C ********** VER. 11.1.********* C ********** R 142B ********* C ********** VER. 11.1.********* C C==================================================================== C May 2, 2001: modified by Ryo Akasaka for ver.12.1 C The following 18 functions were added but not implemented. C AKPD(8A), AKPDD(8B), AKTD(8C), AKTDD(8D), CVPD(7A), CVTD(7B), C EPSPD(2A), EPSPDD(2B), EPSTD(2C), EPSTDD(2D), GAMPD(9A), C GAMTD(9B), TPH2(6H), TPS2(6S), WPD(8E), WPDD(8F), WTD(8G), C WTDD(8H) C C------------------------------------------------- F8A = AKPD REAL FUNCTION AKPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='AKPD' IF (MESS.NE.0) CALL S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(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 S99J15(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT REAL FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99J15(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 DATA FUN/'AJTPT'/ CALL S99J15(FUN) AJTPT=-1.0E+30 RETURN END C------------------------------------------------- F82 = AKPT REAL FUNCTION AKPT(P,T) CHARACTER FUN*6 DATA FUN/'AKPT'/ CALL S99J15(FUN) AKPT=-1.0E+30 RETURN END C------------------------------------------------- F2 = ALAPP REAL FUNCTION ALAPP(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F2J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF 2000 CONTINUE C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALAPP=FF RETURN END C------------------------------------------------- F3 = ALAPT REAL FUNCTION ALAPT(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F3J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F4J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F5J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F6J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') 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 FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, FUN/'ALMPDD'/ 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 --- C FF = F7J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMPDD=FF RETURN END C------------------------------------------------- F8 = ALMPT REAL FUNCTION ALMPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, FUN/'ALMPT'/ 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 = F8J15(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND T=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMPT=FF RETURN END C------------------------------------------------- F9 = ALMTD REAL FUNCTION ALMTD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F9J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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 FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, FUN/'ALMTDD'/ 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 --- C FF = F10J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMTDD=FF RETURN END C------------------------------------------------- F11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FUN*6 DATA FUN/'AMUPD'/ CALL S99J15(FUN) AMUPD=-1.0E+30 RETURN END C------------------------------------------------- F12 = AMUPDD REAL FUNCTION AMUPDD(P) CHARACTER FUN*6 DATA FUN/'AMUPDD'/ CALL S99J15(FUN) AMUPDD=-1.0E+30 RETURN END C------------------------------------------------- F13 = AMUPT REAL FUNCTION AMUPT(P,T) CHARACTER FUN*6 DATA FUN/'AMUPT'/ CALL S99J15(FUN) AMUPT=-1.0E+30 RETURN END C------------------------------------------------- F14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FUN*6 DATA FUN/'AMUTD'/ CALL S99J15(FUN) AMUTD=-1.0E+30 RETURN END C------------------------------------------------- F15 = AMUTDD REAL FUNCTION AMUTDD(T) CHARACTER FUN*6 DATA FUN/'AMUTDD'/ CALL S99J15(FUN) AMUTDD=-1.0E+30 RETURN END C------------------------------------------------- F92 = BPPT FUNCTION BPPT(P,T) CHARACTER FUN*6 DATA FUN/'BPPT'/ CALL S99J15(FUN) BPPT=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 DATA FUN/'BSPT'/ CALL S99J15(FUN) BSPT=-1.0E+30 RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 DATA FUN/'BTPT'/ CALL S99J15(FUN) BTPT=-1.0E+30 RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 DATA FUN/'BVPT'/ CALL S99J15(FUN) BVPT=-1.0E+30 RETURN END C------------------------------------------------- F16 = CPPD REAL FUNCTION CPPD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, FUN/'CPPD'/ 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 = F16J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPPD=FF RETURN END C------------------------------------------------- F17 = CPPDD REAL FUNCTION CPPDD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F17J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F18J15(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND T=',1PE14.7,' ****') 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 FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, FUN/'CPTD'/ 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 = F19J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPTD=FF RETURN END C------------------------------------------------- F20 = CPTDD REAL FUNCTION CPTDD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F20J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,A*1 REAL T0K,PBAR,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, FUN/'CRP'/ 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 = F21J15(A) C--- LEVEL 2 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN A =',A,' ****') 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------------------------------------------------- F76 = CVPDD REAL FUNCTION CVPDD(P) CHARACTER FUN*6 DATA FUN/'CVPDD'/ CALL S99J15(FUN) CVPDD=-1.0E+30 RETURN END C------------------------------------------------- F77 = CVPT REAL FUNCTION CVPT(P,T) CHARACTER FUN*6 DATA FUN/'CVPT'/ CALL S99J15(FUN) CVPT=-1.0E+30 RETURN END C------------------------------------------------- F78 = CVTDD REAL FUNCTION CVTDD(T) CHARACTER FUN*6 DATA FUN/'CVTDD'/ CALL S99J15(FUN) CVTDD=-1.0E+30 RETURN END C------------------------------------------------- F22 = EPSPT REAL FUNCTION EPSPT(P,T) CHARACTER FUN*6 DATA FUN/'EPSPT'/ CALL S99J15(FUN) EPSPT=-1.0E+30 RETURN END C------------------------------------------------- F89 = FC C************************************************ C FUNCTION FOR FUNDDAMENTAL CONSTANTS C PROPATH VER.10.1, MAY 8, 1996 C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='100.496' WHEN A='M' C B='82.7347' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS FC=F89J15(A) IF(FC.LT.-1.E+19) THEN IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR REFRIGERANT 142B WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F96 = GAMPDD FUNCTION GAMPDD(P) CHARACTER FUN*6 DATA FUN/'GAMPDD'/ CALL S99J15(FUN) GAMPDD=-1.0E+30 RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 DATA FUN/'GAMPT'/ CALL S99J15(FUN) GAMPT=-1.0E+30 RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 DATA FUN/'GAMTDD'/ CALL S99J15(FUN) GAMTDD=-1.0E+30 RETURN END C------------------------------------------------- F23 = HPD REAL FUNCTION HPD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F23J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F24J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPDD=FF RETURN END C------------------------------------------------- F71 = HPS REAL FUNCTION HPS(P,S) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F71J15(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPS=FF RETURN END C------------------------------------------------- F25 = HPT REAL FUNCTION HPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F25J15(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND T=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,X,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F26J15(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND X=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F27J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F28J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F29J15(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND X=',1PE14.7,' ****') 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='HCFC-142B(R142B)' WHEN A='S' C B='C2H3CLF2' 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='HCFC-142B(R142B)' ELSE IF (A.EQ.'C') THEN IDENTF='C2H3CLF2' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR HCFC-142B(R142B) WHEN A= &'''//A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F66 = PLDT REAL FUNCTION PLDT(T) CHARACTER FUN*6 DATA FUN/'PLDT'/ CALL S99J15(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT REAL FUNCTION PMLT(T) CHARACTER FUN*6 DATA FUN/'PMLT'/ CALL S99J15(FUN) PMLT=-1.0E+30 RETURN END C------------------------------------------------- F85 = PRPD REAL FUNCTION PRPD(P) CHARACTER FUN*6 DATA FUN/'PRPD'/ CALL S99J15(FUN) PRPD=-1.0E+30 RETURN END C------------------------------------------------- F86 = PRPDD REAL FUNCTION PRPDD(P) CHARACTER FUN*6 DATA FUN/'PRPDD'/ CALL S99J15(FUN) PRPDD=-1.0E+30 RETURN END C------------------------------------------------- F81 = PRPT FUNCTION PRPT(P,T) CHARACTER FUN*6 DATA FUN/'PRPT'/ CALL S99J15(FUN) PRPT=-1.0E+30 RETURN END C------------------------------------------------- F87 = PRTD REAL FUNCTION PRTD(T) CHARACTER FUN*6 DATA FUN/'PRTD'/ CALL S99J15(FUN) PRTD=-1.0E+30 RETURN END C------------------------------------------------- F88 = PRTDD REAL FUNCTION PRTDD(T) CHARACTER FUN*6 DATA FUN/'PRTDD'/ CALL S99J15(FUN) PRTDD=-1.0E+30 RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99J15(FUN) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F30 = PST REAL FUNCTION PST(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F30J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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------------------------------------------------- F72 = PSTD REAL FUNCTION PSTD(T) CHARACTER FUN*6 DATA FUN/'PSTD'/ CALL S99J15(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD REAL FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99J15(FUN) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F31 = SIGP REAL FUNCTION SIGP(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F31J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F32J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F33J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F34J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F35J15(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND T=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,X,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F36J15(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND X=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F37J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F38J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F39J15(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND X=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- STX=FF RETURN END C------------------------------------------------- F67 = TLDP REAL FUNCTION TLDP(P) CHARACTER FUN*6 DATA FUN/'TLDP'/ CALL S99J15(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP REAL FUNCTION TMLP(P) CHARACTER FUN*6 DATA FUN/'TMLP'/ CALL S99J15(FUN) TMLP=-1.0E+30 RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 DATA FUN/'TPSEUP'/ CALL S99J15(FUN) TPSEUP=-1.0E+30 RETURN END C------------------------------------------------- F64 = TPH REAL FUNCTION TPH(P,H) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,H,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F64J15(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,H 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND H=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F65J15(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S=',1PE14.7,' ****') 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------------------------------------------------- F70 = TPV REAL FUNCTION TPV(P,V) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,V,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F70J15(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,V 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND V=',1PE14.7,' ****') 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------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99J15(FUN) TSBP=-1.0E+30 RETURN END C------------------------------------------------- F40 = TSP REAL FUNCTION TSP(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F40J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') 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,FLUID*16,MSG*125,A*1 C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, FUN/'TRPL'/ C--- LEVEL 3 ERROR CHECK & MESSAGE --- MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+30 C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- TRPL=FF RETURN END C------------------------------------------------- F74 = TSPD REAL FUNCTION TSPD(P) CHARACTER FUN*6 DATA FUN/'TSPD'/ CALL S99J15(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD REAL FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99J15(FUN) TSPDD=-1.0E+30 RETURN END C------------------------------------------------- F42 = UPD REAL FUNCTION UPD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F42J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F43J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UPDD=FF RETURN END C------------------------------------------------- F79 = UPS REAL FUNCTION UPS(P,S) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, FUN/'UPS'/ 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 = F79J15(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UPS=FF RETURN END C------------------------------------------------- F44 = UPT REAL FUNCTION UPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F44J15(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND T=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,X,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F45J15(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND X=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F46J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F47J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F48J15(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND X=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F49J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F50J15(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VPDD=FF RETURN END C------------------------------------------------- F80 = VPS REAL FUNCTION VPS(P,S) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, FUN/'VPS'/ 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 = F80J15(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VPS=FF RETURN END C------------------------------------------------- F51 = VPT REAL FUNCTION VPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F51J15(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND T=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,X,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F52J15(PI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND X=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F53J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F54J15(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F55J15(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND X=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VTX=FF RETURN END C------------------------------------------------- F83 = WPT REAL FUNCTION WPT(P,T) CHARACTER FUN*6 DATA FUN/'WPT'/ CALL S99J15(FUN) WPT=-1.0E+30 RETURN END C------------------------------------------------- F56 = XPH REAL FUNCTION XPH(P,H) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,H,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F56J15(PI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,H 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND H=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F57J15(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,U,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F58J15(PI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,U 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND U=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL PBAR,P,V,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F59J15(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,V 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND V=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,H,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F60J15(TI,H) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T,H 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND H=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F61J15(TI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND S=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,U,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F62J15(TI,U) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T,U 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND U=',1PE14.7,' ****') 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,FLUID*16,MSG*125 REAL T0K,T,V,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 142B'/, 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 = F63J15(TI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T,V 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND V=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XTV=FF RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99J15(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR R 142B****' WRITE(6,100) MSG 100 FORMAT(1H ,5X,A) ENDIF RETURN END C ********** R 142B ********* C ********** VER. 10.1. ********* C ********** R 142B ********* C C G01 ****** FUNCTION G01J15(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J15,VM3K,TDGC C C COMMON /R142BA/R,A2,B2,A3,B3/ C COMMON /R142BB/TCK,VC,WMOL/ C DATA R,A2,B2,A3,B3/0.83141215500D-2,-0.38240055000D1, 1 0.70670033175D-2,0.92426212935D0,-0.20776989753D-2/ C DATA WMOL/100.496D0/ C KG/KMOL C TK=TDGC+273.15 VLMOL=VM3K*WMOL PMPA=(R*TK+((A2+B2*TK)+(A3+B3*TK)/VLMOL)/VLMOL)/VLMOL G01J15=PMPA*1.0D1 C BAR RETURN END C G02 ****** FUNCTION G02J15(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G02J15,VM3K,TDGC,J DATA WMOL,J/100.496D0,1000.0/ C DATA R,A2,B2,A3,B3/0.83141215500D-2,-0.38240055000D1, 1 0.70670033175D-2,0.92426212935D0,-0.20776989753D-2/ C DATA G2,G3,G5/0.3069106425D0,-0.2200251688D-3,0.1171932825D6/ DATA X/29963.72D0/ C TK=TDGC+273.15 TK2=TK*TK VLMOL=VM3K*WMOL PMPA=(R*TK+((A2+B2*TK)+(A3+B3*TK)/VLMOL)/VLMOL)/VLMOL C HW=(A2+A3/(2*VLMOL))/VLMOL H=J*(PMPA*VLMOL+HW)+(G2/2+G3*TK/3)*TK2-G5/TK+X G02J15=1.0E3*H/WMOL RETURN END C G03 ******* FUNCTION G03J15(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G03J15,TDGC,J,VD,VDD,G02J15,F54J15,F53J15,F30J15 DATA J/1000.0/ C DATA A2/-0.11845000000D4/ C TK=TDGC+273.15 TK2=TK*TK DPDT=F30J15(TDGC)*1.0D-1*DLOG(10.0D0)*(-A2/TK2) C VDD=F54J15(TDGC) VD=F53J15(TDGC) HDD=1.0E-3*G02J15(VDD,TDGC) C HD=HDD-J*TK*DPDT*(VDD-VD) G03J15=1.0E3*HD RETURN END C G05 ****************** FUNCTION G05J15(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G05J15,VM3K,TDGC,J DATA WMOL,J/100.496D0,1000.0/ C DATA R,B2,B3/0.83141215500D-2,0.70670033175D-2,-0.20776989753D-2/ C DATA G2,G3,G5/0.3069106425D0,-0.2200251688D-3,0.1171932825D6/ DATA Y/81.71691D0/ C TK=TDGC+273.15 TK2=TK*TK VLMOL=VM3K*WMOL C SW=J*(R*DLOG(VLMOL)-(B2+B3/(2*VLMOL))/VLMOL) S=SW+(G2+G3*TK/2)*TK-G5/(2*TK2)+Y G05J15=1.0E3*S/WMOL RETURN END C G06 ****************** FUNCTION G06J15(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G06J15,TDGC,J,VD,VDD,G05J15,F54J15,F53J15,F30J15 DATA J/1000.0/ C DATA A2/-0.11845000000D4/ C TK=TDGC+273.15 TK2=TK*TK DPDT=F30J15(TDGC)*1.0D-1*DLOG(10.0D0)*(-A2/TK2) C VDD=F54J15(TDGC) VD=F53J15(TDGC) SDD=1.0E-3*G05J15(VDD,TDGC) C SD=SDD-J*DPDT*(VDD-VD) G06J15=1.0E3*SD RETURN END C 2 ****** FUNCTION F2J15(PBAR) IF(ABS(PBAR-41.23).GT.0.004) GO TO 10 A=0.0 GO TO 30 10 W=F40J15(PBAR) TK=W+273.15 A=F3J15(W) GO TO 30 20 A=-1.0E20 30 F2J15=A RETURN END C 3 ****** FUNCTION F3J15(TDGC) DOUBLE PRECISION A,G0,SIGMA,RD,RDD DATA G0/9.80665D0/ TK=TDGC+273.15 IF(ABS(TK-410.25).LT.0.02) GO TO 10 IF(TK.LT.203.0.OR.TK.GT.288.1) GO TO 20 W=F53J15(TDGC) IF(W.LT.1.0E-5) GO TO 30 RD=1.0D0/DBLE(W) W=F54J15(TDGC) IF(W.LT.1.0E-5) GO TO 30 RDD=1.0D0/DBLE(W) W=G11J15(TK) IF(W.LT.0.0) GO TO 30 SIGMA=DBLE(W) A=RD-RDD IF(DABS(A).LT.1.0D-2) GO TO 10 A=DSQRT(SIGMA/(G0*A)) GO TO 40 10 A=0.0D0 GO TO 40 20 A=-1.0D20 GO TO 40 30 A=DBLE(W) 40 F3J15=A RETURN END C 4 ****** FUNCTION F4J15(PBAR) ALH=F24J15(PBAR) IF(ALH.LT.-1.0E9) GO TO 10 HD=F23J15(PBAR) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F4J15=ALH RETURN 20 F4J15=HD RETURN END C 5 ****** FUNCTION F5J15(TDGC) ALH=F28J15(TDGC) IF(ALH.LT.-1.0E9) GO TO 10 HD=F27J15(TDGC) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F5J15=ALH RETURN 20 F5J15=HD RETURN END C 6 ******* FUNCTION F6J15(PBAR) TDGC=F40J15(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 ALMPD=F9J15(TDGC) F6J15=ALMPD RETURN 10 F6J15=TDGC RETURN 20 F6J15=-1.0E20 RETURN END C 7 ******* FUNCTION F7J15(PBAR) TDGC=F40J15(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 ALMPDD=F10J15(TDGC) F7J15=ALMPDD RETURN 10 F7J15=TDGC RETURN 20 F7J15=-1.0E20 RETURN END C 8 ******* FUNCTION F8J15(PBAR,TDGC) PDUMMY=PBAR C PDUMMY=1.01325 TK=TDGC+273.15 IF(TK.GE.273.0.AND.TK.LE.473.0) GO TO 10 F8J15=-1.0E20 RETURN 10 ALMPT=G23J15(TK) F8J15=ALMPT RETURN END C G23 *********** FUNCTION G23J15(T) C R142B 1ATM GAS THERM.COND (W/M K) G23J15=SQRT(T)/((0.85757E8/T+0.12908E5)/T+0.48829E3) RETURN END C 9 ******* FUNCTION F9J15(TDGC) C LAMBDA (SAT. LIQ.) IF(TDGC.GE.-50.0.AND.TDGC.LE.90.0) GO TO 10 F9J15=-1.0E20 RETURN 10 ALMTD=G21J15(TDGC) F9J15=ALMTD RETURN END C G21 ****** FUNCTION G21J15(T) C R142B SAT. LIQ THERM.COND (W/M K) G21J15=0.95001E-1+((-0.21807E-8*T+0.15128E-7)*T-0.39535E-3)*T RETURN END C 10 ******* FUNCTION F10J15(TDGC) C LAMBDA (SAT. VAP.) IF(TDGC.GE.30.0.AND.TDGC.LE.90.0) GO TO 10 F10J15=-1.0E20 RETURN 10 ALMTD=G22J15(TDGC) F10J15=ALMTD RETURN END C G22 ****** FUNCTION G22J15(T) C R142B SAT. LIQ THERM.COND (W/M K) G22J15=0.17671E-1+((-0.27940E-7*T+0.62198E-5)*T-0.31791E-3)*T RETURN END C 16 ****** FUNCTION F16J15(PBAR) TDGC=F40J15(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPD=F19J15(TDGC) F16J15=CPD RETURN 10 F16J15=TDGC RETURN END C 17 ****** FUNCTION F17J15(PBAR) TDGC=F40J15(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPDD=F20J15(TDGC) F17J15=CPDD RETURN 10 F17J15=TDGC RETURN END C 18 ******* FUNCTION F18J15(PBAR,TDGC) PDUMMY=PBAR C PDUMMY=1.01325 IF(TDGC.GE.-10.0.AND.TDGC.LE.200.0) GO TO 10 F18J15=-1.0E20 RETURN 10 CP=G43J15(TDGC) F18J15=CP RETURN END C G43 *********** FUNCTION G43J15(T) C R142B 1ATM GAS CP (J/kgK) W=0.78476+((-0.36019E-8*T-0.60923E-7)*T+0.15089E-2)*T G43J15=1.0E3*W RETURN END C 19 ******* FUNCTION F19J15(TDGC) C C CP SAT. LIQUID(TEMP) C IF(TDGC.GE.-50.0.AND.TDGC.LE.90.0) GO TO 10 F19J15=-1.0E20 RETURN 10 CPD=G41J15(TDGC) F19J15=CPD RETURN END C G41 ****** FUNCTION G41J15(T) C R142B SAT. LIQ CP(J/kgK) W=0.12477E1+((0.52161E-7*T+0.51588E-5)*T+0.17104E-2)*T G41J15=1.0E3*W RETURN END C 20 ******* FUNCTION F20J15(TDGC) C C CP SAT.VAPOR(TEMP) C IF(TDGC.GE.-50.0.AND.TDGC.LE.90.0) GO TO 10 F20J15=-1.0E20 RETURN 10 CPDD=G42J15(TDGC) F20J15=CPDD RETURN END C G42 ****** FUNCTION G42J15(T) C R142B SAT. VAP CP(J/kgK) W=0.80498+((0.12613E-6*T+0.14590E-4)*T+0.24105E-2)*T G42J15=1.0E3*W RETURN END C 21 ******** FUNCTION F21J15(C) CHARACTER C IF(C.EQ.'P') GO TO 10 IF(C.EQ.'T') GO TO 20 IF(C.EQ.'V') GO TO 30 IF(C.EQ.'H') GO TO 40 IF(C.EQ.'S') GO TO 50 GO TO 60 10 F21J15=41.23 RETURN 20 F21J15=137.0 RETURN 30 F21J15=2.2988E-3 RETURN 40 F21J15=0.4309E6 RETURN 50 F21J15=1.6464E3 RETURN 60 F21J15=-1.0E+30 RETURN END C 89 ******** FUNCTION F89J15(C) CHARACTER C IF(C.EQ.'M') GO TO 10 IF(C.EQ.'R') GO TO 20 GO TO 60 10 F89J15=100.496 RETURN 20 F89J15=82.7347 RETURN 60 F89J15=-1.0E+30 RETURN END C 23 ****** FUNCTION F23J15(PBAR) TSDGC=F40J15(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F27J15(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F23J15=H RETURN 15 F23J15=TSDGC RETURN 16 F23J15=H RETURN END C 24 ****** FUNCTION F24J15(PBAR) TSDGC=F40J15(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F28J15(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F24J15=H RETURN 15 F24J15=TSDGC RETURN 16 F24J15=H RETURN END C 71 ******* FUNCTION F71J15(PBAR,S) C C H(P,S) C CALL S08J15(PBAR,S,VM3KG,TDGC,H) IF(TDGC.LT.-1.0E9) GO TO 20 IF(H.LT.-1.0E9) GO TO 10 C TK=TDGC+273.15 IF(TK.GT.410.25) GO TO 10 PSAT=F30J15(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 10 STDD=F38J15(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 10 STD=F37J15(TDGC) IF(STD.LT.-1.0E9) GO TO 13 X=(S-STD)/(STDD-STD) IF(X.LT.-1.0E-5.OR.X.GT.1.00001) GO TO 30 C HTDD=F28J15(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 HTD=F27J15(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 H=HTD*(1.0-X)+HTDD*X 10 F71J15=H RETURN 11 F71J15=PSAT RETURN 12 F71J15=STDD RETURN 13 F71J15=STD RETURN 14 F71J15=HTDD RETURN 15 F71J15=HTD RETURN 20 F71J15=TDGC RETURN 30 F71J15=-1.0E20 RETURN END C 25 ****** FUNCTION F25J15(PBAR,TDGC) VM3K=F51J15(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-410.25.GT.-273.15) GO TO 10 VTD=F53J15(TDGC) IF((VM3K-VTD)/2.2988E-3.GT.1.0E-5) GO TO 10 H=G02J15(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J15=H RETURN 10 H=G02J15(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J15=H RETURN 15 F25J15=VM3K RETURN 16 F25J15=H RETURN 20 F25J15=-1.0E20 RETURN END C 26 ******* FUNCTION F26J15(PBAR,X) TDGC=F40J15(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 H=F29J15(TDGC,X) F26J15=H RETURN 10 F26J15=TDGC RETURN END C 27 ****** FUNCTION F27J15(TDGC) C C HDT SAT. LIQUID(TEMP) C VDM3K=F53J15(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.7.5E-4) GO TO 20 HD=G03J15(TDGC) F27J15=HD RETURN 10 F27J15=VDM3K RETURN 20 F27J15=-1.0E10 RETURN END C 28 ****** FUNCTION F28J15(TDGC) C C HDDT SAT. VAPOUR(TEMP) C VDM3K=F54J15(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.4.8E-3) GO TO 20 HDD=G02J15(VDM3K,TDGC) F28J15=HDD RETURN 10 F28J15=VDM3K RETURN 20 F28J15=-1.0E10 RETURN END C 29 ****** FUNCTION F29J15(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 HTD=F27J15(TDGC) IF(HTD.LT.-1.0E9) GO TO 20 HTDD=F28J15(TDGC) IF(HTDD.LT.-1.0E9) GO TO 10 F29J15=(1.0-X)*HTD+X*HTDD RETURN 10 F29J15=HTDD RETURN 20 F29J15=HTD RETURN 30 F29J15=-1.0E20 RETURN END C 30 ****** FUNCTION F30J15(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F30J15,TDGC C IF(TDGC.LT.-70.5.OR.TDGC.GT.137.1) GO TO 10 C AA1=0.35025174691D1 AA2=-0.11845000000D4 TK=DBLE(TDGC)+273.15D0 AL10PS=AA1+AA2/TK F30J15=10.0D0**(AL10PS)*1.0D1 C MPA BAR RETURN 10 F30J16=-1.0E20 RETURN END C 31 ******* FUNCTION F31J15(PBAR) TDGC=F40J15(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 SIGMA=F32J15(TDGC) F31J15=SIGMA RETURN 10 F31J15=TDGC RETURN END C 32 ******* FUNCTION F32J15(TDGC) TK=TDGC+273.15 IF(TK.LT.163.0.OR.TK.GT.288.1) GO TO 10 SIGMA=G11J15(TK) F32J15=SIGMA RETURN 10 F32J15=-1.0E20 RETURN END C G11 ****** FUNCTION G11J15(T) C R142B SAT SURFACE TENSION (N/m) W=55.943*(1.0-T/410.25)**1.2324 G11J15=1.0E-3*W RETURN END C 33 ****** FUNCTION F33J15(PBAR) TDGC=F40J15(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F37J15(TDGC) IF(S.LT.-1.0E9) GO TO 16 F33J15=S RETURN 15 F33J15=TDGC RETURN 16 F33J15=S RETURN 20 F33J15=-1.0E20 RETURN END C 34 ****** FUNCTION F34J15(PBAR) TDGC=F40J15(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F38J15(TDGC) IF(S.LT.-1.0E9) GO TO 16 F34J15=S RETURN 15 F34J15=TDGC RETURN 16 F34J15=S RETURN 20 F34J15=-1.0E20 RETURN END C 35 ****** FUNCTION F35J15(PBAR,TDGC) VM3K=F51J15(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-410.25.GT.-273.15) GO TO 10 VTD=F53J15(TDGC) IF((VM3K-VTD)/2.2988E-3.GT.1.0E-5) GO TO 10 S=G05J15(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J15=S RETURN 10 S=G05J15(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J15=S RETURN 15 F35J15=VM3K RETURN 16 F35J15=S RETURN 20 F35J15=-1.0E20 RETURN END C 36 ******* FUNCTION F36J15(PBAR,X) TDGC=F40J15(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 S=F39J15(TDGC,X) F36J15=S RETURN 10 F36J15=TDGC RETURN END C 37 ****** FUNCTION F37J15(TDGC) C C SDT SAT. LIQUID(TEMP) C VDM3K=F53J15(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.7.5E-4) GO TO 20 SD=G06J15(TDGC) F37J15=SD RETURN 10 F37J15=VDM3K RETURN 20 F37J15=-1.0E10 RETURN END C 38 ****** FUNCTION F38J15(TDGC) C C SDDT SAT. VAPOUR(TEMP) C VDM3K=F54J15(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.4.8E-3) GO TO 20 SDD=G05J15(VDM3K,TDGC) F38J15=SDD RETURN 10 F38J15=VDM3K RETURN 20 F38J15=-1.0E10 RETURN END C 39 ******* FUNCTION F39J15(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 STD=F37J15(TDGC) IF(STD.LT.-1.0E9) GO TO 20 STDD=F38J15(TDGC) IF(STDD.LT.-1.0E9) GO TO 10 F39J15=(1.0-X)*STD+X*STDD RETURN 10 F39J15=STDD RETURN 20 F39J15=STD RETURN 30 F39J15=-1.0E20 RETURN END C 40 ******** FUNCTION F40J15(PBAR) C IMPLICIT DOUBLE PRECISION (A-H),(O-Z) DOUBLE PRECISION AA1,AA2,TK,PMPA REAL F40J15,PBAR C IF(PBAR.LT.0.046.OR.PBAR.GT.35.1) GO TO 10 C AA1=0.35025174691D1 AA2=-0.11845000000D4 PMPA=DBLE(PBAR)*1.0D-1 TK=AA2/(DLOG10(PMPA)-AA1) TDGC=TK-273.15D0 F40J15=TDGC RETURN 10 F40J15=-1.0D20 RETURN END C 42 ******* FUNCTION F42J15(PBAR) C C U=H-PV (SAT. LIQUID) C TSDGC=F40J15(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HD=F27J15(TSDGC) IF(HD.LT.-1.0E9) GO TO 20 VD=F53J15(TSDGC) IF(VD.LT.-1.0E9) GO TO 10 U=HD-PBAR*VD*1.0E5 F42J15=U RETURN 10 F42J15=VD RETURN 20 F42J15=HD RETURN 30 F42J15=TSDGC RETURN END C 43 ******* FUNCTION F43J15(PBAR) C C U=H-PV (SAT. VAPOR) C TSDGC=F40J15(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HDD=F28J15(TSDGC) IF(HDD.LT.-1.0E9) GO TO 20 VDD=F54J15(TSDGC) IF(VDD.LT.-1.0E9) GO TO 10 U=HDD-PBAR*VDD*1.0E5 F43J15=U RETURN 10 F43J15=VDD RETURN 20 F43J15=HDD RETURN 30 F43J15=TSDGC RETURN END C 79 ******* FUNCTION F79J15(PBAR,S) C C U(P,S) U=H-PV C CALL S08J15(PBAR,S,VX,TDGC,H) IF(TDGC.LT.-1.0E9) GO TO 20 IF(H.LT.-1.0E9) GO TO 10 C TK=TDGC+273.15 IF(TK.GT.410.25) GO TO 40 PSAT=F30J15(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 40 STDD=F38J15(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 40 STD=F37J15(TDGC) IF(STD.LT.-1.0E9) GO TO 13 X=(S-STD)/(STDD-STD) IF(X.LT.-1.0E-5.OR.X.GT.1.00001) GO TO 30 C HTDD=F28J15(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 VTDD=F54J15(TDGC) IF(VTDD.LT.-1.0E9) GO TO 16 HTD=F27J15(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 VTD=F53J15(TDGC) C) IF(VTD.LT.-1.0E9) GO TO 17 H=HTD*(1.0-X)+HTDD*X VX=VTD*(1.0-X)+VTDD*X GO TO 40 C 10 F79J15=H C WRITE(6,210) H C 210 FORMAT(1H ,42X,'RTN FROM 10 H=',E12.4) RETURN 11 F79J15=PSAT C WRITE(6,211) PSAT C 211 FORMAT(1H ,42X,'RTN FROM 11 PSAT=',E12.4) RETURN 12 F79J15=STDD C WRITE(6,212) STDD C 212 FORMAT(1H ,42X,'RTN FROM 12 STDD=',E12.4) RETURN 13 F79J15=STD C WRITE(6,213) STD C 213 FORMAT(1H ,42X,'RTN FROM 13 STD=',E12.4) RETURN 14 F79J15=HTDD C WRITE(6,214) HTDD C 214 FORMAT(1H ,42X,'RTN FROM 14 HTDD=',E12.4) RETURN 15 F79J15=HTD C WRITE(6,215) HTD C 215 FORMAT(1H ,42X,'RTN FROM 15 HTD=',E12.4) RETURN 16 F79J15=VTDD C WRITE(6,216) VTDD C 216 FORMAT(1H ,42X,'RTN FROM 16 VTDD=',E12.4) RETURN 17 F79J15=VTD C WRITE(6,217) VTD C 217 FORMAT(1H ,42X,'RTN FROM 17 VTD=',E12.4) RETURN 20 F79J15=TDGC C WRITE(6,220) TDGC C 220 FORMAT(1H ,42X,'RTN FROM 20 TDGC=',E12.4) RETURN 30 F79J15=-1.0E20 RETURN 40 F79J15=H-PBAR*VX*1.0E5 C WRITE(6,102) H C 102 FORMAT(1H ,42X,'H(J/KG K)=',E12.4) RETURN END C 44 ******* FUNCTION F44J15(PBAR,TDGC) C C U=H-PV C V=F51J15(PBAR,TDGC) IF(V.LT.-1.0E9) GO TO 20 IF(TDGC-410.25.GT.-273.15) GO TO 4 VTD=F53J15(TDGC) IF((V-VTD)/2.2988E-3.LT.1.0E-5) GO TO 5 4 H=G02J15(V,TDGC) GO TO 6 5 H=G02J15(V,TDGC) 6 IF(H.LT.-1.0E9) GO TO 10 U=H-PBAR*V*1.0E5 F44J15=U RETURN 10 F44J15=H RETURN 20 F44J15=V RETURN END C 45 ******* FUNCTION F45J15(PBAR,X) C C U=H-PV C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F42J15(PBAR) IF(UD.LT.-1.0E9) GO TO 20 UDD=F43J15(PBAR) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F45J15=U RETURN 10 F45J15=UDD RETURN 20 F45J15=UD RETURN 30 F45J15=-1.0E20 RETURN END C 46 ******* FUNCTION F46J15(TDGC) C C U=H-PV (SAT. LIQUID C HD=F27J15(TDGC) IF(HD.LT.-1.0E9) GO TO 30 VD=F53J15(TDGC) IF(VD.LT.-1.0E9) GO TO 20 PST=F30J15(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HD-PST*VD*1.0E5 F46J15=U RETURN 10 F46J15=PST RETURN 20 F46J15=VD RETURN 30 F46J15=HD RETURN END C 47 ******* FUNCTION F47J15(TDGC) C C U=H-PV (SAT. VAPOR) C HDD=F28J15(TDGC) IF(HDD.LT.-1.0E9) GO TO 30 VDD=F54J15(TDGC) IF(VDD.LT.-1.0E9) GO TO 20 PST=F30J15(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HDD-PST*VDD*1.0E5 F47J15=U RETURN 10 F47J15=PST RETURN 20 F47J15=VDD RETURN 30 F47J15=HDD RETURN END C 48 ******* FUNCTION F48J15(TDGC,X) C C U=H-PV (SAT. LIQUID) C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F46J15(TDGC) IF(UD.LT.-1.0E9) GO TO 20 UDD=F47J15(TDGC) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F48J15=U RETURN 10 F48J15=UDD RETURN 20 F48J15=UD RETURN 30 F48J15=-1.0E20 RETURN END C 80 ****** FUNCTION F80J15(PBAR0,S) C C V(P,S) C G05(V,T)=S VAPOR G06(V,T)=S LIQUID C S.GT.SC S.LT.SC C C CALL S08J15(PBAR0,S,VX,TDGC,H) IF(VX.LT.1.0E-4) GO TO 10 IF(PBAR0.GT.41.23) GO TO 10 PST=F30J15(PBAR0) IF(ABS((PST-PBAR0)/PBAR0).LT.1.0E-5) GO TO 35 10 F80J15=VX RETURN 35 STD=F37J15(TDGC) STDD=F38J15(TDGC) VTD=F53J15(TDGC) VTDD=F54J15(TDGC) SX=(S-STD)/(STDD-STD) VX=VTD+(VTDD-VTD)*SX F80J15=VX RETURN END C 49 ****** FUNCTION F49J15(PBAR) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F49J15,F40J15,F53J15,PBAR,TSAT,VD TSAT=F40J15(PBAR) VD=F53J15(TSAT) C M3/KG F49J15=VD RETURN END C 50 ****** FUNCTION F50J15(PBAR) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F50J15,F40J15,F54J15,PBAR,TSAT,VDD TSAT=F40J15(PBAR) VDD=F54J15(TSAT) C M3/KG F50J15=VDD RETURN END C 51 ******** FUNCTION F51J15(PBAR,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J15,F50J15,F51J15,PBAR,TDGC,VNL,VXL REAL PST,F54J15,VMIN,VMAX,PW,VW REAL VM3KC,PCBAR,WMOL,VLM3C,ROWMAX,WK,F30J15 DATA VLM3C,TCK,PCBAR,WMOL/0.23103,410.25,41.23,100.496/ VM3KC=VLM3C/WMOL C CHK RANGE PBAR,TDGC IF(PBAR.LT.0.099.OR.PBAR.GT.35.1) GO TO 70 TK=TDGC+2.7315D2 IF(TDGC.LT.-58.1.OR.TDGC.GT.180.1) GO TO 70 C IF(DABS(TCK-TK).GT.0.002) GO TO 5 IF(ABS(PCBAR-PBAR).GT.0.0005) GO TO 5 VW=VM3KC GO TO 60 C 5 VMAX=3.75 IF(TDGC.GT.125.0) THEN IF(TDGC.GE.127.5) THEN WK=(180.0-TDGC)/10.0+2.0 ROWMAX=(WK-1.0)*(WK+1.0)+93.0 END IF IF(TDGC.LE.127.5 .AND. TDGC.GE.125.0) THEN WK=(180.0-127.5)/10.0+2.0 ROWMAX=(WK-1.0)*(WK+1.0)+93.0 ROWMAX=(ROWMAX-204.2)/2.5*(TDGC-125.0)+204.2 END IF VMIN=1.0/ROWMAX C ICASE=4 VAPOR REGION PBAR.LT.PC C VMAX VMAX=1.0/(2.5*PBAR) IF(VMAX.GT.3.75) VMAX=3.75 IF(PBAR.GT.30.0) THEN VW=(200.0-87.5)/5.0*(PBAR-30.0)+87.5 VMAX=1.0/VW END IF IF(VMIN.GT.VMAX) THEN VW=1.0/VMIN+2.0 VMAX=1.0/VW END IF C GO TO 15 END IF C C COME ON TDGC.LE.125.0 PST=F30J15(TDGC) IF(ABS(PST/PBAR-1.0).GT.1.0E-6) GO TO 14 VW=F54J15(TDGC) GO TO 60 C 14 VMIN=F54J15(TDGC) C C VMAX VMAX=1.0/(2.9*PBAR) C PW=G01J15(VMIN,TDGC) IF(PW/PBAR-1.0.LT.5.0E-6) THEN VW=VMIN C =F54J15(TDGC) GO TO 60 END IF 15 VW=F50J15(PBAR) IF(VMIN.LT.VW*0.98) VMIN=VW*0.98 C VMIN ADJUST,NOT OVER MAX PRESS C CHECK PW=G01J15(VMIN,TDGC) IF(PW.GT.PBAR) THEN WK=1.0 ELSE DO 151 K=1,10 VMIN=VMIN*0.95 PW=G01J15(VMIN,TDGC) IF(PW.GT.PBAR) GO TO 152 151 CONTINUE 152 CONTINUE END IF C CALL S06J15(PBAR,TDGC,VMIN,VMAX) IF(VMIN.GT.0.001) THEN PW=G01J15(VMIN,TDGC) IF(ABS(PW/PBAR-1.0) .LT.1.0E-5) THEN VW=VMIN PW=G01J15(VW,TDGC) GO TO 60 END IF PW=G01J15(VMAX,TDGC) IF(ABS(PW/PBAR-1.0) .LT.1.0E-5) THEN VW=VMAX PW=G01J15(VW,TDGC) GO TO 60 END IF C ELSE C WRITE(*,*) 'S06 OUT VMIN.LT.001 GOTO70' GO TO 70 END IF C ICASE=4 IF(ABS(VMIN/VMAX-1.0).LT.1.0E-5) THEN VW=VMIN GO TO 60 END IF VNL=VMIN VXL=VMAX C ICOUNT=0 VNL=G01J15(VMIN,TDGC) VXL=G01J15(VMAX,TDGC) C 20 VW=(VMAX+VMIN)*0.5 PW=G01J15(VW,TDGC) IF(ABS(PW/PBAR-1.0).LT.1.0E-6) GO TO 60 IF(PBAR.GT.PW) GO TO 21 VMIN=VW ICOUNT=ICOUNT+1 IF(ABS(VMIN/VMAX-1.0).LT.1.0E-6) GO TO 59 IF(PW.LT.0.001) GO TO 50 IF(ICOUNT.LT.18) GO TO 20 GO TO 50 21 VMAX=VW ICOUNT=ICOUNT+1 IF(ABS(VMIN/VMAX-1.0).LT.1.0E-6) GO TO 59 IF(PW.LT.0.001) GO TO 50 IF(ICOUNT.LT.18) GO TO 20 GO TO 50 C 50 F51J15=-1.E10 RETURN 59 VW=(VMAX+VMIN)*0.5 60 F51J15=VW RETURN 70 F51J15=-1.0E20 RETURN END C 52 ******* FUNCTION F52J15(PBAR,X) TDGC=F40J15(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 V=F55J15(TDGC,X) F52J15=V RETURN 10 F52J15=TDGC RETURN END C 53 ******* FUNCTION F53J15(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F53J15,TDGC C DIMENSION EIR(8),JDXR(8) DATA JDXR/3,8,11,12,19,20,21,24/ DATA EIR/-0.1862347172D-6,0.1092966651D-2,0.5332667931D0, 1 0.3140908845D1,-0.2048590942D2,0.5566112404D2,-0.4055420731D2, 2 0.6086333767D1/ C DATA TCK,VC,WM/410.25D0,0.23103D0,100.496D0/ C K, L/MOL KG/KMOL C IF(TDGC.LT.-70.0.OR.TDGC.GT.137.1) GO TO 20 C TK=TDGC+273.15 THTA=TK/TCK TAU=(TCK-TK)/TCK W=0.0D0 DO 10 K=1,8 I=JDXR(K)-11 RI3=DBLE(FLOAT(I))/3.0D0 10 W=W+EIR(K)*TAU**RI3 C W=W+EIR(9)*DLOG(THTA) C RO=DEXP(W)/VC RO=W/VC VM3K=1.0D0/RO F53J15=VM3K/WM RETURN 20 F53J15=-1.0E20 RETURN END C 54 ****** FUNCTION F54J15(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F54J15,TDGC C DIMENSION FIR(9),JDXR(9) DATA JDXR/1,2,3,4,5,9,14,18,25/ DATA FIR/0.1157420508D-2,-0.1547702606D-1,0.8021715641D-1, 1 -0.1932852011D0,0.1861823045D0,-0.3973527390D0,0.3192501658D2, 2 0.2441315460D2,0.3977383234D2/ C DATA TCK,VC,WM/410.25D0,0.23103D0,100.496D0/ C K, L/MOL KG/KMOL C IF(TDGC.LT.-70.0.OR.TDGC.GT.137.1) GO TO 20 C TK=TDGC+273.15 THTA=TK/TCK TAU=(TCK-TK)/TCK W=0.0D0 DO 10 K=1,8 I=JDXR(K)-11 RI3=DBLE(FLOAT(I))/3.0D0 10 W=W+FIR(K)*TAU**RI3 W=W+FIR(9)*DLOG(THTA) RO=DEXP(W)/VC VM3K=1.0D0/RO F54J15=VM3K/WM RETURN 20 F54J15=-1.0E20 RETURN END C 55 ****** FUNCTION F55J15(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 VD=F53J15(TDGC) IF(VD.LT.-1.0E9) GO TO 20 VDD=F54J15(TDGC) IF(VDD.LT.-1.0E9) GO TO 10 V=(1.0-X)*VD+X*VDD F55J15=V RETURN 10 F55J15=VDD RETURN 20 F55J15=VD RETURN 30 F55J15=-1.0E20 RETURN END C 56 ******* FUNCTION F56J15(PBAR,H) TSDGC=F40J15(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F60J15(TSDGC,H) F56J15=X RETURN 10 F56J15=TSDGC RETURN END C 57 ******* FUNCTION F57J15(PBAR,S) TSDGC=F40J15(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F61J15(TSDGC,S) F57J15=X RETURN 10 F57J15=TSDGC RETURN END C 58 ******* FUNCTION F58J15(PBAR,U) TSDGC=F40J15(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F62J15(TSDGC,U) F58J15=X RETURN 10 F58J15=TSDGC RETURN END C 59 ******* FUNCTION F59J15(PBAR,V) TSDGC=F40J15(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F63J15(TSDGC,V) F59J15=X RETURN 10 F59J15=TSDGC RETURN END C 60 ******* FUNCTION F60J15(TDGC,H) IF(TDGC.LT.-70.1.OR.TDGC.GT.125.1) GO TO 10 HD=F27J15(TDGC) IF(HD.LT.-1.0E9) GO TO 30 IF(HD.GT.H) GO TO 10 HDD=F28J15(TDGC) IF(HDD.LT.-1.0E9) GO TO 20 IF(HDD.LT.H) GO TO 10 IF(HDD-HD.GT.1.0E-5) GO TO 5 F60J15=1.0 RETURN 5 X=(H-HD)/(HDD-HD) F60J15=X RETURN 10 F60J15=-1.0E20 RETURN 20 F60J15=HDD RETURN 30 F60J15=HD RETURN END C 61 ******* FUNCTION F61J15(TDGC,S) IF(TDGC.LT.-70.1.OR.TDGC.GT.125.1) GO TO 10 SD=F37J15(TDGC) IF(SD.LT.-1.0E9) GO TO 30 IF(SD.GT.S) GO TO 10 SDD=F38J15(TDGC) IF(SDD.LT.-1.0E9) GO TO 20 IF(SDD.LT.S) GO TO 10 IF(SDD-SD.GT.1.0E-5) GO TO 5 F61J15=1.0 RETURN 5 X=(S-SD)/(SDD-SD) F61J15=X RETURN 10 F61J15=-1.0E20 RETURN 20 F61J15=SDD RETURN 30 F61J15=SD RETURN END C 62 ******* FUNCTION F62J15(TDGC,U) IF(TDGC.LT.-70.1.OR.TDGC.GT.125.1) GO TO 10 UD=F46J15(TDGC) IF(UD.LT.-1.0E9) GO TO 30 IF(UD.GT.U) GO TO 10 UDD=F47J15(TDGC) IF(UDD.LT.-1.0E9) GO TO 20 IF(UDD.LT.U) GO TO 10 IF(UDD-UD.GT.1.0E-5) GO TO 5 F62J15=1.0 RETURN 5 X=(U-UD)/(UDD-UD) F62J15=X RETURN 10 F62J15=-1.0E20 RETURN 20 F62J15=UDD RETURN 30 F62J15=UD RETURN END C 63 ******* FUNCTION F63J15(TDGC,V) IF(TDGC.LT.-70.1.OR.TDGC.GT.125.1) GO TO 10 VD=F53J15(TDGC) IF(VD.LT.-1.0E9) GO TO 30 IF(VD.GT.V) GO TO 10 VDD=F54J15(TDGC) IF(VDD.LT.-1.0E9) GO TO 20 IF(VDD.LT.V) GO TO 10 IF(VDD-VD.GT.1.0E-5) GO TO 5 F63J15=1.0 RETURN 5 X=(V-VD)/(VDD-VD) F63J15=X RETURN 10 F63J15=-1.0E20 RETURN 20 F63J15=VDD RETURN 30 F63J15=VD RETURN END C 64 ******* FUNCTION F64J15(PBAR0,H) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F64J15,TDGC,HW,TMAX,TMIN,HDP,HDDP,HX,H1,H2,TSP,VX,TWH REAL PBAR0,H,G02J15,F40J15,F51J15,TMAXT,VMINT,VMAXT REAL F54J15,TLCK,TCC,VDP,VDDP,VCM3K REAL TMXR,TMNR,G01J15,G03J15 C DATA HC/4.309D5/ DATA PCBAR,TCK,ROCKM3/4.123D1,4.1025D2,4.350D2/ DATA VMINT,TMAXT,TLCK,VMAXT/0.7542E-3,453.2,203.0,3.80/ C IF(PBAR0.LT.0.009.OR.PBAR0.GT.41.5) GO TO 40 IF(H.LT.1.4E5.OR.H.GT.5.8E5) GO TO 40 IF(ABS(PBAR0-41.23).GT.0.01) GO TO 5 IF(ABS(H-SNGL(HC)).GT.60.0) GO TO 5 C CRITICAL PRES. ERROR =0.01(BAR) C CRITICAL SPC. H ERROR=0.0006E5(J/KG) TDGC=SNGL(TCK)-273.15 GO TO 30 C 5 VCM3K=1.0/SNGL(ROCKM3) IF(PBAR0/35.1-1.0.GT.1.0E-6) GO TO 40 TDGC=F40J15(PBAR0) TSP=TDGC IF(TDGC.LT.-70.7) GO TO 40 HDP=G03J15(TDGC) IF(HDP.LT.1.0E-1) GO TO 50 IF(H/HDP-1.0.GT.1.0E-6) GO TO 13 C C ON UPPER SAT. LIQ LINE AND IN SUPER HEAT VAPOR GO TO 13 C ON SAT.LIQ. LINE ERR=0.01 IF(TDGC.LT.-50.0) ERR=0.02 C EXAMPLE R142B IF(ABS(H/HDP-1.0).GT.ERR) GO TO 40 C LIMITTED ONLY ON THE SAT.LIQ LINE, NO COMPRESSED LIQUID GO TO 30 C 13 VDDP=F54J15(TDGC) IF(VDDP.LT.VCM3K) GO TO 50 HDDP=G02J15(VDDP,TDGC) ERR=3.0E-5 IF(TDGC.GT.100.0) ERR=3.0E-3 IF(H/HDDP-1.0.LT.ERR) GO TO 30 CXX WRITE(*,*) 'PASS SAT. VAP LINE',H,HDDP CXX GO TO 30 C ADAAX **************************** IF(H.GT.HC .OR. H.GT.HDDP) THEN C IF(PBAR0.LT.1.0) THEN TMIN=(-35+70)*ALOG10(PBAR0/0.1)-70.09 ELSE IF(PBAR0.LT.10.0) THEN TMIN=(35+35)*ALOG10(PBAR0)-35.0 ELSE TMIN=(93-35)/ALOG10(3.0)*ALOG10(PBAR0/10.0)+35.0 END IF C TSP=F40J15(PBAR0) IF(TMIN.LT.TSP) TMIN=TSP C IF(TMIN.LT.TDGC) TMIN=TDGC IF(TMIN.LT.-58.09) TMIN=-58.09 C F51 TMIN=-58.1 C TMAX=TMAXT-273.15 C ICASE=4 TSP=(TMAX-TMIN)/9.9 INSTEP=11 TWH=TMAX HW=2.0E10 DO 135 IMARK=1,9 DO 133 I=1,INSTEP TDGC=TMAX-(I-1)*TSP IF(TDGC.LT.-50.09) TDGC=-58.09 C F51 TMIN=-58.1 136 VX=F51J15(PBAR0,TDGC) IF(VX.LT.VDDP*0.97) THEN IF(VX.LT.-0.5E5) GO TO 50 C IF(VX.GT.VDDP*0.95) GO TO 30 GO TO 50 END IF C VX.LT.VDDP END IF C HX=G02J15(VX,TDGC) C IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.LT.H .OR. HX.GT.HW) GO TO 134 C HW=HX TWH=TDGC 133 CONTINUE IF(ABS(HW/H-1.0).LT.5.0E-4) THEN TDGC=TWH GO TO 30 END IF GO TO 50 C 134 TMAX=TWH TMIN=TDGC IF(TMIN.GT.TMAX) THEN VX=TMIN TMIN=TMAX TMAX=VX END IF IF(ABS(TMAX-TMIN).LT.1.0E-4) TMAX=TMIN+TSP IF(TMAX.GT.TMAXT-273.15) TMAX=TMAXT-273.15 C VX=F51J15(PBAR0,TMIN) H1=G02J15(VX,TMIN) VX=F51J15(PBAR0,TMAX) H2=G02J15(VX,TDGC) HW=H2*10.0 C IF(IMARK.LT.3) THEN TSP=(TMAX-TMIN)/9.9 INSTEP=11 ELSE TSP=(TMAX-TMIN)/29.9 INSTEP=31 END IF 135 CONTINUE IF(ABS(HW/H-1.0).LT.1.0E-4) THEN TDGC=TWH GO TO 30 END IF C IF(ABS(TMAX-TMIN).LT.1.0E-2) GO TO 50 GO TO 15 ELSE C ADAAA **************************** C IF(H.GT.HC .OR. H.GT.HDDP) THEN ELSE C TMAX=TDGC TMIN=TLCK-0.1-273.15 VX=F51J15(PBAR0,TMIN) IF(VX.LT.VMINT) THEN TMIN=TLCK-273.15 VX=F51J15(PBAR0,TMIN) IF(VX.LT.VMINT) THEN C WRITE(*,*) 'VX.LT.VMINT AFTER ADAAA',VX,VMINT GO TO 40 END IF END IF HX=G02J15(VX,TMIN) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 32 IF(HX.GT.H) THEN GO TO 40 END IF TWH=(TMAX-TMIN)/49.9 H2=HX DO 131 I=1,50 H1=H2 TDGC=TMIN+I*TWH VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 131 H2=G02J15(VX,TDGC) IF(H2.GT.H) GO TO 132 131 CONTINUE 132 TMAX=TDGC TMIN=TDGC-TWH C ICASE=1 GO TO 15 END IF C **************************** C 14 TWH=(TMAX-TMIN)/50.0 DO 141 I=1,51 TDGC=TMIN+(I-1)*TWH VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 141 IF(VX.GT.VMAXT) GO TO 141 HX=G02J15(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.LT.3.0E4) GO TO 141 IF(HX.GT.H) GO TO 142 141 CONTINUE 142 TMAX=TDGC TMIN=TDGC-TWH C ICASE=3 C 15 IF(TMIN.GT.TMAX) THEN TDGC=TMIN TMIN=TMAX TMAX=TDGC END IF C TCC=SNGL(TCK)-273.15 TMINK=TMIN+237.15 VX=F51J15(PBAR0,TMIN) H1=G02J15(VX,TMIN) VX=F51J15(PBAR0,TMAX) H2=G02J15(VX,TMAX) IF(ABS(H1/H-1.0).LT.1.0E-6) GO TO 32 IF(ABS(H2/H-1.0).LT.1.0E-6) GO TO 31 C 146 GO TO 50 C 25 IF((H1-H)*(H2-H).GT.0.0) GO TO 50 261 IF(PBAR0.GT.PCBAR) GO TO 265 TDGC=F40J15(PBAR0) IF(TDGC.LT.234.5-273.15) GO TO 50 VDDP=F54J15(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G02J15(VDDP,TDGC) IF(H.GT.HDDP) THEN GO TO 263 END IF GO TO 26 C 263 H1=HDDP TMIN=TDGC IF(TDGC.LT.TLCK-273.15) THEN TMIN=TLCK-273.15 TDGC=TMIN VDDP=F54J15(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G02J15(VDDP,TDGC) H1=HDDP IF(H1.LT.0.1) GO TO 50 IF(H.LT.HDDP) GO TO 26 END IF C IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) THEN TMAX=TMAXT-273.15 TDGC=TMAX VX=F51J15(PBAR0,TDGC) HX=G02J15(VX,TDGC) IF(HX.LT.H) THEN GO TO 40 C OUT OF RANGE END IF H2=HX END IF C TWH=TMIN TSP=TMAX-TMIN DO 264 I=1,20 TDGC=TWH+I*TSP/19.9 VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 264 HW=G02J15(VX,TDGC) IF(HW.LT.0.1) GO TO 264 IF(ABS(HW/H-1.0).LT.1.0E-6) GO TO 30 IF((H1-H)*(HW-H).GT.0.0) THEN H1=HW TMIN=TDGC ELSE H2=HW TMAX=TDGC GO TO 26 END IF 264 CONTINUE C GO TO 50 C 265 IF(TMIN.LT.TLCK-273.15) TMIN=TLCK-273.15 IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) TMAX=TMAXT-273.15 TDGC=TMIN VX=F51J15(PBAR0,TDGC) HX=G02J15(VX,TDGC) IF(HX.GT.H) THEN GO TO 40 C OUT OF RANGE END IF H1=HX TDGC=TMAX VX=F51J15(PBAR0,TDGC) HX=G02J15(VX,TDGC) IF(HX.LT.H) THEN GO TO 40 C OUT OF RANGE END IF H2=HX C TWH=TMIN TSP=TMAX-TMIN DO 267 I=1,200 TDGC=TWH+I*TSP/199.0 VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 267 HX=G02J15(VX,TDGC) IF(HX.LT.0.1) GO TO 267 IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) GO TO 266 IF(HX.GT.H1) THEN H1=HX TMIN=TDGC END IF GO TO 267 C 266 IF(HX.LT.H2) THEN H2=HX TMAX=TDGC IF(TMAX.GT.TMIN) GO TO 26 END IF 267 CONTINUE C 26 IC=0 TMNR=TMIN TMXR=TMAX 27 TDGC=(TMIN+TMAX)*0.5 28 VX=F51J15(PBAR0,TDGC) HW=G02J15(VX,TDGC) IF(ABS(HW/H-1.0).LT.1.0E-6) THEN PST=G01J15(VX,TDGC) IF(ABS(PST/PBAR0-1.0).LT.1.0E-6) GO TO 30 C WRITE(*,*) 'HW=H BUT PST NOT PBAR0 GO ON REPEAT' END IF IC=IC+1 IF(IC.GT.999) GO TO 50 IF(ABS(H1/H2-1.0).GT.1.0E-5) GO TO 29 TDGC=(TMIN+TMAX)*0.5 C 281 DO 283 K=1,8 TWH=(TMXR-TMNR)/10.3 IS0=0 DO 282 I=1,10 TDGC=TMNR+I*TWH VX=F51J15(PBAR0,TDGC) IF(VX.LT.0.49E-3) GO TO 282 TSP=G01J15(VX,TDGC) IF(TSP.LT.0.21) GO TO 282 HW=G02J15(VX,TDGC) IF(IS0.EQ.0) THEN H1=ABS(HW/H-1.0)+ABS(TSP/PBAR0-1.0) IF(H1.LT.2.0E-6) GO TO 30 VDP=VX IMK=I IS0=2 GO TO 282 END IF H2=ABS(HW/H-1.0)+ABS(TSP/PBAR0-1.0) IF(H2.LT.2.0E-6) GO TO 30 IF(H1.LT.H2) GO TO 282 H1=H2 IMK=I VDP=VX C 282 CONTINUE TMXR=TMNR+(IMK+1)*TWH TMNR=TMNR+(IMK-1)*TWH 283 CONTINUE TDGC=TMNR+IMK*TWH VX=VDP GO TO 30 C 29 IF((H1-H)*(HW-H).GT.0.0) THEN H1=HW TMIN=TDGC ELSE H2=HW TMAX=TDGC END IF TRS1=TMIN+273.15 TRS2=TMAX+273.15 IF(DABS(TRS1/TRS2-1.0D0).LT.1.0D-3) GO TO 27 TWH=TDGC TDGC=(TMAX+TMIN)*0.5+(TMIN-TMAX)*(H-(H1+H2)*0.5)/(H1-H2) IF(ABS(TDGC-TWH).GT.1.0E-2) GO TO 291 TWH=(TMAX+TMIN)*0.5 IF(ABS(TDGC-TWH).GT.1.0E-2) THEN TDGC=TWH END IF C 291 IF(TDGC.LT.TMIN.OR.TDGC.GT.TMAX) GO TO 27 GO TO 28 C C 30 F64J15=TDGC RETURN 31 F64J15=TMAX RETURN 32 F64J15=TMIN RETURN 40 F64J15=-1.0E20 RETURN 50 F64J15=-1.0E10 RETURN END C 65 ******* FUNCTION F65J15(PBAR0,S) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F65J15,TDGC,SW,TMAX,TMIN,SDP,SDDP,SX,S1,S2,TSP,VX,TWH REAL PBAR0,S,G05J15,F40J15,F51J15,TMAXT,VMINT,VMAXT REAL F54J15,TLCK,TCC,VDP,VDDP,VCM3K REAL TMXR,TMNR,G01J15,G06J15 C DATA SC/1.6464D3/ DATA PCBAR,TCK,ROCKM3/4.123D1,4.1025D2,4.350D2/ DATA VMINT,TMAXT,TLCK,VMAXT/0.7543E-3,453.2,203.0,3.75/ C IF(PBAR0.LT.0.044.OR.PBAR0.GT.35.1) GO TO 40 IF(S.LT.0.7E3.OR.S.GT.2.5E3) GO TO 40 IF(ABS(PBAR0-41.23).GT.0.01) GO TO 5 IF(ABS(S-SNGL(SC)).GT.6.0) GO TO 5 C CRITICAL PRES. ERROR =0.01(BAR) C CRITICAL SPC. S ERROR=0.006E3(J/KG) TDGC=SNGL(TCK)-273.15 GO TO 30 C 5 VCM3K=1.0/SNGL(ROCKM3) IF(PBAR0/35.1-1.0.GT.1.0E-6) GO TO 40 TDGC=F40J15(PBAR0) TSP=TDGC IF(TDGC.LT.-70.7) GO TO 40 SDP=G06J15(TDGC) IF(SDP.LT.1.0E-1) GO TO 50 IF(S/SDP-1.0.GT.1.0E-6) GO TO 13 C C ON UPPER SAT. LIQ LINE AND IN SUPER HEAT VAPOR GO TO 13 C ON SAT.LIQ. LINE ERR=0.04 IF(TDGC.LT.-50.0) ERR=0.08 C EXAMPLE R152A IF(ABS(S/SDP-1.0).GT.ERR) GO TO 40 C LIMITTED ONLY ON THE SAT.LIQ LINE, NO COMPRESSED LIQUID GO TO 30 C 13 VDDP=F54J15(TDGC) IF(VDDP.LT.VCM3K) GO TO 50 SDDP=G05J15(VDDP,TDGC) ERR=1.0E-5 IF(TDGC.GT.100.0) ERR=5.0E-4 IF(S/SDDP-1.0.LT.ERR) GO TO 30 C ADAAX **************************** IF(S.GT.SC .OR. S.GT.SDDP) THEN C IF(PBAR0.LT.1.0) THEN TMIN=(-17+60)*ALOG10(PBAR0/0.1)-60.0 ELSE IF(PBAR0.LT.6.5) THEN TMIN=(40+17)/ALOG10(6.5)*ALOG10(PBAR0)-17.0 ELSE TMIN=(115-40)/ALOG10(35.0/6.5)*ALOG10(PBAR0/6.5)+40.0 END IF C TSP=F40J15(PBAR0) IF(TMIN.LT.TSP) TMIN=TSP C IF(TMIN.LT.TDGC) TMIN=TDGC IF(TMIN.LT.-58.09) TMIN=-58.09 C F51 TMIN=-58.1 C TMAX=TMAXT-273.15 IF(PBAR0.GT.30.0) THEN TMAX=(135.0-145.0)/5.0*(PBAR0-30.0)+145.0 END IF C ICASE=4 TSP=(TMAX-TMIN)/9.9 INSTEP=11 TWH=TMAX SW=2.0E10 DO 135 IMARK=1,9 DO 133 I=1,INSTEP TDGC=TMAX-(I-1)*TSP IF(TDGC.LT.-50.09) TDGC=-58.09 C F 51 TMIN=-58.1 136 VX=F51J15(PBAR0,TDGC) IF(VX.LT.VDDP*0.97) THEN IF(VX.LT.-0.5E5) GO TO 50 C IF(VX.GT.VDDP*0.95) GO TO 30 GO TO 50 END IF C VX.LT.VDDP END IF C SX=G05J15(VX,TDGC) C IF(ABS(SX/S-1.0).LT.1.0E-4) GO TO 30 IF(SX.LT.S .OR. SX.GT.SW) GO TO 134 C SW=SX TWH=TDGC 133 CONTINUE IF(ABS(SW/S-1.0).LT.1.0E-4) THEN TDGC=TWH GO TO 30 END IF GO TO 50 C 134 TMAX=TWH TMIN=TDGC IF(TMIN.GT.TMAX) THEN VX=TMIN TMIN=TMAX TMAX=VX END IF IF(ABS(TMAX-TMIN).LT.1.0E-4) TMAX=TMIN+TSP IF(TMAX.GT.TMAXT-273.15) TMAX=TMAXT-273.15 C VX=F51J15(PBAR0,TMIN) S1=G05J15(VX,TMIN) VX=F51J15(PBAR0,TMAX) S2=G05J15(VX,TDGC) SW=S2*10.0 C IF(IMARK.LT.3) THEN TSP=(TMAX-TMIN)/9.9 INSTEP=11 ELSE TSP=(TMAX-TMIN)/29.9 INSTEP=31 END IF 135 CONTINUE IF(ABS(SW/S-1.0).LT.1.0E-4) THEN TDGC=TWH GO TO 30 END IF C IF(ABS(TMAX-TMIN).LT.1.0E-2) GO TO 50 GO TO 15 ELSE C ADAAA **************************** C IF(S.GT.SC .OR. S.GT.SDDP) THEN ELSE C TMAX=TDGC TMIN=TLCK-0.1-273.15 VX=F51J15(PBAR0,TMIN) IF(VX.LT.VMINT) THEN TMIN=TLCK-273.15 VX=F51J15(PBAR0,TMIN) IF(VX.LT.VMINT) THEN C WRITE(*,*) 'VX.LT.VMINT AFTER ADAAA' GO TO 40 END IF END IF SX=G05J15(VX,TMIN) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 IF(SX.GT.S) THEN GO TO 40 END IF TWH=(TMAX-TMIN)/49.9 S2=SX DO 131 I=1,50 S1=S2 TDGC=TMIN+I*TWH VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 131 S2=G05J15(VX,TDGC) IF(S2.GT.S) GO TO 132 131 CONTINUE 132 TMAX=TDGC TMIN=TDGC-TWH C ICASE=1 GO TO 15 END IF C **************************** C 14 TWH=(TMAX-TMIN)/49.9 DO 141 I=1,51 TDGC=TMIN+(I-1)*TWH VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 141 IF(VX.GT.VMAXT) GO TO 141 SX=G05J15(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.LT.3.0E2) GO TO 141 IF(SX.GT.S) GO TO 142 141 CONTINUE 142 TMAX=TDGC TMIN=TDGC-TWH C ICASE=3 C 15 IF(TMIN.GT.TMAX) THEN TDGC=TMIN TMIN=TMAX TMAX=TDGC END IF C TCC=SNGL(TCK)-273.15 TMINK=TMIN+237.15 VX=F51J15(PBAR0,TMIN) S1=G05J15(VX,TMIN) VX=F51J15(PBAR0,TMAX) S2=G05J15(VX,TMAX) IF(ABS(S1/S-1.0).LT.1.0E-6) GO TO 32 IF(ABS(S2/S-1.0).LT.1.0E-6) GO TO 31 C 146 GO TO 50 C 25 IF((S1-S)*(S2-S).GT.0.0) GO TO 50 261 IF(PBAR0.GT.PCBAR) GO TO 265 TDGC=F40J15(PBAR0) IF(TDGC.LT.234.5-273.15) GO TO 50 VDDP=F54J15(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 SDDP=G05J15(VDDP,TDGC) IF(S.GT.SDDP) THEN GO TO 263 END IF GO TO 26 C 263 S1=SDDP TMIN=TDGC IF(TDGC.LT.TLCK-273.15) THEN TMIN=TLCK-273.15 TDGC=TMIN VDDP=F54J15(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 SDDP=G05J15(VDDP,TDGC) S1=SDDP IF(S1.LT.0.1) GO TO 50 IF(S.LT.SDDP) GO TO 26 END IF C IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) THEN TMAX=TMAXT-273.15 TDGC=TMAX VX=F51J15(PBAR0,TDGC) SX=G05J15(VX,TDGC) IF(SX.LT.S) THEN GO TO 40 C OUT OF RANGE END IF S2=SX END IF C TWH=TMIN TSP=TMAX-TMIN DO 264 I=1,20 TDGC=TWH+I*TSP/19.9 VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 264 SW=G05J15(VX,TDGC) IF(SW.LT.0.1) GO TO 264 IF(ABS(SW/S-1.0).LT.1.0E-6) GO TO 30 IF((S1-S)*(SW-S).GT.0.0) THEN S1=SW TMIN=TDGC ELSE S2=SW TMAX=TDGC GO TO 26 END IF 264 CONTINUE C GO TO 50 C 265 IF(TMIN.LT.TLCK-273.15) TMIN=TLCK-273.15 IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) TMAX=TMAXT-273.15 TDGC=TMIN VX=F51J15(PBAR0,TDGC) SX=G05J15(VX,TDGC) IF(SX.GT.S) THEN GO TO 40 C OUT OF RANGE END IF S1=SX TDGC=TMAX VX=F51J15(PBAR0,TDGC) SX=G05J15(VX,TDGC) IF(SX.LT.S) THEN GO TO 40 C OUT OF RANGE END IF S2=SX C TWH=TMIN TSP=TMAX-TMIN DO 267 I=1,200 TDGC=TWH+I*TSP/199.0 VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 267 SX=G05J15(VX,TDGC) IF(SX.LT.0.1) GO TO 267 IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) GO TO 266 IF(SX.GT.S1) THEN S1=SX TMIN=TDGC END IF GO TO 267 C 266 IF(SX.LT.S2) THEN S2=SX TMAX=TDGC IF(TMAX.GT.TMIN) GO TO 26 END IF 267 CONTINUE C 26 IC=0 TMNR=TMIN TMXR=TMAX 27 TDGC=(TMIN+TMAX)*0.5 28 VX=F51J15(PBAR0,TDGC) SW=G05J15(VX,TDGC) IF(ABS(SW/S-1.0).LT.1.0E-6) THEN PST=G01J15(VX,TDGC) IF(ABS(PST/PBAR0-1.0).LT.1.0E-6) GO TO 30 C WRITE(*,*) 'SW=S BUT PST NOT PBAR0 GO ON REPEAT' END IF IC=IC+1 IF(IC.GT.999) GO TO 50 IF(ABS(S1/S2-1.0).GT.1.0E-5) GO TO 29 TDGC=(TMIN+TMAX)*0.5 C 281 DO 283 K=1,8 TWH=(TMXR-TMNR)/10.3 IS0=0 DO 282 I=1,10 TDGC=TMNR+I*TWH VX=F51J15(PBAR0,TDGC) IF(VX.LT.0.49E-3) GO TO 282 TSP=G01J15(VX,TDGC) IF(TSP.LT.0.21) GO TO 282 SW=G05J15(VX,TDGC) IF(IS0.EQ.0) THEN S1=ABS(SW/S-1.0)+ABS(TSP/PBAR0-1.0) IF(S1.LT.2.0E-6) GO TO 30 VDP=VX IMK=I IS0=2 GO TO 282 END IF S2=ABS(SW/S-1.0)+ABS(TSP/PBAR0-1.0) IF(S2.LT.2.0E-6) GO TO 30 IF(S1.LT.S2) GO TO 282 S1=S2 IMK=I VDP=VX C 282 CONTINUE TMXR=TMNR+(IMK+1)*TWH TMNR=TMNR+(IMK-1)*TWH 283 CONTINUE TDGC=TMNR+IMK*TWH VX=VDP GO TO 30 C 29 IF((S1-S)*(SW-S).GT.0.0) THEN S1=SW TMIN=TDGC ELSE S2=SW TMAX=TDGC END IF TRS1=TMIN+273.15 TRS2=TMAX+273.15 IF(DABS(TRS1/TRS2-1.0D0).LT.1.0D-3) GO TO 27 TWH=TDGC TDGC=(TMAX+TMIN)*0.5+(TMIN-TMAX)*(S-(S1+S2)*0.5)/(S1-S2) IF(ABS(TDGC-TWH).GT.1.0E-2) GO TO 291 TWH=(TMAX+TMIN)*0.5 IF(ABS(TDGC-TWH).GT.1.0E-2) THEN TDGC=TWH END IF C 291 IF(TDGC.LT.TMIN.OR.TDGC.GT.TMAX) GO TO 27 GO TO 28 C C 30 F65J15=TDGC RETURN 31 F65J15=TMAX RETURN 32 F65J15=TMIN RETURN 40 F65J15=-1.0E20 RETURN 50 F65J15=-1.0E10 RETURN END C 70 ******* FUNCTION F70J15(PBAR,VM3K) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F70J15,PBAR,TDGC,VM3K,PW,TMAX,TMIN,VDP,VDDP,P1,P2,TSP REAL G01J15,F40J15,F53J15,F54J15,VCM3K REAL TDGCMX,TDGCMN C DATA PCBAR,TCK,VCLMOL,WMOL/4.123D1,4.1025D2,0.23103D0,100.496D0/ C IF(PBAR.LT.0.0045.OR.PBAR.GT.41.235) GO TO 40 IF(VM3K.LT.0.00074.OR.VM3K.GT.3.8) GO TO 40 C IF(ABS(PBAR-41.23).GT.0.006) GO TO 5 VCM3K=VCLMOL/WMOL ROCKM3=1.0/VCM3K IF(ABS(VM3K-VCM3K).GT.6.0E-6) GO TO 5 C CRITICAL PRES. ERROR =0.006(BAR) C CRITICAL SPC. VOL ERROR=6E-6(M3/KG) TDGC=SNGL(TCK)-273.15 GO TO 30 C 5 IF(PBAR.GT.41.23) GO TO 40 TDGC=F40J15(PBAR) TSP=TDGC IF(TDGC.LT.-70.7) THEN WRITE(*,*) 'TDGC.LT.-70.0 AFTER LBL 5' GO TO 40 END IF C VDP=F53J15(TDGC) IF(VDP.LT.1.0E-5) THEN WRITE(*,*) 'VDP.LT.1.0E-5 AFTER LBL 5' GO TO 50 END IF IF(VM3K/VDP-1.0.GT.1.0E-5) GO TO 10 C UPPER SAT. LIQ LINE GO TO 10 C ON SAT.LIQ. LINE, NO COPRESSED LIQUID REGION C ERR=0.0031 IF(TDGC.LT.-60.0) ERR=0.005 IF(ABS(VDP/VM3K-1.0).GT.ERR) THEN WRITE(*,*) 'COME ON SAT.LIQ. LINE OUT OF RANGE' GO TO 40 END IF GO TO 30 C 10 VDDP=F54J15(TDGC) IF(VDDP.LT.0.004) THEN WRITE(*,*) 'VDDP.LT.0.0044 AT 10' GO TO 50 END IF IF(VM3K/VDDP-1.0.LT.1.0E-5) THEN PW=G01J15(VM3K,TDGC) IF(ABS(PW/PBAR-1.0).LT.0.01) GO TO 30 GO TO 50 END IF TMIN=TDGC TMAX=180.1 CALL S05J15(PBAR,VM3K,TDGCMX,TDGCMN) IF(ABS(TDGCMX-TDGCMN).LT.1.0E-2) THEN IF(TDGCMX.LT.-50.1 ) THEN WRITE(*,*) 'S05 OUT GO TO 50' GO TO 50 END IF TDGC=(TDGCMX+TDGCMN)*0.5 GO TO 30 END IF IF((TMAX.GT.TDGCMX) .OR. (TMIN.LT.TDGCMN)) THEN TMAX=TDGCMX TMIN=TDGCMN ENDIF ICASE=4 C 15 IF(TMIN.GT.TMAX) THEN TDGC=TMIN TMIN=TMAX TMAX=TDGC END IF IF((TMAX.GT.TDGCMX) .OR. (TMIN.LT.TDGCMN)) THEN TMAX=TDGCMX TMIN=TDGCMN ENDIF P1=G01J15(VM3K,TMIN) P2=G01J15(VM3K,TMAX) IF(ABS(P1/PBAR-1.0).LT.1.0E-6) GO TO 32 IF(ABS(P2/PBAR-1.0).LT.1.0E-6) GO TO 31 C 26 EPS=5.0E-7 C TA=0.618034 TB=1.0-TA C Q1=TA*TMIN+TB*TMAX TKW=Q1 PBARW=G01J15(VM3K,TMIN) EQIVZ=PBARW-PBAR G1=ABS(EQIVZ) Q2=TB*TMIN+TA*TMAX TKW=Q2 PBARW=G01J15(VM3K,TMAX) EQIVZ=PBARW-PBAR G2=ABS(EQIVZ) C IC=0 28 W=ABS(TMAX-TMIN) IC=IC+1 IF(IC.GT.100) GO TO 27 C IF(W.LT.EPS*ABS(TMIN+273.15)) GO TO 27 IF(G1.GT.G2) THEN TMIN=Q1 Q1=Q2 G1=G2 Q2=TB*TMIN+TA*TMAX TKW=Q2 TDGC=SNGL(TKW) PBARW=G01J15(VM3K,TDGC) EQIVZ=PBARW-PBAR G2=ABS(EQIVZ) ELSE TMAX=Q2 Q2=Q1 G2=G1 Q1=TA*TMIN+TB*TMAX TKW=Q1 TDGC=SNGL(TKW) PBARW=G01J15(VM3K,TDGC) EQIVZ=PBARW-PBAR G1=ABS(EQIVZ) END IF IF(ABS((Q1+273.15)/(Q2+273.15)-1.0).GT.1.0E-6) GO TO 28 TDGC=(Q1+Q2)*0.5 GO TO 30 C C MIN. F(X) 27 IF(G1.LT.G2) THEN Z=Q1 ZZ=G1 ELSE Z=Q2 ZZ=G2 END IF TKW=Z TDGC=TKW C 30 F70J15=TDGC RETURN 31 F70J15=TMAX RETURN 32 F70J15=TMIN RETURN 40 F70J15=-1.0E20 RETURN 50 F70J15=-1.0E10 RETURN END C S05 SUBROUTINE S05J15(PBAR,VM3K,TDGCMX,TDGCMN) DATA TMINT,TMAXT,TC,PC,VCLMOL/203.0,453.2,410.25,41.23,0.23103/ C K K K BAR L/MOL DATA WMOL/100.496/ C VC=VCLMOL/WMOL ROC=1.0/VC PWC=G01J15(VM3K,TC-273.15) IF(PWC.LT.PBAR) GO TO 13 TMAXW=TC TKW1=TC TKW2=TMINT C EPS=5.0E-7 C TA=0.618034 TB=1.0-TA C Q1=TA*TKW1+TB*TKW2 TKW=Q1 IF(VM3K.LT.VC) THEN VM3KW=F53J15(TKW-273.15) ELSE VM3KW=F54J15(TKW-273.15) END IF IF(VM3KW.LT.1.0E-6) GO TO 999 EQIVZ=VM3KW-VM3K G1=ABS(EQIVZ) Q2=TB*TKW1+TA*TKW2 TKW=Q2 IF(VM3K.LT.VC) THEN VM3KW=F53J15(TKW-273.15) ELSE VM3KW=F54J15(TKW-273.15) END IF IF(VM3KW.LT.1.0E-6) GO TO 999 EQIVZ=VM3KW-VM3K G2=ABS(EQIVZ) C IC=0 8 W=ABS(TKW2-TKW1) IC=IC+1 IF(IC.GT.100) THEN TDGCMX=TKW-273.15 TDGCMN=TDGCMX RETURN END IF C IF(W.LT.EPS*ABS(TKW1)) GO TO 6 IF(G1.GT.G2) THEN TKW1=Q1 Q1=Q2 G1=G2 Q2=TB*TKW1+TA*TKW2 TKW=Q2 IF(VM3K.LT.VC) THEN VM3KW=F53J15(TKW-273.15) ELSE VM3KW=F54J15(TKW-273.15) END IF IF(VM3KW.LT.1.0E-6) GO TO 999 EQIVZ=VM3KW-VM3K G2=ABS(EQIVZ) ELSE TKW2=Q2 Q2=Q1 G2=G1 Q1=TA*TKW1+TB*TKW2 TKW=Q1 IF(VM3K.LT.VC) THEN VM3KW=F53J15(TKW-273.15) ELSE VM3KW=F54J15(TKW-273.15) END IF IF(VM3KW.LT.1.0E-6) GO TO 999 EQIVZ=VM3KW-VM3K G1=ABS(EQIVZ) END IF IF(ABS(Q1/Q2-1.0).GT.1.0E-6) GO TO 8 TKW=(Q1+Q2)*0.5 GO TO 7 C C MIN. F(X) 6 IF(G1.LT.G2) THEN Z=Q1 ZZ=G1 ELSE Z=Q2 ZZ=G2 END IF TKW=Z 7 TMINW=TKW C PW=PWC C 9 DT=(TMINW-TMAXW)*0.2 TMAXL=TMAXW-273.15 ICNT=0 10 ICNT=ICNT+1 C IF(ICNT.GT.3) GO TO 20 DO 11 I=1,6 TW=DT*(I-1)+TMAXL PW=G01J15(VM3K,TW) IF(PW.LT.PBAR) GO TO 12 11 CONTINUE TDGCMX=TW TDGCMN=TDGCMX-0.5 RETURN 12 TMAXL=TW-DT DT=DT*0.2 GO TO 10 C 13 IF(PBAR.GT.PC) THEN TMAXW=TMAXT TMINW=TC GO TO 14 END IF DT=(TMAXT-TC)/5 DO 30 I=1,5 TSPW=TC+DT*I PWC=G01J15(VM3K,TSPW-273.15) IF(PWC.GT.PBAR) THEN TMAXW=TSPW TMINW=TSPW-DT GO TO 9 END IF 30 CONTINUE TDGCMX=TSPW-273.15 TDGCMN=TDGCMX-0.5 RETURN C 14 DT=(TMAXW-TMINW)*0.2 TMAXL=TMINW-273.15 ICNT=0 15 ICNT=ICNT+1 IF(ICNT.GT.3) GO TO 21 DO 16 I=1,6 TW=DT*(I-1)+TMAXL PW=G01J15(VM3K,TW) IF(PW.GT.PBAR) GO TO 17 16 CONTINUE TDGCMX=TW TDGCMN=TDGCMX-0.5 RETURN 17 TMAXL=TW-DT DT=DT*0.2 GO TO 15 20 TDGCMX=TMAXL TDGCMN=TW RETURN 21 TDGCMN=TMAXL TDGCMX=TW RETURN 999 TDGCMN=-1.0E10 TDGCMX=-1.0E10 RETURN END C S06 SUBROUTINE S06J15(PBAR0,TDGC,VM3K1,VM3K2) C VM3K1.LT.VM3K2 C IF(VM3K2.GT.0.0) GO TO 20 PWBAR=G01J15(VM3K1,TDGC) IF(PWBAR.GT.PBAR0) THEN DM=1.003 GO TO 11 ELSE DM=0.997 GO TO 16 END IF 11 VM3K=VM3K1 DO 12 K=1,100 VM3K2=VM3K VM3K=VM3K*DM PWBAR=G01J15(VM3K,TDGC) IF(PWBAR.LT.PBAR0) THEN VM3K1=VM3K2 VM3K2=VM3K GO TO 20 END IF 12 CONTINUE VM3K1=-1.0E10 RETURN 16 VM3K=VM3K1 DO 17 K=1,100 VM3K2=VM3K VM3K=VM3K*DM PWBAR=G01J15(VM3K,TDGC) IF(PWBAR.GT.PBAR0) THEN VM3K1=VM3K GO TO 20 END IF 17 CONTINUE VM3K1=-1.0E10 RETURN C 20 EPS=5.0E-7 C TA=0.618034 TB=1.0-TA C C Q1=TA*VM3K1+TB*VM3K2 Q1=VM3K1 VM3K=Q1 PBARW=G01J15(VM3K1,TDGC) EQIVZ=PBARW-PBAR0 SIG1=SIGN(1.0,EQIVZ) G1=ABS(EQIVZ) IF(G1.LT.1.0E-6*PBAR0) THEN VM3K=VM3K1 GO TO 30 END IF P1DIFR=EQIVZ X1R=VM3K1 C Q2=TB*VM3K1+TA*VM3K2 Q2=VM3K2 VM3K=Q2 PBARW=G01J15(VM3K2,TDGC) EQIVZ=PBARW-PBAR0 SIG2=SIGN(1.0,EQIVZ) G2=ABS(EQIVZ) IF(G2.LT.1.0E-6*PBAR0) THEN VM3K=VM3K2 GO TO 30 END IF P2DIFR=EQIVZ X2R=VM3K2 C IC=0 28 W=ABS(VM3K2-VM3K1) IC=IC+1 IF(IC.GT.200) GO TO 27 C IF(W.LT.EPS*ABS(VM3K1+VM3K2)) THEN VM3K=(VM3K1+VM3K2)*0.5 PBARW=G01J15(VM3K,TDGC) EQIVZ=PBARW-PBAR0 IF(ABS(EQIVZ).LT.1.0E-5) GO TO 30 IF(P1DIFR*EQIVZ.GT.0.0) THEN P1DIFR=EQIVZ VM3K1=VM3K VM3K2=X2R C P2DIFR=P2DIFR ELSE CC P2DIFR*EQIVZ.GT.0.0 P2DIFR=EQIVZ VM3K2=VM3K VM3K1=X1R C P1DIFR=P1DIFR END IF IF(VM3K1.GT.VM3K2) THEN VM3K=VM3K2 VM3K2=VM3K1 VM3K1=VM3K PBARW=P2DIFR P2DIFR=P1DIFR P1DIFR=PBARW END IF X1R=VM3K1 X2R=VM3K2 IF(ABS(X1R-X2R).LT.EPS*(X1R+X2R) ) THEN VM3K=(VM3K1+VM3K2)*0.5 GO TO 30 ELSE GO TO 28 END IF C END IF C VM3K1-VM3K2.LT.EPS C IF(G1.GT.G2) THEN VM3K1=Q1 SIG1=SIG2 Q1=Q2 G1=G2 Q2=TB*VM3K1+TA*VM3K2 VM3K=Q2 PBARW=G01J15(VM3K,TDGC) EQIVZ=PBARW-PBAR0 SIG2=SIGN(1.0,EQIVZ) G2=ABS(EQIVZ) IF(G2.LT.1.0E-5*PBAR0) THEN GO TO 30 END IF C IF(SIG1*SIG2.LT.0.0) THEN VM3K1=Q1 VM3K2=Q2 IF(VM3K1.GT.VM3K2) THEN VW=VM3K1 VM3K1=VM3K2 VM3K2=VW END IF GO TO 25 END IF C ELSE C IF(G1.GT.G2) THEN FALSE C VM3K2=Q2 SIG2=SIG1 Q2=Q1 G2=G1 Q1=TA*VM3K1+TB*VM3K2 VM3K=Q1 PBARW=G01J15(VM3K,TDGC) EQIVZ=PBARW-PBAR0 SIG1=SIGN(1.0,EQIVZ) G1=ABS(EQIVZ) IF(G1.LT.1.0E-5*PBAR0) THEN GO TO 30 END IF C IF(SIG1*SIG2.LT.0.0) THEN VM3K1=Q1 VM3K2=Q2 IF(VM3K1.GT.VM3K2) THEN VW=VM3K1 VM3K1=VM3K2 VM3K2=VW END IF GO TO 25 END IF C END IF C IF(G1.GT.G2) THEN... ELSE... END IF C IF(ABS(Q2).GT.1.0E-7) THEN IF(ABS(Q1/Q2-1.0).GT.1.0E-6) GO TO 28 ELSE IF(ABS(Q2/Q1-1.0).GT.1.0E-6) GO TO 28 END IF VM3K=(Q1+Q2)*0.5 GO TO 30 C 25 PBARW=G01J15(VM3K1,TDGC) Y2=PBARW-PBAR0 X2=VM3K1 IF(ABS(Y2).LT.1.0E-5*PBAR0) THEN VM3K=X2 GO TO 30 END IF C DX=(VM3K2-VM3K1)/199.9 DO 26 K=1,201 VM3K=VM3K1+(K-1)*DX X1=VM3K PBARW=G01J15(VM3K,TDGC) Y1=PBARW-PBAR0 IF(ABS(Y1).LT.1.0E-5*PBAR0) GO TO 30 C IF(Y1*Y2.LT.0.0) GO TO 261 X2=X1 Y2=Y1 26 CONTINUE 261 IF(ABS(Y1-Y2).LT.1.0E-7) THEN VM3K=(X1+X2)*0.5 C 'IN S06 Y1=Y2' YW=G01J15(VM3K,TDGC)-PBAR0 Y1=G01J15(X1,TDGC)-PBAR0 Y2=G01J15(X2,TDGC)-PBAR0 ELSE VM3K=X1-Y1*(X2-X1)/(Y2-Y1) YW=G01J15(VM3K,TDGC)-PBAR0 Y1=G01J15(X1,TDGC)-PBAR0 Y2=G01J15(X2,TDGC)-PBAR0 IF(Y1*YW.GT.0.0) THEN VM3K1=VM3K VM3K2=X2 ELSE VM3K1=X1 VM3K2=VM3K END IF RETURN END IF GO TO 30 C C MIN. F(X) 27 IF(G1.LT.G2) THEN Z=Q1 ZZ=G1 ELSE Z=Q2 ZZ=G2 END IF VM3K=Z C 30 VM3K1=VM3K VM3K2=VM3K RETURN END C S08 SUBROUTINE S08J15(PBAR0,S,VM3K,TEMPC,H) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL TDGC,SW,TMAX,TMIN,SDP,SDDP,SX,S1,S2,TSP,VX,TWS REAL PBAR0,S,G05J15,F40J15,F51J15,TMAXT,VMINT,VMAXT REAL F53J15,F54J15,TLCK,TCC,VDP,VDDP,VDPMAX,VCM3K REAL F37J15,VM3K,TEMPC,H,G02J15,G01J15,G06J15 C DATA SC/1.6464D3/ DATA PCBAR,TCK,ROCKM3/4.123D1,4.1025D2,4.350D2/ DATA VMINT,TMAXT,TLCK,VMAXT/0.7543E-3,453.2,203.0,3.75/ C IF(PBAR0.LT.0.044.OR.PBAR0.GT.35.1) GO TO 40 IF(S.LT.0.7E3.OR.S.GT.2.5E3) GO TO 40 IF(ABS(PBAR0-41.23).GT.0.01) GO TO 5 IF(ABS(S-SNGL(SC)).GT.6.0) GO TO 5 C CRITICAL PRES. ERROR =0.01(BAR) C CRITICAL SPC. S ERROR=0.006E3(J/KG) TDGC=SNGL(TCK)-273.15 GO TO 30 C 5 VCM3K=1.0/SNGL(ROCKM3) TCC=SNGL(TCK)-273.15 IF(PBAR0/SNGL(PCBAR)-1.0.GT.-1.0E-6) THEN GO TO 8 END IF TDGC=F40J15(PBAR0) TSP=TDGC IF(TDGC.LT.-70.7) GO TO 40 C SDP=F37J15(TDGC) IF(SDP.LT.1.0E-1) GO TO 50 IF(S/SDP-1.0.GT.-1.0E-6) THEN GO TO 13 END IF C ON SAT. LIQ LINE AND IN SUPER HEAT VAPOR GO TO 13 C TMAX=TSP VDPMAX=F53J15(TMAX) TSP=(TMAX+273.15-TLCK)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J15(TDGC) SDP=G06J15(TDGC) IF(SDP.LT.0.001) GO TO 6 IF(SDP.LT.S) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J15(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.VMINT) VX=VDP SX=G05J15(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 C DO 71 I=1,50 TDGC=TMIN+I*TSP VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 71 SX=G05J15(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(VX.GT.VDPMAX) GO TO 72 IF(SX.GT.S) GO TO 72 71 CONTINUE 72 TMAX=TDGC ICASE=1 GO TO 717 C 8 IF(S.GT.SC) THEN TMIN=TLCK-273.15 GO TO 12 END IF VDP=F53J15(TLCK-273.15) SDP=G06J15(TLCK-273.15) IF(SDP.LT.S) THEN GO TO 9 END IF ICASE=2 C C TMIN=TLCK C****************** TMAX=TMAXT-273.15 TMIN=TLCK-273.15 VX=F51J15(PBAR0,TMIN) IF(VX.LT.VMINT.OR.VX.GT.VMAXT) THEN GO TO 717 END IF C C SX=G05J15(VX,TMIN) C**************** C IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 C TDGC=SNGL(TCK)-273.15 VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) THEN GO TO 717 END IF SX=G05J15(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN TMAX=TDGC C TMIN=TLCK GO TO 717 ELSE TMIN=TDGC TMAX=TMAXT-273.15 ICASE=3 GO TO 717 END IF C 9 TSP=(SNGL(TCK)-TLCK)/50.0 DO 10 I=1,50 TDGC=TLCK+I*TSP-273.15 VDP=F53J15(TDGC) SDP=G06J15(TDGC) IF(SDP.GT.S) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J15(PBAR0,TMIN) IF(VX.LT.VMINT.OR.VX.GT.VCM3K) THEN TCC=SNGL(TCK)-273.15 TSP=(TMAXT-273.15-TMIN)/200.0 ICASE=2 DO 712 I=1,202 TDGC=TMIN+(I-1)*TSP IF(TDGC+273.15.GT.TMAXT) THEN GO TO 716 END IF VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN SX=G05J15(VX,TDGC) ELSE SX=G05J15(VX,TDGC) END IF IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN TMAX=TDGC TMIN=TDGC-TSP GO TO 717 END IF 712 CONTINUE 716 GO TO 50 END IF C SX=G05J15(VX,TMIN) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 IF(SX.GT.S) THEN TMAX=TMIN ICASE=2 GO TO 717 ELSE GO TO 718 END IF C 717 DO 713 IMARK=1,5 IF(IMARK.EQ.1) THEN TSP=(TMAX-TMIN)/49.9 TWS=TMAX SW=2.0E10 ELSE TMAX=TWS TMIN=TDGC TSP=TSP/50.0 END IF DO 711 I=1,52 TDGC=TMAX-(I-1)*TSP VX=F51J15(PBAR0,TDGC) IF(VX.LT.0.995*VMINT) GO TO 711 SX=G05J15(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 C IF(SX.LT.S .OR. SX.GT.SW) GO TO 713 TWS=TDGC SW=SX 711 CONTINUE IF(ABS(SW/S-1.0).LT.5.0E-4) THEN TDGC=TWS GO TO 30 END IF GO TO 50 713 CONTINUE IF(ABS(SW/S-1.0).LT.1.0E-4) THEN TDGC=TWS GO TO 30 END IF IF(SW.GT.1.0E10 .OR. ABS(TMAX-TMIN).LT.1.0E-2) THEN GO TO 50 END IF C GO TO 15 C C TMAX SET 718 TDGC=SNGL(TCK)-273.15 VX=F51J15(PBAR0,TDGC) SX=G05J15(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN TMAX=TDGC ELSE TMAX=TMAXT-273.15 TMIN=TDGC END IF ICASE=2 GO TO 717 C 12 TMAX=TMAXT-273.15 TCC=SNGL(TCK)-273.15 TDGC=(TMIN+TMAX)*0.5 VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 50 SX=G05J15(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN TMAX=TDGC ELSE TMIN=TDGC END IF ICASE=3 GO TO 717 C 13 VDDP=F54J15(TDGC) IF(VDDP.LT.VCM3K) GO TO 50 SDDP=G05J15(VDDP,TDGC) IF(S/SDDP-1.0.LT.1.0E-6) THEN VX=VDDP GO TO 30 END IF C ADAAX **************************** IF(S.GT.SC) THEN TMIN=TDGC TMAX=TMAXT-273.15 ICASE=4 TSP=(TMAX-TMIN)/24.9 TWS=TMAX SW=2.0E10 DO 135 IMARK=1,5 DO 133 I=1,26 TDGC=TMAX-(I-1)*TSP VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 134 SX=G05J15(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.LT.S .OR. SX.GT.SW) GO TO 134 SW=SX TWS=TDGC 133 CONTINUE IF(ABS(SW/S-1.0).LT.5.0E-4) THEN TDGC=TWS GO TO 30 END IF GO TO 50 134 TMAX=TWS TMIN=TDGC TSP=(TMAX-TMIN)/24.9 135 CONTINUE IF(ABS(SW/S-1.0).LT.1.0E-4) THEN TDGC=TWS GO TO 30 END IF IF(SW.GT.1.0E10 .OR. ABS(TMAX-TMIN).LT.1.0E-2) GO TO 50 C GO TO 15 ELSE C ADAAA **************************** TMAX=TDGC TMIN=TLCK-0.1-273.15 VX=F51J15(PBAR0,TMIN) IF(VX.LT.VMINT) THEN TMIN=TLCK-273.15 VX=F51J15(PBAR0,TMIN) IF(VX.LT.VMINT) GO TO 40 END IF SX=G05J15(VX,TMIN) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 IF(SX.GT.S) GO TO 40 TWS=(TMAX-TMIN)/50.0 S2=SX DO 131 I=1,50 S1=S2 TDGC=TMIN+I*TWS VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 131 S2=G05J15(VX,TDGC) IF(S2.GT.S) GO TO 132 131 CONTINUE 132 TMAX=TDGC TMIN=TDGC-TWS ICASE=1 GO TO 15 END IF C **************************** C 15 IF(TMIN.GT.TMAX) THEN TDGC=TMIN TMIN=TMAX TMAX=TDGC END IF C TCC=SNGL(TCK)-273.15 TMINK=TMIN+237.15 VX=F51J15(PBAR0,TMIN) S1=G05J15(VX,TMIN) VX=F51J15(PBAR0,TMAX) S2=G05J15(VX,TMAX) IF(ABS(S1/S-1.0).LT.1.0E-6) GO TO 32 IF(ABS(S2/S-1.0).LT.1.0E-6) GO TO 31 C C TSP=(TMAX-TMIN)/24.9 TWS=TMAX SW=2.0E10 DO 145 IMARK=1,5 DO 143 I=1,26 TDGC=TMAX-(I-1)*TSP VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 143 SX=G05J15(VX,TDGC) IF(ABS(SW/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.LT.S .OR. SX.GT.SW) GO TO 144 SW=SX TWS=TDGC 143 CONTINUE IF(ABS(SW/S-1.0).LT.5.0E-4) THEN TDGC=TWS GO TO 30 END IF GO TO 146 144 TMAX=TWS TMIN=TDGC TSP=(TMAX-TMIN)/24.9 145 CONTINUE IF(ABS(SW/S-1.0).LT.1.0E-4) THEN TDGC=TWS GO TO 30 END IF C 146 GO TO 50 C 25 IF((S1-S)*(S2-S).GT.0.0) GO TO 50 261 IF(PBAR0.GT.PCBAR) GO TO 265 TDGC=F40J15(PBAR0) IF(TDGC.LT.234.5-273.15) GO TO 50 VDDP=F54J15(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G05J15(VDDP,TDGC) IF(S.GT.HDDP) THEN GO TO 263 END IF GO TO 26 C 263 S1=HDDP TMIN=TDGC IF(TDGC.LT.TLCK-273.15) THEN TMIN=TLCK-273.15 TDGC=TMIN VDDP=F54J15(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G05J15(VDDP,TDGC) S1=HDDP IF(S1.LT.0.1) GO TO 50 IF(S.LT.HDDP) GO TO 26 END IF C IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) THEN TMAX=TMAXT-273.15 TDGC=TMAX VX=F51J15(PBAR0,TDGC) SX=G05J15(VX,TDGC) IF(SX.LT.S) GO TO 40 C OUT OF RANGE S2=SX END IF C TWS=TMIN TSP=TMAX-TMIN DO 264 I=1,20 TDGC=TWS+I*TSP/19.9 VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 264 SW=G05J15(VX,TDGC) IF(SW.LT.0.1) GO TO 264 IF(ABS(SW/S-1.0).LT.1.0E-6) GO TO 30 IF((S1-S)*(SW-S).GT.0.0) THEN S1=SW TMIN=TDGC ELSE S2=SW TMAX=TDGC GO TO 26 END IF 264 CONTINUE C GO TO 50 C 265 IF(TMIN.LT.TLCK-273.15) TMIN=TLCK-273.15 IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) TMAX=TMAXT-273.15 TDGC=TMIN VX=F51J15(PBAR0,TDGC) SX=G05J15(VX,TDGC) IF(SX.GT.S) GO TO 40 C OUT OF RANGE S1=SX TDGC=TMAX VX=F51J15(PBAR0,TDGC) SX=G05J15(VX,TDGC) IF(SX.LT.S) GO TO 40 C OUT OF RANGE S2=SX C TWS=TMIN TSP=TMAX-TMIN DO 267 I=1,20 TDGC=TWS+I*TSP/19.9 VX=F51J15(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 267 SX=G05J15(VX,TDGC) IF(SX.LT.0.1) GO TO 267 IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) GO TO 266 IF(SX.GT.S1) THEN S1=SX TMIN=TDGC END IF GO TO 267 C 266 IF(SX.LT.S2) THEN S2=SX TMAX=TDGC IF(TMAX.GT.TMIN) GO TO 26 END IF 267 CONTINUE C 26 IC=0 27 TDGC=(TMIN+TMAX)*0.5 28 VX=F51J15(PBAR0,TDGC) SW=G05J15(VX,TDGC) IF(ABS(SW/S-1.0).LT.1.0E-6) THEN PST=G01J15(VX,TDGC) IF(ABS(PST/PBAR0-1.0).LT.1.0E-6) GO TO 30 C WRITE(*,*) 'SW=S BUT PST NOT PBAR0 GO ON REPEAT' END IF C IC=IC+1 IF(IC.GT.999) GO TO 50 IF(ABS(S1/S2-1.0).GT.1.0E-5) GO TO 29 TDGC=(TMIN+TMAX)*0.5 C 281 DO 283 K=1,8 TWS=(TMXR-TMNR)/10.3 IS0=0 DO 282 I=1,10 TDGC=TMNR+I*TWS VX=F51J15(PBAR0,TDGC) IF(VX.LT.0.49E-3) GO TO 282 TSP=G01J15(VX,TDGC) IF(TSP.LT.0.21) GO TO 282 SW=G05J15(VX,TDGC) IF(IS0.EQ.0) THEN S1=ABS(SW/S-1.0)+ABS(TSP/PBAR0-1.0) IF(S1.LT.2.0E-6) GO TO 30 VDP=VX IMK=I IS0=2 GO TO 282 END IF S2=ABS(SW/S-1.0)+ABS(TSP/PBAR0-1.0) IF(S2.LT.2.0E-6) GO TO 30 IF(S1.LT.S2) GO TO 282 S1=S2 IMK=I VDP=VX C 282 CONTINUE TMXR=TMNR+(IMK+1)*TWS TMNR=TMNR+(IMK-1)*TWS 283 CONTINUE TDGC=TMNR+IMK*TWS VX=VDP C VX=F51J15(PBAR0,TDGC)DELETE C *********************** GO TO 30 29 IF((S1-S)*(SW-S).GT.0.0) THEN S1=SW TMIN=TDGC ELSE S2=SW TMAX=TDGC END IF TRS1=TMIN+273.15 TRS2=TMAX+273.15 IF(DABS(TRS1/TRS2-1.0D0).LT.1.0D-3) GO TO 27 TWS=TDGC TDGC=(TMAX+TMIN)*0.5+(TMIN-TMAX)*(S-(S1+S2)*0.5)/(S1-S2) IF(ABS(TDGC-TWS).GT.1.0E-2) GO TO 291 TWS=(TMAX+TMIN)*0.5 IF(ABS(TDGC-TWS).GT.1.0E-2) TDGC=TWS C 291 IF(TDGC.LT.TMIN.OR.TDGC.GT.TMAX) GO TO 27 GO TO 28 C C 30 TEMPC=TDGC VM3K=VX H=G02J15(VX,TDGC) RETURN 31 TEMPC=TMAX VM3K=TMAX H=TMAX RETURN 32 TEMPC=TMIN VM3K=TMIN H=TMIN RETURN 40 TEMPC=-1.0E20 VM3K=-1.0E20 H=-1.0E20 RETURN 50 TEMPC=-1.0E10 VM3K=-1.0E10 H=-1.0E10 RETURN END C 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