C ********** ********* C ********** R114 ********* 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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(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 S99J01(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT REAL FUNCTION AIPPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 C--- FUNCTION NAME --- DATA FLUID/'R 114'/, FUN/'AIPPT'/ 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 --- AIPPT=FF RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 DATA FUN/'AJTPT'/ CALL S99J01(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 114'/, 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 = F2J01(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 114'/, 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 = F3J01(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 114'/, 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 = F4J01(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 114'/, 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 = F5J01(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 114'/, 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 = F6J01(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 114'/, 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 = F7J01(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 114'/, 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 = F8J01(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 114'/, 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 = F9J01(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 114'/, 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 = F10J01(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 114'/, 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 = F11J01(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 C--- FUNCTION NAME --- DATA FLUID/'R 114'/, FUN/'AMUPDD'/ 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 --- 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 114'/, 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 = F13J01(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 114'/, 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 = F14J01(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 C--- FUNCTION NAME --- DATA FLUID/'R 114'/, FUN/'AMUTDD'/ 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 --- AMUTDD=FF RETURN END C------------------------------------------------- F92 = BPPT FUNCTION BPPT(P,T) CHARACTER FUN*6 DATA FUN/'BPPT'/ CALL S99J01(FUN) BPPT=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 DATA FUN/'BSPT'/ CALL S99J01(FUN) BSPT=-1.0E+30 RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 DATA FUN/'BTPT'/ CALL S99J01(FUN) BTPT=-1.0E+30 RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 DATA FUN/'BVPT'/ CALL S99J01(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 114'/, 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 = F16J01(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 114'/, 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 = F17J01(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 114'/, 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 = F18J01(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 114'/, 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 = F19J01(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 114'/, 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 = F20J01(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 114'/, 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 = F21J01(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 FUNCTION EPSPT(P,T) CHARACTER FUN*6 DATA FUN/'EPSPT'/ CALL S99J01(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='170.922' WHEN A='M' C B='48.6445' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=170.922 ELSE IF (A.EQ.'R') THEN FC=48.6445 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR REFRIGERANT 114 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 S99J01(FUN) GAMPDD=-1.0E+30 RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 DATA FUN/'GAMPT'/ CALL S99J01(FUN) GAMPT=-1.0E+30 RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 DATA FUN/'GAMTDD'/ CALL S99J01(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 114'/, 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 = F23J01(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 114'/, 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 = F24J01(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 114'/, 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 = F25J01(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 114'/, 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 = F26J01(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 114'/, 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 = F27J01(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 114'/, 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 = F28J01(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 114'/, 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 = F29J01(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 114' WHEN A='S' C B='CCLF2CCLF2' 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 114' ELSE IF (A.EQ.'C') THEN IDENTF='CCLF2CCLF2' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR REFRIGERANT 114 WHEN A=''' &//A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F66 = PLDT FUNCTION PLDT(T) CHARACTER FUN*6 DATA FUN/'PLDT'/ CALL S99J01(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT FUNCTION PMLT(T) CHARACTER FUN*6 DATA FUN/'PMLT'/ CALL S99J01(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 114'/, 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 = F85J01(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 FUNCTION PRPDD(P) CHARACTER FUN*6 DATA FUN/'PRPDD'/ CALL S99J01(FUN) PRPDD=-1.0E+30 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 114'/, 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 = F87J01(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 FUNCTION PRTDD(T) CHARACTER FUN*6 DATA FUN/'PRTDD'/ CALL S99J01(FUN) PRTDD=-1.0E+30 RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99J01(FUN) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F72 = PSTD FUNCTION PSTD(T) CHARACTER FUN*6 DATA FUN/'PSTD'/ CALL S99J01(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99J01(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 114'/, 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 = F31J01(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 114'/, 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 = F32J01(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 114'/, 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 = F33J01(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 114'/, 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 = F34J01(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 114'/, 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 = F35J01(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 114'/, 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 = F36J01(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 114'/, 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 = F37J01(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 114'/, 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 = F38J01(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 114'/, 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 = F39J01(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 FUNCTION TLDP(P) CHARACTER FUN*6 DATA FUN/'TLDP'/ CALL S99J01(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP FUNCTION TMLP(P) CHARACTER FUN*6 DATA FUN/'TMLP'/ CALL S99J01(FUN) TMLP=-1.0E+30 RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 DATA FUN/'TPSEUP'/ CALL S99J01(FUN) TPSEUP=-1.0E+30 RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99J01(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 114'/, 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 = F40J01(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 114'/, 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 FUNCTION TSPD(P) CHARACTER FUN*6 DATA FUN/'TSPD'/ CALL S99J01(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99J01(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 114'/, 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 = F42J01(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 114'/, 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 = F43J01(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 114'/, 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 = F44J01(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 114'/, 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 = F45J01(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 114'/, 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 = F46J01(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 114'/, 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 = F47J01(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 114'/, 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 = F48J01(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 114'/, 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 = F49J01(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 114'/, 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 = F50J01(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 114'/, 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 = F51J01(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 114'/, 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 = F52J01(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 114'/, 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 = F53J01(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 114'/, 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 = F54J01(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 114'/, 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 = F55J01(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 114'/, 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 = F83J01(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 114'/, 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 = F56J01(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 114'/, 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 = F57J01(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 114'/, 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 = F58J01(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 114'/, 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 = F59J01(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 114'/, 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 = F60J01(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 114'/, 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 = F61J01(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 114'/, 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 = F62J01(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 114'/, 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 = F63J01(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 114'/, 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 = F64J01(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 114'/, 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 = F65J01(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 114'/, 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 = F70J01(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 114'/, 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 = F71J01(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 114'/, 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 = F82J01(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 114'/, 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 = F76J01(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 114'/, 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 = F77J01(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 114'/, 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 = F78J01(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 114'/, 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 = F79J01(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 114'/, 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 = F80J01(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------------------------------------------------- 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 114'/, 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 = F81J01(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------------------------------------------------- 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 114'/, 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 = F30J01(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 ********** ********* C ********** R114 ********* C ********** VER. 9.1.R.******* C C 82 ***** FUNCTION F82J01(PBAR,TDGC) WA=F83J01(PBAR,TDGC) VM3K=F51J01(PBAR,TDGC) DXIN=WA*WA/(PBAR*VM3K*1.0E5) F82J01=DXIN RETURN END C 2 ****** FUNCTION F2J01(PBAR) IF(ABS(PBAR-32.48).GT.0.004) GO TO 10 A=0.0 GO TO 30 10 W=F40J01(PBAR) TK=W+273.15 IF(TK.LT.200.0.OR.TK.GT.418.78) GO TO 20 A=F3J01(W) GO TO 30 20 A=-1.0E20 30 F2J01=A RETURN END C 3 ****** FUNCTION F3J01(TDGC) DOUBLE PRECISION A,G0,SIGMA,RD,RDD DATA G0/9.80665D2/ TK=TDGC+273.15 IF(ABS(TK-418.78).LT.0.02) GO TO 10 IF(TK.LT.200.0.OR.TK.GT.418.78) GO TO 20 W=F53J01(TDGC) IF(W.LT.1.0E-5) GO TO 30 RD=1.0D0/DBLE(W) W=F54J01(TDGC) IF(W.LT.1.0E-5) GO TO 30 RDD=1.0D0/DBLE(W) W=G20J01(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 F3J01=A RETURN END C 20 &&&&& FUNCTION G20J01(TK) DOUBLE PRECISION TR,SIGMA,WK IF(ABS(TK-418.78).LT.0.02) GO TO 10 IF(TK.LT.180.0.OR.TK.GT.418.78) GO TO 20 TR=DBLE(TK)/4.1878D2 WK=1.0D0-TR SIGMA=5.084D1*WK**1.24D0 G20J01=SIGMA*1.0D-3 RETURN 10 G20J01=0.0 RETURN 20 G20J01=-1.0E20 RETURN END C 4 ****** FUNCTION F4J01(PBAR) ALH=F24J01(PBAR) IF(ALH.LT.-1.0E9) GO TO 10 HD=F23J01(PBAR) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F4J01=ALH RETURN 20 F4J01=HD RETURN END C 5 ****** FUNCTION F5J01(TDGC) ALH=F28J01(TDGC) IF(ALH.LT.-1.0E9) GO TO 10 HD=F27J01(TDGC) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F5J01=ALH RETURN 20 F5J01=HD RETURN END C 6 ******* FUNCTION F6J01(PBAR) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 ALAMBD=F9J01(TDGC) F6J01=ALAMBD RETURN 10 F6J01=TDGC RETURN END C 7 ******* FUNCTION F7J01(PBAR) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 ALAMBD=F10J01(TDGC) F7J01=ALAMBD RETURN 10 F7J01=TDGC RETURN END C 8 ******* FUNCTION F8J01(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.3.941D2) GO TO 5 ALAMBD=9.36245D-2*TK-1.80919D1 F8J01=ALAMBD*1.0D-3 RETURN 5 F8J01=-1.0E+20 RETURN END C 9 ******* FUNCTION F9J01(TDGC) DOUBLE PRECISION ALAMD,TK C LAMBDA (SAT. LIQ.) TK=DBLE(TDGC+273.15) IF(TK.GT.1.79999D2.AND.TK.LT.3.88001D2) GO TO 10 F9J01=-1.0E20 RETURN 10 ALAMD=-2.62443D-1*TK+1.418013D2 F9J01=ALAMD*1.0D-3 RETURN END C 10 ******* FUNCTION F10J01(TDGC) DOUBLE PRECISION ALAMBD,TK C LAMBDA (SAT. VAP.) TK=DBLE(TDGC+273.15) IF(TK.GT.2.89999D2.AND.TK.LT.3.94001D2) GO TO 10 F10J01=-1.0E20 RETURN 10 ALAMBD=8.512D-47*TK**18+9.36245D-2*TK-1.80995D1 F10J01=ALAMBD*1.0D-3 RETURN END C 11 &&&&&&& FUNCTION G11J01(RO,T) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL RO,T,G11J01 DIMENSION CFMUR(15) DATA CFMUR/0.0D0,4.12710D-2,-1.05058D-5,-8.59323D-2, 13.47296D-4,-3.15296D-7,1.24194D-3,-5.76056D-6,6.90672D-9, 21.36618D-6,-3.08661D-9,0.0D0,-1.57147D-9,3.66920D-12,0.0D0/ ROW=DBLE(RO) TK=DBLE(T) YYTA=0.0D0 ROI=1.0D0/ROW K=0 DO 15 I=1,5 ROI=ROI*ROW TJ=1.0D0/TK YTW=0.0 DO 11 J=1,3 TJ=TJ*TK K=K+1 YTW=YTW+CFMUR(K)*TJ 11 CONTINUE YYTA=YYTA+YTW*ROI 15 CONTINUE G11J01=YYTA*1.0D-6 RETURN END C 11 ******* FUNCTION F11J01(PBAR) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.E9) GO TO 10 AMU=F14J01(TDGC) F11J01=AMU RETURN 10 F11J01=TDGC RETURN END C 13 ******* FUNCTION F13J01(PBAR,TDGC) IF(PBAR.LT.0.999999) GO TO 50 VW=F51J01(PBAR,TDGC) IF(VW.LT.-1.0E9) GO TO 40 IF(PBAR.LT.32.480001) GO TO 5 IF(VW.GT.0.002859) GO TO 11 GO TO 50 C 5 IF(ABS(PBAR-1.01325).LT.1.0E-6) GO TO 6 VPDD=F50J01(PBAR) IF(VPDD.LT.-1.0E9) GO TO 42 RELDV=VW/VPDD IF(DABS(RELDV-1.0D0).LT.1.0E-5) GO TO 10 IF(VW.LT.VPDD) GO TO 50 GO TO 10 C C PBAR=1.01325 BAR 6 TK=TDGC+273.15 AMU=(4.07947E-2-9.34862D-6*TK)*TK F13J01=AMU*1.0E-6 RETURN 10 IF(VW.LT.1.0/300.0) GO TO 50 11 TK=TDGC+273.15 IF(TK.LT.298.15.OR.TK.GT.473.15) GO TO 50 AMU=G11J01(1.0/VW,TK) F13J01=AMU RETURN C 30 AMU=F14J01(TDGC) F13J01=AMU RETURN 40 F13J01=VW RETURN 42 F13J01=VPDD RETURN 50 F13J01=-1.0E20 RETURN END C 14 ******* FUNCTION F14J01(TDGC) DOUBLE PRECISION AMUD,TK TK=DBLE(TDGC+273.15) IF(TK.GT.2.09999D2.AND.TK.LT.3.98001D2) GO TO 10 F14J01=-1.0E20 RETURN 10 AMUD=(6.35392D5/TK-6.156D3)/TK+2.21797D1-3.25928D-2*TK AMUD=DEXP(AMUD) F14J01=AMUD*1.0D-3 RETURN END C 16 ****** FUNCTION F16J01(PBAR) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPD=F19J01(TDGC) F16J01=CPD RETURN 10 F16J01=TDGC RETURN END C 17 ****** FUNCTION F17J01(PBAR) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPDD=F20J01(TDGC) F17J01=CPDD RETURN 10 F17J01=TDGC RETURN END C 18 ******* FUNCTION F18J01(PBAR,TDGC) T=TDGC+273.15 IF(T.LT.200.0.OR.T.GT.510.0) GO TO 50 IF(PBAR.LT.0.01369.OR.PBAR.GT.110.0) GO TO 50 IF(ABS(PBAR-32.48).LT.0.004.AND.ABS(T-418.78).LT.0.002) 1 GO TO 35 C CRITICAL POINT CP=1.0E10 C VV=F51J01(PBAR,TDGC) IF(VV.LT.-1.0E9) GO TO 40 IF(T.GT.310.0.AND.VV.LT.1.0/1500.1) GO TO 50 IF(T.GT.418.78.OR.PBAR.GT.32.48) GO TO 3 VTDD=F54J01(TDGC) IF(VV/VTDD-1.0.GT.-2.0E-5) GO TO 3 IF(T.LT.309.999) GO TO 50 VTD=F53J01(TDGC) IF(ABS(VV/VTD-1.0).GT.-1.0E-5) GO TO 50 CP=F19J01(TDGC) F18J01=CP RETURN 3 CP=G07J01(VV,TDGC) F18J01=CP RETURN 35 CP=1.0E10 F18J01=CP RETURN 40 F18J01=VV RETURN 50 F18J01=-1.0E20 RETURN END C 19 ******* FUNCTION F19J01(TDGC) C C CP SAT. LIQUID(TEMP) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL TDGC,F19J01 DIMENSION AR(4) DATA AR/9.3809D-1,-2.6439D-3,1.4672D-5,-1.8742D-8/ C TK=TDGC+273.15 IF(TK.LT.182.0.OR.TK.GT.296.0) GO TO 20 CP=AR(1) TRN=1.0D0 DO 10 I=2,4 TRN=TRN*TK CP=CP+AR(I)*TRN 10 CONTINUE F19J01=CP*1.0D3 RETURN 20 F19J01=-1.0E20 RETURN END C 20 ******* FUNCTION F20J01(TDGC) C C CP SAT.VAPOR(TEMP) C DATA VC/0.001309/ T=TDGC+273.15 IF(ABS(T-418.78).LT.0.002) GO TO 35 C CRITICAL POINT CP=1.0E10 C IF(T.LT.200.0.OR.T.GT.418.78) GO TO 50 PBAR=F30J01(TDGC) VDD=F51J01(PBAR,TDGC) IF(VDD.LT.VC) GO TO 40 CP=G07J01(VDD,TDGC) F20J01=CP RETURN 35 F20J01=1.0E10 RETURN 40 F20J01=-1.0E10 RETURN 50 F20J01=-1.0E20 RETURN END FUNCTION G07J01(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G07J01,VM3K,TDGC DIMENSION AR(8),BR(8),CR(8),DR(8),ER(4) DATA ER/-1.241207D1,1.722728D2,-1.593831D2,5.878563D1/ C DATA AR/0.0D0,-5.114302067D0,-1.132981433D1,2.405450200D1, 1-1.874282774D1,2.947456807D0,1.258434868D0,-3.115346525D-1/ DATA BR/0.0D0,8.868578327D-1,1.383847827D1,-2.646915487D1, 11.999283874D1,-1.000309853D0,-2.591153132D0,5.428375491D-1/ DATA CR/0.0D0,0.0D0,0.0D0,0.0D0,2.046955392,-4.803331479D0, 12.518993033D0,-4.042768897D-1/ DATA DR/0.0D0,-2.352424185D2,1.116635615D2,1.595930810D2, 11.957513185D2,-2.813838569D2,9.624041691D1,-1.021979892D1/ DATA ARR,QEI,SMALLB/3.61265D0,6.3D0,2.5D-2/ DATA VC,TC/1.7361D-3,4.1878D2/ DATA ZC,RR/2.76805D-1,4.86445D-2/ C T=DBLE(TDGC)+2.7315D2 C C CRITICAL POINT CP=1.0E10 DETECT IN OUTER ROUTINE C VR=DBLE(VM3K)/VC TR=T/TC TR2=TR*TR CP=ER(1)+ER(3)*TR2-ARR SUMWP=(ER(2)+ER(4)*TR2)*TR CP=CP+SUMWP X=VR-SMALLB XW=X*X XN=X XWN=XW EQEITR=DEXP(-QEI*TR) QEITRW=QEI*EQEITR XX=ARR/X YY=ARR*TR/XW SUMWPX=XX SUMWPY=YY SUMWMX=0.0D0 SUMWMY=0.0D0 I=2 XN=XN*X XWN=XWN*X SUMWPX=SUMWPX+(BR(I)-DR(I)*QEITRW)/XN SUMWPY=SUMWPY+ I*BR(I)*TR/XWN SUMWMY=SUMWMY+ I*(AR(I)+DR(I)*EQEITR) /XWN I=3 XN=XN*X XWN=XWN*X SUMWPX=SUMWPX+BR(I)/XN SUMWMX=SUMWMX-DR(I)*QEITRW/XN SUMWPY=SUMWPY+ I*(BR(I)*TR+DR(I)*EQEITR) /XWN SUMWMY=SUMWMY+ I*AR(I)/XWN I=4 XN=XN*X XWN=XWN*X SUMWPY=SUMWPY+ I*(AR(I)+DR(I)*EQEITR)/XWN SUMWMX=SUMWMX+(BR(I)-DR(I)*QEITRW)/XN SUMWMY=SUMWMY+ I*BR(I)*TR/XWN I=5 XN=XN*X XWN=XWN*X SUMWPX=SUMWPX+(BR(I)+2.0D0*CR(I)*TR)/XN SUMWMX=SUMWMX-DR(I)*QEITRW/XN SUMWPY=SUMWPY+ I*((BR(I)+CR(I)*TR)*TR+DR(I)*EQEITR) /XWN SUMWMY=SUMWMY+ I*AR(I)/XWN I=6 XN=XN*X XWN=XWN*X SUMWPX=SUMWPX-DR(I)*QEITRW/XN SUMWMX=SUMWMX+(BR(I)+2.0D0*CR(I)*TR)/XN SUMWPY=SUMWPY+ I*AR(I)/XWN SUMWMY=SUMWMY+ I*((BR(I)+CR(I)*TR)*TR+DR(I)*EQEITR) /XWN I=7 XN=XN*X XWN=XWN*X SUMWPX=SUMWPX+2.0D0*CR(I)*TR/XN SUMWPY=SUMWPY+ I*(AR(I)+CR(I)*TR*TR+DR(I)*EQEITR) /XWN SUMWMX=SUMWMX+(BR(I)-DR(I)*QEITRW)/XN SUMWMY=SUMWMY+ I*BR(I)*TR/XWN I=8 XN=XN*X XWN=XWN*X SUMWPX=SUMWPX+(BR(I)-DR(I)*QEITRW)/XN SUMWPY=SUMWPY+ I*BR(I)*TR/XWN SUMWMX=SUMWMX+2.0D0*CR(I)*TR/XN SUMWMY=SUMWMY+ I*(AR(I)+CR(I)*TR*TR+DR(I)*EQEITR)/XWN 20 CONTINUE XX=SUMWPX+SUMWMX YY=SUMWPY+SUMWMY CP=CP+XX*XX*TR/YY SUMWP=0.0D0 SUMWM=0.0D0 XWN=QEI*QEI XN=1.0 I=2 XN=XN*X SUMWM=SUMWM+XWN*DR(I)*EQEITR/((I-1)*XN) I=3 XN=XN*X SUMWP=SUMWP+XWN*DR(I)*EQEITR/((I-1)*XN) I=4 XN=XN*X SUMWP=SUMWP+XWN*DR(I)*EQEITR/((I-1)*XN) I=5 XN=XN*X SUMWP=SUMWP+(2.0D0*CR(I)+XWN*DR(I)*EQEITR)/((I-1)*XN) I=6 XN=XN*X SUMWM=SUMWM+(2.0D0*CR(I)+XWN*DR(I)*EQEITR)/((I-1)*XN) I=7 XN=XN*X SUMWP=SUMWP+(2.0D0*CR(I)+XWN*DR(I)*EQEITR)/((I-1)*XN) I=8 XN=XN*X SUMWM=SUMWM+(2.0D0*CR(I)+XWN*DR(I)*EQEITR)/((I-1)*XN) 30 CONTINUE CP=(CP-TR*(SUMWP+SUMWM))*(RR*ZC) G07J01=CP*1.0D3 RETURN END FUNCTION G08J01(VM3K,TDGC) C C CV C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G08J01,VM3K,TDGC DIMENSION CR(8),DR(8),ER(4) DATA ER/-1.241207D1,1.722728D2,-1.593831D2,5.878563D1/ C DATA CR/0.0D0,0.0D0,0.0D0,0.0D0,2.046955392,-4.803331479D0, 12.518993033D0,-4.042768897D-1/ DATA DR/0.0D0,-2.352424185D2,1.116635615D2,1.595930810D2, 11.957513185D2,-2.813838569D2,9.624041691D1,-1.021979892D1/ DATA ARR,QEI,SMALLB/3.612652087D0,6.3D0,2.50D-2/ DATA VC,TC/1.7361D-3,4.1878D2/ DATA ZC,RR/2.76805D-1,4.86445D-2/ C T=DBLE(TDGC)+2.7315D2 C 3 VR=DBLE(VM3K)/VC TR=T/TC TR2=TR*TR CV=ER(1)+ER(3)*TR2-ARR SUMWP=(ER(2)+ER(4)*TR2)*TR CV=CV+SUMWP X=VR-SMALLB SUMWP=0.0D0 SUMWM=0.0D0 XN=1.0D0 XWN=QEI*QEI*DEXP(-QEI*TR) C I=2 XN=XN*X SUMWM=SUMWM+XWN*DR(I)/((I-1)*XN) I=3 XN=XN*X SUMWP=SUMWP+XWN*DR(I)/((I-1)*XN) I=4 XN=XN*X SUMWP=SUMWP+XWN*DR(I)/((I-1)*XN) I=5 XN=XN*X SUMWP=SUMWP+(2.0D0*CR(I)+XWN*DR(I))/((I-1)*XN) I=6 XN=XN*X SUMWM=SUMWM+(2.0D0*CR(I)+XWN*DR(I))/((I-1)*XN) I=7 XN=XN*X SUMWP=SUMWP+(2.0D0*CR(I)+XWN*DR(I))/((I-1)*XN) I=8 XN=XN*X SUMWM=SUMWM+(2.0D0*CR(I)+XWN*DR(I))/((I-1)*XN) 11 CONTINUE CV=(CV-TR*(SUMWP+SUMWM))*RR*ZC G08J01=CV*1.0D3 RETURN END C 21 ******** FUNCTION F21J01(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 F21J01=32.48 RETURN 20 F21J01=145.63 RETURN 30 F21J01=1.7361E-3 RETURN 40 F21J01=3.829E5 RETURN 50 F21J01=1.512E3 RETURN 60 F21J01=-1.0E20 RETURN END C 76 ******* FUNCTION F76J01(PBAR) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 20 CVDD=F78J01(TDGC) F76J01=CVDD RETURN 20 F76J01=-1.0E20 RETURN END C 77 ******* FUNCTION F77J01(PBAR,TDGC) C C CV C T=TDGC+273.15 IF(T.LT.200.0.OR.T.GT.510.0) GO TO 50 IF(PBAR.LT.0.01369.OR.PBAR.GT.110.0) GO TO 50 C VV=F51J01(PBAR,TDGC) IF(VV.LT.-1.0E9) GO TO 40 IF(T.GT.310.0.AND.VV.LT.1.0/1500.1) GO TO 50 IF(T.GT.418.78.OR.PBAR.GT.32.48) GO TO 3 VTDD=F54J01(TDGC) IF(VV/VTDD-1.0.GT.-2.0E-5) GO TO 3 GO TO 50 3 CV=G08J01(VV,TDGC) F77J01=CV RETURN 40 F77J01=VV RETURN 50 F77J01=-1.0E20 RETURN END C 78 ******* FUNCTION F78J01(TDGC) C C CV SAT.VAPOR(TEMP) C DATA VC/0.001309/ T=TDGC+273.15 C IF(T.LT.200.0.OR.T.GT.418.78) GO TO 50 PBAR=F30J01(TDGC) VDD=F51J01(PBAR,TDGC) IF(VDD.LT.VC) GO TO 40 CV=G08J01(VDD,TDGC) F78J01=CV RETURN 40 F78J01=-1.0E10 RETURN 50 F78J01=-1.0E20 RETURN END C 23 ****** FUNCTION F23J01(PBAR) C IF(PBAR.LT.0.01.OR.PBAR.GT.110.0) GO TO 20 C TSDGC=F40J01(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F27J01(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F23J01=H RETURN 15 F23J01=TSDGC RETURN 16 F23J01=H RETURN 20 F23J01=-1.0E20 RETURN END C 24 ****** FUNCTION F24J01(PBAR) C IF(PBAR.LT.0.01.OR.PBAR.GT.110.0) GO TO 20 C TSDGC=F40J01(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F28J01(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F24J01=H RETURN 15 F24J01=TSDGC RETURN 16 F24J01=H RETURN 20 F24J01=-1.0E20 RETURN END C 71 ******* FUNCTION F71J01(PBAR,S) C C H(P,S) C CALL S01J01(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.418.78) GO TO 10 PSAT=F30J01(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 10 STDD=F38J01(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 10 STD=F37J01(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=F28J01(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 HTD=F27J01(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 H=HTD*(1.0-X)+HTDD*X 10 F71J01=H RETURN 11 F71J01=PSAT RETURN 12 F71J01=STDD RETURN 13 F71J01=STD RETURN 14 F71J01=HTDD RETURN 15 F71J01=HTD RETURN 20 F71J01=TDGC RETURN 30 F71J01=-1.0E20 RETURN END C 25 ****** FUNCTION F25J01(PBAR,TDGC) C IF(PBAR.LT.0.01.OR.PBAR.GT.115.0) GO TO 20 IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.510.0) GO TO 20 C VM3K=F51J01(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-418.78.GT.-273.15) GO TO 10 VTD=F53J01(TDGC) IF((VM3K-VTD)/1.7361E-3.GT.1.0E-5) GO TO 10 H=G03J01(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J01=H RETURN 10 H=G02J01(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J01=H RETURN 15 F25J01=VM3K RETURN 16 F25J01=H RETURN 20 F25J01=-1.0E20 RETURN END C 26 ******* FUNCTION F26J01(PBAR,X) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 H=F29J01(TDGC,X) F26J01=H RETURN 10 F26J01=TDGC RETURN END C 27 ****** FUNCTION F27J01(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F27J01,TDGC,F51J01,G01J01,G02J01,F53J01,VTD,PST,VTDD,HTDD C DATA G1,G2,G3,G4/-2.80159D0,-2.12706D0,-7.59432D0,1.28527D0/ DATA TC/4.1878D2/ C BAR K IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.510.0) GO TO 20 C VTD=F53J01(TDGC) IF(VTD.LT.-1.0E9) GO TO 17 PST=G01J01(VTD,TDGC) VTDD=F51J01(PST,TDGC) HTDD=G02J01(VTDD,TDGC) IF(HTDD.LT.-1.0E9) GO TO 15 TR=DBLE(TDGC+273.15)/4.1878D2 VRDD=DBLE(VTDD) VRD=DBLE(VTD) PSR=DBLE(PST) TK=DBLE(TDGC)+2.7315D2 TR=TK/TC W=1.0D0/TR WTR=W-1.0D0 TR2=TR*TR W=W+G1*G2*DEXP(G2*WTR)/TR2-G3*G4*WTR/(TR2*DSQRT(1.0+G4*WTR**2)) C HW=DBLE(HTDD) H=HW-TR*(VRDD-VRD)*PSR*W*1.0D5 F27J01=H RETURN 15 F27J01=HTDD RETURN 16 F27J01=VTDD RETURN 17 F27J01=VTD RETURN 20 F27J01=-1.0E20 RETURN END C 28 ****** FUNCTION F28J01(TDGC) C IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.510.0) GO TO 20 C VD=F53J01(TDGC) PST=G01J01(VD,TDGC) IF(PST.LT.-1.0E9) GO TO 10 VDD=F51J01(PST,TDGC) IF(VDD.LT.-1.0E9) GO TO 15 HDD=G02J01(VDD,TDGC) F28J01=HDD RETURN 10 F28J01=PST RETURN 15 F28J01=VDD RETURN 20 F28J01=-1.0E20 RETURN END C 29 ****** FUNCTION F29J01(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 HTD=F27J01(TDGC) IF(HTD.LT.-1.0E9) GO TO 20 HTDD=F28J01(TDGC) IF(HTDD.LT.-1.0E9) GO TO 10 F29J01=(1.0-X)*HTD+X*HTDD RETURN 10 F29J01=HTDD RETURN 20 F29J01=HTD RETURN 30 F29J01=-1.0E20 RETURN END C 85 ****** FUNCTION F85J01(PBAR) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 F85J01=F87J01(TDGC) RETURN 10 F85J01=TDGC RETURN END C 81 *************** FUNCTION F81J01(PBAR,TDGC) PWBAR=PBAR/1.01325 T=TDGC+2.7315D2 IF(T.LT.2.90D2.OR.T.GT.3.94D2) GO TO 50 C PWBAR=1.01325 Y=F13J01(PWBAR,TDGC) IF(Y.LT.0.0) GO TO 35 VW=F51J01(PWBAR,TDGC) IF(VW.LT.1.7361E-3) GO TO 50 CP=G07J01(VW,TDGC) IF(CP.LT.0.0) GO TO 40 AL=F8J01(PWBAR,TDGC) IF(AL.LT.0.0) GO TO 45 F81J01=Y*CP/AL RETURN 35 F81J01=Y 40 F81J01=CP 45 F81J01=AL 50 F81J01=-1.0E20 RETURN END C 87 ****** FUNCTION F87J01(TDGC) AMUTD=F14J01(TDGC) IF(AMUTD.LT.0.0) GO TO 10 CPTD=F19J01(TDGC) IF(CPTD.LT.0.0) GO TO 20 ALMTD=F9J01(TDGC) IF(ALMTD.LT.0.0) GO TO 30 F87J01=AMUTD*CPTD/ALMTD RETURN 10 F87J01=AMUTD RETURN 20 F87J01=CPTD RETURN 30 F87J01=ALMTD RETURN END C 30 ****** FUNCTION F30J01(TDGC) C C PS(T) SAT. PRESS C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F30J01,TDGC,TK TK=TDGC+273.15 IF(ABS(TK-418.78).LT.0.02) GO TO 10 C ERROR 0.02 SHOWN IN ORIGINAL TEXT IF(TK.LT.190.0.OR.TK.GT.418.78) GO TO 20 TR=DBLE(TK)/4.1878D2 TRI1=1.0D0/TR-1.0D0 EXA1=DEXP(-2.12706D0*TRI1) EXA1=2.80159D0*(EXA1-1.0D0) EXA2=DSQRT(1.0D0+1.28527D0*TRI1*TRI1) EXA2=7.59432D0*(EXA2-1.0D0) PST=TR*DEXP(EXA1-EXA2) IF(PST.GT.1.0D0) PST=1.0D0 F30J01=PST*3.248D1 RETURN 10 F30J01=3.248D1 RETURN 20 F30J01=-1.0E20 RETURN END C 31 ******* FUNCTION F31J01(PBAR) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 SIGMA=F32J01(TDGC) F31J01=SIGMA RETURN 10 F31J01=TDGC RETURN END C 32 ******* FUNCTION F32J01(TDGC) DOUBLE PRECISION TR,SIGMA,WK,T T=DBLE(TDGC)+2.7315D2 IF(T.LT.1.80D2.OR.T.GT.4.1878D2) GO TO 20 TR=T/4.1878D2 WK=1.0D0-TR IF(WK.GT.1.0D-7) GO TO 10 F32J01=0.0D0 RETURN C 10 SIGMA=5.084D1*WK**1.24D0 F32J01=SIGMA*1.0D-3 RETURN 20 F32J01=-1.0E20 RETURN END C 33 ****** FUNCTION F33J01(PBAR) C IF(PBAR.LT.0.01.OR.PBAR.GT.110.0) GO TO 20 C TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F37J01(TDGC) IF(S.LT.-1.0E9) GO TO 16 F33J01=S RETURN 15 F33J01=TDGC RETURN 16 F33J01=S RETURN 20 F33J01=-1.0E20 RETURN END C 34 ****** FUNCTION F34J01(PBAR) C IF(PBAR.LT.0.01.OR.PBAR.GT.110.0) GO TO 20 C TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F38J01(TDGC) IF(S.LT.-1.0E9) GO TO 16 F34J01=S RETURN 15 F34J01=TDGC RETURN 16 F34J01=S RETURN 20 F34J01=-1.0E20 RETURN END C 35 ****** FUNCTION F35J01(PBAR,TDGC) C IF(PBAR.LT.0.01.OR.PBAR.GT.110.0) GO TO 20 IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.510.0) GO TO 20 C VM3K=F51J01(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-418.78.GT.-273.15) GO TO 10 VTD=F53J01(TDGC) IF((VM3K-VTD)/1.7361E-3.GT.1.0E-5) GO TO 10 S=G06J01(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J01=S RETURN 10 S=G05J01(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J01=S RETURN 15 F35J01=VM3K RETURN 16 F35J01=S RETURN 20 F35J01=-1.0E20 RETURN END C 36 ******* FUNCTION F36J01(PBAR,X) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 S=F39J01(TDGC,X) F36J01=S RETURN 10 F36J01=TDGC RETURN END C 37 ****** FUNCTION F37J01(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F37J01,TDGC,F51J01,G01J01,G05J01,F53J01,VTD,PST,VTDD,STDD C DATA G1,G2,G3,G4/-2.80159D0,-2.12706D0,-7.59432D0,1.28527D0/ DATA TC/4.1878D2/ C BAR K IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.510.0) GO TO 20 C VTD=F53J01(TDGC) IF(VTD.LT.-1.0E9) GO TO 17 PST=G01J01(VTD,TDGC) VTDD=F51J01(PST,TDGC) IF(VTDD.LT.-1.0E9) GO TO 16 STDD=G05J01(VTDD,TDGC) IF(STDD.LT.-1.0E9) GO TO 15 VRDD=DBLE(VTDD) VRD=DBLE(VTD) PSR=DBLE(PST) TK=DBLE(TDGC)+2.7315D2 TR=TK/TC W=1.0D0/TR WTR=(W-1.0D0) TR2=TR*TR W=W+G1*G2*DEXP(G2*WTR)/TR2-G3*G4*WTR/(TR2*DSQRT(1.0+G4*WTR**2)) C SW=DBLE(STDD) S=SW-(VRDD-VRD)*PSR*W*1.0D5/4.1878D2 F37J01=S RETURN 15 F37J01=STDD RETURN 16 F37J01=VTDD RETURN 17 F37J01=VTD RETURN 20 F37J01=-1.0E20 RETURN END C 38 ****** FUNCTION F38J01(TDGC) C IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.510.0) GO TO 20 C VD=F53J01(TDGC) PST=G01J01(VD,TDGC) VDD=F51J01(PST,TDGC) IF(VDD.LT.-1.0E9) GO TO 15 SDD=G05J01(VDD,TDGC) F38J01=SDD RETURN 15 F38J01=VDD RETURN 20 F38J01=-1.0E20 RETURN END C 39 ******* FUNCTION F39J01(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 STD=F37J01(TDGC) IF(STD.LT.-1.0E9) GO TO 20 STDD=F38J01(TDGC) IF(STDD.LT.-1.0E9) GO TO 10 F39J01=(1.0-X)*STD+X*STDD RETURN 10 F39J01=STDD RETURN 20 F39J01=STD RETURN 30 F39J01=-1.0E20 RETURN END C 2 &&&&&&& FUNCTION G02J01(VM3K,TDGC) C C H(V,T) VAPOR C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3K,TDGC,G02J01 DIMENSION AR(8),BR(8),CR(8),DR(8) DIMENSION ER(4),TRNR(4),T0RNR(4) C DATA ER/-1.241207D1,1.722728D2,-1.593831D2,5.878563D1/ DATA F0,T0C/6.004834D1,2.7315D2/ DATA AR/0.0D0,-5.114302067D0,-1.132981433D1,2.405450200D1, 1-1.874282774D1,2.947456807D0,1.258434868D0,-3.115346525D-1/ DATA BR/0.0D0,8.868578327D-1,1.383847827D1,-2.646915487D1, 11.999283874D1,-1.000309853D0,-2.591153132D0,5.428375491D-1/ DATA CR/0.0D0,0.0D0,0.0D0,0.0D0,2.046955392D0,-4.803331479D0, 12.518993033D0,-4.042768897D-1/ DATA DR/0.0D0,-2.352424185D2,1.116635615D2,1.595930810D2, 11.957513185D2,-2.813838569D2,9.624041691D1,-1.021979892D1/ DATA ARR,QEI,SMALLB/3.612652087D0,6.3D0,2.50D-2/ DATA PC,VC,TC/3.248D1,1.7361D-3,4.1878D2/ C IF(VM3K.LT.1.0/1.5E3.OR.VM3K.GT.13.0) GO TO 20 IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.510.0) GO TO 20 C C V=DBLE(VM3K)/1.7361D-3 T=DBLE(TDGC+273.15)/4.1878D2 EQEITR=DEXP(-QEI*T) T0=T0C/TC TRNR(1)=T T0RNR(1)=T0 DO 5 I=2,4 TRNR(I)=TRNR(I-1)*T T0RNR(I)=T0RNR(I-1)*T0 5 CONTINUE X=V-SMALLB HVT=(V/X-1.0D0)*ARR*T+F0 WM=ER(1)*(TRNR(1)-T0RNR(1))+ER(3)*(TRNR(3)-T0RNR(3))/3 WP=ER(2)*(TRNR(2)-T0RNR(2))/2+ER(4)*(TRNR(4)-T0RNR(4))/4 C XN=X I=2 XN=XN*X WP=WP+BR(I)*V*T/XN W=AR(I)*(I*V-SMALLB)+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WM=WM+W/XN I=3 XN=XN*X W=BR(I)*(I-1)*V*T+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WP=WP+W/(XN*(I-1)) WM=WM+AR(I)*(I*V-SMALLB)/(XN*(I-1)) I=4 XN=XN*X W=AR(I)*(I*V-SMALLB)+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WP=WP+W/(XN*(I-1)) WM=WM+BR(I)*(I-1)*V*T/(XN*(I-1)) I=5 XN=XN*X W=(BR(I)*(I-1)*V+CR(I)*((I-2)*V+SMALLB)*T)*T 1+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WP=WP+W/(XN*(I-1)) WM=WM+AR(I)*(I*V-SMALLB)/(XN*(I-1)) I=6 XN=XN*X WP=WP+AR(I)*(I*V-SMALLB)/(XN*(I-1)) W=(BR(I)*(I-1)*V+CR(I)*((I-2)*V+SMALLB)*T)*T 1+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WM=WM+W/(XN*(I-1)) I=7 XN=XN*X W=AR(I)*(I*V-SMALLB)+CR(I)*((I-2)*V+SMALLB)*T*T 1+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WP=WP+W/(XN*(I-1)) WM=WM+BR(I)*(I-1)*V*T/(XN*(I-1)) I=8 XN=XN*X WP=WP+BR(I)*(I-1)*V*T/(XN*(I-1)) W=AR(I)*(I*V-SMALLB)+CR(I)*((I-2)*V+SMALLB)*T*T 1+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WM=WM+W/(XN*(I-1)) 10 CONTINUE HVT=HVT+WP+WM G02J01=HVT*PC*VC*1.0D5 C C PC*VC=TC*ZC*RR C RETURN 20 G02J01=-1.0E20 RETURN END C 3 &&&&&&& FUNCTION G03J01(VM3K,TDGC) C C H(V,T) LIQUID C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3K,TDGC,G03J01,HTD,PS,VTD,F27J01,F30J01,F53J01 DIMENSION AR(8),BR(8),CR(8),DR(8) C DATA AR/0.0D0,-5.114302067D0,-1.132981433D1,2.405450200D1, 1-1.874282774D1,2.947456807D0,1.258434868D0,-3.115346525D-1/ DATA BR/0.0D0,8.868578327D-1,1.383847827D1,-2.646915487D1, 11.999283874D1,-1.000309853D0,-2.591153132D0,5.428375491D-1/ DATA CR/0.0D0,0.0D0,0.0D0,0.0D0,2.046955392D0,-4.803331479D0, 12.518993033D0,-4.042768897D-1/ DATA DR/0.0D0,-2.352424185D2,1.116635615D2,1.595930810D2, 11.957513185D2,-2.813838569D2,9.624041691D1,-1.021979892D1/ DATA ARR,QEI,SMALLB/3.612652087D0,6.3D0,2.50D-2/ DATA PC,VC/3.248D1,1.7361D-3/ C IF(VM3K.LT.1.0/1.5E3.OR.VM3K.GT.13.0) GO TO 20 IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.510.0) GO TO 20 C V=DBLE(VM3K)/1.7361D-3 T=DBLE(TDGC+273.15)/4.1878D2 T2=T*T EQEITR=DEXP(-QEI*T) HTD=F27J01(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 PS=F30J01(TDGC)/3.248D1 IF(PS.LT.-1.0E9) GO TO 16 VTD=F53J01(TDGC)/1.7361D-3 IF(VTD.LT.-1.0E9) GO TO 17 X=V-SMALLB HVT=ARR*T*V/X-DBLE(PS*VTD) WP=0.0D0 WM=0.0D0 C XN=X I=2 XN=XN*X WP=WP+BR(I)*V*T/XN W=AR(I)*(I*V-SMALLB)+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WM=WM+W/XN I=3 XN=XN*X W=BR(I)*(I-1)*V*T+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WP=WP+W/(XN*(I-1)) WM=WM+AR(I)*(I*V-SMALLB)/(XN*(I-1)) I=4 XN=XN*X W=AR(I)*(I*V-SMALLB)+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WP=WP+W/(XN*(I-1)) WM=WM+BR(I)*(I-1)*V*T/(XN*(I-1)) I=5 XN=XN*X W=(BR(I)*(I-1)*V+CR(I)*((I-2)*V+SMALLB)*T)*T 1+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WP=WP+W/(XN*(I-1)) WM=WM+AR(I)*(I*V-SMALLB)/(XN*(I-1)) I=6 XN=XN*X WP=WP+AR(I)*(I*V-SMALLB)/(XN*(I-1)) W=(BR(I)*(I-1)*V+CR(I)*((I-2)*V+SMALLB)*T)*T 1+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WM=WM+W/(XN*(I-1)) I=7 XN=XN*X W=AR(I)*(I*V-SMALLB)+CR(I)*((I-2)*V+SMALLB)*T2 1+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WP=WP+W/(XN*(I-1)) WM=WM+BR(I)*(I-1)*V*T/(XN*(I-1)) I=8 XN=XN*X WP=WP+BR(I)*(I-1)*V*T/(XN*(I-1)) W=AR(I)*(I*V-SMALLB)+CR(I)*((I-2)*V+SMALLB)*T2 1+DR(I)*((I*V-SMALLB)+X*QEI*T)*EQEITR WM=WM+W/(XN*(I-1)) 10 CONTINUE HVT=HVT+WP+WM XN=1.0D0 X=VTD-SMALLB QEITRW=(QEI*T+1.0D0)*EQEITR C WP=0.0D0 WM=0.0D0 I=2 XN=XN*X WM=WM-(AR(I)+DR(I)*QEITRW)/XN I=3 XN=XN*X WP=WP-DR(I)*QEITRW/((I-1)*XN) WM=WM-AR(I)/((I-1)*XN) I=4 XN=XN*X WP=WP-(AR(I)+DR(I)*QEITRW)/((I-1)*XN) I=5 XN=XN*X WP=WP-DR(I)*QEITRW/((I-1)*XN) WM=WM-(AR(I)-CR(I)*T2)/((I-1)*XN) I=6 XN=XN*X WP=WP-(AR(I)-CR(I)*T2)/((I-1)*XN) WM=WM-DR(I)*QEITRW/((I-1)*XN) I=7 XN=XN*X WP=WP-(AR(I)+DR(I)*QEITRW)/((I-1)*XN) WM=WM+CR(I)*T2/((I-1)*XN) I=8 XN=XN*X WP=WP+CR(I)*T2/((I-1)*XN) WM=WM-(AR(I)+DR(I)*QEITRW)/((I-1)*XN) 11 CONTINUE W=WP+WM HVT=HVT+W G03J01=HVT*PC*VC*1.0D5+DBLE(HTD) C C PC*VC=TC*ZC*RR C RETURN 15 G03J01=HTD RETURN 16 G03J01=PS RETURN 17 G03J01=VTD RETURN 20 G03J01=-1.0E20 RETURN END C 5 &&&&&&& FUNCTION G05J01(VM3K,TDGC) C C S(V,T) VAPOR C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3K,TDGC,G05J01 DIMENSION BR(8),CR(8),DR(8),ER(4) DATA ER/-1.241207D1,1.722728D2,-1.593831D2,5.878563D1/ C DATA BR/0.0D0,8.868578327D-1,1.383847827D1,-2.646915487D1, 11.999283874D1,-1.000309853D0,-2.591153132D0,5.428375491D-1/ DATA CR/0.0D0,0.0D0,0.0D0,0.0D0,2.046955392D0,-4.803331479D0, 12.518993033D0,-4.042768897D-1/ DATA DR/0.0D0,-2.352424185D2,1.116635615D2,1.595930810D2, 11.957513185D2,-2.813838569D2,9.624041691D1,-1.021979892D1/ DATA ARR,QEI,SMALLB/3.612652087D0,6.3D0,2.50D-2/ DATA TC/4.1878D2/ DATA ZC,RR,F1/2.76805D-1,4.86445D-2,9.877038D1/ C IF(VM3K.LT.1.0/1500.0.OR.VM3K.GT.13.0) GO TO 20 IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.510.0) GO TO 20 C VR=DBLE(VM3K)/1.7361D-3 TR=DBLE(TDGC+273.15)/4.1878D2 TR2=TR*TR T0=273.15D0/TC X=VR-SMALLB XN=1.0D0 EQEITR=DEXP(-QEI*TR) S=ARR*DLOG(X/(ARR*TR)) WP=0.0D0 WM=0.0D0 J=2 XN=XN*X WP=WP+(BR(J)-QEI*DR(J)*EQEITR)/XN J=3 XN=XN*X WP=WP+BR(J)/((J-1)*XN) WM=WM-QEI*DR(J)*EQEITR/((J-1)*XN) J=4 XN=XN*X WM=WM+(BR(J)+2.0D0*CR(J)*TR-QEI*DR(J)*EQEITR)/((J-1)*XN) J=5 XN=XN*X WP=WP+(BR(J)+2.0D0*CR(J)*TR)/((J-1)*XN) WM=WM-QEI*DR(J)*EQEITR/((J-1)*XN) J=6 XN=XN*X WP=WP-QEI*DR(J)*EQEITR/((J-1)*XN) WM=WM+(BR(J)+2.0D0*CR(J)*TR)/((J-1)*XN) J=7 XN=XN*X WP=WP+2.0D0*CR(J)*TR/((J-1)*XN) WM=WM+(BR(J)-QEI*DR(J)*EQEITR)/((J-1)*XN) J=8 XN=XN*X WP=WP+(BR(J)-QEI*DR(J)*EQEITR)/((J-1)*XN) WM=WM+2.0D0*CR(J)*TR/((J-1)*XN) 10 CONTINUE S=S-(WP+WM) TR2=TR*TR T02=T0*T0 WP=ER(1)*DLOG(TR/T0)+ER(3)*(TR2-T02)*0.5 WM=ER(2)*(TR-T0)+ER(4)*(TR2*TR-T02*T0)/3 S=S+WP+WM+F1 S=S*RR*ZC G05J01=S*1.0D3 RETURN 20 G05J01=-1.0E20 RETURN END C 6 &&&&&&& FUNCTION G06J01(VM3K,TDGC) C C S(V,T) LIQUID C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3K,TDGC,G06J01,STD,VTD,F37J01,F53J01 DIMENSION BR(8),CR(8),DR(8) C DATA BR/0.0D0,8.868578327D-1,1.383847827D1,-2.646915487D1, 11.999283874D1,-1.000309853D0,-2.591153132D0,5.428375491D-1/ DATA CR/0.0D0,0.0D0,0.0D0,0.0D0,2.046955392D0,-4.803331479D0, 12.518993033D0,-4.042768897D-1/ DATA DR/0.0D0,-2.352424185D2,1.116635615D2,1.595930810D2, 11.957513185D2,-2.813838569D2,9.624041691D1,-1.021979892D1/ DATA ARR,QEI,SMALLB/3.612652087D0,6.3D0,2.50D-2/ DATA ZC,RR/2.76805D-1,4.86445D-2/ C IF(VM3K.LT.1.0/1.5E3.OR.VM3K.GT.13.0) GO TO 20 IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.510.0) GO TO 20 C VR=DBLE(VM3K)/1.7361D-3 TR=DBLE(TDGC+273.15)/4.1878D2 STD=F37J01(TDGC) IF(STD.LT.-1.0E9) GO TO 15 VTD=F53J01(TDGC)/1.7361D-3 IF(VTD.LT.-1.0E9) GO TO 16 X=1.0D0/(VR-SMALLB) XD=1.0D0/(DBLE(VTD)-SMALLB) XN=1.0D0 XDN=1.0D0 SVT=ARR*DLOG(XD/X) C EQEITR=DEXP(-QEI*TR) QEIW=QEI*EQEITR WP=0.0D0 WM=0.0D0 J=2 XN=XN*X XDN=XDN*XD WP=WP+(BR(J)+2.0D0*CR(J)*TR-QEIW*DR(J))/(J-1)*(XN-XDN) J=3 XN=XN*X XDN=XDN*XD WP=WP+BR(J)/(J-1)*(XN-XDN) WM=WM-QEIW*DR(J)/(J-1)*(XN-XDN) J=4 XN=XN*X XDN=XDN*XD WM=WM+(BR(J)+2.0D0*CR(J)*TR-QEIW*DR(J))/(J-1)*(XN-XDN) J=5 XN=XN*X XDN=XDN*XD WP=WP+(BR(J)+2.0D0*CR(J)*TR)/(J-1)*(XN-XDN) WM=WM-QEIW*DR(J)/(J-1)*(XN-XDN) J=6 XN=XN*X XDN=XDN*XD WP=WP-QEIW*DR(J)/(J-1)*(XN-XDN) WM=WM+(BR(J)+2.0D0*CR(J)*TR)/(J-1)*(XN-XDN) J=7 XN=XN*X XDN=XDN*XD WP=WP+2.0D0*CR(J)*TR/(J-1)*(XN-XDN) WM=WM+(BR(J)-QEIW*DR(J))/(J-1)*(XN-XDN) J=8 XN=XN*X XDN=XDN*XD WP=WP+(BR(J)-QEIW*DR(J))/(J-1)*(XN-XDN) WM=WM+2.0D0*CR(J)*TR/(J-1)*(XN-XDN) 10 CONTINUE SVT=SVT-(WP+WM) SVT=SVT*RR*ZC*1.0D3+DBLE(STD) G06J01=SVT RETURN 20 G06J01=-1.0E20 RETURN 15 G06J01=STD RETURN 16 G06J01=VTD RETURN END C 64 ******* FUNCTION F64J01(PBAR0,H) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F64J01,TDGC,HW,TMAX,TMIN,HDP,HDDP,HX,H1,H2,TSP,VX,TWH REAL PBAR0,H,G02J01,G03J01,F40J01,F51J01 REAL F53J01,F54J01,TLC,TCC,VDP,VDDP,VDPMAX,VCM3K REAL F27J01,G21J01 C DATA HC/3.829147D5/ DATA PCBAR,TCK,ROCKM3/3.248D1,4.1878D2,5.76D2/ 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.5.2E5) GO TO 40 IF(ABS(PBAR0-32.48).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=418.78-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=F40J01(PBAR0) TSP=TDGC C IF(TDGC.LT.-72.15) GO TO 40 C -72.15=199.0-273.15 C HDP=F27J01(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=F53J01(TMAX) TSP=(TMAX-TLC)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J01(TDGC) HDP=G03J01(VDP,TDGC) IF(HDP.LT.H) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J01(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.1.0E-4) VX=VDP HX=G03J01(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=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 71 HX=G03J01(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=F53J01(TLC) HDP=G03J01(VDP,TLC) IF(HDP.LT.H) THEN GO TO 9 END IF ICASE=2 C TMIN=TLC TMAX=510.0-273.15 VX=F51J01(PBAR0,TMIN) IF(VX.LT.1.0E-4.OR.VX.GT.10.0) THEN GO TO 81 END IF C C HX=G03J01(VX,TMIN) C**************** IF(TMIN+273.15.LT.TCK) THEN HX=G03J01(VX,TMIN) ELSE HX=G02J01(VX,TMIN) END IF C***************** IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 32 IF(HX.GT.H) THEN IF(TMIN.LT.310.001-273.15) THEN TDGC=310.0 VX=F51J01(PBAR0,TDGC) HX=G03J01(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) GO TO 40 TLC=TDGC END IF END IF TDGC=SNGL(TCK)-273.15 VX=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) THEN GO TO 81 END IF HX=G02J01(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=510.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=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 82 IF(VX.GT.10.0) GO TO 82 HX=G03J01(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=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 IF(VX.GT.10.0) GO TO 50 HX=G03J01(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=F53J01(TDGC) HDP=G03J01(VDP,TDGC) IF(HDP.GT.H) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J01(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.510.0) GO TO 716 VX=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN HX=G02J01(VX,TDGC) ELSE HX=G03J01(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=G03J01(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=F51J01(PBAR0,TDGC) HX=G03J01(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=F51J01(PBAR0,TDGC) HX=G02J01(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) THEN TMAX=TDGC ELSE TMAX=510.0-273.15 TMIN=TDGC END IF ICASE=2 GO TO 15 C 12 TMAX=510.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) +310.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=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 HX=G02J01(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=F54J01(TDGC) IF(VDDP.LT.1.0E-4) GO TO 50 HDDP=G02J01(VDDP,TDGC) IF(H/HDDP-1.0.LT.1.0E-6) GO TO 30 C ADAAA **************************** IF(H.GT.HC) THEN TMIN=TDGC TMAX=510.0-273.15 ICASE=4 GO TO 15 ELSE C ADAAA **************************** TMAX=TDGC TMIN=332.9-273.15 VX=F51J01(PBAR0,TMIN) IF(VX.LT.1.0E-4) THEN TMIN=310.0-273.15 VX=F51J01(PBAR0,TMIN) IF(VX.LT.1.0E-4) GO TO 40 END IF HX=G03J01(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=F51J01(PBAR0,TDGC) IF(VX.LT.1.E-4) GO TO 131 H2=G03J01(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=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 141 IF(VX.GT.10.0) GO TO 141 HX=G02J01(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=F51J01(PBAR0,TMIN) H1=G21J01(VX,TMIN,TCC,ICASE,VDPMAX) VX=F51J01(PBAR0,TMAX) H2=G21J01(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=F51J01(PBAR0,TDGC) HX=G21J01(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=F51J01(PBAR0,TDGC) HX=G21J01(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=F51J01(PBAR0,TMIN) H1=G21J01(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=F51J01(PBAR0,TDGC) HX=G21J01(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=F51J01(PBAR0,TDGC) HX=G21J01(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=F51J01(PBAR0,TDGC) HX=G21J01(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=F51J01(PBAR0,TDGC) HX=G21J01(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=F51J01(PBAR0,TMAX) H2=G21J01(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=F51J01(PBAR0,TDGC) HX=G21J01(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=F51J01(PBAR0,TDGC) HX=G21J01(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=F51J01(PBAR0,TDGC) HW=G21J01(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 F64J01=TDGC RETURN 31 F64J01=TMAX RETURN 32 F64J01=TMIN RETURN 40 F64J01=-1.0E20 RETURN 50 F64J01=-1.0E10 RETURN END C G31 FUNCTION G21J01(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=F53J01(TDGC) GO TO 30 C C ICASE=2 5 IF(TDGC.LT.TCC) GO TO 30 10 G21J01=G02J01(VX,TDGC) RETURN 30 G21J01=G03J01(VX,TDGC) RETURN END C S01 ******* SUBROUTINE S01J01(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,G05J01,G06J01,F40J01,F51J01 REAL F53J01,F54J01,TLC,TCC,VDP,VDDP,VDPMAX,VCM3K REAL F37J01,G31J01,VM3K,TEMPC,H,G03J01,G02J01 C DATA SC/1.512035D3/ DATA PCBAR,TCK,ROCKM3/3.248D1,4.1878D2,5.76D2/ C C IF(PBAR0.LT.0.02.OR.PBAR0.GT.100.001) GO TO 40 C IF(VM3K.LT.5.0E-4.OR.VM3K.GT.13.0) GO TO 40 TLC=330.1-273.15 IF(S.LT.7.0E2.OR.S.GT.2.2E3) GO TO 40 IF(ABS(PBAR0-32.48).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=418.78-273.15 VX=1.7361E-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=F40J01(PBAR0) TSP=TDGC C IF(TDGC.LT.-72.15) GO TO 40 C -72.15=199.0-273.15 C SDP=F37J01(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=F53J01(TMAX) TSP=(TMAX-TLC)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J01(TDGC) SDP=G06J01(VDP,TDGC) IF(SDP.LT.S) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J01(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.1.0E-4) VX=VDP SX=G06J01(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=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 71 SX=G06J01(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=F53J01(TLC) SDP=G06J01(VDP,TLC) IF(SDP.LT.S) THEN GO TO 9 END IF ICASE=2 C TMIN=TLC TMAX=510.0-273.15 VX=F51J01(PBAR0,TMIN) IF(VX.LT.1.0E-4.OR.VX.GT.13.0) THEN GO TO 81 END IF C C SX=G06J01(VX,TMIN) C**************** IF(TMIN+273.15.LT.TCK) THEN SX=G06J01(VX,TMIN) ELSE SX=G05J01(VX,TMIN) END IF C***************** IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 IF(SX.GT.S) THEN IF(TMIN.LT.310.001-273.15) THEN TDGC=310.0 VX=F51J01(PBAR0,TDGC) SX=G06J01(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) GO TO 40 TLC=TDGC END IF END IF TDGC=SNGL(TCK)-273.15 VX=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) THEN GO TO 81 END IF SX=G05J01(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=510.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=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 82 IF(VX.GT.11.0) GO TO 82 SX=G06J01(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=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 IF(VX.GT.11.0) GO TO 50 SX=G06J01(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=F53J01(TDGC) SDP=G06J01(VDP,TDGC) IF(SDP.GT.S) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J01(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.510.0) GO TO 716 VX=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN SX=G05J01(VX,TDGC) ELSE SX=G06J01(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=G06J01(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=F51J01(PBAR0,TDGC) SX=G06J01(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=F51J01(PBAR0,TDGC) SX=G05J01(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN TMAX=TDGC ELSE TMAX=510.0-273.15 TMIN=TDGC END IF ICASE=2 GO TO 15 C 12 TMAX=510.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) +310.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=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 50 SX=G05J01(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=F54J01(TDGC) IF(VDDP.LT.1.0E-4) GO TO 50 SDDP=G05J01(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=510.0-273.15 ICASE=4 GO TO 15 ELSE C ADAAA **************************** TMAX=TDGC TMIN=332.9-273.15 VX=F51J01(PBAR0,TMIN) IF(VX.LT.1.0E-4) THEN TMIN=310.0-273.15 VX=F51J01(PBAR0,TMIN) IF(VX.LT.1.0E-4) GO TO 40 END IF SX=G06J01(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=F51J01(PBAR0,TDGC) IF(VX.LT.1.E-4) GO TO 131 S2=G06J01(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=F51J01(PBAR0,TDGC) IF(VX.LT.1.0E-4) GO TO 141 IF(VX.GT.10.0) GO TO 141 SX=G05J01(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=F51J01(PBAR0,TMIN) S1=G31J01(VX,TMIN,TCC,ICASE,VDPMAX) VX=F51J01(PBAR0,TMAX) S2=G31J01(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=F51J01(PBAR0,TDGC) SX=G31J01(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=F51J01(PBAR0,TDGC) SX=G31J01(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=F51J01(PBAR0,TMIN) S1=G31J01(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=F51J01(PBAR0,TDGC) SX=G31J01(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=F51J01(PBAR0,TDGC) SX=G31J01(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=F51J01(PBAR0,TDGC) SX=G31J01(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=F51J01(PBAR0,TDGC) SX=G31J01(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=F51J01(PBAR0,TMAX) S2=G31J01(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=F51J01(PBAR0,TDGC) SX=G31J01(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=F51J01(PBAR0,TDGC) SX=G31J01(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=F51J01(PBAR0,TDGC) SW=G31J01(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=F51J01(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=G03J01(VX,TDGC) ELSE H=G02J01(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 G31J01(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=F53J01(TDGC) GO TO 30 C C ICASE=2 5 IF(TDGC.LT.TCC) GO TO 30 10 G31J01=G05J01(VX,TDGC) RETURN 30 G31J01=G06J01(VX,TDGC) RETURN END C 65 FUNCTION F65J01(PBAR0,S) C C G05(V,T)=S VAPOR G06(V,T)=S LIQUID C S.GT.SC S.LT.SC C CALL S01J01(PBAR0,S,VM3K,TDGC,H) F65J01=TDGC RETURN END C 70 ****** FUNCTION F70J01(PBAR,VM3K) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F70J01,PBAR,TDGC,VM3K,PW,TMAX,TMIN,VDP,VDDP,PX,P1,P2,TSP REAL G01J01,F40J01,F53J01,F54J01,F30J01,PST310 C DATA PCBAR,TCK,VCM3K/3.248D1,4.1878D2,1.7361D-3/ C IF(PBAR.LT.0.01.OR.PBAR.GT.210.0) GO TO 40 IF(VM3K.LT.4.0E-4.OR.VM3K.GT.13.0) GO TO 40 IF(ABS(PBAR-32.48).GT.0.02) GO TO 5 IF(ABS(VM3K-1.7361E-3).GT.4.0E-6) GO TO 5 C CRITICAL PRES. ERROR =0.02(BAR) C CRITICAL SPC. VOL ERROR=4E-6(M3/KG) TDGC=418.78-273.15 GO TO 30 C 5 IF(PBAR/PCBAR-1.0.GT.-1.0E-6) GO TO 6 TDGC=F40J01(PBAR) TSP=TDGC IF(TDGC.LT.-74.15) GO TO 40 C -74.15=199.0-273.15 C VDP=F53J01(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 IF(PBAR.GT.2.7) THEN PST310=F30J01(310.0-273.15) IF(PBAR/PST310-1.0.LT.-1.0E-6) GO TO 40 C TMIN=310.0-273.15 ELSE PST310=F30J01(205.0-273.15) IF(PBAR/PST310-1.0.LT.-1.0E-6) GO TO 40 C TMIN=205.0-273.15 END IF C TDGC=TMIN PX=G01J01(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=310.0-273.15 TMAX=510.0-273.15 PX=G01J01(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=510.0-273.15 ICASE=3 GO TO 15 C 10 VDDP=F54J01(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=510.0-273.15 ICASE=4 C 15 IF(TMIN.GT.TMAX) THEN TDGC=TMIN TMIN=TMAX TMAX=TDGC ELSE TMIN=TMIN END IF P1=G01J01(VM3K,TMIN) P2=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(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 F70J01=TDGC RETURN 31 F70J01=TMAX RETURN 32 F70J01=TMIN RETURN 40 F70J01=-1.0E20 RETURN 50 F70J01=-1.0E10 RETURN END C 40 ******** FUNCTION F40J01(PBAR) DOUBLE PRECISION DPSDTR C C IF(PBAR.LT.0.02.OR.PBAR.GT.40.65005) GO TO 40 TMIN=200.0-273.15 IF(PBAR.LT.0.1) TMIN=190.0-273.15 TMAX=418.78-273.15 PRI=F30J01(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=F30J01(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)*418.78-273.15 WTMIN=TSRW WTMAX=TSRW+16.0 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)/418.78 IF(IC.GT.15) GO TO 10 PRI=F30J01(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=F30J01(TMAX) PL=F30J01(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)/32.48 TR=(TDGC+273.15)/418.78 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*418.78-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=F30J01(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=F30J01(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=F30J01(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=F30J01(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=F30J01(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 F40J01=-1.0E10 RETURN 40 F40J01=-1.0E20 RETURN 49 TDGC=PRI 50 F40J01=TDGC RETURN END C 42 ******* FUNCTION F42J01(PBAR) C C U=H-PV (SAT. LIQUID) C TSDGC=F40J01(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HD=F27J01(TSDGC) IF(HD.LT.-1.0E9) GO TO 20 VD=F53J01(TSDGC) IF(VD.LT.-1.0E9) GO TO 10 U=HD-PBAR*VD*1.0E5 F42J01=U RETURN 10 F42J01=VD RETURN 20 F42J01=HD RETURN 30 F42J01=TSDGC RETURN END C 43 ******* FUNCTION F43J01(PBAR) C C U=H-PV (SAT. VAPOR) C TSDGC=F40J01(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HDD=F28J01(TSDGC) IF(HDD.LT.-1.0E9) GO TO 20 VDD=F54J01(TSDGC) IF(VDD.LT.-1.0E9) GO TO 10 U=HDD-PBAR*VDD*1.0E5 F43J01=U RETURN 10 F43J01=VDD RETURN 20 F43J01=HDD RETURN 30 F43J01=TSDGC RETURN END C 79 ******* FUNCTION F79J01(PBAR,S) C C U(P,S) U=H-PV C CALL S01J01(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.418.78) GO TO 40 PSAT=F30J01(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 40 STDD=F38J01(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 40 STD=F37J01(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=F28J01(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 VTDD=F54J01(TDGC) IF(VTDD.LT.-1.0E9) GO TO 16 HTD=F27J01(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 VTD=F53J01(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 F79J01=H C WRITE(6,210) H C 210 FORMAT(1H ,42X,'RTN FROM 10 H=',E12.4) RETURN 11 F79J01=PSAT C WRITE(6,211) PSAT C 211 FORMAT(1H ,42X,'RTN FROM 11 PSAT=',E12.4) RETURN 12 F79J01=STDD C WRITE(6,212) STDD C 212 FORMAT(1H ,42X,'RTN FROM 12 STDD=',E12.4) RETURN 13 F79J01=STD C WRITE(6,213) STD C 213 FORMAT(1H ,42X,'RTN FROM 13 STD=',E12.4) RETURN 14 F79J01=HTDD C WRITE(6,214) HTDD C 214 FORMAT(1H ,42X,'RTN FROM 14 HTDD=',E12.4) RETURN 15 F79J01=HTD C WRITE(6,215) HTD C 215 FORMAT(1H ,42X,'RTN FROM 15 HTD=',E12.4) RETURN 16 F79J01=VTDD C WRITE(6,216) VTDD C 216 FORMAT(1H ,42X,'RTN FROM 16 VTDD=',E12.4) RETURN 17 F79J01=VTD C WRITE(6,217) VTD C 217 FORMAT(1H ,42X,'RTN FROM 17 VTD=',E12.4) RETURN 20 F79J01=TDGC C WRITE(6,220) TDGC C 220 FORMAT(1H ,42X,'RTN FROM 20 TDGC=',E12.4) RETURN 30 F79J01=-1.0E20 RETURN 40 F79J01=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 F44J01(PBAR,TDGC) C C U=H-PV C V=F51J01(PBAR,TDGC) IF(V.LT.-1.0E9) GO TO 20 IF(TDGC-418.78.GT.-273.15) GO TO 4 VTD=F53J01(TDGC) IF((V-VTD)/1.7361E-3.LT.1.0E-5) GO TO 5 4 H=G02J01(V,TDGC) GO TO 6 5 H=G03J01(V,TDGC) 6 IF(H.LT.-1.0E9) GO TO 10 U=H-PBAR*V*1.0E5 F44J01=U RETURN 10 F44J01=H RETURN 20 F44J01=V RETURN END C 45 ******* FUNCTION F45J01(PBAR,X) C C U=H-PV C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F42J01(PBAR) IF(UD.LT.-1.0E9) GO TO 20 UDD=F43J01(PBAR) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F45J01=U RETURN 10 F45J01=UDD RETURN 20 F45J01=UD RETURN 30 F45J01=-1.0E20 RETURN END C 46 ******* FUNCTION F46J01(TDGC) C C U=H-PV (SAT. LIQUID C HD=F27J01(TDGC) IF(HD.LT.-1.0E9) GO TO 30 VD=F53J01(TDGC) IF(VD.LT.-1.0E9) GO TO 20 PST=F30J01(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HD-PST*VD*1.0E5 F46J01=U RETURN 10 F46J01=PST RETURN 20 F46J01=VD RETURN 30 F46J01=HD RETURN END C 47 ******* FUNCTION F47J01(TDGC) C C U=H-PV (SAT. VAPOR) C HDD=F28J01(TDGC) IF(HDD.LT.-1.0E9) GO TO 30 VDD=F54J01(TDGC) IF(VDD.LT.-1.0E9) GO TO 20 PST=F30J01(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HDD-PST*VDD*1.0E5 F47J01=U RETURN 10 F47J01=PST RETURN 20 F47J01=VDD RETURN 30 F47J01=HDD RETURN END C 48 ******* FUNCTION F48J01(TDGC,X) C C U=H-PV (SAT. LIQUID) C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F46J01(TDGC) IF(UD.LT.-1.0E9) GO TO 20 UDD=F47J01(TDGC) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F48J01=U RETURN 10 F48J01=UDD RETURN 20 F48J01=UD RETURN 30 F48J01=-1.0E20 RETURN END C 1 &&&&&& FUNCTION G01J01(VM3K,TDGC) C C P(V,T) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J01,VM3K,TDGC,TK,VV,F30J01,F53J01 DIMENSION AR(8),BR(8),CR(8),DR(8) DATA AR/0.0D0,-5.114302067D0,-1.132981433D1,2.405450200D1, 1-1.874282774D1,2.947456807D0,1.258434868D0,-3.115346525D-1/ DATA BR/0.0D0,8.868578327D-1,1.383847827D1,-2.646915487D1, 11.999283874D1,-1.000309853D0,-2.591153132D0,5.428375491D-1/ DATA CR/0.0D0,0.0D0,0.0D0,0.0D0,2.046955392D0,-4.803331479D0, 12.518993033D0,-4.042768897D-1/ DATA DR/0.0D0,-2.352424185D2,1.116635615D2,1.595930810D2, 11.957513185D2,-2.813838569D2,9.624041691D1,-1.021979892D1/ DATA SMALLB,QEI,ARR/2.50D-2,6.3D0,3.612652087D0/ C TK=TDGC+273.15 IF(TK.LT.190.0.OR.TK.GT.510.0) GO TO 20 IF(VM3K.LT.4.0E-4.OR.VM3K.GT.13.0) GO TO 20 IF(VM3K.LT.6.66664E-4) GO TO 15 T=(DBLE(TDGC)+2.7315D2)/4.1878D2 T2=T*T VR=VM3K/1.7361D-3 C X=VR-SMALLB PRIP=ARR*T/X PRIM=0.0D0 EQEITR=DEXP(-QEI*T) XN=X I=2 XN=XN*X PRIP=PRIP+BR(I)*T/XN PRIM=PRIM+(AR(I)+DR(I)*EQEITR)/XN I=3 XN=XN*X PRIP=PRIP+(BR(I)*T+DR(I)*EQEITR)/XN PRIM=PRIM+AR(I)/XN I=4 XN=XN*X PRIP=PRIP+(AR(I)+DR(I)*EQEITR)/XN PRIM=PRIM+BR(I)*T/XN I=5 XN=XN*X PRIP=PRIP+((BR(I)+CR(I)*T)*T+DR(I)*EQEITR)/XN PRIM=PRIM+AR(I)/XN I=6 XN=XN*X PRIP=PRIP+AR(I)/XN PRIM=PRIM+((BR(I)+CR(I)*T)*T+DR(I)*EQEITR)/XN I=7 XN=XN*X PRIP=PRIP+(AR(I)+CR(I)*T2+DR(I)*EQEITR)/XN PRIM=PRIM+BR(I)*T/XN I=8 XN=XN*X PRIP=PRIP+BR(I)*T/XN PRIM=PRIM+(AR(I)+CR(I)*T2+DR(I)*EQEITR)/XN 10 CONTINUE G01J01=SNGL((PRIP+PRIM)*3.248D1) RETURN 15 VV=F53J01(TDGC) IF(VV.LT.-1.0D19) GO TO 19 IF(ABS(VM3K-VV)/VV.GT.1.0E-4) GO TO 20 G01J01=F30J01(TDGC) RETURN 19 G01J01=VV RETURN 20 G01J01=-1.0E20 RETURN END C 49 ****** FUNCTION F49J01(PBAR) C C SAT. VD(P) VPD SAT. LIQUID SPECFIC VOL.(PRESS) C IF(PBAR.LT.0.01369.OR.PBAR.GT.32.48) GO TO 20 C TDGC=F40J01(PBAR) VSM3K=TDGC IF(TDGC.LT.-1.0E9) GO TO 15 VSM3K=F53J01(TDGC) 15 F49J01=VSM3K RETURN 20 F49J01=-1.0E20 RETURN END C 50 ****** FUNCTION F50J01(PBAR) C C SAT. VDD(P) VPDD SAT. SPECIFIC VOL.(PRESS) C IF(PBAR.LT.0.01369.OR.PBAR.GT.32.48) GO TO 20 C TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 VSM3K=F54J01(TDGC) F50J01=VSM3K RETURN 15 F50J01=TDGC RETURN 20 F50J01=-1.0E20 RETURN END C 80 ****** FUNCTION F80J01(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 S01J01(PBAR0,S,VX,TDGC,H) IF(VX.LT.1.0E-4) GO TO 10 IF(PBAR0.GT.32.48) GO TO 10 PST=F30J01(PBAR0) IF(ABS((PST-PBAR0)/PBAR0).LT.1.0E-5) GO TO 35 10 F80J01=VX RETURN 35 STD=F37J01(TDGC) STDD=F38J01(TDGC) VTD=F53J01(TDGC) VTDD=F54J01(TDGC) SX=(S-STD)/(STDD-STD) VX=VTD+(VTDD-VTD)*SX F80J01=VX RETURN END C 51 ******** FUNCTION F51J01(PBAR,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J01,F51J01,PBAR,TDGC,VNL,VXL,V1,V2,P1,P2 REAL PST,F53J01,F54J01,VMIN,VMAX,PX,PW,VW REAL VM3KC,PCBAR,RGSC DATA VM3KC,TCK,PCBAR,RGSC/1.7361E-3,4.1878D2,32.48,4.86445E-2/ C CHK RANGE PBAR,TDGC IF(PBAR.LT.1.99999E-3.OR.PBAR.GT.2.10001E2) GO TO 70 TK=TDGC+2.7315D2 IF(TK.LT.1.99999D2.OR.TK.GT.5.10001D2) 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=F53J01(TDGC) PST=G01J01(VW,TDGC) IF(ABS(PST/PBAR-1.0).GT.1.0E-6) GO TO 14 VW=F54J01(TDGC) GO TO 60 C 14 IF(PBAR.GT.PST) GO TO 15 VMIN=F54J01(TDGC) PW=G01J01(VMIN,TDGC) IF(PW/PBAR-1.0.LT.5.0E-6) THEN VW=F54J01(TDGC) GO TO 60 END IF VMAX=0.5*RGSC*SNGL(TK) ICASE=4 VNL=VMIN VXL=VMAX GO TO 20 15 VMAX=F53J01(TDGC) PW=G01J01(VMAX,TDGC) IF(PW/PBAR-1.0.GT.-5.0E-6) THEN VW=F54J01(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=F54J01(TDGC) GO TO 60 END IF ICASE=2 VXL=VMAX VNL=VMIN GO TO 25 C C FROM 5 16 VW=VM3KC PX=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(VMIN,TDGC) P2=G01J01(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=G01J01(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=G01J01(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=G01J01(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=G01J01(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 F51J01=-1.E10 RETURN 59 VW=(VMAX+VMIN)*0.5 60 F51J01=VW RETURN 70 F51J01=-1.0E20 RETURN END C 52 ******* FUNCTION F52J01(PBAR,X) TDGC=F40J01(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 V=F55J01(TDGC,X) F52J01=V RETURN 10 F52J01=TDGC RETURN END C 53 ******* FUNCTION F53J01(TDGC) DOUBLE PRECISION AR,TTR,WTTR,RD,VC,TC,TR DIMENSION AR(5) DATA AR/ 2.093014D0, -1.241845D0, 5.376572D0, -6.868137D0, 1 3.542564D0/ DATA VC,TC/1.7361D-3,4.1878D2/ TK=TDGC+273.15 IF(ABS(TK-418.78).LT.0.02) GO TO 20 IF(TK.LT.190.0.OR.TK.GT.418.78) GO TO 30 TR=DBLE(TK)/TC TTR=(1.0D0-TR)**(1.0D0/3.0D0) RD=1.0D0 WTTR=1.0D0 DO 10 I=1,5 WTTR=WTTR*TTR RD=RD+AR(I)*WTTR 10 CONTINUE F53J01=VC/SNGL(RD) RETURN 20 F53J01=VC RETURN 30 F53J01=-1.0E20 RETURN END C 54 ******* FUNCTION F54J01(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F54J01,TDGC,TK,VM3K,PBAR0,PRI,DPRI REAL F30J01,G01J01 C VDD(TDGC) DIMENSION AR(8),BR(8),CR(8),DR(8) DATA AR/0.0D0,-5.114302067D0,-1.132981433D1,2.405450200D1, 1-1.874282774D1,2.947456807D0,1.258434868D0,-3.115346525D-1/ DATA BR/0.0D0,8.868578327D-1,1.383847827D1,-2.646915487D1, 11.999283874D1,-1.000309853D0,-2.591153132D0,5.428375491D-1/ DATA CR/0.0D0,0.0D0,0.0D0,0.0D0,2.046955392D0,-4.803331479D0, 12.518993033D0,-4.042768897D-1/ DATA DR/0.0D0,-2.352424185D2,1.116635615D2,1.595930810D2, 11.957513185D2,-2.813838569D2,9.624041691D1,-1.021979892D1/ DATA ARR,QEI,SMALLB/3.61265D0,6.3D0,2.5D-2/ C TK=TDGC+273.15 C IF(ABS(TK-418.78).GT.0.004) GO TO 1 C ERROR 0.004.LT.0.02(SHOWN IN THE TEXT) C VM3K=1.7361E-3 GO TO 50 1 IF(TK.LT.190.0.OR.TK.GT.418.78) GO TO 40 PBAR0=F30J01(TDGC) C IF(PBAR0.LT.-1.0E9) GO TO 51 IF(PBAR0.LT.32.48) GO TO 2 VM3K=1.7361E-3 GO TO 50 C 2 TR=DBLE(TK)/4.1878D2 IF(TR.LT.6.6D-1) GO TO 4 IF(TR.LT.9.89D-1) GO TO 3 VRS2=1.04556D0*TR**(-4.20904D1) GO TO 5 3 VRS2=1.70358D0*TR**(-9.11253D0) GO TO 5 4 VRS2=3.76674D-1*TR**(-1.24775D1) C 5 VRS1=VRS2*0.9D0 IF(VRS2.LT.2.5D0) VRS1=1.0D0 C 6 VM3K=VRS2*1.7361D-3 PRI=G01J01(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 VRS2=VRS2*1.1D0 VRS1=VRS1*1.1D0 GO TO 6 C 7 VM3K=VRS1*1.7361D-3 PRI=G01J01(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 VRS1=VRS1*9.0D-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*1.7361D-3 PRI=G01J01(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) C 14 EQEITR=DEXP(-QEI*TR) IC=0 VRS1R=VRS1 VRS2R=VRS2 VM3K=VRS1*1.7361D-3 PRI=G01J01(VM3K,TDGC) Y1=PRI-PBAR0 VM3K=VRS2*1.7361D-3 PRI=G01J01(VM3K,TDGC) Y2=PRI-PBAR0 IF(Y1*Y2.GT.0.0) GO TO 30 15 VM3K=VRS2*1.7361D-3 16 IC=IC+1 IF(IC.GT.9) GO TO 20 PRI=G01J01(VM3K,TDGC) IF(PRI.LT.-1.0E9) GO TO 49 DPRI=PRI-PBAR0 IF(ABS(DPRI)/PBAR0.LT.6.0E-6) GO TO 50 X=VRS2-SMALLB U=X*X DPRDX=-ARR*TR/U DO 17 J=2,8 U=U*X DPRDX=DPRDX-J*(AR(J)+(BR(J)+CR(J)*TR)*TR+DR(J)*EQEITR)/U 17 CONTINUE IF(DABS(DPRDX).LT.1.0D-5) GO TO 20 X=X-DBLE(DPRI)/DPRDX VR=X+SMALLB IF(VR.GT.VRS2) GO TO 20 IF(VR.LT.VRS1) GO TO 20 VM3K=VR*1.7361D-3 PRI=G01J01(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*1.7361D-3 PRI=G01J01(VM3K,TDGC) IF(PBAR0.GT.PRI) GO TO 210 DX=1.0D-1*VRS2 DO 205 I=1,50 VM3K=(VRS2+I*DX)*1.7361D-3 PRI=G01J01(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*1.7361D-3 PRI=G01J01(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 VM3K=(VRS1+VRS2)*5.0D-1*1.7361D-3 GO TO 50 C C 21 IF(IC.GT.900) GO TO 30 VM3K=VRS1*1.7361D-3 PRI=G01J01(VM3K,TDGC) Y1=PRI-PBAR0 VM3K=VRS2*1.7361D-3 PRI=G01J01(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*1.7361D-3 GO TO 50 24 YW=(Y1+Y2)/(Y1-Y2) X1=VRS1*1.7361D-3 X2=VRS2*1.7361D-3 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*(X1-X2))*0.5D0 C PRI=G01J01(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=G01J01(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/1.7361D-3 VRS2=X2/1.7361D-3 IF(DABS(VRS2/VRS1-1.0D0).GT.1.0D-6) GO TO 28 VM3K=(VRS2+VRS1)*5.0D-1*1.7361D-3 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*1.7361D-3 GO TO 50 29 VRS1R=VRS1 VRS2R=VRS2 GO TO 25 C 30 F54J01=-1.0E10 RETURN 40 F54J01=-1.0E20 RETURN 49 VM3K=PRI 50 F54J01=VM3K RETURN 51 F54J01=PBAR0 RETURN END C 55 ****** FUNCTION F55J01(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 VD=F53J01(TDGC) IF(VD.LT.-1.0E9) GO TO 20 VDD=F54J01(TDGC) IF(VDD.LT.-1.0E9) GO TO 10 V=(1.0-X)*VD+X*VDD F55J01=V RETURN 10 F55J01=VDD RETURN 20 F55J01=VD RETURN 30 F55J01=-1.0E20 RETURN END C 83 *************** FUNCTION F83J01(PBAR,TDGC) VM3KG=F51J01(PBAR,TDGC) IF(VM3KG.LT.1.0E-4) GO TO 50 WPT=G10J01(VM3KG,TDGC) F83J01=WPT RETURN 50 F83J01=VM3KG RETURN END C G10 *************** FUNCTION G10J01(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL VM3K,TDGC,G10J01,G07J01,G08J01,VV,VTDDT,F54J01,CP,CV DIMENSION AR(8),BR(8),CR(8),DR(8) C DATA ER/-1.241207D1,1.722728D2,-1.593831D2,5.878563D1/ C DATA AR/0.0D0,-5.114302067D0,-1.132981433D1,2.405450200D1, 1-1.874282774D1,2.947456807D0,1.258434868D0,-3.115346525D-1/ DATA BR/0.0D0,8.868578327D-1,1.383847827D1,-2.646915487D1, 11.999283874D1,-1.000309853D0,-2.591153132D0,5.428375491D-1/ DATA CR/0.0D0,0.0D0,0.0D0,0.0D0,2.046955392,-4.803331479D0, 12.518993033D0,-4.042768897D-1/ DATA DR/0.0D0,-2.352424185D2,1.116635615D2,1.595930810D2, 11.957513185D2,-2.813838569D2,9.624041691D1,-1.021979892D1/ DATA ARR,QEI,SMALLB/3.61265D0,6.3D0,2.5D-2/ DATA PC,VC,TC/3.248D1,1.7361D-3,4.1878D2/ C BAR,M3/KG,K C DATA ZC,RR/2.76805D-1,4.86445D-2/ C T=DBLE(TDGC)+2.7315D2 IF(T.LT.2.00D2.OR.T.GT.5.10D2) GO TO 50 C 2 IF(VM3K.LT.6.66666E-4.OR.VM3K.GT.15.0) GO TO 50 VV=VM3K IF(T.GT.TC) GO TO 4 VTDDT=F54J01(TDGC) IF(T.GT.3.699999D2) GO TO 3 IF(ABS(VTDDT/VV-1.0).GT.2.0E-5) GO TO 3 C C SAT VAPOR VV=VTDDT GO TO 4 C 3 IF(VV.LT.VTDDT*0.99998) GO TO 50 4 VR=DBLE(VV)/VC TR=T/TC X=VR-SMALLB XW=X*X XWN=XW EQEITR=DEXP(-QEI*TR) YY=ARR*TR/XW DO 20 I=2,8 XWN=XWN*X YY=YY+ I*(AR(I)+(BR(I)+CR(I)*TR)*TR+DR(I)*EQEITR) /XWN 20 CONTINUE C CP=F18J01(PBAR,TDGC) CP=G07J01(VM3K,TDGC) C CV=F77J01(PBAR,TDGC) CV=G08J01(VM3K,TDGC) C IF(CP.GT.0.0.AND.CV.GT.0.0) GO TO 30 C WRITE(6,220) CP,CV,PBAR,T C 220 FORMAT(1H ,'CP,CV=',2E12.4,' AT PBAR,TK=',F7.2,F10.1) GO TO 50 30 WPT=CP/CV*VR*VR*YY G10J01=DSQRT(WPT*PC*VC*1.0D5) RETURN 40 G10J01=VV RETURN 50 G10J01=-1.0E20 RETURN END C 56 ******* FUNCTION F56J01(PBAR,H) TSDGC=F40J01(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F60J01(TSDGC,H) F56J01=X RETURN 10 F56J01=TSDGC RETURN END C 57 ******* FUNCTION F57J01(PBAR,S) TSDGC=F40J01(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F61J01(TSDGC,S) F57J01=X RETURN 10 F57J01=TSDGC RETURN END C 58 ******* FUNCTION F58J01(PBAR,U) TSDGC=F40J01(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F62J01(TSDGC,U) F58J01=X RETURN 10 F58J01=TSDGC RETURN END C 59 ******* FUNCTION F59J01(PBAR,V) TSDGC=F40J01(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F63J01(TSDGC,V) F59J01=X RETURN 10 F59J01=TSDGC RETURN END C 60 ******* FUNCTION F60J01(TDGC,H) TK=TDGC+273.15 IF(TK.LT.170.0.OR.TK.GT.418.78) GO TO 10 HD=F27J01(TDGC) IF(HD.LT.-1.0E9) GO TO 30 IF(HD.GT.H) GO TO 10 HDD=F28J01(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 F60J01=1.0 RETURN 5 X=(H-HD)/(HDD-HD) F60J01=X RETURN 10 F60J01=-1.0E20 RETURN 20 F60J01=HDD RETURN 30 F60J01=HD RETURN END C 61 ******* FUNCTION F61J01(TDGC,S) TK=TDGC+273.15 IF(TK.LT.170.0.OR.TK.GT.418.78) GO TO 10 SD=F37J01(TDGC) IF(SD.LT.-1.0E9) GO TO 30 IF(SD.GT.S) GO TO 10 SDD=F38J01(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 F61J01=1.0 RETURN 5 X=(S-SD)/(SDD-SD) F61J01=X RETURN 10 F61J01=-1.0E20 RETURN 20 F61J01=SDD RETURN 30 F61J01=SD RETURN END C 62 ******* FUNCTION F62J01(TDGC,U) TK=TDGC+273.15 IF(TK.LT.170.0.OR.TK.GT.418.78) GO TO 10 UD=F46J01(TDGC) IF(UD.LT.-1.0E9) GO TO 30 IF(UD.GT.U) GO TO 10 UDD=F47J01(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 F62J01=1.0 RETURN 5 X=(U-UD)/(UDD-UD) F62J01=X RETURN 10 F62J01=-1.0E20 RETURN 20 F62J01=UDD RETURN 30 F62J01=UD RETURN END C 63 ******* FUNCTION F63J01(TDGC,V) TK=TDGC+273.15 IF(TK.LT.170.0.OR.TK.GT.418.78) GO TO 10 VD=F53J01(TDGC) IF(VD.LT.-1.0E9) GO TO 30 IF(VD.GT.V) GO TO 10 VDD=F54J01(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 F63J01=1.0 RETURN 5 X=(V-VD)/(VDD-VD) F63J01=X RETURN 10 F63J01=-1.0E20 RETURN 20 F63J01=VDD RETURN 30 F63J01=VD RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99J01(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR R 114 ****' 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