C ********** VER. 11.1.********* C ********** R 152A ********* 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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(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 S99J16(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT REAL FUNCTION AIPPT(P,T) CHARACTER FUN*6 DATA FUN/'AIPPT'/ CALL S99J16(FUN) AIPPT=-1.0E+30 RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 DATA FUN/'AJTPT'/ CALL S99J16(FUN) AJTPT=-1.0E+30 RETURN END C------------------------------------------------- F82 = AKPT REAL FUNCTION AKPT(P,T) CHARACTER FUN*6 DATA FUN/'AKPT'/ CALL S99J16(FUN) AKPT=-1.0E+30 RETURN END C------------------------------------------------- F2 = ALAPP REAL FUNCTION ALAPP(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, FUN/'ALAPP'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F2J16(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF 2000 CONTINUE C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALAPP=FF RETURN END C------------------------------------------------- F3 = ALAPT REAL FUNCTION ALAPT(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, FUN/'ALAPT'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F3J16(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALAPT=FF RETURN END C------------------------------------------------- F4 = ALHP REAL FUNCTION ALHP(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, 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 = F4J16(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 152A'/, 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 = F5J16(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 152A'/, 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 = F6J16(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMPD=FF RETURN END C------------------------------------------------- F7 = ALMPDD REAL FUNCTION ALMPDD(P) CHARACTER FUN*6 DATA FUN/'ALMPDD'/ CALL S99J16(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 152A'/, 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 = F8J16(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 152A'/, 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 = F9J16(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- ALMTD=FF RETURN END C------------------------------------------------- F10 = ALMTDD REAL FUNCTION ALMTDD(T) CHARACTER FUN*6 DATA FUN/'ALMTDD'/ CALL S99J16(FUN) ALMTDD=-1.0E+30 RETURN END C------------------------------------------------- F11 = AMUPD REAL FUNCTION AMUPD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, 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 = F11J16(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- AMUPD=FF RETURN END C------------------------------------------------- F12 = AMUPDD REAL FUNCTION AMUPDD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, 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 = F12J16(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 152A'/, 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 = F13J16(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 152A'/, 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 = F14J16(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 152A'/, 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 = F15J16(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 S99J16(FUN) BPPT=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 DATA FUN/'BSPT'/ CALL S99J16(FUN) BSPT=-1.0E+30 RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 DATA FUN/'BTPT'/ CALL S99J16(FUN) BTPT=-1.0E+30 RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 DATA FUN/'BVPT'/ CALL S99J16(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 152A'/, 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 = F16J16(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 152A'/, 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 = F17J16(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 152A'/, 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 = F18J16(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 152A'/, 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 = F19J16(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 152A'/, 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 = F20J16(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- CPTDD=FF RETURN END C------------------------------------------------- F21 = CRP REAL FUNCTION CRP(A) CHARACTER FUN*6,FLUID*16,A*1 REAL T0K,PBAR,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, 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 = F21J16(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 DATA FUN/'CVPDD'/ CALL S99J16(FUN) CVPDD=-1.0E+30 RETURN END C------------------------------------------------- F77 = CVPT REAL FUNCTION CVPT(P,T) CHARACTER FUN*6 DATA FUN/'CVPT'/ CALL S99J16(FUN) CVPT=-1.0E+30 RETURN END C------------------------------------------------- F78 = CVTDD REAL FUNCTION CVTDD(T) CHARACTER FUN*6 DATA FUN/'CVTDD'/ CALL S99J16(FUN) CVTDD=-1.0E+30 RETURN END C------------------------------------------------- F22 = EPSPT REAL FUNCTION EPSPT(P,T) CHARACTER FUN*6 DATA FUN/'EPSPT'/ CALL S99J16(FUN) EPSPT=-1.0E+30 RETURN END C------------------------------------------------- F89 = FC C************************************************ C FUNCTION FOR FUNDDAMENTAL CONSTANTS C PROPATH VER.10.1, MAY 8, 1996 C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='66.050' WHEN A='M' C B='125.882' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS FC=F89J16(A) IF(FC.LT.-1.E+19) THEN IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR REFRIGERANT 152A 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 S99J16(FUN) GAMPDD=-1.0E+30 RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 DATA FUN/'GAMPT'/ CALL S99J16(FUN) GAMPT=-1.0E+30 RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 DATA FUN/'GAMTDD'/ CALL S99J16(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 152A'/, 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 = F23J16(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 152A'/, 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 = F24J16(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 152A'/, 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 = F71J16(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 152A'/, 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 = F25J16(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 152A'/, 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 = F26J16(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 152A'/, 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 = F27J16(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 152A'/, 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 = F28J16(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 152A'/, 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 = F29J16(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-152A(R152A)' WHEN A='S' C B='C2H4F2' 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-152A(R152A)' ELSE IF (A.EQ.'C') THEN IDENTF='C2H4F2' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR CFC-152A(R152A) 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 S99J16(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT REAL FUNCTION PMLT(T) CHARACTER FUN*6 DATA FUN/'PMLT'/ CALL S99J16(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 152A'/, 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 = F85J16(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- PRPD=FF RETURN END C------------------------------------------------- F86 = PRPDD REAL FUNCTION PRPDD(P) CHARACTER FUN*6 DATA FUN/'PRPDD'/ CALL S99J16(FUN) PRPDD=-1.0E+30 RETURN END C------------------------------------------------- F81 = PRPT FUNCTION PRPT(P,T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,PBAR,P,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, FUN/'PRPT'/ C--- SET OF UNIT --- IF(KPA.EQ.1) THEN PBAR=1.0 T0K=0.0 ELSE IF(KPA.EQ.2) THEN PBAR=1.0 T0K=273.15 ELSE IF(KPA.EQ.3) THEN PBAR=1.0E-05 T0K=0.0 ELSE PBAR=1.0E-05 T0K=273.15 END IF PI=P*PBAR TI=T-T0K C--- FUNCTION CALL --- FF = F81J16(PI,TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' AND T=',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- PRPT=FF RETURN END C------------------------------------------------- F87 = PRTD REAL FUNCTION PRTD(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, 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 = F87J16(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 S99J16(FUN) PRTDD=-1.0E+30 RETURN END C------------------------------------------------- F99 = PSBT REAL FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99J16(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 152A'/, 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 = F30J16(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 S99J16(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD REAL FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99J16(FUN) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F31 = SIGP REAL FUNCTION SIGP(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, FUN/'SIGP'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.2)) THEN PBAR=1.0 ELSE PBAR=1.0E-05 END IF PI=P*PBAR C--- FUNCTION CALL --- FF = F31J16(PI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN P =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- SIGP=FF RETURN END C------------------------------------------------- F32 = SIGT REAL FUNCTION SIGT(T) CHARACTER FUN*6,FLUID*16,MSG*125 REAL T0K,T,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, FUN/'SIGT'/ C--- SET OF UNIT --- IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF TI=T-T0K C--- FUNCTION CALL --- FF = F32J16(TI) C--- LEVEL 1 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+10) THEN MSG='**** NO CONVERGENCE AT '//FUN//' FOR ' & //FLUID//' ****' WRITE(6,*) MSG FF=-1.0E+10 C--- LEVEL 2 ERROR CHECK & MESSAGE --- ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,FLUID,T 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A, & ' WHEN T =',1PE14.7,' ****') FF=-1.0E+20 END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION --- SIGT=FF RETURN END C------------------------------------------------- F33 = SPD REAL FUNCTION SPD(P) CHARACTER FUN*6,FLUID*16,MSG*125 REAL PBAR,P,FF INTEGER KPA COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FLUID/'R 152A'/, 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 = F33J16(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 152A'/, 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 = F34J16(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 152A'/, 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 = F35J16(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 152A'/, 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 = F36J16(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 152A'/, 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 = F37J16(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 152A'/, 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 = F38J16(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 152A'/, 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 = F39J16(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 S99J16(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP REAL FUNCTION TMLP(P) CHARACTER FUN*6 DATA FUN/'TMLP'/ CALL S99J16(FUN) TMLP=-1.0E+30 RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 DATA FUN/'TPSEUP'/ CALL S99J16(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 152A'/, 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 = F64J16(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 152A'/, 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 = F65J16(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 152A'/, 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 = F70J16(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 S99J16(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 152A'/, 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 = F40J16(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 152A'/, 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 S99J16(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD REAL FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99J16(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 152A'/, 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 = F42J16(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 152A'/, 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 = F43J16(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 152A'/, 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 = F79J16(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 152A'/, 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 = F44J16(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 152A'/, 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 = F45J16(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 152A'/, 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 = F46J16(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 152A'/, 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 = F47J16(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 152A'/, 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 = F48J16(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 152A'/, 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 = F49J16(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 152A'/, 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 = F50J16(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 152A'/, 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 = F80J16(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 152A'/, 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 = F51J16(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 152A'/, 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 = F52J16(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 152A'/, 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 = F53J16(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 152A'/, 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 = F54J16(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 152A'/, 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 = F55J16(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 DATA FUN/'WPT'/ CALL S99J16(FUN) WPT=-1.0E+30 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 152A'/, 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 = F56J16(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 152A'/, 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 = F57J16(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 152A'/, 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 = F58J16(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 152A'/, 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 = F59J16(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 152A'/, 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 = F60J16(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 152A'/, 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 = F61J16(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 152A'/, 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 = F62J16(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 152A'/, 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 = F63J16(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 S99J16(FUN) CHARACTER FUN*6,MSG*125 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF (MESS.NE.0) THEN MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR R 152A****' WRITE(6,100) MSG 100 FORMAT(1H ,5X,A) ENDIF RETURN END C ********** R 152A ********* C ********** VER. 10.1. ********* C ********** R 152A ********* C C G01 ****** FUNCTION G01J16(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J16,VM3K,TDGC C DATA R,A2,B2,A3,B3/0.83141215500D-2,-0.24925950000D1, 1 0.44688403331D-2,0.35045885700D0,-0.78740966670D-3/ C DATA WMOL/66.050D0/ C KG/KMOL C TK=TDGC+273.15 VLMOL=VM3K*WMOL PMPA=(R*TK+((A2+B2*TK)+(A3+B3*TK)/VLMOL)/VLMOL)/VLMOL G01J16=PMPA*1.0D1 RETURN END C G02 ****** FUNCTION G02J16(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G02J16,VM3K,TDGC,J C DATA R,A2,B2,A3,B3/0.83141215500D-2,-0.24925950000D1, 1 0.44688403331D-2,0.35045885700D0,-0.78740966670D-3/ C DATA WMOL,J/66.050D0,1000.0D0/ C KG/KMOL DATA G2,G3,G4,G6/0.3616072883D0,-0.1114680668D-2, 1 0.2606119688D-5,-0.2235961702D-8/ C DATA X/22685.59D0/ C TK=TDGC+273.15 TK2=TK*TK TK4=TK2*TK2 VLMOL=VM3K*WMOL PMPA=(R*TK+((A2+B2*TK)+(A3+B3*TK)/VLMOL)/VLMOL)/VLMOL C HW=(A2+A3/(2*VLMOL))/VLMOL H=J*(PMPA*VLMOL+HW)+(G2/2+G3*TK/3)*TK2+(G4/4+G6*TK/5)*TK4+X G02J16=1.0E3*H/WMOL RETURN END C G03 ******* FUNCTION G03J16(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G03J16,TDGC,J,VD,VDD,G02J16,F54J16,F53J16,F30J16 C DATA J/1000.0D0/ DATA A2/-0.11409500000D4/ C TK=TDGC+273.15 TK2=TK*TK DPDT=F30J16(TDGC)*1.0D-1*DLOG(10.0D0)*(-A2/TK2) C VDD=F54J16(TDGC) VD=F53J16(TDGC) HDD=1.0E-3*G02J16(VDD,TDGC) C HD=HDD-J*TK*DPDT*(VDD-VD) G03J16=1.0E3*HD RETURN END C G05 ****************** FUNCTION G05J16(VM3K,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G05J16,VM3K,TDGC,J C DATA R,B2,B3/0.83141215500D-2,0.44688403331D-2,-0.78740966670D-3/ C DATA WMOL,J/66.050D0,1000.0D0/ C KG/KMOL DATA G2,G3,G4,G6/0.3616072883D0,-0.1114680668D-2, 1 0.2606119688D-5,-0.2235961702D-8/ C DATA Y/51.36177D0/ C TK=TDGC+273.15 TK2=TK*TK TK4=TK2*TK2 VLMOL=VM3K*WMOL C SW=J*(R*DLOG(VLMOL)-(B2+B3/(2*VLMOL))/VLMOL) S=SW+(G2+G3*TK/2)*TK+(G4*TK/3+G6*TK2/4)*TK2+Y G05J16=1.0E3*S/WMOL RETURN END C G06 ****************** FUNCTION G06J16(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G06J16,TDGC,J,VD,VDD,G05J16,F54J16,F53J16,F30J16 C DATA J/1000.0D0/ DATA A2/-0.11409500000D4/ C TK=TDGC+273.15 TK2=TK*TK DPDT=F30J16(TDGC)*1.0D-1*DLOG(10.0D0)*(-A2/TK2) C VDD=F54J16(TDGC) VD=F53J16(TDGC) SDD=1.0E-3*G05J16(VDD,TDGC) C SD=SDD-J*DPDT*(VDD-VD) G06J16=1.0E3*SD RETURN END C 2 ****** FUNCTION F2J16(PBAR) IF(ABS(PBAR-44.95).GT.0.004) GO TO 10 A=0.0 GO TO 30 10 W=F40J16(PBAR) TK=W+273.15 A=F3J16(W) GO TO 30 20 A=-1.0E20 30 F2J16=A RETURN END C 3 ****** FUNCTION F3J16(TDGC) DOUBLE PRECISION A,G0,SIGMA,RD,RDD DATA G0/9.80665D0/ TK=TDGC+273.15 IF(ABS(TK-386.65).LT.0.02) GO TO 10 IF(TK.LT.173.1.OR.TK.GT.268.1) GO TO 20 W=F53J16(TDGC) IF(W.LT.1.0E-5) GO TO 30 RD=1.0D0/DBLE(W) W=F54J16(TDGC) IF(W.LT.1.0E-5) GO TO 30 RDD=1.0D0/DBLE(W) W=G11J16(TK) IF(W.LT.0.0) GO TO 30 SIGMA=DBLE(W) A=RD-RDD IF(DABS(A).LT.1.0D-2) GO TO 10 A=DSQRT(SIGMA/(G0*A)) GO TO 40 10 A=0.0D0 GO TO 40 20 A=-1.0D20 GO TO 40 30 A=DBLE(W) 40 F3J16=A RETURN END C 4 ****** FUNCTION F4J16(PBAR) ALH=F24J16(PBAR) IF(ALH.LT.-1.0E9) GO TO 10 HD=F23J16(PBAR) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F4J16=ALH RETURN 20 F4J16=HD RETURN END C 5 ****** FUNCTION F5J16(TDGC) ALH=F28J16(TDGC) IF(ALH.LT.-1.0E9) GO TO 10 HD=F27J16(TDGC) IF(HD.LT.-1.0E9) GO TO 20 ALH=ALH-HD 10 F5J16=ALH RETURN 20 F5J16=HD RETURN END C 6 ******* FUNCTION F6J16(PBAR) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 ALMPD=F9J16(TDGC) F6J16=ALMPD RETURN 10 F6J16=TDGC RETURN 20 F6J16=-1.0E20 RETURN END C 8 ******* FUNCTION F8J16(PBAR,TDGC) PDUMMY=PBAR C PDUMMY=1.01325 TK=TDGC+273.15 IF(TK.GE.273.0.AND.TK.LE.473.0) GO TO 10 F8J16=-1.0E20 RETURN 10 ALMPT=G23J16(TK) F8J16=ALMPT RETURN END C G23 *********** FUNCTION G23J16(T) C R152A 1ATM GAS THERM.COND (W/M K) G23J16=SQRT(T)/((0.33212E8/T+0.22507E6)/T+0.74557E2) RETURN END C 9 ******* FUNCTION F9J16(TDGC) C LAMBDA (SAT. LIQ.) IF(TDGC.GE.-70.0.AND.TDGC.LE.70.0) GO TO 10 F9J16=-1.0E20 RETURN 10 ALMTD=G21J16(TDGC) F9J16=ALMTD RETURN END C G21 ****** FUNCTION G21J16(T) C R152A SAT. LIQ THERM.COND (W/M K) G21J16=0.11643+((-0.20743E-8*T+0.20050E-7)*T-0.48343E-3)*T RETURN END C 11 ******* FUNCTION F11J16(PBAR) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.E9) GO TO 10 AMUPD=F14J16(TDGC) F11J16=AMUPD RETURN 10 F11J16=TDGC RETURN END C 12 ******* FUNCTION F12J16(PBAR) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.E9) GO TO 10 AMUPDD=F15J16(TDGC) F12J16=AMUPDD RETURN 10 F12J16=TDGC RETURN END C 13 ******* FUNCTION F13J16(PBAR,TDGC) PDUMMY=PBAR C PDUMMY=1.01325 TK=TDGC+273.15 IF(TK.GE.248.0.AND.TK.LE.423.0) GO TO 10 F13J16=-1.0E20 RETURN 10 F13J16=G33J16(TK) RETURN END C G33 ************* FUNCTION G33J16(T) C R152A 1ATM GAS VISCOSITY (PA S) W=SQRT(T)/((-0.35312E5/T+0.48474E3)/T+0.44674) G33J16=1.0E-6*W RETURN END C 14 ******* FUNCTION F14J16(TDGC) TK=TDGC+273.15 IF(TK.GE.203.0.AND.TK.LE.303.0) GO TO 10 F14J16=-1.0E20 RETURN 10 AMUTD=G31J16(TK) F14J16=AMUTD RETURN END C G31 ****** FUNCTION G31J16(T) C R152A SAT. LIQ VISCOSITY (PA S) W=0.26120E1+0.75588E3/T W=EXP(W) G31J16=1.0E-6*W RETURN END C 15 ******* FUNCTION F15J16(TDGC) IF(TDGC.GE.-20.0.AND.TDGC.LE.60.0) GO TO 10 F15J16=-1.0E20 RETURN 10 AMUTDD=G32J16(TDGC) F15J16=AMUTDD RETURN END C G32 ****** FUNCTION G32J16(T) C R152A SAT VAP. VISCOSITY (PA S) W=0.93605E1+((0.10710E-5*T+0.26874E-4)*T+0.29061E-1)*T G32J16=1.0E-6*W RETURN END C 16 ****** FUNCTION F16J16(PBAR) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPD=F19J16(TDGC) F16J16=CPD RETURN 10 F16J16=TDGC RETURN END C 17 ****** FUNCTION F17J16(PBAR) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 CPDD=F20J16(TDGC) F17J16=CPDD RETURN 10 F17J16=TDGC RETURN END C 18 ******* FUNCTION F18J16(PBAR,TDGC) PDUMMY=PBAR C PDUMMY=1.01325 IF(TDGC.GE.-25.0.AND.TDGC.LE.200.0) GO TO 10 F18J16=-1.0E20 RETURN 10 CP=G43J16(TDGC) F18J16=CP RETURN END C G43 *********** FUNCTION G43J16(T) C R152A 1ATM GAS CP (J/kgK) W=0.98984+((-0.14380E-7*T+0.34338E-5)*T+0.20892E-2)*T G43J16=1.0E3*W RETURN END C 19 ******* FUNCTION F19J16(TDGC) C C CP SAT. LIQUID(TEMP) C IF(TDGC.GE.-70.0.AND.TDGC.LE.70.0) GO TO 10 F19J16=-1.0E20 RETURN 10 CPD=G41J16(TDGC) F19J16=CPD RETURN END C G41 ****** FUNCTION G41J16(T) C R152A SAT. LIQ CP(J/kgK) W=0.14380E1+((0.11459E-6*T+0.25992E-4)*T+0.88101E-2)*T G41J16=1.0E3*W RETURN END C 20 ******* FUNCTION F20J16(TDGC) C C CP SAT.VAPOR(TEMP) C IF(TDGC.GE.-60.0.AND.TDGC.LE.40.0) GO TO 10 F20J16=-1.0E20 RETURN 10 CPDD=G42J16(TDGC) F20J16=CPDD RETURN END C G42 ****** FUNCTION G42J16(T) C R152A SAT. VAP CP(J/kgK) W=0.10173E1+((0.54191E-7*T+0.23012E-4)*T+0.37921E-2)*T G42J16=1.0E3*W RETURN END C 21 ******** FUNCTION F21J16(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 F21J16=44.95 RETURN 20 F21J16=113.50 RETURN 30 F21J16=2.7397E-3 RETURN 40 F21J16=0.4679E6 RETURN 50 F21J16=1.7970E3 RETURN 60 F21J16=-1.0E+30 RETURN END C 89 ******** FUNCTION F89J16(C) CHARACTER C IF(C.EQ.'M') GO TO 10 IF(C.EQ.'R') GO TO 20 GO TO 60 10 F89J16=66.050 RETURN 20 F89J16=125.882 RETURN 60 F89J16=-1.0E+30 RETURN END C 23 ****** FUNCTION F23J16(PBAR) TSDGC=F40J16(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F27J16(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F23J16=H RETURN 15 F23J16=TSDGC RETURN 16 F23J16=H RETURN END C 24 ****** FUNCTION F24J16(PBAR) TSDGC=F40J16(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 15 H=F28J16(TSDGC) IF(H.LT.-1.0E9) GO TO 16 F24J16=H RETURN 15 F24J16=TSDGC RETURN 16 F24J16=H RETURN END C 71 ******* FUNCTION F71J16(PBAR,S) C C H(P,S) C CALL S08J16(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.386.65) GO TO 10 PSAT=F30J16(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 10 STDD=F38J16(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 10 STD=F37J16(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=F28J16(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 HTD=F27J16(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 H=HTD*(1.0-X)+HTDD*X 10 F71J16=H RETURN 11 F71J16=PSAT RETURN 12 F71J16=STDD RETURN 13 F71J16=STD RETURN 14 F71J16=HTDD RETURN 15 F71J16=HTD RETURN 20 F71J16=TDGC RETURN 30 F71J16=-1.0E20 RETURN END C 25 ****** FUNCTION F25J16(PBAR,TDGC) VM3K=F51J16(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-386.65.GT.-273.15) GO TO 10 VTD=F53J16(TDGC) IF((VM3K-VTD)/2.7397E-3.GT.1.0E-5) GO TO 10 H=G02J16(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J16=H RETURN 10 H=G02J16(VM3K,TDGC) IF(H.LT.-1.0E9) GO TO 16 F25J16=H RETURN 15 F25J16=VM3K RETURN 16 F25J16=H RETURN 20 F25J16=-1.0E20 RETURN END C 26 ******* FUNCTION F26J16(PBAR,X) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 H=F29J16(TDGC,X) F26J16=H RETURN 10 F26J16=TDGC RETURN END C 27 ****** FUNCTION F27J16(TDGC) C C HDT SAT. LIQUID(TEMP) C VDM3K=F53J16(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.8.7E-4) GO TO 20 HD=G03J16(TDGC) F27J16=HD RETURN 10 F27J16=VDM3K RETURN 20 F27J16=-1.0E10 RETURN END C 28 ****** FUNCTION F28J16(TDGC) C C HDDT SAT. VAPOUR(TEMP) C VDM3K=F54J16(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.6.6E-3) GO TO 20 HDD=G02J16(VDM3K,TDGC) F28J16=HDD RETURN 10 F28J16=VDM3K RETURN 20 F28J16=-1.0E10 RETURN END C 29 ****** FUNCTION F29J16(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 HTD=F27J16(TDGC) IF(HTD.LT.-1.0E9) GO TO 20 HTDD=F28J16(TDGC) IF(HTDD.LT.-1.0E9) GO TO 10 F29J16=(1.0-X)*HTD+X*HTDD RETURN 10 F29J16=HTDD RETURN 20 F29J16=HTD RETURN 30 F29J16=-1.0E20 RETURN END C 85 ****** FUNCTION F85J16(PBAR) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 F85J16=F87J16(TDGC) RETURN 10 F85J16=TDGC RETURN END C 81 ****** FUNCTION F81J16(PBAR,TDGC) AMUPT=F13J16(PBAR,TDGC) IF(AMUPT.LT.0.0) GO TO 10 CPPT=F18J16(PBAR,TDGC) IF(CPPT.LT.0.0) GO TO 20 ALMPT=F8J16(PBAR,TDGC) IF(ALMPT.LT.0.0) GO TO 30 F81J16=AMUPT*CPPT/ALMPT RETURN 10 F81J16=AMUPT RETURN 20 F81J16=CPPT RETURN 30 F81J16=ALMPT RETURN END C 87 ****** FUNCTION F87J16(TDGC) AMUTD=F14J16(TDGC) IF(AMUTD.LT.0.0) GO TO 10 CPTD=F19J16(TDGC) IF(CPTD.LT.0.0) GO TO 20 ALMTD=F9J16(TDGC) IF(ALMTD.LT.0.0) GO TO 30 F87J16=AMUTD*CPTD/ALMTD RETURN 10 F87J16=AMUTD RETURN 20 F87J16=CPTD RETURN 30 F87J16=ALMTD RETURN END C 30 ****** FUNCTION F30J16(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F30J16,TDGC C IF(TDGC.LT.-100.5.OR.TDGC.GT.98.5) GO TO 10 C AA1=0.36034174691D1 AA2=-0.11409500000D4 TK=DBLE(TDGC)+273.15D0 AL10PS=AA1+AA2/TK F30J16=10.0D0**(AL10PS)*1.0D1 C MPA BAR RETURN 10 F30J16=-1.0E20 RETURN END C 31 ******* FUNCTION F31J16(PBAR) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 SIGMA=F32J16(TDGC) F31J16=SIGMA RETURN 10 F31J16=TDGC RETURN END C 32 ******* FUNCTION F32J16(TDGC) TK=TDGC+273.15 IF(TK.LT.153.0.OR.TK.GT.268.01) GO TO 10 SIGMA=G11J16(TK) F32J16=SIGMA RETURN 10 F32J16=-1.0E20 RETURN END C G11 ****** FUNCTION G11J16(T) C R152A SAT SURFACE TENSION (N/m) W=54.075*(1.0-T/386.65)**1.1480 G11J16=1.0E-3*W RETURN END C 33 ****** FUNCTION F33J16(PBAR) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F37J16(TDGC) IF(S.LT.-1.0E9) GO TO 16 F33J16=S RETURN 15 F33J16=TDGC RETURN 16 F33J16=S RETURN 20 F33J16=-1.0E20 RETURN END C 34 ****** FUNCTION F34J16(PBAR) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.0E9) GO TO 15 S=F38J16(TDGC) IF(S.LT.-1.0E9) GO TO 16 F34J16=S RETURN 15 F34J16=TDGC RETURN 16 F34J16=S RETURN 20 F34J16=-1.0E20 RETURN END C 35 ****** FUNCTION F35J16(PBAR,TDGC) VM3K=F51J16(PBAR,TDGC) IF(VM3K.LT.-1.0E9) GO TO 15 IF(TDGC-386.65.GT.-273.15) GO TO 10 VTD=F53J16(TDGC) IF((VM3K-VTD)/2.7397E-3.GT.1.0E-5) GO TO 10 S=G05J16(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J16=S RETURN 10 S=G05J16(VM3K,TDGC) IF(S.LT.-1.0E9) GO TO 16 F35J16=S RETURN 15 F35J16=VM3K RETURN 16 F35J16=S RETURN 20 F35J16=-1.0E20 RETURN END C 36 ******* FUNCTION F36J16(PBAR,X) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 S=F39J16(TDGC,X) F36J16=S RETURN 10 F36J16=TDGC RETURN END C 37 ****** FUNCTION F37J16(TDGC) C C SDT SAT. LIQUID(TEMP) C VDM3K=F53J16(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.8.7E-4) GO TO 20 SD=G06J16(TDGC) F37J16=SD RETURN 10 F37J16=VDM3K RETURN 20 F37J16=-1.0E10 RETURN END C 38 ****** FUNCTION F38J16(TDGC) C C SDDT SAT. VAPOUR(TEMP) C VDM3K=F54J16(TDGC) IF(VDM3K.LT.-1.0E9) GO TO 10 IF(VDM3K.LT.6.6E-3) GO TO 20 SDD=G05J16(VDM3K,TDGC) F38J16=SDD RETURN 10 F38J16=VDM3K RETURN 20 F38J16=-1.0E10 RETURN END C 39 ******* FUNCTION F39J16(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 STD=F37J16(TDGC) IF(STD.LT.-1.0E9) GO TO 20 STDD=F38J16(TDGC) IF(STDD.LT.-1.0E9) GO TO 10 F39J16=(1.0-X)*STD+X*STDD RETURN 10 F39J16=STDD RETURN 20 F39J16=STD RETURN 30 F39J16=-1.0E20 RETURN END C 40 ******** FUNCTION F40J16(PBAR) C IMPLICIT DOUBLE PRECISION (A-H),(O-Z) DOUBLE PRECISION AA1,AA2,TK,TDGC,PMPA REAL F40J16,PBAR C IF(PBAR.LT.0.01033.OR.PBAR.GT.33.832) GO TO 10 C AA1=0.36034174691D1 AA2=-0.11409500000D4 PMPA=DBLE(PBAR)*1.0D-1 TK=AA2/(DLOG10(PMPA)-AA1) TDGC=TK-273.15D0 F40J16=TDGC RETURN 10 F40J16=-1.0E20 RETURN END C 42 ******* FUNCTION F42J16(PBAR) C C U=H-PV (SAT. LIQUID) C TSDGC=F40J16(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HD=F27J16(TSDGC) IF(HD.LT.-1.0E9) GO TO 20 VD=F53J16(TSDGC) IF(VD.LT.-1.0E9) GO TO 10 U=HD-PBAR*VD*1.0E5 F42J16=U RETURN 10 F42J16=VD RETURN 20 F42J16=HD RETURN 30 F42J16=TSDGC RETURN END C 43 ******* FUNCTION F43J16(PBAR) C C U=H-PV (SAT. VAPOR) C TSDGC=F40J16(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 30 HDD=F28J16(TSDGC) IF(HDD.LT.-1.0E9) GO TO 20 VDD=F54J16(TSDGC) IF(VDD.LT.-1.0E9) GO TO 10 U=HDD-PBAR*VDD*1.0E5 F43J16=U RETURN 10 F43J16=VDD RETURN 20 F43J16=HDD RETURN 30 F43J16=TSDGC RETURN END C 79 ******* FUNCTION F79J16(PBAR,S) C C U(P,S) U=H-PV C CALL S08J16(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.299.01) GO TO 40 PSAT=F30J16(TDGC) IF(PSAT.LT.-1.0E9) GO TO 11 IF(ABS(PBAR-PSAT)/PSAT.GT.1.0E-5) GO TO 40 STDD=F38J16(TDGC) IF(STDD.LT.-1.0E9) GO TO 12 IF(ABS(S-STDD)/STDD.LT.1.0E-5) GO TO 40 STD=F37J16(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=F28J16(TDGC) IF(HTDD.LT.-1.0E9) GO TO 14 VTDD=F54J16(TDGC) IF(VTDD.LT.-1.0E9) GO TO 16 HTD=F27J16(TDGC) IF(HTD.LT.-1.0E9) GO TO 15 VTD=F53J16(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 F79J16=H C WRITE(6,210) H C 210 FORMAT(1H ,42X,'RTN FROM 10 H=',E12.4) RETURN 11 F79J16=PSAT C WRITE(6,211) PSAT C 211 FORMAT(1H ,42X,'RTN FROM 11 PSAT=',E12.4) RETURN 12 F79J16=STDD C WRITE(6,212) STDD C 212 FORMAT(1H ,42X,'RTN FROM 12 STDD=',E12.4) RETURN 13 F79J16=STD C WRITE(6,213) STD C 213 FORMAT(1H ,42X,'RTN FROM 13 STD=',E12.4) RETURN 14 F79J16=HTDD C WRITE(6,214) HTDD C 214 FORMAT(1H ,42X,'RTN FROM 14 HTDD=',E12.4) RETURN 15 F79J16=HTD C WRITE(6,215) HTD C 215 FORMAT(1H ,42X,'RTN FROM 15 HTD=',E12.4) RETURN 16 F79J16=VTDD C WRITE(6,216) VTDD C 216 FORMAT(1H ,42X,'RTN FROM 16 VTDD=',E12.4) RETURN 17 F79J16=VTD C WRITE(6,217) VTD C 217 FORMAT(1H ,42X,'RTN FROM 17 VTD=',E12.4) RETURN 20 F79J16=TDGC C WRITE(6,220) TDGC C 220 FORMAT(1H ,42X,'RTN FROM 20 TDGC=',E12.4) RETURN 30 F79J16=-1.0E20 RETURN 40 F79J16=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 F44J16(PBAR,TDGC) C C U=H-PV C V=F51J16(PBAR,TDGC) IF(V.LT.-1.0E9) GO TO 20 IF(TDGC-386.65.GT.-273.15) GO TO 4 VTD=F53J16(TDGC) IF((V-VTD)/2.7397E-3.LT.1.0E-5) GO TO 5 4 H=G02J16(V,TDGC) GO TO 6 5 H=G02J16(V,TDGC) 6 IF(H.LT.-1.0E9) GO TO 10 U=H-PBAR*V*1.0E5 F44J16=U RETURN 10 F44J16=H RETURN 20 F44J16=V RETURN END C 45 ******* FUNCTION F45J16(PBAR,X) C C U=H-PV C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F42J16(PBAR) IF(UD.LT.-1.0E9) GO TO 20 UDD=F43J16(PBAR) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F45J16=U RETURN 10 F45J16=UDD RETURN 20 F45J16=UD RETURN 30 F45J16=-1.0E20 RETURN END C 46 ******* FUNCTION F46J16(TDGC) C C U=H-PV (SAT. LIQUID C HD=F27J16(TDGC) IF(HD.LT.-1.0E9) GO TO 30 VD=F53J16(TDGC) IF(VD.LT.-1.0E9) GO TO 20 PST=F30J16(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HD-PST*VD*1.0E5 F46J16=U RETURN 10 F46J16=PST RETURN 20 F46J16=VD RETURN 30 F46J16=HD RETURN END C 47 ******* FUNCTION F47J16(TDGC) C C U=H-PV (SAT. VAPOR) C HDD=F28J16(TDGC) IF(HDD.LT.-1.0E9) GO TO 30 VDD=F54J16(TDGC) IF(VDD.LT.-1.0E9) GO TO 20 PST=F30J16(TDGC) IF(PST.LT.-1.0E9) GO TO 10 U=HDD-PST*VDD*1.0E5 F47J16=U RETURN 10 F47J16=PST RETURN 20 F47J16=VDD RETURN 30 F47J16=HDD RETURN END C 48 ******* FUNCTION F48J16(TDGC,X) C C U=H-PV (SAT. LIQUID) C IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 UD=F46J16(TDGC) IF(UD.LT.-1.0E9) GO TO 20 UDD=F47J16(TDGC) IF(UDD.LT.-1.0E9) GO TO 10 U=(1.0-X)*UD+X*UDD F48J16=U RETURN 10 F48J16=UDD RETURN 20 F48J16=UD RETURN 30 F48J16=-1.0E20 RETURN END C 80 ****** FUNCTION F80J16(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 S08J16(PBAR0,S,VX,TDGC,H) IF(VX.LT.1.0E-4) GO TO 10 IF(PBAR0.GT.48.162) GO TO 10 PST=F30J16(PBAR0) IF(ABS((PST-PBAR0)/PBAR0).LT.1.0E-5) GO TO 35 10 F80J16=VX RETURN 35 STD=F37J16(TDGC) STDD=F38J16(TDGC) VTD=F53J16(TDGC) VTDD=F54J16(TDGC) SX=(S-STD)/(STDD-STD) VX=VTD+(VTDD-VTD)*SX F80J16=VX RETURN END C 49 ****** FUNCTION F49J16(PBAR) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F49J16,F40J16,F53J16,PBAR,TSAT,VD TSAT=F40J16(PBAR) VD=F53J16(TSAT) C M3/KG F49J16=VD RETURN END C 50 ****** FUNCTION F50J16(PBAR) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F50J16,F40J16,F54J16,PBAR,TSAT,VDD TSAT=F40J16(PBAR) VDD=F54J16(TSAT) C M3/KG F50J16=VDD RETURN END C 51 ******** FUNCTION F51J16(PBAR,TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL G01J16,F50J16,F51J16,PBAR,TDGC,VNL,VXL REAL PST,F54J16,VMIN,VMAX,PW,VW REAL VM3KC,PCBAR,WMOL,VLM3C,ROWMAX,WK,F30J16 DATA VLM3C,TCK,PCBAR,WMOL/0.18096,386.65,44.95,66.050/ VM3KC=VLM3C/WMOL C CHK RANGE PBAR,TDGC IF(PBAR.LT.0.099.OR.PBAR.GT.30.1) GO TO 70 TK=TDGC+2.7315D2 IF(TDGC.LT.-70.1.OR.TDGC.GT.180.1) 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 C 5 VMAX=5.75 IF(TDGC.GT.98.0) THEN IF(TDGC.GE.100.0) THEN WK=(180.0-TDGC)/10.0 ROWMAX=(WK-1.0)*(WK+1.0)*0.5+63.5 END IF IF(TDGC.LE.160.0) ROWMAX=ROWMAX+(0.7+(WK-2.0)/100.0) IF(TDGC.LE.130.0) ROWMAX=ROWMAX+0.3*(WK-4.0) IF(TDGC.LE.110.0) ROWMAX=ROWMAX+2.94*(WK-7.0)+0.1 IF(TDGC.LE.100.0 .AND. TDGC.GE.98.0) THEN ROWMAX=(ROWMAX-148.35)/2.0*(TDGC-98.0)+148.35 END IF VMIN=1.0/ROWMAX C ICASE=4 VAPOR REGION PBAR.LT.PC C VMAX VMAX=1.0/(1.6*PBAR) IF(VMAX.GT.5.75) VMAX=5.75 C GO TO 15 END IF C C COME ON TDGC.LE.98.0 PST=F30J16(TDGC) IF(ABS(PST/PBAR-1.0).GT.1.0E-6) GO TO 14 VW=F54J16(TDGC) GO TO 60 C 14 VMIN=F54J16(TDGC) C C VMAX VMAX=1.0/(1.6*PBAR) C PW=G01J16(VMIN,TDGC) IF(PW/PBAR-1.0.LT.5.0E-6) THEN VW=VMIN C =F54J16(TDGC) GO TO 60 END IF 15 VW=F50J16(PBAR) IF(VMIN.LT.VW*0.98) VMIN=VW*0.98 C VMIN ADJUST,NOT OVER MAX PRESS C CHECK PW=G01J16(VMIN,TDGC) IF(PW.GT.PBAR) THEN WK=1.0 ELSE DO 151 K=1,10 VMIN=VMIN*0.95 PW=G01J16(VMIN,TDGC) IF(PW.GT.PBAR) GO TO 152 151 CONTINUE 152 CONTINUE END IF C CALL S06J16(PBAR,TDGC,VMIN,VMAX) C IF(VMIN.GT.0.001) THEN PW=G01J16(VMIN,TDGC) IF(ABS(PW/PBAR-1.0) .LT.1.0E-5) THEN VW=VMIN PW=G01J16(VW,TDGC) GO TO 60 END IF PW=G01J16(VMAX,TDGC) IF(ABS(PW/PBAR-1.0) .LT.1.0E-5) THEN VW=VMAX PW=G01J16(VW,TDGC) GO TO 60 END IF C ELSE C WRITE(*,*) 'S06 OUT VMIN.LT.001 GOTO70' GO TO 70 END IF C ICASE=4 IF(ABS(VMIN/VMAX-1.0).LT.1.0E-5) THEN VW=VMIN PW=G01J16(VW,TDGC) GO TO 60 END IF C ICOUNT=0 VNL=G01J16(VMIN,TDGC) VXL=G01J16(VMAX,TDGC) C 20 VW=(VMAX+VMIN)*0.5 PW=G01J16(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(ABS(VMIN/VMAX-1.0).LT.1.0E-6) GO TO 59 IF(PW.LT.0.001) GO TO 50 IF(ICOUNT.LT.18) GO TO 20 GO TO 50 21 VMAX=VW ICOUNT=ICOUNT+1 IF(ABS(VMIN/VMAX-1.0).LT.1.0E-6) GO TO 59 IF(PW.LT.0.001) GO TO 50 IF(ICOUNT.LT.18) GO TO 20 GO TO 50 C 50 F51J16=-1.E10 RETURN 59 VW=(VMAX+VMIN)*0.5 60 F51J16=VW RETURN 70 F51J16=-1.0E20 RETURN END C 52 ******* FUNCTION F52J16(PBAR,X) TDGC=F40J16(PBAR) IF(TDGC.LT.-1.0E9) GO TO 10 V=F55J16(TDGC,X) F52J16=V RETURN 10 F52J16=TDGC RETURN END C 53 ******* FUNCTION F53J16(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F53J16,TDGC C DIMENSION EIR(8),JDXR(8) DATA JDXR/1,2,3,5,10,12,23,24/ DATA EIR/0.1666665442D-4,-0.1603503399D-3,0.4507340845D-3, 1 -0.1246643944D-2,0.2168193030D0,0.3464116238D1,0.1880454859D1, 2 -0.1800656728D1/ C DATA TCK,VC,WM/386.65D0,0.18096D0,66.050D0/ C K, L/MOL KG/KMOL C IF(TDGC.LT.-100.0.OR.TDGC.GT.98.1) GO TO 20 C TK=TDGC+273.15 THTA=TK/TCK TAU=(TCK-TK)/TCK W=0.0D0 DO 10 K=1,8 I=JDXR(K)-11 RI3=DBLE(FLOAT(I))/3.0D0 10 W=W+EIR(K)*TAU**RI3 C W=W+EIR(9)*DLOG(THTA) C RO=DEXP(W)/VC RO=W/VC VM3K=1.0D0/RO F53J16=VM3K/WM RETURN 20 F53J16=-1.0E20 RETURN END C 54 ****** FUNCTION F54J16(TDGC) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F54J16,TDGC C DIMENSION FIR(9),JDXR(9) DATA JDXR/1,2,3,4,13,15,22,23,25/ DATA FIR/0.1415311350D-2,-0.1254312072D-1,0.3786936559D-1, 1 -0.3909792278D-1,0.1061497993D2,0.7503612191D2,0.1574358773D2, 2 0.2318135426D2,0.6720498515D2/ C DATA TCK,VC,WM/386.65D0,0.18096D0,66.050D0/ C K, L/MOL KG/KMOL C IF(TDGC.LT.-100.0.OR.TDGC.GT.98.1) GO TO 20 C TK=TDGC+273.15 THTA=TK/TCK TAU=(TCK-TK)/TCK W=0.0D0 DO 10 K=1,8 I=JDXR(K)-11 RI3=DBLE(FLOAT(I))/3.0D0 10 W=W+FIR(K)*TAU**RI3 W=W+FIR(9)*DLOG(THTA) RO=DEXP(W)/VC VM3K=1.0D0/RO F54J16=VM3K/WM RETURN 20 F54j16=-1.0E20 RETURN END C 55 ****** FUNCTION F55J16(TDGC,X) IF(X.LT.0.0.OR.X.GT.1.0) GO TO 30 VD=F53J16(TDGC) IF(VD.LT.-1.0E9) GO TO 20 VDD=F54J16(TDGC) IF(VDD.LT.-1.0E9) GO TO 10 V=(1.0-X)*VD+X*VDD F55J16=V RETURN 10 F55J16=VDD RETURN 20 F55J16=VD RETURN 30 F55J16=-1.0E20 RETURN END C 56 ******* FUNCTION F56J16(PBAR,H) TSDGC=F40J16(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F60J16(TSDGC,H) F56J16=X RETURN 10 F56J16=TSDGC RETURN END C 57 ******* FUNCTION F57J16(PBAR,S) TSDGC=F40J16(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F61J16(TSDGC,S) F57J16=X RETURN 10 F57J16=TSDGC RETURN END C 58 ******* FUNCTION F58J16(PBAR,U) TSDGC=F40J16(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F62J16(TSDGC,U) F58J16=X RETURN 10 F58J16=TSDGC RETURN END C 59 ******* FUNCTION F59J16(PBAR,V) TSDGC=F40J16(PBAR) IF(TSDGC.LT.-1.0E9) GO TO 10 X=F63J16(TSDGC,V) F59J16=X RETURN 10 F59J16=TSDGC RETURN END C 60 ******* FUNCTION F60J16(TDGC,H) IF(TDGC.LT.-100.1.OR.TDGC.GT.98.1) GO TO 10 HD=F27J16(TDGC) IF(HD.LT.-1.0E9) GO TO 30 IF(HD.GT.H) GO TO 10 HDD=F28J16(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 F60J16=1.0 RETURN 5 X=(H-HD)/(HDD-HD) F60J16=X RETURN 10 F60J16=-1.0E20 RETURN 20 F60J16=HDD RETURN 30 F60J16=HD RETURN END C 61 ******* FUNCTION F61J16(TDGC,S) IF(TDGC.LT.-100.1.OR.TDGC.GT.98.1) GO TO 10 SD=F37J16(TDGC) IF(SD.LT.-1.0E9) GO TO 30 IF(SD.GT.S) GO TO 10 SDD=F38J16(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 F61J16=1.0 RETURN 5 X=(S-SD)/(SDD-SD) F61J16=X RETURN 10 F61J16=-1.0E20 RETURN 20 F61J16=SDD RETURN 30 F61J16=SD RETURN END C 62 ******* FUNCTION F62J16(TDGC,U) IF(TDGC.LT.-100.1.OR.TDGC.GT.98.1) GO TO 10 UD=F46J16(TDGC) IF(UD.LT.-1.0E9) GO TO 30 IF(UD.GT.U) GO TO 10 UDD=F47J16(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 F62J16=1.0 RETURN 5 X=(U-UD)/(UDD-UD) F62J16=X RETURN 10 F62J16=-1.0E20 RETURN 20 F62J16=UDD RETURN 30 F62J16=UD RETURN END C 63 ******* FUNCTION F63J16(TDGC,V) IF(TDGC.LT.-100.1.OR.TDGC.GT.98.1) GO TO 10 VD=F53J16(TDGC) IF(VD.LT.-1.0E9) GO TO 30 IF(VD.GT.V) GO TO 10 VDD=F54J16(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 F63J16=1.0 RETURN 5 X=(V-VD)/(VDD-VD) F63J16=X RETURN 10 F63J16=-1.0E20 RETURN 20 F63J16=VDD RETURN 30 F63J16=VD RETURN END C 64 ******* FUNCTION F64J16(PBAR0,H) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F64J16,TDGC,HW,TMAX,TMIN,HDP,HDDP,HX,H1,H2,TSP,VX,TWH REAL PBAR0,H,G02J16,F40J16,F51J16,TMAXT,VMINT,VMAXT REAL F54J16,TLCK,TCC,VDP,VDDP,VCM3K REAL TMXR,TMNR,G01J16,G03J16 C DATA HC/4.679D5/ DATA PCBAR,TCK,ROCKM3/4.495D1,3.8665D2,3.650D2/ DATA VMINT,TMAXT,TLCK,VMAXT/0.8722E-3,453.2,173.0,5.75/ C IF(PBAR0.LT.0.009.OR.PBAR0.GT.45.1) GO TO 40 IF(H.LT.0.95E5.OR.H.GT.7.3E5) GO TO 40 IF(ABS(PBAR0-44.95).GT.0.01) GO TO 5 IF(ABS(H-SNGL(HC)).GT.60.0) GO TO 5 C CRITICAL PRES. ERROR =0.01(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/30.1-1.0.GT.1.0E-6) GO TO 40 TDGC=F40J16(PBAR0) TSP=TDGC IF(TDGC.LT.-101.0) GO TO 40 HDP=G03J16(TDGC) IF(HDP.LT.1.0E-1) GO TO 50 IF(H/HDP-1.0.GT.1.0E-6) GO TO 13 C C ON UPPER SAT. LIQ LINE AND IN SUPER HEAT VAPOR GO TO 13 C ON SAT.LIQ. LINE ERR=0.01 IF(TDGC.LT.-80.0) ERR=0.02 C EXAMPLE R152A IF(ABS(H/HDP-1.0).GT.ERR) GO TO 40 C LIMITTED ONLY ON THE SAT.LIQ LINE, NO COMPRESSED LIQUID GO TO 30 C 13 VDDP=F54J16(TDGC) IF(VDDP.LT.VCM3K) GO TO 50 HDDP=G02J16(VDDP,TDGC) ERR=3.0E-5 IF(TDGC.GT.90.0) ERR=3.0E-3 IF(H/HDDP-1.0.LT.ERR) GO TO 30 CXX WRITE(*,*) 'PASS SAT. VAP LINE',H,HDDP CXX GO TO 30 C ADAAX **************************** IF(H.GT.HC .OR. H.GT.HDDP) THEN C IF(PBAR0.LT.1.0) THEN TMIN=(-35+70)*ALOG10(PBAR0/0.1)-70.09 ELSE IF(PBAR0.LT.10.0) THEN TMIN=(35+35)*ALOG10(PBAR0)-35.0 ELSE TMIN=(93-35)/ALOG10(3.0)*ALOG10(PBAR0/10.0)+35.0 END IF C TSP=F40J16(PBAR0) IF(TMIN.LT.TSP) TMIN=TSP C IF(TMIN.LT.TDGC) TMIN=TDGC IF(TMIN.LT.-70.09) TMIN=-70.09 C F51 TMIN=-70.1 C TMAX=TMAXT-273.15 C ICASE=4 TSP=(TMAX-TMIN)/9.9 INSTEP=11 TWH=TMAX HW=2.0E10 DO 135 IMARK=1,9 DO 133 I=1,INSTEP TDGC=TMAX-(I-1)*TSP IF(TDGC.LT.-65.09) TDGC=-70.09 C F51 TMIN=-70.1 136 VX=F51J16(PBAR0,TDGC) IF(VX.LT.VDDP*1.01) THEN IF(VX.LT.-0.5E5) GO TO 50 C IF(VX.GT.VDDP*0.95) GO TO 30 GO TO 50 END IF C VX.LT.VDDP END IF C HX=G02J16(VX,TDGC) C IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.LT.H .OR. HX.GT.HW) GO TO 134 C 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 C 134 TMAX=TWH TMIN=TDGC IF(TMIN.GT.TMAX) THEN VX=TMIN TMIN=TMAX TMAX=VX END IF IF(ABS(TMAX-TMIN).LT.1.0E-4) TMAX=TMIN+TSP IF(TMAX.GT.TMAXT-273.15) TMAX=TMAXT-273.15 C VX=F51J16(PBAR0,TMIN) H1=G02J16(VX,TMIN) VX=F51J16(PBAR0,TMAX) H2=G02J16(VX,TDGC) HW=H2*10.0 C IF(IMARK.LT.3) THEN TSP=(TMAX-TMIN)/9.9 INSTEP=11 ELSE TSP=(TMAX-TMIN)/29.9 INSTEP=31 END IF 135 CONTINUE IF(ABS(HW/H-1.0).LT.1.0E-4) THEN TDGC=TWH GO TO 30 END IF C IF(ABS(TMAX-TMIN).LT.1.0E-2) GO TO 50 GO TO 15 ELSE C ADAAA **************************** C IF(H.GT.HC .OR. H.GT.HDDP) THEN ELSE C TMAX=TDGC TMIN=TLCK-0.1-273.15 VX=F51J16(PBAR0,TMIN) IF(VX.LT.VMINT) THEN TMIN=TLCK-273.15 VX=F51J16(PBAR0,TMIN) IF(VX.LT.VMINT) THEN C WRITE(*,*) 'VX.LT.VMINT AFTER ADAAA',VX,VMINT GO TO 40 END IF END IF HX=G02J16(VX,TMIN) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 32 IF(HX.GT.H) THEN GO TO 40 END IF TWH=(TMAX-TMIN)/49.9 H2=HX DO 131 I=1,50 H1=H2 TDGC=TMIN+I*TWH VX=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 131 H2=G02J16(VX,TDGC) IF(H2.GT.H) GO TO 132 131 CONTINUE 132 TMAX=TDGC TMIN=TDGC-TWH C 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=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 141 IF(VX.GT.VMAXT) GO TO 141 HX=G02J16(VX,TDGC) IF(ABS(HX/H-1.0).LT.1.0E-6) GO TO 30 IF(HX.LT.3.0E4) GO TO 141 IF(HX.GT.H) GO TO 142 141 CONTINUE 142 TMAX=TDGC TMIN=TDGC-TWH C 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=F51J16(PBAR0,TMIN) H1=G02J16(VX,TMIN) VX=F51J16(PBAR0,TMAX) H2=G02J16(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 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=F40J16(PBAR0) IF(TDGC.LT.234.5-273.15) GO TO 50 VDDP=F54J16(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G02J16(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=F54J16(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G02J16(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=F51J16(PBAR0,TDGC) HX=G02J16(VX,TDGC) IF(HX.LT.H) THEN GO TO 40 C OUT OF RANGE END IF H2=HX END IF C TWH=TMIN TSP=TMAX-TMIN DO 264 I=1,20 TDGC=TWH+I*TSP/19.9 VX=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 264 HW=G02J16(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=F51J16(PBAR0,TDGC) HX=G02J16(VX,TDGC) IF(HX.GT.H) THEN GO TO 40 C OUT OF RANGE END IF H1=HX TDGC=TMAX VX=F51J16(PBAR0,TDGC) HX=G02J16(VX,TDGC) IF(HX.LT.H) THEN GO TO 40 C OUT OF RANGE END IF H2=HX C TWH=TMIN TSP=TMAX-TMIN DO 267 I=1,200 TDGC=TWH+I*TSP/199.0 VX=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 267 HX=G02J16(VX,TDGC) IF(HX.LT.0.1) GO TO 267 IF(ABS(HX/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 IF(TMAX.GT.TMIN) GO TO 26 END IF 267 CONTINUE C 26 IC=0 TMNR=TMIN TMXR=TMAX 27 TDGC=(TMIN+TMAX)*0.5 28 VX=F51J16(PBAR0,TDGC) HW=G02J16(VX,TDGC) IF(ABS(HW/H-1.0).LT.1.0E-6) THEN PST=G01J16(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=F51J16(PBAR0,TDGC) IF(VX.LT.0.49E-3) GO TO 282 TSP=G01J16(VX,TDGC) IF(TSP.LT.0.21) GO TO 282 HW=G02J16(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 F64J16=TDGC RETURN 31 F64J16=TMAX RETURN 32 F64J16=TMIN RETURN 40 F64J16=-1.0E20 RETURN 50 F64J16=-1.0E10 RETURN END C 65 ******* FUNCTION F65J16(PBAR0,S) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F65J16,TDGC,SW,TMAX,TMIN,SDP,SDDP,SX,S1,S2,TSP,VX,TWH REAL PBAR0,S,G05J16,F40J16,F51J16,TMAXT,VMINT,VMAXT REAL F54J16,TLCK,TCC,VDP,VDDP,VCM3K REAL TMXR,TMNR,G01J16,G06J16 C DATA SC/1.7970D3/ DATA PCBAR,TCK,ROCKM3/4.495D1,3.8665D2,3.650D2/ DATA VMINT,TMAXT,TLCK,VMAXT/0.8722E-3,453.2,173.0,5.75/ C IF(PBAR0.LT.0.009.OR.PBAR0.GT.45.1) GO TO 40 IF(S.LT.0.5E3.OR.S.GT.3.2E3) GO TO 40 IF(ABS(PBAR0-44.95).GT.0.01) GO TO 5 IF(ABS(S-SNGL(SC)).GT.6.0) GO TO 5 C CRITICAL PRES. ERROR =0.01(BAR) C CRITICAL SPC. S ERROR=0.006E3(J/KG) TDGC=SNGL(TCK)-273.15 GO TO 30 C 5 VCM3K=1.0/SNGL(ROCKM3) IF(PBAR0/30.1-1.0.GT.1.0E-6) GO TO 40 TDGC=F40J16(PBAR0) TSP=TDGC IF(TDGC.LT.-101.0) GO TO 40 SDP=G06J16(TDGC) IF(SDP.LT.1.0E-1) GO TO 50 IF(S/SDP-1.0.GT.1.0E-6) GO TO 13 C C ON UPPER SAT. LIQ LINE AND IN SUPER HEAT VAPOR GO TO 13 C ON SAT.LIQ. LINE ERR=0.04 IF(TDGC.LT.-80.0) ERR=0.08 C EXAMPLE R152A IF(ABS(S/SDP-1.0).GT.ERR) GO TO 40 C LIMITTED ONLY ON THE SAT.LIQ LINE, NO COMPRESSED LIQUID GO TO 30 C 13 VDDP=F54J16(TDGC) IF(VDDP.LT.VCM3K) GO TO 50 SDDP=G05J16(VDDP,TDGC) ERR=1.0E-5 IF(TDGC.GT.90.0) ERR=5.0E-4 IF(S/SDDP-1.0.LT.ERR) GO TO 30 C ADAAX **************************** IF(S.GT.SC .OR. S.GT.SDDP) THEN C IF(PBAR0.LT.1.0) THEN TMIN=(-17+60)*ALOG10(PBAR0/0.1)-60.0 ELSE IF(PBAR0.LT.6.5) THEN TMIN=(40+17)/ALOG10(6.5)*ALOG10(PBAR0)-17.0 ELSE TMIN=(115-40)/ALOG10(35.0/6.5)*ALOG10(PBAR0/6.5)+40.0 END IF C TSP=F40J16(PBAR0) IF(TMIN.LT.TSP) TMIN=TSP C IF(TMIN.LT.TDGC) TMIN=TDGC IF(TMIN.LT.-70.09) TMIN=-70.09 C F51 TMIN=-70.1 C TMAX=TMAXT-273.15 IF(PBAR0.GT.30.0) THEN TMAX=(135.0-145.0)/5.0*(PBAR0-30.0)+145.0 END IF C ICASE=4 TSP=(TMAX-TMIN)/9.9 INSTEP=11 TWH=TMAX SW=2.0E10 DO 135 IMARK=1,9 DO 133 I=1,INSTEP TDGC=TMAX-(I-1)*TSP IF(TDGC.LT.-65.09) TDGC=-70.09 C F 51 TMIN=-70.1 136 VX=F51J16(PBAR0,TDGC) IF(VX.LT.VDDP*1.01) THEN IF(VX.LT.-0.5E5) GO TO 50 C IF(VX.GT.VDDP*0.95) GO TO 30 GO TO 50 END IF C VX.LT.VDDP END IF C SX=G05J16(VX,TDGC) C IF(ABS(SX/S-1.0).LT.1.0E-4) GO TO 30 IF(SX.LT.S .OR. SX.GT.SW) GO TO 134 C SW=SX TWH=TDGC 133 CONTINUE IF(ABS(SW/S-1.0).LT.1.0E-4) THEN TDGC=TWH GO TO 30 END IF GO TO 50 C 134 TMAX=TWH TMIN=TDGC IF(TMIN.GT.TMAX) THEN VX=TMIN TMIN=TMAX TMAX=VX END IF IF(ABS(TMAX-TMIN).LT.1.0E-4) TMAX=TMIN+TSP IF(TMAX.GT.TMAXT-273.15) TMAX=TMAXT-273.15 C VX=F51J16(PBAR0,TMIN) S1=G05J16(VX,TMIN) VX=F51J16(PBAR0,TMAX) S2=G05J16(VX,TDGC) SW=S2*10.0 C IF(IMARK.LT.3) THEN TSP=(TMAX-TMIN)/9.9 INSTEP=11 ELSE TSP=(TMAX-TMIN)/29.9 INSTEP=31 END IF 135 CONTINUE IF(ABS(SW/S-1.0).LT.1.0E-4) THEN TDGC=TWH GO TO 30 END IF C IF(ABS(TMAX-TMIN).LT.1.0E-2) GO TO 50 GO TO 15 ELSE C ADAAA **************************** C IF(S.GT.SC .OR. S.GT.SDDP) THEN ELSE C TMAX=TDGC TMIN=TLCK-0.1-273.15 VX=F51J16(PBAR0,TMIN) IF(VX.LT.VMINT) THEN TMIN=TLCK-273.15 VX=F51J16(PBAR0,TMIN) IF(VX.LT.VMINT) THEN C WRITE(*,*) 'VX.LT.VMINT AFTER ADAAA' GO TO 40 END IF END IF SX=G05J16(VX,TMIN) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 IF(SX.GT.S) THEN GO TO 40 END IF TWH=(TMAX-TMIN)/49.9 S2=SX DO 131 I=1,50 S1=S2 TDGC=TMIN+I*TWH VX=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 131 S2=G05J16(VX,TDGC) IF(S2.GT.S) GO TO 132 131 CONTINUE 132 TMAX=TDGC TMIN=TDGC-TWH C ICASE=1 GO TO 15 END IF C **************************** C 14 TWH=(TMAX-TMIN)/49.9 DO 141 I=1,51 TDGC=TMIN+(I-1)*TWH VX=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 141 IF(VX.GT.VMAXT) GO TO 141 SX=G05J16(VX,TDGC) IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 30 IF(SX.LT.3.0E2) GO TO 141 IF(SX.GT.S) GO TO 142 141 CONTINUE 142 TMAX=TDGC TMIN=TDGC-TWH C 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=F51J16(PBAR0,TMIN) S1=G05J16(VX,TMIN) VX=F51J16(PBAR0,TMAX) S2=G05J16(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 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=F40J16(PBAR0) IF(TDGC.LT.234.5-273.15) GO TO 50 VDDP=F54J16(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 SDDP=G05J16(VDDP,TDGC) IF(S.GT.SDDP) THEN GO TO 263 END IF GO TO 26 C 263 S1=SDDP TMIN=TDGC IF(TDGC.LT.TLCK-273.15) THEN TMIN=TLCK-273.15 TDGC=TMIN VDDP=F54J16(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 SDDP=G05J16(VDDP,TDGC) S1=SDDP IF(S1.LT.0.1) GO TO 50 IF(S.LT.SDDP) GO TO 26 END IF C IF(TMAX.LT.TMIN .OR. TMAX.GT.TMAXT-273.15) THEN TMAX=TMAXT-273.15 TDGC=TMAX VX=F51J16(PBAR0,TDGC) SX=G05J16(VX,TDGC) IF(SX.LT.S) THEN GO TO 40 C OUT OF RANGE END IF S2=SX END IF C TWH=TMIN TSP=TMAX-TMIN DO 264 I=1,20 TDGC=TWH+I*TSP/19.9 VX=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 264 SW=G05J16(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=F51J16(PBAR0,TDGC) SX=G05J16(VX,TDGC) IF(SX.GT.S) THEN GO TO 40 C OUT OF RANGE END IF S1=SX TDGC=TMAX VX=F51J16(PBAR0,TDGC) SX=G05J16(VX,TDGC) IF(SX.LT.S) THEN GO TO 40 C OUT OF RANGE END IF S2=SX C TWH=TMIN TSP=TMAX-TMIN DO 267 I=1,200 TDGC=TWH+I*TSP/199.0 VX=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 267 SX=G05J16(VX,TDGC) IF(SX.LT.0.1) GO TO 267 IF(ABS(SX/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 IF(TMAX.GT.TMIN) GO TO 26 END IF 267 CONTINUE C 26 IC=0 TMNR=TMIN TMXR=TMAX 27 TDGC=(TMIN+TMAX)*0.5 28 VX=F51J16(PBAR0,TDGC) SW=G05J16(VX,TDGC) IF(ABS(SW/S-1.0).LT.1.0E-6) THEN PST=G01J16(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 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 TWH=(TMXR-TMNR)/10.3 IS0=0 DO 282 I=1,10 TDGC=TMNR+I*TWH VX=F51J16(PBAR0,TDGC) IF(VX.LT.0.49E-3) GO TO 282 TSP=G01J16(VX,TDGC) IF(TSP.LT.0.21) GO TO 282 SW=G05J16(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)*TWH TMNR=TMNR+(IMK-1)*TWH 283 CONTINUE TDGC=TMNR+IMK*TWH VX=VDP GO TO 30 C 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 TWH=TDGC TDGC=(TMAX+TMIN)*0.5+(TMIN-TMAX)*(S-(S1+S2)*0.5)/(S1-S2) 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 F65J16=TDGC RETURN 31 F65J16=TMAX RETURN 32 F65J16=TMIN RETURN 40 F65J16=-1.0E20 RETURN 50 F65J16=-1.0E10 RETURN END C 70 ******* FUNCTION F70J16(PBAR,VM3K) IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL F70J16,PBAR,TDGC,VM3K,PW,TMAX,TMIN,VDP,VDDP,P1,P2,TSP REAL G01J16,F40J16,F53J16,F54J16,VCM3K REAL TDGCMX,TDGCMN C DATA PCBAR,TCK,VCLMOL,WMOL/4.495D1,3.8665D2,0.18096D0,66.050D0/ C IF(PBAR.LT.0.01.OR.PBAR.GT.44.955) GO TO 40 IF(VM3K.LT.0.00086.OR.VM3K.GT.5.8) GO TO 40 C IF(ABS(PBAR-44.95).GT.0.006) GO TO 5 VCM3K=VCLMOL/WMOL ROCKM3=1.0/VCM3K 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.GT.44.95) GO TO 40 TDGC=F40J16(PBAR) TSP=TDGC IF(TDGC.LT.-101.0) THEN GO TO 40 END IF C C VDP=F53J16(TDGC) IF(VDP.LT.1.0E-5) THEN GO TO 50 END IF IF(VM3K/VDP-1.0.GT.-1.0E-5) GO TO 10 C UPPER SAT. LIQ LINE GO TO 10 C ON SAT.LIQ. LINE, NO COPRESSED LIQUID REGION C ERR=0.0031 IF(TDGC.LT.-90.0) ERR=0.005 IF(ABS(VDP/VM3K-1.0).GT.ERR) THEN C WRITE(*,*) 'COME ON SAT.LIQ. LINE OUT OF RANGE' GO TO 40 END IF GO TO 30 C 10 VDDP=F54J16(TDGC) IF(VDDP.LT.0.0044) THEN WRITE(*,*) 'VDDP.LT.0.0044 AT 10' C WRITE(*,*) 'VDDP.LT.0.0044 AT 10' GO TO 50 END IF IF(VM3K/VDDP-1.0.LT.1.0E-5) THEN PW=G01J16(VM3K,TDGC) IF(ABS(PW/PBAR-1.0).LT.0.01) GO TO 30 C WRITE(*,*) 'VDDP.CHECK MISS AT 10 F70J16 PW,PBAR' GO TO 50 END IF TMIN=TDGC TMAX=180.1 CALL S05J16(PBAR,VM3K,TDGCMX,TDGCMN) IF(ABS(TDGCMX-TDGCMN).LT.1.0E-2) THEN IF(TDGCMX.LT.-65.1 ) THEN GO TO 50 END IF TDGC=(TDGCMX+TDGCMN)*0.5 GO TO 30 END IF IF((TMAX.GT.TDGCMX) .OR. (TMIN.LT.TDGCMN)) THEN TMAX=TDGCMX TMIN=TDGCMN END IF ICASE=4 C 15 IF(TMIN.GT.TMAX) THEN TDGC=TMIN TMIN=TMAX TMAX=TDGC END IF C WRITE(1,*) 'COME ON 15' IF((TMAX.GT.TDGCMX) .OR. (TMIN.LT.TDGCMN)) THEN TMAX=TDGCMX TMIN=TDGCMN ENDIF P1=G01J16(VM3K,TMIN) P2=G01J16(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 26 EPS=5.0E-7 C TA=0.618034 TB=1.0-TA C Q1=TA*TMIN+TB*TMAX TKW=Q1 PBARW=G01J16(VM3K,TMIN) EQIVZ=PBARW-PBAR G1=ABS(EQIVZ) Q2=TB*TMIN+TA*TMAX TKW=Q2 PBARW=G01J16(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=G01J16(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=G01J16(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 WRITE(*,*) 'COME ON LBL 30 BEFORE' 30 F70J16=TDGC RETURN 31 F70J16=TMAX RETURN 32 F70J16=TMIN RETURN 40 F70J16=-1.0E20 RETURN 50 F70J16=-1.0E10 RETURN END C S05 SUBROUTINE S05J16(PBAR,VM3K,TDGCMX,TDGCMN) DATA TMINT,TMAXT,TC,PC,VCLMOL/173.0,453.3,386.65,44.95,0.18096/ C K K K BAR L/MOL DATA WMOL/66.050/ C VC=VCLMOL/WMOL ROC=1.0/VC PWC=G01J16(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=F53J16(TKW-273.15) ELSE VM3KW=F54J16(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=F53J16(TKW-273.15) ELSE VM3KW=F54J16(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.200) 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=F53J16(TKW-273.15) ELSE VM3KW=F54J16(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=F53J16(TKW-273.15) ELSE VM3KW=F54J16(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=G01J16(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=G01J16(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=G01J16(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 S06 SUBROUTINE S06J16(PBAR0,TDGC,VM3K1,VM3K2) C VM3K1.LT.VM3K2 C IF(VM3K2.GT.0.0) GO TO 20 PWBAR=G01J16(VM3K1,TDGC) IF(PWBAR.GT.PBAR0) THEN DM=1.003 GO TO 11 ELSE DM=0.997 GO TO 16 END IF 11 VM3K=VM3K1 DO 12 K=1,100 VM3K2=VM3K VM3K=VM3K*DM PWBAR=G01J16(VM3K,TDGC) IF(PWBAR.LT.PBAR0) THEN VM3K1=VM3K2 VM3K2=VM3K GO TO 20 END IF 12 CONTINUE VM3K1=-1.0E10 RETURN 16 VM3K=VM3K1 DO 17 K=1,100 VM3K2=VM3K VM3K=VM3K*DM PWBAR=G01J16(VM3K,TDGC) IF(PWBAR.GT.PBAR0) THEN VM3K1=VM3K GO TO 20 END IF 17 CONTINUE VM3K1=-1.0E10 RETURN C 20 EPS=5.0E-7 C TA=0.618034 TB=1.0-TA C C Q1=TA*VM3K1+TB*VM3K2 Q1=VM3K1 VM3K=Q1 PBARW=G01J16(VM3K1,TDGC) EQIVZ=PBARW-PBAR0 SIG1=SIGN(1.0,EQIVZ) G1=ABS(EQIVZ) IF(G1.LT.1.0E-5*PBAR0) THEN VM3K=VM3K1 GO TO 30 END IF P1DIFR=EQIVZ X1R=VM3K1 C Q2=TB*VM3K1+TA*VM3K2 Q2=VM3K2 VM3K=Q2 PBARW=G01J16(VM3K2,TDGC) EQIVZ=PBARW-PBAR0 SIG2=SIGN(1.0,EQIVZ) G2=ABS(EQIVZ) IF(G2.LT.1.0E-5*PBAR0) THEN VM3K=VM3K2 GO TO 30 END IF P2DIFR=EQIVZ X2R=VM3K2 C IC=0 28 W=ABS(VM3K2-VM3K1) IC=IC+1 IF(IC.GT.200) GO TO 27 C IF(W.LT.EPS*ABS(VM3K1+VM3K2)) THEN VM3K=(VM3K1+VM3K2)*0.5 PBARW=G01J16(VM3K,TDGC) EQIVZ=PBARW-PBAR0 IF(ABS(EQIVZ).LT.1.0E-5) GO TO 30 IF(P1DIFR*EQIVZ.GT.0.0) THEN P1DIFR=EQIVZ VM3K1=VM3K VM3K2=X2R C P2DIFR=P2DIFR ELSE CC P2DIFR*EQIVZ.GT.0.0 P2DIFR=EQIVZ VM3K2=VM3K VM3K1=X1R C P1DIFR=P1DIFR END IF IF(VM3K1.GT.VM3K2) THEN VM3K=VM3K2 VM3K2=VM3K1 VM3K1=VM3K PBARW=P2DIFR P2DIFR=P1DIFR P1DIFR=PBARW END IF X1R=VM3K1 X2R=VM3K2 IF(ABS(X1R-X2R).LT.EPS*(X1R+X2R) ) THEN VM3K=(VM3K1+VM3K2)*0.5 GO TO 30 ELSE GO TO 28 END IF C END IF C VM3K1-VM3K2.LT.EPS C IF(G1.GT.G2) THEN VM3K1=Q1 SIG1=SIG2 Q1=Q2 G1=G2 Q2=TB*VM3K1+TA*VM3K2 VM3K=Q2 PBARW=G01J16(VM3K,TDGC) EQIVZ=PBARW-PBAR0 SIG2=SIGN(1.0,EQIVZ) G2=ABS(EQIVZ) IF(G2.LT.1.0E-5*PBAR0) THEN GO TO 30 END IF C IF(SIG1*SIG2.LT.0.0) THEN VM3K1=Q1 VM3K2=Q2 IF(VM3K1.GT.VM3K2) THEN VW=VM3K1 VM3K1=VM3K2 VM3K2=VW END IF GO TO 25 END IF C ELSE C IF(G1.GT.G2) THEN FALSE C VM3K2=Q2 SIG2=SIG1 Q2=Q1 G2=G1 Q1=TA*VM3K1+TB*VM3K2 VM3K=Q1 PBARW=G01J16(VM3K,TDGC) EQIVZ=PBARW-PBAR0 SIG1=SIGN(1.0,EQIVZ) G1=ABS(EQIVZ) IF(G1.LT.1.0E-5*PBAR0) THEN GO TO 30 END IF C IF(SIG1*SIG2.LT.0.0) THEN VM3K1=Q1 VM3K2=Q2 IF(VM3K1.GT.VM3K2) THEN VW=VM3K1 VM3K1=VM3K2 VM3K2=VW END IF GO TO 25 END IF C END IF C IF(G1.GT.G2) THEN... ELSE... END IF C IF(ABS(Q2).GT.1.0E-7) THEN IF(ABS(Q1/Q2-1.0).GT.1.0E-6) GO TO 28 ELSE IF(ABS(Q2/Q1-1.0).GT.1.0E-6) GO TO 28 END IF VM3K=(Q1+Q2)*0.5 GO TO 30 C 25 PBARW=G01J16(VM3K1,TDGC) Y2=PBARW-PBAR0 X2=VM3K1 IF(ABS(Y2).LT.1.0E-5*PBAR0) THEN VM3K=X2 GO TO 30 END IF C DX=(VM3K2-VM3K1)/199.9 DO 26 K=1,201 VM3K=VM3K1+(K-1)*DX X1=VM3K PBARW=G01J16(VM3K,TDGC) Y1=PBARW-PBAR0 IF(ABS(Y1).LT.1.0E-5*PBAR0) GO TO 30 C IF(Y1*Y2.LT.0.0) GO TO 261 X2=X1 Y2=Y1 26 CONTINUE 261 IF(ABS(Y1-Y2).LT.1.0E-7) THEN VM3K=(X1+X2)*0.5 C 'IN S06 Y1=Y2' YW=G01J16(VM3K,TDGC)-PBAR0 Y1=G01J16(X1,TDGC)-PBAR0 Y2=G01J16(X2,TDGC)-PBAR0 ELSE VM3K=X1-Y1*(X2-X1)/(Y2-Y1) YW=G01J16(VM3K,TDGC)-PBAR0 Y1=G01J16(X1,TDGC)-PBAR0 Y2=G01J16(X2,TDGC)-PBAR0 IF(Y1*YW.GT.0.0) THEN VM3K1=VM3K VM3K2=X2 ELSE VM3K1=X1 VM3K2=VM3K END IF RETURN END IF 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 VM3K=Z C 30 VM3K1=VM3K VM3K2=VM3K RETURN END C S08 SUBROUTINE S08J16(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,G05J16,F40J16,F51J16,TMAXT,VMINT,VMAXT REAL F53J16,F54J16,TLCK,TCC,VDP,VDDP,VDPMAX,VCM3K REAL F37J16,VM3K,TEMPC,H,G02J16,G01J16 C DATA SC/1.7970D3/ DATA PCBAR,TCK,ROCKM3/4.495D1,3.8665D2,3.650D2/ DATA VMINT,TMAXT,TLCK,VMAXT/0.8722E-3,453.2,173.0,5.75/ C IF(PBAR0.LT.0.009.OR.PBAR0.GT.45.1) GO TO 40 IF(S.LT.0.5E3.OR.S.GT.3.2E3) GO TO 40 IF(ABS(PBAR0-44.95).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=F40J16(PBAR0) TSP=TDGC IF(TDGC.LT.-101.0) GO TO 40 C SDP=F37J16(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=F53J16(TMAX) TSP=(TMAX+273.15-TLCK)/50.0 DO 6 I=1,50 TDGC=TMAX-I*TSP VDP=F53J16(TDGC) SDP=G05J16(VDP,TDGC) IF(SDP.LT.0.001) GO TO 6 IF(SDP.LT.S) GO TO 7 6 CONTINUE 7 TMIN=TDGC VX=F51J16(PBAR0,TDGC) IF(VX.GT.VDPMAX.OR.VX.LT.VMINT) VX=VDP SX=G05J16(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=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 71 SX=G05J16(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=F53J16(TLCK-273.15) SDP=G05J16(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=F51J16(PBAR0,TMIN) IF(VX.LT.VMINT.OR.VX.GT.VMAXT) THEN GO TO 717 END IF C C SX=G05J16(VX,TMIN) C**************** C IF(ABS(SX/S-1.0).LT.1.0E-6) GO TO 32 C TDGC=SNGL(TCK)-273.15 VX=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) THEN GO TO 717 END IF SX=G05J16(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=F53J16(TDGC) SDP=G05J16(VDP,TDGC) IF(SDP.GT.S) GO TO 11 10 CONTINUE 11 TMIN=TDGC-TSP VX=F51J16(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) THEN GO TO 716 END IF VX=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT.OR.VX.GT.VCM3K) GO TO 712 IF(TDGC.GT.TCC) THEN SX=G05J16(VX,TDGC) ELSE SX=G05J16(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=G05J16(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=F51J16(PBAR0,TDGC) IF(VX.LT.0.995*VMINT) GO TO 711 SX=G05J16(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=F51J16(PBAR0,TDGC) SX=G05J16(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=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 50 SX=G05J16(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=F54J16(TDGC) IF(VDDP.LT.VCM3K) GO TO 50 SDDP=G05J16(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=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 134 SX=G05J16(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=F51J16(PBAR0,TMIN) IF(VX.LT.VMINT) THEN TMIN=TLCK-273.15 VX=F51J16(PBAR0,TMIN) IF(VX.LT.VMINT) GO TO 40 END IF SX=G05J16(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=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 131 S2=G05J16(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=F51J16(PBAR0,TMIN) S1=G05J16(VX,TMIN) VX=F51J16(PBAR0,TMAX) S2=G05J16(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 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=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 143 SX=G05J16(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=F40J16(PBAR0) IF(TDGC.LT.234.5-273.15) GO TO 50 VDDP=F54J16(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G05J16(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=F54J16(TDGC) IF(VDDP.LT.1.0/SNGL(ROCKM3) ) GO TO 50 HDDP=G05J16(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=F51J16(PBAR0,TDGC) SX=G05J16(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=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 264 SW=G05J16(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=F51J16(PBAR0,TDGC) SX=G05J16(VX,TDGC) IF(SX.GT.S) GO TO 40 C OUT OF RANGE S1=SX TDGC=TMAX VX=F51J16(PBAR0,TDGC) SX=G05J16(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=F51J16(PBAR0,TDGC) IF(VX.LT.VMINT) GO TO 267 SX=G05J16(VX,TDGC) IF(SX.LT.0.1) GO TO 267 IF(ABS(SX/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 IF(TMAX.GT.TMIN) GO TO 26 END IF 267 CONTINUE C 26 IC=0 27 TDGC=(TMIN+TMAX)*0.5 28 VX=F51J16(PBAR0,TDGC) SW=G05J16(VX,TDGC) IF(ABS(SW/S-1.0).LT.1.0E-6) THEN PST=G01J16(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=F51J16(PBAR0,TDGC) IF(VX.LT.0.49E-3) GO TO 282 TSP=G01J16(VX,TDGC) IF(TSP.LT.0.21) GO TO 282 SW=G05J16(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=F51J16(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=G02J16(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 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