C ****************************************** C * PROPATH VER. 7.1 * C * FOR PROPANE VER. 1.1 * C * * C * SUPERVISOR [D06SVP.FOR VER. 1.1] * C * CODED BY * C * TOMOHIRO HONDA * C * FUKUOKA UNIVERSITY * C * FUKUOKA 814-01, JAPAN * C * AUGUST 1988 * 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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(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 S99D06(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99D06(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'AJTPT'/ C--- SET OF UNIT - PI=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL - FF = F94D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL -- FF = F82D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F2D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F3D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F4D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F5D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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 DATA FUN/'ALMPD'/ CALL S99D06(FUN) ALMPD=-1.0E+30 RETURN END C------------------------------------------------- F7 = ALMPDD REAL FUNCTION ALMPDD(P) CHARACTER FUN*6 DATA FUN/'ALMPDD'/ CALL S99D06(FUN) ALMPDD=-1.0E+30 RETURN END C------------------------------------------------- F8 = ALMPT REAL FUNCTION ALMPT(P,T) CHARACTER FUN*6 DATA FUN/'ALMPT'/ CALL S99D06(FUN) ALMPT=-1.0E+30 RETURN END C------------------------------------------------- F9 = ALMTD REAL FUNCTION ALMTD(T) CHARACTER FUN*6 DATA FUN/'ALMTD'/ CALL S99D06(FUN) ALMTD=-1.0E+30 RETURN END C------------------------------------------------- F10 = ALMTDD REAL FUNCTION ALMTDD(T) CHARACTER FUN*6 DATA FUN/'ALMTDD'/ CALL S99D06(FUN) ALMTDD=-1.0E+30 RETURN END C------------------------------------------------- F11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FUN*6 DATA FUN/'AMUPD'/ CALL S99D06(FUN) AMUPD=-1.0E+30 RETURN END C------------------------------------------------- F12 = AMUPDD REAL FUNCTION AMUPDD(P) CHARACTER FUN*6 DATA FUN/'AMUPDD'/ CALL S99D06(FUN) AMUPDD=-1.0E+30 RETURN END C------------------------------------------------- F13 = AMUPT REAL FUNCTION AMUPT(P,T) CHARACTER FUN*6 DATA FUN/'AMUPT'/ CALL S99D06(FUN) AMUPT=-1.0E+30 RETURN END C------------------------------------------------- F14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FUN*6 DATA FUN/'AMUTD'/ CALL S99D06(FUN) AMUTD=-1.0E+30 RETURN END C------------------------------------------------- F15 = AMUTDD REAL FUNCTION AMUTDD(T) CHARACTER FUN*6 DATA FUN/'AMUTDD'/ CALL S99D06(FUN) AMUTDD=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BSPT'/ C--- SET OF UNIT - PI=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL - FF = F90D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BSPT=FF RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BTPT'/ C--- SET OF UNIT - PI=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL - FF = F91D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BTPT=FF RETURN END C------------------------------------------------- F92 = BPPT FUNCTION BPPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BPPT'/ C--- SET OF UNIT - PI=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL - FF = F92D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - BPPT=FF RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'BVPT'/ C--- SET OF UNIT - PI=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL - FF = F93D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F16D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F17D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL -- FF = F18D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F19D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F20D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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 = F21D06(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 ', & ' PROPANE WHEN A=',A,' ****') C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ELSEIF (A.EQ.'T') THEN T0K=-G99D06(0.0) FF=FF+T0K ELSEIF (A.EQ.'P') THEN PBAR=G98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F76D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL -- FF = F77D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F78D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVTDD=FF RETURN END C------------------------------------------------- F22 = EPSPT REAL FUNCTION EPSPT(P,T) CHARACTER FUN*6 DATA FUN/'EPSPT'/ CALL S99D06(FUN) EPSPT=-1.0E+30 RETURN END C------------------------------------------------- F89 = FC C************************************************ C FUNCTION FOR FUNDDAMENTAL CONSTANTS C PROPATH VER.7.1, MAY 8, 1990 C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='44.097' WHEN A='M' C B='188.546' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=44.097 ELSE IF (A.EQ.'R') THEN FC=188.546 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR PROPANE WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C-------------------------------------------------- F96 = GAMPDD FUNCTION GAMPDD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME - DATA FUN/'GAMPDD'/ C--- SET OF UNIT - PI=G98D06(P) C--- FUNCTION CALL - FF = F96D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPDD=FF RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME - DATA FUN/'GAMPT'/ C--- SET OF UNIT - PI=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL - FF = F95D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPT=FF RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME - DATA FUN/'GAMTDD'/ C--- SET OF UNIT - TI=G99D06(T) C--- FUNCTION CALL - FF = F97D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F23D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F24D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F71D06(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL -- FF = F25D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F26D06(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F27D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F28D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F29D06(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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='PROPANE' WHEN A='S' C B='C3H8' 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='PROPANE' ELSE IF (A.EQ.'C') THEN IDENTF='C3H8' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR PROPANE 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 S99D06(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT FUNCTION PMLT(T) CHARACTER FUN*6 DATA FUN/'PMLT'/ CALL S99D06(FUN) PMLT=-1.0E+30 RETURN END C------------------------------------------------- F85 = PRPD FUNCTION PRPD(P) CHARACTER FUN*6 DATA FUN/'PRPD'/ CALL S99D06(FUN) PRPD=-1.0E+30 RETURN END C------------------------------------------------- F86 = PRPDD FUNCTION PRPDD(P) CHARACTER FUN*6 DATA FUN/'PRPDD'/ CALL S99D06(FUN) PRPDD=-1.0E+30 RETURN END C------------------------------------------------- F81 = PRPT FUNCTION PRPT(P,T) CHARACTER FUN*6 DATA FUN/'PRPT'/ CALL S99D06(FUN) PRPT=-1.0E+30 RETURN END C------------------------------------------------- F87 = PRTD FUNCTION PRTD(T) CHARACTER FUN*6 DATA FUN/'PRTD'/ CALL S99D06(FUN) PRTD=-1.0E+30 RETURN END C------------------------------------------------- F88 = PRTDD FUNCTION PRTDD(T) CHARACTER FUN*6 DATA FUN/'PRTDD'/ CALL S99D06(FUN) PRTDD=-1.0E+30 RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F30D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) PBAR=1.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(2,T,T,'T','T',FUN) PBAR=1.0E+00 ELSE PBAR=G98D06(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 S99D06(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F31D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSEIF (FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F32D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF (FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSEIF (FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F33D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F34D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL -- FF = F35D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F36D06(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F37D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F38D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F39D06(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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 S99D06(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP FUNCTION TMLP(P) CHARACTER FUN*6 DATA FUN/'TMLP'/ CALL S99D06(FUN) TMLP=-1.0E+30 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=G98D06(P) C--- FUNCTION CALL -- FF = F64D06(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) T0K=0.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(3,P,H,'P','H',FUN) T0K=0.0E+00 ELSE T0K=-G99D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F65D06(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) T0K=0.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(3,P,S,'P','S',FUN) T0K=0.0E+00 ELSE T0K=-G99D06(T) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPS=FF+T0K RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'TPSEUP'/ C--- SET OF UNIT -- PI=G98D06(P) C--- FUNCTION CALL -- FF = F98D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) T0K=0.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(1,P,P,'P','P',FUN) T0K=0.0E+00 ELSE T0K=-G99D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F70D06(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) T0K=0.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(3,P,V,'P','V',FUN) T0K=0.0E+00 ELSE T0K=-G99D06(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 A*1 CHARACTER FUN*6 DATA FUN/'TRPL'/ CALL S99D06(FUN) TRPL=-1.0E+30 RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F40D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) T0K=0.0E+00 C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(1,P,P,'P','P',FUN) T0K=0.0E+00 ELSE T0K=-G99D06(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 S99D06(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F42D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F43D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F79D06(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL -- FF = F44D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F45D06(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F46D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F47D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F48D06(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F49D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F50D06(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F80D06(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL -- FF = F51D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F52D06(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F53D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F54D06(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F55D06(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) TI=G99D06(T) C--- FUNCTION CALL -- FF = F83D06(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F56D06(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F57D06(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F58D06(PI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G98D06(P) C--- FUNCTION CALL -- FF = F59D06(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F60D06(TI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F61D06(TI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F62D06(TI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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=G99D06(T) C--- FUNCTION CALL -- FF = F63D06(TI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D06(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D06(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 G98D06(P) REAL P,G98D06 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 G98D06=REAL(DBLE(P)*PBAR) RETURN END C G99 *** FUNCTION G99D06(T) REAL T,G99D06 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 G99D06=REAL(DBLE(T)-T0K) RETURN END C ******* SUBROUTINE FOR ERROR MESSAGE ******* C *** LEVEL 1 ERROR MESSAGE -- SUBROUTINE S97D06(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR PROPANE ****' WRITE(6,*) MSG ENDIF RETURN END C *** LEVEL 2 ERROR MESSAGE -- SUBROUTINE S98D06(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 PROPANE', & ' 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 PROPANE', & ' 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 PROPANE', & ' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') ENDIF ENDIF RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99D06(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR PROPANE ****' WRITE(6,100) MSG 100 FORMAT(1H ,5X,A) ENDIF RETURN END C **************************************** C * C3H8 F--D06 FUNCTIONS * C * * C * UNIT NAME [D06FUN.FOR VER.1.1 ] * C * * C * CODED BY * C * TOMOHIRO HONDA * C * FUKUOKA UNIVERSITY * C * FUKUOKA 814-01, JAPAN * C * AUGUST 1988 * C **************************************** C F02 + LAPLACE COEFFICIENT AT P FUNCTION F2D06(P) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 F2D06=G30D06(P,2) RETURN 999 F2D06=-1.0E+20 RETURN END C F03 + LAPLACE COEFFICIENT AT T FUNCTION F3D06(T) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 F3D06=G30D06(T,1) RETURN 999 F3D06=-1.0E+20 RETURN END C F04 + LATENT HEAT OF VAPORIZATION AT P FUNCTION F4D06(P) IMPLICIT DOUBLE PRECISION (G,H,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,YRL,YRG) HL=G15D06(YRL,YTS,YP) HG=G15D06(YRG,YTS,YP) F4D06=REAL(HG-HL) RETURN 999 F4D06=-1.0E+20 RETURN END C F05 + LATENT HEAT OF VAPORIZATION AT T FUNCTION F5D06(T) IMPLICIT DOUBLE PRECISION (G,H,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,YRL,YRG) HL=G15D06(YRL,YT,YPS) HG=G15D06(YRG,YT,YPS) F5D06=REAL(HG-HL) RETURN 999 F5D06=-1.0E+20 RETURN END C F16 + CP OF SATURATED LIQUID AT P FUNCTION F16D06(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,YRL,YRG) F16D06=REAL(G17D06(YRL,YTS)) RETURN 999 F16D06=-1.0E+20 RETURN END C F17 + CP OF SATURATED VAPOUR AT P FUNCTION F17D06(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,YRL,YRG) F17D06=REAL(G17D06(YRG,YTS)) RETURN 999 F17D06=-1.0E+20 RETURN END C F18 + CP AT P AND T FUNCTION F18D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F18D06=REAL(G17D06(YR,YT)) RETURN ENDIF ENDIF F18D06=-1.0E+20 RETURN END C F19 + CP OF SATURATED LIQUID AT T FUNCTION F19D06(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,YRL,YRG) F19D06=REAL(G17D06(YRL,YT)) RETURN 999 F19D06=-1.0E+20 RETURN END C F20 + CP OF SATURATED VAPOUR AT T FUNCTION F20D06(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,YRL,YRG) F20D06=REAL(G17D06(YRG,YT)) RETURN 999 F20D06=-1.0E+20 RETURN END C F21 + CRITICAL POINT FUNCTION F21D06(A) CHARACTER*1 A IF (A.EQ.'H') THEN F21D06=-491.10E+03 ELSEIF (A.EQ.'P') THEN F21D06=42.597 ELSEIF (A.EQ.'S') THEN F21D06=-4.0931E+03 ELSEIF (A.EQ.'T') THEN F21D06=96.75 ELSEIF (A.EQ.'V') THEN F21D06=1E0/220 ELSE F21D06=-1.0E+20 ENDIF RETURN END C F23 + H OF SATURATED LIQUID AT P FUNCTION F23D06(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,YRL,YRG) F23D06=REAL(G15D06(YRL,YTS,YP)) RETURN 999 F23D06=-1.0E+20 RETURN END C F24 + H OF SATURATED VAPOUR AT P FUNCTION F24D06(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,YRL,YRG) F24D06=REAL(G15D06(YRG,YTS,YP)) RETURN 999 F24D06=-1.0E+20 RETURN END C F25 + H AT P AND T FUNCTION F25D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F25D06=REAL(G15D06(YR,YT,YP)) RETURN ENDIF ENDIF F25D06=-1.0E+20 RETURN END C F26 + H OF MIXTURE AT P FUNCTION F26D06(P,X) IMPLICIT DOUBLE PRECISION (G,H,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YX=DBLE(X) CALL S3D06(YP,YTS,YRL,YRG) HL=G15D06(YRL,YTS,YP) HG=G15D06(YRG,YTS,YP) F26D06=REAL(HL+YX*(HG-HL)) RETURN 999 F26D06=-1.0E+20 RETURN END C F27 + H OF SATURATED LIQUID AT T FUNCTION F27D06(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,YRL,YRG) F27D06=REAL(G15D06(YRL,YT,YPS)) RETURN 999 F27D06=-1.0E+20 RETURN END C F28 + H OF SATURATED VAPOUR AT T FUNCTION F28D06(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,YRL,YRG) F28D06=REAL(G15D06(YRG,YT,YPS)) RETURN 999 F28D06=-1.0E+20 RETURN END C F29 + H OF MIXTURE AT T FUNCTION F29D06(T,X) IMPLICIT DOUBLE PRECISION (G,H,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YX=DBLE(X) CALL S1D06(YT,YPS,YRL,YRG) HL=G15D06(YRL,YT,YPS) HG=G15D06(YRG,YT,YPS) F29D06=REAL(HL+YX*(HG-HL)) RETURN 999 F29D06=-1.0E+20 RETURN END C F30 + SATURATION PRESSURE AT T FUNCTION F30D06(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YP,YRL,YRG) F30D06=REAL(YP) RETURN 999 F30D06=-1.0E+20 RETURN END C F31 + SURFACE TENSION AT P FUNCTION F31D06(P) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 T=F40D06(P) F31D06=G29D06(T) RETURN 999 F31D06=-1.0E+20 RETURN END C F32 + SURFACE TENSION AT T FUNCTION F32D06(T) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 F32D06=G29D06(T) RETURN 999 F32D06=-1.0E+20 RETURN END C F33 + S OF SATURATED LIQUID AT P FUNCTION F33D06(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,YRL,YRG) F33D06=REAL(G13D06(YRL,YTS)) RETURN 999 F33D06=-1.0E+20 RETURN END C F34 + S OF SATURATED VAPOUR AT P FUNCTION F34D06(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,YRL,YRG) F34D06=REAL(G13D06(YRG,YTS)) RETURN 999 F34D06=-1.0E+20 RETURN END C F35 + S AT P AND T FUNCTION F35D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F35D06=REAL(G13D06(YR,YT)) RETURN ENDIF ENDIF F35D06=-1.0E+20 RETURN END C F36 + S OF MIXTURE AT P FUNCTION F36D06(P,X) IMPLICIT DOUBLE PRECISION (G,S,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YX=DBLE(X) CALL S3D06(YP,YTS,YRL,YRG) SL=G13D06(YRL,YTS) SG=G13D06(YRG,YTS) F36D06=REAL(SL+YX*(SG-SL)) RETURN 999 F36D06=-1.0E+20 RETURN END C F37 + S OF SATURATED LIQUID AT T FUNCTION F37D06(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,YRL,YRG) F37D06=REAL(G13D06(YRL,YT)) RETURN 999 F37D06=-1.0E+20 RETURN END C F38 + S OF SATURATED VAPOUR AT T FUNCTION F38D06(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,YRL,YRG) F38D06=REAL(G13D06(YRG,YT)) RETURN 999 F38D06=-1.0E+20 RETURN END C F39 + S OF MIXTURE AT T FUNCTION F39D06(T,X) IMPLICIT DOUBLE PRECISION (G,S,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YX=DBLE(X) CALL S1D06(YT,YPS,YRL,YRG) SL=G13D06(YRL,YT) SG=G13D06(YRG,YT) F39D06=REAL(SL+YX*(SG-SL)) RETURN 999 F39D06=-1.0E+20 RETURN END C F40 + SATURATION TEMPERATURE AT P FUNCTION F40D06(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YT,YRL,YRG) F40D06=REAL(YT)-273.15 RETURN 999 F40D06=-1.0E+20 RETURN END C F42 + U OF SATURATED LIQUID AT P FUNCTION F42D06(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,YRL,YRG) F42D06=REAL(G14D06(YRL,YTS)) RETURN 999 F42D06=-1.0E+20 RETURN END C F43 + U OF SATURATED VAPOUR AT P FUNCTION F43D06(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,YRL,YRG) F43D06=REAL(G14D06(YRG,YTS)) RETURN 999 F43D06=-1.0E+20 RETURN END C F44 + U AT P AND T FUNCTION F44D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F44D06=REAL(G14D06(YR,YT)) RETURN ENDIF ENDIF F44D06=-1.0E+20 RETURN END C F45 + U OF MIXTURE AT P FUNCTION F45D06(P,X) IMPLICIT DOUBLE PRECISION (G,U,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YX=DBLE(X) CALL S3D06(YP,YTS,YRL,YRG) UL=G14D06(YRL,YTS) UG=G14D06(YRG,YTS) F45D06=REAL(UL+YX*(UG-UL)) RETURN 999 F45D06=-1.0E+20 RETURN END C F46 + U OF SATURATED LIQUID AT T FUNCTION F46D06(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,YRL,YRG) F46D06=REAL(G14D06(YRL,YT)) RETURN 999 F46D06=-1.0E+20 RETURN END C F47 + U OF SATURATED VAPOUR AT T FUNCTION F47D06(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,YRL,YRG) F47D06=REAL(G14D06(YRG,YT)) RETURN 999 F47D06=-1.0E+20 RETURN END C F48 + U OF MIXTURE AT T FUNCTION F48D06(T,X) IMPLICIT DOUBLE PRECISION (G,U,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YX=DBLE(X) CALL S1D06(YT,YPS,YRL,YRG) UL=G14D06(YRL,YT) UG=G14D06(YRG,YT) F48D06=REAL(UL+YX*(UG-UL)) RETURN 999 F48D06=-1.0E+20 RETURN END C F49 + V OF SATURATED LIQUID AT P FUNCTION F49D06(P) IMPLICIT DOUBLE PRECISION (G,R,Y) DATA W/4.4097E+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,RL,RG) F49D06=1.0E+00/(REAL(RL)*W) RETURN 999 F49D06=-1.0E+20 RETURN END C F50 + V OF SATURATED GAS AT P FUNCTION F50D06(P) IMPLICIT DOUBLE PRECISION (G,R,Y) DATA W/4.4097E+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,RL,RG) F50D06=1.0E+00/(REAL(RG)*W) RETURN 999 F50D06=-1.0E+20 RETURN END C F51 + V AT P AND T FUNCTION F51D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 DATA W/4.4097E+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F51D06=1.0E+00/(REAL(YR)*W) RETURN ENDIF ENDIF F51D06=-1.0E+20 RETURN END C F52 + V OF MIXTURE AT P FUNCTION F52D06(P,X) IMPLICIT DOUBLE PRECISION (G,R,Y) DATA W/4.4097E+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,RL,RG) VL=1.0E+00/(REAL(RL)*W) VG=1.0E+00/(REAL(RG)*W) F52D06=VL+X*(VG-VL) RETURN 999 F52D06=-1.0E+20 RETURN END C F53 + V OF SATURATED LIQUID AT T FUNCTION F53D06(T) IMPLICIT DOUBLE PRECISION (G,R,Y) DATA W/4.4097E+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,RL,RG) F53D06=1.0E+00/(REAL(RL)*W) RETURN 999 F53D06=-1.0E+20 RETURN END C F54 + V OF SATURATED GAS AT T FUNCTION F54D06(T) IMPLICIT DOUBLE PRECISION (G,R,Y) DATA W/4.4097E+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,RL,RG) F54D06=1.0E+00/(REAL(RG)*W) RETURN 999 F54D06=-1.0E+20 RETURN END C F55 + V OF MIXTURE AT T FUNCTION F55D06(T,X) IMPLICIT DOUBLE PRECISION (G,R,Y) DATA W/4.4097E+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,RL,RG) VL=1.0E+00/(REAL(RL)*W) VG=1.0E+00/(REAL(RG)*W) F55D06=VL+X*(VG-VL) RETURN 999 F55D06=-1.0E+20 RETURN END C F56 + DRYNESS FRACTION <-> AT P,H FUNCTION F56D06(P,H) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 HD=F23D06(P) HDD=F24D06(P) IF (H.LT.HD .OR. H.GT.HDD) GOTO 999 F56D06=(H-HD)/(HDD-HD) RETURN 999 F56D06=-1.0E+20 RETURN END C F57 + DRYNESS FRACTION <-> AT P,S FUNCTION F57D06(P,S) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 SD=F33D06(P) SDD=F34D06(P) IF (S.LT.SD .OR. S.GT.SDD) GOTO 999 F57D06=(S-SD)/(SDD-SD) RETURN 999 F57D06=-1.0E+20 RETURN END C F58 + DRYNESS FRACTION <-> AT P,U FUNCTION F58D06(P,U) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 UD=F42D06(P) UDD=F43D06(P) IF (U.LT.UD .OR. U.GT.UDD) GOTO 999 F58D06=(U-UD)/(UDD-UD) RETURN 999 F58D06=-1.0E+20 RETURN END C F59 + DRYNESS FRACTION <-> AT P,V FUNCTION F59D06(P,V) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YT,RL,RG) VL=1.0E+00/(REAL(RL)*44.097E+00) VG=1.0E+00/(REAL(RG)*44.097E+00) IF (V.LT.VL .OR. V.GT.VG) GOTO 999 F59D06=(V-VL)/(VG-VL) RETURN 999 F59D06=-1.0E+20 RETURN END C F60 + DRYNESS FRACTION <-> AT T,H FUNCTION F60D06(T,H) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 HD=F27D06(T) HDD=F28D06(T) IF (H.LT.HD .OR. H.GT.HDD) GOTO 999 F60D06=(H-HD)/(HDD-HD) RETURN 999 F60D06=-1.0E+20 RETURN END C F61 + DRYNESS FRACTION <-> AT T,S FUNCTION F61D06(T,S) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 SD=F37D06(T) SDD=F38D06(T) IF (S.LT.SD .OR. S.GT.SDD) GOTO 999 F61D06=(S-SD)/(SDD-SD) RETURN 999 F61D06=-1.0E+20 RETURN END C F62 + DRYNESS FRACTION <-> AT T,U FUNCTION F62D06(T,U) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 UD=F46D06(T) UDD=F47D06(T) IF (U.LT.UD .OR. U.GT.UDD) GOTO 999 F62D06=(U-UD)/(UDD-UD) RETURN 999 F62D06=-1.0E+20 RETURN END C F63 + DRYNESS FRACTION <-> AT T,V FUNCTION F63D06(T,V) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YP,RL,RG) VL=1.0E+00/(REAL(RL)*44.097E+00) VG=1.0E+00/(REAL(RG)*44.097E+00) IF (V.LT.VL .OR. V.GT.VG) GOTO 999 F63D06=(V-VL)/(VG-VL) RETURN 999 F63D06=-1.0E+20 RETURN END C F64 + TEMPERATURE AT P AND H FUNCTION F64D06(P,H) DOUBLE PRECISION PP,HH,TT,VV,SS,UU PP=DBLE(P) HH=DBLE(H) CALL S10D06(PP,HH,TT,VV,SS,UU) T=REAL(TT) IF (T.GE.-1.0) THEN F64D06=T-273.15 ELSE F64D06=T ENDIF RETURN END C F65 + TEMPERATURE AT P AND S FUNCTION F65D06(P,S) DOUBLE PRECISION PP,SS,TT,VV,HH,UU PP=DBLE(P) SS=DBLE(S) CALL S11D06(PP,SS,TT,VV,HH,UU) T=REAL(TT) IF (T.GE.-1.0) THEN F65D06=T-273.15 ELSE F65D06=T ENDIF RETURN END C F70 + TEMPERATURE AT P AND V FUNCTION F70D06(P,V) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YR=1.0D+00/(DBLE(V)*44.097D+00) T=REAL(G10D06(YR,YP)) IF (T.GE.-1.0) THEN F70D06=T-273.15 ELSE F70D06=T ENDIF RETURN END C F71 + H AT P AND S FUNCTION F71D06(P,S) DOUBLE PRECISION PP,SS,TT,VV,HH,UU PP=DBLE(P) SS=DBLE(S) CALL S11D06(PP,SS,TT,VV,HH,UU) F71D06=REAL(HH) RETURN END C FA1 + CV OF SATURATED LIQUID AT P FUNCTION FA1D06(P) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,RL,RG) FA1D06=REAL(G16D06(RL,YTS)) RETURN 999 FA1D06=-1.0E+20 RETURN END C F76 + CV OF SATURATED VAPOUR AT P FUNCTION F76D06(P) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,RL,RG) F76D06=REAL(G16D06(RG,YTS)) RETURN 999 F76D06=-1.0E+20 RETURN END C F77 + CV AT P AND T FUNCTION F77D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F77D06=REAL(G16D06(YR,YT)) RETURN ENDIF ENDIF F77D06=-1.0E+20 RETURN END C FA2 + CV OF SATURATED LIQUID AT T FUNCTION FA2D06(T) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,RL,RG) FA2D06=REAL(G16D06(RL,YT)) RETURN 999 FA2D06=-1.0E+20 RETURN END C F78 + CV OF SATURATED VAPOUR AT T FUNCTION F78D06(T) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,RL,RG) F78D06=REAL(G16D06(RG,YT)) RETURN 999 F78D06=-1.0E+20 RETURN END C F79 + U AT P AND S FUNCTION F79D06(P,S) DOUBLE PRECISION PP,SS,TT,VV,HH,UU PP=DBLE(P) SS=DBLE(S) CALL S11D06(PP,SS,TT,VV,HH,UU) F79D06=REAL(UU) RETURN END C F80 + V AT P AND S FUNCTION F80D06(P,S) DOUBLE PRECISION PP,SS,TT,VV,HH,UU PP=DBLE(P) SS=DBLE(S) CALL S11D06(PP,SS,TT,VV,HH,UU) F80D06=REAL(VV) RETURN END C FB1 + ADIABATIC EXPONENT<-> OF SATURATED LIQUID AT P FUNCTION FB1D06(P) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,RL,RG) FB1D06=REAL(G28D06(RL,YTS,YP)) RETURN 999 FB1D06=-1.0E+20 RETURN END C FB2 + ADIABATIC EXPONENT<-> OF SATURATED VAPOUR AT P FUNCTION FB2D06(P) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,RL,RG) FB2D06=REAL(G28D06(RG,YTS,YP)) RETURN 999 FB2D06=-1.0E+20 RETURN END C F82 + ADIABATIC EXPONENT<-> AT P AND T FUNCTION F82D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F82D06=REAL(G28D06(YR,YT,YP)) RETURN ENDIF ENDIF F82D06=-1.0E+20 RETURN END C F98 + PSEUDO BOILING POINT AT P FUNCTION F98D06(P) DIMENSION T(2),C(2),TL(3),TR(3),CL(3),CR(3) P1=F21D06('P') PP=ABS((P-P1)/P1) T1=F21D06('T') IF (PP.LT.1.0E-5) THEN F98D06=T1 RETURN ENDIF IF (P.LT.P1.OR.P.GT.200.001D00) THEN F98D06=-1.0E+20 RETURN ENDIF T2=0.85*T1 P2=F30D06(T2) TM0=T1+(T1-T2)*(P-P1)/(P1-P2) C-----TM0 KINJICHI TC=T1 T(1)=TM0 150 EPS=1.0E-6 DEL=T1*0.05 IREP=0 IREM=5000 KCONT=0 ICONT=0 C(1)=F18D06(P,T(1)) T(2)=T(1)-DEL C(2)=F18D06(P,T(2)) 1000 RINC=C(2)-C(1) IF(RINC.GT.0.3)THEN GOTO 1500 ELSE T(2)=T(1) C(2)=C(1) T(1)=T(1)-DEL C(1)=F18D06(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=-F18D06(P,TT) 3000 CONV=ABS((CC-C(2))/CC) IF(CONV.LT.EPS) THEN F98D06=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=-F18D06(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=F18D06(P,TA) CB=F18D06(P,TB) 6050 KCONT=KCONT+1 IF (KCONT.GT.IREM) GO TO 8000 DELT=ABS((TA-TB)/TA) IF (DELT.LT.EPS) GO TO 7000 CC=F18D06(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)=F18D06(P,TL(2)) CR(2)=F18D06(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=F18D06(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=F18D06(P,TB) ELSE TB=TR(MR+1) CB=CR(MR+1) ENDIF 6135 TC=TR(MR) CC=CR(MR) ENDIF GO TO 6050 7000 F98D06=TC RETURN 8000 F98D06=-1.0E+10 RETURN END C FB3 + ADIABATIC EXPONENT<-> OF SATURATED LIQUID AT T FUNCTION FB3D06(T) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,RL,RG) FB3D06=REAL(G28D06(RL,YT,YPS)) RETURN 999 FB3D06=-1.0E+20 RETURN END C FB4 + ADIABATIC EXPONENT<-> OF SATURATED VAPOUR AT T FUNCTION FB4D06(T) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,RL,RG) FB4D06=REAL(G28D06(RG,YT,YPS)) RETURN 999 FB4D06=-1.0E+20 RETURN END C FC1 + SPEED OF SOUND OF SATURATED LIQUID AT P FUNCTION FC1D06(P) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,RL,RG) FC1D06=REAL(G27D06(RL,YTS)) RETURN 999 FC1D06=-1.0E+20 RETURN END C FC2 + SPEED OF SOUND OF SATURATED VAPOUR AT P FUNCTION FC2D06(P) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YTS,RL,RG) FC2D06=REAL(G27D06(RG,YTS)) RETURN 999 FC2D06=-1.0E+20 RETURN END C F83 + SPEED OF SOUND AT P AND T FUNCTION F83D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F83D06=REAL(G27D06(YR,YT)) RETURN ENDIF ENDIF F83D06=-1.0E+20 RETURN END C FC3 + SPEED OF SOUND OF SATURATED LIQUID AT T FUNCTION FC3D06(T) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,RL,RG) FC3D06=REAL(G27D06(RL,YT)) RETURN 999 FC3D06=-1.0E+20 RETURN END C FC4 + SPEED OF SOUND OF SATURATED VAPOUR AT T FUNCTION FC4D06(T) IMPLICIT DOUBLE PRECISION (G,R,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,RL,RG) FC4D06=REAL(G27D06(RG,YT)) RETURN 999 FC4D06=-1.0E+20 RETURN END C F90 + BSPT<1/PA> AT P AND T FUNCTION F90D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 DATA W/4.4097E+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN SS=REAL(G27D06(YR,YT)) VV=1.0E+00/(REAL(YR)*W) F90D06=VV/SS**2 RETURN ENDIF ENDIF F90D06=-1.0E+20 RETURN END C F91 + BTPT<1/PA> AT P AND T FUNCTION F91D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN DPDR=REAL(G4D06(YR,YT))*1.0E+05 F91D06=1.0E+00/REAL(YR)/DPDR RETURN ENDIF ENDIF F91D06=-1.0E+20 RETURN END C F92 + BPPT<1/K> AT P AND T FUNCTION F92D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F92D06=REAL(G3D06(YR,YT)/YR/G4D06(YR,YT)) RETURN ENDIF ENDIF F92D06=-1.0E+20 RETURN END C F93 + BVPT<1/K> AT P AND T FUNCTION F93D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F93D06=REAL(G3D06(YR,YT)/YP) RETURN ENDIF ENDIF F93D06=-1.0E+20 RETURN END C F94 + AJTPT AT P AND T FUNCTION F94D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 DATA GCUB/8.3143E+03/ C GCUB:UNIVERSAL GAS CONSTANT [PA*DM**3/MOL/K] IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN YY=YT*G3D06(YR,YT)/YR/G4D06(YR,YT)-1.0D+00 DPDTDR=REAL(YY) F94D06=DPDTDR/REAL(YR*G17D06(YR,YT))/GCUB RETURN ENDIF ENDIF F94D06=-1.0E+20 RETURN END C F95 + RATIO OF SPECIFIC HEATS AT P AND T FUNCTION F95D06(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D06 IF (G93D06(P,T).EQ.2) THEN YP=DBLE(P) YT=DBLE(T+273.15) YR=G5D06(YP,YT) IF (YR.GE.0.0D+00) THEN F95D06=REAL(G17D06(YR,YT)/G16D06(YR,YT)) RETURN ENDIF ENDIF F95D06=-1.0E+20 RETURN END C F96 + RATIO OF SPECIFIC HEATS OF SATURATED VAPOUR AT P FUNCTION F96D06(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.0.07671 .OR. P.GT.42.51) GOTO 999 YP=DBLE(P) CALL S3D06(YP,YT,YRL,YRG) F96D06=REAL(G17D06(YRG,YT)/G16D06(YRG,YT)) RETURN 999 F96D06=-1.0E+20 RETURN END C F97 + RATIO OF SPECIFIC HEATS OF SATURATED VAPOUR AT T FUNCTION F97D06(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-85.0 .OR. T.GT.96.45) GOTO 999 YT=DBLE(T+273.15) CALL S1D06(YT,YPS,YRL,YRG) F97D06=REAL(G17D06(YRG,YT)/G16D06(YRG,YT)) RETURN 999 F97D06=-1.0E+20 RETURN END C ****************************************** C * C3H8 PROPERTIES FUNCTION * C * * C * EQUATION OF STATE * C * PROPOSED BY * C * BUHNER,K., MAURER,G., AND BENDER,E. * C * CRYOGENICS, MARCH 1981,PP.157-164 * C * * C * UNIT NAME [D06PRO.FOR VER. 1.1] * C * CODED (AUGUST 1988) * C * REVISED (AUGUST 1991) * C * * C * BY * C * TOMOHIRO HONDA * C * FUKUOKA UNIVERSITY * C * FUKUOKA 814-01, JAPAN * C ****************************************** C G01 ************************************ C * PRT: PRESSURE [BAR] * C ************************************ C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * GCU: UNIVERSAL GAS CONSTANT * C * [BAR*DM**3/MOL/K] * C ************************************ FUNCTION G1D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GCU/8.3143D-02/ PPP=G2D06(RO,T) G1D06=PPP*RO*GCU*T RETURN END C G02 ************************************ C * THE BENDER EQUATION OF STATE * C ************************************ C * ZRT: COMPRESSION FACTOR [-] * C * P : PRESSURE [BAR] * C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * GCU: UNIVERSAL GAS CONSTANT * C * [BAR*DM**3/MOL/K] * C ************************************ FUNCTION G2D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 &/ 5.80916810D-03, 3.90114176D+00, 1.56346355D+03, & 2.28771385D+05,-9.23226900D+06, 9.55274430D-04, & -3.24453220D-01, 1.88471771D+02,-2.90188643D-05, & 3.77561217D-02, 1.40000169D-05,-1.51162922D-02, & 7.81456423D-04,-8.28179512D+04, 7.16940510D+07, & -1.53862102D+10,-5.61385455D+03, 2.14103506D+06, & 1.53532302D+08, 4.01688418D-02/ DATA GCU/8.3143D-02/ TR1=1.0D+00/T TR2=TR1*TR1 TR3=TR1*TR2 TR4=TR1*TR3 TR5=TR1*TR4 B=A01-A02*TR1-A03*TR2-A04*TR3-A05*TR4 C=A06+A07*TR1+A08*TR2 D=A09+A10*TR1 E=A11+A12*TR1 F=A13*TR1 G=A14*TR3+A15*TR4+A16*TR5 H=A17*TR3+A18*TR4+A19*TR5 RO2=RO*RO RO3=RO*RO2 RO4=RO*RO3 RO5=RO*RO4 EEE=DEXP(-A20*RO2) ZZZ=GCU+B*RO+C*RO2+D*RO3+E*RO4+F*RO5+(G+H*RO2)*RO2*EEE G2D06=ZZZ/GCU RETURN END C G03 ************************************ C * DPDT: PARTIAL DERIVATIVE OF * C * P BY T [BAR/K] * C * THE BENDER EQUATION OF STATE * C ************************************ C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * GCU: UNIVERSAL GAS CONSTANT * C * [BAR*DM**3/MOL/K] * C ************************************ FUNCTION G3D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 &/ 5.80916810D-03, 3.90114176D+00, 1.56346355D+03, & 2.28771385D+05,-9.23226900D+06, 9.55274430D-04, & -3.24453220D-01, 1.88471771D+02,-2.90188643D-05, & 3.77561217D-02, 1.40000169D-05,-1.51162922D-02, & 7.81456423D-04,-8.28179512D+04, 7.16940510D+07, & -1.53862102D+10,-5.61385455D+03, 2.14103506D+06, & 1.53532302D+08, 4.01688418D-02/ DATA GCU/8.3143D-02/ TR1=1.0D+00/T TR2=TR1*TR1 TR3=TR1*TR2 TR4=TR1*TR3 TR5=TR1*TR4 B1=A01+A03*TR2+2*A04*TR3+3*A05*TR4 C1=A06-A08*TR2 D1=A09 E1=A11 G1=2*A14*TR3+3*A15*TR4+4*A16*TR5 G1=-G1 H1=2*A17*TR3+3*A18*TR4+4*A19*TR5 H1=-H1 RO2=RO*RO RO3=RO*RO2 RO4=RO*RO3 EEE=DEXP(-A20*RO2) DPT=GCU+B1*RO+C1*RO2+D1*RO3+E1*RO4 DPT=DPT+(G1+H1*RO2)*RO2*EEE G3D06=RO*DPT RETURN END C G04 ************************************ C * DPDRO:PARTIAL DERIVATIVE OF * C * P BY RO [BAR/(MOL/DM**3)] * C * THE BENDER EQUATION OF STATE * C ************************************ C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * GCU: UNIVERSAL GAS CONSTANT * C * [BAR*DM**3/MOL/K] * C ************************************ FUNCTION G4D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 &/ 5.80916810D-03, 3.90114176D+00, 1.56346355D+03, & 2.28771385D+05,-9.23226900D+06, 9.55274430D-04, & -3.24453220D-01, 1.88471771D+02,-2.90188643D-05, & 3.77561217D-02, 1.40000169D-05,-1.51162922D-02, & 7.81456423D-04,-8.28179512D+04, 7.16940510D+07, & -1.53862102D+10,-5.61385455D+03, 2.14103506D+06, & 1.53532302D+08, 4.01688418D-02/ DATA GCU/8.3143D-02/ TR1=1.0D+00/T TR2=TR1*TR1 TR3=TR1*TR2 TR4=TR1*TR3 TR5=TR1*TR4 B=A01-A02*TR1-A03*TR2-A04*TR3-A05*TR4 C=A06+A07*TR1+A08*TR2 D=A09+A10*TR1 E=A11+A12*TR1 F=A13*TR1 G=A14*TR3+A15*TR4+A16*TR5 H=A17*TR3+A18*TR4+A19*TR5 RO2=RO*RO RO3=RO*RO2 RO4=RO*RO3 RO5=RO*RO4 ARO2=A20*RO2 DPRO=GCU+2*B*RO+3*C*RO2+4*D*RO3+5*E*RO4+6*F*RO5 DPRO=DPRO+((3-2*ARO2)*G+(5-2*ARO2)*H*RO2)*RO2*DEXP(-ARO2) G4D06=DPRO*T RETURN END C G05 ************************************ C * RPT: DENSITY [MOL/DM**3] * C * P : PRESSURE [BAR] * C * T : TEMPERATURE [K] * C ************************************ FUNCTION G5D06(P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCMAX,PCMIN/42.597D+00,42.51D+00/ DATA TCMAX,TCMIN/369.90D+00,369.60D+00/ IF (T.LE.369.60D0) THEN CALL S1D06(T,PS,RL,RV) IF (P.GT.PS) THEN RST1=RL ELSE IF (T.GT.340.0) THEN RMAX=RV RMIN=2.0D-03 RST1=G6D06(RMAX,RMIN,P,T) ELSE RST1=RV ENDIF ENDIF ELSE IF (T.GE.TCMAX) THEN RMAX=12.0D0 RMIN=2.0D-03 ELSE IF (P.GE.PCMAX) THEN RMAX=12.0D0 RMIN=3.86D0 ELSEIF (P.LT.PCMIN) THEN RMAX=4.19D0 RMIN=2.0D-03 ELSE G5D06=-1.0E+20 RETURN ENDIF ENDIF RST1=G6D06(RMAX,RMIN,P,T) ENDIF G5D06=G7D06(P,T,RST1) RETURN END C G06 ************************************ C * DETERMINATION OF INITIAL VALUE * C * FOR R(P,T) * C * RMAX:DENSITY(MAX) [MOL/DM**3] * C * RMIN:DENSITY(MIN) [MOL/DM**3] * C * P :PRESSURE [BAR] * C * T :TEMPERATURE [K] * C ************************************ FUNCTION G6D06(RMAX,RMIN,P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) ILOOP=0 RA=RMAX RB=RMIN PA=G1D06(RA,T) PB=G1D06(RB,T) 10 ILOOP=ILOOP+1 IF (ILOOP.LE.10000) THEN DPA=P-PA DPB=P-PB DPAB=PA-PB RC=RB+(RA-RB)*.5 PC=G1D06(RC,T) IF (DABS(RA-RB)/RB.LT.1D-1) THEN G6D06=RC RETURN ELSE DPC=P-PC IF (DPA*DPC.LE.0.0 .AND. DPB*DPC.GT.0.0) THEN RB=RC PB=PC ELSEIF (DPA*DPC.GT.0.0 .AND. DPB*DPC.LE.0.0) THEN RA=RC PA=PC ELSE RA=1.1*RA RB=0.9*RB PA=G1D06(RA,T) PB=G1D06(RB,T) ENDIF ENDIF ELSE G6D06=-1.0E+10 RETURN ENDIF GOTO 10 END C G07 ************************************ C * RPTNEW:DENSITY [MOL/DM**3] * C * BY NEWTON-METHOD * C * P :PRESSURE [BAR] * C * TK :TEMPERATURE [K] * C * R1 :INITIAL VALUE [MOL/DM**3] * C ************************************ FUNCTION G7D06(P,TK,R1) IMPLICIT DOUBLE PRECISION (A-H,O-Z) R=R1 ILOOP=0 10 ILOOP=ILOOP+1 IF (ILOOP.LT.10000) THEN PD=G1D06(R,TK) DPDRD=G4D06(R,TK) DR=(P-PD)/DPDRD IF (DABS(DR/R).LT.1D-7) THEN G7D06=R+DR RETURN ELSE R=R+DR ENDIF ELSE G7D06=-1D10 RETURN ENDIF GOTO 10 END C S01 ************************************ C * SATURATED PROPERTIES * C * PS:PRESSURE [BAR] * C * RL:DENSITY OF LIQUID [MOL/DM**3]* C * RV:DENSITY OF VAPOR [MOL/DM**3]* C * TK: TEMPERATURE [K] * C ************************************ C * SATURATED PROPERTIES(TENTATIVE) * C * PST:PRESSURE [BAR] * C * RLT:DENSITY OF LIQUID [G/CM**3]* C * RVT:DENSITY OF VAPOR [G/CM**3]* C ************************************ SUBROUTINE S1D06(TK,PS,RL,RV) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA W/4.4097D+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (TK.GT.369.60D0) THEN RETURN ENDIF CALL S2D06(TK,PST,RLT,RVT) PS1=PST RL1=RLT*1D3/W RV1=RVT*1D3/W ILOOP=0 10 ILOOP=ILOOP+1 RL=G7D06(PS1,TK,RL1) RV=G7D06(PS1,TK,RV1) PS=G8D06(TK,RL,RV) IF (DABS(PS/PS1-1D0).LT.1D-7) THEN RETURN ELSE PS1=PS RL1=RL RV1=RV ENDIF GOTO 10 END C S02 *********************************** C * SATURATED PROPERTIES(TENTATIVE) * C * PST:PRESSURE [BAR] * C * ROL:DENSITY OF LIQUID [G/CM**3]* C * ROV:DENSITY OF VAPOR [G/CM**3]* C * T :TEMPERATURE [K] * C *********************************** SUBROUTINE S2D06(TK,PST,ROL,ROV) IMPLICIT DOUBLE PRECISION(Y) DOUBLE PRECISION TK,PST,ROL,ROV YDT=1D0-TK/369.9D0 YRT=369.9D0/TK-1D0 IF (TK.GE.363.15D0) THEN YYT=YRT**0.9296D+00 YPS= 0.581675107D-02-0.496293846D+01*YYT & -0.497803165D+01*YYT**2 PST=42.597D0*DEXP(YPS) ROL=0.2200D+00+0.5375D+00*YDT**0.4104D+00 ROV=0.2200D+00-0.4135D+00*YDT**0.3563D+00 RETURN ENDIF IF (TK.LT.233.15D0) THEN YYT=YRT**0.849D+00 YPS=-0.524815777D+00-0.301885452D+01*YYT & -0.302880160D+01*YYT**2 YRL= 0.207587910D+00+0.108735831D+01*YDT**0.36D+00 YRV= 0.282442296D+01+0.405709023D+02*YDT**3.23D+00 ELSEIF (TK.LT.283.15D0) THEN YYT=YRT**0.703D+00 YPS= 0.146278573D+00-0.329026691D+01*YYT & -0.328589585D+01*YYT**2 YRL=-0.870523439D-02+0.128988285D+01*YDT**0.28D+00 YRV= 0.153663980D+01+0.184994319D+02*YDT**1.86D+00 ELSEIF (TK.LT.333.15D0) THEN YYT=YRT**0.718D+00 YPS= 0.126544172D+00-0.333209711D+01*YYT & -0.333176975D+01*YYT**2 YRL=-0.195115976D+00+0.145978639D+01*YDT**0.23D+00 YRV= 0.728540014D+00+0.106923403D+02*YDT**1.14D+00 ELSEIF (TK.LT.363.15D0) THEN YYT=YRT**0.875D+00 YPS= 0.144698533D-01-0.429401347D+01*YYT & -0.429691080D+01*YYT**2 YRL=-0.111037632D+00+0.141275043D+01*YDT**0.26D+00 YRV= 0.164811054D+00+0.619247878D+01*YDT**(2D0/3D0) ENDIF PST=42.597D0*DEXP(YPS) ROL=0.2200D0*DEXP(YRL) ROV=0.2200D0*DEXP(-YRV) RETURN END C G08 ************************************ C * PRESSURE BY GIBBS CONDITION * C * PRT: PRESSURE [BAR] * C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * GCU: UNIVERSAL GAS CONSTANT * C * [BAR*DM**3/MOL/K] * C ************************************ FUNCTION G8D06(TK,ROL,ROV) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GCU/8.3143D-02/ SS=GCU*DLOG(ROL/ROV)+(G9D06(ROL,TK)-G9D06(ROV,TK)) G8D06=ROV*ROL/(ROL-ROV)*TK*SS RETURN END C G09 ************************************ C * PRO2IN: INTEGRAL OF P/RO**2 * C * THE BENDER EQUATION OF STATE * C ************************************ C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * GCU: UNIVERSAL GAS CONSTANT * C * [BAR*DM**3/MOL/K] * C ************************************ FUNCTION G9D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 &/ 5.80916810D-03, 3.90114176D+00, 1.56346355D+03, & 2.28771385D+05,-9.23226900D+06, 9.55274430D-04, & -3.24453220D-01, 1.88471771D+02,-2.90188643D-05, & 3.77561217D-02, 1.40000169D-05,-1.51162922D-02, & 7.81456423D-04,-8.28179512D+04, 7.16940510D+07, & -1.53862102D+10,-5.61385455D+03, 2.14103506D+06, & 1.53532302D+08, 4.01688418D-02/ TR1=1.0D+00/T TR2=TR1*TR1 TR3=TR1*TR2 TR4=TR1*TR3 TR5=TR1*TR4 B=A01-A02*TR1-A03*TR2-A04*TR3-A05*TR4 C=A06+A07*TR1+A08*TR2 D=A09+A10*TR1 E=A11+A12*TR1 F=A13*TR1 G=A14*TR3+A15*TR4+A16*TR5 H=A17*TR3+A18*TR4+A19*TR5 RO2=RO*RO RO3=RO*RO2 RO4=RO*RO3 RO5=RO*RO4 EEE=DEXP(-A20*RO2) HFE=B*RO+C*RO2/2+D*RO3/3+E*RO4/4+F*RO5/5 G9D06=HFE-(G+H*(1D0/A20+RO2))*EEE/2/A20 RETURN END C S03 ************************************ C * SATURATED PROPERTIES * C * TS:TEMPERATURE [K] * C * RL:DENSITY OF LIQUID [MOL/DM**3]* C * RV:DENSITY OF VAPOR [MOL/DM**3]* C * P :PRESSURE [BAR] * C * SRT: [J/KG*K] * C ************************************ SUBROUTINE S3D06(P,TS,RL,RV) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA W/4.4097D-02/ C W: MOLECULAR WEIGHT [KG/MOL] IF (P.LT.0.5D0) THEN T1=203.15D0 ELSEIF (P.LT.2.0D0) THEN T1=233.15D0 ELSEIF (P.LT.5.4D0) THEN T1=263.15D0 ELSEIF (P.LT.12.0D0) THEN T1=293.15D0 ELSEIF (P.LT.23.0D0) THEN T1=323.15D0 ELSEIF (P.LT.31.0D0) THEN T1=343.15D0 ELSEIF (P.LT.37.816D0) THEN T1=363.15D0 ELSEIF (P.LT.42.51D0) THEN T1=368.15D0 ELSE RETURN ENDIF ILOOP=0 20 ILOOP=ILOOP+1 IF (T1.GT.369.60D0) THEN RETURN ENDIF CALL S1D06(T1,P1,RL,RV) SL=G13D06(RL,T1) SV=G13D06(RV,T1) DPSDT=(SV-SL)*W/(RL-RV)*RL*RV*1.0D-02 DT=(P-P1)/DPSDT IF (DABS(DT/T1).LT.1D-7) THEN TS=T1 RETURN ELSE T1=T1+DT ENDIF GOTO 20 END C G10 ************************************ C * TRP: TEMPERATURE [K] * C * RO : DENSITY [MOL/DM**3] * C * P : PRESSURE [BAR] * C ************************************ FUNCTION G10D06(RO,P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCMAX,PCMIN/42.597D+00,42.51D+00/ DATA TCMAX,TCMIN/369.90D+00,369.60D+00/ IF (P.GT.1.0D+03) GOTO 999 IF (P.LT.0.07671D+00) GOTO 999 TMAX=300D0+273.15D0 TMIN=-85D0+273.15D0 RMAX=G5D06(P,TMAX) RMIN=G5D06(P,TMIN) IF (RO.LT.RMAX) GOTO 999 IF (RO.GT.RMIN) GOTO 999 IF (P.LE.PCMIN) THEN CALL S3D06(P,TS,RL,RG) IF (RO.GT.RL) THEN T1=TS ELSEIF (RO.GE.RG) THEN G10D06=TS RETURN ELSE T1=G11D06(TMAX,TS,RO,P) ENDIF ELSEIF (P.LT.PCMAX) THEN RMAX=G5D06(P,TCMAX) IF (RO.LE.RMAX) THEN T1=G11D06(TMAX,TCMAX,RO,P) ELSE RMIN=G5D06(P,TCMIN) IF (RO.GE.RMIN) THEN T1=G11D06(TCMIN,TMIN,RO,P) ELSE G10D06=-1.0E+20 RETURN ENDIF ENDIF ELSE T1=G11D06(TMAX,TMIN,RO,P) ENDIF G10D06=G12D06(RO,P,T1) RETURN 999 G10D06=-1.0E+20 RETURN END C G11 ************************************ C * DETERMINATION OF INITIAL VALUE * C * FOR T(RO,P) * C * TMAX:TEMPERATURE(MAX) [K] * C * TMIN:TEMPERATURE(MIN) [K] * C * RO :DENSITY [MOL/DM**3]* C * P :PRESSURE [BAR] * C ************************************ FUNCTION G11D06(TMAX,TMIN,RO,P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) ILOOP=0 TA=TMAX TB=TMIN RA=G5D06(P,TA) RB=G5D06(P,TB) 10 ILOOP=ILOOP+1 IF (ILOOP.LE.10000) THEN DRA=RO-RA DRB=RO-RB DRAB=RA-RB T=TB+(TA-TB)*.5 IF (DABS(TA-TB)/T.LT.1.0D-02) THEN G11D06=T RETURN ELSE RC=G5D06(P,T) DRC=RO-RC IF (DRA*DRC.LE.0.0 .AND. DRB*DRC.GT.0.0) THEN TB=T RB=RC ELSEIF (DRA*DRC.GT.0.0 .AND. DRB*DRC.LE.0.0) THEN TA=T RA=RC ENDIF ENDIF ELSE G11D06=-1.0E+10 RETURN ENDIF GOTO 10 END C G12 ************************************ C * TRPNEW:TEMPERATURE [K] * C * BY NEWTON-METHOD * C * RO :DENSITY [MOL/DM**3] * C * P :PRESSURE [BAR] * C * T1 :INITIAL VALUE [K] * C ************************************ FUNCTION G12D06(RO,P,T1) IMPLICIT DOUBLE PRECISION (A-H,O-Z) TK=T1 ILOOP=0 10 ILOOP=ILOOP+1 IF (ILOOP.LT.10000) THEN PD=G1D06(RO,TK) DPDTR=G3D06(RO,TK) DT=(P-PD)/DPDTR IF (DABS(DT/TK).LT.1D-7) THEN G12D06=TK+DT RETURN ELSE TK=TK+DT ENDIF ELSE G12D06=-1.0E+10 RETURN ENDIF GOTO 10 END C G13 ************************************ C * SRT: SPECIFIC ENTROPY [J/(KG*K)] * C ************************************ C * RO : DENSITY [MOL/DM**3] * C * = [KMOL/M**3] * C * T : TEMPERATURE [K] * C * REFERENCE STATE: * C * SID=0 AT T=298.15 [K] * C * P=1.01325[BAR] * C ************************************ FUNCTION G13D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GCU,W/8.3143D+03,4.4097D+01/ C GCU:UNIVERSAL GAS CONSTANT [J/(KMOL*K)] C W: MOLECULAR WEIGHT [KG/KMOL] GASCON=GCU/W C : GAS CONSTANT FOR PROPANE [J/(KG*K)] SSS=G18D06(RO,T) SSS=SSS-DLOG(RO*GCU*T/1.01325D5)+G22D06(T) G13D06=SSS*GASCON RETURN END C G14 ************************************ C * URT: SPECIFIC INTERNAL ENERGY * C **********************[J/KG]******** C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * REFERENCE STATE: * C * UID=0 AT T=298.15 [K] * C ************************************ FUNCTION G14D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GCU,W/8.3143D+03,4.4097D+01/ C GCU:UNIVERSAL GAS CONSTANT [J/(KMOL*K)] C W: MOLECULAR WEIGHT [KG/KMOL] GASCON=GCU/W C GC: GAS CONSTANT FOR PROPANE [J/(KG*K)] FFF=G19D06(RO,T) SSS=G18D06(RO,T) G14D06=((FFF+SSS)*T+G26D06(T))*GASCON RETURN END C G15 ************************************ C * HRTP: SPECIFIC ENTHALPY [J/KG] * C ************************************ C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * P : PRESSURE [BAR] * C * REFERENCE STATE: * C * HID=0 AT T=298.15 [K] * C ************************************ FUNCTION G15D06(RO,T,P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA W/4.4097D+01/ C W:MOLECULAR WEIGHT [KG/KMOL] G15D06=G14D06(RO,T)+P*1D5/(RO*W) RETURN END C G16 ************************************ C * CVRT: ISOCHORIC SPECIFIC HEAT * C **********************[J/(KG*K)]**** C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C ************************************ FUNCTION G16D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GCU,W/8.3143D+03,4.4097D+01/ C GCU:UNIVERSAL GAS CONSTANT [J/(KMOL*K)] C W: MOLECULAR WEIGHT [KG/KMOL] GASCON=GCU/W C GC: GAS CONSTANT FOR PROPANE [J/(KG*K)] G16D06=(-G20D06(RO,T)+G21D06(T)-1D0)*GASCON RETURN END C G17 ************************************ C * CPRT: ISOBARIC SPECIFIC HEAT * C **********************[J/(KG*K)]**** C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C ************************************ FUNCTION G17D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GCUB/8.3143D-02/ C GCUB:UNIVERSAL GAS CONSTANT [BAR*DM**3/MOL/K] DATA GCU,W/8.3143D+03,4.4097D+01/ C GCU:UNIVERSAL GAS CONSTANT [J/(KMOL*K)] C W: MOLECULAR WEIGHT [KG/KMOL] GASCON=GCU/W C GC: GAS CONSTANT FOR PROPANE [J/(KG*K)] DCPCVB=(G3D06(RO,T)/RO)**2/(G4D06(RO,T)/T) G17D06=G16D06(RO,T)+GASCON*DCPCVB/GCUB RETURN END C G18 ************************************ C * SSRT: INTEGRAL OF * C * [(R/RO-(DP/DT)/RO**2)]/R * C * FROM 0 TO RO * C * THE BENDER EQUATION OF STATE * C ************************************ C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * GCU: UNIVERSAL GAS CONSTANT * C * [BAR*DM**3/MOL/K] * C ************************************ FUNCTION G18D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 &/ 5.80916810D-03, 3.90114176D+00, 1.56346355D+03, & 2.28771385D+05,-9.23226900D+06, 9.55274430D-04, & -3.24453220D-01, 1.88471771D+02,-2.90188643D-05, & 3.77561217D-02, 1.40000169D-05,-1.51162922D-02, & 7.81456423D-04,-8.28179512D+04, 7.16940510D+07, & -1.53862102D+10,-5.61385455D+03, 2.14103506D+06, & 1.53532302D+08, 4.01688418D-02/ DATA GCU/8.3143D-02/ TR1=1.0D+00/T TR2=TR1*TR1 TR3=TR1*TR2 TR4=TR1*TR3 TR5=TR1*TR4 B1=A01+A03*TR2+2*A04*TR3+3*A05*TR4 C1=A06-A08*TR2 D1=A09 E1=A11 G1=2*A14*TR3+3*A15*TR4+4*A16*TR5 G1=-G1 H1=2*A17*TR3+3*A18*TR4+4*A19*TR5 H1=-H1 GH1=G1+H1/A20 RO2=RO*RO RO3=RO*RO2 RO4=RO*RO3 EEE=DEXP(-A20*RO2) S1=B1*RO+C1*RO2/2+D1*RO3/3+E1*RO4/4 S1=S1-((GH1+H1*RO2)*EEE-GH1)/2/A20 G18D06=-S1/GCU RETURN END C G19 ************************************ C * SHFRT: INTEGRAL OF * C * [(P/RO**2-R*T/RO)]/T/R * C * FROM 0 TO RO * C * THE BENDER EQUATION OF STATE * C ************************************ C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * GCU: UNIVERSAL GAS CONSTANT * C * [BAR*DM**3/MOL/K] * C ************************************ FUNCTION G19D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 &/ 5.80916810D-03, 3.90114176D+00, 1.56346355D+03, & 2.28771385D+05,-9.23226900D+06, 9.55274430D-04, & -3.24453220D-01, 1.88471771D+02,-2.90188643D-05, & 3.77561217D-02, 1.40000169D-05,-1.51162922D-02, & 7.81456423D-04,-8.28179512D+04, 7.16940510D+07, & -1.53862102D+10,-5.61385455D+03, 2.14103506D+06, & 1.53532302D+08, 4.01688418D-02/ DATA GCU/8.3143D-02/ TR1=1.0D+00/T TR2=TR1*TR1 TR3=TR1*TR2 TR4=TR1*TR3 TR5=TR1*TR4 B=A01-A02*TR1-A03*TR2-A04*TR3-A05*TR4 C=A06+A07*TR1+A08*TR2 D=A09+A10*TR1 E=A11+A12*TR1 F=A13*TR1 G=A14*TR3+A15*TR4+A16*TR5 H=A17*TR3+A18*TR4+A19*TR5 GH=G+H/A20 RO2=RO*RO RO3=RO*RO2 RO4=RO*RO3 RO5=RO*RO4 EEE=DEXP(-A20*RO2) HFE=B*RO+C*RO2/2+D*RO3/3+E*RO4/4+F*RO5/5 HFE=HFE-((GH+H*RO2)*EEE-GH)/2/A20 G19D06=HFE/GCU RETURN END C G20 ************************************ C * SCVRT: INTEGRAL OF * C * [(D2P/DT2)*T/RO**2]/R * C * FROM 0 TO RO * C * THE BENDER EQUATION OF STATE * C ************************************ C * RO : DENSITY [MOL/DM**3] * C * T : TEMPERATURE [K] * C * R : UNIVERSAL GAS CONSTANT * C * [BAR*DM**3/MOL/K] * C ************************************ FUNCTION G20D06(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 &/ 5.80916810D-03, 3.90114176D+00, 1.56346355D+03, & 2.28771385D+05,-9.23226900D+06, 9.55274430D-04, & -3.24453220D-01, 1.88471771D+02,-2.90188643D-05, & 3.77561217D-02, 1.40000169D-05,-1.51162922D-02, & 7.81456423D-04,-8.28179512D+04, 7.16940510D+07, & -1.53862102D+10,-5.61385455D+03, 2.14103506D+06, & 1.53532302D+08, 4.01688418D-02/ DATA R/8.3143D-02/ TR1=1.0D+00/T TR2=TR1*TR1 TR3=TR1*TR2 TR4=TR1*TR3 TR5=TR1*TR4 B2=-2*A03*TR2-6*A04*TR3-12*A05*TR4 C2=2*A08*TR2 G2=6*A14*TR3+12*A15*TR4+20*A16*TR5 H2=6*A17*TR3+12*A18*TR4+20*A19*TR5 GH2=G2+H2/A20 RO2=RO*RO EEE=DEXP(-A20*RO2) CV=B2*RO+C2*RO2/2 CV=CV-(GH2+H2*RO2)*EEE/2/A20 CV=CV+GH2/2/A20 G20D06=CV/R RETURN END C G21 ******************************************* C * ISOBARIC SPECIFIC HEAT:CPID=CP/R [-] * C * OF THE IDEAL GAS STATE * C ******************************************* FUNCTION G21D06(T) IMPLICIT DOUBLE PRECISION(B,G) DOUBLE PRECISION T DATA B1,B2,B3,B4,B5,B6 &/ 1.92865D+00, 4.65476D-02, -2.31268D-04, & 8.15814D-07, -1.21404D-09, 6.43037D-13/ G21D06=B1+(B2+(B3+(B4+(B5+B6*T)*T)*T)*T)*T RETURN END C G22 ******************************************* C * SPECIFIC ENTROPY:SID=S/R [-] * C * OF THE IDEAL GAS STATE * C ******************************************* FUNCTION G22D06(T) IMPLICIT DOUBLE PRECISION(B,G) DOUBLE PRECISION T DATA B1,B2,B3,B4,B5,B6 &/ 1.92865D+00, 4.65476D-02, -2.31268D-04, & 8.15814D-07, -1.21404D-09, 6.43037D-13/ G22D06=B1*DLOG(T)+(B2+(B3/2+(B4/3+(B5/4+B6/5*T)*T)*T)*T)*T & -0.1969971357D+02 RETURN END C G24 ******************************************* C * SPECIFIC ENTHALPY:HID=H/R [K] * C * OF THE IDEAL GAS STATE * C ******************************************* FUNCTION G24D06(T) IMPLICIT DOUBLE PRECISION(B,G) DOUBLE PRECISION T DATA B1,B2,B3,B4,B5,B6 &/ 1.92865D+00, 4.65476D-02, -2.31268D-04, & 8.15814D-07, -1.21404D-09, 6.43037D-13/ G24D06=(B1+(B2/2+(B3/3+(B4/4+(B5/5+B6/6*T)*T)*T)*T)*T)*T & -0.1715649100D+04 RETURN END C G26 ******************************************* C * SPECIFIC INTERNAL ENERGY:UID=U/R [K] * C * OF THE IDEAL GAS STATE * C ******************************************* FUNCTION G26D06(T) IMPLICIT DOUBLE PRECISION (G) DOUBLE PRECISION T G26D06=G24D06(T)-T RETURN END C G27 *** SPEED OF SOUND AT RO &TK FUNCTION G27D06(R,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) WWW=G17D06(R,TK)*G4D06(R,TK)/G16D06(R,TK)*1.0D+05/44.097D+00 G27D06=DSQRT(WWW) RETURN END C G28 *** LOCAL ADIABATIC EXPONENT AT R, TK &P FUNCTION G28D06(R,TK,P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) G28D06=G17D06(R,TK)*G4D06(R,TK)/G16D06(R,TK)*R/P RETURN END C G29 *** SURFACE TENSION AT T FUNCTION G29D06(T) TK=T+273.15 TR=1E0-TK/369.85 SIG1=TR**1.1982 SIG=49.9052E-03*SIG1 IF (SIG.LT.1E-7) SIG=0 G29D06=SIG RETURN END C G30 *** LAPLACE COEFFICIENT AT T(II=1) OR P(II=2) FUNCTION G30D06(TP,II) IMPLICIT DOUBLE PRECISION (Y) DATA W/4.4097E+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (II.EQ.1) THEN YT=DBLE(TP+273.15) CALL S1D06(YT,YP,YRL,YRG) ELSE YP=DBLE(TP) CALL S3D06(YP,YT,YRL,YRG) ENDIF RV=REAL(YRL-YRG)*W T=REAL(YT)-273.15 SIG=G29D06(T) G30D06=SQRT(SIG/RV/9.80665) RETURN END C S10 *** T,V,S & U AT P & H SUBROUTINE S10D06(P,H,T,V,S,U) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCMAX,PCMIN/42.597D+00,42.51D+00/ DATA TCMAX,TCMIN/369.90D+00,369.60D+00/ DATA W/4.4097D+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (P.LT.0.07671D+00) GOTO 999 IF (P.GT.1.0D+03) GOTO 999 TMAX=300D0+273.15D0 RMAX=G5D06(P,TMAX) HMAX=G15D06(RMAX,TMAX,P) IF (H.GT.HMAX) GOTO 999 TMIN=-85D0+273.15D0 RMIN=G5D06(P,TMIN) HMIN=G15D06(RMIN,TMIN,P) IF (H.LT.HMIN) GOTO 999 IF (P.GE.0.07671D+00 .AND. P.LE.PCMIN) THEN CALL S3D06(P,T,RL,RG) HL=G15D06(RL,T,P) HG=G15D06(RG,T,P) IF (H.LT.HL) THEN TA=T TB=TMIN ELSEIF (H.LE.HG) THEN VG=1.0D+00/(RG*W) VL=1.0D+00/(RL*W) X=(H-HL)/(HG-HL) V=VL+X*(VG-VL) SL=G13D06(RL,T) SG=G13D06(RG,T) S=SL+X*(SG-SL) UL=G14D06(RL,T) UG=G14D06(RG,T) U=UL+X*(UG-UL) RETURN ELSE TA=TMAX TB=T ENDIF ELSEIF (P.LT.PCMAX .AND. P.GT.PCMIN) THEN RMAX=G5D06(P,TCMAX) HMAX=G15D06(RMAX,TCMAX,P) IF (H.GT.HMAX) THEN TA=TMAX TB=TCMAX ELSE RMIN=G5D06(P,TCMIN) HMIN=G15D06(RMIN,TCMIN,P) IF (H.LT.HMIN) THEN TA=TCMIN TB=TMIN ELSE GOTO 999 ENDIF ENDIF ELSE TA=TMAX TB=TMIN ENDIF ILOOP=0 RA=G5D06(P,TA) RB=G5D06(P,TB) HA=G15D06(RA,TA,P) HB=G15D06(RB,TB,P) 10 ILOOP=ILOOP+1 IF (ILOOP.LE.10000) THEN DHA=H-HA DHB=H-HB T=TB+(TA-TB)*.5 R=G5D06(P,T) HC=G15D06(R,T,P) DHC=H-HC IF (DABS((HA-HB)/H).LT.1D-7) THEN V=1.0D+00/(R*W) S=G13D06(R,T) U=G14D06(R,T) RETURN ELSEIF (DHA*DHC.LE.0.0 .AND. DHB*DHC.GT.0.0) THEN TB=T HB=HC ELSEIF (DHA*DHC.GT.0.0 .AND. DHB*DHC.LE.0.0) THEN TA=T HA=HC ENDIF ELSE T=-1.0E+10 V=-1.0E+10 S=-1.0E+10 U=-1.0E+10 RETURN ENDIF GOTO 10 999 T=-1.0E+20 V=-1.0E+20 S=-1.0E+20 U=-1.0E+20 RETURN END C S11 *** T, V, H & U AT P & S SUBROUTINE S11D06(P,S,T,V,H,U) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA PCMAX,PCMIN/42.597D+00,42.51D+00/ DATA TCMAX,TCMIN/369.90D+00,369.60D+00/ DATA W/4.4097E+01/ C W: MOLECULAR WEIGHT [KG/KMOL] IF (P.LT.0.07671D+00) GOTO 999 IF (P.GT.1.0D+03) GOTO 999 TMAX=300D0+273.15D0 RMAX=G5D06(P,TMAX) SMAX=G13D06(RMAX,TMAX) IF (S.GT.SMAX) GOTO 999 TMIN=-85D0+273.15D0 RMIN=G5D06(P,TMIN) SMIN=G13D06(RMIN,TMIN) IF (S.LT.SMIN) GOTO 999 IF (P.GE.0.07671D+00 .AND. P.LE.PCMIN) THEN CALL S3D06(P,T,RL,RG) SL=G13D06(RL,T) SG=G13D06(RG,T) IF (S.LT.SL) THEN TA=T TB=TMIN ELSEIF (S.LE.SG) THEN VG=1.0D+00/(RG*W) VL=1.0D+00/(RL*W) c Modified by R.Akasaka at June 17, 1998. c X=(H-HL)/(HG-HL) X=(S-SL)/(SG-SL) V=VL+X*(VG-VL) HL=G15D06(RL,T,P) HG=G15D06(RG,T,P) H=HL+X*(HG-HL) UL=G14D06(RL,T) UG=G14D06(RG,T) U=UL+X*(UG-UL) RETURN ELSE TA=TMAX TB=T ENDIF ELSEIF (P.LT.PCMAX .AND. P.GT.PCMIN) THEN RMAX=G5D06(P,TCMAX) SMAX=G13D06(RMAX,TCMAX) IF (S.GT.SMAX) THEN TA=TMAX TB=TCMAX ELSE RMIN=G5D06(P,TCMIN) SMIN=G13D06(RMIN,TCMIN) IF (S.LT.SMIN) THEN TA=TCMIN TB=TMIN ELSE GOTO 999 ENDIF ENDIF ELSE TA=TMAX TB=TMIN ENDIF ILOOP=0 RA=G5D06(P,TA) RB=G5D06(P,TB) SA=G13D06(RA,TA) SB=G13D06(RB,TB) 10 ILOOP=ILOOP+1 IF (ILOOP.LE.10000) THEN DSA=S-SA DSB=S-SB T=TB+(TA-TB)*.5 R=G5D06(P,T) SC=G13D06(R,T) DSC=S-SC IF (DABS((SA-SB)/S).LT.1D-7) THEN V=1.0D+00/(R*W) H=G15D06(R,T,P) U=G14D06(R,T) RETURN ELSEIF (DSA*DSC.LE.0.0 .AND. DSB*DSC.GT.0.0) THEN TB=T SB=SC ELSEIF (DSA*DSC.GT.0.0 .AND. DSB*DSC.LE.0.0) THEN TA=T SA=SC ENDIF ELSE T=-1.0E+10 V=-1.0E+10 H=-1.0E+10 U=-1.0E+10 RETURN ENDIF GOTO 10 999 T=-1.0E+20 V=-1.0E+20 H=-1.0E+20 U=-1.0E+20 RETURN END C G93 *** REGION CHECK FOR FUNC(P,T) TYPE FUNCTION G93D06(P,T) INTEGER G93D06 DATA PCR,TKCR/42.597,369.90/ 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 G93D06=1 RETURN ENDIF ENDIF IF (P.GE.0.07671) THEN IF (T.GE.-85.0) THEN IF (P.LE.1000.0) THEN IF (T.LE.300.0) THEN G93D06=2 RETURN ENDIF ENDIF ENDIF ENDIF G93D06=3 RETURN END REAL FUNCTION T90(T) * Conversion of temperature scal from IPTS-68 to ITS-90 * Range -200C<=T68<=630C anf T68>=1064 REAL T68,T0K REAL*8 CA(8) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA CA/-0.14542, -0.26722, 1.06471, 1.131286, -4.25835, + -1.59924, 7.29176, -3.52573/ IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF T68=T-T0K * Check of argument range IF((-200.0.LE.T68).AND.(T68.LE.630.0)) THEN RT68=T68/630.0 TEMP=T68+RT68*(CA(1)+RT68*(CA(2)+RT68*(CA(3)+RT68*(CA(4) + +RT68*(CA(5)+RT68*(CA(6)+RT68*(CA(7)+RT68*CA(8)))))))) ELSE IF((1064.0.LE.T68).AND.(T68.LE.3000.0)) THEN TEMP=T68-0.25*(T68+273.15)*(T68+273.15)/1337.33/1337.33 ELSE IF(MESS.NE.0) WRITE(6,6020) T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT T90', & ' WHEN T68 =',1PE14.7,' ****') T90=-1.0E+20 RETURN END IF T90=TEMP+T0K RETURN END REAL FUNCTION T68(T) * Conversion of temperature scal from ITS-90 to IPTS-68 * Range -200C<=T68<=630C anf T68>=1064 T1=T90(T) T2=T ITER=0 DT=T-T1 1000 CONTINUE ITER=ITER+1 IF(ITER.GE.10000) THEN WRITE(6,*) ' ITERATION EXCEEDED MAXIMUM ' T68=-1.0E+10 RETURN END IF T2=T2+DT T1=T90(T2) DT=T-T1 IF(ABS(DT).GE.1.0E-4) GOTO 1000 T68=T2 RETURN END * Subroutine Program Specifying KPA and MESS * MS-FORTRAN and MS-C Mixed Langage Programing * SUBROUTINE KPAMES(KPAC,MESSC) COMMON/UNIT/KPA,MESS INTEGER KPAC INTEGER MESSC KPA=KPAC MESS=MESSC RETURN END