C ********** R502 ******** C ********** VER. 11.1.********* 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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(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 S99J02(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT REAL FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99J02(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 DATA FUN/'AJTPT'/ CALL S99J02(FUN) AJTPT=-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 502'/, 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 = F2J02(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 502'/, 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 = F3J02(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 502'/, 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 = F4J02(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 502'/, 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 = F5J02(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 502'/, 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 = F6J02(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 502'/, 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 C--- FUNCTION CALL --- FF = F7J02(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 502'/, 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 = F8J02(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 502'/, 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 = F9J02(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 502'/, 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 --- FF = F10J02(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,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'AMUPD'/ 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 = F11J02(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 --- AMUPD=FF RETURN END C------------------------------------------------- F12 = AMUPDD REAL FUNCTION AMUPDD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'AMUPDD'/ 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 = F12J02(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 --- AMUPDD=FF RETURN END C------------------------------------------------- F13 = AMUPT REAL FUNCTION AMUPT(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 502'/, FUN/'AMUPT'/ 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 = F13J02(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 --- AMUPT=FF RETURN END C------------------------------------------------- F14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'AMUTD'/ 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 = F14J02(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 --- AMUTD=FF RETURN END C------------------------------------------------- F15 = AMUTDD REAL FUNCTION AMUTDD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'AMUTDD'/ 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 = F15J02(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 --- AMUTDD=FF RETURN END C------------------------------------------------- F92 = BPPT FUNCTION BPPT(P,T) CHARACTER FUN*6 DATA FUN/'BPPT'/ CALL S99J02(FUN) BPPT=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 DATA FUN/'BSPT'/ CALL S99J02(FUN) BSPT=-1.0E+30 RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 DATA FUN/'BTPT'/ CALL S99J02(FUN) BTPT=-1.0E+30 RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 DATA FUN/'BVPT'/ CALL S99J02(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 502'/, 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 = F16J02(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 502'/, 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 = F17J02(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 502'/, 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 = F18J02(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 502'/, 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 = F19J02(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 502'/, 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 = F20J02(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,MSG*125,A*1 REAL T0K,PBAR,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, 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 = F21J02(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------------------------------------------------- F22 = EPSPT REAL FUNCTION EPSPT(P,T) CHARACTER FUN*6 DATA FUN/'EPSPT'/ CALL S99J02(FUN) EPSPT=-1.0E+30 RETURN END C------------------------------------------------- F89 = FC C************************************************ C FUNCTION FOR FUNDDAMENTAL CONSTANTS C PROPATH VER.7.1, MAY 8, 1990 C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='111.6' WHEN A='M' C B='74.577' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=111.6 ELSE IF (A.EQ.'R') THEN FC=74.577 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR R 502 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 S99J02(FUN) GAMPDD=-1.0E+30 RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 DATA FUN/'GAMPT'/ CALL S99J02(FUN) GAMPT=-1.0E+30 RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 DATA FUN/'GAMTDD'/ CALL S99J02(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 502'/, 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 = F23J02(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 502'/, 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 = F24J02(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------------------------------------------------- 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 502'/, 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 = F25J02(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 502'/, 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 = F26J02(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 502'/, 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 = F27J02(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 502'/, 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 = F28J02(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 502'/, 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 = F29J02(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='REFRIGERANT 502' WHEN A='S' C B='CHCLF2+C2CLF5' 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='REFRIGERANT 502' ELSE IF (A.EQ.'C') THEN IDENTF='CHCLF2+C2CLF5' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR R 502 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 S99J02(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT REAL FUNCTION PMLT(T) CHARACTER FUN*6 DATA FUN/'PMLT'/ CALL S99J02(FUN) PMLT=-1.0E+30 RETURN END C------------------------------------------------- F85 = PRPD REAL FUNCTION PRPD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'PRPD'/ 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 = F85J02(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 --- PRPD=FF RETURN END C------------------------------------------------- F86 = PRPDD REAL FUNCTION PRPDD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'PRPDD'/ 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 = F86J02(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 --- PRPDD=FF RETURN END C------------------------------------------------- F81 = PRPT REAL FUNCTION PRPT(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 502'/, FUN/'PRPT'/ 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 = F81J02(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 --- PRPT=FF RETURN END C------------------------------------------------- F87 = PRTD REAL FUNCTION PRTD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'PRTD'/ 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 = F87J02(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 --- PRTD=FF RETURN END C------------------------------------------------- F88 = PRTDD REAL FUNCTION PRTDD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'PRTDD'/ 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 = F88J02(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 --- PRTDD=FF RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99J02(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 502'/, 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 = F30J02(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 S99J02(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD REAL FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99J02(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 502'/, 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 = F31J02(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 502'/, 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 = F32J02(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 502'/, 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 = F33J02(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 502'/, 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 = F34J02(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 502'/, 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 = F35J02(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 502'/, 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 = F36J02(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 502'/, 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 = F37J02(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 502'/, 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 = F38J02(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 502'/, 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 = F39J02(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 S99J02(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP REAL FUNCTION TMLP(P) CHARACTER FUN*6 DATA FUN/'TMLP'/ CALL S99J02(FUN) TMLP=-1.0E+30 RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 DATA FUN/'TPSEUP'/ CALL S99J02(FUN) TPSEUP=-1.0E+30 RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99J02(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 502'/, 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 = F40J02(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 502'/, 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 S99J02(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD REAL FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99J02(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 502'/, 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 = F42J02(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 502'/, 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 = F43J02(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------------------------------------------------- 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 502'/, 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 = F44J02(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 502'/, 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 = F45J02(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 502'/, 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 = F46J02(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 502'/, 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 = F47J02(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 502'/, 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 = F48J02(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 502'/, 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 = F49J02(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 502'/, 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 = F50J02(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------------------------------------------------- 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 502'/, 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 = F51J02(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 502'/, 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 = F52J02(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 502'/, 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 = F53J02(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 502'/, 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 = F54J02(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 502'/, 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 = F55J02(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,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'WPT'/ 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 = F83J02(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 --- WPT=FF 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 502'/, 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 = F56J02(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 502'/, 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 = F57J02(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 502'/, 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 = F58J02(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 502'/, 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 = F59J02(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 502'/, 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 = F60J02(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 502'/, 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 = F61J02(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 502'/, 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 = F62J02(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 502'/, 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 = F63J02(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------------------------------------------------- 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 502'/, 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 = F64J02(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 502'/, 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 = F65J02(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 502'/, 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 = F70J02(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------------------------------------------------- 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 502'/, 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 = F71J02(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------------------------------------------------- F82 = AKPT REAL FUNCTION AKPT(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 502'/, FUN/'AKPT'/ 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 = F82J02(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 --- AKPT=FF RETURN END C------------------------------------------------- F76 = CVPDD REAL FUNCTION CVPDD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'CVPDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F76J02(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 --- CVPDD=FF RETURN END C------------------------------------------------- F77 = CVPT REAL FUNCTION CVPT(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 502'/, FUN/'CVPT'/ C--- SET OF UNIT --- IF(KPA.EQ.1) THEN PBAR=1.0 T0K=0.0 ELSE IF(KPA.EQ.2) THEN PBAR=1.0 T0K=273.15 ELSE IF(KPA.EQ.3) THEN PBAR=1.0E-05 T0K=0.0 ELSE PBAR=1.0E-05 T0K=273.15 END IF PI=P*PBAR TI=T-T0K C--- FUNCTION CALL --- FF = F77J02(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 --- CVPT=FF RETURN END C------------------------------------------------- F78 = CVTDD REAL FUNCTION CVTDD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 502'/, FUN/'CVTDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F78J02(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 --- CVTDD=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 502'/, 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 = F79J02(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------------------------------------------------- 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 502'/, 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 = F80J02(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 ********** ********* C ********** R502 ******** C ********** VER. 7.1.********* C C 82 FUNCTION F82J02(PBAR,TDGC) DATA PC/4.065E1/ C BAR WA=F83J02(PBAR,TDGC) VM3K=F51J02(PBAR,TDGC) IF(PBAR.GT.PC*0.99999) GO TO 10 PSAT=F30J02(TDGC) IF(ABS(PSAT/PBAR-1.0).GT.1.0E-5) GO TO 10 VM3K=F54J02(TDGC) 10 DXIN=WA*WA/(PBAR*VM3K*1.0E5) F82J02=DXIN RETURN END C 2 ****** FUNCTION F2J02(PBAR) IF(ABS(PBAR-40.65).GT.0.004) GO TO 10 A=0.0 GO TO 30 10 W=F40J02(PBAR) TK=W+273.15 IF(TK.LT.200.0.OR.TK.GT.355.37) GO TO 20 A=F3J02(W) GO TO 30 20 A=-1.0E20 30 F2J02=A RETURN END C 3 ****** FUNCTION F3J02(TDGC) DOUBLE PRECISION A,G0,SIGMA,RD,RDD DATA G0/9.80665D2/ TK=TDGC+273.15 IF(ABS(TK-355.37).LT.0.02) GO TO 10 IF(TK.LT.200.0.OR.TK.GT.355.37) GO TO 20 W=F53J02(TDGC) IF(W.LT.1.0E-5) GO TO 30 RD=1.0D0/DBLE(W) W=F54J02(TDGC) IF(W.LT.1.0E-5) GO TO 30 RDD=1.0D0/DBLE(W) W=G20J02(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 F3J02=A RETURN END C G20 &&&&& FUNCTION G20J02(TK) DOUBLE PRECISION TR,SIGMA,WK IF(ABS(TK-355.37).LT.0.001) GO TO 10 IF(TK.LT.200.0.OR.TK.GT.355.37) GO TO 20 TR=DBLE(TK)/3.5537D2 WK=1.0D0-TR SIGMA=5.423D1*WK**1.263D0 G20J02=SIGMA*1.0D-3 RETURN 10 G20J02=0.0 RETURN 20 G20J02=-1.0E20 RETURN END C 4 ****** FUNCTION F4J02(PBAR) ALH=F24J02(PBAR) IF(ALH.LT.-1.0E9) GO TO 10 HD=F23J02(PBAR) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F4J02=ALH RETURN 20 F4J02=HD RETURN END C 5 ****** FUNCTION F5J02(TDGC) ALH=F28J02(TDGC) IF(ALH.LT.-1.0E9) GO TO 10 HD=F27J02(TDGC) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F5J02=ALH RETURN 20 F5J02=HD RETURN END C 6 ******* FUNCTION F6J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 ALAMBD=F9J02(TDGC) F6J02=ALAMBD RETURN 10 F6J02=TDGC RETURN END C 7 ******* FUNCTION F7J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 ALAMBD=F10J02(TDGC) F7J02=ALAMBD RETURN 10 F7J02=TDGC RETURN END C 8 ****** FUNCTION F8J02(PBAR,TDGC) DOUBLE PRECISION ALAM1,TK,RELDP RELDP=DBLE(PBAR/1.01325) TK=DBLE(TDGC)+2.7315D2 IF(TK.LT.2.2999D2.OR.TK.GT.4.3401D2) GO TO 20 ALAM1=(2.02943D-5*TK+5.41665D-2)*TK-6.6710D0 F8J02=ALAM1*1.0D-3 RETURN 20 F8J02=-1.0E20 RETURN END C 9 ******* FUNCTION F9J02(TDGC) DOUBLE PRECISION ALAMD,TK C LAMBDA (SAT. LIQ.) TK=DBLE(TDGC)+2.7315D2 IF(TK.LT.1.3999D2.OR.TK.GT.2.9801D2) GO TO 20 ALAMD=-3.86873D-1*TK+1.802798D2 F9J02=ALAMD*1.0D-3 RETURN 20 F9J02=-1.0E20 RETURN END C 10 ******* FUNCTION F10J02(TDGC) DOUBLE PRECISION ALAMDD,TK C LAMBDA (SAT. VAP.) TK=DBLE(TDGC+273.15) IF(TK.LT.2.2999D2.OR.TK.GT.3.4801D2) GO TO 20 C 230 K 232 K SHOWN IN THE ORIGANAL TEXT TABLE I.9.2 (P.97) C IF(TK.GT.3.23D2) GO TO 10 ALAMDD=6.8993D-2*TK-8.9940D0 GO TO 15 10 ALAMDD=((6.64498D-4*TK-6.648336D-1)*TK+2.217577D2)*TK ALAMDD=ALAMDD-2.464548D4 15 F10J02=ALAMDD*1.0D-3 RETURN 20 F10J02=-1.0E20 RETURN END C G11 &&&&&& FUNCTION G11J02(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL RO,T,G11J02 DIMENSION CFMUR(9) DATA CFMUR/0.0D0,4.65472D-2,-1.16797D-5,-8.90508D-2,4.46167D-4, 1-5.16951D-7,3.49920D-4,-1.61430D-6,2.20661D-9/ ROW=DBLE(RO) TK=DBLE(T) YYTA=0.0D0 ROI=1.0D0/ROW K=0 DO 15 I=1,3 ROI=ROI*ROW TJ=1.0D0/TK YTW=0.0D0 DO 11 J=1,3 TJ=TJ*TK K=K+1 YTW=YTW+CFMUR(K)*TJ 11 CONTINUE YYTA=YYTA+YTW*ROI 15 CONTINUE G11J02=YYTA*1.0D-6 RETURN END C 11 ******* FUNCTION F11J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.E9) GO TO 10 AMU=F14J02(TDGC) F11J02=AMU RETURN 10 F11J02=TDGC RETURN END C 12 ******* FUNCTION F12J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.E9) GO TO 10 TK=TDGC+273.15 VM3KG=F51J02(PBAR,TDGC) IF(VM3KG.LT.1.0E-4) GO TO 20 RO=1.0/VM3KG AMU=G11J02(RO,TK) F12J02=AMU RETURN 10 F12J02=TDGC RETURN 20 F12J02=VM3KG RETURN END C 13 ******* FUNCTION F13J02(PBAR,TDGC) IF(PBAR.LT.0.999999) GO TO 50 VW=F51J02(PBAR,TDGC) IF(VW.LT.-1.0E9) GO TO 40 IF(PBAR.LT.40.650001) GO TO 5 IF(VW.GT.0.002859) GO TO 11 GO TO 50 C 5 IF(ABS(PBAR-1.01325).LT.1.0E-6) GO TO 6 VPDD=F50J02(PBAR) IF(VPDD.LT.-1.0E9) GO TO 42 RELDV=VW/VPDD IF(DABS(RELDV-1.0D0).LT.1.0E-5) GO TO 10 IF(VW.LT.VPDD) GO TO 50 GO TO 10 C C PBAR=1.01325 BAR 6 TK=TDGC+273.15 AMU=(4.58808E-2-9.53395D-6*TK)*TK F13J02=AMU*1.0E-6 RETURN 10 IF(VW.LT.1.0/300.0) GO TO 50 11 TK=TDGC+273.15 IF(TK.LT.273.15.OR.TK.GT.398.15) GO TO 50 AMU=G11J02(1.0/VW,TK) F13J02=AMU RETURN C 30 AMU=F14J02(TDGC) F13J02=AMU RETURN 40 F13J02=VW RETURN 42 F13J02=VPDD RETURN 50 F13J02=-1.0E20 RETURN END C 14 ****** FUNCTION F14J02(TDGC) DOUBLE PRECISION AMUD,TK TK=DBLE(TDGC+273.15) IF(TK.GT.2.009999D2.OR.TK.LT.2.850001D2) GO TO 10 F14J02=-1.0E20 RETURN 10 AMUD=(3.16501D-5*TK-2.72827D-2)*TK+1.05234D1 AMUD=DEXP(AMUD) F14J02=AMUD*1.0D-6 RETURN END C 15 ******* FUNCTION F15J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.E9) GO TO 10 TK=TDGC+273.15 VM3KG=F53J02(TDGC) IF(VM3KG.LT.1.0E-4) GO TO 20 RO=1.0/VM3KG AMU=G11J02(RO,TK) F15J02=AMU RETURN 10 F15J02=TDGC RETURN 20 F15J02=VM3KG RETURN END C 16 ****** FUNCTION F16J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPD=F19J02(TDGC) F16J02=CPD RETURN 10 F16J02=TDGC RETURN END C 17 ****** FUNCTION F17J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPDD=F20J02(TDGC) F17J02=CPDD RETURN 10 F17J02=TDGC RETURN END C 18 ******* FUNCTION F18J02(PBAR,TDGC) DOUBLE PRECISION TC,ROC,PC,Y,TR,ROR,CPA DATA TC,ROC,PC/3.5537D2,5.67D2,4.065D0/ C K KG/M3 MPA T=TDGC+273.15 IF(T.LT.167.5.OR.T.GT.500.0) GO TO 50 IF(PBAR.LT.0.002.OR.PBAR.GT.100.0) GO TO 50 3 TR=DBLE(T)/TC VV=F51J02(PBAR,TDGC) IF(VV.LT.-1.0E9) GO TO 20 RO=1.0/VV ROR=DBLE(RO)/ROC IF(DABS(TR-1.0D0).LT.1.0D-5.AND.DABS(ROR-1.0D0).LT.1.0D-5) 1 GO TO 30 C CRITICAL POINT CP=1.0E10 IF(PBAR.GT.40.65.OR.T.GT.355.37) GO TO 5 C VTDD=F54J02(TDGC) IF(VTDD.LT.-1.0E9) GO TO 40 IF(VV/VTDD-1.0.GT.-5.0E-5) GO TO 5 IF(T.LT.329.999) GO TO 50 VTD=F53J02(TDGC) IF(VV/VTD-1.0.GT.-1.0E-5) GO TO 50 C 5 Y=DBLE(G08J02(VV,TDGC)) C CPA=DBLE(G07J02(VV,TDGC)) Y=Y+CPA F18J02=SNGL(Y*PC/(TC*ROC)*1.0D6) RETURN 20 F18J02=VV RETURN 30 F18J02=1.0E10 RETURN 40 F18J02=VTDD RETURN 50 F18J02=-1.0E20 RETURN END C G7 &&&&&& FUNCTION G07J02(VM3K,TDGC) C C CP(V,T) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3K,TDGC,G07J02 REAL RO,T,CPW DIMENSION AR(7),BR(7),CR(7),ER(4) C DATA AR/7.00083D0,-8.4490192D0,2.7838077D0,5.500207905D0, 1-3.54810721D0,6.24758598D-1,-1.9789556D-2/ DATA BR/-1.104119D1,1.05650367D1,2.5313958D0,-1.652132976D1, 11.107131744D1,-2.821550135D0,2.52512482D-1/ DATA CR/-5.55836D-1,2.85596416D1,-5.174825476D0,1.445791284D1, 1-7.402277416D0,1.330733107D0,-8.15263720D-2/ DATA ER/-5.9691904D1,-1.213201446D1,-4.97649D-1,1.853733D-1/ DATA A,B/3.69666D0,3.0917597D-1/ DATA TC,ROC/3.5537D2,5.67D2/ C DATA TC,ROC,PC/3.5537D2,5.67D2,4.065D0/ C K KG/M3 MPA C T=TDGC+273.15 TR=DBLE(T)/TC RO=1.0/VM3K ROR=DBLE(RO)/ROC IF(DABS(TR-1.0D0).LT.1.0D-5.AND.DABS(ROR-1.0D0).LT.1.0D-5) 1 GO TO 50 C TRM2=1.0D0/(TR*TR) TRM3=TRM2/TR ROR2=ROR*ROR ROR3=ROR2*ROR ROR4=ROR2*ROR2 ROR5=ROR3*ROR2 BROR2=B*ROR2 EBROR2=DEXP(-BROR2) RORI=ROR Y1=A*ROR DO 10 I=1,3 RORI=RORI*ROR Y1=Y1+I*(AR(I)-2*CR(I)*TRM3)*RORI 10 CONTINUE Y1P=0.0D0 Y1M=0.0D0 I=4 RORI=RORI*ROR Y1P=Y1P+I*AR(I)*RORI Y1M=Y1M-I*2*CR(I)*TRM3*RORI I=5 RORI=RORI*ROR Y1P=Y1P-I*2*CR(I)*TRM3*RORI Y1M=Y1M+I*AR(I)*RORI I=6 RORI=RORI*ROR Y1P=Y1P+I*AR(I)*RORI Y1M=Y1M-I*2*CR(I)*TRM3*RORI I=7 RORI=RORI*ROR Y1P=Y1P-I*2*CR(I)*TRM3*RORI Y1M=Y1M+I*AR(I)*RORI Y1=Y1P+Y1M+Y1 Y1=Y1-2*TRM3*(1.0D0+BROR2)*EBROR2*(ER(1)+ER(2)*ROR2)*ROR3 Y1=Y1+TR*ROR5*(8*ER(3)+10*ER(4)*ROR) C RORI=1.0D0 Y2P=A*TR Y2M=0.0D0 I=1 RORI=RORI*ROR Y2P=Y2P+2*AR(I)*TR*RORI Y2M=Y2M+2*(BR(I)+CR(I)*TRM2)*RORI I=2 RORI=RORI*ROR Y2P=Y2P+I*(I+1)*(BR(I)+CR(I)*TRM2)*RORI Y2M=Y2M+I*(I+1)*AR(I)*TR*RORI I=3 RORI=RORI*ROR Y2P=Y2P+I*(I+1)*(AR(I)*TR+BR(I))*RORI Y2M=Y2M+I*(I+1)*CR(I)*TRM2*RORI I=4 RORI=RORI*ROR Y2P=Y2P+I*(I+1)*(AR(I)*TR+CR(I)*TRM2)*RORI Y2M=Y2M+I*(I+1)*BR(I)*RORI I=5 RORI=RORI*ROR Y2P=Y2P+I*(I+1)*BR(I)*RORI Y2M=Y2M+I*(I+1)*(AR(I)*TR+CR(I)*TRM2)*RORI I=6 RORI=RORI*ROR Y2P=Y2P+I*(I+1)*(AR(I)*TR+CR(I)*TRM2)*RORI Y2M=Y2M+I*(I+1)*BR(I)*RORI I=7 RORI=RORI*ROR Y2P=Y2P+I*(I+1)*BR(I)*RORI Y2M=Y2M+I*(I+1)*(AR(I)*TR+CR(I)*TRM2)*RORI Y2=Y2P+Y2M Y2=Y2-ER(1)*TRM2*EBROR2*((2*BROR2-3.0D0)*BROR2-3.0D0)*ROR2 Y2=Y2-ER(2)*TRM2*EBROR2*((2*BROR2-5.0D0)*BROR2-5.0D0)*ROR4 Y2=Y2+(20*ER(3)+30*ER(4)*ROR)*TR*TR*ROR4 IF(DABS(Y2).LT.1.0D-5) GO TO 50 CPW=TR*Y1*Y1/(Y2*ROR2) G07J02=CPW RETURN 50 G07J02=1.0E10 RETURN END C G8 &&&&&& FUNCTION G08J02(VM3K,TDGC) C C CV(V,T) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3K,TDGC,G08J02 REAL RO,T,CVW DIMENSION CR(7),ER(4) C DIMENSION AR(7),BR(7),CR(7),ER(4) C C DATA AR/7.00083D0,-8.4490192D0,2.7838077D0,5.500207905D0, C 1-3.54810721D0,6.24758598D-1,-1.9789556D-2/ C DATA BR/-1.104119D1,1.05650367D1,2.5313958D0,-1.652132976D1, C 11.107131744D1,-2.821550135D0,2.52512482D-1/ DATA CR/-5.55836D-1,2.85596416D1,-5.174825476D0,1.445791284D1, 1-7.402277416D0,1.330733107D0,-8.15263720D-2/ DATA ER/-5.9691904D1,-1.213201446D1,-4.97649D-1,1.853733D-1/ C DATA A20,A30,A40,A50,A60,A70/-1.6246D-2,-3.592994163D1, DATA A20,A40,A50,A60,A70/-1.6246D-2, 1-1.989147D1,1.99419D0,-1.00075D-1,-4.2376D0/ DATA B/3.0917597D-1/ C DATA A,B/3.69666D0,3.0917597D-1/ DATA TC,ROC/3.5537D2,5.67D2/ C DATA TC,ROC,PC/3.5537D2,5.67D2,4.065D0/ C K KG/M3 MPA C T=DBLE(TDGC)+2.7315D2 RO=1.0/VM3K TR=DBLE(T)/TC ROR=DBLE(RO)/ROC Y=-2.0D0*A20/(TR*TR)-A70-((2.0D0*A60*TR+A50)*3.0D0*TR+A40) 1*2.0D0*TR TRM3=1.0D0/(TR*TR*TR) RORI=1.0D0/ROR YP=0.0D0 YM=0.0D0 ROR2=ROR*ROR DO 10 I=1,7,2 RORI=RORI*ROR2 10 YM=YM-6.0D0*CR(I)*RORI*TRM3 RORI=1.0D0 DO 11 I=2,6,2 RORI=RORI*ROR2 11 YP=YP-6.0D0*CR(I)*RORI*TRM3 Y=YP+YM+Y BROR2=B*ROR2 BROR4=BROR2*ROR*ROR EBROR2=DEXP(-BROR2) Y1=2.0D0-(2.0D0+BROR2)*EBROR2 Y2=3.0D0/B-(3.0D0/B+3.0D0*ROR*ROR+BROR4)*EBROR2 Y=Y-3.0D0*TRM3*(ER(1)*Y1+ER(2)*Y2)/B ROR4=BROR4/B CVW=Y-2.0D0*TR*ROR4*(ER(3)+ER(4)*ROR) G08J02=CVW RETURN END FUNCTION G09J02(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3K,TDGC,G09J02 REAL RO,T,CPW DIMENSION AR(7),BR(7),CR(7),ER(4) C DATA AR/7.00083D0,-8.4490192D0,2.7838077D0,5.500207905D0, 1-3.54810721D0,6.24758598D-1,-1.9789556D-2/ DATA BR/-1.104119D1,1.05650367D1,2.5313958D0,-1.652132976D1, 11.107131744D1,-2.821550135D0,2.52512482D-1/ DATA CR/-5.55836D-1,2.85596416D1,-5.174825476D0,1.445791284D1, 1-7.402277416D0,1.330733107D0,-8.15263720D-2/ DATA ER/-5.9691904D1,-1.213201446D1,-4.97649D-1,1.853733D-1/ DATA A,B/3.69666D0,3.0917597D-1/ DATA TC,ROC/3.5537D2,5.67D2/ C DATA TC,ROC,PC/3.5537D2,5.67D2,4.065D0/ C K KG/M3 MPA C T=TDGC+273.15 TR=DBLE(T)/TC RO=1.0/VM3K ROR=DBLE(RO)/ROC IF(DABS(TR-1.0D0).LT.1.0D-5.AND.DABS(ROR-1.0D0).LT.1.0D-5) 1 GO TO 50 C TRM2=1.0D0/(TR*TR) TRM3=TRM2/TR ROR2=ROR*ROR ROR3=ROR2*ROR ROR4=ROR2*ROR2 ROR5=ROR3*ROR2 BROR2=B*ROR2 EBROR2=DEXP(-BROR2) RORI=ROR Y1=A*ROR DO 10 I=1,7 RORI=RORI*ROR Y1=Y1+I*(AR(I)-2*CR(I)*TRM3)*RORI 10 CONTINUE Y1=Y1-2*TRM3*(1.0D0+BROR2)*EBROR2*(ER(1)+ER(2)*ROR2)*ROR3 Y1=Y1+TR*ROR5*(8*ER(3)+10*ER(4)*ROR) C RORI=1.0D0 Y2=A*TR DO 20 I=1,7 RORI=RORI*ROR Y2=Y2+I*(I+1)*(AR(I)*TR+BR(I)+CR(I)*TRM2)*RORI 20 CONTINUE Y2=Y2-ER(1)*TRM2*EBROR2*((2*BROR2-3.0D0)*BROR2-3.0D0)*ROR2 Y2=Y2-ER(2)*TRM2*EBROR2*((2*BROR2-5.0D0)*BROR2-5.0D0)*ROR4 Y2=Y2+(20*ER(3)+30*ER(4)*ROR)*TR*TR*ROR4 C IF(DABS(Y2).LT.1.0D-5) GO TO 50 CPW=TR*Y1*Y1/(Y2*ROR2) G09J02=CPW RETURN 50 G09J02=1.0E10 RETURN END C 19 ******* FUNCTION F19J02(TDGC) DOUBLE PRECISION TC,ROC,PC DATA TC,ROC,PC/3.5537D2,5.67D2,4.065D0/ C K KG/M3 MPA C C CP SAT. LIQUID(TEMP) C VTD=F53J02(TDGC) IF(VTD.LT.-1.0E9) GO TO 20 CVW=G08J02(VTD,TDGC) CP=CVW+G09J02(VTD,TDGC) F19J02=DBLE(CP)*PC/(TC*ROC)*1.0D6 RETURN 20 F19J02=VTD RETURN END C 20 ******* FUNCTION F20J02(TDGC) DOUBLE PRECISION TC,ROC,PC DATA TC,ROC,PC/3.5537D2,5.67D2,4.065D0/ C K KG/M3 MPA C C CP SAT.VAPOR(TEMP) C VTDD=F54J02(TDGC) IF(VTDD.LT.-1.0E9) GO TO 20 CVW=G08J02(VTDD,TDGC) CP=CVW+G09J02(VTDD,TDGC) F20J02=DBLE(CP)*PC/(TC*ROC)*1.0D6 RETURN 20 F20J02=VTDD RETURN END C 21 ******** FUNCTION F21J02(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 F21J02=40.65 RETURN 20 F21J02=82.22 RETURN 30 F21J02=1.764E-3 RETURN 40 F21J02=0.3259E6 RETURN 50 F21J02=1.383E3 RETURN 60 F21J02=-1.0E20 RETURN END C 76 ******* FUNCTION F76J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 20 CVDD=F78J02(TDGC) F76J02=CVDD RETURN 20 F76J02=-1.0E20 RETURN END C 77 ******* FUNCTION F77J02(PBAR,TDGC) C C CV C DOUBLE PRECISION TC,ROC,PC DATA TC,ROC,PC/3.5537D2,5.67D2,4.065D0/ C K KG/M3 MPA C T=TDGC+273.15 IF(T.LT.167.5.OR.T.GT.500.0) GO TO 50 IF(PBAR.LT.0.002.OR.PBAR.GT.100.0) GO TO 50 VV=F51J02(PBAR,TDGC) IF(VV.LT.-1.0E9) GO TO 20 C IF(PBAR.GT.40.65.OR.T.GT.355.37) GO TO 5 C VTDD=F54J02(TDGC) IF(VTDD.LT.-1.0E9) GO TO 40 IF(VV/VTDD-1.0.GT.-5.0E-5) GO TO 5 IF(T.LT.329.999) GO TO 50 VTD=F53J02(TDGC) IF(VV/VTD-1.0.GT.-1.0E-5) GO TO 50 C 5 CV=G08J02(VV,TDGC) F77J02=DBLE(CV)*PC/(TC*ROC)*1.0D6 RETURN C 20 F77J02=VV RETURN 40 F77J02=VTDD RETURN 50 F77J02=-1.0E20 RETURN END C 78 ******* FUNCTION F78J02(TDGC) DOUBLE PRECISION TC,ROC,PC DATA TC,ROC,PC/3.5537D2,5.67D2,4.065D0/ C K KG/M3 MPA C C CV SAT.VAPOR(TEMP) C VTDD=F54J02(TDGC) IF(VTDD.LT.-1.0E9) GO TO 20 CVDD=G08J02(VTDD,TDGC) F78J02=DBLE(CVDD)*PC/(TC*ROC)*1.0D6 RETURN 20 F78J02=VTDD RETURN END C 23 ****** FUNCTION F23J02(PBAR) C IF(PBAR.LT.0.024998.OR.PBAR.GT.40.6501) GO TO 20 C TSDGC=F40J02(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F27J02(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F23J02=H RETURN 15 F23J02=TSDGC RETURN 16 F23J02=H RETURN 20 F23J02=-1.0E20 RETURN END C 24 ****** FUNCTION F24J02(PBAR) C IF(PBAR.LT.0.024998.OR.PBAR.GT.40.6501) GO TO 20 C TSDGC=F40J02(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F28J02(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F24J02=H RETURN 15 F24J02=TSDGC RETURN 16 F24J02=H RETURN 20 F24J02=-1.0E20 RETURN END C 71 ******* FUNCTION F71J02(PBAR,S) C C H(P,S) C CALL S01J02(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.355.37) GO TO 10 PSAT=F30J02(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 10 STDD=F38J02(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 10 STD=F37J02(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=F28J02(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 HTD=F27J02(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 H=HTD*(1.0-X)+HTDD*X 10 F71J02=H RETURN 11 F71J02=PSAT RETURN 12 F71J02=STDD RETURN 13 F71J02=STD RETURN 14 F71J02=HTDD RETURN 15 F71J02=HTD RETURN 20 F71J02=TDGC RETURN 30 F71J02=-1.0E20 RETURN END C 25 ****** FUNCTION F25J02(PBAR,TDGC) DATA TC,VC/355.37,1.764E-3/ C IF(PBAR.LT.0.02.OR.PBAR.GT.100.001) GO TO 20 IF(TDGC+273.15.LT.167.5.OR.TDGC+273.15.GT.500.01) GO TO 20 C VM3K=F51J02(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-TC.GT.-273.15) GO TO 10 VTD=F53J02(TDGC) IF((VM3K-VTD)/VC.GT.1.0E-5) GO TO 10 H=G02J02(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J02=H RETURN 10 H=G02J02(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J02=H RETURN 15 F25J02=VM3K RETURN 16 F25J02=H RETURN 20 F25J02=-1.0E20 RETURN END C 26 ******* FUNCTION F26J02(PBAR,X) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 H=F29J02(TDGC,X) F26J02=H RETURN 10 F26J02=TDGC RETURN END C 27 ****** FUNCTION F27J02(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F27J02,TDGC,F51J02,G01J02,G02J02,F53J02,VTD,PST,VTDD,HTDD, 1 F30J02 C DATA PC,TC/4.065D1,3.5537D2/ C BAR K IF(TDGC+273.15.LT.167.5.OR.TDGC+273.15.GT.355.371) GO TO 20 C VTD=F53J02(TDGC) IF(VTD.LT.-1.0E9) GO TO 17 PST=G01J02(VTD,TDGC) VTDD=F51J02(PST,TDGC) HTDD=G02J02(VTDD,TDGC) IF(HTDD.LT.-1.0E9) GO TO 15 PSR=DBLE(PST)/PC TK=DBLE(TDGC)+2.7315D2 TR=TK/TC VRDD=DBLE(VTDD) VRD=DBLE(VTD) PSBAR=F30J02(TDGC) IF(PSBAR.LT.-1.0E9) GO TO 18 PRS=DBLE(PSBAR)/PC C DPSDT TR1=1.0D0-TR DRODTR=6.9388D0 DRODTR=DRODTR+2.9519D0*(1.0D0+1.5D0*TR)*TR1**1.5D0 DRODTR=DRODTR-2.0029D0*(1.0D0+7.0D-1*TR)*TR1**7.0D-1 DRODTR=DRODTR*PRS/(TR*TR) DPSDT=PC/TC*DRODTR*1.0E5 C HW=DBLE(HTDD) H=HW-TK*(VRDD-VRD)*DPSDT F27J02=H RETURN 15 F27J02=HTDD RETURN 16 F27J02=VTDD RETURN 17 F27J02=VTD RETURN 18 F27J02=PSBAR RETURN 20 F27J02=-1.0E20 RETURN END C 28 ****** FUNCTION F28J02(TDGC) C IF(TDGC+273.15.LT.167.5.OR.TDGC+273.15.GT.355.37) GO TO 20 C VD=F53J02(TDGC) PST=G01J02(VD,TDGC) VDD=F51J02(PST,TDGC) HDD=G02J02(VDD,TDGC) F28J02=HDD RETURN 15 F28J02=VDD RETURN 20 F28J02=-1.0E20 RETURN END C 29 ****** FUNCTION F29J02(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 HTD=F27J02(TDGC) IF(HTD.LT.-1.0E9) GO TO 20 HTDD=F28J02(TDGC) IF(HTDD.LT.-1.0E9) GO TO 10 F29J02=(1.0-X)*HTD+X*HTDD RETURN 10 F29J02=HTDD RETURN 20 F29J02=HTD RETURN 30 F29J02=-1.0E20 RETURN END C 84 *************** FUNCTION F84J02(C) CHARACTER C,F84J02 IF(C.EQ.'C') GO TO 10 IF(C.EQ.'S') GO TO 20 IF(C.EQ.'V') GO TO 30 GO TO 60 10 F84J02='CHCLF2+C2CLF5' RETURN 20 F84J02='REFRIGERANT 502' RETURN 30 F84J02='7.1' RETURN 60 F84J02='** NO C S V **' RETURN END C 85 ****** FUNCTION F85J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 F85J02=F87J02(TDGC) RETURN 10 F85J02=TDGC RETURN END C 86 ****** FUNCTION F86J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 F86J02=F88J02(TDGC) RETURN 10 F86J02=TDGC RETURN END C 81 ****** FUNCTION F81J02(PBAR,TDGC) DOUBLE PRECISION ALAM1,TK,RELDP,Y1,CP1 RELDP=DBLE(PBAR/1.01325) TK=DBLE(TDGC)+2.7315D2 IF(TK.LT.2.2999D2.OR.TK.GT.4.3401D2) GO TO 20 ALAM1=(2.02943D-5*TK+5.41665D-2)*TK-6.6710D0 Y1=(4.58808D-2-9.53395D-6*TK)*TK CP1=1.04172D1/TK+1.41143D-1 RELDP=(2.10579D-3-1.33633D-6*TK)*TK CP1=CP1+RELDP F81J02=Y1*CP1/ALAM1 RETURN 20 F81J02=-1.0E20 RETURN END C 87 ****** FUNCTION F87J02(TDGC) AMUTD=F14J02(TDGC) IF(AMUTD.LT.0.0) GO TO 10 CPTD=F19J02(TDGC) IF(CPTD.LT.0.0) GO TO 20 ALMTD=F9J02(TDGC) IF(ALMTD.LT.0.0) GO TO 30 F87J02=AMUTD*CPTD/ALMTD RETURN 10 F87J02=AMUTD RETURN 20 F87J02=CPTD RETURN 30 F87J02=ALMTD RETURN END C 88 ****** FUNCTION F88J02(TDGC) AMUTDD=F15J02(TDGC) IF(AMUTDD.LT.0.0) GO TO 10 CPTDD=F27J02(TDGC) IF(CPTDD.LT.0.0) GO TO 20 ALMTDD=F10J02(TDGC) IF(ALMTDD.LT.0.0) GO TO 30 F88J02=AMUTDD*CPTDD/ALMTDD RETURN 10 F88J02=AMUTDD RETURN 20 F88J02=CPTDD RETURN 30 F88J02=ALMTDD RETURN END C 30 ****** FUNCTION F30J02(TDGC) C PS(T) SAT. PRESS (BAR) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F30J02,TDGC,TK TK=TDGC+273.15 IF(ABS(TK-355.37).LT.0.001) GO TO 10 IF(TK.LT.167.5.OR.TK.GT.355.37) GO TO 20 TR=DBLE(TK)/3.5537D2 TRI1=1.0D0-TR PRW=-6.93880D0*TRI1+2.0029D0*TRI1**1.7D0-2.9519D0*TRI1**2.5D0 PRW=PRW/TR PRS=DEXP(PRW) IF(PRS.GT.1.0D0) PRS=1.0D0 F30J02=PRS*4.065D1 RETURN 10 F30J02=4.065D1 RETURN 20 F30J02=-1.0E20 RETURN END C 31 ******* FUNCTION F31J02(PBAR) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 SIGMA=F32J02(TDGC) F31J02=SIGMA RETURN 10 F31J02=TDGC RETURN END C 32 ******* FUNCTION F32J02(TDGC) DOUBLE PRECISION TR,SIGMA,WK,TK TK=DBLE(TDGC)+2.7315D2 IF(DABS(TK-355.37).LT.0.001) GO TO 10 IF(TK.LT.200.0.OR.TK.GT.355.37) GO TO 20 TR=DBLE(TK)/3.5537D2 WK=1.0D0-TR SIGMA=5.423D1*WK**1.263D0 F32J02=SIGMA*1.0D-3 RETURN 10 F32J02=0.0 RETURN 20 F32J02=-1.0E20 RETURN END C 33 ****** FUNCTION F33J02(PBAR) C IF(PBAR.LT.0.02.OR.PBAR.GT.40.6501) GO TO 20 C TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F37J02(TDGC) IF(S.LT.-1.0E9) GO TO 16 F33J02=S RETURN 15 F33J02=TDGC RETURN 16 F33J02=S RETURN 20 F33J02=-1.0E20 RETURN END C 34 ****** FUNCTION F34J02(PBAR) C IF(PBAR.LT.0.02.OR.PBAR.GT.40.6501) GO TO 20 C TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F38J02(TDGC) IF(S.LT.-1.0E9) GO TO 16 F34J02=S RETURN 15 F34J02=TDGC RETURN 16 F34J02=S RETURN 20 F34J02=-1.0E20 RETURN END C 35 ****** FUNCTION F35J02(PBAR,TDGC) DATA TC,VC/355.37,1.764E-3/ C IF(PBAR.LT.0.02.OR.PBAR.GT.100.001) GO TO 20 IF(TDGC+273.15.LT.167.5.OR.TDGC+273.15.GT.500.01) GO TO 20 C VM3K=F51J02(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-TC.GT.-273.15) GO TO 10 VTD=F53J02(TDGC) IF((VM3K-VTD)/VC.GT.1.0E-5) GO TO 10 S=G05J02(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J02=S RETURN 10 S=G05J02(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J02=S RETURN 15 F35J02=VM3K RETURN 16 F35J02=S RETURN 20 F35J02=-1.0E20 RETURN END C 36 ******* FUNCTION F36J02(PBAR,X) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 S=F39J02(TDGC,X) F36J02=S RETURN 10 F36J02=TDGC RETURN END C 37 ****** FUNCTION F37J02(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F37J02,TDGC,F51J02,G01J02,G05J02,F53J02,VTD,PST,VTDD,STDD C DATA PC,TC/4.065D1,3.5537D2/ C BAR K IF(TDGC+273.15.LT.167.5.OR.TDGC+273.15.GT.355.37) GO TO 20 C VTD=F53J02(TDGC) IF(VTD.LT.-1.0E9) GO TO 17 PST=G01J02(VTD,TDGC) VTDD=F51J02(PST,TDGC) STDD=G05J02(VTDD,TDGC) IF(STDD.LT.-1.0E9) GO TO 15 PSR=DBLE(PST)/PC TK=DBLE(TDGC)+2.7315D2 TR=TK/TC VRDD=DBLE(VTDD) VRD=DBLE(VTD) C PRS=DBLE(PST)/PC C DPSDT TR1=1.0D0-TR DRODTR=6.9388D0 DRODTR=DRODTR+2.9519D0*(1.0D0+1.5D0*TR)*TR1**1.5D0 DRODTR=DRODTR-2.0029D0*(1.0D0+7.0D-1*TR)*TR1**7.0D-1 DRODTR=DRODTR*PRS/(TR*TR) DPSDT=PC/TC*DRODTR*1.0E5 C SW=DBLE(STDD) S=SW-(VRDD-VRD)*DPSDT F37J02=S RETURN 15 F37J02=STDD RETURN 16 F37J02=VTDD RETURN 17 F37J02=VTD RETURN 20 F37J02=-1.0E20 RETURN END C 38 ****** FUNCTION F38J02(TDGC) C IF(TDGC+273.15.LT.167.5.OR.TDGC+273.15.GT.355.37) GO TO 20 C VD=F53J02(TDGC) IF(VD.LT.-1.0E9) GO TO 15 PST=G01J02(VD,TDGC) VDD=F51J02(PST,TDGC) SDD=G05J02(VDD,TDGC) F38J02=SDD RETURN 15 F38J02=VD RETURN 20 F38J02=-1.0E20 RETURN END C 39 ******* FUNCTION F39J02(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 STD=F37J02(TDGC) IF(STD.LT.-1.0E9) GO TO 20 STDD=F38J02(TDGC) IF(STDD.LT.-1.0E9) GO TO 10 F39J02=(1.0-X)*STD+X*STDD RETURN 10 F39J02=STDD RETURN 20 F39J02=STD RETURN 30 F39J02=-1.0E20 RETURN END C G2 &&&&&& FUNCTION G02J02(VM3K,TDGC) C C H(V,T) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G02J02,VM3K,TDGC,VV,F53J02 DIMENSION AR(7),BR(7),CR(7),ER(4),AI0R(7) C DATA AR/7.00083D0,-8.4490192D0,2.7838077D0,5.500207905D0, 1-3.54810721D0,6.24758598D-1,-1.9789556D-2/ DATA BR/-1.104119D1,1.05650367D1,2.5313958D0,-1.652132976D1, 11.107131744D1,-2.821550135D0,2.52512482D-1/ DATA CR/-5.55836D-1,2.85596416D1,-5.174825476D0,1.445791284D1, 1-7.402277416D0,1.330733107D0,-8.15263720D-2/ DATA ER/-5.9691904D1,-1.213201446D1,-4.97649D-1,1.853733D-1/ DATA A,B/3.69666D0,3.0917597D-1/ DATA TC,ROC,PC,HC/3.5537D2,5.67D2,4.065D1,3.259D5/ C *************** (K) (KG/M3) (BAR) (J/KG)************* C DATA AI0R/3.352597554D1,-1.6246D-2,-3.592994163D1,-1.989147D1, 11.99419D0,-1.00075D-1,-4.2376D0/ C IF(VM3K.LT.0.000599.OR.VM3K.GT.18.65) GO TO 20 RO=1.0D0/DBLE(VM3K) TK=DBLE(TDGC)+2.7315D2 IF(TK.LT.1.65D2.OR.TK.GT.5.0001D2) GO TO 20 IF(DABS(TK-TC).LT.2.0D-3.AND.DABS(RO-ROC).LT.2.0D-1) GO TO 30 IF(TK.GT.TC) GO TO 5 IF(RO.LT.ROC) GO TO 5 IF(TK.LT.3.29999D0) GO TO 20 VV=F53J02(TDGC) IF(VV.LT.-1.0E19) GO TO 19 IF((VM3K-VV)/VV.LT.-1.0E-5) GO TO 5 C G02J02=F27J02(TDGC) RETURN C 5 V=DBLE(VM3K) RORW=1.0D0/(V*ROC) TK=DBLE(TDGC)+2.7315D2 TRW=TK/TC C TR2=TRW*TRW TRM2=1.0D0/TR2 TR3=TR2*TRW TRM3=1.0D0/TR3 ROR2=RORW*RORW BR2=B*ROR2 EBROR2=DEXP(-BR2) ROR4=ROR2*ROR2 HRW=AI0R(1)+2*AI0R(2)/TRW-(AI0R(4)+2*AI0R(5)*TRW+ 13*AI0R(6)*TR2)*TR2-AI0R(7)*TRW HRW=HRW+A*TRW HRP=0.0D0 HRM=0.0D0 RORI=1.0D0 I=1 RORI=RORI*RORW HRP=HRP+AR(I)*TRW*RORI HRM=HRM+((I+1)*BR(I)+(I+3)*CR(I)*TRM2)*RORI I=2 RORI=RORI*RORW HRP=HRP+((I+1)*BR(I)+(I+3)*CR(I)*TRM2)*RORI HRM=HRM+I*AR(I)*TRW*RORI I=3 RORI=RORI*RORW HRP=HRP+(I*AR(I)*TRW+(I+1)*BR(I))*RORI HRM=HRM+(I+3)*CR(I)*TRM2*RORI I=4 RORI=RORI*RORW HRP=HRP+(I*AR(I)*TRW+(I+3)*CR(I)*TRM2)*RORI HRM=HRM+(I+1)*BR(I)*RORI I=5 RORI=RORI*RORW HRP=HRP+(I+1)*BR(I)*RORI HRM=HRM+(I*AR(I)*TRW+(I+3)*CR(I)*TRM2)*RORI I=6 RORI=RORI*RORW HRP=HRP+(I*AR(I)*TRW+(I+3)*CR(I)*TRM2)*RORI HRM=HRM+(I+1)*BR(I)*RORI I=7 RORI=RORI*RORW HRW=HRW+(I+1)*BR(I)*RORI HRM=HRM+(I*AR(I)*TRW+(I+3)*CR(I)*TRM2)*RORI 10 CONTINUE Y1=3.0D0/B+EBROR2*(ROR2*(1.0D0+BR2)-3*(2.0D0+BR2)/(2*B)) Y2=9.0D0/(2*B*B)+EBROR2*(ROR4*(1.0D0+BR2)-3*(3.0D0/B+3*ROR2+ 1B*ROR4)/(2*B)) HRW=HRW+HRP+HRM+(ER(1)*Y1+ER(2)*Y2)*TRM2 HRW=HRW+(3*ER(3)+4*ER(4)*RORW)*ROR4*TR2 C G02J02=HRW*PC/ROC*1.0D5 RETURN 19 G02J02=VV RETURN 20 G02J02=-1.0E20 RETURN 30 G02J02=HC RETURN END C 5 &&&&&&& FUNCTION G05J02(VM3K,TDGC) C C S(V,T) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G05J02,VM3K,TDGC,VV,F53J02 DIMENSION AR(7), CR(7),ER(4),AI0R(7) C DIMENSION AR(7),BR(7),CR(7),ER(4),AI0R(7) C DATA AR/7.00083D0,-8.4490192D0,2.7838077D0,5.500207905D0, 1-3.54810721D0,6.24758598D-1,-1.9789556D-2/ C DATA BR/-1.104119D1,1.05650367D1,2.5313958D0,-1.652132976D1, C 11.107131744D1,-2.821550135D0,2.52512482D-1/ DATA CR/-5.55836D-1,2.85596416D1,-5.174825476D0,1.445791284D1, 1-7.402277416D0,1.330733107D0,-8.15263720D-2/ DATA ER/-5.9691904D1,-1.213201446D1,-4.97649D-1,1.853733D-1/ DATA A,B/3.69666D0,3.0917597D-1/ DATA TC,ROC,PC,SC/3.5537D2,5.67D2,4.065D1,1.383D3/ C *************** (K) (KG/M3) (BAR) (J/KG K) ********* C DATA AI0R/3.352597554D1,-1.6246D-2,-3.592994163D1,-1.989147D1, 11.99419D0,-1.00075D-1,-4.2376D0/ C IF(VM3K.LT.0.000599.OR.VM3K.GT.18.65) GO TO 20 RO=1.0D0/DBLE(VM3K) TK=DBLE(TDGC)+2.7315D2 IF(TK.LT.1.65D2.OR.TK.GT.5.0001D2) GO TO 20 IF(DABS(TK-TC).LT.2.0D-3.AND.DABS(RO-ROC).LT.2.0D-1) GO TO 30 IF(TK.GT.TC) GO TO 5 IF(RO.LT.ROC) GO TO 5 IF(TK.LT.3.29999D0) GO TO 20 VV=F53J02(TDGC) IF(VV.LT.-1.0E19) GO TO 19 IF((VM3K-VV)/VV.LT.-1.0E-5) GO TO 5 C G05J02=F37J02(TDGC) RETURN C 5 V=DBLE(VM3K) RORW=1.0D0/(V*ROC) TK=DBLE(TDGC)+2.7315D2 TRW=TK/TC C TR2=TRW*TRW TRM2=1.0D0/TR2 TR3=TR2*TRW TRM3=1.0D0/TR3 ROR2=RORW*RORW BR2=B*ROR2 EBROR2=DEXP(-BR2) ROR4=ROR2*ROR2 SRW=-(AI0R(3)+AI0R(7))+AI0R(2)*TRM2-2.0D0*AI0R(4)*TRW SRW=SRW-3.0D0*AI0R(5)*TR2-4.0D0*AI0R(6)*TR3-AI0R(7)*DLOG(TRW) SRW=SRW-A*DLOG(RORW) RORI=1.0D0 DO 10 I=1,3 RORI=RORI*RORW SRW=SRW-(AR(I)-2.0D0*CR(I)*TRM3)*RORI 10 CONTINUE SRP=0.0D0 SRM=0.0D0 I=4 RORI=RORI*RORW SRP=SRP+2.0D0*CR(I)*TRM3*RORI SRM=SRM-AR(I)*RORI I=5 RORI=RORI*RORW SRP=SRP-AR(I)*RORI SRM=SRM+2.0D0*CR(I)*TRM3*RORI I=6 RORI=RORI*RORW SRP=SRP+2.0D0*CR(I)*TRM3*RORI SRM=SRM-AR(I)*RORI I=7 RORI=RORI*RORW SRP=SRP-AR(I)*RORI SRM=SRM+2.0D0*CR(I)*TRM3*RORI SRW=SRW+SRP+SRM CF=-((2.0D0+BR2)*EBROR2-2.0D0)/B SRW=SRW+ER(1)*TRM3*CF CF=-(((1.0D0/B+ROR2)*3.0D0+B*ROR4)*EBROR2-3.0D0/B) SRW=SRW+ER(2)*TRM3*CF/B SRW=SRW-2.0D0*(ER(3)+ER(4)*RORW)*ROR4*TRW C SY=SRW*PC/(TC*ROC)*1.0E5 C G05J02=SY RETURN 19 G05J02=VV RETURN 20 G05J02=-1.0E20 RETURN 30 G05J02=SC RETURN END C 64 ******* FUNCTION F64J02(PBAR0,H) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F64J02,TDGC,HW,TMAX,TMIN,HDP,HDDP,HX,H1,H2,TSP,VX,TWH REAL PBAR0,H,G02J02,F40J02,F51J02 REAL F53J02,F54J02,TLC,TCC,VDP,VDDP,VDPMAX,VCM3K REAL F27J02,G21J02 C DATA PCBAR,TCK,ROCKM3,HC/4.065D1,3.5537D2,5.67D2,3.2591D5/ C C G02(V,T)=H VAPOR AND LIQUID C (T.LT.TC AND V.LT.VC) C IF(PBAR0.LT.0.02.OR.PBAR0.GT.100.001) GO TO 40 TLC=330.1-273.15 IF(H.LT.1.05E5.OR.H.GT.5.32E5) GO TO 40 IF(ABS(PBAR0-40.65).GT.0.006) GO TO 5 IF(ABS(H-SNGL(HC)).GT.60.0) GO TO 5 C CRITICAL PRES. ERROR =0.006(BAR) C CRITICAL SPC. H ERROR=0.0006E5(J/KG) TDGC=355.37-273.15 GO TO 30 C 5 VCM3K=1.0/SNGL(ROCKM3) IF(PBAR0/SNGL(PCBAR)-1.0.GT.-1.0E-6) THEN GO TO 8 END IF TDGC=F40J02(PBAR0) TSP=TDGC C IF(TDGC.LT.-102.15) GO TO 40 C -102.15=169.0-273.15 HDP=F27J02(TDGC) IF(HDP.LT.1.0E-5) GO TO 50 IF(H/HDP-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=F53J02(TMAX) TSP=(TMAX-TLC)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J02(TDGC) HDP=G02J02(VDP,TDGC) IF(HDP.LT.H) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J02(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.1.0E-4) VX=VDP HX=G02J02(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 C DO 71 I=1,50 TDGC=TMIN+I*TSP VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 71 HX=G02J02(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(VX.GT.VDPMAX) GO TO 72 IF(HX.GT.H) GO TO 72 71 CONTINUE 72 TMAX=TDGC ICASE=1 C GO TO 15 C 8 IF(H.GT.HC) THEN GO TO 12 END IF VDP=F53J02(TLC) HDP=G02J02(VDP,TLC) IF(HDP.LT.H) THEN GO TO 9 END IF ICASE=2 C C TMIN=TLC C**************** IF(PBAR0.LT.60.0) THEN TMIN=TLC ELSE IF (PBAR0.LT.100.0) THEN TMIN=4.25*(PBAR0-60.0)+330.0-273.15 ELSE TMIN=5.4*(PBAR0-100.0)+330.0-273.15 END IF C END IF C****************** TMAX=460.0-273.15 VX=F51J02(PBAR0,TMIN) IF(VX.LT.1.0E-4.OR.VX.GT.10.0) THEN GO TO 81 END IF C C HX=G02J02(VX,TMIN) C**************** IF(TMIN+273.15.LT.TCK) THEN HX=G02J02(VX,TMIN) ELSE HX=G02J02(VX,TMIN) END IF C***************** IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 32 IF(HX.GT.H) THEN C**************** IF(TMIN.LT.330.001-273.15) THEN TDGC=330.0 VX=F51J02(PBAR0,TDGC) HX=G02J02(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) GO TO 40 TLC=TDGC END IF END IF TDGC=SNGL(TCK)-273.15 VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) THEN GO TO 81 END IF HX=G02J02(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) THEN C TMAX=TDGC C TMIN=TLC GO TO 81 ELSE TMIN=TDGC TMAX=460.0-273.15 GO TO 14 END IF C 81 TWH=(TCK-TLC-273.15)/70.0 TMAX=TCK-273.15 TMIN=TLC-273.15 ICOUNT=0 85 IMARK=1 DO 82 I=1,71 TDGC=TMAX-(I-1)*TWH VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 82 IF(VX.GT.10.0) GO TO 82 HX=G02J02(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.LT.3.0E2) GO TO 82 IF(IMARK.EQ.1) THEN H2=HX IMARK=2 ELSE H1=H2 H2=HX IF(H2.LT.3.0E2) GO TO 82 IF(H2.GT.2.5E3) GO TO 82 IF(H1.LT.3.0E2) GO TO 82 IF(H1.GT.2.5E3) GO TO 82 IF((H1-H)*(H2-H).LT.0.0) GO TO 83 END IF 82 CONTINUE ICOUNT=ICOUNT+1 IF(ICOUNT.GT.5) GO TO 50 TDGC=TMIN VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 IF(VX.GT.10.0) GO TO 50 HX=G02J02(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) GO TO 50 83 TMAX=TDGC+TWH TMIN=TDGC TWH=(TMAX-TMIN)/50.0 GO TO 85 C 9 TSP=(SNGL(TCK)-TLC-273.15)/50.0 DO 10 I=1,50 TDGC=TLC+I*TSP VDP=F53J02(TDGC) HDP=G02J02(VDP,TDGC) IF(HDP.GT.H) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J02(PBAR0,TMIN) IF(VX.LT.1.0E-4.OR.VX.GT.VCM3K) THEN TCC=SNGL(TCK)-273.15 TSP=TSP*2.0 ICASE=2 DO 712 I=1,201 TDGC=TMIN+(I-1)*TSP IF(TDGC+273.15.GT.460.0) GO TO 716 VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN HX=G02J02(VX,TDGC) ELSE HX=G02J02(VX,TDGC) END IF IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) THEN TMAX=TDGC TMIN=TDGC-TSP GO TO 15 END IF 712 CONTINUE 716 GO TO 50 END IF C HX=G02J02(VX,TMIN) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 32 IF(HX.GT.H) THEN TMAX=TMIN C DO 711 I=1,50 TDGC=TMAX-I*TSP VX=F51J02(PBAR0,TDGC) HX=G02J02(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.LT.H) GO TO 713 711 CONTINUE GO TO 50 C 713 ICASE=2 TMIN=TDGC 714 GO TO 15 END IF C C TMAX SET TDGC=SNGL(TCK)-273.15 VX=F51J02(PBAR0,TDGC) HX=G02J02(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) THEN TMAX=TDGC ELSE TMAX=460.0-273.15 TMIN=TDGC END IF ICASE=2 GO TO 15 C 12 TMAX=460.0-273.15 TCC=SNGL(TCK)-273.15 IF(PBAR0.LT.60.0) THEN TMIN=TCC ELSE IF(PBAR0.LT.100.0) THEN TMIN=0.425*(PBAR0-60.0) +330.0-273.15 IF(TMIN.LT.TCC) TMIN=TCC ELSE TMIN=0.54*(PBAR0-100.0) +373.0-273.15 END IF TDGC=(TMIN+TMAX)*0.5 VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 HX=G02J02(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) THEN TMAX=TDGC ELSE TMIN=TDGC END IF ICASE=3 GO TO 14 C 13 VDDP=F54J02(TDGC) IF(VDDP.LT.1.0E-4) GO TO 50 HDDP=G02J02(VDDP,TDGC) IF(H/HDDP-1.0.LT.1.0E-6) GO TO 30 C ADAAA **************************** IF(H.GT.HC) THEN TMIN=TDGC TMAX=460.0-273.15 ICASE=4 GO TO 15 ELSE C ADAAA **************************** TMAX=TDGC TMIN=332.9-273.15 VX=F51J02(PBAR0,TMIN) IF(VX.LT.1.0E-4) THEN TMIN=330.0-273.15 VX=F51J02(PBAR0,TMIN) IF(VX.LT.1.0E-4) GO TO 40 END IF HX=G02J02(VX,TMIN) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 32 IF(HX.GT.H) GO TO 40 TWH=(TMAX-TMIN)/50.0 H2=HX DO 131 I=1,50 H1=H2 TDGC=TMIN+I*TWH VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.E-4) GO TO 131 H2=G02J02(VX,TDGC) IF(H2.GT.H) GO TO 132 131 CONTINUE 132 TMAX=TDGC TMIN=TDGC-TWH 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=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 141 IF(VX.GT.10.0) GO TO 141 HX=G02J02(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.LT.3.0E2) GO TO 141 IF(HX.GT.H) GO TO 142 141 CONTINUE 142 TMAX=TDGC TMIN=TDGC-TWH 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=F51J02(PBAR0,TMIN) H1=G21J02(VX,TMIN,TCC,ICASE,VDPMAX) VX=F51J02(PBAR0,TMAX) H2=G21J02(VX,TMAX,TCC,ICASE,VDPMAX) 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 IF(ABS((H1-H)/(H2-H)).GT.0.05) THEN GO TO 20 END IF IF(ABS(H1/H-1.0).GT.0.05) THEN GO TO 18 END IF TDGC=(TMIN+273.15)*1.003-273.15 VX=F51J02(PBAR0,TDGC) HX=G21J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(HX.LT.H) GO TO 18 H2=HX TMAX=TDGC IF(H-H1.GT.300.0) GO TO 19 TMIN=TMIN-0.0002 DO 16 I=1,999 TDGC=TMIN+0.0001*I VX=F51J02(PBAR0,TDGC) HX=G21J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(HX.GT.H) GO TO 17 16 CONTINUE TMIN=TMIN+0.0002 GO TO 19 17 TMIN=TMIN+0.0001*(I-1) VX=F51J02(PBAR0,TMIN) H1=G21J02(VX,TMIN,TCC,ICASE,VDPMAX) IF(ABS(H1-H).LT.ABS(HX-H)) TDGC=TMIN GO TO 30 C 18 HW=(TMIN+273.15)*ABS(H1-H) TDGC=TMIN+HW IF(TDGC.GT.TMAX) GO TO 19 VX=F51J02(PBAR0,TDGC) HX=G21J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(HX.GT.H) THEN TMAX=TDGC H2=HX ELSE TMAX=TMAX END IF 19 IF(H1.LT.H) GO TO 26 H2=H1 TMAX=TMIN IF(ICASE.NE.3) THEN TDGC=TMIN-0.01 ELSE TDGC=TMIN-HW END IF VX=F51J02(PBAR0,TDGC) HX=G21J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(HX.GT.H) GO TO 40 C OUT OF RANGE H1=HX TMIN=TDGC GO TO 26 C 20 IF(ABS((H1-H)/(H2-H)).LT.15.0) GO TO 25 IF(ABS(H2/H-1.0).GT.0.05) GO TO 23 TDGC=(TMIN+273.15)*0.997-273.15 VX=F51J02(PBAR0,TDGC) HX=G21J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(HX.GT.H) GO TO 23 H1=HX TMIN=TDGC IF(H2-H.GT.0.03) GO TO 24 TMAX=TMAX+0.0002 DO 21 I=1,999 TDGC=TMAX-0.0001*I VX=F51J02(PBAR0,TDGC) HX=G21J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(HX.LT.H) GO TO 22 21 CONTINUE TMAX=TMAX-0.0002 GO TO 24 22 TMAX=TMAX-0.0001*(I-1) VX=F51J02(PBAR0,TMAX) H2=G21J02(VX,TMAX,TCC,ICASE,VDPMAX) IF(ABS(H2-H).LT.ABS(HX-H)) TDGC=TMAX GO TO 30 C 23 HW=(TMAX+273.15)*ABS(H2-H) TDGC=TMAX-HW IF(TDGC.LT.TMIN) GO TO 24 VX=F51J02(PBAR0,TDGC) HX=G21J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(HX.LT.H) THEN TMIN=TDGC H1=HX ELSE TMIN=TMIN END IF 24 IF(H2.GT.H) GO TO 26 H1=H2 TMIN=TMAX IF(ICASE.GT.1) THEN TDGC=TMAX+0.01 ELSE TDGC=TMAX+HW END IF VX=F51J02(PBAR0,TDGC) HX=G21J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(HX.LT.H) GO TO 40 C OUT OF RANGE TMAX=TDGC H2=HX GO TO 26 C 25 IF((H1-H)*(H2-H).GT.0.0) GO TO 50 26 IC=0 27 TDGC=(TMIN+TMAX)*0.5 28 VX=F51J02(PBAR0,TDGC) HW=G21J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(ABS(HW/H-1.0).LT.1.0E-6) GO TO 30 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 GO TO 30 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) TDGC=TWH C 291 IF(TDGC.LT.TMIN.OR.TDGC.GT.TMAX) GO TO 27 GO TO 28 C C 30 F64J02=TDGC RETURN 31 F64J02=TMAX RETURN 32 F64J02=TMIN RETURN 40 F64J02=-1.0E20 RETURN 50 F64J02=-1.0E10 RETURN END C G31 FUNCTION G21J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(ICASE.GT.2) GO TO 10 IF(ICASE.EQ.2) GO TO 5 C C ICASE=1 IF(VX.LT.1.0E-4.OR.VX.GT.VDPMAX) VX=F53J02(TDGC) GO TO 30 C C ICASE=2 5 IF(TDGC.LT.TCC) GO TO 30 10 G21J02=G02J02(VX,TDGC) RETURN 30 G21J02=G02J02(VX,TDGC) RETURN END C S01 ******* SUBROUTINE S01J02(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,G02J02,G05J02,F40J02,F51J02 REAL F53J02,F54J02,TLC,TCC,VDP,VDDP,VDPMAX,VCM3K REAL F37J02,G31J02,VM3K,TEMPC,H C DATA SC/1.383D3/ DATA PCBAR,TCK,ROCKM3/4.065D1,3.5537D2,5.67D2/ C C IF(PBAR0.LT.0.02.OR.PBAR0.GT.100.001) GO TO 40 C IF(VM3K.LT.5.0E-4.OR.VM3K.GT.13.0) GO TO 40 TLC=330.1-273.15 IF(S.LT.5.0E2.OR.S.GT.2.5E3) GO TO 40 IF(ABS(PBAR0-40.65).GT.0.006) GO TO 5 IF(ABS(S-SNGL(SC)).GT.60.0) GO TO 5 C CRITICAL PRES. ERROR =0.006(BAR) C CRITICAL SPC. S ERROR=0.0006E5(J/KG) TDGC=355.37-273.15 VX=1.764E-3 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=F40J02(PBAR0) TSP=TDGC C IF(TDGC.LT.-102.15) GO TO 40 C -102.15=169.0-273.15 C SDP=F37J02(TDGC) IF(SDP.LT.1.0E-5) 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=F53J02(TMAX) TSP=(TMAX-TLC)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J02(TDGC) SDP=G05J02(VDP,TDGC) IF(SDP.LT.S) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J02(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.1.0E-4) VX=VDP SX=G05J02(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=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 71 SX=G05J02(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 C GO TO 15 C 8 IF(S.GT.SC) THEN GO TO 12 END IF VDP=F53J02(TLC) SDP=G05J02(VDP,TLC) IF(SDP.LT.S) THEN GO TO 9 END IF ICASE=2 C TMIN=TLC TMAX=500.0-273.15 VX=F51J02(PBAR0,TMIN) IF(VX.LT.1.0E-4.OR.VX.GT.10.0) THEN GO TO 81 END IF C C SX=G05J02(VX,TMIN) C**************** IF(TMIN+273.15.LT.TCK) THEN SX=G05J02(VX,TMIN) END IF C***************** IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 IF(SX.GT.S) THEN C**************** IF(TMIN.LT.330.001-273.15) THEN TDGC=330.0 VX=F51J02(PBAR0,TDGC) SX=G05J02(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) GO TO 40 TLC=TDGC END IF END IF TDGC=SNGL(TCK)-273.15 VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) THEN GO TO 81 END IF SX=G05J02(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN C TMAX=TDGC C TMIN=TLC GO TO 81 ELSE TMIN=TDGC TMAX=460.0-273.15 GO TO 14 END IF C 81 TWS=(TCK-TLC-273.15)/70.0 TMAX=TCK-273.15 TMIN=TLC-273.15 ICOUNT=0 85 IMARK=1 DO 82 I=1,71 TDGC=TMAX-(I-1)*TWS VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 82 IF(VX.GT.13.5) GO TO 82 SX=G05J02(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.LT.3.0E2) GO TO 82 IF(IMARK.EQ.1) THEN S2=SX IMARK=2 ELSE S1=S2 S2=SX IF(S2.LT.3.0E2) GO TO 82 IF(S2.GT.2.5E3) GO TO 82 IF(S1.LT.3.0E2) GO TO 82 IF(S1.GT.2.5E3) GO TO 82 IF((S1-S)*(S2-S).LT.0.0) GO TO 83 END IF 82 CONTINUE ICOUNT=ICOUNT+1 IF(ICOUNT.GT.5) GO TO 50 TDGC=TMIN VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 IF(VX.GT.13.5) GO TO 50 SX=G05J02(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) GO TO 50 83 TMAX=TDGC+TWS TMIN=TDGC TWS=(TMAX-TMIN)/50.0 GO TO 85 C 9 TSP=(SNGL(TCK)-TLC-273.15)/50.0 DO 10 I=1,50 TDGC=TLC+I*TSP VDP=F53J02(TDGC) SDP=G05J02(VDP,TDGC) IF(SDP.GT.S) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J02(PBAR0,TMIN) IF(VX.LT.1.0E-4.OR.VX.GT.VCM3K) THEN TCC=SNGL(TCK)-273.15 TSP=TSP*2.0 ICASE=2 DO 712 I=1,201 TDGC=TMIN+(I-1)*TSP IF(TDGC+273.15.GT.460.0) GO TO 716 VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN SX=G05J02(VX,TDGC) ELSE SX=G05J02(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 15 END IF 712 CONTINUE 716 GO TO 50 END IF C SX=G05J02(VX,TMIN) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 IF(SX.GT.S) THEN TMAX=TMIN C DO 711 I=1,50 TDGC=TMAX-I*TSP VX=F51J02(PBAR0,TDGC) SX=G05J02(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.LT.S) GO TO 713 711 CONTINUE GO TO 50 C 713 ICASE=2 TMIN=TDGC 714 GO TO 15 END IF C C TMAX SET TDGC=SNGL(TCK)-273.15 VX=F51J02(PBAR0,TDGC) SX=G05J02(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN TMAX=TDGC ELSE TMAX=460.0-273.15 TMIN=TDGC END IF ICASE=2 GO TO 15 C 12 TMAX=460.0-273.15 TCC=SNGL(TCK)-273.15 IF(PBAR0.LT.60.0) THEN TMIN=TCC ELSE IF(PBAR0.LT.100.0) THEN TMIN=0.425*(PBAR0-60.0) +330.0-273.15 IF(TMIN.LT.TCC) TMIN=TCC ELSE TMIN=0.54*(PBAR0-100.0) +373.0-273.15 END IF TDGC=(TMIN+TMAX)*0.5 VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 SX=G05J02(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 14 C 13 VDDP=F54J02(TDGC) IF(VDDP.LT.1.0E-4) GO TO 50 SDDP=G05J02(VDDP,TDGC) IF(S/SDDP-1.0.LT.1.0E-6) THEN VX=VDDP GO TO 30 END IF C ADAAA **************************** IF(S.GT.SC) THEN TMIN=TDGC TMAX=460.0-273.15 ICASE=4 GO TO 15 ELSE C ADAAA **************************** TMAX=TDGC TMIN=332.9-273.15 VX=F51J02(PBAR0,TMIN) IF(VX.LT.1.0E-4) THEN TMIN=330.0-273.15 VX=F51J02(PBAR0,TMIN) IF(VX.LT.1.0E-4) GO TO 40 END IF SX=G05J02(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=F51J02(PBAR0,TDGC) IF(VX.LT.1.E-4) GO TO 131 S2=G05J02(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 14 TWS=(TMAX-TMIN)/50.0 DO 141 I=1,51 TDGC=TMIN+(I-1)*TWS VX=F51J02(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 141 IF(VX.GT.10.0) GO TO 141 SX=G05J02(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-TWS 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=F51J02(PBAR0,TMIN) S1=G31J02(VX,TMIN,TCC,ICASE,VDPMAX) VX=F51J02(PBAR0,TMAX) S2=G31J02(VX,TMAX,TCC,ICASE,VDPMAX) 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 IF(ABS((S1-S)/(S2-S)).GT.0.05) THEN GO TO 20 END IF IF(ABS(S1/S-1.0).GT.0.05) THEN GO TO 18 END IF TDGC=(TMIN+273.15)*1.003-273.15 VX=F51J02(PBAR0,TDGC) SX=G31J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(SX.LT.S) GO TO 18 S2=SX TMAX=TDGC IF(S-S1.GT.300.0) GO TO 19 TMIN=TMIN-0.0002 DO 16 I=1,999 TDGC=TMIN+0.0001*I VX=F51J02(PBAR0,TDGC) SX=G31J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(SX.GT.S) GO TO 17 16 CONTINUE TMIN=TMIN+0.0002 GO TO 19 17 TMIN=TMIN+0.0001*(I-1) VX=F51J02(PBAR0,TMIN) S1=G31J02(VX,TMIN,TCC,ICASE,VDPMAX) IF(ABS(S1-S).LT.ABS(SX-S)) TDGC=TMIN GO TO 30 C 18 SW=(TMIN+273.15)*ABS(S1-S) TDGC=TMIN+SW IF(TDGC.GT.TMAX) GO TO 19 VX=F51J02(PBAR0,TDGC) SX=G31J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(SX.GT.S) THEN TMAX=TDGC S2=SX ELSE TMAX=TMAX END IF 19 IF(S1.LT.S) GO TO 26 S2=S1 TMAX=TMIN IF(ICASE.NE.3) THEN TDGC=TMIN-0.01 ELSE TDGC=TMIN-SW END IF VX=F51J02(PBAR0,TDGC) SX=G31J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(SX.GT.S) GO TO 40 C OUT OF RANGE S1=SX TMIN=TDGC GO TO 26 C 20 IF(ABS((S1-S)/(S2-S)).LT.15.0) GO TO 25 IF(ABS(S2/S-1.0).GT.0.05) GO TO 23 TDGC=(TMIN+273.15)*0.997-273.15 VX=F51J02(PBAR0,TDGC) SX=G31J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(SX.GT.S) GO TO 23 S1=SX TMIN=TDGC IF(S2-S.GT.0.03) GO TO 24 TMAX=TMAX+0.0002 DO 21 I=1,999 TDGC=TMAX-0.0001*I VX=F51J02(PBAR0,TDGC) SX=G31J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(SX.LT.S) GO TO 22 21 CONTINUE TMAX=TMAX-0.0002 GO TO 24 22 TMAX=TMAX-0.0001*(I-1) VX=F51J02(PBAR0,TMAX) S2=G31J02(VX,TMAX,TCC,ICASE,VDPMAX) IF(ABS(S2-S).LT.ABS(SX-S)) TDGC=TMAX GO TO 30 C 23 SW=(TMAX+273.15)*ABS(S2-S) TDGC=TMAX-SW IF(TDGC.LT.TMIN) GO TO 24 VX=F51J02(PBAR0,TDGC) SX=G31J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(SX.LT.S) THEN TMIN=TDGC S1=SX ELSE TMIN=TMIN END IF 24 IF(S2.GT.S) GO TO 26 S1=S2 TMIN=TMAX IF(ICASE.GT.1) THEN TDGC=TMAX+0.01 ELSE TDGC=TMAX+SW END IF VX=F51J02(PBAR0,TDGC) SX=G31J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(SX.LT.S) GO TO 40 C OUT OF RANGE TMAX=TDGC S2=SX GO TO 26 C 25 IF((S1-S)*(S2-S).GT.0.0) GO TO 50 26 IC=0 27 TDGC=(TMIN+TMAX)*0.5 28 VX=F51J02(PBAR0,TDGC) SW=G31J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(ABS(SW/S-1.0).LT.1.0E-6) GO TO 30 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 VX=F51J02(PBAR0,TDGC) 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 IF(S.LT.SC.AND.TDGC.LT.TCC) THEN H=G02J02(VX,TDGC) ELSE H=G02J02(VX,TDGC) END IF 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 G31 FUNCTION G31J02(VX,TDGC,TCC,ICASE,VDPMAX) IF(ICASE.GT.2) GO TO 10 IF(ICASE.EQ.2) GO TO 5 C C ICASE=1 IF(VX.LT.1.0E-4.OR.VX.GT.VDPMAX) VX=F53J02(TDGC) GO TO 30 C C ICASE=2 5 IF(TDGC.LT.TCC) GO TO 30 10 G31J02=G05J02(VX,TDGC) RETURN 30 G31J02=G05J02(VX,TDGC) RETURN END C 65 FUNCTION F65J02(PBAR0,S) C C G05(V,T)=S VAPOR G06(V,T)=S LIQUID C S.GT.SC S.LT.SC C CALL S01J02(PBAR0,S,VM3K,TDGC,H) F65J02=TDGC RETURN END C 70 ******* FUNCTION F70J02(PBAR,VM3K) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F70J02,PBAR,TDGC,VM3K,PW,TMAX,TMIN,VDP,VDDP,PX,P1,P2,TSP REAL G01J02,F40J02,F53J02,F54J02,F30J02,PST330,VCM3K C DATA PCBAR,TCK,ROCKM3/4.065D1,3.5537D2,5.67D2/ C IF(PBAR.LT.0.02.OR.PBAR.GT.100.001) GO TO 40 IF(VM3K.LT.5.0E-4.OR.VM3K.GT.19.0) GO TO 40 IF(ABS(PBAR-40.65).GT.0.006) GO TO 5 VCM3K=1.0/ROCKM3 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=355.37-273.15 GO TO 30 C 5 IF(PBAR/PCBAR-1.0.GT.-1.0E-6) GO TO 6 TDGC=F40J02(PBAR) TSP=TDGC IF(TDGC.LT.-102.15) GO TO 40 C -102.15=169.0-273.15 C VDP=F53J02(TDGC) IF(VDP.LT.1.0E-5) GO TO 50 IF(VM3K/VDP-1.0.GT.-1.0E-5) GO TO 10 C ON SAT. LIQ LINE GO TO 10 C PST330=F30J02(330.0-273.15) IF(PBAR/PST330-1.0.LT.-1.0E-6) GO TO 40 C TMIN=330.0-273.15 TDGC=TMIN PX=G01J02(VM3K,TDGC) IF(ABS(PX/PBAR-1.0).LT.1.0E-6) GO TO 30 IF(PX.GT.PBAR) GO TO 40 TMAX=TSP ICASE=1 GO TO 15 C 6 IF(VM3K.GT.VCM3K) GO TO 7 TMIN=330.0-273.15 TMAX=500.0-273.15 PX=G01J02(VM3K,TMIN) IF(ABS(PX/PBAR-1.0).LT.1.0E-6) GO TO 30 IF(PX.GT.PBAR) GO TO 40 ICASE=2 GO TO 15 C 7 TMIN=TCK-273.15 TMAX=500.0-273.15 ICASE=3 GO TO 15 C 10 VDDP=F54J02(TDGC) IF(VDDP.LT.1.0E-4) GO TO 50 IF(VM3K/VDDP-1.0.LT.1.0E-5) GO TO 30 TMIN=TDGC TMAX=500.0-273.15 ICASE=4 C 15 IF(TMIN.GT.TMAX) THEN TDGC=TMIN TMIN=TMAX TMAX=TDGC ELSE TMIN=TMIN END IF P1=G01J02(VM3K,TMIN) P2=G01J02(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 IF(ABS((P1-PBAR)/(P2-PBAR)).GT.0.05) GO TO 20 IF(ABS(P1/PBAR-1.0).GT.0.05) GO TO 18 TDGC=(TMIN+273.15)*1.003-273.15 PX=G01J02(VM3K,TDGC) IF(PX.LT.PBAR) GO TO 18 P2=PX TMAX=TDGC IF(PBAR-P1.GT.0.03) GO TO 19 TMIN=TMIN-0.0002 DO 16 I=1,999 TDGC=TMIN+0.0001*I PX=G01J02(VM3K,TDGC) IF(PX.GT.PBAR) GO TO 17 16 CONTINUE TMIN=TMIN+0.0002 GO TO 19 17 TMIN=TMIN+0.0001*(I-1) P1=G01J02(VM3K,TMIN) IF(ABS(P1-PBAR).LT.ABS(PX-PBAR)) TDGC=TMIN GO TO 30 C 18 PW=(TMIN+273.15)*ABS(P1-PBAR) TDGC=TMIN+PW IF(TDGC.GT.TMAX) GO TO 19 PX=G01J02(VM3K,TDGC) IF(PX.GT.PBAR) THEN TMAX=TDGC P2=PX ELSE TMAX=TMAX END IF 19 IF(P1.LT.PBAR) GO TO 26 P2=P1 TMAX=TMIN IF(ICASE.NE.3) THEN TDGC=TMIN-0.01 ELSE TDGC=TMIN-PW END IF PX=G01J02(VM3K,TDGC) IF(PX.GT.PBAR) GO TO 40 C OUT OF RANGE P1=PX TMIN=TDGC GO TO 26 C 20 IF(ABS((P1-PBAR)/(P2-PBAR)).LT.15.0) GO TO 25 IF(ABS(P2/PBAR-1.0).GT.0.05) GO TO 23 TDGC=(TMIN+273.15)*0.997-273.15 PX=G01J02(VM3K,TDGC) IF(PX.GT.PBAR) GO TO 23 P1=PX TMIN=TDGC IF(P2-PBAR.GT.0.03) GO TO 24 TMAX=TMAX+0.0002 DO 21 I=1,999 TDGC=TMAX-0.0001*I PX=G01J02(VM3K,TDGC) IF(PX.LT.PBAR) GO TO 22 21 CONTINUE TMAX=TMAX-0.0002 GO TO 24 22 TMAX=TMAX-0.0001*(I-1) P2=G01J02(VM3K,TMAX) IF(ABS(P2-PBAR).LT.ABS(PX-PBAR)) TDGC=TMAX GO TO 30 C 23 PW=(TMAX+273.15)*ABS(P2-PBAR) TDGC=TMAX-PW IF(TDGC.LT.TMIN) GO TO 24 PX=G01J02(VM3K,TDGC) IF(PX.LT.PBAR) THEN TMIN=TDGC P1=PX ELSE TMIN=TMIN END IF 24 IF(P2.GT.PBAR) GO TO 26 P1=P2 TMIN=TMAX IF(ICASE.GT.1) THEN TDGC=TMAX+0.01 ELSE TDGC=TMAX+PW END IF PX=G01J02(VM3K,TDGC) IF(PX.LT.PBAR) GO TO 40 C OUT OF RANGE TMAX=TDGC P2=PX GO TO 26 C 25 IF((P1-PBAR)*(P2-PBAR).GT.0.0) GO TO 50 26 IC=0 27 TDGC=(TMIN+TMAX)*0.5 28 PW=G01J02(VM3K,TDGC) IF(ABS(PW/PBAR-1.0).LT.1.0E-6) GO TO 30 IC=IC+1 IF(IC.GT.999) GO TO 50 IF(ABS(P1/P2-1.0).GT.1.0E-5) GO TO 29 TDGC=(TMIN+TMAX)*0.5 GO TO 30 29 IF((P1-PBAR)*(PW-PBAR).GT.0.0) THEN P1=PW TMIN=TDGC ELSE P2=PW 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 TDGC=(TMAX+TMIN)*0.5+(TMIN-TMAX)*(PBAR-(P1+P2)*0.5)/(P1-P2) IF(TDGC.LT.TMIN.OR.TDGC.GT.TMAX) GO TO 27 GO TO 28 C 30 F70J02=TDGC RETURN 31 F70J02=TMAX RETURN 32 F70J02=TMIN RETURN 40 F70J02=-1.0E20 RETURN 50 F70J02=-1.0E10 RETURN END C 40 ******** FUNCTION F40J02(PBAR) DOUBLE PRECISION DRODTR C IF(PBAR.LT.0.02.OR.PBAR.GT.40.65005) GO TO 40 TMIN=167.5-273.15 TMAX=355.37-273.15 PRI=F30J02(TMIN) TDGC=TMIN IF(ABS(PRI-PBAR)/PBAR.LT.6.0E-6) GO TO 50 IF(PRI.LT.-1.0E9) GO TO 49 IF(PRI.GT.PBAR) GO TO 30 PRI=F30J02(TMAX) TDGC=TMAX IF(ABS(PRI-PBAR)/PBAR.LT.6.0E-6) GO TO 50 IF(PRI.LT.-1.0E9) GO TO 49 IF(PRI.LT.PBAR) GO TO 30 TDGC=(TMAX+TMIN)*0.5 C IC=0 4 IC=IC+1 TDGC=(TMAX+TMIN)*0.5 TR=(TDGC+273.15)/355.37 IF(IC.GT.15) GO TO 10 PRI=F30J02(TDGC) IF(ABS(PRI-PBAR)/PBAR.LT.1.0E-6) GO TO 50 IF(PRI.LT.-1.0E9) GO TO 49 IF(PRI.LT.PBAR) THEN TMIN=TDGC ELSE TMAX=TDGC END IF GO TO 4 C 10 PU=F30J02(TMAX) PL=F30J02(TMIN) 11 IC=IC+1 IF(IC.GT.30) GO TO 20 IF(ABS(PU/PL-1.0).LT.5.0E-3) GO TO 20 IF(ABS(PU-PBAR).LT.ABS(PL-PBAR)) THEN TDGC=TMAX ICASE=1 ELSE TDGC=TMIN ICASE=2 END IF C DPRW=(PRI-PBAR)/40.65 TR=(TDGC+273.15)/355.37 TR1=1.0-TR C DRODTR STAND FOR DPSR/DTR DRODTR=6.9388D0 DRODTR=DRODTR+2.9519D0*(1.0D0+1.5D0*TR)*TR1**1.5D0 DRODTR=DRODTR-2.0029D0*(1.0D0+7.0D-1*TR)*TR1**7.0D-1 DRODTR=DRODTR*PRI/(TR*TR) IF(DABS(DRODTR).LT.1.0D-5) GO TO 20 C TR=TR-DPRW/DRODTR TDGC=TR*355.37-273.15 IF(ICASE.EQ.2) GO TO 15 C IF(TDGC.LT.TMAX.AND.TDGC.GT.TMIN) GO TO 13 TDGC=(TDGC+273.15)*0.9-273.15 IF(TDGC.LT.TMIN) GO TO 20 13 PRI=F30J02(TDGC) IF((PRI-PBAR)*(PU-PBAR).GT.0.0) GO TO 14 PL=PRI TMIN=TDGC GO TO 11 14 PU=PRI TMAX=TDGC TDGC=(TMAX+TMIN)*0.5 PRI=F30J02(TDGC) IF((PRI-PBAR)*(PL-PBAR).GT.0.0) THEN PL=PRI TL=TDGC ELSE PU=PRI TMAX=TDGC END IF GO TO 11 C 15 IF(TDGC.LT.TMAX.AND.TDGC.GT.TMIN) GO TO 18 TDGC=(TDGC+273.15)*1.1-273.15 IF(TDGC.GT.TMAX) GO TO 20 18 PRI=F30J02(TDGC) IF((PRI-PBAR)*(PL-PBAR).GT.0.0) GO TO 19 PU=PRI TMAX=TDGC GO TO 11 19 PL=PRI TMIN=TDGC TDGC=(TMAX+TMIN)*0.5 PRI=F30J02(TDGC) IF((PRI-PBAR)*(PU-PBAR).GT.0.0) THEN PU=PRI TMAX=TDGC ELSE PL=PRI TMIN=TDGC END IF GO TO 11 C 20 IC=IC+1 IF(IC.GT.999) GO TO 30 TDGC=(TMAX+TMIN)*0.5 PRI=F30J02(TDGC) IF(ABS(PRI-PBAR)/PBAR.LT.1.0E-6) GO TO 50 IF(PRI.LT.-1.0E9) GO TO 49 IF((PRI-PBAR)*(PU-PBAR).GT.0.0) THEN TMAX=TDGC PU=PBAR ELSE TMIN=TDGC PL=PBAR END IF IF(ABS((TMAX+273.15)/(TMIN+273.15)-1.0).GT.1.0E-6) GO TO 20 TDGC=(TMAX+TMIN)*0.5 GO TO 50 C 30 F40J02=-1.0E10 RETURN 40 F40J02=-1.0E20 RETURN 49 TDGC=PRI 50 F40J02=TDGC RETURN END C 42 ******* FUNCTION F42J02(PBAR) C C U=H-PV (SAT. LIQUID) C TSDGC=F40J02(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HD=F27J02(TSDGC) IF(HD.LT.-1.0E9) GO TO 20 VD=F53J02(TSDGC) IF(VD.LT.-1.0E9) GO TO 10 U=HD-PBAR*VD*1.0E5 F42J02=U RETURN 10 F42J02=VD RETURN 20 F42J02=HD RETURN 30 F42J02=TSDGC RETURN END C 43 ******* FUNCTION F43J02(PBAR) C C U=H-PV (SAT. VAPOR) C TSDGC=F40J02(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HDD=F28J02(TSDGC) IF(HDD.LT.-1.0E9) GO TO 20 VDD=F54J02(TSDGC) IF(VDD.LT.-1.0E9) GO TO 10 U=HDD-PBAR*VDD*1.0E5 F43J02=U RETURN 10 F43J02=VDD RETURN 20 F43J02=HDD RETURN 30 F43J02=TSDGC RETURN END C 79 ******* FUNCTION F79J02(PBAR,S) C C U(P,S) U=H-PV C CALL S01J02(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.355.37) GO TO 40 PSAT=F30J02(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 40 STDD=F38J02(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 40 STD=F37J02(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=F28J02(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 VTDD=F54J02(TDGC) IF(VTDD.LT.-1.0E9) GO TO 16 HTD=F27J02(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 VTD=F53J02(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 F79J02=H C WRITE(6,210) H C 210 FORMAT(1H ,42X,'RTN FROM 10 H=',E12.4) RETURN 11 F79J02=PSAT C WRITE(6,211) PSAT C 211 FORMAT(1H ,42X,'RTN FROM 11 PSAT=',E12.4) RETURN 12 F79J02=STDD C WRITE(6,212) STDD C 212 FORMAT(1H ,42X,'RTN FROM 12 STDD=',E12.4) RETURN 13 F79J02=STD C WRITE(6,213) STD C 213 FORMAT(1H ,42X,'RTN FROM 13 STD=',E12.4) RETURN 14 F79J02=HTDD C WRITE(6,214) HTDD C 214 FORMAT(1H ,42X,'RTN FROM 14 HTDD=',E12.4) RETURN 15 F79J02=HTD C WRITE(6,215) HTD C 215 FORMAT(1H ,42X,'RTN FROM 15 HTD=',E12.4) RETURN 16 F79J02=VTDD C WRITE(6,216) VTDD C 216 FORMAT(1H ,42X,'RTN FROM 16 VTDD=',E12.4) RETURN 17 F79J02=VTD C WRITE(6,217) VTD C 217 FORMAT(1H ,42X,'RTN FROM 17 VTD=',E12.4) RETURN 20 F79J02=TDGC C WRITE(6,220) TDGC C 220 FORMAT(1H ,42X,'RTN FROM 20 TDGC=',E12.4) RETURN 30 F79J02=-1.0E20 RETURN 40 F79J02=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 F44J02(PBAR,TDGC) C C U=H-PV C V=F51J02(PBAR,TDGC) IF(V.LT.-1.0E9) GO TO 20 IF(TDGC-355.37.GT.-273.15) GO TO 4 VTD=F53J02(TDGC) IF((V-VTD)/1.764E-3.LT.1.0E-5) GO TO 5 4 H=G02J02(V,TDGC) GO TO 6 5 H=G02J02(V,TDGC) 6 IF(H.LT.-1.0E9) GO TO 10 U=H-PBAR*V*1.0E5 F44J02=U RETURN 10 F44J02=H RETURN 20 F44J02=V RETURN END C 45 ******* FUNCTION F45J02(PBAR,X) C C U=H-PV C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F42J02(PBAR) IF(UD.LT.-1.0E9) GO TO 20 UDD=F43J02(PBAR) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F45J02=U RETURN 10 F45J02=UDD RETURN 20 F45J02=UD RETURN 30 F45J02=-1.0E20 RETURN END C 46 ******* FUNCTION F46J02(TDGC) C C U=H-PV (SAT. LIQUID C HD=F27J02(TDGC) IF(HD.LT.-1.0E9) GO TO 30 VD=F53J02(TDGC) IF(VD.LT.-1.0E9) GO TO 20 PST=F30J02(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HD-PST*VD*1.0E5 F46J02=U RETURN 10 F46J02=PST RETURN 20 F46J02=VD RETURN 30 F46J02=HD RETURN END C 47 ******* FUNCTION F47J02(TDGC) C C U=H-PV (SAT. VAPOR) C HDD=F28J02(TDGC) IF(HDD.LT.-1.0E9) GO TO 30 VDD=F54J02(TDGC) IF(VDD.LT.-1.0E9) GO TO 20 PST=F30J02(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HDD-PST*VDD*1.0E5 F47J02=U RETURN 10 F47J02=PST RETURN 20 F47J02=VDD RETURN 30 F47J02=HDD RETURN END C 48 ******* FUNCTION F48J02(TDGC,X) C C U=H-PV (SAT. LIQUID) C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F46J02(TDGC) IF(UD.LT.-1.0E9) GO TO 20 UDD=F47J02(TDGC) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F48J02=U RETURN 10 F48J02=UDD RETURN 20 F48J02=UD RETURN 30 F48J02=-1.0E20 RETURN END C G1 &&&&&& FUNCTION G01J02(VM3KG,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3KG,TDGC,G01J02,F53J02,F30J02,VV,PRSBAR DIMENSION AR(7),BR(7),CR(7),ER(4) C DATA AR/7.00083D0,-8.4490192D0,2.7838077D0,5.500207905D0, 1-3.54810721D0,6.24758598D-1,-1.9789556D-2/ DATA BR/-1.104119D1,1.05650367D1,2.5313958D0,-1.652132976D1, 11.107131744D1,-2.821550135D0,2.52512482D-1/ DATA CR/-5.55836D-1,2.85596416D1,-5.174825476D0,1.445791284D1, 1-7.402277416D0,1.330733107D0,-8.15263720D-2/ DATA ER/-5.9691904D1,-1.213201446D1,-4.97649D-1,1.853733D-1/ DATA A,B/3.69666D0,3.0917597D-1/ DATA TC,ROC,PC/3.5537D2,5.67D2,4.065D1/ C K KG/M3 BAR IF(VM3KG.LT.0.000599.OR.VM3KG.GT.18.65) GO TO 50 RO=1.0D0/DBLE(VM3KG) TK=DBLE(TDGC)+2.7315D2 IF(TK.LT.1.65D2.OR.TK.GT.5.0001D2) GO TO 50 IF(DABS(TK-TC).LT.2.0D-3.AND.DABS(RO-ROC).LT.2.0D-1) GO TO 30 IF(TK.GT.TC) GO TO 10 IF(RO.LT.ROC) GO TO 10 VV=F53J02(TDGC) IF(VV.LT.-1.0E19) GO TO 19 IF((VM3KG-VV)/VV.LT.-1.0E-4) GO TO 10 G01J02=F30J02(TDGC) RETURN 10 ROR=RO/ROC TR=TK/TC TR2=TR*TR TRM2=1.0D0/TR2 ROR2=ROR*ROR EBROR2=DEXP(-B*ROR2) ROR3=ROR2*ROR ROR5=ROR2*ROR3 CF=TRM2*(1.0D0+B*ROR2)*EBROR2 C Y1P=A*TR*ROR Y1M=0.0D0 RORI=ROR I=1 RORI=RORI*ROR Y1P=Y1P+AR(I)*TR*RORI Y1M=Y1M+(BR(I)+CR(I)*TRM2)*RORI I=2 RORI=RORI*ROR Y1P=Y1P+I*(BR(I)+CR(I)*TRM2)*RORI Y1M=Y1M+I*AR(I)*TR*RORI I=3 RORI=RORI*ROR Y1P=Y1P+I*(AR(I)*TR+BR(I))*RORI Y1M=Y1M+I*CR(I)*TRM2*RORI I=4 RORI=RORI*ROR Y1P=Y1P+I*(AR(I)*TR+CR(I)*TRM2)*RORI Y1M=Y1M+I*BR(I)*RORI I=5 RORI=RORI*ROR Y1P=Y1P+I*BR(I)*RORI Y1M=Y1M+I*(AR(I)*TR+CR(I)*TRM2)*RORI I=6 RORI=RORI*ROR Y1P=Y1P+I*(AR(I)*TR+CR(I)*TRM2)*RORI Y1M=Y1M+I*BR(I)*RORI I=7 RORI=RORI*ROR Y1P=Y1P+I*BR(I)*RORI Y1M=Y1M+I*(AR(I)*TR+CR(I)*TRM2)*RORI 11 CONTINUE Y1=Y1P+Y1M EBROR2=DEXP(-B*ROR2) Y2=(ER(1)+ER(2)*ROR2)*ROR3*CF Y3=(4*ER(3)+5*ER(4)*ROR)*TR2*ROR5 PRSBAR=(Y1+Y2+Y3)*PC C BAR IF(VM3KG.LT.8.63E-4.AND.TDGC.GT.56.849) GO TO 18 C IF(PRSBAR.GT.100.001) GO TO 50 18 G01J02=PRSBAR RETURN 19 G01J02=VV RETURN 30 G01J02=PC RETURN 50 G01J02=-1.0E20 RETURN END C 49 ****** FUNCTION F49J02(PBAR) C C SAT. VD(P) VPD SAT. LIQUID SPECFIC VOL.(PRESS) C IF(PBAR.LT.0.02.OR.PBAR.GT.40.65) GO TO 20 C TDGC=F40J02(PBAR) VSM3K=TDGC IF(TDGC.LT.-1.0E9) GO TO 15 VSM3K=F53J02(TDGC) 15 F49J02=VSM3K RETURN 20 F49J02=-1.0E20 RETURN END C 50 ****** FUNCTION F50J02(PBAR) C C SAT. VDD(P) VPDD SAT. SPECIFIC VOL.(PRESS) C IF(PBAR.LT.0.02.OR.PBAR.GT.40.65) GO TO 20 C TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 VSM3K=F54J02(TDGC) F50J02=VSM3K RETURN 15 F50J02=TDGC RETURN 20 F50J02=-1.0E20 RETURN END C 80 ****** FUNCTION F80J02(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 S01J02(PBAR0,S,VX,TDGC,H) IF(VX.LT.1.0E-4) GO TO 10 IF(PBAR0.GT.40.65) GO TO 10 PST=F30J02(PBAR0) IF(ABS((PST-PBAR0)/PBAR0).LT.1.0E-5) GO TO 35 10 F80J02=VX RETURN 35 STD=F37J02(TDGC) STDD=F38J02(TDGC) VTD=F53J02(TDGC) VTDD=F54J02(TDGC) SX=(S-STD)/(STDD-STD) VX=VTD+(VTDD-VTD)*SX F80J02=VX RETURN END C 51 ******** FUNCTION F51J02(PBAR,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J02,F51J02,PBAR,TDGC,VNL,VXL,V1,V2,P1,P2 REAL PST,F53J02,F54J02,VMIN,VMAX,PX,PW,VW REAL VM3KC,PCBAR,RGSC DATA VM3KC,TCK,PCBAR,RGSC/1.763668E-3,3.5537D2,40.65,7.4577E-2/ C CHK RANGE PBAR,TDGC IF(PBAR.LT.1.99999E-3.OR.PBAR.GT.1.00001E2) GO TO 70 TK=TDGC+2.7315D2 IF(TK.LT.1.65D2.OR.TK.GT.5.0001D2) 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 5 ICOUNT=0 IF(TK.GT.TCK) GO TO 16 VW=F53J02(TDGC) PST=G01J02(VW,TDGC) IF(ABS(PST/PBAR-1.0).GT.1.0E-6) GO TO 14 VW=F54J02(TDGC) GO TO 60 C 14 IF(PBAR.GT.PST) GO TO 15 VMIN=F54J02(TDGC) PW=G01J02(VMIN,TDGC) IF(PW/PBAR-1.0.LT.5.0E-6) THEN VW=F54J02(TDGC) GO TO 60 END IF VMAX=0.5*RGSC*SNGL(TK) ICASE=4 VNL=VMIN VXL=VMAX GO TO 20 15 VMAX=F53J02(TDGC) PW=G01J02(VMAX,TDGC) IF(PW/PBAR-1.0.GT.-5.0E-6) THEN VW=F54J02(TDGC) GO TO 60 END IF VMIN=9.3E-4 IF(VMAX/VMIN-1.0.LT.1.0E-5.OR.TDGC.LT.330.0-273.14) THEN VW=F54J02(TDGC) GO TO 60 END IF ICASE=2 VXL=VMAX VNL=VMIN GO TO 25 C C FROM 5 16 VW=VM3KC PX=G01J02(VM3KC,TDGC) IF(PX.LT.-1.0E9) GO TO 18 IF(ABS(PX/PBAR-1.0).LT.1.0E-6) GO TO 60 IF(PBAR.GT.PX) GO TO 17 VMIN=VM3KC VMAX=0.5*RGSC*SNGL(TK) ICASE=3 VNL=VMIN VXL=VMAX GO TO 20 17 VMAX=VM3KC VMIN=9.3E-4 ICASE=1 VXL=VMAX VNL=VMIN GO TO 25 C C FROM 16 18 VMAX=0.5*RGSC*SNGL(TK) VXL=VMAX C C FROM 37 TOO 19 VW=VMAX PX=G01J02(VMAX,TDGC) IF(PX.LT.-1.0E9) GO TO 37 IF(ABS(PX/PBAR-1.0).LT.1.0E-6) GO TO 60 GO TO 30 C 20 VW=(VMAX+VMIN)*0.5 PW=G01J02(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(ICOUNT.LT.8) GO TO 20 IF(ABS(VMIN/VMAX-1.0).LT.1.0E-6) GO TO 59 GO TO 20 21 VMAX=VW ICOUNT=ICOUNT+1 IF(ICOUNT.LT.8) GO TO 20 IF(PW.GT.0.0) GO TO 40 IF(ABS(VMIN/VMAX-1.0).LT.1.0E-6) GO TO 59 GO TO 20 C 25 VW=(VMAX+VMIN)*0.5 PW=G01J02(VW,TDGC) IF(PW.LT.-1.0E9) GO TO 26 IF(ABS(PW/PBAR-1.0).LT.1.0E-6) GO TO 60 IF(PBAR.GT.PW) GO TO 27 26 VMIN=VW ICOUNT=ICOUNT+1 IF(ICOUNT.LT.8) GO TO 25 IF(ABS(VMIN/VMAX-1.0).LT.1.0E-6) GO TO 59 GO TO 25 27 VMAX=VW ICOUNT=ICOUNT+1 IF(ICOUNT.LT.8) GO TO 25 IF(PW.GT.0.0) GO TO 40 IF(ABS(VMIN/VMAX-1.0).LT.1.0E-6) GO TO 59 GO TO 25 C C FROM 19(..5) 30 V2=VMAX IF(PX.LT.PBAR) GO TO 31 IF(VXL/V2.LT.1.00001) GO TO 50 V1=VMAX V2=VXL GO TO 32 31 V1=VM3KC 32 VW=(V1+V2)*0.5 PW=G01J02(VW,TDGC) IF(ABS(PW/PBAR-1.0).LT.1.0E-6) GO TO 60 IF(PW.GT.PBAR) GO TO 34 IF(PW.LT.-1.0E9) GO TO 33 V2=VW GO TO 32 33 V1=VW GO TO 32 C 34 VXL=V2 VMIN=VW VMAX=V2 ICASE=3 VNL=VMIN GO TO 20 C C FROM 19 37 VMAX=VMAX*0.5 IF(VMAX.LT.VM3KC) GO TO 50 GO TO 19 C 40 P1=G01J02(VMIN,TDGC) P2=G01J02(VMAX,TDGC) IF(P1.GT.0.0.AND.P2.GT.0.0) GO TO 41 GO TO 42 C 41 IF((P1-PBAR)*(P2-PBAR).LT.0.0) GO TO 44 42 IF(ICASE.LE.2) GO TO 43 PW=G01J02(VNL,TDGC) IF(ABS(PW/PBAR-1.0).LT.1.0E-6) GO TO 60 IF(PW.LT.-1.0E9) GO TO 50 IF((PW-PBAR)*(P1-PBAR).GT.0.0) GO TO 50 VMAX=VMIN VMIN=VNL IF(ABS(VMAX/VMIN-1.0).LT.1.0E-6) GO TO 59 ICOUNT=0 GO TO 20 43 PW=G01J02(VXL,TDGC) IF(ABS(PW/PBAR-1.0).LT.1.0E-6) GO TO 60 IF(PW.LT.-1.0E9) GO TO 50 IF((PW-PBAR)*(P2-PBAR).GT.0.0) GO TO 50 VMIN=VMAX VMAX=VXL IF(ABS(VMIN/VMAX-1.0).LT.1.0E-6) GO TO 59 ICOUNT=0 GO TO 25 C C FROM 41 44 IC=0 VW=ABS(VMIN/VMAX-1.0) 45 VW=(VMAX+VMIN)*0.5 IC=IC+1 IF(IC.GT.999) GO TO 50 PW=G01J02(VW,TDGC) IF(ABS(PW/PBAR-1.0).LT.1.0E-6) GO TO 60 IF((PW-PBAR)*(P1-PBAR).GT.0.0) GO TO 46 VMAX=VW P2=PW GO TO 47 46 VMIN=VW P1=PW 47 VW=ABS(VMIN/VMAX-1.0) IF(VW.LT.2.0E-6) GO TO 59 IF(VW.LT.1.0E-3) GO TO 45 VW=(VMIN+VMAX+(VMAX-VMIN)*(P1+P2-PBAR-PBAR)/(P1-P2))*0.5 PW=G01J02(VW,TDGC) IF(ABS(PW/PBAR-1.0).LT.1.0E-6) GO TO 60 IF((PW-PBAR)*(P1-PBAR).GT.0.0) GO TO 48 VMAX=VW P2=PW GO TO 45 48 VMIN=VW P1=PW GO TO 45 C 50 F51J02=-1.E10 RETURN 59 VW=(VMAX+VMIN)*0.5 60 F51J02=VW RETURN 70 F51J02=-1.0E20 RETURN END C 52 ******* FUNCTION F52J02(PBAR,X) TDGC=F40J02(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 V=F55J02(TDGC,X) F52J02=V RETURN 10 F52J02=TDGC RETURN END C 53 ******* FUNCTION F53J02(TDGC) DOUBLE PRECISION TR,TC,ROC,ROR,ETR DATA TC,ROC/3.5537D2,5.67D2/ TK=TDGC+273.15 IF(ABS(TK-355.37).LT.0.001) GO TO 20 IF(TK.LT.167.5.OR.TK.GT.355.37) GO TO 30 TR=DBLE(TK)/TC ETR=1.0D0-TR ROR=1.0D0+2.16466*ETR**3.74D-1+5.0713D-1*ETR**1.25D0 F53J02=1.0D0/(ROR*ROC) RETURN 20 F53J02=1.0D0/ROC RETURN 30 F53J02=-1.0E20 RETURN END C 54 ******* C C update : 08/08/1996 for Ver.10.1 C FUNCTION F54J02(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F54J02,TDGC DIMENSION A(27) DATA A/ 7.00083D0, -8.4490192D0, 2.7838077D0, 5.500207905D0, 1 -3.54810721D0, 0.624758598D0, -1.9789556D-2, -5.9691904D01, 2 -4.97649D-1, -1.6246D02, -1.104119D01, 1.05650367D01, 3 2.5313958D0, -1.652132976D01, 1.107131744D01, -2.821550135D0, 4 2.52512482D-1, -1.213201446D01, 1.853733D-1, -3.592994163D01, 5 -5.55836D-1, 2.85596416D01, -5.174825476D0, 1.445791284D01, 6 -7.402277416D0, 1.330733107D0, -8.15263720D-2/ DATA AA, BB, RHOC/ 3.69666D0, 3.0917597D-1, 567.D0 / DATA PC, TC / 4.065D0, 355.37D0 / DATA AA1, AA2, AA3 / -6.93880D0, 2.0029D0, -2.9519D0 / C TK=TDGC+273.15 C IF(ABS(TK-355.37).GT.0.004) GO TO 1 C ERROR 0.004 STAND FOR ROUND OFF C VM3K=1.764E-3 GO TO 500 1 IF(TK.LT.167.5.OR.TK.GT.355.37) GO TO 920 TTR = 1.0D0-TK/TC FFT = AA1*TTR+AA2*TTR**1.7+AA3*TTR**2.5 PM = PC*DEXP(TC/TK*FFT) RR = 1.E-3 PR = PM/PC TR = TK/TC TT2 =TR*TR IF (TK.GE.355.01D0) GO TO 300 ICNT = 0 50 SUM1 = 0. ICNT = ICNT+1 DO 5 I=1,7 SUM1 = SUM1+DBLE(I)*(A(I)*TR+A(10+I)+A(20+I)/TT2)*RR**(I+1) 5 CONTINUE RR2 = RR*RR RR3 = RR2*RR RR4 = RR3*RR RR5 = RR4*RR RR6 = RR5*RR BRH2 = BB*RR2 EBR = DEXP(-BRH2) F = AA*TR*RR+SUM1+A(8)*RR3/TT2*(1.0D0+BRH2)*EBR+A(18)*RR5/TT2* 1 (1.0D0+BRH2)*EBR+4.D0*A(9)*TT2*RR5+5.D0*A(19)*TT2*RR6-PR SUM2 = 0. DO 10 I=1,7 SUM2 = SUM2+DBLE(I*(I+1))*(A(I)*TR+A(10+I)+A(20+I)/TT2)*RR**I 10 CONTINUE DF = AA*TR+SUM2+A(8)/TT2*RR2*(3.D0+5.D0*BRH2)*EBR-2.D0*A(8)/TT2* 1 BB*RR4*(1.D0+BRH2)*EBR+A(18)/TT2*RR4*(5.D0+7.D0*BRH2)*EBR 2 -2.D0*A(18)/TT2*BB*RR6*(1.D0+BRH2)*EBR+20.D0*A(9)*TT2*RR4+ 3 30.D0*A(19)*TT2*RR5 RRN = RR-F/DF IF (ICNT.GT.1000) GO TO 910 IF (DABS((RRN-RR)/RR).LT.1.D-8) GO TO 100 RR = RRN GO TO 50 100 RHO = RR*RHOC F54J02 = 1.0D0/RHO RETURN 910 F54J02 = -1.0E+10 RETURN 920 F54J02=-1.0E20 RETURN 500 F54J02=VM3K RETURN 300 RHO = RHOC*(1.0D0-1.3533D0*(1.0D0-TR)**0.374) F54J02 = 1.0/RHO RETURN END C 55 ****** FUNCTION F55J02(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 VD=F53J02(TDGC) IF(VD.LT.-1.0E9) GO TO 20 VDD=F54J02(TDGC) IF(VDD.LT.-1.0E9) GO TO 10 V=(1.0-X)*VD+X*VDD F55J02=V RETURN 10 F55J02=VDD RETURN 20 F55J02=VD RETURN 30 F55J02=-1.0E20 RETURN END C 83 *************** FUNCTION F83J02(PBAR,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3K,TDGC,PBAR,F51J02,F30J02,F54J02,PSAT,CP,CV REAL RO,T,F18J02,F77J02,F83J02 DIMENSION AR(7),BR(7),CR(7),ER(4) C DATA AR/7.00083D0,-8.4490192D0,2.7838077D0,5.500207905D0, 1-3.54810721D0,6.24758598D-1,-1.9789556D-2/ DATA BR/-1.104119D1,1.05650367D1,2.5313958D0,-1.652132976D1, 11.107131744D1,-2.821550135D0,2.52512482D-1/ DATA CR/-5.55836D-1,2.85596416D1,-5.174825476D0,1.445791284D1, 1-7.402277416D0,1.330733107D0,-8.15263720D-2/ DATA ER/-5.9691904D1,-1.213201446D1,-4.97649D-1,1.853733D-1/ DATA A,B/3.69666D0,3.0917597D-1/ DATA TC,ROC,PC/3.5537D2,5.67D2,4.065D1/ C K KG/M3 BAR C VM3K=F51J02(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 40 IF(PBAR.GT.PC*0.99999) GO TO 10 PSAT=F30J02(TDGC) IF(ABS(PSAT/PBAR-1.0).GT.1.0E-5) GO TO 10 VM3K=F54J02(TDGC) 10 T=TDGC+273.15 TR=DBLE(T)/TC RO=1.0/VM3K ROR=DBLE(RO)/ROC IF(DABS(TR-1.0D0).LT.1.0D-5.AND.DABS(ROR-1.0D0).LT.1.0D-5) 1 GO TO 50 C TRM2=1.0D0/(TR*TR) TRM3=TRM2/TR ROR2=ROR*ROR ROR3=ROR2*ROR ROR4=ROR2*ROR2 ROR5=ROR3*ROR2 BROR2=B*ROR2 EBROR2=DEXP(-BROR2) C RORI=1.0D0 Y2=A*TR DO 20 I=1,7 RORI=RORI*ROR Y2=Y2+I*(I+1)*(AR(I)*TR+BR(I)+CR(I)*TRM2)*RORI 20 CONTINUE Y2=Y2-ER(1)*TRM2*EBROR2*((2*BROR2-3.0D0)*BROR2-3.0D0)*ROR2 Y2=Y2-ER(2)*TRM2*EBROR2*((2*BROR2-5.0D0)*BROR2-5.0D0)*ROR4 Y2=Y2+(20*ER(3)+30*ER(4)*ROR)*TR*TR*ROR4 C IF(DABS(Y2).LT.1.0D-5) GO TO 50 CP=F18J02(PBAR,TDGC) CV=F77J02(PBAR,TDGC) C IF(CP.GT.0.0.AND.CV.GT.0.0) GO TO 30 GO TO 50 30 WPT=CP/CV*Y2 F83J02=DSQRT(WPT*PC/ROC*1.0D5) RETURN 40 F83J02=VM3K RETURN 50 F83J02=-1.0E20 RETURN END C 56 ******* FUNCTION F56J02(PBAR,H) TSDGC=F40J02(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F60J02(TSDGC,H) F56J02=X RETURN 10 F56J02=TSDGC RETURN END C 57 ******* FUNCTION F57J02(PBAR,S) TSDGC=F40J02(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F61J02(TSDGC,S) F57J02=X RETURN 10 F57J02=TSDGC RETURN END C 58 ******* FUNCTION F58J02(PBAR,U) TSDGC=F40J02(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F62J02(TSDGC,U) F58J02=X RETURN 10 F58J02=TSDGC RETURN END C 59 ******* FUNCTION F59J02(PBAR,V) TSDGC=F40J02(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F63J02(TSDGC,V) F59J02=X RETURN 10 F59J02=TSDGC RETURN END C 60 ******* FUNCTION F60J02(TDGC,H) TK=TDGC+273.15 IF(TK.LT.167.5.OR.TK.GT.355.37) GO TO 10 HD=F27J02(TDGC) IF(HD.LT.-1.0E9) GO TO 30 IF(HD.GT.H) GO TO 10 HDD=F28J02(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 F60J02=1.0 RETURN 5 X=(H-HD)/(HDD-HD) F60J02=X RETURN 10 F60J02=-1.0E20 RETURN 20 F60J02=HDD RETURN 30 F60J02=HD RETURN END C 61 ******* FUNCTION F61J02(TDGC,S) TK=TDGC+273.15 IF(TK.LT.167.5.OR.TK.GT.355.37) GO TO 10 SD=F37J02(TDGC) IF(SD.LT.-1.0E9) GO TO 30 IF(SD.GT.S) GO TO 10 SDD=F38J02(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 F61J02=1.0 RETURN 5 X=(S-SD)/(SDD-SD) F61J02=X RETURN 10 F61J02=-1.0E20 RETURN 20 F61J02=SDD RETURN 30 F61J02=SD RETURN END C 62 ******* FUNCTION F62J02(TDGC,U) TK=TDGC+273.15 IF(TK.LT.167.5.OR.TK.GT.355.37) GO TO 10 UD=F46J02(TDGC) IF(UD.LT.-1.0E9) GO TO 30 IF(UD.GT.U) GO TO 10 UDD=F47J02(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 F62J02=1.0 RETURN 5 X=(U-UD)/(UDD-UD) F62J02=X RETURN 10 F62J02=-1.0E20 RETURN 20 F62J02=UDD RETURN 30 F62J02=UD RETURN END C 63 ******* FUNCTION F63J02(TDGC,V) TK=TDGC+273.15 IF(TK.LT.167.5.OR.TK.GT.355.37) GO TO 10 VD=F53J02(TDGC) IF(VD.LT.-1.0E9) GO TO 30 IF(VD.GT.V) GO TO 10 VDD=F54J02(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 F63J02=1.0 RETURN 5 X=(V-VD)/(VDD-VD) F63J02=X RETURN 10 F63J02=-1.0E20 RETURN 20 F63J02=VDD RETURN 30 F63J02=VD RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99J02(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR R 502 ****' WRITE(6,100) MSG 100 FORMAT(1H ,5X,A) ENDIF RETURN END REAL FUNCTION T90(T) * Conversion of temperature scal from IPTS-68 to ITS-90 * Range -200C<=T68<=630C anf T68>=1064 REAL T68,T0K REAL*8 CA(8) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA CA/-0.14542, -0.26722, 1.06471, 1.131286, -4.25835, + -1.59924, 7.29176, -3.52573/ IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF T68=T-T0K * Check of argument range IF((-200.0.LE.T68).AND.(T68.LE.630.0)) THEN RT68=T68/630.0 TEMP=T68+RT68*(CA(1)+RT68*(CA(2)+RT68*(CA(3)+RT68*(CA(4) + +RT68*(CA(5)+RT68*(CA(6)+RT68*(CA(7)+RT68*CA(8)))))))) ELSE IF((1064.0.LE.T68).AND.(T68.LE.3000.0)) THEN TEMP=T68-0.25*(T68+273.15)*(T68+273.15)/1337.33/1337.33 ELSE IF(MESS.NE.0) WRITE(6,6020) T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT T90', & ' WHEN T68 =',1PE14.7,' ****') T90=-1.0E+20 RETURN END IF T90=TEMP+T0K RETURN END REAL FUNCTION T68(T) * Conversion of temperature scal from ITS-90 to IPTS-68 * Range -200C<=T68<=630C anf T68>=1064 T1=T90(T) T2=T ITER=0 DT=T-T1 1000 CONTINUE ITER=ITER+1 IF(ITER.GE.10000) THEN WRITE(6,*) ' ITERATION EXCEEDED MAXIMUM ' T68=-1.0E+10 RETURN END IF T2=T2+DT T1=T90(T2) DT=T-T1 IF(ABS(DT).GE.1.0E-4) GOTO 1000 T68=T2 RETURN END * Subroutine Program Specifying KPA and MESS * MS-FORTRAN and MS-C Mixed Langage Programing * SUBROUTINE KPAMES(KPAC,MESSC) COMMON/UNIT/KPA,MESS INTEGER KPAC INTEGER MESSC KPA=KPAC MESS=MESSC RETURN END