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
