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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(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 S99KRY(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT FUNCTION AIPPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99KRY(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F2 = ALAPP FUNCTION ALAPP(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALAPP'/ CALL S99KRY(FUN) ALAPP=-1.0E+30 RETURN END C------------------------------------------------- F3 = ALAPT FUNCTION ALAPT(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALAPT'/ CALL S99KRY(FUN) ALAPT=-1.0E+30 RETURN END C------------------------------------------------- F4 = ALHP FUNCTION ALHP(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALHP'/ CALL S99KRY(FUN) ALHP=-1.0E+30 RETURN END C------------------------------------------------- F5 = ALHT FUNCTION ALHT(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALHT'/ CALL S99KRY(FUN) ALHT=-1.0E+30 RETURN END C------------------------------------------------- F6 = ALMPD FUNCTION ALMPD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALMPD'/ CALL S99KRY(FUN) ALMPD=-1.0E+30 RETURN END C------------------------------------------------- F7 = ALMPDD FUNCTION ALMPDD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALMPDD'/ CALL S99KRY(FUN) ALMPDD=-1.0E+30 RETURN END C------------------------------------------------- F8 = ALMPT FUNCTION ALMPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALMPT'/ CALL S99KRY(FUN) ALMPT=-1.0E+30 RETURN END C------------------------------------------------- F9 = ALMTD FUNCTION ALMTD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALMTD'/ CALL S99KRY(FUN) ALMTD=-1.0E+30 RETURN END C------------------------------------------------- F10 = ALMTDD FUNCTION ALMTDD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALMTDD'/ CALL S99KRY(FUN) ALMTDD=-1.0E+30 RETURN END C------------------------------------------------- F11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F11KRY,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUPD'/ C--- SET OF UNIT --- PI=G98KRY(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F11KRY(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUPD=FF RETURN END C------------------------------------------------- F12 = AMUPDD REAL FUNCTION AMUPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F12KRY,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUPDD'/ C--- SET OF UNIT --- PI=G98KRY(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F12KRY(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUPDD=FF RETURN END C------------------------------------------------- F13 = AMUPT FUNCTION AMUPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'AMUPT'/ CALL S99KRY(FUN) AMUPT=-1.0E+30 RETURN END C------------------------------------------------- F14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F14KRY,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUTD'/ C--- SET OF UNIT --- TI=G99KRY(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F14KRY(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUTD=FF RETURN END C------------------------------------------------- F15 = AMUTDD REAL FUNCTION AMUTDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F15KRY,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUTDD'/ C--- SET OF UNIT --- TI=G99KRY(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F15KRY(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUTDD=FF RETURN END C------------------------------------------------- F16 = CPPD FUNCTION CPPD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'CPPD'/ CALL S99KRY(FUN) CPPD=-1.0E+30 RETURN END C------------------------------------------------- F17 = CPPDD FUNCTION CPPDD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'CPPDD'/ CALL S99KRY(FUN) CPPDD=-1.0E+30 RETURN END C------------------------------------------------- F18 = CPPT FUNCTION CPPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'CPPT'/ CALL S99KRY(FUN) CPPT=-1.0E+30 RETURN END C------------------------------------------------- F19 = CPTD FUNCTION CPTD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'CPTD'/ CALL S99KRY(FUN) CPTD=-1.0E+30 RETURN END C------------------------------------------------- F20 = CPTDD FUNCTION CPTDD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'CPTDD'/ CALL S99KRY(FUN) CPTDD=-1.0E+30 RETURN END C------------------------------------------------- F21 = CRP REAL FUNCTION CRP(A) CHARACTER FUN*6,FLUID*8,A*1 REAL T0K,PBAR,FF INTEGER KPA DOUBLE PRECISION F21KRY COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'KRYPTON'/, FUN/'CRP'/ C--- SET OF UNIT --- 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 C--- FUNCTION CALL --- FF = F21KRY(A) C--- LEVEL 2 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN A =',A,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- 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 C------------------------------------------------- F22 = EPSPT FUNCTION EPSPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'EPSPT'/ CALL S99KRY(FUN) EPSPT=-1.0E+30 RETURN END C------------------------------------------------- F89 = FC C************************************************ C FUNCTION FOR FUNDDAMENTAL CONSTANTS C PROPATH VER.10.1, JULY 31, 1996 C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='83.80' WHEN A='M' C B='99.22' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=83.80 ELSE IF (A.EQ.'R') THEN FC=99.22 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR KRYPTON WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F23 = HPD FUNCTION HPD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'HPD'/ CALL S99KRY(FUN) HPD=-1.0E+30 RETURN END C------------------------------------------------- F24 = HPDD FUNCTION HPDD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'HPDD'/ CALL S99KRY(FUN) HPDD=-1.0E+30 RETURN END C------------------------------------------------- F25 = HPT FUNCTION HPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'HPT'/ CALL S99KRY(FUN) HPT=-1.0E+30 RETURN END C------------------------------------------------- F26 = HPX FUNCTION HPX(P,X) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'HPX'/ CALL S99KRY(FUN) HPX=-1.0E+30 RETURN END C------------------------------------------------- F27 = HTD FUNCTION HTD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'HTD'/ CALL S99KRY(FUN) HTD=-1.0E+30 RETURN END C------------------------------------------------- F28 = HTDD FUNCTION HTDD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'HTDD'/ CALL S99KRY(FUN) HTDD=-1.0E+30 RETURN END C------------------------------------------------- F29 = HTX FUNCTION HTX(T,X) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'HTDD'/ CALL S99KRY(FUN) HTX=-1.0E+30 RETURN END C------------------------------------------------- F84 = IDENTF C************************************************ C FUNCTION FOR IDENTIFICATION OF SUBSTANCE C PROPATH VER.12.1, MAY 2, 2001 C USAGE: B=IDENTF(A) C A, B : CHARACTER TYPE VALIABLES C B='KRYPTON' WHEN A='S' C B='KR' 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='KRYPTON' ELSE IF (A.EQ.'C') THEN IDENTF='KR' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR KRYPTON WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F30 = PST REAL FUNCTION PST(T) CHARACTER FUN*6 REAL PBAR,T0K,T,FF INTEGER KPA DOUBLE PRECISION F30KRY,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'PST'/ C--- SET OF UNIT --- 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 TI=T-T0K DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F30KRY(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 PST=FF/PBAR RETURN END C------------------------------------------------- F31 = SIGP FUNCTION SIGP(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'SIGP'/ CALL S99KRY(FUN) SIGP=-1.0E+30 RETURN END C------------------------------------------------- F32 = SIGT FUNCTION SIGT(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'SIGT'/ CALL S99KRY(FUN) SIGT=-1.0E+30 RETURN END C------------------------------------------------- F33 = SPD FUNCTION SPD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'SPD'/ CALL S99KRY(FUN) SPD=-1.0E+30 RETURN END C------------------------------------------------- F34 = SPDD FUNCTION SPDD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'SPDD'/ CALL S99KRY(FUN) SPDD=-1.0E+30 RETURN END C------------------------------------------------- F35 = SPT FUNCTION SPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'SPT'/ CALL S99KRY(FUN) SPT=-1.0E+30 RETURN END C------------------------------------------------- F36 = SPX FUNCTION SPX(P,X) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'SPX'/ CALL S99KRY(FUN) SPX=-1.0E+30 RETURN END C------------------------------------------------- F37 = STD FUNCTION STD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'STD'/ CALL S99KRY(FUN) STD=-1.0E+30 RETURN END C------------------------------------------------- F38 = STDD FUNCTION STDD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'STDD'/ CALL S99KRY(FUN) STDD=-1.0E+30 RETURN END C------------------------------------------------- F39 = STX FUNCTION STX(T,X) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'STX'/ CALL S99KRY(FUN) STX=-1.0E+30 RETURN END C------------------------------------------------- F40 = TSP REAL FUNCTION TSP(P) CHARACTER FUN*6 REAL PBAR,T0K,P,FF INTEGER KPA DOUBLE PRECISION F40KRY,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TSP'/ C--- SET OF UNIT --- 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 PI=P*PBAR DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F40KRY(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TSP=FF+T0K RETURN END C------------------------------------------------- F41 = TRPL REAL FUNCTION TRPL(A) CHARACTER FUN*6,FLUID*8,A*1 REAL T0K,PBAR,FF INTEGER KPA DOUBLE PRECISION F41KRY COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'KRYPTON'/, FUN/'TRPL'/ C--- SET OF UNIT --- 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 C--- FUNCTION CALL --- FF = F41KRY(A) C--- LEVEL 2 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN A =',A,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- 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 TRPL=FF RETURN END C------------------------------------------------- F42 = UPD FUNCTION UPD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'UPD'/ CALL S99KRY(FUN) UPD=-1.0E+30 RETURN END C------------------------------------------------- F43 = UPDD FUNCTION UPDD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'UPDD'/ CALL S99KRY(FUN) UPDD=-1.0E+30 RETURN END C------------------------------------------------- F44 = UPT FUNCTION UPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'UPT'/ CALL S99KRY(FUN) UPT=-1.0E+30 RETURN END C------------------------------------------------- F45 = UPX FUNCTION UPX(P,X) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'UPX'/ CALL S99KRY(FUN) UPX=-1.0E+30 RETURN END C------------------------------------------------- F46 = UTD FUNCTION UTD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'UTD'/ CALL S99KRY(FUN) UTD=-1.0E+30 RETURN END C------------------------------------------------- F47 = UTDD FUNCTION UTDD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'UTDD'/ CALL S99KRY(FUN) UTDD=-1.0E+30 RETURN END C------------------------------------------------- F48 = UTX FUNCTION UTX(T,X) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'UTX'/ CALL S99KRY(FUN) UTX=-1.0E+30 RETURN END C------------------------------------------------- F49 = VPD REAL FUNCTION VPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F49KRY,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPD'/ C--- SET OF UNIT --- PI=G98KRY(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F49KRY(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VPD=FF RETURN END C------------------------------------------------- F50 = VPDD REAL FUNCTION VPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F50KRY,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPDD'/ C--- SET OF UNIT --- PI=G98KRY(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F50KRY(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VPDD=FF RETURN END C------------------------------------------------- F51 = VPT FUNCTION VPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'VPT'/ CALL S99KRY(FUN) VPT=-1.0E+30 RETURN END C------------------------------------------------- F52 = VPX FUNCTION VPX(P,X) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'VPX'/ CALL S99KRY(FUN) VPX=-1.0E+30 RETURN END C------------------------------------------------- F53 = VTD REAL FUNCTION VTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F53KRY,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTD'/ C--- SET OF UNIT --- TI=G99KRY(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F53KRY(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VTD=FF RETURN END C------------------------------------------------- F54 = VTDD REAL FUNCTION VTDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F54KRY,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTDD'/ C--- SET OF UNIT --- TI=G99KRY(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F54KRY(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VTDD=FF RETURN END C------------------------------------------------- F55 = VTX FUNCTION VTX(T,X) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'VTX'/ CALL S99KRY(FUN) VTX=-1.0E+30 RETURN END C------------------------------------------------- F56 = XPH FUNCTION XPH(P,H) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'XPH'/ CALL S99KRY(FUN) XPH=-1.0E+30 RETURN END C------------------------------------------------- F57 = XPS FUNCTION XPS(P,S) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'XPS'/ CALL S99KRY(FUN) XPS=-1.0E+30 RETURN END C------------------------------------------------- F58 = XPU FUNCTION XPU(P,U) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'XPU'/ CALL S99KRY(FUN) XPU=-1.0E+30 RETURN END C------------------------------------------------- F59 = XPV FUNCTION XPV(P,V) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'XPV'/ CALL S99KRY(FUN) XPV=-1.0E+30 RETURN END C------------------------------------------------- F60 = XTH FUNCTION XTH(T,H) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'XTH'/ CALL S99KRY(FUN) XTH=-1.0E+30 RETURN END C------------------------------------------------- F61 = XTS FUNCTION XTS(T,S) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'XTS'/ CALL S99KRY(FUN) XTS=-1.0E+30 RETURN END C------------------------------------------------- F62 = XTU FUNCTION XTU(T,U) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'XTU'/ CALL S99KRY(FUN) XTU=-1.0E+30 RETURN END C------------------------------------------------- F63 = XTV FUNCTION XTV(T,V) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'XTV'/ CALL S99KRY(FUN) XTV=-1.0E+30 RETURN END C------------------------------------------------- F64 = TPH FUNCTION TPH(P,H) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'TPH'/ CALL S99KRY(FUN) TPH=-1.0E+30 RETURN END C------------------------------------------------- F65 = TPS FUNCTION TPS(P,S) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'TPS'/ CALL S99KRY(FUN) TPS=-1.0E+30 RETURN END C------------------------------------------------- F66 = PLDT FUNCTION PLDT(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PLDT'/ CALL S99KRY(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F67 = TLDP FUNCTION TLDP(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'TLDP'/ CALL S99KRY(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT REAL FUNCTION PMLT(T) CHARACTER FUN*6 REAL PBAR,T0K,T,FF INTEGER KPA DOUBLE PRECISION F68KRY,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'PMLT'/ C--- SET OF UNIT --- 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 TI=T-T0K DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F68KRY(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 PMLT=FF/PBAR RETURN END C------------------------------------------------- F69 = TMLP REAL FUNCTION TMLP(P) CHARACTER FUN*6 REAL PBAR,T0K,P,FF INTEGER KPA DOUBLE PRECISION F69KRY,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TMLP'/ C--- SET OF UNIT --- 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 PI=P*PBAR DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F69KRY(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97KRY(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98KRY(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TMLP=FF+T0K RETURN END C------------------------------------------------- F70 = TPV FUNCTION TPV(P,V) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'TPV'/ CALL S99KRY(FUN) TPV=-1.0E+30 RETURN END C------------------------------------------------- F71 = HPS FUNCTION HPS(P,S) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'HPS'/ CALL S99KRY(FUN) HPS=-1.0E+30 RETURN END C------------------------------------------------- F72 = PSTD FUNCTION PSTD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PSTD'/ CALL S99KRY(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD FUNCTION PSTDD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99KRY(FUN) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F74 = TSPD FUNCTION TSPD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'TSPD'/ CALL S99KRY(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD FUNCTION TSPDD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99KRY(FUN) TSPDD=-1.0E+30 RETURN END C------------------------------------------------- F76 = CVPDD FUNCTION CVPDD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'CVPDD'/ CALL S99KRY(FUN) CVPDD=-1.0E+30 RETURN END C------------------------------------------------- F77= CVPT FUNCTION CVPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'CVPT'/ CALL S99KRY(FUN) CVPT=-1.0E+30 RETURN END C------------------------------------------------- F78 = CVTDD FUNCTION CVTDD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'CVTDD'/ CALL S99KRY(FUN) CVTDD=-1.0E+30 RETURN END C------------------------------------------------- F79 = UPS FUNCTION UPS(P,S) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'UPS'/ CALL S99KRY(FUN) UPS=-1.0E+30 RETURN END C------------------------------------------------- F80 = VPS FUNCTION VPS(P,S) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'VPS'/ CALL S99KRY(FUN) VPS=-1.0E+30 RETURN END C------------------------------------------------- F81= PRPT FUNCTION PRPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PRPT'/ CALL S99KRY(FUN) PRPT=-1.0E+30 RETURN END C------------------------------------------------- F82= AKPT FUNCTION AKPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'AKPT'/ CALL S99KRY(FUN) AKPT=-1.0E+30 RETURN END C------------------------------------------------- F83= WPT FUNCTION WPT(P,T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'WPT'/ CALL S99KRY(FUN) WPT=-1.0E+30 RETURN END *------------------------------------------------- F85 = PRPD REAL FUNCTION PRPD(P) REAL P,PI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PRPD'/ PI=P CALL S99KRY(FUN) PRPD=-1.0E+30 RETURN END *------------------------------------------------- F86 = PRPDD REAL FUNCTION PRPDD(P) REAL P,PI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PRPDD'/ PI=P CALL S99KRY(FUN) PRPDD=-1.0E+30 RETURN END *------------------------------------------------- F87 = PRTD REAL FUNCTION PRTD(T) REAL T,TI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PRTD'/ TI=T CALL S99KRY(FUN) PRTD=-1.0E+30 RETURN END *------------------------------------------------- F88 = PRTDD REAL FUNCTION PRTDD(T) REAL T,TI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PRTDD'/ TI=T CALL S99KRY(FUN) PRTDD=-1.0E+30 RETURN END **------------------------------------------------ F90= BSPT REAL FUNCTION BSPT(P,T) REAL P,PI,T,TI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'BSPT'/ PI=P TI=T CALL S99KRY(FUN) BSPT=-1.0E+30 RETURN END **------------------------------------------------ F91= BTPT REAL FUNCTION BTPT(P,T) REAL P,PI,T,TI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'BTPT'/ PI=P TI=T CALL S99KRY(FUN) BTPT=-1.0E+30 RETURN END **------------------------------------------------ F92= BPPT REAL FUNCTION BPPT(P,T) REAL P,PI,T,TI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'BPPT'/ PI=P TI=T CALL S99KRY(FUN) BPPT=-1.0E+30 RETURN END **------------------------------------------------ F93= BVPT REAL FUNCTION BVPT(P,T) REAL P,PI,T,TI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'BVPT'/ PI=P TI=T CALL S99KRY(FUN) BVPT=-1.0E+30 RETURN END **------------------------------------------------ F94= AJTPT REAL FUNCTION AJTPT(P,T) REAL P,PI,T,TI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'AJTPT'/ PI=P TI=T CALL S99KRY(FUN) AJTPT=-1.0E+30 RETURN END **------------------------------------------------ F95= GAMPT REAL FUNCTION GAMPT(P,T) REAL P,PI,T,TI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'GAMPT'/ PI=P TI=T CALL S99KRY(FUN) GAMPT=-1.0E+30 RETURN END **------------------------------------------------ F96 = GAMPDD REAL FUNCTION GAMPDD(P) REAL P,PI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'GAMPDD'/ PI=P CALL S99KRY(FUN) GAMPDD=-1.0E+30 RETURN END **------------------------------------------------ F97 = GAMTDD REAL FUNCTION GAMTDD(T) REAL T,TI INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'GAMTDD'/ TI=T CALL S99KRY(FUN) GAMTDD=-1.0E+30 RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'TPSEUP'/ CALL S99KRY(FUN) TPSEUP=-1.0E+30 RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99KRY(FUN) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99KRY(FUN) TSBP=-1.0E+30 RETURN END C C******************************************************************** C* ********************************** * C* * A PROGRAM PACKAGE OF KRYPTON * * C* ********************************** * C* * C* ***************** ATTENTION ********************** * C* * T : TEMPERATURE, CELSIUS * * C* * H : SPECIFIC ENTHALPY, J/KG * * C* * P : PRESSURE, BAR * * C* * S : SPECIFIC ENTROPY, J/KG/K * * C* * U : SPECIFIC INTERNAL ENERGY, J/KG * * C* * V : SPECIFIC VOLUME, CU.M/KG * * C* ************************************************** * C* * C******************************************************************** C *** AMUPD(P) VISCOSITY OF S.L. DOUBLE PRECISION FUNCTION F11KRY(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA RO/3.210D00/,TB/567.50D00/,AN/6.0022D23/,AM/83.80D00/, * RE/3.94D-8/,PAI/3.14D00/, * A0/-7.4D00/,A1/3600.0D00/,A2/-1440.0D00/, * A3/251.0D00/,A4/58.0D00/, * PL/0.73189D00/,PC/54.961D00/ IF(P.LT.PL.OR.P.GT.PC) GO TO 900 ALO=F49KRY(P) IF(ALO.EQ.-1.0E+20) GO TO 900 T=F40KRY(P) IF(T.EQ.-1.0E+20) GO TO 900 T=T+273.15D00 R=1.0D00/(ALO*1.0D03) TV=T/1000.0D00 PB=(P-1.0D00)/1000.0D00 OM=R/RO SI=TB/T AI=1.03010D00-0.99175D00*(OM)+2.47127D00*(OM**2) * -3.11864D00*(OM**3)+1.57066D00*(OM**4) BI=0.48148D00-1.18732D00*(OM)+2.80277D00*(OM**2) * -5.41058D00*(OM**3)+7.04779D00*(OM**4)-3.76608D00*(OM**5) SIG=(AI+BI*DLOG10(SI))*RE BA=2.0D00*PAI*AN/AM*(SIG**3)/3.0D00 RMT=A0*(TV**0)+A1*(TV**1)+A2*(TV**2)+A3*(TV**3) * +A4*(TV**4) AMT=(266.93D00*((T*AM)**(0.5))*RMT/4.19D00) * /(1989.1D00*((T/AM)**(0.5))) BR=BA*R X=(1.0D00+0.27676D00*(BR)+0.014355D00*(BR**2) * +2.6480D00*(BR**3)-1.9643D00*(BR**4)+0.89161D00*(BR**5)) AMUT=AMT*X F11KRY=AMUT/1.0D08 RETURN 900 F11KRY=-1.0E+20 RETURN END C C *** AMUPDD(P) VISCOSITY OF S.V. DOUBLE PRECISION FUNCTION F12KRY(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA RO/3.210D00/,TB/567.50D00/,AN/6.0022D23/,AM/83.80D00/, * RE/3.94D-8/,PAI/3.14D00/, * A0/-7.4D00/,A1/3600.0D00/,A2/-1440.0D00/, * A3/251.0D00/,A4/58.0D00/, * PL/0.73189D00/,PC/54.961D00/ IF(P.LT.PL.OR.P.GT.PC) GO TO 900 ALO=F50KRY(P) IF(ALO.EQ.-1.0E+20) GO TO 900 T=F40KRY(P) IF(T.EQ.-1.0E+20) GO TO 900 T=T+273.15D00 R=1.0D00/(ALO*1.0D03) TV=T/1000.0D00 PB=(P-1.0D00)/1000.0D00 OM=R/RO SI=TB/T AI=1.03010D00-0.99175D00*(OM)+2.47127D00*(OM**2) * -3.11864D00*(OM**3)+1.57066D00*(OM**4) BI=0.48148D00-1.18732D00*(OM)+2.80277D00*(OM**2) * -5.41058D00*(OM**3)+7.04779D00*(OM**4)-3.76608D00*(OM**5) SIG=(AI+BI*DLOG10(SI))*RE BA=2.0D00*PAI*AN/AM*(SIG**3)/3.0D00 RMT=A0*(TV**0)+A1*(TV**1)+A2*(TV**2)+A3*(TV**3) * +A4*(TV**4) AMT=(266.93D00*((T*AM)**(0.5))*RMT/4.19D00) * /(1989.1D00*((T/AM)**(0.5))) BR=BA*R X=(1.0D00+0.27676D00*(BR)+0.014355D00*(BR**2) * +2.6480D00*(BR**3)-1.9643D00*(BR**4)+0.89161D00*(BR**5)) AMUT=AMT*X F12KRY=AMUT/1.0D08 RETURN 900 F12KRY=-1.0E+20 RETURN END C C *** AMUTD(T) VISCOSITY OF S.L. DOUBLE PRECISION FUNCTION F14KRY(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA RO/3.210D00/,TB/567.50D00/,AN/6.0022D23/,AM/83.80D00/, * RE/3.94D-8/,PAI/3.14D00/, * A0/-7.4D00/,A1/3600.0D00/,A2/-1440.0D00/, * A3/251.0D00/,A4/58.0D00/, * TL/115.759D00/,TC/209.391D00/ ALO=F53KRY(T) IF(ALO.EQ.-1.0E+20) GO TO 900 IF(T.LT.TL.OR.T.GT.TC) GO TO 900 T=T-273.15D00 P=F30KRY(T) IF(P.EQ.-1.0E+20) GO TO 900 R=1.0D00/(ALO*1.0D03) TV=T/1000.0D00 PB=(P-1.0D00)/1000.0D00 OM=R/RO SI=TB/T AI=1.03010D00-0.99175D00*(OM)+2.47127D00*(OM**2) * -3.11864D00*(OM**3)+1.57066D00*(OM**4) BI=0.48148D00-1.18732D00*(OM)+2.80277D00*(OM**2) * -5.41058D00*(OM**3)+7.04779D00*(OM**4)-3.76608D00*(OM**5) SIG=(AI+BI*DLOG10(SI))*RE BA=2.0D00*PAI*AN/AM*(SIG**3)/3.0D00 RMT=A0*(TV**0)+A1*(TV**1)+A2*(TV**2)+A3*(TV**3) * +A4*(TV**4) AMT=(266.93D00*((T*AM)**(0.5))*RMT/4.19D00) * /(1989.1D00*((T/AM)**(0.5))) BR=BA*R X=(1.0D00+0.27676D00*(BR)+0.014355D00*(BR**2) * +2.6480D00*(BR**3)-1.9643D00*(BR**4)+0.89161D00*(BR**5)) AMUT=AMT*X F14KRY=AMUT/1.0D08 RETURN 900 F14KRY=-1.0E+20 RETURN END C C *** AMUTDD(T) VISCOSITY OF S.V. DOUBLE PRECISION FUNCTION F15KRY(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA RO/3.210D00/,TB/567.50D00/,AN/6.0022D23/,AM/83.80D00/, * RE/3.94D-8/,PAI/3.14D00/, * A0/-7.4D00/,A1/3600.0D00/,A2/-1440.0D00/, * A3/251.0D00/,A4/58.0D00/, * TL/115.759D00/,TC/209.391D00/ ALO=F54KRY(T) IF(ALO.EQ.-1.0E+20) GO TO 900 IF(T.LT.TL.OR.T.GT.TC) GO TO 900 T=T-273.15D00 P=F30KRY(T) IF(P.EQ.-1.0E+20) GO TO 900 R=1.0D00/(ALO*1.0D03) TV=T/1000.0D00 PB=(P-1.0D00)/1000.0D00 OM=R/RO SI=TB/T AI=1.03010D00-0.99175D00*(OM)+2.47127D00*(OM**2) * -3.11864D00*(OM**3)+1.57066D00*(OM**4) BI=0.48148D00-1.18732D00*(OM)+2.80277D00*(OM**2) * -5.41058D00*(OM**3)+7.04779D00*(OM**4)-3.76608D00*(OM**5) SIG=(AI+BI*DLOG10(SI))*RE BA=2.0D00*PAI*AN/AM*(SIG**3)/3.0D00 RMT=A0*(TV**0)+A1*(TV**1)+A2*(TV**2)+A3*(TV**3) * +A4*(TV**4) AMT=(266.93D00*((T*AM)**(0.5))*RMT/4.19D00) * /(1989.1D00*((T/AM)**(0.5))) BR=BA*R X=(1.0D00+0.27676D00*(BR)+0.014355D00*(BR**2) * +2.6480D00*(BR**3)-1.9643D00*(BR**4)+0.89161D00*(BR**5)) AMUT=AMT*X F15KRY=AMUT/1.0D08 RETURN 900 F15KRY=-1.0E+20 RETURN END C C *** CRP(A) QUANTITIES AT THE CRITICAL POINT DOUBLE PRECISION FUNCTION F21KRY(A) CHARACTER*1 A,B(5) DATA B/'H','P','S','T','V'/ IF((A.EQ.B(1)).OR.(A.EQ.B(2)).OR.(A.EQ.B(3)).OR. & (A.EQ.B(4)).OR.(A.EQ.B(5))) GO TO 5 GO TO 900 5 IF(A.NE.B(1)) GO TO 10 F21KRY=133900.D00 RETURN 10 IF(A.NE.B(2)) GO TO 20 F21KRY=54.960D00 RETURN 20 IF(A.NE.B(3)) GO TO 30 F21KRY=1262.D00 RETURN 30 IF(A.NE.B(4)) GO TO 40 F21KRY=-63.760D00 RETURN 40 IF(A.NE.B(5)) GO TO 900 F21KRY=1.098D-03 RETURN 900 F21KRY=-1.0E+20 RETURN END C C *** PST(T) SATURATED PRESSURE DOUBLE PRECISION FUNCTION F30KRY(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A/20.41183D00/,B/-723.68513D00/,C/-7.539334D00/, * D/0.0109024D00/, * TL/115.759D00/,TC/209.391D00/ T=T+273.15D00 IF(T.LT.TL.OR.T.GT.TC) GO TO 900 ZZ=A+B*T**(-1)+C*DLOG10(T)+D*T PV=10.0D00**(ZZ) F30KRY=PV RETURN 900 F30KRY=-1.0E+20 RETURN END C C *** TSP(P) SATURATED TEMPERATURE DOUBLE PRECISION FUNCTION F40KRY(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A/20.41183D00/,B/-723.68513D00/,C/-7.539334D00/, * D/0.0109024D00/, * PL/0.73189D00/,PC/54.961D00/ TS(T)=(ALP*T-B-C*DLOG10(T)*T-D*T**2)/A IF(P.LT.PL.OR.P.GT.PC) GO TO 900 ALP=DLOG10(P) ERR=1.D-05 T0=0.1D00 IC=0 T1=TS(T0) 100 IC=IC+1 T2=TS(T1) T3=TS(T2) IF(DABS(T2-T3).LE.ERR) GO TO 200 T1=T2 T2=T3 IF(IC.GT.1000) GO TO 300 GO TO 100 200 F40KRY=T3-273.15D00 RETURN 300 F40KRY=-1.0E+10 RETURN 900 F40KRY=-1.0E+20 RETURN END C C *** TRPL(A) QUANTITIES AT THE TRIPLE POINT DOUBLE PRECISION FUNCTION F41KRY(A) CHARACTER*1 A,B(2) DATA B/'P','T'/ IF (A.EQ.B(1).OR.A.EQ.B(2)) GO TO 5 GO TO 900 5 IF(A.NE.B(1)) GO TO 10 F41KRY=0.73190D00 RETURN 10 IF(A.NE.B(2)) GO TO 900 F41KRY=-157.39D00 RETURN 900 F41KRY=-1.0E+20 RETURN END C C *** VPD(P) SPECIFIC VOLUME DOUBLE PRECISION FUNCTION F49KRY(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA PL/0.73189D00/,PC/54.961D00/,DLT/1.0D-05/ RB(R)=Q*(R**6)+A*(R**4)+Z*(R**2)-W RD(R)=6.0*Q*(R**5)+4.0*A*(R**3)+2.0*Z*R AA(T)=(-117.740D00+0.505612D00*T-0.000728729D00*(T**2)) ZZ(T)=(-247.537D00+1.425643D00*T+(81.64768D04/(T**2)) * -(34.78487D08/(T**4))) WW(P)=P IF(P.LT.PL.OR.P.GT.PC) GO TO 900 IF(DABS((P-54.96D00)/54.96D00).LT.DLT) GO TO 300 IF(P.LT.39.83D00) GO TO 2000 CALL S02KRY(P,VPT) P=P/1.0D05 F49KRY=VPT/1.0D03 RETURN 2000 T=F40KRY(P) IF(T.EQ.-1.0E+20) GO TO 900 T=T+273.15D00 Q=12.69602D00 A=AA(T) Z=ZZ(T) W=WW(P) ERR=1.D-05 R0=-A/Q 100 RF=RB(R0) RS=RD(R0) R1=R0-RF/RS E=DABS(R1-R0)/R0 IF(E.LE.ERR) GO TO 200 R0=R1 GO TO 100 200 F49KRY=1.0D-03/R1 RETURN 300 F49KRY=1.098D-03 RETURN 900 F49KRY=-1.0E+20 RETURN END C C *** VPDD(P) SPECIFIC VOLUME DOUBLE PRECISION FUNCTION F50KRY(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA TCR/209.39D00/,RI/0.09921599D00/, * PL/0.73189D00/,PC/54.961D00/,DLT/1.0D-05/ AA(T)=(0.377406D00*((T/TCR)**0)-0.148988D00*((T/TCR)**(-1)) * -0.341045D01*((T/TCR)**(-2))+0.352052D01*((T/TCR)**(-3)) * -0.197616D01*((T/TCR)**(-4))+0.384117D00*((T/TCR)**(-5))) BB(T)=(0.142595D00*((T/TCR)**0)-0.485821D00*((T/TCR)**(-1)) * -0.134716D01*((T/TCR)**(-2))+0.774659D01*((T/TCR)**(-3)) * -0.831482D01*((T/TCR)**(-4))+0.293861D01*((T/TCR)**(-5))) CC(T)=(0.358102D00*((T/TCR)**0)+0.363255D01*((T/TCR)**(-1)) * -0.670407D01*((T/TCR)**(-2))+0.709952D00*((T/TCR)**(-3)) * +0.315334D01*((T/TCR)**(-4))-0.226468D01*((T/TCR)**(-5))) DD(T)=(-0.142313D01*((T/TCR)**0)-0.253209D01*((T/TCR)**(-1)) * +0.596767D01*((T/TCR)**(-2))-0.393900D01*((T/TCR)**(-3)) * +0.452926D01*((T/TCR)**(-4))) EE(T)=(0.147064D01*((T/TCR)**0)+0.785829D00*((T/TCR)**(-1)) * +0.433364D00*((T/TCR)**(-2))-0.423227D01*((T/TCR)**(-3)) * -0.111457D01*((T/TCR)**(-4))) FF(T)=(-0.378146D00*((T/TCR)**0)-0.166798D01*((T/TCR)**(-1)) * +0.150981D01*((T/TCR)**(-2))+0.173903D01*((T/TCR)**(-3))) GG(T)=(0.957550D-02*((T/TCR)**0)+0.600554D00*((T/TCR)**(-1)) * -0.805498D00*((T/TCR)**(-2))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=((-G*(R**8)-F*(R**7)-E*(R**6)-D*(R**5)-C*(R**4) * -B*(R**3)-A*(R**2)+H)) IF(P.LT.PL.OR.P.GT.PC) GO TO 900 IF(DABS((P-54.96D00)/54.96D00).LT.DLT) GO TO 350 IF(P.LT.51.49001D00) GO TO 2000 CALL S04KRY(P,VPT) P=P/1.0D05 F50KRY=VPT/1.0D03 RETURN 2000 PA=P*1.0D5 T=F40KRY(P) IF(T.EQ.-1.0E+20) GO TO 900 T=T+273.15D00 A=AA(T) B=BB(T) C=CC(T) D=DD(T) E=EE(T) F=FF(T) G=GG(T) H=HH(PA,T) ERR=1.0D-05 R0=0.0D00 IC=0 R1=RB(R0) 100 IC=IC+1 R2=RB(R1) R3=RB(R2) IF(DABS(R2-R3).LE.ERR) GO TO 200 R1=R2 R2=R3 IF(IC.GT.1000) GO TO 300 GO TO 100 200 F50KRY=1.0D-03/R3 RETURN 300 F50KRY=-1.0E+10 RETURN 350 F50KRY=1.098D-03 RETURN 900 F50KRY=-1.0E+20 RETURN END C C *** VTD(T) SPECIFIC VOLUME DOUBLE PRECISION FUNCTION F53KRY(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA TL/115.759D00/,TC/209.391D00/,DLT/1.0D-05/ RB(R)=Q*(R**6)+A*(R**4)+Z*(R**2)-W RD(R)=6.0*Q*(R**5)+4.0*A*(R**3)+2.0*Z*R AA(T)=(-117.740D00+0.505612D00*T-0.000728729D00*(T**2)) ZZ(T)=(-247.537D00+1.425643D00*T+(81.64768D04/(T**2)) * -(34.78487D08/(T**4))) WW(P)=P P=F30KRY(T) IF(T.LT.TL.OR.T.GT.TC) GO TO 900 IF(DABS((T-209.39D00)/209.39D00).LT.DLT) GO TO 300 IF(T.LT.198.0D00) GO TO 2000 CALL S01KRY(T,VPT) F53KRY=VPT/1.0D03 RETURN 2000 IF(P.EQ.-1.0E+20) GO TO 900 Q=12.69602D00 A=AA(T) Z=ZZ(T) W=WW(P) ERR=1.D-05 R0=-A/Q 100 RF=RB(R0) RS=RD(R0) R1=R0-RF/RS E=DABS(R1-R0)/R0 IF(E.LE.ERR) GO TO 200 R0=R1 GO TO 100 200 F53KRY=1.0D-03/R1 RETURN 300 F53KRY=1.098D-03 RETURN 900 F53KRY=-1.0E+20 RETURN END C C *** VTDD(T) SPECIFIC VOLUME DOUBLE PRECISION FUNCTION F54KRY(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA TCR/209.39D00/,RI/0.09921599D00/, * TL/115.759D00/,TC/209.391D00/,DLT/1.0D-05/ AA(T)=(0.377406D00*((T/TCR)**0)-0.148988D00*((T/TCR)**(-1)) * -0.341045D01*((T/TCR)**(-2))+0.352052D01*((T/TCR)**(-3)) * -0.197616D01*((T/TCR)**(-4))+0.384117D00*((T/TCR)**(-5))) BB(T)=(0.142595D00*((T/TCR)**0)-0.485821D00*((T/TCR)**(-1)) * -0.134716D01*((T/TCR)**(-2))+0.774659D01*((T/TCR)**(-3)) * -0.831482D01*((T/TCR)**(-4))+0.293861D01*((T/TCR)**(-5))) CC(T)=(0.358102D00*((T/TCR)**0)+0.363255D01*((T/TCR)**(-1)) * -0.670407D01*((T/TCR)**(-2))+0.709952D00*((T/TCR)**(-3)) * +0.315334D01*((T/TCR)**(-4))-0.226468D01*((T/TCR)**(-5))) DD(T)=(-0.142313D01*((T/TCR)**0)-0.253209D01*((T/TCR)**(-1)) * +0.596767D01*((T/TCR)**(-2))-0.393900D01*((T/TCR)**(-3)) * +0.452926D01*((T/TCR)**(-4))) EE(T)=(0.147064D01*((T/TCR)**0)+0.785829D00*((T/TCR)**(-1)) * +0.433364D00*((T/TCR)**(-2))-0.423227D01*((T/TCR)**(-3)) * -0.111457D01*((T/TCR)**(-4))) FF(T)=(-0.378146D00*((T/TCR)**0)-0.166798D01*((T/TCR)**(-1)) * +0.150981D01*((T/TCR)**(-2))+0.173903D01*((T/TCR)**(-3))) GG(T)=(0.957550D-02*((T/TCR)**0)+0.600554D00*((T/TCR)**(-1)) * -0.805498D00*((T/TCR)**(-2))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=((-G*(R**8)-F*(R**7)-E*(R**6)-D*(R**5)-C*(R**4) * -B*(R**3)-A*(R**2)+H)) P=F30KRY(T) IF(T.LT.TL.OR.T.GT.TC) GO TO 900 IF(DABS((T-209.39D00)/209.39D00).LT.DLT) GO TO 350 IF(T.LT.208.0D00) GO TO 2000 CALL S03KRY(T,VPT) F54KRY=VPT/1.0D03 RETURN 2000 IF(P.EQ.-1.0E+20) GO TO 900 PA=P*1.0D05 A=AA(T) B=BB(T) C=CC(T) D=DD(T) E=EE(T) F=FF(T) G=GG(T) H=HH(PA,T) ERR=1.0D-05 R0=0.0D00 IC=0 R1=RB(R0) 100 IC=IC+1 R2=RB(R1) R3=RB(R2) IF(DABS(R2-R3).LE.ERR) GO TO 200 R1=R2 R2=R3 IF(IC.GT.1000) GO TO 300 GO TO 100 200 F54KRY=1.0D-03/R3 RETURN 300 F54KRY=-1.0E+10 RETURN 350 F54KRY=1.098D-03 RETURN 900 F54KRY=-1.0E+20 RETURN END C C *** PMLT(T) MELTING PRESSURE DOUBLE PRECISION FUNCTION F68KRY(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A/2376.07D00/,B/0.039332D00/,C/1.616984D00/, * TL/115.759D00/,TC/144.1D00/ T=T+273.15D00 IF(T.LT.TL.OR.T.GT.TC) GO TO 900 ZZ=C*DLOG10(T)+B PM=10.0D00**(ZZ)-A F68KRY=PM RETURN 900 F68KRY=-1.0E+20 RETURN END C C *** TMLP(P) MELTING TEMPERATURE DOUBLE PRECISION FUNCTION F69KRY(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A/2376.07D00/,B/0.039332D00/,C/1.616984D00/, * PL/0.73189D00/,PC/1007.1D00/ IF(P.LT.PL.OR.P.GT.PC) GO TO 900 ZZ=(DLOG10(P+A)-B)/C TM=10.0D00**(ZZ) F69KRY=TM-273.15D00 RETURN 900 F69KRY=-1.0E+20 RETURN END C C******************************************************************** C* ******************************** * C* * FUNCTION FOR SETTING UNITS * * C* ******************************** * C******************************************************************** C REAL FUNCTION G98KRY(KPA,P) REAL P,PBAR IF(KPA.EQ.1) THEN PBAR=1.0E0 ELSE IF(KPA.EQ.2) THEN PBAR=1.0E0 ELSE IF(KPA.EQ.3) THEN PBAR=1.0E-05 ELSE PBAR=1.0E-05 END IF G98KRY=P*PBAR RETURN END REAL FUNCTION G99KRY(KPA,T) REAL T,T0K IF(KPA.EQ.1) THEN T0K=0.0E0 ELSE IF(KPA.EQ.2) THEN T0K=273.15E0 ELSE IF(KPA.EQ.3) THEN T0K=0.0E0 ELSE T0K=273.15E0 END IF G99KRY=T-T0K RETURN END C C#################################################################### C******************************************************************** C* **************** * C* * SUBROUTINE * * C* **************** * C******************************************************************** C C *** ROLT *** SUBROUTINE S01KRY(T,VPT) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA TCR/209.39D00/,RI/0.09921599D00/ AA(T)=(0.377406D00*((T/TCR)**0)-0.148988D00*((T/TCR)**(-1)) * -0.341045D01*((T/TCR)**(-2))+0.352052D01*((T/TCR)**(-3)) * -0.197616D01*((T/TCR)**(-4))+0.384117D00*((T/TCR)**(-5))) BB(T)=(0.142595D00*((T/TCR)**0)-0.485821D00*((T/TCR)**(-1)) * -0.134716D01*((T/TCR)**(-2))+0.774659D01*((T/TCR)**(-3)) * -0.831482D01*((T/TCR)**(-4))+0.293861D01*((T/TCR)**(-5))) CC(T)=(0.358102D00*((T/TCR)**0)+0.363255D01*((T/TCR)**(-1)) * -0.670407D01*((T/TCR)**(-2))+0.709952D00*((T/TCR)**(-3)) * +0.315334D01*((T/TCR)**(-4))-0.226468D01*((T/TCR)**(-5))) DD(T)=(-0.142313D01*((T/TCR)**0)-0.253209D01*((T/TCR)**(-1)) * +0.596767D01*((T/TCR)**(-2))-0.393900D01*((T/TCR)**(-3)) * +0.452926D01*((T/TCR)**(-4))) EE(T)=(0.147064D01*((T/TCR)**0)+0.785829D00*((T/TCR)**(-1)) * +0.433364D00*((T/TCR)**(-2))-0.423227D01*((T/TCR)**(-3)) * -0.111457D01*((T/TCR)**(-4))) FF(T)=(-0.378146D00*((T/TCR)**0)-0.166798D01*((T/TCR)**(-1)) * +0.150981D01*((T/TCR)**(-2))+0.173903D01*((T/TCR)**(-3))) GG(T)=(0.957550D-02*((T/TCR)**0)+0.600554D00*((T/TCR)**(-1)) * -0.805498D00*((T/TCR)**(-2))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=G*(R**8)+F*(R**7)+E*(R**6)+D*(R**5)+C*(R**4) * +B*(R**3)+A*(R**2)+R-H T=T-273.15D00 P=F30KRY(T) P=P*1.0D05 A=AA(T) B=BB(T) C=CC(T) D=DD(T) E=EE(T) F=FF(T) G=GG(T) H=HH(P,T) IF(T.GE.209.0D00) GO TO 1100 IF(T.GE.208.0D00) GO TO 1000 R0=1.400D00 R1=1.550D00 GO TO 1200 1000 R0=1.090D00 R1=1.190D00 GO TO 1200 1100 R0=0.950D00 R1=1.090D00 1200 RX0=RB(R0) RX1=RB(R1) 100 R2=(R0*RX1-R1*RX0)/(RX1-RX0) RX2=RB(R2) IF(ABS(RX2).LT.1.0D-03) GO TO 200 IF(RX0*RX2) 10,20,20 10 RX1=RX2 R1=R2 GO TO 100 20 RX0=RX2 R0=R2 GO TO 100 200 VP=R2 VPT=1.0D00/VP RETURN END C *** ROLP *** SUBROUTINE S02KRY(P,VPT) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA TCR/209.39D00/,RI/0.09921599D00/ AA(T)=(0.377406D00*((T/TCR)**0)-0.148988D00*((T/TCR)**(-1)) * -0.341045D01*((T/TCR)**(-2))+0.352052D01*((T/TCR)**(-3)) * -0.197616D01*((T/TCR)**(-4))+0.384117D00*((T/TCR)**(-5))) BB(T)=(0.142595D00*((T/TCR)**0)-0.485821D00*((T/TCR)**(-1)) * -0.134716D01*((T/TCR)**(-2))+0.774659D01*((T/TCR)**(-3)) * -0.831482D01*((T/TCR)**(-4))+0.293861D01*((T/TCR)**(-5))) CC(T)=(0.358102D00*((T/TCR)**0)+0.363255D01*((T/TCR)**(-1)) * -0.670407D01*((T/TCR)**(-2))+0.709952D00*((T/TCR)**(-3)) * +0.315334D01*((T/TCR)**(-4))-0.226468D01*((T/TCR)**(-5))) DD(T)=(-0.142313D01*((T/TCR)**0)-0.253209D01*((T/TCR)**(-1)) * +0.596767D01*((T/TCR)**(-2))-0.393900D01*((T/TCR)**(-3)) * +0.452926D01*((T/TCR)**(-4))) EE(T)=(0.147064D01*((T/TCR)**0)+0.785829D00*((T/TCR)**(-1)) * +0.433364D00*((T/TCR)**(-2))-0.423227D01*((T/TCR)**(-3)) * -0.111457D01*((T/TCR)**(-4))) FF(T)=(-0.378146D00*((T/TCR)**0)-0.166798D01*((T/TCR)**(-1)) * +0.150981D01*((T/TCR)**(-2))+0.173903D01*((T/TCR)**(-3))) GG(T)=(0.957550D-02*((T/TCR)**0)+0.600554D00*((T/TCR)**(-1)) * -0.805498D00*((T/TCR)**(-2))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=G*(R**8)+F*(R**7)+E*(R**6)+D*(R**5)+C*(R**4) * +B*(R**3)+A*(R**2)+R-H T=F40KRY(P) T=T+273.15D00 P=P*1.0D05 A=AA(T) B=BB(T) C=CC(T) D=DD(T) E=EE(T) F=FF(T) G=GG(T) H=HH(P,T) IF(P.GE.54.38000D05) GO TO 1100 IF(P.GE.52.91999D05) GO TO 1000 R0=1.400D00 R1=1.550D00 GO TO 1200 1000 R0=1.090D00 R1=1.190D00 GO TO 1200 1100 R0=0.950D00 R1=1.090D00 1200 RX0=RB(R0) RX1=RB(R1) 100 R2=(R0*RX1-R1*RX0)/(RX1-RX0) RX2=RB(R2) IF(ABS(RX2).LT.1.0D-03) GO TO 200 IF(RX0*RX2) 10,20,20 10 RX1=RX2 R1=R2 GO TO 100 20 RX0=RX2 R0=R2 GO TO 100 200 VP=R2 VPT=1.0E00/VP RETURN END C *** ROVT *** SUBROUTINE S03KRY(T,VPT) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA TCR/209.39D00/,RI/0.09921599D00/ AA(T)=(0.377406D00*((T/TCR)**0)-0.148988D00*((T/TCR)**(-1)) * -0.341045D01*((T/TCR)**(-2))+0.352052D01*((T/TCR)**(-3)) * -0.197616D01*((T/TCR)**(-4))+0.384117D00*((T/TCR)**(-5))) BB(T)=(0.142595D00*((T/TCR)**0)-0.485821D00*((T/TCR)**(-1)) * -0.134716D01*((T/TCR)**(-2))+0.774659D01*((T/TCR)**(-3)) * -0.831482D01*((T/TCR)**(-4))+0.293861D01*((T/TCR)**(-5))) CC(T)=(0.358102D00*((T/TCR)**0)+0.363255D01*((T/TCR)**(-1)) * -0.670407D01*((T/TCR)**(-2))+0.709952D00*((T/TCR)**(-3)) * +0.315334D01*((T/TCR)**(-4))-0.226468D01*((T/TCR)**(-5))) DD(T)=(-0.142313D01*((T/TCR)**0)-0.253209D01*((T/TCR)**(-1)) * +0.596767D01*((T/TCR)**(-2))-0.393900D01*((T/TCR)**(-3)) * +0.452926D01*((T/TCR)**(-4))) EE(T)=(0.147064D01*((T/TCR)**0)+0.785829D00*((T/TCR)**(-1)) * +0.433364D00*((T/TCR)**(-2))-0.423227D01*((T/TCR)**(-3)) * -0.111457D01*((T/TCR)**(-4))) FF(T)=(-0.378146D00*((T/TCR)**0)-0.166798D01*((T/TCR)**(-1)) * +0.150981D01*((T/TCR)**(-2))+0.173903D01*((T/TCR)**(-3))) GG(T)=(0.957550D-02*((T/TCR)**0)+0.600554D00*((T/TCR)**(-1)) * -0.805498D00*((T/TCR)**(-2))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=G*(R**8)+F*(R**7)+E*(R**6)+D*(R**5)+C*(R**4) * +B*(R**3)+A*(R**2)+R-H T=T-273.15D00 P=F30KRY(T) P=P*1.0D05 A=AA(T) B=BB(T) C=CC(T) D=DD(T) E=EE(T) F=FF(T) G=GG(T) H=HH(P,T) IF(T.GE.209.0D00) GO TO 1000 R0=0.600D00 R1=0.770D00 GO TO 1100 1000 R0=0.699D00 R1=0.960D00 1100 RX0=RB(R0) RX1=RB(R1) 100 R2=(R0*RX1-R1*RX0)/(RX1-RX0) RX2=RB(R2) IF(ABS(RX2).LT.1.0D-03) GO TO 200 IF(RX0*RX2) 10,20,20 10 RX1=RX2 R1=R2 GO TO 100 20 RX0=RX2 R0=R2 GO TO 100 200 VP=R2 VPT=1.0D00/VP RETURN END C *** ROVP *** SUBROUTINE S04KRY(P,VPT) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA TCR/209.39D00/,RI/0.09921599D00/ AA(T)=(0.377406D00*((T/TCR)**0)-0.148988D00*((T/TCR)**(-1)) * -0.341045D01*((T/TCR)**(-2))+0.352052D01*((T/TCR)**(-3)) * -0.197616D01*((T/TCR)**(-4))+0.384117D00*((T/TCR)**(-5))) BB(T)=(0.142595D00*((T/TCR)**0)-0.485821D00*((T/TCR)**(-1)) * -0.134716D01*((T/TCR)**(-2))+0.774659D01*((T/TCR)**(-3)) * -0.831482D01*((T/TCR)**(-4))+0.293861D01*((T/TCR)**(-5))) CC(T)=(0.358102D00*((T/TCR)**0)+0.363255D01*((T/TCR)**(-1)) * -0.670407D01*((T/TCR)**(-2))+0.709952D00*((T/TCR)**(-3)) * +0.315334D01*((T/TCR)**(-4))-0.226468D01*((T/TCR)**(-5))) DD(T)=(-0.142313D01*((T/TCR)**0)-0.253209D01*((T/TCR)**(-1)) * +0.596767D01*((T/TCR)**(-2))-0.393900D01*((T/TCR)**(-3)) * +0.452926D01*((T/TCR)**(-4))) EE(T)=(0.147064D01*((T/TCR)**0)+0.785829D00*((T/TCR)**(-1)) * +0.433364D00*((T/TCR)**(-2))-0.423227D01*((T/TCR)**(-3)) * -0.111457D01*((T/TCR)**(-4))) FF(T)=(-0.378146D00*((T/TCR)**0)-0.166798D01*((T/TCR)**(-1)) * +0.150981D01*((T/TCR)**(-2))+0.173903D01*((T/TCR)**(-3))) GG(T)=(0.957550D-02*((T/TCR)**0)+0.600554D00*((T/TCR)**(-1)) * -0.805498D00*((T/TCR)**(-2))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=G*(R**8)+F*(R**7)+E*(R**6)+D*(R**5)+C*(R**4) * +B*(R**3)+A*(R**2)+R-H T=F40KRY(P) T=T+273.15D00 P=P*1.0D05 A=AA(T) B=BB(T) C=CC(T) D=DD(T) E=EE(T) F=FF(T) G=GG(T) H=HH(P,T) IF(P.GE.54.38D05) GO TO 1000 R0=0.600D00 R1=0.770D00 GO TO 1100 1000 R0=0.699D00 R1=0.960D00 1100 RX0=RB(R0) RX1=RB(R1) 100 R2=(R0*RX1-R1*RX0)/(RX1-RX0) RX2=RB(R2) IF(ABS(RX2).LT.1.0D-03) GO TO 200 IF(RX0*RX2) 10,20,20 10 RX1=RX2 R1=R2 GO TO 100 20 RX0=RX2 R0=R2 GO TO 100 200 VP=R2 VPT=1.0E00/VP RETURN END C C******************************************************************** C* ********************************** * C* * SUBROUTINE FOR ERROR MESSAGE * * C* ********************************** * C******************************************************************** C C *** LEVEL 1 ERROR MESSAGE *** SUBROUTINE S97KRY(FUN) COMMON/UNIT/KPA,MESS CHARACTER FUN*6,MSG*125 IF(MESS.NE.0) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR KRYPTON ****' WRITE(6,*) MSG END IF RETURN END C *** LEVEL 2 ERROR MESSAGE *** SUBROUTINE S98KRY(IPT,P,T,N1,N2,FUN) COMMON/UNIT/KPA,MESS CHARACTER FUN*6,N1*1,N2*1 IF(MESS.NE.0) THEN IF (IPT.EQ.1) THEN C --- FUN(P) TYPE WRITE(6,6010) FUN,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR KRYPTON', & ' WHEN P =',1PE14.7,' ****') C --- FUN(T) TYPE ELSE IF (IPT.EQ.2) THEN WRITE(6,6020) FUN,T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR KRYPTON', & ' WHEN T =',1PE14.7,' ****') C --- FUN(P,T) TYPE ELSE WRITE(6,6030) FUN,N1,P,N2,T 6030 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR KRYPTON', &' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') END IF END IF RETURN END C *** LEVEL 3 ERROR MESSAGE *** SUBROUTINE S99KRY(FUN) COMMON/UNIT/KPA,MESS CHARACTER FUN*6,MSG*125 IF(MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR KRYPTON ****' WRITE(6,100) MSG 100 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