C ***************************** C C * PROPATH VER.11.1 * C C * ARGPROP VER.1.2 * C C ***************************** 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 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 C------------------------------------------------- F1 = AIPPT REAL FUNCTION AIPPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'AIPPT'/ PP=P TT=T CALL S99D05(FNAME) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT REAL FUNCTION AJTPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'AJTPT'/ PP=P TT=T CALL S99D05(FNAME) AJTPT=-1.0E+30 RETURN END C------------------------------------------------- F2 = ALAPP REAL FUNCTION ALAPP(P) CHARACTER FUN*6 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALAPP'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F2ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALAPT'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F3ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALHP'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F4ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALHT'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F5ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALHT=FF RETURN END C------------------------------------------------- F6 = ALMPD REAL FUNCTION ALMPD(P) CHARACTER FUN*6 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALMPD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F6ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMPD=FF RETURN END C------------------------------------------------- F7 = ALMPDD REAL FUNCTION ALMPDD(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'ALMPDD'/ PP=P CALL S99D05(FNAME) ALMPDD=-1.0E+30 RETURN END C------------------------------------------------- F8 = ALMPT REAL FUNCTION ALMPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'ALMPT'/ PP=P TT=T CALL S99D05(FNAME) ALMPT=-1.0E+30 RETURN END C------------------------------------------------- F9 = ALMTD REAL FUNCTION ALMTD(T) CHARACTER FUN*6 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALMTD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F9ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMTD=FF RETURN END C------------------------------------------------- F10 = ALMTDD REAL FUNCTION ALMTDD(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'ALMTDD'/ TT=T CALL S99D05(FNAME) ALMTDD=-1.0E+30 RETURN END C------------------------------------------------- F11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'AMUPD'/ PP=P CALL S99D05(FNAME) AMUPD=-1.0E+30 RETURN END C------------------------------------------------- F12 = AMUPDD REAL FUNCTION AMUPDD(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'AMUPDD'/ PP=P CALL S99D05(FNAME) AMUPDD=-1.0E+30 RETURN END C------------------------------------------------- F13 = AMUPT REAL FUNCTION AMUPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'AMUPT'/ PP=P TT=T CALL S99D05(FNAME) AMUPT=-1.0E+30 RETURN END C------------------------------------------------- F14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'AMUTD'/ TT=T CALL S99D05(FNAME) AMUTD=-1.0E+30 RETURN END C------------------------------------------------- F15 = AMUTDD REAL FUNCTION AMUTDD(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'AMUTDD'/ TT=T CALL S99D05(FNAME) AMUTDD=-1.0E+30 RETURN END C------------------------------------------------- F92 = BPPT REAL FUNCTION BPPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'BPPT'/ PP=P TT=T CALL S99D05(FNAME) BPPT=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT REAL FUNCTION BSPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'BSPT'/ PP=P TT=T CALL S99D05(FNAME) BSPT=-1.0E+30 RETURN END C------------------------------------------------- F91 = BTPT REAL FUNCTION BTPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'BTPT'/ PP=P TT=T CALL S99D05(FNAME) BTPT=-1.0E+30 RETURN END C------------------------------------------------- F93 = BVPT REAL FUNCTION BVPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'BVPT'/ PP=P TT=T CALL S99D05(FNAME) BVPT=-1.0E+30 RETURN END C------------------------------------------------- F16 = CPPD REAL FUNCTION CPPD(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'CPPD'/ PP=P CALL S99D05(FNAME) CPPD=-1.0E+30 RETURN END C------------------------------------------------- F17 = CPPDD REAL FUNCTION CPPDD(P) CHARACTER FUN*6 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPPDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F17ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPPT'/ C--- SET OF UNIT --- 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 PI=P*PBAR TI=T-T0K C--- FUNCTION CALL --- FF = F18ARG(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPPT=FF RETURN END C------------------------------------------------- F19 = CPTD REAL FUNCTION CPTD(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'CPTD'/ TT=T CALL S99D05(FNAME) CPTD=-1.0E+30 RETURN END C------------------------------------------------- F20 = CPTDD REAL FUNCTION CPTDD(T) CHARACTER FUN*6 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPTDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F20ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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,FLUID*16 REAL T0K,PBAR,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CRP'/ ,FLUID/'ARGON'/ C--- SET OF UNIT --- 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 C--- FUNCTION CALL --- FF = F21ARG(A) C--- LEVEL 2 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+20) THEN IF (MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A10, &' WHEN A= ',A,' ****') ENDIF FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- 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------------------------------------------------- F22 = EPSPT REAL FUNCTION EPSPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'EPSPT'/ TT=T PP=P CALL S99D05(FNAME) 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='39.948' WHEN A='M' C B='208.13' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=39.948 ELSE IF (A.EQ.'R') THEN FC=208.13 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR ARGON WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F96 = GAMPDD REAL FUNCTION GAMPDD(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'GAMPDD'/ PP=P CALL S99D05(FNAME) GAMPDD=-1.0E+30 RETURN END C------------------------------------------------- F95 = GAMPT REAL FUNCTION GAMPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'GAMPT'/ PP=P TT=T CALL S99D05(FNAME) GAMPT=-1.0E+30 RETURN END C------------------------------------------------- F97 = GAMTDD REAL FUNCTION GAMTDD(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'GAMTDD'/ TT=T CALL S99D05(FNAME) GAMTDD=-1.0E+30 RETURN END C------------------------------------------------- F23 = HPD REAL FUNCTION HPD(P) CHARACTER FUN*6 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F23ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F24ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPDD=FF RETURN END C------------------------------------------------- F25 = HPT REAL FUNCTION HPT(P,T) CHARACTER FUN*6 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPT'/ C--- SET OF UNIT --- 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 PI=P*PBAR TI=T-T0K C--- FUNCTION CALL --- FF = F25ARG(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,X,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPX'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F26ARG(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HTD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F27ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HTDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F28ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HTX'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F29ARG(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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='ARGON' WHEN A='S' C B='AR' 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='ARGON' ELSE IF (A.EQ.'C') THEN IDENTF='AR' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR ARGON WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F30 = PST REAL FUNCTION PST(T) CHARACTER FUN*6 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'PST'/ C--- SET OF UNIT --- 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 TI=T-T0K C--- FUNCTION CALL --- FF = F30ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 PST=FF/PBAR RETURN END C------------------------------------------------- F31 = SIGP REAL FUNCTION SIGP(P) CHARACTER FUN*6 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SIGP'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F31ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SIGT'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F32ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F33ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F34ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPT'/ C--- SET OF UNIT --- 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 PI=P*PBAR TI=T-T0K C--- FUNCTION CALL --- FF = F35ARG(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,X,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPX'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F36ARG(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'STD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F37ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'STDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F38ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'STX'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F39ARG(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- STX=FF RETURN END C------------------------------------------------- F40 = TSP REAL FUNCTION TSP(P) CHARACTER FUN*6 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TSP'/ C--- SET OF UNIT --- 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 PI=P*PBAR C--- FUNCTION CALL --- FF = F40ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TSP=FF+T0K RETURN END C------------------------------------------------- F41 = TRPL REAL FUNCTION TRPL(A) CHARACTER FUN*6,A*1,FLUID*16 REAL T0K,PBAR,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TRPL'/ ,FLUID/'ARGON'/ C--- SET OF UNIT --- 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 C--- FUNCTION CALL --- FF = F41ARG(A) C--- LEVEL 2 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+20) THEN IF (MESS.NE.0) THEN WRITE(6,6010) FUN,FLUID,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A10,' WHEN A=', &A,' ****') ENDIF FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- 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------------------------------------------------- F42 = UPD REAL FUNCTION UPD(P) CHARACTER FUN*6 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F42ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F43ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UPDD=FF RETURN END C------------------------------------------------- F44 = UPT REAL FUNCTION UPT(P,T) CHARACTER FUN*6 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPT'/ C--- SET OF UNIT --- 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 PI=P*PBAR TI=T-T0K C--- FUNCTION CALL --- FF = F44ARG(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,X,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPX'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F45ARG(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UTD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F46ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UTDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F47ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UTX'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F48ARG(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F49ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F50ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VPDD=FF RETURN END C------------------------------------------------- F51 = VPT REAL FUNCTION VPT(P,T) CHARACTER FUN*6 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPT'/ C--- SET OF UNIT --- 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 PI=P*PBAR TI=T-T0K C--- FUNCTION CALL --- FF = F51ARG(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,X,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPX'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F52ARG(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F53ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F54ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTX'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F55ARG(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VTX=FF RETURN END C------------------------------------------------- F56 = XPH REAL FUNCTION XPH(P,H) CHARACTER FUN*6 REAL PBAR,P,H,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XPH'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F56ARG(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XPS'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F57ARG(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,U,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XPU'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F58ARG(PI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 PBAR,P,V,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XPV'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F59ARG(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,H,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XTH'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F60ARG(TI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XTS'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F61ARG(TI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,U,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XTU'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F62ARG(TI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,V,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XTV'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F63ARG(TI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XTV=FF RETURN END C------------------------------------------------- F64 = TPH REAL FUNCTION TPH(P,H) CHARACTER FUN*6 REAL T0K,PBAR,P,H,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TPH'/ C--- SET OF UNIT --- 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 PI=P*PBAR C--- FUNCTION CALL --- FF = F64ARG(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TPH=FF+T0K RETURN END C------------------------------------------------- F65 = TPS REAL FUNCTION TPS(P,S) CHARACTER FUN*6 REAL T0K,PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TPS'/ C--- SET OF UNIT --- 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 PI=P*PBAR C--- FUNCTION CALL --- FF = F65ARG(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TPS=FF+T0K RETURN END C------------------------------------------------- F66 = PLDT REAL FUNCTION PLDT(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'PLDT'/ TT=T CALL S99D05(FNAME) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT REAL FUNCTION PMLT(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'PMLT'/ TT=T CALL S99D05(FNAME) PMLT=-1.0E+30 RETURN END C------------------------------------------------- F99 = PSBT REAL FUNCTION PSBT(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'PSBT'/ TT=T CALL S99D05(FNAME) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F67 = TLDP REAL FUNCTION TLDP(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'TLDT'/ PP=P CALL S99D05(FNAME) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP REAL FUNCTION TMLP(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'TMLP'/ PP=P CALL S99D05(FNAME) TMLP=-1.0E+30 RETURN END C------------------------------------------------- F98 = TPSEUP REAL FUNCTION TPSEUP(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'TPSEUP'/ PP=P CALL S99D05(FNAME) TPSEUP=-1.0E+30 RETURN END C------------------------------------------------- F100 = TSBP REAL FUNCTION TSBP(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'TSBP'/ PP=P CALL S99D05(FNAME) TSBP=-1.0E+30 RETURN END C------------------------------------------------- F70 = TPV REAL FUNCTION TPV(P,V) CHARACTER FUN*6 REAL T0K,PBAR,P,V,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TPV'/ C--- SET OF UNIT --- 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 PI=P*PBAR C--- FUNCTION CALL --- FF = F70ARG(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TPV=FF+T0K RETURN END C------------------------------------------------- F71 = HPS REAL FUNCTION HPS(P,S) CHARACTER FUN*6 REAL PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPS'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F71ARG(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPS=FF RETURN END C------------------------------------------------- F72 = PSTD REAL FUNCTION PSTD(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'PSTD'/ TT=T CALL S99D05(FNAME) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD REAL FUNCTION PSTDD(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'PSTDD'/ TT=T CALL S99D05(FNAME) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F74 = TSPD REAL FUNCTION TSPD(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'TSPD'/ PP=P CALL S99D05(FNAME) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD REAL FUNCTION TSPDD(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'TSPDD'/ PP=P CALL S99D05(FNAME) TSPDD=-1.0E+30 RETURN END C------------------------------------------------- F76 = CVPDD REAL FUNCTION CVPDD(P) CHARACTER FUN*6 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CVPDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F76ARG(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(1,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CVPT'/ C--- SET OF UNIT --- 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 PI=P*PBAR TI=T-T0K C--- FUNCTION CALL --- FF = F77ARG(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(3,P,T,'P','T',FUN) FF=-1.0E+20 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 T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CVTDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F78ARG(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN CALL S97D05(FUN) FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D05(2,P,T,'P','T',FUN) FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CVTDD=FF RETURN END C------------------------------------------------- F79 = UPS REAL FUNCTION UPS(P,S) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'UPS'/ PP=P SS=S CALL S99D05(FNAME) UPS=-1.0E+30 RETURN END C------------------------------------------------- F80 = VPS REAL FUNCTION VPS(P,S) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'VPS'/ PP=P SS=S CALL S99D05(FNAME) VPS=-1.0E+30 RETURN END C------------------------------------------------- F81 = PRPT REAL FUNCTION PRPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'PRPT'/ PP=P TT=T CALL S99D05(FNAME) PRPT=-1.0E+30 RETURN END C------------------------------------------------- F82 = AKPT REAL FUNCTION AKPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'AKPT'/ PP=P TT=T CALL S99D05(FNAME) AKPT=-1.0E+30 RETURN END C------------------------------------------------- F83 = WPT REAL FUNCTION WPT(P,T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'WPT'/ PP=P TT=T CALL S99D05(FNAME) WPT=-1.0E+30 RETURN END *------------------------------------------------- F85D05 = PRPD REAL FUNCTION PRPD(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'PRPD'/ PI=P CALL S99D05(FNAME) PRPD=-1.0E+30 RETURN END *------------------------------------------------- F86D05 = PRPDD REAL FUNCTION PRPDD(P) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'PRPDD'/ PI=P CALL S99D05(FNAME) PRPDD=-1.0E+30 RETURN END *------------------------------------------------- F87D05 = PRTD REAL FUNCTION PRTD(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'PRTD'/ TI=T CALL S99D05(FNAME) PRTD=-1.0E+30 RETURN END *------------------------------------------------- F88D05 = PRTDD REAL FUNCTION PRTDD(T) CHARACTER FNAME*6 COMMON/UNIT/KPA,MESS DATA FNAME/'PRTDD'/ TI=T CALL S99D05(FNAME) PRTDD=-1.0E+30 RETURN END C ***** SUBROUTINE FOR ERROR MESSAGE ******** C **** LEVEL 1 ERROR MESSAGE -- SUBROUTINE S97D05(FUN) COMMON/UNIT/KPA,MESS CHARACTER FUN*6,MSG*125 IF (MESS.NE.0) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ARGON ***' WRITE(6,*) MSG END IF RETURN END C **** LEVEL 2 ERROR MESSAGE -- SUBROUTINE S98D05(IPT,P,T,N1,N2,FUN) COMMON/UNIT/KPA,MESS CHARACTER FUN*6,N1*1,N2*1 IF (MESS.NE.0) THEN IF (IPT.EQ.1) THEN C--- FUN(P) TYPE WRITE(6,6010) FUN,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ARGON ', & ' WHEN P =',1PE14.7,' ****') C--- FUN(T) TYPE ELSEIF (IPT.EQ.2) THEN WRITE(6,6020) FUN,T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ARGON ', & ' WHEN T =',1PE14.7,' ****') C--- FUN(P,T) TYPE ELSE WRITE(6,6030) FUN,N1,P,N2,T 6030 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ARGON ', & ' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') ENDIF END IF RETURN END C***** LEVEL 3 ERROR MESSAGE - SUBROUTINE S99D05(FNAME) COMMON/UNIT/KPA,MESS CHARACTER FNAME*6,MSG*125 IF(MESS.NE.0) THEN MSG='**** FUNCTION '//FNAME//' UNAVAILABLE FOR ARGON ****' WRITE(6,100) MSG 100 FORMAT(1H ,5X,A) END IF RETURN END C02 + LAPLACE COEFFICIENT AT P REAL FUNCTION F2ARG(P) T=F40ARG(P) IF (T.EQ.-1E20) GOTO 999 F2ARG=G5ARG(T) RETURN 999 F2ARG=-1E20 RETURN END C03 + LAPLACE COEFFICIENT AT T REAL FUNCTION F3ARG(T) IF (T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 F3ARG=G5ARG(T) RETURN 999 F3ARG=-1E20 RETURN END C04 + LATENT HEAT OF VAPORIZATION AT P REAL FUNCTION F4ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) YDPDTS=G2ARG(YP,YT) CALL S1ARG(YT,YVL,YVG) F4ARG=REAL((YVG-YVL)*YT*YDPDTS)*1E5 RETURN 999 F4ARG=-1E20 RETURN END C05 + LATENT HEAT OF VAPORIZATION AT T REAL FUNCTION F5ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YT=DBLE(T+273.15) YP=G1ARG(YT) YDPDTS=G2ARG(YP,YT) CALL S1ARG(YT,YVL,YVG) F5ARG=REAL((YVG-YVL)*YT*YDPDTS)*1E5 RETURN 999 F5ARG=-1E20 RETURN END C06 + THERMAL CONDUCTIVITY AT SATURATED LIQUID AT P REAL FUNCTION F6ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) F6ARG=REAL(G6ARG(YT)) RETURN 999 F6ARG=-1E20 RETURN END C09 + THERMAL CONDUCTIVITY AT SATURATED LIQUID T REAL FUNCTION F9ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-133.15) GOTO 999 YT=DBLE(T+273.15) F9ARG=REAL(G6ARG(YT)) RETURN 999 F9ARG=-1E20 RETURN END C17 + ISOBARIC SPECIFIC HEAT OF SATURATED VAPOUR AT P REAL FUNCTION F17ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) CALL S1ARG(YT,YVL,YVG) F17ARG=REAL(G16ARG(YT,YVG)) RETURN 999 F17ARG=-1E20 RETURN END C18 + ISOBARIC SPECIFIC HEAT AT P AND T REAL FUNCTION F18ARG(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YT=DBLE(T+273.15) YP=DBLE(P) YV=G10ARG(YP,YT) IF (YV.EQ.-1E10) THEN F18ARG=-1E10 ELSEIF (YV.EQ.-1E20) THEN F18ARG=-1E20 ELSE F18ARG=REAL(G16ARG(YT,YV)) ENDIF RETURN END C20 + ISOBARIC SPECIFIC HEAT OF SATURATED VAPOUR AT T REAL FUNCTION F20ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YT=DBLE(T+273.15) CALL S1ARG(YT,YVL,YVG) F20ARG=REAL(G16ARG(YT,YVG)) RETURN 999 F20ARG=-1E20 RETURN END C21 + CRITICAL POINT REAL FUNCTION F21ARG(A) CHARACTER*1 A IF (A.EQ.'H') THEN F21ARG=1.8917E5 ELSEIF (A.EQ.'P') THEN F21ARG=49.98 ELSEIF (A.EQ.'S') THEN F21ARG=2.201E3 ELSEIF (A.EQ.'T') THEN F21ARG=-122.29 ELSEIF (A.EQ.'V') THEN F21ARG=1E0/535.7 ELSE F21ARG=-1E20 ENDIF RETURN END C23 + SPECIFIC ENTHALPY OF SATURATED LIQUID AT P REAL FUNCTION F23ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) YDPDTS=G2ARG(YP,YT) CALL S1ARG(YT,YVL,YVG) YF23S=REAL(G13ARG(YT,YVG)) YF5DH=YF23S-(YVG-YVL)*YT*YDPDTS*1D5 F23ARG=YF5DH RETURN 999 F23ARG=-1E20 RETURN END C24 + SPECIFIC ENTHALPY OF SATURATED VAPOUR AT P REAL FUNCTION F24ARG(P) F24ARG=F26ARG(P,1E0) RETURN END C25 + SPECIFIC ENTHALPY AT PAND T REAL FUNCTION F25ARG(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YT=DBLE(T+273.15) YV=G10ARG(YP,YT) IF (YV.EQ.-1E10) THEN F25ARG=-1E10 ELSEIF (YV.EQ.-1E20) THEN F25ARG=-1E20 ELSE F25ARG=REAL(G13ARG(YT,YV)) ENDIF RETURN END C26 + SPECIFIC ENTHALPY OF MIXTURE AT P REAL FUNCTION F26ARG(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) YDPDTS=G2ARG(YP,YT) CALL S1ARG(YT,YVL,YVG) YF23H=G13ARG(YT,YVG) YF4DH=YF23H-(YVG-YVL)*YT*YDPDTS*1D5 F26ARG=REAL(X*YF23H+(1-X)*YF4DH) RETURN 999 F26ARG=-1E20 RETURN END C27 + SPECIFIC ENTHALPY OF SATURATED LIQUID AT T REAL FUNCTION F27ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YT=DBLE(T+273.15) YP=G1ARG(YT) YDPDTS=G2ARG(YP,YT) CALL S1ARG(YT,YVL,YVG) YF27S=REAL(G13ARG(YT,YVG)) YF5DH=YF27S-(YVG-YVL)*YT*YDPDTS*1D5 F27ARG=YF5DH RETURN 999 F27ARG=-1E20 RETURN END C28 + SPECIFIC ENTHALPY OF SATURATED VAPOUR AT T REAL FUNCTION F28ARG(T) F28ARG=F29ARG(T,1E0) RETURN END C29 + SPECIFIC ENTHALPY OF MIXTURE AT T REAL FUNCTION F29ARG(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YP=G1ARG(YT) YDPDTS=G2ARG(YP,YT) CALL S1ARG(YT,YVL,YVG) YF27H=G13ARG(YT,YVG) YF5DH=YF27H-(YVG-YVL)*YT*YDPDTS*1D5 F29ARG=REAL(X*YF27H+(1-X)*YF5DH) RETURN 999 F29ARG=-1E20 RETURN END C30 + SATURATION PRESSURE AT T REAL FUNCTION F30ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YT=DBLE(T+273.15) F30ARG=REAL(G1ARG(YT)) RETURN 999 F30ARG=-1E20 RETURN END C31 + SURFACE TENSION AT P REAL FUNCTION F31ARG(P) T=F40ARG(P) IF (T.EQ.-1E20) GOTO 999 F31ARG=G4ARG(T) RETURN 999 F31ARG=-1E20 RETURN END C32 + SURFACE TENSION AT T REAL FUNCTION F32ARG(T) IF (T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 F32ARG=G4ARG(T) RETURN 999 F32ARG=-1E20 RETURN END C33 + SPECIFIC ENTROPY OF SATURATED LIQUID AT P REAL FUNCTION F33ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) YDPDTS=G2ARG(YP,YT) CALL S1ARG(YT,YVL,YVG) YF33S=REAL(G14ARG(YT,YVL)) YF5DS=YF33S-(YVG-YVL)*YDPDTS*1D5 F33ARG=YF5DS RETURN 999 F33ARG=-1E20 RETURN END C34 + SPECIFIC ENTROPY OF SATURATED VAPOUR AT P REAL FUNCTION F34ARG(P) F34ARG=F36ARG(P,1E0) RETURN END C35 + SPECIFIC ENTROPY AT PAND T REAL FUNCTION F35ARG(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YT=DBLE(T+273.15) YV=G10ARG(YP,YT) IF (YV.EQ.-1E10) THEN F35ARG=-1E10 ELSEIF (YV.EQ.-1E20) THEN F35ARG=-1E20 ELSE F35ARG=REAL(G14ARG(YT,YV)) ENDIF RETURN END C36 + SPECIFIC ENTROPY OF MIXTURE AT P REAL FUNCTION F36ARG(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) YDPDTS=G2ARG(YP,YT) CALL S1ARG(YT,YVL,YVG) YF33S=G14ARG(YT,YVG) YF4DS=YF33S-(YVG-YVL)*YDPDTS*1D5 F36ARG=REAL(X*YF33S+(1-X)*YF4DS) RETURN 999 F36ARG=-1E20 RETURN END C37 + SPECIFIC ENTROPY OF SATURATED LIQUID AT T REAL FUNCTION F37ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YT=DBLE(T+273.15) YP=G1ARG(YT) YDPDTS=G2ARG(YP,YT) CALL S1ARG(YT,YVL,YVG) YF37S=REAL(G14ARG(YT,YVG)) YF5DS=YF37S-(YVG-YVL)*YDPDTS*1D5 F37ARG=YF5DS RETURN 999 F37ARG=-1E20 RETURN END C38 + SPECIFIC ENTROPY OF SATURATED VAPOUR AT T REAL FUNCTION F38ARG(T) F38ARG=F39ARG(T,1E0) RETURN END C39 + SPECIFIC ENTROPY OF MIXTURE AT T REAL FUNCTION F39ARG(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YP=G1ARG(YT) YDPDTS=G2ARG(YP,YT) CALL S1ARG(YT,YVL,YVG) YF37S=G14ARG(YT,YVG) YF5DS=YF37S-(YVG-YVL)*YDPDTS*1D5 F39ARG=REAL(X*YF37S+(1-X)*YF5DS) RETURN 999 F39ARG=-1E20 RETURN END C40 + SATURATION TEMPERATURE AT P REAL FUNCTION F40ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 F40ARG=REAL(G3ARG(DBLE(P)))-273.15 RETURN 999 F40ARG=-1E20 RETURN END C41 + TRIPLE POINT REAL FUNCTION F41ARG(A) CHARACTER*1 A IF (A.EQ.'P') THEN F41ARG=0.6875 ELSEIF (A.EQ.'T') THEN F41ARG=-189.37 ELSE F41ARG=-1E20 ENDIF RETURN END C42 + SPECIFIC INTERNAL ENERGY OF SATURATED LIQUID AT P REAL FUNCTION F42ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P)*1.D05 YVL=F49ARG(P) YHL=F23ARG(P) F42ARG=REAL(YHL-YP*YVL) RETURN 999 F42ARG=-1E20 RETURN END C43 + SPECIFIC INTERNAL ENERGY OF SATURATED VAPOUR AT P REAL FUNCTION F43ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P)*1.D05 YVV=F50ARG(P) YHV=F24ARG(P) F43ARG=REAL(YHV-YP*YVV) RETURN 999 F43ARG=-1E20 RETURN END C44 + SPECIFIC INTERNAL ENERGY AT PAND T REAL FUNCTION F44ARG(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YT=DBLE(T+273.15) YV=G10ARG(YP,YT) IF (YV.EQ.-1E10) THEN F44ARG=-1E10 ELSEIF (YV.EQ.-1E20) THEN F44ARG=-1E20 ELSE F44ARG=REAL(G13ARG(YT,YV))-1E5*YP*YV ENDIF RETURN END C45 + SPECIFIC INTERNAL ENERGY OF MIXTURE AT P REAL FUNCTION F45ARG(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YUL=F42ARG(P) YUV=F43ARG(P) F45ARG=REAL(YUL+X*(YUV-YUL)) RETURN 999 F45ARG=-1E20 RETURN END C46 + SPECIFIC INTERNAL ENERGY OF SATURATED LIQUID AT T REAL FUNCTION F46ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YP=F30ARG(T)*1.D05 YHL=F27ARG(T) YVL=F53ARG(T) F46ARG=REAL(YHL-YP*YVL) RETURN 999 F46ARG=-1E20 RETURN END C47 + SPECIFIC INTERNAL ENERGY OF SATURATED VAPOUR AT T REAL FUNCTION F47ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YP=F30ARG(T)*1.D05 YHV=F28ARG(T) YVV=F54ARG(T) F47ARG=REAL(YHV-YP*YVV) RETURN 999 F47ARG=-1E20 RETURN END C48 + SPECIFIC INTERNAL ENERGY OF MIXTURE AT T REAL FUNCTION F48ARG(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) YUL=F46ARG(T) YUV=F47ARG(T) F48ARG=REAL(YUL+X*(YUV-YUL)) RETURN 999 F48ARG=-1E20 RETURN END C49 + SPECIFIC VOLUME OF SATURATED LIQUID AT P REAL FUNCTION F49ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) CALL S1ARG(YT,YVL,YVG) F49ARG=REAL(YVL) RETURN 999 F49ARG=-1E20 RETURN END C50 + SPECIFIC VOLUME OF SATURATED GAS AT P REAL FUNCTION F50ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) CALL S1ARG(YT,YVL,YVG) F50ARG=REAL(YVG) RETURN 999 F50ARG=-1E20 RETURN END C51 + SPECIFIC VOLUME AT P AND T REAL FUNCTION F51ARG(P,T) IMPLICIT DOUBLE PRECISION (G,V,Y) YP=DBLE(P) YT=DBLE(T+273.15) YV=G10ARG(YP,YT) IF (YV.EQ.-1E10) THEN F51ARG=-1E10 ELSEIF (YV.EQ.-1E20) THEN F51ARG=-1E20 ELSE F51ARG=REAL(YV) ENDIF RETURN END C52 + SPECIFIC VOLUME OF MIXTURE AT P REAL FUNCTION F52ARG(P,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) CALL S1ARG(YT,YVL,YVG) F52ARG=REAL(YVL+X*(YVG-YVL)) RETURN 999 F52ARG=-1E20 RETURN END C53 + SPECIFIC VOLUME OF SATURATED LIQUID AT T REAL FUNCTION F53ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YT=DBLE(T+273.15) CALL S1ARG(YT,YVL,YVG) F53ARG=REAL(YVL) RETURN 999 F53ARG=-1E20 RETURN END C54 + SPECIFIC VOLUME OF SATURATED GAS AT T REAL FUNCTION F54ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YT=DBLE(T+273.15) CALL S1ARG(YT,YVL,YVG) F54ARG=REAL(YVG) RETURN 999 F54ARG=-1E20 RETURN END C55 + SPECIFIC VOLUME OF MIXTURE AT T REAL FUNCTION F55ARG(T,X) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 IF (X.LT.0 .OR. X.GT.1) GOTO 999 YT=DBLE(T+273.15) CALL S1ARG(YT,YVL,YVG) F55ARG=REAL(YVL+X*(YVG-YVL)) RETURN 999 F55ARG=-1E20 RETURN END C56 + DRYNESS FRACTION <-> AT P,H REAL FUNCTION F56ARG(P,H) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 HD=F23ARG(P) HDD=F24ARG(P) IF (H.LT.HD .OR. H.GT.HDD) GOTO 999 F56ARG=(H-HD)/(HDD-HD) RETURN 999 F56ARG=-1E20 RETURN END C57 + DRYNESS FRACTION <-> AT P,S REAL FUNCTION F57ARG(P,S) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 SD=F33ARG(P) SDD=F34ARG(P) IF (S.LT.SD .OR. S.GT.SDD) GOTO 999 F57ARG=(S-SD)/(SDD-SD) RETURN 999 F57ARG=-1E20 RETURN END C58 + DRYNESS FRACTION <-> AT P,U REAL FUNCTION F58ARG(P,U) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 UD=F42ARG(P) UDD=F43ARG(P) IF (U.LT.UD .OR. U.GT.UDD) GOTO 999 F58ARG=(U-UD)/(UDD-UD) RETURN 999 F58ARG=-1E20 RETURN END C59 + DRYNESS FRACTION <-> AT P,V REAL FUNCTION F59ARG(P,V) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) CALL S1ARG(YT,YVL,YVG) YVV=DBLE(V) IF (YVV.LT.YVL .OR. YVV.GT.YVG) GOTO 999 F59ARG=REAL((YVV-YVL)/(YVG-YVL)) RETURN 999 F59ARG=-1E20 RETURN END C60 + DRYNESS FRACTION <-> AT T,H REAL FUNCTION F60ARG(T,H) IF (T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 HD=F27ARG(T) HDD=F28ARG(T) IF (H.LT.HD .OR. H.GT.HDD) GOTO 999 F60ARG=(H-HD)/(HDD-HD) RETURN 999 F60ARG=-1E20 RETURN END C61 + DRYNESS FRACTION <-> AT T,S REAL FUNCTION F61ARG(T,S) IF (T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 SD=F37ARG(T) SDD=F38ARG(T) IF (S.LT.SD .OR. S.GT.SDD) GOTO 999 F61ARG=(S-SD)/(SDD-SD) RETURN 999 F61ARG=-1E20 RETURN END C62 + DRYNESS FRACTION <-> AT T,U REAL FUNCTION F62ARG(T,U) IF (T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 UD=F46ARG(T) UDD=F47ARG(T) IF (U.LT.UD .OR. U.GT.UDD) GOTO 999 F62ARG=(U-UD)/(UDD-UD) RETURN 999 F62ARG=-1E20 RETURN END C63 + DRYNESS FRACTION <-> AT T,V REAL FUNCTION F63ARG(T,V) IMPLICIT DOUBLE PRECISION (G,Y) IF (T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YT=DBLE(T+273.15) CALL S1ARG(YT,YVL,YVG) YVV=DBLE(V) IF (YVV.LT.YVL .OR. YVV.GT.YVG) GOTO 999 F63ARG=REAL((YVV-YVL)/(YVG-YVL)) RETURN 999 F63ARG=-1E20 RETURN END C64 + TEMPERATURE AT P AND H REAL FUNCTION F64ARG(P,H) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YH=DBLE(H) CALL S2ARG(YP,YH,YT,YV) TK=REAL(YT) IF (TK.GE.0.0) THEN F64ARG=TK-273.15 ELSE F64ARG=TK ENDIF RETURN END C65 + TEMPERATURE AT P AND S REAL FUNCTION F65ARG(P,S) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YS=DBLE(S) CALL S3ARG(YP,YS,YT,YV) TK=REAL(YT) IF (TK.GE.0.0) THEN F65ARG=TK-273.15 ELSE F65ARG=TK ENDIF RETURN END C70 + TEMPERATURE AT P AND V REAL FUNCTION F70ARG(P,V) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YV=DBLE(V) TK=G12ARG(YP,YV) IF (TK.GE.0.0) THEN F70ARG=TK-273.15 ELSE F70ARG=TK ENDIF RETURN END C71 + ENTHALPY AT P AND S REAL FUNCTION F71ARG(P,S) IMPLICIT DOUBLE PRECISION (G,Y) X=F57ARG(P,S) IF (X.LT.0.0 .OR. X.GT.1.0) GOTO 10 F71ARG=F26ARG(P,X) RETURN 10 YP=DBLE(P) YS=DBLE(S) CALL S3ARG(YP,YS,YT,YV) IF (YT.LT.-1E9) GOTO 999 T=REAL(YT)-273.15 F71ARG=F25ARG(P,T) RETURN 999 F71ARG=REAL(YT) RETURN END C76 + ISOCHORIC SPECIFIC HEAT OF SATURATED VAPOUR AT P REAL FUNCTION F76ARG(P) IMPLICIT DOUBLE PRECISION (G,Y) IF (P.LT..6875 .OR. P.GT.49.98) GOTO 999 YP=DBLE(P) YT=G3ARG(YP) CALL S1ARG(YT,YVL,YVG) F76ARG=REAL(G15ARG(YT,YVG)) RETURN 999 F76ARG=-1E20 RETURN END C77 + ISOCHORIC SPECIFIC HEAT AT P AND T REAL FUNCTION F77ARG(P,T) IMPLICIT DOUBLE PRECISION (G,Y) YP=DBLE(P) YT=DBLE(T+273.15) YV=G10ARG(YP,YT) IF (YV.EQ.-1E10) THEN F77ARG=-1E10 ELSEIF (YV.EQ.-1E20) THEN F77ARG=-1E20 ELSE F77ARG=REAL(G15ARG(YT,YV)) ENDIF RETURN END C78 + ISOCHORIC SPECIFIC HEAT OF SATURATED VAPOUR AT T REAL FUNCTION F78ARG(T) IMPLICIT DOUBLE PRECISION (G,Y) IF(T.LT.-189.37 .OR. T.GT.-122.29) GOTO 999 YT=DBLE(T+273.15) CALL S1ARG(YT,YVL,YVG) F78ARG=REAL(G15ARG(YT,YVG)) RETURN 999 F78ARG=-1E20 RETURN END CG01 *** PS(T) DOUBLE PRECISION FUNCTION G1ARG(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A0/1.226935D1/,A1/-9.158256D2/, & A2/-2.458378D-2/,A3/3.425326D-5/, & A4/1.811213D-7/ P0=A0+A1/T+(A2+(A3+(A4*T))*T)*T G1ARG=DEXP(P0) RETURN END CG02 *** DPS/DT(T) ---- DOUBLE PRECISION FUNCTION G2ARG(P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A1/-9.158256D2/, & A2/-2.458378D-2/,A3/3.425326D-5/, & A4/1.811213D-7/ DP0=-A1/T/T+A2+2*A3*T+3*A4*T*T G2ARG=P*DP0 RETURN END CG03 *** TS(P) ---- DOUBLE PRECISION FUNCTION G3ARG(P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) T0=83.78D0-(0.6875-P)*1.3609D0 10 P0=G1ARG(T0) DPDT=G2ARG(P0,T0) T1=T0+(P-P0)/DPDT IF (DABS((T1-T0)/T1) .GE. 1D-6) THEN T0=T1 GOTO 10 ELSE G3ARG=T1 ENDIF RETURN END CG04 *** SURFACE TENSION AT T REAL FUNCTION G4ARG(T) IF(T.GT.-122.4) GOTO 999 SIG1=12.84E-3 RDT=(-122.4-T)/(-122.4+187.16) SIG=SIG1*RDT**1.2834 IF (SIG.LT.1E-6) SIG=0 G4ARG=SIG RETURN 999 SIG=0 G4ARG=SIG RETURN END CG05 *** LAPLACE COEFFICIENT AT T REAL FUNCTION G5ARG(T) IMPLICIT DOUBLE PRECISION (Y) YT=DBLE(T+273.15) CALL S1ARG(YT,YVL,YVG) RV=REAL(YVL*YVG/(YVG-YVL)) SIG=G4ARG(T) G5ARG=SQRT(SIG*RV/9.80665) RETURN END CG06 *** ALMPD(T)---- DOUBLE PRECISION FUNCTION G6ARG(T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A1/-2.55768D-3/, & A2/-2.32178D0/,A3/5.16609D2/ ALM=4.186*1D-4*(A1*T**2+A2*T+A3) G6ARG=ALM RETURN END CG08 *** P(T,V)--ANALYSIS -IUPAC P AT LIQUID DOUBLE PRECISION FUNCTION G8ARG(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C0/-465.6D0/,C1/4.157D0/,C2/4.274D5/, & C3/-360.553D7/,C4/-733.5D0/,C5/2.67D0/, & C6/287D0/ V1=V*1000D0 G8ARG=(C0+C1*T+C2/T/T+C3/T/T/T/T)/V1/V1+(C4+C5*T)/V1/V1/V1/V1 &+C6/V1/V1/V1/V1/V1/V1 RETURN END CG09 *** P(T,V) - ANALYSIS - IUPAC P DOUBLE PRECISION FUNCTION G9ARG(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION B0(10),B1(10),B2(10),B3(10) DATA B0(1)/0/,B0(2)/-1.25858D0/,B0(3)/1.38187D0/, &B0(4)/-8.20485D0/,B0(5)/1.68798D1/,B0(6)/-1.450077D1/, &B0(7)/5.65064D0/,B0(8)/-0.82210D0/ DATA B1(1)/1D0/,B1(2)/0.49867D0/,B1(3)/-0.11809D0/, &B1(4)/1.44965D0/,B1(5)/-2.84978D0/,B1(6)/2.45896D0/, &B1(7)/-0.96034D0/,B1(8)/0.14022D0/ DATA B2(1)/0 /,B2(2)/-0.16717D0/,B2(3)/-2.26825D0/, &B2(4)/1.485159D1/,B2(5)/-3.123559D1/,B2(6)/2.699154D1/, &B2(7)/-1.048046D1/,B2(8)/1.51936D0/ DATA B3(1)/0/,B3(2)/-0.21318D0/,B3(3)/1.40269D0/, &B3(4)/-8.21780D0/,B3(5)/1.780704D1/,B3(6)/-1.568419D1/, &B3(7)/6.12795D0/,B3(8)/-0.88820D0/ GASC=2.083D2 TAU=T/150.86D0 WW=1D0/(535.7D0*V) CB0=0.0 CB1=0.0 CB2=0.0 CB3=0.0 DO 15 I=1,8 CB0=CB0+B0(I)*WW**(I-1) CB1=CB1+B1(I)*WW**(I-1) CB2=CB2+B2(I)*WW**(I-1) CB3=CB3+B3(I)*WW**(I-1) 15 CONTINUE ZZ=CB0/TAU+CB1+CB2/TAU/TAU+CB3/TAU/TAU/TAU G9ARG=ZZ*GASC*T/V*1D-5 RETURN END CG10 *** V(P,T) - FROM IUPAC ANALYSIS P(T,V) BY NEWTON-METHOD DOUBLE PRECISION FUNCTION G10ARG(P,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) IS=0 IF (P.LT.0 .OR. P.GT.1D3) GOTO 999 TMIN=83.78D0 TMAX=1100D0 IF (P.GT.500.AND.P.LE.1000) THEN TMIN=130.0+0.1*P ELSEIF (P.GE.49.98.AND.P.LE.500) THEN TMIN=6.476D-2*P+147.62D0 ELSE TMIN=83.78D0-1.3609D0*(0.6875-P) ENDIF IF (T.LT.TMIN) GOTO 999 IF (T.GT.TMAX) GOTO 999 IF (P.LT..6875D0) THEN VMIN=(1763.1-(1763.1-243.37)*(P-0.1)/0.5875)*1D-3 VMAX=(22898-(22898-243.37)*(P-0.1)/0.5875)*1D-3 ELSEIF (P.LE.49.98) THEN TS=G3ARG(P) CALL S1ARG(TS,VL,VG) IF (T.LT.TS) THEN VMIN=.7068*1D-3 VMAX=VL IS=1 ELSE VMIN=VG VMAX=(46.311+(46.311-3275)*(P-49.98)/(49.98-.6875))*1D-3 IS=0 ENDIF ELSEIF (P.LE.5D2) THEN VMIN=.9052*1D-3 VMAX=(5.1234+(5.1234-46.311)*(P-5D2)/(5D2-49.98))*1D-3 IS=0 ELSE VMIN=.9052*1D-3 VMAX=(2.8629+(2.8629-5.1234)*(P-1D3)/(1D3-5D2))*1D-3 IS=0 ENDIF V1=G11ARG(VMAX,VMIN,P,T,IS) IF (IS.EQ.1) GOTO 20 GASBAR=2.083D2 ILOOP=0 10 ILOOP=ILOOP+1 IF (ILOOP.GT.10000) GOTO 888 P1=G9ARG(T,V1) DP1DV=G18ARG(T,V1) V2=1D5*(P-P1)/DP1DV+V1 IF (DABS((V2-V1)/V2).LT.1D-7) THEN G10ARG=V2 RETURN ELSE V1=V2 GOTO 10 ENDIF 888 G10ARG=-1E10 RETURN 999 G10ARG=-1E20 RETURN 20 G10ARG=V1 RETURN END CG11 *** DOUBLE PRECISION FUNCTION G11ARG(VMAX,VMIN,P,T,IS) IMPLICIT DOUBLE PRECISION (A-H,O-Z) ILOOP=0 VA=VMAX VB=VMIN IF (IS.EQ.1) GOTO 25 10 PA=G9ARG(T,VA) PB=G9ARG(T,VB) DPA=P-PA DPB=P-PB DPAB=PA-PB VC=VB+(VA-VB)*.5 PC=G9ARG(T,VC) DPC=P-PC IF (DPA*DPC.LE.0.0 .AND. DPB*DPC.GT.0.0) THEN VA=VA VB=VC ELSEIF (DPA*DPC.GT.0.0 .AND. DPB*DPC.LE.0.0) THEN VA=VC VB=VB ELSE VA=1.1*VA VB=0.9*VB ENDIF ILOOP=ILOOP+1 IF (ILOOP.LT.10000) GOTO 20 G11ARG=-1E10 RETURN 20 IF (DABS(VA-VB)/VB.GT.1E-2) GOTO 10 G11ARG=VC RETURN 25 PA=G8ARG(T,VA) PB=G8ARG(T,VB) DPA=P-PA DPB=P-PB DPAB=PA-PB VC=VB+(VA-VB)*.5 PC=G8ARG(T,VC) DPC=P-PC IF (DPA*DPC.LE.0.0 .AND. DPB*DPC.GT.0.0) THEN VA=VA VB=VC ELSEIF (DPA*DPC.GT.0.0 .AND. DPB*DPC.LE.0.0) THEN VA=VC VB=VB ELSE VA=1.1*VA VB=0.9*VB ENDIF ILOOP=ILOOP+1 IF (ILOOP.LT.10000) GOTO 30 G11ARG=-1E10 RETURN 30 IF (DABS(VA-VB)/VB.GT.1E-2) GOTO 25 G11ARG=VC RETURN END CG12 *** T(P0,V0) FROM P(T,V0)-P0=0 DOUBLE PRECISION FUNCTION G12ARG(P,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) ILOOP=0 IF (P.LT.0 .OR. P.GT.1D3) GOTO 999 TMIN=83.78D0 TMAX=1100D0 IF (P.GT.500.AND.P.LE.1000) THEN TMIN=130.0+0.1*P ELSEIF (P.GE.49.98.AND.P.LE.500) THEN TMIN=6.476D-2*P+147.62D0 ELSE TMIN=83.78D0-1.3609D0*(0.6875-P) ENDIF VMAX=G10ARG(P,TMAX) VMIN=G10ARG(P,TMIN) IF (V.LT.VMIN .OR. V.GT.VMAX) GOTO 999 IF ( P.LT..6875 .OR. P.GT.49.98) GOTO 5 YT=G3ARG(P) CALL S1ARG(YT,VL,VG) IF (V.LT.VL) THEN TA=YT TB=TMIN ELSEIF (V.LE.VG) THEN G12ARG=YT RETURN ELSE TA=TMAX TB=YT ENDIF GOTO 10 5 TA=TMAX TB=TMIN 10 VA=G10ARG(P,TA) VB=G10ARG(P,TB) DVA=V-VA DVB=V-VB DVAB=VA-VB TC=TB+(TA-TB)*.5 VC=G10ARG(P,TC) DVC=V-VC IF (DVA*DVC.LE.0.0 .AND. DVB*DVC.GT.0.0) THEN TA=TA TB=TC ELSEIF (DVA*DVC.GT.0.0 .AND. DVB*DVC.LE.0.0) THEN TA=TC TB=TB ELSE GOTO 777 ENDIF 777 ILOOP=ILOOP+1 IF (ILOOP.GT.10000) GOTO 888 IF (DABS(TA-TB)/TB.GT.1E-6) GOTO 10 G12ARG=TC RETURN 888 G12ARG=-1E10 RETURN 999 G12ARG=-1E20 RETURN END CG13 *** H(T,V)-ANALYSIS--IUPAC H(T,V)/(R*T) <-> DOUBLE PRECISION FUNCTION G13ARG(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION B0(10),B1(10),B2(10),B3(10) DATA B0(1)/0/,B0(2)/-1.25858D0/,B0(3)/1.38187D0/, &B0(4)/-8.20485D0/,B0(5)/1.68798D1/,B0(6)/-1.450077D1/, &B0(7)/5.65064D0/,B0(8)/-0.82210D0/ DATA B1(1)/1D0/,B1(2)/0.49867D0/,B1(3)/-0.11809D0/, &B1(4)/1.44965D0/,B1(5)/-2.84978D0/,B1(6)/2.45896D0/, &B1(7)/-0.96034D0/,B1(8)/0.14022D0/ DATA B2(1)/0 /,B2(2)/-0.16717D0/,B2(3)/-2.26825D0/, &B2(4)/1.485159D1/,B2(5)/-3.123559D1/,B2(6)/2.699154D1/, &B2(7)/-1.048046D1/,B2(8)/1.51936D0/ DATA B3(1)/0/,B3(2)/-0.21318D0/,B3(3)/1.40269D0/, &B3(4)/-8.21780D0/,B3(5)/1.780704D1/,B3(6)/-1.568419D1/, &B3(7)/6.12795D0/,B3(8)/-0.88820D0/ GASC=2.083D2 TAU=T/150.86D0 WW=1D0/(535.7D0*V) RC=GASC CP0=520.32D0 T0=298.15D0 CB0=0.0 CB1=0.0 CB2=0.0 CB3=0.0 DO 15 I=2,8 CB0=CB0+B0(I)*WW**(I-1)/(I-1) CB1=CB1+B1(I)*WW**(I-1)/(I-1) CB2=CB2+B2(I)*WW**(I-1)/(I-1) CB3=CB3+B3(I)*WW**(I-1)/(I-1) 15 CONTINUE ZZ=CB0/TAU+2*CB2/TAU/TAU+3*CB3/TAU/TAU/TAU AHT0=(1.55114+1.92520)*1D5 P=G9ARG(T,V) G13ARG=AHT0+CP0*(T-T0)-RC*T+P*V*1D5+RC*T*ZZ RETURN END CG14 *** S(T,V) - ANALYSIS - IUPAC S(T,V)/R <-> DOUBLE PRECISION FUNCTION G14ARG(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION B0(10),B1(10),B2(10),B3(10) DATA B0(1)/0/,B0(2)/-1.25858D0/,B0(3)/1.38187D0/, &B0(4)/-8.20485D0/,B0(5)/1.68798D1/,B0(6)/-1.450077D1/, &B0(7)/5.65064D0/,B0(8)/-0.82210D0/ DATA B1(1)/1D0/,B1(2)/0.49867D0/,B1(3)/-0.11809D0/, &B1(4)/1.44965D0/,B1(5)/-2.84978D0/,B1(6)/2.45896D0/, &B1(7)/-0.96034D0/,B1(8)/0.14022D0/ DATA B2(1)/0 /,B2(2)/-0.16717D0/,B2(3)/-2.26825D0/, &B2(4)/1.485159D1/,B2(5)/-3.123559D1/,B2(6)/2.699154D1/, &B2(7)/-1.048046D1/,B2(8)/1.51936D0/ DATA B3(1)/0/,B3(2)/-0.21318D0/,B3(3)/1.40269D0/, &B3(4)/-8.21780D0/,B3(5)/1.780704D1/,B3(6)/-1.568419D1/, &B3(7)/6.12795D0/,B3(8)/-0.88820D0/ GASC=2.083D2 RC=GASC CP0=520.32D0 T0=298.15D0 TAU=T/150.86D0 WW=1D0/(535.7D0*V) PP0=1.01325D5 ST0=3.8734D3 CB0=0.0 CB1=0.0 CB2=0.0 CB3=0.0 DO 15 I=2,8 CB0=CB0+B0(I)*WW**(I-1)/(I-1) CB1=CB1+B1(I)*WW**(I-1)/(I-1) CB2=CB2+B2(I)*WW**(I-1)/(I-1) CB3=CB3+B3(I)*WW**(I-1)/(I-1) 15 CONTINUE ZZ1=-CB1+CB2/TAU/TAU+2*CB3/TAU/TAU/TAU G14ARG=ST0+CP0*DLOG(T/T0)-RC*DLOG(RC*T/PP0/V)+RC*ZZ1 RETURN END CG15 *** CV(T,V) - IUPAC - ANALYSIS CV/R <-> DOUBLE PRECISION FUNCTION G15ARG(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION B0(10),B1(10),B2(10),B3(10) DATA B0(1)/0/,B0(2)/-1.25858D0/,B0(3)/1.38187D0/, &B0(4)/-8.20485D0/,B0(5)/1.68798D1/,B0(6)/-1.450077D1/, &B0(7)/5.65064D0/,B0(8)/-0.82210D0/ DATA B1(1)/1D0/,B1(2)/0.49867D0/,B1(3)/-0.11809D0/, &B1(4)/1.44965D0/,B1(5)/-2.84978D0/,B1(6)/2.45896D0/, &B1(7)/-0.96034D0/,B1(8)/0.14022D0/ DATA B2(1)/0 /,B2(2)/-0.16717D0/,B2(3)/-2.26825D0/, &B2(4)/1.485159D1/,B2(5)/-3.123559D1/,B2(6)/2.699154D1/, &B2(7)/-1.048046D1/,B2(8)/1.51936D0/ DATA B3(1)/0/,B3(2)/-0.21318D0/,B3(3)/1.40269D0/, &B3(4)/-8.21780D0/,B3(5)/1.780704D1/,B3(6)/-1.568419D1/, &B3(7)/6.12795D0/,B3(8)/-0.88820D0/ GASC=2.083D2 TAU=T/150.86D0 WW=1D0/(535.7D0*V) CP0=520.32D0 CB0=0.0 CB1=0.0 CB2=0.0 CB3=0.0 DO 15 I=2,8 CB0=CB0+B0(I)*WW**(I-1)/(I-1) CB1=CB1+B1(I)*WW**(I-1)/(I-1) CB2=CB2+B2(I)*WW**(I-1)/(I-1) CB3=CB3+B3(I)*WW**(I-1)/(I-1) 15 CONTINUE ZZ=-2*CB2/TAU/TAU-6*CB3/TAU/TAU/TAU G15ARG=GASC*ZZ+(CP0-GASC) RETURN END CG16 *** CP(T,V) - IUPAC - ANALYSIS CP/R <-> DOUBLE PRECISION FUNCTION G16ARG(T,V) IMPLICIT DOUBLE PRECISION (G,T,V) G16ARG=G15ARG(T,V)-(G17ARG(T,V))**2/G18ARG(T,V)*T RETURN END CG17 *** DP/DT(T,V0) - IUPAC -ANALYSIS DOUBLE PRECISION FUNCTION G17ARG(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION B0(10),B1(10),B2(10),B3(10) DATA B0(1)/0/,B0(2)/-1.25858D0/,B0(3)/1.38187D0/, &B0(4)/-8.20485D0/,B0(5)/1.68798D1/,B0(6)/-1.450077D1/, &B0(7)/5.65064D0/,B0(8)/-0.82210D0/ DATA B1(1)/1D0/,B1(2)/0.49867D0/,B1(3)/-0.11809D0/, &B1(4)/1.44965D0/,B1(5)/-2.84978D0/,B1(6)/2.45896D0/, &B1(7)/-0.96034D0/,B1(8)/0.14022D0/ DATA B2(1)/0 /,B2(2)/-0.16717D0/,B2(3)/-2.26825D0/, &B2(4)/1.485159D1/,B2(5)/-3.123559D1/,B2(6)/2.699154D1/, &B2(7)/-1.048046D1/,B2(8)/1.51936D0/ DATA B3(1)/0/,B3(2)/-0.21318D0/,B3(3)/1.40269D0/, &B3(4)/-8.21780D0/,B3(5)/1.780704D1/,B3(6)/-1.568419D1/, &B3(7)/6.12795D0/,B3(8)/-0.88820D0/ RC=2.083D2 TAU=T/150.86D0 WW=1D0/(535.7D0*V) CB0=0.0 CB1=0.0 CB2=0.0 CB3=0.0 DO 15 I=1,8 CB0=CB0+B0(I)*WW**(I-1) CB1=CB1+B1(I)*WW**(I-1) CB2=CB2+B2(I)*WW**(I-1) CB3=CB3+B3(I)*WW**(I-1) 15 CONTINUE ZAZ=CB0/TAU+CB1+CB2/TAU/TAU+CB3/TAU/TAU/TAU CB0=0.0 CB1=0.0 CB2=0.0 CB3=0.0 DO 20 I=1,8 CB0=CB0+B0(I)*WW**(I-1) CB1=CB1+B1(I)*WW**(I-1) CB2=CB2+B2(I)*WW**(I-1) CB3=CB3+B3(I)*WW**(I-1) 20 CONTINUE ZCZ=CB0/TAU+2*CB2/TAU/TAU+3*CB3/TAU/TAU/TAU G17ARG=RC/V*ZAZ-RC/V*ZCZ RETURN END CG18 *** DP/DV(T0,V) - IUPAC - ANALYSIS DOUBLE PRECISION FUNCTION G18ARG(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION B0(10),B1(10),B2(10),B3(10) DATA B0(1)/0/,B0(2)/-1.25858D0/,B0(3)/1.38187D0/, &B0(4)/-8.20485D0/,B0(5)/1.68798D1/,B0(6)/-1.450077D1/, &B0(7)/5.65064D0/,B0(8)/-0.82210D0/ DATA B1(1)/1D0/,B1(2)/0.49867D0/,B1(3)/-0.11809D0/, &B1(4)/1.44965D0/,B1(5)/-2.84978D0/,B1(6)/2.45896D0/, &B1(7)/-0.96034D0/,B1(8)/0.14022D0/ DATA B2(1)/0 /,B2(2)/-0.16717D0/,B2(3)/-2.26825D0/, &B2(4)/1.485159D1/,B2(5)/-3.123559D1/,B2(6)/2.699154D1/, &B2(7)/-1.048046D1/,B2(8)/1.51936D0/ DATA B3(1)/0/,B3(2)/-0.21318D0/,B3(3)/1.40269D0/, &B3(4)/-8.21780D0/,B3(5)/1.780704D1/,B3(6)/-1.568419D1/, &B3(7)/6.12795D0/,B3(8)/-0.88820D0/ GASC=2.083D2 TAU=T/150.86D0 WW=1D0/(535.7D0*V) CB0=0.0 CB1=0.0 CB2=0.0 CB3=0.0 DO 15 I=1,8 CB0=CB0+B0(I)*WW**(I-1) CB1=CB1+B1(I)*WW**(I-1) CB2=CB2+B2(I)*WW**(I-1) CB3=CB3+B3(I)*WW**(I-1) 15 CONTINUE ZAZ=CB0/TAU+CB1+CB2/TAU/TAU+CB3/TAU/TAU/TAU CB0=0.0 CB1=0.0 CB2=0.0 CB3=0.0 DO 20 I=1,8 CB0=CB0+(I-1)*B0(I)*WW**(I-1) CB1=CB1+(I-1)*B1(I)*WW**(I-1) CB2=CB2+(I-1)*B2(I)*WW**(I-1) CB3=CB3+(I-1)*B3(I)*WW**(I-1) 20 CONTINUE ZBZ=CB0/TAU+CB1+CB2/TAU/TAU+CB3/TAU/TAU/TAU ZZ=ZAZ+ZBZ G18ARG=(GASC*T*ZZ)*(-1D0/V/V) RETURN END CG19 *** DP/DV(T0,V) - IUPAC - ANALYSIS AT LIQUID DOUBLE PRECISION FUNCTION G19ARG(T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA C0/-465.6D0/,C1/4.157D0/,C2/4.274D5/, & C3/-360.553D7/,C4/-733.5D0/,C5/2.67D0/, & C6/287D0/ V1=V*1000D0 CP0=520.D0 DPDT=C1/V1/V1-2*C2/T/V1/T/V1/T-4*C3/T/V1/T/V1/T/T/T DPDT=DPDT+C5/V1/V1/V1/V1 DPDV=2*(C0+C1*T+C2/T/T+C3/T/T/T/T)/V1 DPDV=DPDV+4*(C4+C5*T)/V1/V1/V1+6*C6/V1/V1/V1/V1/V1 CPV=6*C2/T/T/T/T+20*C3/T/T/T/T/T/T G19ARG=CP0+(DPDT)**2/DPDV*V*V*T*1D8 RETURN END CS1 *****VD(T),VDD(T) SUBROUTINE S1ARG(T,VL,VG) IMPLICIT DOUBLE PRECISION (A-H,O-Z) P=G1ARG(T) IS=1 VMAX=1.8667*1D-3 VMIN=.70679*1D-3 VL=G11ARG(VMAX,VMIN,P,T,IS) IS=0 IF(T.LE.100.0) THEN VMAX=243.37*1D-3 VMIN=58.75*1D-3 ELSEIF(T.LE.130.0) THEN VMAX=58.75*1D-3 VMIN=9.6197*1D-3 ELSE VMAX=9.6197*1D-3 VMIN=1.8667*1D-3 ENDIF VG=G11ARG(VMAX,VMIN,P,T,IS) RETURN END CS2 *** T(P0,H0) V(P0,H0) FROM P(T,V)-P0=0 AND H(T,V)-H0=0 SUBROUTINE S2ARG(P,H,T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) ILOOP=0 IF (P.LT.0 .OR. P.GT.1D3) GOTO 999 TMIN=83.78D0 TMAX=1100D0 IF (P.GT.500.AND.P.LE.1000) THEN TMIN=130.0+0.1*P ELSEIF (P.GE.49.98.AND.P.LE.500) THEN TMIN=6.476D-2*P+147.62D0 ELSE TMIN=83.78D0-1.3609D0*(0.6875-P) ENDIF IF ( P.LT..6875 .OR. P.GT.49.98) GOTO 5 VMAX=G10ARG(P,TMAX) VMIN=G10ARG(P,TMIN) HMAX=G13ARG(TMAX,VMAX) HMIN=G13ARG(TMIN,VMIN) IF (H.LT.HMIN .OR. H.GT.HMAX) GOTO 999 YT=G3ARG(P) CALL S1ARG(YT,VL,VG) HD=G13ARG(YT,VL) HDD=HD+1D5*(VG-VL)*G2ARG(P,YT) IF (H.LT.HD) THEN TA=YT TB=TMIN ELSEIF (H.LE.HDD) THEN T=YT V=VL+(VG-VL)*(H-HD)/(HDD-HD) RETURN ELSE TA=TMAX TB=YT ENDIF GOTO 10 5 TA=TMAX TB=TMIN 10 VA=G10ARG(P,TA) VB=G10ARG(P,TB) HA=G13ARG(TA,VA) HB=G13ARG(TB,VB) DHA=H-HA DHB=H-HB DHAB=HA-HB TC=TB+(TA-TB)*.5 VC=G10ARG(P,TC) HC=G13ARG(TC,VC) DHC=H-HC IF (DHA*DHC.LE.0.0 .AND. DHB*DHC.GT.0.0) THEN TA=TA TB=TC ELSEIF (DHA*DHC.GT.0.0 .AND. DHB*DHC.LE.0.0) THEN TA=TC TB=TB ELSE GOTO 777 ENDIF 777 ILOOP=ILOOP+1 IF (ILOOP.GT.10000) GOTO 888 IF (DABS(TA-TB)/TB.GT.1E-6) GOTO 10 T=TC V=G10ARG(P,T) RETURN 888 T=-1E10 V=-1E10 RETURN 999 T=-1E20 V=-1E20 RETURN END CS3 *** T(P0,S0) V(P0,S0) FROM P(T,V)-P0=0 AND S(T,V)-S0=0 SUBROUTINE S3ARG(P,S,T,V) IMPLICIT DOUBLE PRECISION (A-H,O-Z) ILOOP=0 IF (P.LT.0 .OR. P.GT.1D3) GOTO 999 TMIN=83.78D0 TMAX=1100D0 IF (P.GT.500.AND.P.LE.1000) THEN TMIN=130.0+0.1*P ELSEIF (P.GE.49.98.AND.P.LE.500) THEN TMIN=6.476D-2*P+147.62D0 ELSE TMIN=83.78D0-1.3609D0*(0.6875-P) ENDIF VMAX=G10ARG(P,TMAX) VMIN=G10ARG(P,TMIN) SMAX=G14ARG(TMAX,VMAX) SMIN=G14ARG(TMIN,VMIN) IF (S.LT.SMIN .OR. S.GT.SMAX) GOTO 999 IF ( P.LT..6875 .OR. P.GT.49.98) GOTO 5 YT=G3ARG(P) CALL S1ARG(YT,VL,VG) SD=G14ARG(YT,VL) SDD=SD+1D5*(VG-VL)*G2ARG(P,YT)/YT IF (S.LT.SD) THEN TA=YT TB=TMIN ELSEIF (S.LE.SDD) THEN T=YT V=VL+(VG-VL)*(S-SD)/(SDD-SD) RETURN ELSE TA=TMAX TB=YT ENDIF GOTO 10 5 TA=TMAX TB=TMIN 10 VA=G10ARG(P,TA) VB=G10ARG(P,TB) SA=G14ARG(TA,VA) SB=G14ARG(TB,VB) DSA=S-SA DSB=S-SB DSAB=SA-SB TC=TB+(TA-TB)*.5 VC=G10ARG(P,TC) SC=G14ARG(TC,VC) DSC=S-SC IF (DSA*DSC.LE.0.0 .AND. DSB*DSC.GT.0.0) THEN TA=TA TB=TC ELSEIF (DSA*DSC.GT.0.0 .AND. DSB*DSC.LE.0.0) THEN TA=TC TB=TB ELSE GOTO 777 ENDIF 777 ILOOP=ILOOP+1 IF (ILOOP.GT.10000) GOTO 888 IF (DABS(TA-TB)/TB.GT.1E-6) GOTO 10 T=TC V=G10ARG(P,T) RETURN 888 T=-1E10 V=-1E10 RETURN 999 T=-1E20 V=-1E20 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