C ********** VER. 11.1.********* C ********** R 115 ********* C ********** VER. 11.1.********* C C==================================================================== C May 2, 2001: modified by Ryo Akasaka for ver.12.1 C The following 18 functions were added but not implemented. C AKPD(8A), AKPDD(8B), AKTD(8C), AKTDD(8D), CVPD(7A), CVTD(7B), C EPSPD(2A), EPSPDD(2B), EPSTD(2C), EPSTDD(2D), GAMPD(9A), C GAMTD(9B), TPH2(6H), TPS2(6S), WPD(8E), WPDD(8F), WTD(8G), C WTDD(8H) C C------------------------------------------------- F8A = AKPD REAL FUNCTION AKPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='AKPD' IF (MESS.NE.0) CALL S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(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 S99J14(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT REAL FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99J14(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 DATA FUN/'AJTPT'/ CALL S99J14(FUN) AJTPT=-1.0E+30 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 115'/, 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 = F82J14(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------------------------------------------------- F2 = ALAPP FUNCTION ALAPP(P) CHARACTER FUN*6 DATA FUN/'ALAPP'/ CALL S99J14(FUN) ALAPP=-1.0E+30 RETURN END C------------------------------------------------- F3 = ALAPT REAL FUNCTION ALAPT(T) CHARACTER FUN*6 DATA FUN/'ALAPT'/ CALL S99J14(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 115'/, 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 = F4J14(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 115'/, 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 = F5J14(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALHT=FF RETURN END C------------------------------------------------- F6 = ALMPD REAL FUNCTION ALMPD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, FUN/'ALMPD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR DBP=DBLE(PI) C--- FUNCTION CALL --- FF = F6J14(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMPD=FF RETURN END C------------------------------------------------- F7 = ALMPDD FUNCTION ALMPDD(P) CHARACTER FUN*6 DATA FUN/'ALMPDD'/ CALL S99J14(FUN) ALMPDD=-1.0E+30 RETURN END C------------------------------------------------- F8 = ALMPT REAL FUNCTION ALMPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, FUN/'ALMPT'/ C--- SET OF UNIT --- IF(KPA.EQ.1) THEN PBAR=1.0 T0K=0.0 ELSE IF(KPA.EQ.2) THEN PBAR=1.0 T0K=273.15 ELSE IF(KPA.EQ.3) THEN PBAR=1.0E-05 T0K=0.0 ELSE PBAR=1.0E-05 T0K=273.15 END IF PI=P*PBAR TI=T-T0K C--- FUNCTION CALL --- FF = F8J14(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND T=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMPT=FF RETURN END C------------------------------------------------- F9 = ALMTD REAL FUNCTION ALMTD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, FUN/'ALMTD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F9J14(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMTD=FF RETURN END C------------------------------------------------- F10 = ALMTDD FUNCTION ALMTDD(P) CHARACTER FUN*6 DATA FUN/'ALMTDD'/ CALL S99J14(FUN) ALMTDD=-1.0E+30 RETURN END C------------------------------------------------- F11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, FUN/'AMUPD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F11J14(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUPD=FF RETURN END C------------------------------------------------- F12 = AMUPDD REAL FUNCTION AMUPDD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, FUN/'AMUPDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F12J14(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUPDD=FF RETURN END C------------------------------------------------- F13 = AMUPT REAL FUNCTION AMUPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, FUN/'AMUPT'/ C--- SET OF UNIT --- IF(KPA.EQ.1) THEN PBAR=1.0 T0K=0.0 ELSE IF(KPA.EQ.2) THEN PBAR=1.0 T0K=273.15 ELSE IF(KPA.EQ.3) THEN PBAR=1.0E-05 T0K=0.0 ELSE PBAR=1.0E-05 T0K=273.15 END IF PI=P*PBAR TI=T-T0K C--- FUNCTION CALL --- FF = F13J14(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND T=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUPT=FF RETURN END C------------------------------------------------- F14 = AMUTD REAL FUNCTION AMUTD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, FUN/'AMUTD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F14J14(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUTD=FF RETURN END C------------------------------------------------- F15 = AMUTDD REAL FUNCTION AMUTDD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, FUN/'AMUTDD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F15J14(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUTDD=FF RETURN END C------------------------------------------------- F92 = BPPT FUNCTION BPPT(P,T) CHARACTER FUN*6 DATA FUN/'BPPT'/ CALL S99J14(FUN) BPPT=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 DATA FUN/'BSPT'/ CALL S99J14(FUN) BSPT=-1.0E+30 RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 DATA FUN/'BTPT'/ CALL S99J14(FUN) BTPT=-1.0E+30 RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 DATA FUN/'BVPT'/ CALL S99J14(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 115'/, 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 = F16J14(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 115'/, 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 = F17J14(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 115'/, 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 = F18J14(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 115'/, 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 = F19J14(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 115'/, 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 = F20J14(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPTDD=FF RETURN END C------------------------------------------------- F21 = CRP REAL FUNCTION CRP(A) CHARACTER FUN*6,FLUID*16,MSG*125,A*1 REAL T0K,PBAR,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, 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 = F21J14(A) C--- LEVEL 2 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN A =',A,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF(A.EQ.'T') THEN IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 FF=FF+T0K ELSE IF(A.EQ.'P') THEN IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 FF=FF/PBAR END IF CRP=FF RETURN END C------------------------------------------------- F76 = CVPDD REAL FUNCTION CVPDD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, 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 = F76J14(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 115'/, 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 = F77J14(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 115'/, 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 = F78J14(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------------------------------------------------- F22 = EPSPT REAL FUNCTION EPSPT(P,T) CHARACTER FUN*6 DATA FUN/'EPSPT'/ CALL S99J14(FUN) EPSPT=-1.0E+30 RETURN END C------------------------------------------------- F89 = FC C************************************************ C FUNCTION FOR FUNDDAMENTAL CONSTANTS C PROPATH VER.7.1, MAY 8, 1990 C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='87.28' WHEN A='M' C B='95.2624' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS FC=F89J14(A) IF(FC.LT.-1.E+19) THEN IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR REFRIGERANT 115 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 S99J14(FUN) GAMPDD=-1.0E+30 RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 DATA FUN/'GAMPT'/ CALL S99J14(FUN) GAMPT=-1.0E+30 RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 DATA FUN/'GAMTDD'/ CALL S99J14(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 115'/, 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 = F23J14(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 115'/, 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 = F24J14(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPDD=FF RETURN END C------------------------------------------------- F71 = HPS REAL FUNCTION HPS(P,S) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, 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 = F71J14(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- HPS=FF RETURN END C------------------------------------------------- F25 = HPT REAL FUNCTION HPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, 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 = F25J14(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 115'/, 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 = F26J14(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 115'/, 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 = F27J14(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 115'/, 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 = F28J14(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 115'/, 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 = F29J14(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='CFC-115(R115)' WHEN A='S' C B='C2CLF5' WHEN A='C' C B='12.1' WHEN A='V' C************************************************ CHARACTER*20 FUNCTION IDENTF(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'S') THEN IDENTF='CFC-115(R115)' ELSE IF (A.EQ.'C') THEN IDENTF='C2CLF5' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR CFC-115(R115) WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F66 = PLDT REAL FUNCTION PLDT(T) CHARACTER FUN*6 DATA FUN/'PLDT'/ CALL S99J14(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT REAL FUNCTION PMLT(T) CHARACTER FUN*6 DATA FUN/'PMLT'/ CALL S99J14(FUN) PMLT=-1.0E+30 RETURN END C------------------------------------------------- F85 = PRPD REAL FUNCTION PRPD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, FUN/'PRPD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F85J14(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- PRPD=FF RETURN END C------------------------------------------------- F86 = PRPDD REAL FUNCTION PRPDD(T) CHARACTER FUN*6 DATA FUN/'PRPDD'/ CALL S99J14(FUN) PRPDD=-1.0E+30 RETURN END C------------------------------------------------- F81 = PRPT REAL FUNCTION PRPT(P,T) CHARACTER FUN*6 DATA FUN/'PRPT'/ CALL S99J14(FUN) PRPT=-1.0E+30 RETURN END C------------------------------------------------- F87 = PRTD REAL FUNCTION PRTD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, FUN/'PRTD'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F87J14(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- PRTD=FF RETURN END C------------------------------------------------- F88 = PRTDD REAL FUNCTION PRTDD(T) CHARACTER FUN*6 DATA FUN/'PRTDD'/ CALL S99J14(FUN) PRTDD=-1.0E+30 RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99J14(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 115'/, 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 = F30J14(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 PST=FF/PBAR RETURN END C------------------------------------------------- F72 = PSTD REAL FUNCTION PSTD(T) CHARACTER FUN*6 DATA FUN/'PSTD'/ CALL S99J14(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD REAL FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99J14(FUN) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F31 = SIGP REAL FUNCTION SIGP(T) CHARACTER FUN*6 DATA FUN/'SIGP'/ CALL S99J14(FUN) SIGP=-1.0E+30 RETURN END C------------------------------------------------- F32 = SIGT REAL FUNCTION SIGT(T) CHARACTER FUN*6 DATA FUN/'SIGT'/ CALL S99J14(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 115'/, 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 = F33J14(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 115'/, 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 = F34J14(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 115'/, 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 = F35J14(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 115'/, 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 = F36J14(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 115'/, 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 = F37J14(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 115'/, 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 = F38J14(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 115'/, 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 = F39J14(TI,X) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T,X 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND X=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- STX=FF RETURN END C------------------------------------------------- F67 = TLDP REAL FUNCTION TLDP(P) CHARACTER FUN*6 DATA FUN/'TLDP'/ CALL S99J14(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP REAL FUNCTION TMLP(P) CHARACTER FUN*6 DATA FUN/'TMLP'/ CALL S99J14(FUN) TMLP=-1.0E+30 RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 DATA FUN/'TPSEUP'/ CALL S99J14(FUN) TPSEUP=-1.0E+30 RETURN END C------------------------------------------------- F64 = TPH REAL FUNCTION TPH(P,H) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,H,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, 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 = F64J14(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 115'/, 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 = F65J14(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 115'/, 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 = F70J14(PI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,V 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND V=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TPV=FF+T0K RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99J14(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 115'/, 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 = F40J14(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 115'/, FUN/'TRPL'/ C--- LEVEL 3 ERROR CHECK & MESSAGE --- MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+30 C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- TRPL=FF RETURN END C------------------------------------------------- F74 = TSPD REAL FUNCTION TSPD(P) CHARACTER FUN*6 DATA FUN/'TSPD'/ CALL S99J14(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD REAL FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99J14(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 115'/, 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 = F42J14(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 115'/, 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 = F43J14(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UPDD=FF RETURN END C------------------------------------------------- F79 = UPS REAL FUNCTION UPS(P,S) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, 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 = F79J14(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- UPS=FF RETURN END C------------------------------------------------- F44 = UPT REAL FUNCTION UPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, 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 = F44J14(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 115'/, 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 = F45J14(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 115'/, 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 = F46J14(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 115'/, 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 = F47J14(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 115'/, 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 = F48J14(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 115'/, 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 = F49J14(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 115'/, 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 = F50J14(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VPDD=FF RETURN END C------------------------------------------------- F80 = VPS REAL FUNCTION VPS(P,S) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,S,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, 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 = F80J14(PI,S) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,S 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND S=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- VPS=FF RETURN END C------------------------------------------------- F51 = VPT REAL FUNCTION VPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 115'/, 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 = F51J14(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 115'/, 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 = F52J14(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 115'/, 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 = F53J14(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 115'/, 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 = F54J14(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 115'/, 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 = F55J14(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 115'/, 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 = F83J14(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 115'/, 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 = F56J14(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 115'/, 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 = F57J14(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 115'/, 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 = F58J14(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 115'/, 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 = F59J14(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 115'/, 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 = F60J14(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 115'/, 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 = F61J14(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 115'/, 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 = F62J14(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 115'/, 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 = F63J14(TI,V) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T,V 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' AND V=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- XTV=FF RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99J14(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR R 115 ****' WRITE(6,100) MSG 100 FORMAT(1H ,5X,A) ENDIF RETURN END C ********** R115 ********* C ********** VER. 9.1.********* C ********** R115 ********* C C G01 ****** FUNCTION G01J14(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J14,VM3K,TDGC C COMMON/R115A/A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, C & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 C DATA A01,A02,A03,A04,A05/2.3366423320D-02, 3.6254298340D+01, &-8.9222216730D+03, 3.7757690770D+06, 2.3826225750D+08 / DATA A06,A07,A08,A09,A10/4.1067070490D-01, -2.6810832280D+02, &5.8910342990D+04,-4.1131369640D-01, 1.8247777160D+02/ DATA A11,A12,A13,A14,A15/4.5099307060D-01, -2.8676585670D+02, &7.2142477090D+01, -1.1555632860D+07, 4.3630653440D+09/ DATA A16,A17,A18,A19,A20/-4.8300903530D+11, 1.7669793250D+07, &-1.9335704800D+10, 3.8905495630D+12,4.000000000D+00/ C T=DBLE(TDGC)+2.731500D2 TI=1.000D0/T T2I=TI*TI T3I=T2I*TI T4I=T2I*T2I C RO=1.000D-3/DBLE(VM3K) C GRAM/CM 3 RO2=RO*RO C C R115 R=8.31451D0/1.54480D2 C KJ/KMOL K KG/KMOLE C BP=A01-A03*T2I BM=-((A05*TI+A04)*T2I+A02)*TI CP=A08*T2I+A06 CM=A07*TI DP=A09 DM=A10*TI EP=A11 EM=A12*TI FP=A13*TI FM=0.0D0 GP=A15*T4I GM=(A16*T2I+A14)*T3I HP=(A19*T2I+A17)*T3I HM=A18*T4I C C RO2=RO*RO 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=((((FM*RO+EM)*RO+DM)*RO+CM)*RO+BM)*RO W2=RO*T*(R+WP+W1P+W1M+WM) G01J14=SNGL(W2)*10.0 C BAR RETURN END C G02 ****** FUNCTION G02J14(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G02J14,VM3K,TDGC,UJ,PMPA,G01J14 C COMMON/R115A/A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, C & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 C COMMON/R115D/D1,D2,D3,D4,D5 C DATA A01,A02,A03,A04,A05/2.3366423320D-02, 3.6254298340D+01, &-8.9222216730D+03, 3.7757690770D+06, 2.3826225750D+08 / DATA A06,A07,A08,A09,A10/4.1067070490D-01, -2.6810832280D+02, &5.8910342990D+04,-4.1131369640D-01, 1.8247777160D+02/ DATA A11,A12,A13,A14,A15/4.5099307060D-01, -2.8676585670D+02, &7.2142477090D+01, -1.1555632860D+07, 4.3630653440D+09/ DATA A16,A17,A18,A19,A20/-4.8300903530D+11, 1.7669793250D+07, &-1.9335704800D+10, 3.8905495630D+12,4.000000000D+00/ C DATA D1,D2,D3,D4,D5/1.313895D-1, 2.882158D-3,-4.406363D-6, & 5.603690D-9,-3.856480D-12/ C C C R115 C DATA T0,H0/2.9815D2,3.3250D2/ C R115 C C WRITE(6,101) A01,A02,A03,A04,A05,A06,A07,A08,A09,A10 C WRITE(6,101) A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 C 101 FORMAT(1H ,1PD17.10) C DUM=A01+A11+A06+A09 DUM=DUM 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 C RO=1.000D-3/DBLE(VM3K) C GRAM/CM 3 RO2=RO*RO RO3=RO2*RO C R=8.31451D0/1.54480D2 C KJ/KMOL K KG/KMOLE T2=T*T 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=(4.000D0*A05*T3I+3.000D0*A04*T2I+A02)*T2I BDM=2.000D0*A03*T3I CDP=-A07*T2I CDM=-2.000D0*A08*T3I DDP=0.0D0 DDM=-A10*T2I EDP=-A12*T2I EDM=0.0D0 FDP=0.0D0 FDM=-A13*T2I GDP=(-5.000D0*A16*T2I-3.000D0*A14)*T4I GDM=-4.000D0*A15*T5I HDP=-4.000D0*A18*T5I HDM=-(5.000D0*A19*T2I+3.000D0*A17)*T4I C SP=((EDP*2.500D-1*RO2+CDP*5.000D-1)*RO+BDP)*RO SM=(((FDM*2.000D-1*RO2+DDM/3.000D0)*RO+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=G01J14(VM3K,TDGC)*0.1 IF(PMPA.LT.0.016) GO TO 10 G02J14=UJ+PMPA*VM3K*1.0E6 RETURN 10 G02J14=-1.0E20 RETURN END C G03 ******* FUNCTION G03J14(VM3K,TDGC,PMPA) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G03J14,VM3K,TDGC,PMPA,CV,G04J14 C COMMON/R115A/A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, C & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 C DATA A01,A02,A03,A04,A05/2.3366423320D-02, 3.6254298340D+01, &-8.9222216730D+03, 3.7757690770D+06, 2.3826225750D+08 / DATA A06,A07,A08,A09,A10/4.1067070490D-01, -2.6810832280D+02, &5.8910342990D+04,-4.1131369640D-01, 1.8247777160D+02/ DATA A11,A12,A13,A14,A15/4.5099307060D-01, -2.8676585670D+02, &7.2142477090D+01, -1.1555632860D+07, 4.3630653440D+09/ DATA A16,A17,A18,A19,A20/-4.8300903530D+11, 1.7669793250D+07, &-1.9335704800D+10, 3.8905495630D+12,4.000000000D+00/ C C C R115 CP 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 C R=8.31451D0/1.54480D2 C KJ/KMOL K KG/KMOLE C C BDP=(3.000D0*A04*T2I+4.000D0*A05*T3I+A02)*T2I BDM=2.000D0*A03*T3I CDP=-A07*T2I CDM=-2.000D0*A08*T3I DDM=-A10*T2I EDP=-A12*T2I FDM=-A13*T2I GDP=(-5.000D0*A16*T2I-3.000D0*A14)*T4I GDM=-4.000D0*A15*T5I HDP=-4.000D0*A18*T5I HDM=-(5.000D0*A19*T2I+3.000D0*A17)*T4I C SP=((EDP*RO2+CDP)*RO+BDP)*RO SM=(((FDM*RO2+DDM)*RO+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-A03*T2I BM=-((A05*TI+A04)*T2I+A02)*TI CP=A08*T2I+A06 CM=A07*TI DP=A10*TI DM=A09 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=G04J14(VM3K,TDGC) CP=DBLE(CV)+W G03J14=SNGL(CP) RETURN END C G04 ******* FUNCTION G04J14(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G04J14,VM3K,TDGC C COMMON/R115A/A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, C & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 C COMMON/R115D/D1,D2,D3,D4,D5 C DATA A01,A02,A03,A04,A05/2.3366423320D-02, 3.6254298340D+01, &-8.9222216730D+03, 3.7757690770D+06, 2.3826225750D+08 / DATA A06,A07,A08,A09,A10/4.1067070490D-01, -2.6810832280D+02, &5.8910342990D+04,-4.1131369640D-01, 1.8247777160D+02/ DATA A11,A12,A13,A14,A15/4.5099307060D-01, -2.8676585670D+02, &7.2142477090D+01, -1.1555632860D+07, 4.3630653440D+09/ DATA A16,A17,A18,A19,A20/-4.8300903530D+11, 1.7669793250D+07, &-1.9335704800D+10, 3.8905495630D+12,4.000000000D+00/ C DATA D1,D2,D3,D4,D5/1.313895D-1, 2.882158D-3,-4.406363D-6, & 5.603690D-9,-3.856480D-12/ C DUM=A01+A11+A06+A09 DUM=DUM C C R115 CV 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/1.54480D2 C KJ/KMOL K KG/KMOLE C BDDP=-6.000D0*A03*T4I BDDM=(-12.000D0*A04*T2I-2.000D1*A05*T3I-2.000D0*A02)*T3I CDDP=6.000D0*A08*T4I CDDM=2.000D0*A07*T3I DDDP=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*2.000D-1*RO2+DDDP/3.000D0)*RO+CDDP*5.000D-1)*RO+BDDP 1)*RO SM2=((EDDM*2.500D-1*RO2+CDDM*5.000D-1)*RO+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 C BDP=(3.000D0*A04*T2I+2.000D0*A03*TI+A02)*T2I BDM=4.000D0*A05*T5I CDP=-A07*T2I CDM=-2.000D0*A08*T3I DDM=-A10*T2I EDP=-A12*T2I FDM=-A13*T2I GDP=(-5.000D0*A16*T2I-3.000D0*A14)*T4I GDM=-4.000D0*A15*T5I HDP=-4.000D0*A18*T5I HDM=-(5.000D0*A19*T2I+3.000D0*A17)*T4I C SP=((EDP*2.500D-1*RO2+CDP*5.000D-1)*RO+BDP)*RO SM=(((FDM*2.000D-1*RO2+DDM/3.000D0)*RO+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 G04J14=SNGL(CV) RETURN END C G05 ****************** FUNCTION G05J14(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G05J14,VM3K,TDGC C R115 C COMMON/R115A/A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, C & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 C COMMON/R115D/D1,D2,D3,D4,D5 C DATA A01,A02,A03,A04,A05/2.3366423320D-02, 3.6254298340D+01, &-8.9222216730D+03, 3.7757690770D+06, 2.3826225750D+08 / DATA A06,A07,A08,A09,A10/4.1067070490D-01, -2.6810832280D+02, &5.8910342990D+04,-4.1131369640D-01, 1.8247777160D+02/ DATA A11,A12,A13,A14,A15/4.5099307060D-01, -2.8676585670D+02, &7.2142477090D+01, -1.1555632860D+07, 4.3630653440D+09/ DATA A16,A17,A18,A19,A20/-4.8300903530D+11, 1.7669793250D+07, &-1.9335704800D+10, 3.8905495630D+12,4.000000000D+00/ C DATA D1,D2,D3,D4,D5/1.313895D-1, 2.882158D-3,-4.406363D-6, & 5.603690D-9,-3.856480D-12/ C C DATA T0,S0,P0/2.9815D2,1.5554D0,1.0D-1/ C C R115 S C DUM=A10+A02+A12+A13+A07 DUM=DUM 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/1.54480D2 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 C IF(R*T*RO/P0.LT.1.0E-6) WRITE(*,*) R,T,RO,P0 C 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 10 BBDPT=A01+(2.0D0*A04+3.0D0*A05*TI)*T3I CCDPT=A06 DDDPT=0.0D0 EEDPT=A11 FFDPT=0.0D0 GGDPT=(-2.0D0*A16*T2I-A14)*2.0D0*T3I HHDPT=-3.0D0*A18*T4I C BBDMT=A03*T2I CCDMT=-A08*T2I DDDMT=A09 EEDMT=0.0D0 FFDMT=0.0D0 GGDMT=-3.0D0*A15*T4I HHDMT=(-2.0D0*A19*T2I-A17)*2.0D0*T3I C 20 ZP=(((EEDPT/4.0D0*RO+DDDPT/3.0D0)*RO+CCDPT/2.0D0)*RO+BBDPT)*RO ZM=(((EEDMT/4.0D0*RO+DDDMT/3.0D0)*RO+CCDMT/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 C IF(T/T0.LT.1.0E-3) WRITE(*,*) 'T,T0=',T,T0 WLOG=D1*DLOG(T/T0) G05J14=SNGL(WSP+S0+WLOG+WSM)*1.0E3 RETURN END C 82 FUNCTION F82J14(PBAR,TDGC) WA=F83J14(PBAR,TDGC) IF(WA.LT.0.0) GO TO 10 VM3K=F51J14(PBAR,TDGC) IF(VM3K.LT.0.0) GO TO 20 DXIN=WA*WA/(PBAR*VM3K*1.0E5) F82J14=DXIN RETURN 10 IF(WA.LT.-1.0E+11) THEN F82J14=-1.0E+20 ELSE F82J14=-1.0E+10 END IF RETURN 20 IF(VM3K.LT.-1.0E+11) THEN F82J14=-1.0E+20 ELSE F82J14=-1.0E+10 END IF RETURN END C 2 ****** C FUNCTION F2J14(PBAR) SURFACE T. NON C 3 ****** C FUNCTION F3J14(TDGC) SURFACE T. NON C 4 ****** FUNCTION F4J14(PBAR) ALH=F24J14(PBAR) IF(ALH.LT.-1.0E9) GO TO 10 HD=F23J14(PBAR) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F4J14=ALH RETURN 20 F4J14=HD RETURN END C 5 ****** FUNCTION F5J14(TDGC) ALH=F28J14(TDGC) IF(ALH.LT.-1.0E9) GO TO 10 HD=F27J14(TDGC) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F5J14=ALH RETURN 20 F5J14=HD RETURN END C 6 ******* FUNCTION F6J14(PBAR) TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 ALMPD=F9J14(TDGC) F6J14=ALMPD RETURN 10 F6J14=TDGC RETURN 20 F6J14=-1.0E20 RETURN END C 7 ******* C FUNCTION F7J14(PBAR) C 8 ******* FUNCTION F8J14(PBAR,TDGC) PDUMMY=PBAR C PDUMMY=1.01325 TK=TDGC+273.15 IF(TK.GE.213.0.AND.TK.LE.323.0) GO TO 10 F8J14=-1.0E20 RETURN 10 ALMPT=G23J14(TK) F8J14=ALMPT RETURN END C G23 *********** FUNCTION G23J14(T) C R115 1ATM GAS THERM.COND (W/M K) C T=TDGC+273.15 G23J14=(1.35245E-8*T+5.33828E-5)*T-0.0046274 RETURN END C 9 ******* FUNCTION F9J14(TDGC) C LAMBDA (SAT. LIQ.) TK=TDGC+273.15 IF(TK.GE.165.0.AND.TK.LE.390.0) GO TO 10 F9J14=-1.0E20 RETURN 10 ALMTD=G21J14(TK) F9J14=ALMTD RETURN END C G21 ****** FUNCTION G21J14(T) C R115 SAT. LIQ THERM.COND (W/M K) TDGC=T-273.15 G21J14=0.06030-0.000324*TDGC RETURN END C 10 ******* C FUNCTION F10J14(TDGC) C LAMBDA (SAT. VAP.) NON C 11 ******* FUNCTION F11J14(PBAR) TDGC=F40J14(PBAR) IF(TDGC.LT.-1.E9) GO TO 10 AMUPD=F14J14(TDGC) F11J14=AMUPD RETURN 10 F11J14=TDGC RETURN END C 12 ******* FUNCTION F12J14(PBAR) TDGC=F40J14(PBAR) IF(TDGC.LT.-1.E9) GO TO 10 AMUPDD=F15J14(TDGC) F12J14=AMUPDD RETURN 10 F12J14=TDGC RETURN END C 13 ******* FUNCTION F13J14(PBAR,TDGC) PDUMMY=PBAR C PDUMMY=1.01325 TK=TDGC+273.15 IF(TK.GE.230.0.AND.TK.LE.500.0) GO TO 10 F13J14=-1.0E20 RETURN 10 F13J14=G33J14(TK) RETURN END C G33 ************* FUNCTION G33J14(T) C R115 1ATM GAS VISCOSITY (PA S) C T=DGC+273.15 W=SQRT(T)/((-12872.0/T+248.768)/T+0.67069) G33J14=1.0E-6*W RETURN END C 14 ******* FUNCTION F14J14(TDGC) TK=TDGC+273.15 IF(TK.GE.170.0.AND.TK.LE.390.0) GO TO 10 F14J14=-1.0E20 RETURN 10 AMUTD=G31J14(TK) F14J14=AMUTD RETURN END C G31 ****** FUNCTION G31J14(T) C R115 SAT. LIQ VISCOSITY (PA S) C T=DGC+273.15 W=-4.42089+833.816/T W=EXP(W) G31J14=1.0E-3*W RETURN END FUNCTION G31K14(T) C R115 SAT. LIQ VISCOSITY (PA S) C T=DGC+273.15 W=((-8.33333E-7*T+7.950E-4)*T-0.25507)*T+27.66810 G31K14=1.0E-3*W RETURN END C 15 ******* FUNCTION F15J14(TDGC) TK=TDGC+273.15 IF(TK.GE.290.0.AND.TK.LE.470.0) GO TO 10 F15J14=-1.0E20 RETURN 10 AMUTDD=G32J14(TK) F15J14=AMUTDD RETURN END C G32 ****** FUNCTION G32J14(T) C R115 VAP. LIQ VISCOSITY (PA S) C T=DGC+273.15 W=((1.03059E-8*T-8.28845E-6)*T+2.25953E-3)*T-0.19678 G32J14=1.0E-3*W RETURN END C 16 ****** FUNCTION F16J14(PBAR) TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPD=F19J14(TDGC) F16J14=CPD RETURN 10 F16J14=TDGC RETURN END C 17 ****** FUNCTION F17J14(PBAR) TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPDD=F20J14(TDGC) F17J14=CPDD RETURN 10 F17J14=TDGC RETURN END C 18 ******* FUNCTION F18J14(PBAR,TDGC) C C CP C VM3K=F51J14(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 10 IF(VM3K.LT.5.9E-4) GO TO 20 PMPA=PBAR*0.1 CP=G03J14(VM3K,TDGC,PMPA) F18J14=CP RETURN 10 F18J14=VM3K RETURN 20 F18J14=-1.0E10 RETURN END C 19 ******* FUNCTION F19J14(TDGC) C C CP SAT. LIQUID(TEMP) C PBAR=F30J14(TDGC) IF(PBAR.LT.-1.0E9) GO TO 30 VM3K=F53J14(TDGC) IF(VM3K.LT.-1.0E9) GO TO 10 IF(VM3K.LT.5.9E-4) GO TO 20 PMPA=PBAR*0.1 CP=G03J14(VM3K,TDGC,PMPA) F19J14=CP RETURN 10 F19J14=VM3K RETURN 20 F19J14=-1.0E10 RETURN 30 F19J14=PBAR RETURN END C 20 ******* FUNCTION F20J14(TDGC) C C CP SAT.VAPOR(TEMP) C PBAR=F30J14(TDGC) IF(PBAR.LT.-1.0E9) GO TO 30 VM3K=F54J14(TDGC) IF(VM3K.LT.-1.0E9) GO TO 10 IF(VM3K.LT.1.629E-3) GO TO 20 PMPA=PBAR*0.1 CP=G03J14(VM3K,TDGC,PMPA) F20J14=CP RETURN 10 F20J14=VM3K RETURN 20 F20J14=-1.0E10 RETURN 30 F20J14=PBAR RETURN END C 21 ******** FUNCTION F21J14(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 F21J14=31.600 RETURN 20 F21J14=79.95 RETURN 30 F21J14=1.6300E-3 RETURN 40 F21J14=0.3125E6 RETURN 50 F21J14=1.345E3 RETURN 60 F21J14=-1.0E+30 RETURN END C 76 ******* FUNCTION F76J14(PBAR) TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 20 CVDD=F78J14(TDGC) F76J14=CVDD RETURN 20 F76J14=-1.0E20 RETURN END C 77 ******* FUNCTION F77J14(PBAR,TDGC) C C CV C VM3K=F51J14(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 10 IF(VM3K.LT.5.9E-4) GO TO 20 CV=G04J14(VM3K,TDGC) F77J14=CV RETURN 10 F77J14=VM3K RETURN 20 F77J14=-1.0E10 RETURN END C 78 ******* FUNCTION F78J14(TDGC) C C CV SAT.VAPOR(TEMP) C VM3K=F54J14(TDGC) IF(VM3K.LT.-1.0E9) GO TO 10 IF(VM3K.LT.1.629E-3) GO TO 20 CV=G04J14(VM3K,TDGC) F78J14=CV RETURN 10 F78J14=VM3K RETURN 20 F78J14=-1.0E10 RETURN END C 89 ******** FUNCTION F89J14(C) CHARACTER C IF(C.EQ.'M') GO TO 10 IF(C.EQ.'R') GO TO 20 GO TO 60 10 F89J14=154.480 RETURN 20 F89J14=53.822 RETURN 60 F89J14=-1.0E+30 RETURN END C 23 ****** FUNCTION F23J14(PBAR) C IF(PBAR.LT.0.16.OR.PBAR.GT.31.600) GO TO 20 C TSDGC=F40J14(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F27J14(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F23J14=H RETURN 15 F23J14=TSDGC RETURN 16 F23J14=H RETURN 20 F23J14=-1.0E20 RETURN END C 24 ****** FUNCTION F24J14(PBAR) C IF(PBAR.LT.0.16.OR.PBAR.GT.31.600) GO TO 20 C TSDGC=F40J14(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F28J14(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F24J14=H RETURN 15 F24J14=TSDGC RETURN 16 F24J14=H RETURN 20 F24J14=-1.0E20 RETURN END C 71 ******* FUNCTION F71J14(PBAR,S) C C H(P,S) C CALL S08J14(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.353.10) GO TO 10 PSAT=F30J14(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 10 STDD=F38J14(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 10 STD=F37J14(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=F28J14(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 HTD=F27J14(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 H=HTD*(1.0-X)+HTDD*X 10 F71J14=H RETURN 11 F71J14=PSAT RETURN 12 F71J14=STDD RETURN 13 F71J14=STD RETURN 14 F71J14=HTDD RETURN 15 F71J14=HTD RETURN 20 F71J14=TDGC RETURN 30 F71J14=-1.0E20 RETURN END C 25 ****** FUNCTION F25J14(PBAR,TDGC) C IF(PBAR.LT.0.3.OR.PBAR.GT. 70.0) GO TO 20 IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.450.0) GO TO 20 C VM3K=F51J14(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-353.10.GT.-273.15) GO TO 10 VTD=F53J14(TDGC) IF((VM3K-VTD)/1.4854E-3.GT.1.0E-5) GO TO 10 H=G02J14(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J14=H RETURN 10 H=G02J14(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J14=H RETURN 15 F25J14=VM3K RETURN 16 F25J14=H RETURN 20 F25J14=-1.0E20 RETURN END C 26 ******* FUNCTION F26J14(PBAR,X) TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 H=F29J14(TDGC,X) F26J14=H RETURN 10 F26J14=TDGC RETURN END C 27 ****** FUNCTION F27J14(TDGC) C C HDT SAT. LIQUID(TEMP) C VDM3K=F53J14(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.5.9E-4) GO TO 20 HD=G02J14(VDM3K,TDGC) F27J14=HD RETURN 10 F27J14=VDM3K RETURN 20 F27J14=-1.0E10 RETURN END C 28 ****** FUNCTION F28J14(TDGC) C C HDDT SAT. VAPOUR(TEMP) C VDM3K=F54J14(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.1.6300E-3) GO TO 20 HDD=G02J14(VDM3K,TDGC) F28J14=HDD RETURN 10 F28J14=VDM3K RETURN 20 F28J14=-1.0E10 RETURN END C 29 ****** FUNCTION F29J14(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 HTD=F27J14(TDGC) IF(HTD.LT.-1.0E9) GO TO 20 HTDD=F28J14(TDGC) IF(HTDD.LT.-1.0E9) GO TO 10 F29J14=(1.0-X)*HTD+X*HTDD RETURN 10 F29J14=HTDD RETURN 20 F29J14=HTD RETURN 30 F29J14=-1.0E20 RETURN END C 85 ****** FUNCTION F85J14(PBAR) TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 F85J14=F87J14(TDGC) RETURN 10 F85J14=TDGC RETURN END C 86 ********* C FUNCTION F86J14(PBAR) C PR (SAT. VAP) C 87 ****** FUNCTION F87J14(TDGC) AMUTD=F14J14(TDGC) IF(AMUTD.LT.0.0) GO TO 10 CPTD=F19J14(TDGC) IF(CPTD.LT.0.0) GO TO 20 ALMTD=F9J14(TDGC) IF(ALMTD.LT.0.0) GO TO 30 F87J14=AMUTD*CPTD/ALMTD RETURN 10 F87J14=AMUTD RETURN 20 F87J14=CPTD RETURN 30 F87J14=ALMTD RETURN END C 88 ********* C FUNCTION F88J14(TDGC) C PR (SAT. VAP) C 30 ****** FUNCTION F30J14(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F30J14,TDGC C COMMON/R115B/BI(4) C COMMON/R115CR/PC,TC,ROC C BAR K KG/M3 C DIMENSION BI(4) DATA BI/ -7.023396D0, 1.044096D0, -2.801354D0,-1.068209D0/ C DATA PC,TC,ROC/3.1600D1,3.5310D2,0.6135D3/ C BAR K KG/M3 C ROW=ROC ROW=ROW C T=DBLE(TDGC+273.15) TAU=1.0D0-(T/TC) IF(TAU.GT.1.0D-5) THEN SQTAU=DSQRT(TAU) ELSE PSW=PC GO TO 10 END IF W2=TAU*TAU TAUT=W2*TAU C PSW=BI(1)/SQTAU+BI(2)+BI(3)*TAU+BI(4)*TAU**5 PSW=(BI(1)+BI(2)*SQTAU)*TAU+(BI(3)+BI(4)*TAUT)*TAUT PSW=DEXP(PSW*TC/T)*PC C 10 F30J14=SNGL(PSW) RETURN END C 31 ******* C FUNCTION F31J14(PBAR) C 32 ******* C FUNCTION F32J14(TDGC) C 33 ****** FUNCTION F33J14(PBAR) C C IF(PBAR.LT.13.3.OR.PBAR.GT.31.600) GO TO 20 C TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F37J14(TDGC) IF(S.LT.-1.0E9) GO TO 16 F33J14=S RETURN 15 F33J14=TDGC RETURN 16 F33J14=S RETURN 20 F33J14=-1.0E20 RETURN END C 34 ****** FUNCTION F34J14(PBAR) C C IF(PBAR.LT.13.3.OR.PBAR.GT.31.600) GO TO 20 C TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F38J14(TDGC) IF(S.LT.-1.0E9) GO TO 16 F34J14=S RETURN 15 F34J14=TDGC RETURN 16 F34J14=S RETURN 20 F34J14=-1.0E20 RETURN END C 35 ****** FUNCTION F35J14(PBAR,TDGC) C IF(PBAR.LT.0.3.OR.PBAR.GT. 70.0) GO TO 20 IF(TDGC+273.15.LT.200.0.OR.TDGC+273.15.GT.450.0) GO TO 20 C VM3K=F51J14(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-353.10.GT.-273.15) GO TO 10 VTD=F53J14(TDGC) IF((VM3K-VTD)/1.6300E-3.GT.1.0E-5) GO TO 10 S=G05J14(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J14=S RETURN 10 S=G05J14(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J14=S RETURN 15 F35J14=VM3K RETURN 16 F35J14=S RETURN 20 F35J14=-1.0E20 RETURN END C 36 ******* FUNCTION F36J14(PBAR,X) TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 S=F39J14(TDGC,X) F36J14=S RETURN 10 F36J14=TDGC RETURN END C 37 ****** FUNCTION F37J14(TDGC) C C SDT SAT. LIQUID(TEMP) C VDM3K=F53J14(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.5.9E-4) GO TO 20 SD=G05J14(VDM3K,TDGC) F37J14=SD RETURN 10 F37J14=VDM3K RETURN 20 F37J14=-1.0E10 RETURN END C 38 ****** FUNCTION F38J14(TDGC) C C SDDT SAT. VAPOUR(TEMP) C VDM3K=F54J14(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.1.6300E-3) GO TO 20 SDD=G05J14(VDM3K,TDGC) F38J14=SDD RETURN 10 F38J14=VDM3K RETURN 20 F38J14=-1.0E10 RETURN END C 39 ******* FUNCTION F39J14(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 STD=F37J14(TDGC) IF(STD.LT.-1.0E9) GO TO 20 STDD=F38J14(TDGC) IF(STDD.LT.-1.0E9) GO TO 10 F39J14=(1.0-X)*STD+X*STDD RETURN 10 F39J14=STDD RETURN 20 F39J14=STD RETURN 30 F39J14=-1.0E20 RETURN END C 40 ******** FUNCTION F40J14(PBAR) C IF(PBAR.LT.0.16.OR.PBAR.GT.31.65) GO TO 40 TMIN=199.8-273.15 TMAX=353.10-273.15 PRI=F30J14(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=F30J14(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=F30J14(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=F30J14(TMAX) PTMIN=F30J14(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 F40J14=-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 Q1=TA*TDGCA+TB*TDGCB TDGC=Q1 PBARW=F30J14(TDGC) EQIVZ=PSTBAR-PBARW G1=ABS(EQIVZ) Q2=TB*TDGCA+TA*TDGCB TDGC=Q2 PBARW=F30J14(TDGC) EQIVZ=PSTBAR-PBARW G2=ABS(EQIVZ) C IC=0 22 W=ABS(TDGCB-TDGCA) IC=IC+1 IF(IC.GT.100) THEN F40J14=-1.0E10 RETURN END IF C 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=F30J14(TDGC) EQIVZ=PSTBAR-PBARW G2=ABS(EQIVZ) ELSE TDGCB=Q2 Q2=Q1 G2=G1 Q1=TA*TDGCA+TB*TDGCB TDGC=Q1 PBARW=F30J14(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 F40J14=TDGCW RETURN C 30 F40J14=-1.0E10 RETURN 40 F40J14=-1.0E20 RETURN 49 TDGC=PRI 50 F40J14=TDGC RETURN END C 42 ******* FUNCTION F42J14(PBAR) C C U=H-PV (SAT. LIQUID) C TSDGC=F40J14(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HD=F27J14(TSDGC) IF(HD.LT.-1.0E9) GO TO 20 VD=F53J14(TSDGC) IF(VD.LT.-1.0E9) GO TO 10 U=HD-PBAR*VD*1.0E5 F42J14=U RETURN 10 F42J14=VD RETURN 20 F42J14=HD RETURN 30 F42J14=TSDGC RETURN END C 43 ******* FUNCTION F43J14(PBAR) C C U=H-PV (SAT. VAPOR) C TSDGC=F40J14(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HDD=F28J14(TSDGC) IF(HDD.LT.-1.0E9) GO TO 20 VDD=F54J14(TSDGC) IF(VDD.LT.-1.0E9) GO TO 10 U=HDD-PBAR*VDD*1.0E5 F43J14=U RETURN 10 F43J14=VDD RETURN 20 F43J14=HDD RETURN 30 F43J14=TSDGC RETURN END C 79 ******* FUNCTION F79J14(PBAR,S) C C U(P,S) U=H-PV C CALL S08J14(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.353.10) GO TO 40 PSAT=F30J14(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 40 STDD=F38J14(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 40 STD=F37J14(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=F28J14(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 VTDD=F54J14(TDGC) IF(VTDD.LT.-1.0E9) GO TO 16 HTD=F27J14(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 VTD=F53J14(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 F79J14=H C WRITE(6,210) H C 210 FORMAT(1H ,42X,'RTN FROM 10 H=',E12.4) RETURN 11 F79J14=PSAT C WRITE(6,211) PSAT C 211 FORMAT(1H ,42X,'RTN FROM 11 PSAT=',E12.4) RETURN 12 F79J14=STDD C WRITE(6,212) STDD C 212 FORMAT(1H ,42X,'RTN FROM 12 STDD=',E12.4) RETURN 13 F79J14=STD C WRITE(6,213) STD C 213 FORMAT(1H ,42X,'RTN FROM 13 STD=',E12.4) RETURN 14 F79J14=HTDD C WRITE(6,214) HTDD C 214 FORMAT(1H ,42X,'RTN FROM 14 HTDD=',E12.4) RETURN 15 F79J14=HTD C WRITE(6,215) HTD C 215 FORMAT(1H ,42X,'RTN FROM 15 HTD=',E12.4) RETURN 16 F79J14=VTDD C WRITE(6,216) VTDD C 216 FORMAT(1H ,42X,'RTN FROM 16 VTDD=',E12.4) RETURN 17 F79J14=VTD C WRITE(6,217) VTD C 217 FORMAT(1H ,42X,'RTN FROM 17 VTD=',E12.4) RETURN 20 F79J14=TDGC C WRITE(6,220) TDGC C 220 FORMAT(1H ,42X,'RTN FROM 20 TDGC=',E12.4) RETURN 30 F79J14=-1.0E20 RETURN 40 F79J14=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 F44J14(PBAR,TDGC) C C U=H-PV C V=F51J14(PBAR,TDGC) IF(V.LT.-1.0E9) GO TO 20 IF(TDGC-353.10.GT.-273.15) GO TO 4 VTD=F53J14(TDGC) IF((V-VTD)/1.6300E-3.LT.1.0E-5) GO TO 5 4 H=G02J14(V,TDGC) GO TO 6 5 H=G02J14(V,TDGC) 6 IF(H.LT.-1.0E9) GO TO 10 U=H-PBAR*V*1.0E5 F44J14=U RETURN 10 F44J14=H RETURN 20 F44J14=V RETURN END C 45 ******* FUNCTION F45J14(PBAR,X) C C U=H-PV C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F42J14(PBAR) IF(UD.LT.-1.0E9) GO TO 20 UDD=F43J14(PBAR) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F45J14=U RETURN 10 F45J14=UDD RETURN 20 F45J14=UD RETURN 30 F45J14=-1.0E20 RETURN END C 46 ******* FUNCTION F46J14(TDGC) C C U=H-PV (SAT. LIQUID C HD=F27J14(TDGC) IF(HD.LT.-1.0E9) GO TO 30 VD=F53J14(TDGC) IF(VD.LT.-1.0E9) GO TO 20 PST=F30J14(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HD-PST*VD*1.0E5 F46J14=U RETURN 10 F46J14=PST RETURN 20 F46J14=VD RETURN 30 F46J14=HD RETURN END C 47 ******* FUNCTION F47J14(TDGC) C C U=H-PV (SAT. VAPOR) C HDD=F28J14(TDGC) IF(HDD.LT.-1.0E9) GO TO 30 VDD=F54J14(TDGC) IF(VDD.LT.-1.0E9) GO TO 20 PST=F30J14(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HDD-PST*VDD*1.0E5 F47J14=U RETURN 10 F47J14=PST RETURN 20 F47J14=VDD RETURN 30 F47J14=HDD RETURN END C 48 ******* FUNCTION F48J14(TDGC,X) C C U=H-PV (SAT. LIQUID) C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F46J14(TDGC) IF(UD.LT.-1.0E9) GO TO 20 UDD=F47J14(TDGC) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F48J14=U RETURN 10 F48J14=UDD RETURN 20 F48J14=UD RETURN 30 F48J14=-1.0E20 RETURN END C 80 ****** FUNCTION F80J14(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 S08J14(PBAR0,S,VX,TDGC,H) IF(VX.LT.5.9E-4) GO TO 10 IF(PBAR0.GT.31.600) GO TO 10 PST=F30J14(PBAR0) IF(ABS((PST-PBAR0)/PBAR0).LT.1.0E-5) GO TO 35 10 F80J14=VX RETURN 35 STD=F37J14(TDGC) STDD=F38J14(TDGC) VTD=F53J14(TDGC) VTDD=F54J14(TDGC) SX=(S-STD)/(STDD-STD) VX=VTD+(VTDD-VTD)*SX F80J14=VX RETURN END C 49 ****** FUNCTION F49J14(PBAR) C C SAT. VD(P) VPD SAT. LIQUID SPECFIC VOL.(PRESS) C IF(PBAR.LT.0.162.OR.PBAR.GT.31.603) GO TO 20 C TDGC=F40J14(PBAR) VSM3K=TDGC IF(TDGC.LT.-1.0E9) GO TO 15 VSM3K=F53J14(TDGC) 15 F49J14=VSM3K RETURN 20 F49J14=-1.0E20 RETURN END C 50 ****** FUNCTION F50J14(PBAR) C C SAT. VDD(P) VPDD SAT. SPECIFIC VOL.(PRESS) C IF(PBAR.LT.0.162.OR.PBAR.GT.31.603) GO TO 20 C TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 VSM3K=F54J14(TDGC) F50J14=VSM3K RETURN 15 F50J14=TDGC RETURN 20 F50J14=-1.0E20 RETURN END C 51 ******** FUNCTION F51J14(PBAR,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J14,F51J14,PBAR,TDGC,VNL,VXL,V1,V2,P1,P2,VMINL REAL PST,F53J14,F54J14,VMIN,VMAX,PX,PW,VW,VMINCL,VMAXCL REAL VM3KC,PCBAR DATA VM3KC,TCK,PCBAR/1.6300E-3,3.5310D2,31.600/ DATA VMINL/0.6030E-3/ C CHK RANGE PBAR,TDGC IF(PBAR.LT.0.162.OR.PBAR.GT.70.0) GO TO 70 TK=TDGC+2.7315D2 IF(TK.LT.1.998D2.OR.TK.GT.4.7690D2) 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=F53J14(TDGC) PST=G01J14(VW,TDGC) IF(ABS(PST/PBAR-1.0).GT.1.0E-6) GO TO 14 VW=F54J14(TDGC) GO TO 60 C 14 IF(PBAR.GT.PST) GO TO 15 VMIN=F54J14(TDGC) PW=G01J14(VMIN,TDGC) IF(PW/PBAR-1.0.LT.5.0E-6) THEN VW=F54J14(TDGC) GO TO 60 END IF CALL S04J14(PBAR,TDGC,VMAX,VMINCL) IF(VMINCL.GT.VMIN) VMIN=VMINCL ICASE=4 VNL=VMIN VXL=VMAX GO TO 20 15 VMAX=F53J14(TDGC) PW=G01J14(VMAX,TDGC) IF(PW/PBAR-1.0.GT.-5.0E-6) THEN VW=F54J14(TDGC) GO TO 60 END IF CALL S04J14(PBAR,TDGC,VMAXCL,VMIN) IF(VMAXCL.LT.VMAX) VMAX=VMAXCL IF(VMAX/VMIN-1.0.LT.1.0E-5) THEN VW=F54J14(TDGC) GO TO 60 END IF ICASE=2 VXL=VMAX VNL=VMIN GO TO 25 C C FROM 5 16 VW=VM3KC PX=G01J14(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 S04J14(PBAR,TDGC,VMAX,VMINCL) IF(VMINCL.GT.VMIN) VMIN=VMINCL ICASE=3 VNL=VMIN VXL=VMAX GO TO 20 17 VMAX=VM3KC CALL S04J14(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 S04J14(PBAR,TDGC,VMAX,VMINCL) VXL=VMAX C C FROM 37 TOO 19 VW=VMAX PX=G01J14(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=G01J14(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=G01J14(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=G01J14(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=G01J14(VMIN,TDGC) P2=G01J14(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=G01J14(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=G01J14(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=G01J14(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=G01J14(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 F51J14=-1.E10 RETURN 59 VW=(VMAX+VMIN)*0.5 60 F51J14=VW RETURN 70 F51J14=-1.0E20 RETURN END C 52 ******* FUNCTION F52J14(PBAR,X) TDGC=F40J14(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 V=F55J14(TDGC,X) F52J14=V RETURN 10 F52J14=TDGC RETURN END C 53 ******* FUNCTION F53J14(TDGC) TK=TDGC+273.15 IF(TK.LT.199.7) GO TO 40 IF(TK.GT.353.1) GO TO 40 PSTBAR=F30J14(TDGC) VM3KD=1.0E3/G53J14(TK) C CALL S01J14(PSTBAR,VM3KD,VDCAL,TK) VM3KW=1.0E-3*VDCAL PBARW=G01J14(VM3KW,TDGC) EQIVZ=PSTBAR-PBARW C EQIVZ=ABS(EQIVZ)/PSTBAR CZZ IF(EQIVZ.GT.0.01) THEN VDDDMK=G54J14(TDGC) C IF(VDDDMK.LT.1.0E-7) THEN F53J14=-1.0E10 RETURN END IF C RODD=1.0/VDDDMK RODDBS=RODD*1.2 RODDE=RODD*0.8 RODCAL=1.0/VDCAL CALL S03J14(RODDBS,RODDE,RODCAL,TK,VM3K) VDCAL=1.0/RODCAL CZZ END IF C F53J14=VDCAL*1.0E-3 RETURN 40 F53J14=-1.0E20 RETURN END C G53 ******* FUNCTION G53J14(TK) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G53J14,TK C COMMON/R115C/CI(3) C COMMON/R115CR/PC,TC,ROC C BAR K KG/M3 C DIMENSION CI(3) DATA CI/1.711552D0,6.068560D-1,7.606392D-1/ C DATA PC,TC,ROC/3.1600D1,3.5310D2,0.6135D3/ C BAR K KG/M3 PCW=PC PCW=PCW C T=DBLE(TK) TAU=1.0D0-(T/TC) IF(TAU.GT.1.0D-5) THEN TRTAU=TAU**(1.0D0/3.0D0) ELSE RSW=ROC GO TO 10 END IF W2=TAU*TAU C RSW=CI(1)/W2+(CI(2)+CI(3)*TRTAU)*TRTAU RSW=CI(3)*W2*TAU+(CI(1)+CI(2)*TRTAU)*TRTAU RSW=RSW*ROC+ROC 10 G53J14=SNGL(RSW) RETURN END C G54 ******* FUNCTION G54J14(TDGC) DATA SNTMPA/1.50/ DATA ANM01R,ANM11R,ANM21R/-1137.32,1003.59,-178.182/ DATA ADN01R,ADN11R,ADN21R/-442.964,205.029,1.0/ DATA ANM02R,ANM12R,ANM22R/5.16911,-8.81122,3.69204/ DATA ADN02R,ADN12R,ADN22R/2.15396,-3.11189,1.0/ C PMPA=F30J14(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 VDDDMK=EXP(W) C WRITE(6,100) PMPA,VDDDMK C 100 FORMAT(1H ,F6.2,' MPA ',F9.3,' DM3/KG') G54J14=VDDDMK RETURN END C 54 ******* FUNCTION F54J14(TDGC) TK=TDGC+273.15 IF(TK.LT.199.7) GO TO 40 IF(TK.GT.353.1) GO TO 40 VDDDMK=G54J14(TDGC) C IF(VDDDMK.LT.1.0E-7) THEN VDCAL=-1.0E10 GO TO 30 END IF C RODD=1.0/VDDDMK VDCAL=F53J14(TDGC) IF(VDCAL.LT.1.0E-7) GO TO 30 RODCAL=1.0E-3/VDCAL ROC=0.5200 RODDBS=RODD*1.2 IF(RODDBS.GT.ROC) RODDBS=ROC RODDE=RODD*0.8 CALL S03J14(RODDBS,RODDE,RODCAL,TK,VM3K) F54J14=VM3K RETURN 30 IF(VDCAL.LT.-1.1E10) GO TO 40 F54J14=-1.0E10 RETURN 40 F54J14=-1.0E20 RETURN END C 55 ****** FUNCTION F55J14(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 VD=F53J14(TDGC) IF(VD.LT.-1.0E9) GO TO 20 VDD=F54J14(TDGC) IF(VDD.LT.-1.0E9) GO TO 10 V=(1.0-X)*VD+X*VDD F55J14=V RETURN 10 F55J14=VDD RETURN 20 F55J14=VD RETURN 30 F55J14=-1.0E20 RETURN END C 83 *************** FUNCTION F83J14(PBAR,TDGC) VM3K=F51J14(PBAR,TDGC) IF(VM3K.LT.1.0E-5) GO TO 50 IF(VM3K.LT.5.9E-4) GO TO 40 PMPA=0.1*PBAR WA=G10J14(VM3K,TDGC,PMPA) F83J14=WA RETURN 40 F83J14=-1.0E10 RETURN 50 F83J14=VM3K RETURN END C G10 ******* FUNCTION G10J14(VM3K,TDGC,PMPA) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G10J14,VM3K,TDGC,PMPA,CV,G04J14,CP,G03J14 C COMMON/R115A/A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, C & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 C DATA A01,A02,A03,A04,A05/2.3366423320D-02, 3.6254298340D+01, &-8.9222216730D+03, 3.7757690770D+06, 2.3826225750D+08 / DATA A06,A07,A08,A09,A10/4.1067070490D-01, -2.6810832280D+02, &5.8910342990D+04,-4.1131369640D-01, 1.8247777160D+02/ DATA A11,A12,A13,A14,A15/4.5099307060D-01, -2.8676585670D+02, &7.2142477090D+01, -1.1555632860D+07, 4.3630653440D+09/ DATA A16,A17,A18,A19,A20/-4.8300903530D+11, 1.7669793250D+07, &-1.9335704800D+10, 3.8905495630D+12,4.000000000D+00/ C C R115 CP 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 C R=8.31451D0/1.54480D2 C KJ/KMOL K KG/KMOLE C C BDP=(3.000D0*A04*T2I+4.000D0*A05*T3I+A02)*T2I BDM=2.000D0*A03*T3I CDP=-A07*T2I CDM=-2.000D0*A08*T3I DDM=-A10*T2I EDP=-A12*T2I FDM=-A13*T2I GDP=(-5.000D0*A16*T2I-3.000D0*A14)*T4I GDM=-4.000D0*A15*T5I HDP=-4.000D0*A18*T5I HDM=-(5.000D0*A19*T2I+3.000D0*A17)*T4I C SP=((EDP*RO2+CDP)*RO+BDP)*RO SM=(((FDM*RO2+DDM)*RO+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-A03*T2I BM=-((A05*TI+A04)*T2I+A02)*TI CP=A08*T2I+A06 CM=A07*TI DP=A10*TI DM=A09 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=G04J14(VM3K,TDGC) CP=G03J14(VM3K,TDGC,PMPA) WA2=CP/CV*DPDR*1.0E3 G10J14=SQRT(SNGL(WA2)) RETURN END C 56 ******* FUNCTION F56J14(PBAR,H) TSDGC=F40J14(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F60J14(TSDGC,H) F56J14=X RETURN 10 F56J14=TSDGC RETURN END C 57 ******* FUNCTION F57J14(PBAR,S) TSDGC=F40J14(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F61J14(TSDGC,S) F57J14=X RETURN 10 F57J14=TSDGC RETURN END C 58 ******* FUNCTION F58J14(PBAR,U) TSDGC=F40J14(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F62J14(TSDGC,U) F58J14=X RETURN 10 F58J14=TSDGC RETURN END C 59 ******* FUNCTION F59J14(PBAR,V) TSDGC=F40J14(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F63J14(TSDGC,V) F59J14=X RETURN 10 F59J14=TSDGC RETURN END C 60 ******* FUNCTION F60J14(TDGC,H) TK=TDGC+273.15 IF(TK.LT.200.0.OR.TK.GT.353.10) GO TO 10 HD=F27J14(TDGC) IF(HD.LT.-1.0E9) GO TO 30 IF(HD.GT.H) GO TO 10 HDD=F28J14(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 F60J14=1.0 RETURN 5 X=(H-HD)/(HDD-HD) F60J14=X RETURN 10 F60J14=-1.0E20 RETURN 20 F60J14=HDD RETURN 30 F60J14=HD RETURN END C 61 ******* FUNCTION F61J14(TDGC,S) TK=TDGC+273.15 IF(TK.LT.200.0.OR.TK.GT.353.10) GO TO 10 SD=F37J14(TDGC) IF(SD.LT.-1.0E9) GO TO 30 IF(SD.GT.S) GO TO 10 SDD=F38J14(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 F61J14=1.0 RETURN 5 X=(S-SD)/(SDD-SD) F61J14=X RETURN 10 F61J14=-1.0E20 RETURN 20 F61J14=SDD RETURN 30 F61J14=SD RETURN END C 62 ******* FUNCTION F62J14(TDGC,U) TK=TDGC+273.15 IF(TK.LT.200.0.OR.TK.GT.353.10) GO TO 10 UD=F46J14(TDGC) IF(UD.LT.-1.0E9) GO TO 30 IF(UD.GT.U) GO TO 10 UDD=F47J14(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 F62J14=1.0 RETURN 5 X=(U-UD)/(UDD-UD) F62J14=X RETURN 10 F62J14=-1.0E20 RETURN 20 F62J14=UDD RETURN 30 F62J14=UD RETURN END C 63 ******* FUNCTION F63J14(TDGC,V) TK=TDGC+273.15 IF(TK.LT.200.0.OR.TK.GT.353.10) GO TO 10 VD=F53J14(TDGC) IF(VD.LT.-1.0E9) GO TO 30 IF(VD.GT.V) GO TO 10 VDD=F54J14(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 F63J14=1.0 RETURN 5 X=(V-VD)/(VDD-VD) F63J14=X RETURN 10 F63J14=-1.0E20 RETURN 20 F63J14=VDD RETURN 30 F63J14=VD RETURN END C 64 ******* FUNCTION F64J14(PBAR0,H) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F64J14,TDGC,HW,TMAX,TMIN,HDP,HDDP,HX,H1,H2,TSP,VX,TWH REAL PBAR0,H,G02J14,F40J14,F51J14,TMAXT,VMINT,VMAXT REAL F53J14,F54J14,TLCK,TCC,VDP,VDDP,VDPMAX,VCM3K REAL TMXR,TMNR,G01J14 C DATA HC/3.1252D5/ DATA PCBAR,TCK,ROCKM3/3.1600D1,3.5310D2,6.135D2/ DATA VMINT,TMAXT,TLCK,VMAXT/0.6035E-3,472.5,199.8,806.3E-3/ C IF(PBAR0.LT.0.162.OR.PBAR0.GT.70.0) GO TO 40 IF(H.LT.1.315E5.OR.H.GT.4.552E5) GO TO 40 IF(ABS(PBAR0-31.600).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=SNGL(TCK)-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=F40J14(PBAR0) TSP=TDGC IF(TDGC.LT.-73.35) GO TO 40 C -73.35=199.8-273.15 VDP=F53J14(TDGC) HDP=G02J14(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=F53J14(TMAX) TSP=(TMAX+273.15-TLCK)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J14(TDGC) HDP=G02J14(VDP,TDGC) IF(HDP.LT.0.1) GO TO 6 IF(HDP.LT.H) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J14(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.VMINT) VX=VDP HX=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 71 HX=G02J14(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=F53J14(TLCK-273.15) HDP=G02J14(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=F51J14(PBAR0,TMIN) IF(VX.LT.VMINT.OR.VX.GT.VMAXT) THEN GO TO 81 END IF C C HX=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) THEN GO TO 81 END IF HX=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 82 IF(VX.GT.VMAXT) GO TO 82 HX=G02J14(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=F53J14(TDGC) HDP=G02J14(VDP,TDGC) IF(HDP.GT.H) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN HX=G02J14(VX,TDGC) ELSE HX=G02J14(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=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.0.995*VMINT) GO TO 711 HX=G02J14(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=F51J14(PBAR0,TDGC) HX=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 50 HX=G02J14(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=F54J14(TDGC) IF(VDDP.LT.VCM3K) GO TO 50 HDDP=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) THEN GO TO 134 END IF HX=G02J14(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=F51J14(PBAR0,TMIN) IF(VX.LT.VMINT) THEN TMIN=TLCK-273.15 VX=F51J14(PBAR0,TMIN) IF(VX.LT.VMINT) GO TO 40 END IF HX=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 131 H2=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 141 IF(VX.GT.VMAXT) GO TO 141 HX=G02J14(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=F51J14(PBAR0,TMIN) H1=G02J14(VX,TMIN) VX=F51J14(PBAR0,TMAX) H2=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 143 HX=G02J14(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=F40J14(PBAR0) IF(TDGC.LT.234.5-273.15) GO TO 50 VDDP=F54J14(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G02J14(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=F54J14(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G02J14(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=F51J14(PBAR0,TDGC) HX=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 264 HW=G02J14(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=F51J14(PBAR0,TDGC) HX=G02J14(VX,TDGC) IF(HX.GT.H) GO TO 40 C OUT OF RANGE H1=HX TDGC=TMAX VX=F51J14(PBAR0,TDGC) HX=G02J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 267 HW=G02J14(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=F51J14(PBAR0,TDGC) HW=G02J14(VX,TDGC) IF(ABS(HW/H-1.0).LT.1.0E-6) THEN PST=G01J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.0.49E-3) GO TO 282 TSP=G01J14(VX,TDGC) IF(TSP.LT.0.21) GO TO 282 HW=G02J14(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 F64J14=TDGC RETURN 31 F64J14=TMAX RETURN 32 F64J14=TMIN RETURN 40 F64J14=-1.0E20 RETURN 50 F64J14=-1.0E10 RETURN END C 65 ******* FUNCTION F65J14(PBAR0,S) C C G05(V,T)=S VAPOR G06(V,T)=S LIQUID C S.GT.SC S.LT.SC C CALL S08J14(PBAR0,S,VM3K,TDGC,H) F65J14=TDGC RETURN END C 70 ******* FUNCTION F70J14(PBAR,VM3K) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F70J14,PBAR,TDGC,VM3K,PW,TMAX,TMIN,VDP,VDDP,PX,P1,P2,TSP REAL G01J14,F40J14,F53J14,F54J14,F30J14,PST230,VCM3K REAL TDGCMX,TDGCMN C DATA PCBAR,TCK,ROCKM3/3.1600D1,3.5310D2,6.135D2/ C IF(PBAR.LT.0.162.OR.PBAR.GT.70.7) GO TO 40 IF(VM3K.LT.6.01E-4.OR.VM3K.GT.0.8143) GO TO 40 IF(ABS(PBAR-31.600).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=SNGL(TCK)-273.15 GO TO 30 C 5 IF(PBAR/PCBAR-1.0.GT.-1.0E-6) GO TO 6 TDGC=F40J14(PBAR) TSP=TDGC IF(TDGC.LT.-73.15) GO TO 40 C -73.15=200.0-273.15 C VDP=F53J14(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 PST230=F30J14(210.0-273.15) IF(PBAR/PST230-1.0.LT.-1.0E-6) GO TO 40 C CALL S05J14(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=210.0-273.15 TDGC=TMIN PX=G01J14(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 S05J14(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=210.0-273.15 TMAX=450.1-273.15 IF((TMAX.GT.TDGCMX) .OR. (TMIN.LT.TDGCMN)) THEN TMAX=TDGCMX TMIN=TDGCMN ENDIF PX=G01J14(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=353.10-273.15 TMAX=450.1-273.15 CALL S05J14(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=F54J14(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=450.1-273.15 CALL S05J14(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=G01J14(VM3K,TMIN) P2=G01J14(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=G01J14(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=G01J14(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=G01J14(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=G01J14(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=G01J14(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=G01J14(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=G01J14(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=G01J14(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=G01J14(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=G01J14(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=G01J14(VM3K,TMIN) EQIVZ=PBARW-PBAR G1=ABS(EQIVZ) Q2=TB*TMIN+TA*TMAX TKW=Q2 PBARW=G01J14(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=G01J14(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=G01J14(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 F70J14=TDGC RETURN 31 F70J14=TMAX RETURN 32 F70J14=TMIN RETURN 40 F70J14=-1.0E20 RETURN 50 F70J14=-1.0E10 RETURN END C S01 *************** SUBROUTINE S01J14(PSTBAR,VDR,VDCAL,TK) C DOUBLE PRECISION ROC,TC C COMMON/R115CR/PC,TC,ROC C BAR K KG/M3 DATA ROC,TC/0.6135,353.10/ C R115 KG/DM3 TA=1.0-TK/TC TB=0.04 RO1=(0.99-TB*TA)/VDR C IF(RO1.LT.ROC) THEN RO1=ROC TDGC=TK-273.15 DO 10 I=1,21 K=I VM3KW=1.0E-3/(RO1*((21-K)*0.01+1.0)) PBAR1=G01J14(VM3KW,TDGC) IF(PSTBAR.GT.PBAR1) GO TO 11 10 CONTINUE RODW=ROC GO TO 50 11 RO1=RO1*((21-K)*0.01+1.0) GO TO 14 END IF C RO1.LT.ROC IF-CLOUSE C C RO1.GT.ROC TDGC=TK-273.15 DRO=(RO1-ROC)/40.0 DO 12 I=1,41 K=I VM3KW=1.0E-3/(RO1-(K-1)*DRO) PBAR1=G01J14(VM3KW,TDGC) IF(PSTBAR.GT.PBAR1) GO TO 13 12 CONTINUE RODW=ROC GO TO 50 13 RO1=RO1/(K*0.01+1.0) C 14 RO2=1.15/VDR IF(RO2.LT.ROC) RO2=ROC TDGC=TK-273.15 DO 20 I=1,41 K=I VM3KW=1.0E-3/(RO2*((K-1)*0.01+1.0)) PBAR2=G01J14(VM3KW,TDGC) IF(PSTBAR.LT.PBAR2) GO TO 21 20 CONTINUE 21 RO2=RO2*(K*0.01+1.0) C EPS=5.0E-7 VM3KW=1.0E-3/RO1 PBAR1=G01J14(VM3KW,TDGC) VM3KW=1.0E-3/RO2 PBAR2=G01J14(VM3KW,TDGC) C TA=0.618034 TB=1.0-TA C Q1=TA*RO1+TB*RO2 ROD=Q1 VM3KW=1.0E-3/ROD PBARW=G01J14(VM3KW,TDGC) EQIVZ=PSTBAR-PBARW G1=ABS(EQIVZ) Q2=TB*RO1+TA*RO2 ROD=Q2 VM3KW=1.0E-3/ROD PBARW=G01J14(VM3KW,TDGC) EQIVZ=PSTBAR-PBARW G2=ABS(EQIVZ) C IC=0 8 W=ABS(RO2-RO1) IC=IC+1 IF(IC.GT.100) THEN VDCAL=-1.0E10 RETURN END IF C 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=G01J14(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=G01J14(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 S02 ********* SUBROUTINE S02J14(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 C COMMON/R115A/A01,A02,A03,A04,A05,A06,A07,A08,A09,A10, C & A11,A12,A13,A14,A15,A16,A17,A18,A19,A20 C DATA A01,A02,A03,A04,A05/2.3366423320D-02, 3.6254298340D+01, &-8.9222216730D+03, 3.7757690770D+06, 2.3826225750D+08 / DATA A06,A07,A08,A09,A10/4.1067070490D-01, -2.6810832280D+02, &5.8910342990D+04,-4.1131369640D-01, 1.8247777160D+02/ DATA A11,A12,A13,A14,A15/4.5099307060D-01, -2.8676585670D+02, &7.2142477090D+01, -1.1555632860D+07, 4.3630653440D+09/ DATA A16,A17,A18,A19,A20/-4.8300903530D+11, 1.7669793250D+07, &-1.9335704800D+10, 3.8905495630D+12,4.000000000D+00/ C T=DBLE(TK) TI=1.000D0/T T2I=TI*TI T3I=T2I*TI T4I=T2I*T2I C R=8.31451D0/1.54480D2 C KJ/KMOL K KG/KMOLE C BP=A01-A03*T2I BM=-((A05*TI+A04)*T2I+A02)*TI CP=A08*T2I+A06 CM=A07*TI DP=A10*TI DM=A09 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)/ &(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 C WRITE(6,100) T,R,TRLRO,UPD,UMD,UPDD,UMDD,VP,VM,VE1,VE2, C & GP,GM,HP,HM,EQIV C 100 FORMAT(1H ,'T=',F7.1,' R=',F7.4,' TRLRO=',D12.4,/1H , C &'UPD,UMD=',2D12.4,'UPDD,UMDD=',2D12.4,' VP,VM=',2D12.4, C &/1H ,' VE1,VE2=',2D12.4,' GP,GM,HP,HM=',4D12.4, C &/1H ,' EQIV=',E12.4) C WRITE(*,*) 'KEY IN SOME V.' C READ(*,*) IIW RETURN END C SUBROUTINE S03J14(RODDBS,RODDE,ROD,TK,VM3K) DRO=(RODDE-RODDBS)/20 RODDW=RODDBS CALL S02J14(RODDW,ROD,TK,EQIVM) TDGC=TK-273.15 VM3KW=1.0E-3/RODDW PBARW=G01J14(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=G01J14(VM3KW,TDGC) VDR=1.0/ROD CALL S01J14(PBARW,VDR,VDCAL,TK) ROD=1.0/VDCAL CALL S02J14(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=G01J14(VM3KW,TDGC) VDR=1.0/ROD CALL S01J14(PBARW,VDR,VDCAL,TK) ROD=1.0/VDCAL CALL S02J14(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=G01J14(VM3KW,TDGC) VDR=1.0/ROD CALL S01J14(PBARW,VDR,VDCAL,TK) ROD=1.0/VDCAL CALL S02J14(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=G01J14(VM3KW,TDGC) VDR=1.0/ROD CALL S01J14(PBARW,VDR,VDCAL,TK) ROD=1.0/VDCAL CALL S02J14(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=G01J14(VM3KW,TDGC) VDR=1.0/ROD CALL S01J14(PBARW,VDR,VDCAL,TK) ROD=1.0/VDCAL CALL S02J14(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 SUBROUTINE S04J14(PBAR,TDGC,VMAX,VMIN) C DATA VMINL,VMINT,VMAXT/0.6035E-3,0.6074E-3,806.20E-3/ DATA VMINL,VMAXT/0.6074E-3,806.20E-3/ DATA PCBAR/31.600/ IF(PBAR.GT.PCBAR) THEN VMAXU=VMAXT VMINU=VMINL GO TO 5 END IF C PST=F30J14(TDGC) IF(ABS(PST/PBAR-1.0).GT.1.1E-6) GO TO 2 VMIN=1.0/G53J14(TDGC+273.15) VMAX=VMIN RETURN C 2 IF(PBAR.GT.PST) GO TO 3 VMINU=G54J14(TDGC)*1.0E-3 VMAXU=VMAXT GO TO 5 C 3 VMAXU=1.0/G53J14(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=G01J14(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 S05 SUBROUTINE S05J14(PBAR,VM3K,TDGCMX,TDGCMN) DATA TMINT,TMAXT,TC,PC,ROC/210.0,472.0,353.10,31.600,6.135E2/ VC=1.0/ROC PWC=G01J14(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=F53J14(TKW-273.15) ELSE VM3KW=F54J14(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=F53J14(TKW-273.15) ELSE VM3KW=F54J14(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=F53J14(TKW-273.15) ELSE VM3KW=F54J14(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=F53J14(TKW-273.15) ELSE VM3KW=F54J14(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=G01J14(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=G01J14(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=G01J14(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 S08 SUBROUTINE S08J14(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,G05J14,F40J14,F51J14,TMAXT,VMINT,VMAXT REAL F53J14,F54J14,TLCK,TCC,VDP,VDDP,VDPMAX,VCM3K REAL F37J14,VM3K,TEMPC,H,G02J14,G01J14 C DATA SC/1.34515D3/ DATA PCBAR,TCK,ROCKM3/3.1600D1,3.5310D2,6.135D2/ DATA VMINT,TMAXT,TLCK,VMAXT/0.6035E-3,472.5,199.8,806.30E-3/ C IF(PBAR0.LT.0.162.OR.PBAR0.GT.70.0) GO TO 40 IF(S.LT.0.7102E3.OR.S.GT.1.964E3) GO TO 40 IF(ABS(PBAR0-31.600).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=SNGL(TCK)-273.15 VX=1.0/SNGL(ROCKM3) 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=F40J14(PBAR0) TSP=TDGC IF(TDGC.LT.-73.35) GO TO 40 C -73.35=199.8-273.15 C SDP=F37J14(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=F53J14(TMAX) TSP=(TMAX+273.15-TLCK)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J14(TDGC) SDP=G05J14(VDP,TDGC) IF(SDP.LT.0.001) GO TO 6 IF(SDP.LT.S) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J14(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.VMINT) VX=VDP SX=G05J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 71 SX=G05J14(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=F53J14(TLCK-273.15) SDP=G05J14(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=F51J14(PBAR0,TMIN) IF(VX.LT.VMINT.OR.VX.GT.VMAXT) THEN GO TO 717 END IF C C SX=G05J14(VX,TMIN) C**************** C IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 C TDGC=SNGL(TCK)-273.15 VX=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) THEN GO TO 717 END IF SX=G05J14(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=F53J14(TDGC) SDP=G05J14(VDP,TDGC) IF(SDP.GT.S) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN SX=G05J14(VX,TDGC) ELSE SX=G05J14(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=G05J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.0.995*VMINT) GO TO 711 SX=G05J14(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=F51J14(PBAR0,TDGC) SX=G05J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 50 SX=G05J14(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=F54J14(TDGC) IF(VDDP.LT.VCM3K) GO TO 50 SDDP=G05J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 134 SX=G05J14(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=F51J14(PBAR0,TMIN) IF(VX.LT.VMINT) THEN TMIN=TLCK-273.15 VX=F51J14(PBAR0,TMIN) IF(VX.LT.VMINT) GO TO 40 END IF SX=G05J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 131 S2=G05J14(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=F51J14(PBAR0,TMIN) S1=G05J14(VX,TMIN) VX=F51J14(PBAR0,TMAX) S2=G05J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 143 SX=G05J14(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=F40J14(PBAR0) IF(TDGC.LT.234.5-273.15) GO TO 50 VDDP=F54J14(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G05J14(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=F54J14(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G05J14(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=F51J14(PBAR0,TDGC) SX=G05J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 264 SW=G05J14(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=F51J14(PBAR0,TDGC) SX=G05J14(VX,TDGC) IF(SX.GT.S) GO TO 40 C OUT OF RANGE S1=SX TDGC=TMAX VX=F51J14(PBAR0,TDGC) SX=G05J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 267 SW=G05J14(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=F51J14(PBAR0,TDGC) SW=G05J14(VX,TDGC) IF(ABS(SW/S-1.0).LT.1.0E-6) THEN PST=G01J14(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=F51J14(PBAR0,TDGC) IF(VX.LT.0.49E-3) GO TO 282 TSP=G01J14(VX,TDGC) IF(TSP.LT.0.21) GO TO 282 SW=G05J14(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=F51J14(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=G02J14(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 *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE S99J08(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR R 113 ****' 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