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