SUBROUTINE FLUIDS(UNITS,T,P,H,S,X,V,U,MU,K,NREF,ITYPE) C****************************************************************** C* THIS SUBROUTINE CALCULATES THE THERMODYNAMIC PROPERTIES * C* OF MANY DIFFERENT REFRIGERANTS. THE REFRIGERANT OPTIONS * C* ARE R11,R12,R13,R14,R22,R114,R134a,R500,R502,AND * C* AMMONIA(R717). THE UNITS VARIABLE TELLS THE SUBROUTINE * C* WHETHER TO USE ENGLISH('EN') OR 'SI' UNITS. THE * C* VARIABLE NREF REFERS TO THE NUMBER OF THE REFRIGERANT * C* FOR WHICH PROPERTIES ARE WANTED. THE VARIABLE ITYPE * C* TELLS THE ROUTINE WHICH TWO VARIABLES ARE TO BE USED TO * C* CALCULATE THE OTHER PROPERTIES. THE FIRST NUMBER * C* DENOTES THE FIRST PROPERTY AND THE SECOND DENOTES THE * C* OTHER PROPERTY. THE FIRST PROPERTY IS T AND THE LAST IS * C* U. THEREFORE, IF P AND S ARE THE KNOWN PROPERTIES, THEN * C* ITYPE IS 24. IF V AND U ARE KNOWN, THEN ITYPE IS 67. * C* TEMPERATURES AER ENTERED IN EITHER CELSIUS OR FAHRENHEIT * C* DEPENDING ON WHICH UNIT SYSTEM IS TO BE USED. * C* * C* ROUTINE MODIFIED BY TIM MCDOWELL, SUMMER 1992 * C****************************************************************** EXTERNAL THCON,TSCON,SVCON,XVCON,SXCON,HXCON,PSCON,PHCON LOGICAL ERROR DIMENSION Q(71) COMMON /CONST/ Q COMMON /LUNITS/LUR,LUW,IFORM,LUK DATA IMAX/100/,JMAX/10/,TOL/0.0001/ REAL MU,K CHARACTER*2 UNITS C ERROR=.FALSE. IF (UNITS.EQ.'SI') CALL REVERT(V,T,P,H,S,X,U,MU,K) CALL FILL(NREF) J=ITYPE/10 L=ITYPE-J*10 IF(J.NE.1.AND.L.NE.1)GO TO 100 T=T+Q(44) C T,X KNOWN 100 IF(ITYPE.EQ.51.OR.ITYPE.EQ.15)GO TO 111 C T,P KNOWN IF(ITYPE.EQ.21.OR.ITYPE.EQ.12)GO TO 121 C T,V KNOWN IF(ITYPE.EQ.61.OR.ITYPE.EQ.16)GO TO 131 C P,V KNOWN IF(ITYPE.EQ.62.OR.ITYPE.EQ.26)GO TO 141 C P,X KNOWN IF(ITYPE.EQ.52.OR.ITYPE.EQ.25)GO TO 151 C T,H GIVEN IF(ITYPE.EQ.31.OR.ITYPE.EQ.13)GO TO 161 C T,S KNOWN IF(ITYPE.EQ.14.OR.ITYPE.EQ.41)GO TO 171 C S,V KNOWN IF(ITYPE.EQ.64.OR.ITYPE.EQ.46)GO TO 181 C V,X KNOWN IF(ITYPE.EQ.56.OR.ITYPE.EQ.65)GO TO 191 C S,X KNOWN IF(ITYPE.EQ.45.OR.ITYPE.EQ.54)GO TO 201 C H,X KNOWN IF(ITYPE.EQ.35.OR.ITYPE.EQ.53)GO TO 211 C P,S KNOWN IF(ITYPE.EQ.24.OR.ITYPE.EQ.42)GO TO 221 C P,H KNOWN IF(ITYPE.EQ.23.OR.ITYPE.EQ.32)GO TO 231 C H,S KNOWN IF(ITYPE.EQ.34.OR.ITYPE.EQ.43)GO TO 241 C C T,X KNOWN FIND LIQUID SPECIFIC VOLUME C 111 VL=1./DLIQ(T) P=VPR(T) CALL SPVOL(T,P,VV) V=VL+X*(VV-VL) DH=DHLAT(T,VV,VL,P) CALL ENTHAL(HV,P,VV,T) H=HV-(1.-X)*DH DS=DH/T CALL ENTROP(SVAP,T,VV) S=SVAP-(1.-X)*DS GO TO 1000 C C T,P KNOWN FIND VAPOR PRESSURE ASSUME SUPERHEAT C 121 CALL SPVOL(T,P,V) CALL ENTHAL(H,P,V,T) CALL ENTROP(S,T,V) X=1.5E+38 GO TO 1000 C C T,V KNOWN C 131 IF(T.GT.Q(42))GO TO 22 PV=VPR(T) CALL SPVOL(T,PV,VV) 20 IF(V-VV)21,21,22 21 P=PV VL=1./DLIQ(T) X=(V-VL)/(VV-VL) DH=DHLAT(T,VV,VL,P) DS=DH/T CALL ENTHAL(HV,P,VV,T) H=HV-(1.-X)*DH CALL ENTROP(SV,T,VV) S=SV-(1.-X)*DS GO TO 1000 C IF SUPERHEAT 22 X=1.5E+38 P=PR(T,V) 23 CALL ENTHAL(H,P,V,T) CALL ENTROP(S,T,V) GO TO 1000 C C P,V KNOWN C 141 IF(P.GT.Q(41))GO TO 45 CALL TSAT(P,TV) CALL SPVOL(TV,P,VV) IF(V-VV)44,44,45 C IF SATURATED 44 T=TV VL=1./DLIQ(T) X=(V-VL)/(VV-VL) DH=DHLAT(T,VV,VL,P) CALL ENTHAL(HV,P,VV,T) H=HV-(1.-X)*DH DS=DH/T CALL ENTROP(SV,T,VV) S=SV-(1.-X)*DS GO TO 1000 C IF SUPERHEAT 45 X=1.5E+38 ITER=0 T1=Q(42) 42 XT=PR(T1,V)-P ITER=ITER+1 DT=DPDT(T1,V) T=T1-(XT/DT) Z=ABS(T-T1) T1=T IF(ITER.GT.IMAX) THEN ERROR=.TRUE. GO TO 43 ENDIF IF(Z-.001)43,43,42 43 CONTINUE CALL ENTHAL(H,P,V,T) CALL ENTROP(S,T,V) GO TO 1000 C C P,X KNOWN C 151 CALL TSAT(P,T) VL=1./DLIQ(T) CALL SPVOL(T,P,VV) V=VV-(1.-X)*(VV-VL) CALL ENTHAL(HV,P,VV,T) DH=DHLAT(T,VV,VL,P) H=HV-(1.-X)*DH DS=DH/T CALL ENTROP(SV,T,VV) S=SV-(1.-X)*DS GO TO 1000 C C T,H KNOWN C 161 IF(T.GT.Q(42))GO TO 61 PV=VPR(T) CALL SPVOL(T,PV,VV) CALL ENTHAL(HV,PV,VV,T) IF(H-HV)65,65,61 C FOR SUPERHEAT 61 X=1.5E+38 V=Q(43) CALL SOLVE(T,H,V,THCON,TOL,IFLAG) IF(IFLAG.EQ.1) ERROR=.TRUE. P=PR(T,V) CALL ENTROP(S,T,V) GO TO 1000 C IF SATURATED 65 VL=1./DLIQ(T) P=PV DH=DHLAT(T,VV,VL,P) X=1.-(HV-H)/DH V=VV-(1.-X)*(VV-VL) DS=DH/T CALL ENTROP(SV,T,VV) S=SV-(1.-X)*DS GO TO 1000 C C T,S KNOWN C 171 PV=VPR(T) CALL SPVOL(T,PV,VV) CALL ENTROP(SV,T,VV) IF(S-SV)75,75,71 C FOR SUPERHEAT 71 X=1.5E+38 V=VV CALL SOLVE(T,S,V,TSCON,TOL,IFLAG) IF(IFLAG.EQ.1) ERROR=.TRUE. P=PR(T,V) CALL ENTHAL(H,P,V,T) GO TO 1000 75 VL=1./DLIQ(T) P=PV DH=DHLAT(T,VV,VL,P) DS=DH/T X=1.-(SV-S)/DS V=VV-(1.-X)*(VV-VL) CALL ENTHAL(HV,P,VV,T) H=HV-(1.-X)*DH GO TO 1000 C C S,V KNOWN C 181 T=500. CALL SOLVE(V,S,T,SVCON,TOL,IFLAG) IF(IFLAG.EQ.1) ERROR=.TRUE. P=PR(T,V) CALL ENTHAL(H,P,V,T) X=1.5E+38 GO TO 1000 C C X,V KNOWN C 191 T=500. CALL SOLVE(X,V,T,XVCON,TOL,IFLAG) IF(IFLAG.EQ.1) ERROR=.TRUE. P=VPR(T) CALL SPVOL(T,P,VV) VL=1./DLIQ(T) DH=DHLAT(T,VV,VL,P) CALL ENTHAL(HV,P,VV,T) H=HV-(1.-X)*DH DS=DH/T CALL ENTROP(SV,T,VV) S=SV-(1.-X)*DS GO TO 1000 C C S,X KNOWN C 201 T=500. CALL SOLVE(X,S,T,SXCON,TOL,IFLAG) IF(IFLAG.EQ.1) ERROR=.TRUE. P=VPR(T) CALL SPVOL(T,P,VV) VL=1./DLIQ(T) V=VV-(1.-X)*(VV-VL) CALL ENTHAL(HV,P,VV,T) DH=DHLAT(T,VV,VL,P) H=HV-(1.-X)*DH GO TO 1000 C C H,X KNOWN C 211 T=500. CALL SOLVE(X,H,T,HXCON,TOL,IFLAG) IF(IFLAG.EQ.1) ERROR=.TRUE. P=VPR(T) CALL SPVOL(T,P,VV) VL=1./DLIQ(T) V=VV-(1.-X)*(VV-VL) DS=DHLAT(T,VV,VL,P)/T CALL ENTROP(SV,T,VV) S=SV-(1.-X)*DS GO TO 1000 C C P,S KNOWN C 221 IF(P.GT.Q(41))GO TO 15 CALL TSAT(P,TS) CALL SPVOL(TS,P,VV) CALL ENTROP(SV,TS,VV) IF(S-SV)18,18,15 C FOR SATURATED 18 T=TS P=VPR(T) VL=1./DLIQ(T) DH=DHLAT(T,VV,VL,P) DS=DH/T X=1.-(SV-S)/DS V=VL+X*(VV-VL) CALL ENTHAL(HV,P,VV,T) H=HV-(1.-X)*DH GO TO 1000 15 X=1.5E+38 T=Q(42) CALL SOLVE(P,S,T,PSCON,TOL,IFLAG) IF(IFLAG.EQ.1) ERROR=.TRUE. CALL SPVOL(T,P,V) CALL ENTHAL(H,P,V,T) GO TO 1000 C C P,H KNOWN C 231 IF(P.GT.Q(41))GO TO 12 CALL TSAT(P,TS) CALL SPVOL(TS,P,VV) CALL ENTHAL(HV,P,VV,TS) IF(H-HV)11,11,12 C IF SATURATED 11 T=TS P=VPR(T) VL=1./DLIQ(T) DH=DHLAT(T,VV,VL,P) DS=DH/T X=1.-(HV-H)/DH V=VL+X*(VV-VL) CALL ENTROP(SV,T,VV) S=SV-(1.-X)*DS GO TO 1000 C IF SUPERHEAT 12 X=1.5E+38 T=Q(42) CALL SOLVE(P,H,T,PHCON,TOL,IFLAG) IF(IFLAG.EQ.1) ERROR=.TRUE. CALL SPVOL(T,P,V) CALL ENTROP(S,T,V) GO TO 1000 C C H,S KNOWN C 241 T=460. P=100.0 CALL HSCON(T,P,H,S,F,G) ENORM=F*F+G*G ITER=0 95 ITER=ITER+1 TOLD=T POLD=P FOLD=F GOLD=G T=TOLD+AMAX1(0.001,0.001*TOLD) P=POLD+AMAX1(0.001,0.001*POLD) CALL HSCON(T,POLD,H,S,F,G) DFDT=(F-FOLD)/(T-TOLD) DGDT=(G-GOLD)/(T-TOLD) CALL HSCON(TOLD,P,H,S,F,G) DFDP=(F-FOLD)/(P-POLD) DGDP=(G-GOLD)/(P-POLD) IF(ABS(DFDT*DGDP).GT.1.E-06 .OR. ABS(DGDT*DFDP).GT.1.E-06) THEN DP=2.*(FOLD*DGDT-GOLD*DFDT)/(DFDT*DGDP-DGDT*DFDP) DT=2.*(GOLD*DFDP-FOLD*DGDP)/(DFDT*DGDP-DGDT*DFDP) ELSE DP=0. DT=0. ENDIF J=0 ELAST=ENORM 98 J=J+1 DP=DP/2. DT=DT/2. P=AMAX1(AMIN1(POLD+DP,Q(41)),1.E-06) T=AMAX1(AMIN1(TOLD+DT,Q(42)),1.E-06) CALL HSCON(T,P,H,S,F,G) ENORM=F*F+G*G IF(ENORM.GT.ELAST .AND. J.LT.JMAX) GO TO 98 Z1=ABS(P-POLD) Z2=ABS(T-TOLD) IF(ITER.GT.IMAX) THEN ERROR=.TRUE. GO TO 96 ENDIF IF(Z1-.001)96,96,95 96 IF(Z2-.001)97,97,95 97 CONTINUE CALL SPVOL(T,P,V) X=1.5E+38 GO TO 1000 1000 CONTINUE U=H-P*V*(144./778.) CALL VISCON(T,X,MU,K) T=T-Q(44) IF(ERROR) WRITE(LUW,1001) ITYPE,T,P,H,S,X,V 1001 FORMAT(' ** WARNING - SOLUTION DID NOT CONVERGE **'/4X, . 'ITYPE = ',I2,' T, P, H, S, X, V =', . 3(1X,1PE11.3)/33X,3(1X,1PE11.3)) IF (UNITS.EQ.'SI') CALL CONVERT(V,T,P,H,S,X,U,MU,K) RETURN END C C SUBROUTINE FOR FINDING SPECIFIC VOLUME C SUBROUTINE SPVOL(TA,PA,VA) DIMENSION Q(71) COMMON /CONST/ Q DATA IMAX/50/ R=Q(14) V1=(R*TA)/PA ITER=0 5 X=PR(TA,V1)-PA ITER=ITER+1 DX=DPDV(TA,V1) VA=V1-(X/DX) Z=ABS(VA-V1) V1=VA IF(ITER.GT.IMAX) THEN WRITE(LUW,1001) TA,PA,VA,Z RETURN ENDIF IF(Z-.0001)10,10,5 10 CONTINUE 1001 FORMAT(' ** WARNING - SUBROUTINE SPVOL, SOLUTION DID NOT CON', . 'VERGE **'/4X,'T, P, V, ABS(V-VLAST) = ',4(1X,1PE11.3)) RETURN END C C SUBROUTINE FOR FINDING ENTHALPY C SUBROUTINE ENTHAL(H,P,V,T) DIMENSION Q(71) COMMON /CONST/ Q XJ=0.185053 T2=T**2/2.0 T3=T**3/3.0 T4=T**4/4.0 VB=AMAX1(AMIN1(V-Q(15),1.E+05),1.E-05) VB2=VB**2*2.0 VB3=VB**3*3.0 VB4=VB**4*4.0 XKT=Q(31)*T/Q(42) EKT=EXP(-XKT) AV=Q(32)*V C AVOID DIVIDING BY ZERO IF(AV.EQ.0.0 .OR. ABS(AV).GT.30.) GO TO 105 EAV=EXP(AV) IF(Q(33).EQ.0.0)GO TO 100 CLN=Q(33)*(ALOG(1.0+(1.0/(Q(33)*EAV)))) GO TO 110 100 CLN=0.0 GO TO 115 105 EAV=0.0 RX=0.0 RZ=0.0 CLN=0.0 GO TO 115 110 RX=(Q(28)/Q(32))*(1.0/EAV-CLN) RZ=Q(30)/(Q(32)*EAV)-Q(30)*CLN/Q(32) 115 H1=Q(34)*T+Q(35)*T2+Q(36)*T3+Q(37)*T4-Q(38)/(4.0*T2)+XJ*P*V H2=XJ*(Q(16)/VB+Q(19)/VB2+Q(22)/VB3+Q(25)/VB4+RX) H3=XJ*(Q(18)/VB+Q(21)/VB2+Q(24)/VB3+Q(27)/VB4+RZ)*(1.0+XKT)*EKT H=H1+H2+H3+Q(39) RETURN END C C SUBROUTINE FOR FINDING ENTROPY C SUBROUTINE ENTROP(S,T,V) DIMENSION Q(71) COMMON /CONST/ Q XJ=0.185053 R=Q(14) T2=T**2/2.0 T3=T**3/3.0 VB=AMAX1(AMIN1(V-Q(15),1.E+05),1.E-05) VB2=2.0*VB**2 VB3=3.0*VB**3 VB4=4.0*VB**4 XKT=Q(31)*T/Q(42) EKT=EXP(-XKT) AV=Q(32)*V IF(AV.EQ.0.0 .OR. ABS(AV).GT.30. .OR. Q(33).EQ.0.0)GO TO 100 EAV=EXP(AV) CLN=Q(33)*ALOG(1.0+(1.0/(Q(33)*EAV))) RX=(Q(29)/Q(32))*(1.0/EAV-CLN) IF(CLN.GT.1.E-20) THEN RZ=(Q(30)/Q(32))*EAV-Q(30)/(Q(32)*CLN) ELSE RZ=0. ENDIF GO TO 110 100 RX=0.0 RZ=0.0 EAV=0.0 CLN=0.0 110 G=Q(18)/VB+Q(21)/VB2+Q(24)/VB3+Q(27)/VB4+RZ S1=Q(34)*ALOG(T)+Q(35)*T+Q(36)*T2+Q(37)*T3-Q(38)/(2.0*T**2) S2=XJ*R*ALOG(VB) S3=-XJ*(Q(17)/VB+Q(20)/VB2+Q(23)/VB3+Q(26)/VB4+RX) S4=((XJ*Q(31)*EKT)/Q(42))*G S=S1+S2+S3+S4+Q(40) RETURN END C C SUBROUTINE FOR FINDING SATURATION TEMP AT A PRESSURE C SUBROUTINE TSAT(P,TS) EXTERNAL PCON DATA TOL/0.0001/ C TS=500. CALL SOLVE(0.,P,TS,PCON,TOL,IFLAG) IF(IFLAG.EQ.1) WRITE(LUW,1001) 1001 FORMAT(' ** WARNING - SUBROUTINE TSAT, SOLUTION DID ', . ' NOT CONVERGE **'/4X,'P, T =',2(1X,1PE11.3)) RETURN END C C C FUNCTION FOR FINDING LIQUID DENSITY AT A TEMPERATURE C FUNCTION DLIQ(T) DIMENSION Q(71) COMMON/CONST/Q TTC=AMAX1(1.-T/Q(42),0.) DLIQ=Q(1)+Q(2)*TTC**(1./3.)+Q(3)*TTC**(2./3.)+Q(4)*TTC @ +Q(5)*TTC**(4./3.)+Q(6)*TTC**0.5+Q(7)*TTC**2. RETURN END C C FUNCTION FOR FINDING VAPOR PRESSURE C FUNCTION VPR(T) DIMENSION Q(71) COMMON/CONST/Q IF(Q(13)-T)701,701,702 701 PL=Q(8)+Q(9)/T+Q(10)*LOG10(T)+Q(11)*T GO TO 703 702 PL=Q(8)+Q(9)/T+Q(10)*LOG10(T)+Q(11)*T+Q(12)*((Q(13)-T)/T) @*LOG10(Q(13)-T) 703 VPR=10**PL RETURN END C C FUNCTION FOR FINDING LATENT HEAT OF VAPORIZATION C FUNCTION DHLAT(T,VG,VF,P) DIMENSION Q(71) COMMON/CONST/Q XJ=0.185053 XLN10=2.302585093 XLOGE=0.4342944819 IF(Q(13)-T)711,711,712 711 E=Q(12)*(XLOGE/T) GO TO 713 712 E=Q(12)*(XLOGE/T+Q(13)*LOG10(Q(13)-T)/T**2) 713 DHLAT=XJ*T*(VG-VF)*(P*XLN10*(-Q(9)/T**2+Q(10)/(T*XLN10)+Q(11)-E)) RETURN END C C FUNCTION FINDING PRESSURE C FUNCTION PR(T,V) DIMENSION Q(71) COMMON/CONST/Q RI=Q(14) EKT=EXP(-Q(31)*T/Q(42)) VB=AMAX1(AMIN1(V-Q(15),1.E+05),1.E-05) AV=Q(32)*V IF(AV.EQ.0. .OR. ABS(AV).GT.30.) THEN P5=0. ELSE EAV=EXP(AV) P5=(Q(28)+Q(29)*T+Q(30)*EKT)/(EAV*(1.+Q(33)*EAV)) ENDIF P1=(RI*T)/VB+(Q(16)+Q(17)*T+Q(18)*EKT)/VB**2 P2=(Q(19)+Q(20)*T+Q(21)*EKT)/VB**3 P3=(Q(22)+Q(23)*T+Q(24)*EKT)/VB**4 P4=(Q(25)+Q(26)*T+Q(27)*EKT)/VB**5 PR=P1+P2+P3+P4+P5 RETURN END C C FUNCTION FOR FINDING DP/DV AT CONST T C FUNCTION DPDV(T,V) DIMENSION Q(71) COMMON/CONST/Q R=Q(14) EKT=EXP(-Q(31)*T/Q(42)) VB=AMAX1(AMIN1(V-Q(15),1.E+05),1.E-05) AV=Q(32)*V IF(AV.EQ.0. .OR. ABS(AV).GT.25.) THEN RR=0. ELSE EAV=EXP(AV) EAV2=EXP(2.0*AV) RR=-(Q(32)*EAV+2.0*Q(32)*Q(33)*EAV2)/(EAV+Q(33)*EAV2)**2 ENDIF DX1=-R*T/VB**2-2.0*(Q(16)+Q(17)*T+Q(18)*EKT)/VB**3 DX2=-3.0*(Q(19)+Q(20)*T+Q(21)*EKT)/VB**4 DX3=-4.0*(Q(22)+Q(23)*T+Q(24)*EKT)/VB**5 DX4=-5.0*(Q(25)+Q(26)*T+Q(27)*EKT)/VB**6 DX5=(Q(28)+Q(29)*T+Q(30)*EKT)*RR DPDV=DX1+DX2+DX3+DX4+DX5 RETURN END C C FUNCTION FINDING DP/DT AT CONST V C FUNCTION DPDT(T,V) DIMENSION Q(71) COMMON/CONST/Q R=Q(14) EKT=EXP(-Q(31)*T/Q(42)) VB=AMAX1(AMIN1(V-Q(15),1.E+05),1.E-05) AV=Q(32)*V IF(AV.EQ.0. .OR. ABS(AV).GT.30.) THEN TERM=0. ELSE EAV=EXP(AV) TERM=(Q(29)-TTC*Q(30))/(EAV*(1.+Q(33)*EAV)) ENDIF TTC=(Q(31)*EKT)/Q(42) DT1=R/VB+(Q(17)-TTC*Q(18))/VB**2 DT2=(Q(20)-TTC*Q(21))/VB**3 DT3=(Q(22)-TTC*Q(24))/VB**4 DT4=(Q(26)-TTC*Q(27))/VB**5+TERM DPDT=DT1+DT2+DT3+DT4 RETURN END C SUBROUTINE FILL(NREF) INTEGER RTYPE(10) DIMENSION R717(71),R11(71),R12(71),R13(71),R14(71),R22(71) DIMENSION R114(71),R134a(71),R500(71),R502(71),Q(71) COMMON /CONST/ Q DATA RTYPE/717,11,12,13,14,22,114,134,500,502/,NRTYPE/10/ DATA NCOEF/71/,LAST/0/ C DATA R717/59.685,-240.50,600.64,-571.28,210.50,0.,0.,-6139.698, . 1.6448E1,-0.0008494,3.170,0.,0.,0.63,1.0082E-2,-69.672,3.5956E-2, . -1968.529,3.376,-1.3701E-3,128.141,-8.2319E-2,0.,0.,0., . 1.5469E-6,-4.6590E-2,0.,0.,0.,5.475,0.,0.,0.34322,-4.5867E-5, . 2.8841E-7,-9.0245E-11,0.,406.728647,-1.02202503,1640,729.77, . 0.06816,459.69,0.,2.,200.,1000.,3.6575E5,2.9975E4,1.2579E1, . -7.0761E-3,240.,390.,2.0822E3,-1.3582E1,3.1014E-2,-2.437E-5, . 2.,240.,900.,2.7287E-3,3.0187E-5,1.6195E-7,-6.3697E-11,244., . 406.,1.17130,-0.002315,0.,0./ C DATA R11/34.57,57.63811,43.6322,-42.82356,36.70663,0.,0., . 42.14702865,-4344.343807,-12.84596753,4.0083725E-03,0.0313605356, . 862.07,0.078117,0.00190,-3.126759,1.318523E-03,-35.76999, . -0.025341,4.875121E-05,1.220367,1.687277E-03,-1.805062E-06, . 0.,-2.358930E-05,2.448303E-08,-1.478379E-04,1.057504E08, . -9.472103E04,0.,4.50,580.,0.,0.023815,2.798823E-04,-2.123734E-07, . 5.999018E-11,-336.80703,50.5418,-0.0918395,639.5,848.07,0.028927, . 459.67,0.,1.,200.,380.,0.43547E-6,511.161E-6,-50128.E-6,0., . 230.,500.,17578.,-151.49,0.44774,-4.4568E-4,2.,270.,420., . 0.00597101,2.28456E-5,0.,0.,165.,390.,0.86824485,-2.81E-4,0.,0./ C DATA R12/34.84,53.341187,0.,18.69137,0.,21.98396,-3.150994, . 39.88381727,-3436.632228,-12.47152228,4.73044244E-03,0.,0., . 0.088734,0.0065093886,-3.40972713,1.59434848E-03,-56.7627671, . 0.0602394465,-1.87961843E-05,1.31139908,-5.4873701E-04,0.,0.,0., . 3.468834E-09,-2.54390678E-05,0.,0.,0.,5.475,0.,0.,8.0945E-03, . 3.32662E-04,-2.413896E-07,6.72363E-11,0.,39.556551, . -0.016537936,596.9,693.3,0.0287,459.7,0.,1.,250.,470., . 0.75309E-6,188.969E-6,-803.786E-6,0.,170.,340.,9621.3,-89.526, . 0.28593,-3.0681E-4,1.,244.45,477.78,313.340951,2.967962841E5, . 4.340553017E7,0.,144.,344.,0.1782729,-0.000366,0.,0./ C DATA R13/36.06996,54.395124,0.,8.512776,0.,25.879906,9.589006, . 25.967975,-2709.538217,-7.17234391,2.545154E-03,0.280301091, . 546.0,0.102728,0.0048,-3.083417,2.341695E-03,-18.212643,0.058854, . -5.671268E-05,.571958,-1.026061E-03,1.338679E-06,0.,5.290649E-06, . -7.395111E-09,-3.874233E-05,7.378601E07,-7.435565E04,0.,4.0,625., . 0.,0.01602,2.823E-04,-1.159E-07,0.,0.,20.911,-0.05676,561.3, . 543.62,0.02772,459.69,0.,0.,200.,300.,6152.7,-68.413,0.2656, . -3.511E-4,1.,220.,423.,0.41108E-6,328.51E-6,-27963.E-6,1.,222.23, . 533.34,394.5134982,1.679399269E5,4.243215045E7,0.,94.,270., . 0.1922843,-0.000522,0.,0./ C DATA R14/39.06,69.568489,4.5866114,36.1716662,-8.058986,0.,0., . 20.71545389,-2467.505285,-4.69017025,6.4798076E-04,0.770707795, . 424.,0.1219336,0.0015,-2.162959,2.135114E-03,-18.941131, . 4.404057E-03,1.282818E-05,0.539776,1.921072E-04,-3.918263E-07, . 0.,-4.481049E-06,9.062318E-09,-4.836678E-05,5.838823E07, . -9.263923E04,0.,4.,661.199997,0.,0.0300559282,2.3704335E-04, . -2.85660077E-08,-2.95338805E-11,0.,86.102162,0.36172528,543.16, . 409.5,0.0256,459.69,0.,0.,-1.,0.,0.,0.,0.,0.,230.,500., . 0.64625E-6,103.E-6,-3.42714E-6,1.,2.,144.26,533.15, . -0.006291594,7.40511E-5,0.,0.,140.,210.,0.2155348,0.000792, . 0.,0./ C DATA R22/32.76,54.634409,36.74892,-22.2925657,20.4732886,0.,0., . 29.35754453,-3845.193152,-7.8610322,2.1909390E-03, . 0.445746703,686.1,0.124098,0.002,-4.353547,2.407252E-03, . -44.066868,-0.017464,7.62789E-05,1.483763,2.310142E-03, . -3.605723E-06,0.,-3.724044E-05,5.355465E-08,-1.845051E-04, . 1.363387E08,-1.672612E05,0.,4.2,548.2,0.,0.02812836,2.255408E-04, . -6.509607E-08,0.,257.341,62.4009,-0.0453335,721.91,664.5, . 0.030525,459.69,0.,0.,170.,360.,5765.2,-53.815,0.17657, . -1.9663E-4,250.,440.,0.61943E-6,239.551E-6,-7605.74E-6,1.,2., . 233.,644.,-0.007,6.E-5,0.,0.,144.,340.,0.23530925,-0.000495, . 0.,0./ C DATA R114/36.32,61.146414,0.,16.418015,0.,17.476838,1.119828, . 27.071306,-5113.7021,-6.3086761,6.91003E-04,0.78142111,768.35, . 0.062780807,0.005914907,-2.3856704,1.0801207E-03,-6.5643648, . 0.034055687,-5.3336494E-06,0.16366057,-3.857481E-04,0.,0., . 1.6017659E-06,6.2632341E-10,-1.0165314E-05,0.,0.,0.,3.,0.,0., . 0.0175,3.49E-04,-1.67E-07,0.,0.,25.3396621,-0.11513718,477.2, . 753.97,0.027531,459.69,0.,0.,170.,410.,36213.,-335.24,1.0344, . -1.0556E-3,230.,500.,0.51357E-6,434.124E-6,-41996.E-6,1.,2., . 283.,673.,6.1999E-3,-3.6584E-5,1.9178E-7,-7.9248E-11,183., . 360.,0.14229215,-0.000261,0.,0./ C DATA R134a/31.976,51.16709,63.90010,-72.21399,49.30054,0.,0., . -6.03623E3,1.64299E1,-1.61558E-3,2.78366,0.,0.,0.1051781, . 0.005535127,-4.447446,0.002352,-131.4301,0.08630833, . -2.961652E-5,3.856549,-0.1001713E-2,0.,0.,-1.063691E-6, . 1.079076E-8,-0.3137839E-3,0.,0.,0.,5.475,0.,0.,0.02597217, . 0.00033646,-9.37488E-8,0.,0.,50.373666,-0.094348,589.8,637.65, . 0.03127346,459.68,0.,2.,280.,433.,-5.46570359E7,4.93532754E5, . -1.23854989E3,1.11163505,250.,355.,5663.5,-45.178,1.2616E-1, . -1.2065E-4,2.,250.,350.,29.742E-3,-0.17962E-3,0.42648E-6,0., . 293.,350.,0.2049,-0.000417438,0.,0./ C DATA R500/31.0,43.562,74.709,-87.583,56.483,0.,0.,17.780935, . -3422.69717,-3.63691,5.0272207E-04,0.4629401,695.57,0.10805, . 0.006034229,-4.549888,2.308415E-03,-92.90748,0.08660634, . -3.141665E-05,2.742282,-8.726016E-04,0.,0.,-1.375958E-06, . 9.149570E-09,-2.102661E-04,0.,0.,0.,5.475,0.,0.,0.026803537, . 2.8373408E-04,-9.7167893E-08,0.,0.,46.4734,-0.09012707564,646.3, . 681.59,0.032256,459.67,0.,0.,200.,370.,6595.3,-59.043,0.18478, . -1.9714E-4,240.,390.,-2.22841E6,0.052918E6,-1.57563E1,2.,-1., . -1.,-1.,-1.,-1.,-1.,-1.,290.,335.,0.1922211,-0.000394,0.,0./ C DATA R502/35.0,53.48437,63.86417,-70.08066,48.47901,0.,0., . 10.64495494,-3671.15381257,-0.36983496,-0.0017463519,0.81611391, . 654.,0.096125,0.00167,-3.2613344,0.0020576287,-24.24879, . 0.034866748,-0.86791313E-05,0.33274779,-8.5765677E-04, . 7.0240549E-07,0.022412368,8.8368967E-06,-7.9168095E-09, . -3.7167231E-04,-3.8257766E07,5.5816094E04,1.5378377E09,4.2,609., . 7.E-07,0.020419,2.996802E-04,-1.409043E-07,2.210861E-11,0., . 35.308,-0.07444,591.,639.56,0.028571,459.67,0.,0.,200.,350., . 5897.9,-52.528,0.16488,-1.7785E-4,220.,390.,0.6997E-6, . 192.77E-6,20.394E-6,1.,2.,228.,380.,-0.01118,1.25755E-4, . -2.68221E-7,3.44533E-10,280.,320.,0.18100165,-0.000391,0.,0./ C IGO=0 DO 5 I=1,NRTYPE IGO=IGO+1 IF(NREF.EQ.RTYPE(IGO)) GO TO 100 5 CONTINUE C WRITE(LUW,11) 11 FORMAT(///' ** ERROR - NO PROPERTIES FOR THIS REFRIGERANT **') STOP C 100 IF(IGO.EQ.LAST) RETURN LAST=IGO GO TO (105,110,120,130,140,150,160,167,170,180) ,IGO C 105 DO 108 T=1,NCOEF Q(I)=R717(I) 108 CONTINUE GO TO 500 C 110 DO 115 I=1,NCOEF Q(I)=R11(I) 115 CONTINUE GO TO 500 C 120 DO 125 I=1,NCOEF Q(I)=R12(I) 125 CONTINUE GO TO 500 C 130 DO 135 I=1,NCOEF Q(I)=R13(I) 135 CONTINUE GO TO 500 C 140 DO 145 I=1,NCOEF Q(I)=R14(I) 145 CONTINUE GO TO 500 C 150 DO 155 I=1,NCOEF Q(I)=R22(I) 155 CONTINUE GO TO 500 C 160 DO 165 I=1,NCOEF Q(I)=R114(I) 165 CONTINUE GO TO 500 C 167 DO 168 I=1,NCOEF Q(I)=R134a(I) 168 CONTINUE GO TO 500 C 170 DO 175 I=1,NCOEF Q(I)=R500(I) 175 CONTINUE GO TO 500 C 180 DO 185 I=1,NCOEF Q(I)=R502(I) 185 CONTINUE C 500 CONTINUE RETURN END C C SUBROUTINE SOLVE(Y1,Y2,XNEW,FUNC,TOL,IFLAG) EXTERNAL FUNC DATA IMAX/100/,JMAX/10/ C IFLAG=0 C C C Iterate using Newton's method with damping C ITER=0 CALL FUNC(Y1,Y2,XNEW,FNEW) C 5 ITER=ITER+1 C C Determine numerical approximation to derivative C X=XNEW F=FNEW C XNEW=X+AMAX1(TOL,X*TOL) CALL FUNC(Y1,Y2,XNEW,FNEW) DFDX=(FNEW-F)/(XNEW-X) DX=2.*F/DFDX C C Determine new guess but don't accept if there is an increase in C the residual error ---> "damping" C J=0 40 CONTINUE J=J+1 DX=DX/2. XNEW=X-DX CALL FUNC(Y1,Y2,XNEW,FNEW) IF(ABS(FNEW).GT.ABS(F) .AND. J.LT.JMAX) GO TO 40 70 CONTINUE C C Check for convergence C ERROR=ABS(DX/XNEW) IF(ERROR.GT.TOL .AND. ABS(DX).GT.1.E-06 . .AND. ITER.LT.IMAX) GO TO 5 C IF(ITER.EQ.IMAX) IFLAG=1 RETURN END C SUBROUTINE THCON(T,H,V,F) P=PR(T,V) CALL ENTHAL(HNEW,P,V,T) F=HNEW-H RETURN END C SUBROUTINE TSCON(T,S,V,F) CALL ENTROP(SNEW,T,V) F=SNEW-S RETURN END C SUBROUTINE SVCON(V,S,T,F) CALL ENTROP(SNEW,T,V) F=SNEW-S RETURN END C SUBROUTINE XVCON(X,V,T,F) P=VPR(T) CALL SPVOL(T,P,VV) VL=1./DLIQ(T) F=VV-(1.-X)*(VV-VL)-V RETURN END C SUBROUTINE SXCON(X,S,T,F) P=VPR(T) CALL SPVOL(T,P,VV) VL=1./DLIQ(T) CALL ENTROP(SVAP,T,VV) DS=DHLAT(T,VV,VL,P)/T F=SVAP-(1.-X)*DS-S RETURN END C SUBROUTINE HXCON(X,H,T,F) P=VPR(T) CALL SPVOL(T,P,VV) VL=1./DLIQ(T) CALL ENTHAL(HV,P,VV,T) F=HV-(1.-X)*DHLAT(T,VV,VL,P)-H RETURN END C SUBROUTINE PSCON(P,S,T,F) CALL SPVOL(T,P,V) CALL ENTROP(SNEW,T,V) F=SNEW-S RETURN END C SUBROUTINE PHCON(P,H,T,F) CALL SPVOL(T,P,V) CALL ENTHAL(HNEW,P,V,T) F=HNEW-H RETURN END C SUBROUTINE PCON(DUM,P,T,F) F=VPR(T)-P RETURN END C SUBROUTINE HSCON(T,P,H,S,F,G) CALL SPVOL(T,P,V) CALL ENTROP(SGUESS,T,V) CALL ENTHAL(HGUESS,P,V,T) F=SGUESS-S G=HGUESS-H RETURN END C SUBROUTINE VISCON(T,X,MU,K) DIMENSION Q(71) COMMON /CONST/ Q REAL MU,K C TK=T/1.8 IF (X.GE.1) THEN MU=Q(49)+Q(50)*TK+Q(51)*TK**2+Q(52)*TK**3 MU=MU/1.E12 K=Q(62)+Q(63)*TK+Q(64)*TK**2+Q(65)*TK**3 RETURN END IF IF (X.LE.0) THEN MU=Q(55)+Q(56)*TK+Q(57)*TK**2+Q(58)*TK**3 MU=MU/1.E6 K=Q(68)+Q(69)*TK+Q(70)*TK**2+Q(71)*TK**3 RETURN END IF MU=999. K=999. RETURN END C SUBROUTINE CONVERT(V,T,P,H,S,X,U,C,K) IMPLICIT REAL*8 (A-H,O-Z) C V = V*0.0624280 T = (T-32)*5/9 P = P*6.8947E3/1.E6 H = H*2.326 S = S*4.1868 U = U*2.326 RETURN END C SUBROUTINE REVERT(V,T,P,H,S,X,U,C,K) IMPLICIT REAL*8 (A-H,O-Z) C V = V*16.0185 T = T*9/5+32 P = (P/1.E6)*1.45038E-4 H = H*0.429923 S = S*0.238846 U = U*0.429923 RETURN END