*=====PR22V71 ====1990.5.30==========================================* *=====PR22V81 ====1993.5.12==========================================* *=====PAR22 ======1993.3.10==========================================* C==================================================================== C May 2, 2001: modified by Ryo Akasaka for ver.12.1 C The following 18 functions were added but not implemented. C AKPD(8A), AKPDD(8B), AKTD(8C), AKTDD(8D), CVPD(7A), CVTD(7B), C EPSPD(2A), EPSPDD(2B), EPSTD(2C), EPSTDD(2D), GAMPD(9A), C GAMTD(9B), TPH2(6H), TPS2(6S), WPD(8E), WPDD(8F), WTD(8G), C WTDD(8H) C C------------------------------------------------- F8A = AKPD REAL FUNCTION AKPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='AKPD' IF (MESS.NE.0) CALL S99R22(FUN) AKPD=-1.0E+30 RETURN END C------------------------------------------------- F8B = AKPDD REAL FUNCTION AKPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='AKPDD' IF (MESS.NE.0) CALL S99R22(FUN) AKPDD=-1.0E+30 RETURN END C------------------------------------------------- F8C = AKTD REAL FUNCTION AKTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='AKTD' IF (MESS.NE.0) CALL S99R22(FUN) AKTD=-1.0E+30 RETURN END C------------------------------------------------- F8D = AKTDD REAL FUNCTION AKTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='AKTDD' IF (MESS.NE.0) CALL S99R22(FUN) AKTDD=-1.0E+30 RETURN END C------------------------------------------------- F7A = CVPD REAL FUNCTION CVPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='CVPD' IF (MESS.NE.0) CALL S99R22(FUN) CVPD=-1.0E+30 RETURN END C------------------------------------------------- F7B = CVTD REAL FUNCTION CVTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='CVTD' IF (MESS.NE.0) CALL S99R22(FUN) CVTD=-1.0E+30 RETURN END C------------------------------------------------- F2A = EPSPD REAL FUNCTION EPSPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='EPSPD' IF (MESS.NE.0) CALL S99R22(FUN) EPSPD=-1.0E+30 RETURN END C------------------------------------------------- F2B = EPSPDD REAL FUNCTION EPSPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='EPSPDD' IF (MESS.NE.0) CALL S99R22(FUN) EPSPDD=-1.0E+30 RETURN END C------------------------------------------------- F2C = EPSTD REAL FUNCTION EPSTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='EPSTD' IF (MESS.NE.0) CALL S99R22(FUN) EPSTD=-1.0E+30 RETURN END C------------------------------------------------- F2D = EPSTDD REAL FUNCTION EPSTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='EPSTDD' IF (MESS.NE.0) CALL S99R22(FUN) EPSTDD=-1.0E+30 RETURN END C------------------------------------------------- F9A = GAMPD REAL FUNCTION GAMPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='GAMPD' IF (MESS.NE.0) CALL S99R22(FUN) GAMPD=-1.0E+30 RETURN END C------------------------------------------------- F9B = GAMTD REAL FUNCTION GAMTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='GAMTD' IF (MESS.NE.0) CALL S99R22(FUN) GAMTD=-1.0E+30 RETURN END C------------------------------------------------- F6H = TPH2 REAL FUNCTION TPH2(P,H) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='TPH2' IF (MESS.NE.0) CALL S99R22(FUN) TPH2=-1.0E+30 RETURN END C------------------------------------------------- F6S = TPS2 REAL FUNCTION TPS2(P,S) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='TPS2' IF (MESS.NE.0) CALL S99R22(FUN) TPS2=-1.0E+30 RETURN END C------------------------------------------------- F8E = WPD REAL FUNCTION WPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='WPD' IF (MESS.NE.0) CALL S99R22(FUN) WPD=-1.0E+30 RETURN END C------------------------------------------------- F8F = WPDD REAL FUNCTION WPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='WPDD' IF (MESS.NE.0) CALL S99R22(FUN) WPDD=-1.0E+30 RETURN END C------------------------------------------------- F8G = WTD REAL FUNCTION WTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='WTD' IF (MESS.NE.0) CALL S99R22(FUN) WTD=-1.0E+30 RETURN END C------------------------------------------------- F8H = WTDD REAL FUNCTION WTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='WTDD' IF (MESS.NE.0) CALL S99R22(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== *------------------------------------------------- F1R22 = AIPPT REAL FUNCTION AIPPT(P,T) REAL P,PI,T,TI PI=P TI=T CALL S99R22('AIPPT') AIPPT=-1.0E+30 RETURN END *------------------------------------------------- F2R22 = ALAPP REAL FUNCTION ALAPP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) ALAPP=F2R22(PI) IF(ALAPP.EQ.-1.0E+10) THEN CALL S97R22('ALAPP') ELSE IF(ALAPP.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','ALAPP') END IF RETURN END *------------------------------------------------- F3R22 = ALAPT REAL FUNCTION ALAPT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) ALAPT=F3R22(TI) IF(ALAPT.EQ.-1.0E+10) THEN CALL S97R22('ALAPT') ELSE IF(ALAPT.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','ALAPT') END IF RETURN END *------------------------------------------------- F4R22 = ALHP REAL FUNCTION ALHP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) ALHP=F4R22(PI) IF(ALHP.EQ.-1.0E+10) THEN CALL S97R22('ALHP') ELSE IF(ALHP.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','ALHP') END IF RETURN END *------------------------------------------------- F5R22 = ALHT REAL FUNCTION ALHT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) ALHT=F5R22(TI) IF(ALHT.EQ.-1.0E+10) THEN CALL S97R22('ALHT') ELSE IF(ALHT.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','ALHT') END IF RETURN END *------------------------------------------------- F6R22 = ALMPD REAL FUNCTION ALMPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) ALMPD=F6R22(PI) IF(ALMPD.EQ.-1.0E+10) THEN CALL S97R22('ALMPD') ELSE IF(ALMPD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','ALMPD') END IF RETURN END *------------------------------------------------- F7R22 = ALMPDD REAL FUNCTION ALMPDD(P) REAL P,PI PI=P CALL S99R22('ALMPDD') ALMPDD=-1.0E+30 RETURN END *------------------------------------------------- F8R22 = ALMPT REAL FUNCTION ALMPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) ALMPT=F8R22(PI,TI) IF(ALMPT.EQ.-1.0E+10) THEN CALL S97R22('ALMPT') ELSE IF(ALMPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','ALMPT') END IF RETURN END *------------------------------------------------- F9R22 = ALMTD REAL FUNCTION ALMTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) ALMTD=F9R22(TI) IF(ALMTD.EQ.-1.0E+10) THEN CALL S97R22('ALMTD') ELSE IF(ALMTD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','ALMTD') END IF RETURN END *------------------------------------------------- F10R22 = ALMTDD REAL FUNCTION ALMTDD(T) REAL T,TI TI=T CALL S99R22('ALMTDD') ALMTDD=-1.0E+30 RETURN END *------------------------------------------------- F11R22 = AMUPD REAL FUNCTION AMUPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) AMUPD=F11R22(PI) IF(AMUPD.EQ.-1.0E+10) THEN CALL S97R22('AMUPD') ELSE IF(AMUPD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','AMUPD') END IF RETURN END *------------------------------------------------- F12R22 = AMUPDD REAL FUNCTION AMUPDD(P) REAL P,PI PI=P CALL S99R22('AMUPDD') AMUPDD=-1.0E+30 RETURN END *------------------------------------------------- F13R22 = AMUPT REAL FUNCTION AMUPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) AMUPT=F13R22(PI,TI) IF(AMUPT.EQ.-1.0E+10) THEN CALL S97R22('AMUPT') ELSE IF(AMUPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','AMUPT') END IF RETURN END *------------------------------------------------- F14R22 = AMUTD REAL FUNCTION AMUTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) AMUTD=F14R22(TI) IF(AMUTD.EQ.-1.0E+10) THEN CALL S97R22('AMUTD') ELSE IF(AMUTD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','AMUTD') END IF RETURN END *------------------------------------------------- F15R22 = AMUTDD REAL FUNCTION AMUTDD(T) REAL T,TI TI=T CALL S99R22('AMUTDD') AMUTDD=-1.0E+30 RETURN END *------------------------------------------------- F16R22 = CPPD REAL FUNCTION CPPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) CPPD=F16R22(PI) IF(CPPD.EQ.-1.0E+10) THEN CALL S97R22('CPPD') ELSE IF(CPPD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','CPPD') END IF RETURN END *------------------------------------------------- F17R22 = CPPDD REAL FUNCTION CPPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) CPPDD=F17R22(PI) IF(CPPDD.EQ.-1.0E+10) THEN CALL S97R22('CPPDD') ELSE IF(CPPDD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','CPPDD') END IF RETURN END *------------------------------------------------- F18R22 = CPPT REAL FUNCTION CPPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) CPPT=F18R22(PI,TI) IF(CPPT.EQ.-1.0E+10) THEN CALL S97R22('CPPT') ELSE IF(CPPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','CPPT') END IF RETURN END *------------------------------------------------- F19R22 = CPTD REAL FUNCTION CPTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) CPTD=F19R22(TI) IF(CPTD.EQ.-1.0E+10) THEN CALL S97R22('CPTD') ELSE IF(CPTD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','CPTD') END IF RETURN END *------------------------------------------------- F20R22 = CPTDD REAL FUNCTION CPTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) CPTDD=F20R22(TI) IF(CPTDD.EQ.-1.0E+10) THEN CALL S97R22('CPTDD') ELSE IF(CPTDD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','CPTDD') END IF RETURN END *------------------------------------------------- F21R22 = CRP REAL FUNCTION CRP(A) CHARACTER A*1 REAL PBAR,T0K,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF(KPA.EQ.1) THEN PBAR=1.0 T0K=0.0 ELSE IF(KPA.EQ.2) THEN PBAR=1.0 T0K=273.15 ELSE IF(KPA.EQ.3) THEN PBAR=1.0E-05 T0K=0.0 ELSE PBAR=1.0E-05 T0K=273.15 END IF FF=F21R22(A) IF(FF.EQ.-1.0E+20) THEN IF (MESS.NE.0) THEN WRITE(6,2000) A 2000 FORMAT(1H ,5X,'**** OUT OF RANGE AT CRP FOR R22', - ' WHEN A =',A,' ****') END IF FF=-1.0E+20 END IF IF(A.EQ.'T') THEN IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 FF=FF+T0K ELSE IF(A.EQ.'P') THEN IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 FF=FF/PBAR END IF CRP=FF RETURN END *------------------------------------------------- F22R22 = EPSPT REAL FUNCTION EPSPT(P,T) REAL P,PI,T,TI PI=P TI=T CALL S99R22('EPSPT') EPSPT=-1.0E+30 RETURN END C------------------------------------------------- F89R22 = FC C************************************************ C FUNCTION FOR FUNDDAMENTAL CONSTANTS C PROPATH VER.7.1, MAY 8, 1990 C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='86.469' WHEN A='M' C B='96.15469' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=86.469 ELSE IF (A.EQ.'R') THEN FC=96.15469 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR REFRIGERANT 22 WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END *------------------------------------------------- F23R22 = HPD REAL FUNCTION HPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) HPD=F23R22(PI) IF(HPD.EQ.-1.0E+10) THEN CALL S97R22('HPD') ELSE IF(HPD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','HPD') END IF RETURN END *------------------------------------------------- F24R22 = HPDD REAL FUNCTION HPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) HPDD=F24R22(PI) IF(HPDD.EQ.-1.0E+10) THEN CALL S97R22('HPDD') ELSE IF(HPDD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','HPDD') END IF RETURN END *------------------------------------------------- F25R22 = HPT REAL FUNCTION HPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) HPT=F25R22(PI,TI) IF(HPT.EQ.-1.0E+10) THEN CALL S97R22('HPT') ELSE IF(HPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','HPT') END IF RETURN END *------------------------------------------------- F26R22 = HPX REAL FUNCTION HPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) HPX=F26R22(PI,X) IF(HPX.EQ.-1.0E+10) THEN CALL S97R22('HPX') ELSE IF(HPX.EQ.-1.0E+20) THEN CALL S98R22(2,P,X,'P','X','HPX') END IF RETURN END *------------------------------------------------- F27R22 = HTD REAL FUNCTION HTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) HTD=F27R22(TI) IF(HTD.EQ.-1.0E+10) THEN CALL S97R22('HTD') ELSE IF(HTD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','HTD') END IF RETURN END *------------------------------------------------- F28R22 = HTDD REAL FUNCTION HTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) HTDD=F28R22(TI) IF(HTDD.EQ.-1.0E+10) THEN CALL S97R22('HTDD') ELSE IF(HTDD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','HTDD') END IF RETURN END *------------------------------------------------- F29R22 = HTX REAL FUNCTION HTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) HTX=F29R22(TI,X) IF(HTX.EQ.-1.0E+10) THEN CALL S97R22('HTX') ELSE IF(HTX.EQ.-1.0E+20) THEN CALL S98R22(2,T,X,'T','X','HTX') END IF RETURN END *------------------------------------------------- F84R22 = IDENTF C************************************************ C FUNCTION FOR IDENTIFICATION OF SUBSTANCE C PROPATH VER.12.1, MAY 2, 2001 C USAGE: B=IDENTF(A) C A, B : CHARACTER TYPE VALIABLES C B='REFRIGERANT 22' WHEN A='S' C B='CHCLF2' WHEN A='C' C B='12.1' WHEN A='V' C************************************************ CHARACTER*20 FUNCTION IDENTF(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'S') THEN IDENTF='REFRIGERANT 22' ELSE IF (A.EQ.'C') THEN IDENTF='CHCLF2' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR REFRIGERANT 22 WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END *------------------------------------------------- F30R22 = PST REAL FUNCTION PST(T) REAL TI,T INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) PST=F30R22(TI) IF(PST.EQ.-1.0E+10) THEN CALL S97R22('PST') RETURN ELSE IF(PST.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','PST') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.2)) RETURN PST=PST*1.0E+05 RETURN END *------------------------------------------------- F31R22 = SIGP REAL FUNCTION SIGP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) SIGP=F31R22(PI) IF(SIGP.EQ.-1.0E+10) THEN CALL S97R22('SIGP') ELSE IF(SIGP.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','SIGP') END IF RETURN END *------------------------------------------------- F32R22 = SIGT REAL FUNCTION SIGT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) SIGT=F32R22(TI) IF(SIGT.EQ.-1.0E+10) THEN CALL S97R22('SIGT') ELSE IF(SIGT.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','SIGT') END IF RETURN END *------------------------------------------------- F33R22 = SPD REAL FUNCTION SPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) SPD=F33R22(PI) IF(SPD.EQ.-1.0E+10) THEN CALL S97R22('SPD') ELSE IF(SPD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','SPD') END IF RETURN END *------------------------------------------------- F34R22 = SPDD REAL FUNCTION SPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) SPDD=F34R22(PI) IF(SPDD.EQ.-1.0E+10) THEN CALL S97R22('SPDD') ELSE IF(SPDD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','SPDD') END IF RETURN END *------------------------------------------------- F35R22 = SPT REAL FUNCTION SPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) SPT=F35R22(PI,TI) IF(SPT.EQ.-1.0E+10) THEN CALL S97R22('SPT') ELSE IF(SPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','SPT') END IF RETURN END *------------------------------------------------- F36R22 = SPX REAL FUNCTION SPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) SPX=F36R22(PI,X) IF(SPX.EQ.-1.0E+10) THEN CALL S97R22('SPX') ELSE IF(SPX.EQ.-1.0E+20) THEN CALL S98R22(2,P,X,'P','X','SPX') END IF RETURN END *------------------------------------------------- F37R22 = STD REAL FUNCTION STD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) STD=F37R22(TI) IF(STD.EQ.-1.0E+10) THEN CALL S97R22('STD') ELSE IF(STD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','STD') END IF RETURN END *------------------------------------------------- F38R22 = STDD REAL FUNCTION STDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) STDD=F38R22(TI) IF(STDD.EQ.-1.0E+10) THEN CALL S97R22('STDD') ELSE IF(STDD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','STDD') END IF RETURN END *------------------------------------------------- F39R22 = STX REAL FUNCTION STX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) STX=F39R22(TI,X) IF(STX.EQ.-1.0E+10) THEN CALL S97R22('STX') ELSE IF(STX.EQ.-1.0E+20) THEN CALL S98R22(2,T,X,'T','X','STX') END IF RETURN END *------------------------------------------------- F40R22 = TSP REAL FUNCTION TSP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TSP=F40R22(PI) IF(TSP.EQ.-1.0E+10) THEN CALL S97R22('TSP') RETURN ELSE IF(TSP.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','TSP') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TSP=TSP+273.15 RETURN END *------------------------------------------------- F41R22 = TRPL REAL FUNCTION TRPL(A) CHARACTER A*1,AI*1 AI=A CALL S99R22('TRPL') TRPL=-1.0E+30 RETURN END *------------------------------------------------- F42R22 = UPD REAL FUNCTION UPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) UPD=F42R22(PI) IF(UPD.EQ.-1.0E+10) THEN CALL S97R22('UPD') ELSE IF(UPD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','UPD') END IF RETURN END *------------------------------------------------- F43R22 = UPDD REAL FUNCTION UPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) UPDD=F43R22(PI) IF(UPDD.EQ.-1.0E+10) THEN CALL S97R22('UPDD') ELSE IF(UPDD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','UPDD') END IF RETURN END *------------------------------------------------- F44R22 = UPT REAL FUNCTION UPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) UPT=F44R22(PI,TI) IF(UPT.EQ.-1.0E+10) THEN CALL S97R22('UPT') ELSE IF(UPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','UPT') END IF RETURN END *------------------------------------------------- F45R22 = UPX REAL FUNCTION UPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) UPX=F45R22(PI,X) IF(UPX.EQ.-1.0E+10) THEN CALL S97R22('UPX') ELSE IF(UPX.EQ.-1.0E+20) THEN CALL S98R22(2,P,X,'P','X','UPX') END IF RETURN END *------------------------------------------------- F46R22 = UTD REAL FUNCTION UTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) UTD=F46R22(TI) IF(UTD.EQ.-1.0E+10) THEN CALL S97R22('UTD') ELSE IF(UTD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','UTD') END IF RETURN END *------------------------------------------------- F47R22 = UTDD REAL FUNCTION UTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) UTDD=F47R22(TI) IF(UTDD.EQ.-1.0E+10) THEN CALL S97R22('UTDD') ELSE IF(UTDD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','UTDD') END IF RETURN END *------------------------------------------------- F48R22 = UTX REAL FUNCTION UTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) UTX=F48R22(TI,X) IF(UTX.EQ.-1.0E+10) THEN CALL S97R22('UTX') ELSE IF(UTX.EQ.-1.0E+20) THEN CALL S98R22(2,T,X,'T','X','UTX') END IF RETURN END *------------------------------------------------- F49R22 = VPD REAL FUNCTION VPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) VPD=F49R22(PI) IF(VPD.EQ.-1.0E+10) THEN CALL S97R22('VPD') ELSE IF(VPD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','VPD') END IF RETURN END *------------------------------------------------- F50R22 = VPDD REAL FUNCTION VPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) VPDD=F50R22(PI) IF(VPDD.EQ.-1.0E+10) THEN CALL S97R22('VPDD') ELSE IF(VPDD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','VPDD') END IF RETURN END *------------------------------------------------- F51R22 = VPT REAL FUNCTION VPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) VPT=F51R22(PI,TI) IF(VPT.EQ.-1.0E+10) THEN CALL S97R22('VPT') ELSE IF(VPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','VPT') END IF RETURN END *------------------------------------------------- F52R22 = VPX REAL FUNCTION VPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) VPX=F52R22(PI,X) IF(VPX.EQ.-1.0E+10) THEN CALL S97R22('VPX') ELSE IF(VPX.EQ.-1.0E+20) THEN CALL S98R22(2,P,X,'P','X','VPX') END IF RETURN END *------------------------------------------------- F53R22 = VTD REAL FUNCTION VTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) VTD=F53R22(TI) IF(VTD.EQ.-1.0E+10) THEN CALL S97R22('VTD') ELSE IF(VTD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','VTD') END IF RETURN END *------------------------------------------------- F54R22 = VTDD REAL FUNCTION VTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) VTDD=F54R22(TI) IF(VTDD.EQ.-1.0E+10) THEN CALL S97R22('VTDD') ELSE IF(VTDD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','VTDD') END IF RETURN END *------------------------------------------------- F55R22 = VTX REAL FUNCTION VTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) VTX=F55R22(TI,X) IF(VTX.EQ.-1.0E+10) THEN CALL S97R22('VTX') ELSE IF(VTX.EQ.-1.0E+20) THEN CALL S98R22(2,T,X,'T','X','VTX') END IF RETURN END *------------------------------------------------- F56R22 = XPH REAL FUNCTION XPH(P,H) REAL P,PI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) XPH=F56R22(PI,H) IF(XPH.EQ.-1.0E+10) THEN CALL S97R22('XPH') ELSE IF(XPH.EQ.-1.0E+20) THEN CALL S98R22(2,P,H,'P','H','XPH') END IF RETURN END *------------------------------------------------- F57R22 = XPS REAL FUNCTION XPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) XPS=F57R22(PI,S) IF(XPS.EQ.-1.0E+10) THEN CALL S97R22('XPS') ELSE IF(XPS.EQ.-1.0E+20) THEN CALL S98R22(2,P,S,'P','S','XPS') END IF RETURN END *------------------------------------------------- F58R22 = XPU REAL FUNCTION XPU(P,U) REAL P,PI,U INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) XPU=F58R22(PI,U) IF(XPU.EQ.-1.0E+10) THEN CALL S97R22('XPU') ELSE IF(XPU.EQ.-1.0E+20) THEN CALL S98R22(2,P,U,'P','U','XPU') END IF RETURN END *------------------------------------------------- F59R22 = XPV REAL FUNCTION XPV(P,V) REAL P,PI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) XPV=F59R22(PI,V) IF(XPV.EQ.-1.0E+10) THEN CALL S97R22('XPV') ELSE IF(XPV.EQ.-1.0E+20) THEN CALL S98R22(2,P,V,'P','V','XPV') END IF RETURN END *------------------------------------------------- F60R22 = XTH REAL FUNCTION XTH(T,H) REAL T,TI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) XTH=F60R22(TI,H) IF(XTH.EQ.-1.0E+10) THEN CALL S97R22('XTH') ELSE IF(XTH.EQ.-1.0E+20) THEN CALL S98R22(2,T,H,'T','H','XTH') END IF RETURN END *------------------------------------------------- F61R22 = XTS REAL FUNCTION XTS(T,S) REAL T,TI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) XTS=F61R22(TI,S) IF(XTS.EQ.-1.0E+10) THEN CALL S97R22('XTS') ELSE IF(XTS.EQ.-1.0E+20) THEN CALL S98R22(2,T,S,'T','S','XTS') END IF RETURN END *------------------------------------------------- F62R22 = XTU REAL FUNCTION XTU(T,U) REAL T,TI,U INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) XTU=F62R22(TI,U) IF(XTU.EQ.-1.0E+10) THEN CALL S97R22('XTU') ELSE IF(XTU.EQ.-1.0E+20) THEN CALL S98R22(2,T,U,'T','U','XTU') END IF RETURN END *------------------------------------------------- F63R22 = XTV REAL FUNCTION XTV(T,V) REAL T,TI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) XTV=F63R22(TI,V) IF(XTV.EQ.-1.0E+10) THEN CALL S97R22('XTV') ELSE IF(XTV.EQ.-1.0E+20) THEN CALL S98R22(2,T,V,'T','V','XTV') END IF RETURN END *------------------------------------------------- F64R22 = TPH REAL FUNCTION TPH(P,H) REAL P,PI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TPH=F64R22(PI,H) IF(TPH.EQ.-1.0E+10) THEN CALL S97R22('TPH') RETURN ELSE IF(TPH.EQ.-1.0E+20) THEN CALL S98R22(2,P,H,'P','H','TPH') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPH=TPH+273.15 RETURN END *------------------------------------------------- F65R22 = TPS REAL FUNCTION TPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TPS=F65R22(PI,S) IF(TPS.EQ.-1.0E+10) THEN CALL S97R22('TPS') RETURN ELSE IF(TPS.EQ.-1.0E+20) THEN CALL S98R22(2,P,S,'P','S','TPS') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPS=TPS+273.15 RETURN END *------------------------------------------------- F66R22 = PLDT REAL FUNCTION PLDT(T) REAL T,TI TI=T CALL S99R22('PLDT') PLDT=-1.0E+30 RETURN END *------------------------------------------------- F67R22 = TLDP REAL FUNCTION TLDP(P) REAL P,PI PI=P CALL S99R22('TLDP') TLDP=-1.0E+30 RETURN END *------------------------------------------------- F68R22 = PMLT REAL FUNCTION PMLT(T) REAL T,TI TI=T CALL S99R22('PMLT') PMLT=-1.0E+30 RETURN END *------------------------------------------------- F69R22 = TMLP REAL FUNCTION TMLP(P) REAL P,PI PI=P CALL S99R22('TMLP') TMLP=-1.0E+30 RETURN END *------------------------------------------------- F70R22 = TPV REAL FUNCTION TPV(P,V) REAL P,PI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TPV=F70R22(PI,V) IF(TPV.EQ.-1.0E+10) THEN CALL S97R22('TPV') RETURN ELSE IF(TPV.EQ.-1.0E+20) THEN CALL S98R22(2,P,V,'P','V','TPV') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPV=TPV+273.15 RETURN END *------------------------------------------------- F71R22 = HPS REAL FUNCTION HPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) HPS=F71R22(PI,S) IF(HPS.EQ.-1.0E+10) THEN CALL S97R22('HPS') ELSE IF(HPS.EQ.-1.0E+20) THEN CALL S98R22(2,P,S,'P','S','HPS') END IF RETURN END *------------------------------------------------- F72R22 = PSTD REAL FUNCTION PSTD(T) REAL T,TI TI=T CALL S99R22('PSTD') PSTD=-1.0E+30 RETURN END *------------------------------------------------- F73R22 = PSTDD REAL FUNCTION PSTDD(T) REAL T,TI TI=T CALL S99R22('PSTDD') PSTDD=-1.0E+30 RETURN END *------------------------------------------------- F74R22 = TSPD REAL FUNCTION TSPD(P) REAL P,PI PI=P CALL S99R22('TSPD') TSPD=-1.0E+30 RETURN END *------------------------------------------------- F75R22 = TSPDD REAL FUNCTION TSPDD(P) REAL P,PI PI=P CALL S99R22('TSPDD') TSPDD=-1.0E+30 RETURN END *------------------------------------------------- F76R22 = CVPDD REAL FUNCTION CVPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) CVPDD=F76R22(PI) IF(CVPDD.EQ.-1.0E+10) THEN CALL S97R22('CVPDD') ELSE IF(CVPDD.EQ.-1.0E+20) THEN CALL S98R22(1,P,P,'P','P','CVPDD') END IF RETURN END *------------------------------------------------- F77R22 = CVPT REAL FUNCTION CVPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) CVPT=F77R22(PI,TI) IF(CVPT.EQ.-1.0E+10) THEN CALL S97R22('CVPT') ELSE IF(CVPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','CVPT') END IF RETURN END *------------------------------------------------- F78R22 = CVTDD REAL FUNCTION CVTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R22(KPA,T) CVTDD=F78R22(TI) IF(CVTDD.EQ.-1.0E+10) THEN CALL S97R22('CVTDD') ELSE IF(CVTDD.EQ.-1.0E+20) THEN CALL S98R22(1,T,T,'T','T','CVTDD') END IF RETURN END *------------------------------------------------- F79R22 = UPS REAL FUNCTION UPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) UPS=F79R22(PI,S) IF(UPS.EQ.-1.0E+10) THEN CALL S97R22('UPS') ELSE IF(UPS.EQ.-1.0E+20) THEN CALL S98R22(2,P,S,'P','S','UPS') END IF RETURN END *------------------------------------------------- F80R22 = VPS REAL FUNCTION VPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) VPS=F80R22(PI,S) IF(VPS.EQ.-1.0E+10) THEN CALL S97R22('VPS') ELSE IF(VPS.EQ.-1.0E+20) THEN CALL S98R22(2,P,S,'P','S','VPS') END IF RETURN END *------------------------------------------------- F81R22 = PRPT REAL FUNCTION PRPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) PRPT=F81R22(PI,TI) IF(PRPT.EQ.-1.0E+10) THEN CALL S97R22('PRPT') ELSE IF(PRPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','PRPT') END IF RETURN END *------------------------------------------------- F82R22 = AKPT REAL FUNCTION AKPT(P,T) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) AKPT=F82R22(PI,TI) IF(AKPT.EQ.-1.0E+10) THEN CALL S97R22('AKPT') ELSE IF(AKPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','AKPT') END IF RETURN END *------------------------------------------------- F83R22 = WPT REAL FUNCTION WPT(P,T) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R22(KPA,P) TI=G99R22(KPA,T) WPT=F83R22(PI,TI) IF(WPT.EQ.-1.0E+10) THEN CALL S97R22('WPT') ELSE IF(WPT.EQ.-1.0E+20) THEN CALL S98R22(2,P,T,'P','T','WPT') END IF RETURN END *------------------------------------------------- F85R22 = PRPD REAL FUNCTION PRPD(P) REAL P,PI PI=P CALL S99R22('PRPD') PRPD=-1.0E+30 RETURN END *------------------------------------------------- F86R22 = PRPDD REAL FUNCTION PRPDD(P) REAL P,PI PI=P CALL S99R22('PRPDD') PRPDD=-1.0E+30 RETURN END *------------------------------------------------- F87R22 = PRTD REAL FUNCTION PRTD(T) REAL T,TI TI=T CALL S99R22('PRTD') PRTD=-1.0E+30 RETURN END *------------------------------------------------- F88R22 = PRTDD REAL FUNCTION PRTDD(T) REAL T,TI TI=T CALL S99R22('PRTDD') PRTDD=-1.0E+30 RETURN END *------------------------------------------------- F90R22 = BSPT REAL FUNCTION BSPT(P,T) REAL T,TI TI=T PI=P CALL S99R22('BSPT') BSPT=-1.0E+30 RETURN END *------------------------------------------------- F91R22 = BTPT REAL FUNCTION BTPT(P,T) REAL T,TI TI=T PI=P CALL S99R22('BTPT') BTPT=-1.0E+30 RETURN END *------------------------------------------------- F92R22 = BPPT REAL FUNCTION BPPT(P,T) REAL T,TI TI=T PI=P CALL S99R22('BPPT') BPPT=-1.0E+30 RETURN END *------------------------------------------------- F93R22 = BVPT REAL FUNCTION BVPT(P,T) REAL T,TI TI=T PI=P CALL S99R22('BVPT') BVPT=-1.0E+30 RETURN END *------------------------------------------------- F94R22 = AJTPT REAL FUNCTION AJTPT(P,T) REAL T,TI TI=T PI=P CALL S99R22('AJTPT') AJTPT=-1.0E+30 RETURN END *------------------------------------------------- F95R22 = GAMPT REAL FUNCTION GAMPT(P,T) REAL T,TI TI=T PI=P CALL S99R22('GAMPT') GAMPT=-1.0E+30 RETURN END *------------------------------------------------- F96R22 = GAMPDD REAL FUNCTION GAMPDD(P) REAL P,PI PI=P CALL S99R22('GAMPDD') GAMPDD=-1.0E+30 RETURN END *------------------------------------------------- F97R22 = GAMTDD REAL FUNCTION GAMTDD(T) REAL T,TI TI=T CALL S99R22('GAMTDD') GAMTDD=-1.0E+30 RETURN END *------------------------------------------------- F98R22 = TPSEUP REAL FUNCTION TPSEUP(P) REAL P,PI PI=P CALL S99R22('TPSEUP') TPSEUP=-1.0E+30 RETURN END *------------------------------------------------- F99R22 = PSBT REAL FUNCTION PSBT(T) REAL T,TI TI=T CALL S99R22('PSBT') PSBT=-1.0E+30 RETURN END *------------------------------------------------- F100R22 = TSBP REAL FUNCTION TSBP(P) REAL P,PI PI=P CALL S99R22('TSBP') TSBP=-1.0E+30 RETURN END *------------------------------------------------- G98R22 REAL FUNCTION G98R22(KPA,P) INTEGER KPA REAL P,PBAR IF (KPA.EQ.1) THEN PBAR=1.0E+00 ELSE IF (KPA.EQ.2) THEN PBAR=1.0E+00 ELSE IF (KPA.EQ.3) THEN PBAR=1.0E-05 ELSE PBAR=1.0E-05 END IF G98R22=P*PBAR RETURN END *------------------------------------------------- G99R22 REAL FUNCTION G99R22(KPA,T) INTEGER KPA REAL T,T0K IF (KPA.EQ.1) THEN T0K=0.0E+00 ELSE IF (KPA.EQ.2) THEN T0K=273.15E+00 ELSE IF (KPA.EQ.3) THEN T0K=0.0E+00 ELSE T0K=273.15E+00 END IF G99R22=T-T0K RETURN END ******R12V61:FUNCTIONS****1989.2.18************************************ REAL FUNCTION F2R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02,GRVT=9.80665D+00) F2R22=-1.0E+20 IF((FP.LT.0.6454).OR.(FP.GT.49.7)) RETURN F2R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S3R22(RRDD,PR,TSR) CALL S6R22(RRD,TSR) IF((RRDD.LT.0.0D0).OR.(RRD.LE.RRDD)) RETURN SIG=7.5692D-02*(ABS(1.0D0-TSR))**1.40D+00 ALAPP=SQRT(SIG/(GRVT*(RRD-RRDD)*RC)) F2R22=REAL(ALAPP) RETURN END REAL FUNCTION F3R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02,RC=5.130D+02,GRVT=9.80665D+00) F3R22=-1.0E+20 IF((FCT.LT.-50.0).OR.(FCT.GT.96.0)) RETURN F3R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R22(PSR,TR) CALL S3R22(RRDD,PSR,TR) CALL S6R22(RRD,TR) IF((RRDD.LT.0.0D0).OR.(RRD.LE.RRDD)) RETURN SIG=7.5692D-02*(ABS(1.0D0-TR))**1.40D+00 ALAPT=SQRT(SIG/(GRVT*(RRD-RRDD)*RC)) F3R22=REAL(ALAPT) RETURN END REAL FUNCTION F4R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F4R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7)) RETURN F4R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S7R22(HDD,PR,TSR) CALL S8R22(HD,TSR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN ALHP=(HDD-HD)*1.0D+03 F4R22=REAL(ALHP) RETURN END REAL FUNCTION F5R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F5R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0)) RETURN F5R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R22(PSR,TR) CALL S7R22(HDD,PSR,TR) CALL S8R22(HD,TR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN ALHT=(HDD-HD)*1.0D+03 F5R22=REAL(ALHT) RETURN END REAL FUNCTION F6R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) DATA CO1/ 2.16719D-01/, CO2/ 2.89265D-04/, - CO3/-8.47273D-06/, CO4/ 3.35706D-08/, - CO5/-4.46379D-11/ F6R22=-1.0E+20 IF((FP.LT.0.0195).OR.(FP.GT.30.0)) RETURN F6R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) RETURN TS=TSR*TC ALMPD=CO1+(CO2+(CO3+(CO4+CO5*TS)*TS)*TS)*TS F6R22=REAL(ALMPD) RETURN END REAL FUNCTION F8R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DATA CO1/-3.78899D+00/, CO2/ 4.37446D-02/, - CO3/-1.60996D-04/, CO4/ 2.89387D-07/, - CO5/-1.87243D-10/ F8R22=-1.0E+20 IF((FCT.LT.-40.0).OR.(FCT.GT.200.0)) RETURN P=DBLE(FP) T=DBLE(FCT)+273.15D0 ALM1T=CO1+(CO2+(CO3+(CO4+CO5*T)*T)*T)*T F8R22=REAL(ALM1T*1.0D-02) RETURN END REAL FUNCTION F9R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DATA CO1/ 2.16719D-01/, CO2/ 2.89265D-04/, - CO3/-8.47273D-06/, CO4/ 3.35706D-08/, - CO5/-4.46379D-11/ F9R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.70.0)) RETURN T=DBLE(FCT)+273.15D0 ALMTD=CO1+(CO2+(CO3+(CO4+CO5*T)*T)*T)*T F9R22=REAL(ALMTD) RETURN END REAL FUNCTION F11R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) DATA CO1/ 4.28201D+00/, CO2/-3.67370D-02/, - CO3/ 1.15726D-04/, CO4/-1.38045D-07/, - CO5/ 2.79412D-11/ F11R22=-1.0E+20 IF((FP.LT.0.0195).OR.(FP.GT.15.4)) RETURN F11R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) RETURN TS=TSR*TC AMUPD=CO1+(CO2+(CO3+(CO4+CO5*TS)*TS)*TS)*TS F11R22=REAL(AMUPD*1.0D-03) RETURN END REAL FUNCTION F13R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DIMENSION D(0:4,0:4),AMUT(0:4) DATA D(0,0)/-4.187759D+01/, D(0,1)/ 5.858057D+04/, - D(0,2)/-2.899446D+07/, D(0,3)/ 6.269848D+09/, - D(0,4)/-5.035207D+11/, D(1,0)/ 1.847342D+01/, - D(1,1)/-2.395394D+04/, D(1,2)/ 1.156548D+07/, - D(1,3)/-2.465397D+09/, D(1,4)/ 1.958625D+11/, - D(2,0)/-1.547995D+00/, D(2,1)/ 1.979280D+03/, - D(2,2)/-9.419432D+05/, D(2,3)/ 1.980055D+08/, - D(2,4)/-1.553601D+10/, D(3,0)/ 3.093802D-02/, - D(3,1)/-3.813233D+01/, D(3,2)/ 1.754582D+04/, - D(3,3)/-3.594837D+06/, D(3,4)/ 2.790724D+08/, - D(4,0)/ 1.139595D-04/, D(4,1)/-1.752541D-01/, - D(4,2)/ 9.327668D+01/, D(4,3)/-2.019864D+04/, - D(4,4)/ 1.454734D+06/ F13R22=-1.0E+20 IF((FP.LT.0.980665).OR.(FP.GT.60.0)) RETURN P=DBLE(FP) T=DBLE(FCT)+273.15D0 IF(ABS((P/1.01325D0)-1.0D0).LT.1.0D-05) THEN IF((FCT.LT.-40.0).OR.(FCT.GT.150.0)) RETURN AMUPT=1.31296D+01+(-1.55566D-01+(7.20319D-04 - +(-1.42316D-06+1.03972D-09*T)*T)*T)*T ELSE IF((FCT.LT.0.0).OR.(FCT.GT.125.0)) RETURN DO 10 I=0,4 AMUT(I)=D(I,0)+(D(I,1)+(D(I,2)+(D(I,3)+D(I,4)/T)/T)/T)/T 10 CONTINUE AMUPT=AMUT(0)+(AMUT(1)+(AMUT(2)+(AMUT(3)+AMUT(4)*P)*P)*P)*P END IF F13R22=REAL(AMUPT*1.0D-05) RETURN END REAL FUNCTION F14R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DATA CO1/ 4.28201D+00/, CO2/-3.67370D-02/, - CO3/ 1.15726D-04/, CO4/-1.38045D-07/, - CO5/ 2.79412D-11/ F14R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.40.0)) RETURN T=DBLE(FCT)+273.15D0 AMUTD=CO1+(CO2+(CO3+(CO4+CO5*T)*T)*T)*T F14R22=REAL(AMUTD*1.0D-03) RETURN END REAL FUNCTION F16R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) F16R22=-1.0E+20 IF((FP.LT.0.0195).OR.(FP.GT.10.5)) RETURN F16R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) RETURN TS=TSR*TC CALL S14R22(CPPD,TS) F16R22=REAL(CPPD*1.0D+03) RETURN END REAL FUNCTION F17R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F17R22=-1.0E+20 IF((FP.LT.0.0195).OR.(FP.GT.36.7)) RETURN F17R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S13R22(CPPDD,PR,TSR,1) IF(CPPDD.LT.0.0D0) RETURN F17R22=REAL(CPPDD*1.0D+03) RETURN END REAL FUNCTION F18R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) DATA EPSPC/1.2D-05/,EPSTC/1.0D-05/,EPSTS/1.0D-05/ DATA FPMIN/0.019/,FPMAX/100.0/,FCTMAX/200.0/ F18R22=-1.0E+20 IF((FP.LT.FPMIN).OR.(FP.GT.FPMAX)) RETURN IF(FP.GT.6.6214) THEN FVMIN=0.00080 FCTMIN=F70R22(FP,FVMIN) ELSE FCTMIN=F40R22(FP) END IF IF((FP.GT.49.7).AND.(FP.LT.49.88)) THEN FCTL=F40R22(FP)-0.1 FCTU=F40R22(FP)+0.1 IF((FCT.GT.FCTL).AND.(FCT.LT.FCTU)) RETURN END IF IF((FCTMIN.LE.-1.0E+10).OR.(FCTL.LE.-1.0E+10).OR. - (FCTU.LE.-1.0E+10)) RETURN IF((FCT.LT.FCTMIN).OR.(FCT.GT.FCTMAX)) RETURN F18R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC TR=(DBLE(FCT)+273.15D0)/TC IF(ABS(PR-1.0D0).LT.EPSPC.AND.ABS(TR-1.0D0).LT.EPSTC) THEN PR=1.0D0 TR=1.0D0 ELSE IF(PR.LT.1.0D0) THEN CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) RETURN IF(ABS(TR-TSR).LT.EPSTS) THEN TR=TSR END IF END IF CALL S13R22(CPPT,PR,TR,1) IF(CPPT.LT.0.0D0) RETURN F18R22=REAL(CPPT*1.0D+03) RETURN END REAL FUNCTION F19R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F19R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.25.0)) RETURN T=DBLE(FCT)+273.15D0 CALL S14R22(CPTD,T) F19R22=REAL(CPTD*1.0D+03) RETURN END REAL FUNCTION F20R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F20R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.80.0)) RETURN F20R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R22(PSR,TR) CALL S13R22(CPTDD,PSR,TR,1) IF(CPTDD.LT.0.0D0) RETURN F20R22=REAL(CPTDD*1.0D+03) RETURN END REAL FUNCTION F21R22(A) CHARACTER*1 A,B(1:5) DOUBLE PRECISION CRP(1:5),HC,PC,RC,SC,TC PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02) DATA B(1)/'H'/,B(2)/'P'/,B(3)/'S'/,B(4)/'T'/,B(5)/'V'/ CALL S7R22(HC,1.0D0,1.0D0) CALL S10R22(SC,1.0D0,1.0D0) CRP(1)=HC*1.0D+03 CRP(2)=PC*1.0D-02 CRP(3)=SC*1.0D+03 CRP(4)=TC-273.15D0 CRP(5)=1.0D0/RC DO 10 I=1,5 F21R22=REAL(CRP(I)) IF(A.EQ.B(I)) RETURN 10 CONTINUE F21R22=-1.0E+20 RETURN END REAL FUNCTION F23R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F23R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7)) RETURN F23R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S8R22(HPD,TSR) IF(HPD.LT.0.0D0) RETURN F23R22=REAL(HPD*1.0D+03) RETURN END REAL FUNCTION F24R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F24R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7)) RETURN F24R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S7R22(HPDD,PR,TSR) IF(HPDD.LT.0.0D0) RETURN F24R22=REAL(HPDD*1.0D+03) RETURN END REAL FUNCTION F25R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F25R22=-1.0E+20 CALL S90R22(FP,FCT,PR,TR,ILL90,IVL) IF(ILL90.EQ.10000) RETURN F25R22=-1.0E+10 IF(ILL90.EQ.1000) RETURN IF(IVL.EQ.1) THEN CALL S7R22(H,PR,TR) ELSE IF(IVL.EQ.2) THEN CALL S9R22(H,PR,TR) END IF IF(H.LT.0.0D0) RETURN F25R22=REAL(H*1.0D+03) RETURN END REAL FUNCTION F26R22(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F26R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F26R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC X=DBLE(FX) CALL S2R22(TSR,PR) CALL S7R22(HDD,PR,TSR) CALL S8R22(HD,TSR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN HPX=HD+X*(HDD-HD) F26R22=REAL(HPX*1.0D+03) RETURN END REAL FUNCTION F27R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F27R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0)) RETURN F27R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S8R22(HTD,TR) IF(HTD.LT.0.0D0) RETURN F27R22=REAL(HTD*1.0D+03) RETURN END REAL FUNCTION F28R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F28R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0)) RETURN F28R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R22(PSR,TR) CALL S7R22(HTDD,PSR,TR) IF(HTDD.LT.0.0D0) RETURN F28R22=REAL(HTDD*1.0D+03) RETURN END REAL FUNCTION F29R22(FCT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F29R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F29R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC X=DBLE(FX) CALL S1R22(PSR,TR) CALL S7R22(HDD,PSR,TR) CALL S8R22(HD,TR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN HTX=HD+X*(HDD-HD) F29R22=REAL(HTX*1.0D+03) RETURN END REAL FUNCTION F30R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) DATA EPSTC/1.0D-05/ F30R22=-1.0E+20 IF((FCT.LT.-100.01).OR.(FCT.GT.96.15)) RETURN TR=(DBLE(FCT)+273.15D0)/TC IF(ABS(TR-1.0D0).LT.EPSTC) THEN PSR=1.0D0 ELSE CALL S1R22(PSR,TR) IF(PSR.LT.0.0D0) RETURN END IF F30R22=REAL(PSR*PC*1.0D-02) RETURN END REAL FUNCTION F31R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) DATA EPSPC/1.2D-05/ F31R22=-1.0E+20 IF((FP.LT.0.6454).OR.(FP.GT.49.88)) RETURN F31R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC IF(ABS(PR-1.0D0).LT.EPSPC) THEN SIGP=0.0D0 ELSE CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) RETURN SIGP=7.5692D-02*(ABS(1.0D0-TSR))**1.40D+00 END IF F31R22=REAL(SIGP) RETURN END REAL FUNCTION F32R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) DATA EPSTC/1.0D-05/ F32R22=-1.0E+20 IF((FCT.LT.-50.0).OR.(FCT.GT.96.15)) RETURN TR=(DBLE(FCT)+273.15D0)/TC IF(ABS(TR-1.0D0).LT.EPSTC) THEN SIGT=0.0D0 ELSE SIGT=7.5692D-02*(ABS(1.0D0-TR))**1.40D+00 END IF F32R22=REAL(SIGT) RETURN END REAL FUNCTION F33R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F33R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7)) RETURN F33R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S11R22(SPD,TSR) IF(SPD.LT.0.0D0) RETURN F33R22=REAL(SPD*1.0D+03) RETURN END REAL FUNCTION F34R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F34R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7)) RETURN F34R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S10R22(SPDD,PR,TSR) IF(SPDD.LT.0.0D0) RETURN F34R22=REAL(SPDD*1.0D+03) RETURN END REAL FUNCTION F35R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F35R22=-1.0E+20 CALL S90R22(FP,FCT,PR,TR,ILL90,IVL) IF(ILL90.EQ.10000) RETURN F35R22=-1.0E+10 IF(ILL90.EQ.1000) RETURN IF(IVL.EQ.1) THEN CALL S10R22(S,PR,TR) ELSE IF(IVL.EQ.2) THEN CALL S12R22(S,PR,TR) END IF IF(S.LT.0.0D0) RETURN F35R22=REAL(S*1.0D+03) RETURN END REAL FUNCTION F36R22(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F36R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F36R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC X=DBLE(FX) CALL S2R22(TSR,PR) CALL S10R22(SDD,PR,TSR) CALL S11R22(SD,TSR) IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN SPX=SD+X*(SDD-SD) F36R22=REAL(SPX*1.0D+03) RETURN END REAL FUNCTION F37R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F37R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0)) RETURN F37R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S11R22(STD,TR) IF(STD.LT.0.0D0) RETURN F37R22=REAL(STD*1.0D+03) RETURN END REAL FUNCTION F38R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F38R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0)) RETURN F38R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R22(PSR,TR) CALL S10R22(STDD,PSR,TR) IF(STDD.LT.0.0D0) RETURN F38R22=REAL(STDD*1.0D+03) RETURN END REAL FUNCTION F39R22(FCT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F39R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F39R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC X=DBLE(FX) CALL S1R22(PSR,TR) CALL S10R22(SDD,PSR,TR) CALL S11R22(SD,TR) IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN STX=SD+X*(SDD-SD) F39R22=REAL(STX*1.0D+03) RETURN END REAL FUNCTION F40R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) DATA EPSPC/1.2D-05/ F40R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.88)) RETURN F40R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC IF(ABS(PR-1.0D0).LT.EPSPC) THEN TSR=1.0D0 ELSE CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) RETURN END IF F40R22=REAL(TSR*TC-273.15D0) RETURN END REAL FUNCTION F42R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02) F42R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7)) RETURN F42R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S8R22(HD,TSR) IF(HD.LT.0.0D0) RETURN CALL S6R22(RRD,TSR) UPD=HD-PR*PC/(RRD*RC) F42R22=REAL(UPD*1.0D+03) RETURN END REAL FUNCTION F43R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02) F43R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7)) RETURN F43R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S3R22(RRDD,PR,TSR) CALL S7R22(HDD,PR,TSR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0)) RETURN UPDD=HDD-PR*PC/(RRDD*RC) F43R22=REAL(UPDD*1.0D+03) RETURN END REAL FUNCTION F44R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02) F44R22=-1.0E+20 CALL S90R22(FP,FCT,PR,TR,ILL90,IVL) IF(ILL90.EQ.10000) RETURN F44R22=-1.0E+10 IF(ILL90.EQ.1000) RETURN IF(IVL.EQ.1) THEN CALL S3R22(RR,PR,TR) CALL S7R22(H,PR,TR) ELSE IF(IVL.EQ.2) THEN CALL S4R22(RR,PR,TR) CALL S9R22(H,PR,TR) END IF IF((RR.LT.0.0D0).OR.(H.LT.0.0D0)) RETURN UPT=H-PR*PC/(RR*RC) F44R22=REAL(UPT*1.0D+03) RETURN END REAL FUNCTION F45R22(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02) F45R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F45R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC X=DBLE(FX) CALL S2R22(TSR,PR) CALL S3R22(RRDD,PR,TSR) CALL S7R22(HDD,PR,TSR) CALL S6R22(RRD,TSR) CALL S8R22(HD,TSR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN UD=HD-PR*PC/(RRD*RC) UDD=HDD-PR*PC/(RRDD*RC) UPX=UD+X*(UDD-UD) F45R22=REAL(UPX*1.0D+03) RETURN END REAL FUNCTION F46R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02) F46R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0)) RETURN F46R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R22(PSR,TR) CALL S8R22(HD,TR) IF(HD.LT.0.0D0) RETURN CALL S6R22(RRD,TR) UTD=HD-PSR*PC/(RRD*RC) F46R22=REAL(UTD*1.0D+03) RETURN END REAL FUNCTION F47R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02) F47R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0)) RETURN F47R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R22(PSR,TR) CALL S3R22(RRDD,PSR,TR) CALL S7R22(HDD,PSR,TR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0)) RETURN UTDD=HDD-PSR*PC/(RRDD*RC) F47R22=REAL(UTDD*1.0D+03) RETURN END REAL FUNCTION F48R22(FCT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02) F48R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F48R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC X=DBLE(FX) CALL S1R22(PSR,TR) CALL S3R22(RRDD,PSR,TR) CALL S7R22(HDD,PSR,TR) CALL S8R22(HD,TR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN CALL S6R22(RRD,TR) UD=HD-PSR*PC/(RRD*RC) UDD=HDD-PSR*PC/(RRDD*RC) UTX=UD+X*(UDD-UD) F48R22=REAL(UTX*1.0D+03) RETURN END REAL FUNCTION F49R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02) F49R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7)) RETURN F49R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) RETURN CALL S6R22(RRD,TSR) F49R22=REAL(1.0D0/(RRD*RC)) RETURN END REAL FUNCTION F50R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02) F50R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7)) RETURN F50R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S3R22(RRDD,PR,TSR) IF(RRDD.LT.0.0D0) RETURN F50R22=REAL(1.0D0/(RRDD*RC)) RETURN END REAL FUNCTION F51R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(RC=5.130D+02) F51R22=-1.0E+20 CALL S90R22(FP,FCT,PR,TR,ILL90,IVL) IF(ILL90.EQ.10000) RETURN F51R22=-1.0E+10 IF(ILL90.EQ.1000) RETURN IF(IVL.EQ.1) THEN CALL S3R22(RR,PR,TR) ELSE IF(IVL.EQ.2) THEN CALL S4R22(RR,PR,TR) END IF IF(RR.LT.0.0D0) RETURN F51R22=REAL(1.0D0/(RR*RC)) RETURN END REAL FUNCTION F52R22(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02) F52R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F52R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC X=DBLE(FX) CALL S2R22(TSR,PR) CALL S3R22(RRDD,PR,TSR) IF(RRDD.LT.0.0D0) RETURN CALL S6R22(RRD,TSR) VDD=1.0D0/(RRDD*RC) VD=1.0D0/(RRD*RC) VPX=VD+X*(VDD-VD) F52R22=REAL(VPX) RETURN END REAL FUNCTION F53R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02,RC=5.130D+02) F53R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0)) RETURN TR=(DBLE(FCT)+273.15D0)/TC CALL S6R22(RRD,TR) F53R22=REAL(1.0D0/(RRD*RC)) RETURN END REAL FUNCTION F54R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02,RC=5.130D+02) F54R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0)) RETURN F54R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R22(PSR,TR) CALL S3R22(RRDD,PSR,TR) IF(RRDD.LT.0.0D0) RETURN F54R22=REAL(1.0D0/(RRDD*RC)) RETURN END REAL FUNCTION F55R22(FCT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02,RC=5.130D+02) F55R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F55R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC X=DBLE(FX) CALL S1R22(PSR,TR) CALL S3R22(RRDD,PSR,TR) IF(RRDD.LT.0.0D0) RETURN CALL S6R22(RRD,TR) VDD=1.0D0/(RRDD*RC) VD=1.0D0/(RRD*RC) VTX=VD+X*(VDD-VD) F55R22=REAL(VTX) RETURN END REAL FUNCTION F56R22(FP,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F56R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7).OR. - (FH.LT.F23R22(FP)).OR.(FH.GT.F24R22(FP))) RETURN F56R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC H=DBLE(FH)*1.0D-03 CALL S2R22(TSR,PR) CALL S7R22(HDD,PR,TSR) CALL S8R22(HD,TSR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN XPH=(H-HD)/(HDD-HD) F56R22=REAL(XPH) RETURN END REAL FUNCTION F57R22(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F57R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7).OR. - (FS.LT.F33R22(FP)).OR.(FS.GT.F34R22(FP))) RETURN F57R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC S=DBLE(FS)*1.0D-03 CALL S2R22(TSR,PR) CALL S10R22(SDD,PR,TSR) CALL S11R22(SD,TSR) IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN XPS=(S-SD)/(SDD-SD) F57R22=REAL(XPS) RETURN END REAL FUNCTION F58R22(FP,FU) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02) F58R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7).OR. - (FU.LT.F42R22(FP)).OR.(FU.GT.F43R22(FP))) RETURN F58R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC U=DBLE(FU)*1.0D-03 CALL S2R22(TSR,PR) CALL S3R22(RRDD,PR,TSR) CALL S7R22(HDD,PR,TSR) CALL S8R22(HD,TSR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN CALL S6R22(RRD,TSR) UD=HD-PR*PC/(RRD*RC) UDD=HDD-PR*PC/(RRDD*RC) XPU=(U-UD)/(UDD-UD) F58R22=REAL(XPU) RETURN END REAL FUNCTION F59R22(FP,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02) F59R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.49.7).OR. - (FV.LT.F49R22(FP)).OR.(FV.GT.F50R22(FP))) RETURN F59R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC V=DBLE(FV) CALL S2R22(TSR,PR) CALL S3R22(RRDD,PR,TSR) IF(RRDD.LT.0.0D0) RETURN CALL S6R22(RRD,TSR) VDD=1.0D0/(RRDD*RC) VD=1.0D0/(RRD*RC) XPV=(V-VD)/(VDD-VD) F59R22=REAL(XPV) RETURN END REAL FUNCTION F60R22(FCT,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F60R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0).OR. - (FH.LT.F27R22(FCT)).OR.(FH.GT.F28R22(FCT))) RETURN F60R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC H=DBLE(FH)*1.0D-03 CALL S1R22(PSR,TR) CALL S7R22(HDD,PSR,TR) CALL S8R22(HD,TR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN XTH=(H-HD)/(HDD-HD) F60R22=REAL(XTH) RETURN END REAL FUNCTION F61R22(FCT,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F61R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0).OR. - (FS.LT.F37R22(FCT)).OR.(FS.GT.F38R22(FCT))) RETURN F61R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC S=DBLE(FS)*1.0D-03 CALL S1R22(PSR,TR) CALL S10R22(SDD,PSR,TR) CALL S11R22(SD,TR) IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN XTS=(S-SD)/(SDD-SD) F61R22=REAL(XTS) RETURN END REAL FUNCTION F62R22(FCT,FU) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02) F62R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0).OR. - (FU.LT.F46R22(FCT)).OR.(FU.GT.F47R22(FCT))) RETURN F62R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC U=DBLE(FU)*1.0D-03 CALL S1R22(PSR,TR) CALL S3R22(RRDD,PSR,TR) CALL S7R22(HDD,PSR,TR) CALL S8R22(HD,TR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN CALL S6R22(RRD,TR) UD=HD-PSR*PC/(RRD*RC) UDD=HDD-PSR*PC/(RRDD*RC) XTU=(U-UD)/(UDD-UD) F62R22=REAL(XTU) RETURN END REAL FUNCTION F63R22(FCT,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02,RC=5.130D+02) F63R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.96.0).OR. - (FV.LT.F53R22(FCT)).OR.(FV.GT.F54R22(FCT))) RETURN F63R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC V=DBLE(FV) CALL S1R22(PSR,TR) CALL S3R22(RRDD,PSR,TR) IF(RRDD.LT.0.0D0) RETURN CALL S6R22(RRD,TR) VDD=1.0D0/(RRDD*RC) VD=1.0D0/(RRD*RC) XTV=(V-VD)/(VDD-VD) F63R22=REAL(XTV) RETURN END REAL FUNCTION F64R22(FP,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) DATA EPSPC/1.2D-05/,FEPSHC/1.0E-05/ F64R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.150.0)) RETURN IF(FP.GT.6.6214) THEN FVMIN=0.00080 FCTMIN=F70R22(FP,FVMIN) FHMIN=F25R22(FP,FCTMIN) ELSE FHMIN=F23R22(FP) END IF FHMAX=F25R22(FP,200.0) IF((FCTMIN.LE.-1.0E+10).OR.(FHMIN.LE.-1.0E+10).OR. - (FHMAX.LE.-1.0E+10)) RETURN IF((FH.LT.FHMIN).OR.(FH.GT.FHMAX)) RETURN IF((FP.GT.49.7).AND.(FP.LT.49.88)) THEN FCTL=F40R22(FP)-0.1 FCTU=F40R22(FP)+0.1 FHL=F25R22(FP,FCTL) FHU=F25R22(FP,FCTU) IF((FH.GE.FHL).AND.(FH.LE.FHU)) RETURN END IF F64R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC H=DBLE(FH)*1.0D-03 FHR=FH/F21R22('H') IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(FHR-1.0D0).LT.FEPSHC)) THEN F64R22=REAL(TC-273.15D0) RETURN END IF IF(PR.GT.1.0D0) THEN T0R=1.0D0 CALL S7R22(H0,PR,T0R) IF(H0.LT.0.0D0) RETURN CALL S13R22(CP0,PR,T0R,1) IF(CP0.LT.0.0D0) RETURN T1R=T0R+(H-H0)/(CP0*TC) IF(H.GE.H0) THEN CALL S7R22(H1,PR,T1R) IF(H1.LT.0.0D0) RETURN CALL S18R22(TR,PR,H,T0R,T1R,H0,H1,1) IF(TR.LT.0.0D0) RETURN ELSE CALL S9R22(H1,PR,T1R) IF(H1.LT.0.0D0) RETURN CALL S18R22(TR,PR,H,T0R,T1R,H0,H1,2) IF(TR.LT.0.0D0) RETURN END IF ELSE CALL S2R22(TSR,PR) IF(PR.GT.0.99639D0) THEN CALL S7R22(HDD,PR,TSR+0.001D0) CALL S8R22(HD,TSR-0.001D0) ELSE CALL S7R22(HDD,PR,TSR) CALL S8R22(HD,TSR) END IF IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN IF(H.GT.HDD) THEN T0R=TSR H0=HDD CALL S13R22(CPDD,PR,TSR,1) IF(CPDD.LT.0.0D0) RETURN T1R=T0R+(H-H0)/(CPDD*TC) CALL S7R22(H1,PR,T1R) IF(H1.LT.0.0D0) RETURN CALL S18R22(TR,PR,H,T0R,T1R,H0,H1,1) IF(TR.LT.0.0D0) RETURN ELSE IF(H.LT.HD) THEN T0R=TSR T0=TSR*TC H0=HD CALL S14R22(CPD,T0) T1R=T0R+(H-H0)/(CPD*TC) CALL S9R22(H1,PR,T1R) IF(H1.LT.0.0D0) RETURN CALL S18R22(TR,PR,H,T0R,T1R,H0,H1,2) IF(TR.LT.0.0D0) RETURN ELSE TR=TSR END IF END IF F64R22=REAL(TR*TC-273.15D0) RETURN END REAL FUNCTION F65R22(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) DATA EPSPC/1.2D-05/,FEPSSC/1.0E-05/ F65R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.150.0)) RETURN IF(FP.GT.6.6214) THEN FVMIN=0.00080 FCTMIN=F70R22(FP,FVMIN) FSMIN=F35R22(FP,FCTMIN) ELSE FSMIN=F33R22(FP) END IF FSMAX=F35R22(FP,200.0) IF((FCTMIN.LE.-1.0E+10).OR.(FSMIN.LE.-1.0E+10).OR. - (FSMAX.LE.-1.0E+10)) RETURN IF((FS.LT.FSMIN).OR.(FS.GT.FSMAX)) RETURN IF((FP.GT.49.7).AND.(FP.LT.49.88)) THEN FCTL=F40R22(FP)-0.1 FCTU=F40R22(FP)+0.1 FSL=F35R22(FP,FCTL) FSU=F35R22(FP,FCTU) IF((FS.GE.FSL).AND.(FS.LE.FSU)) RETURN END IF F65R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC S=DBLE(FS)*1.0D-03 FSR=FS/F21R22('S') IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(FSR-1.0D0).LT.FEPSSC)) THEN F65R22=REAL(TC-273.15D0) RETURN END IF IF(PR.GT.1.0D0) THEN T0R=1.0D0 CALL S10R22(S0,PR,T0R) IF(S0.LT.0.0D0) RETURN CALL S13R22(CP0,PR,T0R,1) IF(CP0.LT.0.0D0) RETURN T1R=T0R*(1.0D0+(S-S0)/CP0) IF(S.GE.S0) THEN CALL S10R22(S1,PR,T1R) IF(S1.LT.0.0D0) RETURN CALL S18R22(TR,PR,S,T0R,T1R,S0,S1,3) IF(TR.LT.0.0D0) RETURN ELSE CALL S12R22(S1,PR,T1R) IF(S1.LT.0.0D0) RETURN CALL S18R22(TR,PR,S,T0R,T1R,S0,S1,4) IF(TR.LT.0.0D0) RETURN END IF ELSE CALL S2R22(TSR,PR) IF(PR.GT.0.99639D0) THEN CALL S10R22(SDD,PR,TSR+0.001D0) CALL S11R22(SD,TSR-0.001D0) ELSE CALL S10R22(SDD,PR,TSR) CALL S11R22(SD,TSR) END IF IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN IF(S.GT.SDD) THEN T0R=TSR S0=SDD CALL S13R22(CPDD,PR,TSR,1) IF(CPDD.LT.0.0D0) RETURN T1R=T0R*(1.0D0+(S-S0)/CPDD) CALL S10R22(S1,PR,T1R) IF(S1.LT.0.0D0) RETURN CALL S18R22(TR,PR,S,T0R,T1R,S0,S1,3) IF(TR.LT.0.0D0) RETURN ELSE IF(S.LT.SD) THEN T0R=TSR T0=TSR*TC S0=SD CALL S14R22(CPD,T0) T1R=T0R*(1.0D0+(S-S0)/CPD) CALL S12R22(S1,PR,T1R) IF(S1.LT.0.0D0) RETURN CALL S18R22(TR,PR,S,T0R,T1R,S0,S1,4) IF(TR.LT.0.0D0) RETURN ELSE TR=TSR END IF END IF F65R22=REAL(TR*TC-273.15D0) RETURN END REAL FUNCTION F70R22(FP,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02) DATA EPSPC/1.2D-05/,EPSRC/1.0D-05/ DATA PMIN/0.0189D0/,PMAX/150.01D0/,CTMAX/200.01D0/ PR=DBLE(FP)*1.0D+02/PC PRMIN=PMIN*1.0D+02/PC PRMAX=PMAX*1.0D+02/PC TRMAX=(CTMAX+273.15D0)/TC F70R22=-1.0E+20 IF((FV.LE.0.0).OR.(PR.LT.PRMIN).OR.(PR.GT.PRMAX)) RETURN RR=1.0D0/(RC*DBLE(FV)) IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(RR-1.0D0).LT.EPSRC)) THEN F70R22=REAL(TC-273.15D0) RETURN END IF CALL S3R22(RRV,PR,TRMAX) IF(RRV.LT.0.0D0) RETURN RRMIN=RRV IF(FP.GT.6.6214) THEN RRMAX=(1.0D0/(RC*0.00080D0))+0.001D0 ELSE CALL S2R22(TSR,PR) CALL S6R22(RRD,TSR) RRMAX=RRD END IF IF((RR.LT.RRMIN).OR.(RR.GT.RRMAX)) RETURN F70R22=-1.0E+10 IF(PR.GE.1.0D0) THEN IF(RR.LT.1.0D0) THEN IVL=1 ELSE IVL=2 END IF ELSE CALL S2R22(TSR,PR) IF(PR.GT.0.99639D0) THEN CALL S3R22(RRDD,PR,TSR+0.001D0) CALL S6R22(RRD,TSR-0.001D0) IF((PR.GT.0.99639D0).AND.(RR.GT.RRDD).AND.(RR.LT.RRD)) RETURN END IF CALL S3R22(RRDD,PR,TSR) IF(RRDD.LT.0.0D0) RETURN CALL S6R22(RRD,TSR) IF(RR.GT.RRD) THEN IVL=3 ELSE IF(RR.LT.RRDD) THEN IVL=1 ELSE F70R22=REAL(TSR*TC-273.15D0) RETURN END IF END IF IF(IVL.EQ.1) THEN CALL S19R22(TR,PR,RR) ELSE IF(IVL.EQ.2) THEN CALL S20R22(TR,PR,RR,1.0D0) ELSE IF(IVL.EQ.3) THEN CALL S2R22(TRL2I,PR) CALL S20R22(TR,PR,RR,TRL2I) END IF IF(TR.LT.0.0D0) RETURN F70R22=REAL(TR*TC-273.15D0) RETURN END REAL FUNCTION F71R22(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02,TC=3.69300D+02) DATA EPSPC/1.0D-05/,FEPSSC/1.0E-05/ F71R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.150.0)) RETURN IF(FP.GT.6.6214) THEN FVMIN=0.00080 FCTMIN=F70R22(FP,FVMIN) FSMIN=F35R22(FP,FCTMIN) ELSE FSMIN=F33R22(FP) END IF FSMAX=F35R22(FP,200.0) IF((FCTMIN.LE.-1.0E+10).OR.(FSMIN.LE.-1.0E+10).OR. - (FSMAX.LE.-1.0E+10)) RETURN IF((FS.LT.FSMIN).OR.(FS.GT.FSMAX)) RETURN IF((FP.GT.49.7).AND.(FP.LT.49.88)) THEN FCTL=F40R22(FP)-0.1 FCTU=F40R22(FP)+0.1 FSL=F35R22(FP,FCTL) FSU=F35R22(FP,FCTU) IF((FS.GE.FSL).AND.(FS.LE.FSU)) RETURN END IF F71R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC S=DBLE(FS)*1.0D-03 FSR=FS/F21R22('S') IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(FSR-1.0D0).LT.FEPSSC)) THEN F71R22=F21R22('H') RETURN END IF IF(PR.GT.1.0D0) THEN FT=F65R22(FP,FS) FH=F25R22(FP,FT) F71R22=FH ELSE CALL S2R22(TSR,PR) IF(PR.GT.0.99639D0) THEN CALL S10R22(SDD,PR,TSR+0.001D0) CALL S11R22(SD,TSR-0.001D0) ELSE CALL S10R22(SDD,PR,TSR) CALL S11R22(SD,TSR) END IF IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN IF(S.GT.SDD) THEN FT=F65R22(FP,FS) FH=F25R22(FP,FT) F71R22=FH ELSE IF((S.GE.SD).AND.(S.LE.SDD)) THEN CALL S7R22(HDD,PR,TSR) IF(HDD.LT.0.0D0) RETURN CALL S8R22(HD,TSR) IF(HD.LT.0.0D0) RETURN H=HD+((S-SD)/(SDD-SD))*(HDD-HD) F71R22=REAL(H*1.0D+03) ELSE IF(S.LT.SD) THEN FT=F65R22(FP,FS) FH=F25R22(FP,FT) F71R22=FH END IF END IF RETURN END REAL FUNCTION F76R22(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03) F76R22=-1.0E+20 IF((FP.LT.0.0195).OR.(FP.GT.36.7)) RETURN F76R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R22(TSR,PR) CALL S13R22(CVPDD,PR,TSR,2) IF(CVPDD.LT.0.0D0) RETURN F76R22=REAL(CVPDD*1.0D+03) RETURN END REAL FUNCTION F77R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) DATA EPSPC/1.2D-05/,EPSTC/1.0D-05/,EPSTS/1.0D-05/ DATA FPMIN/0.019/,FPMAX/100.0/,FCTMAX/200.0/ F77R22=-1.0E+20 IF((FP.LT.FPMIN).OR.(FP.GT.FPMAX)) RETURN IF(FP.GT.6.6214) THEN FVMIN=0.00080 FCTMIN=F70R22(FP,FVMIN) ELSE FCTMIN=F40R22(FP) END IF IF((FP.GT.49.7).AND.(FP.LT.49.88)) THEN FCTL=F40R22(FP)-0.1 FCTU=F40R22(FP)+0.1 IF((FCT.GT.FCTL).AND.(FCT.LT.FCTU)) RETURN END IF IF((FCTMIN.LE.-1.0E+10).OR.(FCTL.LE.-1.0E+10).OR. - (FCTU.LE.-1.0E+10)) RETURN IF((FCT.LT.FCTMIN).OR.(FCT.GT.FCTMAX)) RETURN F77R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC TR=(DBLE(FCT)+273.15D0)/TC IF(ABS(PR-1.0D0).LT.EPSPC.AND.ABS(TR-1.0D0).LT.EPSTC) THEN PR=1.0D0 TR=1.0D0 ELSE IF(PR.LT.1.0D0) THEN CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) RETURN IF(ABS(TR-TSR).LT.EPSTS) THEN TR=TSR END IF END IF CALL S13R22(CVPT,PR,TR,2) IF(CVPT.LT.0.0D0) RETURN F77R22=REAL(CVPT*1.0D+03) RETURN END REAL FUNCTION F78R22(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.69300D+02) F78R22=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.80.0)) RETURN F78R22=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R22(PSR,TR) CALL S13R22(CVTDD,PSR,TR,2) IF(CVTDD.LT.0.0D0) RETURN F78R22=REAL(CVTDD*1.0D+03) RETURN END REAL FUNCTION F79R22(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02,TC=3.69300D+02) DATA EPSPC/1.0D-05/,FEPSSC/1.0E-05/ F79R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.150.0)) RETURN IF(FP.GT.6.6214) THEN FVMIN=0.00080 FCTMIN=F70R22(FP,FVMIN) FSMIN=F35R22(FP,FCTMIN) ELSE FSMIN=F33R22(FP) END IF FSMAX=F35R22(FP,200.0) IF((FCTMIN.LE.-1.0E+10).OR.(FSMIN.LE.-1.0E+10).OR. - (FSMAX.LE.-1.0E+10)) RETURN IF((FS.LT.FSMIN).OR.(FS.GT.FSMAX)) RETURN IF((FP.GT.49.7).AND.(FP.LT.49.88)) THEN FCTL=F40R22(FP)-0.1 FCTU=F40R22(FP)+0.1 FSL=F35R22(FP,FCTL) FSU=F35R22(FP,FCTU) IF((FS.GE.FSL).AND.(FS.LE.FSU)) RETURN END IF F79R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC S=DBLE(FS)*1.0D-03 FSR=FS/F21R22('S') IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(FSR-1.0D0).LT.FEPSSC)) THEN F79R22=F21R22('H')-PC*1.0E+03*F21R22('V') RETURN END IF IF(PR.GT.1.0D0) THEN FT=F65R22(FP,FS) FU=F44R22(FP,FT) F79R22=FU ELSE CALL S2R22(TSR,PR) IF(PR.GT.0.99639D0) THEN CALL S10R22(SDD,PR,TSR+0.001D0) CALL S11R22(SD,TSR-0.001D0) ELSE CALL S10R22(SDD,PR,TSR) CALL S11R22(SD,TSR) END IF IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN IF(S.GT.SDD) THEN FT=F65R22(FP,FS) FU=F44R22(FP,FT) F79R22=FU ELSE IF((S.GE.SD).AND.(S.LE.SDD)) THEN CALL S7R22(HDD,PR,TSR) CALL S3R22(RRDD,PR,TSR) IF((HDD.LT.0.0D0).OR.(RRDD.LT.0.0D0)) RETURN UDD=HDD-PR*PC/(RRDD*RC) CALL S8R22(HD,TSR) IF(HD.LT.0.0D0) RETURN CALL S2R22(RRD,TSR) UD=HD-PR*PC/(RRD*RC) U=UD+((S-SD)/(SDD-SD))*(UDD-UD) F79R22=REAL(U*1.0D+03) ELSE IF(S.LT.SD) THEN FT=F65R22(FP,FS) FU=F44R22(FP,FT) F79R22=FU END IF END IF RETURN END REAL FUNCTION F80R22(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02,TC=3.69300D+02) DATA EPSPC/1.0D-05/,FEPSSC/1.0E-05/ F80R22=-1.0E+20 IF((FP.LT.0.019).OR.(FP.GT.150.0)) RETURN IF(FP.GT.6.6214) THEN FVMIN=0.00080 FCTMIN=F70R22(FP,FVMIN) FSMIN=F35R22(FP,FCTMIN) ELSE FSMIN=F33R22(FP) END IF FSMAX=F35R22(FP,200.0) IF((FCTMIN.LE.-1.0E+10).OR.(FSMIN.LE.-1.0E+10).OR. - (FSMAX.LE.-1.0E+10)) RETURN IF((FS.LT.FSMIN).OR.(FS.GT.FSMAX)) RETURN IF((FP.GT.49.7).AND.(FP.LT.49.88)) THEN FCTL=F40R22(FP)-0.1 FCTU=F40R22(FP)+0.1 FSL=F35R22(FP,FCTL) FSU=F35R22(FP,FCTU) IF((FS.GE.FSL).AND.(FS.LE.FSU)) RETURN END IF F80R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC S=DBLE(FS)*1.0D-03 FSR=FS/F21R22('S') IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(FSR-1.0D0).LT.FEPSSC)) THEN F80R22=F21R22('V') RETURN END IF IF(PR.GT.1.0D0) THEN FT=F65R22(FP,FS) FV=F51R22(FP,FT) F80R22=FV ELSE CALL S2R22(TSR,PR) IF(PR.GT.0.99639D0) THEN CALL S10R22(SDD,PR,TSR+0.001D0) CALL S11R22(SD,TSR-0.001D0) ELSE CALL S10R22(SDD,PR,TSR) CALL S11R22(SD,TSR) END IF IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN IF(S.GT.SDD) THEN FT=F65R22(FP,FS) FV=F51R22(FP,FT) F80R22=FV ELSE IF((S.GE.SD).AND.(S.LE.SDD)) THEN CALL S3R22(RRDD,PR,TSR) IF (RRDD.LT.0.0D0) RETURN VDD=1.0D0/(RRDD*RC) CALL S2R22(RRD,TSR) VD=1.0D0/(RRD*RC) V=VD+((S-SD)/(SDD-SD))*(VDD-VD) F80R22=REAL(V) ELSE IF(S.LT.SD) THEN FT=F65R22(FP,FS) FV=F51R22(FP,FT) F80R22=FV END IF END IF RETURN END REAL FUNCTION F81R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) F81R22=-1.0E+20 IF (( FCT.LT.-40.0).OR.(FCT.GT.150.0)) RETURN F81R22=-1.0E+10 FP1=1.01325D+0 PR=DBLE(FP1)*1.0D+02/PC TR=(DBLE(FCT)+273.15D0)/TC CALL S13R22(CP1T,PR,TR,1) IF(CP1T.LT.0.0D0) RETURN P=DBLE(FP) T=DBLE(FCT)+273.15D0 ALM1T=-3.78899D+0+(4.37446D-02+(-1.60996D-04 - +(2.89387D-07+(-1.87243D-10)*T)*T)*T)*T AMU1T=1.31296D+01+(-1.55566D-01+(7.20319D-04 - +(-1.42316D-06+1.03972D-09*T)*T)*T)*T PRPT=(AMU1T*1.0D-05)*(CP1T*1.0D+03)/(ALM1T*1.0D-02) F81R22=REAL(PRPT) RETURN END REAL FUNCTION F82R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) DATA EPSPC/1.2D-05/,EPSTC/1.0D-05/,EPSTS/1.0D-05/ DATA FPMIN/0.019/,FPMAX/100.0/,FCTMAX/200.0/ F82R22=-1.0E+20 IF((FP.LT.FPMIN).OR.(FP.GT.FPMAX)) RETURN IF(FP.GT.6.6214) THEN FVMIN=0.00080 FCTMIN=F70R22(FP,FVMIN) ELSE FCTMIN=F40R22(FP) END IF IF((FP.GT.49.7).AND.(FP.LT.49.88)) THEN FCTL=F40R22(FP)-0.1 FCTU=F40R22(FP)+0.1 IF((FCT.GT.FCTL).AND.(FCT.LT.FCTU)) RETURN END IF IF((FCTMIN.LE.-1.0E+10).OR.(FCTL.LE.-1.0E+10).OR. - (FCTU.LE.-1.0E+10)) RETURN IF((FCT.LT.FCTMIN).OR.(FCT.GT.FCTMAX)) RETURN F82R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC TR=(DBLE(FCT)+273.15D0)/TC IF(ABS(PR-1.0D0).LT.EPSPC.AND.ABS(TR-1.0D0).LT.EPSTC) THEN PR=1.0D0 TR=1.0D0 ELSE IF(PR.LT.1.0D0) THEN CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) RETURN IF(ABS(TR-TSR).LT.EPSTS) THEN TR=TSR END IF END IF CALL S13R22(AKPT,PR,TR,3) IF(AKPT.LT.0.0D0) RETURN F82R22=REAL(AKPT) RETURN END REAL FUNCTION F83R22(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02) DATA EPSPC/1.2D-05/,EPSTC/1.0D-05/,EPSTS/1.0D-05/ DATA FPMIN/0.019/,FPMAX/100.0/,FCTMAX/200.0/ F83R22=-1.0E+20 IF((FP.LT.FPMIN).OR.(FP.GT.FPMAX)) RETURN IF(FP.GT.6.6214) THEN FVMIN=0.00080 FCTMIN=F70R22(FP,FVMIN) ELSE FCTMIN=F40R22(FP) END IF IF((FP.GT.49.7).AND.(FP.LT.49.88)) THEN FCTL=F40R22(FP)-0.1 FCTU=F40R22(FP)+0.1 IF((FCT.GT.FCTL).AND.(FCT.LT.FCTU)) RETURN END IF IF((FCTMIN.LE.-1.0E+10).OR.(FCTL.LE.-1.0E+10).OR. - (FCTU.LE.-1.0E+10)) RETURN IF((FCT.LT.FCTMIN).OR.(FCT.GT.FCTMAX)) RETURN F83R22=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC TR=(DBLE(FCT)+273.15D0)/TC IF(ABS(PR-1.0D0).LT.EPSPC.AND.ABS(TR-1.0D0).LT.EPSTC) THEN PR=1.0D0 TR=1.0D0 ELSE IF(PR.LT.1.0D0) THEN CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) RETURN IF(ABS(TR-TSR).LT.EPSTS) THEN TR=TSR END IF END IF CALL S13R22(WPT,PR,TR,4) IF(WPT.LT.0.0D0) RETURN F83R22=REAL(WPT) RETURN END SUBROUTINE S1R22(PSR,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DIMENSION B(1:5) PSR=-1.0D+20 IF(TR.LE.0.0D0) RETURN PSR=1.0D0 IF(TR.EQ.1.0D0) RETURN CALL S17R22(B) TR1=ABS(1.0D0-TR) XPSR=(TR1/TR)*(B(1)+B(2)*SQRT(TR1)+(B(3)+B(4)*TR1+B(5)*TR1*TR1) - *TR1*TR1) PSR=EXP(XPSR) RETURN END SUBROUTINE S2R22(TSR,PR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(ITMAX=10000,EPS=1.0D-12) DIMENSION B(1:5) TSR=-1.0D+20 IF(PR.LE.0.0D0) RETURN TSR=1.0D0 IF(PR.EQ.1.0D0) RETURN CALL S17R22(B) TR=1.0D0/(1.0D0+LOG(PR)/B(1)) DO 10 IT=1,ITMAX TR1=ABS(1.0D0-TR) F=LOG(PR)*TR-(B(1)+B(2)*SQRT(TR1)+(B(3)+B(4)*TR1 - +B(5)*TR1*TR1)*TR1*TR1)*TR1 DF=LOG(PR)+B(1)+1.5D0*B(2)*SQRT(TR1)+(3.0D0*B(3)+4.0D0*B(4)*TR1 - +5.0D0*B(5)*TR1*TR1)*TR1*TR1 TR=TR-F/DF IF(ABS(-F/(DF*TR)).LT.EPS) THEN TSR=TR RETURN END IF 10 CONTINUE TSR=-1.0D+10 RETURN END SUBROUTINE S3R22(RRV,PR,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02, - GASC=9.615469D-02) RRV=-1.0D+20 IF((PR.LE.0.0D0).AND.(TR.LE.0.0D0)) RETURN RRV=1.0D0 IF((PR.EQ.1.0D0).AND.(TR.EQ.1.0D0)) RETURN IF(PR.GT.1.001D0.AND.TR.GE.1.0D0.AND.TR.LT.1.06D0) THEN RRVI=2.0D0 ELSE RRVI=PC*PR/(GASC*RC*TC*TR) END IF CALL S5R22(RRVL,PR,TR,RRVI) RRV=RRVL RETURN END SUBROUTINE S4R22(RRL,PR,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) RRL=-1.0D+20 IF((PR.LE.0.0D0).AND.(TR.LE.0.0D0)) RETURN RRL=1.0D0 IF((PR.EQ.1.0D0).AND.(TR.EQ.1.0D0)) RETURN IF(PR.GT.1.001D0.AND.TR.GT.0.97D0.AND.TR.LE.1.0D0) THEN RRLI=2.0D0 ELSE CALL S6R22(RRD,TR) RRLI=RRD END IF CALL S5R22(RRVL,PR,TR,RRLI) RRL=RRVL RETURN END SUBROUTINE S5R22(RRVL,PR,TR,RRVLI) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02, - GASC=9.615469D-02,ITMAX=10000,EPS=1.0D-12) DIMENSION A(1:28) CALL S15R22(A) COZ=-PC*PR/(GASC*RC*TC*TR) CO1=1.0D0 CO2=A(1)+(A(2)+(A(3)+A(4)/TR/TR)/TR/TR/TR)/TR CO3=A(5)+(A(6)+A(7)/TR/TR/TR)/TR CO4=A(8)+(A(9)+(A(10)+A(11)/TR/TR)/TR)/TR CO5=(A(12)+A(13)/TR/TR/TR)/TR CO6=(A(14)+(A(15)+(A(16)+A(17)/TR/TR)/TR)/TR)/TR/TR CO7=A(18) CO8=(A(19)+A(20)/TR**4)/TR/TR CO9=A(21)/TR CO10=(A(22)+A(23)/TR**4)/TR/TR CO11=(A(24)+A(25)/TR**5)/TR CO12=(A(26)+(A(27)+A(28)/TR**4)/TR)/TR RR=RRVLI DO 10 IT=1,ITMAX F=COZ+(CO1+(CO2+(CO3+(CO4+(CO5+(CO6+(CO7+(CO8+(CO9+(CO10 - +(CO11+CO12*RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR DF=CO1+(2.0D0*CO2+(3.0D0*CO3+(4.0D0*CO4+(5.0D0*CO5 - +(6.0D0*CO6+(7.0D0*CO7+(8.0D0*CO8+(9.0D0*CO9 - +(10.0D0*CO10+(11.0D0*CO11+12.0D0*CO12*RR) - *RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR RR=RR-F/DF IF(ABS(-F/(DF*RR)).LT.EPS) THEN RRVL=RR RETURN END IF 10 CONTINUE RRVL=-1.0D+10 RETURN END SUBROUTINE S6R22(RRD,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA CO1/ 1.0D+00/, CO2/ 1.8877394D+00/, - CO3/ 5.9858531D-01/, CO4/-7.1134041D-02/, - CO5/ 4.0327650D-01/ RRD=1.0D0 IF(TR.EQ.1.0D0) RETURN TR1=ABS(1.0D0-TR)**(1.0D0/3.0D0) RRD=CO1+(CO2+(CO3+(CO4+CO5*TR1)*TR1)*TR1)*TR1 RETURN END SUBROUTINE S7R22(HV,PR,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=3.69300D+02,GASC=9.615469D-02,B00=6.0707324D+02) PARAMETER(D2=2.0D0,D3=3.0D0,D4=4.0D0,D5=5.0D0,D6=6.0D0,D7=7.0D0, - D8=8.0D0,D9=9.0D0,D10=10.0D0,D11=11.0D0,D12=12.0D0, - D13=13.0D0,D15=15.0D0,D16=16.0D0,D17=17.0D0) DIMENSION A(1:28),A0(0:4),CO(1:12) HV=-1.0D+20 IF((PR.LE.0.0D0).AND.(TR.LE.0.0D0)) RETURN CALL S3R22(RRV,PR,TR) IF(RRV.LT.0.0D0) GO TO 1000 CALL S15R22(A) CO(1)=(D12*A(26)+(D13*A(27)+D17*A(28)/TR**4)/TR)/(D11*TR) CO(2)=(D11*A(24)+D16*A(25)/TR**5)/(D10*TR) CO(3)=(D11*A(22)+D15*A(23)/TR**4)/(D9*TR*TR) CO(4)=D9*A(21)/(D8*TR) CO(5)=(D9*A(19)+D13*A(20)/TR**4)/(D7*TR*TR) CO(6)=A(18) CO(7)=(D7*A(14)+(D8*A(15)+(D9*A(16)+D11*A(17)/TR/TR)/TR)/TR) - /(D5*TR*TR) CO(8)=(D5*A(12)+D8*A(13)/TR**3)/(D4*TR) CO(9)=(D3*A(8)+(D4*A(9)+(D5*A(10)+D7*A(11)/TR/TR)/TR)/TR)/D3 CO(10)=(D2*A(5)+(D3*A(6)+D6*A(7)/TR**3)/TR)/D2 CO(11)=A(1)+(D2*A(2)+(D5*A(3)+D7*A(4)/TR/TR)/TR**3)/TR CO(12)=1.0D0 HVSUM=0.0D0 DO 10 I=1,12 HVSUM=HVSUM*RRV+CO(I) 10 CONTINUE CALL S16R22(A0) T0R=273.15D0/TC HV=GASC*TC*TR*HVSUM - +TC*(((A0(0)-GASC)+(A0(1)/D2+(A0(2)/D3+(A0(3)/D4+A0(4)*TR/D5) - *TR)*TR)*TR)*TR - -((A0(0)-GASC)+(A0(1)/D2+(A0(2)/D3+(A0(3)/D4+A0(4)*T0R/D5) - *T0R)*T0R)*T0R)*T0R) - +B00 RETURN 1000 HV=-1.0D+10 RETURN END SUBROUTINE S8R22(HD,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.9880D+03,RC=5.130D+02) DIMENSION B(1:5) HD=-1.0D+20 IF(TR.LE.0.0D0) RETURN IF(TR.EQ.1.0D0) THEN CALL S7R22(HDD,1.0D0,1.0D0) HD=HDD RETURN END IF CALL S1R22(PSR,TR) CALL S3R22(RRDD,PSR,TR) CALL S7R22(HDD,PSR,TR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0)) GO TO 1000 CALL S6R22(RRD,TR) CALL S17R22(B) TR1=ABS(1.0D0-TR) HD=HDD+(PC/RC)*(PSR/TR)*(1.0D0/RRDD-1.0D0/RRD) - *(B(1)+B(2)*(1.0D0+0.5D0*TR)*SQRT(TR1) - +(B(3)*(1.0D0+2.0D0*TR)+B(4)*(1.0D0+3.0D0*TR)*TR1 - +B(5)*(1.0D0+4.0D0*TR)*TR1*TR1)*TR1*TR1) RETURN 1000 HD=-1.0D+10 RETURN END SUBROUTINE S9R22(HL,PR,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02, - GASC=9.615469D-02) PARAMETER(D2=2.0D0,D3=3.0D0,D4=4.0D0,D5=5.0D0, - D6=6.0D0,D7=7.0D0,D8=8.0D0,D9=9.0D0,D10=10.0D0, - D11=11.0D0,D12=12.0D0,D13=13.0D0,D17=17.0D0) DIMENSION A(1:28) HL=-1.0D+20 IF((PR.LE.0.0D0).AND.(TR.LE.0.0D0)) RETURN CALL S4R22(RRL,PR,TR) IF(RRL.LT.0.0D0) GO TO 1000 CALL S15R22(A) CALL S6R22(RRD,TR) CO1=1.0D0+(A(1)+(A(5)+(A(8)+A(18)*RRL**3)*RRL)*RRL)*RRL CO2=(D2*A(2)+(D3*A(6)/D2+(D4*A(9)/D3+(D5*A(12)/D4 - +(D9*A(21)/D8+(D11*A(24)/D10+(D12/D11)*A(26)*RRL) - *RRL*RRL)*RRL**4)*RRL)*RRL)*RRL)*RRL - -(A(2)+(A(6)/D2+(A(9)/D3+(A(12)/D4+(A(21)/D8+(A(24)/D10 - +(A(26)/D11)*RRD)*RRD*RRD)*RRD**4)*RRD)*RRD)*RRD)*RRD CO3=(D5*A(10)/D3+(D7*A(14)/D5+(D9*A(19)/D7 - +(D11*A(22)/D9+(D13/D11)*A(27)*RRL*RRL) - *RRL*RRL)*RRL*RRL)*RRL*RRL)*RRL**3 - -D2*(A(10)/D3+(A(14)/D5+(A(19)/D7+(A(22)/D9 - +(A(27)/D11)*RRD*RRD)*RRD*RRD)*RRD*RRD)*RRD*RRD)*RRD**3 CO4=A(15)*(D8*RRL**5-D3*RRD**5)/D5 CO5=(D5*A(3)+(D3*A(7)+(D7*A(11)/D3+(D2*A(13)+(D9/D5)*A(16)*RRL) - *RRL)*RRL)*RRL)*RRL - -D4*(A(3)+(A(7)/D2+(A(11)/D3+(A(13)/D4+(A(16)/D5)*RRD) - *RRD)*RRD)*RRD)*RRD CO6=(D7*A(4)+(D11*A(17)/D5+(D13*A(20)/D7+(D5*A(23)/D3+(D8*A(25)/D5 - +(D17/D11)*A(28)*RRL)*RRL)*RRL*RRL)*RRL*RRL)*RRL**4)*RRL - -D6*(A(4)+(A(17)/D5+(A(20)/D7+(A(23)/D9+(A(25)/D10 - +(A(28)/D11)*RRD)*RRD)*RRD*RRD)*RRD*RRD)*RRD**4)*RRD HLSUM=CO1+(CO2+(CO3+(CO4+(CO5+CO6/TR/TR)/TR)/TR)/TR)/TR CALL S1R22(PSR,TR) CALL S8R22(HD,TR) IF((PSR.LT.0.0D0).OR.(HD.LT.0.0D0)) GO TO 1000 HL=HD-PC*PSR/(RC*RRD)+GASC*TC*TR*HLSUM RETURN 1000 HL=-1.0D+10 RETURN END SUBROUTINE S10R22(SV,PR,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=3.69300D+02,GASC=9.615469D-02,B01=4.643862+00) PARAMETER(D2=2.0D0,D3=3.0D0,D4=4.0D0,D5=5.0D0, - D6=6.0D0,D7=7.0D0,D9=9.0D0,D11=11.0D0) DIMENSION A(1:28),A0(0:4),CO(1:11) SV=-1.0D+20 IF((PR.LE.0.0D0).AND.(TR.LE.0.0D0)) RETURN CALL S3R22(RRV,PR,TR) IF(RRV.LT.0.0D0) GO TO 1000 CALL S15R22(A) CO(1)=-(A(27)+D5*A(28)/TR**4)/(D11*TR*TR) CO(2)=-A(25)/(D2*TR**6) CO(3)=-(A(22)+D5*A(23)/TR**4)/(D9*TR*TR) CO(4)=0.0D0 CO(5)=-(A(19)+D5*A(20)/TR**4)/(D7*TR*TR) CO(6)=A(18)/D6 CO(7)=-(A(14)+(D2*A(15)+(D3*A(16)+D5*A(17)/TR/TR)/TR)/TR) - /(D5*TR*TR) CO(8)=-D3*A(13)/(D4*TR**4) CO(9)=(A(8)-(A(10)+D3*A(11)/TR/TR)/TR/TR)/D3 CO(10)=(A(5)-D3*A(7)/TR**4)/D2 CO(11)=A(1)-(D3*A(3)+D5*A(4)/TR/TR)/TR**4 SVSUM=0.0D0 DO 10 I=1,11 SVSUM=SVSUM*RRV+CO(I) 10 CONTINUE CALL S16R22(A0) T0R=273.15D0/TC SV=-GASC*(LOG(RRV)+SVSUM*RRV) - +(A0(0)-GASC)*LOG(TR/T0R) - +(A0(1)+(A0(2)/D2+(A0(3)/D3+A0(4)*TR/D4)*TR)*TR)*TR - -(A0(1)+(A0(2)/D2+(A0(3)/D3+A0(4)*T0R/D4)*T0R)*T0R)*T0R - +B01 RETURN 1000 SV=-1.0D+10 RETURN END SUBROUTINE S11R22(SD,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02) DIMENSION B(1:5) SD=-1.0D+20 IF(TR.LE.0.0D0) RETURN IF(TR.EQ.1.0D0) THEN CALL S10R22(SDD,1.0D0,1.0D0) SD=SDD RETURN END IF CALL S1R22(PSR,TR) CALL S3R22(RRDD,PSR,TR) CALL S10R22(SDD,PSR,TR) IF((RRDD.LT.0.0D0).OR.(SDD.LT.0.0D0)) GO TO 1000 CALL S6R22(RRD,TR) CALL S17R22(B) TR1=ABS(1.0D0-TR) SD=SDD+(PC/(RC*TC))*(PSR/(TR*TR))*(1.0D0/RRDD-1.0D0/RRD) - *(B(1)+B(2)*(1.0D0+0.5D0*TR)*SQRT(TR1) - +(B(3)*(1.0D0+2.0D0*TR)+B(4)*(1.0D0+3.0D0*TR)*TR1 - +B(5)*(1.0D0+4.0D0*TR)*TR1*TR1)*TR1*TR1) RETURN 1000 SD=-1.0D+10 RETURN END SUBROUTINE S12R22(SL,PR,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(GASC=9.615469D-02) PARAMETER(D2=2.0D0,D3=3.0D0,D4=4.0D0,D5=5.0D0, - D6=6.0D0,D7=7.0D0,D9=9.0D0,D11=11.0D0) DIMENSION A(1:28),CO(1:11) SL=-1.0D+20 IF((PR.LE.0.0D0).AND.(TR.LE.0.0D0)) RETURN CALL S4R22(RRL,PR,TR) IF(RRL.LT.0.0D0) GO TO 1000 CALL S15R22(A) CALL S6R22(RRD,TR) CO(1)=-(A(27)+D5*A(28)/TR**4)/(D11*TR*TR) CO(2)=-(A(25)/(D2*TR**6)) CO(3)=-(A(22)+D5*A(23)/TR**4)/(D9*TR*TR) CO(4)=0.0D0 CO(5)=-(A(19)+D5*A(20)/TR**4)/(D7*TR*TR) CO(6)=A(18)/D6 CO(7)=-(A(14)+(D2*A(15)+(D3*A(16)+D5*A(17)/TR/TR)/TR)/TR) - /(D5*TR*TR) CO(8)=-D3*A(13)/(D4*TR**4) CO(9)=(A(8)-(A(10)+D3*A(11)/TR/TR)/TR/TR)/D3 CO(10)=(A(5)-D3*A(7)/TR**4)/D2 CO(11)=A(1)-(D3*A(3)+D5*A(4)/TR/TR)/TR**4 SLSUML=0.0D0 SLSUMD=0.0D0 DO 10 I=1,11 SLSUML=SLSUML*RRL+CO(I) SLSUMD=SLSUMD*RRD+CO(I) 10 CONTINUE CALL S11R22(SD,TR) IF(SD.LT.0.0D0) GO TO 1000 SL=SD-GASC*(LOG(RRL/RRD)+SLSUML*RRL-SLSUMD*RRD) RETURN 1000 SL=-1.0D+10 RETURN END SUBROUTINE S13R22(CPVKW,PR,TR,ICPVKW) ******ICPVKW=1......CPVKW=CP(ISOCHORIC SPECIFIC HEAT CAPACITY) ******ICPVKW=2......CPVKW=CV(ISOBARIC SPECIFIC HEAT CAPACITY) ******ICPVKW=3......CPVKW=K (ISENTROPIC EXPONENT) ******ICPVKW=4......CPVKW=W (VELOCITY OF SOUND) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02, - GASC=9.615469D-02) PARAMETER(D2=2.0D0,D3=3.0D0,D4=4.0D0,D5=5.0D0,D6=6.0D0,D7=7.0D0, - D8=8.0D0,D9=9.0D0,D10=10.0D0,D11=11.0D0,D12=12.0D0,D30=30.0D0) DIMENSION A(1:28),A0(0:4),CX(1:12),CY(1:12),CO(1:10) CPVKW=-1.0D+20 IF((PR.LE.0.0D0).AND.(TR.LE.0.0D0)) RETURN CALL S3R22(RRV,PR,TR) IF(RRV.LT.0.0D0) GO TO 1000 CALL S15R22(A) CO(1)=-(D2*A(27)+D30*A(28)/TR**4)/(D11*TR*TR) CO(2)=-D3*A(25)/TR**6 CO(3)=-(D2*A(22)+D30*A(23)/TR**4)/(D9*TR*TR) CO(4)=0.0D0 CO(5)=-(D2*A(19)+D30*A(20)/TR**4)/(D7*TR*TR) CO(6)=-(D2*A(14)+(D6*A(15)+(D12*A(16)+D30*A(17)/TR/TR)/TR)/TR) - /(D5*TR*TR) CO(7)=-D3*A(13)/TR**4 CO(8)=-(D2*A(10)/D3+D4*A(11)/TR/TR)/TR/TR CO(9)=-D6*A(7)/TR**4 CO(10)=-(D12*A(3)+D30*A(4)/TR/TR)/TR**4 CPVSUM=0.0D0 DO 10 I=1,10 CPVSUM=CPVSUM*RRV+CO(I) 10 CONTINUE CALL S16R22(A0) CV=GASC*RRV*CPVSUM - +(A0(0)-GASC)+(A0(1)+(A0(2)+(A0(3)+A0(4)*TR)*TR)*TR)*TR IF (ICPVKW.EQ.2) THEN CPVKW=CV RETURN END IF * CX(1)=-(A(27)+D5*A(28)/TR**4)/TR/TR CX(2)=-D5*A(25)/TR**6 CX(3)=-(A(22)+D5*A(23)/TR**4)/TR/TR CX(4)=0.0D0 CX(5)=-(A(19)+D5*A(20)/TR**4)/TR/TR CX(6)=A(18) CX(7)=-(A(14)+(D2*A(15)+(D3*A(16)+D5*A(17)/TR/TR)/TR)/TR)/TR/TR CX(8)=-D3*A(13)/TR**4 CX(9)=A(8)-(A(10)+D3*A(11)/TR/TR)/TR/TR CX(10)=A(5)-D3*A(7)/TR**4 CX(11)=A(1)-(D3*A(3)+D5*A(4)/TR/TR)/TR**4 CX(12)=1.0D0 CY(1)=D12*(A(26)+(A(27)+A(28)/TR**4)/TR)/TR CY(2)=D11*(A(24)+A(25)/TR**5)/TR CY(3)=D10*(A(22)+A(23)/TR**5)/TR CY(4)=D9*A(21)/TR CY(5)=D8*(A(19)+A(20)/TR**4)/TR/TR CY(6)=D7*A(18) CY(7)=D6*(A(14)+(A(15)+(A(16)+A(17)/TR/TR)/TR)/TR)/TR/TR CY(8)=D5*(A(12)+A(13)/TR**3)/TR CY(9)=D4*(A(8)+(A(9)+(A(10)+A(11)/TR/TR)/TR)/TR) CY(10)=D3*(A(5)+(A(6)+A(7)/TR**3)/TR) CY(11)=D2*(A(1)+(A(2)+(A(3)+A(4)/TR/TR)/TR**3)/TR) CY(12)=1.0D0 X=0.0D0 Y=0.0D0 DO 20 I=1,12 X=X*RRV+CX(I) Y=Y*RRV+CY(I) 20 CONTINUE CP=CV+GASC*X*X/Y IF (ICPVKW.EQ.1) THEN CPVKW=CP ELSE IF (ICPVKW.EQ.3) THEN CPVKW=(GASC*RC*TC/PC)*(RRV*TR/PR)*(CP/CV)*Y ELSE IF (ICPVKW.EQ.4) THEN CPVKW=SQRT((GASC*1.0D+03*TC*TR)*(CP/CV)*Y) END IF RETURN 1000 CPVKW=-1.0D+10 RETURN END SUBROUTINE S14R22(CPD,T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA CO1/ 1.56005D+00/, CO2/-1.05165D-02/, - CO3/ 8.31935D-05/, CO4/-2.98753D-07/, - CO5/ 4.24557D-10/ CPD=CO1+(CO2+(CO3+(CO4+CO5*T)*T)*T)*T RETURN END SUBROUTINE S15R22(AR22) DOUBLE PRECISION AR22(1:28),A(1:28) DATA A( 1)/ 5.45762D-01/, A( 2)/-1.39198D+00/, - A( 3)/-4.32562D-01/, A( 4)/ 2.214D-02/, - A( 5)/-1.307418D-01/, A( 6)/ 7.9211D-01/, - A( 7)/-1.67024D-01/, A( 8)/ 5.6743874D-01/, - A( 9)/-1.35071D+00/, A(10)/-1.15487D-01/, - A(11)/ 1.024567D+00/, A(12)/ 3.4435035D-01/, - A(13)/-4.082677D-01/, A(14)/ 8.30099D-02/, - A(15)/-1.899033D-01/, A(16)/ 8.821727D-02/, - A(17)/ 1.90595D-02/, A(18)/-3.76347D-02/, - A(19)/ 3.329212D-02/, A(20)/-3.794234D-02/, - A(21)/ 7.86909D-03/, A(22)/-4.626965D-03/, - A(23)/ 2.336405D-02/, A(24)/-2.066556D-03/, - A(25)/-1.0501834D-02/, A(26)/ 5.276995D-04/, - A(27)/ 2.09547D-04/, A(28)/ 1.346363D-03/ DO 10 I=1,28 AR22(I)=A(I) 10 CONTINUE RETURN END SUBROUTINE S16R22(A0R22) DOUBLE PRECISION A0R22(0:4),A0(0:4) DATA A0(0)/ 3.37055D-01/, A0(1)/ 1.045219D-01/ - A0(2)/ 7.32804D-01/, A0(3)/-6.11404D-01/, - A0(4)/ 1.61807D-01/ DO 10 I=0,4 A0R22(I)=A0(I) 10 CONTINUE RETURN END SUBROUTINE S17R22(BR22) DOUBLE PRECISION BR22(1:5),B(1:5) DATA B(1)/-7.0340913D+00/, B(2)/ 1.4030736D+00/, - B(3)/-4.9605880D+00/, B(4)/ 8.8828089D+00/, - B(5)/-1.0600638D+01/ DO 10 I=1,5 BR22(I)=B(I) 10 CONTINUE RETURN END SUBROUTINE S18R22(TR,PR,Y,T1R,T2R,Y1,Y2,IHS) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(EPS=1.0D-07,ITMAX=10000) DO 10 IT=1,ITMAX DELT=(Y-Y2)*(T2R-T1R)/(Y2-Y1) IF(ABS(DELT/T1R).LT.EPS) THEN TR=T2R RETURN END IF T1R=T2R Y1=Y2 T2R=T2R+DELT IF(IHS.EQ.1) THEN CALL S7R22(Y2,PR,T2R) ELSE IF(IHS.EQ.2) THEN CALL S9R22(Y2,PR,T2R) ELSE IF(IHS.EQ.3) THEN CALL S10R22(Y2,PR,T2R) ELSE IF(IHS.EQ.4) THEN CALL S12R22(Y2,PR,T2R) END IF IF(Y2.LT.0.0D0) GO TO 1000 10 CONTINUE 1000 TR=-1.0D+10 RETURN END SUBROUTINE S19R22(TRV,PR,RR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02, - GASC=9.615469D-02) TRV=-1.0D+20 IF((PR.LE.0.0D0).AND.(RR.LE.0.0D0)) RETURN TRV=1.0D0 IF((PR.EQ.1.0D0).AND.(RR.EQ.1.0D0)) RETURN IF(PR.GE.1.0D0) THEN TRVI=PC*PR/(GASC*RC*TC*RR) ELSE CALL S2R22(TSR,PR) TRVI=TSR END IF CALL S20R22(TRVL,PR,RR,TRVI) TRV=TRVL RETURN END SUBROUTINE S20R22(TR,PR,RR,TRI) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02, - GASC=9.615469D-02,ITMAX=10000,EPS=1.0D-12) DIMENSION A(1:28) CALL S15R22(A) CO1=1.0D0+(A(1)+(A(5)+(A(8)+A(18)*RR*RR*RR)*RR)*RR)*RR CO2=(A(2)+(A(6)+(A(9)+(A(12)+(A(21)+(A(24)+A(26)*RR)*RR*RR) - *RR**4)*RR)*RR)*RR)*RR-PC*PR/(GASC*RC*TC*RR) CO3=(A(10)+(A(14)+(A(19)+(A(22)+A(27)*RR*RR)*RR*RR)*RR*RR)*RR*RR) - *RR*RR*RR CO4=A(15)*RR**5 CO5=(A(3)+(A(7)+(A(11)+(A(13)+A(16)*RR)*RR)*RR)*RR)*RR CO6=(A(4)+(A(17)+(A(20)+(A(23)+(A(25)+A(28)*RR)*RR)*RR*RR) - *RR*RR)*RR**4)*RR XTR=1.0D0/TRI DO 10 IT=1,ITMAX F=CO1+(CO2+(CO3+(CO4+(CO5+CO6*XTR*XTR)*XTR)*XTR)*XTR)*XTR DF=CO2+(2.0D0*CO3+(3.0D0*CO4+(4.0D0*CO5+6.0D0*CO6*XTR*XTR) - *XTR)*XTR)*XTR XTR=XTR-F/DF IF(ABS(-F/(DF*RR)).LT.EPS) THEN TR=1.0D0/XTR RETURN END IF 10 CONTINUE TR=-1.0D+10 RETURN END SUBROUTINE S90R22(FP,FCT,PR,TR,ILL,IVL) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.9880D+03,TC=3.69300D+02,RC=5.130D+02) DATA EPSPC/1.0D-05/,EPSTC/1.0D-05/,EPSTS/1.0D-05/ PR=DBLE(FP)*1.0D+02/PC TR=(DBLE(FCT)+273.15D0)/TC ILL=10000 IVL=-1 IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(TR-1.0D0).LT.EPSTC)) THEN PR=1.0D0 TR=1.0D0 ILL=0 IVL=1 RETURN END IF IF((FP.LT.0.019).OR.(FP.GT.150.0)) RETURN IF(FP.GT.6.6214) THEN FVMIN=0.00080 FCTMIN=F70R22(FP,FVMIN) ELSE FCTMIN=F40R22(FP) END IF IF((FP.GT.49.7).AND.(FP.LT.49.88)) THEN FCTL=F40R22(FP)-0.1 FCTU=F40R22(FP)+0.1 IF((FCT.GT.FCTL).AND.(FCT.LT.FCTU)) RETURN END IF IF((FCTMIN.LE.-1.0E+10).OR.(FCTL.LE.-1.0E+10).OR. - (FCTU.LE.-1.0E+10)) RETURN IF((FCT.LT.FCTMIN).OR.(FCT.GT.200.0)) RETURN IF(PR.GE.1.0D0) THEN IF(ABS(TR-1.0D0).LT.EPSTC) THEN IVL=1 TR=1.0D0 ELSE IF(TR.GT.1.0D0) THEN IVL=1 ELSE IVL=2 END IF ELSE CALL S2R22(TSR,PR) IF(TSR.LT.0.0D0) GO TO 1000 IF(ABS(TR-TSR).LT.EPSTS) THEN IVL=1 TR=TSR ELSE IF(TR.GT.TSR) THEN IVL=1 ELSE IVL=2 END IF END IF ILL=0 RETURN 1000 ILL=1000 RETURN END *-------------------------ERROR MESSAGES FOR LEVEL 1, 2 AND 3------ SUBROUTINE S97R22(NFUN) *** LEVEL 1 ERROR MESSAGE *** CHARACTER NFUN*6, MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** NO CONVERGENCE AT '//NFUN//' FOR R22 ****' WRITE(6,1000) MSG 1000 FORMAT(1H ,5X,A) END IF RETURN END SUBROUTINE S98R22(IARG,ARG1,ARG2,NARG1,NARG2,NFUN) *** LEVEL 2 ERROR MESSAGE *** *** IARG=1 FOR ONE ARGUMENT (SECOND ARGUMENT IS DUMMY) *** IARG=2 FOR TWO ARGUMENTS CHARACTER NFUN*6, NARG1*1,NARG2*1 INTEGER IARG,KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN IF (IARG.EQ.1) THEN WRITE(6,2000) NFUN,NARG1,ARG1 ELSE IF (IARG.EQ.2) THEN WRITE(6,2010) NFUN,NARG1,ARG1,NARG2,ARG2 END IF END IF 2000 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR R22', - ' WHEN ',A1,' =', 1PE14.7,' ****') 2010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR R22', - ' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') RETURN END SUBROUTINE S99R22(NFUN) *** LEVEL 3 ERROR MESSAGE *** CHARACTER NFUN*6, MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//NFUN//' UNAVAILABLE FOR R22 ****' WRITE(6,3000) MSG 3000 FORMAT(1H ,5X,A) END IF RETURN END REAL FUNCTION T90(T) * Conversion of temperature scal from IPTS-68 to ITS-90 * Range -200C<=T68<=630C anf T68>=1064 REAL T68,T0K REAL*8 CA(8) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA CA/-0.14542, -0.26722, 1.06471, 1.131286, -4.25835, + -1.59924, 7.29176, -3.52573/ IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF T68=T-T0K * Check of argument range IF((-200.0.LE.T68).AND.(T68.LE.630.0)) THEN RT68=T68/630.0 TEMP=T68+RT68*(CA(1)+RT68*(CA(2)+RT68*(CA(3)+RT68*(CA(4) + +RT68*(CA(5)+RT68*(CA(6)+RT68*(CA(7)+RT68*CA(8)))))))) ELSE IF((1064.0.LE.T68).AND.(T68.LE.3000.0)) THEN TEMP=T68-0.25*(T68+273.15)*(T68+273.15)/1337.33/1337.33 ELSE IF(MESS.NE.0) WRITE(6,6020) T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT T90', & ' WHEN T68 =',1PE14.7,' ****') T90=-1.0E+20 RETURN END IF T90=TEMP+T0K RETURN END REAL FUNCTION T68(T) * Conversion of temperature scal from ITS-90 to IPTS-68 * Range -200C<=T68<=630C anf T68>=1064 T1=T90(T) T2=T ITER=0 DT=T-T1 1000 CONTINUE ITER=ITER+1 IF(ITER.GE.10000) THEN WRITE(6,*) ' ITERATION EXCEEDED MAXIMUM ' T68=-1.0E+10 RETURN END IF T2=T2+DT T1=T90(T2) DT=T-T1 IF(ABS(DT).GE.1.0E-4) GOTO 1000 T68=T2 RETURN END * Subroutine Program Specifying KPA and MESS * MS-FORTRAN and MS-C Mixed Langage Programing * SUBROUTINE KPAMES(KPAC,MESSC) COMMON/UNIT/KPA,MESS INTEGER KPAC INTEGER MESSC KPA=KPAC MESS=MESSC RETURN END