C ************************************* C * PROPATH FOR C2H4 * C * * C * CODED (FEBRUARY 1988) * C * REVISED (AUGUST 1988) * C * REVISED (MARCH 1989) * C * VERSION 7.1 * C * REVISED (JANUARY 1990) * C * VERSION 8.1 * C * REVISED (SEPTEMBER 1990) * C * BY * C * TOMOHIRO HONDA * C * FUKUOKA UNIVERSITY * C * FUKUOKA 814-01, JAPAN * C ************************************* C ************************************* C * SUPERVISOR FOR C2H4 * C ************************************* 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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(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 S99D03(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99D03(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT REAL FUNCTION AJTPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'AJTPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F94D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - AJTPT=FF RETURN END C------------------------------------------------- F82 = AKPT REAL FUNCTION AKPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'AKPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F82D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - AKPT=FF RETURN END C------------------------------------------------- F2 = ALAPP REAL FUNCTION ALAPP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'ALAPP'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F2D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - ALAPP=FF RETURN END C------------------------------------------------- F3 = ALAPT REAL FUNCTION ALAPT(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME - DATA FUN/'ALAPT'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F3D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - ALAPT=FF RETURN END C------------------------------------------------- F4 = ALHP REAL FUNCTION ALHP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'ALHP'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F4D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) 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 C--- FUNCTION NAME - DATA FUN/'ALHT'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F5D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - ALHT=FF RETURN END C------------------------------------------------- F6 = ALMPD FUNCTION ALMPD(P) CHARACTER FUN*6 DATA FUN/'ALMPD'/ CALL S99D03(FUN) ALMPD=-1.0E+30 RETURN END C------------------------------------------------- F7 = ALMPDD FUNCTION ALMPDD(P) CHARACTER FUN*6 DATA FUN/'ALMPDD'/ CALL S99D03(FUN) ALMPDD=-1.0E+30 RETURN END C------------------------------------------------- F8 = ALMPT FUNCTION ALMPT(P,T) CHARACTER FUN*6 DATA FUN/'ALMPT'/ CALL S99D03(FUN) ALMPT=-1.0E+30 RETURN END C------------------------------------------------- F9 = ALMTD FUNCTION ALMTD(T) CHARACTER FUN*6 DATA FUN/'ALMTD'/ CALL S99D03(FUN) ALMTD=-1.0E+30 RETURN END C------------------------------------------------- F10= ALMTDD FUNCTION ALMTDD(T) CHARACTER FUN*6 DATA FUN/'ALMTDD'/ CALL S99D03(FUN) ALMTDD=-1.0E+30 RETURN END C------------------------------------------------- F11 = AMUPD FUNCTION AMUPD(P) CHARACTER FUN*6 DATA FUN/'AMUPD'/ CALL S99D03(FUN) AMUPD=-1.0E+30 RETURN END C------------------------------------------------- F12 = AMUPDD FUNCTION AMUPDD(P) CHARACTER FUN*6 DATA FUN/'AMUPDD'/ CALL S99D03(FUN) AMUPDD=-1.0E+30 RETURN END C------------------------------------------------- F13 = AMUPT REAL FUNCTION AMUPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'AMUPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F13D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - AMUPT=FF RETURN END C------------------------------------------------- F14 = AMUTD FUNCTION AMUTD(T) CHARACTER FUN*6 DATA FUN/'AMUTD'/ CALL S99D03(FUN) AMUTD=-1.0E+30 RETURN END C------------------------------------------------- F15 = AMUTDD FUNCTION AMUTDD(T) CHARACTER FUN*6 DATA FUN/'AMUTDD'/ CALL S99D03(FUN) AMUTDD=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT REAL FUNCTION BSPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BSPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F90D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BSPT=FF RETURN END C------------------------------------------------- F91 = BTPT REAL FUNCTION BTPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BTPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F91D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BTPT=FF RETURN END C------------------------------------------------- F92 = BPPT REAL FUNCTION BPPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BPPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F92D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BPPT=FF RETURN END C------------------------------------------------- F93 = BVPT REAL FUNCTION BVPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BVPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F93D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BVPT=FF RETURN END C------------------------------------------------- F16 = CPPD REAL FUNCTION CPPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'CPPD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F16D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) 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 C--- FUNCTION NAME - DATA FUN/'CPPDD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F17D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) 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 C--- FUNCTION NAME - DATA FUN/'CPPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F18D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) 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 C--- FUNCTION NAME - DATA FUN/'CPTD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F19D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) 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 C--- FUNCTION NAME - DATA FUN/'CPTDD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F20D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - CPTDD=FF RETURN END C------------------------------------------------- F21 = CRP REAL FUNCTION CRP(A) CHARACTER FUN*6,A*1 REAL T0K,PBAR,FF C--- FUNCTION NAME - DATA FUN/'CRP'/ C--- SET OF UNIT - C--- FUNCTION CALL - FF = F21D03(A) C--- LEVEL 2 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ', & ' ETHYLENE WHEN A = ',A,' ****') CRP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - IF(A.EQ.'T') THEN T0K=-G99D03(0.0) FF=FF+T0K ELSE IF(A.EQ.'P') THEN PBAR=G98D03(1.0) FF=FF/PBAR END IF CRP=FF RETURN END C------------------------------------------------- F76 = CVPDD REAL FUNCTION CVPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'CVPDD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F76D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) 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 C--- FUNCTION NAME - DATA FUN/'CVPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F77D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) 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 C--- FUNCTION NAME - DATA FUN/'CVTDD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F78D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - CVTDD=FF RETURN END C------------------------------------------------- F22 = EPSPT REAL FUNCTION EPSPT(P,T) CHARACTER FUN*6 DATA FUN/'EPSPT'/ CALL S99D03(FUN) EPSPT=-1.0E+30 RETURN END C------------------------------------------------- F89 = FC C************************************************ C FUNCTION FOR FUNDDAMENTAL CONSTANTS C PROPATH VER.7.1, MAY 8, 1990 C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='28.054' WHEN A='M' C B='296.37' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=28.054 ELSE IF (A.EQ.'R') THEN FC=296.37 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR ETHYLENE WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C-------------------------------------------------- F96 = GAMPDD REAL FUNCTION GAMPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'GAMPDD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F96D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPDD=FF RETURN END C------------------------------------------------- F95 = GAMPT REAL FUNCTION GAMPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'GAMPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F95D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPT=FF RETURN END C------------------------------------------------- F97 = GAMTDD REAL FUNCTION GAMTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME - DATA FUN/'GAMTDD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F97D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMTDD=FF RETURN END C------------------------------------------------- F23 = HPD REAL FUNCTION HPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'HPD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F23D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) 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 C--- FUNCTION NAME - DATA FUN/'HPDD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F24D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - HPDD=FF RETURN END C------------------------------------------------- F71 = HPS REAL FUNCTION HPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME - DATA FUN/'HPS'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F71D03(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - HPS=FF RETURN END C------------------------------------------------- F25 = HPT REAL FUNCTION HPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'HPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F25D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) 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 REAL P,X,FF C--- FUNCTION NAME - DATA FUN/'HPX'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F26D03(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,X,'P','X',FUN) 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,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME - DATA FUN/'HTD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F27D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) 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 C--- FUNCTION NAME - DATA FUN/'HTDD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F28D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) 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 REAL T,FF C--- FUNCTION NAME - DATA FUN/'HTX'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F29D03(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,T,X,'T','X',FUN) 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='ETHYLENE' WHEN A='S' C B='C2H4' 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='ETHYLENE' ELSE IF (A.EQ.'C') THEN IDENTF='C2H4' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR ETHYLENE WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F66 = PLDT FUNCTION PLDT(T) CHARACTER FUN*6 DATA FUN/'PLDT'/ CALL S99D03(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT REAL FUNCTION PMLT(T) CHARACTER FUN*6 REAL PBAR,T,FF C--- FUNCTION NAME - DATA FUN/'PMLT'/ C--- SET OF UNIT - PBAR=G98D03(1.0) TI=G99D03(T) C--- FUNCTION CALL - FF = F68D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) PMLT=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) PMLT=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - PMLT=FF/PBAR RETURN END C------------------------------------------------- F85 = PRPD FUNCTION PRPD(P) CHARACTER FUN*6 DATA FUN/'PRPD'/ CALL S99D03(FUN) PRPD=-1.0E+30 RETURN END C------------------------------------------------- F86 = PRPDD FUNCTION PRPDD(P) CHARACTER FUN*6 DATA FUN/'PRPDD'/ CALL S99D03(FUN) PRPDD=-1.0E+30 RETURN END C------------------------------------------------- F81 = PRPT FUNCTION PRPT(P,T) CHARACTER FUN*6 DATA FUN/'PRPT'/ CALL S99D03(FUN) PRPT=-1.0E+30 RETURN END C------------------------------------------------- F87 = PRTD FUNCTION PRTD(T) CHARACTER FUN*6 DATA FUN/'PRTD'/ CALL S99D03(FUN) PRTD=-1.0E+30 RETURN END C------------------------------------------------- F88 = PRTDD FUNCTION PRTDD(T) CHARACTER FUN*6 DATA FUN/'PRTDD'/ CALL S99D03(FUN) PRTDD=-1.0E+30 RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99D03(FUN) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F30 = PST REAL FUNCTION PST(T) CHARACTER FUN*6 REAL PBAR,T,FF C--- FUNCTION NAME - DATA FUN/'PST'/ C--- SET OF UNIT - PBAR=G98D03(1.0) TI=G99D03(T) C--- FUNCTION CALL - FF = F30D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) PST=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) PST=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - PST=FF/PBAR RETURN END C------------------------------------------------- F72 = PSTD FUNCTION PSTD(T) CHARACTER FUN*6 DATA FUN/'PSTD'/ CALL S99D03(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99D03(FUN) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F31 = SIGP REAL FUNCTION SIGP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'SIGP'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F31D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) 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 C--- FUNCTION NAME - DATA FUN/'SIGT'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F32D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) 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 C--- FUNCTION NAME - DATA FUN/'SPD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F33D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) 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 C--- FUNCTION NAME - DATA FUN/'SPDD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F34D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) 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 C--- FUNCTION NAME - DATA FUN/'SPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F35D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) 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 REAL P,X,FF C--- FUNCTION NAME - DATA FUN/'SPX'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F36D03(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,X,'P','X',FUN) 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 C--- FUNCTION NAME - DATA FUN/'STD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F37D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) 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 C--- FUNCTION NAME - DATA FUN/'STDD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F38D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) 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 REAL T,FF C--- FUNCTION NAME - DATA FUN/'STX'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F39D03(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,T,X,'T','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - STX=FF RETURN END C------------------------------------------------- F67 = TLDP FUNCTION TLDP(P) CHARACTER FUN*6 DATA FUN/'TLDP'/ CALL S99D03(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP REAL FUNCTION TMLP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'TMLP'/ C--- SET OF UNIT - PI=G98D03(P) T0K=-G99D03(0.0) C--- FUNCTION CALL - FF = F69D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) TMLP=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) TMLP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - TMLP=FF+T0K RETURN END C------------------------------------------------- F64 = TPH REAL FUNCTION TPH(P,H) CHARACTER FUN*6 REAL T0K,P,H,FF C--- FUNCTION NAME - DATA FUN/'TPH'/ C--- SET OF UNIT - PI=G98D03(P) T0K=-G99D03(0.0) C--- FUNCTION CALL - FF = F64D03(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) TPH=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,H,'P','H',FUN) TPH=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - TPH=FF+T0K RETURN END C------------------------------------------------- F65 = TPS REAL FUNCTION TPS(P,S) CHARACTER FUN*6 REAL T0K,P,S,FF C--- FUNCTION NAME - DATA FUN/'TPS'/ C--- SET OF UNIT - PI=G98D03(P) T0K=-G99D03(T) C--- FUNCTION CALL - FF = F65D03(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) TPS=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,S,'P','S',FUN) TPS=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - TPS=FF+T0K RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'TPSEUP'/ C--- SET OF UNIT - PI=G98D03(P) T0K=-G99D03(0.0) C--- FUNCTION CALL - FF = F98D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) TPSEUP=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) TPSEUP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - TPSEUP=FF+T0K RETURN END C------------------------------------------------- F70 = TPV REAL FUNCTION TPV(P,V) CHARACTER FUN*6 REAL T0K,P,V,FF C--- FUNCTION NAME - DATA FUN/'TPV'/ C--- SET OF UNIT - PI=G98D03(P) T0K=-G99D03(0.0) C--- FUNCTION CALL - FF = F70D03(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) TPV=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,V,'P','V',FUN) TPV=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - TPV=FF+T0K RETURN END C------------------------------------------------- F41 = TRPL REAL FUNCTION TRPL(A) CHARACTER FUN*6,A*1 REAL T0K,PBAR,FF C--- FUNCTION NAME - DATA FUN/'TRPL'/ C--- SET OF UNIT - C--- FUNCTION CALL - FF = F41D03(A) C--- LEVEL 2 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ', & ' ETHYLENE WHEN A = ',A,' ****') TRPL=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - IF(A.EQ.'T') THEN T0K=-G99D03(0.0) FF=FF+T0K ELSE IF(A.EQ.'P') THEN PBAR=G98D03(1.0) FF=FF/PBAR END IF TRPL=FF RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99D03(FUN) TSBP=-1.0E+30 RETURN END C------------------------------------------------- F40 = TSP REAL FUNCTION TSP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'TSP'/ C--- SET OF UNIT - PI=G98D03(P) T0K=-G99D03(0.0) C--- FUNCTION CALL - FF = F40D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) TSP=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) TSP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - TSP=FF+T0K RETURN END C------------------------------------------------- F74 = TSPD FUNCTION TSPD(P) CHARACTER FUN*6 DATA FUN/'TSPD'/ CALL S99D03(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99D03(FUN) TSPDD=-1.0E+30 RETURN END C------------------------------------------------- F42 = UPD REAL FUNCTION UPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'UPD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F42D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) 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 C--- FUNCTION NAME - DATA FUN/'UPDD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F43D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - UPDD=FF RETURN END C------------------------------------------------- F79 = UPS REAL FUNCTION UPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME - DATA FUN/'UPS'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F79D03(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - UPS=FF RETURN END C------------------------------------------------- F44 = UPT REAL FUNCTION UPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'UPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F44D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) 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 REAL P,X,FF C--- FUNCTION NAME - DATA FUN/'UPX'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F45D03(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,X,'P','X',FUN) 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 C--- FUNCTION NAME - DATA FUN/'UTD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F46D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) 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 C--- FUNCTION NAME - DATA FUN/'UTDD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F47D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) 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 REAL T,FF C--- FUNCTION NAME - DATA FUN/'UTX'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F48D03(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,T,X,'T','X',FUN) 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 C--- FUNCTION NAME - DATA FUN/'VPD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F49D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) 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 C--- FUNCTION NAME - DATA FUN/'VPDD'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F50D03(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - VPDD=FF RETURN END C------------------------------------------------- F80 = VPS REAL FUNCTION VPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME - DATA FUN/'VPS'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F80D03(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - VPS=FF RETURN END C------------------------------------------------- F51 = VPT REAL FUNCTION VPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'VPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F51D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(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 REAL P,X,FF C--- FUNCTION NAME - DATA FUN/'VPX'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F52D03(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,X,'P','X',FUN) 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 C--- FUNCTION NAME - DATA FUN/'VTD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F53D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) 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 C--- FUNCTION NAME - DATA FUN/'VTDD'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F54D03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(2,T,T,'T','T',FUN) 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 REAL T,FF C--- FUNCTION NAME - DATA FUN/'VTX'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F55D03(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,T,X,'T','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - VTX=FF RETURN END C------------------------------------------------- F83 = WPT REAL FUNCTION WPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'WPT'/ C--- SET OF UNIT - PI=G98D03(P) TI=G99D03(T) C--- FUNCTION CALL - FF = F83D03(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - WPT=FF RETURN END C------------------------------------------------- F56 = XPH REAL FUNCTION XPH(P,H) CHARACTER FUN*6 REAL P,H,FF C--- FUNCTION NAME - DATA FUN/'XPH'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F56D03(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,H,'P','H',FUN) 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 REAL P,S,FF C--- FUNCTION NAME - DATA FUN/'XPS'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F57D03(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,S,'P','S',FUN) 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 REAL P,U,FF C--- FUNCTION NAME - DATA FUN/'XPU'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F58D03(PI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,U,'P','U',FUN) 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 REAL P,V,FF C--- FUNCTION NAME - DATA FUN/'XPV'/ C--- SET OF UNIT - PI=G98D03(P) C--- FUNCTION CALL - FF = F59D03(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,P,V,'P','V',FUN) 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 REAL T,H,FF C--- FUNCTION NAME - DATA FUN/'XTH'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F60D03(TI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,T,H,'T','H',FUN) 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 REAL T,S,FF C--- FUNCTION NAME - DATA FUN/'XTS'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F61D03(TI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,T,S,'T','S',FUN) 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 REAL T,U,FF C--- FUNCTION NAME - DATA FUN/'XTU'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F62D03(TI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,T,U,'T','U',FUN) 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 REAL T,V,FF C--- FUNCTION NAME - DATA FUN/'XTV'/ C--- SET OF UNIT - TI=G99D03(T) C--- FUNCTION CALL - FF = F63D03(TI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D03(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D03(3,T,V,'T','V',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - XTV=FF RETURN END C *** FUNCTION FOR SETTING UNITS **** C G98 *** FUNCTION G98D03(P) REAL P,G98D03 DOUBLE PRECISION PBAR INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF(KPA.EQ.1) THEN PBAR=1.0D+00 ELSE IF(KPA.EQ.2) THEN PBAR=1.0D+00 ELSE IF(KPA.EQ.3) THEN PBAR=1.0D-05 ELSE PBAR=1.0D-05 END IF G98D03=REAL(DBLE(P)*PBAR) RETURN END C G99 *** FUNCTION G99D03(T) REAL T,G99D03 DOUBLE PRECISION T0K INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF(KPA.EQ.1) THEN T0K=0.0D+00 ELSE IF(KPA.EQ.2) THEN T0K=273.15D+00 ELSE IF(KPA.EQ.3) THEN T0K=0.0D+00 ELSE T0K=273.15D+00 END IF G99D03=REAL(DBLE(T)-T0K) RETURN END C ******* SUBROUTINE FOR ERROR MESSAGE ******* C *** LEVEL 1 ERROR MESSAGE - SUBROUTINE S97D03(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ETHYLENE ****' WRITE(6,*) MSG ENDIF RETURN END C *** LEVEL 2 ERROR MESSAGE - SUBROUTINE S98D03(IPT,P,T,N1,N2,FUN) CHARACTER FUN*6,N1*1,N2*1 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS 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 ETHYLENE', & ' WHEN P =',1PE14.7,' ****') C--- FUN(T) TYPE ELSEIF (IPT.EQ.2) THEN WRITE(6,6020) FUN,T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ETHYLENE', & ' 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 ETHYLENE', & ' WHEN ',A1,'=',1PE14.7,' AND ',A1,'=',1PE14.7,' ****') ENDIF ENDIF RETURN END C *** LEVEL 3 ERROR MESSAGE - SUBROUTINE S99D03(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR ETHYLENE ****' WRITE(6,100) MSG 100 FORMAT(1H ,5X,A) ENDIF RETURN END C ********************************* C * ETHYLENE FUNCTION VER.5.1 * C * APPEND F90-F97 * C * (SEPTEMBER 1990) * C ********************************* C02 + LAPLACE COEFFICIENT M AT P BAR FUNCTION F2D03(P) INTEGER G91D03 IG91=G91D03(P) IF (IG91.EQ.0) THEN T=F40D03(P) F2D03=F3D03(T) ELSEIF (IG91.EQ.1) THEN F2D03=0.0 ELSE F2D03=-1.0E+20 ENDIF RETURN END C03 + LAPLACE COEFFICIENT M AT T C FUNCTION F3D03(T) INTEGER G92D03 IG92=G92D03(T) IF (IG92.EQ.0) THEN VL=F53D03(T) VG=F54D03(T) RV=VL*VG/(VG-VL) SIG=G47D03(T) F3D03=SQRT(SIG*RV/9.80665) ELSEIF (IG92.EQ.1) THEN F3D03=0.0 ELSE F3D03=-1.0E+20 ENDIF RETURN END C04 + LATENT HEAT OF VAPORIZATION J/KG AT P BAR FUNCTION F4D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IK=G91D03(P) IF (IK.EQ.1) THEN F4D03=0.0E+00 ELSEIF (IK.EQ.0) THEN YP=1.0D-01*DBLE(P) YT=G2D03(YP) HD=REAL(G14D03(YT)) HDD=REAL(G15D03(YT)) F4D03=(HDD-HD)/28.054E-3 ELSE F4D03=-1.0E+20 ENDIF RETURN END C05 + LATENT HEAT OF VAPORIZATION J/KG AT T C FUNCTION F5D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IK=G92D03(T) IF (IK.EQ.1) THEN F5D03=0.0E+00 ELSEIF (IK.EQ.0) THEN YT=DBLE(T)+273.15D0 HD=REAL(G14D03(YT)) HDD=REAL(G15D03(YT)) F5D03=(HDD-HD)/28.054E-3 ELSE F5D03=-1.0E+20 ENDIF RETURN END C13 + VISCOSITY PA*S AT P BAR AND T C FUNCTION F13D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YT=DBLE(T+273.15) YP=DBLE(P) F13D03=REAL(G51D03(YP,YT)) RETURN END C16 + ISOBARIC SPECIFIC HEAT J/KG*K OF SATURATED LIQUID AT P BAR FUNCTION F16D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.0) THEN YP=1.0D-01*DBLE(P) YT=G2D03(YP) F16D03=REAL(G22D03(YT))/28.054E-3 ELSE F16D03=-1.0E+20 ENDIF RETURN END C17 + ISOBARIC SPECIFIC HEAT J/KG*K OF SATURATED VAPOUR AT P BAR FUNCTION F17D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.0) THEN YP=1.0D-01*DBLE(P) YT=G2D03(YP) F17D03=REAL(G23D03(YT))/28.054E-3 ELSE F17D03=-1.0E+20 ENDIF RETURN END C18 + ISOBARIC SPECIFIC HEAT J/KG*K AT P BAR AND T C FUNCTION F18D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.2) THEN YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YR=G26D03(YP,YT) F18D03=REAL(G12D03(YT,YR))/28.054E-3 ELSE F18D03=-1.0E+20 ENDIF RETURN END C19 + ISOBARIC SPECIFIC HEAT J/KG*K OF SATURATED LIQUID AT T C FUNCTION F19D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.0) THEN YT=DBLE(T)+273.15D0 F19D03=REAL(G22D03(YT))/28.054E-3 ELSE F19D03=-1.0E+20 ENDIF RETURN END C20 + ISOBARIC SPECIFIC HEAT J/KG*K OF SATURATED VAPOUR AT T C FUNCTION F20D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.0) THEN YT=DBLE(T)+273.15D0 F20D03=REAL(G23D03(YT))/28.054E-3 ELSE F20D03=-1.0E+20 ENDIF RETURN END C21 + CRITICAL POINT FUNCTION F21D03(A) IMPLICIT DOUBLE PRECISION (G) CHARACTER*1 A DOUBLE PRECISION TC,RC,M DATA TC,RC,M/282.3452D+00,7.634D+00, 28.054D+00/ IF (A.EQ.'H') THEN F21D03=REAL(G8D03(TC,RC)*1.0D+03/M) ELSEIF (A.EQ.'P') THEN F21D03=50.401 ELSEIF (A.EQ.'S') THEN F21D03=REAL(G10D03(TC,RC)*1.0D+03/M) ELSEIF (A.EQ.'T') THEN F21D03=9.1952 ELSEIF (A.EQ.'V') THEN F21D03=1E0/REAL(RC*M) ELSE F21D03=-1.0E+20 ENDIF RETURN END C23 + SPECIFIC ENTHALPY J/KG OF SATURATED LIQUID AT P BAR FUNCTION F23D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F23D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=G2D03(YP) F23D03=REAL(G14D03(YT))/28.054E-3 ENDIF RETURN END C24 + SPECIFIC ENTHALPY J/KG OF SATURATED VAPOUR AT P BAR FUNCTION F24D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F24D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=G2D03(YP) F24D03=REAL(G15D03(YT))/28.054E-3 ENDIF RETURN END C25 + SPECIFIC ENTHALPY J/KG AT P BAR AND T C FUNCTION F25D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.3) THEN F25D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YR=G26D03(YP,YT) F25D03=REAL(G8D03(YT,YR))/28.054E-3 ENDIF RETURN END C26 + SPECIFIC ENTHALPY J/KG OF MIXTURE AT P BAR FUNCTION F26D03(P,X) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F26D03=-1.0E+20 ELSEIF (X.GE.0.0 .AND. X.LE.1 ) THEN YP=1.0D-01*DBLE(P) YT=G2D03(YP) HD=REAL(G14D03(YT))/28.054E-03 HDD=REAL(G15D03(YT))/28.054E-03 F26D03=HD+X*(HDD-HD) ELSE F26D03=-1.0E+20 ENDIF RETURN END C27 + SPECIFIC ENTHALPY J/KG OF SATURATED LIQUID AT T C FUNCTION F27D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F27D03=-1.0E+20 ELSE YT=DBLE(T)+273.15D+00 F27D03=REAL(G14D03(YT))/28.054E-3 ENDIF RETURN END C28 + SPECIFIC ENTHALPY J/KG OF SATURATED VAPOUR AT T C FUNCTION F28D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F28D03=-1.0E+20 ELSE YT=DBLE(T)+273.15D0 F28D03=REAL(G15D03(YT))/28.054E-3 ENDIF RETURN END C29 + SPECIFIC ENTHALPY J/KG OF MIXTURE AT T C FUNCTION F29D03(T,X) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F29D03=-1.0E+20 ELSEIF (X.GE.0.0 .AND. X.LE.1 ) THEN YT=DBLE(T)+273.15D0 HD=REAL(G14D03(YT))/28.054E-03 HDD=REAL(G15D03(YT))/28.054E-03 F29D03=HD+X*(HDD-HD) ELSE F29D03=-1.0E+20 ENDIF RETURN END C30 + SATURATION PRESSURE BAR AT T C FUNCTION F30D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IK=G92D03(T) IF (IK.EQ.0) THEN YT=DBLE(T)+273.15D0 F30D03=10.0*REAL(G1D03(YT)) ELSEIF (IK.EQ.1) THEN F30D03=50.401 ELSE F30D03=-1.0E+20 ENDIF RETURN END C31 + SURFACE TENSION N/M AT P BAR FUNCTION F31D03(P) DOUBLE PRECISION G2D03,YP INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F31D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) T=REAL(G2D03(YP))-273.15 F31D03=G47D03(T) ENDIF RETURN END C32 + SURFACE TENSION N/M AT T C FUNCTION F32D03(T) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F32D03=-1.0E+20 ELSE F32D03=G47D03(T) ENDIF RETURN END C33 + SPECIFIC ENTROPY J/KG*K OF SATURATED LIQUID AT P BAR FUNCTION F33D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F33D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=G2D03(YP) F33D03=REAL(G16D03(YT))/28.054E-3 ENDIF RETURN END C34 + SPECIFIC ENTROPY J/KG OF SATURATED VAPOUR AT P BAR FUNCTION F34D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F34D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=G2D03(YP) F34D03=REAL(G17D03(YT))/28.054E-3 ENDIF RETURN END C35 + SPECIFIC ENTROPY J/KG*K AT P BAR AND T C FUNCTION F35D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.3) THEN F35D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YR=G26D03(YP,YT) F35D03=REAL(G10D03(YT,YR))/28.054E-3 ENDIF RETURN END C36 + SPECIFIC ENTROPY J/KG*K OF MIXTURE AT P BAR FUNCTION F36D03(P,X) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F36D03=-1.0E+20 ELSEIF (X.GE.0 .AND. X.LE.1) THEN YP=1.0D-01*DBLE(P) YT=G2D03(YP) SD=REAL(G16D03(YT))/28.054E-3 SDD=REAL(G17D03(YT))/28.054E-3 F36D03=SD+X*(SDD-SD) ELSE F36D03=-1.0E+20 ENDIF RETURN END C37 + SPECIFIC ENTROPY J/KG*K OF SATURATED LIQUID AT T C FUNCTION F37D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F37D03=-1.0E+20 ELSE YT=DBLE(T)+273.15D+00 F37D03=REAL(G16D03(YT))/28.054E-03 ENDIF RETURN END C38 + SPECIFIC ENTROPY J/KG*K OF SATURATED VAPOUR AT T C FUNCTION F38D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F38D03=-1.0E+20 ELSE YT=DBLE(T)+273.15D+00 F38D03=REAL(G17D03(YT))/28.054E-03 ENDIF RETURN END C39 + SPECIFIC ENTROPY J/KG*K OF MIXTURE AT T C FUNCTION F39D03(T,X) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F39D03=-1.0E+20 ELSEIF (X.GE.0 .AND. X.LE.1 ) THEN YT=DBLE(T)+273.15D+00 SD=REAL(G16D03(YT))/28.054E-03 SDD=REAL(G17D03(YT))/28.054E-03 F39D03=SD+X*(SDD-SD) ELSE F39D03=-1.0E+20 ENDIF RETURN END C40 + SATURATION TEMPERATURE C AT P BAR FUNCTION F40D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IK=G91D03(P) IF (IK.EQ.0) THEN YP=1.0D-01*DBLE(P) YT=G2D03(YP) F40D03=REAL(YT)-273.15 ELSEIF (IK.EQ.1) THEN F40D03=9.1952 ELSE F40D03=-1.0E+20 ENDIF RETURN END C41 + TRIPLE POINT FUNCTION F41D03(A) CHARACTER*1 A IF (A.EQ.'T') THEN F41D03=-169.164 ELSEIF (A.EQ.'P') THEN F41D03=1.225E-3 ELSE F41D03=-1.0E+20 ENDIF RETURN END C42 + SPECIFIC INTERNAL ENERGY J/KG OF SATURATED LIQUID AT P BAR FUNCTION F42D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F42D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=G2D03(YP) F42D03=REAL(G18D03(YT))/28.054E-03 ENDIF RETURN END C43 + SPECIFIC INTERNAL ENERGY J/KG OF SATURATED VAPOUR AT P BAR FUNCTION F43D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F43D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=G2D03(YP) F43D03=REAL(G19D03(YT))/28.054E-03 ENDIF RETURN END C44 + SPECIFIC INTERNAL ENERGY J/KG AT P BAR AND T FUNCTION F44D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.3) THEN F44D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YR=G26D03(YP,YT) F44D03=REAL(G9D03(YT,YR))/28.054E-3 ENDIF RETURN END C45 + SPECIFIC INTERNAL ENERGY J/KG OF MIXTURE AT P BAR FUNCTION F45D03(P,X) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F45D03=-1.0E+20 ELSEIF (X.GE.0 .AND. X.LE.1) THEN YP=1.0D-01*DBLE(P) YT=G2D03(YP) UD=REAL(G18D03(YT))/28.054E-03 UDD=REAL(G19D03(YT))/28.054E-03 F45D03=UD+X*(UDD-UD) ELSE F45D03=-1.0E+20 ENDIF RETURN END C46 + SPECIFIC INTERNAL ENERGY J/KG OF SATURATED LIQUID AT T C FUNCTION F46D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F46D03=-1.0E+20 ELSE YT=DBLE(T)+273.15D0 F46D03=REAL(G18D03(YT))/28.054E-03 ENDIF RETURN END C47 + SPECIFIC INTERNAL ENERGY J/KG OF SATURATED VAPOUR AT T C FUNCTION F47D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F47D03=-1.0E+20 ELSE YT=DBLE(T)+273.15D0 F47D03=REAL(G19D03(YT))/28.054E-03 ENDIF RETURN END C48 + SPECIFIC INTERNAL ENERGY J/KG OF MIXTURE AT T C FUNCTION F48D03(T,X) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F48D03=-1.0E+20 ELSEIF (X.GE.0 .AND. X.LE.1) THEN YT=DBLE(T)+273.15D0 UD=REAL(G18D03(YT))/28.054E-03 UDD=REAL(G19D03(YT))/28.054E-03 F48D03=UD+X*(UDD-UD) ELSE F48D03=-1.0E+20 ENDIF RETURN END C49 + SPECIFIC VOLUME M**3/KG OF SATURATED LIQUID AT P BAR FUNCTION F49D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F49D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=G2D03(YP) F49D03=1.0/REAL(G3D03(YT))/28.054 ENDIF RETURN END C50 + SPECIFIC VOLUME M**3/KG OF SATURATED GAS AT P BAR FUNCTION F50D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F50D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=G2D03(YP) F50D03=1.0/REAL(G4D03(YT))/28.054 ENDIF RETURN END C51 + SPECIFIC VOLUME M**3/KG AT P BAR AND T C FUNCTION F51D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.3) THEN F51D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 F51D03=1.0/REAL(G26D03(YP,YT))/28.054 ENDIF RETURN END C52 + SPECIFIC VOLUME M**3/KG OF MIXTURE AT P BAR FUNCTION F52D03(P,X) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F52D03=-1.0E+20 ELSEIF (X.GE.0.0 .AND. X.LE.1) THEN YP=1.0D-01*DBLE(P) YT=G2D03(YP) VD=1.0/REAL(G3D03(YT))/28.054 VDD=1.0/REAL(G4D03(YT))/28.054 F52D03=VD+X*(VDD-VD) ELSE F52D03=-1.0E+20 ENDIF RETURN END C53 + SPECIFIC VOLUME M**3/KG OF SATURATED LIQUID AT T C FUNCTION F53D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F53D03=-1.0E+20 ELSE YT=DBLE(T)+273.15D0 F53D03=1.0/REAL(G3D03(YT))/28.054 ENDIF RETURN END C54 + SPECIFIC VOLUME M**3/KG OF SATURATED GAS AT T C FUNCTION F54D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F54D03=-1.0E+20 ELSE YT=DBLE(T)+273.15D0 F54D03=1.0/REAL(G4D03(YT))/28.054 ENDIF RETURN END C55 + SPECIFIC VOLUME M**3/KG OF MIXTURE AT T C FUNCTION F55D03(T,X) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F55D03=-1.0E+20 ELSEIF (X.GE.0 .AND. X.LE.1) THEN YT=DBLE(T)+273.15D0 VD=1.0/REAL(G3D03(YT))/28.054 VDD=1.0/REAL(G4D03(YT))/28.054 F55D03=VD+X*(VDD-VD) ELSE F55D03=-1.0E+20 ENDIF RETURN END C56 + DRYNESS FRACTION AT P BAR AND H J/KG FUNCTION F56D03(P,H) INTEGER G91D03 IF (G91D03(P).EQ.0) THEN HD=F23D03(P) IF (H.LT.HD) GOTO 999 HDD=F24D03(P) IF (HD.EQ.HDD) GOTO 999 IF (H.GT.HDD) GOTO 999 F56D03=(H-HD)/(HDD-HD) RETURN ENDIF 999 F56D03=-1.0E+20 RETURN END C57 + DRYNESS FRACTION AT P BAR AND S J/(KG*K) FUNCTION F57D03(P,S) INTEGER G91D03 IF (G91D03(P).EQ.0) THEN SD=F33D03(P) IF (S.LT.SD) GOTO 999 SDD=F34D03(P) IF (SD.EQ.SDD) GOTO 999 IF (S.GT.SDD) GOTO 999 F57D03=(S-SD)/(SDD-SD) RETURN ENDIF 999 F57D03=-1.0E+20 RETURN END C58 + DRYNESS FRACTION AT P BAR AND U J/KG FUNCTION F58D03(P,U) INTEGER G91D03 IF (G91D03(P).EQ.0) THEN UD=F42D03(P) IF (U.LT.UD) GOTO 999 UDD=F43D03(P) IF (UD.EQ.UDD) GOTO 999 IF (U.GT.UDD) GOTO 999 F58D03=(U-UD)/(UDD-UD) RETURN ENDIF 999 F58D03=-1.0E+20 RETURN END C59 + DRYNESS FRACTION AT P BAR AND V M**3/KG FUNCTION F59D03(P,V) INTEGER G91D03 IF (G91D03(P).EQ.0) THEN VD=F49D03(P) IF (V.LT.VD) GOTO 999 VDD=F50D03(P) IF (VD.EQ.VDD) GOTO 999 IF (V.GT.VDD) GOTO 999 F59D03=(V-VD)/(VDD-VD) RETURN ENDIF 999 F59D03=-1.0E+20 RETURN END C60 + DRYNESS FRACTION AT T C AND H J/KG FUNCTION F60D03(T,H) INTEGER G92D03 IF (G92D03(T).EQ.0) THEN HD=F27D03(T) IF (H.LT.HD) GOTO 999 HDD=F28D03(T) IF (H.GT.HDD) GOTO 999 F60D03=(H-HD)/(HDD-HD) RETURN ENDIF 999 F60D03=-1.0E+20 RETURN END C61 + DRYNESS FRACTION AT T C AND S J/(KG*K) FUNCTION F61D03(T,S) INTEGER G92D03 IF (G92D03(T).EQ.0) THEN SD=F37D03(T) IF (S.LT.SD) GOTO 999 SDD=F38D03(T) IF (S.GT.SDD) GOTO 999 F61D03=(S-SD)/(SDD-SD) RETURN ENDIF 999 F61D03=-1.0E+20 RETURN END C62 + DRYNESS FRACTION AT T C AND U J/KG FUNCTION F62D03(T,U) INTEGER G92D03 IF (G92D03(T).EQ.0) THEN UD=F46D03(T) IF (U.LT.UD) GOTO 999 UDD=F47D03(T) IF (U.GT.UDD) GOTO 999 F62D03=(U-UD)/(UDD-UD) RETURN ENDIF 999 F62D03=-1.0E+20 RETURN END C63 + DRYNESS FRACTION AT T C AND V M**3/KG FUNCTION F63D03(T,V) INTEGER G92D03 IF (G92D03(T).EQ.0) THEN VD=F53D03(T) IF (V.LT.VD) GOTO 999 VDD=F54D03(T) IF (V.GT.VDD) GOTO 999 F63D03=(V-VD)/(VDD-VD) RETURN ENDIF 999 F63D03=-1.0E+20 RETURN END C64 + TEMPERATURE C AT P BAR AND H J/KG FUNCTION F64D03(P,H) DOUBLE PRECISION PP,SS,TT,RR,HH,UU PP=1.0D-01*DBLE(P) HH=DBLE(H)*28.054D-03 CALL S10D03(PP,HH,TT,RR,SS,UU) IF (TT.GT.0.0) THEN F64D03=REAL(TT)-273.15 ELSE F64D03=-1.0E+20 ENDIF RETURN END C65 + TEMPERATURE C AT P BAR AND S J/(KG*K) FUNCTION F65D03(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH,UU PP=1.0D-01*DBLE(P) SS=DBLE(S)*28.054D-03 CALL S11D03(PP,SS,TT,RR,HH,UU) IF (TT.GT.0.0) THEN F65D03=REAL(TT)-273.15 ELSE F65D03=-1.0E+20 ENDIF RETURN END C68 + MELTING PRESSURE BAR AT T C FUNCTION F68D03(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-169.164 .OR. T.GT.-137.95) THEN F68D03=-1.0E+20 ELSE YT=DBLE(T)+273.15D+00 F68D03=REAL(G5D03(YT))*1.0E+01 ENDIF RETURN END C69 + MELTING TEMPERATURE C AT P BAR FUNCTION F69D03(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.1 .OR. P.GT.2600.0) THEN F69D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) F69D03=REAL(G6D03(YP))-273.15E+00 ENDIF RETURN END C70 + TEMPERATURE C P BAR AND V M**3/KG C *** T(P0,V0) FROM P(T,V0)-P0=0 FUNCTION F70D03(P,V) IMPLICIT DOUBLE PRECISION (G,Y) YP=1.0D-01*DBLE(P) YR=1.0D+00/DBLE(V)/28.054D+00 TT=REAL(G46D03(YP,YR)) IF (TT.GT.0.0) THEN F70D03=TT-273.15E+00 ELSE F70D03=-1.0E+20 ENDIF RETURN END C71 + ENTHALPY H J/KG AT P BAR AND S J/(KG*K) FUNCTION F71D03(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH,UU PP=1.0D-01*DBLE(P) SS=DBLE(S)*28.054D-03 CALL S11D03(PP,SS,TT,RR,HH,UU) IF (TT.GT.0.0) THEN F71D03=REAL(HH)/28.054E-3 ELSE F71D03=-1.0E+20 ENDIF RETURN END C76 + ISOCHORIC SPECIFIC HEAT J/(KG*K) OF SATURATED VAPOR AT P BAR FUNCTION F76D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.3) THEN F76D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=G2D03(YP) F76D03=REAL(G21D03(YT))/28.054E-3 ENDIF RETURN END C77 + ISOCHORIC SPECIFIC HEAT J/(KG*K) AT P BAR AND T C FUNCTION F77D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.3) THEN F77D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D0 YR=G26D03(YP,YT) F77D03=REAL(G11D03(YT,YR))/28.054E-3 ENDIF RETURN END C78 + ISOCHORIC SPECIFIC HEAT J/(KG*K) OF SATURATED VAPOR AT T C FUNCTION F78D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.3) THEN F78D03=-1.0E+20 ELSE YT=DBLE(T)+273.15D0 F78D03=REAL(G21D03(YT))/28.054E-3 ENDIF RETURN END C79 + INTERNAL ENERGY U J/KG AT P BAR AND S J/(KG*K) FUNCTION F79D03(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH,UU PP=1.0D-01*DBLE(P) SS=DBLE(S)*28.054D-03 CALL S11D03(PP,SS,TT,RR,HH,UU) IF (TT.GT.0.0) THEN F79D03=REAL(UU)/28.054E-03 ELSE F79D03=-1.0E+20 ENDIF RETURN END C80 + SPECIFIC VOLUME V M**3/KG AT P BAR AND S J/(KG*K) FUNCTION F80D03(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH,UU PP=1.0D-01*DBLE(P) SS=DBLE(S)*28.054D-03 CALL S11D03(PP,SS,TT,RR,HH,UU) IF (TT.GT.0.0) THEN F80D03=1.0/REAL(RR)/28.054 ELSE F80D03=-1.0E+20 ENDIF RETURN END C82 + LOCAL ADIABATIC EXPONENT AT P BAR AND T C FUNCTION F82D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.3) THEN F82D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YR=G26D03(YP,YT) CV=G11D03(YT,YR) CP=G12D03(YT,YR) CALL S1D03(YT,YR,YPD,YDPDR) F82D03=CP/CV*YR/YP*YDPDR ENDIF RETURN END C83 + SPEED OF SOUND M/S AT P BAR AND T C FUNCTION F83D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.3) THEN F83D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YR=G26D03(YP,YT) F83D03=REAL(G13D03(YT,YR)) ENDIF RETURN END C90 + ADIABATIC COMPRESSIBILITY (1/PA) AT P BAR AND T C FUNCTION F90D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.3) THEN F90D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YRO=G26D03(YP,YT) WW=REAL(G13D03(YT,YRO)) RR=1.0E+03*REAL(YRO)*28.054E-03 VV=1.0E+00/RR F90D03=VV/(WW*WW) ENDIF RETURN END C91 + ISOTHERMAL COMPRESSIVILITY (1/PA) AT P BAR AND T C FUNCTION F91D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.2) THEN YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YRO=G26D03(YP,YT) YDPDV=G28D03(YT,YRO) F91D03=-1.0E-06/REAL(YDPDV/YRO) ELSE F91D03=-1.0E+20 ENDIF RETURN END C92 + VOLUMETRIC COEFFICIENT OF EXPANSION (1/K) AT P BAR AND T C FUNCTION F92D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.2) THEN YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YRO=G26D03(YP,YT) YDVDT=G27D03(YT,YRO) F92D03=REAL(YRO*YDVDT) ELSE F92D03=-1.0E+20 ENDIF RETURN END C93 + PRESSURE COEFFICIENT (1/K) AT P BAR AND T C FUNCTION F93D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.3) THEN F93D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YRO=G26D03(YP,YT) YDPDT=G29D03(YT,YRO) F93D03=REAL(YDPDT/YP) ENDIF RETURN END C94 + JOULE-THOMSON COEFFICIENT (K/PA) AT P BAR AND T C FUNCTION F94D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IG93=G93D03(P,T) IF (IG93.EQ.3) THEN F94D03=-1.0E+20 ELSE YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YRO=G26D03(YP,YT) IF (IG93.EQ.2) THEN YDVDT=G27D03(YT,YRO) CP=REAL(G12D03(YT,YRO)) F94D03=REAL(YT*YDVDT-1.0D+00/YRO)/CP*1.0E-03 ELSE F94D03=1.0E-06/REAL(G29D03(YT,YRO)) ENDIF ENDIF RETURN END C95 + RATIO OF SPECIFIC HEATS AT P BAR AND T C FUNCTION F95D03(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D03 IF (G93D03(P,T).EQ.2) THEN YP=1.0D-01*DBLE(P) YT=DBLE(T)+273.15D+00 YR=G26D03(YP,YT) F95D03=REAL(G12D03(YT,YR)/G11D03(YT,YR)) ELSE F95D03=-1.0E+20 ENDIF RETURN END C96 + RATIO OF SPECIFIC HEATS OF SATURATED VAPOUR AT P BAR FUNCTION F96D03(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D03 IF (G91D03(P).EQ.0) THEN YP=1.0D-01*DBLE(P) YT=G2D03(YP) F96D03=REAL(G23D03(YT)/G21D03(YT)) ELSE F96D03=-1.0E+20 ENDIF RETURN END C97 + RATIO OF SPECIFIC HEATS OF SATURATED VAPOUR AT T C FUNCTION F97D03(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D03 IF (G92D03(T).EQ.0) THEN YT=DBLE(T)+273.15D0 F97D03=REAL(G23D03(YT)/G21D03(YT)) ELSE F97D03=-1.0E+20 ENDIF RETURN END C F98 + PSEUDO BOILING POINT AT P FUNCTION F98D03(P) DIMENSION T(2),C(2),TL(3),TR(3),CL(3),CR(3) P1=F21D03('P') PP=ABS((P-P1)/P1) T1=F21D03('T') IF (PP.LT.1.0D-5) THEN F98D03=T1 RETURN ENDIF IF (P.LT.P1.OR.P.GT.400.001D00) THEN F98D03=-1.0E+20 RETURN ENDIF T2=0.85*T1 P2=F30D03(T2) TM0=T1+(T1-T2)*(P-P1)/(P1-P2) C-----TM0 KINJICHI TC=T1 T(1)=TM0 IF (P.GT.200.0) T(1)=150.0 150 EPS=1.0E-6 DEL=T1*0.05D00 IREP=0 IREM=5000 KCONT=0 ICONT=0 C(1)=F18D03(P,T(1)) T(2)=T(1)-DEL C(2)=F18D03(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)=F18D03(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=-F18D03(P,TT) 3000 CONV=ABS((CC-C(2))/CC) IF(CONV.LT.EPS) THEN F98D03=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=-F18D03(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=F18D03(P,TA) CB=F18D03(P,TB) 6050 KCONT=KCONT+1 IF (KCONT.GT.IREM) GO TO 8000 DELT=ABS((TA-TB)/TA) IF (DELT.LT.EPS) GO TO 7000 CC=F18D03(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)=F18D03(P,TL(2)) CR(2)=F18D03(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=F18D03(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=F18D03(P,TB) ELSE TB=TR(MR+1) CB=CR(MR+1) ENDIF 6135 TC=TR(MR) CC=CR(MR) ENDIF GO TO 6050 7000 F98D03=TC RETURN 8000 F98D03=-1.0E+10 RETURN END C ********************************************** C * THEMOPHYSICAL PROPERTIES OF ETHYLENE * C * FOR PROPATH VER.7.1 * C * * C * CITED FROM * C * * C * M.JAHANGIRI, R.T.JACOBSEN, AND R.B.STEWART * C * * C * THERMODYNAMIC PROPERTIES OF ETHYLENE FROM * C * THE FREEZING LINE TO 450 K AT PRESSURES * C * TO 260 MPA * C * * C * JOURNAL OF PHYSICAL AND CHEMICAL REFERENCE * C * DATA, VOL.15 NO.2, 1986, PP.593-734. * C * * C * CODED BY TOMOHIRO HONDA * C * * C * FUKUOKA UNIVERSITY * C * FUKUOKA, 814-01, JAPAN * C * (JANUARY 1990) * C * * C * APPEND G27-G29 * C * (SEPTEMBER 1990) * C ********************************************** C G01 *** VAPOR PRESSURE PST(MPA) AT T(K) FUNCTION G1D03(TK) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A1,A2,A3,A5,A10 & / -6.373572165D+00, 1.363317303D+00, & -3.197269070D-01,-1.157656259D+00, & -1.899024189D+00/ DATA TC,PC/282.3452D+00,5.0401D+00/ H=1.0D+00-TK/TC IF (DABS(H).LT.1.0D-05) THEN G1D03=PC ELSE HQ=DSQRT(H) SS=(A1+A2*HQ+(A3+(A5+A10*H*H*HQ)*H)*H)*H SS=TC/TK*SS G1D03=PC*DEXP(SS) ENDIF RETURN END C G02 *** SATURATED TEMPERATURE TSP(K) AT P(MPA) FUNCTION G2D03(PMP) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A1,A2,A3,A5,A10 & / -6.373572165D+00, 1.363317303D+00, & -3.197269070D-01,-1.157656259D+00, & -1.899024189D+00/ DATA TCR,PCR/282.3452D+00,5.0401D+00/ DATA TTR,PTR/103.986D+00,1.225D-04/ P=1.0D+00-PMP/PCR IF (DABS(P).LT.1.0D-05) THEN G2D03=TCR ELSE IF (PMP.GE.3.75D+00) THEN TK=TCR-(TCR-TTR)*(PCR-PMP)/(PCR-PTR) ELSE TA=TCR TB=TTR PA=PCR PB=PTR 100 TK=(TA+TB)/2 PC=G1D03(TK) IF (DABS(1.0D+00-PC/PMP).GT.1.0D-02) THEN IF (PC.LT.PMP) THEN TB=TK PB=PC ELSE TA=TK PA=PC ENDIF GOTO 100 ENDIF ENDIF 10 H=1.0D+00-TK/TCR HQ=DSQRT(H) SS=(A1+A2*HQ+(A3+(A5+A10*H*H*HQ)*H)*H)*H SS=TCR/TK*SS P1=PCR*DEXP(SS) IF (DABS((P1-PMP)/PMP).LT.1.0D-07) THEN G2D03=TK ELSE ST=A1+1.5D+00*A2*HQ+(2*A3+(3*A5+5.5D+00*A10*H*H*HQ)*H)*H DPDT=-P1/TK*(SS+ST) TK=TK+(PMP-P1)/DPDT GOTO 10 ENDIF ENDIF RETURN END C S01 *** DPDRO(MPA/(MOL/DM**3)) AT TK(K) AND RO(MOL/DM**3) SUBROUTINE S1D03(TK,RO,PP,DPDRO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA GASCON/8.31434D-03/ CCCC D=RO/RC D2=D*D D3=D2*D D4=D2*D2 D6=D4*D2 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D6) C T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 C AL1=A2*TSQ+A4*T+A5*T*TQT+A7*T2/TQT+A16*T4 DADD=AL1 AL2=(A22+(A26+(A27+A28*T)*T)*T2)*T2 DADD=DADD+2.0D+00*D*AL2 AL3=A29*TQT+A35*T3 DADD=DADD+3.0D+00*D2*AL3 AL4=A38*TQT DADD=DADD+4.0D+00*D3*AL4 AL6=(A44+A48*T2)*TSQ+A49*T3 DADD=DADD+6.0D+00*D4*D*AL6 DADDD=(2*AL1+(6*AL2+(12*AL3+(20*AL4+42*AL6*D2)*D)*D)*D)*D AL1=(A50*TSQ+A51*T)*ED3 DADD=DADD+AL1*(1.0D+00-3*D3) DADDD=DADDD+AL1*D*(9*D6-18*D3+2.0D+00) AL21=(A57*TSQ+(A60+A62*T2)*T2)*ED2 DADD=DADD+AL21*2*D*(1.0D+00-D2) DADDD=DADDD+AL21*2*D2*(2*D4-7*D2+3.0D+00) AL22=(A66+(A67+(A68+A69*T)*T)*T)*T3*ED4 DADD=DADD+AL22*2*D*(1.0D+00-2*D4) DADDD=DADDD+AL22*2*D2*(8*D4*D4-18*D4+3.0D+00) AL23=(A71+(A72+A73*T)*T)*T2*ED6 DADD=DADD+AL23*2*D*(1.0D+00-3*D2*D4) DADDD=DADDD+AL23*6*D2*(6*D6*D6-11*D6+1.0D+00) AL3=A76*T*TSQ*ED3 DADD=DADD+AL3*3*D2*(1.0D+00-D3) DADDD=DADDD+AL3*3*D3*(3*D6-10*D3+4.0D+00) AL41=((A81+A83*T)*TSQ+(A86+A87*T)*T4)*ED2 DADD=DADD+AL41*2*D3*(2.0D+00-D2) DADDD=DADDD+AL41*2*D4*(2*D4-11*D2+1.0D+01) AL42=(A88+(A89+(A90+(A91+(A92+A93*T)*T)*T)*T)*T)*T*ED4 DADD=DADD+AL42*4*D3*(1.0D+00-D4) DADDD=DADDD+AL42*4*D4*(4*D4*D4-13*D4+5.0D+00) AL8=(A94*TSQ+(A95+A100*T4)*T)*ED2 DADD=DADD+AL8*2*D3*D4*(4.0D+00-D2) DADDD=DADDD+AL8*2*D4*D4*(2*D4-19*D2+3.6D+01) PP=RO*GASCON*TK*(1.0D+00+D*DADD) DPDRO=GASCON*TK*(1.0D+00+DADDD) RETURN END C G03 *** SATURATED LIQUID DENSITY RLT(MOL/DM**3) AT T(K) FUNCTION G3D03(TK) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A10,A11,A12,A14,A15,A18,A25 & / -2.973241426D-06,-1.759597892D+00, & 1.297770957D+00,-1.735448063D+00, & 9.422348274D-01,-4.226244872D-02, & 3.131180969D+00/ DATA TC,RVC/282.3452D+00,7.6340D+00/ RDT=1.0D+00-TK/TC IF (DABS(RDT).LT.1.0D-05) THEN G3D03=RVC ELSE PS=G1D03(TK) T=TC/TK-1.0D+00 ETRI=1.0D+00/3.0D+00 T1=T**ETRI T2=T1*T1 SRL=A10/T1+(A11+A14*T)*T1+(A12+(A15+A18*T)*T)*T2+A25*T**0.325D+00 RL1=RVC*(1.0D+00+SRL) 10 CALL S1D03(TK,RL1,PS1,DPDRO) DRL=(PS-PS1)/DPDRO IF(DABS(DRL).LT.1.0D-07) THEN G3D03=RL1 ELSE RL1=RL1+DRL GOTO 10 ENDIF ENDIF RETURN END C G04 *** SATURATED VAPOR DENSITY RVT(MOL/DM**3) AT T(K) FUNCTION G4D03(TK) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DATA A1,A3,A4,A5,A7,A8,A25 & / -1.722832379D+00, 1.903195837D+01, & 3.038649257D+01,-4.114655323D+01, & 1.275383046D+01,-3.767668608D+00, & 3.180542637D+01/ DATA TC,RVC/282.3452D+00,7.6340D+00/ RDT=1.0D+00-TK/TC IF (DABS(RDT).LT.1.0D-05) THEN G4D03=RVC ELSE PS=G1D03(TK) T=TC/TK-1.0D+00 ETRI=1.0D+00/3.0D+00 T1=T**ETRI T2=T1*T1 SRV=(A1+(A4+A7*T)*T)*T1+A3*T+(A5+A8*T)*T*T2+A25*DLOG(TK/TC) RV1=RVC*DEXP(SRV) 10 CALL S1D03(TK,RV1,PS1,DPDRO) DRV=(PS-PS1)/DPDRO IF(DABS(1.0D+00-PS1/PS).LT.1.0D-07) THEN G4D03=RV1 ELSE RV1=RV1+DRV GOTO 10 ENDIF ENDIF RETURN END C G05 *** MELTING PRESSURE FUNCTION G5D03(TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA TTR,PTR/103.986D+00,1.2D-04/ DATA A,EP/3.57924D+02,2.0645D+00/ G5D03=PTR+A*((TK/TTR)**EP-1.0) RETURN END C G06 *** MELTING PRESSURE FUNCTION G6D03(P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) TA=136.0D+00 TB=103.987D+00 PA=G5D03(TA) PB=G5D03(TB) 100 TC=0.5*(TA+TB) PC=G5D03(TC) IF (ABS((TA-TB)/TC).LT.1.0E-06) THEN G6D03=TC RETURN ELSE IF (PC.LT.P) THEN TB=TC PB=PC ELSE TA=TC PA=PC ENDIF GOTO 100 ENDIF END C G07 *** P(MPA) AT TK(K) AND RO(MOL/DM**3) FUNCTION G7D03(TK,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA GASCON/8.31434D+00/ D=RO/RC D2=D*D D3=D2*D D4=D2*D2 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D2*D4) T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 DADD=A2*TSQ+A4*T+A5*T*TQT+A7*T2/TQT+A16*T4 DADD=DADD+2.0D+00*D*(A22+(A26+A27*T+A28*T2)*T2)*T2 DADD=DADD+D2*(3.0D+00*(A29*TQT+A35*T3)+4.0D+00*D*A38*TQT) DADD=DADD+6.0D+00*D4*D*((A44+A48*T2)*TSQ+A49*T3) DADD=DADD+(A50*TSQ+A51*T)*(1.0D+00-3.0D+00*D3)*ED3 DADD=DADD+(A57*TSQ+A60*T2+A62*T4) & *2.0D+00*D*(1.0D+00-D2)*ED2 DADD=DADD+(A66+(A67+(A68+A69*T)*T)*T)*T3 & *2.0D+00*D*(1.0D+00-2.0D+00*D4)*ED4 DADD=DADD+(A71+(A72+A73*T)*T)*T2 & *2.0D+00*D*(1.0D+00-3.0D+00*D2*D4)*ED6 DADD=DADD+A76*T*TSQ*3.0D+00*D2*(1.0D+00-D3)*ED3 DADD=DADD+((A81+A83*T)*TSQ+(A86+A87*T)*T4) & *2.0D+00*D3*(2.0D+00-D2)*ED2 DADD=DADD+(A88+(A89+(A90+(A91+(A92+A93*T)*T)*T)*T)*T)*T & *4.0D+00*D3*(1.0D+00-D4)*ED4 DADD=DADD+(A94*TSQ+(A95+A100*T4)*T) & *2.0D+00*D3*D4*(4.0D+00-D2)*ED2 ZZ=1.0D+00+D*DADD G7D03=ZZ*RO*1.0D+03*GASCON*TK*1.0D-06 RETURN END C G08 *** H(J/MOL) AT TK(K) AND RO(MOL/DM**3) FUNCTION G8D03(TK,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION W(12) DATA W/3.026D+03,1.623D+03,1.342D+03,1.023D+03, & 3.103D+03,1.236D+03,0.949D+03,0.943D+03, & 3.106D+03,0.826D+03,2.989D+03,1.444D+03/ DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA AH,AC,AK/6.626196D-34,2.9979250D+08,1.380622D-23/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA GASCON,T0/8.31434D+00,298.15D+00/ CCCC AA=AH*AC/AK*1.0D+02 HHK=0.0D+00 HH0=0.0D+00 DO 10 I=1,12 HI=AA*W(I) UK=HI/TK U0=HI/T0 EUK=DEXP(UK) EU0=DEXP(U0) EUK1=EUK-1.0D+00 EU01=EU0-1.0D+00 HHK=HHK+UK/EUK1 HH0=HH0+U0/EU01 10 CONTINUE HHH=(4+HHK)*TK-(4+HH0)*T0 HHID=HHH/TK-1.0D+00 C D=RO/RC D2=D*D D3=D2*D D4=D2*D2 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D2*D4) C T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 C DADD=A2*TSQ+A4*T+A5*T*TQT+A7*T2/TQT+A16*T4 DADD=DADD+2*D*(A22+(A26+A27*T+A28*T2)*T2)*T2 DADD=DADD+D2*(3*(A29*TQT+A35*T*T2)+4*D*A38*TQT) DADD=DADD+6*D4*D*((A44+A48*T2)*TSQ+A49*T2*T) DADD=DADD+(A50*TSQ+A51*T)*(1.0D+00-3*D3)*ED3 DADD=DADD+(A57*TSQ+A60*T2+A62*T4) & *2*D*(1.0D+00-D2)*ED2 DADD=DADD+(A66+(A67+(A68+A69*T)*T)*T)*T3 & *2*D*(1.0D+00-2*D4)*ED4 DADD=DADD+(A71+(A72+A73*T)*T)*T2 & *2*D*(1.0D+00-3*D2*D4)*ED6 DADD=DADD+A76*T*TSQ*3*D2*(1.0D+00-D3)*ED3 DADD=DADD+((A81+A83*T)*TSQ+(A86+A87*T)*T4) & *2*D3*(2.0D+00-D2)*ED2 DADD=DADD+(A88+(A89+(A90+(A91+(A92+A93*T)*T)*T)*T)*T)*T & *4*D3*(1.0D+00-D4)*ED4 DADD=DADD+(A94*TSQ+(A95+A100*T4)*T) & *2*D3*D4*(4.0D+00-D2)*ED2 ZZ=1.0D+00+D*DADD CCCC DADT=A2/2/TSQ+A4+1.25D+00*A5*TQT+1.75D+00*A7*T/TQT+4*A16*T3 DADT=DADT*D+D2*(2*A22+4*A26*T2+5*A27*T3+6*A28*T4)*T DADT=DADT+D3*((A29+D*A38)/4/T*TQT+3*A35*T2) DADT=DADT+D4*D2*((A44/2+2.5D+00*A48*T2)/TSQ+3*A49*T2) DADT=DADT+D*(A50/2/TSQ+A51)*ED3 DADT=DADT+D2*(A57/2/TSQ+2*A60*T+4*A62*T3)*ED2 DADT=DADT+D2*(3*A66+4*A67*T+5*A68*T2+6*A69*T3)*T2*ED4 DADT=DADT+D2*(2*A71*T+3*A72*T2+4*A73*T3)*ED6 DADT=DADT+D3*3*A76/2*TSQ*ED3 DADT=DADT+D4*((A81+3*A83*T)/2/TSQ+(4*A86*T3+5*A87*T4))*ED2 DADT=DADT+D4*(A88+(2*A89+(3*A90+(4*A91+(5*A92 & +6*A93*T)*T)*T)*T)*T)*ED4 DADT=DADT+D4*D4*(A94/2/TSQ+A95+5*A100*T4)*ED2 CCC G8D03=GASCON*(HHID+T*DADT+ZZ)*TK+2.9610D+04 RETURN END C G09 *** U(J/MOL) AT TK(K) AND RO(MOL/DM**3) FUNCTION G9D03(TK,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION W(12) DATA W/3.026D+03,1.623D+03,1.342D+03,1.023D+03, & 3.103D+03,1.236D+03,0.949D+03,0.943D+03, & 3.106D+03,0.826D+03,2.989D+03,1.444D+03/ DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA AH,AC,AK/6.626196D-34,2.9979250D+08,1.380622D-23/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA GASCON,T0/8.31434D+00,298.15D+00/ CCCC AA=AH*AC/AK*1.0D+02 HHK=0.0D+00 HH0=0.0D+00 DO 10 I=1,12 HI=AA*W(I) UK=HI/TK U0=HI/T0 EUK=DEXP(UK) EU0=DEXP(U0) EUK1=EUK-1.0D+00 EU01=EU0-1.0D+00 HHK=HHK+UK/EUK1 HH0=HH0+U0/EU01 10 CONTINUE HHH=(4+HHK)*TK-(4+HH0)*T0 HHID=HHH/TK-1.0D+00 C D=RO/RC D2=D*D D3=D2*D D4=D2*D2 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D2*D4) C T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 C DADT=A2/2/TSQ+A4+1.25D+00*A5*TQT+1.75D+00*A7*T/TQT+4*A16*T3 DADT=DADT*D+D2*(2*A22+4*A26*T2+5*A27*T3+6*A28*T4)*T DADT=DADT+D3*((A29+D*A38)/4/T*TQT+3*A35*T2) DADT=DADT+D4*D2*((A44/2+2.5D+00*A48*T2)/TSQ+3*A49*T2) DADT=DADT+D*(A50/2/TSQ+A51)*ED3 DADT=DADT+D2*(A57/2/TSQ+2*A60*T+4*A62*T3)*ED2 DADT=DADT+D2*(3*A66+4*A67*T+5*A68*T2+6*A69*T3)*T2*ED4 DADT=DADT+D2*(2*A71*T+3*A72*T2+4*A73*T3)*ED6 DADT=DADT+D3*3*A76/2*TSQ*ED3 DADT=DADT+D4*((A81+3*A83*T)/2/TSQ+(4*A86*T3+5*A87*T4))*ED2 DADT=DADT+D4*(A88+(2*A89+(3*A90+(4*A91+(5*A92 & +6*A93*T)*T)*T)*T)*T)*ED4 DADT=DADT+D4*D4*(A94/2/TSQ+A95+5*A100*T4)*ED2 CCC G9D03=GASCON*(HHID+T*DADT)*TK+2.9610D+04 RETURN END C G10 *** S(J/(MOL*K)) AT TK(K) AND RO(MOL/DM**3) FUNCTION G10D03(TK,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION W(12) DATA W/3.026D+03,1.623D+03,1.342D+03,1.023D+03, & 3.103D+03,1.236D+03,0.949D+03,0.943D+03, & 3.106D+03,0.826D+03,2.989D+03,1.444D+03/ DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA AH,AC,AK/6.626196D-34,2.9979250D+08,1.380622D-23/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA T0,P0,S0/298.15D+00,0.101325D+00,219.225D+00/ DATA GASCON/8.31434D+00/ CCCC AA=AH*AC/AK*1.0D+02 SSK=0.0D+00 SS0=0.0D+00 DO 10 I=1,12 HI=AA*W(I) UK=HI/TK U0=HI/T0 EUK=DEXP(UK) EU0=DEXP(U0) EUK1=EUK-1.0D+00 EU01=EU0-1.0D+00 SSK=SSK+UK*EUK/EUK1-DLOG(EUK1) SS0=SS0+U0*EU0/EU01-DLOG(EU01) 10 CONTINUE SID=GASCON*(4.0D+00*DLOG(TK/T0)+SSK-SS0 & -DLOG(RO*1.0D+03*GASCON*TK/(P0*1.0D+06)))+S0 C D=RO/RC D2=D*D D3=D2*D D4=D2*D2 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D2*D4) C T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 C AL1=A2*TSQ+A4*T+A5*T*TQT+A7*T2/TQT+A16*T4 AL2=(A22+(A26+(A27+A28*T)*T)*T2)*T2 AL3=A29*TQT+A35*T3 AL4=A38*TQT AL6=(A44+A48*T2)*TSQ+A49*T3 AL1=AL1+(A50*TSQ+A51*T)*ED3 AL2=AL2+(A57*TSQ+(A60+A62*T2)*T2)*ED2 AL2=AL2+(A66+(A67+(A68+A69*T)*T)*T)*T3*ED4 AL2=AL2+(A71+(A72+A73*T)*T)*T2*ED6 AL3=AL3+A76*T*TSQ*ED3 AL4=AL4+((A81+A83*T)*TSQ+(A86+A87*T)*T4)*ED2 AL4=AL4+(A88+(A89+(A90+(A91+(A92+A93*T)*T)*T)*T)*T)*T*ED4 AL8=(A94*TSQ+(A95+A100*T4)*T)*ED2 ALFA=(AL1+(AL2+(AL3+(AL4+(AL6+AL8*D2)*D2)*D)*D)*D)*D CCCC DADT=A2/2/TSQ+A4+1.25D+00*A5*TQT+1.75D+00*A7*T/TQT+4*A16*T3 DADT=DADT*D+D2*(2*A22+4*A26*T2+5*A27*T3+6*A28*T4)*T DADT=DADT+D3*((A29+D*A38)/4/T*TQT+3*A35*T2) DADT=DADT+D4*D2*((A44/2+2.5D+00*A48*T2)/TSQ+3*A49*T2) DADT=DADT+D*(A50/2/TSQ+A51)*ED3 DADT=DADT+D2*(A57/2/TSQ+2*A60*T+4*A62*T3)*ED2 DADT=DADT+D2*(3*A66+4*A67*T+5*A68*T2+6*A69*T3)*T2*ED4 DADT=DADT+D2*(2*A71*T+3*A72*T2+4*A73*T3)*ED6 DADT=DADT+D3*3*A76/2*TSQ*ED3 DADT=DADT+D4*((A81+3*A83*T)/2/TSQ+(4*A86*T3+5*A87*T4))*ED2 DADT=DADT+D4*(A88+(2*A89+(3*A90+(4*A91+(5*A92 & +6*A93*T)*T)*T)*T)*T)*ED4 DADT=DADT+D4*D4*(A94/2/TSQ+A95+5*A100*T4)*ED2 CCC G10D03=GASCON*(T*DADT-ALFA)+SID RETURN END C G11 *** CV(J/(MOL*K)) AT TK(K) AND RO(MOL/DM**3) FUNCTION G11D03(TK,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION W(12) DATA W/3.026D+03,1.623D+03,1.342D+03,1.023D+03, & 3.103D+03,1.236D+03,0.949D+03,0.943D+03, & 3.106D+03,0.826D+03,2.989D+03,1.444D+03/ DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA AH,AC,AK/6.626196D-34,2.9979250D+08,1.380622D-23/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA T0,P0,S0/298.15D+00,0.101325D+00,219.225D+00/ DATA GASCON/8.31434D+00/ CCCC AA=AH*AC/AK*1.0D+02 CCC=4.0D+00 DO 10 I=1,12 HI=AA*W(I) UK=HI/TK EUK=DEXP(UK) EUK1=EUK-1.0D+00 CCC=CCC+UK*UK*EUK/EUK1**2 10 CONTINUE CVID=1.0D+00-CCC C D=RO/RC D2=D*D D3=D2*D D4=D2*D2 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D2*D4) C T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 CCCC DTT1=-A2/4/T/TSQ+1.25D+00/4*A5/T*TQT & +1.75D+00*0.75D+00*A7/TQT+4*3*A16*T2 DTT2=2*A22+(4*3*A26+(5*4*A27+6*5*A28*T)*T)*T2 DTT3=-0.75D+00*A29/4/T2*TQT+3*2*A35*T DTT4=-0.75D+00*A38/4/T2*TQT DTT6=-A44/4/T/TSQ+2.5D+00*1.5D+00*A48*TSQ+3*2*A49*T DTT1=DTT1-A50/4/T/TSQ*ED3 DTT2=DTT2+(2*A60+4*3*A62*T2-A57/4/T/TSQ)*ED2 DTT2=DTT2+(3*2*A66+(4*3*A67+(5*4*A68+6*5*A69*T)*T)*T)*T*ED4 DTT2=DTT2+(2*A71+(3*2*A72+4*3*A73*T)*T)*ED6 DTT3=DTT3+1.5D+00/2*A76/TSQ*ED3 DTT4=DTT4+((0.75D+00*A83-A81/4/T)/TSQ+4*3*A86*T2+5*4*A87*T3)*ED2 DTT4=DTT4+(2*A89+(3*2*A90+(4*3*A91+(5*4*A92 & +6*5*A93*T)*T)*T)*T)*ED4 DTT8=(5*4*A100*T3-A94/4/T/TSQ)*ED2 DADTT=(DTT1+(DTT2+(DTT3+(DTT4+(DTT6+DTT8*D2)*D2)*D)*D)*D)*D CCC G11D03=-GASCON*(T2*DADTT+CVID) RETURN END C G12 *** CPTKRO(J/(MOL*K)) AT TK(K) AND RO(MOL/DM**3) FUNCTION G12D03(TK,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA GASCON,T0/8.31434D+00,298.15D+00/ CCCC D=RO/RC D2=D*D D3=D2*D D4=D2*D2 D6=D2*D4 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D6) C T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 C AL1=A2*TSQ+A4*T+A5*T*TQT+A7*T2/TQT+A16*T4 DADD=AL1 AL2=(A22+(A26+(A27+A28*T)*T)*T2)*T2 DADD=DADD+2*D*AL2 AL3=A29*TQT+A35*T3 DADD=DADD+3*D2*AL3 AL4=A38*TQT DADD=DADD+4*D3*AL4 AL6=(A44+A48*T2)*TSQ+A49*T3 DADD=DADD+6*D4*D*AL6 DADDD=(2*AL1+(3*2*AL2+(4*3*AL3+(5*4*AL4+7*6*AL6*D2)*D)*D)*D)*D AL1=(A50*TSQ+A51*T)*ED3 DADD=DADD+AL1*(1.0D+00-3*D3) DADDD=DADDD+AL1*D*(9*D6-18*D3+2.0D+00) AL21=(A57*TSQ+(A60+A62*T2)*T2)*ED2 DADD=DADD+AL21*2*D*(1.0D+00-D2) DADDD=DADDD+AL21*2*D2*(2*D4-7*D2+3.0D+00) AL22=(A66+(A67+(A68+A69*T)*T)*T)*T3*ED4 DADD=DADD+AL22*2*D*(1.0D+00-2*D4) DADDD=DADDD+AL22*2*D2*(8*D4*D4-18*D4+3.0D+00) AL23=(A71+(A72+A73*T)*T)*T2*ED6 DADD=DADD+AL23*2*D*(1.0D+00-3*D2*D4) DADDD=DADDD+AL23*6*D2*(6*D6*D6-11*D6+1.0D+00) AL3=A76*T*TSQ*ED3 DADD=DADD+AL3*3*D2*(1.0D+00-D3) DADDD=DADDD+AL3*3*D3*(3*D6-10*D3+4.0D+00) AL41=((A81+A83*T)*TSQ+(A86+A87*T)*T4)*ED2 DADD=DADD+AL41*2*D3*(2.0D+00-D2) DADDD=DADDD+AL41*2*D4*(2*D4-11*D2+1.0D+01) AL42=(A88+(A89+(A90+(A91+(A92+A93*T)*T)*T)*T)*T)*T*ED4 DADD=DADD+AL42*4*D3*(1.0D+00-D4) DADDD=DADDD+AL42*4*D4*(4*D4*D4-13*D4+5.0D+00) AL8=(A94*TSQ+(A95+A100*T4)*T)*ED2 DADD=DADD+AL8*2*D3*D4*(4.0D+00-D2) DADDD=DADDD+AL8*2*D4*D4*(2*D4-19*D2+3.6D+01) ZZ=1.0D+00+D*DADD CCCC DT1=A2/2/TSQ+A4+1.25D+00*A5*TQT+1.75D+00*A7*T/TQT+4*A16*T3 DT2=(2*A22+(4*A26+(5*A27+6*A28*T)*T)*T2)*T DT3=A29/4/T*TQT+3*A35*T2 DT4=A38/4/T*TQT DT6=A44/2/TSQ+2.5D+00*A48*T2/TSQ+3*A49*T2 DADTD=DT1+(2*DT2+(3*DT3+(4*DT4+6*DT6*D2)*D)*D)*D DT1=(A50/2/TSQ+A51)*(1.0D+00-3*D3)*ED3 DT21=(A57/2/TSQ+2*A60*T+4*A62*T3)*2*D*(1.0D+00-D2)*ED2 DT22=(3*A66+(4*A67+(5*A68+6*A69*T)*T)*T)*T2 DT22=DT22*2*D*(1.0D+00-2*D4)*ED4 DT23=(2*A71+(3*A72+4*A73*T)*T)*T DT23=DT23*2*D*(1.0D+00-3*D2*D4)*ED6 DT3=1.5D+00*A76*TSQ*3*D2*(1.0D+00-D3)*ED3 DT41=(A81+3*A83*T)/2/TSQ+(4*A86*T3+5*A87*T4) DT41=DT41*2*D3*(2.0D+00-D2)*ED2 DT42=A88+(2*A89+(3*A90+(4*A91+(5*A92+6*A93*T)*T)*T)*T)*T DT42=DT42*4*D3*(1.0D+00-D4)*ED4 DT8=(A94/2/TSQ+A95+5*A100*T4)*2*D3*D4*(4.0D+00-D2)*ED2 DADTD=DADTD+DT1+DT21+DT22+DT23+DT3+DT41+DT42+DT8 CCC DCPCV=(ZZ-D*T*DADTD)**2/(1.0D+00+DADDD) G12D03=G11D03(TK,RO)+GASCON*DCPCV RETURN END C G13 *** W(M/S) AT TK(K) AND RO(MOL/DM**3) FUNCTION G13D03(TK,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION W(12) DATA W/3.026D+03,1.623D+03,1.342D+03,1.023D+03, & 3.103D+03,1.236D+03,0.949D+03,0.943D+03, & 3.106D+03,0.826D+03,2.989D+03,1.444D+03/ DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA AH,AC,AK/6.626196D-34,2.9979250D+08,1.380622D-23/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA T0,P0,S0/298.15D+00,0.101325D+00,219.225D+00/ DATA GASCON,AMOL/8.31434D+00,28.054D-03/ CCCC AA=AH*AC/AK*1.0D+02 CCC=4.0D+00 DO 10 I=1,12 HI=AA*W(I) UK=HI/TK EUK=DEXP(UK) EUK1=EUK-1.0D+00 CCC=CCC+UK*UK*EUK/EUK1**2 10 CONTINUE CVID=1.0D+00-CCC C D=RO/RC D2=D*D D3=D2*D D4=D2*D2 D6=D4*D2 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D6) C T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 C DTT1=-A2/4/T/TSQ+1.25D+00/4*A5/T*TQT & +1.75D+00*0.75D+00*A7/TQT+4*3*A16*T2 DTT2=2*A22+(4*3*A26+(5*4*A27+6*5*A28*T)*T)*T2 DTT3=-0.75D+00*A29/4/T2*TQT+3*2*A35*T DTT4=-0.75D+00*A38/4/T2*TQT DTT6=-A44/4/T/TSQ+2.5D+00*1.5D+00*A48*TSQ+3*2*A49*T DTT1=DTT1-A50/4/T/TSQ*ED3 DTT2=DTT2+(2*A60+4*3*A62*T2-A57/4/T/TSQ)*ED2 DTT2=DTT2+(3*2*A66+(4*3*A67+(5*4*A68+6*5*A69*T)*T)*T)*T*ED4 DTT2=DTT2+(2*A71+(3*2*A72+4*3*A73*T)*T)*ED6 DTT3=DTT3+1.5D+00/2*A76/TSQ*ED3 DTT4=DTT4+((0.75D+00*A83-A81/4/T)/TSQ+4*3*A86*T2+5*4*A87*T3)*ED2 DTT4=DTT4+(2*A89+(3*2*A90+(4*3*A91+(5*4*A92 & +6*5*A93*T)*T)*T)*T)*ED4 DTT8=(5*4*A100*T3-A94/4/T/TSQ)*ED2 DADTT=(DTT1+(DTT2+(DTT3+(DTT4+(DTT6+DTT8*D2)*D2)*D)*D)*D)*D CCC DWL=CVID+T2*DADTT CCCC AL1=A2*TSQ+A4*T+A5*T*TQT+A7*T2/TQT+A16*T4 DADD=AL1 AL2=(A22+(A26+(A27+A28*T)*T)*T2)*T2 DADD=DADD+2*D*AL2 AL3=A29*TQT+A35*T3 DADD=DADD+3*D2*AL3 AL4=A38*TQT DADD=DADD+4*D3*AL4 AL6=(A44+A48*T2)*TSQ+A49*T3 DADD=DADD+6*D4*D*AL6 DADDD=(2*AL1+(3*2*AL2+(4*3*AL3+(5*4*AL4+7*6*AL6*D2)*D)*D)*D)*D AL1=(A50*TSQ+A51*T)*ED3 DADD=DADD+AL1*(1.0D+00-3*D3) DADDD=DADDD+AL1*D*(9*D6-18*D3+2.0D+00) AL21=(A57*TSQ+(A60+A62*T2)*T2)*ED2 DADD=DADD+AL21*2*D*(1.0D+00-D2) DADDD=DADDD+AL21*2*D2*(2*D4-7*D2+3.0D+00) AL22=(A66+(A67+(A68+A69*T)*T)*T)*T3*ED4 DADD=DADD+AL22*2*D*(1.0D+00-2*D4) DADDD=DADDD+AL22*2*D2*(8*D4*D4-18*D4+3.0D+00) AL23=(A71+(A72+A73*T)*T)*T2*ED6 DADD=DADD+AL23*2*D*(1.0D+00-3*D2*D4) DADDD=DADDD+AL23*6*D2*(6*D6*D6-11*D6+1.0D+00) AL3=A76*T*TSQ*ED3 DADD=DADD+AL3*3*D2*(1.0D+00-D3) DADDD=DADDD+AL3*3*D3*(3*D6-10*D3+4.0D+00) AL41=((A81+A83*T)*TSQ+(A86+A87*T)*T4)*ED2 DADD=DADD+AL41*2*D3*(2.0D+00-D2) DADDD=DADDD+AL41*2*D4*(2*D4-11*D2+1.0D+01) AL42=(A88+(A89+(A90+(A91+(A92+A93*T)*T)*T)*T)*T)*T*ED4 DADD=DADD+AL42*4*D3*(1.0D+00-D4) DADDD=DADDD+AL42*4*D4*(4*D4*D4-13*D4+5.0D+00) AL8=(A94*TSQ+(A95+A100*T4)*T)*ED2 DADD=DADD+AL8*2*D3*D4*(4.0D+00-D2) DADDD=DADDD+AL8*2*D4*D4*(2*D4-19*D2+3.6D+01) ZZ=1.0D+00+D*DADD CCCC DT1=A2/2/TSQ+A4+1.25D+00*A5*TQT+1.75D+00*A7*T/TQT+4*A16*T3 DT2=(2*A22+(4*A26+(5*A27+6*A28*T)*T)*T2)*T DT3=A29/4/T*TQT+3*A35*T2 DT4=A38/4/T*TQT DT6=A44/2/TSQ+2.5D+00*A48*T2/TSQ+3*A49*T2 DADTD=DT1+(2*DT2+(3*DT3+(4*DT4+6*DT6*D2)*D)*D)*D DT1=(A50/2/TSQ+A51)*(1.0D+00-3*D3)*ED3 DT21=(A57/2/TSQ+2*A60*T+4*A62*T3)*2*D*(1.0D+00-D2)*ED2 DT22=(3*A66+(4*A67+(5*A68+6*A69*T)*T)*T)*T2 DT22=DT22*2*D*(1.0D+00-2*D4)*ED4 DT23=(2*A71+(3*A72+4*A73*T)*T)*T DT23=DT23*2*D*(1.0D+00-3*D2*D4)*ED6 DT3=1.5D+00*A76*TSQ*3*D2*(1.0D+00-D3)*ED3 DT41=(A81+3*A83*T)/2/TSQ+(4*A86*T3+5*A87*T4) DT41=DT41*2*D3*(2.0D+00-D2)*ED2 DT42=A88+(2*A89+(3*A90+(4*A91+(5*A92+6*A93*T)*T)*T)*T)*T DT42=DT42*4*D3*(1.0D+00-D4)*ED4 DT8=(A94/2/TSQ+A95+5*A100*T4)*2*D3*D4*(4.0D+00-D2)*ED2 DADTD=DADTD+DT1+DT21+DT22+DT23+DT3+DT41+DT42+DT8 CCC DWU=(ZZ-D*T*DADTD)**2 WWW=GASCON/AMOL*TK*(1.0D+00+DADDD-DWU/DWL) G13D03=DSQRT(WWW) RETURN END C G14 *** SATURATED LIQUID ENTHALPY HLT(J/MOL) AT T(K) FUNCTION G14D03(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) RL=G3D03(T) G14D03=G8D03(T,RL) RETURN END C G15 *** SATURATED VAPOR ENTHALPY HVT(J/MOL) AT T(K) FUNCTION G15D03(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) RV=G4D03(T) G15D03=G8D03(T,RV) RETURN END C G16 *** SATURATED LIQUID ENTROPY SLT(J/(MOL*K)) AT T(K) FUNCTION G16D03(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) RL=G3D03(T) G16D03=G10D03(T,RL) RETURN END C G17 *** SATURATED VAPOR ENTROPY SVT(J/(MOL*K)) AT T(K) FUNCTION G17D03(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) RV=G4D03(T) G17D03=G10D03(T,RV) RETURN END C G18 *** SATURATED LIQUID INTERNAL ENERGY ULT(J/MOL) AT T(K) FUNCTION G18D03(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) RL=G3D03(T) G18D03=G9D03(T,RL) RETURN END C G19 *** SATURATED VAPOR INTERNAL ENERGY UVT(J/MOL) AT T(K) FUNCTION G19D03(T) IMPLICIT DOUBLE PRECISION(A-H,O-Z) RV=G4D03(T) G19D03=G9D03(T,RV) RETURN END C G20 *** LIQUID ISOCHORIC SPECIFIC HEAT CVLT(J/(MOL*K)) AT T(K) FUNCTION G20D03(YT) IMPLICIT DOUBLE PRECISION (G,Y) YRL=G3D03(YT) G20D03=G11D03(YT,YRL) RETURN END C G21 *** VAPOR ISOCHORIC SPECIFIC HEAT CVVT(J/(MOL*K)) AT T(K) FUNCTION G21D03(YT) IMPLICIT DOUBLE PRECISION (G,Y) YRV=G4D03(YT) G21D03=G11D03(YT,YRV) RETURN END C G22 *** LIQUID ISOBARIC SPECIFIC HEAT CPLT(J/(MOL*K)) AT T(K) FUNCTION G22D03(YT) IMPLICIT DOUBLE PRECISION (G,Y) YRL=G3D03(YT) G22D03=G12D03(YT,YRL) RETURN END C G23 *** VAPOR ISOBARIC SPECIFIC HEAT CPVT(J/(MOL*K)) AT T(K) FUNCTION G23D03(YT) IMPLICIT DOUBLE PRECISION (G,Y) YRV=G4D03(YT) G23D03=G12D03(YT,YRV) RETURN END C G24 *** LIQUID VELOCITY OF SOUND WLT(M/S) AT T(K) FUNCTION G24D03(YT) IMPLICIT DOUBLE PRECISION (G,Y) YRL=G3D03(YT) G24D03=G13D03(YT,YRL) RETURN END C G25 *** VAPOR VELOCITY OF SOUND WVT(M/S) AT T(K) FUNCTION G25D03(YT) IMPLICIT DOUBLE PRECISION (G,Y) YRV=G4D03(YT) G25D03=G13D03(YT,YRV) RETURN END C G26 *** DENSITY MOL/DM**3 AT P MPA AND T K FUNCTION G26D03(P,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA TCR,PCR,RCR/282.3452D+00,5.0401D+00,7.6340D+00/ DATA TTR,PTR/103.986D+00,1.225D-04/ DPPC=DABS(P/PCR-1.0D+00) IF (DPPC.LT.1.0D-05) THEN DTTC=DABS(TK/TCR-1.0D+00) IF (DTTC.LT.1.0D-05) THEN G26D03=RCR RETURN ENDIF ENDIF IF (P.GE.PCR) THEN IF (TK.LT.155.0) THEN RMAX=25.3D0 RMIN=21.1D0 ELSE RMAX=24.9D0 RMIN=1.42D0 ENDIF ELSEIF (TK.GT.TCR) THEN RMAX=23.42D0 RMIN=1D-03 ELSE PS=G1D03(TK) ROL=G3D03(TK) ROG=G4D03(TK) IF (P.GT.PS) THEN RMAX=23.42D0 RMIN=ROL ELSE RMAX=ROG RMIN=1D-03 ENDIF ENDIF RST1=G45D03(RMAX,RMIN,P,TK) G26D03=G44D03(P,TK,RST1) RETURN END C G27 *** DVDT(DM**3/MOL/K) AT TK(K) AND RO(MOL/DM**3) FUNCTION G27D03(TK,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA GASCON/8.31434D-03/ CCCC D=RO/RC D2=D*D D3=D2*D D4=D2*D2 D6=D2*D4 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D6) C T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 C AL1=A2*TSQ+A4*T+A5*T*TQT+A7*T2/TQT+A16*T4 DADD=AL1 AL2=(A22+(A26+(A27+A28*T)*T)*T2)*T2 DADD=DADD+2*D*AL2 AL3=A29*TQT+A35*T3 DADD=DADD+3*D2*AL3 AL4=A38*TQT DADD=DADD+4*D3*AL4 AL6=(A44+A48*T2)*TSQ+A49*T3 DADD=DADD+6*D4*D*AL6 DADDD=(2*AL1+(3*2*AL2+(4*3*AL3+(5*4*AL4+7*6*AL6*D2)*D)*D)*D)*D AL1=(A50*TSQ+A51*T)*ED3 DADD=DADD+AL1*(1.0D+00-3*D3) DADDD=DADDD+AL1*D*(9*D6-18*D3+2.0D+00) AL21=(A57*TSQ+(A60+A62*T2)*T2)*ED2 DADD=DADD+AL21*2*D*(1.0D+00-D2) DADDD=DADDD+AL21*2*D2*(2*D4-7*D2+3.0D+00) AL22=(A66+(A67+(A68+A69*T)*T)*T)*T3*ED4 DADD=DADD+AL22*2*D*(1.0D+00-2*D4) DADDD=DADDD+AL22*2*D2*(8*D4*D4-18*D4+3.0D+00) AL23=(A71+(A72+A73*T)*T)*T2*ED6 DADD=DADD+AL23*2*D*(1.0D+00-3*D2*D4) DADDD=DADDD+AL23*6*D2*(6*D6*D6-11*D6+1.0D+00) AL3=A76*T*TSQ*ED3 DADD=DADD+AL3*3*D2*(1.0D+00-D3) DADDD=DADDD+AL3*3*D3*(3*D6-10*D3+4.0D+00) AL41=((A81+A83*T)*TSQ+(A86+A87*T)*T4)*ED2 DADD=DADD+AL41*2*D3*(2.0D+00-D2) DADDD=DADDD+AL41*2*D4*(2*D4-11*D2+1.0D+01) AL42=(A88+(A89+(A90+(A91+(A92+A93*T)*T)*T)*T)*T)*T*ED4 DADD=DADD+AL42*4*D3*(1.0D+00-D4) DADDD=DADDD+AL42*4*D4*(4*D4*D4-13*D4+5.0D+00) AL8=(A94*TSQ+(A95+A100*T4)*T)*ED2 DADD=DADD+AL8*2*D3*D4*(4.0D+00-D2) DADDD=DADDD+AL8*2*D4*D4*(2*D4-19*D2+3.6D+01) CCCC DT1=A2/2/TSQ+A4+1.25D+00*A5*TQT+1.75D+00*A7*T/TQT+4*A16*T3 DT2=(2*A22+(4*A26+(5*A27+6*A28*T)*T)*T2)*T DT3=A29/4/T*TQT+3*A35*T2 DT4=A38/4/T*TQT DT6=A44/2/TSQ+2.5D+00*A48*T2/TSQ+3*A49*T2 DADTD=DT1+(2*DT2+(3*DT3+(4*DT4+6*DT6*D2)*D)*D)*D DT1=(A50/2/TSQ+A51)*(1.0D+00-3*D3)*ED3 DT21=(A57/2/TSQ+2*A60*T+4*A62*T3)*2*D*(1.0D+00-D2)*ED2 DT22=(3*A66+(4*A67+(5*A68+6*A69*T)*T)*T)*T2 DT22=DT22*2*D*(1.0D+00-2*D4)*ED4 DT23=(2*A71+(3*A72+4*A73*T)*T)*T DT23=DT23*2*D*(1.0D+00-3*D2*D4)*ED6 DT3=1.5D+00*A76*TSQ*3*D2*(1.0D+00-D3)*ED3 DT41=(A81+3*A83*T)/2/TSQ+(4*A86*T3+5*A87*T4) DT41=DT41*2*D3*(2.0D+00-D2)*ED2 DT42=A88+(2*A89+(3*A90+(4*A91+(5*A92+6*A93*T)*T)*T)*T)*T DT42=DT42*4*D3*(1.0D+00-D4)*ED4 DT8=(A94/2/TSQ+A95+5*A100*T4)*2*D3*D4*(4.0D+00-D2)*ED2 DADTD=DADTD+DT1+DT21+DT22+DT23+DT3+DT41+DT42+DT8 CCC ZZZ=(1.0D+00+D*DADD-D*T*DADTD)/(1.0D+00+DADDD) G27D03=ZZZ/RO/TK RETURN END C G28 *** DPDV(MPA/(DM**3/MOL)) AT TK(K) AND RO(MOL/DM**3) FUNCTION G28D03(TK,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA GASCON/8.31434D-03/ CCCC D=RO/RC D2=D*D D3=D2*D D4=D2*D2 D6=D2*D4 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D6) C T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 C AL1=A2*TSQ+A4*T+A5*T*TQT+A7*T2/TQT+A16*T4 AL2=(A22+(A26+(A27+A28*T)*T)*T2)*T2 AL3=A29*TQT+A35*T3 AL4=A38*TQT AL6=(A44+A48*T2)*TSQ+A49*T3 DADDD=(2*AL1+(3*2*AL2+(4*3*AL3+(5*4*AL4+7*6*AL6*D2)*D)*D)*D)*D AL1=(A50*TSQ+A51*T)*ED3 DADDD=DADDD+AL1*D*(9*D6-18*D3+2.0D+00) AL21=(A57*TSQ+(A60+A62*T2)*T2)*ED2 DADDD=DADDD+AL21*2*D2*(2*D4-7*D2+3.0D+00) AL22=(A66+(A67+(A68+A69*T)*T)*T)*T3*ED4 DADDD=DADDD+AL22*2*D2*(8*D4*D4-18*D4+3.0D+00) AL23=(A71+(A72+A73*T)*T)*T2*ED6 DADDD=DADDD+AL23*6*D2*(6*D6*D6-11*D6+1.0D+00) AL3=A76*T*TSQ*ED3 DADDD=DADDD+AL3*3*D3*(3*D6-10*D3+4.0D+00) AL41=((A81+A83*T)*TSQ+(A86+A87*T)*T4)*ED2 DADDD=DADDD+AL41*2*D4*(2*D4-11*D2+1.0D+01) AL42=(A88+(A89+(A90+(A91+(A92+A93*T)*T)*T)*T)*T)*T*ED4 DADDD=DADDD+AL42*4*D4*(4*D4*D4-13*D4+5.0D+00) AL8=(A94*TSQ+(A95+A100*T4)*T)*ED2 DADDD=DADDD+AL8*2*D4*D4*(2*D4-19*D2+3.6D+01) CCCC ZZZ=1.0D+00+DADDD G28D03=-RO*RO*GASCON*TK*ZZZ RETURN END C G29 *** DPDT(MPA/K) AT TK(K) AND RO(MOL/DM**3) FUNCTION G29D03(TK,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A2,A4,A5,A7,A16,A22,A26,A27,A28,A29,A35,A38, & A44,A48,A49,A50,A51,A57,A60,A62,A66,A67,A68,A69 & / 3.248937034D+00,-1.017278862D+01, 7.386604053D+00, & -1.568916359D+00,-8.884514287D-02, 6.021068143D-02, & 1.078324588D-01,-2.004025211D-02, 1.950491412D-03, & 6.718006403D-02,-4.200451469D-02,-1.620507626D-03, & 5.555156795D-04, 7.583671146D-04,-2.878544021D-04, & 6.258987063D-02,-6.418431160D-02,-1.368693752D-01, & 5.179207660D-01,-3.026331319D-01, 7.757213872D-01, & -2.639890864D+00, 2.927563554D+00,-1.066267599D+00/ DATA A71,A72,A73,A76,A81,A83,A86,A87,A88,A89,A90,A91, & A92,A93,A94,A95,A100 & /-5.380471540D-02, 1.277921080D-01,-7.450152310D-02, & -1.624304356D-02, 1.476032429D-01,-2.003910489D-01, & 2.926905618D-01,-1.389040901D-01, 5.913513541D+00, & -3.800370130D+01, 9.691940570D+01,-1.226256839D+02, & 7.702379476D+01,-1.922684672D+01,-3.800045701D-03, & 1.118003813D-02, 2.945841426D-03/ DATA TC,PC,RC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA GASCON,T0/8.31434D-03,298.15D+00/ CCCC D=RO/RC D2=D*D D3=D2*D D4=D2*D2 D6=D2*D4 ED2=DEXP(-D2) ED3=DEXP(-D3) ED4=DEXP(-D4) ED6=DEXP(-D6) C T=TC/TK TSQ=DSQRT(T) TQT=DSQRT(TSQ) T2=T*T T3=T2*T T4=T2*T2 C AL1=A2*TSQ+A4*T+A5*T*TQT+A7*T2/TQT+A16*T4 DADD=AL1 AL2=(A22+(A26+(A27+A28*T)*T)*T2)*T2 DADD=DADD+2*D*AL2 AL3=A29*TQT+A35*T3 DADD=DADD+3*D2*AL3 AL4=A38*TQT DADD=DADD+4*D3*AL4 AL6=(A44+A48*T2)*TSQ+A49*T3 DADD=DADD+6*D4*D*AL6 AL1=(A50*TSQ+A51*T)*ED3 DADD=DADD+AL1*(1.0D+00-3*D3) AL21=(A57*TSQ+(A60+A62*T2)*T2)*ED2 DADD=DADD+AL21*2*D*(1.0D+00-D2) AL22=(A66+(A67+(A68+A69*T)*T)*T)*T3*ED4 DADD=DADD+AL22*2*D*(1.0D+00-2*D4) AL23=(A71+(A72+A73*T)*T)*T2*ED6 DADD=DADD+AL23*2*D*(1.0D+00-3*D2*D4) AL3=A76*T*TSQ*ED3 DADD=DADD+AL3*3*D2*(1.0D+00-D3) AL41=((A81+A83*T)*TSQ+(A86+A87*T)*T4)*ED2 DADD=DADD+AL41*2*D3*(2.0D+00-D2) AL42=(A88+(A89+(A90+(A91+(A92+A93*T)*T)*T)*T)*T)*T*ED4 DADD=DADD+AL42*4*D3*(1.0D+00-D4) AL8=(A94*TSQ+(A95+A100*T4)*T)*ED2 DADD=DADD+AL8*2*D3*D4*(4.0D+00-D2) CCCC DT1=A2/2/TSQ+A4+1.25D+00*A5*TQT+1.75D+00*A7*T/TQT+4*A16*T3 DT2=(2*A22+(4*A26+(5*A27+6*A28*T)*T)*T2)*T DT3=A29/4/T*TQT+3*A35*T2 DT4=A38/4/T*TQT DT6=A44/2/TSQ+2.5D+00*A48*T2/TSQ+3*A49*T2 DADTD=DT1+(2*DT2+(3*DT3+(4*DT4+6*DT6*D2)*D)*D)*D DT1=(A50/2/TSQ+A51)*(1.0D+00-3*D3)*ED3 DT21=(A57/2/TSQ+2*A60*T+4*A62*T3)*2*D*(1.0D+00-D2)*ED2 DT22=(3*A66+(4*A67+(5*A68+6*A69*T)*T)*T)*T2 DT22=DT22*2*D*(1.0D+00-2*D4)*ED4 DT23=(2*A71+(3*A72+4*A73*T)*T)*T DT23=DT23*2*D*(1.0D+00-3*D2*D4)*ED6 DT3=1.5D+00*A76*TSQ*3*D2*(1.0D+00-D3)*ED3 DT41=(A81+3*A83*T)/2/TSQ+(4*A86*T3+5*A87*T4) DT41=DT41*2*D3*(2.0D+00-D2)*ED2 DT42=A88+(2*A89+(3*A90+(4*A91+(5*A92+6*A93*T)*T)*T)*T)*T DT42=DT42*4*D3*(1.0D+00-D4)*ED4 DT8=(A94/2/TSQ+A95+5*A100*T4)*2*D3*D4*(4.0D+00-D2)*ED2 DADTD=DADTD+DT1+DT21+DT22+DT23+DT3+DT41+DT42+DT8 CCC ZZZ=1.0D+00+D*DADD-D*T*DADTD G29D03=RO*GASCON*ZZZ RETURN END C G44 *** DENSITY MOL/DM**3 BY NEWTON-METHOD C C *** AT P MPA AND T K R1=INITIAL VALUE FUNCTION G44D03(P,T,R1) IMPLICIT DOUBLE PRECISION (A-H,O-Z) ILOOP=0 10 CALL S1D03(T,R1,P1,DPDRO1) R2=(P-P1)/DPDRO1+R1 ILOOP=ILOOP+1 IF (ILOOP.EQ.1000) THEN G44D03=-1.0E+10 ELSEIF (DABS((R2-R1)/R2).LT.1.0D-07) THEN G44D03=R2 ELSE R1=R2 GOTO 10 ENDIF RETURN END C G45 *** DETERMINATION OF INITIAL VALUE C C *** RO MOL/DM**3 AT P MPA AND T K FUNCTION G45D03(RMAX,RMIN,P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) ILOOP=0 RA=RMAX RB=RMIN PA=G7D03(T,RA) PB=G7D03(T,RB) 10 DPA=P-PA DPB=P-PB RC=(RA+RB)*0.5D+00 PC=G7D03(T,RC) DPC=P-PC IF (DPA*DPC.LE.0.0 .AND. DPB*DPC.GT.0.0) THEN RB=RC PB=PC ELSEIF (DPA*DPC.GT.0.0 .AND. DPB*DPC.LE.0.0) THEN RA=RC PA=PC ELSE RA=1.1*RA RB=0.9*RB PA=G7D03(T,RA) PB=G7D03(T,RB) ENDIF ILOOP=ILOOP+1 IF (ILOOP.EQ.10000) THEN G45D03=-1.0E+10 ELSEIF (DABS(RA-RB)/RB.GT.1.0D-02) THEN GOTO 10 ELSE G45D03=RC ENDIF RETURN END C G46 *** TEMPERATURE K FROM P MPA AND RO MOL/DM**3 FUNCTION G46D03(P,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA TCR,PCR,RCR/282.3452D+00,5.0401D+00,7.6340D+00/ DATA TTR,PTR/103.986D+00,1.225D-04/ DATA GASCON/8.31434D-03/ DPPC=DABS(P/PCR-1.0D+00) IF (DPPC.LT.1.0D-05) THEN DRRC=DABS(RO/RCR-1.0D+00) IF (DRRC.LT.1.0D-05) THEN G46D03=TCR RETURN ENDIF ENDIF TMIN=G6D03(P) IF (P.LE.40.0D0) THEN TMAX=450D0 ELSE TMAX=350D0 ENDIF RMAX=G26D03(P,TMAX) RMIN=G26D03(P,TMIN) IF (RO.LT.RMAX .OR. RO.GT.RMIN) GOTO 999 IF (P.GT.PCR) THEN TA=TMAX RA=RMAX TB=TMIN RB=RMIN ELSE TS=G2D03(P) RG=G4D03(TS) RL=G3D03(TS) IF (RO.GT.RL) THEN TA=TS RA=RL TB=TMIN RB=RMIN ELSEIF (RO.GE.RG) THEN G46D03=TS RETURN ELSE TA=TMAX RA=RMAX TB=TS RB=RG ENDIF ENDIF ILOOP=0 10 DRA=RO-RA DRB=RO-RB T=(TA+TB)*0.5D+00 RC=G26D03(P,T) DRC=RO-RC IF (DRA*DRC.LE.0.0 .AND. DRB*DRC.GT.0.0) THEN TB=T RB=RC ELSEIF (DRA*DRC.GT.0.0 .AND. DRB*DRC.LE.0.0) THEN TA=T RA=RC ENDIF ILOOP=ILOOP+1 IF (ILOOP.EQ.10000) THEN G46D03=-1.0E+10 ELSEIF (DABS((RA-RB)/RO).GT.1.0D-07) THEN GOTO 10 ELSE G46D03=T ENDIF RETURN 999 G46D03=-1.0E+20 RETURN END C G47 *** SURFACE TENSION N/M AT T C FUNCTION G47D03(T) SIG1=19.52E-3 RDT=(9.9-T)/(9.9+120) SIG=SIG1*RDT**1.2760 IF (SIG.LT.0.26E-04) SIG=0 G47D03=SIG RETURN END C S10 *** T(P0,H0) R(P0,H0) FROM P(T,R)-P0=0 AND H(T,R)-H0=0 SUBROUTINE S10D03(P,H,T,R,S,U) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA TTC,PPC,RRC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA TTR,PTR/103.986D+00,1.225D-04/ IF (P.LT.0.01D0 .OR. P.GT.260D0) GOTO 999 DPPC=DABS(P/PPC-1.0D+00) IF (DPPC.LT.1.0D-05) THEN HHC=G8D03(TTC,RRC) DHHC=DABS(H/HHC-1.0D+00) IF (DHHC.LT.1.0D-05) THEN T=TTC R=RRC S=G10D03(T,R) U=G9D03(T,R) RETURN ENDIF ENDIF TMIN=G6D03(P) IF (P.LE.40.0D0) THEN TMAX=450D0 ELSE TMAX=350D0 ENDIF RMAX=G26D03(P,TMAX) RMIN=G26D03(P,TMIN) HMAX=G8D03(TMAX,RMAX) HMIN=G8D03(TMIN,RMIN) IF (H.LT.HMIN .OR. H.GT.HMAX) GOTO 999 IF (P.GT.PPC) THEN TA=TMAX RA=RMAX HA=HMAX TB=TMIN RB=RMIN HB=HMIN ELSE T=G2D03(P) RG=G4D03(T) RL=G3D03(T) HG=G8D03(T,RG) HL=G8D03(T,RL) IF (H.LT.HL) THEN TA=T RA=RL HA=HL TB=TMIN RB=RMIN HB=HMIN ELSEIF (H.LE.HG) THEN VG=1/RG VL=1/RL X=(H-HL)/(HG-HL) V=VL+X*(VG-VL) R=1D0/V SL=G10D03(T,RL) SG=G10D03(T,RG) S=SL+X*(SG-SL) UL=G9D03(T,RL) UG=G9D03(T,RG) U=UL+X*(UG-UL) RETURN ELSE TA=TMAX RA=RMAX HA=HMAX TB=T RB=RG HB=HG ENDIF ENDIF ILOOP=0 10 DHA=H-HA DHB=H-HB T=(TA+TB)*0.5D+00 R=G26D03(P,T) HC=G8D03(T,R) DHC=H-HC IF (DHA*DHC.LE.0.0 .AND. DHB*DHC.GT.0.0) THEN TB=T RB=R HB=HC ELSEIF (DHA*DHC.GT.0.0 .AND. DHB*DHC.LE.0.0) THEN TA=T RA=R HA=HC ENDIF ILOOP=ILOOP+1 IF (ILOOP.EQ.10000) THEN T=-1.0E+10 R=-1.0E+10 S=-1.0E+10 U=-1.0E+10 ELSEIF (DABS((HA-HB)/H).GT.1.0D-07) THEN GOTO 10 ELSE S=G10D03(T,R) U=G9D03(T,R) ENDIF RETURN 999 T=-1.0E+20 R=-1.0E+20 S=-1.0E+20 U=-1.0E+20 RETURN END C S11 *** T(P0,S0) R(P0,S0) FROM P(T,R)-P0=0 AND S(T,R)-S0=0 SUBROUTINE S11D03(P,S,T,R,H,U) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA TTC,PPC,RRC/282.3452D+00,5.0401D+00,7.6340D+00/ DATA TTR,PTR/103.986D+00,1.225D-04/ DATA GASCON/8.31434D-03/ IF (P.LT.0.01D0 .OR. P.GT.260D0) GOTO 999 DPPC=DABS(P/PPC-1.0D+00) IF (DPPC.LT.1.0D-05) THEN SSC=G10D03(TTC,RRC) DSSC=DABS(S/SSC-1.0D+00) IF (DSSC.LT.1.0D-05) THEN T=TTC R=RRC H=G8D03(T,R) U=G9D03(T,R) RETURN ENDIF ENDIF TMIN=G6D03(P) IF (P.LE.40.0D0) THEN TMAX=450D0 ELSE TMAX=350D0 ENDIF RMAX=G26D03(P,TMAX) RMIN=G26D03(P,TMIN) SMAX=G10D03(TMAX,RMAX) SMIN=G10D03(TMIN,RMIN) IF (S.LT.SMIN .OR. S.GT.SMAX) GOTO 999 IF (P.GT.PPC) THEN TA=TMAX RA=RMAX SA=SMAX TB=TMIN RB=RMIN SB=SMIN ELSE T=G2D03(P) RG=G4D03(T) RL=G3D03(T) SG=G10D03(T,RG) SL=G10D03(T,RL) IF (S.LT.SL) THEN TA=T RA=RL SA=SL TB=TMIN RB=RMIN SB=SMIN ELSEIF (S.LE.SG) THEN VL=1D0/RL VG=1D0/RG X=(S-SL)/(SG-SL) V=VL+X*(VG-VL) R=1D0/V HG=G8D03(T,RG) HL=G8D03(T,RL) H=HL+X*(HG-HL) UG=G9D03(T,RG) UL=G9D03(T,RL) U=UL+X*(UG-UL) RETURN ELSE TA=TMAX RA=RMAX SA=SMAX TB=T RB=RG SB=SG ENDIF ENDIF ILOOP=0 10 DSA=S-SA DSB=S-SB T=(TA+TB)*0.5D+00 R=G26D03(P,T) SC=G10D03(T,R) DSC=S-SC IF (DSA*DSC.LE.0.0 .AND. DSB*DSC.GT.0.0) THEN TB=T RB=R SB=SC ELSEIF (DSA*DSC.GT.0.0 .AND. DSB*DSC.LE.0.0) THEN TA=T RA=R SA=SC ENDIF ILOOP=ILOOP+1 IF (ILOOP.EQ.10000) THEN T=-1.0E+10 R=-1.0E+10 H=-1.0E+10 U=-1.0E+10 ELSEIF (DABS((SA-SB)/S).GT.1.0D-07) THEN GOTO 10 ELSE H=G8D03(T,R) U=G9D03(T,R) ENDIF RETURN 999 T=-1.0E+20 R=-1.0E+20 H=-1.0E+20 U=-1.0E+20 RETURN END C ************************************************** C * EVALUATION AND CORRELATION OF VISCOSITY DATA: * C * THE MOST PROBABLE VALUES OF THE VISCOSITY OF * C * GASEOUS ETHAN AND ETYLENE. * C * * C * T.MAKITA, Y.TANAKA, AND A.NAGASHIMA * C * * C * THE REVIEW OF PHYSICAL CHEMISTRY OF JAPAN, * C * (1) VOL.44,NO.2,PP.98-111,1975, * C * (2) VOL.46.NO.1,PP.54-55, 1976. * C * * C * CODED BY * C * * C * TOMOHIRO HONDA * C * FUKUOKA UNIVERSITY, FUKUOKA 814-01, JAPAN * C * JANUARY, 1989 * C ************************************************** C G51 VISCOSITY OF ETHYLENE PA*S AT PB BAR AND TK K FUNCTION G51D03(PB,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PH,PL,TH,TL/120D+00,100D+00,373.15D+00,297.15D+00/ DATA A0,A1,A2,A3,A4 & / 4.246821D+02,-2.187278D+00, 2.715949D-02, & -5.494674D-05, 3.773645D-08/ DATA B00,B01,B02,B03,B04 & / 1.132723D+05,-1.480752D+08, 7.352706D+10, & -1.623172D+13, 1.340907D+15/ DATA B10,B11,B12,B13,B14 & /-1.026810D+04, 1.351976D+07,-6.637443D+09, & 1.439961D+12,-1.164414D+14/ DATA B20,B21,B22,B23,B24 & / 3.102819D+02,-3.926019D+05, 1.840298D+08, & -3.780408D+10, 2.864169D+12/ DATA B30,B31,B32,B33,B34 & / 3.978220D-01,-1.076534D+03, 8.307573D+05, & -2.533540D+08, 2.710515D+10/ DATA B40,B41,B42,B43,B44 & /-3.985915D-03, 6.905955D+00,-4.236190D+03, & 1.106715D+06,-1.047300D+08/ DATA D00,D01,D02,D03,D04 & / 5.917752D+05,-5.703392D+08, 1.855210D+11, & -2.177056D+13, 4.512506D+14/ DATA D10,D11,D12,D13,D14 & / 4.385706D+02,-2.730739D+06, 2.325611D+09, & -6.995046D+11, 7.095611D+13/ DATA D20,D21,D22,D23,D24 & / 5.520574D+00,-4.510650D+02,-2.793001D+06, & 1.181917D+09,-1.362136D+11/ DATA D30,D31,D32,D33,D34 & /-1.171499D-02, 6.319410D+00, 8.220850D+02, & -9.045336D+05, 1.222175D+08/ DATA D40,D41,D42,D43,D44 & / 8.567417D-06,-6.988449D-03, 1.625683D+00, & -2.973166D+01,-1.836842D+04/ IF (TK.LT.TL .OR. TK.GT.TH) THEN G51D03=-1.0E+20 RETURN ENDIF IF (PB.LT.0.0D+00 .OR. PB.GT.800D+00) THEN G51D03=-1.0E+20 RETURN ENDIF TI=1.0D+00/TK IF (PB.LE.PL) THEN IP=0 ELSEIF (PB.GE.PH) THEN IP=2 ELSE PM=PL+(PH-PL)*(TK-TL)/(TH-TL) IF (PB.LE.PM) THEN IP=0 ELSE IP=2 ENDIF ENDIF IF (IP.EQ.0) THEN V0=B00+(B01+(B02+(B03+B04*TI)*TI)*TI)*TI V1=B10+(B11+(B12+(B13+B14*TI)*TI)*TI)*TI V2=B20+(B21+(B22+(B23+B24*TI)*TI)*TI)*TI V3=B30+(B31+(B32+(B33+B34*TI)*TI)*TI)*TI V4=B40+(B41+(B42+(B43+B44*TI)*TI)*TI)*TI ELSE V0=D00+(D01+(D02+(D03+D04*TI)*TI)*TI)*TI V1=D10+(D11+(D12+(D13+D14*TI)*TI)*TI)*TI V2=D20+(D21+(D22+(D23+D24*TI)*TI)*TI)*TI V3=D30+(D31+(D32+(D33+D34*TI)*TI)*TI)*TI V4=D40+(D41+(D42+(D43+D44*TI)*TI)*TI)*TI ENDIF VV=V0+(V1+(V2+(V3+V4*PB)*PB)*PB)*PB G51D03=VV*1.0D-08 RETURN END C *** FUNCTION FOR REGION CHECK C G91 FUNC(P) TYPE FUNCTION G91D03(P) DOUBLE PRECISION PCR,PTR,DP,PD INTEGER G91D03 DATA PCR,PTR/50.401D+00,1.225D-03/ PD=DBLE(P) IF (PD.LT.PTR) THEN G91D03=3 ELSEIF (PD.LT.PCR+0.00001D+00) THEN G91D03=0 ELSE G91D03=3 ENDIF IF (G91D03.EQ.0) THEN DP=1.0D+00-PD/PCR IF (DP.LT.1.0D-05) THEN G91D03=1 ENDIF ENDIF RETURN END C G92 FUNC(T) TYPE FUNCTION G92D03(T) DOUBLE PRECISION TTR,TCR,TKCR,TD,TK,DT INTEGER G92D03 DATA TTR,TCR,TKCR/-169.164D+00,9.1952E+00,282.3452D+00/ TD=DBLE(T) IF (TD.LT.TTR) THEN G92D03=3 ELSEIF (TD.LT.TCR+0.00001D+00) THEN G92D03=0 ELSE G92D03=3 ENDIF IF (G92D03.EQ.0) THEN TK=TD+273.15D+00 DT=1.0D+00-TK/TKCR IF (DT.LT.1.0D-05) THEN G92D03=1 ENDIF ENDIF RETURN END C G93 FUNC(P,T) TYPE FUNCTION G93D03(P,T) DOUBLE PRECISION G6D03,YP INTEGER G93D03 DATA PCR,TCR/50.401E+00,9.1952E+00/ DP=ABS(1.0E+00-P/PCR) TK=TCR+273.15E+00 DT=ABS(1.0E+00-(T+273.15E+00)/TK) IF (DP.LE.1.0E-05 .AND. DT.LE.1.0E-05) THEN G93D03=1 RETURN ELSEIF (P.GE.0.1) THEN IF (P.LE.2600) THEN YP=1.0D-01*DBLE(P) TMIN=REAL(G6D03(YP))-273.15E+00 IF (T.GE.TMIN) THEN IF (P.LE.400) THEN TMAX=450-273.15E+00 ELSE TMAX=350-273.15E+00 ENDIF IF (T.LE.TMAX) THEN G93D03=2 RETURN ENDIF ENDIF ENDIF ENDIF G93D03=3 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