comp-chem/NWChem
1
0
Fork 0
mirror of https://github.com/nwchemgit/nwchem.git synced 2026-07-28 22:25:48 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Merge pull request #651 from edoapra/bas-loadlibrary-pull

Browse source 
updates
This commit is contained in:
Edoardo Aprà 2022-09-21 21:03:29 -07:00 • committed by GitHub
commit fae78b83f2
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 50 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/qmd/qmd_driver.F
View file

@ -111,8 +111,8 @@ c
logical task_freq
external task_freq
c
logical qmd_property
external qmd_property
logical qmd_property,qmd_linear
external qmd_property,qmd_linear
c
c preliminaries
status_qmd = .true.
@ -211,6 +211,11 @@ c
c set degrees of freedom depending on the type of thermostat
ndeg = 3*nactive ! initialize ndeg for local thermostats (e.g. langevin)
if (.not.do_langevin) then ! for global thermostats
if(.not.do_linear) then
c check linearity of molecular geometry
do_linear=qmd_linear(geom,nat,dbl_mb(k_r))
write(6,*) ' do_linear ',do_linear
endif
if (do_linear) then ! check for linear flag
ndeg = 3*nactive-5 ! 3N-5 (linear)
else
@ -518,3 +523,28 @@ c
c
end
c $Id$
logical function qmd_linear(geom,n,xyz)
implicit none
integer n,geom
double precision xyz(3,*)
c
integer i
double precision angle
logical geom_calc_angle,geom_cart_coords_get
external geom_calc_angle,geom_cart_coords_get
c
qmd_linear=.true.
if(n.eq.2) return
if(.not.geom_cart_coords_get(geom, xyz))
c call errquit(' geom_cart_coords fails ',0,0)
do i=1,n-2
if(.not.geom_calc_angle(
1 xyz(1,i),
2 xyz(1,i+1),
3 xyz(1,i+2),
a angle))
c call errquit(' geom_calc_angle fails ',0,0)
if(abs(angle-180d0).gt.1d-5) qmd_linear=.false.
enddo
return
end

32
src/util/util_file_name.F
View file

@ -728,31 +728,35 @@ c
character*1024 envscr
integer util_getblnk
external util_getblnk
logical envok
c
c return the name of the scratch/permanent directory for the
c specified process
c
dir='. '
envok=.false.
if (oscratch) then
call util_getenv('SCRATCH_DIR',envscr)
if(inp_strlen(envscr).gt.0) then
if(.not.util_file_parse_dir(envscr, dir, ga_nodeid()))
I then
if (.not. util_file_parse_dir(scratch_dir,
d dir, node)) then
dir = '. ' ! Final default is blank
endif
if(inp_strlen(envscr).gt.0) then
envok =
U util_file_parse_dir(envscr, dir, ga_nodeid())
endif
if(.not.envok) then
if (.not. util_file_parse_dir(scratch_dir,
d dir, node)) then
dir = '. ' ! Final default is blank
endif
endif
else
call util_getenv('PERMANENT_DIR',envscr)
call util_getenv('PERMANENT_DIR',envscr)
if(inp_strlen(envscr).gt.0) then
if(.not.util_file_parse_dir(envscr, dir, ga_nodeid()))
I then
if (.not. util_file_parse_dir(permanent_dir,
D dir, node)) then
dir = '. ' ! Final default is blank
endif
envok =
U util_file_parse_dir(envscr, dir, ga_nodeid())
endif
if(.not.envok) then
if (.not. util_file_parse_dir(permanent_dir,
D dir, node)) then
dir = '. ' ! Final default is blank
endif
endif
endif