geomechanics_strata.F90 coverage: 100.00 %func 85.57 %block
1) module Geomechanics_Strata_module
2)
3) use Geomechanics_Region_module
4) use Geomechanics_Material_module
5) use PFLOTRAN_Constants_module
6)
7) implicit none
8)
9) private
10)
11) #include "petsc/finclude/petscsys.h"
12)
13) type, public :: geomech_strata_type
14) PetscInt :: id ! id of strata
15) PetscBool :: active
16) character(len=MAXWORDLENGTH) :: material_property_name ! character string defining name of material to be applied
17) character(len=MAXSTRINGLENGTH) :: material_property_filename ! character string defining name of file containing materia ids
18) PetscBool :: realization_dependent
19) character(len=MAXWORDLENGTH) :: region_name ! character string defining name of region to be applied
20) PetscInt :: imaterial_property ! id of material in material array/list
21) PetscInt :: iregion ! id of region in region array/list
22) type(geomech_material_property_type), pointer :: material_property ! pointer to material in material array/list
23) type(gm_region_type), pointer :: region ! pointer to region in region array/list
24) type(geomech_strata_type), pointer :: next ! pointer to next strata
25) end type geomech_strata_type
26)
27) type, public :: geomech_strata_ptr_type
28) type(geomech_strata_type), pointer :: ptr
29) end type geomech_strata_ptr_type
30)
31) type, public :: geomech_strata_list_type
32) PetscInt :: num_strata
33) type(geomech_strata_type), pointer :: first
34) type(geomech_strata_type), pointer :: last
35) type(geomech_strata_ptr_type), pointer :: array(:)
36) end type geomech_strata_list_type
37)
38) interface GeomechStrataCreate
39) module procedure GeomechStrataCreate1
40) module procedure GeomechStrataCreateFromGeomechStrata
41) end interface
42)
43) public :: GeomechStrataCreate, &
44) GeomechStrataDestroy, &
45) GeomechStrataInitList, &
46) GeomechStrataAddToList, &
47) GeomechStrataRead, &
48) GeomechStrataDestroyList
49)
50) contains
51)
52) ! ************************************************************************** !
53)
54) function GeomechStrataCreate1()
55) !
56) ! Creates a geomechanics strata
57) !
58) ! Author: Satish Karra, LANL
59) ! Date: 06/07/2013
60) !
61)
62) implicit none
63)
64) type(geomech_strata_type), pointer :: GeomechStrataCreate1
65)
66) type(geomech_strata_type), pointer :: strata
67)
68) allocate(strata)
69) strata%id = 0
70) strata%active = PETSC_TRUE
71) strata%material_property_name = ""
72) strata%material_property_filename = ""
73) strata%realization_dependent = PETSC_FALSE
74) strata%region_name = ""
75) strata%iregion = 0
76) strata%imaterial_property = 0
77)
78) nullify(strata%region)
79) nullify(strata%material_property)
80) nullify(strata%next)
81)
82) GeomechStrataCreate1 => strata
83)
84) end function GeomechStrataCreate1
85)
86) ! ************************************************************************** !
87)
88) function GeomechStrataCreateFromGeomechStrata(strata)
89) !
90) ! Creates a geomechanics strata
91) ! from another geomechanics strata
92) !
93) ! Author: Satish Karra, LANL
94) ! Date: 06/07/2013
95) !
96)
97) implicit none
98)
99) type(geomech_strata_type), pointer :: GeomechStrataCreateFromGeomechStrata
100) type(geomech_strata_type), pointer :: strata
101)
102) type(geomech_strata_type), pointer :: new_strata
103)
104) new_strata => GeomechStrataCreate1()
105)
106) new_strata%id = strata%id
107) new_strata%active = strata%active
108) new_strata%material_property_name = strata%material_property_name
109) new_strata%material_property_filename = strata%material_property_filename
110) new_strata%realization_dependent = strata%realization_dependent
111) new_strata%region_name = strata%region_name
112) new_strata%iregion = strata%iregion
113) ! keep these null
114) nullify(new_strata%region)
115) nullify(new_strata%material_property)
116) nullify(new_strata%next)
117)
118) GeomechStrataCreateFromGeomechStrata => new_strata
119)
120) end function GeomechStrataCreateFromGeomechStrata
121)
122) ! ************************************************************************** !
123)
124) subroutine GeomechStrataInitList(list)
125) !
126) ! Initializes a geomechanics strata list
127) !
128) ! Author: Satish Karra, LANL
129) ! Date: 06/07/2013
130) !
131)
132) implicit none
133)
134) type(geomech_strata_list_type) :: list
135)
136) nullify(list%first)
137) nullify(list%last)
138) nullify(list%array)
139) list%num_strata = 0
140)
141) end subroutine GeomechStrataInitList
142)
143) ! ************************************************************************** !
144)
145) subroutine GeomechStrataRead(strata,input,option)
146) !
147) ! Reads a geomechanics strata from the input file
148) !
149) ! Author: Satish Karra, LANL
150) ! Date: 06/07/2013
151) !
152)
153) use Input_Aux_module
154) use Option_module
155) use String_module
156)
157) implicit none
158)
159) type(geomech_strata_type) :: strata
160) type(input_type), pointer :: input
161) type(option_type) :: option
162)
163) character(len=MAXWORDLENGTH) :: keyword
164) character(len=MAXSTRINGLENGTH) :: string
165)
166) input%ierr = 0
167) do
168)
169) call InputReadPflotranString(input,option)
170)
171) if (InputCheckExit(input,option)) exit
172)
173) call InputReadWord(input,option,keyword,PETSC_TRUE)
174) call InputErrorMsg(input,option,'keyword','GEOMECHANICS STRATA')
175)
176) select case(trim(keyword))
177)
178) case('GEOMECHANICS_REGION')
179) call InputReadWord(input,option,strata%region_name,PETSC_TRUE)
180) call InputErrorMsg(input,option,'geomechanics region name', &
181) 'GEOMECHANICS STRATA')
182) case('GEOMECHANICS_MATERIAL')
183) call InputReadNChars(input,option,string,MAXSTRINGLENGTH,PETSC_TRUE)
184) call InputErrorMsg(input,option, &
185) 'geomechancis material property name','GEOMECHANICS STRATA')
186) if (StringCompareIgnoreCase(string,'realization_dependent')) then
187) strata%realization_dependent = PETSC_TRUE
188) call InputReadNChars(input,option,string,MAXSTRINGLENGTH,PETSC_TRUE)
189) call InputErrorMsg(input,option, &
190) 'geomechancis material property name','GEOMECHANICS STRATA')
191) endif
192) strata%material_property_name = trim(string)
193) strata%material_property_filename = string
194) case('INACTIVE')
195) strata%active = PETSC_FALSE
196) case default
197) call InputKeywordUnrecognized(keyword,'GEOMECHANICS_STRATA',option)
198) end select
199)
200) enddo
201)
202) end subroutine GeomechStrataRead
203)
204) ! ************************************************************************** !
205)
206) subroutine GeomechStrataAddToList(new_strata,list)
207) !
208) ! Adds a new geomechanics strata to a geomechanics
209) ! strata list
210) !
211) ! Author: Satish Karra, LANL
212) ! Date: 06/07/2013
213) !
214)
215) implicit none
216)
217) type(geomech_strata_type), pointer :: new_strata
218) type(geomech_strata_list_type) :: list
219)
220) list%num_strata = list%num_strata + 1
221) new_strata%id = list%num_strata
222) if (.not.associated(list%first)) list%first => new_strata
223) if (associated(list%last)) list%last%next => new_strata
224) list%last => new_strata
225)
226) end subroutine GeomechStrataAddToList
227)
228) ! ************************************************************************** !
229)
230) subroutine GeomechStrataDestroyList(strata_list)
231) !
232) ! Deallocates a list of geomechanics stratas
233) !
234) ! Author: Satish Karra, LANL
235) ! Date: 06/07/2013
236) !
237)
238) implicit none
239)
240) type(geomech_strata_list_type), pointer :: strata_list
241)
242) type(geomech_strata_type), pointer :: strata, prev_strata
243)
244)
245) strata => strata_list%first
246) do
247) if (.not.associated(strata)) exit
248) prev_strata => strata
249) strata => strata%next
250) call GeomechStrataDestroy(prev_strata)
251) enddo
252)
253) strata_list%num_strata = 0
254) nullify(strata_list%first)
255) nullify(strata_list%last)
256) if (associated(strata_list%array)) deallocate(strata_list%array)
257) nullify(strata_list%array)
258)
259) deallocate(strata_list)
260) nullify(strata_list)
261)
262) end subroutine GeomechStrataDestroyList
263)
264) ! ************************************************************************** !
265)
266) subroutine GeomechStrataDestroy(strata)
267) !
268) ! Destroys a geomechanics strata
269) !
270) ! Author: Satish Karra, LANL
271) ! Date: 06/07/2013
272) !
273)
274) implicit none
275)
276) type(geomech_strata_type), pointer :: strata
277)
278) if (.not.associated(strata)) return
279)
280) ! since strata%region is a pointer to a region in a list, nullify instead
281) ! of destroying since the list will be destroyed separately
282) nullify(strata%region)
283)
284) deallocate(strata)
285) nullify(strata)
286)
287) end subroutine GeomechStrataDestroy
288)
289) end module Geomechanics_Strata_module