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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(FUN) ALAPT=-1.0E+30 RETURN END C------------------------------------------------- F4 = ALHP REAL FUNCTION ALHP(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F4CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALHP'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F4CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALHP=FF RETURN END C------------------------------------------------- F5 = ALHT REAL FUNCTION ALHT(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F5CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALHT'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F5CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALHT=FF RETURN END C------------------------------------------------- F6 = ALMPD FUNCTION ALMPD(P) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALMPD'/ CALL S99CH4(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 S99CH4(FUN) ALMPDD=-1.0E+30 RETURN END C------------------------------------------------- F8 = ALMPT REAL FUNCTION ALMPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F8CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALMPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F8CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMPT=FF RETURN END C------------------------------------------------- F9 = ALMTD FUNCTION ALMTD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'ALMTD'/ CALL S99CH4(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 S99CH4(FUN) ALMTDD=-1.0E+30 RETURN END C------------------------------------------------- F11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F11CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUPD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F11CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 F12CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUPDD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F12CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 REAL FUNCTION AMUPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F13CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F13CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUPT=FF RETURN END C------------------------------------------------- F14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F14CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUTD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F14CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 F15CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUTDD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F15CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 REAL FUNCTION CPPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F16CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPPD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F16CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPPD=FF RETURN END C------------------------------------------------- F17 = CPPDD REAL FUNCTION CPPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F17CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPPDD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F17CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPPDD=FF RETURN END C------------------------------------------------- F18 = CPPT REAL FUNCTION CPPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F18CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F18CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPPT=FF RETURN END C------------------------------------------------- F19 = CPTD REAL FUNCTION CPTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F19CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPTD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F19CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPTD=FF RETURN END C------------------------------------------------- F20 = CPTDD REAL FUNCTION CPTDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F20CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPTDD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F20CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPTDD=FF RETURN END C------------------------------------------------- F21 = CRP REAL FUNCTION CRP(A) CHARACTER FUN*6,FLUID*8,A*1 REAL T0K,PBAR,FF INTEGER KPA DOUBLE PRECISION F21CH4 COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, 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 = F21CH4(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 S99CH4(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='16.043' WHEN A='M' C B='518.25' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=16.043 ELSE IF (A.EQ.'R') THEN FC=518.25 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR METHANE WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F23 = HPD REAL FUNCTION HPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F23CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F23CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPD=FF RETURN END C------------------------------------------------- F24 = HPDD REAL FUNCTION HPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F24CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPDD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F24CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPDD=FF RETURN END C------------------------------------------------- F25 = HPT REAL FUNCTION HPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F25CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F25CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPT=FF RETURN END C------------------------------------------------- F26 = HPX REAL FUNCTION HPX(P,X) CHARACTER FUN*6,FLUID*8 REAL P,X,FF INTEGER KPA DOUBLE PRECISION F26CH4,DBP,XX COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'HPX'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) XX=DBLE(X) C--- FUNCTION CALL --- FF = F26CH4(DBP,XX) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND X =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPX=FF RETURN END C------------------------------------------------- F27 = HTD REAL FUNCTION HTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F27CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HTD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F27CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HTD=FF RETURN END C------------------------------------------------- F28 = HTDD REAL FUNCTION HTDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F28CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HTDD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F28CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HTDD=FF RETURN END C------------------------------------------------- F29 = HTX REAL FUNCTION HTX(T,X) CHARACTER FUN*6,FLUID*8 REAL T,FF INTEGER KPA DOUBLE PRECISION F29CH4,DBT,XX COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'HTX'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) XX=DBLE(X) C--- FUNCTION CALL --- FF = F29CH4(DBT,XX) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,T,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND X =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HTX=FF 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='METHANE' WHEN A='S' C B='CH4' 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='METHANE' ELSE IF (A.EQ.'C') THEN IDENTF='CH4' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR METHANE 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 F30CH4,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 = F30CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 REAL FUNCTION SIGP(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F31CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SIGP'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F31CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- SIGP=FF RETURN END C------------------------------------------------- F32 = SIGT REAL FUNCTION SIGT(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F32CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SIGT'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F32CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- SIGT=FF RETURN END C------------------------------------------------- F33 = SPD REAL FUNCTION SPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F33CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F33CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- SPD=FF RETURN END C------------------------------------------------- F34 = SPDD REAL FUNCTION SPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F34CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPDD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F34CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- SPDD=FF RETURN END C------------------------------------------------- F35 = SPT REAL FUNCTION SPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F35CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F35CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- SPT=FF RETURN END C------------------------------------------------- F36 = SPX REAL FUNCTION SPX(P,X) CHARACTER FUN*6,FLUID*8 REAL P,X,FF INTEGER KPA DOUBLE PRECISION F36CH4,DBP,XX COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'SPX'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) XX=DBLE(X) C--- FUNCTION CALL --- FF = F36CH4(DBP,XX) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND X =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- SPX=FF RETURN END C------------------------------------------------- F37 = STD REAL FUNCTION STD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F37CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'STD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F37CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- STD=FF RETURN END C------------------------------------------------- F38 = STDD REAL FUNCTION STDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F38CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'STDD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F38CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- STDD=FF RETURN END C------------------------------------------------- F39 = STX REAL FUNCTION STX(T,X) CHARACTER FUN*6,FLUID*8 REAL T,FF INTEGER KPA DOUBLE PRECISION F39CH4,DBT,XX COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'STX'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) XX=DBLE(X) C--- FUNCTION CALL --- FF = F39CH4(DBT,XX) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,T,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND X =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- STX=FF RETURN END C------------------------------------------------- F40 = TSP REAL FUNCTION TSP(P) CHARACTER FUN*6 REAL PBAR,T0K,P,FF INTEGER KPA DOUBLE PRECISION F40CH4,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 = F40CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 F41CH4 COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, 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 = F41CH4(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 REAL FUNCTION UPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F42CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F42CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UPD=FF RETURN END C------------------------------------------------- F43 = UPDD REAL FUNCTION UPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F43CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPDD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F43CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UPDD=FF RETURN END C------------------------------------------------- F44 = UPT REAL FUNCTION UPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F44CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F44CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UPT=FF RETURN END C------------------------------------------------- F45 = UPX REAL FUNCTION UPX(P,X) CHARACTER FUN*6,FLUID*8 REAL P,X,FF INTEGER KPA DOUBLE PRECISION F45CH4,DBP,XX COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'UPX'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) XX=DBLE(X) C--- FUNCTION CALL --- FF = F45CH4(DBP,XX) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND X =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UPX=FF RETURN END C------------------------------------------------- F46 = UTD REAL FUNCTION UTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F46CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UTD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F46CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UTD=FF RETURN END C------------------------------------------------- F47 = UTDD REAL FUNCTION UTDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F47CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UTDD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F47CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UTDD=FF RETURN END C------------------------------------------------- F48 = UTX REAL FUNCTION UTX(T,X) CHARACTER FUN*6,FLUID*8 REAL T,FF INTEGER KPA DOUBLE PRECISION F48CH4,DBT,XX COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'UTX'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) XX=DBLE(X) C--- FUNCTION CALL --- FF = F48CH4(DBT,XX) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,T,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND X =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UTX=FF RETURN END C------------------------------------------------- F49 = VPD REAL FUNCTION VPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F49CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F49CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 F50CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPDD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F50CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 REAL FUNCTION VPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F51CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F51CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VPT=FF RETURN END C------------------------------------------------- F52 = VPX REAL FUNCTION VPX(P,X) CHARACTER FUN*6,FLUID*8 REAL P,X,FF INTEGER KPA DOUBLE PRECISION F52CH4,DBP,XX COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'VPX'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) XX=DBLE(X) C--- FUNCTION CALL --- FF = F52CH4(DBP,XX) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND X =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VPX=FF RETURN END C------------------------------------------------- F53 = VTD REAL FUNCTION VTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F53CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F53CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 F54CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTDD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F54CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 REAL FUNCTION VTX(T,X) CHARACTER FUN*6,FLUID*8 REAL T,FF INTEGER KPA DOUBLE PRECISION F55CH4,DBT,XX COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'VTX'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) XX=DBLE(X) C--- FUNCTION CALL --- FF = F55CH4(DBT,XX) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,T,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND X =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VTX=FF RETURN END C------------------------------------------------- F56 = XPH REAL FUNCTION XPH(P,H) CHARACTER FUN*6,FLUID*8 REAL P,H,FF INTEGER KPA DOUBLE PRECISION F56CH4,DBP,HH COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'XPH'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) HH=DBLE(H) C--- FUNCTION CALL --- FF = F56CH4(DBP,HH) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,H 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND H =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XPH=FF RETURN END C------------------------------------------------- F57 = XPS REAL FUNCTION XPS(P,S) CHARACTER FUN*6,FLUID*8 REAL P,S,FF INTEGER KPA DOUBLE PRECISION F57CH4,DBP,SS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'XPS'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) SS=DBLE(S) C--- FUNCTION CALL --- FF = F57CH4(DBP,SS) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XPS=FF RETURN END C------------------------------------------------- F58 = XPU REAL FUNCTION XPU(P,U) CHARACTER FUN*6,FLUID*8 REAL P,U,FF INTEGER KPA DOUBLE PRECISION F58CH4,DBP,UU COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'XPU'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) UU=DBLE(U) C--- FUNCTION CALL --- FF = F58CH4(DBP,UU) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,U 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND U =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XPU=FF RETURN END C------------------------------------------------- F59 = XPV REAL FUNCTION XPV(P,V) CHARACTER FUN*6,FLUID*8 REAL P,V,FF INTEGER KPA DOUBLE PRECISION F59CH4,DBP,VV COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'XPV'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) VV=DBLE(V) C--- FUNCTION CALL --- FF = F59CH4(DBP,VV) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,V 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND V =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XPV=FF RETURN END C------------------------------------------------- F60 = XTH REAL FUNCTION XTH(T,H) CHARACTER FUN*6,FLUID*8 REAL T,H,FF INTEGER KPA DOUBLE PRECISION F60CH4,DBT,HH COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'XTH'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) HH=DBLE(H) C--- FUNCTION CALL --- FF = F60CH4(DBT,HH) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,T,H 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND H =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XTH=FF RETURN END C------------------------------------------------- F61 = XTS REAL FUNCTION XTS(T,S) CHARACTER FUN*6,FLUID*8 REAL T,S,FF INTEGER KPA DOUBLE PRECISION F61CH4,DBT,SS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'XTS'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) SS=DBLE(S) C--- FUNCTION CALL --- FF = F61CH4(DBT,SS) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,T,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND S =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XTS=FF RETURN END C------------------------------------------------- F62 = XTU REAL FUNCTION XTU(T,U) CHARACTER FUN*6,FLUID*8 REAL T,U,FF INTEGER KPA DOUBLE PRECISION F62CH4,DBT,UU COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'XTU'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) UU=DBLE(U) C--- FUNCTION CALL --- FF = F62CH4(DBT,UU) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,T,U 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND U =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XTU=FF RETURN END C------------------------------------------------- F63 = XTV REAL FUNCTION XTV(T,V) CHARACTER FUN*6,FLUID*8 REAL T,V,FF INTEGER KPA DOUBLE PRECISION F63CH4,DBT,VV COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'XTV'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) VV=DBLE(V) C--- FUNCTION CALL --- FF = F63CH4(DBT,VV) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,T,V 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND V =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XTV=FF RETURN END C------------------------------------------------- F64 = TPH REAL FUNCTION TPH(P,H) CHARACTER FUN*6,FLUID*8 REAL T0K,PBAR,P,H,FF INTEGER KPA DOUBLE PRECISION F64CH4,DBP,HH COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'TPH'/ 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) HH=DBLE(H) C--- FUNCTION CALL --- FF = F64CH4(DBP,HH) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,H 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND H =',1PE14.7,' ****') FF=-1.0E+20 END IF 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 TPH=FF+T0K RETURN END C------------------------------------------------- F65 = TPS REAL FUNCTION TPS(P,S) CHARACTER FUN*6,FLUID*8 REAL T0K,PBAR,P,S,FF INTEGER KPA DOUBLE PRECISION F65CH4,DBP,SS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'TPS'/ 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) SS=DBLE(S) C--- FUNCTION CALL --- FF = F65CH4(DBP,SS) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S =',1PE14.7,' ****') FF=-1.0E+20 END IF 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 TPS=FF+T0K RETURN END C------------------------------------------------- F66 = PLDT FUNCTION PLDT(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PLDT'/ CALL S99CH4(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 S99CH4(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 F68CH4,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 = F68CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 F69CH4,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 = F69CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 REAL FUNCTION TPV(P,V) CHARACTER FUN*6,FLUID*8 REAL T0K,PBAR,P,V,FF INTEGER KPA DOUBLE PRECISION F70CH4,DBP,VV COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'TPV'/ 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) VV=DBLE(V) C--- FUNCTION CALL --- FF = F70CH4(DBP,VV) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,V 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND V =',1PE14.7,' ****') FF=-1.0E+20 END IF 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 TPV=FF+T0K RETURN END C------------------------------------------------- F71 = HPS REAL FUNCTION HPS(P,S) CHARACTER FUN*6,FLUID*8 REAL P,S,FF INTEGER KPA DOUBLE PRECISION F71CH4,DBP,SS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'METHANE'/, FUN/'HPS'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) SS=DBLE(S) C--- FUNCTION CALL --- FF = F71CH4(DBP,SS) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S =',1PE14.7,' ****') FF=-1.0E+20 END IF END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPS=FF RETURN END C------------------------------------------------- F72 = PSTD FUNCTION PSTD(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PSTD'/ CALL S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(FUN) TSPDD=-1.0E+30 RETURN END C------------------------------------------------- F76 = CVPDD REAL FUNCTION CVPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F76CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CVPDD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F76CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CVPDD=FF RETURN END C------------------------------------------------- F77= CVPT REAL FUNCTION CVPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F77CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CVPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F77CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CVPT=FF RETURN END C------------------------------------------------- F78 = CVTDD REAL FUNCTION CVTDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F78CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CVTDD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F78CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CVTDD=FF RETURN END C------------------------------------------------- F79 = UPS FUNCTION UPS(P,S) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'UPS'/ CALL S99CH4(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 S99CH4(FUN) VPS=-1.0E+30 RETURN END C------------------------------------------------- F81= PRPT REAL FUNCTION PRPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F81CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'PRPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F81CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- PRPT=FF RETURN END C------------------------------------------------- F82= AKPT REAL FUNCTION AKPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F82CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AKPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F82CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AKPT=FF RETURN END C------------------------------------------------- F83= WPT REAL FUNCTION WPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F83CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'WPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F83CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- WPT=FF 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 S99CH4(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 S99CH4(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 S99CH4(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 S99CH4(FUN) PRTDD=-1.0E+30 RETURN END **------------------------------------------------ F90= BSPT REAL FUNCTION BSPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F90CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'BSPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F90CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- BSPT=FF RETURN END **------------------------------------------------ F91= BTPT REAL FUNCTION BTPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F91CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'BTPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F91CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- BTPT=FF RETURN END **------------------------------------------------ F92= BPPT REAL FUNCTION BPPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F92CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'BPPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F92CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- BPPT=FF RETURN END **------------------------------------------------ F93= BVPT REAL FUNCTION BVPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F93CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'BVPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F93CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- BVPT=FF RETURN END **------------------------------------------------ F94= AJTPT REAL FUNCTION AJTPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F94CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AJTPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F94CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AJTPT=FF RETURN END **------------------------------------------------ F95= GAMPT REAL FUNCTION GAMPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA DOUBLE PRECISION F95CH4,DBP,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'GAMPT'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) TI=G99CH4(KPA,T) DBP=DBLE(PI) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F95CH4(DBP,DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- GAMPT=FF RETURN END **------------------------------------------------ F96 = GAMPDD REAL FUNCTION GAMPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA DOUBLE PRECISION F96CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'GAMPDD'/ C--- SET OF UNIT --- PI=G98CH4(KPA,P) DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F96CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- GAMPDD=FF RETURN END **------------------------------------------------ F97 = GAMTDD REAL FUNCTION GAMTDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA DOUBLE PRECISION F97CH4,DBT COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'GAMTDD'/ C--- SET OF UNIT --- TI=G99CH4(KPA,T) DBT=DBLE(TI) C--- FUNCTION CALL --- FF = F97CH4(DBT) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- GAMTDD=FF RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 REAL PBAR,T0K,P,FF INTEGER KPA DOUBLE PRECISION F98CH4,DBP COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TPSEUP'/ 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 = F98CH4(DBP) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97CH4(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98CH4(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 TPSEUP=FF+T0K RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) INTEGER KPA COMMON/UNIT/KPA,MESS CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99CH4(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 S99CH4(FUN) TSBP=-1.0E+30 RETURN END C C#################################################################### C C******************************************************************** C* ********************************** * C* * A PROGRAM PACKAGE OF METHANE * * 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 *** ALHP(P) LATENT HEAT OF VAPORIZATION DOUBLE PRECISION FUNCTION F4CH4(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) IF(P.LT.0.11719D00.OR.P.GT.45.95001D00) GO TO 900 HL=F23CH4(P) HV=F24CH4(P) IF(HL.EQ.-1.0E+20.OR.HV.EQ.-1.0E+20) GO TO 900 F4CH4=HV-HL RETURN 900 F4CH4=-1.0E+20 RETURN END C *** ALHT(T) LATENT HEAT OF VAPORIZATION DOUBLE PRECISION FUNCTION F5CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) HL=F27CH4(T) HV=F28CH4(T) IF(HL.EQ.-1.0E+20.OR.HV.EQ.-1.0E+20) GO TO 900 F5CH4=HV-HL RETURN 900 F5CH4=-1.0E+20 RETURN END C **** ALMPT(P,T) THERMAL CONDUCTIVITY DOUBLE PRECISION FUNCTION F8CH4(P,T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA G00/ 0.2141958D03/,G01/-0.1236086D06/,G02/ 0.2980609D08/, & G03/-0.2697890D10/, & G10/-0.2668987D01/,G11/ 0.2395180D04/,G12/ 0.3353348D06/, & G13/-0.9394799D09/,G14/ 0.3259245D12/,G15/-0.3500520D14/, & G20/-0.1402263D-1/,G21/ 0.1449289D02/,G22/-0.4991578D04/, & G23/ 0.5838046D06/, & G30/ 0.2887848D-4/,G31/-0.1596820D-1/,G32/-0.8384761D01/, & G33/ 0.8244275D04/,G34/-0.2121137D07/,G35/ 0.1773436D09/, & G40/-0.4279680D-7/,G41/ 0.2961922D-4/,G42/ 0.7582647D-2/, & G43/-0.1141494D02/,G44/ 0.3331705D04/,G45/-0.3110679D06/ T=T+273.15D00 IF(T.LT.298.15D00.OR.T.GT.423.15D00) GO TO 900 IF(T.GE.298.15D00.AND.T.LE.423.15D00 & .AND.P.GE.1.D00.AND.P.LE.700.D00) GO TO 100 GO TO 900 100 GG1=G00/T**0.+G01/T**1.+G02/T**2.+G03/T**3. GG2=(G10/T**0.+G11/T**1.+G12/T**2.+G13/T**3.+G14/T**4. 1 +G15/T**5.)*P GG3=(G20/T**0.+G21/T**1.+G22/T**2.+G23/T**3.)*P**2. GG4=(G30/T**0.+G31/T**1.+G32/T**2.+G33/T**3.+G34/T**4. 1 +G35/T**5.)*P**3. GG5=(G40/T**0.+G41/T**1.+G42/T**2.+G43/T**3.+G44/T**4. 1 +G45/T**5.)*P**4. F8CH4=(GG1+GG2+GG3+GG4+GG5)/1000.0 RETURN 900 F8CH4=-1.0E+20 RETURN END C *** AMUPD(P) COEFFICIENT OF VISCOSITY OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F11CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION A(7),B(4),C(9) DATA A/-1.0239160427D01,1.7422822961D02,1.7460545674D01, * -2.8476328289D03,1.3368502192D-01,1.4207239767D02, * 5.0020669720D03/, * B/1.6969859271D00,-1.3337234608D-01,1.4,1.68D02/, * C/2.907741307D06,-3.312874033D06,1.608101838D06, * -4.331904871D05,7.062481330D04,-7.116620750D03, * 4.325174400D02,-1.445911210D01,2.037119479D-01/, * SI/0.1628D00/ IF(P.LT.0.198790D00.OR.P.GT.45.95001D00) GO TO 600 T=F40CH4(P) IF(T.EQ.-1.0E+20) GO TO 600 TM=T+273.15D00 F1=0. RO=F53CH4(T) IF(RO.EQ.-1.0E+20) GO TO 600 S=(1.0D00/RO)/1.0E3 DO 100 J=1,9 100 F1=F1+C(J)*(TM**((J-4)/3.0)) F2=B(1)+B(2)*(B(3)-DLOG(TM/B(4))) F3=DEXP(A(1)+A(2)/TM)*(DEXP((A(3)+A(4)/(TM**1.5))*(S**0.1) * +((S-SI)/SI)*(S**0.5)*(A(5)+A(6)/TM+A(7)/(TM**2.0)))-1.0D00) F11CH4=(F1+F2+F3)*1.0E-7 RETURN 600 F11CH4=-1.0E+20 RETURN END C *** AMUPDD(P) COEFFICIENT OF VISCOSITY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F12CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION A(7),B(4),C(9) DATA A/-1.0239160427D01,1.7422822961D02,1.7460545674D01, * -2.8476328289D03,1.3368502192D-01,1.4207239767D02, * 5.0020669720D03/, * B/1.6969859271D00,-1.3337234608D-01,1.4,1.68D02/, * C/2.907741307D06,-3.312874033D06,1.608101838D06, * -4.331904871D05,7.062481330D04,-7.116620750D03, * 4.325174400D02,-1.445911210D01,2.037119479D-01/, * SI/0.1628D00/ IF(P.LT.0.198790D00.OR.P.GT.45.95001D00) GO TO 600 T=F40CH4(P) IF(T.EQ.-1.0E+20) GO TO 600 TM=T+273.15D00 F1=0. RO=F54CH4(T) IF(RO.EQ.-1.0E+20) GO TO 600 S=(1.0D00/RO)/1.0E3 DO 100 J=1,9 100 F1=F1+C(J)*(TM**((J-4)/3.0)) F2=B(1)+B(2)*(B(3)-DLOG(TM/B(4))) F3=DEXP(A(1)+A(2)/TM)*(DEXP((A(3)+A(4)/(TM**1.5))*(S**0.1) * +((S-SI)/SI)*(S**0.5)*(A(5)+A(6)/TM+A(7)/(TM**2.0)))-1.0D00) F12CH4=(F1+F2+F3)*1.0E-7 RETURN 600 F12CH4=-1.0E+20 RETURN END C *** AMUPT(P,T) COEFFICIENT OF VISCOSITY DOUBLE PRECISION FUNCTION F13CH4(P,T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION A(7),B(4),C(9) DATA A/-1.0239160427D01,1.7422822961D02,1.7460545674D01, * -2.8476328289D03,1.3368502192D-01,1.4207239767D02, * 5.0020669720D03/, * B/1.6969859271D00,-1.3337234608D-01,1.4,1.68D02/, * C/2.907741307D06,-3.312874033D06,1.608101838D06, * -4.331904871D05,7.062481330D04,-7.116620750D03, * 4.325174400D02,-1.445911210D01,2.037119479D-01/, * SI/0.1628D00/ TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.1.0D00.AND.P.LE.171.81144D00) & .AND.(T.GE.-178.15.AND.T.LE.226.85D00)) GO TO 100 IF((P.GT.171.81144D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.226.85D00)) GO TO 100 IF((P.GT.450.D00.AND.P.LE.500.D00) & .AND.(T.GE.TP.AND.T.LE.196.85D00)) GO TO 100 IF((P.GT.500.D00.AND.P.LE.750.D00) & .AND.(T.GE.-68.15.AND.T.LE.196.85D00)) GO TO 100 GO TO 900 100 TM=T+273.15D00 F1=0. RO=F51CH4(P,T) IF(RO.EQ.-1.0E+20) GO TO 900 S=(1.0D00/RO)/1.0E3 DO 200 J=1,9 200 F1=F1+C(J)*(TM**((J-4)/3.0)) F2=B(1)+B(2)*(B(3)-DLOG(TM/B(4))) F3=DEXP(A(1)+A(2)/TM)*(DEXP((A(3)+A(4)/(TM**1.5))*(S**0.1) * +((S-SI)/SI)*(S**0.5)*(A(5)+A(6)/TM+A(7)/(TM**2.0)))-1.0D00) F13CH4=(F1+F2+F3)*1.0E-7 RETURN 900 F13CH4=-1.0E+20 RETURN END C *** AMUTD(T) COEFFICIENT OF VISCOSITY OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F14CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION A(7),B(4),C(9) DATA A/-1.0239160427D01,1.7422822961D02,1.7460545674D01, * -2.8476328289D03,1.3368502192D-01,1.4207239767D02, * 5.0020669720D03/, * B/1.6969859271D00,-1.3337234608D-01,1.4,1.68D02/, * C/2.907741307D06,-3.312874033D06,1.608101838D06, * -4.331904871D05,7.062481330D04,-7.116620750D03, * 4.325174400D02,-1.445911210D01,2.037119479D-01/, * SI/0.1628D00/, * TC/190.555D00/,TL/95.0D00/ TM=T+273.15D00 IF(TM.LT.TL) GO TO 600 IF(TM.GT.TC) GO TO 600 F1=0. RO=F53CH4(T) IF(RO.EQ.-1.0E+20) GO TO 600 S=(1.0D00/RO)/1.0E3 DO 100 J=1,9 100 F1=F1+C(J)*(TM**((J-4)/3.0)) F2=B(1)+B(2)*(B(3)-DLOG(TM/B(4))) F3=DEXP(A(1)+A(2)/TM)*(DEXP((A(3)+A(4)/(TM**1.5))*(S**0.1) * +((S-SI)/SI)*(S**0.5)*(A(5)+A(6)/TM+A(7)/(TM**2.0)))-1.0D00) F14CH4=(F1+F2+F3)*1.0E-7 RETURN 600 F14CH4=-1.0E+20 RETURN END C *** AMUTDD(T) COEFFICIENT OF VISCOSITY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F15CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION A(7),B(4),C(9) DATA A/-1.0239160427D01,1.7422822961D02,1.7460545674D01, * -2.8476328289D03,1.3368502192D-01,1.4207239767D02, * 5.0020669720D03/, * B/1.6969859271D00,-1.3337234608D-01,1.4,1.68D02/, * C/2.907741307D06,-3.312874033D06,1.608101838D06, * -4.331904871D05,7.062481330D04,-7.116620750D03, * 4.325174400D02,-1.445911210D01,2.037119479D-01/, * SI/0.1628D00/, * TC/190.555D00/,TL/95.0D00/ TM=T+273.15D00 IF(TM.LT.TL) GO TO 600 IF(TM.GT.TC) GO TO 600 F1=0. RO=F54CH4(T) IF(RO.EQ.-1.0E+20) GO TO 600 S=(1.0D00/RO)/1.0E3 DO 100 J=1,9 100 F1=F1+C(J)*(TM**((J-4)/3.0)) F2=B(1)+B(2)*(B(3)-DLOG(TM/B(4))) F3=DEXP(A(1)+A(2)/TM)*(DEXP((A(3)+A(4)/(TM**1.5))*(S**0.1) * +((S-SI)/SI)*(S**0.5)*(A(5)+A(6)/TM+A(7)/(TM**2.0)))-1.0D00) F15CH4=(F1+F2+F3)*1.0E-7 RETURN 600 F15CH4=-1.0E+20 RETURN END C *** CPPD(P) SPECIFIC HEAT CAPACITY OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F16CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ IF(P.LT.0.11719D00.OR.P.GT.45.95001D00) GO TO 900 VL=F49CH4(P) T=F40CH4(P) IF(T.EQ.-1.0E+20.OR.VL.EQ.-1.0E+20) GO TO 900 LO=1.D00/VL CALL S01CH4(T,CID) CID=CID*1000.D00/16.043D00 CALL S13CH4(T,LO,F1,F2,F3) F16CH4=CID-R-R*F1+R*F2/F3 RETURN 900 F16CH4=-1.0E+20 RETURN END C *** CPPDD(P) SPECIFIC HEAT CAPACITY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F17CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ IF(P.LT.0.11719D00.OR.P.GT.45.95001D00) GO TO 900 VV=F50CH4(P) IF(VV.EQ.-1.0E+20) GO TO 900 LO=1.D00/VV T=F40CH4(P) IF(T.EQ.-1.0E+20) GO TO 900 CALL S01CH4(T,CID) CID=CID*1000.D00/16.043D00 CALL S13CH4(T,LO,F1,F2,F3) F17CH4=CID-R-R*F1+R*F2/F3 RETURN 900 F17CH4=-1.0E+20 RETURN END C *** CPPT(P,T) SPECIFIC HEAT CAPACITY DOUBLE PRECISION FUNCTION F18CH4(P,T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 LOO=F51CH4(P,T) IF(LOO.EQ.-1.0E+20) GO TO 900 LO=1.D00/LOO CALL S01CH4(T,CID) CID=CID*1000.D00/16.043D00 CALL S13CH4(T,LO,F1,F2,F3) F18CH4=CID-R-R*F1+R*F2/F3 RETURN 900 F18CH4=-1.0E+20 RETURN END C *** CPTD(T) SPECIFIC HEAT CAPACITY OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F19CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ TM=T+273.15D00 VL=F53CH4(T) IF(VL.EQ.-1.0E+20) GO TO 900 LO=1.D00/VL CALL S01CH4(T,CID) CID=CID*1000.D00/16.043D00 CALL S13CH4(T,LO,F1,F2,F3) F19CH4=CID-R-R*F1+R*F2/F3 RETURN 900 F19CH4=-1.0E+20 RETURN END C *** CPTDD(T) SPECIFIC HEAT CAPACITY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F20CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ TM=T+273.15D00 VV=F54CH4(T) IF(VV.EQ.-1.0E+20) GO TO 900 LO=1.D00/VV CALL S01CH4(T,CID) CID=CID*1000.D00/16.043D00 CALL S13CH4(T,LO,F1,F2,F3) F20CH4=CID-R-R*F1+R*F2/F3 RETURN 900 F20CH4=-1.0E+20 RETURN END C *** CRP(A) QUANTITIES AT THE CRITICAL POINT DOUBLE PRECISION FUNCTION F21CH4(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 F21CH4=-492053.D00 RETURN 10 IF(A.NE.B(2)) GO TO 20 F21CH4=45.950D00 RETURN 20 IF(A.NE.B(3)) GO TO 30 F21CH4=-4098.D00 RETURN 30 IF(A.NE.B(4)) GO TO 40 F21CH4=-82.595D00 RETURN 40 IF(A.NE.B(5)) GO TO 900 F21CH4=1.D00/162.19D00 RETURN 900 F21CH4=-1.0E+20 RETURN END C *** HPD(P) SPECIFIC ENTHALPY OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F23CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ VL=F49CH4(P) IF (VL.EQ.-1.0E+20) GO TO 600 LO=1.D00/VL T=F40CH4(P) TM=T+273.15D00 CALL S03CH4(T,HID) HID=HID*1000.D00/16.043D00 CALL S12CH4(T,LO,ULL) UID=HID-R*TM ULOT=UID+ULL F23CH4=ULOT+P*100000.D00/LO RETURN 600 F23CH4=-1.0E+20 RETURN END C *** HPDD(P) SPECIFIC ENTHALPY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F24CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ LV=F50CH4(P) IF(LV.EQ.-1.0E+20) GO TO 600 LO=1.D00/LV T=F40CH4(P) TM=T+273.15D00 CALL S03CH4(T,HID) HID=HID*1000.D00/16.043D00 CALL S12CH4(T,LO,ULL) UID=HID-R*TM ULOT=UID+ULL F24CH4=ULOT+P*100000.D00/LO RETURN 600 F24CH4=-1.0E+20 RETURN END C *** HPT(P,T) SPECIFIC ENTHALPY DOUBLE PRECISION FUNCTION F25CH4(P,T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 LOO=F51CH4(P,T) IF(LOO.EQ.-1.0E+20) GO TO 900 TM=T+273.15D00 LO=1.D00/LOO CALL S03CH4(T,HID) HID=HID*1000.D00/16.043D00 CALL S12CH4(T,LO,ULL) UID=HID-R*TM ULOT=UID+ULL F25CH4=ULOT+P*100000.D00/LO RETURN 900 F25CH4=-1.0E+20 RETURN END C *** HPX(P,X) SPECIFIC ENTHALPY OF MIXTURE DOUBLE PRECISION FUNCTION F26CH4(P,X) IMPLICIT DOUBLE PRECISION(A-H,L-Z) IF((P.LT.0.11719D00.OR.P.GT.45.95001D00) & .OR.(X.LT.0.0.OR.X.GT.1.0)) GO TO 900 HL=F23CH4(P) HV=F24CH4(P) IF(HL.EQ.-1.0E+20.OR.HV.EQ.-1.0E+20) GO TO 900 F26CH4=HL+X*(HV-HL) RETURN 900 F26CH4=-1.0E+20 RETURN END C *** HTD(T) SPECIFIC ENTHALPY OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F27CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ TM=T+273.15D00 P=F30CH4(T) IF(P.EQ.-1.0E+20) GO TO 900 VL=F53CH4(T) IF(VL.EQ.-1.0E+20) GO TO 900 LO=1.D0/VL CALL S03CH4(T,HID) HID=HID*1000.D00/16.043D00 CALL S12CH4(T,LO,ULL) UID=HID-R*TM ULOT=UID+ULL F27CH4=ULOT+P*100000.D00/LO RETURN 900 F27CH4=-1.0E+20 RETURN END C *** HTDD(T) SPECIFIC ENTHALPY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F28CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ TM=T+273.15D00 P=F30CH4(T) VL=F54CH4(T) IF(VL.EQ.-1.0E+20.OR.P.EQ.-1.0E+20) GO TO 900 LO=1.D0/VL CALL S03CH4(T,HID) HID=HID*1000.D00/16.043D00 CALL S12CH4(T,LO,ULL) UID=HID-R*TM ULOT=UID+ULL F28CH4=ULOT+P*100000.D00/LO RETURN 900 F28CH4=-1.0E+20 RETURN END C *** HTX(T,X) SPECIFIC ENTHALPY OF MIXTURE DOUBLE PRECISION FUNCTION F29CH4(T,X) IMPLICIT DOUBLE PRECISION(A-H,L-Z) TM=T+273.15D00 IF(X.LT.0.0.OR.X.GT.1.0) GO TO 900 HL=F27CH4(T) HV=F28CH4(T) IF(HL.EQ.-1.0E+20.OR.HV.EQ.-1.0E+20) GO TO 900 F29CH4=HL+X*(HV-HL) RETURN 900 F29CH4=-1.0E+20 RETURN END C *** PST(T) SATURATION PRESSURE DOUBLE PRECISION FUNCTION F30CH4(T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) DIMENSION A(4) DATA TC/190.555D00/,PC/45.95D00/,PL/0.11719D00/,DLT/1.D-05/, 1 A/-6.046852056D00,1.345684762D00,-0.6607506347D00, 2 -1.304019605D00/,TL/90.680D00/ TM=T+273.15D00 IF(DABS((TM-TC)/TC).LT.DLT) GO TO 300 IF(DABS((TM-TL)/TL).LT.DLT) GO TO 350 IF(TM.LT.TL) GO TO 600 IF(TM.GT.TC) GO TO 600 TT=1-TM/TC P=DLOG(PC)+TC/TM*(A(1)*TT+A(2)*TT**1.5+A(3)*TT**2.5+A(4)*TT**5) F30CH4=DEXP(P) RETURN 300 F30CH4=PC RETURN 350 F30CH4=PL RETURN 600 F30CH4=-1.0E+20 RETURN END C *** SIGP(P) SURFACE TENSION *** DOUBLE PRECISION FUNCTION F31CH4(P) IMPLICIT DOUBLE PRECISION (A-H,L-Z) DATA TL/90.68D00/,TC/190.55D00/,T1/104.99D00/,SIGMA1/15.026D00/ T=F40CH4(P) IF(T.EQ.-1.0E+20) GO TO 900 TM=T+273.15D00 IF(TM.LT.TL.OR.TM.GT.TC) GO TO 900 F31CH4=(SIGMA1*((TC-TM)/(TC-T1))**1.3941D00)/1000.0 RETURN 900 F31CH4=-1.0E+20 RETURN END C *** SIGT(T) SURFACE TENSION *** DOUBLE PRECISION FUNCTION F32CH4(T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) DATA TL/90.68D00/,TC/190.55D00/,T1/104.99D00/,SIGMA1/15.026D00/ TM=T+273.15D00 IF(TM.LT.TL.OR.TM.GT.TC) GO TO 900 F32CH4=(SIGMA1*((TC-TM)/(TC-T1))**1.3941D00)/1000.0 RETURN 900 F32CH4=-1.0E+20 RETURN END C *** SPD(P) SPECIFIC ENTROPY OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F33CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) C DIMENSION A(6),N(32),XS(32) DATA PC/45.95001D00/,PL/0.11719D00/,DLT/1.D-05/, 1 R/518.25095D00/,PA/101325D00/, 2 SL/-7381.D00/,SC/-4098.D00/ IF(DABS((P-PC)/PC).LT.DLT) GO TO 300 IF(DABS((P-PL)/PL).LT.DLT) GO TO 350 IF(P.LT.PL) GO TO 600 IF(P.GT.PC) GO TO 600 T=F40CH4(P) LO=1.D00/F53CH4(T) IF(T.EQ.-1.0E+20.OR.LO.EQ.-1.0E+20) GO TO 600 TM=T+273.15D00 CALL S02CH4(T,SID) SID=SID*1000.D00/16.043D00 CALL S11CH4(T,LO,SLL) F33CH4=SID-R*DLOG(LO*R*TM/PA)+SLL RETURN 300 F33CH4=SC RETURN 350 F33CH4=SL RETURN 600 F33CH4=-1.0E+20 RETURN END C *** SPDD(P) SPECIFIC ENTROPY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F34CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA PC/45.95001D00/,PL/0.11719D00/,DLT/1.D-05/, 1 R/518.25095D00/,PA/101325.D00/, 2 SL/-1388.D00/,SC/-4098.D00/ IF(DABS((P-PC)/PC).LT.DLT) GO TO 300 IF(DABS((P-PL)/PL).LT.DLT) GO TO 350 IF(P.LT.PL) GO TO 900 IF(P.GT.PC) GO TO 900 T=F40CH4(P) TM=T+273.15D00 LO=1.D00/F54CH4(T) IF(T.EQ.-1.0E+20.OR.LO.EQ.-1.0E+20) GO TO 900 CALL S02CH4(T,SID) SID=SID*1000.D00/16.043D00 CALL S11CH4(T,LO,SLL) F34CH4=SID-R*DLOG(LO*R*TM/PA)+SLL RETURN 300 F34CH4=SC RETURN 350 F34CH4=SL RETURN 900 F34CH4=-1.0E+20 RETURN END C *** SPT(P,T) SPECIFIC ENTROPY DOUBLE PRECISION FUNCTION F35CH4(P,T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA PA/101325.D00/,ERR/1.D-7/,R/518.25095D00/ TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 TM=T+273.15D00 LOO=F51CH4(P,T) IF(LOO.EQ.ERR) GO TO 900 LO=1.D00/LOO CALL S02CH4(T,SID) SID=SID*1000.D00/16.043D00 CALL S11CH4(T,LO,SLL) F35CH4=SID-R*DLOG(LO*R*TM/PA)+SLL RETURN 900 F35CH4=-1.0E+20 RETURN END C *** SPX(P,X) SPECIFIC ENTROPY OF MIXTURE DOUBLE PRECISION FUNCTION F36CH4(P,X) IMPLICIT DOUBLE PRECISION(A-H,L-Z) IF((P.LT.0.11719D00.OR.P.GT.45.95001D00) & .OR.(X.LT.0.0.OR.X.GT.1.0)) GO TO 900 SL=F33CH4(P) SV=F34CH4(P) IF(SL.EQ.-1.0E+20.OR.SV.EQ.-1.0E+20) GO TO 900 F36CH4=SL+X*(SV-SL) RETURN 900 F36CH4=-1.0E+20 RETURN END C *** STD(T) SPECIFIC ENTROPY OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F37CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA DLT/1.D-05/, 1 R/518.25095D00/,TL/90.68D00/,PA/101325D00/,TC/190.555D00/, 2 SL/-7381.D00/,SC/-4098.D00/ TM=T+273.15D00 IF (DABS((TM-TL)/TL).LT.DLT) GO TO 300 IF (DABS((TM-TC)/TC).LT.DLT) GO TO 350 IF(TM.LT.TL) GO TO 900 IF(TM.GT.TC) GO TO 900 LO=1.D00/F53CH4(T) CALL S02CH4(T,SID) SID=SID*1000.D00/16.043D00 CALL S11CH4(T,LO,SLL) F37CH4=SID-R*DLOG(LO*R*TM/PA)+SLL RETURN 300 F37CH4=SL RETURN 350 F37CH4=SC RETURN 900 F37CH4=-1.0E+20 RETURN END C *** STDD(T) SPECIFIC ENTROPY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F38CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA DLT/1.D-05/,R/518.25095D00/,TC/190.555D00/, 1 SL/-1388.D00/,SC/-4098.D00/,PA/101325.D00/, 2 TL/90.68D00/ TM=T+273.15D00 IF(DABS((TM-TC)/TC).LT.DLT) GO TO 300 IF(DABS((TM-TL)/TL).LT.DLT) GO TO 350 IF(TM.LT.TL) GO TO 600 IF(TM.GT.TC) GO TO 600 LO=1.D00/F54CH4(T) CALL S02CH4(T,SID) SID=SID*1000.D00/16.043D00 CALL S11CH4(T,LO,SLL) F38CH4=SID-R*DLOG(LO*R*TM/PA)+SLL RETURN 300 F38CH4=SC RETURN 350 F38CH4=SL RETURN 600 F38CH4=-1.0E+20 RETURN END C *** STX(T,X) SPECIFIC ENTROPY OF MIXTURE DOUBLE PRECISION FUNCTION F39CH4(T,X) IMPLICIT DOUBLE PRECISION(A-H,L-Z) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 900 SL=F37CH4(T) SV=F38CH4(T) IF(SL.EQ.-1.0E+20.OR.SV.EQ.-1.0E+20) GO TO 900 F39CH4=SL+X*(SV-SL) RETURN 900 F39CH4=-1.0E+20 RETURN END C *** TSP(P) SATURATION TEMPERATURE DOUBLE PRECISION FUNCTION F40CH4(P) IMPLICIT DOUBLE PRECISION (A-H,L-Z) DIMENSION A(4) DATA TC/190.555D00/,PC/45.95001D00/,PL/0.11719D00/,DLT/1.D-05/, 1 EV/-1.0D+20/,A/-6.046852056D00,1.345684762D00,-0.6607506347D00, 2 -1.304019605D00/,TL/90.68D00/ AA(X)=DLOG(P/PC)-TC/X*(A(1)*S+A(2)*S**1.5+A(3)*S**2.5+A(4)*S**5) IF(DABS((P-PC)/PC).LT.DLT) GO TO 300 IF(DABS((P-PL)/PL).LT.DLT) GO TO 350 IF(P.LT.PL) GO TO 600 IF(P.GT.PC) GO TO 600 ERR=1.D-05 X0=TL X1=TC X3=X1 IC=0 S=1.D00-X0/TC F0=AA(X0) F1=AA(X1) 100 IC=IC+1 X2=(X0+X1)/2.D00 S=1.D00-X2/TC F2=AA(X2) IF(DABS(X2-X3).LE.ERR) GO TO 400 X3=X2 IF(F0*F2.LT.0.) GO TO 200 F0=F2 X0=X2 IF(IC.GT.200) GO TO 900 GO TO 100 200 F1=F2 X1=X2 IF(IC.GT.200) GO TO 900 GO TO 100 300 F40CH4=TC-273.15D00 RETURN 350 F40CH4=TL-273.15D00 RETURN 400 F40CH4=X2-273.15D00 RETURN 600 F40CH4=-1.0E+20 RETURN 900 F40CH4=EV RETURN END C *** TRPL(A) QUANTITIES AT THE TRIPLE POINT DOUBLE PRECISION FUNCTION F41CH4(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 F41CH4=0.11719D00 RETURN 10 IF(A.NE.B(2)) GO TO 900 F41CH4=-182.47D00 RETURN 900 F41CH4=-1.0E+20 RETURN END C *** UPD(P) SPECIFIC INTERNAL ENERGY OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F42CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ IF(P.LT.0.11719D00.OR.P.GT.45.95001D00) GO TO 900 T=F40CH4(P) TM=T+273.15D00 VL=F53CH4(T) IF(T.EQ.-1.0E+20.OR.VL.EQ.-1.0E+20) GO TO 900 LO=1.D0/VL CALL S03CH4(T,HID) HID=HID*1000.D00/16.043D00 CALL S12CH4(T,LO,ULL) UID=HID-R*TM F42CH4=UID+ULL RETURN 900 F42CH4=-1.0E+20 RETURN END C *** UPDD(P) SPECIFIC INTERNAL ENERGY OF SATURATED VAPPOR DOUBLE PRECISION FUNCTION F43CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ T=F40CH4(P) VL=F54CH4(T) IF(T.EQ.-1.0E+20.OR.VL.EQ.-1.0E+20) GO TO 900 TM=T+273.15D00 LO=1.D0/VL CALL S03CH4(T,HID) HID=HID*1000.D00/16.043D00 CALL S12CH4(T,LO,ULL) UID=HID-R*TM F43CH4=UID+ULL RETURN 900 F43CH4=-1.0E+20 RETURN END C *** UPT(P,T) SPECIFIC INTERNAL ENERGY DOUBLE PRECISION FUNCTION F44CH4(P,T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 TM=T+273.15D00 VLM=F51CH4(P,T) IF(VLM.EQ.-1.0E+20) GO TO 900 LO=1.D00/VLM CALL S03CH4(T,HID) HID=HID*1000.D00/16.043D00 CALL S12CH4(T,LO,ULL) UID=HID-R*TM F44CH4=UID+ULL RETURN 900 F44CH4=-1.0E+20 RETURN END C *** UPX(P,X) SPECIFIC INTERNAL ENERGY OF MIXTURE DOUBLE PRECISION FUNCTION F45CH4(P,X) IMPLICIT DOUBLE PRECISION(A-H,L-Z) IF((P.LT.0.11719D00.OR.P.GT.45.95001D00) & .OR.(X.LT.0.0.OR.X.GT.1.0)) GO TO 900 UL=F42CH4(P) UV=F43CH4(P) IF(UL.EQ.-1.0E+20.OR.UV.EQ.-1.0E+20) GO TO 900 F45CH4=UL+X*(UV-UL) RETURN 900 F45CH4=-1.0E+20 RETURN END C *** UTD(T) SPECIFIC INTERNAL ENERGY OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F46CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ TM=T+273.15D00 VL=F53CH4(T) IF(VL.EQ.-1.0E+20) GO TO 900 LO=1.D00/VL CALL S03CH4(T,HID) HID=HID*1000.D00/16.043D00 CALL S12CH4(T,LO,ULL) UID=HID-R*TM F46CH4=UID+ULL RETURN 900 F46CH4=-1.0E+20 RETURN END C *** UTDD(T) SPECIFIC INTERNAL ENERGY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F47CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ TM=T+273.15D00 VV=F54CH4(T) IF(VV.EQ.-1.0E+20) GO TO 900 LO=1.D00/VV CALL S03CH4(T,HID) HID=HID*1000.D00/16.043D00 CALL S12CH4(T,LO,ULL) UID=HID-R*TM UL=UID+ULL F47CH4=UID+ULL RETURN 900 F47CH4=-1.0E+20 RETURN END C *** UTX(T,X) SPECIFIC INTERNAL ENERGY OF MIXTURE DOUBLE PRECISION FUNCTION F48CH4(T,X) IMPLICIT DOUBLE PRECISION(A-H,L-Z) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 900 UL=F46CH4(T) UV=F47CH4(T) IF(UL.EQ.-1.0E+20.OR.UV.EQ.-1.0E+20) GO TO 900 F48CH4=UL+X*(UV-UL) RETURN 900 F48CH4=-1.0E+20 RETURN END C *** VPD(P) SPECIFIC VOLUME OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F49CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) IF(P.LT.0.11719D00.OR.P.GT.45.95001D00) GO TO 900 T=F40CH4(P) IF(T.EQ.-1.0E+20) GO TO 900 F49CH4=F53CH4(T) RETURN 900 F49CH4=-1.0E+20 RETURN END C *** VPDD(P) SPECIFIC VOLUME OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F50CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) IF(P.LT.0.11719D00.OR.P.GT.45.95001D00) GO TO 900 T=F40CH4(P) IF(T.EQ.-1.0E+20) GO TO 900 F50CH4=F54CH4(T) RETURN 900 F50CH4=-1.0E+20 RETURN END C *** VPT(P,T) SPECIFIC VOLUME DOUBLE PRECISION FUNCTION F51CH4(P,T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION N(32),X(32) DATA TC/190.555D00/,LC/162.19D00/,ALFA/-0.98113911D00/, 1 R/518.25095D00/,ERR/1.D-07/,PC/45.95001D00/ TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LE.346.86D00)) GO TO 40 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.197.86D00)) GO TO 40 GO TO 900 40 TM=T+273.15D00 IF(TM.GT.TC.OR.P.GT.PC) GO TO 90 T1=TP T2=F40CH4(P) IF(T.GE.T1.AND.T.LE.T2) GO TO 60 50 X0=0. X1=1.D00/F54CH4(T) X3=X1 GO TO 100 60 X0=1.D00/F53CH4(T)-0.5D00 X1=600.D00 X3=X1 GO TO 100 90 X0=0. X1=600.D00 X3=X1 100 CALL S04CH4(N) OM=X0/LC TAW=TC/TM CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 150 K=1,32 150 VPT=VPT+N(K)*X(K) F0=P*100000.D00-X0*R*TM*(1.D00+VPT) OM=X1/LC TAW=TC/TM CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 200 K=1,32 200 VPT=VPT+N(K)*X(K) F1=P*100000.D00-X1*R*TM*(1.D00+VPT) 70 X2=(X0+X1)/2.D00 OM=X2/LC TAW=TC/TM CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 300 K=1,32 300 VPT=VPT+N(K)*X(K) F2=P*100000.D00-X2*R*TM*(1.D00+VPT) IF(DABS(X2-X3).LT.ERR) GO TO 400 X3=X2 IF((F0*F2).LT.0.) GO TO 410 F0=F2 X0=X2 GO TO 70 410 F1=F2 X1=X2 GO TO 70 400 F51CH4=1.D00/X2 RETURN 900 F51CH4=-1.0E+20 RETURN END C *** VPX(P,X) SPECIFIC VOLUME OF MIXTURE DOUBLE PRECISION FUNCTION F52CH4(P,X) IMPLICIT DOUBLE PRECISION(A-H,L-Z) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 900 VL=F49CH4(P) VV=F50CH4(P) IF(VL.EQ.-1.0E+20.OR.VV.EQ.-1.0E+20) GO TO 900 F52CH4=VL+X*(VV-VL) RETURN 900 F52CH4=-1.0E+20 RETURN END C *** VTD(T) SPECIFIC VOLUME OF SATURATED LIQUID DOUBLE PRECISION FUNCTION F53CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION N(32),X(32) DATA TC/190.555D00/,LC/162.19D00/,TL/90.68D00/, 1 LF/451.23D00/,DLT/1.D-05/,R/518.25095D00/, 2 ERR/1.D-07/,ALFA/-0.98113911D00/ CALL S04CH4(N) TM=T+273.15D00 IF(DABS((TM-TC)/TC).LT.DLT) GO TO 300 IF(DABS((TM-TL)/TL).LT.DLT) GO TO 350 IF(TM.LT.TL) GO TO 600 IF(TM.GT.TC) GO TO 600 P=F30CH4(T) X0=451.239D00 X1=162.19D00 X3=X1 OM=X0/LC TAW=TC/TM CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 150 K=1,32 150 VPT=VPT+N(K)*X(K) F0=P*100000.D00-X0*R*TM*(1.D00+VPT) OM=X1/LC CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 200 K=1,32 200 VPT=VPT+N(K)*X(K) F1=P*100000.D00-X1*R*TM*(1.D00+VPT) 70 X2=(X0+X1)/2.D00 OM=X2/LC CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 310 K=1,32 310 VPT=VPT+N(K)*X(K) F2=P*100000.D00-X2*R*TM*(1.D00+VPT) IF(DABS(X2-X3).LT.ERR) GO TO 400 X3=X2 IF((F0*F2).LT.0.) GO TO 410 F0=F2 X0=X2 GO TO 70 410 F1=F2 X1=X2 GO TO 70 400 F53CH4=1.D00/X2 RETURN 300 F53CH4=1.D00/LC RETURN 350 F53CH4=1.D00/LF RETURN 600 F53CH4=-1.0E+20 RETURN END C *** VTDD(T) SPECIFIC VOLUME OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F54CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION B(7),N(32),X(32) DATA TC/190.555D00/,TL/90.680D00/,LC/162.19D00/,LL/0.25137D00/, 1 DLT/1.D-05/,ERR/1.D-07/,R/518.25095/, 2 B/-1.380664556D00,-0.5398778702D00,10.939171514D00, 3 26.25420566D00,19.00373486D00,36.51595002D00,0.29D00/, 4 ALFA/-0.98113911D00/ CALL S04CH4(N) TM=T+273.15D00 IF(DABS((TM-TL)/TL).LT.DLT) GO TO 300 IF(DABS((TM-TC)/TC).LT.DLT) GO TO 350 IF(TM.LT.TL) GO TO 600 IF(TM.GT.TC) GO TO 600 S=TM/TC X0=LL X1=LC X3=X1 B1=0 DO 10 K=1,4 10 B1=B1+B(K)*(1.D00-S)**(B(7)*K) F0=DLOG(X0/LC)-(B1+B(5)*(1-S)**(9.D00*B(7))+B(6)*DLOG(S)) F1=DLOG(X1/LC)-(B1+B(5)*(1-S)**(9.D00*B(7))+B(6)*DLOG(S)) 100 X2=(X0+X1)/2.D00 F2=DLOG(X2/LC)-(B1+B(5)*(1-S)**(9.D00*B(7))+B(6)*DLOG(S)) IF (DABS(X2-X3).LT.ERR) GOTO 250 X3=X2 IF (F0*F2.LT.0.) GOTO 200 F0=F2 X0=X2 GOTO 100 200 F1=F2 X1=X2 GOTO 100 250 VV=X2 IF(VV.EQ.LC) GO TO 350 P=F30CH4(T) X0=0.2D00 X1=1.1D00*VV X3=X1 OM=X0/LC TAW=TC/TM CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 150 K=1,32 150 VPT=VPT+N(K)*X(K) F0=P*100000.D00-X0*R*TM*(1.D00+VPT) OM=X1/LC CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 210 K=1,32 210 VPT=VPT+N(K)*X(K) F1=P*100000.D00-X1*R*TM*(1.D00+VPT) 70 X2=(X0+X1)/2.D00 OM=X2/LC CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 310 K=1,32 310 VPT=VPT+N(K)*X(K) F2=P*100000.D00-X2*R*TM*(1.D00+VPT) IF(DABS(X2-X3).LT.ERR) GO TO 400 X3=X2 IF((F0*F2).LT.0.) GO TO 410 F0=F2 X0=X2 GO TO 70 410 F1=F2 X1=X2 GO TO 70 400 F54CH4=1.D00/X2 RETURN 300 F54CH4=1.D00/LL RETURN 350 F54CH4=1.D00/LC RETURN 600 F54CH4=-1.0E+20 RETURN END C *** VTX(T,X) SPECIFIC VOLUME OF MIXTURE DOUBLE PRECISION FUNCTION F55CH4(T,X) IMPLICIT DOUBLE PRECISION(A-H,L-Z) TM=T+273.15D00 IF(X.LT.0.0.OR.X.GT.1.0) GO TO 900 VL=F53CH4(T) VV=F54CH4(T) IF(VL.EQ.-1.0E+20.OR.VV.EQ.-1.0E+20) GO TO 900 F55CH4=VL+X*(VV-VL) RETURN 900 F55CH4=-1.0E+20 RETURN END C *** XPH(P,H) DRYNESS FRACTION DOUBLE PRECISION FUNCTION F56CH4(P,H) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA PC/45.95001D00/,PL/0.11719D00/ IF(P.LT.PL.OR.P.GT.PC) GO TO 900 HL=F23CH4(P) HV=F24CH4(P) IF(H.LT.HL.OR.H.GT.HV) GO TO 900 IF(HL.EQ.-1.0E+20.OR.HV.EQ.-1.0E+20) GO TO 900 F56CH4=(H-HL)/(HV-HL) RETURN 900 F56CH4=-1.0E+20 RETURN END C *** XPS(P,S) DRYNESS FRACTION DOUBLE PRECISION FUNCTION F57CH4(P,S) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA PC/45.95001D00/,PL/0.11719D00/ IF(P.LT.PL.OR.P.GT.PC) GO TO 900 SL=F33CH4(P) SV=F34CH4(P) IF(S.LT.SL.OR.S.GT.SV) GO TO 900 IF(SL.EQ.-1.0E+20.OR.SV.EQ.-1.0E+20) GO TO 900 F57CH4=(S-SL)/(SV-SL) RETURN 900 F57CH4=-1.0E+20 RETURN END C *** XPU(P,U) DRYNESS FRACTION DOUBLE PRECISION FUNCTION F58CH4(P,U) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA PC/45.95001D00/,PL/0.11719D00/ IF(P.LT.PL.OR.P.GT.PC) GO TO 900 UL=F42CH4(P) UV=F43CH4(P) IF(U.LT.UL.OR.U.GT.UV) GO TO 900 IF(UL.EQ.-1.0E+20.OR.UV.EQ.-1.0E+20) GO TO 900 F58CH4=(U-UL)/(UV-UL) RETURN 900 F58CH4=-1.0E+20 RETURN END C *** XPV(P,V) DRYNESS FRACTION DOUBLE PRECISION FUNCTION F59CH4(P,V) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA PC/45.95001D00/,PL/0.11719D00/ IF(P.LT.PL.OR.P.GT.PC) GO TO 900 VL=F49CH4(P) VV=F50CH4(P) IF(V.LT.VL.OR.V.GT.VV) GO TO 900 IF(VL.EQ.-1.0E+20.OR.VV.EQ.-1.0E+20) GO TO 900 F59CH4=(V-VL)/(VV-VL) RETURN 900 F59CH4=-1.0E+20 RETURN END C *** XTH(T,H) DRYNESS FRACTION DOUBLE PRECISION FUNCTION F60CH4(T,H) IMPLICIT DOUBLE PRECISION(A-H,L-Z) HL=F27CH4(T) HV=F28CH4(T) IF(HL.EQ.-1.0E+20.OR.HV.EQ.-1.0E+20) GO TO 900 IF(H.LT.HL.OR.H.GT.HV) GO TO 900 F60CH4=(H-HL)/(HV-HL) RETURN 900 F60CH4=-1.0E+20 RETURN END C *** XTS(T,S) DRYNESS FRACTION DOUBLE PRECISION FUNCTION F61CH4(T,S) IMPLICIT DOUBLE PRECISION(A-H,L-Z) SL=F37CH4(T) SV=F38CH4(T) IF(S.LT.SL.OR.S.GT.SV) GO TO 900 IF(SL.EQ.-1.0E+20.OR.SV.EQ.-1.0E+20) GO TO 900 F61CH4=(S-SL)/(SV-SL) RETURN 900 F61CH4=-1.0E+20 RETURN END C *** XTU(T,U) DRYNESS FRACTION DOUBLE PRECISION FUNCTION F62CH4(T,U) IMPLICIT DOUBLE PRECISION(A-H,L-Z) UL=F46CH4(T) UV=F47CH4(T) IF(UL.EQ.-1.0E+20.OR.UV.EQ.-1.0E+20) GO TO 900 IF(U.LT.UL.OR.U.GT.UV) GO TO 900 F62CH4=(U-UL)/(UV-UL) RETURN 900 F62CH4=-1.0E+20 RETURN END C *** XTV(T,V) DRYNESS FRACTION DOUBLE PRECISION FUNCTION F63CH4(T,V) IMPLICIT DOUBLE PRECISION(A-H,L-Z) VL=F53CH4(T) VV=F54CH4(T) IF(V.LT.VL.OR.V.GT.VV) GO TO 900 IF(VL.EQ.-1.0E+20.OR.VV.EQ.-1.0E+20) GO TO 900 F63CH4=(V-VL)/(VV-VL) RETURN 900 F63CH4=-1.0E+20 RETURN END C *** TPH(P,H) TEMPERATURE DOUBLE PRECISION FUNCTION F64CH4(P,H) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA PC/45.95001D00/,ERR/1.D-07/ IF(P.GE.0.11719D00.AND.P.LE.PC) GO TO 50 40 IF(P.GE.0.11719D00.AND.P.LT.450.D00) GO TO 100 IF(P.GE.450.D00.AND.P.LE.10000.D00) GO TO 120 GO TO 900 50 TS=F40CH4(P) H0=F23CH4(P) H1=F24CH4(P) IF(H.GE.H0.AND.H.LE.H1) GO TO 800 GO TO 40 100 TL=F69CH4(P) TCC=620.D00-273.15D00 GO TO 150 120 TL=F69CH4(P) TCC=470.D00-273.15D00 150 H0=F25CH4(P,TL ) H1=F25CH4(P,TCC) IF(H.LT.H0.OR.H.GT.H1) GO TO 900 T0=TL G0=H0-H IF(H0.EQ.-1.0E+20) GO TO 900 T1=TCC T3=T1 G1=H1-H 200 T2=(T0+T1)/2.D00 T=T2 H2=F25CH4(P,T) G2=H2-H IF(DABS(T2-T3).LT.ERR) GO TO 350 T3=T2 IF((G0*G2).LT.0.) GO TO 300 G0=G2 T0=T2 GO TO 200 300 G1=G2 T1=T2 GO TO 200 350 F64CH4=T2 RETURN 800 F64CH4=TS RETURN 900 F64CH4=-1.0E+20 RETURN END C *** TPS(P,S) TEMPERATURE DOUBLE PRECISION FUNCTION F65CH4(P,S) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA PC/45.95001D00/,ERR/1.D-07/ IF(P.GE.0.11719D00.AND.P.LE.PC) GO TO 50 40 IF(P.GE.0.11719D00.AND.P.LT.450.D00) GO TO 100 IF(P.GE.450.D00.AND.P.LE.10000.D00) GO TO 120 GO TO 900 50 TS=F40CH4(P) S0=F33CH4(P) S1=F34CH4(P) IF(S.GE.S0.AND.S.LE.S1) GO TO 800 GO TO 40 100 TL=F69CH4(P) TCC=620.D00-273.15D00 GO TO 150 120 TL=F69CH4(P) TCC=470.D00-273.15D00 150 S0=F35CH4(P,TL) S1=F35CH4(P,TCC) IF(S.LT.S0.OR.S.GT.S1) GO TO 900 T0=TL G0=S0-S IF(S0.EQ.-1.0E+20) GO TO 900 T1=TCC T3=T1 G1=S1-S 200 T2=(T0+T1)/2.D00 T=T2 S2=F35CH4(P,T) G2=S2-S IF(DABS(T2-T3).LT.ERR) GO TO 350 T3=T2 IF((G0*G2).LT.0.) GO TO 300 G0=G2 T0=T2 GO TO 200 300 G1=G2 T1=T2 GO TO 200 350 F65CH4=T2 RETURN 800 F65CH4=TS RETURN 900 F65CH4=-1.0E+20 RETURN END C *** PMLT(T) PRESSURE ON THE MELTING LINE DOUBLE PRECISION FUNCTION F68CH4(T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) DIMENSION D(5) DATA TC/260.D00/,TL/90.680D00/,PC/10416.D00/,PL/0.11719D00/, 1 D/-32.2988083D00,163.1572171D00, 2 -238.0692255D00,156.5940578D00,-38.78155184D00/,DLT/1.D-05/ TM=T+273.15D00 IF(DABS((TM-TC)/TC).LT.DLT) GO TO 300 IF(DABS((TM-TL)/TL).LT.DLT) GO TO 350 IF(TM.LT.TL) GO TO 600 IF(TM.GT.TC) GO TO 600 P1=D(1)*(TM/TL-1.)**0.1+D(2)*(TM/TL-1.)**0.2 P2=D(3)*(TM/TL-1.)**0.3+D(4)*(TM/TL-1.)**0.4+D(5)*(TM/TL-1.)**0.5 P=DLOG(PL)+(P1+P2) F68CH4=DEXP(P) RETURN 300 F68CH4=PC RETURN 350 F68CH4=PL RETURN 600 F68CH4=-1.0E+20 RETURN END C *** TMLP(P) TEMPERATURE ON THE MELTING LINE DOUBLE PRECISION FUNCTION F69CH4(P) IMPLICIT DOUBLE PRECISION (A-H,L-Z) DIMENSION D(5) DATA TC/260.D00/,TL/90.680D00/,PC/10416.D00/,PL/0.11719D00/, 1 EV/-1.0D+20/,D/-32.2988083D00,163.157217D00, 2 -238.0692255D00,156.5940578D00,-38.78155184D00/,DLT/1.D-05/ IF(P.LT.PL) GO TO 600 IF(P.GT.PC) GO TO 600 IF(DABS((P-PC)/PC).LT.DLT) GO TO 300 IF(DABS((P-PL)/PL).LT.DLT) GO TO 350 ERR=1.E-7 X0=90.68D00 X1=260.D00 X3=X1 IC=0 F3=0. F4=0. DO 50 K=1,5 MR=0.1D00*DBLE(K) F3=F3+D(K)*(X0/TL-1.D00)**MR 50 F4=F4+D(K)*(X1/TL-1.D00)**MR F0=DLOG(P/PL)-F3 F1=DLOG(P/PL)-F4 100 IC=IC+1 X2=(X0+X1)/2.D00 F5=0. DO 110 K=1,5 MR=0.1D00*DBLE(K) 110 F5=F5+D(K)*(X2/TL-1.D00)**MR F2=DLOG(P/PL)-F5 IF(DABS(X2-X3).LE.ERR) GO TO 400 X3=X2 IF(F0*F2.LT.0.) GO TO 200 F0=F2 X0=X2 IF(IC.GT.200) GO TO 900 GO TO 100 200 F1=F2 X1=X2 IF(IC.GT.200) GO TO 900 GO TO 100 300 F69CH4=TC-273.15D00 RETURN 350 F69CH4=TL-273.15D00 RETURN 400 F69CH4=X2-273.15D00 RETURN 600 F69CH4=-1.0E+20 RETURN 900 F69CH4=EV RETURN END C *** TPV(P,V) TEMPERATURE DOUBLE PRECISION FUNCTION F70CH4(P,V) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION N(32),X(32) DATA TC/190.555D00/,LC/162.19D00/,ALFA/-0.98113911D00/, 1 R/518.25095D00/,ERR/1.D-07/,PC/45.95001D00/ IF(P.GE.0.11719D00.AND.P.LE.PC) GO TO 50 40 IF(P.GE.0.11719D00.AND.P.LT.450.D00) GO TO 100 IF(P.GE.450.D00.AND.P.LE.10000.D00) GO TO 120 GO TO 900 50 TS=F40CH4(P) V0=F49CH4(P) V1=F50CH4(P) IF(V.LT.V0.OR.V.GT.V1) GO TO 40 F70CH4=TS RETURN 100 TL=F69CH4(P) TCC=620.D00-273.15D00 X0=TL+273.15D00 X1=TCC+273.15D00 X3=X1 GO TO 150 120 TL=F69CH4(P) TCC=470.D00-273.15D00 X0=TL+273.15D00 X1=TCC+273.15D00 X3=X1 150 V0=F51CH4(P,TL ) V1=F51CH4(P,TCC) IF(V.LT.V0.OR.V.GT.V1) GO TO 900 CALL S04CH4(N) LO=1.D00/V OM=LO/LC T=TL CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 180 K=1,32 180 VPT=VPT+N(K)*X(K) F0=P*100000.D00-LO*R*X0*(1.D00+VPT) T=TCC CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 200 K=1,32 200 VPT=VPT+N(K)*X(K) F1=P*100000.D00-LO*R*X1*(1.D00+VPT) 250 X2=(X0+X1)/2.D00 T=X2-273.15D00 CALL S09CH4(T,OM,X,TC,ALFA) VPT=0. DO 300 K=1,32 300 VPT=VPT+N(K)*X(K) F2=P*100000.D00-LO*R*X2*(1.D00+VPT) IF(DABS(X2-X3).LT.ERR) GO TO 400 X3=X2 IF((F0*F2).LT.0.) GO TO 350 F0=F2 X0=X2 GO TO 250 350 F1=F2 X1=X2 GO TO 250 400 F70CH4=X2-273.15D00 RETURN 900 F70CH4=-1.0E+20 RETURN END C *** HPS(P,S) SPECIFIC ENTHALPY DOUBLE PRECISION FUNCTION F71CH4(P,S) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA PC/45.95001D00/ IF(P.GE.0.11719D00.AND.P.LE.PC) GO TO 50 40 IF(P.GE.0.11719D00.AND.P.LT.450.D00) GO TO 100 IF(P.GE.450.D00.AND.P.LE.10000.D00) GO TO 120 GO TO 900 50 S0=F33CH4(P) S1=F34CH4(P) IF(S.LT.S0.OR.S.GT.S1) GO TO 40 X=(S-S0)/(S1-S0) H0=F23CH4(P) H1=F24CH4(P) F71CH4=H0+X*(H1-H0) RETURN 100 TL=F69CH4(P) TCC=620.D00-273.15D00 GO TO 150 120 TL=F69CH4(P) TCC=470.D00-273.15D00 150 SMIN=F35CH4(P,TL) SMAX=F35CH4(P,TCC) IF(S.LT.SMIN.OR.S.GT.SMAX) GO TO 900 T=F65CH4(P,S) IF(T.EQ.-1.0E+20.OR.S.EQ.-1.0E+20) GO TO 900 F71CH4=F25CH4(P,T) RETURN 900 F71CH4=-1.0E+20 RETURN END C *** CVPDD(P) SPECIFIC HEAT CAPACITY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F76CH4(P) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ IF(P.LT.0.11719D00.OR.P.GT.45.95001D00) GO TO 900 VV=F50CH4(P) IF(VV.EQ.-1.0E+20) GO TO 900 LO=1.D00/VV T=F40CH4(P) IF(T.EQ.-1.0E+20) GO TO 900 CALL S01CH4(T,CID) CID=CID*1000.D00/16.043D00 CALL S13CH4(T,LO,F1,F2,F3) F76CH4=CID-R-R*F1 RETURN 900 F76CH4=-1.0E+20 RETURN END C *** CVPT(P,T) ISOCHORIC SPECIFIC HEAT DOUBLE PRECISION FUNCTION F77CH4(P,T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION N(32),XC(32) DATA ALFA/-0.98113911D00/,TC/190.555D00/,LC/162.19D00/, * R/518.25095D00/ TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LE.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.197.86D00)) GO TO 100 GO TO 900 100 CALL S04CH4(N) TM=T+273.15D00 S=F51CH4(P,T) IF(S.EQ.-1.0E+20) GO TO 900 RO=(1.0D00/S) TAW=TC/TM OM=RO/LC Y1=0. F1=0. CALL S10CH4(XC,OM,ALFA,TAW) DO 10 K=1,32 10 Y1=Y1+N(K)*XC(K) OM=0. Y2=0. CALL S10CH4(XC,OM,ALFA,TAW) DO 12 K=1,32 12 Y2=Y2+N(K)*XC(K) F1=Y1-Y2 CV1=-R*F1 CALL S01CH4(T,CID) CID=CID*1000.D00/16.043D00 F77CH4=CID-R+CV1 RETURN 900 F77CH4=-1.0E+20 RETURN END C *** CVTDD(T) SPECIFIC HEAT CAPACITY OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F78CH4(T) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DATA R/518.25095D00/ TM=T+273.15D00 VV=F54CH4(T) IF(VV.EQ.-1.0E+20) GO TO 900 LO=1.D00/VV CALL S01CH4(T,CID) CID=CID*1000.D00/16.043D00 CALL S13CH4(T,LO,F1,F2,F3) F78CH4=CID-R-R*F1 RETURN 900 F78CH4=-1.0E+20 RETURN END C *** PRPT(P,T) PRANDTL NUMBER DOUBLE PRECISION FUNCTION F81CH4(P,T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) TA=T+273.15D00 IF(TA.LT.298.15D00.OR.TA.GT.423.15D00) GO TO 900 IF(TA.GE.298.15D00.AND.TA.LE.423.15D00 & .AND.P.GE.1.D00.AND.P.LE.500.D00) GO TO 100 GO TO 900 100 CP=F18CH4(P,T) IF(CP.EQ.-1.0E+20) GO TO 900 MU=F13CH4(P,T) IF(MU.EQ.-1.0E+20) GO TO 900 LM=F8CH4(P,T) IF(LM.EQ.-1.0E+20) GO TO 900 F81CH4=(CP*MU)/LM RETURN 900 F81CH4=-1.0E+20 RETURN END C *** AKPT(P,T) ADIABATIC EXPONENT DOUBLE PRECISION FUNCTION F82CH4(P,T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 LOO=F51CH4(P,T) IF(LOO.EQ.-1.0E+20) GO TO 900 LO=1.D00/LOO CP=F18CH4(P,T) IF(CP.EQ.-1.0E+20) GO TO 900 CV=F77CH4(P,T) IF(CV.EQ.-1.0E+20) GO TO 900 CALL S14CH4(T,LO,DPDL) VPT=F51CH4(P,T) IF(VPT.EQ.-1.0E+20) GO TO 900 F82CH4=((CP/CV)*DPDL)/(P*1.0D05*VPT) RETURN 900 F82CH4=-1.0E+20 RETURN END C *** WPT(P,T) SONIC VELOCITY DOUBLE PRECISION FUNCTION F83CH4(P,T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 LOO=F51CH4(P,T) IF(LOO.EQ.-1.0E+20) GO TO 900 LO=1.D00/LOO CP=F18CH4(P,T) IF(CP.EQ.-1.0E+20) GO TO 900 CV=F77CH4(P,T) IF(CV.EQ.-1.0E+20) GO TO 900 CALL S14CH4(T,LO,DPDL) W2=(CP/CV)*DPDL F83CH4=DSQRT(W2) RETURN 900 F83CH4=-1.0E+20 RETURN END C *** BSPT(P,T) ADIABATIC COMPRESSIBILITY DOUBLE PRECISION FUNCTION F90CH4(P,T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 VV=F51CH4(P,T) IF(VV.EQ.-1.0E+20) GO TO 900 WC=F83CH4(P,T) IF(WC.EQ.-1.0E+20) GO TO 900 BBS=VV/(WC**2) F90CH4=BBS RETURN 900 F90CH4=-1.0E+20 RETURN END C *** BTPT(P,T) ISOTHERMAL COMPRESSIBILITY DOUBLE PRECISION FUNCTION F91CH4(P,T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 CP=F18CH4(P,T) IF(CP.EQ.-1.0E+20) GO TO 900 CV=F77CH4(P,T) IF(CV.EQ.-1.0E+20) GO TO 900 BS=F90CH4(P,T) IF(BS.EQ.-1.0E+20) GO TO 900 F91CH4=(CP/CV)*BS RETURN 900 F91CH4=-1.0E+20 RETURN END C *** BPPT(P,T) VOLUMETRIC COEFFICIENT OF EXPANSION DOUBLE PRECISION FUNCTION F92CH4(P,T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) DATA RR/8.3143D00/,R/518.25095D00/ TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 VV=F51CH4(P,T) IF(VV.EQ.-1.0E+20) GO TO 900 LO=1.0D00/VV CP=F18CH4(P,T) IF(CP.EQ.-1.0E+20) GO TO 900 CV=F77CH4(P,T) IF(CV.EQ.-1.0E+20) GO TO 900 TM=T+273.15D00 CALL S15CH4(T,LO,DPDT) DVDT=(CP-CV)/(TM*DPDT) F92CH4=(1.0D00/VV)*DVDT RETURN 900 F92CH4=-1.0E+20 RETURN END C *** BVPT(P,T) PRESSURE COEFFICIENT DOUBLE PRECISION FUNCTION F93CH4(P,T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 VV=F51CH4(P,T) IF(VV.EQ.-1.0E+20) GO TO 900 LO=1.0D00/VV CALL S15CH4(T,LO,DPDT) F93CH4=DPDT/(P*1.0D05) RETURN 900 F93CH4=-1.0E+20 RETURN END C *** AJTPT(P,T) JOULE-THOMSON COEFFICIENT DOUBLE PRECISION FUNCTION F94CH4(P,T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) DATA RR/8.3143D00/,R/518.25095D00/ TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 VV=F51CH4(P,T) IF(VV.EQ.-1.0E+20) GO TO 900 BP=F92CH4(P,T) IF(BP.EQ.-1.0E+20) GO TO 900 VT=BP*VV TM=T+273.15D00 CP=F18CH4(P,T) IF(CP.EQ.-1.0E+20) GO TO 900 F94CH4=(TM*VT-VV)/CP RETURN 900 F94CH4=-1.0E+20 RETURN END C *** GAMPT(P,T) RATIO OF SPECIFIC HEATS DOUBLE PRECISION FUNCTION F95CH4(P,T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) TP=F69CH4(P) IF(TP.EQ.-1.0E+20) GO TO 900 IF((P.GE.0.11719D00.AND.P.LT.450.D00) & .AND.(T.GE.TP.AND.T.LT.346.86D00)) GO TO 100 IF((P.GE.450.D00.AND.P.LE.10000.D00) & .AND.(T.GE.TP.AND.T.LE.196.86D00)) GO TO 100 GO TO 900 100 CP=F18CH4(P,T) IF(CP.EQ.-1.0E+20) GO TO 900 CV=F77CH4(P,T) IF(CV.EQ.-1.0E+20) GO TO 900 F95CH4=CP/CV RETURN 900 F95CH4=-1.0E+20 RETURN END C *** GAMPDD(P) RATIO OF SPECIFIC HEATS OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F96CH4(P) IMPLICIT DOUBLE PRECISION (A-H,L-Z) IF(P.LT.0.11719D00.OR.P.GT.45.95001D00) GO TO 900 CPDD=F17CH4(P) IF(CPDD.EQ.-1.0E+20) GO TO 900 CVDD=F76CH4(P) IF(CVDD.EQ.-1.0E+20) GO TO 900 F96CH4=CPDD/CVDD RETURN 900 F96CH4=-1.0E+20 RETURN END C *** GAMTDD(T) RATIO OF SPECIFIC HEATS OF SATURATED VAPOR DOUBLE PRECISION FUNCTION F97CH4(T) IMPLICIT DOUBLE PRECISION (A-H,L-Z) CPDD=F20CH4(T) IF(CPDD.EQ.-1.0E+20) GO TO 900 CVDD=F78CH4(T) IF(CVDD.EQ.-1.0E+20) GO TO 900 F97CH4=CPDD/CVDD RETURN 900 F97CH4=-1.0E+20 RETURN END C F98 + PSEUDO BOILING POINT AT P DOUBLE PRECISION FUNCTION F98CH4(P) IMPLICIT DOUBLE PRECISION (A-H, O-Z) DIMENSION T(2),C(2),TL(3),TR(3),CL(3),CR(3) P1=F21CH4('P') PP=DABS((P-P1)/P1) T1=F21CH4('T') IF (PP.LT.1.0D-5) THEN F98CH4=T1 RETURN ENDIF IF (P.LT.P1.OR.P.GT.500.001D00) THEN F98CH4=-1.0E+20 RETURN ENDIF T2=0.85*T1 P2=F30CH4(T2) TM0=T1+(T1-T2)*(P-P1)/(P1-P2) C-----TM0 KINJICHI TC=T1 T(1)=TM0 WRITE(6,901) TM0 901 FORMAT(1H ,' +++++ TM0 : ',G15.7) IF (P.GT.400.0) T(1)=-30.0 150 EPS=1.0D-7 DEL=T1*0.05 IREP=0 IREM=5000 KCONT=0 ICONT=0 C(1)=F18CH4(P,T(1)) T(2)=T(1)-DEL C(2)=F18CH4(P,T(2)) 1000 RINC=C(2)-C(1) IF(RINC.GT.0.3)THEN GOTO 1500 ELSE T(2)=T(1) C(2)=C(1) T(1)=T(1)-DEL C(1)=F18CH4(P,T(1)) GOTO 1000 ENDIF 1500 C(1)=-C(1) C(2)=-C(2) 2000 IREP=IREP+1 IF(IREP.GT.IREM) GO TO 8000 TT=T(2)+1.3*(T(2)-T(1)) CC=-F18CH4(P,TT) 3000 CONV=DABS((CC-C(2))/CC) IF(CONV.LT.EPS) THEN F98CH4=TT RETURN ENDIF 4000 DEC=C(1)-CC ICONT=ICONT+1 IF(DEC.GE.0.0) THEN T(1)=TT C(1)=CC ELSE IF (ICONT.GT.5) GO TO 6000 TT=(TT+T(2))*0.5 CC=-F18CH4(P,TT) GOTO 4000 ENDIF 5000 DEC=C(1)-C(2) IF(DEC.LT.0.0) THEN TT=T(1) CC=C(1) T(1)=T(2) C(1)=C(2) T(2)=TT C(2)=CC ENDIF GOTO 2000 6000 TA=T(1) TB=TT IF (TB.LT.TA) THEN TA=TT TB=T(1) ENDIF TC=TA+0.5*(TB-TA) CA=F18CH4(P,TA) CB=F18CH4(P,TB) 6050 KCONT=KCONT+1 IF (KCONT.GT.IREM) GO TO 8000 DELT=DABS((TA-TB)/TA) IF (DELT.LT.EPS) GO TO 7000 CC=F18CH4(P,TC) DTA=(TC-TA)*0.3 TL(1)=TA TL(2)=TC-DTA TL(3)=TC DTB=(TB-TC)*0.3 TR(1)=TC TR(2)=TC+DTB TR(3)=TB CL(1)=CA CL(3)=CC CR(1)=CC CR(3)=CB CL(2)=F18CH4(P,TL(2)) CR(2)=F18CH4(P,TR(2)) CMXL=CL(1) ML=1 DO 6120 I=2,3 IF(CL(I).GT.CMXL) THEN CMXL=CL(I) ML=I ENDIF 6120 CONTINUE CMXR=CR(1) MR=1 DO 6130 I=2,3 IF(CR(I).GT.CMXR) THEN CMXR=CR(I) MR=I ENDIF 6130 CONTINUE IF(CMXL.GT.CMXR) THEN IF(ML.EQ.1) THEN TA=TL(1)-DTA CA=F18CH4(P,TA) ELSE TA=TL(ML-1) CA=CL(ML-1) ENDIF IF(ML.EQ.3) THEN TB=TR(2) CB=CR(2) ELSE TB=TL(ML+1) CB=CL(ML+1) ENDIF TC=TL(ML) CC=CL(ML) ELSE IF(MR.EQ.1) THEN TA=TL(2) CA=CL(2) ELSE TA=TR(MR-1) CA=CR(MR-1) ENDIF IF(MR.EQ.3) THEN TB=TR(3)+DTB CB=F18CH4(P,TB) ELSE TB=TR(MR+1) CB=CR(MR+1) ENDIF 6135 TC=TR(MR) CC=CR(MR) ENDIF GO TO 6050 7000 F98CH4=TC RETURN 8000 F98CH4=-1.0E+10 RETURN END C******************************************************************** C* ******************************** * C* * FUNCTION FOR SETTING UNITS * * C* ******************************** * C******************************************************************** C REAL FUNCTION G98CH4(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 G98CH4=P*PBAR RETURN END REAL FUNCTION G99CH4(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 G99CH4=T-T0K RETURN END C C#################################################################### C******************************************************************** C* **************** * C* * SUBROUTINE * * C* **************** * C******************************************************************** C C *** CID *** SUBROUTINE S01CH4(T,CID) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION F(10) DATA F/0.269386063023D01,-0.213367335398D01,0.799266772081D00, 1 -0.160476700181D00,0.170796753887D-01,-0.785578368269D-03, 2 0.855930945735D-07,-0.145719286035D-10,0.918971501008D00, 3 2000.D00/,RR/8.3143D00/,TL/90.68D00/,TC/620.D00/, 4 DLT/1.D-05/,CIDL/33.27D00/ TM=T+273.15D00 IF(DABS((TM-TL)/TL).LT.DLT) GO TO 350 IF(TM.LT.TL) GO TO 600 IF(TM.GT.TC) GO TO 600 U=F(10)/TM F1=0. F2=0. F3=0. DO 100 J=1,6 RM=DBLE(J)/3.D00 100 F1=F1+F(J)*TM**RM DO 200 K=7,8 200 F2=F2+F(K)*TM**(K-4) F3=F(9)*(U**2*DEXP(U))/((DEXP(U)-1.D00)**2) FT=F1+F2+F3 CID=FT*4.D00*RR RETURN 350 CID=CIDL RETURN 600 CID=-1.0E+20 RETURN END C **** SID **** SUBROUTINE S02CH4(T,SID) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION F(10) DATA F/0.269386063023D01,-0.213367335398D01,0.799266772081D00, 1 -0.160476700181D00,0.170796753887D-01,-0.785578368269D-03, 2 0.855930945735D-07,-0.145719286035D-10,0.918971501008D00, 3 2000.D00/,DLT/1.D-05/, 4 RR/8.3143D00/,TL/90.68D00/,SIDL/-40.04D00/, 5 TC/620.D00/ TM=T+273.15D00 TT=298.15D00 IF(DABS((TM-TL)/TL).LT.DLT) GO TO 350 IF(TM.LT.TL) GO TO 600 IF(TM.GT.TC) GO TO 600 U=F(10)/TM U1=F(10)/TT F1=0. F2=0. F3=0. F4=0. F5=0. DO 100 J=1,6 RJ=DBLE(J) RM=RJ/3.0D00 F1=F1+3.D00*F(J)*(TM**(RM))/RJ 100 F4=F4+3.D00*F(J)*(TT**(RM))/RJ F1=F1-F4 DO 200 J=7,8 J4=J-4 F2=F2+F(J)*(TM**J4)/DBLE(J4) 200 F5=F5+F(J)*(TT**J4)/DBLE(J4) F2=F2-F5 M1=U/(DEXP(U)-1.D00)-DLOG(1.D00-1.D00/DEXP(U)) M2=U1/(DEXP(U1)-1.D00)-DLOG(1.D00-1.D00/DEXP(U1)) F3=F(9)*(M1-M2) FT=F1+F2+F3 SID=FT*4.D00*RR RETURN 350 SID=SIDL RETURN 600 SID=-1.0E+20 RETURN END C **** HID **** SUBROUTINE S03CH4(T,HID) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION F(10) DATA F/0.269386063023D01,-0.213367335398D01,0.799266772081D00, 1 -0.160476700181D00,0.170796753887D-01,-0.785578368269D-03, 2 0.855930945735D-07,-0.145719286035D-10,0.918971501008D00, 3 2000.D00/,TL/90.68D00/,TC/620.D00/, 4 DLT/1.D-05/,HIDL/-7015.6D00/, 5 RR/8.3143D00/ TM=T+273.15D00 IF(DABS((TM-TL)/TL).LT.DLT) GO TO 350 IF(TM.LT.TL) GO TO 600 IF(TM.GT.TC) GO TO 600 TT=298.15D00 U=F(10)/TM U1=F(10)/TT F1=0. F2=0. F3=0. F4=0. F5=0. DO 100 J=1,6 RM=DBLE(J)/3.D00+1.D00 F1=F1+F(J)*(TM**RM)/RM 100 F4=F4+F(J)*(TT**RM)/RM F1=F1-F4 DO 200 K=7,8 K3=K-3 F2=F2+F(K)*(TM**(K3))/DBLE(K3) 200 F5=F5+F(K)*(TT**(K3))/DBLE(K3) F2=F2-F5 F3=F(9)*U*TM/(DEXP(U)-1.D00) F6=F(9)*U1*TT/(DEXP(U1)-1.D00) F3=F3-F6 FT=F1+F2+F3 HID=FT*4.D00*RR RETURN 350 HID=HIDL RETURN 600 HID=-1.0E+20 RETURN END C *** NI *** SUBROUTINE S04CH4(N) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION N(32) N(1)=-0.133485595546D00 N(2)=2.57395483665D00 N(3)=-4.21259560708D00 N(4)=1.21838193459D00 N(5)=-0.567664713645D00 N(6)=0.141357820610D00 N(7)=0.218272994555D00 N(8)=-1.67854271263D00 N(9)=11.9046702802D00 N(10)=-0.055049624997D00 N(11)=0.222991427494D00 N(12)=0.989983917221D00 N(13)=0.0895580146022D00 N(14)=-0.408865640150D00 N(15)=-1.35937683339D00 N(16)=0.147116126108D00 N(17)=-0.0135078041807D00 N(18)=0.214314159875D00 N(19)=-0.0359787643676D00 N(20)=-9.19269130423D00 N(21)=-1.36468925696D00 N(22)=-11.669982483D00 N(23)=0.485346197864D00 N(24)=-3.3840871158D00 N(25)=0.16922194059D00 N(26)=-1.51553322986D00 N(27)=-0.0806250313879D00 N(28)=-0.0369326536783D00 N(29)=0.0528555059265D00 N(30)=-0.0478198692008D00 N(31)=-0.00692834320138D00 N(32)=0.00057222052999D00 RETURN END C *** XU *** SUBROUTINE S05CH4(XU,OM,ALFA,TAW) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION A(6),XU(32) E=DEXP(ALFA*OM**2.0) A(1)=1.D00 A(2)=OM**2.-A(1)/ALFA A(3)=OM**4.-2.D00*A(2)/ALFA A(4)=OM**6-3.D00*A(3)/ALFA A(5)=OM**8.-4.D00*A(4)/ALFA A(6)=OM**10.-5.D00*A(5)/ALFA XU(1)=OM XU(2)=OM*TAW**0.5 XU(3)=OM*TAW XU(4)=OM*TAW**2. XU(5)=OM*TAW**3. XU(6)=OM**2./2.D00 XU(7)=OM**2.*TAW/2.D00 XU(8)=OM**2.*TAW**2./2.D00 XU(9)=OM**2.*TAW**3./2.D00 XU(10)=OM**3./3.D00 XU(11)=OM**3.*TAW/3.D00 XU(12)=OM**3.*TAW**2./3.D00 XU(13)=OM**4.*TAW/4.D00 XU(14)=OM**5.*TAW**2./5.D00 XU(15)=OM**5.*TAW**3./5.D00 XU(16)=OM**6.*TAW**2./6.D00 XU(17)=OM**7.*TAW**2./7.D00 XU(18)=OM**7.*TAW**3./7.D00 XU(19)=OM**8.*TAW**3./8.D00 XU(20)=A(1)*TAW**3.*E/(2.D00*ALFA) XU(21)=A(1)*TAW**4.*E/(2.D00*ALFA) XU(22)=A(2)*TAW**3.*E/(2.D00*ALFA) XU(23)=A(2)*TAW**5.*E/(2.D00*ALFA) XU(24)=A(3)*TAW**3.*E/(2.D00*ALFA) XU(25)=A(3)*TAW**4.*E/(2.D00*ALFA) XU(26)=A(4)*TAW**3.*E/(2.D00*ALFA) XU(27)=A(4)*TAW**5.*E/(2.D00*ALFA) XU(28)=A(5)*TAW**3.*E/(2.D00*ALFA) XU(29)=A(5)*TAW**4.*E/(2.D00*ALFA) XU(30)=A(6)*TAW**3.*E/(2.D00*ALFA) XU(31)=A(6)*TAW**4.*E/(2.D00*ALFA) XU(32)=A(6)*TAW**5.*E/(2.D00*ALFA) RETURN END C *** XS *** SUBROUTINE S06CH4(XS,OM,ALFA,TAW) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION A(6),XS(32) E=DEXP(OM**2.*ALFA) A(1)=1.D00 A(2)=OM**2.-A(1)/ALFA A(3)=OM**4.-2.D00*A(2)/ALFA A(4)=OM**6.-3.D00*A(3)/ALFA A(5)=OM**8.-4.D00*A(4)/ALFA A(6)=OM**10.-5.D00*A(5)/ALFA XS(1)=OM XS(2)=OM*TAW**0.5/2.D00 XS(3)=0. XS(4)=-OM*TAW**2. XS(5)=-2.D00*OM*TAW**3. XS(6)=OM**2./2.D00 XS(7)=0. XS(8)=-OM**2.*TAW**2./2.D00 XS(9)=-OM**2.*TAW**3. XS(10)=OM**3./3.D00 XS(11)=0. XS(12)=-OM**3.*TAW**2./3.D00 XS(13)=0. XS(14)=-OM**5.*TAW**2./5.D00 XS(15)=-2.D00*OM**5.*TAW**3./5.D00 XS(16)=-OM**6.*TAW**2./6.D00 XS(17)=-OM**7.*TAW**2./7.D00 XS(18)=-2.D00*OM**7.*TAW**3./7.D00 XS(19)=-OM**8.*TAW**3./4.D00 XS(20)=-2.D00*A(1)*TAW**3.*E/(2.D00*ALFA) XS(21)=-3.D00*A(1)*TAW**4.*E/(2.D00*ALFA) XS(22)=-2.D00*A(2)*TAW**3.*E/(2.D00*ALFA) XS(23)=-4.D00*A(2)*TAW**5.*E/(2.D00*ALFA) XS(24)=-2.D00*A(3)*TAW**3.*E/(2.D00*ALFA) XS(25)=-3.D00*A(3)*TAW**4.*E/(2.D00*ALFA) XS(26)=-2.D00*A(4)*TAW**3.*E/(2.D00*ALFA) XS(27)=-4.D00*A(4)*TAW**5.*E/(2.D00*ALFA) XS(28)=-2.D00*A(5)*TAW**3.*E/(2.D00*ALFA) XS(29)=-3.D00*A(5)*TAW**4.*E/(2.D00*ALFA) XS(30)=-2.D00*A(6)*TAW**3.*E/(2.D00*ALFA) XS(31)=-3.D00*A(6)*TAW**4.*E/(2.D00*ALFA) XS(32)=-4.D00*A(6)*TAW**5.*E/(2.D00*ALFA) RETURN END C *** XLO *** SUBROUTINE S07CH4(XLO,OM,ALFA,TAW) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION XLO(32) A=2.D00*ALFA*OM**2. E=DEXP(ALFA*OM**2.) XLO(1)=2.D00*OM XLO(2)=2.D00*OM*TAW**0.5 XLO(3)=2.D00*OM*TAW XLO(4)=2.D00*OM*TAW**2. XLO(5)=2.D00*OM*TAW**3. XLO(6)=3.D00*OM**2. XLO(7)=3.D00*OM**2.*TAW XLO(8)=3.D00*OM**2.*TAW**2. XLO(9)=3.D00*OM**2.*TAW**3. XLO(10)=4.D00*OM**3. XLO(11)=4.D00*OM**3.*TAW XLO(12)=4.D00*OM**3.*TAW**2. XLO(13)=5.D00*OM**4.*TAW XLO(14)=6.D00*OM**5.*TAW**2. XLO(15)=6.D00*OM**5.*TAW**3. XLO(16)=7.D00*OM**6.*TAW**2. XLO(17)=8.D00*OM**7.*TAW**2. XLO(18)=8.D00*OM**7.*TAW**3. XLO(19)=9.D00*OM**8.*TAW**3. XLO(20)=OM**2.*(3.D00+A)*TAW**3.*E XLO(21)=OM**2.*(3.D00+A)*TAW**4.*E XLO(22)=OM**4.*(5.D00+A)*TAW**3.*E XLO(23)=OM**4.*(5.D00+A)*TAW**5.*E XLO(24)=OM**6.*(7.D00+A)*TAW**3.*E XLO(25)=OM**6.*(7.D00+A)*TAW**4.*E XLO(26)=OM**8.*(9.D00+A)*TAW**3.*E XLO(27)=OM**8.*(9.D00+A)*TAW**5.*E XLO(28)=OM**10.*(11.D00+A)*TAW**3.*E XLO(29)=OM**10.*(11.D00+A)*TAW**4.*E XLO(30)=OM**12.*(13.D00+A)*TAW**3.*E XLO(31)=OM**12.*(13.D00+A)*TAW**4.*E XLO(32)=OM**12.*(13.D00+A)*TAW**5.*E RETURN END C *** XT *** SUBROUTINE S08CH4(XT,OM,ALFA,TAW) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION XT(32) E=DEXP(ALFA*OM**2.) XT(1)=OM XT(2)=OM*TAW**0.5/2.D00 XT(3)=0. XT(4)=-OM*TAW**2. XT(5)=-2.D00*OM*TAW**3. XT(6)=OM**2. XT(7)=0. XT(8)=-OM**2.*TAW**2. XT(9)=-2*OM**2.*TAW**3. XT(10)=OM**3. XT(11)=0. XT(12)=-OM**3.*TAW**2. XT(13)=0. XT(14)=-OM**5.*TAW**2. XT(15)=-2.D00*OM**5.*TAW**3. XT(16)=-OM**6.*TAW**2. XT(17)=-OM**7.*TAW**2. XT(18)=-2.D00*OM**7.*TAW**3. XT(19)=-2.D00*OM**8.*TAW**3. XT(20)=-2.D00*OM**2.*TAW**3.*E XT(21)=-3.D00*OM**2.*TAW**4.*E XT(22)=-2.D00*OM**4.*TAW**3.*E XT(23)=-4.D00*OM**4.*TAW**5.*E XT(24)=-2.D00*OM**6.*TAW**3.*E XT(25)=-3.D00*OM**6.*TAW**4.*E XT(26)=-2.D00*OM**8.*TAW**3.*E XT(27)=-4.D00*OM**8.*TAW**5.*E XT(28)=-2.D00*OM**10.*TAW**3.*E XT(29)=-3.D00*OM**10.*TAW**4.*E XT(30)=-2.D00*OM**12.*TAW**3.*E XT(31)=-3.D00*OM**12.*TAW**4.*E XT(32)=-4.D00*OM**12.*TAW**5.*E RETURN END C *** XI *** SUBROUTINE S09CH4(T,OM,X,TC,ALFA) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION X(32) TM=T+273.15D00 TAW=TC/TM E=DEXP(ALFA*OM**2.) X(1)=OM X(2)=OM*TAW**0.5 X(3)=OM*TAW X(4)=OM*TAW**2. X(5)=OM*TAW**3. X(6)=OM**2. X(7)=OM**2.*TAW X(8)=OM**2.*TAW**2. X(9)=OM**2.*TAW**3. X(10)=OM**3. X(11)=OM**3.*TAW X(12)=OM**3.*TAW**2. X(13)=OM**4.*TAW X(14)=OM**5.*TAW**2. X(15)=OM**5.*TAW**3. X(16)=OM**6.*TAW**2. X(17)=OM**7.*TAW**2. X(18)=OM**7.*TAW**3. X(19)=OM**8.*TAW**3. X(20)=OM**2.*TAW**3.*E X(21)=OM**2.*TAW**4.*E X(22)=OM**4.*TAW**3.*E X(23)=OM**4.*TAW**5.*E X(24)=OM**6.*TAW**3.*E X(25)=OM**6.*TAW**4.*E X(26)=OM**8.*TAW**3.*E X(27)=OM**8.*TAW**5.*E X(28)=OM**10.*TAW**3.*E X(29)=OM**10.*TAW**4.*E X(30)=OM**12.*TAW**3.*E X(31)=OM**12.*TAW**4.*E X(32)=OM**12.*TAW**5.*E RETURN END C *** XC *** SUBROUTINE S10CH4(XC,OM,ALFA,TAW) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION A(6),XC(32) E=DEXP(ALFA*OM**2.0) A(1)=1.D00 A(2)=OM**2.-A(1)/ALFA A(3)=OM**4.-2.D00*A(2)/ALFA A(4)=OM**6.-3.D00*A(3)/ALFA A(5)=OM**8.-4.D00*A(4)/ALFA A(6)=OM**10.-5.D00*A(5)/ALFA XC(1)=0. XC(2)=-OM*TAW**0.5/4.D00 XC(3)=0. XC(4)=2.D00*OM*TAW**2. XC(5)=6.D00*OM*TAW**3. XC(6)=0. XC(7)=0. XC(8)=OM**2.*TAW**2. XC(9)=3.D00*OM**2.*TAW**3. XC(10)=0. XC(11)=0. XC(12)=2.D00*OM**3.*TAW**2./3.D00 XC(13)=0. XC(14)=2.D00*OM**5.*TAW**2./5.D00 XC(15)=6.D00*OM**5.*TAW**3./5.D00 XC(16)=OM**6.*TAW**2./3.D00 XC(17)=2.D00*OM**7.*TAW**2./7.D00 XC(18)=6.D00*OM**7.*TAW**3./7.D00 XC(19)=3.D00*OM**8.*TAW**3./4.D00 XC(20)=6.D00*A(1)*TAW**3.*E/(2.D00*ALFA) XC(21)=12.D00*A(1)*TAW**4.*E/(2.D00*ALFA) XC(22)=6.D00*A(2)*TAW**3.*E/(2.D00*ALFA) XC(23)=20.D00*A(2)*TAW**5.*E/(2.D00*ALFA) XC(24)=6.D00*A(3)*TAW**3.*E/(2.D00*ALFA) XC(25)=12.D00*A(3)*TAW**4.*E/(2.D00*ALFA) XC(26)=6.D00*A(4)*TAW**3.*E/(2.D00*ALFA) XC(27)=20.D00*A(4)*TAW**5.*E/(2.D00*ALFA) XC(28)=6.D00*A(5)*TAW**3.*E/(2.D00*ALFA) XC(29)=12.D00*A(5)*TAW**4.*E/(2.D00*ALFA) XC(30)=6.D00*A(6)*TAW**3.*E/(2.D00*ALFA) XC(31)=12.D00*A(6)*TAW**4.*E/(2.D00*ALFA) XC(32)=20.D00*A(6)*TAW**5.*E/(2.D00*ALFA) RETURN END C **** SL **** SUBROUTINE S11CH4(T,LO,SLL) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION N(32),XS(32) DATA ALFA/-0.98113911D00/, R/518.25095D00/, TC/190.555D00/, 1 LC/162.19D00/ TM=T+273.15D00 CALL S04CH4(N) TAW=TC/TM OM=LO/LC NZ=0. CALL S06CH4(XS,OM,ALFA,TAW) DO 100 K=1,32 100 NZ=NZ+N(K)*XS(K) OM=0. NY=0. CALL S06CH4(XS,OM,ALFA,TAW) DO 110 K=1,32 110 NY=NY+N(K)*XS(K) NZ=NZ-NY SLL=-R*NZ RETURN END C **** UL **** SUBROUTINE S12CH4(T,LO,ULL) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION XU(32),XS(32),N(32) DATA ALFA/-0.98113911D00/, TC/190.555D00/, LC/162.19D00/, 1 R/518.25095D00/ CALL S04CH4(N) TM=T+273.15D00 TAW=TC/TM OM=LO/LC NY1=0. CALL S05CH4(XU,OM,ALFA,TAW) DO 10 K=1,32 10 NY1=NY1+N(K)*XU(K) OM=0. NY3=0. CALL S05CH4(XU,OM,ALFA,TAW) DO 11 K=1,32 11 NY3=NY3+N(K)*XU(K) U1=NY1-NY3 TAW=TC/TM OM=LO/LC NZ=0. CALL S06CH4(XS,OM,ALFA,TAW) DO 100 K=1,32 100 NZ=NZ+N(K)*XS(K) OM=0. NY2=0. CALL S06CH4(XS,OM,ALFA,TAW) DO 110 K=1,32 110 NY2=NY2+N(K)*XS(K) U2=NZ-NY2 ULL=R*TM*(U1-U2) RETURN END C *** CP1 *** SUBROUTINE S13CH4(T,LO,F1,F2,F3) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION N(32),XC(32),XLO(32),XT(32) DATA ALFA/-0.98113911D00/, TC/190.555D00/, LC/162.19D00/ CALL S04CH4(N) TM=T+273.15D00 TAW=TC/TM OM=LO/LC Y1=0. F1=0. CALL S10CH4(XC,OM,ALFA,TAW) DO 10 K=1,32 10 Y1=Y1+N(K)*XC(K) OM=0. Y2=0. CALL S10CH4(XC,OM,ALFA,TAW) DO 12 K=1,32 12 Y2=Y2+N(K)*XC(K) F1=Y1-Y2 TAW=TC/TM OM=LO/LC F2=0. CALL S08CH4(XT,OM,ALFA,TAW) DO 20 K=1,32 20 F2=F2+N(K)*XT(K) F2=(1.D00+F2)**2. TAW=TC/TM OM=LO/LC F3=0. CALL S07CH4(XLO,OM,ALFA,TAW) DO 30 K=1,32 30 F3=F3+N(K)*XLO(K) F3=1.D00+F3 RETURN END C *** DPDL *** SUBROUTINE S14CH4(T,LO,DPDL) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION N(32),XLO(32) DATA ALFA/-0.98113911D00/,TC/190.555D00/,LC/162.19D00/, * R/518.25095D00/ CALL S04CH4(N) TM=T+273.15D00 TAW=TC/TM OM=LO/LC Y1=0. F1=0. CALL S07CH4(XLO,OM,ALFA,TAW) DO 10 K=1,32 10 Y1=Y1+N(K)*XLO(K) F1=(1.D00+Y1) DPDL=R*TM*F1 RETURN END C *** DPDT *** SUBROUTINE S15CH4(T,LO,DPDT) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION N(32),XT(32) DATA ALFA/-0.98113911D00/,TC/190.555D00/,LC/162.19D00/, * R/518.25095D00/ CALL S04CH4(N) TM=T+273.15D00 TAW=TC/TM OM=LO/LC Y1=0. F1=0. CALL S08CH4(XT,OM,ALFA,TAW) DO 10 K=1,32 10 Y1=Y1+N(K)*XT(K) F1=(1.D00+Y1) DPDT=R*LO*F1 RETURN END C *** ANX *** SUBROUTINE S16CH4(T,LO,ANX) IMPLICIT DOUBLE PRECISION(A-H,L-Z) DIMENSION N(32),X(32) DATA ALFA/-0.98113911D00/,TC/190.555D00/,LC/162.19D00/, * R/518.25095D00/ CALL S04CH4(N) TM=T+273.15D00 TAW=TC/TM OM=LO/LC Y1=0. F1=0. CALL S09CH4(T,OM,X,TC,ALFA) DO 10 K=1,32 10 Y1=Y1+N(K)*X(K) F1=(1.D00+Y1) ANX=F1 RETURN END C C******************************************************************** C* ********************************** * C* * SUBROUTINE FOR ERROR MESSAGE * * C* ********************************** * C******************************************************************** C C *** LEVEL 1 ERROR MESSAGE *** SUBROUTINE S97CH4(FUN) COMMON/UNIT/KPA,MESS CHARACTER FUN*6,MSG*125 IF(MESS.NE.0) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR METHANE ****' WRITE(6,*) MSG END IF RETURN END C *** LEVEL 2 ERROR MESSAGE *** SUBROUTINE S98CH4(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 METHANE', & ' 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 METHANE', & ' 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 METHANE', &' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') END IF END IF RETURN END C *** LEVEL 3 ERROR MESSAGE *** SUBROUTINE S99CH4(FUN) COMMON/UNIT/KPA,MESS CHARACTER FUN*6,MSG*125 IF(MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR METHANE ****' 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