th_aux.F90       coverage:  85.71 %func     84.21 %block


     1) module TH_Aux_module
     2) 
     3)   use PFLOTRAN_Constants_module
     4) 
     5)   implicit none
     6)   
     7)   private 
     8) 
     9) #include "petsc/finclude/petscsys.h"
    10) 
    11)   PetscReal, public :: th_itol_scaled_res = 1.d-5
    12)   PetscReal, public :: th_itol_rel_update = UNINITIALIZED_DOUBLE
    13) 
    14)   type, public :: TH_auxvar_type
    15)     PetscReal :: avgmw
    16)     PetscReal :: h
    17)     PetscReal :: u
    18)     PetscReal :: pc
    19)     PetscReal :: vis
    20) !    PetscReal :: dvis_dp
    21) !    PetscReal :: kr
    22) !    PetscReal :: dkr_dp
    23)     PetscReal :: kvr
    24)     PetscReal :: dsat_dp
    25)     PetscReal :: dsat_dt
    26)     PetscReal :: dden_dp
    27)     PetscReal :: dden_dt
    28)     PetscReal :: dkvr_dp
    29)     PetscReal :: dkvr_dt
    30)     PetscReal :: dh_dp
    31)     PetscReal :: dh_dt
    32)     PetscReal :: du_dp
    33)     PetscReal :: du_dt
    34)     PetscReal :: transient_por
    35)     PetscReal :: Dk_eff
    36)     PetscReal :: Ke
    37)     PetscReal :: dKe_dp
    38)     PetscReal :: dKe_dt
    39)     ! for ice
    40)     type(th_ice_type), pointer :: ice
    41)     ! For surface-flow
    42)     type(th_surface_flow_type), pointer :: surface
    43)   end type TH_auxvar_type
    44) 
    45)   type, public :: th_ice_type
    46)     PetscReal :: Ke_fr
    47)     PetscReal :: dKe_fr_dp
    48)     PetscReal :: dKe_fr_dt
    49)     ! ice
    50)     PetscReal :: sat_ice
    51)     PetscReal :: sat_gas
    52)     PetscReal :: dsat_ice_dp
    53)     PetscReal :: dsat_gas_dp
    54)     PetscReal :: dsat_ice_dt
    55)     PetscReal :: dsat_gas_dt
    56)     PetscReal :: den_ice
    57)     PetscReal :: dden_ice_dp
    58)     PetscReal :: dden_ice_dt
    59)     PetscReal :: u_ice
    60)     PetscReal :: du_ice_dt
    61)     PetscReal :: den_gas
    62)     PetscReal :: dden_gas_dt
    63)     PetscReal :: u_gas
    64)     PetscReal :: du_gas_dt
    65)     PetscReal :: mol_gas
    66)     PetscReal :: dmol_gas_dt
    67)     ! For DallAmico model
    68)     PetscReal :: pres_fh2o
    69)     PetscReal :: dpres_fh2o_dp
    70)     PetscReal :: dpres_fh2o_dt
    71)   end type th_ice_type
    72)   
    73)   type, public :: th_surface_flow_type
    74)     PetscBool :: surf_wat
    75)     PetscReal :: P_min
    76)     PetscReal :: P_max
    77)     PetscReal :: coeff_for_cubic_approx(4)
    78)     PetscReal :: coeff_for_deriv_cubic_approx(4)
    79)     PetscReal :: range_for_linear_approx(4)
    80)     PetscReal :: dlinear_slope_dT
    81)     PetscBool :: bcflux_default_scheme
    82)   end type th_surface_flow_type
    83) 
    84)   type, public :: TH_parameter_type
    85)     PetscReal, pointer :: dencpr(:)
    86)     PetscReal, pointer :: ckdry(:) ! Thermal conductivity (dry)
    87)     PetscReal, pointer :: ckwet(:) ! Thermal conductivity (wet)
    88)     PetscReal, pointer :: alpha(:)
    89)     PetscReal, pointer :: ckfrozen(:) ! Thermal conductivity (frozen soil)
    90)     PetscReal, pointer :: alpha_fr(:) ! exponent frozen
    91)     PetscReal, pointer :: sir(:,:)
    92)     PetscReal, pointer :: diffusion_coefficient(:)
    93)     PetscReal, pointer :: diffusion_activation_energy(:)
    94)   end type TH_parameter_type
    95)   
    96)   type, public :: TH_type
    97)     PetscInt :: n_zero_rows
    98)     PetscInt, pointer :: zero_rows_local(:), zero_rows_local_ghosted(:)
    99)     PetscBool :: auxvars_up_to_date
   100)     PetscBool :: inactive_cells_exist
   101)     PetscInt :: num_aux, num_aux_bc, num_aux_ss
   102)     type(TH_parameter_type), pointer :: TH_parameter
   103)     type(TH_auxvar_type), pointer :: auxvars(:)
   104)     type(TH_auxvar_type), pointer :: auxvars_bc(:)
   105)     type(TH_auxvar_type), pointer :: auxvars_ss(:)
   106)   end type TH_type
   107) 
   108)   PetscReal, parameter :: epsilon = 1.d-6
   109) 
   110)   public :: THAuxCreate, THAuxDestroy, &
   111)             THAuxVarComputeNoFreezing, THAuxVarInit, &
   112)             THAuxVarCopy, THAuxVarDestroy
   113) 
   114)   public :: THAuxVarComputeFreezing
   115) 
   116) contains
   117) 
   118) ! ************************************************************************** !
   119) 
   120) function THAuxCreate(option)
   121)   ! 
   122)   ! Allocate and initialize auxiliary object
   123)   ! 
   124)   ! Author: ???
   125)   ! Date: 02/14/08
   126)   ! 
   127) 
   128)   use Option_module
   129) 
   130)   implicit none
   131)   
   132)   type(option_type) :: option
   133)   type(TH_type), pointer :: THAuxCreate
   134)   
   135)   type(TH_type), pointer :: aux
   136) 
   137)   allocate(aux) 
   138)   aux%auxvars_up_to_date = PETSC_FALSE
   139)   aux%inactive_cells_exist = PETSC_FALSE
   140)   aux%num_aux = 0
   141)   aux%num_aux_bc = 0
   142)   aux%num_aux_ss = 0
   143)   nullify(aux%auxvars)
   144)   nullify(aux%auxvars_bc)
   145)   nullify(aux%auxvars_ss)
   146)   aux%n_zero_rows = 0
   147) 
   148)   allocate(aux%TH_parameter)
   149)   nullify(aux%TH_parameter%dencpr)
   150)   nullify(aux%TH_parameter%ckdry)
   151)   nullify(aux%TH_parameter%ckwet)
   152)   nullify(aux%TH_parameter%alpha)
   153)   nullify(aux%TH_parameter%ckfrozen)
   154)   nullify(aux%TH_parameter%alpha_fr)
   155)   nullify(aux%TH_parameter%sir)
   156)   nullify(aux%TH_parameter%diffusion_coefficient)
   157)   nullify(aux%TH_parameter%diffusion_activation_energy)
   158)   
   159)   nullify(aux%zero_rows_local)
   160)   nullify(aux%zero_rows_local_ghosted)
   161) 
   162)   allocate(aux%TH_parameter%diffusion_coefficient(option%nphase))
   163)   allocate(aux%TH_parameter%diffusion_activation_energy(option%nphase))
   164)   aux%TH_parameter%diffusion_coefficient = 1.d-9
   165)   aux%TH_parameter%diffusion_activation_energy = 0.d0
   166)  
   167)   THAuxCreate => aux
   168)   
   169) end function THAuxCreate
   170) 
   171) ! ************************************************************************** !
   172) 
   173) subroutine THAuxVarInit(auxvar,option)
   174)   ! 
   175)   ! Initialize auxiliary object
   176)   ! 
   177)   ! Author: ???
   178)   ! Date: 02/14/08
   179)   ! 
   180) 
   181)   use Option_module
   182)   use PFLOTRAN_Constants_module, only : UNINITIALIZED_DOUBLE
   183) 
   184)   implicit none
   185)   
   186)   type(TH_auxvar_type) :: auxvar
   187)   type(option_type) :: option
   188)   
   189)   PetscReal :: uninit_value
   190)   uninit_value     = UNINITIALIZED_DOUBLE
   191) 
   192)   auxvar%avgmw     = uninit_value
   193)   auxvar%h         = uninit_value
   194)   auxvar%u         = uninit_value
   195)   auxvar%pc        = uninit_value
   196)   !auxvar%kr       = uninit_value
   197)   !auxvar%dkr_dp   = uninit_value
   198)   auxvar%vis       = uninit_value
   199)   !auxvar%dvis_dp  = uninit_value
   200)   auxvar%kvr       = uninit_value
   201)   auxvar%dsat_dp   = uninit_value
   202)   auxvar%dsat_dt   = uninit_value
   203)   auxvar%dden_dp   = uninit_value
   204)   auxvar%dden_dt   = uninit_value
   205)   auxvar%dkvr_dp   = uninit_value
   206)   auxvar%dkvr_dt   = uninit_value
   207)   auxvar%dh_dp     = uninit_value
   208)   auxvar%dh_dt     = uninit_value
   209)   auxvar%du_dp     = uninit_value
   210)   auxvar%du_dt     = uninit_value    
   211)   auxvar%transient_por = uninit_value
   212)   auxvar%Dk_eff    = uninit_value
   213)   auxvar%Ke        = uninit_value
   214)   auxvar%dKe_dp    = uninit_value
   215)   auxvar%dKe_dt    = uninit_value
   216)   if (option%use_th_freezing) then
   217)     allocate(auxvar%ice)
   218)     auxvar%ice%Ke_fr     = uninit_value
   219)     auxvar%ice%dKe_fr_dp = uninit_value
   220)     auxvar%ice%dKe_fr_dt = uninit_value
   221)     ! NOTE(bja, 2013-12) always initialize ice variables to zero, even if not used!
   222)     auxvar%ice%sat_ice       = uninit_value
   223)     auxvar%ice%sat_gas       = uninit_value
   224)     auxvar%ice%dsat_ice_dp   = uninit_value
   225)     auxvar%ice%dsat_gas_dp   = uninit_value
   226)     auxvar%ice%dsat_ice_dt   = uninit_value
   227)     auxvar%ice%dsat_gas_dt   = uninit_value
   228)     auxvar%ice%den_ice       = uninit_value
   229)     auxvar%ice%dden_ice_dp   = uninit_value
   230)     auxvar%ice%dden_ice_dt   = uninit_value
   231)     auxvar%ice%u_ice         = uninit_value
   232)     auxvar%ice%du_ice_dt     = uninit_value
   233)     auxvar%ice%den_gas       = uninit_value
   234)     auxvar%ice%dden_gas_dt   = uninit_value
   235)     auxvar%ice%u_gas         = uninit_value
   236)     auxvar%ice%du_gas_dt     = uninit_value
   237)     auxvar%ice%mol_gas       = uninit_value
   238)     auxvar%ice%dmol_gas_dt   = uninit_value
   239)     auxvar%ice%pres_fh2o     = uninit_value
   240)     auxvar%ice%dpres_fh2o_dp = uninit_value
   241)     auxvar%ice%dpres_fh2o_dt = uninit_value
   242)   else
   243)     nullify(auxvar%ice)
   244)   endif
   245)   if (option%surf_flow_on) then
   246)     allocate(auxvar%surface)
   247)     auxvar%surface%surf_wat      = PETSC_FALSE
   248)     auxvar%surface%P_min         = uninit_value
   249)     auxvar%surface%P_max         = uninit_value
   250)     auxvar%surface%coeff_for_cubic_approx(:)       = uninit_value
   251)     auxvar%surface%coeff_for_deriv_cubic_approx(:) = uninit_value
   252)     auxvar%surface%range_for_linear_approx(:)      = uninit_value
   253)     auxvar%surface%dlinear_slope_dT                = uninit_value
   254)     auxvar%surface%bcflux_default_scheme           = PETSC_FALSE
   255)   else
   256)     nullify(auxvar%surface)
   257)   endif
   258)   
   259) end subroutine THAuxVarInit
   260) 
   261) ! ************************************************************************** !
   262) 
   263) subroutine THAuxVarCopy(auxvar,auxvar2,option)
   264)   ! 
   265)   ! Copies an auxiliary variable
   266)   ! 
   267)   ! Author: ???
   268)   ! Date: 12/13/07
   269)   ! 
   270) 
   271)   use Option_module
   272) 
   273)   implicit none
   274)   
   275)   type(TH_auxvar_type) :: auxvar, auxvar2
   276)   type(option_type) :: option
   277) 
   278) ! auxvar2%pres = auxvar%pres
   279) ! auxvar2%temp = auxvar%temp
   280) ! auxvar2%den = auxvar%den
   281) ! auxvar2%den_kg = auxvar%den_kg
   282)     
   283)   auxvar2%avgmw = auxvar%avgmw
   284)   auxvar2%h = auxvar%h
   285)   auxvar2%u = auxvar%u
   286)   auxvar2%pc = auxvar%pc
   287) !  auxvar2%kr = auxvar%kr
   288) !  auxvar2%dkr_dp = auxvar%dkr_dp
   289)   auxvar2%vis = auxvar%vis
   290) !  auxvar2%dvis_dp = auxvar%dvis_dp
   291)   auxvar2%kvr = auxvar%kvr
   292)   auxvar2%dsat_dp = auxvar%dsat_dp
   293)   auxvar2%dsat_dt = auxvar%dsat_dt
   294)   auxvar2%dden_dp = auxvar%dden_dp
   295)   auxvar2%dden_dt = auxvar%dden_dt
   296)   auxvar2%dkvr_dp = auxvar%dkvr_dp
   297)   auxvar2%dkvr_dt = auxvar%dkvr_dt
   298)   auxvar2%dh_dp = auxvar%dh_dp
   299)   auxvar2%dh_dt = auxvar%dh_dt
   300)   auxvar2%du_dp = auxvar%du_dp
   301)   auxvar2%du_dt = auxvar%du_dt  
   302)   auxvar2%transient_por = auxvar%transient_por
   303)   auxvar2%Dk_eff = auxvar%Dk_eff
   304)   auxvar2%Ke = auxvar%Ke
   305)   auxvar2%dKe_dp = auxvar%dKe_dp
   306)   auxvar2%dKe_dt = auxvar%dKe_dt
   307)   if (associated(auxvar%ice)) then
   308)     auxvar2%ice%Ke_fr = auxvar%ice%Ke_fr
   309)     auxvar2%ice%dKe_fr_dp = auxvar%ice%dKe_fr_dp
   310)     auxvar2%ice%dKe_fr_dt = auxvar%ice%dKe_fr_dt
   311)     auxvar2%ice%sat_ice = auxvar%ice%sat_ice 
   312)     auxvar2%ice%sat_gas = auxvar%ice%sat_gas
   313)     auxvar2%ice%dsat_ice_dp = auxvar%ice%dsat_ice_dp
   314)     auxvar2%ice%dsat_gas_dp = auxvar%ice%dsat_gas_dp
   315)     auxvar2%ice%dsat_ice_dt = auxvar%ice%dsat_ice_dt
   316)     auxvar2%ice%dsat_gas_dt = auxvar%ice%dsat_gas_dt
   317)     auxvar2%ice%den_ice = auxvar%ice%den_ice
   318)     auxvar2%ice%dden_ice_dp = auxvar%ice%dden_ice_dp
   319)     auxvar2%ice%dden_ice_dt = auxvar%ice%dden_ice_dt
   320)     auxvar2%ice%u_ice = auxvar%ice%u_ice
   321)     auxvar2%ice%du_ice_dt = auxvar%ice%du_ice_dt
   322)     auxvar2%ice%pres_fh2o = auxvar%ice%pres_fh2o
   323)     auxvar2%ice%dpres_fh2o_dp = auxvar%ice%dpres_fh2o_dp
   324)     auxvar2%ice%dpres_fh2o_dt = auxvar%ice%dpres_fh2o_dt
   325)     auxvar2%ice%den_gas = auxvar%ice%den_gas
   326)     auxvar2%ice%dden_gas_dt = auxvar%ice%dden_gas_dt
   327)     auxvar2%ice%u_gas = auxvar%ice%u_gas
   328)     auxvar2%ice%du_gas_dt = auxvar%ice%du_gas_dt
   329)     auxvar2%ice%mol_gas = auxvar%ice%mol_gas
   330)     auxvar2%ice%dmol_gas_dt = auxvar%ice%dmol_gas_dt
   331)   endif
   332)   if (associated(auxvar%surface)) then
   333)     auxvar2%surface%surf_wat = auxvar%surface%surf_wat
   334)     auxvar2%surface%P_min = auxvar%surface%P_min
   335)     auxvar2%surface%P_max = auxvar%surface%P_max
   336)     auxvar2%surface%coeff_for_cubic_approx(:) = &
   337)       auxvar%surface%coeff_for_cubic_approx(:)
   338)     auxvar2%surface%coeff_for_deriv_cubic_approx(:) = &
   339)       auxvar%surface%coeff_for_deriv_cubic_approx(:)
   340)     auxvar2%surface%range_for_linear_approx(:) = &
   341)       auxvar%surface%range_for_linear_approx(:)
   342)     auxvar2%surface%dlinear_slope_dT = auxvar%surface%dlinear_slope_dT
   343)     auxvar2%surface%bcflux_default_scheme = &
   344)       auxvar%surface%bcflux_default_scheme
   345)   endif
   346) 
   347) end subroutine THAuxVarCopy
   348) 
   349) ! ************************************************************************** !
   350) 
   351) subroutine THAuxVarComputeNoFreezing(x,auxvar,global_auxvar, &
   352)                                      material_auxvar, &
   353)                                      iphase,saturation_function, &
   354)                                      th_parameter, ithrm, &
   355)                                      option)
   356)   ! 
   357)   ! Computes auxiliary variables for each grid cell
   358)   ! 
   359)   ! Author: ???
   360)   ! Date: 02/22/08
   361)   ! 
   362) 
   363)   use Option_module
   364)   use Global_Aux_module
   365)   
   366)   use EOS_Water_module
   367)   use Saturation_Function_module  
   368)   use Material_Aux_class
   369)   
   370)   implicit none
   371) 
   372)   type(option_type) :: option
   373)   type(saturation_function_type) :: saturation_function
   374)   PetscReal :: x(option%nflowdof)
   375)   type(TH_auxvar_type) :: auxvar
   376)   type(global_auxvar_type) :: global_auxvar
   377)   PetscInt :: iphase
   378)   type(TH_parameter_type) :: th_parameter
   379)   PetscInt :: ithrm
   380)   class(material_auxvar_type) :: material_auxvar
   381) 
   382)   PetscErrorCode :: ierr
   383)   PetscReal :: pw,dw_kg,dw_mol,hw,sat_pressure,visl
   384)   PetscReal :: kr, ds_dp, dkr_dp
   385)   PetscReal :: dvis_dt, dvis_dp
   386)   PetscReal :: dw_dp, dw_dt, hw_dp, hw_dt
   387)   PetscReal :: dpw_dp
   388)   PetscReal :: dpsat_dt
   389)   PetscReal :: Ke
   390)   PetscReal :: alpha
   391)   PetscReal :: Dk
   392)   PetscReal :: Dk_dry
   393)   PetscReal :: aux(1)
   394) 
   395) ! auxvar%den = 0.d0
   396) ! auxvar%den_kg = 0.d0
   397)   global_auxvar%sat = 0.d0
   398)   global_auxvar%den = 0.d0
   399)   global_auxvar%den_kg = 0.d0
   400) 
   401)   auxvar%h = 0.d0
   402)   auxvar%u = 0.d0
   403)   auxvar%avgmw = 0.d0
   404)   auxvar%kvr = 0.d0
   405)   kr = 0.d0
   406)  
   407) ! auxvar%pres = x(1)  
   408) ! auxvar%temp = x(2)
   409)   global_auxvar%pres = x(1)  
   410)   global_auxvar%temp = x(2)
   411)  
   412) ! auxvar%pc = option%reference_pressure - auxvar%pres
   413)   auxvar%pc = option%reference_pressure - global_auxvar%pres(1)
   414) 
   415) !***************  Liquid phase properties **************************
   416)   auxvar%avgmw = FMWH2O
   417) 
   418)   pw = option%reference_pressure
   419)   ds_dp = 0.d0
   420)   dkr_dp = 0.d0
   421) !  if (auxvar%pc > 0.d0) then
   422)   if (auxvar%pc > 1.d0) then
   423)     iphase = 3
   424)     call SaturationFunctionCompute(auxvar%pc,global_auxvar%sat(1), &
   425)                                    kr,ds_dp,dkr_dp, &
   426)                                    saturation_function, &
   427)                                    material_auxvar%porosity, &
   428)                                    material_auxvar%permeability(perm_xx_index), &
   429)                                    option)
   430)     dpw_dp = 0.d0
   431)   else
   432)     iphase = 1
   433)     auxvar%pc = 0.d0
   434)     global_auxvar%sat(1) = 1.d0  
   435)     kr = 1.d0    
   436) !   pw = auxvar%pres
   437)     pw = global_auxvar%pres(1)
   438)     dpw_dp = 1.d0
   439)   endif  
   440) 
   441)   ! may need to compute dpsat_dt to pass to VISW
   442)   call EOSWaterSaturationPressure(global_auxvar%temp,sat_pressure,dpsat_dt,ierr)
   443)   call EOSWaterEnthalpy(global_auxvar%temp,pw,hw,hw_dp,hw_dt,ierr)
   444)   if (.not.option%flow%density_depends_on_salinity) then
   445)     call EOSWaterDensity(global_auxvar%temp,pw,dw_kg,dw_mol,dw_dp,dw_dt,ierr)
   446)     call EOSWaterViscosity(global_auxvar%temp,pw,sat_pressure,dpsat_dt,visl, &
   447)                            dvis_dt,dvis_dp,ierr)
   448)   else
   449)     aux(1) = global_auxvar%m_nacl(1)
   450)     call EOSWaterDensityExt(global_auxvar%temp,pw,aux, &
   451)                             dw_kg,dw_mol,dw_dp,dw_dt,ierr)
   452)     call EOSWaterViscosityExt(global_auxvar%temp,pw,sat_pressure,dpsat_dt,aux, &
   453)                               visl,dvis_dt,dvis_dp,ierr)
   454)   endif
   455)   ! J/kmol -> whatever units
   456)   hw = hw * option%scale
   457)   hw_dp = hw_dp * option%scale
   458)   hw_dt = hw_dt * option%scale
   459)   
   460) !  call VISW_noderiv(option%temp,pw,sat_pressure,visl,ierr)
   461)   if (iphase == 3) then !kludge since pw is constant in the unsat zone
   462)     dvis_dp = 0.d0
   463)     dw_dp = 0.d0
   464)     hw_dp = 0.d0
   465)   endif
   466) 
   467) ! auxvar%den = dw_mol
   468) ! auxvar%den_kg = dw_kg
   469)   global_auxvar%den = dw_mol
   470)   global_auxvar%den_kg = dw_kg
   471)   
   472)   auxvar%h = hw
   473)   auxvar%u = auxvar%h - pw / dw_mol * option%scale
   474)   auxvar%kvr = kr/visl
   475)   
   476)   auxvar%vis = visl
   477) !  auxvar%dvis_dp = dvis_dp
   478) !  auxvar%kr = kr
   479) !  auxvar%dkr_dp = dkr_dp
   480)   auxvar%dsat_dp = ds_dp
   481)   auxvar%dden_dt = dw_dt
   482) 
   483)   auxvar%dden_dp = dw_dp
   484)   
   485) !geh: contribution of dvis_dpsat is now added in EOSWaterViscosity
   486) !  auxvar%dkvr_dt = -kr/(visl*visl)*(dvis_dt+dvis_dpsat*dpsat_dt)
   487)   auxvar%dkvr_dt = -kr/(visl*visl)*dvis_dt
   488)   auxvar%dkvr_dp = dkr_dp/visl - kr/(visl*visl)*dvis_dp
   489)   if (iphase < 3) then !kludge since pw is constant in the unsat zone
   490)     auxvar%dh_dp = hw_dp
   491)     auxvar%du_dp = hw_dp - (dpw_dp/dw_mol-pw/(dw_mol*dw_mol)*dw_dp)*option%scale
   492)   else
   493)     auxvar%dh_dp = 0.d0
   494)     auxvar%du_dp = 0.d0
   495)   endif
   496) 
   497)   auxvar%dh_dt = hw_dt
   498)   auxvar%du_dt = hw_dt + pw/(dw_mol*dw_mol)*option%scale*dw_dt
   499)   
   500)   ! Parameters for computation of effective thermal conductivity
   501)   alpha = th_parameter%alpha(ithrm)
   502)   Dk = th_parameter%ckwet(ithrm)
   503)   Dk_dry = th_parameter%ckdry(ithrm)
   504) 
   505)   !unfrozen soil Kersten number
   506)   Ke = (global_auxvar%sat(1) + epsilon)**(alpha)
   507)   auxvar%Ke = Ke
   508) 
   509)   ! Effective thermal conductivity
   510)   auxvar%Dk_eff = Dk_dry + (Dk - Dk_dry)*Ke
   511) 
   512)   ! Derivative of soil Kersten number
   513)   auxvar%dKe_dp = alpha*(global_auxvar%sat(1) + epsilon)**(alpha - 1.d0)* &
   514)                   auxvar%dsat_dp
   515)   auxvar%dKe_dt = 0.d0
   516) 
   517) end subroutine THAuxVarComputeNoFreezing
   518) 
   519) ! ************************************************************************** !
   520) 
   521) subroutine THAuxVarComputeFreezing(x, auxvar, global_auxvar, &
   522)                                    material_auxvar, &
   523)                                    iphase, &
   524)                                    saturation_function, &
   525)                                    th_parameter, ithrm, &
   526)                                    option)
   527)   ! 
   528)   ! Computes auxillary variables for each grid cell when
   529)   ! ice and vapor phases are present
   530)   ! 
   531)   ! Author: Satish Karra, LANL
   532)   ! Date: 11/16/11
   533)   ! 
   534) 
   535) !sk: Not sure if we need por, perm
   536) 
   537)   use Option_module
   538)   use Global_Aux_module
   539)   
   540)   use EOS_Water_module
   541)   use Saturation_Function_module  
   542)   use Material_Aux_class
   543)   
   544)   implicit none
   545) 
   546)   type(option_type) :: option
   547)   type(saturation_function_type) :: saturation_function
   548)   PetscReal :: x(option%nflowdof)
   549)   type(TH_auxvar_type) :: auxvar
   550)   type(global_auxvar_type) :: global_auxvar
   551)   class(material_auxvar_type) :: material_auxvar
   552)   type(TH_parameter_type) :: th_parameter
   553)   PetscInt :: ithrm
   554)   PetscInt :: iphase
   555) 
   556)   PetscErrorCode :: ierr
   557)   PetscReal :: pw, dw_kg, dw_mol, hw, sat_pressure, visl
   558)   PetscReal :: kr, ds_dp, dkr_dp, dkr_dt
   559)   PetscReal :: dvis_dt, dvis_dp
   560)   PetscReal :: dw_dp, dw_dt, hw_dp, hw_dt
   561)   PetscReal :: dpw_dp
   562)   PetscReal :: dpsat_dt
   563)   PetscReal :: ice_saturation, gas_saturation
   564)   PetscReal :: dsl_temp
   565)   PetscReal :: dsg_pl, dsg_temp
   566)   PetscReal :: dsi_pl, dsi_temp
   567)   PetscReal :: den_ice, dden_ice_dT, dden_ice_dP
   568)   PetscReal :: u_ice, du_ice_dT
   569)   PetscBool :: out_of_table_flag
   570)   PetscReal :: p_th
   571) 
   572)   PetscReal :: p_g
   573)   PetscReal :: p_sat
   574)   PetscReal :: mol_g
   575)   PetscReal :: C_g
   576)   PetscReal :: dmolg_dt
   577)   PetscReal, parameter :: C_a = 1.86d-3 ! in MJ/kg/K at 300K
   578)   PetscReal, parameter :: C_wv = 1.005d-3 ! in MJ/kg/K
   579) 
   580)   PetscReal :: Ke
   581)   PetscReal :: Ke_fr
   582)   PetscReal :: alpha
   583)   PetscReal :: alpha_fr
   584)   PetscReal :: Dk
   585)   PetscReal :: Dk_dry
   586)   PetscReal :: Dk_ice
   587) 
   588)   out_of_table_flag = PETSC_FALSE
   589)  
   590)   global_auxvar%sat = 0.d0
   591)   global_auxvar%den = 0.d0
   592)   global_auxvar%den_kg = 0.d0
   593) 
   594)   auxvar%h = 0.d0
   595)   auxvar%u = 0.d0
   596)   auxvar%avgmw = 0.d0
   597)   auxvar%kvr = 0.d0
   598)    
   599)   global_auxvar%pres = x(1)  
   600)   global_auxvar%temp = x(2)
   601)   
   602)   ! Check if the capillary pressure is less than -100MPa
   603)   
   604)   if (global_auxvar%pres(1) - option%reference_pressure < -1.d8 + 1.d0) then
   605)     global_auxvar%pres(1) = -1.d8 + option%reference_pressure + 1.d0
   606)   endif
   607) 
   608)  
   609)   auxvar%pc = option%reference_pressure - global_auxvar%pres(1)
   610) 
   611) !***************  Liquid phase properties **************************
   612)   auxvar%avgmw = FMWH2O
   613) 
   614)   pw = option%reference_pressure
   615)   ds_dp = 0.d0
   616)   dkr_dp = 0.d0
   617)   if (auxvar%pc > 1.d0) then
   618)     iphase = 3
   619)     dpw_dp = 0.d0
   620)   else
   621)     iphase = 1
   622)     auxvar%pc = 0.d0
   623)     pw = global_auxvar%pres(1)
   624)     dpw_dp = 1.d0
   625)   endif  
   626)   
   627)   call CapillaryPressureThreshold(saturation_function,p_th,option)
   628) 
   629)   select case (option%ice_model)
   630)     case (PAINTER_EXPLICIT)
   631)       ! Model from Painter, Comp. Geosci. (2011)
   632)       call SatFuncComputeIcePExplicit(global_auxvar%pres(1), & 
   633)                                       global_auxvar%temp, ice_saturation, &
   634)                                       global_auxvar%sat(1), gas_saturation, &
   635)                                       kr, ds_dp, dsl_temp, dsg_pl, dsg_temp, &
   636)                                       dsi_pl, dsi_temp, dkr_dp, dkr_dt, &
   637)                                       saturation_function, p_th, option)    
   638)     case (PAINTER_KARRA_IMPLICIT)
   639)       ! Implicit model from Painter & Karra, VJZ (2013)
   640)       call SatFuncComputeIcePKImplicit(global_auxvar%pres(1), & 
   641)                                        global_auxvar%temp, ice_saturation, &
   642)                                        global_auxvar%sat(1), gas_saturation, &
   643)                                        kr, ds_dp, dsl_temp, dsg_pl, dsg_temp, &
   644)                                        dsi_pl, dsi_temp, dkr_dp, dkr_dt, &
   645)                                        saturation_function, p_th, option)    
   646)     case (PAINTER_KARRA_EXPLICIT)
   647)       ! Explicit model from Painter & Karra, VJZ (2013)
   648)       call SatFuncComputeIcePKExplicit(global_auxvar%pres(1), & 
   649)                                        global_auxvar%temp, ice_saturation, &
   650)                                        global_auxvar%sat(1), gas_saturation, &
   651)                                        kr, ds_dp, dsl_temp, dsg_pl, dsg_temp, &
   652)                                        dsi_pl, dsi_temp, dkr_dp, dkr_dt, &
   653)                                        saturation_function, p_th, option) 
   654)     case (DALL_AMICO)
   655)       ! Model from Dall'Amico (2010) and Dall' Amico et al. (2011)
   656)       call SatFuncComputeIceDallAmico(global_auxvar%pres(1), &
   657)                                       global_auxvar%temp, &
   658)                                       auxvar%ice%pres_fh2o, &
   659)                                       auxvar%ice%dpres_fh2o_dp, &
   660)                                       auxvar%ice%dpres_fh2o_dt, &
   661)                                       ice_saturation, &
   662)                                       global_auxvar%sat(1), gas_saturation, &
   663)                                       kr, ds_dp, dsl_temp, dsg_pl, dsg_temp, &
   664)                                       dsi_pl, dsi_temp, dkr_dp, dkr_dt, &
   665)                                       saturation_function, option)
   666)     case (PAINTER_KARRA_EXPLICIT_NOCRYO)
   667)       ! Explicit model from Painter & Karra, VJZ (2013) and removed cryosuction
   668)       call SatFuncComputeIcePKExplicitNoCryo(global_auxvar%pres(1), & 
   669)                                        global_auxvar%temp, ice_saturation, &
   670)                                        global_auxvar%sat(1), gas_saturation, &
   671)                                        kr, ds_dp, dsl_temp, dsg_pl, dsg_temp, &
   672)                                        dsi_pl, dsi_temp, dkr_dp, dkr_dt, &
   673)                                        saturation_function, p_th, option) 
   674)     case default
   675)       option%io_buffer = 'THCAuxVarComputeIce: Ice model not recognized.'
   676)       call printErrMsg(option)
   677)   end select
   678) 
   679)   call EOSWaterDensity(global_auxvar%temp,pw,dw_kg,dw_mol,dw_dp,dw_dt,ierr)
   680)   call EOSWaterEnthalpy(global_auxvar%temp,pw,hw,hw_dp,hw_dt,ierr)
   681)   ! J/kmol -> MJ/kmol
   682)   hw = hw * option%scale
   683)   hw_dp = hw_dp * option%scale
   684)   hw_dt = hw_dt * option%scale
   685)                          
   686)   call EOSWaterSaturationPressure(global_auxvar%temp, sat_pressure, &
   687)                                   dpsat_dt, ierr)
   688)   call EOSWaterViscosity(global_auxvar%temp, pw, sat_pressure, dpsat_dt, &
   689)                          visl, dvis_dt,dvis_dp, ierr)
   690) 
   691)   if (iphase == 3) then !kludge since pw is constant in the unsat zone
   692)     dvis_dp = 0.d0
   693)     dw_dp = 0.d0
   694)     hw_dp = 0.d0
   695)   endif
   696) 
   697)   global_auxvar%den = dw_mol
   698)   global_auxvar%den_kg = dw_kg
   699)   
   700)   auxvar%h = hw
   701)   auxvar%u = auxvar%h - pw / dw_mol * option%scale
   702)   auxvar%kvr = kr/visl
   703)   auxvar%vis = visl
   704)   auxvar%dsat_dp = ds_dp
   705)   auxvar%dden_dt = dw_dt
   706)   auxvar%dden_dp = dw_dp
   707) !geh: contribution of dvis_dpsat is now added in EOSWaterViscosity  
   708) !  auxvar%dkvr_dt = -kr/(visl*visl)*(dvis_dt + dvis_dpsat*dpsat_dt) + dkr_dt/visl
   709)   auxvar%dkvr_dt = -kr/(visl*visl)*dvis_dt + dkr_dt/visl
   710)   auxvar%dkvr_dp = dkr_dp/visl - kr/(visl*visl)*dvis_dp
   711)   auxvar%dh_dp = hw_dp
   712)   auxvar%du_dp = hw_dp - (dpw_dp/dw_mol - pw/(dw_mol*dw_mol)*dw_dp)* &
   713)                   option%scale
   714)   auxvar%dh_dt = hw_dt
   715)   auxvar%du_dt = hw_dt + pw/(dw_mol*dw_mol)*option%scale*dw_dt
   716) 
   717)   auxvar%ice%sat_ice = ice_saturation
   718)   auxvar%ice%sat_gas = gas_saturation
   719)   auxvar%dsat_dt = dsl_temp
   720)   auxvar%ice%dsat_ice_dp = dsi_pl
   721)   auxvar%ice%dsat_gas_dp = dsg_pl
   722)   auxvar%ice%dsat_ice_dt = dsi_temp
   723)   auxvar%ice%dsat_gas_dt = dsg_temp
   724)   
   725)   ! Calculate the density, internal energy and derivatives for ice
   726)   call EOSWaterDensityIce(global_auxvar%temp, global_auxvar%pres(1), &
   727)                           den_ice, dden_ice_dT, dden_ice_dP, ierr)
   728) 
   729)   call EOSWaterInternalEnergyIce(global_auxvar%temp, u_ice, du_ice_dT)
   730) 
   731)   auxvar%ice%den_ice = den_ice
   732)   auxvar%ice%dden_ice_dt = dden_ice_dT
   733)   auxvar%ice%dden_ice_dp = dden_ice_dP
   734)   auxvar%ice%u_ice = u_ice*1.d-3                  !kJ/kmol --> MJ/kmol
   735)   auxvar%ice%du_ice_dt = du_ice_dT*1.d-3          !kJ/kmol/K --> MJ/kmol/K 
   736) 
   737)   ! Calculate the values and derivatives for density and internal energy
   738)   call EOSWaterSaturationPressure(global_auxvar%temp, p_sat, ierr)
   739) 
   740)   p_g            = option%reference_pressure
   741)   auxvar%ice%den_gas = p_g/(IDEAL_GAS_CONSTANT*(global_auxvar%temp + 273.15d0))*1.d-3 !in kmol/m3
   742)   mol_g          = p_sat/p_g
   743)   C_g            = C_wv*mol_g*FMWH2O + C_a*(1.d0 - mol_g)*FMWAIR ! in MJ/kmol/K
   744)   auxvar%ice%u_gas   = C_g*(global_auxvar%temp + 273.15d0)           ! in MJ/kmol
   745)   auxvar%ice%mol_gas = mol_g
   746) 
   747)   auxvar%ice%dden_gas_dt = - p_g/(IDEAL_GAS_CONSTANT*(global_auxvar%temp + 273.15d0)**2)*1.d-3
   748)   dmolg_dt           = dpsat_dt/p_g
   749)   auxvar%ice%du_gas_dt   = C_g + (C_wv*dmolg_dt*FMWH2O - C_a*dmolg_dt*FMWAIR)* &
   750)                        (global_auxvar%temp + 273.15d0)
   751)   auxvar%ice%dmol_gas_dt = dmolg_dt
   752) 
   753)   ! Parameters for computation of effective thermal conductivity
   754)   alpha = th_parameter%alpha(ithrm)
   755)   alpha_fr = th_parameter%alpha_fr(ithrm)
   756)   Dk = th_parameter%ckwet(ithrm)
   757)   Dk_dry = th_parameter%ckdry(ithrm)
   758)   Dk_ice = th_parameter%ckfrozen(ithrm)
   759) 
   760)   !Soil Kersten number
   761)   Ke = (global_auxvar%sat(1) + epsilon)**(alpha)
   762)   Ke_fr = (auxvar%ice%sat_ice + epsilon)**(alpha_fr)
   763)   auxvar%Ke = Ke
   764)   auxvar%ice%Ke_fr = Ke_fr
   765) 
   766)   ! Effective thermal conductivity
   767)   auxvar%Dk_eff = Dk*Ke + Dk_ice*Ke_fr + (1.d0 - Ke - Ke_fr)*Dk_dry
   768) 
   769)   ! Derivative of Kersten number
   770)   auxvar%dKe_dp = alpha*(global_auxvar%sat(1) + epsilon)**(alpha - 1.d0)* &
   771)                   auxvar%dsat_dp
   772)   auxvar%dKe_dt = alpha*(global_auxvar%sat(1) + epsilon)**(alpha - 1.d0)* &
   773)                   auxvar%dsat_dt
   774)   auxvar%ice%dKe_fr_dt = alpha_fr* &
   775)                          (auxvar%ice%sat_ice + epsilon)**(alpha_fr - 1.d0)* &
   776)                          auxvar%ice%dsat_ice_dt
   777)   auxvar%ice%dKe_fr_dp = alpha_fr* &
   778)                          (auxvar%ice%sat_ice + epsilon)**(alpha_fr - 1.d0)* &
   779)                          auxvar%ice%dsat_ice_dp
   780) 
   781)   if (option%ice_model == DALL_AMICO) then
   782)     auxvar%ice%den_ice = dw_mol
   783)     auxvar%ice%dden_ice_dt = auxvar%dden_dt
   784)     auxvar%ice%dden_ice_dp = auxvar%dden_dp
   785) !    auxvar%ice%u_ice = auxvar%u  ! commented out by S.Karra 06/02/14. setting
   786) !    internal energy of ice and water might not be correct.
   787) !    auxvar%ice%du_ice_dt = auxvar%du_dt
   788) 
   789)     auxvar%ice%sat_gas       = 0.d0
   790)     auxvar%ice%dsat_gas_dp   = 0.d0
   791)     auxvar%ice%dsat_gas_dt   = 0.d0
   792)     auxvar%ice%den_gas       = 0.d0
   793)     auxvar%ice%dden_gas_dt   = 0.d0
   794)     auxvar%ice%u_gas         = 0.d0
   795)     auxvar%ice%du_gas_dt     = 0.d0
   796)     auxvar%ice%mol_gas       = 0.d0
   797)     auxvar%ice%dmol_gas_dt   = 0.d0
   798)   endif
   799) 
   800) end subroutine THAuxVarComputeFreezing
   801) 
   802) ! ************************************************************************** !
   803) 
   804) subroutine THAuxVarDestroy(auxvar)
   805)   ! 
   806)   ! Deallocates a TH auxiliary object
   807)   ! 
   808)   ! Author: ???
   809)   ! Date: 02/14/08
   810)   ! 
   811) 
   812)   implicit none
   813) 
   814)   type(TH_auxvar_type) :: auxvar
   815)   
   816)   if (associated(auxvar%ice)) deallocate(auxvar%ice)
   817)   nullify(auxvar%ice)
   818)   if (associated(auxvar%surface)) deallocate(auxvar%surface)
   819)   nullify(auxvar%surface)
   820)   
   821) end subroutine THAuxVarDestroy
   822) 
   823) ! ************************************************************************** !
   824) 
   825) subroutine THAuxDestroy(aux)
   826)   ! 
   827)   ! Deallocates a TH auxiliary object
   828)   ! 
   829)   ! Author: ???
   830)   ! Date: 02/14/08
   831)   ! 
   832) 
   833)   implicit none
   834) 
   835)   type(TH_type), pointer :: aux
   836)   PetscInt :: iaux
   837)   
   838)   if (.not.associated(aux)) return
   839)   
   840)   do iaux = 1, aux%num_aux
   841)     call THAuxVarDestroy(aux%auxvars(iaux))
   842)   enddo  
   843)   do iaux = 1, aux%num_aux_bc
   844)     call THAuxVarDestroy(aux%auxvars_bc(iaux))
   845)   enddo  
   846)   do iaux = 1, aux%num_aux_ss
   847)     call THAuxVarDestroy(aux%auxvars_ss(iaux))
   848)   enddo  
   849)   
   850)   if (associated(aux%auxvars)) deallocate(aux%auxvars)
   851)   nullify(aux%auxvars)
   852)   if (associated(aux%auxvars_bc)) deallocate(aux%auxvars_bc)
   853)   nullify(aux%auxvars_bc)
   854)   if (associated(aux%auxvars_ss)) deallocate(aux%auxvars_ss)
   855)   nullify(aux%auxvars_ss)
   856)   if (associated(aux%zero_rows_local)) deallocate(aux%zero_rows_local)
   857)   nullify(aux%zero_rows_local)
   858)   if (associated(aux%zero_rows_local_ghosted)) deallocate(aux%zero_rows_local_ghosted)
   859)   nullify(aux%zero_rows_local_ghosted)
   860)   if (associated(aux%TH_parameter)) then
   861)     if (associated(aux%TH_parameter%diffusion_coefficient)) &
   862)       deallocate(aux%TH_parameter%diffusion_coefficient)
   863)     nullify(aux%TH_parameter%diffusion_coefficient)
   864)     if (associated(aux%TH_parameter%diffusion_activation_energy)) &
   865)       deallocate(aux%TH_parameter%diffusion_activation_energy)
   866)     nullify(aux%TH_parameter%diffusion_activation_energy)
   867)     if (associated(aux%TH_parameter%dencpr)) deallocate(aux%TH_parameter%dencpr)
   868)     nullify(aux%TH_parameter%dencpr)
   869)     if (associated(aux%TH_parameter%ckwet)) deallocate(aux%TH_parameter%ckwet)
   870)     nullify(aux%TH_parameter%ckwet)
   871)     if (associated(aux%TH_parameter%ckdry)) deallocate(aux%TH_parameter%ckdry)
   872)     nullify(aux%TH_parameter%ckdry)
   873)     if (associated(aux%TH_parameter%alpha)) deallocate(aux%TH_parameter%alpha)
   874)     nullify(aux%TH_parameter%alpha)
   875)     ! ice
   876)     if (associated(aux%TH_parameter%ckfrozen)) deallocate(aux%TH_parameter%ckfrozen)
   877)     nullify(aux%TH_parameter%ckfrozen)
   878)     if (associated(aux%TH_parameter%alpha_fr)) deallocate(aux%TH_parameter%alpha_fr)
   879)     nullify(aux%TH_parameter%alpha_fr)
   880) 
   881)     if (associated(aux%TH_parameter%sir)) deallocate(aux%TH_parameter%sir)
   882)     nullify(aux%TH_parameter%sir)
   883)   endif
   884)   nullify(aux%TH_parameter)
   885)   
   886)   deallocate(aux)
   887)   nullify(aux)  
   888) 
   889)   end subroutine THAuxDestroy
   890) 
   891) end module TH_Aux_module

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