diff --git a/src/cafe/cf_common.fh b/src/cafe/cf_common.fh index 0526418b21..443f0d5f51 100644 --- a/src/cafe/cf_common.fh +++ b/src/cafe/cf_common.fh @@ -1,4 +1,4 @@ -c $Id: cf_common.fh,v 1.34 2002-05-02 19:39:34 d3j191 Exp $ +c $Id: cf_common.fh,v 1.35 2002-08-09 22:16:13 d3j191 Exp $ c real*8 zero,tiny,small real*8 fourth,third,half,one,two,three,four,six,twelve @@ -74,7 +74,7 @@ c + i_pmew,l_pmew,i_pmes,l_pmes, + i_theta,l_theta,i_dtheta,l_dtheta, + i_ipmf,l_ipmf,i_jpmf,l_jpmf,i_rpmf,l_rpmf,i_xpmf,l_xpmf, - + i_ypmf,l_ypmf,i_wpmf,l_wpmf + + i_ypmf,l_ypmf,i_wpmf,l_wpmf,i_upmf,l_upmf common/cf_ptr/i_vdw,l_vdw,i_mas,l_mas,i_nam,l_nam,i_num,l_num, + i_chg,l_chg,i_iwa,l_iwa,i_iwq,l_iwq,i_ias,l_ias,i_typ,l_typ, + i_ibnd,l_ibnd,i_bnd,l_bnd,i_rbnd,l_rbnd, diff --git a/src/cafe/cf_finish.F b/src/cafe/cf_finish.F index a7ed1e32f3..08d8061353 100644 --- a/src/cafe/cf_finish.F +++ b/src/cafe/cf_finish.F @@ -1,5 +1,5 @@ subroutine cf_finish() -c $Id: cf_finish.F,v 1.13 2001-05-23 03:20:03 d3j191 Exp $ +c $Id: cf_finish.F,v 1.14 2002-08-09 22:16:13 d3j191 Exp $ implicit none c #include "cf_common.fh" @@ -12,6 +12,8 @@ c if(ipme.gt.0) call pme_finish() c if(numpmf.gt.0) then + if(.not.ma_pop_stack(l_upmf)) + + call errquit('Failed to deallocate upmf',0) if(.not.ma_pop_stack(l_wpmf)) + call errquit('Failed to deallocate wpmf',0) if(.not.ma_pop_stack(l_ypmf)) diff --git a/src/cafe/cf_init.F b/src/cafe/cf_init.F index a54f696211..8c6d6dd24e 100644 --- a/src/cafe/cf_init.F +++ b/src/cafe/cf_init.F @@ -6,7 +6,7 @@ + sclq,iislow,tempi,tempwi,tempsi,compr,ntyp,idset,ipset1,ipset2, + issscl,delta,nfanal,lpbc,npgi,fldi,fvec,ffrq,npenrg,ictrl,nbiasi, + mropti,incl,ltwn) -c $Id: cf_init.F,v 1.79 2002-07-17 14:25:21 d3j191 Exp $ +c $Id: cf_init.F,v 1.80 2002-08-09 22:16:13 d3j191 Exp $ implicit none c #include "cf_common.fh" @@ -254,7 +254,7 @@ c numpmf=itemp(1) npmfa=itemp(2) if(numpmf.gt.0) then - if(.not.ma_push_get(mt_int,7*numpmf,'ipmf',l_ipmf,i_ipmf)) + if(.not.ma_push_get(mt_int,8*numpmf,'ipmf',l_ipmf,i_ipmf)) + call errquit('Failed to allocate ipmf',0) if(.not.ma_push_get(mt_int,4*numpmf*npmfa,'jpmf',l_jpmf,i_jpmf)) + call errquit('Failed to allocate jpmf',0) @@ -266,6 +266,8 @@ c + call errquit('Failed to allocate ypmf',0) if(.not.ma_push_get(mt_dbl,4*numpmf,'wpmf',l_wpmf,i_wpmf)) + call errquit('Failed to allocate wpmf',0) + if(.not.ma_push_get(mt_dbl,numpmf,'upmf',l_upmf,i_upmf)) + + call errquit('Failed to allocate upmf',0) endif call cf_rdpmf(lfntop,int_mb(i_ipmf),int_mb(i_jpmf),dbl_mb(i_rpmf)) call ga_brdcst(mcf_75,nbias,ma_sizeof(mt_int,1,mt_byte),0) @@ -361,7 +363,7 @@ c #include "msgids.fh" c integer lfntop - integer ipmf(numpmf,7),jpmf(numpmf,4,npmfa) + integer ipmf(numpmf,8),jpmf(numpmf,4,npmfa) real*8 rpmf(3,6,numpmf) c integer i,j,k,m,lenint,lendbl,lenlog @@ -375,8 +377,8 @@ c do 1 i=1,numpmf read(lfntop,1000) ipmf(i,1),ipmf(i,6),ipmf(i,7), + (rpmf(j,1,i),rpmf(j,3,i),j=1,2), - + (ipmf(i,j),j=2,5) - 1000 format(3i5,2f12.6,2e12.5,4i5) + + (ipmf(i,j),j=2,5),ipmf(i,8) + 1000 format(3i5,2f12.6,2e12.5,5i5) if(ipmf(i,6).ne.0) nbias=nbias+1 do 2 j=1,2 rpmf(j,2,i)=rpmf(j,1,i) diff --git a/src/cafe/cf_main.F b/src/cafe/cf_main.F index cfe23a6bfd..7fe5a7663a 100644 --- a/src/cafe/cf_main.F +++ b/src/cafe/cf_main.F @@ -1,5 +1,5 @@ subroutine cf_weight(numw,nums,isat,isml,wbx) -c $Id: cf_main.F,v 1.147 2002-06-26 21:02:40 d3j191 Exp $ +c $Id: cf_main.F,v 1.148 2002-08-09 22:16:13 d3j191 Exp $ implicit none c #include "cf_common.fh" @@ -1416,13 +1416,13 @@ c if(lpmf) then call cf_plist(nums,xs,fs,isgan,isatt,int_mb(i_ipmf), + int_mb(i_jpmf),dbl_mb(i_rpmf),dbl_mb(i_xpmf),dbl_mb(i_wpmf), - + lfnpmf,lrec,iprpmf) + + dbl_mb(i_upmf),lfnpmf,lrec,iprpmf) endif c return end subroutine cf_plist(nums,xs,fs,isgan,isatt, - + ipmf,jpmf,rpmf,xpmf,wpmf,lfnpmf,lrec,iprpmf) + + ipmf,jpmf,rpmf,xpmf,wpmf,upmf,lfnpmf,lrec,iprpmf) c implicit none c @@ -1437,9 +1437,9 @@ c integer nums,lfnpmf,iprpmf real*8 xs(msa,3),fs(msa,3) integer isgan(msa),isatt(msa) - integer ipmf(numpmf,7),jpmf(numpmf,4,npmfa) + integer ipmf(numpmf,8),jpmf(numpmf,4,npmfa) real*8 rpmf(3,6,numpmf),xpmf(4,3,numpmf),wpmf(4,numpmf) - real*8 et(2),ft(4,3) + real*8 et(2),ft(4,3),upmf(numpmf) integer ip(5) real*8 rv(2),chg(2) integer it(2),ign(4),iml(4),idt(4),ich(4) @@ -1462,6 +1462,7 @@ c xpmf(j,3,i)=zero wpmf(j,i)=zero 2 continue + upmf(i)=zero if(ipmf(i,6).eq.2.and.lpmfc) goto 1 c m=0 @@ -1563,6 +1564,7 @@ c 1000 format(i5,f12.6,e12.5) if(ipmf(i,6).eq.1) ubias=ubias+rv(2) epmf=epmf+rv(2) + upmf(ipmf(i,8))=upmf(ipmf(i,8))+rv(2) endif do 9 j=1,2 do 10 k=1,ipmf(i,j+1) @@ -1599,6 +1601,7 @@ c write(*,'(a,f12.6,e12.5,3e12.5)') 'Angle:',rv,(ft(3,j),j=1,3) if(me.eq.0) then if(lrec.and.lfnpmf.lt.0) write(-lfnpmf,1000) i,rv epmf=epmf+rv(2) + upmf(ipmf(i,8))=upmf(ipmf(i,8))+rv(2) if(ipmf(i,6).eq.1) ubias=ubias+rv(2) endif do 14 j=1,3 @@ -1644,6 +1647,7 @@ c write(*,'(a,f12.6,e12.5,3e12.5)') 'Imp:',rv,(ft(3,j),j=1,3) if(me.eq.0) then if(lrec.and.lfnpmf.lt.0) write(-lfnpmf,1000) i,rv epmf=epmf+rv(2) + upmf(ipmf(i,8))=upmf(ipmf(i,8))+rv(2) if(ipmf(i,6).eq.1) ubias=ubias+rv(2) endif do 19 j=1,4 @@ -1719,6 +1723,7 @@ c sum ubias on every processor since this is not done in replicated mode c ubias=ubias+rv(2) epmf=epmf+rv(2) + upmf(ipmf(i,8))=upmf(ipmf(i,8))+rv(2) c c sum the forces c @@ -2348,6 +2353,9 @@ c if(numi(2).gt.0) call cf_pr_imprs(lfnout,numi(2),mit(2),mip(2), + int_mb(i_iimp(2)),dbl_mb(i_imp(2)),dbl_mb(i_rimp(2)), + byte_mb(i_snam)) +c + if(numpmf.gt.0) call cf_pr_pmf(lfnout,int_mb(i_ipmf), + + dbl_mb(i_upmf)) c return end @@ -2486,6 +2494,39 @@ c 1001 format(4i7,4a17,i7,f5.1,f10.5,e12.5,f10.5,f12.6) 1 continue c + return + end + subroutine cf_pr_pmf(lfnout,ipmf,upmf) +c + implicit none +c +#include "cf_common.fh" +c + integer lfnout,ipmf(numpmf,8) + real*8 upmf(numpmf) +c + integer i,j,nup + real*8 up +c + if(me.eq.0) then + write(lfnout,1000) + 1000 format(/,'Solute potentials of mean force',//, + + ' i U',/) + do 1 i=1,numpmf + up=zero + nup=0 + do 2 j=1,numpmf + if(ipmf(j,8).eq.i) then + up=up+upmf(j) + nup=nup+1 + endif + 2 continue + if(nup.eq.0) goto 3 + write(lfnout,1001) i,up + 1001 format(i7,e12.5) + 1 continue + 3 continue + endif return end subroutine cf_fix(lfnout,lfn,numfix,iwgmn,iwdt,numw, diff --git a/src/cafe/cf_shake.F b/src/cafe/cf_shake.F index d878795608..894fa7a94c 100644 --- a/src/cafe/cf_shake.F +++ b/src/cafe/cf_shake.F @@ -1,5 +1,5 @@ subroutine cf_shakew(xw,yw,iwgm,iwdt,numw) -c $Id: cf_shake.F,v 1.21 2002-04-06 14:30:30 d3j191 Exp $ +c $Id: cf_shake.F,v 1.22 2002-08-09 22:16:13 d3j191 Exp $ implicit none c #include "cf_common.fh" @@ -79,7 +79,7 @@ c integer nums real*8 xs(msa,3),ys(msa,3) integer isgan(msa),isat(msa) - integer ipmf(numpmf,7),jpmf(numpmf,4,npmfa) + integer ipmf(numpmf,8),jpmf(numpmf,4,npmfa) real*8 rpmf(3,6,numpmf),xpmf(4,4,numpmf),ypmf(4,3,numpmf) real*8 wgt(mat,6),ft(4,3),rv(2),w(4) integer ip(3),it(2),ign(4),iml(4),idt(4),ich(4)