geomechanics_material.F90       coverage:  100.00 %func     70.63 %block


     1) module Geomechanics_Material_module
     2)   
     3)   use PFLOTRAN_Constants_module
     4) 
     5)   implicit none
     6)   
     7)   private
     8)   
     9) #include "petsc/finclude/petscsys.h"  
    10) 
    11)   type, public :: geomech_material_property_type
    12)     character(len=MAXWORDLENGTH) :: name
    13)     PetscInt :: id
    14)     PetscReal :: youngs_modulus
    15)     PetscReal :: poissons_ratio
    16)     PetscReal :: density
    17)     PetscReal :: biot_coeff
    18)     PetscReal :: thermal_exp_coeff
    19)   
    20)     type(geomech_material_property_type), pointer :: next
    21)   end type geomech_material_property_type
    22) 
    23)   type, public :: geomech_material_property_ptr_type
    24)     type(geomech_material_property_type), pointer :: ptr
    25)   end type geomech_material_property_ptr_type
    26)   
    27)   public :: GeomechanicsMaterialPropertyCreate, &
    28)             GeomechanicsMaterialPropertyDestroy, &
    29)             GeomechanicsMaterialPropertyAddToList, &
    30)             GeomechanicsMaterialPropertyRead, &
    31)             GeomechanicsMaterialPropConvertListToArray, &
    32)             GeomechanicsMaterialPropGetPtrFromArray
    33) 
    34) contains
    35) 
    36) ! ************************************************************************** !
    37) 
    38) function GeomechanicsMaterialPropertyCreate()
    39)   ! 
    40)   ! Creates a geomechanics material property
    41)   ! 
    42)   ! Author: Satish Karra, LANL
    43)   ! Date: 05/23/13
    44)   ! 
    45) 
    46)   implicit none
    47)   
    48)   type(geomech_material_property_type), &
    49)     pointer :: GeomechanicsMaterialPropertyCreate
    50)   type(geomech_material_property_type), pointer :: geomech_material_property
    51)   
    52)   allocate(geomech_material_property)
    53)   
    54)   geomech_material_property%name = ''
    55)   geomech_material_property%id = 0
    56)   geomech_material_property%youngs_modulus = 0.d0
    57)   geomech_material_property%poissons_ratio = 0.d0
    58)   geomech_material_property%density = 0.d0
    59)   geomech_material_property%biot_coeff = 0.d0
    60)   geomech_material_property%thermal_exp_coeff = 0.d0
    61)   
    62)   nullify(geomech_material_property%next)
    63)   
    64)   GeomechanicsMaterialPropertyCreate => geomech_material_property
    65) 
    66) end function GeomechanicsMaterialPropertyCreate
    67) 
    68) ! ************************************************************************** !
    69) 
    70) subroutine GeomechanicsMaterialPropertyRead(geomech_material_property, &
    71)                                             input,option)
    72)   ! 
    73)   ! Reads geomechanics material properties
    74)   ! property
    75)   ! 
    76)   ! Author: Satish Karra, LANL
    77)   ! Date: 05/23/13. 09/02/13
    78)   ! 
    79) 
    80)   use Option_module
    81)   use Input_Aux_module
    82)   use String_module
    83)   
    84)   implicit none
    85)   
    86)   type(geomech_material_property_type) :: geomech_material_property
    87)   type(input_type), pointer :: input
    88)   type(option_type) :: option
    89)   
    90)   character(len=MAXWORDLENGTH) :: keyword, word
    91)   character(len=MAXSTRINGLENGTH) :: string
    92)   
    93)   do
    94)     call InputReadPflotranString(input,option)
    95)     
    96)     if (InputCheckExit(input,option)) exit
    97)   
    98)     call InputReadWord(input,option,keyword,PETSC_TRUE)
    99)     call InputErrorMsg(input,option,'keyword','GEOMECHANICS_MATERIAL_PROPERTY')
   100)     call StringToUpper(keyword)
   101)     
   102)     select case(trim(keyword))
   103)       case('ID')
   104)         call InputReadInt(input,option,geomech_material_property%id)
   105)         call InputErrorMsg(input,option,'id','GEOMECHANICS_MATERIAL_PROPERTY')
   106)       case('YOUNGS_MODULUS')
   107)         call InputReadDouble(input,option,geomech_material_property% &
   108)                              youngs_modulus)
   109)         call InputErrorMsg(input,option,'YOUNGS_MODULUS', &
   110)                            'GEOMECHANICS_MATERIAL_PROPERTY')
   111)       case('POISSONS_RATIO')
   112)         call InputReadDouble(input,option,geomech_material_property% &
   113)                              poissons_ratio)
   114)         call InputErrorMsg(input,option,'POISSONS_RATIO', &
   115)                            'GEOMECHANICS_MATERIAL_PROPERTY')
   116)       case('ROCK_DENSITY')
   117)         call InputReadDouble(input,option,geomech_material_property% &
   118)                              density)
   119)         call InputErrorMsg(input,option,'ROCK_DENSITY', &
   120)                            'GEOMECHANICS_MATERIAL_PROPERTY')
   121)       case('BIOT_COEFFICIENT')
   122)         call InputReadDouble(input,option,geomech_material_property% &
   123)                              biot_coeff)
   124)         call InputErrorMsg(input,option,'BIOT_COEFFICIENT', &
   125)                            'GEOMECHANICS_MATERIAL_PROPERTY')
   126)       case('THERMAL_EXPANSION_COEFFICIENT')
   127)         call InputReadDouble(input,option,geomech_material_property% &
   128)                              thermal_exp_coeff)
   129)         call InputErrorMsg(input,option,'THERMAL_EXPANSION_COEFFICIENT', &
   130)                            'GEOMECHANICS_MATERIAL_PROPERTY')
   131)       case default
   132)         call InputKeywordUnrecognized(keyword, &
   133)                                  'GEOMECHANICS_MATERIAL_PROPERTY',option)
   134)       end select
   135)   enddo
   136)   
   137) end subroutine GeomechanicsMaterialPropertyRead
   138) 
   139) ! ************************************************************************** !
   140) 
   141) subroutine GeomechanicsMaterialPropertyAddToList(geomech_material_property, &
   142)                                                  list)
   143)   ! 
   144)   ! Destroys a geomechanics material
   145)   ! property
   146)   ! 
   147)   ! Author: Satish Karra, LANL
   148)   ! Date: 05/23/13
   149)   ! 
   150) 
   151)   implicit none
   152)   
   153)   type(geomech_material_property_type), pointer :: geomech_material_property
   154)   type(geomech_material_property_type), pointer :: list
   155)   type(geomech_material_property_type), pointer :: cur_geomech_material_property
   156)   
   157)   if (associated(list)) then
   158)     cur_geomech_material_property => list
   159)     ! loop to end of list
   160)     do
   161)       if (.not.associated(cur_geomech_material_property%next)) exit
   162)       cur_geomech_material_property => cur_geomech_material_property%next
   163)     enddo
   164)     cur_geomech_material_property%next => geomech_material_property
   165)   else
   166)     list => geomech_material_property
   167)   endif
   168)   
   169) end subroutine GeomechanicsMaterialPropertyAddToList
   170) 
   171) ! ************************************************************************** !
   172) 
   173) subroutine GeomechanicsMaterialPropConvertListToArray(list,array,option)
   174)   ! 
   175)   ! Destroys a geomechanics material
   176)   ! property
   177)   ! 
   178)   ! Author: Satish Karra, LANL
   179)   ! Date: 05/23/13
   180)   ! 
   181) 
   182)   use Option_module
   183)   use String_module
   184) 
   185)   implicit none
   186) 
   187)   type(geomech_material_property_type), pointer :: list
   188)   type(geomech_material_property_ptr_type), pointer :: array(:)
   189)   type(option_type) :: option
   190) 
   191)   type(geomech_material_property_type), pointer :: cur_material_property
   192)   type(geomech_material_property_type), pointer :: prev_material_property
   193)   type(geomech_material_property_type), pointer :: next_material_property
   194)   PetscInt :: i, j, length1,length2, max_id
   195)   PetscInt, allocatable :: id_count(:)
   196)   PetscBool :: error_flag
   197)   character(len=MAXSTRINGLENGTH) :: string
   198) 
   199)   max_id = 0
   200)   cur_material_property => list
   201)   do
   202)     if (.not.associated(cur_material_property)) exit
   203)     max_id = max(max_id,cur_material_property%id)
   204)     cur_material_property => cur_material_property%next
   205)   enddo
   206) 
   207)   allocate(array(max_id))
   208)   do i = 1, max_id
   209)     nullify(array(i)%ptr)
   210)   enddo
   211) 
   212)   ! use id_count to ensure that an id is not duplicated
   213)   allocate(id_count(max_id))
   214)   id_count = 0
   215) 
   216)   cur_material_property => list
   217)   do
   218)     if (.not.associated(cur_material_property)) exit
   219)     id_count(cur_material_property%id) = &
   220)       id_count(cur_material_property%id) + 1
   221)     array(cur_material_property%id)%ptr => cur_material_property
   222)     cur_material_property => cur_material_property%next
   223)   enddo
   224) 
   225)   ! check to ensure that an id is not duplicated
   226)   error_flag = PETSC_FALSE
   227)   do i = 1, max_id
   228)     if (id_count(i) > 1) then
   229)       write(string,*) i
   230)       option%io_buffer = 'Material ID ' // trim(adjustl(string)) // &
   231)         ' is duplicated in input file.'
   232)       call printMsg(option)
   233)       error_flag = PETSC_TRUE
   234)     endif
   235)   enddo
   236) 
   237)   deallocate(id_count)
   238) 
   239)   if (error_flag) then
   240)     option%io_buffer = 'Duplicate Material IDs.'
   241)     call printErrMsg(option)
   242)   endif
   243) 
   244)   ! ensure unique material names
   245)   error_flag = PETSC_FALSE
   246)   do i = 1, max_id
   247)     if (associated(array(i)%ptr)) then
   248)       length1 = len_trim(array(i)%ptr%name)
   249)       do j = 1, i-1
   250)         if (associated(array(j)%ptr)) then
   251)           length2 = len_trim(array(j)%ptr%name)
   252)           if (length1 /= length2) cycle
   253)           if (StringCompare(array(i)%ptr%name,array(j)%ptr%name,length1)) then
   254)             option%io_buffer = 'Material name "' // &
   255)               trim(adjustl(array(i)%ptr%name)) // &
   256)               '" is duplicated in input file.'
   257)             call printMsg(option)
   258)             error_flag = PETSC_TRUE
   259)           endif
   260)         endif
   261)       enddo
   262)     endif
   263)   enddo
   264) 
   265)   if (error_flag) then
   266)     option%io_buffer = 'Duplicate Material names.'
   267)     call printErrMsg(option)
   268)   endif
   269) 
   270) end subroutine GeomechanicsMaterialPropConvertListToArray
   271) 
   272) ! ************************************************************************** !
   273) 
   274) function GeomechanicsMaterialPropGetPtrFromArray( &
   275)                                             geomech_material_property_name, &
   276)                                             geomech_material_property_array)
   277)   ! 
   278)   ! Destroys a geomechanics material
   279)   ! property
   280)   ! 
   281)   ! Author: Satish Karra, LANL
   282)   ! Date: 05/23/13
   283)   ! 
   284) 
   285)   use String_module
   286) 
   287)   implicit none
   288) 
   289)   type(geomech_material_property_type), &
   290)     pointer :: GeomechanicsMaterialPropGetPtrFromArray
   291)   type(geomech_material_property_ptr_type), &
   292)     pointer :: geomech_material_property_array(:)
   293)   character(len=MAXWORDLENGTH) :: geomech_material_property_name
   294)   PetscInt :: length
   295)   PetscInt :: igeomech_material_property
   296) 
   297)   nullify(GeomechanicsMaterialPropGetPtrFromArray)
   298) 
   299)   do igeomech_material_property = 1, size(geomech_material_property_array)
   300)     length = len_trim(geomech_material_property_name)
   301)     if (.not.associated(geomech_material_property_array &
   302)       (igeomech_material_property)%ptr)) cycle
   303)     if (length == &
   304)         len_trim(geomech_material_property_array &
   305)           (igeomech_material_property)%ptr%name) .and. &
   306)         StringCompare(geomech_material_property_array &
   307)           (igeomech_material_property)%ptr%name, &
   308)                         geomech_material_property_name,length)) then
   309)       GeomechanicsMaterialPropGetPtrFromArray => &
   310)         geomech_material_property_array(igeomech_material_property)%ptr
   311)       return
   312)     endif
   313)   enddo
   314) 
   315) end function GeomechanicsMaterialPropGetPtrFromArray
   316) 
   317) ! ************************************************************************** !
   318) 
   319) recursive subroutine GeomechanicsMaterialPropertyDestroy(&
   320)                                                     geomech_material_property)
   321)   ! 
   322)   ! Destroys a geomechanics material
   323)   ! property
   324)   ! 
   325)   ! Author: Satish Karra, LANL
   326)   ! Date: 05/23/13
   327)   ! 
   328) 
   329)   implicit none
   330)   
   331)   type(geomech_material_property_type), pointer :: geomech_material_property
   332)   
   333)   if (.not.associated(geomech_material_property)) return
   334)   
   335)   call GeomechanicsMaterialPropertyDestroy(geomech_material_property%next)
   336)   
   337)   deallocate(geomech_material_property)
   338)   nullify(geomech_material_property)
   339)   
   340) end subroutine GeomechanicsMaterialPropertyDestroy
   341) 
   342) end module Geomechanics_Material_module

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