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

return value of push_get was NEVER checked plus COSMO_YK definition from cosmo header fiel was not there

Browse source
This commit is contained in:
Edoardo Apra 2015-12-02 02:48:08 +00:00
parent 05d5d6688d
commit 0374d17c19
1 changed files with 42 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

74
src/solvation/hnd_cosmo_lib.F
View file

@ -92,26 +92,32 @@ c if(.not.ma_push_get(mt_dbl,need,'mem init:cosmo:hnd_cosset:1',
c & i_init,init))
c & call errquit('hnd_cosset, malloc of init failed',911,MA_ERR)
c
stat = .true.
stat = stat.and.ma_push_get(mt_dbl,3*nat,"xyzatm",l_i10,i10)
stat = stat.and.ma_push_get(mt_dbl, nat,"ratm",l_i20,i20)
stat = stat.and.ma_push_get(mt_int, nat,"nspa",l_i30,i30)
stat = stat.and.ma_push_get(mt_int, nat,"nppa",l_i40,i40)
stat = stat.and.ma_push_get(mt_int,3*mxface,"ijkfac",l_i50,i50)
stat = stat.and.ma_push_get(mt_dbl,3*mxface,"xyzseg",l_i60,i60)
stat = stat.and.ma_push_get(mt_int, mxface,"ijkseg",l_i70,i70)
stat = stat.and.ma_push_get(mt_log, mxface*nat,"insseg",
& l_i80,i80)
stat = stat.and.ma_push_get(mt_dbl,3*mxface*nat,"xyzspa",
& l_i90,i90)
stat = stat.and.ma_push_get(mt_int, mxface*nat,"ijkspa",
& l_i100,i100)
stat = stat.and.ma_push_get(mt_int, mxface*nat,"numpps",
& l_i110,i110)
stat = stat.and.ma_push_get(mt_dbl,3*mxapex ,"apex",
& l_i120,i120)
stat = stat.and.ma_push_get(mt_dbl, mxface*nat,"xyzff",
& l_i130,i130)
if(.not.ma_push_get(mt_dbl,3*nat,"xyzatm",l_i10,i10))
c call errquit('hndcosset: not enuf mem',0,MA_ERR)
if(.not.ma_push_get(mt_dbl, nat,"ratm",l_i20,i20))
c call errquit('hndcosset: not enuf mem',1,MA_ERR)
if(.not.ma_push_get(mt_int, nat,"nspa",l_i30,i30))
c call errquit('hndcosset: not enuf mem',2,MA_ERR)
if(.not.ma_push_get(mt_int, nat,"nppa",l_i40,i40))
c call errquit('hndcosset: not enuf mem',3,MA_ERR)
if(.not.ma_push_get(mt_int,3*mxface,"ijkfac",l_i50,i50))
c call errquit('hndcosset: not enuf mem',4,MA_ERR)
if(.not.ma_push_get(mt_dbl,3*mxface,"xyzseg",l_i60,i60))
c call errquit('hndcosset: not enuf mem',5,MA_ERR)
if(.not.ma_push_get(mt_int, mxface,"ijkseg",l_i70,i70))
c call errquit('hndcosset: not enuf mem',6,MA_ERR)
if(.not.ma_push_get(mt_log, mxface*nat,"insseg",l_i80,i80))
c call errquit('hndcosset: not enuf mem',7,MA_ERR)
if(.not.ma_push_get(mt_dbl,3*mxface*nat,"xyzspa",l_i90,i90))
c call errquit('hndcosset: not enuf mem',8,MA_ERR)
if(.not.ma_push_get(mt_int, mxface*nat,"ijkspa",l_i100,i100))
c call errquit('hndcosset: not enuf mem',9,MA_ERR)
if(.not.ma_push_get(mt_int, mxface*nat,"numpps",l_i110,i110))
c call errquit('hndcosset: not enuf mem',10,MA_ERR)
if(.not.ma_push_get(mt_dbl,3*mxapex ,"apex",l_i120,i120))
c call errquit('hndcosset: not enuf mem',11,MA_ERR)
if(.not.ma_push_get(mt_dbl, mxface*nat,"xyzff",l_i130,i130))
c call errquit('hndcosset: not enuf mem',12,MA_ERR)
c i10 =init ! xyzatm(3,nat)
c i20 =i10 +3*nat ! ratm( nat)
c i30 =i20 + nat ! nspa( nat)
@ -129,9 +135,10 @@ c ----- get -cosmo- surface -----
c
call hnd_cossrf(nat,c,radius,nat,mxface,mxapex,
1 dbl_mb(i10),dbl_mb(i20),int_mb(i30),int_mb(i40),
2 int_mb(i50),dbl_mb(i60),int_mb(i70),
3 log_mb(i80),dbl_mb(i90),int_mb(i100),int_mb(i110),
2 int_mb(i50),dbl_mb(i60),int_mb(i70),log_mb(i80),
3 dbl_mb(i90),int_mb(i100),int_mb(i110),
4 dbl_mb(i120),dbl_mb(i130),rtdb)
c
c ----- release memory block -----
c
@ -157,7 +164,7 @@ c
#include "global.fh"
#include "stdio.fh"
#include "cosmoP.fh"
c
#include "mafdecls.fh"
integer rtdb, nat
integer mxatm
integer mxfac
@ -261,6 +268,7 @@ c
c
c ----- create -solvent accessible surface- of the molecule -----
c
call hnd_cossas(nat,xyzatm,ratm,mxatm,
1 nspa,nppa,xyzspa,ijkspa,
2 nseg,nfac,xyzseg,ijkseg,insseg,
@ -366,6 +374,7 @@ C>
#include "stdio.fh"
#include "bq.fh"
#include "prop.fh"
cnew
#include "cosmoP.fh"
c
integer rtdb !< [Input] The RTDB handle
@ -410,7 +419,6 @@ c
integer numpps( mxface,mxatom)
double precision xyzff( mxface,mxatom)
double precision zero, one
data zero /0.0d+00/
data one /1.0d+00/
integer l_efcc, k_efcc, l_efcs, k_efcs, l_efcz, k_efcz
integer l_efclb, k_efclb, k_efciat, l_efciat
@ -464,7 +472,7 @@ c
do i=1,mxface
ijkspa(i,iat)=0
numpps(i,iat)=0
xyzff(i,iat)=zero
xyzff(i,iat)=0d0
enddo
enddo
c
@ -473,7 +481,7 @@ c belongs to the -sas- or is inside the molecule.
c
do iat=1,nat
c
if(ratm(iat).ne.zero) then
if(ratm(iat).ne.0d0) then
do iseg=1,nseg
ijkspa(iseg,iat)=ijkseg(iseg)
xyzff(iseg,iat)=one
@ -515,7 +523,7 @@ c
enddo
endif
else if (do_cosmo_model.eq.DO_COSMO_YK) then
if((jat.ne.iat).and.(ratm(jat).ne.zero)
if((jat.ne.iat).and.(ratm(jat).ne.0d0)
1 .and.(dij.lt.(ratm(iat)+rout(jat)))) then
do iseg=1,nseg
dum=dist(xyzspa(1,iseg,iat),
@ -615,7 +623,7 @@ c and generate memory to store them
c
nefc = 0
do iat=1,nat
if(ratm(iat).ne.zero) then
if(ratm(iat).ne.0d0) then
do iseg=1,nseg
if(.not.insseg(iseg,iat)) nefc = nefc+1
enddo
@ -639,11 +647,11 @@ c ----- save coordinates of surface points -----
c save segment surfaces
c save segment to atom mapping
c
srfmol=zero
volmol=zero
srfmol=0d0
volmol=0d0
ief =0
do iat=1,nat
if(ratm(iat).ne.zero) then
if(ratm(iat).ne.0d0) then
if (do_cosmo_model.eq.DO_COSMO_KS) then
ratm_real=ratm(iat)-rsolv/bohr
else if (do_cosmo_model.eq.DO_COSMO_YK) then
@ -720,7 +728,7 @@ c
endif
c
do ief=1,nefc
dbl_mb(k_efcz+ief-1)=zero
dbl_mb(k_efcz+ief-1)=0d0
enddo
do ief=1,nefc
byte_mb(k_efclb+(ief-1)*8)=' '
@ -877,6 +885,8 @@ C>
implicit double precision (a-h,o-z)
#include "global.fh"
#include "stdio.fh"
cnew
#include "cosmoP.fh"
c
c ----- starting from -icosahedron- -----
c