comp-chem/NWChem
1
0
Fork 0
mirror of https://github.com/nwchemgit/nwchem.git synced 2026-07-29 06:35:39 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

added more print options

Browse source
This commit is contained in:
edoapra 2022-03-09 16:28:52 -08:00
parent a03cbb77d9
commit ac9f5cc366
No known key found for this signature in database
GPG key ID: 472C4EBB4F3AEDFA
4 changed files with 35 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/solvation/cosmo_initialize.F
View file

@ -89,6 +89,8 @@ c
c
odbug=.false.
osome=oprint
call util_print_push
call util_print_rtdb_load(rtdb, 'cosmo')
c
if(odbug.and.me.eq.0) then
write(Luout,*) 'in cosmo_initialize ...'

6
src/solvation/cosmo_input.F
View file

@ -187,9 +187,7 @@ c
if(.not.ma_push_get(mt_dbl,nw_max_atom,'cosmo rads',l_rad,k_rad))
& call errquit('cosmo_input malloc k_rad failed',nw_max_atom,
& MA_ERR)
do iat=1,nw_max_atom
dbl_mb(k_rad+iat-1)=0.0d+00
enddo
call dfill(nw_max_atom,0d0,dbl_mb(k_rad),1)
c
c ----- read values from input -----
c
@ -591,6 +589,8 @@ c
$ call errquit('cosmo_input: put cosmo:sw_tol failed',
$ 911, RTDB_ERR)
c
else if(inp_compare(.false.,'print',field)) then
call util_print_input(rtdb, 'cosmo')
else
if (ga_nodeid().eq.0) then
write(LuOut,*)'cosmo_input: read unknown keyword: ',field

1
src/solvation/cosmo_tidy.F
View file

@ -20,6 +20,7 @@ c
#include "stdio.fh"
integer rtdb !< [Input] the RTDB handle
c
call util_print_pop
if (.not. bq_destroy(cosmo_bq_efc)) call errquit
$ ('cosmo_tidy: bq destroy failed', 0, GEOM_ERR)
if (.not. bq_destroy(cosmo_bq_invnuc)) call errquit

41
src/solvation/hnd_cosmo_lib.F
View file

@ -429,6 +429,7 @@ c
integer l_efcc, k_efcc, l_efcs, k_efcs, l_efcz, k_efcz
integer l_efclb, k_efclb, k_efciat, l_efciat
integer l_efczz, k_efczz
integer l_msrf,k_msrf
double precision ratm_real,dij,dum,cavdsp,pi,zetai,zetaii
integer m,mfac,mseg
integer nefc,iat,jat,npp,i,iseg,ifac,ief,ipp
@ -454,6 +455,7 @@ c
double precision dist, xi, yi, zi, xj, yj, zj, rin, rout, alphai
parameter (alphai = 0.5d0)
logical oprint_debug
logical oprint_molsurf
c
dist(xi,yi,zi,xj,yj,zj)=sqrt((xj-xi)**2+(yj-yi)**2+(zj-zi)**2)
rin(iat)=ratm(iat)*(1.0d0-alphai*gammas*sqrt(0.25d0**minbem))
@ -461,6 +463,8 @@ c
& sqrt(0.25d0**minbem))
c
oprint_debug = util_print("cosmo_cossas_debug",print_debug).and.
D (ga_nodeid().eq.0)
oprint_molsurf = util_print("cosmo_mol_surface",print_never).and.
D (ga_nodeid().eq.0)
pi = acos(-1.0d0)
c
@ -704,7 +708,11 @@ c
if(.not.ma_push_get(mt_dbl,nefc,'cosmo zeta',l_efczz,k_efczz))
& call errquit('cosmo_cossas malloc k_efczz failed',911,MA_ERR)
if(.not.ma_push_get(mt_byte,nefc*8,'cosmo tags',l_efclb,k_efclb))
& call errquit('cosmo_cossas malloc k_tag failed',911,MA_ERR)
& call errquit('cosmo_cossas malloc k_tag failed',911,MA_ERR)
if(oprint_molsurf) then
if(.not.ma_push_get(mt_dbl,nseg*nat,'molsurf',l_msrf,k_msrf))
& call errquit('cosmo_cossas malloc k_tag failed',1,MA_ERR)
endif
c
c ----- save coordinates of surface points -----
c save segment surfaces
@ -766,12 +774,22 @@ c
zetai=zeta/sqrt(dsurf)/ratm_real
zetaii=zetai*sqrt(2d0/pi)
dbl_mb(k_efcs+ief-1) = (zetaii/xyzff(iseg,iat))
c 769
if(oprint_molsurf) then
dbl_mb(k_msrf+(iat-1)*nseg+iseg-1)=
x xyzff(iseg,iat)*dsurf*ratm_real**2
endif
srfmol = srfmol+xyzff(iseg,iat)*dsurf*ratm_real**2
volmol = volmol+xyzff(iseg,iat)*dvol *ratm_real**3
else
zetai=zeta/(ratm_real*sqrt(wleb(iseg)))
zetaii=zetai*sqrt(2d0/pi)
dbl_mb(k_efcs+ief-1) = zetaii/xyzff(iseg,iat)
c 775
if(oprint_molsurf) then
dbl_mb(k_msrf+(iat-1)*nseg+iseg-1)=
x xyzff(iseg,iat)*wleb(iseg)*ratm_real**2
endif
srfmol = srfmol + xyzff(iseg,iat)*
$ wleb(iseg)*ratm_real**2
volmol = volmol + xyzff(iseg,iat)*
@ -824,6 +842,15 @@ c
& int_mb(k_efciat+ief-1)
enddo
endif
if(oprint_molsurf) then
write(luout,*) ' Contributions to the molecular surface '
do iat=1,nat
do iseg=1,nseg
write(luout,*) iat,iseg,
W dbl_mb(k_msrf+(iat-1)*nseg+iseg-1)
enddo
enddo
endif
c
do ief=1,nefc
dbl_mb(k_efcz+ief-1)=0d0
@ -870,17 +897,7 @@ c if(.not.rtdb_cput(rtdb,'char variable',nefc,byte_mb(k_efclb)))
c $ call errquit('hnd_cossas: rtdb put failed for efclab',917,
c & rtdb_err)
c
if(.not.ma_pop_stack(l_efclb)) call
& errquit('cosmo_cossas chop stack k_efclb failed',911,MA_ERR)
if(.not.ma_pop_stack(l_efczz)) call
& errquit('cosmo_cossas chop stack k_efczz failed',911,MA_ERR)
if(.not.ma_pop_stack(l_efcz)) call
& errquit('cosmo_cossas chop stack k_efcz failed',911,MA_ERR)
if(.not.ma_pop_stack(l_efciat)) call
& errquit('cosmo_cossas chop stack k_efciat failed',911,MA_ERR)
if(.not.ma_pop_stack(l_efcs)) call
& errquit('cosmo_cossas chop stack k_efcs failed',911,MA_ERR)
if(.not.ma_pop_stack(l_efcc)) call
if(.not.ma_chop_stack(l_efcc)) call
& errquit('cosmo_cossas chop stack k_efcc failed',911,MA_ERR)
c
return