C ************************************* C * PROPATH FOR * C * 1999 JSME STEAM TABLES * C * BASED ON IAPWS-IF97 * C * * C * VERSION 12.1 * C * CODED (FEBRUARY 2001) * C * * C * BY * C * TOMOHIRO HONDA * C * (FUKUOKA UNIVERSITY) * C * FUKUOKA 814-0180, JAPAN * C ************************************* C ************************************* C * SUPERVISOR FOR * C * 1999 JSME STEAM TABLES * C * BASED ON IAPWS-IF97 * C * CODED (FEBRUARY 2001) * C ************************************* C------------------------------------------------- F1 = AIPPT FUNCTION AIPPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F1D09 C--- FUNCTION NAME - DATA FUN/'AIPPT'/ C--- SET OF UNIT - PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL - FF = REAL(F1D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - AIPPT=FF RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F94D09 C--- FUNCTION NAME -- DATA FUN/'AJTPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F94D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AJTPT=FF RETURN END C------------------------------------------------- F8A = AKPD FUNCTION AKPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F8AD09 C--- FUNCTION NAME -- DATA FUN/'AKPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F8AD09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AKPD=FF RETURN END C------------------------------------------------- F8B = AKPDD FUNCTION AKPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F8BD09 C--- FUNCTION NAME -- DATA FUN/'AKPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F8BD09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AKPDD=FF RETURN END C------------------------------------------------- F82 = AKPT FUNCTION AKPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F82D09 C--- FUNCTION NAME -- DATA FUN/'AKPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F82D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AKPT=FF RETURN END C------------------------------------------------- F8C = AKTD FUNCTION AKTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F8CD09 C--- FUNCTION NAME -- DATA FUN/'AKTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F8CD09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AKTD=FF RETURN END C------------------------------------------------- F8D = AKTDD FUNCTION AKTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F8DD09 C--- FUNCTION NAME -- DATA FUN/'AKTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F8DD09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AKTDD=FF RETURN END C------------------------------------------------- F2 = ALAPP FUNCTION ALAPP(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F2D09 C--- FUNCTION NAME -- DATA FUN/'ALAPP'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F2D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALAPP=FF RETURN END C------------------------------------------------- F3 = ALAPT FUNCTION ALAPT(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F3D09 C--- FUNCTION NAME -- DATA FUN/'ALAPT'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F3D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALAPT=FF RETURN END C------------------------------------------------- F4 = ALHP FUNCTION ALHP(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F4D09 C--- FUNCTION NAME -- DATA FUN/'ALHP'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F4D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALHP=FF RETURN END C------------------------------------------------- F5 = ALHT FUNCTION ALHT(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F5D09 C--- FUNCTION NAME -- DATA FUN/'ALHT'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F5D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALHT=FF RETURN END C------------------------------------------------- F6 = ALMPD FUNCTION ALMPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F6D09 C--- FUNCTION NAME -- DATA FUN/'ALMPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F6D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMPD=FF RETURN END C------------------------------------------------- F7 = ALMPDD FUNCTION ALMPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F7D09 C--- FUNCTION NAME -- DATA FUN/'ALMPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F7D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMPDD=FF RETURN END C------------------------------------------------- F8 = ALMPT FUNCTION ALMPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F8D09 C--- FUNCTION NAME -- DATA FUN/'ALMPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F8D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMPT=FF RETURN END C------------------------------------------------- F9 = ALMTD FUNCTION ALMTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F9D09 C--- FUNCTION NAME -- DATA FUN/'ALMTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F9D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMTD=FF RETURN END C------------------------------------------------- F10 = ALMTDD FUNCTION ALMTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F10D09 C--- FUNCTION NAME -- DATA FUN/'ALMTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F10D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- ALMTDD=FF RETURN END C------------------------------------------------- F11 = AMUPD FUNCTION AMUPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F11D09 C--- FUNCTION NAME -- DATA FUN/'AMUPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F11D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUPD=FF RETURN END C------------------------------------------------- F12 = AMUPDD FUNCTION AMUPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F12D09 C--- FUNCTION NAME -- DATA FUN/'AMUPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F12D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUPDD=FF RETURN END C------------------------------------------------- F13 = AMUPT FUNCTION AMUPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F13D09 C--- FUNCTION NAME -- DATA FUN/'AMUPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F13D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUPT=FF RETURN END C------------------------------------------------- F14 = AMUTD FUNCTION AMUTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F14D09 C--- FUNCTION NAME -- DATA FUN/'AMUTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F14D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUTD=FF RETURN END C------------------------------------------------- F15 = AMUTDD FUNCTION AMUTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F15D09 C--- FUNCTION NAME -- DATA FUN/'AMUTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F15D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- AMUTDD=FF RETURN END C------------------------------------------------- F92 = BPPT FUNCTION BPPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F92D09 C--- FUNCTION NAME -- DATA FUN/'BPPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F92D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- BPPT=FF RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F90D09 C--- FUNCTION NAME -- DATA FUN/'BSPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F90D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- BSPT=FF RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F91D09 C--- FUNCTION NAME -- DATA FUN/'BTPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F91D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- BTPT=FF RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F93D09 C--- FUNCTION NAME -- DATA FUN/'BVPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F93D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- BVPT=FF RETURN END C------------------------------------------------- F16 = CPPD FUNCTION CPPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F16D09 C--- FUNCTION NAME -- DATA FUN/'CPPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F16D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPPD=FF RETURN END C------------------------------------------------- F17 = CPPDD FUNCTION CPPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F17D09 C--- FUNCTION NAME -- DATA FUN/'CPPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F17D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPPDD=FF RETURN END C------------------------------------------------- F18 = CPPT FUNCTION CPPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F18D09 C--- FUNCTION NAME -- DATA FUN/'CPPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F18D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPPT=FF RETURN END C------------------------------------------------- F19 = CPTD FUNCTION CPTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F19D09 C--- FUNCTION NAME -- DATA FUN/'CPTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F19D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPTD=FF RETURN END C------------------------------------------------- F20 = CPTDD FUNCTION CPTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F20D09 C--- FUNCTION NAME -- DATA FUN/'CPTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F20D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CPTDD=FF RETURN END C------------------------------------------------- F21 = CRP FUNCTION CRP(A) CHARACTER FUN*6,A*1 REAL T0K,PBAR,FF DOUBLE PRECISION G98D09,G99D09,F21D09 C--- FUNCTION NAME -- DATA FUN/'CRP'/ C--- SET OF UNIT -- C--- FUNCTION CALL -- FF = REAL(F21D09(A)) C--- LEVEL 2 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ', & ' WATER(IAPWS-IF97) WHEN A=',A,' ****') CRP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- IF(A.EQ.'T') THEN T0K=REAL(G99D09(0.0D+00)) FF=FF-T0K ELSE IF(A.EQ.'P') THEN PBAR=REAL(G98D09(1.0D+00)) FF=FF/PBAR END IF CRP=FF RETURN END C------------------------------------------------- F7A = CVPD FUNCTION CVPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F7AD09 C--- FUNCTION NAME -- DATA FUN/'CVPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F7AD09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVPD=FF RETURN END C------------------------------------------------- F76 = CVPDD FUNCTION CVPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F76D09 C--- FUNCTION NAME -- DATA FUN/'CVPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F76D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVPDD=FF RETURN END C------------------------------------------------- F77 = CVPT FUNCTION CVPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F77D09 C--- FUNCTION NAME -- DATA FUN/'CVPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F77D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVPT=FF RETURN END C------------------------------------------------- F7B = CVTD FUNCTION CVTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F7BD09 C--- FUNCTION NAME -- DATA FUN/'CVTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F7BD09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVTD=FF RETURN END C------------------------------------------------- F78 = CVTDD FUNCTION CVTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F78D09 C--- FUNCTION NAME -- DATA FUN/'CVTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F78D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- CVTDD=FF RETURN END C------------------------------------------------- F2A = EPSPD FUNCTION EPSPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F2AD09 C--- FUNCTION NAME -- DATA FUN/'EPSPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F2AD09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- EPSPD=FF RETURN END C------------------------------------------------- F76 = EPSPDD FUNCTION EPSPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F2BD09 C--- FUNCTION NAME -- DATA FUN/'EPSPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F2BD09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- EPSPDD=FF RETURN END C------------------------------------------------- F22 = EPSPT FUNCTION EPSPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F22D09 C--- FUNCTION NAME -- DATA FUN/'EPSPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F22D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- EPSPT=FF RETURN END C------------------------------------------------- F2C = EPSTD FUNCTION EPSTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F2CD09 C--- FUNCTION NAME -- DATA FUN/'EPSTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F2CD09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- EPSTD=FF RETURN END C------------------------------------------------- F2D = EPSTDD FUNCTION EPSTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F2DD09 C--- FUNCTION NAME -- DATA FUN/'EPSTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F2DD09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- EPSTDD=FF RETURN END C------------------------------------------------- F89 = FC C************************************************ C FUNCTION FOR FUNDDAMENTAL CONSTANTS C PROPATH VER.7.1, MAY 8, 1990 C USAGE: B=FC(A) C A, B : CHARACTER TYPE VALIABLES C B='18.0152' WHEN A='M' C B='461.52' WHEN A='R' C************************************************ FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=18.015268 ELSE IF (A.EQ.'R') THEN FC=461.526 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR WATER(IAPWS-IF97) WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C-------------------------------------------------- F9A = GAMPD FUNCTION GAMPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F9AD09 C--- FUNCTION NAME - DATA FUN/'GAMPD'/ C--- SET OF UNIT - PI=G98D09(DBLE(P)) C--- FUNCTION CALL - FF = REAL(F9AD09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPD=FF RETURN END C-------------------------------------------------- F96 = GAMPDD FUNCTION GAMPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F96D09 C--- FUNCTION NAME - DATA FUN/'GAMPDD'/ C--- SET OF UNIT - PI=G98D09(DBLE(P)) C--- FUNCTION CALL - FF = REAL(F96D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPDD=FF RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F95D09 C--- FUNCTION NAME - DATA FUN/'GAMPT'/ C--- SET OF UNIT - PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL - FF = REAL(F95D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMPT=FF RETURN END C------------------------------------------------- F9B = GAMTD FUNCTION GAMTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F9BD09 C--- FUNCTION NAME - DATA FUN/'GAMTD'/ C--- SET OF UNIT - TI=G99D09(DBLE(T)) C--- FUNCTION CALL - FF = REAL(F9BD09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMTD=FF RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F97D09 C--- FUNCTION NAME - DATA FUN/'GAMTDD'/ C--- SET OF UNIT - TI=G99D09(DBLE(T)) C--- FUNCTION CALL - FF = REAL(F97D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION - GAMTDD=FF RETURN END C------------------------------------------------- F23 = HPD FUNCTION HPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F23D09 C--- FUNCTION NAME -- DATA FUN/'HPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F23D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPD=FF RETURN END C------------------------------------------------- F24 = HPDD FUNCTION HPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F24D09 C--- FUNCTION NAME -- DATA FUN/'HPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F24D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPDD=FF RETURN END C------------------------------------------------- F71 = HPS FUNCTION HPS(P,S) CHARACTER FUN*6 REAL P,S,FF DOUBLE PRECISION PI,G98D09,F71D09 C--- FUNCTION NAME -- DATA FUN/'HPS'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F71D09(PI,DBLE(S))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPS=FF RETURN END C------------------------------------------------- F25 = HPT FUNCTION HPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F25D09 C--- FUNCTION NAME -- DATA FUN/'HPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F25D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPT=FF RETURN END C------------------------------------------------- F26 = HPX FUNCTION HPX(P,X) CHARACTER FUN*6 REAL P,X,FF DOUBLE PRECISION PI,G98D09,F26D09 C--- FUNCTION NAME -- DATA FUN/'HPX'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F26D09(PI,DBLE(X))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HPX=FF RETURN END C------------------------------------------------- F27 = HTD FUNCTION HTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F27D09 C--- FUNCTION NAME -- DATA FUN/'HTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F27D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HTD=FF RETURN END C------------------------------------------------- F28 = HTDD FUNCTION HTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F28D09 C--- FUNCTION NAME -- DATA FUN/'HTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F28D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- HTDD=FF RETURN END C------------------------------------------------- F29 = HTX FUNCTION HTX(T,X) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F29D09 C--- FUNCTION NAME -- DATA FUN/'HTX'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F29D09(TI,DBLE(X))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,T,X,'T','X',FUN) 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, FEB, 2001 C USAGE: B=IDENTF(A) C A, B : CHARACTER TYPE VALIABLES C B='WATER(IAPWS 2001)' WHEN A='S' C B='H2O' 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='WATER(IAPWS-IF97)' ELSE IF (A.EQ.'C') THEN IDENTF='H2O' ELSE IF (A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR H2O(IAPWS-IF97) WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F66 = PLDT FUNCTION PLDT(T) CHARACTER FUN*6 DATA FUN/'PLDT'/ CALL S99D09(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT FUNCTION PMLT(T) CHARACTER FUN*6 DATA FUN/'PMLT'/ CALL S99D09(FUN) PMLT=-1.0E+30 RETURN END C------------------------------------------------- F85 = PRPD FUNCTION PRPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F85D09 C--- FUNCTION NAME -- DATA FUN/'PRPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F85D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRPD=FF RETURN END C------------------------------------------------- F86 = PRPDD FUNCTION PRPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F86D09 C--- FUNCTION NAME -- DATA FUN/'PRPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F86D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRPDD=FF RETURN END C------------------------------------------------- F81 = PRPT FUNCTION PRPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F81D09 C--- FUNCTION NAME -- DATA FUN/'PRPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F81D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRPT=FF RETURN END C------------------------------------------------- F87 = PRTD FUNCTION PRTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F87D09 C--- FUNCTION NAME -- DATA FUN/'PRTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F87D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRTD=FF RETURN END C------------------------------------------------- F88 = PRTDD FUNCTION PRTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F88D09 C--- FUNCTION NAME -- DATA FUN/'PRTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F88D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PRTDD=FF RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 DATA FUN/'PSBT'/ CALL S99D09(FUN) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F30 = PST FUNCTION PST(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION G98D09,TI,G99D09,F30D09,DFF,DPBAR C--- FUNCTION NAME -- DATA FUN/'PST'/ C--- SET OF UNIT -- DPBAR=G98D09(1.00000000000D+00) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- DFF = F30D09(TI) FF = REAL(DFF) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) PST=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) PST=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- PST=REAL(DFF/DPBAR) RETURN END C------------------------------------------------- F72 = PSTD FUNCTION PSTD(T) CHARACTER FUN*6 DATA FUN/'PSTD'/ CALL S99D09(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD FUNCTION PSTDD(T) CHARACTER FUN*6 DATA FUN/'PSTDD'/ CALL S99D09(FUN) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F31 = SIGP FUNCTION SIGP(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F31D09 C--- FUNCTION NAME -- DATA FUN/'SIGP'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F31D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSEIF (FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SIGP=FF RETURN END C------------------------------------------------- F32 = SIGT FUNCTION SIGT(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F32D09 C--- FUNCTION NAME -- DATA FUN/'SIGT'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F32D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF (FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSEIF (FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SIGT=FF RETURN END C------------------------------------------------- F33 = SPD FUNCTION SPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F33D09 C--- FUNCTION NAME -- DATA FUN/'SPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F33D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPD=FF RETURN END C------------------------------------------------- F34 = SPDD FUNCTION SPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F34D09 C--- FUNCTION NAME -- DATA FUN/'SPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F34D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPDD=FF RETURN END C------------------------------------------------- F35 = SPT FUNCTION SPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F35D09 C--- FUNCTION NAME -- DATA FUN/'SPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F35D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPT=FF RETURN END C------------------------------------------------- F36 = SPX FUNCTION SPX(P,X) CHARACTER FUN*6 REAL P,X,FF DOUBLE PRECISION PI,G98D09,F36D09 C--- FUNCTION NAME -- DATA FUN/'SPX'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F36D09(PI,DBLE(X))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- SPX=FF RETURN END C------------------------------------------------- F37 = STD FUNCTION STD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F37D09 C--- FUNCTION NAME -- DATA FUN/'STD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F37D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- STD=FF RETURN END C------------------------------------------------- F38 = STDD FUNCTION STDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F38D09 C--- FUNCTION NAME -- DATA FUN/'STDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F38D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- STDD=FF RETURN END C------------------------------------------------- F39 = STX FUNCTION STX(T,X) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F39D09 C--- FUNCTION NAME -- DATA FUN/'STX'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F39D09(TI,DBLE(X))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,T,X,'T','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- STX=FF RETURN END C------------------------------------------------- F67 = TLDP FUNCTION TLDP(P) CHARACTER FUN*6 DATA FUN/'TLDP'/ CALL S99D09(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP FUNCTION TMLP(P) CHARACTER FUN*6 DATA FUN/'TMLP'/ CALL S99D09(FUN) TMLP=-1.0E+30 RETURN END C------------------------------------------------- F64 = TPH FUNCTION TPH(P,H) CHARACTER FUN*6 REAL T0K,P,H,FF DOUBLE PRECISION PI,G98D09,G99D09,F64D09 C--- FUNCTION NAME -- DATA FUN/'TPH'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) T0K=REAL(G99D09(0.0D+00)) C--- FUNCTION CALL -- FF = REAL(F64D09(PI,DBLE(H))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) TPH=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,H,'P','H',FUN) TPH=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPH=FF-T0K RETURN END C------------------------------------------------- F64 = TPH2 FUNCTION TPH2(P,H) CHARACTER FUN*6 REAL T0K,P,H,FF DOUBLE PRECISION PI,G98D09,G99D09,F6HD09 C--- FUNCTION NAME -- DATA FUN/'TPH2'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) T0K=REAL(G99D09(0.0D+00)) C--- FUNCTION CALL -- FF = REAL(F6HD09(PI,DBLE(H))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) TPH2=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,H,'P','H',FUN) TPH2=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPH2=FF-T0K RETURN END C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) CHARACTER FUN*6 DATA FUN/'TPSEUP'/ CALL S99D09(FUN) TPSEUP=-1.0E+30 RETURN END C------------------------------------------------- F65 = TPS FUNCTION TPS(P,S) CHARACTER FUN*6 REAL T0K,P,S,FF DOUBLE PRECISION PI,G98D09,G99D09,F65D09 C--- FUNCTION NAME -- DATA FUN/'TPS'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) T0K=REAL(G99D09(0.0D+00)) C--- FUNCTION CALL -- FF = REAL(F65D09(PI,DBLE(S))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) TPS=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,S,'P','S',FUN) TPS=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPS=FF-T0K RETURN END C------------------------------------------------- F6H = TPS FUNCTION TPS2(P,S) CHARACTER FUN*6 REAL T0K,P,S,FF DOUBLE PRECISION PI,G98D09,G99D09,F6SD09 C--- FUNCTION NAME -- DATA FUN/'TPS2'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) T0K=REAL(G99D09(0.0D+00)) C--- FUNCTION CALL -- FF = REAL(F6SD09(PI,DBLE(S))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) TPS2=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,S,'P','S',FUN) TPS2=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPS2=FF-T0K RETURN END C------------------------------------------------- F70 = TPV FUNCTION TPV(P,V) CHARACTER FUN*6 REAL T0K,P,V,FF DOUBLE PRECISION PI,G98D09,G99D09,F70D09 C--- FUNCTION NAME -- DATA FUN/'TPV'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) T0K=REAL(G99D09(0.0D+00)) C--- FUNCTION CALL -- FF = REAL(F70D09(PI,DBLE(V))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) TPV=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,V,'P','V',FUN) TPV=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TPV=FF-T0K RETURN END C------------------------------------------------- F41 = TRPL FUNCTION TRPL(A) CHARACTER FUN*6,A*1 REAL T0K,PBAR,FF DOUBLE PRECISION G98D09,G99D09,F41D09 C--- FUNCTION NAME -- DATA FUN/'TRPL'/ C--- SET OF UNIT -- C--- FUNCTION CALL -- FF = REAL(F41D09(A)) C--- LEVEL 2 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+20) THEN WRITE(6,6010) FUN,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ', & ' WATER(IAPWS-IF97) WHEN A=',A,' ****') TRPL=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- IF(A.EQ.'T') THEN T0K=REAL(G99D09(0.0D+00)) FF=FF-T0K ELSE IF(A.EQ.'P') THEN PBAR=REAL(G98D09(1.0D+00)) FF=FF/PBAR END IF TRPL=FF RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 DATA FUN/'TSBP'/ CALL S99D09(FUN) TSBP=-1.0E+30 RETURN END C------------------------------------------------- F40 = TSP FUNCTION TSP(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,G99D09,F40D09,DT0K,DFF C--- FUNCTION NAME -- DATA FUN/'TSP'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) DT0K=G99D09(0.0D+00) C--- FUNCTION CALL -- DFF = F40D09(PI) FF = REAL(DFF) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) TSP=-1.0E+10 RETURN C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) TSP=-1.0E+20 RETURN END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- TSP=REAL(DFF-DT0K) RETURN END C------------------------------------------------- F74 = TSPD FUNCTION TSPD(P) CHARACTER FUN*6 DATA FUN/'TSPD'/ CALL S99D09(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD FUNCTION TSPDD(P) CHARACTER FUN*6 DATA FUN/'TSPDD'/ CALL S99D09(FUN) TSPDD=-1.0E+30 RETURN END C------------------------------------------------- F42 = UPD FUNCTION UPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F42D09 C--- FUNCTION NAME -- DATA FUN/'UPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F42D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPD=FF RETURN END C------------------------------------------------- F43 = UPDD FUNCTION UPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F43D09 C--- FUNCTION NAME -- DATA FUN/'UPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F43D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPDD=FF RETURN END C------------------------------------------------- F79 = UPS FUNCTION UPS(P,S) CHARACTER FUN*6 REAL P,S,FF DOUBLE PRECISION PI,G98D09,F79D09 C--- FUNCTION NAME -- DATA FUN/'UPS'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F79D09(PI,DBLE(S))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPS=FF RETURN END C------------------------------------------------- F44 = UPT FUNCTION UPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F44D09 C--- FUNCTION NAME -- DATA FUN/'UPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F44D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPT=FF RETURN END C------------------------------------------------- F45 = UPX FUNCTION UPX(P,X) CHARACTER FUN*6 REAL P,X,FF DOUBLE PRECISION PI,G98D09,F45D09 C--- FUNCTION NAME -- DATA FUN/'UPX'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F45D09(PI,DBLE(X))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UPX=FF RETURN END C------------------------------------------------- F46 = UTD FUNCTION UTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F46D09 C--- FUNCTION NAME -- DATA FUN/'UTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F46D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UTD=FF RETURN END C------------------------------------------------- F47 = UTDD FUNCTION UTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F47D09 C--- FUNCTION NAME -- DATA FUN/'UTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F47D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UTDD=FF RETURN END C------------------------------------------------- F48 = UTX FUNCTION UTX(T,X) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F48D09 C--- FUNCTION NAME -- DATA FUN/'UTX'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F48D09(TI,DBLE(X))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,T,X,'T','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- UTX=FF RETURN END C------------------------------------------------- F49 = VPD FUNCTION VPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F49D09 C--- FUNCTION NAME -- DATA FUN/'VPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F49D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPD=FF RETURN END C------------------------------------------------- F50 = VPDD FUNCTION VPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F50D09 C--- FUNCTION NAME -- DATA FUN/'VPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F50D09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPDD=FF RETURN END C------------------------------------------------- F80 = VPS FUNCTION VPS(P,S) CHARACTER FUN*6 REAL P,S,FF DOUBLE PRECISION PI,G98D09,F80D09 C--- FUNCTION NAME -- DATA FUN/'VPS'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F80D09(PI,DBLE(S))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPS=FF RETURN END C------------------------------------------------- F51 = VPT FUNCTION VPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F51D09 C--- FUNCTION NAME -- DATA FUN/'VPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F51D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPT=FF RETURN END C------------------------------------------------- F52 = VPX FUNCTION VPX(P,X) CHARACTER FUN*6 REAL P,X,FF DOUBLE PRECISION PI,G98D09,F52D09 C--- FUNCTION NAME -- DATA FUN/'VPX'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F52D09(PI,DBLE(X))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,X,'P','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VPX=FF RETURN END C------------------------------------------------- F53 = VTD FUNCTION VTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F53D09 C--- FUNCTION NAME -- DATA FUN/'VTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F53D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VTD=FF RETURN END C------------------------------------------------- F54 = VTDD FUNCTION VTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F54D09 C--- FUNCTION NAME -- DATA FUN/'VTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F54D09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VTDD=FF RETURN END C------------------------------------------------- F55 = VTX FUNCTION VTX(T,X) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F55D09 C--- FUNCTION NAME -- DATA FUN/'VTX'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F55D09(TI,DBLE(X))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,T,X,'T','X',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- VTX=FF RETURN END C------------------------------------------------- F8E = WPD FUNCTION WPD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F8ED09 C--- FUNCTION NAME -- DATA FUN/'WPD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F8ED09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- WPD=FF RETURN END C------------------------------------------------- F8F = WPDD FUNCTION WPDD(P) CHARACTER FUN*6 REAL P,FF DOUBLE PRECISION PI,G98D09,F8FD09 C--- FUNCTION NAME -- DATA FUN/'WPDD'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F8FD09(PI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(1,P,P,'P','P',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- WPDD=FF RETURN END C------------------------------------------------- F83 = WPT FUNCTION WPT(P,T) CHARACTER FUN*6 REAL P,T,FF DOUBLE PRECISION PI,G98D09,TI,G99D09,F83D09 C--- FUNCTION NAME -- DATA FUN/'WPT'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F83D09(PI,TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,T,'P','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- WPT=FF RETURN END C------------------------------------------------- F8C = WTD FUNCTION WTD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F8GD09 C--- FUNCTION NAME -- DATA FUN/'WTD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F8GD09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- WTD=FF RETURN END C------------------------------------------------- F8H = WTDD FUNCTION WTDD(T) CHARACTER FUN*6 REAL T,FF DOUBLE PRECISION TI,G99D09,F8HD09 C--- FUNCTION NAME -- DATA FUN/'WTDD'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F8HD09(TI)) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(2,T,T,'T','T',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- WTDD=FF RETURN END C------------------------------------------------- F56 = XPH FUNCTION XPH(P,H) CHARACTER FUN*6 REAL P,H,FF DOUBLE PRECISION PI,G98D09,F56D09 C--- FUNCTION NAME -- DATA FUN/'XPH'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F56D09(PI,DBLE(H))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,H,'P','H',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPH=FF RETURN END C------------------------------------------------- F57 = XPS FUNCTION XPS(P,S) CHARACTER FUN*6 REAL P,S,FF DOUBLE PRECISION PI,G98D09,F57D09 C--- FUNCTION NAME -- DATA FUN/'XPS'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F57D09(PI,DBLE(S))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,S,'P','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPS=FF RETURN END C------------------------------------------------- F58 = XPU FUNCTION XPU(P,U) CHARACTER FUN*6 REAL P,U,FF DOUBLE PRECISION PI,G98D09,F58D09 C--- FUNCTION NAME -- DATA FUN/'XPU'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F58D09(PI,DBLE(U))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,U,'P','U',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPU=FF RETURN END C------------------------------------------------- F59 = XPV FUNCTION XPV(P,V) CHARACTER FUN*6 REAL P,V,FF DOUBLE PRECISION PI,G98D09,F59D09 C--- FUNCTION NAME -- DATA FUN/'XPV'/ C--- SET OF UNIT -- PI=G98D09(DBLE(P)) C--- FUNCTION CALL -- FF = REAL(F59D09(PI,DBLE(V))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,P,V,'P','V',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XPV=FF RETURN END C------------------------------------------------- F60 = XTH FUNCTION XTH(T,H) CHARACTER FUN*6 REAL T,H,FF DOUBLE PRECISION TI,G99D09,F60D09 C--- FUNCTION NAME -- DATA FUN/'XTH'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F60D09(TI,DBLE(H))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,T,H,'T','H',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XTH=FF RETURN END C------------------------------------------------- F61 = XTS FUNCTION XTS(T,S) CHARACTER FUN*6 REAL T,S,FF DOUBLE PRECISION TI,G99D09,F61D09 C--- FUNCTION NAME -- DATA FUN/'XTS'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F61D09(TI,DBLE(S))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,T,S,'T','S',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XTS=FF RETURN END C------------------------------------------------- F62 = XTU FUNCTION XTU(T,U) CHARACTER FUN*6 REAL T,U,FF DOUBLE PRECISION TI,G99D09,F62D09 C--- FUNCTION NAME -- DATA FUN/'XTU'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F62D09(TI,DBLE(U))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,T,U,'T','U',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XTU=FF RETURN END C------------------------------------------------- F63 = XTV FUNCTION XTV(T,V) CHARACTER FUN*6 REAL T,V,FF DOUBLE PRECISION TI,G99D09,F63D09 C--- FUNCTION NAME -- DATA FUN/'XTV'/ C--- SET OF UNIT -- TI=G99D09(DBLE(T)) C--- FUNCTION CALL -- FF = REAL(F63D09(TI,DBLE(V))) C--- LEVEL 1 ERROR CHECK & MESSAGE -- IF(FF.EQ.-1.0E+10) THEN CALL S97D09(FUN) C--- LEVEL 2 ERROR CHECK & MESSAGE -- ELSE IF(FF.EQ.-1.0E+20) THEN CALL S98D09(3,T,V,'T','V',FUN) END IF C--- SUBSTITUTION OF THE VALUE INTO THE FUNCTION -- XTV=FF RETURN END C------------------------------------------------- G98 C *** FUNCTION FOR SETTING UNITS **** FOR IF97 H20 DOUBLE PRECISION FUNCTION G98D09(P) DOUBLE PRECISION P,PBAR INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF(KPA .EQ. 1) THEN PBAR=1.000000000000D+05 ELSE IF(KPA .EQ. 2) THEN PBAR=1.000000000000D+05 ELSE IF(KPA .EQ. 3) THEN PBAR=1.000000000000D+00 ELSE PBAR=1.000000000000D+00 END IF G98D09=P*PBAR RETURN END C------------------------------------------------- G99 C *** FUNCTION FOR SETTING UNITS **** FOR IF97 H20 DOUBLE PRECISION FUNCTION G99D09(T) DOUBLE PRECISION T,T0C INTEGER KPA,MESS COMMON/UNIT/KPA,MESS IF(KPA .EQ. 1) THEN T0C=273.150000000000D+00 ELSE IF(KPA .EQ. 2) THEN T0C=0.000000000000D+00 ELSE IF(KPA .EQ. 3) THEN T0C=273.150000000000D+00 ELSE T0C=0.000000000000D+00 END IF G99D09=T+T0C RETURN END C------------------------------------------------- S97 C *** LEVEL 1 ERROR MESSAGE -- FOR IF97 H2O SUBROUTINE S97D09(FUN) CHARACTER FLUID*17,FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FLUID/'WATER(IAPWS-IF97)'/ IF (MESS.NE.0) THEN WRITE(6,1000) FUN,FLUID 1000 FORMAT(1H ,5X,'**** NO CONVERGENCE AT ',A6,' FOR ', & A17,' ****') ENDIF RETURN END C------------------------------------------------- S98 C *** LEVEL 2 ERROR MESSAGE -- FOR IF97 H2O SUBROUTINE S98D09(IPT,P,T,N1,N2,FUN) CHARACTER FLUID*17,FUN*6,N1*1,N2*1 REAL P,T INTEGER KPA,MESS,IPT COMMON/UNIT/KPA,MESS DATA FLUID/'WATER(IAPWS-IF97)'/ IF (MESS.NE.0) THEN IF (IPT.EQ.1) THEN C--- FUN(P) TYPE WRITE(6,6010) FUN,FLUID,P 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A17, & ' WHEN P =',1PE14.7,' ****') C--- FUN(T) TYPE ELSEIF (IPT.EQ.2) THEN WRITE(6,6020) FUN,FLUID,T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A17, & ' WHEN T =',1PE14.7,' ****') C--- FUN(P,T) TYPE ELSE WRITE(6,6030) FUN,FLUID,N1,P,N2,T 6030 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR ',A17, & ' WHEN ',A1,'=',1PE14.7,' AND ',A1,'=',1PE14.7,' ****') ENDIF ENDIF RETURN END C------------------------------------------------- S99 C *** LEVEL 3 ERROR MESSAGE -- FOR IF97 H2O SUBROUTINE S99D09(FUN) CHARACTER FLUID*17,FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA FLUID/'WATER(IAPWS-IF97)'/ IF (MESS.NE.0) THEN WRITE(6,1000) FUN,FLUID 1000 FORMAT(1H ,5X,'**** FUNCTION ',A6,' UNAVAILABLE FOR ', & A17,' ****') ENDIF RETURN END C ************************************* C * FUNCTION PROGRAMS FOR * C * 1999 JSME STEAM TABLES * C * BASED ON IAPWS-IF97 * C * * C * PROGRAM NAME * C * JH20IJ97.F90 VERSION 1.0 * C * * C * PROPATH VERSION 12.1 * C * CODED (FEBRUARY 2001) * C * * C * BY * C * TOMOHIRO HONDA * C * (FUKUOKA UNIVERSITY) * C * FUKUOKA 814-0180, JAPAN * C ************************************* C F01 + ION PRODUCT (MOL/KG)**2 AT P AND T DOUBLE PRECISION FUNCTION F1D09(P,T) DOUBLE PRECISION P,T,A,B,C,D,E,F,G DOUBLE PRECISION V,F51D09,ROGRAM,AKW DATA A,B,C,D,E,F,G/-4.098D+00,-3.2452D+03, 2.2362D+05, * -3.984D+07, 1.3957D+01,-1.2623D+03, 8.5641D+05/ C INTEGER G91D09,IR IF (P .LT. 0.1D+06 .OR. T .GT. 1273.15D+00) THEN F1D09=-1.0D+20 ELSE V=F51D09(P,T) IF (V. LT. 0.0D+00) THEN F1D09=-V ELSE ROGRAM=1.0D-03/V AKW=A+(B+(C+D/T)/T)/T+(E+(F+G/T)/T)*DLOG10(ROGRAM) F1D09=10.0**AKW ENDIF ENDIF RETURN END C F02 + LAPLACE COEFFICIENT AT P DOUBLE PRECISION FUNCTION F2D09(P) DOUBLE PRECISION P,F32D09,SIG,T,RL,RV DOUBLE PRECISION GN DATA GN/9.80665D+00/ IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F2D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) IF (RL .EQ. RV) THEN F2D09=-1.0D+20 ELSE SIG=F32D09(T) F2D09=DSQRT(SIG/GN/(RL-RV)) ENDIF ENDIF RETURN END C F03 + LAPLACE COEFFICIENT AT T DOUBLE PRECISION FUNCTION F3D09(T) DOUBLE PRECISION T,F32D09,SIG,P,RL,RV DOUBLE PRECISION GN DATA GN/9.80665D+00/ SIG=F32D09(T) IF (SIG .LE. 0.0D+00) THEN F3D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) F3D09=DSQRT(SIG/GN/(RL-RV)) ENDIF RETURN END C F04 + LATENT HEAT OF VAPORIZATION AT P DOUBLE PRECISION FUNCTION F4D09(P) DOUBLE PRECISION P,T,F40D09,F27D09,F28D09 IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F4D09=-1.0D+20 ELSE T=F40D09(P) F4D09=F28D09(T)-F27D09(T) ENDIF RETURN END C F05 + LATENT HEAT OF VAPORIZATION AT T DOUBLE PRECISION FUNCTION F5D09(T) DOUBLE PRECISION T,F27D09,F28D09 IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F5D09=-1.0D+20 ELSE F5D09=F28D09(T)-F27D09(T) ENDIF RETURN END C F06 + LUMDA OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F6D09(P) DOUBLE PRECISION P,T,RL,RV,G84D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F6D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) F6D09=G84D09(T,RL) ENDIF RETURN END C F07 + LUMDA OF SATURATED VAPOR AT P DOUBLE PRECISION FUNCTION F7D09(P) DOUBLE PRECISION P,T,RL,RV,G84D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F7D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) F7D09=G84D09(T,RV) ENDIF RETURN END C F08 + LUMDA AT P AND T DOUBLE PRECISION FUNCTION F8D09(P,T) DOUBLE PRECISION F51D09,G84D09 DOUBLE PRECISION P,T,VV,RO IF (T .GT. 1073.15D+00) THEN F8D09=-1.0D+20 ELSE VV=F51D09(P,T) IF (VV .EQ. -1.0D+20) THEN F8D09=VV ELSE RO=1.0D+00/VV F8D09=G84D09(T,RO) ENDIF ENDIF RETURN END C F09 + LUMDA OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F9D09(T) DOUBLE PRECISION T,P,RL,RV,G84D09 IF (T .LT. 273.15996D+00 .OR. T .GE. 647.096D+00) THEN F9D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) F9D09=G84D09(T,RL) ENDIF RETURN END C F10 + LUMDA OF SATURATED VAPOR AT T DOUBLE PRECISION FUNCTION F10D09(T) DOUBLE PRECISION T,P,RL,RV,G84D09 IF (T .LT. 273.15996D+00 .OR. T .GE. 647.096D+00) THEN F10D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) F10D09=G84D09(T,RV) ENDIF RETURN END C F11 + MYU OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F11D09(P) DOUBLE PRECISION P,T,RL,RV,G83D09 IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F11D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) F11D09=G83D09(T,RL) ENDIF RETURN END C F12 + MYU OF SATURATED VAPOR AT P DOUBLE PRECISION FUNCTION F12D09(P) DOUBLE PRECISION P,T,RL,RV,G83D09 IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F12D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) F12D09=G83D09(T,RV) ENDIF RETURN END C F13 + MYU AT P AND T DOUBLE PRECISION FUNCTION F13D09(P,T) DOUBLE PRECISION F51D09,G83D09 DOUBLE PRECISION P,T,VV,RO IF (T .GT. 1173.15D+00) THEN F13D09=-1.0D+20 ELSE VV=F51D09(P,T) IF (VV .EQ. -1.0D+20) THEN F13D09=-1.0D+20 ELSE RO=1.0D+00/VV F13D09=G83D09(T,RO) ENDIF ENDIF RETURN END C F14 + MYU OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F14D09(T) DOUBLE PRECISION T,P,RL,RV,G83D09 IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F14D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) F14D09=G83D09(T,RL) ENDIF RETURN END C F15 + MYU OF SATURATED VAPOR AT T DOUBLE PRECISION FUNCTION F15D09(T) DOUBLE PRECISION T,P,RL,RV,G83D09 IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F15D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) F15D09=G83D09(T,RV) ENDIF RETURN END C F16 + CP OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F16D09(P) DOUBLE PRECISION P,T,RL,RV,F19D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F16D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) F16D09=F19D09(T) ENDIF RETURN END C F17 + CP OF SATURATED VAPOUR AT P DOUBLE PRECISION FUNCTION F17D09(P) DOUBLE PRECISION P,T,RL,RV,F20D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F17D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) F17D09=F20D09(T) ENDIF RETURN END C F18 + CP AT P AND T DOUBLE PRECISION FUNCTION F18D09(P,T) DOUBLE PRECISION TSTAR1,TSTAR2,TSTAR5 DOUBLE PRECISION P,T,RO,TA,RA,G31D09 DOUBLE PRECISION TCR,RCR,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT INTEGER IR,G91D09 DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TSTAR5/1.0D+03/ DATA TCR,RCR/6.47096D+02,3.22D+02/ DATA GASCON/0.461526D+03/ IR=G91D09(P,T) IF (IR .EQ. 9 .OR. IR .EQ. 0) THEN F18D09=-1.0D+20 ELSEIF (IR .EQ. 1) THEN CALL S01D09(P,T,0,0,0,0,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F18D09=-GASCON*(TSTAR1/T)**2*GDTT ELSEIF (IR .EQ. 2) THEN CALL S02D09(P,T,0,0,0,0,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F18D09=-GASCON*(TSTAR2/T)**2*GDTT ELSEIF (IR .EQ. 3) THEN RO=G31D09(P,T) CALL S03D09(RO,T,0,1,1,1,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RO/RCR TA=TCR/T F18D09=-GASCON*TA**2*GDTT + +GASCON*(RA*GDP-RA*TA*GDPT)**2/(2.0D+00*RA*GDP+RA**2*GDPP) ELSEIF (IR .EQ. 5) THEN CALL S05D09(P,T,0,0,0,0,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F18D09=-GASCON*(TSTAR5/T)**2*GDTT ENDIF RETURN END C F19 + CP OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F19D09(T) DOUBLE PRECISION TSTAR1 DOUBLE PRECISION P,T,RL,RV,TA,RA DOUBLE PRECISION TCR,RCR,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DATA TSTAR1/1.386D+03/ DATA TCR,RCR/6.47096D+02,3.22D+02/ DATA GASCON/0.461526D+03/ IF (T .LT. 273.15996D+00 .OR. T .GE. 647.096D+00) THEN F19D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,0,0,0,0,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F19D09=-GASCON*(TSTAR1/T)**2*GDTT ELSE CALL S03D09(RL,T,0,1,1,1,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RL/RCR TA=TCR/T F19D09=-GASCON*TA**2*GDTT + +GASCON*(RA*GDP-RA*TA*GDPT)**2/(2.0D+00*RA*GDP+RA**2*GDPP) ENDIF ENDIF RETURN END C F20 + CP OF SATURATED VAPOUR AT T DOUBLE PRECISION FUNCTION F20D09(T) DOUBLE PRECISION P,T,RL,RV,RA,TA DOUBLE PRECISION TSTAR2,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR,RCR DATA GASCON/0.461526D+03/ DATA TSTAR2/5.40D+02/ DATA TCR,RCR/6.47096D+02,3.22D+02/ IF (T .LT. 273.15996D+00 .OR. T .GE. 647.096D+00) THEN F20D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S02D09(P,T,0,0,0,0,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F20D09=-GASCON*(TSTAR2/T)**2*GDTT ELSE CALL S03D09(RV,T,0,1,1,1,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RV/RCR TA=TCR/T F20D09=-GASCON*TA**2*GDTT + +GASCON*(RA*GDP-RA*TA*GDPT)**2/(2.0D+00*RA*GDP+RA**2*GDPP) ENDIF ENDIF RETURN END C F21 + CRITICAL POINT DOUBLE PRECISION FUNCTION F21D09(A) CHARACTER*1 A IF (A.EQ.'H') THEN F21D09=2087.55D+03 ELSEIF (A.EQ.'P') THEN F21D09=22.064D+06 ELSEIF (A.EQ.'S') THEN F21D09=4.41202D+03 ELSEIF (A.EQ.'T') THEN F21D09=647.096D+00 ELSEIF (A.EQ.'V') THEN F21D09=1D+00/322D+00 ELSE F21D09=-1.0D+20 ENDIF RETURN END C F2A + STATISTIC DIELECTRIC CONSTANT<-> OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F2AD09(P) DOUBLE PRECISION P,T,F40D09,F2CD09 T=F40D09(P) IF (T .LT. 0.0D+00) THEN F2AD09=T ELSE F2AD09=F2CD09(T) ENDIF RETURN END C F2B + STATISTIC DIELECTRIC CONSTANT<-> OF SATURATED VAPOR AT P DOUBLE PRECISION FUNCTION F2BD09(P) DOUBLE PRECISION P,T,F40D09,F2DD09 T=F40D09(P) IF (T .LT. 0.0D+00) THEN F2BD09=T ELSE F2BD09=F2DD09(T) ENDIF RETURN END C F22 + STATISTIC DIELECTRIC CONSTANT<-> AT P & T DOUBLE PRECISION FUNCTION F22D09(P,T) DOUBLE PRECISION F51D09,G82D09 DOUBLE PRECISION P,T,VV,RO IF (T .GT. 1200.15D+00) THEN F22D09=-1.0D+20 ELSE VV=F51D09(P,T) IF (VV .LT. 0.0D+00) THEN F22D09=VV ELSE RO=1.0D+00/VV F22D09=G82D09(T,RO) ENDIF ENDIF RETURN END C F2C + STATISTIC DIELECTRIC CONSTANT<-> OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F2CD09(T) DOUBLE PRECISION G82D09 DOUBLE PRECISION P,T,RL,RV IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F2CD09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) F2CD09=G82D09(T,RL) ENDIF RETURN END C F2D + STATISTIC DIELECTRIC CONSTANT<-> OF SATURATED VAPOR AT T DOUBLE PRECISION FUNCTION F2DD09(T) DOUBLE PRECISION G82D09 DOUBLE PRECISION P,T,RL,RV IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F2DD09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) F2DD09=G82D09(T,RV) ENDIF RETURN END C F23 + H OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F23D09(P) DOUBLE PRECISION P,T,RL,RV,RA,TA DOUBLE PRECISION TSTAR1,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR,RCR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TCR,RCR/6.47096D+02,3.22D+02/ IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F23D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F23D09=GASCON*TSTAR1*GDT ELSE CALL S03D09(RL,T,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RL/RCR TA=TCR/T F23D09=GASCON*T*(TA*GDT+RA*GDP) ENDIF ENDIF RETURN END C F24 + H OF SATURATED VAPOUR AT P DOUBLE PRECISION FUNCTION F24D09(P) DOUBLE PRECISION P,T,RL,RV,RA,TA DOUBLE PRECISION TSTAR2,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR,RCR DATA GASCON/0.461526D+03/ DATA TSTAR2/5.40D+02/ DATA TCR,RCR/6.47096D+02,3.22D+02/ IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F24D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S02D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F24D09=GASCON*TSTAR2*GDT ELSE CALL S03D09(RV,T,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RV/RCR TA=TCR/T F24D09=GASCON*T*(TA*GDT+RA*GDP) ENDIF ENDIF RETURN END C F25 + H AT P AND T DOUBLE PRECISION FUNCTION F25D09(P,T) DOUBLE PRECISION TSTAR1,TSTAR2,TSTAR5,GASCON DOUBLE PRECISION P,T,RO,G31D09,RA,TA DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR,RCR INTEGER IR,G91D09 DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TCR,RCR/6.47096D+02,3.22D+02/ DATA TSTAR5/1.0D+03/ IR=G91D09(P,T) IF (IR .EQ. 9) THEN F25D09=-1.0D+20 ELSEIF (IR .EQ. 1) THEN CALL S01D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F25D09=GASCON*TSTAR1*GDT ELSEIF (IR .EQ. 2) THEN CALL S02D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F25D09=GASCON*TSTAR2*GDT ELSEIF (IR .EQ. 3 .OR. IR .EQ. 0) THEN RO=G31D09(P,T) CALL S03D09(RO,T,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RO/RCR TA=TCR/T F25D09=GASCON*T*(TA*GDT+RA*GDP) ELSEIF (IR .EQ. 5) THEN CALL S05D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F25D09=GASCON*TSTAR5*GDT ENDIF RETURN END C F26 + H OF MIXTURE AT P DOUBLE PRECISION FUNCTION F26D09(P,X) DOUBLE PRECISION TSTAR1,TSTAR2,GASCON DOUBLE PRECISION P,X,T,RL,RV,RA,TA,HD,HDD DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR,RCR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TCR,RCR/6.47096D+02,3.22D+02/ IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F26D09=-1.0D+20 ELSEIF (X .LT. 0.0D+00 .OR. X .GT. 1.0D+00) THEN F26D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HD=GASCON*TSTAR1*GDT CALL S02D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HDD=GASCON*TSTAR2*GDT ELSE TA=TCR/T CALL S03D09(RL,T,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RL/RCR HD=GASCON*T*(TA*GDT+RA*GDP) CALL S03D09(RV,T,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RV/RCR HDD=GASCON*T*(TA*GDT+RA*GDP) ENDIF F26D09=HD+(HDD-HD)*X ENDIF RETURN END C F27 + H OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F27D09(T) DOUBLE PRECISION P,T,RL,RV,RA,TA DOUBLE PRECISION TSTAR1,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR,RCR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TCR,RCR/6.47096D+02,3.22D+02/ IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F27D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F27D09=GASCON*TSTAR1*GDT ELSE CALL S03D09(RL,T,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RL/RCR TA=TCR/T F27D09=GASCON*T*(TA*GDT+RA*GDP) ENDIF ENDIF RETURN END C F28 + H OF SATURATED VAPOUR AT T DOUBLE PRECISION FUNCTION F28D09(T) DOUBLE PRECISION P,T,RL,RV,RA,TA DOUBLE PRECISION TSTAR2,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR,RCR DATA GASCON/0.461526D+03/ DATA TSTAR2/5.40D+02/ DATA TCR,RCR/6.47096D+02,3.22D+02/ IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F28D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S02D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F28D09=GASCON*TSTAR2*GDT ELSE CALL S03D09(RV,T,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RV/RCR TA=TCR/T F28D09=GASCON*T*(TA*GDT+RA*GDP) ENDIF ENDIF RETURN END C F29 + H OF MIXTURE AT T DOUBLE PRECISION FUNCTION F29D09(T,X) DOUBLE PRECISION TSTAR1,TSTAR2,GASCON DOUBLE PRECISION T,X,P,RL,RV,RA,TA,HD,HDD DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR,RCR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TCR,RCR/6.47096D+02,3.22D+02/ IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00)THEN F29D09=-1.0D+20 ELSEIF (X .LT. 0.0D+00 .OR. X .GT. 1.0D+00) THEN F29D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HD=GASCON*TSTAR1*GDT CALL S02D09(P,T,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HDD=GASCON*TSTAR2*GDT ELSE TA=TCR/T CALL S03D09(RL,T,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RL/RCR HD=GASCON*T*(TA*GDT+RA*GDP) CALL S03D09(RV,T,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RV/RCR HDD=GASCON*T*(TA*GDT+RA*GDP) ENDIF F29D09=HD+(HDD-HD)*X ENDIF RETURN END C F30 + SATURATION PRESSURE AT T DOUBLE PRECISION FUNCTION F30D09(T) DOUBLE PRECISION R4N1,R4N2,R4N3,R4N4,R4N5,R4N6,R4N7, + R4N8,R4N9,R4N10 DOUBLE PRECISION PSTAR,TSTAR,T,PR,TR,A,B,C DATA R4N1,R4N2,R4N3,R4N4,R4N5,R4N6,R4N7,R4N8,R4N9,R4N10 + / 0.11670521452767D+04,-0.72421316703206D+06, + -0.17073846940092D+02, 0.12020824702470D+05, + -0.32325550322333D+07, 0.14915108613530D+02, + -0.48232657361591D+04, 0.40511340542057D+06, + -0.23855557567849D+00, 0.65017534844798D+03/ DATA PSTAR,TSTAR/1.0D+06,1.0D+00/ IF (DABS(647.096D+00-T)/647.096D+00 .LT.1.0D-07) THEN F30D09=22.064D+06 ELSEIF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F30D09=-1.0D+20 ELSE TR=T/TSTAR+R4N9/((T/TSTAR)-R4N10) A=R4N2+(R4N1+TR)*TR B=R4N5+(R4N4+R4N3*TR)*TR C=R4N8+(R4N7+R4N6*TR)*TR PR=2*C/(DSQRT(B*B-4*A*C)-B) PR=PR**4 F30D09=PR*PSTAR ENDIF RETURN END C F31 + SURFACE TENSION AT P DOUBLE PRECISION FUNCTION F31D09(P) DOUBLE PRECISION P,T,F40D09,F32D09 T=F40D09(P) F31D09=F32D09(T) RETURN END C F32 + SURFACE TENSION AT T DOUBLE PRECISION FUNCTION F32D09(T) DOUBLE PRECISION T IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F32D09=-1.0D+20 ELSE F32D09=G81D09(T) ENDIF RETURN END C F33 + S OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F33D09(P) DOUBLE PRECISION P,T,RL,RV DOUBLE PRECISION TSTAR1,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TCR/6.47096D+02/ IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F33D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F33D09=GASCON*(TSTAR1/T*GDT-GD) ELSE CALL S03D09(RL,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F33D09=GASCON*(TCR/T*GDT-GD) ENDIF ENDIF RETURN END C F34 + S OF SATURATED VAPOUR AT P DOUBLE PRECISION FUNCTION F34D09(P) DOUBLE PRECISION P,T,RL,RV DOUBLE PRECISION TSTAR2,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR DATA GASCON/0.461526D+03/ DATA TSTAR2/5.40D+02/ DATA TCR/6.47096D+02/ IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F34D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S02D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F34D09=GASCON*(TSTAR2/T*GDT-GD) ELSE CALL S03D09(RV,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F34D09=GASCON*(TCR/T*GDT-GD) ENDIF ENDIF RETURN END C F35 + S AT P AND T SPTFUN DOUBLE PRECISION FUNCTION F35D09(P,T) DOUBLE PRECISION GASCON DOUBLE PRECISION TSTAR1,TSTAR2,TCR,TSTAR5,G31D09 DOUBLE PRECISION P,T,RO DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT INTEGER G91D09,IR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TCR/6.47096D+02/ DATA TSTAR5/1.0D+03/ IR=G91D09(P,T) IF (IR .EQ. 9) THEN F35D09=-1.0D+20 ELSEIF (IR .EQ. 1) THEN CALL S01D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F35D09=GASCON*(TSTAR1/T*GDT-GD) ELSEIF (IR .EQ. 2) THEN CALL S02D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F35D09=GASCON*(TSTAR2/T*GDT-GD) ELSEIF (IR .EQ. 3 .OR. IR.EQ. 0) THEN RO=G31D09(P,T) CALL S03D09(RO,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F35D09=GASCON*(TCR/T*GDT-GD) ELSEIF (IR .EQ. 5) THEN CALL S05D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F35D09=GASCON*(TSTAR5/T*GDT-GD) ENDIF RETURN END C F36 + S OF MIXTURE AT P DOUBLE PRECISION FUNCTION F36D09(P,X) DOUBLE PRECISION TSTAR1,TSTAR2,GASCON DOUBLE PRECISION P,X,T,RL,RV,SD,SDD DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TCR/6.47096D+02/ IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F36D09=-1.0D+20 ELSEIF (X .LT. 0.0D+00 .OR. X .GT. 1.0D+00) THEN F36D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SD=GASCON*(TSTAR1/T*GDT-GD) CALL S02D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SDD=GASCON*(TSTAR2/T*GDT-GD) ELSE CALL S03D09(RL,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SD=GASCON*(TCR/T*GDT-GD) CALL S03D09(RV,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SDD=GASCON*(TCR/T*GDT-GD) ENDIF F36D09=SD+(SDD-SD)*X ENDIF RETURN END C F37 + S OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F37D09(T) DOUBLE PRECISION P,T,RL,RV DOUBLE PRECISION TSTAR1,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TCR/6.47096D+02/ IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F37D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F37D09=GASCON*(TSTAR1/T*GDT-GD) ELSE CALL S03D09(RL,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F37D09=GASCON*(TCR/T*GDT-GD) ENDIF ENDIF RETURN END C F38 + S OF SATURATED VAPOUR AT T DOUBLE PRECISION FUNCTION F38D09(T) DOUBLE PRECISION P,T,RL,RV DOUBLE PRECISION TSTAR2,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR DATA GASCON/0.461526D+03/ DATA TSTAR2/5.40D+02/ DATA TCR/6.47096D+02/ IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F38D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S02D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F38D09=GASCON*(TSTAR2/T*GDT-GD) ELSE CALL S03D09(RV,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F38D09=GASCON*(TCR/T*GDT-GD) ENDIF ENDIF RETURN END C F39 + S OF MIXTURE AT T DOUBLE PRECISION FUNCTION F39D09(T,X) DOUBLE PRECISION T,X,P,RL,RV DOUBLE PRECISION TSTAR1,TSTAR2,GASCON DOUBLE PRECISION SD,SDD DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TCR/6.47096D+02/ IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00)THEN F39D09=-1.0D+20 ELSEIF (X .LT. 0.0D+00 .OR. X .GT. 1.0D+00) THEN F39D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SD=GASCON*(TSTAR1/T*GDT-GD) CALL S02D09(P,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SDD=GASCON*(TSTAR2/T*GDT-GD) ELSE CALL S03D09(RL,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SD=GASCON*(TCR/T*GDT-GD) CALL S03D09(RV,T,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SDD=GASCON*(TCR/T*GDT-GD) ENDIF F39D09=SD+(SDD-SD)*X ENDIF RETURN END C F40 + SATURATION TEMPERATURE AT P DOUBLE PRECISION FUNCTION F40D09(P) DOUBLE PRECISION R4N1,R4N2,R4N3,R4N4,R4N5, + R4N6,R4N7,R4N8,R4N9,R4N10 DOUBLE PRECISION PSTAR,TSTAR,P,PR,TR,D,E,F,G,TSPK DATA R4N1,R4N2,R4N3,R4N4,R4N5,R4N6,R4N7,R4N8,R4N9,R4N10 C / 0.11670521452767D+04,-0.72421316703206D+06, C -0.17073846940092D+02, 0.12020824702470D+05, C -0.32325550322333D+07, 0.14915108613530D+02, C -0.48232657361591D+04, 0.40511340542057D+06, C -0.23855557567849D+00, 0.65017534844798D+03/ DATA PSTAR,TSTAR/1.0D+06,1.0D+00/ IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F40D09=-1.0D+20 ELSE PR=DSQRT(DSQRT(P/PSTAR)) E=R4N6+(R4N3+PR)*PR F=R4N7+(R4N4+R4N1*PR)*PR G=R4N8+(R4N5+R4N2*PR)*PR D=-2*G/(F+DSQRT(F*F-4*E*G)) TR=(R4N10+D-DSQRT((R4N10+D)**2-4*(R4N9+R4N10*D)))/2 TSPK=TR*TSTAR C IF (TSPK .LT. 273.16D+00 .OR. TSPK .GT. 647.096D+00) THEN C F40D09=-1.0D+20 C ELSE F40D09=TSPK C ENDIF ENDIF RETURN END C F41 + TRIPLE POINT DOUBLE PRECISION FUNCTION F41D09(A) CHARACTER*1 A IF (A.EQ.'P') THEN F41D09=611.657D+00 ELSEIF (A.EQ.'T') THEN F41D09=273.16D+00 ELSE F41D09=-1.0D+20 ENDIF RETURN END C F42 + U OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F42D09(P) DOUBLE PRECISION P,H,V,F23D09,F49D09 H=F23D09(P) IF (H .GT. 0.0D+00) THEN V=F49D09(P) F42D09=H-P*V ELSE F42D09=H ENDIF RETURN END C F43 + U OF SATURATED VAPOUR AT P DOUBLE PRECISION FUNCTION F43D09(P) DOUBLE PRECISION P,H,V,F24D09,F50D09 H=F24D09(P) IF (H .GT. 0.0D+00) THEN V=F50D09(P) F43D09=H-P*V ELSE F43D09=H ENDIF RETURN END C F44 + U AT P AND T DOUBLE PRECISION FUNCTION F44D09(P,T) DOUBLE PRECISION P,T,H,V,F25D09,F51D09 H=F25D09(P,T) IF (H .GT. 0.0D+00) THEN V=F51D09(P,T) F44D09=H-P*V ELSE F44D09=H ENDIF RETURN END C F45 + U OF MIXTURE AT P DOUBLE PRECISION FUNCTION F45D09(P,X) DOUBLE PRECISION P,X,F42D09,F43D09,UD,UDD IF (X .GE. 0.0E+00 .AND. X .LE. 1.0D+00) THEN UD=F42D09(P) IF (UD .GE. -1.0D+09) THEN UDD=F43D09(P) F45D09=UD+(UDD-UD)*X RETURN ENDIF ENDIF F45D09=-1.0D+20 RETURN END C F46 + U OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F46D09(T) DOUBLE PRECISION T,H,F27D09,P,RL,RV H=F27D09(T) IF (H .GT. 0.0D+00) THEN CALL S04D09(T,P,RL,RV) F46D09=H-P/RL ELSE F46D09=H ENDIF RETURN END C F47 + U OF SATURATED VAPOUR AT T DOUBLE PRECISION FUNCTION F47D09(T) DOUBLE PRECISION T,H,F28D09,P,RL,RV H=F28D09(T) IF (H .GT. 0.0D+00) THEN CALL S04D09(T,P,RL,RV) F47D09=H-P/RV ELSE F47D09=H ENDIF RETURN END C F48 + U OF MIXTURE AT T DOUBLE PRECISION FUNCTION F48D09(T,X) DOUBLE PRECISION T,X,F46D09,F47D09,UD,UDD IF (X .GE. 0.0E+00 .AND. X .LE. 1.0D+00) THEN UD=F46D09(T) IF (UD .GE. -1.0D+09) THEN UDD=F47D09(T) F48D09=UD+(UDD-UD)*X RETURN ENDIF ENDIF F48D09=-1.0D+20 RETURN END C F49 + V OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F49D09(P) DOUBLE PRECISION P,T,RL,RV IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F49D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) F49D09=1.0D+00/RL ENDIF RETURN END C F50 + V OF SATURATED GAS AT P DOUBLE PRECISION FUNCTION F50D09(P) DOUBLE PRECISION P,T,RL,RV IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F50D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) F50D09=1.0D+00/RV ENDIF RETURN END C F51 + V AT P AND T DOUBLE PRECISION FUNCTION F51D09(P,T) DOUBLE PRECISION GASCON DOUBLE PRECISION P,T,R,G31D09 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT INTEGER G91D09,IR DATA GASCON/0.461526D+03/ IR=G91D09(P,T) IF (IR .EQ. 9) THEN F51D09=-1.0D+20 ELSEIF (IR .EQ. 1) THEN CALL S01D09(P,T,0,1,0,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F51D09=GASCON*T/16.53D+06*GDP ELSEIF (IR .EQ. 2) THEN CALL S02D09(P,T,0,1,0,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F51D09=GASCON*T/1.0D+06*GDP ELSEIF (IR .EQ. 3 .OR. IR .EQ. 0) THEN R=G31D09(P,T) IF (R .GT. 0.0D+00) THEN F51D09=1.0D+00/R ELSE F51D09=R ENDIF ELSEIF (IR .EQ. 5) THEN CALL S05D09(P,T,0,1,0,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F51D09=GASCON*T/1.0D+06*GDP ENDIF RETURN END C F52 + V OF MIXTURE AT P DOUBLE PRECISION FUNCTION F52D09(P,X) DOUBLE PRECISION P,X,T,RL,RV,VL,VG IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F52D09=-1.0D+20 ELSEIF (X .LT. 0.0D+00 .OR. X .GT. 1.0D+00) THEN F52D09=-1.0D+20 ELSE CALL S07D09(P,T,RL,RV) VL=1.0D+00/RL VG=1.0D+00/RV F52D09=VL+(VG-VL)*X ENDIF RETURN END C F53 + V OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F53D09(T) DOUBLE PRECISION T,P,RL,RV IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F53D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) F53D09=1.0D+00/RL ENDIF RETURN END C F54 + V OF SATURATED GAS AT T DOUBLE PRECISION FUNCTION F54D09(T) DOUBLE PRECISION T,P,RL,RV IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F54D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) F54D09=1.0D+00/RV ENDIF RETURN END C F55 + V OF MIXTURE AT T DOUBLE PRECISION FUNCTION F55D09(T,X) DOUBLE PRECISION T,X,P,RL,RV IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F55D09=-1.0D+20 ELSEIF (X .LT. 0.0D+00 .OR. X .GT. 1.0D+00) THEN F55D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) VL=1.0D+00/RL VG=1.0D+00/RV F55D09=VL+(VG-VL)*X ENDIF RETURN END C F56 + DRYNESS FRACTION <-> AT P,H DOUBLE PRECISION FUNCTION F56D09(P,H) DOUBLE PRECISION P,H,T,F40D09,F60D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F56D09=-1.0D+20 ELSE T=F40D09(P) F56D09=F60D09(T,H) ENDIF RETURN END C F57 + DRYNESS FRACTION <-> AT P,S DOUBLE PRECISION FUNCTION F57D09(P,S) DOUBLE PRECISION P,S,T,F40D09,F61D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F57D09=-1.0D+20 ELSE T=F40D09(P) F57D09=F61D09(T,S) ENDIF RETURN END C F58 + DRYNESS FRACTION <-> AT P,U DOUBLE PRECISION FUNCTION F58D09(P,U) DOUBLE PRECISION P,U,T,F40D09,F62D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F58D09=-1.0D+20 ELSE T=F40D09(P) F58D09=F62D09(T,U) ENDIF RETURN END C F59 + DRYNESS FRACTION <-> AT P,V DOUBLE PRECISION FUNCTION F59D09(P,V) DOUBLE PRECISION P,V,T,F40D09,F63D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F59D09=-1.0D+20 ELSE T=F40D09(P) F59D09=F63D09(T,V) ENDIF RETURN END C F60 + DRYNESS FRACTION <-> AT T,H DOUBLE PRECISION FUNCTION F60D09(T,H) DOUBLE PRECISION T,H,F27D09,F28D09,HD,HDD IF (T .GE. 273.15996D+00 .AND. T .LT. 647.096D+00) THEN HD=F27D09(T) HDD=F28D09(T) IF (H .GE. HD .AND. H .LE. HDD) THEN F60D09=(H-HD)/(HDD-HD) RETURN ENDIF ENDIF F60D09=-1.0D+20 RETURN END C F61 + DRYNESS FRACTION <-> AT T,S DOUBLE PRECISION FUNCTION F61D09(T,S) DOUBLE PRECISION T,S,F37D09,F38D09,SD,SDD IF (T .GE. 273.15996D+00 .AND. T .LT. 647.096D+00) THEN SD=F37D09(T) SDD=F38D09(T) IF (S .GE. SD .AND. S .LE. SDD) THEN F61D09=(S-SD)/(SDD-SD) RETURN ENDIF ENDIF F61D09=-1.0D+20 RETURN END C F62 + DRYNESS FRACTION <-> AT T,U DOUBLE PRECISION FUNCTION F62D09(T,U) DOUBLE PRECISION T,U,F46D09,F47D09,UD,UDD IF (T .GE. 273.15996D+00 .AND. T .LT. 647.096D+00) THEN UD=F46D09(T) UDD=F47D09(T) IF (U .GE. UD .AND. U .LE. UDD) THEN F62D09=(U-UD)/(UDD-UD) RETURN ENDIF ENDIF F62D09=-1.0D+20 RETURN END C F63 + DRYNESS FRACTION <-> AT T,V DOUBLE PRECISION FUNCTION F63D09(T,V) DOUBLE PRECISION T,V,P,RL,RV,VD,VDD IF (T .GE. 273.15996D+00 .AND. T .LT. 647.096D+00) THEN CALL S04D09(T,P,RL,RV) VD=1.0D+00/RL VDD=1.0D+00/RV IF (V .GE. VD .AND. V .LE. VDD) THEN F63D09=(V-VD)/(VDD-VD) ENDIF RETURN ENDIF F63D09=-1.0D+20 RETURN END C F64 + TEMPERATURE AT P AND H DOUBLE PRECISION FUNCTION F64D09(P,H) DOUBLE PRECISION P,H,G64D09,T T=G64D09(P,H) IF (T .GE. 0.0D+00) THEN F64D09=T ELSE F64D09=-1.0D+20 ENDIF RETURN END C F6H + TEMPERATURE AT P AND H USING BACKWARD FUNCTION DOUBLE PRECISION FUNCTION F6HD09(P,H) DOUBLE PRECISION P,H,G6HD09,T T=G6HD09(P,H) IF (T .GE. 0.0D+00) THEN F6HD09=T ELSE F6HD09=-1.0D+20 ENDIF RETURN END C F65 + TEMPERATURE AT P AND S USING BACKWARD FUNCTION DOUBLE PRECISION FUNCTION F65D09(P,S) DOUBLE PRECISION P,S,G65D09,T T=G65D09(P,S) IF (T .GE. 0.0D+00) THEN F65D09=T ELSE F65D09=-1.0D+20 ENDIF RETURN END C F65 + TEMPERATURE AT P AND S USING BACKWARD FUNCTION DOUBLE PRECISION FUNCTION F6SD09(P,S) DOUBLE PRECISION P,S,G6SD09,T T=G6SD09(P,S) IF (T .GE. 0.0D+00) THEN F6SD09=T ELSE F6SD09=-1.0D+20 ENDIF RETURN END C F70 + TEMPERATURE AT P AND V DOUBLE PRECISION FUNCTION F70D09(P,V) DOUBLE PRECISION P,V,F51D09,TS,G02D09,F30D09 DOUBLE PRECISION VMIN,VMAX,RL,RV,VD,VDD DOUBLE PRECISION TA,TB,TC,VA,VB,VC,TMIN DOUBLE PRECISION V350,V800,V2000,V23,T23,P13 TMIN=273.15D+00 IF (P .LE. 0.0D+00 .OR. P .GT. 100D+06) THEN F70D09=-1.0D+20 RETURN ENDIF VMIN=F51D09(P,TMIN) IF (V .LT. VMIN) THEN F70D09=-1.0D+20 RETURN ENDIF V800=F51D09(P,1073.15D+00) VMAX=V800 IF (P .LE. 10.0D+06) THEN V2000=F51D09(P,2273.15D+00) VMAX=V2000 ENDIF IF (V .GT. VMAX) THEN F70D09=-1.0D+20 RETURN ENDIF IF (P .LE. 22.064D+06) THEN CALL S07D09(P,TS,RL,RV) VD=1.0D+00/RL VDD=1.0D+00/RV IF (V .GE. VD .AND. V .LE. VDD) THEN F70D09=TS RETURN ENDIF P13=F30D09(623.15D+00) IF (P .LT. P13) THEN IF (V .LT. VD) THEN TA=TMIN TB=TS ELSE TA=TS IF (P .LT. 10.0D+06) THEN TB=2273.15D+00 ELSE TB=1073.15D+00 ENDIF ENDIF ELSE V350=F51D09(P,623.15D+00) IF (V .LE. V350) THEN TA=TMIN TB=623.15D+00 ELSEIF (V .LE. VD) THEN TA=623.15D+00 TB=TS ELSE T23=G02D09(P) V23=F51D09(P,T23) IF (V .LE. V23) THEN TA=TS TB=T23 ELSE TA=T23 TB=1073.15D+00 ENDIF ENDIF ENDIF ELSE V350=F51D09(P,623.15D+00) T23=G02D09(P) V23=F51D09(P,T23) IF (V .LT. V350) THEN TA=TMIN TB=623.15D+00 ELSEIF (V .LT. V23) THEN TA=623.15D+00 TB=T23 ELSE TA=T23 TB=1073.15D+00 ENDIF ENDIF ILOOP=0 100 ILOOP=ILOOP+1 IF (ILOOP .EQ. 10000) THEN F70D09=-1.0D+10 RETURN ENDIF TC=(TA+TB)/2 VA=F51D09(P,TA) VB=F51D09(P,TB) VC=F51D09(P,TC) C IF (V .LE. VC .AND. V .GE. VA) THEN IF (V .LE. VC) THEN TB=TC ELSE TA=TC ENDIF IF (DABS(VC-V)/V .LT. 1.0D-07) THEN F70D09=TC RETURN ENDIF GOTO 100 END C F71 + H AT P AND S DOUBLE PRECISION FUNCTION F71D09(P,S) DOUBLE PRECISION P,S,G65D09,T,F25D09 DOUBLE PRECISION TS,F40D09,SD,SDD,F37D09,F38D09 DOUBLE PRECISION X,HD,F27D09,F28D09 T=G65D09(P,S) IF (T .GE. 0.0D+00) THEN IF (P .LT. 22.064D+06) THEN TS=F40D09(P) SD=F37D09(TS) IF (S .GE. SD) THEN SDD=F38D09(TS) IF (S .LE. SDD) THEN X=(S-SD)/(SDD-SD) HD=F27D09(TS) F71D09=HD+X*(F28D09(TS)-HD) RETURN ENDIF ENDIF ENDIF F71D09=F25D09(P,T) ELSE F71D09=-1.0D+20 ENDIF RETURN END C F7A + CV OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F7AD09(P) DOUBLE PRECISION P,T,F40D09,F7BD09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F7AD09=-1.0D+20 ELSE T=F40D09(P) F7AD09=F7BD09(T) ENDIF RETURN END C F76 + CV OF SATURATED VAPOUR AT P DOUBLE PRECISION FUNCTION F76D09(P) DOUBLE PRECISION P,T,F40D09,F78D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F76D09=-1.0D+20 ELSE T=F40D09(P) F76D09=F78D09(T) ENDIF RETURN END C F77 + CV AT P AND T DOUBLE PRECISION FUNCTION F77D09(P,T) DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION P,T,RO,TA,G31D09 DOUBLE PRECISION TCR,GASCON INTEGER G91D09,IR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TCR/6.47096D+02/ DATA TSTAR5/1.0D+03/ IR=G91D09(P,T) IF (IR .EQ. 9 .OR. IR .EQ. 0) THEN F77D09=-1.0D+20 ELSEIF (IR .EQ. 1) THEN CALL S01D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR1/T F77D09=-GASCON*TA**2*GDTT+GASCON*(GDP-TA*GDPT)**2/GDPP ELSEIF (IR .EQ. 2) THEN CALL S02D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR2/T F77D09=-GASCON*TA**2*GDTT+GASCON*(GDP-TA*GDPT)**2/GDPP ELSEIF (IR .EQ. 3) THEN RO=G31D09(P,T) CALL S03D09(RO,T,0,0,0,0,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TCR/T F77D09=-GASCON*TA**2*GDTT ELSEIF (IR .EQ. 5) THEN CALL S05D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR5/T F77D09=-GASCON*TA**2*GDTT+GASCON*(GDP-TA*GDPT)**2/GDPP ENDIF RETURN END C F7B + CV OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F7BD09(T) DOUBLE PRECISION TSTAR1 DOUBLE PRECISION P,T,RL,RV,TA DOUBLE PRECISION TCR,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DATA TSTAR1/1.386D+03/ DATA TCR/6.47096D+02/ DATA GASCON/0.461526D+03/ IF (T .LT. 273.15996D+00 .OR. T .GE. 647.096D+00) THEN F7BD09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR1/T F7BD09=-GASCON*TA**2*GDTT+GASCON*(GDP-TA*GDPT)**2/GDPP ELSE CALL S03D09(RL,T,0,1,1,1,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TCR/T F7BD09=-GASCON*TA**2*GDTT ENDIF ENDIF RETURN END C F78 + CV OF SATURATED VAPOUR AT T DOUBLE PRECISION FUNCTION F78D09(T) DOUBLE PRECISION P,T,RL,RV,TA DOUBLE PRECISION TSTAR2,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TCR DATA GASCON/0.461526D+03/ DATA TSTAR2/5.40D+02/ DATA TCR/6.47096D+02/ IF (T .LT. 273.15996D+00 .OR. T .GE. 647.096D+00) THEN F78D09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S02D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR2/T F78D09=-GASCON*TA**2*GDTT+GASCON*(GDP-TA*GDPT)**2/GDPP ELSE CALL S03D09(RV,T,0,0,0,0,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TCR/T F78D09=-GASCON*TA**2*GDTT ENDIF ENDIF RETURN END C F79 + U AT P AND S DOUBLE PRECISION FUNCTION F79D09(P,S) DOUBLE PRECISION P,S,G65D09,T,F44D09 DOUBLE PRECISION TS,F40D09,SD,SDD,F37D09,F38D09 DOUBLE PRECISION X,UD,F46D09,F47D09 T=G65D09(P,S) IF (T .GE. 0.0D+00) THEN IF (P .LT. 22.064D+06) THEN TS=F40D09(P) SD=F37D09(TS) IF (S .GE. SD) THEN SDD=F38D09(TS) IF (S .LE. SDD) THEN X=(S-SD)/(SDD-SD) UD=F46D09(TS) F79D09=UD+X*(F47D09(TS)-UD) RETURN ENDIF ENDIF ENDIF F79D09=F44D09(P,T) ELSE F79D09=-1.0D+20 ENDIF RETURN END C F80 + V AT P AND S DOUBLE PRECISION FUNCTION F80D09(P,S) DOUBLE PRECISION P,S,G65D09,T,F51D09 DOUBLE PRECISION TS,F40D09,SD,SDD,F37D09,F38D09 DOUBLE PRECISION X,VD,F53D09,F54D09 T=G65D09(P,S) IF (T .GE. 0.0D+00) THEN IF (P .LT. 22.064D+06) THEN TS=F40D09(P) SD=F37D09(TS) IF (S .GE. SD) THEN SDD=F38D09(TS) IF (S .LE. SDD) THEN X=(S-SD)/(SDD-SD) VD=F53D09(TS) F80D09=VD+X*(F54D09(TS)-VD) RETURN ENDIF ENDIF ENDIF F80D09=F51D09(P,T) ELSE F80D09=-1.0D+20 ENDIF RETURN END C F81 + PR<-> AT P AND T DOUBLE PRECISION FUNCTION F81D09(P,T) DOUBLE PRECISION P,T,AMYU,ALUM,CP DOUBLE PRECISION F13D09,F8D09,F18D09 ALUM=F8D09(P,T) IF (ALUM .GT. 0.0D+00) THEN CP=F18D09(P,T) IF (CP .GT. 0.0D+00) THEN AMYU=F13D09(P,T) F81D09=CP*AMYU/ALUM RETURN ENDIF ENDIF F81D09=-1.0D+20 RETURN END C F8A + KAPPA<-> OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F8AD09(P) DOUBLE PRECISION P,T,F40D09,F8CD09 IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F8AD09=-1.0D+20 ELSE T=F40D09(P) F8AD09=F8CD09(T) ENDIF RETURN END C F8B + KAPPA<-> OF SATURATED GAS AT P DOUBLE PRECISION FUNCTION F8BD09(P) DOUBLE PRECISION P,T,F40D09,F8DD09 IF (P .LT. 611.65698D+00 .OR. P .GT. 22.064D+06) THEN F8BD09=-1.0D+20 ELSE T=F40D09(P) F8BD09=F8DD09(T) ENDIF RETURN END C F82 + KAPPA<-> AT P AND T DOUBLE PRECISION FUNCTION F82D09(P,T) C DOUBLE PRECISION GASCON DOUBLE PRECISION TSTAR1,TSTAR2,TCR,TSTAR5,G31D09 DOUBLE PRECISION P,T,RO,TA,PA,RA DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT INTEGER G91D09,IR C DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TCR/6.47096D+02/ DATA TSTAR5/1.0D+03/ IR=G91D09(P,T) IF (IR .EQ. 9 .OR. IR .EQ. 0) THEN F82D09=-1.0D+20 ELSEIF (IR .EQ. 1) THEN CALL S01D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR1/T PA=P/16.53D+06 F82D09=GDP/PA/((GDP-TA*GDPT)**2/TA**2/GDTT-GDPP) ELSEIF (IR .EQ. 2) THEN CALL S02D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR2/T PA=P/1.0D+06 F82D09=PA*GDP/(-PA*PA*GDPP+(PA*GDP-TA*PA*GDPT)**2/TA**2/GDTT) ELSEIF (IR .EQ. 3) THEN RO=G31D09(P,T) CALL S03D09(RO,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TCR/T RA=RO/322D+00 F82D09=2D+00+RA*GDPP/GDP-RA*(GDP-TA*GDPT)**2/TA**2/GDP/GDTT ELSEIF (IR .EQ.5) THEN CALL S05D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR5/T PA=P/1.0D+06 F82D09=PA*GDP/(-PA*PA*GDPP+(PA*GDP-TA*PA*GDPT)**2/TA**2/GDTT) ENDIF RETURN END C F8C + KAPPA<-> OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F8CD09(T) DOUBLE PRECISION P,T,RL,RV,TA,PA,RA DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TSTAR1,TCR DATA TSTAR1,TCR/1.386D+03,6.47096D+02/ IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F8CD09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR1/T PA=P/16.53D+06 F8CD09=GDP/PA/((GDP-TA*GDPT)**2/TA**2/GDTT-GDPP) ELSE CALL S03D09(RL,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TCR/T RA=RL/322D+00 F8CD09=2D+00+RA*GDPP/GDP-RA*(GDP-TA*GDPT)**2/TA**2/GDP/GDTT ENDIF ENDIF RETURN END C F8D + KAPPA<-> OF SATURATED GAS AT T DOUBLE PRECISION FUNCTION F8DD09(T) DOUBLE PRECISION P,T,RL,RV,TA,PA,RA DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TSTAR2,TCR DATA TSTAR2,TCR/5.40D+02,6.47096D+02/ IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F8DD09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S02D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR2/T PA=P/1.0D+06 F8DD09=PA*GDP/(-PA*PA*GDPP+(PA*GDP-TA*PA*GDPT)**2/TA**2/GDTT) ELSE CALL S03D09(RV,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TCR/T RA=RV/322D+00 F8DD09=2D+00+RA*GDPP/GDP-RA*(GDP-TA*GDPT)**2/TA**2/GDP/GDTT ENDIF ENDIF RETURN END C F8E + W OF SATURATED LIQUID AT P DOUBLE PRECISION FUNCTION F8ED09(P) DOUBLE PRECISION P,T,F40D09,F8GD09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F8ED09=-1.0D+20 ELSE T=F40D09(P) F8ED09=F8GD09(T) ENDIF RETURN END C F8F + W OF SATURATED GAS AT P DOUBLE PRECISION FUNCTION F8FD09(P) DOUBLE PRECISION P,T,F40D09,F8HD09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F8FD09=-1.0D+20 ELSE T=F40D09(P) F8FD09=F8HD09(T) ENDIF RETURN END C F83 + W AT P AND T DOUBLE PRECISION FUNCTION F83D09(P,T) DOUBLE PRECISION GASCON DOUBLE PRECISION TSTAR1,TSTAR2,TCR,TSTAR5,G31D09 DOUBLE PRECISION P,T,RO,TA,PA,RA,WW2 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT INTEGER G91D09,IR DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TCR/6.47096D+02/ DATA TSTAR5/1.0D+03/ IR=G91D09(P,T) IF (IR .EQ. 9 .OR. IR .EQ. 0) THEN F83D09=-1.0D+20 ELSEIF (IR .EQ. 1) THEN CALL S01D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR1/T PA=P/16.53D+06 WW2=GDP**2/((GDP-TA*GDPT)**2/TA**2/GDTT-GDPP) F83D09=DSQRT(GASCON*T*WW2) ELSEIF (IR .EQ. 2) THEN CALL S02D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR2/T PA=P/1.0D+06 WW2=(PA*GDP)**2/(-PA*PA*GDPP+(PA*GDP-TA*PA*GDPT)**2/TA**2/GDTT) F83D09=DSQRT(GASCON*T*WW2) ELSEIF (IR .EQ. 3) THEN RO=G31D09(P,T) CALL S03D09(RO,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TCR/T RA=RO/322D+00 WW2=2*RA*GDP+RA**2*GDPP-RA**2*(GDP-TA*GDPT)**2/TA**2/GDTT F83D09=DSQRT(GASCON*T*WW2) ELSEIF (IR .EQ.5) THEN CALL S05D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR5/T PA=P/1.0D+06 WW2=(PA*GDP)**2/(-PA*PA*GDPP+(PA*GDP-TA*PA*GDPT)**2/TA**2/GDTT) F83D09=DSQRT(GASCON*T*WW2) ENDIF RETURN END C F8G + W OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F8GD09(T) DOUBLE PRECISION P,T,RL,RV,TA,PA,RA DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TSTAR1,TCR DOUBLE PRECISION GASCON DATA GASCON/0.461526D+03/ DATA TSTAR1,TCR/1.386D+03,6.47096D+02/ IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F8GD09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S01D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR1/T PA=P/16.53D+06 WW2=GDP**2/((GDP-TA*GDPT)**2/TA**2/GDTT-GDPP) F8GD09=DSQRT(GASCON*T*WW2) ELSE CALL S03D09(RL,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TCR/T RA=RL/322D+00 WW2=2*RA*GDP+RA**2*GDPP-RA**2*(GDP-TA*GDPT)**2/TA**2/GDTT F8GD09=DSQRT(GASCON*T*WW2) ENDIF ENDIF RETURN END C F8H + W OF SATURATED GAS AT T DOUBLE PRECISION FUNCTION F8HD09(T) DOUBLE PRECISION P,T,RL,RV,TA,PA,RA DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION TSTAR2,TCR DOUBLE PRECISION GASCON DATA GASCON/0.461526D+03/ DATA TSTAR2,TCR/5.40D+02,6.47096D+02/ IF (T .LT. 273.15996D+00 .OR. T .GT. 647.09602D+00) THEN F8HD09=-1.0D+20 ELSE CALL S04D09(T,P,RL,RV) IF (T .LT. 623.15D+00) THEN CALL S02D09(P,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TSTAR2/T PA=P/1.0D+06 WW2=(PA*GDP)**2/ + (-PA*PA*GDPP+(PA*GDP-TA*PA*GDPT)**2/TA**2/GDTT) F8HD09=DSQRT(GASCON*T*WW2) ELSE CALL S03D09(RV,T,0,1,1,0,1,1,GD,GDP,GDPP,GDT,GDTT,GDPT) TA=TCR/T RA=RV/322D+00 WW2=2*RA*GDP+RA**2*GDPP-RA**2*(GDP-TA*GDPT)**2/TA**2/GDTT F8HD09=DSQRT(GASCON*T*WW2) ENDIF ENDIF RETURN END C F85 + PRPD(P) DOUBLE PRECISION FUNCTION F85D09(P) DOUBLE PRECISION P,T,F40D09,F87D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F85D09=-1.0D+20 ELSE T=F40D09(P) F85D09=F87D09(T) ENDIF RETURN END C F86 + PRPDD(P) DOUBLE PRECISION FUNCTION F86D09(P) DOUBLE PRECISION P,T,F40D09,F88D09 IF (P .LT. 611.65698D+00 .OR. P .GE. 22.06399993D+06) THEN F86D09=-1.0D+20 ELSE T=F40D09(P) F86D09=F88D09(T) ENDIF RETURN END C F87 + PRTD(T) DOUBLE PRECISION FUNCTION F87D09(T) DOUBLE PRECISION T,AMYU,ALUM,CP DOUBLE PRECISION F14D09,F9D09,F19D09 IF (T .LT. 273.15996D+00 .OR. T .GE. 647.096D+00) THEN F87D09=-1.0D+20 ELSE AMYU=F14D09(T) ALUM=F9D09(T) CP=F19D09(T) F87D09=CP*AMYU/ALUM ENDIF RETURN END C F88 + PRTDD(T) DOUBLE PRECISION FUNCTION F88D09(T) DOUBLE PRECISION T,AMYU,ALUM,CP DOUBLE PRECISION F15D09,F10D09,F20D09 IF (T .LT. 273.15996D+00 .OR. T .GE. 647.096D+00) THEN F88D09=-1.0D+20 ELSE AMYU=F15D09(T) ALUM=F10D09(T) CP=F20D09(T) F88D09=CP*AMYU/ALUM ENDIF RETURN END C F90 + ISENTROPIC COMPRESSIBILITY BSPT AT P AND T DOUBLE PRECISION FUNCTION F90D09(P,T) DOUBLE PRECISION P,T,VV,WW DOUBLE PRECISION F51D09,F83D09 INTEGER IR,G91D09 IR=G91D09(P,T) IF (IR .EQ. 9 .OR. IR .EQ. 0) THEN F90D09=-1.0D+20 ELSE VV=F51D09(P,T) WW=F83D09(P,T) F90D09=VV/WW/WW ENDIF RETURN END C F91 + ISOTHERMAL COMPRESSIBILITY BTPT AT P AND T DOUBLE PRECISION FUNCTION F91D09(P,T) C DOUBLE PRECISION TSTAR1,TSTAR2,TSTAR5 DOUBLE PRECISION PSTAR1,PSTAR2,PSTAR5 DOUBLE PRECISION P,T,RO,TA,RA,G31D09 DOUBLE PRECISION TCR,RCR,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT INTEGER IR,G91D09 DATA PSTAR1/16.53D+06/ DATA PSTAR2/1.0D+06/ DATA PSTAR5/1.0D+06/ DATA TCR,RCR/6.47096D+02,3.22D+02/ DATA GASCON/0.461526D+03/ IR=G91D09(P,T) IF (IR .EQ. 9 .OR. IR .EQ. 0) THEN F91D09=-1.0D+20 ELSEIF (IR .EQ. 1) THEN CALL S01D09(P,T,0,1,1,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F91D09=-GDPP/GDP/PSTAR1 ELSEIF (IR .EQ. 2) THEN CALL S02D09(P,T,0,1,1,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F91D09=-GDPP/GDP/PSTAR2 ELSEIF (IR .EQ. 3) THEN RO=G31D09(P,T) CALL S03D09(RO,T,0,1,1,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RO/RCR TA=TCR/T F91D09=1.0D+00/RCR/GASCON/T/RA**2/(RA*GDPP+2*GDP) ELSEIF (IR .EQ. 5) THEN CALL S05D09(P,T,0,1,1,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) F91D09=-GDPP/GDP/PSTAR5 ENDIF RETURN END C F92 + VOLUMETRIC COEFFICIENT OF EXPANSION BPPT AT P AND T DOUBLE PRECISION FUNCTION F92D09(P,T) DOUBLE PRECISION TSTAR1,TSTAR2,TSTAR5 DOUBLE PRECISION P,T,RO,TA,RA,G31D09 DOUBLE PRECISION TCR,RCR DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT INTEGER IR,G91D09 DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TSTAR5/1.0D+03/ DATA TCR,RCR/6.47096D+02,3.22D+02/ IR=G91D09(P,T) IF (IR .EQ. 9 .OR. IR .EQ. 0) THEN F92D09=-1.0D+20 ELSEIF (IR .EQ. 1) THEN CALL S01D09(P,T,0,1,0,0,0,1,GD,GDP,GDPP,GDT,GDTT,GDPT) F92D09=(1.0D+00-TSTAR1/T*GDPT/GDP)/T ELSEIF (IR .EQ. 2) THEN CALL S02D09(P,T,0,1,0,0,0,1,GD,GDP,GDPP,GDT,GDTT,GDPT) F92D09=(1.0D+00-TSTAR2/T*GDPT/GDP)/T ELSEIF (IR .EQ. 3) THEN RO=G31D09(P,T) CALL S03D09(RO,T,0,1,1,0,0,1,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RO/RCR TA=TCR/T F92D09=-(TA*GDPT-GDP)/(RA*GDPP+2*GDP)/T ELSEIF (IR .EQ. 5) THEN CALL S05D09(P,T,0,1,0,0,0,1,GD,GDP,GDPP,GDT,GDTT,GDPT) F92D09=(1.0D+00-TSTAR5/T*GDPT/GDP)/T ENDIF RETURN END C F93 + PRESSURE COEFFICIENT BVPT AT P AND T DOUBLE PRECISION FUNCTION F93D09(P,T) DOUBLE PRECISION TSTAR1,TSTAR2,TSTAR5 DOUBLE PRECISION PSTAR1,PSTAR2,PSTAR5 DOUBLE PRECISION P,T,RO,TA,RA,G31D09 DOUBLE PRECISION TCR,RCR,GASCON DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT INTEGER IR,G91D09 DATA PSTAR1,TSTAR1/16.53D+06,1.386D+03/ DATA PSTAR2,TSTAR2/1.0D+06,5.40D+02/ DATA PSTAR5,TSTAR5/1.0D+06,1.0D+03/ DATA TCR,RCR/6.47096D+02,3.22D+02/ DATA GASCON/0.461526D+03/ IR=G91D09(P,T) IF (IR .EQ. 9) THEN F93D09=-1.0D+20 ELSEIF (IR .EQ. 1) THEN CALL S01D09(P,T,0,1,1,0,0,1,GD,GDP,GDPP,GDT,GDTT,GDPT) F93D09=(TSTAR1/T*GDPT-GDP)/GDPP/P*PSTAR1/T ELSEIF (IR .EQ. 2) THEN CALL S02D09(P,T,0,1,1,0,0,1,GD,GDP,GDPP,GDT,GDTT,GDPT) F93D09=(TSTAR2/T*GDPT-GDP)/GDPP/P*PSTAR2/T ELSEIF (IR .EQ. 3 .OR. IR .EQ. 0) THEN RO=G31D09(P,T) CALL S03D09(RO,T,0,1,0,0,0,1,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RO/RCR TA=TCR/T F93D09=RCR*GASCON*RA**2*(GDP-TA*GDPT)/P ELSEIF (IR .EQ. 5) THEN CALL S05D09(P,T,0,1,1,0,0,1,GD,GDP,GDPP,GDT,GDTT,GDPT) F93D09=(TSTAR5/T*GDPT-GDP)/GDPP/P*PSTAR5/T ENDIF RETURN END C F94 + JOULE-THOMSON COEFFICIENT AJTPT AT P AND T DOUBLE PRECISION FUNCTION F94D09(P,T) DOUBLE PRECISION P,T,VV,CV,BP DOUBLE PRECISION F51D09,F77D09,F92D09 INTEGER IR,G91D09 IR=G91D09(P,T) IF (IR .EQ. 9 .OR. IR .EQ. 0) THEN F94D09=-1.0D+20 ELSE VV=F51D09(P,T) CV=F77D09(P,T) BP=F92D09(P,T) F94D09=VV*(T*BP-1.0D+00)/CV ENDIF RETURN END C F95 + RATIO OF SPECIFIC HEATS AT P AND T DOUBLE PRECISION FUNCTION F95D09(P,T) DOUBLE PRECISION P,T,F18D09,F77D09,CP CP=F18D09(P,T) IF (CP .GT. 0.0D+00) THEN F95D09=CP/F77D09(P,T) ELSE F95D09=CP ENDIF RETURN END C F96 + RATIO OF SPECIFIC HEATS OF SATURATED VAPOUR AT P BAR DOUBLE PRECISION FUNCTION F96D09(P) DOUBLE PRECISION P,T,F40D09,F97D09 T=F40D09(P) IF (T .GT. 0.0D+00) THEN F96D09=F97D09(T) ELSE F96D09=-1.0D+20 ENDIF RETURN END C F97 + RATIO OF SPECIFIC HEATS OF SATURATED VAPOUR AT T DOUBLE PRECISION FUNCTION F97D09(T) DOUBLE PRECISION T,F20D09,F78D09,CPT CPT=F20D09(T) IF (CPT .GT. 0.0D+00) THEN F97D09=CPT/F78D09(T) ELSE F97D09=-1.0D+20 ENDIF RETURN END C F9A + RATIO OF SPECIFIC HEATS OF SATURATED LIQUID AT P BAR DOUBLE PRECISION FUNCTION F9AD09(P) DOUBLE PRECISION P,T,F40D09,F9BD09 T=F40D09(P) IF (T .GT. 0.0D+00) THEN F9AD09=F9BD09(T) ELSE F9AD09=-1.0D+20 ENDIF RETURN END C F9B + RATIO OF SPECIFIC HEATS OF SATURATED LIQUID AT T DOUBLE PRECISION FUNCTION F9BD09(T) DOUBLE PRECISION T,F19D09,F7BD09,CPT CPT=F19D09(T) IF (CPT .GT. 0.0D+00) THEN F9BD09=CPT/F7BD09(T) ELSE F9BD09=-1.0D+20 ENDIF RETURN END C G91 FUNCTION FOR REGION CHECK C INTEGER FUNCTION IAREA(P,T) INTEGER FUNCTION G91D09(P,T) DOUBLE PRECISION F30D09,G01D09,PC,TC DOUBLE PRECISION P,T DATA PC,TC/22.064D+06,647.096D+00/ IF (T .GE. 273.14999D+00 .AND. P .GT. 611.65698D+00) THEN IF (T .LE. 1073.15005D+00 .AND. P .LE. 100.0D+06) THEN G91D09=1 ELSEIF (T .LE. 2273.15D+00 .AND. P .LE. 10.0D+06) THEN G91D09=5 RETURN ELSE G91D09=9 RETURN ENDIF ELSE G91D09=9 RETURN ENDIF IF (T .LE. 623.15D+00) THEN IF (P .GE. F30D09(T)) THEN G91D09=1 ELSE G91D09=2 ENDIF ELSEIF (T .LE. 863.15D+00) THEN IF (P .GE. G01D09(T)) THEN IF ( DABS(P-PC)/PC .LT. 1.0D-07 + .AND. DABS(T-TC)/TC .LT. 1.0D-07) THEN G91D09=0 ELSE G91D09=3 ENDIF ELSE G91D09=2 ENDIF ELSE G91D09=2 ENDIF RETURN END C ********************************* C * 1999 JSME STEAM TABLES * C * IAPWS-IF97 PROPERTIES VER.1.1 * C * PRESSURE * C * TEMPERATURE * C * DENSITY * C * ENTHALPY * C * ENTROPY * C ********************************* C S01 *** SUBROUTINE PROGRAM FOR BASE EQUATIONS AT REGION 1 *** C SUBROUTINE R1SUB(P,T,ID,IDP,IDPP,IDT,IDTT,IDPT, C + GD,GDP,GDPP,GDT,GDTT,GDPT) SUBROUTINE S01D09(P,T,ID,IDP,IDPP,IDT,IDTT,IDPT, + GD,GDP,GDPP,GDT,GDTT,GDPT) DOUBLE PRECISION R1NR(1:34) INTEGER IR(1:34),JR(1:34) INTEGER ID,IDP,IDPP,IDT,IDTT,IDPT DOUBLE PRECISION PSTAR,TSTAR DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT,P,T,PA,TA DATA IR/0,0,0,0,0,0,0,0,1,1,1,1,1,1,2,2,2,2,2, + 3,3,3,4,4,4,5,8,8,21,23,29,30,31,32/ DATA JR/-2,-1,0,1,2,3,4,5,-9,-7,-1,0,1,3,-3,0,1,3,17, + -4,0,6,-5,-2,10,-8,-11,-6,-29,-31,-38,-39,-40,-41/ DATA R1NR(1),R1NR(2)/ 1.4632971213167D-01,-8.4548187169114D-01/ DATA R1NR(3),R1NR(4)/-3.7563603672040D+00, 3.3855169168385D+00/ DATA R1NR(5),R1NR(6)/-9.5791963387872D-01, 1.5772038513228D-01/ DATA R1NR(7),R1NR(8)/-1.6616417199501D-02, 8.1214629983568D-04/ DATA R1NR(9),R1NR(10)/ 2.8319080123804D-04,-6.0706301565874D-04/ DATA R1NR(11),R1NR(12)/-1.8990068218419D-02,-3.2529748770505D-02/ DATA R1NR(13),R1NR(14)/-2.1841717175414D-02,-5.2838357969930D-05/ DATA R1NR(15),R1NR(16)/-4.7184321073267D-04,-3.0001780793026D-04/ DATA R1NR(17),R1NR(18)/ 4.7661393906987D-05,-4.4141845330846D-06/ DATA R1NR(19),R1NR(20)/-7.2694996297594D-16,-3.1679644845054D-05/ DATA R1NR(21),R1NR(22)/-2.8270797985312D-06,-8.5205128120103D-10/ DATA R1NR(23),R1NR(24)/-2.2425281908000D-06,-6.5171222895601D-07/ DATA R1NR(25),R1NR(26)/-1.4341729937924D-13,-4.0516996860117D-07/ DATA R1NR(27),R1NR(28)/-1.2734301741641D-09,-1.7424871230634D-10/ DATA R1NR(29),R1NR(30)/-6.8762131295531D-19, 1.4478307828521D-20/ DATA R1NR(31),R1NR(32)/ 2.6335781662795D-23,-1.1947622640071D-23/ DATA R1NR(33),R1NR(34)/ 1.8228094581404D-24,-9.3537087292458D-26/ DATA PSTAR,TSTAR/16.53D+06,1.386D+03/ PA=P/PSTAR TA=TSTAR/T IF (ID .EQ. 1) THEN GD=0.0D+00 DO 110 I=1,34 GD=GD+R1NR(I)*(7.1D+00-PA)**IR(I)*(TA-1.222D+00)**JR(I) 110 CONTINUE ENDIF IF (IDP.EQ.1) THEN GDP=0.0D+00 DO 120 I=9,34 GDP=GDP-R1NR(I)*IR(I)*(7.1D+00-PA)**(IR(I)-1) + *(TA-1.222D+00)**JR(I) 120 CONTINUE ENDIF IF (IDPP.EQ.1) THEN GDPP=0.0D+00 DO 130 I=9,34 GDPP=GDPP+R1NR(I)*IR(I)*(IR(I)-1)*(7.1D+00-PA)**(IR(I)-2) + *(TA-1.222D+00)**JR(I) 130 CONTINUE ENDIF IF (IDT.EQ.1) THEN GDT=0.0D+00 DO 140 I=1,34 GDT=GDT+R1NR(I)*(7.1D+00-PA)**IR(I) + *JR(I)*(TA-1.222D+00)**(JR(I)-1) 140 CONTINUE ENDIF IF (IDTT.EQ.1) THEN GDTT=0.0D+00 DO 150 I=1,34 GDTT=GDTT+R1NR(I)*(7.1D+00-PA)**IR(I) + *JR(I)*(JR(I)-1)*(TA-1.222D+00)**(JR(I)-2) 150 CONTINUE ENDIF IF (IDPT.EQ.1) THEN GDPT=0.0D+00 DO 160 I=9,34 GDPT=GDPT-R1NR(I)*IR(I)*(7.1D+00-PA)**(IR(I)-1) + *JR(I)*(TA-1.222D+00)**(JR(I)-1) 160 CONTINUE ENDIF RETURN END C S02 *** SUBROUTINE PROGRAM FOR BASE EQUATIONS AT REGION 2 *** C SUBROUTINE R2SUB(P,T,ID,IDP,IDPP,IDT,IDTT,IDPT, C + GD,GDP,GDPP,GDT,GDTT,GDPT) SUBROUTINE S02D09(P,T,ID,IDP,IDPP,IDT,IDTT,IDPT, + GD,GDP,GDPP,GDT,GDTT,GDPT) DOUBLE PRECISION R2N0(1:9) INTEGER J0(1:9) DOUBLE PRECISION R2NR(1:43) INTEGER IR(1:43),JR(1:43) DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT INTEGER ID,IDP,IDPP,IDT,IDTT,IDPT DOUBLE PRECISION PSTAR,TSTAR DOUBLE PRECISION P,T,PA,TA DATA J0/ 0, 1,-5,-4,-3,-2,-1, 2, 3/ DATA R2N0(1),R2N0(2)/-0.96927686500217D+01, 0.10086655968018D+02/ DATA R2N0(3),R2N0(4)/-0.56087911283020D-02, 0.71452738081455D-01/ DATA R2N0(5),R2N0(6)/-0.40710498223928D+00, 0.14240819171444D+01/ DATA R2N0(7),R2N0(8)/-0.43839511319450D+01,-0.28408632460772D+00/ DATA R2N0(9)/0.21268463753307D-01/ DATA IR(1),IR(2),IR(3),IR(4),IR(5)/1,1,1,1,1/ DATA IR(6),IR(7),IR(8),IR(9),IR(10)/2,2,2,2,2/ DATA IR(11),IR(12),IR(13),IR(14),IR(15)/3,3,3,3,3/ DATA IR(16),IR(17),IR(18),IR(19),IR(20)/4,4,4,5,6/ DATA IR(21),IR(22),IR(23),IR(24),IR(25)/6,6,7,7,7/ DATA IR(26),IR(27),IR(28),IR(29),IR(30)/8,8,9,10,10/ DATA IR(31),IR(32),IR(33),IR(34),IR(35)/10,16,16,18,20/ DATA IR(36),IR(37),IR(38),IR(39),IR(40)/20,20,21,22,23/ DATA IR(41),IR(42),IR(43)/24,24,24/ DATA JR(1),JR(2),JR(3),JR(4),JR(5)/0,1,2,3,6/ DATA JR(6),JR(7),JR(8),JR(9),JR(10)/1,2,4,7,36/ DATA JR(11),JR(12),JR(13),JR(14),JR(15)/0,1,3,6,35/ DATA JR(16),JR(17),JR(18),JR(19),JR(20)/1,2,3,7,3/ DATA JR(21),JR(22),JR(23),JR(24),JR(25)/16,35,0,11,25/ DATA JR(26),JR(27),JR(28),JR(29),JR(30)/8,36,13,4,10/ DATA JR(31),JR(32),JR(33),JR(34),JR(35)/14,29,50,57,20/ DATA JR(36),JR(37),JR(38),JR(39),JR(40)/35,48,21,53,39/ DATA JR(41),JR(42),JR(43)/26,40,58/ DATA R2NR(1),R2NR(2)/-1.7731742473213D-03,-1.7834862292358D-02/ DATA R2NR(3),R2NR(4)/-4.5996013696365D-02,-5.7581259083432D-02/ DATA R2NR(5),R2NR(6)/-5.0325278727930D-02,-3.3032641670203D-05/ DATA R2NR(7),R2NR(8)/-1.8948987516315D-04,-3.9392777243355D-03/ DATA R2NR(9),R2NR(10)/-4.3797295650573D-02,-2.6674547914087D-05/ DATA R2NR(11),R2NR(12)/ 2.0481737692309D-08, 4.3870667284435D-07/ DATA R2NR(13),R2NR(14)/-3.2277677238570D-05,-1.5033924542148D-03/ DATA R2NR(15),R2NR(16)/-4.0668253562649D-02,-7.8847309559367D-10/ DATA R2NR(17),R2NR(18)/ 1.2790717852285D-08, 4.8225372718507D-07/ DATA R2NR(19),R2NR(20)/ 2.2922076337661D-06,-1.6714766451061D-11/ DATA R2NR(21),R2NR(22)/-2.1171472321355D-03,-2.3895741934104D+01/ DATA R2NR(23),R2NR(24)/-5.9059564324270D-18,-1.2621808899101D-06/ DATA R2NR(25),R2NR(26)/-3.8946842435739D-02, 1.1256211360459D-11/ DATA R2NR(27),R2NR(28)/-8.2311340897998D+00, 1.9809712802088D-08/ DATA R2NR(29),R2NR(30)/ 1.0406965210174D-19,-1.0234747095929D-13/ DATA R2NR(31),R2NR(32)/-1.0018179379511D-09,-8.0882908646985D-11/ DATA R2NR(33),R2NR(34)/ 1.0693031879409D-01,-3.3662250574171D-01/ DATA R2NR(35),R2NR(36)/ 8.9185845355421D-25, 3.0629316876232D-13/ DATA R2NR(37),R2NR(38)/-4.2002467698208D-06,-5.9056029685639D-26/ DATA R2NR(39),R2NR(40)/ 3.7826947613457D-06,-1.2768608934681D-15/ DATA R2NR(41),R2NR(42)/ 7.3087610595061D-29, 5.5414715350778D-17/ DATA R2NR(43) /-9.4369707241210D-07/ DATA PSTAR,TSTAR/1.0D+06,5.40D+02/ PA=P/PSTAR TA=TSTAR/T TA05=TA-0.5D+00 IF (ID .EQ. 1) THEN GD=DLOG(PA) DO 110 I=1,9 GD=GD+R2N0(I)*TA**J0(I) 110 CONTINUE DO 112 I=1,43 GD=GD+R2NR(I)*PA**IR(I)*TA05**JR(I) 112 CONTINUE ENDIF IF (IDP .EQ. 1) THEN GDP=1.0D+00/PA DO 122 I=1,43 GDP=GDP+R2NR(I)*IR(I)*PA**(IR(I)-1)*TA05**JR(I) 122 CONTINUE ENDIF IF (IDPP .EQ. 1) THEN GDPP=-1.0D+00/PA**2 DO 132 I=6,43 GDPP=GDPP+R2NR(I)*IR(I)*(IR(I)-1)*PA**(IR(I)-2) + *TA05**JR(I) 132 CONTINUE ENDIF IF (IDT .EQ. 1) THEN GDT=0.0D+00 DO 140 I=2,9 GDT=GDT+R2N0(I)*J0(I)*TA**(J0(I)-1) 140 CONTINUE DO 142 I=2,43 GDT=GDT+R2NR(I)*PA**IR(I) + *JR(I)*TA05**(JR(I)-1) 142 CONTINUE ENDIF IF (IDTT .EQ. 1) THEN GDTT=0.0D+00 DO 150 I=3,9 GDTT=GDTT+R2N0(I)*J0(I)*(J0(I)-1)*TA**(J0(I)-2) 150 CONTINUE DO 152 I=3,43 GDTT=GDTT+R2NR(I)*PA**IR(I) + *JR(I)*(JR(I)-1)*TA05**(JR(I)-2) 152 CONTINUE ENDIF IF (IDPT .EQ. 1) THEN GDPT=0.0D+00 DO 162 I=2,43 GDPT=GDPT+R2NR(I)*IR(I)*PA**(IR(I)-1) + *JR(I)*TA05**(JR(I)-1) 162 CONTINUE ENDIF RETURN END C S03 *** SUBROUTINE PROGRAM FOR BASE EQUATIONS AT REGION 3 *** C SUBROUTINE R3SUB(RO,T,ID,IDR,IDRR,IDT,IDTT,IDRT, C + GD,GDR,GDRR,GDT,GDTT,GDRT) SUBROUTINE S03D09(RO,T,ID,IDR,IDRR,IDT,IDTT,IDRT, + GD,GDR,GDRR,GDT,GDTT,GDRT) DOUBLE PRECISION R3N(1:40) INTEGER IR(1:40),JR(1:40) DOUBLE PRECISION GD,GDR,GDRR,GDT,GDTT,GDRT INTEGER ID,IDR,IDRR,IDT,IDTT,IDRT DOUBLE PRECISION RCR,TCR DOUBLE PRECISION RO,T,RA,TA DATA IR(1),IR(2),IR(3),IR(4),IR(5)/0,0,0,0,0/ DATA IR(6),IR(7),IR(8),IR(9),IR(10)/0,0,0,1,1/ DATA IR(11),IR(12),IR(13),IR(14),IR(15)/1,1,2,2,2/ DATA IR(16),IR(17),IR(18),IR(19),IR(20)/2,2,2,3,3/ DATA IR(21),IR(22),IR(23),IR(24),IR(25)/3,3,3,4,4/ DATA IR(26),IR(27),IR(28),IR(29),IR(30)/4,4,5,5,5/ DATA IR(31),IR(32),IR(33),IR(34),IR(35)/6,6,6,7,8/ DATA IR(36),IR(37),IR(38),IR(39),IR(40)/9,9,10,10,11/ DATA JR(1),JR(2),JR(3),JR(4),JR(5)/0,0,1,2,7/ DATA JR(6),JR(7),JR(8),JR(9),JR(10)/10,12,23,2,6/ DATA JR(11),JR(12),JR(13),JR(14),JR(15)/15,17,0,2,6/ DATA JR(16),JR(17),JR(18),JR(19),JR(20)/7,22,26,0,2/ DATA JR(21),JR(22),JR(23),JR(24),JR(25)/4,16,26,0,2/ DATA JR(26),JR(27),JR(28),JR(29),JR(30)/4,26,1,3,26/ DATA JR(31),JR(32),JR(33),JR(34),JR(35)/0,2,26,2,26/ DATA JR(36),JR(37),JR(38),JR(39),JR(40)/2,26,0,1,26/ DATA R3N(1),R3N(2)/ 1.0658070028513D+00,-1.5732845290239D+01/ DATA R3N(3),R3N(4)/ 2.0944396974307D+01,-7.6867707878716D+00/ DATA R3N(5),R3N(6)/ 2.6185947787954D+00,-2.8080781148620D+00/ DATA R3N(7),R3N(8)/ 1.2053369696517D+00,-8.4566812812502D-03/ DATA R3N(9),R3N(10)/-1.2654315477714D+00,-1.1524407806681D+00/ DATA R3N(11),R3N(12)/ 8.8521043984318D-01,-6.4207765181607D-01/ DATA R3N(13),R3N(14)/ 3.8493460186671D-01,-8.5214708824206D-01/ DATA R3N(15),R3N(16)/ 4.8972281541877D+00,-3.0502617256965D+00/ DATA R3N(17),R3N(18)/ 3.9420536879154D-02, 1.2558408424308D-01/ DATA R3N(19),R3N(20)/-2.7999329698710D-01, 1.3899799569460D+00/ DATA R3N(21),R3N(22)/-2.0189915023570D+00,-8.2147637173963D-03/ DATA R3N(23),R3N(24)/-4.7596035734923D-01, 4.3984074473500D-02/ DATA R3N(25),R3N(26)/-4.4476435428739D-01, 9.0572070719733D-01/ DATA R3N(27),R3N(28)/ 7.0522450087967D-01, 1.0770512626332D-01/ DATA R3N(29),R3N(30)/-3.2913623258954D-01,-5.0871062041158D-01/ DATA R3N(31),R3N(32)/-2.2175400873096D-02, 9.4260751665092D-02/ DATA R3N(33),R3N(34)/ 1.6436278447961D-01,-1.3503372241348D-02/ DATA R3N(35),R3N(36)/-1.4834345352472D-02, 5.7922953628084D-04/ DATA R3N(37),R3N(38)/ 3.2308904703711D-03, 8.0964802996215D-05/ DATA R3N(39),R3N(40)/-1.6557679795037D-04,-4.4923899061815D-05/ DATA RCR,TCR/3.22D+02,6.47096D+02/ RA=RO/RCR TA=TCR/T IF (ID .EQ. 1) THEN GD=R3N(1)*DLOG(RA) DO 110 I=2,40 GD=GD+R3N(I)*RA**IR(I)*TA**JR(I) 110 CONTINUE ENDIF IF (IDR .EQ. 1) THEN GDR=R3N(1)/RA DO 120 I=9,40 GDR=GDR+R3N(I)*IR(I)*RA**(IR(I)-1)*TA**JR(I) 120 CONTINUE ENDIF IF (IDRR .EQ. 1) THEN GDRR=-R3N(1)/RA**2 DO 130 I=13,40 GDRR=GDRR+R3N(I)*IR(I)*(IR(I)-1)*RA**(IR(I)-2) + *TA**JR(I) 130 CONTINUE ENDIF IF (IDT .EQ. 1) THEN GDT=0.0D+00 DO 140 I=3,40 GDT=GDT+R3N(I)*RA**IR(I)*JR(I)*TA**(JR(I)-1) 140 CONTINUE ENDIF IF (IDTT .EQ. 1) THEN GDTT=0.0D+00 DO 150 I=4,40 GDTT=GDTT+R3N(I)*RA**IR(I) + *JR(I)*(JR(I)-1)*TA**(JR(I)-2) 150 CONTINUE ENDIF IF (IDRT .EQ. 1) THEN GDRT=0.0D+00 DO 160 I=9,40 GDRT=GDRT+R3N(I)*IR(I)*RA**(IR(I)-1) + *JR(I)*TA**(JR(I)-1) 160 CONTINUE ENDIF RETURN END C S05 *** SUBROUTINE PROGRAM FOR BASE EQUATIONS AT REGION 5 *** C SUBROUTINE R5SUB(P,T,ID,IDP,IDPP,IDT,IDTT,IDPT, C + GD,GDP,GDPP,GDT,GDTT,GDPT) SUBROUTINE S05D09(P,T,ID,IDP,IDPP,IDT,IDTT,IDPT, + GD,GDP,GDPP,GDT,GDTT,GDPT) DOUBLE PRECISION R5N0(1:6) INTEGER J0(1:6) DOUBLE PRECISION R5NR(1:5) INTEGER IR(1:5),JR(1:5) DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT INTEGER ID,IDP,IDPP,IDT,IDTT,IDPT DOUBLE PRECISION PSTAR,TSTAR DOUBLE PRECISION P,T,PA,TA DATA J0/ 0, 1,-3,-2,-1, 2/ DATA R5N0(1),R5N0(2)/-1.3179983674201D+01, 6.8540841634434D+00/ DATA R5N0(3),R5N0(4)/-2.4805148933466D-02, 3.6901534980333D-01/ DATA R5N0(5),R5N0(6)/-3.1161318213925D+00,-3.2961626538917D-01/ DATA IR(1),IR(2),IR(3),IR(4),IR(5)/1,1,1,2,3/ DATA JR(1),JR(2),JR(3),JR(4),JR(5)/0,1,3,9,3/ DATA R5NR(1),R5NR(2)/-1.2563183589592D-04, 2.1774678714571D-03/ DATA R5NR(3),R5NR(4)/-4.5942820899910D-03,-3.9724828359569D-06/ DATA R5NR(5) / 1.2919228289784D-07/ DATA PSTAR,TSTAR/1.0D+06,1.0D+03/ PA=P/PSTAR TA=TSTAR/T IF (ID .EQ. 1) THEN GD=DLOG(PA) DO 110 I=1,6 GD=GD+R5N0(I)*TA**J0(I) 110 CONTINUE DO 112 I=1,5 GD=GD+R5NR(I)*PA**IR(I)*TA**JR(I) 112 CONTINUE ENDIF IF (IDP .EQ. 1) THEN GDP=1.0D+00/PA DO 122 I=1,5 GDP=GDP+R5NR(I)*IR(I)*PA**(IR(I)-1)*TA**JR(I) 122 CONTINUE ENDIF IF (IDPP .EQ. 1) THEN GDPP=-1.0D+00/PA**2 DO 132 I=4,5 GDPP=GDPP+R5NR(I)*IR(I)*(IR(I)-1)*PA**(IR(I)-2) + *TA**JR(I) 132 CONTINUE ENDIF IF (IDT .EQ. 1) THEN GDT=0.0D+00 DO 140 I=2,6 GDT=GDT+R5N0(I)*J0(I)*TA**(J0(I)-1) 140 CONTINUE DO 142 I=2,5 GDT=GDT+R5NR(I)*PA**IR(I) + *JR(I)*TA**(JR(I)-1) 142 CONTINUE ENDIF IF (IDTT .EQ. 1) THEN GDTT=0.0D+00 DO 150 I=3,6 GDTT=GDTT+R5N0(I)*J0(I)*(J0(I)-1)*TA**(J0(I)-2) 150 CONTINUE DO 152 I=3,5 GDTT=GDTT+R5NR(I)*PA**IR(I) + *JR(I)*(JR(I)-1)*TA**(JR(I)-2) 152 CONTINUE ENDIF IF (IDPT .EQ. 1) THEN GDPT=0.0D+00 DO 162 I=2,5 GDPT=GDPT+R5NR(I)*IR(I)*PA**(IR(I)-1) + *JR(I)*TA**(JR(I)-1) 162 CONTINUE ENDIF RETURN END C S04 *** SATURATION DENSIDIES RL AND RV AT T C SUBROUTINE SATPLV(T,P,RL,RV) SUBROUTINE S04D09(T,P,RL,RV) DOUBLE PRECISION T,P,RL,RV,GASCON DOUBLE PRECISION F30D09 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DATA GASCON/0.461526D+03/ P=F30D09(T) IF (T .LE. 623.15D+00) THEN CALL S01D09(P,T,0,1,0,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RL=16.53D+06/GASCON/T/GDP CALL S02D09(P,T,0,1,0,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RV=1.0D+06/GASCON/T/GDP ELSE CALL S06D09(T,P,RL,RV) ENDIF RETURN END C S06 *** SATURATION DENSIDIES AT REGION 3 C SUBROUTINE SATR3(T,P,RL,RV) SUBROUTINE S06D09(T,P,RL,RV) DOUBLE PRECISION GD,GDR,GDRR,GDT,GDTT,GDRT DOUBLE PRECISION GDP,GDPP,GDPT DOUBLE PRECISION ROC,TC,PC,GASCON,ZCR DOUBLE PRECISION T,P,RL,RL1,RL2,RV,RV1,RV2,R1,R2 DATA ROC,TC,PC/3.22D+02,6.47096D+02,22.064D+06/ DATA GASCON/0.461526D+03/ IF (DABS((P-PC)/PC) .LT. 1.0D-06) THEN IF (DABS((T-TC)/TC) .LT. 1.0D-06) THEN RL=ROC RV=ROC RETURN ENDIF ENDIF ZCR=P/ROC/GASCON/T CALL S01D09(P,T,0,1,0,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RL=16.53D+06/GASCON/T/GDP CALL S02D09(P,T,0,1,0,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RV=1.0D+06/GASCON/T/GDP RL1=RL 10 R1=RL1/ROC CALL S03D09(RL1,T,0,1,1,0,0,0,GD,GDR,GDRR,GDT,GDTT,GDRT) R2=R1-(R1**2*GDR-ZCR)/(R1*(2*GDR+R1*GDRR)) RL2=R2*ROC CALL S03D09(RL2,T,0,1,0,0,0,0,GD,GDR,GDRR,GDT,GDTT,GDRT) P2=R2*GDR*RL2*GASCON*T IF ((DABS(R2-R1)/R2) .LT. 1.0D-08) THEN RL=RL2 ELSE RL1=RL2 GOTO 10 ENDIF RV1=RV 20 R1=RV1/ROC CALL S03D09(RV1,T,0,1,1,0,0,0,GD,GDR,GDRR,GDT,GDTT,GDRT) R2=R1-(R1**2*GDR-ZCR)/(R1*(2.0D+00*GDR+R1*GDRR)) RV2=R2*ROC CALL S03D09(RV2,T,0,1,0,0,0,0,GD,GDR,GDRR,GDT,GDTT,GDRT) P2=R2*GDR*RV2*GASCON*T IF ((DABS(R2-R1)/R2) .LT. 1.0D-08) THEN RV=RV2 ELSE RV1=RV2 GOTO 20 ENDIF RETURN END C S07 *** SATURATION DENSIDIES RL AND RV AT P C SUBROUTINE SAPTLV(P,T,RL,RV) SUBROUTINE S07D09(P,T,RL,RV) DOUBLE PRECISION T,P,RL,RV DOUBLE PRECISION F40D09 T=F40D09(P) CALL S04D09(T,P,RL,RV) RETURN END C G01 *** P AT BOUNDARY BETWEEN REGIONS 2 AND 3 C DOUBLE PRECISION FUNCTION P23T(T) DOUBLE PRECISION FUNCTION G01D09(T) DOUBLE PRECISION R23N1,R23N2,R23N3 DOUBLE PRECISION PSTAR,TSTAR,T,PA,TA DATA R23N1,R23N2/ 3.4805185628969D+02,-1.1671859879975D+00/ DATA R23N3 / 1.0192970039326D-03/ DATA PSTAR,TSTAR/1.0D+06,1.0D+00/ TA=T/TSTAR PA=R23N1+(R23N2+R23N3*TA)*TA G01D09=PA*PSTAR RETURN END C G02 *** T AT BOUNDARY BETWEEN REGIONS 2 AND 3 C DOUBLE PRECISION FUNCTION T23P(P) DOUBLE PRECISION FUNCTION G02D09(P) DOUBLE PRECISION R23N3,R23N4,R23N5 DOUBLE PRECISION PSTAR,TSTAR,P,PA,TA DATA R23N3,R23N4/ 1.0192970039326D-03, 5.7254459862746D+02/ DATA R23N5 / 1.3918839778870D+01/ DATA PSTAR,TSTAR/1.0D+06,1.0D+00/ PA=P/PSTAR TA=R23N4+DSQRT((PA-R23N5)/R23N3) G02D09=TA*TSTAR RETURN END C G03 *** P AT BOUNDARY BETWEEN REGIONS 2B AND 2C C DOUBLE PRECISION FUNCTION P2BCH(H) DOUBLE PRECISION FUNCTION G03D09(H) DOUBLE PRECISION R2BCN1,R2BCN2,R2BCN3 DOUBLE PRECISION PSTAR,HSTAR,H,PA,HA DATA R2BCN1,R2BCN2/ 9.0584278514723D+02,-6.7955786399241D-01/ DATA R2BCN3 / 1.2809002730136D-04/ DATA PSTAR,HSTAR/1.0D+06,1.0D+03/ HA=H/HSTAR PA=R2BCN1+(R2BCN2+R2BCN3*HA)*HA G03D09=PA*PSTAR RETURN END C G04 *** H AT BOUNDARY BETWEEN REGIONS 2B AND 2C C DOUBLE PRECISION FUNCTION H2BCP(P) DOUBLE PRECISION FUNCTION G04D09(P) DOUBLE PRECISION R2BCN3,R2BCN4,R2BCN5 DOUBLE PRECISION PSTAR,HSTAR,P,PA,HA DATA R2BCN3,R2BCN4/ 1.2809002730136D-04, 2.6526571908428D+03/ DATA R2BCN5 / 4.5257578905948D+00/ DATA PSTAR,HSTAR/1.0D+06,1.0D+03/ PA=P/PSTAR HA=R2BCN4+DSQRT((PA-R2BCN5)/R2BCN3) G04D09=HA*HSTAR RETURN END C G11 *** FUNCTION SUBPROGRAM FOR INVERSE FUNCTION TPH AT REGION 1 *** C DOUBLE PRECISION FUNCTION R1TPH(P,H) DOUBLE PRECISION FUNCTION G11D09(P,H) DOUBLE PRECISION R1HN(1:20) DOUBLE PRECISION P,H,PSTAR,HSTAR,PA,EA,GT,TSTAR INTEGER IH(1:20),JH(1:20) INTEGER I DATA IH/0,0,0,0,0,0,1,1,1,1, + 1,1,1,2,2,3,3,4,5,6/ DATA JH/ 0, 1, 2, 6,22,32, 0, 1, 2, 3, + 4,10,32,10,32,10,32,32,32,32/ DATA R1HN(1),R1HN(2)/-2.3872489924521D+02, 4.0421188637945D+02/ DATA R1HN(3),R1HN(4)/ 1.1349746881718D+02,-5.8457616048039D+00/ DATA R1HN(5),R1HN(6)/-1.5285482413140D-04,-1.0866707695377D-06/ DATA R1HN(7),R1HN(8)/-1.3391744872602D+01, 4.3211039183559D+01/ DATA R1HN(9),R1HN(10)/-5.4010067170506D+01, 3.0535892203916D+01/ DATA R1HN(11),R1HN(12)/-6.5964749423638D+00, 9.3965400878363D-03/ DATA R1HN(13),R1HN(14)/ 1.1573647505340D-07,-2.5858641282073D-05/ DATA R1HN(15),R1HN(16)/-4.0644363084799D-09, 6.6456186191635D-08/ DATA R1HN(17),R1HN(18)/ 8.0670734103027D-11,-9.3477771213947D-13/ DATA R1HN(19),R1HN(20)/ 5.8265442020601D-15,-1.5020185953503D-17/ DATA PSTAR,HSTAR,TSTAR/1.00D+06,2500D+03,1.00D+00/ PA=P/PSTAR EA=H/HSTAR+1.0D+00 GT=R1HN(1) DO 110 I=2,6 GT=GT+R1HN(I)*EA**JH(I) 110 CONTINUE DO 112 I=7,20 GT=GT+R1HN(I)*PA**IH(I)*EA**JH(I) 112 CONTINUE G11D09=GT*TSTAR RETURN END C G13 *** STRICT VALUE FOR TPS FROM G11D09 AT REGION 1 *** C DOUBLE PRECISION FUNCTION TPHR1(P,H,T1) DOUBLE PRECISION FUNCTION G13D09(P,H,T1) DOUBLE PRECISION P,H,T1,T,DT,HPT1,CPPT1 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION GASCON,TSTAR1 INTEGER ILOOP DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ ILOOP=0 10 ILOOP=ILOOP+1 CALL S01D09(P,T1,0,0,0,1,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HPT1=GASCON*TSTAR1*GDT CPPT1=-GASCON*(TSTAR1/T1)**2*GDTT DT=(H-HPT1)/CPPT1 T=T1+DT IF (DABS(DT/T) .GE. 1.0D-08) THEN T1=T GOTO 10 ENDIF G13D09=T RETURN END C G12 *** FUNCTION SUBPROGRAM FOR INVERSE FUNCTION TPS AT REGION 1 *** C DOUBLE PRECISION FUNCTION R1TPS(P,S) DOUBLE PRECISION FUNCTION G12D09(P,S) DOUBLE PRECISION R1SN(1:20) DOUBLE PRECISION P,S,PSTAR,SSTAR,PA,SA,GT,TSTAR INTEGER IS(1:20),JS(1:20) INTEGER I DATA IS/0,0,0,0,0,0,1,1,1,1, + 1,1,2,2,2,2,2,3,3,4/ DATA JS/ 0, 1, 2, 3,11,31, 0, 1, 2, 3, + 12,31, 0, 1, 2, 9,31,10,32,32/ DATA R1SN(1),R1SN(2)/ 1.7478268058307D+02, 3.4806930892873D+01/ DATA R1SN(3),R1SN(4)/ 6.5292584978455D+00, 3.3039981775489D-01/ DATA R1SN(5),R1SN(6)/-1.9281382923196D-07,-2.4909197244573D-23/ DATA R1SN(7),R1SN(8)/-2.6107636489332D-01, 2.2592965981586D-01/ DATA R1SN(9),R1SN(10)/-6.4256463395226D-02, 7.8876289270526D-03/ DATA R1SN(11),R1SN(12)/ 3.5672110607366D-10, 1.7332496994895D-24/ DATA R1SN(13),R1SN(14)/ 5.6608900654837D-04,-3.2635483139717D-04/ DATA R1SN(15),R1SN(16)/ 4.4778286690632D-05,-5.1322156908507D-10/ DATA R1SN(17),R1SN(18)/-4.2522657042207D-26, 2.6400441360689D-13/ DATA R1SN(19),R1SN(20)/ 7.8124600459723D-29,-3.0732199903668D-31/ DATA PSTAR,SSTAR,TSTAR/1.00D+06,1.00D+03,1.00D+00/ PA=P/PSTAR SA=S/SSTAR+2.0D+00 GT=R1SN(1) DO 110 I=2,6 GT=GT+R1SN(I)*SA**JS(I) 110 CONTINUE DO 112 I=7,20 GT=GT+R1SN(I)*PA**IS(I)*SA**JS(I) 112 CONTINUE G12D09=GT*TSTAR RETURN END C G14 *** STRICT VALUE FOR TPS FROM G12D09 AT REGION 1 *** C DOUBLE PRECISION FUNCTION TPSR1(P,S,T1) DOUBLE PRECISION FUNCTION G14D09(P,S,T1) DOUBLE PRECISION P,S,T1,T,DT,SPT1,CPPT1 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION GASCON,TSTAR1 INTEGER ILOOP DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ ILOOP=0 10 ILOOP=ILOOP+1 CALL S01D09(P,T1,1,0,0,1,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SPT1=GASCON*(TSTAR1/T1*GDT-GD) CPPT1=-GASCON*(TSTAR1/T1)**2*GDTT DT=(S-SPT1)/CPPT1*T1 T=T1+DT IF (DABS(DT/T) .GE. 1.0D-08) THEN T1=T GOTO 10 ENDIF G14D09=T RETURN END C G21 *** FUNCTION SUBPROGRAM FOR INVERSE FUNCTION TPH AT REGION 2A *** C DOUBLE PRECISION FUNCTION R2ATPH(P,H) DOUBLE PRECISION FUNCTION G21D09(P,H) DOUBLE PRECISION R2HN(1:34) DOUBLE PRECISION P,H,PSTAR,HSTAR,PA,EA,GT,TSTAR INTEGER IH(1:34),JH(1:34) INTEGER I DATA IH/0,0,0,0,0,0,1,1,1,1,1,1,1,1,1, + 2,2,2,2,2,2,2,2,3,3,4,4,4,5,5, + 5,6,6,7/ DATA JH/ 0, 1, 2, 3, 7,20, 0, 1, 2, 3, 7, 9,11,18,44, + 0, 2, 7,36,38,40,42,44,24,44,12,32,44,32,36, + 42,34,44,28/ DATA R2HN(1),R2HN(2)/ 1.0898952318288D+03, 8.4951654495535D+02/ DATA R2HN(3),R2HN(4)/-1.0781748091826D+02, 3.3153654801263D+01/ DATA R2HN(5),R2HN(6)/-7.4232016790248D+00, 1.1765048724356D+01/ DATA R2HN(7),R2HN(8)/ 1.8445749355790D+00,-4.1792700549624D+00/ DATA R2HN(9),R2HN(10)/ 6.2478196935812D+00,-1.7344563108114D+01/ DATA R2HN(11),R2HN(12)/-2.0058176862096D+02, 2.7196065473796D+02/ DATA R2HN(13),R2HN(14)/-4.5511318285818D+02, 3.0919688604755D+03/ DATA R2HN(15),R2HN(16)/ 2.5226640357872D+05,-6.1707422868339D-03/ DATA R2HN(17),R2HN(18)/-3.1078046629583D-01, 1.1670873077107D+01/ DATA R2HN(19),R2HN(20)/ 1.2812798404046D+08,-9.8554909623276D+08/ DATA R2HN(21),R2HN(22)/ 2.8224546973002D+09,-3.5948971410703D+09/ DATA R2HN(23),R2HN(24)/ 1.7227349913197D+09,-1.3551334240775D+04/ DATA R2HN(25),R2HN(26)/ 1.2848734664650D+07, 1.3865724283226D+00/ DATA R2HN(27),R2HN(28)/ 2.3598832556514D+05,-1.3105236545054D+07/ DATA R2HN(29),R2HN(30)/ 7.3999835474766D+03,-5.5196697030060D+05/ DATA R2HN(31),R2HN(32)/ 3.7154085996233D+06, 1.9127729239660D+04/ DATA R2HN(33),R2HN(34)/-4.1535164835634D+05,-6.2459855192507D+01/ DATA PSTAR,HSTAR,TSTAR/1.00D+06,2.0D+06,1.00D+00/ PA=P/PSTAR EA=H/HSTAR-2.1D+00 GT=R2HN(1) DO 110 I=2,6 GT=GT+R2HN(I)*EA**JH(I) 110 CONTINUE DO 112 I=7,34 GT=GT+R2HN(I)*PA**IH(I)*EA**JH(I) 112 CONTINUE G21D09=GT*TSTAR RETURN END C G22 *** FUNCTION SUBPROGRAM FOR INVERSE FUNCTION TPS AT REGION 2A *** C DOUBLE PRECISION FUNCTION R2ATPS(P,S) DOUBLE PRECISION FUNCTION G22D09(P,S) DOUBLE PRECISION R2SN(1:46),IS(1:46) DOUBLE PRECISION P,S,PSTAR,SSTAR,PA,SA,GT,TSTAR INTEGER JS(1:46) INTEGER I DATA IS/-1.50D+00,-1.50D+00,-1.50D+00,-1.50D+00,-1.50D+00, + -1.50D+00,-1.25D+00,-1.25D+00,-1.25D+00,-1.00D+00, + -1.00D+00,-1.00D+00,-1.00D+00,-1.00D+00,-1.00D+00, + -0.75D+00,-0.75D+00,-0.50D+00,-0.50D+00,-0.50D+00, + -0.50D+00,-0.25D+00,-0.25D+00,-0.25D+00,-0.25D+00, + 0.25D+00, 0.25D+00, 0.25D+00, 0.25D+00, 0.50D+00, + 0.50D+00, 0.50D+00, 0.50D+00, 0.50D+00, 0.50D+00, + 0.50D+00, 0.75D+00, 0.75D+00, 0.75D+00, 0.75D+00, + 1.0D+00,1.0D+00,1.25D+00,1.25D+00,1.5D+00,1.5D+00/ DATA JS/-24,-23,-19,-13,-11,-10,-19,-15, -6,-26, + -21,-17,-16, -9, -8,-15,-14,-26,-13, -9, + -7,-27,-25,-11, -6, 1, 4, 8, 11, 0, + 1, 5, 6, 10, 14, 16, 0, 4, 9, 17, + 7, 18, 3, 15, 5, 18/ DATA R2SN(1),R2SN(2)/-3.9235983861984D+05, 5.1526573827270D+05/ DATA R2SN(3),R2SN(4)/ 4.0482443161048D+04,-3.2193790923902D+02/ DATA R2SN(5),R2SN(6)/ 9.6961424218694D+01,-2.2867846371773D+01/ DATA R2SN(7),R2SN(8)/-4.4942914124357D+05,-5.0118336020166D+03/ DATA R2SN(9),R2SN(10)/ 3.5684463560015D-01, 4.4235335848190D+04/ DATA R2SN(11),R2SN(12)/-1.3673388811708D+04, 4.2163260207864D+05/ DATA R2SN(13),R2SN(14)/ 2.2516925837475D+04, 4.7442144865646D+02/ DATA R2SN(15),R2SN(16)/-1.4931130797647D+02,-1.9781126320452D+05/ DATA R2SN(17),R2SN(18)/-2.3554399470760D+04,-1.9070616302076D+04/ DATA R2SN(19),R2SN(20)/ 5.5375669883164D+04, 3.8293691437363D+03/ DATA R2SN(21),R2SN(22)/-6.0391860580567D+02, 1.9363102620331D+03/ DATA R2SN(23),R2SN(24)/ 4.2660643698610D+03,-5.9780638872718D+03/ DATA R2SN(25),R2SN(26)/-7.0401463926862D+02, 3.3836784107553D+02/ DATA R2SN(27),R2SN(28)/ 2.0862786635187D+01, 3.3834172656196D-02/ DATA R2SN(29),R2SN(30)/-4.3124428414893D-05, 1.6653791356412D+02/ DATA R2SN(31),R2SN(32)/-1.3986292055898D+02,-7.8849547999872D-01/ DATA R2SN(33),R2SN(34)/ 7.2132411753872D-02,-5.9754839398283D-03/ DATA R2SN(35),R2SN(36)/-1.2141358953904D-05, 2.3227096733871D-07/ DATA R2SN(37),R2SN(38)/-1.0538463566194D+01, 2.0718925496502D+00/ DATA R2SN(39),R2SN(40)/-7.2193155260427D-02, 2.0749887081120D-07/ DATA R2SN(41),R2SN(42)/-1.8340657911379D-02, 2.9036272348696D-07/ DATA R2SN(43),R2SN(44)/ 2.1037527893619D-01, 2.5681239729999D-04/ DATA R2SN(45),R2SN(46)/-1.2799002933781D-02,-8.2198102652018D-06/ DATA PSTAR,SSTAR,TSTAR/1.00D+06,2.00D+03,1.00D+00/ PA=P/PSTAR SA=S/SSTAR-2.0D+00 GT=0.0D+00 DO 110 I=1,46 GT=GT+R2SN(I)*PA**IS(I)*SA**JS(I) 110 CONTINUE G22D09=GT*TSTAR RETURN END C G23 *** FUNCTION SUBPROGRAM FOR INVERSE FUNCTION TPH AT REGION 2B *** C DOUBLE PRECISION FUNCTION R2BTPH(P,H) DOUBLE PRECISION FUNCTION G23D09(P,H) DOUBLE PRECISION R2HN(1:38) DOUBLE PRECISION P,H,PSTAR,HSTAR,PA,EA,GT,TSTAR INTEGER IH(1:38),JH(1:38) INTEGER I DATA IH/0,0,0,0,0,0,0,0,1,1,1,1,1,1,1, + 1,2,2,2,2,3,3,3,3,4,4,4,4,4,4, + 5,5,5,6,7,7,9,9/ DATA JH/ 0, 1, 2,12,18,24,28,40, 0, 2, 6,12,18,24,28, + 40, 2, 8,18,40, 1, 2,12,24, 2,12,18,24,28,40, + 18,24,40,28, 2,28, 1,40/ DATA R2HN(1),R2HN(2)/ 1.4895041079516D+03, 7.4307798314034D+02/ DATA R2HN(3),R2HN(4)/-9.7708318797837D+01, 2.4742464705674D+00/ DATA R2HN(5),R2HN(6)/-6.3281320016026D-01, 1.1385952129658D+00/ DATA R2HN(7),R2HN(8)/-4.7811863648625D-01, 8.5208123431544D-03/ DATA R2HN(9),R2HN(10)/ 9.3747147377932D-01, 3.3593118604916D+00/ DATA R2HN(11),R2HN(12)/ 3.3809355601454D+00, 1.6844539671904D-01/ DATA R2HN(13),R2HN(14)/ 7.3875745236695D-01,-4.7128737436186D-01/ DATA R2HN(15),R2HN(16)/ 1.5020273139707D-01,-2.1764114219750D-03/ DATA R2HN(17),R2HN(18)/-2.1810755324761D-02,-1.0829784403677D-01/ DATA R2HN(19),R2HN(20)/-4.6333324635812D-02, 7.1280351959551D-05/ DATA R2HN(21),R2HN(22)/ 1.1032831789999D-04, 1.8955248387902D-04/ DATA R2HN(23),R2HN(24)/ 3.0891541160537D-03, 1.3555504554949D-03/ DATA R2HN(25),R2HN(26)/ 2.8640237477456D-07,-1.0779857357512D-05/ DATA R2HN(27),R2HN(28)/-7.6462712454814D-05, 1.4052392818316D-05/ DATA R2HN(29),R2HN(30)/-3.1083814331434D-05,-1.0302738212103D-06/ DATA R2HN(31),R2HN(32)/ 2.8217281635040D-07, 1.2704902271945D-06/ DATA R2HN(33),R2HN(34)/ 7.3803353468292D-08,-1.1030139238909D-08/ DATA R2HN(35),R2HN(36)/-8.1456365207833D-14,-2.5180545682962D-11/ DATA R2HN(37),R2HN(38)/-1.7565233969407D-18, 8.6934156344163D-15/ DATA PSTAR,HSTAR,TSTAR/1.00D+06,2.0D+06,1.00D+00/ PA=P/PSTAR-2.0D+00 EA=H/HSTAR-2.6D+00 GT=R2HN(1) DO 110 I=2,8 GT=GT+R2HN(I)*EA**JH(I) 110 CONTINUE DO 112 I=9,38 GT=GT+R2HN(I)*PA**IH(I)*EA**JH(I) 112 CONTINUE G23D09=GT*TSTAR RETURN END C G24 *** FUNCTION SUBPROGRAM FOR INVERSE FUNCTION TPS AT REGION 2B *** C DOUBLE PRECISION FUNCTION R2BTPS(P,S) DOUBLE PRECISION FUNCTION G24D09(P,S) DOUBLE PRECISION R2SN(1:44) DOUBLE PRECISION P,S,PSTAR,SSTAR,PA,SA,GT,TSTAR INTEGER IS(1:44),JS(1:44) INTEGER I DATA IS/-6,-6,-5,-5,-4,-4,-4,-3,-3,-3, + -3,-2,-2,-2,-2,-1,-1,-1,-1,-1, + 0,0,0,0,0,0,0,1,1,1, + 1,1,1,2,2,2,3,3,3,4, + 4,5,5,5/ DATA JS/ 0,11, 0,11, 0, 1,11, 0, 1,11, + 12, 0, 1, 6,10, 0, 1, 5, 8, 9, + 0, 1, 2, 4, 5, 6, 9, 0, 1, 2, + 3, 7, 8, 0, 1, 5, 0, 1, 3, 0, + 1, 0, 1, 2/ DATA R2SN(1),R2SN(2)/ 3.1687665083497D+05, 2.0864175881858D+01/ DATA R2SN(3),R2SN(4)/-3.9859399803599D+05,-2.1816058518877D+01/ DATA R2SN(5),R2SN(6)/ 2.2369785194242D+05,-2.7841703445817D+03/ DATA R2SN(7),R2SN(8)/ 9.9207436071480D+00,-7.5197512299157D+04/ DATA R2SN(9),R2SN(10)/ 2.9708605951158D+03,-3.4406878548526D+00/ DATA R2SN(11),R2SN(12)/ 3.8815564249115D-01, 1.7511295085750D+04/ DATA R2SN(13),R2SN(14)/-1.4237112854449D+03, 1.0943803364167D+00/ DATA R2SN(15),R2SN(16)/ 8.9971619308495D-01,-3.3759740098958D+03/ DATA R2SN(17),R2SN(18)/ 4.7162885818355D+02,-1.9188241993679D+00/ DATA R2SN(19),R2SN(20)/ 4.1078580492196D-01,-3.3465378172097D-01/ DATA R2SN(21),R2SN(22)/ 1.3870034777505D+03,-4.0663326195838D+02/ DATA R2SN(23),R2SN(24)/ 4.1727347159610D+01, 2.1932549434532D+00/ DATA R2SN(25),R2SN(26)/-1.0320050009077D+00, 3.5882943516703D-01/ DATA R2SN(27),R2SN(28)/ 5.2511453726066D-03, 1.2838916450705D+01/ DATA R2SN(29),R2SN(30)/-2.8642437219381D+00, 5.6912683664855D-01/ DATA R2SN(31),R2SN(32)/-9.9962954584931D-02,-3.2632037778459D-03/ DATA R2SN(33),R2SN(34)/ 2.3320922576723D-04,-1.5334809857450D-01/ DATA R2SN(35),R2SN(36)/ 2.9072288239902D-02, 3.7534702741167D-04/ DATA R2SN(37),R2SN(38)/ 1.7296691702411D-03,-3.8556050844504D-04/ DATA R2SN(39),R2SN(40)/-3.5017712292608D-05,-1.4566393631492D-05/ DATA R2SN(41),R2SN(42)/ 5.6420857267269D-06, 4.1286150074605D-08/ DATA R2SN(43),R2SN(44)/-2.0684671118824D-08, 1.6409393674725D-09/ DATA PSTAR,SSTAR,TSTAR/1.00D+06,0.7853D+03,1.00D+00/ PA=P/PSTAR SA=1.0D+01-S/SSTAR GT=0.0D+00 DO 110 I=1,44 GT=GT+R2SN(I)*PA**IS(I)*SA**JS(I) 110 CONTINUE G24D09=GT*TSTAR RETURN END C G25 *** FUNCTION SUBPROGRAM FOR INVERSE FUNCTION TPH AT REGION 2C *** C DOUBLE PRECISION FUNCTION R2CTPH(P,H) DOUBLE PRECISION FUNCTION G25D09(P,H) DOUBLE PRECISION R2HN(1:23) DOUBLE PRECISION P,H,PSTAR,HSTAR,PA,EA,GT,TSTAR INTEGER IH(1:23),JH(1:23) INTEGER I DATA IH/-7,-7,-6,-6,-5,-5,-2,-2,-1,-1, + 0, 0, 1, 1, 2, 6, 6, 6, 6, 6, + 6, 6, 6/ DATA JH/ 0, 4, 0, 2, 0, 2, 0, 1, 0, 2, + 0, 1, 4, 8, 4, 0, 1, 4,10,12, + 16,20,22/ DATA R2HN(1),R2HN(2)/-3.2368398555242D+12, 7.3263350902181D+12/ DATA R2HN(3),R2HN(4)/ 3.5825089945447D+11,-5.8340131851590D+11/ DATA R2HN(5),R2HN(6)/-1.0783068217470D+10, 2.0825544563171D+10/ DATA R2HN(7),R2HN(8)/ 6.1074783564516D+05, 8.5977722535580D+05/ DATA R2HN(9),R2HN(10)/-2.5745723604170D+04, 3.1081088422714D+04/ DATA R2HN(11),R2HN(12)/ 1.2082315865936D+03, 4.8219755109255D+02/ DATA R2HN(13),R2HN(14)/ 3.7966001272486D+00,-1.0842984880077D+01/ DATA R2HN(15),R2HN(16)/-4.5364172676660D-02, 1.4559115658698D-13/ DATA R2HN(17),R2HN(18)/ 1.1261597407230D-12,-1.7804982240686D-11/ DATA R2HN(19),R2HN(20)/ 1.2324579690832D-07,-1.1606921130984D-06/ DATA R2HN(21),R2HN(22)/ 2.7846367088554D-05,-5.9270038474176D-04/ DATA R2HN(23) / 1.2918582991878D-03/ DATA PSTAR,HSTAR,TSTAR/1.00D+06,2.0D+06,1.00D+00/ PA=P/PSTAR+2.5D+01 EA=H/HSTAR-1.8D+00 GT=0.0E+00 DO 110 I=1,23 GT=GT+R2HN(I)*PA**IH(I)*EA**JH(I) 110 CONTINUE G25D09=GT*TSTAR RETURN END C G26 *** FUNCTION SUBPROGRAM FOR INVERSE FUNCTION TPS AT REGION 2C *** C DOUBLE PRECISION FUNCTION R2CTPS(P,S) DOUBLE PRECISION FUNCTION G26D09(P,S) DOUBLE PRECISION R2SN(1:30) DOUBLE PRECISION P,S,PSTAR,SSTAR,PA,SA,GT,TSTAR INTEGER IS(1:30),JS(1:30) INTEGER I DATA IS/-2,-2,-1,0,0,0,0,1,1,1,1,2,2,2,3, + 3, 3, 4,4,4,5,5,5,6,6,7,7,7,7,7/ DATA JS/0,1,0,0,1,2,3,0,1,3,4,0,1,2,0, + 1,5,0,1,4,0,1,2,0,1,0,1,3,4,5/ DATA R2SN(1),R2SN(2)/ 9.0968501005365D+02, 2.4045667088420D+03/ DATA R2SN(3),R2SN(4)/-5.9162326387130D+02, 5.4145404128074D+02/ DATA R2SN(5),R2SN(6)/-2.7098308411192D+02, 9.7976525097926D+02/ DATA R2SN(7),R2SN(8)/-4.6966772959435D+02, 1.4399274604723D+01/ DATA R2SN(9),R2SN(10)/-1.9104204230429D+01, 5.3299167111971D+00/ DATA R2SN(11),R2SN(12)/-2.1252975375934D+01,-3.1147334413760D-01/ DATA R2SN(13),R2SN(14)/ 6.0334840894623D-01,-4.2764839702509D-02/ DATA R2SN(15),R2SN(16)/ 5.8185597255259D-03,-1.4597008284753D-02/ DATA R2SN(17),R2SN(18)/ 5.6631175631027D-03,-7.6155864584577D-05/ DATA R2SN(19),R2SN(20)/ 2.2440342919332D-04,-1.2561095013413D-05/ DATA R2SN(21),R2SN(22)/ 6.3323132660934D-07,-2.0541989675375D-06/ DATA R2SN(23),R2SN(24)/ 3.6405370390082D-08,-2.9759897789215D-09/ DATA R2SN(25),R2SN(26)/ 1.0136618529763D-08, 5.9925719692351D-12/ DATA R2SN(27),R2SN(28)/-2.0677870105164D-11,-2.0874278181886D-11/ DATA R2SN(29),R2SN(30)/ 1.0162166825089D-10,-1.6429828281347D-10/ DATA PSTAR,SSTAR,TSTAR/1.00D+06,2.9251D+03,1.00D+00/ PA=P/PSTAR SA=2.0D+00-S/SSTAR GT=0.0D+00 DO 110 I=1,30 GT=GT+R2SN(I)*PA**IS(I)*SA**JS(I) 110 CONTINUE G26D09=GT*TSTAR RETURN END C G27 *** STRICT VALUE FOR TPH FROM INVERSE FUNCTION AT REGION 2 *** C DOUBLE PRECISION FUNCTION TPHR2(P,H,T1) DOUBLE PRECISION FUNCTION G27D09(P,H,T1) DOUBLE PRECISION P,H,T1,T,DT,HPT1,CPPT1 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION GASCON,TSTAR2 INTEGER ILOOP DATA GASCON/0.461526D+03/ DATA TSTAR2/5.40D+02/ ILOOP=0 10 ILOOP=ILOOP+1 CALL S02D09(P,T1,0,0,0,1,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HPT1=GASCON*TSTAR2*GDT CPPT1=-GASCON*(TSTAR2/T1)**2*GDTT DT=(H-HPT1)/CPPT1 T=T1+DT IF (DABS(DT/T) .GE. 1.0D-08) THEN T1=T GOTO 10 ENDIF G27D09=T RETURN END C G28 *** STRICT VALUE FOR TPS FROM INVERSE FUNCTION AT REGION 2 *** C DOUBLE PRECISION FUNCTION TPSR2(P,S,T1) DOUBLE PRECISION FUNCTION G28D09(P,S,T1) DOUBLE PRECISION P,S,T1,T,DT,SPT1,CPPT1 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION GASCON,TSTAR2 INTEGER ILOOP DATA GASCON/0.461526D+03/ DATA TSTAR2/5.40D+02/ ILOOP=0 10 ILOOP=ILOOP+1 CALL S02D09(P,T1,1,0,0,1,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SPT1=GASCON*(TSTAR2/T1*GDT-GD) CPPT1=-GASCON*(TSTAR2/T1)**2*GDTT DT=(S-SPT1)/CPPT1*T1 T=T1+DT IF (DABS(DT/T) .GE. 1.0D-08) THEN T1=T GOTO 10 ENDIF G28D09=T RETURN END C G31 *** FUNCTION SUBPROGRAM FOR RPT AT REGION 3 *** C DOUBLE PRECISION FUNCTION R3RPT(P,T) DOUBLE PRECISION FUNCTION G31D09(P,T) DOUBLE PRECISION GD,GDR,GDRR,GDT,GDTT,GDRT DOUBLE PRECISION GDP,GDPP,GDPT DOUBLE PRECISION P,T,TMAX,TMIN DOUBLE PRECISION RC,RCA,RA,RB,RV,RL DOUBLE PRECISION TSATB,G02D09 DOUBLE PRECISION PCR,TCR,RCR,GASCON DOUBLE PRECISION P1,DPDRO1,DRO,G32D09 DATA PCR,TCR,RCR/22.064D+06,6.47096D+02,3.22D+02/ DATA GASCON/0.461526D+03/ IF ( DABS(P-PCR)/PCR .LT. 1.0D-07 + .AND. DABS(T-TCR)/TCR .LT. 1.0D-07) THEN G31D09=RCR RETURN ENDIF IF (P .GT. 22.0D+06 .AND. P .LT. 25.0D+06) THEN IF (T .GT. 645.15D+00 .AND. T .LT. 650.15D+00) THEN G31D09=G32D09(P,T) RETURN ENDIF ENDIF TMAX=G02D09(P) TMIN=623.15D+00 CALL S01D09(P,TMIN,0,1,0,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=16.53D+06/GASCON/TMIN/GDP CALL S02D09(P,TMAX,0,1,0,0,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RB=1.0D+06/GASCON/TMAX/GDP IF (P .LE. PCR) THEN CALL S07D09(P,TSATB,RL,RV) IF (T .GT. TSATB) THEN TMIN=TSATB RA=RV RC=RB ELSE TMAX=TSATB RB=RL RC=RA ENDIF ELSE IF (P .GT. 25.0D+06) THEN RC=RB+(T-TMAX)/(TMIN-TMAX)*(RA-RB) ELSE IF (T .GT. TCR) THEN TMIN=TCR RA=RCR ELSE TMAX=TCR RB=RCR ENDIF RC=RA ENDIF ENDIF ILOOP=0 10 ILOOP=ILOOP+1 CALL S03D09(RC,T,0,1,1,0,0,0,GD,GDR,GDRR,GDT,GDTT,GDRT) RCA=RC/RCR P1=GASCON*T*RC*RCA*GDR DPDRO1=GASCON*T*RCA*(RCA*GDRR+2*GDR) DRO=(P-P1)/DPDRO1 IF (DABS(DRO/RC) .GT. 0.1D+00) THEN RC=RC+0.05*DRO GOTO 10 ENDIF IF (DABS(DRO/RC) .LT. 1.0D-7) THEN G31D09=RC+DRO RETURN ELSEIF (ILOOP .EQ. 10000) THEN G31D09=-1.0D+10 RETURN ELSE RC=RC+DRO GOTO 10 ENDIF END C G32 C *** CALCULATION OF THE DENSITITY FROM PRESSURE AND TEMPERATURE C *** USING THE ITERATION PROCEDURE C *** FOR THE REGION NEAR THE CRITICAL POINT *** C DOUBLE PRECISION FUNCTION R3NECR(P,T) DOUBLE PRECISION FUNCTION G32D09(P,T) DOUBLE PRECISION GD,GDR,GDRR,GDT,GDTT,GDRT C DOUBLE PRECISION GDP,GDPP,GDPT DOUBLE PRECISION P,T,PA,PB DOUBLE PRECISION RC,RCA,RA,RB,G31D09 C DOUBLE PRECISION TSATB,G02D09,TSP DOUBLE PRECISION RCR,GASCON DOUBLE PRECISION P1 DATA RCR/3.22D+02/ DATA GASCON/0.461526D+03/ PA=26.0D+06 PB=20.0D+06 RA=G31D09(PA,T) RB=G31D09(PB,T) 100 RC=(RA+RB)/2 CALL S03D09(RC,T,0,1,1,0,0,0,GD,GDR,GDRR,GDT,GDTT,GDRT) RCA=RC/RCR P1=RC*GASCON*T*RCA*GDR IF (P .GT. P1 .AND. P .LT. PA) THEN RB=RC ELSEIF (P .LT. P1 .AND. P .GT. PB) THEN RA=RC ENDIF IF (DABS((P1-P)/P) .LT. 1.0D-08) THEN G32D09=RC RETURN ENDIF GOTO 100 END C G33 *** FUNCTION SUBPROGRAM FOR TPH AT REGION 3 *** C DOUBLE PRECISION FUNCTION TPHR3(P,H) DOUBLE PRECISION FUNCTION G33D09(P,H) DOUBLE PRECISION GASCON DOUBLE PRECISION TCR,T,T1,TA,G02D09,T23,TS DOUBLE PRECISION PCR,P DOUBLE PRECISION RCR,RO,RL,RV,RA,R1 DOUBLE PRECISION HCR,H,H23,H13,F25D09 C DOUBLE PRECISION HN,HNMIN,HND,HNDD,HNTH,HNTHH,H2BC,HNT13 DOUBLE PRECISION G31D09 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DATA GASCON/0.461526D+03/ DATA TCR,PCR,RCR/6.47096D+02,22.064D+06,322D+00/ C DATA TMIN,T13,TH,THH/ C + 273.15D+00,623.15D+00,1073.15D+00,2273.15D+00/ HCR=F25D09(PCR,TCR) IF (DABS(P-PCR)/PCR .LT. 1.0D-07 .AND. C DABS(H-HCR)/HCR .LT. 1.0D-07) THEN G33D09=TCR RETURN ENDIF IF (P .LE. PCR) THEN CALL S07D09(P,TS,RL,RV) RO=RL CALL S03D09(RO,TS,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RO/RCR TA=TCR/TS HD=GASCON*TCR*(GDT+RA*GDP/TA) RO=RV CALL S03D09(RO,TS,0,1,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) RA=RO/RCR TA=TCR/TS HDD=GASCON*TCR*(GDT+RA*GDP/TA) IF (H .LE. HD) THEN CALL S31D09(P,H,RL,TS,RO,T) G33D09=T ELSEIF (H .LE. HDD) THEN G33D09=TS ELSE CALL S31D09(P,H,RV,TS,RO,T) G33D09=T ENDIF RETURN ELSE T23=G02D09(P) H23=F25D09(P,T23) H13=F25D09(P,623.15D+00) T1=623.15D+00+(H-H13)/(H23-H13)*(T23-623.15D+00) ILOOP=0 10 ILOOP=ILOOP+1 R1=G31D09(P,T1) CALL S31D09(P,H,R1,T1,RO,T) G33D09=T RETURN ENDIF END C S31 *** SUBROUTINE SUBPROGRAM FOR TPH AT REGION 3 *** C SUBROUTINE R3TPH(P,H,R1,T1,RO,T) SUBROUTINE S31D09(P,H,R1,T1,RO,T) DOUBLE PRECISION GD,GDR,GDRR,GDT,GDTT,GDRT DOUBLE PRECISION ROC,TC DOUBLE PRECISION R1,T1,RO,T,RA,TA DOUBLE PRECISION P,H,P1,H1 DOUBLE PRECISION DPDRO,DPDT,DHDRO,DHDT,DDD,DELRO,DELT DATA ROC,TC,GASCON/3.22D+02,6.47096D+02,0.461526D+03/ 100 RA=R1/ROC TA=TC/T1 CALL S03D09(R1,T1,1,1,1,1,1,1,GD,GDR,GDRR,GDT,GDTT,GDRT) DPDRO=GASCON*TC*RA/TA*(RA*GDRR+2*GDR) DPDT=-GASCON*ROC*RA**2*(TA*GDRT-GDR) DHDRO=GASCON*TC/ROC*(GDRT+RA*GDRR/TA+GDR/TA) DHDT=-GASCON*(TA**2*GDTT+TA*RA*GDRT-RA*GDR) H1=GASCON*TC*(GDT+RA*GDR/TA) P1=GASCON*ROC*TC*RA*RA*GDR/TA DDD=DPDT*DHDRO-DHDT*DPDRO DELRO=((H-H1)*DPDT-(P-P1)*DHDT)/DDD DELT=-((H-H1)*DPDRO-(P-P1)*DHDRO)/DDD IF ( DABS(DELRO/R1) .GT. 1.0D-07 + .OR. DABS(DELT/T1) .GT. 1.0D-07) THEN R1=R1+DELRO T1=T1+DELT GOTO 100 ENDIF T=T1 RO=R1 RETURN END C S32 *** SUBROUTINE SUBPROGRAM FOR TPH AT REGION 3 *** C SUBROUTINE R3TPS(P,S,R1,T1,RO,T) SUBROUTINE S32D09(P,S,R1,T1,RO,T) DOUBLE PRECISION GD,GDR,GDRR,GDT,GDTT,GDRT DOUBLE PRECISION ROC,TC DOUBLE PRECISION R1,T1,RO,T,RA,TA DOUBLE PRECISION P,S,P1,S1 DOUBLE PRECISION DPDRO,DPDT,DSDRO,DSDT,DDD,DELRO,DELT DATA ROC,TC,GASCON/3.22D+02,6.47096D+02,0.461526D+03/ 100 RA=R1/ROC TA=TC/T1 CALL S03D09(R1,T1,1,1,1,1,1,1,GD,GDR,GDRR,GDT,GDTT,GDRT) DPDRO=GASCON*TC*RA/TA*(RA*GDRR+2*GDR) DPDT=-GASCON*ROC*RA**2*(TA*GDRT-GDR) DSDRO=GASCON/ROC*(TA*GDRT-GDR) DSDT=-GASCON/TC*TA**3*GDTT S1=GASCON*(TA*GDT-GD) P1=GASCON*ROC*TC*RA**2*GDR/TA DDD=DPDT*DSDRO-DSDT*DPDRO DELRO=((S-S1)*DPDT-(P-P1)*DSDT)/DDD DELT=-((S-S1)*DPDRO-(P-P1)*DSDRO)/DDD IF ( DABS(DELRO/R1) .GT. 1.0D-07 + .OR. DABS(DELT/T1) .GT. 1.0D-07) THEN R1=R1+DELRO T1=T1+DELT GOTO 100 ENDIF T=T1 RO=R1 RETURN END C G51 *** FUNCTION SUBPROGRAM FOR TPS AT REGION 5 *** C DOUBLE PRECISION FUNCTION TPHR5(P,H) DOUBLE PRECISION FUNCTION G51D09(P,H) DOUBLE PRECISION P,H,T1,T,DT,HPT1,CPPT1 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION GASCON,TSTAR5 INTEGER ILOOP DATA GASCON/0.461526D+03/ DATA TSTAR5/1.0D+03/ T1=8.00D+02+(H-4.10D+06)*2.72D-03 ILOOP=0 10 ILOOP=ILOOP+1 CALL S05D09(P,T1,0,0,0,1,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HPT1=GASCON*TSTAR5*GDT CPPT1=-GASCON*(TSTAR5/T1)**2*GDTT DT=(H-HPT1)/CPPT1 T=T1+DT IF (DABS(DT/T) .GE. 1.0D-08) THEN T1=T GOTO 10 ENDIF G51D09=T RETURN END C G52 *** FUNCTION SUBPROGRAM FOR TPS AT REGION 5 *** C DOUBLE PRECISION FUNCTION R5TPS(P,S) DOUBLE PRECISION FUNCTION G52D09(P,S) DOUBLE PRECISION GASCON,PSTAR,TSTAR,SSTAR,CPSTAR DOUBLE PRECISION P,S,X DATA PSTAR,TSTAR,SSTAR/1.00D+04,1073.15D+00,10.6311D+03/ DATA CPSTAR/2.342D+03/ DATA GASCON/0.461526D+03/ X=S-SSTAR+GASCON*DLOG(P/PSTAR) G52D09=TSTAR*DEXP(X/CPSTAR) RETURN END C G54 *** FUNCTION SUBPROGRAM FOR TPS AT REGION 5 *** C DOUBLE PRECISION FUNCTION TPSR5(P,S,T1) DOUBLE PRECISION FUNCTION G54D09(P,S,T1) DOUBLE PRECISION P,S,T1,T,DT,SPT1,CPPT1 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DOUBLE PRECISION GASCON,TSTAR5 INTEGER ILOOP DATA GASCON/0.461526D+03/ DATA TSTAR5/1.0D+03/ ILOOP=0 10 ILOOP=ILOOP+1 CALL S05D09(P,T1,1,0,0,1,1,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SPT1=GASCON*(TSTAR5/T1*GDT-GD) CPPT1=-GASCON*(TSTAR5/T1)**2*GDTT DT=(S-SPT1)/CPPT1*T1 T=T1+DT IF (DABS(DT/T) .GE. 1.0D-08) THEN T1=T GOTO 10 ENDIF G54D09=T RETURN END C G64 *** T AT P AND H C DOUBLE PRECISION FUNCTION TPHFUN(P,H) DOUBLE PRECISION FUNCTION G64D09(P,H) DOUBLE PRECISION F40D09,F30D09 DOUBLE PRECISION GASCON DOUBLE PRECISION TSTAR1,TSTAR2,TSTAR5,G02D09,G33D09 DOUBLE PRECISION P,T1,G11D09,G21D09,G23D09,G25D09,G04D09 DOUBLE PRECISION H,HN,HNMIN,HND,HNDD,HNTH,HNTHH,H2BC,HNT13 DOUBLE PRECISION TMIN,T13,TSAT,T23,TH,THH,G13D09,G27D09,G51D09 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ C DATA TCR/6.47096D+02/ DATA TSTAR5/1.0D+03/ DATA TMIN,T13,TH,THH/ + 273.15D+00,623.15D+00,1073.15D+00,2273.15D+00/ IF (P .LE. 0.0D+00 .OR. P .GT. 1.0D+08) THEN G64D09=-1.0D+25 RETURN ENDIF HN=H/GASCON CALL S01D09(P,TMIN,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNMIN=TSTAR1*GDT IF (HN .LT. HNMIN) THEN G64D09=-1.0D+24 RETURN ENDIF IF (P .LE. 22.064D+06) THEN TSAT=F40D09(P) ENDIF IF (P .GE. 6.5466D+06) THEN H2BC=G04D09(P) ENDIF IF (P .LE. F30D09(T13)) THEN CALL S01D09(P,TSAT,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HND=TSTAR1*GDT CALL S02D09(P,TSAT,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNDD=TSTAR2*GDT IF (HN .LE. HND) THEN T1=G11D09(P,H) G64D09=G13D09(P,H,T1) ELSEIF (HN .LE. HNDD) THEN G64D09=TSAT ELSE CALL S02D09(P,TH,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNTH=TSTAR2*GDT IF (HN .LE. HNTH) THEN IF (P .LE. 4.0D+06) THEN T1=G21D09(P,H) ELSEIF (H .GE. H2BC) THEN T1=G23D09(P,H) ELSE T1=G25D09(P,H) ENDIF G64D09=G27D09(P,H,T1) ELSEIF (P .LE. 10.0D+06) THEN CALL S05D09(P,THH,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNTHH=TSTAR5*GDT IF (HN .LE. HNTHH) THEN G64D09=G51D09(P,H) ELSE G64D09=-1.0D+23 ENDIF ELSE G64D09=-1.0D+22 ENDIF ENDIF ELSE CALL S02D09(P,TH,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNTH=TSTAR2*GDT IF (HN .LE. HNTH) THEN CALL S01D09(P,T13,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNT13=TSTAR1*GDT IF (HN .LE. HNT13) THEN T1=G11D09(P,H) G64D09=G13D09(P,H,T1) ELSE T23=G02D09(P) CALL S02D09(P,T23,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNT23=TSTAR2*GDT IF (HN .LT. HNT23) THEN G64D09=G33D09(P,H) ELSE IF (H .LE. H2BC) THEN T1=G25D09(P,H) ELSE T1=G23D09(P,H) ENDIF G64D09=G27D09(P,H,T1) ENDIF ENDIF ELSE G64D09=-1.0D+21 ENDIF ENDIF RETURN END C G6H *** BACKWARD FUNCTION TPH2< AT P AND H C DOUBLE PRECISION FUNCTION TPHFUN(P,H) DOUBLE PRECISION FUNCTION G6HD09(P,H) DOUBLE PRECISION F30D09,F40D09 DOUBLE PRECISION GASCON DOUBLE PRECISION TSTAR1,TSTAR2,G02D09 DOUBLE PRECISION P,G11D09,G21D09,G23D09,G25D09,G04D09 DOUBLE PRECISION H,HN,HNMIN,HND,HNDD,HNTH,H2BC,HNT13 DOUBLE PRECISION TMIN,T13,TSAT,T23,TH DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TMIN,T13,TH/273.15D+00,623.15D+00,1073.15D+00/ IF (P .LE. 0.0D+00 .OR. P .GT. 1.0D+08) THEN G6HD09=-1.0D+25 RETURN ENDIF HN=H/GASCON CALL S01D09(P,TMIN,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNMIN=TSTAR1*GDT IF (HN .LT. HNMIN) THEN G6HD09=-1.0D+24 RETURN ENDIF CALL S02D09(P,TH,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNTH=TSTAR2*GDT IF (HN .GT. HNTH) THEN G6HD09=-1.0D+24 RETURN ENDIF IF (P .LE. 22.064D+06) THEN TSAT=F40D09(P) ENDIF IF (P .GE. 6.5466D+06) THEN H2BC=G04D09(P) ENDIF IF (P .LE. F30D09(T13)) THEN CALL S01D09(P,TSAT,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HND=TSTAR1*GDT CALL S02D09(P,TSAT,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNDD=TSTAR2*GDT IF (HN .LE. HND) THEN G6HD09=G11D09(P,H) ELSEIF (HN .LE. HNDD) THEN G6HD09=TSAT ELSE IF (P .LE. 4.0D+06) THEN G6HD09=G21D09(P,H) ELSEIF (H .GE. H2BC) THEN G6HD09=G23D09(P,H) ELSE G6HD09=G25D09(P,H) ENDIF ENDIF ELSE CALL S01D09(P,T13,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNT13=TSTAR1*GDT IF (HN .LE. HNT13) THEN G6HD09=G11D09(P,H) ELSE T23=G02D09(P) CALL S02D09(P,T23,0,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) HNT23=TSTAR2*GDT IF (HN .LT. HNT23) THEN G6HD09=-1.0D+20 ELSE IF (H .LE. H2BC) THEN G6HD09=G25D09(P,H) ELSE G6HD09=G23D09(P,H) ENDIF ENDIF ENDIF ENDIF RETURN END C G65 *** T AT P AND S C DOUBLE PRECISION FUNCTION TPSFUN(P,S) DOUBLE PRECISION FUNCTION G65D09(P,S) DOUBLE PRECISION GASCON DOUBLE PRECISION TSTAR1,TSTAR2,TCR,TSTAR5,G02D09 DOUBLE PRECISION P,T,T1,G12D09,G22D09,G24D09,G26D09,G52D09 DOUBLE PRECISION F30D09,F40D09 DOUBLE PRECISION S,SN,SNMIN,SND,SNDD,SNTH,SNTHH,SNT13,SNT23 DOUBLE PRECISION TMIN,T13,TSAT,T23,TH,THH,G14D09,G28D09,G54D09 DOUBLE PRECISION PCR,RD,RDD,RO,R1,G31D09 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ DATA TCR/6.47096D+02/ DATA PCR/22.064D+06/ DATA TSTAR5/1.0D+03/ DATA TMIN,T13,TH,THH/ + 273.15D+00,623.15D+00,1073.15D+00,2273.15D+00/ IF (P .LE. 0.0D+00 .OR. P .GT. 1.0D+08) THEN G65D09=-1.0D+25 RETURN ENDIF SN=S/GASCON CALL S01D09(P,TMIN,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNMIN=TSTAR1/TMIN*GDT-GD IF (SN .LT. SNMIN) THEN G65D09=-1.0D+24 RETURN ENDIF IF (P .LE. 22.064D+06) THEN TSAT=F40D09(P) ENDIF IF (P .LE. F30D09(T13)) THEN CALL S01D09(P,TSAT,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SND=TSTAR1/TSAT*GDT-GD CALL S02D09(P,TSAT,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNDD=TSTAR2/TSAT*GDT-GD IF (SN .LE. SND) THEN T1=G12D09(P,S) G65D09=G14D09(P,S,T1) ELSEIF (SN .LE. SNDD) THEN G65D09=TSAT ELSE CALL S02D09(P,TH,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNTH=TSTAR2/TH*GDT-GD IF (SN .LE. SNTH) THEN IF (P .LE. 4.0D+06) THEN T1=G22D09(P,S) ELSEIF (S .GE. 5.85D+03) THEN T1=G24D09(P,S) ELSE T1=G26D09(P,S) ENDIF G65D09=G28D09(P,S,T1) ELSEIF (P .LE. 10.0D+06) THEN CALL S05D09(P,THH,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNTHH=TSTAR5/THH*GDT-GD IF (SN .LE. SNTHH) THEN T1=G52D09(P,S) G65D09=G54D09(P,S,T1) ELSE G65D09=-1.0D+23 ENDIF ELSE G65D09=-1.0D+22 ENDIF ENDIF ELSE CALL S02D09(P,TH,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNTH=TSTAR2/TH*GDT-GD IF (SN .LE. SNTH) THEN CALL S01D09(P,T13,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNT13=TSTAR1/T13*GDT-GD IF (SN .LE. SNT13) THEN T1=G12D09(P,S) G65D09=G14D09(P,S,T1) ELSE T23=G02D09(P) CALL S02D09(P,T23,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNT23=TSTAR2/T23*GDT-GD IF (SN .LT. SNT23) THEN IF (P .LE. PCR) THEN CALL S04D09(TSAT,P,RD,RDD) CALL S03D09(RD,TSAT,1,0,0,1,0,0, + GD,GDP,GDPP,GDT,GDTT,GDPT) SND=TCR/TSAT*GDT-GD CALL S03D09(RDD,TSAT,1,0,0,1,0,0, + GD,GDP,GDPP,GDT,GDTT,GDPT) SNDD=TCR/TSAT*GDT-GD IF (SN .LE. SND) THEN CALL S32D09(P,S,RD,TSAT,RO,T) G65D09=T ELSEIF (SN .LE. SNDD) THEN G65D09=TSAT ELSE CALL S32D09(P,S,RDD,TSAT,RO,T) G65D09=T ENDIF RETURN ELSE T1=T13+(SN-SNT13)/(SNT23-SNT13)*(T23-T13) R1=G31D09(P,T1) CALL S32D09(P,S,R1,T1,RO,T) G65D09=T RETURN ENDIF G65D09=1.0D+13 RETURN ELSE IF (S .LE. 5.85D+03) THEN T1=G26D09(P,S) ELSE T1=G24D09(P,S) ENDIF G65D09=G28D09(P,S,T1) ENDIF ENDIF ELSE G65D09=-1.0D+21 ENDIF ENDIF RETURN END C G6S *** BACKWARD FUNCTION TPS2 AT P AND S C DOUBLE PRECISION FUNCTION TPSFUN(P,S) DOUBLE PRECISION FUNCTION G6SD09(P,S) DOUBLE PRECISION GASCON DOUBLE PRECISION TSTAR1,TSTAR2,G02D09 DOUBLE PRECISION P,G12D09,G22D09,G24D09,G26D09 DOUBLE PRECISION F30D09,F40D09 DOUBLE PRECISION S,SN,SNMIN,SND,SNDD,SNTH,SNT13,SNT23 DOUBLE PRECISION TMIN,T13,TSAT,T23,TH C DOUBLE PRECISION PCR,RD,RDD,RO,R1,G31D09 DOUBLE PRECISION GD,GDP,GDPP,GDT,GDTT,GDPT DATA GASCON/0.461526D+03/ DATA TSTAR1/1.386D+03/ DATA TSTAR2/5.40D+02/ C DATA TCR/6.47096D+02/ C DATA PCR/22.064D+06/ DATA TMIN,T13,TH/273.15D+00,623.15D+00,1073.15D+00/ IF (P .LE. 0.0D+00 .OR. P .GT. 1.0D+08) THEN G6SD09=-1.0D+20 RETURN ENDIF SN=S/GASCON CALL S01D09(P,TMIN,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNMIN=TSTAR1/TMIN*GDT-GD IF (SN .LT. SNMIN) THEN G6SD09=-1.0D+20 RETURN ENDIF CALL S02D09(P,TH,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNTH=TSTAR2/TH*GDT-GD IF (SN .GT. SNTH) THEN G6SD09=-1.0D+20 RETURN ENDIF IF (P .LE. 22.064D+06) THEN TSAT=F40D09(P) ENDIF IF (P .LE. F30D09(T13)) THEN CALL S01D09(P,TSAT,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SND=TSTAR1/TSAT*GDT-GD CALL S02D09(P,TSAT,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNDD=TSTAR2/TSAT*GDT-GD IF (SN .LE. SND) THEN G6SD09=G12D09(P,S) ELSEIF (SN .LE. SNDD) THEN G6SD09=TSAT ELSE IF (P .LE. 4.0D+06) THEN G6SD09=G22D09(P,S) ELSEIF (S .GE. 5.85D+03) THEN G6SD09=G24D09(P,S) ELSE G6SD09=G26D09(P,S) ENDIF ENDIF ELSE CALL S01D09(P,T13,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNT13=TSTAR1/T13*GDT-GD IF (SN .LE. SNT13) THEN G6SD09=G12D09(P,S) ELSE T23=G02D09(P) CALL S02D09(P,T23,1,0,0,1,0,0,GD,GDP,GDPP,GDT,GDTT,GDPT) SNT23=TSTAR2/T23*GDT-GD IF (SN .LT. SNT23) THEN G6SD09=1.0D+20 ELSE IF (S .LE. 5.85D+03) THEN G6SD09=G26D09(P,S) ELSE G6SD09=G24D09(P,S) ENDIF ENDIF ENDIF ENDIF RETURN END C G81 *** SURFACE TENSION AT T DOUBLE PRECISION FUNCTION G81D09(T) DOUBLE PRECISION T,TA,BB,SB,GMU,SIG DATA TCR,BB,SB,GMU/647.096D+00,235.8D-03,-0.625D+00,1.256D+00/ TA=1.0D+00-T/TCR SIG=BB*TA**GMU*(1.0D+00+SB*TA) IF (SIG .LT. 1.0D-07) SIG=0.0D+00 G81D09=SIG RETURN END C G82 *** STATISTIC DIELECTRIC CONSTANT AT T & RO DOUBLE PRECISION FUNCTION G82D09(T,RO) DOUBLE PRECISION T,RO DOUBLE PRECISION AN(1:11),AN12 DOUBLE PRECISION AJH(1:11) DOUBLE PRECISION ROC,TC,ABOLTZ,AMYU,ABOG,AMOL,EPS0 DOUBLE PRECISION ROCMOL,ROMOL,RA,TA,G,A,B,EE INTEGER IH(1:11) DATA AN,AN12/ & 0.978224486826D+00,-0.957771379375D+00, 0.237511794148D+00, & 0.714692244396D+00,-0.298217036956D+00,-0.108863472196D+00, & 0.949327488264D-01,-0.980469816509D-02, 0.165167634970D-04, & 0.937359795772D-04,-0.123179218720D-09, 0.196096504426D-02/ DATA IH/1,1,1,2,3,3,4,5,6,7,10/ DATA AJH/0.25D+00,1.0D+00,2.5D+00,1.5D+00,1.5D+00,2.5D+00, & 2.0D+00,2.0D+00,5.0D+00,0.5D+00,10.0D+00/ DATA ROC,TC/322D+00,647.096D+00/ DATA ABOLTZ/1.380658D-23/ DATA AMYU,ABOG,AMOL/6.138D-30,6.0221367D+23,0.018015268D+00/ EPS0=4.0D-07*3.1415926535D+00*0.299792458D+09**2 EPS0=1.0D+00/EPS0 ROCMOL=ROC/AMOL ROMOL=RO/AMOL RA=ROMOL/ROCMOL TA=TC/T G=1.0D+00 DO 10 I=1,11 G=G+AN(I)*RA**IH(I)*TA**AJH(I) 10 CONTINUE G=G+AN12*RA/(T/228D+00-1.0D+00)**1.2D+00 A=ABOG*AMYU*AMYU/EPS0/ABOLTZ*ROMOL*G/T B=ABOG*1.636D-40/3/EPS0*ROMOL EE=DSQRT(9.0D+00+2*A+18*B+A*A+10*A*B+9*B*B) G82D09=(1.0D+00+A+5*B+EE)/4/(1.0D+00-B) RETURN END C G83 *** DYNAMIC VISCOSITY AT T & RO DOUBLE PRECISION FUNCTION G83D09(T,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA H0,H1,H2,H3/ & 1.0D+00,0.978197D+00, 0.579829D+00,-0.202354D+00/ DATA H00,H10,H40,H50,H01,H11,H21,H31,H02,H12,H22, & H03,H13,H23,H33,H04,H34,H15,H36/ & 0.5132047D+00, 0.3205656D+00,-0.7782567D+00, 0.1885447D+00, & 0.2151778D+00, 0.7317883D+00, 0.1241044D+01, 0.1476783D+01, & -0.2818107D+00,-0.1070786D+01,-0.1263184D+01, & 0.1778064D+00, 0.4605040D+00, 0.2340379D+00,-0.4924179D+00, & -0.4176610D-01, 0.1600435D+00,-0.1578386D-01,-0.3629481D-02/ DATA TSTA,ROSTA,AMUSTA/647.226D+00,317.763D+00,55.071D-06/ TB=T/TSTA RTB=1.0D+00/TB RB=RO/ROSTA AMU0=RTB*(RTB*(H3*RTB+H2)+H1)+H0 AMU0=DSQRT(TB)/AMU0 X=1.0D+00/TB-1.0D+00 Y=RB-1.0D+00 EX=X*(X*(X*(X*(H50*X+H40)))+H10)+H00 YY=Y EX=EX+(X*(X*(H31*X+H21)+H11)+H01)*YY YY=YY*Y EX=EX+(X*(H22*X+H12)+H02)*YY YY=YY*Y EX=EX+(X*(X*(H33*X+H23)+H13)+H03)*YY YY=YY*Y EX=EX+(H34*X**3+H04)*YY YY=YY*Y EX=EX+(H15*X+H36*X**3*Y)*YY AMUEX=DEXP(RB*EX) G83D09=AMUSTA*AMU0*AMUEX RETURN END C G84 *** THERMAL CONDUCTIVITY AT T & RO DOUBLE PRECISION FUNCTION G84D09(T,RO) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DATA A0,A1,A2,A3/ & 0.102811D-01, 0.299621D-01, 0.156146D-01,-0.422464D-02/ DATA SB0,SB1,SB2/-0.397070D+00, 0.400302D+00, 0.1060000D+01/ DATA BB1,BB2/-0.171587D+00, 0.2392190D+01/ DATA C1,C2,C3,C4,C5,C6/ & 0.642857D+00,-0.411717D+01,-0.617937D+01, & 0.308976D-02, 0.822994D-01, 0.100932D+02/ DATA D1,D2,D3,D4/ & 0.701309D-01, 0.118520D-01, 0.169937D-02, -0.10200D+01/ DATA TSTA,ROSTA,ALMSTA/647.26D+00,317.7D+00,1.0D+00/ IF (DABS(T-647.096D+00)/647.096D+00 .LT. 1.0D-06 + .AND. DABS(RO-ROSTA)/ROSTA .LT. 1.0D-06) THEN G84D09=-1.0D+20 RETURN ENDIF TB=T/TSTA RB=RO/ROSTA ALM0=TB*(TB*(A3*TB+A2)+A1)+A0 ALM0=DSQRT(TB)*ALM0 ALM1=SB0+SB1*RB+SB2*DEXP(BB1*(RB+BB2)**2) DELTB=DABS(TB-1.0D+00)+C4 Q=2.0D+00+C5/DELTB**0.6D+00 IF (TB .GE. 1.0D+00) THEN S=1.0D+00/DELTB ELSE S=C6/DELTB**0.6D+00 ENDIF ALM2=(D1/TB**10+D2)*RB**1.8D+00*DEXP(C1*(1.0D+00-RB**2.8D+00)) ALM2=ALM2+D3*S*RB**Q & *DEXP(Q/(1.0D+00+Q)*(1.0D+00-RB**(1.0D+00+Q))) ALM2=ALM2+D4*DEXP(C2*TB**1.5D+00+C3/RB**5) G84D09=ALMSTA*(ALM0+ALM1+ALM2) RETURN END C ******************* C *** THE FOLLOWING SUBPROGRAMS ARE ATTACHED C *** BY ADMINISTRATIVE OFFICE (KYUSHU UNIVERSITY) 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