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