From 73d8cbcbad0a0c17c63d8c792a42f477166751b4 Mon Sep 17 00:00:00 2001
From: Tjerk Straatsma <straatsmatp@ornl.gov>
Date: Tue, 6 Nov 2001 15:40:17 +0000
Subject: [PATCH] Pressure scaling option for xy or z only

---
 src/cafe/cf_common.fh |  6 +++---
 src/cafe/cf_init.F    |  5 +++--
 src/cafe/cf_main.F    | 10 +++++++---
 3 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/src/cafe/cf_common.fh b/src/cafe/cf_common.fh
index 23ff9ccb78..4908841ac4 100644
--- a/src/cafe/cf_common.fh
+++ b/src/cafe/cf_common.fh
@@ -1,4 +1,4 @@
-c $Id: cf_common.fh,v 1.27 2001-07-31 17:58:18 d3j191 Exp $
+c $Id: cf_common.fh,v 1.28 2001-11-06 15:40:15 d3j191 Exp $
 c
       real*8 zero,tiny,small
       real*8 fourth,third,half,one,two,three,four,six,twelve
@@ -102,7 +102,7 @@ c
       integer lpww,lpsw,lpss,ngrsw,ngrss,nrwrec
       integer isolvo,npww,npsw,npss,ipme,morder,ngx,ngy,ngz,ngmax
       integer ipolt,niterw,niters,mshitw,mshits,noshak
-      integer itscal,ipscal,islow,mdalgo,ntest,numpmf,npmfa,npgdec
+      integer itscal,ipscal,ipopt,islow,mdalgo,ntest,numpmf,npmfa,npgdec
       real*8 box(3),boxh(3),vlat(3,3),vlati(3,3),rshrt,rlong,rrest,
      + rqmmm,rshrt2,rlong2,rrest2,rqmmm2,deriv(24,2),ep2(2),ep3(2),
      + dfrdf,ewwl(2),zw(3,3,2),rffww,ewwr(2),drdf,ealpha,ewwq(2),rdfvol,
@@ -129,7 +129,7 @@ c
      + ngc,ngl,nfrdf,ifstep,ngrww,ireact,npener,ipme,lpww,lpsw,
      + lpss,ngrsw,ngrss,nrwrec,isolvo,npww,npsw,npss,morder,
      + ngx,ngy,ngz,ngmax,ipolt,niterw,niters,mshitw,mshits,noshak,
-     + itscal,ipscal,islow,mdalgo,ntest,numpmf,npmfa,npgdec,
+     + itscal,ipscal,ipopt,islow,mdalgo,ntest,numpmf,npmfa,npgdec,
      + llww,lsww,llsw,lssw,llss,lsss,
      + llist,lpair,ltwin,llong,lssscl,lpmf,lpmfc,lanal,
      + ithint,ith,ipert2,ipert3,ip2,ip3
diff --git a/src/cafe/cf_init.F b/src/cafe/cf_init.F
index 6e6b32fd9b..f8f82ee86b 100644
--- a/src/cafe/cf_init.F
+++ b/src/cafe/cf_init.F
@@ -2,10 +2,10 @@
      + nwmi,mwmi,nwai,mwai,nsfi,msfi,nsmi,msmi,nsai,msai,
      + mdalg,npbt,nbxt,rcs,rcl,rqm,bx,
      + jpme,jorder,jgx,jgy,jgz,nodpme,spmet,step,tols,mshw,mshs,nosh,
-     + iiqmmm,iipolt,iitmps,iiprss,rtmpx,rprsx,rtmpw,rtmps,rpres,
+     + iiqmmm,iipolt,iitmps,iiprss,iipopt,rtmpx,rprsx,rtmpw,rtmps,rpres,
      + iislow,tempi,tempwi,tempsi,compr,ntyp,idset,ipset1,ipset2,
      + issscl,delta,nfanal,lpbc,npgi,fldi,fvec,ffrq,npenrg,ictrl)
-c $Id: cf_init.F,v 1.62 2001-07-31 17:58:19 d3j191 Exp $
+c $Id: cf_init.F,v 1.63 2001-11-06 15:40:17 d3j191 Exp $
       implicit none
 c
 #include "cf_common.fh"
@@ -39,6 +39,7 @@ c
 c
       itscal=iitmps
       ipscal=iiprss
+      ipopt=iipopt
       tmpext=rtmpx
       prsext=rprsx
       tmwrlx=rtmpw
diff --git a/src/cafe/cf_main.F b/src/cafe/cf_main.F
index 289c821895..190fafd3e1 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.111 2001-10-25 19:45:56 d3j191 Exp $
+c $Id: cf_main.F,v 1.112 2001-11-06 15:40:17 d3j191 Exp $
       implicit none
 c
 #include "cf_common.fh"
@@ -826,14 +826,18 @@ c
       pscx(1)=pscale
       pscx(2)=pscale
       pscx(3)=pscale
-      if(iabs(ipscal).gt.1) then
+      if(ipscal.ne.0) then
       do 17 i=1,3
       prssc3=facpsc*(three*prx(i,i)-prsext)+one
       if(prssc3.lt.small) prssc3=small
       pscx(i)=prssc3**third
    17 continue
       endif
-      if(ipscal.lt.0) pscx(3)=one
+      if(ipopt.eq.12) then
+      pscx(1)=one
+      pscx(2)=one
+      endif
+      if(ipopt.eq.3) pscx(3)=one
       pscale=pscx(1)*pscx(2)*pscx(3)
 c
       if(np.gt.1) then