From ac9f5cc3666c3155b233da3384eec9827aaa6185 Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 9 Mar 2022 16:28:52 -0800 Subject: [PATCH] added more print options --- src/solvation/cosmo_initialize.F | 2 ++ src/solvation/cosmo_input.F | 6 ++--- src/solvation/cosmo_tidy.F | 1 + src/solvation/hnd_cosmo_lib.F | 41 ++++++++++++++++++++++---------- 4 files changed, 35 insertions(+), 15 deletions(-) diff --git a/src/solvation/cosmo_initialize.F b/src/solvation/cosmo_initialize.F index 4a3bda9a4f..dbf092990a 100644 --- a/src/solvation/cosmo_initialize.F +++ b/src/solvation/cosmo_initialize.F @@ -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 ...' diff --git a/src/solvation/cosmo_input.F b/src/solvation/cosmo_input.F index 5e9f0b577c..42f272bb61 100644 --- a/src/solvation/cosmo_input.F +++ b/src/solvation/cosmo_input.F @@ -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 diff --git a/src/solvation/cosmo_tidy.F b/src/solvation/cosmo_tidy.F index b1019bdf5a..37b9c16904 100644 --- a/src/solvation/cosmo_tidy.F +++ b/src/solvation/cosmo_tidy.F @@ -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 diff --git a/src/solvation/hnd_cosmo_lib.F b/src/solvation/hnd_cosmo_lib.F index d13f9740ae..02c00e657b 100644 --- a/src/solvation/hnd_cosmo_lib.F +++ b/src/solvation/hnd_cosmo_lib.F @@ -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