C ************************************* C * PROPATH FOR CO2 * C * * C * CODED (FEBRUARY 1988) * C * REVISED (MARCH 1989) * C * VERSION 7.1 * C * REVISED (MARCH 1990) * C * VERSION 8.1 * C * REVISED (AUGUST 1991) * C * * C * BY * C * TOMOHIRO HONDA * C * (FUKUOKA UNIVERSITY) * C * FUKUOKA 814-01, JAPAN * C ************************************* C ************************************* C * SUPERVISOR FOR CO2 * C * CODED (FEB. 1988) VER.1.1 * C * REVISED (DEC. 1988) VER.2.1 * C * REVISED (MAR. 1989) VER.2.2 * C * REVISED (AUG. 1991) VER.3.1 * 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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(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 S99D02(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99D02(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'AJTPT'/ C--- SET OF UNIT - PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL - FF = F94D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - AJTPT=FF RETURN END C------------------------------------------------- F82 = AKPT FUNCTION AKPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'AKPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F82D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AKPT=FF RETURN END C------------------------------------------------- F2 = ALAPP FUNCTION ALAPP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'ALAPP'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F2D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALAPP=FF RETURN END C------------------------------------------------- F3 = ALAPT FUNCTION ALAPT(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'ALAPT'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F3D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALAPT=FF RETURN END C------------------------------------------------- F4 = ALHP FUNCTION ALHP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'ALHP'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F4D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALHP=FF RETURN END C------------------------------------------------- F5 = ALHT FUNCTION ALHT(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'ALHT'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F5D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'ALMPD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F6D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMPD=FF RETURN END C------------------------------------------------- F7 = ALMPDD FUNCTION ALMPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'ALMPDD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F7D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMPDD=FF RETURN END C------------------------------------------------- F8 = ALMPT FUNCTION ALMPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'ALMPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F8D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMPT=FF RETURN END C------------------------------------------------- F9 = ALMTD FUNCTION ALMTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'ALMTD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F9D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMTD=FF RETURN END C------------------------------------------------- F10 = ALMTDD FUNCTION ALMTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'ALMTDD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F10D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMTDD=FF RETURN END C------------------------------------------------- F11 = AMUPD FUNCTION AMUPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'AMUPD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F11D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUPD=FF RETURN END C------------------------------------------------- F12 = AMUPDD FUNCTION AMUPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'AMUPDD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F12D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUPDD=FF RETURN END C------------------------------------------------- F13 = AMUPT FUNCTION AMUPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'AMUPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F13D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'AMUTD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F14D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUTD=FF RETURN END C------------------------------------------------- F15 = AMUTDD FUNCTION AMUTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'AMUTDD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F15D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUTDD=FF RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BSPT'/ C--- SET OF UNIT - PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL - FF = F90D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BSPT=FF RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BTPT'/ C--- SET OF UNIT - PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL - FF = F91D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BTPT=FF RETURN END C------------------------------------------------- F92 = BPPT FUNCTION BPPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BPPT'/ C--- SET OF UNIT - PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL - FF = F92D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BPPT=FF RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BVPT'/ C--- SET OF UNIT - PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL - FF = F93D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BVPT=FF RETURN END C------------------------------------------------- F16 = CPPD FUNCTION CPPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'CPPD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F16D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPPD=FF RETURN END C------------------------------------------------- F17 = CPPDD FUNCTION CPPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'CPPDD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F17D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPPDD=FF RETURN END C------------------------------------------------- F18 = CPPT FUNCTION CPPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'CPPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F18D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPPT=FF RETURN END C------------------------------------------------- F19 = CPTD FUNCTION CPTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'CPTD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F19D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPTD=FF RETURN END C------------------------------------------------- F20 = CPTDD FUNCTION CPTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'CPTDD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F20D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPTDD=FF RETURN END C------------------------------------------------- F21 = CRP 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 = F21D02(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 ', & ' CARBON DIOXIDE WHEN A=',A,' ****') CRP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- IF(A.EQ.'T') THEN T0K=-G99D02(0.0) FF=FF+T0K ELSE IF(A.EQ.'P') THEN PBAR=G98D02(1.0) FF=FF/PBAR END IF CRP=FF RETURN END C------------------------------------------------- F76 = CVPDD FUNCTION CVPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'CVPDD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F76D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVPDD=FF RETURN END C------------------------------------------------- F77 = CVPT FUNCTION CVPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'CVPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F77D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVPT=FF RETURN END C------------------------------------------------- F78 = CVTDD FUNCTION CVTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'CVTDD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F78D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVTDD=FF RETURN END C------------------------------------------------- F22 = EPSPT FUNCTION EPSPT(P,T) CHARACTER FUN*6 DATA FUN/'EPSPT'/ CALL S99D02(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='44.009' WHEN A='M' C B='188.92' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=44.009 ELSE IF (A.EQ.'R') THEN FC=188.92 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR CARBON DIOXIDE WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C-------------------------------------------------- F96 = GAMPDD FUNCTION GAMPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'GAMPDD'/ C--- SET OF UNIT - PI=G98D02(P) C--- FUNCTION CALL - FF = F96D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPDD=FF RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'GAMPT'/ C--- SET OF UNIT - PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL - FF = F95D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPT=FF RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME - DATA FUN/'GAMTDD'/ C--- SET OF UNIT - TI=G99D02(T) C--- FUNCTION CALL - FF = F97D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMTDD=FF RETURN END C------------------------------------------------- F23 = HPD FUNCTION HPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'HPD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F23D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPD=FF RETURN END C------------------------------------------------- F24 = HPDD FUNCTION HPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'HPDD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F24D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPDD=FF RETURN END C------------------------------------------------- F71 = HPS FUNCTION HPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME -- DATA FUN/'HPS'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F71D02(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPS=FF RETURN END C------------------------------------------------- F25 = HPT FUNCTION HPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'HPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F25D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPT=FF RETURN END C------------------------------------------------- F26 = HPX FUNCTION HPX(P,X) CHARACTER FUN*6 REAL P,X,FF C--- FUNCTION NAME -- DATA FUN/'HPX'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F26D02(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPX=FF RETURN END C------------------------------------------------- F27 = HTD FUNCTION HTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'HTD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F27D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HTD=FF RETURN END C------------------------------------------------- F28 = HTDD FUNCTION HTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'HTDD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F28D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HTDD=FF RETURN END C------------------------------------------------- F29 = HTX FUNCTION HTX(T,X) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'HTX'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F29D02(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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='CARBON DIOXIDE' WHEN A='S' C B='CO2' 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='CARBON DIOXIDE' ELSE IF (A.EQ.'C') THEN IDENTF='CO2' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR CARBON DIOXIDE 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 S99D02(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT FUNCTION PMLT(T) CHARACTER FUN*6 REAL PBAR,T,FF C--- FUNCTION NAME -- DATA FUN/'PMLT'/ C--- SET OF UNIT -- PBAR=G98D02(1.0) TI=G99D02(T) C--- FUNCTION CALL -- FF = F68D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) PMLT=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'PRPD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F85D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRPD=FF RETURN END C------------------------------------------------- F86 = PRPDD FUNCTION PRPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'PRPDD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F86D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRPDD=FF RETURN END C------------------------------------------------- F81 = PRPT FUNCTION PRPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'PRPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F81D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRPT=FF RETURN END C------------------------------------------------- F87 = PRTD FUNCTION PRTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'PRTD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F87D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRTD=FF RETURN END C------------------------------------------------- F88 = PRTDD FUNCTION PRTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'PRTDD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F88D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRTDD=FF RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99D02(FUN) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F30 = PST FUNCTION PST(T) CHARACTER FUN*6 REAL PBAR,T,FF C--- FUNCTION NAME -- DATA FUN/'PST'/ C--- SET OF UNIT -- PBAR=G98D02(1.0) TI=G99D02(T) C--- FUNCTION CALL -- FF = F30D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) PST=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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 S99D02(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99D02(FUN) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F31 = SIGP FUNCTION SIGP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'SIGP'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F31D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSEIF (FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SIGP=FF RETURN END C------------------------------------------------- F32 = SIGT FUNCTION SIGT(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'SIGT'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F32D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF (FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSEIF (FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SIGT=FF RETURN END C------------------------------------------------- F33 = SPD FUNCTION SPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'SPD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F33D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPD=FF RETURN END C------------------------------------------------- F34 = SPDD FUNCTION SPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'SPDD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F34D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPDD=FF RETURN END C------------------------------------------------- F35 = SPT FUNCTION SPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'SPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F35D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPT=FF RETURN END C------------------------------------------------- F36 = SPX FUNCTION SPX(P,X) CHARACTER FUN*6 REAL P,X,FF C--- FUNCTION NAME -- DATA FUN/'SPX'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F36D02(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPX=FF RETURN END C------------------------------------------------- F37 = STD FUNCTION STD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'STD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F37D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- STD=FF RETURN END C------------------------------------------------- F38 = STDD FUNCTION STDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'STDD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F38D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- STDD=FF RETURN END C------------------------------------------------- F39 = STX FUNCTION STX(T,X) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'STX'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F39D02(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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 S99D02(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP FUNCTION TMLP(P) DOUBLE PRECISION F69D02,DD,PP CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'TMLP'/ C--- SET OF UNIT -- PI=G98D02(P) T0K=-G99D02(0.0) C--- FUNCTION CALL -- PP = DBLE(PI) DD = F69D02(PP) FF=REAL(DD) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) TMLP=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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 FUNCTION TPH(P,H) CHARACTER FUN*6 REAL T0K,P,H,FF C--- FUNCTION NAME -- DATA FUN/'TPH'/ C--- SET OF UNIT -- PI=G98D02(P) T0K=-G99D02(0.0) C--- FUNCTION CALL -- FF = F64D02(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) TPH=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 DATA FUN/'TPSEUP'/ C--- SET OF UNIT -- PI=G98D02(P) T0K=-G99D02(0.0) C--- FUNCTION CALL -- FF = F98D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) TPSEUP=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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------------------------------------------------- F65 = TPS FUNCTION TPS(P,S) CHARACTER FUN*6 REAL T0K,P,S,FF C--- FUNCTION NAME -- DATA FUN/'TPS'/ C--- SET OF UNIT -- PI=G98D02(P) T0K=-G99D02(T) C--- FUNCTION CALL -- FF = F65D02(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) TPS=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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------------------------------------------------- F70 = TPV FUNCTION TPV(P,V) CHARACTER FUN*6 REAL T0K,P,V,FF C--- FUNCTION NAME -- DATA FUN/'TPV'/ C--- SET OF UNIT -- PI=G98D02(P) T0K=-G99D02(0.0) C--- FUNCTION CALL -- FF = F70D02(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) TPV=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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 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 = F41D02(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 ', & ' CARBON DIOXIDE WHEN A=',A,' ****') TRPL=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- IF(A.EQ.'T') THEN T0K=-G99D02(0.0) FF=FF+T0K ELSE IF(A.EQ.'P') THEN PBAR=G98D02(1.0) FF=FF/PBAR END IF TRPL=FF RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99D02(FUN) TSBP=-1.0E+30 RETURN END C------------------------------------------------- F40 = TSP FUNCTION TSP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'TSP'/ C--- SET OF UNIT -- PI=G98D02(P) T0K=-G99D02(0.0) C--- FUNCTION CALL -- FF = F40D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) TSP=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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 S99D02(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99D02(FUN) TSPDD=-1.0E+30 RETURN END C------------------------------------------------- F42 = UPD FUNCTION UPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'UPD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F42D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPD=FF RETURN END C------------------------------------------------- F43 = UPDD FUNCTION UPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'UPDD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F43D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPDD=FF RETURN END C------------------------------------------------- F79 = UPS FUNCTION UPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME -- DATA FUN/'UPS'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F79D02(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPS=FF RETURN END C------------------------------------------------- F44 = UPT FUNCTION UPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'UPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F44D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPT=FF RETURN END C------------------------------------------------- F45 = UPX FUNCTION UPX(P,X) CHARACTER FUN*6 REAL P,X,FF C--- FUNCTION NAME -- DATA FUN/'UPX'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F45D02(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPX=FF RETURN END C------------------------------------------------- F46 = UTD FUNCTION UTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'UTD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F46D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UTD=FF RETURN END C------------------------------------------------- F47 = UTDD FUNCTION UTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'UTDD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F47D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UTDD=FF RETURN END C------------------------------------------------- F48 = UTX FUNCTION UTX(T,X) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'UTX'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F48D02(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,T,X,'T','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UTX=FF RETURN END C------------------------------------------------- F49 = VPD FUNCTION VPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'VPD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F49D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPD=FF RETURN END C------------------------------------------------- F50 = VPDD FUNCTION VPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'VPDD'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F50D02(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPDD=FF RETURN END C------------------------------------------------- F80 = VPS FUNCTION VPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME -- DATA FUN/'VPS'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F80D02(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPS=FF RETURN END C------------------------------------------------- F51 = VPT FUNCTION VPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'VPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F51D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPT=FF RETURN END C------------------------------------------------- F52 = VPX FUNCTION VPX(P,X) CHARACTER FUN*6 REAL P,X,FF C--- FUNCTION NAME -- DATA FUN/'VPX'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F52D02(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPX=FF RETURN END C------------------------------------------------- F53 = VTD FUNCTION VTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'VTD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F53D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VTD=FF RETURN END C------------------------------------------------- F54 = VTDD FUNCTION VTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'VTDD'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F54D02(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VTDD=FF RETURN END C------------------------------------------------- F55 = VTX FUNCTION VTX(T,X) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'VTX'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F55D02(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,T,X,'T','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VTX=FF RETURN END C------------------------------------------------- F83 = WPT FUNCTION WPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'WPT'/ C--- SET OF UNIT -- PI=G98D02(P) TI=G99D02(T) C--- FUNCTION CALL -- FF = F83D02(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- WPT=FF RETURN END C------------------------------------------------- F56 = XPH FUNCTION XPH(P,H) CHARACTER FUN*6 REAL P,H,FF C--- FUNCTION NAME -- DATA FUN/'XPH'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F56D02(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,H,'P','H',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPH=FF RETURN END C------------------------------------------------- F57 = XPS FUNCTION XPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME -- DATA FUN/'XPS'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F57D02(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPS=FF RETURN END C------------------------------------------------- F58 = XPU FUNCTION XPU(P,U) CHARACTER FUN*6 REAL P,U,FF C--- FUNCTION NAME -- DATA FUN/'XPU'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F58D02(PI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,U,'P','U',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPU=FF RETURN END C------------------------------------------------- F59 = XPV FUNCTION XPV(P,V) CHARACTER FUN*6 REAL P,V,FF C--- FUNCTION NAME -- DATA FUN/'XPV'/ C--- SET OF UNIT -- PI=G98D02(P) C--- FUNCTION CALL -- FF = F59D02(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,P,V,'P','V',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPV=FF RETURN END C------------------------------------------------- F60 = XTH FUNCTION XTH(T,H) CHARACTER FUN*6 REAL T,H,FF C--- FUNCTION NAME -- DATA FUN/'XTH'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F60D02(TI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,T,H,'T','H',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XTH=FF RETURN END C------------------------------------------------- F61 = XTS FUNCTION XTS(T,S) CHARACTER FUN*6 REAL T,S,FF C--- FUNCTION NAME -- DATA FUN/'XTS'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F61D02(TI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,T,S,'T','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XTS=FF RETURN END C------------------------------------------------- F62 = XTU FUNCTION XTU(T,U) CHARACTER FUN*6 REAL T,U,FF C--- FUNCTION NAME -- DATA FUN/'XTU'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F62D02(TI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(3,T,U,'T','U',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XTU=FF RETURN END C------------------------------------------------- F63 = XTV FUNCTION XTV(T,V) CHARACTER FUN*6 REAL T,V,FF C--- FUNCTION NAME -- DATA FUN/'XTV'/ C--- SET OF UNIT -- TI=G99D02(T) C--- FUNCTION CALL -- FF = F63D02(TI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D02(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D02(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 G98D02(P) REAL P,G98D02 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 G98D02=REAL(DBLE(P)*PBAR) RETURN END C G99 *** FUNCTION G99D02(T) REAL T,G99D02 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 G99D02=REAL(DBLE(T)-T0K) RETURN END C ******* SUBROUTINE FOR ERROR MESSAGE ******* C *** LEVEL 1 ERROR MESSAGE -- SUBROUTINE S97D02(FUN) CHARACTER FLUID*14,FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FLUID/'CARBON DIOXIDE'/ IF (MESS.NE.0) THEN WRITE(6,1000) FUN,FLUID 1000 FORMAT(1H ,5X,'**** NO CONVERGENCE AT ',A6,' FOR ', & A14,' ****') ENDIF RETURN END C *** LEVEL 2 ERROR MESSAGE -- SUBROUTINE S98D02(IPT,P,T,N1,N2,FUN) CHARACTER FLUID*14,FUN*6,N1*1,N2*1 REAL P,T INTEGER KPA,MESS,IPT COMMON/UNIT/KPA,MESS DATA FLUID/'CARBON DIOXIDE'/ IF (MESS.NE.0) THEN IF (IPT.EQ.1) THEN C--- FUN(P) TYPE WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A14, & ' WHEN P =',1PE14.7,' ****') C--- FUN(T) TYPE ELSEIF (IPT.EQ.2) THEN WRITE(6,6020) FUN,FLUID,T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A14, & ' WHEN T =',1PE14.7,' ****') C--- FUN(P,T) TYPE ELSE WRITE(6,6030) FUN,FLUID,N1,P,N2,T 6030 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A14, & ' WHEN ',A1,'=',1PE14.7,' AND ',A1,'=',1PE14.7,' ****') ENDIF ENDIF RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99D02(FUN) CHARACTER FLUID*14,FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FLUID/'CARBON DIOXIDE'/ IF (MESS.NE.0) THEN WRITE(6,1000) FUN,FLUID 1000 FORMAT(1H ,5X,'**** FUNCTION ',A6,' UNAVAILABLE FOR ', & A14,' ****') ENDIF RETURN END C ***************************** C C * PROPATH VER.5.1 * C C * CO2 FUNCTION VER.2.1 * C C * REVISED AUGUST 1991 * C C ***************************** C C02 + LAPLACE COEFFICIENT AT P FUNCTION F2D02(P) INTEGER G91D02 IG91=G91D02(P) IF (IG91.EQ.0) THEN T=F40D02(P) F2D02=F3D02(T) ELSEIF (IG91.EQ.1) THEN F2D02=0.0 ELSE F2D02=-1.0E+20 ENDIF RETURN END C03 + LAPLACE COEFFICIENT AT T FUNCTION F3D02(T) INTEGER G92D02 IG92=G92D02(T) IF (IG92.EQ.0) THEN F3D02=G5D02(T) ELSEIF (IG92.EQ.1) THEN F3F02=0.0 ELSE F3D02=-1.0E+20 ENDIF RETURN END C04 + LATENT HEAT OF VAPORIZATION AT P FUNCTION F4D02(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D02 IF (G91D02(P).EQ.3) THEN F4D02=-1.0E+20 ELSE YP=DBLE(P) YT=G3D02(YP) YDPDTS=G2D02(YP,YT) CALL S1D02(YT,YVL,YVG) F4D02=REAL((YVG-YVL)*YT*YDPDTS)*1E5 ENDIF RETURN END C05 + LATENT HEAT OF VAPORIZATION AT T FUNCTION F5D02(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D02 IF (G92D02(T).EQ.3) THEN F5D02=-1.0E+20 ELSE YT=DBLE(T+273.15) YP=G1D02(YT) YDPDTS=G2D02(YP,YT) CALL S1D02(YT,YVL,YVG) F5D02=REAL((YVG-YVL)*YT*YDPDTS)*1E5 ENDIF RETURN END C06 + THERMAL CONDUCTIVITY OF SATURATED LIQUID AT P FUNCTION F6D02(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.F30D02(-33.15) .OR. P.GE.73.8243) GOTO 999 YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F6D02=REAL(G19D02(YT,YVL)) RETURN 999 F6D02=-1.0E+20 RETURN END C07 + THERMAL CONDUCTIVITY OF SATURATED VAPOR AT P FUNCTION F7D02(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GE.73.8243) GOTO 999 YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F7D02=REAL(G19D02(YT,YVG)) RETURN 999 F7D02=-1.0E+20 RETURN END C08 + THERMAL CONDUCTIVITY AT P AND T FUNCTION F8D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D02 IF (G93D02(P,T).EQ.1) THEN F8D02=-1.0E+20 RETURN ENDIF PLIM=F30D02(-33.15) IF(P.GT.PLIM .AND. T.LT.-33.15) GOTO 999 IF (P.GE.5.185 .AND. P.LE.PLIM) THEN IF (T.LT.F40D02(P)) GOTO 999 ENDIF TK=T+273.15 YP=DBLE(P) YT=DBLE(TK) YV=G10D02(YP,YT) IF (YV.LT.-1.0E-08) THEN F8D02=YV ELSE F8D02=REAL(G19D02(YT,YV)) ENDIF RETURN 999 F8D02=-1.0E+20 RETURN END C09 + THERMAL CONDUCTIVITY OF SATURATED LIQUID AT T FUNCTION F9D02(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-33.15 .OR. T.GE.31.0570) GOTO 999 YT=DBLE(T)+273.15D0 CALL S1D02(YT,YVL,YVG) F9D02=REAL(G19D02(YT,YVL)) RETURN 999 F9D02=-1.0E+20 RETURN END C10 + THERMAL CONDUCTIVITY OF SATURATED VAPOR AT T FUNCTION F10D02(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-56.57 .OR. T.GE.31.0570) GOTO 999 YT=DBLE(T)+273.15D0 CALL S1D02(YT,YVL,YVG) F10D02=REAL(G19D02(YT,YVG)) RETURN 999 F10D02=-1.0E+20 RETURN END C11 + VISCOSITY OF SATURATED LIQUID AT P FUNCTION F11D02(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.F30D02(-33.15) .OR. P.GT.73.825) GOTO 999 YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F11D02=REAL(G20D02(YT,YVL)) RETURN 999 F11D02=-1.0E+20 RETURN END C12 + VISCOSITY OF SATURATED VAPOR AT P FUNCTION F12D02(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D02 IF (G91D02(P).EQ.3) THEN F12D02=-1.0E+20 ELSE YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F12D02=REAL(G20D02(YT,YVG)) ENDIF RETURN END C13 + VISCOSITY AT P AND T FUNCTION F13D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) PLIM=F30D02(-33.15) IF(P.GT.PLIM .AND. T.LT.-33.15) GOTO 999 IF (P.GE.5.185 .AND. P.LE.PLIM) THEN IF (T.LT.F40D02(P)) GOTO 999 ENDIF YP=DBLE(P) YT=DBLE(T+273.15) YV=G10D02(YP,YT) IF (YV.EQ.-1.0E+10) THEN F13D02=-1.0E+10 ELSEIF (YV.EQ.-1.0E+20) THEN F13D02=-1.0E+20 ELSE F13D02=REAL(G20D02(YT,YV)) ENDIF RETURN 999 F13D02=-1.0E+20 RETURN END C14 + VISCOSITY OF SATURATED LIQUID AT T FUNCTION F14D02(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-33.15 .OR. T.GT.31.06) GOTO 999 YT=DBLE(T)+273.15D0 CALL S1D02(YT,YVL,YVG) F14D02=REAL(G20D02(YT,YVL)) RETURN 999 F14D02=-1.0E+20 RETURN END C15 + VISCOSITY OF SATURATED VAPOR AT T FUNCTION F15D02(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D02 IF (G92D02(T).EQ.3) THEN F15D02=-1.0E+20 ELSE YT=DBLE(T)+273.15D0 CALL S1D02(YT,YVL,YVG) F15D02=REAL(G20D02(YT,YVG)) ENDIF RETURN END C16 + ISOBARIC SPECIFIC HEAT OF SATURATED LIQUID AT P FUNCTION F16D02(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GT.73.0) THEN F16D02=-1.0E+20 ELSE YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F16D02=REAL(G16D02(YT,YVL))*1.889227E2 ENDIF RETURN END C17 + ISOBARIC SPECIFIC HEAT OF SATURATED VAPOUR AT P FUNCTION F17D02(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GT.73.0) THEN F17D02=-1.0E+20 ELSE YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F17D02=REAL(G16D02(YT,YVG))*1.889227E2 ENDIF RETURN END C18 + ISOBARIC SPECIFIC HEAT AT P AND T FUNCTION F18D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D02 IF (G93D02(P,T).EQ.1) THEN F18D02=-1.0E+20 RETURN ENDIF TK=T+273.15 YT=DBLE(TK) YP=DBLE(P) YV=G10D02(YP,YT) IF (YV.EQ.-1.0E+10) THEN F18D02=-1.0E+10 ELSEIF (YV.EQ.-1.0E+20) THEN F18D02=-1.0E+20 ELSE F18D02=REAL(G16D02(YT,YV))*1.889227E2 ENDIF RETURN END C19 + ISOBARIC SPECIFIC HEAT OF SATURATED LIQUID AT T FUNCTION F19D02(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-56.57 .OR. T.GT.30.56) THEN F19D02=-1.0E+20 ELSE YT=DBLE(T+273.15) CALL S1D02(YT,YVL,YVG) F19D02=REAL(G16D02(YT,YVL))*1.889227E2 ENDIF RETURN END C20 + ISOBARIC SPECIFIC HEAT OF SATURATED VAPOUR AT T FUNCTION F20D02(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-56.57 .OR. T.GT.30.56) THEN F20D02=-1.0E+20 ELSE YT=DBLE(T+273.15) CALL S1D02(YT,YVL,YVG) F20D02=REAL(G16D02(YT,YVG))*1.889227E2 ENDIF RETURN END C21 + CRITICAL POINT FUNCTION F21D02(A) CHARACTER*1 A IF (A.EQ.'H') THEN F21D02=6.3664E5 ELSEIF (A.EQ.'P') THEN F21D02=73.825 ELSEIF (A.EQ.'S') THEN F21D02=3.5579E3 ELSEIF (A.EQ.'T') THEN F21D02=31.06 ELSEIF (A.EQ.'V') THEN F21D02=1E0/466 ELSE F21D02=-1.0E+20 ENDIF RETURN END C23 + SPECIFIC ENTHALPY OF SATURATED LIQUID AT P FUNCTION F23D02(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D02 IF (G91D02(P).EQ.3) THEN F23D02=-1.0E+20 ELSE YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F23D02=REAL(G13D02(YT,YVL)*YT)*1.889227E2 ENDIF RETURN END C24 + SPECIFIC ENTHALPY OF SATURATED VAPOUR AT P FUNCTION F24D02(P) F24D02=F26D02(P,1.0) RETURN END C25 + SPECIFIC ENTHALPY AT PAND T FUNCTION F25D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YT=DBLE(T+273.15) YV=G10D02(YP,YT) IF (YV.EQ.-1.0E+10) THEN F25D02=-1.0E+10 ELSEIF (YV.EQ.-1.0E+20) THEN F25D02=-1.0E+20 ELSE F25D02=REAL(G13D02(YT,YV)*YT)*1.889227E2 ENDIF RETURN END C26 + SPECIFIC ENTHALPY OF MIXTURE AT P FUNCTION F26D02(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GT.73.825) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YT=G3D02(YP) YDPDTS=G2D02(YP,YT) CALL S1D02(YT,YVL,YVG) YF23H=G13D02(YT,YVL)*YT*1.889227D2 YF4DH=(YVG-YVL)*YT*YDPDTS*1D5 F26D02=REAL(YF23H+X*YF4DH) RETURN 999 F26D02=-1.0E+20 RETURN END C27 + SPECIFIC ENTHALPY OF SATURATED LIQUID AT T FUNCTION F27D02(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D02 IF (G92D02(T).EQ.3) THEN F27D02=-1.0E+20 ELSE YT=DBLE(T+273.15) CALL S1D02(YT,YVL,YVG) F27D02=REAL(G13D02(YT,YVL)*YT)*1.889227E2 ENDIF RETURN END C28 + SPECIFIC ENTHALPY OF SATURATED VAPOUR AT T FUNCTION F28D02(T) F28D02=F29D02(T,1.0) RETURN END C29 + SPECIFIC ENTHALPY OF MIXTURE AT T FUNCTION F29D02(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-56.57 .OR. T.GT.31.06) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YP=G1D02(YT) YDPDTS=G2D02(YP,YT) CALL S1D02(YT,YVL,YVG) YF27H=G13D02(YT,YVL)*YT*1.889227D2 YF5DH=(YVG-YVL)*YT*YDPDTS*1D5 F29D02=REAL(YF27H+X*YF5DH) RETURN 999 F29D02=-1.0E+20 RETURN END C30 + SATURATION PRESSURE AT T FUNCTION F30D02(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D02 IF (G92D02(T).EQ.3) THEN F30D02=-1.0E+20 ELSE YT=DBLE(T+273.15) F30D02=REAL(G1D02(YT)) ENDIF RETURN END C31 + SURFACE TENSION AT P FUNCTION F31D02(P) DOUBLE PRECISION G3D02 INTEGER G91D02 IF (G91D02(P).EQ.3) THEN F31D02=-1.0E+20 ELSE T=REAL(G3D02(DBLE(P)))-273.15 F31D02=G4D02(T) ENDIF RETURN END C32 + SURFACE TENSION AT T FUNCTION F32D02(T) INTEGER G92D02 IF (G92D02(T).EQ.3) THEN F32D02=-1.0E+20 ELSE F32D02=G4D02(T) ENDIF RETURN END C33 + SPECIFIC ENTROPY OF SATURATED LIQUID AT P FUNCTION F33D02(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D02 IF (G91D02(P).EQ.3) THEN F33D02=-1.0E+20 ELSE YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F33D02=REAL(G14D02(YT,YVL))*1.889227E2 ENDIF RETURN END C34 + SPECIFIC ENTROPY OF SATURATED VAPOUR AT P FUNCTION F34D02(P) F34D02=F36D02(P,1.0) RETURN END C35 + SPECIFIC ENTROPY AT P AND T FUNCTION F35D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YT=DBLE(T+273.15) YV=G10D02(YP,YT) IF (YV.EQ.-1.0E+10) THEN F35D02=-1.0E+10 ELSEIF (YV.EQ.-1.0E+20) THEN F35D02=-1.0E+20 ELSE F35D02=REAL(G14D02(YT,YV))*1.889227E2 ENDIF RETURN END C36 + SPECIFIC ENTROPY OF MIXTURE AT P FUNCTION F36D02(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GT.73.825) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YT=G3D02(YP) YDPDTS=G2D02(YP,YT) CALL S1D02(YT,YVL,YVG) YF33S=G14D02(YT,YVL)*1.889227D2 YF4DS=(YVG-YVL)*YDPDTS*1D5 F36D02=REAL(YF33S+X*YF4DS) RETURN 999 F36D02=-1.0E+20 RETURN END C37 + SPECIFIC ENTROPY OF SATURATED LIQUID AT T FUNCTION F37D02(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D02 IF (G92D02(T).EQ.3) THEN F37D02=-1.0E+20 ELSE YT=DBLE(T+273.15) CALL S1D02(YT,YVL,YVG) F37D02=REAL(G14D02(YT,YVL))*1.889227E2 ENDIF RETURN END C38 + SPECIFIC ENTROPY OF SATURATED VAPOUR AT T FUNCTION F38D02(T) F38D02=F39D02(T,1.0) RETURN END C39 + SPECIFIC ENTROPY OF MIXTURE AT T FUNCTION F39D02(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-56.57 .OR. T.GT.31.06) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YP=G1D02(YT) YDPDTS=G2D02(YP,YT) CALL S1D02(YT,YVL,YVG) YF37S=G14D02(YT,YVL)*1.889227D2 YF5DS=(YVG-YVL)*YDPDTS*1D5 F39D02=REAL(YF37S+X*YF5DS) RETURN 999 F39D02=-1.0E+20 RETURN END C40 + SATURATION TEMPERATURE AT P FUNCTION F40D02(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D02 IF (G91D02(P).EQ.3) THEN F40D02=-1.0E+20 ELSE F40D02=REAL(G3D02(DBLE(P)))-273.15 ENDIF RETURN END C41 + TRIPLE POINT FUNCTION F41D02(A) CHARACTER*1 A IF (A.EQ.'P') THEN F41D02=5.185 ELSEIF (A.EQ.'T') THEN F41D02=-56.57 ELSE F41D02=-1.0E+20 ENDIF RETURN END C42 + SPECIFIC INTERNAL ENERGY OF SATURATED LIQUID AT P FUNCTION F42D02(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D02 IF (G91D02(P).EQ.3) THEN F42D02=-1.0E+20 ELSE YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) YF23H=G13D02(YT,YVL)*YT*1.889227D2 F42D02=REAL(YF23H-1D5*YP*YVL) ENDIF RETURN END C43 + SPECIFIC INTERNAL ENERGY OF SATURATED VAPOUR AT P FUNCTION F43D02(P) F43D02=F45D02(P,1.0) RETURN END C44 + SPECIFIC INTERNAL ENERGY AT PAND T FUNCTION F44D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YT=DBLE(T+273.15) YV=G10D02(YP,YT) IF (YV.EQ.-1.0E+10) THEN F44D02=-1.0E+10 ELSEIF (YV.EQ.-1.0E+20) THEN F44D02=-1.0E+20 ELSE F44D02=REAL(G13D02(YT,YV)*YT)*1.889227E2-1E5*YP*YV ENDIF RETURN END C45 + SPECIFIC INTERNAL ENERGY OF MIXTURE AT P FUNCTION F45D02(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GT.73.825) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YT=G3D02(YP) YDPDTS=G2D02(YP,YT) CALL S1D02(YT,YVL,YVG) YF23H=G13D02(YT,YVL)*YT*1.889227D2 YF4DH=(YVG-YVL)*YT*YDPDTS*1D5 F45D02=REAL(YF23H+X*YF4DH-1D5*YP*((1D0-X)*YVL+X*YVG)) RETURN 999 F45D02=-1.0E+20 RETURN END C46 + SPECIFIC INTERNAL ENERGY OF SATURATED LIQUID AT T FUNCTION F46D02(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D02 IF (G92D02(T).EQ.3) THEN F46D02=-1.0E+20 ELSE YT=DBLE(T+273.15) YP=G1D02(YT) CALL S1D02(YT,YVL,YVG) YF27H=G13D02(YT,YVL)*YT*1.889227D2 F46D02=REAL(YF27H-1D5*YP*YVL) ENDIF RETURN END C47 + SPECIFIC INTERNAL ENERGY OF SATURATED VAPOUR AT T FUNCTION F47D02(T) F47D02=F48D02(T,1.0) RETURN END C48 + SPECIFIC INTERNAL ENERGY OF MIXTURE AT T FUNCTION F48D02(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-56.57 .OR. T.GT.31.06) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YP=G1D02(YT) YDPDTS=G2D02(YP,YT) CALL S1D02(YT,YVL,YVG) YF23H=G13D02(YT,YVL)*YT*1.889227D2 YF4DH=(YVG-YVL)*YT*YDPDTS*1D5 F48D02=REAL(YF23H+X*YF4DH-1D5*YP*((1D0-X)*YVL+X*YVG)) RETURN 999 F48D02=-1.0E+20 RETURN END C49 + SPECIFIC VOLUME OF SATURATED LIQUID AT P FUNCTION F49D02(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D02 IF (G91D02(P).EQ.3) THEN F49D02=-1.0E+20 ELSE YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F49D02=REAL(YVL) ENDIF RETURN END C50 + SPECIFIC VOLUME OF SATURATED GAS AT P FUNCTION F50D02(P) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G91D02 IF (G91D02(P).EQ.3) THEN F50D02=-1.0E+20 ELSE YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F50D02=REAL(YVG) ENDIF RETURN END C51 + SPECIFIC VOLUME AT P AND T FUNCTION F51D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YT=DBLE(T+273.15) YV=G10D02(YP,YT) IF (YV.EQ.-1.0E+10) THEN F51D02=-1.0E+10 ELSEIF (YV.EQ.-1.0E+20) THEN F51D02=-1.0E+20 ELSE F51D02=REAL(YV) ENDIF RETURN END C52 + SPECIFIC VOLUME OF MIXTURE AT P FUNCTION F52D02(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GT.73.825) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F52D02=REAL(YVL+X*(YVG-YVL)) RETURN 999 F52D02=-1.0E+20 RETURN END C53 + SPECIFIC VOLUME OF SATURATED LIQUID AT T FUNCTION F53D02(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D02 IF (G92D02(T).EQ.3) THEN F53D02=-1.0E+20 ELSE YT=DBLE(T+273.15) CALL S1D02(YT,YVL,YVG) F53D02=REAL(YVL) ENDIF RETURN END C54 + SPECIFIC VOLUME OF SATURATED GAS AT T FUNCTION F54D02(T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G92D02 IF (G92D02(T).EQ.3) THEN F54D02=-1.0E+20 ELSE YT=DBLE(T+273.15) CALL S1D02(YT,YVL,YVG) F54D02=REAL(YVG) ENDIF RETURN END C55 + SPECIFIC VOLUME OF MIXTURE AT T FUNCTION F55D02(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-56.57 .OR. T.GT.31.06) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) CALL S1D02(YT,YVL,YVG) F55D02=REAL(YVL+X*(YVG-YVL)) RETURN 999 F55D02=-1.0E+20 RETURN END C56 + DRYNESS FRACTION <-> AT P,H FUNCTION F56D02(P,H) IF (P.LT.5.180 .OR. P.GE.73.8243) GOTO 999 HD=F23D02(P) HDD=F24D02(P) IF (H.LT.HD .OR. H.GT.HDD) GOTO 999 F56D02=(H-HD)/(HDD-HD) RETURN 999 F56D02=-1.0E+20 RETURN END C57 + DRYNESS FRACTION <-> AT P,S FUNCTION F57D02(P,S) IF (P.LT.5.180 .OR. P.GE.73.8243) GOTO 999 SD=F33D02(P) SDD=F34D02(P) IF (S.LT.SD .OR. S.GT.SDD) GOTO 999 F57D02=(S-SD)/(SDD-SD) RETURN 999 F57D02=-1.0E+20 RETURN END C58 + DRYNESS FRACTION <-> AT P,U FUNCTION F58D02(P,U) IF (P.LT.5.180 .OR. P.GE.73.8243) GOTO 999 UD=F42D02(P) UDD=F43D02(P) IF (U.LT.UD .OR. U.GT.UDD) GOTO 999 F58D02=(U-UD)/(UDD-UD) RETURN 999 F58D02=-1.0E+20 RETURN END C59 + DRYNESS FRACTION <-> AT P,V FUNCTION F59D02(P,V) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GE.73.8243) GOTO 999 VD=F49D02(P) VDD=F50D02(P) IF (V.LT.VD .OR. V.GT.VDD) GOTO 999 F59D02=(V-VD)/(VDD-VD) RETURN 999 F59D02=-1.0E+20 RETURN END C60 + DRYNESS FRACTION <-> AT T,H FUNCTION F60D02(T,H) IF (T.LT.-56.57 .OR. T.GE.31.0570) GOTO 999 HD=F27D02(T) HDD=F28D02(T) IF (H.LT.HD .OR. H.GT.HDD) GOTO 999 F60D02=(H-HD)/(HDD-HD) RETURN 999 F60D02=-1.0E+20 RETURN END C61 + DRYNESS FRACTION <-> AT T,S FUNCTION F61D02(T,S) IF (T.LT.-56.57 .OR. T.GE.31.0570) GOTO 999 SD=F37D02(T) SDD=F38D02(T) IF (S.LT.SD .OR. S.GT.SDD) GOTO 999 F61D02=(S-SD)/(SDD-SD) RETURN 999 F61D02=-1.0E+20 RETURN END C62 + DRYNESS FRACTION <-> AT T,U FUNCTION F62D02(T,U) IF (T.LT.-56.57 .OR. T.GE.31.0570) GOTO 999 UD=F46D02(T) UDD=F47D02(T) IF (U.LT.UD .OR. U.GT.UDD) GOTO 999 F62D02=(U-UD)/(UDD-UD) RETURN 999 F62D02=-1.0E+20 RETURN END C63 + DRYNESS FRACTION <-> AT T,V FUNCTION F63D02(T,V) IF (T.LT.-56.57 .OR. T.GE.31.0570) GOTO 999 VD=F53D02(T) VDD=F54D02(T) IF (V.LT.VD .OR. V.GT.VDD) GOTO 999 F63D02=(V-VD)/(VDD-VD) RETURN 999 F63D02=-1.0E+20 RETURN END C64 + TEMPERATURE AT P AND H FUNCTION F64D02(P,H) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YH=DBLE(H) CALL S2D02(YP,YH,YT,YV) TK=REAL(YT) IF (TK.GE.0.0) THEN F64D02=TK-273.15 ELSE F64D02=TK ENDIF RETURN END C65 + TEMPERATURE AT P AND S FUNCTION F65D02(P,S) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YS=DBLE(S) CALL S3D02(YP,YS,YT,YV) TK=REAL(YT) IF (TK.GE.0.0) THEN F65D02=TK-273.15 ELSE F65D02=TK ENDIF RETURN END C68 + PRESSURE ON MELTING CURVE T FUNCTION F68D02(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-56.57 .OR. T.GT.-36.15) GOTO 999 YTK=DBLE(T+273.15) YTR=YTK/216.58D0 YP=((YTR*YTR*YTR-1D0)*6.4813886D2+1D0)*5.180D0 F68D02=REAL(YP) RETURN 999 F68D02=-1.0E+20 RETURN END C69 + TEMPERATURE ON MELTING CURVE AT P DOUBLE PRECISION FUNCTION F69D02(P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF (P.LT.5.185 .OR. P.GT.1000) GOTO 999 YT=(P-5.185D0)/5.185D0/6.4813886D2+1D0 YT=2.1658D2*YT**(1.D00/3.D00) F69D02=YT-273.15D00 RETURN 999 F69D02=-1.0E+20 RETURN END C70 + TEMPERATURE AT P AND V FUNCTION F70D02(P,V) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YV=DBLE(V) TK=G12D02(YP,YV) IF (TK.GE.0.0) THEN F70D02=TK-273.15 ELSE F70D02=TK ENDIF RETURN END C71 + ENTHALPY AT P AND S FUNCTION F71D02(P,S) IMPLICIT DOUBLE PRECISION (G,Y) X=F57D02(P,S) IF (X.LT.0.0 .OR. X.GT.1.0) GOTO 10 F71D02=F26D02(P,X) RETURN 10 YP=DBLE(P) YS=DBLE(S) CALL S3D02(YP,YS,YT,YV) IF (YT.LT.-1E9) GOTO 999 T=REAL(YT)-273.15 F71D02=F25D02(P,T) RETURN 999 F71D02=REAL(YT) RETURN END C FA1 + ISOCHORIC SPECIFIC HEAT OF SATURATED LIQUID AT P FUNCTION FA1D02(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GT.73.825) GOTO 999 YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) FA1D02=REAL(G15D02(YT,YVL))*1.889227E2 RETURN 999 FA1D02=-1.0E+20 RETURN END C F76 + ISOCHORIC SPECIFIC HEAT OF SATURATED VAPOUR AT P FUNCTION F76D02(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GT.73.825) GOTO 999 YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F76D02=REAL(G15D02(YT,YVG))*1.889227E2 RETURN 999 F76D02=-1.0E+20 RETURN END C F77 + ISOCHORIC SPECIFIC HEAT AT P AND T FUNCTION F77D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YT=DBLE(T+273.15) YP=DBLE(P) YV=G10D02(YP,YT) IF (YV.GT.-1E8) THEN F77D02=REAL(G15D02(YT,YV))*1.889227E2 ELSE F77D02=YV ENDIF RETURN END C FA2 + ISOCHORIC SPECIFIC HEAT OF SATURATED LIQUID AT T FUNCTION FA2D02(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-56.57 .OR. T.GT.31.06) GOTO 999 YT=DBLE(T+273.15) CALL S1D02(YT,YVL,YVG) FA2D02=REAL(G15D02(YT,YVL))*1.889227E2 RETURN 999 FA2D02=-1.0E+20 RETURN END C F78 + ISOCHORIC SPECIFIC HEAT OF SATURATED VAPOUR AT T FUNCTION F78D02(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-56.57 .OR. T.GT.31.06) GOTO 999 YT=DBLE(T+273.15) CALL S1D02(YT,YVL,YVG) F78D02=REAL(G15D02(YT,YVG))*1.889227E2 RETURN 999 F78D02=-1.0E+20 RETURN END C F79 + U AT P AND S FUNCTION F79D02(P,S) IMPLICIT DOUBLE PRECISION (G,Y) X=F57D02(P,S) IF (X.LT.0.0 .OR. X.GT.1.0) GOTO 10 F79D02=F45D02(P,X) RETURN 10 YP=DBLE(P) YS=DBLE(S) CALL S3D02(YP,YS,YT,YV) IF (YT.LT.-1E9) GOTO 999 T=REAL(YT)-273.15 F79D02=F44D02(P,T) RETURN 999 F79D02=REAL(YT) RETURN END C F80 + V AT P AND S FUNCTION F80D02(P,S) IMPLICIT DOUBLE PRECISION (G,Y) X=F57D02(P,S) IF (X.LT.0.0 .OR. X.GT.1.0) GOTO 10 F80D02=F52D02(P,X) RETURN 10 YP=DBLE(P) YS=DBLE(S) CALL S3D02(YP,YS,YT,YV) IF (YT.LT.-1E9) GOTO 999 T=REAL(YT)-273.15 F80D02=F51D02(P,T) RETURN 999 F80D02=REAL(YT) RETURN END C F81 + PR<-> AT P AND T FUNCTION F81D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D02 IF (G93D02(P,T).EQ.1) THEN F81D02=-1.0E+20 RETURN ENDIF AMU=F13D02(P,T) IF (AMU.LT.-1E8) THEN F81D02=AMU RETURN ENDIF TK=T+273.15 YT=DBLE(TK) YP=DBLE(P) YV=G10D02(YP,YT) IF (YV.GT.-1E8) THEN CP=G16D02(YT,YV)*1.889227E2 F81D02=CP*G20D02(YT,YV)/G19D02(YT,YV) ELSE F81D02=YV ENDIF RETURN END C F82 + KAPPA<-> AT P AND T FUNCTION F82D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) DATA PCR,TKCR/73.825,304.21/ TK=T+273.15 YT=DBLE(TK) YP=DBLE(P) YV=G10D02(YP,YT) V=REAL(YV) IF (V.GT.-1E8) THEN AK=G16D02(YT,YV)*G18D02(YT,YV)/G15D02(YT,YV) F82D02=AK*1.889227E2*YT/(1E5*P*V) ELSE F82D02=V ENDIF RETURN END C F83 + W AT P AND T FUNCTION F83D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YT=DBLE(T+273.15) YP=DBLE(P) YV=G10D02(YP,YT) V=REAL(YV) IF (V.GT.-1E8) THEN AK=G16D02(YT,YV)*G18D02(YT,YV)/G15D02(YT,YV) WWW=AK*1.889227E2*YT F83D02=SQRT(WWW) ELSE F83D02=V ENDIF RETURN END C 85 ***** PRPD(P) FUNCTION F85D02(P) IF (P.LT.F30D02(-33.15) .OR. P.GT.73.0) THEN F85D02=-1.0E+20 ELSE CONDUC=F6D02(P) VISCOS=F11D02(P) CP=F16D02(P) F85D02=CP*VISCOS/CONDUC ENDIF RETURN END C 86 ***** PRPDD(P) FUNCTION F86D02(P) IF (P.LT.5.180 .OR. P.GT.73.0) THEN F86D02=-1.0E+20 ELSE CONDUC=F7D02(P) VISCOS=F12D02(P) CP=F17D02(P) F86D02=CP*VISCOS/CONDUC ENDIF RETURN END C 87 ***** FUNCTION F87D02(T) IF (T.LT.-33.15 .OR. T.GT.30.56) THEN F87D02=-1.0E+20 ELSE CONDUC=F9D02(T) VISCOS=F14D02(T) CP=F19D02(T) F87D02=CP*VISCOS/CONDUC ENDIF RETURN END C 88 ***** FUNCTION F88D02(T) IF (T.LT.-56.57 .OR. T.GT.30.56) THEN F88D02=-1.0E+20 ELSE CONDUC=F10D02(T) VISCOS=F15D02(T) CP=F20D02(T) F88D02=CP*VISCOS/CONDUC ENDIF RETURN END C F90 + BSPT<1/PA> AT P AND T FUNCTION F90D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YT=DBLE(T)+273.15D+00 YP=DBLE(P) YV=G10D02(YP,YT) V=REAL(YV) IF (V.GT.-1E8) THEN YAK=G16D02(YT,YV)*G18D02(YT,YV)/G15D02(YT,YV) YSS=DSQRT(YAK*1.889227D+02*YT) F90D02=REAL(YV/YSS**2) ELSE F90D02=V ENDIF RETURN END C F91 + BTPT<1/PA> AT P AND T FUNCTION F91D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D02 REAL GASCON DATA GASCON/1.889227E+02/ IF (G93D02(P,T).EQ.1) THEN F91D02=-1.0E+20 RETURN ENDIF YT=DBLE(T)+273.15D+00 YP=DBLE(P) YV=G10D02(YP,YT) V=REAL(YV) IF (V.GT.-1E8) THEN DPDRO=GASCON*REAL(YT*G18D02(YT,YV)) F91D02=V/DPDRO ELSE F91D02=V ENDIF RETURN END C F92 + BPPT<1/K> AT P AND T FUNCTION F92D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D02 IF (G93D02(P,T).EQ.1) THEN F92D02=-1.0E+20 RETURN ENDIF YT=DBLE(T)+273.15D+00 YP=DBLE(P) YV=G10D02(YP,YT) V=REAL(YV) IF (V.GT.-1E8) THEN F92D02=REAL(G17D02(YT,YV)/G18D02(YT,YV)/YT) ELSE F92D02=V ENDIF RETURN END C F93 + BVPT<1/K> AT P AND T FUNCTION F93D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) REAL GASCON DATA GASCON/1.889227E+02/ YT=DBLE(T)+273.15D+00 YP=DBLE(P) YV=G10D02(YP,YT) V=REAL(YV) IF (V.GT.-1E8) THEN DPDT=GASCON*REAL(G17D02(YT,YV))/V F93D02=DPDT/P*1.0E-05 ELSE F93D02=V ENDIF RETURN END C F94 + AJTPT AT P AND T FUNCTION F94D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) REAL GASCON DATA GASCON/1.889227E+02/ YT=DBLE(T)+273.15D+00 YP=DBLE(P) YV=G10D02(YP,YT) V=REAL(YV) IF (V.GT.-1E8) THEN DPDTDR=REAL(G17D02(YT,YV)/G18D02(YT,YV)-1.0D+00) F94D02=V/GASCON*DPDTDR/REAL(G16D02(YT,YV)) ELSE F94D02=V ENDIF RETURN END C F95 + RATIO OF SPECIFIC HEATS AT P AND T FUNCTION F95D02(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D02 IF (G93D02(P,T).EQ.1) THEN F95D02=-1.0E+20 RETURN ENDIF TK=T+273.15 YT=DBLE(TK) YP=DBLE(P) YV=G10D02(YP,YT) IF (YV.EQ.-1.0E+10) THEN F95D02=-1.0E+10 ELSEIF (YV.EQ.-1.0E+20) THEN F95D02=-1.0E+20 ELSE F95D02=REAL(G16D02(YT,YV)/G15D02(YT,YV)) ENDIF RETURN END C F96 + RATIO OF SPECIFIC HEATS OF SATURATED VAPOUR AT P FUNCTION F96D02(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.5.180 .OR. P.GT.73.0) THEN F96D02=-1.0E+20 ELSE YP=DBLE(P) YT=G3D02(YP) CALL S1D02(YT,YVL,YVG) F96D02=REAL(G16D02(YT,YVG)/G15D02(YT,YVG)) ENDIF RETURN END C F97 + RATIO OF SPECIFIC HEATS OF SATURATED VAPOUR AT T FUNCTION F97D02(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-56.57 .OR. T.GT.30.56) THEN F97D02=-1.0E+20 ELSE YT=DBLE(T)+273.15D+00 CALL S1D02(YT,YVL,YVG) F97D02=REAL(G16D02(YT,YVG)/G15D02(YT,YVG)) ENDIF RETURN END C F98 + PSEUDO BOILING POINT AT P FUNCTION F98D02(P) DIMENSION T(2),C(2),TL(3),TR(3),CL(3),CR(3) P1=F21D02('P') PP=ABS((P-P1)/P1) T1=F21D02('T') IF (PP.LT.1.0D-5) THEN F98D02=T1 RETURN ENDIF IF (P.LT.P1.OR.P.GT.300.001D00) THEN F98D02=-1.0E+20 RETURN ENDIF T2=0.85*T1 P2=F30D02(T2) TM0=T1+(T1-T2)*(P-P1)/(P1-P2) C-----TM0 KINJICHI TC=T1 T(1)=TM0 150 EPS=1.0D-7 DEL=T1*0.05D00 IREP=0 IREM=5000 KCONT=0 ICONT=0 C(1)=F18D02(P,T(1)) T(2)=T(1)-DEL C(2)=F18D02(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)=F18D02(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=-F18D02(P,TT) 3000 CONV=ABS((CC-C(2))/CC) IF(CONV.LT.EPS) THEN F98D02=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=-F18D02(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=F18D02(P,TA) CB=F18D02(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=F18D02(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)=F18D02(P,TL(2)) CR(2)=F18D02(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=F18D02(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=F18D02(P,TB) ELSE TB=TR(MR+1) CB=CR(MR+1) ENDIF 6135 TC=TR(MR) CC=CR(MR) ENDIF GO TO 6050 7000 F98D02=TC RETURN 8000 F98D02=-1.0E+10 RETURN END C ************************************* C * CO2 PROPERTIES VER.2.1 * C ************************************* C G01 *** PS(T) FUNCTION G1D02(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCR,TKCR/73.825D+00,304.21D+00/ P0=1.1377371D1*(1D0-T/304.21D0)**1.935D0 TR=TKCR/T-1D0 P0=P0+(((13.679755D0-8.6056439D0*TR)*TR-9.5924263D0) * *TR-6.8849249D0)*TR G1D02=PCR*DEXP(P0) RETURN END C G02 *** DPS/DT(T) ---- FUNCTION G2D02(P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA TC/304.21D0/ TCT=-TC/(T*T) DP0=-1.935D0*1.1377371D1*(1D0-T/TC)**.935D0/TC DP0=DP0-6.8849249D0*TCT TR=TC/T-1D0 DP0=DP0+TCT*((3*13.679755D0-4*8.6056439D0*TR)*TR * -2*9.5924263D0)*TR G2D02=P*DP0 RETURN END C G03 *** TS(P) ---- FUNCTION G3D02(P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCR,TKCR/73.825D+00,304.21D+00/ T0=TKCR-(PCR-P)/1.2821D0 10 P0=G1D02(T0) DPDT=G2D02(P0,T0) T1=T0+(P-P0)/DPDT IF (DABS((T1-T0)/T1) .GE. 1D-7) THEN T0=T1 GOTO 10 ELSE G3D02=T1 ENDIF RETURN END C G04 *** SURFACE TENSION AT T FUNCTION G4D02(T) SIG1=1.16E-3 RDT=(31.1-T)/(31.1-20) SIG=SIG1*RDT**1.3015 IF (SIG.LT.1E-6) SIG=0 G4D02=SIG RETURN END C G05 *** LAPLACE COEFFICIENT AT T FUNCTION G5D02(T) IMPLICIT DOUBLE PRECISION (Y) YT=DBLE(T+273.15) CALL S1D02(YT,YVL,YVG) RV=REAL(YVL*YVG/(YVG-YVL)) SIG=G4D02(T) G5D02=SQRT(SIG*RV/9.80665) RETURN END C G06 *** SID(T)-- IUPAC <-> FUNCTION G6D02(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) TT=304.2D0/T SS=((((((.138971347D3-.212300540D2*TT)*TT-.381060049D3)*TT * +.570626856D3)*TT-.511752178D3)*TT+.285920847D3)*TT * -.103477722D3)*TT+.477983597D2 G6D02=SS RETURN END C G07 *** HID(T)-- IUPAC <-> FUNCTION G7D02(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) TT=304.2D0/T HH=((((((.456446566D1-.585016654D0*TT)*TT-.153006069D2)*TT * +.289244934D2)*TT-.341840533D2)*TT+.266614790D2)*TT * -.139641330D2)*TT+.767516488D1 G7D02=HH RETURN END C G08 *** CPID(T)-- IUPAC <-> FUNCTION G8D02(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) TT=304.2D0/T CPCP=((((((.323362153D1*TT-.212184243D2)*TT+.574148450D2)*TT * -.820863624D2)*TT+.651102201D2)*TT-.254000397D2)*TT * -.249610766D0)*TT+.769441246D1 G8D02=CPCP RETURN END C G09 *** P(T,V) - ANALYSIS - IUPAC P FUNCTION G9D02(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA B00,B01,B02,B03,B04,B05,B06,B10,B11,B12,B13,B14,B15,B20, * B21,B22,B23,B24,B25,B30,B31,B32,B33,B34,B35,B40,B41,B42 */-.725854437D0,-.168332974D1, .259587221D0,.376945574D0, * -.670755370D0,-.871456126D0,-.149156928D0, .447869183D0, * .126050691D1, .596957049D1, .154645885D2, .194449475D2, * .864880497D1,-.172011999D0,-.183458178D1,-.461487677D1, * -.382121926D1, .360171349D1, .492265552D1, .446304911D-2, * -.176300541D1,-.111436705D2,-.278215446D2,-.271685720D2, * -.642177872D1, .255491571D0, .237414246D1, .750925141D1/ DATA B43,B44,B45,B50,B51,B52,B53,B54,B60,B61,B62,B63,B70,B71, * B72,B73,B80,B81,B82,B90,B91,B92 */ .661133318D1 ,-.242663210D1 ,-.257944032D1, .594667298D-1, * .116974683D1 , .743706410D1 ,.150646731D2 , .957496845D1, * -.147960010D0 ,-.169233071D1 ,-.468219937D1,-.313517448D1, * .136710441D-1,-.100492330D0 ,-.163653806D1,-.187082988D1, * .392284575D-1, .441503812D0 , .886741970D0, * -.119872097D-1,-.846051949D-1, .464564370D-1/ GASC=1.889227D2 TAU=304.2D0/T TT=TAU-1D0 W=1D0/(468D0*V) WW=W-1D0 WI=1D0 ZI=B00+(B01+(B02+(B03+(B04+(B05+B06*TT)*TT)*TT)*TT)*TT)*TT ZZZ=WI*ZI WI=WI*WW ZI=B10+(B11+(B12+(B13+(B14+B15*TT)*TT)*TT)*TT)*TT ZZZ=ZZZ+WI*ZI WI=WI*WW ZI=B20+(B21+(B22+(B23+(B24+B25*TT)*TT)*TT)*TT)*TT ZZZ=ZZZ+WI*ZI WI=WI*WW ZI=B30+(B31+(B32+(B33+(B34+B35*TT)*TT)*TT)*TT)*TT ZZZ=ZZZ+WI*ZI WI=WI*WW ZI=B40+(B41+(B42+(B43+(B44+B45*TT)*TT)*TT)*TT)*TT ZZZ=ZZZ+WI*ZI WI=WI*WW ZI=B50+(B51+(B52+(B53+B54*TT)*TT)*TT)*TT ZZZ=ZZZ+WI*ZI WI=WI*WW ZI=B60+(B61+(B62+B63*TT)*TT)*TT ZZZ=ZZZ+WI*ZI WI=WI*WW ZI=B70+(B71+(B72+B73*TT)*TT)*TT ZZZ=ZZZ+WI*ZI WI=WI*WW ZI=B80+(B81+B82*TT)*TT ZZZ=ZZZ+WI*ZI WI=WI*WW ZI=B90+(B91+B92*TT)*TT ZZZ=ZZZ+WI*ZI Z=1D0+W*ZZZ G9D02=Z*GASC*T/V*1D-5 RETURN END C G10 *** V(P,T) - FROM IUPAC ANALYSIS P(T,V) BY NEWTON-METHOD FUNCTION G10D02(P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCR,TKCR,VCR/73.825D+00,304.21D+00,2.1459227D-03/ DP=DABS(1.0D+00-P/PCR) IF (DP.LE.1.0D-05) THEN DT=DABS(1.0D+00-T/TKCR) IF(DT.LE.1.0D-05) THEN G10D02=VCR RETURN ENDIF ENDIF IF (P.LT.0.0D+00 .OR. P.GT.1.0D+03) GOTO 999 IF (P.GT.600D+00) THEN TMAX=700D+00 ELSE TMAX=1100D+00 ENDIF IF (T.GT.TMAX) GOTO 999 IF (P.GE.5.185D+00) THEN TMIN=F69D02(P)+273.15D00 ELSE TMIN=220D+00 ENDIF IF (T.LT.TMIN) GOTO 999 IF (P.LT.5.185D+00) THEN VMIN=4.15-(4.15-0.069)*P/5.185 VMAX=20.8-(20.8-0.416)*P/5.185 ELSEIF (P.LE.PCR) THEN TS=G3D02(P) CALL S1D02(TS,VL,VG) IF (T.LT.TS) THEN VMIN=8D-4 VMAX=VL ELSE VMIN=VG VMAX=0.42-(0.42-0.03)*(P-5.185)/(73.825-5.185) ENDIF ELSEIF (P.LE.6D2) THEN VMIN=8D-4 VMAX=0.031-(0.031-0.0041)*(P-73.825)/(6D2-73.825) ELSE VMIN=7.9D-4 VMAX=0.0026-(0.0026-0.0018)*(P-6D2)/(1D3-6D2) ENDIF V1=G11D02(VMAX,VMIN,P,T) GASBAR=1.889227D2 ILOOP=0 10 ILOOP=ILOOP+1 IF (ILOOP.EQ.1000) THEN G10D02=-1.0E+10 ELSE P1=G9D02(T,V1) DP1DV=-G18D02(T,V1)*GASBAR*T/(V1*V1) V2=1D5*(P-P1)/DP1DV+V1 IF (DABS((V2-V1)/V2).LT.1.0D-07) THEN G10D02=V2 ELSE V1=V2 GOTO 10 ENDIF ENDIF RETURN 999 G10D02=-1.0E+20 RETURN END C G11 *** FUNCTION G11D02(VMAX,VMIN,P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) VA=VMAX VB=VMIN PA=G9D02(T,VA) PB=G9D02(T,VB) ILOOP=0 10 DPA=P-PA DPB=P-PB DPAB=PA-PB VC=VB+(VA-VB)*0.5D+00 PC=G9D02(T,VC) DPC=P-PC IF (DPA*DPC.LE.0.0 .AND. DPB*DPC.GT.0.0) THEN VB=VC PB=PC ELSEIF (DPA*DPC.GT.0.0 .AND. DPB*DPC.LE.0.0) THEN VA=VC PA=PC ELSE VA=1.1*VA VB=0.9*VB PA=G9D02(T,VA) PB=G9D02(T,VB) ENDIF ILOOP=ILOOP+1 IF (ILOOP.EQ.10000) THEN G11D02=-1.0E+10 ELSEIF (DABS(VA-VB)/VB.GT.1E-2) THEN GOTO 10 ELSE G11D02=VC ENDIF RETURN END C G12 *** T(P0,V0) FROM P(T,V0)-P0=0 FUNCTION G12D02(P,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCR,TKCR,VCR/73.825D+00,304.21D+00,2.1459227D-03/ DP=DABS(1.0D+00-P/PCR) IF (DP.LE.1.0D-05) THEN DV=DABS(1.0D+00-V/VCR) IF(DV.LE.1.0D-05) THEN G12D02=TKCR RETURN ENDIF ENDIF IF (P.LT.0.0D+00 .OR. P.GT.1.0D+03) GOTO 999 IF (P.GT.600+00) THEN TMAX=700D0 ELSE TMAX=1100D0 ENDIF VMAX=G10D02(P,TMAX) IF (V.GT.VMAX) GOTO 999 IF (P.GE.5.185D+00) THEN TMIN=F69D02(P)+273.15D00 ELSE TMIN=220D+00 ENDIF VMIN=G10D02(P,TMIN) IF (V.LT.VMIN) GOTO 999 IF (P.LT.5.185D+00 .OR. P.GT.73.825D+00) THEN TA=TMAX TB=TMIN ELSE YT=G3D02(P) CALL S1D02(YT,VL,VG) IF (V.LT.VL) THEN TA=YT TB=TMIN ELSEIF (V.LE.VG) THEN G12D02=YT RETURN ELSE TA=TMAX TB=YT ENDIF ENDIF ILOOP=0 VA=G10D02(P,TA) VB=G10D02(P,TB) 10 DVA=V-VA DVB=V-VB DVAB=VA-VB TC=TB+(TA-TB)*0.5D+00 VC=G10D02(P,TC) DVC=V-VC IF (DVA*DVC.LE.0.0 .AND. DVB*DVC.GT.0.0) THEN TB=TC VB=VC ELSEIF (DVA*DVC.GT.0.0 .AND. DVB*DVC.LE.0.0) THEN TA=TC VA=VC ENDIF ILOOP=ILOOP+1 IF (ILOOP.EQ.10000) THEN G12D02=-1.0E+10 ELSEIF (DABS(TA-TB)/TB.LT.1.0D-07) THEN G12D02=TC ELSE GOTO 10 ENDIF RETURN 999 G12D02=-1.0E+20 RETURN END C G13 *** H(T,V)-ANALYSIS--IUPAC H(T,V)/(R*T) <-> FUNCTION G13D02(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA B01,B02,B03,B04,B05,B06,B11,B12,B13,B14,B15, * B21,B22,B23,B24,B25,B31,B32,B33,B34,B35,B41,B42 */-.168332974D1, .259587221D0,.376945574D0, * -.670755370D0,-.871456126D0,-.149156928D0, * .126050691D1, .596957049D1, .154645885D2, .194449475D2, * .864880497D1,-.183458178D1,-.461487677D1, * -.382121926D1, .360171349D1, .492265552D1, * -.176300541D1,-.111436705D2,-.278215446D2,-.271685720D2, * -.642177872D1, .237414246D1, .750925141D1/ DATA B43,B44,B45,B51,B52,B53,B54,B61,B62,B63,B71, * B72,B73,B81,B82,B91,B92 */ .661133318D1 ,-.242663210D1 ,-.257944032D1, * .116974683D1 , .743706410D1 ,.150646731D2 , .957496845D1, * -.169233071D1 ,-.468219937D1,-.313517448D1, * -.100492330D0 ,-.163653806D1,-.187082988D1, * .441503812D0 , .886741970D0, * -.846051949D-1, .464564370D-1/ GASC=1.889227D2 TAU=304.2D0/T TT=TAU-1D0 W=1D0/(468D0*V) WW=W-1D0 WI=WW HIJ=B01+(2*B02+(3*B03+(4*B04+(5*B05+6*B06*TT)*TT)*TT)*TT)*TT HHH=HIJ*(WI+1D0) WI=WI*WW HIJ=B11+(2*B12+(3*B13+(4*B14+5*B15*TT)*TT)*TT)*TT HHH=HHH+HIJ*(WI-1D0)/2 WI=WI*WW HIJ=B21+(2*B22+(3*B23+(4*B24+5*B25*TT)*TT)*TT)*TT HHH=HHH+HIJ*(WI+1D0)/3 WI=WI*WW HIJ=B31+(2*B32+(3*B33+(4*B34+5*B35*TT)*TT)*TT)*TT HHH=HHH+HIJ*(WI-1D0)/4 WI=WI*WW HIJ=B41+(2*B42+(3*B43+(4*B44+5*B45*TT)*TT)*TT)*TT HHH=HHH+HIJ*(WI+1D0)/5 WI=WI*WW HIJ=B51+(2*B52+(3*B53+4*B54*TT)*TT)*TT HHH=HHH+HIJ*(WI-1D0)/6 WI=WI*WW HIJ=B61+(2*B62+3*B63*TT)*TT HHH=HHH+HIJ*(WI+1D0)/7 WI=WI*WW HIJ=B71+(2*B72+3*B73*TT)*TT HHH=HHH+HIJ*(WI-1D0)/8 WI=WI*WW HIJ=B81+2*B82*TT HHH=HHH+HIJ*(WI+1D0)/9 WI=WI*WW HIJ=B91+2*B92*TT HHH=HHH+HIJ*(WI-1D0)/10 P=G9D02(T,V) HTV=G7D02(T)+(1D5*P*V+26250D3/44.009D0)/(GASC*T)-1D0 G13D02=HTV+TAU*HHH RETURN END C G14 *** S(T,V) - ANALYSIS - IUPAC S(T,V)/R <-> FUNCTION G14D02(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA B00,B01,B02,B03,B04,B05,B06,B10,B11,B12,B13,B14,B15,B20, * B21,B22,B23,B24,B25,B30,B31,B32,B33,B34,B35,B40,B41,B42 */-.725854437D0,-.168332974D1, .259587221D0,.376945574D0, * -.670755370D0,-.871456126D0,-.149156928D0, .447869183D0, * .126050691D1, .596957049D1, .154645885D2, .194449475D2, * .864880497D1,-.172011999D0,-.183458178D1,-.461487677D1, * -.382121926D1, .360171349D1, .492265552D1, .446304911D-2, * -.176300541D1,-.111436705D2,-.278215446D2,-.271685720D2, * -.642177872D1, .255491571D0, .237414246D1, .750925141D1/ DATA B43,B44,B45,B50,B51,B52,B53,B54,B60,B61,B62,B63,B70,B71, * B72,B73,B80,B81,B82,B90,B91,B92 */ .661133318D1 ,-.242663210D1 ,-.257944032D1, .594667298D-1, * .116974683D1 , .743706410D1 ,.150646731D2 , .957496845D1, * -.147960010D0 ,-.169233071D1 ,-.468219937D1,-.313517448D1, * .136710441D-1,-.100492330D0 ,-.163653806D1,-.187082988D1, * .392284575D-1, .441503812D0 , .886741970D0, * -.119872097D-1,-.846051949D-1, .464564370D-1/ GASC=1.889227D2 TAU=304.2D0/T TT=TAU-1D0 W=1D0/(468D0*V) WW=W-1D0 WI=WW SIJ1=B01+(2*B02+(3*B03+(4*B04+(5*B05+6*B06*TT)*TT)*TT)*TT)*TT SIJ2=B00+(B01+(B02+(B03+(B04+(B05+B06*TT)*TT)*TT)*TT)*TT)*TT SSS=(TAU*SIJ1-SIJ2)*(WI+1D0) WI=WI*WW SIJ1=B11+(2*B12+(3*B13+(4*B14+5*B15*TT)*TT)*TT)*TT SIJ2=B10+(B11+(B12+(B13+(B14+B15*TT)*TT)*TT)*TT)*TT SSS=SSS+(TAU*SIJ1-SIJ2)*(WI-1D0)/2 WI=WI*WW SIJ1=B21+(2*B22+(3*B23+(4*B24+5*B25*TT)*TT)*TT)*TT SIJ2=B20+(B21+(B22+(B23+(B24+B25*TT)*TT)*TT)*TT)*TT SSS=SSS+(TAU*SIJ1-SIJ2)*(WI+1D0)/3 WI=WI*WW SIJ1=B31+(2*B32+(3*B33+(4*B34+5*B35*TT)*TT)*TT)*TT SIJ2=B30+(B31+(B32+(B33+(B34+B35*TT)*TT)*TT)*TT)*TT SSS=SSS+(TAU*SIJ1-SIJ2)*(WI-1D0)/4 WI=WI*WW SIJ1=B41+(2*B42+(3*B43+(4*B44+5*B45*TT)*TT)*TT)*TT SIJ2=B40+(B41+(B42+(B43+(B44+B45*TT)*TT)*TT)*TT)*TT SSS=SSS+(TAU*SIJ1-SIJ2)*(WI+1D0)/5 WI=WI*WW SIJ1=B51+(2*B52+(3*B53+4*B54*TT)*TT)*TT SIJ2=B50+(B51+(B52+(B53+B54*TT)*TT)*TT)*TT SSS=SSS+(TAU*SIJ1-SIJ2)*(WI-1D0)/6 WI=WI*WW SIJ1=B61+(2*B62+3*B63*TT)*TT SIJ2=B60+(B61+(B62+B63*TT)*TT)*TT SSS=SSS+(TAU*SIJ1-SIJ2)*(WI+1D0)/7 WI=WI*WW SIJ1=B71+(2*B72+3*B73*TT)*TT SIJ2=B70+(B71+(B72+B73*TT)*TT)*TT SSS=SSS+(TAU*SIJ1-SIJ2)*(WI-1D0)/8 WI=WI*WW SIJ1=B81+2*B82*TT SIJ2=B80+(B81+B82*TT)*TT SSS=SSS+(TAU*SIJ1-SIJ2)*(WI+1D0)/9 WI=WI*WW SIJ1=B91+2*B92*TT SIJ2=B90+(B91+B92*TT)*TT SSS=SSS+(TAU*SIJ1-SIJ2)*(WI-1D0)/10 STV=G6D02(T)-DLOG(GASC*T/(1.01325D5*V))+SSS G14D02=STV RETURN END C G15 *** CV(T,V) - IUPAC - ANALYSIS CV/R <-> FUNCTION G15D02(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA B02,B03,B04,B05,B06,B12,B13,B14,B15, * B22,B23,B24,B25,B32,B33,B34,B35,B42 */ .259587221D0,.376945574D0, * -.670755370D0,-.871456126D0,-.149156928D0, * .596957049D1, .154645885D2, .194449475D2, * .864880497D1,-.461487677D1, * -.382121926D1, .360171349D1, .492265552D1, * -.111436705D2,-.278215446D2,-.271685720D2, * -.642177872D1, .750925141D1/ DATA B43,B44,B45,B52,B53,B54,B62,B63, * B72,B73,B82,B92 */ .661133318D1 ,-.242663210D1 ,-.257944032D1, * .743706410D1 ,.150646731D2 , .957496845D1, * -.468219937D1,-.313517448D1, * -.163653806D1,-.187082988D1, * .886741970D0, * .464564370D-1/ TAU=304.2D0/T TT=TAU-1D0 W=1D0/(468D0*V) WW=W-1D0 WI=WW CIJ=2*B02+(3*2*B03+(4*3*B04+(5*4*B05+6*5*B06*TT)*TT)*TT)*TT CCC=CIJ*(WI+1D0) WI=WI*WW CIJ=2*B12+(3*2*B13+(4*3*B14+5*4*B15*TT)*TT)*TT CCC=CCC+CIJ*(WI-1D0)/2 WI=WI*WW CIJ=2*B22+(3*2*B23+(4*3*B24+5*4*B25*TT)*TT)*TT CCC=CCC+CIJ*(WI+1D0)/3 WI=WI*WW CIJ=2*B32+(3*2*B33+(4*3*B34+5*4*B35*TT)*TT)*TT CCC=CCC+CIJ*(WI-1D0)/4 WI=WI*WW CIJ=2*B42+(3*2*B43+(4*3*B44+5*4*B45*TT)*TT)*TT CCC=CCC+CIJ*(WI+1D0)/5 WI=WI*WW CIJ=2*B52+(3*2*B53+4*3*B54*TT)*TT CCC=CCC+CIJ*(WI-1D0)/6 WI=WI*WW CIJ=2*B62+3*2*B63*TT CCC=CCC+CIJ*(WI+1D0)/7 WI=WI*WW CIJ=2*B72+3*2*B73*TT CCC=CCC+CIJ*(WI-1D0)/8 WI=WI*WW CIJ=2*B82 CCC=CCC+CIJ*(WI+1D0)/9 WI=WI*WW CIJ=2*B92 CCC=CCC+CIJ*(WI-1D0)/10 G15D02=-TAU*TAU*CCC+G8D02(T)-1D0 RETURN END C G16 *** CP(T,V) - IUPAC - ANALYSIS CP/R <-> FUNCTION G16D02(T,V) IMPLICIT DOUBLE PRECISION (G) DOUBLE PRECISION T,V G16D02=G15D02(T,V)+(G17D02(T,V))**2/G18D02(T,V) RETURN END C G17 *** (DP/DT)/(GASCON*RO) <-> AT T AND V C - IUPAC TABLE - FUNCTION G17D02(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA B00,B01,B02,B03,B04,B05,B06,B10,B11,B12,B13,B14,B15,B20, * B21,B22,B23,B24,B25,B30,B31,B32,B33,B34,B35,B40,B41,B42 */-.725854437D0,-.168332974D1, .259587221D0,.376945574D0, * -.670755370D0,-.871456126D0,-.149156928D0, .447869183D0, * .126050691D1, .596957049D1, .154645885D2, .194449475D2, * .864880497D1,-.172011999D0,-.183458178D1,-.461487677D1, * -.382121926D1, .360171349D1, .492265552D1, .446304911D-2, * -.176300541D1,-.111436705D2,-.278215446D2,-.271685720D2, * -.642177872D1, .255491571D0, .237414246D1, .750925141D1/ DATA B43,B44,B45,B50,B51,B52,B53,B54,B60,B61,B62,B63,B70,B71, * B72,B73,B80,B81,B82,B90,B91,B92 */ .661133318D1 ,-.242663210D1 ,-.257944032D1, .594667298D-1, * .116974683D1 , .743706410D1 ,.150646731D2 , .957496845D1, * -.147960010D0 ,-.169233071D1 ,-.468219937D1,-.313517448D1, * .136710441D-1,-.100492330D0 ,-.163653806D1,-.187082988D1, * .392284575D-1, .441503812D0 , .886741970D0, * -.119872097D-1,-.846051949D-1, .464564370D-1/ TAU=304.2D0/T TT=TAU-1D0 W=1D0/(468D0*V) WW=W-1D0 WI=1D0 DP1=B01+(2*B02+(3*B03+(4*B04+(5*B05+6*B06*TT)*TT)*TT)*TT)*TT DP2=B00+(B01+(B02+(B03+(B04+(B05+B06*TT)*TT)*TT)*TT)*TT)*TT DPP=(DP2-TAU*DP1)*WI WI=WI*WW DP1=B11+(2*B12+(3*B13+(4*B14+5*B15*TT)*TT)*TT)*TT DP2=B10+(B11+(B12+(B13+(B14+B15*TT)*TT)*TT)*TT)*TT DPP=DPP+(DP2-TAU*DP1)*WI WI=WI*WW DP1=B21+(2*B22+(3*B23+(4*B24+5*B25*TT)*TT)*TT)*TT DP2=B20+(B21+(B22+(B23+(B24+B25*TT)*TT)*TT)*TT)*TT DPP=DPP+(DP2-TAU*DP1)*WI WI=WI*WW DP1=B31+(2*B32+(3*B33+(4*B34+5*B35*TT)*TT)*TT)*TT DP2=B30+(B31+(B32+(B33+(B34+B35*TT)*TT)*TT)*TT)*TT DPP=DPP+(DP2-TAU*DP1)*WI WI=WI*WW DP1=B41+(2*B42+(3*B43+(4*B44+5*B45*TT)*TT)*TT)*TT DP2=B40+(B41+(B42+(B43+(B44+B45*TT)*TT)*TT)*TT)*TT DPP=DPP+(DP2-TAU*DP1)*WI WI=WI*WW DP1=B51+(2*B52+(3*B53+4*B54*TT)*TT)*TT DP2=B50+(B51+(B52+(B53+B54*TT)*TT)*TT)*TT DPP=DPP+(DP2-TAU*DP1)*WI WI=WI*WW DP1=B61+(2*B62+3*B63*TT)*TT DP2=B60+(B61+(B62+B63*TT)*TT)*TT DPP=DPP+(DP2-TAU*DP1)*WI WI=WI*WW DP1=B71+(2*B72+3*B73*TT)*TT DP2=B70+(B71+(B72+B73*TT)*TT)*TT DPP=DPP+(DP2-TAU*DP1)*WI WI=WI*WW DP1=B81+2*B82*TT DP2=B80+(B81+B82*TT)*TT DPP=DPP+(DP2-TAU*DP1)*WI WI=WI*WW DP1=B91+2*B92*TT DP2=B90+(B91+B92*TT)*TT DPP=DPP+(DP2-TAU*DP1)*WI G17D02=1D0+W*DPP RETURN END C G18 *** (DP/DRO)/(GASCON*T) <-> AT T AND V C - IUPAC TABLE - EQUATION(26) FUNCTION G18D02(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA B00,B01,B02,B03,B04,B05,B06,B10,B11,B12,B13,B14,B15,B20, * B21,B22,B23,B24,B25,B30,B31,B32,B33,B34,B35,B40,B41,B42 */-.725854437D0,-.168332974D1, .259587221D0,.376945574D0, * -.670755370D0,-.871456126D0,-.149156928D0, .447869183D0, * .126050691D1, .596957049D1, .154645885D2, .194449475D2, * .864880497D1,-.172011999D0,-.183458178D1,-.461487677D1, * -.382121926D1, .360171349D1, .492265552D1, .446304911D-2, * -.176300541D1,-.111436705D2,-.278215446D2,-.271685720D2, * -.642177872D1, .255491571D0, .237414246D1, .750925141D1/ DATA B43,B44,B45,B50,B51,B52,B53,B54,B60,B61,B62,B63,B70,B71, * B72,B73,B80,B81,B82,B90,B91,B92 */ .661133318D1 ,-.242663210D1 ,-.257944032D1, .594667298D-1, * .116974683D1 , .743706410D1 ,.150646731D2 , .957496845D1, * -.147960010D0 ,-.169233071D1 ,-.468219937D1,-.313517448D1, * .136710441D-1,-.100492330D0 ,-.163653806D1,-.187082988D1, * .392284575D-1, .441503812D0 , .886741970D0, * -.119872097D-1,-.846051949D-1, .464564370D-1/ TAU=304.2D0/T TT=TAU-1D0 W=1D0/(468D0*V) WW=W-1D0 WI=1D0 DV1=B00+(B01+(B02+(B03+(B04+(B05+B06*TT)*TT)*TT)*TT)*TT)*TT DPV=2*DV1 DV1=B10+(B11+(B12+(B13+(B14+B15*TT)*TT)*TT)*TT)*TT DPV=DPV+(2*WW+W)*DV1 WI=WI*WW DV1=B20+(B21+(B22+(B23+(B24+B25*TT)*TT)*TT)*TT)*TT DPV=DPV+(2*WW+2*W)*WI*DV1 WI=WI*WW DV1=B30+(B31+(B32+(B33+(B34+B35*TT)*TT)*TT)*TT)*TT DPV=DPV+(2*WW+3*W)*WI*DV1 WI=WI*WW DV1=B40+(B41+(B42+(B43+(B44+B45*TT)*TT)*TT)*TT)*TT DPV=DPV+(2*WW+4*W)*WI*DV1 WI=WI*WW DV1=B50+(B51+(B52+(B53+B54*TT)*TT)*TT)*TT DPV=DPV+(2*WW+5*W)*WI*DV1 WI=WI*WW DV1=B60+(B61+(B62+B63*TT)*TT)*TT DPV=DPV+(2*WW+6*W)*WI*DV1 WI=WI*WW DV1=B70+(B71+(B72+B73*TT)*TT)*TT DPV=DPV+(2*WW+7*W)*WI*DV1 WI=WI*WW DV1=B80+(B81+B82*TT)*TT DPV=DPV+(2*WW+8*W)*WI*DV1 WI=WI*WW DV1=B90+(B91+B92*TT)*TT DPV=DPV+(2*WW+9*W)*WI*DV1 G18D02=1D0+W*DPV RETURN END C G19 *** RAM(T,V) - THERMAL CONDUCTIVITY - T,V FUNCTION G19D02(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A10,A11,A12,A20,A21,A22,A30,A31,A32, * A40,A41,A42,A50,A51,B1,B2,B3,B4 */ .118763738D1,-.273693975D1, .252042816D1, * -.230778414D1, .441994872D1,-.915667463D-1, * .261294395D1,-.400329344D1,-.135345324D1, * -.128325590D1, .213659771D1, .376570783D0, * .219542368D0,-.402133782D0, * .572860124D2,-.781435192D2, .491871184D2,-.115094347D2/ TT=304.2D0/T WW=1D0/(468D0*V) TI=1D0 ZI=(A10+(A20+(A30+(A40+A50*WW)*WW)*WW)*WW)*WW ZZZ=ZI TI=TI*TT ZI=(A11+(A21+(A31+(A41+A51*WW)*WW)*WW)*WW)*WW ZZZ=ZZZ+TI*ZI TI=TI*TT ZI=(A12+(A22+(A32+A42*WW)*WW)*WW)*WW ZZZ=ZZZ+TI*ZI ZT=(B1+(B2+(B3+B4*TT)*TT)*TT)/DSQRT(TT)*1D-3 ZZZ=ZT*DEXP(ZZZ) G19D02=ZZZ RETURN END C G20 *** MYU(T,V) - VISCOSITY - T,V FUNCTION G20D02(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A10,A11,A20,A21,A30,A31,A40,A41,B1,B2,B3 */ .248566120D0, .489494200D-2,-.373300660D0, .122753488D1, * .363854523D0,-.774229021D0,-.639070755D-1, .142507049D0, * .272246461D4,-.166346068D4, .466920556D3/ TT=304.2D0/T WW=1D0/(468D0*V) TI=1D0 ZI=(((A40*WW+A30)*WW+A20)*WW+A10)*WW ZZZ=ZI TI=TI*TT ZI=(((A41*WW+A31)*WW+A21)*WW+A11)*WW ZZZ=ZZZ+TI*ZI ZT=((B3*TT+B2)*TT+B1)/DSQRT(TT)*1D-8 ZZZ=ZT*DEXP(ZZZ) G20D02=ZZZ END C S1 *** VD(T),VDD(T) SUBROUTINE S1D02(T,VL,VG) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA TC,ROC/304.21D0,466D0/ DT=DABS(1.0D+00-T/TC) IF (DT.LT.5.0D-07) THEN VL=1.0D+00/ROC VG=VL ELSE ER=2D0/3 TR=1D0-T/TC TR1=TR**.347 TR2=TR**ER DROL=1.9073793D0*TR1+.38225012D0*TR2+.42897885D0*TR ROL=ROC*(1D0+DROL) VL=1D0/ROL DROG=-1.7988929D0*TR1-.71728276D0*TR2+1.7739244D0*TR ROG=ROC*(1D0+DROG) VG=1D0/ROG ENDIF RETURN END C S2 *** T(P0,H0) V(P0,H0) FROM P(T,V)-P0=0 AND H(T,V)-H0=0 SUBROUTINE S2D02(P,H,T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF (P.LT.0.0D+00 .OR. P.GT.1.0D+03) GOTO 999 IF (P.GT.600D+00) THEN TMAX=700D+00 ELSE TMAX=1100D+00 ENDIF VMAX=G10D02(P,TMAX) HMAX=G13D02(TMAX,VMAX)*TMAX*1.889227D2 IF (H.GT.HMAX) GOTO 999 IF (P.GE.5.185D+00) THEN TMIN=F69D02(P)+273.15D00 ELSE TMIN=220D+00 ENDIF VMIN=G10D02(P,TMIN) HMIN=G13D02(TMIN,VMIN)*TMIN*1.889227D2 IF (H.LT.HMIN) GOTO 999 IF (P.LT.5.185D+00 .OR. P .GT. 73.825+00) THEN TA=TMAX TB=TMIN ELSE YT=G3D02(P) CALL S1D02(YT,VL,VG) HD=G13D02(YT,VL)*YT*1.889227D2 HDD=HD+1D5*(VG-VL)*YT*G2D02(P,YT) IF (H.LT.HD) THEN TA=YT TB=TMIN ELSEIF (H.LE.HDD) THEN T=YT V=VL+(VG-VL)*(H-HD)/(HDD-HD) RETURN ELSE TA=TMAX TB=YT ENDIF ENDIF ILOOP=0 VA=G10D02(P,TA) VB=G10D02(P,TB) HA=G13D02(TA,VA)*TA*1.889227D2 HB=G13D02(TB,VB)*TB*1.889227D2 10 DHA=H-HA DHB=H-HB DHAB=HA-HB TC=TB+(TA-TB)*0.5+00 VC=G10D02(P,TC) HC=G13D02(TC,VC)*TC*1.889227D2 DHC=H-HC IF (DHA*DHC.LE.0.0 .AND. DHB*DHC.GT.0.0) THEN TB=TC HB=HC ELSEIF (DHA*DHC.GT.0.0 .AND. DHB*DHC.LE.0.0) THEN TA=TC HA=HC ENDIF ILOOP=ILOOP+1 IF (ILOOP.EQ.10000) THEN T=-1.0E+10 V=-1.0E+10 ELSEIF (DABS(TA-TB)/TB.LT.1.0D-07) THEN T=TC V=G10D02(P,T) ELSE GOTO 10 ENDIF RETURN 999 T=-1.0E+20 V=-1.0E+20 RETURN END C S3 *** T(P0,S0) V(P0,S0) FROM P(T,V)-P0=0 AND S(T,V)-S0=0 SUBROUTINE S3D02(P,S,T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF (P.LT.0.0D+00 .OR. P.GT.1.0D+03) GOTO 999 IF (P.GT.600D+00) THEN TMAX=700D+00 ELSE TMAX=1100D+00 ENDIF VMAX=G10D02(P,TMAX) SMAX=G14D02(TMAX,VMAX)*1.889227D2 IF (S.GT.SMAX) GOTO 999 IF (P.GE.5.185D+00) THEN TMIN=F69D02(P)+273.15D00 ELSE TMIN=220D+00 ENDIF VMIN=G10D02(P,TMIN) SMIN=G14D02(TMIN,VMIN)*1.889227D2 IF (S.LT.SMIN) GOTO 999 IF (P.LT.5.185D+00 .OR. P.GT.73.825D+00) THEN TA=TMAX TB=TMIN ELSE YT=G3D02(P) CALL S1D02(YT,VL,VG) SD=G14D02(YT,VL)*1.889227D2 SDD=SD+1D5*(VG-VL)*G2D02(P,YT) IF (S.LT.SD) THEN TA=YT TB=TMIN ELSEIF (S.LE.SDD) THEN T=YT V=VL+(VG-VL)*(S-SD)/(SDD-SD) RETURN ELSE TA=TMAX TB=YT ENDIF ENDIF ILOOP=0 VA=G10D02(P,TA) VB=G10D02(P,TB) SA=G14D02(TA,VA)*1.889227D2 SB=G14D02(TB,VB)*1.889227D2 10 DSA=S-SA DSB=S-SB DSAB=SA-SB TC=TB+(TA-TB)*0.5D+00 VC=G10D02(P,TC) SC=G14D02(TC,VC)*1.889227D2 DSC=S-SC IF (DSA*DSC.LE.0.0 .AND. DSB*DSC.GT.0.0) THEN TB=TC SB=SC ELSEIF (DSA*DSC.GT.0.0 .AND. DSB*DSC.LE.0.0) THEN TA=TC SA=SC ENDIF ILOOP=ILOOP+1 IF (ILOOP.EQ.10000) THEN T=-1.0E+10 V=-1.0E+10 ELSEIF (DABS(TA-TB)/TC .LT. 1.0D-07) THEN T=TC V=G10D02(P,T) ELSE GOTO 10 ENDIF RETURN 999 T=-1.0E+20 V=-1.0E+20 RETURN END C *** FUNCTION FOR REGION CHECK C G91 FUNC(P) TYPE FUNCTION G91D02(P) DOUBLE PRECISION PCR,PTR,DP,PD INTEGER G91D02 DATA PCR,PTR/73.825D+00,5.180D+00/ PD=DBLE(P) IF (PD.LT.PTR) THEN G91D02=3 ELSEIF (P.LT.PCR) THEN G91D02=0 ELSE G91D02=3 ENDIF DP=1.0D+00-PD/PCR IF (DP.LT.1.0D-06) THEN IF (DP.GE.0.0D+00) THEN G91D02=1 ENDIF ENDIF RETURN END C G92 FUNC(T) TYPE FUNCTION G92D02(T) DOUBLE PRECISION TTR,TCR,TKCR,TD,TK,DT INTEGER G92D02 DATA TTR,TCR,TKCR/-56.57D+00,31.06D+00,304.21D+00/ TD=DBLE(T) TK=TD+273.15D+00 IF (TD.LT.TTR) THEN G92D02=3 ELSEIF (TD.LT.TCR) THEN G92D02=0 ELSE G92D02=3 ENDIF DT=1.0D+00-TK/TKCR IF (DT.LT.5.0D-07) THEN IF (DT.GE.0.0D+00) THEN G92D02=1 ENDIF ENDIF RETURN END C G93 *** REGION CHECK FOR FUNC(P,T) TYPE FUNCTION G93D02(P,T) INTEGER G93D02 DATA PCR,TKCR/73.825,304.21/ TK=T+273.15 DP=ABS(1.0E+00-P/PCR) IF (DP.LE.1.0E-05) THEN DT=ABS(1.0E+00-TK/TKCR) IF(DT.LE.1.0E-05) THEN G93D02=1 RETURN ENDIF ENDIF G93D02=2 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