DO 2000 J=1,2
DO 2001 I =1,2
XA(J,I)=6.*ZA(I)*ZA(J)*A*SQ
X=XA(J,I)
IF (X.LT.1.) THEN
ZZ=4.*X**0.2-2.0
DZ=.8*X**(-.8)
DO 2002 K=20,0,-1
B(K)=ZZ*B(K+1)-B(K+2)+AKI(K)
D(K)=B(K+1)+ZZ*D(K+1)-D(K+2)
2002
CONTINUE
ELSE
ZZ=40./9.*X**(-.1)-22./9.
DZ=-40./90.*X**(-1.1)
DO 2003 K=20,0,-1
B(K)=ZZ*B(K+1)-B(K+2)+AKII(K)
D(K)=B(K+1)+ZZ*D(K+1)-D(K+2)
2003
CONTINUE
END IF
XJ(J,I)=.25*X-1.+.5*(B(0)-B(2))
XJPRIM(J,I)=.25+.5*DZ*(D(0)-D(2))
2001
CONTINUE
2000
CONTINUE
ETHETA=(Z1*Z2/4./UM)*(XJ(1,2)-.5*XJ(1,1)-.5*XJ(2,2))
ETHPRI=-ETHETA/UM+(Z1*Z2/8./UM**2)*(XA(1,2)*XJPRIM(1,2)-
$
.5*XA(1,1)*XJPRIM(1,1)-.5*XA(2,2)*XJPRIM(2,2))
PHIPHI=THETA+ETHETA+UM*ETHPRI
PHIIJ=THETA+ETHETA
PHIPRI=ETHPRI
RETURN
END
C------------------------------------------------------------------C
C------------------------------------------------------------------C
SUBROUTINE PITZER (T,IFLAG,EX)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION A0M(6),NMM(40),NAQ(20),Z(20),EX(20)
DIMENSION BPRIME(10,10),BPHI(10,10),C(10,10),PHIIJ(10,10),
$ SUMCA(10),SUMCAT(10),SUMAN(10),SUMZ(10),SUMAC(10),ACT(20),
$ PHIPHI(10,10),PHIPRI(10,10),XM(40),IZ(20)
DIMENSION SUMAA(10),SUMCC(10),SUMK(10)
DIMENSION BET0(10,10),BET1(10,10),C0(10,10), BET2(10,10),
$ TET(10,10),PSI(10,10,10),B(10,10)
DIMENSION BET0M(10,10,6),BET1M(10,10,6),C0M(10,10,6),
$ BET2M(10,10,6),TETM(10,10,6),PSIM(10,10,10,6)
COMMON /NUMBER/NCAT,NANI,NNEI,NMM
18
Previous Page
