C ********** R12B1 ********* 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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(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 S99J04(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99J04(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 DATA FUN/'AJTPT'/ CALL S99J04(FUN) AJTPT=-1.0E+30 RETURN END C------------------------------------------------- F2 = ALAPP FUNCTION ALAPP(P) CHARACTER FUN*6 DATA FUN/'ALAPP'/ CALL S99J04(FUN) ALAPP=-1.0E+30 RETURN END C------------------------------------------------- F3 = ALAPT FUNCTION ALAPT(T) CHARACTER FUN*6 DATA FUN/'ALAPT'/ CALL S99J04(FUN) ALAPT=-1.0E+30 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 12B1'/, 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 = F4J04(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 12B1'/, 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 = F5J04(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 FUNCTION ALMPD(P) CHARACTER FUN*6 DATA FUN/'ALMPD'/ CALL S99J04(FUN) ALMPD=-1.0E+30 RETURN END C------------------------------------------------- F7 = ALMPDD FUNCTION ALMPDD(P) CHARACTER FUN*6 DATA FUN/'ALMPDD'/ CALL S99J04(FUN) ALMPDD=-1.0E+30 RETURN END C------------------------------------------------- F8 = ALMPT FUNCTION ALMPT(P,T) CHARACTER FUN*6 DATA FUN/'ALMPT'/ CALL S99J04(FUN) ALMPT=-1.0E+30 RETURN END C------------------------------------------------- F9 = ALMTD FUNCTION ALMTD(T) CHARACTER FUN*6 DATA FUN/'ALMTD'/ CALL S99J04(FUN) ALMTD=-1.0E+30 RETURN END C------------------------------------------------- F10 = ALMTDD FUNCTION ALMTDD(T) CHARACTER FUN*6 DATA FUN/'ALMTDD'/ CALL S99J04(FUN) ALMTDD=-1.0E+30 RETURN END C------------------------------------------------- F11 = AMUPD FUNCTION AMUPD(P) CHARACTER FUN*6 DATA FUN/'AMUPD'/ CALL S99J04(FUN) AMUPD=-1.0E+30 RETURN END C------------------------------------------------- F12 = AMUPDD FUNCTION AMUPDD(P) CHARACTER FUN*6 DATA FUN/'AMUPDD'/ CALL S99J04(FUN) AMUPDD=-1.0E+30 RETURN END C------------------------------------------------- F13 = AMUPT FUNCTION AMUPT(P,T) CHARACTER FUN*6 DATA FUN/'AMUPT'/ CALL S99J04(FUN) AMUPT=-1.0E+30 RETURN END C------------------------------------------------- F14 = AMUTD FUNCTION AMUTD(T) CHARACTER FUN*6 DATA FUN/'AMUTD'/ CALL S99J04(FUN) AMUTD=-1.0E+30 RETURN END C------------------------------------------------- F15 = AMUTDD FUNCTION AMUTDD(T) CHARACTER FUN*6 DATA FUN/'AMUTDD'/ CALL S99J04(FUN) AMUTDD=-1.0E+30 RETURN END C------------------------------------------------- F92 = BPPT FUNCTION BPPT(P,T) CHARACTER FUN*6 DATA FUN/'BPPT'/ CALL S99J04(FUN) BPPT=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 DATA FUN/'BSPT'/ CALL S99J04(FUN) BSPT=-1.0E+30 RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 DATA FUN/'BTPT'/ CALL S99J04(FUN) BTPT=-1.0E+30 RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 DATA FUN/'BVPT'/ CALL S99J04(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 12B1'/, 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 = F16J04(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 12B1'/, 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 = F17J04(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 12B1'/, 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 = F18J04(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 12B1'/, 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 = F19J04(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 12B1'/, 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 = F20J04(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 12B1'/, 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 = F21J04(A) C--- LEVEL 2 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN A =',A,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF(A.EQ.'T') THEN IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 FF=FF+T0K ELSE IF(A.EQ.'P') THEN IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 FF=FF/PBAR END IF CRP=FF RETURN END C------------------------------------------------- F22 = EPSPT REAL FUNCTION EPSPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 C--- FUNCTION NAME --- DATA FLUID/'R 12B1'/, FUN/'EPSPT'/ 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 --- EPSPT=FF 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='165.37' WHEN A='M' C B='50.2782' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=165.37 ELSE IF (A.EQ.'R') THEN FC=50.2782 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR REFRIGERANT 12B1 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 S99J04(FUN) GAMPDD=-1.0E+30 RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 DATA FUN/'GAMPT'/ CALL S99J04(FUN) GAMPT=-1.0E+30 RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 DATA FUN/'GAMTDD'/ CALL S99J04(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 12B1'/, 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 = F23J04(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 12B1'/, 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 = F24J04(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 12B1'/, 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 = F25J04(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 12B1'/, 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 = F26J04(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 12B1'/, 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 = F27J04(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 12B1'/, 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 = F28J04(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 12B1'/, 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 = F29J04(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 12B1' WHEN A='S' C B='CBRCLF2' 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 12B1' ELSE IF (A.EQ.'C') THEN IDENTF='CBRCLF2' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR REFRIGERANT 12B1 WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F66 = PLDT FUNCTION PLDT(P) CHARACTER FUN*6 DATA FUN/'PLDT'/ CALL S99J04(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT FUNCTION PMLT(P) CHARACTER FUN*6 DATA FUN/'PMLT'/ CALL S99J04(FUN) PMLT=-1.0E+30 RETURN END C------------------------------------------------- F85 = PRPD FUNCTION PRPD(P) CHARACTER FUN*6 DATA FUN/'PRPD'/ CALL S99J04(FUN) PRPD=-1.0E+30 RETURN END C------------------------------------------------- F86 = PRPDD FUNCTION PRPDD(P) CHARACTER FUN*6 DATA FUN/'PRPDD'/ CALL S99J04(FUN) PRPDD=-1.0E+30 RETURN END C------------------------------------------------- F81 = PRPT FUNCTION PRPT(P,T) CHARACTER FUN*6 DATA FUN/'PRPT'/ CALL S99J04(FUN) PRPT=-1.0E+30 RETURN END C------------------------------------------------- F87 = PRTD FUNCTION PRTD(T) CHARACTER FUN*6 DATA FUN/'PRTD'/ CALL S99J04(FUN) PRTD=-1.0E+30 RETURN END C------------------------------------------------- F88 = PRTDD FUNCTION PRTDD(T) CHARACTER FUN*6 DATA FUN/'PRTDD'/ CALL S99J04(FUN) PRTDD=-1.0E+30 RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99J04(FUN) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F30 = PST REAL FUNCTION PST(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 12B1'/, 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 = F30J04(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 PST=FF/PBAR RETURN END C------------------------------------------------- F72 = PSTD FUNCTION PSTD(T) CHARACTER FUN*6 DATA FUN/'PSTD'/ CALL S99J04(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99J04(FUN) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F31 = SIGP FUNCTION SIGP(P) CHARACTER FUN*6 DATA FUN/'SIGP'/ CALL S99J04(FUN) SIGP=-1.0E+30 RETURN END C------------------------------------------------- F32 = SIGT FUNCTION SIGT(T) CHARACTER FUN*6 DATA FUN/'SIGT'/ CALL S99J04(FUN) SIGT=-1.0E+30 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 12B1'/, 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 = F33J04(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 12B1'/, 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 = F34J04(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 12B1'/, 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 = F35J04(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 12B1'/, 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 = F36J04(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 12B1'/, 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 = F37J04(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 12B1'/, 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 = F38J04(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 12B1'/, 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 = F39J04(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 S99J04(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP FUNCTION TMLP(P) CHARACTER FUN*6 DATA FUN/'TMLP'/ CALL S99J04(FUN) TMLP=-1.0E+30 RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 DATA FUN/'TPSEUP'/ CALL S99J04(FUN) TPSEUP=-1.0E+30 RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99J04(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 12B1'/, 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 = F40J04(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 12B1'/, 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 S99J04(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99J04(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 12B1'/, 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 = F42J04(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 12B1'/, 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 = F43J04(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 12B1'/, 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 = F44J04(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 12B1'/, 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 = F45J04(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 12B1'/, 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 = F46J04(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 12B1'/, 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 = F47J04(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 12B1'/, 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 = F48J04(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 12B1'/, 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 = F49J04(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 12B1'/, 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 = F50J04(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 12B1'/, 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 = F51J04(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 12B1'/, 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 = F52J04(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 12B1'/, 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 = F53J04(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 12B1'/, 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 = F54J04(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 12B1'/, 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 = F55J04(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 12B1'/, 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 = F83J04(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 12B1'/, 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 = F56J04(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 12B1'/, 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 = F57J04(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 12B1'/, 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 = F58J04(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 12B1'/, 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 = F59J04(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 12B1'/, 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 = F60J04(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 12B1'/, 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 = F61J04(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 12B1'/, 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 = F62J04(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 12B1'/, 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 = F63J04(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 12B1'/, 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 = F64J04(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 12B1'/, 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 = F65J04(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 12B1'/, 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 = F70J04(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 12B1'/, 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 = F71J04(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 12B1'/, 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 = F82J04(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 12B1'/, 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 = F76J04(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 12B1'/, 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 = F77J04(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 12B1'/, 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 = F78J04(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 12B1'/, 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 = F79J04(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 12B1'/, 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 = F80J04(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VPS=FF RETURN END C ********** ********* C ********** R12B1 ********* C ********** VER. 9.1.********* C C 82 FUNCTION F82J04(PBAR,TDGC) WA=F83J04(PBAR,TDGC) IF(WA.LT.0.0) GO TO 10 VM3K=F51J04(PBAR,TDGC) IF(VM3K.LT.0.0) GO TO 20 DXIN=WA*WA/(PBAR*VM3K*1.0E5) F82J04=DXIN RETURN 10 IF(WA.LT.-1.0E+11) THEN F82J04=-1.0E+20 ELSE F82J04=-1.0E+10 ENDIF RETURN 20 IF(VM3K.LT.1.0E+11) THEN F82J04=-1.0E+20 ELSE F82J04=-1.0E+10 ENDIF RETURN END C 4 ****** FUNCTION F4J04(PBAR) ALH=F24J04(PBAR) IF(ALH.LT.-1.0E9) GO TO 10 HD=F23J04(PBAR) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F4J04=ALH RETURN 20 F4J04=HD RETURN END C 5 ****** FUNCTION F5J04(TDGC) ALH=F28J04(TDGC) IF(ALH.LT.-1.0E9) GO TO 10 HD=F27J04(TDGC) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F5J04=ALH RETURN 20 F5J04=HD RETURN END C 16 ****** FUNCTION F16J04(PBAR) TDGC=F40J04(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPD=F19J04(TDGC) F16J04=CPD RETURN 10 F16J04=TDGC RETURN END C 17 ****** FUNCTION F17J04(PBAR) TDGC=F40J04(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPDD=F20J04(TDGC) F17J04=CPDD RETURN 10 F17J04=TDGC RETURN END C 18 ******* FUNCTION F18J04(PBAR,TDGC) C C CP C VM3K=F51J04(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 10 IF(VM3K.LT.6.3E-4) GO TO 20 PMPA=PBAR*0.1 CP=G03J04(VM3K,TDGC,PMPA) F18J04=CP RETURN 10 F18J04=VM3K RETURN 20 F18J04=-1.0E10 RETURN END C 19 ******* FUNCTION F19J04(TDGC) C C CP SAT. LIQUID(TEMP) C PBAR=F30J04(TDGC) IF(PBAR.LT.-1.0E9) GO TO 30 VM3K=F53J04(TDGC) IF(VM3K.LT.-1.0E9) GO TO 10 IF(VM3K.LT.4.9E-4) GO TO 20 PMPA=PBAR*0.1 CP=G03J04(VM3K,TDGC,PMPA) F19J04=CP RETURN 10 F19J04=VM3K RETURN 20 F19J04=-1.0E10 RETURN 30 F19J04=PBAR RETURN END C 20 ******* FUNCTION F20J04(TDGC) C C CP SAT.VAPOR(TEMP) C PBAR=F30J04(TDGC) IF(PBAR.LT.-1.0E9) GO TO 30 VM3K=F54J04(TDGC) IF(VM3K.LT.-1.0E9) GO TO 10 IF(VM3K.LT.1.48E-3) GO TO 20 PMPA=PBAR*0.1 CP=G03J04(VM3K,TDGC,PMPA) F20J04=CP RETURN 10 F20J04=VM3K RETURN 20 F20J04=-1.0E10 RETURN 30 F20J04=PBAR RETURN END C 21 ******** FUNCTION F21J04(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 F21J04=42.500 RETURN 20 F21J04=153.73 RETURN 30 F21J04=1.4854E-3 RETURN 40 F21J04=0.34807E6 RETURN 50 F21J04=1.405E3 RETURN 60 F21J04=-1.0E+20 RETURN END C 76 ******* FUNCTION F76J04(PBAR) TDGC=F40J04(PBAR) IF(TDGC.LT.-1.0E9) GO TO 20 CVDD=F78J04(TDGC) F76J04=CVDD RETURN 20 F76J04=TDGC RETURN END C 77 ******* FUNCTION F77J04(PBAR,TDGC) C C CV C VM3K=F51J04(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 10 IF(VM3K.LT.6.3E-4) GO TO 20 CV=G04J04(VM3K,TDGC) F77J04=CV RETURN 10 F77J04=VM3K RETURN 20 F77J04=-1.0E10 RETURN END C 78 ******* FUNCTION F78J04(TDGC) C C CV SAT.VAPOR(TEMP) C VM3K=F54J04(TDGC) IF(VM3K.LT.-1.0E9) GO TO 10 IF(VM3K.LT.1.48E-3) GO TO 20 CV=G04J04(VM3K,TDGC) F78J04=CV RETURN 10 F78J04=VM3K RETURN 20 F78J04=-1.0E10 RETURN END C 89 ******** FUNCTION F89J04(C) CHARACTER C IF(C.EQ.'M') GO TO 10 IF(C.EQ.'R') GO TO 20 GO TO 60 10 F89J04=165.37 RETURN 20 F89J04=50.2782 RETURN 60 F89J04=-1.0E+30 RETURN END C 23 ****** FUNCTION F23J04(PBAR) C IF(PBAR.LT.0.2.OR.PBAR.GT.42.500) GO TO 20 C TSDGC=F40J04(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F27J04(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F23J04=H RETURN 15 F23J04=TSDGC RETURN 16 F23J04=H RETURN 20 F23J04=-1.0E20 RETURN END C 24 ****** FUNCTION F24J04(PBAR) C IF(PBAR.LT.0.2.OR.PBAR.GT.42.500) GO TO 20 C TSDGC=F40J04(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F28J04(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F24J04=H RETURN 15 F24J04=TSDGC RETURN 16 F24J04=H RETURN 20 F24J04=-1.0E20 RETURN END C 71 ******* FUNCTION F71J04(PBAR,S) C C H(P,S) C CALL S08J04(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.426.88) GO TO 10 PSAT=F30J04(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 10 STDD=F38J04(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 10 STD=F37J04(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=F28J04(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 HTD=F27J04(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 H=HTD*(1.0-X)+HTDD*X 10 F71J04=H RETURN 11 F71J04=PSAT RETURN 12 F71J04=STDD RETURN 13 F71J04=STD RETURN 14 F71J04=HTDD RETURN 15 F71J04=HTD RETURN 20 F71J04=TDGC RETURN 30 F71J04=-1.0E20 RETURN END C 25 ****** FUNCTION F25J04(PBAR,TDGC) C IF(PBAR.LT.1.0.OR.PBAR.GT.62.0) GO TO 20 IF(TDGC+273.15.LT.360.0.OR.TDGC+273.15.GT.460.0) GO TO 20 C VM3K=F51J04(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-426.88.GT.-273.15) GO TO 10 VTD=F53J04(TDGC) IF((VM3K-VTD)/1.4854E-3.GT.1.0E-5) GO TO 10 H=G02J04(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J04=H RETURN 10 H=G02J04(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J04=H RETURN 15 F25J04=VM3K RETURN 16 F25J04=H RETURN 20 F25J04=-1.0E20 RETURN END C 26 ******* FUNCTION F26J04(PBAR,X) TDGC=F40J04(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 H=F29J04(TDGC,X) F26J04=H RETURN 10 F26J04=TDGC RETURN END C 27 ****** FUNCTION F27J04(TDGC) C C HDT SAT. LIQUID(TEMP) C VDM3K=F53J04(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.4.8E-4) GO TO 20 HD=G02J04(VDM3K,TDGC) F27J04=HD RETURN 10 F27J04=VDM3K RETURN 20 F27J04=-1.0E10 RETURN END C 28 ****** FUNCTION F28J04(TDGC) C C HDDT SAT. VAPOUR(TEMP) C VDM3K=F54J04(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.1.4854E-3) GO TO 20 HDD=G02J04(VDM3K,TDGC) F28J04=HDD RETURN 10 F28J04=VDM3K RETURN 20 F28J04=-1.0E10 RETURN END C 29 ****** FUNCTION F29J04(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 HTD=F27J04(TDGC) IF(HTD.LT.-1.0E9) GO TO 20 HTDD=F28J04(TDGC) IF(HTDD.LT.-1.0E9) GO TO 10 F29J04=(1.0-X)*HTD+X*HTDD RETURN 10 F29J04=HTDD RETURN 20 F29J04=HTD RETURN 30 F29J04=-1.0E20 RETURN END C 30 ****** FUNCTION F30J04(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F30J04,TDGC DIMENSION BI(4) DATA BI/-6.715733D0,1.002208D0,-1.994656D0,7.742518D-1/ DATA PC,TC/4.2500D1,426.88D0/ C BAR K T=DBLE(TDGC+273.15) TAU=1.0D0-(T/TC) IF(TAU.GT.0.0D0) THEN SQTAU=DSQRT(TAU) ELSE PSW=PC GO TO 10 END IF W2=TAU*TAU C PSW=BI(1)*TAU+BI(2)*TAU**1.5+BI(3)*TAU**2.5+BI(4)*TAU**4.5 PSW=((BI(4)*W2*TAU+BI(3))*W2+BI(2)*SQTAU+BI(1))*TAU PSW=DEXP(PSW*TC/T)*PC C BAR 10 F30J04=SNGL(PSW) RETURN END C 33 ****** FUNCTION F33J04(PBAR) C IF(PBAR.LT.0.217.OR.PBAR.GT.42.500) GO TO 20 C TDGC=F40J04(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F37J04(TDGC) IF(S.LT.-1.0E9) GO TO 16 F33J04=S RETURN 15 F33J04=TDGC RETURN 16 F33J04=S RETURN 20 F33J04=-1.0E20 RETURN END C 34 ****** FUNCTION F34J04(PBAR) C IF(PBAR.LT.0.217.OR.PBAR.GT.42.500) GO TO 20 C TDGC=F40J04(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F38J04(TDGC) IF(S.LT.-1.0E9) GO TO 16 F34J04=S RETURN 15 F34J04=TDGC RETURN 16 F34J04=S RETURN 20 F34J04=-1.0E20 RETURN END C 35 ****** FUNCTION F35J04(PBAR,TDGC) C IF(PBAR.LT.1.0.OR.PBAR.GT.62.0) GO TO 20 IF(TDGC+273.15.LT.360.0.OR.TDGC+273.15.GT.460.0) GO TO 20 C VM3K=F51J04(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-426.88.GT.-273.15) GO TO 10 VTD=F53J04(TDGC) IF((VM3K-VTD)/1.4854E-3.GT.1.0E-5) GO TO 10 S=G05J04(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J04=S RETURN 10 S=G05J04(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J04=S RETURN 15 F35J04=VM3K RETURN 16 F35J04=S RETURN 20 F35J04=-1.0E20 RETURN END C 36 ******* FUNCTION F36J04(PBAR,X) TDGC=F40J04(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 S=F39J04(TDGC,X) F36J04=S RETURN 10 F36J04=TDGC RETURN END C 37 ****** FUNCTION F37J04(TDGC) C C SDT SAT. LIQUID(TEMP) C VDM3K=F53J04(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.4.8E-4) GO TO 20 SD=G05J04(VDM3K,TDGC) F37J04=SD RETURN 10 F37J04=VDM3K RETURN 20 F37J04=-1.0E10 RETURN END C 38 ****** FUNCTION F38J04(TDGC) C C SDDT SAT. VAPOUR(TEMP) C VDM3K=F54J04(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.1.4854E-3) GO TO 20 SDD=G05J04(VDM3K,TDGC) F38J04=SDD RETURN 10 F38J04=VDM3K RETURN 20 F38J04=-1.0E10 RETURN END C 39 ******* FUNCTION F39J04(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 STD=F37J04(TDGC) IF(STD.LT.-1.0E9) GO TO 20 STDD=F38J04(TDGC) IF(STDD.LT.-1.0E9) GO TO 10 F39J04=(1.0-X)*STD+X*STDD RETURN 10 F39J04=STDD RETURN 20 F39J04=STD RETURN 30 F39J04=-1.0E20 RETURN END C G02******* FUNCTION G02J04(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G02J04,VM3K,TDGC,UJ,PMPA,G01J04 DATA A01,A02,A03,A04,A05/9.304996919D-2,5.370447241D1, 11.853478820D4,-4.995831746D6,6.310751196D8/ DATA A06,A07,A08,A09,A10/-1.191483710D-1,5.393792079D1, 11.634919553D4,2.986084863D-2,-1.480514431D0/ DATA A11,A12,A13,A14,A15/9.151154779D-2,-9.481726991D1, 12.721693016D1,-7.125002870D6,4.372082961D9/ DATA A16,A17,A18,A19,A20/-1.156062057D12,3.540280722D7, 1-3.086865892D10,5.824394999D12,2.700000000D0/ C DATA T0,H0/2.9815D2,3.4677D2/ C R12B1 DATA D1,D2,D3,D4,D5/4.591353E-2,2.887161E-3,-9.858437E-6, 12.147228E-8,-1.861243E-11/ C T=DBLE(TDGC)+2.731500D2 TMT=T-T0 T2C=T+T0 T3C=T2C*T2C-T*T0 T4C=T2C*(T2C*T2C-2.000D0*T*T0) T5C=T2C**4-3.000D0*T*T0*T2C*T2C+(T*T0)**2 RO=1.000D-3/DBLE(VM3K) C GRAM/CM 3 RO2=RO*RO RO3=RO2*RO C R=8.31451D0/165.370D0 C KJ/KMOL K KG/KMOLE C WP=D1+D2*T2C*5.000D-1+D4*T4C*2.500D-1 WM=D3*T3C/3.000D0+D5*T5C*2.000D-1 TI=1.000D0/T T2I=TI*TI T3I=T2I*TI T4I=T2I*T2I T5I=T3I*T2I T6I=T3I*T3I C BDP=((A05*T2I*4.000D0+2.000D0*A03)*TI+A02)*T2I BDM=3.000D0*A04*T4I CDM=(-2.000D0*A08*TI-A07)*T2I DDP=-A10*T2I EDP=-A12*T2I FDM=-A13*T2I GDP=(-5.000D0*A16*T2I-3.000D0*A14)*T4I GDM=-4.000D0*A15*T5I HDM=(-5.000D0*A19*T2I-3.000D0*A17)*T4I HDP=-4.000D0*A18*T5I C T2=T*T SP=((EDP*2.500D-1*RO+DDP/3.000D0)*RO2+BDP)*RO SM=((FDM*RO3*2.000D-1+CDM*5.000D-1)*RO+BDM)*RO WE=DEXP(-A20*RO2) W1=(1.000D0-WE)/(A20+A20) W2=(1.000D0-(A20*RO2+1.000D0)*WE)/(2.000D0*A20*A20) SKP=GDP*W1+HDP*W2 SKM=GDM*W1+HDM*W2 W1=SP+SKP W2=SM+SKM W3=-T2*W2+WP*TMT-T2*W1+WM*TMT WE=W3+H0-R*T UJ=SNGL(WE)*1.0E3 PMPA=G01J04(VM3K,TDGC)*0.1 IF(PMPA.LT.0.020) GO TO 10 G02J04=UJ+PMPA*VM3K*1.0E6 RETURN 10 G02J04=-1.0E20 RETURN END C 64 ******* FUNCTION F64J04(PBAR0,H) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F64J04,TDGC,HW,TMAX,TMIN,HDP,HDDP,HX,H1,H2,TSP,VX,TWH REAL PBAR0,H,G02J04,F40J04,F51J04,TMAXT,VMINT,VMAXT REAL F53J04,F54J04,TLCK,TCC,VDP,VDDP,VDPMAX,VCM3K,G01J04 C DATA HC/3.4807D5/ DATA PCBAR,TCK,ROCKM3/4.2500D1,4.2688D2,6.732D2/ DATA VMINT,TMAXT,TLCK,VMAXT/0.6326E-3,460.0,360.0,229.80E-3/ C IF(PBAR0.LT.1.0.OR.PBAR0.GT.62.0) GO TO 40 TLCK=360.1 IF(H.LT.2.65E5.OR.H.GT.4.2807E5) GO TO 40 IF(ABS(PBAR0-42.500).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=426.88-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=F40J04(PBAR0) TSP=TDGC IF(TDGC.LT. -39.15) GO TO 40 C -39.15=234.0-273.15 C VDP=F53J04(TDGC) HDP=G02J04(VDP,TDGC) IF(HDP.LT.1.0E-1) 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=F53J04(TMAX) TSP=(TMAX+273.15-TLCK)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J04(TDGC) HDP=G02J04(VDP,TDGC) IF(HDP.LT.0.1) GO TO 6 IF(HDP.LT.H) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J04(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.VMINT) VX=VDP HX=G02J04(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=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 71 HX=G02J04(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 TMIN=TLCK-273.15 GO TO 12 END IF VDP=F53J04(TLCK-273.15) HDP=G02J04(VDP,TLCK-273.15) IF(HDP.LT.H) THEN GO TO 9 END IF ICASE=2 C C TMIN=TLCK C****************** TMAX=TMAXT-273.15 VX=F51J04(PBAR0,TMIN) IF(VX.LT.VMINT.OR.VX.GT.VMAXT) THEN GO TO 81 END IF C C HX=G02J04(VX,TMIN) C**************** C C IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 32 C TDGC=SNGL(TCK)-273.15 VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) THEN GO TO 81 END IF HX=G02J04(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=TLCK GO TO 81 ELSE TMIN=TDGC TMAX=TMAXT-273.15 GO TO 14 END IF C 81 TWH=(TCK-TLCK*0.99)/9.99 TMAX=TCK-273.15 TMIN=TLCK*0.99-273.15 ICOUNT=0 85 IMARK=1 DO 82 I=1,11 TDGC=TMAX-(I-1)*TWH VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 82 IF(VX.GT.VMAXT) GO TO 82 HX=G02J04(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(IMARK.EQ.1) THEN H1=HX IMARK=2 ELSE H2=H1 H1=HX IF((H1-H)*(H2-H).GT.0.0) GO TO 82 TMAX=TMAX-(I-2)*TWH TWH=TWH/9.5 ICOUNT=ICOUNT+1 IF(ICOUNT.LT.5) GO TO 85 TMIN=TDGC GO TO 25 END IF 82 CONTINUE C 9 TSP=(SNGL(TCK)-TLCK*0.99)/49.99 DO 10 I=1,50 TDGC=TLCK+I*TSP-273.15 VDP=F53J04(TDGC) HDP=G02J04(VDP,TDGC) IF(HDP.GT.H) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J04(PBAR0,TMIN) IF(VX.LT.VMINT.OR.VX.GT.VCM3K) THEN TCC=SNGL(TCK)-273.15 TSP=(TMAXT-273.15-TMIN)/200.0 ICASE=2 DO 712 I=1,202 TDGC=TMIN+(I-1)*TSP IF(TDGC+273.15.GT.TMAXT) GO TO 716 VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN HX=G02J04(VX,TDGC) ELSE HX=G02J04(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=G02J04(VX,TMIN) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 32 IF(HX.GT.H) THEN TMAX=TMIN C DO 713 IMARK=1,5 IF(IMARK.EQ.1) THEN TWH=TMAX HW=1.0E10 ELSE TMAX=TWH TMIN=TDGC TSP=TSP/49.9 END IF DO 711 I=1,51 TDGC=TMAX-(I-1)*TSP VX=F51J04(PBAR0,TDGC) IF(VX.LT.0.995*VMINT) GO TO 711 HX=G02J04(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.LT.H .OR. HX.GT.HW) GO TO 713 TWH=TDGC HW=HX 711 CONTINUE IF(ABS(HW/H-1.0).LT.5.0E-4) THEN TDGC=TWH GO TO 30 END IF GO TO 50 713 CONTINUE IF(ABS(HW/H-1.0).LT.1.0E-4) THEN TDGC=TWH GO TO 30 END IF IF(HW.GT.1.0E10 .OR. ABS(TMAX-TMIN).LT.1.0E-2) GO TO 50 C ICASE=2 GO TO 15 END IF C C TMAX SET TDGC=SNGL(TCK)-273.15 VX=F51J04(PBAR0,TDGC) HX=G02J04(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) THEN TMAX=TDGC ELSE TMAX=TMAXT-273.15 TMIN=TDGC END IF ICASE=2 GO TO 15 C 12 TMAX=TMAXT-273.15 TCC=SNGL(TCK)-273.15 TDGC=(TMIN+TMAX)*0.5 VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 50 HX=G02J04(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=F54J04(TDGC) IF(VDDP.LT.VCM3K) GO TO 50 HDDP=G02J04(VDDP,TDGC) IF(H/HDDP-1.0.LT.1.0E-6) GO TO 30 C ADAAX **************************** IF(H.GT.HC .OR. H.GT.HDDP) THEN TMIN=TDGC TMAX=TMAXT-273.15 ICASE=4 TSP=(TMAX-TMIN)/24.9 TWH=TMAX HW=2.0E10 DO 135 IMARK=1,5 DO 133 I=1,26 TDGC=TMAX-(I-1)*TSP VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) THEN GO TO 134 END IF HX=G02J04(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.LT.H .OR. HX.GT.HW) GO TO 134 HW=HX TWH=TDGC 133 CONTINUE IF(ABS(HW/H-1.0).LT.5.0E-4) THEN TDGC=TWH GO TO 30 END IF GO TO 50 134 TMAX=TWH TMIN=TDGC TSP=(TMAX-TMIN)/24.9 135 CONTINUE IF(ABS(HW/H-1.0).LT.1.0E-4) THEN TDGC=TWH GO TO 30 END IF IF(HW.GT.1.0E10 .OR. ABS(TMAX-TMIN).LT.1.0E-2) THEN GO TO 50 END IF C GO TO 15 ELSE C ADAAA **************************** TMAX=TDGC TMIN=TLCK-0.1-273.15 VX=F51J04(PBAR0,TMIN) IF(VX.LT.VMINT) THEN TMIN=TLCK-273.15 VX=F51J04(PBAR0,TMIN) IF(VX.LT.VMINT) GO TO 40 END IF HX=G02J04(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=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 131 H2=G02J04(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=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 141 IF(VX.GT.VMAXT) GO TO 141 HX=G02J04(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=F51J04(PBAR0,TMIN) H1=G02J04(VX,TMIN) VX=F51J04(PBAR0,TMAX) H2=G02J04(VX,TMAX) IF(ABS(H1/H-1.0).LT.1.0E-6) GO TO 32 IF(ABS(H2/H-1.0).LT.1.0E-6) GO TO 31 C TSP=(TMAX-TMIN)/24.9 TWH=TMAX HW=2.0E10 DO 145 IMARK=1,5 DO 143 I=1,25 TDGC=TMAX-(I-1)*TSP VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 143 HX=G02J04(VX,TDGC) IF(ABS(HW/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.LT.H .OR. HX.GT.HW) GO TO 144 HW=HX TWH=TDGC 143 CONTINUE IF(ABS(HW/H-1.0).LT.5.0E-4) THEN TDGC=TWH GO TO 30 END IF GO TO 146 144 TMAX=TWH TMIN=TDGC TSP=(TMAX-TMIN)/24.9 145 CONTINUE IF(ABS(HW/H-1.0).LT.1.0E-4) THEN TDGC=TWH GO TO 30 END IF C 146 GO TO 50 C 25 IF((H1-H)*(H2-H).GT.0.0) GO TO 50 261 IF(PBAR0.GT.PCBAR) GO TO 265 TDGC=F40J04(PBAR0) IF(TDGC.LT.234.5-273.15) GO TO 50 VDDP=F54J04(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G02J04(VDDP,TDGC) IF(H.GT.HDDP) THEN GO TO 263 END IF GO TO 26 C 263 H1=HDDP TMIN=TDGC IF(TDGC.LT.TLCK-273.15) THEN TMIN=TLCK-273.15 TDGC=TMIN VDDP=F54J04(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G02J04(VDDP,TDGC) H1=HDDP IF(H1.LT.0.1) GO TO 50 IF(H.LT.HDDP) GO TO 26 END IF C IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) THEN TMAX=TMAXT-273.15 TDGC=TMAX VX=F51J04(PBAR0,TDGC) HX=G02J04(VX,TDGC) IF(HX.LT.H) GO TO 40 C OUT OF RANGE H2=HX END IF C TWH=TMIN TSP=TMAX-TMIN DO 264 I=1,20 TDGC=TWH+I*TSP/19.9 VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 264 HW=G02J04(VX,TDGC) IF(HW.LT.0.1) GO TO 264 IF(ABS(HW/H-1.0).LT.1.0E-6) GO TO 30 IF((H1-H)*(HW-H).GT.0.0) THEN H1=HW TMIN=TDGC ELSE H2=HW TMAX=TDGC GO TO 26 END IF 264 CONTINUE C GO TO 50 C 265 IF(TMIN.LT.TLCK-273.15) TMIN=TLCK-273.15 IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) TMAX=TMAXT-273.15 TDGC=TMIN VX=F51J04(PBAR0,TDGC) HX=G02J04(VX,TDGC) IF(HX.GT.H) GO TO 40 C OUT OF RANGE H1=HX TDGC=TMAX VX=F51J04(PBAR0,TDGC) HX=G02J04(VX,TDGC) IF(HX.LT.H) GO TO 40 C OUT OF RANGE H2=HX C TWH=TMIN TSP=TMAX-TMIN DO 267 I=1,20 TDGC=TWH+I*TSP/19.9 VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 267 HW=G02J04(VX,TDGC) IF(HW.LT.0.1) GO TO 267 IF(ABS(HW/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.GT.H) GO TO 266 IF(HX.GT.H1) THEN H1=HX TMIN=TDGC END IF GO TO 267 C 266 IF(HX.LT.H2) THEN H2=HX TMAX=TDGC END IF 267 CONTINUE C 26 IC=0 TMNR=TMIN TMXR=TMAX 27 TDGC=(TMIN+TMAX)*0.5 28 VX=F51J04(PBAR0,TDGC) HW=G02J04(VX,TDGC) IF(ABS(HW/H-1.0).LT.1.0E-6) THEN PST=G01J04(VX,TDGC) IF(ABS(PST/PBAR0-1.0).LT.1.0E-6) GO TO 30 C WRITE(*,*) 'HW=H BUT PST NOT PBAR0 GO ON REPEAT' END IF IC=IC+1 IF(IC.GT.999) GO TO 50 IF(ABS(H1/H2-1.0).GT.1.0E-5) GO TO 29 TDGC=(TMIN+TMAX)*0.5 C 281 DO 283 K=1,8 TWH=(TMXR-TMNR)/10.3 IS0=0 DO 282 I=1,10 TDGC=TMNR+I*TWH VX=F51J04(PBAR0,TDGC) IF(VX.LT.0.49E-3) GO TO 282 TSP=G01J04(VX,TDGC) IF(TSP.LT.0.21) GO TO 282 HW=G02J04(VX,TDGC) IF(IS0.EQ.0) THEN H1=ABS(HW/H-1.0)+ABS(TSP/PBAR0-1.0) IF(H1.LT.2.0E-6) GO TO 30 VDP=VX IMK=I IS0=2 GO TO 282 END IF H2=ABS(HW/H-1.0)+ABS(TSP/PBAR0-1.0) IF(H2.LT.2.0E-6) GO TO 30 IF(H1.LT.H2) GO TO 282 H1=H2 IMK=I VDP=VX C 282 CONTINUE TMXR=TMNR+(IMK+1)*TWH TMNR=TMNR+(IMK-1)*TWH 283 CONTINUE TDGC=TMNR+IMK*TWH VX=VDP GO TO 30 C 29 IF((H1-H)*(HW-H).GT.0.0) THEN H1=HW TMIN=TDGC ELSE H2=HW TMAX=TDGC END IF TRS1=TMIN+273.15 TRS2=TMAX+273.15 IF(DABS(TRS1/TRS2-1.0D0).LT.1.0D-3) GO TO 27 TWH=TDGC TDGC=(TMAX+TMIN)*0.5+(TMIN-TMAX)*(H-(H1+H2)*0.5)/(H1-H2) IF(ABS(TDGC-TWH).GT.1.0E-2) GO TO 291 TWH=(TMAX+TMIN)*0.5 IF(ABS(TDGC-TWH).GT.1.0E-2) THEN TDGC=TWH END IF C 291 IF(TDGC.LT.TMIN.OR.TDGC.GT.TMAX) GO TO 27 GO TO 28 C C 30 F64J04=TDGC RETURN 31 F64J04=TMAX RETURN 32 F64J04=TMIN RETURN 40 F64J04=-1.0E20 RETURN 50 F64J04=-1.0E10 RETURN END C 65 ******* FUNCTION F65J04(PBAR0,S) C C G05(V,T)=S VAPOR,S LIQUID C CALL S08J04(PBAR0,S,VM3K,TDGC,H) F65J04=TDGC RETURN END C G05 ****** FUNCTION G05J04(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G05J04,VM3K,TDGC DATA A01,A02,A03,A04,A05/9.304996919D-2,5.370447241D1, 11.853478820D4,-4.995831746D6,6.310751196D8/ DATA A06,A07,A08,A09,A10/-1.191483710D-1,5.393792079D1, 11.634919553D4,2.986084863D-2,-1.480514431D0/ DATA A11,A12,A13,A14,A15/9.151154779D-2,-9.481726991D1, 12.721693016D1,-7.125002870D6,4.372082961D9/ DATA A16,A17,A18,A19,A20/-1.156062057D12,3.540280722D7, 1-3.086865892D10,5.824394999D12,2.700000000D0/ C DATA T0,S0,P0/2.9815D2,1.5417D0,1.0D-1/ C R12B1 S VAP. DATA D1,D2,D3,D4,D5/4.591353D-2,2.887161D-3,-9.858437D-6, 12.147228D-8,-1.861243D-11/ C T=DBLE(TDGC)+2.731500D2 TMT=T-T0 T2C=T+T0 T3C=T2C*T2C-T*T0 T4C=T2C*(T2C*T2C-2.000D0*T*T0) T5C=T2C**4-3.000D0*T*T0*(T2C*T2C-2.000D0*T*T0)-5.000D0*(T*T0)**2 RO=1.000D-3/DBLE(VM3K) C GRAM/CM 3 RO2=RO*RO C R=8.31451D0/165.370D0 C KJ/KMOL K KG/KMOLE C C S0+D1*DLOG(T/T0) WP=D2+D4*T3C/3.000D0 WM=D3*T2C*5.000D-1+D5*T4C*2.500D-1 WY=DLOG(R*T*RO/P0) IF(WY.GT.0.0) THEN WYP=R*WY WYM=0.0D0 ELSE WYP=0.0D0 WYM=R*WY END IF TI=1.000D0/T T2I=TI*TI T3I=T2I*TI T4I=T2I*T2I T5I=T3I*T2I T6I=T3I*T3I IF(T.GT.0.0) GO TO 10 C BDP=((A05*T2I*4.000D0+2.000D0*A03)*TI+A02)*T2I BDM=3.000D0*A04*T4I CDM=(-2.000D0*A08*TI-A07)*T2I DDP=-A10*T2I EDP=-A12*T2I FDM=-A13*T2I GDP=(-5.000D0*A16*T2I-3.000D0*A14)*T4I GDM=-4.000D0*A15*T5I HDM=(-5.000D0*A19*T2I-3.000D0*A17)*T4I HDP=-4.000D0*A18*T5I C BP=A01-A04*T3I BM=-((A05*T2I+A03)*TI+A02)*TI CP=A08*T2I+A07*TI CM=A06 DP=A09 DM=A10*TI EP=A11 EM=A12*TI FP=A13*TI GP=A15*T4I GM=(A16*T2I+A14)*T3I HP=(A19*T2I+A17)*T3I HM=A18*T4I C BBDPT=BP+BDP*T CCDPT=CP DDDPT=DP+DDP*T EEDPT=EP+EDP*T FFDPT=FP GGDPT=GP+GDP*T HHDPT=HP+HDP*T BBDMT=BM+BDM*T CCDMT=CM+CDM*T DDDMT=DM EEDMT=EM FFDMT=FDM*T GGDMT=GM+GDM*T HHDMT=HM+HDM*T IF(T.GT.0.0) GO TO 20 C 10 BBDPT=A01+(3.0D0*A05*T2I+A03)*T2I CCDPT=0.0D0 DDDPT=A09 EEDPT=A11 FFDPT=0.0D0 GGDPT=(-2.0D0*A14-4.0D0*A16*T2I)*T3I HHDPT=-3.0D0*A18*T4I BBDMT=2.0D0*A04*T3I CCDMT=A06-A08*T2I DDDMT=0.0D0 EEDMT=0.0D0 FFDMT=0.0D0 GGDMT=-3.0D0*A15*T4I HHDMT=(-2.0D0*A17-4.0D0*A19*T2I)*T3I C 20 ZP=((((FFDPT*RO/5.0D0+EEDPT/4.0D0)*RO+DDDPT/3.0D0)*RO+CCDPT/ 1 2.0D0)*RO+BBDPT)*RO ZM=((((FFDMT*RO/5.0D0+EEDMT/4.0D0)*RO+DDDMT/3.0D0)*RO+CCDMT/ 1 2.0D0)*RO+BBDMT)*RO WE=DEXP(-A20*RO2) W1=(1.000D0-WE)/(A20+A20) W2=(1.000D0-(A20*RO2+1.000D0)*WE)/(2.000D0*A20*A20) IF(W2.GT.0.0) THEN HHD1=HHDPT HHD2=HHDMT ELSE HHD1=HHDMT HHD2=HHDPT END IF SKP=GGDPT*W1+HHD1*W2 SKM=GGDMT*W1+HHD2*W2 W1=ZP+SKP W2=ZM+SKM WSP=WP*TMT-WYM-W2 WSM=WM*TMT-WYP-W1 C C WXP=S0+D1*ALOG(T/T0), WP=D2+D4*T3C/3, WM=D3*T2C/2+D5*T4C/4 C A*WY=A*ALOG(R*T*RO/P0) WYP OR WYM C WLOG=D1*DLOG(T/T0) G05J04=SNGL(WSP+S0+WLOG+WSM)*1.0E3 RETURN END C S08 ******* SUBROUTINE S08J04(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,G05J04,F40J04,F51J04,TMAXT,VMINT,VMAXT REAL F53J04,F54J04,TLCK,TCC,VDP,VDDP,VDPMAX,VCM3K REAL F37J04,VM3K,TEMPC,H,G02J04,G01J04,TMNR,TMXR C DATA SC/1.4051D3/ C J/KG K DATA PCBAR,TCK,ROCKM3/4.2500D1,4.2688D2,6.732D2/ DATA VMINT,TMAXT,TLCK,VMAXT/0.6326E-3,460.0,360.0,229.80E-3/ C IF(PBAR0.LT.1.0.OR.PBAR0.GT.62.0) GO TO 40 IF(VM3K.LT.0.6325E-3.OR.VM3K.GT.229.85E-3) GO TO 40 TLCK=360.0 IF(S.LT.1.1950E3.OR.S.GT.1.7586E3) GO TO 40 IF(ABS(PBAR0-42.500).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=426.88-273.15 VX=1.0/SNGL(ROCKM3) C VX=1.4854E-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=F40J04(PBAR0) TSP=TDGC IF(TDGC.LT. -39.15) GO TO 40 C -39.15=234.0-273.15 C SDP=F37J04(TDGC) IF(SDP.LT.1.0E-3) 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=F53J04(TMAX) TSP=(TMAX+273.15-TLCK)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J04(TDGC) SDP=G05J04(VDP,TDGC) IF(SDP.LT.0.001) GO TO 6 IF(SDP.LT.S) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J04(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.VMINT) VX=VDP SX=G05J04(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=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 71 SX=G05J04(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(VX.GT.VDPMAX) GO TO 72 IF(SX.GT.S) GO TO 72 71 CONTINUE 72 TMAX=TDGC ICASE=1 GO TO 717 C 8 IF(S.GT.SC) THEN TMIN=TLCK-273.15 GO TO 12 END IF VDP=F53J04(TLCK-273.15) SDP=G05J04(VDP,TLCK-273.15) IF(SDP.LT.S) THEN GO TO 9 END IF ICASE=2 C C TMIN=TLCK C****************** TMAX=TMAXT-273.15 TMIN=TLCK-273.15 VX=F51J04(PBAR0,TMIN) IF(VX.LT.VMINT.OR.VX.GT.VMAXT) THEN GO TO 717 END IF C C SX=G05J04(VX,TMIN) C**************** C IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 C TDGC=SNGL(TCK)-273.15 VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) THEN GO TO 717 END IF SX=G05J04(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN TMAX=TDGC C TMIN=TLCK GO TO 717 ELSE TMIN=TDGC TMAX=TMAXT-273.15 ICASE=3 GO TO 717 END IF C 9 TSP=(SNGL(TCK)-TLCK)/50.0 DO 10 I=1,50 TDGC=TLCK+I*TSP-273.15 VDP=F53J04(TDGC) SDP=G05J04(VDP,TDGC) IF(SDP.GT.S) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J04(PBAR0,TMIN) C IF(VX.LT.VMINT.OR.VX.GT.VCM3K) THEN TCC=SNGL(TCK)-273.15 TSP=(TMAXT-273.15-TMIN)/200.0 ICASE=2 DO 712 I=1,202 TDGC=TMIN+(I-1)*TSP IF(TDGC+273.15.GT.TMAXT) THEN GO TO 716 END IF VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN SX=G05J04(VX,TDGC) ELSE SX=G05J04(VX,TDGC) END IF IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN TMAX=TDGC TMIN=TDGC-TSP GO TO 717 END IF 712 CONTINUE 716 GO TO 50 END IF C SX=G05J04(VX,TMIN) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 IF(SX.GT.S) THEN TMAX=TMIN ICASE=2 GO TO 717 ELSE GO TO 718 END IF C 717 DO 713 IMARK=1,5 IF(IMARK.EQ.1) THEN TSP=(TMAX-TMIN)/49.9 TWS=TMAX SW=2.0E10 ELSE TMAX=TWS TMIN=TDGC TSP=TSP/50.0 END IF DO 711 I=1,52 TDGC=TMAX-(I-1)*TSP VX=F51J04(PBAR0,TDGC) IF(VX.LT.0.995*VMINT) GO TO 711 SX=G05J04(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 C IF(SX.LT.S .OR. SX.GT.SW) GO TO 713 TWS=TDGC SW=SX 711 CONTINUE IF(ABS(SW/S-1.0).LT.5.0E-4) THEN TDGC=TWS GO TO 30 END IF GO TO 50 713 CONTINUE IF(ABS(SW/S-1.0).LT.1.0E-4) THEN TDGC=TWS GO TO 30 END IF IF(SW.GT.1.0E10 .OR. ABS(TMAX-TMIN).LT.1.0E-2) THEN GO TO 50 END IF C GO TO 15 C C TMAX SET 718 TDGC=SNGL(TCK)-273.15 VX=F51J04(PBAR0,TDGC) SX=G05J04(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN TMAX=TDGC ELSE TMAX=TMAXT-273.15 TMIN=TDGC END IF ICASE=2 GO TO 717 C 12 TMAX=TMAXT-273.15 TCC=SNGL(TCK)-273.15 TDGC=(TMIN+TMAX)*0.5 VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 50 SX=G05J04(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) THEN TMAX=TDGC ELSE TMIN=TDGC END IF ICASE=3 GO TO 717 C 13 VDDP=F54J04(TDGC) IF(VDDP.LT.VCM3K) GO TO 50 SDDP=G05J04(VDDP,TDGC) IF(S/SDDP-1.0.LT.1.0E-6) THEN VX=VDDP GO TO 30 END IF C ADAAX **************************** IF(S.GT.SC) THEN TMIN=TDGC TMAX=TMAXT-273.15 ICASE=4 TSP=(TMAX-TMIN)/24.9 TWS=TMAX SW=2.0E10 DO 135 IMARK=1,5 DO 133 I=1,26 TDGC=TMAX-(I-1)*TSP VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 134 SX=G05J04(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.LT.S .OR. SX.GT.SW) GO TO 134 SW=SX TWS=TDGC 133 CONTINUE IF(ABS(SW/S-1.0).LT.5.0E-4) THEN TDGC=TWS GO TO 30 END IF GO TO 50 134 TMAX=TWS TMIN=TDGC TSP=(TMAX-TMIN)/24.9 135 CONTINUE IF(ABS(SW/S-1.0).LT.1.0E-4) THEN TDGC=TWS GO TO 30 END IF IF(SW.GT.1.0E10 .OR. ABS(TMAX-TMIN).LT.1.0E-2) GO TO 50 C GO TO 15 ELSE C ADAAA **************************** TMAX=TDGC TMIN=TLCK-0.1-273.15 VX=F51J04(PBAR0,TMIN) IF(VX.LT.VMINT) THEN TMIN=TLCK-273.15 VX=F51J04(PBAR0,TMIN) IF(VX.LT.VMINT) GO TO 40 END IF SX=G05J04(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=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 131 S2=G05J04(VX,TDGC) IF(S2.GT.S) GO TO 132 131 CONTINUE 132 TMAX=TDGC TMIN=TDGC-TWS ICASE=1 GO TO 15 END IF C **************************** C 15 IF(TMIN.GT.TMAX) THEN TDGC=TMIN TMIN=TMAX TMAX=TDGC END IF C TCC=SNGL(TCK)-273.15 TMINK=TMIN+237.15 VX=F51J04(PBAR0,TMIN) S1=G05J04(VX,TMIN) VX=F51J04(PBAR0,TMAX) S2=G05J04(VX,TMAX) IF(ABS(S1/S-1.0).LT.1.0E-6) GO TO 32 IF(ABS(S2/S-1.0).LT.1.0E-6) GO TO 31 C TSP=(TMAX-TMIN)/24.9 TWS=TMAX SW=2.0E10 DO 145 IMARK=1,5 DO 143 I=1,26 TDGC=TMAX-(I-1)*TSP VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 143 SX=G05J04(VX,TDGC) IF(ABS(SW/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.LT.S .OR. SX.GT.SW) GO TO 144 SW=SX TWS=TDGC 143 CONTINUE IF(ABS(SW/S-1.0).LT.5.0E-4) THEN TDGC=TWS GO TO 30 END IF GO TO 146 144 TMAX=TWS TMIN=TDGC TSP=(TMAX-TMIN)/24.9 145 CONTINUE IF(ABS(SW/S-1.0).LT.1.0E-4) THEN TDGC=TWS GO TO 30 END IF C 146 GO TO 50 C 25 IF((S1-S)*(S2-S).GT.0.0) GO TO 50 261 IF(PBAR0.GT.PCBAR) GO TO 265 TDGC=F40J04(PBAR0) IF(TDGC.LT.234.5-273.15) GO TO 50 VDDP=F54J04(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G05J04(VDDP,TDGC) IF(S.GT.HDDP) THEN GO TO 263 END IF GO TO 26 C 263 S1=HDDP TMIN=TDGC IF(TDGC.LT.TLCK-273.15) THEN TMIN=TLCK-273.15 TDGC=TMIN VDDP=F54J04(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G05J04(VDDP,TDGC) S1=HDDP IF(S1.LT.0.1) GO TO 50 IF(S.LT.HDDP) GO TO 26 END IF C IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) THEN TMAX=TMAXT-273.15 TDGC=TMAX VX=F51J04(PBAR0,TDGC) SX=G05J04(VX,TDGC) IF(SX.LT.S) GO TO 40 C OUT OF RANGE S2=SX END IF C TWS=TMIN TSP=TMAX-TMIN DO 264 I=1,20 TDGC=TWS+I*TSP/19.9 VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 264 SW=G05J04(VX,TDGC) IF(SW.LT.0.1) GO TO 264 IF(ABS(SW/S-1.0).LT.1.0E-6) GO TO 30 IF((S1-S)*(SW-S).GT.0.0) THEN S1=SW TMIN=TDGC ELSE S2=SW TMAX=TDGC GO TO 26 END IF 264 CONTINUE C GO TO 50 C 265 IF(TMIN.LT.TLCK-273.15) TMIN=TLCK-273.15 IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) TMAX=TMAXT-273.15 TDGC=TMIN VX=F51J04(PBAR0,TDGC) SX=G05J04(VX,TDGC) IF(SX.GT.S) GO TO 40 C OUT OF RANGE S1=SX TDGC=TMAX VX=F51J04(PBAR0,TDGC) SX=G05J04(VX,TDGC) IF(SX.LT.S) GO TO 40 C OUT OF RANGE S2=SX C TWS=TMIN TSP=TMAX-TMIN DO 267 I=1,20 TDGC=TWS+I*TSP/19.9 VX=F51J04(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 267 SW=G05J04(VX,TDGC) IF(SW.LT.0.1) GO TO 267 IF(ABS(SW/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.GT.S) GO TO 266 IF(SX.GT.S1) THEN S1=SX TMIN=TDGC END IF GO TO 267 C 266 IF(SX.LT.S2) THEN S2=SX TMAX=TDGC END IF 267 CONTINUE C 26 IC=0 27 TDGC=(TMIN+TMAX)*0.5 28 VX=F51J04(PBAR0,TDGC) SW=G05J04(VX,TDGC) IF(ABS(SW/S-1.0).LT.1.0E-6) THEN PST=G01J04(VX,TDGC) IF(ABS(PST/PBAR0-1.0).LT.1.0E-6) GO TO 30 C WRITE(*,*) 'SW=S BUT PST NOT PBAR0 GO ON REPEAT' END IF C IC=IC+1 IF(IC.GT.999) GO TO 50 IF(ABS(S1/S2-1.0).GT.1.0E-5) GO TO 29 TDGC=(TMIN+TMAX)*0.5 C 281 DO 283 K=1,8 TWS=(TMXR-TMNR)/10.3 IS0=0 DO 282 I=1,10 TDGC=TMNR+I*TWS VX=F51J04(PBAR0,TDGC) IF(VX.LT.0.49E-3) GO TO 282 TSP=G01J04(VX,TDGC) IF(TSP.LT.0.21) GO TO 282 SW=G05J04(VX,TDGC) IF(IS0.EQ.0) THEN S1=ABS(SW/S-1.0)+ABS(TSP/PBAR0-1.0) IF(S1.LT.2.0E-6) GO TO 30 VDP=VX IMK=I IS0=2 GO TO 282 END IF S2=ABS(SW/S-1.0)+ABS(TSP/PBAR0-1.0) IF(S2.LT.2.0E-6) GO TO 30 IF(S1.LT.S2) GO TO 282 S1=S2 IMK=I VDP=VX C 282 CONTINUE TMXR=TMNR+(IMK+1)*TWS TMNR=TMNR+(IMK-1)*TWS 283 CONTINUE TDGC=TMNR+IMK*TWS VX=VDP C VX=F51J04(PBAR0,TDGC)DELETE C *********************** GO TO 30 29 IF((S1-S)*(SW-S).GT.0.0) THEN S1=SW TMIN=TDGC ELSE S2=SW TMAX=TDGC END IF TRS1=TMIN+273.15 TRS2=TMAX+273.15 IF(DABS(TRS1/TRS2-1.0D0).LT.1.0D-3) GO TO 27 TWS=TDGC TDGC=(TMAX+TMIN)*0.5+(TMIN-TMAX)*(S-(S1+S2)*0.5)/(S1-S2) IF(ABS(TDGC-TWS).GT.1.0E-2) GO TO 291 TWS=(TMAX+TMIN)*0.5 IF(ABS(TDGC-TWS).GT.1.0E-2) TDGC=TWS C 291 IF(TDGC.LT.TMIN.OR.TDGC.GT.TMAX) GO TO 27 GO TO 28 C C 30 TEMPC=TDGC VM3K=VX H=G02J04(VX,TDGC) RETURN 31 TEMPC=TMAX VM3K=TMAX H=TMAX RETURN 32 TEMPC=TMIN VM3K=TMIN H=TMIN RETURN 40 TEMPC=-1.0E20 VM3K=-1.0E20 H=-1.0E20 RETURN 50 TEMPC=-1.0E10 VM3K=-1.0E10 H=-1.0E10 RETURN END C S04 SUBROUTINE S04J04(PBAR,TDGC,VMAX,VMIN) DATA VMINL,VMINT,VMAXT/0.49E-3,1.5867E-3,229.80E-3/ DATA PCBAR/42.5/ IF(PBAR.GT.PCBAR) THEN VMAXU=VMAXT VMINU=VMINL GO TO 5 END IF C PST=F30J04(TDGC) IF(ABS(PST/PBAR-1.0).GT.1.1E-6) GO TO 2 VMIN=1.0/G53J04(TDGC+273.15) VMAX=VMIN RETURN C 2 IF(PBAR.GT.PST) GO TO 3 VMINU=G54J04(TDGC)*1.0E-3 VMAXU=VMAXT GO TO 5 C 3 VMAXU=1.0/G53J04(TDGC+273.15) VMINU=VMINL C 5 DV=(VMINU-VMAXU)*0.2 VMAXL=VMAXT ICNT=0 10 ICNT=ICNT+1 IF(ICNT.GT.3) GO TO 20 DO 11 I=1,6 VW=DV*(I-1)+VMAXL PW=G01J04(VW,TDGC) IF(PW.GT.PBAR) GO TO 12 11 CONTINUE VMAX=VW VMIN=VMINL RETURN 12 VMAXL=VW-DV DV=DV*0.2 GO TO 10 20 VMAX=VMAXL VMIN=VW RETURN END C 51 ******** FUNCTION F51J04(PBAR,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J04,F51J04,PBAR,TDGC,VNL,VXL,V1,V2,P1,P2,VMINL REAL PST,F53J04,F54J04,VMIN,VMAX,PX,PW,VW,VMINCL,VMAXCL REAL VM3KC,PCBAR DATA VM3KC,TCK,PCBAR/1.4854E-3,4.2688D2,42.500/ DATA VMINL/0.49E-3/ C CHK RANGE PBAR,TDGC IF(PBAR.LT.1.0.OR.PBAR.GT.62.0) GO TO 70 TK=TDGC+2.7315D2 IF(TK.LT.3.58D2.OR.TK.GT.4.62D2) 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 VMIN=VMINL IF(TK.GT.TCK) GO TO 16 VW=F53J04(TDGC) PST=G01J04(VW,TDGC) IF(ABS(PST/PBAR-1.0).GT.1.0E-6) GO TO 14 VW=F54J04(TDGC) GO TO 60 C 14 IF(PBAR.GT.PST) GO TO 15 VMIN=F54J04(TDGC) PW=G01J04(VMIN,TDGC) IF(PW/PBAR-1.0.LT.5.0E-6) THEN VW=F54J04(TDGC) GO TO 60 END IF CALL S04J04(PBAR,TDGC,VMAX,VMINCL) IF(VMINCL.GT.VMIN) VMIN=VMINCL ICASE=4 VNL=VMIN VXL=VMAX GO TO 20 15 VMAX=F53J04(TDGC) PW=G01J04(VMAX,TDGC) IF(PW/PBAR-1.0.GT.-5.0E-6) THEN VW=F54J04(TDGC) GO TO 60 END IF CALL S04J04(PBAR,TDGC,VMAXCL,VMIN) IF(VMAXCL.LT.VMAX) VMAX=VMAXCL IF(VMAX/VMIN-1.0.LT.1.0E-5) THEN VW=F54J04(TDGC) GO TO 60 END IF ICASE=2 VXL=VMAX VNL=VMIN GO TO 25 C C FROM 5 16 VW=VM3KC PX=G01J04(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 CALL S04J04(PBAR,TDGC,VMAX,VMINCL) IF(VMINCL.GT.VMIN) VMIN=VMINCL ICASE=3 VNL=VMIN VXL=VMAX GO TO 20 17 VMAX=VM3KC CALL S04J04(PBAR,TDGC,VMAXCL,VMINCL) IF(VMAXCL.LT.VMAX) VMAX=VMAXCL ICASE=1 VXL=VMAX VNL=VMIN GO TO 25 C C FROM 16 18 CALL S04J04(PBAR,TDGC,VMAX,VMINCL) VXL=VMAX C C FROM 37 TOO 19 VW=VMAX PX=G01J04(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=G01J04(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=G01J04(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=G01J04(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=G01J04(VMIN,TDGC) P2=G01J04(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=G01J04(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=G01J04(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=G01J04(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=G01J04(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 F51J04=-1.E10 RETURN 59 VW=(VMAX+VMIN)*0.5 60 F51J04=VW RETURN 70 F51J04=-1.0E20 RETURN END C G01 ********* FUNCTION G01J04(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J04,VM3K,TDGC DATA A01,A02,A03,A04,A05/9.304996919D-2,5.370447241D1, 11.853478820D4,-4.995831746D6,6.310751196D8/ DATA A06,A07,A08,A09,A10/-1.191483710D-1,5.393792079D1, 11.634919553D4,2.986084863D-2,-1.480514431D0/ DATA A11,A12,A13,A14,A15/9.151154779D-2,-9.481726991D1, 12.721693016D1,-7.125002870D6,4.372082961D9/ DATA A16,A17,A18,A19,A20/-1.156062057D12,3.540280722D7, 1-3.086865892D10,5.824394999D12,2.700000000D0/ C T=DBLE(TDGC)+2.731500D2 TI=1.000D0/T T2I=TI*TI T3I=T2I*TI T4I=T2I*T2I T5I=T3I*T2I T6I=T3I*T3I C RO=1.000D-3/DBLE(VM3K) C GRAM/CM 3 RO2=RO*RO C R=8.31451D0/165.370D0 C KJ/KMOL K KG/KMOLE C BP=A01-A04*T3I BM=-((A05*T2I+A03)*TI+A02)*TI CP=A08*T2I+A07*TI CM=A06 DP=A09 DM=A10*TI EP=A11 EM=A12*TI FP=A13*TI GP=A15*T4I GM=(A16*T2I+A14)*T3I HP=(A19*T2I+A17)*T3I HM=A18*T4I C W=DEXP(-A20*RO2) W1P=(GP+HP*RO2)*RO2*W W1M=(GM+HM*RO2)*RO2*W WP=((((FP*RO+EP)*RO+DP)*RO+CP)*RO+BP)*RO WM=(((EM*RO+DM)*RO+CM)*RO+BM)*RO W2=RO*T*(R+WP+W1P+W1M+WM) G01J04=SNGL(W2)*10.0 C BAR RETURN END C S02 SUBROUTINE S02J04(RODD,ROD,TK,EQIV) C RODD,ROD=1E-3/(M3/KG) C GRAM/CM 3 IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL RODD,ROD,TK,EQIV DATA A01,A02,A03,A04,A05/9.304996919D-2,5.370447241D1, 11.853478820D4,-4.995831746D6,6.310751196D8/ DATA A06,A07,A08,A09,A10/-1.191483710D-1,5.393792079D1, 11.634919553D4,2.986084863D-2,-1.480514431D0/ DATA A11,A12,A13,A14,A15/9.151154779D-2,-9.481726991D1, 12.721693016D1,-7.125002870D6,4.372082961D9/ DATA A16,A17,A18,A19,A20/-1.156062057D12,3.540280722D7, 1-3.086865892D10,5.824394999D12,2.700000000D0/ C C T=DBLE(TDGC)+2.731500D2 T=DBLE(TK) TI=1.000D0/T T2I=TI*TI T3I=T2I*TI T4I=T2I*T2I T5I=T3I*T2I T6I=T3I*T3I C R=8.31451D0/165.370D0 C KJ/KMOL K KG/KMOLE C BP=A01-A04*T3I BM=-((A05*T2I+A03)*TI+A02)*TI CP=A08*T2I+A07*TI CM=A06 DP=A09 DM=A10*TI EP=A11 EM=A12*TI FP=A13*TI GP=A15*T4I GM=(A16*T2I+A14)*T3I HP=(A19*T2I+A17)*T3I HM=A18*T4I C W=DBLE(ROD)/DBLE(RODD) TRLRO=T*R*DLOG(W) W=DBLE(ROD) UPD=((((FP*2.0D-1*W+EP*2.5D-1)*W+DP/3.0D0)*W+CP*5.0D-1)*W+BP)*W UMD=(((EM*2.5D-1*W+DM/3.0D0)*W+CM*5.0D-1)*W+BM)*W W=DBLE(RODD) UPDD=((((FP*2.0D-1*W+EP*2.5D-1)*W+DP/3.0D0)*W+CP*5.0D-1)*W+BP)*W UMDD=(((EM*2.5D-1*W+DM/3.0D0)*W+CM*5.0D-1)*W+BM)*W ROD2=DBLE(ROD)**2 EXPWD=DEXP(-A20*ROD2) RODD2=DBLE(RODD)**2 EXPWDD=DEXP(-A20*RODD2) VE1=(EXPWD-EXPWDD)/(-2.0D0*A20) VE2=((-A20*ROD2-1.0D0)*EXPWD-(-A20*RODD2-1.0D0)*EXPWDD)/ 1(2.0D0*A20*A20) VP=GP*VE1+HP*VE2 VM=GM*VE1+HM*VE2 EQIV=TRLRO+T*(UPD-UMDD+VP+VM+UMD-UPDD) IK=1 IF(IK.EQ.1) RETURN WRITE(6,100) T,R,TRLRO,UPD,UMD,UPDD,UMDD,VP,VM,VE1,VE2, 1 GP,GM,HP,HM,EQIV 100 FORMAT(1H ,'T=',F7.1,' R=',F7.4,' TRLRO=',D12.4,/1H , 1'UPD,UMD=',2D12.4,'UPDD,UMDD=',2D12.4,' VP,VM=',2D12.4, 2/1H ,' VE1,VE2=',2D12.4,' GP,GM,HP,HM=',4D12.4, 3/1H ,' EQIV=',E12.4) C WRITE(*,*) 'KEY IN SOME V.' C READ(*,*) IIW RETURN END C S03 SUBROUTINE S03J04(RODDBS,RODDE,ROD,TK,VM3K) C DRO=(RODD*0.85-RODDBS)/200 DRO=(RODDE-RODDBS)/20 RODDW=RODDBS CALL S02J04(RODDW,ROD,TK,EQIVM) TDGC=TK-273.15 VM3KW=1.0E-3/RODDW PBARW=G01J04(VM3KW,TDGC) PMPAW=PBARW*0.1 EQIVMW=EQIVM-PMPAW*(1.0/RODDW-1.0/ROD) WMIN=ABS(EQIVMW) KIR=1 DO 5 KI=2,21 RODDW=RODDBS+(KI-1)*DRO TDGC=TK-273.15 VM3KW=1.0E-3/RODDW PBARW=G01J04(VM3KW,TDGC) VDR=1.0/ROD CALL S01J04(PBARW,VDR,VDCAL,TK) ROD=1.0/VDCAL CALL S02J04(RODDW,ROD,TK,EQIVM) PMPAW=PBARW*0.1 EQIVMW=EQIVM-PMPAW*(1.0/RODDW-1.0/ROD) IF(WMIN.GT.ABS(EQIVMW)) THEN WMIN=ABS(EQIVMW) KIR=KI END IF 5 CONTINUE IF(KIR.GT.1) THEN RODDW1=RODDBS+(KIR-2)*DRO ELSE RODDW1=RODDBS END IF RODDW2=RODDBS+KIR*DRO C VM3K=1.0E-3/RODDW C TDGC=TK-273.15 EPS=5.0E-7 C TA=0.618034 TB=1.0-TA C RODD1=TA*RODDW1+TB*RODDW2 RODD=RODD1 VM3KW=1.0E-3/RODD PBARW=G01J04(VM3KW,TDGC) VDR=1.0/ROD CALL S01J04(PBARW,VDR,VDCAL,TK) ROD=1.0/VDCAL CALL S02J04(RODD,ROD,TK,EQIV) PMPAW=PBARW*0.1 EQIVZ=EQIV-PMPAW*(1.0/RODD-1.0/ROD) EQAV=ABS(EQIVZ) RODD2=TB*RODDW1+TA*RODDW2 RODD=RODD2 TDGC=TK-273.15 VM3KW=1.0E-3/RODD PBARW=G01J04(VM3KW,TDGC) VDR=1.0/ROD CALL S01J04(PBARW,VDR,VDCAL,TK) ROD=1.0/VDCAL CALL S02J04(RODD,ROD,TK,EQIV) PMPAW=PBARW*0.1 EQIVZ=EQIV-PMPAW*(1.0/RODD-1.0/ROD) EQBV=ABS(EQIVZ) C 8 W=ABS(RODDW2-RODDW1) IF(W.LT.EPS*ABS(RODDW1).OR.W.LT.EPS) GO TO 6 IF(EQAV.GT.EQBV) THEN RODDW1=RODD1 RODD1=RODD2 EQAV=EQBV RODD2=TB*RODDW1+TA*RODDW2 RODD=RODD2 VM3KW=1.0E-3/RODD PBARW=G01J04(VM3KW,TDGC) VDR=1.0/ROD CALL S01J04(PBARW,VDR,VDCAL,TK) ROD=1.0/VDCAL CALL S02J04(RODD,ROD,TK,EQIV) PMPAW=PBARW*0.1 EQIVZ=EQIV-PMPAW*(1.0/RODD-1.0/ROD) EQBV=ABS(EQIVZ) ELSE RODDW2=RODD2 RODD2=RODD1 EQBV=EQAV RODD1=TA*RODDW1+TB*RODDW2 RODD=RODD1 VM3KW=1.0E-3/RODD PBARW=G01J04(VM3KW,TDGC) VDR=1.0/ROD CALL S01J04(PBARW,VDR,VDCAL,TK) ROD=1.0/VDCAL CALL S02J04(RODD,ROD,TK,EQIV) PMPAW=PBARW*0.1 EQIVZ=EQIV-PMPAW*(1.0/RODD-1.0/ROD) EQAV=ABS(EQIVZ) END IF IF(ABS(RODD1/RODD2-1.0).GT.1.0E-6) GO TO 8 RODDW=(RODD1+RODD2)*0.5 GO TO 50 C C MIN. F(X) 6 IF(EQAV.LT.EQBV) THEN Z=RODD1 ZZ=EQAV ELSE Z=RODD2 ZZ=EQBV END IF RODDW=Z C 50 VM3K=1.0E-3/RODDW RETURN END C G54 ****************** FUNCTION G54J04(TDGC) DATA SNTMPA/1.15/ DATA ANM01R,ANM11R,ANM21R/1072.3,-847.579,137.414/ DATA ADN01R,ADN11R,ADN21R/-401.026,161.28,1.0/ DATA ANM02R,ANM12R,ANM22R/-42.5481,47.5498,-12.7947/ DATA ADN02R,ADN12R,ADN22R/ 15.9412,-11.7868,1.0/ PMPA=F30J04(TDGC)*0.1 X=ALOG(PMPA) IF(PMPA.LT.SNTMPA) THEN W1=(ANM21R*X+ANM11R)*X+ANM01R W2=(ADN21R*X+ADN11R)*X+ADN01R ELSE W1=(ANM22R*X+ANM12R)*X+ANM02R W2=(ADN22R*X+ADN12R)*X+ADN02R END IF W=W1/W2 RODDKD=EXP(W) G54J04=1.0/RODDKD RETURN END C 54 ************ FUNCTION F54J04(TDGC) TK=TDGC+273.15 IF(TK.LT.234.95) GO TO 40 IF(TK.GT.426.884) GO TO 40 VDDDMK=G54J04(TDGC) C IF(VDDDMK.LT.1.0E-7) THEN VDCAL=-1.0E10 GO TO 30 END IF C RODD=1.0/VDDDMK VDCAL=F53J04(TDGC) IF(VDCAL.LT.1.0E-7) GO TO 30 RODCAL=1.0E-3/VDCAL ROC=0.6732 RODDBS=RODD*1.2 IF(RODDBS.GT.ROC) RODDBS=ROC RODDE=RODD*0.8 CALL S03J04(RODDBS,RODDE,RODCAL,TK,VM3K) F54J04=VM3K RETURN 30 IF(VDCAL.LT.-1.1E10) GO TO 40 F54J04=-1.0E10 RETURN 40 F54J04=-1.0E20 RETURN END C G53 ******** FUNCTION G53J04(TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION CI(3) REAL G53J04,TK DATA CI/2.021474D0,6.728795D-1,4.656096D-1/ DATA TC,ROC/4.2688D2,0.6732D3/ C K KG/M3 T=DBLE(TK) TAU=1.0D0-(T/TC) IF(TAU.GT.0.0D0) THEN TRTAU=TAU**(1.0D0/3.0D0) ELSE RSW=ROC GO TO 10 END IF WTRTAU=TAU*TRTAU WTRTAU=WTRTAU*WTRTAU W2=TAU*TAU C RSW=CI(1)*TRTAU+CI(2)*TAU+CI(3)*WTRTAU RSW= W2*CI(3)*TAU+(CI(2)*TRTAU+CI(1))*TRTAU RSW=RSW*ROC+ROC 10 G53J04=SNGL(RSW) RETURN END C S01 ************** SUBROUTINE S01J04(PSTBAR,VDR,VDCAL,TK) C DATA ROC,TC/0.6732,426.88/ DATA TC/426.88/ C R12B1 KG/DM3 TA=1.0-TC/TK TB=0.04 RO1=(0.99-TB*TA)/VDR RO2=1.15/VDR TDGC=TK-273.15 EPS=5.0E-7 C TA=0.618034 TB=1.0-TA C IC=0 1 IC=IC+1 IF(IC.GT.12) THEN VM3K=-1.0E10 RETURN END IF C Q1=TA*RO1+TB*RO2 ROD=Q1 VM3KW=1.0E-3/ROD PBARW=G01J04(VM3KW,TDGC) EQIVZ=PSTBAR-PBARW G1=ABS(EQIVZ) Q2=TB*RO1+TA*RO2 ROD=Q2 VM3KW=1.0E-3/ROD PBARW=G01J04(VM3KW,TDGC) EQIVZ=PSTBAR-PBARW G2=ABS(EQIVZ) C 8 W=ABS(RO2-RO1) IF(W.LT.EPS*ABS(RO1).OR.W.LT.EPS) GO TO 6 IF(G1.GT.G2) THEN RO1=Q1 Q1=Q2 G1=G2 Q2=TB*RO1+TA*RO2 ROD=Q2 VM3KW=1.0E-3/ROD PBARW=G01J04(VM3KW,TDGC) EQIVZ=PSTBAR-PBARW G2=ABS(EQIVZ) ELSE RO2=Q2 Q2=Q1 G2=G1 Q1=TA*RO1+TB*RO2 ROD=Q1 VM3KW=1.0E-3/ROD PBARW=G01J04(VM3KW,TDGC) EQIVZ=PSTBAR-PBARW G1=ABS(EQIVZ) END IF IF(ABS(Q1/Q2-1.0).GT.1.0E-6) GO TO 8 RODW=(Q1+Q2)*0.5 GO TO 50 C C MIN. F(X) 6 IF(G1.LT.G2) THEN Z=Q1 ZZ=G1 ELSE Z=Q2 ZZ=G2 END IF RODW=Z 50 VDCAL=1.0/RODW C DM3/KG RETURN END C 53 FUNCTION F53J04(TDGC) TK=TDGC+273.15 IF(TK.LT.234.95) GO TO 40 IF(TK.GT.426.884) GO TO 40 PSTBAR=F30J04(TDGC) ROD=G53J04(TK) VM3KD=1.0E3/ROD CALL S01J04(PSTBAR,VM3KD,VDCAL,TK) F53J04=VDCAL*1.0E-3 RETURN 40 F53J04=-1.0E20 RETURN END C 40 ******** FUNCTION F40J04(PBAR) C C IF(PBAR.LT.0.21.OR.PBAR.GT.42.5005) GO TO 40 TMIN=233.0-273.15 TMAX=426.88-273.15 PRI=F30J04(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=F30J04(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 IC=0 1 IC=IC+1 IF(IC.GT.17) GO TO 5 TDGC0=(TMAX+TMIN)*0.5 PRI=F30J04(TDGC0) TDGC=TDGC0 IF(ABS(PRI-PBAR)/PBAR.LT.6.0E-6) GO TO 50 IF(PRI.LT.PBAR) GO TO 3 C C PRI.GT.PBAR ...... TEMP. DECREASE TMAX=TDGC0 GO TO 1 C C PRI.LT.PBAR ....... TEMP. INCREASE 3 TMIN=TDGC0 GO TO 1 C 5 H=(TMAX-TMIN)*0.1 EPS=5.0E-4 PTMAX=F30J04(TMAX) PTMIN=F30J04(TMIN) W=(PBAR-PTMAX)*(PBAR-PTMIN) 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 20 IF(W.GT.0.0) THEN F40J04=-1.0E10 RETURN END IF C PSTBAR=PBAR EPS=5.0E-7 TA=1.618034 TB=1.0-TA C TDGCA=TMIN TDGCB=TMAX C IC=0 21 IC=IC+1 IF(IC.GT.10) THEN F40J04=-1.0E10 RETURN END IF C Q1=TA*TDGCA+TB*TDGCB TDGC=Q1 PBARW=F30J04(TDGC) EQIVZ=PSTBAR-PBARW G1=ABS(EQIVZ) Q2=TB*TDGCA+TA*TDGCB TDGC=Q2 PBARW=F30J04(TDGC) EQIVZ=PSTBAR-PBARW G2=ABS(EQIVZ) C 22 W=ABS(TDGCB-TDGCA) IF(W.LT.EPS*(TDGCA+273.15)*0.01.OR.W.LT.EPS) GO TO 23 IF(G1.LT.G2) THEN TDGCA=Q1 Q1=Q2 G1=G2 Q2=TB*TDGCA+TA*TDGCB TDGC=Q2 PBARW=F30J04(TDGC) EQIVZ=PSTBAR-PBARW G2=ABS(EQIVZ) ELSE TDGCB=Q2 Q2=Q1 G2=G1 Q1=TA*TDGCA+TB*TDGCB TDGC=Q1 PBARW=F30J04(TDGC) EQIVZ=PSTBAR-PBARW G1=ABS(EQIVZ) END IF IF(ABS((Q1+273.15)/(Q2+273.15)-1.0).GT.1.0E-6) GO TO 22 TDGCW=(Q1+Q2)*0.5 GO TO 25 C 23 IF(G1.LT.G2) THEN Z=Q1 ZZ=G1 ELSE Z=Q2 ZZ=G2 END IF TDGCW=Z 25 F40J04=TDGCW RETURN C 30 F40J04=-1.0E10 RETURN 40 F40J04=-1.0E20 RETURN 49 TDGC=PRI 50 F40J04=TDGC RETURN END C S05 ******* SUBROUTINE S05J04(PBAR,VM3K,TDGCMX,TDGCMN) DATA TMINT,TMAXT,TC,PC,ROC/235.0,460.0,426.88,4.25E01,673.2/ VC=1.0/ROC PWC=G01J04(VM3K,TC-273.15) IF(PWC.LT.PBAR) GO TO 13 TMAXW=TC TKW1=TC TKW2=TMINT C EPS=5.0E-7 C TA=0.618034 TB=1.0-TA C Q1=TA*TKW1+TB*TKW2 TKW=Q1 IF(VM3K.LT.VC) THEN VM3KW=F53J04(TKW-273.15) ELSE VM3KW=F54J04(TKW-273.15) END IF IF(VM3KW.LT.1.0E-6) GO TO 999 EQIVZ=VM3KW-VM3K G1=ABS(EQIVZ) Q2=TB*TKW1+TA*TKW2 TKW=Q2 IF(VM3K.LT.VC) THEN VM3KW=F53J04(TKW-273.15) ELSE VM3KW=F54J04(TKW-273.15) END IF IF(VM3KW.LT.1.0E-6) GO TO 999 EQIVZ=VM3KW-VM3K G2=ABS(EQIVZ) C IC=0 8 W=ABS(TKW2-TKW1) IC=IC+1 IF(IC.GT.100) THEN TDGCMX=TKW-273.15 TDGCMN=TDGCMX RETURN END IF C IF(W.LT.EPS*ABS(TKW1)) GO TO 6 IF(G1.GT.G2) THEN TKW1=Q1 Q1=Q2 G1=G2 Q2=TB*TKW1+TA*TKW2 TKW=Q2 IF(VM3K.LT.VC) THEN VM3KW=F53J04(TKW-273.15) ELSE VM3KW=F54J04(TKW-273.15) END IF IF(VM3KW.LT.1.0E-6) GO TO 999 EQIVZ=VM3KW-VM3K G2=ABS(EQIVZ) ELSE TKW2=Q2 Q2=Q1 G2=G1 Q1=TA*TKW1+TB*TKW2 TKW=Q1 IF(VM3K.LT.VC) THEN VM3KW=F53J04(TKW-273.15) ELSE VM3KW=F54J04(TKW-273.15) END IF IF(VM3KW.LT.1.0E-6) GO TO 999 EQIVZ=VM3KW-VM3K G1=ABS(EQIVZ) END IF IF(ABS(Q1/Q2-1.0).GT.1.0E-6) GO TO 8 TKW=(Q1+Q2)*0.5 GO TO 7 C C MIN. F(X) 6 IF(G1.LT.G2) THEN Z=Q1 ZZ=G1 ELSE Z=Q2 ZZ=G2 END IF TKW=Z 7 TMINW=TKW C PW=PWC C 9 DT=(TMINW-TMAXW)*0.2 TMAXL=TMAXW-273.15 ICNT=0 10 ICNT=ICNT+1 C IF(ICNT.GT.3) GO TO 20 DO 11 I=1,6 TW=DT*(I-1)+TMAXL PW=G01J04(VM3K,TW) IF(PW.LT.PBAR) GO TO 12 11 CONTINUE TDGCMX=TW TDGCMN=TDGCMX-0.5 RETURN 12 TMAXL=TW-DT DT=DT*0.2 GO TO 10 C 13 IF(PBAR.GT.PC) THEN TMAXW=TMAXT TMINW=TC GO TO 14 END IF DT=(TMAXT-TC)/5 DO 30 I=1,5 TSPW=TC+DT*I PWC=G01J04(VM3K,TSPW-273.15) IF(PWC.GT.PBAR) THEN TMAXW=TSPW TMINW=TSPW-DT GO TO 9 END IF 30 CONTINUE TDGCMX=TSPW-273.15 TDGCMN=TDGCMX-0.5 RETURN C 14 DT=(TMAXW-TMINW)*0.2 TMAXL=TMINW-273.15 ICNT=0 15 ICNT=ICNT+1 IF(ICNT.GT.3) GO TO 21 DO 16 I=1,6 TW=DT*(I-1)+TMAXL PW=G01J04(VM3K,TW) IF(PW.GT.PBAR) GO TO 17 16 CONTINUE TDGCMX=TW TDGCMN=TDGCMX-0.5 RETURN 17 TMAXL=TW-DT DT=DT*0.2 GO TO 15 20 TDGCMX=TMAXL TDGCMN=TW RETURN 21 TDGCMN=TMAXL TDGCMX=TW RETURN 999 TDGCMN=-1.0E10 TDGCMX=-1.0E10 RETURN END C 70 ******* FUNCTION F70J04(PBAR,VM3K) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F70J04,PBAR,TDGC,VM3K,PW,TMAX,TMIN,VDP,VDDP,PX,P1,P2,TSP REAL G01J04,F40J04,F53J04,F54J04,F30J04,PST360,VCM3K REAL TDGCMX,TDGCMN C DATA PCBAR,TCK,ROCKM3/4.2500D1,4.2688D2,6.732D2/ C IF(PBAR.LT.1.0.OR.PBAR.GT.62.1) GO TO 40 VMIN=0.6325E-3 VMAX=229.85E-3 IF(VM3K.LT.VMIN.OR.VM3K.GT.VMAX) GO TO 40 IF(ABS(PBAR-42.500).GT.0.006) GO TO 5 VCM3K=1.0/ROCKM3 IF(ABS(VM3K-VCM3K).GT.6.0E-6) GO TO 5 C CRITICAL PRES. ERROR =0.006(BAR) C CRITICAL SPC. VOL ERROR=6E-6(M3/KG) TDGC=426.88-273.15 GO TO 30 C 5 IF(PBAR/PCBAR-1.0.GT.-1.0E-6) GO TO 6 TDGC=F40J04(PBAR) TSP=TDGC IF(TDGC.LT.-5.15) GO TO 40 C -5.15=268.0-273.15 C VDP=F53J04(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 PST360=F30J04(360.0-273.15) IF(PBAR/PST360-1.0.LT.-1.0E-6) GO TO 40 C CALL S05J04(PBAR,VM3K,TDGCMX,TDGCMN) IF(ABS(TDGCMX-TDGCMN).LT.1.0E-2) THEN IF(TDGCMX.LT.-300.0 ) GO TO 50 TDGC=(TDGCMX+TDGCMN)*0.5 GO TO 30 END IF TMIN=TDGCMN C TMIN=360.0-273.15 TDGC=TMIN PX=G01J04(VM3K,TDGC) IF(ABS(PX/PBAR-1.0).LT.1.0E-6) GO TO 30 IF(PX.GT.PBAR) GO TO 40 TMAX=TSP IF(TMAX.GT.TDGCMX) TMAX=TDGCMX ICASE=1 GO TO 15 C 6 IF(VM3K.GT.VCM3K) GO TO 7 CALL S05J04(PBAR,VM3K,TDGCMX,TDGCMN) IF(ABS(TDGCMX-TDGCMN).LT.1.0E-2) THEN IF(TDGCMX.LT.-300.0 ) GO TO 50 TDGC=(TDGCMX+TDGCMN)*0.5 GO TO 30 END IF TMIN=360.0-273.15 TMAX=460.1-273.15 IF((TMAX.GT.TDGCMX) .OR. (TMIN.LT.TDGCMN)) THEN TMAX=TDGCMX TMIN=TDGCMN ENDIF PX=G01J04(VM3K,TMIN) IF(ABS(PX/PBAR-1.0).LT.1.0E-6) GO TO 30 IF(PX.GT.PBAR) GO TO 40 ICASE=2 GO TO 15 C 7 TMIN=TCK-273.15 TMAX=460.1-273.15 CALL S05J04(PBAR,VM3K,TDGCMX,TDGCMN) IF(ABS(TDGCMX-TDGCMN).LT.1.0E-2) THEN IF(TDGCMX.LT.-300.0 ) GO TO 50 TDGC=(TDGCMX+TDGCMN)*0.5 GO TO 30 END IF IF((TMAX.GT.TDGCMX) .OR. (TMIN.LT.TDGCMN)) THEN TMAX=TDGCMX TMIN=TDGCMN ENDIF ICASE=3 GO TO 15 C 10 VDDP=F54J04(TDGC) IF(VDDP.LT.1.0E-4) GO TO 50 IF(VM3K/VDDP-1.0.LT.1.0E-5) GO TO 30 TMIN=TDGC TMAX=460.1-273.15 CALL S05J04(PBAR,VM3K,TDGCMX,TDGCMN) IF(ABS(TDGCMX-TDGCMN).LT.1.0E-2) THEN IF(TDGCMX.LT.-300.0 ) GO TO 50 TDGC=(TDGCMX+TDGCMN)*0.5 GO TO 30 END IF IF((TMAX.GT.TDGCMX) .OR. (TMIN.LT.TDGCMN)) THEN TMAX=TDGCMX TMIN=TDGCMN ENDIF ICASE=4 C 15 IF(TMIN.GT.TMAX) THEN TDGC=TMIN TMIN=TMAX TMAX=TDGC END IF IF((TMAX.GT.TDGCMX) .OR. (TMIN.LT.TDGCMN)) THEN TMAX=TDGCMX TMIN=TDGCMN ENDIF P1=G01J04(VM3K,TMIN) P2=G01J04(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=G01J04(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=G01J04(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=G01J04(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=G01J04(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=G01J04(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=G01J04(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=G01J04(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=G01J04(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=G01J04(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=G01J04(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 C 26 EPS=5.0E-7 C TA=0.618034 TB=1.0-TA C Q1=TA*TMIN+TB*TMAX TKW=Q1 PBARW=G01J04(VM3K,TMIN) EQIVZ=PBARW-PBAR G1=ABS(EQIVZ) Q2=TB*TMIN+TA*TMAX TKW=Q2 PBARW=G01J04(VM3K,TMAX) EQIVZ=PBARW-PBAR G2=ABS(EQIVZ) C IC=0 28 W=ABS(TMAX-TMIN) IC=IC+1 IF(IC.GT.100) GO TO 27 C IF(W.LT.EPS*ABS(TMIN+273.15)) GO TO 27 IF(G1.GT.G2) THEN TMIN=Q1 Q1=Q2 G1=G2 Q2=TB*TMIN+TA*TMAX TKW=Q2 TDGC=SNGL(TKW) PBARW=G01J04(VM3K,TDGC) EQIVZ=PBARW-PBAR G2=ABS(EQIVZ) ELSE TMAX=Q2 Q2=Q1 G2=G1 Q1=TA*TMIN+TB*TMAX TKW=Q1 TDGC=SNGL(TKW) PBARW=G01J04(VM3K,TDGC) EQIVZ=PBARW-PBAR G1=ABS(EQIVZ) END IF IF(ABS((Q1+273.15)/(Q2+273.15)-1.0).GT.1.0E-6) GO TO 28 TDGC=(Q1+Q2)*0.5 GO TO 30 C C MIN. F(X) 27 IF(G1.LT.G2) THEN Z=Q1 ZZ=G1 ELSE Z=Q2 ZZ=G2 END IF TKW=Z TDGC=TKW C 30 F70J04=TDGC RETURN 31 F70J04=TMAX RETURN 32 F70J04=TMIN RETURN 40 F70J04=-1.0E20 RETURN 50 F70J04=-1.0E10 RETURN END C 42 ******* FUNCTION F42J04(PBAR) C C U=H-PV (SAT. LIQUID) C TSDGC=F40J04(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HD=F27J04(TSDGC) IF(HD.LT.-1.0E9) GO TO 20 VD=F53J04(TSDGC) IF(VD.LT.-1.0E9) GO TO 10 U=HD-PBAR*VD*1.0E5 F42J04=U RETURN 10 F42J04=VD RETURN 20 F42J04=HD RETURN 30 F42J04=TSDGC RETURN END C 43 ******* FUNCTION F43J04(PBAR) C C U=H-PV (SAT. VAPOR) C TSDGC=F40J04(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HDD=F28J04(TSDGC) IF(HDD.LT.-1.0E9) GO TO 20 VDD=F54J04(TSDGC) IF(VDD.LT.-1.0E9) GO TO 10 U=HDD-PBAR*VDD*1.0E5 F43J04=U RETURN 10 F43J04=VDD RETURN 20 F43J04=HDD RETURN 30 F43J04=TSDGC RETURN END C 79 ******* FUNCTION F79J04(PBAR,S) C C U(P,S) U=H-PV C CALL S08J04(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.426.88) GO TO 40 PSAT=F30J04(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 40 STDD=F38J04(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 40 STD=F37J04(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=F28J04(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 VTDD=F54J04(TDGC) IF(VTDD.LT.-1.0E9) GO TO 16 HTD=F27J04(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 VTD=F53J04(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 F79J04=H C WRITE(6,210) H C 210 FORMAT(1H ,42X,'RTN FROM 10 H=',E12.4) RETURN 11 F79J04=PSAT C WRITE(6,211) PSAT C 211 FORMAT(1H ,42X,'RTN FROM 11 PSAT=',E12.4) RETURN 12 F79J04=STDD C WRITE(6,212) STDD C 212 FORMAT(1H ,42X,'RTN FROM 12 STDD=',E12.4) RETURN 13 F79J04=STD C WRITE(6,213) STD C 213 FORMAT(1H ,42X,'RTN FROM 13 STD=',E12.4) RETURN 14 F79J04=HTDD C WRITE(6,214) HTDD C 214 FORMAT(1H ,42X,'RTN FROM 14 HTDD=',E12.4) RETURN 15 F79J04=HTD C WRITE(6,215) HTD C 215 FORMAT(1H ,42X,'RTN FROM 15 HTD=',E12.4) RETURN 16 F79J04=VTDD C WRITE(6,216) VTDD C 216 FORMAT(1H ,42X,'RTN FROM 16 VTDD=',E12.4) RETURN 17 F79J04=VTD C WRITE(6,217) VTD C 217 FORMAT(1H ,42X,'RTN FROM 17 VTD=',E12.4) RETURN 20 F79J04=TDGC C WRITE(6,220) TDGC C 220 FORMAT(1H ,42X,'RTN FROM 20 TDGC=',E12.4) RETURN 30 F79J04=-1.0E20 RETURN 40 F79J04=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 F44J04(PBAR,TDGC) C C U=H-PV C V=F51J04(PBAR,TDGC) IF(V.LT.-1.0E9) GO TO 20 IF(TDGC-426.88.GT.-273.15) GO TO 4 VTD=F53J04(TDGC) IF((V-VTD)/1.4854E-3.LT.1.0E-5) GO TO 5 4 H=G02J04(V,TDGC) GO TO 6 5 H=G02J04(V,TDGC) 6 IF(H.LT.-1.0E9) GO TO 10 U=H-PBAR*V*1.0E5 F44J04=U RETURN 10 F44J04=H RETURN 20 F44J04=V RETURN END C 45 ******* FUNCTION F45J04(PBAR,X) C C U=H-PV C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F42J04(PBAR) IF(UD.LT.-1.0E9) GO TO 20 UDD=F43J04(PBAR) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F45J04=U RETURN 10 F45J04=UDD RETURN 20 F45J04=UD RETURN 30 F45J04=-1.0E20 RETURN END C 46 ******* FUNCTION F46J04(TDGC) C C U=H-PV (SAT. LIQUID C HD=F27J04(TDGC) IF(HD.LT.-1.0E9) GO TO 30 VD=F53J04(TDGC) IF(VD.LT.-1.0E9) GO TO 20 PST=F30J04(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HD-PST*VD*1.0E5 F46J04=U RETURN 10 F46J04=PST RETURN 20 F46J04=VD RETURN 30 F46J04=HD RETURN END C 47 ******* FUNCTION F47J04(TDGC) C C U=H-PV (SAT. VAPOR) C HDD=F28J04(TDGC) IF(HDD.LT.-1.0E9) GO TO 30 VDD=F54J04(TDGC) IF(VDD.LT.-1.0E9) GO TO 20 PST=F30J04(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HDD-PST*VDD*1.0E5 F47J04=U RETURN 10 F47J04=PST RETURN 20 F47J04=VDD RETURN 30 F47J04=HDD RETURN END C 48 ******* FUNCTION F48J04(TDGC,X) C C U=H-PV (SAT. LIQUID) C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F46J04(TDGC) IF(UD.LT.-1.0E9) GO TO 20 UDD=F47J04(TDGC) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F48J04=U RETURN 10 F48J04=UDD RETURN 20 F48J04=UD RETURN 30 F48J04=-1.0E20 RETURN END C 49 ****** FUNCTION F49J04(PBAR) C C SAT. VD(P) VPD SAT. LIQUID SPECFIC VOL.(PRESS) C IF(PBAR.LT.0.21.OR.PBAR.GT.42.500) GO TO 20 C TDGC=F40J04(PBAR) VSM3K=TDGC IF(TDGC.LT.-1.0E9) GO TO 15 VSM3K=F53J04(TDGC) 15 F49J04=VSM3K RETURN 20 F49J04=-1.0E20 RETURN END C 50 ****** FUNCTION F50J04(PBAR) C C SAT. VDD(P) VPDD SAT. SPECIFIC VOL.(PRESS) C IF(PBAR.LT.0.21.OR.PBAR.GT.42.500) GO TO 20 C TDGC=F40J04(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 VSM3K=F54J04(TDGC) F50J04=VSM3K RETURN 15 F50J04=TDGC RETURN 20 F50J04=-1.0E20 RETURN END C 80 ****** FUNCTION F80J04(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 S08J04(PBAR0,S,VX,TDGC,H) IF(VX.LT.1.0E-4) GO TO 10 IF(PBAR0.GT.42.500) GO TO 10 PST=F30J04(PBAR0) IF(ABS((PST-PBAR0)/PBAR0).LT.1.0E-5) GO TO 35 10 F80J04=VX RETURN 35 STD=F37J04(TDGC) STDD=F38J04(TDGC) VTD=F53J04(TDGC) VTDD=F54J04(TDGC) SX=(S-STD)/(STDD-STD) VX=VTD+(VTDD-VTD)*SX F80J04=VX RETURN END C 52 ******* FUNCTION F52J04(PBAR,X) TDGC=F40J04(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 V=F55J04(TDGC,X) F52J04=V RETURN 10 F52J04=TDGC RETURN END C 55 ****** FUNCTION F55J04(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 VD=F53J04(TDGC) IF(VD.LT.-1.0E9) GO TO 20 VDD=F54J04(TDGC) IF(VDD.LT.-1.0E9) GO TO 10 V=(1.0-X)*VD+X*VDD F55J04=V RETURN 10 F55J04=VDD RETURN 20 F55J04=VD RETURN 30 F55J04=-1.0E20 RETURN END C 83 *************** FUNCTION F83J04(PBAR,TDGC) VM3K=F51J04(PBAR,TDGC) IF(VM3K.LT.1.0E-4) GO TO 50 IF(VM3K.LT.4.9E-4) GO TO 40 PMPA=0.1*PBAR WA=G10J04(VM3K,TDGC,PMPA) F83J04=WA RETURN 40 F83J04=-1.0E10 RETURN 50 F83J04=VM3K RETURN END C G03 ******* FUNCTION G03J04(VM3K,TDGC,PMPA) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G03J04,VM3K,TDGC,PMPA,CV,G04J04 DATA A01,A02,A03,A04,A05/9.304996919D-2,5.370447241D1, 11.853478820D4,-4.995831746D6,6.310751196D8/ DATA A06,A07,A08,A09,A10/-1.191483710D-1,5.393792079D1, 11.634919553D4,2.986084863D-2,-1.480514431D0/ DATA A11,A12,A13,A14,A15/9.151154779D-2,-9.481726991D1, 12.721693016D1,-7.125002870D6,4.372082961D9/ DATA A16,A17,A18,A19,A20/-1.156062057D12,3.540280722D7, 1-3.086865892D10,5.824394999D12,2.700000000D0/ C DATA T0,H0/2.9815D2,3.4677D2/ C K KJ/KG C R12B1 C PRES=DBLE(PMPA) T=DBLE(TDGC)+2.731500D2 TI=1.000D0/T T2I=TI*TI T3I=T2I*TI T4I=T2I*T2I T5I=T3I*T2I T6I=T3I*T3I C RO=1.000D-3/DBLE(VM3K) C GRAM/CM 3 RO2=RO*RO RO3=RO2*RO R=8.31451D0/165.370D0 C KJ/KMOL K KG/KMOLE C C BDP=((A05*T2I*4.000D0+2.000D0*A03)*TI+A02)*T2I BDM=3.000D0*A04*T4I CDM=(-2.000D0*A08*TI-A07)*T2I DDP=-A10*T2I EDP=-A12*T2I FDM=-A13*T2I GDP=(-5.000D0*A16*T2I-3.000D0*A14)*T4I GDM=-4.000D0*A15*T5I HDM=(-5.000D0*A19*T2I-3.000D0*A17)*T4I HDP=-4.000D0*A18*T5I C T2=T*T SP=((EDP*RO+DDP)*RO2+BDP)*RO SM=((FDM*RO3+CDM)*RO+BDM)*RO WE=DEXP(-A20*RO2) SKP=(GDP+HDP*RO2)*RO2*WE SKM=(GDM+HDM*RO2)*RO2*WE DPDT=PRES*TI+RO*T*(SP+SKP+SM+SKM) DPDT2=DPDT*DPDT C BP=A01-A04*T3I BM=-((A05*T2I+A03)*TI+A02)*TI CP=A08*T2I+A07*TI CM=A06 DP=A09 DM=A10*TI EP=A11 EM=A12*TI FP=A13*TI GP=A15*T4I GM=(A16*T2I+A14)*T3I HP=(A19*T2I+A17)*T3I HM=A18*T4I C SP2=(((5.000D0*FP*RO+4.000D0*EP)*RO+3.000D0*DP)*RO+2.000D0*CP)*RO 1 +BP SM2=((4.000D0*EM*RO+3.000D0*DM)*RO+2.000D0*CM)*RO+BM C W1=1.000D0-A20*RO2 GW1=GP*W1 GW2=GM*W1 W2=2.000D0-A20*RO2 HW1=HP*W2 HW2=HM*W2 C IF(W1.GT.0.0) THEN GWP=GW1 GWM=GW2 ELSE GWP=GW2 GWM=GW1 END IF C IF(W2.GT.0.0) THEN HWP=HW1 HWM=HW2 ELSE HWP=HW2 HWM=HW1 END IF C SKP2=2.000D0*RO*(GWP+HWP*RO2)*WE SKM2=2.000D0*RO*(GWM+HWM*RO2)*WE C RODPDR=PRES*RO+RO2*RO*T*(SP2+SKP2+SM2+SKM2) W=T*DPDT2/RODPDR C C CP=CV+T*DPDT2/RODPDR CV=G04J04(VM3K,TDGC) CP=DBLE(CV)+W G03J04=SNGL(CP) RETURN END C G04 ******* FUNCTION G04J04(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G04J04,VM3K,TDGC DATA A01,A02,A03,A04,A05/9.304996919D-2,5.370447241D1, 11.853478820D4,-4.995831746D6,6.310751196D8/ DATA A06,A07,A08,A09,A10/-1.191483710D-1,5.393792079D1, 11.634919553D4,2.986084863D-2,-1.480514431D0/ DATA A11,A12,A13,A14,A15/9.151154779D-2,-9.481726991D1, 12.721693016D1,-7.125002870D6,4.372082961D9/ DATA A16,A17,A18,A19,A20/-1.156062057D12,3.540280722D7, 1-3.086865892D10,5.824394999D12,2.700000000D0/ C DATA T0,H0/2.9815D2,3.4677D2/ C K KJ/KG C R12B1 DATA D1,D2,D3,D4,D5/4.591353E-2,2.887161E-3,-9.858437E-6, 12.147228E-8,-1.861243E-11/ C T=DBLE(TDGC)+2.731500D2 TI=1.000D0/T T2I=TI*TI T3I=T2I*TI T4I=T2I*T2I T5I=T3I*T2I T6I=T3I*T3I C RO=1.000D-3/DBLE(VM3K) C GRAM/CM 3 RO2=RO*RO RO3=RO2*RO C R=8.31451D0/165.370D0 C KJ/KMOL K KG/KMOLE C BDDP=-12.000D0*A04*T5I BDDM=((-20.000D0*A05*T2I-6.000D0*A03)*TI-2.000D0*A02)*T3I CDDP=(6.000D0*A08*TI+2.000D0*A07)*T3I DDDM=2.000D0*A10*T3I EDDM=2.000D0*A12*T3I FDDP=2.000D0*A13*T3I GDDP=2.000D1*A15*T6I GDDM=(3.000D1*A16*T2I+1.200D1*A14)*T5I HDDP=(3.000D1*A19*T2I+1.200D1*A17)*T5I HDDM=2.000D1*A18*T6I C T2=T*T CP0P=D1+(D2+D4*T2)*T CP0M=(D3+D5*T2)*T2 C SP2=((FDDP*RO3*2.000D-1+CDDP*5.000D-1)*RO+BDDP)*RO SM2=((EDDM*2.500D-1*RO+DDDM/3.000D0)*RO2+BDDM)*RO WE=DEXP(-A20*RO2) W1=(1.000D0-WE)/(A20+A20) W2=(1.000D0-(A20*RO2+1.000D0)*WE)/(2.000D0*A20*A20) SKP2=GDDP*W1+HDDP*W2 SKM2=GDDM*W1+HDDM*W2 C BDP=((A05*T2I*4.000D0+2.000D0*A03)*TI+A02)*T2I BDM=3.000D0*A04*T4I CDM=(-2.000D0*A08*TI-A07)*T2I DDP=-A10*T2I EDP=-A12*T2I FDM=-A13*T2I GDP=(-5.000D0*A16*T2I-3.000D0*A14)*T4I GDM=-4.000D0*A15*T5I HDM=(-5.000D0*A19*T2I-3.000D0*A17)*T4I HDP=-4.000D0*A18*T5I C T2=T*T SP=((EDP*2.500D-1*RO+DDP/3.000D0)*RO2+BDP)*RO SM=((FDM*RO3*2.000D-1+CDM*5.000D-1)*RO+BDM)*RO C WE=DEXP(-A20*RO2) C W1=(1.000D0-WE)/(A20+A20) C W2=(1.000D0-(A20*RO2+1.000D0)*WE)/(2.000D0*A20*A20) SKP=GDP*W1+HDP*W2 SKM=GDM*W1+HDM*W2 W1=(SP+SKP)*2.000D0*T+(SP2+SKP2)*T2 W2=(SM+SKM)*2.000D0*T+(SM2+SKM2)*T2 CV=CP0P-W2-R-W1+CP0M G04J04=SNGL(CV) RETURN END C G10 ******* FUNCTION G10J04(VM3K,TDGC,PMPA) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G10J04,VM3K,TDGC,PMPA,CV,G04J04,CP,G03J04 DATA A01,A02,A03,A04,A05/9.304996919D-2,5.370447241D1, 11.853478820D4,-4.995831746D6,6.310751196D8/ DATA A06,A07,A08,A09,A10/-1.191483710D-1,5.393792079D1, 11.634919553D4,2.986084863D-2,-1.480514431D0/ DATA A11,A12,A13,A14,A15/9.151154779D-2,-9.481726991D1, 12.721693016D1,-7.125002870D6,4.372082961D9/ DATA A16,A17,A18,A19,A20/-1.156062057D12,3.540280722D7, 1-3.086865892D10,5.824394999D12,2.700000000D0/ C DATA T0,H0/2.9815D2,3.4677D2/ C K KJ/KG C R12B1 C PRES=DBLE(PMPA) T=DBLE(TDGC)+2.731500D2 TI=1.000D0/T T2I=TI*TI T3I=T2I*TI T4I=T2I*T2I T5I=T3I*T2I T6I=T3I*T3I C RO=1.000D-3/DBLE(VM3K) C GRAM/CM 3 RO2=RO*RO RO3=RO2*RO C R=8.31451D0/165.370D0 C KJ/KMOL K KG/KMOLE C C BDP=((A05*T2I*4.000D0+2.000D0*A03)*TI+A02)*T2I BDM=3.000D0*A04*T4I CDM=(-2.000D0*A08*TI-A07)*T2I DDP=-A10*T2I EDP=-A12*T2I FDM=-A13*T2I GDP=(-5.000D0*A16*T2I-3.000D0*A14)*T4I GDM=-4.000D0*A15*T5I HDM=(-5.000D0*A19*T2I-3.000D0*A17)*T4I HDP=-4.000D0*A18*T5I C T2=T*T SP=((EDP*RO+DDP)*RO2+BDP)*RO SM=((FDM*RO3+CDM)*RO+BDM)*RO WE=DEXP(-A20*RO2) SKP=(GDP+HDP*RO2)*RO2*WE SKM=(GDM+HDM*RO2)*RO2*WE DPDT=PRES*TI+RO*T*(SP+SKP+SM+SKM) DPDT2=DPDT*DPDT C BP=A01-A04*T3I BM=-((A05*T2I+A03)*TI+A02)*TI CP=A08*T2I+A07*TI CM=A06 DP=A09 DM=A10*TI EP=A11 EM=A12*TI FP=A13*TI GP=A15*T4I GM=(A16*T2I+A14)*T3I HP=(A19*T2I+A17)*T3I HM=A18*T4I C SP2=(((5.000D0*FP*RO+4.000D0*EP)*RO+3.000D0*DP)*RO+2.000D0*CP)*RO 1 +BP SM2=((4.000D0*EM*RO+3.000D0*DM)*RO+2.000D0*CM)*RO+BM C W1=1.000D0-A20*RO2 GW1=GP*W1 GW2=GM*W1 W2=2.000D0-A20*RO2 HW1=HP*W2 HW2=HM*W2 C IF(W1.GT.0.0) THEN GWP=GW1 GWM=GW2 ELSE GWP=GW2 GWM=GW1 END IF C IF(W2.GT.0.0) THEN HWP=HW1 HWM=HW2 ELSE HWP=HW2 HWM=HW1 END IF C SKP2=2.000D0*RO*(GWP+HWP*RO2)*WE SKM2=2.000D0*RO*(GWM+HWM*RO2)*WE C C RODPDR=PRES*RO+RO2*RO*T*(SP2+SKP2+SM2+SKM2) DPDR=PRES/RO+RO*T*(SP2+SKP2+SM2+SKM2) C CV=G04J04(VM3K,TDGC) CP=G03J04(VM3K,TDGC,PMPA) WA2=CP/CV*DPDR*1.0E3 G10J04=SQRT(SNGL(WA2)) RETURN END C 56 ******* FUNCTION F56J04(PBAR,H) TSDGC=F40J04(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F60J04(TSDGC,H) F56J04=X RETURN 10 F56J04=TSDGC RETURN END C 57 ******* FUNCTION F57J04(PBAR,S) TSDGC=F40J04(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F61J04(TSDGC,S) F57J04=X RETURN 10 F57J04=TSDGC RETURN END C 58 ******* FUNCTION F58J04(PBAR,U) TSDGC=F40J04(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F62J04(TSDGC,U) F58J04=X RETURN 10 F58J04=TSDGC RETURN END C 59 ******* FUNCTION F59J04(PBAR,V) TSDGC=F40J04(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F63J04(TSDGC,V) F59J04=X RETURN 10 F59J04=TSDGC RETURN END C 60 ******* FUNCTION F60J04(TDGC,H) TK=TDGC+273.15 IF(TK.LT.235.0.OR.TK.GT.426.88) GO TO 10 HD=F27J04(TDGC) IF(HD.LT.-1.0E9) GO TO 30 IF(HD.GT.H) GO TO 10 HDD=F28J04(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 F60J04=1.0 RETURN 5 X=(H-HD)/(HDD-HD) F60J04=X RETURN 10 F60J04=-1.0E20 RETURN 20 F60J04=HDD RETURN 30 F60J04=HD RETURN END C 61 ******* FUNCTION F61J04(TDGC,S) TK=TDGC+273.15 IF(TK.LT.235.0.OR.TK.GT.426.88) GO TO 10 SD=F37J04(TDGC) IF(SD.LT.-1.0E9) GO TO 30 IF(SD.GT.S) GO TO 10 SDD=F38J04(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 F61J04=1.0 RETURN 5 X=(S-SD)/(SDD-SD) F61J04=X RETURN 10 F61J04=-1.0E20 RETURN 20 F61J04=SDD RETURN 30 F61J04=SD RETURN END C 62 ******* FUNCTION F62J04(TDGC,U) TK=TDGC+273.15 IF(TK.LT.235.0.OR.TK.GT.426.88) GO TO 10 UD=F46J04(TDGC) IF(UD.LT.-1.0E9) GO TO 30 IF(UD.GT.U) GO TO 10 UDD=F47J04(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 F62J04=1.0 RETURN 5 X=(U-UD)/(UDD-UD) F62J04=X RETURN 10 F62J04=-1.0E20 RETURN 20 F62J04=UDD RETURN 30 F62J04=UD RETURN END C 63 ******* FUNCTION F63J04(TDGC,V) TK=TDGC+273.15 IF(TK.LT.235.0.OR.TK.GT.426.88) GO TO 10 VD=F53J04(TDGC) IF(VD.LT.-1.0E9) GO TO 30 IF(VD.GT.V) GO TO 10 VDD=F54J04(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 F63J04=1.0 RETURN 5 X=(V-VD)/(VDD-VD) F63J04=X RETURN 10 F63J04=-1.0E20 RETURN 20 F63J04=VDD RETURN 30 F63J04=VD RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99J04(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR R 12B1 ****' 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