*=====PR12V71 ====1990.5.30==========================================* *=====PAR12 ======1997.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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(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 S99R12(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== *------------------------------------------------- F1R12 = AIPPT REAL FUNCTION AIPPT(P,T) REAL P,PI,T,TI PI=P TI=T CALL S99R12('AIPPT') AIPPT=-1.0E+30 RETURN END *------------------------------------------------- F2R12 = ALAPP REAL FUNCTION ALAPP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) ALAPP=F2R12(PI) IF(ALAPP.EQ.-1.0E+10) THEN CALL S97R12('ALAPP') ELSE IF(ALAPP.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','ALAPP') END IF RETURN END *------------------------------------------------- F3R12 = ALAPT REAL FUNCTION ALAPT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) ALAPT=F3R12(TI) IF(ALAPT.EQ.-1.0E+10) THEN CALL S97R12('ALAPT') ELSE IF(ALAPT.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','ALAPT') END IF RETURN END *------------------------------------------------- F4R12 = ALHP REAL FUNCTION ALHP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) ALHP=F4R12(PI) IF(ALHP.EQ.-1.0E+10) THEN CALL S97R12('ALHP') ELSE IF(ALHP.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','ALHP') END IF RETURN END *------------------------------------------------- F5R12 = ALHT REAL FUNCTION ALHT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) ALHT=F5R12(TI) IF(ALHT.EQ.-1.0E+10) THEN CALL S97R12('ALHT') ELSE IF(ALHT.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','ALHT') END IF RETURN END *------------------------------------------------- F6R12 = ALMPD REAL FUNCTION ALMPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) ALMPD=F6R12(PI) IF(ALMPD.EQ.-1.0E+10) THEN CALL S97R12('ALMPD') ELSE IF(ALMPD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','ALMPD') END IF RETURN END *------------------------------------------------- F7R12 = ALMPDD REAL FUNCTION ALMPDD(P) REAL P,PI PI=P CALL S99R12('ALMPDD') ALMPDD=-1.0E+30 RETURN END *------------------------------------------------- F8R12 = ALMPT REAL FUNCTION ALMPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) ALMPT=F8R12(PI,TI) IF(ALMPT.EQ.-1.0E+10) THEN CALL S97R12('ALMPT') ELSE IF(ALMPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','ALMPT') END IF RETURN END *------------------------------------------------- F9R12 = ALMTD REAL FUNCTION ALMTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) ALMTD=F9R12(TI) IF(ALMTD.EQ.-1.0E+10) THEN CALL S97R12('ALMTD') ELSE IF(ALMTD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','ALMTD') END IF RETURN END *------------------------------------------------- F10R12 = ALMTDD REAL FUNCTION ALMTDD(T) REAL T,TI TI=T CALL S99R12('ALMTDD') ALMTDD=-1.0E+30 RETURN END *------------------------------------------------- F11R12 = AMUPD REAL FUNCTION AMUPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) AMUPD=F11R12(PI) IF(AMUPD.EQ.-1.0E+10) THEN CALL S97R12('AMUPD') ELSE IF(AMUPD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','AMUPD') END IF RETURN END *------------------------------------------------- F12R12 = AMUPDD REAL FUNCTION AMUPDD(P) REAL P,PI PI=P CALL S99R12('AMUPDD') AMUPDD=-1.0E+30 RETURN END *------------------------------------------------- F13R12 = AMUPT REAL FUNCTION AMUPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) AMUPT=F13R12(PI,TI) IF(AMUPT.EQ.-1.0E+10) THEN CALL S97R12('AMUPT') ELSE IF(AMUPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','AMUPT') END IF RETURN END *------------------------------------------------- F14R12 = AMUTD REAL FUNCTION AMUTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) AMUTD=F14R12(TI) IF(AMUTD.EQ.-1.0E+10) THEN CALL S97R12('AMUTD') ELSE IF(AMUTD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','AMUTD') END IF RETURN END *------------------------------------------------- F15R12 = AMUTDD REAL FUNCTION AMUTDD(T) REAL T,TI TI=T CALL S99R12('AMUTDD') AMUTDD=-1.0E+30 RETURN END *------------------------------------------------- F16R12 = CPPD REAL FUNCTION CPPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) CPPD=F16R12(PI) IF(CPPD.EQ.-1.0E+10) THEN CALL S97R12('CPPD') ELSE IF(CPPD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','CPPD') END IF RETURN END *------------------------------------------------- F17R12 = CPPDD REAL FUNCTION CPPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) CPPDD=F17R12(PI) IF(CPPDD.EQ.-1.0E+10) THEN CALL S97R12('CPPDD') ELSE IF(CPPDD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','CPPDD') END IF RETURN END *------------------------------------------------- F18R12 = CPPT REAL FUNCTION CPPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) CPPT=F18R12(PI,TI) IF(CPPT.EQ.-1.0E+10) THEN CALL S97R12('CPPT') ELSE IF(CPPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','CPPT') END IF RETURN END *------------------------------------------------- F19R12 = CPTD REAL FUNCTION CPTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) CPTD=F19R12(TI) IF(CPTD.EQ.-1.0E+10) THEN CALL S97R12('CPTD') ELSE IF(CPTD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','CPTD') END IF RETURN END *------------------------------------------------- F20R12 = CPTDD REAL FUNCTION CPTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) CPTDD=F20R12(TI) IF(CPTDD.EQ.-1.0E+10) THEN CALL S97R12('CPTDD') ELSE IF(CPTDD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','CPTDD') END IF RETURN END *------------------------------------------------- F21R12 = 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=F21R12(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 R12', - ' 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 *------------------------------------------------- F22R12 = EPSPT REAL FUNCTION EPSPT(P,T) REAL P,PI,T,TI PI=P TI=T CALL S99R12('EPSPT') EPSPT=-1.0E+30 RETURN END C------------------------------------------------- F89 = 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='120.9138' WHEN A='M' C B='68.7625' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=120.9138 ELSE IF (A.EQ.'R') THEN FC=68.7625 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR REFRIGERANT 12 WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END *------------------------------------------------- F23R12 = HPD REAL FUNCTION HPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) HPD=F23R12(PI) IF(HPD.EQ.-1.0E+10) THEN CALL S97R12('HPD') ELSE IF(HPD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','HPD') END IF RETURN END *------------------------------------------------- F24R12 = HPDD REAL FUNCTION HPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) HPDD=F24R12(PI) IF(HPDD.EQ.-1.0E+10) THEN CALL S97R12('HPDD') ELSE IF(HPDD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','HPDD') END IF RETURN END *------------------------------------------------- F25R12 = HPT REAL FUNCTION HPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) HPT=F25R12(PI,TI) IF(HPT.EQ.-1.0E+10) THEN CALL S97R12('HPT') ELSE IF(HPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','HPT') END IF RETURN END *------------------------------------------------- F26R12 = HPX REAL FUNCTION HPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) HPX=F26R12(PI,X) IF(HPX.EQ.-1.0E+10) THEN CALL S97R12('HPX') ELSE IF(HPX.EQ.-1.0E+20) THEN CALL S98R12(2,P,X,'P','X','HPX') END IF RETURN END *------------------------------------------------- F27R12 = HTD REAL FUNCTION HTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) HTD=F27R12(TI) IF(HTD.EQ.-1.0E+10) THEN CALL S97R12('HTD') ELSE IF(HTD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','HTD') END IF RETURN END *------------------------------------------------- F28R12 = HTDD REAL FUNCTION HTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) HTDD=F28R12(TI) IF(HTDD.EQ.-1.0E+10) THEN CALL S97R12('HTDD') ELSE IF(HTDD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','HTDD') END IF RETURN END *------------------------------------------------- F29R12 = HTX REAL FUNCTION HTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) HTX=F29R12(TI,X) IF(HTX.EQ.-1.0E+10) THEN CALL S97R12('HTX') ELSE IF(HTX.EQ.-1.0E+20) THEN CALL S98R12(2,T,X,'T','X','HTX') END IF RETURN END *------------------------------------------------- F84R12 = 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 12' WHEN A='S' C B='CCL2F2' 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 12' ELSE IF (A.EQ.'C') THEN IDENTF='CCL2F2' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR REFRIGERANT 12 WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END *------------------------------------------------- F30R12 = PST REAL FUNCTION PST(T) REAL TI,T INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) PST=F30R12(TI) IF(PST.EQ.-1.0E+10) THEN CALL S97R12('PST') RETURN ELSE IF(PST.EQ.-1.0E+20) THEN CALL S98R12(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 *------------------------------------------------- F31R12 = SIGP REAL FUNCTION SIGP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) SIGP=F31R12(PI) IF(SIGP.EQ.-1.0E+10) THEN CALL S97R12('SIGP') ELSE IF(SIGP.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','SIGP') END IF RETURN END *------------------------------------------------- F32R12 = SIGT REAL FUNCTION SIGT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) SIGT=F32R12(TI) IF(SIGT.EQ.-1.0E+10) THEN CALL S97R12('SIGT') ELSE IF(SIGT.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','SIGT') END IF RETURN END *------------------------------------------------- F33R12 = SPD REAL FUNCTION SPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) SPD=F33R12(PI) IF(SPD.EQ.-1.0E+10) THEN CALL S97R12('SPD') ELSE IF(SPD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','SPD') END IF RETURN END *------------------------------------------------- F34R12 = SPDD REAL FUNCTION SPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) SPDD=F34R12(PI) IF(SPDD.EQ.-1.0E+10) THEN CALL S97R12('SPDD') ELSE IF(SPDD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','SPDD') END IF RETURN END *------------------------------------------------- F35R12 = SPT REAL FUNCTION SPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) SPT=F35R12(PI,TI) IF(SPT.EQ.-1.0E+10) THEN CALL S97R12('SPT') ELSE IF(SPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','SPT') END IF RETURN END *------------------------------------------------- F36R12 = SPX REAL FUNCTION SPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) SPX=F36R12(PI,X) IF(SPX.EQ.-1.0E+10) THEN CALL S97R12('SPX') ELSE IF(SPX.EQ.-1.0E+20) THEN CALL S98R12(2,P,X,'P','X','SPX') END IF RETURN END *------------------------------------------------- F37R12 = STD REAL FUNCTION STD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) STD=F37R12(TI) IF(STD.EQ.-1.0E+10) THEN CALL S97R12('STD') ELSE IF(STD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','STD') END IF RETURN END *------------------------------------------------- F38R12 = STDD REAL FUNCTION STDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) STDD=F38R12(TI) IF(STDD.EQ.-1.0E+10) THEN CALL S97R12('STDD') ELSE IF(STDD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','STDD') END IF RETURN END *------------------------------------------------- F39R12 = STX REAL FUNCTION STX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) STX=F39R12(TI,X) IF(STX.EQ.-1.0E+10) THEN CALL S97R12('STX') ELSE IF(STX.EQ.-1.0E+20) THEN CALL S98R12(2,T,X,'T','X','STX') END IF RETURN END *------------------------------------------------- F40R12 = TSP REAL FUNCTION TSP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TSP=F40R12(PI) IF(TSP.EQ.-1.0E+10) THEN CALL S97R12('TSP') RETURN ELSE IF(TSP.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','TSP') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TSP=TSP+273.15 RETURN END *------------------------------------------------- F41R12 = TRPL REAL FUNCTION TRPL(A) CHARACTER A*1,AI*1 AI=A CALL S99R12('TRPL') TRPL=-1.0E+30 RETURN END *------------------------------------------------- F42R12 = UPD REAL FUNCTION UPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) UPD=F42R12(PI) IF(UPD.EQ.-1.0E+10) THEN CALL S97R12('UPD') ELSE IF(UPD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','UPD') END IF RETURN END *------------------------------------------------- F43R12 = UPDD REAL FUNCTION UPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) UPDD=F43R12(PI) IF(UPDD.EQ.-1.0E+10) THEN CALL S97R12('UPDD') ELSE IF(UPDD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','UPDD') END IF RETURN END *------------------------------------------------- F44R12 = UPT REAL FUNCTION UPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) UPT=F44R12(PI,TI) IF(UPT.EQ.-1.0E+10) THEN CALL S97R12('UPT') ELSE IF(UPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','UPT') END IF RETURN END *------------------------------------------------- F45R12 = UPX REAL FUNCTION UPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) UPX=F45R12(PI,X) IF(UPX.EQ.-1.0E+10) THEN CALL S97R12('UPX') ELSE IF(UPX.EQ.-1.0E+20) THEN CALL S98R12(2,P,X,'P','X','UPX') END IF RETURN END *------------------------------------------------- F46R12 = UTD REAL FUNCTION UTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) UTD=F46R12(TI) IF(UTD.EQ.-1.0E+10) THEN CALL S97R12('UTD') ELSE IF(UTD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','UTD') END IF RETURN END *------------------------------------------------- F47R12 = UTDD REAL FUNCTION UTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) UTDD=F47R12(TI) IF(UTDD.EQ.-1.0E+10) THEN CALL S97R12('UTDD') ELSE IF(UTDD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','UTDD') END IF RETURN END *------------------------------------------------- F48R12 = UTX REAL FUNCTION UTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) UTX=F48R12(TI,X) IF(UTX.EQ.-1.0E+10) THEN CALL S97R12('UTX') ELSE IF(UTX.EQ.-1.0E+20) THEN CALL S98R12(2,T,X,'T','X','UTX') END IF RETURN END *------------------------------------------------- F49R12 = VPD REAL FUNCTION VPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) VPD=F49R12(PI) IF(VPD.EQ.-1.0E+10) THEN CALL S97R12('VPD') ELSE IF(VPD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','VPD') END IF RETURN END *------------------------------------------------- F50R12 = VPDD REAL FUNCTION VPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) VPDD=F50R12(PI) IF(VPDD.EQ.-1.0E+10) THEN CALL S97R12('VPDD') ELSE IF(VPDD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','VPDD') END IF RETURN END *------------------------------------------------- F51R12 = VPT REAL FUNCTION VPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) VPT=F51R12(PI,TI) IF(VPT.EQ.-1.0E+10) THEN CALL S97R12('VPT') ELSE IF(VPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','VPT') END IF RETURN END *------------------------------------------------- F52R12 = VPX REAL FUNCTION VPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) VPX=F52R12(PI,X) IF(VPX.EQ.-1.0E+10) THEN CALL S97R12('VPX') ELSE IF(VPX.EQ.-1.0E+20) THEN CALL S98R12(2,P,X,'P','X','VPX') END IF RETURN END *------------------------------------------------- F53R12 = VTD REAL FUNCTION VTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) VTD=F53R12(TI) IF(VTD.EQ.-1.0E+10) THEN CALL S97R12('VTD') ELSE IF(VTD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','VTD') END IF RETURN END *------------------------------------------------- F54R12 = VTDD REAL FUNCTION VTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) VTDD=F54R12(TI) IF(VTDD.EQ.-1.0E+10) THEN CALL S97R12('VTDD') ELSE IF(VTDD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','VTDD') END IF RETURN END *------------------------------------------------- F55R12 = VTX REAL FUNCTION VTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) VTX=F55R12(TI,X) IF(VTX.EQ.-1.0E+10) THEN CALL S97R12('VTX') ELSE IF(VTX.EQ.-1.0E+20) THEN CALL S98R12(2,T,X,'T','X','VTX') END IF RETURN END *------------------------------------------------- F56R12 = XPH REAL FUNCTION XPH(P,H) REAL P,PI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) XPH=F56R12(PI,H) IF(XPH.EQ.-1.0E+10) THEN CALL S97R12('XPH') ELSE IF(XPH.EQ.-1.0E+20) THEN CALL S98R12(2,P,H,'P','H','XPH') END IF RETURN END *------------------------------------------------- F57R12 = XPS REAL FUNCTION XPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) XPS=F57R12(PI,S) IF(XPS.EQ.-1.0E+10) THEN CALL S97R12('XPS') ELSE IF(XPS.EQ.-1.0E+20) THEN CALL S98R12(2,P,S,'P','S','XPS') END IF RETURN END *------------------------------------------------- F58R12 = XPU REAL FUNCTION XPU(P,U) REAL P,PI,U INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) XPU=F58R12(PI,U) IF(XPU.EQ.-1.0E+10) THEN CALL S97R12('XPU') ELSE IF(XPU.EQ.-1.0E+20) THEN CALL S98R12(2,P,U,'P','U','XPU') END IF RETURN END *------------------------------------------------- F59R12 = XPV REAL FUNCTION XPV(P,V) REAL P,PI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) XPV=F59R12(PI,V) IF(XPV.EQ.-1.0E+10) THEN CALL S97R12('XPV') ELSE IF(XPV.EQ.-1.0E+20) THEN CALL S98R12(2,P,V,'P','V','XPV') END IF RETURN END *------------------------------------------------- F60R12 = XTH REAL FUNCTION XTH(T,H) REAL T,TI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) XTH=F60R12(TI,H) IF(XTH.EQ.-1.0E+10) THEN CALL S97R12('XTH') ELSE IF(XTH.EQ.-1.0E+20) THEN CALL S98R12(2,T,H,'T','H','XTH') END IF RETURN END *------------------------------------------------- F61R12 = XTS REAL FUNCTION XTS(T,S) REAL T,TI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) XTS=F61R12(TI,S) IF(XTS.EQ.-1.0E+10) THEN CALL S97R12('XTS') ELSE IF(XTS.EQ.-1.0E+20) THEN CALL S98R12(2,T,S,'T','S','XTS') END IF RETURN END *------------------------------------------------- F62R12 = XTU REAL FUNCTION XTU(T,U) REAL T,TI,U INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) XTU=F62R12(TI,U) IF(XTU.EQ.-1.0E+10) THEN CALL S97R12('XTU') ELSE IF(XTU.EQ.-1.0E+20) THEN CALL S98R12(2,T,U,'T','U','XTU') END IF RETURN END *------------------------------------------------- F63R12 = XTV REAL FUNCTION XTV(T,V) REAL T,TI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) XTV=F63R12(TI,V) IF(XTV.EQ.-1.0E+10) THEN CALL S97R12('XTV') ELSE IF(XTV.EQ.-1.0E+20) THEN CALL S98R12(2,T,V,'T','V','XTV') END IF RETURN END *------------------------------------------------- F64R12 = TPH REAL FUNCTION TPH(P,H) REAL P,PI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TPH=F64R12(PI,H) IF(TPH.EQ.-1.0E+10) THEN CALL S97R12('TPH') RETURN ELSE IF(TPH.EQ.-1.0E+20) THEN CALL S98R12(2,P,H,'P','H','TPH') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPH=TPH+273.15 RETURN END *------------------------------------------------- F65R12 = TPS REAL FUNCTION TPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TPS=F65R12(PI,S) IF(TPS.EQ.-1.0E+10) THEN CALL S97R12('TPS') RETURN ELSE IF(TPS.EQ.-1.0E+20) THEN CALL S98R12(2,P,S,'P','S','TPS') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPS=TPS+273.15 RETURN END *------------------------------------------------- F66R12 = PLDT REAL FUNCTION PLDT(T) REAL T,TI TI=T CALL S99R12('PLDT') PLDT=-1.0E+30 RETURN END *------------------------------------------------- F67R12 = TLDP REAL FUNCTION TLDP(P) REAL P,PI PI=P CALL S99R12('TLDP') TLDP=-1.0E+30 RETURN END *------------------------------------------------- F68R12 = PMLT REAL FUNCTION PMLT(T) REAL T,TI TI=T CALL S99R12('PMLT') PMLT=-1.0E+30 RETURN END *------------------------------------------------- F69R12 = TMLP REAL FUNCTION TMLP(P) REAL P,PI PI=P CALL S99R12('TMLP') TMLP=-1.0E+30 RETURN END *------------------------------------------------- F70R12 = TPV REAL FUNCTION TPV(P,V) REAL P,PI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TPV=F70R12(PI,V) IF(TPV.EQ.-1.0E+10) THEN CALL S97R12('TPV') RETURN ELSE IF(TPV.EQ.-1.0E+20) THEN CALL S98R12(2,P,V,'P','V','TPV') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPV=TPV+273.15 RETURN END *------------------------------------------------- F71R12 = HPS REAL FUNCTION HPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) HPS=F71R12(PI,S) IF(HPS.EQ.-1.0E+10) THEN CALL S97R12('HPS') ELSE IF(HPS.EQ.-1.0E+20) THEN CALL S98R12(2,P,S,'P','S','HPS') END IF RETURN END *------------------------------------------------- F72R12 = PSTD REAL FUNCTION PSTD(T) REAL T,TI TI=T CALL S99R12('PSTD') PSTD=-1.0E+30 RETURN END *------------------------------------------------- F73R12 = PSTDD REAL FUNCTION PSTDD(T) REAL T,TI TI=T CALL S99R12('PSTDD') PSTDD=-1.0E+30 RETURN END *------------------------------------------------- F74R12 = TSPD REAL FUNCTION TSPD(P) REAL P,PI PI=P CALL S99R12('TSPD') TSPD=-1.0E+30 RETURN END *------------------------------------------------- F75R12 = TSPDD REAL FUNCTION TSPDD(P) REAL P,PI PI=P CALL S99R12('TSPDD') TSPDD=-1.0E+30 RETURN END *------------------------------------------------- F76R12 = CVPDD REAL FUNCTION CVPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) CVPDD=F76R12(PI) IF(CVPDD.EQ.-1.0E+10) THEN CALL S97R12('CVPDD') ELSE IF(CVPDD.EQ.-1.0E+20) THEN CALL S98R12(1,P,P,'P','P','CVPDD') END IF RETURN END *------------------------------------------------- F77R12 = CVPT REAL FUNCTION CVPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) CVPT=F77R12(PI,TI) IF(CVPT.EQ.-1.0E+10) THEN CALL S97R12('CVPT') ELSE IF(CVPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','CVPT') END IF RETURN END *------------------------------------------------- F78R12 = CVTDD REAL FUNCTION CVTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99R12(KPA,T) CVTDD=F78R12(TI) IF(CVTDD.EQ.-1.0E+10) THEN CALL S97R12('CVTDD') ELSE IF(CVTDD.EQ.-1.0E+20) THEN CALL S98R12(1,T,T,'T','T','CVTDD') END IF RETURN END *------------------------------------------------- F79R12 = UPS REAL FUNCTION UPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) UPS=F79R12(PI,S) IF(UPS.EQ.-1.0E+10) THEN CALL S97R12('UPS') ELSE IF(UPS.EQ.-1.0E+20) THEN CALL S98R12(2,P,S,'P','S','UPS') END IF RETURN END *------------------------------------------------- F80R12 = VPS REAL FUNCTION VPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) VPS=F80R12(PI,S) IF(VPS.EQ.-1.0E+10) THEN CALL S97R12('VPS') ELSE IF(VPS.EQ.-1.0E+20) THEN CALL S98R12(2,P,S,'P','S','VPS') END IF RETURN END *------------------------------------------------- F81R12 = PRPT REAL FUNCTION PRPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) PRPT=F81R12(PI,TI) IF(PRPT.EQ.-1.0E+10) THEN CALL S97R12('PRPT') ELSE IF(PRPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','PRPT') END IF RETURN END *------------------------------------------------- F82R12 = AKPT REAL FUNCTION AKPT(P,T) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) AKPT=F82R12(PI,TI) IF(AKPT.EQ.-1.0E+10) THEN CALL S97R12('AKPT') ELSE IF(AKPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','AKPT') END IF RETURN END *------------------------------------------------- F83R12 = WPT REAL FUNCTION WPT(P,T) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98R12(KPA,P) TI=G99R12(KPA,T) WPT=F83R12(PI,TI) IF(WPT.EQ.-1.0E+10) THEN CALL S97R12('WPT') ELSE IF(WPT.EQ.-1.0E+20) THEN CALL S98R12(2,P,T,'P','T','WPT') END IF RETURN END *------------------------------------------------- F85R12 = PRPD REAL FUNCTION PRPD(P) REAL P,PI PI=P CALL S99R12('PRPD') PRPD=-1.0E+30 RETURN END *------------------------------------------------- F86R12 = PRPDD REAL FUNCTION PRPDD(P) REAL P,PI PI=P CALL S99R12('PRPDD') PRPDD=-1.0E+30 RETURN END *------------------------------------------------- F87R12 = PRTD REAL FUNCTION PRTD(T) REAL T,TI TI=T CALL S99R12('PRTD') PRTD=-1.0E+30 RETURN END *------------------------------------------------- F88R12 = PRTDD REAL FUNCTION PRTDD(T) REAL T,TI TI=T CALL S99R12('PRTDD') PRTDD=-1.0E+30 RETURN END *------------------------------------------------- F90R12 = BSPT REAL FUNCTION BSPT(P,T) REAL P,PI PI=P TI=T CALL S99R12('BSPT') BSPT=-1.0E+30 RETURN END *------------------------------------------------- F91R12 = BTPT REAL FUNCTION BTPT(P,T) REAL P,PI PI=P TI=T CALL S99R12('BTPT') BTPT=-1.0E+30 RETURN END *------------------------------------------------- F92R12 = BPPT REAL FUNCTION BPPT(P,T) REAL P,PI PI=P TI=T CALL S99R12('BPPT') BPPT=-1.0E+30 RETURN END *------------------------------------------------- F93R12 = BVPT REAL FUNCTION BVPT(P,T) REAL P,PI PI=P TI=T CALL S99R12('BVPT') BVPT=-1.0E+30 RETURN END *------------------------------------------------- F94R12 = AJTPT REAL FUNCTION AJTPT(P,T) REAL P,PI PI=P TI=T CALL S99R12('AJTPT') AJTPT=-1.0E+30 RETURN END *------------------------------------------------- F95R12 = GAMPT REAL FUNCTION GAMPT(P,T) REAL P,PI PI=P TI=T CALL S99R12('GAMPT') GAMPT=-1.0E+30 RETURN END *------------------------------------------------- F96R12 = GAMPDD REAL FUNCTION GAMPDD(P) REAL P,PI PI=P CALL S99R12('GAMPDD') GAMPDD=-1.0E+30 RETURN END *------------------------------------------------- F97R12 = GAMTDD REAL FUNCTION GAMTDD(T) REAL T,TI TI=T CALL S99R12('GAMTDD') GAMTDD=-1.0E+30 RETURN END *------------------------------------------------- F98R12 = TPSEUP REAL FUNCTION TPSEUP(P) REAL P,PI PI=P CALL S99R12('TPSEUP') TPSEUP=-1.0E+30 RETURN END *------------------------------------------------- F99R12 = PSBT REAL FUNCTION PSBT(T) REAL T,TI TI=T CALL S99R12('PSBT') PSBT=-1.0E+30 RETURN END *------------------------------------------------- F100R12 = TSBP REAL FUNCTION TSBP(P) REAL P,PI PI=P CALL S99R12('TSBP') TSBP=-1.0E+30 RETURN END *------------------------------------------------- G98R12 REAL FUNCTION G98R12(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 G98R12=P*PBAR RETURN END *------------------------------------------------- G99R12 REAL FUNCTION G99R12(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 G99R12=T-T0K RETURN END ***** R12V61:FUNCTIONS****1989.2.18************************************* REAL FUNCTION F2R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02,GRVT=9.80665D+00) F2R12=-1.0E+20 IF((FP.LT.0.2259).OR.(FP.GT.40.21)) RETURN F2R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S3R12(RRDD,PR,TSR) CALL S4R12(RRD,TSR) IF((RRDD.LT.0.0D0).OR.(RRD.LE.RRDD)) RETURN SIG=5.6066D-02*(ABS(1.0D0-TSR))**1.2643D+00 ALAPP=SQRT(SIG/(GRVT*(RRD-RRDD)*RC)) F2R12=REAL(ALAPP) RETURN END REAL FUNCTION F3R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02,RC=5.5800D+02,GRVT=9.80665D+00) F3R12=-1.0E+20 IF((FCT.LT.-60.0).OR.(FCT.GT.110.0)) RETURN F3R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R12(PSR,TR) CALL S3R12(RRDD,PSR,TR) CALL S4R12(RRD,TR) IF((RRDD.LT.0.0D0).OR.(RRD.LE.RRDD)) RETURN SIG=5.6066D-02*(ABS(1.0D0-TR))**1.2643D+00 ALAPT=SQRT(SIG/(GRVT*(RRD-RRDD)*RC)) F3R12=REAL(ALAPT) RETURN END REAL FUNCTION F4R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F4R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21)) RETURN F4R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S5R12(HDD,PR,TSR) CALL S6R12(HD,TSR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN ALHP=(HDD-HD)*1.0D+03 F4R12=REAL(ALHP) RETURN END REAL FUNCTION F5R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F5R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0)) RETURN F5R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R12(PSR,TR) CALL S5R12(HDD,PSR,TR) CALL S6R12(HD,TR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN ALHT=(HDD-HD)*1.0D+03 F5R12=REAL(ALHT) RETURN END REAL FUNCTION F6R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02) F6R12=-1.0E+20 IF((FP.LT.0.011).OR.(FP.GT.15.3)) RETURN F6R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) IF(TSR.LT.0.0D0) RETURN ALMPD=1.8093D-01-3.7125D-04*TSR*TC F6R12=REAL(ALMPD) RETURN END REAL FUNCTION F8R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F8R12=-1.0E+20 IF((FCT.LT.-20.0).OR.(FCT.GT.90.0)) RETURN P=DBLE(FP) T=DBLE(FCT)+273.15D0 ALM1T=1.7033D-03+(1.6796D-05+3.9063D-08*T)*T F8R12=REAL(ALM1T) RETURN END REAL FUNCTION F9R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F9R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.60.0)) RETURN T=DBLE(FCT)+273.15D0 ALMTD=1.8093D-01-3.7125D-04*T F9R12=REAL(ALMTD) RETURN END REAL FUNCTION F11R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02) DATA CO1/2.108203D+01/, CO2/-2.450974D+04/, - CO3/9.430266D+06/, CO4/-1.549714D+09/, - CO5/9.433612D+10/ F11R12=-1.0E+20 IF((FP.LT.0.12).OR.(FP.GT.9.14)) RETURN F11R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) IF(TSR.LT.0.0D0) RETURN TS=TSR*TC XMUPD=CO1+(CO2+(CO3+(CO4+CO5/TS)/TS)/TS)/TS AMUPD=EXP(XMUPD)*1.0D-03 F11R12=REAL(AMUPD) RETURN END REAL FUNCTION F13R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DIMENSION C(0:4,0:4),AMUT(0:4) DATA C(0,0)/ 3.615286D+00/, C(0,1)/ 1.725609D+04/, - C(0,2)/-4.579897D+06/, C(0,3)/-6.726768D+08/, - C(0,4)/ 2.211417D+11/, C(1,0)/-4.886873D+01/, - C(1,1)/ 6.926711D+04/, C(1,2)/-3.664654D+07/, - C(1,3)/ 8.578013D+09/, C(1,4)/-7.500900D+11/, - C(2,0)/ 6.515996D+00/, C(2,1)/-9.629660D+03/, - C(2,2)/ 5.298183D+06/, C(2,3)/-1.286156D+09/, - C(2,4)/ 1.163637D+11/, C(3,0)/ 3.739187D-01/, - C(3,1)/-4.687937D+02/, C(3,2)/ 2.149362D+05/, - C(3,3)/-4.226404D+07/, C(3,4)/ 2.942585D+09/, - C(4,0)/-1.731776D-02/, C(4,1)/ 2.061458D+01/, - C(4,2)/-8.646676D+03/, C(4,3)/ 1.441230D+06/, - C(4,4)/-6.896285D+07/ F13R12=-1.0E+20 IF ((FP.LT.0.980665).OR.(FP.GT.40.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.-33.0).OR.(FCT.GT.150.0)) RETURN AMUPT=SQRT(T)/(1.221172D+01+(-1.409456D+04+(6.60711D+06 - +(-1.343265D+09+1.011268D+11/T)/T)/T)/T) ELSE IF ((FCT.LT.25.0).OR.(FCT.GT.125.0)) RETURN DO 10 I=0,4 AMUT(I)=C(I,0)+(C(I,1)+(C(I,2)+(C(I,3)+C(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 F13R12=REAL(AMUPT*1.0D-06) RETURN END REAL FUNCTION F14R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DATA CO1/2.108203D+01/, CO2/-2.450974D+04/, - CO3/9.430266D+06/, CO4/-1.549714D+09/, - CO5/9.433612D+10/ F14R12=-1.0E+20 IF((FCT.LT.-70.0).OR.(FCT.GT.38.0)) RETURN T=DBLE(FCT)+273.15D0 XMUTD=CO1+(CO2+(CO3+(CO4+CO5/T)/T)/T)/T AMUTD=EXP(XMUTD)*1.0D-03 F14R12=REAL(AMUTD) RETURN END REAL FUNCTION F16R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02) F16R12=-1.0E+20 IF((FP.LT.0.011).OR.(FP.GT.27.8)) RETURN F16R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) IF(TSR.LT.0.0D0) RETURN TS=TSR*TC CALL S10R12(CPPD,TS) F16R12=REAL(CPPD*1.0D+03) RETURN END REAL FUNCTION F17R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F17R12=-1.0E+20 IF((FP.LT.0.011).OR.(FP.GT.27.8)) RETURN F17R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S9R12(CPPDD,PR,TSR,1) IF(CPPDD.LT.0.0D0) RETURN F17R12=REAL(CPPDD*1.0D+03) RETURN END REAL FUNCTION F18R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F18R12=-1.0E+20 CALL S90R12(FP,FCT,PR,TR,ILL90) IF(ILL90.EQ.10000) RETURN F18R12=-1.0E+10 IF(ILL90.EQ.1000) RETURN CALL S9R12(CPPT,PR,TR,1) IF(CPPT.LT.0.0D0) RETURN F18R12=REAL(CPPT*1.0D+03) RETURN END REAL FUNCTION F19R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F19R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.90.0)) RETURN T=DBLE(FCT)+273.15D0 CALL S10R12(CPTD,T) F19R12=REAL(CPTD*1.0D+03) RETURN END REAL FUNCTION F20R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F20R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.90.0)) RETURN F20R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R12(PSR,TR) CALL S9R12(CPTDD,PSR,TR,1) IF(CPTDD.LT.0.0D0) RETURN F20R12=REAL(CPTDD*1.0D+03) RETURN END REAL FUNCTION F21R12(A) CHARACTER*1 A,B(1:5) DOUBLE PRECISION CRP(1:5),HC,PC,RC,SC,TC PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+02) DATA B(1)/'H'/,B(2)/'P'/,B(3)/'S'/,B(4)/'T'/,B(5)/'V'/ CALL S5R12(HC,1.0D0,1.0D0) CALL S7R12(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 F21R12=REAL(CRP(I)) IF(A.EQ.B(I)) RETURN 10 CONTINUE F21R12=-1.0E+20 RETURN END REAL FUNCTION F23R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F23R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21)) RETURN F23R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S6R12(HPD,TSR) IF(HPD.LT.0.0D0) RETURN F23R12=REAL(HPD*1.0D+03) RETURN END REAL FUNCTION F24R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F24R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21)) RETURN F24R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S5R12(HPDD,PR,TSR) IF(HPDD.LT.0.0D0) RETURN F24R12=REAL(HPDD*1.0D+03) RETURN END REAL FUNCTION F25R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F25R12=-1.0E+20 CALL S90R12(FP,FCT,PR,TR,ILL90) IF(ILL90.EQ.10000) RETURN F25R12=-1.0E+10 IF(ILL90.EQ.1000) RETURN CALL S5R12(HPT,PR,TR) IF(HPT.LT.0.0D0) RETURN F25R12=REAL(HPT*1.0D+03) RETURN END REAL FUNCTION F26R12(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F26R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F26R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC X=DBLE(FX) CALL S2R12(TSR,PR) CALL S5R12(HDD,PR,TSR) CALL S6R12(HD,TSR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN HPX=HD+X*(HDD-HD) F26R12=REAL(HPX*1.0D+03) RETURN END REAL FUNCTION F27R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F27R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0)) RETURN F27R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S6R12(HTD,TR) IF(HTD.LT.0.0D0) RETURN F27R12=REAL(HTD*1.0D+03) RETURN END REAL FUNCTION F28R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F28R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0)) RETURN F28R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R12(PSR,TR) CALL S5R12(HTDD,PSR,TR) IF(HTDD.LT.0.0D0) RETURN F28R12=REAL(HTDD*1.0D+03) RETURN END REAL FUNCTION F29R12(FCT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F29R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F29R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC X=DBLE(FX) CALL S1R12(PSR,TR) CALL S5R12(HDD,PSR,TR) CALL S6R12(HD,TR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN HTX=HD+X*(HDD-HD) F29R12=REAL(HTX*1.0D+03) RETURN END REAL FUNCTION F30R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02) DATA EPSTC/1.0D-05/ F30R12=-1.0E+20 IF((FCT.LT.-100.01).OR.(FCT.GT.111.8)) RETURN TR=(DBLE(FCT)+273.15D0)/TC IF(ABS(TR-1.0D0).LT.EPSTC) THEN PSR=1.0D0 ELSE CALL S1R12(PSR,TR) END IF F30R12=REAL(PSR*PC*1.0D-02) RETURN END REAL FUNCTION F31R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) DATA EPSPC/1.0D-05/ F31R12=-1.0E+20 IF((FP.LT.0.2258).OR.(FP.GT.41.25)) RETURN F31R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC IF(ABS(PR-1.0D0).LT.EPSPC) THEN SIGP=0.0D0 ELSE CALL S2R12(TSR,PR) IF(TSR.LT.0.0D0) RETURN SIGP=5.6066D-02*(ABS(1.0D0-TSR))**1.2643D+00 END IF F31R12=REAL(SIGP) RETURN END REAL FUNCTION F32R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) DATA EPSTC/1.0D-05/ F32R12=-1.0E+20 IF((FCT.LT.-60.0).OR.(FCT.GT.111.8)) RETURN TR=(DBLE(FCT)+273.15D0)/TC IF(ABS(TR-1.0D0).LT.EPSTC) THEN SIGT=0.0D0 ELSE SIGT=5.6066D-02*(ABS(1.0D0-TR))**1.2643D+00 END IF F32R12=REAL(SIGT) RETURN END REAL FUNCTION F33R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F33R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21)) RETURN F33R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S8R12(SPD,TSR) IF(SPD.LT.0.0D0) RETURN F33R12=REAL(SPD*1.0D+03) RETURN END REAL FUNCTION F34R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F34R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21)) RETURN F34R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S7R12(SPDD,PR,TSR) IF(SPDD.LT.0.0D0) RETURN F34R12=REAL(SPDD*1.0D+03) RETURN END REAL FUNCTION F35R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F35R12=-1.0E+20 CALL S90R12(FP,FCT,PR,TR,ILL90) IF(ILL90.EQ.10000) RETURN F35R12=-1.0E+10 IF(ILL90.EQ.1000) RETURN CALL S7R12(SPT,PR,TR) IF(SPT.LT.0.0D0) RETURN F35R12=REAL(SPT*1.0D+03) RETURN END REAL FUNCTION F36R12(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F36R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F36R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC X=DBLE(FX) CALL S2R12(TSR,PR) CALL S7R12(SDD,PR,TSR) CALL S8R12(SD,TSR) IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN SPX=SD+X*(SDD-SD) F36R12=REAL(SPX*1.0D+03) RETURN END REAL FUNCTION F37R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F37R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0)) RETURN F37R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S8R12(STD,TR) IF(STD.LT.0.0D0) RETURN F37R12=REAL(STD*1.0D+03) RETURN END REAL FUNCTION F38R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F38R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0)) RETURN F38R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R12(PSR,TR) CALL S7R12(STDD,PSR,TR) IF(STDD.LT.0.0D0) RETURN F38R12=REAL(STDD*1.0D+03) RETURN END REAL FUNCTION F39R12(FCT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F39R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F39R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC X=DBLE(FX) CALL S1R12(PSR,TR) CALL S7R12(SDD,PSR,TR) CALL S8R12(SD,TR) IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN STX=SD+X*(SDD-SD) F39R12=REAL(STX*1.0D+03) RETURN END REAL FUNCTION F40R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02) DATA EPSPC/1.0D-05/ F40R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.41.25)) RETURN F40R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC IF(ABS(PR-1.0D0).LT.EPSPC) THEN TSR=1.0D0 ELSE CALL S2R12(TSR,PR) IF(TSR.LT.0.0D0) RETURN END IF F40R12=REAL(TSR*TC-273.15D0) RETURN END REAL FUNCTION F42R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02) F42R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21)) RETURN F42R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S6R12(HD,TSR) IF(HD.LT.0.0D0) RETURN CALL S4R12(RRD,TSR) UPD=HD-PR*PC/(RRD*RC) F42R12=REAL(UPD*1.0D+03) RETURN END REAL FUNCTION F43R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02) F43R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21)) RETURN F43R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S3R12(RRDD,PR,TSR) CALL S5R12(HDD,PR,TSR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0)) RETURN UPDD=HDD-PR*PC/(RRDD*RC) F43R12=REAL(UPDD*1.0D+03) RETURN END REAL FUNCTION F44R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02) F44R12=-1.0E+20 CALL S90R12(FP,FCT,PR,TR,ILL90) IF(ILL90.EQ.10000) RETURN F44R12=-1.0E+10 IF(ILL90.EQ.1000) RETURN CALL S3R12(RRV,PR,TR) CALL S5R12(HV,PR,TR) IF((RRV.LT.0.0D0).OR.(HV.LT.0.0D0)) RETURN UPT=HV-PR*PC/(RRV*RC) F44R12=REAL(UPT*1.0D+03) RETURN END REAL FUNCTION F45R12(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02) F45R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F45R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC X=DBLE(FX) CALL S2R12(TSR,PR) CALL S3R12(RRDD,PR,TSR) CALL S5R12(HDD,PR,TSR) CALL S6R12(HD,TSR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN CALL S4R12(RRD,TSR) UDD=HDD-PR*PC/(RRDD*RC) UD=HD-PR*PC/(RRD*RC) UPX=UD+X*(UDD-UD) F45R12=REAL(UPX*1.0D+03) RETURN END REAL FUNCTION F46R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+02) F46R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0)) RETURN F46R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R12(PSR,TR) CALL S6R12(HD,TR) IF(HD.LT.0.0D0) RETURN CALL S4R12(RRD,TR) UTD=HD-PSR*PC/(RRD*RC) F46R12=REAL(UTD*1.0D+03) RETURN END REAL FUNCTION F47R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+02) F47R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0)) RETURN F47R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R12(PSR,TR) CALL S3R12(RRDD,PSR,TR) CALL S5R12(HDD,PSR,TR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0)) RETURN UTDD=HDD-PSR*PC/(RRDD*RC) F47R12=REAL(UTDD*1.0D+03) RETURN END REAL FUNCTION F48R12(FCT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+02) F48R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F48R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC X=DBLE(FX) CALL S1R12(PSR,TR) CALL S3R12(RRDD,PSR,TR) CALL S5R12(HDD,PSR,TR) CALL S6R12(HD,TR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN CALL S4R12(RRD,TR) UDD=HDD-PSR*PC/(RRDD*RC) UD=HD-PSR*PC/(RRD*RC) UTX=UD+X*(UDD-UD) F48R12=REAL(UTX*1.0D+03) RETURN END REAL FUNCTION F49R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02) F49R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21)) RETURN F49R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) IF(TSR.LT.0.0D0) RETURN CALL S4R12(RRD,TSR) F49R12=REAL(1.0D0/(RRD*RC)) RETURN END REAL FUNCTION F50R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02) F50R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21)) RETURN F50R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S3R12(RRDD,PR,TSR) IF(RRDD.LT.0.0D0) RETURN F50R12=REAL(1.0D0/(RRDD*RC)) RETURN END REAL FUNCTION F51R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(RC=5.5800D+02) F51R12=-1.0E+20 CALL S90R12(FP,FCT,PR,TR,ILL90) IF(ILL90.EQ.10000) RETURN F51R12=-1.0E+10 IF(ILL90.EQ.1000) RETURN CALL S3R12(RRV,PR,TR) IF(RRV.LT.0.0D0) RETURN F51R12=REAL(1.0D0/(RRV*RC)) RETURN END REAL FUNCTION F52R12(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02) F52R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F52R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC X=DBLE(FX) CALL S2R12(TSR,PR) CALL S3R12(RRDD,PR,TSR) IF(RRDD.LT.0.0D0) RETURN CALL S4R12(RRD,TSR) VDD=1.0D0/(RRDD*RC) VD=1.0D0/(RRD*RC) VPX=VD+X*(VDD-VD) F52R12=REAL(VPX) RETURN END REAL FUNCTION F53R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02,RC=5.5800D+02) F53R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0)) RETURN TR=(DBLE(FCT)+273.15D0)/TC CALL S4R12(RRD,TR) F53R12=REAL(1.0D0/(RRD*RC)) RETURN END REAL FUNCTION F54R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02,RC=5.5800D+02) F54R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0)) RETURN F54R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R12(PSR,TR) CALL S3R12(RRDD,PSR,TR) IF(RRDD.LT.0.0D0) RETURN F54R12=REAL(1.0D0/(RRDD*RC)) RETURN END REAL FUNCTION F55R12(FCT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02,RC=5.5800D+02) F55R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F55R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC X=DBLE(FX) CALL S1R12(PSR,TR) CALL S3R12(RRDD,PSR,TR) IF(RRDD.LT.0.0D0) RETURN CALL S4R12(RRD,TR) VDD=1.0D0/(RRDD*RC) VD=1.0D0/(RRD*RC) VTX=VD+X*(VDD-VD) F55R12=REAL(VTX) RETURN END REAL FUNCTION F56R12(FP,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F56R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21).OR. - (FH.LT.F23R12(FP)).OR.(FH.GT.F24R12(FP))) RETURN F56R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC H=DBLE(FH)*1.0D-03 CALL S2R12(TSR,PR) CALL S5R12(HDD,PR,TSR) CALL S6R12(HD,TSR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN XPH=(H-HD)/(HDD-HD) F56R12=REAL(XPH) RETURN END REAL FUNCTION F57R12(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F57R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21).OR. - (FS.LT.F33R12(FP)).OR.(FS.GT.F34R12(FP))) RETURN F57R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC S=DBLE(FS)*1.0D-03 CALL S2R12(TSR,PR) CALL S7R12(SDD,PR,TSR) CALL S8R12(SD,TSR) IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN XPS=(S-SD)/(SDD-SD) F57R12=REAL(XPS) RETURN END REAL FUNCTION F58R12(FP,FU) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02) F58R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21).OR. - (FU.LT.F42R12(FP)).OR.(FU.GT.F43R12(FP))) RETURN F58R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC U=DBLE(FU)*1.0D-03 CALL S2R12(TSR,PR) CALL S3R12(RRDD,PR,TSR) CALL S5R12(HDD,PR,TSR) CALL S6R12(HD,TSR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN CALL S4R12(RRD,TSR) UDD=HDD-PR*PC/(RRDD*RC) UD=HD-PR*PC/(RRD*RC) XPU=(U-UD)/(UDD-UD) F58R12=REAL(XPU) RETURN END REAL FUNCTION F59R12(FP,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02) F59R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.40.21).OR. - (FV.LT.F49R12(FP)).OR.(FV.GT.F50R12(FP))) RETURN F59R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC V=DBLE(FV) CALL S2R12(TSR,PR) CALL S3R12(RRDD,PR,TSR) IF(RRDD.LT.0.0D0) RETURN CALL S4R12(RRD,TSR) VDD=1.0D0/(RRDD*RC) VD=1.0D0/(RRD*RC) XPV=(V-VD)/(VDD-VD) F59R12=REAL(XPV) RETURN END REAL FUNCTION F60R12(FCT,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F60R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0).OR. - (FH.LT.F27R12(FCT)).OR.(FH.GT.F28R12(FCT))) RETURN F60R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC H=DBLE(FH)*1.0D-03 CALL S1R12(PSR,TR) CALL S5R12(HDD,PSR,TR) CALL S6R12(HD,TR) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN XTH=(H-HD)/(HDD-HD) F60R12=REAL(XTH) RETURN END REAL FUNCTION F61R12(FCT,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F61R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0).OR. - (FS.LT.F37R12(FCT)).OR.(FS.GT.F38R12(FCT))) RETURN F61R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC S=DBLE(FS)*1.0D-03 CALL S1R12(PSR,TR) CALL S7R12(SDD,PSR,TR) CALL S8R12(SD,TR) IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN XTS=(S-SD)/(SDD-SD) F61R12=REAL(XTS) RETURN END REAL FUNCTION F62R12(FCT,FU) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+02) F62R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0).OR. - (FU.LT.F46R12(FCT)).OR.(FU.GT.F47R12(FCT))) RETURN F62R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC U=DBLE(FU)*1.0D-03 CALL S1R12(PSR,TR) CALL S3R12(RRDD,PSR,TR) CALL S5R12(HDD,PSR,TR) CALL S6R12(HD,TR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN CALL S4R12(RRD,TR) UDD=HDD-PSR*PC/(RRDD*RC) UD=HD-PSR*PC/(RRD*RC) XTU=(U-UD)/(UDD-UD) F62R12=REAL(XTU) RETURN END REAL FUNCTION F63R12(FCT,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02,RC=5.5800D+02) F63R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.110.0).OR. - (FV.LT.F53R12(FCT)).OR.(FV.GT.F54R12(FCT))) RETURN F63R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC V=DBLE(FV) CALL S1R12(PSR,TR) CALL S3R12(RRDD,PSR,TR) IF(RRDD.LT.0.0D0) RETURN CALL S4R12(RRD,TR) VDD=1.0D0/(RRDD*RC) VD=1.0D0/(RRD*RC) XTV=(V-VD)/(VDD-VD) F63R12=REAL(XTV) RETURN END REAL FUNCTION F64R12(FP,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+02) DATA EPSPC/1.0D-05/,FEPSHC/1.0E-05/ F64R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.80.0)) RETURN IF(FP.GE.41.25) THEN FVMIN=1.0/REAL(RC) FCTMIN=F70R12(FP,FVMIN) FHMIN=F25R12(FP,FCTMIN) ELSE IF((FP.GE.40.21).AND.(FP.LT.41.25)) THEN FCTMIN=F40R12(FP)+0.1 FHMIN=F25R12(FP,FCTMIN) ELSE FHMIN=F23R12(FP) END IF FHMAX=F25R12(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 F64R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC H=DBLE(FH)*1.0D-03 FHR=FH/F21R12('H') IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(FHR-1.0).LT.FEPSHC)) THEN F64R12=REAL(TC-273.15D0) RETURN END IF IF(PR.GE.1.0D0) THEN CALL S11R12(T0R,PR,1.0D0) IF(T0R.LT.0.0D0) RETURN CALL S5R12(H0,PR,T0R) IF(H0.LT.0.0D0) RETURN CALL S9R12(CP0,PR,T0R,1) IF(CP0.LT.0.0D0) RETURN T1R=T0R+(H-H0)/(CP0*TC) CALL S5R12(H1,PR,T1R) IF(H1.LT.0.0D0) RETURN CALL S16R12(TR,PR,H,T0R,T1R,H0,H1,1) IF(TR.LT.0.0D0) RETURN ELSE CALL S2R12(TSR,PR) IF(PR.GT.0.9748D0) THEN CALL S5R12(HDD,PR,TSR+0.001D0) CALL S6R12(HD,TSR-0.001D0) ELSE CALL S5R12(HDD,PR,TSR) CALL S6R12(HD,TSR) END IF IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN IF((H.GE.HD).AND.(H.LE.HDD)) THEN TR=TSR ELSE IF(H.GT.HDD) THEN T0R=TSR H0=HDD CALL S9R12(CPDD,PR,TSR,1) IF(CPDD.LT.0.0D0) RETURN T1R=T0R+(H-H0)/(CPDD*TC) CALL S5R12(H1,PR,T1R) IF(H1.LT.0.0D0) RETURN CALL S16R12(TR,PR,H,T0R,T1R,H0,H1,1) IF(TR.LT.0.0D0) RETURN END IF END IF F64R12=REAL(TR*TC-273.15D0) RETURN END REAL FUNCTION F65R12(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+02) DATA EPSPC/1.0D-05/,FEPSSC/1.0E-05/ F65R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.80.0)) RETURN IF(FP.GE.41.25) THEN FVMIN=1.0/REAL(RC) FCTMIN=F70R12(FP,FVMIN) FSMIN=F35R12(FP,FCTMIN) ELSE IF((FP.GE.40.21).AND.(FP.LT.41.25)) THEN FCTMIN=F40R12(FP)+0.1 FSMIN=F35R12(FP,FCTMIN) ELSE FSMIN=F33R12(FP) END IF FSMAX=F35R12(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 F65R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC S=DBLE(FS)*1.0D-03 FSR=FS/F21R12('S') IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(FSR-1.0).LT.FEPSSC)) THEN F65R12=REAL(TC-273.15D0) RETURN END IF IF(PR.GE.1.0D0) THEN CALL S11R12(T0R,PR,1.0D0) IF(T0R.LT.0.0D0) RETURN CALL S7R12(S0,PR,T0R) IF(S0.LT.0.0D0) RETURN CALL S9R12(CP0,PR,T0R,1) IF(CP0.LT.0.0D0) RETURN T1R=T0R*(1.0D0+(S-S0)/CP0) CALL S7R12(S1,PR,T1R) IF(S1.LT.0.0D0) RETURN CALL S16R12(TR,PR,S,T0R,T1R,S0,S1,2) IF(TR.LT.0.0D0) RETURN ELSE CALL S2R12(TSR,PR) IF(PR.GT.0.9748D0) THEN CALL S7R12(SDD,PR,TSR+0.001D0) CALL S8R12(SD,TSR-0.001D0) ELSE CALL S7R12(SDD,PR,TSR) CALL S8R12(SD,TSR) END IF IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN IF((S.GE.SD).AND.(S.LE.SDD)) THEN TR=TSR ELSE IF(S.GT.SDD) THEN T0R=TSR S0=SDD CALL S9R12(CPDD,PR,TSR,1) IF(CPDD.LT.0.0D0) RETURN T1R=T0R*(1.0D0+(S-S0)/CPDD) CALL S7R12(S1,PR,T1R) IF(S1.LT.0.0D0) RETURN CALL S16R12(TR,PR,S,T0R,T1R,S0,S1,2) IF(TR.LT.0.0D0) RETURN END IF END IF F65R12=REAL(TR*TC-273.15D0) RETURN END REAL FUNCTION F70R12(FP,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02,TC=3.8495D+02) DATA EPSPC/1.0D-05/,EPSRC/1.0D-05/ DATA PMIN/0.01199D0/,PMAX/80.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 F70R12=-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 F70R12=REAL(TC-273.15D0) RETURN END IF CALL S3R12(RRV,PR,TRMAX) IF(RRV.LT.0.0D0) GO TO 1000 RRMIN=RRV IF(PR.GE.1.0D0) THEN RRMAX=1.001D0 IF((RR.LT.RRMIN).OR.(RR.GT.RRMAX)) RETURN CALL S11R12(TRV,PR,RR) IF(TRV.LT.0.0D0) GO TO 1000 ELSE CALL S2R12(TSR,PR) IF(PR.GT.0.9748D0) THEN CALL S3R12(RRDD,PR,TSR+0.001D0) CALL S4R12(RRD,TSR-0.001D0) ELSE CALL S3R12(RRDD,PR,TSR) CALL S4R12(RRD,TSR) END IF IF(RRDD.LT.0.0D0) GO TO 1000 IF(PR.GT.0.9748D0) RRMAX=RRDD RRMAX=RRD IF((RR.LT.RRMIN).OR.(RR.GT.RRMAX)) RETURN IF((PR.LE.0.9748).AND.(RR.GE.RRDD).AND.(RR.LE.RRD)) THEN TRV=TSR ELSE CALL S11R12(TRV,PR,RR) IF(TRV.LT.0.0D0) GO TO 1000 END IF END IF F70R12=REAL(TRV*TC-273.15D0) RETURN 1000 F70R12=-1.0E+10 RETURN END REAL FUNCTION F71R12(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02,TC=3.8495D+02) DATA EPSPC/1.0D-05/,FEPSSC/1.0E-05/ F71R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.80.0)) RETURN IF(FP.GE.41.25) THEN FVMIN=1.0/REAL(RC) FCTMIN=F70R12(FP,FVMIN) FSMIN=F35R12(FP,FCTMIN) ELSE IF((FP.GT.40.21).AND.(FP.LT.41.25)) THEN FCTMIN=F40R12(FP)+0.1 FSMIN=F35R12(FP,FCTMIN) ELSE FSMIN=F33R12(FP) END IF FSMAX=F35R12(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 F71R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC S=DBLE(FS)*1.0D-03 FSR=FS/F21R12('S') IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(FSR-1.0D0).LT.FEPSSC)) THEN F71R12=F21R12('H') RETURN END IF IF(PR.GE.1.0D0) THEN FT=F65R12(FP,FS) FH=F25R12(FP,FT) F71R12=FH ELSE CALL S2R12(TSR,PR) IF(PR.GT.0.9748D0) THEN CALL S7R12(SDD,PR,TSR+0.001D0) CALL S8R12(SD,TSR-0.001D0) ELSE CALL S7R12(SDD,PR,TSR) CALL S8R12(SD,TSR) END IF IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN IF(S.GT.SDD) THEN FT=F65R12(FP,FS) FH=F25R12(FP,FT) F71R12=FH ELSE IF((S.GE.SD).AND.(S.LE.SDD)) THEN CALL S5R12(HDD,PR,TSR) IF(HDD.LT.0.0D0) RETURN CALL S6R12(HD,TSR) IF(HD.LT.0.0D0) RETURN H=HD+((S-SD)/(SDD-SD))*(HDD-HD) F71R12=REAL(H*1.0D+03) END IF END IF RETURN END REAL FUNCTION F76R12(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03) F76R12=-1.0E+20 IF((FP.LT.0.011).OR.(FP.GT.27.8)) RETURN F76R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC CALL S2R12(TSR,PR) CALL S9R12(CVPDD,PR,TSR,2) IF(CVPDD.LT.0.0D0) RETURN F76R12=REAL(CVPDD*1.0D+03) RETURN END REAL FUNCTION F77R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F77R12=-1.0E+20 CALL S90R12(FP,FCT,PR,TR,ILL90) IF(ILL90.EQ.10000) RETURN F77R12=-1.0E+10 IF(ILL90.EQ.1000) RETURN CALL S9R12(CVPT,PR,TR,2) IF(CVPT.LT.0.0D0) RETURN F77R12=REAL(CVPT*1.0D+03) RETURN END REAL FUNCTION F78R12(FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.8495D+02) F78R12=-1.0E+20 IF((FCT.LT.-100.0).OR.(FCT.GT.90.0)) RETURN F78R12=-1.0E+10 TR=(DBLE(FCT)+273.15D0)/TC CALL S1R12(PSR,TR) CALL S9R12(CVTDD,PSR,TR,2) IF(CVTDD.LT.0.0D0) RETURN F78R12=REAL(CVTDD*1.0D+03) RETURN END REAL FUNCTION F79R12(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02,TC=3.8495D+02) DATA EPSPC/1.0D-05/,FEPSSC/1.0E-05/ F79R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.80.0)) RETURN IF(FP.GE.41.25) THEN FVMIN=1.0/REAL(RC) FCTMIN=F70R12(FP,FVMIN) FSMIN=F35R12(FP,FCTMIN) ELSE IF((FP.GT.40.21).AND.(FP.LT.41.25)) THEN FCTMIN=F40R12(FP)+0.1 FSMIN=F35R12(FP,FCTMIN) ELSE FSMIN=F33R12(FP) END IF FSMAX=F35R12(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 F79R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC S=DBLE(FS)*1.0D-03 FSR=FS/F21R12('S') IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(FSR-1.0D0).LT.FEPSSC)) THEN F79R12=F21R12('H')-PC*1.0E+03*F21R12('V') RETURN END IF IF(PR.GE.1.0D0) THEN FT=F65R12(FP,FS) FU=F44R12(FP,FT) F79R12=FU ELSE CALL S2R12(TSR,PR) IF(PR.GT.0.9748D0) THEN CALL S7R12(SDD,PR,TSR+0.001D0) CALL S8R12(SD,TSR-0.001D0) ELSE CALL S7R12(SDD,PR,TSR) CALL S8R12(SD,TSR) END IF IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN IF(S.GT.SDD) THEN FT=F65R12(FP,FS) FU=F44R12(FP,FT) F79R12=FU ELSE IF((S.GE.SD).AND.(S.LE.SDD)) THEN CALL S5R12(HDD,PR,TSR) CALL S3R12(RRDD,PR,TSR) IF((HDD.LT.0.0D0).OR.(RRDD.LT.0.0D0)) RETURN UDD=HDD-PR*PC/(RRDD*RC) CALL S6R12(HD,TSR) IF(HD.LT.0.0D0) RETURN CALL S4R12(RRD,TSR) UD=HD-PR*PC/(RRD*RC) U=UD+((S-SD)/(SDD-SD))*(UDD-UD) F79R12=REAL(U*1.0D+03) END IF END IF RETURN END REAL FUNCTION F80R12(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02,TC=3.8495D+02) DATA EPSPC/1.0D-05/,FEPSSC/1.0E-05/ F80R12=-1.0E+20 IF((FP.LT.0.012).OR.(FP.GT.80.0)) RETURN IF(FP.GE.41.25) THEN FVMIN=1.0/REAL(RC) FCTMIN=F70R12(FP,FVMIN) FSMIN=F35R12(FP,FCTMIN) ELSE IF((FP.GT.40.21).AND.(FP.LT.41.25)) THEN FCTMIN=F40R12(FP)+0.1 FSMIN=F35R12(FP,FCTMIN) ELSE FSMIN=F33R12(FP) END IF FSMAX=F35R12(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 F80R12=-1.0E+10 PR=DBLE(FP)*1.0D+02/PC S=DBLE(FS)*1.0D-03 FSR=FS/F21R12('S') IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(FSR-1.0D0).LT.FEPSSC)) THEN F80R12=F21R12('V') RETURN END IF IF(PR.GE.1.0D0) THEN FT=F65R12(FP,FS) FV=F51R12(FP,FT) F80R12=FV ELSE CALL S2R12(TSR,PR) IF(PR.GT.0.9748D0) THEN CALL S7R12(SDD,PR,TSR+0.001D0) CALL S8R12(SD,TSR-0.001D0) ELSE CALL S7R12(SDD,PR,TSR) CALL S8R12(SD,TSR) END IF IF((SDD.LT.0.0D0).OR.(SD.LT.0.0D0)) RETURN IF(S.GT.SDD) THEN FT=F65R12(FP,FS) FV=F51R12(FP,FT) F80R12=FV ELSE IF((S.GE.SD).AND.(S.LE.SDD)) THEN CALL S3R12(RRDD,PR,TSR) IF(RRDD.LT.0.0D0) RETURN VDD=1.0D0/(RRDD*RC) CALL S4R12(RRD,TSR) IF(RRD.LT.0.0D0) RETURN VD=1.0D0/(RRD*RC) V=VD+((S-SD)/(SDD-SD))*(VDD-VD) F80R12=REAL(V) END IF END IF RETURN END REAL FUNCTION F81R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F81R12=-1.0E+20 IF ((FCT.LT.-20.0).OR.(FCT.GT.90.0)) RETURN FP1=1.01325 CALL S90R12(FP1,FCT,PR,TR,ILL90) IF(ILL90.EQ.10000) RETURN F81R12=-1.0E+10 IF(ILL90.EQ.1000) RETURN CALL S9R12(CP1T,PR,TR,1) IF(CP1T.LT.0.0D0) RETURN P=DBLE(FP) T=DBLE(FCT)+273.15D0 ALM1T=1.7033D-03+(1.6796D-05+3.9063D-08*T)*T AMU1T=SQRT(T)/(1.221172D+01+(-1.409456D+04+(6.60711D+06 - +(-1.343265D+09+1.011268D+11/T)/T)/T)/T) PRPT=(AMU1T*1.0D-06)*(CP1T*1.0D+03)/ALM1T F81R12=REAL(PRPT) RETURN END REAL FUNCTION F82R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F82R12=-1.0E+20 CALL S90R12(FP,FCT,PR,TR,ILL90) IF(ILL90.EQ.10000) RETURN F82R12=-1.0E+10 IF(ILL90.EQ.1000) RETURN CALL S9R12(AKPT,PR,TR,3) IF(AKPT.LT.0.0D0) RETURN F82R12=REAL(AKPT) RETURN END REAL FUNCTION F83R12(FP,FCT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) F83R12=-1.0E+20 CALL S90R12(FP,FCT,PR,TR,ILL90) IF(ILL90.EQ.10000) RETURN F83R12=-1.0E+10 IF(ILL90.EQ.1000) RETURN CALL S9R12(WPT,PR,TR,4) IF(WPT.LT.0.0D0) RETURN F83R12=REAL(WPT) RETURN END ***** SUBROUTINES ****************************************************** SUBROUTINE S1R12(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 S14R12(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 S2R12(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 S14R12(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 S3R12(RRV,PR,TR68) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+02, - GASC=6.87625D-02,ITMAX=10000,EPS=1.0D-12) DIMENSION A(1:15) RRV=-1.0D+20 IF((PR.LE.0.0D0).OR.(TR68.LE.0.0D0)) RETURN RRV=1.0D0 IF((PR.EQ.1.0D0).AND.(TR68.EQ.1.0D0)) RETURN CALL S15R12(TR48,TR68,1) TR=TR48 CALL S12R12(A) COZ=-PC*PR/(GASC*RC*TC*TR) CO1=1.0D0 CO2=A(1)+(A(2)+(A(3)+A(4)/TR)/TR)/TR CO3=A(5)+(A(6)+A(7)/TR)/TR CO4=A(8)+(A(9)+A(10)/TR)/TR CO5=A(11)+A(12)/TR CO6=A(13)+A(14)/TR CO7=A(15) RR=PC*PR/(GASC*RC*TC*TR) DO 10 IT=1,ITMAX F=COZ+(CO1+(CO2+(CO3+(CO4+(CO5+(CO6+CO7*RR*RR) - *RR*RR)*RR)*RR)*RR)*RR)*RR DF=CO1+(2.0D0*CO2+(3.0D0*CO3+(4.0D0*CO4+(5.0D0*CO5 - +(7.0D0*CO6+9.0D0*CO7*RR*RR)*RR*RR)*RR)*RR)*RR)*RR RR=RR-F/DF IF(ABS(-F/(DF*RR)).LT.EPS) THEN RRV=RR RETURN END IF 10 CONTINUE RRV=-1.0D+10 RETURN END SUBROUTINE S4R12(RRD,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA CO1/ 1.0D+00/, CO2/ 3.036359D+00/, - CO3/-1.156439D+01/, CO4/ 4.347273D+01/, - CO5/-7.285118D+01/, CO6/ 5.858101D+01/, - CO7/-1.794327D+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+(CO6+CO7*TR1)*TR1)*TR1)*TR1)*TR1)*TR1 RETURN END SUBROUTINE S5R12(HV,PR,TR68) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=3.8495D+02,GASC=6.87625D-02,B00=5.575090245D+02) DIMENSION A(1:15),A0(0:5) HV=-1.0D+20 IF((PR.LE.0.0D0).OR.(TR68.LE.0.0D0)) RETURN CALL S3R12(RRV,PR,TR68) IF(RRV.LT.0.0D0) GO TO 1000 CALL S15R12(TR48,TR68,1) TR=TR48 CALL S12R12(A) CO1=1.0D0 CO2=A(1)+(2.0D0*A(2)+(3.0D0*A(3)+4.0D0*A(4)/TR)/TR)/TR CO3=A(5)+(1.5D0*A(6)+2.0D0*A(7)/TR)/TR CO4=A(8)+((4.0D0/3.0D0)*A(9)+(5.0D0/3.0D0)*A(10)/TR)/TR CO5=A(11)+(5.0D0/4.0D0)*A(12)/TR CO6=A(13)+(7.D0/6.0D0)*A(14)/TR CO7=A(15) HVSUM=CO1+(CO2+(CO3+(CO4+(CO5+(CO6+CO7*RRV*RRV) - *RRV*RRV)*RRV)*RRV)*RRV)*RRV CALL S13R12(A0) T0R=273.15D0/TC HV=GASC*TC*TR*HVSUM+TC*(A0(0)*LOG(TR/T0R) - +((A0(1)-GASC)+(A0(2)/2.0D0+(A0(3)/3.0D0+(A0(4)/4.0D0 - +(A0(5)/5.0D0)*TR)*TR)*TR)*TR)*TR - -((A0(1)-GASC)+(A0(2)/2.0D0+(A0(3)/3.0D0+(A0(4)/4.0D0 - +(A0(5)/5.0D0)*T0R)*T0R)*T0R)*T0R)*T0R) - +B00 RETURN 1000 HV=-1.0D+10 RETURN END SUBROUTINE S6R12(HD,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.1250D+03,RC=5.5800D+02) DIMENSION B(1:5) HD=-1.0D+20 IF(TR.LE.0.0D0) RETURN IF(TR.EQ.1.0D0) THEN CALL S5R12(HDD,1.0D0,1.0D0) HD=HDD RETURN END IF CALL S1R12(PSR,TR) CALL S3R12(RRDD,PSR,TR) CALL S5R12(HDD,PSR,TR) IF((RRDD.LT.0.0D0).OR.(HDD.LT.0.0D0)) GO TO 1000 CALL S4R12(RRD,TR) CALL S14R12(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 S7R12(SV,PR,TR68) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=3.8495D+02,GASC=6.87625D-02,B01=4.514177962D+00) DIMENSION A(1:15),A0(0:5) SV=-1.0D+20 IF((PR.LE.0.0D0).OR.(TR68.LE.0.0D0)) RETURN CALL S3R12(RRV,PR,TR68) IF(RRV.LT.0.0D0) GO TO 1000 CALL S15R12(TR48,TR68,1) TR=TR48 CALL S12R12(A) CO1=A(1)-(A(3)+2.0D0*A(4)/TR)/TR/TR CO2=(A(5)-A(7)/TR/TR)/2.0D0 CO3=(A(8)-A(10)/TR/TR)/3.0D0 CO4=A(11)/4.0D0 CO5=A(13)/6.0D0 CO6=A(15)/8.0D0 SVSUM=CO1+(CO2+(CO3+(CO4+(CO5+CO6*RRV*RRV)*RRV*RRV)*RRV)*RRV)*RRV CALL S13R12(A0) T0R=273.15D0/TC SV=-GASC*(LOG(RRV)+SVSUM*RRV)+A0(0)*(1.0D0/T0R-1.0D0/TR) - +(A0(1)-GASC)*LOG(TR/T0R) - +(A0(2)+(A0(3)/2.0D0+(A0(4)/3.0D0+(A0(5)/4.0D0)*TR)*TR)*TR)*TR - -(A0(2)+(A0(3)/2.0D0+(A0(4)/3.0D0+(A0(5)/4.0D0)*T0R)*T0R)*T0R) - *T0R+B01 RETURN 1000 SV=-1.0D+10 RETURN END SUBROUTINE S8R12(SD,TR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+02) DIMENSION B(1:5) SD=-1.0D+20 IF(TR.LE.0.0D0) RETURN IF(TR.EQ.1.0D0) THEN CALL S7R12(SDD,1.0D0,1.0D0) SD=SDD RETURN END IF CALL S1R12(PSR,TR) CALL S3R12(RRDD,PSR,TR) CALL S7R12(SDD,PSR,TR) IF((RRDD.LT.0.0D0).OR.(SDD.LT.0.0D0)) GO TO 1000 CALL S4R12(RRD,TR) CALL S14R12(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 S9R12(CPVKW,PR,TR68,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.1250D+03,TC=3.8495D+02,RC=5.5800D+02, - GASC=6.87625D-02) DIMENSION A(1:15),A0(0:5) CPVKW=-1.0D+20 IF((PR.LE.0.0D0).OR.(TR68.LE.0.0D0)) RETURN CALL S3R12(RRV,PR,TR68) IF(RRV.LT.0.0D0) GO TO 1000 CALL S15R12(TR48,TR68,1) TR=TR48 CALL S12R12(A) CALL S13R12(A0) CV=-GASC*((2.0D0*A(3)+6.0D0*A(4)/TR) - +(A(7)+(2.0D0/3.0D0)*A(10)*RRV)*RRV)*RRV/TR/TR+A0(0)/TR - +(A0(1)-GASC)+(A0(2)+(A0(3)+(A0(4)+A0(5)*TR)*TR)*TR)*TR IF (ICPVKW.EQ.2) THEN CPVKW=CV RETURN END IF * CX1=1.0D0 CX2=A(1)-(A(3)+2.0D0*A(4)/TR)/TR/TR CX3=A(5)-A(7)/TR/TR CX4=A(8)-A(10)/TR/TR CX5=A(11) CX6=A(13) CX7=A(15) CY1=1.0D0 CY2=2.0D0*(A(1)+(A(2)+(A(3)+A(4)/TR)/TR)/TR) CY3=3.0D0*(A(5)+(A(6)+A(7)/TR)/TR) CY4=4.0D0*(A(8)+(A(9)+A(10)/TR)/TR) CY5=5.0D0*(A(11)+A(12)/TR) CY6=7.0D0*(A(13)+A(14)/TR) CY7=9.0D0*A(15) X=CX1+(CX2+(CX3+(CX4+(CX5+(CX6+CX7*RRV*RRV) - *RRV*RRV)*RRV)*RRV)*RRV)*RRV Y=CY1+(CY2+(CY3+(CY4+(CY5+(CY6+CY7*RRV*RRV) - *RRV*RRV)*RRV)*RRV)*RRV)*RRV 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 S10R12(CPD,T68) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=3.8495D+02) DATA CO1/ 8.3835D+00/, CO2/-1.2700D-01/, - CO3/ 7.9043D-04/, CO4/-2.1593D-06/, - CO5/ 2.2036D-09/ T=T68 CPD=CO1+(CO2+(CO3+(CO4+CO5*T)*T)*T)*T RETURN END SUBROUTINE S11R12(TRV68,PR,RR) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+02, - GASC=6.87625D-02,ITMAX=10000,EPS=1.0D-12) DIMENSION A(1:15) TRV68=-1.0D+20 IF((PR.LE.0.0D0).OR.(RR.LE.0.0D0)) RETURN TRV68=1.0D0 IF((PR.EQ.1.0D0).AND.(RR.EQ.1.0D0)) RETURN CALL S12R12(A) CO1=1.0D0+(A(1)+(A(5)+(A(8)+(A(11)+(A(13)+A(15)*RR*RR) - *RR*RR)*RR)*RR)*RR)*RR CO2=(A(2)+(A(6)+(A(9)+(A(12)+A(14)*RR*RR)*RR)*RR)*RR)*RR - -(PC/(GASC*TC*RC))*(PR/RR) CO3=(A(3)+(A(7)+A(10)*RR)*RR)*RR CO4=A(4)*RR XTR=GASC*TC*RC*RR/(PC*PR) DO 10 IT=1,ITMAX F=CO1+(CO2+(CO3+CO4*XTR)*XTR)*XTR DF=CO2+(2.0D0*CO3+3.0D0*CO4*XTR)*XTR XTR=XTR-F/DF IF(ABS(-F/(DF*XTR)).LT.EPS) THEN TR48=1.0D0/XTR CALL S15R12(TR68,TR48,2) TRV68=TR68 RETURN END IF 10 CONTINUE TRV68=-1.0D+10 RETURN END SUBROUTINE S12R12(AR12) DOUBLE PRECISION AR12(1:15),A(1:15) DATA A( 1)/ 2.337370817D+00/, A( 2)/-6.412406390D+00/, - A( 3)/ 4.830185249D+00/, A( 4)/-1.965519089D+00/, - A( 5)/-3.007980190D+00/, A( 6)/ 6.836347882D+00/, - A( 7)/-3.379592003D+00/, A( 8)/ 3.125967270D+00/, - A( 9)/-7.177260909D+00/, A(10)/ 4.136982393D+00/, - A(11)/ 4.704538125D-03/, A(12)/-1.573667708D-02/, - A(13)/ 1.398447840D-01/, A(14)/-1.863103713D-01/, - A(15)/ 1.221380142D-02/ DO 10 I=1,15 AR12(I)=A(I) 10 CONTINUE RETURN END SUBROUTINE S13R12(A0R12) DOUBLE PRECISION A0R12(0:5),A0(0:5) DATA A0(0)/ 2.21611D-02/, A0(1)/-5.85730D-02/, - A0(2)/ 1.40742D+00/, A0(3)/-1.06308D+00/, - A0(4)/ 4.41392D-01/, A0(5)/-7.86229D-02/ DO 10 I=0,5 A0R12(I)=A0(I) 10 CONTINUE RETURN END SUBROUTINE S14R12(BR12) DOUBLE PRECISION BR12(1:5),B(1:5) DATA B(1)/-6.9670659D+00/, B(2)/ 1.6788237D+00/, - B(3)/-4.0795370D+00/, B(4)/ 4.4821021D+00/, - B(5)/-5.0646598D+00/ DO 10 I=1,5 BR12(I)=B(I) 10 CONTINUE RETURN END SUBROUTINE S15R12(TROUT,TRINP,ICONV) *** CONVERSION OF INTERNATIONAL PRACTICAL TEMPERATURE SCALE(IPTS) *** *** IN THE RANGE OF TEMPERATURE FROM -130(DEG C) TO +240(DEG C) *** * ICONV=1:TRINP=TR68, TROUT=TR48 * ICONV=2:TRINP=TR48, TR0UT=TR68 * CT48:TEMPERATURE GIVEN BY THE 'IPTS OF 1948'...DEG C * CT68:TEMPERATURE GIVEN BY THE 'IPTS OF 1968'...DEG C IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=3.8495D+02,ITMAX=10000) TROUT=1.0D0 IF(TRINP.EQ.1.0D0) RETURN IF(ICONV.EQ.1) THEN TR68=TRINP CT68=TR68*TC-273.15D0 CT=CT68*1.0D-02 IF(CT68.GE.0.0D0) THEN CT48=CT68-CT*(CT68-100.0D0)*(4.637893D-04+(-6.49038D-05 - +(-1.036074D-04+(5.329607D-05-8.304192D-06*CT)*CT)*CT)*CT) ELSE CT48=CT68-CT*(CT68+123.2D0)*(-4.010795D-04+(7.739816D-04 - +(-1.970624D-04+(-2.686817D-04+1.522688D-04*CT)*CT)*CT)*CT) END IF TROUT=(CT48+273.15D0)/TC RETURN ELSE IF(ICONV.EQ.2) THEN TR48=TRINP CT48=TR48*TC-273.15D0 CT=CT48 DO 10 IT=1,ITMAX CT=CT*1.0D-02 IF(CT.GE.0.0D0) THEN CT68=CT48+CT*(CT*1.0D+02-100.0D0)*(4.637893D-04+(-6.49038D-05 - +(-1.036074D-04+(5.329607D-05-8.304192D-06*CT)*CT)*CT)*CT) ELSE CT68=CT48+CT*(CT*1.0D+02+123.2D0)*(-4.010795D-04+(7.739816D-04 - +(-1.970624D-04+(-2.686817D-04+1.522688D-04*CT)*CT)*CT)*CT) END IF CT=CT*1.0D+02 IF(ABS(CT-CT68).LT.1.0D-05) THEN TROUT=(CT68+273.15D0)/TC RETURN END IF CT=CT68 10 CONTINUE TROUT=(CT68+273.15D0)/TC RETURN END IF END SUBROUTINE S16R12(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 S5R12(Y2,PR,T2R) ELSE IF(IHS.EQ.2) THEN CALL S7R12(Y2,PR,T2R) END IF IF(Y2.LT.0.0D0) GO TO 1000 10 CONTINUE 1000 TR=-1.0D+10 RETURN END SUBROUTINE S90R12(FP,FCT,PR,TR,ILL) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.1250D+03,TC=3.8495D+02,RC=5.5800D+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 IF((ABS(PR-1.0D0).LT.EPSPC).AND.(ABS(TR-1.0D0).LT.EPSTC)) THEN PR=1.0D0 TR=1.0D0 ILL=0 RETURN END IF ILL=10000 IF((FP.LT.0.012).OR.(FP.GT.80.0)) RETURN IF(FP.GE.41.25) THEN FVMIN=1.0/REAL(RC) FCTMIN=F70R12(FP,FVMIN) ELSE IF((FP.GE.40.21).AND.(FP.LT.41.25)) THEN FCTMIN=F40R12(FP)+0.1 ELSE FCTMIN=F40R12(FP) END IF IF(FCTMIN.LE.-1.0E+10) RETURN IF((FCT.LT.FCTMIN).OR.(FCT.GT.200.0)) RETURN IF(PR.LT.0.9748D0) THEN CALL S2R12(TSR,PR) IF(TSR.LT.0.0D0) GO TO 1000 IF(ABS(TR-TSR).LT.EPSTS) TR=TSR END IF ILL=0 RETURN 1000 ILL=1000 RETURN END *-------------------------ERROR MESSAGES FOR LEVEL 1, 2 AND 3------ SUBROUTINE S97R12(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 R12 ****' WRITE(6,1000) MSG 1000 FORMAT(1H ,5X,A) END IF RETURN END SUBROUTINE S98R12(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 R12', - ' WHEN ',A1,' =', 1PE14.7,' ****') 2010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR R12', - ' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') RETURN END SUBROUTINE S99R12(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 R12 ****' 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