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

further solvation updates

Browse source
This commit is contained in:
Niri Govind 2016-07-22 23:17:32 +00:00
parent beace12df6
commit 8a5a113b89
2 changed files with 18 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/solvation/cosmo_initialize.F
View file

@ -26,6 +26,7 @@ C>
#include "msgids.fh"
#include "cosmoP.fh"
#include "cosmo_params.fh"
#include "util_params.fh"
c
integer rtdb !< [Input] the RTDB handle
integer geom !< [Input] the geometry handle
@ -600,7 +601,7 @@ c call smd model
$ 'cosmo_initialize: cannot get areacds from rtdb',
$ 911,rtdb_err)
if (me.eq.0) then
write(luout,9976) gcds*627.509451d+00
write(luout,9976) gcds*cau2kcal
write(luout,9975) areacds
endif
end if

59
src/solvation/mnsol_interface.F
View file

@ -14,62 +14,43 @@ c
#include "nwc_const.fh"
#include "mafdecls.fh"
#include "global.fh"
#include "util_params.fh"
c
integer rtdb,geom,nat,ixmem,icds
double precision sola,solb,solc,solg,solh,soln
c
character*16 atsym(nat)
double precision c(3,nat)
integer ian(nat)
double precision q(nat)
integer atnum(nat)
c
double precision gcds,areacds
double precision dcds(3,nat)
double precision x(ixmem)
c
integer iat
integer iat,ixyz
integer l_c, k_c, l_atsym, k_atsym, l_z, k_z
logical status
c
c preliminaries
do iat = 1,nat
c(1,iat) = 0.d0
c(2,iat) = 0.d0
c(3,iat) = 0.d0
ian(iat) = 0
do ixyz = 1,3
c(ixyz,iat) = 0.d0
end do
atnum(iat) = 0
q(iat) = 0
end do
c
c allocate c,z,atsym
if(.not.ma_push_get(mt_dbl,nat*3,'c',l_c,k_c))
& call errquit('mnsol_interface: k_c failed',911,MA_ERR)
if(.not.ma_push_get(mt_dbl,nat,'z',l_z,k_z))
& call errquit('mnsol_interface: k_z failed',911,MA_ERR)
if(.not.ma_push_get(mt_byte,nat*16,'atsym',l_atsym,k_atsym))
& call errquit('mnsol_interface: k_atsym failed',911,MA_ERR)
c
c get the coordinates
if(.not.geom_cart_get(geom,nat,byte_mb(k_atsym),
& dbl_mb(k_c),dbl_mb(k_z))) call errquit
$ (' cosmo_initialize: geom_cart_get failed.',911, GEOM_ERR)
if(.not.geom_cart_get2(geom,nat,atsym,c,q,atnum))
& call errquit('mnsol_interface: geom_cart_get2 failed.',911,
& GEOM_ERR)
c
do iat=1,nat
c(1,iat) = dbl_mb(k_c +3*(iat-1))
c(2,iat) = dbl_mb(k_c+1+3*(iat-1))
c(3,iat) = dbl_mb(k_c+2+3*(iat-1))
ian(iat) = dbl_mb(k_z+iat-1)
c if (ga_nodeid().eq.0)
c & write(luout,*) iat,ian(iat),c(1,iat),c(2,iat),c(3,iat)
end do
C
C call cavity dispersion solvent (CDS) structure driver
c if (ga_nodeid().eq.0) write(luout,*) "calling cdsset"
call cdsset(icds,gcds,areacds,nat,c,ian,dcds,x,
call cdsset(icds,gcds,areacds,nat,c,atnum,dcds,x,
& sola,solb,solc,solg,solh,soln)
C
C print out the output from CDSSET
C
c if (ga_nodeid().eq.0) write (luout,*) "GCDS: ", GCDS
c if (ga_nodeid().eq.0) write (luout,*) "AREACDS: ", AREACDS
c
c store non-electrostatic energy contribution from SMD model
gcds = gcds / 627.509451d+00
gcds = gcds / cau2kcal
if (.not. rtdb_put(rtdb,'cosmo:gcds',mt_dbl,1,gcds))
$ call errquit('mnsol_interface: rtdb put failed',911,RTDB_ERR)
c
@ -89,14 +70,6 @@ c write (6,*) iat,dcds(1,iat),dcds(2,iat),dcds(3,iat)
c enddo
c write (6,*) 'GRADIENTSGRADIENTSGRADIENTSGRADIENTS'
c endif
c
c release local memory
if(.not.ma_pop_stack(l_atsym))
& call errquit('mnsol_interface: k_atsym failed',911,MA_ERR)
if(.not.ma_pop_stack(l_z))
& call errquit('mnsol_interface: k_z failed',911,MA_ERR)
if(.not.ma_pop_stack(l_c))
& call errquit('mnsol_interface: k_c failed',911,MA_ERR)
c
return
end