From 2c7770f24edea63c3d747b080c15a18f7659d1df Mon Sep 17 00:00:00 2001 From: rpseng Date: Thu, 13 Mar 2025 08:21:40 -0300 Subject: [PATCH] Fix efcs mixup. --- src/solvation/cosmo_charges.F | 19 +++++++++++++++---- src/solvation/hnd_coschg.F | 16 +++++++++++----- src/solvation/hnd_cosmo_lib.F | 11 ++++------- 3 files changed, 30 insertions(+), 16 deletions(-) diff --git a/src/solvation/cosmo_charges.F b/src/solvation/cosmo_charges.F index 4297d3ecfc..7f4f6d6f53 100644 --- a/src/solvation/cosmo_charges.F +++ b/src/solvation/cosmo_charges.F @@ -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 ----- diff --git a/src/solvation/hnd_coschg.F b/src/solvation/hnd_coschg.F index 30c9373c32..a1bd8f0364 100644 --- a/src/solvation/hnd_coschg.F +++ b/src/solvation/hnd_coschg.F @@ -447,8 +447,8 @@ C> C> 10.1111/1468-0262.00296. 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 diff --git a/src/solvation/hnd_cosmo_lib.F b/src/solvation/hnd_cosmo_lib.F index 134ff6b140..529048dec0 100644 --- a/src/solvation/hnd_cosmo_lib.F +++ b/src/solvation/hnd_cosmo_lib.F @@ -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)