27
Z=0D0
RETURN
ENDIF
ZZZ=Z12+(320D0-T)**2*1.875D-5
BEFF=X11*B11+X12*ZZZ*(B11+B22)+2.*X13*Z13*DSQRT(BA13)+
*X22*B22+2.*X23*B23+X33*B33
END
SUBROUTINE CBER(T,H,CEFF,Z)
IMPLICIT REAL*8(A-H,O-Z)
COMMON/CBLOK/CR111H0(3),CR111H1(3),CR111H2(3),CR222(3),CR223(3),
*CR233(3),CR333(3)
COMMON/ZETA/Z12,Z13,Y12,Y13,Y123
COMMON/XBLOK/X1,X2,X3,X11,X12,X13,X22,X23,X33
T2=T*T
C111=CR111 H0(1)+CR111H0(2)*T+CR111H0(3)*T2+
*(CR111H1(1)+CR111H1(2)*T+CR111H1(3)*T2)*H+
*(CR111H2(1)+CR111H2(2)*T+CR111H2(3)*T2)H*H
C222=CR222(1)+CR222(2)*T+CR222(3)*T2
C223=CR223(1)+CR223(2)*T+CR223(3)*T2
C233=CR233(1)+CR233(2)*T+CR233(3)*T2
C333=CR333(1)+CR333(2)*T+CR333(3)*T2
CA112=C111*C111*C222
CA113=C111*C111*C333
CA122=C111*C222*C222
CA123=C111*C222*C333
CA133=C111<C333*C333
IF(CA112.LT.0D0.OR.CA113.LT.0D0.OR.CA122.LT.0DO0.OR.
*CA123.LT.0D0.OR.CA133.LT.0D0)THEN
Z=0D0
RETURN
ENDIF
D3REP=1D0/3D0
CEFF=X1*X11*C111+3D0*X11*X2*(CA112)**D3REP*(Y12+(T-270D0)*.0013D0)
*+3.*X11*X3*(CA113)**D3REP*Y13+
*3.*X1*X22*(CA122)**D3REP*(Y12+(T-270D0)*.0013D0)+
*6.*X1*X2*X3*(CA123)**D3REP*Y123+3.*X1*X33*(CA133)**D3REP*Y13+
*X22*X2*C222+3.*X22*X3*C223+3.*X2*X33*C233+X3*X33*C333
END
С Подпрограмма, реализующая схему Кардано для определения
С фактора сжимаемости из уравнения состояния
SUBROUTINE ITER2(P,T,Bm,Cm,Z)
IMPLICIT REAL*8(A-H,O-Z)
B1=1D3*P/2.7715/T
B0=Bl*Bm
C0=Bl**2*Cm
A1=1D0+B0
A0=1D0+1.5*(B0+C0)
A01=A0**2-A1**3
IF(A01.LE.0D0) THEN
Z=0D0
RETURN
ENDIF