C ************************************* C * PROPATH VERSION 7.1 * C * SUPERVISOR FOR CHLORINE * C * PROGRAM UNIT D05SVP.FOR * C * VERSION 2.2 * C * CODED (DECEMBER 1988) * C * REVISED (MARCH 1990) * C * REVISED (AUGUST 1991) * C * BY * C * TOMOHIRO HONDA * C * (FUKUOKA UNIVERSITY) * C * FUKUOKA 814-01, JAPAN * 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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(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 S99D05(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL - FF = F94D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F82D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F2D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F3D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F4D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F5D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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(T) CHARACTER FUN*6 DATA FUN/'ALMPD'/ CALL S99D05(FUN) ALMPD=-1.0E+30 RETURN END C------------------------------------------------- F7 = ALMPDD REAL FUNCTION ALMPDD(T) CHARACTER FUN*6 DATA FUN/'ALMPDD'/ CALL S99D05(FUN) ALMPDD=-1.0E+30 RETURN END C------------------------------------------------- F8 = ALMPT REAL FUNCTION ALMPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'ALMPT'/ C--- SET OF UNIT -- PI=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F8D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMPT=FF RETURN END C------------------------------------------------- F9 = ALMTD REAL FUNCTION ALMTD(P) CHARACTER FUN*6 DATA FUN/'ALMTD'/ CALL S99D05(FUN) ALMTD=-1.0E+30 RETURN END C------------------------------------------------- F10 = ALMTDD REAL FUNCTION ALMTDD(P) CHARACTER FUN*6 DATA FUN/'ALMTDD'/ CALL S99D05(FUN) ALMTDD=-1.0E+30 RETURN END C------------------------------------------------- F11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FUN*6 REAL P,FF C--- FUNCTION NAME -- DATA FUN/'AMUPD'/ C--- SET OF UNIT -- PI=G98D05(P) C--- FUNCTION CALL -- FF = F11D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUPD=FF RETURN END C------------------------------------------------- F12 = AMUPDD REAL FUNCTION AMUPDD(T) CHARACTER FUN*6 DATA FUN/'AMUPDD'/ CALL S99D05(FUN) AMUPDD=-1.0E+30 RETURN END C------------------------------------------------- F13 = AMUPT REAL FUNCTION AMUPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'AMUPT'/ C--- SET OF UNIT -- PI=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F13D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUPT=FF RETURN END C------------------------------------------------- F14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'AMUTD'/ C--- SET OF UNIT -- TI=G99D05(T) C--- FUNCTION CALL -- FF = F14D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUTD=FF RETURN END C------------------------------------------------- F15 = AMUTDD REAL FUNCTION AMUTDD(P) CHARACTER FUN*6 DATA FUN/'AMUTDD'/ CALL S99D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL - FF = F90D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL - FF = F91D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL - FF = F92D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL - FF = F93D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F16D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F17D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F18D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPPT=FF RETURN END C------------------------------------------------- F19 = CPTD REAL FUNCTION CPTD(T) CHARACTER FUN*6 REAL T,FF C--- FUNCTION NAME -- DATA FUN/'CPTD'/ C--- SET OF UNIT -- TI=G99D05(T) C--- FUNCTION CALL -- FF = F19D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F20D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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 = F21D05(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 ', & ' CHLORINE WHEN A=',A,' ****') CRP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- IF(A.EQ.'T') THEN T0K=-G99D05(0.0) FF=FF+T0K ELSE IF(A.EQ.'P') THEN PBAR=G98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F76D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F77D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F78D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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 S99D05(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='70.906' WHEN A='M' C B='117.259' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=70.906 ELSE IF (A.EQ.'R') THEN FC=117.259 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR CHLORINE 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=G98D05(P) C--- FUNCTION CALL - FF = F96D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL - FF = F95D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL - FF = F97D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F23D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F24D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F71D05(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F25D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F26D05(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F27D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F28D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F29D05(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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='CHLORINE' WHEN A='S' C B='CL2' 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='CHLORINE' ELSE IF (A.EQ.'C') THEN IDENTF='CL2' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR CHLORINE 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 S99D05(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT FUNCTION PMLT(T) CHARACTER FUN*6 DATA FUN/'PMLT'/ CALL S99D05(FUN) PMLT=-1.0E+30 RETURN END C------------------------------------------------- F85 = PRPD FUNCTION PRPD(P) CHARACTER FUN*6 DATA FUN/'PRPD'/ CALL S99D05(FUN) PRPD=-1.0E+30 RETURN END C------------------------------------------------- F86 = PRPDD FUNCTION PRPDD(P) CHARACTER FUN*6 DATA FUN/'PRPDD'/ CALL S99D05(FUN) PRPDD=-1.0E+30 RETURN END C------------------------------------------------- F81 = PRPT REAL FUNCTION PRPT(P,T) CHARACTER FUN*6 REAL P,T,FF C--- FUNCTION NAME -- DATA FUN/'PRPT'/ C--- SET OF UNIT -- PI=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F81D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRPT=FF RETURN END C------------------------------------------------- F87 = PRTD FUNCTION PRTD(T) CHARACTER FUN*6 DATA FUN/'PRTD'/ CALL S99D05(FUN) PRTD=-1.0E+30 RETURN END C------------------------------------------------- F88 = PRTDD FUNCTION PRTDD(T) CHARACTER FUN*6 DATA FUN/'PRTDD'/ CALL S99D05(FUN) PRTDD=-1.0E+30 RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99D05(FUN) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F30 = PST REAL FUNCTION PST(T) CHARACTER FUN*6 REAL PBAR,T,FF C--- FUNCTION NAME -- DATA FUN/'PST'/ C--- SET OF UNIT -- PBAR=G98D05(1.0) TI=G99D05(T) C--- FUNCTION CALL -- FF = F30D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) PST=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,T,T,'T','T',FUN) PST=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PST=FF/PBAR RETURN END C------------------------------------------------- F72 = PSTD FUNCTION PSTD(T) CHARACTER FUN*6 DATA FUN/'PSTD'/ CALL S99D05(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F31D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSEIF (FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F32D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF (FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSEIF (FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F33D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F34D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F35D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F36D05(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F37D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F38D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F39D05(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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 S99D05(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP FUNCTION TMLP(P) CHARACTER FUN*6 DATA FUN/'TMLP'/ CALL S99D05(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=G98D05(P) T0K=-G99D05(0.0) C--- FUNCTION CALL -- FF = F64D05(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) TPH=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,H,'P','H',FUN) TPH=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPH=FF+T0K RETURN END C------------------------------------------------- F65 = TPS REAL FUNCTION TPS(P,S) CHARACTER FUN*6 REAL T0K,P,S,FF C--- FUNCTION NAME -- DATA FUN/'TPS'/ C--- SET OF UNIT -- PI=G98D05(P) T0K=-G99D05(T) C--- FUNCTION CALL -- FF = F65D05(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) TPS=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,S,'P','S',FUN) TPS=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPS=FF+T0K RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) C DOUBLE PRECISION F98D05 CHARACTER FUN*6 DATA FUN/'TPSEUP'/ C--- SET OF UNIT -- PI=G98D05(P) T0K=-G99D05(0.0) C--- FUNCTION CALL -- FF = F98D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) TPSEUP=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,P,'P','P',FUN) TPSEUP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPSEUP=FF+T0K RETURN END C------------------------------------------------- F70 = TPV REAL FUNCTION TPV(P,V) CHARACTER FUN*6 REAL T0K,P,V,FF C--- FUNCTION NAME -- DATA FUN/'TPV'/ C--- SET OF UNIT -- PI=G98D05(P) T0K=-G99D05(0.0) C--- FUNCTION CALL -- FF = F70D05(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) TPV=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,V,'P','V',FUN) TPV=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPV=FF+T0K RETURN END C------------------------------------------------- F41 = TRPL REAL FUNCTION TRPL(A) CHARACTER FUN*6,A*1 REAL T0K,PBAR,FF C--- FUNCTION NAME -- DATA FUN/'TRPL'/ C--- SET OF UNIT -- C--- FUNCTION CALL -- FF = F41D05(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 ', & ' CHLORINE WHEN A=',A,' ****') TRPL=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- IF(A.EQ.'T') THEN T0K=-G99D05(0.0) FF=FF+T0K ELSE IF(A.EQ.'P') THEN PBAR=G98D05(1.0) FF=FF/PBAR END IF TRPL=FF RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99D05(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=G98D05(P) T0K=-G99D05(0.0) C--- FUNCTION CALL -- FF = F40D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) TSP=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,P,'P','P',FUN) TSP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TSP=FF+T0K RETURN END C------------------------------------------------- F74 = TSPD FUNCTION TSPD(P) CHARACTER FUN*6 DATA FUN/'TSPD'/ CALL S99D05(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F42D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F43D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F79D05(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F44D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F45D05(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F46D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F47D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F48D05(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F49D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F50D05(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F80D05(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F51D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F52D05(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F53D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F54D05(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F55D05(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) TI=G99D05(T) C--- FUNCTION CALL -- FF = F83D05(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F56D05(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F57D05(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F58D05(PI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G98D05(P) C--- FUNCTION CALL -- FF = F59D05(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F60D05(TI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F61D05(TI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F62D05(TI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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=G99D05(T) C--- FUNCTION CALL -- FF = F63D05(TI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(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 **** FUNCTION G98D05(P) REAL P,G98D05 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 G98D05=REAL(DBLE(P)*PBAR) RETURN END FUNCTION G99D05(T) REAL T,G99D05 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 G99D05=REAL(DBLE(T)-T0K) RETURN END C ******* SUBROUTINE FOR ERROR MESSAGE ******* C *** LEVEL 1 ERROR MESSAGE -- SUBROUTINE S97D05(FUN) CHARACTER FLUID*8,FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FLUID/'CHLORINE'/ IF (MESS.NE.0) THEN WRITE(6,1000) FUN,FLUID 1000 FORMAT(1H ,5X,'**** NO CONVERGENCE AT ',A6,' FOR ', & A8,' ****') ENDIF RETURN END C *** LEVEL 2 ERROR MESSAGE -- SUBROUTINE S98D05(IPT,P,T,N1,N2,FUN) CHARACTER FLUID*8,FUN*6,N1*1,N2*1 REAL P,T INTEGER KPA,MESS,IPT COMMON/UNIT/KPA,MESS DATA FLUID/'CHLORINE'/ IF (MESS.NE.0) THEN IF (IPT.EQ.1) THEN C--- FUN(P) TYPE WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A8, & ' WHEN P =',1PE14.7,' ****') C--- FUN(T) TYPE ELSEIF (IPT.EQ.2) THEN WRITE(6,6020) FUN,FLUID,T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A8, & ' WHEN T =',1PE14.7,' ****') C--- FUN(P,T) TYPE ELSE WRITE(6,6030) FUN,FLUID,N1,P,N2,T 6030 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A8, & ' WHEN ',A1,'=',1PE14.7,' AND ',A1,'=',1PE14.7,' ****') ENDIF ENDIF RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99D05(FUN) CHARACTER FLUID*8,FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FLUID/'CHLORINE'/ IF (MESS.NE.0) THEN WRITE(6,1000) FUN,FLUID 1000 FORMAT(1H ,5X,'**** FUNCTION ',A6,' UNAVAILABLE FOR ', & A8,' ****') ENDIF RETURN END C ************************************** C * CL2 FUNCTION VER.1.1 * C * PRESSURE * C * TEMPERATURE * C * SPECIFIC VOLUME * C * SPECIFIC ENTROPY * C * SPECIFIC ENTHALPY * C * REVISED (MARCH 1990) * C * REVISED (AUGUST 1991) * C ************************************** C F02 + LAPLACE COEFFICIENT AT P FUNCTION F2D05(P) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 T=F40D05(P) F2D05=F3D05(T) RETURN 999 F2D05=-1.0E+20 RETURN END C F03 + LAPLACE COEFFICIENT AT T FUNCTION F3D05(T) IMPLICIT DOUBLE PRECISION (Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 SIG=G41D05(T) IF (SIG.EQ.0.0) THEN F3D05=0.0 ELSE YT=DBLE(T)+273.15D+00 CALL S1D05(YT,YP,YRL,YRG) IF (YRL.EQ.YRG) THEN F3D05=0.0 ELSE RV=REAL(YRL-YRG)*1E3 F3D05=SQRT(SIG/RV/9.80665) ENDIF ENDIF RETURN 999 F3D05=-1.0E+20 RETURN END C F04 + LATENT HEAT OF VAPORIZATION AT P FUNCTION F4D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) F4D05=REAL(G34D05(YP,YP,1.5D0,2))/70.906E-3 RETURN 999 F4D05=-1.0E+20 RETURN END C F05 + LATENT HEAT OF VAPORIZATION AT T FUNCTION F5D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) F5D05=REAL(G34D05(YT,YT,1.5D0,1))/70.906E-3 RETURN 999 F5D05=-1.0E+20 RETURN END C F08 + LUMDA AT P AND T FUNCTION F8D05(P,T) IF (ABS((P/1.01325)-1E0).GT.1E-2) GOTO 999 IF (T.LT.-80.0) GOTO 999 IF (T.GT.1200.0) GOTO 999 F8D05=(3.25+(5.8E-2+(2.1E-5-1.25E-8*T)*T)*T)*4.1868E-4 RETURN 999 F8D05=-1.0E+20 RETURN END C F11 + MYU OF SATURATED LIQUID AT P FUNCTION F11D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P)*1.0D-01 CALL S2D05(YP,YT,YRL,YRG) TK=REAL(YT) VIS=4.075E-7*TK*TK-8.065E-4*TK+151.4E0/TK-0.7681 F11D05=10.0**VIS*1E-3 RETURN 999 F11D05=-1.0E+20 RETURN END C F13 + MYU AT P AND T FUNCTION F13D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) IF (ABS((P/1.01325)-1E0).GT.1E-2) GOTO 999 IF (T.LT.-200.0) GOTO 999 IF (T.GT.1200.0) GOTO 999 TK=T+273.15 F13D05=(5.175+(45.69E-2-88.54E-6*TK)*TK)*1E-7 RETURN 999 F13D05=-1.0E+20 RETURN END C F14 + MYU OF SATURATED LIQUID AT T FUNCTION F14D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 TK=T+273.15 VIS=4.075E-7*TK*TK-8.065E-4*TK+151.4E0/TK-0.7681 F14D05=10.0**VIS*1E-3 RETURN 999 F14D05=-1.0E+20 RETURN END C F16 + CP OF SATURATED LIQUID AT P FUNCTION F16D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.9132) GOTO 999 YP=DBLE(P*0.1) F16D05=REAL(G38D05(YP,YP,2,2))/70.906E-3 RETURN 999 F16D05=-1.0E+20 RETURN END C F17 + CP OF SATURATED VAPOUR AT P FUNCTION F17D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.9132) GOTO 999 YP=DBLE(P*0.1) F17D05=REAL(G38D05(YP,YP,2,1))/70.906E-3 RETURN 999 F17D05=-1.0E+20 RETURN END C F18 + CP AT P AND T FUNCTION F18D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IG93=G93D05(P,T) IF (IG93.EQ.2) THEN YT=DBLE(T)+273.15D+00 YP=DBLE(P)*1.0D-01 YRO=G13D05(YP,YT) F18D05=REAL(G31D05(YRO,YT))/70.906E-3 ELSEIF (IG93.EQ.4) THEN YT=DBLE(T)+273.15D+00 F18D05=REAL(G26D05(YT))/70.906E-3 ELSE F18D05=-1.0E+20 ENDIF RETURN END C F19 + CP OF SATURATED LIQUID AT T FUNCTION F19D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.8018) GOTO 999 YT=DBLE(T+273.15) F19D05=REAL(G38D05(YT,YT,1,2))/70.906E-3 RETURN 999 F19D05=-1.0E+20 RETURN END C F20 + CP OF SATURATED VAPOUR AT T FUNCTION F20D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.8018) GOTO 999 YT=DBLE(T+273.15) F20D05=REAL(G38D05(YT,YT,1,1))/70.906E-3 RETURN 999 F20D05=-1.0E+20 RETURN END C F21 + CRITICAL POINT FUNCTION F21D05(A) CHARACTER*1 A IF (A.EQ.'H') THEN F21D05=-81.188E3 ELSEIF (A.EQ.'P') THEN F21D05=79.914 ELSEIF (A.EQ.'S') THEN F21D05=-632.74 ELSEIF (A.EQ.'T') THEN F21D05=143.806 ELSEIF (A.EQ.'V') THEN F21D05=1.7337E-3 ELSE F21D05=-1.0E+20 ENDIF RETURN END C F23 + H OF SATURATED LIQUID AT P FUNCTION F23D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) F23D05=REAL(G34D05(YP,YP,-2.5D0,2))/70.906E-3 RETURN 999 F23D05=-1.0E+20 RETURN END C F24 + H OF SATURATED VAPOUR AT P FUNCTION F24D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) F24D05=REAL(G34D05(YP,YP,-1.5D0,2))/70.906E-3 RETURN 999 F24D05=-1.0E+20 RETURN END C F25 + H AT P AND T FUNCTION F25D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IG93=G93D05(P,T) IF (IG93.LE.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YRO=G13D05(YP,YT) F25D05=G29D05(YRO,YT,YP)/70.906E-3 ELSEIF (IG93.EQ.4) THEN YT=DBLE(T+273.15) F25D05=G23D05(YT)/70.906E-3 ELSE F25D05=-1.0E+20 ENDIF RETURN END C F26 + H OF MIXTURE AT P FUNCTION F26D05(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P*0.1) YX=DBLE(X) F26D05=REAL(G34D05(YP,YP,YX,2))/70.906E-3 RETURN 999 F26D05=-1.0E+20 RETURN END C F27 + H OF SATURATED LIQUID AT T FUNCTION F27D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) F27D05=REAL(G34D05(YT,YT,-2.5D0,1))/70.906E-3 RETURN 999 F27D05=-1.0E+20 RETURN END C F28 + H OF SATURATED VAPOUR AT T FUNCTION F28D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) F28D05=REAL(G34D05(YT,YT,-1.5D0,1))/70.906E-3 RETURN 999 F28D05=-1.0E+20 RETURN END C F29 + H OF MIXTURE AT T FUNCTION F29D05(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YX=DBLE(X) F29D05=REAL(G34D05(YT,YT,YX,1))/70.906E-3 RETURN 999 F29D05=-1.0E+20 RETURN END C F30 + SATURATION PRESSURE AT T FUNCTION F30D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) CALL S1D05(YT,YP,YRL,YRG) F30D05=REAL(YP)*1E1 RETURN 999 F30D05=-1.0E+20 RETURN END C F31 + SURFACE TENSION AT P FUNCTION F31D05(P) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 T=F40D05(P) F31D05=G41D05(T) RETURN 999 F31D05=-1.0E+20 RETURN END C F32 + SURFACE TENSION AT T FUNCTION F32D05(T) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 F32D05=G41D05(T) RETURN 999 F32D05=-1.0E+20 RETURN END C F33 + S OF SATURATED LIQUID AT P FUNCTION F33D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) F33D05=REAL(G35D05(YP,YP,-2.5D0,2))/70.906E-3 RETURN 999 F33D05=-1.0E+20 RETURN END C F34 + S OF SATURATED VAPOUR AT P FUNCTION F34D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) F34D05=REAL(G35D05(YP,YP,-1.5D0,2))/70.906E-3 RETURN 999 F34D05=-1.0E+20 RETURN END C F35 + S AT P AND T FUNCTION F35D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IG93=G93D05(P,T) IF (IG93.LE.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YRO=G13D05(YP,YT) F35D05=REAL(G27D05(YRO,YT))/70.906E-3 ELSE F35D05=-1.0E+20 ENDIF RETURN END C F36 + S OF MIXTURE AT P FUNCTION F36D05(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P*0.1) YX=DBLE(X) F36D05=REAL(G35D05(YP,YP,YX,2))/70.906E-3 RETURN 999 F36D05=-1.0E+20 RETURN END C F37 + S OF SATURATED LIQUID AT T FUNCTION F37D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) F37D05=REAL(G35D05(YT,YT,-2.5D0,1))/70.906E-3 RETURN 999 F37D05=-1.0E+20 RETURN END C F38 + S OF SATURATED VAPOUR AT T FUNCTION F38D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) F38D05=REAL(G35D05(YT,YT,-1.5D0,1))/70.906E-3 RETURN 999 F38D05=-1.0E+20 RETURN END C F39 + S OF MIXTURE AT T FUNCTION F39D05(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YX=DBLE(X) F39D05=REAL(G35D05(YT,YT,YX,1))/70.906E-3 RETURN 999 F39D05=-1.0E+20 RETURN END C F40 + SATURATION TEMPERATURE AT P FUNCTION F40D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) CALL S2D05(YP,YT,YRL,YRG) F40D05=REAL(YT)-273.15 RETURN 999 F40D05=-1.0E+20 RETURN END C F41 + TRIPLE POINT FUNCTION F41D05(A) CHARACTER*1 A IF (A.EQ.'P') THEN F41D05=1.387E-2 ELSEIF (A.EQ.'T') THEN F41D05=-100.980 ELSE F41D05=-1.0E+20 ENDIF RETURN END C F42 + U OF SATURATED LIQUID AT P FUNCTION F42D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) F42D05=REAL(G36D05(YP,YP,-2.5D0,2))/70.906E-3 RETURN 999 F42D05=-1.0E+20 RETURN END C F43 + U OF SATURATED VAPOUR AT P FUNCTION F43D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) F43D05=REAL(G36D05(YP,YP,-1.5D0,2))/70.906E-3 RETURN 999 F43D05=-1.0E+20 RETURN END C F44 + U AT P AND T FUNCTION F44D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IG93=G93D05(P,T) IF (IG93.LE.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YRO=G13D05(YP,YT) F44D05=REAL(G28D05(YRO,YT))/70.906E-3 ELSEIF (IG93.EQ.4) THEN YT=DBLE(T+273.15) F44D05=REAL(G24D05(YT))/70.906E-3 ELSE F44D05=-1.0E+20 ENDIF RETURN END C F45 + U OF MIXTURE AT P FUNCTION F45D05(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P*0.1) YX=DBLE(X) F45D05=REAL(G36D05(YP,YP,YX,2))/70.906E-3 RETURN 999 F45D05=-1.0E+20 RETURN END C F46 + U OF SATURATED LIQUID AT T FUNCTION F46D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) F46D05=REAL(G36D05(YT,YT,-2.5D0,1))/70.906E-3 RETURN 999 F46D05=-1.0E+20 RETURN END C F47 + U OF SATURATED VAPOUR AT T FUNCTION F47D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) F47D05=REAL(G36D05(YT,YT,-1.5D0,1))/70.906E-3 RETURN 999 F47D05=-1.0E+20 RETURN END C F48 + U OF MIXTURE AT T FUNCTION F48D05(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YX=DBLE(X) F48D05=REAL(G36D05(YT,YT,YX,1))/70.906E-3 RETURN 999 F48D05=-1.0E+20 RETURN END C F49 + V OF SATURATED LIQUID AT P FUNCTION F49D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) CALL S2D05(YP,YT,YRL,YRG) F49D05=1E-3/REAL(YRL)/70.906 RETURN 999 F49D05=-1.0E+20 RETURN END C F50 + V OF SATURATED GAS AT P FUNCTION F50D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) CALL S2D05(YP,YT,YRL,YRG) F50D05=1E-3/REAL(YRG)/70.906 RETURN 999 F50D05=-1.0E+20 RETURN END C F51 + V AT P AND T FUNCTION F51D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IG93=G93D05(P,T) IF (IG93.LE.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) F51D05=1E-3/REAL(G13D05(YP,YT))/70.906 ELSE F51D05=-1.0E+20 ENDIF RETURN END C F52 + V OF MIXTURE AT P FUNCTION F52D05(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P*0.1) CALL S2D05(YP,YT,YRL,YRG) VG=1E-3/REAL(YRG)/70.906 VL=1E-3/REAL(YRL)/70.906 F52D05=VL+X*(VG-VL) RETURN 999 F52D05=-1.0E+20 RETURN END C F53 + V OF SATURATED LIQUID AT T FUNCTION F53D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) CALL S1D05(YT,YP,YRL,YRG) F53D05=1E-3/REAL(YRL)/70.906 RETURN 999 F53D05=-1.0E+20 RETURN END C F54 + V OF SATURATED GAS AT T FUNCTION F54D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) CALL S1D05(YT,YP,YRL,YRG) F54D05=1E-3/REAL(YRG)/70.906 RETURN 999 F54D05=-1.0E+20 RETURN END C F55 + V OF MIXTURE AT T FUNCTION F55D05(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) CALL S1D05(YT,YP,YRL,YRG) VL=1E-3/REAL(YRL)/70.906 VG=1E-3/REAL(YRG)/70.906 F55D05=VL+X*(VG-VL) RETURN 999 F55D05=-1.0E+20 RETURN END C F56 + DRYNESS FRACTION <-> AT P,H FUNCTION F56D05(P,H) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.9132) GOTO 999 YP=DBLE(P*0.1) HD=REAL(G34D05(YP,YP,-2.5D0,2))/70.906E-3 HDD=REAL(G34D05(YP,YP,-1.5D0,2))/70.906E-3 IF (H.LT.HD .OR. H.GT.HDD) GOTO 999 F56D05=(H-HD)/(HDD-HD) RETURN 999 F56D05=-1.0E+20 RETURN END C F57 + DRYNESS FRACTION <-> AT P,S FUNCTION F57D05(P,S) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.9132) GOTO 999 YP=DBLE(P*0.1) SD=REAL(G35D05(YP,YP,-2.5D0,2))/70.906E-3 SDD=REAL(G35D05(YP,YP,-1.5D0,2))/70.906E-3 IF (S.LT.SD .OR. S.GT.SDD) GOTO 999 F57D05=(S-SD)/(SDD-SD) RETURN 999 F57D05=-1.0E+20 RETURN END C F58 + DRYNESS FRACTION <-> AT P,U FUNCTION F58D05(P,U) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.9132) GOTO 999 YP=DBLE(P*0.1) UD=REAL(G36D05(YP,YP,-2.5D0,2))/70.906E-3 UDD=REAL(G36D05(YP,YP,-1.5D0,2))/70.906E-3 IF (U.LT.UD .OR. U.GT.UDD) GOTO 999 F58D05=(U-UD)/(UDD-UD) RETURN 999 F58D05=-1.0E+20 RETURN END C F59 + DRYNESS FRACTION <-> AT P,V FUNCTION F59D05(P,V) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.9132) GOTO 999 YP=DBLE(P*0.1) CALL S2D05(YP,YT,YRL,YRG) VL=1E-3/REAL(YRL)/70.906 VG=1E-3/REAL(YRG)/70.906 IF (V.LT.VL .OR. V.GT.VG) GOTO 999 F59D05=(V-VL)/(VG-VL) RETURN 999 F59D05=-1.0E+20 RETURN END C F60 + DRYNESS FRACTION <-> AT T,H FUNCTION F60D05(T,H) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.8018) GOTO 999 YT=DBLE(T+273.15) HD=REAL(G34D05(YT,YT,-2.5D0,1))/70.906E-3 HDD=REAL(G34D05(YT,YT,-1.5D0,1))/70.906E-3 IF (H.LT.HD .OR. H.GT.HDD) GOTO 999 F60D05=(H-HD)/(HDD-HD) RETURN 999 F60D05=-1.0E+20 RETURN END C F61 + DRYNESS FRACTION <-> AT T,S FUNCTION F61D05(T,S) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.8018) GOTO 999 YT=DBLE(T+273.15) SD=REAL(G35D05(YT,YT,-2.5D0,1))/70.906E-3 SDD=REAL(G35D05(YT,YT,-1.5D0,1))/70.906E-3 IF (S.LT.SD .OR. S.GT.SDD) GOTO 999 F61D05=(S-SD)/(SDD-SD) RETURN 999 F61D05=-1.0E+20 RETURN END C F62 + DRYNESS FRACTION <-> AT T,U FUNCTION F62D05(T,U) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.8018) GOTO 999 YT=DBLE(T+273.15) UD=REAL(G36D05(YT,YT,-2.5D0,1))/70.906E-3 UDD=REAL(G36D05(YT,YT,-1.5D0,1))/70.906E-3 IF (U.LT.UD .OR. U.GT.UDD) GOTO 999 F62D05=(U-UD)/(UDD-UD) RETURN 999 F62D05=-1.0E+20 RETURN END C F63 + DRYNESS FRACTION <-> AT T,V FUNCTION F63D05(T,V) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.8018) GOTO 999 YT=DBLE(T+273.15) CALL S1D05(YT,YP,YRL,YRG) VL=1E-3/REAL(YRL)/70.906 VG=1E-3/REAL(YRG)/70.906 IF (V.LT.VL .OR. V.GT.VG) GOTO 999 F63D05=(V-VL)/(VG-VL) RETURN 999 F63D05=-1.0E+20 RETURN END C F64 + TEMPERATURE AT P AND H FUNCTION F64D05(P,H) DOUBLE PRECISION PP,HH,TT,RR,SS,UU PP=DBLE(P*0.1) HH=DBLE(H)*70.906D-3 CALL S4D05(PP,HH,TT,RR,SS,UU) T=REAL(TT) IF (T.GE.-1.0) THEN F64D05=T-273.15 ELSE F64D05=T ENDIF RETURN END C F65 + TEMPERATURE AT P AND S FUNCTION F65D05(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH,UU PP=DBLE(P*0.1) SS=DBLE(S)*70.906D-3 CALL S5D05(PP,SS,TT,RR,HH,UU) T=REAL(TT) IF (T.GE.-1.0) THEN F65D05=T-273.15 ELSE F65D05=T ENDIF RETURN END C F70 + TEMPERATURE AT P AND V FUNCTION F70D05(P,V) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P*0.1) YR=1D-3/DBLE(V)/70.906D0 T=REAL(G16D05(YP,YR)) IF (T.GE.-1.0) THEN F70D05=T-273.15 ELSE F70D05=T ENDIF RETURN END C F71 + H AT P AND S FUNCTION F71D05(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH,UU PP=DBLE(P*0.1) SS=DBLE(S)*70.906D-3 CALL S5D05(PP,SS,TT,RR,HH,UU) H=REAL(HH) IF (H.GE.-1E8) THEN F71D05=H/70.906E-3 ELSE F71D05=H ENDIF RETURN END C FA1 + CV OF SATURATED LIQUID AT P FUNCTION FA1D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) FA1D05=REAL(G37D05(YP,YP,2,2))/70.906E-3 RETURN 999 FA1D05=-1.0E+20 RETURN END C F76 + CV OF SATURATED VAPOUR AT P FUNCTION F76D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.914) GOTO 999 YP=DBLE(P*0.1) F76D05=REAL(G37D05(YP,YP,2,1))/70.906E-3 RETURN 999 F76D05=-1.0E+20 RETURN END C F77 + CV AT P AND T FUNCTION F77D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IG93=G93D05(P,T) IF (IG93.LE.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YRO=G13D05(YP,YT) F77D05=REAL(G30D05(YRO,YT))/70.906E-3 ELSEIF (IG93.EQ.4) THEN YT=DBLE(T+273.15) F77D05=REAL(G26D05(YT)-8.31434D0)/70.906E-3 ELSE F77D05=-1.0E+20 ENDIF RETURN END C FA2 + CV OF SATURATED LIQUID AT T FUNCTION FA2D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) FA2D05=REAL(G37D05(YT,YT,1,2))/70.906E-3 RETURN 999 FA2D05=-1.0E+20 RETURN END C F78 + CV OF SATURATED VAPOUR AT T FUNCTION F78D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.806) GOTO 999 YT=DBLE(T+273.15) F78D05=REAL(G37D05(YT,YT,1,1))/70.906E-3 RETURN 999 F78D05=-1.0E+20 RETURN END C F79 + U AT P AND S FUNCTION F79D05(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH,UU PP=DBLE(P*0.1) SS=DBLE(S)*70.906E-3 CALL S5D05(PP,SS,TT,RR,HH,UU) U=REAL(UU) IF (U.GE.-1E8) THEN F79D05=U/70.906E-3 ELSE F79D05=U ENDIF RETURN END C F80 + V AT P AND S FUNCTION F80D05(P,S) DOUBLE PRECISION PP,SS,TT,RR,HH,UU PP=DBLE(P*0.1) SS=DBLE(S)*70.906E-3 CALL S5D05(PP,SS,TT,RR,HH,UU) R=REAL(RR) IF (R.GE.-1E8) THEN F80D05=1E-3/R/70.906 ELSE F80D05=R ENDIF RETURN END C F81 + PRANDTL NUMBER AT P AND T FUNCTION F81D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) AP=ABS(P/1.01325-1.0) IF (AP.GT.1E-2) GOTO 999 IF (T.LT.-80.0) GOTO 999 IF (T.GT.626.8501) GOTO 999 F81D05=F18D05(P,T)*F13D05(P,T)/F8D05(P,T) RETURN 999 F81D05=-1.0E+20 RETURN END C F82 + ADIABATIC EXPONENT AT P AND T FUNCTION F82D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IG93=G93D05(P,T) IF (IG93.LE.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YRO=G13D05(YP,YT) F82D05=REAL(G33D05(YRO,YT,YP)) ELSEIF (IG93.EQ.4) THEN YT=DBLE(T+273.15) F82D05=1D0/(1D0-8.31434D0/G26D05(YT)) ELSE F82D05=-1.0E+20 ENDIF RETURN END C F83 + SPEED OF SOUND AT P AND T FUNCTION F83D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 DATA RMOL,AMMOL/8.31434E+00,70.906E-03/ IG93=G93D05(P,T) IF (IG93.LE.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YRO=G13D05(YP,YT) F83D05=REAL(G32D05(YRO,YT)) ELSEIF (IG93.EQ.4) THEN YT=DBLE(T+273.15) WSD=RMOL*YT/(1D0-RMOL/G26D05(YT))/AMMOL F83D05=SQRT(WSD) ELSE F83D05=-1.0E+20 ENDIF RETURN END C F90 + BSPT<1/PA> AT P AND T FUNCTION F90D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IG93=G93D05(P,T) IF (IG93.LE.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YRO=G13D05(YP,YT) VV=1E-3/REAL(G13D05(YP,YT))/70.906 SS=REAL(G32D05(YRO,YT)) F90D05=VV/SS**2 ELSE F90D05=-1.0E+20 ENDIF RETURN END C F91 + BTPT<1/PA> AT P AND T FUNCTION F91D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IF (G93D05(P,T).EQ.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YR=G13D05(YP,YT) DPDR=REAL(G3D05(YR,YT)) F91D05=1.0E-06/REAL(YR)/DPDR ELSE F91D05=-1.0E+20 ENDIF RETURN END C F92 + BPPT<1/K> AT P AND T FUNCTION F92D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IF (G93D05(P,T).EQ.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YR=G13D05(YP,YT) F92D05=REAL(G5D05(YR,YT)/YR/G3D05(YR,YT)) ELSE F92D05=-1.0E+20 ENDIF RETURN END C F93 + BVPT<1/K> AT P AND T FUNCTION F93D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IF (G93D05(P,T).LE.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YR=G13D05(YP,YT) F93D05=REAL(G5D05(YR,YT)/YP) ELSE F93D05=-1.0E+20 ENDIF RETURN END C F94 + AJTPT AT P AND T FUNCTION F94D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IG93=G93D05(P,T) IF (IG93.LE.2) THEN YP=DBLE(P*0.1) YT=DBLE(T+273.15) YR=G13D05(YP,YT) YY=YT*G5D05(YR,YT)/YR/G3D05(YR,YT)-1.0D+00 F94D05=REAL(YY/YR/G31D05(YR,YT))*70.906E-09 ELSE F94D05=-1.0E+20 ENDIF RETURN END C F95 + RATIO OF SPECIFIC HEATS AT P AND T FUNCTION F95D05(P,T) IMPLICIT DOUBLE PRECISION (G,Y) INTEGER G93D05 IG93=G93D05(P,T) IF (IG93.EQ.2) THEN YT=DBLE(T)+273.15D+00 YP=DBLE(P)*1.0D-01 YRO=G13D05(YP,YT) F95D05=REAL(G31D05(YRO,YT)/G30D05(YRO,YT)) ELSEIF (IG93.EQ.4) THEN YT=DBLE(T)+273.15D+00 YCPMOL=G26D05(YT) F95D05=REAL(YCPMOL/(YCPMOL-8.31434D0)) ELSE F95D05=-1.0E+20 ENDIF RETURN END C F96 + RATIO OF SPECIFIC HEATS OF SATURATED VAPOUR AT P FUNCTION F96D05(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT.1.387E-2 .OR. P.GT.79.9132) GOTO 999 YP=DBLE(P*0.1) CALL S2D05(YP,YT,YRL,YRG) F96D05=REAL(G31D05(YRG,YT)/G30D05(YRG,YT)) RETURN 999 F96D05=-1.0E+20 RETURN END C F97 + RATIO OF SPECIFIC HEATS OF SATURATED VAPOUR AT T FUNCTION F97D05(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-100.980 .OR. T.GT.143.8018) GOTO 999 YT=DBLE(T+273.15) CALL S1D05(YT,YP,YRL,YRG) F97D05=REAL(G31D05(YRG,YT)/G30D05(YRG,YT)) RETURN 999 F97D05=-1.0E+20 RETURN END C F98 + PSEUDO BOILING POINT AT P FUNCTION F98D05(P) DIMENSION T(2),C(2),TL(3),TR(3),CL(3),CR(3) P1=F21D05('P') PP=ABS((P-P1)/P1) T1=F21D05('T') IF (PP.LT.1.0D-5) THEN F98D05=T1 RETURN ENDIF IF (P.LT.P1.OR.P.GT.1000.001D00) THEN F98D05=-1.0E+20 RETURN ENDIF T2=0.85*T1 P2=F30D05(T2) TM0=T1+(T1-T2)*(P-P1)/(P1-P2) C-----TM0 KINJICHI TC=T1 T(1)=TM0 IF (P.LT.180.0) GO TO 150 T(1)=0.542*P+100.0 150 EPS=1.0D-7 DEL=T1*0.05D00 IREP=0 IREM=5000 KCONT=0 ICONT=0 C(1)=F18D05(P,T(1)) T(2)=T(1)-DEL C(2)=F18D05(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)=F18D05(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=-F18D05(P,TT) 3000 CONV=ABS((CC-C(2))/CC) IF(CONV.LT.EPS) THEN F98D05=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=-F18D05(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=F18D05(P,TA) CB=F18D05(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=F18D05(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)=F18D05(P,TL(2)) CR(2)=F18D05(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=F18D05(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=F18D05(P,TB) ELSE TB=TR(MR+1) CB=CR(MR+1) ENDIF 6135 TC=TR(MR) CC=CR(MR) ENDIF GO TO 6050 7000 F98D05=TC RETURN 8000 F98D05=-1.0E+10 RETURN END C ****************************************** C * CL2PROP:VER.1.1 * C * PRESSURE P * C * TEMPERATURE T,TK * C * DENSITY R,RO * C * ENTHALPY H * C * ENTROPY S * C * REVISED (MARCH 1990) * C * REVISED (AUGUST 1991) * C ****************************************** C G01 *** PRESSURE AT R & TK *** FUNCTION G1D05(R,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON,TC,RC/8.31434D0,416.956D0,8.1345D-3/ W=R/RC T=TC/TK IF (DABS(W-1D0).LT.1D-5 .AND. DABS(T-1D0).LT.1D-5) THEN G1D05=7.9914D0 ELSE G1D05=R*GASCON*TK*G2D05(W,T) ENDIF RETURN END C G02 *** SUMMATION OF N(I)*X(I) *** FUNCTION G2D05(W,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09, & C10,C11,C12,C13,C14,C15,C16,C17,C18 & / 2.084186556D0 , 1.602205227D-1,-3.472905370D0, & 7.309167992D-1, 1.522615555D-1,-4.160803958D-1, & 2.795563934D-1, 1.680093781D-2,-7.193406570D-2, & 3.286861325D-3, 9.492028988D-5,-3.516743265D-1, & -1.571792260D-1, 1.648268896D-2,-5.581295212D-3, & 1.484372497D-3,-4.524817187D-3, 3.441082765D-3/ W2=W*W W4=W2*W2 T2=T*T T3=T2*T T4=T3*T T5=T4*T TSQ=DSQRT(T) T1B4=DSQRT(TSQ) T5B4=T*T1B4 T7B4=T5B4*TSQ SUM=C11*W2*T3+C10*T4 SUM=W2*SUM+C09*T4+C08*T2 SUM=W2*SUM+C07*T4 SUM=W*(W*SUM+C06*T+C05*T4+C04*T5B4) SUM=W*(SUM+C03*T7B4+C02*T4+C01*T5B4) SUM1=SUM SUM=C18+C17*T+C16*T2 SUM=W2*(W2*SUM+C15)+C14*T SUM=W2*SUM+C13*T2 SUM=(W4*SUM+C12)*W4*T3/DEXP(W2) G2D05=1D0+SUM1+SUM RETURN END C G03 *** DP/DR AT R0 & T *** FUNCTION G3D05(R,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON,TC,RC/8.31434D0,416.956D0,8.1345D-3/ W=R/RC T=TC/TK G3D05=GASCON*TK*G4D05(W,T) RETURN END C G04 *** SUMMATION OF N(I)*XRO(I) *** FUNCTION G4D05(W,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09, & C10,C11,C12,C13,C14,C15,C16,C17,C18 & / 2.084186556D0 , 1.602205227D-1,-3.472905370D0, & 7.309167992D-1, 1.522615555D-1,-4.160803958D-1, & 2.795563934D-1, 1.680093781D-2,-7.193406570D-2, & 3.286861325D-3, 9.492028988D-5,-3.516743265D-1, & -1.571792260D-1, 1.648268896D-2,-5.581295212D-3, & 1.484372497D-3,-4.524817187D-3, 3.441082765D-3/ W2=W*W W4=W2*W2 T2=T*T T3=T2*T T4=T3*T T5=T4*T TSQ=DSQRT(T) T1B4=DSQRT(TSQ) T5B4=T*T1B4 T7B4=T5B4*TSQ SUM=10*C11*W2*T3+8*C10*T4 SUM=W2*SUM+6*(C09*T4+C08*T2) SUM=W2*SUM+4*C07*T4 SUM=W*(W*SUM+3*(C06*T+C05*T4+C04*T5B4)) SUM=W*(SUM+2*(C03*T7B4+C02*T4+C01*T5B4)) SUM1=SUM AA=2*W2 SUM=(15D0-AA)*(C18+C17*T+C16*T2) SUM=W2*(W2*SUM+(13D0-AA)*C15)+(11D0-AA)*C14*T SUM=W2*SUM+(9D0-AA)*C13*T2 SUM=(W4*SUM+(5D0-AA)*C12)*W4*T3/DEXP(W2) G4D05=1D0+SUM1+SUM RETURN END C G05 *** DP/DT AT R & T0 *** FUNCTION G5D05(R,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON,TC,RC/8.31434D0,416.956D0,8.1345D-3/ W=R/RC T=TC/TK G5D05=R*GASCON*G6D05(W,T) RETURN END C G06 *** SUMMATION OF N(I)*XT(I) *** FUNCTION G6D05(W,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C07,C08,C09, & C10,C11,C12,C13,C14,C15,C16,C17,C18 & / 2.084186556D0 , 1.602205227D-1,-3.472905370D0, & 7.309167992D-1, 1.522615555D-1, & 2.795563934D-1, 1.680093781D-2,-7.193406570D-2, & 3.286861325D-3, 9.492028988D-5,-3.516743265D-1, & -1.571792260D-1, 1.648268896D-2,-5.581295212D-3, & 1.484372497D-3,-4.524817187D-3, 3.441082765D-3/ W2=W*W W4=W2*W2 T2=T*T T3=T2*T T4=T3*T T5=T4*T TSQ=DSQRT(T) T1B4=DSQRT(TSQ) T5B4=T*T1B4 T7B4=T5B4*TSQ SUM=2*C11*W2*T3+3*C10*T4 SUM=W2*SUM+3*C09*T4+C08*T2 SUM=W2*SUM+3*C07*T4 SUM=W*(W*SUM+3*C05*T4+0.25D0*C04*T5B4) SUM=W*(SUM+0.75D0*C03*T7B4+3*C02*T4+0.25D0*C01*T5B4) SUM1=SUM SUM=2*C18+3*C17*T+4*C16*T2 SUM=W2*(W2*SUM+2*C15)+3*C14*T SUM=W2*SUM+4*C13*T2 SUM=(W4*SUM+2*C12)*W4*T3/DEXP(W2) G6D05=1D0-SUM1-SUM RETURN END C G07 *** SUMMATION OF N(I)*XU(I) *** FUNCTION G7D05(W,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09, & C10,C11,C12,C13,C14,C15,C16,C17,C18 & / 2.084186556D0 , 1.602205227D-1,-3.472905370D0, & 7.309167992D-1, 1.522615555D-1,-4.160803958D-1, & 2.795563934D-1, 1.680093781D-2,-7.193406570D-2, & 3.286861325D-3, 9.492028988D-5,-3.516743265D-1, & -1.571792260D-1, 1.648268896D-2,-5.581295212D-3, & 1.484372497D-3,-4.524817187D-3, 3.441082765D-3/ W2=W*W W4=W2*W2 W8=W4*W4 T2=T*T T3=T2*T T4=T3*T T5=T4*T TSQ=DSQRT(T) T1B4=DSQRT(TSQ) T5B4=T*T1B4 T7B4=T5B4*TSQ SUM=C11*W2*T3/9+C10*T4/7 SUM=W2*SUM+(C09*T4+C08*T2)/5 SUM=W2*SUM+C07*T4/3 SUM=W*(W*SUM+(C06*T+C05*T4+C04*T5B4)/2) SUM=W*(SUM+C03*T7B4+C02*T4+C01*T5B4) SUM1=SUM A2=W2+1 A3=W4+2*A2 A4=W2*W4+3*A3 A5=W8+4*A4 A6=W2*W8+5*A5 A7=W4*W8+6*A6 SUM=A2*C12+A4*C13*T2+A5*C14*T+A6*C15 & +A7*(C16*T2+C17*T+C18) SUM=0.5D0*SUM*T3/DEXP(W2) G7D05=SUM1-SUM RETURN END C G** *** INITIAL VALUES FOR SATURATED PROPERTIES *** C G08 *** PS AT T *** FUNCTION G8D05(TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A1,A2,A3,A4,A5,A6 & /-6.385686491D0, 1.097597510D0, -5.583806522D0, & -1.019792630D0, -3.980500663D-3, 3.088457077D-3/ DATA TC,PC/416.956D0,7.9914D0/ S=TC/TK-1D0 SSQ=DSQRT(S) S1B6=S**(1D0/6D0) S1B3=S1B6*S1B6 S2=S*S S4=S2*S2 S8=S4*S4 PSLOG=A1*S+A2*S*SSQ+A3*S2+A4*S2*SSQ+A5*S8*S PSLOG=(PSLOG+A6*S8*S*SSQ)/(S+1D0) G8D05=PC*DEXP(PSLOG) RETURN END C G09 *** TS AT P *** FUNCTION G9D05(P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A1,A2,A3,A4,A5,A6 & /-6.385686491D0, 1.097597510D0, -5.583806522D0, & -1.019792630D0, -3.980500663D-3, 3.088457077D-3/ DATA TC,PC/416.956D0,7.9914D0/ IF (P.LT.0.05D0) THEN TK=200D0 ELSEIF (P.LT.0.2D0) THEN TK=250D0 ELSEIF (P.LT.2D0) THEN TK=300D0 ELSEIF (P.LT.4D0) THEN TK=350D0 ELSEIF (P.LT.6.5D0) THEN TK=400D0 ELSEIF (P.LT.7.9781D0) THEN TK=416.85D0 ELSE TA=416.956D0 TB=416.7D0 10 TM=0.5D0*(TA+TB) PA=G8D05(TA) PB=G8D05(TB) PM=G8D05(TM) DPA=P-PA DPB=P-PB DPM=P-PM IF (DABS(DPM/P).LT.1D-7) THEN G9D05=TM RETURN ELSE IF (DPA*DPM.LE.0D0 .AND. DPB*DPM.GT.0D0) THEN TA=TA TB=TM ELSEIF (DPA*DPM.GT.0D0 .AND. DPB*DPM.LE.0D0) THEN TA=TM TB=TB ENDIF GOTO 10 ENDIF ENDIF 20 S=TC/TK-1D0 SSQ=DSQRT(S) S2=S*S S4=S2*S2 S8=S4*S4 PSLOG=A1*S+A2*S*SSQ+A3*S2+A4*S2*SSQ+A5*S8*S PSLOG=PSLOG+A6*S8*S*SSQ PK=PC*DEXP(PSLOG/(S+1D0)) DPP=A1+1.5D0*A2*SSQ+2*A3*S+2.5D0*A4*S*SSQ DPP=DPP+9*A5*S8+9.5D0*A6*S8*SSQ DPKDT=PK/TC*(PSLOG-DPP*(S+1D0)) DT=(P-PK)/DPKDT IF (DABS(DT/TK).LT.1D-7) THEN G9D05=TK RETURN ELSE TK=TK+DT ENDIF GOTO 20 END C G10 *** LIQUID DENSITY AT T *** FUNCTION G10D05(TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA B1,B2,B3,B4,B5,B6,B7 & /-2.432766554D-1, 6.073392373D0, -1.550790406D1, & 2.379767692D1, -1.977802883D1, 7.011314636D0, & -3.068770784D-1/ DATA TC,RC/416.956D0,8.1345D-3/ S=TC/TK-1D0 SSQ=DSQRT(S) S1B6=S**(1D0/6D0) S1B3=S1B6*S1B6 S2=S*S RLLOG=B1*S1B3+B2*SSQ+B3*S/S1B6+B4*S*S1B6 RLLOG=RLLOG+B5*S*SSQ+B6*S2/S1B6+B7*S2*S/S1B3 G10D05=RC*DEXP(RLLOG) RETURN END C G11 *** GAS DENSITY AT T *** FUNCTION G11D05(TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C1,C2,C3,C4,C5,C6,C7 & /-3.298745208D1, 8.763645735D1, -8.260327593D1, & 2.632150078D1, -7.112939898D0, 5.977789361D0, & -3.740136501D0/ DATA TC,RC/416.956D0,8.1345D-3/ S=TC/TK-1D0 SSQ=DSQRT(S) S1B6=S**(1D0/6D0) S1B3=S1B6*S1B6 S2=S*S S3=S*S2 RGLOG=C1*S/S1B3+C2*S/S1B6+C3*S+C4*S*S1B3 RGLOG=RGLOG+C5*S2*S1B6+C6*S3+C7*S3*S1B6 G11D05=RC*DEXP(RGLOG) RETURN END C G12 *** PRESSURE BY GIBBS CONDITION *** FUNCTION G12D05(TK,RL,RG) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON,TC,RC/8.31434D0,416.956D0,8.1345D-3/ WL=RL/RC WG=RG/RC T=TC/TK SS=DLOG(RG/RL)+G7D05(WG,T)-G7D05(WL,T) G12D05=RG*RL/(RG-RL)*GASCON*TK*SS RETURN END C G13 *** RO AT P & T *** FUNCTION G13D05(P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA TC,PC/416.956D0,7.9914D0/ DELPC=DABS(P/PC-1D0) DELTC=DABS(T/TC-1D0) IF (DELPC.LT.1D-5 .AND. DELTC.LT.1D-5) THEN G13D05=0.0081345D0 RETURN ENDIF IF (T.GT.TC) THEN RMAX=0.016D0 RMIN=1D-9 ELSE CALL S1D05(T,PS,RL,RG) IF (P.GT.PS) THEN RMAX=0.0246D0 RMIN=RL ELSE RMAX=RG RMIN=1D-9 ENDIF ENDIF RST1=G14D05(RMAX,RMIN,P,T) G13D05=G15D05(P,T,RST1) RETURN END C G14 *** INITIAL VALUE FOR R(P,T)*** FUNCTION G14D05(RMAX,RMIN,P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) ILOOP=0 RA=RMAX RB=RMIN 10 PA=G1D05(RA,T) PB=G1D05(RB,T) DPA=P-PA DPB=P-PB DPAB=PA-PB RC=RB+(RA-RB)*.5 PC=G1D05(RC,T) DPC=P-PC IF (DPA*DPC.LE.0.0 .AND. DPB*DPC.GT.0.0) THEN RA=RA RB=RC ELSEIF (DPA*DPC.GT.0.0 .AND. DPB*DPC.LE.0.0) THEN RA=RC RB=RB ELSE RA=1.1*RA RB=0.9*RB ENDIF ILOOP=ILOOP+1 IF (ILOOP.LT.10000) GOTO 20 G14D05=-1E10 RETURN 20 IF (DABS(RA-RB)/RB.GT.1E-2) GOTO 10 G14D05=RC RETURN END C G15 *** RO AT P & TK BY NEWTON-METHOD (R1:INITIAL VALUE) FUNCTION G15D05(P,TK,R1) IMPLICIT DOUBLE PRECISION (A-H,O-Z) R=R1 ILOOP=0 10 ILOOP=ILOOP+1 IF (ILOOP.LT.10000) THEN PD=G1D05(R,TK) DPDRD=G3D05(R,TK) DR=(P-PD)/DPDRD IF (DABS(DR/R).LT.1D-7) THEN G15D05=R+DR RETURN ELSE R=R+DR ENDIF ELSE G15D05=-1.0E10 RETURN ENDIF GOTO 10 END C G16 *** TK AT P & RO *** FUNCTION G16D05(P,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF (P.LE.0.999999D-5 .OR. P.GT.25D0) GOTO 999 DELPC=DABS((P/7.9914D0)-1D0) DELRC=DABS((RO/8.1345D-3)-1D0) IF (DELPC.LT.1D-5 .AND. DELRC.LT.1D-5) THEN G16D05=416.956D0 RETURN ENDIF TMIN=179.999D0 TMAX=900.001D0 RMAX=G13D05(P,TMAX) RMIN=G13D05(P,TMIN) IF (RO.LT.RMAX .OR. RO.GT.RMIN) GOTO 999 ILOOP=0 IF ( P.LT.0.001387D0 .OR. P.GT.7.9914D0) GOTO 5 CALL S2D05(P,T,RL,RG) IF (RO.GT.RL) THEN TA=T TB=TMIN ELSEIF (RO.GE.RG) THEN G16D05=T RETURN ELSE TA=TMAX TB=T ENDIF GOTO 10 5 TA=TMAX TB=TMIN 10 RA=G13D05(P,TA) RB=G13D05(P,TB) DRA=RO-RA DRB=RO-RB DRAB=RA-RB T=TB+(TA-TB)*.5 RC=G13D05(P,T) DRC=RO-RC IF (DRA*DRC.LE.0.0 .AND. DRB*DRC.GT.0.0) THEN TA=TA TB=T ELSEIF (DRA*DRC.GT.0.0 .AND. DRB*DRC.LE.0.0) THEN TA=T TB=TB ENDIF ILOOP=ILOOP+1 IF (ILOOP.GT.10000) GOTO 888 IF (DABS(TA-TB)/T.GT.1D-1) GOTO 10 G16D05=G17D05(RO,P,T) RETURN 888 G16D05=-1.0E10 RETURN 999 G16D05=-1.0E20 RETURN END C G17 *** TK AT RO & P BY NEWTON METHOD (TST:INITIAL VALUE) FUNCTION G17D05(R,P,TST) IMPLICIT DOUBLE PRECISION (A-H,O-Z) TK=TST ILOOP=0 10 ILOOP=ILOOP+1 IF (ILOOP.LT.10000) THEN PD=G1D05(R,TK) DPDRD=G5D05(R,TK) DT=(P-PD)/DPDRD IF (DABS(DT/TK).LT.1D-7) THEN G17D05=TK+DT RETURN ELSE TK=TK+DT ENDIF ELSE G17D05=-1.0E10 RETURN ENDIF GOTO 10 END C G18 *** SUMMATION OF N(I)*XS(I) *** FUNCTION G18D05(W,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C07,C08,C09, & C10,C11,C12,C13,C14,C15,C16,C17,C18 & / 2.084186556D0 , 1.602205227D-1,-3.472905370D0, & 7.309167992D-1, 1.522615555D-1, & 2.795563934D-1, 1.680093781D-2,-7.193406570D-2, & 3.286861325D-3, 9.492028988D-5,-3.516743265D-1, & -1.571792260D-1, 1.648268896D-2,-5.581295212D-3, & 1.484372497D-3,-4.524817187D-3, 3.441082765D-3/ W2=W*W W4=W2*W2 W8=W4*W4 T2=T*T T3=T2*T T4=T3*T T5=T4*T TSQ=DSQRT(T) T1B4=DSQRT(TSQ) T5B4=T*T1B4 T7B4=T5B4*TSQ SUM=2*C11*W2*T3/9+3*C10*T4/7 SUM=W2*SUM+(3*C09*T4+C08*T2)/5 SUM=W2*SUM+C07*T4 SUM=W*(W*SUM+1.5D0*C05*T4+0.125D0*C04*T5B4) SUM=W*(SUM+0.75D0*C03*T7B4+3*C02*T4+0.25D0*C01*T5B4) SUM1=-SUM A2=W2+1 A3=W4+2*A2 A4=W2*W4+3*A3 A5=W8+4*A4 A6=W2*W8+5*A5 A7=W4*W8+6*A6 SUM=A2*C12+2*A4*C13*T2+1.5D0*A5*C14*T+A6*C15 & +A7*(2*C16*T2+1.5D0*C17*T+C18) SUM=SUM*T3/DEXP(W2) SIW=SUM1+SUM A2=1 A3=2*A2 A4=3*A3 A5=4*A4 A6=5*A5 A7=6*A6 SUM=A2*C12+2*A4*C13*T2+1.5D0*A5*C14*T+A6*C15 & +A7*(2*C16*T2+1.5D0*C17*T+C18) SI0=SUM*T3 G18D05=SIW-SI0 RETURN END C G19 *** SUMMATION OF N(I)*(XU-XS)(I) FUNCTION G19D05(W,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C06,C07,C08,C09, & C10,C11,C12,C13,C14,C15,C16,C17,C18 & / 2.084186556D0 , 1.602205227D-1,-3.472905370D0, & 7.309167992D-1, 1.522615555D-1,-4.160803958D-1, & 2.795563934D-1, 1.680093781D-2,-7.193406570D-2, & 3.286861325D-3, 9.492028988D-5,-3.516743265D-1, & -1.571792260D-1, 1.648268896D-2,-5.581295212D-3, & 1.484372497D-3,-4.524817187D-3, 3.441082765D-3/ W2=W*W W4=W2*W2 W8=W4*W4 T2=T*T T3=T2*T T4=T3*T T5=T4*T TSQ=DSQRT(T) T1B4=DSQRT(TSQ) T5B4=T*T1B4 T7B4=T5B4*TSQ SUM=C11*W2*T3/3+4*C10*T4/7 SUM=W2*SUM+0.4D0*(2*C09*T4+C08*T2) SUM=W2*SUM+4*C07*T4/3 SUM=W*(W*SUM+0.5D0*C06*T+2*C05*T4+0.625D0*C04*T5B4) SUM=W*(SUM+1.75D0*C03*T7B4+4*C02*T4+1.25D0*C01*T5B4) SUM1=SUM A2=W2+1 A3=W4+2*A2 A4=W2*W4+3*A3 A5=W8+4*A4 A6=W2*W8+5*A5 A7=W4*W8+6*A6 SUM=1.5D0*A2*C12+2.5D0*A4*C13*T2+2*A5*C14*T+1.5D0*A6*C15 & +A7*(2.5D0*C16*T2+2*C17*T+1.5D0*C18) SUM=SUM*T3/DEXP(W2) SIW=SUM1-SUM A2=1 A3=2*A2 A4=3*A3 A5=4*A4 A6=5*A5 A7=6*A6 SUM=1.5D0*A2*C12+2.5D0*A4*C13*T2+2*A5*C14*T+1.5D0*A6*C15 & +A7*(2.5D0*C16*T2+2*C17*T+1.5D0*C18) SI0=-SUM*T3 G19D05=SIW-SI0 RETURN END C G20 *** SUMMATION OF N(I)*XC(I) FUNCTION G20D05(W,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C01,C02,C03,C04,C05,C07,C08,C09, & C10,C11,C12,C13,C14,C15,C16,C17,C18 & / 2.084186556D0 , 1.602205227D-1,-3.472905370D0, & 7.309167992D-1, 1.522615555D-1, & 2.795563934D-1, 1.680093781D-2,-7.193406570D-2, & 3.286861325D-3, 9.492028988D-5,-3.516743265D-1, & -1.571792260D-1, 1.648268896D-2,-5.581295212D-3, & 1.484372497D-3,-4.524817187D-3, 3.441082765D-3/ W2=W*W W4=W2*W2 W8=W4*W4 T2=T*T T3=T2*T T4=T3*T T5=T4*T TSQ=DSQRT(T) T1B4=DSQRT(TSQ) T5B4=T*T1B4 T7B4=T5B4*TSQ SUM=2*C11*W2*T3/3+12*C10*T4/7 SUM=W2*SUM+0.4D0*(6*C09*T4+C08*T2) SUM=W2*SUM+4*C07*T4 SUM=W*(W*SUM+6*C05*T4+5*C04*T5B4/32) SUM=W*(SUM+21*C03*T7B4/16+12*C02*T4+5*C01*T5B4/16) SUM1=SUM A2=W2+1 A3=W4+2*A2 A4=W2*W4+3*A3 A5=W8+4*A4 A6=W2*W8+5*A5 A7=W4*W8+6*A6 SUM=3*A2*C12+10*A4*C13*T2+6*A5*C14*T+3*A6*C15 & +A7*(10*C16*T2+6*C17*T+3*C18) SUM=SUM*T3/DEXP(W2) SIW=SUM1-SUM A2=1 A3=2*A2 A4=3*A3 A5=4*A4 A6=5*A5 A7=6*A6 SUM=3*A2*C12+10*A4*C13*T2+6*A5*C14*T+3*A6*C15 & +A7*(10*C16*T2+6*C17*T+3*C18) SI0=-SUM*T3 G20D05=SIW-SI0 RETURN END C G** *** IDEAL GAS PROPERTIES C G21 *** ENTROPY FUNCTION G21D05(TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON,TC/8.31434D0,416.956D0/ TU=TC/TK TL=TC/298.15D0 SUM=G22D05(TU)-G22D05(TL) G21D05=GASCON*SUM RETURN END C G22 *** SID/GASCON *** FUNCTION G22D05(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C1,C2,C3,C4,C5,C6,C7 & / 7.18199426134D-5, 3.72181989518D-2,-2.40000307873D-2, & 4.09241298575D-3, 3.87109246126D-11, & 1.00537563151D0 , 1.91296034620D0/ U=C7*T EU=DEXP(U) DEU=EU-1D0 T2=T*T T4=T2*T2 T8=T4*T4 SUM=C6*(U*EU/DEU-DLOG(DEU))+C5/(T8*T8*T)/17 SUM=SUM+0.25D0*C4/T4+C3/(T2*T)/3+0.5D0*C2/T2 G22D05=SUM-0.5D0*C1*T2-3.5D0*DLOG(T) RETURN END C G23 *** ENTHALPY FUNCTION G23D05(TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON,TC/8.31434D0,416.956D0/ TU=TC/TK TL=TC/298.15D0 SUM=G25D05(TU)-G25D05(TL) G23D05=GASCON*TC*SUM RETURN END C G24 *** INTERNAL ENERGY FUNCTION G24D05(TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON/8.31434D0/ G24D05=G23D05(TK)-GASCON*TK RETURN END C G25 *** HID/(GASCON*TC) *** FUNCTION G25D05(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C1,C2,C3,C4,C5,C6,C7 & / 7.18199426134D-5, 3.72181989518D-2,-2.40000307873D-2, & 4.09241298575D-3, 3.87109246126D-11, & 1.00537563151D0 , 1.91296034620D0/ U=C7*T EU=DEXP(U) DEU=EU-1D0 T2=T*T T4=T2*T2 T8=T4*T4 SUM=C7*C6/DEU+C5/(T8*T8*T2)/18 SUM=SUM+0.2D0*C4/(T4*T)+0.25D0*C3/T4+C2/(T2*T)/3 G25D05=SUM-C1*T+3.5D0/T RETURN END C G26 *** ISOBARIC SPECIFIC HEAT FUNCTION G26D05(TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C1,C2,C3,C4,C5,C6,C7 & / 7.18199426134D-5, 3.72181989518D-2,-2.40000307873D-2, & 4.09241298575D-3, 3.87109246126D-11, & 1.00537563151D0 , 1.91296034620D0/ DATA GASCON,TC/8.31434D0,416.956D0/ T=TC/TK U=C7*T EU=DEXP(U) DEU=EU-1D0 T2=T*T T4=T2*T2 T8=T4*T4 SUM=C6*EU*(U/DEU)**2+C5/(T8*T8*T) SUM=SUM+C4/T4+C3/(T2*T)+C2/T2 SUM=SUM+C1*T2+3.5D0 G26D05=GASCON*SUM RETURN END C G** *** *** C G27 *** ENTROPY AT R & TK FUNCTION G27D05(R,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON,TC,RC/8.31434D0,416.956D0,8.1345D-3/ PA=0.101325D0 W=R/RC T=TC/TK G27D05=G21D05(TK)-GASCON*(DLOG(R*GASCON*TK/PA)+G18D05(W,T)) RETURN END C G28 *** INTERNAL ENERGY AT RO & TK FUNCTION G28D05(R,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON,TC,RC/8.31434D0,416.956D0,8.1345D-3/ W=R/RC T=TC/TK G28D05=G24D05(TK)+GASCON*TK*G19D05(W,T) RETURN END C G29 *** ENTHALPY AT RO, TK & P FUNCTION G29D05(R,TK,P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) G29D05=G28D05(R,TK)+P/R RETURN END C G30 *** ISOCHORIC SPECIFIC HEAT AT RO & TK FUNCTION G30D05(R,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON,TC,RC/8.31434D0,416.956D0,8.1345D-3/ W=R/RC T=TC/TK G30D05=G26D05(TK)-GASCON-GASCON*G20D05(W,T) RETURN END C G31 *** ISOBARIC SPECIFIC HEAT AT RO & TK FUNCTION G31D05(R,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA GASCON,TC,RC/8.31434D0,416.956D0,8.1345D-3/ W=R/RC T=TC/TK SSXT=G6D05(W,T) SSXR=G4D05(W,T) G31D05=G30D05(R,TK)+GASCON*(SSXT*SSXT)/SSXR RETURN END C G32 *** SPEED OF SOUND AT RO &TK FUNCTION G32D05(R,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) WWW=G31D05(R,TK)*G3D05(R,TK)/G30D05(R,TK)/7.0906D-2 G32D05=DSQRT(WWW) RETURN END C G33 *** LOCAL ADIABATIC EXPONENT AT R, TK &P FUNCTION G33D05(R,TK,P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) G33D05=G31D05(R,TK)*G3D05(R,TK)/G30D05(R,TK)*R/P RETURN END C G34 *** HPTX I=1(T,X):I=2(P,X) C C *** X<-2(LIQ):-21(LATENT HEAT) FUNCTION G34D05(P,T,X,I) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF (I.EQ.1) THEN CALL S1D05(T,PS,RL,RG) TS=T ELSEIF (I.EQ.2) THEN CALL S2D05(P,TS,RL,RG) PS=P ENDIF IF (X.LT.-2D0) THEN G34D05=G29D05(RL,TS,PS) ELSEIF (X.LT.-1D0) THEN G34D05=G29D05(RG,TS,PS) ELSE HL=G29D05(RL,TS,PS) HG=G29D05(RG,TS,PS) IF (X.GT.1D0) THEN G34D05=HG-HL ELSE G34D05=HL+X*(HG-HL) ENDIF ENDIF RETURN END C G35 *** SPTX I=0 (P,T):I=1(T,X):I=2(P,X):X<-2(LIQ):-2 AT T FUNCTION G41D05(T) TK=T+273.15 TR=1E0-TK/417.15 SIG1=TR**1.0508 SIG=65.834E-3*SIG1 IF (SIG.LT.2.1E-5) SIG=0.0 G41D05=SIG RETURN END C S** *** S01 - S03 *** SATURATED PROPERTIES C S01 *** AT T SUBROUTINE S1D05(TK,PS,RL,RG) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF (TK.GT.416.850D0) THEN CALL S3D05(1,PS,TK,RL,RG) RETURN ELSE PS1=G8D05(TK) RL1=G10D05(TK) RG1=G11D05(TK) 10 RL=G15D05(PS1,TK,RL1) RG=G15D05(PS1,TK,RG1) PS=G12D05(TK,RL,RG) IF (DABS(PS/PS1-1D0).LT.1D-7) THEN RETURN ELSE PS1=PS RL1=RL RG1=RG ENDIF GOTO 10 ENDIF END C S02 *** AT P SUBROUTINE S2D05(P,TS,RL,RG) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A1,A2,A3,A4,A5,A6 & /-6.385686491D0, 1.097597510D0, -5.583806522D0, & -1.019792630D0, -3.980500663D-3, 3.088457077D-3/ TC=416.956D0 PC=7.9914D0 IF (P.GE.7.9781D0) THEN CALL S3D05(2,P,TS,RL,RG) RETURN ELSE TS1=G9D05(P) 10 CALL S1D05(TS1,PS,RL,RG) IF (DABS(P/PS-1D0).LT.1D-7) THEN TS=TS1 RETURN ELSE S=TC/TS1-1D0 SSQ=DSQRT(S) S2=S*S S4=S2*S2 S8=S4*S4 PSLOG=A1*S+A2*S*SSQ+A3*S2+A4*S2*SSQ+A5*S8*S PSLOG=PSLOG+A6*S8*S*SSQ PK=PC*DEXP(PSLOG/(S+1D0)) DPP=A1+1.5D0*A2*SSQ+2*A3*S+2.5D0*A4*S*SSQ DPP=DPP+9*A5*S8+9.5D0*A6*S8*SSQ DPKDT=PK/TC*(PSLOG-DPP*(S+1D0)) DT=(PS-P)/DPKDT TS1=TS1-DT ENDIF GOTO 10 ENDIF END C S03 *** NEAR THE CRITICAL POINT *** SUBROUTINE S3D05(ID,PS,TS,RL,RG) IMPLICIT DOUBLE PRECISION (A-H,O-Z) TC=416.956D0 PC=7.9914D0 RC=8.1345D-3 IF (ID.EQ.1) THEN IF (DABS(TS/TC-1D0).LT.1D-5) THEN PS=PC RL=RC RG=RC RETURN ELSE PX=G8D05(TS) RLX=G10D05(TS) RGX=G11D05(TS) PS=PC-0.01293D0/0.01331D0*(PC-PX) RL=RC-5.4895D-4/5.6554D-4*(RC-RLX) RG=RC-5.3529D-4/5.0771D-4*(RC-RGX) RETURN ENDIF ELSE IF (DABS(PS/PC-1D0).LT.1D-5) THEN TS=TC RL=RC RG=RC RETURN ELSE TX=G9D05(PS) RLX=G10D05(TX) RGX=G11D05(TX) TS=TC-0.10589D0/0.10900D0*(TC-TX) RL=RC-5.4867D-4/5.7344D-4*(RC-RLX) RG=RC-5.3502D-4/5.1530D-4*(RC-RGX) RETURN ENDIF ENDIF END C S04 *** T,R,S & U AT P & H SUBROUTINE S4D05(P,H,T,R,S,U) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF (P.LE.0.999999D-05) GOTO 999 IF (P.GT.25D0) GOTO 999 PCRI=7.9914D0 HCRI=-5756.733D0 DPCRI=DABS(P/PCRI-1D0) DHCRI=DABS(H/HCRI-1D0) IF (DPCRI.LT.1D-5 .AND. DHCRI.LT.1D-5) THEN T=416.956D0 R=8.1345D-3 S=-44.8652D0 U=H-P/R RETURN ENDIF TMAX=900.001D0 RMAX=G13D05(P,TMAX) HMAX=G29D05(RMAX,TMAX,P) IF (H.GE.HMAX) GOTO 999 TMIN=179.999D0 RMIN=G13D05(P,TMIN) HMIN=G29D05(RMIN,TMIN,P) IF (H.LE.HMIN) GOTO 999 IF (P.GE.1.387D-3 .AND. P.LE.7.9914D0) THEN CALL S2D05(P,T,RL,RG) HL=G29D05(RL,T,P) HG=G29D05(RG,T,P) IF (H.LT.HL) THEN TA=T TB=TMIN ELSEIF (H.LE.HG) THEN VG=1/RG VL=1/RL X=(H-HL)/(HG-HL) V=VL+X*(VG-VL) R=1D0/V SL=G27D05(RL,T) SG=G27D05(RG,T) S=SL+X*(SG-SL) UL=G28D05(RL,T) UG=G28D05(RG,T) U=UL+X*(UG-UL) RETURN ELSE TA=TMAX TB=T ENDIF ELSE TA=TMAX TB=TMIN ENDIF ILOOP=0 RA=G13D05(P,TA) RB=G13D05(P,TB) HA=G29D05(RA,TA,P) HB=G29D05(RB,TB,P) 10 ILOOP=ILOOP+1 IF (ILOOP.LT.10000) THEN DHA=H-HA DHB=H-HB T=TB+(TA-TB)*.5 R=G13D05(P,T) HC=G29D05(R,T,P) DHC=H-HC IF (DABS((HA-HB)/H).LT.1D-7) THEN S=G27D05(R,T) U=G28D05(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.0E10 R=-1.0E10 S=-1.0E10 U=-1.0E10 RETURN ENDIF GOTO 10 999 T=-1.0E20 R=-1.0E20 S=-1.0E20 U=-1.0E20 RETURN END C S05 *** T, R, H & U AT P & S SUBROUTINE S5D05(P,S,T,R,H,U) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF (P.LE.0.999999D-05) GOTO 999 IF (P.GT.25D0) GOTO 999 PCRI=7.9914D0 SCRI=-44.8652D0 DPCRI=DABS(P/PCRI-1D0) DSCRI=DABS(S/SCRI-1D0) IF (DPCRI.LT.1D-5 .AND. DSCRI.LT.1D-5) THEN T=416.956D0 R=8.1345D-3 H=-5756.733D0 U=H-P/R RETURN ENDIF TMAX=900.001D0 RMAX=G13D05(P,TMAX) SMAX=G27D05(RMAX,TMAX) IF (S.GE.SMAX) GOTO 999 TMIN=179.999D0 RMIN=G13D05(P,TMIN) SMIN=G27D05(RMIN,TMIN) IF (S.LE.SMIN) GOTO 999 IF (P.GE.1.387D-3 .AND. P.LE.7.9914D0) THEN CALL S2D05(P,T,RL,RG) SL=G27D05(RL,T) SG=G27D05(RG,T) IF (S.LT.SL) THEN TA=T TB=TMIN ELSEIF (S.LE.SG) THEN VL=1D0/RL VG=1D0/RG X=(S-SL)/(SG-SL) V=VL+X*(VG-VL) R=1D0/V HL=G29D05(RL,T,P) HG=G29D05(RG,T,P) H=HL+X*(HG-HL) UL=G28D05(RL,T) UG=G28D05(RG,T) U=UL+X*(UG-UL) RETURN ELSE TA=TMAX TB=T ENDIF ELSE TA=TMAX TB=TMIN ENDIF ILOOP=0 RA=G13D05(P,TA) RB=G13D05(P,TB) SA=G27D05(RA,TA) SB=G27D05(RB,TB) 10 ILOOP=ILOOP+1 IF (ILOOP.LE.10000) THEN DSA=S-SA DSB=S-SB T=TB+(TA-TB)*.5 R=G13D05(P,T) SC=G27D05(R,T) DSC=S-SC IF (DABS((SA-SB)/S).LT.1D-7) THEN H=G29D05(R,T,P) U=G28D05(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 GOTO 10 ELSE T=-1.0E10 R=-1.0E10 H=-1.0E10 U=-1.0E10 RETURN ENDIF 999 T=-1.0E20 R=-1.0E20 H=-1.0E20 U=-1.0E20 RETURN END C G93 FUNC(P,T) TYPE FUNCTION G93D05(P,T) INTEGER G93D05 DATA PCR,TKCR/79.914,416.956E+00/ IF (T.GE.-93.15) THEN IF (T.LE.626.85) THEN IF (P.GE.0.0) THEN IF (P.LT.1D-4) THEN G93D05=4 RETURN ELSEIF (P.LE.250.) THEN DP=ABS(1.0E+00-P/PCR) IF (DP.LE.1.0E-05) THEN TK=T+273.15E+00 DT=ABS(1.0E+00-TK/TKCR) IF(DT.LE.1.0E-05) THEN G93D05=1 RETURN ENDIF ENDIF G93D05=2 RETURN ENDIF ENDIF ENDIF ENDIF G93D05=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