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

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