Pressure scaling option for xy or z only

This commit is contained in:
Tjerk Straatsma 2001-11-06 15:40:17 +00:00
parent 7e6ab23b19
commit 73d8cbcbad
3 changed files with 13 additions and 8 deletions

View file

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

View file

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

View file

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