C ************************************* C * PROPATH VERSION 9.1 * C * SUPERVISOR FOR [NITROGEN] * C * PROGRAM UNIT [D01SVP.FOR] * C * VERSION 3.1 * C * CODED BY * C * TOMOHIRO HONDA * C * (FUKUOKA UNIVERSITY) * C * FUKUOKA 814-01, JAPAN * C * AUGUST 1988 (VER.2.1) * C * SEPTEMBER 1990 (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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(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 S99D01(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99D01(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT REAL FUNCTION AJTPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'AJTPT'/ C--- SET OF UNIT - PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL - FF = F94D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - AJTPT=FF RETURN END C------------------------------------------------- F82 = AKPT REAL FUNCTION AKPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'AKPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F82D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AKPT=FF RETURN END C------------------------------------------------- F2 = ALAPP REAL FUNCTION ALAPP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'ALAPP'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F2D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALAPP=FF RETURN END C------------------------------------------------- F3 = ALAPT REAL FUNCTION ALAPT(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'ALAPT'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F3D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALAPT=FF RETURN END C------------------------------------------------- F4 = ALHP REAL FUNCTION ALHP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'ALHP'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F4D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALHP=FF RETURN END C------------------------------------------------- F5 = ALHT REAL FUNCTION ALHT(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'ALHT'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F5D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALHT=FF RETURN END C------------------------------------------------- F6 = ALMPD REAL FUNCTION ALMPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'ALMPD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F6D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMPD=FF RETURN END C------------------------------------------------- F7 = ALMPDD REAL FUNCTION ALMPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'ALMPDD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F7D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMPDD=FF RETURN END C------------------------------------------------- F8 = ALMPT REAL FUNCTION ALMPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'ALMPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F8D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMPT=FF RETURN END C------------------------------------------------- F9 = ALMTD REAL FUNCTION ALMTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'ALMTD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F9D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMTD=FF RETURN END C------------------------------------------------- F10 = ALMTDD REAL FUNCTION ALMTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'ALMTDD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F10D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMTDD=FF RETURN END C------------------------------------------------- F11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'AMUPD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F11D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUPD=FF RETURN END C------------------------------------------------- F12 = AMUPDD REAL FUNCTION AMUPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'AMUPDD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F12D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUPDD=FF RETURN END C------------------------------------------------- F13 = AMUPT REAL FUNCTION AMUPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'AMUPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F13D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUPT=FF RETURN END C------------------------------------------------- F14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'AMUTD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F14D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUTD=FF RETURN END C------------------------------------------------- F15 = AMUTDD REAL FUNCTION AMUTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'AMUTDD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F15D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUTDD=FF RETURN END C------------------------------------------------- F90 = BSPT REAL FUNCTION BSPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BSPT'/ C--- SET OF UNIT - PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL - FF = F90D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BSPT=FF RETURN END C------------------------------------------------- F91 = BTPT REAL FUNCTION BTPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BTPT'/ C--- SET OF UNIT - PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL - FF = F91D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BTPT=FF RETURN END C------------------------------------------------- F92 = BPPT REAL FUNCTION BPPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BPPT'/ C--- SET OF UNIT - PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL - FF = F92D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BPPT=FF RETURN END C------------------------------------------------- F93 = BVPT REAL FUNCTION BVPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BVPT'/ C--- SET OF UNIT - PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL - FF = F93D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BVPT=FF RETURN END C------------------------------------------------- F16 = CPPD REAL FUNCTION CPPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'CPPD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F16D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPPD=FF RETURN END C------------------------------------------------- F17 = CPPDD REAL FUNCTION CPPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'CPPDD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F17D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPPDD=FF RETURN END C------------------------------------------------- F18 = CPPT REAL FUNCTION CPPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'CPPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F18D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPPT=FF RETURN END C------------------------------------------------- F19 = CPTD REAL FUNCTION CPTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'CPTD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F19D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPTD=FF RETURN END C------------------------------------------------- F20 = CPTDD REAL FUNCTION CPTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'CPTDD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F20D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPTDD=FF RETURN END C------------------------------------------------- F21 = CRP REAL FUNCTION CRP(A) CHARACTER FUN*6,A*1 REAL T0K,PBAR,FF C--- FUNCTION NAME -- DATA FUN/'CRP'/ C--- SET OF UNIT -- C--- FUNCTION CALL -- FF = F21D01(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 ', & ' NITROGEN WHEN A=',A,' ****') CRP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- IF(A.EQ.'T') THEN T0K=-G99D01(0.0) FF=FF+T0K ELSE IF(A.EQ.'P') THEN PBAR=G98D01(1.0) FF=FF/PBAR END IF CRP=FF RETURN END C------------------------------------------------- F76 = CVPDD REAL FUNCTION CVPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'CVPDD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F76D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVPDD=FF RETURN END C------------------------------------------------- F77 = CVPT REAL FUNCTION CVPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'CVPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F77D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVPT=FF RETURN END C------------------------------------------------- F78 = CVTDD REAL FUNCTION CVTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'CVTDD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F78D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVTDD=FF RETURN END C------------------------------------------------- F89 = FC C************************************************ C FUNCTION FOR FUNDDAMENTAL CONSTANTS C PROPATH VER.7.1, MAY 8, 1990 C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='28.0134' WHEN A='M' C B='296.8115' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=28.0134 ELSE IF (A.EQ.'R') THEN FC=296.8115 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR NITROGEN WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F22 = EPSPT REAL FUNCTION EPSPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'EPSPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F22D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- EPSPT=FF RETURN END C------------------------------------------------- F96 = GAMPDD REAL FUNCTION GAMPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'GAMPDD'/ C--- SET OF UNIT - PI=G98D01(P) C--- FUNCTION CALL - FF = F96D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPDD=FF RETURN END C------------------------------------------------ F95 = GAMPT REAL FUNCTION GAMPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'GAMPT'/ C--- SET OF UNIT - PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL - FF = F95D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPT=FF RETURN END C------------------------------------------------ F97 = GAMTDD REAL FUNCTION GAMTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME - DATA FUN/'GAMTDD'/ C--- SET OF UNIT - TI=G99D01(T) C--- FUNCTION CALL - FF = F97D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMTDD=FF RETURN END C------------------------------------------------- F23 = HPD REAL FUNCTION HPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'HPD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F23D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPD=FF RETURN END C------------------------------------------------- F24 = HPDD REAL FUNCTION HPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'HPDD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F24D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPDD=FF RETURN END C------------------------------------------------- F71 = HPS REAL FUNCTION HPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME -- DATA FUN/'HPS'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F71D01(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPS=FF RETURN END C------------------------------------------------- F25 = HPT REAL FUNCTION HPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'HPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F25D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPT=FF RETURN END C------------------------------------------------- F26 = HPX REAL FUNCTION HPX(P,X) CHARACTER FUN*6 REAL P,X,FF C--- FUNCTION NAME -- DATA FUN/'HPX'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F26D01(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPX=FF RETURN END C------------------------------------------------- F27 = HTD REAL FUNCTION HTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'HTD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F27D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HTD=FF RETURN END C------------------------------------------------- F28 = HTDD REAL FUNCTION HTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'HTDD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F28D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HTDD=FF RETURN END C------------------------------------------------- F29 = HTX REAL FUNCTION HTX(T,X) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'HTX'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F29D01(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(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='NITROGEN' WHEN A='S' C B='N2' 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='NITROGEN' ELSE IF (A.EQ.'C') THEN IDENTF='N2' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR NITROGEN 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 S99D01(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 -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F68D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) PBAR=1.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) PBAR=1.0E+00 ELSE PBAR=G98D01(1.0) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PMLT=FF/PBAR RETURN END C------------------------------------------------- F85 = PRPD REAL FUNCTION PRPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'PRPD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F85D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRPD=FF RETURN END C------------------------------------------------- F86 = PRPDD REAL FUNCTION PRPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'PRPDD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F86D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRPDD=FF RETURN END C------------------------------------------------- F81 = PRPT REAL FUNCTION PRPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'PRPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F81D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRPT=FF RETURN END C------------------------------------------------- F87 = PRTD REAL FUNCTION PRTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'PRTD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F87D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRTD=FF RETURN END C------------------------------------------------- F88 = PRTDD REAL FUNCTION PRTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'PRTDD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F88D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(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 S99D01(FUN) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F30 = PST REAL FUNCTION PST(T) CHARACTER FUN*6 REAL PBAR,T,FF C--- FUNCTION NAME -- DATA FUN/'PST'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F30D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) PBAR=1.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) PBAR=1.0E+00 ELSE PBAR=G98D01(1.0) 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 S99D01(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99D01(FUN) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F31 = SIGP REAL FUNCTION SIGP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'SIGP'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F31D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSEIF (FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SIGP=FF RETURN END C------------------------------------------------- F32 = SIGT REAL FUNCTION SIGT(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'SIGT'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F32D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF (FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSEIF (FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SIGT=FF RETURN END C------------------------------------------------- F33 = SPD REAL FUNCTION SPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'SPD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F33D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPD=FF RETURN END C------------------------------------------------- F34 = SPDD REAL FUNCTION SPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'SPDD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F34D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPDD=FF RETURN END C------------------------------------------------- F35 = SPT REAL FUNCTION SPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'SPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F35D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPT=FF RETURN END C------------------------------------------------- F36 = SPX REAL FUNCTION SPX(P,X) CHARACTER FUN*6 REAL P,X,FF C--- FUNCTION NAME -- DATA FUN/'SPX'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F36D01(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPX=FF RETURN END C------------------------------------------------- F37 = STD REAL FUNCTION STD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'STD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F37D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- STD=FF RETURN END C------------------------------------------------- F38 = STDD REAL FUNCTION STDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'STDD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F38D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- STDD=FF RETURN END C------------------------------------------------- F39 = STX REAL FUNCTION STX(T,X) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'STX'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F39D01(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(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 S99D01(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP FUNCTION TMLP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'TMLP'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F69D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) T0K=0.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) T0K=0.0E+00 ELSE T0K=-G99D01(0.0) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TMLP=FF+T0K RETURN END C------------------------------------------------- F64 = TPH REAL FUNCTION TPH(P,H) CHARACTER FUN*6 REAL T0K,P,H,FF C--- FUNCTION NAME -- DATA FUN/'TPH'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F64D01(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) T0K=0.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,H,'P','H',FUN) T0K=0.0E+00 ELSE T0K=-G99D01(0.0) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPH=FF+T0K RETURN END C------------------------------------------------- F65 = TPS REAL FUNCTION TPS(P,S) CHARACTER FUN*6 REAL T0K,P,S,FF C--- FUNCTION NAME -- DATA FUN/'TPS'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F65D01(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) T0K=0.0E+00 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,S,'P','S',FUN) T0K=0.0E+00 ELSE T0K=-G99D01(T) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPS=FF+T0K RETURN END C---------------------------------------------------------------------- C----- FUNCTION SUBRROGRM TPSEUP(P) TO FIND PSEUDO BOILING POINT C----- AS A FUNCTION OF PRESSSURE TPSEUP.FOR C---------------------------------------------------------------------- REAL FUNCTION TPSEUP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'TPSEUP'/ C--- SET OF UNIT -- PI=DBLE(G98D01(P)) C--- FUNCTION CALL -- FF = F98D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) T0K=0.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) T0K=0.0E+00 ELSE T0K=-G99D01(0.0) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPSEUP=FF+T0K RETURN END C------------------------------------------------- F70 = TPV REAL FUNCTION TPV(P,V) CHARACTER FUN*6 REAL T0K,P,V,FF C--- FUNCTION NAME -- DATA FUN/'TPV'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F70D01(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) T0K=0.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,V,'P','V',FUN) T0K=0.0E+00 ELSE T0K=-G99D01(0.0) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPV=FF+T0K RETURN END C------------------------------------------------- F41 = TRPL REAL FUNCTION TRPL(A) CHARACTER FUN*6,A*1 REAL T0K,PBAR,FF C--- FUNCTION NAME -- DATA FUN/'TRPL'/ C--- SET OF UNIT -- C--- FUNCTION CALL -- FF = F41D01(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 ', & ' NITROGEN WHEN A=',A,' ****') TRPL=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- IF(A.EQ.'T') THEN T0K=-G99D01(0.0) FF=FF+T0K ELSE IF(A.EQ.'P') THEN PBAR=G98D01(1.0) FF=FF/PBAR END IF TRPL=FF RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99D01(FUN) TSBP=-1.0E+30 RETURN END C------------------------------------------------- F40 = TSP REAL FUNCTION TSP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'TSP'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F40D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) T0K=0.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) T0K=0.0E+00 ELSE T0K=-G99D01(0.0) 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 S99D01(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99D01(FUN) TSPDD=-1.0E+30 RETURN END C------------------------------------------------- F42 = UPD REAL FUNCTION UPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'UPD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F42D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPD=FF RETURN END C------------------------------------------------- F43 = UPDD REAL FUNCTION UPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'UPDD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F43D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPDD=FF RETURN END C------------------------------------------------- F79 = UPS REAL FUNCTION UPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME -- DATA FUN/'UPS'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F79D01(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPS=FF RETURN END C------------------------------------------------- F44 = UPT REAL FUNCTION UPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'UPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F44D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPT=FF RETURN END C------------------------------------------------- F45 = UPX REAL FUNCTION UPX(P,X) CHARACTER FUN*6 REAL P,X,FF C--- FUNCTION NAME -- DATA FUN/'UPX'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F45D01(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPX=FF RETURN END C------------------------------------------------- F46 = UTD REAL FUNCTION UTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'UTD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F46D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UTD=FF RETURN END C------------------------------------------------- F47 = UTDD REAL FUNCTION UTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'UTDD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F47D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UTDD=FF RETURN END C------------------------------------------------- F48 = UTX REAL FUNCTION UTX(T,X) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'UTX'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F48D01(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,T,X,'T','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UTX=FF RETURN END C------------------------------------------------- F49 = VPD REAL FUNCTION VPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'VPD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F49D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPD=FF RETURN END C------------------------------------------------- F50 = VPDD REAL FUNCTION VPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'VPDD'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F50D01(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPDD=FF RETURN END C------------------------------------------------- F80 = VPS REAL FUNCTION VPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME -- DATA FUN/'VPS'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F80D01(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPS=FF RETURN END C------------------------------------------------- F51 = VPT REAL FUNCTION VPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'VPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F51D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPT=FF RETURN END C------------------------------------------------- F52 = VPX REAL FUNCTION VPX(P,X) CHARACTER FUN*6 REAL P,X,FF C--- FUNCTION NAME -- DATA FUN/'VPX'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F52D01(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPX=FF RETURN END C------------------------------------------------- F53 = VTD REAL FUNCTION VTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'VTD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F53D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VTD=FF RETURN END C------------------------------------------------- F54 = VTDD REAL FUNCTION VTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'VTDD'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F54D01(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VTDD=FF RETURN END C------------------------------------------------- F55 = VTX REAL FUNCTION VTX(T,X) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'VTX'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F55D01(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,T,X,'T','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VTX=FF RETURN END C------------------------------------------------- F83 = WPT REAL FUNCTION WPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'WPT'/ C--- SET OF UNIT -- PI=G98D01(P) TI=G99D01(T) C--- FUNCTION CALL -- FF = F83D01(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- WPT=FF RETURN END C------------------------------------------------- F56 = XPH REAL FUNCTION XPH(P,H) CHARACTER FUN*6 REAL P,H,FF C--- FUNCTION NAME -- DATA FUN/'XPH'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F56D01(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,H,'P','H',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPH=FF RETURN END C------------------------------------------------- F57 = XPS REAL FUNCTION XPS(P,S) CHARACTER FUN*6 REAL P,S,FF C--- FUNCTION NAME -- DATA FUN/'XPS'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F57D01(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPS=FF RETURN END C------------------------------------------------- F58 = XPU REAL FUNCTION XPU(P,U) CHARACTER FUN*6 REAL P,U,FF C--- FUNCTION NAME -- DATA FUN/'XPU'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F58D01(PI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,U,'P','U',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPU=FF RETURN END C------------------------------------------------- F59 = XPV REAL FUNCTION XPV(P,V) CHARACTER FUN*6 REAL P,V,FF C--- FUNCTION NAME -- DATA FUN/'XPV'/ C--- SET OF UNIT -- PI=G98D01(P) C--- FUNCTION CALL -- FF = F59D01(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,P,V,'P','V',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPV=FF RETURN END C------------------------------------------------- F60 = XTH REAL FUNCTION XTH(T,H) CHARACTER FUN*6 REAL T,H,FF C--- FUNCTION NAME -- DATA FUN/'XTH'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F60D01(TI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,T,H,'T','H',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XTH=FF RETURN END C------------------------------------------------- F61 = XTS REAL FUNCTION XTS(T,S) CHARACTER FUN*6 REAL T,S,FF C--- FUNCTION NAME -- DATA FUN/'XTS'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F61D01(TI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,T,S,'T','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XTS=FF RETURN END C------------------------------------------------- F62 = XTU REAL FUNCTION XTU(T,U) CHARACTER FUN*6 REAL T,U,FF C--- FUNCTION NAME -- DATA FUN/'XTU'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F62D01(TI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(3,T,U,'T','U',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XTU=FF RETURN END C------------------------------------------------- F63 = XTV REAL FUNCTION XTV(T,V) CHARACTER FUN*6 REAL T,V,FF C--- FUNCTION NAME -- DATA FUN/'XTV'/ C--- SET OF UNIT -- TI=G99D01(T) C--- FUNCTION CALL -- FF = F63D01(TI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D01(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D01(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 G98D01(P) REAL P,G98D01 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 G98D01=REAL(DBLE(P)*PBAR) RETURN END C G99 *** FUNCTION G99D01(T) REAL T,G99D01 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 G99D01=REAL(DBLE(T)-T0K) RETURN END C ******* SUBROUTINE FOR ERROR MESSAGE ******* C *** LEVEL 1 ERROR MESSAGE -- SUBROUTINE S97D01(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR NITROGEN ****' WRITE(6,*) MSG ENDIF RETURN END C *** LEVEL 2 ERROR MESSAGE -- SUBROUTINE S98D01(IPT,P,T,N1,N2,FUN) CHARACTER FUN*6,N1*1,N2*1 REAL P,T INTEGER KPA,MESS,IPT COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN IF (IPT.EQ.1) THEN C--- FUN(P) TYPE WRITE(6,6010) FUN,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR NITROGEN', & ' WHEN P =',1PE14.7,' ****') C--- FUN(T) TYPE ELSEIF (IPT.EQ.2) THEN WRITE(6,6020) FUN,T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR NITROGEN', & ' WHEN T =',1PE14.7,' ****') C--- FUN(P,T) TYPE ELSE WRITE(6,6030) FUN,N1,P,N2,T 6030 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR NITROGEN', & ' WHEN ',A1,'=',1PE14.7,' AND ',A1,'=',1PE14.7,' ****') ENDIF ENDIF RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99D01(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR NITROGEN ****' WRITE(6,100) MSG 100 FORMAT(1H ,5X,A) ENDIF RETURN END C ************************************* C * PROGRAM UNIT FOR NITROGEN * C * VERSION 2.2 * C * * C * CODED BY * C * TAMAMI ODATE * C * FEBRUARY 1987 * C * * C * REVICED BY * C * TOMOHIRO HONDA * C * SEPTEMBER 1988 * C * JANUARY 1990 * C * * C * APPEND F90-F97 * C * SEPTEMBER 1990 * C * (FUKUOKA UNIVERSITY) * C * FUKUOKA 814-01, JAPAN * C ************************************* C C 2 ***** FUNCTION F2D01(P) T=F40D01(P) IF (T.GT.-1.0E+08) THEN F2D01=F3D01(T) ELSE F2D01=-1.0E+20 ENDIF RETURN END C 3 ***** FUNCTION F3D01(T) IF(T.GE.-210.002.AND.T.LE.-146.95) THEN TK=T+273.15 SIG=G22D01(TK) VF=F53D01(T) VG=F54D01(T) IF (SIG.EQ.0. .OR. VF.EQ.VG) THEN F3D01=0.0 ELSE G=9.80665 F3D01=SQRT(SIG*VF*VG/(G*(VG-VF))) ENDIF ELSE F3D01=-1.0E+20 ENDIF RETURN END C 4 ***** FUNCTION F4D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YTK=G4D01(DBLE(P)*1D5) F4D01=REAL(G18D01(YTK))/28.0134E-3 ELSE F4D01=-1.0E+20 ENDIF RETURN END C 5 ***** FUNCTION F5D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 F5D01=REAL(G18D01(YTK))/28.0134E-3 ELSE F5D01=-1.0E+20 ENDIF RETURN END C 6 ***** FUNCTION F6D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.34.) THEN YTK=G4D01(DBLE(P)*1D5) YRF=G12D01(YTK)*28.0134D-3 F6D01=REAL(G19D01(YRF,YTK)) ELSE F6D01=-1.0E+20 ENDIF RETURN END C 7 ***** FUNCTION F7D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YTK=G4D01(DBLE(P)*1D5) YRG=G11D01(YTK)*28.0134D-3 F7D01=REAL(G19D01(YRG,YTK)) ELSE F7D01=-1.0E+20 ENDIF RETURN END C 8 ***** FUNCTION F8D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D01 IF (G93D01(P,T).EQ.2) THEN IF (P.LE.1000.0) THEN TMIN=F69D01(P) IF (T.GE.TMIN.AND.T.LE.826.851) THEN YPP=DBLE(P)*1.0D+05 YTK=DBLE(T)+273.15D0 YROH=G8D01(YPP,YTK)*28.0134D-3 IF(YROH.GE.-1.0E8) THEN F8D01=REAL(G19D01(YROH,YTK)) ELSE F8D01=-1.0E+10 ENDIF RETURN ENDIF ENDIF ENDIF F8D01=-1.0E+20 RETURN END C 9 ***** FUNCTION F9D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.95) THEN YTK=DBLE(T)+273.15D0 YRF=G12D01(YTK)*28.0134D-3 F9D01=REAL(G19D01(YRF,YTK)) ELSE F9D01=-1.0E+20 ENDIF RETURN END C 10 ***** FUNCTION F10D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 YRG=G11D01(YTK)*28.0134D-3 F10D01=REAL(G19D01(YRG,YTK)) ELSE F10D01=-1.0E+20 ENDIF RETURN END C 11 ***** FUNCTION F11D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.34.) THEN YTK=G4D01(DBLE(P)*1D5) YRF=G12D01(YTK)*28.0134D-3 F11D01=REAL(G20D01(YRF,YTK)) ELSE F11D01=-1.0E+20 ENDIF RETURN END C 12 ***** FUNCTION F12D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YTK=G4D01(DBLE(P)*1D5) YRG=G11D01(YTK)*28.0134D-3 F12D01=REAL(G20D01(YRG,YTK)) ELSE F12D01=-1.0E+20 ENDIF RETURN END C 13 ***** FUNCTION F13D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.LT.0.1253.OR.P.GT.1000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F13D01=-1.0E+20 RETURN 20 YPP=DBLE(P)*1.0D+05 YTK=DBLE(T)+273.15D0 YROH=G8D01(YPP,YTK)*28.0134D-3 IF(YROH.GE.-1.0E8) THEN F13D01=REAL(G20D01(YROH,YTK)) ELSE F13D01=-1.0E+10 ENDIF RETURN END C 14 ***** FUNCTION F14D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.95) THEN YTK=DBLE(T)+273.15D0 YRF=G12D01(YTK)*28.0134D-3 F14D01=REAL(G20D01(YRF,YTK)) ELSE F14D01=-1.0E+20 ENDIF RETURN END C 15 ***** FUNCTION F15D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 YRG=G11D01(YTK)*28.0134D-3 F15D01=REAL(G20D01(YRG,YTK)) ELSE F15D01=-1.0E+20 ENDIF RETURN END C 16 ***** FUNCTION F16D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YTK=G4D01(DBLE(P)*1D5) YRF=G12D01(YTK) F16D01=G14D01(YRF,YTK)/28.0134E-3 ELSE F16D01=-1.0E+20 ENDIF RETURN END C 17 ***** FUNCTION F17D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YTK=G4D01(DBLE(P)*1D5) YRG=G11D01(YTK) F17D01=G14D01(YRG,YTK)/28.0134E-3 ELSE F17D01=-1.0E+20 ENDIF RETURN END C 18 ***** FUNCTION F18D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D01 IF (G93D01(P,T).EQ.2) THEN TMIN=F69D01(P) IF (T.GE.TMIN.AND.T.LE.826.851) THEN YPP=DBLE(P)*1.0D+05 YTK=DBLE(T)+273.15D0 YROH=G8D01(YPP,YTK) IF (YROH.GE.-1.0E8) THEN F18D01=G14D01(YROH,YTK)/28.0134E-3 ELSE F18D01=-1.0E+10 ENDIF RETURN ENDIF ENDIF F18D01=-1.0E+20 RETURN END C 19 ***** FUNCTION F19D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 YRF=G12D01(YTK) F19D01=G14D01(YRF,YTK)/28.0134E-3 ELSE F19D01=-1.0E+20 ENDIF RETURN END C 20 ***** FUNCTION F20D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 YRG=G11D01(YTK) F20D01=G14D01(YRG,YTK)/28.0134D-3 ELSE F20D01=-1.0E+20 ENDIF RETURN END C 21 ***** FUNCTION F21D01(C) CHARACTER C*1 IF(C.EQ.'P') THEN F21D01=34.000 ELSEIF(C.EQ.'T') THEN F21D01=126.20-273.15 ELSEIF(C.EQ.'V') THEN F21D01=1.0/314. ELSEIF(C.EQ.'H') THEN F21D01=(-7808.9+8669.)/28.0134E-3 ELSEIF(C.EQ.'S') THEN F21D01=(-73.10+191.502)/28.0134E-3 ELSE F21D01=-1.0E+20 ENDIF RETURN END C 22 ***** FUNCTION F22D01(P,T) IMPLICIT DOUBLE PRECISION (Y) DOUBLE PRECISION G8D01 IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.726.85) GO TO 20 10 F22D01=-1.0E+20 RETURN 20 YPP=DBLE(P)*1.0D+05 YTK=DBLE(T)+273.15D0 ROH=REAL(G8D01(YPP,YTK))*28.0134E-3 IF(ROH.GE.-1.0E8) THEN F22D01=G21D01(ROH) ELSE F22D01=-1.0E+10 ENDIF RETURN END C 23 ***** FUNCTION F23D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.34.) THEN YTK=G4D01(DBLE(P)*1D5) YRF=G12D01(YTK) F23D01=(G17D01(YRF,YTK)+8669D0)/28.0134E-3 ELSE F23D01=-1.0E+20 ENDIF RETURN END C 24 ***** FUNCTION F24D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YTK=G4D01(DBLE(P)*1D5) YRG=G11D01(YTK) F24D01=(G17D01(YRG,YTK)+8669D0)/28.0134E-3 ELSE F24D01=-1.0E+20 ENDIF RETURN END C 25 ***** FUNCTION F25D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F25D01=-1.0E+20 RETURN 20 YPP=DBLE(P)*1.0D+05 YTK=DBLE(T)+273.15D0 YROH=G8D01(YPP,YTK) IF(YROH.GE.-1.0E8) THEN F25D01=(G17D01(YROH,YTK)+8669D0)/28.0134E-3 ELSE F25D01=-1.0E+10 ENDIF RETURN END C 26 ***** FUNCTION F26D01(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(X.LT.0.0.OR.X.GT.1.0)GO TO 10 IF(P.GE.0.1253.AND.P.LE.33.98) GO TO 20 10 F26D01=-1.0E+20 RETURN 20 YTK=G4D01(DBLE(P)*1D5) YRF=G12D01(YTK) HF=(G17D01(YRF,YTK)+8669D0)/28.0134E-3 YRG=G11D01(YTK) HG=(G17D01(YRG,YTK)+8669D0)/28.0134E-3 F26D01=HF+X*(HG-HF) RETURN END C 27 ***** FUNCTION F27D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.95) THEN YTK=DBLE(T)+273.15D0 YRF=G12D01(YTK) F27D01=(G17D01(YRF,YTK)+8669D0)/28.0134E-3 ELSE F27D01=-1.0E+20 ENDIF RETURN END C 28 ***** FUNCTION F28D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 YRG=G11D01(YTK) F28D01=(G17D01(YRG,YTK)+8669D0)/28.0134E-3 ELSE F28D01=-1.0E+20 ENDIF RETURN END C 29 ***** FUNCTION F29D01(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 10 IF(T.GE.-210.002.AND.T.LE.-146.97) GO TO 20 10 F29D01=-1.0E+20 RETURN 20 YTK=DBLE(T)+273.15D0 YRF=G12D01(YTK) HF=(G17D01(YRF,YTK)+8669D0)/28.0134E-3 YRG=G11D01(YTK) HG=(G17D01(YRG,YTK)+8669D0)/28.0134E-3 F29D01=HF+X*(HG-HF) RETURN END C 30 ***** FUNCTION F30D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.95) GO TO 10 F30D01=-1.0E+20 RETURN 10 YTK=DBLE(T)+273.15D0 PS=G3D01(YTK) F30D01=PS*1.0D-5 RETURN END C 31 ***** FUNCTION F31D01(P) TK=F40D01(P)+273.15 IF (TK.GT.-1.0E+10) THEN F31D01=G22D01(TK) ELSE F31D01=-1.0E+20 ENDIF RETURN END C 32 ***** FUNCTION F32D01(T) IF(T.GE.-210.002.AND.T.LE.-146.95) THEN TK=T+273.15 F32D01=G22D01(TK) ELSE F32D01=-1.0E+20 ENDIF RETURN END C 33 ***** FUNCTION F33D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.34.) THEN YTK=G4D01(DBLE(P)*1D5) YRF=G12D01(YTK) F33D01=(G15D01(YRF,YTK)+191.502D0)/28.0134E-3 ELSE F33D01=-1.0E+20 ENDIF RETURN END C 34 ***** FUNCTION F34D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YTK=G4D01(DBLE(P)*1D5) YRG=G11D01(YTK) F34D01=(G15D01(YRG,YTK)+191.502D0)/28.0134E-3 ELSE F34D01=-1.0E+20 ENDIF RETURN END C 35 ***** FUNCTION F35D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F35D01=-1.0E+20 RETURN 20 YPP=DBLE(P)*1.0D+05 YTK=DBLE(T)+273.15D0 YROH=G8D01(YPP,YTK) IF(YROH.GE.-1.0E8) THEN F35D01=(G15D01(YROH,YTK)+191.502D0)/28.0134E-3 ELSE F35D01=-1.0E+10 ENDIF RETURN END C 36 ***** FUNCTION F36D01(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(X.LT.0.0.OR.X.GT.1.0)GO TO 10 IF(P.GE.0.1253.AND.P.LE.33.98) GO TO 20 10 F36D01=-1.0E+20 RETURN 20 YTK=G4D01(DBLE(P)*1D5) YRF=G12D01(YTK) SF=(G15D01(YRF,YTK)+191.502D0)/28.0134E-3 YRG=G11D01(YTK) SG=(G15D01(YRG,YTK)+191.502D0)/28.0134E-3 F36D01=SF+X*(SG-SF) RETURN END C 37 ***** FUNCTION F37D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.95) THEN YTK=DBLE(T)+273.15D0 YRF=G12D01(YTK) F37D01=(G15D01(YRF,YTK)+191.502D0)/28.0134E-3 ELSE F37D01=-1.0E+20 ENDIF RETURN END C 38 ***** FUNCTION F38D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 YRG=G11D01(YTK) F38D01=(G15D01(YRG,YTK)+191.502D0)/28.0134E-3 ELSE F38D01=-1.0E+20 ENDIF RETURN END C 39 ***** FUNCTION F39D01(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 10 IF(T.GE.-210.002.AND.T.LE.-146.97) GO TO 20 10 F39D01=-1.0E+20 RETURN 20 YTK=DBLE(T)+273.15D0 YRF=G12D01(YTK) SF=(G15D01(YRF,YTK)+191.502D0)/28.0134E-3 YTK=DBLE(T)+273.15D0 YRG=G11D01(YTK) SG=(G15D01(YRG,YTK)+191.502D0)/28.0134E-3 F39D01=SF+X*(SG-SF) RETURN END C 40 ***** FUNCTION F40D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.34.) THEN YPP=DBLE(P)*1.0D+5 F40D01=DBLE(G4D01(YPP))-273.15E0 ELSE F40D01=-1.0E+20 ENDIF RETURN END C 41 ***** FUNCTION F41D01(C) CHARACTER C*1 IF(C.EQ.'P') THEN F41D01=0.1253 ELSEIF(C.EQ.'T') THEN F41D01=63.148-273.15 ELSE F41D01=-1.0E20 ENDIF RETURN END C 42 ***** FUNCTION F42D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.34.) GO TO 10 F42D01=-1.0E+20 RETURN 10 YTK=G4D01(DBLE(P)*1D5) YRF=G12D01(YTK) F42D01=(G16D01(YRF,YTK)+8669D0)/28.0134D-3 RETURN END C 43 ***** FUNCTION F43D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) GO TO 10 F43D01=-1.0E+20 RETURN 10 YTK=G4D01(DBLE(P)*1D5) YRG=G11D01(YTK) F43D01=(G16D01(YRG,YTK)+8669D0)/28.0134E-3 RETURN END C 44 ***** FUNCTION F44D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F44D01=-1.0E+20 RETURN 20 YPP=DBLE(P)*1.0D+05 YTK=DBLE(T)+273.15D0 YROH=G8D01(YPP,YTK) IF(YROH.GE.-1.0E8) THEN F44D01=(G16D01(YROH,YTK)+8669D0)/28.0134E-3 ELSE F44D01=-1.0E+10 ENDIF RETURN END C 45 ***** FUNCTION F45D01(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(X.LT.0.0.OR.X.GT.1.0)GO TO 10 IF(P.GE.0.1253.AND.P.LE.33.98) GO TO 20 10 F45D01=-1.0E+20 RETURN 20 YTK=G4D01(DBLE(P)*1D5) YRF=G12D01(YTK) UF=(G16D01(YRF,YTK)+8669D0)/28.0134D-3 YRG=G11D01(YTK) UG=(G16D01(YRG,YTK)+8669D0)/28.0134E-3 F45D01=UF+X*(UG-UF) RETURN END C 46 ***** FUNCTION F46D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.95) GO TO 10 F46D01=-1.0E+20 RETURN 10 YTK=DBLE(T)+273.15D0 YRF=G12D01(YTK) F46D01=(G16D01(YRF,YTK)+8669D0)/28.0134E-3 RETURN END C 47 ***** FUNCTION F47D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) GO TO 10 F47D01=-1.0E+20 RETURN 10 YTK=DBLE(T)+273.15D0 YRG=G11D01(YTK) F47D01=(G16D01(YRG,YTK)+8669D0)/28.0134E-3 RETURN END C 48 ***** FUNCTION F48D01(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 10 IF(T.GE.-210.002.AND.T.LE.-146.97) GO TO 20 10 F48D01=-1.0E+20 RETURN 20 YTK=DBLE(T)+273.15D0 YRF=G12D01(YTK) UF=(G16D01(YRF,YTK)+8669D0)/28.0134E-3 YRG=G11D01(YTK) UG=(G16D01(YRG,YTK)+8669D0)/28.0134E-3 F48D01=UF+X*(UG-UF) RETURN END C 49 ***** FUNCTION F49D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.34.) THEN YTK=G4D01(DBLE(P)*1D5) F49D01=1.0/(G12D01(YTK)*28.0134E-3) ELSE F49D01=-1.0E+20 ENDIF RETURN END C 50 ***** FUNCTION F50D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YTK=G4D01(DBLE(P)*1D5) F50D01=1.0/(G11D01(YTK)*28.0134E-3) ELSE F50D01=-1.0E+20 ENDIF RETURN END C 51 ***** FUNCTION F51D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F51D01=-1.0E+20 RETURN 20 YPP=DBLE(P)*1.0D+5 YTK=DBLE(T)+273.15D0 ROH=REAL(G8D01(YPP,YTK)) IF (ROH.GE.-1.0E8) THEN F51D01=1.0/(ROH*28.0134E-3) ELSE F51D01=-1.0E+10 ENDIF RETURN END C 52 ***** FUNCTION F52D01(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(X.LT.0.0.OR.X.GT.1.0)GO TO 10 IF(P.GE.0.1253.AND.P.LE.33.98) GO TO 20 10 F52D01=-1.0E+20 RETURN 20 YTK=G4D01(DBLE(P)*1D5) VF=1.0/(G12D01(YTK)*28.0134E-3) VG=1.0/(G11D01(YTK)*28.0134E-3) F52D01=VF+X*(VG-VF) RETURN END C 53 ***** FUNCTION F53D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.95) THEN YTK=DBLE(T)+273.15D0 F53D01=1.0/(G12D01(YTK)*28.0134E-3) ELSE F53D01=-1.0E+20 ENDIF RETURN END C 54 ***** FUNCTION F54D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 F54D01=1.0/(G11D01(YTK)*28.0134E-3) ELSE F54D01=-1.0E+20 ENDIF RETURN END C 55 ***** FUNCTION F55D01(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 10 IF(T.GE.-210.002.AND.T.LE.-146.97) GO TO 20 10 F55D01=-1.0E+20 RETURN 20 YTK=DBLE(T)+273.15D0 VF=1.0/(G12D01(YTK)*28.0134E-3) VG=1.0/(G11D01(YTK)*28.0134E-3) F55D01=VF+X*(VG-VF) RETURN END C 56 ***** FUNCTION F56D01(P,H) IF(P.GE.0.1253.AND.P.LE.33.98) THEN HMIN=F23D01(P) HMAX=F24D01(P) IF(H.GE.HMIN.AND.H.LE.HMAX) THEN F56D01=(H-HMIN)/(HMAX-HMIN) RETURN ENDIF ENDIF F56D01=-1.0E+20 RETURN END C 57 ***** FUNCTION F57D01(P,S) IF(P.GE.0.1253.AND.P.LE.33.98) THEN SMIN=F33D01(P) SMAX=F34D01(P) IF(S.GE.SMIN.AND.S.LE.SMAX) THEN F57D01=(S-SMIN)/(SMAX-SMIN) RETURN ENDIF ENDIF F57D01=-1.0E+20 RETURN END C 58 ***** FUNCTION F58D01(P,U) IF(P.GE.0.1253.AND.P.LE.33.98) THEN UMIN=F42D01(P) UMAX=F43D01(P) IF(U.GE.UMIN.AND.U.LE.UMAX) THEN F58D01=(U-UMIN)/(UMAX-UMIN) RETURN ENDIF ENDIF F58D01=-1.0E+20 RETURN END C 59 ***** FUNCTION F59D01(P,V) IF(P.GE.0.1253.AND.P.LE.33.98) THEN VMIN=F49D01(P) VMAX=F50D01(P) IF(V.GE.VMIN.AND.V.LE.VMAX) THEN F59D01=(V-VMIN)/(VMAX-VMIN) RETURN ENDIF ENDIF F59D01=-1.0E+20 RETURN END C 60 ***** FUNCTION F60D01(T,H) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN HMIN=F27D01(T) HMAX=F28D01(T) IF(H.GE.HMIN.AND.H.LE.HMAX) THEN F60D01=(H-HMIN)/(HMAX-HMIN) RETURN ENDIF ENDIF F60D01=-1.0E+20 RETURN END C 61 ***** FUNCTION F61D01(T,S) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN SMIN=F37D01(T) SMAX=F38D01(T) IF(S.GE.SMIN.AND.S.LE.SMAX) THEN F61D01=(S-SMIN)/(SMAX-SMIN) RETURN ENDIF ENDIF F61D01=-1.0E+20 RETURN END C 62 ***** FUNCTION F62D01(T,U) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN UMIN=F46D01(T) UMAX=F47D01(T) IF(U.GE.UMIN.AND.U.LE.UMAX) THEN F62D01=(U-UMIN)/(UMAX-UMIN) RETURN ENDIF ENDIF F62D01=-1.0E+20 RETURN END C 63 ***** FUNCTION F63D01(T,V) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN VMIN=F53D01(T) VMAX=F54D01(T) IF(V.GE.VMIN.AND.V.LE.VMAX) THEN F63D01=(V-VMIN)/(VMAX-VMIN) RETURN ENDIF ENDIF F63D01=-1.0E+20 RETURN END C 64 ***** FUNCTION F64D01(P,H) DOUBLE PRECISION PP,HH,TT,RR,SS IF(P.LT.0.1253.OR.P.GT.10000.0) THEN F64D01=-1.0E+20 ELSE PP=DBLE(P)*1D5 HH=DBLE(H)*28.0134D-3-8669D0 CALL S4D01(PP,HH,TT,RR,SS) IF(TT.GE.-1D8) THEN F64D01=TT-273.15D0 ELSE F64D01=TT ENDIF ENDIF RETURN END C 65 ***** FUNCTION F65D01(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH IF(P.LT.0.1253.OR.P.GT.10000.0) THEN F65D01=-1.0E+20 ELSE PP=DBLE(P)*1D5 SS=DBLE(S)*28.0134D-3-191.502D0 CALL S3D01(PP,SS,TT,RR,HH) IF(TT.GE.-1D8) THEN F65D01=TT-273.15D0 ELSE F65D01=TT ENDIF ENDIF RETURN END C 68 ***** FUNCTION F68D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-73.149) THEN YTK=DBLE(T)+273.15D0 F68D01=G1D01(YTK)*1.0E-5 ELSE F68D01=-1.0E+20 ENDIF RETURN END C 69 ***** FUNCTION F69D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.10000.0) THEN YPP=DBLE(P)*1.0D+5 F69D01=G2D01(YPP)-273.15D0 ELSE F69D01=-1.0E+20 ENDIF RETURN END C 70 ***** FUNCTION F70D01(P,V) DOUBLE PRECISION PP,RR,G7D01 IF(P.LT.0.1253.OR.P.GT.10000.0) THEN F70D01=-1.0E+20 ELSE PP=DBLE(P)*1D5 RR=1D0/DBLE(V)/28.0134D-3 F70D01=G7D01(PP,RR)-273.15D0 ENDIF RETURN END C 71 ***** FUNCTION F71D01(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH IF(P.LT.0.1253.OR.P.GT.10000.0) THEN F71D01=-1.0E+20 ELSE PP=DBLE(P)*1D5 SS=DBLE(S)*28.0134D-3-191.502D0 CALL S3D01(PP,SS,TT,RR,HH) H=REAL(HH) IF(H.GE.-1E8) THEN F71D01=(H+8669E0)/28.0134E-3 ELSE F71D01=H ENDIF ENDIF RETURN END C 76 ***** FUNCTION F76D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YTK=G4D01(DBLE(P)*1D5) YRG=G11D01(YTK) F76D01=G13D01(YRG,YTK)/28.0134E-3 ELSE F76D01=-1.0E+20 ENDIF RETURN END C 77 ***** FUNCTION F77D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F77D01=-1.0E+20 RETURN 20 YPP=DBLE(P)*1.0D+05 YTK=DBLE(T)+273.15D0 YROH=G8D01(YPP,YTK) IF(YROH.GE.-1.0E8) THEN F77D01=G13D01(YROH,YTK)/28.0134E-3 ELSE F77D01=-1.0E+10 ENDIF RETURN END C 78 ***** FUNCTION F78D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 YRG=G11D01(YTK) F78D01=G13D01(YRG,YTK)/28.0134E-3 ELSE F78D01=-1.0E+20 ENDIF RETURN END C 79 ***** FUNCTION F79D01(P,S) IF(P.LT.0.1253.OR.P.GT.10000.) GO TO 10 T=F65D01(P,S) IF(T.GE.-1E8) THEN F79D01=F44D01(P,T) ELSE F79D01=T ENDIF RETURN 10 F79D01=-1.0E+20 RETURN END C 80 ***** FUNCTION F80D01(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH IF(P.LT.0.1253.OR.P.GT.10000.) GO TO 10 PP=DBLE(P)*1D5 SS=DBLE(S)*28.0134D-3-191.502D0 CALL S3D01(PP,SS,TT,RR,HH) R=REAL(RR) IF(R.GE.-1E8) THEN F80D01=1.0/(R*28.0134E-3) ELSE F80D01=R ENDIF RETURN 10 F80D01=-1.0E+20 RETURN END C 81 ***** FUNCTION F81D01(P,T) ALM=F8D01(P,T) IF (ALM.GT.-1.0E-08) THEN F81D01=F18D01(P,T)*F13D01(P,T)/F8D01(P,T) ELSE F81D01=ALM ENDIF RETURN END C 82 ***** FUNCTION F82D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F82D01=-1.0E20 RETURN 20 YPP=DBLE(P)*1.0D+5 YTK=DBLE(T)+273.15D0 YRO=G8D01(YPP,YTK) IF (YRO.GE.-1.0E8) THEN WPT=REAL(G23D01(YRO,YTK)) RO=REAL(YRO)*28.0134E-03 F82D01=WPT**2*RO/REAL(YPP) ELSE F82D01=-1.0E+10 ENDIF RETURN END C 83 ***** WPT FUNCTION F83D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F83D01=-1.0E20 RETURN 20 YPP=DBLE(P)*1.0D+5 YTK=DBLE(T)+273.15D0 YRO=G8D01(YPP,YTK) IF (YRO.GE.-1.0E8) THEN F83D01=REAL(G23D01(YRO,YTK)) ELSE F83D01=-1.0E+10 ENDIF RETURN END C 85 ***** PRPD(P) FUNCTION F85D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YPM=DBLE(P)*1.0D+05 YTK=G4D01(YPM) YRF=G12D01(YTK) YRK=YRF*28.0134D-3 CP=G14D01(YRF,YTK)/28.0134E-3 VISCOS=G20D01(YRK,YTK) CONDUC=G19D01(YRK,YTK) F85D01=CP*VISCOS/CONDUC ELSE F85D01=-1.0E+20 ENDIF RETURN END C 86 ***** PRPDD(P) FUNCTION F86D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YPM=DBLE(P)*1.0D+05 YTK=G4D01(YPM) YRG=G11D01(YTK) YRK=YRG*28.0134D-3 CP=G14D01(YRG,YTK)/28.0134E-3 VISCOS=G20D01(YRK,YTK) CONDUC=G19D01(YRK,YTK) F86D01=CP*VISCOS/CONDUC ELSE F86D01=-1.0E+20 ENDIF RETURN END C 87 ***** FUNCTION F87D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 YRF=G12D01(YTK) YRK=YRF*28.0134D-3 CP=G14D01(YRF,YTK)/28.0134E-3 VISCOS=G20D01(YRK,YTK) CONDUC=G19D01(YRK,YTK) F87D01=CP*VISCOS/CONDUC ELSE F87D01=-1.0E+20 ENDIF RETURN END C 88 ***** FUNCTION F88D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 YRG=G11D01(YTK) YRK=YRG*28.0134D-3 CP=G14D01(YRG,YTK)/28.0134E-3 VISCOS=G20D01(YRK,YTK) CONDUC=G19D01(YRK,YTK) F88D01=CP*VISCOS/CONDUC ELSE F88D01=-1.0E+20 ENDIF RETURN END C 90 ****** BSPT(P,T):(1/PA) FUNCTION F90D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F90D01=-1.0E+20 RETURN 20 YPP=DBLE(P)*1.0D+5 YTK=DBLE(T)+273.15D0 YRO=G8D01(YPP,YTK) IF (YRO.GE.-1.0D+08) THEN VV=1.0/(REAL(YRO)*28.0134E-3) WW=REAL(G23D01(YRO,YTK)) F90D01=VV/(WW*WW) ELSE F90D01=-1.0E+10 ENDIF RETURN END C 91 ***** BTPT(P,T):(1/PA) FUNCTION F91D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D01 IF (G93D01(P,T).EQ.2) THEN TMIN=F69D01(P) IF (T.GE.TMIN.AND.T.LE.826.851) THEN YPP=DBLE(P)*1.0D+5 YTK=DBLE(T)+273.15D0 YR=G8D01(YPP,YTK) IF (YR.GE.-1.0D+08) THEN DPDR=REAL(G9D01(YR,YTK)) F91D01=1.0E+00/(DPDR*REAL(YR)) ELSE F91D01=-1.0E+10 ENDIF RETURN ENDIF ENDIF F91D01=-1.0E+20 RETURN END C 92 ***** BPPT(P,T):(1/K) FUNCTION F92D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D01 IF (G93D01(P,T).EQ.2) THEN TMIN=F69D01(P) IF (T.GE.TMIN.AND.T.LE.826.851) THEN YPP=DBLE(P)*1.0D+5 YTK=DBLE(T)+273.15D0 YR=G8D01(YPP,YTK) IF (YR.GE.-1.0D+08) THEN DPDT=REAL(G10D01(YR,YTK)) DPDR=REAL(G9D01(YR,YTK)) F92D01=DPDT/(DPDR*REAL(YR)) ELSE F92D01=-1.0E+10 ENDIF RETURN ENDIF ENDIF F92D01=-1.0E+20 RETURN END C 93 ***** BVPT(P,T):(1/K) FUNCTION F93D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F93D01=-1.0E+20 RETURN 20 YPP=DBLE(P)*1.0D+5 YTK=DBLE(T)+273.15D0 YRO=G8D01(YPP,YTK) IF (YRO.GE.-1.0D+08) THEN DPDT=REAL(G10D01(YRO,YTK)) F93D01=DPDT/REAL(YPP) ELSE F93D01=-1.0E+10 ENDIF RETURN END C 94 ***** AJTPT(P,T):(K/PA) FUNCTION F94D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D01 IF(P.LT.0.1253.OR.P.GT.10000.0) GO TO 10 TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) GO TO 20 10 F94D01=-1.0E+20 RETURN 20 YPP=DBLE(P)*1.0D+5 YTK=DBLE(T)+273.15D0 YRO=G8D01(YPP,YTK) IF (YRO.GE.-1.0D+08) THEN DPDT=REAL(G10D01(YRO,YTK)) IF (G93D01(P,T).EQ.1) THEN F94D01=1.0E+00/DPDT ELSE DPDRO=REAL(G9D01(YRO,YTK)) CP=REAL(G14D01(YRO,YTK)) ROH=REAL(YRO) TK=REAL(YTK) F94D01=(DPDT/DPDRO*TK/ROH-1.0E+00)/ROH/CP ENDIF ELSE F94D01=-1.0E+10 ENDIF RETURN END C 95 ***** GAMPT FUNCTION F95D01(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D01 IF (G93D01(P,T).EQ.2) THEN TMIN=F69D01(P) IF(T.GE.TMIN.AND.T.LE.826.851) THEN YPP=DBLE(P)*1.0D+05 YTK=DBLE(T)+273.15D0 YRO=G8D01(YPP,YTK) IF(YRO.GE.-1.0E8) THEN F95D01=REAL(G14D01(YRO,YTK)/G13D01(YRO,YTK)) ELSE F95D01=-1.0E+10 ENDIF RETURN ENDIF ENDIF F95D01=-1.0E+20 RETURN END C 96 ***** GAMPDD FUNCTION F96D01(P) IMPLICIT DOUBLE PRECISION (G,Y) IF(P.GE.0.1253.AND.P.LE.33.98) THEN YTK=G4D01(DBLE(P)*1D5) YRG=G11D01(YTK) F96D01=REAL(G14D01(YRG,YTK)/G13D01(YRG,YTK)) ELSE F96D01=-1.0E+20 ENDIF RETURN END C 97 ***** GAMTDD FUNCTION F97D01(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.GE.-210.002.AND.T.LE.-146.97) THEN YTK=DBLE(T)+273.15D0 YRG=G11D01(YTK) F97D01=REAL(G14D01(YRG,YTK)/G13D01(YRG,YTK)) ELSE F97D01=-1.0E+20 ENDIF RETURN END C*** F98D01 REAL FUNCTION F98D01(P) DIMENSION T(2),C(2),TL(3),TR(3),CL(3),CR(3) TTM=F69D01(P) P1=F21D01('P') PP=ABS((P-P1)/P1) T1=F21D01('T') IF (PP.LT.1.0D-5) THEN F98D01=T1 RETURN ENDIF IF (P.LT.P1.OR.P.GT.1000.001D00) THEN F98D01=-1.0E+20 RETURN ENDIF T2=0.85*T1 P2=F30D01(T2) TM0=T1+(T1-T2)*(P-P1)/(P1-P2) C-----TM0 KINJICHI TC=T1 T(1)=TM0 DEL=T1*0.01D00 IF(P.GT.3000.) T(1)=-100. IF(P.GT.7000.) T(1)=-10. 150 EPS=1.0D-7 IREP=0 IREM=10000 KCONT=0 ICONT=0 C(1)=F18D01(P,T(1)) T(2)=T(1)-DEL C(2)=F18D01(P,T(2)) 1000 RINC=C(2)-C(1) IF(RINC.GT.0.0)THEN GOTO 1500 ELSE T(2)=T(1) C(2)=C(1) T(1)=T(1)-DEL C(1)=F18D01(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=-F18D01(P,TT) 3000 CONV=DABS(DBLE((CC-C(2))/CC)) IF(CONV.LT.EPS) THEN F98D01=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=-F18D01(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=F18D01(P,TA) CB=F18D01(P,TB) 6050 KCONT=KCONT+1 IF (KCONT.GT.IREM) GO TO 8000 DELT=DABS(DBLE((TA-TB)/TA)) IF (DELT.LT.EPS) GO TO 7000 CC=F18D01(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)=F18D01(P,TL(2)) CR(2)=F18D01(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=F18D01(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=F18D01(P,TB) ELSE TB=TR(MR+1) CB=CR(MR+1) ENDIF 6135 TC=TR(MR) CC=CR(MR) ENDIF GO TO 6050 7000 F98D01=TC RETURN 8000 F98D01=-1.0E+10 RETURN END C G1 ******** G1D01(T:K) PMLT:(PA) ******** FUNCTION G1D01(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A1,A2,A3,A4,A5/-22.207134D0,114.63633D0,-155.53829D0, & 95.230366D0,-21.764068D0/ TT=63.148D0 PT=0.01253D6 TM=T/TT-1D0 IF(DABS(TM).LT.0.5D-5) TM=0D0 S=A1*TM**1D-1+A2*TM**2D-1+A3*TM**3D-1 S=S+A4*TM**4D-1+A5*TM**5D-1 G1D01=DEXP(S)*PT RETURN END C C G2 ******** G2D01(P:PA) TMLP:(K) ******** FUNCTION G2D01(P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF(P .LT. 0.014D6) THEN G2D01=63.148D0 RETURN ENDIF ILOOP=0 EPS=1D-7 TMAX=200D0 TMIN=63.148D0 TA=TMIN TB=TMAX PA=G1D01(TA) PB=G1D01(TB) 10 ILOOP=ILOOP+1 IF(ILOOP.GT.10000) GO TO 888 TM=TA+(TB-TA)/2D0 PM=G1D01(TM) DA=P-PA DB=P-PB DM=P-PM IF(DABS(DM/P).LT.EPS) GO TO 30 IF(DM*DA.LT.0D0) THEN TB=TM PB=PM ELSE IF(DM*DB.LT.0D0) THEN TA=TM PA=TM ELSE TB=TM PB=PM END IF GO TO 10 30 G2D01=TM RETURN 888 G2D01=-1.0E+10 RETURN END C G3 ******** G3D01(T:K) PST:(PA) ******** FUNCTION G3D01(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA B1,B2,B3,B4/-6.111020D0,1.218911D0,-0.693658D0,-1.898934D0/ DATA TC,PC/126.2D+00,3.40D+06/ IF(T.GE.TC) GO TO 10 TH=1D0-T/TC F=TC/T*(B1*TH+B2*TH**1.5D0+B3*TH**2.5D0+B4*TH**5D0) G3D01=DEXP(F)*PC RETURN 10 G3D01=PC RETURN END C G4 ******** G4D01(P:PA) TSP:(K) ******** FUNCTION G4D01(P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF(P.GE.3.4D6) GO TO 40 ILOOP=0 EPS=1D-7 TMAX=126.2D0 TMIN=63.148D0 TA=TMIN TB=TMAX PA=G3D01(TA) PB=G3D01(TB) 10 ILOOP=ILOOP+1 IF(ILOOP.GT.10000) GO TO 888 TM=TA+(TB-TA)/2D0 PM=G3D01(TM) DA=P-PA DB=P-PB DM=P-PM IF(DABS(DM/P).LT.EPS) GO TO 30 IF(DM*DA.LT.0D0) THEN TB=TM PB=PM ELSE IF(DM*DB.LT.0D0) THEN TA=TM PA=PM ELSE TB=TM PB=TM END IF GO TO 10 30 G4D01=TM RETURN 40 G4D01=126.2D0 RETURN 888 G4D01=-1.0E+10 RETURN END C G5 ******** G5D01(T:K) PPST:(PA) ******** FUNCTION G5D01(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) GC=8.31434D0 RC=0.01121D6 RG=G11D01(T) CALL S2D01(RG,T,SU) SUG=SU RL=G12D01(T) CALL S2D01(RL,T,SU) SUL=SU IF((RG.EQ.RC).AND.(RL.EQ.RC)) GO TO 10 G5D01=(RL*RG/(RG-RL))*GC*T*(DLOG(RG/RL)+(SUG-SUL)) RETURN 10 G5D01=3.4D6 RETURN END C C G6 ******** G6D01(R:MOL/M**3,T:K) PRT:(PA) ******** FUNCTION G6D01(R,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09,C10,C11, & C12,C13,C14,C15,C16,C17,C18,C19,C20,C21,C22, & C23,C24,C25,C26,C27,C28,C29,C30,C31,C32/ & +0.185927462121D00,+0.130155934655D01,-0.264054394027D01, & +0.292709245322D00,-0.287482987766D00,+0.161225592835D00, & -0.135129830972D00,+0.137262707287D-4,+0.136860808703D02, & +0.128973300860D-2,+0.315240491447D00,-0.548670430729D00, & +0.744966916902D-1,-0.151712926147D00,-0.728119881405D00, & +0.112790673192D00,-0.187922799332D-1,+0.460360632178D-1, & -0.251321896106D-2,-0.125428246147D02,-0.722843603762D00, & -0.907779852949D01,+0.333590008958D00,-0.210175282124D01, & -0.244752749620D00,-0.611651799016D00,-0.244254052253D-1, & -0.230295508018D-1,+0.157620487302D-1,-0.126428070667D-1, & -0.146576723582D-2,+0.915063203408D-4/ DATA GC,TC,RC/8.31434D0,126.2D0,0.01121D6/ AL=-0.70371896D0 W=R/RC W2=W*W W3=W2*W W4=W3*W W5=W4*W W6=W5*W W7=W6*W W8=W7*W W10=W8*W2 W12=W10*W2 TA=TC/T TA2=TA*TA TA3=TA2*TA TA4=TA3*TA TA5=TA4*TA E=DEXP(AL*W2) SX=C01*W+C02*W*TA**5D-1+C03*W*TA+C04*W*TA2+C05*W*TA3 SX=SX+C06*W2+C07*W2*TA+C08*W2*TA2+C09*W2*TA3+C10*W3 SX=SX+C11*W3*TA+C12*W3*TA2+C13*W4*TA+C14*W5*TA2 SX=SX+C15*W5*TA3+C16*W6*TA2+C17*W7*TA2+C18*W7*TA3 SX=SX+C19*W8*TA3+C20*W2*TA3*E+C21*W2*TA4*E+C22*W4*TA3*E SX=SX+C23*W4*TA5*E+C24*W6*TA3*E+C25*W6*TA4*E+C26*W8*TA3*E SX=SX+C27*W8*TA5*E+C28*W10*TA3*E+C29*W10*TA4*E SX=SX+C30*W12*TA3*E+C31*W12*TA4*E+C32*W12*TA5*E G6D01=R*GC*T*(1D0+SX) RETURN END C C G7 ******** G7D01(P:PA,R:MOL/M**3) TPR:(K) ******** FUNCTION G7D01(P,R) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA TKCR,PCR,RCR/126.2D+00,3.40D+06,0.01121D6/ DP=DABS(1.0D+00-P/PCR) IF (DP.LE.1.0D-05) THEN DR=DABS(1.0D+00-R/RCR) IF(DR.LE.1.0D-05) THEN G7D01=TKCR RETURN ENDIF ENDIF ILOOP=0 TMIN=G2D01(P) TMAX=1101D0 RMAX=G8D01(P,TMAX) RMIN=G8D01(P,TMIN) IF (R.LT.RMAX .OR. R.GT.RMIN) GOTO 999 IF ( P.LT.0.01253D6 .OR. P.GT.3.4D6) GOTO 5 TS=G4D01(P) RG=G11D01(TS) RL=G12D01(TS) IF (R.GT.RL) THEN TA=TS TB=TMIN ELSEIF (R.GE.RG) THEN G7D01=TS RETURN ELSE TA=TMAX TB=TS ENDIF GOTO 8 5 TA=TMAX TB=TMIN 8 RA=G8D01(P,TA) RB=G8D01(P,TB) 10 DRA=R-RA DRB=R-RB TC=TB+(TA-TB)*.5 RC=G8D01(P,TC) DRC=R-RC IF (DRA*DRC.LE.0.0 .AND. DRB*DRC.GT.0.0) THEN TB=TC RB=RC ELSEIF (DRA*DRC.GT.0.0 .AND. DRB*DRC.LE.0.0) THEN TA=TC RA=RC ELSE GOTO 777 ENDIF 777 ILOOP=ILOOP+1 IF (ILOOP.GT.10000) GOTO 888 IF (DABS(TA-TB)/TB.GT.1D-7) GOTO 10 G7D01=TC RETURN 888 G7D01=-1.0E+10 RETURN 999 G7D01=-1.0E+20 RETURN END C G8 ******** G8D01(P:PA,T:K) RPT:(MOL/M**3) ******** FUNCTION G8D01(P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCR,TKCR,RCR/34.0D+05,126.2D+00,0.01121D6/ DP=DABS(1.0D+00-P/PCR) IF (DP.LE.1.0D-05) THEN DT=ABS(1.0D+00-T/TKCR) IF(DT.LE.1.0D-05) THEN G8D01=RCR RETURN ENDIF ENDIF EPS=1D-7 IF(T.GT.126D0) THEN RMIN=0.0001D0 RMAX=50D3 ELSE PS=G5D01(T) IF(P.LE.PS) THEN C *** SUPERHEATED VAPOR *** RMIN=1D-3 RMAX=RCR ELSE C *** COMPRESSED LIQUID *** RMIN=RCR RMAX=50D3 ENDIF ENDIF CALL S1D01(RMIN,RMAX,EPS,P,T,R) G8D01=R RETURN END C G9 ******** G9D01(R:MOL/M**3,T:K) DPDR:(PA/(MOL/M**3)) ******** FUNCTION G9D01(R,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09,C10,C11, & C12,C13,C14,C15,C16,C17,C18,C19,C20,C21,C22, & C23,C24,C25,C26,C27,C28,C29,C30,C31,C32/ & +0.185927462121D00,+0.130155934655D01,-0.264054394027D01, & +0.292709245322D00,-0.287482987766D00,+0.161225592835D00, & -0.135129830972D00,+0.137262707287D-4,+0.136860808703D02, & +0.128973300860D-2,+0.315240491447D00,-0.548670430729D00, & +0.744966916902D-1,-0.151712926147D00,-0.728119881405D00, & +0.112790673192D00,-0.187922799332D-1,+0.460360632178D-1, & -0.251321896106D-2,-0.125428246147D02,-0.722843603762D00, & -0.907779852949D01,+0.333590008958D00,-0.210175282124D01, & -0.244752749620D00,-0.611651799016D00,-0.244254052253D-1, & -0.230295508018D-1,+0.157620487302D-1,-0.126428070667D-1, & -0.146576723582D-2,+0.915063203408D-4/ DATA GC,TC,RC/8.31434D0,126.2D0,0.01121D6/ AL=-0.70371896D0 W=R/RC W2=W*W W3=W2*W W4=W3*W W5=W4*W W6=W5*W W7=W6*W W8=W7*W W10=W8*W2 W12=W10*W2 TA=TC/T TA2=TA*TA TA3=TA2*TA TA4=TA3*TA TA5=TA4*TA E=DEXP(AL*W2) EE=E/2D0/AL A1=1D0 A2=W2-A1/AL A3=W4-2D0*A2/AL A4=W6-3D0*A3/AL A5=W8-4D0*A4/AL A6=W10-5D0*A5/AL A=2D0*AL*W2 SR=C01*2D0*W+C02*2D0*W*TA**5D-1+C03*2D0*W*TA+C04*2D0*W*TA2 SR=SR+C05*2D0*W*TA3+C06*3D0*W2+C07*3D0*W2*TA+C08*3D0*W2*TA2 SR=SR+C09*3D0*W2*TA3+C10*4D0*W3+C11*4D0*W3*TA+C12*4D0*W3*TA2 SR=SR+C13*5D0*W4*TA+C14*6D0*W5*TA2+C15*6D0*W5*TA3 SR=SR+C16*7D0*W6*TA2+C17*8D0*W7*TA2+C18*8D0*W7*TA3 SR=SR+C19*9D0*W8*TA3+C20*(3D0+A)*W2*TA3*E SR=SR+C21*(3D0+A)*W2*TA4*E+C22*(5D0+A)*W4*TA3*E SR=SR+C23*(5D0+A)*W4*TA5*E+C24*(7D0+A)*W6*TA3*E SR=SR+C25*(7D0+A)*W6*TA4*E+C26*(9D0+A)*W8*TA3*E SR=SR+C27*(9D0+A)*W8*TA5*E+C28*(11D0+A)*W10*TA3*E SR=SR+C29*(11D0+A)*W10*TA4*E+C30*(13D0+A)*W12*TA3*E SR=SR+C31*(13D0+A)*W12*TA4*E+C32*(13D0+A)*W12*TA5*E G9D01=GC*T*(1D0+SR) RETURN END C C G10 ******** G10D01(R:MOL/M**3,T:K) DPDT:(PA/K) ******** FUNCTION G10D01(R,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09,C10,C11, & C12,C13,C14,C15,C16,C17,C18,C19,C20,C21,C22, & C23,C24,C25,C26,C27,C28,C29,C30,C31,C32/ & +0.185927462121D00,+0.130155934655D01,-0.264054394027D01, & +0.292709245322D00,-0.287482987766D00,+0.161225592835D00, & -0.135129830972D00,+0.137262707287D-4,+0.136860808703D02, & +0.128973300860D-2,+0.315240491447D00,-0.548670430729D00, & +0.744966916902D-1,-0.151712926147D00,-0.728119881405D00, & +0.112790673192D00,-0.187922799332D-1,+0.460360632178D-1, & -0.251321896106D-2,-0.125428246147D02,-0.722843603762D00, & -0.907779852949D01,+0.333590008958D00,-0.210175282124D01, & -0.244752749620D00,-0.611651799016D00,-0.244254052253D-1, & -0.230295508018D-1,+0.157620487302D-1,-0.126428070667D-1, & -0.146576723582D-2,+0.915063203408D-4/ DATA GC,TC,RC/8.31434D0,126.2D0,0.01121D6/ AL=-0.70371896D0 W=R/RC W2=W*W W3=W2*W W4=W3*W W5=W4*W W6=W5*W W7=W6*W W8=W7*W W10=W8*W2 W12=W10*W2 TA=TC/T TA2=TA*TA TA3=TA2*TA TA4=TA3*TA TA5=TA4*TA E=DEXP(AL*W2) ST=C01*W+C02*W*TA**5D-1/2D0+C03*0D0-C04*W*TA2 ST=ST-C05*2D0*W*TA3+C06*W2+C07*0D0-C08*W2*TA2 ST=ST-C09*2D0*W2*TA3+C10*W3+C11*0D0-C12*W3*TA2 ST=ST+C13*0D0-C14*W5*TA2-C15*2D0*W5*TA3 ST=ST-C16*W6*TA2-C17*W7*TA2-C18*2D0*W7*TA3 ST=ST-C19*2D0*W8*TA3-C20*2D0*W2*TA3*E ST=ST-C21*3D0*W2*TA4*E-C22*2D0*W4*TA3*E ST=ST-C23*4D0*W4*TA5*E-C24*2D0*W6*TA3*E ST=ST-C25*3D0*W6*TA4*E-C26*2D0*W8*TA3*E ST=ST-C27*4D0*W8*TA5*E-C28*2D0*W10*TA3*E ST=ST-C29*3D0*W10*TA4*E-C30*2D0*W12*TA3*E ST=ST-C31*3D0*W12*TA4*E-C32*4D0*W12*TA5*E G10D01=GC*R*(1D0+ST) RETURN END C C G11 ******** G11D01(T:K) RGT:(MOL/M**3) ******** FUNCTION G11D01(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) RC=0.01121D6 TC=126.2D0 ILOOP=0 JLOOP=0 IF(T.GE.TC) GO TO 40 P=G3D01(T) RMIN=1D0 RMAX=RC IF(T.GT.100D0) GO TO 60 C ***** NEWTON ***** R1=RMIN EPS1=1D-7 10 ILOOP=ILOOP+1 IF(ILOOP.GT.10000) GO TO 888 R2=R1+(P-G6D01(R1,T))/G9D01(R1,T) IF(DABS((R2-R1)/R2).LT.EPS1) GO TO 30 R1=R2 GO TO 10 30 G11D01=R2 RETURN 40 G11D01=RC RETURN C ***** NIBUN ***** 60 RA=RMIN RB=RMAX PA=G6D01(RA,T) PB=G6D01(RB,T) EPS2=1D-5 70 JLOOP=JLOOP+1 IF(JLOOP.GT.10000) GO TO 888 RM=RA+(RB-RA)/2D0 PM=G6D01(RM,T) DA=P-PA DB=P-PB DM=P-PM IF(DABS(DM/P).LT.EPS2) GO TO 80 IF(DM*DA.LT.0D0) THEN RB=RM PB=PM ELSE IF(DM*DB.LT.0D0) THEN RA=RM PA=PM ELSE IF((PM.GT.PB).AND.(PM.GT.PA).AND.(PB.GT.PA)) THEN RA=RM PA=PM ELSE IF((PM.GT.PB).AND.(PM.GT.PA).AND.(PB.LT.PA)) THEN RB=RM PB=PM ELSE RA=RM PA=PM END IF GO TO 70 80 G11D01=RM RETURN 888 G11D01=-1.0E+10 RETURN END C C G12 ******** G12D01(T:K) RLT:(MOL/M**3) ******** FUNCTION G12D01(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) RC=0.01121D6 TC=126.2D0 ILOOP=0 IF(T.GE.TC) GO TO 60 P=G3D01(T) EPS=1D-7 RMAX=3D4 RMIN=RC IF(T.GT.85D0) GO TO 50 C ***** NEWTON ***** R1=RMAX 10 ILOOP=ILOOP+1 IF(ILOOP.GT.10000) GO TO 888 R2=R1+(P-G6D01(R1,T))/G9D01(R1,T) IF(DABS((R2-R1)/R2).LT.EPS) GO TO 30 R1=R2 GO TO 10 30 G12D01=R2 RETURN C ***** NIBUN ***** 50 CALL S1D01(RMIN,RMAX,EPS,P,T,R) G12D01=R RETURN 60 G12D01=RC RETURN 888 G12D01=-1.0E+10 RETURN END C C G13 ******** G13D01(R:MOL/M**3,T:K) CVRT:(J/K/MOL) ******** FUNCTION G13D01(R,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09,C10,C11, & C12,C13,C14,C15,C16,C17,C18,C19,C20,C21,C22, & C23,C24,C25,C26,C27,C28,C29,C30,C31,C32/ & +0.185927462121D00,+0.130155934655D01,-0.264054394027D01, & +0.292709245322D00,-0.287482987766D00,+0.161225592835D00, & -0.135129830972D00,+0.137262707287D-4,+0.136860808703D02, & +0.128973300860D-2,+0.315240491447D00,-0.548670430729D00, & +0.744966916902D-1,-0.151712926147D00,-0.728119881405D00, & +0.112790673192D00,-0.187922799332D-1,+0.460360632178D-1, & -0.251321896106D-2,-0.125428246147D02,-0.722843603762D00, & -0.907779852949D01,+0.333590008958D00,-0.210175282124D01, & -0.244752749620D00,-0.611651799016D00,-0.244254052253D-1, & -0.230295508018D-1,+0.157620487302D-1,-0.126428070667D-1, & -0.146576723582D-2,+0.915063203408D-4/ DATA F1,F2,F3,F4,F5,F6,F7,F8,F9/ & -0.837079888737D+03,+0.379147114487D+02, & -0.601737844275D+00,+0.350418363823D+01, & -0.874955653028D-05,+0.148968607239D-07, & -0.256370354277D-11,+0.100773735767D+01, & +0.335340610D+04/ DATA GC,TC,RC/8.31434D0,126.2D0,0.01121D6/ AL=-0.70371896D0 W=R/RC W2=W*W W3=W2*W W4=W3*W W5=W4*W W6=W5*W W7=W6*W W8=W7*W W10=W8*W2 W12=W10*W2 TA=TC/T TA2=TA*TA TA3=TA2*TA TA4=TA3*TA TA5=TA4*TA E=DEXP(AL*W2) EE=E/2D0/AL E0=5D-1/AL A1=1D0 A2=W2-A1/AL A3=W4-2D0*A2/AL A4=W6-3D0*A3/AL A5=W8-4D0*A4/AL A6=W10-5D0*A5/AL A10=1D0 A20=-A10/AL A30=-2D0*A20/AL A40=-3D0*A30/AL A50=-4D0*A40/AL A60=-5D0*A50/AL SC=C01*0D0-C02*W*TA**5D-1/4D0+C03*0D0+C04*2D0*W*TA2+C05*6D0*W*TA3 SC=SC+C06*0D0+C07*0D0+C08*W2*TA2+C09*3D0*W2*TA3+C10*0D0 SC=SC+C11*0D0+C12*2D0*W3*TA2/3D0+C13*0D0+C14*2D0*W5*TA2/5D0 SC=SC+C15*6D0*W5*TA3/5D0+C16*W6*TA2/3D0+C17*2D0*W7*TA2/7D0 SC=SC+C18*6D0*W7*TA3/7D0+C19*3D0*W8*TA3/4D0+C20*6D0*A1*TA3*EE SC=SC+C21*12D0*A1*TA4*EE+C22*6D0*A2*TA3*EE SC=SC+C23*20D0*A2*TA5*EE+C24*6D0*A3*TA3*EE SC=SC+C25*12D0*A3*TA4*EE+C26*6D0*A4*TA3*EE SC=SC+C27*20D0*A4*TA5*EE+C28*6D0*A5*TA3*EE SC=SC+C29*12D0*A5*TA4*EE+C30*6D0*A6*TA3*EE SC=SC+C31*12D0*A6*TA4*EE+C32*20D0*A6*TA5*EE SC0=C20*6D0*A10*TA3*E0 SC0=SC0+C21*12D0*A10*TA4*E0+C22*6D0*A20*TA3*E0 SC0=SC0+C23*20D0*A20*TA5*E0+C24*6D0*A30*TA3*E0 SC0=SC0+C25*12D0*A30*TA4*E0+C26*6D0*A40*TA3*E0 SC0=SC0+C27*20D0*A40*TA5*E0+C28*6D0*A50*TA3*E0 SC0=SC0+C29*12D0*A50*TA4*E0+C30*6D0*A60*TA3*E0 SC0=SC0+C31*12D0*A60*TA4*E0+C32*20D0*A60*TA5*E0 U=F9/T CPID=(F1/T/T/T+F2/T/T+F3/T+F4+F5*T+F6*T*T+F7*T*T*T & +F8*U*U*DEXP(U)/((DEXP(U)-1D0)*(DEXP(U)-1D0)))*GC G13D01=CPID-GC-GC*(SC-SC0) RETURN END C C G14 ******** G14D01(R:MOL/M**3,T:K) CPRT:(J/K/MOL) ******** FUNCTION G14D01(R,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) PDT=G10D01(R,T) G14D01=G13D01(R,T)+T*PDT*PDT/R/R/G9D01(R,T) RETURN END C C G15 ******** G15D01(R:MOL/M**3,T:K) SRT:(J/K/MOL) ******** FUNCTION G15D01(R,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09,C10,C11, & C12,C13,C14,C15,C16,C17,C18,C19,C20,C21,C22, & C23,C24,C25,C26,C27,C28,C29,C30,C31,C32/ & +0.185927462121D00,+0.130155934655D01,-0.264054394027D01, & +0.292709245322D00,-0.287482987766D00,+0.161225592835D00, & -0.135129830972D00,+0.137262707287D-4,+0.136860808703D02, & +0.128973300860D-2,+0.315240491447D00,-0.548670430729D00, & +0.744966916902D-1,-0.151712926147D00,-0.728119881405D00, & +0.112790673192D00,-0.187922799332D-1,+0.460360632178D-1, & -0.251321896106D-2,-0.125428246147D02,-0.722843603762D00, & -0.907779852949D01,+0.333590008958D00,-0.210175282124D01, & -0.244752749620D00,-0.611651799016D00,-0.244254052253D-1, & -0.230295508018D-1,+0.157620487302D-1,-0.126428070667D-1, & -0.146576723582D-2,+0.915063203408D-4/ DATA F1,F2,F3,F4,F5,F6,F7,F8,F9/ & -0.837079888737D+03,+0.379147114487D+02, & -0.601737844275D+00,+0.350418363823D+01, & -0.874955653028D-05,+0.148968607239D-07, & -0.256370354277D-11,+0.100773735767D+01, & +0.335340610D+04/ DATA GC,TC,RC/8.31434D0,126.2D0,0.01121D6/ AL=-0.70371896D0 W=R/RC W2=W*W W3=W2*W W4=W3*W W5=W4*W W6=W5*W W7=W6*W W8=W7*W W10=W8*W2 W12=W10*W2 TA=TC/T TA2=TA*TA TA3=TA2*TA TA4=TA3*TA TA5=TA4*TA E=DEXP(AL*W2) EE=E/2D0/AL E0=5D-1/AL A1=1D0 A2=W2-A1/AL A3=W4-2D0*A2/AL A4=W6-3D0*A3/AL A5=W8-4D0*A4/AL A6=W10-5D0*A5/AL A10=1D0 A20=-A10/AL A30=-2D0*A20/AL A40=-3D0*A30/AL A50=-4D0*A40/AL A60=-5D0*A50/AL SS=C01*W+C02*W*TA**5D-1/2D0+C03*0D0-C04*W*TA2-C05*2D0*W*TA3 SS=SS+C06*W2/2D0+C07*0D0-C08*W2*TA2/2D0-C09*W2*TA3+C10*W3/3D0 SS=SS+C11*0D0-C12*W3*TA2/3D0+C13*0D0-C14*W5*TA2/5D0 SS=SS-C15*2D0*W5*TA3/5D0-C16*W6*TA2/6D0-C17*W7*TA2/7D0 SS=SS-C18*2D0*W7*TA3/7D0-C19*W8*TA3/4D0-C20*2D0*A1*TA3*EE SS=SS-C21*3D0*A1*TA4*EE-C22*2D0*A2*TA3*EE SS=SS-C23*4D0*A2*TA5*EE-C24*2D0*A3*TA3*EE SS=SS-C25*3D0*A3*TA4*EE-C26*2D0*A4*TA3*EE SS=SS-C27*4D0*A4*TA5*EE-C28*2D0*A5*TA3*EE SS=SS-C29*3D0*A5*TA4*EE-C30*2D0*A6*TA3*EE SS=SS-C31*3D0*A6*TA4*EE-C32*4D0*A6*TA5*EE SS0=-C20*2D0*A10*TA3*E0 SS0=SS0-C21*3D0*A10*TA4*E0-C22*2D0*A20*TA3*E0 SS0=SS0-C23*4D0*A20*TA5*E0-C24*2D0*A30*TA3*E0 SS0=SS0-C25*3D0*A30*TA4*E0-C26*2D0*A40*TA3*E0 SS0=SS0-C27*4D0*A40*TA5*E0-C28*2D0*A50*TA3*E0 SS0=SS0-C29*3D0*A50*TA4*E0-C30*2D0*A60*TA3*E0 SS0=SS0-C31*3D0*A60*TA4*E0-C32*4D0*A60*TA5*E0 S1=-GC*(SS-SS0) U=F9/T SID=-F1/T/T/T/3D0-F2/T/T/2D0-F3/T+F4*DLOG(T) & +F5*T+F6*T*T/2D0+F7*T*T*T/3D0 & +F8*(U*DEXP(U)/(DEXP(U)-1D0)-DLOG(DEXP(U)-1D0)) TI=298.15D0 UI=F9/TI SIDI=-F1/TI/TI/TI/3D0-F2/TI/TI/2D0-F3/TI+F4*DLOG(TI) & +F5*TI+F6*TI*TI/2D0+F7*TI*TI*TI/3D0 & +F8*(UI*DEXP(UI)/(DEXP(UI)-1D0)-DLOG(DEXP(UI)-1D0)) SIDT=(SID-SIDI)*GC PA=0.101325D6 G15D01=SIDT-GC*DLOG(R*GC*T/PA)+S1 RETURN END C C G16 ******** G16D01(R:MOL/M**3,T:K) URT:(J/MOL) ******** FUNCTION G16D01(R,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09,C10,C11, & C12,C13,C14,C15,C16,C17,C18,C19,C20,C21,C22, & C23,C24,C25,C26,C27,C28,C29,C30,C31,C32/ & +0.185927462121D00,+0.130155934655D01,-0.264054394027D01, & +0.292709245322D00,-0.287482987766D00,+0.161225592835D00, & -0.135129830972D00,+0.137262707287D-4,+0.136860808703D02, & +0.128973300860D-2,+0.315240491447D00,-0.548670430729D00, & +0.744966916902D-1,-0.151712926147D00,-0.728119881405D00, & +0.112790673192D00,-0.187922799332D-1,+0.460360632178D-1, & -0.251321896106D-2,-0.125428246147D02,-0.722843603762D00, & -0.907779852949D01,+0.333590008958D00,-0.210175282124D01, & -0.244752749620D00,-0.611651799016D00,-0.244254052253D-1, & -0.230295508018D-1,+0.157620487302D-1,-0.126428070667D-1, & -0.146576723582D-2,+0.915063203408D-4/ DATA F1,F2,F3,F4,F5,F6,F7,F8,F9/ & -0.837079888737D+03,+0.379147114487D+02, & -0.601737844275D+00,+0.350418363823D+01, & -0.874955653028D-05,+0.148968607239D-07, & -0.256370354277D-11,+0.100773735767D+01, & +0.335340610D+04/ DATA GC,TC,RC/8.31434D0,126.2D0,0.01121D6/ AL=-0.70371896D0 W=R/RC W2=W*W W3=W2*W W4=W3*W W5=W4*W W6=W5*W W7=W6*W W8=W7*W W10=W8*W2 W12=W10*W2 TA=TC/T TA2=TA*TA TA3=TA2*TA TA4=TA3*TA TA5=TA4*TA E=DEXP(AL*W2) EE=E/2D0/AL E0=5D-1/AL A1=1D0 A2=W2-A1/AL A3=W4-2D0*A2/AL A4=W6-3D0*A3/AL A5=W8-4D0*A4/AL A6=W10-5D0*A5/AL A10=1D0 A20=-A10/AL A30=-2D0*A20/AL A40=-3D0*A30/AL A50=-4D0*A40/AL A60=-5D0*A50/AL SS=C01*W+C02*W*TA**5D-1/2D0+C03*0D0 SS=SS-C04*W*TA2-C05*2D0*W*TA3 SS=SS+C06*W2/2D0+C07*0D0-C08*W2*TA2/2D0 SS=SS-C09*W2*TA3+C10*W3/3D0+C11*0D0 SS=SS+C11*0D0-C12*W3*TA2/3D0+C13*0D0-C14*W5*TA2/5D0 SS=SS-C15*2D0*W5*TA3/5D0-C16*W6*TA2/6D0 SS=SS-C17*W7*TA2/7D0-C18*2D0*W7*TA3/7D0 SS=SS-C19*W8*TA3/4D0-C20*2D0*A1*TA3*EE SS=SS-C21*3D0*A1*TA4*EE-C22*2D0*A2*TA3*EE SS=SS-C23*4D0*A2*TA5*EE-C24*2D0*A3*TA3*EE SS=SS-C25*3D0*A3*TA4*EE-C26*2D0*A4*TA3*EE SS=SS-C27*4D0*A4*TA5*EE-C28*2D0*A5*TA3*EE SS=SS-C29*3D0*A5*TA4*EE-C30*2D0*A6*TA3*EE SS=SS-C31*3D0*A6*TA4*EE-C32*4D0*A6*TA5*EE SS0=-C20*2D0*A10*TA3*E0 SS0=SS0-C21*3D0*A10*TA4*E0-C22*2D0*A20*TA3*E0 SS0=SS0-C23*4D0*A20*TA5*E0-C24*2D0*A30*TA3*E0 SS0=SS0-C25*3D0*A30*TA4*E0-C26*2D0*A40*TA3*E0 SS0=SS0-C27*4D0*A40*TA5*E0-C28*2D0*A50*TA3*E0 SS0=SS0-C29*3D0*A50*TA4*E0-C30*2D0*A60*TA3*E0 SS0=SS0-C31*3D0*A60*TA4*E0-C32*4D0*A60*TA5*E0 SU=C01*W+C02*W*TA**5D-1+C03*W*TA+C04*W*TA2 SU=SU+C05*W*TA3+C06*W2/2D0+C07*W2*TA/2D0 SU=SU+C08*W2*TA2/2D0+C09*W2*TA3/2D0+C10*W3/3D0 SU=SU+C11*W3*TA/3D0+C12*W3*TA2/3D0 SU=SU+C13*W4*TA/4D0+C14*W5*TA2/5D0 SU=SU+C15*W5*TA3/5D0+C16*W6*TA2/6D0 SU=SU+C17*W7*TA2/7D0+C18*W7*TA3/7D0 SU=SU+C19*W8*TA3/8D0+C20*A1*TA3*EE SU=SU+C21*A1*TA4*EE+C22*A2*TA3*EE SU=SU+C23*A2*TA5*EE+C24*A3*TA3*EE SU=SU+C25*A3*TA4*EE+C26*A4*TA3*EE SU=SU+C27*A4*TA5*EE+C28*A5*TA3*EE SU=SU+C29*A5*TA4*EE+C30*A6*TA3*EE SU=SU+C31*A6*TA4*EE+C32*A6*TA5*EE SU0=C20*A10*TA3*E0 SU0=SU0+C21*A10*TA4*E0+C22*A20*TA3*E0 SU0=SU0+C23*A20*TA5*E0+C24*A30*TA3*E0 SU0=SU0+C25*A30*TA4*E0+C26*A40*TA3*E0 SU0=SU0+C27*A40*TA5*E0+C28*A50*TA3*E0 SU0=SU0+C29*A50*TA4*E0+C30*A60*TA3*E0 SU0=SU0+C31*A60*TA4*E0+C32*A60*TA5*E0 U1=GC*T*(SU-SU0-SS+SS0) U=F9/T UID=-F1/T/T/2D0-F2/T+F3*DLOG(T)+F4*T+F5*T*T/2D0 & +F6*T*T*T/3D0+F7*T*T*T*T/4D0+F8*F9/(DEXP(U)-1D0) TI=298.15D0 UI=F9/TI UIDI=-F1/TI/TI/2D0-F2/TI+F3*DLOG(TI)+F4*TI+F5*TI*TI/2D0 & +F6*TI*TI*TI/3D0+F7*TI*TI*TI*TI/4D0+F8*F9/(DEXP(UI)-1D0) UIDT=(UID-UIDI-T)*GC G16D01=UIDT+U1 RETURN END C C G17 ******** G17D01(R:MOL/M**3,T:K) HRT:(J/MOL) ******** FUNCTION G17D01(R,T) IMPLICIT DOUBLE PRECISION (G,R,T) G17D01=G16D01(R,T)+G6D01(R,T)/R RETURN END C C G18 ******** G18D01(T:K) HEAT:(J/MOL) ******** FUNCTION G18D01(T) IMPLICIT DOUBLE PRECISION (G,H,R,T) RG=G11D01(T) RL=G12D01(T) HG=G17D01(RG,T) HL=G17D01(RL,T) G18D01=HG-HL RETURN END C C G19 ****** THERMAL CONDUCTIVITY:(W/M/K) ***** C ********************************************* C ** CON:MILLIWATT/(M*K) R:KG/M**3 T:K ** C ********************************************* FUNCTION G19D01(RO,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DOUBLE PRECISION M DATA M,BOL,AVO/28.013D0, 1.38062D-23, 6.02213D26/ DATA X1,X2 /0.95185202D0, 1.0205422D0/ DATA C1,C2,C3,C4/3.3373542D0, 0.37098251D0, & 0.89913456D0, 0.16972505D0/ DATA RC,CONC/314D0, 4.17D0/ DATA F1,F2,F3,F4,F5,F6,F7,F8,F9 & /-0.837079888737D+03, 0.379147114487D+02, & -0.601737844275D+00, 0.350418363823D+01, & -0.874955653028D-05, 0.148968607239D-07, & -0.256370354277D-11, 0.100773735767D+01, & 0.335340610D+04/ C DATA A0,A1,A2,A3,A4 &/ 0.46649D0,-0.57015D0, 0.19164D0,-0.03708D0, 0.00241D0/ DATA C,EBK,SIG/2.0442D-49, 1.0001654D+02, 0.36502496D-9/ C TST=DLOG(TK/EBK) OME=A0+(A1+(A2+(A3+A4*TST)*TST)*TST)*TST VIS0TK=1.0D+06*5D0/16D0*DSQRT(C*TK)/SIG/SIG/DEXP(OME) C GC=8.31434D0 FAC=BOL*AVO*VIS0TK/(M*1D3) CONTR=2.5D0*FAC*(1.5D0-X1) C SUM1=F4+(F3+(F2+F1/TK)/TK)/TK+(F5+(F6+F7*TK)*TK)*TK U=F9/TK EU1=DEXP(U)-1D0 SUM2=F8*U*U*(EU1+1D0)/EU1/EU1 CV0TK=GC*(SUM1+SUM2-1D0) C CONIN=FAC*X2*(CV0TK*1D3/BOL/AVO+X1) CON0=CONTR+CONIN R=RO/RC CONR=CONC*(C1+(C2+(C3+C4*R)*R)*R)*R CON=CON0+CONR G19D01=1.0D-03*CON RETURN END C C G20 ******** VISCOSITY:(N*S/M**2) ******** C ******************************************** C ** VIS:MICROPASCAL*S RO:KG/M**3 TK:K ** C ******************************************** FUNCTION G20D01(RO,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C1,C2,C3,C4,C5 /-20.099970D+00, 3.4376416D+00, & -1.4470051D+00,-0.27766561D-01,-0.21662362D+00/ DATA RC,VISC/314D+00, 14D+00/ C DATA A0,A1,A2,A3,A4 &/ 0.46649D0,-0.57015D0, 0.19164D0,-0.03708D0, 0.00241D0/ DATA C,EBK,SIG/2.0442D-49, 1.0001654D+02, 0.36502496D-9/ C TST=DLOG(TK/EBK) OME=A0+(A1+(A2+(A3+A4*TST)*TST)*TST)*TST VIS0TK=1.0D+06*5D0/16D0*DSQRT(C*TK)/SIG/SIG/DEXP(OME) C R=RO/RC DVISR=C1/(R-C2)+C1/C2+(C3+(C4+C5*R)*R)*R VISR=VISC*DVISR VIS=VIS0TK+VISR G20D01=1.0D-06*VIS RETURN END C C G21 ******** G21D01(ROH:KG/M**3) DIELECTRIC CONSTANT ******** FUNCTION G21D01(ROH) ROHM=ROH*1.0E-03/28.0134E+00 P=4.389+(2.2-114.0*ROHM)*ROHM G21D01=(1.0E+00+2*P*ROHM)/(1.0E+00-P*ROHM) RETURN END C C G22 ******** G22D01(T:K) SURFACE TENTION:(N/M) ******** FUNCTION G22D01(T) DT=1.0-T/126.2 IF (DT.GT.1E-5) THEN G22D01=29.7074E-03*DT**1.27135 ELSE G22D01=0.0E+00 ENDIF RETURN END C C G23 ******** G23D01(YR:MOL/M**3,YT:K) SPEED OF SOUND:(M/S) ** FUNCTION G23D01(YR,YT) IMPLICIT DOUBLE PRECISION (G,Y) DATA YM/28.0134D-03/ YDPDT=G10D01(YR,YT) YWW=G9D01(YR,YT)+YT*(YDPDT/YR)**2/G13D01(YR,YT) G23D01=DSQRT(YWW/YM) RETURN END C C S1 ******** S1D01 NB ( NIBUN - HOU ) ******** SUBROUTINE S1D01(RMIN,RMAX,EPS,P,T,R) IMPLICIT DOUBLE PRECISION (A-H,O-Z) ILOOP=0 RA=RMIN RB=RMAX PA=G6D01(RA,T) PB=G6D01(RB,T) 10 ILOOP=ILOOP+1 IF(ILOOP.GT.10000) GO TO 888 RM=RA+(RB-RA)/2D0 PM=G6D01(RM,T) DA=P-PA DB=P-PB DM=P-PM IF(DABS(DM/P).LT.EPS) GO TO 40 IF(DM*DA.LT.0D0) THEN RB=RM PB=PM ELSE IF(DM*DB.LT.0D0) THEN RA=RM PA=PM ELSE RB=RM PB=PM END IF GO TO 10 40 R=RM RETURN 888 R=-1.0E+10 RETURN END C C S2 ******** S2D01 XU ( N(I)*XU(I) ) ********* SUBROUTINE S2D01(R,T,SU) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09,C10,C11, & C12,C13,C14,C15,C16,C17,C18,C19,C20,C21,C22, & C23,C24,C25,C26,C27,C28,C29,C30,C31,C32/ & +0.185927462121D00,+0.130155934655D01,-0.264054394027D01, & +0.292709245322D00,-0.287482987766D00,+0.161225592835D00, & -0.135129830972D00,+0.137262707287D-4,+0.136860808703D02, & +0.128973300860D-2,+0.315240491447D00,-0.548670430729D00, & +0.744966916902D-1,-0.151712926147D00,-0.728119881405D00, & +0.112790673192D00,-0.187922799332D-1,+0.460360632178D-1, & -0.251321896106D-2,-0.125428246147D02,-0.722843603762D00, & -0.907779852949D01,+0.333590008958D00,-0.210175282124D01, & -0.244752749620D00,-0.611651799016D00,-0.244254052253D-1, & -0.230295508018D-1,+0.157620487302D-1,-0.126428070667D-1, & -0.146576723582D-2,+0.915063203408D-4/ DATA GC,TC,RC/8.31434D0,126.2D0,0.01121D6/ AL=-0.70371896D0 W=R/RC W2=W*W W3=W2*W W4=W3*W W5=W4*W W6=W5*W W7=W6*W W8=W7*W W10=W8*W2 W12=W10*W2 TA=TC/T TA2=TA*TA TA3=TA2*TA TA4=TA3*TA TA5=TA4*TA E=DEXP(AL*W2) EE=E/2D0/AL A1=1D0 A2=W2-A1/AL A3=W4-2D0*A2/AL A4=W6-3D0*A3/AL A5=W8-4D0*A4/AL A6=W10-5D0*A5/AL SU=C01*W+C02*W*TA**5D-1+C03*W*TA+C04*W*TA2 SU=SU+C05*W*TA3+C06*W2/2D0+C07*W2*TA/2D0 SU=SU+C08*W2*TA2/2D0+C09*W2*TA3/2D0+C10*W3/3D0 SU=SU+C11*W3*TA/3D0+C12*W3*TA2/3D0 SU=SU+C13*W4*TA/4D0+C14*W5*TA2/5D0 SU=SU+C15*W5*TA3/5D0+C16*W6*TA2/6D0 SU=SU+C17*W7*TA2/7D0+C18*W7*TA3/7D0 SU=SU+C19*W8*TA3/8D0+C20*A1*TA3*EE SU=SU+C21*A1*TA4*EE+C22*A2*TA3*EE SU=SU+C23*A2*TA5*EE+C24*A3*TA3*EE SU=SU+C25*A3*TA4*EE+C26*A4*TA3*EE SU=SU+C27*A4*TA5*EE+C28*A5*TA3*EE SU=SU+C29*A5*TA4*EE+C30*A6*TA3*EE SU=SU+C31*A6*TA4*EE+C32*A6*TA5*EE RETURN END C C S3 **** S3D01 ( P:PA, S:J/K/MOL --- T:K, R:MOL/M**3, H:J/MOL ) **** SUBROUTINE S3D01(P,S,T,R,H) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCR,TKCR,RCR/3.40D+06,126.20D+00,11.21D+03/ DP=DABS(1.0D+00-P/PCR) IF (DP.LE.1.0D-05) THEN SCR=G15D01(RCR,TKCR) DS=DABS(1.0D+00-S/SCR) IF(DS.LE.1.0D-05) THEN T=TKCR R=RCR H=G17D01(RCR,TKCR) RETURN ENDIF ENDIF ILOOP=0 TMIN=G2D01(P) TMAX=1101D0 RMAX=G8D01(P,TMAX) RMIN=G8D01(P,TMIN) SMAX=G15D01(RMAX,TMAX) SMIN=G15D01(RMIN,TMIN) IF (S.LT.SMIN .OR. S.GT.SMAX) GOTO 999 IF ( P.LT.0.01253D6 .OR. P.GT.3.4D6) GOTO 5 TS=G4D01(P) RG=G11D01(TS) RL=G12D01(TS) SG=G15D01(RG,TS) SL=G15D01(RL,TS) IF (S.LT.SL) THEN TA=TS TB=TMIN ELSEIF (S.LE.SG) THEN VL=1/RL VG=1/RG X=(S-SL)/(SG-SL) V=VL+X*(S-SL)/(SG-SL) HL=G17D01(RL,TS) HG=G17D01(RG,TS) H=HL+X*(HG-HL) T=TS R=1/V RETURN ELSE TA=TMAX TB=TS ENDIF GOTO 8 5 TA=TMAX TB=TMIN 8 RA=G8D01(P,TA) RB=G8D01(P,TB) SA=G15D01(RA,TA) SB=G15D01(RB,TB) 10 DSA=S-SA DSB=S-SB DSAB=SA-SB TC=TB+(TA-TB)*.5 RC=G8D01(P,TC) SC=G15D01(RC,TC) 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 ELSE GOTO 777 ENDIF 777 ILOOP=ILOOP+1 IF (ILOOP.GT.10000) GOTO 888 IF (DABS(TA-TB)/TB.GT.1D-7) GOTO 10 T=TC R=RC H=G17D01(R,T) RETURN 888 T=-1.0E+10 R=-1.0E+10 H=-1.0E+10 RETURN 999 T=-1.0E+20 R=-1.0E+20 H=-1.0E+20 RETURN END C C S4 **** S4D01 ( P:PA, H:J/MOL --- T:K, R:MOL/M**3, S:J/K/MOL ) **** SUBROUTINE S4D01(P,H,T,R,S) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCR,TKCR,RCR/3.40D+06,126.20D+00,11.21D+03/ DP=DABS(1.0D+00-P/PCR) IF (DP.LE.1.0D-05) THEN HCR=G17D01(RCR,TKCR) DH=DABS(1.0D+00-H/HCR) IF(DH.LE.1.0D-05) THEN T=TKCR R=RCR S=G15D01(RCR,TKCR) RETURN ENDIF ENDIF ILOOP=0 TMIN=G2D01(P) TMAX=1101D0 RMAX=G8D01(P,TMAX) RMIN=G8D01(P,TMIN) HMAX=G17D01(RMAX,TMAX) HMIN=G17D01(RMIN,TMIN) IF (H.LT.HMIN .OR. H.GT.HMAX) GOTO 999 IF ( P.LT.0.01253D6 .OR. P.GT.3.4D6) GOTO 5 TS=G4D01(P) RG=G11D01(TS) RL=G12D01(TS) HG=G17D01(RG,TS) HL=G17D01(RL,TS) IF (H.LT.HL) THEN TA=TS TB=TMIN ELSEIF (H.LE.HG) THEN VL=1/RL VG=1/RG X=(H-HL)/(HG-HL) V=VL+X*(VG-VL) SL=G15D01(RL,TS) SG=G15D01(RG,TS) S=SL+X*(SG-SL) T=TS R=1/V RETURN ELSE TA=TMAX TB=TS ENDIF GOTO 8 5 TA=TMAX TB=TMIN 8 RA=G8D01(P,TA) RB=G8D01(P,TB) HA=G17D01(RA,TA) HB=G17D01(RB,TB) 10 DHA=H-HA DHB=H-HB DHAB=HA-HB TC=TB+(TA-TB)*.5 RC=G8D01(P,TC) HC=G17D01(RC,TC) 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 ELSE GOTO 777 ENDIF 777 ILOOP=ILOOP+1 IF (ILOOP.GT.10000) GOTO 888 IF (DABS(TA-TB)/TB.GT.1D-7) GOTO 10 T=TC R=RC S=G15D01(R,T) RETURN 888 T=-1.0E+10 R=-1.0E+10 S=-1.0E+10 RETURN 999 T=-1.0E+20 R=-1.0E+20 S=-1.0E+20 RETURN END C G93 FUNC(P,T) TYPE *** CRITICAL POINT CHECK ROUTINE *** FUNCTION G93D01(P,T) INTEGER G93D01 DATA PCR,TKCR/34.0,126.2/ DP=ABS(1.0E+00-P/PCR) IF (DP.LE.1.0E-05) THEN DT=ABS(1.0E+00-(T+273.15E+00)/TKCR) IF(DT.LE.1.0E-05) THEN G93D01=1 RETURN ENDIF ENDIF IF (P.LT.0.1253) THEN G93D01=3 ELSEIF (P.GT.10000.0) THEN G93D01=3 ELSE G93D01=2 ENDIF 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