characteristic_curves.F90 coverage: 56.69 %func 36.16 %block
1) module Characteristic_Curves_module
2)
3) use PFLOTRAN_Constants_module
4)
5) implicit none
6)
7) private
8)
9) #include "petsc/finclude/petscsys.h"
10)
11) PetscReal, parameter :: DEFAULT_PCMAX = 1.d9
12)
13) type :: polynomial_type
14) PetscReal :: low
15) PetscReal :: high
16) PetscReal :: coefficients(4)
17) end type polynomial_type
18)
19) ! Begin Saturation Functions ------------------------------------------------
20) type :: sat_func_base_type
21) type(polynomial_type), pointer :: sat_poly
22) type(polynomial_type), pointer :: pres_poly
23) PetscReal :: Sr
24) PetscReal :: pcmax
25) contains
26) procedure, public :: Init => SFBaseInit
27) procedure, public :: Verify => SFBaseVerify
28) procedure, public :: Test => SFBaseTest
29) procedure, public :: SetupPolynomials => SFBaseSetupPolynomials
30) procedure, public :: CapillaryPressure => SFBaseCapillaryPressure
31) procedure, public :: Saturation => SFBaseSaturation
32) end type sat_func_base_type
33) ! Default
34) type, public, extends(sat_func_base_type) :: sat_func_default_type
35) contains
36) procedure, public :: Verify => SFDefaultVerify
37) procedure, public :: CapillaryPressure => SFDefaultCapillaryPressure
38) procedure, public :: Saturation => SFDefaultSaturation
39) end type sat_func_default_type
40) type, public, extends(sat_func_base_type) :: sat_func_VG_type
41) PetscReal :: alpha
42) PetscReal :: m
43) contains
44) procedure, public :: Init => SF_VG_Init
45) procedure, public :: Verify => SF_VG_Verify
46) procedure, public :: CapillaryPressure => SF_VG_CapillaryPressure
47) procedure, public :: Saturation => SF_VG_Saturation
48) end type sat_func_VG_type
49) type, public, extends(sat_func_base_type) :: sat_func_BC_type
50) PetscReal :: alpha
51) PetscReal :: lambda
52) contains
53) procedure, public :: Init => SF_BC_Init
54) procedure, public :: Verify => SF_BC_Verify
55) procedure, public :: SetupPolynomials => SF_BC_SetupPolynomials
56) procedure, public :: CapillaryPressure => SF_BC_CapillaryPressure
57) procedure, public :: Saturation => SF_BC_Saturation
58) end type sat_func_BC_type
59) type, public, extends(sat_func_base_type) :: sat_func_Linear_type
60) PetscReal :: alpha
61) contains
62) procedure, public :: Init => SF_Linear_Init
63) procedure, public :: Verify => SF_Linear_Verify
64) procedure, public :: CapillaryPressure => SF_Linear_CapillaryPressure
65) procedure, public :: Saturation => SF_Linear_Saturation
66) end type sat_func_Linear_type
67) ! BRAGFLO KRP9 modified Brooks-Corey Model
68) type, public, extends(sat_func_base_type) :: sat_func_BF_KRP9_type
69) contains
70) procedure, public :: Init => SF_BF_KRP9_Init
71) procedure, public :: Verify => SF_BF_KRP9_Verify
72) procedure, public :: CapillaryPressure => SF_BF_KRP9_CapillaryPressure
73) procedure, public :: Saturation => SF_BF_KRP9_Saturation
74) end type sat_func_BF_KRP9_type
75) ! BRAGFLO KRP4 modified Brooks-Corey Model
76) type, public, extends(sat_func_BC_type) :: sat_func_BF_KRP4_type
77) PetscReal :: Srg
78) PetscInt :: pcmax_flag
79) contains
80) procedure, public :: Verify => SF_BF_KRP4_Verify
81) procedure, public :: CapillaryPressure => SF_BF_KRP4_CapillaryPressure
82) procedure, public :: Saturation => SF_BF_KRP4_Saturation
83) end type sat_func_BF_KRP4_type
84) ! BRAGFLO KRP11 modified Brooks-Corey Model
85) type, public, extends(sat_func_base_type) :: sat_func_BF_KRP11_type
86) contains
87) procedure, public :: Init => SF_BF_KRP11_Init
88) procedure, public :: Verify => SF_BF_KRP11_Verify
89) procedure, public :: CapillaryPressure => SF_BF_KRP11_CapillaryPressure
90) procedure, public :: Saturation => SF_BF_KRP11_Saturation
91) end type sat_func_BF_KRP11_type
92) ! BRAGFLO KRP12 modified Brooks-Corey Model
93) type, public, extends(sat_func_BC_type) :: sat_func_BF_KRP12_type
94) PetscReal :: Srg
95) PetscReal :: socmin
96) PetscReal :: soceffmin
97) contains
98) procedure, public :: Verify => SF_BF_KRP12_Verify
99) procedure, public :: CapillaryPressure => SF_BF_KRP12_CapillaryPressure
100) end type sat_func_BF_KRP12_type
101) ! End Saturation Functions --------------------------------------------------
102)
103) ! Begin Relative Permeability Functions -------------------------------------
104) type :: rel_perm_func_base_type
105) type(polynomial_type), pointer :: poly
106) PetscReal :: Sr
107) contains
108) procedure, public :: Init => RPFBaseInit
109) procedure, public :: Verify => RPFBaseVerify
110) procedure, public :: Test => RPF_Base_Test
111) procedure, public :: SetupPolynomials => RPFBaseSetupPolynomials
112) procedure, public :: RelativePermeability => RPF_Base_RelPerm
113) end type rel_perm_func_base_type
114) ! Default
115) type, public, extends(rel_perm_func_base_type) :: rel_perm_func_default_type
116) contains
117) procedure, public :: Verify => RPFDefaultVerify
118) procedure, public :: RelativePermeability => RPF_DefaultRelPerm
119) end type rel_perm_func_default_type
120) ! Mualem-VG-liq
121) type, public, extends(rel_perm_func_base_type) :: rpf_Mualem_VG_liq_type
122) PetscReal :: m
123) contains
124) procedure, public :: Init => RPF_Mualem_VG_Liq_Init
125) procedure, public :: Verify => RPF_Mualem_VG_Liq_Verify
126) procedure, public :: SetupPolynomials => RPF_Mualem_SetupPolynomials
127) procedure, public :: RelativePermeability => RPF_Mualem_VG_Liq_RelPerm
128) end type rpf_Mualem_VG_liq_type
129) ! Mualem-VG-gas
130) type, public, extends(rel_perm_func_base_type) :: rpf_Mualem_VG_gas_type
131) PetscReal :: m
132) PetscReal :: Srg
133) contains
134) procedure, public :: Init => RPF_Mualem_VG_Gas_Init
135) procedure, public :: Verify => RPF_Mualem_VG_Gas_Verify
136) procedure, public :: RelativePermeability => RPF_Mualem_VG_Gas_RelPerm
137) end type rpf_Mualem_VG_gas_type
138) ! since the TOUGH2_Corey relative permeability function (IRP=7 in
139) ! TOUGH2 manual) calculates relative perm as a function of the
140) ! Mualem-based liquid relative permeability when Srg = 0., we extend
141) ! the rpf_Mualem_type to save code
142) type, public, extends(rpf_Mualem_VG_liq_type) :: rpf_TOUGH2_IRP7_gas_type
143) PetscReal :: Srg
144) contains
145) procedure, public :: Init => RPF_TOUGH2_IRP7_Gas_Init
146) procedure, public :: Verify => RPF_TOUGH2_IRP7_Gas_Verify
147) procedure, public :: RelativePermeability => RPF_TOUGH2_IRP7_Gas_RelPerm
148) end type rpf_TOUGH2_IRP7_gas_type
149) ! Burdine-BC
150) type, public, extends(rel_perm_func_base_type) :: rpf_Burdine_BC_liq_type
151) PetscReal :: lambda
152) contains
153) procedure, public :: Init => RPF_Burdine_BC_Liq_Init
154) procedure, public :: Verify => RPF_Burdine_BC_Liq_Verify
155) procedure, public :: RelativePermeability => RPF_Burdine_BC_Liq_RelPerm
156) end type rpf_Burdine_BC_liq_type
157) type, public, extends(rel_perm_func_base_type) :: rpf_Burdine_BC_gas_type
158) PetscReal :: lambda
159) PetscReal :: Srg
160) contains
161) procedure, public :: Init => RPF_Burdine_BC_Gas_Init
162) procedure, public :: Verify => RPF_Burdine_BC_Gas_Verify
163) procedure, public :: RelativePermeability => RPF_Burdine_BC_Gas_RelPerm
164) end type rpf_Burdine_BC_gas_type
165) ! Mualem-BC
166) type, public, extends(rel_perm_func_base_type) :: rpf_Mualem_BC_liq_type
167) PetscReal :: lambda
168) contains
169) procedure, public :: Init => RPF_Mualem_BC_Liq_Init
170) procedure, public :: Verify => RPF_Mualem_BC_Liq_Verify
171) procedure, public :: RelativePermeability => RPF_Mualem_BC_Liq_RelPerm
172) end type rpf_MUALEM_BC_liq_type
173) type, public, extends(rel_perm_func_base_type) :: rpf_Mualem_BC_gas_type
174) PetscReal :: lambda
175) PetscReal :: Srg
176) contains
177) procedure, public :: Init => RPF_Mualem_BC_Gas_Init
178) procedure, public :: Verify => RPF_Mualem_BC_Gas_Verify
179) procedure, public :: RelativePermeability => RPF_Mualem_BC_Gas_RelPerm
180) end type rpf_Mualem_BC_gas_type
181) ! Burdine-VG
182) type, public, extends(rel_perm_func_base_type) :: rpf_Burdine_VG_liq_type
183) PetscReal :: m
184) contains
185) procedure, public :: Init => RPF_Burdine_VG_Liq_Init
186) procedure, public :: Verify => RPF_Burdine_VG_Liq_Verify
187) procedure, public :: RelativePermeability => RPF_Burdine_VG_Liq_RelPerm
188) end type rpf_Burdine_VG_liq_type
189) type, public, extends(rel_perm_func_base_type) :: rpf_Burdine_VG_gas_type
190) PetscReal :: m
191) PetscReal :: Srg
192) contains
193) procedure, public :: Init => RPF_Burdine_VG_Gas_Init
194) procedure, public :: Verify => RPF_Burdine_VG_Gas_Verify
195) procedure, public :: RelativePermeability => RPF_Burdine_VG_Gas_RelPerm
196) end type rpf_Burdine_VG_gas_type
197) ! Mualem-Linear
198) type, public, extends(rel_perm_func_base_type) :: rpf_Mualem_Linear_liq_type
199) PetscReal :: pcmax
200) PetscReal :: alpha
201) contains
202) procedure, public :: Init => RPF_Mualem_Linear_Liq_Init
203) procedure, public :: Verify => RPF_Mualem_Linear_Liq_Verify
204) procedure, public :: RelativePermeability => RPF_Mualem_Linear_Liq_RelPerm
205) end type rpf_Mualem_Linear_liq_type
206) type, public, extends(rpf_Mualem_Linear_liq_type) :: &
207) rpf_Mualem_Linear_gas_type
208) PetscReal :: Srg
209) contains
210) procedure, public :: Init => RPF_Mualem_Linear_Gas_Init
211) procedure, public :: Verify => RPF_Mualem_Linear_Gas_Verify
212) procedure, public :: RelativePermeability => RPF_Mualem_Linear_Gas_RelPerm
213) end type rpf_Mualem_Linear_gas_type
214) ! Burdine-Linear
215) type, public, extends(rel_perm_func_base_type) :: rpf_Burdine_Linear_liq_type
216) contains
217) procedure, public :: Init => RPF_Burdine_Linear_Liq_Init
218) procedure, public :: Verify => RPF_Burdine_Linear_Liq_Verify
219) procedure, public :: RelativePermeability => RPF_Burdine_Linear_Liq_RelPerm
220) end type rpf_Burdine_Linear_liq_type
221) type, public, extends(rel_perm_func_base_type) :: &
222) rpf_Burdine_Linear_gas_type
223) PetscReal :: Srg
224) contains
225) procedure, public :: Init => RPF_Burdine_Linear_Gas_Init
226) procedure, public :: Verify => RPF_Burdine_Linear_Gas_Verify
227) procedure, public :: RelativePermeability => RPF_Burdine_Linear_Gas_RelPerm
228) end type rpf_Burdine_Linear_gas_type
229) ! BRAGFLO KRP9
230) type, public, extends(rel_perm_func_base_type) :: rpf_BRAGFLO_KRP9_liq_type
231) contains
232) procedure, public :: Init => RPF_BRAGFLO_KRP9_Liq_Init
233) procedure, public :: Verify => RPF_BRAGFLO_KRP9_Liq_Verify
234) procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP9_Liq_RelPerm
235) end type rpf_BRAGFLO_KRP9_liq_type
236) type, public, extends(rpf_BRAGFLO_KRP9_liq_type) :: &
237) rpf_BRAGFLO_KRP9_gas_type
238) PetscReal :: Srg
239) contains
240) procedure, public :: Init => RPF_BRAGFLO_KRP9_Gas_Init
241) procedure, public :: Verify => RPF_BRAGFLO_KRP9_Gas_Verify
242) procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP9_Gas_RelPerm
243) end type rpf_BRAGFLO_KRP9_gas_type
244) ! BRAGFLO KRP4 modified Brooks-Corey Model
245) ! relperm equations for KRP4 is identical to Burdine Brooks Corey
246) ! formulation, but with different conditions
247) type, public, extends(rpf_Burdine_BC_liq_type) :: rpf_BRAGFLO_KRP4_liq_type
248) contains
249) end type rpf_BRAGFLO_KRP4_liq_type
250) type, public, extends(rpf_Burdine_BC_gas_type) :: &
251) rpf_BRAGFLO_KRP4_gas_type
252) contains
253) procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP4_Gas_RelPerm
254) end type rpf_BRAGFLO_KRP4_gas_type
255) ! BRAGFLO KRP11
256) type, public, extends(rel_perm_func_base_type) :: rpf_BRAGFLO_KRP11_liq_type
257) PetscReal :: tolc
258) PetscReal :: Srg
259) contains
260) procedure, public :: Init => RPF_BRAGFLO_KRP11_Liq_Init
261) procedure, public :: Verify => RPF_BRAGFLO_KRP11_Liq_Verify
262) procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP11_Liq_RelPerm
263) end type rpf_BRAGFLO_KRP11_liq_type
264) type, public, extends(rpf_BRAGFLO_KRP11_liq_type) :: &
265) rpf_BRAGFLO_KRP11_gas_type
266) contains
267) procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP11_Gas_RelPerm
268) end type rpf_BRAGFLO_KRP11_gas_type
269) ! BRAGFLO KRP12 modified Brooks-Corey Model
270) ! relperm equations for KRP12 is identical to Burdine Brooks Corey
271) ! formulation, but with different conditions and truncations
272) type, public, extends(rpf_Burdine_BC_liq_type) :: rpf_BRAGFLO_KRP12_liq_type
273) contains
274) procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP12_Liq_RelPerm
275) end type rpf_BRAGFLO_KRP12_liq_type
276) type, public, extends(rpf_Burdine_BC_gas_type) :: rpf_BRAGFLO_KRP12_gas_type
277) contains
278) procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP12_Gas_RelPerm
279) end type rpf_BRAGFLO_KRP12_gas_type
280) ! Oil relative permeability functions
281) type, public, extends(rel_perm_func_base_type) :: rpf_TOUGH2_Linear_oil_type
282) PetscReal :: Sro !
283) contains
284) procedure, public :: Init => RPF_TOUGH2_Linear_Oil_Init
285) procedure, public :: Verify => RPF_TOUGH2_Linear_Oil_Verify
286) procedure, public :: RelativePermeability => RPF_TOUGH2_Linear_Oil_RelPerm
287) end type rpf_TOUGH2_Linear_Oil_type
288) type, public, extends(rel_perm_func_base_type) :: RPF_Mod_BC_type
289) PetscReal :: m !exponential coeff.
290) PetscReal :: Srg
291) PetscReal :: Sro
292) PetscReal :: kr_max
293) contains
294) procedure, public :: Init => RPF_Mod_BC_Init
295) procedure, public :: Verify => RPF_Mod_BC_Verify
296) procedure, public :: SetupPolynomials => RPF_Mod_BC_SetupPolynomials
297) end type RPF_Mod_BC_type
298) type, public, extends(RPF_Mod_BC_type) :: RPF_Mod_BC_liq_type
299) contains
300) procedure, public :: RelativePermeability => RPF_Mod_BC_Liq_RelPerm
301) end type RPF_Mod_BC_liq_type
302) type, public, extends(RPF_Mod_BC_type) :: RPF_Mod_BC_oil_type
303) contains
304) procedure, public :: RelativePermeability => RPF_Mod_BC_Oil_RelPerm
305) end type RPF_Mod_BC_oil_type
306) ! Constant: for running tests with a fixed relative permeability
307) type, public, extends(rel_perm_func_base_type) :: rel_perm_func_constant_type
308) PetscReal :: kr
309) contains
310) procedure, public :: Verify => RPFConstantVerify
311) procedure, public :: RelativePermeability => RPF_ConstantRelPerm
312) end type rel_perm_func_constant_type
313) ! End Relative Permeability Functions ---------------------------------------
314)
315) type, public :: characteristic_curves_type
316) character(len=MAXWORDLENGTH) :: name
317) PetscBool :: print_me
318) PetscBool :: test
319) class(sat_func_base_type), pointer :: saturation_function
320) class(rel_perm_func_base_type), pointer :: liq_rel_perm_function
321) class(rel_perm_func_base_type), pointer :: gas_rel_perm_function
322) class(rel_perm_func_base_type), pointer :: oil_rel_perm_function
323) class(characteristic_curves_type), pointer :: next
324) end type characteristic_curves_type
325)
326) type, public :: characteristic_curves_ptr_type
327) class(characteristic_curves_type), pointer :: ptr
328) end type characteristic_curves_ptr_type
329)
330) public :: CharacteristicCurvesCreate, &
331) CharacteristicCurvesRead, &
332) CharacteristicCurvesAddToList, &
333) CharCurvesConvertListToArray, &
334) CharacteristicCurvesGetID, &
335) CharCurvesGetGetResidualSats, &
336) CharacteristicCurvesDestroy, &
337) CharCurvesInputRecord, &
338) ! required to be public for unit tests - Heeho Park
339) SF_VG_Create, &
340) SF_BC_Create, &
341) SF_Linear_Create, &
342) SF_BF_KRP9_Create, &
343) SF_BF_KRP4_Create, &
344) SF_BF_KRP11_Create, &
345) SF_BF_KRP12_Create, &
346) RPF_Mualem_VG_Liq_Create, &
347) RPF_Mualem_VG_Gas_Create, &
348) RPF_Burdine_BC_Liq_Create, &
349) RPF_Burdine_BC_Gas_Create, &
350) RPF_TOUGH2_IRP7_Gas_Create, &
351) RPF_Mualem_BC_Liq_Create, &
352) RPF_Mualem_BC_Gas_Create, &
353) RPF_Burdine_VG_Liq_Create, &
354) RPF_Burdine_VG_Gas_Create, &
355) RPF_Mualem_Linear_Liq_Create, &
356) RPF_Mualem_Linear_Gas_Create, &
357) RPF_Burdine_Linear_Liq_Create, &
358) RPF_Burdine_Linear_Gas_Create, &
359) RPF_BRAGFLO_KRP9_Liq_Create, &
360) RPF_BRAGFLO_KRP9_Gas_Create, &
361) RPF_BRAGFLO_KRP4_Liq_Create, &
362) RPF_BRAGFLO_KRP4_Gas_Create, &
363) RPF_BRAGFLO_KRP11_Liq_Create, &
364) RPF_BRAGFLO_KRP11_Gas_Create, &
365) RPF_BRAGFLO_KRP12_Liq_Create, &
366) RPF_BRAGFLO_KRP12_Gas_Create, &
367) PolynomialCreate
368)
369) contains
370)
371) ! ************************************************************************** !
372)
373) ! Begin Characteristic Curves
374) function CharacteristicCurvesCreate()
375) !
376) ! Creates a characteristic curve object that holds parameters and pointers
377) ! to functions for calculating saturation, capillary pressure, relative
378) ! permeability, etc.
379) !
380) ! Author: Glenn Hammond
381) ! Date: 09/23/14
382) !
383)
384) implicit none
385)
386) class(characteristic_curves_type), pointer :: CharacteristicCurvesCreate
387)
388) class(characteristic_curves_type), pointer :: characteristic_curves
389)
390) allocate(characteristic_curves)
391) characteristic_curves%name = ''
392) characteristic_curves%print_me = PETSC_FALSE
393) characteristic_curves%test = PETSC_FALSE
394) nullify(characteristic_curves%saturation_function)
395) nullify(characteristic_curves%liq_rel_perm_function)
396) nullify(characteristic_curves%gas_rel_perm_function)
397) nullify(characteristic_curves%oil_rel_perm_function)
398) nullify(characteristic_curves%next)
399)
400) CharacteristicCurvesCreate => characteristic_curves
401)
402) end function CharacteristicCurvesCreate
403)
404) ! ************************************************************************** !
405)
406) subroutine CharacteristicCurvesRead(this,input,option)
407) !
408) ! Reads in contents of a saturation_function card
409) !
410) ! Author: Glenn Hammond
411) ! Date: 01/21/09
412) !
413)
414) use Option_module
415) use Input_Aux_module
416) use String_module
417)
418) implicit none
419)
420) class(characteristic_curves_type) :: this
421) type(input_type), pointer :: input
422) type(option_type) :: option
423) PetscInt :: iphase
424)
425) character(len=MAXWORDLENGTH) :: keyword, word, phase_keyword
426) character(len=MAXSTRINGLENGTH) :: error_string
427) class(rel_perm_func_base_type), pointer :: rel_perm_function_ptr
428)
429) input%ierr = 0
430) error_string = 'CHARACTERISTIC_CURVES'
431) do
432)
433) call InputReadPflotranString(input,option)
434)
435) if (InputCheckExit(input,option)) exit
436)
437) call InputReadWord(input,option,keyword,PETSC_TRUE)
438) call InputErrorMsg(input,option,'keyword',error_string)
439) call StringToUpper(keyword)
440)
441) select case(trim(keyword))
442) case('SATURATION_FUNCTION')
443) ! replacing read word that is capable of database lookup
444) ! call InputReadWord(input,option,word,PETSC_TRUE)
445) call InputReadWordDbaseCompatible(input,option,word,PETSC_TRUE)
446) call InputErrorMsg(input,option,'saturation_function_type', &
447) error_string)
448) call StringToUpper(word)
449) select case(word)
450) case('VAN_GENUCHTEN')
451) this%saturation_function => SF_VG_Create()
452) case('BROOKS_COREY')
453) this%saturation_function => SF_BC_Create()
454) case('LINEAR')
455) this%saturation_function => SF_Linear_Create()
456) case('BRAGFLO_KRP9')
457) this%saturation_function => SF_BF_KRP9_Create()
458) case('BRAGFLO_KRP4')
459) this%saturation_function => SF_BF_KRP4_Create()
460) case('BRAGFLO_KRP11')
461) this%saturation_function => SF_BF_KRP11_Create()
462) case('BRAGFLO_KRP12')
463) this%saturation_function => SF_BF_KRP12_Create()
464) case default
465) call InputKeywordUnrecognized(word,'SATURATION_FUNCTION',option)
466) end select
467) call SaturationFunctionRead(this%saturation_function,input,option)
468) case('PERMEABILITY_FUNCTION')
469) nullify(rel_perm_function_ptr)
470) phase_keyword = 'NONE'
471) ! replacing read word that is capable of database lookup
472) ! call InputReadWord(input,option,word,PETSC_TRUE)
473) call InputReadWordDbaseCompatible(input,option,word,PETSC_TRUE)
474) call InputErrorMsg(input,option,'permeability_function_type', &
475) error_string)
476) call StringToUpper(word)
477) select case(word)
478) case('MUALEM','MUALEM_VG_LIQ')
479) rel_perm_function_ptr => RPF_Mualem_VG_Liq_Create()
480) case('MUALEM_VG_GAS')
481) rel_perm_function_ptr => RPF_Mualem_VG_Gas_Create()
482) phase_keyword = 'GAS'
483) case('BURDINE','BURDINE_BC_LIQ')
484) rel_perm_function_ptr => RPF_Burdine_BC_Liq_Create()
485) case('BURDINE_BC_GAS')
486) rel_perm_function_ptr => RPF_Burdine_BC_Gas_Create()
487) phase_keyword = 'GAS'
488) case('TOUGH2_IRP7_LIQ')
489) rel_perm_function_ptr => RPF_Mualem_VG_Liq_Create()
490) case('TOUGH2_IRP7_GAS')
491) rel_perm_function_ptr => RPF_TOUGH2_IRP7_Gas_Create()
492) phase_keyword = 'GAS'
493) case('MUALEM_BC_LIQ')
494) rel_perm_function_ptr => RPF_Mualem_BC_Liq_Create()
495) case('MUALEM_BC_GAS')
496) rel_perm_function_ptr => RPF_Mualem_BC_Gas_Create()
497) phase_keyword = 'GAS'
498) case('BURDINE_VG_LIQ')
499) rel_perm_function_ptr => RPF_Burdine_VG_Liq_Create()
500) case('BURDINE_VG_GAS')
501) rel_perm_function_ptr => RPF_Burdine_VG_Gas_Create()
502) phase_keyword = 'GAS'
503) case('MUALEM_LINEAR_LIQ')
504) rel_perm_function_ptr => RPF_Mualem_Linear_Liq_Create()
505) case('MUALEM_LINEAR_GAS')
506) rel_perm_function_ptr => RPF_Mualem_Linear_Gas_Create()
507) phase_keyword = 'GAS'
508) case('BURDINE_LINEAR_LIQ')
509) rel_perm_function_ptr => RPF_Burdine_Linear_Liq_Create()
510) case('BURDINE_LINEAR_GAS')
511) rel_perm_function_ptr => RPF_Burdine_Linear_Gas_Create()
512) phase_keyword = 'GAS'
513) case('BRAGFLO_KRP9_LIQ')
514) rel_perm_function_ptr => RPF_BRAGFLO_KRP9_Liq_Create()
515) case('BRAGFLO_KRP9_GAS')
516) rel_perm_function_ptr => RPF_BRAGFLO_KRP9_Gas_Create()
517) case('BRAGFLO_KRP4_LIQ')
518) rel_perm_function_ptr => RPF_BRAGFLO_KRP4_Liq_Create()
519) case('BRAGFLO_KRP4_GAS')
520) rel_perm_function_ptr => RPF_BRAGFLO_KRP4_Gas_Create()
521) phase_keyword = 'GAS'
522) case('BRAGFLO_KRP11_LIQ')
523) rel_perm_function_ptr => RPF_BRAGFLO_KRP11_Liq_Create()
524) case('BRAGFLO_KRP11_GAS')
525) rel_perm_function_ptr => RPF_BRAGFLO_KRP11_Gas_Create()
526) phase_keyword = 'GAS'
527) case('BRAGFLO_KRP12_LIQ')
528) rel_perm_function_ptr => RPF_BRAGFLO_KRP12_Liq_Create()
529) case('BRAGFLO_KRP12_GAS')
530) rel_perm_function_ptr => RPF_BRAGFLO_KRP12_Gas_Create()
531) phase_keyword = 'GAS'
532) case('TOUGH2_LINEAR_OIL')
533) rel_perm_function_ptr => RPF_TOUGH2_Linear_Oil_Create()
534) phase_keyword = 'OIL'
535) case('MOD_BC_LIQ')
536) rel_perm_function_ptr => RPF_Mod_BC_Liq_Create()
537) !phase_keyword = 'LIQUID'
538) case('MOD_BC_OIL')
539) rel_perm_function_ptr => RPF_Mod_BC_Oil_Create()
540) phase_keyword = 'OIL'
541) case('CONSTANT')
542) rel_perm_function_ptr => RPF_Constant_Create()
543) case default
544) call InputKeywordUnrecognized(word,'PERMEABILITY_FUNCTION',option)
545) end select
546) call PermeabilityFunctionRead(rel_perm_function_ptr,phase_keyword, &
547) input,option)
548) ! if PHASE is specified, have to align correct pointer
549) select case(phase_keyword)
550) case('GAS')
551) this%gas_rel_perm_function => rel_perm_function_ptr
552) case('LIQUID')
553) this%liq_rel_perm_function => rel_perm_function_ptr
554) case('OIL')
555) this%oil_rel_perm_function => rel_perm_function_ptr
556) ! PO: gas_rel_perm_fucntion initiated oil_rel_perm_function
557) ! to pass the verification in CharacteristicCurvesVerify
558) ! in case gas_rel_perm_function is not defined in the input
559) ! We should change CharacteristicCurvesVerify instead
560) this%gas_rel_perm_function => rel_perm_function_ptr
561) case('NONE')
562) this%gas_rel_perm_function => rel_perm_function_ptr
563) this%liq_rel_perm_function => rel_perm_function_ptr
564) case default
565) call InputKeywordUnrecognized(word, &
566) 'PERMEABILITY_FUNCTION,PHASE',option)
567) end select
568) case('TEST')
569) this%test = PETSC_TRUE
570) case('DEFAULT')
571) this%saturation_function => SF_Default_Create()
572) this%liq_rel_perm_function => RPF_Default_Create()
573) this%gas_rel_perm_function => this%liq_rel_perm_function
574) case default
575) call InputKeywordUnrecognized(keyword,'charateristic_curves',option)
576) end select
577) enddo
578)
579) call CharacteristicCurvesVerify(this,option)
580)
581) end subroutine CharacteristicCurvesRead
582)
583) ! ************************************************************************** !
584)
585) subroutine SaturationFunctionRead(saturation_function,input,option)
586) !
587) ! Reads in contents of a SATURATION_FUNCTION block
588) !
589) use Option_module
590) use Input_Aux_module
591) use String_module
592)
593) implicit none
594)
595) class(sat_func_base_type) :: saturation_function
596) type(input_type), pointer :: input
597) type(option_type) :: option
598)
599) character(len=MAXWORDLENGTH) :: keyword
600) character(len=MAXSTRINGLENGTH) :: error_string
601) PetscBool :: found
602) PetscBool :: smooth
603)
604) input%ierr = 0
605) smooth = PETSC_FALSE
606) error_string = 'CHARACTERISTIC_CURVES,SATURATION_FUNCTION,'
607) select type(sf => saturation_function)
608) class is(sat_func_VG_type)
609) error_string = trim(error_string) // 'VAN_GENUCHTEN'
610) class is(sat_func_BC_type)
611) error_string = trim(error_string) // 'BROOKS_COREY'
612) class is(sat_func_Linear_type)
613) error_string = trim(error_string) // 'LINEAR'
614) end select
615) do
616) call InputReadPflotranString(input,option)
617) if (InputCheckExit(input,option)) exit
618)
619) call InputReadWord(input,option,keyword,PETSC_TRUE)
620) call InputErrorMsg(input,option,'keyword',error_string)
621) call StringToUpper(keyword)
622)
623) ! base
624) found = PETSC_TRUE
625) select case(keyword)
626) case('LIQUID_RESIDUAL_SATURATION')
627) call InputReadDouble(input,option,saturation_function%Sr)
628) call InputErrorMsg(input,option,'liquid residual saturation', &
629) error_string)
630) case('MAX_CAPILLARY_PRESSURE')
631) call InputReadDouble(input,option,saturation_function%pcmax)
632) call InputErrorMsg(input,option,'maximum capillary pressure', &
633) error_string)
634) case('SMOOTH')
635) smooth = PETSC_TRUE
636) case default
637) found = PETSC_FALSE
638) end select
639)
640) if (found) cycle
641)
642) select type(sf => saturation_function)
643) class is(sat_func_VG_type)
644) select case(keyword)
645) case('M')
646) call InputReadDouble(input,option,sf%m)
647) call InputErrorMsg(input,option,'m',error_string)
648) case('ALPHA')
649) call InputReadDouble(input,option,sf%alpha)
650) call InputErrorMsg(input,option,'alpha',error_string)
651) case default
652) call InputKeywordUnrecognized(keyword, &
653) 'van Genuchten saturation function',option)
654) end select
655) class is(sat_func_BC_type)
656) select case(keyword)
657) case('LAMBDA')
658) call InputReadDouble(input,option,sf%lambda)
659) call InputErrorMsg(input,option,'lambda',error_string)
660) case('ALPHA')
661) call InputReadDouble(input,option,sf%alpha)
662) call InputErrorMsg(input,option,'alpha',error_string)
663) case default
664) call InputKeywordUnrecognized(keyword, &
665) 'Brooks-Corey saturation function',option)
666) end select
667) class is(sat_func_Linear_type)
668) select case(keyword)
669) case('ALPHA')
670) call InputReadDouble(input,option,sf%alpha)
671) call InputErrorMsg(input,option,'alpha',error_string)
672) case default
673) call InputKeywordUnrecognized(keyword, &
674) 'Linear saturation function',option)
675) end select
676) class is(sat_func_BF_KRP4_type)
677) select case(keyword)
678) case('LAMBDA')
679) call InputReadDouble(input,option,sf%lambda)
680) call InputErrorMsg(input,option,'lambda',error_string)
681) case('ALPHA')
682) call InputReadDouble(input,option,sf%alpha)
683) call InputErrorMsg(input,option,'alpha',error_string)
684) case('GAS_RESIDUAL_SATURATION')
685) call InputReadDouble(input,option,sf%Srg)
686) call InputErrorMsg(input,option,'Srg',error_string)
687) case('KPC')
688) call InputReadInt(input,option,sf%pcmax_flag)
689) call InputErrorMsg(input,option,'pcmax_flag',error_string)
690) case default
691) call InputKeywordUnrecognized(keyword, &
692) 'Brooks-Corey saturation function',option)
693) end select
694) class is(sat_func_BF_KRP12_type)
695) select case(keyword)
696) case('LAMBDA')
697) call InputReadDouble(input,option,sf%lambda)
698) call InputErrorMsg(input,option,'lambda',error_string)
699) case('ALPHA')
700) call InputReadDouble(input,option,sf%alpha)
701) call InputErrorMsg(input,option,'alpha',error_string)
702) case('GAS_RESIDUAL_SATURATION')
703) call InputReadDouble(input,option,sf%Srg)
704) call InputErrorMsg(input,option,'Srg',error_string)
705) case('SOCMIN')
706) call InputReadDouble(input,option,sf%socmin)
707) call InputErrorMsg(input,option,'socmin',error_string)
708) case('SOCEFFMIN')
709) call InputReadDouble(input,option,sf%soceffmin)
710) call InputErrorMsg(input,option,'soceffmin',error_string)
711) case default
712) call InputKeywordUnrecognized(keyword, &
713) 'Brooks-Corey saturation function',option)
714) end select
715) class default
716) option%io_buffer = 'Read routine not implemented for saturation ' // &
717) 'function class.'
718) call printErrMsg(option)
719) end select
720) enddo
721)
722) if (smooth) then
723) call saturation_function%SetupPolynomials(option,error_string)
724) endif
725)
726) select type(sf => saturation_function)
727) class is(sat_func_VG_type)
728) class is(sat_func_BC_type)
729) if (.not.smooth) then
730) option%io_buffer = 'Brooks-Corey saturation function is being used ' // &
731) 'without SMOOTH option.'
732) call printWrnMsg(option)
733) endif
734) class is(sat_func_Linear_type)
735) class is(sat_func_BF_KRP4_type)
736) if (.not.smooth) then
737) option%io_buffer = 'Brooks-Corey saturation function is being used ' // &
738) 'without SMOOTH option.'
739) call printWrnMsg(option)
740) endif
741) class is(sat_func_BF_KRP12_type)
742) if (.not.smooth) then
743) option%io_buffer = 'Brooks-Corey saturation function is being used ' // &
744) 'without SMOOTH option.'
745) call printWrnMsg(option)
746) endif
747) end select
748)
749) end subroutine SaturationFunctionRead
750)
751) ! ************************************************************************** !
752)
753) subroutine PermeabilityFunctionRead(permeability_function,phase_keyword, &
754) input,option)
755) !
756) ! Reads in contents of a PERMEABILITY_FUNCTION block
757) !
758) use Option_module
759) use Input_Aux_module
760) use String_module
761)
762) implicit none
763)
764) class(rel_perm_func_base_type) :: permeability_function
765) character(len=MAXWORDLENGTH) :: phase_keyword
766) type(input_type), pointer :: input
767) type(option_type) :: option
768)
769) character(len=MAXWORDLENGTH) :: keyword, new_phase_keyword
770) character(len=MAXSTRINGLENGTH) :: error_string
771) PetscBool :: found
772) PetscBool :: smooth
773)
774) input%ierr = 0
775) smooth = PETSC_FALSE
776) new_phase_keyword = 'NONE'
777) error_string = 'CHARACTERISTIC_CURVES,PERMEABILITY_FUNCTION,'
778) select type(rpf => permeability_function)
779) class is(rpf_Mualem_VG_liq_type)
780) error_string = trim(error_string) // 'MUALEM_VG_LIQ'
781) class is(rpf_Mualem_VG_gas_type)
782) error_string = trim(error_string) // 'MUALEM_VG_GAS'
783) class is(rpf_Burdine_BC_liq_type)
784) error_string = trim(error_string) // 'BURDINE_BC_LIQ'
785) class is(rpf_Burdine_BC_gas_type)
786) error_string = trim(error_string) // 'BURDINE_BC_GAS'
787) class is(rpf_TOUGH2_IRP7_gas_type)
788) error_string = trim(error_string) // 'TOUGH2_IRP7_GAS'
789) class is(rpf_Mualem_BC_liq_type)
790) error_string = trim(error_string) // 'MUALEM_BC_LIQ'
791) class is(rpf_Mualem_BC_gas_type)
792) error_string = trim(error_string) // 'MUALEM_BC_GAS'
793) class is(rpf_Burdine_VG_liq_type)
794) error_string = trim(error_string) // 'BURDINE_VG_LIQ'
795) class is(rpf_Burdine_VG_gas_type)
796) error_string = trim(error_string) // 'BURDINE_VG_GAS'
797) class is(rpf_Mualem_Linear_liq_type)
798) error_string = trim(error_string) // 'MUALEM_Linear_LIQ'
799) class is(rpf_Mualem_Linear_gas_type)
800) error_string = trim(error_string) // 'MUALEM_Linear_GAS'
801) class is(rpf_Burdine_Linear_liq_type)
802) error_string = trim(error_string) // 'BURDINE_Linear_LIQ'
803) class is(rpf_Burdine_Linear_gas_type)
804) error_string = trim(error_string) // 'BURDINE_Linear_GAS'
805) class is(rpf_BRAGFLO_KRP9_liq_type)
806) error_string = trim(error_string) // 'BURDINE_BF_KRP9_LIQ'
807) class is(rpf_BRAGFLO_KRP9_gas_type)
808) error_string = trim(error_string) // 'BURDINE_BF_KRP9_GAS'
809) class is(rpf_BRAGFLO_KRP4_liq_type)
810) error_string = trim(error_string) // 'BURDINE_BF_KRP4_LIQ'
811) class is(rpf_BRAGFLO_KRP4_gas_type)
812) error_string = trim(error_string) // 'BURDINE_BF_KRP4_GAS'
813) class is(rpf_BRAGFLO_KRP11_liq_type)
814) error_string = trim(error_string) // 'BURDINE_BF_KRP11_LIQ'
815) class is(rpf_BRAGFLO_KRP11_gas_type)
816) error_string = trim(error_string) // 'BURDINE_BF_KRP11_GAS'
817) class is(rpf_BRAGFLO_KRP12_liq_type)
818) error_string = trim(error_string) // 'BURDINE_BF_KRP12_LIQ'
819) class is(rpf_BRAGFLO_KRP12_gas_type)
820) error_string = trim(error_string) // 'BURDINE_BF_KRP12_GAS'
821) class is(rpf_TOUGH2_Linear_oil_type)
822) error_string = trim(error_string) // 'TOUGH2_Linear_OIL'
823) class is(rpf_mod_BC_liq_type)
824) error_string = trim(error_string) // 'Mod_BC_LIQ'
825) class is(rpf_mod_BC_oil_type)
826) error_string = trim(error_string) // 'Mod_BC_OIL'
827) class is(rel_perm_func_constant_type)
828) error_string = trim(error_string) // 'CONSTANT'
829) end select
830)
831) do
832) call InputReadPflotranString(input,option)
833) if (InputCheckExit(input,option)) exit
834)
835) call InputReadWord(input,option,keyword,PETSC_TRUE)
836) call InputErrorMsg(input,option,'keyword',error_string)
837) call StringToUpper(keyword)
838)
839) ! base
840) found = PETSC_TRUE
841) select case(keyword)
842) case('LIQUID_RESIDUAL_SATURATION')
843) call InputReadDouble(input,option,permeability_function%Sr)
844) call InputErrorMsg(input,option,'residual_saturation',error_string)
845) case('PHASE')
846) call InputReadWord(input,option,new_phase_keyword,PETSC_TRUE)
847) call InputErrorMsg(input,option,'phase',error_string)
848) call StringToUpper(phase_keyword)
849) case('SMOOTH')
850) smooth = PETSC_TRUE
851) case default
852) found = PETSC_FALSE
853) end select
854)
855) if (found) cycle
856)
857) ! we assume liquid phase if PHASE keyword is not present.
858) select type(rpf => permeability_function)
859) class is(rpf_Mualem_VG_liq_type)
860) select case(keyword)
861) case('M')
862) call InputReadDouble(input,option,rpf%m)
863) call InputErrorMsg(input,option,'m',error_string)
864) case default
865) call InputKeywordUnrecognized(keyword, &
866) 'Mualem van Genuchten liquid relative permeability function', &
867) option)
868) end select
869) class is(rpf_Mualem_VG_gas_type)
870) select case(keyword)
871) case('M')
872) call InputReadDouble(input,option,rpf%m)
873) call InputErrorMsg(input,option,'m',error_string)
874) case('GAS_RESIDUAL_SATURATION')
875) call InputReadDouble(input,option,rpf%Srg)
876) call InputErrorMsg(input,option,'Srg',error_string)
877) case default
878) call InputKeywordUnrecognized(keyword, &
879) 'Mualem van Genuchten gas relative permeability function', &
880) option)
881) end select
882) class is(rpf_Burdine_BC_liq_type)
883) select case(keyword)
884) case('LAMBDA')
885) call InputReadDouble(input,option,rpf%lambda)
886) call InputErrorMsg(input,option,'lambda',error_string)
887) case default
888) call InputKeywordUnrecognized(keyword, &
889) 'Burdine Brooks-Corey liquid relative permeability function', &
890) option)
891) end select
892) class is(rpf_Burdine_BC_gas_type)
893) select case(keyword)
894) case('LAMBDA')
895) call InputReadDouble(input,option,rpf%lambda)
896) call InputErrorMsg(input,option,'lambda',error_string)
897) case('GAS_RESIDUAL_SATURATION')
898) call InputReadDouble(input,option,rpf%Srg)
899) call InputErrorMsg(input,option,'Srg',error_string)
900) case default
901) call InputKeywordUnrecognized(keyword, &
902) 'Burdine Brooks-Corey gas relative permeability function', &
903) option)
904) end select
905) class is(rpf_TOUGH2_IRP7_gas_type)
906) select case(keyword)
907) case('M')
908) call InputReadDouble(input,option,rpf%m)
909) call InputErrorMsg(input,option,'m',error_string)
910) case('GAS_RESIDUAL_SATURATION')
911) call InputReadDouble(input,option,rpf%Srg)
912) call InputErrorMsg(input,option,'Srg',error_string)
913) case default
914) call InputKeywordUnrecognized(keyword, &
915) 'TOUGH2 IRP7 gas relative permeability function',option)
916) end select
917) class is(rpf_Mualem_BC_liq_type)
918) select case(keyword)
919) case('LAMBDA')
920) call InputReadDouble(input,option,rpf%lambda)
921) call InputErrorMsg(input,option,'lambda',error_string)
922) case default
923) call InputKeywordUnrecognized(keyword, &
924) 'Mualem Brooks-Corey liquid relative permeability function', &
925) option)
926) end select
927) class is(rpf_Mualem_BC_gas_type)
928) select case(keyword)
929) case('LAMBDA')
930) call InputReadDouble(input,option,rpf%lambda)
931) call InputErrorMsg(input,option,'lambda',error_string)
932) case('GAS_RESIDUAL_SATURATION')
933) call InputReadDouble(input,option,rpf%Srg)
934) call InputErrorMsg(input,option,'Srg',error_string)
935) case default
936) call InputKeywordUnrecognized(keyword, &
937) 'Mualem Brooks-Corey gas relative permeability function', &
938) option)
939) end select
940) class is(rpf_Burdine_VG_liq_type)
941) select case(keyword)
942) case('M')
943) call InputReadDouble(input,option,rpf%m)
944) call InputErrorMsg(input,option,'m',error_string)
945) case default
946) call InputKeywordUnrecognized(keyword, &
947) 'Burdine van Genuchten liquid relative permeability function', &
948) option)
949) end select
950) class is(rpf_Burdine_VG_gas_type)
951) select case(keyword)
952) case('M')
953) call InputReadDouble(input,option,rpf%m)
954) call InputErrorMsg(input,option,'m',error_string)
955) case('GAS_RESIDUAL_SATURATION')
956) call InputReadDouble(input,option,rpf%Srg)
957) call InputErrorMsg(input,option,'Srg',error_string)
958) case default
959) call InputKeywordUnrecognized(keyword, &
960) 'Burdine van Genuchten gas relative permeability function', &
961) option)
962) end select
963) class is(rpf_Mualem_Linear_liq_type)
964) select case(keyword)
965) case('MAX_CAPILLARY_PRESSURE')
966) call InputReadDouble(input,option,rpf%pcmax)
967) call InputErrorMsg(input,option,'max_capillary_pressure',error_string)
968) case('ALPHA')
969) call InputReadDouble(input,option,rpf%alpha)
970) call InputErrorMsg(input,option,'alpha',error_string)
971) case default
972) call InputKeywordUnrecognized(keyword, &
973) 'Mualem Linear liquid relative permeability function', &
974) option)
975) end select
976) class is(rpf_Mualem_Linear_gas_type)
977) select case(keyword)
978) case('GAS_RESIDUAL_SATURATION')
979) call InputReadDouble(input,option,rpf%Srg)
980) call InputErrorMsg(input,option,'Srg',error_string)
981) case('MAX_CAPILLARY_PRESSURE')
982) call InputReadDouble(input,option,rpf%pcmax)
983) call InputErrorMsg(input,option,'max_capillary_pressure',error_string)
984) case('ALPHA')
985) call InputReadDouble(input,option,rpf%alpha)
986) call InputErrorMsg(input,option,'alpha',error_string)
987) case default
988) call InputKeywordUnrecognized(keyword, &
989) 'Mualem Linear gas relative permeability function', &
990) option)
991) end select
992) class is(rpf_Burdine_Linear_liq_type)
993) select case(keyword)
994) case default
995) call InputKeywordUnrecognized(keyword, &
996) 'Burdine Linear liquid relative permeability function', &
997) option)
998) end select
999) class is(rpf_Burdine_Linear_gas_type)
1000) select case(keyword)
1001) case('GAS_RESIDUAL_SATURATION')
1002) call InputReadDouble(input,option,rpf%Srg)
1003) call InputErrorMsg(input,option,'Srg',error_string)
1004) case default
1005) call InputKeywordUnrecognized(keyword, &
1006) 'Burdine Linear gas relative permeability function', &
1007) option)
1008) end select
1009) class is(rpf_BRAGFLO_KRP9_liq_type)
1010) select case(keyword)
1011) case default
1012) call InputKeywordUnrecognized(keyword, &
1013) 'BRAGFLO KRP9 liq relative permeability function', &
1014) option)
1015) end select
1016) class is(rpf_BRAGFLO_KRP9_gas_type)
1017) select case(keyword)
1018) case('GAS_RESIDUAL_SATURATION')
1019) call InputReadDouble(input,option,rpf%Srg)
1020) call InputErrorMsg(input,option,'Srg',error_string)
1021) case default
1022) call InputKeywordUnrecognized(keyword, &
1023) 'BRAGFLO KRP9 gas relative permeability function', &
1024) option)
1025) end select
1026) class is(rpf_BRAGFLO_KRP4_liq_type)
1027) select case(keyword)
1028) case('LAMBDA')
1029) call InputReadDouble(input,option,rpf%lambda)
1030) call InputErrorMsg(input,option,'lambda',error_string)
1031) case default
1032) call InputKeywordUnrecognized(keyword, &
1033) 'BRAGFLO KRP4 liq relative permeability function', &
1034) option)
1035) end select
1036) class is(rpf_BRAGFLO_KRP4_gas_type)
1037) select case(keyword)
1038) case('LAMBDA')
1039) call InputReadDouble(input,option,rpf%lambda)
1040) call InputErrorMsg(input,option,'lambda',error_string)
1041) case('GAS_RESIDUAL_SATURATION')
1042) call InputReadDouble(input,option,rpf%Srg)
1043) call InputErrorMsg(input,option,'Srg',error_string)
1044) case default
1045) call InputKeywordUnrecognized(keyword, &
1046) 'BRAGFLO KRP4 gas relative permeability function', &
1047) option)
1048) end select
1049) class is(rpf_BRAGFLO_KRP11_liq_type)
1050) select case(keyword)
1051) case('TOLC')
1052) call InputReadDouble(input,option,rpf%tolc)
1053) call InputErrorMsg(input,option,'tolc',error_string)
1054) case default
1055) call InputKeywordUnrecognized(keyword, &
1056) 'BRAGFLO KRP11 liq relative permeability function', &
1057) option)
1058) end select
1059) class is(rpf_BRAGFLO_KRP11_gas_type)
1060) select case(keyword)
1061) case('TOLC')
1062) call InputReadDouble(input,option,rpf%tolc)
1063) call InputErrorMsg(input,option,'tolc',error_string)
1064) case('GAS_RESIDUAL_SATURATION')
1065) call InputReadDouble(input,option,rpf%Srg)
1066) call InputErrorMsg(input,option,'Srg',error_string)
1067) case default
1068) call InputKeywordUnrecognized(keyword, &
1069) 'BRAGFLO KRP11 gas relative permeability function', &
1070) option)
1071) end select
1072) class is(rpf_BRAGFLO_KRP12_liq_type)
1073) select case(keyword)
1074) case('LAMBDA')
1075) call InputReadDouble(input,option,rpf%lambda)
1076) call InputErrorMsg(input,option,'lambda',error_string)
1077) case default
1078) call InputKeywordUnrecognized(keyword, &
1079) 'BRAGFLO KRP4 liq relative permeability function', &
1080) option)
1081) end select
1082) class is(rpf_BRAGFLO_KRP12_gas_type)
1083) select case(keyword)
1084) case('LAMBDA')
1085) call InputReadDouble(input,option,rpf%lambda)
1086) call InputErrorMsg(input,option,'lambda',error_string)
1087) case('GAS_RESIDUAL_SATURATION')
1088) call InputReadDouble(input,option,rpf%Srg)
1089) call InputErrorMsg(input,option,'Srg',error_string)
1090) case default
1091) call InputKeywordUnrecognized(keyword, &
1092) 'BRAGFLO KRP4 gas relative permeability function', &
1093) option)
1094) end select
1095) class is(rpf_TOUGH2_Linear_oil_type)
1096) select case(keyword)
1097) case('OIL_RESIDUAL_SATURATION')
1098) call InputReadDouble(input,option,rpf%Sro)
1099) call InputErrorMsg(input,option,'Sro',error_string)
1100) case default
1101) call InputKeywordUnrecognized(keyword, &
1102) 'TOUGH2 LINEAR oil relative permeability function', &
1103) option)
1104) end select
1105) class is(rpf_mod_BC_liq_type)
1106) select case(keyword)
1107) case('M')
1108) call InputReadDouble(input,option,rpf%m)
1109) call InputErrorMsg(input,option,'m - power',error_string)
1110) case('OIL_RESIDUAL_SATURATION')
1111) call InputReadDouble(input,option,rpf%Sro)
1112) call InputErrorMsg(input,option,'Sro',error_string)
1113) case('GAS_RESIDUAL_SATURATION')
1114) call InputReadDouble(input,option,rpf%Srg)
1115) call InputErrorMsg(input,option,'Srg',error_string)
1116) case('LIQUID_MAX_REL_PERM')
1117) call InputReadDouble(input,option,rpf%kr_max)
1118) call InputErrorMsg(input,option,'kr_max',error_string)
1119) case default
1120) call InputKeywordUnrecognized(keyword, &
1121) 'Mod BC liq relative permeability function', &
1122) option)
1123) end select
1124) class is(rpf_mod_BC_oil_type)
1125) select case(keyword)
1126) case('M')
1127) call InputReadDouble(input,option,rpf%m)
1128) call InputErrorMsg(input,option,'m - power',error_string)
1129) case('OIL_RESIDUAL_SATURATION')
1130) call InputReadDouble(input,option,rpf%Sro)
1131) call InputErrorMsg(input,option,'Sro',error_string)
1132) case('GAS_RESIDUAL_SATURATION')
1133) call InputReadDouble(input,option,rpf%Srg)
1134) call InputErrorMsg(input,option,'Srg',error_string)
1135) case('OIL_MAX_REL_PERM')
1136) call InputReadDouble(input,option,rpf%kr_max)
1137) call InputErrorMsg(input,option,'kr_max',error_string)
1138) case default
1139) call InputKeywordUnrecognized(keyword, &
1140) 'Mod BC oil relative permeability function', &
1141) option)
1142) end select
1143) class is(rel_perm_func_constant_type)
1144) select case(keyword)
1145) case('RESIDUAL_SATURATION')
1146) call InputReadDouble(input,option,rpf%Sr)
1147) call InputErrorMsg(input,option,'Sr',error_string)
1148) case('RELATIVE_PERMEABILITY')
1149) call InputReadDouble(input,option,rpf%kr)
1150) call InputErrorMsg(input,option,'kr',error_string)
1151) case default
1152) call InputKeywordUnrecognized(keyword, &
1153) 'Constant relative permeability function', &
1154) option)
1155) end select
1156) class default
1157) option%io_buffer = 'Read routine not implemented for relative ' // &
1158) 'permeability function class.'
1159) call printErrMsg(option)
1160) end select
1161) enddo
1162)
1163) ! check to ensure that the phase is correct if phase_keyword was set to
1164) ! something other than 'NONE' prior to the call of this subroutine
1165) if (StringCompare('NONE',phase_keyword)) then
1166) phase_keyword = new_phase_keyword
1167) else if (.not.StringCompare('NONE',new_phase_keyword)) then
1168) if (.not.StringCompare(phase_keyword,new_phase_keyword)) then
1169) option%io_buffer = 'Relative permeability function has been set ' // &
1170) 'for the wrong phase (' // trim(phase_keyword) // ' vs ' // &
1171) trim(new_phase_keyword) // ').'
1172) call printErrMsg(option)
1173) endif
1174) endif
1175)
1176) if (smooth) then
1177) call permeability_function%SetupPolynomials(option,error_string)
1178) endif
1179)
1180) end subroutine PermeabilityFunctionRead
1181)
1182) ! ************************************************************************** !
1183)
1184) subroutine CharacteristicCurvesAddToList(new_characteristic_curves,list)
1185) !
1186) ! Adds a characteristic curves object to linked list
1187) !
1188) ! Author: Glenn Hammond
1189) ! Date: 11/02/07
1190) !
1191)
1192) implicit none
1193)
1194) class(characteristic_curves_type), pointer :: new_characteristic_curves
1195) class(characteristic_curves_type), pointer :: list
1196)
1197) class(characteristic_curves_type), pointer :: cur_characteristic_curves
1198)
1199) if (associated(list)) then
1200) cur_characteristic_curves => list
1201) ! loop to end of list
1202) do
1203) if (.not.associated(cur_characteristic_curves%next)) exit
1204) cur_characteristic_curves => cur_characteristic_curves%next
1205) enddo
1206) cur_characteristic_curves%next => new_characteristic_curves
1207) else
1208) list => new_characteristic_curves
1209) endif
1210)
1211) end subroutine CharacteristicCurvesAddToList
1212)
1213) ! ************************************************************************** !
1214)
1215) subroutine CharCurvesConvertListToArray(list,array,option)
1216) !
1217) ! Creates an array of pointers to the characteristic curves objects in the
1218) ! list
1219) !
1220) ! Author: Glenn Hammond
1221) ! Date: 12/11/07
1222) !
1223)
1224) use String_module
1225) use Option_module
1226)
1227) implicit none
1228)
1229) class(characteristic_curves_type), pointer :: list
1230) type(characteristic_curves_ptr_type), pointer :: array(:)
1231) type(option_type) :: option
1232)
1233) class(characteristic_curves_type), pointer :: cur_characteristic_curves
1234) PetscInt :: count
1235)
1236) count = 0
1237) cur_characteristic_curves => list
1238) do
1239) if (.not.associated(cur_characteristic_curves)) exit
1240) count = count + 1
1241) cur_characteristic_curves => cur_characteristic_curves%next
1242) enddo
1243)
1244) if (associated(array)) deallocate(array)
1245) allocate(array(count))
1246)
1247) count = 0
1248) cur_characteristic_curves => list
1249) do
1250) if (.not.associated(cur_characteristic_curves)) exit
1251) count = count + 1
1252) array(count)%ptr => cur_characteristic_curves
1253) if (cur_characteristic_curves%test .and. &
1254) option%myrank == option%io_rank) then
1255) call CharacteristicCurvesTest(cur_characteristic_curves,option)
1256) endif
1257) cur_characteristic_curves => cur_characteristic_curves%next
1258) enddo
1259)
1260) end subroutine CharCurvesConvertListToArray
1261)
1262) ! ************************************************************************** !
1263)
1264) function CharCurvesGetGetResidualSats(characteristic_curves,option)
1265) !
1266) ! Returns the residual saturations associated with a characteristic curves
1267) ! object
1268) !
1269) ! Author: Glenn Hammond
1270) ! Date: 09/29/14
1271) !
1272)
1273) use Option_module
1274)
1275) class(characteristic_curves_type) :: characteristic_curves
1276) type(option_type) :: option
1277)
1278) PetscReal :: CharCurvesGetGetResidualSats(option%nphase)
1279)
1280) CharCurvesGetGetResidualSats(1) = &
1281) characteristic_curves%liq_rel_perm_function%Sr
1282) if (option%nphase > 1) then
1283) select type(rpf=>characteristic_curves%gas_rel_perm_function)
1284) class is(rpf_Mualem_VG_liq_type)
1285) CharCurvesGetGetResidualSats(2) = rpf%Sr
1286) class is(rpf_Mualem_VG_gas_type)
1287) CharCurvesGetGetResidualSats(2) = rpf%Srg
1288) class is(rpf_Burdine_BC_liq_type)
1289) CharCurvesGetGetResidualSats(2) = rpf%Sr
1290) class is(rpf_Burdine_BC_gas_type)
1291) CharCurvesGetGetResidualSats(2) = rpf%Srg
1292) class is(rpf_Mualem_BC_liq_type)
1293) CharCurvesGetGetResidualSats(2) = rpf%Sr
1294) class is(rpf_Mualem_BC_gas_type)
1295) CharCurvesGetGetResidualSats(2) = rpf%Srg
1296) class is(rpf_Burdine_VG_liq_type)
1297) CharCurvesGetGetResidualSats(2) = rpf%Sr
1298) class is(rpf_Burdine_VG_gas_type)
1299) CharCurvesGetGetResidualSats(2) = rpf%Srg
1300) class is(rpf_TOUGH2_IRP7_gas_type)
1301) CharCurvesGetGetResidualSats(2) = rpf%Srg
1302) class is(rpf_Mualem_Linear_liq_type)
1303) CharCurvesGetGetResidualSats(2) = rpf%Sr
1304) class is(rpf_Mualem_Linear_gas_type)
1305) CharCurvesGetGetResidualSats(2) = rpf%Srg
1306) class is(rpf_Burdine_Linear_liq_type)
1307) CharCurvesGetGetResidualSats(2) = rpf%Sr
1308) class is(rpf_Burdine_Linear_gas_type)
1309) CharCurvesGetGetResidualSats(2) = rpf%Srg
1310) class is(rpf_BRAGFLO_KRP9_liq_type)
1311) CharCurvesGetGetResidualSats(2) = rpf%Sr
1312) class is(rpf_BRAGFLO_KRP9_gas_type)
1313) CharCurvesGetGetResidualSats(2) = rpf%Srg
1314) class is(rpf_BRAGFLO_KRP4_liq_type)
1315) CharCurvesGetGetResidualSats(2) = rpf%Sr
1316) class is(rpf_BRAGFLO_KRP4_gas_type)
1317) CharCurvesGetGetResidualSats(2) = rpf%Srg
1318) class is(rpf_BRAGFLO_KRP11_liq_type)
1319) CharCurvesGetGetResidualSats(2) = rpf%Sr
1320) class is(rpf_BRAGFLO_KRP11_gas_type)
1321) CharCurvesGetGetResidualSats(2) = rpf%Srg
1322) class is(rpf_TOUGH2_Linear_oil_type)
1323) CharCurvesGetGetResidualSats(2) = rpf%Sro
1324) class is(rpf_mod_BC_liq_type)
1325) CharCurvesGetGetResidualSats(2) = rpf%Sr
1326) class is(rpf_mod_BC_oil_type)
1327) CharCurvesGetGetResidualSats(2) = rpf%Sro
1328) class is(rel_perm_func_constant_type)
1329) CharCurvesGetGetResidualSats(2) = rpf%Sr
1330) class is(rel_perm_func_default_type)
1331) CharCurvesGetGetResidualSats(2) = rpf%Sr
1332) class default
1333) option%io_buffer = 'Relative permeability class not supported in ' // &
1334) 'CharCurvesGetGetResidualSats.'
1335) call printErrMsg(option)
1336) end select
1337)
1338) endif
1339)
1340) end function CharCurvesGetGetResidualSats
1341)
1342) ! ************************************************************************** !
1343)
1344) function CharacteristicCurvesGetID(characteristic_curves_array, &
1345) characteristic_curves_name, &
1346) material_property_name, option)
1347) !
1348) ! Returns the ID of the characteristic curves object named
1349) ! "characteristic_curves_name"
1350) !
1351) ! Author: Glenn Hammond
1352) ! Date: 01/12/11
1353) !
1354)
1355) use Option_module
1356) use String_module
1357)
1358) type(characteristic_curves_ptr_type), pointer :: &
1359) characteristic_curves_array(:)
1360) character(len=MAXWORDLENGTH) :: characteristic_curves_name
1361) character(len=MAXWORDLENGTH) :: material_property_name
1362) type(option_type) :: option
1363)
1364) PetscInt :: CharacteristicCurvesGetID
1365)
1366) CharacteristicCurvesGetID = 0
1367) do CharacteristicCurvesGetID = 1, size(characteristic_curves_array)
1368) if (StringCompare(characteristic_curves_name, &
1369) characteristic_curves_array( &
1370) CharacteristicCurvesGetID)%ptr%name)) then
1371) return
1372) endif
1373) enddo
1374) option%io_buffer = 'Characteristic curves "' // &
1375) trim(characteristic_curves_name) // &
1376) '" in material property "' // &
1377) trim(material_property_name) // &
1378) '" not found among available characteristic curves.'
1379) call printErrMsg(option)
1380)
1381) end function CharacteristicCurvesGetID
1382)
1383) ! ************************************************************************** !
1384)
1385) subroutine CharacteristicCurvesTest(characteristic_curves,option)
1386) !
1387) ! Outputs values of characteristic curves over a range of values
1388) !
1389) ! Author: Glenn Hammond
1390) ! Date: 09/29/14
1391) !
1392) use Option_module
1393)
1394) implicit none
1395)
1396) class(characteristic_curves_type) :: characteristic_curves
1397) type(option_type) :: option
1398)
1399) character(len=MAXWORDLENGTH) :: phase
1400)
1401) call characteristic_curves%saturation_function%Test( &
1402) characteristic_curves%name, &
1403) option)
1404) phase = 'liquid'
1405) call characteristic_curves%liq_rel_perm_function%Test( &
1406) characteristic_curves%name, &
1407) phase,option)
1408) phase = 'gas'
1409) call characteristic_curves%gas_rel_perm_function%Test( &
1410) characteristic_curves%name, &
1411) phase,option)
1412)
1413) if ( associated(characteristic_curves%oil_rel_perm_function) ) then
1414) phase = 'oil'
1415) call characteristic_curves%oil_rel_perm_function%Test( &
1416) characteristic_curves%name, &
1417) phase,option)
1418) end if
1419)
1420) end subroutine CharacteristicCurvesTest
1421)
1422) ! ************************************************************************** !
1423)
1424) subroutine CharacteristicCurvesVerify(characteristic_curves,option)
1425) !
1426) ! Outputs values of characteristic curves over a range of values
1427) !
1428) ! Author: Glenn Hammond
1429) ! Date: 09/29/14
1430) !
1431) use Option_module
1432)
1433) implicit none
1434)
1435) class(characteristic_curves_type) :: characteristic_curves
1436) type(option_type) :: option
1437)
1438) character(len=MAXSTRINGLENGTH) :: string
1439)
1440) string = 'CHARACTERISTIC_CURVES(' // trim(characteristic_curves%name) // &
1441) '),'
1442)
1443) call characteristic_curves%saturation_function%Verify(string,option)
1444) call characteristic_curves%liq_rel_perm_function%Verify(string,option)
1445)
1446) if (associated(characteristic_curves%gas_rel_perm_function) ) then
1447) call characteristic_curves%gas_rel_perm_function%Verify(string,option)
1448) end if
1449)
1450) if ( associated(characteristic_curves%oil_rel_perm_function) ) then
1451) call characteristic_curves%oil_rel_perm_function%Verify(string,option)
1452) end if
1453)
1454) end subroutine CharacteristicCurvesVerify
1455)
1456) ! **************************************************************************** !
1457)
1458) subroutine CharCurvesInputRecord(char_curve_list)
1459) !
1460) ! Prints ingested characteristic curves information to the input record file
1461) !
1462) ! Author: Jenn Frederick
1463) ! Date: 04/11/2016
1464) !
1465)
1466) implicit none
1467)
1468) class(characteristic_curves_type), pointer :: char_curve_list
1469)
1470) class(characteristic_curves_type), pointer :: cur_ccurve
1471) character(len=MAXWORDLENGTH) :: word1, word2
1472) character(len=MAXSTRINGLENGTH) :: string
1473) PetscInt :: id = INPUT_RECORD_UNIT
1474)
1475) write(id,'(a)') ' '
1476) write(id,'(a)') '---------------------------------------------------------&
1477) &-----------------------'
1478) write(id,'(a29)',advance='no') '---------------------------: '
1479) write(id,'(a)') 'CHARACTERISTIC CURVES'
1480)
1481) cur_ccurve => char_curve_list
1482) do
1483) if (.not.associated(cur_ccurve)) exit
1484)
1485) write(id,'(a29)',advance='no') 'characteristic curve name: '
1486) write(id,'(a)') adjustl(trim(cur_ccurve%name))
1487)
1488) if (associated(cur_ccurve%saturation_function)) then
1489) write(id,'(a29)',advance='no') 'saturation function: '
1490) select type (sf => cur_ccurve%saturation_function)
1491) !---------------------------------
1492) class is (sat_func_VG_type)
1493) write(id,'(a)') 'van genuchten'
1494) write(id,'(a29)',advance='no') 'm: '
1495) write(word1,*) sf%m
1496) write(id,'(a)') adjustl(trim(word1))
1497) write(id,'(a29)',advance='no') 'alpha: '
1498) write(word1,*) sf%alpha
1499) write(id,'(a)') adjustl(trim(word1))
1500) !---------------------------------
1501) class is (sat_func_BC_type)
1502) write(id,'(a)') 'brooks corey'
1503) write(id,'(a29)',advance='no') 'alpha: '
1504) write(word1,*) sf%alpha
1505) write(id,'(a)') adjustl(trim(word1))
1506) write(id,'(a29)',advance='no') 'lambda: '
1507) write(word1,*) sf%lambda
1508) write(id,'(a)') adjustl(trim(word1))
1509) !---------------------------------
1510) class is (sat_func_Linear_type)
1511) write(id,'(a)') 'linear'
1512) write(id,'(a29)',advance='no') 'alpha: '
1513) write(word1,*) sf%alpha
1514) write(id,'(a)') adjustl(trim(word1))
1515) !---------------------------------
1516) class is (sat_func_BF_KRP9_type)
1517) write(id,'(a)') 'Bragflo KRP9 modified brooks corey'
1518) !---------------------------------
1519) class is (sat_func_BF_KRP4_type)
1520) write(id,'(a)') 'Bragflo KRP4 modified brooks corey'
1521) write(id,'(a29)',advance='no') 'alpha: '
1522) write(word1,*) sf%alpha
1523) write(id,'(a)') adjustl(trim(word1))
1524) write(id,'(a29)',advance='no') 'lambda: '
1525) write(word1,*) sf%lambda
1526) write(id,'(a)') adjustl(trim(word1))
1527) write(id,'(a29)',advance='no') 'gas residual sat.: '
1528) write(word1,*) sf%Srg
1529) write(id,'(a)') adjustl(trim(word1))
1530) write(id,'(a29)',advance='no') 'kpc: '
1531) write(word1,*) sf%pcmax_flag
1532) write(id,'(a)') adjustl(trim(word1))
1533) !---------------------------------
1534) class is (sat_func_BF_KRP11_type)
1535) write(id,'(a)') 'Bragflo KRP11 modified brooks corey'
1536) !---------------------------------
1537) class is (sat_func_BF_KRP12_type)
1538) write(id,'(a)') 'Bragflo KRP12 modified brooks corey'
1539) write(id,'(a29)',advance='no') 'alpha: '
1540) write(word1,*) sf%alpha
1541) write(id,'(a)') adjustl(trim(word1))
1542) write(id,'(a29)',advance='no') 'lambda: '
1543) write(word1,*) sf%lambda
1544) write(id,'(a)') adjustl(trim(word1))
1545) write(id,'(a29)',advance='no') 'gas residual sat.: '
1546) write(word1,*) sf%Srg
1547) write(id,'(a)') adjustl(trim(word1))
1548) write(id,'(a29)',advance='no') 'socmin: '
1549) write(word1,*) sf%socmin
1550) write(id,'(a)') adjustl(trim(word1))
1551) write(id,'(a29)',advance='no') 'soceffmin: '
1552) write(word1,*) sf%soceffmin
1553) write(id,'(a)') adjustl(trim(word1))
1554) !---------------------------------
1555) class is (sat_func_default_type)
1556) write(id,'(a)') 'default'
1557) !---------------------------------
1558) end select
1559) write(id,'(a29)',advance='no') 'liquid residual sat.: '
1560) write(word1,*) cur_ccurve%saturation_function%Sr
1561) write(id,'(a)') adjustl(trim(word1))
1562) write(id,'(a29)',advance='no') 'max capillary pressure: '
1563) write(word1,*) cur_ccurve%saturation_function%pcmax
1564) write(id,'(a)') adjustl(trim(word1))
1565) endif
1566)
1567) if (associated(cur_ccurve%liq_rel_perm_function)) then
1568) write(id,'(a29)',advance='no') 'liq. relative perm. func.: '
1569) select type (rpf => cur_ccurve%liq_rel_perm_function)
1570) !------------------------------------
1571) class is (rel_perm_func_default_type)
1572) write(id,'(a)') 'default'
1573) !------------------------------------
1574) class is (rpf_Mualem_VG_liq_type)
1575) write(id,'(a)') 'mualem_vg_liq/tough2_irp7_liq'
1576) write(id,'(a29)',advance='no') 'm: '
1577) write(word1,*) rpf%m
1578) write(id,'(a)') adjustl(trim(word1))
1579) !------------------------------------
1580) class is (rpf_Mualem_BC_liq_type)
1581) write(id,'(a)') 'mualem_bc_liq'
1582) write(id,'(a29)',advance='no') 'lambda: '
1583) write(word1,*) rpf%lambda
1584) write(id,'(a)') adjustl(trim(word1))
1585) !------------------------------------
1586) class is (rpf_Mualem_Linear_liq_type)
1587) write(id,'(a)') 'mualem_linear_liq'
1588) write(id,'(a29)',advance='no') 'alpha: '
1589) write(word1,*) rpf%alpha
1590) write(id,'(a)') adjustl(trim(word1))
1591) write(id,'(a29)',advance='no') 'max capillary pressure: '
1592) write(word1,*) rpf%pcmax
1593) write(id,'(a)') adjustl(trim(word1))
1594) !------------------------------------
1595) class is (rpf_Burdine_VG_liq_type)
1596) write(id,'(a)') 'burdine_vg_liq'
1597) write(id,'(a29)',advance='no') 'm: '
1598) write(word1,*) rpf%m
1599) write(id,'(a)') adjustl(trim(word1))
1600) !------------------------------------
1601) class is (rpf_Burdine_BC_liq_type)
1602) write(id,'(a)') 'burdine_bc_liq'
1603) write(id,'(a29)',advance='no') 'lambda: '
1604) write(word1,*) rpf%lambda
1605) write(id,'(a)') adjustl(trim(word1))
1606) !------------------------------------
1607) class is (rpf_Burdine_linear_liq_type)
1608) write(id,'(a)') 'burdine_linear_liq'
1609) !------------------------------------
1610) class is (rpf_BRAGFLO_KRP9_liq_type)
1611) write(id,'(a)') 'bragflo_krp9_liq'
1612) !------------------------------------
1613) class is (rpf_BRAGFLO_KRP4_liq_type)
1614) write(id,'(a)') 'bragflo_krp4_liq'
1615) write(id,'(a29)',advance='no') 'lambda: '
1616) write(word1,*) rpf%lambda
1617) write(id,'(a)') adjustl(trim(word1))
1618) !------------------------------------
1619) class is (rpf_BRAGFLO_KRP11_liq_type)
1620) write(id,'(a)') 'bragflo_krp11_liq'
1621) write(id,'(a29)',advance='no') 'tolc: '
1622) write(word1,*) rpf%tolc
1623) write(id,'(a)') adjustl(trim(word1))
1624) !------------------------------------
1625) class is (rpf_BRAGFLO_KRP12_liq_type)
1626) write(id,'(a)') 'bragflo_krp12_liq'
1627) write(id,'(a29)',advance='no') 'lambda: '
1628) write(word1,*) rpf%lambda
1629) write(id,'(a)') adjustl(trim(word1))
1630) !------------------------------------
1631) class default
1632) write(id,'(a)') 'none'
1633) !------------------------------------
1634) end select
1635) endif
1636)
1637) if (associated(cur_ccurve%gas_rel_perm_function)) then
1638) write(id,'(a29)',advance='no') 'gas relative perm. func.: '
1639) select type (rpf => cur_ccurve%gas_rel_perm_function)
1640) !------------------------------------
1641) class is (rel_perm_func_default_type)
1642) write(id,'(a)') 'default'
1643) !------------------------------------
1644) class is (rpf_Mualem_VG_gas_type)
1645) write(id,'(a)') 'mualem_vg_gas'
1646) write(id,'(a29)',advance='no') 'm: '
1647) write(word1,*) rpf%m
1648) write(id,'(a)') adjustl(trim(word1))
1649) write(id,'(a29)',advance='no') 'gas residual sat.: '
1650) write(word1,*) rpf%Srg
1651) write(id,'(a)') adjustl(trim(word1))
1652) !------------------------------------
1653) class is (rpf_Mualem_BC_gas_type)
1654) write(id,'(a)') 'mualem_bc_gas'
1655) write(id,'(a29)',advance='no') 'lambda: '
1656) write(word1,*) rpf%lambda
1657) write(id,'(a)') adjustl(trim(word1))
1658) write(id,'(a29)',advance='no') 'gas residual sat.: '
1659) write(word1,*) rpf%Srg
1660) write(id,'(a)') adjustl(trim(word1))
1661) !------------------------------------
1662) class is (rpf_Mualem_Linear_gas_type)
1663) write(id,'(a)') 'mualem_linear_gas'
1664) write(id,'(a29)',advance='no') 'alpha: '
1665) write(word1,*) rpf%alpha
1666) write(id,'(a)') adjustl(trim(word1))
1667) write(id,'(a29)',advance='no') 'max capillary pressure: '
1668) write(word1,*) rpf%pcmax
1669) write(id,'(a)') adjustl(trim(word1))
1670) write(id,'(a29)',advance='no') 'gas residual sat.: '
1671) write(word1,*) rpf%Srg
1672) write(id,'(a)') adjustl(trim(word1))
1673) !------------------------------------
1674) class is (rpf_TOUGH2_IRP7_gas_type)
1675) write(id,'(a)') 'tough2_irp7_gas'
1676) write(id,'(a29)',advance='no') 'm: '
1677) write(word1,*) rpf%m
1678) write(id,'(a)') adjustl(trim(word1))
1679) write(id,'(a29)',advance='no') 'gas residual sat.: '
1680) write(word1,*) rpf%Srg
1681) write(id,'(a)') adjustl(trim(word1))
1682) !------------------------------------
1683) class is (rpf_Burdine_VG_gas_type)
1684) write(id,'(a)') 'burdine_vg_gas'
1685) write(id,'(a29)',advance='no') 'm: '
1686) write(word1,*) rpf%m
1687) write(id,'(a)') adjustl(trim(word1))
1688) write(id,'(a29)',advance='no') 'gas residual sat.: '
1689) write(word1,*) rpf%Srg
1690) write(id,'(a)') adjustl(trim(word1))
1691) !------------------------------------
1692) class is (rpf_Burdine_BC_gas_type)
1693) write(id,'(a)') 'burdine_bc_gas'
1694) write(id,'(a29)',advance='no') 'lambda: '
1695) write(word1,*) rpf%lambda
1696) write(id,'(a)') adjustl(trim(word1))
1697) write(id,'(a29)',advance='no') 'gas residual sat.: '
1698) write(word1,*) rpf%Srg
1699) write(id,'(a)') adjustl(trim(word1))
1700) !------------------------------------
1701) class is (rpf_Burdine_linear_gas_type)
1702) write(id,'(a)') 'burdine_linear_gas'
1703) write(id,'(a29)',advance='no') 'gas residual sat.: '
1704) write(word1,*) rpf%Srg
1705) write(id,'(a)') adjustl(trim(word1))
1706) !------------------------------------
1707) class is (rpf_BRAGFLO_KRP9_gas_type)
1708) write(id,'(a)') 'bragflo_krp9_gas'
1709) write(id,'(a29)',advance='no') 'gas residual sat.: '
1710) write(word1,*) rpf%Srg
1711) write(id,'(a)') adjustl(trim(word1))
1712) !------------------------------------
1713) class is (rpf_BRAGFLO_KRP4_gas_type)
1714) write(id,'(a)') 'bragflo_krp4_gas'
1715) write(id,'(a29)',advance='no') 'lambda: '
1716) write(word1,*) rpf%lambda
1717) write(id,'(a)') adjustl(trim(word1))
1718) write(id,'(a29)',advance='no') 'gas residual sat.: '
1719) write(word1,*) rpf%Srg
1720) write(id,'(a)') adjustl(trim(word1))
1721) !------------------------------------
1722) class is (rpf_BRAGFLO_KRP11_gas_type)
1723) write(id,'(a)') 'bragflo_krp11_gas'
1724) write(id,'(a29)',advance='no') 'tolc: '
1725) write(word1,*) rpf%tolc
1726) write(id,'(a)') adjustl(trim(word1))
1727) write(id,'(a29)',advance='no') 'gas residual sat.: '
1728) write(word1,*) rpf%Srg
1729) write(id,'(a)') adjustl(trim(word1))
1730) !------------------------------------
1731) class is (rpf_BRAGFLO_KRP12_gas_type)
1732) write(id,'(a)') 'bragflo_krp12_gas'
1733) write(id,'(a29)',advance='no') 'lambda: '
1734) write(word1,*) rpf%lambda
1735) write(id,'(a)') adjustl(trim(word1))
1736) write(id,'(a29)',advance='no') 'gas residual sat.: '
1737) write(word1,*) rpf%Srg
1738) write(id,'(a)') adjustl(trim(word1))
1739) !------------------------------------
1740) class default
1741) write(id,'(a)') 'none'
1742) !------------------------------------
1743) end select
1744) endif
1745)
1746) if (associated(cur_ccurve%oil_rel_perm_function)) then
1747) write(id,'(a29)',advance='no') 'oil relative perm. func.: '
1748) select type (rpf => cur_ccurve%oil_rel_perm_function)
1749) !------------------------------------
1750) class is (rel_perm_func_default_type)
1751) write(id,'(a)') 'default'
1752) !------------------------------------
1753) class is (rpf_TOUGH2_Linear_Oil_type)
1754) write(id,'(a)') 'tough2_linear_oil'
1755) write(id,'(a29)',advance='no') 'oil residual sat.: '
1756) write(word1,*) rpf%Sro
1757) write(id,'(a)') adjustl(trim(word1))
1758) !------------------------------------
1759) end select
1760) endif
1761)
1762) write(id,'(a29)') '---------------------------: '
1763) cur_ccurve => cur_ccurve%next
1764) enddo
1765)
1766) end subroutine CharCurvesInputRecord
1767)
1768) ! End Characteristic Curves
1769)
1770) ! ************************************************************************** !
1771)
1772) ! Begin Base Routines
1773) function PolynomialCreate()
1774)
1775) implicit none
1776)
1777) type(polynomial_type), pointer :: PolynomialCreate
1778)
1779) allocate(PolynomialCreate)
1780) PolynomialCreate%low = 0.d0
1781) PolynomialCreate%high = 0.d0
1782) PolynomialCreate%coefficients(:) = 0.d0
1783)
1784) end function PolynomialCreate
1785)
1786) ! ************************************************************************** !
1787)
1788) subroutine SFBaseInit(this)
1789)
1790) implicit none
1791)
1792) class(sat_func_base_type) :: this
1793)
1794) ! Cannot allocate here. Allocation takes place in daughter class
1795) nullify(this%sat_poly)
1796) nullify(this%pres_poly)
1797) this%Sr = UNINITIALIZED_DOUBLE
1798) this%pcmax = DEFAULT_PCMAX
1799)
1800) end subroutine SFBaseInit
1801)
1802) ! ************************************************************************** !
1803)
1804) subroutine SFBaseVerify(this,name,option)
1805)
1806) use Option_module
1807)
1808) implicit none
1809)
1810) class(sat_func_base_type) :: this
1811) character(len=MAXSTRINGLENGTH) :: name
1812) type(option_type) :: option
1813)
1814) if (Uninitialized(this%Sr)) then
1815) option%io_buffer = UninitializedMessage('LIQUID_RESIDUAL_SATURATION', &
1816) name)
1817) call printErrMsg(option)
1818) endif
1819)
1820) end subroutine SFBaseVerify
1821)
1822) ! ************************************************************************** !
1823)
1824) subroutine RPFBaseInit(this)
1825)
1826) implicit none
1827)
1828) class(rel_perm_func_base_type) :: this
1829)
1830) ! Cannot allocate here. Allocation takes place in daughter class
1831) nullify(this%poly)
1832) this%Sr = UNINITIALIZED_DOUBLE
1833)
1834) end subroutine RPFBaseInit
1835)
1836) ! ************************************************************************** !
1837)
1838) subroutine RPFBaseVerify(this,name,option)
1839)
1840) use Option_module
1841)
1842) implicit none
1843)
1844) class(rel_perm_func_base_type) :: this
1845) character(len=MAXSTRINGLENGTH) :: name
1846) type(option_type) :: option
1847)
1848) if (Uninitialized(this%Sr)) then
1849) option%io_buffer = UninitializedMessage('LIQUID_RESIDUAL_SATURATION', &
1850) name)
1851) call printErrMsg(option)
1852) endif
1853)
1854) end subroutine RPFBaseVerify
1855)
1856) ! ************************************************************************** !
1857)
1858) subroutine SFBaseSetupPolynomials(this,option,error_string)
1859)
1860) ! Sets up polynomials for smoothing saturation functions
1861)
1862) use Option_module
1863)
1864) implicit none
1865)
1866) class(sat_func_base_type) :: this
1867) type(option_type) :: option
1868) character(len=MAXSTRINGLENGTH) :: error_string
1869)
1870) option%io_buffer = 'Smoothing not supported for ' // trim(error_string)
1871) call printErrMsg(option)
1872)
1873) end subroutine SFBaseSetupPolynomials
1874)
1875) ! ************************************************************************** !
1876)
1877) subroutine RPFBaseSetupPolynomials(this,option,error_string)
1878)
1879) ! Sets up polynomials for smoothing relative permeability functions
1880)
1881) use Option_module
1882)
1883) implicit none
1884)
1885) class(rel_perm_func_base_type) :: this
1886) type(option_type) :: option
1887) character(len=MAXSTRINGLENGTH) :: error_string
1888)
1889) option%io_buffer = 'Smoothing not supported for ' // trim(error_string)
1890) call printErrMsg(option)
1891)
1892) end subroutine RPFBaseSetupPolynomials
1893)
1894) ! ************************************************************************** !
1895)
1896) subroutine SFBaseCapillaryPressure(this,liquid_saturation, &
1897) capillary_pressure,option)
1898) use Option_module
1899)
1900) implicit none
1901)
1902) class(sat_func_base_type) :: this
1903) PetscReal, intent(in) :: liquid_saturation
1904) PetscReal, intent(out) :: capillary_pressure
1905) type(option_type), intent(inout) :: option
1906)
1907) option%io_buffer = 'SFBaseCapillaryPressure must be extended.'
1908) call printErrMsg(option)
1909)
1910) end subroutine SFBaseCapillaryPressure
1911)
1912) ! ************************************************************************** !
1913)
1914) subroutine SFBaseSaturation(this,capillary_pressure,liquid_saturation, &
1915) dsat_dpres,option)
1916) use Option_module
1917)
1918) implicit none
1919)
1920) class(sat_func_base_type) :: this
1921) PetscReal, intent(in) :: capillary_pressure
1922) PetscReal, intent(out) :: liquid_saturation
1923) PetscReal, intent(out) :: dsat_dpres
1924) type(option_type), intent(inout) :: option
1925)
1926) option%io_buffer = 'SFBaseSaturation must be extended.'
1927) call printErrMsg(option)
1928)
1929) end subroutine SFBaseSaturation
1930)
1931) ! ************************************************************************** !
1932)
1933) subroutine SFBaseTest(this,cc_name,option)
1934)
1935) use Option_module
1936)
1937) implicit none
1938)
1939) class(sat_func_base_type) :: this
1940) character(len=MAXWORDLENGTH) :: cc_name
1941) type(option_type), intent(inout) :: option
1942)
1943) character(len=MAXSTRINGLENGTH) :: string
1944) PetscReal :: pc, pc_increment
1945) PetscReal :: capillary_pressure(101)
1946) PetscReal :: liquid_saturation(101)
1947) PetscReal :: dummy_real
1948) PetscInt :: count, i
1949)
1950) ! calculate saturation as a function of capillary pressure
1951) ! start at 1 Pa up to maximum capillary pressure
1952) pc = 1.d0
1953) pc_increment = 1.d0
1954) count = 0
1955) do
1956) if (pc > this%pcmax) exit
1957) count = count + 1
1958) call this%Saturation(pc,liquid_saturation(count),dummy_real,option)
1959) capillary_pressure(count) = pc
1960) if (pc > 0.99d0*pc_increment*10.d0) pc_increment = pc_increment*10.d0
1961) pc = pc + pc_increment
1962) enddo
1963)
1964) write(string,*) cc_name
1965) string = trim(cc_name) // '_pc_sat.dat'
1966) open(unit=86,file=string)
1967) write(86,*) '"capillary pressure", "saturation"'
1968) do i = 1, count
1969) write(86,'(2es14.6)') capillary_pressure(i), liquid_saturation(i)
1970) enddo
1971) close(86)
1972)
1973) ! calculate capillary pressure as a function of saturation
1974) do i = 1, 101
1975) liquid_saturation(i) = dble(i-1)*0.01d0
1976) call this%CapillaryPressure(liquid_saturation(i),capillary_pressure(i), &
1977) option)
1978) enddo
1979) count = 101
1980)
1981) write(string,*) cc_name
1982) string = trim(cc_name) // '_sat_pc.dat'
1983) open(unit=86,file=string)
1984) write(86,*) '"saturation", "capillary pressure"'
1985) do i = 1, count
1986) write(86,'(2es14.6)') liquid_saturation(i), capillary_pressure(i)
1987) enddo
1988) close(86)
1989)
1990) end subroutine SFBaseTest
1991)
1992) ! ************************************************************************** !
1993)
1994) subroutine RPF_Base_RelPerm(this,liquid_saturation,relative_permeability, &
1995) dkr_sat,option)
1996) use Option_module
1997)
1998) implicit none
1999)
2000) class(rel_perm_func_base_type) :: this
2001) PetscReal, intent(in) :: liquid_saturation
2002) PetscReal, intent(out) :: relative_permeability
2003) PetscReal, intent(out) :: dkr_sat
2004) type(option_type), intent(inout) :: option
2005)
2006) option%io_buffer = 'RPF_Base_RelPerm must be extended.'
2007) call printErrMsg(option)
2008)
2009) end subroutine RPF_Base_RelPerm
2010)
2011) ! ************************************************************************** !
2012)
2013) subroutine RPF_Base_Test(this,cc_name,phase,option)
2014)
2015) use Option_module
2016)
2017) implicit none
2018)
2019) class(rel_perm_func_base_type) :: this
2020) character(len=MAXWORDLENGTH) :: cc_name
2021) character(len=MAXWORDLENGTH) :: phase
2022) type(option_type), intent(inout) :: option
2023)
2024) character(len=MAXSTRINGLENGTH) :: string
2025) PetscReal :: dummy_real
2026) PetscInt :: i
2027) PetscReal :: liquid_saturation(101), kr(101)
2028)
2029) do i = 1, 101
2030) liquid_saturation(i) = dble(i-1)*0.01d0
2031) call this%RelativePermeability(liquid_saturation(i),kr(i),dummy_real, &
2032) option)
2033) enddo
2034)
2035) write(string,*) cc_name
2036) string = trim(cc_name) // '_' // trim(phase) // '_rel_perm.dat'
2037) open(unit=86,file=string)
2038) write(86,*) '"saturation", "' // trim(phase) // ' relative permeability"'
2039) do i = 1, size(liquid_saturation)
2040) write(86,'(2es14.6)') liquid_saturation(i), kr(i)
2041) enddo
2042) close(86)
2043)
2044) end subroutine RPF_Base_Test
2045) ! End Base Routines
2046)
2047) ! ************************************************************************** !
2048)
2049) ! Begin SF: Default
2050) function SF_Default_Create()
2051)
2052) ! Creates the default saturation function object
2053)
2054) implicit none
2055)
2056) class(sat_func_default_type), pointer :: SF_Default_Create
2057)
2058) allocate(SF_Default_Create)
2059) call SFBaseInit(SF_Default_Create)
2060) SF_Default_Create%Sr = 0.d0
2061)
2062) end function SF_Default_Create
2063)
2064) ! ************************************************************************** !
2065)
2066) subroutine SFDefaultVerify(this,name,option)
2067)
2068) use Option_module
2069)
2070) implicit none
2071)
2072) class(sat_func_default_type) :: this
2073) character(len=MAXSTRINGLENGTH) :: name
2074) type(option_type) :: option
2075)
2076) option%io_buffer = 'A default Saturation Function has been chosen in ' // &
2077) trim(name) // '.'
2078) call printWrnMsg(option)
2079)
2080) end subroutine SFDefaultVerify
2081)
2082) ! ************************************************************************** !
2083)
2084) subroutine SFDefaultCapillaryPressure(this,liquid_saturation, &
2085) capillary_pressure,option)
2086) use Option_module
2087)
2088) implicit none
2089)
2090) class(sat_func_default_type) :: this
2091) PetscReal, intent(in) :: liquid_saturation
2092) PetscReal, intent(out) :: capillary_pressure
2093) type(option_type), intent(inout) :: option
2094)
2095) if (liquid_saturation < 1.d0) then
2096) option%io_buffer = 'SFDefaultCapillaryPressure is a dummy routine used &
2097) &for saturated flow only. The user must specify a valid &
2098) &SATURATION_FUNCTION.'
2099) call printErrMsgByRank(option)
2100) endif
2101)
2102) end subroutine SFDefaultCapillaryPressure
2103)
2104) ! ************************************************************************** !
2105)
2106) subroutine SFDefaultSaturation(this,capillary_pressure,liquid_saturation, &
2107) dsat_dpres,option)
2108) use Option_module
2109)
2110) implicit none
2111)
2112) class(sat_func_default_type) :: this
2113) PetscReal, intent(in) :: capillary_pressure
2114) PetscReal, intent(out) :: liquid_saturation
2115) PetscReal, intent(out) :: dsat_dpres
2116) type(option_type), intent(inout) :: option
2117)
2118) option%io_buffer = 'SFDefaultSaturation is a dummy routine used &
2119) &for saturated flow only. The user must specify a valid &
2120) &SATURATION_FUNCTION.'
2121) call printErrMsgByRank(option)
2122)
2123) end subroutine SFDefaultSaturation
2124)
2125) ! ************************************************************************** !
2126)
2127) function RPF_Default_Create()
2128)
2129) ! Creates the default relative permeability function object
2130)
2131) implicit none
2132)
2133) class(rel_perm_func_default_type), pointer :: RPF_Default_Create
2134)
2135) allocate(RPF_Default_Create)
2136) call RPFBaseInit(RPF_Default_Create)
2137) RPF_Default_Create%Sr = 0.d0
2138)
2139) end function RPF_Default_Create
2140)
2141) ! ************************************************************************** !
2142)
2143) subroutine RPFDefaultVerify(this,name,option)
2144)
2145) use Option_module
2146)
2147) implicit none
2148)
2149) class(rel_perm_func_default_type) :: this
2150) character(len=MAXSTRINGLENGTH) :: name
2151) type(option_type) :: option
2152)
2153) option%io_buffer = 'A default Relative Permeability Function has been ' // &
2154) 'chosen in ' // trim(name) // '.'
2155) call printWrnMsg(option)
2156)
2157) end subroutine RPFDefaultVerify
2158)
2159) ! ************************************************************************** !
2160)
2161) subroutine RPF_DefaultRelPerm(this,liquid_saturation,relative_permeability, &
2162) dkr_sat,option)
2163) use Option_module
2164)
2165) implicit none
2166)
2167) class(rel_perm_func_default_type) :: this
2168) PetscReal, intent(in) :: liquid_saturation
2169) PetscReal, intent(out) :: relative_permeability
2170) PetscReal, intent(out) :: dkr_sat
2171) type(option_type), intent(inout) :: option
2172)
2173) if (liquid_saturation < 1.d0) then
2174) option%io_buffer = 'RPF_Default_RelPerm is a dummy routine used &
2175) &for saturated flow only. The user must specify a valid &
2176) &PERMEABILITY_FUNCTION.'
2177) call printErrMsgByRank(option)
2178) endif
2179) relative_permeability = 1.d0
2180)
2181) end subroutine RPF_DefaultRelPerm
2182) ! End Default Routines
2183)
2184) ! ************************************************************************** !
2185)
2186) ! Begin SF: van Genuchten
2187) function SF_VG_Create()
2188)
2189) ! Creates the van Genutchten capillary pressure function object
2190)
2191) implicit none
2192)
2193) class(sat_func_VG_type), pointer :: SF_VG_Create
2194)
2195) allocate(SF_VG_Create)
2196) call SF_VG_Create%Init()
2197)
2198) end function SF_VG_Create
2199)
2200) ! ************************************************************************** !
2201)
2202) subroutine SF_VG_Init(this)
2203)
2204) ! Creates the van Genutchten capillary pressure function object
2205)
2206) implicit none
2207)
2208) class(sat_func_VG_type) :: this
2209)
2210) call SFBaseInit(this)
2211) this%alpha = UNINITIALIZED_DOUBLE
2212) this%m = UNINITIALIZED_DOUBLE
2213)
2214) end subroutine SF_VG_Init
2215)
2216) ! ************************************************************************** !
2217)
2218) subroutine SF_VG_Verify(this,name,option)
2219)
2220) use Option_module
2221)
2222) implicit none
2223)
2224) class(sat_func_VG_type) :: this
2225) character(len=MAXSTRINGLENGTH) :: name
2226) type(option_type) :: option
2227)
2228) character(len=MAXSTRINGLENGTH) :: string
2229)
2230) if (index(name,'SATURATION_FUNCTION') > 0) then
2231) string = name
2232) else
2233) string = trim(name) // 'SATURATION_FUNCTION,VAN_GENUCHTEN'
2234) endif
2235) call SFBaseVerify(this,string,option)
2236) if (Uninitialized(this%alpha)) then
2237) option%io_buffer = UninitializedMessage('ALPHA',string)
2238) call printErrMsg(option)
2239) endif
2240) if (Uninitialized(this%m)) then
2241) option%io_buffer = UninitializedMessage('M',string)
2242) call printErrMsg(option)
2243) endif
2244)
2245) end subroutine SF_VG_Verify
2246)
2247) ! ************************************************************************** !
2248)
2249) subroutine SF_VG_CapillaryPressure(this,liquid_saturation, &
2250) capillary_pressure,option)
2251) !
2252) ! Computes the capillary_pressure as a function of saturation
2253) !
2254) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
2255) ! of two-fluid capillary pressure-saturation and permeability functions",
2256) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
2257) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
2258) !
2259) ! Author: Glenn Hammond
2260) ! Date: 12/11/07, 09/23/14
2261) !
2262) use Option_module
2263)
2264) implicit none
2265)
2266) class(sat_func_VG_type) :: this
2267) PetscReal, intent(in) :: liquid_saturation
2268) PetscReal, intent(out) :: capillary_pressure
2269) type(option_type), intent(inout) :: option
2270)
2271) PetscReal :: n
2272) PetscReal :: Se
2273) PetscReal :: one_plus_pc_alpha_n
2274) PetscReal :: pc_alpha_n
2275) PetscReal :: pc_alpha
2276)
2277) if (liquid_saturation <= this%Sr) then
2278) capillary_pressure = this%pcmax
2279) return
2280) else if (liquid_saturation >= 1.d0) then
2281) capillary_pressure = 0.d0
2282) return
2283) endif
2284)
2285) n = 1.d0/(1.d0-this%m)
2286) Se = (liquid_saturation-this%Sr)/(1.d0-this%Sr)
2287) one_plus_pc_alpha_n = Se**(-1.d0/this%m)
2288) pc_alpha_n = one_plus_pc_alpha_n - 1.d0
2289) pc_alpha = pc_alpha_n**(1.d0/n)
2290) capillary_pressure = pc_alpha/this%alpha
2291) #if defined(MATCH_TOUGH2)
2292) if (liquid_saturation > 0.999d0) then
2293) capillary_pressure = capillary_pressure*(1.d0-liquid_saturation)/0.001d0
2294) endif
2295) #endif
2296)
2297)
2298) capillary_pressure = min(capillary_pressure,this%pcmax)
2299)
2300) end subroutine SF_VG_CapillaryPressure
2301)
2302) ! ************************************************************************** !
2303)
2304) subroutine SF_VG_Saturation(this,capillary_pressure,liquid_saturation, &
2305) dsat_dpres,option)
2306) !
2307) ! Computes the saturation (and associated derivatives) as a function of
2308) ! capillary pressure
2309) !
2310) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
2311) ! of two-fluid capillary pressure-saturation and permeability functions",
2312) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
2313) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
2314) !
2315) ! Author: Glenn Hammond
2316) ! Date: 12/11/07, 09/23/14
2317) !
2318) use Option_module
2319) use Utility_module
2320)
2321) implicit none
2322)
2323) class(sat_func_VG_type) :: this
2324) PetscReal, intent(in) :: capillary_pressure
2325) PetscReal, intent(out) :: liquid_saturation
2326) PetscReal, intent(out) :: dsat_dpres
2327) type(option_type), intent(inout) :: option
2328)
2329) PetscReal, parameter :: pc_alpha_n_epsilon = 1.d-15
2330) PetscReal :: n
2331) PetscReal :: pc_alpha
2332) PetscReal :: pc_alpha_n
2333) PetscReal :: one_plus_pc_alpha_n
2334) PetscReal :: Se
2335) PetscReal :: dSe_dpc
2336)
2337) dsat_dpres = 0.d0
2338)
2339) if (associated(this%pres_poly)) then
2340) if (capillary_pressure < this%pres_poly%low) then
2341) liquid_saturation = 1.d0
2342) return
2343) else if (capillary_pressure < this%pres_poly%high) then
2344) call CubicPolynomialEvaluate(this%pres_poly%coefficients, &
2345) capillary_pressure,Se,dSe_dpc)
2346) liquid_saturation = this%Sr + (1.d0-this%Sr)*Se
2347) dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
2348) return
2349) endif
2350) endif
2351)
2352) if (capillary_pressure <= 0.d0) then
2353) liquid_saturation = 1.d0
2354) return
2355) else
2356) n = 1.d0/(1.d0-this%m)
2357) pc_alpha = capillary_pressure*this%alpha
2358) pc_alpha_n = pc_alpha**n
2359) !geh: This conditional does not catch potential cancelation in
2360) ! the dkr_sat deriviative calculation. Therefore, I am setting
2361) ! an epsilon here
2362) ! if (1.d0 + pc_alpha_n == 1.d0) then ! check for zero perturbation
2363) if (pc_alpha_n < pc_alpha_n_epsilon) then
2364) liquid_saturation = 1.d0
2365) !switch_to_saturated = PETSC_TRUE
2366) return
2367) endif
2368) one_plus_pc_alpha_n = 1.d0+pc_alpha_n
2369) Se = one_plus_pc_alpha_n**(-this%m)
2370) dSe_dpc = -this%m*n*this%alpha*pc_alpha_n/ &
2371) (pc_alpha*one_plus_pc_alpha_n**(this%m+1.d0))
2372) liquid_saturation = this%Sr + (1.d0-this%Sr)*Se
2373) dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
2374) endif
2375)
2376) end subroutine SF_VG_Saturation
2377) ! End SF: van Genuchten
2378)
2379) ! ************************************************************************** !
2380)
2381) ! Begin SF: Brooks-Corey
2382) function SF_BC_Create()
2383)
2384) ! Creates the Brooks Corey capillary pressure function object
2385)
2386) implicit none
2387)
2388) class(sat_func_BC_type), pointer :: SF_BC_Create
2389)
2390) allocate(SF_BC_Create)
2391) call SF_BC_Create%Init()
2392)
2393) end function SF_BC_Create
2394)
2395) ! ************************************************************************** !
2396)
2397) subroutine SF_BC_Init(this)
2398)
2399) use Option_module
2400)
2401) implicit none
2402)
2403) class(sat_func_BC_type) :: this
2404) character(len=MAXWORDLENGTH) :: name
2405) type(option_type) :: option
2406)
2407) call SFBaseInit(this)
2408) this%alpha = UNINITIALIZED_DOUBLE
2409) this%lambda = UNINITIALIZED_DOUBLE
2410)
2411) end subroutine SF_BC_Init
2412)
2413) ! ************************************************************************** !
2414)
2415) subroutine SF_BC_Verify(this,name,option)
2416)
2417) use Option_module
2418)
2419) implicit none
2420)
2421) class(sat_func_BC_type) :: this
2422) character(len=MAXSTRINGLENGTH) :: name
2423) type(option_type) :: option
2424)
2425) character(len=MAXSTRINGLENGTH) :: string
2426)
2427) if (index(name,'SATURATION_FUNCTION') > 0) then
2428) string = name
2429) else
2430) string = trim(name) // 'SATURATION_FUNCTION,BROOKS_COREY'
2431) endif
2432) call SFBaseVerify(this,string,option)
2433) if (Uninitialized(this%alpha)) then
2434) option%io_buffer = UninitializedMessage('ALPHA',string)
2435) call printErrMsg(option)
2436) endif
2437) if (Uninitialized(this%lambda)) then
2438) option%io_buffer = UninitializedMessage('LAMBDA',string)
2439) call printErrMsg(option)
2440) endif
2441)
2442) end subroutine SF_BC_Verify
2443)
2444) ! ************************************************************************** !
2445)
2446) subroutine SF_BC_SetupPolynomials(this,option,error_string)
2447)
2448) ! Sets up polynomials for smoothing Brooks-Corey saturation function
2449)
2450) use Option_module
2451) use Utility_module
2452)
2453) implicit none
2454)
2455) class(sat_func_BC_type) :: this
2456) type(option_type) :: option
2457) character(len=MAXSTRINGLENGTH) :: error_string
2458)
2459) PetscReal :: b(4)
2460)
2461) ! polynomial fitting pc as a function of saturation
2462) ! 1.05 is essentially pc*alpha (i.e. pc = 1.05/alpha)
2463) this%sat_poly => PolynomialCreate()
2464) this%sat_poly%low = 1.05d0**(-this%lambda)
2465) this%sat_poly%high = 1.d0
2466)
2467) b = 0.d0
2468) ! fill right hand side
2469) ! capillary pressure at 1
2470) b(1) = 1.05d0/this%alpha
2471) ! capillary pressure at 2
2472) b(2) = 0.d0
2473) ! derivative of pressure at saturation_1
2474) ! pc = Se**(-1/lambda)/alpha
2475) ! dpc_dSe = -1/lambda*Se**(-1/lambda-1)/alpha
2476) b(3) = -1.d0/this%lambda* &
2477) this%sat_poly%low**(-1.d0/this%lambda-1.d0)/ &
2478) this%alpha
2479)
2480) call QuadraticPolynomialSetup(this%sat_poly%low,this%sat_poly%high,b(1:3), &
2481) ! indicates derivative given at 1
2482) PETSC_TRUE)
2483)
2484) this%sat_poly%coefficients(1:3) = b(1:3)
2485)
2486) ! polynomial fitting saturation as a function of pc
2487) !geh: cannot invert the pressure/saturation relationship above
2488) ! since it can result in saturations > 1 with both
2489) ! quadratic and cubic polynomials
2490) ! fill matix with values
2491) this%pres_poly => PolynomialCreate()
2492) this%pres_poly%low = 0.95/this%alpha
2493) this%pres_poly%high = 1.05/this%alpha
2494)
2495) b = 0.d0
2496) ! Se at 1
2497) b(1) = 1.d0
2498) ! Se at 2
2499) b(2) = (this%pres_poly%high*this%alpha)** &
2500) (-this%lambda)
2501) ! derivative of Se at 1
2502) b(3) = 0.d0
2503) ! derivative of Se at 2
2504) b(4) = -this%lambda/this%pres_poly%high* &
2505) (this%pres_poly%high*this%alpha)** &
2506) (-this%lambda)
2507)
2508) call CubicPolynomialSetup(this%pres_poly%low,this%pres_poly%high,b)
2509)
2510) this%pres_poly%coefficients(1:4) = b(1:4)
2511)
2512)
2513) end subroutine SF_BC_SetupPolynomials
2514)
2515) ! ************************************************************************** !
2516)
2517) subroutine SF_BC_CapillaryPressure(this,liquid_saturation, &
2518) capillary_pressure,option)
2519) !
2520) ! Computes the capillary_pressure as a function of saturation using the
2521) ! Brooks-Corey formulation
2522) !
2523) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
2524) ! of two-fluid capillary pressure-saturation and permeability functions",
2525) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
2526) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
2527) !
2528) ! Author: Glenn Hammond
2529) ! Date: 12/11/07, 09/23/14
2530) !
2531) use Option_module
2532) use Utility_module
2533)
2534) implicit none
2535)
2536) class(sat_func_BC_type) :: this
2537) PetscReal, intent(in) :: liquid_saturation
2538) PetscReal, intent(out) :: capillary_pressure
2539) type(option_type), intent(inout) :: option
2540)
2541) PetscReal :: Se
2542) PetscReal :: dummy_real
2543)
2544) if (liquid_saturation <= this%Sr) then
2545) capillary_pressure = this%pcmax
2546) return
2547) else if (liquid_saturation >= 1.d0) then
2548) capillary_pressure = 0.d0
2549) return
2550) endif
2551)
2552) Se = (liquid_saturation-this%Sr)/(1.d0-this%Sr)
2553) if (associated(this%sat_poly)) then
2554) if (Se > this%sat_poly%low) then
2555) call QuadraticPolynomialEvaluate(this%sat_poly%coefficients(1:3), &
2556) Se,capillary_pressure,dummy_real)
2557) return
2558) endif
2559) endif
2560) capillary_pressure = (Se**(-1.d0/this%lambda))/this%alpha
2561) #if defined(MATCH_TOUGH2)
2562) if (liquid_saturation > 0.999d0) then
2563) capillary_pressure = capillary_pressure*(1.d0-liquid_saturation)/0.001d0
2564) endif
2565) #endif
2566)
2567) capillary_pressure = min(capillary_pressure,this%pcmax)
2568)
2569) end subroutine SF_BC_CapillaryPressure
2570)
2571) ! ************************************************************************** !
2572)
2573) subroutine SF_BC_Saturation(this,capillary_pressure,liquid_saturation, &
2574) dsat_dpres,option)
2575) !
2576) ! Computes the saturation (and associated derivatives) as a function of
2577) ! capillary pressure
2578) !
2579) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
2580) ! of two-fluid capillary pressure-saturation and permeability functions",
2581) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
2582) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
2583) !
2584) ! Author: Glenn Hammond
2585) ! Date: 12/11/07, 09/23/14
2586)
2587) use Option_module
2588) use Utility_module
2589)
2590) implicit none
2591)
2592) class(sat_func_BC_type) :: this
2593) PetscReal, intent(in) :: capillary_pressure
2594) PetscReal, intent(out) :: liquid_saturation
2595) PetscReal, intent(out) :: dsat_dpres
2596) type(option_type), intent(inout) :: option
2597)
2598) PetscReal :: pc_alpha_neg_lambda
2599) PetscReal :: Se
2600) PetscReal :: dSe_dpc
2601)
2602) dsat_dpres = 0.d0
2603)
2604) ! reference #1
2605) if (associated(this%pres_poly)) then
2606) if (capillary_pressure < this%pres_poly%low) then
2607) liquid_saturation = 1.d0
2608) return
2609) else if (capillary_pressure < this%pres_poly%high) then
2610) call CubicPolynomialEvaluate(this%pres_poly%coefficients, &
2611) capillary_pressure,Se,dSe_dpc)
2612) liquid_saturation = this%Sr + (1.d0-this%Sr)*Se
2613) dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
2614) return
2615) endif
2616) else
2617) if (capillary_pressure < 1.d0/this%alpha) then
2618) liquid_saturation = 1.d0
2619) dsat_dpres = 0.d0
2620) return
2621) endif
2622) endif
2623)
2624) pc_alpha_neg_lambda = (capillary_pressure*this%alpha)**(-this%lambda)
2625) Se = pc_alpha_neg_lambda
2626) dSe_dpc = -this%lambda/capillary_pressure*pc_alpha_neg_lambda
2627) liquid_saturation = this%Sr + (1.d0-this%Sr)*Se
2628) dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
2629)
2630) end subroutine SF_BC_Saturation
2631) ! End SF: Brooks-Corey
2632)
2633) ! ************************************************************************** !
2634)
2635) ! Begin SF: Linear Model
2636) function SF_Linear_Create()
2637)
2638) ! Creates the van Genutchten capillary pressure function object
2639)
2640) implicit none
2641)
2642) class(sat_func_Linear_type), pointer :: SF_Linear_Create
2643)
2644) allocate(SF_Linear_Create)
2645) call SF_Linear_Create%Init()
2646)
2647) end function SF_Linear_Create
2648)
2649) ! ************************************************************************** !
2650)
2651) subroutine SF_Linear_Init(this)
2652)
2653) ! Creates the van Genutchten capillary pressure function object
2654)
2655) implicit none
2656)
2657) class(sat_func_Linear_type) :: this
2658)
2659) call SFBaseInit(this)
2660) this%alpha = UNINITIALIZED_DOUBLE
2661)
2662) end subroutine SF_Linear_Init
2663)
2664) ! ************************************************************************** !
2665)
2666) subroutine SF_Linear_Verify(this,name,option)
2667)
2668) use Option_module
2669)
2670) implicit none
2671)
2672) class(sat_func_Linear_type) :: this
2673) character(len=MAXSTRINGLENGTH) :: name
2674) type(option_type) :: option
2675)
2676) character(len=MAXSTRINGLENGTH) :: string
2677)
2678) if (index(name,'SATURATION_FUNCTION') > 0) then
2679) string = name
2680) else
2681) string = trim(name) // 'SATURATION_FUNCTION,LINEAR'
2682) endif
2683) call SFBaseVerify(this,string,option)
2684) if (Uninitialized(this%alpha)) then
2685) option%io_buffer = UninitializedMessage('ALPHA',string)
2686) call printErrMsg(option)
2687) endif
2688)
2689) end subroutine SF_Linear_Verify
2690)
2691) ! ************************************************************************** !
2692)
2693) subroutine SF_Linear_CapillaryPressure(this,liquid_saturation, &
2694) capillary_pressure,option)
2695) !
2696) ! Computes the capillary_pressure as a function of saturation
2697) !
2698) !
2699)
2700) ! Author: Bwalya Malama, Heeho Park
2701) ! Date: 11/14/14
2702) !
2703) use Option_module
2704)
2705) implicit none
2706)
2707) class(sat_func_Linear_type) :: this
2708) PetscReal, intent(in) :: liquid_saturation
2709) PetscReal, intent(out) :: capillary_pressure
2710) type(option_type), intent(inout) :: option
2711)
2712) PetscReal :: Se
2713)
2714) if (liquid_saturation <= this%Sr) then
2715) capillary_pressure = this%pcmax
2716) return
2717) else if (liquid_saturation >= 1.d0) then
2718) capillary_pressure = 0.d0
2719) return
2720) endif
2721)
2722) Se = (liquid_saturation-this%Sr)/(1.d0-this%Sr)
2723) capillary_pressure = (1.d0/this%alpha-this%pcmax)*Se + this%pcmax
2724) #if defined(MATCH_TOUGH2)
2725) if (liquid_saturation > 0.999d0) then
2726) capillary_pressure = capillary_pressure*(1.d0-liquid_saturation)/0.001d0
2727) endif
2728) #endif
2729)
2730) capillary_pressure = min(capillary_pressure,this%pcmax)
2731)
2732) end subroutine SF_Linear_CapillaryPressure
2733)
2734) ! ************************************************************************** !
2735)
2736) subroutine SF_Linear_Saturation(this,capillary_pressure,liquid_saturation, &
2737) dsat_dpres,option)
2738) !
2739) ! Computes the saturation (and associated derivatives) as a function of
2740) ! capillary pressure
2741) !
2742) !
2743) ! Author: Bwalya Malama, Heeho Park
2744) ! Date: 11/14/14
2745) !
2746) use Option_module
2747) use Utility_module
2748)
2749) implicit none
2750)
2751) class(sat_func_Linear_type) :: this
2752) PetscReal, intent(in) :: capillary_pressure
2753) PetscReal, intent(out) :: liquid_saturation
2754) PetscReal, intent(out) :: dsat_dpres
2755) type(option_type), intent(inout) :: option
2756)
2757) PetscReal :: Se
2758) PetscReal :: dSe_dpc
2759)
2760) dsat_dpres = 0.d0
2761)
2762) if (capillary_pressure <= 0.d0) then
2763) liquid_saturation = 1.d0
2764) return
2765) else
2766) Se = (this%pcmax-capillary_pressure) / (this%pcmax-1.d0/this%alpha)
2767) dSe_dpc = -1.d0/(this%pcmax-1.d0/this%alpha)
2768) liquid_saturation = this%Sr + (1.d0-this%Sr)*Se
2769) dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
2770) endif
2771)
2772) end subroutine SF_Linear_Saturation
2773) ! End SF: Linear Model
2774)
2775) ! ************************************************************************** !
2776)
2777) ! Begin SF: BRAGFLO KRP9 Model
2778) function SF_BF_KRP9_Create()
2779)
2780) ! Creates the van Genutchten capillary pressure function object
2781)
2782) implicit none
2783)
2784) class(sat_func_BF_KRP9_type), pointer :: SF_BF_KRP9_Create
2785)
2786) allocate(SF_BF_KRP9_Create)
2787) call SF_BF_KRP9_Create%Init()
2788)
2789) end function SF_BF_KRP9_Create
2790)
2791) ! ************************************************************************** !
2792)
2793) subroutine SF_BF_KRP9_Init(this)
2794)
2795) ! Creates the van Genutchten capillary pressure function object
2796)
2797) implicit none
2798)
2799) class(sat_func_BF_KRP9_type) :: this
2800)
2801) call SFBaseInit(this)
2802)
2803) end subroutine SF_BF_KRP9_Init
2804)
2805) ! ************************************************************************** !
2806)
2807) subroutine SF_BF_KRP9_Verify(this,name,option)
2808)
2809) use Option_module
2810)
2811) implicit none
2812)
2813) class(sat_func_BF_KRP9_type) :: this
2814) character(len=MAXSTRINGLENGTH) :: name
2815) type(option_type) :: option
2816)
2817) character(len=MAXSTRINGLENGTH) :: string
2818)
2819) if (index(name,'SATURATION_FUNCTION') > 0) then
2820) string = name
2821) else
2822) string = trim(name) // 'SATURATION_FUNCTION,BRAGFLO_KRP9'
2823) endif
2824) call SFBaseVerify(this,string,option)
2825)
2826) end subroutine SF_BF_KRP9_Verify
2827)
2828) ! ************************************************************************** !
2829)
2830) subroutine SF_BF_KRP9_CapillaryPressure(this,liquid_saturation, &
2831) capillary_pressure,option)
2832) !
2833) ! Computes the capillary_pressure as a function of saturation
2834) ! based on experimental measurements and analyses done by Vauclin et al.
2835) ! as discussed by Moridis and Pruess.
2836) ! 14. Moridis, G. J., and K. Pruess. 1992. TOUGH Simulations of
2837) ! Updegraff\92s Set of Fluid and Heat Flow Problems. LBL-32611, ERMS# 138458.
2838) ! Berkeley, CA: Lawrence Berkeley Laboratory.
2839) ! Author: Heeho Park
2840) ! Date: 03/26/15
2841) !
2842) use Option_module
2843)
2844) implicit none
2845)
2846) class(sat_func_BF_KRP9_type) :: this
2847) PetscReal, intent(in) :: liquid_saturation
2848) PetscReal, intent(out) :: capillary_pressure
2849) type(option_type), intent(inout) :: option
2850)
2851) PetscReal :: Se
2852)
2853) if (liquid_saturation <= this%Sr) then
2854) capillary_pressure = 0.d0
2855) return
2856) else if (liquid_saturation >= 1.d0) then
2857) capillary_pressure = 0.d0
2858) return
2859) endif
2860)
2861) Se = (1.d0-liquid_saturation)/(liquid_saturation)
2862) capillary_pressure = 3783.0145d0*Se**(1.d0/2.9d0)
2863) #if defined(MATCH_TOUGH2)
2864) if (liquid_saturation > 0.999d0) then
2865) capillary_pressure = capillary_pressure*(1.d0-liquid_saturation)/0.001d0
2866) endif
2867) #endif
2868)
2869) ! capillary_pressure = min(capillary_pressure,this%pcmax)
2870)
2871) end subroutine SF_BF_KRP9_CapillaryPressure
2872)
2873) ! ************************************************************************** !
2874)
2875) subroutine SF_BF_KRP9_Saturation(this,capillary_pressure,liquid_saturation, &
2876) dsat_dpres,option)
2877) !
2878) ! Computes the saturation (and associated derivatives) as a function of
2879) ! capillary pressure
2880) !
2881) !
2882) ! Author: Heeho Park
2883) ! Date: 03/26/15
2884) !
2885) use Option_module
2886) use Utility_module
2887)
2888) implicit none
2889)
2890) class(sat_func_BF_KRP9_type) :: this
2891) PetscReal, intent(in) :: capillary_pressure
2892) PetscReal, intent(out) :: liquid_saturation
2893) PetscReal, intent(out) :: dsat_dpres
2894) type(option_type), intent(inout) :: option
2895)
2896) PetscReal :: Se
2897) PetscReal :: dSe_dpc
2898)
2899) dsat_dpres = 0.d0
2900)
2901) if (capillary_pressure <= 0.d0) then
2902) liquid_saturation = 1.d0
2903) return
2904) else
2905) Se = (capillary_pressure/3783.0145d0)**(2.9d0)
2906) liquid_saturation = 1.d0 / (Se-1.d0)
2907) endif
2908)
2909) end subroutine SF_BF_KRP9_Saturation
2910) ! End SF: BRAGFLO KRP9 Model
2911)
2912) ! ************************************************************************** !
2913)
2914) ! Begin SF: BRAGFLO KRP4 Model
2915)
2916) function SF_BF_KRP4_Create()
2917)
2918) ! Creates the van Genutchten capillary pressure function object
2919)
2920) implicit none
2921)
2922) class(sat_func_BF_KRP4_type), pointer :: SF_BF_KRP4_Create
2923)
2924) allocate(SF_BF_KRP4_Create)
2925) call SF_BF_KRP4_Create%Init()
2926)
2927) end function SF_BF_KRP4_Create
2928)
2929) ! ************************************************************************** !
2930)
2931) subroutine SF_BF_KRP4_Verify(this,name,option)
2932)
2933) use Option_module
2934)
2935) implicit none
2936)
2937) class(sat_func_BF_KRP4_type) :: this
2938) character(len=MAXSTRINGLENGTH) :: name
2939) type(option_type) :: option
2940)
2941) character(len=MAXSTRINGLENGTH) :: string
2942)
2943) if (index(name,'SATURATION_FUNCTION') > 0) then
2944) string = name
2945) else
2946) string = trim(name) // 'SATURATION_FUNCTION,BROOKS_COREY'
2947) endif
2948) call SFBaseVerify(this,string,option)
2949) if (Uninitialized(this%alpha)) then
2950) option%io_buffer = UninitializedMessage('ALPHA',string)
2951) call printErrMsg(option)
2952) endif
2953) if (Uninitialized(this%lambda)) then
2954) option%io_buffer = UninitializedMessage('LAMBDA',string)
2955) call printErrMsg(option)
2956) endif
2957) if (Uninitialized(this%Srg)) then
2958) option%io_buffer = UninitializedMessage('Srg',string)
2959) call printErrMsg(option)
2960) endif
2961) if (Uninitialized(this%pcmax_flag)) then
2962) option%io_buffer = UninitializedMessage('KPC',string)
2963) call printErrMsg(option)
2964) endif
2965)
2966) end subroutine SF_BF_KRP4_Verify
2967)
2968) ! ************************************************************************** !
2969)
2970) subroutine SF_BF_KRP4_CapillaryPressure(this,liquid_saturation, &
2971) capillary_pressure,option)
2972) !
2973) ! Computes the capillary_pressure as a function of saturation using the
2974) ! Brooks-Corey formulation
2975) !
2976) ! Modified according to KRP=4 option of BRAGFLO
2977) ! Explanation: residual gas saturation in the calculation of effective
2978) ! saturation
2979) ! There is no usage of Pc Max unless KPC card is defined as 2. If KPC = 0,
2980) ! then there is no cut off in Pc Max
2981) ! Author: Heeho Park
2982) ! Date: 11/14/15
2983) !
2984) use Option_module
2985) use Utility_module
2986)
2987) implicit none
2988)
2989) class(sat_func_BF_KRP4_type) :: this
2990) PetscReal, intent(in) :: liquid_saturation
2991) PetscReal, intent(out) :: capillary_pressure
2992) type(option_type), intent(inout) :: option
2993)
2994) PetscReal :: Se
2995) PetscReal :: dummy_real
2996)
2997) if (liquid_saturation >= 1.d0) then
2998) capillary_pressure = 0.d0
2999) return
3000) endif
3001)
3002) if (this%alpha > 1.0d20) then
3003) capillary_pressure = 0.d0
3004) return
3005) endif
3006)
3007) Se = (liquid_saturation-this%Sr)/(1.d0-this%Sr-this%Srg)
3008)
3009) if (Se > 1.d0) then
3010) Se = 1.d0
3011) else if (Se < 0.d0) then
3012) Se = 0.d0
3013) endif
3014)
3015) if (associated(this%sat_poly)) then
3016) if (Se > this%sat_poly%low) then
3017) call QuadraticPolynomialEvaluate(this%sat_poly%coefficients(1:3), &
3018) Se,capillary_pressure,dummy_real)
3019) return
3020) endif
3021) endif
3022)
3023) capillary_pressure = (Se**(-1.d0/this%lambda))/this%alpha
3024)
3025) if (this%pcmax_flag == 2) then
3026) capillary_pressure = min(capillary_pressure,this%pcmax)
3027) endif
3028)
3029) end subroutine SF_BF_KRP4_CapillaryPressure
3030)
3031) ! ************************************************************************** !
3032)
3033) subroutine SF_BF_KRP4_Saturation(this,capillary_pressure,liquid_saturation, &
3034) dsat_dpres,option)
3035) !
3036) ! Computes the capillary_pressure as a function of saturation using the
3037) ! Brooks-Corey formulation
3038) !
3039) ! Modified according to KRP=4 option of BRAGFLO
3040) ! Explanation: residual gas saturation in the calculation of effective
3041) ! saturation
3042) ! There is no usage of Pc Max unless KPC card is defined as 2. If KPC = 0,
3043) ! then there is no cut off in Pc Max
3044) ! Author: Heeho Park
3045) ! Date: 11/14/15
3046) !
3047) use Option_module
3048) use Utility_module
3049)
3050) implicit none
3051)
3052) class(sat_func_BF_KRP4_type) :: this
3053) PetscReal, intent(in) :: capillary_pressure
3054) PetscReal, intent(out) :: liquid_saturation
3055) PetscReal, intent(out) :: dsat_dpres
3056) type(option_type), intent(inout) :: option
3057)
3058) PetscReal :: pc_alpha_neg_lambda
3059) PetscReal :: Se
3060) PetscReal :: dSe_dpc
3061)
3062) dsat_dpres = 0.d0
3063)
3064) ! reference #1
3065) if (associated(this%pres_poly)) then
3066) if (capillary_pressure < this%pres_poly%low) then
3067) liquid_saturation = 1.d0
3068) return
3069) else if (capillary_pressure < this%pres_poly%high) then
3070) call CubicPolynomialEvaluate(this%pres_poly%coefficients, &
3071) capillary_pressure,Se,dSe_dpc)
3072) liquid_saturation = this%Sr + (1.d0-this%Sr-this%Srg)*Se
3073) dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
3074) return
3075) endif
3076) else
3077) if (capillary_pressure < 1.d0/this%alpha) then
3078) liquid_saturation = 1.d0
3079) dsat_dpres = 0.d0
3080) return
3081) endif
3082) endif
3083)
3084) pc_alpha_neg_lambda = (capillary_pressure*this%alpha)**(-this%lambda)
3085) Se = pc_alpha_neg_lambda
3086) dSe_dpc = -this%lambda/capillary_pressure*pc_alpha_neg_lambda
3087) liquid_saturation = this%Sr + (1.d0-this%Sr-this%Srg)*Se
3088) dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
3089)
3090) end subroutine SF_BF_KRP4_Saturation
3091)
3092) ! End SF: BRAGFLO KRP4 Model
3093)
3094) ! ************************************************************************** !
3095) ! Begin SF: BRAGFLO KRP11 Model
3096) function SF_BF_KRP11_Create()
3097)
3098) ! Creates the van Genutchten capillary pressure function object
3099)
3100) implicit none
3101)
3102) class(sat_func_BF_KRP11_type), pointer :: SF_BF_KRP11_Create
3103)
3104) allocate(SF_BF_KRP11_Create)
3105) call SF_BF_KRP11_Create%Init()
3106)
3107) end function SF_BF_KRP11_Create
3108)
3109) ! ************************************************************************** !
3110)
3111) subroutine SF_BF_KRP11_Init(this)
3112)
3113) ! Creates the van Genutchten capillary pressure function object
3114)
3115) implicit none
3116)
3117) class(sat_func_BF_KRP11_type) :: this
3118)
3119) call SFBaseInit(this)
3120)
3121) end subroutine SF_BF_KRP11_Init
3122)
3123) ! ************************************************************************** !
3124)
3125) subroutine SF_BF_KRP11_Verify(this,name,option)
3126)
3127) use Option_module
3128)
3129) implicit none
3130)
3131) class(sat_func_BF_KRP11_type) :: this
3132) character(len=MAXSTRINGLENGTH) :: name
3133) type(option_type) :: option
3134)
3135) character(len=MAXSTRINGLENGTH) :: string
3136)
3137) if (index(name,'SATURATION_FUNCTION') > 0) then
3138) string = name
3139) else
3140) string = trim(name) // 'SATURATION_FUNCTION,BRAGFLO_KRP11'
3141) endif
3142) call SFBaseVerify(this,string,option)
3143)
3144) end subroutine SF_BF_KRP11_Verify
3145)
3146) ! ************************************************************************** !
3147)
3148) subroutine SF_BF_KRP11_CapillaryPressure(this,liquid_saturation, &
3149) capillary_pressure,option)
3150) !
3151) ! KRP=11 of BRAGFLO
3152) ! capillary pressure is 0 at all times
3153) ! Author: Heeho Park
3154) ! Date: 03/26/15
3155) !
3156) use Option_module
3157)
3158) implicit none
3159)
3160) class(sat_func_BF_KRP11_type) :: this
3161) PetscReal, intent(in) :: liquid_saturation
3162) PetscReal, intent(out) :: capillary_pressure
3163) type(option_type), intent(inout) :: option
3164)
3165) capillary_pressure = 0.0d0
3166)
3167) end subroutine SF_BF_KRP11_CapillaryPressure
3168)
3169) ! ************************************************************************** !
3170)
3171) subroutine SF_BF_KRP11_Saturation(this,capillary_pressure,liquid_saturation, &
3172) dsat_dpres,option)
3173) !
3174) ! Computes the saturation (and associated derivatives) as a function of
3175) ! capillary pressure
3176) !
3177) !
3178) ! Author: Heeho Park
3179) ! Date: 03/26/15
3180) !
3181) use Option_module
3182) use Utility_module
3183)
3184) implicit none
3185)
3186) class(sat_func_BF_KRP11_type) :: this
3187) PetscReal, intent(in) :: capillary_pressure
3188) PetscReal, intent(out) :: liquid_saturation
3189) PetscReal, intent(out) :: dsat_dpres
3190) type(option_type), intent(inout) :: option
3191)
3192) PetscReal :: Se
3193) PetscReal :: dSe_dpc
3194)
3195) dsat_dpres = 0.d0
3196)
3197) liquid_saturation = 1.d0
3198)
3199) end subroutine SF_BF_KRP11_Saturation
3200) ! End SF: BRAGFLO KRP11 Model
3201)
3202) ! ************************************************************************** !
3203)
3204) ! Begin SF: BRAGFLO KRP12 Model
3205)
3206) function SF_BF_KRP12_Create()
3207)
3208) ! Creates the van Genutchten capillary pressure function object
3209)
3210) implicit none
3211)
3212) class(sat_func_BF_KRP12_type), pointer :: SF_BF_KRP12_Create
3213)
3214) allocate(SF_BF_KRP12_Create)
3215) call SF_BF_KRP12_Create%Init()
3216)
3217) end function SF_BF_KRP12_Create
3218)
3219) ! ************************************************************************** !
3220)
3221) subroutine SF_BF_KRP12_Verify(this,name,option)
3222)
3223) use Option_module
3224)
3225) implicit none
3226)
3227) class(sat_func_BF_KRP12_type) :: this
3228) character(len=MAXSTRINGLENGTH) :: name
3229) type(option_type) :: option
3230)
3231) character(len=MAXSTRINGLENGTH) :: string
3232)
3233) if (index(name,'SATURATION_FUNCTION') > 0) then
3234) string = name
3235) else
3236) string = trim(name) // 'SATURATION_FUNCTION,BROOKS_COREY'
3237) endif
3238) call SFBaseVerify(this,string,option)
3239) if (Uninitialized(this%socmin)) then
3240) option%io_buffer = UninitializedMessage('ALPHA',string)
3241) call printErrMsg(option)
3242) endif
3243) if (Uninitialized(this%soceffmin)) then
3244) option%io_buffer = UninitializedMessage('LAMBDA',string)
3245) call printErrMsg(option)
3246) endif
3247) if (Uninitialized(this%Srg)) then
3248) option%io_buffer = UninitializedMessage('Srg',string)
3249) call printErrMsg(option)
3250) endif
3251)
3252) end subroutine SF_BF_KRP12_Verify
3253) ! ************************************************************************** !
3254)
3255) subroutine SF_BF_KRP12_CapillaryPressure(this,liquid_saturation, &
3256) capillary_pressure,option)
3257) !
3258) ! Computes the capillary_pressure as a function of saturation using the
3259) ! Brooks-Corey formulation
3260) !
3261) ! Modified according to KRP=12 option of BRAGFLO
3262) ! Explanation: The relative permeabilities are unchanged from the
3263) ! modified Brooks-Corey model but the capillary presssure is
3264) ! calculated with modified saturation
3265) ! Author: Heeho Park
3266) ! Date: 11/14/15
3267) !
3268) use Option_module
3269) use Utility_module
3270)
3271) implicit none
3272)
3273) class(sat_func_BF_KRP12_type) :: this
3274) PetscReal, intent(in) :: liquid_saturation
3275) PetscReal, intent(out) :: capillary_pressure
3276) type(option_type), intent(inout) :: option
3277)
3278) PetscReal :: Se
3279) PetscReal :: dummy_real
3280) PetscReal :: soczro
3281)
3282) soczro = this%socmin - this%soceffmin
3283)
3284) if (liquid_saturation >= 1.d0) then
3285) capillary_pressure = 0.d0
3286) return
3287) endif
3288)
3289) if (this%alpha > 1.0d20) then
3290) capillary_pressure = 0.d0
3291) return
3292) endif
3293)
3294) Se = (liquid_saturation-soczro)/(1.d0-soczro)
3295) Se = max(min(Se,1.0d0),this%soceffmin)
3296)
3297) if (associated(this%sat_poly)) then
3298) if (Se > this%sat_poly%low) then
3299) call QuadraticPolynomialEvaluate(this%sat_poly%coefficients(1:3), &
3300) Se,capillary_pressure,dummy_real)
3301) return
3302) endif
3303) endif
3304)
3305) capillary_pressure = (Se**(-1.d0/this%lambda))/this%alpha
3306)
3307) end subroutine SF_BF_KRP12_CapillaryPressure
3308)
3309) ! End SF: BRAGFLO KRP12 Model
3310)
3311) ! ************************************************************************** !
3312)
3313) ! Begin RPF: Mualem, Van Genuchten (Liquid)
3314) function RPF_Mualem_VG_Liq_Create()
3315)
3316) ! Creates the van Genutchten Mualem relative permeability function object
3317)
3318) implicit none
3319)
3320) class(rpf_Mualem_vg_liq_type), pointer :: RPF_Mualem_VG_Liq_Create
3321)
3322) allocate(RPF_Mualem_VG_Liq_Create)
3323) call RPF_Mualem_VG_Liq_Create%Init()
3324)
3325) end function RPF_Mualem_VG_Liq_Create
3326)
3327) ! ************************************************************************** !
3328)
3329) subroutine RPF_Mualem_VG_Liq_Init(this)
3330)
3331) ! Initializes the van Genutchten Mualem relative permeability function
3332) ! object
3333)
3334) implicit none
3335)
3336) class(rpf_Mualem_VG_liq_type) :: this
3337)
3338) call RPFBaseInit(this)
3339) this%m = UNINITIALIZED_DOUBLE
3340)
3341) end subroutine RPF_Mualem_VG_Liq_Init
3342)
3343) ! ************************************************************************** !
3344)
3345) subroutine RPF_Mualem_VG_Liq_Verify(this,name,option)
3346)
3347) use Option_module
3348)
3349) implicit none
3350)
3351) class(rpf_Mualem_VG_liq_type) :: this
3352) character(len=MAXSTRINGLENGTH) :: name
3353) type(option_type) :: option
3354)
3355) character(len=MAXSTRINGLENGTH) :: string
3356)
3357) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
3358) string = name
3359) else
3360) string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM'
3361) endif
3362) call RPFBaseVerify(this,string,option)
3363) if (Uninitialized(this%m)) then
3364) option%io_buffer = UninitializedMessage('M',string)
3365) call printErrMsg(option)
3366) endif
3367)
3368) end subroutine RPF_Mualem_VG_Liq_Verify
3369)
3370) ! ************************************************************************** !
3371)
3372) subroutine RPF_Mualem_SetupPolynomials(this,option,error_string)
3373)
3374) ! Sets up polynomials for smoothing Mualem permeability function
3375)
3376) use Option_module
3377) use Utility_module
3378)
3379) implicit none
3380)
3381) class(rpf_Mualem_VG_liq_type) :: this
3382) type(option_type) :: option
3383) character(len=MAXSTRINGLENGTH) :: error_string
3384)
3385) PetscReal :: b(4)
3386) PetscReal :: one_over_m, Se_one_over_m, m
3387)
3388) this%poly => PolynomialCreate()
3389) ! fill matix with values
3390) this%poly%low = 0.99d0 ! just below saturated
3391) this%poly%high = 1.d0 ! saturated
3392)
3393) m = this%m
3394) one_over_m = 1.d0/m
3395) Se_one_over_m = this%poly%low**one_over_m
3396) b(1) = 1.d0
3397) b(2) = sqrt(this%poly%low)*(1.d0-(1.d0-Se_one_over_m)**m)**2.d0
3398) b(3) = 0.d0
3399) b(4) = 0.5d0*b(2)/this%poly%low+ &
3400) 2.d0*this%poly%low**(one_over_m-0.5d0)* &
3401) (1.d0-Se_one_over_m)**(m-1.d0)* &
3402) (1.d0-(1.d0-Se_one_over_m)**m)
3403)
3404) call CubicPolynomialSetup(this%poly%high,this%poly%low,b)
3405)
3406) this%poly%coefficients(1:4) = b(1:4)
3407)
3408) end subroutine RPF_Mualem_SetupPolynomials
3409)
3410) ! ************************************************************************** !
3411)
3412) subroutine RPF_Mualem_VG_Liq_RelPerm(this,liquid_saturation, &
3413) relative_permeability,dkr_sat,option)
3414) !
3415) ! Computes the relative permeability (and associated derivatives) as a
3416) ! function of saturation
3417) !
3418) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
3419) ! of two-fluid capillary pressure-saturation and permeability functions",
3420) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
3421) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
3422) !
3423) ! Author: Glenn Hammond
3424) ! Date: 12/11/07, 09/23/14
3425) !
3426) use Option_module
3427) use Utility_module
3428)
3429) implicit none
3430)
3431) class(rpf_Mualem_VG_liq_type) :: this
3432) PetscReal, intent(in) :: liquid_saturation
3433) PetscReal, intent(out) :: relative_permeability
3434) PetscReal, intent(out) :: dkr_sat
3435) type(option_type), intent(inout) :: option
3436)
3437) PetscReal :: Se
3438) PetscReal :: one_over_m
3439) PetscReal :: Se_one_over_m
3440) PetscReal :: dkr_Se
3441) PetscReal :: dSe_sat
3442)
3443) relative_permeability = 0.d0
3444) dkr_sat = 0.d0
3445)
3446) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
3447) if (Se >= 1.d0) then
3448) relative_permeability = 1.d0
3449) return
3450) else if (Se <= 0.d0) then
3451) relative_permeability = 0.d0
3452) return
3453) endif
3454)
3455) if (associated(this%poly)) then
3456) if (Se > this%poly%low) then
3457) call CubicPolynomialEvaluate(this%poly%coefficients, &
3458) Se,relative_permeability,dkr_Se)
3459) return
3460) endif
3461) endif
3462)
3463) one_over_m = 1.d0/this%m
3464) Se_one_over_m = Se**one_over_m
3465) relative_permeability = sqrt(Se)*(1.d0-(1.d0-Se_one_over_m)**this%m)**2.d0
3466) dkr_Se = 0.5d0*relative_permeability/Se+ &
3467) 2.d0*Se**(one_over_m-0.5d0)* &
3468) (1.d0-Se_one_over_m)**(this%m-1.d0)* &
3469) (1.d0-(1.d0-Se_one_over_m)**this%m)
3470) dSe_sat = 1.d0 / (1.d0 - this%Sr)
3471) dkr_sat = dkr_Se * dSe_sat
3472)
3473) end subroutine RPF_Mualem_VG_Liq_RelPerm
3474) ! End RPF: Mualem, Van Genuchten (Liquid)
3475)
3476) ! ************************************************************************** !
3477)
3478) ! Begin RPF: Mualem, Van Genuchten (Gas)
3479) function RPF_Mualem_VG_Gas_Create()
3480)
3481) ! Creates the van Genutchten Mualem gas relative permeability function object
3482)
3483) implicit none
3484)
3485) class(rpf_Mualem_VG_gas_type), pointer :: RPF_Mualem_VG_Gas_Create
3486)
3487) allocate(RPF_Mualem_VG_Gas_Create)
3488) call RPF_Mualem_VG_Gas_Create%Init()
3489)
3490) end function RPF_Mualem_VG_Gas_Create
3491)
3492) ! ************************************************************************** !
3493)
3494) subroutine RPF_Mualem_VG_Gas_Init(this)
3495)
3496) ! Initializes the van Genutchten Mualem gas relative permeability function
3497) ! object
3498)
3499) implicit none
3500)
3501) class(rpf_Mualem_VG_gas_type) :: this
3502)
3503) call RPFBaseInit(this)
3504) this%Srg = UNINITIALIZED_DOUBLE
3505)
3506) end subroutine RPF_Mualem_VG_Gas_Init
3507)
3508) ! ************************************************************************** !
3509)
3510) subroutine RPF_Mualem_VG_Gas_Verify(this,name,option)
3511)
3512) use Option_module
3513)
3514) implicit none
3515)
3516) class(rpf_Mualem_VG_gas_type) :: this
3517) character(len=MAXSTRINGLENGTH) :: name
3518) type(option_type) :: option
3519)
3520) character(len=MAXSTRINGLENGTH) :: string
3521)
3522) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
3523) string = name
3524) else
3525) string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM_VG_GAS'
3526) endif
3527) call RPFBaseVerify(this,string,option)
3528) if (Uninitialized(this%Srg)) then
3529) option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
3530) call printErrMsg(option)
3531) endif
3532)
3533) end subroutine RPF_Mualem_VG_Gas_Verify
3534)
3535) ! ************************************************************************** !
3536)
3537) subroutine RPF_Mualem_VG_Gas_RelPerm(this,liquid_saturation, &
3538) relative_permeability,dkr_sat,option)
3539) !
3540) ! Computes the relative permeability (and associated derivatives) as a
3541) ! function of saturation
3542) !
3543) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
3544) ! of two-fluid capillary pressure-saturation and permeability functions",
3545) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
3546) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
3547) !
3548) ! Author: Glenn Hammond
3549) ! Date: 12/11/07, 09/23/14
3550) !
3551) use Option_module
3552)
3553) implicit none
3554)
3555) class(rpf_Mualem_VG_gas_type) :: this
3556) PetscReal, intent(in) :: liquid_saturation
3557) PetscReal, intent(out) :: relative_permeability
3558) PetscReal, intent(out) :: dkr_sat
3559) type(option_type), intent(inout) :: option
3560)
3561) PetscReal :: Se
3562) PetscReal :: Seg
3563) PetscReal :: dkr_Se
3564) PetscReal :: dSe_sat
3565)
3566) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
3567)
3568) relative_permeability = 0.d0
3569) dkr_sat = UNINITIALIZED_DOUBLE
3570) if (Se >= 1.d0) then
3571) relative_permeability = 0.d0
3572) return
3573) else if (Se <= 0.d0) then
3574) relative_permeability = 1.d0
3575) return
3576) endif
3577)
3578) Seg = 1.d0 - Se
3579) relative_permeability = sqrt(Seg)*(1.d0-Se**(1.d0/this%m))**(2.d0*this%m)
3580) ! Mathematica Analytical solution (Heeho Park)
3581) dkr_Se = -(1.d0-Se**(1.d0/this%m))**(2.d0*this%m)/(2.d0*sqrt(Seg)) &
3582) - 2.d0*sqrt(Seg)*Se**(1.d0/this%m-1.d0) &
3583) * (1.d0-Se**(1.d0/this%m))**(2.d0*this%m-1.d0)
3584) dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
3585) dkr_sat = dkr_Se * dSe_sat
3586)
3587) end subroutine RPF_Mualem_VG_Gas_RelPerm
3588) ! End RPF: Mualem, Van Genuchten (Gas)
3589)
3590) ! ************************************************************************** !
3591)
3592) ! RPF: Tough2 IRP7 w/ VG-Mualem (Gas)
3593) function RPF_TOUGH2_IRP7_Gas_Create()
3594)
3595) ! Creates the Brooks-Corey Burdine gas relative permeability function object
3596)
3597) implicit none
3598)
3599) class(rpf_TOUGH2_IRP7_gas_type), pointer :: RPF_TOUGH2_IRP7_Gas_Create
3600)
3601) allocate(RPF_TOUGH2_IRP7_Gas_Create)
3602) call RPF_TOUGH2_IRP7_Gas_Create%Init()
3603)
3604) end function RPF_TOUGH2_IRP7_Gas_Create
3605)
3606) ! ************************************************************************** !
3607)
3608) subroutine RPF_TOUGH2_IRP7_Gas_Init(this)
3609)
3610) ! Initializes the Brooks-Corey Burdine gas relative permeability function
3611) ! object
3612)
3613) implicit none
3614)
3615) class(rpf_TOUGH2_IRP7_gas_type) :: this
3616)
3617) call RPFBaseInit(this)
3618) this%Srg = UNINITIALIZED_DOUBLE
3619)
3620) end subroutine RPF_TOUGH2_IRP7_Gas_Init
3621)
3622) ! ************************************************************************** !
3623)
3624) subroutine RPF_TOUGH2_IRP7_Gas_Verify(this,name,option)
3625)
3626) use Option_module
3627)
3628) implicit none
3629)
3630) class(rpf_TOUGH2_IRP7_gas_type) :: this
3631) character(len=MAXSTRINGLENGTH) :: name
3632) type(option_type) :: option
3633)
3634) character(len=MAXSTRINGLENGTH) :: string
3635)
3636) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
3637) string = name
3638) else
3639) string = trim(name) // 'PERMEABILITY_FUNCTION,TOUGH2_IRP7_GAS'
3640) endif
3641) call RPFBaseVerify(this,string,option)
3642) if (Uninitialized(this%Srg)) then
3643) option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
3644) call printErrMsg(option)
3645) endif
3646)
3647) end subroutine RPF_TOUGH2_IRP7_Gas_Verify
3648)
3649) ! ************************************************************************** !
3650)
3651) subroutine RPF_TOUGH2_IRP7_Gas_RelPerm(this,liquid_saturation, &
3652) relative_permeability,dkr_sat,option)
3653) !
3654) ! TOUGH2 IRP(7) equations from Appendix G of TOUGH2 user manual
3655) !
3656) use Option_module
3657)
3658) implicit none
3659)
3660) class(rpf_TOUGH2_IRP7_gas_type) :: this
3661) PetscReal, intent(in) :: liquid_saturation
3662) PetscReal, intent(out) :: relative_permeability
3663) PetscReal, intent(out) :: dkr_sat
3664) type(option_type), intent(inout) :: option
3665)
3666) PetscReal :: liquid_relative_permeability
3667) PetscReal :: liquid_dkr_sat
3668) PetscReal :: Se
3669) PetscReal :: Seg
3670) PetscReal :: dkr_Se
3671) PetscReal :: dSe_sat
3672)
3673) relative_permeability = 0.d0
3674) dkr_sat = 0.d0
3675) dkr_sat = dkr_sat / 0.d0
3676) dkr_sat = dkr_sat * 0.d0
3677)
3678) ! essentially zero
3679) if (this%Srg <= 0.d0) then
3680) call RPF_Mualem_VG_Liq_RelPerm(this,liquid_saturation, &
3681) liquid_relative_permeability, &
3682) liquid_dkr_sat,option)
3683) relative_permeability = 1.d0 - liquid_relative_permeability
3684) return
3685) endif
3686)
3687) if ((1.d0 - liquid_saturation) <= this%Srg) then
3688) relative_permeability = 0.d0
3689) else
3690) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
3691) Seg = 1.d0 - Se
3692) relative_permeability = Seg**2*(1.d0-Se*Se)
3693) ! Mathematica Analytical solution (Heeho Park)
3694) dkr_Se = -2.d0*Seg**2.d0*Se - 2.d0*Seg*(1.d0-Se**2.d0)
3695) dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
3696) dkr_sat = dkr_Se * dSe_sat
3697) endif
3698)
3699) end subroutine RPF_TOUGH2_IRP7_Gas_RelPerm
3700) ! End RPF: Tough2 IRP7 w/ VG-Mualem (Gas)
3701)
3702) ! ************************************************************************** !
3703)
3704) ! Begin RPF: Burdine, Brooks-Corey (Liquid)
3705) function RPF_Burdine_BC_Liq_Create()
3706)
3707) ! Creates the Brooks-Corey Burdine relative permeability function object
3708)
3709) implicit none
3710)
3711) class(rpf_Burdine_BC_Liq_type), pointer :: RPF_Burdine_BC_Liq_Create
3712)
3713) allocate(RPF_Burdine_BC_Liq_Create)
3714) call RPF_Burdine_BC_Liq_Create%Init()
3715)
3716) end function RPF_Burdine_BC_Liq_Create
3717)
3718) ! ************************************************************************** !
3719)
3720) subroutine RPF_Burdine_BC_Liq_Init(this)
3721)
3722) ! Initializes the Brooks-Corey Burdine relative permeability function object
3723)
3724) implicit none
3725)
3726) class(rpf_Burdine_BC_Liq_type) :: this
3727)
3728) call RPFBaseInit(this)
3729) this%lambda = UNINITIALIZED_DOUBLE
3730)
3731) end subroutine RPF_Burdine_BC_Liq_Init
3732)
3733) ! ************************************************************************** !
3734)
3735) subroutine RPF_Burdine_BC_Liq_Verify(this,name,option)
3736)
3737) ! Initializes the Brooks-Corey Burdine relative permeability function object
3738)
3739) use Option_module
3740)
3741) implicit none
3742)
3743) class(rpf_Burdine_BC_liq_type) :: this
3744) character(len=MAXSTRINGLENGTH) :: name
3745) type(option_type) :: option
3746)
3747) character(len=MAXSTRINGLENGTH) :: string
3748)
3749) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
3750) string = name
3751) else
3752) string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE'
3753) endif
3754) call RPFBaseVerify(this,name,option)
3755) if (Uninitialized(this%lambda)) then
3756) option%io_buffer = UninitializedMessage('LAMBDA',string)
3757) call printErrMsg(option)
3758) endif
3759)
3760) end subroutine RPF_Burdine_BC_Liq_Verify
3761)
3762) ! ************************************************************************** !
3763)
3764) subroutine RPF_Burdine_BC_Liq_RelPerm(this,liquid_saturation, &
3765) relative_permeability,dkr_sat,option)
3766) !
3767) ! Computes the relative permeability (and associated derivatives) as a
3768) ! function of saturation
3769) !
3770) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
3771) ! of two-fluid capillary pressure-saturation and permeability functions",
3772) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
3773) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
3774) !
3775) ! Author: Glenn Hammond
3776) ! Date: 12/11/07, 09/23/14
3777) !
3778) use Option_module
3779)
3780) implicit none
3781)
3782) class(rpf_Burdine_BC_Liq_type) :: this
3783) PetscReal, intent(in) :: liquid_saturation
3784) PetscReal, intent(out) :: relative_permeability
3785) PetscReal, intent(out) :: dkr_sat
3786) type(option_type), intent(inout) :: option
3787)
3788) PetscReal :: Se
3789) PetscReal :: power
3790) PetscReal :: dkr_Se
3791) PetscReal :: dSe_sat
3792)
3793) relative_permeability = 0.d0
3794) dkr_sat = 0.d0
3795)
3796) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
3797) if (Se >= 1.d0) then
3798) relative_permeability = 1.d0
3799) return
3800) else if (Se <= 0.d0) then
3801) relative_permeability = 0.d0
3802) return
3803) endif
3804)
3805) ! reference #1
3806) power = 3.d0+2.d0/this%lambda
3807) relative_permeability = Se**power
3808) dkr_Se = power*relative_permeability/Se
3809) dSe_sat = 1.d0 / (1.d0 - this%Sr)
3810) dkr_sat = dkr_Se * dSe_sat
3811)
3812) end subroutine RPF_Burdine_BC_Liq_RelPerm
3813) ! End RPF: Burdine, Brooks-Corey (Liquid)
3814)
3815) ! ************************************************************************** !
3816)
3817) ! Begin RPF: Burdine, Brooks-Corey (Gas)
3818) function RPF_Burdine_BC_Gas_Create()
3819)
3820) ! Creates the Brooks-Corey Burdine gas relative permeability function
3821) ! object
3822)
3823) implicit none
3824)
3825) class(rpf_Burdine_BC_gas_type), pointer :: RPF_Burdine_BC_Gas_Create
3826)
3827) allocate(RPF_Burdine_BC_Gas_Create)
3828) call RPF_Burdine_BC_Gas_Create%Init()
3829)
3830) end function RPF_Burdine_BC_Gas_Create
3831)
3832) ! ************************************************************************** !
3833)
3834) subroutine RPF_Burdine_BC_Gas_Init(this)
3835)
3836) ! Initializes the Brooks-Corey Burdine gas relative permeability function
3837) ! object
3838)
3839) implicit none
3840)
3841) class(rpf_Burdine_BC_gas_type) :: this
3842)
3843) call RPFBaseInit(this)
3844) this%Srg = UNINITIALIZED_DOUBLE
3845)
3846) end subroutine RPF_Burdine_BC_Gas_Init
3847)
3848) ! ************************************************************************** !
3849)
3850) subroutine RPF_Burdine_BC_Gas_Verify(this,name,option)
3851)
3852) use Option_module
3853)
3854) implicit none
3855)
3856) class(rpf_Burdine_BC_gas_type) :: this
3857) character(len=MAXSTRINGLENGTH) :: name
3858) type(option_type) :: option
3859)
3860) character(len=MAXSTRINGLENGTH) :: string
3861)
3862) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
3863) string = name
3864) else
3865) string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE_BC_GAS'
3866) endif
3867) call RPFBaseVerify(this,string,option)
3868) if (Uninitialized(this%Srg)) then
3869) option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
3870) call printErrMsg(option)
3871) endif
3872)
3873) end subroutine RPF_Burdine_BC_Gas_Verify
3874)
3875) ! ************************************************************************** !
3876)
3877) subroutine RPF_Burdine_BC_Gas_RelPerm(this,liquid_saturation, &
3878) relative_permeability,dkr_sat,option)
3879) !
3880) ! Computes the relative permeability (and associated derivatives) as a
3881) ! function of saturation
3882) !
3883) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
3884) ! of two-fluid capillary pressure-saturation and permeability functions",
3885) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
3886) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
3887) !
3888) ! Author: Glenn Hammond
3889) ! Date: 12/11/07, 09/23/14
3890) !
3891) use Option_module
3892)
3893) implicit none
3894)
3895) class(rpf_Burdine_BC_gas_type) :: this
3896) PetscReal, intent(in) :: liquid_saturation
3897) PetscReal, intent(out) :: relative_permeability
3898) PetscReal, intent(out) :: dkr_sat
3899) type(option_type), intent(inout) :: option
3900)
3901) PetscReal :: Se
3902) PetscReal :: Seg
3903) PetscReal :: dkr_Se
3904) PetscReal :: dSe_sat
3905)
3906) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
3907)
3908) relative_permeability = 0.d0
3909) dkr_sat = UNINITIALIZED_DOUBLE
3910) if (Se >= 1.d0) then
3911) relative_permeability = 0.d0
3912) return
3913) else if (Se <= 0.d0) then
3914) relative_permeability = 1.d0
3915) return
3916) endif
3917)
3918) Seg = 1.d0 - Se
3919) ! reference #1
3920) relative_permeability = Seg*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
3921) ! Mathematica Analytical solution (Heeho Park)
3922) dkr_Se = -(1.d0+2.d0/this%lambda)*Seg**2.d0*Se**(2.d0/this%lambda) &
3923) - 2.d0*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
3924) dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
3925) dkr_sat = dkr_Se * dSe_sat
3926)
3927) end subroutine RPF_Burdine_BC_Gas_RelPerm
3928) ! End RPF: Burdine, Brooks-Corey (Gas)
3929)
3930) ! ************************************************************************** !
3931)
3932) ! Begin RPF: Mualem, Brooks-Corey (Liq)
3933) function RPF_Mualem_BC_Liq_Create()
3934)
3935) ! Creates the Brooks-Corey Mualem liquid relative permeability function object
3936)
3937) implicit none
3938)
3939) class(rpf_Mualem_BC_liq_type), pointer :: RPF_Mualem_BC_Liq_Create
3940)
3941) allocate(RPF_Mualem_BC_Liq_Create)
3942) call RPF_Mualem_BC_Liq_Create%Init()
3943)
3944) end function RPF_Mualem_BC_Liq_Create
3945)
3946) ! ************************************************************************** !
3947)
3948) subroutine RPF_Mualem_BC_Liq_Init(this)
3949)
3950) ! Initializes the Brooks-Corey Mualem liquid relative permeability function
3951) ! object
3952)
3953) implicit none
3954)
3955) class(rpf_Mualem_BC_liq_type) :: this
3956)
3957) call RPFBaseInit(this)
3958) this%lambda = UNINITIALIZED_DOUBLE
3959)
3960) end subroutine RPF_Mualem_BC_Liq_Init
3961)
3962) ! ************************************************************************** !
3963)
3964) subroutine RPF_Mualem_BC_Liq_Verify(this,name,option)
3965)
3966) ! Initializes the Brooks-Corey Mualem liquid relative permeability function object
3967)
3968) use Option_module
3969)
3970) implicit none
3971)
3972) class(rpf_Mualem_BC_liq_type) :: this
3973) character(len=MAXSTRINGLENGTH) :: name
3974) type(option_type) :: option
3975)
3976) character(len=MAXSTRINGLENGTH) :: string
3977)
3978) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
3979) string = name
3980) else
3981) string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM'
3982) endif
3983) call RPFBaseVerify(this,name,option)
3984) if (Uninitialized(this%lambda)) then
3985) option%io_buffer = UninitializedMessage('LAMBDA',string)
3986) call printErrMsg(option)
3987) endif
3988)
3989) end subroutine RPF_Mualem_BC_Liq_Verify
3990)
3991) ! ************************************************************************** !
3992)
3993) subroutine RPF_Mualem_BC_Liq_RelPerm(this,liquid_saturation, &
3994) relative_permeability,dkr_sat,option)
3995) !
3996) ! Computes the relative permeability (and associated derivatives) as a
3997) ! function of saturation
3998) !
3999) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
4000) ! of two-fluid capillary pressure-saturation and permeability functions",
4001) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
4002) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
4003) !
4004) ! Author: Glenn Hammond
4005) ! Date: 12/11/07, 09/23/14
4006) !
4007) use Option_module
4008)
4009) implicit none
4010)
4011) class(rpf_Mualem_BC_Liq_type) :: this
4012) PetscReal, intent(in) :: liquid_saturation
4013) PetscReal, intent(out) :: relative_permeability
4014) PetscReal, intent(out) :: dkr_sat
4015) type(option_type), intent(inout) :: option
4016)
4017) PetscReal :: Se
4018) PetscReal :: power
4019) PetscReal :: dkr_Se
4020) PetscReal :: dSe_sat
4021)
4022) relative_permeability = 0.d0
4023) dkr_sat = 0.d0
4024)
4025) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
4026) if (Se >= 1.d0) then
4027) relative_permeability = 1.d0
4028) return
4029) else if (Se <= 0.d0) then
4030) relative_permeability = 0.d0
4031) return
4032) endif
4033)
4034) ! reference #1
4035) power = 2.5d0+2.d0/this%lambda
4036) relative_permeability = Se**power
4037) dkr_Se = power*relative_permeability/Se
4038) dSe_sat = 1.d0 / (1.d0 - this%Sr)
4039) dkr_sat = dkr_Se * dSe_sat
4040)
4041) end subroutine RPF_Mualem_BC_Liq_RelPerm
4042) ! End RPF: Mualem, Brooks-Corey (Liq)
4043)
4044) ! ************************************************************************** !
4045)
4046) ! Begin RPF: Mualem, Brooks-Corey (Gas)
4047) function RPF_Mualem_BC_Gas_Create()
4048)
4049) ! Creates the Brooks-Corey Mualem gas relative permeability function object
4050)
4051) implicit none
4052)
4053) class(rpf_Mualem_BC_gas_type), pointer :: RPF_Mualem_BC_Gas_Create
4054)
4055) allocate(RPF_Mualem_BC_Gas_Create)
4056) call RPF_Mualem_BC_Gas_Create%Init()
4057)
4058) end function RPF_Mualem_BC_Gas_Create
4059)
4060) ! ************************************************************************** !
4061)
4062) subroutine RPF_Mualem_BC_Gas_Init(this)
4063)
4064) ! Initializes the Brooks-Corey Mualem gas relative permeability function
4065) ! object
4066)
4067) implicit none
4068)
4069) class(rpf_Mualem_BC_gas_type) :: this
4070)
4071) call RPFBaseInit(this)
4072) this%Srg = UNINITIALIZED_DOUBLE
4073)
4074) end subroutine RPF_Mualem_BC_Gas_Init
4075)
4076) ! ************************************************************************** !
4077)
4078) subroutine RPF_Mualem_BC_Gas_Verify(this,name,option)
4079)
4080) use Option_module
4081)
4082) implicit none
4083)
4084) class(rpf_Mualem_BC_gas_type) :: this
4085) character(len=MAXSTRINGLENGTH) :: name
4086) type(option_type) :: option
4087)
4088) character(len=MAXSTRINGLENGTH) :: string
4089)
4090) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
4091) string = name
4092) else
4093) string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM_BC_GAS'
4094) endif
4095) call RPFBaseVerify(this,string,option)
4096) if (Uninitialized(this%Srg)) then
4097) option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
4098) call printErrMsg(option)
4099) endif
4100)
4101) end subroutine RPF_Mualem_BC_Gas_Verify
4102)
4103) ! ************************************************************************** !
4104)
4105) subroutine RPF_Mualem_BC_Gas_RelPerm(this,liquid_saturation, &
4106) relative_permeability,dkr_sat,option)
4107) !
4108) ! Computes the relative permeability (and associated derivatives) as a
4109) ! function of saturation
4110) !
4111) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
4112) ! of two-fluid capillary pressure-saturation and permeability functions",
4113) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
4114) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
4115) !
4116) ! Author: Glenn Hammond
4117) ! Date: 12/11/07, 09/23/14
4118) !
4119) use Option_module
4120)
4121) implicit none
4122)
4123) class(rpf_Mualem_BC_gas_type) :: this
4124) PetscReal, intent(in) :: liquid_saturation
4125) PetscReal, intent(out) :: relative_permeability
4126) PetscReal, intent(out) :: dkr_sat
4127) type(option_type), intent(inout) :: option
4128)
4129) PetscReal :: Se
4130) PetscReal :: Seg
4131) PetscReal :: dkr_Se
4132) PetscReal :: dSe_sat
4133)
4134) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
4135)
4136) relative_permeability = 0.d0
4137) dkr_sat = UNINITIALIZED_DOUBLE
4138) if (Se >= 1.d0) then
4139) relative_permeability = 0.d0
4140) return
4141) else if (Se <= 0.d0) then
4142) relative_permeability = 1.d0
4143) return
4144) endif
4145)
4146) Seg = 1.d0 - Se
4147) ! reference Table 2
4148) relative_permeability = sqrt(Seg)* &
4149) (1.d0-Se**(1.d0+1.d0/this%lambda))**2.d0
4150) ! Mathematica Analytical solution (Heeho Park)
4151) dkr_Se = -2.d0*(1.d0+1.d0/this%lambda)*sqrt(Seg)*Se**(1.d0/this%lambda) &
4152) * (1.d0-Se**(1.d0+1.d0/this%lambda)) &
4153) - (1.d0-Se**(1.d0+1.d0/this%lambda))**2.d0/(2.d0*sqrt(Seg))
4154) dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
4155) dkr_sat = dkr_Se * dSe_sat
4156)
4157) end subroutine RPF_Mualem_BC_Gas_RelPerm
4158) ! End RPF: Mualem, Brooks-Corey (Gas)
4159)
4160) ! ************************************************************************** !
4161)
4162) ! Begin RPF: Burdine, Van Genuchten (Liq)
4163) function RPF_Burdine_VG_Liq_Create()
4164)
4165) ! Creates the van Genutchten Mualem relative permeability function object
4166)
4167) implicit none
4168)
4169) class(rpf_burdine_vg_liq_type), pointer :: RPF_Burdine_VG_Liq_Create
4170)
4171) allocate(RPF_Burdine_VG_Liq_Create)
4172) call RPF_Burdine_VG_Liq_Create%Init()
4173)
4174) end function RPF_Burdine_VG_Liq_Create
4175)
4176) ! ************************************************************************** !
4177)
4178) subroutine RPF_Burdine_VG_Liq_Init(this)
4179)
4180) ! Initializes the van Genutchten Mualem relative permeability function object
4181)
4182) implicit none
4183)
4184) class(rpf_Burdine_VG_liq_type) :: this
4185)
4186) call RPFBaseInit(this)
4187) this%m = UNINITIALIZED_DOUBLE
4188)
4189) end subroutine RPF_Burdine_VG_Liq_Init
4190)
4191) ! ************************************************************************** !
4192)
4193) subroutine RPF_Burdine_VG_Liq_Verify(this,name,option)
4194)
4195) use Option_module
4196)
4197) implicit none
4198)
4199) class(rpf_Burdine_VG_liq_type) :: this
4200) character(len=MAXSTRINGLENGTH) :: name
4201) type(option_type) :: option
4202)
4203) character(len=MAXSTRINGLENGTH) :: string
4204)
4205) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
4206) string = name
4207) else
4208) string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM'
4209) endif
4210) call RPFBaseVerify(this,string,option)
4211) if (Uninitialized(this%m)) then
4212) option%io_buffer = UninitializedMessage('M',string)
4213) call printErrMsg(option)
4214) endif
4215)
4216) end subroutine RPF_Burdine_VG_Liq_Verify
4217)
4218) ! ************************************************************************** !
4219)
4220) subroutine RPF_Burdine_VG_Liq_RelPerm(this,liquid_saturation, &
4221) relative_permeability,dkr_sat,option)
4222) !
4223) ! Computes the relative permeability (and associated derivatives) as a
4224) ! function of saturation
4225) !
4226) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
4227) ! of two-fluid capillary pressure-saturation and permeability functions",
4228) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
4229) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
4230) !
4231) ! Author: Glenn Hammond
4232) ! Date: 12/11/07, 09/23/14
4233) !
4234) use Option_module
4235) use Utility_module
4236)
4237) implicit none
4238)
4239) class(rpf_Burdine_VG_liq_type) :: this
4240) PetscReal, intent(in) :: liquid_saturation
4241) PetscReal, intent(out) :: relative_permeability
4242) PetscReal, intent(out) :: dkr_sat
4243) type(option_type), intent(inout) :: option
4244)
4245) PetscReal :: Se
4246) PetscReal :: one_over_m
4247) PetscReal :: Se_one_over_m
4248) PetscReal :: dkr_Se
4249) PetscReal :: dSe_sat
4250)
4251) relative_permeability = 0.d0
4252) dkr_sat = 0.d0
4253)
4254) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
4255) if (Se >= 1.d0) then
4256) relative_permeability = 1.d0
4257) return
4258) else if (Se <= 0.d0) then
4259) relative_permeability = 0.d0
4260) return
4261) endif
4262)
4263) one_over_m = 1.d0/this%m
4264) Se_one_over_m = Se**one_over_m
4265) relative_permeability = Se*Se*(1.d0-(1.d0-Se_one_over_m)**this%m)
4266) dkr_Se = 2.d0*relative_permeability/Se + &
4267) Se*Se_one_over_m*(1.d0-Se_one_over_m)**(this%m-1.d0)
4268) dSe_sat = 1.d0 / (1.d0 - this%Sr)
4269) dkr_sat = dkr_Se * dSe_sat
4270)
4271) end subroutine RPF_Burdine_VG_Liq_RelPerm
4272) ! End RPF: Burdine, Van Genuchten (Liq)
4273)
4274) ! ************************************************************************** !
4275)
4276) ! Begin RPF: Burdine, Van Genuchten (Gas)
4277) function RPF_Burdine_VG_Gas_Create()
4278)
4279) ! Creates the Brooks-Corey Burdine gas relative permeability function object
4280)
4281) implicit none
4282)
4283) class(rpf_Burdine_VG_gas_type), pointer :: RPF_Burdine_VG_Gas_Create
4284)
4285) allocate(RPF_Burdine_VG_Gas_Create)
4286) call RPF_Burdine_VG_Gas_Create%Init()
4287)
4288) end function RPF_Burdine_VG_Gas_Create
4289)
4290) ! ************************************************************************** !
4291)
4292) subroutine RPF_Burdine_VG_Gas_Init(this)
4293)
4294) ! Initializes the Brooks-Corey Burdine gas relative permeability function
4295) ! object
4296)
4297) implicit none
4298)
4299) class(rpf_Burdine_VG_gas_type) :: this
4300)
4301) call RPFBaseInit(this)
4302) this%Srg = UNINITIALIZED_DOUBLE
4303)
4304) end subroutine RPF_Burdine_VG_Gas_Init
4305)
4306) ! ************************************************************************** !
4307)
4308) subroutine RPF_Burdine_VG_Gas_Verify(this,name,option)
4309)
4310) use Option_module
4311)
4312) implicit none
4313)
4314) class(rpf_Burdine_VG_gas_type) :: this
4315) character(len=MAXSTRINGLENGTH) :: name
4316) type(option_type) :: option
4317)
4318) character(len=MAXSTRINGLENGTH) :: string
4319)
4320) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
4321) string = name
4322) else
4323) string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE_VG_GAS'
4324) endif
4325) call RPFBaseVerify(this,string,option)
4326) if (Uninitialized(this%Srg)) then
4327) option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
4328) call printErrMsg(option)
4329) endif
4330)
4331) end subroutine RPF_Burdine_VG_Gas_Verify
4332)
4333) ! ************************************************************************** !
4334)
4335) subroutine RPF_Burdine_VG_Gas_RelPerm(this,liquid_saturation, &
4336) relative_permeability,dkr_sat,option)
4337) !
4338) ! Computes the relative permeability (and associated derivatives) as a
4339) ! function of saturation
4340) !
4341) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
4342) ! of two-fluid capillary pressure-saturation and permeability functions",
4343) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
4344) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
4345) !
4346) ! Author: Glenn Hammond
4347) ! Date: 12/11/07, 09/23/14
4348)
4349) use Option_module
4350)
4351) implicit none
4352)
4353) class(rpf_Burdine_VG_gas_type) :: this
4354) PetscReal, intent(in) :: liquid_saturation
4355) PetscReal, intent(out) :: relative_permeability
4356) PetscReal, intent(out) :: dkr_sat
4357) type(option_type), intent(inout) :: option
4358)
4359) PetscReal :: Se
4360) PetscReal :: Seg
4361) PetscReal :: dkr_Se
4362) PetscReal :: dSe_sat
4363)
4364) relative_permeability = 0.d0
4365) dkr_sat = 0.d0
4366)
4367) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
4368) if (Se >= 1.d0) then
4369) relative_permeability = 0.d0
4370) return
4371) else if (Se <= 0.d0) then
4372) relative_permeability = 1.d0
4373) return
4374) endif
4375)
4376) Seg = 1.d0 - Se
4377) ! reference Table 2
4378) relative_permeability = Seg*Seg*(1.d0-Se**(1.d0/this%m))**this%m
4379) dkr_Se = -Seg**2.d0*Se**(1.d0/this%m-1.d0) &
4380) *(1.d0-Se**(1.d0/this%m))**(this%m-1.d0) &
4381) - 2.d0*Seg*(1.d0-Se**(1.d0/this%m))**this%m
4382) dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
4383) dkr_sat = dkr_Se * dSe_sat
4384)
4385) end subroutine RPF_Burdine_VG_Gas_RelPerm
4386) ! End RPF: Burdine, Van Genuchten (Gas)
4387)
4388) ! ************************************************************************** !
4389)
4390) ! Begin RPF: Mualem, Linear (Liquid)
4391) function RPF_Mualem_Linear_Liq_Create()
4392)
4393) ! Creates the Linear Mualem relative permeability function object
4394)
4395) implicit none
4396)
4397) class(rpf_Mualem_linear_liq_type), pointer :: RPF_Mualem_Linear_Liq_Create
4398)
4399) allocate(RPF_Mualem_Linear_Liq_Create)
4400) call RPF_Mualem_Linear_Liq_Create%Init()
4401)
4402) end function RPF_Mualem_Linear_Liq_Create
4403)
4404) ! ************************************************************************** !
4405)
4406) subroutine RPF_Mualem_Linear_Liq_Init(this)
4407)
4408) ! Initializes the Linear Mualem relative permeability function
4409) ! object
4410)
4411) implicit none
4412)
4413) class(rpf_Mualem_Linear_liq_type) :: this
4414)
4415) call RPFBaseInit(this)
4416) this%alpha = UNINITIALIZED_DOUBLE
4417) this%pcmax = UNINITIALIZED_DOUBLE
4418)
4419) end subroutine RPF_Mualem_Linear_Liq_Init
4420)
4421) ! ************************************************************************** !
4422)
4423) subroutine RPF_Mualem_Linear_Liq_Verify(this,name,option)
4424)
4425) use Option_module
4426)
4427) implicit none
4428)
4429) class(rpf_Mualem_Linear_liq_type) :: this
4430) character(len=MAXSTRINGLENGTH) :: name
4431) type(option_type) :: option
4432)
4433) character(len=MAXSTRINGLENGTH) :: string
4434)
4435) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
4436) string = name
4437) else
4438) string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM'
4439) endif
4440) call RPFBaseVerify(this,string,option)
4441) if (Uninitialized(this%alpha)) then
4442) option%io_buffer = UninitializedMessage('ALPHA',string)
4443) call printErrMsg(option)
4444) endif
4445) if (Uninitialized(this%pcmax)) then
4446) option%io_buffer = UninitializedMessage('MAX_CAPILLARY_PRESSURE',string)
4447) call printErrMsg(option)
4448) endif
4449)
4450) end subroutine RPF_Mualem_Linear_Liq_Verify
4451)
4452) ! ************************************************************************** !
4453)
4454) subroutine RPF_Mualem_Linear_Liq_RelPerm(this,liquid_saturation, &
4455) relative_permeability,dkr_sat,option)
4456) !
4457) ! Computes the relative permeability (and associated derivatives) as a
4458) ! function of saturation
4459) !
4460) !
4461) ! Author: Bwalya Malama, Heeho Park
4462) ! Date: 11/14/14
4463) !
4464) use Option_module
4465) use Utility_module
4466)
4467) implicit none
4468)
4469) class(rpf_Mualem_Linear_liq_type) :: this
4470) PetscReal, intent(in) :: liquid_saturation
4471) PetscReal, intent(out) :: relative_permeability
4472) PetscReal, intent(out) :: dkr_sat
4473) type(option_type), intent(inout) :: option
4474)
4475) PetscReal :: Se
4476) PetscReal :: one_over_alpha
4477) PetscReal :: pct_over_pcmax
4478) PetscReal :: pc_over_pcmax
4479) PetscReal :: pc_log_ratio
4480) PetscReal :: dkr_Se
4481) PetscReal :: dSe_sat
4482)
4483) relative_permeability = 0.d0
4484) dkr_sat = 0.d0
4485)
4486) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
4487) if (Se >= 1.d0) then
4488) relative_permeability = 1.d0
4489) return
4490) else if (Se <= 0.d0) then
4491) relative_permeability = 0.d0
4492) return
4493) endif
4494)
4495) one_over_alpha = 1.d0/this%alpha
4496) pct_over_pcmax = one_over_alpha/this%pcmax
4497) pc_over_pcmax = 1.d0-(1.d0-pct_over_pcmax)*Se
4498) pc_log_ratio = log(pc_over_pcmax) / log(pct_over_pcmax)
4499) relative_permeability = (Se**0.5d0)*(pc_log_ratio**2.d0)
4500) ! ***used Mathematica to verify***
4501) ! In[3]:
4502) ! D[Se^(1/2)*(Log[1 - (1 - pctoverpcmax)*Se]/Log[pctoverpcmax])^2, Se]
4503) ! Out[3]:
4504) ! (2 (-1 + pctoverpcmax) Sqrt[Se]
4505) ! Log[1 - (1 - pctoverpcmax) Se])/((1 - (1 - pctoverpcmax) Se) Log[
4506) ! pctoverpcmax]^2) + Log[1 - (1 - pctoverpcmax) Se]^2/(
4507) ! 2 Sqrt[Se] Log[pctoverpcmax]^2)
4508) dkr_Se = 2.d0*(-1.d0+pct_over_pcmax)*sqrt(Se)* log(pc_over_pcmax) / &
4509) (pc_over_pcmax*log(pct_over_pcmax)**2.d0) + &
4510) log(pc_over_pcmax)**2.d0 / (2.d0*sqrt(Se)*log(pct_over_pcmax)**2.d0)
4511) dSe_sat = 1.d0 / (1.d0 - this%Sr)
4512) dkr_sat = dkr_Se * dSe_sat
4513)
4514) end subroutine RPF_Mualem_Linear_Liq_RelPerm
4515) ! End RPF: Mualem, Linear (Liquid)
4516)
4517) ! ************************************************************************** !
4518)
4519) ! Begin RPF: Mualem, Linear (Gas)
4520) function RPF_Mualem_Linear_Gas_Create()
4521)
4522) ! Creates the Linear Mualem gas relative permeability function object
4523)
4524) implicit none
4525)
4526) class(rpf_Mualem_Linear_gas_type), pointer :: RPF_Mualem_Linear_Gas_Create
4527)
4528) allocate(RPF_Mualem_Linear_Gas_Create)
4529) call RPF_Mualem_Linear_Gas_Create%Init()
4530)
4531) end function RPF_Mualem_Linear_Gas_Create
4532)
4533) ! ************************************************************************** !
4534)
4535) subroutine RPF_Mualem_Linear_Gas_Init(this)
4536)
4537) ! Initializes the Linear Mualem gas relative permeability function
4538) ! object
4539)
4540) implicit none
4541)
4542) class(rpf_Mualem_Linear_gas_type) :: this
4543)
4544) call RPFBaseInit(this)
4545) this%Srg = UNINITIALIZED_DOUBLE
4546) this%alpha = UNINITIALIZED_DOUBLE
4547) this%pcmax = UNINITIALIZED_DOUBLE
4548)
4549) end subroutine RPF_Mualem_Linear_Gas_Init
4550)
4551) ! ************************************************************************** !
4552)
4553) subroutine RPF_Mualem_Linear_Gas_Verify(this,name,option)
4554)
4555) use Option_module
4556)
4557) implicit none
4558)
4559) class(rpf_Mualem_Linear_gas_type) :: this
4560) character(len=MAXSTRINGLENGTH) :: name
4561) type(option_type) :: option
4562)
4563) character(len=MAXSTRINGLENGTH) :: string
4564)
4565) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
4566) string = name
4567) else
4568) string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM_LINEAR_GAS'
4569) endif
4570) call RPFBaseVerify(this,string,option)
4571) if (Uninitialized(this%Srg)) then
4572) option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
4573) call printErrMsg(option)
4574) endif
4575) if (Uninitialized(this%alpha)) then
4576) option%io_buffer = UninitializedMessage('ALPHA',string)
4577) call printErrMsg(option)
4578) endif
4579) if (Uninitialized(this%pcmax)) then
4580) option%io_buffer = UninitializedMessage('MAX_CAPILLARY_PRESSURE',string)
4581) call printErrMsg(option)
4582) endif
4583)
4584) end subroutine RPF_Mualem_Linear_Gas_Verify
4585)
4586) ! ************************************************************************** !
4587)
4588) subroutine RPF_Mualem_Linear_Gas_RelPerm(this,liquid_saturation, &
4589) relative_permeability,dkr_sat,option)
4590) !
4591) ! Computes the relative permeability (and associated derivatives) as a
4592) ! function of saturation
4593) !
4594) !
4595) !
4596) ! Author: Bwalya Malama, Heeho Park
4597) ! Date: 11/14/14
4598)
4599) use Option_module
4600)
4601) implicit none
4602)
4603) class(rpf_Mualem_Linear_gas_type) :: this
4604) PetscReal, intent(in) :: liquid_saturation
4605) PetscReal, intent(out) :: relative_permeability
4606) PetscReal, intent(out) :: dkr_sat
4607) type(option_type), intent(inout) :: option
4608)
4609) PetscReal :: Se
4610) PetscReal :: Seg
4611) PetscReal :: liquid_relative_permeability
4612) PetscReal :: liquid_dkr_sat
4613)
4614) call RPF_Mualem_Linear_Liq_RelPerm(this,liquid_saturation, &
4615) liquid_relative_permeability, &
4616) liquid_dkr_sat,option)
4617)
4618) relative_permeability = 0.d0
4619) ! initialize to derivative to NaN so that not mistakenly used.
4620) dkr_sat = 0.d0
4621) dkr_sat = dkr_sat / 0.d0
4622) dkr_sat = dkr_sat * 0.d0
4623)
4624) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
4625) if (Se >= 1.d0) then
4626) relative_permeability = 0.d0
4627) return
4628) else if (Se <= 0.d0) then
4629) relative_permeability = 1.d0
4630) return
4631) endif
4632)
4633) Seg = 1.d0 - Se
4634) ! reference Table 2
4635) relative_permeability = Seg**0.5d0 * &
4636) (1.d0-sqrt(liquid_relative_permeability*Se**(-0.5d0)))**2.d0
4637)
4638) end subroutine RPF_Mualem_Linear_Gas_RelPerm
4639) ! End RPF: Mualem, Linear (Gas)
4640)
4641) ! ************************************************************************** !
4642)
4643) ! Begin RPF: Burdine, Linear (Liquid)
4644) function RPF_Burdine_Linear_Liq_Create()
4645)
4646) ! Creates the Linear Burdine relative permeability function object
4647)
4648) implicit none
4649)
4650) class(rpf_Burdine_linear_liq_type), pointer :: RPF_Burdine_Linear_Liq_Create
4651)
4652) allocate(RPF_Burdine_Linear_Liq_Create)
4653) call RPF_Burdine_Linear_Liq_Create%Init()
4654)
4655) end function RPF_Burdine_Linear_Liq_Create
4656)
4657) ! ************************************************************************** !
4658)
4659) subroutine RPF_Burdine_Linear_Liq_Init(this)
4660)
4661) ! Initializes the Linear Burdine relative permeability function
4662) ! object
4663)
4664) implicit none
4665)
4666) class(rpf_Burdine_Linear_liq_type) :: this
4667)
4668) call RPFBaseInit(this)
4669)
4670) end subroutine RPF_Burdine_Linear_Liq_Init
4671)
4672) ! ************************************************************************** !
4673)
4674) subroutine RPF_Burdine_Linear_Liq_Verify(this,name,option)
4675)
4676) use Option_module
4677)
4678) implicit none
4679)
4680) class(rpf_Burdine_Linear_liq_type) :: this
4681) character(len=MAXSTRINGLENGTH) :: name
4682) type(option_type) :: option
4683)
4684) character(len=MAXSTRINGLENGTH) :: string
4685)
4686) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
4687) string = name
4688) else
4689) string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE'
4690) endif
4691) call RPFBaseVerify(this,string,option)
4692)
4693) end subroutine RPF_Burdine_Linear_Liq_Verify
4694)
4695) ! ************************************************************************** !
4696)
4697) subroutine RPF_Burdine_Linear_Liq_RelPerm(this,liquid_saturation, &
4698) relative_permeability,dkr_sat,option)
4699) !
4700) ! Computes the relative permeability (and associated derivatives) as a
4701) ! function of saturation
4702) !
4703) !
4704) !
4705) ! Author: Bwalya Malama, Heeho Park
4706) ! Date: 11/14/14
4707) !
4708) use Option_module
4709) use Utility_module
4710)
4711) implicit none
4712)
4713) class(rpf_Burdine_Linear_liq_type) :: this
4714) PetscReal, intent(in) :: liquid_saturation
4715) PetscReal, intent(out) :: relative_permeability
4716) PetscReal, intent(out) :: dkr_sat
4717) type(option_type), intent(inout) :: option
4718)
4719) PetscReal :: Se
4720) PetscReal :: one_over_m
4721) PetscReal :: Se_one_over_m
4722)
4723) relative_permeability = 0.d0
4724) dkr_sat = 0.d0
4725)
4726) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
4727) if (Se >= 1.d0) then
4728) relative_permeability = 1.d0
4729) return
4730) else if (Se <= 0.d0) then
4731) relative_permeability = 0.d0
4732) return
4733) endif
4734)
4735) relative_permeability = Se
4736) dkr_sat = 1.d0 / (1.d0 - this%Sr)
4737)
4738) end subroutine RPF_Burdine_Linear_Liq_RelPerm
4739) ! End RPF: Burdine, Linear (Liquid)
4740)
4741) ! ************************************************************************** !
4742)
4743) ! Begin Burdine Linear (Gas)
4744) function RPF_Burdine_Linear_Gas_Create()
4745)
4746) ! Creates the Linear Burdine gas relative permeability function object
4747)
4748) implicit none
4749)
4750) class(rpf_Burdine_Linear_gas_type), pointer :: RPF_Burdine_Linear_Gas_Create
4751)
4752) allocate(RPF_Burdine_Linear_Gas_Create)
4753) call RPF_Burdine_Linear_Gas_Create%Init()
4754)
4755) end function RPF_Burdine_Linear_Gas_Create
4756)
4757) ! ************************************************************************** !
4758)
4759) subroutine RPF_Burdine_Linear_Gas_Init(this)
4760)
4761) ! Initializes the Linear Burdine gas relative permeability function
4762) ! object
4763)
4764) implicit none
4765)
4766) class(rpf_Burdine_Linear_gas_type) :: this
4767)
4768) call RPFBaseInit(this)
4769) this%Srg = UNINITIALIZED_DOUBLE
4770)
4771) end subroutine RPF_Burdine_Linear_Gas_Init
4772)
4773) ! ************************************************************************** !
4774)
4775) subroutine RPF_Burdine_Linear_Gas_Verify(this,name,option)
4776)
4777) use Option_module
4778)
4779) implicit none
4780)
4781) class(rpf_Burdine_Linear_gas_type) :: this
4782) character(len=MAXSTRINGLENGTH) :: name
4783) type(option_type) :: option
4784)
4785) character(len=MAXSTRINGLENGTH) :: string
4786)
4787) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
4788) string = name
4789) else
4790) string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE_LINEAR_GAS'
4791) endif
4792) call RPFBaseVerify(this,string,option)
4793) if (Uninitialized(this%Srg)) then
4794) option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
4795) call printErrMsg(option)
4796) endif
4797)
4798) end subroutine RPF_Burdine_Linear_Gas_Verify
4799)
4800) ! ************************************************************************** !
4801)
4802) subroutine RPF_Burdine_Linear_Gas_RelPerm(this,liquid_saturation, &
4803) relative_permeability,dkr_sat,option)
4804) !
4805) ! Computes the relative permeability (and associated derivatives) as a
4806) ! function of saturation
4807) !
4808) !
4809) !
4810) ! Author: Bwalya Malama, Heeho Park
4811) ! Date: 11/14/14
4812) !
4813)
4814) use Option_module
4815)
4816) implicit none
4817)
4818) class(rpf_Burdine_Linear_gas_type) :: this
4819) PetscReal, intent(in) :: liquid_saturation
4820) PetscReal, intent(out) :: relative_permeability
4821) PetscReal, intent(out) :: dkr_sat
4822) type(option_type), intent(inout) :: option
4823)
4824) PetscReal :: Se
4825) PetscReal :: Seg
4826) PetscReal :: liquid_relative_permeability
4827) PetscReal :: liquid_dkr_sat
4828) PetscReal :: dkr_Se
4829) PetscReal :: dSe_sat
4830)
4831) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
4832)
4833) relative_permeability = 0.d0
4834) dkr_sat = UNINITIALIZED_DOUBLE
4835) if (Se >= 1.d0) then
4836) relative_permeability = 0.d0
4837) return
4838) else if (Se <= 0.d0) then
4839) relative_permeability = 1.d0
4840) return
4841) endif
4842)
4843) Seg = 1.d0 - Se
4844) relative_permeability = Seg
4845) dkr_Se = -1.d0
4846) dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
4847) dkr_sat = dkr_Se * dSe_sat
4848)
4849) end subroutine RPF_Burdine_Linear_Gas_RelPerm
4850) ! End Burdine Linear (Gas)
4851)
4852) ! ************************************************************************** !
4853)
4854) ! Begin RPF: BRAGFLO KRP9 (Liquid)
4855) function RPF_BRAGFLO_KRP9_Liq_Create()
4856)
4857) ! Creates the Linear Burdine relative permeability function object
4858)
4859) implicit none
4860)
4861) class(rpf_BRAGFLO_KRP9_liq_type), pointer :: RPF_BRAGFLO_KRP9_Liq_Create
4862)
4863) allocate(RPF_BRAGFLO_KRP9_Liq_Create)
4864) call RPF_BRAGFLO_KRP9_Liq_Create%Init()
4865)
4866) end function RPF_BRAGFLO_KRP9_Liq_Create
4867)
4868) ! ************************************************************************** !
4869)
4870) subroutine RPF_BRAGFLO_KRP9_Liq_Init(this)
4871)
4872) ! Initializes the Linear Burdine relative permeability function
4873) ! object
4874)
4875) implicit none
4876)
4877) class(rpf_BRAGFLO_KRP9_liq_type) :: this
4878)
4879) call RPFBaseInit(this)
4880)
4881) end subroutine RPF_BRAGFLO_KRP9_Liq_Init
4882)
4883) ! ************************************************************************** !
4884)
4885) subroutine RPF_BRAGFLO_KRP9_Liq_Verify(this,name,option)
4886)
4887) use Option_module
4888)
4889) implicit none
4890)
4891) class(rpf_BRAGFLO_KRP9_liq_type) :: this
4892) character(len=MAXSTRINGLENGTH) :: name
4893) type(option_type) :: option
4894)
4895) character(len=MAXSTRINGLENGTH) :: string
4896)
4897) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
4898) string = name
4899) else
4900) string = trim(name) // 'PERMEABILITY_FUNCTION,BRAGFLO_KRP9'
4901) endif
4902) call RPFBaseVerify(this,string,option)
4903)
4904) end subroutine RPF_BRAGFLO_KRP9_Liq_Verify
4905)
4906) ! ************************************************************************** !
4907)
4908) subroutine RPF_BRAGFLO_KRP9_Liq_RelPerm(this,liquid_saturation, &
4909) relative_permeability,dkr_sat,option)
4910) !
4911) ! Computes the relative permeability (and associated derivatives) as a
4912) ! function of saturation
4913) ! based on experimental measurements and analyses done by Vauclin et al.
4914) ! as discussed by Moridis and Pruess.
4915) ! 14. Moridis, G. J., and K. Pruess. 1992. TOUGH Simulations of
4916) ! Updegraff\92s Set of Fluid and Heat Flow Problems. LBL-32611, ERMS# 138458.
4917) ! Berkeley, CA: Lawrence Berkeley Laboratory.
4918) ! Author: Heeho Park
4919) ! Date: 03/26/15
4920) !
4921) use Option_module
4922) use Utility_module
4923)
4924) implicit none
4925)
4926) class(rpf_BRAGFLO_KRP9_liq_type) :: this
4927) PetscReal, intent(in) :: liquid_saturation
4928) PetscReal, intent(out) :: relative_permeability
4929) PetscReal, intent(out) :: dkr_sat
4930) type(option_type), intent(inout) :: option
4931)
4932) PetscReal :: Se
4933) PetscReal :: one_over_m
4934) PetscReal :: Se_one_over_m
4935)
4936) relative_permeability = 0.d0
4937) print *, 'RPF_BRAGFLO_KRP9_Liq_RelPerm not validated'
4938) stop
4939) ! initialize to derivative to NaN so that not mistakenly used.
4940) dkr_sat = 0.d0
4941) dkr_sat = dkr_sat / 0.d0
4942) dkr_sat = dkr_sat * 0.d0
4943)
4944) Se = (1.d0-liquid_saturation)/(liquid_saturation)
4945) if (liquid_saturation <= this%Sr) then
4946) relative_permeability = 0.d0
4947) return
4948) endif
4949)
4950) relative_permeability = 1.d0/(1.d0+28.768353d0*Se**1.7241379d0)
4951)
4952) end subroutine RPF_BRAGFLO_KRP9_Liq_RelPerm
4953) ! End RPF: BRAGFLO KRP9 (Liquid)
4954)
4955) ! ************************************************************************** !
4956)
4957) ! Begin BRAGFLO KRP9 (Gas)
4958) function RPF_BRAGFLO_KRP9_Gas_Create()
4959)
4960) ! Creates the Linear Burdine gas relative permeability function object
4961)
4962) implicit none
4963)
4964) class(rpf_BRAGFLO_KRP9_gas_type), pointer :: RPF_BRAGFLO_KRP9_Gas_Create
4965)
4966) allocate(RPF_BRAGFLO_KRP9_Gas_Create)
4967) call RPF_BRAGFLO_KRP9_Gas_Create%Init()
4968)
4969) end function RPF_BRAGFLO_KRP9_Gas_Create
4970)
4971) ! ************************************************************************** !
4972)
4973) subroutine RPF_BRAGFLO_KRP9_Gas_Init(this)
4974)
4975) ! Initializes the Linear Burdine gas relative permeability function
4976) ! object
4977)
4978) implicit none
4979)
4980) class(rpf_BRAGFLO_KRP9_gas_type) :: this
4981)
4982) call RPFBaseInit(this)
4983)
4984) end subroutine RPF_BRAGFLO_KRP9_Gas_Init
4985)
4986) ! ************************************************************************** !
4987)
4988) subroutine RPF_BRAGFLO_KRP9_Gas_Verify(this,name,option)
4989)
4990) use Option_module
4991)
4992) implicit none
4993)
4994) class(rpf_BRAGFLO_KRP9_gas_type) :: this
4995) character(len=MAXSTRINGLENGTH) :: name
4996) type(option_type) :: option
4997)
4998) character(len=MAXSTRINGLENGTH) :: string
4999)
5000) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
5001) string = name
5002) else
5003) string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE_LINEAR_GAS'
5004) endif
5005) call RPFBaseVerify(this,string,option)
5006)
5007) end subroutine RPF_BRAGFLO_KRP9_Gas_Verify
5008)
5009) ! ************************************************************************** !
5010)
5011) subroutine RPF_BRAGFLO_KRP9_Gas_RelPerm(this,liquid_saturation, &
5012) relative_permeability,dkr_sat,option)
5013) !
5014) ! Computes the relative permeability (and associated derivatives) as a
5015) ! function of saturation
5016) ! based on experimental measurements and analyses done by Vauclin et al.
5017) ! as discussed by Moridis and Pruess.
5018) ! 14. Moridis, G. J., and K. Pruess. 1992. TOUGH Simulations of
5019) ! Updegraff\92s Set of Fluid and Heat Flow Problems. LBL-32611, ERMS# 138458.
5020) ! Berkeley, CA: Lawrence Berkeley Laboratory.
5021) ! Author: Heeho Park
5022) ! Date: 03/26/15
5023) !
5024)
5025) use Option_module
5026)
5027) implicit none
5028)
5029) class(rpf_BRAGFLO_KRP9_gas_type) :: this
5030) PetscReal, intent(in) :: liquid_saturation
5031) PetscReal, intent(out) :: relative_permeability
5032) PetscReal, intent(out) :: dkr_sat
5033) type(option_type), intent(inout) :: option
5034)
5035) PetscReal :: Se
5036) PetscReal :: Seg
5037) PetscReal :: liquid_relative_permeability
5038) PetscReal :: liquid_dkr_sat
5039) PetscReal :: dkr_Se
5040)
5041) print *, 'RPF_BRAGFLO_KRP9_Gas_RelPerm not validated'
5042) stop
5043) ! initialize to derivative to NaN so that not mistakenly used.
5044) dkr_sat = 0.d0
5045) dkr_sat = dkr_sat / 0.d0
5046) dkr_sat = dkr_sat * 0.d0
5047)
5048)
5049) Se = (1.d0-liquid_saturation)/(liquid_saturation)
5050) if (liquid_saturation <= this%Sr) then
5051) relative_permeability = 1.d0
5052) return
5053) endif
5054)
5055) call RPF_BRAGFLO_KRP9_Liq_RelPerm(this,liquid_saturation, &
5056) liquid_relative_permeability, &
5057) liquid_dkr_sat,option)
5058)
5059) relative_permeability = 1.d0 - liquid_relative_permeability
5060) dkr_Se = -1.d0 * liquid_dkr_sat
5061)
5062) end subroutine RPF_BRAGFLO_KRP9_Gas_RelPerm
5063) ! End RPF: BRAGFLO KRP9 (Gas)
5064)
5065) ! ************************************************************************** !
5066)
5067) ! Begin RPF: BRAGFLO KRP4 (Liq)
5068) function RPF_BRAGFLO_KRP4_Liq_Create()
5069)
5070) ! Creates the KRP4 or BC_Burdine liq relative permeability function object
5071)
5072) implicit none
5073)
5074) class(rpf_BRAGFLO_KRP4_liq_type), pointer :: RPF_BRAGFLO_KRP4_Liq_Create
5075)
5076) allocate(RPF_BRAGFLO_KRP4_Liq_Create)
5077) call RPF_BRAGFLO_KRP4_Liq_Create%Init()
5078)
5079) end function RPF_BRAGFLO_KRP4_Liq_Create
5080) ! End RPF: BRAGFLO KRP4 (Liq)
5081)
5082) ! ************************************************************************** !
5083)
5084) ! Begin RPF: BRAGFLO KRP4 (Gas)
5085) function RPF_BRAGFLO_KRP4_Gas_Create()
5086)
5087) ! Creates the KRP4 or BC_Burdine gas relative permeability function object
5088)
5089) implicit none
5090)
5091) class(rpf_BRAGFLO_KRP4_gas_type), pointer :: RPF_BRAGFLO_KRP4_Gas_Create
5092)
5093) allocate(RPF_BRAGFLO_KRP4_Gas_Create)
5094) call RPF_BRAGFLO_KRP4_Gas_Create%Init()
5095)
5096) end function RPF_BRAGFLO_KRP4_Gas_Create
5097) ! End RPF: BRAGFLO KRP4 (Gas)
5098)
5099) ! ************************************************************************** !
5100)
5101) subroutine RPF_BRAGFLO_KRP4_Gas_Init(this)
5102)
5103) ! Initializes the Brooks-Corey Burdine gas relative permeability function
5104) ! object
5105)
5106) implicit none
5107)
5108) class(rpf_BRAGFLO_KRP4_gas_type) :: this
5109)
5110) call RPFBaseInit(this)
5111) this%Srg = UNINITIALIZED_DOUBLE
5112)
5113) end subroutine RPF_BRAGFLO_KRP4_Gas_Init
5114)
5115) ! ************************************************************************** !
5116)
5117) subroutine RPF_BRAGFLO_KRP4_Gas_Verify(this,name,option)
5118)
5119) use Option_module
5120)
5121) implicit none
5122)
5123) class(rpf_BRAGFLO_KRP4_gas_type) :: this
5124) character(len=MAXSTRINGLENGTH) :: name
5125) type(option_type) :: option
5126)
5127) character(len=MAXSTRINGLENGTH) :: string
5128)
5129) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
5130) string = name
5131) else
5132) string = trim(name) // 'PERMEABILITY_FUNCTION,BRAGFLO_KRP4_GAS'
5133) endif
5134) call RPFBaseVerify(this,string,option)
5135) if (Uninitialized(this%Srg)) then
5136) option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
5137) call printErrMsg(option)
5138) endif
5139)
5140) end subroutine RPF_BRAGFLO_KRP4_Gas_Verify
5141)
5142) ! ************************************************************************** !
5143)
5144) subroutine RPF_BRAGFLO_KRP4_Gas_RelPerm(this,liquid_saturation, &
5145) relative_permeability,dkr_sat,option)
5146) !
5147) ! Computes the relative permeability (and associated derivatives) as a
5148) ! function of saturation
5149) !
5150) ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
5151) ! of two-fluid capillary pressure-saturation and permeability functions",
5152) ! Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
5153) ! http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
5154) !
5155) ! Author: Glenn Hammond
5156) ! Date: 12/11/07, 09/23/14
5157) !
5158) use Option_module
5159)
5160) implicit none
5161)
5162) class(rpf_BRAGFLO_KRP4_gas_type) :: this
5163) PetscReal, intent(in) :: liquid_saturation
5164) PetscReal, intent(out) :: relative_permeability
5165) PetscReal, intent(out) :: dkr_sat
5166) type(option_type), intent(inout) :: option
5167)
5168) PetscReal :: Se
5169) PetscReal :: Seg
5170) PetscReal :: gas_saturation
5171) PetscReal :: dkr_Se
5172) PetscReal :: dSe_sat
5173)
5174) gas_saturation = 1.0d0 - liquid_saturation
5175)
5176) relative_permeability = 0.d0
5177) print *, 'RPF_BRAGFLO_KRP4_Gas_RelPerm not validated'
5178) stop
5179) ! initialize to derivative to NaN so that not mistakenly used.
5180) dkr_sat = 0.d0
5181) dkr_sat = dkr_sat / 0.d0
5182) dkr_sat = dkr_sat * 0.d0
5183)
5184)
5185) if (gas_saturation <= this%Srg) then
5186) relative_permeability = 0.0d0
5187) else if (liquid_saturation > this%Sr) then
5188) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
5189) Seg = 1.d0 - Se
5190) ! reference #1
5191) relative_permeability = Seg*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
5192) ! Mathematica Analytical solution (Heeho Park)
5193) dkr_Se = -(1.d0+2.d0/this%lambda)*Seg**2.d0*Se**(2.d0/this%lambda) &
5194) - 2.d0*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
5195) dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
5196) dkr_sat = dkr_Se * dSe_sat
5197) else
5198) relative_permeability = 1.0d0
5199) endif
5200)
5201) end subroutine RPF_BRAGFLO_KRP4_Gas_RelPerm
5202) ! End RPF: Burdine, Brooks-Corey (Gas)
5203)
5204) ! ************************************************************************** !
5205)
5206) ! Begin RPF: BRAGFLO KRP11 (Liquid)
5207) function RPF_BRAGFLO_KRP11_Liq_Create()
5208)
5209) ! Creates the Linear Burdine relative permeability function object
5210)
5211) implicit none
5212)
5213) class(rpf_BRAGFLO_KRP11_liq_type), pointer :: RPF_BRAGFLO_KRP11_Liq_Create
5214)
5215) allocate(RPF_BRAGFLO_KRP11_Liq_Create)
5216) call RPF_BRAGFLO_KRP11_Liq_Create%Init()
5217)
5218) end function RPF_BRAGFLO_KRP11_Liq_Create
5219)
5220) ! ************************************************************************** !
5221)
5222) subroutine RPF_BRAGFLO_KRP11_Liq_Init(this)
5223)
5224) ! Initializes the Linear Burdine relative permeability function
5225) ! object
5226)
5227) implicit none
5228)
5229) class(rpf_BRAGFLO_KRP11_liq_type) :: this
5230)
5231) call RPFBaseInit(this)
5232)
5233) end subroutine RPF_BRAGFLO_KRP11_Liq_Init
5234)
5235) ! ************************************************************************** !
5236)
5237) subroutine RPF_BRAGFLO_KRP11_Liq_Verify(this,name,option)
5238)
5239) use Option_module
5240)
5241) implicit none
5242)
5243) class(rpf_BRAGFLO_KRP11_liq_type) :: this
5244) character(len=MAXSTRINGLENGTH) :: name
5245) type(option_type) :: option
5246)
5247) character(len=MAXSTRINGLENGTH) :: string
5248)
5249) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
5250) string = name
5251) else
5252) string = trim(name) // 'PERMEABILITY_FUNCTION,BRAGFLO_KRP11'
5253) endif
5254) call RPFBaseVerify(this,string,option)
5255) if (Uninitialized(this%Srg)) then
5256) option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
5257) call printErrMsg(option)
5258) endif
5259) if (Uninitialized(this%tolc)) then
5260) option%io_buffer = UninitializedMessage('TOLC',string)
5261) call printErrMsg(option)
5262) endif
5263)
5264) end subroutine RPF_BRAGFLO_KRP11_Liq_Verify
5265)
5266) ! ************************************************************************** !
5267)
5268) subroutine RPF_BRAGFLO_KRP11_Liq_RelPerm(this,liquid_saturation, &
5269) relative_permeability,dkr_sat,option)
5270) !
5271) ! KRP = 11 BRAGFLO relative permeability model
5272) ! the relative permeabilities decrease from 1 to zero linearly between
5273) ! the residual saturations (brine and gas) and the residual saturation
5274) ! plus a tolerance.
5275) !
5276) ! Author: Heeho Park
5277) ! Date: 03/26/15
5278) !
5279) use Option_module
5280) use Utility_module
5281)
5282) implicit none
5283)
5284) class(rpf_BRAGFLO_KRP11_liq_type) :: this
5285) PetscReal, intent(in) :: liquid_saturation
5286) PetscReal, intent(out) :: relative_permeability
5287) PetscReal, intent(out) :: dkr_sat
5288) type(option_type), intent(inout) :: option
5289)
5290) PetscReal :: gas_saturation
5291) PetscReal :: tol
5292)
5293) gas_saturation = 1.d0 - liquid_saturation
5294)
5295) relative_permeability = 0.d0
5296) print *, 'RPF_BRAGFLO_KRP11_Liq_RelPerm not validated'
5297) stop
5298) ! initialize to derivative to NaN so that not mistakenly used.
5299) dkr_sat = 0.d0
5300) dkr_sat = dkr_sat / 0.d0
5301) dkr_sat = dkr_sat * 0.d0
5302)
5303) tol = this%tolc * (1 - this%Sr - this%Srg)
5304)
5305) if (liquid_saturation <= this%Sr) then
5306) relative_permeability = 0.d0
5307) else if (gas_saturation <= this%Srg) then
5308) relative_permeability = 1.d0
5309) else if (liquid_saturation <= this%Sr+tol) then
5310) relative_permeability = (liquid_saturation - this%Sr)/tol
5311) else if (gas_saturation <= this%Srg+tol) then
5312) relative_permeability = 1.d0
5313) else
5314) relative_permeability = 1.d0
5315) endif
5316)
5317) end subroutine RPF_BRAGFLO_KRP11_Liq_RelPerm
5318) ! End RPF: BRAGFLO KRP11 (Liquid)
5319)
5320) ! ************************************************************************** !
5321)
5322) ! Begin BRAGFLO KRP11 (Gas)
5323) function RPF_BRAGFLO_KRP11_Gas_Create()
5324)
5325) ! Creates the Linear Burdine gas relative permeability function object
5326)
5327) implicit none
5328)
5329) class(rpf_BRAGFLO_KRP11_gas_type), pointer :: RPF_BRAGFLO_KRP11_Gas_Create
5330)
5331) allocate(RPF_BRAGFLO_KRP11_Gas_Create)
5332) call RPF_BRAGFLO_KRP11_Gas_Create%Init()
5333)
5334) end function RPF_BRAGFLO_KRP11_Gas_Create
5335)
5336) ! ************************************************************************** !
5337)
5338) subroutine RPF_BRAGFLO_KRP11_Gas_RelPerm(this,liquid_saturation, &
5339) relative_permeability,dkr_sat,option)
5340) !
5341) ! KRP = 11 BRAGFLO relative permeability model
5342) ! the relative permeabilities decrease from 1 to zero linearly between
5343) ! the residual saturations (brine and gas) and the residual saturation
5344) ! plus a tolerance.
5345) !
5346) ! Author: Heeho Park
5347) ! Date: 03/26/15
5348) !
5349)
5350) use Option_module
5351)
5352) implicit none
5353)
5354) class(rpf_BRAGFLO_KRP11_gas_type) :: this
5355) PetscReal, intent(in) :: liquid_saturation
5356) PetscReal, intent(out) :: relative_permeability
5357) PetscReal, intent(out) :: dkr_sat
5358) type(option_type), intent(inout) :: option
5359)
5360) PetscReal :: gas_saturation
5361) PetscReal :: tol
5362)
5363) gas_saturation = 1.d0 - liquid_saturation
5364)
5365) relative_permeability = 0.d0
5366) print *, 'RPF_BRAGFLO_KRP11_Gas_RelPerm not validated'
5367) stop
5368) ! initialize to derivative to NaN so that not mistakenly used.
5369) dkr_sat = 0.d0
5370) dkr_sat = dkr_sat / 0.d0
5371) dkr_sat = dkr_sat * 0.d0
5372)
5373)
5374) tol = this%tolc * (1 - this%Sr - this%Srg)
5375)
5376) if (liquid_saturation <= this%Sr) then
5377) relative_permeability = 1.d0
5378) else if (gas_saturation <= this%Srg) then
5379) relative_permeability = 0.d0
5380) else if (liquid_saturation <= this%Sr+tol) then
5381) relative_permeability = 1.d0
5382) else if (gas_saturation <= this%Srg+tol) then
5383) relative_permeability = (gas_saturation - this%Srg)/tol
5384) else
5385) relative_permeability = 1.d0
5386) endif
5387)
5388) end subroutine RPF_BRAGFLO_KRP11_Gas_RelPerm
5389) ! End RPF: BRAGFLO KRP11 (Gas)
5390)
5391) ! ************************************************************************** !
5392)
5393) ! Begin RPF: BRAGFLO KRP12 (Liq)
5394) function RPF_BRAGFLO_KRP12_Liq_Create()
5395)
5396) ! Creates the KRP12 or BC_Burdine liq relative permeability function object
5397)
5398) implicit none
5399)
5400) class(rpf_BRAGFLO_KRP12_liq_type), pointer :: RPF_BRAGFLO_KRP12_Liq_Create
5401)
5402) allocate(RPF_BRAGFLO_KRP12_Liq_Create)
5403) call RPF_BRAGFLO_KRP12_Liq_Create%Init()
5404)
5405) end function RPF_BRAGFLO_KRP12_Liq_Create
5406) ! End RPF: BRAGFLO KRP12 (Liq)
5407)
5408) ! ************************************************************************** !
5409)
5410) subroutine RPF_BRAGFLO_KRP12_Liq_RelPerm(this,liquid_saturation, &
5411) relative_permeability,dkr_sat,option)
5412) !
5413) ! Computes the relative permeability (and associated derivatives) as a
5414) ! function of saturation
5415) !
5416) ! Modified Brooks-Corey model KRP = 12 in BRAGFLO
5417) !
5418) ! Author: Heeho Park
5419) ! Date: 11/13/15
5420) !
5421) use Option_module
5422)
5423) implicit none
5424)
5425) class(rpf_BRAGFLO_KRP12_liq_type) :: this
5426) PetscReal, intent(in) :: liquid_saturation
5427) PetscReal, intent(out) :: relative_permeability
5428) PetscReal, intent(out) :: dkr_sat
5429) type(option_type), intent(inout) :: option
5430)
5431) PetscReal :: Se
5432) PetscReal :: power
5433) PetscReal :: dkr_Se
5434)
5435) relative_permeability = 0.d0
5436) print *, 'RPF_BRAGFLO_KRP12_Liq_RelPerm not validated'
5437) stop
5438) ! initialize to derivative to NaN so that not mistakenly used.
5439) dkr_sat = 0.d0
5440) dkr_sat = dkr_sat / 0.d0
5441) dkr_sat = dkr_sat * 0.d0
5442)
5443) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
5444) Se = max(min(Se,1.0d0),0.0d0)
5445)
5446) if (Se >= 1.d0) then
5447) relative_permeability = 1.d0
5448) return
5449) else if (Se <= 0.d0) then
5450) relative_permeability = 0.d0
5451) return
5452) else if (Se < this%Sr) then
5453) Se = this%Sr
5454) endif
5455)
5456) ! reference #1
5457) power = 3.d0+2.d0/this%lambda
5458) relative_permeability = Se**power
5459) dkr_Se = power*relative_permeability/Se
5460)
5461) end subroutine RPF_BRAGFLO_KRP12_Liq_RelPerm
5462) ! End RPF: Burdine, Brooks-Corey (Liquid)
5463)
5464) ! ************************************************************************** !
5465)
5466) ! Begin RPF: BRAGFLO KRP12 (Gas)
5467) function RPF_BRAGFLO_KRP12_Gas_Create()
5468)
5469) ! Creates the KRP12 or BC_Burdine gas relative permeability function object
5470)
5471) implicit none
5472)
5473) class(rpf_BRAGFLO_KRP12_gas_type), pointer :: RPF_BRAGFLO_KRP12_Gas_Create
5474)
5475) allocate(RPF_BRAGFLO_KRP12_Gas_Create)
5476) call RPF_BRAGFLO_KRP12_Gas_Create%Init()
5477)
5478) end function RPF_BRAGFLO_KRP12_Gas_Create
5479) ! End RPF: BRAGFLO KRP12 (Gas)
5480)
5481) ! ************************************************************************** !
5482)
5483) subroutine RPF_BRAGFLO_KRP12_Gas_RelPerm(this,liquid_saturation, &
5484) relative_permeability,dkr_sat,option)
5485) !
5486) ! Computes the relative permeability (and associated derivatives) as a
5487) ! function of saturation
5488) !
5489) ! Modified Brooks-Corey model KRP = 12 in BRAGFLO
5490) !
5491) ! Author: Heeho Park
5492) ! Date: 11/13/15
5493) !
5494) use Option_module
5495)
5496) implicit none
5497)
5498) class(rpf_BRAGFLO_KRP12_gas_type) :: this
5499) PetscReal, intent(in) :: liquid_saturation
5500) PetscReal, intent(out) :: relative_permeability
5501) PetscReal, intent(out) :: dkr_sat
5502) type(option_type), intent(inout) :: option
5503)
5504) PetscReal :: Se
5505) PetscReal :: Seg
5506) PetscReal :: gas_saturation
5507) PetscReal :: dkr_Se
5508)
5509) gas_saturation = 1.0d0 - liquid_saturation
5510)
5511) relative_permeability = 0.d0
5512) print *, 'RPF_BRAGFLO_KRP12_Gas_RelPerm not validated'
5513) stop
5514) ! initialize to derivative to NaN so that not mistakenly used.
5515) dkr_sat = 0.d0
5516) dkr_sat = dkr_sat / 0.d0
5517) dkr_sat = dkr_sat * 0.d0
5518)
5519) if (gas_saturation <= this%Srg) then
5520) relative_permeability = 0.0d0
5521) else if (liquid_saturation > this%Sr) then
5522) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
5523) Se = max(min(Se,1.0d0),0.0d0)
5524) Seg = 1.d0 - Se
5525) if (Se < this%Sr) then
5526) Se = this%Sr
5527) Seg = 1.d0 - Se
5528) else if (Seg < this%Srg) then
5529) Seg = this%Srg
5530) Se = 1.d0 - Seg
5531) endif
5532) ! reference #1
5533) relative_permeability = Seg*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
5534) ! Mathematica Analytical solution (Heeho Park)
5535) dkr_Se = -(1.d0+2.d0/this%lambda)*Seg**2.d0*Se**(2.d0/this%lambda) &
5536) - 2.d0*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
5537) else
5538) relative_permeability = 1.0d0
5539) endif
5540)
5541) end subroutine RPF_BRAGFLO_KRP12_Gas_RelPerm
5542) ! End RPF: Burdine, Brooks-Corey (Gas)
5543)
5544) ! ************************************************************************** !
5545)
5546) ! Begin RPF: TOUGH2, Linear (Oil)
5547) function RPF_TOUGH2_Linear_Oil_Create()
5548)
5549) ! Creates the TOUGH2 Linear oil relative permeability function object
5550) ! Author: Paolo Orsini (OGS)
5551) ! Date: 10/19/2015
5552)
5553) class(rpf_TOUGH2_Linear_oil_type), pointer :: RPF_TOUGH2_Linear_Oil_Create
5554)
5555) allocate(RPF_TOUGH2_Linear_Oil_Create)
5556) call RPF_TOUGH2_Linear_Oil_Create%Init()
5557)
5558) end function RPF_TOUGH2_Linear_Oil_Create
5559)
5560) ! ************************************************************************** !
5561)
5562) subroutine RPF_TOUGH2_Linear_Oil_Init(this)
5563)
5564) ! Initializes the TOUGH2 Linear Oil relative permeability function
5565) ! object
5566) ! Author: Paolo Orsini (OGS)
5567) ! Date: 10/19/2015
5568)
5569) implicit none
5570)
5571) class(rpf_TOUGH2_Linear_oil_type) :: this
5572)
5573) call RPFBaseInit(this)
5574) this%Sro = UNINITIALIZED_DOUBLE
5575)
5576) end subroutine RPF_TOUGH2_Linear_Oil_Init
5577)
5578) ! ************************************************************************** !
5579)
5580) subroutine RPF_TOUGH2_Linear_Oil_Verify(this,name,option)
5581)
5582) use Option_module
5583)
5584) implicit none
5585)
5586) class(rpf_TOUGH2_Linear_oil_type) :: this
5587) character(len=MAXSTRINGLENGTH) :: name
5588) type(option_type) :: option
5589)
5590) character(len=MAXSTRINGLENGTH) :: string
5591)
5592) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
5593) string = name
5594) else
5595) string = trim(name) // 'PERMEABILITY_FUNCTION,TOUGH2_LINEAR_OIL'
5596) endif
5597) call RPFBaseVerify(this,string,option)
5598) if (Uninitialized(this%Sro)) then
5599) option%io_buffer = UninitializedMessage('OIL_RESIDUAL_SATURATION',string)
5600) call printErrMsg(option)
5601) endif
5602)
5603) end subroutine RPF_TOUGH2_Linear_Oil_Verify
5604)
5605) ! ************************************************************************** !
5606)
5607) subroutine RPF_TOUGH2_Linear_Oil_RelPerm(this,liquid_saturation, &
5608) relative_permeability,dkr_sat,option)
5609) !
5610) ! Computes the relative permeability (and associated derivatives) as a
5611) ! function of saturation
5612) !
5613) ! Author: Paolo Orsini (OGS)
5614) ! Date: 10/19/2015
5615)
5616)
5617) use Option_module
5618)
5619) implicit none
5620)
5621) class(rpf_TOUGH2_Linear_oil_type) :: this
5622) PetscReal, intent(in) :: liquid_saturation
5623) PetscReal, intent(out) :: relative_permeability
5624) PetscReal, intent(out) :: dkr_sat
5625) type(option_type), intent(inout) :: option
5626)
5627) PetscReal :: So
5628) PetscReal :: Se
5629) PetscReal :: Seo
5630) PetscReal :: liquid_relative_permeability
5631) PetscReal :: liquid_dkr_sat
5632)
5633) ! initialize to derivative to NaN so that not mistakenly used.
5634) dkr_sat = 0.d0
5635) dkr_sat = dkr_sat / 0.d0
5636) dkr_sat = dkr_sat * 0.d0
5637)
5638) So = 1.d0 - liquid_saturation
5639)
5640) Seo = (So - this%Sro) / (1.d0 - this%Sro)
5641)
5642) if (Seo >= 1.d0) then
5643) relative_permeability = 1.d0
5644) return
5645) else if (Seo <= 0.d0) then
5646) relative_permeability = 0.d0
5647) return
5648) endif
5649)
5650) relative_permeability = Seo
5651)
5652) end subroutine RPF_TOUGH2_Linear_Oil_RelPerm
5653) ! End RPF: TOUGH2, Linear (Oil)
5654)
5655) ! ************************************************************************** !
5656)
5657) !Beginning RPF Modified Brooks-Corey for liq and oil phase (RPF_Mod_BC_Oil)
5658)
5659) ! procedure, public :: Init => RPF_Mod_BC_Oil_Init
5660) ! procedure, public :: Verify => RPF_Mod_BC_Oil_Verify
5661) ! procedure, public :: SetupPolynomials => RPF_Mod_BC_SetupPolynomials
5662) ! procedure, public :: RelativePermeability => RPF_Mod_BC_Oil_RelPerm
5663)
5664) function RPF_Mod_BC_Liq_Create()
5665)
5666) ! Creates the Modified BC Oil relative permeability function object
5667) ! Author: Paolo Orsini (OGS)
5668) ! Date: 02/20/2016
5669)
5670) class(rpf_mod_BC_liq_type), pointer :: RPF_Mod_BC_Liq_Create
5671)
5672) allocate(RPF_Mod_BC_Liq_Create)
5673) call RPF_Mod_BC_Liq_Create%Init()
5674)
5675) end function RPF_Mod_BC_Liq_Create
5676)
5677) ! ************************************************************************** !
5678)
5679) function RPF_Mod_BC_Oil_Create()
5680)
5681) ! Creates the Modified BC Oil relative permeability function object
5682) ! Author: Paolo Orsini (OGS)
5683) ! Date: 02/20/2016
5684)
5685) class(rpf_mod_BC_oil_type), pointer :: RPF_Mod_BC_Oil_Create
5686)
5687) allocate(RPF_Mod_BC_Oil_Create)
5688) call RPF_Mod_BC_Oil_Create%Init()
5689)
5690) end function RPF_Mod_BC_Oil_Create
5691)
5692) ! ************************************************************************** !
5693)
5694) !subroutine RPF_Mod_BC_Oil_Init(this)
5695) subroutine RPF_Mod_BC_Init(this)
5696)
5697) ! Initializes the Modified BC Oil relative permeability function object
5698) ! object
5699) ! Author: Paolo Orsini (OGS)
5700) ! Date: 02/20/2016
5701)
5702) implicit none
5703)
5704) !class(rpf_mod_BC_oil_type) :: this
5705) class(rpf_mod_BC_type) :: this
5706)
5707) call RPFBaseInit(this)
5708) this%m = UNINITIALIZED_DOUBLE
5709) this%Srg = UNINITIALIZED_DOUBLE
5710) this%Sro = UNINITIALIZED_DOUBLE
5711) this%kr_max = 1.0d0
5712)
5713) !end subroutine RPF_Mod_BC_Oil_Init
5714) end subroutine RPF_Mod_BC_Init
5715)
5716) ! ************************************************************************** !
5717)
5718) !subroutine RPF_Mod_BC_Oil_Verify(this,name,option)
5719) subroutine RPF_Mod_BC_Verify(this,name,option)
5720)
5721) use Option_module
5722)
5723) implicit none
5724)
5725) !class(rpf_mod_BC_oil_type) :: this
5726) class(rpf_mod_BC_type) :: this
5727) character(len=MAXSTRINGLENGTH) :: name
5728) type(option_type) :: option
5729)
5730) character(len=MAXSTRINGLENGTH) :: string
5731)
5732) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
5733) string = name
5734) else
5735) select type(rpf => this)
5736) class is(rpf_mod_BC_liq_type)
5737) string = trim(name) // 'PERMEABILITY_FUNCTION,MOD_BC_LIQ'
5738) class is(rpf_mod_BC_oil_type)
5739) string = trim(name) // 'PERMEABILITY_FUNCTION,MOD_BC_OIL'
5740) end select
5741) endif
5742) call RPFBaseVerify(this,string,option)
5743) if (Uninitialized(this%Sro)) then
5744) option%io_buffer = UninitializedMessage('OIL_RESIDUAL_SATURATION',string)
5745) call printErrMsg(option)
5746) endif
5747) if (Uninitialized(this%Srg)) then
5748) option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
5749) call printErrMsg(option)
5750) endif
5751)
5752) if (Uninitialized(this%m)) then
5753) option%io_buffer = UninitializedMessage('POWER EXPONENT',string)
5754) call printErrMsg(option)
5755) endif
5756)
5757) !end subroutine RPF_Mod_BC_Oil_Verify
5758) end subroutine RPF_Mod_BC_Verify
5759)
5760)
5761) ! ************************************************************************** !
5762)
5763) subroutine RPF_Mod_BC_SetupPolynomials(this,option,error_string)
5764)
5765) ! Sets up polynomials for smoothing Modified BC permeability function
5766)
5767) use Option_module
5768) use Utility_module
5769)
5770) implicit none
5771)
5772) class(rpf_mod_BC_type) :: this
5773) type(option_type) :: option
5774) character(len=MAXSTRINGLENGTH) :: error_string
5775)
5776) PetscReal :: b(4)
5777)
5778) PetscReal :: Se_ph_low
5779)
5780) this%poly => PolynomialCreate()
5781) ! fill matix with values
5782) this%poly%low = 0.99d0 ! just below saturated
5783) !this%poly%low = 0.95d0 ! just below saturated
5784) this%poly%high = 1.d0 ! saturated
5785) Se_ph_low = this%poly%low
5786) !select type(rpf => this)
5787) ! class is(rpf_mod_BC_liq_type)
5788) ! Se_ph_low = ( this%poly%low - this%Sr ) / &
5789) ! (1.0 - this%Sro - this%Sr - this%Srg)
5790) ! class is(rpf_mod_BC_oil_type)
5791) ! Se_ph_low = ( this%poly%low - this%Sro ) / &
5792) ! (1.0 - this%Sro - this%Sr - this%Srg)
5793) !end select
5794)
5795) b(1) = this%kr_max
5796) b(2) = this%kr_max * (Se_ph_low ** this%m)
5797) b(3) = 0.d0
5798) b(4) = this%m * this%kr_max * Se_ph_low ** (this%m - 1.0 )
5799)
5800) call CubicPolynomialSetup(this%poly%high,this%poly%low,b)
5801)
5802) this%poly%coefficients(1:4) = b(1:4)
5803)
5804) end subroutine RPF_Mod_BC_SetupPolynomials
5805)
5806) ! ************************************************************************** !
5807)
5808) subroutine RPF_Mod_BC_Liq_RelPerm(this,liquid_saturation, &
5809) relative_permeability,dkr_sat,option)
5810) !
5811) ! Computes the relative permeability (and associated derivatives) as a
5812) ! function of saturation
5813) !
5814) ! Author: Paolo Orsini (OGS)
5815) ! Date: 02/21/2016
5816)
5817) use Option_module
5818) use Utility_module
5819)
5820) implicit none
5821)
5822) class(rpf_Mod_BC_liq_type) :: this
5823) PetscReal, intent(in) :: liquid_saturation
5824) PetscReal, intent(out) :: relative_permeability
5825) PetscReal, intent(out) :: dkr_sat
5826) type(option_type), intent(inout) :: option
5827)
5828) PetscReal :: Se
5829) PetscReal :: dkr_Se
5830)
5831) ! initialize to derivative to NaN so that not mistakenly used.
5832) dkr_sat = 0.d0
5833) dkr_sat = dkr_sat / 0.d0
5834) dkr_sat = dkr_sat * 0.d0
5835)
5836) Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sro - this%Sr - this%Srg )
5837)
5838) if (Se >= 1.d0) then
5839) relative_permeability = this%kr_max
5840) return
5841) else if (Se <= 0.d0) then
5842) relative_permeability = 0.d0
5843) return
5844) endif
5845)
5846) if (associated(this%poly)) then
5847) if (Se > this%poly%low) then
5848) call CubicPolynomialEvaluate(this%poly%coefficients, &
5849) Se,relative_permeability,dkr_Se)
5850) return
5851) endif
5852) endif
5853)
5854) relative_permeability = this%kr_max * (Se ** this%m)
5855)
5856) end subroutine RPF_Mod_BC_Liq_RelPerm
5857)
5858) ! ************************************************************************** !
5859)
5860)
5861) subroutine RPF_Mod_BC_Oil_RelPerm(this,liquid_saturation, &
5862) relative_permeability,dkr_sat,option)
5863) !
5864) ! Computes the relative permeability (and associated derivatives) as a
5865) ! function of saturation
5866) !
5867) ! Author: Paolo Orsini (OGS)
5868) ! Date: 02/20/2016
5869)
5870) use Option_module
5871) use Utility_module
5872)
5873) implicit none
5874)
5875) class(rpf_Mod_BC_oil_type) :: this
5876) PetscReal, intent(in) :: liquid_saturation
5877) PetscReal, intent(out) :: relative_permeability
5878) PetscReal, intent(out) :: dkr_sat
5879) type(option_type), intent(inout) :: option
5880)
5881) PetscReal :: So
5882) PetscReal :: Se
5883) PetscReal :: Seo
5884) PetscReal :: dkr_Se
5885)
5886) ! initialize to derivative to NaN so that not mistakenly used.
5887) dkr_sat = 0.d0
5888) dkr_sat = dkr_sat / 0.d0
5889) dkr_sat = dkr_sat * 0.d0
5890)
5891) So = 1.d0 - liquid_saturation
5892)
5893) Seo = (So - this%Sro) / (1.d0 - this%Sro - this%Sr - this%Srg )
5894)
5895) if (Seo >= 1.d0) then
5896) relative_permeability = this%kr_max
5897) return
5898) else if (Seo <= 0.d0) then
5899) relative_permeability = 0.d0
5900) return
5901) endif
5902)
5903) if (associated(this%poly)) then
5904) if (Seo > this%poly%low) then
5905) call CubicPolynomialEvaluate(this%poly%coefficients, &
5906) Seo,relative_permeability,dkr_Se)
5907) return
5908) endif
5909) endif
5910)
5911) relative_permeability = this%kr_max * (Seo ** this%m)
5912)
5913) end subroutine RPF_Mod_BC_Oil_RelPerm
5914)
5915) !End RPF: Modified Brooks-Corey for the oil phase (RPF_Mod_BC_Oil)
5916)
5917) ! ************************************************************************** !
5918)
5919) function RPF_Constant_Create()
5920)
5921) ! Creates the constant relative permeability function object
5922)
5923) implicit none
5924)
5925) class(rel_perm_func_constant_type), pointer :: RPF_Constant_Create
5926)
5927) allocate(RPF_Constant_Create)
5928) call RPFBaseInit(RPF_Constant_Create)
5929) ! set Sr = 0. to avoid uninitialized failure
5930) RPF_Constant_Create%Sr = 0.d0
5931) RPF_Constant_Create%kr = 0.d0
5932)
5933) end function RPF_Constant_Create
5934)
5935) ! ************************************************************************** !
5936)
5937) subroutine RPFConstantVerify(this,name,option)
5938)
5939) use Option_module
5940)
5941) implicit none
5942)
5943) class(rel_perm_func_constant_type) :: this
5944) character(len=MAXSTRINGLENGTH) :: name
5945) type(option_type) :: option
5946)
5947) character(len=MAXSTRINGLENGTH) :: string
5948)
5949) if (index(name,'PERMEABILITY_FUNCTION') > 0) then
5950) string = name
5951) else
5952) string = trim(name) // 'PERMEABILITY_FUNCTION,CONSTANT'
5953) endif
5954) call RPFBaseVerify(this,string,option)
5955) if (Uninitialized(this%kr)) then
5956) option%io_buffer = UninitializedMessage('RELATIVE_PERMEABILITY',string)
5957) call printErrMsg(option)
5958) endif
5959)
5960) end subroutine RPFConstantVerify
5961)
5962) ! ************************************************************************** !
5963)
5964) subroutine RPF_ConstantRelPerm(this,liquid_saturation,relative_permeability, &
5965) dkr_sat,option)
5966) use Option_module
5967)
5968) implicit none
5969)
5970) class(rel_perm_func_constant_type) :: this
5971) PetscReal, intent(in) :: liquid_saturation
5972) PetscReal, intent(out) :: relative_permeability
5973) PetscReal, intent(out) :: dkr_sat
5974) type(option_type), intent(inout) :: option
5975)
5976) relative_permeability = this%kr
5977) dkr_sat = 0.d0
5978)
5979) end subroutine RPF_ConstantRelPerm
5980)
5981) ! ************************************************************************** !
5982)
5983) subroutine PolynomialDestroy(poly)
5984) !
5985) ! Destroys a polynomial smoother
5986) !
5987) ! Author: Glenn Hammond
5988) ! Date: 09/24/14
5989) !
5990)
5991) implicit none
5992)
5993) type(polynomial_type), pointer :: poly
5994)
5995) if (.not.associated(poly)) return
5996)
5997) deallocate(poly)
5998) nullify(poly)
5999)
6000) end subroutine PolynomialDestroy
6001)
6002) ! ************************************************************************** !
6003)
6004) subroutine SaturationFunctionDestroy(sf)
6005) !
6006) ! Destroys a saturuation function
6007) !
6008) ! Author: Glenn Hammond
6009) ! Date: 09/24/14
6010) !
6011)
6012) implicit none
6013)
6014) class(sat_func_base_type), pointer :: sf
6015)
6016) if (.not.associated(sf)) return
6017)
6018) call PolynomialDestroy(sf%sat_poly)
6019) call PolynomialDestroy(sf%sat_poly)
6020) deallocate(sf)
6021) nullify(sf)
6022)
6023) end subroutine SaturationFunctionDestroy
6024)
6025) ! ************************************************************************** !
6026)
6027) subroutine PermeabilityFunctionDestroy(rpf)
6028) !
6029) ! Destroys a saturuation function
6030) !
6031) ! Author: Glenn Hammond
6032) ! Date: 09/24/14
6033) !
6034)
6035) implicit none
6036)
6037) class(rel_perm_func_base_type), pointer :: rpf
6038)
6039) if (.not.associated(rpf)) return
6040)
6041) call PolynomialDestroy(rpf%poly)
6042) deallocate(rpf)
6043) nullify(rpf)
6044)
6045) end subroutine PermeabilityFunctionDestroy
6046)
6047) ! ************************************************************************** !
6048)
6049) recursive subroutine CharacteristicCurvesDestroy(cc)
6050) !
6051) ! Destroys a characteristic curve
6052) !
6053) ! Author: Glenn Hammond
6054) ! Date: 09/24/14
6055) !
6056)
6057) implicit none
6058)
6059) class(characteristic_curves_type), pointer :: cc
6060)
6061) if (.not.associated(cc)) return
6062)
6063) call CharacteristicCurvesDestroy(cc%next)
6064)
6065) call SaturationFunctionDestroy(cc%saturation_function)
6066)
6067) ! the liquid and gas relative permeability pointers may pointer to the
6068) ! same address. if so, destroy one and nullify the other.
6069) if (associated(cc%liq_rel_perm_function,cc%gas_rel_perm_function)) then
6070) call PermeabilityFunctionDestroy(cc%liq_rel_perm_function)
6071) nullify(cc%gas_rel_perm_function)
6072) !PO how about avoiding xxx_rel_perm_function => aaa_rel_perm_function?
6073) ! it should semplify code. It seems we do this only to pass verify
6074) else if (associated(cc%oil_rel_perm_function,cc%gas_rel_perm_function)) then
6075) call PermeabilityFunctionDestroy(cc%oil_rel_perm_function)
6076) nullify(cc%gas_rel_perm_function)
6077) else
6078) call PermeabilityFunctionDestroy(cc%liq_rel_perm_function)
6079) call PermeabilityFunctionDestroy(cc%gas_rel_perm_function)
6080) !call PermeabilityFunctionDestroy(cc%oil_rel_perm_function)
6081) endif
6082)
6083) deallocate(cc)
6084) nullify(cc)
6085)
6086) end subroutine CharacteristicCurvesDestroy
6087)
6088) ! ************************************************************************** !
6089)
6090) end module Characteristic_Curves_module