Print pmf energies

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,

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))

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)

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,

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)