C=============================================================== C = C THERMODYNAMIC PROPERTIES OF AMMONIA(R717) = C = C MAY , 8 , 1999 = C = C UNIVERSITY OF SCIENCE AND TECHNOLOGY OF CHINA = C DEPARTMENT OF THERMAL SCIENCE AND ENERGY ENGINEERING = C = C CHENG WENLONG = C = C R.Tillner-Roth, F.Harms-Watzenberg and H. D. Baehr, = C Eine neue Fundamentalgleichung Folr Ammoniak, = C Proc.20th DKV-Tagung Heidelberg, Germany, Vol II,167 (1993) = C = 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) 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 S99NH3(FUN,MESS) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------------------ C FUNCTION NO.04= ALHP(P) C LATENT HEAT OF VAPORIZATION C------------------------------------------------------------ REAL FUNCTION ALHP(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'ALHP'/ PI=G98NH3(KPA,P) FF = F04NH3(PI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF=-1.0E+20 END IF ALHP=FF RETURN END C------------------------------------------------------------ C FUNCTION NO.05= ALHT(T) C LATENT HEAT OF VAPORIZATION C------------------------------------------------------------ REAL FUNCTION ALHT(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'ALHT'/ TI=G99NH3(KPA,T) FF = F05NH3(TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF=-1.0E+20 END IF ALHT=FF RETURN END C---------------------------------------> FUNCTION NO.06 = ALMPD REAL FUNCTION ALMPD(P) CHARACTER FUN*6 DOUBLE PRECISION F06NH3,DP COMMON/UNIT/KPA,MESS DATA FUN/'ALMPD'/ PI=G98NH3(KPA,P) DP = DBLE(PI) FF = REAL(F06NH3(DP)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF = -1.0E+20 END IF ALMPD = FF RETURN END C---------------------------------------> FUNCTION NO.07 = ALMPDD REAL FUNCTION ALMPDD(P) CHARACTER FUN*6 DOUBLE PRECISION F07NH3, DP COMMON/UNIT/KPA,MESS DATA FUN/'ALMPDD'/ PI=G98NH3(KPA,P) DP = DBLE(PI) FF = REAL(F07NH3(DP)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF = -1.0E+20 END IF ALMPDD = FF RETURN END C---------------------------------------> FUNCTION NO.08 = ALMPT REAL FUNCTION ALMPT(P,T) CHARACTER FUN*6 DOUBLE PRECISION F08NH3, DP, DT COMMON/UNIT/KPA,MESS DATA FUN/'ALMPT'/ PI=G98NH3(KPA,P) TI=G99NH3(KPA,T) DP = DBLE(PI) DT = DBLE(TI) FF = REAL(F08NH3(DP,DT)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,T,'P','T',FUN,MESS) FF = -1.0E+20 ENDIF ALMPT = FF RETURN END C---------------------------------------> FUNCTION NO.09 = ALMTD REAL FUNCTION ALMTD(T) CHARACTER FUN*6 DOUBLE PRECISION F09NH3, DT COMMON/UNIT/KPA,MESS DATA FUN/'ALMTD'/ TI=G99NH3(KPA,T) DT = DBLE(TI) FF = REAL(F09NH3(DT)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF = -1.0E+20 END IF ALMTD = FF RETURN END C---------------------------------------> FUNCTION NO.10 = ALMTDD REAL FUNCTION ALMTDD(T) CHARACTER FUN*6 DOUBLE PRECISION F10NH3, DT COMMON/UNIT/KPA,MESS DATA FUN/'ALMTDD'/ TI=G99NH3(KPA,T) DT = DBLE(TI) FF = REAL(F10NH3(DT)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF = -1.0E+20 END IF ALMTDD = FF RETURN END C---------------------------------------> FUNCTION NO.11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FUN*6 DOUBLE PRECISION F11NH3,DP COMMON/UNIT/KPA,MESS DATA FUN/'AMUPD'/ PI=G98NH3(KPA,P) DP = DBLE(PI) FF = REAL(F11NH3(DP)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF = -1.0E+20 END IF AMUPD = FF RETURN END C---------------------------------------> FUNCTION NO.12 = AMUPDD REAL FUNCTION AMUPDD(P) CHARACTER FUN*6 DOUBLE PRECISION F12NH3, DP COMMON/UNIT/KPA,MESS DATA FUN/'AMUPDD'/ PI=G98NH3(KPA,P) DP = DBLE(PI) FF = REAL(F12NH3(DP)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF = -1.0E+20 END IF AMUPDD = FF RETURN END C---------------------------------------> FUNCTION NO.13 = AMUPT REAL FUNCTION AMUPT(P,T) CHARACTER FUN*6 DOUBLE PRECISION F13NH3, DP, DT COMMON/UNIT/KPA,MESS DATA FUN/'AMUPT'/ PI=G98NH3(KPA,P) TI=G99NH3(KPA,T) DP = DBLE(PI) DT = DBLE(TI) FF = REAL(F13NH3(DP,DT)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,T,'P','T',FUN,MESS) FF = -1.0E+20 ENDIF AMUPT = FF RETURN END C---------------------------------------> FUNCTION NO.14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FUN*6 DOUBLE PRECISION F14NH3, DT COMMON/UNIT/KPA,MESS DATA FUN/'AMUTD'/ TI=G99NH3(KPA,T) DT = DBLE(TI) FF = REAL(F14NH3(DT)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF = -1.0E+20 END IF AMUTD = FF RETURN END C---------------------------------------> FUNCTION NO.15 = AMUTDD REAL FUNCTION AMUTDD(T) CHARACTER FUN*6 DOUBLE PRECISION F15NH3, DT COMMON/UNIT/KPA,MESS DATA FUN/'AMUTDD'/ TI=G99NH3(KPA,T) DT = DBLE(TI) FF = REAL(F15NH3(DT)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF = -1.0E+20 END IF AMUTDD = FF RETURN END C---------------------------------------> FUNCTION NO.31 = SIGP REAL FUNCTION SIGP(P) CHARACTER FUN*6 DOUBLE PRECISION F31NH3, DP COMMON/UNIT/KPA,MESS DATA FUN/'SIGP'/ PI=G98NH3(KPA,P) DP = DBLE(PI) FF = REAL(F31NH3(DP)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF = -1.0E+20 END IF SIGP = FF RETURN END C---------------------------------------> FUNCTION NO.32 = SIGT REAL FUNCTION SIGT(T) CHARACTER FUN*6 DOUBLE PRECISION F32NH3, DT COMMON/UNIT/KPA,MESS DATA FUN/'SIGT'/ TI=G99NH3(KPA,T) DT = DBLE(TI) FF = REAL(F32NH3(DT)) IF (FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF = -1.0E+10 ELSE IF (FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF = -1.0E+20 END IF SIGT = FF RETURN END C---------------------------------------> FUNCTION NO.23 = HPD REAL FUNCTION HPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'HPD'/ PI=G98NH3(KPA,P) FF = F23NH3(PI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF=-1.0E+20 END IF HPD=FF RETURN END C---------------------------------------> FUNCTION NO.24 = HPDD REAL FUNCTION HPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'HPDD'/ PI=G98NH3(KPA,P) FF = F24NH3(PI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF=-1.0E+20 END IF HPDD=FF RETURN END C---------------------------------------> FUNCTION NO.71 = HPS REAL FUNCTION HPS(P,S) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'HPS'/ PI=G98NH3(KPA,P) FF = F71NH3(PI,S) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,S,'P','S',FUN,MESS) END IF HPS=FF RETURN END C---------------------------------------> FUNCTION NO.25 = HPT REAL FUNCTION HPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'HPT'/ PI=G98NH3(KPA,P) TI=G99NH3(KPA,T) FF = F25NH3(PI,TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,T,'P','T',FUN,MESS) FF=-1.0E+20 ENDIF HPT=FF RETURN END C---------------------------------------> FUNCTION NO.26 = HPX REAL FUNCTION HPX(P,X) CHARACTER FUN*6 REAL P,X,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'HPX'/ PI=G98NH3(KPA,P) FF = F26NH3(PI,X) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,X,'P','X',FUN,MESS) FF=-1.0E+20 END IF HPX=FF RETURN END C---------------------------------------> FUNCTION NO.27 = HTD REAL FUNCTION HTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'HTD'/ TI=G99NH3(KPA,T) FF = F27NH3(TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF=-1.0E+20 END IF HTD=FF RETURN END C---------------------------------------> FUNCTION NO.28 = HTDD REAL FUNCTION HTDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'HTDD'/ TI=G99NH3(KPA,T) FF = F28NH3(TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF=-1.0E+20 END IF HTDD=FF RETURN END C---------------------------------------> FUNCTION NO.29 = HTX REAL FUNCTION HTX(T,X) CHARACTER FUN*6 REAL T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'HTX'/ TI=G99NH3(KPA,T) FF = F29NH3(TI,X) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,T,X,'T','X',FUN,MESS) FF=-1.0E+20 END IF HTX=FF RETURN END C---------------------------------------> FUNCTION NO.84 = 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='AMMONIA' WHEN A='S' C B='NH3' 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='AMMONIA' ELSE IF (A.EQ.'C') THEN IDENTF='NH3' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR AMMONIA WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C---------------------------------------> FUNCTION NO.30 = PST REAL FUNCTION PST(T) CHARACTER FUN*6 REAL PBAR,T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'PST'/ PBAR=G98NH3(KPA,1.0) TI=G99NH3(KPA,T) FF = F30NH3(TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) PST=-1.0E+10 RETURN ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) PST=-1.0E+20 RETURN END IF PST=FF/PBAR RETURN END C---------------------------------------> FUNCTION NO.33 = SPD REAL FUNCTION SPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'SPD'/ PI=G98NH3(KPA,P) FF = F33NH3(PI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF=-1.0E+20 END IF SPD=FF RETURN END C---------------------------------------> FUNCTION NO.34 = SPDD REAL FUNCTION SPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'SPDD'/ PI=G98NH3(KPA,P) FF = F34NH3(PI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF=-1.0E+20 END IF SPDD=FF RETURN END C---------------------------------------> FUNCTION NO.35 = SPT REAL FUNCTION SPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'SPT'/ PI=G98NH3(KPA,P) TI=G99NH3(KPA,T) FF = F35NH3(PI,TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,T,'P','T',FUN,MESS) FF=-1.0E+20 END IF SPT=FF RETURN END C---------------------------------------> FUNCTION NO.36 = SPX REAL FUNCTION SPX(P,X) CHARACTER FUN*6 REAL P,X,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'SPX'/ PI=G98NH3(KPA,P) FF = F36NH3(PI,X) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,X,'P','X',FUN,MESS) FF=-1.0E+20 END IF SPX=FF RETURN END C---------------------------------------> FUNCTION NO.37 = STD REAL FUNCTION STD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'STD'/ TI=G99NH3(KPA,T) FF = F37NH3(TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF=-1.0E+20 END IF STD=FF RETURN END C---------------------------------------> FUNCTION NO.38 = STDD REAL FUNCTION STDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'STDD'/ TI=G99NH3(KPA,T) FF = F38NH3(TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF=-1.0E+20 END IF STDD=FF RETURN END C---------------------------------------> FUNCTION NO.39 = STX REAL FUNCTION STX(T,X) CHARACTER FUN*6 REAL T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'STX'/ TI=G99NH3(KPA,T) FF = F39NH3(TI,X) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,T,X,'T','X',FUN,MESS) FF=-1.0E+20 END IF STX=FF RETURN END C---------------------------------------> FUNCTION NO.64 = TPH REAL FUNCTION TPH(P,H) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'TPH'/ PI=G98NH3(KPA,P) T0K=-G99NH3(KPA,0.0) FF = F64NH3(PI,H) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) TPH=-1.0E+10 RETURN ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,H,'P','H',FUN,MESS) TPH=-1.0E+20 RETURN END IF TPH=FF+T0K RETURN END C---------------------------------------> FUNCTION NO.65 = TPS REAL FUNCTION TPS(P,S) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'TPS'/ PI=G98NH3(KPA,P) T0K=-G99NH3(KPA,0.0) FF = F65NH3(PI,S) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) TPS=-1.0E+10 RETURN ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,S,'P','S',FUN,MESS) TPS=-1.0E+20 RETURN END IF TPS=FF+T0K RETURN END C---------------------------------------> FUNCTION NO.70 = TPV REAL FUNCTION TPV(P,V) CHARACTER FUN*6 REAL T0K,P,V,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'TPV'/ PI=G98NH3(KPA,P) T0K=-G99NH3(KPA,0.0) FF = F70NH3(PI,V) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) TPV=-1.0E+10 RETURN ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,V,'P','V',FUN,MESS) TPV=-1.0E+20 RETURN END IF TPV=FF+T0K RETURN END C---------------------------------------> FUNCTION NO.40 = TSP REAL FUNCTION TSP(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'TSP'/ PI=G98NH3(KPA,P) T0K=-G99NH3(KPA,0.0) FF = F40NH3(PI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) TSP=-1.0E+10 RETURN ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) TSP=-1.0E+20 RETURN END IF TSP=FF+T0K RETURN END C---------------------------------------> FUNCTION NO.42 = UPD REAL FUNCTION UPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'UPD'/ PI=G98NH3(KPA,P) FF=F42NH3(PI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) ENDIF UPD=FF RETURN END C---------------------------------------> FUNCTION NO.43 = UPDD REAL FUNCTION UPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'UPDD'/ PI=G98NH3(KPA,P) FF=F43NH3(PI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) ENDIF UPDD=FF RETURN END C---------------------------------------> FUNCTION NO.79 = UPS REAL FUNCTION UPS(P,S) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'UPS'/ PI=G98NH3(KPA,P) FF = F79NH3(PI,S) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,S,'P','S',FUN,MESS) END IF UPS=FF RETURN END C---------------------------------------> FUNCTION NO.44 = UPT REAL FUNCTION UPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'UPT'/ PI=G98NH3(KPA,P) TI=G99NH3(KPA,T) FF=F44NH3(PI,TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,T,'P','T',FUN,MESS) ENDIF UPT=FF RETURN END C---------------------------------------> FUNCTION NO.45 = UPX REAL FUNCTION UPX(P,X) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'UPX'/ PI=G98NH3(KPA,P) FF=F45NH3(PI,X) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,X,'P','X',FUN,MESS) ENDIF UPX=FF RETURN END C---------------------------------------> FUNCTION NO.46 = UTD REAL FUNCTION UTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'UTD'/ TI=G99NH3(KPA,T) FF=F46NH3(TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) ENDIF UTD=FF RETURN END C---------------------------------------> FUNCTION NO.47 = UTDD REAL FUNCTION UTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'UTDD'/ TI=G99NH3(KPA,T) FF=F47NH3(TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) ENDIF UTDD=FF RETURN END C---------------------------------------> FUNCTION NO.48 = UTX REAL FUNCTION UTX(T,X) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'UTX'/ TI=G99NH3(KPA,T) FF=F48NH3(TI,X) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,T,X,'T','X',FUN,MESS) ENDIF UTX=FF RETURN END C---------------------------------------> FUNCTION NO.49 = VPD REAL FUNCTION VPD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'VPD'/ PI=G98NH3(KPA,P) FF = F49NH3(PI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF=-1.0E+20 END IF VPD=FF RETURN END C---------------------------------------> FUNCTION NO.50 = VPDD REAL FUNCTION VPDD(P) CHARACTER FUN*6 REAL P,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'VPDD'/ PI=G98NH3(KPA,P) FF = F50NH3(PI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(1,P,P,'P','P',FUN,MESS) FF=-1.0E+20 END IF VPDD=FF RETURN END C---------------------------------------> FUNCTION NO.80 = VPS REAL FUNCTION VPS(P,S) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'VPS'/ PI=G98NH3(KPA,P) FF = F80NH3(PI,S) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,S,'P','S',FUN,MESS) END IF VPS=FF RETURN END C---------------------------------------> FUNCTION NO.51 = VPT REAL FUNCTION VPT(P,T) CHARACTER FUN*6 REAL P,T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'VPT'/ PI=G98NH3(KPA,P) TI=G99NH3(KPA,T) FF = F51NH3(PI,TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,T,'P','T',FUN,MESS) FF=-1.0E+20 END IF VPT=FF RETURN END C---------------------------------------> FUNCTION NO.52 = VPX REAL FUNCTION VPX(P,X) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'VPX'/ PI=G98NH3(KPA,P) FF=F52NH3(PI,X) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,X,'P','X',FUN,MESS) ENDIF VPX=FF RETURN END C---------------------------------------> FUNCTION NO.53 = VTD REAL FUNCTION VTD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'VTD'/ TI=G99NH3(KPA,T) FF = F53NH3(TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF=-1.0E+20 END IF VTD=FF RETURN END C---------------------------------------> FUNCTION NO.54 = VTDD REAL FUNCTION VTDD(T) CHARACTER FUN*6 REAL T,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FUN/'VTDD'/ TI=G99NH3(KPA,T) FF = F54NH3(TI) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) FF=-1.0E+10 ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(2,T,T,'T','T',FUN,MESS) FF=-1.0E+20 END IF VTDD=FF RETURN END C---------------------------------------> FUNCTION NO.55 = VTX REAL FUNCTION VTX(T,X) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'VTX'/ TI=G99NH3(KPA,T) FF=F55NH3(TI,X) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,T,X,'T','X',FUN,MESS) ENDIF VTX=FF RETURN END C---------------------------------------> FUNCTION NO.56 = XPH REAL FUNCTION XPH(P,H) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'XPH'/ PI=G98NH3(KPA,P) FF=F56NH3(PI,H) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,H,'P','H',FUN,MESS) ENDIF XPH=FF RETURN END C---------------------------------------> FUNCTION NO.57 = XPS REAL FUNCTION XPS(P,S) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'XPS'/ PI=G98NH3(KPA,P) FF=F57NH3(PI,S) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,S,'P','S',FUN,MESS) ENDIF XPS=FF RETURN END C---------------------------------------> FUNCTION NO.58 = XPU REAL FUNCTION XPU(P,U) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'XPU'/ PI=G98NH3(KPA,P) FF=F58NH3(PI,U) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,U,'P','U',FUN,MESS) ENDIF XPU=FF RETURN END C---------------------------------------> FUNCTION NO.59 = XPV REAL FUNCTION XPV(P,V) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'XPV'/ PI=G98NH3(KPA,P) FF=F59NH3(PI,V) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,P,V,'P','V',FUN,MESS) ENDIF XPV=FF RETURN END C---------------------------------------> FUNCTION NO.60 = XTH REAL FUNCTION XTH(T,H) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'XTH'/ TI=G99NH3(KPA,T) FF=F60NH3(TI,H) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,T,H,'T','H',FUN,MESS) ENDIF XTH=FF RETURN END C---------------------------------------> FUNCTION NO.61 = XTS REAL FUNCTION XTS(T,S) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'XTS'/ TI=G99NH3(KPA,T) FF=F61NH3(TI,S) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,T,S,'T','S',FUN,MESS) ENDIF XTS=FF RETURN END C---------------------------------------> FUNCTION NO.62 = XTU REAL FUNCTION XTU(T,U) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'XTU'/ TI=G99NH3(KPA,T) FF=F62NH3(TI,U) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,T,U,'T','U',FUN,MESS) ENDIF XTU=FF RETURN END C---------------------------------------> FUNCTION NO.63 = XTV REAL FUNCTION XTV(T,V) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS DATA FUN/'XTV'/ TI=G99NH3(KPA,T) FF=F63NH3(TI,V) IF(FF.EQ.-1.0E+10) THEN CALL S97NH3(FUN,MESS) ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98NH3(3,T,V,'T','V',FUN,MESS) ENDIF XTV=FF RETURN END C*****F30NH3 REAL FUNCTION F30NH3(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) T=DBLE(FT) F30NH3=SNGL(G30NH3(T)) RETURN END C*****F51NH3 REAL FUNCTION F51NH3(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) T=DBLE(FT) F51NH3=SNGL(G51NH3(P,T)) RETURN END C*****F25NH3 REAL FUNCTION F25NH3(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) T=DBLE(FT) F25NH3=SNGL(G25NH3(P,T)) RETURN END C*****F35NH3 REAL FUNCTION F35NH3(FP,FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) T=DBLE(FT) F35NH3=SNGL(G35NH3(P,T)) RETURN END C*****F64NH3 REAL FUNCTION F64NH3(P,H) IMPLICIT DOUBLE PRECISION(A-E,G) C T7=753.15 T7=700.0 AH=H C IF(P.GT.500.0E+6.OR.P.LT.0.01E+6) GO TO 900 IF(P.GT.1000.E+6.OR.P.LT.0) GOTO 900 IF(P.GT.150.0E+6) THEN T1=158.15+P*0.4E-6 ELSEIF(P.GT.35.0E06) THEN T1=218.149 ELSEIF(P.GT.15.0E06) THEN T1=213.149 ELSE T1=195.9 ENDIF C IF(P.GE.1.5587E04.AND.P.LE.11.288E06) THEN IF(P.GE.6.063E3.AND.P.LE.11.36E06) THEN HL=F23NH3(P) HV=F24NH3(P) TT=F40NH3(P) IF(H.GE.HL.AND.H.LE.HV) THEN F64NH3=TT RETURN ENDIF IF(H.LT.HL) T7=TT IF(H.GT.HV) T1=TT ENDIF H1=F25NH3(P,T1) H2=F25NH3(P,T7) IF(H.GE.H1.AND.H.LE.H2) GO TO 20 900 F64NH3=-1.0E+20 RETURN 20 DH1=H1 DH2=H2 DSS=DABS((DH1-AH)/AH) IF(DSS.LE.1.0D-6) THEN F64NH3=T1 RETURN END IF DSS=DABS((DH2-AH)/AH) IF(DSS.LE.1.0D-6) THEN F64NH3=T7 RETURN ENDIF LP=0 DX1=T1 DX2=T7 DP=P EPS=1.D-8 DYY=G25NH3(DP,DX1)-AH 50 DXM=(DX1+DX2)*0.5 LP=LP+1 FF=G25NH3(DP,DXM)-AH IF(DYY*FF.GT.0) THEN DX1=DXM ELSE DX2=DXM ENDIF IF(LP.GT.5000) THEN F64NH3=-1.0E+10 RETURN ENDIF IF((DX2-DX1).GE.EPS) GO TO 50 F64NH3=REAL(DXM) RETURN END C*****F65NH3 REAL FUNCTION F65NH3(P,S) IMPLICIT DOUBLE PRECISION(A-E,G) C T7=753.15 T7=700. AS=S IF(P.GT.1000.0E+6.OR.P.LT.0) GO TO 900 IF(P.GT.150.0E+6) THEN T1=158.15+P*0.4E-6 ELSEIF(P.GT.35.0E06) THEN T1=218.149 ELSEIF(P.GT.15.0E06) THEN T1=213.149 ELSE T1=195.9 ENDIF IF(P.GE.6.063E3.AND.P.LE.11.36E06) THEN SL=F33NH3(P) SV=F34NH3(P) TT=F40NH3(P) IF(S.GE.SL.AND.S.LE.SV) THEN F65NH3=TT RETURN ENDIF IF(S.LT.SL) T7=TT IF(S.GT.SV) T1=TT ENDIF S1=F35NH3(P,T1) S2=F35NH3(P,T7) IF(S.GE.S1.AND.S.LE.S2) GO TO 20 900 F65NH3=-1.0E+20 RETURN 20 DS1=S1 DS2=S2 DSS=DABS((DS1-AS)/AS) IF(DSS.LE.1.0D-7) THEN F65NH3=T1 RETURN END IF DSS=DABS((DS2-AS)/AS) IF(DSS.LE.1.0D-7) THEN F65NH3=T7 RETURN ENDIF LP=0 DX1=T1 DX2=T7 DP=P EPS=1.D-8 DYY=G35NH3(DP,DX1)-AS 50 DXM=(DX1+DX2)*0.5 LP=LP+1 FF=G35NH3(DP,DXM)-AS IF(DYY*FF.GT.0) THEN DX1=DXM ELSE DX2=DXM ENDIF IF(LP.GT.5000) THEN F65NH3=-1.0E+10 RETURN ENDIF DXX=DXM IF((DX2-DX1).GE.EPS) GO TO 50 F65NH3=REAL(DXM) RETURN END C*****F70NH3 REAL FUNCTION F70NH3(P,V) IMPLICIT DOUBLE PRECISION(A-E,G) C T7=753.15 T7=700.0 AV=V IF(P.GT.1000.0E+6.OR.P.LT.0.0) GO TO 900 IF(P.GT.150.0E+6) THEN T1=158.15+P*0.4E-6 ELSEIF(P.GT.35.0E06) THEN T1=218.149 ELSEIF(P.GT.15.0E06) THEN T1=213.149 ELSE T1=195.9 ENDIF C IF(P.GE.1.5587E04.AND.P.LE.11.288E06) THEN IF(P.GE.6.063E3.AND.P.LE.11.36E06) THEN VL=F49NH3(P) VV=F50NH3(P) TT=F40NH3(P) IF(V.GE.VL.AND.V.LE.VV) THEN F70NH3=TT RETURN ENDIF IF(V.LT.VL) T7=TT IF(V.GT.VV) T1=TT ENDIF V1=F51NH3(P,T1) V2=F51NH3(P,T7) IF(V.GE.V1.AND.V.LE.V2) GO TO 20 900 F70NH3=-1.0E+20 RETURN 20 DV1=V1 DV2=V2 DSS=DABS((DV1-AV)/AV) IF(DSS.LE.1.0D-7) THEN F70NH3=T1 RETURN END IF DSS=DABS((DV2-AV)/AV) IF(DSS.LE.1.0D-7) THEN F70NH3=T7 RETURN ENDIF LP=0 DX1=T1 DX2=T7 DP=P EPS=1.D-8 DYY=G51NH3(DP,DX1)-AV 50 DXM=(DX1+DX2)*0.5 LP=LP+1 FF=G51NH3(DP,DXM)-AV IF(DYY*FF.GT.0) THEN DX1=DXM ELSE DX2=DXM ENDIF IF(LP.GT.5000) THEN F70NH3=-1.0E+10 RETURN ENDIF IF((DX2-DX1).GE.EPS) GO TO 50 F70NH3=REAL(DXM) RETURN END C*****F71NH3 FUNCTION F71NH3(P,S) TT=F65NH3(P,S) IF(TT.LE.-1.0E+10) THEN F71NH3=TT RETURN ENDIF HH=F25NH3(P,TT) F71NH3=HH RETURN END C*****F79NH3 FUNCTION F79NH3(P,S) TT=F65NH3(P,S) IF(TT.LE.-1.0E+10) THEN F79NH3=TT RETURN ENDIF UU=F44NH3(P,TT) F79NH3=UU RETURN END C*****F80NH3 FUNCTION F80NH3(P,S) TT=F65NH3(P,S) IF(TT.LE.-1.0E+10) THEN F80NH3=TT RETURN ENDIF VV=F51NH3(P,TT) F80NH3=VV RETURN END C*****F40NH3 REAL FUNCTION F40NH3(FP) DOUBLE PRECISION DP, G40NH3 DP=DBLE(FP) F40NH3=SNGL(G40NH3(DP)) RETURN END C*****F50NH3 REAL FUNCTION F50NH3(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) F50NH3=SNGL(G50NH3(P)) RETURN END C*****F49NH3 REAL FUNCTION F49NH3(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) F49NH3=SNGL(G49NH3(P)) RETURN END C*****F24NH3 REAL FUNCTION F24NH3(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) F24NH3=SNGL(G24NH3(P)) RETURN END C*****F23NH3 REAL FUNCTION F23NH3(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) F23NH3=SNGL(G23NH3(P)) RETURN END C*****F34NH3 REAL FUNCTION F34NH3(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) F34NH3=SNGL(G34NH3(P)) RETURN END C*****F33NH3 REAL FUNCTION F33NH3(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) F33NH3=SNGL(G33NH3(P)) RETURN END C*****F54NH3 REAL FUNCTION F54NH3(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) T=DBLE(FT) F54NH3=SNGL(G54NH3(T)) RETURN END C*****F53NH3 REAL FUNCTION F53NH3(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) T=DBLE(FT) F53NH3=SNGL(G53NH3(T)) RETURN END C*****F28NH3 REAL FUNCTION F28NH3(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) T=DBLE(FT) F28NH3=SNGL(G28NH3(T)) RETURN END C*****F27NH3 REAL FUNCTION F27NH3(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) T=DBLE(FT) F27NH3=SNGL(G27NH3(T)) RETURN END C*****F38NH3 REAL FUNCTION F38NH3(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) T=DBLE(FT) F38NH3=SNGL(G38NH3(T)) RETURN END C*****F37NH3 REAL FUNCTION F37NH3(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) T=DBLE(FT) F37NH3=SNGL(G37NH3(T)) RETURN END C*****F29NH3 REAL FUNCTION F29NH3(FT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) T=DBLE(FT) X=DBLE(FX) F29NH3=SNGL(G29NH3(T,X)) RETURN END C*****F26NH3 REAL FUNCTION F26NH3(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) X=DBLE(FX) F26NH3=SNGL(G26NH3(P,X)) RETURN END C*****F39NH3 REAL FUNCTION F39NH3(FT,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) T=DBLE(FT) X=DBLE(FX) F39NH3=SNGL(G39NH3(T,X)) RETURN END C*****F36NH3 REAL FUNCTION F36NH3(FP,FX) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) X=DBLE(FX) F36NH3=SNGL(G36NH3(T,X)) RETURN END C*****F05NH3 REAL FUNCTION F05NH3(FT) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) T=DBLE(FT) F05NH3=SNGL(G05NH3(T)) RETURN END C*****F04NH3 REAL FUNCTION F04NH3(FP) IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z) P=DBLE(FP) F04NH3=SNGL(G04NH3(P)) RETURN END C*****F42NH3 FUNCTION F42NH3(P) XX=F23NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 HD=XX XX=F49NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 VD=XX F42NH3=HD-P*VD RETURN 900 F42NH3=XX RETURN END C*****F43NH3 FUNCTION F43NH3(P) XX=F24NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 HDD=XX XX=F50NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 VDD=XX F43NH3=HDD-P*VDD RETURN 900 F43NH3=XX RETURN END C*****F44NH3 FUNCTION F44NH3(P,T) XX=F25NH3(P,T) IF(XX.LE.-1.0E+10) GO TO 900 HH=XX XX=F51NH3(P,T) IF(XX.LE.-1.0E+10) GO TO 900 VV=XX F44NH3=HH-P*VV RETURN 900 F44NH3=XX RETURN END C*****F45NH3 FUNCTION F45NH3(P,X) IF(X.GE.0.AND.X.LE.1.0) GO TO 100 XX=-1.0E+20 GO TO 900 100 XX=F42NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 UD=XX XX=F43NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 UDD=XX F45NH3=UD+(UDD-UD)*X RETURN 900 F45NH3=XX RETURN END C*****F46NH3 FUNCTION F46NH3(T) XX=F30NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 PP=XX XX=F27NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 HD=XX XX=F53NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 VD=XX F46NH3=HD-PP*VD RETURN 900 F46NH3=XX RETURN END C*****F47NH3 FUNCTION F47NH3(T) XX=F30NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 PP=XX XX=F28NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 HDD=XX XX=F54NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 VDD=XX F47NH3=HDD-PP*VDD RETURN 900 F47NH3=XX RETURN END C*****F48NH3 FUNCTION F48NH3(T,X) IF(X.GE.0.AND.X.LE.1.0) GO TO 100 XX=-1.0E+20 GO TO 900 100 XX=F46NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 UD=XX XX=F47NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 UDD=XX F48NH3=UD+(UDD-UD)*X RETURN 900 F48NH3=XX RETURN END C*****F52NH3 FUNCTION F52NH3(P,X) IF(X.GE.0.AND.X.LE.1.0) GO TO 100 XX=-1.0E+20 GO TO 900 100 XX=F49NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 VD=XX XX=F50NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 VDD=XX F52NH3=VD+(VDD-VD)*X RETURN 900 F52NH3=XX RETURN END C*****F55NH3 FUNCTION F55NH3(T,X) IF(X.GE.0.AND.X.LE.1.0) GO TO 100 XX=-1.0E+20 GO TO 900 100 XX=F53NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 VD=XX XX=F54NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 VDD=XX F55NH3=VD+(VDD-VD)*X RETURN 900 F55NH3=XX RETURN END C*****F56NH3 FUNCTION F56NH3(P,H) XX=F23NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 HD=XX XX=F24NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 HDD=XX IF(H.GE.HD.AND.H.LE.HDD) GO TO 100 XX=-1.0E+20 GO TO 900 100 F56NH3=(H-HD)/(HDD-HD) RETURN 900 F56NH3=XX RETURN END C*****F57NH3 FUNCTION F57NH3(P,S) XX=F33NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 SD=XX XX=F34NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 SDD=XX IF(S.GE.SD.AND.S.LE.SDD) GO TO 100 XX=-1.0E+20 GO TO 900 100 F57NH3=(S-SD)/(SDD-SD) RETURN 900 F57NH3=XX RETURN END C*****F58NH3 FUNCTION F58NH3(P,U) XX=F42NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 UD=XX XX=F43NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 UDD=XX IF(U.GE.UD.AND.U.LE.UDD) GO TO 100 XX=-1.0E+20 GO TO 900 100 F58NH3=(U-UD)/(UDD-UD) RETURN 900 F58NH3=XX RETURN END C*****F59NH3 FUNCTION F59NH3(P,V) XX=F49NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 VD=XX XX=F50NH3(P) IF(XX.LE.-1.0E+10) GO TO 900 VDD=XX IF(V.GE.VD.AND.V.LE.VDD) GO TO 100 XX=-1.0E+20 GO TO 900 100 F59NH3=(V-VD)/(VDD-VD) RETURN 900 F59NH3=XX RETURN END C*****F60NH3 FUNCTION F60NH3(T,H) XX=F27NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 HD=XX XX=F28NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 HDD=XX IF(H.GE.HD.AND.H.LE.HDD) GO TO 100 XX=-1.0E+20 GO TO 900 100 F60NH3=(H-HD)/(HDD-HD) RETURN 900 F60NH3=XX RETURN END C*****F61NH3 FUNCTION F61NH3(T,S) XX=F37NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 SD=XX XX=F38NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 SDD=XX IF(S.GE.SD.AND.S.LE.SDD) GO TO 100 XX=-1.0E+20 GO TO 900 100 F61NH3=(S-SD)/(SDD-SD) RETURN 900 F61NH3=XX RETURN END C*****F62NH3 FUNCTION F62NH3(T,U) XX=F46NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 UD=XX XX=F47NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 UDD=XX IF(U.GE.UD.AND.U.LE.UDD) GO TO 100 XX=-1.0E+20 GO TO 900 100 F62NH3=(U-UD)/(UDD-UD) RETURN 900 F62NH3=XX RETURN END C*****F63NH3 FUNCTION F63NH3(T,V) XX=F53NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 VD=XX XX=F54NH3(T) IF(XX.LE.-1.0E+10) GO TO 900 VDD=XX IF(V.GE.VD.AND.V.LE.VDD) GO TO 100 XX=-1.0E+20 GO TO 900 100 F63NH3=(V-VD)/(VDD-VD) RETURN 900 F63NH3=XX RETURN END C*****G30NH3 DOUBLE PRECISION FUNCTION G30NH3(T) IMPLICIT DOUBLE PRECISION(C-H,K,O-Z) DATA TC/405.4/,VC/225./ R=488.189 IF(T.LT.196.OR.T.GT.405.40D0) GOTO 200 IF(DABS((T-196.0D0)/T).LT.1.0D-05) THEN G30NH3=0.60596848D04 RETURN ENDIF IF(DABS((T-405.40D0)/T).LT.1.0D-05) THEN G30NH3=11.36D06 RETURN ENDIF BM1=-7.296510 BM2= 1.618053 BM3=-1.956546 BM4=-2.114118 TMC=405.4D+0 TMX=T XM=(TMC-TMX)/TMC PMX=113.04D+0*0.986923D+0 &*EXP((TMC/TMX)*(BM1*XM+BM2*XM**1.5+BM3*XM**2.5+BM4*XM**5)) P=PMX*1.01325D+5 1 CONTINUE VV=G86NH3(P,TMX) VL=G87NH3(P,TMX) ROV=1./VV ROL=1./VL DLTAL=1./(VL*VC) DLTAV=1./(VV*VC) PL=R*TMX*ROL*(1.+DLTAL*R3NH3(VL,TMX)) PV=R*TMX*ROV*(1.+DLTAV*R3NH3(VV,TMX)) E=DABS((PL-PV)/P) IF(E.LT.1.E-5) GOTO 999 P=R0NH3(VL,TMX)-R0NH3(VV,TMX)+DLOG(ROL/ROV) P=R*TMX*P/(VV-VL) GOTO 1 999 CONTINUE P=R0NH3(VL,TMX)-R0NH3(VV,TMX)+DLOG(ROL/ROV) P=R*TMX*P/(VV-VL) G30NH3=P RETURN 200 G30NH3=-1.0E+20 RETURN END C==================================================== C DENSITY OF SATUATION GAS : G86NH3(P,T) C==================================================== DOUBLE PRECISION FUNCTION G86NH3(P,T) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) ILOOP=0 V1=0.3D+0 DV=0.10000000001D+0 PDD=1.0D-1 IF(P.GE.1.0D+8) PDD=1.0D+1 PDDD=-PDD DP=G85NH3(T,V1)-P ILOOP=ILOOP+1 IF(ILOOP.GT.1000) GOTO 100 IF(DP.LT.PDD.AND.DP.GT.PDDD) GOTO 7173 IF(DP) 7176,7176,7175 7175 CONTINUE DP=G85NH3(T,V1)-P ILOOP=ILOOP+1 IF(ILOOP.GT.1000) GOTO 100 IF(DP.LT.PDD.AND.DP.GT.PDDD) GOTO 7173 IF(DP.GT.0.0) GOTO 7178 V1=V1-DV DV=DV*0.5 V1=V1+DV GOTO 7175 7178 CONTINUE V1=V1+DV GOTO 7175 7176 CONTINUE DP=G85NH3(T,V1)-P ILOOP=ILOOP+1 IF(ILOOP.GT.1000) GOTO 100 IF(DP.LT.PDD.AND.DP.GT.PDDD) GOTO 7173 IF(DP.LT.0.0) GOTO 7179 7177 V1=V1+DV DV=DV*0.5 V1=V1-DV IF(V1.LT.0.0013D+0) GOTO 7177 GOTO 7176 7179 V1=V1-DV IF(V1.LT.0.0013D+0) GOTO 7177 GOTO 7176 7173 G86NH3=V1 RETURN 100 G86NH3=-1.0E+10 RETURN END C=============================================== C DENSITY OF SATUATION LIQUID G87NH3(P,T) C=============================================== DOUBLE PRECISION FUNCTION G87NH3(P,T) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) ILOOP=0 V1=0.0013D+0 DV=0.0001D+0 PDD=1.0D-1 IF(P.GE.1.0D+8) PDD=1.0D+1 PDDD=-PDD 7175 CONTINUE DP=G85NH3(T,V1)-P ILOOP=ILOOP+1 IF(ILOOP.GT.1000) GOTO 100 IF(DP.LT.PDD.AND.DP.GT.PDDD) GOTO 7173 IF(DP.GT.0.0) GOTO 7178 V1=V1-DV DV=DV*0.5 V1=V1+DV GOTO 7175 7178 CONTINUE V1=V1+DV GOTO 7175 7176 CONTINUE DP=G85NH3(T,V1)-P ILOOP=ILOOP+1 IF(ILOOP.GT.1000) GOTO 100 IF(DP.LT.PDD.AND.DP.GT.PDDD) GOTO 7173 IF(DP.LT.0.0) GOTO 7179 7177 V1=V1+DV DV=DV*0.5 V1=V1-DV IF(V1.LT.0.0013D+0) GOTO 7177 GOTO 7176 7179 V1=V1-DV IF(V1.LT.0.0013D+0) GOTO 7177 GOTO 7176 7173 G87NH3=V1 RETURN 100 G87NH3=-1.0E+10 RETURN END C*****G51NH3 DOUBLE PRECISION FUNCTION G51NH3(P,T) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) C IF(P.LT.0.01D+6.OR.T.LT.195.9) GOTO 200 C IF(P.GT.15.0D+6.AND.T.LT.213.149) GOTO 200 C IF(P.GT.35.0D+6.AND.T.LT.218.149) GOTO 200 C IF(P.GT.150.0D+6.AND.T.LT.(0.4D-6)*P+158.149) GOTO 200 C IF(P.GT.500.0D+6.OR.T.GT.753.15) GOTO 200 IF(P.LT.0.OR.P.GT.1000E6) GOTO 200 IF(T.LT.196.OR.T.GT.700.0) GOTO 200 IF(T.GT.405.40D+0) GOTO 121 IF(P.LT.G30NH3(T)) GOTO 121 G51NH3=G87NH3(P,T) RETURN 121 CONTINUE G51NH3=G86NH3(P,T) RETURN 200 G51NH3=-1.0E+20 RETURN END C=================================================== C FUNCTION G85NH3(T,V) C CALCULATION OF PRESSION P(T,V) C=================================================== DOUBLE PRECISION FUNCTION G85NH3(T,V) DOUBLE PRECISION DLTA,T,V,R3NH3,R DATA TC/405.4/,VC/225./ V1=1./V R=488.189 DLTA=1./(V*VC) G85NH3=R*T*V1*(1.+DLTA*R3NH3(V,T)) RETURN END C==================================================== C FUNCTION G88NH3(T,V) C CALCULATION OF ENTHALPY H(V,T) C==================================================== DOUBLE PRECISION FUNCTION G88NH3(V,T) DOUBLE PRECISION DLTA,TAO,T,V,I1NH3,R1NH3,R3NH3,R DATA TC/405.4/,VC/225./ R=488.189 DLTA=1./(V*VC) TAO=TC/T G88NH3=1.0+TAO*(I1NH3(V,T)+R1NH3(V,T))+DLTA*R3NH3(V,T) G88NH3=R*T*G88NH3 RETURN END C*****G25NH3 DOUBLE PRECISION FUNCTION G25NH3(P,T) IMPLICIT DOUBLE PRECISION(A-H,K,O-W) C IF(P.LT.0.01D+6.OR.T.LT.195.9) GOTO 200 C IF(P.GT.15.0D+6.AND.T.LT.213.149) GOTO 200 C IF(P.GT.35.0D+6.AND.T.LT.218.149) GOTO 200 C IF(P.GT.150.0D+6.AND.T.LT.(0.4D-6)*P+158.149) GOTO 200 C IF(P.GT.500.0D+6.OR.T.GT.753.15) GOTO 200 IF(P.GT.1000E6.OR.P.LT.0) GOTO 200 IF(T.LT.196.OR.T.GT.700.) GOTO 200 V=G51NH3(P,T) IF(V.EQ.-1.0E+10) GOTO 100 IF(V.EQ.-2.0E+10) GOTO 200 G25NH3=G88NH3(V,T) RETURN 100 G25NH3=-1.0E+10 RETURN 200 G25NH3=-1.0E+20 RETURN END C*****G89NH3 DOUBLE PRECISION FUNCTION G89NH3(P,T) IMPLICIT DOUBLE PRECISION(A-H,K,O-W) V=G86NH3(P,T) IF(V.EQ.-1.0E+10) GOTO 100 IF(V.EQ.-2.0E+10) GOTO 200 G89NH3=G88NH3(V,T) RETURN 100 G89NH3=-1.0E+10 RETURN 200 G89NH3=-1.0E+20 RETURN END C*****G90NH3 DOUBLE PRECISION FUNCTION G90NH3(P,T) IMPLICIT DOUBLE PRECISION(A-H,K,O-W) V=G87NH3(P,T) IF(V.EQ.-1.0E+10) GOTO 100 IF(V.EQ.-2.0E+10) GOTO 200 G90NH3=G88NH3(V,T) RETURN 100 G90NH3=-1.0E+10 RETURN 200 G90NH3=-1.0E+20 RETURN END C==================================================== C FUNCTION G88NH3(T,V) C CALCULATION OF ENTROPY H(V,T) C==================================================== DOUBLE PRECISION FUNCTION G91NH3(V,T) DOUBLE PRECISION DLTA,TAO,T,V,I1NH3,R1NH3,I0NH3,R0NH3,R DATA TC/405.4/,VC/225./ R=488.189 DLTA=1./(V*VC) TAO=TC/T G91NH3=TAO*(I1NH3(V,T)+R1NH3(V,T))-(I0NH3(V,T)+R0NH3(V,T)) G91NH3=R*G91NH3 RETURN END DOUBLE PRECISION FUNCTION G35NH3(P,T) IMPLICIT DOUBLE PRECISION(A-H,K,O-W) C IF(P.LT.0.01D+6.OR.T.LT.195.9) GOTO 200 C IF(P.GT.15.0D+6.AND.T.LT.213.149) GOTO 200 C IF(P.GT.35.0D+6.AND.T.LT.218.149) GOTO 200 C IF(P.GT.150.0D+6.AND.T.LT.(0.4D-6)*P+158.149) GOTO 200 C IF(P.GT.500.0D+6.OR.T.GT.753.15) GOTO 200 IF(P.LT.0.0.OR.P.GT.1000E6) GOTO 200 IF(T.LT.196.0.OR.T.GT.700) GOTO 200 V=G51NH3(P,T) IF(V.EQ.-1.0E+10) GOTO 100 IF(V.EQ.-2.0E+10) GOTO 200 G35NH3=G91NH3(V,T) RETURN 100 G35NH3=-1.0E+10 RETURN 200 G35NH3=-1.0E+20 RETURN END C*****G92NH3 DOUBLE PRECISION FUNCTION G92NH3(P,T) IMPLICIT DOUBLE PRECISION(A-H,K,O-W) V=G86NH3(P,T) IF(V.EQ.-1.0E+10) GOTO 100 IF(V.EQ.-2.0E+10) GOTO 200 G92NH3=G91NH3(V,T) RETURN 100 G92NH3=-1.0E+10 RETURN 200 G92NH3=-1.0E+20 RETURN END C*****G93NH3 DOUBLE PRECISION FUNCTION G93NH3(P,T) IMPLICIT DOUBLE PRECISION(A-H,K,O-W) V=G87NH3(P,T) IF(V.EQ.-1.0E+10) GOTO 100 IF(V.EQ.-2.0E+10) GOTO 200 G93NH3=G91NH3(V,T) RETURN 100 G93NH3=-1.0E+10 RETURN 200 G93NH3=-1.0E+20 RETURN END C*****G40NH3 DOUBLE PRECISION FUNCTION G40NH3(DP) IMPLICIT DOUBLE PRECISION(A-G) IF(DP.GE.0.6063D+04.AND.DP.LE.11.36D+06) GO TO 20 G40NH3=-1.0E+20 RETURN 20 IF(DABS((DP-0.60596848D+04)/DP).LT.1.0D-05) THEN G40NH3=196.0D00 RETURN ENDIF IF(DABS((DP-11.36D+06)/DP).LT.1.0D-05) THEN G40NH3=405.40D00 RETURN ENDIF DX1=196.0D0 DX2=405.40D0 LP=0 EPS=1.D-12 DYY=G30NH3(DX1)-DP 50 DXM=(DX1+DX2)*0.5 LP=LP+1 FF=G30NH3(DXM)-DP IF(DYY*FF.GT.0) THEN DX1=DXM ELSE DX2=DXM ENDIF DXX=DXM IF(LP.GT.5000) THEN G40NH3=-1.0E+10 RETURN ENDIF IF((DX2-DX1).GE.EPS) GO TO 50 G40NH3=DXM RETURN END C*****G50NH3 DOUBLE PRECISION FUNCTION G50NH3(P) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(P.LT.0.006060D+6.OR.P.GT.11.36D+6) GOTO 200 T=G40NH3(P) IF(T.EQ.-1.0E+10) GOTO 100 IF(T.EQ.-2.0E+10) GOTO 200 G50NH3=G86NH3(P,T) RETURN 100 G50NH3=-1.0E+10 RETURN 200 G50NH3=-1.0E+20 RETURN END C*****G49NH3 DOUBLE PRECISION FUNCTION G49NH3(P) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(P.LT.0.006060D+6.OR.P.GT.11.36D+6) GOTO 200 T=G40NH3(P) IF(T.EQ.-1.0E+10) GOTO 100 IF(T.EQ.-2.0E+10) GOTO 200 G49NH3=G87NH3(P,T) RETURN 100 G49NH3=-1.0E+10 RETURN 200 G49NH3=-1.0E+20 RETURN END C*****G24NH3 DOUBLE PRECISION FUNCTION G24NH3(P) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(P.LT.0.006063D+6.OR.P.GT.11.36D+6) GOTO 200 T=G40NH3(P) IF(T.EQ.-1.0E+10) GOTO 100 IF(T.EQ.-2.0E+10) GOTO 200 G24NH3=G89NH3(P,T) RETURN 100 G24NH3=-1.0E+10 RETURN 200 G24NH3=-1.0E+20 RETURN END C*****G23NH3 DOUBLE PRECISION FUNCTION G23NH3(P) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(P.LT.0.006063D+6.OR.P.GT.11.36D+6) GOTO 200 T=G40NH3(P) IF(T.EQ.-1.0E+10) GOTO 100 IF(T.EQ.-2.0E+10) GOTO 200 G23NH3=G90NH3(P,T) RETURN 100 G23NH3=-1.0E+10 RETURN 200 G23NH3=-1.0E+20 RETURN END C*****G34NH3 DOUBLE PRECISION FUNCTION G34NH3(P) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(P.LT.0.006063D+6.OR.P.GT.11.36D+6) GOTO 200 T=G40NH3(P) IF(T.EQ.-1.0E+10) GOTO 100 IF(T.EQ.-2.0E+10) GOTO 200 G34NH3=G92NH3(P,T) RETURN 100 G34NH3=-1.0E+10 RETURN 200 G34NH3=-1.0E+20 RETURN END C*****G33NH3 DOUBLE PRECISION FUNCTION G33NH3(P) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(P.LT.0.006063D+6.OR.P.GT.11.36D+6) GOTO 200 T=G40NH3(P) IF(T.EQ.-1.0E+10) GOTO 100 IF(T.EQ.-2.0E+10) GOTO 200 G33NH3=G93NH3(P,T) RETURN 100 G33NH3=-1.0E+10 RETURN 200 G33NH3=-1.0E+20 RETURN END C*****G54NH3 DOUBLE PRECISION FUNCTION G54NH3(T) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(T.LT.196.0.OR.T.GT.405.40) GOTO 200 P=G30NH3(T) IF(P.EQ.-1.0E+10) GOTO 100 IF(P.EQ.-2.0E+10) GOTO 200 G54NH3=G86NH3(P,T) RETURN 100 G54NH3=-1.0E+10 RETURN 200 G54NH3=-1.0E+20 RETURN END C*****G53NH3 DOUBLE PRECISION FUNCTION G53NH3(T) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(T.LT.196.0.OR.T.GT.405.40) GOTO 200 P=G30NH3(T) IF(P.EQ.-1.0E+10) GOTO 100 IF(P.EQ.-2.0E+10) GOTO 200 G53NH3=G87NH3(P,T) RETURN 100 G53NH3=-1.0E+10 RETURN 200 G53NH3=-1.0E+20 RETURN END C*****G28NH3 DOUBLE PRECISION FUNCTION G28NH3(T) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(T.LT.196.0.OR.T.GT.405.40) GOTO 200 P=G30NH3(T) IF(P.EQ.-1.0E+10) GOTO 100 IF(P.EQ.-2.0E+10) GOTO 200 G28NH3=G89NH3(P,T) RETURN 100 G28NH3=-1.0E+10 RETURN 200 G28NH3=-1.0E+20 RETURN END C*****G27NH3 DOUBLE PRECISION FUNCTION G27NH3(T) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(T.LT.196.0.OR.T.GT.405.40) GOTO 200 P=G30NH3(T) IF(P.EQ.-1.0E+10) GOTO 100 IF(P.EQ.-2.0E+10) GOTO 200 G27NH3=G90NH3(P,T) RETURN 100 G27NH3=-1.0E+10 RETURN 200 G27NH3=-1.0E+20 RETURN END C*****G38NH3 DOUBLE PRECISION FUNCTION G38NH3(T) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(T.LT.196.0.OR.T.GT.405.40) GOTO 200 P=G30NH3(T) IF(P.EQ.-1.0E+10) GOTO 100 IF(P.EQ.-2.0E+10) GOTO 200 G38NH3=G92NH3(P,T) RETURN 100 G38NH3=-1.0E+10 RETURN 200 G38NH3=-1.0E+20 RETURN END C*****G37NH3 DOUBLE PRECISION FUNCTION G37NH3(T) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(T.LT.196.0.OR.T.GT.405.40) GOTO 200 P=G30NH3(T) IF(P.EQ.-1.0E+10) GOTO 100 IF(P.EQ.-2.0E+10) GOTO 200 G37NH3=G93NH3(P,T) RETURN 100 G37NH3=-1.0E+10 RETURN 200 G37NH3=-1.0E+20 RETURN END C*****G29NH3 DOUBLE PRECISION FUNCTION G29NH3(T,X) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(T.LT.196.0.OR.T.GT.405.40) GOTO 200 IF(X.GT.1.0.OR.X.LT.0.0) GOTO 200 G29NH3=G28NH3(T)-(1.0D+0-X)*(G28NH3(T)-G27NH3(T)) RETURN 200 G29NH3=-1.0E+20 RETURN END C*****G26NH3 DOUBLE PRECISION FUNCTION G26NH3(P,X) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(P.LT.6.063E3.OR.P.GT.11.36D+6) GOTO 200 IF(X.GT.1.0.OR.X.LT.0.0) GOTO 200 G26NH3=G24NH3(P)-(1.0D+0-X)*(G24NH3(P)-G23NH3(P)) RETURN 200 G26NH3=-1.0E+20 RETURN END C*****G39NH3 DOUBLE PRECISION FUNCTION G39NH3(T,X) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(T.LT.196.0.OR.T.GT.405.40) GOTO 200 IF(X.GT.1.0.OR.X.LT.0.0) GOTO 200 G39NH3=G38NH3(T)-(1.0D+0-X)*(G28NH3(T)-G27NH3(T))/T RETURN 200 G39NH3=-1.0E+20 RETURN END C*****G36NH3 DOUBLE PRECISION FUNCTION G36NH3(P,X) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(P.LT.6.063E3.OR.P.GT.11.36D+6) GOTO 200 IF(X.GT.1.0.OR.X.LT.0.0) GOTO 200 T=G40NH3(P) G36NH3=G34NH3(P)-(1.0D+0-X)*(G24NH3(P)-G23NH3(P))/T RETURN 200 G36NH3=-1.0E+20 RETURN END C*****G05NH3 DOUBLE PRECISION FUNCTION G05NH3(T) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) IF(T.LT.196.0.OR.T.GT.405.40) GOTO 200 G05NH3=G28NH3(T)-G27NH3(T) RETURN 200 G05NH3=-1.0E+20 RETURN END C*****G04NH3 DOUBLE PRECISION FUNCTION G04NH3(P) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) c IF(P.LT.0.1D+6.OR.P.GT.11.36D+6) GOTO 200 IF(P.LT.6.063E+3.OR.P.GT.11.36D+6) GOTO 200 G04NH3=G24NH3(P)-G23NH3(P) RETURN 200 G04NH3=-1.0E+20 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 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) 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 C================================================ C Subroutine Program Specifying KPA and MESS C MS-FORTRAN and MS-C Mixed Langage Programing C================================================ SUBROUTINE KPAMES(KPAC,MESSC) COMMON/UNIT/KPA,MESS INTEGER KPAC INTEGER MESSC KPA=KPAC MESS=MESSC RETURN END C--------------------------------------------------------------- C FUNCTION NO.01= AIPPT C UNAVAILABLE C--------------------------------------------------------------- FUNCTION AIPPT(P,T) CHARACTER FUN*6 COMMON /UNIT/KPA,MESS P1=P T1=T DATA FUN/'AIPPT'/ CALL S99NH3(FUN,MESS) AIPPT=-1.0E+30 RETURN END C--------------------------------------------------------------- C FUNCTION NO.82= AKPT C UNAVAILABLE C--------------------------------------------------------------- REAL FUNCTION AKPT(P,T) CHARACTER FUN*6 COMMON /UNIT/KPA,MESS P1=P T1=T DATA FUN/'AKPT'/ CALL S99NH3(FUN,MESS) AKPT=-1.0E+30 RETURN END C------------------------------------------------------------ C FUNCTION NO.02= ALAPP C UNAVAILABLE C------------------------------------------------------------ REAL FUNCTION ALAPP(P) CHARACTER FUN*6 COMMON /UNIT/KPA,MESS P1=P DATA FUN/'ALAPP'/ CALL S99NH3(FUN,MESS) ALAPP=-1.0E+30 RETURN END C------------------------------------------------------------ C FUNCTION NO.03= ALAPT C UNAVAILABLE C------------------------------------------------------------ REAL FUNCTION ALAPT(T) CHARACTER FUN*6 COMMON /UNIT/KPA,MESS T1=T DATA FUN/'ALAPT'/ CALL S99NH3(FUN,MESS) ALAPT=-1.0E+30 RETURN END C-------------------------------------------------------------- C FUNCTION NO.16= CPPD(P) C UNAVAILABLE C-------------------------------------------------------------- REAL FUNCTION CPPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'CPPD'/ CALL S99NH3(FUN,MESS) CPPD=-1.0E+30 RETURN END C-------------------------------------------------------------- C FUNCTION NO.17= CPPDD(P) C UNAVAILABLE C-------------------------------------------------------------- REAL FUNCTION CPPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'CPPDD'/ CALL S99NH3(FUN,MESS) CPPDD=-1.0E+30 RETURN END C-------------------------------------------------------------- C FUNCTION NO.18= CPPT(P,T) C UNAVAILABLE C-------------------------------------------------------------- REAL FUNCTION CPPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P T1=T DATA FUN/'CPPT'/ CALL S99NH3(FUN,MESS) CPPT=-1.0E+30 RETURN END C-------------------------------------------------------------- C FUNCTION NO.19= CPTD(T) C UNAVAILABLE C-------------------------------------------------------------- REAL FUNCTION CPTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS T1=T DATA FUN/'CPTD'/ CALL S99NH3(FUN,MESS) CPTD=-1.0E+30 RETURN END C-------------------------------------------------------------- C FUNCTION NO.20= CPTDD(T) C UNAVAILABLE C-------------------------------------------------------------- REAL FUNCTION CPTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS T1=T DATA FUN/'CPTDD'/ CALL S99NH3(FUN,MESS) CPTDD=-1.0E+30 RETURN END C-------------------------------------------------------------- C FUNCTION NO.76= CVPDD(P) C UNAVAILABLE C-------------------------------------------------------------- REAL FUNCTION CVPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'CVPDD'/ CALL S99NH3(FUN,MESS) CVPDD=-1.0E+30 RETURN END C-------------------------------------------------------------- C FUNCTION NO.77= CVPT(P,T) C UNAVAILABLE C-------------------------------------------------------------- REAL FUNCTION CVPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P T1=T DATA FUN/'CVPT'/ CALL S99NH3(FUN,MESS) CVPT=-1.0E+30 RETURN END C-------------------------------------------------------------- C FUNCTION NO.78= CVTDD(T) C UNAVAILABLE C-------------------------------------------------------------- REAL FUNCTION CVTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS T1=T DATA FUN/'CVTDD'/ CALL S99NH3(FUN,MESS) CVTDD=-1.0E+30 RETURN END C-------------------------------------------------------------- C FUNCTION NO.22= EPSPT(P,T) C UNAVAILABLE C-------------------------------------------------------------- REAL FUNCTION EPSPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P T1=T DATA FUN/'EPSPT'/ CALL S99NH3(FUN,MESS) EPSPT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.66 = PLDT(T) C UNAVAILABLE C--------------------------------------- FUNCTION PLDT(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS T1=T DATA FUN/'PLDT'/ CALL S99NH3(FUN,MESS) PLDT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.68 = PMLT(T) C UNAVAILABLE C--------------------------------------- FUNCTION PMLT(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS T1=T DATA FUN/'PMLT'/ CALL S99NH3(FUN,MESS) PMLT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.85 = PRPD C UNAVAILABLE C--------------------------------------- REAL FUNCTION PRPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'PRPD'/ CALL S99NH3(FUN,MESS) PRPD=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.86 = PRPDD(P) C UNAVAILABLE C--------------------------------------- REAL FUNCTION PRPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'PRPDD'/ CALL S99NH3(FUN,MESS) PRPDD=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.81 = PRPT(P,T) C UNAVAILABLE C--------------------------------------- REAL FUNCTION PRPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P T1=T DATA FUN/'PRPT'/ CALL S99NH3(FUN,MESS) PRPT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.87 = PRTD(T) C UNAVAILABLE C--------------------------------------- REAL FUNCTION PRTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS T1=T DATA FUN/'PRTD'/ CALL S99NH3(FUN,MESS) PRTD=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.88 = PRTDD(T) C UNAVAILABLE C--------------------------------------- REAL FUNCTION PRTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS T1=T DATA FUN/'PRTDD'/ CALL S99NH3(FUN,MESS) PRTDD=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.99 = PSBT(T) C UNAVAILABLE C--------------------------------------- FUNCTION PSBT(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS T1=T DATA FUN/'PSBT'/ CALL S99NH3(FUN,MESS) PSBT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.72 = PSTD(T) C UNAVAILABLE C--------------------------------------- FUNCTION PSTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS T1=T DATA FUN/'PSTD'/ CALL S99NH3(FUN,MESS) PSTD=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.73 = PSTDD(T) C UNAVAILABLE C--------------------------------------- FUNCTION PSTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS T1=T DATA FUN/'PSTDD'/ CALL S99NH3(FUN,MESS) PSTDD=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.67 = TLDP(P) C UNAVAILABLE C--------------------------------------- FUNCTION TLDP(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'TLDP'/ CALL S99NH3(FUN,MESS) TLDP=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.69 = TMLP(P) C UNAVAILABLE C--------------------------------------- FUNCTION TMLP(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'TMLP'/ CALL S99NH3(FUN,MESS) TMLP=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.98 = TPSEUP(P) C UNAVAILABLE C--------------------------------------- FUNCTION TPSEUP(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'TPSEUP'/ CALL S99NH3(FUN,MESS) TPSEUP=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.100 = TSBP(P) C UNAVAILABLE C--------------------------------------- FUNCTION TSBP(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'TSBP'/ CALL S99NH3(FUN,MESS) TSBP=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.74 = TSPD(P) C UNAVAILABLE C--------------------------------------- FUNCTION TSPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'TSPD'/ CALL S99NH3(FUN,MESS) TSPD=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.75 = TSPDD(P) C UNAVAILABLE C--------------------------------------- FUNCTION TSPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P DATA FUN/'TSPDD'/ CALL S99NH3(FUN,MESS) TSPDD=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.83 = WPT(P,T) C UNAVAILABLE C--------------------------------------- REAL FUNCTION WPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS P1=P T1=T DATA FUN/'WPT'/ CALL S99NH3(FUN,MESS) WPT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.94 = AJTPT(P,T) C UNAVAILABLE C--------------------------------------- FUNCTION AJTPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='AJTPT' CALL S99NH3(FUN,MESS) AJTPT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.92 = BPPT(P,T) C UNAVAILABLE C--------------------------------------- FUNCTION BPPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='BPPT' CALL S99NH3(FUN,MESS) BPPT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.90 = BSPT(P,T) C UNAVAILABLE C--------------------------------------- FUNCTION BSPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='BSPT' CALL S99NH3(FUN,MESS) BSPT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.91 = BTPT(P,T) C UNAVAILABLE C--------------------------------------- FUNCTION BTPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='BTPT' CALL S99NH3(FUN,MESS) BTPT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.93 = BVPT(P,T) C UNAVAILABLE C--------------------------------------- FUNCTION BVPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='BVPT' CALL S99NH3(FUN,MESS) BVPT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.96 = GAMPDD(P) C UNAVAILABLE C--------------------------------------- FUNCTION GAMPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P FUN='GAMPDD' CALL S99NH3(FUN,MESS) GAMPDD=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.95 = GAMPT(P,T) C UNAVAILABLE C--------------------------------------- FUNCTION GAMPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='GAMPT' CALL S99NH3(FUN,MESS) GAMPT=-1.0E+30 RETURN END C--------------------------------------- C FUNCTION NO.97 = GAMTDD(T) C UNAVAILABLE C--------------------------------------- FUNCTION GAMTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=T FUN='GAMTDD' CALL S99NH3(FUN,MESS) GAMTDD=-1.0E+30 RETURN END C==================================================== C ERROR MESSAGE C==================================================== C---------------------------------------------------- C LEVEL 1 ERROR MESSAGE C---------------------------------------------------- SUBROUTINE S97NH3(FUN,MESS) CHARACTER FUN*6,MSG*125 IF(MESS.EQ.0) GOTO 100 MSG='**** NO CONVERGENCE AT '//FUN//' FOR AMMONIA ****' WRITE(6,*) MSG 100 CONTINUE RETURN END C--------------------------------------------------- C LEVEL 2 ERROR MESSAGE C--------------------------------------------------- SUBROUTINE S98NH3(IPT,P,T,N1,N2,FUN,MESS) CHARACTER FUN*6,N1*1,N2*1 IF(MESS.EQ.0) GOTO 100 IF (IPT.EQ.1) THEN WRITE(6,1100) FUN,P 1100 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR AMMONIA', *' WHEN P =',1PE14.7,' ****') ELSEIF (IPT.EQ.2) THEN WRITE(6,1200) FUN,T 1200 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR AMMONIA', *' WHEN T =',1PE14.7,' ****') ELSE WRITE(6,1300) FUN,N1,P,N2,T 1300 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR AMMONIA', *' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') ENDIF 100 CONTINUE RETURN END C------------------------------------------------- C LEVEL 3 ERROR MESSAGE C------------------------------------------------- SUBROUTINE S99NH3(FUN,MESS) CHARACTER FUN*6,MSG*125 IF(MESS.EQ.0) GOTO 100 MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR AMMONIA ****' WRITE(6,110) MSG 110 FORMAT(1H ,5X,A) 100 CONTINUE RETURN END C************************************************ C FUNCTION NO.89 = FC(A) C FUNCTION FOR FUNDDAMENTAL CONSTANTS C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='17.03026' WHEN A='M' RELATIVE MOLECULAR MASS C B='488.189' WHEN A='R' GAS CONSTANT C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=17.03026 ELSE IF (A.EQ.'R') THEN FC=488.189 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR AMMONIA WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C--------------------------------------- C FUNCTION NO.21 = CRP(A) C CRITICAL POINT C--------------------------------------- REAL FUNCTION CRP(A) CHARACTER A*1 REAL PBAR,T0K,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF(KPA.EQ.1) THEN PBAR=1.0 T0K=0.0 ELSE IF(KPA.EQ.2) THEN PBAR=1.0 T0K=273.15 ELSE IF(KPA.EQ.3) THEN PBAR=1.0E-05 T0K=0.0 ELSE PBAR=1.0E-05 T0K=273.15 END IF FF=F21NH3(A) IF(FF.EQ.-1.0E+20) THEN IF (MESS.NE.0) THEN WRITE(6,2000) A 2000 FORMAT(1H ,5X,'**** OUT OF RANGE AT CRP FOR AMMONIA', - ' WHEN A =',A,' ****') END IF FF=-1.0E+20 END IF IF(A.EQ.'T') THEN IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 FF=FF+T0K ELSE IF(A.EQ.'P') THEN IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 FF=FF/PBAR END IF CRP=FF RETURN END C******************************************* C FUNCTION F21NH3(A) C CRITICAL CONSTANTS C******************************************* REAL FUNCTION F21NH3(A) CHARACTER A*1,D(5)*1 DATA D/'P','T','V','H','S'/ IF (A.EQ.D(1)) THEN F=113.6 ELSE IF (A.EQ.D(2)) THEN F=132.25 ELSE IF (A.EQ.D(3)) THEN F=4.44E-03 ELSE IF(A.EQ.D(4)) THEN F=1.085278E6 ELSE IF(A.EQ.D(5)) THEN F=3.470162E3 ELSE F=-1.0E+20 END IF F21NH3=F RETURN END C--------------------------------------- C FUNCTION NO.41 = TRPL(A) C TRIPLE POINT C--------------------------------------- REAL FUNCTION TRPL(A) CHARACTER A*1 REAL PBAR,T0K,FF INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF(KPA.EQ.1) THEN PBAR=1.0 T0K=0.0 ELSE IF(KPA.EQ.2) THEN PBAR=1.0 T0K=273.15 ELSE IF(KPA.EQ.3) THEN PBAR=1.0E-05 T0K=0.0 ELSE PBAR=1.0E-05 T0K=273.15 END IF FF=F41NH3(A) IF(FF.EQ.-1.0E+20) THEN IF (MESS.NE.0) THEN WRITE(6,2000) A 2000 FORMAT(1H ,5X,'**** OUT OF RANGE AT TRPL FOR AMMONIA', - ' WHEN A =',A,' ****') END IF FF=-1.0E+20 END IF IF(A.EQ.'T') THEN IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 FF=FF+T0K ELSE IF(A.EQ.'P') THEN IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 FF=FF/PBAR END IF TRPL=FF RETURN END C******************************************** C FUNCTION F41NH3(A) C PROPERTIES AT TRIPLE POINT C******************************************** REAL FUNCTION F41NH3(A) CHARACTER A*1,D(2)*1 DATA D/'P','T'/ IF (A.EQ.D(1)) THEN F=0.06063 ELSE IF (A.EQ.D(2)) THEN F=-77.655 ELSE F=-1.0E+20 END IF F41NH3=F RETURN END C=================================================== C SETTING UNITS FUNCTION C=================================================== C--------------------------------------------------- C PRESSURE C--------------------------------------------------- FUNCTION G98NH3(KPA,P) IF(KPA.EQ.1) THEN PBAR=1.0E+5 ELSE IF(KPA.EQ.2) THEN PBAR=1.0E+5 ELSE PBAR=1.0E+0 END IF G98NH3=P*PBAR RETURN END C---------------------------------------------------- C TEMPERATURE C---------------------------------------------------- FUNCTION G99NH3(KPA,T) IF(KPA.EQ.1) THEN T0K=273.15 ELSE IF(KPA.EQ.3) THEN T0K=273.15 ELSE T0K=0.0 END IF G99NH3=T+T0K RETURN END C -------------------------------------------------------------- C ** Exponents and Coefficients for the Residual Free Energy ** C -------------------------------------------------------------- SUBROUTINE COEFF(ALFA,T,D) REAL ALFA,T INTEGER D DIMENSION ALFA(21),T(21),D(21) ALFA(1)=0.4554431E-1 ALFA(2)=0.7238548E0 ALFA(3)=0.1229470E-1 ALFA(4)=-0.1858814E+1 ALFA(5)=0.2141882E-10 ALFA(6)=-0.1430020E-1 ALFA(7)=0.3441324E0 ALFA(8)=-0.2873571E0 ALFA(9)=0.2352589E-4 ALFA(10)=-0.3497111E-1 ALFA(11)=0.2397852E-1 ALFA(12)=0.1831117E-2 ALFA(13)=-0.4085375E-1 ALFA(14)=0.2379275E0 ALFA(15)=-0.3548972E-1 ALFA(16)=-0.1823729E0 ALFA(17)=0.2281556E-1 ALFA(18)=-0.6663444E-2 ALFA(19)=-0.8847486E-2 ALFA(20)=0.2272635E-2 ALFA(21)=-0.5588655E-3 T(1)=-0.5 T(2)=0.5 T(3)=1 T(4)=1.5 T(5)=3 T(6)=0 T(7)=3 T(8)=4 T(9)=4 T(10)=5 T(11)=3 T(12)=5 T(13)=6 T(14)=8 T(15)=8 T(16)=10 T(17)=10 T(18)=5 T(19)=7.5 T(20)=15 T(21)=30 D(1)=2 D(2)=1 D(3)=4 D(4)=1 D(5)=15 D(6)=3 D(7)=3 D(8)=1 D(9)=8 D(10)=2 D(11)=1 D(12)=8 D(13)=1 D(14)=2 D(15)=3 D(16)=2 D(17)=4 D(18)=3 D(19)=1 D(20)=2 D(21)=4 RETURN END C ========================================================== C ** The Helmholtz Free Energy of The residual part ** C ** OF AMMONIA ** C ========================================================== DOUBLE PRECISION FUNCTION R0NH3(V,T) DOUBLE PRECISION V,T,DLTA,TAO,FA1,FA2,FA3,FA4,F REAL A,E INTEGER D DIMENSION A(21),E(21),D(21) DATA TC/405.4/,VC/225./ DLTA=1./(V*VC) TAO=TC/T CALL COEFF(A,E,D) F=DSQRT(TAO) FA1=A(1)*DLTA**D(1)/F+A(2)*F*DLTA**D(2)+ $ A(3)*TAO*DLTA**D(3)+A(4)*TAO**1.5*DLTA**D(4)+ $ A(5)*TAO**3*DLTA**D(5) FA2=A(6)*DLTA**D(6)+A(7)*TAO**3*DLTA**D(7)+ $ A(8)*TAO**4*DLTA**D(8)+A(9)*TAO**4*DLTA**D(9)+ $ A(10)*TAO**5*DLTA**D(10) FA3=A(11)*TAO**3*DLTA**D(11)+A(12)*TAO**5*DLTA**D(12)+ $ A(13)*TAO**6*DLTA**D(13)+A(14)*TAO**8*DLTA**D(14)+ $ A(15)*TAO**8*DLTA**D(15)+A(16)*TAO**10*DLTA**D(16)+ $ A(17)*TAO**10*DLTA**D(17) FA4=A(18)*TAO**5*DLTA**D(18)+A(19)*TAO**7.5*DLTA**D(19)+ $ A(20)*TAO**15*DLTA**D(20)+A(21)*TAO**30*DLTA**D(21) R0NH3=FA1+DEXP(-DLTA)*FA2+DEXP(-DLTA*DLTA)*FA3 $ +DEXP(-DLTA*DLTA*DLTA)*FA4 RETURN END C =============================================================== C ** Differential of the Helmholtz Free Energy of ** C **the Residual Part to Dimensionless Temperature T OF AMMONIA** C =============================================================== DOUBLE PRECISION FUNCTION R1NH3(V,T) DOUBLE PRECISION V,T,DLTA,TAO,FA1,FA2,FA3,FA4,F REAL A,E INTEGER D DIMENSION A(21),E(21),D(21) DATA TC/405.4/,VC/225./ DLTA=1./(V*VC) TAO=TC/T CALL COEFF(A,E,D) F=DSQRT(TAO) FA1=A(1)*(-0.5)*DLTA**D(1)/(TAO*F)+ $ A(2)*0.5*DLTA**D(2)/F+ $ A(3)*DLTA**D(3)+ $ A(4)*1.5*F*DLTA**D(4)+ $ A(5)*3*TAO*TAO*DLTA**D(5) FA2= $ A(7)*3*TAO*TAO*DLTA**D(7)+ $ A(8)*4*TAO**3*DLTA**D(8)+ $ A(9)*4*TAO**3*DLTA**D(9)+ $ A(10)*5*TAO**4*DLTA**D(10) FA3=A(11)*3*TAO*TAO*DLTA**D(11)+ $ A(12)*5*TAO**4*DLTA**D(12)+ $ A(13)*6*TAO**5*DLTA**D(13)+ $ A(14)*8*TAO**7*DLTA**D(14)+ $ A(15)*8*TAO**7*DLTA**D(15)+ $ A(16)*10*TAO**9*DLTA**D(16)+ $ A(17)*10*TAO**9*DLTA**D(17) FA4=A(18)*5*TAO**4*DLTA**D(18)+ $ A(19)*7.5*TAO**6.5*DLTA**D(19)+ $ A(20)*15*TAO**14*DLTA**D(20)+ $ A(21)*30*TAO**29*DLTA**D(21) R1NH3=FA1+DEXP(-DLTA)*FA2+DEXP(-DLTA*DLTA)*FA3 $ +DEXP(-DLTA*DLTA*DLTA)*FA4 RETURN END C =============================================================== C ** Differential of the Helmholtz Free Energy of the Residual ** C ** Part to Dimensionless Temperature TT OF AMMONIA ** C =============================================================== DOUBLE PRECISION FUNCTION R2NH3(V,T) DOUBLE PRECISION V,T,DLTA,TAO,FA1,FA2,FA3,FA4 REAL A,E INTEGER D DIMENSION A(21),E(21),D(21) DATA TC/405.4/,VC/225./ DLTA=1./(V*VC) TAO=TC/T CALL COEFF(A,E,D) FA1=A(1)*0.75*TAO**(-2.5)*DLTA**D(1)+ $ A(2)*(-0.25)*TAO**(-1.5)*DLTA**D(2)+ $ A(4)*0.75*TAO**(-0.5)*DLTA**D(4)+ $ A(5)*6*TAO*DLTA**D(5) FA2= $ A(7)*6*TAO*DLTA**D(7)+ $ A(8)*12*TAO*TAO*DLTA**D(8)+ $ A(9)*12*TAO*TAO*DLTA**D(9)+ $ A(10)*20*TAO*TAO*TAO*DLTA**D(10) FA3=A(11)*6*TAO*DLTA**D(11)+ $ A(12)*20*TAO*TAO*TAO*DLTA**D(12)+ $ A(13)*30*TAO**4*DLTA**D(13)+ $ A(14)*56*TAO**6*DLTA**D(14)+ $ A(15)*56*TAO**6*DLTA**D(15)+ $ A(16)*90*TAO**8*DLTA**D(16)+ $ A(17)*90*TAO**8*DLTA**D(17) FA4=A(18)*20*TAO**3*DLTA**D(18)+ $ A(19)*48.75*TAO**5.5*DLTA**D(19)+ $ A(20)*210*TAO**13*DLTA**D(20)+ $ A(21)*870*TAO**28*DLTA**D(21) R2NH3=FA1+DEXP(-DLTA)*FA2+DEXP(-DLTA*DLTA)*FA3+ $ DEXP(-DLTA*DLTA*DLTA)*FA4 RETURN END C =============================================================== C ** Differential of the Helmholtz Free Energy of the Residual ** C ** Part to Dimensionless Volume V OF AMMONIA ** C =============================================================== DOUBLE PRECISION FUNCTION R3NH3(V,T) DOUBLE PRECISION V,T,DLTA,TAO,FA1,FA2,FA3,FA4,F REAL A,E INTEGER D DIMENSION A(21),E(21),D(21) DATA TC/405.4/,VC/225./ DLTA=1./(V*VC) TAO=TC/T CALL COEFF(A,E,D) F=DSQRT(TAO) FA1=A(1)*D(1)*DLTA**(D(1)-1)/F+ $ A(2)*F*D(2)*DLTA**(D(2)-1)+ $ A(3)*TAO*D(3)*DLTA**(D(3)-1)+ $ A(4)*TAO**1.5*D(4)*DLTA**(D(4)-1)+ $ A(5)*TAO**3*D(5)*DLTA**(D(5)-1) FA2=A(6)*(D(6)*DLTA**(D(6)-1)-DLTA**D(6))+ $ A(7)*TAO**3*(D(7)*DLTA**(D(7)-1)-DLTA**D(7))+ $ A(8)*TAO**4*(D(8)*DLTA**(D(8)-1)-DLTA**D(8))+ $ A(9)*TAO**4*(D(9)*DLTA**(D(9)-1)-DLTA**D(9))+ $ A(10)*TAO**5*(D(10)*DLTA**(D(10)-1)-DLTA**D(10)) FA3=A(11)*TAO**3*(D(11)*DLTA**(D(11)-1)-2*DLTA**(D(11)+1))+ $ A(12)*TAO**5*(D(12)*DLTA**(D(12)-1)-2*DLTA**(D(12)+1))+ $ A(13)*TAO**6*(D(13)*DLTA**(D(13)-1)-2*DLTA**(D(13)+1))+ $ A(14)*TAO**8*(D(14)*DLTA**(D(14)-1)-2*DLTA**(D(14)+1))+ $ A(15)*TAO**8*(D(15)*DLTA**(D(15)-1)-2*DLTA**(D(15)+1))+ $ A(16)*TAO**10*(D(16)*DLTA**(D(16)-1)-2*DLTA**(D(16)+1))+ $ A(17)*TAO**10*(D(17)*DLTA**(D(17)-1)-2*DLTA**(D(17)+1)) FA4=A(18)*TAO**5*(D(18)*DLTA**(D(18)-1)-3*DLTA**(D(18)+2))+ $ A(19)*TAO**7.5*(D(19)*DLTA**(D(19)-1)-3*DLTA**(D(19)+2))+ $ A(20)*TAO**15*(D(20)*DLTA**(D(20)-1)-3*DLTA**(D(20)+2))+ $ A(21)*TAO**30*(D(21)*DLTA**(D(21)-1)-3*DLTA**(D(21)+2)) R3NH3=FA1+DEXP(-DLTA)*FA2+DEXP(-DLTA*DLTA)*FA3 $ +DEXP(-DLTA*DLTA*DLTA)*FA4 RETURN END C ================================================================ C ** Differential of the Helmholtz Free Energy of the Residual ** C ** Part to Dimensionless Volume and Temperature TV OF AMMONIA ** C ================================================================ DOUBLE PRECISION FUNCTION R4NH3(V,T) DOUBLE PRECISION V,T,TAO,DLTA,FA1,FA2,FA3,FA4,F REAL A,E INTEGER D DIMENSION A(21),E(21),D(21) DATA TC/405.4/,VC/225./ DLTA=1./(V*VC) TAO=TC/T CALL COEFF(A,E,D) F=DSQRT(TAO) FA1=A(1)*(-0.5)*D(1)*DLTA**(D(1)-1)/(TAO*F)+ $ A(2)*0.5*D(2)*DLTA**(D(2)-1)/F+ $ A(3)*D(3)*DLTA**(D(3)-1)+ $ A(4)*1.5*F*D(4)*DLTA**(D(4)-1)+ $ A(5)*3*TAO*TAO*D(5)*DLTA**(D(5)-1) FA2= $ A(7)*3*TAO*TAO*(D(7)*DLTA**(D(7)-1)-DLTA**D(7))+ $ A(8)*4*TAO**(3)*(D(8)*DLTA**(D(8)-1)-DLTA**D(8))+ $ A(9)*4*TAO**(3)*(D(9)*DLTA**(D(9)-1)-DLTA**D(9))+ $ A(10)*5*TAO**(4)*(D(10)*DLTA**(D(10)-1)-DLTA**D(10)) FA3= $ A(11)*3*TAO*TAO*(D(11)*DLTA**(D(11)-1)-2*DLTA**(D(11)+1))+ $ A(12)*5*TAO**(4)*(D(12)*DLTA**(D(12)-1)-2*DLTA**(D(12)+1))+ $ A(13)*6*TAO**(5)*(D(13)*DLTA**(D(13)-1)-2*DLTA**(D(13)+1))+ $ A(14)*8*TAO**(7)*(D(14)*DLTA**(D(14)-1)-2*DLTA**(D(14)+1))+ $ A(15)*8*TAO**(7)*(D(15)*DLTA**(D(15)-1)-2*DLTA**(D(15)+1))+ $ A(16)*10*TAO**(9)*(D(16)*DLTA**(D(16)-1)-2*DLTA**(D(16)+1))+ $ A(17)*10*TAO**(9)*(D(17)*DLTA**(D(17)-1)-2*DLTA**(D(17)+1)) FA4= $ A(18)*5*TAO**(4)*(D(18)*DLTA**(D(18)-1)-3*DLTA**(D(18)+2))+ $ A(19)*7.5*TAO**(6.5)*(D(19)*DLTA**(D(19)-1)-3*DLTA**(D(19)+2))+ $ A(20)*15*TAO**(14)*(D(20)*DLTA**(D(20)-1)-3*DLTA**(D(20)+2))+ $ A(21)*30*TAO**(29)*(D(21)*DLTA**(D(21)-1)-3*DLTA**(D(21)+2)) R4NH3=FA1+DEXP(-DLTA)*FA2+DEXP(-DLTA*DLTA)*FA3 $ +DEXP(-DLTA*DLTA*DLTA)*FA4 RETURN END C =============================================================== C ** Differential of the Helmholtz Free Energy of the Residual ** C ** Part to Dimensionless Volume VX OF AMMONIA ** C =============================================================== DOUBLE PRECISION FUNCTION R5NH3(V,T) DOUBLE PRECISION V,T,TAO,DLTA,FA1,FA2,FA3,FA4,F REAL A,E INTEGER D DIMENSION A(21),E(21),D(21) DATA TC/405.4/,VC/225./ DLTA=1./(V*VC) TAO=TC/T CALL COEFF(A,E,D) F=DSQRT(TAO) FA1=A(1)/F*D(1)*(D(1)-1)*DLTA**(D(1)-2)+ $ A(2)*F*D(2)*(D(2)-1)*DLTA**(D(2)-2)+ $ A(3)*TAO*D(3)*(D(3)-1)*DLTA**(D(3)-2)+ $ A(4)*TAO*F*D(4)*(D(4)-1)*DLTA**(D(4)-2)+ $ A(5)*TAO**3*D(5)*(D(5)-1)*DLTA**(D(5)-2) FA2=A(6)*(D(6)*(D(6)-1)*DLTA**(D(6)-2) $ -2*D(6)*DLTA**(D(6)-1)+DLTA**D(6)) $ +A(7)*TAO**3*(D(7)*(D(7)-1)*DLTA**(D(7)-2) $ -2*D(7)*DLTA**(D(7)-1)+DLTA**D(7)) $ +A(8)*TAO**4*(D(8)*(D(8)-1)*DLTA**(D(8)-2) $ -2*D(8)*DLTA**(D(8)-1)+DLTA**D(8)) $ +A(9)*TAO**4*(D(9)*(D(9)-1)*DLTA**(D(9)-2) $ -2*D(9)*DLTA**(D(9)-1)+DLTA**D(9)) $ +A(10)*TAO**5*(D(10)*(D(10)-1)*DLTA**(D(10)-2) $ -2*D(10)*DLTA**(D(10)-1)+DLTA**D(10)) FA3=A(11)*TAO**3*(D(11)*(D(11)-1)*DLTA**(D(11)-2) $ -(4*D(11)+2)*DLTA**D(11)+4*DLTA**(D(11)+2)) $ +(12)*TAO**5*(D(12)*(D(12)-1)*DLTA**(D(12)-2) $ -(4*D(12)+2)*DLTA**D(12)+4*DLTA**(D(12)+2)) $ +(13)*TAO**6*(D(13)*(D(13)-1)*DLTA**(D(13)-2) $ -(4*D(13)+2)*DLTA**D(13)+4*DLTA**(D(13)+2)) $ +(14)*TAO**8*(D(14)*(D(14)-1)*DLTA**(D(14)-2) $ -(4*D(14)+2)*DLTA**D(14)+4*DLTA**(D(14)+2)) $ +(15)*TAO**8*(D(15)*(D(15)-1)*DLTA**(D(15)-2) $ -(4*D(15)+2)*DLTA**D(15)+4*DLTA**(D(15)+2)) $ +(16)*TAO**10*(D(16)*(D(16)-1)*DLTA**(D(16)-2) $ -(4*D(16)+2)*DLTA**D(16)+4*DLTA**(D(16)+2)) $ +(17)*TAO**10*(D(17)*(D(17)-1)*DLTA**(D(17)-2) $ -(4*D(17)+2)*DLTA**D(17)+4*DLTA**(D(17)+2)) FA4= A(18)*TAO**5*(D(18)*(D(18)-1)*DLTA**(D(18)-2) $ -6*(D(18)+1)*DLTA**(D(18)+1)+9*DLTA**(D(18)+4)) $ +A(19)*TAO**7.5*(D(19)*(D(19)-1)*DLTA**(D(19)-2) $ -6*(D(19)+1)*DLTA**(D(19)+1)+9*DLTA**(D(19)+4)) $ +A(20)*TAO**15*(D(20)*(D(20)-1)*DLTA**(D(20)-2) $ -6*(D(20)+1)*DLTA**(D(20)+1)+9*DLTA**(D(20)+4)) $ +A(21)*TAO**30*(D(21)*(D(21)-1)*DLTA**(D(21)-2) $ -6*(D(21)+1)*DLTA**(D(21)+1)+9*DLTA**(D(21)+4)) R5NH3=FA1+DEXP(-DLTA)*FA2+DEXP(-DLTA*DLTA)*FA3 $ +DEXP(-DLTA*DLTA*DLTA)*FA4 RETURN END C =============================================================== C ** Helmholtz Free Energy of Ideal-Ammonia Properties ** C =============================================================== DOUBLE PRECISION FUNCTION I0NH3(V,T) DOUBLE PRECISION V,T,TAO,DLTA DOUBLE PRECISION A(5) DATA (A(J),J=1,5) /-15.815020,4.255726,11.474340,-1.296211, $ 0.5706757/ DATA TC/405.4/,VC/225./ DLTA=1./(V*VC) TAO=TC/T I0NH3=DLOG(DLTA)+A(1)+A(2)*TAO-DLOG(TAO)+A(3)*TAO**0.3333333333 $ +A(4)*TAO**(-1.5)+A(5)*TAO**(-1.75) RETURN END C ============================================================== c ** Differential of Helmholtz Free Energy of Ideal Gas ** c ** to Dimensionless Temperature (T) ** C ============================================================== DOUBLE PRECISION FUNCTION I1NH3(V,T) DOUBLE PRECISION V,T,TAO,DLTA DOUBLE PRECISION A(5) DATA (A(J),J=1,5) /-15.815020,4.255726,11.474340,-1.296211, $ 0.5706757/ DATA TC/405.4/,VC/225./ DLTA=1./(V*VC) TAO=TC/T I1NH3=A(2)-1./TAO+0.33333333*A(3)*TAO**(-0.66666667) $ -1.5*A(4)*TAO**(-2.5)-1.75*A(5)*TAO**(-2.75) RETURN END C ============================================================== c ** Differential of Helmholtz Free Energy of Ideal Gas ** c ** to Dimensionless TT ** C ============================================================== DOUBLE PRECISION FUNCTION I2NH3(V,T) DOUBLE PRECISION V,T,TAO,DLTA DOUBLE PRECISION A(5) DATA (A(J),J=1,5) /-15.815020,4.255726,11.474340,-1.296211, $ 0.5706757/ DATA TC/405.4/,VC/225./ DLTA=1./(V*VC) TAO=TC/T I2NH3=1./(TAO*TAO)-0.222222222*A(3)*TAO**(-1.66666667) $ +3.75*A(4)*TAO**(-3.5)+4.8125*A(5)*TAO**(-3.75) RETURN END C-------------------------------------------------------------- C CALCULATION OF THERMAL CONDUCTIVITY ALMPD(P) C-------------------------------------------------------------- DOUBLE PRECISION FUNCTION F06NH3(P) IMPLICIT DOUBLE PRECISION (A-H, O-Z) IF(P.LT.4.083393D04.OR.P.GT.1.046522D07) GO TO 200 T = G40NH3(P) IF (T.EQ.-1.0E+10) GO TO 100 IF (T.EQ.-1.0E+20) GO TO 200 VL = G53NH3(T) IF (VL.EQ.-1.0E+10) GO TO 100 IF (VL.EQ.-1.0E+20) GO TO 200 RHOL = 1.0D00/VL ALML = G08NH3(T, RHOL) F06NH3 = ALML RETURN 100 F06NH3 = -1.0E+10 RETURN 200 F06NH3 = -1.0E+20 RETURN END C-------------------------------------------------------------- C CALCULATION OF THERMAL CONDUCTIVITY ALMPDD(P) C-------------------------------------------------------------- DOUBLE PRECISION FUNCTION F07NH3(P) IMPLICIT DOUBLE PRECISION (A-H, O-Z) IF (P.LT.4.083393D04.OR.P.GT.9.710347D06) GO TO 200 T = G40NH3(P) IF (T.EQ.-1.0E+10) GO TO 100 IF (T.EQ.-1.0E+20) GO TO 200 C VV = G53NH3(T) C modified by R. Akasaka, March 27, 2000 VV = G54NH3(T) IF (VV.EQ.-1.0E+10) GO TO 100 IF (VV.EQ.-1.0E+20) GO TO 200 RHOV = 1.0D00/VV ALMV = G08NH3(T, RHOV) F07NH3 = ALMV RETURN 100 F07NH3 = -1.0E+10 RETURN 200 F07NH3 = -1.0E+20 RETURN END C-------------------------------------------------------------- C CALCULATION OF THERMAL CONDUCTIVITY ALMPT(P,T) C-------------------------------------------------------------- DOUBLE PRECISION FUNCTION F08NH3(P,T) IMPLICIT DOUBLE PRECISION (A-H, O-Z) IF (P.LT.0.OR.P.GT.50.0D06) GO TO 200 IF (T.LT.223.14999D00.OR.T.GT.573.15D00) GO TO 200 VV = G51NH3(P, T) IF (VV.EQ.-1.0E+10) GO TO 100 IF (VV.EQ.-1.0E+20) GO TO 200 RHO = 1.0D00/VV IF (T.LE.395.D00.OR.T.GE.430.D00) GO TO 50 IF (RHO.LE.112.5D00.OR.RHO.GE.337.5D00) GO TO 50 GO TO 200 50 ALM = G08NH3(T, RHO) F08NH3 = ALM RETURN 100 F08NH3 = -1.0E+10 RETURN 200 F08NH3 = -1.0E+20 RETURN END C-------------------------------------------------------------- C CALCULATION OF THERMAL CONDUCTIVITY ALMTD(T) C-------------------------------------------------------------- DOUBLE PRECISION FUNCTION F09NH3(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF(T.LT.223.14999D00.OR.T.GT.401.064D00) GOTO 200 VL = G53NH3(T) IF (VL.EQ.1.0E+10) GO TO 100 IF (VL.EQ.1.0E+20) GO TO 200 RHOL = 1.0D00/VL ALML = G08NH3(T, RHOL) F09NH3 = ALML RETURN 100 F09NH3 = -1.0E+10 RETURN 200 F09NH3 = -1.0E+20 RETURN END C-------------------------------------------------------------- C CALCULATION OF THERMAL CONDUCTIVITY ALMTDD(T) C-------------------------------------------------------------- DOUBLE PRECISION FUNCTION F10NH3(T) IMPLICIT DOUBLE PRECISION (A-H, O-Z) IF (T.LT.223.14999D00.OR.T.GT.396.8669D00) GO TO 200 VV = G54NH3(T) IF (VV.EQ.-1.0E+10) GO TO 100 IF (VV.EQ.-1.0E+20) GO TO 200 RHOV = 1.0D00/VV ALMV = G08NH3(T, RHOV) F10NH3 = ALMV RETURN 100 F10NH3 = -1.0E+10 RETURN 200 F10NH3 = -1.0E+20 RETURN END C-------------------------------------------------------------- C CALCULATION OF VISCOSITY AMUPD(P) C-------------------------------------------------------------- DOUBLE PRECISION FUNCTION F11NH3(P) IMPLICIT DOUBLE PRECISION (A-H, O-Z) IF (P.LT.0.006060D+6.OR.P.GT.11.36D+6) GO TO 200 T = G40NH3(P) IF (T.EQ.-1.0E+10) GO TO 100 IF (T.EQ.-1.0E+20) GO TO 200 VL = G53NH3(T) IF (VL.EQ.-1.0E+10) GO TO 100 IF (VL.EQ.-1.0E+20) GO TO 200 RHOL = 1.0D00/VL AMUL = G13NH3(T, RHOL) F11NH3 = AMUL RETURN 100 F11NH3 = -1.0E+10 RETURN 200 F11NH3 = -1.0E+20 RETURN END C-------------------------------------------------------------- C CALCULATION OF VISCOSITY AMUPDD(P) C-------------------------------------------------------------- DOUBLE PRECISION FUNCTION F12NH3(P) IMPLICIT DOUBLE PRECISION (A-H, O-Z) IF (P.LT.0.006060D+6.OR.P.GT.11.36D+6) GO TO 200 T = G40NH3(P) IF (T.EQ.-1.0E+10) GO TO 100 IF (T.EQ.-1.0E+20) GO TO 200 VV = G54NH3(T) IF (VV.EQ.-1.0E+10) GO TO 100 IF (VV.EQ.-1.0E+20) GO TO 200 RHOV = 1.0D00/VV AMUV = G13NH3(T, RHOV) F12NH3 = AMUV RETURN 100 F12NH3 = -1.0E+10 RETURN 200 F12NH3 = -1.0E+20 RETURN END C-------------------------------------------------------------- C CALCULATION OF VISCOSITY AMUPT(P,T) C-------------------------------------------------------------- DOUBLE PRECISION FUNCTION F13NH3(P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IF (P.LT.0.OR.P.GT.50.0001D06) GO TO 200 IF(T.LT.196.D00.OR.T.GT.700.D00) GO TO 200 VV = G51NH3(P, T) IF (VV.EQ.-1.0E+10) GO TO 100 IF (VV.EQ.-1.0E+20) GO TO 200 RHO = 1.0D00/VV AMU = G13NH3(T, RHO) F13NH3 = AMU RETURN 100 F13NH3 = -1.0E+10 RETURN 200 F13NH3 = -1.0E+20 RETURN END C-------------------------------------------------------------- C CALCULATION OF VISCOSITY AMUTD(T) C-------------------------------------------------------------- DOUBLE PRECISION FUNCTION F14NH3(T) IMPLICIT DOUBLE PRECISION (A-H, O-Z) IF (T.LT.196.D00.OR.T.GT.405.40D00) GO TO 200 VL = G53NH3(T) IF (VL.EQ.-1.0E+10) GO TO 100 IF (VL.EQ.-1.0E+20) GO TO 200 RHOL = 1.0D00/VL AMUL = G13NH3(T, RHOL) F14NH3 = AMUL RETURN 100 F14NH3 = -1.0E+10 RETURN 200 F14NH3 = -1.0E+20 RETURN END C-------------------------------------------------------------- C CALCULATION OF VISCOSITY AMUTDD(T) C-------------------------------------------------------------- DOUBLE PRECISION FUNCTION F15NH3(T) IMPLICIT DOUBLE PRECISION (A-H, O-Z) IF (T.LT.196.D00.OR.T.GT.405.40D00) GO TO 200 VV = G54NH3(T) IF (VV.EQ.-1.0E+10) GO TO 100 IF (VV.EQ.-1.0E+20) GO TO 200 RHOV = 1.0D00/VV AMUV = G13NH3(T, RHOV) F15NH3 = AMUV RETURN 100 F15NH3 = -1.0E+10 RETURN 200 F15NH3 = -1.0E+20 RETURN END C--------------------------------------- C CALCULATION OF SURFACE TENSION SIGP(P) C--------------------------------------- DOUBLE PRECISION FUNCTION F31NH3(P) IMPLICIT DOUBLE PRECISION (A-H, O-Z) IF (P.LT.1.082074D04.OR.P.GT.1.161927D06) GO TO 200 T = G40NH3(P) IF (T.EQ.-1.0E+10) GO TO 100 IF (T.EQ.-1.0E+20) GO TO 200 SIG = G32NH3(T) F31NH3 = SIG RETURN 100 F31NH3 = -1.0E+10 RETURN 200 F31NH3 = -1.0E+20 RETURN END C--------------------------------------- C CALCULATION OF SURFACE TENSION SIGT(T) C--------------------------------------- DOUBLE PRECISION FUNCTION F32NH3(T) IMPLICIT DOUBLE PRECISION (A-H, O-Z) IF (T.LT.203.0D00.OR.T.GT.303.0D00) GO TO 200 SIG = G32NH3(T) F32NH3 = SIG RETURN 100 F32NH3 = -1.0E+10 RETURN 200 F32NH3 = -1.0E+20 RETURN END C====================================================== C FUNCTION G32NH3(T) C CALCULATION OF SURFACE TENSION C====================================================== DOUBLE PRECISION FUNCTION G32NH3(T) IMPLICIT DOUBLE PRECISION (A-H, O-Z) SIG = 90.301D00*(1.0D00-T/405.5D00)**1.0862 G32NH3 = SIG*1.0D-3 RETURN END C===================================================== C FUNCTION G08NH3(T, RHO) C CALCULATION OF THERMAL CONDUCTIVITY C===================================================== DOUBLE PRECISION FUNCTION G08NH3(T, RHO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION A(4), B(4) DATA A / -0.480157150D01, 0.671200671D-1, 0.112800921D-3, 1 -0.439120180D-7/ DATA B / 0.324878979D00, 0.630423411D-4, 0.148929156D-5, 1 -0.742513551D-9/ T2 = T*T RHO2 = RHO*RHO RLAM0 = A(1)+A(2)*T+A(3)*T2+A(4)*T2*T RLAMB = B(1)*RHO+B(2)*RHO2+B(3)*RHO2*RHO+B(4)*RHO2*RHO2 RLAM = RLAM0+RLAMB G08NH3 = RLAM*1.0D-3 RETURN END C====================================================== C FUNCTION G13NH3(T, RHO) C CALCULATION OF VISCOSITY C====================================================== DOUBLE PRECISION FUNCTION G13NH3(T, RHO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION A(5), C(13), D(5,4) DATA A/ 4.99318220D00, -0.61122364D00, 0.0, 1 0.18535124D00, -0.11160946D00/ DATA C/ -0.17999496D01, 0.46692621D02, -0.53460794D03, 1 0.33604074D04, -0.13019164D05, 0.33414230D05, -0.58711743D05, 2 0.71426686D05, -0.59834012D05, 0.33652741D05, -0.12027350D05, 3 0.24348205D04, -0.20807957D03/ DATA D/ 0.0, 0.0, 0.0, 0.0, 0.0, 1 0.0, 0.0, 2.19664285D-1, 0.0, -0.83651107D-1, 2 0.17366936D-2, -0.64250359D-2, 0.0, 0.0, 0.0, 3 0.0, 0.0, 0.167668649D-3, -0.14971009D-3, 0.77012274D-4/ DATA SIGM / 0.2957D00 / RHOM = RHO/17.03026D00 AT = T/386.D00 SS = 0.0 DO 10 I=1,5 SS = SS+A(I)*(DLOG(AT))**(I-1) 10 CONTINUE SS1 = DEXP(SS) ETA0 =100.0D00*0.021357D00*DSQRT(17.03026D00*T)/(SIGM*SIGM*SS1) S2 = 0.0 DO 20 I=1,13 S2 = S2+C(I)*(DSQRT(AT))**(1-I) 20 CONTINUE BE = S2*0.6022137D00*SIGM**3 S3 = 0.0 DO 50 I=2,4 SUM = 0.0 DO 30 J=1,5 SUM = SUM+D(J,I)/AT**(J-1) 30 CONTINUE S3 = S3+SUM*RHOM**I 50 CONTINUE BVIR = BE*RHOM SS5 = ETA0*BVIR ETA = ETA0+SS5+S3 G13NH3 = ETA*1.0D-6 RETURN END