material.F90 coverage: 70.83 %func 49.26 %block
1) module Material_module
2)
3) use Dataset_Base_class
4)
5) use PFLOTRAN_Constants_module
6) use Material_Aux_class
7) use Fracture_module
8)
9) implicit none
10)
11) private
12)
13) #include "petsc/finclude/petscsys.h"
14)
15) type, public :: material_property_type
16) PetscInt :: external_id
17) PetscInt :: internal_id
18) PetscBool :: active
19) character(len=MAXWORDLENGTH) :: name
20) PetscReal :: permeability(3,3)
21) PetscBool :: isotropic_permeability
22) PetscReal :: vertical_anisotropy_ratio ! (vertical / horizontal)
23) PetscReal :: permeability_scaling_factor
24) ! character(len=MAXWORDLENGTH) :: permeability_dataset_name
25) class(dataset_base_type), pointer :: permeability_dataset
26) class(dataset_base_type), pointer :: permeability_dataset_y
27) class(dataset_base_type), pointer :: permeability_dataset_z
28) PetscReal :: porosity
29) ! character(len=MAXWORDLENGTH) :: porosity_dataset_name
30) class(dataset_base_type), pointer :: porosity_dataset
31) class(dataset_base_type), pointer :: tortuosity_dataset
32) PetscReal :: tortuosity
33) PetscInt :: saturation_function_id
34) character(len=MAXWORDLENGTH) :: saturation_function_name
35) PetscReal :: rock_density ! kg/m^3
36) PetscReal :: specific_heat ! J/kg-K
37) PetscReal :: thermal_conductivity_dry
38) PetscReal :: thermal_conductivity_wet
39) PetscReal :: alpha ! conductivity saturation relation exponent
40)
41) class(fracture_type), pointer :: fracture
42)
43) character(len=MAXWORDLENGTH) :: soil_compressibility_function
44) PetscReal :: soil_compressibility
45) PetscReal :: soil_reference_pressure
46) PetscBool :: soil_reference_pressure_initial
47) ! character(len=MAXWORDLENGTH) :: compressibility_dataset_name
48) class(dataset_base_type), pointer :: compressibility_dataset
49)
50) ! ice properties
51) PetscReal :: thermal_conductivity_frozen
52) PetscReal :: alpha_fr
53)
54) PetscReal :: pore_compressibility
55) PetscReal :: thermal_expansitivity
56) PetscReal :: dispersivity(3)
57) PetscReal :: tortuosity_pwr
58) PetscReal :: min_pressure
59) PetscReal :: max_pressure
60) PetscReal :: max_permfactor
61) !geh: minral surface area power functions must be defined on a per
62) ! mineral basis, look in reaction_aux.F90
63) !PetscReal :: mnrl_surf_area_volfrac_pwr
64) !PetscReal :: mnrl_surf_area_porosity_pwr
65) PetscReal :: permeability_pwr
66) PetscReal :: permeability_crit_por
67) PetscReal :: permeability_min_scale_fac
68) character(len=MAXWORDLENGTH) :: secondary_continuum_name
69) PetscReal :: secondary_continuum_length
70) PetscReal :: secondary_continuum_matrix_block_size
71) PetscReal :: secondary_continuum_fracture_spacing
72) PetscReal :: secondary_continuum_radius
73) PetscReal :: secondary_continuum_area
74) PetscInt :: secondary_continuum_ncells
75) PetscReal :: secondary_continuum_epsilon
76) PetscReal :: secondary_continuum_aperture
77) PetscReal :: secondary_continuum_init_temp
78) PetscReal :: secondary_continuum_init_conc
79) PetscReal :: secondary_continuum_porosity
80) PetscReal :: secondary_continuum_diff_coeff
81) PetscReal :: secondary_continuum_mnrl_volfrac
82) PetscReal :: secondary_continuum_mnrl_area
83) PetscBool :: secondary_continuum_log_spacing
84) PetscReal :: secondary_continuum_outer_spacing
85) PetscReal :: secondary_continuum_area_scaling
86) type(material_property_type), pointer :: next
87) end type material_property_type
88)
89) type, public :: material_property_ptr_type
90) type(material_property_type), pointer :: ptr
91) end type material_property_ptr_type
92)
93) public :: MaterialPropertyCreate, &
94) MaterialPropertyDestroy, &
95) MaterialPropertyAddToList, &
96) MaterialPropGetPtrFromList, &
97) MaterialPropGetPtrFromArray, &
98) MaterialPropConvertListToArray, &
99) MaterialAnisotropyExists, &
100) MaterialSetAuxVarScalar, &
101) MaterialSetAuxVarVecLoc, &
102) MaterialGetAuxVarVecLoc, &
103) MaterialAuxVarCommunicate, &
104) MaterialPropertyRead, &
105) MaterialInitAuxIndices, &
106) MaterialAssignPropertyToAux, &
107) MaterialSetup, &
108) MaterialUpdateAuxVars, &
109) MaterialStoreAuxVars, &
110) MaterialWeightAuxVars, &
111) MaterialGetMaxExternalID, &
112) MaterialCreateIntToExtMapping, &
113) MaterialCreateExtToIntMapping, &
114) MaterialApplyMapping, &
115) MaterialPropInputRecord
116)
117) contains
118)
119) ! ************************************************************************** !
120)
121) function MaterialPropertyCreate()
122) !
123) ! Creates a material property
124) !
125) ! Author: Glenn Hammond
126) ! Date: 11/02/07
127) !
128)
129) implicit none
130)
131) type(material_property_type), pointer :: MaterialPropertyCreate
132)
133) type(material_property_type), pointer :: material_property
134)
135) allocate(material_property)
136) material_property%external_id = 0
137) material_property%internal_id = 0
138) material_property%active = PETSC_TRUE
139) material_property%name = ''
140) ! initialize to UNINITIALIZED_DOUBLE to catch bugs
141) material_property%permeability = UNINITIALIZED_DOUBLE
142) material_property%isotropic_permeability = PETSC_TRUE
143) material_property%vertical_anisotropy_ratio = UNINITIALIZED_DOUBLE
144) material_property%permeability_scaling_factor = 0.d0
145) material_property%permeability_pwr = 1.d0
146) material_property%permeability_crit_por = 0.d0
147) material_property%permeability_min_scale_fac = 1.d0
148) ! material_property%permeability_dataset_name = ''
149) nullify(material_property%permeability_dataset)
150) nullify(material_property%permeability_dataset_y)
151) nullify(material_property%permeability_dataset_z)
152) ! initialize to UNINITIALIZED_DOUBLE to catch bugs
153) material_property%porosity = UNINITIALIZED_DOUBLE
154) ! material_property%porosity_dataset_name = ''
155) nullify(material_property%porosity_dataset)
156) nullify(material_property%tortuosity_dataset)
157) material_property%tortuosity = 1.d0
158) material_property%tortuosity_pwr = 0.d0
159) material_property%saturation_function_id = 0
160) material_property%saturation_function_name = ''
161) material_property%rock_density = UNINITIALIZED_DOUBLE
162) material_property%specific_heat = UNINITIALIZED_DOUBLE
163) material_property%thermal_conductivity_dry = UNINITIALIZED_DOUBLE
164) material_property%thermal_conductivity_wet = UNINITIALIZED_DOUBLE
165) material_property%alpha = 0.45d0
166)
167) nullify(material_property%fracture)
168)
169) material_property%soil_compressibility_function = ''
170) material_property%soil_compressibility = UNINITIALIZED_DOUBLE
171) material_property%soil_reference_pressure = UNINITIALIZED_DOUBLE
172) material_property%soil_reference_pressure_initial = PETSC_FALSE
173) ! material_property%compressibility_dataset_name = ''
174) nullify(material_property%compressibility_dataset)
175)
176) material_property%thermal_conductivity_frozen = 0.d0
177) material_property%alpha_fr = 0.95d0
178)
179) material_property%pore_compressibility = UNINITIALIZED_DOUBLE
180) material_property%thermal_expansitivity = 0.d0
181) material_property%dispersivity = 0.d0
182) material_property%min_pressure = 0.d0
183) material_property%max_pressure = 1.d6
184) material_property%max_permfactor = 1.d0
185) material_property%secondary_continuum_name = ''
186) material_property%secondary_continuum_length = 0.d0
187) material_property%secondary_continuum_matrix_block_size = 0.d0
188) material_property%secondary_continuum_fracture_spacing = 0.d0
189) material_property%secondary_continuum_radius = 0.d0
190) material_property%secondary_continuum_area = 0.d0
191) material_property%secondary_continuum_epsilon = 1.d0
192) material_property%secondary_continuum_aperture = 0.d0
193) material_property%secondary_continuum_init_temp = 100.d0
194) material_property%secondary_continuum_init_conc = 0.d0
195) material_property%secondary_continuum_porosity = 0.5d0
196) material_property%secondary_continuum_diff_coeff = 1.d-9
197) material_property%secondary_continuum_mnrl_volfrac = 0.d0
198) material_property%secondary_continuum_mnrl_area = 0.d0
199) material_property%secondary_continuum_ncells = 0
200) material_property%secondary_continuum_log_spacing = PETSC_FALSE
201) material_property%secondary_continuum_outer_spacing = 1.d-3
202) material_property%secondary_continuum_area_scaling = 1.d0
203) nullify(material_property%next)
204) MaterialPropertyCreate => material_property
205)
206) end function MaterialPropertyCreate
207)
208) ! ************************************************************************** !
209)
210) subroutine MaterialPropertyRead(material_property,input,option)
211) !
212) ! Reads in contents of a material_property card
213) !
214) ! Author: Glenn Hammond
215) ! Date: 01/13/09
216) !
217)
218) use Option_module
219) use Input_Aux_module
220) use String_module
221) use Fracture_module
222) use Dataset_module
223)
224) implicit none
225)
226) type(material_property_type) :: material_property
227) type(input_type), pointer :: input
228) type(option_type) :: option
229)
230) character(len=MAXWORDLENGTH) :: keyword, word, internal_units
231) character(len=MAXSTRINGLENGTH) :: string
232) character(len=MAXSTRINGLENGTH) :: buffer_save
233)
234) PetscInt :: length
235) PetscBool :: therm_k_frz
236) PetscBool :: therm_k_exp_frz
237) PetscReal :: tempreal
238)
239) therm_k_frz = PETSC_FALSE
240) therm_k_exp_frz = PETSC_FALSE
241)
242) input%ierr = 0
243) do
244)
245) call InputReadPflotranString(input,option)
246)
247) if (InputCheckExit(input,option)) exit
248)
249) call InputReadWord(input,option,keyword,PETSC_TRUE)
250) call InputErrorMsg(input,option,'keyword','MATERIAL_PROPERTY')
251) call StringToUpper(keyword)
252)
253) select case(trim(keyword))
254)
255) case('NAME')
256) call InputReadWord(input,option,material_property%name,PETSC_TRUE)
257) call InputErrorMsg(input,option,'name','MATERIAL_PROPERTY')
258) case('ID')
259) call InputReadInt(input,option,material_property%external_id)
260) call InputErrorMsg(input,option,'id','MATERIAL_PROPERTY')
261) if (material_property%external_id == UNINITIALIZED_INTEGER) then
262) write(string,*) UNINITIALIZED_INTEGER
263) option%io_buffer = 'Material ID "' // trim(adjustl(string)) // &
264) '" is reserved for uninitialized materials. Please choose a &
265) &different value.'
266) endif
267) case('ACTIVE')
268) material_property%active = PETSC_TRUE
269) case('INACTIVE')
270) material_property%active = PETSC_FALSE
271) case('SATURATION_FUNCTION','CHARACTERISTIC_CURVES')
272) call InputReadWordDbaseCompatible(input,option, &
273) material_property%saturation_function_name, &
274) PETSC_TRUE)
275) call InputErrorMsg(input,option,'saturation function name', &
276) 'MATERIAL_PROPERTY')
277) case('ROCK_DENSITY')
278) call InputReadDouble(input,option,material_property%rock_density)
279) call InputErrorMsg(input,option,'rock density','MATERIAL_PROPERTY')
280) call InputReadAndConvertUnits(input,material_property%rock_density, &
281) 'kg/m^3','MATERIAL_PROPERTY,rock density',option)
282) case('SPECIFIC_HEAT','HEAT_CAPACITY')
283) call InputReadDouble(input,option,material_property%specific_heat)
284) call InputErrorMsg(input,option,'specific heat','MATERIAL_PROPERTY')
285) call InputReadAndConvertUnits(input,material_property%specific_heat, &
286) 'J/kg-C','MATERIAL_PROPERTY,specific heat',option)
287) case('LONGITUDINAL_DISPERSIVITY')
288) call InputReadDouble(input,option,material_property%dispersivity(1))
289) call InputErrorMsg(input,option,'longitudinal_dispersivity', &
290) 'MATERIAL_PROPERTY')
291) case('TRANSVERSE_DISPERSIVITY_H')
292) call InputReadDouble(input,option,material_property%dispersivity(2))
293) call InputErrorMsg(input,option,'transverse_dispersivity_h', &
294) 'MATERIAL_PROPERTY')
295) case('TRANSVERSE_DISPERSIVITY_V')
296) call InputReadDouble(input,option,material_property%dispersivity(3))
297) call InputErrorMsg(input,option,'transverse_dispersivity_v', &
298) 'MATERIAL_PROPERTY')
299) case('THERMAL_CONDUCTIVITY_DRY')
300) call InputReadDouble(input,option, &
301) material_property%thermal_conductivity_dry)
302) call InputErrorMsg(input,option,'dry thermal conductivity', &
303) 'MATERIAL_PROPERTY')
304) call InputReadAndConvertUnits(input, &
305) material_property%thermal_conductivity_dry, &
306) 'W/m-C','MATERIAL_PROPERTY,dry thermal conductivity',option)
307) case('THERMAL_CONDUCTIVITY_WET')
308) call InputReadDouble(input,option, &
309) material_property%thermal_conductivity_wet)
310) call InputErrorMsg(input,option,'wet thermal conductivity', &
311) 'MATERIAL_PROPERTY')
312) call InputReadAndConvertUnits(input, &
313) material_property%thermal_conductivity_wet, &
314) 'W/m-C','MATERIAL_PROPERTY,wet thermal conductivity',option)
315) case('THERMAL_COND_EXPONENT')
316) call InputReadDouble(input,option, &
317) material_property%alpha)
318) call InputErrorMsg(input,option,'thermal conductivity exponent', &
319) 'MATERIAL_PROPERTY')
320) case('THERMAL_CONDUCTIVITY_FROZEN')
321) therm_k_frz = PETSC_TRUE
322) call InputReadDouble(input,option, &
323) material_property%thermal_conductivity_frozen)
324) call InputErrorMsg(input,option,'frozen thermal conductivity', &
325) 'MATERIAL_PROPERTY')
326) call InputReadAndConvertUnits(input, &
327) material_property%thermal_conductivity_frozen, &
328) 'W/m-C','MATERIAL_PROPERTY,frozen thermal conductivity',option)
329) case('THERMAL_COND_EXPONENT_FROZEN')
330) therm_k_exp_frz = PETSC_TRUE
331) call InputReadDouble(input,option, &
332) material_property%alpha_fr)
333) call InputErrorMsg(input,option, &
334) 'thermal conductivity frozen exponent', &
335) 'MATERIAL_PROPERTY')
336) !case('PORE_COMPRESSIBILITY')
337) ! call InputReadDouble(input,option, &
338) ! material_property%pore_compressibility)
339) ! call InputErrorMsg(input,option,'pore compressibility', &
340) ! 'MATERIAL_PROPERTY')
341) case('SOIL_COMPRESSIBILITY_FUNCTION')
342) call InputReadWord(input,option, &
343) material_property%soil_compressibility_function, &
344) PETSC_TRUE)
345) call InputErrorMsg(input,option,'soil compressibility function', &
346) 'MATERIAL_PROPERTY')
347) case('SOIL_COMPRESSIBILITY')
348) call DatasetReadDoubleOrDataset(input,material_property% &
349) soil_compressibility, &
350) material_property%compressibility_dataset, &
351) 'soil compressibility', &
352) 'MATERIAL_PROPERTY',option)
353) case('SOIL_REFERENCE_PRESSURE')
354) string = trim(input%buf)
355) ! first read the word to determine if it is the keyword
356) ! INITIAL_CELL_PRESSURE.
357) call InputReadWord(input,option,word,PETSC_TRUE)
358) call InputErrorMsg(input,option,'soil reference pressure', &
359) 'MATERIAL_PROPERTY')
360) length = 16
361) if (StringCompare(word,'INITIAL_PRESSURE',length)) then
362) material_property%soil_reference_pressure_initial = PETSC_TRUE
363) else
364) ! if not the keyword above, copy back into buffer to be read as a
365) ! double precision.
366) input%buf = string
367) call InputReadDouble(input,option, &
368) material_property%soil_reference_pressure)
369) call InputErrorMsg(input,option,'soil reference pressure', &
370) 'MATERIAL_PROPERTY')
371) endif
372) case('THERMAL_EXPANSITIVITY')
373) call InputReadDouble(input,option, &
374) material_property%thermal_expansitivity)
375) call InputErrorMsg(input,option,'thermal expansitivity', &
376) 'MATERIAL_PROPERTY')
377) case('POROSITY')
378) call DatasetReadDoubleOrDataset(input,material_property%porosity, &
379) material_property%porosity_dataset, &
380) 'porosity','MATERIAL_PROPERTY',option)
381) case('TORTUOSITY')
382) call DatasetReadDoubleOrDataset(input,material_property%tortuosity, &
383) material_property%tortuosity_dataset, &
384) 'tortuosity','MATERIAL_PROPERTY',option)
385) case('WIPP-FRACTURE')
386) ! Calculates permeability and porosity induced by fracture,
387) ! which is described by pressure within certain range of pressure
388) ! BRAGFLO_6.02_UM Eq. (136)
389) ! 4.10 Pressure-Induced Fracture Treatment
390) material_property%fracture => FractureCreate()
391) call material_property%fracture%Read(input,option)
392) option%flow%transient_porosity = PETSC_TRUE
393) case('PERMEABILITY')
394) do
395) call InputReadPflotranString(input,option)
396) call InputReadStringErrorMsg(input,option, &
397) 'MATERIAL_PROPERTY,PERMEABILITY')
398)
399) if (InputCheckExit(input,option)) exit
400)
401) if (InputError(input)) exit
402) call InputReadWord(input,option,word,PETSC_TRUE)
403) call InputErrorMsg(input,option,'keyword', &
404) 'MATERIAL_PROPERTY,PERMEABILITY')
405) select case(trim(word))
406) case('ANISOTROPIC')
407) material_property%isotropic_permeability = PETSC_FALSE
408) case('VERTICAL_ANISOTROPY_RATIO')
409) material_property%isotropic_permeability = PETSC_FALSE
410) call InputReadDouble(input,option, &
411) material_property%vertical_anisotropy_ratio)
412) call InputErrorMsg(input,option,'vertical anisotropy ratio', &
413) 'MATERIAL_PROPERTY,PERMEABILITY')
414) case('ISOTROPIC')
415) material_property%isotropic_permeability = PETSC_TRUE
416) case('PERMEABILITY_SCALING_FACTOR')
417) call InputReadDouble(input,option, &
418) material_property%permeability_scaling_factor)
419) call InputErrorMsg(input,option,'permeability scaling factor', &
420) 'MATERIAL_PROPERTY,PERMEABILITY')
421) case('PERM_X')
422) call InputReadDouble(input,option, &
423) material_property%permeability(1,1))
424) call InputErrorMsg(input,option,'x permeability', &
425) 'MATERIAL_PROPERTY,PERMEABILITY')
426) case('PERM_Y')
427) call InputReadDouble(input,option, &
428) material_property%permeability(2,2))
429) call InputErrorMsg(input,option,'y permeability', &
430) 'MATERIAL_PROPERTY,PERMEABILITY')
431) case('PERM_Z')
432) call InputReadDouble(input,option, &
433) material_property%permeability(3,3))
434) call InputErrorMsg(input,option,'z permeability', &
435) 'MATERIAL_PROPERTY,PERMEABILITY')
436) case('PERM_X_LOG10')
437) call InputReadDouble(input,option, tempreal)
438) call InputErrorMsg(input,option,'log10 x permeability', &
439) 'MATERIAL_PROPERTY,PERMEABILITY')
440) material_property%permeability(1,1) = 10.d0**tempreal
441) case('PERM_Y_LOG10')
442) call InputReadDouble(input,option, tempreal)
443) call InputErrorMsg(input,option,'log10 y permeability', &
444) 'MATERIAL_PROPERTY,PERMEABILITY')
445) material_property%permeability(2,2) = 10.d0**tempreal
446) case('PERM_Z_LOG10')
447) call InputReadDouble(input,option, tempreal)
448) call InputErrorMsg(input,option,'log10 z permeability', &
449) 'MATERIAL_PROPERTY,PERMEABILITY')
450) material_property%permeability(3,3) = 10.d0**tempreal
451) case('PERM_XZ')
452) call InputReadDouble(input,option, &
453) material_property%permeability(1,3))
454) call InputErrorMsg(input,option,'xz permeability', &
455) 'MATERIAL_PROPERTY,PERMEABILITY')
456) case('PERM_XY')
457) call InputReadDouble(input,option, &
458) material_property%permeability(1,2))
459) call InputErrorMsg(input,option,'xy permeability', &
460) 'MATERIAL_PROPERTY,PERMEABILITY')
461) case('PERM_YZ')
462) call InputReadDouble(input,option, &
463) material_property%permeability(2,3))
464) call InputErrorMsg(input,option,'yz permeability', &
465) 'MATERIAL_PROPERTY,PERMEABILITY')
466) case('PERM_XZ_LOG10')
467) call InputReadDouble(input,option, tempreal)
468) call InputErrorMsg(input,option,'log10 xz permeability', &
469) 'MATERIAL_PROPERTY,PERMEABILITY')
470) material_property%permeability(1,3) = 10.d0**tempreal
471) case('PERM_XY_LOG10')
472) call InputReadDouble(input,option, tempreal)
473) call InputErrorMsg(input,option,'log10 xy permeability', &
474) 'MATERIAL_PROPERTY,PERMEABILITY')
475) material_property%permeability(1,2) = 10.d0**tempreal
476) case('PERM_YZ_LOG10')
477) call InputReadDouble(input,option, tempreal)
478) call InputErrorMsg(input,option,'log10 yz permeability', &
479) 'MATERIAL_PROPERTY,PERMEABILITY')
480) material_property%permeability(2,3) = 10.d0**tempreal
481) case('PERM_ISO_LOG10')
482) call InputReadDouble(input,option, tempreal)
483) call InputErrorMsg(input,option,'log10 isotropic permeability', &
484) 'MATERIAL_PROPERTY,PERMEABILITY')
485) material_property%permeability(1,1) = 10.d0**tempreal
486) material_property%permeability(2,2) = 10.d0**tempreal
487) material_property%permeability(3,3) = 10.d0**tempreal
488) case('PERM_ISO')
489) call InputReadDouble(input,option, &
490) material_property%permeability(1,1))
491) call InputErrorMsg(input,option,'isotropic permeability', &
492) 'MATERIAL_PROPERTY,PERMEABILITY')
493) material_property%permeability(2,2) = &
494) material_property%permeability(1,1)
495) material_property%permeability(3,3) = &
496) material_property%permeability(1,1)
497) case('RANDOM_DATASET')
498) option%io_buffer = 'RANDOM_DATASET is no longer supported. ' // &
499) 'Please use the new DATASET object in the input file and ' // &
500) 'reference that dataset through "DATASET name" within ' // &
501) 'the PERMEABILITY card.'
502) call printErrMsg(option)
503) case('DATASET')
504) material_property%permeability_dataset => DatasetBaseCreate()
505) call InputReadNChars(input,option, &
506) material_property% &
507) permeability_dataset%name, &
508) MAXWORDLENGTH,PETSC_TRUE)
509) call InputErrorMsg(input,option,'DATASET,NAME', &
510) 'MATERIAL_PROPERTY,PERMEABILITY')
511) case default
512) call InputKeywordUnrecognized(word, &
513) 'MATERIAL_PROPERTY,PERMEABILITY',option)
514) end select
515) enddo
516) if (dabs(material_property%permeability(1,1) - &
517) material_property%permeability(2,2)) > 1.d-40 .or. &
518) dabs(material_property%permeability(1,1) - &
519) material_property%permeability(3,3)) > 1.d-40) then
520) material_property%isotropic_permeability = PETSC_FALSE
521) endif
522) case('PERM_FACTOR')
523) ! Permfactor is the multiplier to permeability to increase perm
524) ! The perm increase could be due to pressure or other variable
525) ! Added by Satish Karra, LANL, 1/8/12
526) do
527) call InputReadPflotranString(input,option)
528) call InputReadStringErrorMsg(input,option, &
529) 'MATERIAL_PROPERTY,PERM_FACTOR')
530)
531) if (InputCheckExit(input,option)) exit
532)
533) if (InputError(input)) exit
534) call InputReadWord(input,option,word,PETSC_TRUE)
535) call InputErrorMsg(input,option,'keyword', &
536) 'MATERIAL_PROPERTY,PERM_FACTOR')
537) select case(trim(word))
538) ! Assuming only ramp function for now
539) ! The permfactor ramps from 1 to max_permfactor at max_pressure
540) ! and remains same
541) case('MIN_PRESSURE')
542) call InputReadDouble(input,option,material_property%min_pressure)
543) call InputErrorMsg(input,option,'min pressure','PERM_FACTOR')
544) case('MAX_PRESSURE')
545) call InputReadDouble(input,option,material_property%max_pressure)
546) call InputErrorMsg(input,option,'max pressure','PERM_FACTOR')
547) case('MAX_PERMFACTOR')
548) call InputReadDouble(input,option,material_property%max_permfactor)
549) call InputErrorMsg(input,option,'max permfactor','PERM_FACTOR')
550) case default
551) call InputKeywordUnrecognized(word, &
552) 'MATERIAL_PROPERTY,PERM_FACTOR',option)
553) end select
554) enddo
555) case('PERMEABILITY_POWER')
556) call InputReadDouble(input,option, &
557) material_property%permeability_pwr)
558) call InputErrorMsg(input,option,'permeability power', &
559) 'MATERIAL_PROPERTY')
560) case('PERMEABILITY_CRITICAL_POROSITY')
561) call InputReadDouble(input,option, &
562) material_property%permeability_crit_por)
563) call InputErrorMsg(input,option,'permeability critical porosity', &
564) 'MATERIAL_PROPERTY')
565) case('PERMEABILITY_MIN_SCALE_FACTOR')
566) call InputReadDouble(input,option, &
567) material_property%permeability_min_scale_fac)
568) call InputErrorMsg(input,option,'permeability min scale factor', &
569) 'MATERIAL_PROPERTY')
570) case('TORTUOSITY_POWER')
571) call InputReadDouble(input,option, &
572) material_property%tortuosity_pwr)
573) call InputErrorMsg(input,option,'tortuosity power','MATERIAL_PROPERTY')
574) case('MINERAL_SURFACE_AREA_POWER')
575) option%io_buffer = 'Adjustment of mineral surface area based on ' // &
576) 'mineral volume fraction or porosity must be performed on a ' // &
577) 'per mineral basis under the MINERAL_KINETICS card. See ' // &
578) 'reaction_aux.F90.'
579) call printErrMsg(option)
580) case('SECONDARY_CONTINUUM')
581) do
582) call InputReadPflotranString(input,option)
583) call InputReadStringErrorMsg(input,option, &
584) 'MATERIAL_PROPERTY,SECONDARY_CONTINUUM')
585)
586) if (InputCheckExit(input,option)) exit
587)
588) if (InputError(input)) exit
589) call InputReadWord(input,option,word,PETSC_TRUE)
590) call InputErrorMsg(input,option,'keyword', &
591) 'MATERIAL_PROPERTY,SECONDARY_CONTINUUM')
592) select case(trim(word))
593) case('TYPE')
594) call InputReadNChars(input,option, &
595) material_property%secondary_continuum_name,&
596) MAXWORDLENGTH,PETSC_TRUE)
597) call InputErrorMsg(input,option,'type', &
598) 'MATERIAL_PROPERTY, SECONDARY_CONTINUUM')
599) case('MATRIX_BLOCK_SIZE')
600) call InputReadDouble(input,option, &
601) material_property%secondary_continuum_matrix_block_size)
602) call InputErrorMsg(input,option,'matrix_block_size', &
603) 'MATERIAL_PROPERTY, SECONDARY_CONTINUUM')
604) case('FRACTURE_SPACING')
605) call InputReadDouble(input,option, &
606) material_property%secondary_continuum_fracture_spacing)
607) call InputErrorMsg(input,option,'fracture_spacing', &
608) 'MATERIAL_PROPERTY, SECONDARY_CONTINUUM')
609) case('RADIUS')
610) call InputReadDouble(input,option, &
611) material_property%secondary_continuum_radius)
612) call InputErrorMsg(input,option,'radius', &
613) 'MATERIAL_PROPERTY, SECONDARY_CONTINUUM')
614) case('LENGTH')
615) call InputReadDouble(input,option, &
616) material_property%secondary_continuum_length)
617) call InputErrorMsg(input,option,'length', &
618) 'MATERIAL_PROPERTY, SECONDARY_CONTINUUM')
619) case('AREA')
620) call InputReadDouble(input,option, &
621) material_property%secondary_continuum_area)
622) call InputErrorMsg(input,option,'area', &
623) 'MATERIAL_PROPERTY, SECONDARY_CONTINUUM')
624) case('NUM_CELLS')
625) call InputReadInt(input,option, &
626) material_property%secondary_continuum_ncells)
627) call InputErrorMsg(input,option,'number of cells', &
628) 'MATERIAL_PROPERTY, SECONDARY_CONTINUUM')
629) case('EPSILON')
630) call InputReadDouble(input,option, &
631) material_property%secondary_continuum_epsilon)
632) call InputErrorMsg(input,option,'epsilon', &
633) 'MATERIAL_PROPERTY')
634) case('APERTURE')
635) call InputReadDouble(input,option, &
636) material_property%secondary_continuum_aperture)
637) call InputErrorMsg(input,option,'aperture', &
638) 'MATERIAL_PROPERTY')
639) case('TEMPERATURE')
640) call InputReadDouble(input,option, &
641) material_property%secondary_continuum_init_temp)
642) call InputErrorMsg(input,option,'secondary continuum init temp', &
643) 'MATERIAL_PROPERTY')
644) option%set_secondary_init_temp = PETSC_TRUE
645) case('CONCENTRATION')
646) call InputReadDouble(input,option, &
647) material_property%secondary_continuum_init_conc)
648) call InputErrorMsg(input,option,'secondary continuum init conc', &
649) 'MATERIAL_PROPERTY')
650) option%set_secondary_init_conc = PETSC_TRUE
651) case('POROSITY')
652) call InputReadDouble(input,option, &
653) material_property%secondary_continuum_porosity)
654) call InputErrorMsg(input,option,'secondary continuum porosity', &
655) 'MATERIAL_PROPERTY')
656) case('DIFFUSION_COEFFICIENT')
657) call InputReadDouble(input,option, &
658) material_property%secondary_continuum_diff_coeff)
659) call InputErrorMsg(input,option, &
660) 'secondary continuum diff coeff', &
661) 'MATERIAL_PROPERTY')
662) case('MINERAL_VOLFRAC')
663) call InputReadDouble(input,option, &
664) material_property%secondary_continuum_mnrl_volfrac)
665) call InputErrorMsg(input,option,'secondary cont. mnrl volfrac.', &
666) 'MATERIAL_PROPERTY')
667) case('MINERAL_AREA')
668) call InputReadDouble(input,option, &
669) material_property%secondary_continuum_mnrl_area)
670) call InputErrorMsg(input,option,'secondary cont. mnrl area', &
671) 'MATERIAL_PROPERTY')
672) case('LOG_GRID_SPACING')
673) material_property%secondary_continuum_log_spacing = PETSC_TRUE
674) case('OUTER_SPACING')
675) call InputReadDouble(input,option, &
676) material_property%secondary_continuum_outer_spacing)
677) call InputErrorMsg(input,option,'secondary cont. outer spacing', &
678) 'MATERIAL_PROPERTY')
679) case('AREA_SCALING_FACTOR')
680) call InputReadDouble(input,option, &
681) material_property%secondary_continuum_area_scaling)
682) call InputErrorMsg(input,option,'secondary area scaling factor', &
683) 'MATERIAL_PROPERTY')
684) case default
685) call InputKeywordUnrecognized(word, &
686) 'MATERIAL_PROPERTY,SECONDARY_CONTINUUM',option)
687) end select
688) enddo
689)
690) case default
691) call InputKeywordUnrecognized(keyword,'MATERIAL_PROPERTY',option)
692) end select
693) enddo
694)
695) if (associated(material_property%permeability_dataset) .and. &
696) .not.material_property%isotropic_permeability .and. &
697) Uninitialized(material_property%vertical_anisotropy_ratio)) then
698) material_property%permeability_dataset_y => DatasetBaseCreate()
699) material_property%permeability_dataset_z => DatasetBaseCreate()
700) material_property%permeability_dataset_y%name = &
701) trim(material_property%permeability_dataset%name) // 'Y'
702) material_property%permeability_dataset_z%name = &
703) trim(material_property%permeability_dataset%name) // 'Z'
704) material_property%permeability_dataset%name = &
705) trim(material_property%permeability_dataset%name) // 'X'
706) endif
707)
708) if (option%iflowmode == TH_MODE) then
709) if (option%use_th_freezing .eqv. PETSC_TRUE) then
710) if (.not. therm_k_frz) then
711) option%io_buffer = 'THERMAL_CONDUCTIVITY_FROZEN must be set &
712) &in inputdeck for MODE TH(C) ICE'
713) call printErrMsg(option)
714) endif
715) if (.not. therm_k_exp_frz) then
716) option%io_buffer = 'THERMAL_COND_EXPONENT_FROZEN must be set &
717) &in inputdeck for MODE TH(C) ICE'
718) call printErrMsg(option)
719) endif
720) endif
721) endif
722)
723) if (len_trim(material_property%soil_compressibility_function) > 0) then
724) option%flow%transient_porosity = PETSC_TRUE
725) if (Uninitialized(material_property%soil_compressibility) .and. &
726) .not.associated(material_property%compressibility_dataset)) then
727) option%io_buffer = 'SOIL_COMPRESSIBILITY_FUNCTION is specified in &
728) &inputdeck for MATERIAL_PROPERTY "' // &
729) trim(material_property%name) // &
730) '", but SOIL_COMPRESSIBILITY is not defined.'
731) call printErrMsg(option)
732) endif
733) if (Uninitialized(material_property%soil_reference_pressure) .and. &
734) .not.material_property%soil_reference_pressure_initial) then
735) option%io_buffer = 'SOIL_COMPRESSIBILITY_FUNCTION is specified in &
736) &inputdeck for MATERIAL_PROPERTY "' // &
737) trim(material_property%name) // &
738) '", but a SOIL_REFERENCE_PRESSURE is not defined.'
739) call printErrMsg(option)
740) endif
741) if (Initialized(material_property%soil_reference_pressure) .and. &
742) material_property%soil_reference_pressure_initial) then
743) option%io_buffer = 'SOIL_REFERENCE_PRESSURE may not be defined by the &
744) &initial pressure and a specified pressure in material "' // &
745) trim(material_property%name) // '".'
746) call printErrMsg(option)
747) endif
748) endif
749)
750) ! material id must be > 0
751) if (material_property%external_id <= 0) then
752) write(word,*) material_property%external_id
753) option%io_buffer = 'Material ID in MATERIAL_PROPERTY "' // &
754) trim(material_property%name) // '" must be > 0 (' // &
755) trim(adjustl(word)) // '). If you would like to inactivate a &
756) &material, please do so by adding INACTIVE to the STRATA to which &
757) &the MATERIAL_PROPERTY is coupled.'
758) call printErrMsg(option)
759) endif
760)
761) end subroutine MaterialPropertyRead
762)
763) ! ************************************************************************** !
764)
765) subroutine MaterialPropertyAddToList(material_property,list)
766) !
767) ! Adds a material property to linked list
768) !
769) ! Author: Glenn Hammond
770) ! Date: 11/02/07
771) !
772)
773) implicit none
774)
775) type(material_property_type), pointer :: material_property
776) type(material_property_type), pointer :: list
777)
778) type(material_property_type), pointer :: cur_material_property
779)
780) if (associated(list)) then
781) cur_material_property => list
782) ! loop to end of list
783) do
784) if (.not.associated(cur_material_property%next)) exit
785) cur_material_property => cur_material_property%next
786) enddo
787) cur_material_property%next => material_property
788) material_property%internal_id = iabs(cur_material_property%internal_id) + 1
789) else
790) list => material_property
791) material_property%internal_id = 1
792) endif
793) if (.not.material_property%active) then
794) material_property%internal_id = -1*material_property%internal_id
795) endif
796)
797) end subroutine MaterialPropertyAddToList
798)
799) ! ************************************************************************** !
800)
801) subroutine MaterialPropConvertListToArray(list,array,option)
802) !
803) ! Creates an array of pointers to the
804) ! material_properties in the list
805) !
806) ! Author: Glenn Hammond
807) ! Date: 12/18/07
808) !
809)
810) use Option_module
811) use String_module
812)
813) implicit none
814)
815) type(material_property_type), pointer :: list
816) type(material_property_ptr_type), pointer :: array(:)
817) type(option_type) :: option
818)
819) type(material_property_type), pointer :: cur_material_property
820) type(material_property_type), pointer :: prev_material_property
821) type(material_property_type), pointer :: next_material_property
822) PetscInt :: i, j, length1,length2, max_internal_id, max_external_id
823) PetscInt, allocatable :: id_count(:)
824) PetscBool :: error_flag
825) character(len=MAXSTRINGLENGTH) :: string
826)
827) #if 0
828) ! don't necessary need right now, but maybe in future
829) ! reorder into ascending order
830) swapped = PETSC_FALSE
831) do
832) if (.not.swapped) exit
833) cur_material_property => list
834) do
835) if (.not.associated(cur_material_property)) exit
836) next_material_property => cur_material_property%next
837) if (associated(next_material_property)) then
838) if (cur_material_property%id > next_material_property%id) then
839) ! swap
840) if (associated(prev_material_property)) then
841) prev_material_property%next => next_material_property
842) else
843) list => next_material_property
844) endif
845) cur_material_property%next => next_material_property%next
846) next_material_property%next => cur_material_property
847) swapped = PETSC_TRUE
848) endif
849) endif
850) prev_material_property => cur_material_property
851) cur_material_property => next_material_property
852) enddo
853) enddo
854) #endif
855)
856) ! check to ensure that max internal id is equal to the number of
857) ! material properties and that internal ids are contiguous
858) max_internal_id = 0
859) max_external_id = 0
860) cur_material_property => list
861) do
862) if (.not.associated(cur_material_property)) exit
863) max_internal_id = max_internal_id + 1
864) max_external_id = max(max_external_id,cur_material_property%external_id)
865) if (max_internal_id /= iabs(cur_material_property%internal_id)) then
866) write(string,*) cur_material_property%external_id
867) option%io_buffer = 'Non-contiguous internal material id for ' // &
868) 'material named "' // trim(cur_material_property%name) // &
869) '" with external id "' // trim(adjustl(string)) // '" '
870) write(string,*) cur_material_property%internal_id
871) option%io_buffer = trim(option%io_buffer) // &
872) 'and internal id "' // trim(adjustl(string)) // '".'
873) call printErrMsg(option)
874) endif
875) cur_material_property => cur_material_property%next
876) enddo
877)
878) if (associated(array)) deallocate(array)
879) allocate(array(max_internal_id))
880) do i = 1, max_internal_id
881) nullify(array(i)%ptr)
882) enddo
883)
884) ! use id_count to ensure that an id is not duplicated
885) allocate(id_count(max_external_id))
886) id_count = 0
887)
888) cur_material_property => list
889) do
890) if (.not.associated(cur_material_property)) exit
891) id_count(cur_material_property%external_id) = &
892) id_count(cur_material_property%external_id) + 1
893) array(iabs(cur_material_property%internal_id))%ptr => cur_material_property
894) cur_material_property => cur_material_property%next
895) enddo
896)
897) ! check to ensure that an id is not duplicated
898) error_flag = PETSC_FALSE
899) do i = 1, max_external_id
900) if (id_count(i) > 1) then
901) write(string,*) i
902) option%io_buffer = 'Material ID ' // trim(adjustl(string)) // &
903) ' is duplicated in input file.'
904) call printMsg(option)
905) error_flag = PETSC_TRUE
906) endif
907) enddo
908)
909) deallocate(id_count)
910)
911) if (error_flag) then
912) option%io_buffer = 'Duplicate Material IDs.'
913) call printErrMsg(option)
914) endif
915)
916) ! ensure unique material names
917) error_flag = PETSC_FALSE
918) do i = 1, size(array)
919) if (associated(array(i)%ptr)) then
920) length1 = len_trim(array(i)%ptr%name)
921) do j = 1, i-1
922) if (associated(array(j)%ptr)) then
923) length2 = len_trim(array(j)%ptr%name)
924) if (length1 /= length2) cycle
925) if (StringCompare(array(i)%ptr%name,array(j)%ptr%name,length1)) then
926) option%io_buffer = 'Material name "' // &
927) trim(adjustl(array(i)%ptr%name)) // &
928) '" is duplicated in input file.'
929) call printMsg(option)
930) error_flag = PETSC_TRUE
931) endif
932) endif
933) enddo
934) endif
935) enddo
936)
937) if (error_flag) then
938) option%io_buffer = 'Duplicate Material names.'
939) call printErrMsg(option)
940) endif
941)
942) end subroutine MaterialPropConvertListToArray
943)
944) ! ************************************************************************** !
945)
946) function MaterialGetMaxExternalID(material_property_array)
947) !
948) ! Maps internal material ids to external for I/O, etc.
949) !
950) ! Author: Glenn Hammond
951) ! Date: 08/05/14
952) !
953) implicit none
954)
955) type(material_property_ptr_type) :: material_property_array(:)
956)
957) PetscInt :: MaterialGetMaxExternalID
958)
959) PetscInt :: i
960)
961) MaterialGetMaxExternalID = UNINITIALIZED_INTEGER
962) do i = 1, size(material_property_array)
963) MaterialGetMaxExternalID = max(MaterialGetMaxExternalID, &
964) (material_property_array(i)%ptr%external_id))
965) enddo
966)
967) end function MaterialGetMaxExternalID
968)
969) ! ************************************************************************** !
970)
971) subroutine MaterialCreateIntToExtMapping(material_property_array,mapping)
972) !
973) ! Maps internal material ids to external for I/O, etc.
974) !
975) ! Author: Glenn Hammond
976) ! Date: 08/05/14
977) !
978) implicit none
979)
980) type(material_property_ptr_type) :: material_property_array(:)
981) PetscInt, pointer :: mapping(:)
982)
983) PetscInt :: i
984)
985) allocate(mapping(0:size(material_property_array)))
986) mapping = UNINITIALIZED_INTEGER
987) mapping(0) = 0
988)
989) do i = 1, size(material_property_array)
990) mapping(iabs(material_property_array(i)%ptr%internal_id)) = &
991) material_property_array(i)%ptr%external_id
992) enddo
993)
994) end subroutine MaterialCreateIntToExtMapping
995)
996) ! ************************************************************************** !
997)
998) subroutine MaterialCreateExtToIntMapping(material_property_array,mapping)
999) !
1000) ! Maps external material ids to internal for setup. This array should be
1001) ! temporary and never stored for the duration of the simulation.
1002) !
1003) ! Author: Glenn Hammond
1004) ! Date: 08/05/14
1005) !
1006) implicit none
1007)
1008) type(material_property_ptr_type) :: material_property_array(:)
1009) PetscInt, pointer :: mapping(:)
1010)
1011) PetscInt :: i
1012)
1013) allocate(mapping(0:MaterialGetMaxExternalID(material_property_array)))
1014) mapping = -888
1015) mapping(0) = 0
1016)
1017) do i = 1, size(material_property_array)
1018) mapping(material_property_array(i)%ptr%external_id) = &
1019) material_property_array(i)%ptr%internal_id
1020) enddo
1021)
1022) end subroutine MaterialCreateExtToIntMapping
1023)
1024) ! ************************************************************************** !
1025)
1026) subroutine MaterialApplyMapping(mapping,array)
1027) !
1028) ! Maps internal material ids to external for I/O, etc.
1029) !
1030) ! Author: Glenn Hammond
1031) ! Date: 08/05/14
1032) !
1033) implicit none
1034)
1035) PetscInt :: mapping(0:)
1036) PetscInt :: array(:)
1037)
1038) PetscInt :: i
1039) PetscInt :: mapping_size
1040) PetscInt :: mapped_id
1041)
1042) mapping_size = size(mapping)-1 ! subtract 1 for 0 index
1043) do i = 1, size(array)
1044) if (array(i) <= mapping_size) then
1045) mapped_id = mapping(array(i))
1046) else
1047) mapped_id = -888 ! indicates corresponding mapped value does not exist.
1048) endif
1049) array(i) = mapped_id
1050) enddo
1051)
1052) end subroutine MaterialApplyMapping
1053)
1054) ! ************************************************************************** !
1055)
1056) subroutine MaterialSetup(material_parameter, material_property_array, &
1057) characteristic_curves_array, option)
1058) !
1059) ! Creates arrays for material parameter object
1060) !
1061) ! Author: Glenn Hammond
1062) ! Date: 02/05/14
1063) !
1064) use Option_module
1065) use Characteristic_Curves_module
1066)
1067) implicit none
1068)
1069) type(material_parameter_type) :: material_parameter
1070) type(material_property_ptr_type) :: material_property_array(:)
1071) type(characteristic_curves_ptr_type) :: characteristic_curves_array(:)
1072) type(option_type), pointer :: option
1073)
1074) PetscInt :: num_characteristic_curves
1075) PetscInt :: num_mat_prop
1076) PetscInt :: i
1077)
1078) num_mat_prop = size(material_property_array)
1079) num_characteristic_curves = size(characteristic_curves_array)
1080)
1081) allocate(material_parameter%soil_residual_saturation(option%nphase, &
1082) num_characteristic_curves))
1083) material_parameter%soil_residual_saturation = UNINITIALIZED_DOUBLE
1084) do i = 1, num_characteristic_curves
1085) if (associated(characteristic_curves_array(i)%ptr)) then
1086) material_parameter%soil_residual_saturation(:,i) = &
1087) CharCurvesGetGetResidualSats(characteristic_curves_array(i)%ptr,option)
1088) endif
1089) enddo
1090)
1091) if (option%iflowmode /= RICHARDS_MODE) then
1092) allocate(material_parameter%soil_heat_capacity(num_mat_prop))
1093) allocate(material_parameter%soil_thermal_conductivity(2,num_mat_prop))
1094) material_parameter%soil_heat_capacity = UNINITIALIZED_DOUBLE
1095) material_parameter%soil_thermal_conductivity = UNINITIALIZED_DOUBLE
1096) do i = 1, num_mat_prop
1097) if (associated(material_property_array(i)%ptr)) then
1098) ! kg rock/m^3 rock * J/kg rock-K * 1.e-6 MJ/J
1099) material_parameter%soil_heat_capacity(i) = &
1100) material_property_array(i)%ptr%specific_heat * option%scale ! J -> MJ
1101) material_parameter%soil_thermal_conductivity(1,i) = &
1102) material_property_array(i)%ptr%thermal_conductivity_dry
1103) material_parameter%soil_thermal_conductivity(2,i) = &
1104) material_property_array(i)%ptr%thermal_conductivity_wet
1105) endif
1106) enddo
1107) endif
1108)
1109) end subroutine MaterialSetup
1110)
1111) ! ************************************************************************** !
1112)
1113) function MaterialPropGetPtrFromList(material_property_name, &
1114) material_property_list)
1115) !
1116) ! Returns a pointer to the material property
1117) ! matching material_name
1118) !
1119) ! Author: Glenn Hammond
1120) ! Date: 11/02/07
1121) !
1122)
1123) use String_module
1124)
1125) implicit none
1126)
1127) type(material_property_type), pointer :: MaterialPropGetPtrFromList
1128) character(len=MAXWORDLENGTH) :: material_property_name
1129) type(material_property_type), pointer :: material_property_list
1130) PetscInt :: length
1131) type(material_property_type), pointer :: material_property
1132)
1133) nullify(MaterialPropGetPtrFromList)
1134) material_property => material_property_list
1135)
1136) do
1137) if (.not.associated(material_property)) exit
1138) length = len_trim(material_property_name)
1139) if (length == len_trim(material_property%name) .and. &
1140) StringCompare(material_property%name,material_property_name,length)) then
1141) MaterialPropGetPtrFromList => material_property
1142) return
1143) endif
1144) material_property => material_property%next
1145) enddo
1146)
1147) end function MaterialPropGetPtrFromList
1148)
1149) ! ************************************************************************** !
1150)
1151) function MaterialPropGetPtrFromArray(material_property_name, &
1152) material_property_array)
1153) !
1154) ! Returns a pointer to the material property
1155) ! matching material_name
1156) !
1157) ! Author: Glenn Hammond
1158) ! Date: 11/02/07
1159) !
1160)
1161) use String_module
1162)
1163) implicit none
1164)
1165) type(material_property_type), pointer :: MaterialPropGetPtrFromArray
1166) character(len=MAXWORDLENGTH) :: material_property_name
1167) type(material_property_ptr_type), pointer :: material_property_array(:)
1168) PetscInt :: length
1169) PetscInt :: imaterial_property
1170)
1171) nullify(MaterialPropGetPtrFromArray)
1172)
1173) do imaterial_property = 1, size(material_property_array)
1174) length = len_trim(material_property_name)
1175) if (.not.associated(material_property_array(imaterial_property)%ptr)) cycle
1176) if (length == &
1177) len_trim(material_property_array(imaterial_property)%ptr%name) .and. &
1178) StringCompare(material_property_array(imaterial_property)%ptr%name, &
1179) material_property_name,length)) then
1180) MaterialPropGetPtrFromArray => &
1181) material_property_array(imaterial_property)%ptr
1182) return
1183) endif
1184) enddo
1185)
1186) end function MaterialPropGetPtrFromArray
1187)
1188) ! ************************************************************************** !
1189)
1190) function MaterialAnisotropyExists(material_property_list)
1191) !
1192) ! Determines whether any of the material
1193) ! properties are anisotropic
1194) !
1195) ! Author: Glenn Hammond
1196) ! Date: 07/11/13
1197) !
1198)
1199) implicit none
1200)
1201) type(material_property_type), pointer :: material_property_list
1202)
1203) PetscBool :: MaterialAnisotropyExists
1204)
1205) type(material_property_type), pointer :: cur_material_property
1206)
1207) MaterialAnisotropyExists = PETSC_FALSE
1208)
1209) cur_material_property => material_property_list
1210) do
1211) if (.not.associated(cur_material_property)) exit
1212) if (.not. cur_material_property%isotropic_permeability) then
1213) MaterialAnisotropyExists = PETSC_TRUE
1214) return
1215) endif
1216) cur_material_property => cur_material_property%next
1217) enddo
1218)
1219) end function MaterialAnisotropyExists
1220)
1221)
1222) ! ************************************************************************** !
1223)
1224) subroutine MaterialInitAuxIndices(material_property_ptrs,option)
1225) !
1226) ! Initializes the pointer used to index material property arrays
1227) !
1228) ! Author: Glenn Hammond
1229) ! Date: 01/09/14
1230) !
1231) use Material_Aux_class
1232) use String_module
1233) use Option_module
1234)
1235) implicit none
1236)
1237) type(material_property_ptr_type), pointer :: material_property_ptrs(:)
1238) type(option_type) :: option
1239)
1240) PetscInt :: i
1241) PetscInt :: icount = 0
1242) PetscInt :: num_soil_compress_func = 0
1243) PetscInt :: num_soil_compress = 0
1244) PetscInt :: num_soil_ref_press = 0
1245) PetscInt :: num_material_properties
1246)
1247) procedure(MaterialCompressSoilDummy), pointer :: &
1248) MaterialCompressSoilPtrTmp
1249)
1250) ! soil_thermal_conductivity_index = 0
1251) ! soil_heat_capacity_index = 0
1252) soil_compressibility_index = 0
1253) soil_reference_pressure_index = 0
1254) max_material_index = 0
1255)
1256) num_material_properties = size(material_property_ptrs)
1257) ! must be nullified here to avoid an error message on subsequent calls
1258) ! on stochastic simulations
1259) MaterialCompressSoilPtr => null()
1260)
1261) do i = 1, num_material_properties
1262) MaterialCompressSoilPtrTmp => null()
1263) if (len_trim(material_property_ptrs(i)%ptr% &
1264) soil_compressibility_function) > 1) then
1265) call StringToUpper(material_property_ptrs(i)%ptr% &
1266) soil_compressibility_function)
1267) select case(material_property_ptrs(i)%ptr%soil_compressibility_function)
1268) case('BRAGFLO','WIPP')
1269) MaterialCompressSoilPtrTmp => MaterialCompressSoilBRAGFLO
1270) case('LEIJNSE','DEFAULT')
1271) MaterialCompressSoilPtrTmp => MaterialCompressSoilLeijnse
1272) case default
1273) option%io_buffer = 'Soil compressibility function "' // &
1274) trim(material_property_ptrs(i)%ptr% &
1275) soil_compressibility_function) // &
1276) '" not recognized.'
1277) call printErrMsg(option)
1278) end select
1279) num_soil_compress_func = num_soil_compress_func + 1
1280) endif
1281) if (.not.associated(MaterialCompressSoilPtr)) then
1282) MaterialCompressSoilPtr => MaterialCompressSoilPtrTmp
1283) else if (.not.associated(MaterialCompressSoilPtr, &
1284) MaterialCompressSoilPtrTmp)) then
1285) option%io_buffer = 'All MATERIAL_PROPERTIES must specify the ' // &
1286) 'same soil compressibility function.'
1287) call printErrMsg(option)
1288) endif
1289) if (Initialized(material_property_ptrs(i)%ptr%soil_compressibility) .or. &
1290) associated(material_property_ptrs(i)%ptr%compressibility_dataset)) then
1291) if (soil_compressibility_index == 0) then
1292) icount = icount + 1
1293) soil_compressibility_index = icount
1294) endif
1295) num_soil_compress = num_soil_compress + 1
1296) endif
1297) if (Initialized(material_property_ptrs(i)%ptr%&
1298) soil_reference_pressure) .or. &
1299) material_property_ptrs(i)%ptr%soil_reference_pressure_initial) then
1300) if (soil_reference_pressure_index == 0) then
1301) icount = icount + 1
1302) soil_reference_pressure_index = icount
1303) endif
1304) num_soil_ref_press = num_soil_ref_press + 1
1305) endif
1306) ! if (material_property_ptrs(i)%ptr%specific_heat > 0.d0 .and. &
1307) ! soil_heat_capacity_index == 0) then
1308) ! icount = icount + 1
1309) ! soil_heat_capacity_index = icount
1310) ! endif
1311) ! if (material_property_ptrs(i)%ptr%thermal_conductivity_wet > 0.d0 .and. &
1312) ! soil_thermal_conductivity_index == 0) then
1313) ! icount = icount + 1
1314) ! soil_thermal_conductivity_index = icount
1315) ! endif
1316) enddo
1317) max_material_index = icount
1318)
1319) if (.not.associated(MaterialCompressSoilPtr)) then
1320) MaterialCompressSoilPtr => MaterialCompressSoilLeijnse
1321) endif
1322)
1323) ! check of uninitialized values
1324) if (num_soil_compress_func > 0 .and. &
1325) num_soil_compress_func /= num_material_properties) then
1326) option%io_buffer = 'SOIL_COMPRESSIBILITY_FUNCTION must be defined for all &
1327) &materials.'
1328) call printErrMsg(option)
1329) endif
1330) if (soil_compressibility_index > 0 .and. &
1331) num_soil_compress /= num_material_properties) then
1332) option%io_buffer = 'SOIL_COMPRESSIBILITY must be defined for all &
1333) &materials.'
1334) call printErrMsg(option)
1335) endif
1336) if (soil_reference_pressure_index > 0 .and. &
1337) num_soil_ref_press /= num_material_properties) then
1338) option%io_buffer = 'SOIL_REFERENCE_PRESSURE must be defined for all &
1339) &materials.'
1340) call printErrMsg(option)
1341) endif
1342) if (soil_compressibility_index > 0 .and. &
1343) soil_reference_pressure_index == 0) then
1344) option%io_buffer = 'SOIL_REFERENCE_PRESSURE must be defined to model &
1345) &soil compressibility.'
1346) call printErrMsg(option)
1347) endif
1348)
1349) end subroutine MaterialInitAuxIndices
1350)
1351) ! ************************************************************************** !
1352)
1353) subroutine MaterialAssignPropertyToAux(material_auxvar,material_property, &
1354) option)
1355) !
1356) ! Initializes the pointer used to index material property arrays
1357) !
1358) ! Author: Glenn Hammond
1359) ! Date: 01/09/14
1360) !
1361) use Material_Aux_class
1362) use Option_module
1363) use Fracture_module
1364)
1365) implicit none
1366)
1367) class(material_auxvar_type) :: material_auxvar
1368) type(material_property_type) :: material_property
1369) type(option_type) :: option
1370)
1371) if (Initialized(material_property%rock_density)) then
1372) material_auxvar%soil_particle_density = &
1373) material_property%rock_density
1374) endif
1375)
1376) if (associated(material_property%fracture)) then
1377) call FracturePropertytoAux(material_auxvar, material_property%fracture)
1378) endif
1379)
1380) if (soil_compressibility_index > 0) then
1381) material_auxvar%soil_properties(soil_compressibility_index) = &
1382) material_property%soil_compressibility
1383) endif
1384) if (soil_reference_pressure_index > 0) then
1385) ! soil reference pressure may be assigned as the initial cell pressure, and
1386) ! in that case, it will be assigned elsewhere
1387) if (Initialized(material_property%soil_reference_pressure)) then
1388) material_auxvar%soil_properties(soil_reference_pressure_index) = &
1389) material_property%soil_reference_pressure
1390) endif
1391) endif
1392) ! if (soil_heat_capacity_index > 0) then
1393) ! material_auxvar%soil_properties(soil_heat_capacity_index) = &
1394) ! material_property%specific_heat
1395) ! endif
1396) ! if (soil_thermal_conductivity_index > 0) then
1397) ! material_auxvar%soil_properties(soil_thermal_conductivity_index) = &
1398) ! material_property%thermal_conductivity_wet
1399) ! endif
1400)
1401) end subroutine MaterialAssignPropertyToAux
1402)
1403) ! ************************************************************************** !
1404)
1405) subroutine MaterialSetAuxVarScalar(Material,value,ivar)
1406) !
1407) ! Sets values of a material auxvar data using a scalar value.
1408) !
1409) ! Author: Glenn Hammond
1410) ! Date: 01/09/14
1411) !
1412)
1413) use Variables_module
1414)
1415) implicit none
1416)
1417) type(material_type) :: Material ! from realization%patch%aux%Material
1418) PetscReal :: value
1419) PetscInt :: ivar
1420)
1421) PetscInt :: i
1422) class(material_auxvar_type), pointer :: material_auxvars(:)
1423)
1424) ! material_auxvars => Material%auxvars
1425) !geh: can't use this pointer as gfortran does not like it. Must use
1426) ! Material%auxvars%....
1427)
1428) select case(ivar)
1429) case(VOLUME)
1430) do i=1, Material%num_aux
1431) Material%auxvars(i)%volume = value
1432) enddo
1433) case(POROSITY)
1434) do i=1, Material%num_aux
1435) Material%auxvars(i)%porosity = value
1436) enddo
1437) case(TORTUOSITY)
1438) do i=1, Material%num_aux
1439) Material%auxvars(i)%tortuosity = value
1440) enddo
1441) case(PERMEABILITY_X)
1442) do i=1, Material%num_aux
1443) Material%auxvars(i)%permeability(perm_xx_index) = value
1444) enddo
1445) case(PERMEABILITY_Y)
1446) do i=1, Material%num_aux
1447) Material%auxvars(i)%permeability(perm_yy_index) = value
1448) enddo
1449) case(PERMEABILITY_Z)
1450) do i=1, Material%num_aux
1451) Material%auxvars(i)%permeability(perm_zz_index) = value
1452) enddo
1453) case(PERMEABILITY_XY)
1454) do i=1, Material%num_aux
1455) Material%auxvars(i)%permeability(perm_xy_index) = value
1456) enddo
1457) case(PERMEABILITY_YZ)
1458) do i=1, Material%num_aux
1459) Material%auxvars(i)%permeability(perm_yz_index) = value
1460) enddo
1461) case(PERMEABILITY_XZ)
1462) do i=1, Material%num_aux
1463) Material%auxvars(i)%permeability(perm_xz_index) = value
1464) enddo
1465) end select
1466)
1467) end subroutine MaterialSetAuxVarScalar
1468)
1469) ! ************************************************************************** !
1470)
1471) subroutine MaterialSetAuxVarVecLoc(Material,vec_loc,ivar,isubvar)
1472) !
1473) ! Sets values of material auxvar data using a vector.
1474) !
1475) ! Author: Glenn Hammond
1476) ! Date: 01/09/14
1477) !
1478)
1479) use Variables_module
1480)
1481) implicit none
1482)
1483) #include "petsc/finclude/petscvec.h"
1484) #include "petsc/finclude/petscvec.h90"
1485)
1486) type(material_type) :: Material ! from realization%patch%aux%Material
1487) Vec :: vec_loc
1488) PetscInt :: ivar
1489) PetscInt :: isubvar
1490)
1491) PetscInt :: ghosted_id
1492) PetscReal, pointer :: vec_loc_p(:)
1493) class(material_auxvar_type), pointer :: material_auxvars(:)
1494) PetscErrorCode :: ierr
1495)
1496) ! material_auxvars => Material%auxvars
1497) !geh: can't use this pointer as gfortran does not like it. Must use
1498) ! Material%auxvars%....
1499) call VecGetArrayReadF90(vec_loc,vec_loc_p,ierr);CHKERRQ(ierr)
1500)
1501) select case(ivar)
1502) case(SOIL_COMPRESSIBILITY)
1503) do ghosted_id=1, Material%num_aux
1504) Material%auxvars(ghosted_id)% &
1505) soil_properties(soil_compressibility_index) = vec_loc_p(ghosted_id)
1506) enddo
1507) case(SOIL_REFERENCE_PRESSURE)
1508) do ghosted_id=1, Material%num_aux
1509) Material%auxvars(ghosted_id)% &
1510) soil_properties(soil_reference_pressure_index) = vec_loc_p(ghosted_id)
1511) enddo
1512) case(VOLUME)
1513) do ghosted_id=1, Material%num_aux
1514) Material%auxvars(ghosted_id)%volume = vec_loc_p(ghosted_id)
1515) enddo
1516) case(POROSITY)
1517) select case(isubvar)
1518) case(POROSITY_CURRENT)
1519) do ghosted_id=1, Material%num_aux
1520) Material%auxvars(ghosted_id)%porosity = vec_loc_p(ghosted_id)
1521) enddo
1522) case(POROSITY_MINERAL)
1523) do ghosted_id=1, Material%num_aux
1524) Material%auxvars(ghosted_id)%porosity_base = vec_loc_p(ghosted_id)
1525) enddo
1526) end select
1527) case(TORTUOSITY)
1528) do ghosted_id=1, Material%num_aux
1529) Material%auxvars(ghosted_id)%tortuosity = vec_loc_p(ghosted_id)
1530) enddo
1531) case(PERMEABILITY_X)
1532) do ghosted_id=1, Material%num_aux
1533) Material%auxvars(ghosted_id)%permeability(perm_xx_index) = &
1534) vec_loc_p(ghosted_id)
1535) enddo
1536) case(PERMEABILITY_Y)
1537) do ghosted_id=1, Material%num_aux
1538) Material%auxvars(ghosted_id)%permeability(perm_yy_index) = &
1539) vec_loc_p(ghosted_id)
1540) enddo
1541) case(PERMEABILITY_Z)
1542) do ghosted_id=1, Material%num_aux
1543) Material%auxvars(ghosted_id)%permeability(perm_zz_index) = &
1544) vec_loc_p(ghosted_id)
1545) enddo
1546) case(PERMEABILITY_XY)
1547) do ghosted_id=1, Material%num_aux
1548) Material%auxvars(ghosted_id)%permeability(perm_xy_index) = &
1549) vec_loc_p(ghosted_id)
1550) enddo
1551) case(PERMEABILITY_YZ)
1552) do ghosted_id=1, Material%num_aux
1553) Material%auxvars(ghosted_id)%permeability(perm_yz_index) = &
1554) vec_loc_p(ghosted_id)
1555) enddo
1556) case(PERMEABILITY_XZ)
1557) do ghosted_id=1, Material%num_aux
1558) Material%auxvars(ghosted_id)%permeability(perm_xz_index) = &
1559) vec_loc_p(ghosted_id)
1560) enddo
1561) end select
1562)
1563) call VecRestoreArrayReadF90(vec_loc,vec_loc_p,ierr);CHKERRQ(ierr)
1564)
1565) end subroutine MaterialSetAuxVarVecLoc
1566)
1567) ! ************************************************************************** !
1568)
1569) subroutine MaterialGetAuxVarVecLoc(Material,vec_loc,ivar,isubvar)
1570) !
1571) ! Gets values of material auxvar data using a vector.
1572) !
1573) ! Author: Glenn Hammond
1574) ! Date: 01/09/14
1575) !
1576)
1577) use Variables_module
1578)
1579) implicit none
1580)
1581) #include "petsc/finclude/petscvec.h"
1582) #include "petsc/finclude/petscvec.h90"
1583)
1584) type(material_type) :: Material ! from realization%patch%aux%Material
1585) Vec :: vec_loc
1586) PetscInt :: ivar
1587) PetscInt :: isubvar
1588)
1589) PetscInt :: ghosted_id
1590) PetscReal, pointer :: vec_loc_p(:)
1591) class(material_auxvar_type), pointer :: material_auxvars(:)
1592) PetscErrorCode :: ierr
1593)
1594) ! material_auxvars => Material%auxvars
1595) !geh: can't use this pointer as gfortran does not like it. Must use
1596) ! Material%auxvars%....
1597) call VecGetArrayReadF90(vec_loc,vec_loc_p,ierr);CHKERRQ(ierr)
1598)
1599) select case(ivar)
1600) case(SOIL_COMPRESSIBILITY)
1601) if (soil_compressibility_index > 0) then
1602) do ghosted_id=1, Material%num_aux
1603) vec_loc_p(ghosted_id) = Material%auxvars(ghosted_id)% &
1604) soil_properties(soil_compressibility_index)
1605) enddo
1606) else
1607) vec_loc_p(:) = UNINITIALIZED_DOUBLE
1608) endif
1609) case(SOIL_REFERENCE_PRESSURE)
1610) if (soil_reference_pressure_index > 0) then
1611) do ghosted_id=1, Material%num_aux
1612) vec_loc_p(ghosted_id) = Material%auxvars(ghosted_id)% &
1613) soil_properties(soil_reference_pressure_index)
1614) enddo
1615) else
1616) vec_loc_p(:) = UNINITIALIZED_DOUBLE
1617) endif
1618) case(VOLUME)
1619) do ghosted_id=1, Material%num_aux
1620) vec_loc_p(ghosted_id) = Material%auxvars(ghosted_id)%volume
1621) enddo
1622) case(POROSITY)
1623) select case(isubvar)
1624) case(POROSITY_CURRENT)
1625) do ghosted_id=1, Material%num_aux
1626) vec_loc_p(ghosted_id) = &
1627) Material%auxvars(ghosted_id)%porosity
1628) enddo
1629) case(POROSITY_MINERAL)
1630) do ghosted_id=1, Material%num_aux
1631) vec_loc_p(ghosted_id) = Material%auxvars(ghosted_id)%porosity_base
1632) enddo
1633) end select
1634) case(TORTUOSITY)
1635) do ghosted_id=1, Material%num_aux
1636) vec_loc_p(ghosted_id) = Material%auxvars(ghosted_id)%tortuosity
1637) enddo
1638) case(PERMEABILITY_X)
1639) do ghosted_id=1, Material%num_aux
1640) vec_loc_p(ghosted_id) = &
1641) Material%auxvars(ghosted_id)%permeability(perm_xx_index)
1642) enddo
1643) case(PERMEABILITY_Y)
1644) do ghosted_id=1, Material%num_aux
1645) vec_loc_p(ghosted_id) = &
1646) Material%auxvars(ghosted_id)%permeability(perm_yy_index)
1647) enddo
1648) case(PERMEABILITY_Z)
1649) do ghosted_id=1, Material%num_aux
1650) vec_loc_p(ghosted_id) = &
1651) Material%auxvars(ghosted_id)%permeability(perm_zz_index)
1652) enddo
1653) case(PERMEABILITY_XY)
1654) do ghosted_id=1, Material%num_aux
1655) vec_loc_p(ghosted_id) = &
1656) Material%auxvars(ghosted_id)%permeability(perm_xy_index)
1657) enddo
1658) case(PERMEABILITY_YZ)
1659) do ghosted_id=1, Material%num_aux
1660) vec_loc_p(ghosted_id) = &
1661) Material%auxvars(ghosted_id)%permeability(perm_yz_index)
1662) enddo
1663) case(PERMEABILITY_XZ)
1664) do ghosted_id=1, Material%num_aux
1665) vec_loc_p(ghosted_id) = &
1666) Material%auxvars(ghosted_id)%permeability(perm_xz_index)
1667) enddo
1668) end select
1669)
1670) call VecRestoreArrayReadF90(vec_loc,vec_loc_p,ierr);CHKERRQ(ierr)
1671)
1672) end subroutine MaterialGetAuxVarVecLoc
1673)
1674) ! ************************************************************************** !
1675)
1676) subroutine MaterialWeightAuxVars(Material,weight,field,comm1)
1677) !
1678) ! Updates the porosities in auxiliary variables associated with
1679) ! reactive transport
1680) !
1681) ! Author: Glenn Hammond
1682) ! Date: 04/17/14
1683) !
1684)
1685) use Option_module
1686) use Field_module
1687) use Communicator_Base_module
1688) use Variables_module, only : POROSITY
1689)
1690) implicit none
1691)
1692) #include "petsc/finclude/petscvec.h"
1693) #include "petsc/finclude/petscvec.h90"
1694)
1695) type(material_type) :: Material
1696) type(field_type) :: field
1697) PetscReal :: weight
1698) class(communicator_type) :: comm1
1699)
1700) PetscErrorCode :: ierr
1701)
1702) ! material_auxvars => Material%auxvars
1703) !geh: can't use this pointer as gfortran does not like it. Must use
1704) ! Material%auxvars%....
1705) call VecCopy(field%porosity_t,field%work,ierr)
1706) call VecAXPBY(field%work,weight,1.d0-weight, &
1707) field%porosity_tpdt,ierr);CHKERRQ(ierr)
1708) call comm1%GlobalToLocal(field%work,field%work_loc)
1709) call MaterialSetAuxVarVecLoc(Material,field%work_loc,POROSITY, &
1710) POROSITY_CURRENT)
1711)
1712) end subroutine MaterialWeightAuxVars
1713)
1714) ! ************************************************************************** !
1715)
1716) subroutine MaterialStoreAuxVars(Material,time)
1717) !
1718) ! Moves material properties from TIME_TpDT -> TIME_T in storage arrays
1719) !
1720) ! Author: Glenn Hammond
1721) ! Date: 10/30/14
1722) !
1723)
1724) use Option_module
1725)
1726) implicit none
1727)
1728) type(material_type) :: Material
1729) PetscReal :: time
1730)
1731) PetscInt :: ghosted_id
1732)
1733) Material%time_t = time
1734)
1735) do ghosted_id=1, Material%num_aux
1736) ! Material%auxvars(ghosted_id)%porosity_store(TIME_T) = &
1737) ! Material%auxvars(ghosted_id)%porosity_store(TIME_TpDT)
1738) enddo
1739)
1740) end subroutine MaterialStoreAuxVars
1741)
1742) ! ************************************************************************** !
1743)
1744) subroutine MaterialUpdateAuxVars(Material,comm1,vec_loc,time_level,time)
1745) !
1746) ! Updates material aux var variables for use in reactive transport
1747) !
1748) ! Author: Glenn Hammond
1749) ! Date: 01/14/09
1750) !
1751)
1752) use Option_module
1753) use Communicator_Base_module
1754) use Variables_module, only : POROSITY
1755)
1756) implicit none
1757)
1758) #include "petsc/finclude/petscvec.h"
1759) #include "petsc/finclude/petscvec.h90"
1760)
1761) type(material_type) :: Material
1762) class(communicator_type) :: comm1
1763) Vec :: vec_loc
1764) PetscReal :: time
1765) PetscInt :: time_level
1766)
1767) select case(time_level)
1768) case(TIME_T)
1769) Material%time_t = time
1770) case(TIME_TpDT)
1771) Material%time_tpdt = time
1772) end select
1773)
1774) print *, 'MaterialUpdateAuxVars not implemented.'
1775) stop
1776) ! porosity
1777) ! call MaterialGetAuxVarVecLoc(Material,vec_loc,POROSITY,ZERO_INTEGER)
1778) ! call comm1%LocalToLocal(vec_loc,vec_loc)
1779) ! note that 'time_level' is not ZERO_INTEGER. thus, this differs
1780) ! from MaterialAuxVarCommunicate.
1781) ! call MaterialSetAuxVarVecLoc(Material,vec_loc,POROSITY,time_level)
1782)
1783) end subroutine MaterialUpdateAuxVars
1784)
1785) ! ************************************************************************** !
1786)
1787) subroutine MaterialAuxVarCommunicate(comm,Material,vec_loc,ivar,isubvar)
1788) !
1789) ! Sets values of material auxvar data using a vector.
1790) !
1791) ! Author: Glenn Hammond
1792) ! Date: 01/09/14
1793) !
1794)
1795) use Communicator_Base_module
1796)
1797) implicit none
1798)
1799) #include "petsc/finclude/petscvec.h"
1800) #include "petsc/finclude/petscvec.h90"
1801)
1802) class(communicator_type), pointer :: comm
1803) type(material_type) :: Material ! from realization%patch%aux%Material
1804) Vec :: vec_loc
1805) PetscInt :: ivar
1806) PetscInt :: isubvar
1807)
1808) call MaterialGetAuxVarVecLoc(Material,vec_loc,ivar,isubvar)
1809) call comm%LocalToLocal(vec_loc,vec_loc)
1810) call MaterialSetAuxVarVecLoc(Material,vec_loc,ivar,isubvar)
1811)
1812) end subroutine MaterialAuxVarCommunicate
1813)
1814) ! ************************************************************************** !
1815)
1816) subroutine MaterialUpdatePorosity(Material,global_auxvars,porosity_loc)
1817) !
1818) ! Gets values of material auxvar data using a vector.
1819) !
1820) ! Author: Glenn Hammond
1821) ! Date: 01/09/14
1822) !
1823)
1824) use Variables_module
1825) use Global_Aux_module
1826)
1827) implicit none
1828)
1829) #include "petsc/finclude/petscvec.h"
1830) #include "petsc/finclude/petscvec.h90"
1831)
1832) type(material_type) :: Material ! from realization%patch%aux%Material
1833) type(global_auxvar_type) :: global_auxvars(:)
1834) Vec :: porosity_loc
1835)
1836) PetscReal, pointer :: porosity_loc_p(:)
1837) class(material_auxvar_type), pointer :: material_auxvars(:)
1838) PetscInt :: ghosted_id
1839) PetscReal :: compressed_porosity
1840) PetscReal :: dcompressed_porosity_dp
1841) PetscErrorCode :: ierr
1842)
1843) if (soil_compressibility_index > 0) then
1844) material_auxvars => Material%auxvars
1845) call VecGetArrayReadF90(porosity_loc,porosity_loc_p,ierr);CHKERRQ(ierr)
1846) do ghosted_id = 1, Material%num_aux
1847) material_auxvars(ghosted_id)%porosity = porosity_loc_p(ghosted_id)
1848) call MaterialCompressSoil(material_auxvars(ghosted_id), &
1849) maxval(global_auxvars(ghosted_id)%pres), &
1850) compressed_porosity,dcompressed_porosity_dp)
1851) material_auxvars(ghosted_id)%porosity = compressed_porosity
1852) material_auxvars(ghosted_id)%dporosity_dp = dcompressed_porosity_dp
1853) enddo
1854) call VecRestoreArrayReadF90(porosity_loc,porosity_loc_p, &
1855) ierr);CHKERRQ(ierr)
1856) endif
1857)
1858) end subroutine MaterialUpdatePorosity
1859)
1860) ! **************************************************************************** !
1861)
1862) subroutine MaterialPropInputRecord(material_property_list)
1863) !
1864) ! Prints ingested material property information to the input record file
1865) !
1866) ! Author: Jenn Frederick
1867) ! Date: 04/08/2016
1868) !
1869)
1870) implicit none
1871)
1872) type(material_property_type), pointer :: material_property_list
1873)
1874) type(material_property_type), pointer :: cur_matprop
1875) character(len=MAXWORDLENGTH) :: word1, word2
1876) character(len=MAXSTRINGLENGTH) :: string
1877) PetscInt :: id = INPUT_RECORD_UNIT
1878)
1879) write(id,'(a)') ' '
1880) write(id,'(a)') '---------------------------------------------------------&
1881) &-----------------------'
1882) write(id,'(a29)',advance='no') '---------------------------: '
1883) write(id,'(a)') 'MATERIAL PROPERTIES'
1884)
1885) cur_matprop => material_property_list
1886) do
1887) if (.not.associated(cur_matprop)) exit
1888)
1889) write(id,'(a29)',advance='no') 'material property name: '
1890) write(id,'(a)') adjustl(trim(cur_matprop%name))
1891)
1892) if (Initialized(cur_matprop%external_id)) then
1893) write(id,'(a29)',advance='no') 'material id: '
1894) write(word1,*) cur_matprop%external_id
1895) write(id,'(a)') adjustl(trim(word1))
1896) endif
1897)
1898) write(id,'(a29)',advance='no') 'material property is: '
1899) if (cur_matprop%active) then
1900) write(id,'(a)') 'active'
1901) else
1902) write(id,'(a)') 'inactive'
1903) endif
1904)
1905) write(id,'(a29)',advance='no') 'permeability: '
1906) if (associated(cur_matprop%permeability_dataset)) then
1907) write(id,'(a)') cur_matprop%permeability_dataset%name
1908) write(id,'(a29)',advance='no') 'from file: '
1909) write(id,'(a)') cur_matprop%permeability_dataset%filename
1910) else
1911) if (cur_matprop%isotropic_permeability) then
1912) write(id,'(a)') 'isotropic'
1913) else
1914) write(id,'(a)') 'anisotropic'
1915) if (Initialized(cur_matprop%vertical_anisotropy_ratio)) then
1916) write(id,'(a29)',advance='no') 'vertical anisotropy ratio: '
1917) write(word1,*) cur_matprop%vertical_anisotropy_ratio
1918) write(id,'(a)') adjustl(trim(word1))
1919) endif
1920) endif
1921) write(id,'(a29)',advance='no') 'k_xx: '
1922) write(word1,*) cur_matprop%permeability(1,1)
1923) write(id,'(a)') adjustl(trim(word1)) // ' m^2'
1924) write(id,'(a29)',advance='no') 'k_yy: '
1925) write(word1,*) cur_matprop%permeability(2,2)
1926) write(id,'(a)') adjustl(trim(word1)) // ' m^2'
1927) write(id,'(a29)',advance='no') 'k_zz: '
1928) write(word1,*) cur_matprop%permeability(3,3)
1929) write(id,'(a)') adjustl(trim(word1)) // ' m^2'
1930) endif
1931) if (cur_matprop%permeability_scaling_factor > 0.d0) then
1932) write(id,'(a29)',advance='no') 'permeability scaling factor: '
1933) write(word1,*) cur_matprop%permeability_scaling_factor
1934) write(id,'(a)') adjustl(trim(word1))
1935) endif
1936) if (cur_matprop%permeability_pwr /= 1.d0) then
1937) write(id,'(a29)',advance='no') 'permeability power: '
1938) write(word1,*) cur_matprop%permeability_pwr
1939) write(id,'(a)') adjustl(trim(word1))
1940) endif
1941) if (cur_matprop%permeability_crit_por > 0.d0) then
1942) write(id,'(a29)',advance='no') 'permeability critical por.: '
1943) write(word1,*) cur_matprop%permeability_crit_por
1944) write(id,'(a)') adjustl(trim(word1))
1945) endif
1946)
1947) write(id,'(a29)',advance='no') 'tortuosity: '
1948) write(word1,*) cur_matprop%tortuosity
1949) write(id,'(a)') adjustl(trim(word1))
1950)
1951) if (Initialized(cur_matprop%rock_density)) then
1952) write(id,'(a29)',advance='no') 'rock density: '
1953) write(word1,*) cur_matprop%rock_density
1954) write(id,'(a)') adjustl(trim(word1)) // ' kg/m^3'
1955) endif
1956)
1957) write(id,'(a29)',advance='no') 'porosity: '
1958) if (associated(cur_matprop%porosity_dataset)) then
1959) write(id,'(a)') adjustl(trim(cur_matprop%porosity_dataset%name))
1960) write(id,'(a29)',advance='no') 'from file: '
1961) write(id,'(a)') adjustl(trim(cur_matprop%porosity_dataset%filename))
1962) else
1963) write(word1,*) cur_matprop%porosity
1964) write(id,'(a)') adjustl(trim(word1))
1965) endif
1966)
1967) write(id,'(a29)',advance='no') 'tortuosity: '
1968) if (associated(cur_matprop%tortuosity_dataset)) then
1969) write(id,'(a)') adjustl(trim(cur_matprop%tortuosity_dataset%name))
1970) write(id,'(a29)',advance='no') 'from file: '
1971) write(id,'(a)') adjustl(trim(cur_matprop%tortuosity_dataset%filename))
1972) else
1973) write(word1,*) cur_matprop%tortuosity
1974) write(id,'(a)') adjustl(trim(word1))
1975) endif
1976)
1977) if (Initialized(cur_matprop%specific_heat)) then
1978) write(id,'(a29)',advance='no') 'specific heat capacity: '
1979) write(word1,*) cur_matprop%specific_heat
1980) write(id,'(a)') adjustl(trim(word1)) // ' J/kg-C'
1981) endif
1982)
1983) if (Initialized(cur_matprop%thermal_conductivity_dry)) then
1984) write(id,'(a29)',advance='no') 'dry th. conductivity: '
1985) write(word1,*) cur_matprop%thermal_conductivity_dry
1986) write(id,'(a)') adjustl(trim(word1)) // ' W/m-C'
1987) endif
1988) if (Initialized(cur_matprop%thermal_conductivity_wet)) then
1989) write(id,'(a29)',advance='no') 'wet th. conductivity: '
1990) write(word1,*) cur_matprop%thermal_conductivity_wet
1991) write(id,'(a)') adjustl(trim(word1)) // ' W/m-C'
1992) endif
1993) if (cur_matprop%thermal_conductivity_frozen > 0.d0) then
1994) write(id,'(a29)',advance='no') 'frozen th. conductivity: '
1995) write(word1,*) cur_matprop%thermal_conductivity_frozen
1996) write(id,'(a)') adjustl(trim(word1)) // ' W/m-C'
1997) endif
1998)
1999) if (len_trim(cur_matprop%soil_compressibility_function) > 0) then
2000) write(id,'(a29)',advance='no') 'soil compressibility func.: '
2001) write(id,'(a)') adjustl(trim(cur_matprop%soil_compressibility_function))
2002) endif
2003) if (Initialized(cur_matprop%soil_compressibility)) then
2004) write(id,'(a29)',advance='no') 'soil compressibility: '
2005) write(word1,*) cur_matprop%soil_compressibility
2006) write(id,'(a)') adjustl(trim(word1))
2007) endif
2008) if (Initialized(cur_matprop%soil_reference_pressure)) then
2009) write(id,'(a29)',advance='no') 'soil reference pressure: '
2010) write(word1,*) cur_matprop%soil_reference_pressure
2011) write(id,'(a)') adjustl(trim(word1)) // ' Pa'
2012) endif
2013) if (cur_matprop%soil_reference_pressure_initial) then
2014) write(id,'(a29)',advance='no') 'soil reference pressure: '
2015) write(id,'(a)') 'initial cell pressure'
2016) endif
2017)
2018) if (cur_matprop%dispersivity(1) > 0.d0 .or. &
2019) cur_matprop%dispersivity(2) > 0.d0 .or. &
2020) cur_matprop%dispersivity(3) > 0.d0) then
2021) write(id,'(a29)',advance='no') 'longitudinal dispersivity: '
2022) write(word1,*) cur_matprop%dispersivity(1)
2023) write(id,'(a)') adjustl(trim(word1)) // ' m'
2024) write(id,'(a29)',advance='no') 'transverse h dispersivity: '
2025) write(word1,*) cur_matprop%dispersivity(2)
2026) write(id,'(a)') adjustl(trim(word1)) // ' m'
2027) write(id,'(a29)',advance='no') 'transverse v dispersivity: '
2028) write(word1,*) cur_matprop%dispersivity(2)
2029) write(id,'(a)') adjustl(trim(word1)) // ' m'
2030) endif
2031)
2032) write(id,'(a29)',advance='no') 'cc / saturation function: '
2033) write(id,'(a)') adjustl(trim(cur_matprop%saturation_function_name))
2034)
2035) write(id,'(a29)') '---------------------------: '
2036) cur_matprop => cur_matprop%next
2037) enddo
2038)
2039) end subroutine MaterialPropInputRecord
2040)
2041) ! ************************************************************************** !
2042)
2043) recursive subroutine MaterialPropertyDestroy(material_property)
2044) !
2045) ! Destroys a material_property
2046) !
2047) ! Author: Glenn Hammond
2048) ! Date: 11/02/07
2049) !
2050)
2051) implicit none
2052)
2053) type(material_property_type), pointer :: material_property
2054)
2055) if (.not.associated(material_property)) return
2056)
2057) call MaterialPropertyDestroy(material_property%next)
2058) call FractureDestroy(material_property%fracture)
2059)
2060) ! simply nullify since the datasets reside in a list within realization
2061) nullify(material_property%permeability_dataset)
2062) nullify(material_property%permeability_dataset_y)
2063) nullify(material_property%permeability_dataset_z)
2064) nullify(material_property%porosity_dataset)
2065) nullify(material_property%tortuosity_dataset)
2066) nullify(material_property%compressibility_dataset)
2067)
2068) deallocate(material_property)
2069) nullify(material_property)
2070)
2071) end subroutine MaterialPropertyDestroy
2072)
2073) end module Material_module