geomechanics_coupler.F90 coverage: 88.89 %func 81.25 %block
1) module Geomechanics_Coupler_module
2)
3) use Geomechanics_Condition_module
4) use Geomechanics_Region_module
5) use PFLOTRAN_Constants_module
6)
7) implicit none
8)
9) private
10)
11) #include "petsc/finclude/petscsys.h"
12)
13) ! coupler types
14) ! SK: Note that there is no initial coupler since we solve
15) ! a quasi-static problem for geomechanics (when coupled to flow, otherwise
16) ! it is a steady state problem)
17) PetscInt, parameter, public :: GM_BOUNDARY_COUPLER_TYPE = 1
18) PetscInt, parameter, public :: GM_SRC_SINK_COUPLER_TYPE = 2
19)
20) type, public :: geomech_coupler_type
21) PetscInt :: id ! id of coupler
22) character(len=MAXWORDLENGTH) :: name ! name of coupler
23) PetscInt :: itype ! integer defining type
24) character(len=MAXWORDLENGTH) :: ctype ! character string defining type
25) character(len=MAXWORDLENGTH) :: geomech_condition_name ! character string defining name of condition to be applied
26) character(len=MAXWORDLENGTH) :: region_name ! character string defining name of region to be applied
27) PetscInt :: igeomech_condition ! id of condition in condition array/list
28) PetscInt :: iregion ! id of region in region array/list
29) PetscInt, pointer :: geomech_aux_int_var(:,:) ! auxiliary array for integer value
30) PetscReal, pointer :: geomech_aux_real_var(:,:) ! auxiliary array for real values
31) type(geomech_condition_type), pointer :: geomech_condition ! pointer to condition in condition array/list
32) type(gm_region_type), pointer :: region ! pointer to region in region array/list
33) type(geomech_coupler_type), pointer :: next ! pointer to next coupler
34) end type geomech_coupler_type
35)
36) type, public :: geomech_coupler_ptr_type
37) type(geomech_coupler_type), pointer :: ptr
38) end type geomech_coupler_ptr_type
39)
40) type, public :: geomech_coupler_list_type
41) PetscInt :: num_couplers
42) type(geomech_coupler_type), pointer :: first
43) type(geomech_coupler_type), pointer :: last
44) type(geomech_coupler_type), pointer :: array(:)
45) end type geomech_coupler_list_type
46)
47) public :: GeomechCouplerCreate, &
48) GeomechCouplerDestroy, &
49) GeomechCouplerInitList, &
50) GeomechCouplerAddToList, &
51) GeomechCouplerRead, &
52) GeomechCouplerDestroyList, &
53) GeomechCouplerGetPtrFromList
54)
55) interface GeomechCouplerCreate
56) module procedure GeomechCouplerCreate1
57) module procedure GeomechCouplerCreate2
58) module procedure GeomechCouplerCreateFromGeomechCoupler
59) end interface
60)
61) contains
62)
63) ! ************************************************************************** !
64)
65) function GeomechCouplerCreate1()
66) !
67) ! GeomechCouplerCreate: Creates a coupler
68) !
69) ! Author: Satish Karra, LANL
70) ! Date: 06/13/13
71) !
72)
73) implicit none
74)
75) type(geomech_coupler_type), pointer :: GeomechCouplerCreate1
76)
77) type(geomech_coupler_type), pointer :: coupler
78)
79) allocate(coupler)
80) coupler%id = 0
81) coupler%name = ''
82) coupler%itype = GM_BOUNDARY_COUPLER_TYPE
83) coupler%ctype = "boundary"
84) coupler%geomech_condition_name = ""
85) coupler%region_name = ""
86) coupler%igeomech_condition = 0
87) coupler%iregion = 0
88) nullify(coupler%geomech_aux_int_var)
89) nullify(coupler%geomech_aux_real_var)
90) nullify(coupler%geomech_condition)
91) nullify(coupler%region)
92) nullify(coupler%next)
93)
94) GeomechCouplerCreate1 => coupler
95)
96) end function GeomechCouplerCreate1
97)
98) ! ************************************************************************** !
99)
100) function GeomechCouplerCreate2(itype)
101) !
102) ! Creates a coupler
103) !
104) ! Author: Satish Karra, LANL
105) ! Date: 06/13/13
106) !
107)
108) implicit none
109)
110) PetscInt :: itype
111)
112) type(geomech_coupler_type), pointer :: GeomechCouplerCreate2
113)
114) type(geomech_coupler_type), pointer :: coupler
115)
116) coupler => GeomechCouplerCreate1()
117) coupler%itype = itype
118) select case(itype)
119) case(GM_BOUNDARY_COUPLER_TYPE)
120) coupler%ctype = 'boundary'
121) case(GM_SRC_SINK_COUPLER_TYPE)
122) coupler%ctype = 'source_sink'
123) end select
124)
125) GeomechCouplerCreate2 => coupler
126)
127) end function GeomechCouplerCreate2
128)
129) ! ************************************************************************** !
130)
131) function GeomechCouplerCreateFromGeomechCoupler(coupler)
132) !
133) ! Creates a coupler
134) !
135) ! Author: Satish Karra, LANL
136) ! Date: 06/13/13
137) !
138)
139) implicit none
140)
141) type(geomech_coupler_type), pointer :: coupler
142)
143) type(geomech_coupler_type), pointer :: GeomechCouplerCreateFromGeomechCoupler
144) type(geomech_coupler_type), pointer :: new_coupler
145)
146) new_coupler => GeomechCouplerCreate1()
147)
148) new_coupler%id = coupler%id
149) new_coupler%name = coupler%name
150) new_coupler%itype = coupler%itype
151) new_coupler%ctype = coupler%ctype
152) new_coupler%geomech_condition_name = coupler%geomech_condition_name
153) new_coupler%region_name = coupler%region_name
154) new_coupler%igeomech_condition = coupler%igeomech_condition
155) new_coupler%iregion = coupler%iregion
156)
157) ! these must remain null
158) nullify(coupler%geomech_condition)
159) nullify(coupler%region)
160) nullify(coupler%geomech_aux_int_var)
161) nullify(coupler%geomech_aux_real_var)
162) nullify(coupler%next)
163)
164) GeomechCouplerCreateFromGeomechCoupler => new_coupler
165)
166) end function GeomechCouplerCreateFromGeomechCoupler
167)
168) ! ************************************************************************** !
169)
170) subroutine GeomechCouplerInitList(list)
171) !
172) ! Initializes a coupler list
173) !
174) ! Author: Satish Karra, LANL
175) ! Date: 06/13/13
176) !
177)
178) implicit none
179)
180) type(geomech_coupler_list_type) :: list
181)
182) nullify(list%first)
183) nullify(list%last)
184) nullify(list%array)
185) list%num_couplers = 0
186)
187) end subroutine GeomechCouplerInitList
188)
189) ! ************************************************************************** !
190)
191) subroutine GeomechCouplerRead(coupler,input,option)
192) !
193) ! Reads a coupler from the input file
194) !
195) ! Author: Satish Karra, LANL
196) ! Date: 06/13/13
197) !
198)
199) use Input_Aux_module
200) use String_module
201) use Option_module
202)
203) implicit none
204)
205) type(option_type) :: option
206) type(geomech_coupler_type) :: coupler
207) type(input_type), pointer :: input
208)
209) character(len=MAXWORDLENGTH) :: word
210)
211) input%ierr = 0
212) do
213)
214) call InputReadPflotranString(input,option)
215) if (InputError(input)) exit
216) if (InputCheckExit(input,option)) exit
217)
218) call InputReadWord(input,option,word,PETSC_TRUE)
219) call InputErrorMsg(input,option,'keyword','GEOMECHANICS COUPLER')
220) call StringToUpper(word)
221)
222) select case(trim(word))
223)
224) case('GEOMECHANICS_REGION')
225) call InputReadWord(input,option,coupler%region_name,PETSC_TRUE)
226) case('GEOMECHANICS_CONDITION')
227) call InputReadWord(input,option,coupler%geomech_condition_name, &
228) PETSC_TRUE)
229) case default
230) call InputKeywordUnrecognized(word, &
231) 'geomechanics coupler',option)
232) end select
233)
234) enddo
235)
236) end subroutine GeomechCouplerRead
237)
238) ! ************************************************************************** !
239)
240) subroutine GeomechCouplerAddToList(new_coupler,list)
241) !
242) ! Adds a new coupler to a coupler list
243) !
244) ! Author: Satish Karra, LANL
245) ! Date: 06/13/13
246) !
247)
248) implicit none
249)
250) type(geomech_coupler_type), pointer :: new_coupler
251) type(geomech_coupler_list_type) :: list
252)
253) list%num_couplers = list%num_couplers + 1
254) new_coupler%id = list%num_couplers
255) if (.not.associated(list%first)) list%first => new_coupler
256) if (associated(list%last)) list%last%next => new_coupler
257) list%last => new_coupler
258)
259) end subroutine GeomechCouplerAddToList
260)
261) ! ************************************************************************** !
262)
263) function GeomechCouplerGetPtrFromList(coupler_name,coupler_list)
264) !
265) ! Returns a pointer to the geomech coupler
266) ! matching coupler_name
267) !
268) ! Author: Satish Karra, LANL
269) ! Date: 06/13/13
270) !
271)
272) use String_module
273)
274) implicit none
275)
276) type(geomech_coupler_type), pointer :: GeomechCouplerGetPtrFromList
277) character(len=MAXWORDLENGTH) :: coupler_name
278) PetscInt :: length
279) type(geomech_coupler_list_type) :: coupler_list
280)
281) type(geomech_coupler_type), pointer :: coupler
282)
283) nullify(GeomechCouplerGetPtrFromList)
284)
285) coupler => coupler_list%first
286) do
287) if (.not.associated(coupler)) exit
288) length = len_trim(coupler_name)
289) if (length == len_trim(coupler%name) .and. &
290) StringCompare(coupler%name,coupler_name,length)) then
291) GeomechCouplerGetPtrFromList => coupler
292) return
293) endif
294) coupler => coupler%next
295) enddo
296)
297) end function GeomechCouplerGetPtrFromList
298)
299) ! ************************************************************************** !
300)
301) subroutine GeomechCouplerDestroyList(coupler_list)
302) !
303) ! Deallocates a list of geomech couplers
304) !
305) ! Author: Satish Karra, LANL
306) ! Date: 06/13/13
307) !
308)
309) implicit none
310)
311) type(geomech_coupler_list_type), pointer :: coupler_list
312)
313) type(geomech_coupler_type), pointer :: coupler, prev_coupler
314)
315) if (.not.associated(coupler_list)) return
316)
317) coupler => coupler_list%first
318) do
319) if (.not.associated(coupler)) exit
320) prev_coupler => coupler
321) coupler => coupler%next
322) call GeomechCouplerDestroy(prev_coupler)
323) enddo
324)
325) coupler_list%num_couplers = 0
326) nullify(coupler_list%first)
327) nullify(coupler_list%last)
328) if (associated(coupler_list%array)) deallocate(coupler_list%array)
329) nullify(coupler_list%array)
330)
331) deallocate(coupler_list)
332) nullify(coupler_list)
333)
334) end subroutine GeomechCouplerDestroyList
335)
336) ! ************************************************************************** !
337)
338) subroutine GeomechCouplerDestroy(coupler)
339) !
340) ! Destroys a coupler
341) !
342) ! Author: Satish Karra, LANL
343) ! Date: 06/13/13
344) !
345)
346) implicit none
347)
348) type(geomech_coupler_type), pointer :: coupler
349)
350) if (.not.associated(coupler)) return
351)
352) ! since the below are simply pointers to objects in list that have already
353) ! or will be deallocated from the list, nullify instead of destroying
354)
355) nullify(coupler%geomech_condition) ! since these are simply pointers to
356) nullify(coupler%region) ! conditions in list, nullify
357)
358) if (associated(coupler%geomech_aux_int_var)) &
359) deallocate(coupler%geomech_aux_int_var)
360) nullify(coupler%geomech_aux_int_var)
361) if (associated(coupler%geomech_aux_real_var)) &
362) deallocate(coupler%geomech_aux_real_var)
363) nullify(coupler%geomech_aux_real_var)
364)
365) deallocate(coupler)
366) nullify(coupler)
367)
368) end subroutine GeomechCouplerDestroy
369)
370)
371) end module Geomechanics_Coupler_module