C ********** R13B1 ******** 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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(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 S99J03(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT REAL FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99J03(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 DATA FUN/'AJTPT'/ CALL S99J03(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 13B1'/, 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 = F2J03(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 13B1'/, 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 = F3J03(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 13B1'/, 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 = F4J03(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 13B1'/, 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 = F5J03(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 13B1'/, 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 = F6J03(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 13B1'/, 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 = F7J03(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 13B1'/, 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 = F8J03(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 13B1'/, 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 = F9J03(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 13B1'/, 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 = F10J03(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 13B1'/, 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 = F11J03(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 13B1'/, 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 = F12J03(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 13B1'/, 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 = F13J03(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 13B1'/, 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 = F14J03(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 13B1'/, 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 = F15J03(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 S99J03(FUN) BPPT=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 DATA FUN/'BSPT'/ CALL S99J03(FUN) BSPT=-1.0E+30 RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 DATA FUN/'BTPT'/ CALL S99J03(FUN) BTPT=-1.0E+30 RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 DATA FUN/'BVPT'/ CALL S99J03(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 13B1'/, 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 = F16J03(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 13B1'/, 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 = F17J03(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 13B1'/, 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 = F18J03(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 13B1'/, 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 = F19J03(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 13B1'/, 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 = F20J03(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPTDD=FF RETURN END C------------------------------------------------- F21 = CRP REAL FUNCTION CRP(A) CHARACTER FUN*6,FLUID*16,A*1 REAL T0K,PBAR,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 13B1'/, 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 = F21J03(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 S99J03(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='148.91' WHEN A='M' C B='55.8346' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=148.91 ELSE IF (A.EQ.'R') THEN FC=55.8346 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR REFRIGERANT 13B1 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 S99J03(FUN) GAMPDD=-1.0E+30 RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 DATA FUN/'GAMPT'/ CALL S99J03(FUN) GAMPT=-1.0E+30 RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 DATA FUN/'GAMTDD'/ CALL S99J03(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 13B1'/, 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 = F23J03(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 13B1'/, 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 = F24J03(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 13B1'/, 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 = F25J03(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 13B1'/, 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 = F26J03(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 13B1'/, 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 = F27J03(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 13B1'/, 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 = F28J03(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 13B1'/, 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 = F29J03(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 13B1' WHEN A='S' C B='CBRF3 ' 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 13B1' ELSE IF (A.EQ.'C') THEN IDENTF='CBRF3' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR REFRIGERANT 13B1 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 S99J03(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT REAL FUNCTION PMLT(T) CHARACTER FUN*6 DATA FUN/'PMLT'/ CALL S99J03(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 13B1'/, 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 = F85J03(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 13B1'/, 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 = F86J03(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 13B1'/, 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 = F81J03(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 13B1'/, 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 = F87J03(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 13B1'/, 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 = F88J03(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 S99J03(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 13B1'/, 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 = F30J03(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 S99J03(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD REAL FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99J03(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 13B1'/, 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 = F31J03(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 13B1'/, 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 = F32J03(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 13B1'/, 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 = F33J03(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 13B1'/, 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 = F34J03(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 13B1'/, 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 = F35J03(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 13B1'/, 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 = F36J03(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 13B1'/, 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 = F37J03(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 13B1'/, 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 = F38J03(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 13B1'/, 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 = F39J03(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 S99J03(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP REAL FUNCTION TMLP(P) CHARACTER FUN*6 DATA FUN/'TMLP'/ CALL S99J03(FUN) TMLP=-1.0E+30 RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 DATA FUN/'TPSEUP'/ CALL S99J03(FUN) TPSEUP=-1.0E+30 RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99J03(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 13B1'/, 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 = F40J03(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 13B1'/, 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 S99J03(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD REAL FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99J03(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 13B1'/, 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 = F42J03(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 13B1'/, 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 = F43J03(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 13B1'/, 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 = F44J03(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 13B1'/, 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 = F45J03(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 13B1'/, 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 = F46J03(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 13B1'/, 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 = F47J03(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 13B1'/, 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 = F48J03(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 13B1'/, 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 = F49J03(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 13B1'/, 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 = F50J03(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 13B1'/, 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 = F51J03(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 13B1'/, 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 = F52J03(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 13B1'/, 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 = F53J03(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 13B1'/, 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 = F54J03(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 13B1'/, 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 = F55J03(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 13B1'/, 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 = F83J03(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 13B1'/, 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 = F56J03(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 13B1'/, 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 = F57J03(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 13B1'/, 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 = F58J03(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 13B1'/, 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 = F59J03(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 13B1'/, 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 = F60J03(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 13B1'/, 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 = F61J03(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 13B1'/, 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 = F62J03(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 13B1'/, 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 = F63J03(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 13B1'/, 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 = F64J03(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 13B1'/, 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 = F65J03(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 13B1'/, 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 = F70J03(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 13B1'/, 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 = F71J03(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 13B1'/, 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 = F82J03(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 13B1'/, 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 = F76J03(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 13B1'/, 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 = F77J03(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 13B1'/, 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 = F78J03(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 13B1'/, 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 = F79J03(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 13B1'/, 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 = F80J03(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 ********** R13B1 ********* C ********** VER. 9.1.********* C C 82 FUNCTION F82J03(PBAR,TDGC) WA=F83J03(PBAR,TDGC) VM3K=F51J03(PBAR,TDGC) DXIN=WA*WA/(PBAR*VM3K*1.0E5) F82J03=DXIN RETURN END C 2 ****** FUNCTION F2J03(PBAR) IF(ABS(PBAR-39.628).GT.0.004) GO TO 10 A=0.0 GO TO 30 10 W=F40J03(PBAR) TK=W+273.15 IF(TK.LT.160.0.OR.TK.GT.340.08) GO TO 20 A=F3J03(W) GO TO 30 20 A=-1.0E20 30 F2J03=A RETURN END C 3 ****** FUNCTION F3J03(TDGC) DOUBLE PRECISION A,G0,SIGMA,RD,RDD DATA G0/9.80665D2/ TK=TDGC+273.15 IF(ABS(TK-340.08).LT.0.02) GO TO 10 IF(TK.LT.160.0.OR.TK.GT.340.08) GO TO 20 W=F53J03(TDGC) IF(W.LT.1.0E-5) GO TO 30 RD=1.0D0/DBLE(W) W=F54J03(TDGC) IF(W.LT.1.0E-5) GO TO 30 RDD=1.0D0/DBLE(W) W=G20J03(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 F3J03=A RETURN END C 20 &&&&& FUNCTION G20J03(TK) DOUBLE PRECISION TR,SIGMA,WK IF(ABS(TK-340.08).LT.0.02) GO TO 10 IF(TK.LT.105.0.OR.TK.GT.340.08) GO TO 20 TR=DBLE(TK)/3.4008D2 WK=1.0D0-TR SIGMA=5.221D1*WK**1.26D0 G20J03=SIGMA*1.0D-3 RETURN 10 G20J03=0.0 RETURN 20 G20J03=-1.0E20 RETURN END C 4 ****** FUNCTION F4J03(PBAR) ALH=F24J03(PBAR) IF(ALH.LT.-1.0E9) GO TO 10 HD=F23J03(PBAR) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F4J03=ALH RETURN 20 F4J03=HD RETURN END C 5 ****** FUNCTION F5J03(TDGC) ALH=F28J03(TDGC) IF(ALH.LT.-1.0E9) GO TO 10 HD=F27J03(TDGC) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F5J03=ALH RETURN 20 F5J03=HD RETURN END C 6 ******* FUNCTION F6J03(PBAR) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 ALAMBD=F9J03(TDGC) F6J03=ALAMBD RETURN 10 F6J03=TDGC RETURN END C 7 ******* FUNCTION F7J03(PBAR) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 ALAMBD=F10J03(TDGC) F7J03=ALAMBD RETURN 10 F7J03=TDGC RETURN END C 8 ******* FUNCTION F8J03(PBAR,TDGC) DOUBLE PRECISION ALAMBD,TK,RELDP RELDP=DBLE(PBAR/1.01325) TK=DBLE(TDGC+273.15) IF(TK.LT.2.7D2.OR.TK.GT.4.341D2) GO TO 5 ALAMBD=5.2117D-2*TK-5.7658D0 F8J03=ALAMBD*1.0D-3 RETURN 5 F8J03=-1.0E+20 RETURN END C 9 ******* FUNCTION F9J03(TDGC) DOUBLE PRECISION ALAMD,TK C LAMBDA (SAT. LIQ.) TK=DBLE(TDGC+273.15) IF(TK.GT.9.99999D1.AND.TK.LT.3.20001D2) GO TO 10 F9J03=-1.0E20 RETURN 10 ALAMD=1.549139D2+(1.85164D-4*TK-4.00736D-1)*TK F9J03=ALAMD*1.0D-3 RETURN END C 10 ******* FUNCTION F10J03(TDGC) DOUBLE PRECISION ALAMBD,TK C LAMBDA (SAT. VAP.) TK=DBLE(TDGC+273.15) IF(TK.GT.2.99999D2.AND.TK.LT.3.34001D2) GO TO 10 F10J03=-1.0E20 RETURN 10 ALAMBD=5.1958D-45*TK**18+5.2117D-2*TK-5.7709D0 F10J03=ALAMBD*1.0D-3 RETURN END C 11 &&&&&&& FUNCTION G11J03(RO,TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) C IOTA(DYNAMIC VISC.) REAL RO,TK,G11J03 DIMENSION CFMUR(12) DATA CFMUR/0.0D0,5.50785D-2,-1.11377D-5,-3.49981D-2, 11.74849D-4,-1.74610D-7,3.44141D-5,0.0D0,0.0D0,3.91831D-8, 2-1.05885D-10,0.0/ IF(TK.LT.273.1499.OR.TK.GT.448.15) GO TO 50 IF(RO.GT.600.0) GO TO 50 ROW=DBLE(RO) T=DBLE(TK) S0=(CFMUR(2)+CFMUR(3)*T)*T S1=CFMUR(4)+(CFMUR(5)+CFMUR(6)*T)*T S2=CFMUR(7) S3=CFMUR(10)+CFMUR(11)*T YYTA=(((S3*ROW+S2)*ROW)+S1)*ROW+S0 G11J03=SNGL(YYTA*1.0D-6) RETURN 50 G11J03=-1.0E20 END C 11 ******* FUNCTION F11J03(PBAR) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.E9) GO TO 10 AMU=F14J03(TDGC) F11J03=AMU RETURN 10 F11J03=TDGC RETURN END C 12 ******* FUNCTION F12J03(PBAR) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.E9) GO TO 10 TK=TDGC+273.15 VM3KG=F51J03(PBAR,TDGC) IF(VM3KG.LT.1.0E-4) GO TO 20 RO=1.0/VM3KG AMU=G11J03(RO,TK) F12J03=AMU RETURN 10 F12J03=TDGC RETURN 20 F12J03=VM3KG RETURN END C 13 ******* FUNCTION F13J03(PBAR,TDGC) IF(PBAR.LT.0.999999) GO TO 50 VW=F51J03(PBAR,TDGC) IF(VW.LT.-1.0E9) GO TO 40 RO=1.0/VW IF(RO.GT.600.0) GO TO 50 C 5 AMU=G11J03(RO,TK) F13J03=AMU*1.0E-6 RETURN 40 F13J03=VW RETURN 50 F13J03=-1.0E20 RETURN END C 14 ******* FUNCTION F14J03(TDGC) TK=TDGC+273.15 IF(TK.GT.189.99.AND.TK.LT.332.01) GO TO 10 5 F14J03=-1.0E20 RETURN 10 VD=F53J03(TDGC) IF(VD.LT.1.0E-4) GO TO 20 RO=1.0/VD IF(RO.GT.600.0) GO TO 5 C AMU=G11J03(RO,TK) F14J03=AMU*1.0E-6 RETURN 20 F14J03=VD RETURN END C 15 ******* FUNCTION F15J03(TDGC) TK=TDGC+273.15 IF(TK.GT.273.15.AND.TK.LT.340.08) GO TO 10 F15J03=-1.E+20 RETURN 10 VM3KG=F54J03(TDGC) IF(VM3KG.LT.1.0E-4) GO TO 20 RO=1.0/VM3KG AMU=G11J03(RO,TK) F15J03=AMU RETURN 20 F15J03=VM3KG RETURN END C 16 ****** FUNCTION F16J03(PBAR) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPD=F19J03(TDGC) F16J03=CPD RETURN 10 F16J03=TDGC RETURN END C 17 ****** FUNCTION F17J03(PBAR) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPDD=F20J03(TDGC) F17J03=CPDD RETURN 10 F17J03=TDGC RETURN END C 18 ******* FUNCTION F18J03(PBAR,TDGC) DATA TC,VC/3.4008E2,1.3089E-3/ T=TDGC+273.15 IF(T.LT.160.0.OR.T.GT.460.0) GO TO 50 IF(PBAR.LT.0.06897.OR.PBAR.GT.150.0) GO TO 50 IF(ABS(PBAR-39.628).LT.0.004.AND.ABS(T-340.08).LT.0.002) 1 GO TO 35 C CRITICAL POINT CP=1.0E10 C VV=F51J03(PBAR,TDGC) IF(VV.LT.-1.0E9) GO TO 40 RO=1.0/VV IF(RO.GT.600.0) GO TO 50 IF(VV.LT.VC.AND.T.LT.TC) THEN VSLIQ=F53J03(TDGC) CP=-1.0E20 IF(ABS(VV/VSLIQ-1.0).LT.1.0E-4) CP=F19J03(TDGC) ELSE CP=G07J03(VV,TDGC) END IF F18J03=CP RETURN 35 F18J03=1.0E10 RETURN 40 F18J03=VV RETURN 50 F18J03=-1.0E20 RETURN END C G7 &&&&&& FUNCTION G07J03(VM3KG,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G07J03,VM3KG,TDGC C CP(V,T) DIMENSION A(20) C DATA A/7.974353864D-1,-1.900841429D0,-1.113118701D-1, 13.727822548D-1,2.970786824D0,-1.045640488D1,9.930766387D0, 2-2.227161050D0,-1.343481711D0,1.121225596D0,1.690410401D-1, 35.362221526D-1,-4.301837568D-1,-3.852201837D-1,8.050511470D-2, 42.497134203D-1,4.665707679D-2,-1.610467521D-1,-2.107993994D-2, 53.475784760D-2/ DATA B0,B1,B2,B3,B4/1.536686D-1,-1.166064D0,5.242538D0, 16.025346D0,-1.38925D0/ DATA R/5.583460D1/ DATA TC,ROC/3.4008D2,7.640D2/ C K KG/M3 ROR=1.0D0/(DBLE(VM3KG)*ROC) TR=(DBLE(TDGC)+2.7315D2)/TC ROR2=ROR*ROR ROR3=ROR2*ROR ROR4=ROR2*ROR2 ROR6=ROR4*ROR2 ROR7=ROR4*ROR3 ROR9=ROR6*ROR3 ROR10=ROR6*ROR4 ROR11=ROR7*ROR4 TRI=1.0D0/TR TR2I=TRI*TRI TR4I=TR2I*TR2I TR6I=TR4I*TR2I S1=-30*A(3)*TR6I*ROR-(4*A(8)+2.4D0*A(9)*ROR2)*ROR3*TR4I S2=-30*A(13)*TR6I*ROR7/7.0D0 S3=(-3*A(18)*TR4I*ROR3-2*A(19)*ROR4/1.1D1)*TR2I*ROR7 S=S1+S2+S3 S1=(2*A(7)/3.0D0+6*A(10)*TR4I*ROR2)*TR2I*ROR3 S2=(2*A(15)+30*A(16)*TR4I)*TR2I*ROR9/9.0D0 S3=(2*A(12)/7.0D0+30*A(20)*TR4I*ROR4/1.1D1)*TR2I*ROR7 S1=S1+S2+S3 S=S-S1 S1=B0*TR2I+B2+B3*TR+B1*TRI+B4*TR*TR-1.0 WA=S+S1 S1=1.0D0+(A(1)-5*A(3)*TR6I+A(4)*ROR)*ROR S2=(A(5)-3*(A(8)+A(9)*ROR2)*TR4I+A(11)*ROR3)*ROR3 S3=-(5*(A(13)+A(18)*ROR3)*TR6I+A(19)*TR2I*ROR4)*ROR7 S=S1+S2+S3 S1=(A(7)*TR2I+5*A(10)*TR6I*ROR2+A(12)*TR2I*ROR4)*ROR3 S2=(A(15)*TR2I+5*A(16)*TR6I)*ROR9+5*A(20)*TR6I*ROR11 S3=S1+S2 X=S-S3 S1=1.0D0+(2*A(1)+3*A(4)*ROR+4*(A(5)+A(7)*TR2I)*ROR2)*ROR S2=(6*A(10)*TR6I*ROR+7*A(11)*ROR2+8*A(12)*TR2I*ROR3)*ROR4 S3=(10*(A(15)+A(16)*TR4I)*TR2I+11*A(17)*TRI*ROR+ 1 12*A(20)*TR6I*ROR2)*ROR9 S=S1+S2+S3 S1=(2*(A(2)*TRI+A(3)*TR6I)+4*(A(6)*TRI+A(8)*TR4I)*ROR2)*ROR S2=(6*A(9)*TR4I*ROR+8*A(13)*TR6I*ROR3+9*A(14)*TRI*ROR4)*ROR4 S3=11*A(18)*TR6I*ROR10+12*A(19)*TR2I*ROR11 S1=S1+S2+S3 Y=S+S1 WA=WA+X*X/Y G07J03=SNGL(WA*R) RETURN END C G8 &&&&&& FUNCTION G08J03(VM3KG,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G08J03,VM3KG,TDGC C CV(V,T) DIMENSION A(20) C DATA A/7.974353864D-1,-1.900841429D0,-1.113118701D-1, 13.727822548D-1,2.970786824D0,-1.045640488D1,9.930766387D0, 2-2.227161050D0,-1.343481711D0,1.121225596D0,1.690410401D-1, 35.362221526D-1,-4.301837568D-1,-3.852201837D-1,8.050511470D-2, 42.497134203D-1,4.665707679D-2,-1.610467521D-1,-2.107993994D-2, 53.475784760D-2/ DATA B0,B1,B2,B3,B4/1.536686D-1,-1.166064D0,5.242538D0, 16.025346D0,-1.38925D0/ DATA R/5.583460D1/ DATA TC,ROC/3.4008D2,7.640D2/ C K KG/M3 ROR=1.0D0/(DBLE(VM3KG)*ROC) TR=(DBLE(TDGC)+2.7315D2)/TC ROR2=ROR*ROR ROR3=ROR2*ROR ROR4=ROR2*ROR2 ROR6=ROR4*ROR2 ROR7=ROR4*ROR3 ROR9=ROR6*ROR3 ROR10=ROR6*ROR4 ROR11=ROR7*ROR4 TRI=1.0D0/TR TR2I=TRI*TRI TR4I=TR2I*TR2I TR6I=TR4I*TR2I S1=-30*A(3)*TR6I*ROR-(4*A(8)*TR4I+2.4D0*A(9)*TR4I*ROR2)*ROR3 S2=-30*A(13)*TR6I*ROR7/7.0D0 S3=(-3*A(18)*TR4I*ROR3-2*A(19)*ROR4/1.1D1)*TR2I*ROR7 S=S1+S2+S3 S1=(2*A(7)/3.0D0+6*A(10)*TR4I*ROR2)*TR2I*ROR3 S2=(2*A(15)+30*A(16)*TR4I)*TR2I*ROR9/9.0D0 S3=(2*A(12)/7.0D0+30*A(20)*TR4I*ROR4/1.1D1)*TR2I*ROR7 S1=S1+S2+S3 S=S-S1 S1=B0*TR2I+B2+B3*TR+B1*TRI+B4*TR*TR-1.0 WA=S+S1 G08J03=SNGL(WA*R) RETURN END C 19 ******* FUNCTION F19J03(TDGC) DOUBLE PRECISION T,CP C C CP SAT. LIQUID(TEMP) C TK=TDGC+273.15 IF(TK.LT.172.0.OR.TK.GT.314.0) GO TO 20 T=DBLE(TK) CP=(((2.316D-9*T-2.0998D-6)*T+7.1529D-4)*T-1.06743D-1)*T+6.4727D0 F19J03=CP RETURN 20 F19J03=-1.0E20 RETURN END C 20 ******* FUNCTION F20J03(TDGC) C C CP SAT.VAPOR(TEMP) C DATA VC/0.001309/ T=TDGC+273.15 IF(ABS(T-340.08).LT.0.002) GO TO 35 C CRITICAL POINT CP=1.0E10 C IF(T.LT.160.0.OR.T.GT.340.08) GO TO 50 PBAR=F30J03(TDGC) VDD=F51J03(PBAR,TDGC) IF(VDD.LT.VC) GO TO 40 CP=G07J03(VDD,TDGC) F20J03=CP RETURN 35 F20J03=1.0E10 RETURN 40 F20J03=-1.0E10 RETURN 50 F20J03=-1.0E20 RETURN END C 21 ******** FUNCTION F21J03(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 F21J03=39.628 RETURN 20 F21J03=66.93 RETURN 30 F21J03=1.3089E-3 RETURN 40 F21J03=2.778E5 RETURN 50 F21J03=1.241E3 RETURN 60 F21J03=-1.0E20 RETURN END C 76 ******* FUNCTION F76J03(PBAR) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 20 CVDD=F78J03(TDGC) F76J03=CVDD RETURN 20 F76J03=-1.0E20 RETURN END C 77 ******* FUNCTION F77J03(PBAR,TDGC) DATA TC,VC/3.4008E2,1.3089E-3/ C C CV C T=TDGC+273.15 IF(T.LT.160.0.OR.T.GT.460.0) GO TO 50 IF(PBAR.LT.0.06897.OR.PBAR.GT.150.0) GO TO 50 C VV=F51J03(PBAR,TDGC) IF(VV.LT.-1.0E9) GO TO 40 RO=1.0/VV IF(RO.GT.600.0) GO TO 50 IF(VV.LT.VC.AND.T.LT.TC) GO TO 50 CV=G08J03(VV,TDGC) F77J03=CV RETURN 40 F77J03=VV RETURN 50 F77J03=-1.0E20 RETURN END C 78 ******* FUNCTION F78J03(TDGC) C C CV SAT.VAPOR(TEMP) C DATA VC/0.001309/ T=TDGC+273.15 IF(ABS(T-340.08).LT.0.002) GO TO 35 C CRITICAL POINT CP=1.0E10 C IF(T.LT.160.0.OR.T.GT.340.08) GO TO 50 PBAR=F30J03(TDGC) VDD=F51J03(PBAR,TDGC) IF(VDD.LT.VC) GO TO 40 CV=G08J03(VDD,TDGC) F78J03=CV RETURN 35 F78J03=1.0E10 RETURN 40 F78J03=-1.0E10 RETURN 50 F78J03=-1.0E20 RETURN END C 23 ****** FUNCTION F23J03(PBAR) C IF(PBAR.LT.0.05.OR.PBAR.GT.39.628) GO TO 20 C TSDGC=F40J03(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F27J03(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F23J03=H RETURN 15 F23J03=TSDGC RETURN 16 F23J03=H RETURN 20 F23J03=-1.0E20 RETURN END C 24 ****** FUNCTION F24J03(PBAR) C IF(PBAR.LT.0.05.OR.PBAR.GT.39.628) GO TO 20 C TSDGC=F40J03(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F28J03(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F24J03=H RETURN 15 F24J03=TSDGC RETURN 16 F24J03=H RETURN 20 F24J03=-1.0E20 RETURN END C 71 ******* FUNCTION F71J03(PBAR,S) C C H(P,S) C CALL S01J03(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.340.08) GO TO 10 PSAT=F30J03(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 10 STDD=F38J03(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 10 STD=F37J03(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=F28J03(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 HTD=F27J03(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 H=HTD*(1.0-X)+HTDD*X 10 F71J03=H RETURN 11 F71J03=PSAT RETURN 12 F71J03=STDD RETURN 13 F71J03=STD RETURN 14 F71J03=HTDD RETURN 15 F71J03=HTD RETURN 20 F71J03=TDGC RETURN 30 F71J03=-1.0E20 RETURN END C 25 ****** FUNCTION F25J03(PBAR,TDGC) C IF(PBAR.LT.0.05.OR.PBAR.GT.150.0) GO TO 20 IF(TDGC+273.15.LT.160.0.OR.TDGC+273.15.GT.460.0) GO TO 20 C VM3K=F51J03(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-340.08.GT.-273.15) GO TO 10 VTD=F53J03(TDGC) IF((VM3K-VTD)/1.309E-3.GT.1.0E-5) GO TO 10 H=G03J03(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J03=H RETURN 10 H=G02J03(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J03=H RETURN 15 F25J03=VM3K RETURN 16 F25J03=H RETURN 20 F25J03=-1.0E20 RETURN END C 26 ******* FUNCTION F26J03(PBAR,X) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 H=F29J03(TDGC,X) F26J03=H RETURN 10 F26J03=TDGC RETURN END C 27 ****** FUNCTION F27J03(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F27J03,TDGC,F51J03,G01J03,G02J03,F53J03,VTD,PST,VTDD,HTDD C DATA D1,D2,D3,D4,D5/-6.893539D0,1.75182D0,-3.82176D0,1.54196D1, 1-2.3211D1/ DATA PC,TC,ROC/3.962D1,3.4008D2,7.64D2/ C BAR K IF(TDGC+273.15.LT.167.5.OR.TDGC+273.15.GT.340.08) GO TO 20 C VTD=F53J03(TDGC) IF(VTD.LT.-1.0E9) GO TO 17 PST=G01J03(VTD,TDGC) VTDD=F51J03(PST,TDGC) HTDD=G02J03(VTDD,TDGC) IF(HTDD.LT.-1.0E9) GO TO 15 PSR=DBLE(PST)/PC TK=DBLE(TDGC)+2.7315D2 TR=TK/TC TRI=1.0D0/TR TR2I=TRI*TRI TR3I=TRI*TR2I TR4I=TR2I*TR2I TR6I=TR2I*TR4I SQR1MT=0.0D0 W=1.0D0-TR WW=W*W IF(W.GT.0.0D0) SQR1MT=DSQRT(W) HDCLP=TR*PSR*DBLE(VTDD-VTD)*ROC*(D1*TR2I+1.5D0*D2*SQR1MT+ 1(3*D3+4*D4*W+5*D5*WW)*WW) HD=DBLE(HTDD)+HDCLP*PC*1.0D5/ROC F27J03=HD RETURN 15 F27J03=HTDD RETURN 16 F27J03=VTDD RETURN 17 F27J03=VTD RETURN 20 F27J03=-1.0E20 RETURN END C 28 ****** FUNCTION F28J03(TDGC) C IF(TDGC+273.15.LT.167.5.OR.TDGC+273.15.GT.340.08) GO TO 20 C VD=F53J03(TDGC) PST=G01J03(VD,TDGC) VDD=F51J03(PST,TDGC) IF(VDD.LT.1.0E-4) GO TO 15 HDD=G02J03(VDD,TDGC) F28J03=HDD RETURN 15 F28J03=VDD RETURN 20 F28J03=-1.0E20 RETURN END C 29 ****** FUNCTION F29J03(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 HTD=F27J03(TDGC) IF(HTD.LT.-1.0E9) GO TO 20 HTDD=F28J03(TDGC) IF(HTDD.LT.-1.0E9) GO TO 10 F29J03=(1.0-X)*HTD+X*HTDD RETURN 10 F29J03=HTDD RETURN 20 F29J03=HTD RETURN 30 F29J03=-1.0E20 RETURN END C 85 ****** FUNCTION F85J03(PBAR) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 F85J03=F87J03(TDGC) RETURN 10 F85J03=TDGC RETURN END C 86 ****** FUNCTION F86J03(PBAR) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 F86J03=F88J03(TDGC) RETURN 10 F86J03=TDGC RETURN END C 81 *************** FUNCTION F81J03(PBAR,TDGC) C RELDP=PBAR/1.01325 T=TDGC+2.7315D2 IF(T.LT.2.7315.OR.T.GT.4.34D2) GO TO 50 C Y=F13J03(PBAR,TDGC) IF(Y.LT.0.0) GO TO 35 PWBAR=1.01325 VW=F51J03(PWBAR,TDGC) IF(VW.LT.1.309E-3) GO TO 50 CP=G07J03(VW,TDGC) IF(CP.LT.0.0) GO TO 40 AL=F8J03(PBAR,TDGC) IF(AL.LT.0.0) GO TO 45 F81J03=Y*CP/AL RETURN 35 F81J03=Y 40 F81J03=CP 45 F81J03=AL 50 F81J03=-1.0E20 RETURN END C 87 ****** FUNCTION F87J03(TDGC) AMUTD=F14J03(TDGC) IF(AMUTD.LT.0.0) GO TO 10 CPTD=F19J03(TDGC) IF(CPTD.LT.0.0) GO TO 20 ALMTD=F9J03(TDGC) IF(ALMTD.LT.0.0) GO TO 30 F87J03=AMUTD*CPTD/ALMTD RETURN 10 F87J03=AMUTD RETURN 20 F87J03=CPTD RETURN 30 F87J03=ALMTD RETURN END C 88 ****** FUNCTION F88J03(TDGC) AMUTDD=F15J03(TDGC) IF(AMUTDD.LT.0.0) GO TO 10 CPTDD=F20J03(TDGC) IF(CPTDD.LT.0.0) GO TO 20 ALMTDD=F10J03(TDGC) IF(ALMTDD.LT.0.0) GO TO 30 F88J03=AMUTDD*CPTDD/ALMTDD RETURN 10 F88J03=AMUTDD RETURN 20 F88J03=CPTDD RETURN 30 F88J03=ALMTDD RETURN END C 30 ****** FUNCTION F30J03(TDGC) C PS(T) SAT. PRESS (BAR) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F30J03,TDGC,TK TK=TDGC+273.15 IF(TK.LT.160.0) GO TO 20 IF(TK.LT.340.08) GO TO 5 IF(TK-340.08.GT.0.001) THEN GO TO 20 ELSE GO TO 10 END IF C 5 TR=DBLE(TK)/3.4008D2 TRI1=1.0D0-TR PRW=-6.893539D0*(1.0D0/TR-1.0)+1.75182D0*TRI1**1.5D0 1+((-2.32111D1*TRI1+1.54196D1)*TRI1-3.82176D0)*TRI1**3 PRS=DEXP(PRW) IF(PRS.GT.1.0D0) PRS=1.0D0 F30J03=PRS*3.9628D1 RETURN 10 F30J03=3.9628D1 RETURN 20 F30J03=-1.0E20 RETURN END C 31 ******* FUNCTION F31J03(PBAR) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 SIGMA=F32J03(TDGC) F31J03=SIGMA RETURN 10 F31J03=TDGC RETURN END C 32 ******* FUNCTION F32J03(TDGC) DOUBLE PRECISION TR,SIGMA,WK,T T=DBLE(TDGC)+2.7315D2 IF(T.LT.1.05D2.OR.T.GT.3.4008D2) GO TO 20 TR=T/3.4008D2 WK=1.0D0-TR IF(WK.GT.1.0D-7) GO TO 10 F32J03=0.0D0 RETURN C 10 SIGMA=5.221D1*WK**1.26D0 F32J03=SIGMA*1.0D-3 RETURN 20 F32J03=-1.0E20 RETURN END C 33 ****** FUNCTION F33J03(PBAR) C IF(PBAR.LT.0.05.OR.PBAR.GT.39.628) GO TO 20 C TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F37J03(TDGC) IF(S.LT.-1.0E9) GO TO 16 F33J03=S RETURN 15 F33J03=TDGC RETURN 16 F33J03=S RETURN 20 F33J03=-1.0E20 RETURN END C 34 ****** FUNCTION F34J03(PBAR) C IF(PBAR.LT.0.05.OR.PBAR.GT.39.628) GO TO 20 C TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F38J03(TDGC) IF(S.LT.-1.0E9) GO TO 16 F34J03=S RETURN 15 F34J03=TDGC RETURN 16 F34J03=S RETURN 20 F34J03=-1.0E20 RETURN END C 35 ****** FUNCTION F35J03(PBAR,TDGC) C IF(PBAR.LT.0.05.OR.PBAR.GT.150.0) GO TO 20 IF(TDGC+273.15.LT.160.0.OR.TDGC+273.15.GT.460.0) GO TO 20 C VM3K=F51J03(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-340.08.GT.-273.15) GO TO 10 VTD=F53J03(TDGC) IF((VM3K-VTD)/1.309E-3.GT.1.0E-5) GO TO 10 S=G06J03(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J03=S RETURN 10 S=G05J03(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J03=S RETURN 15 F35J03=VM3K RETURN 16 F35J03=S RETURN 20 F35J03=-1.0E20 RETURN END C 36 ******* FUNCTION F36J03(PBAR,X) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 S=F39J03(TDGC,X) F36J03=S RETURN 10 F36J03=TDGC RETURN END C 37 ****** FUNCTION F37J03(TDGC) VTD=F53J03(TDGC) IF(VTD.LT.-1.0E9) GO TO 20 STD=G06J03(VTD,TDGC) IF(STD.LT.-1.0E9) GO TO 20 F37J03=STD RETURN 20 F37J03=-1.0E20 RETURN END C 38 ****** FUNCTION F38J03(TDGC) C IF(TDGC+273.15.LT.167.5.OR.TDGC+273.15.GT.340.08) GO TO 20 C VD=F53J03(TDGC) PST=G01J03(VD,TDGC) VDD=F51J03(PST,TDGC) IF(VDD.LT.1.0E-4) GO TO 15 SDD=G05J03(VDD,TDGC) F38J03=SDD RETURN 15 F38J03=VDD RETURN 20 F38J03=-1.0E20 RETURN END C 39 ******* FUNCTION F39J03(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 STD=F37J03(TDGC) IF(STD.LT.-1.0E9) GO TO 20 STDD=F38J03(TDGC) IF(STDD.LT.-1.0E9) GO TO 10 F39J03=(1.0-X)*STD+X*STDD RETURN 10 F39J03=STDD RETURN 20 F39J03=STD RETURN 30 F39J03=-1.0E20 RETURN END C 2 &&&&&& FUNCTION G02J03(VM3KG,TDGC) C C H(V,T) VAPOR C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G02J03,VM3KG,TDGC DIMENSION A(20) C DATA A/7.974353864D-1,-1.900841429D0,-1.113118701D-1, 13.727822548D-1,2.970786824D0,-1.045640488D1,9.930766387D0, 2-2.227161050D0,-1.343481711D0,1.121225596D0,1.690410401D-1, 35.362221526D-1,-4.301837568D-1,-3.852201837D-1,8.050511470D-2, 42.497134203D-1,4.665707679D-2,-1.610467521D-1,-2.107993994D-2, 53.475784760D-2/ DATA B0,B1,B2,B3,B4/1.536686D-1,-1.166064D0,5.242538D0, 16.025346D0,-1.38925D0/ DATA C0/2.882710371D5/ DATA R/5.583460D1/ DATA TC,ROC/3.4008D2,7.640D2/ C K KG/M3 C IF(VM3KG.LT.0.000599.OR.VM3KG.GT.18.65) GO TO 50 ROR=1.0D0/(DBLE(VM3KG)*ROC) TR=(DBLE(TDGC)+2.7315D2)/TC T0=2.7315D2/TC T0I=1.0D0/T0 ROR2=ROR*ROR ROR3=ROR2*ROR ROR4=ROR2*ROR2 ROR8=ROR4*ROR4 ROR10=ROR2*ROR8 TRI=1.0D0/TR TR2I=TRI*TRI TR4I=TR2I*TR2I TR6I=TR4I*TR2I H1=1.0D0+(A(1)+A(4)*ROR)*ROR H2=(A(5)+5*A(7)*TR2I/3.0D0)*ROR3 H3=(11*A(10)*TR6I*ROR/5.0D0+A(11)*ROR2+9*A(12)*TR2I*ROR3/7.0D0) 1*ROR4 H4=((11*A(15)+15*A(16)*TR4I)*TR2I*ROR/9.0+11*A(17)*TRI*ROR2 2*1.0D-1+17*A(20)*TR6I*ROR3/1.1D1)*ROR8 H=(H1+H2+H3+H4)*TR H1=-B0*(TRI-T0I)+(B2-1.0D0+B3*5.0D-1*(TR+T0))*(TR-T0) H=(H+H1)*R*TC+C0 C H1=(2*A(2)*TRI+7*A(3)*TR6I)*ROR H2=(4*A(6)*TRI+7*A(8)*TR4I)*ROR3/3.0D0 H3=(9*A(9)*ROR/5.0D0+13*A(13)*TR2I*ROR3/7.0D0)*TR4I*ROR4 H4=9*A(14)*ROR8/(8*TR)+(16*A(18)*TR4I*1.0D-1+13*A(19)*ROR/1.1D1) 1*TR2I*ROR10 H1=(H1+H2+H3+H4)*TR H2=B1*DLOG(TR/T0)+B4*(TR*TR+TR*T0+T0*T0)*(TR-T0)/3.0D0 H=H+(H1+H2)*R*TC G02J03=H RETURN END C 3 &&&&&& FUNCTION G03J03(VM3KG,TDGC) C C H(V,T) LIQUID C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G03J03,VM3KG,TDGC,VD,VDD,PST,HDD REAL G01J03,G02J03,F51J03,F53J03 DIMENSION A(20) C DATA A/7.974353864D-1,-1.900841429D0,-1.113118701D-1, 13.727822548D-1,2.970786824D0,-1.045640488D1,9.930766387D0, 2-2.227161050D0,-1.343481711D0,1.121225596D0,1.690410401D-1, 35.362221526D-1,-4.301837568D-1,-3.852201837D-1,8.050511470D-2, 42.497134203D-1,4.665707679D-2,-1.610467521D-1,-2.107993994D-2, 53.475784760D-2/ DATA D1,D2,D3,D4,D5/-6.893539D0,1.75182D0,-3.82176D0,1.54196D1, 1-2.3211D1/ DATA ZC/2.731645D-1/ DATA TC,ROC,PC/3.4008D2,7.640D2,3.9628D1/ C K KG/M3 BAR C VD=F53J03(TDGC) PST=G01J03(VD,TDGC) VDD=F51J03(PST,TDGC) HDD=G02J03(VDD,TDGC) PSR=DBLE(PST)/PC TK=DBLE(TDGC)+2.7315D2 TR=TK/TC TRI=1.0D0/TR TR2I=TRI*TRI TR3I=TRI*TR2I TR4I=TR2I*TR2I TR6I=TR2I*TR4I SQR1MT=0.0D0 W=1.0D0-TR WW=W*W IF(W.GT.0.0D0) SQR1MT=DSQRT(W) HDCLP=TR*PSR*DBLE(VDD-VD)*ROC*(D1*TR2I+1.5D0*D2*SQR1MT+ 1(3*D3+4*D4*W+5*D5*WW)*WW) HD=DBLE(HDD)+HDCLP*PC*1.0D5/ROC C ROR=1.0D0/(DBLE(VM3KG)*ROC) RODR=1.0D0/(DBLE(VD)*ROC) RW=RODR RR1=ROR+RODR RW=RW*RODR RR2=RR1*ROR+RW RW=RW*RODR RR3=RR2*ROR+RW RW=RW*RODR RR4=RR3*ROR+RW RW=RW*RODR RR5=RR4*ROR+RW RW=RW*RODR RR6=RR5*ROR+RW RW=RW*RODR RR7=RR6*ROR+RW RW=RW*RODR RR8=RR7*ROR+RW RW=RW*RODR RR9=RR8*ROR+RW RW=RW*RODR RR10=RR9*ROR+RW C H1=A(1)+2*A(2)*TRI+7*A(3)*TR6I+A(4)*RR1+A(5)*RR2 H2=((4*A(6)+5*A(7)*TRI)*TRI+7*A(8)*TR4I)*RR2/3.0D0 H3=(9*A(9)+11*A(10)*TR2I)*TR4I*RR4*2.0D-1+A(11)*RR5 H4=(9*A(12)+13*A(13)*TR4I)*TR2I*RR6/7.0D0+9*A(14)*RR7*TRI/8.0D0 H5=(11*A(15)+15*A(16)*TR4I)*TR2I*RR8/9.0D0 H6=(11*A(17)*TRI+16*A(18)*TR6I)*RR9*1.0D-1 H7=(13*A(19)+17*A(20)*TR4I)*TR2I*RR10/1.1D1 H1=H1+H2+H3+H4+H5+H6+H7 G03J03=HD+(ROR-RODR)*H1*1.0D5*PC*TR/(ROC*ZC) RETURN END C 5 &&&&&& FUNCTION G05J03(VM3KG,TDGC) C C S(V,T) VAPOR C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G05J03,VM3KG,TDGC C DIMENSION A(20) C DATA A/7.974353864D-1,-1.900841429D0,-1.113118701D-1, 13.727822548D-1,2.970786824D0,-1.045640488D1,9.930766387D0, 2-2.227161050D0,-1.343481711D0,1.121225596D0,1.690410401D-1, 35.362221526D-1,-4.301837568D-1,-3.852201837D-1,8.050511470D-2, 42.497134203D-1,4.665707679D-2,-1.610467521D-1,-2.107993994D-2, 53.475784760D-2/ DATA B0,B1,B2,B3,B4/1.536686D-1,-1.166064D0,5.242538D0, 16.025346D0,-1.38925D0/ DATA C1/1.223634208D3/ DATA R/5.583460D1/ DATA TC,ROC/3.4008D2,7.640D2/ C K KG/M3 C IF(VM3KG.LT.0.000599.OR.VM3KG.GT.18.65) GO TO 50 ROR=1.0D0/(DBLE(VM3KG)*ROC) TR=(DBLE(TDGC)+2.7315D2)/TC T0=2.7315D2/TC T0I=1.0D0/T0 ROR2=ROR*ROR ROR3=ROR2*ROR ROR4=ROR2*ROR2 ROR6=ROR4*ROR2 ROR7=ROR4*ROR3 ROR9=ROR6*ROR3 TRI=1.0D0/TR TR2I=TRI*TRI TR4I=TR2I*TR2I TR6I=TR4I*TR2I S1=DLOG(ROR)+(A(1)-5*A(3)*TR6I+5.0D-1*A(4)*ROR)*ROR S2=(A(5)/3.0D0-A(8)*TR4I-3*A(9)*TR4I*ROR2/5.0D0)*ROR3 S3=(A(11)/6.0D0-5*A(13)*TR6I*ROR/7.0D0)*ROR6 S4=(A(18)*TR4I*ROR3*5.0D-1+A(19)*ROR4/1.1D1)*TR2I*ROR7 S=S1+S2+S3-S4 S1=(A(7)/3.0D0+A(10)*TR4I*ROR2)*TR2I*ROR3 S2=(A(15)+5*A(16)*TR4I)*TR2I*ROR9/9.0D0 S3=(A(12)/7.0D0+5*A(20)*TR4I*ROR4/1.1D1)*TR2I*ROR7 S=S-S1-S2-S3 S1=(B0*(TRI+T0I)*5.0D-1+B1)*(TRI-T0I) S2=(B2-1.0D0)*DLOG(TR/T0)+(B3+B4*5.0D-1*(TR+T0))*(TR-T0) S=S+S1-S2 S=-S*R+C1 G05J03=S RETURN END C 6 &&&&&& FUNCTION G06J03(VM3KG,TDGC) C C S(V,T) LIQUID C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G06J03,VM3KG,TDGC,VD,VDD,PST,SDD REAL F53J03,G01J03,G05J03,F51J03 C DIMENSION A(20) C DATA A/7.974353864D-1,-1.900841429D0,-1.113118701D-1, 13.727822548D-1,2.970786824D0,-1.045640488D1,9.930766387D0, 2-2.227161050D0,-1.343481711D0,1.121225596D0,1.690410401D-1, 35.362221526D-1,-4.301837568D-1,-3.852201837D-1,8.050511470D-2, 42.497134203D-1,4.665707679D-2,-1.610467521D-1,-2.107993994D-2, 53.475784760D-2/ DATA D1,D2,D3,D4,D5/-6.893539D0,1.75182D0,-3.82176D0,1.54196D1, 1-2.3211D1/ DATA R/5.583460D1/ DATA TC,ROC,PC/3.4008D2,7.640D2,3.9628D1/ C K KG/M3 BAR C IF(VM3KG.LT.0.000599.OR.VM3KG.GT.18.65) GO TO 50 RO=1.0D0/DBLE(VM3KG) TK=DBLE(TDGC)+2.7315D2 ROR=RO/ROC TR=TK/TC T0=2.7315D2/TC ROR2=ROR*ROR ROR3=ROR2*ROR ROR4=ROR2*ROR2 ROR5=ROR3*ROR2 ROR6=ROR3*ROR3 ROR7=ROR4*ROR3 ROR8=ROR4*ROR4 ROR9=ROR5*ROR4 ROR10=ROR5*ROR5 ROR11=ROR8*ROR3 TR2=TR*TR TR2I=1.0D0/TR2 TR4I=TR2I*TR2I TR6I=TR4I*TR2I TR3=TR2*TR VD=F53J03(TDGC) PST=G01J03(VD,TDGC) VDD=F51J03(PST,TDGC) SDD=G05J03(VDD,TDGC) PSR=DBLE(PST)/PC RODR=1.0D0/(DBLE(VD)*ROC) RODR2=RODR*RODR RODR3=RODR*RODR2 RODR4=RODR2*RODR2 RODR5=RODR2*RODR3 RODR6=RODR3*RODR3 RODR7=RODR4*RODR3 RODR8=RODR4*RODR4 RODR10=RODR5*RODR5 RODR11=RODR8*RODR3 RODR9=RODR4*RODR5 SQR1MT=0.0D0 W=1.0D0-TR WW=W*W IF(W.GT.0.0D0) SQR1MT=DSQRT(W) SDCLP=PSR*DBLE(VDD-VD)*ROC*(D1*TR2I+1.5D0*D2*SQR1MT+(3*D3+4*D4*W 1+5*D5*WW)*WW) SD=DBLE(SDD)+SDCLP*PC*1.0D5/(ROC*TC) S1=DLOG(ROR/RODR)+(A(1)-5*A(3)*TR6I+5.0D-1*A(4)*(ROR+RODR))* 1(ROR-RODR) S2=(A(5)-A(7)*TR2I-3*A(8)*TR4I)*(ROR3-RODR3)/3.0D0-(3*A(9)*TR4I+ 15*A(10)*TR6I)*(ROR5-RODR5)/5.0D0 S3=A(11)*(ROR6-RODR6)/6.0D0-(A(12)*TR2I+5*A(13)*TR6I)* 1(ROR7-RODR7)/7.0D0 S4=(A(15)*TR2I+5*A(16)*TR6I)*(ROR9-RODR9)/9.0D0+A(18)*TR6I*5.0D-1 1*(ROR10-RODR10)+(A(19)*TR2I+5*A(20)*TR6I)*(ROR11-RODR11)/1.1D1 S=S1+S2+S3-S4 S=-R*S+SD G06J03=S RETURN END C 64 ******* FUNCTION F64J03(PBAR0,H) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F64J03,TDGC,HW,TMAX,TMIN,HDP,HDDP,HX,H1,H2,TSP,VX,TWH REAL PBAR0,H,G02J03,G03J03,F40J03,F51J03 REAL F53J03,F54J03,TLC,TCC,VDP,VDDP,VDPMAX,VCM3K REAL F27J03,G21J03 C DATA HC/2.7781D5/ DATA PCBAR,TCK,ROCKM3/3.9628D1,3.4008D2,7.64D2/ 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.19.0) GO TO 40 TLC=330.1-273.15 IF(H.LT.1.20E5.OR.H.GT.4.0E5) GO TO 40 IF(ABS(PBAR0-39.628).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=340.08-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=F40J03(PBAR0) TSP=TDGC C IF(TDGC.LT.-106.15) GO TO 40 C -106.15=167.0-273.15 C HDP=F27J03(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=F53J03(TMAX) TSP=(TMAX-TLC)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J03(TDGC) HDP=G03J03(VDP,TDGC) IF(HDP.LT.H) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J03(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.1.0E-4) VX=VDP HX=G03J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 71 HX=G03J03(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=F53J03(TLC) HDP=G03J03(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)+333.0-273.15 ELSE TMIN=5.4*(PBAR0-100.0)+333.0-273.15 END IF C END IF C****************** TMAX=460.0-273.15 VX=F51J03(PBAR0,TMIN) IF(VX.LT.1.0E-4.OR.VX.GT.10.0) THEN GO TO 81 END IF C C HX=G03J03(VX,TMIN) C**************** IF(TMIN+273.15.LT.TCK) THEN HX=G03J03(VX,TMIN) ELSE HX=G02J03(VX,TMIN) END IF C***************** IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 32 CC IF(HX.GT.H) THEN C**************** C IF(TMIN.LT.333.001-273.15) THEN C TDGC=333.0 C VX=F51J03(PBAR0,TDGC) C HX=G03J03(VX,TDGC) C IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 C IF(HX.GT.H) GO TO 40 C TLC=TDGC C END IF CC END IF TDGC=SNGL(TCK)-273.15 VX=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) THEN GO TO 81 END IF HX=G02J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 82 IF(VX.GT.10.0) GO TO 82 HX=G03J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 IF(VX.GT.10.0) GO TO 50 HX=G03J03(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=F53J03(TDGC) HDP=G03J03(VDP,TDGC) IF(HDP.GT.H) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN HX=G02J03(VX,TDGC) ELSE HX=G03J03(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=G03J03(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=F51J03(PBAR0,TDGC) HX=G03J03(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=F51J03(PBAR0,TDGC) HX=G02J03(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) +333.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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 HX=G02J03(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=F54J03(TDGC) IF(VDDP.LT.1.0E-4) GO TO 50 HDDP=G02J03(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=F51J03(PBAR0,TMIN) IF(VX.LT.1.0E-4) THEN TMIN=333.0-273.15 VX=F51J03(PBAR0,TMIN) IF(VX.LT.1.0E-4) GO TO 40 END IF HX=G03J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.E-4) GO TO 131 H2=G03J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 141 IF(VX.GT.10.0) GO TO 141 HX=G02J03(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=F51J03(PBAR0,TMIN) H1=G21J03(VX,TMIN,TCC,ICASE,VDPMAX) VX=F51J03(PBAR0,TMAX) H2=G21J03(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=F51J03(PBAR0,TDGC) HX=G21J03(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=F51J03(PBAR0,TDGC) HX=G21J03(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=F51J03(PBAR0,TMIN) H1=G21J03(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=F51J03(PBAR0,TDGC) HX=G21J03(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=F51J03(PBAR0,TDGC) HX=G21J03(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=F51J03(PBAR0,TDGC) HX=G21J03(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=F51J03(PBAR0,TDGC) HX=G21J03(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=F51J03(PBAR0,TMAX) H2=G21J03(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=F51J03(PBAR0,TDGC) HX=G21J03(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=F51J03(PBAR0,TDGC) HX=G21J03(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=F51J03(PBAR0,TDGC) HW=G21J03(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 F64J03=TDGC RETURN 31 F64J03=TMAX RETURN 32 F64J03=TMIN RETURN 40 F64J03=-1.0E20 RETURN 50 F64J03=-1.0E10 RETURN END C G31 FUNCTION G21J03(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=F53J03(TDGC) GO TO 30 C C ICASE=2 5 IF(TDGC.LT.TCC) GO TO 30 10 G21J03=G02J03(VX,TDGC) RETURN 30 G21J03=G03J03(VX,TDGC) RETURN END C S01 ******* SUBROUTINE S01J03(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,G05J03,G06J03,F40J03,F51J03 REAL F53J03,F54J03,TLC,TCC,VDP,VDDP,VDPMAX,VCM3K REAL F37J03,G31J03,VM3K,TEMPC,H,G02J03,G03J03 C DATA SC/1.24125D3/ DATA PCBAR,TCK,ROCKM3/3.9628D1,3.4008D2,7.64D2/ 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.19.0) GO TO 40 TLC=330.1-273.15 IF(S.LT.3.0E2.OR.S.GT.2.0E3) GO TO 40 IF(ABS(PBAR0-39.628).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=340.08-273.15 VX=1.309E-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=F40J03(PBAR0) TSP=TDGC C IF(TDGC.LT.-106.15) GO TO 40 C -106.15=167.0-273.15 C SDP=F37J03(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=F53J03(TMAX) TSP=(TMAX-TLC)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J03(TDGC) SDP=G06J03(VDP,TDGC) IF(SDP.LT.S) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J03(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.1.0E-4) VX=VDP SX=G06J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 71 SX=G06J03(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=F53J03(TLC) SDP=G06J03(VDP,TLC) IF(SDP.LT.S) 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)+333.0-273.15 ELSE TMIN=5.4*(PBAR0-100.0)+333.0-273.15 END IF C END IF C****************** TMAX=460.0-273.15 VX=F51J03(PBAR0,TMIN) IF(VX.LT.1.0E-4.OR.VX.GT.10.0) THEN GO TO 81 END IF C C SX=G06J03(VX,TMIN) C**************** IF(TMIN+273.15.LT.TCK) THEN SX=G06J03(VX,TMIN) ELSE SX=G05J03(VX,TMIN) END IF C***************** IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 CC IF(SX.GT.S) THEN C**************** C IF(TMIN.LT.333.001-273.15) THEN C TDGC=333.0 C VX=F51J03(PBAR0,TDGC) C SX=G06J03(VX,TDGC) C IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 C IF(SX.GT.S) GO TO 40 C TLC=TDGC C END IF CC END IF TDGC=SNGL(TCK)-273.15 VX=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) THEN GO TO 81 END IF SX=G05J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 82 IF(VX.GT.10.0) GO TO 82 SX=G06J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 IF(VX.GT.10.0) GO TO 50 SX=G06J03(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=F53J03(TDGC) SDP=G06J03(VDP,TDGC) IF(SDP.GT.S) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN SX=G05J03(VX,TDGC) ELSE SX=G06J03(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=G06J03(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=F51J03(PBAR0,TDGC) SX=G06J03(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=F51J03(PBAR0,TDGC) SX=G05J03(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) +333.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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 SX=G05J03(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=F54J03(TDGC) IF(VDDP.LT.1.0E-4) GO TO 50 SDDP=G05J03(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=F51J03(PBAR0,TMIN) IF(VX.LT.1.0E-4) THEN TMIN=333.0-273.15 VX=F51J03(PBAR0,TMIN) IF(VX.LT.1.0E-4) GO TO 40 END IF SX=G06J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.E-4) GO TO 131 S2=G06J03(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=F51J03(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 141 IF(VX.GT.10.0) GO TO 141 SX=G05J03(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=F51J03(PBAR0,TMIN) S1=G31J03(VX,TMIN,TCC,ICASE,VDPMAX) VX=F51J03(PBAR0,TMAX) S2=G31J03(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=F51J03(PBAR0,TDGC) SX=G31J03(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=F51J03(PBAR0,TDGC) SX=G31J03(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=F51J03(PBAR0,TMIN) S1=G31J03(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=F51J03(PBAR0,TDGC) SX=G31J03(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=F51J03(PBAR0,TDGC) SX=G31J03(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=F51J03(PBAR0,TDGC) SX=G31J03(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=F51J03(PBAR0,TDGC) SX=G31J03(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=F51J03(PBAR0,TMAX) S2=G31J03(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=F51J03(PBAR0,TDGC) SX=G31J03(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=F51J03(PBAR0,TDGC) SX=G31J03(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=F51J03(PBAR0,TDGC) SW=G31J03(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=F51J03(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=G03J03(VX,TDGC) ELSE H=G02J03(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 G31J03(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=F53J03(TDGC) GO TO 30 C C ICASE=2 5 IF(TDGC.LT.TCC) GO TO 30 10 G31J03=G05J03(VX,TDGC) RETURN 30 G31J03=G06J03(VX,TDGC) RETURN END C 65 FUNCTION F65J03(PBAR0,S) C C G05(V,T)=S VAPOR G06(V,T)=S LIQUID C S.GT.SC S.LT.SC C CALL S01J03(PBAR0,S,VM3K,TDGC,H) F65J03=TDGC RETURN END C 70 ******* FUNCTION F70J03(PBAR,VM3K) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F70J03,PBAR,TDGC,VM3K,PW,TMAX,TMIN,VDP,VDDP,PX,P1,P2,TSP REAL G01J03,F40J03,F53J03,F54J03,F30J03,PST333,VCM3K C DATA PCBAR,TCK,ROCKM3/3.9628D1,3.4008D2,7.64D2/ C IF(PBAR.LT.0.05.OR.PBAR.GT.150.001) GO TO 40 IF(VM3K.LT.4.5E-4.OR.VM3K.GT.5.0) GO TO 40 IF(ABS(PBAR-39.628).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=340.08-273.15 GO TO 30 C 5 IF(PBAR/PCBAR-1.0.GT.-1.0E-6) GO TO 6 TDGC=F40J03(PBAR) TSP=TDGC IF(TDGC.LT.-106.15) GO TO 40 C -106.15=167.0-273.15 C VDP=F53J03(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 PST333=F30J03(333.0-273.15) IF(PBAR/PST333-1.0.LT.-1.0E-6) GO TO 40 C TMIN=333.0-273.15 TDGC=TMIN PX=G01J03(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=333.0-273.15 TMAX=460.1-273.15 PX=G01J03(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=460.1-273.15 ICASE=3 GO TO 15 C 10 VDDP=F54J03(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=460.1-273.15 ICASE=4 C 15 IF(TMIN.GT.TMAX) THEN TDGC=TMIN TMIN=TMAX TMAX=TDGC ELSE TMIN=TMIN END IF P1=G01J03(VM3K,TMIN) P2=G01J03(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=G01J03(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=G01J03(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=G01J03(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=G01J03(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=G01J03(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=G01J03(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=G01J03(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=G01J03(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=G01J03(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=G01J03(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=G01J03(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 F70J03=TDGC RETURN 31 F70J03=TMAX RETURN 32 F70J03=TMIN RETURN 40 F70J03=-1.0E20 RETURN 50 F70J03=-1.0E10 RETURN END C 40 ******** FUNCTION F40J03(PBAR) DOUBLE PRECISION DPSDTR C C IF(PBAR.LT.0.02.OR.PBAR.GT.40.65005) GO TO 40 TMIN=160.0-273.15 TMAX=340.08-273.15 PRI=F30J03(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=F30J03(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 C PMPAW=PBAR*0.1 PMPA=PMPAW PMPAW=ALOG(PMPAW) TSRW=(0.0065669*PMPAW+0.13007)*PMPAW-0.19443 TSRW=EXP(TSRW)*340.08-273.15 WTMIN=TSRW-1.15 WTMAX=TSRW+1.15 IF(TMAX.GT.WTMAX) TMAX=WTMAX IF(TMIN.LT.WTMIN) TMIN=WTMIN TDGC=(TMAX+TMIN)*0.5 C IC=0 4 IC=IC+1 TDGC=(TMAX+TMIN)*0.5 TR=(TDGC+273.15)/340.08 IF(IC.GT.15) GO TO 10 PRI=F30J03(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=F30J03(TMAX) PL=F30J03(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)/39.628 TR=(TDGC+273.15)/340.08 TR2=TR*TR TR1=1.0-TR IF(TR1.LT.0.0) TR1=0.0 SQTR1=SQRT(TR1) C DPSDTR STAND FOR DPSR/DTR DPSDTR=-6.893539D0/TR2+2.62773D0*SQTR1 DPSDTR=DPSDTR+((-1.160555D2*TR1+6.16784D1)*TR-9.6528D0)*TR2 DPSDTR=-PRI*DPSDTR/3.9628D2 IF(DABS(DPSDTR).LT.1.0D-6) GO TO 20 C TR=TR-DPRW/DPSDTR 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=F30J03(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=F30J03(TDGC) IF((PRI-PBAR)*(PL-PBAR).GT.0.0) THEN PL=PRI TMIN=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=F30J03(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=F30J03(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=F30J03(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 F40J03=-1.0E10 RETURN 40 F40J03=-1.0E20 RETURN 49 TDGC=PRI 50 F40J03=TDGC RETURN END C 42 ******* FUNCTION F42J03(PBAR) C C U=H-PV (SAT. LIQUID) C TSDGC=F40J03(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HD=F27J03(TSDGC) IF(HD.LT.-1.0E9) GO TO 20 VD=F53J03(TSDGC) IF(VD.LT.-1.0E9) GO TO 10 U=HD-PBAR*VD*1.0E5 F42J03=U RETURN 10 F42J03=VD RETURN 20 F42J03=HD RETURN 30 F42J03=TSDGC RETURN END C 43 ******* FUNCTION F43J03(PBAR) C C U=H-PV (SAT. VAPOR) C TSDGC=F40J03(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HDD=F28J03(TSDGC) IF(HDD.LT.-1.0E9) GO TO 20 VDD=F54J03(TSDGC) IF(VDD.LT.-1.0E9) GO TO 10 U=HDD-PBAR*VDD*1.0E5 F43J03=U RETURN 10 F43J03=VDD RETURN 20 F43J03=HDD RETURN 30 F43J03=TSDGC RETURN END C 79 ******* FUNCTION F79J03(PBAR,S) C C U(P,S) U=H-PV C CALL S01J03(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.340.08) GO TO 40 PSAT=F30J03(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 40 STDD=F38J03(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 40 STD=F37J03(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=F28J03(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 VTDD=F54J03(TDGC) IF(VTDD.LT.-1.0E9) GO TO 16 HTD=F27J03(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 VTD=F53J03(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 F79J03=H C WRITE(6,210) H C 210 FORMAT(1H ,42X,'RTN FROM 10 H=',E12.4) RETURN 11 F79J03=PSAT C WRITE(6,211) PSAT C 211 FORMAT(1H ,42X,'RTN FROM 11 PSAT=',E12.4) RETURN 12 F79J03=STDD C WRITE(6,212) STDD C 212 FORMAT(1H ,42X,'RTN FROM 12 STDD=',E12.4) RETURN 13 F79J03=STD C WRITE(6,213) STD C 213 FORMAT(1H ,42X,'RTN FROM 13 STD=',E12.4) RETURN 14 F79J03=HTDD C WRITE(6,214) HTDD C 214 FORMAT(1H ,42X,'RTN FROM 14 HTDD=',E12.4) RETURN 15 F79J03=HTD C WRITE(6,215) HTD C 215 FORMAT(1H ,42X,'RTN FROM 15 HTD=',E12.4) RETURN 16 F79J03=VTDD C WRITE(6,216) VTDD C 216 FORMAT(1H ,42X,'RTN FROM 16 VTDD=',E12.4) RETURN 17 F79J03=VTD C WRITE(6,217) VTD C 217 FORMAT(1H ,42X,'RTN FROM 17 VTD=',E12.4) RETURN 20 F79J03=TDGC C WRITE(6,220) TDGC C 220 FORMAT(1H ,42X,'RTN FROM 20 TDGC=',E12.4) RETURN 30 F79J03=-1.0E20 RETURN 40 F79J03=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 F44J03(PBAR,TDGC) C C U=H-PV C V=F51J03(PBAR,TDGC) IF(V.LT.-1.0E9) GO TO 20 IF(TDGC-340.08.GT.-273.15) GO TO 4 VTD=F53J03(TDGC) IF((V-VTD)/1.309E-3.LT.1.0E-5) GO TO 5 4 H=G02J03(V,TDGC) GO TO 6 5 H=G03J03(V,TDGC) 6 IF(H.LT.-1.0E9) GO TO 10 U=H-PBAR*V*1.0E5 F44J03=U RETURN 10 F44J03=H RETURN 20 F44J03=V RETURN END C 45 ******* FUNCTION F45J03(PBAR,X) C C U=H-PV C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F42J03(PBAR) IF(UD.LT.-1.0E9) GO TO 20 UDD=F43J03(PBAR) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F45J03=U RETURN 10 F45J03=UDD RETURN 20 F45J03=UD RETURN 30 F45J03=-1.0E20 RETURN END C 46 ******* FUNCTION F46J03(TDGC) C C U=H-PV (SAT. LIQUID C HD=F27J03(TDGC) IF(HD.LT.-1.0E9) GO TO 30 VD=F53J03(TDGC) IF(VD.LT.-1.0E9) GO TO 20 PST=F30J03(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HD-PST*VD*1.0E5 F46J03=U RETURN 10 F46J03=PST RETURN 20 F46J03=VD RETURN 30 F46J03=HD RETURN END C 47 ******* FUNCTION F47J03(TDGC) C C U=H-PV (SAT. VAPOR) C HDD=F28J03(TDGC) IF(HDD.LT.-1.0E9) GO TO 30 VDD=F54J03(TDGC) IF(VDD.LT.-1.0E9) GO TO 20 PST=F30J03(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HDD-PST*VDD*1.0E5 F47J03=U RETURN 10 F47J03=PST RETURN 20 F47J03=VDD RETURN 30 F47J03=HDD RETURN END C 48 ******* FUNCTION F48J03(TDGC,X) C C U=H-PV (SAT. LIQUID) C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F46J03(TDGC) IF(UD.LT.-1.0E9) GO TO 20 UDD=F47J03(TDGC) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F48J03=U RETURN 10 F48J03=UDD RETURN 20 F48J03=UD RETURN 30 F48J03=-1.0E20 RETURN END C 1 &&&&&& FUNCTION G01J03(VM3KG,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3KG,TDGC,G01J03,F53J03,F30J03,VV,PRSBAR DIMENSION A(20) C DATA A/7.974353864D-1,-1.900841429D0,-1.113118701D-1, 13.727822548D-1,2.970786824D0,-1.045640488D1,9.930766387D0, 2-2.227161050D0,-1.343481711D0,1.121225596D0,1.690410401D-1, 35.362221526D-1,-4.301837568D-1,-3.852201837D-1,8.050511470D-2, 42.497134203D-1,4.665707679D-2,-1.610467521D-1,-2.107993994D-2, 53.475784760D-2/ DATA ZC/2.731645D-1/ DATA TC,ROC,PC/3.4008D2,7.640D2,3.9628D1/ C K KG/M3 BAR C IF(VM3KG.LT.0.000599.OR.VM3KG.GT.18.65) GO TO 50 RO=1.0D0/DBLE(VM3KG) TK=DBLE(TDGC)+2.7315D2 C**** IF(TK.LT.1.59D2.OR.TK.GT.4.6001D2) 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.3.32399D2) GO TO 10 IF(RO.LT.ROC) GO TO 10 C VV=F53J03(TDGC) IF(VV.LT.-1.0E19) GO TO 19 IF((VM3KG-VV)/VV.LT.-1.0E-4) GO TO 50 G01J03=F30J03(TDGC) RETURN 10 ROR=RO/ROC TR=TK/TC TR2=TR*TR TRM2=1.0D0/TR2 TRM4=TRM2*TRM2 TRM6=TRM2*TRM4 TRI=1.0/TR ROR2=ROR*ROR ROR3=ROR2*ROR ROR5=ROR2*ROR3 ROR6=ROR3*ROR3 ROR7=ROR6*ROR ROR8=ROR6*ROR2 ROR9=ROR6*ROR3 ROR10=ROR5*ROR5 ROR11=ROR6*ROR5 C Z1=1.0D0+(A(1)+A(2)*TRI+A(3)*TRM6)*ROR+A(4)*ROR2 Z2=(A(5)+A(6)*TRI+A(7)*TRM2+A(8)*TRM4)*ROR3+ 1(A(9)*TRM4+A(10)*TRM6)*ROR5 Z=Z1+Z2+A(11)*ROR6+(A(12)*TRM2+A(13)*TRM6)*ROR7 Z1=A(14)*TRI*ROR8+(A(15)*TRM2+A(16)*TRM6)*ROR9 Z2=(A(17)*TRI+A(18)*TRM6)*ROR10+(A(19)*TRM2+A(20)*TRM6)*ROR11 Z=Z+Z1+Z2 PRSBAR=Z*PC*TR*ROR/ZC C BAR C IF(VM3KG.LT.8.63E-4.AND.TDGC.GT.56.849) GO TO 18 C C IF(PRSBAR.GT.160.001) GO TO 50 18 G01J03=PRSBAR RETURN 19 G01J03=VV RETURN 30 G01J03=PC RETURN 50 G01J03=-1.0E20 RETURN END C 49 ****** FUNCTION F49J03(PBAR) C C SAT. VD(P) VPD SAT. LIQUID SPECFIC VOL.(PRESS) C IF(PBAR.LT.0.05.OR.PBAR.GT.39.628) GO TO 20 C TDGC=F40J03(PBAR) VSM3K=TDGC IF(TDGC.LT.-1.0E9) GO TO 15 VSM3K=F53J03(TDGC) 15 F49J03=VSM3K RETURN 20 F49J03=-1.0E20 RETURN END C 50 ****** FUNCTION F50J03(PBAR) C C SAT. VDD(P) VPDD SAT. SPECIFIC VOL.(PRESS) C IF(PBAR.LT.0.05.OR.PBAR.GT.39.628) GO TO 20 C TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 VSM3K=F54J03(TDGC) F50J03=VSM3K RETURN 15 F50J03=TDGC RETURN 20 F50J03=-1.0E20 RETURN END C 80 ****** FUNCTION F80J03(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 S01J03(PBAR0,S,VX,TDGC,H) IF(VX.LT.1.0E-4) GO TO 10 IF(PBAR0.GT.39.628) GO TO 10 PST=F30J03(PBAR0) IF(ABS((PST-PBAR0)/PBAR0).LT.1.0E-5) GO TO 35 10 F80J03=VX RETURN 35 STD=F37J03(TDGC) STDD=F38J03(TDGC) VTD=F53J03(TDGC) VTDD=F54J03(TDGC) SX=(S-STD)/(STDD-STD) VX=VTD+(VTDD-VTD)*SX F80J03=VX RETURN END C 51 ******** FUNCTION F51J03(PBAR,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J03,F51J03,PBAR,TDGC,VNL,VXL,V1,V2,P1,P2 REAL PST,F53J03,F54J03,VMIN,VMAX,PX,PW,VW REAL VM3KC,PCBAR,RGSC DATA VM3KC,TCK,PCBAR,RGSC/1.309E-3,3.4008D2,39.628,5.8346E-2/ C CHK RANGE PBAR,TDGC C IF(PBAR.LT.1.99999E-3.OR.PBAR.GT.1.60001E2) GO TO 70 TK=TDGC+2.7315D2 C 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=F53J03(TDGC) PST=G01J03(VW,TDGC) IF(ABS(PST/PBAR-1.0).GT.1.0E-6) GO TO 14 VW=F54J03(TDGC) GO TO 60 C 14 IF(PBAR.GT.PST) GO TO 15 VMIN=F54J03(TDGC) PW=G01J03(VMIN,TDGC) IF(PW/PBAR-1.0.LT.5.0E-6) THEN VW=F54J03(TDGC) GO TO 60 END IF VMAX=0.5*RGSC*SNGL(TK) ICASE=4 VNL=VMIN VXL=VMAX GO TO 20 15 VMAX=F53J03(TDGC) PW=G01J03(VMAX,TDGC) IF(PW/PBAR-1.0.GT.-5.0E-6) THEN VW=F54J03(TDGC) GO TO 60 END IF VMIN=6.5E-4 IF(VMAX/VMIN-1.0.LT.1.0E-5.OR.TDGC.LT.329.99-273.14) THEN VW=F54J03(TDGC) GO TO 60 END IF ICASE=2 VXL=VMAX VNL=VMIN GO TO 25 C C FROM 5 16 VW=VM3KC PX=G01J03(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=6.5E-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=G01J03(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=G01J03(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=G01J03(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=G01J03(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=G01J03(VMIN,TDGC) P2=G01J03(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=G01J03(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=G01J03(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=G01J03(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=G01J03(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 F51J03=-1.E10 RETURN 59 VW=(VMAX+VMIN)*0.5 60 F51J03=VW RETURN 70 F51J03=-1.0E20 RETURN END C 52 ******* FUNCTION F52J03(PBAR,X) TDGC=F40J03(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 V=F55J03(TDGC,X) F52J03=V RETURN 10 F52J03=TDGC RETURN END C 53 ******* FUNCTION F53J03(TDGC) DOUBLE PRECISION TR,TC,ROC,ROR,ETR,ETR17 DATA TC,ROC/3.4008D2,7.6400D2/ TK=TDGC+273.15 IF(TK.LT.165.0) GO TO 30 IF(TK-340.08.GT.0.001) GO TO 30 TR=DBLE(TK)/TC ETR=1.0D0-TR IF(ETR.GT.0.001D0) THEN ETR17=ETR**(1.0D0/7.0D0) ELSE GO TO 20 ENDIF ROR=1.0D0+((((4.850170*ETR17-9.898893)*ETR17+9.494703D0)*ETR17 1-2.257146D0)*ETR17+3.88392D-1)*ETR17 F53J03=1.0D0/(ROR*ROC) RETURN 20 F53J03=1.0D0/ROC RETURN 30 F53J03=-1.0E20 RETURN END C 54 ******* FUNCTION F54J03(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F53J03,F54J03,TDGC,TK,VM3K,PBAR0,PRI,DPRI REAL G01J03 C VDD(TDGC) DIMENSION A(20) C DATA A/7.974353864D-1,-1.900841429D0,-1.113118701D-1, 13.727822548D-1,2.970786824D0,-1.045640488D1,9.930766387D0, 2-2.227161050D0,-1.343481711D0,1.121225596D0,1.690410401D-1, 35.362221526D-1,-4.301837568D-1,-3.852201837D-1,8.050511470D-2, 42.497134203D-1,4.665707679D-2,-1.610467521D-1,-2.107993994D-2, 53.475784760D-2/ DATA TC,ROC,PC/3.4008D2,7.640D2,3.9628D1/ C K KG/M3 BAR C DATA ANM01,ANM11,ANM21,ADN01,ADN11,ADN21/-1.73484D3,7.38081D2, 12.4174D2,-3.98206D2,2.65142D2,1.0D0/ DATA ANM02,ANM12,ANM22,ADN02,ADN12,ADN22/5.98727D2,-2.02642D2, 1-6.74995D1,1.37569D2,-7.91034D1,1.0D0/ C C TK=TDGC+273.15 C VCRIT=1.0D0/ROC IF(ABS(TK-340.08).GT.0.004) GO TO 1 C ERROR 0.004 STAND FOR ROUND OFF C VM3K=SNGL(VCRIT) GO TO 50 1 IF(TK.LT.167.5.OR.TK.GT.3.400801D2) GO TO 40 VM3K=F53J03(TDGC) PBAR0=G01J03(VM3K,TDGC) KC=0 IF(PBAR0.LT.-1.0E9) GO TO 51 IF(PBAR0.LT.PC) GO TO 2 VM3K=SNGL(VCRIT) GO TO 50 C 2 TR=DBLE(TK)/TC C PMPA=DBLE(PBAR0*0.1) AX=DLOG(PMPA) IF(PMPA.GT.0.7) GO TO 4 3 AR2X=((ANM21*AX+ANM11)*AX+ANM01)/((ADN21*AX+ADN11)*AX+ADN01) GO TO 5 C 4 AR2X=((ANM22*AX+ANM12)*AX+ANM02)/((ADN22*AX+ADN12)*AX+ADN02) C 5 AY=DEXP(AR2X) VRS1=ROC/AY VRS2=VRS1/1.07 IF(VRS2.LT.1.2D0) THEN VRS2=1.0D0 VM3K=SNGL(VCRIT) PRI=G01J03(VM3K,TDGC) IF(PRI-PBAR0.GT.0.0) GO TO 6 DVRS2=(VRS1-1.0D0)/3.0D2 DO 10 I=1,300 VRS2=VRS1-DVRS2*I VM3K=VRS2*VCRIT PRI=G01J03(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 49 IF(ABS(PRI-PBAR0)/PBAR0.LT.6.0E-6) GO TO 50 IF(PRI-PBAR0.GT.0.0) GO TO 6 10 CONTINUE END IF C 6 VM3K=VRS2*VCRIT PRI=G01J03(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 49 IF(ABS(PRI-PBAR0)/PBAR0.LT.6.0E-6) GO TO 50 IF(PRI.LT.PBAR0) GO TO 7 C VRS2=VRS2*1.05D0 VRS1=VRS1*1.05D0 GO TO 6 C 7 VM3K=VRS1*VCRIT PRI=G01J03(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 49 IF(ABS(PRI-PBAR0)/PBAR0.LT.6.0E-6) GO TO 50 IF(PRI.GT.PBAR0) GO TO 14 C VRS1=VRS1*9.5D-1 IF(VRS1.GT.1.0D0) GO TO 7 C DVRS1=(VRS2-1.0D0)/30 DO 8 I=1,30 VRS1=VRS2-DVRS1*I VM3K=VRS1*VCRIT IF(VM3K.LT.VCRIT) THEN VRS1=1.0001D0 VM3K=VCRIT END IF PRI=G01J03(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 49 IF(ABS(PRI-PBAR0)/PBAR0.LT.6.0E-6) GO TO 50 IF(PRI.GT.PBAR0) GO TO 9 8 CONTINUE GO TO 30 9 VRS2=VRS2-DVRS1*(I-1) IF(VRS2.LT.VRS1) THEN VM3K=SNGL(VCRIT) GO TO 50 END IF C 14 IC=0 VRS1R=VRS1 VRS2R=VRS2 VM3K=VRS1*VCRIT PRI=G01J03(VM3K,TDGC) Y1=PRI-PBAR0 VM3K=VRS2*VCRIT PRI=G01J03(VM3K,TDGC) Y2=PRI-PBAR0 IF(Y1*Y2.GT.0.0) GO TO 30 15 VM3K=VRS2*VCRIT 16 IC=IC+1 IF(IC.GT.9) GO TO 20 PRI=G01J03(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 49 DPRI=PRI-PBAR0 IF(ABS(DPRI)/PBAR0.LT.6.0E-6) GO TO 50 C DPRDX STAND FOR DPR/DROR RORW=1.0D0/(DBLE(VM3K)*ROC) ROR=RORW TR=TK/TC TR2=TR*TR TRM2=1.0D0/TR2 TRM4=TRM2*TRM2 TRM6=TRM2*TRM4 TRI=1.0/TR ROR2=ROR*ROR ROR3=ROR2*ROR ROR5=ROR2*ROR3 ROR6=ROR3*ROR3 ROR7=ROR6*ROR ROR8=ROR6*ROR2 ROR9=ROR6*ROR3 ROR10=ROR5*ROR5 ROR11=ROR6*ROR5 C Z1=1.0D0+2*(A(1)+A(2)*TRI+A(3)*TRM6)*ROR+3*A(4)*ROR2 Z2=4*(A(5)+A(6)*TRI+A(7)*TRM2+A(8)*TRM4)*ROR3+ 16*(A(9)*TRM4+A(10)*TRM6)*ROR5 Z=Z1+Z2+7*A(11)*ROR6+8*(A(12)*TRM2+A(13)*TRM6)*ROR7 Z1=9*A(14)*TRI*ROR8+10*(A(15)*TRM2+A(16)*TRM6)*ROR9 Z2=11*(A(17)*TRI+A(18)*TRM6)*ROR10+ 112*(A(19)*TRM2+A(20)*TRM6)*ROR11 Z=Z+Z1+Z2 DPRDX=Z C PRSBAR=Z*PC*TR*ROR/ZC C BAR C C ROR=RO+DELTA RO C IF(DABS(DPRDX).LT.1.0D-5) GO TO 20 RORW=RORW-DBLE(DPRI)/DPRDX VR=1.0D0/RORW C IF(VR.GT.VRS2) GO TO 20 IF(VR.LT.VRS1) GO TO 20 VM3K=VR*VCRIT PRI=G01J03(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 49 DPRI=PRI-PBAR0 IF(ABS(DPRI)/PBAR0.LT.6.0E-6) GO TO 50 IF(PRI.GT.PBAR0) THEN VRS1=VR ELSE VRS2=VR END IF GO TO 15 C 20 IC=IC+1 IF(DABS(VRS2/VRS1-1.0D0).GT.6.0D-6) GO TO 21 C VM3K=VRS1*VCRIT PRI=G01J03(VM3K,TDGC) IF(PBAR0.GT.PRI) GO TO 210 DX=1.0D-1*VRS2 DO 205 I=1,50 VM3K=(VRS2+I*DX)*VCRIT PRI=G01J03(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 30 DPRI=PRI-PBAR0 IF(ABS(DPRI)/PBAR0.LT.6.0E-6) GO TO 50 IF(PBAR0.GT.PRI) GO TO 206 205 CONTINUE GO TO 30 206 VRS2=VRS2+I*DX DX=DX/(I*1.0D1) GO TO 211 210 DX=(PBAR0-PRI)*VRS2*1.0D-1 211 DO 212 I=1,900 VRS1=VRS2-DX*I IF(VRS1.LT.1.0D0) GO TO 30 VM3K=VRS1*VCRIT PRI=G01J03(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 30 DPRI=PRI-PBAR0 IF(ABS(DPRI)/PBAR0.LT.6.0E-6) GO TO 50 IF(PBAR0.LT.PRI) GO TO 213 212 CONTINUE GO TO 30 213 VRS2=VRS1+DX VRS1R=VRS1 VRS2R=VRS2 IF(DABS(VRS2/VRS1-1.0D0).GT.6.0D-6) GO TO 21 C VM3K=(VRS1+VRS2)*5.0D-1*VCRIT GO TO 50 C C 21 IF(IC.GT.900) GO TO 30 VM3K=VRS1*VCRIT IF(VM3K.LT.VCRIT) THEN VM3K=VCRIT VRS1=1.0D0 END IF PRI=G01J03(VM3K,TDGC) Y1=PRI-PBAR0 VM3K=VRS2*VCRIT PRI=G01J03(VM3K,TDGC) Y2=PRI-PBAR0 IF(Y1*Y2.LE.0.0) GO TO 23 GO TO 30 C 23 IF(DABS(VRS2/VRS1-1.0D0).GT.1.0D-6) GO TO 24 VM3K=(VRS2+VRS1)*5.0D-1*VCRIT GO TO 50 C 24 YW=(Y1+Y2)/(Y1-Y2) X1=VRS1*VCRIT X2=VRS2*VCRIT C 25 IC=IC+1 IF(IC.GT.900) GO TO 30 IF(DABS(X1/X2-1.0D0).LT.1.0D-2) GO TO 27 VM3K=(X1+X2+YW*(X2-X1))*0.5D0 C PRI=G01J03(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 49 YW=DBLE(PRI-PBAR0) IF(DABS(YW/ DBLE(PBAR0)).LT.6.0D-6) GO TO 50 IF(YW*Y2.GT.0.0D0) THEN Y2=YW X2=VM3K ELSE Y1=YW X1=VM3K END IF 27 VM3K=(X1+X2)*5.0D-1 PRI=G01J03(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 49 YW=DBLE(PRI-PBAR0) IF(DABS(YW/ DBLE(PBAR0)).LT.6.0D-6) GO TO 50 IF(YW*Y2.GT.0.0D0) THEN Y2=YW X2=VM3K ELSE Y1=YW X1=VM3K END IF VRS1=X1/VCRIT VRS2=X2/VCRIT IF(DABS(VRS2/VRS1-1.0D0).GT.1.0D-6) GO TO 28 VM3K=(VRS2+VRS1)*5.0D-1*VCRIT GO TO 50 28 IF(DABS(VRS1R/VRS1-1.0D0).GT.1.0D-6) GO TO 29 IF(DABS(VRS2R/VRS2-1.0D0).GT.1.0D-6) GO TO 29 VM3K=(VRS2+VRS1)*5.0D-1*VCRIT GO TO 50 29 VRS1R=VRS1 VRS2R=VRS2 YW=(Y1+Y2)/(Y1-Y2) GO TO 25 C 30 F54J03=-1.0E10 RETURN 40 F54J03=-1.0E20 RETURN 49 VM3K=PRI 50 F54J03=VM3K RETURN 51 F54J03=PBAR0 RETURN END C 55 ****** FUNCTION F55J03(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 VD=F53J03(TDGC) IF(VD.LT.-1.0E9) GO TO 20 VDD=F54J03(TDGC) IF(VDD.LT.-1.0E9) GO TO 10 V=(1.0-X)*VD+X*VDD F55J03=V RETURN 10 F55J03=VDD RETURN 20 F55J03=VD RETURN 30 F55J03=-1.0E20 RETURN END C 83 *************** FUNCTION F83J03(PBAR,TDGC) VM3KG=F51J03(PBAR,TDGC) IF(VM3KG.LT.1.0E-4) GO TO 50 WPT=G10J03(VM3KG,TDGC) F83J03=WPT RETURN 50 F83J03=VM3KG RETURN END C G10 ******* FUNCTION G10J03(VM3KG,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G10J03,VM3KG,TDGC,G07J03,G08J03 C WA(V,T) DIMENSION A(20) C DATA A/7.974353864D-1,-1.900841429D0,-1.113118701D-1, 13.727822548D-1,2.970786824D0,-1.045640488D1,9.930766387D0, 2-2.227161050D0,-1.343481711D0,1.121225596D0,1.690410401D-1, 35.362221526D-1,-4.301837568D-1,-3.852201837D-1,8.050511470D-2, 42.497134203D-1,4.665707679D-2,-1.610467521D-1,-2.107993994D-2, 53.475784760D-2/ DATA R/5.583460D1/ DATA TC,ROC/3.4008D2,7.640D2/ C K KG/M3 GAMMA=DBLE(G07J03(VM3KG,TDGC)/G08J03(VM3KG,TDGC)) ROR=1.0D0/(DBLE(VM3KG)*ROC) TR=(DBLE(TDGC)+2.7315D2)/TC ROR2=ROR*ROR ROR3=ROR2*ROR ROR4=ROR2*ROR2 ROR6=ROR4*ROR2 ROR7=ROR4*ROR3 ROR9=ROR6*ROR3 ROR10=ROR6*ROR4 ROR11=ROR7*ROR4 TRI=1.0D0/TR TR2I=TRI*TRI TR4I=TR2I*TR2I TR6I=TR4I*TR2I S1=1.0D0+(2*A(1)+3*A(4)*ROR+4*(A(5)+A(7)*TR2I)*ROR2)*ROR S2=(6*A(10)*TR6I*ROR+7*A(11)*ROR2+8*A(12)*TR2I*ROR3)*ROR4 S3=(10*(A(15)+A(16)*TR4I)*TR2I+11*A(17)*TRI*ROR+ 1 12*A(20)*TR6I*ROR2)*ROR9 S=S1+S2+S3 S1=(2*(A(2)*TRI+A(3)*TR6I)+4*(A(6)*TRI+A(8)*TR4I)*ROR2)*ROR S2=(6*A(9)*TR4I*ROR+8*A(13)*TR6I*ROR3+9*A(14)*TRI*ROR4)*ROR4 S3=11*A(18)*TR6I*ROR10+12*A(19)*TR2I*ROR11 S1=S1+S2+S3 Y=S+S1 WA=DSQRT(R*TR*TC*GAMMA*Y) G10J03=SNGL(WA) RETURN END C 56 ******* FUNCTION F56J03(PBAR,H) TSDGC=F40J03(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F60J03(TSDGC,H) F56J03=X RETURN 10 F56J03=TSDGC RETURN END C 57 ******* FUNCTION F57J03(PBAR,S) TSDGC=F40J03(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F61J03(TSDGC,S) F57J03=X RETURN 10 F57J03=TSDGC RETURN END C 58 ******* FUNCTION F58J03(PBAR,U) TSDGC=F40J03(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F62J03(TSDGC,U) F58J03=X RETURN 10 F58J03=TSDGC RETURN END C 59 ******* FUNCTION F59J03(PBAR,V) TSDGC=F40J03(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F63J03(TSDGC,V) F59J03=X RETURN 10 F59J03=TSDGC RETURN END C 60 ******* FUNCTION F60J03(TDGC,H) TK=TDGC+273.15 IF(TK.LT.170.0.OR.TK.GT.340.08) GO TO 10 HD=F27J03(TDGC) IF(HD.LT.-1.0E9) GO TO 30 IF(HD.GT.H) GO TO 10 HDD=F28J03(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 F60J03=1.0 RETURN 5 X=(H-HD)/(HDD-HD) F60J03=X RETURN 10 F60J03=-1.0E20 RETURN 20 F60J03=HDD RETURN 30 F60J03=HD RETURN END C 61 ******* FUNCTION F61J03(TDGC,S) TK=TDGC+273.15 IF(TK.LT.170.0.OR.TK.GT.340.08) GO TO 10 SD=F37J03(TDGC) IF(SD.LT.-1.0E9) GO TO 30 IF(SD.GT.S) GO TO 10 SDD=F38J03(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 F61J03=1.0 RETURN 5 X=(S-SD)/(SDD-SD) F61J03=X RETURN 10 F61J03=-1.0E20 RETURN 20 F61J03=SDD RETURN 30 F61J03=SD RETURN END C 62 ******* FUNCTION F62J03(TDGC,U) TK=TDGC+273.15 IF(TK.LT.170.0.OR.TK.GT.340.08) GO TO 10 UD=F46J03(TDGC) IF(UD.LT.-1.0E9) GO TO 30 IF(UD.GT.U) GO TO 10 UDD=F47J03(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 F62J03=1.0 RETURN 5 X=(U-UD)/(UDD-UD) F62J03=X RETURN 10 F62J03=-1.0E20 RETURN 20 F62J03=UDD RETURN 30 F62J03=UD RETURN END C 63 ******* FUNCTION F63J03(TDGC,V) TK=TDGC+273.15 IF(TK.LT.170.0.OR.TK.GT.340.08) GO TO 10 VD=F53J03(TDGC) IF(VD.LT.-1.0E9) GO TO 30 IF(VD.GT.V) GO TO 10 VDD=F54J03(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 F63J03=1.0 RETURN 5 X=(V-VD)/(VDD-VD) F63J03=X RETURN 10 F63J03=-1.0E20 RETURN 20 F63J03=VDD RETURN 30 F63J03=VD RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99J03(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR R 13B1 ****' 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