Fix efcs mixup.

This commit is contained in:
rpseng 2025-03-13 08:21:40 -03:00
parent 570f901b99
commit 2c7770f24e
3 changed files with 30 additions and 16 deletions

View file

@ -21,6 +21,7 @@ c
#include "nwc_const.fh"
#include "stdio.fh"
#include "prop.fh"
#include "cosmoP.fh"
#include "cosmo_params.fh"
#include "util_params.fh"
c
@ -47,6 +48,7 @@ c
c
c
integer l_efcc, k_efcc, l_efcs, k_efcs, l_efcz, k_efcz
integer l_msrf, k_msrf
integer l_efciat, k_efciat
integer l_rad, k_rad, nrad
integer l_occ, k_occ
@ -90,6 +92,8 @@ c
& call errquit('cosmo_charges malloc k_efcc failed',911,MA_ERR)
if(.not.ma_push_get(mt_dbl,nefc,'cosmo efcs',l_efcs,k_efcs))
& call errquit('cosmo_charges malloc k_efcs failed',911,MA_ERR)
if(.not.ma_push_get(mt_dbl,nefc,'molsurf',l_msrf,k_msrf))
& call errquit('cosmo_charges malloc k_msrf failed',911,MA_ERR)
if(.not.ma_push_get(mt_dbl,nefc,'cosmo efcz',l_efcz,k_efcz))
& call errquit('cosmo_charges malloc k_efcz failed',911,MA_ERR)
if(.not.ma_push_get(mt_dbl,nefc,'cosmo efczz',l_efczz,k_efczz))
@ -196,8 +200,8 @@ c
c ----- get -cosmo- charges -----
c
call hnd_coschg(g_dens,ndens,rtdb,geom,basis,nat,nefc,
& dbl_mb(k_efcc),dbl_mb(k_efcs),dbl_mb(k_efcz),
& dbl_mb(k_efczz),
& dbl_mb(k_efcc),dbl_mb(k_efcs),dbl_mb(k_msrf),
& dbl_mb(k_efcz),dbl_mb(k_efczz),
& int_mb(k_efciat),dbl_mb(k_rad),ecos,cosmo_file)
c
c ----- release memory block -----
@ -251,9 +255,11 @@ c
! & cosmo_sccor
! common/hnd_cosdat/adiag,dsurf,dvol,srfmol,volmol,ptspatm
#include "cosmo_params.fh"
#include "cosmoP.fh"
#include "util_params.fh"
c
integer l_efcc, k_efcc, l_efcs, k_efcs, l_efcz, k_efcz
integer l_msrf, k_msrf
integer l_efciat, k_efciat
integer l_rad, k_rad, nrad
integer l_occ, k_occ
@ -299,6 +305,8 @@ c
& call errquit('cosmo_charges malloc k_efcc failed',911,MA_ERR)
if(.not.ma_push_get(mt_dbl,nefc,'cosmo efcs',l_efcs,k_efcs))
& call errquit('cosmo_charges malloc k_efcs failed',911,MA_ERR)
if(.not.ma_push_get(mt_dbl,nefc,'molsurf',l_msrf,k_msrf))
& call errquit('cosmo_charges malloc k_msrf failed',911,MA_ERR)
if(.not.ma_push_get(mt_dbl,nefc,'cosmo efcz',l_efcz,k_efcz))
& call errquit('cosmo_charges malloc k_efcz failed',911,MA_ERR)
if(.not.ma_push_get(mt_dbl,nefc,'cosmo efczz',l_efczz,k_efczz))
@ -316,6 +324,9 @@ c
& RTDB_ERR)
if(.not.rtdb_get(rtdb,'cosmo:efcs',mt_dbl, nefc,dbl_mb(k_efcs)))
& call errquit('cosmo_charges: rtdb get failed for efcs ',914,
& RTDB_ERR)
if(.not.rtdb_get(rtdb,'cosmo:msrf',mt_dbl, nefc,dbl_mb(k_msrf)))
& call errquit('cosmo_charges: rtdb get failed for msrf ',914,
& RTDB_ERR)
if(.not.rtdb_get(rtdb,'cosmo:efczz',mt_dbl, nefc,dbl_mb(k_efczz)))
& call errquit('cosmo_charges: rtdb get failed for efczz',914,
@ -361,8 +372,8 @@ c
c ----- get -cosmo- charges -----
c
call hnd_coschg(g_dens,ndens,rtdb,geom,basis,nat,nefc,
& dbl_mb(k_efcc),dbl_mb(k_efcs),dbl_mb(k_efcz),
& dbl_mb(k_efczz),
& dbl_mb(k_efcc),dbl_mb(k_efcs),dbl_mb(k_msrf),
& dbl_mb(k_efcz),dbl_mb(k_efczz),
& int_mb(k_efciat),dbl_mb(k_rad),ecos,cosmo_file)
c
c ----- release memory block -----

View file

@ -447,8 +447,8 @@ C> <a href="https://doi.org/10.1111/1468-0262.00296">
C> 10.1111/1468-0262.00296</a>.
C>
subroutine hnd_coschg(g_dens,ndens,rtdb,geom,basis,nat,nefc,
& efcc,efcs,efcz,efczz,efciat,ratm,ecos,
& cosmo_file_in)
& efcc,efcs,msrf,efcz,efczz,efciat,ratm,
& ecos,cosmo_file_in)
implicit none
#include "errquit.fh"
#include "global.fh"
@ -477,7 +477,9 @@ c
double precision efcc(3,nefc) !< [Input] the COSMO charge
!< coordinates
double precision efcs(nefc) !< [Input] the COSMO charge
!< surface area
!< surface area for KS
double precision msrf(nefc) !< [Input] the COSMO charge
!< surface area for YS
c
double precision efcz(nefc) !< [Output] the COSMO charges
double precision efczz(nefc) !< [Input[ the COSMO zeta value for
@ -549,6 +551,7 @@ c
double precision zi, zj, zn, zp ! Z-coordinates
double precision qi, qj ! charges
double precision rr ! distance
double precision efcsi ! surface area of a segment
double precision solnrg ! solvation energy
double precision dlambda ! lambda (surface charge correction)
double precision elambda ! lambda dependent energy term
@ -1253,10 +1256,13 @@ c
write(fn,"(a)") "# n atom x y z charge area charge/area"
write(fn,"(a)") "# coordinates [a.u.], area [A2]"
do ief=1,nefc
efcsi = efcs(ief)*(cau2ang**2)
if (do_cosmo_model.eq.DO_COSMO_YK)
+ efcsi = msrf(ief)*(cau2ang**2)
write(fn,*) ief, efciat(ief),
+ efcc(1,ief), efcc(2,ief), efcc(3,ief),
+ efcz(ief), efcs(ief)*(cau2ang**2),
+ efcz(ief)/(efcs(ief)*(cau2ang**2))
+ efcz(ief), efcsi, efcz(ief)/efcsi
end do
close(fn)
end if

View file

@ -716,7 +716,7 @@ c
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)
if(.not.ma_push_get(mt_dbl,nefc,'molsurf',l_msrf,k_msrf))
& call errquit('cosmo_cossas malloc k_tag failed',1,MA_ERR)
& call errquit('cosmo_cossas malloc k_msrf failed',1,MA_ERR)
call dfill(nefc,0.0d0,dbl_mb(k_msrf),1)
if(oprint_debug) then
@ -894,15 +894,12 @@ c
if(.not.rtdb_put(rtdb,'cosmo:efcz',mt_dbl, nefc,dbl_mb(k_efcz)))
$ call errquit('hnd_cossas: rtdb put failed for efcz ',913,
& rtdb_err)
if (do_cosmo_model.eq.DO_COSMO_YK) then
if(.not.rtdb_put(rtdb,'cosmo:efcs',mt_dbl, nefc,dbl_mb(k_msrf)))
$ call errquit('hnd_cossas: rtdb put failed for efcs ',914,
& rtdb_err)
else
if(.not.rtdb_put(rtdb,'cosmo:efcs',mt_dbl, nefc,dbl_mb(k_efcs)))
$ call errquit('hnd_cossas: rtdb put failed for efcs ',914,
& rtdb_err)
endif
if(.not.rtdb_put(rtdb,'cosmo:msrf',mt_dbl, nefc,dbl_mb(k_msrf)))
$ call errquit('hnd_cossas: rtdb put failed for msrf ',914,
& rtdb_err)
if(.not.rtdb_put(rtdb,'cosmo:efczz',mt_dbl,nefc,dbl_mb(k_efczz)))
& call errquit('hnd_cossas: rtdb put failed for efczz ',914,
& rtdb_err)