*=====PR123V81====1993/04/22========================================* *=====PAR123======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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(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 S99C08(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== *------------------------------------------------- F1C08 = AIPPT REAL FUNCTION AIPPT(P,T) REAL P,PI,T,TI PI=P TI=T CALL S99C08('AIPPT') AIPPT=-1.0E+30 RETURN END *------------------------------------------------- F2C08 = ALAPP REAL FUNCTION ALAPP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) ALAPP=F2C08(PI) IF(ALAPP.EQ.-1.0E+10) THEN CALL S97C08('ALAPP') ELSE IF(ALAPP.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','ALAPP') END IF RETURN END *------------------------------------------------- F3C08 = ALAPT REAL FUNCTION ALAPT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) ALAPT=F3C08(TI) IF(ALAPT.EQ.-1.0E+10) THEN CALL S97C08('ALAPT') ELSE IF(ALAPT.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','ALAPT') END IF RETURN END *------------------------------------------------- F4C08 = ALHP REAL FUNCTION ALHP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) ALHP=F4C08(PI) IF(ALHP.EQ.-1.0E+10) THEN CALL S97C08('ALHP') ELSE IF(ALHP.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','ALHP') END IF RETURN END *------------------------------------------------- F5C08 = ALHT REAL FUNCTION ALHT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) ALHT=F5C08(TI) IF(ALHT.EQ.-1.0E+10) THEN CALL S97C08('ALHT') ELSE IF(ALHT.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','ALHT') END IF RETURN END *------------------------------------------------- F6C08 = ALMPD REAL FUNCTION ALMPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) ALMPD=F6C08(PI) IF(ALMPD.EQ.-1.0E+10) THEN CALL S97C08('ALMPD') ELSE IF(ALMPD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','ALMPD') END IF RETURN END *------------------------------------------------- F7C08 = ALMPDD REAL FUNCTION ALMPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) ALMPDD=F7C08(PI) IF(ALMPDD.EQ.-1.0E+10) THEN CALL S97C08('ALMPDD') ELSE IF(ALMPDD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','ALMPDD') END IF RETURN END *------------------------------------------------- F8C08 = ALMPT REAL FUNCTION ALMPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) ALMPT=F8C08(PI,TI) IF(ALMPT.EQ.-1.0E+10) THEN CALL S97C08('ALMPT') ELSE IF(ALMPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','ALMPT') END IF RETURN END *------------------------------------------------- F9C08 = ALMTD REAL FUNCTION ALMTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) ALMTD=F9C08(TI) IF(ALMTD.EQ.-1.0E+10) THEN CALL S97C08('ALMTD') ELSE IF(ALMTD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','ALMTD') END IF RETURN END *------------------------------------------------- F10C08 = ALMTDD REAL FUNCTION ALMTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) ALMTDD=F10C08(TI) IF(ALMTDD.EQ.-1.0E+10) THEN CALL S97C08('ALMTDD') ELSE IF(ALMTDD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','ALMTDD') END IF RETURN END *------------------------------------------------- F11C08 = AMUPD REAL FUNCTION AMUPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) AMUPD=F11C08(PI) IF(AMUPD.EQ.-1.0E+10) THEN CALL S97C08('AMUPD') ELSE IF(AMUPD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','AMUPD') END IF RETURN END *------------------------------------------------- F12C08 = AMUPDD REAL FUNCTION AMUPDD(P) REAL P,PI PI=P CALL S99C08('AMUPDD') AMUPDD=-1.0E+30 RETURN END *------------------------------------------------- F13C08 = AMUPT REAL FUNCTION AMUPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) AMUPT=F13C08(PI,TI) IF(AMUPT.EQ.-1.0E+10) THEN CALL S97C08('AMUPT') ELSE IF(AMUPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','AMUPT') END IF RETURN END *------------------------------------------------- F14C08 = AMUTD REAL FUNCTION AMUTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) AMUTD=F14C08(TI) IF(AMUTD.EQ.-1.0E+10) THEN CALL S97C08('AMUTD') ELSE IF(AMUTD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','AMUTD') END IF RETURN END *------------------------------------------------- F15C08 = AMUTDD REAL FUNCTION AMUTDD(T) REAL T,TI TI=T CALL S99C08('AMUTDD') AMUTDD=-1.0E+30 RETURN END *------------------------------------------------- F16C08 = CPPD REAL FUNCTION CPPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) CPPD=F16C08(PI) IF(CPPD.EQ.-1.0E+10) THEN CALL S97C08('CPPD') ELSE IF(CPPD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','CPPD') END IF RETURN END *------------------------------------------------- F17C08 = CPPDD REAL FUNCTION CPPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) CPPDD=F17C08(PI) IF(CPPDD.EQ.-1.0E+10) THEN CALL S97C08('CPPDD') ELSE IF(CPPDD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','CPPDD') END IF RETURN END *------------------------------------------------- F18C08 = CPPT REAL FUNCTION CPPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) CPPT=F18C08(PI,TI) IF(CPPT.EQ.-1.0E+10) THEN CALL S97C08('CPPT') ELSE IF(CPPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','CPPT') END IF RETURN END *------------------------------------------------- F19C08 = CPTD REAL FUNCTION CPTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) CPTD=F19C08(TI) IF(CPTD.EQ.-1.0E+10) THEN CALL S97C08('CPTD') ELSE IF(CPTD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','CPTD') END IF RETURN END *------------------------------------------------- F20C08 = CPTDD REAL FUNCTION CPTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) CPTDD=F20C08(TI) IF(CPTDD.EQ.-1.0E+10) THEN CALL S97C08('CPTDD') ELSE IF(CPTDD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','CPTDD') END IF RETURN END *------------------------------------------------- F21C08 = 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=F21C08(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 HCFC-123', - ' 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 *------------------------------------------------- F22C08 = EPSPT REAL FUNCTION EPSPT(P,T) REAL P,PI,T,TI PI=P TI=T CALL S99C08('EPSPT') EPSPT=-1.0E+30 RETURN END *----------------------------------------------------- F89 = FC *************************************************** * FUNCTION FOR FUNDAMENTAL CONSTANTS * PROPATH VER.8.1, JULY 9, 1992. * USAGE: B=FC(A) * A, B : CHARACTER TYPE VARIABLES * B='152.931' WHEN A='M' * B='54.36769' WHEN A='R' *************************************************** REAL FUNCTION FC(A) CHARACTER A*1, MSG*120 COMMON /UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=152.931 ELSE IF (A.EQ.'R') THEN FC=54.36769 ELSE FC=-1.0E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR HCFC-123 WHEN A=''' - //A//''' ****' WRITE(6,'(1H, A)') MSG END IF END IF RETURN END *------------------------------------------------- F23C08 = HPD REAL FUNCTION HPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) HPD=F23C08(PI) IF(HPD.EQ.-1.0E+10) THEN CALL S97C08('HPD') ELSE IF(HPD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','HPD') END IF RETURN END *------------------------------------------------- F24C08 = HPDD REAL FUNCTION HPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) HPDD=F24C08(PI) IF(HPDD.EQ.-1.0E+10) THEN CALL S97C08('HPDD') ELSE IF(HPDD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','HPDD') END IF RETURN END *------------------------------------------------- F25C08 = HPT REAL FUNCTION HPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) HPT=F25C08(PI,TI) IF(HPT.EQ.-1.0E+10) THEN CALL S97C08('HPT') ELSE IF(HPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','HPT') END IF RETURN END *------------------------------------------------- F26C08 = HPX REAL FUNCTION HPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) HPX=F26C08(PI,X) IF(HPX.EQ.-1.0E+10) THEN CALL S97C08('HPX') ELSE IF(HPX.EQ.-1.0E+20) THEN CALL S98C08(2,P,X,'P','X','HPX') END IF RETURN END *------------------------------------------------- F27C08 = HTD REAL FUNCTION HTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) HTD=F27C08(TI) IF(HTD.EQ.-1.0E+10) THEN CALL S97C08('HTD') ELSE IF(HTD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','HTD') END IF RETURN END *------------------------------------------------- F28C08 = HTDD REAL FUNCTION HTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) HTDD=F28C08(TI) IF(HTDD.EQ.-1.0E+10) THEN CALL S97C08('HTDD') ELSE IF(HTDD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','HTDD') END IF RETURN END *------------------------------------------------- F29C08 = HTX REAL FUNCTION HTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) HTX=F29C08(TI,X) IF(HTX.EQ.-1.0E+10) THEN CALL S97C08('HTX') ELSE IF(HTX.EQ.-1.0E+20) THEN CALL S98C08(2,T,X,'T','X','HTX') END IF RETURN END *------------------------------------------------- F30C08 = PST REAL FUNCTION PST(T) REAL TI,T INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) PST=F30C08(TI) IF(PST.EQ.-1.0E+10) THEN CALL S97C08('PST') RETURN ELSE IF(PST.EQ.-1.0E+20) THEN CALL S98C08(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 *------------------------------------------------- F31C08 = SIGP REAL FUNCTION SIGP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) SIGP=F31C08(PI) IF(SIGP.EQ.-1.0E+10) THEN CALL S97C08('SIGP') ELSE IF(SIGP.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','SIGP') END IF RETURN END *------------------------------------------------- F32C08 = SIGT REAL FUNCTION SIGT(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) SIGT=F32C08(TI) IF(SIGT.EQ.-1.0E+10) THEN CALL S97C08('SIGT') ELSE IF(SIGT.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','SIGT') END IF RETURN END *------------------------------------------------- F33C08 = SPD REAL FUNCTION SPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) SPD=F33C08(PI) IF(SPD.EQ.-1.0E+10) THEN CALL S97C08('SPD') ELSE IF(SPD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','SPD') END IF RETURN END *------------------------------------------------- F34C08 = SPDD REAL FUNCTION SPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) SPDD=F34C08(PI) IF(SPDD.EQ.-1.0E+10) THEN CALL S97C08('SPDD') ELSE IF(SPDD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','SPDD') END IF RETURN END *------------------------------------------------- F35C08 = SPT REAL FUNCTION SPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) SPT=F35C08(PI,TI) IF(SPT.EQ.-1.0E+10) THEN CALL S97C08('SPT') ELSE IF(SPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','SPT') END IF RETURN END *------------------------------------------------- F36C08 = SPX REAL FUNCTION SPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) SPX=F36C08(PI,X) IF(SPX.EQ.-1.0E+10) THEN CALL S97C08('SPX') ELSE IF(SPX.EQ.-1.0E+20) THEN CALL S98C08(2,P,X,'P','X','SPX') END IF RETURN END *------------------------------------------------- F37C08 = STD REAL FUNCTION STD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) STD=F37C08(TI) IF(STD.EQ.-1.0E+10) THEN CALL S97C08('STD') ELSE IF(STD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','STD') END IF RETURN END *------------------------------------------------- F38C08 = STDD REAL FUNCTION STDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) STDD=F38C08(TI) IF(STDD.EQ.-1.0E+10) THEN CALL S97C08('STDD') ELSE IF(STDD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','STDD') END IF RETURN END *------------------------------------------------- F39C08 = STX REAL FUNCTION STX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) STX=F39C08(TI,X) IF(STX.EQ.-1.0E+10) THEN CALL S97C08('STX') ELSE IF(STX.EQ.-1.0E+20) THEN CALL S98C08(2,T,X,'T','X','STX') END IF RETURN END *------------------------------------------------- F40C08 = TSP REAL FUNCTION TSP(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TSP=F40C08(PI) IF(TSP.EQ.-1.0E+10) THEN CALL S97C08('TSP') RETURN ELSE IF(TSP.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','TSP') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TSP=TSP+273.15 RETURN END *------------------------------------------------- F41C08 = TRPL REAL FUNCTION TRPL(A) CHARACTER A*1,AI*1 AI=A CALL S99C08('TRPL') TRPL=-1.0E+30 RETURN END *------------------------------------------------- F42C08 = UPD REAL FUNCTION UPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) UPD=F42C08(PI) IF(UPD.EQ.-1.0E+10) THEN CALL S97C08('UPD') ELSE IF(UPD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','UPD') END IF RETURN END *------------------------------------------------- F43C08 = UPDD REAL FUNCTION UPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) UPDD=F43C08(PI) IF(UPDD.EQ.-1.0E+10) THEN CALL S97C08('UPDD') ELSE IF(UPDD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','UPDD') END IF RETURN END *------------------------------------------------- F44C08 = UPT REAL FUNCTION UPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) UPT=F44C08(PI,TI) IF(UPT.EQ.-1.0E+10) THEN CALL S97C08('UPT') ELSE IF(UPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','UPT') END IF RETURN END *------------------------------------------------- F45C08 = UPX REAL FUNCTION UPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) UPX=F45C08(PI,X) IF(UPX.EQ.-1.0E+10) THEN CALL S97C08('UPX') ELSE IF(UPX.EQ.-1.0E+20) THEN CALL S98C08(2,P,X,'P','X','UPX') END IF RETURN END *------------------------------------------------- F46C08 = UTD REAL FUNCTION UTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) UTD=F46C08(TI) IF(UTD.EQ.-1.0E+10) THEN CALL S97C08('UTD') ELSE IF(UTD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','UTD') END IF RETURN END *------------------------------------------------- F47C08 = UTDD REAL FUNCTION UTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) UTDD=F47C08(TI) IF(UTDD.EQ.-1.0E+10) THEN CALL S97C08('UTDD') ELSE IF(UTDD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','UTDD') END IF RETURN END *------------------------------------------------- F48C08 = UTX REAL FUNCTION UTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) UTX=F48C08(TI,X) IF(UTX.EQ.-1.0E+10) THEN CALL S97C08('UTX') ELSE IF(UTX.EQ.-1.0E+20) THEN CALL S98C08(2,T,X,'T','X','UTX') END IF RETURN END *------------------------------------------------- F49C08 = VPD REAL FUNCTION VPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) VPD=F49C08(PI) IF(VPD.EQ.-1.0E+10) THEN CALL S97C08('VPD') ELSE IF(VPD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','VPD') END IF RETURN END *------------------------------------------------- F50C08 = VPDD REAL FUNCTION VPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) VPDD=F50C08(PI) IF(VPDD.EQ.-1.0E+10) THEN CALL S97C08('VPDD') ELSE IF(VPDD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','VPDD') END IF RETURN END *------------------------------------------------- F51C08 = VPT REAL FUNCTION VPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) VPT=F51C08(PI,TI) IF(VPT.EQ.-1.0E+10) THEN CALL S97C08('VPT') ELSE IF(VPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','VPT') END IF RETURN END *------------------------------------------------- F52C08 = VPX REAL FUNCTION VPX(P,X) REAL P,PI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) VPX=F52C08(PI,X) IF(VPX.EQ.-1.0E+10) THEN CALL S97C08('VPX') ELSE IF(VPX.EQ.-1.0E+20) THEN CALL S98C08(2,P,X,'P','X','VPX') END IF RETURN END *------------------------------------------------- F53C08 = VTD REAL FUNCTION VTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) VTD=F53C08(TI) IF(VTD.EQ.-1.0E+10) THEN CALL S97C08('VTD') ELSE IF(VTD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','VTD') END IF RETURN END *------------------------------------------------- F54C08 = VTDD REAL FUNCTION VTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) VTDD=F54C08(TI) IF(VTDD.EQ.-1.0E+10) THEN CALL S97C08('VTDD') ELSE IF(VTDD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','VTDD') END IF RETURN END *------------------------------------------------- F55C08 = VTX REAL FUNCTION VTX(T,X) REAL T,TI,X INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) VTX=F55C08(TI,X) IF(VTX.EQ.-1.0E+10) THEN CALL S97C08('VTX') ELSE IF(VTX.EQ.-1.0E+20) THEN CALL S98C08(2,T,X,'T','X','VTX') END IF RETURN END *------------------------------------------------- F56C08 = XPH REAL FUNCTION XPH(P,H) REAL P,PI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) XPH=F56C08(PI,H) IF(XPH.EQ.-1.0E+10) THEN CALL S97C08('XPH') ELSE IF(XPH.EQ.-1.0E+20) THEN CALL S98C08(2,P,H,'P','H','XPH') END IF RETURN END *------------------------------------------------- F57C08 = XPS REAL FUNCTION XPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) XPS=F57C08(PI,S) IF(XPS.EQ.-1.0E+10) THEN CALL S97C08('XPS') ELSE IF(XPS.EQ.-1.0E+20) THEN CALL S98C08(2,P,S,'P','S','XPS') END IF RETURN END *------------------------------------------------- F58C08 = XPU REAL FUNCTION XPU(P,U) REAL P,PI,U INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) XPU=F58C08(PI,U) IF(XPU.EQ.-1.0E+10) THEN CALL S97C08('XPU') ELSE IF(XPU.EQ.-1.0E+20) THEN CALL S98C08(2,P,U,'P','U','XPU') END IF RETURN END *------------------------------------------------- F59C08 = XPV REAL FUNCTION XPV(P,V) REAL P,PI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) XPV=F59C08(PI,V) IF(XPV.EQ.-1.0E+10) THEN CALL S97C08('XPV') ELSE IF(XPV.EQ.-1.0E+20) THEN CALL S98C08(2,P,V,'P','V','XPV') END IF RETURN END *------------------------------------------------- F60C08 = XTH REAL FUNCTION XTH(T,H) REAL T,TI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) XTH=F60C08(TI,H) IF(XTH.EQ.-1.0E+10) THEN CALL S97C08('XTH') ELSE IF(XTH.EQ.-1.0E+20) THEN CALL S98C08(2,T,H,'T','H','XTH') END IF RETURN END *------------------------------------------------- F61C08 = XTS REAL FUNCTION XTS(T,S) REAL T,TI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) XTS=F61C08(TI,S) IF(XTS.EQ.-1.0E+10) THEN CALL S97C08('XTS') ELSE IF(XTS.EQ.-1.0E+20) THEN CALL S98C08(2,T,S,'T','S','XTS') END IF RETURN END *------------------------------------------------- F62C08 = XTU REAL FUNCTION XTU(T,U) REAL T,TI,U INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) XTU=F62C08(TI,U) IF(XTU.EQ.-1.0E+10) THEN CALL S97C08('XTU') ELSE IF(XTU.EQ.-1.0E+20) THEN CALL S98C08(2,T,U,'T','U','XTU') END IF RETURN END *------------------------------------------------- F63C08 = XTV REAL FUNCTION XTV(T,V) REAL T,TI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) XTV=F63C08(TI,V) IF(XTV.EQ.-1.0E+10) THEN CALL S97C08('XTV') ELSE IF(XTV.EQ.-1.0E+20) THEN CALL S98C08(2,T,V,'T','V','XTV') END IF RETURN END *------------------------------------------------- F64C08 = TPH REAL FUNCTION TPH(P,H) REAL P,PI,H INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TPH=F64C08(PI,H) IF(TPH.EQ.-1.0E+10) THEN CALL S97C08('TPH') RETURN ELSE IF(TPH.EQ.-1.0E+20) THEN CALL S98C08(2,P,H,'P','H','TPH') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPH=TPH+273.15 RETURN END *------------------------------------------------- F65C08 = TPS REAL FUNCTION TPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TPS=F65C08(PI,S) IF(TPS.EQ.-1.0E+10) THEN CALL S97C08('TPS') RETURN ELSE IF(TPS.EQ.-1.0E+20) THEN CALL S98C08(2,P,S,'P','S','TPS') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPS=TPS+273.15 RETURN END *------------------------------------------------- F66C08 = PLDT REAL FUNCTION PLDT(T) REAL T,TI TI=T CALL S99C08('PLDT') PLDT=-1.0E+30 RETURN END *------------------------------------------------- F67C08 = TLDP REAL FUNCTION TLDP(P) REAL P,PI PI=P CALL S99C08('TLDP') TLDP=-1.0E+30 RETURN END *------------------------------------------------- F68C08 = PMLT REAL FUNCTION PMLT(T) REAL T,TI TI=T CALL S99C08('PMLT') PMLT=-1.0E+30 RETURN END *------------------------------------------------- F69C08 = TMLP REAL FUNCTION TMLP(P) REAL P,PI PI=P CALL S99C08('TMLP') TMLP=-1.0E+30 RETURN END *------------------------------------------------- F70C08 = TPV REAL FUNCTION TPV(P,V) REAL P,PI,V INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TPV=F70C08(PI,V) IF(TPV.EQ.-1.0E+10) THEN CALL S97C08('TPV') RETURN ELSE IF(TPV.EQ.-1.0E+20) THEN CALL S98C08(2,P,V,'P','V','TPV') RETURN END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPV=TPV+273.15 RETURN END *------------------------------------------------- F71C08 = HPS REAL FUNCTION HPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) HPS=F71C08(PI,S) IF(HPS.EQ.-1.0E+10) THEN CALL S97C08('HPS') ELSE IF(HPS.EQ.-1.0E+20) THEN CALL S98C08(2,P,S,'P','S','HPS') END IF RETURN END *------------------------------------------------- F72C08 = PSTD REAL FUNCTION PSTD(T) REAL T,TI TI=T CALL S99C08('PSTD') PSTD=-1.0E+30 RETURN END *------------------------------------------------- F73C08 = PSTDD REAL FUNCTION PSTDD(T) REAL T,TI TI=T CALL S99C08('PSTDD') PSTDD=-1.0E+30 RETURN END *------------------------------------------------- F74C08 = TSPD REAL FUNCTION TSPD(P) REAL P,PI PI=P CALL S99C08('TSPD') TSPD=-1.0E+30 RETURN END *------------------------------------------------- F75C08 = TSPDD REAL FUNCTION TSPDD(P) REAL P,PI PI=P CALL S99C08('TSPDD') TSPDD=-1.0E+30 RETURN END *------------------------------------------------- F76C08 = CVPDD REAL FUNCTION CVPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) CVPDD=F76C08(PI) IF(CVPDD.EQ.-1.0E+10) THEN CALL S97C08('CVPDD') ELSE IF(CVPDD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','CVPDD') END IF RETURN END *------------------------------------------------- F77C08 = CVPT REAL FUNCTION CVPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) CVPT=F77C08(PI,TI) IF(CVPT.EQ.-1.0E+10) THEN CALL S97C08('CVPT') ELSE IF(CVPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','CVPT') END IF RETURN END *------------------------------------------------- F78C08 = CVTDD REAL FUNCTION CVTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) CVTDD=F78C08(TI) IF(CVTDD.EQ.-1.0E+10) THEN CALL S97C08('CVTDD') ELSE IF(CVTDD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','CVTDD') END IF RETURN END *------------------------------------------------- F79C08 = UPS REAL FUNCTION UPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) UPS=F79C08(PI,S) IF(UPS.EQ.-1.0E+10) THEN CALL S97C08('UPS') ELSE IF(UPS.EQ.-1.0E+20) THEN CALL S98C08(2,P,S,'P','S','UPS') END IF RETURN END *------------------------------------------------- F80C08 = VPS REAL FUNCTION VPS(P,S) REAL P,PI,S INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) VPS=F80C08(PI,S) IF(VPS.EQ.-1.0E+10) THEN CALL S97C08('VPS') ELSE IF(VPS.EQ.-1.0E+20) THEN CALL S98C08(2,P,S,'P','S','VPS') END IF RETURN END *------------------------------------------------- F81C08 = PRPT REAL FUNCTION PRPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) PRPT=F81C08(PI,TI) IF(PRPT.EQ.-1.0E+10) THEN CALL S97C08('PRPT') ELSE IF(PRPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','PRPT') END IF RETURN END *------------------------------------------------- F82C08 = AKPT REAL FUNCTION AKPT(P,T) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) AKPT=F82C08(PI,TI) IF(AKPT.EQ.-1.0E+10) THEN CALL S97C08('AKPT') ELSE IF(AKPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','AKPT') END IF RETURN END *------------------------------------------------- F83C08 = WPT REAL FUNCTION WPT(P,T) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) WPT=F83C08(PI,TI) IF(WPT.EQ.-1.0E+10) THEN CALL S97C08('WPT') ELSE IF(WPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','WPT') END IF RETURN END *------------------------------------------------- F84C08 = 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='HCFC-123' WHEN A='S' C B='CHCL2-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='HCFC-123' ELSE IF (A.EQ.'C') THEN IDENTF='CHCL2-CF3' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG=' *** OUT OF RANGE AT IDENTF FOR HCFC-123 WHEN A=''' & //A//''' ****' WRITE(6,'(1H,A)') MSG END IF END IF RETURN END *------------------------------------------------- F85C08 = PRPD REAL FUNCTION PRPD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) PRPD=F85C08(PI) IF(PRPD.EQ.-1.0E+10) THEN CALL S97C08('PRPD') ELSE IF(PRPD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','PRPD') END IF RETURN END *------------------------------------------------- F86C08 = PRPDD REAL FUNCTION PRPDD(P) REAL P,PI PI=P CALL S99C08('PRPDD') PRPDD=-1.0E+30 RETURN END *------------------------------------------------- F87C08 = PRTD REAL FUNCTION PRTD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) PRTD=F87C08(TI) IF(PRTD.EQ.-1.0E+10) THEN CALL S97C08('PRTD') ELSE IF(PRTD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','PRTD') END IF RETURN END *------------------------------------------------- F88C08 = PRTDD REAL FUNCTION PRTDD(T) REAL T,TI TI=T CALL S99C08('PRTDD') PRTDD=-1.0E+30 RETURN END *------------------------------------------------- F90C08 = BSPT REAL FUNCTION BSPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) BSPT=F90C08(PI,TI) IF(BSPT.EQ.-1.0E+10) THEN CALL S97C08('BSPT') RETURN ELSE IF(BSPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','BSPT') RETURN END IF RETURN END *------------------------------------------------- F91C08 = BTPT REAL FUNCTION BTPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) BTPT=F91C08(PI,TI) IF(BTPT.EQ.-1.0E+10) THEN CALL S97C08('BTPT') RETURN ELSE IF(BTPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','BTPT') RETURN END IF RETURN END *------------------------------------------------- F92C08 = BPPT REAL FUNCTION BPPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) BPPT=F92C08(PI,TI) IF(BPPT.EQ.-1.0E+10) THEN CALL S97C08('BPPT') ELSE IF(BPPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','BPPT') END IF RETURN END *------------------------------------------------- F93C08 = BVPT REAL FUNCTION BVPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) BVPT=F93C08(PI,TI) IF(BVPT.EQ.-1.0E+10) THEN CALL S97C08('BVPT') ELSE IF(BVPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','BVPT') END IF RETURN END *------------------------------------------------- F94C08 = AJTPT REAL FUNCTION AJTPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) AJTPT=F94C08(PI,TI) IF(AJTPT.EQ.-1.0E+10) THEN CALL S97C08('AJTPT') RETURN ELSE IF(AJTPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','AJTPT') RETURN END IF RETURN END *------------------------------------------------- F95C08 = GAMPT REAL FUNCTION GAMPT(P,T) REAL P,PI,T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) TI=G99C08(KPA,T) GAMPT=F95C08(PI,TI) IF(GAMPT.EQ.-1.0E+10) THEN CALL S97C08('GAMPT') ELSE IF(GAMPT.EQ.-1.0E+20) THEN CALL S98C08(2,P,T,'P','T','GAMPT') END IF RETURN END *------------------------------------------------- F96C08 = GAMPDD REAL FUNCTION GAMPDD(P) REAL P,PI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS PI=G98C08(KPA,P) GAMPDD=F96C08(PI) IF(GAMPDD.EQ.-1.0E+10) THEN CALL S97C08('GAMPDD') ELSE IF(GAMPDD.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','GAMPDD') END IF RETURN END *------------------------------------------------- F97C08 = GAMTDD REAL FUNCTION GAMTDD(T) REAL T,TI INTEGER KPA,MESS COMMON/UNIT/KPA,MESS TI=G99C08(KPA,T) GAMTDD=F97C08(TI) IF(GAMTDD.EQ.-1.0E+10) THEN CALL S97C08('GAMTDD') ELSE IF(GAMTDD.EQ.-1.0E+20) THEN CALL S98C08(1,T,T,'T','T','GAMTDD') END IF RETURN END *-------------------------------------------------- F98C08 = TPSEUP REAL FUNCTION TPSEUP(P) ***** TPSEUP = PSEUDO BOILING POINT REAL P,PI INTEGER KPA,MESS COMMON /UNIT/KPA,MESS PI=G98C08(KPA,P) TPSEUP=F98C08(PI) IF(TPSEUP.EQ.-1.0E+10) THEN CALL S97C08('TPSEUP') ELSE IF(TPSEUP.EQ.-1.0E+20) THEN CALL S98C08(1,P,P,'P','P','TPSEUP') END IF IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN TPSEUP=TPSEUP+273.15 RETURN END *------------------------------------------------- F99C08 = PSBT REAL FUNCTION PSBT(T) REAL T,TI TI=T CALL S99C08('PSBT') PSBT=-1.0E+30 RETURN END *------------------------------------------------- F100C08 = TSBP REAL FUNCTION TSBP(P) REAL P,PI PI=P CALL S99C08('TSBP') TSBP=-1.0E+30 RETURN END *------------------------------------------------- G98C08 REAL FUNCTION G98C08(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 G98C08=P*PBAR RETURN END *------------------------------------------------- G99C08 REAL FUNCTION G99C08(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 G99C08=T-T0K RETURN END ***** R123V81:FUNCTIONS****1992/08/21***************************** REAL FUNCTION F2C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,RC=5.55D+02,GRVT=9.80665D+00) F2C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F2C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) IF((RRDD.LT.0.0D0).OR.(RRD0.LE.RRDD)) RETURN SIG=5.485D-02*(ABS(1.0D0-TSR))**1.227D+00 ALAPP=SQRT(SIG/(GRVT*(RRD0-RRDD)*RC)) F2C08=REAL(ALAPP) RETURN END REAL FUNCTION F3C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02,RC=5.55D+02,GRVT=9.80665D+00) F3C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN F3C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,20,TR,RRD0) CALL S2C08(1,3,TR,RRDD) IF((RRDD.LT.0.0D0).OR.(RRD0.LE.RRDD)) RETURN SIG=5.485D-02*(ABS(1.0D0-TR))**1.227D+00 ALAPT=SQRT(SIG/(GRVT*(RRD0-RRDD)*RC)) F3C08=REAL(ALAPT) RETURN END REAL FUNCTION F4C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F4C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F4C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) CALL S21C08(TSR,RRD0,HD) CALL S7C08(TSR,RRDD,HDD) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN ALHP=(HDD-HD) F4C08=REAL(ALHP) RETURN END REAL FUNCTION F5C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F5C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN F5C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,20,TR,RRD0) CALL S2C08(1,3,TR,RRDD) CALL S21C08(TR,RRD0,HD) CALL S7C08(TR,RRDD,HDD) IF((HDD.LT.0.0D0).OR.(HD.LT.0.0D0)) RETURN ALHT=(HDD-HD) F5C08=REAL(ALHT) RETURN END REAL FUNCTION F6C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) DATA A00/+1.63175D+02/, A01/-2.90282D-01/ F6C08=-1.0E+20 IF((FP.LT.0.1066).OR.(FP.GT.9.16)) RETURN F6C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) ALMPD=A00+A01*(TSR*TC) F6C08=REAL(ALMPD*1.0D-03) RETURN END REAL FUNCTION F7C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) DATA B00/-1.025D+01/, B01/+6.844D-02/ F7C08=-1.0E+20 IF((FP.LT.0.674).OR.(FP.GT.7.34)) RETURN PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) ALMPDD=B00+B01*(TSR*TC) F7C08=REAL(ALMPDD*1.0D-03) RETURN END REAL FUNCTION F8C08(FP,FT) ***** FOR SUPERHEATED VAPOR AT 0.101325 MPA ONLY(EQ.(IIIA.3.3.4)) ***** AND FOR COMPRESSED LIQUID(EQ.(IIIA.3.3.1)) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) DATA A00/+1.63175D+02/, A01/-2.90282D-01/, - A10/+2.30183D+00/, A11/-1.43892D-02/, A12/+2.64289D-05/, - A20/-2.53110D-02/, A21/+1.67082D-04/, A22/-2.83606D-07/ - A30/+4.98296D-05/, A31/-3.25253D-07/, A32/+5.38515D-10/ F8C08=-1.0E+20 IF((FP.LT.0.999).OR.(FP.GT.200.1)) RETURN IF((FT.LT.-23.16).OR.(FT.GT.106.86)) RETURN T=DBLE(FT)+273.15D0 * *** FOR SUPERHEATED VAPOR AT 0.101325 MPA ONLY(EQ.(IIIA.3.3.4)) IF((ABS((FP/1.01325)-1.0).LT.1.0E-03).AND.(FT.GT.31.84).AND. - (FT.LT.96.86)) THEN ALM1T=(-6.68+0.0564*T)*1.0D-03 F8C08=REAL(ALM1T*1.0D-03) RETURN END IF * *** FOR COMPRESSED LIQUID(EQ.(IIIA.3.3.1)) IF((FP.LE.36.66).AND.(FT.GT.F40C08(FP))) RETURN P=DBLE(FP)*1.0D+05/1.0D+06 TR=T/TC CALL S2C08(1,1,TR,PSR) PS=(PSR*PC)/1.0D+06 DP=P-PS A0=A00+A01*T A1=A10+(A11+A12*T)*T A2=A20+(A21+A22*T)*T A3=A30+(A31+A32*T)*T ALMPTL=A0+(A1+(A2+A3*DP)*DP)*DP F8C08=REAL(ALMPTL*1.0D-03) RETURN END REAL FUNCTION F9C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DATA A00/+1.63175D+02/, A01/-2.90282D-01/ F9C08=-1.0E+20 IF((FT.LT.-23.16).OR.(FT.GT.106.86)) RETURN T=DBLE(FT)+273.15D0 ALMTD=A00+A01*T F9C08=REAL(ALMTD*1.0D-03) RETURN END REAL FUNCTION F10C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DATA B00/-1.025D+01/, B01/+6.844D-02/ F10C08=-1.0E+20 IF((FT.LT.16.84).OR.(FT.GT.96.86)) RETURN T=DBLE(FT)+273.15D0 ALMTDD=B00+B01*T F10C08=REAL(ALMTDD*1.0D-03) RETURN END REAL FUNCTION F11C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) DATA CO1/-1.1093D+01/, CO2/+1.6032D+03/, - CO3/+2.5615D-02/, CO4/-3.1391D-05/ F11C08=-1.0E+20 IF ((FP.LT.0.289).OR.(FP.GT.4.76)) RETURN F11C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) TS=TSR*TC XMUPD=CO1+CO2/TS+CO3*TS+CO4*TS**2 AMUPD=EXP(XMUPD)*1.0D-03 F11C08=REAL(AMUPD) RETURN END REAL FUNCTION F13C08(FP,FT) ***** FOR SUPERHEATED VAPOR ONLY, EQ.(IIIA.3.1.3) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DATA A10/-1.24512D+00/,A11/+4.4975D-03/,A12/-4.51505D-06/ - A20/-0.63229D+00/, A21/+2.440D-03/ F13C08=-1.0E+20 IF ((FP.LT.0.99).OR.(FP.GT.18.1)) RETURN IF ((FT.LT.F40C08(FP)).OR.(FT.GT.148.9)) RETURN T=DBLE(FT)+273.15D0 * AMU1T=(3.904D-02-8.548D-06*T)*T * P1=0.101325D+06/1.0D+06 P=DBLE(FP)*1.0D+05/1.0D+06 DP=P-P1 A1=A10+(A11+A12*T)*T A2=A20+A21*T AMUPT=AMU1T+(A1+A2*DP)*DP F13C08=REAL(AMUPT*1.0D-06) RETURN END REAL FUNCTION F14C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) DATA CO1/-1.1093D+01/, CO2/+1.6032D+03/, - CO3/+2.5615D-02/, CO4/-3.1391D-05/ F14C08=-1.0E+20 IF((FT.LT.-3.16).OR.(FT.GT.78.86)) RETURN F14C08=-1.0E+10 TS=DBLE(FT)+273.15D0 XMUTD=CO1+CO2/TS+CO3*TS+CO4*TS**2 AMUTD=EXP(XMUTD)*1.0D-03 F14C08=REAL(AMUTD) RETURN END REAL FUNCTION F16C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F16C08=-1.0E+20 IF((FP.LT.0.333).OR.(FP.GT.35.0)) RETURN F16C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S10C08(TSR,RRD0,CPPD) F16C08=REAL(CPPD) RETURN END REAL FUNCTION F17C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F17C08=-1.0E+20 IF((FP.LT.0.333).OR.(FP.GT.35.0)) RETURN F17C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,3,PR,RRDD) CALL S10C08(TSR,RRDD,CPPDD) F17C08=REAL(CPPDD) RETURN END REAL FUNCTION F18C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) F18C08=-1.0E+20 CALL S91C08(FP,FT,ILL91) IF(ILL91.NE.0) RETURN F18C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) CALL S10C08(TR,RR,CPPT) F18C08=REAL(CPPT) RETURN END REAL FUNCTION F19C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F19C08=-1.0E+20 IF((FT.LT.-0.1).OR.(FT.GT.180.86)) RETURN TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,20,TR,RRD0) CALL S10C08(TR,RRD0,CPTD) F19C08=REAL(CPTD) RETURN END REAL FUNCTION F20C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F20C08=-1.0E+20 IF((FT.LT.-0.1).OR.(FT.GT.180.86)) RETURN F20C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,3,TR,RRDD) CALL S10C08(TR,RRDD,CPTDD) F20C08=REAL(CPTDD) RETURN END REAL FUNCTION F21C08(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 S7C08(1.0D0,1.0D0,HC) CALL S6C08(1.0D0,1.0D0,SC) CRP(1)=HC CRP(2)=36.666D0 CRP(3)=SC CRP(4)=183.71D0 CRP(5)=1.0D0/555.D+00 DO 10 I=1,5 F21C08=REAL(CRP(I)) IF(A.EQ.B(I)) RETURN 10 CONTINUE F21C08=-1.0E+20 RETURN END REAL FUNCTION F23C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F23C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F23C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S21C08(TSR,RRD0,HPD) F23C08=REAL(HPD) RETURN END REAL FUNCTION F24C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F24C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F24C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,3,PR,RRDD) CALL S7C08(TSR,RRDD,HPDD) F24C08=REAL(HPDD) RETURN END REAL FUNCTION F25C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) F25C08=-1.0E+20 CALL S90C08(FP,FT,ILL90) IF(ILL90.NE.0) RETURN F25C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) IF(PR.GT.1.0D0) THEN IF(TR.LT.1.0D0) THEN CALL S21C08(TR,RR,HPT) ELSE CALL S7C08(TR,RR,HPT) END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TR.LT.TSR) THEN CALL S21C08(TR,RR,HPT) ELSE CALL S7C08(TR,RR,HPT) END IF END IF F25C08=REAL(HPT) RETURN END REAL FUNCTION F26C08(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F26C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F26C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC X=DBLE(FX) CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) CALL S21C08(TSR,RRD0,HD) CALL S7C08(TSR,RRDD,HDD) HPX=HD+X*(HDD-HD) F26C08=REAL(HPX) RETURN END REAL FUNCTION F27C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F27C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN F27C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,20,TR,RRD0) CALL S21C08(TR,RRD0,HTD) F27C08=REAL(HTD) RETURN END REAL FUNCTION F28C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F28C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN F28C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,3,TR,RRDD) CALL S7C08(TR,RRDD,HTDD) F28C08=REAL(HTDD) RETURN END REAL FUNCTION F29C08(FT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F29C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F29C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC X=DBLE(FX) CALL S2C08(1,20,TR,RRD0) CALL S2C08(1,3,TR,RRDD) CALL S21C08(TR,RRD0,HD) CALL S7C08(TR,RRDD,HDD) HTX=HD+X*(HDD-HD) F29C08=REAL(HTX) RETURN END REAL FUNCTION F30C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) DATA EPSTC/1.0D-05/ F30C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN TR=(DBLE(FT)+273.15D0)/TC IF(ABS(TR-1.0D0).LT.EPSTC) THEN PSR=1.0D0 ELSE CALL S2C08(1,1,TR,PSR) END IF F30C08=REAL(PSR*PC*1.0D-05) RETURN END REAL FUNCTION F31C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) DATA EPSPC/1.0D-05/ F31C08=-1.0E+20 IF((FP.LT.0.0446).OR.(FP.GT.36.661)) RETURN F31C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC IF(ABS(PR-1.0D0).LT.EPSPC) THEN SIGP=0.0D0 ELSE CALL S2C08(2,1,PR,TSR) SIGP=5.485D-02*(ABS(1.0D0-TSR))**1.227D+00 END IF F31C08=REAL(SIGP) RETURN END REAL FUNCTION F32C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) DATA EPSTC/1.0D-05/ F32C08=-1.0E+20 IF((FT.LT.-38.16).OR.(FT.GT.183.72)) RETURN TR=(DBLE(FT)+273.15D0)/TC IF(ABS(TR-1.0D0).LT.EPSTC) THEN SIGT=0.0D0 ELSE SIGT=5.485D-02*(ABS(1.0D0-TR))**1.227D+00 END IF F32C08=REAL(SIGT) RETURN END REAL FUNCTION F33C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F33C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F33C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S20C08(TSR,RRD0,SPD) F33C08=REAL(SPD) RETURN END REAL FUNCTION F34C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F34C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F34C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,3,PR,RRDD) CALL S6C08(TSR,RRDD,SPDD) F34C08=REAL(SPDD) RETURN END REAL FUNCTION F35C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) F35C08=-1.0E+20 CALL S90C08(FP,FT,ILL90) IF(ILL90.NE.0) RETURN F35C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) IF(PR.GT.1.0D0) THEN IF(TR.LT.1.0D0) THEN CALL S20C08(TR,RR,SPT) ELSE CALL S6C08(TR,RR,SPT) END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TR.LT.TSR) THEN CALL S20C08(TR,RR,SPT) ELSE CALL S6C08(TR,RR,SPT) END IF END IF F35C08=REAL(SPT) RETURN END REAL FUNCTION F36C08(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F36C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F36C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC X=DBLE(FX) CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) CALL S20C08(TSR,RRD0,SD) CALL S6C08(TSR,RRDD,SDD) SPX=SD+X*(SDD-SD) F36C08=REAL(SPX) RETURN END REAL FUNCTION F37C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F37C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN F37C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,20,TR,RRD0) CALL S20C08(TR,RRD0,STD) F37C08=REAL(STD) RETURN END REAL FUNCTION F38C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F38C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN F38C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,3,TR,RRDD) CALL S6C08(TR,RRDD,STDD) F38C08=REAL(STDD) RETURN END REAL FUNCTION F39C08(FT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F39C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F39C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC X=DBLE(FX) CALL S2C08(1,20,TR,RRD0) CALL S2C08(1,3,TR,RRDD) CALL S20C08(TR,RRD0,SD) CALL S6C08(TR,RRDD,SDD) STX=SD+X*(SDD-SD) F39C08=REAL(STX) RETURN END REAL FUNCTION F40C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) DATA EPSPC/1.0D-05/ F40C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F40C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC IF(ABS(PR-1.0D0).LT.EPSPC) THEN TSR=1.0D0 ELSE CALL S2C08(2,1,PR,TSR) END IF F40C08=REAL(TSR*TC-273.15D0) RETURN END REAL FUNCTION F42C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F42C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F42C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S22C08(TSR,RRD0,UPD) F42C08=REAL(UPD) RETURN END REAL FUNCTION F43C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F43C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F43C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,3,PR,RRDD) CALL S8C08(TSR,RRDD,UPDD) F43C08=REAL(UPDD) RETURN END REAL FUNCTION F44C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) F44C08=-1.0E+20 CALL S90C08(FP,FT,ILL90) IF(ILL90.NE.0) RETURN F44C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) IF(PR.GT.1.0D0) THEN IF(TR.LT.1.0D0) THEN CALL S22C08(TR,RR,UPT) ELSE CALL S8C08(TR,RR,UPT) END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TR.LT.TSR) THEN CALL S22C08(TR,RR,UPT) ELSE CALL S8C08(TR,RR,UPT) END IF END IF F44C08=REAL(UPT) RETURN END REAL FUNCTION F45C08(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F45C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F45C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC X=DBLE(FX) CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) CALL S22C08(TSR,RRD0,UD) CALL S8C08(TSR,RRDD,UDD) UPX=UD+X*(UDD-UD) F45C08=REAL(UPX) RETURN END REAL FUNCTION F46C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F46C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN F46C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,20,TR,RRD0) CALL S22C08(TR,RRD0,UTD) F46C08=REAL(UTD) RETURN END REAL FUNCTION F47C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F47C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN F47C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,3,TR,RRDD) CALL S8C08(TR,RRDD,UTDD) F47C08=REAL(UTDD) RETURN END REAL FUNCTION F48C08(FT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F48C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F48C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC X=DBLE(FX) CALL S2C08(1,20,TR,RRD0) CALL S2C08(1,3,TR,RRDD) CALL S22C08(TR,RRD0,UD) CALL S8C08(TR,RRDD,UDD) UTX=UD+X*(UDD-UD) F48C08=REAL(UTX) RETURN END REAL FUNCTION F49C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,RC=5.55D+02) F49C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F49C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,20,PR,RRD0) F49C08=REAL(1.0D0/(RRD0*RC)) RETURN END REAL FUNCTION F50C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,RC=5.55D+02) F50C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661)) RETURN F50C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,3,PR,RRDD) F50C08=REAL(1.0D0/(RRDD*RC)) RETURN END REAL FUNCTION F51C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02,RC=5.55D+02) F51C08=-1.0E+20 CALL S90C08(FP,FT,ILL90) IF(ILL90.NE.0) RETURN F51C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) F51C08=REAL(1.0D0/(RR*RC)) RETURN END REAL FUNCTION F52C08(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,RC=5.55D+02) F52C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F52C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC X=DBLE(FX) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) VD=1.0D0/(RRD0*RC) VDD=1.0D0/(RRDD*RC) VPX=VD+X*(VDD-VD) F52C08=REAL(VPX) RETURN END REAL FUNCTION F53C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02,RC=5.55D+02) F53C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,20,TR,RRD0) F53C08=REAL(1.0D0/(RRD0*RC)) RETURN END REAL FUNCTION F54C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02,RC=5.55D+02) F54C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72)) RETURN F54C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,3,TR,RRDD) F54C08=REAL(1.0D0/(RRDD*RC)) RETURN END REAL FUNCTION F55C08(FT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02,RC=5.55D+02) F55C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72).OR. - (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN F55C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC X=DBLE(FX) CALL S2C08(1,20,TR,RRD0) CALL S2C08(1,3,TR,RRDD) VD=1.0D0/(RRD0*RC) VDD=1.0D0/(RRDD*RC) VTX=VD+X*(VDD-VD) F55C08=REAL(VTX) RETURN END REAL FUNCTION F56C08(FP,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F56C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661).OR. - (FH.LT.F23C08(FP)).OR.(FH.GT.F24C08(FP))) RETURN F56C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC H=DBLE(FH) CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) CALL S21C08(TSR,RRD0,HD) CALL S7C08(TSR,RRDD,HDD) XPH=(H-HD)/(HDD-HD) F56C08=REAL(XPH) RETURN END REAL FUNCTION F57C08(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F57C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661).OR. - (FS.LT.F33C08(FP)).OR.(FS.GT.F34C08(FP))) RETURN F57C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC S=DBLE(FS) CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) CALL S20C08(TSR,RRD0,SD) CALL S6C08(TSR,RRDD,SDD) XPS=(S-SD)/(SDD-SD) F57C08=REAL(XPS) RETURN END REAL FUNCTION F58C08(FP,FU) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F58C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661).OR. - (FU.LT.F42C08(FP)).OR.(FU.GT.F43C08(FP))) RETURN F58C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC U=DBLE(FU) CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) CALL S22C08(TSR,RRD0,UD) CALL S8C08(TSR,RRDD,UDD) XPU=(U-UD)/(UDD-UD) F58C08=REAL(XPU) RETURN END REAL FUNCTION F59C08(FP,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,RC=5.55D+02) F59C08=-1.0E+20 IF((FP.LT.0.199).OR.(FP.GT.36.661).OR. - (FV.LT.F49C08(FP)).OR.(FV.GT.F50C08(FP))) RETURN F59C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC V=DBLE(FV) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) VD=1.0D0/(RRD0*RC) VDD=1.0D0/(RRDD*RC) XPV=(V-VD)/(VDD-VD) F59C08=REAL(XPV) RETURN END REAL FUNCTION F60C08(FT,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F60C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72).OR. - (FH.LT.F27C08(FT)).OR.(FH.GT.F28C08(FT))) RETURN F60C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC H=DBLE(FH) CALL S2C08(1,20,TR,RRD0) CALL S2C08(1,3,TR,RRDD) CALL S21C08(TR,RRD0,HD) CALL S7C08(TR,RRDD,HDD) XTH=(H-HD)/(HDD-HD) F60C08=REAL(XTH) RETURN END REAL FUNCTION F61C08(FT,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F61C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72).OR. - (FS.LT.F37C08(FT)).OR.(FS.GT.F38C08(FT))) RETURN F61C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC S=DBLE(FS) CALL S2C08(1,20,TR,RRD0) CALL S2C08(1,3,TR,RRDD) CALL S20C08(TR,RRD0,SD) CALL S6C08(TR,RRDD,SDD) XTS=(S-SD)/(SDD-SD) F61C08=REAL(XTS) RETURN END REAL FUNCTION F62C08(FT,FU) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F62C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72).OR. - (FU.LT.F46C08(FT)).OR.(FU.GT.F47C08(FT))) RETURN F62C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC U=DBLE(FU) CALL S2C08(1,20,TR,RRD0) CALL S2C08(1,3,TR,RRDD) CALL S22C08(TR,RRD0,UD) CALL S8C08(TR,RRDD,UDD) XTU=(U-UD)/(UDD-UD) F62C08=REAL(XTU) RETURN END REAL FUNCTION F63C08(FT,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02,RC=5.55D+02) F63C08=-1.0E+20 IF((FT.LT.-13.16).OR.(FT.GT.183.72).OR. - (FV.LT.F53C08(FT)).OR.(FV.GT.F54C08(FT))) RETURN F63C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC V=DBLE(FV) CALL S2C08(1,20,TR,RRD0) CALL S2C08(1,3,TR,RRDD) VD=1.0D0/(RRD0*RC) VDD=1.0D0/(RRDD*RC) XTV=(V-VD)/(VDD-VD) F63C08=REAL(XTV) RETURN END REAL FUNCTION F64C08(FP,FH) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) F64C08=-1.0E+20 IF((FP.GE.0.199).AND.(FP.LE.100.1)) THEN FHMIN=F25C08(FP,-0.1) ELSE RETURN END IF FHMAX=F25C08(FP,226.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 F64C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC H=DBLE(FH) CALL S7C08(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 F64C08=REAL(TC-273.15D0) RETURN END IF IF(PR.GE.1.0D0) THEN TR0=1.0D0 CALL S3C08(PR,TR0,RR0) IF(RR0.LE.-1.0D+10) RETURN CALL S7C08(TR0,RR0,H0) CALL S10C08(TR0,RR0,CP0) ELSE CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) IF(RRD0.LE.-1.0D+10) RETURN CALL S21C08(TSR,RRD0,HD) CALL S7C08(TSR,RRDD,HDD) IF((H.GE.HD).AND.(H.LE.HDD)) THEN F64C08=REAL(TSR*TC-273.15D0) RETURN END IF IF(H.GT.HDD) THEN CALL S10C08(TSR,RRDD,CPDD) TR0=TSR H0=HDD CP0=CPDD ELSE IF(H.LT.HD) THEN CALL S10C08(TSR,RRD0,CPD) TR0=TSR H0=HD CP0=CPD END IF END IF TR1=TR0+(H-H0)/(CP0*TC) CALL S3C08(PR,TR1,RR1) IF(RR1.LE.-1.0D+10) RETURN IF(PR.GE.1.0D0) THEN IF(TR1.LT.1.0D0) THEN CALL S21C08(TR1,RR1,H1) ELSE CALL S7C08(TR1,RR1,H1) END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TR1.LT.TSR) THEN CALL S21C08(TR1,RR1,H1) ELSE CALL S7C08(TR1,RR1,H1) END IF END IF TH0=TR0 TH1=TR1 CALL S40C08(1,PR,H,TH0,TH1,H0,H1,THW) IF (THW.LE.-1.0D+10) RETURN TRW=THW TPH=TRW*TC F64C08=REAL(TPH-273.15D0) RETURN END REAL FUNCTION F65C08(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) F65C08=-1.0E+20 IF((FP.GE.0.199).AND.(FP.LE.100.1)) THEN FSMIN=F35C08(FP,-0.1) ELSE RETURN END IF FSMAX=F35C08(FP,226.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 F65C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC S=DBLE(FS) CALL S6C08(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 F65C08=REAL(TC-273.15D0) RETURN END IF IF(PR.GE.1.0D0) THEN TR0=1.0D0 CALL S3C08(PR,TR0,RR0) IF(RR0.LE.-1.0D+10) RETURN CALL S6C08(TR0,RR0,S0) CALL S10C08(TR0,RR0,CP0) ELSE CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) IF(RRD0.LE.-1.0D+10) RETURN CALL S20C08(TSR,RRD0,SD) CALL S6C08(TSR,RRDD,SDD) IF((S.GE.SD).AND.(S.LE.SDD)) THEN F65C08=REAL(TSR*TC-273.15D0) RETURN END IF IF(S.GT.SDD) THEN CALL S10C08(TSR,RRDD,CPDD) TR0=TSR S0=SDD CP0=CPDD ELSE IF(S.LT.SD) THEN CALL S10C08(TSR,RRD0,CPD) TR0=TSR S0=SD CP0=CPD END IF END IF TR1=TR0*EXP((S-S0)/CP0) CALL S3C08(PR,TR1,RR1) IF(RR1.LE.-1.0D+10) RETURN IF(PR.GE.1.0D0) THEN IF(TR1.LT.1.0D0) THEN CALL S20C08(TR1,RR1,S1) ELSE CALL S6C08(TR1,RR1,S1) END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TR1.LT.TSR) THEN CALL S20C08(TR1,RR1,S1) ELSE CALL S6C08(TR1,RR1,S1) END IF END IF TH0=TR0 TH1=TR1 CALL S40C08(2,PR,S,TH0,TH1,S0,S1,THW) IF (THW.LE.-1.0D+10) RETURN TRW=THW TPS=TRW*TC F65C08=REAL(TPS-273.15D0) RETURN END REAL FUNCTION F70C08(FP,FV) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,RC=5.55D+02,TC=4.5686D+02) F70C08=-1.0E+20 IF((FP.GE.0.199).AND.(FP.LE.100.1)) THEN FVMIN=F51C08(FP,-0.1) ELSE RETURN END IF FVMAX=F51C08(FP,226.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 F70C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC RR=(1.0D0/DBLE(FV))/RC IF(PR.LT.1.0D0) THEN CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) IF(RRD0.LE.-1.0D+10) RETURN IF((RR.GE.RRDD).AND.(RR.LE.RRD0)) THEN TPV=TSR*TC F70C08=REAL(TPV-273.15D0) RETURN END IF END IF CALL S4C08(PR,RR,TR) IF(TR.LE.-1.0D+10) RETURN TRW=TR TPV=TRW*TC F70C08=REAL(TPV-273.15D0) RETURN END REAL FUNCTION F71C08(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F71C08=-1.0E+20 IF((FP.GE.0.199).AND.(FP.LE.100.1)) THEN FSMIN=F35C08(FP,-0.1) ELSE RETURN END IF FSMAX=F35C08(FP,226.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 F71C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC S=DBLE(FS) CALL S6C08(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 S7C08(1.0D0,1.0D0,HC) F71C08=REAL(HC) RETURN END IF IF(PR.GE.1.0D0) THEN TR0=1.0D0 CALL S3C08(PR,TR0,RR0) IF(RR0.LE.-1.0D+10) RETURN CALL S6C08(TR0,RR0,S0) CALL S10C08(TR0,RR0,CP0) ELSE CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) IF(RRD0.LE.-1.0D+10) RETURN CALL S20C08(TSR,RRD0,SD) CALL S6C08(TSR,RRDD,SDD) IF((S.GE.SD).AND.(S.LE.SDD)) THEN XPS=(S-SD)/(SDD-SD) CALL S21C08(TSR,RRD0,HD) CALL S7C08(TSR,RRDD,HDD) HPS=HD+XPS*(HDD-HD) F71C08=REAL(HPS) RETURN END IF IF(S.GT.SDD) THEN CALL S10C08(TSR,RRDD,CPDD) TR0=TSR S0=SDD CP0=CPDD ELSE IF(S.LT.SD) THEN CALL S10C08(TSR,RRD0,CPD) TR0=TSR S0=SD CP0=CPD END IF END IF TR1=TR0*EXP((S-S0)/CP0) CALL S3C08(PR,TR1,RR1) IF(RR1.LE.-1.0D+10) RETURN IF(PR.GE.1.0D0) THEN IF(TR1.LT.1.0D0) THEN CALL S20C08(TR1,RR1,S1) ELSE CALL S6C08(TR1,RR1,S1) END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TR1.LT.TSR) THEN CALL S20C08(TR1,RR1,S1) ELSE CALL S6C08(TR1,RR1,S1) END IF END IF TH0=TR0 TH1=TR1 CALL S40C08(2,PR,S,TH0,TH1,S0,S1,THW) IF (THW.LE.-1.0D+10) RETURN TRW=THW CALL S3C08(PR,TRW,RRW) IF (RRW.LE.-1.0D+10) RETURN IF(PR.GE.1.0D0) THEN IF(TRW.LT.1.0D0) THEN CALL S21C08(TRW,RRW,HW) ELSE CALL S7C08(TRW,RRW,HW) END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TRW.LT.TSR) THEN CALL S21C08(TRW,RRW,HW) ELSE CALL S7C08(TRW,RRW,HW) END IF END IF HPS=HW F71C08=REAL(HPS) RETURN END REAL FUNCTION F76C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F76C08=-1.0E+20 IF((FP.LT.0.333).OR.(FP.GT.35.0)) RETURN F76C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,3,PR,RRDD) CALL S9C08(TSR,RRDD,CVPDD) F76C08=REAL(CVPDD) RETURN END REAL FUNCTION F77C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) F77C08=-1.0E+20 CALL S91C08(FP,FT,ILL91) IF(ILL91.NE.0) RETURN F77C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) CALL S9C08(TR,RR,CVPT) F77C08=REAL(CVPT) RETURN END REAL FUNCTION F78C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F78C08=-1.0E+20 IF((FT.LT.-0.1).OR.(FT.GT.180.86)) RETURN F78C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,3,TR,RRDD) CALL S9C08(TR,RRDD,CVTDD) F78C08=REAL(CVTDD) RETURN END REAL FUNCTION F79C08(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F79C08=-1.0E+20 IF((FP.GE.0.199).AND.(FP.LE.100.1)) THEN FSMIN=F35C08(FP,-0.1) ELSE RETURN END IF FSMAX=F35C08(FP,226.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 F79C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC S=DBLE(FS) CALL S6C08(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 S8C08(1.0D0,1.0D0,UC) F79C08=REAL(UC) RETURN END IF IF(PR.GE.1.0D0) THEN TR0=1.0D0 CALL S3C08(PR,TR0,RR0) IF(RR0.LE.-1.0D+10) RETURN CALL S6C08(TR0,RR0,S0) CALL S10C08(TR0,RR0,CP0) ELSE CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) IF(RRD0.LE.-1.0D+10) RETURN CALL S20C08(TSR,RRD0,SD) CALL S6C08(TSR,RRDD,SDD) IF((S.GE.SD).AND.(S.LE.SDD)) THEN XPS=(S-SD)/(SDD-SD) CALL S22C08(TSR,RRD0,UD) CALL S8C08(TSR,RRDD,UDD) UPS=UD+XPS*(UDD-UD) F79C08=REAL(UPS) RETURN END IF IF(S.GT.SDD) THEN CALL S10C08(TSR,RRDD,CPDD) TR0=TSR S0=SDD CP0=CPDD ELSE IF(S.LT.SD) THEN CALL S10C08(TSR,RRD0,CPD) TR0=TSR S0=SD CP0=CPD END IF END IF TR1=TR0*EXP((S-S0)/CP0) CALL S3C08(PR,TR1,RR1) IF(RR1.LE.-1.0D+10) RETURN IF(PR.GE.1.0D0) THEN IF(TR1.LT.1.0D0) THEN CALL S20C08(TR1,RR1,S1) ELSE CALL S6C08(TR1,RR1,S1) END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TR1.LT.TSR) THEN CALL S20C08(TR1,RR1,S1) ELSE CALL S6C08(TR1,RR1,S1) END IF END IF TH0=TR0 TH1=TR1 CALL S40C08(2,PR,S,TH0,TH1,S0,S1,THW) IF (THW.LE.-1.0D+10) RETURN TRW=THW CALL S3C08(PR,TRW,RRW) IF (RRW.LE.-1.0D+10) RETURN IF(PR.GE.1.0D0) THEN IF(TRW.LT.1.0D0) THEN CALL S22C08(TRW,RRW,UW) ELSE CALL S8C08(TRW,RRW,UW) END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TRW.LT.TSR) THEN CALL S22C08(TRW,RRW,UW) ELSE CALL S8C08(TRW,RRW,UW) END IF END IF UPS=UW F79C08=REAL(UPS) RETURN END REAL FUNCTION F80C08(FP,FS) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,RC=5.55D+02) F80C08=-1.0E+20 IF((FP.GE.0.199).AND.(FP.LE.100.1)) THEN FSMIN=F35C08(FP,-0.1) ELSE RETURN END IF FSMAX=F35C08(FP,226.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 F80C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC S=DBLE(FS) CALL S6C08(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 F80C08=REAL(VPS) RETURN END IF IF(PR.GE.1.0D0) THEN TR0=1.0D0 CALL S3C08(PR,TR0,RR0) IF(RR0.LE.-1.0D+10) RETURN CALL S6C08(TR0,RR0,S0) CALL S10C08(TR0,RR0,CP0) ELSE CALL S2C08(2,1,PR,TSR) CALL S2C08(2,20,PR,RRD0) CALL S2C08(2,3,PR,RRDD) IF(RRD0.LE.-1.0D+10) RETURN CALL S20C08(TSR,RRD0,SD) CALL S6C08(TSR,RRDD,SDD) IF((S.GE.SD).AND.(S.LE.SDD)) THEN XPS=(S-SD)/(SDD-SD) VD=1.0D0/(RRD0*RC) VDD=1.0D0/(RRDD*RC) VPS=VD+XPS*(VDD-VD) F80C08=REAL(VPS) RETURN END IF IF(S.GT.SDD) THEN CALL S10C08(TSR,RRDD,CPDD) TR0=TSR S0=SDD CP0=CPDD ELSE IF(S.LT.SD) THEN CALL S10C08(TSR,RRD0,CPD) TR0=TSR S0=SD CP0=CPD END IF END IF TR1=TR0*EXP((S-S0)/CP0) CALL S3C08(PR,TR1,RR1) IF(RR1.LE.-1.0D+10) RETURN IF(PR.GE.1.0D0) THEN IF(TR1.LT.1.0D0) THEN CALL S20C08(TR1,RR1,S1) ELSE CALL S6C08(TR1,RR1,S1) END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TR1.LT.TSR) THEN CALL S20C08(TR1,RR1,S1) ELSE CALL S6C08(TR1,RR1,S1) END IF END IF TH0=TR0 TH1=TR1 CALL S40C08(2,PR,S,TH0,TH1,S0,S1,THW) IF (THW.LE.-1.0D+10) RETURN TRW=THW CALL S3C08(PR,TRW,RRW) IF (RRW.LE.-1.0D+10) RETURN VPS=1.0D0/(RRW*RC) F80C08=REAL(VPS) RETURN END REAL FUNCTION F81C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) FCPPT=F18C08(FP,FT) FMUPT=F13C08(FP,FT) FLMPT=F8C08(FP,FT) F81C08=-1.0E+20 IF ((FCPPT.EQ.-1.0E+20).OR.(FMUPT.EQ.-1.0E+20) - .OR.(FLMPT.EQ.-1.0E+20)) RETURN F81C08=-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 F81C08=FPRPT RETURN END REAL FUNCTION F82C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) F82C08=-1.0E+20 CALL S91C08(FP,FT,ILL91) IF(ILL91.NE.0) RETURN F82C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) CALL S12C08(TR,RR,AKPT) F82C08=REAL(AKPT) RETURN END REAL FUNCTION F83C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) F83C08=-1.0E+20 CALL S91C08(FP,FT,ILL91) IF(ILL91.NE.0) RETURN F83C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) CALL S11C08(TR,RR,WPT) F83C08=REAL(WPT) RETURN END REAL FUNCTION F85C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) FCPPD=F16C08(FP) FMUPD=F11C08(FP) FLMPD=F6C08(FP) F85C08=-1.0E+20 IF ((FCPPD.EQ.-1.0E+20).OR.(FMUPD.EQ.-1.0E+20) - .OR.(FLMPD.EQ.-1.0E+20)) RETURN F85C08=-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 F85C08=FPRPD RETURN END REAL FUNCTION F87C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) FCPTD=F19C08(FT) FMUTD=F14C08(FT) FLMTD=F9C08(FT) F87C08=-1.0E+20 IF ((FCPTD.EQ.-1.0E+20).OR.(FMUTD.EQ.-1.0E+20) - .OR.(FLMTD.EQ.-1.0E+20)) RETURN F87C08=-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 F87C08=FPRTD RETURN END REAL FUNCTION F90C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=456.86D+00) F90C08=-1.0E+20 CALL S92C08(FP,FT,ILL92) IF (ILL92.NE.0) RETURN F90C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) IF (RR.LE.-1.0D+10) RETURN CALL S13C08(TR,RR,BSPT) F90C08=REAL(BSPT) RETURN END REAL FUNCTION F91C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=456.86D+00) F91C08=-1.0E+20 CALL S92C08(FP,FT,ILL92) IF (ILL92.NE.0) RETURN F91C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) IF (RR.LE.-1.0D+10) RETURN CALL S14C08(TR,RR,BTPT) F91C08=REAL(BTPT) RETURN END REAL FUNCTION F92C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=456.86D+00) F92C08=-1.0E+20 CALL S92C08(FP,FT,ILL92) IF (ILL92.NE.0) RETURN F92C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) IF (RR.LE.-1.0D+10) RETURN CALL S15C08(TR,RR,BPPT) F92C08=REAL(BPPT) RETURN END REAL FUNCTION F93C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=456.86D+00) F93C08=-1.0E+20 CALL S92C08(FP,FT,ILL92) IF (ILL92.NE.0) RETURN F93C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) IF (RR.LE.-1.0D+10) RETURN CALL S16C08(TR,RR,BVPT) F93C08=REAL(BVPT) RETURN END REAL FUNCTION F94C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=456.86D+00) F94C08=-1.0E+20 CALL S92C08(FP,FT,ILL92) IF (ILL92.NE.0) RETURN F94C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) IF (RR.LE.-1.0D+10) RETURN CALL S17C08(TR,RR,AJTPT) F94C08=REAL(AJTPT) RETURN END REAL FUNCTION F95C08(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06,TC=4.5686D+02) F95C08=-1.0E+20 CALL S91C08(FP,FT,ILL91) IF(ILL91.NE.0) RETURN F95C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC TR=(DBLE(FT)+273.15D0)/TC CALL S3C08(PR,TR,RR) CALL S10C08(TR,RR,CPPT) CALL S9C08(TR,RR,CVPT) GAMPT=CPPT/CVPT F95C08=REAL(GAMPT) RETURN END REAL FUNCTION F96C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(PC=3.666D+06) F96C08=-1.0E+20 IF((FP.LT.0.333).OR.(FP.GT.35.0)) RETURN F96C08=-1.0E+10 PR=DBLE(FP)*1.0D+05/PC CALL S2C08(2,1,PR,TSR) CALL S2C08(2,3,PR,RRDD) CALL S10C08(TSR,RRDD,CPPDD) CALL S9C08(TSR,RRDD,CVPDD) GAMPDD=CPPDD/CVPDD F96C08=REAL(GAMPDD) RETURN END REAL FUNCTION F97C08(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) PARAMETER(TC=4.5686D+02) F97C08=-1.0E+20 IF((FT.LT.-0.1).OR.(FT.GT.180.86)) RETURN F97C08=-1.0E+10 TR=(DBLE(FT)+273.15D0)/TC CALL S2C08(1,3,TR,RRDD) CALL S10C08(TR,RRDD,CPTDD) CALL S9C08(TR,RRDD,CVTDD) GAMTDD=CPTDD/CVTDD F97C08=REAL(GAMTDD) RETURN END REAL FUNCTION F98C08(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) ***** NOTE : PCRBAR IN BAR AND T IN K. PARAMETER(PCRBAR=36.666D0,TCR=456.86D0,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) F98C08=-1.0E+20 IF ((P.LT.PCRBAR).OR.(P.GT.71.2D0)) RETURN IF (ABS((P-PCRBAR)/PCRBAR).LT.-1.0D-05) THEN F98C08=REAL(TCR-T0K) RETURN END IF * T2=0.9D0*TCR P2=DBLE(F30C08(REAL(T2))) TM0=TCR+(TCR-T2)*(P-PCRBAR)/(PCRBAR-P2) DEL=TCR*0.01D0 * T(1)=TM0 C(1)=DBLE(F18C08(FP,REAL(T(1)-T0K))) T(2)=T(1)-DEL C(2)=DBLE(F18C08(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(F18C08(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(F18C08(FP,REAL(TT-T0K))) CONV=ABS((CC-C(2))/CC) IF (CONV.LT.EPS) THEN F98C08=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(F18C08(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(F18C08(FP,REAL(TA-T0K))) CB=DBLE(F18C08(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(F18C08(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(F18C08(FP,REAL(TL(2)-T0K))) CR(2)=DBLE(F18C08(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(F18C08(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(F18C08(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 F98C08=REAL(TC-T0K) RETURN * 9000 F98C08=-10.0E+10 RETURN END ***** SUBROUTINES FOR HCFC-123 *************************************** SUBROUTINE S1C08(K,TR,RR,FRK) ***** SUBROUTINE TO CALCULATE THE REDUCED HELMHOLTZ FUNCTIONS: ***** FR0,FR1,FR2,FR3,FR4,FR5 AND FR6, DEFINED AS ***** K=0 : FRK=FR FROM EQ.(IIIA2.3.2) ***** 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=54.36768584D0, - TC=456.86D0, PC=3.666D+06, RHOC=555.00D0) DIMENSION A(1:21),A0(1:4) DATA (A(J),J=1,10) /+1.725819324D+00,-4.738579604D+00, - +3.574614406D+00,-1.907301865D+00,-3.144299921D-02, - -1.133720336D-01,+1.420329563D+00,-2.077742728D+00, - +3.474083667D-01,+7.949899011D-03/ DATA (A(J),J=11,21)/-6.655434793D-02,+1.151345857D-02, - +1.652272737D+00,-7.201220838D-01,+9.459398235D-01, - +4.032353048D-01,+1.147546987D-01,-2.789866453D-02, - -1.267522348D-02,+3.102624210D-03,-1.766735773D-03/ DATA (A0(J),J=1,4)/-9.287D-01,+7.288D+00,+1.17388D+01,-2.7791D+00/ * ******CONSTANTS: B01 & B02, ZC, TR0, ALPHA B01=55.01466889D0 B02=93.50100124D0 ZC=PC/(GASCON*RHOC*TC) TR0=273.15D0/TC ALPHA=-0.75D0 * 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 AT1=A(1)*TR+A(2)+(A(3)+A(4)/TR)/TR AT2=A(5)*TR AT3=A(6)*TR+A(7)+A(8)/TR AT5=A(9)/(TR*TR) AT7=(A(10)+A(11)/TR)/TR AT8=A(12)/(TR*TR) ATX1=(A(13)+A(14)/TR)/(TR*TR) ATX2=(A(15)+A(16)/(TR*TR))/(TR*TR) ATX4=(A(17)+A(18)/(TR*TR))/(TR*TR) ATX5=A(19)/(TR*TR) ATX6=(A(20)+A(21)/TR)/(TR*TR) ELSE IF ((K.EQ.2).OR.(K.EQ.5)) THEN AT1=A(1)-(A(3)+2.0*A(4)/TR)/(TR*TR) AT2=A(5) AT3=A(6)-A(8)/(TR*TR) AT5=A(9)/(TR*TR*TR) AT7=(A(10)+2.0D0*A(11)/TR)/(TR*TR) AT8=A(12)/(TR*TR*TR) ATX1=(2.0D0*A(13)+3.0D0*A(14)/TR)/(TR*TR*TR) ATX2=(2.0D0*A(15)+4.0D0*A(16)/(TR*TR))/(TR*TR*TR) ATX4=(2.0D0*A(17)+4.0D0*A(18)/(TR*TR))/(TR*TR*TR) ATX5=(2.0D0*A(19)/(TR*TR*TR)) ATX6=(2.0D0*A(20)+3.0D0*A(21)/TR)/(TR*TR*TR) ELSE IF (K.EQ.4) THEN AT1=(2.0D0*A(3)+6.0D0*A(4)/TR)/(TR*TR*TR) AT3=(A(8)/(TR*TR*TR))*(2.0D0/3.0D0) AT5=(A(9)/(TR*TR*TR*TR))*(6.0D0/5.0D0) AT7=((2.0D0*A(10)+6.0D0*A(11)/TR)/(TR*TR*TR))/7.0D0 AT8=(A(12)/(TR*TR*TR*TR))*(3.0D0/4.0D0) ATX1=(6.0D0*A(13)+12.0D0*A(14)/TR)/(TR*TR*TR*TR) ATX2=(6.0D0*A(15)+20.0D0*A(16)/(TR*TR))/(TR*TR*TR*TR) ATX4=(6.0D0*A(17)+20.0D0*A(18)/(TR*TR))/(TR*TR*TR*TR) ATX5=(6.0D0*A(19)/(TR*TR*TR*TR)) ATX6=(6.0D0*A(20)+12.0D0*A(21)/TR)/(TR*TR*TR*TR) END IF * ARR2=2.0D0*ALPHA*RR*RR E=EXP(ALPHA*RR*RR) * IF ((K.EQ.0).OR.(K.EQ.2).OR.(K.EQ.4)) THEN X1=1.0D0 X2=RR**2 -1.0D0*X1/ALPHA X3=RR**4 -2.0D0*X2/ALPHA X4=RR**6 -3.0D0*X3/ALPHA X5=RR**8 -4.0D0*X4/ALPHA X6=RR**10-5.0D0*X5/ALPHA VEX1=E*X1 -1.0D0 VEX2=E*X2 +1.0D0/ALPHA VEX4=E*X4 +6.0D0/ALPHA**3 VEX5=E*X5 -24.0D0/ALPHA**4 VEX6=E*X6+120.0D0/ALPHA**5 END IF * IF (K.EQ.0) THEN FRK=((TR*LOG(RR))+(AT1+((AT2/2.0D0)+((AT3/3.0D0)+((AT5/5.0D0) - +((AT7/7.0D0)+(AT8/8.0D0)*RR)*RR*RR)*RR*RR)*RR)*RR)*RR - +(ATX1*VEX1+ATX2*VEX2+ATX4*VEX4+ATX5*VEX5+ATX6*VEX6) - /(2.0D0*ALPHA) - +A0(1)*(LOG(TR/TR0)+1.0D0-(TR/TR0)) - +(A0(2)-1.0D0)*(TR-TR0-TR*LOG(TR/TR0)) - -A0(3)*(TR-TR0)**2/2.0D0 - -A0(4)*((TR-TR0)**2)*(TR+2.0D0*TR0)/6.0D0)/ZC - +(B01-B02*TR) ELSE IF (K.EQ.1) THEN FRK=(TR/RR+AT1+(AT2+(AT3+(AT5+(AT7+AT8*RR)*RR*RR)*RR*RR)*RR)*RR - +(ATX1+(ATX2+(ATX4+(ATX5+ATX6*RR*RR)*RR*RR)*RR*RR*RR*RR) - *RR*RR)*RR*E)/ZC ELSE IF (K.EQ.2) THEN FRK=(LOG(RR) - +(AT1+((AT2/2.0D0)+((AT3/3.0D0)+(-(2.0D0*AT5/5.0D0) - +(-(AT7/7.0D0)-(AT8/4.0D0)*RR)*RR*RR)*RR*RR)*RR)*RR)*RR - -(ATX1*VEX1+ATX2*VEX2+ATX4*VEX4+ATX5*VEX5+ATX6*VEX6) - /(2.0D0*ALPHA) - +A0(1)*((1.0D0/TR)-(1.0D0/TR0)) - -(A0(2)-1.0D0)*LOG(TR/TR0) - -A0(3)*(TR-TR0) - -A0(4)*(TR**2-TR0**2)/2.0D0)/ZC - -B02 ELSE IF (K.EQ.3) THEN FRK=((-TR/(RR*RR))+AT2+(2.0D0*AT3+(4.0D0*AT5+(6.0D0*AT7 - +7.0D0*AT8*RR)*RR*RR)*RR*RR)*RR - +(ATX1*(1.0D0+ARR2)+(ATX2*(3.0D0+ARR2) - +(ATX4*(7.0D0+ARR2)+(ATX5*(9.0D0+ARR2)+ATX6 - *(11.0D0+ARR2)*RR*RR)*RR*RR)*RR*RR*RR*RR)*RR*RR)*E)/ZC ELSE IF (K.EQ.4) THEN FRK=((AT1+(AT3+(AT5+(AT7+AT8*RR)*RR*RR)*RR*RR)*RR*RR)*RR - +(ATX1*VEX1+ATX2*VEX2+ATX4*VEX4+ATX5*VEX5+ATX6*VEX6) - /(2.0D0*ALPHA) - -(A0(1)/TR**2+(A0(2)-1.0D0)/TR+A0(3)+A0(4)*TR))/ZC ELSE IF (K.EQ.5) THEN FRK=((1.0D0/RR)+AT1+(AT2+(AT3+(-2.0D0*AT5-(AT7+2.0D0*AT8*RR) - *RR*RR)*RR*RR)*RR)*RR - -(ATX1+(ATX2+(ATX4+(ATX5+ATX6*RR*RR)*RR*RR)*RR*RR*RR*RR) - *RR*RR)*RR*E)/ZC ELSE IF (K.EQ.6) THEN FRK=((TR/RR)+2.0D0*AT1+(3.0D0*AT2+(4.0D0*AT3+(6.0D0*AT5 - +(8.0D0*AT7+9.0D0*AT8*RR)*RR*RR)*RR*RR)*RR)*RR - +(ATX1*(3.0D0+ARR2)+(ATX2*(5.0D0+ARR2) - +(ATX4*(9.0D0+ARR2)+(ATX5*(11.0D0+ARR2)+ATX6 - *(13.0D0+ARR2)*RR*RR)*RR*RR)*RR*RR*RR*RR)*RR*RR)*RR*E)/ZC END IF * RETURN END SUBROUTINE S2C08(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. ***** 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=20: POUT=RRD BY CORRELATION EQUATION, EQ.(IIIA.2.4.1) ***** IPOUT=3 : POUT=RRDD IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(GASCON=54.36768584D0, - TC=456.86D0, PC=3.666D+06, RHOC=555.0D0) PARAMETER(EPSSAT=1.0D-12, ITMAX=10000) DATA B1/-7.5998D0/, B2/3.0970D0/, B3/-3.014D0/, B4/-0.864D0/ * POUT=-1.0D+20 IF (PIN.LE.0.0D0) RETURN * POUT=1.0D0 IF (ABS(PIN-1.0D0).LT.1.0D-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))*PC 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)/PC 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).OR.(IPOUT.EQ.20)) THEN TR1=ABS(1.0D0-TR) *** CORRELATION EQUATION EQ.(IIIA.2.4.1) RRD=1.0D0+2.350495D0*TR1**0.375D0-0.1595988D0*TR1**0.6D0 - +0.5461867D0*TR1**1.3D0 RR=RRD IF (IPOUT.EQ.20) THEN POUT=RRD RETURN END IF ELSE IF (IPOUT.EQ.3) THEN RRDD=ZC*(PR/TR) IF (TR.GT.0.999) THEN RRD=1.0D0+2.350495D0*TR1**0.375D0-0.1595988D0*TR1**0.6D0 - +0.5461867D0*TR1**1.3D0 RRDD=1.0D0/(2.0D0-1.0D0/RRD) END IF RR=RRDD END IF * *** NEWTON METHOD DO 120 IT=1,ITMAX CALL S1C08(1,TR,RR,FR1) CALL S1C08(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 S3C08(PR,TR,RR) ***** SUBROUTINE TO FIND THE DENSITY CORRESPONDING TO THE INPUT ***** PRESSURE AND TEMPERATURE BY SOLVING THE EQUATION OF STATE, ***** EQ.(IIIA.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=54.36768584D0, - TC=456.86D0, PC=3.666D+06, RHOC=555.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 *** SET AN APPROPRIATE VALUE OF RRW FOR HCFC-123 RRW=2.8D0 END IF ELSE IF ((PR.LT.1.0D0).AND.(TR.GT.1.0D0)) THEN RRW=ZC*PR/TR ELSE CALL S2C08(1,1,TR,PSR) CALL S2C08(1,20,TR,RRD) CALL S2C08(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 S1C08(1,TR,RRW,FR1) CALL S1C08(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 S4C08(PR,RR,TR) ***** SUBROUTINE TO FIND THE TEMPERATURE CORRESPONDING TO THE INPUT ***** PRESSURE AND DENSITY BY SOLVING THE EQUATION OF STATE, ***** EQ.(IIIA.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=54.36768584D0, - TC=456.86D0, PC=3.666D+06, RHOC=555.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 S3C08(PR,1.0D0,RRC) IF (RR.GE.RRC) THEN TRW=((270.0D0+TC)/TC)/2.0D0 ELSE TRW=500.0D0/TC END IF ELSE CALL S2C08(2,20,PR,RRD) CALL S2C08(2,3,PR,RRDD) IF (RR.GE.RRD) THEN CALL S2C08(2,1,PR,TSR) TRW=(TSR+(270.0D0/TC))/2.0D0 ELSE IF(RR.LE.RRDD) THEN TRW=500.0D0/TC END IF END IF *** NEWTON METHOD *** DO 1 IT=1,ITMAX CALL S1C08(1,TRW,RR,FR1) CALL S1C08(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 S5C08(TR,RR,PR) ***** SUBROUTINE TO CALCULATE THE PRESSURE CORRESPONDING TO THE INPUT ***** TEMPERATURE AND DENSITY FROM EQ.(IIIA.2.3.1) ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : PR = P/PC IMPLICIT DOUBLE PRECISION(A-H,O-Z) CALL S1C08(1,TR,RR,FR1) PR=(RR*RR)*FR1 RETURN END SUBROUTINE S6C08(TR,RR,SV) ***** SUBROUTINE TO CALCULATE THE ENTROPY ***** FOR SUPERHEATED AND SATURATED VAPOR ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : SV = ENTROPY IN (J/(KG*K)) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=456.86D0, PC=3.666D+06, RHOC=555.0D0) TRV=TR RRV=RR IF ((ABS(TRV-1.0D0).LE.1.0D-05) - .AND.(ABS(RRV-1.0).LE.1.0D-05)) THEN TRV=1.0D0 RRV=1.0D0 END IF CALL S1C08(2,TRV,RRV,FR2V) SV=(PC/(RHOC*TC))*(-FR2V) RETURN END SUBROUTINE S7C08(TR,RR,HV) ***** SUBROUTINE TO CALCULATE THE ENTHALPY ***** FOR SUPERHEATED AND SATURATED VAPOR ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : HV = ENTHALPY IN (J/KG) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=3.666D+06, RHOC=555.0D0) TRV=TR RRV=RR IF ((ABS(TRV-1.0D0).LE.1.0D-05) - .AND.(ABS(RRV-1.0).LE.1.0D-05)) THEN TRV=1.0D0 RRV=1.0D0 END IF CALL S1C08(0,TRV,RRV,FR0V) CALL S1C08(1,TRV,RRV,FR1V) CALL S1C08(2,TRV,RRV,FR2V) HV=(PC/RHOC)*(FR0V-TRV*FR2V+RRV*FR1V) RETURN END SUBROUTINE S8C08(TR,RR,UV) ***** SUBROUTINE TO CALCULATE THE INTERNAL ENERGY ***** FOR SUPERHEATED AND SATURATED VAPOR ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : UV = INTERNAL ENERGU IN (J/KG) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=3.666D+06, RHOC=555.0D0) TRV=TR RRV=RR IF ((ABS(TRV-1.0D0).LE.1.0D-05) - .AND.(ABS(RRV-1.0).LE.1.0D-05)) THEN TRV=1.0D0 RRV=1.0D0 END IF CALL S1C08(0,TRV,RRV,FR0V) CALL S1C08(2,TRV,RRV,FR2V) UV=(PC/RHOC)*(FR0V-TRV*FR2V) RETURN END SUBROUTINE S9C08(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=456.86D0, PC=3.666D+06, RHOC=555.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 S1C08(4,TRW,RRW,FR4) CV=(PC/(RHOC*TC))*TRW*(-FR4) RETURN END SUBROUTINE S10C08(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=456.86D0, PC=3.666D+06, RHOC=555.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 S1C08(4,TRW,RRW,FR4) CALL S1C08(5,TRW,RRW,FR5) CALL S1C08(6,TRW,RRW,FR6) CP=(PC/(RHOC*TC))*TRW*(-FR4+RRW*FR5**2/FR6) RETURN END SUBROUTINE S11C08(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=3.666D+06, RHOC=555.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 S9C08(TRW,RRW,CV) CALL S10C08(TRW,RRW,CP) CALL S1C08(6,TRW,RRW,FR6) W=SQRT((CP/CV)*(PC/RHOC)*RRW*FR6) RETURN END SUBROUTINE S12C08(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 S9C08(TRW,RRW,CV) CALL S10C08(TRW,RRW,CP) CALL S1C08(1,TRW,RRW,FR1) CALL S1C08(6,TRW,RRW,FR6) AK=(CP/CV)*(FR6/FR1) RETURN END SUBROUTINE S13C08(TR,RR,BS) ***** SUBROUTINE TO CALCULATE THE ADIABATIC COMPRESSIBILITY ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOCR ***** OUTPUT : BS = ADIABATIC COMPRESSIBILITY IN (1/PA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=3.666D+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 S9C08(TRW,RRW,CV) CALL S10C08(TRW,RRW,CP) CALL S1C08(6,TRW,RRW,FR6) BS=(CV/CP)/(PC*RR*RR*FR6) RETURN END SUBROUTINE S14C08(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=3.666D+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 S9C08(TRW,RRW,CV) CALL S10C08(TRW,RRW,CP) CALL S1C08(6,TRW,RRW,FR6) BT=1.0D0/(PC*RR*RR*FR6) RETURN END SUBROUTINE S15C08(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=456.86D0) 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 S1C08(5,TRW,RRW,FR5) CALL S1C08(6,TRW,RRW,FR6) BP=FR5/(TC*FR6) RETURN END SUBROUTINE S16C08(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=456.86D0) 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 S1C08(1,TRW,RRW,FR1) CALL S1C08(5,TRW,RRW,FR5) BV=FR5/(TC*FR1) RETURN END SUBROUTINE S17C08(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=456.86D0, RHOC=555.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 S10C08(TRW,RRW,CP) CALL S15C08(TRW,RRW,BP) AJT=(TC*TRW*BP-1.0D0)/(CP*RHOC*RRW) RETURN END SUBROUTINE S20C08(TR,RR,SL) ***** SUBROUTINE TO CALCULATE THE ENTROPY ***** FOR COMPRESSED AND SATURATED LIQUID ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : SL = ENTROPY IN (J/(KG*K)) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(TC=456.86D0, PC=3.666D+06, RHOC=555.0D0) DATA B1/-7.5998D0/, B2/3.0970D0/, B3/-3.014D0/, B4/-0.864D0/ TRL=TR RRL=RR IF ((ABS(TRL-1.0D0).LE.1.0D-05) - .AND.(ABS(RRL-1.0).LE.1.0D-05)) THEN TRL=1.0D0 RRL=1.0D0 END IF * CALL S2C08(1,1,TRL,PSR) CALL S2C08(1,20,TRL,RRD) CALL S2C08(1,3,TRL,RRDD) CALL S1C08(2,TRL,RRDD,FR2DD) TR1=ABS(1.0D0-TRL) DSRD=(PSR/TRL**2)*((1.0D0/RRDD)-(1.0D0/RRD)) - *(B1+B2*(1.0D0+0.5D0*TRL)*SQRT(TR1)+B3*(1.0D0-TRL**2) - +B4*(1.0D0+2.0D0*TRL)*TR1**2) SRD=-FR2DD+DSRD * CALL S1C08(2,TRL,RRL,FR2L) SRL=-FR2L * CALL S1C08(2,TRL,RRD,FR2D) SRLD=-FR2D * SL=(PC/(RHOC*TC))*(SRD+(SRL-SRLD)) RETURN END SUBROUTINE S21C08(TR,RR,HL) ***** SUBROUTINE TO CALCULATE THE ENTHALPY ***** FOR COMPRESSED AND SATURATED LIQUID ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : HL = ENTHALPY IN (J/KG) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=3.666D+06, RHOC=555.0D0) DATA B1/-7.5998D0/, B2/3.0970D0/, B3/-3.014D0/, B4/-0.864D0/ TRL=TR RRL=RR IF ((ABS(TRL-1.0D0).LE.1.0D-05) - .AND.(ABS(RRL-1.0).LE.1.0D-05)) THEN TRL=1.0D0 RRL=1.0D0 END IF * CALL S2C08(1,1,TRL,PSR) CALL S2C08(1,20,TRL,RRD) CALL S2C08(1,3,TRL,RRDD) CALL S1C08(0,TRL,RRDD,FR0DD) CALL S1C08(1,TRL,RRDD,FR1DD) CALL S1C08(2,TRL,RRDD,FR2DD) TR1=ABS(1.0D0-TRL) DHRD=(PSR/TRL)*((1.0D0/RRDD)-(1.0D0/RRD)) - *(B1+B2*(1.0D0+0.5D0*TRL)*SQRT(TR1)+B3*(1.0D0-TRL**2) - +B4*(1.0D0+2.0D0*TRL)*TR1**2) HRD=(FR0DD-TRL*FR2DD+RRDD*FR1DD)+DHRD * CALL S1C08(0,TRL,RRL,FR0L) CALL S1C08(1,TRL,RRL,FR1L) CALL S1C08(2,TRL,RRL,FR2L) HRL=(FR0L-TRL*FR2L+RRL*FR1L) * CALL S1C08(0,TRL,RRD,FR0D) CALL S1C08(1,TRL,RRD,FR1D) CALL S1C08(2,TRL,RRD,FR2D) HRLD=(FR0D-TRL*FR2D+RRD*FR1D) * HL=(PC/RHOC)*(HRD+(HRL-HRLD)) RETURN END SUBROUTINE S22C08(TR,RR,UL) ***** SUBROUTINE TO CALCULATE THE INTERNAL ENERGY ***** FOR COMPRESSED AND SATURATED LIQUID ***** INPUT1 : TR = T/TC ***** INPUT2 : RR = RHO/RHOC ***** OUTPUT : UL = INTERNAL ENERGY IN (J/KG) IMPLICIT DOUBLE PRECISION(A-H,O-Z) PARAMETER(PC=3.666D+06, RHOC=555.0D0) DATA B1/-7.5998D0/, B2/3.0970D0/, B3/-3.014D0/, B4/-0.864D0/ TRL=TR RRL=RR IF ((ABS(TRL-1.0D0).LE.1.0D-05) - .AND.(ABS(RRL-1.0).LE.1.0D-05)) THEN TRL=1.0D0 RRL=1.0D0 END IF * CALL S2C08(1,1,TRL,PSR) CALL S2C08(1,20,TRL,RRD) CALL S2C08(1,3,TRL,RRDD) CALL S1C08(0,TRL,RRDD,FR0DD) CALL S1C08(1,TRL,RRDD,FR1DD) CALL S1C08(2,TRL,RRDD,FR2DD) TR1=ABS(1.0D0-TRL) DHRD=(PSR/TRL)*((1.0D0/RRDD)-(1.0D0/RRD)) - *(B1+B2*(1.0D0+0.5D0*TRL)*SQRT(TR1)+B3*(1.0D0-TRL**2) - +B4*(1.0D0+2.0D0*TRL)*TR1**2) URD=((FR0DD-TRL*FR2DD+RRDD*FR1DD+DHRD)-PSR/RRD) * CALL S1C08(0,TRL,RRL,FR0L) CALL S1C08(2,TRL,RRL,FR2L) URL=(FR0L-TRL*FR2L) * CALL S1C08(0,TRL,RRD,FR0D) CALL S1C08(2,TRL,RRD,FR2D) URLD=(FR0D-TRL*FR2D) * UL=(PC/RHOC)*(URD+(URL-URLD)) RETURN END SUBROUTINE S40C08(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=269.15D0/456.86D0 IF (TH2.LE.TH2MIN) THEN TH2=TH2MIN*0.9999D0 END IF CALL S3C08(PR,TH2,RR2) IF (RR2.LE.-1.0D+10) GO TO 1000 IF(PR.GE.1.0D0) THEN IF(TH2.LT.1.0D0) THEN IF (IHS.EQ.1) THEN CALL S21C08(TH2,RR2,Z2) ELSE IF (IHS.EQ.2) THEN CALL S20C08(TH2,RR2,Z2) END IF ELSE IF (IHS.EQ.1) THEN CALL S7C08(TH2,RR2,Z2) ELSE IF (IHS.EQ.2) THEN CALL S6C08(TH2,RR2,Z2) END IF END IF ELSE CALL S2C08(2,1,PR,TSR) IF (TH2.LT.TSR) THEN IF (IHS.EQ.1) THEN CALL S21C08(TH2,RR2,Z2) ELSE IF (IHS.EQ.2) THEN CALL S20C08(TH2,RR2,Z2) END IF ELSE IF (IHS.EQ.1) THEN CALL S7C08(TH2,RR2,Z2) ELSE IF (IHS.EQ.2) THEN CALL S6C08(TH2,RR2,Z2) END IF END IF END IF 1 CONTINUE 1000 TH=-1.0D+10 RETURN END SUBROUTINE S90C08(FP,FT,ILL) ***** SUBROUTINE TO CHECK IF THE RANGE OF ARGUMENTS:(P,T) IS PROPER***** ***** FOR F25C08:HPT, F35C08:SPT, F44C08:UPT, F51C08:VPT, ****** IMPLICIT REAL(F) ILL=10000 IF ((FP.LT.0.19).OR.(FP.GT.100.1)) RETURN IF ((FT.LT.-0.1).OR.(FT.GT.226.86)) RETURN ILL=0 RETURN END SUBROUTINE S91C08(FP,FT,ILL) ***** SUBROUTINE TO CHECK IF THE RANGE OF ARGUMENTS:(P,T) IS PROPER***** ***** FOR F18C08:CPPT, F77C08:CVPT, F82C08:AKPT, F83C08:WPT, ****** IMPLICIT REAL(F) ILL=10000 IF ((FP.LE.0.0).OR.(FP.GT.100.1)) RETURN IF ((FT.LT.-0.1).OR.(FT.GT.226.86)) RETURN ILL=0 RETURN END SUBROUTINE S92C08(FP,FT,ILL) ***** SUBROUTINE TO CHECK IF THE RANGE OF ARGUMENTS:(P,T) IS PROPER***** ***** FOR F90C08:BSPT, F91C08:BTPT, F92C08:BPPT, F93C08:BVPT, ****** ***** F94C08:AJTPT. ****** IMPLICIT REAL(F) ILL=10000 IF ((FP.LE.0.0).OR.(FP.GT.100.1)) RETURN IF ((FT.LT.-0.1).OR.(FT.GT.226.86)) RETURN ILL=0 RETURN END SUBROUTINE S97C08(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 HCFC-123 ****' WRITE(6,1000) MSG 1000 FORMAT(1H ,5X,A) END IF RETURN END SUBROUTINE S98C08(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 HCFC-123', - ' WHEN ',A1,' =', 1PE14.7,' ****') 2020 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR HCFC-123', - ' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') RETURN END SUBROUTINE S99C08(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 HCFC-123 ****' 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