co2eos.F90       coverage:  9.09 %func     10.68 %block


     1) module co2eos_module
     2) 
     3)   private
     4) 
     5) #include "petsc/finclude/petscsys.h"
     6) 
     7)   public HENRY_co2_noderiv,VISCO2,duanco2,denmix,Henry_duan_sun, &
     8)          Henry_duan_sun_0NaCl,CO2
     9) 
    10) contains
    11) 
    12) ! ************************************************************************** !
    13) 
    14) subroutine CO2(TX,PCX,DC,FC,PHI,HC)
    15)   ! 
    16)   ! VERSION/REVISION HISTORY
    17)   ! $Id: co2eos.F90,v 1.1.1.1 2004/07/30 21:49:42 lichtner Exp $
    18)   ! $Log: co2eos.F90,v $
    19)   ! Revision 1.1.1.1  2004/07/30 21:49:42  lichtner
    20)   ! initial import
    21)   ! Revision 1.2  2004/01/10 18:32:06  lichtner
    22)   ! Began work on 2 phase capability.
    23)   ! Revision 1.1.1.1  2003/11/23 20:12:46  lichtner
    24)   ! initial entry
    25)   ! Revision 1.2  2003/05/09 15:22:41  lichtner
    26)   ! commented out icall statements
    27)   ! Revision 1.1.1.1  2003/03/03 01:33:27  lichtner
    28)   ! PFLOTRAN initial implementation
    29)   ! Revision 1.6  2002/09/28 17:25:49  lichtner
    30)   ! Improved fit of dissolved CO2.
    31)   ! Revision 1.5  2002/05/19 18:53:01  lichtner
    32)   ! Added documentation of CO2 EOS
    33)   ! Revision 1.4  2002/05/19 00:21:46  lichtner
    34)   ! Modified Crovetto (1991) fit to Henry's law to be consistent with
    35)   ! Duan et al. CO2 EOS.
    36)   ! Revision 1.3  2002/05/07 03:14:39  lichtner
    37)   ! Modified Henry's law subroutine to output the Poynting term.
    38)   ! Revision 1.2  2002/05/04 18:28:34  lichtner
    39)   ! Added Duan and Weare CO2 eos and new Henry's law.
    40)   ! Revision 1.1  2002/04/12 19:03:10  lichtner
    41)   ! Initial entry
    42)   ! 
    43)       use PFLOTRAN_Constants_module, only : IDEAL_GAS_CONSTANT    
    44) 
    45)       implicit none
    46)       
    47)       PetscReal :: AT,T,TOL,TX,PCX,DC,DV,FC,PHI,H,HC,XMWC,R,B,V, &
    48)                 Y,Y2,Y3,Z
    49)       
    50)       PetscInt :: KOUNT
    51) !
    52) !     This subroutine calculates the specific density, fugacity, and 
    53) !     specific enthalpy of gaseous and supercritical CO2 as a function of
    54) !     the pressure of CO2 (PCX) and temperature (TX) using a Modified 
    55) !     Redlich-Kwong (MRK) equation of state (EOS) and standard thermo-
    56) !     dynamic equations.  This formulation of the MRK EOS is based on the 
    57) !     work of Kerrick and Jacobs (1981) and Weir et al. (1996). Weir et al.
    58) !     extended the MRK EOS of Kerrick and Jacobs to low temperatures.
    59) !     Accuracy is suspect outside the temperature and pressure ranges of
    60) !     50 < T < 350 deg C and 0.1 < PCX < 45 MPa, respectively.
    61) !
    62) !       Input:
    63) !               TX   = Temperature in degrees C
    64) !               PCX  = Pressure of CO2 in Pa
    65) !
    66) !       Output:
    67) !               DC   = Specific density of CO2 in kg/m3
    68) !               HC   = Specific enthalpy of CO2 in J/kg
    69) !               FC   = Fugacity of CO2 in Pa
    70) !              PHI   = Fugacity coefficient of CO2
    71) !
    72) !       Constants:
    73) !               XMWC = Molecular weight of CO2 in Kg/mol
    74) !               R    = Universal gas constant in m3Pa/molK
    75) !               B    = Covolume in m3/mol (value from K&J)
    76) !
    77) !       Variables:
    78) !               T    = Temperature in K
    79) !               V    = Molar volume of CO2 in m3/mol    
    80) !               Y    = Dimensionless variable (B/4V)
    81) !               Z    = Compressibility factor [-]
    82) !               PHI  = Fugacity coefficient [-] 
    83) !               H    = Molar enthalpy in J/mol
    84) !
    85) 
    86)       PARAMETER(XMWC = 4.40098D-02)
    87)       PARAMETER(R    = IDEAL_GAS_CONSTANT)
    88)       PARAMETER(B    = 5.8D-05)
    89) !      
    90) !
    91)       if (PCX.LE..1D6)THEN
    92)         DC=0.D0
    93)         FC=0.D0
    94)         HC=0.D0
    95)         RETURN
    96)       END IF
    97) !    Convert temperature from degrees C to K:
    98)       T = TX + 2.7315D+02
    99) !
   100) !    First calculate V as a function of T and PCX using Newton Iteration 
   101) !    with tolerance TOL:
   102)       TOL = 1.0D-06
   103) !
   104) !    Initial guess of V, DV, and Y from ideal gas law:
   105)       V = (R*T) / PCX
   106)       DV = V
   107)       Y = B / (4.D0*V)
   108) !
   109) !    Initialize attractive term (AT) of MRK EOS:
   110)       AT  = 0.D0
   111) !
   112) !    Newton Iteration for V as a function of T and PCX:
   113)       KOUNT = 0
   114) !--> use the following as a crude method to set up file incon (revise 
   115) !--> appropriate boundary cells to have correct pressures); uncomment,
   116) !--> run model till it stops, then use the SAVE file:
   117)       DO WHILE(DABS(DV/V).GT.TOL)
   118)         CALL MRK(Y,T,PCX,V,DV,AT)
   119)         V = V - DV
   120)         Y = B / (4.D0*V)
   121)         KOUNT = KOUNT + 1
   122)         if (KOUNT.GT.25000) GO TO 5
   123)       END DO
   124) 
   125) !    Calculate density (DC) in kg/m3 from V in m3/mol:
   126)       DC = XMWC / V
   127) 
   128) !    Calculate Y to the 2nd and 3rd powers for later use:
   129)       Y2 = Y * Y
   130)       Y3 = Y2 * Y
   131)  
   132) !    Calculate compressibility factor (Z) by substituting MRK EOS
   133) !    into Z=PV/RT:
   134)       Z = ((1.D0+Y+Y2-Y3)/((1.D0-Y)**3.D0)) - (AT/(R*T*DSQRT(T)*(V+B)))      
   135) 
   136) !    Initialize fugacity coefficient (PHI):
   137)       PHI = 0.D0
   138) 
   139) !    Calculate fugacity (FC):
   140)       CALL FUGACITY(Y,T,V,Z,PHI)
   141)       FC = PHI * PCX
   142) 
   143) !    Initialize molar enthalpy (H):
   144)       H = 0.D0
   145) 
   146) !    Calculate specific enthalpy (HC):
   147)       CALL ENTHALPY(T,V,Z,H)
   148)       HC = (H/XMWC)+8.1858447D+05
   149)       RETURN
   150) 
   151) !    Come here when no convergence:
   152) 5     CONTINUE
   153)       PRINT 6
   154) 6     FORMAT('NO CONVERGENCE IN SUBROUTINE CO2')
   155)       print*, PCX,T,V,Y,DV
   156)       
   157)       RETURN
   158) end subroutine CO2
   159) 
   160) ! ************************************************************************** !
   161) 
   162) subroutine MRK(Y,T,PCX,V,DV,AT)
   163)       
   164)       use PFLOTRAN_Constants_module, only : IDEAL_GAS_CONSTANT    
   165) 
   166)       implicit none
   167) 
   168) !     MODIFIED REDLICH-KWONG EQUATION OF STATE FOR CO2
   169) !     This subroutine is called from subroutine CO2 during the Newton
   170) !     Iteration for the molar volume (V) of CO2 as function of temperature
   171) !     (T) and pressure of CO2 (PCX).  This subroutine calculates  
   172) !     the V for which the MRK EOS is 0 at the given T and PCX, and the 
   173) !     value of the derivative of the MRK EOS wrt V for the calculated V.
   174) !
   175) !       Input:
   176) !               Y   = Dimensionless variable (B/4V)
   177) !               T   = Temperature in K
   178) !               PCX = Pressure of CO2 in Pa
   179) !               V   = Prev. estimate of molar volume of CO2 in m3/mol   
   180) !
   181) !       Output:
   182) !               DV  = Change in molar volume of CO2 in m3/mol 
   183) !
   184) !       Constants:
   185) !               R   = Universal gas constant in m3Pa/molK
   186) !               B   = Covolume in m3/mol (value from K&J)
   187) !       Ci thru Fi= Coefficients of the MRK EOS (i=1,2,3)   
   188) !                   Values from Weir et al. (1996)
   189) !
   190) !       Variables:
   191) !       CT thru FT= Temperature-dependent functions for evaluating
   192) !                     attractive term of MRK EOS
   193) !               AT  = Attractive term of MRK EOS        
   194) !               FV  = V at which MRK EOS is 0 for T and PCX
   195) !               DV  = -FV / Value of derivative wrt V of MRK EOS
   196) 
   197)       PetscReal :: Y,T,PCX,V,DV,AT
   198)       PetscReal :: R,B,C1,C2,C3,D1,D2,D3,E1,E2,E3,F1,F2,F3
   199)       PetscReal :: T2,V2,V3,V4,Y2,Y3
   200)       PetscReal :: B2,B3,CT,DT,ET,FT,FV
   201) 
   202)       PARAMETER(R   =  IDEAL_GAS_CONSTANT)
   203)       PARAMETER(B   =  5.8D-05)
   204)       PARAMETER(C1  =  2.39534D+01)
   205)       PARAMETER(C2  = -4.55309D-02)
   206)       PARAMETER(C3  =  3.65168D-05)
   207)       PARAMETER(D1  = -4.09844D-03)
   208)       PARAMETER(D2  =  1.23158D-05)
   209)       PARAMETER(D3  = -8.99791D-09)
   210)       PARAMETER(E1  =  2.89224D-07)
   211)       PARAMETER(E2  = -8.02594D-10)
   212)       PARAMETER(E3  =  7.30975D-13)
   213)       PARAMETER(F1  = -6.43556D-12)
   214)       PARAMETER(F2  =  2.01284D-14)
   215)       PARAMETER(F3  = -2.17304D-17)
   216) 
   217) !    Calculate T squared for later use:
   218)       T2 = T * T
   219) !
   220) !    Calculate V to the 2nd, 3rd, and 4th powers for later use:
   221)       V2 = V * V
   222)       V3 = V2 * V
   223)       V4 = V3 * V
   224) !
   225) !    Calculate Y to the 2nd and 3rd powers for later use:
   226)       Y2 = Y * Y
   227)       Y3 = Y2 * Y
   228) !
   229) !    Calculate B to the 2nd and 3rd powers for later use:
   230)       B2 = B * B
   231)       B3 = B2 * B
   232) !
   233) !    Calculate temperature-dependent functions for evaluating attractive
   234) !    term in MRK EOS:
   235)       CT = C1 + (C2*T) + (C3*T2)
   236)       DT = D1 + (D2*T) + (D3*T2)
   237)       ET = E1 + (E2*T) + (E3*T2)
   238)       FT = F1 + (F2*T) + (F3*T2)
   239) !
   240) !    Calculate attractive term in MRK EOS: 
   241)       AT = CT + (DT/V) + (ET/V2) + (FT/V3)
   242) !
   243) !    Calculate V at which MRK EOS equals 0:
   244)       FV = PCX - (((R*T*(1.D0+Y+Y2-Y3))/(V*((1.D0-Y)**3.D0)))- &
   245)            (AT/(DSQRT(T)*V*(V+B))))     
   246) !
   247) !    Calculate -FV / value of derivative wrt V of MRK EOS 
   248)       DV = -FV / (((-3.D0*B*R*T*(1.D0+Y+Y2-Y3))/(4.D0*V3* &
   249)            ((1.D0-Y)**4.D0)))-((R*T*(1.D0+Y+Y2-Y3))/ &
   250)            (V2*((1.D0-Y)**3.D0)))+((R*T*(((3.D0*B3)/(64.D0*V4)) &
   251)            -(B2/(8.D0*V3))-(B/(4.D0*V2))))/(V*((1.D0-Y)**3.D0))) &
   252)            -(AT/(DSQRT(T)*V*(V+B))))
   253)       RETURN
   254) end subroutine MRK
   255) 
   256) ! ************************************************************************** !
   257) 
   258) subroutine FUGACITY(Y,T,V,Z,PHI)
   259)       
   260)       use PFLOTRAN_Constants_module, only : IDEAL_GAS_CONSTANT    
   261) 
   262)       implicit none
   263) 
   264) !
   265) !     This subroutine is called from subroutine CO2 during the       
   266) !     calculation of fugacity of CO2 as function of temperature (T),
   267) !     pressure of CO2 (PCX), and molar volume of CO2 (V).  This
   268) !     subroutine calculates the fugacity coefficient of CO2 (PHI) by   
   269) !     substituting the MRK EOS into RTln(PHI)=Integral from V to infinity
   270) !     of (PCX-RT/V)dV - RTln(Z) + RT(Z-1).  This expression comes from
   271) !     Prausnitz (1969).
   272) !
   273) !       Input:
   274) !               Y   = Dimensionless variable (B/4V)
   275) !               T   = Temperature in K
   276) !               V   = Molar volume of CO2 in m3/mol
   277) !               Z   = Compressibility factor of CO2 [-] 
   278) !
   279) !       Output:
   280) !               PHI = Fugacity coefficient of CO2 [-]
   281) !
   282) !       Constants:
   283) !               R   = Universal gas constant in m3Pa/molK
   284) !               B   = Covolume in m3/mol (value from K&J)
   285) !       Ci thru Fi= Coefficients of the MRK EOS (i=1,2,3)   
   286) !                     Values from Weir et al. (1996)
   287) !
   288) !       Variables:
   289) !       CT thru FT= Temperature-dependent functions for evaluating
   290) !                     attractive term of MRK EOS
   291) !
   292)       PetscReal :: Y,T,V,Z,PHI
   293)       PetscReal :: R,B,C1,C2,C3,D1,D2,D3,E1,E2,E3,F1,F2,F3
   294)       PetscReal :: T2,V2,V3,B2,B3,B4,CT,DT,ET,FT
   295)       
   296)       PARAMETER(R   =  IDEAL_GAS_CONSTANT)
   297)       PARAMETER(B   =  5.8D-05)
   298)       PARAMETER(C1  =  2.39534D+01)
   299)       PARAMETER(C2  = -4.55309D-02)
   300)       PARAMETER(C3  =  3.65168D-05)
   301)       PARAMETER(D1  = -4.09844D-03)
   302)       PARAMETER(D2  =  1.23158D-05)
   303)       PARAMETER(D3  = -8.99791D-09)
   304)       PARAMETER(E1  =  2.89224D-07)
   305)       PARAMETER(E2  = -8.02594D-10)
   306)       PARAMETER(E3  =  7.30975D-13)
   307)       PARAMETER(F1  = -6.43556D-12)
   308)       PARAMETER(F2  =  2.01284D-14)
   309)       PARAMETER(F3  = -2.17304D-17)
   310) 
   311) !
   312) !    Calculate T to the 2nd power for later use:
   313)       T2 = T * T
   314) !
   315) !    Calculate V to the 2nd, 3rd, and 4th powers for later use:
   316)       V2 = V * V
   317)       V3 = V2 * V
   318) !
   319) !    Calculate B to the 2nd, 3rd, and 4th powers for later use:
   320)       B2 = B * B
   321)       B3 = B2 * B
   322)       B4 = B3 * B
   323) !
   324) !    Calculate temperature dependent functions for evaluating attractive
   325) !    term in MRK EOS:
   326)       CT = C1 + (C2*T) + (C3*T2)
   327)       DT = D1 + (D2*T) + (D3*T2)
   328)       ET = E1 + (E2*T) + (E3*T2)
   329)       FT = F1 + (F2*T) + (F3*T2)
   330) !      
   331) !    Calculate fugacity coefficient:
   332)       PHI = Y * (8.D0 + Y * (-9.D0 + 3.D0 * Y))/(1.D0-Y)**3.D0 &
   333)            - DLOG(Z) &
   334)            - CT / (R * T * DSQRT(T) * (V + B)) &
   335)            - DT / (R * T * DSQRT(T) * V * (V + B)) &
   336)            - ET / (R * T * DSQRT(T) * V2 * (V + B)) &
   337)            - FT / (R * T * DSQRT(T) * V3 * (V + B)) &
   338)            + CT * DLOG(V / (V + B))/ (R * T * DSQRT(T) * B) &
   339)            - DT / (R * T * DSQRT(T) * B * V) &
   340)            + DT * DLOG((V + B) / V) / (R * T * DSQRT(T) * B2) &
   341)            - ET / (R * T * DSQRT(T) * 2.D0 * B * V2) &
   342)            + ET / (R * T * DSQRT(T) * B2 * V) &
   343)            - ET * DLOG((V + B) / V) / (R * T * DSQRT(T) * B3) &
   344)            - FT / (R * T * DSQRT(T) * 3.D0 * B * V3) &
   345)            + FT / (R * T * DSQRT(T) * 2.D0 * B2 * V2) &
   346)            - FT / (R * T * DSQRT(T) * B3 * V) &
   347)            - FT * DLOG(V / (V + B)) / (R * T * DSQRT(T) * B4)
   348)       PHI = DEXP(PHI)
   349) 
   350)       RETURN
   351) end subroutine FUGACITY
   352) 
   353) ! ************************************************************************** !
   354) 
   355) subroutine ENTHALPY(T,V,Z,H)
   356) 
   357)       use PFLOTRAN_Constants_module, only : IDEAL_GAS_CONSTANT    
   358) 
   359)       implicit none
   360) !
   361) !     This subroutine is called from subroutine CO2 during the       
   362) !     calculation of the specific enthalpy of CO2 as function of
   363) !     temperature (T), pressure of CO2 (PCX), and molar volume 
   364) !     of CO2 (V).  This subroutine calculates the molar enthalpy of CO2
   365) !     using residual properties.  A residual property is defined as the
   366) !     difference between the real fluid property and the perfect gas   
   367) !     state property.  Following Patel and Eubank (1988) for molar enthalpy:
   368) !     H-H'ref = H(T,rho) - H'(Tref,Pref/RTref), where ' indicates the 
   369) !     perfect gas state.  Integration is done along the path
   370) !     H(T,rho)-->H'(T,0)-->H'(Tref,0)-->H'(Tref,Pref/RTref).
   371) !
   372) !     Determine residual internal energy first: (U-U'ref)/RT = 1/T integral
   373) !     from 0 to rho of dZ/d(1/T) drho/rho + 1/T integral from Tref to T of
   374) !     Cv/R dT, where Cv is molar heat capacity in J/(mol K).  Then determine
   375) !     residual enthalpy: (H-H'ref)/RT = (U-U'ref)/RT + Z - Tref/T.  Using
   376) !     Tref=273.16 K and Pref=1000 Pa, H'ref=0 (from Patel and Eubank).
   377) !
   378) !       Input:
   379) !               T    = Temperature in K
   380) !               V    = Molar volume of CO2 in m3/mol
   381) !               Z    = Compressibility factor of CO2 [-] 
   382) !
   383) !       Output:
   384) !               H    = Molar enthalpy of CO2 in J/mol
   385) !
   386) !       Constants:
   387) !               R    = Universal gas constant in m3Pa/molK
   388) !               B    = Covolume in m3/mol (value from K&J)
   389) !       Ci thru Fi = Coefficients of the MRK EOS (i=1,2,3)   
   390) !                      Values from Weir et al. (1996)
   391) !           Gi   = Coefficients of molar heat capacity
   392) !                  Values from Angus et al. (1976)
   393) !               Tref = Reference temperature in K (value from P&E)
   394) !
   395) !       Variables:
   396) !               RHO  = Molar density of CO2 in mol/m3
   397) !               XI1  = First Integral (see above)
   398) !               XI2  = Second Integral (see above)
   399) !               URES = Residual internal energy
   400) !
   401)       PetscReal :: T,V,Z,H
   402)       PetscReal :: BETA,R,TREF,B,C1,C2,C3,D1,D2,D3,E1,E2,E3,F1,F2,F3, &
   403)                    G0,G1,G2,G3,G4,G5,G6,G7, &
   404)                    RHO,RHO2,BETA2,BETA3,BETA4,BETA5,BETA6,BETA7, &
   405)                    TREF2,TREF3,TREF4,TREF5,TREF6,T2,T3,T4,T5,T6, &
   406)                    B2,B3,B4,XI1,XI2,URES
   407)       
   408)       PARAMETER(BETA=  304.21D0)
   409)       PARAMETER(R   =  IDEAL_GAS_CONSTANT)
   410)       PARAMETER(TREF=  2.7316D+02)
   411)       PARAMETER(B   =  5.8D-05)
   412)       PARAMETER(C1  =  2.39534D+01)
   413)       PARAMETER(C2  = -4.55309D-02)
   414)       PARAMETER(C3  =  3.65168D-05)
   415)       PARAMETER(D1  = -4.09844D-03)
   416)       PARAMETER(D2  =  1.23158D-05)
   417)       PARAMETER(D3  = -8.99791D-09)
   418)       PARAMETER(E1  =  2.89224D-07)
   419)       PARAMETER(E2  = -8.02594D-10)
   420)       PARAMETER(E3  =  7.30975D-13)
   421)       PARAMETER(F1  = -6.43556D-12)
   422)       PARAMETER(F2  =  2.01284D-14)
   423)       PARAMETER(F3  = -2.17304D-17)
   424)       PARAMETER(G0  =  0.769441246D+01)
   425)       PARAMETER(G1  = -0.249610766D+00)
   426)       PARAMETER(G2  = -0.254000397D+02)
   427)       PARAMETER(G3  =  0.651102201D+02)
   428)       PARAMETER(G4  = -0.820863624D+02)
   429)       PARAMETER(G5  =  0.574148450D+02)
   430)       PARAMETER(G6  = -0.212184243D+02)
   431)       PARAMETER(G7  =  0.323362153D+01)
   432) 
   433) !     SAVE ICALL
   434) !     DATA ICALL/0/
   435) !     ICALL=ICALL+1
   436) !     if (ICALL.EQ.1) WRITE(11,899)
   437) ! 899 FORMAT(6X,'ENTHALPY 2.0      29 JUNE      1999',6X,
   438) !    X'CALCULATE MOLAR ENTHALPY OF SEPARATE PHASE CO2')
   439) !
   440) !    Calculate molar density (RHO):
   441)       RHO = 1.D0 / V
   442) !
   443) !    Calculate rho to the 2nd and 3rd powers for later use:
   444)       RHO2 = RHO * RHO
   445) !
   446) !    Calculate beta to the 2nd thru 7th powers for later use:
   447)       BETA2 = BETA * BETA
   448)       BETA3 = BETA2 * BETA
   449)       BETA4 = BETA3 * BETA
   450)       BETA5 = BETA4 * BETA
   451)       BETA6 = BETA5 * BETA
   452)       BETA7 = BETA6 * BETA
   453) !
   454) !    Calculate Tref to the 2nd thru 6th powers for later use:
   455)       TREF2 = TREF * TREF
   456)       TREF3 = TREF2 * TREF
   457)       TREF4 = TREF3 * TREF
   458)       TREF5 = TREF4 * TREF
   459)       TREF6 = TREF5 * TREF
   460) !
   461) !    Calculate T to the 2nd thru 6th powers for later use:
   462)       T2 = T * T
   463)       T3 = T2 * T
   464)       T4 = T3 * T
   465)       T5 = T4 * T
   466)       T6 = T5 * T
   467) !
   468) !    Calculate B to the 2nd, 3rd, and 4th powers for later use:
   469)       B2 = B * B
   470)       B3 = B2 * B
   471)       B4 = B3 * B
   472) !
   473) !    Calculate 1/T times the integral from 0 to rho of dZ/d(1/T) drho/rho:
   474)       XI1 = (B*RHO*(-6.D0*(3.D0*F1+T*(F2-F3*T))-B2*(18.D0*D1 &
   475)             +6.D0*T*(D2-D3*T)+3.D0*(3.D0*E1+T*(E2-E3*T))*RHO &
   476)             +2.D0*(3.D0*F1+T*(F2-F3*T))*RHO2)+3.D0*B*(6.D0*E1 &
   477)             +3.D0*F1*RHO+T*(2.D0*E2-2.D0*E3*T+F2*RHO-F3*T*RHO))) &
   478)             +6.D0*(3.D0*F1+T*(F2-F3*T)+B3*(-3.D0*C1+T*(-C2+C3*T)) &
   479)             +B2*(3.D0*D1+T*(D2-D3*T))+B*(-3.D0*E1+T*(-E2+E3*T))) &
   480)             *DLOG(1+B*RHO))/(12*B4*R*T**1.5)
   481) ! 
   482) !    Calculate 1/T times the integral from Tref to T of Cv/R dT, where Cv
   483) !    is molar heat capacity in J/(mol K).  The expression for Cv is
   484) !    derived an expression from Angus et al. (1976) for molar
   485) !    heat capacity at constant pressure: 
   486)       XI2 = G0-1.D0+((TREF/T)*(1.D0-G0))+(((BETA*G1)/T)*DLOG &
   487)             (T/TREF))+(((BETA2*G2)/T)*((1.D0/TREF)-(1.D0/T))) &
   488)             +(((BETA3*G3)/(2.D0*T))*((1.D0/TREF2)-(1.D0/T2))) &
   489)             +(((BETA4*G4)/(3.D0*T))*((1.D0/TREF3)-(1.D0/T3))) &
   490)             +(((BETA5*G5)/(4.D0*T))*((1.D0/TREF4)-(1.D0/T4))) &
   491)             +(((BETA6*G6)/(5.D0*T))*((1.D0/TREF5)-(1.D0/T5))) &
   492)             +(((BETA7*G7)/(6.D0*T))*((1.D0/TREF6)-(1.D0/T6)))
   493) !
   494) !    Calculate residual internal energy (URES):
   495)       URES = XI1+XI2
   496) !
   497) !    Calculate molar enthalpy (H):
   498)       H = (URES+Z-(TREF/T)) * R * T + 8.1858447D5*.044D0
   499)       RETURN
   500) end subroutine ENTHALPY
   501) 
   502) ! ************************************************************************** !
   503) 
   504) subroutine duanco2 (tt,p,dc,fc,phi)
   505)   ! 
   506)   ! Subroutine: duanco2.f
   507)   ! Input: tt   [C]        temperature
   508)   ! p    [Pa]       CO2 partial pressure
   509)   ! Output: fc   [bars]    CO2 fugacity
   510)   ! phi  [-]       CO2 fugacity coefficient
   511)   ! dc   [g/cm^3]  CO2 density
   512)   ! Duan, Z., Moller, N., and Weare, J.H. (1992) An equation of state for
   513)   ! the CH4-CO2-H2O system: I. Pure systems from 0 to 1000 oC and 0 to
   514)   ! 8000 bar. Geochimica Cosmochimica Acta, 56, 2605-2617.
   515)   ! 
   516) 
   517)       use PFLOTRAN_Constants_module, only : IDEAL_GAS_CONSTANT    
   518) 
   519)       implicit none
   520)       
   521)       PetscReal :: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,alpha,beta,gamma
   522)       PetscReal :: t,tt,tc,pc,tr,tr1,tr2,tr3,pr,p,a,b,c,d,e,rgas,vc
   523)       PetscReal :: epsilon,videal,v,v1,xmwc,vr,vr1,vr2,gamvr,expgam,z,zeq
   524)       PetscReal :: f1,ov,df1,phi,fc,dc
   525)       
   526)       PetscInt :: itmax,iter
   527)       
   528)       data xmwc /4.40098d-02/
   529) 
   530)       data a1    / 8.99288497d-2/
   531)       data a2    /-4.94783127d-1/
   532)       data a3    / 4.77922245d-2/
   533)       data a4    / 1.03808883d-2/
   534)       data a5    /-2.82516861d-2/
   535)       data a6    / 9.49887563d-2/
   536)       data a7    / 5.20600880d-4/
   537)       data a8    /-2.93540971d-4/
   538)       data a9    /-1.77265112d-3/
   539)       data a10   /-2.51101973d-5/
   540)       data a11   / 8.93353441d-5/
   541)       data a12   / 7.88998563d-5/
   542)       data alpha /-1.66727022d-2/
   543)       data beta  / 1.398d0/
   544)       data gamma / 2.96d-2/
   545) 
   546)       t = tt + 273.15d0
   547)       
   548) 
   549)       tc = 31.05d0 + 273.15d0
   550)       pc = 73.825d0
   551) 
   552)       tr = t/tc
   553)       tr1 = 1.d0/tr
   554)       tr2 = tr1*tr1
   555)       tr3 = tr1*tr2
   556)       pr = p /pc
   557)       a = alpha*tr3
   558)       b = a1 + (a2 + a3*tr1)*tr2
   559)       c = a4 + (a5 + a6*tr1)*tr2
   560)       d = a7 + (a8 + a9*tr1)*tr2
   561)       e = a10 + (a11 + a12*tr1)*tr2
   562) 
   563)       rgas = IDEAL_GAS_CONSTANT * 1.d-2 !bar dm**3 / k
   564)       vc = rgas*tc/pc
   565) 
   566) !-----solve
   567) !     f(v) = z[p, t, v] - zeq[t, v] = 0
   568) 
   569) !-----newton-raphson
   570) !     f(x) = 0
   571) !     f'(x1) (x-x1) = -f(x1)
   572) !     x = x1-f/f'
   573) 
   574) !-----tolerance parameters
   575)       epsilon = 1.d-8
   576)       itmax = 150
   577) 
   578) !-----set initial guess from ideal gas law
   579)       videal = rgas*t/p
   580)       v = videal ! ideal gas law
   581) 
   582)       iter = 0
   583)    10 continue
   584)       iter = iter + 1
   585)       if (iter .gt. itmax) goto 20
   586) 
   587)       vr = v/vc
   588)       vr1 = 1.d0/vr
   589)       vr2 = vr1*vr1
   590)       gamvr = gamma*vr2
   591)       expgam = exp(-gamvr)
   592) 
   593)       z = pr*vr/tr
   594) 
   595)       zeq = 1.d0 + (b + (c + (d + e*vr1)*vr2)*vr1)*vr1 + &
   596)             a*vr2*(beta + gamvr)*expgam
   597) 
   598)       f1 = z-zeq
   599) 
   600) !-----check convergence
   601)       if (dabs(f1).lt.epsilon .and. iter.gt.2) goto 30
   602) 
   603)       ov = 1.d0/v
   604)       df1 = pr/vc/tr + (b + (2.d0*c + (4.d0*d + 5.d0*e*vr1)*vr2 &
   605)            + 2.d0*a*((beta + gamvr)*(1.d0-gamvr) + gamvr) &
   606)            * expgam)*vr1)*ov*vr1
   607) 
   608)       v1 = v
   609)       v = v1-f1/df1
   610)       
   611) !     Protect against negative volume solutions
   612)       if (v < 0) v = v1 /2.d0
   613) 
   614) !     write(*,*) 'v,v1,f,df: ',iter,v,v1,f1,df1
   615) 
   616)       goto 10
   617) 
   618)    20 continue
   619) 
   620)       write(*,*) 'duanco2: iter > itmax:  stop', tt,p
   621)       stop
   622) 
   623)    30 continue
   624) 
   625) !-----fugacity coefficient
   626)       phi = exp(z-1.d0-log(z) + (b + (0.5d0*c + (0.25d0*d + &
   627)       0.2d0*e*vr1)*vr2)*vr1)*vr1 + a/(2.d0*gamma)* &
   628)       (beta + 1.d0 - (beta + 1.d0 + gamvr)*expgam))
   629) 
   630) !-----fugacity
   631)       fc = phi * p
   632) 
   633) !-----density
   634)       dc = xmwc / v ! g/cm^3
   635) 
   636)       return
   637) 
   638) end subroutine duanco2
   639) 
   640) ! ************************************************************************** !
   641) 
   642) subroutine Henry_duan_sun_0NaCl (p,tc,henry)
   643) 
   644)   implicit none
   645) 
   646)   PetscReal :: c1,c2,c3,c4,c5,c6,c7,c8,c9,c10
   647)   PetscReal :: p,t,tc,lnt,muco2, henry
   648) 
   649)   c1  = 28.9447706d0
   650)   c2  = -0.0354581768d0
   651)   c3  = -4770.67077d0
   652)   c4  =  1.02782768d-5
   653)   c5  = 33.8126098d0
   654)   c6  =  9.04037140d-3
   655)   c7  = -1.14934031d-3
   656)   c8  = -0.307405726d0
   657)   c9  = -0.0907301486d0
   658)   c10 =  9.32713393d-4
   659) 
   660)   t = tc + 273.15d0
   661)   lnt = log(t)
   662)   muco2 = c1 + c2*t + c3/t + c4*t*t + c5/(630.d0-t) + c6*p + c7*p*lnt &
   663)     + c8*p/t + c9*p/(630.d0-t) + c10*p*p/(630.d0-t)**2
   664) 
   665)   henry = exp(-muco2)
   666) 
   667)   return
   668) end subroutine Henry_duan_sun_0NaCl
   669) 
   670) ! ************************************************************************** !
   671) 
   672) subroutine Henry_duan_sun(tc,p,keqco2,lngamco2,mc,ma,co2_aq_actcoef)
   673)   
   674) ! t[c], p[bar], mco2[mol/Kg-H2O], mc[cation: mol/kg-H2O], 
   675) ! ma[anion: mol/kg-H2O], psat[bars]
   676) 
   677)   implicit none
   678)   PetscReal, save :: coef(3,11)
   679)   PetscReal :: tc,p,keqco2,mc,ma,t
   680)   PetscReal, optional :: co2_aq_actcoef
   681)   PetscReal :: temparray(11)
   682) 
   683)   PetscReal :: lngamco2, tmp, mu0, lamc, lamca
   684) 
   685)   data coef / 28.9447706, -0.411370585, 3.36389723e-4, &
   686)   -0.0354581768,  6.07632013e-4,  -1.98298980e-5, &
   687)   -4770.67077,    97.5347708,     0., &
   688)   1.02782768e-5,  0.,             0., &
   689)   33.8126098,     0.,             0., &
   690)   9.04037140e-3,  0.,             0., &
   691)   -1.14934031e-3, 0.,             0., &
   692)   -0.307405726,  -0.0237622469,   2.12220830e-3, & 
   693)   -0.0907301486,  0.0170656236,  -5.24873303e-3, & 
   694)   9.32713393e-4,  0.,             0., &
   695)   0.,             1.41335834e-5,  0./
   696) 
   697) 
   698)   t=tc+273.15
   699) 
   700)   ! adding temparray to improve efficiency (and remove Intel warning) - geh
   701)   temparray = coef(1,:)
   702)   call duan_sun_param(t,p,temparray,mu0) ! mu0/RT
   703)   temparray = coef(2,:)
   704)   call duan_sun_param(t,p,temparray,lamc) ! lambda_CO2-Na Pitzer 2nd order int. param.
   705)   temparray = coef(3,:)
   706)   call duan_sun_param(t,p,temparray,lamca) ! zeta_CO2-Na-Cl Pitzer 3rd order int. param.
   707)   
   708)   !activity coef. aqueous co2
   709)   lngamco2 = 2.d0*lamc*mc + lamca*mc*ma ! = log(gam(jco2))
   710)   if (present(co2_aq_actcoef)) then
   711)     co2_aq_actcoef = exp(lngamco2)
   712)   endif 
   713)   tmp = mu0 + lngamco2 !- ln(phico2) [ln y P/m = mu0 + ln gamma - ln phico2]
   714)   
   715)   ! yco2 = (p-psat)/p ! mole fraction of CO2 in supercritical CO2 phase: based on
   716)                     ! assumption that mole fraction of H2O in SC CO2 = Psat(T)/P.
   717)   
   718)   ! mco2 = molality co2
   719)   ! mco2 = phico2 * yco2 * p * exp(-mu0) / gamma
   720)   
   721)   keqco2 = exp(-tmp) ! = K_co2 / gamco2
   722)   !print *, 'keqco2: ', mu0,lngamco2,tc,p,ma,mc
   723)   return
   724) end subroutine Henry_duan_sun
   725) 
   726) ! ************************************************************************** !
   727) 
   728) subroutine duan_sun_param(t,p,c,par)
   729)   
   730)   implicit none
   731)   
   732)   PetscReal :: t,p,par,fac,c(11)
   733)   
   734)   fac = 1.d0/(630.d0-t)
   735)   
   736)   par = c(1) + c(2) * t + c(3) / t + c(4) * t * t &
   737)   + c(5) * fac + c(6) * p + c(7) * p * log(t) &
   738)   + c(8) * p / t + c(9) * p * fac &
   739)   + C(10) * p * p * fac * fac + c(11) * t * log(p)
   740) 
   741)   return
   742) end subroutine duan_sun_param
   743) 
   744) ! ************************************************************************** !
   745) 
   746) subroutine HENRY_co2_noderiv(xmole,x1m,tx,pcx,xphi,rkh,poyn)
   747)   ! 
   748)   ! Subroutine: henry.f
   749)   ! Input: tx   [C]       temperature
   750)   ! pco2 [Pa]      CO2 partial pressure
   751)   ! psys [Pa]      total system pressure ***not implemented***
   752)   ! phi  [-]       CO2 fugacity coefficient
   753)   ! Output: xmole [-]     mole fraction CO2 in aqueous phase
   754)   ! x1m   [-]     mass fraction CO2
   755)   ! rkh   [Pa]  Henry constant
   756)   ! poyn  [-]     Poynting factor
   757)   ! Crovetto, R. (1991) Evaluation of solubility data of the system CO2-H2O
   758)   ! from 273�Z K to the critical point of water. Journal of Physical and
   759)   ! Chemical Reference Data, 20(3), 575-589.
   760)   ! 
   761) 
   762) !     input:
   763) !     tx   [C]  temperature
   764) !     pcx  [Pa] CO2 partial pressure
   765) !     xphi [-]  fugacity coef.
   766) 
   767) !     output:
   768) !     rkh   [Pa] Henry's constant
   769) !     poyn  [-]  Poynting correction
   770) !     xmole [-]  mole fraction CO2 in liquid water at t and p
   771) !     x1m   [-]  mass fraction CO2
   772)       
   773)       implicit none
   774)       
   775)       PetscReal, intent(in) :: tx,xphi,pcx
   776)       PetscReal, intent(out) :: xmole,x1m,rkh,poyn
   777)       PetscReal :: ams,ama,tk,otk
   778) 
   779)       ams = 18.01534D-3 !h2o
   780)       ama = 44.0098D-3  !co2
   781) 
   782) !     pcx = pco2! *1.d5 !suspious, pco2 should be in bar as well
   783) 
   784) !     COMMON/GASLAW/R,AMS,AMA,CVNCG
   785) !
   786) !     SAVE ICALL
   787) !     DATA ICALL/0/
   788) !     ICALL=ICALL+1
   789) !     if (ICALL.EQ.1) WRITE(11,899)
   790) ! 899 FORMAT(6X,'HENRY    1.0      25 FEBRUARY  1993',6X,
   791) ! 899 FORMAT(6X,'HENRY    1.1      30 October   1997',6X,
   792) !    X'Henry',1H','s law for dissolved CO2 mass',
   793) !    X' fraction as function of partial pressure'/
   794) !    x47X,'adapted from Battistelli et al. formulation in EWASG')
   795) !
   796) !     T2=TX*TX
   797) !     T3=T2*TX
   798) !     T4=T2*T2
   799) !
   800) !     CO2: CRAMER, 1982.
   801) !        RKH=(783.666E0+19.6025E0*TX+0.820574E0*T2-7.40674E-03*T3+
   802) !    X       2.18380E-05*T4-2.20999E-08*T2*T3)*1.E5
   803) !
   804)       tk = tx + 273.15d0
   805)       otk = 1.d0/tk
   806) 
   807)       if (tx.gt.372.d0) then
   808)         rkH = (-272998.463142d0*otk + 568.443483d0)*otk - &
   809)         0.00625205d0*tk + 1.099025d0*Log(tk)
   810)         write(*,*) "Henry's law out of range: t= ",tx,rkH
   811)       else
   812) 
   813) !-------crovetto form
   814) !       rkH = 2.45621d0 + (948.4254679d0-458199.88483d0*otk)*otk + (1008.599d0*
   815) !    .  (1.d0 - 0.001545294d0*tk)**0.333333333d0)*otk
   816) 
   817) !-------new fit 1 - fixed Vco2 = 35 cm^3/mol
   818) !       rkH = 9.38406d0 - (6192.46 + 132377.d0*otk)*otk + &
   819) !       (5885.39d0*(1.d0 - 0.001545294d0*tk)**0.333333333d0)*otk
   820)         
   821) !       rkH = 9.38406d0 - (6192.46d0 + 132377.d0*otk - &
   822) !       5885.39d0*(1.d0 - 0.001545294d0*tk)**0.333333333d0)*otk
   823) 
   824) 
   825)         rkH = (-272998.463142d0*otk + 568.443483d0)*otk - 0.00625205d0*tk + 1.099025d0*Log(tk)
   826)       endif
   827) 
   828)       rkH = 10.d0**rkH*1.d5/xphi ! units of rkH in [Pa]
   829) 
   830)       xmole = PCX/RKH ! note: pcx in [Pa]
   831) 
   832) !-----Poynting term
   833) !     vid = 3.5d-5
   834) !     rgas = IDEAL_GAS_CONSTANT
   835) !     call sat(tx,ps)
   836)  
   837) !     poyn = exp(-(VID*(PCX-PS))/(Rgas*Tk))
   838)       poyn  = 1.d0
   839)       
   840) !     xmole = xmole * poyn
   841) 
   842)       x1m = xmole*ama/(xmole*ama+(1.d0-xmole)*ams)
   843)       
   844) !     print *,'henry_co2_noderiv: ',pcx,tx,xmole,x1m,xphi,rkh
   845) 
   846)       RETURN
   847) end subroutine HENRY_CO2_NODERIV
   848) 
   849) ! ************************************************************************** !
   850) 
   851) subroutine HENRY_sullivan (TX,PCX,PS,FC,X1M,XCO2,HP)
   852) 
   853)       use PFLOTRAN_Constants_module, only : IDEAL_GAS_CONSTANT    
   854) 
   855)       implicit none
   856) 
   857) !     This subroutine calculates the mass fraction of CO2 in the liquid 
   858) !     phase using an extended Henry's Law relationship from Reid et al.
   859) !     (1987). The relationship is ln(FC/XCO2) = ln(HP) + VID(PCX-PS)/RT. 
   860) !     See below for variable definitions.
   861) !
   862) !     The expression for Henry's Constant is from O'Sullivan et al. (1985).
   863) !     The expression was created using a piece-wise quadratic fit to data
   864) !     published by Ellis and Goulding (1963), Malinin (1959), Takenouchi 
   865) !     and Kennedy (1964), and Gibb and Van Ness (1971). 
   866) !
   867) !     The value for the the partial molar volume of CO2 at infinite 
   868) !     dilution is assumed to be constant at 30E-6 from the work of 
   869) !     Takenouchi and Kennedy (1964) (and others). This assumption is 
   870) !     reasonable at temperatures below 150 C.
   871) !
   872) !       Input:
   873) !               TX   = Temperature in degrees C
   874) !               PCX  = Pressure of CO2 in Pa
   875) !               PS   = Saturation pressure of water in Pa
   876) !               FC   = Fugacity of CO2 in Pa
   877) !
   878) !       Output:
   879) !               X1M  = Mass fraction of CO2 in liquid phase [-]
   880) !                HP  = Henry's contant [Pa] <pcl>
   881) !
   882) !       Constants:
   883) !               XMWC = Molecular weight of CO2 in Kg/mol
   884) !               XMWW = Molecular weight of H2O in Kg/mol
   885) !               R    = Universal gas constant in m3Pa/molK
   886) !               VID  = Partial molar volume of CO2 at infinite
   887) !                      dilution in m3/mol (value from T&K)
   888) !
   889) !       Variables:
   890) !               T    = Temperature in K
   891) !               TAU  = Temperature variable used in calculation
   892) !                      of Henry's Coefficient in degrees C
   893) !               HP   = Henry's Coefficient in bars, then Pa
   894) !               XCO2 = Mole fraction CO2 in liquid phase [-]
   895) 
   896)       PetscReal :: TX,PCX,PS,FC,X1M,XCO2,HP
   897)       PetscReal :: XMWC,XMWW,R,VID,TAU,TAU2,TAU4,T
   898)       
   899)       PARAMETER(XMWC = 4.40098D-02)
   900)       PARAMETER(XMWW = 1.801534D-02)
   901)       PARAMETER(R    = IDEAL_GAS_CONSTANT)
   902)       PARAMETER(VID  = 3.0D-05)
   903) 
   904) !    Calculate TAU:
   905)       TAU = (TX-1.7D+02) / 1.0D+02
   906) 
   907) !    Calculate TAU to the 2nd and 4th powers for later use:
   908)       TAU2 = TAU * TAU
   909)       TAU4 = TAU2 * TAU2
   910) 
   911) !    Calculate Henry's Coefficient (HP) in bars:
   912)       if (TAU.GE.0.D0)THEN
   913)          HP = 6.4D+03 - (2.07778D+03*TAU2) + (3.1111D+02*TAU4)
   914)       ELSEif (TAU.LT.0.D0)THEN
   915)          HP = 6.4D+03 - (2.14914D+03*TAU2) - (1.9543D+02*TAU4)
   916)       ENDIF
   917) 
   918) !    Convert Henry's Coefficient to Pa:
   919)       HP = HP * 1.0D+05
   920) 
   921) !    Convert temperature to K:
   922)       T = TX + 2.7315D+02
   923) 
   924) !    Calculate mole fraction of CO2 (XMOLE):
   925)       XCO2 = DEXP(DLOG(FC/HP)-(VID*(PCX-PS))/(R*T)) 
   926) 
   927) !    Calculate mass fraction of CO2 (XMASS):
   928)       X1M = (XMWC*XCO2) / (((1.D0-XCO2)*XMWW)+(XCO2*XMWC))
   929) 
   930)       RETURN
   931) end subroutine HENRY_sullivan
   932) 
   933) ! ************************************************************************** !
   934) 
   935) subroutine SOLUT(PCX,TX,HSOL)
   936)       implicit none
   937)       
   938)       PetscReal :: PCX,TX,HSOL
   939)       PetscReal :: T,T2,T3,T4
   940) 
   941) !     This subroutine calculates the enthalpy of CO2 dissolution in
   942) !     liquid water. The expression is from O'Sullivan et al. (1985).
   943) !     The expression was created using a quadratic fit to data published
   944) !     by Ellis and Goulding (1963).
   945) 
   946)       T  = 1.D-2 * TX
   947)       T2 = T * T
   948)       T3 = T * T2
   949)       T4 = T * T3
   950)       HSOL = -7.3696D-2 - 5.6405D-1*T + 7.0363D-1*T2 - &
   951)              2.7882D-1*T3 + 4.2579D-2*T4
   952)       HSOL = HSOL * 1.D6
   953)       RETURN
   954) end subroutine SOLUT
   955) 
   956) ! ************************************************************************** !
   957) 
   958) subroutine DENMIX(TX,DW,X1M,D1M)
   959)       implicit none
   960)       
   961)       PetscReal :: TX,DW,X1M,D1M
   962)       PetscReal :: TX2,TX3,TX4,RHO,DC,XMWC,X2M
   963) 
   964) !     This subroutine returns density of CO2-H2O liquid mixture. The
   965) !     expression is from Anderson et al. (1992).
   966) !
   967) !       Input:
   968) !               TX   = Temperature in degrees C
   969) !               DW   = Density of H2O in kg/m3
   970) !               X1M  = Mass fraction of CO2 [-]
   971) !
   972) !       Output:
   973) !               D1M  = Density of CO2-H2O mixture in kg/m3
   974) !
   975) !       Constants:
   976) !               XMWC = Molecular weight of CO2 in kg/mol
   977) !
   978) !       Variables:
   979) !               RHO  = Density of CO2 at saturation pressure in mol/cm3
   980) !               DC   = Density of CO2 at saturation pressure in kg/m3
   981) !               X2M  = Mass fraction H2O [-]
   982) 
   983)       PARAMETER(XMWC=4.40098D-02)
   984) 
   985)       if (X1M.LE.0.D0) THEN
   986)         D1M = DW
   987)         RETURN
   988)       ENDIF
   989) 
   990) !    Calculate TX to the 2nd, 3rd and 4th powers for later use:
   991)       TX2 = TX * TX
   992)       TX3 = TX2 * TX
   993)       TX4 = TX3 * TX
   994) 
   995) !    Calculate density of CO2 (RHO) at saturation pressure in mol/cm3:
   996)       RHO = 1.D0/(3.736D+01 - (7.109D-02*TX) - (3.812D-05*TX2) + &
   997)             (3.296D-06*TX3) - (3.702D-09*TX4))
   998) 
   999) !    Convert RHO to kg/m3 (DC):
  1000)       DC = RHO * 1.0D+06 * XMWC
  1001) 
  1002) !    Calculate mass fraction of H2O:
  1003)       X2M = 1.D0 - X1M
  1004) 
  1005) !    Calculate density of CO2-H2O mixture in kg/m3:
  1006)       D1M = (DW*DC) / (X1M*DW + X2M*DC)
  1007) 
  1008)       RETURN
  1009) end subroutine DENMIX
  1010) 
  1011) ! ************************************************************************** !
  1012) 
  1013) subroutine VISCO2(TX,DC,VC)
  1014)       implicit none
  1015) !
  1016) !     This subroutine calculates the viscosity of pure CO2 as a function 
  1017) !     of temperature and density of CO2.  The expressions for calculating
  1018) !     the viscosity come from empirical equations provided in Vesovic et
  1019) !     al.(1990) and Fenghour et al. (1998).
  1020) !     The critical point enhancement for the viscosity of CO2
  1021) !     has been neglected since it is weak and restricted to a very small
  1022) !     region around the critical point.
  1023) !
  1024) !       Input:
  1025) !               TX     = Temperature in degrees C
  1026) !               DC     = Density of CO2 in kg/m3
  1027) !
  1028) !       Output:
  1029) !               VC     = Viscosity of CO2 in Pa-s       
  1030) !
  1031) !       Constants:
  1032) !               Ai     = Coefficients of the correlation of the
  1033) !                        zero-density viscosity 
  1034) !               ESCL   = Energy scaling parameter in K
  1035) !                      = epsilon/kappa
  1036) !               Dij    = Coefficients of the correlation of the
  1037) !                        excess viscosity 
  1038) !
  1039) !       Variables:
  1040) !               T      = Temperature in K
  1041) !               TSTAR  = (kappa*T)/epsilon = T/ESCL [-]
  1042) !               ETA0   = Zero-density viscosity in muPa-s
  1043) !               DETA   = Excess viscosity in muPa-s
  1044) !
  1045)       PetscReal :: TX,DC,VC
  1046)       PetscReal :: A0,A1,A2,A3,A4,ESCL,D11,D21,D64,D81,D82
  1047)       PetscReal :: T,DC2,DC6,DC8,TSTAR,TSTAR3,BETA1,BETA2,BETA3,BETA4
  1048)       PetscReal :: EXS,ETA0,DETA
  1049)       
  1050)       PARAMETER(A0   =  2.35156D-01)
  1051)       PARAMETER(A1   = -4.91266D-01)
  1052)       PARAMETER(A2   =  5.211155D-02)
  1053)       PARAMETER(A3   =  5.347906D-02)
  1054)       PARAMETER(A4   = -1.537102D-02)
  1055)       PARAMETER(ESCL =  2.51196D+02)
  1056)       PARAMETER(D11  =  0.4071119D-02)
  1057)       PARAMETER(D21  =  0.7198037D-04)
  1058)       PARAMETER(D64  =  0.2411697D-16)
  1059)       PARAMETER(D81  =  0.2971072D-22)
  1060)       PARAMETER(D82  = -0.1627888D-22)
  1061) 
  1062) !    Convert temperature from degrees C to K:
  1063)       T = TX + 2.7315D+02
  1064) 
  1065) !    Calculate DC to 2nd, 6th, and 8th powers:
  1066)       DC2 = DC*DC
  1067)       DC6 = DC2*DC2*DC2
  1068)       DC8 = DC6*DC2
  1069) 
  1070) !    Calculate TSTAR and 3rd power:
  1071)       TSTAR = T/ESCL
  1072)       TSTAR3=TSTAR*TSTAR*TSTAR
  1073) 
  1074) !    Calculate ln(TSTAR) and 2nd, 3rd, and 4th powers:
  1075)       BETA1 = DLOG(TSTAR)
  1076)       BETA2 = BETA1*BETA1
  1077)       BETA3 = BETA2*BETA1
  1078)       BETA4 = BETA3*BETA1
  1079) 
  1080) !    Calculate zero-density limit viscosity in muPa-s:
  1081)       EXS = DEXP(A0+(A1*BETA1)+(A2*BETA2)+(A3*BETA3)+(A4*BETA4))
  1082)       ETA0 = (1.00697D0 * DSQRT(T)) / EXS 
  1083) 
  1084) !    Calculate excess viscosity in muPa-s:
  1085)       DETA = (D11*DC)+(D21*DC2)+((D64*DC6)/TSTAR3)+(D81*DC8)+ &
  1086)              ((D82*DC8)/TSTAR) 
  1087) 
  1088) !    Calculate total viscosity in muPa-s:
  1089)       VC = ETA0 + DETA
  1090) 
  1091) !    Convert viscosity from muPa-s to Pa-s:
  1092)       VC = VC * 1.0D-06
  1093)       RETURN
  1094) end subroutine VISCO2
  1095) 
  1096) ! ************************************************************************** !
  1097) 
  1098) subroutine SAT(T,P)
  1099) !--------- Fast SAT M.J.O'Sullivan - 17 SEPT 1990 ---------
  1100) !
  1101)       use PFLOTRAN_Constants_module, only : H2O_CRITICAL_PRESSURE, &
  1102)                                             H2O_CRITICAL_TEMPERATURE
  1103)       implicit none
  1104) 
  1105)       PetscReal :: T,P,A1,A2,A3,A4,A5,A6,A7,A8,A9
  1106)       PetscReal :: TC,X1,X2,SC,PC_
  1107)       
  1108)       DATA A1,A2,A3,A4,A5,A6,A7,A8,A9/ &
  1109)       -7.691234564,-2.608023696E1,-1.681706546E2,6.423285504E1, &
  1110)       -1.189646225E2,4.167117320,2.097506760E1,1.E9,6./
  1111) 
  1112)       if (T.LT.1..OR.T.GT.500.) GOTO 10
  1113)       TC=(T+273.15d0)/H2O_CRITICAL_TEMPERATURE
  1114)       X1=1.d0-TC
  1115)       X2=X1*X1
  1116)       SC=A5*X1+A4
  1117)       SC=SC*X1+A3
  1118)       SC=SC*X1+A2
  1119)       SC=SC*X1+A1
  1120)       SC=SC*X1
  1121)       PC_=EXP(SC/(TC*(1.d0+A6*X1+A7*X2))-X1/(A8*X2+A9))
  1122)       P=PC_*H2O_CRITICAL_PRESSURE
  1123)       RETURN
  1124)    10 continue
  1125)       WRITE(6,1) ' ',T
  1126)     1 FORMAT(A1,'TEMPERATURE = ',E12.6,'  OUT OF RANGE IN SAT ')
  1127)       RETURN
  1128) end subroutine SAT
  1129) 
  1130) ! ************************************************************************** !
  1131) 
  1132) subroutine COWAT0(TF,PP,D,U)
  1133) !--------- Fast COWAT M.J.O'Sullivan - 17 SEPT 1990 ---------
  1134)       use PFLOTRAN_Constants_module, only : H2O_CRITICAL_PRESSURE, &
  1135)                                             H2O_CRITICAL_TEMPERATURE
  1136) 
  1137)       implicit none
  1138)       
  1139)       PetscReal :: TF,PP,D,U
  1140)       PetscReal :: A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12, &
  1141)                    A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23, &
  1142)                    SA1,SA2,SA3,SA4,SA5,SA6,SA7,SA8,SA9,SA10,SA11,SA12
  1143)       PetscReal :: TKR,TKR2,TKR3,TKR4,TKR5,TKR6,TKR7,TKR8,TKR9,TKR10,TKR11, &
  1144)         TKR18,TKR19,TKR20,PNMR,PNMR2,PNMR3,PNMR4,Y,YD,Z,ZP,V,VMKR, &
  1145)         CC1,CC2,CC4,CC8,CC10,CZ,SNUM,PRT1,PRT2,PRT3,PRT4,PRT5, &
  1146)         AA1,BB1,BB2,EE1,EE3,H,DD1,DD2,DD4,ENTR,PAR1,PAR2,PAR3,PAR4,PAR5
  1147) 
  1148)       DATA A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12 / &
  1149)       6.824687741E3,-5.422063673E2,-2.096666205E4,3.941286787E4, &
  1150)       -13.466555478E4,29.707143084E4,-4.375647096E5,42.954208335E4, &
  1151)       -27.067012452E4,9.926972482E4,-16.138168904E3,7.982692717E0/
  1152)       DATA A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23 / &
  1153)       -2.616571843E-2,1.522411790E-3,2.284279054E-2,2.421647003E2, &
  1154)       1.269716088E-10,2.074838328E-7,2.174020350E-8,1.105710498E-9, &
  1155)       1.293441934E1,1.308119072E-5,6.047626338E-14/
  1156)       DATA SA1,SA2,SA3,SA4,SA5,SA6,SA7,SA8,SA9,SA10,SA11,SA12 / &
  1157)       8.438375405E-1,5.362162162E-4,1.720000000E0,7.342278489E-2, &
  1158)       4.975858870E-2,6.537154300E-1,1.150E-6,1.51080E-5, &
  1159)       1.41880E-1,7.002753165E0,2.995284926E-4,2.040E-1   /
  1160) 
  1161)       TKR=(TF+273.15)/H2O_CRITICAL_TEMPERATURE
  1162)       TKR2=TKR*TKR
  1163)       TKR3=TKR*TKR2
  1164)       TKR4=TKR2*TKR2
  1165)       TKR5=TKR2*TKR3
  1166)       TKR6=TKR4*TKR2
  1167)       TKR7=TKR4*TKR3
  1168)       TKR8=TKR4*TKR4
  1169)       TKR9=TKR4*TKR5
  1170)       TKR10=TKR4*TKR6
  1171)       TKR11=TKR*TKR10
  1172)       TKR19=TKR8*TKR11
  1173)       TKR18=TKR8*TKR10
  1174)       TKR20=TKR10*TKR10
  1175)       PNMR=PP/H2O_CRITICAL_PRESSURE
  1176)       PNMR2=PNMR*PNMR
  1177)       PNMR3=PNMR*PNMR2
  1178)       PNMR4=PNMR*PNMR3
  1179)       Y=1.d0-SA1*TKR2-SA2/TKR6
  1180)       ZP=SA3*Y*Y-2.*SA4*TKR+2.*SA5*PNMR
  1181)       if (ZP.LT.0.) GOTO 1
  1182) !     19 September 1990.  double on VAX, single on CRAY
  1183) !      Z=Y+ DSQRT(ZP)
  1184)       Z=Y+SQRT(ZP)
  1185)       CZ=Z**(5./17.)
  1186)       PAR1=A12*SA5/CZ
  1187)       CC1=SA6-TKR
  1188)       CC2=CC1*CC1
  1189)       CC4=CC2*CC2
  1190)       CC8=CC4*CC4
  1191)       CC10=CC2*CC8
  1192)       AA1=SA7+TKR19
  1193)       PAR2=A13+A14*TKR+A15*TKR2+A16*CC10+A17/AA1
  1194)       PAR3=(A18+2.*A19*PNMR+3.*A20*PNMR2)/(SA8+TKR11)
  1195)       DD1=SA10+PNMR
  1196)       DD2=DD1*DD1
  1197)       DD4=DD2*DD2
  1198)       PAR4=A21*TKR18*(SA9+TKR2)*(-3./DD4+SA11)
  1199)       PAR5=3.*A22*(SA12-TKR)*PNMR2+4.*A23/TKR20*PNMR3
  1200)       VMKR=PAR1+PAR2-PAR3-PAR4+PAR5
  1201)       V=VMKR*3.17E-3
  1202)       D=1.d0/V
  1203)       YD=-2.d0*SA1*TKR+6.*SA2/TKR7
  1204)       SNUM= A10+A11*TKR
  1205)       SNUM=SNUM*TKR + A9
  1206)       SNUM=SNUM*TKR + A8
  1207)       SNUM=SNUM*TKR + A7
  1208)       SNUM=SNUM*TKR + A6
  1209)       SNUM=SNUM*TKR + A5
  1210)       SNUM=SNUM*TKR + A4
  1211)       SNUM=SNUM*TKR2 - A2
  1212)       PRT1=A12*(Z*(17.*(Z/29.-Y/12.)+5.*TKR*YD/12.)+SA4*TKR- &
  1213)       (SA3-1.)*TKR*Y*YD)/CZ
  1214)       PRT2=PNMR*(A13-A15*TKR2+A16*(9.*TKR+SA6)*CC8*CC1 &
  1215)       +A17*(19.*TKR19+AA1)/(AA1*AA1))
  1216)       BB1=SA8+TKR11
  1217)       BB2=BB1*BB1
  1218)       PRT3=(11.*TKR11+BB1)/BB2*(A18*PNMR+A19* &
  1219)       PNMR2+A20*PNMR3)
  1220)       EE1=SA10+PNMR
  1221)       EE3=EE1*EE1*EE1
  1222)       PRT4=A21*TKR18*(17.*SA9+19.*TKR2)*(1./EE3+SA11*PNMR)
  1223)       PRT5=A22*SA12*PNMR3+21.*A23/TKR20*PNMR4
  1224)       ENTR= A1*TKR - SNUM +PRT1+PRT2-PRT3+PRT4+PRT5
  1225)       H=ENTR*70120.4
  1226)       U=H-PP*V
  1227)       RETURN
  1228)     1 continue
  1229)       WRITE(6,2)TF
  1230)       WRITE(7,2)TF
  1231)     2 FORMAT(' TEMPERATURE = ',E12.6,'  OUT OF RANGE IN COWAT')
  1232) !  100 FORMAT(1H ,5X,A6,2X,E20.10)
  1233) !  102 FORMAT(1H ,5X,A6,5X,I2,2X,E20.10)
  1234)       RETURN
  1235) end subroutine COWAT0
  1236) 
  1237) ! ************************************************************************** !
  1238) 
  1239) subroutine SUPST(T,P,D,U)
  1240) !--------- Fast SUPST M.J.O'Sullivan - 17 SEPT 1990 ---------
  1241) ! SUPST    1.0 S     1 February  1991
  1242) ! VAPOR DENSITY AND INTERNAL ENERGY AS FUNCTION OF TEMPERATURE AND 
  1243) ! PRESSURE (M. OS.)
  1244)       use PFLOTRAN_Constants_module, only : H2O_CRITICAL_PRESSURE, &
  1245)                                             H2O_CRITICAL_TEMPERATURE
  1246)       
  1247)       implicit none
  1248)       
  1249)       PetscReal :: T,P,D,U
  1250)       PetscReal :: I1
  1251)       PetscReal :: B0,B01,B02,B03,B04,B05,B11,B12,B21,B22,B23,B31,B32,B41,B42, &
  1252)                    B51,B52,B53,B61,B62,B71,B72,B81,B82, &
  1253)                    B90,B91,B92,B93,B94,B95,B96,SB,SB61,SB71,SB81,SB82
  1254)       PetscReal :: THETA,THETA2,THETA3,THETA4
  1255)       PetscReal :: BETA,BETA2,BETA3,BETA4,BETA5,BETA6,BETA7,BETAL,DBETAL
  1256)       PetscReal :: X,X2,X3,X4,X5,X6,X8,X10,X11,X14,X18,X19,X24,X27
  1257)       PetscReal :: R,R2,R4,R6,R10,SD1,SD2,SD3,SC,SN,CHI1,CHI2,V
  1258)       PetscReal :: SN6,SN7,SN8,OS1,OS2,OS5,OS6,OS7,EPS2,H
  1259) 
  1260)       DATA B0,B01,B02,B03,B04,B05/ &
  1261)       16.83599274,28.56067796,-54.38923329,0.4330662834,-0.6547711697, &
  1262)       8.565182058E-2/
  1263)       DATA B11,B12,B21,B22,B23,B31,B32,B41,B42/ &
  1264)       6.670375918E-2,1.388983801,8.390104328E-2,2.614670893E-2, &
  1265)       -3.373439453E-2,4.520918904E-1,1.069036614E-1,-5.975336707E-1, &
  1266)       -8.847535804E-2/
  1267)       DATA B51,B52,B53,B61,B62,B71,B72,B81,B82/ &
  1268)       5.958051609E-1,-5.159303373E-1,2.075021122E-1,1.190610271E-1, &
  1269)       -9.867174132E-2,1.683998803E-1,-5.809438001E-2,6.552390126E-3, &
  1270)       5.710218649E-4/
  1271)       DATA B90,B91,B92,B93,B94,B95,B96/ &
  1272)       1.936587558E2,-1.388522425E3,4.126607219E3,-6.508211677E3, &
  1273)       5.745984054E3,-2.693088365E3,5.235718623E2/
  1274)       DATA SB,SB61,SB71,SB81,SB82/ &
  1275)       7.633333333E-1,4.006073948E-1,8.636081627E-2,-8.532322921E-1, &
  1276)       3.460208861E-1/
  1277) 
  1278)       THETA=(T+273.15)/H2O_CRITICAL_TEMPERATURE
  1279)       BETA=P/H2O_CRITICAL_PRESSURE
  1280)       I1=4.260321148
  1281)       X=EXP(SB*(1.d0-THETA))
  1282) 
  1283)       X2=X*X
  1284)       X3=X2*X
  1285)       X4=X3*X
  1286)       X5=X4*X
  1287)       X6=X5*X
  1288)       X8=X6*X2
  1289)       X10=X6*X4
  1290)       X11=X10*X
  1291)       X14=X10*X4
  1292)       X18=X14*X4
  1293)       X19=X18*X
  1294)       X24=X18*X6
  1295)       X27=X24*X3
  1296) 
  1297)       THETA2=THETA*THETA
  1298)       THETA3=THETA2*THETA
  1299)       THETA4=THETA3*THETA
  1300) 
  1301)       BETA2=BETA*BETA
  1302)       BETA3=BETA2*BETA
  1303)       BETA4=BETA3*BETA
  1304)       BETA5=BETA4*BETA
  1305)       BETA6=BETA5*BETA
  1306)       BETA7=BETA6*BETA
  1307) 
  1308)       BETAL=15.74373327-34.17061978*THETA+19.31380707*THETA2
  1309)       DBETAL=-34.17061978+38.62761414*THETA
  1310)       R=BETA/BETAL
  1311)       R2=R*R
  1312)       R4=R2*R2
  1313)       R6=R4*R2
  1314)       R10=R6*R4
  1315) 
  1316)       CHI2=I1*THETA/BETA
  1317)       SC=(B11*X10+B12)*X3
  1318)       CHI2=CHI2-SC
  1319)       SC=B21*X18+B22*X2+B23*X
  1320)       CHI2=CHI2-2*BETA*SC
  1321)       SC=(B31*X8+B32)*X10
  1322)       CHI2=CHI2-3*BETA2*SC
  1323)       SC=(B41*X11+B42)*X14
  1324)       CHI2=CHI2-4*BETA3*SC
  1325)       SC=(B51*X8+B52*X4+B53)*X24
  1326)       CHI2=CHI2-5*BETA4*SC
  1327) 
  1328)       SD1=1./BETA4+SB61*X14
  1329)       SD2=1./BETA5+SB71*X19
  1330)       SD3=1./BETA6+(SB81*X27+SB82)*X27
  1331) 
  1332)       SN=(B61*X+B62)*X11
  1333) !over CHI2=CHI2-SN/SD12*4/BETA5
  1334)       chi2=chi2-(sn/sd1*4/beta5)/sd1
  1335)       SN=(B71*X6+B72)*X18
  1336) !over CHI2=CHI2-SN/SD22*5/BETA6
  1337)       chi2=chi2-(sn/sd2*5/beta6)/sd2
  1338)       SN=(B81*X10+B82)*X14
  1339) !over CHI2=CHI2-SN/SD32*6/BETA7
  1340)       chi2=chi2-(sn/sd3*6/beta7)/sd3
  1341)       SC=B96
  1342)       SC=SC*X+B95
  1343)       SC=SC*X+B94
  1344)       SC=SC*X+B93
  1345)       SC=SC*X+B92
  1346)       SC=SC*X+B91
  1347)       SC=SC*X+B90
  1348)       CHI2=CHI2+11.*R10*SC
  1349)       V=CHI2*0.00317
  1350)       D=1./V
  1351) 
  1352)       OS1=SB*THETA
  1353)       EPS2=0.0+B0*THETA-(-B01+B03*THETA2+2*B04*THETA3+3*B05*THETA4)
  1354)       SC=(B11*(1.+13.*OS1)*X10+B12*(1.+3.*OS1))*X3
  1355)       EPS2=EPS2-BETA*SC
  1356)       SC=B21*(1.+18.*OS1)*X18+B22*(1.+2.*OS1)*X2+B23*(1.+OS1)*X
  1357)       EPS2=EPS2-BETA2*SC
  1358)       SC=(B31*(1.+18.*OS1)*X8+B32*(1.+10.*OS1))*X10
  1359)       EPS2=EPS2-BETA3*SC
  1360)       SC=(B41*(1.+25.*OS1)*X11+B42*(1.+14.*OS1))*X14
  1361)       EPS2=EPS2-BETA4*SC
  1362)       SC=(B51*(1.+32.*OS1)*X8+B52*(1.+28.*OS1)*X4+ &
  1363)        B53*(1.+24.*OS1))*X24
  1364)       EPS2=EPS2-BETA5*SC
  1365) 
  1366)       SN6=14.*SB61*X14
  1367)       SN7=19.*SB71*X19
  1368)       SN8=(54.*SB81*X27+27.*SB82)*X27
  1369)       OS5= 1+11.*OS1-OS1*SN6/SD1
  1370)       SC=(B61*X*(OS1+OS5)+B62*OS5)*(X11/SD1)
  1371)       EPS2=EPS2-SC
  1372)       OS6= 1.+24.*OS1-OS1*SN7/SD2
  1373)       SC=(B71*X6*OS6+B72*(OS6-6.*OS1))*(X18/SD2)
  1374)       EPS2=EPS2-SC
  1375)       OS7= 1.+24.*OS1-OS1*SN8/SD3
  1376)       SC=(B81*X10*OS7+B82*(OS7-10.* OS1))*(X14/SD3)
  1377)       EPS2=EPS2-SC
  1378)       OS2=1+THETA*10.0*DBETAL/BETAL
  1379)       SC= (OS2+6*OS1)*B96
  1380)       SC=SC*X + (OS2+5*OS1)*B95
  1381)       SC=SC*X + (OS2+4*OS1)*B94
  1382)       SC=SC*X + (OS2+3*OS1)*B93
  1383)       SC=SC*X + (OS2+2*OS1)*B92
  1384)       SC=SC*X + (OS2+OS1)*B91
  1385)       SC=SC*X + OS2*B90
  1386)       EPS2=EPS2+BETA*R10*SC
  1387)       H=EPS2*70120.4
  1388)       U=H-P*V
  1389)       RETURN
  1390) end subroutine SUPST
  1391) 
  1392) ! ************************************************************************** !
  1393) 
  1394) subroutine TSAT(PX,TX00,TS)
  1395)       implicit none
  1396)       
  1397) !     SATURATION TEMPERATURE TS AT PRESSURE PX.
  1398) 
  1399)       PetscReal :: PX,TX00,TX0,TS,PS,DT,TSD,PSD
  1400)       
  1401)       TX0=TX00
  1402)       if (TX0.NE.0.) GOTO 2
  1403) !
  1404) !-----COME HERE TO OBTAIN ROUGH STARTING VALUE FOR ITERATION.
  1405)       TX0=4606./(24.02-LOG(PX)) - 273.15
  1406)       TX0=MAX(TX0,5.d0)
  1407) 
  1408)     2 CONTINUE
  1409)       TS=TX0
  1410)       DT=TS*1.E-8
  1411)       TSD=TS+DT
  1412) 
  1413)     1 CONTINUE
  1414) 
  1415)       CALL SAT(TS,PS)
  1416) 
  1417)       if (ABS((PX-PS)/PX).LE.1.E-10) RETURN
  1418) 
  1419)       TSD=TS+DT
  1420)       CALL SAT(TSD,PSD)
  1421)       TS=TS+(PX-PS)*DT/(PSD-PS)
  1422) 
  1423)       goto 1
  1424)       
  1425) end subroutine TSAT
  1426) 
  1427) ! ************************************************************************** !
  1428) 
  1429) subroutine SIGMA(T,ST)
  1430)       use PFLOTRAN_Constants_module, only : H2O_CRITICAL_TEMPERATURE
  1431)       implicit none
  1432) !
  1433) !-----COMPUTE SURFACE TENSION OF WATER, USING THE
  1434) !     "INTERNATIONAL REPRESENTATION OF THE SURFACE TENSION OF
  1435) !                                               WATER SUBSTANCE" (1975).
  1436) 
  1437)       PetscReal :: T,ST
  1438)       
  1439)       if (T.GE.374.15) GOTO 1
  1440)       ST=1.-0.625*(374.15-T)/H2O_CRITICAL_TEMPERATURE
  1441)       ST=ST*.2358*((374.15-T)/H2O_CRITICAL_TEMPERATURE)**1.256
  1442)       RETURN
  1443) 
  1444)     1 CONTINUE
  1445)       ST=0.
  1446)       RETURN
  1447) end subroutine SIGMA
  1448) 
  1449) ! ************************************************************************** !
  1450) 
  1451) subroutine VIS(T,P,D,VW,VS,PS)
  1452)       implicit none
  1453)       
  1454) !     VISCOSITY OF LIQUID WATER AND VAPOR AS FUNCTION OF
  1455) !     TEMPERATURE AND PRESSURE
  1456) 
  1457)       PetscReal :: T,P,D,VW,VS,PS
  1458)       PetscReal :: EX,PHI,AM,V1
  1459)       
  1460)       EX=247.8/(T+133.15)
  1461)       PHI=1.0467*(T-31.85)
  1462)       AM=1.+PHI*(P-PS)*1.E-11
  1463)       VW=1.E-7*AM*241.4*10.**EX
  1464) 
  1465)       V1=.407*T+80.4
  1466)       if (T.LE.350.) VS=1.E-7*(V1-D*(1858.-5.9*T)*1.E-3)
  1467)       if (T.GT.350.) VS=1.E-7*(V1+.353*D+676.5E-6*D**2+102.1E-9*D**3)
  1468)       RETURN
  1469) end subroutine VIS
  1470) 
  1471) ! ************************************************************************** !
  1472) 
  1473) subroutine VISW0(T,P,PS,VW)
  1474)       implicit none
  1475) 
  1476) !     VISCOSITY OF LIQUID WATER AS FUNCTION OF
  1477) !     TEMPERATURE AND PRESSURE
  1478) 
  1479)       PetscReal :: T,P,PS,VW
  1480)       PetscReal :: EX,PHI,AM
  1481) 
  1482)       EX=247.8/(T+133.15)
  1483)       PHI=1.0467*(T-31.85)
  1484)       AM=1.+PHI*(P-PS)*1.E-11
  1485)       VW=1.E-7*AM*241.4*10.**EX
  1486) 
  1487)       RETURN
  1488) end subroutine VISW0
  1489) 
  1490) ! ************************************************************************** !
  1491) 
  1492) subroutine VISS(T,P,D,VS)
  1493)       implicit none
  1494) 
  1495) !     VISCOSITY OF VAPOR AS FUNCTION OF
  1496) !     TEMPERATURE AND PRESSURE
  1497) 
  1498)       PetscReal :: T,P,D,VS,V1
  1499)       
  1500)       V1=.407*T+80.4
  1501)       if (T.LE.350.) VS=1.E-7*(V1-D*(1858.-5.9*T)*1.E-3)
  1502)       if (T.GT.350.) VS=1.E-7*(V1+.353*D+676.5E-6*D**2+102.1E-9*D**3)
  1503) 
  1504)       RETURN
  1505) end subroutine VISS
  1506) 
  1507) ! ************************************************************************** !
  1508) 
  1509) subroutine THERC(T,P,D,CONW,CONS,PS)
  1510)       implicit none
  1511) 
  1512) !     THERMAL CONDUCTIVITY OF WATER AND VAPOR AS FUNCTION OF
  1513) !     TEMPERATURE AND PRESSURE
  1514) 
  1515)       PetscReal :: T,P,D,CONW,CONS,PS
  1516)       PetscReal :: A0,A1,A2,A3,A4,B0,B1,B2,B3,C0,C1,C2,C3,T0,T1,T2,T3,T4
  1517)       PetscReal :: CON1,CON2,CON3,CONS1
  1518) 
  1519)       DATA A0,A1,A2,A3,A4/-922.47,2839.5,-1800.7,525.77,-73.440/
  1520)       DATA B0,B1,B2,B3/-.94730,2.5186,-2.0012,.51536/
  1521)       DATA C0,C1,C2,C3/1.6563E-3,-3.8929E-3,2.9323E-3,-7.1693E-4/
  1522)       DATA T0/273.15/
  1523) 
  1524)       T1=(T+273.15)/T0
  1525)       T2=T1*T1
  1526)       T3=T2*T1
  1527)       T4=T3*T1
  1528) 
  1529) !     if (P-PS.LT.0.) GOTO1
  1530)       CON1=A0+A1*T1+A2*T2+A3*T3+A4*T4
  1531)       CON2=(P-PS)*(B0+B1*T1+B2*T2+B3*T3)*1.E-5
  1532)       CON3=(P-PS)*(P-PS)*(C0+C1*T1+C2*T2+C3*T3)*1.E-10
  1533)       CONW=(CON1+CON2+CON3)*1.E-3
  1534)       CON1=17.6+5.87E-2*T
  1535)       CON2=1.04E-4*T*T
  1536)       CON3=4.51E-8*T**3
  1537)       CONS1=1.E-3*(CON1+CON2-CON3)
  1538)       CONS=CONS1+1.E-6*(103.51+.4198*T-2.771E-5*T*T)*D &
  1539)       +1.E-9*D*D*2.1482E14/T**4.2
  1540) 
  1541) !     PRINT 10,T,P,PS,CON
  1542) !   10 FORMAT(5H T = ,E12.6,5H P = ,E12.6,6H PS = ,E12.6,7H CON = ,E12.6)
  1543) 
  1544)       RETURN
  1545) !    1 CONTINUE
  1546) !     PRINT 2,T,P,PS
  1547) !    2 FORMAT(8H AT T = ,E12.6,5H P = ,E12.6,19H IS LESS THAN PS = ,E12.6)
  1548)       RETURN
  1549) end subroutine THERC
  1550) end module co2eos_module

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody