C-------------------------------------- H2O V10.1 C--- PROPATH 10.1 ****** WATER ****** C==================================================================== C May 2, 2001: modified by Ryo Akasaka for ver.12.1 C The following 18 functions were added but not implemented. C AKPD(8A), AKPDD(8B), AKTD(8C), AKTDD(8D), CVPD(7A), CVTD(7B), C EPSPD(2A), EPSPDD(2B), EPSTD(2C), EPSTDD(2D), GAMPD(9A), C GAMTD(9B), TPH2(6H), TPS2(6S), WPD(8E), WPDD(8F), WTD(8G), C WTDD(8H) C C------------------------------------------------- F8A = AKPD REAL FUNCTION AKPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='AKPD' IF (MESS.NE.0) CALL SE3H2O(FUN) AKPD=-1.0E+30 RETURN END C------------------------------------------------- F8B = AKPDD REAL FUNCTION AKPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='AKPDD' IF (MESS.NE.0) CALL SE3H2O(FUN) AKPDD=-1.0E+30 RETURN END C------------------------------------------------- F8C = AKTD REAL FUNCTION AKTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='AKTD' IF (MESS.NE.0) CALL SE3H2O(FUN) AKTD=-1.0E+30 RETURN END C------------------------------------------------- F8D = AKTDD REAL FUNCTION AKTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='AKTDD' IF (MESS.NE.0) CALL SE3H2O(FUN) AKTDD=-1.0E+30 RETURN END C------------------------------------------------- F7A = CVPD REAL FUNCTION CVPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='CVPD' IF (MESS.NE.0) CALL SE3H2O(FUN) CVPD=-1.0E+30 RETURN END C------------------------------------------------- F7B = CVTD REAL FUNCTION CVTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='CVTD' IF (MESS.NE.0) CALL SE3H2O(FUN) CVTD=-1.0E+30 RETURN END C------------------------------------------------- F2A = EPSPD REAL FUNCTION EPSPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='EPSPD' IF (MESS.NE.0) CALL SE3H2O(FUN) EPSPD=-1.0E+30 RETURN END C------------------------------------------------- F2B = EPSPDD REAL FUNCTION EPSPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='EPSPDD' IF (MESS.NE.0) CALL SE3H2O(FUN) EPSPDD=-1.0E+30 RETURN END C------------------------------------------------- F2C = EPSTD REAL FUNCTION EPSTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='EPSTD' IF (MESS.NE.0) CALL SE3H2O(FUN) EPSTD=-1.0E+30 RETURN END C------------------------------------------------- F2D = EPSTDD REAL FUNCTION EPSTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='EPSTDD' IF (MESS.NE.0) CALL SE3H2O(FUN) EPSTDD=-1.0E+30 RETURN END C------------------------------------------------- F9A = GAMPD REAL FUNCTION GAMPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='GAMPD' IF (MESS.NE.0) CALL SE3H2O(FUN) GAMPD=-1.0E+30 RETURN END C------------------------------------------------- F9B = GAMTD REAL FUNCTION GAMTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='GAMTD' IF (MESS.NE.0) CALL SE3H2O(FUN) GAMTD=-1.0E+30 RETURN END C------------------------------------------------- F6H = TPH2 REAL FUNCTION TPH2(P,H) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='TPH2' IF (MESS.NE.0) CALL SE3H2O(FUN) TPH2=-1.0E+30 RETURN END C------------------------------------------------- F6S = TPS2 REAL FUNCTION TPS2(P,S) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='TPS2' IF (MESS.NE.0) CALL SE3H2O(FUN) TPS2=-1.0E+30 RETURN END C------------------------------------------------- F8E = WPD REAL FUNCTION WPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='WPD' IF (MESS.NE.0) CALL SE3H2O(FUN) WPD=-1.0E+30 RETURN END C------------------------------------------------- F8F = WPDD REAL FUNCTION WPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='WPDD' IF (MESS.NE.0) CALL SE3H2O(FUN) WPDD=-1.0E+30 RETURN END C------------------------------------------------- F8G = WTD REAL FUNCTION WTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='WTD' IF (MESS.NE.0) CALL SE3H2O(FUN) WTD=-1.0E+30 RETURN END C------------------------------------------------- F8H = WTDD REAL FUNCTION WTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS FUN='WTDD' IF (MESS.NE.0) CALL SE3H2O(FUN) WTDD=-1.0E+30 RETURN END C C==================================================================== C------------------------------------------------- F1 = AIPPT FUNCTION AIPPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AIPPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F1H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- AIPPT=SNGL(FF) RETURN END C------------------------------------------------- F2 = ALAPP FUNCTION ALAPP(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALAPP'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F2H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- ALAPP=SNGL(FF) RETURN END C------------------------------------------------- F3 = ALAPT FUNCTION ALAPT(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALAPT'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F3H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- ALAPT=SNGL(FF) RETURN END C------------------------------------------------- F4 = ALHP FUNCTION ALHP(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALHP'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F4H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- ALHP=SNGL(FF) RETURN END C------------------------------------------------- F5 = ALHT FUNCTION ALHT(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALHT'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F5H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- ALHT=SNGL(FF) RETURN END C------------------------------------------------- F6 = ALMPD FUNCTION ALMPD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALMPD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F6H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- ALMPD=SNGL(FF) RETURN END C------------------------------------------------- F7 = ALMPDD FUNCTION ALMPDD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALMPDD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F7H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- ALMPDD=SNGL(FF) RETURN END C------------------------------------------------- F8 = ALMPT FUNCTION ALMPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALMPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F8H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- ALMPT=SNGL(FF) RETURN END C------------------------------------------------- F9 = ALMTD FUNCTION ALMTD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALMTD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F9H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- ALMTD=SNGL(FF) RETURN END C------------------------------------------------- F10 = ALMTDD FUNCTION ALMTDD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'ALMTDD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F10H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- ALMTDD=SNGL(FF) RETURN END C------------------------------------------------- F11 = AMUPD FUNCTION AMUPD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUPD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F11H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- AMUPD=SNGL(FF) RETURN END C------------------------------------------------- F12 = AMUPDD FUNCTION AMUPDD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUPDD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F12H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- AMUPDD=SNGL(FF) RETURN END C------------------------------------------------- F13 = AMUPT FUNCTION AMUPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F13H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- AMUPT=SNGL(FF) RETURN END C------------------------------------------------- F14 = AMUTD FUNCTION AMUTD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUTD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F14H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- AMUTD=SNGL(FF) RETURN END C------------------------------------------------- F15 = AMUTDD FUNCTION AMUTDD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'AMUTDD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F15H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- AMUTDD=SNGL(FF) RETURN END C------------------------------------------------- F16 = CPPD FUNCTION CPPD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPPD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F16H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- CPPD=SNGL(FF) RETURN END C------------------------------------------------- F17 = CPPDD FUNCTION CPPDD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPPDD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F17H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- CPPDD=SNGL(FF) RETURN END C------------------------------------------------- F18 = CPPT FUNCTION CPPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F18H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- CPPT=SNGL(FF) RETURN END C------------------------------------------------- F19 = CPTD FUNCTION CPTD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPTD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F19H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- CPTD=SNGL(FF) RETURN END C------------------------------------------------- F20 = CPTDD FUNCTION CPTDD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CPTDD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F20H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- CPTDD=SNGL(FF) RETURN END C------------------------------------------------- F21 = CRP FUNCTION CRP(A) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6,MSG*125,A*1 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'CRP'/ C--- FUNCTION CALL --- FF=F21H2O(A) C--- LEVEL 2 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) WRITE(6,6010) FUN,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR WATER', & ' WHEN A =',A,' ****') FF=-1.0E+20 END IF C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- IF(A.EQ.'T') THEN T0K=-DBLE(G99H2O(KPA,0.0)) IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 FF=SNGL(FF)+T0K ELSE IF(A.EQ.'P') THEN PBAR=G98H2O(KPA,1.0) IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 FF=SNGL(FF)/PBAR END IF CRP=SNGL(FF) RETURN END C------------------------------------------------- F22 = EPSPT FUNCTION EPSPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'EPSPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F22H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- EPSPT=SNGL(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.0153' WHEN A='M' C B='461.51' WHEN A='R' C************************************************ REAL FUNCTION FC(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF (A.EQ.'M') THEN FC=18.0153 ELSE IF (A.EQ.'R') THEN FC=461.51 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR WATER(IFC 1967) WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F23 = HPD FUNCTION HPD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F23H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- HPD=SNGL(FF) RETURN END C------------------------------------------------- F24 = HPDD FUNCTION HPDD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPDD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F24H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- HPDD=SNGL(FF) RETURN END C------------------------------------------------- F25 = HPT FUNCTION HPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F25H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- HPT=SNGL(FF) RETURN END C------------------------------------------------- F26 = HPX FUNCTION HPX(P,X) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPX'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DX=DBLE(X) C--- FUNCTION CALL --- FF=F26H2O(DP,DX) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DX,'P','X',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- HPX=SNGL(FF) RETURN END C------------------------------------------------- F27 = HTD FUNCTION HTD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HTD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F27H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- HTD=SNGL(FF) RETURN END C------------------------------------------------- F28 = HTDD FUNCTION HTDD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HTDD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F28H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- HTDD=SNGL(FF) RETURN END C------------------------------------------------- F29 = HTX FUNCTION HTX(T,X) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HTX'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) DX=DBLE(X) C--- FUNCTION CALL --- FF=F29H2O(DT,DX) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DT,DX,'T','X',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- HTX=SNGL(FF) RETURN END C------------------------------------------------- F84 = IDENTF C************************************************ C FUNCTION FOR IDENTIFICATION OF SUBSTANCE C PROPATH VER.12.1, MAY 2, 2001 C USAGE: B=IDENTF(A) C A, B : CHARACTER TYPE VALIABLES C B='WATER(IFC 1967)' 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(IFC 1967)' 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 WATER WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG END IF END IF RETURN END C------------------------------------------------- F30 = PST FUNCTION PST(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'PST'/ C--- SET OF UNIT --- PBAR=G98H2O(KPA,1.0) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F30H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 PST=SNGL(FF)/PBAR RETURN END C------------------------------------------------- F31 = SIGP FUNCTION SIGP(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SIGP'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F31H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- SIGP=SNGL(FF) RETURN END C------------------------------------------------- F32 = SIGT FUNCTION SIGT(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SIGT'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F32H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- SIGT=SNGL(FF) RETURN END C------------------------------------------------- F33 = SPD FUNCTION SPD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F33H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- SPD=SNGL(FF) RETURN END C------------------------------------------------- F34 = SPDD FUNCTION SPDD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPDD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F34H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- SPDD=SNGL(FF) RETURN END C------------------------------------------------- F35 = SPT FUNCTION SPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F35H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- SPT=SNGL(FF) RETURN END C------------------------------------------------- F36 = SPX FUNCTION SPX(P,X) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'SPX'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DX=DBLE(X) C--- FUNCTION CALL --- FF=F36H2O(DP,DX) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DX,'P','X',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- SPX=SNGL(FF) RETURN END C------------------------------------------------- F37 = STD FUNCTION STD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'STD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F37H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- STD=SNGL(FF) RETURN END C------------------------------------------------- F38 = STDD FUNCTION STDD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'STDD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F38H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- STDD=SNGL(FF) RETURN END C------------------------------------------------- F39 = STX FUNCTION STX(T,X) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'STX'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) DX=DBLE(X) C--- FUNCTION CALL --- FF=F39H2O(DT,DX) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DT,DX,'T','X',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- STX=SNGL(FF) RETURN END C------------------------------------------------- F40 = TSP FUNCTION TSP(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TSP'/ C--- SET OF UNIT --- T0K=-DBLE(G99H2O(KPA,0.0)) DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F40H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TSP=SNGL(FF)+T0K RETURN END C------------------------------------------------- F41 = TRPL FUNCTION TRPL(A) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6,MSG*125,A*1 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TRPL'/ C--- FUNCTION CALL --- FF=F41H2O(A) C--- LEVEL 2 ERROR CHECK & MESSAGE --- IF(FF.EQ.-1.0E+20) THEN IF(MESS.NE.0) WRITE(6,6010) FUN,A 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR WATER', & ' WHEN A =',A,' ****') FF=-1.0E+20 END IF C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- IF(A.EQ.'T') THEN T0K=-DBLE(G99H2O(KPA,0.0)) IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 FF=SNGL(FF)+T0K ELSE IF(A.EQ.'P') THEN PBAR=G98H2O(KPA,1.0) IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0 FF=SNGL(FF)/PBAR END IF TRPL=SNGL(FF) RETURN END C------------------------------------------------- F42 = UPD FUNCTION UPD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F42H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- UPD=SNGL(FF) RETURN END C------------------------------------------------- F43 = UPDD FUNCTION UPDD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPDD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F43H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- UPDD=SNGL(FF) RETURN END C------------------------------------------------- F44 = UPT FUNCTION UPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F44H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- UPT=SNGL(FF) RETURN END C------------------------------------------------- F45 = UPX FUNCTION UPX(P,X) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPX'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DX=DBLE(X) C--- FUNCTION CALL --- FF=F45H2O(DP,DX) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DX,'P','X',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- UPX=SNGL(FF) RETURN END C------------------------------------------------- F46 = UTD FUNCTION UTD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UTD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F46H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- UTD=SNGL(FF) RETURN END C------------------------------------------------- F47 = UTDD FUNCTION UTDD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UTDD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F47H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- UTDD=SNGL(FF) RETURN END C------------------------------------------------- F48 = UTX FUNCTION UTX(T,X) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UTX'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) DX=DBLE(X) C--- FUNCTION CALL --- FF=F48H2O(DT,DX) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DT,DX,'T','X',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- UTX=SNGL(FF) RETURN END C------------------------------------------------- F49 = VPD FUNCTION VPD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F49H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- VPD=SNGL(FF) RETURN END C------------------------------------------------- F50 = VPDD FUNCTION VPDD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPDD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F50H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- VPDD=SNGL(FF) RETURN END C------------------------------------------------- F51 = VPT FUNCTION VPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F51H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- VPT=SNGL(FF) RETURN END C------------------------------------------------- F52 = VPX FUNCTION VPX(P,X) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPX'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DX=DBLE(X) C--- FUNCTION CALL --- FF=F52H2O(DP,DX) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DX,'P','X',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- VPX=SNGL(FF) RETURN END C------------------------------------------------- F53 = VTD FUNCTION VTD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F53H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- VTD=SNGL(FF) RETURN END C------------------------------------------------- F54 = VTDD FUNCTION VTDD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTDD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F54H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- VTDD=SNGL(FF) RETURN END C------------------------------------------------- F55 = VTX FUNCTION VTX(T,X) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VTX'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) DX=DBLE(X) C--- FUNCTION CALL --- FF=F55H2O(DT,DX) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DT,DX,'T','X',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- VTX=SNGL(FF) RETURN END C------------------------------------------------- F56 = XPH FUNCTION XPH(P,H) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XPH'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DH=DBLE(H) C--- FUNCTION CALL --- FF=F56H2O(DP,DH) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DH,'P','H',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- XPH=SNGL(FF) RETURN END C------------------------------------------------- F57 = XPS FUNCTION XPS(P,S) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XPS'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DS=DBLE(S) C--- FUNCTION CALL --- FF=F57H2O(DP,DS) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DS,'P','S',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- XPS=SNGL(FF) RETURN END C------------------------------------------------- F58 = XPU FUNCTION XPU(P,U) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XPU'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DU=DBLE(U) C--- FUNCTION CALL --- FF=F58H2O(DP,DU) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DU,'P','U',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- XPU=SNGL(FF) RETURN END C------------------------------------------------- F59 = XPV FUNCTION XPV(P,V) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XPV'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DV=DBLE(V) C--- FUNCTION CALL --- FF=F59H2O(DP,DV) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DV,'P','V',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- XPV=SNGL(FF) RETURN END C------------------------------------------------- F60 = XTH FUNCTION XTH(T,H) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XTH'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) DH=DBLE(H) C--- FUNCTION CALL --- FF=F60H2O(DT,DH) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DT,DH,'T','H',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- XTH=SNGL(FF) RETURN END C------------------------------------------------- F61 = XTS FUNCTION XTS(T,S) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XTS'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) DS=DBLE(S) C--- FUNCTION CALL --- FF=F61H2O(DT,DS) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DT,DS,'T','S',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- XTS=SNGL(FF) RETURN END C------------------------------------------------- F62 = XTU FUNCTION XTU(T,U) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XTU'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) DU=DBLE(U) C--- FUNCTION CALL --- FF=F62H2O(DT,DU) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DT,DU,'T','U',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- XTU=SNGL(FF) RETURN END C------------------------------------------------- F63 = XTV FUNCTION XTV(T,V) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'XTV'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) DV=DBLE(V) C--- FUNCTION CALL --- FF=F63H2O(DT,DV) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DT,DV,'T','V',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- XTV=SNGL(FF) RETURN END C------------------------------------------------- F64 = TPH FUNCTION TPH(P,H) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TPH'/ C--- SET OF UNIT --- T0K=-DBLE(G99H2O(KPA,0.0)) DP=DBLE(G98H2O(KPA,P)) DH=DBLE(H) C--- FUNCTION CALL --- FF=F64H2O(DP,DH) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DH,'P','H',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TPH=SNGL(FF)+T0K RETURN END C------------------------------------------------- F65 = TPS FUNCTION TPS(P,S) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TPS'/ C--- SET OF UNIT --- T0K=-DBLE(G99H2O(KPA,0.0)) DP=DBLE(G98H2O(KPA,P)) DS=DBLE(S) C--- FUNCTION CALL --- FF=F65H2O(DP,DS) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DS,'P','S',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TPS=SNGL(FF)+T0K RETURN END C------------------------------------------------- F66 = PLDT FUNCTION PLDT(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=T FUN='PLDT' IF (MESS.NE.0) CALL SE3H2O(FUN) PLDT=-1.0E+30 RETURN END C------------------------------------------------- F67 = TLDP FUNCTION TLDP(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P FUN='TLDP' IF (MESS.NE.0) CALL SE3H2O(FUN) TLDP=-1.0E+30 RETURN END C------------------------------------------------- F68 = PMLT FUNCTION PMLT(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=T FUN='PMLT' IF (MESS.NE.0) CALL SE3H2O(FUN) PMLT=-1.0E+30 RETURN END C------------------------------------------------- F69 = TMLP FUNCTION TMLP(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P FUN='TMLP' IF (MESS.NE.0) CALL SE3H2O(FUN) TMLP=-1.0E+30 RETURN END C------------------------------------------------- F70 = TPV FUNCTION TPV(P,V) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'TPV'/ C--- SET OF UNIT --- T0K=-DBLE(G99H2O(KPA,0.0)) DP=DBLE(G98H2O(KPA,P)) DV=DBLE(V) C--- FUNCTION CALL --- FF=F70H2O(DP,DV) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DV,'P','V',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TPV=SNGL(FF)+T0K RETURN END C------------------------------------------------- F71 = HPS FUNCTION HPS(P,S) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'HPS'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DS=DBLE(S) C--- FUNCTION CALL --- FF=F71H2O(DP,DS) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DS,'P','S',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- HPS=SNGL(FF) RETURN END C------------------------------------------------- F72 = PSTD FUNCTION PSTD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=T FUN='PSTD' IF (MESS.NE.0) CALL SE3H2O(FUN) PSTD=-1.0E+30 RETURN END C------------------------------------------------- F73 = PSTDD FUNCTION PSTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=T FUN='PSTDD' IF (MESS.NE.0) CALL SE3H2O(FUN) PSTDD=-1.0E+30 RETURN END C------------------------------------------------- F74 = TSPD FUNCTION TSPD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P FUN='TSPD' IF (MESS.NE.0) CALL SE3H2O(FUN) TSPD=-1.0E+30 RETURN END C------------------------------------------------- F75 = TSPDD FUNCTION TSPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P FUN='TSPDD' IF (MESS.NE.0) CALL SE3H2O(FUN) TSPDD=-1.0E+30 RETURN END C------------------------------------------------- F76 = CVPDD FUNCTION CVPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P FUN='CVPDD' IF (MESS.NE.0) CALL SE3H2O(FUN) CVPDD=-1.0E+30 RETURN END C------------------------------------------------- F77 = CVPT FUNCTION CVPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P X1=T FUN='CVPT' IF (MESS.NE.0) CALL SE3H2O(FUN) CVPT=-1.0E+30 RETURN END C------------------------------------------------- F78 = CVTDD FUNCTION CVTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=T FUN='CVTDD' IF (MESS.NE.0) CALL SE3H2O(FUN) CVTDD=-1.0E+30 RETURN END C------------------------------------------------- F79 = UPS FUNCTION UPS(P,S) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'UPS'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DS=DBLE(S) C--- FUNCTION CALL --- FF=F79H2O(DP,DS) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DS,'P','S',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- UPS=SNGL(FF) RETURN END C------------------------------------------------- F80 = VPS FUNCTION VPS(P,S) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'VPS'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DS=DBLE(S) C--- FUNCTION CALL --- FF=F80H2O(DP,DS) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DS,'P','S',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- VPS=SNGL(FF) RETURN END C------------------------------------------------- F81 = PRPT FUNCTION PRPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'PRPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F81H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- PRPT=SNGL(FF) RETURN END C------------------------------------------------- F82 = AKPT FUNCTION AKPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- FUN='AKPT' DATA FUN/'AKPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F82H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- AKPT=SNGL(FF) RETURN END C------------------------------------------------- F83 = WPT FUNCTION WPT(P,T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'WPT'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F83H2O(DP,DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,3,DP,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- WPT=SNGL(FF) RETURN END C------------------------------------------------- F85 = PRPD FUNCTION PRPD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'PRPD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F85H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- PRPD=SNGL(FF) RETURN END C------------------------------------------------- F86 = PRPDD FUNCTION PRPDD(P) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'PRPDD'/ C--- SET OF UNIT --- DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F86H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- PRPDD=SNGL(FF) RETURN END C------------------------------------------------- F87 = PRTD FUNCTION PRTD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'PRTD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F87H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- PRTD=SNGL(FF) RETURN END C------------------------------------------------- F88 = PRTDD FUNCTION PRTDD(T) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6 INTEGER KPA,MESS COMMON/UNIT/KPA,MESS C--- FUNCTION NAME --- DATA FUN/'PRTDD'/ C--- SET OF UNIT --- DT=DBLE(G99H2O(KPA,T)) C--- FUNCTION CALL --- FF=F88H2O(DT) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,2,DT,DT,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- PRTDD=SNGL(FF) RETURN END C------------------------------------------------- F94 = AJTPT FUNCTION AJTPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='AJTPT' IF (MESS.NE.0) CALL SE3H2O(FUN) AJTPT=-1.0E+30 RETURN END C------------------------------------------------- F92 = BPPT FUNCTION BPPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='BPPT' IF (MESS.NE.0) CALL SE3H2O(FUN) BPPT=-1.0E+30 RETURN END C------------------------------------------------- F90 = BSPT FUNCTION BSPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='BSPT' IF (MESS.NE.0) CALL SE3H2O(FUN) BSPT=-1.0E+30 RETURN END C------------------------------------------------- F91 = BTPT FUNCTION BTPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='BTPT' IF (MESS.NE.0) CALL SE3H2O(FUN) BTPT=-1.0E+30 RETURN END C------------------------------------------------- F93 = BVPT FUNCTION BVPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='BVPT' IF (MESS.NE.0) CALL SE3H2O(FUN) BVPT=-1.0E+30 RETURN END C------------------------------------------------- F96 = GAMPDD FUNCTION GAMPDD(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P FUN='GAMPDD' IF (MESS.NE.0) CALL SE3H2O(FUN) GAMPDD=-1.0E+30 RETURN END C------------------------------------------------- F95 = GAMPT FUNCTION GAMPT(P,T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P*T FUN='GAMPT' IF (MESS.NE.0) CALL SE3H2O(FUN) GAMPT=-1.0E+30 RETURN END C------------------------------------------------- F97 = GAMTDD FUNCTION GAMTDD(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=T FUN='GAMTDD' IF (MESS.NE.0) CALL SE3H2O(FUN) GAMTDD=-1.0E+30 RETURN END C---------------------------------------------------------------------- C----- FUNCTION SUBRROGRM TPSEUP(P) TO FIND PSEUDO BOILING POINT C----- AS A FUNCTION OF PRESSSURE TPSEUP.FOR C---------------------------------------------------------------------- C------------------------------------------------- F98 = TPSEUP FUNCTION TPSEUP(P) COMMON /UNIT/KPA,MESS DOUBLE PRECISION DP,FF,F98H2O,T0K CHARACTER FUN*6 FUN='TPSEUP' C--- SET OF UNIT --- T0K=-DBLE(G99H2O(KPA,0.0)) DP=DBLE(G98H2O(KPA,P)) C--- FUNCTION CALL --- FF=F98H2O(DP) C--- ERROR CHECK & MESSAGE --- IF (MESS.NE.0) CALL SE1H2O(FF,1,DP,DP,'P','T',FUN) C--- SUBSDTTUDTON OF THE VALUE INTO THE FUNCTION --- IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0 TPSEUP=SNGL(FF+T0K) RETURN END C------------------------------------------------- F99 = PSBT FUNCTION PSBT(T) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=T FUN='PSBT' IF (MESS.NE.0) CALL SE3H2O(FUN) PSBT=-1.0E+30 RETURN END C------------------------------------------------- F100 = TSBP FUNCTION TSBP(P) CHARACTER FUN*6 COMMON/UNIT/KPA,MESS X1=P FUN='TSBP' IF (MESS.NE.0) CALL SE3H2O(FUN) TSBP=-1.0E+30 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,KPA,MESSC,MESS KPA=KPAC MESS=MESSC RETURN END C *** FUNCTION FOR SETDTNG UNITS **** FUNCTION G98H2O(KPA,P) IMPLICIT REAL*8 (D,F) IF(KPA.EQ.1) THEN PBAR=1.0E0 ELSE IF(KPA.EQ.2) THEN PBAR=1.0E0 ELSE IF(KPA.EQ.3) THEN PBAR=1.0E-05 ELSE PBAR=1.0E-05 END IF G98H2O=P*PBAR RETURN END FUNCTION G99H2O(KPA,T) IMPLICIT REAL*8 (D,F) IF(KPA.EQ.1) THEN T0K=0.0E0 ELSE IF(KPA.EQ.2) THEN T0K=273.15E0 ELSE IF(KPA.EQ.3) THEN T0K=0.0E0 ELSE T0K=273.15E0 END IF G99H2O=T-T0K RETURN END C ******* SUBROUDTNE FOR ERROR CHECK & MESSAGE ******* C *** LEVEL 1 & 2 ERROR - SUBROUTINE SE1H2O(FF,IPT,DP,DT,N1,N2,FUN) IMPLICIT REAL*8 (D,F) CHARACTER FUN*6,N1*1,N2*1 C *** LEVEL 1 ERROR CHECK & MESSAGE - IF(FF.EQ.-1.0E+10) THEN WRITE(6,6000) FUN 6000 FORMAT(1H ,5X,'**** NO CONVERGENCE AT ',A6,' FOR WATER ****') C *** LEVEL 2 ERROR CHECK & MESSAGE - ELSE IF(FF.EQ.-1.0E+20) THEN IF (IPT.EQ.1) THEN C--- FUN(P) TYPED WRITE(6,6010) FUN,DP 6010 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR WATER', & ' WHEN P =',1PE14.7,' ****') C--- FUN(T) TYPE ELSE IF(IPT.EQ.2) THEN WRITE(6,6020) FUN,DT 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR WATER', & ' WHEN T =',1PE14.7,' ****') C--- FUN(P,T) TYPE ELSE WRITE(6,6030) FUN,N1,DP,N2,DT 6030 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6,' FOR WATER', &' WHEN ',A1,' =',1PE14.7,' AND ',A1,' =',1PE14.7,' ****') END IF END IF RETURN END C *** LEVEL 3 ERROR MESSAGE - SUBROUTINE SE3H2O(FUN) CHARACTER FUN*6,MSG*125 MSG='**** FUNCTION '//FUN//' UNAVAILABLE FOR WATER ****' WRITE(6,100) MSG 100 FORMAT(1H ,5X,A) RETURN END C1**AIPPT DOUBLE PRECISION FUNCTION F1H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 DATA A/ -4.098D00/, B/ -3.2452D+03/, C/ 2.2362D+05/, * D/ -3.984D+07/, E/ 1.3957D+01/, F/ -1.2623D+03/, * G/ 8.5641D+05/ CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.0) GO TO 650 CITA=(CT+T0)/TC1 BETA=P*1.0D+05/PC1 CALL S1H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 700 RHO=1.0/(1.0D03*SVC1*RKAI) T=CITA*TC1 G1=A+B/T+C/(T*T)+D/T**3+(E+F/T+G/(T*T))*DLOG10(RHO) F1H2O=10.0**G1 RETURN 650 CONTINUE F1H2O=-1.0E+20 RETURN END C2**ALAPP DOUBLE PRECISION FUNCTION F2H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 DATA C1/0.2358D00/, C2/1.256D00/, C3/0.625D00/ CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) SVL=F49H2O(P) IF(SVL.LT.0.) GO TO 650 SVV=F50H2O(P) IF(SVV.LT.0.) GO TO 650 GRVT=9.80665D00 TEMP=1.0-CITA SIGMA=C1*TEMP**C2*(1.0-C3*TEMP) F2H2O=DSQRT(SIGMA*SVL*SVV/(GRVT*(SVV-SVL))) RETURN 3 F2H2O=0.0 RETURN 650 CONTINUE F2H2O=-1.0E+20 RETURN END C3 **ALAPT DOUBLE PRECISION FUNCTION F3H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 DATA C1/0.2358D00/, C2/1.256D00/, C3/0.625D00/ CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 CITA=(CT+T0)/TC1 SVL=F53H2O(CT) IF(SVL.LT.0.) GO TO 650 SVV=F54H2O(CT) IF(SVV.LT.0.) GO TO 650 GRVT=9.80665D00 TEMP=1.0-CITA SIGMA=C1*TEMP**C2*(1.0-C3*TEMP) F3H2O=DSQRT(SIGMA*SVL*SVV/(GRVT*(SVV-SVL))) RETURN 3 F3H2O=0.0 RETURN 650 CONTINUE F3H2O=-1.0E+20 RETURN END C4**ALHP DOUBLE PRECISION FUNCTION F4H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 HHL=F23H2O(P) IF(HHL.LT.-100.0) GO TO 650 HHV=F24H2O(P) IF(HHV.LT.0.) GO TO 650 700 F4H2O=(HHV-HHL) RETURN 3 F4H2O=0.0 RETURN 650 CONTINUE F4H2O=-1.0E+20 RETURN END C5**ALHT DOUBLE PRECISION FUNCTION F5H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 HHL=F27H2O(CT) IF(HHL.LT.-100.0) GO TO 650 HHV=F28H2O(CT) IF(HHV.LT.0.) GO TO 650 700 F5H2O=(HHV-HHL) RETURN 3 F5H2O=0.0 RETURN 650 CONTINUE F5H2O=-1.0E+20 RETURN END C6**ALMPD DOUBLE PRECISION FUNCTION F6H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 300 200 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S2H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 300 CALL S27H2O(DLM,RKAI,CITA) F6H2O=DLM RETURN 650 CONTINUE F6H2O=-1.0E+20 RETURN END C7**ALMPDD DOUBLE PRECISION FUNCTION F7H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 300 200 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S3H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 300 CALL S27H2O(DLM,RKAI,CITA) F7H2O=DLM RETURN 650 CONTINUE F7H2O=-1.0E+20 RETURN END C8**ALMPT DOUBLE PRECISION FUNCTION F8H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.) GO TO 650 CITA=(CT+T0)/TC1 BETA=P*1.0D+05/PC1 CALL S1H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 CALL S27H2O(DLM,RKAI,CITA) F8H2O=DLM RETURN 650 CONTINUE F8H2O=-1.0E+20 RETURN END C9**ALMTD DOUBLE PRECISION FUNCTION F9H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 300 200 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S2H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 300 CALL S27H2O(DLM,RKAI,CITA) F9H2O=DLM RETURN 650 CONTINUE F9H2O=-1.0E+20 RETURN END C10**ALMTDD DOUBLE PRECISION FUNCTION F10H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 300 200 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S3H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 300 CALL S27H2O(DLM,RKAI,CITA) F10H2O=DLM RETURN 650 CONTINUE F10H2O=-1.0E+20 RETURN END C11**AMUPD DOUBLE PRECISION FUNCTION F11H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 300 200 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S2H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 300 CALL S26H2O(DMU,RKAI,CITA) F11H2O=DMU RETURN 650 CONTINUE F11H2O=-1.0E+20 RETURN END C12**AMUPDD DOUBLE PRECISION FUNCTION F12H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 300 200 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S3H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 300 CALL S26H2O(DMU,RKAI,CITA) F12H2O=DMU RETURN 650 CONTINUE F12H2O=-1.0E+20 RETURN END C13**AMUPT DOUBLE PRECISION FUNCTION F13H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.) GO TO 650 CITA=(CT+T0)/TC1 BETA=P*1.0D+05/PC1 CALL S1H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 CALL S26H2O(DMU,RKAI,CITA) F13H2O=DMU RETURN 650 CONTINUE F13H2O=-1.0E+20 RETURN END C14**AMUTD DOUBLE PRECISION FUNCTION F14H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 300 200 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S2H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 300 CALL S26H2O(DMU,RKAI,CITA) F14H2O=DMU RETURN 650 CONTINUE F14H2O=-1.0E+20 RETURN END C15**AMUTDD DOUBLE PRECISION FUNCTION F15H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 300 200 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S3H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 300 CALL S26H2O(DMU,RKAI,CITA) F15H2O=DMU RETURN 650 CONTINUE F15H2O=-1.0E+20 RETURN END C16**CPPD DOUBLE PRECISION FUNCTION F16H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S5H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S16H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S19H2O(EPSION,RKAI,CITA) 700 F16H2O=EPSION*PC1*SVC1/TC1 RETURN 3 F16H2O=6.722550189D+12 RETURN 650 CONTINUE F16H2O=-1.0E+20 RETURN END C17**CPPDD DOUBLE PRECISION FUNCTION F17H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S6H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S17H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S18H2O(EPSION,RKAI,CITA) 700 F17H2O=EPSION*PC1*SVC1/TC1 RETURN 3 F17H2O=6.722550189D+12 RETURN 650 CONTINUE F17H2O=-1.0E+20 RETURN END C18**CPPT DOUBLE PRECISION FUNCTION F18H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.) GO TO 650 100 CITA=(CT+T0)/TC1 BETA=P*1.0D+05/PC1 CALL S4H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3,4), ILL 1 CALL S16H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S17H2O(EPSION,CITA,BETA) GO TO 700 3 CALL S18H2O(EPSION,RKAI,CITA) GO TO 700 4 CALL S19H2O(EPSION,RKAI,CITA) 700 F18H2O=EPSION*PC1*SVC1/TC1 RETURN 650 CONTINUE F18H2O=-1.0E+20 RETURN END C19**CPTD DOUBLE PRECISION FUNCTION F19H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S5H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S16H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S19H2O(EPSION,RKAI,CITA) 700 F19H2O=EPSION*PC1*SVC1/TC1 RETURN 3 F19H2O=6.722550189D+12 RETURN 650 CONTINUE F19H2O=-1.0E+20 RETURN END C20**CPTDD DOUBLE PRECISION FUNCTION F20H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S6H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S17H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S18H2O(EPSION,RKAI,CITA) 700 F20H2O=EPSION*PC1*SVC1/TC1 RETURN 3 F20H2O=6.722550189D+12 RETURN 650 CONTINUE F20H2O=-1.0E+20 RETURN END C21**CRP DOUBLE PRECISION FUNCTION F21H2O(A) IMPLICIT DOUBLE PRECISION (A-H) CHARACTER*1 A,B(5) DATA B/'P','T','V','H','S'/ DO 20 I=1,5 IF(A.EQ.B(I)) GO TO (1,2,3,4,5), I 20 CONTINUE F21H2O=-1.0E+20 RETURN 1 F21H2O=221.2D00 RETURN 2 F21H2O=374.15D00 RETURN 3 F21H2O=3.17D-03 RETURN 4 F21H2O=2.1074D06 RETURN 5 F21H2O=4.44286D03 RETURN END C22**EPSPT DOUBLE PRECISION FUNCTION F22H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 C ** NUMERICAL VALUES OF DERIVED CONSTANS ** C * DATA BETA2/ 4.5207956601D+00/, CITAT/ 4.219990730D-01/, C * * CITA2/ 1.333462073D+00/, CITA3/ 1.657886606D+00/ DATA A1/7.62571D00/, A2/2.44003D+02/, A3/-1.40569D+02/, * A4/2.77841D+01/, A5/-9.62805D+01/, A6/4.17909D+01/, * A7/-1.02099D+01/, A8/-4.52059D+01/, A9/8.46395D+01/, * A10/-3.58644D+01/, TT0/298.15D00/, RHO0/1.0D03/ CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.0) GO TO 650 CITA=(CT+T0)/TC1 BETA=P*1.0D+05/PC1 CALL S1H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 700 RHO=1.0/(SVC1*RKAI) TEM=CITA*TC1/TT0 RHOR=RHO/RHO0 F22H2O=1.0+A1/TEM*RHOR+(A2/TEM+A3+A4*TEM)*RHOR*RHOR 1 +(A5/TEM+A6*TEM+A7*TEM*TEM)*RHOR**3+(A8/TEM/TEM+A9/TEM+A10) 2 *RHOR**4 RETURN 650 CONTINUE F22H2O=-1.0E+20 RETURN END C23**HPD DOUBLE PRECISION FUNCTION F23H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S5H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO(1,2,3),ILL 1 CALL S12H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S15H2O(EPSION,RKAI,CITA) 700 F23H2O=(PC1*SVC1)*EPSION RETURN 3 F23H2O=0.21073732D+07 RETURN 650 CONTINUE F23H2O=-1.0E+20 RETURN END C24**HPDD DOUBLE PRECISION FUNCTION F24H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S6H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S13H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S14H2O(EPSION,RKAI,CITA,BETA) 700 F24H2O=(PC1*SVC1)*EPSION RETURN 3 F24H2O=0.21073732D+07 RETURN 650 CONTINUE F24H2O=-1.0E+20 RETURN END C25**HPT DOUBLE PRECISION FUNCTION F25H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.) GO TO 650 CITA=(CT+T0)/TC1 BETA=P*1.0D+05/PC1 CALL S4H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3,4), ILL 1 CALL S12H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S13H2O(EPSION,CITA,BETA) GO TO 700 3 CALL S14H2O(EPSION,RKAI,CITA,BETA) GO TO 700 4 CALL S15H2O(EPSION,RKAI,CITA) 700 F25H2O=(PC1*SVC1)*EPSION RETURN 650 CONTINUE F25H2O=-1.0E+20 RETURN END C27**HTX DOUBLE PRECISION FUNCTION F26H2O(P,X) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(X.LT.0..OR.X.GT.VPXX) GO TO 650 IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 HHL=F23H2O(P) IF(HHL.LT.-100.0) GO TO 650 HHV=F24H2O(P) IF(HHV.LT.0.) GO TO 650 700 F26H2O=HHL+X*(HHV-HHL) RETURN 3 F26H2O=0.21073732D+07 RETURN 650 CONTINUE F26H2O=-1.0E+20 RETURN END C27**HTD DOUBLE PRECISION FUNCTION F27H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S5H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S12H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S15H2O(EPSION,RKAI,CITA) 700 F27H2O=(PC1*SVC1)*EPSION RETURN 3 F27H2O=0.21073732D+07 RETURN 650 CONTINUE F27H2O=-1.0E+20 RETURN END C28**HTDD DOUBLE PRECISION FUNCTION F28H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S6H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S13H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S14H2O(EPSION,RKAI,CITA,BETA) 700 F28H2O=(PC1*SVC1)*EPSION RETURN 3 F28H2O=0.21073732D+07 RETURN 650 CONTINUE F28H2O=-1.0E+20 RETURN END C29**HTX DOUBLE PRECISION FUNCTION F29H2O(CT,X) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(X.LT.0..OR.X.GT.VPXX) GO TO 650 IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 HHL=F27H2O(CT) IF(HHL.LT.-100.0) GO TO 650 HHV=F28H2O(CT) IF(HHV.LT.0.) GO TO 650 700 F29H2O=HHL+X*(HHV-HHL) RETURN 3 F29H2O=0.21073732D+07 RETURN 650 CONTINUE F29H2O=-1.0E+20 RETURN END C30**PST DOUBLE PRECISION FUNCTION F30H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O C CHECK OF THE RANGE OF ARGUMENT IF((0.LE.CT).AND.(CT.LE.CRTM)) THEN CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) F30H2O=BETA*PC1/1.0D+05 ELSE IF((-100.LE.CT).AND.(CT.LT.0.)) THEN F30H2O=FEH2O(CT) ELSE F30H2O=-1.0E+20 END IF RETURN END C31**SIGP DOUBLE PRECISION FUNCTION F31H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 DATA C1/0.2358D00/, C2/1.256D00/, C3/0.625D00/ CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) TEMP=1.0-CITA F31H2O=C1*TEMP**C2*(1.0-C3*TEMP) RETURN 3 F31H2O=0.0 RETURN 650 CONTINUE F31H2O=-1.0E+20 RETURN END C32**SIGT DOUBLE PRECISION FUNCTION F32H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 DATA C1/0.2358D00/, C2/1.256D00/, C3/0.625D00/ CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 CITA=(CT+T0)/TC1 TEMP=1.0-CITA F32H2O=C1*TEMP**C2*(1.0-C3*TEMP) RETURN 3 F32H2O=0.0 RETURN 650 CONTINUE F32H2O=-1.0E+20 RETURN END C33**SPD DOUBLE PRECISION FUNCTION F33H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S5H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S20H2O(SIGUMA,CITA,BETA) GO TO 700 2 CALL S23H2O(SIGUMA,RKAI,CITA) 700 F33H2O=(PC1*SVC1/TC1)*SIGUMA RETURN 3 F33H2O=0.44428649D+04 RETURN 650 CONTINUE F33H2O=-1.0E+20 RETURN END C34**SPDD DOUBLE PRECISION FUNCTION F34H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S6H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S21H2O(SIGUMA,CITA,BETA) GO TO 700 2 CALL S22H2O(SIGUMA,RKAI,CITA) 700 F34H2O=(PC1*SVC1/TC1)*SIGUMA RETURN 3 F34H2O=0.44428649D+04 RETURN 650 CONTINUE F34H2O=-1.0E+20 RETURN END C35**SPT DOUBLE PRECISION FUNCTION F35H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.0) GO TO 650 CITA=(CT+T0)/TC1 BETA=P*1.0D+05/PC1 CALL S4H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3,4), ILL 1 CALL S20H2O(SIGUMA,CITA,BETA) GO TO 700 2 CALL S21H2O(SIGUMA,CITA,BETA) GO TO 700 3 CALL S22H2O(SIGUMA,RKAI,CITA) IF(SIGUMA.LT.0.) GO TO 650 GO TO 700 4 CALL S23H2O(SIGUMA,RKAI,CITA) 700 F35H2O=(PC1*SVC1/TC1)*SIGUMA RETURN 650 CONTINUE F35H2O=-1.0E+20 RETURN END C36**SPX DOUBLE PRECISION FUNCTION F36H2O(P,X) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(X.LT.0.0.OR.X.GT.VPXX) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 SSL=F33H2O(P) IF(SSL.LT.-100.0) GO TO 650 SSV=F34H2O(P) IF(SSV.LT.0.) GO TO 650 700 F36H2O=SSL+X*(SSV-SSL) RETURN 3 F36H2O=0.44428649D+04 RETURN 650 CONTINUE F36H2O=-1.0E+20 RETURN END C37**STD DOUBLE PRECISION FUNCTION F37H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S5H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S20H2O(SIGUMA,CITA,BETA) GO TO 700 2 CALL S23H2O(SIGUMA,RKAI,CITA) 700 F37H2O=(PC1*SVC1/TC1)*SIGUMA RETURN 3 F37H2O=0.44428649D+04 RETURN 650 CONTINUE F37H2O=-1.0E+20 RETURN END C38**STDD DOUBLE PRECISION FUNCTION F38H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S6H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3), ILL 1 CALL S21H2O(SIGUMA,CITA,BETA) GO TO 700 2 CALL S22H2O(SIGUMA,RKAI,CITA) 700 F38H2O=(PC1*SVC1/TC1)*SIGUMA RETURN 3 F38H2O=0.44428649D+04 RETURN 650 CONTINUE F38H2O=-1.0E+20 RETURN END C39**STX DOUBLE PRECISION FUNCTION F39H2O(CT,X) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(X.LT.0..OR.X.GT.VPXX) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 SSL=F37H2O(CT) IF(SSL.LT.-100.0) GO TO 650 SSV=F38H2O(CT) IF(SSV.LT.0.) GO TO 650 700 F39H2O=SSL+X*(SSV-SSL) RETURN 3 F39H2O=0.44428649D+04 RETURN 650 CONTINUE F39H2O=-1.0E+20 RETURN END C40**TSP DOUBLE PRECISION FUNCTION F40H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O C CHECK OF THE RANGE OF ARGUMENT IF((ZPR0.LE.P).AND.(P.LE.CRPR)) THEN BETA=P*1.0D+05/PC1 CALL S7H2O(CITAK,BETA) CITA=CITAK BETAK=BETA F40H2O=CITA*TC1-T0 ELSE IF((1.40749D-08.LE.P).AND.(P.LT.ZPR0)) THEN F40H2O=FFH2O(P) ELSE F40H2O=-1.0E+20 END IF RETURN END C41**TRPL DOUBLE PRECISION FUNCTION F41H2O(A) IMPLICIT DOUBLE PRECISION (A-H) CHARACTER*1 A,B(2) DATA B/'P','T'/ DO 20 I=1,2 IF(A.EQ.B(I)) GO TO (1,2), I 20 CONTINUE F41H2O=-1.0E+20 RETURN 1 F41H2O=611.2D-05 RETURN 2 F41H2O=0.01D00 RETURN END C42**UPD DOUBLE PRECISION FUNCTION F42H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 PP=P*1.D+05 HH=F23H2O(P) IF(HH.LT.-100.0) GO TO 650 VV=F49H2O(P) IF(VV.LT.0.) GO TO 650 F42H2O=HH-PP*VV RETURN 650 CONTINUE F42H2O=-1.0E+20 RETURN END C43**UPDD DOUBLE PRECISION FUNCTION F43H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 PP=P*1.D+05 HH=F24H2O(P) IF(HH.LT.0.) GO TO 650 VV=F50H2O(P) IF(VV.LT.0.) GO TO 650 F43H2O=HH-PP*VV RETURN 650 CONTINUE F43H2O=-1.0E+20 RETURN END C44**UPT DOUBLE PRECISION FUNCTION F44H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.0) GO TO 650 PP=P*1.D+05 HH=F25H2O(P,CT) IF(HH.LT.-100.0) GO TO 650 VV=F51H2O(P,CT) IF(VV.LT.0.) GO TO 650 F44H2O=HH-PP*VV RETURN 650 CONTINUE F44H2O=-1.0E+20 RETURN END C45**UPX DOUBLE PRECISION FUNCTION F45H2O(P,X) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(X.LT.0..OR.X.GT.VPXX) GO TO 650 PP=P*1.D+05 HHL=F23H2O(P) IF(HHL.LT.-100.0) GO TO 650 HHV=F24H2O(P) IF(HHV.LT.0.) GO TO 650 SVL=F49H2O(P) IF(SVL.LT.0.) GO TO 650 SVV=F50H2O(P) IF(SVV.LT.0.) GO TO 650 UUL=HHL-PP*SVL UUV=HHV-PP*SVV F45H2O=UUL+X*(UUV-UUL) RETURN 650 CONTINUE F45H2O=-1.0E+20 RETURN END C46**UTD DOUBLE PRECISION FUNCTION F46H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 BETA=FCH2O((CT+T0)/TC1) PP=BETA*PC1 HH=F27H2O(CT) IF(HH.LT.-100.0) GO TO 650 VV=F53H2O(CT) IF(VV.LT.0.) GO TO 650 F46H2O=HH-PP*VV RETURN 650 CONTINUE F46H2O=-1.0E+20 RETURN END C47**UTDD DOUBLE PRECISION FUNCTION F47H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 BETA=FCH2O((CT+T0)/TC1) PP=BETA*PC1 HH=F28H2O(CT) IF(HH.LT.-100.0) GO TO 650 VV=F54H2O(CT) IF(VV.LT.0.) GO TO 650 F47H2O=HH-PP*VV RETURN 650 CONTINUE F47H2O=-1.0E+20 RETURN END C48**UTX DOUBLE PRECISION FUNCTION F48H2O(CT,X) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(X.LT.0..OR.X.GT.VPXX) GO TO 650 BETA=FCH2O((CT+T0)/TC1) PP=BETA*PC1 HHL=F27H2O(CT) IF(HHL.LT.-100.0) GO TO 650 HHV=F28H2O(CT) IF(HHV.LT.0.) GO TO 650 SVL=F53H2O(CT) IF(SVL.LT.0.) GO TO 650 SVV=F54H2O(CT) IF(SVV.LT.0.) GO TO 650 UUL=HHL-PP*SVL UUV=HHV-PP*SVV F48H2O=UUL+X*(UUV-UUL) RETURN 650 CONTINUE F48H2O=-1.0E+20 RETURN END C49**VPD DOUBLE PRECISION FUNCTION F49H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 800 200 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S2H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 800 F49H2O=SVC1*RKAI RETURN 650 CONTINUE F49H2O=-1.0E+20 RETURN END C50**VPDD DOUBLE PRECISION FUNCTION F50H2O(P) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 800 200 BETA=P*1.0D+05/PC1 CALL S7H2O(CITA,BETA) CALL S3H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 800 F50H2O=SVC1*RKAI RETURN 650 CONTINUE F50H2O=-1.0E+20 RETURN END C51**VPT DOUBLE PRECISION FUNCTION F51H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.0) GO TO 650 400 CITA=(CT+T0)/TC1 BETA=P*1.0D+05/PC1 CALL S1H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 700 F51H2O=SVC1*RKAI RETURN 650 CONTINUE F51H2O=-1.0E+20 RETURN END C52**VPX DOUBLE PRECISION FUNCTION F52H2O(P,X) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(X.LT.0..OR.X.GT.VPXX) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 SVL=F49H2O(P) IF(SVL.LT.0.) GO TO 650 SVV=F50H2O(P) IF(SVV.LT.0.) GO TO 650 F52H2O=SVL+X*(SVV-SVL) RETURN 3 F52H2O=SVC1 RETURN 650 CONTINUE F52H2O=-1.0E+20 RETURN END C53**VTD DOUBLE PRECISION FUNCTION F53H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 800 200 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S2H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0.) GO TO 650 800 F53H2O=SVC1*RKAI RETURN 650 CONTINUE F53H2O=-1.0E+20 RETURN END C54**VTDD DOUBLE PRECISION FUNCTION F54H2O(CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D02).GT.1.0D-3) GO TO 200 RKAI=1.0D00 GO TO 800 200 CITA=(CT+T0)/TC1 BETA=FCH2O(CITA) CALL S3H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 800 F54H2O=SVC1*RKAI RETURN 650 CONTINUE F54H2O=-1.0E+20 RETURN END C55**VTX DOUBLE PRECISION FUNCTION F55H2O(CT,X) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(X.LT.0..OR.X.GT.VPXX) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 SVL=F53H2O(CT) IF(SVL.LT.0.) GO TO 650 SVV=F54H2O(CT) IF(SVV.LT.0.) GO TO 650 800 F55H2O=SVL+X*(SVV-SVL) RETURN 3 F55H2O=SVC1 RETURN 650 CONTINUE F55H2O=-1.0E+20 RETURN END C56**XPH DOUBLE PRECISION FUNCTION F56H2O(P,HH) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(HH.LT.-42.2.OR.HH.GT.2.805D+6) GO TO 650 IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 HHL=F23H2O(P) IF(HHL.LT.-100.0) GO TO 650 HHV=F24H2O(P) IF(HHV.LT.0.) GO TO 650 700 F56H2O=(HH-HHL)/(HHV-HHL) RETURN 3 F56H2O=0.0 RETURN 650 CONTINUE F56H2O=-1.0E+20 RETURN END C57**XPS DOUBLE PRECISION FUNCTION F57H2O(P,SS) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(SS.LT.-0.16.OR.SS.GT.9.158D03) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 SSL=F33H2O(P) IF(SSL.LT.-100.0) GO TO 650 SSV=F34H2O(P) IF(SSV.LT.0.) GO TO 650 700 F57H2O=(SS-SSL)/(SSV-SSL) RETURN 3 F57H2O=0.0 RETURN 650 CONTINUE F57H2O=-1.0E+20 RETURN END C58**XPU DOUBLE PRECISION FUNCTION F58H2O(P,UU) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(UU.LT.-4.218D+01.OR.UU.GT.2.605D+06) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 UUL=F42H2O(P) IF(UUL.LT.-100.0) GO TO 650 UUV=F43H2O(P) IF(UUV.LT.0.) GO TO 650 F58H2O=(UU-UUL)/(UUV-UUL) RETURN 3 F58H2O=0.0 RETURN 650 CONTINUE F58H2O=-1.0E+20 RETURN END C59**XPV DOUBLE PRECISION FUNCTION F59H2O(P,VV) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.LE.ZPR0.OR.P.GT.CRPR) GO TO 650 IF(VV.LT.1.D-03.OR.VV.GT.2.0631D+02) GO TO 650 IF(DABS(P-2.212D02).LT.1.0D-3) GO TO 3 SVL=F49H2O(P) IF(SVL.LT.0.) GO TO 650 SVV=F50H2O(P) IF(SVV.LT.0.) GO TO 650 F59H2O=(VV-SVL)/(SVV-SVL) RETURN 3 F59H2O=0.0 RETURN 650 CONTINUE F59H2O=-1.0E+20 RETURN END C60**XTH DOUBLE PRECISION FUNCTION F60H2O(CT,HH) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(HH.LT.-42.2.OR.HH.GT.2.805D+6) GO TO 650 IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 HHL=F27H2O(CT) IF(HHL.LT.-100.0) GO TO 650 HHV=F28H2O(CT) IF(HHV.LT.0.) GO TO 650 700 F60H2O=(HH-HHL)/(HHV-HHL) RETURN 3 F60H2O=0.0 RETURN 650 CONTINUE F60H2O=-1.0E+20 RETURN END C61**XTS DOUBLE PRECISION FUNCTION F61H2O(CT,SS) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0.0.OR.CT.GT.CRTM) GO TO 650 IF(SS.LT.-0.16.OR.SS.GT.9.158D03) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 SSL=F37H2O(CT) IF(SSL.LT.-100.0) GO TO 650 SSV=F38H2O(CT) IF(SSV.LT.0.) GO TO 650 700 F61H2O=(SS-SSL)/(SSV-SSL) RETURN 3 F61H2O=0.0 RETURN 650 CONTINUE F61H2O=-1.0E+20 RETURN END C62**XTU DOUBLE PRECISION FUNCTION F62H2O(CT,UU) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(UU.LT.-4.218D+01.OR.UU.GT.2.605D+06) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 UUL=F46H2O(CT) IF(UUL.LT.-100.0) GO TO 650 UUV=F47H2O(CT) IF(UUV.LT.0.) GO TO 650 F62H2O=(UU-UUL)/(UUV-UUL) RETURN 3 F62H2O=0.0 RETURN 650 CONTINUE F62H2O=-1.0E+20 RETURN END C63**XTV DOUBLE PRECISION FUNCTION F63H2O(CT,VV) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(CT.LT.0..OR.CT.GT.CRTM) GO TO 650 IF(VV.LT.1.D-03.OR.VV.GT.2.0631D+02) GO TO 650 IF(DABS(CT-3.7415D2).LT.1.0D-3) GO TO 3 SVL=F53H2O(CT) IF(SVL.LT.0.) GO TO 650 SVV=F54H2O(CT) IF(SVV.LT.0.) GO TO 650 F63H2O=(VV-SVL)/(SVV-SVL) RETURN 3 F63H2O=0.0 RETURN 650 CONTINUE F63H2O=-1.0E+20 RETURN END C64**TPH DOUBLE PRECISION FUNCTION F64H2O(P,H) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 TOK=273.15 ILL=0 H23=F23H2O(P) H24=F24H2O(P) IF((P.LE.CRPR).AND.(H.GE.H23).AND.(H.LE.H24)) THEN F64H2O=F40H2O(P) ELSE IF (P.GT.CRPR) THEN TO=CRTM H0=F25H2O(P,TO) IF(H0.LE.-1000.0) GO TO 100 CP=F18H2O(P,TO) IF(CP.LE.-1000.0) GO TO 100 T1=TO+(H-H0)/CP H1=F25H2O(P,T1) IF(H1.LE.-1000.0) GO TO 100 GO TO 110 100 ILL=-10000 110 CONTINUE ELSE IF((P.LE.CRPR).AND.(H.LT.H23)) THEN TO=F40H2O(P) IF(TO.LE.-1000.0) GO TO 200 H0=F23H2O(P) IF(H0.LE.-1000.0) GO TO 200 CP=F16H2O(P) IF(CP.LE.-1000.0) GO TO 200 T1=TO+(H-H0)/CP H1=F25H2O(P,T1) IF(H1.LE.-1000.0) GO TO 200 GO TO 210 200 ILL=-10000 210 CONTINUE ELSE IF((P.LE.CRPR).AND.(H.GT.H24)) THEN TO=F40H2O(P) IF(TO.LE.-1000.0) GO TO 300 H0=F24H2O(P) IF(H0.LE.-1000.0) GO TO 300 CP=F17H2O(P) IF(CP.LE.-1000.0) GO TO 300 T1=TO+(H-H0)/CP H1=F25H2O(P,T1) IF(H1.LE.-1000.0) GO TO 300 GO TO 310 300 ILL=-10000 310 CONTINUE END IF IF(ILL.LE.-10000) GO TO 650 NIT=0 1000 DELT=(H-H1)*(T1-TO)/(H1-H0) RDELT=DABS(DELT/(T1+TOK)) IF(NIT.GE.10000) GO TO 630 IF(RDELT.LT.1.0E-7) GO TO 1100 TO=T1 H0=H1 T1=T1+DELT H1=F25H2O(P,T1) NIT=NIT+1 GO TO 1000 1100 F64H2O=T1 GO TO 400 630 F64H2O=-1.0E+10 GO TO 400 650 F64H2O=-1.0E+20 400 CONTINUE END IF RETURN END C65**TPS DOUBLE PRECISION FUNCTION F65H2O(P,S) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 ILL=0 TOK=273.15 H33=F33H2O(P) H34=F34H2O(P) IF((P.LE.CRPR).AND.(S.GE.H33).AND.(S.LE.H34)) THEN F65H2O=F40H2O(P) ELSE IF (P.GT.CRPR) THEN TO=CRTM S0=F35H2O(P,TO) IF(S0.LE.-1000.0) GO TO 100 CP=F18H2O(P,TO) IF(CP.LE.-1000.0) GO TO 100 T1=TO*(1.+(S-S0)/CP) S1=F35H2O(P,T1) IF(S1.LE.-1000.0) GO TO 100 GO TO 110 100 ILL=-10000 110 CONTINUE ELSE IF((P.LE.CRPR).AND.(S.LT.H33)) THEN T1=F40H2O(P) IF(T1.LE.-1000.0) GO TO 200 S1=F33H2O(P) IF(S1.LE.-1000.0) GO TO 200 CP=F16H2O(P) IF(CP.LE.-1000.0) GO TO 200 TO=T1*(1.+(S-S1)/CP) S0=F35H2O(P,TO) IF(S0.LE.-1000.0) GO TO 200 GO TO 210 200 ILL=-10000 210 CONTINUE ELSE IF((P.LE.CRPR).AND.(S.GT.H34)) THEN TO=F40H2O(P) IF(TO.LE.-1000.0) GO TO 300 S0=F34H2O(P) IF(S0.LE.-1000.0) GO TO 300 CP=F17H2O(P) IF(CP.LE.-1000.0) GO TO 300 T1=TO*(1.+(S-S0)/CP) S1=F35H2O(P,T1) IF(S1.LE.-1000.0) GO TO 300 GO TO 310 300 ILL=-10000 310 CONTINUE END IF IF(ILL.LE.-10000) GO TO 650 NIT=0 1000 DELT=(S-S1)*(T1-TO)/(S1-S0) RDELT=DABS(DELT/(T1+TOK)) IF(NIT.GE.10000) GO TO 630 IF(RDELT.LT.1.0E-7) GO TO 1100 TO=T1 S0=S1 T1=T1+DELT IF (T1.LT.0) T1=DABS(T1) S1=F35H2O(P,T1) NIT=NIT+1 GO TO 1000 1100 F65H2O=T1 GO TO 400 630 F65H2O=-1.0E+10 GO TO 400 650 F65H2O=-1.0E+20 400 CONTINUE END IF RETURN END C70**TPV DOUBLE PRECISION FUNCTION F70H2O(P,V) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O TOK=273.15 DT=50.0 IF((CRPR.LE.P).AND.(P.LE.PRMX)) THEN VMAX=F51H2O(P,7.999D+02) VMIN=F51H2O(P,1.0D-02) IF((V.LT.VMIN).OR.(V.GT.VMAX)) THEN F70H2O=-1.0E+20 RETURN END IF VCC=F51H2O(P,CRTM) IF(V.LT.VCC) THEN TO=0.01 ELSE TO=CRTM END IF TMAX=TMMX ELSE IF((ZPR0.LE.P).AND.(P.LT.CRPR)) THEN VD=F49H2O(P) VDD=F50H2O(P) VMAX=F51H2O(P,7.999D+02) VMIN=F51H2O(P,1.0D-02) IF((V.LT.VD).AND.(V.GT.VMIN)) THEN TMAX=F40H2O(P) TO=0.01 ELSE IF((VD.LE.V).AND.(V.LE.VDD)) THEN F70H2O=F40H2O(P) RETURN ELSE IF((V.GT.VDD).AND.(V.LE.VMAX)) THEN TO=F40H2O(P) TMAX=TMMX ELSE F70H2O=-1.0E+20 RETURN END IF ELSE F70H2O=-1.0E+20 RETURN END IF 600 T1=TO 1000 TO=T1 T1=T1+DT IF(T1.GT.TMAX) T1=TMAX V0=F51H2O(P,TO) V1=F51H2O(P,T1) SIGN=(V0-V)*(V1-V) IF(SIGN.GT.0.0) GO TO 1000 NIT=0 2000 DELT=(V-V1)*(T1-TO)/(V1-V0) RDELT=DABS(DELT/(T1+TOK)) IF(NIT.GE.10000) THEN F70H2O=-1.0E+10 RETURN END IF IF(RDELT.LT.1.0E-7) THEN F70H2O=T1 RETURN END IF TO=T1 V0=V1 T1=T1+DELT V1=F51H2O(P,T1) NIT=NIT+1 GO TO 2000 END C71**HPS DOUBLE PRECISION FUNCTION F71H2O(P,S) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O T=-1.0E+20 IF((P.GT.PRMX).OR.(P.LE.ZPR0)) GO TO 650 SD=F33H2O(P) SDD=F34H2O(P) IF ((SD.LE.S).AND.(S.LE.SDD)) THEN X=F57H2O(P,S) H=F26H2O(P,X) ELSE T=F65H2O(P,S) IF((T.EQ.-1.0E+20).OR.(T.EQ.-1.0E+10)) THEN H=T ELSE H=F25H2O(P,T) END IF END IF F71H2O=H RETURN 650 F71H2O=T RETURN END C77**CVPT DOUBLE PRECISION FUNCTION F77H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.) GO TO 650 100 CITA=(CT+T0)/TC1 BETA=P*1.0D+05/PC1 CALL S4H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3,4), ILL 1 CALL S28H2O(EPSION,CITA,BETA) GO TO 700 2 CALL S29H2O(EPSION,CITA,BETA) GO TO 700 3 CALL S30H2O(EPSION,RKAI,CITA) GO TO 700 4 CALL S31H2O(EPSION,RKAI,CITA) 700 F77H2O=EPSION*PC1*SVC1/TC1 RETURN 650 CONTINUE F77H2O=-1.0E+20 RETURN END C79**UPS DOUBLE PRECISION FUNCTION F79H2O(P,S) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O T=-1.0E+20 IF((P.GT.PRMX).OR.(P.LE.ZPR0)) GO TO 650 SD=F33H2O(P) SDD=F34H2O(P) IF ((SD.LE.S).AND.(S.LE.SDD)) THEN X=F57H2O(P,S) U=F45H2O(P,X) ELSE T=F65H2O(P,S) IF((T.EQ.-1.0E+20).OR.(T.EQ.-1.0E+10)) THEN U=T ELSE U=F44H2O(P,T) END IF END IF F79H2O=U RETURN 650 F79H2O=T RETURN END C80**VPS DOUBLE PRECISION FUNCTION F80H2O(P,S) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O T=-1.0E+20 IF((P.GT.PRMX).OR.(P.LE.ZPR0)) GO TO 650 SD=F33H2O(P) SDD=F34H2O(P) IF ((SD.LE.S).AND.(S.LE.SDD)) THEN X=F57H2O(P,S) V=F52H2O(P,X) ELSE T=F65H2O(P,S) IF((T.EQ.-1.0E+20).OR.(T.EQ.-1.0E+10)) THEN V=T ELSE V=F51H2O(P,T) END IF END IF F80H2O=V RETURN 650 F80H2O=T RETURN END C81**PRPT DOUBLE PRECISION FUNCTION F81H2O(P,CT) IMPLICIT DOUBLE PRECISION (A-H,O-Z) CALL S25H2O CP=F18H2O(P,CT) AM=F13H2O(P,CT) AL=F8H2O(P,CT) ER10=-1.0E+10 ER20=-1.0E+20 IF((CP.EQ.ER10).OR.(AM.EQ.ER10).OR.(AL.EQ.ER10)) GOTO 980 IF((CP.EQ.ER20).OR.(AM.EQ.ER20).OR.(AL.EQ.ER20)) GOTO 990 F81H2O=CP*AM/AL RETURN 980 CONTINUE F81H2O=ER10 RETURN 990 F81H2O=ER20 RETURN END C82**AKPT DOUBLE PRECISION FUNCTION F82H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 COMMON/REGION/ILL CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.) GO TO 650 100 CITA=(CT+T0)/TC1 BETA=P*1.0D+5/PC1 CALL S1H2O(RKAI,CITA,BETA,ILL) IF(ILL.LT.0) GO TO 650 GO TO (1,2,3,4), ILL 1 CALL S16H2O(CP,CITA,BETA) CALL S28H2O(CV,CITA,BETA) CALL S32H2O(DPDV,CITA,BETA) GO TO 700 2 CALL S17H2O(CP,CITA,BETA) CALL S29H2O(CV,CITA,BETA) CALL S33H2O(DPDV,CITA,BETA) GO TO 700 3 CALL S18H2O(CP,RKAI,CITA) CALL S30H2O(CV,RKAI,CITA) CALL S34H2O(DPDV,RKAI,CITA) GO TO 700 4 CALL S19H2O(CP,RKAI,CITA) CALL S31H2O(CV,RKAI,CITA) CALL S35H2O(DPDV,RKAI,CITA) 700 F82H2O=-CP/CV*RKAI/BETA*DPDV RETURN 650 CONTINUE F82H2O=-1.0E+20 RETURN END C83**WPT DOUBLE PRECISION FUNCTION F83H2O(P,CT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S25H2O IF(P.GT.PRMX.OR.CT.GT.TMMX) GO TO 650 IF(P.LE.ZPR0.OR.CT.LT.0.) GO TO 650 PC=P*1.0D+05 AK=F82H2O(P,CT) VV=F51H2O(P,CT) IF(AK.LT.-1.0D+10) GOTO 650 IF(VV.LT.-1.0D+10) GOTO 650 F83H2O=DSQRT(PC*VV*AK) RETURN 650 F83H2O=-1.0D+20 RETURN END C85**PRPD DOUBLE PRECISION FUNCTION F85H2O(P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) CALL S25H2O CP=F16H2O(P) AM=F11H2O(P) AL=F6H2O(P) ER10=-1.0E+10 ER20=-1.0E+20 IF((CP.EQ.ER10).OR.(AM.EQ.ER10).OR.(AL.EQ.ER10)) GOTO 980 IF((CP.EQ.ER20).OR.(AM.EQ.ER20).OR.(AL.EQ.ER20)) GOTO 990 F85H2O=CP*AM/AL RETURN 980 CONTINUE F85H2O=ER10 RETURN 990 F85H2O=ER20 RETURN END C86**PRPDD DOUBLE PRECISION FUNCTION F86H2O(P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) CALL S25H2O CP=F17H2O(P) AM=F12H2O(P) AL=F7H2O(P) ER10=-1.0E+10 ER20=-1.0E+20 IF((CP.EQ.ER10).OR.(AM.EQ.ER10).OR.(AL.EQ.ER10)) GOTO 980 IF((CP.EQ.ER20).OR.(AM.EQ.ER20).OR.(AL.EQ.ER20)) GOTO 990 F86H2O=CP*AM/AL RETURN 980 CONTINUE F86H2O=ER10 RETURN 990 F86H2O=ER20 RETURN END C87**PRTD DOUBLE PRECISION FUNCTION F87H2O(CT) IMPLICIT DOUBLE PRECISION (A-H,O-Z) CALL S25H2O CP=F19H2O(CT) AM=F14H2O(CT) AL=F9H2O(CT) ER10=-1.0E+10 ER20=-1.0E+20 IF((CP.EQ.ER10).OR.(AM.EQ.ER10).OR.(AL.EQ.ER10)) GOTO 980 IF((CP.EQ.ER20).OR.(AM.EQ.ER20).OR.(AL.EQ.ER20)) GOTO 990 F87H2O=CP*AM/AL RETURN 980 CONTINUE F87H2O=ER10 RETURN 990 F87H2O=ER20 RETURN END C88**PRTDD DOUBLE PRECISION FUNCTION F88H2O(CT) IMPLICIT DOUBLE PRECISION (A-H,O-Z) CALL S25H2O CP=F20H2O(CT) AM=F15H2O(CT) AL=F10H2O(CT) ER10=-1.0E+10 ER20=-1.0E+20 IF((CP.EQ.ER10).OR.(AM.EQ.ER10).OR.(AL.EQ.ER10)) GOTO 980 IF((CP.EQ.ER20).OR.(AM.EQ.ER20).OR.(AL.EQ.ER20)) GOTO 990 F88H2O=CP*AM/AL RETURN 980 CONTINUE F88H2O=ER10 RETURN 990 F88H2O=ER20 RETURN END C98**TPSEUP DOUBLE PRECISION FUNCTION F98H2O(P) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION T(2),C(2),TL(3),TR(3),CL(3),CR(3) P1=F21H2O('P') PP=ABS((P-P1)/P1) T1=F21H2O('T') IF (PP.LT.1.0D-5) THEN F98H2O=T1 RETURN ENDIF IF (P.LT.P1.OR.P.GT.1000.001D00) THEN F98H2O=-1.0E+20 RETURN ENDIF T2=0.85*T1 P2=F30H2O(T2) TM0=T1+(T1-T2)*(P-P1)/(P1-P2) C-----TM0 KINJICHI TC=T1 T(1)=375.5 IF (P.GE.270.D00.AND.P.LT.370.D00) THEN T(1)=390.0 ELSEIF (P.GE.370.D00.AND.P.LT.450.D00) THEN T(1)=420.0 ELSEIF (P.GE.450.D00.AND.P.LT.560.D00) THEN T(1)=440.0 ELSEIF (P.GE.560.D00.AND.P.LT.750.D00) THEN T(1)=460.0 ELSEIF (P.GE.750.D00) THEN T(1)=515.0 ENDIF DEL=T1*0.0003D00 150 EPS=1.0D-7 IREP=0 IREM=5000 KCONT=0 ICONT=0 C(1)=F18H2O(P,T(1)) T(2)=T(1)-DEL C(2)=F18H2O(P,T(2)) 1000 RINC=C(2)-C(1) IF(RINC.GT.0.3)THEN GOTO 1500 ELSE T(2)=T(1) C(2)=C(1) T(1)=T(1)-DEL C(1)=F18H2O(P,T(1)) GOTO 1000 ENDIF 1500 C(1)=-C(1) C(2)=-C(2) 2000 IREP=IREP+1 IF(IREP.GT.IREM) GO TO 8000 TT=T(2)+1.3*(T(2)-T(1)) CC=-F18H2O(P,TT) 3000 CONV=DABS((CC-C(2))/CC) IF(CONV.LT.EPS) THEN F98H2O=TT RETURN ENDIF 4000 DEC=C(1)-CC ICONT=ICONT+1 IF(DEC.GE.0.0) THEN T(1)=TT C(1)=CC ELSE IF (ICONT.GT.5) GO TO 6000 TT=(TT+T(2))*0.5 CC=-F18H2O(P,TT) GOTO 4000 ENDIF 5000 DEC=C(1)-C(2) IF(DEC.LT.0.0) THEN TT=T(1) CC=C(1) T(1)=T(2) C(1)=C(2) T(2)=TT C(2)=CC ENDIF GOTO 2000 6000 TA=T(1) TB=TT IF (TB.LT.TA) THEN TA=TT TB=T(1) ENDIF TC=TA+0.5*(TB-TA) CA=F18H2O(P,TA) CB=F18H2O(P,TB) 6050 KCONT=KCONT+1 IF (KCONT.GT.IREM) GO TO 8000 DELT=DABS((TA-TB)/TA) IF (DELT.LT.EPS) GO TO 7000 CC=F18H2O(P,TC) DTA=(TC-TA)*0.3 TL(1)=TA TL(2)=TC-DTA TL(3)=TC DTB=(TB-TC)*0.3 TR(1)=TC TR(2)=TC+DTB TR(3)=TB CL(1)=CA CL(3)=CC CR(1)=CC CR(3)=CB CL(2)=F18H2O(P,TL(2)) CR(2)=F18H2O(P,TR(2)) CMXL=CL(1) ML=1 DO 6120 I=2,3 IF(CL(I).GT.CMXL) THEN CMXL=CL(I) ML=I ENDIF 6120 CONTINUE CMXR=CR(1) MR=1 DO 6130 I=2,3 IF(CR(I).GT.CMXR) THEN CMXR=CR(I) MR=I ENDIF 6130 CONTINUE IF(CMXL.GT.CMXR) THEN IF(ML.EQ.1) THEN TA=TL(1)-DTA CA=F18H2O(P,TA) ELSE TA=TL(ML-1) CA=CL(ML-1) ENDIF IF(ML.EQ.3) THEN TB=TR(2) CB=CR(2) ELSE TB=TL(ML+1) CB=CL(ML+1) ENDIF TC=TL(ML) CC=CL(ML) ELSE IF(MR.EQ.1) THEN TA=TL(2) CA=CL(2) ELSE TA=TR(MR-1) CA=CR(MR-1) ENDIF IF(MR.EQ.3) THEN TB=TR(3)+DTB CB=F18H2O(P,TB) ELSE TB=TR(MR+1) CB=CR(MR+1) ENDIF 6135 TC=TR(MR) CC=CR(MR) ENDIF GO TO 6050 7000 F98H2O=TC RETURN 8000 F98H2O=-1.0E+10 RETURN END SUBROUTINE S26H2O(DMU,RKAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 DIMENSION A(4),B(55) C ** NUMERICAL VALUES OF DERIVED CONSTANS ** C * DATA BETA2/ 4.5207956601D+00/, CITAT/ 4.219990730D-01/, C * CITA2/ 1.333462073D+00/, CITA3/ 1.657886606D+00/ DATA A/0.181583D-01, 0.177624D-01, 0.105287D-01, -0.36744D-02/, * B(1)/0.501938D+00/, B(2)/0.235622D+00/, B(3)/-0.274637D+00/, * B(4)/0.145831D+00/, B(5)/-0.270448D-01/, B(11)/0.162888D+00/, * B(12)/0.789393D+00/, B(13)/-0.743539D+00/, B(14)/0.263129D+00/, * B(15)/-0.253093D-01/, B(21)/-0.130356D+00/, B(22)/0.673665D+00/, * B(23)/-0.959456D+00/, B(24)/0.347247D+00/, B(25)/-0.267758D-01/, * B(31)/0.907919D+00/, B(32)/0.1207552D+01/, B(33)/-0.687343D+00/, * B(34)/0.213486D+00/, B(35)/-0.822904D-01/, B(41)/-0.551119D+00/, * B(42)/0.670665D-01/, B(43)/-0.497089D+00/, B(44)/0.100754D+00/, * B(45)/0.602253D-01/, B(51)/0.146543D+00/, B(52)/-0.84337D-01/, * B(53)/0.195286D+00/, B(54)/-0.32932D-01/, B(55)/-0.202595D-01/, * TAST/0.64727D+03/, RHOAST/0.317763D+03/ 700 RHO=1.0/(SVC1*RKAI) CT=CITA*TC1-T0 SUM1=0. SUM2=0. TA=CT+T0 TTA=TAST/TA RRA=RHO/RHOAST DO 710 I0=1,4 I=I0-1 710 SUM1=SUM1+A(I0)*TTA**I RMU0=1.0/(TTA**0.5*SUM1) DO 720 I0=1,6 I=I0-1 DO 720 J0=1,5 J=J0-1 720 SUM2=SUM2+B(10*I+J0)*(TTA-1.)**I*(RRA-1.)**J DMU=RMU0*DEXP(RRA*SUM2)*1.0D-6 RETURN END SUBROUTINE S27H2O(DLM,KAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 DIMENSION A(4) C ** NUMERICAL VALUES OF DERIVED CONSTANS ** C * DATA BETA2/ 4.5207956601D+00/, CITAT/ 4.219990730D-01/, C * * CITA2/ 1.333462073D+00/, CITA3/ 1.657886606D+00/ DATA A/1.02811D-02,2.99621D-02,1.56146D-02,-4.22464D-03/, * B1/-0.171587D+00/, B2/0.239219D+01/, * C1/0.642857D+00/, C2/-0.411717D+01/, C3/-0.617937D+01/, * C4/0.308976D-02/, C5/0.822994D-01/, C6/0.100932D+02/, * SB0/-0.39707D+00/, SB1/0.400302D+00/, SB2/0.106D+01/, * SD1/0.701309D-01/, SD2/0.11852D-01/, SD3/0.16993D-02/, * SD4/-0.102D+01/, * TAST/0.64730D+03/, RHOAST/0.317700D+03/ CT=CITA*TC1-T0 SUM1=0. C * SUM2=0. TA=CT+T0 RHO=1.0/(KAI*SVC1) TTA=TA/TAST RRA=RHO/RHOAST DTA=DABS(TTA-1.0)+C4 IF(TTA.LT.1.0) GO TO 50 S=1.0/DTA GO TO 55 50 S=C6*DTA**(-0.6) 55 Q=2.0+C5*DTA**(-0.6) R=Q+1.0 SUM1=0. DO 710 I0=1,4 I=I0-1 710 SUM1=SUM1+A(I0)*TTA**I RLAM0=TTA**0.5*SUM1 RLAMB=SB0+SB1*RRA+SB2*DEXP(B1*(RRA+B2)*(RRA+B2)) DELAM=(SD1/TTA**10+SD2)*RRA**1.8*DEXP(C1*(1.0-RRA**2.8)) 1 +SD3*S*RRA**Q*DEXP(Q/R*(1.0-RRA**R))+SD4*DEXP(C2*TTA**1.5 2 +C3/RRA**5) DLM=RLAM0+RLAMB+DELAM RETURN END SUBROUTINE S1H2O(RKAI,CITA,BETA,ILL) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 C ** NUMERICAL VALUES OF DERIVED CONSTANS ** DATA BETA2/ 4.5207956601D+00/, * CITA2/ 1.333462073D+00/, CITA3/ 1.657886606D+00/ DATA RL0/ 1.574373327D+01/, RL1/-3.417061978D+01/, * RL2/ 1.931380707D+01/ C * CTC1=TC1-T0 CTB1=T0/TC1 BETAK=FCH2O(CITA) C ** THE L-FUNCTION ** 300 BETAL=RL0+RL1*CITA+RL2*CITA*CITA C * TEMPERATURE RANGE * IF(CTB1.LE.CITA.AND.CITA.LE.CITA1) GO TO 1001 IF(CITA1.LT.CITA.AND.CITA.LT.1.D00) GO TO 1002 IF(1.D00.LE.CITA.AND.CITA.LT.CITA2) GO TO 1003 IF(CITA2.LE.CITA.AND.CITA.LE.CITA3) GO TO 1004 GO TO 650 C * PRESSURE RANGE * 1001 IF(0..LE.BETA.AND.BETA.LT.BETAK) GO TO 2 IF(BETA.EQ.BETAK) GO TO 2 IF(BETAK.LT.BETA.AND.BETA.LE.BETA2) GO TO 1 1002 IF(BETA.EQ.BETAK) GO TO 3 IF(0..LE.BETA.AND.BETA.LE.BETAL) GO TO 2 IF(BETAL.LT.BETA.AND.BETA.LT.BETAK) GO TO 3 IF(BETAK.LT.BETA.AND.BETA.LE.BETA2) GO TO 4 1003 IF(0..LE.BETA.AND.BETA.LE.BETAL) GO TO 2 IF(BETAL.LT.BETA.AND.BETA.LE.BETA2) GO TO 3 1004 IF(0..LE.BETA.AND.BETA.LE.BETA2) GO TO 2 GO TO 650 1 CALL S8H2O(RKAI,CITA,BETA) ILL=1 GO TO 700 2 CALL S9H2O(RKAI,CITA,BETA) ILL=2 GO TO 700 3 CALL S10H2O(RKAI,CITA,BETA) ILL=3 GO TO 700 4 CALL S11H2O(RKAI,CITA,BETA) ILL=4 700 IF(RKAI.LT.0.) GO TO 650 RETURN 650 ILL=-1000 RETURN END SUBROUTINE S2H2O(RKAI,CITA,BETA,ILL) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 CTB1=T0/TC1 IF(CTB1.LE.CITA.AND.CITA.LE.CITA1) GO TO 6 IF(CITA1.LT.CITA.AND.CITA.LT.1.D00) GO TO 5 IF(CITA.EQ.1.0D00) GO TO 3 GO TO 650 5 CALL S11H2O(RKAI,CITA,BETA) ILL=2 GO TO 700 6 CALL S8H2O(RKAI,CITA,BETA) ILL=1 GO TO 700 3 RKAI=1.0D00 ILL=3 700 IF(RKAI.LT.0.) GO TO 650 RETURN 650 ILL=-1000 RETURN END SUBROUTINE S3H2O(RKAI,CITA,BETA,ILL) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 CTB1=T0/TC1 IF(CTB1.LE.CITA.AND.CITA.LE.CITA1) GO TO 6 IF(CITA1.LT.CITA.AND.CITA.LT.1.D00) GO TO 5 IF(CITA.EQ.1.0D00) GO TO 3 GO TO 650 5 CALL S10H2O(RKAI,CITA,BETA) ILL=2 GO TO 700 6 CALL S9H2O(RKAI,CITA,BETA) ILL=1 GO TO 700 3 RKAI=1.0D00 ILL=3 700 IF(RKAI.LT.0.) GO TO 650 RETURN 650 ILL=-1000 RETURN END SUBROUTINE S4H2O(RKAI,CITA,BETA,ILL) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 C ** NUMERICAL VALUES OF DERIVED CONSTANS ** DATA BETA2/ 4.5207956601D+00/, * CITA2/ 1.333462073D+00/, CITA3/ 1.657886606D+00/ DATA RL0/ 1.574373327D+01/, RL1/-3.417061978D+01/, * RL2/ 1.931380707D+01/ RKAI=0.0 C * CTC1=TC1-T0 CTB1=T0/TC1 BETAK=FCH2O(CITA) C ** THE L-FUNCTION ** 300 BETAL=RL0+RL1*CITA+RL2*CITA*CITA C * TEMPERATURE RANGE * IF(CTB1.LE.CITA.AND.CITA.LE.CITA1) GO TO 1001 IF(CITA1.LT.CITA.AND.CITA.LT.1.D00) GO TO 1002 IF(1.D00.LE.CITA.AND.CITA.LT.CITA2) GO TO 1003 IF(CITA2.LE.CITA.AND.CITA.LE.CITA3) GO TO 1004 GO TO 650 C * PRESSURE RANGE * 1001 IF(0..LE.BETA.AND.BETA.LT.BETAK) GO TO 2 IF(BETA.EQ.BETAK) GO TO 2 IF(BETAK.LT.BETA.AND.BETA.LE.BETA2) GO TO 1 1002 IF(BETA.EQ.BETAK) GO TO 3 IF(0..LE.BETA.AND.BETA.LE.BETAL) GO TO 2 IF(BETAL.LT.BETA.AND.BETA.LT.BETAK) GO TO 3 IF(BETAK.LT.BETA.AND.BETA.LE.BETA2) GO TO 4 1003 IF(0..LE.BETA.AND.BETA.LE.BETAL) GO TO 2 IF(BETAL.LT.BETA.AND.BETA.LE.BETA2) GO TO 3 1004 IF(0..LE.BETA.AND.BETA.LE.BETA2) GO TO 2 GO TO 650 1 ILL=1 GO TO 700 2 ILL=2 GO TO 700 3 CALL S10H2O(RKAI,CITA,BETA) ILL=3 GO TO 700 4 CALL S11H2O(RKAI,CITA,BETA) ILL=4 700 IF(RKAI.LT.0.) GO TO 650 RETURN 650 ILL=-1000 RETURN END SUBROUTINE S5H2O(RKAI,CITA,BETA,ILL) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 CTB1=T0/TC1 RKAI=0.0 IF(CTB1.LE.CITA.AND.CITA.LE.CITA1) GO TO 6 IF(CITA1.LT.CITA.AND.CITA.LT.1.D00) GO TO 5 IF(CITA.EQ.1.0D00) GO TO 3 GO TO 650 5 CALL S11H2O(RKAI,CITA,BETA) ILL=2 GO TO 700 6 ILL=1 GO TO 700 3 RKAI=1.0D00 ILL=3 700 IF(RKAI.LT.0.) GO TO 650 RETURN 650 ILL=-1000 RETURN END SUBROUTINE S6H2O(RKAI,CITA,BETA,ILL) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 CTB1=T0/TC1 RKAI=0.0 IF(CTB1.LE.CITA.AND.CITA.LE.CITA1) GO TO 6 IF(CITA1.LT.CITA.AND.CITA.LT.1.D00) GO TO 5 IF(CITA.EQ.1.0D00) GO TO 3 GO TO 650 5 CALL S10H2O(RKAI,CITA,BETA) ILL=2 GO TO 700 6 ILL=1 GO TO 700 3 RKAI=1.0D00 ILL=3 700 IF(RKAI.LT.0.) GO TO 650 RETURN 650 ILL=-1000 RETURN END C ** SUBREGION 1 ** SUBROUTINE S8H2O(RKAI,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /SUBR1/A0,A(30),SA(20) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 C * REDUCED VOLUME * Y=1.D0-SA(1)*(CITA*CITA)-SA(2)*(CITA**(-6)) RAM10=SA(3)*(Y**2)-2.D0*SA(4)*CITA+2.D0*SA(5)*BETA IF(RAM10.LE.0.D0) GO TO 1000 Z=Y+DSQRT(RAM10) GO TO 1001 1000 Z=Y 1001 IF(DABS(SA(6)-CITA).LE.1.585D-08) GO TO 30 RAM1=(SA(6)-CITA)**10 GO TO 40 30 RAM1=0.D0 40 CTA2=CITA*CITA CTA11=CITA**11 CTA18=CITA**18 CTA19=CITA*CTA18 CTA20=CITA*CTA19 BTA2=BETA*BETA BTA3=BETA*BTA2 CF517=5.D0/17.D0 RKAI=A(11)*SA(5)/(Z**CF517) 1 +(A(12)+A(13)*CITA+A(14)*CTA2+A(15)*RAM1 Z +A(16)/(SA(7)+CTA19)) 2 -(A(17)+2.D0*A(18)*BETA+3.D0*A(19)*BTA2)/(SA(8)+CTA11) 3 -A(20)*CTA18*(SA(9)+CTA2)*(-3.D0/(SA(10)+BETA)**4+SA(11)) 5 +3.D0*A(21)*(SA(12)-CITA)*BTA2 6 +4.D0*A(22)/CTA20*BTA3 RETURN END C ** SUBREGION 2 ** SUBROUTINE S9H2O(RKAI,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) INTEGER BZ,BN,BL,BX COMMON /SUBR2/B0,B(100),SB(100),BZ(10,10),BN(10),BL(10),BX(10,10), * BB COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 DATA RL0/ 1.574373327D+01/, RL1/-3.417061978D+01/, * RL2/ 1.931380707D+01/ BETAL=RL0+RL1*CITA+RL2*(CITA**2) C * BETALD=RL1+2.*RL2*CITA C * REDUCED V0LUME * X=DEXP(BB*(1.-CITA)) SUM22=0. SUM25=0. VTERM3=0. VTERM1=DI1*(CITA/BETA) DO 25 MU=1,5 SUM21=0. I=BN(MU) DO 30 NU=1,I 30 SUM21=SUM21+B(MU*10+NU)*(X**BZ(MU,NU)) AMU=MU 25 SUM22=SUM22+AMU*(BETA**(MU-1))*SUM21 VTERM2=SUM22 DO 35 MU=6,8 SUM23=0. SUM24=0. I=BN(MU) DO 40 NU=1,I 40 SUM23=SUM23+B(MU*10+NU)*(X**BZ(MU,NU)) I=BL(MU) DO 45 LAM=1,I 45 SUM24=SUM24+SB(MU*10+LAM)*(X**BX(MU,LAM)) AMU=MU 35 VTERM3=VTERM3+((AMU-2.)*(BETA**(1-MU))*SUM23) 1 /((BETA**(2-MU)+SUM24)**2) DO 50 NU=1,7 50 SUM25=SUM25+B(90+NU-1)*(X**(NU-1)) VTERM4=11.*((BETA/BETAL)**10)*SUM25 RKAI=VTERM1-VTERM2-VTERM3+VTERM4 RETURN END C ** SUBREGION 3 ** SUBROUTINE S10H2O(KAI,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI,KAI0,KAI1,KAI2,KAI3 COMMON /SUBR3/C0,C(400) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 C * REDUCED VOLUME ** DATA COG1/ 0.5910536904D+00/,COG2/ 0.3145752006D+01/, * COG3/-0.3884192073D+01/,COG4/ 0.1530973681D+02/, * COG5/-0.1064965589D+02/,COG6/-0.2880734505D+02/, * COF1/ 0.5131052039D+01/,COF2/ 0.1954291506D+02/, * COF3/-0.2846146407D+02/,COF4/ 0.1090348964D+03/, * COF5/-0.6073518709D+02/,COF6/-0.1596364960D+03/, * COE1/-0.1680322672D+02/,COE2/-0.4120100040D+03/, * COE3/ 0.1959763950D+03/,COE4/-0.9887289444D+03/, * COE5/ 0.3852324252D+04/,COE6/-0.8807679676D+04/, * COD1/-0.2091173099D+05/,COD2/ 0.1833772568D+06/, * COD3/-0.6570772812D+06/,COD4/ 0.1220213841D+07/, * COD5/-0.1264902264D+07/,COD6/ 0.9874636937D+06/, * COD7/-0.1405976791D+07/,COD8/ 0.2244270049D+07/, * COD9/-0.2085025037D+07/,COD10/ 0.9871033318D+06/, * COD11/-0.1885340574D+06/ IF(DABS(CITA-1.D0).LT.1.0D-09) CITA=1.D0 IF(DABS(BETA-1.D0).LT.1.0D-09) BETA=1.D0 IC=0 ICOUNT=0 IF(CITA.EQ.1.D0.AND.BETA.EQ.1.D0) GO TO 221 IF((CITA-1.D0).GE.7.0D-08) GO TO 1 VKAI10=0.00319D+00/SVC1 VKAI20=0.00315D+00/SVC1 BETA10=FAH2O(CITA,VKAI10) BETA20=FAH2O(CITA,VKAI20) BETA30=FAH2O(CITA,1.D0) IF(BETA.LE.BETA10.OR.BETA.GE.BETA20) GO TO 1 KAI1=(1.0D+00-VKAI10)*(BETA-BETA10)/(BETA30 -BETA10)+VKAI10 IF(BETA.LE.1.0D+00) GO TO 2 KAI1=(1.0D+00-VKAI20)*(BETA-BETA30 )/(BETA30 -BETA20)+1.0D+00 GO TO 2 1 P=BETA*PC1*1.01971600D-05 CT=CITA*TC1-T0 V0=0.3194887135D-02 VKAI=V0/SVC1 P0=FAH2O(CITA,VKAI)*PC1*1.019716D-05 IF(CT.LE.374.149D+00.OR.CT.GT.374.15D+00) GO TO 3 IF(P.LE.P0) GO TO 3 PS=FCH2O(CITA)*PC1*1.019716D-05 PX=(PS-225.55D+00)/1.11792D-02 VY=COD1+(COD2+(COD3+(COD4+(COD5+(COD6+(COD7+(COD8+(COD9+(COD10 1 +COD11*PX)*PX)*PX)*PX)*PX)*PX)*PX)*PX)*PX)*PX VS=VY*0.7D-04+0.31D-02 SV1=(P-P0)*(VS-V0)/(PS-P0)+V0 KAI1=SV1/SVC1 GO TO 2 3 PL=DLOG(P) TL=DLOG(CT) IF(P.LT.255.D+00) GO TO 1000 IF(P.LT.410.D+00) GO TO 3000 G=(COG1*PL+COG4)*PL+(COG2*TL+COG5)*TL+COG3*PL*TL+COG6 SV1=DEXP(G) GO TO 2000 3000 F=(COF1*PL+COF4)*PL+(COF2*TL+COF5)*TL+COF3*PL*TL+COF6 SV1=DEXP(F) GO TO 2000 1000 E=(COE1*PL+COE4)*PL+(COE2*TL+COE5)*TL+COE3*PL*TL+COE6 SV1=DEXP(E) 2000 KAI1=SV1/SVC1 2 KAI0=KAI1*1.05D+00 DKAIS=KAI1 IF(CITA.LT.1.D0.OR.CITA.GT.1.004400D0) GO TO 105 IF(BETA.GT.0.88D0.AND.BETA.LT.1.05002D0) GO TO 2500 105 IF(CITA.LT.1.D0.OR.CITA.GT.1.0013D0) GO TO 106 IF(BETA.GT.1.120D0.AND.BETA.LT.1.1315D0) GO TO 2600 106 G0=FAH2O(CITA,KAI0)-BETA G1=FAH2O(CITA,KAI1)-BETA 103 KAI2=(KAI1*G0-KAI0*G1)/(G0-G1) IC=IC+1 IF(IC.GT.5000) GO TO 9950 G2=FAH2O(CITA,KAI2)-BETA IF(DABS(G2/KAI2).LT.1.0D-10) GO TO 203 IF(G2.EQ.G1) GO TO 2500 KAI0=KAI1 KAI1=KAI2 G0=G1 G1=G2 GO TO 103 2500 KAI0=2.0*DKAIS KAI1=0.5*DKAIS GO TO 2011 2600 KAI0=10.0*DKAIS KAI1=0.5*DKAIS 2011 G0=FAH2O(CITA,KAI0)-BETA G1=FAH2O(CITA,KAI1)-BETA 2103 KAI2=(KAI1*G0-KAI0*G1)/(G0-G1) G2=FAH2O(CITA,KAI2)-BETA IF(DABS(G2/KAI2).LT.1.0D-10) GO TO 203 IF(G1*G2) 2020,203,201 201 KAI0=KAI1 KAI1=KAI2 G0=G1 G1=G2 GO TO 2103 2020 IF(G2.GT.0.) GO TO 2022 G0=G1 KAI0=KAI1 G1=G2 KAI1=KAI2 G2=G0 KAI2=KAI0 2022 E=(KAI2-KAI1)*DABS(G1)/(DABS(G1)+DABS(G2)) KAI3=KAI1+E G3=FAH2O(CITA,KAI3)-BETA IF(DABS(G3/KAI3).LT.1.0D-10) GO TO 2030 IF(G1*G3) 2025,2030,2026 2025 KAI2=KAI3 G2=G3 GO TO 2028 2026 KAI1=KAI3 G1=G3 2028 ICOUNT=ICOUNT+1 IF(ICOUNT.LT.5000) GO TO 2022 9950 CONTINUE KAI=-1000.0 RETURN 2030 KAI=KAI3 GO TO 205 221 KAI=1.D0 GO TO 205 203 KAI=KAI2 205 CONTINUE RETURN END C ** SUBREGION 4 ** SUBROUTINE S11H2O(KAI,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI,KAI0,KAI1,KAI2 COMMON /SUBR3/C0,C(400) COMMON /SUBR4/D(100) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 C * REDUCED VOLUME ** DATA COF1/0.1000323355D+00/,COF2/ 0.5017063282D+02/, 1 COF3/-0.3231349236D+01/,COF4/ 0.1758931458D+02/, 2 COF5/-0.5687672359D+03/,COF6/ 0.1608085290D+04/, 3 COD1/-0.1809664960D-01/,COD2/ 0.1368176755D+02/, 4 COD3/ 0.5796464848D+03/,COD4/ 0.1533244038D+05/, 5 COD5/ 0.2135995872D+06/,COD6/ 0.1594762179D+07/, 6 COD7/ 0.6276838071D+07/,COD8/ 0.1189403104D+08/, 7 COD9/ 0.8108806806D+07/ IF(DABS(CITA-1.D0).LT.1.0D-09) CITA=1.D0 P=BETA*PC1*1.01971600D-05 CT=CITA*TC1-T0 V0=0.3138853560D-02 VKAI=V0/SVC1 P0=FBH2O(CITA,VKAI)*PC1*1.019716D-05 IF(CT.LE.374.149D+00.OR.CT.GT.374.15D+00) GO TO 3 IF(P.GE.P0) GO TO 3 PS=FCH2O(CITA)*PC1*1.019716D-05 PX=(PS-225.55D+00)/1.11792D-02 PX=DLOG(PX) VY=COD1+(COD2+(COD3+(COD4+(COD5+(COD6+(COD7+(COD8 1 +COD9*PX)*PX)*PX)*PX)*PX)*PX)*PX)*PX VS=DEXP(VY)*0.7D-04+0.31D-02 SV1=(P-P0)*(VS-V0)/(PS-P0)+V0 KAI1=SV1/SVC1 GO TO 2 3 PL=DLOG(P) TL=DLOG(CT) F=(COF1*PL+COF4)*PL+(COF2*TL+COF5)*TL+COF3*PL*TL+COF6 SV1=DEXP(F) KAI1=SV1/SVC1 2 KAI0=KAI1*0.95D+00 G0=FBH2O(CITA,KAI0)-BETA G1=FBH2O(CITA,KAI1)-BETA 104 KAI2=(KAI1*G0-KAI0*G1)/(G0-G1) G2=FBH2O(CITA,KAI2)-BETA IF(DABS(G2/KAI2).LT.1.0D-08) GO TO 204 KAI0=KAI1 KAI1=KAI2 G0=G1 G1=G2 GO TO 104 204 KAI=KAI2 RETURN END C ** SUBREGION 1 ** SUBROUTINE S12H2O(EPSION,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /SUBR1/A0,A(30),SA(20) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 C * REDUCED VOLUME * Y=1.-SA(1)*(CITA**2)-SA(2)*(CITA**(-6)) RAM10=SA(3)*(Y**2)-2.*SA(4)*CITA+2.*SA(5)*BETA IF(RAM10.LE.0.D0) GO TO 1000 Z=Y+(RAM10**(1.D0/2.D0)) GO TO 1001 1000 Z=Y 1001 YD=-2.*SA(1)*CITA+6.*SA(2)*(CITA**(-7)) C * REDUCED ENTHALPY * SUM12=0. DO 20 NU=1,10 ANU=NU 20 SUM12=SUM12+(ANU-2.)*A(NU)*(CITA**(NU-1)) IF(DABS(SA(6)-CITA).LE.2.155D-09) GO TO 500 RAM3=(SA(6)-CITA)**9 GO TO 600 500 RAM3=0.D0 600 EPSION=ALFA0+A0*CITA-SUM12 1 +A(11)*(Z*(17.*((Z/29.)-(Y/12.))+5.*CITA*YD/12.)+SA(4)*CITA 2 -(SA(3)-1.)*CITA*Y*YD)*(Z**(-5.D+00/17.D+00)) 3 +(A(12)-A(14)*(CITA**2)+A(15)*(9.*CITA+SA(6)) 4 *RAM3 5 +A(16)*(20.*(CITA**19)+SA(7))*((SA(7)+CITA**19)**(-2)))*BETA 6 -(12.*(CITA**11)+SA(8))*((SA(8)+CITA**11)**(-2)) 7 *(A(17)*BETA+A(18)*(BETA**2)+A(19)*(BETA**3)) 8 +A(20)*(CITA**18)*(17.*SA(9)+19.*(CITA**2)) 9 *((SA(10)+BETA)**(-3)+SA(11)*BETA) A +A(21)*SA(12)*(BETA**3)+21.*A(22)*(CITA**(-20))*(BETA**4) RETURN END C ** SUBREGION 2 ** SUBROUTINE S13H2O(EPSION,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) INTEGER BZ,BN,BL,BX COMMON /SUBR2/B0,B(100),SB(100),BZ(10,10),BN(10),BL(10),BX(10,10), * BB COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 DATA RL0/ 1.574373327D+01/, RL1/-3.417061978D+01/, * RL2/ 1.931380707D+01/ BETAL=RL0+RL1*CITA+RL2*(CITA**2) BETALD=RL1+2.*RL2*CITA X=DEXP(BB*(1.-CITA)) C * REDUCED ENTHALPY * SUM214=0. SUM205=0. SUM219=0. SUM220=0. ATERM1=ALFA0 ATERM2=B0*CITA DO 90 NU=1,5 ANU=NU 90 SUM214=SUM214+B(NU)*(ANU-2.)*(CITA**(NU-1)) ATERM3=SUM214 DO 95 MU=1,5 SUM215=0. I=BN(MU) DO 100 NU=1,I 100 SUM215=SUM215+B(MU*10+NU)*(1.+BZ(MU,NU)*BB*CITA)*(X**BZ(MU,NU)) 95 SUM205=SUM205+(BETA**MU)*SUM215 ATERM4=SUM205 DO 105 MU=6,8 SUM216=0. SUM217=0. SUM218=0. I=BL(MU) DO 110 LAM=1,I SUM216=SUM216+BX(MU,LAM)*SB(MU*10+LAM)*(X**BX(MU,LAM)) 110 SUM217=SUM217+SB(MU*10+LAM)*(X**BX(MU,LAM)) I=BN(MU) DO 115 NU=1,I 115 SUM218=SUM218+B(MU*10+NU)*(X**BZ(MU,NU)) 1 *((1.+BZ(MU,NU)*BB*CITA)-(BB*CITA*SUM216) 2 /(BETA**(2-MU)+SUM217)) 105 SUM219=SUM219+SUM218/(BETA**(2-MU)+SUM217) ATERM5=SUM219 DO 120 NU=1,7 ANU=NU-1 120 SUM220=SUM220+(1.+CITA*(10.*BETALD/BETAL+ANU*BB)) 1 *B(90+NU-1)*(X**(NU-1)) ATERM6=BETA*((BETA/BETAL)**10)*SUM220 EPSION=ATERM1+ATERM2-ATERM3-ATERM4-ATERM5+ATERM6 RETURN END C ** SUBREGION 3 ** SUBROUTINE S14H2O(EPSION,KAI,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 SUM311=0.0 SUM312=0.0 SUM313=0.0 SUM314=0.0 SUM315=0.0 SUM316=0.0 SUM317=0.0 SUM318=0.0 IF(DABS(CITA-1.D0).LT.1.0D-09) CITA=1.D0 IF(DABS(BETA-1.D0).LT.1.0D-09) BETA=1.D0 C * REDUCED ENTHALPY * DO 300 NU=2,9 ANU=NU 300 SUM311=SUM311+ANU*C(NU)*(KAI**(1-NU)) DO 305 NU=2,6 305 SUM312=SUM312+C(10+NU)*(KAI**(1-NU)) DO 310 NU=2,6 ANU=NU 310 SUM313=SUM313+(ANU-1.)*C(10+NU)*(KAI**(1-NU)) DO 315 NU=2,7 315 SUM314=SUM314+C(20+NU)*(KAI**(1-NU)) DO 320 NU=2,7 ANU=NU 320 SUM315=SUM315+(ANU-2.)*C(20+NU)*(KAI**(1-NU)) DO 325 NU=2,9 325 SUM316=SUM316+C(30+NU)*(KAI**(1-NU)) DO 330 NU=2,9 ANU=NU 330 SUM317=SUM317+(ANU-3.)*C(30+NU)*(KAI**(1-NU)) DO 335 NU=1,5 ANU=NU-1 335 SUM318=SUM318+(ANU-3.)*C(60+NU-1)*(CITA**(-2-(NU-1))) SUM319=C(70) IF(DABS(CITA-1.D0).LT.1.0D-10) GO TO 350 SUM319=0. DO 340 NU=1,9 ANU=NU-1 340 SUM319=SUM319+C(70+NU-1)*(1.+ANU*CITA)*((CITA-1.)**(NU-1)) 350 EPSION=ALFA0 O +10.*C(100)*(KAI**(-9))+11.*C(110)*(KAI**(-10)) 1 +((C0 -C(120)-C(50))-C(11)*KAI+SUM311-SUM312 2 +(C(120)-C(17))*DLOG(KAI)) 3 +((-C(17)-C(50))-(C(11)+2.*C(21))*KAI+SUM313-2.*SUM314 4 -2.*C(28)*DLOG(KAI))*(CITA-1.) 5 +(-C(28)-(2.*C(21)+3.*C(31))*KAI+SUM315-3.*SUM316 6 -(C(28)+3.*C(310))*DLOG(KAI))*((CITA-1.)**2) 7 +(-C(310)-3.*C(31)*KAI+SUM317-2.*C(310)*DLOG(KAI)) 8 *((CITA-1.)**3) 9 +(23.*C(40)+28.*C(41)*(KAI**(-5)))*(CITA**(-22)) A -(24.*C(40)+29.*C(41)*(KAI**(- 5)))*(CITA**(-23)) B +(KAI**6)*SUM318-SUM319 RETURN END C ** SUBREGION 4 ** SUBROUTINE S15H2O(EPSION,KAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) COMMON /SUBR4/D(100) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 SUM311=0.0 SUM312=0.0 SUM313=0.0 SUM314=0.0 SUM315=0.0 SUM316=0.0 SUM317=0.0 SUM318=0.0 SUM424=0.0 SUM425=0.0 Y=(1.-CITA)/(1.-CITA1) IF(Y.LT.1.0D-02) Y=0. C * REDUCED ENTHALPY * DO 300 NU=2,9 ANU=NU 300 SUM311=SUM311+ANU*C(NU)*(KAI**(1-NU)) DO 305 NU=2,6 305 SUM312=SUM312+C(10+NU)*(KAI**(1-NU)) DO 310 NU=2,6 ANU=NU 310 SUM313=SUM313+(ANU-1.)*C(10+NU)*(KAI**(1-NU)) DO 315 NU=2,7 315 SUM314=SUM314+C(20+NU)*(KAI**(1-NU)) DO 320 NU=2,7 ANU=NU 320 SUM315=SUM315+(ANU-2.)*C(20+NU)*(KAI**(1-NU)) DO 325 NU=2,9 325 SUM316=SUM316+C(30+NU)*(KAI**(1-NU)) DO 330 NU=2,9 ANU=NU 330 SUM317=SUM317+(ANU-3.)*C(30+NU)*(KAI**(1-NU)) DO 335 NU=1,5 ANU=NU-1 335 SUM318=SUM318+(ANU-3.)*C(60+NU-1)*(CITA**(-2-(NU-1))) SUM319=C(70) IF(DABS(CITA-1.D0).LT.1.0D-10) GO TO 350 SUM319=0. DO 340 NU=1,9 ANU=NU-1 340 SUM319=SUM319+C(70+NU-1)*(1.+ANU*CITA)*((CITA-1.)**(NU-1)) 350 CONTINUE DO 294 MU=3,4 DO 294 NU=1,5 AMU=MU ANU=NU-1 294 SUM424=SUM424+D(MU*10+NU-1)*((1.-AMU+ANU)*Y+AMU/(1.-CITA1)) 1 *(Y**(MU-1))*(KAI**(-(NU-1))) DO 302 NU=1,3 ANU=NU-1 302 SUM425=SUM425+D(50+NU-1)*((31.+ANU)*Y-32./(1.-CITA1))*KAI**(NU-1) EPSION=ALFA0 O +10.*C(100)*(KAI**(-9))+11.*C(110)*(KAI**(-10)) 1 +((C0 -C(120)-C(50))-C(11)*KAI+SUM311-SUM312 2 +(C(120)-C(17))*DLOG(KAI)) 3 +((-C(17)-C(50))-(C(11)+2.*C(21))*KAI+SUM313-2.*SUM314 4 -2.*C(28)*DLOG(KAI))*(CITA-1.) 5 +(-C(28)-(2.*C(21)+3.*C(31))*KAI+SUM315-3.*SUM316 6 -(C(28)+3.*C(310))*DLOG(KAI))*((CITA-1.)**2) 7 +(-C(310)-3.*C(31)*KAI+SUM317-2.*C(310)*DLOG(KAI)) 8 *((CITA-1.)**3) 9 +(23.*C(40)+28.*C(41)*(KAI**(-5)))*(CITA**(-22)) A -(24.*C(40)+29.*C(41)*(KAI**(- 5)))*(CITA**(-23)) B +(KAI**6)*SUM318-SUM319 C +SUM424-Y**31*SUM425 RETURN END SUBROUTINE S16H2O(EPSION,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /SUBR1/A0,A(30),SA(20) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 Y=1.-SA(1)*(CITA**2)-SA(2)*(CITA**(-6)) Z1=SA(3)*Y*Y-2.*SA(4)*CITA+2.*SA(5)*BETA Z=Y+Z1**0.5 DY=-2.*SA(1)*CITA+6.*SA(2)*CITA**(-7) DDY=-2.*(SA(1)+21.*SA(2)*CITA**(-8)) DZ=DY+(SA(3)*Y*DY-SA(4))*Z1**(-0.5) DDZ=DDY+SA(3)*Z1**(-0.5)*(DY*DY+Y*DDY)-(SA(3)*Y*DY-SA(4))**2*Z1 1 **(-3./2.) SUM1=0.0 DO 20 NU=1,8 NU0=NU-1 RNU=NU0 20 SUM1=SUM1+(RNU+1.)*(RNU+2.)*A(NU0+3)*CITA**NU0 BETA2=BETA*BETA BETA3=BETA2*BETA COF129=1.2D01/2.9D01 COF249=2.*COF129 COF517=5.0D00/1.7D01 COF172=1.7D01/1.2D01 COF179=1.7D01/2.9D01 COF227=2.2D01/1.7D01 COF127=1.2D01/1.7D01 CIT9=CITA**9 CIT11=CITA**11 CIT16=CITA**16 CIT17=CIT16*CITA CIT18=CIT17*CITA CIT19=CIT18*CITA DDZETA=-A0/CITA+SUM1+A(11)*((COF129*Z-Y)*(Z**(-COF517)*DDZ 1 -COF517*Z**(-COF227)*DZ*DZ)+(COF249*DZ-2.*DY)*Z**(-COF517) 2 *DZ+(COF179*DDZ-COF172*DDY)*Z**(COF127))+BETA*(2.*A(14)+ 3 90.*A(15)*(SA(6)-CITA)**8+722.*A(16)*CIT18*CIT18*(SA(7)+ 4 CIT19)**(-3)-342.*A(16)*CIT17*(SA(7)+CIT19)**(-2))-(242.* 5 CITA*CIT19*(SA(8)+CIT11)**(-3)-110.*CIT9*(SA(8)+CIT11)**(-2)) 6 *(A(17)*BETA+A(18)*BETA2+A(19)*BETA3)-A(20)*CIT16*(306.*SA(9) 7 +380.*CITA*CITA)*((SA(10)+BETA)**(-3)+SA(11)*BETA)+420.*A(22) 8 *BETA3*BETA/CIT11/CIT11 EPSION=-CITA*DDZETA RETURN END C ** SUBREGION 2 ** SUBROUTINE S17H2O(EPSION,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) INTEGER BZ,BN,BL,BX DIMENSION F0(3),F1(3),F2(3),G0(3),G1(3),G2(3) COMMON /SUBR2/B0,B(100),SB(100),BZ(10,10),BN(10),BL(10),BX(10,10), * BB COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 DATA RL0/ 1.574373327D+01/, RL1/-3.417061978D+01/, * RL2/ 1.931380707D+01/, DDBETL/3.862761414D+02/ BETAL=RL0+RL1*CITA+RL2*(CITA**2) BETALD=RL1+2.*RL2*CITA X=DEXP(BB*(1.-CITA)) BETA3=BETA**3 BETA4=BETA3*BETA BETA5=BETA4*BETA BETA6=BETA5*BETA X10=X**10 X11=X10*X X12=X11*X X14=X**14 X18=X**18 X19=X18*X X24=X12*X12 X27=X**27 X54=X27*X27 BB2=BB*BB F0(1)=(B(61)*X12+B(62)*X11)*BETA4 F0(2)=(B(71)*X24+B(72)*X18)*BETA5 F0(3)=(B(81)*X24+B(82)*X14)*BETA6 F1(1)=-BB*BETA4*(12.*B(61)*X12+11.*B(62)*X11) F1(2)=-BB*BETA5*(24.*B(71)*X24+18.*B(72)*X18) F1(3)=-BB*BETA6*(24.*B(81)*X24+14.*B(82)*X14) F2(1)=BB2*BETA4*(144.*B(61)*X12+121.*B(62)*X11) F2(2)=BB2*BETA5*(576.*B(71)*X24+324.*B(72)*X18) F2(3)=BB2*BETA6*(576.*B(81)*X24+196.*B(82)*X14) G0(1)=1.+SB(61)*X14*BETA4 G0(2)=1.+SB(71)*X19*BETA5 G0(3)=1.+(SB(81)*X54+SB(82)*X27)*BETA6 G1(1)=-14.*BB*SB(61)*X14*BETA4 G1(2)=-19.*BB*SB(71)*X19*BETA5 G1(3)=-BB*BETA6*(54.*SB(81)*X54+27.*SB(82)*X27) G2(1)=196.*BB2*SB(61)*X14*BETA4 G2(2)=361.*BB2*SB(71)*X19*BETA5 G2(3)=BB2*BETA6*(2916.*SB(81)*X54+729.*SB(82)*X27) SUM77=0. DO 150 I=1,3 150 SUM77=SUM77+F2(I)/G0(I)-(2.*F1(I)*G1(I)+F0(I)*G2(I))/G0(I)/G0(I) 1 +2.*F0(I)*G1(I)*G1(I)/(G0(I)**3) SUM1=0. SUM2=0. SUM3=0. DO 155 N0=1,7 NU=N0-1 RNU=NU SMB=B(90+NU)*X**NU SUM1=SUM1+SMB SUM2=SUM2+RNU*SMB 155 SUM3=SUM3+RNU*RNU*SMB DDZETA=-B0/CITA+2.*B(3)+6.*B(4)*CITA+12.*B(5)*CITA*CITA- 1 (169.*B(11)*X12*X+9.*B(12)*X**3)*BB2*BETA-(324.*B(21)*X18+4.* 2 B(22)*X*X+B(23)*X)*BB2*BETA*BETA-(324.*B(31)*X18+100.*B(32)* 3 X10)*BB2*BETA3-(625.*B(41)*X24*X+196.*B(42)*X14)*BB2*BETA4- 4 (1024.*B(51)*X**32+784.*B(52)*X27*X+576.*B(53)*X24)*BB2*BETA5- 5 SUM77+(BETA/BETAL)**11*((110./BETAL*BETALD*BETALD-DDBETL)*SUM1+ 6 20.*BB*BETALD*SUM2+BB2*BETAL*SUM3) EPSION=-CITA*DDZETA RETURN END C ** SUBREGION 3 ** SUBROUTINE S18H2O(EPSION,KAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 SUM312=0.0 SUM313=0.0 SUM316=0.0 SUM321=0.0 SUM322=0.0 SUM323=0.0 SUM326=0.0 SUM330=0.0 SUM331=0.0 SUM332=0.0 SUM333=0.0 SUM336=0.0 DO 250 NU=2,7 RNU=NU 250 SUM312=SUM312+C(20+NU)*KAI**(1-NU) DO 252 NU=2,9 RNU=NU 252 SUM313=SUM313+C(30+NU)*KAI**(1-NU) DO 253 N0=1,5 NU=N0-1 RNU=NU 253 SUM316=SUM316+(RNU+2.0)*(RNU+3.0)*C(60+NU)*CITA**(-NU-4) SUM317=2.0*C(71) IF(DABS(CITA-1.00D00).LT.1.00D-10) GO TO 256 SUM317=0.0 DO 255 N0=1,9 NU=N0-1 RNU=NU 255 SUM317=SUM317+RNU*(RNU+1.0)*C(70+NU)*(CITA-1.0)**(NU-1) 256 DO 257 NU=2,6 RNU=NU 257 SUM321=SUM321+(1.0-RNU)*C(10+NU)*KAI**(-NU) DO 258 NU=2,7 RNU=NU 258 SUM322=SUM322+(1.0-RNU)*C(20+NU)*KAI**(-NU) DO 260 NU=2,9 RNU=NU 260 SUM323=SUM323+(1.0-RNU)*C(30+NU)*KAI**(-NU) DO 262 N0=1,5 NU=N0-1 RNU=NU 262 SUM326=SUM326+(RNU+2.0)*C(60+NU)*CITA**(-NU-3) DO 263 NU=2,9 RNU=NU 263 SUM330=SUM330+RNU*(RNU-1.0)*C(NU)*KAI**(-NU-1) SUM330=SUM330+90.0*C(100)*KAI**(-11)+110.0*C(110)*KAI**(-12) DO 264 NU=2,6 RNU=NU 264 SUM331=SUM331+RNU*(RNU-1.0)*C(10+NU)*KAI**(-NU-1) DO 265 NU=2,7 RNU=NU 265 SUM332=SUM332+RNU*(RNU-1.0)*C(20+NU)*KAI**(-NU-1) DO 266 NU=2,9 RNU=NU 266 SUM333=SUM333+RNU*(RNU-1.0)*C(30+NU)*KAI**(-NU-1) DO 267 N0=1,5 NU=N0-1 267 SUM336=SUM336+C(60+NU)*CITA**(-NU-2) PSIC1=2.0*(C(21)*KAI+SUM312+C(28)*DLOG(KAI))+6.0*(C(31)*KAI+ 1 SUM313+C(310)*DLOG(KAI))*(CITA-1.0)+(C(40)+C(41)*KAI**(-5)) 2 *(506.0*CITA-552.0)*CITA**(-25)+C(50)*CITA**(-1)+SUM316* 3 KAI**6+SUM317 CITA5=CITA-1.0 PSIC2=C(11)+SUM321+C(17)*KAI**(-1)+2.0*(C(21)+SUM322+C(28)*KAI 1 **(-1))*CITA5+3.0*(C(31)+SUM323+C(310)*KAI**(-1))*CITA5*CITA5 2 -5.0*C(41)*KAI**(-6)*(23.0-22.0*CITA)*CITA**(-24) 3 -6.0*SUM326*KAI**5 PSIC3=SUM330-C(120)*KAI**(-2)+(SUM331-C(17)*KAI**(-2))*CITA5+ 1 (SUM332-C(28)*KAI**(-2))*CITA5*CITA5+(SUM333-C(310)*KAI**(-2)) 2 *CITA5*CITA5*CITA5+30.0*C(41)*CITA5*KAI**(-7)*CITA**(-23) 3 +30.0*SUM336*KAI**4 EPSION=-CITA*PSIC1+CITA*PSIC2*PSIC2/PSIC3 RETURN END C ** SUBREGION 4 ** SUBROUTINE S19H2O(EPSION,KAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) COMMON /SUBR4/D(100) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 SUM312=0.0 SUM313=0.0 SUM316=0.0 SUM321=0.0 SUM322=0.0 SUM323=0.0 SUM326=0.0 SUM330=0.0 SUM331=0.0 SUM332=0.0 SUM333=0.0 SUM336=0.0 SUM411=0.0 SUM415=0.0 SUM421=0.0 SUM425=0.0 SUM431=0.0 SUM435=0.0 DO 250 NU=2,7 RNU=NU 250 SUM312=SUM312+C(20+NU)*KAI**(1-NU) DO 252 NU=2,9 RNU=NU 252 SUM313=SUM313+C(30+NU)*KAI**(1-NU) DO 253 N0=1,5 NU=N0-1 RNU=NU 253 SUM316=SUM316+(RNU+2.0)*(RNU+3.0)*C(60+NU)*CITA**(-NU-4) SUM317=2.0*C(71) IF(DABS(CITA-1.00D00).LT.1.00D-10) GO TO 256 SUM317=0.0 DO 255 N0=1,9 NU=N0-1 RNU=NU 255 SUM317=SUM317+RNU*(RNU+1.0)*C(70+NU)*(CITA-1.0)**(NU-1) 256 DO 257 NU=2,6 RNU=NU 257 SUM321=SUM321+(1.0-RNU)*C(10+NU)*KAI**(-NU) DO 258 NU=2,7 RNU=NU 258 SUM322=SUM322+(1.0-RNU)*C(20+NU)*KAI**(-NU) DO 260 NU=2,9 RNU=NU 260 SUM323=SUM323+(1.0-RNU)*C(30+NU)*KAI**(-NU) DO 262 N0=1,5 NU=N0-1 RNU=NU 262 SUM326=SUM326+(RNU+2.0)*C(60+NU)*CITA**(-NU-3) DO 263 NU=2,9 RNU=NU 263 SUM330=SUM330+RNU*(RNU-1.0)*C(NU)*KAI**(-NU-1) SUM330=SUM330+90.0*C(100)*KAI**(-11)+110.0*C(110)*KAI**(-12) DO 264 NU=2,6 RNU=NU 264 SUM331=SUM331+RNU*(RNU-1.0)*C(10+NU)*KAI**(-NU-1) DO 265 NU=2,7 RNU=NU 265 SUM332=SUM332+RNU*(RNU-1.0)*C(20+NU)*KAI**(-NU-1) DO 266 NU=2,9 RNU=NU 266 SUM333=SUM333+RNU*(RNU-1.0)*C(30+NU)*KAI**(-NU-1) DO 267 N0=1,5 NU=N0-1 267 SUM336=SUM336+C(60+NU)*CITA**(-NU-2) PSIC1=2.0*(C(21)*KAI+SUM312+C(28)*DLOG(KAI))+6.0*(C(31)*KAI+ 1 SUM313+C(310)*DLOG(KAI))*(CITA-1.0)+(C(40)+C(41)*KAI**(-5)) 2 *(506.0*CITA-552.0)*CITA**(-25)+C(50)*CITA**(-1)+SUM316* 3 KAI**6+SUM317 CITA5=CITA-1.0 PSIC2=C(11)+SUM321+C(17)*KAI**(-1)+2.0*(C(21)+SUM322+C(28)*KAI 1 **(-1))*CITA5+3.0*(C(31)+SUM323+C(310)*KAI**(-1))*CITA5*CITA5 2 -5.0*C(41)*(KAI**(-6))*(23.0-22.0*CITA)*CITA**(-24) 3 -6.0*SUM326*KAI**5 PSIC3=SUM330-C(120)*KAI**(-2)+(SUM331-C(17)*KAI**(-2))*CITA5+ 1 (SUM332-C(28)*KAI**(-2))*CITA5*CITA5+(SUM333-C(310)*KAI**(-2)) 2 *CITA5*CITA5*CITA5+30.0*C(41)*CITA5*(KAI**(-7))*CITA**(-23) 3 +30.0*SUM336*KAI**4 Y=(1.-CITA)/(1.-CITA1) DO 430 MU=3,4 RMU=MU DO 430 N0=1,5 NU=N0-1 430 SUM411=SUM411+RMU*(RMU-1.)*D(MU*10+NU)*(Y**(MU-2))*KAI**(-NU) DO 431 N0=1,3 NU=N0-1 431 SUM415=SUM415+D(50+NU)*KAI**NU DO 432 MU=3,4 RMU=MU DO 432 N0=1,5 NU=N0-1 RNU=NU 432 SUM421=SUM421+RMU*RNU*D(MU*10+NU)*(Y**(MU-1))*KAI**(-NU-1) DO 433 N0=1,3 NU=N0-1 RNU=NU 433 SUM425=SUM425+RNU*D(50+NU)*KAI**(NU-1) DO 435 MU=3,4 DO 435 N0=1,5 NU=N0-1 RNU=NU 435 SUM431=SUM431+RNU*(RNU+1.)*D(MU*10+NU)*(Y**MU)*KAI**(-NU-2) DO 436 N0=1,3 NU=N0-1 RNU=NU 436 SUM435=SUM435+RNU*(RNU-1.)*D(50+NU)*KAI**(NU-2) CITA5=1.-CITA1 PSID1=(SUM411+992.*SUM415*Y**30)/CITA5/CITA5 PSID2=(SUM421-32.*SUM425*Y**31)/CITA5 PSID3=SUM431+SUM435*Y**32 EPSION=-CITA*(PSIC1+PSID1-(PSIC2+PSID2)*(PSIC2+PSID2)/(PSIC3+ 1 PSID3)) RETURN END C ** SUBREGION 1 ** SUBROUTINE S20H2O(SIGUMA,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /SUBR1/A0,A(30),SA(20) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 Y=1.-SA(1)*(CITA**2)-SA(2)*(CITA**(-6)) RAM10=SA(3)*(Y**2)-2.*SA(4)*CITA+2.*SA(5)*BETA IF(RAM10.LE.0.D0) GO TO 1000 Z=Y+(RAM10**(1.D0/2.D0)) GO TO 1001 1000 Z=Y C * REDUCED ENTR0PY * 1001 YD=-2.*SA(1)*CITA+6.*SA(2)*(CITA**(-7)) SUM11=0. DO 15 NU=2,10 ANU=NU 15 SUM11=SUM11+(ANU-1.)*A(NU)*(CITA**(NU-2)) IF(DABS(SA(6)-CITA).LE.2.155D-09) GO TO 300 RAM2=(SA(6)-CITA)**9 GO TO 400 300 RAM2=0.D0 400 CTA10=CITA**10 CTA11=CITA*CTA10 CTA17=CITA**17 CTA18=CITA*CTA17 CTA19=CITA*CTA18 CTA21=CITA*CITA*CTA19 BTA2=BETA*BETA BTA3=BETA*BTA2 BTA4=BETA*BTA3 SIGUMA=-ALFA1+A0*DLOG(CITA)-SUM11 1 +A(11)*(((5.D0/12.D0)*Z-(SA(3)-1.D0)*Y)*YD+SA(4)) 2 *(Z**(-5.D0/17.D0))+(-A(13)-2.D0*A(14)*CITA+10.D0*A(15)*RAM2 3 +19.*A(16)*((SA(7)+CTA19)**(-2))*CTA18)*BETA 4 -11.* ((SA(8)+CTA11)**(-2))*CTA10 5 *(A(17)*BETA+A(18)*BTA2+A(19)*BTA3) 6 +A(20)*CTA17*(18.*SA(9)+20.*CITA*CITA) 7 *((SA(10)+BETA)**(-3)+SA(11)*BETA) 8 +A(21)*BTA3+20.* A(22)/CTA21*BTA4 RETURN END C ** SUBREGION 2 ** SUBROUTINE S21H2O(SIGUMA,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) INTEGER BZ,BN,BL,BX COMMON /SUBR2/B0,B(100),SB(100),BZ(10,10),BN(10),BL(10),BX(10,10), * BB COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 C ** DERIVED VALUES OF THE CONSTANTS RELATING THE L-FUNCTION ** DATA RL0/ 1.574373327D+01/, RL1/-3.417061978D+01/, * RL2/ 1.931380707D+01/ SUM26=0.0 SUM28=0.0 SUM212=0.0 SUM213=0.0 BETAL=RL0+RL1*CITA+RL2*CITA*CITA BETALD=RL1+2.*RL2*CITA X=DEXP(BB*(1.-CITA)) C * REDUCED ENTROPY * OTERM1=ALFA1 OTERM2=DI1*DLOG(BETA) OTERM3=B0*DLOG(CITA) DO 55 NU=1,5 ANU=NU 55 SUM26=SUM26+(ANU-1.)*B(NU)*(CITA**(NU-2)) OTERM4=SUM26 DO 60 MU=1,5 SUM27=0. I=BN(MU) DO 65 NU=1,I 65 SUM27=SUM27+BZ(MU,NU)*(X**BZ(MU,NU))*B(MU*10+NU) 60 SUM28=SUM28+(BETA**MU)*SUM27 OTERM5=BB*SUM28 DO 70 MU=6,8 SUM29=0. SUM210=0. SUM211=0. I=BL(MU) DO 75 LAM=1,I SUM29=SUM29+BX(MU,LAM)*SB(MU*10+LAM)*(X**BX(MU,LAM)) 75 SUM210=SUM210+SB(MU*10+LAM)*(X**BX(MU,LAM)) I=BN(MU) DO 80 NU=1,I 80 SUM211=SUM211+B(MU*10+NU)*(X**BZ(MU,NU))*((BZ(MU,NU) 1 - SUM29/(BETA**(2-MU)+SUM210))) 70 SUM212=SUM212+ (SUM211/(BETA**(2-MU)+SUM210)) OTERM6=BB*SUM212 DO 85 NU=1,7 ANU=NU-1 85 SUM213=SUM213+((10.*BETALD/BETAL+ANU*BB)*B(90+NU-1)*(X**(NU-1))) OTERM7=BETA*((BETA/BETAL)**10)*SUM213 SIGUMA=-OTERM1-OTERM2+OTERM3-OTERM4-OTERM5-OTERM6+OTERM7 RETURN END C ** SUBREGION 3 ** SUBROUTINE S22H2O(SIGUMA,KAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 SUM36=0.0 SUM37=0.0 SUM38=0.0 SUM39=0.0 C * REDUCED ENTROPY * DO 150 NU=2,6 150 SUM36=SUM36+C(10+NU)*(KAI**(1-NU)) DO 155 NU=2,7 155 SUM37=SUM37+C(20+NU)*(KAI**(1-NU)) DO 160 NU=2,9 160 SUM38=SUM38+C(30+NU)*(KAI**(1-NU)) DO 165 NU=1,5 ANU=NU-1 165 SUM39=SUM39+((ANU+2.)*C(60+NU-1)*(CITA**(-3-(NU-1)))) SUM310=C(70) IF(DABS(CITA-1.D0).LT.1.0D-10) GO TO 180 SUM310=0. DO 170 NU=1,9 ANU=NU-1 170 SUM310=SUM310+(ANU+1.)*C(70+NU-1)*((CITA-1.)**(NU-1)) 180 SIGUMA=-ALFA1 1 -(C(11)*KAI+SUM36+C(17)*DLOG(KAI)+C(50)) 2 -2.*(C(21)*KAI+SUM37+C(28)*DLOG(KAI))*(CITA-1.) 3 -3.*(C(31)*KAI+SUM38+C(310)*DLOG(KAI))*((CITA-1.)**2) 4 +(C(40)+C(41)*(KAI**(-5)))*( 22.*(CITA**(-23)) Z -23.*(CITA**(-24))) 5 -C(50)*DLOG(CITA) 6 +(KAI**6)*SUM39 7 -SUM310 RETURN END C ** SUBREGION 4 ** SUBROUTINE S23H2O(SIGUMA,KAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) COMMON /SUBR4/D(100) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 SUM36=0.0 SUM37=0.0 SUM38=0.0 SUM39=0.0 SUM413=0.0 SUM414=0.0 C * REDOCED ENTROPY * Y=(1.-CITA)/(1.-CITA1) IF(Y.LT.1.0D-02) Y=0. DO 150 NU=2,6 150 SUM36=SUM36+C(10+NU)*(KAI**(1-NU)) DO 155 NU=2,7 155 SUM37=SUM37+C(20+NU)*(KAI**(1-NU)) DO 160 NU=2,9 160 SUM38=SUM38+C(30+NU)*(KAI**(1-NU)) DO 165 NU=1,5 ANU=NU-1 165 SUM39=SUM39+((ANU+2.)*C(60+NU-1)*(CITA**(-3-(NU-1)))) SUM310=C(70) IF(DABS(CITA-1.D0).LT.1.0D-10) GO TO 180 SUM310=0. DO 170 NU=1,9 ANU=NU-1 170 SUM310=SUM310+(ANU+1.)*C(70+NU-1)*((CITA-1.)**(NU-1)) 180 CONTINUE DO 240 MU=3,4 DO 240 NU=1,5 AMU=MU 240 SUM413=SUM413+AMU*D(MU*10+NU-1)*(Y**(MU-1))*(KAI**(-(NU-1))) DO 245 NU=1,3 245 SUM414=SUM414+D(50+NU-1)*(KAI**(NU-1)) SIGUMA=-ALFA1 1 -(C(11)*KAI+SUM36+C(17)*DLOG(KAI)+C(50)) 2 -2.*(C(21)*KAI+SUM37+C(28)*DLOG(KAI))*(CITA-1.) 3 -3.*(C(31)*KAI+SUM38+C(310)*DLOG(KAI))*((CITA-1.)**2) 4 +(C(40)+C(41)*(KAI**(-5)))*( 22.*(CITA**(-23)) Z -23.*(CITA**(-24))) 5 -C(50)*DLOG(CITA) 6 +(KAI**6)*SUM39 7 -SUM310 8 +SUM413/(1.-CITA1)+32.*(Y**31)*SUM414/(1.-CITA1) RETURN END C * REDUCED PRESSURE FUNCTION SUBREGION 3 * DOUBLE PRECISION FUNCTION FAH2O(CITA,KAI) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) SUM31=0.0 SUM32=0.0 SUM33=0.0 SUM34=0.0 SUM35=0.0 IF(DABS(CITA-1.D0).LT.1.0D-09) CITA=1.D0 DO 125 NU=2,9 ANU=NU 125 SUM31=SUM31+(1.-ANU)*C(NU)*(KAI**(-NU)) DO 130 NU=2,6 ANU=NU 130 SUM32=SUM32+(1.-ANU)*C(10+NU)*(KAI**(-NU)) DO 135 NU=2,7 ANU=NU 135 SUM33=SUM33+(1.-ANU)*C(20+NU)*(KAI**(-NU)) DO 140 NU=2,9 ANU=NU 140 SUM34=SUM34+(1.-ANU)*C(30+NU)*(KAI**(-NU)) DO 145 NU=1,5 145 SUM35=SUM35+C(60+NU-1)*(CITA**(-2-(NU-1))) FAH2O=-(C(1)+SUM31+C(120)*(KAI**(-1))) O -(-9.*C(100)*(KAI**(-10))-10.*C(110)*(KAI**(-11))) 1 -(C(11)+SUM32+C(17)*(KAI**(-1)))*(CITA-1.) 2 -(C(21)+SUM33+C(28)*(KAI**(-1)))*((CITA-1.)**2) 3 -(C(31)+SUM34+C(310)*(KAI**(-1)))*((CITA-1.)**3) 4 +5.*C(41)*(KAI**(-6))*(CITA-1.)*(CITA**(-23)) 5 -6.*(KAI **5)*SUM35 RETURN END C * REDUCED PRESSURE FUNCTION SUBREGION 4 * DOUBLE PRECISION FUNCTION FBH2O(CITA,KAI) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI,I1 COMMON /SUBR3/C0,C(400) COMMON /SUBR4/D(100) COMMON /NUMEL/ALFA0,ALFA1,CITA1,I1 IF(DABS(CITA-1.D0).LT.1.0D-09) CITA=1.D0 SUM31=0.0 SUM32=0.0 SUM33=0.0 SUM34=0.0 SUM35=0.0 SUM46=0.0 SUM47=0.0 Y=(1.-CITA)/(1.-CITA1) IF(Y.LT.1.0D-02) Y=0. DO 125 NU=2,9 ANU=NU 125 SUM31=SUM31+(1.-ANU)*C(NU)*(KAI**(-NU)) DO 130 NU=2,6 ANU=NU 130 SUM32=SUM32+(1.-ANU)*C(10+NU)*(KAI**(-NU)) DO 135 NU=2,7 ANU=NU 135 SUM33=SUM33+(1.-ANU)*C(20+NU)*(KAI**(-NU)) DO 140 NU=2,9 ANU=NU 140 SUM34=SUM34+(1.-ANU)*C(30+NU)*(KAI**(-NU)) DO 145 NU=1,5 145 SUM35=SUM35+C(60+NU-1)*(CITA**(-2-(NU-1))) DO 204 MU=3,4 DO 204 NU=1,5 ANU=NU-1 204 SUM46=SUM46+ANU*D(MU*10+NU-1)*(Y**MU)*(KAI**(-(NU-1)-1)) DO 210 NU=1,3 ANU=NU-1 210 SUM47=SUM47+ANU*D(50+NU-1)*(KAI**(NU-1-1)) FBH2O=-(C(1)+SUM31+C(120)*(KAI**(-1))) O -(-9.*C(100)*(KAI**(-10))-10.*C(110)*(KAI**(-11))) 1 -(C(11)+SUM32+C(17)*(KAI**(-1)))*(CITA-1.) 2 -(C(21)+SUM33+C(28)*(KAI**(-1)))*((CITA-1.)**2) 3 -(C(31)+SUM34+C(310)*(KAI**(-1)))*((CITA-1.)**3) 4 +5.*C(41)*(KAI**(-6))*(CITA-1.)*(CITA**(-23)) 5 -6.*(KAI **5)*SUM35 6 +SUM46-(Y**32)*SUM47 RETURN END C ** THE K-FUNCTION ( SATURATION LINE ,PRESSUR BASE ) ** SUBROUTINE S7H2O(CITAK,BETA) IMPLICIT DOUBLE PRECISION (A-H,O-Z) COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 DATA COF1/ 0.460664D+01/,COF2/ 0.257746D+00/,COF3/-0.174491D-01/, 1 COF4/ 0.471172D-02/,COF5/-0.891457D-03/ ICNT=0 P=BETA*PC1*1.01972D-05 Y=COF1+COF2*DLOG(P)+COF3*DLOG(P)**2+COF4*DLOG(P)**3 1 +COF5*DLOG(P)**4 CT0=DEXP(Y) CITA0=(CT0+T0)/TC1 IF(DABS((BETA-1.D00)/BETA).LT.1.D-06) THEN CITAK=1.0D00 RETURN END IF 100 CONTINUE G0=1.-BETA/FCH2O(CITA0) CITA1=CITA0-G0/FDH2O(CITA0) ICNT=ICNT+1 IF(DABS(G0).LT.1.0D-7) GO TO 200 CITA0=CITA1 GO TO 100 200 CITAK=CITA1 RETURN END C ** THE K-FUNCTION ( SATURATION LINE , TEMPERATURE BASE ) ** DOUBLE PRECISION FUNCTION FCH2O(CITA) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DOUBLE PRECISION K(20) COMMON /SATUL/K IF(DABS(CITA-1.D0).LT.1.0D-09) CITA=1.D0 SUMK=0. DO 10 NU=1,5 10 SUMK=SUMK+K(NU)*((1.-CITA)**NU) XK=(1./CITA)*SUMK/(1.+K(6)*(1.-CITA)+K(7)*((1.-CITA)**2)) 1 -(1.-CITA)/(K(8)*((1.-CITA)**2)+K(9)) FCH2O=DEXP(XK) RETURN END C*** INITIAL VALUES, CONSTANTS FOR CALCULATION *** SUBROUTINE S25H2O IMPLICIT DOUBLE PRECISION (A-H,O-Z) DOUBLE PRECISION K(20),I1 INTEGER BZ,BN,BL,BX COMMON /NUMEL/ALFA0,ALFA1,CITA1,I1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 COMMON /SUBR1/A0,A(30),SA(20) COMMON /SUBR2/B0,B(100),SB(100),BZ(10,10),BN(10),BL(10) 1 ,BX(10,10),BB COMMON /SUBR3/C0,C(400) COMMON /SUBR4/D(100) COMMON /SATUL/K C ** ONE PART OF NUMERICAL VALUES OF DERIVED CONSTANTS ** ALFA0= 0. ALFA1= 0. CITA1= 9.626911788D-01 I1 = 4.260321148D+00 CRTM=3.74150001D02 CRPR=2.2120001D02 TMMX=8.0000001D02 PRMX=1.0000001D03 VPXX=1.0000001D0 ZPR0=6.1075D-03 C ** DEFINED CONSTANT QUANTITIES ** T0=2.7315D+02 TC1=6.473D+02 PC1=2.212D+07 SVC1=3.17D-03 C ** SUBREGION 1 ** A0 = 6.824687741D+03 A( 1)=-5.422063673D+02 A( 2)=-2.096666205D+04 A( 3)= 3.941286787D+04 A( 4)=-6.733277739D+04 A( 5)= 9.902381028D+04 A( 6)=-1.093911774D+05 A( 7)= 8.590841667D+04 A( 8)=-4.511168742D+04 A( 9)= 1.418138926D+04 A(10)=-2.017271113D+03 A(11)= 7.982692717D+00 A(12)=-2.616571843D-02 A(13)= 1.522411790D-03 A(14)= 2.284279054D-02 A(15)= 2.421647003D+02 A(16)= 1.269716088D-10 A(17)= 2.074838328D-07 A(18)= 2.174020350D-08 A(19)= 1.105710498D-09 A(20)= 1.293441934D+01 A(21)= 1.308119072D-05 A(22)= 6.047626338D-14 C SA( 1)= 8.438375405D-01 SA( 2)= 5.362162162D-04 SA( 3)= 1.720000000D+00 SA( 4)= 7.342278489D-02 SA( 5)= 4.975858870D-02 SA( 6)= 6.537154300D-01 SA( 7)= 1.150000000D-06 SA( 8)= 1.510800000D-05 SA( 9)= 1.418800000D-01 SA(10)= 7.002753165D+00 SA(11)= 2.995284926D-04 SA(12)= 2.040000000D-01 C C ** SU BREGION 2 ** C B0 = 1.683599274D+01 B( 1)= 2.856067796D+01 B( 2)=-5.438923329D+01 B( 3)= 4.330662834D-01 B( 4)=-6.547711697D-01 B( 5)= 8.565182058D-02 B(11)= 6.670375918D-02 B(12)= 1.388983801D+00 B(21)= 8.390104328D-02 B(22)= 2.614670893D-02 B(23)=-3.373439453D-02 B(31)= 4.520918904D-01 B(32)= 1.069036614D-01 B(41)=-5.975336707D-01 B(42)=-8.847535804D-02 B(51)= 5.958051609D-01 B(52)=-5.159303373D-01 B(53)= 2.075021122D-01 B(61)= 1.190610271D-01 B(62)=-9.867174132D-02 B(71)= 1.683998803D-01 B(72)=-5.809438001D-02 B(81)= 6.552390126D-03 B(82)= 5.710218649D-04 B(90)= 1.936587558D+02 B(91)=-1.388522425D+03 B(92)= 4.126607219D+03 B(93)=-6.508211677D+03 B(94)= 5.745984054D+03 B(95)=-2.693088365D+03 B(96)= 5.235718623D+02 BB = 7.633333333D-01 SB(61)= 4.006073948D-01 SB(71)= 8.636081627D-02 SB(81)=-8.532322921D-01 SB(82)= 3.460208861D-01 C C THE NUMBERS OF TERMS N(MU),L(MU);THE EXPONENTS Z(MU,NU),X(MU,LAM) C BN(1)= 2 BN(2)= 3 BN(5)= 3 BN(4)= 2 BN(3)= 2 BN(6)= 2 BN(7)= 2 BZ(1,2)= 3 BZ(1,1)=13 BN(8)= 2 BZ(2,1)=18 BZ(2,2)= 2 BZ(3,2)=10 BZ(3,1)=18 BZ(2,3)= 1 BZ(4,1)=25 BZ(4,2)=14 BZ(5,3)=24 BZ(5,2)=28 BZ(5,1)=32 BZ(6,1)=12 BZ(6,2)=11 BZ(8,1)=24 BZ(7,2)=18 BZ(7,1)=24 BZ(8,2)=14 BL(6)= 1 BX(6,1)=14 BL(8)= 2 BL(7)= 1 BX(7,1)=19 BX(8,1)=54 BX(8,2)=27 C C ** SUBREGION 3 ** C C0 =-6.839900000D+00 C( 1)=-1.722604200D-02 C( 2)=-7.771750390D+00 C( 3)= 4.204607520D+00 C( 4)=-2.768070380D+00 C( 5)= 2.104197070D+00 C( 6)=-1.146495880D+00 C( 7)= 2.231380850D-01 C( 8)= 1.162503630D-01 C( 9)=-8.209005440D-02 C(100)= 1.941292390D-02 C(110)=-1.694705760D-03 C(120)=-4.311577033D+00 C(11)= 7.086360850D-01 C(12)= 1.236794550D+01 C(13)=-1.203890040D+01 C(14)= 5.404374220D+00 C(15)=-9.938650430D-01 C(16)= 6.275231820D-02 C(17)=-7.747430160D+00 C(21)=-4.298850920D+00 C(22)= 4.314305380D+01 C(23)=-1.416193130D+01 C(24)= 4.041724590D+00 C(27)= 3.248811580D-01 C(28)= 2.936553250D+01 C(31)= 7.948418420D-06 C(32)= 8.088597470D+01 C(33)=-8.361533800D+01 C(34)= 3.586365170D+01 C(35)= 7.518959540D+00 C(36)=-1.261606400D+01 C(37)= 1.097174620D+00 C(38)= 2.121454920D+00 C(39)=-5.465295660D-01 C(310)= 8.328754130D+00 C(40)= 2.759717760D-06 C(41)=-5.090739850D-04 C(50)= 2.106363320D+02 C(60)= 5.528935335D-02 C(25)= 1.555463260D+00 C(26)=-1.665689350D+00 C(61)=-2.336365955D-01 C(62)= 3.697071420D-01 C(63)=-2.596415470D-01 C(64)= 6.828087013D-02 C(70)=-2.571600553D+02 C(71)=-1.518783715D+02 C(72)= 2.220723208D+01 C(73)=-1.802039570D+02 C(74)= 2.357096220D+03 C(75)=-1.462335698D+04 C(76)= 4.542916630D+04 C(77)=-7.053556432D+04 C(78)= 4.381571428D+04 C ** SUBREGION 4 ** D(30)=-1.717616747D+00 D(31)= 3.526389875D+00 D(32)=-2.690899373D+00 D(33)= 9.070982605D-01 D(34)=-1.138791156D-01 D(40)= 1.301023613D+00 D(41)=-2.642777743D+00 D(42)= 1.996765362D+00 D(43)=-6.661557013D-01 D(44)= 8.270860589D-02 D(50)= 3.426663535D-04 D(51)=-1.236521258D-03 D(52)= 1.155018309D-03 C ** SATULATION LINE ** K(1)=-7.691234564D+00 K(2)=-2.608023696D+01 K(3)=-1.681706546D+02 K(4)= 6.423285504D+01 K(5)=-1.189646225D+02 K(6)= 4.167117320D+00 K(7)= 2.097506760D+01 K(8)= 1.D+09 K(9)= 6.D+00 RETURN END C ** THE K-FUNCTION (DY/DX) ( SATURATION LINE , TEMPERATURE BASE ) ** DOUBLE PRECISION FUNCTION FDH2O(CITA) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DOUBLE PRECISION K(20) COMMON /SATUL/K IF(DABS(CITA-1.D0).LT.1.0D-09) CITA=1.D0 CITA1=1.0-CITA SUMK=0. DO 10 NU=1,5 10 SUMK=SUMK+K(NU)*CITA1**NU SUMKN=0. DO 20 NU=1,5 20 SUMKN=SUMKN+NU*K(NU)*CITA1**(NU-1) BNB=CITA*(1+K(6)*CITA1+K(7)*CITA1*CITA1) DY=(-1.+K(6)*(2.*CITA-1.)+K(7)*CITA1*(3.*CITA-1.))*SUMK/(BNB*BNB) 1 -SUMKN/BNB-(K(8)*CITA1*CITA1-K(9))/(K(8)*CITA1*CITA1+K(9))**2 FDH2O=DY RETURN END C ** SUBREGION 1 ** CV SUBROUTINE S28H2O(EPSION,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /SUBR1/A0,A(30),SA(20) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 C& WRITE(6,*) '***** SUBREGION 1 *****' Y=1.-SA(1)*(CITA**2)-SA(2)*(CITA**(-6)) Z1=SA(3)*Y*Y-2.*SA(4)*CITA+2.*SA(5)*BETA Z=Y+Z1**0.5 DY=-2.*SA(1)*CITA+6.*SA(2)*CITA**(-7) DDY=-2.*(SA(1)+21.*SA(2)*CITA**(-8)) DZ=DY+(SA(3)*Y*DY-SA(4))*Z1**(-0.5) DDZ=DDY+SA(3)*Z1**(-0.5)*(DY*DY+Y*DDY)-(SA(3)*Y*DY-SA(4))**2*Z1 1 **(-3./2.) DZB=SA(5)*Z1**(-0.5) SUM1=0.0 DO 20 NU=1,8 NU0=NU-1 RNU=NU0 20 SUM1=SUM1+(RNU+1.)*(RNU+2.)*A(NU0+3)*CITA**NU0 BETA2=BETA*BETA BETA3=BETA2*BETA COF129=1.2D01/2.9D01 COF249=2.*COF129 COF517=5.0D00/1.7D01 COF172=1.7D01/1.2D01 COF179=1.7D01/2.9D01 COF227=2.2D01/1.7D01 COF127=1.2D01/1.7D01 CIT9=CITA**9 CIT10=CIT9*CITA CIT11=CITA*CIT10 CIT16=CITA**16 CIT17=CIT16*CITA CIT18=CIT17*CITA CIT19=CIT18*CITA DDZETA=-A0/CITA+SUM1+A(11)*((COF129*Z-Y)*(Z**(-COF517)*DDZ 1 -COF517*Z**(-COF227)*DZ*DZ)+(COF249*DZ-2.*DY)*Z**(-COF517) 2 *DZ+(COF179*DDZ-COF172*DDY)*Z**(COF127))+BETA*(2.*A(14)+ 3 90.*A(15)*(SA(6)-CITA)**8+722.*A(16)*CIT18*CIT18*(SA(7)+ 4 CIT19)**(-3)-342.*A(16)*CIT17*(SA(7)+CIT19)**(-2))-(242.* 5 CITA*CIT19*(SA(8)+CIT11)**(-3)-110.*CIT9*(SA(8)+CIT11)**(-2)) 6 *(A(17)*BETA+A(18)*BETA2+A(19)*BETA3)-A(20)*CIT16*(306.*SA(9) 7 +380.*CITA*CITA)*((SA(10)+BETA)**(-3)+SA(11)*BETA)+420.*A(22) 8 *BETA3*BETA/CIT11/CIT11 DDZCB=-COF517*A(11)*SA(5)*Z**(-COF227)*DZ 1 +(A(13)+2.*A(14)*CITA-10.*A(15)*(SA(6)-CITA)**9 2 -19*A(16)*(SA(7)+CIT19)**(-2)*CIT18)+11.*(SA(8)+CIT11)**(-2) 3 *CIT10*(A(17)+2.*A(18)*BETA+3.*A(19)*BETA2) -A(20)*CIT17 4 *(18.*SA(9)+20.*CITA**2)*(-3.*(SA(10)+BETA)**(-4)+SA(11)) 5 -3.*A(21)*BETA2-80.*A(22)*BETA3/(CIT10*CIT11) DDZDB2=-COF517*A(11)*SA(5)*Z**(-COF227)*DZB 1 -2./(SA(8)+CIT11)*(A(18)+3.*A(19)*BETA) 2 -12.*A(20)*CIT18*(SA(9)+CITA**2)*(SA(10)+BETA)**(-5) 3 +6.*A(21)*(SA(12)-CITA)*BETA+12.*A(22)*CIT10**(-2)*BETA2 EPSION=-CITA*(DDZETA-DDZCB*DDZCB/DDZDB2) RETURN END C ** SUBREGION 2 ** SUBROUTINE S29H2O(EPSION,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) INTEGER BZ,BN,BL,BX DIMENSION F0(3),F1(3),F2(3),G0(3),G1(3),G2(3), * H(8),DJ(8),Q(8),R(8) COMMON /SUBR2/B0,B(100),SB(100),BZ(10,10),BN(10),BL(10),BX(10,10), * BB COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 DATA RL0/ 1.574373327D+01/, RL1/-3.417061978D+01/, * RL2/ 1.931380707D+01/, DDBETL/3.862761414D+02/ C& WRITE(6,*) '***** SUBREGION 2 *****' BETAL=RL0+RL1*CITA+RL2*(CITA**2) BETALD=RL1+2.*RL2*CITA X=DEXP(BB*(1.-CITA)) BETA3=BETA**3 BETA4=BETA3*BETA BETA5=BETA4*BETA BETA6=BETA5*BETA X10=X**10 X11=X10*X X12=X11*X X13=X12*X X14=X13*X X18=X**18 X19=X18*X X24=X12*X12 X27=X**27 X28=X27*X X32=X14*X18 X54=X27*X27 BB2=BB*BB F0(1)=(B(61)*X12+B(62)*X11)*BETA4 F0(2)=(B(71)*X24+B(72)*X18)*BETA5 F0(3)=(B(81)*X24+B(82)*X14)*BETA6 F1(1)=-BB*BETA4*(12.*B(61)*X12+11.*B(62)*X11) F1(2)=-BB*BETA5*(24.*B(71)*X24+18.*B(72)*X18) F1(3)=-BB*BETA6*(24.*B(81)*X24+14.*B(82)*X14) F2(1)=BB2*BETA4*(144.*B(61)*X12+121.*B(62)*X11) F2(2)=BB2*BETA5*(576.*B(71)*X24+324.*B(72)*X18) F2(3)=BB2*BETA6*(576.*B(81)*X24+196.*B(82)*X14) G0(1)=1.+SB(61)*X14*BETA4 G0(2)=1.+SB(71)*X19*BETA5 G0(3)=1.+(SB(81)*X54+SB(82)*X27)*BETA6 G1(1)=-14.*BB*SB(61)*X14*BETA4 G1(2)=-19.*BB*SB(71)*X19*BETA5 G1(3)=-BB*BETA6*(54.*SB(81)*X54+27.*SB(82)*X27) G2(1)=196.*BB2*SB(61)*X14*BETA4 G2(2)=361.*BB2*SB(71)*X19*BETA5 G2(3)=BB2*BETA6*(2916.*SB(81)*X54+729.*SB(82)*X27) H(6)=1./BETA4+SB(61)*X14 H(7)=1./BETA5+SB(71)*X19 H(8)=1./BETA6+SB(81)*X54+SB(82)*X27 DJ(6)=28.*SB(61)*X14 DJ(7)=38.*SB(71)*X19 DJ(8)=108.*SB(81)*X54+54.*SB(82)*X27 Q(1)=B(11)*X13+B(12)*X*X*X Q(2)=B(21)*X18+B(22)*X*X+B(23)*X Q(3)=B(31)*X18+B(32)*X10 Q(4)=B(41)*X24*X+B(42)*X14 Q(5)=B(51)*X32+B(52)*X28+B(53)*X24 Q(6)=B(61)*X12+B(62)*X11 Q(7)=B(71)*X24+B(72)*X18 Q(8)=B(81)*X24+B(82)*X14 R(1)=13.*B(11)*X13+3.*B(12)*X*X*X R(2)=18.*B(21)*X18+2.*B(22)*X*X+B(23)*X R(3)=18.*B(31)*X18+10.*B(32)*X10 R(4)=25.*B(41)*X24*X+14.*B(42)*X14 R(5)=32.*B(51)*X32+28.*B(52)*X28+24.*B(53)*X24 R(6)=12.*B(61)*X12+11.*B(62)*X11 R(7)=24.*B(71)*X24+18.*B(72)*X18 R(8)=24.*B(81)*X24+14.*B(82)*X14 SUM77=0. DO 150 I=1,3 150 SUM77=SUM77+F2(I)/G0(I)-(2.*F1(I)*G1(I)+F0(I)*G2(I))/G0(I)/G0(I) 1 +2.*F0(I)*G1(I)*G1(I)/(G0(I)**3) SUM1=0. SUM2=0. SUM3=0. DO 155 N0=1,7 NU=N0-1 RNU=NU SMB=B(90+NU)*X**NU SUM1=SUM1+SMB SUM2=SUM2+RNU*SMB 155 SUM3=SUM3+RNU*RNU*SMB DDZETA=-B0/CITA+2.*B(3)+6.*B(4)*CITA+12.*B(5)*CITA*CITA- 1 (169.*B(11)*X12*X+9.*B(12)*X**3)*BB2*BETA-(324.*B(21)*X18+4.* 2 B(22)*X*X+B(23)*X)*BB2*BETA*BETA-(324.*B(31)*X18+100.*B(32)* 3 X10)*BB2*BETA3-(625.*B(41)*X24*X+196.*B(42)*X14)*BB2*BETA4- 4 (1024.*B(51)*X**32+784.*B(52)*X27*X+576.*B(53)*X24)*BB2*BETA5- 5 SUM77+(BETA/BETAL)**11*((110./BETAL*BETALD*BETALD-DDBETL)*SUM1+ 6 20.*BB*BETALD*SUM2+BB2*BETAL*SUM3) SUM1=0. SUM2=0. SUM3=0. DO 200 N1=1,5 SUM1=SUM1+N1*BETA**(N1-1)*R(N1) 200 CONTINUE DO 210 N2=6,8 SUM2=SUM2+(N2-2)*BETA**(1-N2)*H(N2)**(-2) 1 *(R(N2)-Q(N2)*DJ(N2)/H(N2)) 210 CONTINUE DO 220 N3=0,6 SUM3=SUM3+(10.*BETALD/BETAL+N3*BB)*B(90+N3)*X**N3 220 CONTINUE DDZCB=DI1/BETA+BB*(SUM1+SUM2)-11*(BETA/BETAL)**10*SUM3 SUM1=0. SUM2=0. SUM3=0. DO 300 N1=1,5 SUM1=SUM1+N1*(N1-1)*BETA**(N1-2)*Q(N1) 300 CONTINUE DO 310 N2=6,8 SUM2=SUM2+(N2-2)*BETA**(-N2)*Q(N2)/H(N2)**2*((1-N2) 1 +2*(N2-2)*BETA**(2-N2)/H(N2)) 310 CONTINUE DO 320 N3=0,6 SUM3=SUM3+B(90+N3)*X**N3 320 CONTINUE DDZDB2=-DI1*CITA/(BETA*BETA)-SUM1-SUM2 1 +110*(BETA/BETAL)**9/BETAL*SUM3 EPSION=-CITA*(DDZETA-DDZCB*DDZCB/DDZDB2) RETURN END C ** SUBREGION 3 ** CV SUBROUTINE S30H2O(EPSION,KAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 SUM312=0.0 C& WRITE(6,*) '***** SUBREGION 3 *****' SUM313=0.0 SUM316=0.0 DO 250 NU=2,7 250 SUM312=SUM312+C(20+NU)*KAI**(1-NU) DO 252 NU=2,9 252 SUM313=SUM313+C(30+NU)*KAI**(1-NU) DO 253 NU=0,4 RNU=NU 253 SUM316=SUM316+(RNU+2.0)*(RNU+3.0)*C(60+NU)*CITA**(-NU-4) SUM317=2.0*C(71) IF(DABS(CITA-1.00D00).LT.1.00D-10) GO TO 256 SUM317=0.0 DO 255 NU=0,8 RNU=NU 255 SUM317=SUM317+RNU*(RNU+1.0)*C(70+NU)*(CITA-1.0)**(NU-1) 256 CONTINUE PSIC1=2.0*(C(21)*KAI+SUM312+C(28)*DLOG(KAI))+6.0*(C(31)*KAI+ 1 SUM313+C(310)*DLOG(KAI))*(CITA-1.0)+(C(40)+C(41)*KAI**(-5)) 2 *(506.0*CITA-552.0)*CITA**(-25)+C(50)*CITA**(-1)+SUM316* 3 KAI**6+SUM317 EPSION=-CITA*PSIC1 RETURN END C ** SUBREGION 4 ** CV SUBROUTINE S31H2O(EPSION,KAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) COMMON /SUBR4/D(100) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 SUM312=0.0 C& WRITE(6,*) '***** SUBREGION 4 *****' SUM313=0.0 SUM316=0.0 SUM411=0.0 SUM415=0.0 DO 250 NU=2,7 RNU=NU 250 SUM312=SUM312+C(20+NU)*KAI**(1-NU) DO 252 NU=2,9 RNU=NU 252 SUM313=SUM313+C(30+NU)*KAI**(1-NU) DO 253 N0=1,5 NU=N0-1 RNU=NU 253 SUM316=SUM316+(RNU+2.0)*(RNU+3.0)*C(60+NU)*CITA**(-NU-4) SUM317=2.0*C(71) IF(DABS(CITA-1.00D00).LT.1.00D-10) GO TO 256 SUM317=0.0 DO 255 N0=1,9 NU=N0-1 RNU=NU 255 SUM317=SUM317+RNU*(RNU+1.0)*C(70+NU)*(CITA-1.0)**(NU-1) 256 CONTINUE PSIC1=2.0*(C(21)*KAI+SUM312+C(28)*DLOG(KAI))+6.0*(C(31)*KAI+ 1 SUM313+C(310)*DLOG(KAI))*(CITA-1.0)+(C(40)+C(41)*KAI**(-5)) 2 *(506.0*CITA-552.0)*CITA**(-25)+C(50)*CITA**(-1)+SUM316* 3 KAI**6+SUM317 Y=(1.-CITA)/(1.-CITA1) DO 430 MU=3,4 RMU=MU DO 430 N0=1,5 NU=N0-1 430 SUM411=SUM411+RMU*(RMU-1.)*D(MU*10+NU)*(Y**(MU-2))*KAI**(-NU) DO 431 N0=1,3 NU=N0-1 431 SUM415=SUM415+D(50+NU)*KAI**NU CITA5=1.-CITA1 PSID1=(SUM411+992.*SUM415*Y**30)/CITA5/CITA5 EPSION=-CITA*(PSIC1+PSID1) RETURN END C ** SUBREGION 1 ** DPDV SUBROUTINE S32H2O(DPDV,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) COMMON /SUBR1/A0,A(30),SA(20) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 C& WRITE(6,*) '***** SUBREGION 1 (S32H2O) *****' Y=1.-SA(1)*(CITA**2)-SA(2)*(CITA**(-6)) Z1=SA(3)*Y*Y-2.*SA(4)*CITA+2.*SA(5)*BETA Z=Y+Z1**0.5 BETA2=BETA*BETA COF517=5.0D00/1.7D01 COF227=2.2D01/1.7D01 CIT9=CITA**9 CIT10=CIT9*CITA CIT11=CITA*CIT10 CIT16=CITA**16 CIT17=CIT16*CITA CIT18=CIT17*CITA RDPDV=-COF517*A(11)*SA(5)**2/DSQRT(Z1)*Z**(-COF227) 1 -2.*(A(18)+3.*A(19)*BETA)/(SA(8)+CIT11) 2 -12.*A(20)*CIT18*(SA(9)+CITA*CITA)*(SA(10)+BETA)**(-5) 3 +6.*A(21)*(SA(12)-CITA)*BETA+12.*A(22)/CIT10**2*BETA2 DPDV=1/RDPDV RETURN END C ** SUBREGION 2 DPDV** SUBROUTINE S33H2O(DPDV,CITA,BETA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) INTEGER BZ,BN,BL,BX DIMENSION H(8),Q(8) COMMON /SUBR2/B0,B(100),SB(100),BZ(10,10),BN(10),BL(10),BX(10,10), * BB COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 DATA RL0/ 1.574373327D+01/, RL1/-3.417061978D+01/, * RL2/ 1.931380707D+01/, DDBETL/3.862761414D+02/ C& WRITE(6,*) '***** SUBREGION 2 (S29H2O) *****' BETAL=RL0+RL1*CITA+RL2*(CITA**2) BETALD=RL1+2.*RL2*CITA X=DEXP(BB*(1.-CITA)) BETA3=BETA**3 BETA4=BETA3*BETA BETA5=BETA4*BETA BETA6=BETA5*BETA X10=X**10 X11=X10*X X12=X11*X X13=X12*X X14=X13*X X18=X**18 X19=X18*X X24=X12*X12 X27=X**27 X28=X27*X X32=X14*X18 X54=X27*X27 BB2=BB*BB H(6)=1./BETA4+SB(61)*X14 H(7)=1./BETA5+SB(71)*X19 H(8)=1./BETA6+SB(81)*X54+SB(82)*X27 Q(1)=B(11)*X13+B(12)*X*X*X Q(2)=B(21)*X18+B(22)*X*X+B(23)*X Q(3)=B(31)*X18+B(32)*X10 Q(4)=B(41)*X24*X+B(42)*X14 Q(5)=B(51)*X32+B(52)*X28+B(53)*X24 Q(6)=B(61)*X12+B(62)*X11 Q(7)=B(71)*X24+B(72)*X18 Q(8)=B(81)*X24+B(82)*X14 SUM1=0. SUM2=0. SUM3=0. DO 200 N1=1,5 SUM1=SUM1+N1*(N1-1)*BETA**(N1-2)*Q(N1) 200 CONTINUE DO 210 N2=6,8 SUM2=SUM2+((1-N2)-2*(2-N2)*BETA**(2-N2)/H(N2)) 1 *(N2-2)*BETA**(-N2)*Q(N2)/H(N2)**2 210 CONTINUE DO 220 N3=0,6 SUM3=SUM3+B(90+N3)*X**N3 220 CONTINUE RDPDV=-DI1*CITA/BETA**2-SUM1-SUM2+110.*(BETA/BETAL)**9/BETAL*SUM3 DPDV=1/RDPDV RETURN END C ** SUBREGION 3 ** DPDV SUBROUTINE S34H2O(DPDV,KAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 C& WRITE(6,*) '***** SUBREGION 3 (S34H2O) *****' SUM0=0.0 SUM1=0.0 SUM2=0.0 SUM3=0.0 SUM6=0.0 DO 101 NU=2,9 SUM0=SUM0+(1-NU)*NU*C(NU)*KAI**(-1-NU) 101 CONTINUE SUM0=SUM0+C(120)*KAI**(-2) 1 +(1-10)*10*C(100)*KAI**(-1-10) 2 +(1-11)*11*C(110)*KAI**(-1-11) DO 102 NU=2,6 SUM1=SUM1+(1-NU)*NU*C(10+NU)*KAI**(-1-NU) 102 CONTINUE SUM1=SUM1+C(17)*KAI**(-2) DO 103 NU=2,7 SUM2=SUM2+(1-NU)*NU*C(20+NU)*KAI**(-1-NU) 103 CONTINUE SUM2=SUM2+C(28)*KAI**(-2) DO 104 NU=2,9 SUM3=SUM3+(1-NU)*NU*C(30+NU)*KAI**(-1-NU) 104 CONTINUE SUM3=SUM3+C(310)*KAI**(-2) DO 105 NU=0,4 SUM6=SUM6+C(60+NU)*CITA**(-2-NU) 105 CONTINUE DPDV=SUM0+SUM1*(CITA-1.)+SUM2*(CITA-1.)**2+SUM3*(CITA-1.)**3 1 -30.*C(41)*KAI**(-7)*CITA**(-23)*(CITA-1.) 2 -30.*KAI**4*SUM6 RETURN END C ** SUBREGION 4 ** CV SUBROUTINE S35H2O(DPDV,KAI,CITA) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION KAI COMMON /SUBR3/C0,C(400) COMMON /SUBR4/D(100) COMMON /NUMEL/ALFA0,ALFA1,CITA1,DI1 COMMON /DEFIN/CRTM,CRPR,TMMX,PRMX,VPXX,ZPR0,T0,TC1,PC1,SVC1 CALL S34H2O(DPDV3,KAI,CITA) C& WRITE(6,*) '***** SUBREGION 4 (S31H2O) *****' SY=(1.-CITA)/(1.-CITA1) SUM8=0.0 SUM9=0.0 DO 202 MU=3,4 DO 202 NU=0,4 SUM8=SUM8+NU*(NU+1)*D(MU*10+NU)*SY**MU*KAI**(-NU-2) 202 CONTINUE DO 203 NU=0,2 SUM9=SUM9+NU*(NU-1)*D(50+NU)*KAI**(NU-2) 203 CONTINUE DPDV=DPDV3-SUM8-SY**32*SUM9 RETURN END C** Saturation Pressure over Ice for Temperature Range of -100 to 0 C Ref: ASHRAE Handbook 1985 Fundamentals, ASHRAE, Chap.6, 1985 C DOUBLE PRECISION FUNCTION FEH2O(DT) IMPLICIT REAL*8 (C,D,F) REAL*8 PBAR,T0K IF (DT.GE.-0.008) THEN FEH2O=6.108D-03 ELSE PBAR=1.0D-05 T0K=273.15 C1=-5674.5359D+00 C2=6.3925247D+00 C3=-0.9677843D-02 C4=0.62215701D-06 C5=0.20747825D-08 C6=-0.9484024D-12 C7=4.1635019D+00 CT=DT+T0K DLNP=C1/CT+C2+CT*(C3+CT*(C4+CT*(C5+CT*C6)))+C7*DLOG(CT) FEH2O=DEXP(DLNP)*PBAR END IF RETURN END C** Saturation Pressure over Ice for Pressure Range of C 14.0749D-09 to 6.1764D-03 bar C Ref: ASHRAE Handbook 1985 Fundamentals, ASHRAE, Chap.6, 1985 C DOUBLE PRECISION FUNCTION FFH2O(DP) IMPLICIT REAL*8 (C,D,F) REAL*8 PBAR,T0K,EPS DPDT(DT)=1./(-C1/(DT*DT)+C3+DT*(2.*C4+DT*(3.*C5+4.*C6*DT))+C7/DT) T0K=273.15 EPS=1.0D-07 C1=-5674.5359D+00 C3=-0.9677843D-02 C4=0.62215701D-06 C5=0.20747825D-08 C6=-0.9484024D-12 C7=4.1635019D+00 C SET INITIAL GUESS OF DT0 DTO=264.5 + 7.7*DLOG(DP) IT=1 1000 CONTINUE DTN=DTO-DPDT(DTO)*DLOG(FEH2O(DTO-T0K)/DP) IF(DABS((DTN-DTO)/DTN).LT.EPS) THEN FFH2O=DTN-T0K RETURN ELSE IF(IT.GT.10000) THEN FFH2O=-1.0D+10 RETURN ELSE DTO=DTN IT=IT+1 END IF GOTO 1000 END REAL FUNCTION T90(T) * Conversion of temperature scal from IPTS-68 to ITS-90 * Range -200C<=T68<=630C anf T68>=1064 REAL T68,T0K REAL*8 CA(8) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA CA/-0.14542, -0.26722, 1.06471, 1.131286, -4.25835, + -1.59924, 7.29176, -3.52573/ IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF T68=T-T0K * Check of argument range IF((-200.0.LE.T68).AND.(T68.LE.630.0)) THEN RT68=T68/630.0 TEMP=T68+RT68*(CA(1)+RT68*(CA(2)+RT68*(CA(3)+RT68*(CA(4) + +RT68*(CA(5)+RT68*(CA(6)+RT68*(CA(7)+RT68*CA(8)))))))) ELSE IF((1064.0.LE.T68).AND.(T68.LE.3000.0)) THEN TEMP=T68-0.25*(T68+273.15)*(T68+273.15)/1337.33/1337.33 ELSE IF(MESS.NE.0) WRITE(6,6020) T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT T90', & ' WHEN T68 =',1PE14.7,' ****') T90=-1.0E+20 RETURN END IF T90=TEMP+T0K RETURN END REAL FUNCTION T68(T) * Conversion of temperature scal from ITS-90 to IPTS-68 * Range -200C<=T68<=630C anf T68>=1064 T1=T90(T) T2=T ITER=0 DT=T-T1 1000 CONTINUE ITER=ITER+1 IF(ITER.GE.10000) THEN WRITE(6,*) ' ITERATION EXCEEDED MAXIMUM ' T68=-1.0E+10 RETURN END IF T2=T2+DT T1=T90(T2) DT=T-T1 IF(ABS(DT).GE.1.0E-4) GOTO 1000 T68=T2 RETURN END