diff options
Diffstat (limited to 'var/spack/repos/builtin/packages/nwchem/cosmo_meminit.patch')
| -rwxr-xr-x | var/spack/repos/builtin/packages/nwchem/cosmo_meminit.patch | 172 |
1 files changed, 172 insertions, 0 deletions
diff --git a/var/spack/repos/builtin/packages/nwchem/cosmo_meminit.patch b/var/spack/repos/builtin/packages/nwchem/cosmo_meminit.patch new file mode 100755 index 0000000000..2f56e268ab --- /dev/null +++ b/var/spack/repos/builtin/packages/nwchem/cosmo_meminit.patch @@ -0,0 +1,172 @@ +Index: src/solvation/hnd_cosmo_lib.F +=================================================================== +--- src/solvation/hnd_cosmo_lib.F (revision 27880) ++++ src/solvation/hnd_cosmo_lib.F (revision 27881) +@@ -92,26 +92,32 @@ + 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 + 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 @@ + #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 ----- 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 @@ + #include "stdio.fh" + #include "bq.fh" + #include "prop.fh" ++cnew + #include "cosmoP.fh" + c + integer rtdb !< [Input] The RTDB handle +@@ -410,7 +419,6 @@ + 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 @@ + 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 + 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 @@ + 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 + 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 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 @@ + 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 @@ + implicit double precision (a-h,o-z) + #include "global.fh" + #include "stdio.fh" ++cnew ++#include "cosmoP.fh" + c + c ----- starting from -icosahedron- ----- + c |