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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(FUN) ALMTDD=-1.0E+30 RETURN END C------------------------------------------------- F11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F11XEN,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUPD'/ C--- SET OF UNIT --- PI=G98XEN(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F11XEN(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 F12XEN,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUPDD'/ C--- SET OF UNIT --- PI=G98XEN(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F12XEN(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 S99XEN(FUN) AMUPT=-1.0E+30 RETURN END C------------------------------------------------- F14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F14XEN,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUTD'/ C--- SET OF UNIT --- TI=G99XEN(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F14XEN(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 F15XEN,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUTDD'/ C--- SET OF UNIT --- TI=G99XEN(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F15XEN(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 F21XEN COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'XENON'/, 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 = F21XEN(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 S99XEN(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='131.3' WHEN A='M' C B='63.32' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=131.3 ELSE IF (A.EQ.'R') THEN FC=63.32 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR XENON 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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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/'HTX'/ CALL S99XEN(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='XENON' WHEN A='S' C B='XE' 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='XENON' ELSE IF (A.EQ.'C') THEN IDENTF='XE' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR XENON 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 F30XEN,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 = F30XEN(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 F40XEN,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 = F40XEN(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 F41XEN COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'XENON'/, 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 = F41XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(FUN) UTX=-1.0E+30 RETURN END C------------------------------------------------- F49 = VPD REAL FUNCTION VPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F49XEN,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPD'/ C--- SET OF UNIT --- PI=G98XEN(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F49XEN(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 F50XEN,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPDD'/ C--- SET OF UNIT --- PI=G98XEN(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F50XEN(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 S99XEN(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 S99XEN(FUN) VPX=-1.0E+30 RETURN END C------------------------------------------------- F53 = VTD REAL FUNCTION VTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F53XEN,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTD'/ C--- SET OF UNIT --- TI=G99XEN(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F53XEN(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 F54XEN,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTDD'/ C--- SET OF UNIT --- TI=G99XEN(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F54XEN(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 F68XEN,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 = F68XEN(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 F69XEN,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 = F69XEN(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97XEN(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(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 S99XEN(FUN) TSBP=-1.0E+30 RETURN END C C******************************************************************** C* ********************************** * C* * A PROGRAM PACKAGE OF XENON * * 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 F11XEN(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA RO/3.890D00/,TB/791.00D00/,AN/6.0022D23/,AM/131.3D00/, * RE/4.29D-8/,PAI/3.14D00/, * A0/1.8D00/,A1/1980.0D00/,A2/-370.0D00/, * A3/-192.0D00/,A4/119.0D00/, * PL/0.81599D00/,PC/58.211D00/ IF(P.LT.PL.OR.P.GT.PC) GO TO 900 ALO=F49XEN(P) IF(ALO.EQ.-1.0E+20) GO TO 900 T=F40XEN(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 F11XEN=AMUT/1.0D08 RETURN 900 F11XEN=-1.0E+20 RETURN END C C *** AMUPDD(P) VISCOSITY OF S.V. DOUBLE PRECISION FUNCTION F12XEN(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA RO/3.890D00/,TB/791.00D00/,AN/6.0022D23/,AM/131.3D00/, * RE/4.29D-8/,PAI/3.14D00/, * A0/1.8D00/,A1/1980.0D00/,A2/-370.0D00/, * A3/-192.0D00/,A4/119.0D00/, * PL/0.81599D00/,PC/58.211D00/ IF(P.LT.PL.OR.P.GT.PC) GO TO 900 ALO=F50XEN(P) IF(ALO.EQ.-1.0E+20) GO TO 900 T=F40XEN(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 F12XEN=AMUT/1.0D08 RETURN 900 F12XEN=-1.0E+20 RETURN END C C *** AMUTD(T) VISCOSITY OF S.L. DOUBLE PRECISION FUNCTION F14XEN(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA RO/3.890D00/,TB/791.00D00/,AN/6.0022D23/,AM/131.3D00/, * RE/4.29D-8/,PAI/3.14D00/, * A0/1.8D00/,A1/1980.0D00/,A2/-370.0D00/, * A3/-192.0D00/,A4/119.0D00/, * TL/161.359D00/,TC/289.741D00/ ALO=F53XEN(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=F30XEN(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 F14XEN=AMUT/1.0D08 RETURN 900 F14XEN=-1.0E+20 RETURN END C C *** AMUTDD(T) VISCOSITY OF S.V. DOUBLE PRECISION FUNCTION F15XEN(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA RO/3.890D00/,TB/791.00D00/,AN/6.0022D23/,AM/131.3D00/, * RE/4.29D-8/,PAI/3.14D00/, * A0/1.8D00/,A1/1980.0D00/,A2/-370.0D00/, * A3/-192.0D00/,A4/119.0D00/, * TL/161.359D00/,TC/289.741D00/ ALO=F54XEN(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=F30XEN(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 F15XEN=AMUT/1.0D08 RETURN 900 F15XEN=-1.0E+20 RETURN END C C *** CRP(A) QUANTITIES AT THE CRITICAL POINT DOUBLE PRECISION FUNCTION F21XEN(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 F21XEN=120000.D00 RETURN 10 IF(A.NE.B(2)) GO TO 20 F21XEN=58.210D00 RETURN 20 IF(A.NE.B(3)) GO TO 30 F21XEN=896.2D00 RETURN 30 IF(A.NE.B(4)) GO TO 40 F21XEN=16.590D00 RETURN 40 IF(A.NE.B(5)) GO TO 900 F21XEN=0.9091D-03 RETURN 900 F21XEN=-1.0E+20 RETURN END C C *** PST(T) SATURATED PRESSURE DOUBLE PRECISION FUNCTION F30XEN(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A/21.17109D00/,B/-1000.1252D00/,C/-7.381810D00/, * D/0.00766133D00/, * TL/161.359D00/,TC/289.741D00/ 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) F30XEN=PV RETURN 900 F30XEN=-1.0E+20 RETURN END C C *** TSP(P) SATURATED TEMPERATURE DOUBLE PRECISION FUNCTION F40XEN(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A/21.17109D00/,B/-1000.1252D00/,C/-7.381810D00/, * D/0.00766133D00/, * PL/0.81599D00/,PC/58.211D00/ 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 F40XEN=T3-273.15D00 RETURN 300 F40XEN=-1.0E+10 RETURN 900 F40XEN=-1.0E+20 RETURN END C C *** TRPL(A) QUANTITIES AT THE TRIPLE POINT DOUBLE PRECISION FUNCTION F41XEN(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 F41XEN=0.81600D00 RETURN 10 IF(A.NE.B(2)) GO TO 900 F41XEN=-111.79D00 RETURN 900 F41XEN=-1.0E+20 RETURN END C C *** VPD(P) SPECIFIC VOLUME DOUBLE PRECISION FUNCTION F49XEN(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA PL/0.81599D00/,PC/58.211D00/,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)=(-50.3818D00+0.152241D00*T-1.58574D-04*(T**2)) ZZ(T)=(-160.945D00+0.70725D00*T) WW(P)=P IF(P.LT.PL.OR.P.GT.PC) GO TO 900 IF(DABS((P-58.21D00)/58.21D00).LT.DLT) GO TO 300 IF(P.LT.34.62D00) GO TO 2000 CALL S02XEN(P,VPT) P=P/1.0D05 F49XEN=VPT/1.0D03 RETURN 2000 T=F40XEN(P) IF(T.EQ.-1.0E+20) GO TO 900 T=T+273.15D00 Q=4.0125D00 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 F49XEN=1.0D-03/R1 RETURN 300 F49XEN=0.9091D-03 RETURN 900 F49XEN=-1.0E+20 RETURN END C C *** VPDD(P) SPECIFIC VOLUME DOUBLE PRECISION FUNCTION F50XEN(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA TCR/289.74D00/,RI/0.0633229246D00/, * PL/0.81599D00/,PC/58.211D00/,DLT/1.0D-05/ AA(T)=(0.311432D00*((T/TCR)**0)-0.124048D00*((T/TCR)**(-1)) * -0.286506D01*((T/TCR)**(-2))+0.298409D01*((T/TCR)**(-3)) * -0.169010D01*((T/TCR)**(-4))+0.331464D00*((T/TCR)**(-5))) BB(T)=(0.499096D-01*((T/TCR)**0)+0.660246D-01*((T/TCR)**(-1)) * -0.863325D00*((T/TCR)**(-2))+0.354419D01*((T/TCR)**(-3)) * -0.358471D01*((T/TCR)**(-4))+0.119122D01*((T/TCR)**(-5))) CC(T)=(0.216360D00*((T/TCR)**0)+0.438290D00*((T/TCR)**(-1)) * -0.975566D00*((T/TCR)**(-2))+0.766205D-01*((T/TCR)**(-3)) * +0.126497D-01*((T/TCR)**(-4))-0.386903D-01*((T/TCR)**(-5))) DD(T)=(-0.433867D00*((T/TCR)**0)+0.123217D00*((T/TCR)**(-1)) * -0.519648D00*((T/TCR)**(-2))+0.141667D01*((T/TCR)**(-3)) * +0.944493D-02*((T/TCR)**(-4))) EE(T)=(0.363104D00*((T/TCR)**0)-0.281127D-01*((T/TCR)**(-1)) * -0.195138D00*((T/TCR)**(-2))-0.653019D00*((T/TCR)**(-3))) FF(T)=(-0.120343D00*((T/TCR)**0)+0.171534D00*((T/TCR)**(-1)) * +0.114723D00*((T/TCR)**(-2))) GG(T)=(-0.385342D-01*((T/TCR)**0)-0.521881D-01*((T/TCR)**(-1)) * +0.831912D-01*((T/TCR)**(-2))) OO(T)=(0.275163D-01*((T/TCR)**0)-0.305918D-01*((T/TCR)**(-1))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=((-O*(R**9)-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-58.21D00)/58.21D00).LT.DLT) GO TO 350 IF(P.LT.55.15D00) GO TO 2000 CALL S04XEN(P,VPT) P=P/1.0D05 F50XEN=VPT/1.0D03 RETURN 2000 PA=P*1.0D5 T=F40XEN(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) O=OO(T) H=HH(PA,T) ERR=1.D-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 F50XEN=1.0D-03/R3 RETURN 300 F50XEN=-1.0E+10 RETURN 350 F50XEN=0.9091D-03 RETURN 900 F50XEN=-1.0E+20 RETURN END C C *** VTD(T) SPECIFIC VOLUME DOUBLE PRECISION FUNCTION F53XEN(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA TL/161.359D00/,TC/289.741D00/,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)=(-50.3818D00+0.152241D00*T-1.58574D-04*(T**2)) ZZ(T)=(-160.945D00+0.70725D00*T) WW(P)=P IF(DABS((P-58.21D00)/58.21D00).LT.DLT) GO TO 300 P=F30XEN(T) IF(T.LT.TL.OR.T.GT.TC) GO TO 900 IF(DABS((T-289.74D00)/289.74D00).LT.DLT) GO TO 300 IF(T.LT.265.0D00) GO TO 2000 CALL S01XEN(T,VPT) F53XEN=VPT/1.0D03 RETURN 2000 IF(P.EQ.-1.0E+20) GO TO 900 Q=4.0125D00 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 F53XEN=1.0D-03/R1 RETURN 300 F53XEN=0.9091D-03 RETURN 900 F53XEN=-1.0E+20 RETURN END C C *** VTDD(T) SPECIFIC VOLUME DOUBLE PRECISION FUNCTION F54XEN(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA TCR/289.74D00/,RI/0.0633229246D00/, * TL/161.359D00/,TC/289.741D00/,DLT/1.0D-05/ AA(T)=(0.311432D00*((T/TCR)**0)-0.124048D00*((T/TCR)**(-1)) * -0.286506D01*((T/TCR)**(-2))+0.298409D01*((T/TCR)**(-3)) * -0.169010D01*((T/TCR)**(-4))+0.331464D00*((T/TCR)**(-5))) BB(T)=(0.499096D-01*((T/TCR)**0)+0.660246D-01*((T/TCR)**(-1)) * -0.863325D00*((T/TCR)**(-2))+0.354419D01*((T/TCR)**(-3)) * -0.358471D01*((T/TCR)**(-4))+0.119122D01*((T/TCR)**(-5))) CC(T)=(0.216360D00*((T/TCR)**0)+0.438290D00*((T/TCR)**(-1)) * -0.975566D00*((T/TCR)**(-2))+0.766205D-01*((T/TCR)**(-3)) * +0.126497D-01*((T/TCR)**(-4))-0.386903D-01*((T/TCR)**(-5))) DD(T)=(-0.433867D00*((T/TCR)**0)+0.123217D00*((T/TCR)**(-1)) * -0.519648D00*((T/TCR)**(-2))+0.141667D01*((T/TCR)**(-3)) * +0.944493D-02*((T/TCR)**(-4))) EE(T)=(0.363104D00*((T/TCR)**0)-0.281127D-01*((T/TCR)**(-1)) * -0.195138D00*((T/TCR)**(-2))-0.653019D00*((T/TCR)**(-3))) FF(T)=(-0.120343D00*((T/TCR)**0)+0.171534D00*((T/TCR)**(-1)) * +0.114723D00*((T/TCR)**(-2))) GG(T)=(-0.385342D-01*((T/TCR)**0)-0.521881D-01*((T/TCR)**(-1)) * +0.831912D-01*((T/TCR)**(-2))) OO(T)=(0.275163D-01*((T/TCR)**0)-0.305918D-01*((T/TCR)**(-1))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=((-O*(R**9)-G*(R**8)-F*(R**7)-E*(R**6)-D*(R**5) * -C*(R**4)-B*(R**3)-A*(R**2)+H)) P=F30XEN(T) IF(T.LT.TL.OR.T.GT.TC) GO TO 900 IF(DABS((T-289.74D00)/289.74D00).LT.DLT) GO TO 350 IF(T.LT.287.0D00) GO TO 2000 CALL S03XEN(T,VPT) F54XEN=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) O=OO(T) H=HH(PA,T) ERR=1.D-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 F54XEN=1.0D-03/R3 RETURN 300 F54XEN=-1.0E+10 RETURN 350 F54XEN=0.9091D-03 RETURN 900 F54XEN=-1.0E+20 RETURN END C C *** PMLT(T) MELTING PRESSURE DOUBLE PRECISION FUNCTION F68XEN(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A/-2610.13D00/,B/0.808906D00/,C/1.589165D00/, * D/1.839D00/,E/-0.2706D00/,F/1.38D00/, * TL/161.349D00/,TC/198.1D00/,TTR/161.36D00/ T=T+273.15D00 IF(T.LT.TL.OR.T.GT.TC) GO TO 900 PM=A+B*(T**C)+D/(DEXP(-E*DABS(T-TTR)**F)) F68XEN=PM RETURN 900 F68XEN=-1.0E+20 RETURN END C C *** TMLP(P) MELTING TEMPERATURE DOUBLE PRECISION FUNCTION F69XEN(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A/-2610.13D00/,B/0.808906D00/,C/1.589165D00/, * D/1.839D00/,E/-0.2706D00/,F/1.38D00/, * PL/0.81599D00/,PC/1001.1D00/,TTR/161.36D00/ TM(T)=((P-A-D/(DEXP(-E*DABS(T-TTR)**F)))/B)**(1.0/C) IF(P.LT.PL.OR.P.GT.PC) GO TO 900 ERR=1.D-05 T0=0.0D00 IC=0 T1=TM(T0) 100 IC=IC+1 T2=TM(T1) T3=TM(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 F69XEN=T3-273.15D00 RETURN 300 F69XEN=-1.0E+10 RETURN 900 F69XEN=-1.0E+20 RETURN END C C******************************************************************** C* ******************************** * C* * FUNCTION FOR SETTING UNITS * * C* ******************************** * C******************************************************************** C REAL FUNCTION G98XEN(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 G98XEN=P*PBAR RETURN END REAL FUNCTION G99XEN(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 G99XEN=T-T0K RETURN END C C#################################################################### C******************************************************************** C* **************** * C* * SUBROUTINE * * C* **************** * C******************************************************************** C C *** ROLT *** SUBROUTINE S01XEN(T,VPT) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA TCR/289.74D00/,RI/0.0633229246D00/ AA(T)=(0.311432D00*((T/TCR)**0)-0.124048D00*((T/TCR)**(-1)) * -0.286506D01*((T/TCR)**(-2))+0.298409D01*((T/TCR)**(-3)) * -0.169010D01*((T/TCR)**(-4))+0.331464D00*((T/TCR)**(-5))) BB(T)=(0.499096D-01*((T/TCR)**0)+0.660246D-01*((T/TCR)**(-1)) * -0.863325D00*((T/TCR)**(-2))+0.354419D01*((T/TCR)**(-3)) * -0.358471D01*((T/TCR)**(-4))+0.119122D01*((T/TCR)**(-5))) CC(T)=(0.216360D00*((T/TCR)**0)+0.438290D00*((T/TCR)**(-1)) * -0.975566D00*((T/TCR)**(-2))+0.766205D-01*((T/TCR)**(-3)) * +0.126497D-01*((T/TCR)**(-4))-0.386903D-01*((T/TCR)**(-5))) DD(T)=(-0.433867D00*((T/TCR)**0)+0.123217D00*((T/TCR)**(-1)) * -0.519648D00*((T/TCR)**(-2))+0.141667D01*((T/TCR)**(-3)) * +0.944493D-02*((T/TCR)**(-4))) EE(T)=(0.363104D00*((T/TCR)**0)-0.281127D-01*((T/TCR)**(-1)) * -0.195138D00*((T/TCR)**(-2))-0.653019D00*((T/TCR)**(-3))) FF(T)=(-0.120343D00*((T/TCR)**0)+0.171534D00*((T/TCR)**(-1)) * +0.114723D00*((T/TCR)**(-2))) GG(T)=(-0.385342D-01*((T/TCR)**0)-0.521881D-01*((T/TCR)**(-1)) * +0.831912D-01*((T/TCR)**(-2))) OO(T)=(0.275163D-01*((T/TCR)**0)-0.305918D-01*((T/TCR)**(-1))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=O*(R**9)+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=F30XEN(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) O=OO(T) H=HH(P,T) IF(T.GE.289.0D00) GO TO 1000 R0=1.440D00 R1=2.048D00 GO TO 1100 1000 R0=0.782D00 R1=1.180D00 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 *** ROLP *** SUBROUTINE S02XEN(P,VPT) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA TCR/289.74D00/,RI/0.0633229246D00/ AA(T)=(0.311432D00*((T/TCR)**0)-0.124048D00*((T/TCR)**(-1)) * -0.286506D01*((T/TCR)**(-2))+0.298409D01*((T/TCR)**(-3)) * -0.169010D01*((T/TCR)**(-4))+0.331464D00*((T/TCR)**(-5))) BB(T)=(0.499096D-01*((T/TCR)**0)+0.660246D-01*((T/TCR)**(-1)) * -0.863325D00*((T/TCR)**(-2))+0.354419D01*((T/TCR)**(-3)) * -0.358471D01*((T/TCR)**(-4))+0.119122D01*((T/TCR)**(-5))) CC(T)=(0.216360D00*((T/TCR)**0)+0.438290D00*((T/TCR)**(-1)) * -0.975566D00*((T/TCR)**(-2))+0.766205D-01*((T/TCR)**(-3)) * +0.126497D-01*((T/TCR)**(-4))-0.386903D-01*((T/TCR)**(-5))) DD(T)=(-0.433867D00*((T/TCR)**0)+0.123217D00*((T/TCR)**(-1)) * -0.519648D00*((T/TCR)**(-2))+0.141667D01*((T/TCR)**(-3)) * +0.944493D-02*((T/TCR)**(-4))) EE(T)=(0.363104D00*((T/TCR)**0)-0.281127D-01*((T/TCR)**(-1)) * -0.195138D00*((T/TCR)**(-2))-0.653019D00*((T/TCR)**(-3))) FF(T)=(-0.120343D00*((T/TCR)**0)+0.171534D00*((T/TCR)**(-1)) * +0.114723D00*((T/TCR)**(-2))) GG(T)=(-0.385342D-01*((T/TCR)**0)-0.521881D-01*((T/TCR)**(-1)) * +0.831912D-01*((T/TCR)**(-2))) OO(T)=(0.275163D-01*((T/TCR)**0)-0.305918D-01*((T/TCR)**(-1))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=O*(R**9)+G*(R**8)+F*(R**7)+E*(R**6)+D*(R**5) * +C*(R**4)+B*(R**3)+A*(R**2)+R-H T=F40XEN(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) O=OO(T) H=HH(P,T) IF(T.GE.289.0D00) GO TO 1000 R0=1.440D00 R1=2.048D00 GO TO 1100 1000 R0=0.782D00 R1=1.180D00 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 *** ROVT *** SUBROUTINE S03XEN(T,VPT) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA TCR/289.74D00/,RI/0.0633229246D00/ AA(T)=(0.311432D00*((T/TCR)**0)-0.124048D00*((T/TCR)**(-1)) * -0.286506D01*((T/TCR)**(-2))+0.298409D01*((T/TCR)**(-3)) * -0.169010D01*((T/TCR)**(-4))+0.331464D00*((T/TCR)**(-5))) BB(T)=(0.499096D-01*((T/TCR)**0)+0.660246D-01*((T/TCR)**(-1)) * -0.863325D00*((T/TCR)**(-2))+0.354419D01*((T/TCR)**(-3)) * -0.358471D01*((T/TCR)**(-4))+0.119122D01*((T/TCR)**(-5))) CC(T)=(0.216360D00*((T/TCR)**0)+0.438290D00*((T/TCR)**(-1)) * -0.975566D00*((T/TCR)**(-2))+0.766205D-01*((T/TCR)**(-3)) * +0.126497D-01*((T/TCR)**(-4))-0.386903D-01*((T/TCR)**(-5))) DD(T)=(-0.433867D00*((T/TCR)**0)+0.123217D00*((T/TCR)**(-1)) * -0.519648D00*((T/TCR)**(-2))+0.141667D01*((T/TCR)**(-3)) * +0.944493D-02*((T/TCR)**(-4))) EE(T)=(0.363104D00*((T/TCR)**0)-0.281127D-01*((T/TCR)**(-1)) * -0.195138D00*((T/TCR)**(-2))-0.653019D00*((T/TCR)**(-3))) FF(T)=(-0.120343D00*((T/TCR)**0)+0.171534D00*((T/TCR)**(-1)) * +0.114723D00*((T/TCR)**(-2))) GG(T)=(-0.385342D-01*((T/TCR)**0)-0.521881D-01*((T/TCR)**(-1)) * +0.831912D-01*((T/TCR)**(-2))) OO(T)=(0.275163D-01*((T/TCR)**0)-0.305918D-01*((T/TCR)**(-1))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=O*(R**9)+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=F30XEN(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) O=OO(T) H=HH(P,T) IF(T.GE.288.1D00) GO TO 1000 R0=0.550D00 R1=0.770D00 GO TO 1100 1000 R0=0.772D00 R1=1.1946D00 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 S04XEN(P,VPT) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA TCR/289.74D00/,RI/0.0633229246D00/ AA(T)=(0.311432D00*((T/TCR)**0)-0.124048D00*((T/TCR)**(-1)) * -0.286506D01*((T/TCR)**(-2))+0.298409D01*((T/TCR)**(-3)) * -0.169010D01*((T/TCR)**(-4))+0.331464D00*((T/TCR)**(-5))) BB(T)=(0.499096D-01*((T/TCR)**0)+0.660246D-01*((T/TCR)**(-1)) * -0.863325D00*((T/TCR)**(-2))+0.354419D01*((T/TCR)**(-3)) * -0.358471D01*((T/TCR)**(-4))+0.119122D01*((T/TCR)**(-5))) CC(T)=(0.216360D00*((T/TCR)**0)+0.438290D00*((T/TCR)**(-1)) * -0.975566D00*((T/TCR)**(-2))+0.766205D-01*((T/TCR)**(-3)) * +0.126497D-01*((T/TCR)**(-4))-0.386903D-01*((T/TCR)**(-5))) DD(T)=(-0.433867D00*((T/TCR)**0)+0.123217D00*((T/TCR)**(-1)) * -0.519648D00*((T/TCR)**(-2))+0.141667D01*((T/TCR)**(-3)) * +0.944493D-02*((T/TCR)**(-4))) EE(T)=(0.363104D00*((T/TCR)**0)-0.281127D-01*((T/TCR)**(-1)) * -0.195138D00*((T/TCR)**(-2))-0.653019D00*((T/TCR)**(-3))) FF(T)=(-0.120343D00*((T/TCR)**0)+0.171534D00*((T/TCR)**(-1)) * +0.114723D00*((T/TCR)**(-2))) GG(T)=(-0.385342D-01*((T/TCR)**0)-0.521881D-01*((T/TCR)**(-1)) * +0.831912D-01*((T/TCR)**(-2))) OO(T)=(0.275163D-01*((T/TCR)**0)-0.305918D-01*((T/TCR)**(-1))) HH(P,T)=P/(RI*T*(10.0**6)) RB(R)=O*(R**9)+G*(R**8)+F*(R**7)+E*(R**6)+D*(R**5) * +C*(R**4)+B*(R**3)+A*(R**2)+R-H T=F40XEN(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) O=OO(T) H=HH(P,T) IF(T.GE.288.1D00) GO TO 1000 R0=0.550D00 R1=0.770D00 GO TO 1100 1000 R0=0.770D00 R1=1.1977D00 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 S97XEN(FUN) COMMON/UNIT/KPA,MESS CHARACTER FUN*6,MSG*125 IF(MESS.NE.0) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR XENON ****' WRITE(6,*) MSG END IF RETURN END C *** LEVEL 2 ERROR MESSAGE *** SUBROUTINE S98XEN(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 XENON', & ' 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 XENON', & ' 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 XENON', &' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') END IF END IF RETURN END C *** LEVEL 3 ERROR MESSAGE *** SUBROUTINE S99XEN(FUN) COMMON/UNIT/KPA,MESS CHARACTER FUN*6,MSG*125 IF(MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR XENON ****' 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