*=====PR134V81====1993/04/22========================================* *=====PAR134======1997/03/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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(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 S99C07(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== *------------------------------------------------- F1C07 = AIPPT REAL FUNCTION AIPPT(P,T) REAL P,PI,T,TI PI=P TI=T CALL S99C07('AIPPT') AIPPT=-1.0E+30 RETURN END *------------------------------------------------- F2C07 = ALAPP REAL FUNCTION ALAPP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) ALAPP=F2C07(PI) IF(ALAPP.EQ.-1.0E+10) THEN CALL S97C07('ALAPP') ELSE IF(ALAPP.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','ALAPP') END IF RETURN END *------------------------------------------------- F3C07 = ALAPT REAL FUNCTION ALAPT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) ALAPT=F3C07(TI) IF(ALAPT.EQ.-1.0E+10) THEN CALL S97C07('ALAPT') ELSE IF(ALAPT.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','ALAPT') END IF RETURN END *------------------------------------------------- F4C07 = ALHP REAL FUNCTION ALHP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) ALHP=F4C07(PI) IF(ALHP.EQ.-1.0E+10) THEN CALL S97C07('ALHP') ELSE IF(ALHP.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','ALHP') END IF RETURN END *------------------------------------------------- F5C07 = ALHT REAL FUNCTION ALHT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) ALHT=F5C07(TI) IF(ALHT.EQ.-1.0E+10) THEN CALL S97C07('ALHT') ELSE IF(ALHT.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','ALHT') END IF RETURN END *------------------------------------------------- F6C07 = ALMPD REAL FUNCTION ALMPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) ALMPD=F6C07(PI) IF(ALMPD.EQ.-1.0E+10) THEN CALL S97C07('ALMPD') ELSE IF(ALMPD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','ALMPD') END IF RETURN END *------------------------------------------------- F7C07 = ALMPDD REAL FUNCTION ALMPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) ALMPDD=F7C07(PI) IF(ALMPDD.EQ.-1.0E+10) THEN CALL S97C07('ALMPDD') ELSE IF(ALMPDD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','ALMPDD') END IF RETURN END *------------------------------------------------- F8C07 = ALMPT REAL FUNCTION ALMPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) ALMPT=F8C07(PI,TI) IF(ALMPT.EQ.-1.0E+10) THEN CALL S97C07('ALMPT') ELSE IF(ALMPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','ALMPT') END IF RETURN END *------------------------------------------------- F9C07 = ALMTD REAL FUNCTION ALMTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) ALMTD=F9C07(TI) IF(ALMTD.EQ.-1.0E+10) THEN CALL S97C07('ALMTD') ELSE IF(ALMTD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','ALMTD') END IF RETURN END *------------------------------------------------- F10C07 = ALMTDD REAL FUNCTION ALMTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) ALMTDD=F10C07(TI) IF(ALMTDD.EQ.-1.0E+10) THEN CALL S97C07('ALMTDD') ELSE IF(ALMTDD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','ALMTDD') END IF RETURN END *------------------------------------------------- F11C07 = AMUPD REAL FUNCTION AMUPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) AMUPD=F11C07(PI) IF(AMUPD.EQ.-1.0E+10) THEN CALL S97C07('AMUPD') ELSE IF(AMUPD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','AMUPD') END IF RETURN END *------------------------------------------------- F12C07 = AMUPDD REAL FUNCTION AMUPDD(P) REAL P,PI PI=P CALL S99C07('AMUPDD') AMUPDD=-1.0E+30 RETURN END *------------------------------------------------- F13C07 = AMUPT REAL FUNCTION AMUPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) AMUPT=F13C07(PI,TI) IF(AMUPT.EQ.-1.0E+10) THEN CALL S97C07('AMUPT') ELSE IF(AMUPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','AMUPT') END IF RETURN END *------------------------------------------------- F14C07 = AMUTD REAL FUNCTION AMUTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) AMUTD=F14C07(TI) IF(AMUTD.EQ.-1.0E+10) THEN CALL S97C07('AMUTD') ELSE IF(AMUTD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','AMUTD') END IF RETURN END *------------------------------------------------- F15C07 = AMUTDD REAL FUNCTION AMUTDD(T) REAL T,TI TI=T CALL S99C07('AMUTDD') AMUTDD=-1.0E+30 RETURN END *------------------------------------------------- F16C07 = CPPD REAL FUNCTION CPPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) CPPD=F16C07(PI) IF(CPPD.EQ.-1.0E+10) THEN CALL S97C07('CPPD') ELSE IF(CPPD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','CPPD') END IF RETURN END *------------------------------------------------- F17C07 = CPPDD REAL FUNCTION CPPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) CPPDD=F17C07(PI) IF(CPPDD.EQ.-1.0E+10) THEN CALL S97C07('CPPDD') ELSE IF(CPPDD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','CPPDD') END IF RETURN END *------------------------------------------------- F18C07 = CPPT REAL FUNCTION CPPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) CPPT=F18C07(PI,TI) IF(CPPT.EQ.-1.0E+10) THEN CALL S97C07('CPPT') ELSE IF(CPPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','CPPT') END IF RETURN END *------------------------------------------------- F19C07 = CPTD REAL FUNCTION CPTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) CPTD=F19C07(TI) IF(CPTD.EQ.-1.0E+10) THEN CALL S97C07('CPTD') ELSE IF(CPTD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','CPTD') END IF RETURN END *------------------------------------------------- F20C07 = CPTDD REAL FUNCTION CPTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) CPTDD=F20C07(TI) IF(CPTDD.EQ.-1.0E+10) THEN CALL S97C07('CPTDD') ELSE IF(CPTDD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','CPTDD') END IF RETURN END *------------------------------------------------- F21C07 = 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=F21C07(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 HFC-134A', - ' 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 *------------------------------------------------- F22C07 = EPSPT REAL FUNCTION EPSPT(P,T) REAL P,PI,T,TI PI=P TI=T CALL S99C07('EPSPT') EPSPT=-1.0E+30 RETURN END *----------------------------------------------------- F89 = FC ************************************************** * FUNCTION FOR FUNDAMENTAL CONSTANTS * PROPATH VER.8.1, JULY 10, 1992. * USAGE: B=FC(A) * A, B : CHARACTER TYPE VARIABLES * B='102.032' WHEN A='M' * B='81.4892' WHEN A='R' *************************************************** REAL FUNCTION FC(A) CHARACTER A*1, MSG*120 COMMON /UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=102.032 ELSE IF (A.EQ.'R') THEN FC=81.4892 ELSE FC=-1.0E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR HFC-134A WHEN A=''' - //A//''' ****' WRITE(6,'(1H, A)') MSG END IF END IF RETURN END *------------------------------------------------- F23C07 = HPD REAL FUNCTION HPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) HPD=F23C07(PI) IF(HPD.EQ.-1.0E+10) THEN CALL S97C07('HPD') ELSE IF(HPD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','HPD') END IF RETURN END *------------------------------------------------- F24C07 = HPDD REAL FUNCTION HPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) HPDD=F24C07(PI) IF(HPDD.EQ.-1.0E+10) THEN CALL S97C07('HPDD') ELSE IF(HPDD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','HPDD') END IF RETURN END *------------------------------------------------- F25C07 = HPT REAL FUNCTION HPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) HPT=F25C07(PI,TI) IF(HPT.EQ.-1.0E+10) THEN CALL S97C07('HPT') ELSE IF(HPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','HPT') END IF RETURN END *------------------------------------------------- F26C07 = HPX REAL FUNCTION HPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) HPX=F26C07(PI,X) IF(HPX.EQ.-1.0E+10) THEN CALL S97C07('HPX') ELSE IF(HPX.EQ.-1.0E+20) THEN CALL S98C07(2,P,X,'P','X','HPX') END IF RETURN END *------------------------------------------------- F27C07 = HTD REAL FUNCTION HTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) HTD=F27C07(TI) IF(HTD.EQ.-1.0E+10) THEN CALL S97C07('HTD') ELSE IF(HTD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','HTD') END IF RETURN END *------------------------------------------------- F28C07 = HTDD REAL FUNCTION HTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) HTDD=F28C07(TI) IF(HTDD.EQ.-1.0E+10) THEN CALL S97C07('HTDD') ELSE IF(HTDD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','HTDD') END IF RETURN END *------------------------------------------------- F29C07 = HTX REAL FUNCTION HTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) HTX=F29C07(TI,X) IF(HTX.EQ.-1.0E+10) THEN CALL S97C07('HTX') ELSE IF(HTX.EQ.-1.0E+20) THEN CALL S98C07(2,T,X,'T','X','HTX') END IF RETURN END *------------------------------------------------- F30C07 = PST REAL FUNCTION PST(T) REAL TI,T INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) PST=F30C07(TI) IF(PST.EQ.-1.0E+10) THEN CALL S97C07('PST') RETURN ELSE IF(PST.EQ.-1.0E+20) THEN CALL S98C07(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 *------------------------------------------------- F31C07 = SIGP REAL FUNCTION SIGP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) SIGP=F31C07(PI) IF(SIGP.EQ.-1.0E+10) THEN CALL S97C07('SIGP') ELSE IF(SIGP.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','SIGP') END IF RETURN END *------------------------------------------------- F32C07 = SIGT REAL FUNCTION SIGT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) SIGT=F32C07(TI) IF(SIGT.EQ.-1.0E+10) THEN CALL S97C07('SIGT') ELSE IF(SIGT.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','SIGT') END IF RETURN END *------------------------------------------------- F33C07 = SPD REAL FUNCTION SPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) SPD=F33C07(PI) IF(SPD.EQ.-1.0E+10) THEN CALL S97C07('SPD') ELSE IF(SPD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','SPD') END IF RETURN END *------------------------------------------------- F34C07 = SPDD REAL FUNCTION SPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) SPDD=F34C07(PI) IF(SPDD.EQ.-1.0E+10) THEN CALL S97C07('SPDD') ELSE IF(SPDD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','SPDD') END IF RETURN END *------------------------------------------------- F35C07 = SPT REAL FUNCTION SPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) SPT=F35C07(PI,TI) IF(SPT.EQ.-1.0E+10) THEN CALL S97C07('SPT') ELSE IF(SPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','SPT') END IF RETURN END *------------------------------------------------- F36C07 = SPX REAL FUNCTION SPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) SPX=F36C07(PI,X) IF(SPX.EQ.-1.0E+10) THEN CALL S97C07('SPX') ELSE IF(SPX.EQ.-1.0E+20) THEN CALL S98C07(2,P,X,'P','X','SPX') END IF RETURN END *------------------------------------------------- F37C07 = STD REAL FUNCTION STD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) STD=F37C07(TI) IF(STD.EQ.-1.0E+10) THEN CALL S97C07('STD') ELSE IF(STD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','STD') END IF RETURN END *------------------------------------------------- F38C07 = STDD REAL FUNCTION STDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) STDD=F38C07(TI) IF(STDD.EQ.-1.0E+10) THEN CALL S97C07('STDD') ELSE IF(STDD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','STDD') END IF RETURN END *------------------------------------------------- F39C07 = STX REAL FUNCTION STX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) STX=F39C07(TI,X) IF(STX.EQ.-1.0E+10) THEN CALL S97C07('STX') ELSE IF(STX.EQ.-1.0E+20) THEN CALL S98C07(2,T,X,'T','X','STX') END IF RETURN END *------------------------------------------------- F40C07 = TSP REAL FUNCTION TSP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TSP=F40C07(PI) IF(TSP.EQ.-1.0E+10) THEN CALL S97C07('TSP') RETURN ELSE IF(TSP.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','TSP') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TSP=TSP+273.15 RETURN END *------------------------------------------------- F41C07 = TRPL REAL FUNCTION TRPL(A) CHARACTER A*1,AI*1 AI=A CALL S99C07('TRPL') TRPL=-1.0E+30 RETURN END *------------------------------------------------- F42C07 = UPD REAL FUNCTION UPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) UPD=F42C07(PI) IF(UPD.EQ.-1.0E+10) THEN CALL S97C07('UPD') ELSE IF(UPD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','UPD') END IF RETURN END *------------------------------------------------- F43C07 = UPDD REAL FUNCTION UPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) UPDD=F43C07(PI) IF(UPDD.EQ.-1.0E+10) THEN CALL S97C07('UPDD') ELSE IF(UPDD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','UPDD') END IF RETURN END *------------------------------------------------- F44C07 = UPT REAL FUNCTION UPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) UPT=F44C07(PI,TI) IF(UPT.EQ.-1.0E+10) THEN CALL S97C07('UPT') ELSE IF(UPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','UPT') END IF RETURN END *------------------------------------------------- F45C07 = UPX REAL FUNCTION UPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) UPX=F45C07(PI,X) IF(UPX.EQ.-1.0E+10) THEN CALL S97C07('UPX') ELSE IF(UPX.EQ.-1.0E+20) THEN CALL S98C07(2,P,X,'P','X','UPX') END IF RETURN END *------------------------------------------------- F46C07 = UTD REAL FUNCTION UTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) UTD=F46C07(TI) IF(UTD.EQ.-1.0E+10) THEN CALL S97C07('UTD') ELSE IF(UTD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','UTD') END IF RETURN END *------------------------------------------------- F47C07 = UTDD REAL FUNCTION UTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) UTDD=F47C07(TI) IF(UTDD.EQ.-1.0E+10) THEN CALL S97C07('UTDD') ELSE IF(UTDD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','UTDD') END IF RETURN END *------------------------------------------------- F48C07 = UTX REAL FUNCTION UTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) UTX=F48C07(TI,X) IF(UTX.EQ.-1.0E+10) THEN CALL S97C07('UTX') ELSE IF(UTX.EQ.-1.0E+20) THEN CALL S98C07(2,T,X,'T','X','UTX') END IF RETURN END *------------------------------------------------- F49C07 = VPD REAL FUNCTION VPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) VPD=F49C07(PI) IF(VPD.EQ.-1.0E+10) THEN CALL S97C07('VPD') ELSE IF(VPD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','VPD') END IF RETURN END *------------------------------------------------- F50C07 = VPDD REAL FUNCTION VPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) VPDD=F50C07(PI) IF(VPDD.EQ.-1.0E+10) THEN CALL S97C07('VPDD') ELSE IF(VPDD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','VPDD') END IF RETURN END *------------------------------------------------- F51C07 = VPT REAL FUNCTION VPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) VPT=F51C07(PI,TI) IF(VPT.EQ.-1.0E+10) THEN CALL S97C07('VPT') ELSE IF(VPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','VPT') END IF RETURN END *------------------------------------------------- F52C07 = VPX REAL FUNCTION VPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) VPX=F52C07(PI,X) IF(VPX.EQ.-1.0E+10) THEN CALL S97C07('VPX') ELSE IF(VPX.EQ.-1.0E+20) THEN CALL S98C07(2,P,X,'P','X','VPX') END IF RETURN END *------------------------------------------------- F53C07 = VTD REAL FUNCTION VTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) VTD=F53C07(TI) IF(VTD.EQ.-1.0E+10) THEN CALL S97C07('VTD') ELSE IF(VTD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','VTD') END IF RETURN END *------------------------------------------------- F54C07 = VTDD REAL FUNCTION VTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) VTDD=F54C07(TI) IF(VTDD.EQ.-1.0E+10) THEN CALL S97C07('VTDD') ELSE IF(VTDD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','VTDD') END IF RETURN END *------------------------------------------------- F55C07 = VTX REAL FUNCTION VTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) VTX=F55C07(TI,X) IF(VTX.EQ.-1.0E+10) THEN CALL S97C07('VTX') ELSE IF(VTX.EQ.-1.0E+20) THEN CALL S98C07(2,T,X,'T','X','VTX') END IF RETURN END *------------------------------------------------- F56C07 = XPH REAL FUNCTION XPH(P,H) REAL P,PI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) XPH=F56C07(PI,H) IF(XPH.EQ.-1.0E+10) THEN CALL S97C07('XPH') ELSE IF(XPH.EQ.-1.0E+20) THEN CALL S98C07(2,P,H,'P','H','XPH') END IF RETURN END *------------------------------------------------- F57C07 = XPS REAL FUNCTION XPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) XPS=F57C07(PI,S) IF(XPS.EQ.-1.0E+10) THEN CALL S97C07('XPS') ELSE IF(XPS.EQ.-1.0E+20) THEN CALL S98C07(2,P,S,'P','S','XPS') END IF RETURN END *------------------------------------------------- F58C07 = XPU REAL FUNCTION XPU(P,U) REAL P,PI,U INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) XPU=F58C07(PI,U) IF(XPU.EQ.-1.0E+10) THEN CALL S97C07('XPU') ELSE IF(XPU.EQ.-1.0E+20) THEN CALL S98C07(2,P,U,'P','U','XPU') END IF RETURN END *------------------------------------------------- F59C07 = XPV REAL FUNCTION XPV(P,V) REAL P,PI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) XPV=F59C07(PI,V) IF(XPV.EQ.-1.0E+10) THEN CALL S97C07('XPV') ELSE IF(XPV.EQ.-1.0E+20) THEN CALL S98C07(2,P,V,'P','V','XPV') END IF RETURN END *------------------------------------------------- F60C07 = XTH REAL FUNCTION XTH(T,H) REAL T,TI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) XTH=F60C07(TI,H) IF(XTH.EQ.-1.0E+10) THEN CALL S97C07('XTH') ELSE IF(XTH.EQ.-1.0E+20) THEN CALL S98C07(2,T,H,'T','H','XTH') END IF RETURN END *------------------------------------------------- F61C07 = XTS REAL FUNCTION XTS(T,S) REAL T,TI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) XTS=F61C07(TI,S) IF(XTS.EQ.-1.0E+10) THEN CALL S97C07('XTS') ELSE IF(XTS.EQ.-1.0E+20) THEN CALL S98C07(2,T,S,'T','S','XTS') END IF RETURN END *------------------------------------------------- F62C07 = XTU REAL FUNCTION XTU(T,U) REAL T,TI,U INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) XTU=F62C07(TI,U) IF(XTU.EQ.-1.0E+10) THEN CALL S97C07('XTU') ELSE IF(XTU.EQ.-1.0E+20) THEN CALL S98C07(2,T,U,'T','U','XTU') END IF RETURN END *------------------------------------------------- F63C07 = XTV REAL FUNCTION XTV(T,V) REAL T,TI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) XTV=F63C07(TI,V) IF(XTV.EQ.-1.0E+10) THEN CALL S97C07('XTV') ELSE IF(XTV.EQ.-1.0E+20) THEN CALL S98C07(2,T,V,'T','V','XTV') END IF RETURN END *------------------------------------------------- F64C07 = TPH REAL FUNCTION TPH(P,H) REAL P,PI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TPH=F64C07(PI,H) IF(TPH.EQ.-1.0E+10) THEN CALL S97C07('TPH') RETURN ELSE IF(TPH.EQ.-1.0E+20) THEN CALL S98C07(2,P,H,'P','H','TPH') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPH=TPH+273.15 RETURN END *------------------------------------------------- F65C07 = TPS REAL FUNCTION TPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TPS=F65C07(PI,S) IF(TPS.EQ.-1.0E+10) THEN CALL S97C07('TPS') RETURN ELSE IF(TPS.EQ.-1.0E+20) THEN CALL S98C07(2,P,S,'P','S','TPS') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPS=TPS+273.15 RETURN END *------------------------------------------------- F66C07 = PLDT REAL FUNCTION PLDT(T) REAL T,TI TI=T CALL S99C07('PLDT') PLDT=-1.0E+30 RETURN END *------------------------------------------------- F67C07 = TLDP REAL FUNCTION TLDP(P) REAL P,PI PI=P CALL S99C07('TLDP') TLDP=-1.0E+30 RETURN END *------------------------------------------------- F68C07 = PMLT REAL FUNCTION PMLT(T) REAL T,TI TI=T CALL S99C07('PMLT') PMLT=-1.0E+30 RETURN END *------------------------------------------------- F69C07 = TMLP REAL FUNCTION TMLP(P) REAL P,PI PI=P CALL S99C07('TMLP') TMLP=-1.0E+30 RETURN END *------------------------------------------------- F70C07 = TPV REAL FUNCTION TPV(P,V) REAL P,PI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TPV=F70C07(PI,V) IF(TPV.EQ.-1.0E+10) THEN CALL S97C07('TPV') RETURN ELSE IF(TPV.EQ.-1.0E+20) THEN CALL S98C07(2,P,V,'P','V','TPV') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPV=TPV+273.15 RETURN END *------------------------------------------------- F71C07 = HPS REAL FUNCTION HPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) HPS=F71C07(PI,S) IF(HPS.EQ.-1.0E+10) THEN CALL S97C07('HPS') ELSE IF(HPS.EQ.-1.0E+20) THEN CALL S98C07(2,P,S,'P','S','HPS') END IF RETURN END *------------------------------------------------- F72C07 = PSTD REAL FUNCTION PSTD(T) REAL T,TI TI=T CALL S99C07('PSTD') PSTD=-1.0E+30 RETURN END *------------------------------------------------- F73C07 = PSTDD REAL FUNCTION PSTDD(T) REAL T,TI TI=T CALL S99C07('PSTDD') PSTDD=-1.0E+30 RETURN END *------------------------------------------------- F74C07 = TSPD REAL FUNCTION TSPD(P) REAL P,PI PI=P CALL S99C07('TSPD') TSPD=-1.0E+30 RETURN END *------------------------------------------------- F75C07 = TSPDD REAL FUNCTION TSPDD(P) REAL P,PI PI=P CALL S99C07('TSPDD') TSPDD=-1.0E+30 RETURN END *------------------------------------------------- F76C07 = CVPDD REAL FUNCTION CVPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) CVPDD=F76C07(PI) IF(CVPDD.EQ.-1.0E+10) THEN CALL S97C07('CVPDD') ELSE IF(CVPDD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','CVPDD') END IF RETURN END *------------------------------------------------- F77C07 = CVPT REAL FUNCTION CVPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) CVPT=F77C07(PI,TI) IF(CVPT.EQ.-1.0E+10) THEN CALL S97C07('CVPT') ELSE IF(CVPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','CVPT') END IF RETURN END *------------------------------------------------- F78C07 = CVTDD REAL FUNCTION CVTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) CVTDD=F78C07(TI) IF(CVTDD.EQ.-1.0E+10) THEN CALL S97C07('CVTDD') ELSE IF(CVTDD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','CVTDD') END IF RETURN END *------------------------------------------------- F79C07 = UPS REAL FUNCTION UPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) UPS=F79C07(PI,S) IF(UPS.EQ.-1.0E+10) THEN CALL S97C07('UPS') ELSE IF(UPS.EQ.-1.0E+20) THEN CALL S98C07(2,P,S,'P','S','UPS') END IF RETURN END *------------------------------------------------- F80C07 = VPS REAL FUNCTION VPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) VPS=F80C07(PI,S) IF(VPS.EQ.-1.0E+10) THEN CALL S97C07('VPS') ELSE IF(VPS.EQ.-1.0E+20) THEN CALL S98C07(2,P,S,'P','S','VPS') END IF RETURN END *------------------------------------------------- F81C07 = PRPT REAL FUNCTION PRPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) PRPT=F81C07(PI,TI) IF(PRPT.EQ.-1.0E+10) THEN CALL S97C07('PRPT') ELSE IF(PRPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','PRPT') END IF RETURN END *------------------------------------------------- F82C07 = AKPT REAL FUNCTION AKPT(P,T) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) AKPT=F82C07(PI,TI) IF(AKPT.EQ.-1.0E+10) THEN CALL S97C07('AKPT') ELSE IF(AKPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','AKPT') END IF RETURN END *------------------------------------------------- F83C07 = WPT REAL FUNCTION WPT(P,T) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) WPT=F83C07(PI,TI) IF(WPT.EQ.-1.0E+10) THEN CALL S97C07('WPT') ELSE IF(WPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','WPT') END IF RETURN END *------------------------------------------------- F84C07 = 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 VARIABLES C B='HFC-134A' WHEN A='S' C B='CH2F-CF3' 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='HFC-134A' ELSE IF (A.EQ.'C') THEN IDENTF='CH2F-CF3' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG=' *** OUT OF RANGE AT IDENTF FOR HFC-134A WHEN A=''' & //A//''' ****' WRITE(6,'(1H,A)') MSG END IF END IF RETURN END *------------------------------------------------- F85C07 = PRPD REAL FUNCTION PRPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) PRPD=F85C07(PI) IF(PRPD.EQ.-1.0E+10) THEN CALL S97C07('PRPD') ELSE IF(PRPD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','PRPD') END IF RETURN END *------------------------------------------------- F86C07 = PRPDD REAL FUNCTION PRPDD(P) REAL P,PI PI=P CALL S99C07('PRPDD') PRPDD=-1.0E+30 RETURN END *------------------------------------------------- F87C07 = PRTD REAL FUNCTION PRTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) PRTD=F87C07(TI) IF(PRTD.EQ.-1.0E+10) THEN CALL S97C07('PRTD') ELSE IF(PRTD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','PRTD') END IF RETURN END *------------------------------------------------- F88C07 = PRTDD REAL FUNCTION PRTDD(T) REAL T,TI TI=T CALL S99C07('PRTDD') PRTDD=-1.0E+30 RETURN END *------------------------------------------------- F90C07 = BSPT REAL FUNCTION BSPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) BSPT=F90C07(PI,TI) IF(BSPT.EQ.-1.0E+10) THEN CALL S97C07('BSPT') RETURN ELSE IF(BSPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','BSPT') RETURN END IF RETURN END *------------------------------------------------- F91C07 = BTPT REAL FUNCTION BTPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) BTPT=F91C07(PI,TI) IF(BTPT.EQ.-1.0E+10) THEN CALL S97C07('BTPT') RETURN ELSE IF(BTPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','BTPT') RETURN END IF RETURN END *------------------------------------------------- F92C07 = BPPT REAL FUNCTION BPPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) BPPT=F92C07(PI,TI) IF(BPPT.EQ.-1.0E+10) THEN CALL S97C07('BPPT') ELSE IF(BPPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','BPPT') END IF RETURN END *------------------------------------------------- F93C07 = BVPT REAL FUNCTION BVPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) BVPT=F93C07(PI,TI) IF(BVPT.EQ.-1.0E+10) THEN CALL S97C07('BVPT') ELSE IF(BVPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','BVPT') END IF RETURN END *------------------------------------------------- F94C07 = AJTPT REAL FUNCTION AJTPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) AJTPT=F94C07(PI,TI) IF(AJTPT.EQ.-1.0E+10) THEN CALL S97C07('AJTPT') RETURN ELSE IF(AJTPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','AJTPT') RETURN END IF RETURN END *------------------------------------------------- F95C07 = GAMPT REAL FUNCTION GAMPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) TI=G99C07(KPA,T) GAMPT=F95C07(PI,TI) IF(GAMPT.EQ.-1.0E+10) THEN CALL S97C07('GAMPT') ELSE IF(GAMPT.EQ.-1.0E+20) THEN CALL S98C07(2,P,T,'P','T','GAMPT') END IF RETURN END *------------------------------------------------- F96C07 = GAMPDD REAL FUNCTION GAMPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C07(KPA,P) GAMPDD=F96C07(PI) IF(GAMPDD.EQ.-1.0E+10) THEN CALL S97C07('GAMPDD') ELSE IF(GAMPDD.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','GAMPDD') END IF RETURN END *------------------------------------------------- F97C07 = GAMTDD REAL FUNCTION GAMTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C07(KPA,T) GAMTDD=F97C07(TI) IF(GAMTDD.EQ.-1.0E+10) THEN CALL S97C07('GAMTDD') ELSE IF(GAMTDD.EQ.-1.0E+20) THEN CALL S98C07(1,T,T,'T','T','GAMTDD') END IF RETURN END *-------------------------------------------------- F98C07 = TPSEUP REAL FUNCTION TPSEUP(P) ***** TPSEUP = PSEUDO BOILING POINT REAL P,PI INTEGER KPA,MESS COMMON /UNIT/KPA,MESS PI=G98C07(KPA,P) TPSEUP=F98C07(PI) IF(TPSEUP.EQ.-1.0E+10) THEN CALL S97C07('TPSEUP') ELSE IF(TPSEUP.EQ.-1.0E+20) THEN CALL S98C07(1,P,P,'P','P','TPSEUP') END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPSEUP=TPSEUP+273.15 RETURN END *------------------------------------------------- F99C07 = PSBT REAL FUNCTION PSBT(T) REAL T,TI TI=T CALL S99C07('PSBT') PSBT=-1.0E+30 RETURN END *------------------------------------------------- F100C07 = TSBP REAL FUNCTION TSBP(P) REAL P,PI PI=P CALL S99C07('PSBT') TSBP=-1.0E+30 RETURN END *------------------------------------------------- G98C07 REAL FUNCTION G98C07(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 G98C07=P*PBAR RETURN END *------------------------------------------------- G99C07 REAL FUNCTION G99C07(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 G99C07=T-T0K RETURN END ***** R134V81:FUNCTIONS****1992/08/21***************************** REAL FUNCTION F2C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,RC=5.08D+02,GRVT=9.80665D+00) F2C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F2C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) IF((RRDD.LT.0.0D0).OR.(RRD.LE.RRDD)) RETURN SIG=5.544D-02*(ABS(1.0D0-TSR))**1.220D+00 ALAPP=SQRT(SIG/(GRVT*(RRD-RRDD)*RC)) F2C07=REAL(ALAPP) RETURN END REAL FUNCTION F3C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02,RC=5.08D+02,GRVT=9.80665D+00) F3C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN F3C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) IF((RRDD.LT.0.0D0).OR.(RRD.LE.RRDD)) RETURN SIG=5.544D-02*(ABS(1.0D0-TR))**1.220D+00 ALAPT=SQRT(SIG/(GRVT*(RRD-RRDD)*RC)) F3C07=REAL(ALAPT) RETURN END REAL FUNCTION F4C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.064D+06) F4C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F4C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) CALL S7C07(TSR,RRD,HD) CALL S7C07(TSR,RRDD,HDD) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN ALHP=(HDD-HD) F4C07=REAL(ALHP) RETURN END REAL FUNCTION F5C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F5C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN F5C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) CALL S7C07(TR,RRD,HD) CALL S7C07(TR,RRDD,HDD) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN ALHT=(HDD-HD) F5C07=REAL(ALHT) RETURN END REAL FUNCTION F6C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) DATA A00/+2.08425D+02/, A01/-4.25584D-01/ F6C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.30.4)) RETURN F6C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) ALMPD=A00+A01*(TSR*TC) F6C07=REAL(ALMPD*1.0D-03) RETURN END REAL FUNCTION F7C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PCMPA=4.0640D+00,TC=3.7430D+02) DATA B00/-1.00635D+01/, B01/+7.74609D-02/, - B10/+6.65212D+01/, B11/-4.08255D-01/, B12/+6.32241D-04/, - B30/+7.22720D+01/, B31/-4.07082D-01/, B32/+5.74951D-04/ F7C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.30.4)) RETURN P=(DBLE(FP)*1.0D+05)/1.0D+06 PR=P/PCMPA CALL S2C07(2,1,PR,TSR) TS=TSR*TC ALMPDD=B00+B01*TS+((B10+(B11+B12*TS)*TS) - +(B30+(B31+B32*TS)*TS)*P**2)*P F7C07=REAL(ALMPDD*1.0D-03) RETURN END REAL FUNCTION F8C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PCMPA=4.0640D+00,TC=3.7430D+02) DATA A00/+2.08425D+02/, A01/-4.25584D-01/, - A10/+7.33423D+00/, A11/-5.01525D-02/, A12/+9.36972D-05/, - A20/-1.96787D-01/, A21/+1.39264D-03/, A22/-2.50637D-06/ DATA B00/-1.00635D+01/, B01/+7.74609D-02/, - B10/+6.65212D+01/, B11/-4.08255D-01/, B12/+6.32241D-04/, - B30/+7.22720D+01/, B31/-4.07082D-01/, B32/+5.74951D-04/ F8C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.86.86)) RETURN IF((FP.LT.0.699).OR.(FP.GT.200.1)) RETURN P=(DBLE(FP)*1.0D+05)/1.0D+06 T=DBLE(FT)+273.15D0 TR=T/TC CALL S2C07(1,1,TR,PSR) PS=PSR*PCMPA IF (P.GT.PS) THEN ALMPT=A00+A01*T+((A10+(A11+A12*T)*T) - +(A20+(A21+A22*T)*T)*(P-PS))*(P-PS) ELSE ALMPT=B00+B01*T+((B10+(B11+B12*T)*T) - +(B30+(B31+B32*T)*T)*P**2)*P END IF F8C07=REAL(ALMPT*1.0D-03) RETURN END REAL FUNCTION F9C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DATA A00/+2.08425D+02/, A01/-4.25584D-01/ F9C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.86.86)) RETURN T=DBLE(FT)+273.15D0 ALMTD=A00+A01*T F9C07=REAL(ALMTD*1.0D-03) RETURN END REAL FUNCTION F10C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PCMPA=4.0640D+00,TC=3.7430D+02) DATA B00/-1.00635D+01/, B01/+7.74609D-02/, - B10/+6.65212D+01/, B11/-4.08255D-01/, B12/+6.32241D-04/, - B30/+7.22720D+01/, B31/-4.07082D-01/, B32/+5.74951D-04/ F10C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.86.86)) RETURN T=DBLE(FT)+273.15D0 TR=T/TC CALL S2C07(1,1,TR,PSR) PS=PSR*PCMPA ALMTDD=B00+B01*T+((B10+(B11+B12*T)*T) - +(B30+(B31+B32*T)*T)*PS**2)*PS F10C07=REAL(ALMTDD*1.0D-03) RETURN END REAL FUNCTION F11C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) DATA CO1/-6.04810D+00/, CO2/+9.06845D+02/, - CO3/+1.09872D-02/, CO4/-2.10309D-05/ F11C07=-1.0E+20 IF ((FP.LT.1.16).OR.(FP.GT.20.62)) RETURN F11C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) TS=TSR*TC XMUPD=CO1+CO2/TS+CO3*TS+CO4*TS**2 AMUPD=EXP(XMUPD)*1.0D-03 F11C07=REAL(AMUPD) RETURN END REAL FUNCTION F13C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02,RC=5.08D+02) DATA B10/+4.761D-02/,B11/-9.075D+01/,B12/+5.2672D+04/, - B13/-9.314D+06/, - B20/+1.238D-03/,B21/-5.893D-06/,B22/+7.441D-09/, - B30/-2.004D-06/,B31/+1.609D-03/,B32/-0.3246/ F13C07=-1.0E+20 IF ((FT.LT.24.9).OR.(FT.GT.150.1)) RETURN IF (FT.GT.97.058) THEN FPMAX=0.446*FT-5.8577 ELSE FPMAX=F30C07(FT) END IF IF ((FP.LT.0.7).OR.(FP.GT.FPMAX)) RETURN T=DBLE(FT)+273.15D0 TR=T/TC * AMU1T=(4.366D-02-6.832D-06*T)*T * PR1=0.101325D+06/PC PR=DBLE(FP)*1.0D+05/PC CALL S3C07(PR1,TR,RR1) CALL S3C07(PR,TR,RR) DRHO=(RR-RR1)*RC B1=B10+(B11+(B12+B13/T)/T)/T B2=B20+(B21+B22*T)*T B3=B30+(B31+B32/T)/T AMUPT=AMU1T+(B1+(B2+B3*DRHO)*DRHO)*DRHO F13C07=REAL(AMUPT*1.0D-06) RETURN END REAL FUNCTION F14C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DATA CO1/-6.04810D+00/, CO2/+9.06845D+02/, - CO3/+1.09872D-02/, CO4/-2.10309D-05/ F14C07=-1.0E+20 IF((FT.LT.-23.16).OR.(FT.GT.68.86)) RETURN F14C07=-1.0E+10 TS=DBLE(FT)+273.15D0 XMUTD=CO1+CO2/TS+CO3*TS+CO4*TS**2 AMUTD=EXP(XMUTD)*1.0D-03 F14C07=REAL(AMUTD) RETURN END REAL FUNCTION F16C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F16C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.404)) RETURN F16C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S10C07(TSR,RRD,CPPD) F16C07=REAL(CPPD) RETURN END REAL FUNCTION F17C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F17C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.404)) RETURN F17C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,3,PR,RRDD) CALL S10C07(TSR,RRDD,CPPDD) F17C07=REAL(CPPDD) RETURN END REAL FUNCTION F18C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) F18C07=-1.0E+20 CALL S91C07(FP,FT,ILL91) IF(ILL91.NE.0) RETURN F18C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) CALL S10C07(TR,RR,CPPT) F18C07=REAL(CPPT) RETURN END REAL FUNCTION F19C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F19C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.100.85)) RETURN TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,2,TR,RRD) CALL S10C07(TR,RRD,CPTD) F19C07=REAL(CPTD) RETURN END REAL FUNCTION F20C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F20C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.15)) RETURN F20C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,3,TR,RRDD) CALL S10C07(TR,RRDD,CPTDD) F20C07=REAL(CPTDD) RETURN END REAL FUNCTION F21C07(A) CHARACTER*1 A,B(1:5) DOUBLE PRECISION CRP(1:5),HC,SC DATA B(1)/'H'/,B(2)/'P'/,B(3)/'S'/,B(4)/'T'/,B(5)/'V'/ CALL S7C07(1.0D0,1.0D0,HC) CALL S6C07(1.0D0,1.0D0,SC) CRP(1)=HC CRP(2)=40.640D0 CRP(3)=SC CRP(4)=101.15D0 CRP(5)=1.0D0/508.D+00 DO 10 I=1,5 F21C07=REAL(CRP(I)) IF(A.EQ.B(I)) RETURN 10 CONTINUE F21C07=-1.0E+20 RETURN END REAL FUNCTION F23C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F23C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F23C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S7C07(TSR,RRD,HPD) F23C07=REAL(HPD) RETURN END REAL FUNCTION F24C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F24C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F24C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,3,PR,RRDD) CALL S7C07(TSR,RRDD,HPDD) F24C07=REAL(HPDD) RETURN END REAL FUNCTION F25C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) F25C07=-1.0E+20 CALL S90C07(FP,FT,ILL90) IF(ILL90.NE.0) RETURN F25C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) CALL S7C07(TR,RR,HPT) F25C07=REAL(HPT) RETURN END REAL FUNCTION F26C07(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F26C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F26C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC X=DBLE(FX) CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) CALL S7C07(TSR,RRD,HD) CALL S7C07(TSR,RRDD,HDD) HPX=HD+X*(HDD-HD) F26C07=REAL(HPX) RETURN END REAL FUNCTION F27C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F27C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN F27C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,2,TR,RRD) CALL S7C07(TR,RRD,HTD) F27C07=REAL(HTD) RETURN END REAL FUNCTION F28C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F28C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN F28C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,3,TR,RRDD) CALL S7C07(TR,RRDD,HTDD) F28C07=REAL(HTDD) RETURN END REAL FUNCTION F29C07(FT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F29C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F29C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC X=DBLE(FX) CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) CALL S7C07(TR,RRD,HD) CALL S7C07(TR,RRDD,HDD) HTX=HD+X*(HDD-HD) F29C07=REAL(HTX) RETURN END REAL FUNCTION F30C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) DATA EPSTC/1.0D-05/ F30C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN TR=(DBLE(FT)+273.15D0)/TC IF(ABS(TR-1.0D0).LT.EPSTC) THEN PSR=1.0D0 ELSE CALL S2C07(1,1,TR,PSR) END IF F30C07=REAL(PSR*PC*1.0D-05) RETURN END REAL FUNCTION F31C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) DATA EPSPC/1.0D-05/ F31C07=-1.0E+20 IF((FP.LT.0.4376).OR.(FP.GT.40.641)) RETURN F31C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC IF(ABS(PR-1.0D0).LT.EPSPC) THEN SIGP=0.0D0 ELSE CALL S2C07(2,1,PR,TSR) SIGP=5.544D-02*(ABS(1.0D0-TSR))**1.220D+00 END IF F31C07=REAL(SIGP) RETURN END REAL FUNCTION F32C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) DATA EPSTC/1.0D-05/ F32C07=-1.0E+20 IF((FT.LT.-43.16).OR.(FT.GT.101.16)) RETURN TR=(DBLE(FT)+273.15D0)/TC IF(ABS(TR-1.0D0).LT.EPSTC) THEN SIGT=0.0D0 ELSE SIGT=5.544D-02*(ABS(1.0D0-TR))**1.220D+00 END IF F32C07=REAL(SIGT) RETURN END REAL FUNCTION F33C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F33C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F33C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S6C07(TSR,RRD,SPD) F33C07=REAL(SPD) RETURN END REAL FUNCTION F34C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F34C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F34C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,3,PR,RRDD) CALL S6C07(TSR,RRDD,SPDD) F34C07=REAL(SPDD) RETURN END REAL FUNCTION F35C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) F35C07=-1.0E+20 CALL S90C07(FP,FT,ILL90) IF(ILL90.NE.0) RETURN F35C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) CALL S6C07(TR,RR,SPT) F35C07=REAL(SPT) RETURN END REAL FUNCTION F36C07(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F36C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F36C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC X=DBLE(FX) CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) CALL S6C07(TSR,RRD,SD) CALL S6C07(TSR,RRDD,SDD) SPX=SD+X*(SDD-SD) F36C07=REAL(SPX) RETURN END REAL FUNCTION F37C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F37C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN F37C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,2,TR,RRD) CALL S6C07(TR,RRD,STD) F37C07=REAL(STD) RETURN END REAL FUNCTION F38C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F38C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN F38C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,3,TR,RRDD) CALL S6C07(TR,RRDD,STDD) F38C07=REAL(STDD) RETURN END REAL FUNCTION F39C07(FT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F39C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F39C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC X=DBLE(FX) CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) CALL S6C07(TR,RRD,SD) CALL S6C07(TR,RRDD,SDD) STX=SD+X*(SDD-SD) F39C07=REAL(STX) RETURN END REAL FUNCTION F40C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) DATA EPSPC/1.0D-05/ F40C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F40C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC IF(ABS(PR-1.0D0).LT.EPSPC) THEN TSR=1.0D0 ELSE CALL S2C07(2,1,PR,TSR) END IF F40C07=REAL(TSR*TC-273.15D0) RETURN END REAL FUNCTION F42C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F42C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F42C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S8C07(TSR,RRD,UPD) F42C07=REAL(UPD) RETURN END REAL FUNCTION F43C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F43C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F43C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,3,PR,RRDD) CALL S8C07(TSR,RRDD,UPDD) F43C07=REAL(UPDD) RETURN END REAL FUNCTION F44C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) F44C07=-1.0E+20 CALL S90C07(FP,FT,ILL90) IF(ILL90.NE.0) RETURN F44C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) CALL S8C07(TR,RR,UPT) F44C07=REAL(UPT) RETURN END REAL FUNCTION F45C07(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F45C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F45C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC X=DBLE(FX) CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) CALL S8C07(TSR,RRD,UD) CALL S8C07(TSR,RRDD,UDD) UPX=UD+X*(UDD-UD) F45C07=REAL(UPX) RETURN END REAL FUNCTION F46C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F46C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN F46C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,2,TR,RRD) CALL S8C07(TR,RRD,UTD) F46C07=REAL(UTD) RETURN END REAL FUNCTION F47C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F47C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN F47C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,3,TR,RRDD) CALL S8C07(TR,RRDD,UTDD) F47C07=REAL(UTDD) RETURN END REAL FUNCTION F48C07(FT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F48C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F48C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC X=DBLE(FX) CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) CALL S8C07(TR,RRD,UD) CALL S8C07(TR,RRDD,UDD) UTX=UD+X*(UDD-UD) F48C07=REAL(UTX) RETURN END REAL FUNCTION F49C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,RC=5.0800D+02) F49C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F49C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,2,PR,RRD) F49C07=REAL(1.0D0/(RRD*RC)) RETURN END REAL FUNCTION F50C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,RC=5.0800D+02) F50C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F50C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,3,PR,RRDD) F50C07=REAL(1.0D0/(RRDD*RC)) RETURN END REAL FUNCTION F51C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02,RC=5.0800D+02) F51C07=-1.0E+20 CALL S90C07(FP,FT,ILL90) IF(ILL90.NE.0) RETURN F51C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) F51C07=REAL(1.0D0/(RR*RC)) RETURN END REAL FUNCTION F52C07(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,RC=5.0800D+02) F52C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F52C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC X=DBLE(FX) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) VD=1.0D0/(RRD*RC) VDD=1.0D0/(RRDD*RC) VPX=VD+X*(VDD-VD) F52C07=REAL(VPX) RETURN END REAL FUNCTION F53C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02,RC=5.0800D+02) F53C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,2,TR,RRD) F53C07=REAL(1.0D0/(RRD*RC)) RETURN END REAL FUNCTION F54C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02,RC=5.0800D+02) F54C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN F54C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,3,TR,RRDD) F54C07=REAL(1.0D0/(RRDD*RC)) RETURN END REAL FUNCTION F55C07(FT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02,RC=5.0800D+02) F55C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F55C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC X=DBLE(FX) CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) VD=1.0D0/(RRD*RC) VDD=1.0D0/(RRDD*RC) VTX=VD+X*(VDD-VD) F55C07=REAL(VTX) RETURN END REAL FUNCTION F56C07(FP,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F56C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641).OR. - (FH.LT.F23C07(FP)).OR.(FH.GT.F24C07(FP))) RETURN F56C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC H=DBLE(FH) CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) CALL S7C07(TSR,RRD,HD) CALL S7C07(TSR,RRDD,HDD) XPH=(H-HD)/(HDD-HD) F56C07=REAL(XPH) RETURN END REAL FUNCTION F57C07(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F57C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641).OR. - (FS.LT.F33C07(FP)).OR.(FS.GT.F34C07(FP))) RETURN F57C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC S=DBLE(FS) CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) CALL S6C07(TSR,RRD,SD) CALL S6C07(TSR,RRDD,SDD) XPS=(S-SD)/(SDD-SD) F57C07=REAL(XPS) RETURN END REAL FUNCTION F58C07(FP,FU) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F58C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641).OR. - (FU.LT.F42C07(FP)).OR.(FU.GT.F43C07(FP))) RETURN F58C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC U=DBLE(FU) CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) CALL S8C07(TSR,RRD,UD) CALL S8C07(TSR,RRDD,UDD) XPU=(U-UD)/(UDD-UD) F58C07=REAL(XPU) RETURN END REAL FUNCTION F59C07(FP,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,RC=5.0800D+02) F59C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641).OR. - (FV.LT.F49C07(FP)).OR.(FV.GT.F50C07(FP))) RETURN F59C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC V=DBLE(FV) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) VD=1.0D0/(RRD*RC) VDD=1.0D0/(RRDD*RC) XPV=(V-VD)/(VDD-VD) F59C07=REAL(XPV) RETURN END REAL FUNCTION F60C07(FT,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F60C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16).OR. - (FH.LT.F27C07(FT)).OR.(FH.GT.F28C07(FT))) RETURN F60C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC H=DBLE(FH) CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) CALL S7C07(TR,RRD,HD) CALL S7C07(TR,RRDD,HDD) XTH=(H-HD)/(HDD-HD) F60C07=REAL(XTH) RETURN END REAL FUNCTION F61C07(FT,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F61C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16).OR. - (FS.LT.F37C07(FT)).OR.(FS.GT.F38C07(FT))) RETURN F61C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC S=DBLE(FS) CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) CALL S6C07(TR,RRD,SD) CALL S6C07(TR,RRDD,SDD) XTS=(S-SD)/(SDD-SD) F61C07=REAL(XTS) RETURN END REAL FUNCTION F62C07(FT,FU) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F62C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16).OR. - (FU.LT.F46C07(FT)).OR.(FU.GT.F47C07(FT))) RETURN F62C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC U=DBLE(FU) CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) CALL S8C07(TR,RRD,UD) CALL S8C07(TR,RRDD,UDD) XTU=(U-UD)/(UDD-UD) F62C07=REAL(XTU) RETURN END REAL FUNCTION F63C07(FT,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02,RC=5.0800D+02) F63C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16).OR. - (FV.LT.F53C07(FT)).OR.(FV.GT.F54C07(FT))) RETURN F63C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC V=DBLE(FV) CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) VD=1.0D0/(RRD*RC) VDD=1.0D0/(RRDD*RC) XTV=(V-VD)/(VDD-VD) F63C07=REAL(XTV) RETURN END REAL FUNCTION F64C07(FP,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) F64C07=-1.0E+20 IF((FP.GE.0.699).AND.(FP.LE.0.72979)) THEN FHMIN=F23C07(FP) ELSE IF((FP.GT.0.72979).AND.(FP.LE.150.1)) THEN FHMIN=F25C07(FP,-33.15) ELSE RETURN END IF FHMAX=F25C07(FP,206.85) IF((FHMIN.LE.-1.0E+10).OR.(FHMAX.LE.-1.0E+10)) RETURN IF((FH.LT.FHMIN*0.999).OR.(FH.GT.FHMAX*1.001)) RETURN F64C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC H=DBLE(FH) CALL S7C07(1.0D0,1.0D0,HC) IF ((ABS(PR-1.0D0).LT.1.0D-05).AND.(ABS(H/HC-1.0D0).LT.1.0D-05)) - THEN F64C07=REAL(TC-273.15D0) RETURN END IF IF(PR.GE.1.0D0) THEN TR0=1.0D0 CALL S3C07(PR,TR0,RR0) IF(RR0.LE.-1.0D+10) RETURN CALL S7C07(TR0,RR0,H0) CALL S10C07(TR0,RR0,CP0) ELSE CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) IF(RRD.LE.-1.0D+10) RETURN CALL S7C07(TSR,RRD,HD) CALL S7C07(TSR,RRDD,HDD) IF((H.GE.HD).AND.(H.LE.HDD)) THEN F64C07=REAL(TSR*TC-273.15D0) RETURN END IF IF(H.GT.HDD) THEN CALL S10C07(TSR,RRDD,CPDD) TR0=TSR H0=HDD CP0=CPDD ELSE IF(H.LT.HD) THEN CALL S10C07(TSR,RRD,CPD) TR0=TSR H0=HD CP0=CPD END IF END IF TR1=TR0+(H-H0)/(CP0*TC) CALL S3C07(PR,TR1,RR1) IF(RR1.LE.-1.0D+10) RETURN CALL S7C07(TR1,RR1,H1) TH0=TR0 TH1=TR1 CALL S40C07(1,PR,H,TH0,TH1,H0,H1,THW) IF (THW.LE.-1.0D+10) RETURN TRW=THW TPH=TRW*TC F64C07=REAL(TPH-273.15D0) RETURN END REAL FUNCTION F65C07(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) F65C07=-1.0E+20 IF((FP.GE.0.699).AND.(FP.LE.0.72979)) THEN FSMIN=F33C07(FP) ELSE IF((FP.GT.0.72979).AND.(FP.LE.150.1)) THEN FSMIN=F35C07(FP,-33.15) ELSE RETURN END IF FSMAX=F35C07(FP,206.85) IF((FSMIN.LE.-1.0E+10).OR.(FSMAX.LE.-1.0E+10)) RETURN IF((FS.LT.FSMIN*0.999).OR.(FS.GT.FSMAX*1.001)) RETURN F65C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC S=DBLE(FS) CALL S6C07(1.0D0,1.0D0,SC) IF ((ABS(PR-1.0D0).LT.1.0D-05).AND.(ABS(S/SC-1.0D0).LT.1.0D-05)) - THEN F65C07=REAL(TC-273.15D0) RETURN END IF IF(PR.GE.1.0D0) THEN TR0=1.0D0 CALL S3C07(PR,TR0,RR0) IF(RR0.LE.-1.0D+10) RETURN CALL S6C07(TR0,RR0,S0) CALL S10C07(TR0,RR0,CP0) ELSE CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) IF(RRD.LE.-1.0D+10) RETURN CALL S6C07(TSR,RRD,SD) CALL S6C07(TSR,RRDD,SDD) IF((S.GE.SD).AND.(S.LE.SDD)) THEN F65C07=REAL(TSR*TC-273.15D0) RETURN END IF IF(S.GT.SDD) THEN CALL S10C07(TSR,RRDD,CPDD) TR0=TSR S0=SDD CP0=CPDD ELSE IF(S.LT.SD) THEN CALL S10C07(TSR,RRD,CPD) TR0=TSR S0=SD CP0=CPD END IF END IF TR1=TR0*EXP((S-S0)/CP0) CALL S3C07(PR,TR1,RR1) IF(RR1.LE.-1.0D+10) RETURN CALL S6C07(TR1,RR1,S1) TH0=TR0 TH1=TR1 CALL S40C07(2,PR,S,TH0,TH1,S0,S1,THW) IF (THW.LE.-1.0D+10) RETURN TRW=THW TPS=TRW*TC F65C07=REAL(TPS-273.15D0) RETURN END REAL FUNCTION F70C07(FP,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,RC=5.08D+02,TC=3.7430D+02) F70C07=-1.0E+20 IF((FP.GE.0.699).AND.(FP.LE.0.72979)) THEN FVMIN=F49C07(FP) ELSE IF((FP.GT.0.72979).AND.(FP.LE.150.1)) THEN FVMIN=F51C07(FP,-33.15) ELSE RETURN END IF FVMAX=F51C07(FP,206.85) IF((FVMIN.LE.-1.0E+10).OR.(FVMAX.LE.-1.0E+10)) RETURN IF((FV.LT.FVMIN*0.9998).OR.(FV.GT.FVMAX*1.002)) RETURN F70C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC RR=(1.0D0/DBLE(FV))/RC IF(PR.LT.1.0D0) THEN CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) IF(RRD.LE.-1.0D+10) RETURN IF((RR.GE.RRDD).AND.(RR.LE.RRD)) THEN TPV=TSR*TC F70C07=REAL(TPV-273.15D0) RETURN END IF END IF CALL S4C07(PR,RR,TR) IF(TR.LE.-1.0D+10) RETURN TRW=TR TPV=TRW*TC F70C07=REAL(TPV-273.15D0) RETURN END REAL FUNCTION F71C07(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F71C07=-1.0E+20 IF((FP.GE.0.699).AND.(FP.LE.0.72979)) THEN FSMIN=F33C07(FP) ELSE IF((FP.GT.0.72979).AND.(FP.LE.150.1)) THEN FSMIN=F35C07(FP,-33.15) ELSE RETURN END IF FSMAX=F35C07(FP,206.85) IF((FSMIN.LE.-1.0E+10).OR.(FSMAX.LE.-1.0E+10)) RETURN IF((FS.LT.FSMIN*0.999).OR.(FS.GT.FSMAX*1.001)) RETURN F71C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC S=DBLE(FS) CALL S6C07(1.0D0,1.0D0,SC) IF ((ABS(PR-1.0D0).LT.1.0D-05).AND.(ABS(S/SC-1.0D0).LT.1.0D-05)) - THEN CALL S7C07(1.0D0,1.0D0,HC) F71C07=REAL(HC) RETURN END IF IF(PR.GE.1.0D0) THEN TR0=1.0D0 CALL S3C07(PR,TR0,RR0) IF(RR0.LE.-1.0D+10) RETURN CALL S6C07(TR0,RR0,S0) CALL S10C07(TR0,RR0,CP0) ELSE CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) IF(RRD.LE.-1.0D+10) RETURN CALL S6C07(TSR,RRD,SD) CALL S6C07(TSR,RRDD,SDD) IF((S.GE.SD).AND.(S.LE.SDD)) THEN XPS=(S-SD)/(SDD-SD) CALL S7C07(TSR,RRD,HD) CALL S7C07(TSR,RRDD,HDD) HPS=HD+XPS*(HDD-HD) F71C07=REAL(HPS) RETURN END IF IF(S.GT.SDD) THEN CALL S10C07(TSR,RRDD,CPDD) TR0=TSR S0=SDD CP0=CPDD ELSE IF(S.LT.SD) THEN CALL S10C07(TSR,RRD,CPD) TR0=TSR S0=SD CP0=CPD END IF END IF TR1=TR0*EXP((S-S0)/CP0) CALL S3C07(PR,TR1,RR1) IF(RR1.LE.-1.0D+10) RETURN CALL S6C07(TR1,RR1,S1) TH0=TR0 TH1=TR1 CALL S40C07(2,PR,S,TH0,TH1,S0,S1,THW) IF (THW.LE.-1.0D+10) RETURN TRW=THW CALL S3C07(PR,TRW,RRW) IF (RRW.LE.-1.0D+10) RETURN CALL S7C07(TRW,RRW,HW) HPS=HW F71C07=REAL(HPS) RETURN END REAL FUNCTION F76C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F76C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.641)) RETURN F76C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,3,PR,RRDD) CALL S9C07(TSR,RRDD,CVPDD) F76C07=REAL(CVPDD) RETURN END REAL FUNCTION F77C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) F77C07=-1.0E+20 CALL S91C07(FP,FT,ILL91) IF(ILL91.NE.0) RETURN F77C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) CALL S9C07(TR,RR,CVPT) F77C07=REAL(CVPT) RETURN END REAL FUNCTION F78C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F78C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.16)) RETURN F78C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,3,TR,RRDD) CALL S9C07(TR,RRDD,CVTDD) F78C07=REAL(CVTDD) RETURN END REAL FUNCTION F79C07(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F79C07=-1.0E+20 IF((FP.GE.0.699).AND.(FP.LE.0.72979)) THEN FSMIN=F33C07(FP) ELSE IF((FP.GT.0.72979).AND.(FP.LE.150.1)) THEN FSMIN=F35C07(FP,-33.15) ELSE RETURN END IF FSMAX=F35C07(FP,206.85) IF((FSMIN.LE.-1.0E+10).OR.(FSMAX.LE.-1.0E+10)) RETURN IF((FS.LT.FSMIN*0.999).OR.(FS.GT.FSMAX*1.001)) RETURN F79C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC S=DBLE(FS) CALL S6C07(1.0D0,1.0D0,SC) IF ((ABS(PR-1.0D0).LT.1.0D-05).AND.(ABS(S/SC-1.0D0).LT.1.0D-05)) - THEN CALL S8C07(1.0D0,1.0D0,UC) F79C07=REAL(UC) RETURN END IF IF(PR.GE.1.0D0) THEN TR0=1.0D0 CALL S3C07(PR,TR0,RR0) IF(RR0.LE.-1.0D+10) RETURN CALL S6C07(TR0,RR0,S0) CALL S10C07(TR0,RR0,CP0) ELSE CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) IF(RRD.LE.-1.0D+10) RETURN CALL S6C07(TSR,RRD,SD) CALL S6C07(TSR,RRDD,SDD) IF((S.GE.SD).AND.(S.LE.SDD)) THEN XPS=(S-SD)/(SDD-SD) CALL S8C07(TSR,RRD,UD) CALL S8C07(TSR,RRDD,UDD) UPS=UD+XPS*(UDD-UD) F79C07=REAL(UPS) RETURN END IF IF(S.GT.SDD) THEN CALL S10C07(TSR,RRDD,CPDD) TR0=TSR S0=SDD CP0=CPDD ELSE IF(S.LT.SD) THEN CALL S10C07(TSR,RRD,CPD) TR0=TSR S0=SD CP0=CPD END IF END IF TR1=TR0*EXP((S-S0)/CP0) CALL S3C07(PR,TR1,RR1) IF(RR1.LE.-1.0D+10) RETURN CALL S6C07(TR1,RR1,S1) TH0=TR0 TH1=TR1 CALL S40C07(2,PR,S,TH0,TH1,S0,S1,THW) IF (THW.LE.-1.0D+10) RETURN TRW=THW CALL S3C07(PR,TRW,RRW) IF (RRW.LE.-1.0D+10) RETURN CALL S8C07(TRW,RRW,UW) UPS=UW F79C07=REAL(UPS) RETURN END REAL FUNCTION F80C07(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,RC=5.08D+02) F80C07=-1.0E+20 IF((FP.GE.0.699).AND.(FP.LE.0.72979)) THEN FSMIN=F33C07(FP) ELSE IF((FP.GT.0.72979).AND.(FP.LE.150.1)) THEN FSMIN=F35C07(FP,-33.15) ELSE RETURN END IF FSMAX=F35C07(FP,206.85) IF((FSMIN.LE.-1.0E+10).OR.(FSMAX.LE.-1.0E+10)) RETURN IF((FS.LT.FSMIN*0.999).OR.(FS.GT.FSMAX*1.001)) RETURN F80C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC S=DBLE(FS) CALL S6C07(1.0D0,1.0D0,SC) IF ((ABS(PR-1.0D0).LT.1.0D-05).AND.(ABS(S/SC-1.0D0).LT.1.0D-05)) - THEN VPS=1.0D0/RC F80C07=REAL(VPS) RETURN END IF IF(PR.GE.1.0D0) THEN TR0=1.0D0 CALL S3C07(PR,TR0,RR0) IF(RR0.LE.-1.0D+10) RETURN CALL S6C07(TR0,RR0,S0) CALL S10C07(TR0,RR0,CP0) ELSE CALL S2C07(2,1,PR,TSR) CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) IF(RRD.LE.-1.0D+10) RETURN CALL S6C07(TSR,RRD,SD) CALL S6C07(TSR,RRDD,SDD) IF((S.GE.SD).AND.(S.LE.SDD)) THEN XPS=(S-SD)/(SDD-SD) VD=1.0D0/(RRD*RC) VDD=1.0D0/(RRDD*RC) VPS=VD+XPS*(VDD-VD) F80C07=REAL(VPS) RETURN END IF IF(S.GT.SDD) THEN CALL S10C07(TSR,RRDD,CPDD) TR0=TSR S0=SDD CP0=CPDD ELSE IF(S.LT.SD) THEN CALL S10C07(TSR,RRD,CPD) TR0=TSR S0=SD CP0=CPD END IF END IF TR1=TR0*EXP((S-S0)/CP0) CALL S3C07(PR,TR1,RR1) IF(RR1.LE.-1.0D+10) RETURN CALL S6C07(TR1,RR1,S1) TH0=TR0 TH1=TR1 CALL S40C07(2,PR,S,TH0,TH1,S0,S1,THW) IF (THW.LE.-1.0D+10) RETURN TRW=THW CALL S3C07(PR,TRW,RRW) IF (RRW.LE.-1.0D+10) RETURN VPS=1.0D0/(RRW*RC) F80C07=REAL(VPS) RETURN END REAL FUNCTION F81C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) FCPPT=F18C07(FP,FT) FMUPT=F13C07(FP,FT) FLMPT=F8C07(FP,FT) F81C07=-1.0E+20 IF ((FCPPT.EQ.-1.0E+20).OR.(FMUPT.EQ.-1.0E+20) - .OR.(FLMPT.EQ.-1.0E+20)) RETURN F81C07=-1.0E+10 IF ((FCPPT.EQ.-1.0E+10).OR.(FMUPT.EQ.-1.0E+10) - .OR.(FLMPT.EQ.-1.0E+10)) RETURN * FPRPT=FCPPT*FMUPT/FLMPT F81C07=FPRPT RETURN END REAL FUNCTION F82C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) F82C07=-1.0E+20 CALL S91C07(FP,FT,ILL91) IF(ILL91.NE.0) RETURN F82C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) CALL S12C07(TR,RR,AKPT) F82C07=REAL(AKPT) RETURN END REAL FUNCTION F83C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) F83C07=-1.0E+20 CALL S91C07(FP,FT,ILL91) IF(ILL91.NE.0) RETURN F83C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) CALL S11C07(TR,RR,WPT) F83C07=REAL(WPT) RETURN END REAL FUNCTION F85C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) FCPPD=F16C07(FP) FMUPD=F11C07(FP) FLMPD=F6C07(FP) F85C07=-1.0E+20 IF ((FCPPD.EQ.-1.0E+20).OR.(FMUPD.EQ.-1.0E+20) - .OR.(FLMPD.EQ.-1.0E+20)) RETURN F85C07=-1.0E+10 IF ((FCPPD.EQ.-1.0E+10).OR.(FMUPD.EQ.-1.0E+10) - .OR.(FLMPD.EQ.-1.0E+10)) RETURN * FPRPD=FCPPD*FMUPD/FLMPD F85C07=FPRPD RETURN END REAL FUNCTION F87C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) FCPTD=F19C07(FT) FMUTD=F14C07(FT) FLMTD=F9C07(FT) F87C07=-1.0E+20 IF ((FCPTD.EQ.-1.0E+20).OR.(FMUTD.EQ.-1.0E+20) - .OR.(FLMTD.EQ.-1.0E+20)) RETURN F87C07=-1.0E+10 IF ((FCPTD.EQ.-1.0E+10).OR.(FMUTD.EQ.-1.0E+10) - .OR.(FLMTD.EQ.-1.0E+10)) RETURN * FPRTD=FCPTD*FMUTD/FLMTD F87C07=FPRTD RETURN END REAL FUNCTION F90C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.064D+06,TC=374.30D+00) F90C07=-1.0E+20 CALL S91C07(FP,FT,ILL91) IF (ILL91.NE.0) RETURN F90C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) IF (RR.LE.-1.0D+10) RETURN CALL S13C07(TR,RR,BSPT) F90C07=REAL(BSPT) RETURN END REAL FUNCTION F91C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.064D+06,TC=374.30D+00) F91C07=-1.0E+20 CALL S91C07(FP,FT,ILL91) IF (ILL91.NE.0) RETURN F91C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) IF (RR.LE.-1.0D+10) RETURN CALL S14C07(TR,RR,BTPT) F91C07=REAL(BTPT) RETURN END REAL FUNCTION F92C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.064D+06,TC=374.30D+00) F92C07=-1.0E+20 CALL S91C07(FP,FT,ILL91) IF (ILL91.NE.0) RETURN F92C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) IF (RR.LE.-1.0D+10) RETURN CALL S15C07(TR,RR,BPPT) F92C07=REAL(BPPT) RETURN END REAL FUNCTION F93C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.064D+06,TC=374.30D+00) F93C07=-1.0E+20 CALL S91C07(FP,FT,ILL91) IF (ILL91.NE.0) RETURN F93C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) IF (RR.LE.-1.0D+10) RETURN CALL S16C07(TR,RR,BVPT) F93C07=REAL(BVPT) RETURN END REAL FUNCTION F94C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.064D+06,TC=374.30D+00) F94C07=-1.0E+20 CALL S91C07(FP,FT,ILL91) IF (ILL91.NE.0) RETURN F94C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) IF (RR.LE.-1.0D+10) RETURN CALL S17C07(TR,RR,AJTPT) F94C07=REAL(AJTPT) RETURN END REAL FUNCTION F95C07(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06,TC=3.7430D+02) F95C07=-1.0E+20 CALL S91C07(FP,FT,ILL91) IF(ILL91.NE.0) RETURN F95C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C07(PR,TR,RR) CALL S10C07(TR,RR,CPPT) CALL S9C07(TR,RR,CVPT) GAMPT=CPPT/CVPT F95C07=REAL(GAMPT) RETURN END REAL FUNCTION F96C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=4.0640D+06) F96C07=-1.0E+20 IF((FP.LT.0.699).OR.(FP.GT.40.404)) RETURN F96C07=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C07(2,1,PR,TSR) CALL S2C07(2,3,PR,RRDD) CALL S10C07(TSR,RRDD,CPPDD) CALL S9C07(TSR,RRDD,CVPDD) GAMPDD=CPPDD/CVPDD F96C07=REAL(GAMPDD) RETURN END REAL FUNCTION F97C07(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=3.7430D+02) F97C07=-1.0E+20 IF((FT.LT.-33.16).OR.(FT.GT.101.15)) RETURN F97C07=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C07(1,3,TR,RRDD) CALL S10C07(TR,RRDD,CPTDD) CALL S9C07(TR,RRDD,CVTDD) GAMTDD=CPTDD/CVTDD F97C07=REAL(GAMTDD) RETURN END REAL FUNCTION F98C07(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) ***** NOTE : PCRBAR IN BAR AND T IN K. PARAMETER(PCRBAR=40.640D0,TCR=374.30D0,T0K=273.15D0) DIMENSION T(2),C(2),TL(3),TR(3),CL(3),CR(3) DATA IREPM,EPS/10000,1.0D-07/ P=DBLE(FP) F98C07=-1.0E+20 IF ((P.LT.PCRBAR).OR.(P.GT.150.1D0)) RETURN IF (ABS((P-PCRBAR)/PCRBAR).LT.-1.0D-05) THEN F98C07=REAL(TCR-T0K) RETURN END IF * T2=0.9D0*TCR P2=DBLE(F30C07(REAL(T2))) TM0=TCR+(TCR-T2)*(P-PCRBAR)/(PCRBAR-P2) DEL=TCR*0.01D0 * T(1)=TM0 C(1)=DBLE(F18C07(FP,REAL(T(1)-T0K))) T(2)=T(1)-DEL C(2)=DBLE(F18C07(FP,REAL(T(2)-T0K))) 100 DEFC=C(2)-C(1) IF (DEFC.GT.0.0D0) GO TO 200 T(2)=T(1) C(2)=C(1) T(1)=T(1)+DEL C(1)=DBLE(F18C07(FP,REAL(T(1)-T0K))) GO TO 100 * 200 IREP=0 C(1)=-C(1) C(2)=-C(2) 210 IREP=IREP+1 IF (IREP.GT.IREPM) GO TO 9000 TT=T(2)+1.3D0*(T(2)-T(1)) CC=-DBLE(F18C07(FP,REAL(TT-T0K))) CONV=ABS((CC-C(2))/CC) IF (CONV.LT.EPS) THEN F98C07=REAL(TT-T0K) RETURN END IF ICONT=0 300 DEC=C(1)-CC ICONT=ICONT+1 IF (DEC.GE.0.0D0) GO TO 310 IF (ICONT.GT.5) GO TO 320 TT=(TT+T(2))*0.5D0 CC=-DBLE(F18C07(FP,REAL(TT-T0K))) GO TO 300 * 310 T(1)=TT C(1)=CC DEC=C(1)-C(2) IF (DEC.LT.0.0D0) THEN TT=T(1) CC=C(1) T(1)=T(2) C(1)=C(2) T(2)=TT C(2)=CC END IF GO TO 210 * 320 TA=T(1) TB=TT IF (TB.LT.TA) THEN TA=TT TB=T(1) END IF * TC=TA+0.5*(TB-TA) CA=DBLE(F18C07(FP,REAL(TA-T0K))) CB=DBLE(F18C07(FP,REAL(TB-T0K))) * KCONT=0 400 KCONT=KCONT+1 IF (KCONT.GT.IREPM) GO TO 9000 DELT=ABS((TA-TB)/TA) IF (DELT.LT.EPS) GO TO 500 CC=DBLE(F18C07(FP,REAL(TC-T0K))) DTA=(TC-TA)*0.3D0 TL(1)=TA TL(2)=TC-DTA TL(3)=TC DTB=(TB-TC)*0.3D0 TR(1)=TC TR(2)=TC+DTB TR(3)=TB CL(1)=CA CL(3)=CC CR(1)=CC CR(3)=CB CL(2)=DBLE(F18C07(FP,REAL(TL(2)-T0K))) CR(2)=DBLE(F18C07(FP,REAL(TR(2)-T0K))) CMXL=CL(1) ML=1 DO 410 I=2,3 IF (CL(I).GT.CMXL) THEN CMXL=CL(I) ML=1 END IF 410 CONTINUE CMXR=CR(1) MR=1 DO 420 I=2,3 IF (CR(I).GT.CMXR) THEN CMXR=CR(I) MR=1 END IF 420 CONTINUE IF (CMXL.GT.CMXR) THEN IF (ML.EQ.1) THEN TA=TL(1)-DTA CA=DBLE(F18C07(FP,REAL(TA-T0K))) ELSE TA=TL(ML-1) CA=CL(ML-1) END IF IF (ML.EQ.3) THEN TB=TR(2) CB=CR(2) ELSE TB=TL(ML+1) CB=CL(ML+1) END IF IF (ML.NE.2) GO TO 430 DELT=ABS((TL(ML)-TL(ML-1))/TL(ML)) IF (DELT.LT.EPS) GO TO 500 430 TC=TL(ML) CC=CL(ML) ELSE IF (MR.EQ.1) THEN TA=TL(2) CA=CL(2) ELSE TA=TR(MR-1) CA=CR(MR-1) END IF IF (MR.EQ.3) THEN TB=TR(3)+DTB CB=DBLE(F18C07(FP,REAL(TB-T0K))) ELSE TB=TR(MR+1) CB=CR(MR+1) END IF IF (MR.NE.2) GO TO 440 DELT=ABS((TR(MR)-TR(MR-1))/TR(MR)) IF (DELT.LT.EPS) GO TO 500 440 TC=TR(MR) CC=CR(MR) END IF GO TO 400 * 500 F98C07=REAL(TC-T0K) RETURN * 9000 F98C07=-10.0E+10 RETURN END ***** SUBROUTINES FOR HFC-134A****************************************** SUBROUTINE S1C07(K,TR,RR,FRK) ***** SUBROUTINE TO CALCULATE FR0,FR1,FR2,FR3,FR4,FR5,FR6 DEFINED ***** AS FOLLOWS: ***** K=0 : FRK=FR FROM EQ.(IIA2.3.3) ***** K=1 : FRK=D(FR)/D(RR) ***** K=2 : FRK=D(FR)/D(TR) ***** K=3 : FRK=D2(FR)/D(RR)2 ***** K=4 : FRK=D2(FR)/D(TR)2 ***** K=5 : FRK=D2(FR)/D(RR)D(TR) ***** K=6 : FRK=2*(D(FR)/D(RR))+RR*((D2(FR)/D(RR)2) ***** INPUTS : K(=0-6),TR(=T/TC),RR(=RHO/RHOC) ***** OUTPUT : FRK IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(GASCON=81.48923867D0, - TC=374.30D0, PC=4.0640D+06, RHOC=508.0D0) DIMENSION A(2:9,1:5),C(1:5),AT(2:9) DATA (A(2,J),J=1,5)/ 1.0200664D+01,-3.3117138D+01, 2.7006031D+01, - -9.3442006D+00, 4.3959113D-02/ DATA (A(3,J),J=1,5)/-3.2533383D+01, 8.4321026D+01,-5.3638675D+01, - 5.1293252D+00, 0.0D+00/ DATA (A(4,J),J=1,5)/ 7.8123563D+01,-1.8615733D+02, 1.0508815D+02, - 0.0D+00, 0.0D+00/ DATA (A(5,J),J=1,5)/-6.8597038D+01, 1.6379850D+02,-8.9655243D+01, - 0.0D+00, 0.0D+00/ DATA (A(6,J),J=1,5)/ 2.8411548D+01,-6.8881150D+01, 3.4766061D+01, - 0.0D+00, 0.0D+00/ DATA (A(7,J),J=1,5)/-4.9177332D+00, 1.3404290D+01,-5.7021512D+00, - 0.0D+00, 0.0D+00/ DATA (A(8,J),J=1,5)/ 0.0D+00, -6.1139649D-01, 0.0D+00, - 0.0D+00, 0.0D+00/ DATA (A(9,J),J=1,5)/ 5.7702463D-02,-7.7630849D-02, 6.9571809D-02, - 0.0D+00, 0.0D+00/ DATA (C(J),J=1,5) / 2.01832D+00, 1.2891165D+01,-3.83066D+00, - 7.1466D-01, 0.0D+00/ ******CONSTANTS: CS & CF, ZC,TR0 CS=17.784918D+00 CF=0.4043836D+00 ZC=PC/(GASCON*RHOC*TC) TR0=273.15D0/TC * FRK=-1.0D+30 IF ((K.LT.0).OR.(K.GT.6)) RETURN * IF ((K.EQ.0).OR.(K.EQ.1).OR.(K.EQ.3).OR.(K.EQ.6)) THEN DO 10 I=2,9 AT(I)=A(I,1)+(A(I,2)+(A(I,3)+(A(I,4)+A(I,5)/(TR*TR))/TR)/TR)/TR 10 CONTINUE ELSE IF ((K.EQ.2).OR.(K.EQ.5)) THEN DO 11 I=2,9 AT(I)=(A(I,2)+(2.0D0*A(I,3)+(3.0D0*A(I,4)+5.0D0*A(I,5)/(TR*TR) - )/TR)/TR)/(TR*TR) 11 CONTINUE ELSE IF (K.EQ.4) THEN DO 12 I=2,9 AT(I)=(2.0D0*A(I,2)+(6.0D0*A(I,3)+(12.0D0*A(I,4)+30.0D0*A(I,5) - /(TR*TR))/TR)/TR)/(TR*TR*TR) 12 CONTINUE END IF * IF (K.EQ.0) THEN FRK=(AT(2)+((AT(3)/2.0D0)+((AT(4)/3.0D0)+((AT(5)/4.0D0) - +((AT(6)/5.0D0)+((AT(7)/6.0D0)+((AT(8)/7.0D0) - +(AT(9)/8.0D0)*RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR - +(TR/ZC)*LOG(RR) +((C(1)-1.0D0)*(TR-TR0-TR*LOG(TR/TR0)) - -C(2)*(TR-TR0)**2/2.0D0-C(3)*(TR**3-3.0D0*TR0**2*TR - +2.0D0*TR0**3)/6.0D0-C(4)*(TR**4-4.0D0*TR0**3*TR - +3.0D0*TR0**4)/12.0D0-(TR-TR0)*CS-CF)/ZC ELSE IF (K.EQ.1) THEN FRK=AT(2)+(AT(3)+(AT(4)+(AT(5)+(AT(6)+(AT(7)+(AT(8) - +AT(9)*RR)*RR)*RR)*RR)*RR)*RR)*RR+TR/(ZC*RR) ELSE IF (K.EQ.2) THEN FRK=-(AT(2)+((AT(3)/2.0D0)+((AT(4)/3.0D0)+((AT(5)/4.0D0) - +((AT(6)/5.0D0)+((AT(7)/6.0D0)+((AT(8)/7.0D0) - +(AT(9)/8.0D0)*RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR - +LOG(RR)/ZC +((C(1)-1.0D0)*LOG(TR0/TR) - -C(2)*(TR-TR0)-C(3)*(TR**2-TR0**2)/2.0D0 - -C(4)*(TR**3-TR0**3)/3.0D0-CS)/ZC ELSE IF (K.EQ.3) THEN FRK=AT(3)+(2.0D0*AT(4)+(3.0D0*AT(5)+(4.0D0*AT(6) - +(5.0D0*AT(7)+(6.0D0*AT(8)+7.0D0*AT(9)*RR) - *RR)*RR)*RR)*RR)*RR-TR/(ZC*RR*RR) ELSE IF (K.EQ.4) THEN FRK=(AT(2)+((AT(3)/2.0D0)+((AT(4)/3.0D0)+((AT(5)/4.0D0) - +((AT(6)/5.0D0)+((AT(7)/6.0D0)+((AT(8)/7.0D0) - +(AT(9)/8.0D0)*RR)*RR)*RR)*RR)*RR)*RR)*RR)*RR - -((C(1)-1.0D0)/TR+C(2)+(C(3)+C(4)*TR)*TR)/ZC ELSE IF (K.EQ.5) THEN FRK=-(AT(2)+(AT(3)+(AT(4)+(AT(5)+(AT(6)+(AT(7)+(AT(8) - +AT(9)*RR)*RR)*RR)*RR)*RR)*RR)*RR)+1.0D0/(ZC*RR) ELSE IF (K.EQ.6) THEN FRK=2.0D0*AT(2)+(3.0D0*AT(3)+(4.0D0*AT(4)+(5.0D0*AT(5) - +(6.0D0*AT(6)+(7.0D0*AT(7)+(8.0D0*AT(8)+9.0D0*AT(9)*RR) - *RR)*RR)*RR)*RR)*RR)*RR+TR/(ZC*RR) END IF * RETURN END SUBROUTINE S2C07(IPIN,IPOUT,PIN,POUT) ***** SUBROUTINE TO FIND THE SATURATION PRESSURE (OR TEMPERATURE) AND, ***** SATURATED LIQUID AND VAPOR DENSITIES WHEN A TEMPERATURE ***** (OR PRESSURE) IS GIVEN. ***** NOTE THAT THE VALUE OF THE CRITICAL PRESSURE ADOPTED IN THE ***** VAPOR PRESSURE CURVE IS '4.0650 PA' (=PCSAT). PCSAT IS SLIGHTLY ***** DIFFERENT FROM PC(=4.0640 MPA) ]]] ***** IPIN=1 : PIN=TR ***** IPIN=2 : PIN=PR ***** IPOUT=1 : POUT=PSR FOR IPIN=1 OR TSR FOR IPIN=2 ***** IPOUT=2 : POUT=RRD ***** IPOUT=3 : POUT=RRDD IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(GASCON=81.48923867D0, - TC=374.30D0, PC=4.0640D+06, RHOC=508.0D0, - PCSAT=4.0650D+06) PARAMETER(EPSSAT=1.0D-12, ITMAX=10000) DATA B1/-7.6510D0/, B2/1.8458D0/, B3/-0.6821D0/, B4/-3.059D0/ * POUT=-1.0D+20 IF (PIN.LE.0.0D0) RETURN * POUT=1.0D0 IF (ABS(PIN-1.0D0).LT.2.5D-04) RETURN * IF (IPIN.EQ.1) THEN TR=PIN TR1=ABS(1.0D0-TR) PS=(EXP((B1+B2*SQRT(TR1)+(B3+B4*TR1)*TR1)*TR1/TR))*PCSAT POUT=PS/PC IF (IPOUT.EQ.1) RETURN PR=PS/PC GO TO 100 ELSE IF(IPIN.EQ.2) THEN PR=PIN PRW=(PIN*PC)/PCSAT TSR=1.0D0/(1.0D0+LOG(PRW)/B1) DO 10 IT=1,ITMAX TSR1=ABS(1.0D0-TSR) G=LOG(PRW)*TSR-(B1+B2*SQRT(TSR1)+(B3+B4*TSR1)*TSR1)*TSR1 DG=LOG(PRW)+B1+1.5D0*B2*SQRT(TSR1)+(2.0D0*B3 - +3.0D0*B4*TSR1)*TSR1 IF (ABS(G/DG).LT.EPSSAT) THEN POUT=TSR IF (IPOUT.EQ.1) RETURN TR=TSR GO TO 100 END IF TSR=TSR-G/DG 10 CONTINUE POUT=-1.0D+10 RETURN END IF * 100 CONTINUE * ZC=PC/(GASCON*RHOC*TC) * ***** INITIAL GUESSES FOR RRD(IPOUT=2) AND RRDD(IPOUT=3) * IF (IPOUT.EQ.2) THEN TR1=ABS(1.0D0-TR) RRD=1.0D0+2.451D0*TR1**0.38D0+0.4403D0*TR1**1.6D0 RR=RRD ELSE IF (IPOUT.EQ.3) THEN RRDD=ZC*(PR/TR) IF (TR.GT.0.999) THEN RRD=1.0D0+2.451D0*TR1**0.38D0+0.4403D0*TR1**1.6D0 RRDD=1.0D0/(2.0D0-1.0D0/RRD) END IF RR=RRDD END IF * *** NEWTON METHOD DO 120 IT=1,ITMAX CALL S1C07(1,TR,RR,FR1) CALL S1C07(6,TR,RR,FR6) DRR=-((RR*RR)*FR1-PR)/(RR*FR6) IF (ABS(DRR/RR).LT.EPSSAT) THEN POUT=RR RETURN END IF RR=RR+DRR 120 CONTINUE POUT=-1.0D+10 RETURN END SUBROUTINE S3C07(PR,TR,RR) ***** SUBROUTINE TO FIND THE DENSITY CORRESPONDING TO THE INPUT ***** PRESSURE AND TEMPERATURE BY SOLVING THE EQUATION OF STATE, ***** EQ.(IIA.2.3.1) USING NEWTON METHOD ***** INPUT1 : PR = P/PC ***** INPUT2 : TR = T/TC ***** OUTPUT : RR = RHO/RHOC IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(GASCON=81.48923867D0, - TC=374.30D0, PC=4.0640D+06, RHOC=508.0D0) PARAMETER(EPS=1.0D-12,ITMAX=10000) RR=1.0D0 IF ((ABS(PR-1.0D0).LE.1.0D-05).AND.(ABS(TR-1.0D0).LE.1.0D-05)) - RETURN ZC=PC/(GASCON*RHOC*TC) *** INITIAL GUESS FOR RR *** IF (PR.GE.1.0D0) THEN IF (TR.GE.1.0D0) THEN RRW=ZC*PR/TR ELSE IF (TR.LT.1.0D0) THEN RRW=2.9D0 END IF ELSE IF ((PR.LT.1.0D0).AND.(TR.GT.1.0D0)) THEN RRW=ZC*PR/TR ELSE CALL S2C07(1,1,TR,PSR) CALL S2C07(1,2,TR,RRD) CALL S2C07(1,3,TR,RRDD) IF (RRD.LE.-1.0D+10) GO TO 1000 IF ((TR.LE.1.0D0).AND.(PR.GT.PSR)) THEN IF (ABS(PSR/PR-1.0D0).LT.1.0D-05) THEN RR=RRD RETURN END IF RRW=RRD ELSE IF ((TR.LE.1.0D0).AND.(PR.LE.PSR)) THEN IF (ABS(PR/PSR-1.0D0).LT.1.0D-05) THEN RR=RRDD RETURN END IF RRW=RRDD END IF END IF *** NEWTON METHOD *** DO 1 IT=1,ITMAX CALL S1C07(1,TR,RRW,FR1) CALL S1C07(6,TR,RRW,FR6) DRRW=-((RRW*RRW)*FR1-PR)/(RRW*FR6) IF (ABS(DRRW/RRW).LT.EPS) THEN RR=RRW RETURN END IF RRW=RRW+DRRW 1 CONTINUE 1000 RR=-1.0D+10 RETURN END SUBROUTINE S4C07(PR,RR,TR) ***** SUBROUTINE TO FIND THE TEMPERATURE CORRESPONDING TO THE INPUT ***** PRESSURE AND DENSITY BY SOLVING THE EQUATION OF STATE, ***** EQ.(IIA.2.3.1) USING NEWTON METHOD ***** INPUT1 : PR = P/PC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : TR = T/TC IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(GASCON=81.48923867D0, - TC=374.30D0, PC=4.0640D+06, RHOC=508.0D0) PARAMETER(EPS=1.0D-12,ITMAX=10000) TR=1.0D0 IF ((ABS(PR-1.0D0).LE.1.0D-05).AND.(ABS(RR-1.0D0).LE.1.0D-05)) - RETURN ZC=PC/(GASCON*RHOC*TC) *** INITIAL GUESS FOR TR *** IF (PR.GE.1.0D0) THEN CALL S3C07(PR,1.0D0,RRC) IF (RR.GE.RRC) THEN TRW=240.0D0/TC ELSE TRW=480.0D0/TC END IF ELSE CALL S2C07(2,2,PR,RRD) CALL S2C07(2,3,PR,RRDD) IF (RR.GE.RRD) THEN CALL S2C07(2,1,PR,TSR) TRW=(TSR+(240.0D0/TC))/2.0D0 ELSE IF(RR.LE.RRDD) THEN TRW=480.0D0/TC END IF END IF *** NEWTON METHOD *** DO 1 IT=1,ITMAX CALL S1C07(1,TRW,RR,FR1) CALL S1C07(5,TRW,RR,FR5) DTRW=-((RR*RR)*FR1-PR)/((RR*RR)*FR5) IF (ABS(DTRW/TRW).LT.EPS) THEN TR=TRW RETURN END IF TRW=TRW+DTRW 1 CONTINUE TR=-1.0D+10 RETURN END SUBROUTINE S5C07(TR,RR,PR) ***** SUBROUTINE TO CALCULATE THE PRESSURE CORRESPONDING TO THE INPUT ***** TEMPERATURE AND DENSITY FROM EQ.(IIA.2.3.1) ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : PR = P/PC IMPLICIT DOUBLE PRECISION(A-H,O-Z) CALL S1C07(1,TR,RR,FR1) PR=(RR*RR)*FR1 RETURN END SUBROUTINE S6C07(TR,RR,S) ***** SUBROUTINE TO CALCULATE THE ENTROPY ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : S = ENTROPY IN (J/(KG*K)) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=374.30D0, PC=4.0640D+06, RHOC=508.0D0) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S1C07(2,TRW,RRW,FR2) S=(PC/(RHOC*TC))*(-FR2) RETURN END SUBROUTINE S7C07(TR,RR,H) ***** SUBROUTINE TO CALCULATE THE ENTHALPY ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : H = ENTHALPY IN (J/KG) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.0640D+06, RHOC=508.0D0) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S1C07(0,TRW,RRW,FR0) CALL S1C07(1,TRW,RRW,FR1) CALL S1C07(2,TRW,RRW,FR2) H=(PC/RHOC)*(FR0-TRW*FR2+RRW*FR1) RETURN END SUBROUTINE S8C07(TR,RR,U) ***** SUBROUTINE TO CALCULATE THE INTERNAL ENERGY ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : U = INTERNAL ENERGU IN (J/KG) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.0640D+06, RHOC=508.0D0) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S1C07(0,TRW,RRW,FR0) CALL S1C07(2,TRW,RRW,FR2) U=(PC/RHOC)*(FR0-TRW*FR2) RETURN END SUBROUTINE S9C07(TR,RR,CV) ***** SUBROUTINE TO CALCULATE THE ISOCHORIC SPECIFIC HEAT ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : CV = ISOCHORIC SPECIFIC HEAT IN J/(KG*K) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=374.30D0, PC=4.0640D+06, RHOC=508.0D0) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S1C07(4,TRW,RRW,FR4) CV=(PC/(RHOC*TC))*TRW*(-FR4) RETURN END SUBROUTINE S10C07(TR,RR,CP) ***** SUBROUTINE TO CALCULATE THE ISOBARIC SPECIFIC HEAT ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : CP = ISOBARIC SPECIFIC HEAT IN J/(KG*K) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=374.30D0, PC=4.0640D+06, RHOC=508.0D0) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S1C07(4,TRW,RRW,FR4) CALL S1C07(5,TRW,RRW,FR5) CALL S1C07(6,TRW,RRW,FR6) CP=(PC/(RHOC*TC))*TRW*(-FR4+RRW*FR5**2/FR6) RETURN END SUBROUTINE S11C07(TR,RR,W) ***** SUBROUTINE TO CALCULATE THE VELOCUTY OF SOUND ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : W = VELOCITY OF SOUND IN M/S IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.0640D+06, RHOC=508.0D0) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S9C07(TRW,RRW,CV) CALL S10C07(TRW,RRW,CP) CALL S1C07(6,TRW,RRW,FR6) W=SQRT((CP/CV)*(PC/RHOC)*RRW*FR6) RETURN END SUBROUTINE S12C07(TR,RR,AK) ***** SUBROUTINE TO CALCULATE THE ADIABATIC INDEX ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : AK = ADIABATIC INDEX IN (-) IMPLICIT DOUBLE PRECISION(A-H,O-Z) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S9C07(TRW,RRW,CV) CALL S10C07(TRW,RRW,CP) CALL S1C07(1,TRW,RRW,FR1) CALL S1C07(6,TRW,RRW,FR6) AK=(CP/CV)*(FR6/FR1) RETURN END SUBROUTINE S13C07(TR,RR,BS) ***** SUBROUTINE TO CALCULATE THE ADIABATIC COMPRESSIBILITY ***** INPUT1 : TR = T/TC ***** INPUT2 : ORR RHO/RHOCR ***** OUTPUT : BS = ADIABATIC COMPRESSIBILITY IN (1/PA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.0640D+06) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S9C07(TRW,RRW,CV) CALL S10C07(TRW,RRW,CP) CALL S1C07(6,TRW,RRW,FR6) BS=(CV/CP)/(PC*RR*RR*FR6) RETURN END SUBROUTINE S14C07(TR,RR,BT) ***** SUBROUTINE TO CALCULATE THE ISOTHERMAL COMPRESSIBILITY ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : BT = ISOTHERMAL COMPRESSIBILITY IN (1/PA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=4.0640D+06) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S9C07(TRW,RRW,CV) CALL S10C07(TRW,RRW,CP) CALL S1C07(6,TRW,RRW,FR6) BT=1.0D0/(PC*RR*RR*FR6) RETURN END SUBROUTINE S15C07(TR,RR,BP) ***** SUBROUTINE TO CALCULATE THE VOLUMETRIC EXPANSION COEFF. ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : BP = VOLUMETRIC EXPANSION COEFF. IN (1/K) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=374.30D0) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S1C07(5,TRW,RRW,FR5) CALL S1C07(6,TRW,RRW,FR6) BP=FR5/(TC*FR6) RETURN END SUBROUTINE S16C07(TR,RR,BV) ***** SUBROUTINE TO CALCULATE THE PRESSURE COEFF. ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : BV = PRESSURE COEFF. IN (1/K) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=374.30D0) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S1C07(1,TRW,RRW,FR1) CALL S1C07(5,TRW,RRW,FR5) BV=FR5/(TC*FR1) RETURN END SUBROUTINE S17C07(TR,RR,AJT) ***** SUBROUTINE TO CALCULATE THE JOULE-THOMSON COEFF. ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : AJT = JOULE-THOMSON COEFF. IN (K/PA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=374.30D0, RHOC=508.0D0) TRW=TR RRW=RR IF ((ABS(TRW-1.0D0).LE.1.0D-05) - .AND.(ABS(RRW-1.0).LE.1.0D-05)) THEN TRW=1.0D0 RRW=1.0D0 END IF CALL S10C07(TRW,RRW,CP) CALL S15C07(TRW,RRW,BP) AJT=(TC*TRW*BP-1.0D0)/(CP*RHOC*RRW) RETURN END SUBROUTINE S40C07(IHS,PR,Z,TH1,TH2,Z1,Z2,TH) *** IHS : IHS=1 FOR ARGUMENTS(FP,FH):F64 *** IHS=2 FOR ARGUMENTS(FP,FS):F65, F71, F79 AND F80 *** TH : OUTPUT=T/TC=TR IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(EPS=1.0D-07,ITMAX=10000) DO 1 IT=1,ITMAX DTH=(Z-Z2)*(TH2-TH1)/(Z2-Z1) IF (ABS(DTH/TH1).LT.EPS) THEN TH=TH2 RETURN END IF TH1=TH2 Z1=Z2 TH2=TH2+DTH TH2MIN=239.15D0/374.3D0 IF (TH2.LE.TH2MIN) THEN TH2=TH2MIN*0.9999D0 END IF CALL S3C07(PR,TH2,RR2) IF (RR2.LE.-1.0D+10) GO TO 1000 IF (IHS.EQ.1) THEN CALL S7C07(TH2,RR2,Z2) ELSE IF (IHS.EQ.2) THEN CALL S6C07(TH2,RR2,Z2) END IF 1 CONTINUE 1000 TH=-1.0D+10 RETURN END SUBROUTINE S90C07(FP,FT,ILL) ***** SUBROUTINE TO CHECK IF THE RANGE OF ARGUMENTS:(P,T) IS PROPER***** ***** FOR F25C07:HPT, F35C07:SPT, F44C07:UPT, F51C07:VPT, ****** IMPLICIT REAL(F) ILL=10000 IF ((FP.LT.0.699).OR.(FP.GT.150.1)) RETURN IF ((FT.LT.-33.16).OR.(FT.GT.206.86)) RETURN ILL=0 RETURN END SUBROUTINE S91C07(FP,FT,ILL) ***** SUBROUTINE TO CHECK IF THE RANGE OF ARGUMENTS:(P,T) IS PROPER***** ***** FOR F18C07:CPPT, F77C07:CVPT, F82C07:AKPT, F83C07:WPT, ****** ***** F90C07:BSPT, F91C07:BTPT, F92C07:BPPT, F93C07:BVPT, ****** ***** F94C07:AJTPT, F95C07:GAMPT ****** IMPLICIT REAL(F) ILL=10000 IF ((FP.LE.0.0).OR.(FP.GT.150.1)) RETURN IF ((FT.LT.-33.16).OR.(FT.GT.206.86)) RETURN ILL=0 RETURN END SUBROUTINE S97C07(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 HFC-134A ****' WRITE(6,1000) MSG 1000 FORMAT(1H ,5X,A) END IF RETURN END SUBROUTINE S98C07(IARG,ARG1,ARG2,NARG1,NARG2,NFUN) *** IARG=1 FOR ONE ARGUMENT (SECOND ARUMENT IS DUMMY) *** IARG=2 FOR TW0 ARUMENTS *** LEVEL 2 ERROR MESSAGE *** CHARACTER NFUN*6, NARG1*1,NARG2*1 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN IF (IARG.EQ.1) THEN WRITE(6,2010) NFUN,NARG1,ARG1 ELSE IF (IARG.EQ.2) THEN WRITE(6,2020) NFUN,NARG1,ARG1,NARG2,ARG2 END IF END IF 2010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR HFC-134A', - ' WHEN ',A1,' =', 1PE14.7,' ****') 2020 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR HFC-134A', - ' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') RETURN END SUBROUTINE S99C07(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 HFC-134A ****' 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