coupler.F90 coverage: 91.67 %func 83.33 %block
1) module Coupler_module
2)
3) use Condition_module
4) use Connection_module
5) use Region_module
6)
7) use PFLOTRAN_Constants_module
8)
9) implicit none
10)
11) private
12)
13) #include "petsc/finclude/petscsys.h"
14)
15) ! coupler types
16) PetscInt, parameter, public :: INITIAL_COUPLER_TYPE = 1
17) PetscInt, parameter, public :: BOUNDARY_COUPLER_TYPE = 2
18) PetscInt, parameter, public :: SRC_SINK_COUPLER_TYPE = 3
19) PetscInt, parameter, public :: COUPLER_IPHASE_INDEX = 1
20)
21) type, public :: coupler_type
22) PetscInt :: id ! id of coupler
23) character(len=MAXWORDLENGTH) :: name ! name of coupler
24) PetscInt :: itype ! integer defining type
25) character(len=MAXWORDLENGTH) :: ctype ! character string defining type
26) character(len=MAXWORDLENGTH) :: flow_condition_name ! character string defining name of condition to be applied
27) character(len=MAXWORDLENGTH) :: tran_condition_name ! character string defining name of condition to be applied
28) character(len=MAXWORDLENGTH) :: region_name ! character string defining name of region to be applied
29) PetscInt :: iflow_condition ! id of condition in condition array/list
30) PetscInt :: itran_condition ! id of condition in condition array/list
31) PetscInt :: iregion ! id of region in region array/list
32) PetscInt :: iface ! for structured grids only
33) PetscInt, pointer :: flow_aux_mapping(:) ! maps flow_aux_real_var to primarhy dof
34) PetscInt, pointer :: flow_bc_type(:) ! id of boundary condition type
35) PetscInt, pointer :: flow_aux_int_var(:,:) ! auxiliary array for integer value
36) PetscReal, pointer :: flow_aux_real_var(:,:) ! auxiliary array for real values
37) type(flow_condition_type), pointer :: flow_condition ! pointer to condition in condition array/list
38) type(tran_condition_type), pointer :: tran_condition ! pointer to condition in condition array/list
39) type(region_type), pointer :: region ! pointer to region in region array/list
40) type(connection_set_type), pointer :: connection_set ! pointer to an array/list of connections
41) PetscInt :: numfaces_set
42) type(coupler_type), pointer :: next ! pointer to next coupler
43) end type coupler_type
44)
45) type, public :: coupler_ptr_type
46) type(coupler_type), pointer :: ptr
47) end type coupler_ptr_type
48)
49) type, public :: coupler_list_type
50) PetscInt :: num_couplers
51) type(coupler_type), pointer :: first
52) type(coupler_type), pointer :: last
53) type(coupler_ptr_type), pointer :: array(:)
54) end type coupler_list_type
55)
56) public :: CouplerCreate, &
57) CouplerDestroy, &
58) CouplerInitList, &
59) CouplerAddToList, &
60) CouplerRead, &
61) CouplerDestroyList, &
62) CouplerGetNumConnectionsInList, &
63) CouplerListComputeConnections, &
64) CouplerGetPtrFromList
65)
66) interface CouplerCreate
67) module procedure CouplerCreate1
68) module procedure CouplerCreate2
69) module procedure CouplerCreateFromCoupler
70) end interface
71)
72) contains
73)
74) ! ************************************************************************** !
75)
76) function CouplerCreate1()
77) !
78) ! CouplerCreate: Creates a coupler
79) !
80) ! Author: Glenn Hammond
81) ! Date: 10/23/07
82) !
83)
84) implicit none
85)
86) type(coupler_type), pointer :: CouplerCreate1
87)
88) type(coupler_type), pointer :: coupler
89)
90) allocate(coupler)
91) coupler%id = 0
92) coupler%name = ''
93) coupler%itype = BOUNDARY_COUPLER_TYPE
94) coupler%ctype = "boundary"
95) coupler%flow_condition_name = ""
96) coupler%tran_condition_name = ""
97) coupler%region_name = ""
98) coupler%iflow_condition = 0
99) coupler%itran_condition = 0
100) coupler%iregion = 0
101) coupler%iface = 0
102) nullify(coupler%flow_aux_mapping)
103) nullify(coupler%flow_bc_type)
104) nullify(coupler%flow_aux_int_var)
105) nullify(coupler%flow_aux_real_var)
106) nullify(coupler%flow_condition)
107) nullify(coupler%tran_condition)
108) nullify(coupler%region)
109) nullify(coupler%connection_set)
110) nullify(coupler%next)
111)
112) CouplerCreate1 => coupler
113)
114) end function CouplerCreate1
115)
116) ! ************************************************************************** !
117)
118) function CouplerCreate2(itype)
119) !
120) ! Creates a coupler
121) !
122) ! Author: Glenn Hammond
123) ! Date: 10/23/07
124) !
125)
126) implicit none
127)
128) PetscInt :: itype
129)
130) type(coupler_type), pointer :: CouplerCreate2
131)
132) type(coupler_type), pointer :: coupler
133)
134) coupler => CouplerCreate1()
135) coupler%itype = itype
136) select case(itype)
137) case(INITIAL_COUPLER_TYPE)
138) coupler%ctype = 'initial'
139) case(BOUNDARY_COUPLER_TYPE)
140) coupler%ctype = 'boundary'
141) case(SRC_SINK_COUPLER_TYPE)
142) coupler%ctype = 'source_sink'
143) end select
144)
145) CouplerCreate2 => coupler
146)
147) end function CouplerCreate2
148)
149) ! ************************************************************************** !
150)
151) function CouplerCreateFromCoupler(coupler)
152) !
153) ! Creates a coupler
154) !
155) ! Author: Glenn Hammond
156) ! Date: 10/23/07
157) !
158)
159) implicit none
160)
161) type(coupler_type), pointer :: coupler
162)
163) type(coupler_type), pointer :: CouplerCreateFromCoupler
164) type(coupler_type), pointer :: new_coupler
165)
166) new_coupler => CouplerCreate1()
167)
168) new_coupler%id = coupler%id
169) new_coupler%name = coupler%name
170) new_coupler%itype = coupler%itype
171) new_coupler%ctype = coupler%ctype
172) new_coupler%flow_condition_name = coupler%flow_condition_name
173) new_coupler%tran_condition_name = coupler%tran_condition_name
174) new_coupler%region_name = coupler%region_name
175) new_coupler%iflow_condition = coupler%iflow_condition
176) new_coupler%itran_condition = coupler%itran_condition
177) new_coupler%iregion = coupler%iregion
178) new_coupler%iface = coupler%iface
179)
180) ! these must remain null
181) nullify(coupler%flow_condition)
182) nullify(coupler%tran_condition)
183) nullify(coupler%region)
184) nullify(coupler%flow_aux_mapping)
185) nullify(coupler%flow_bc_type)
186) nullify(coupler%flow_aux_int_var)
187) nullify(coupler%flow_aux_real_var)
188) nullify(coupler%connection_set)
189) nullify(coupler%next)
190)
191) CouplerCreateFromCoupler => new_coupler
192)
193) end function CouplerCreateFromCoupler
194)
195) ! ************************************************************************** !
196)
197) subroutine CouplerInitList(list)
198) !
199) ! Initializes a coupler list
200) !
201) ! Author: Glenn Hammond
202) ! Date: 11/01/07
203) !
204)
205) implicit none
206)
207) type(coupler_list_type) :: list
208)
209) nullify(list%first)
210) nullify(list%last)
211) nullify(list%array)
212) list%num_couplers = 0
213)
214) end subroutine CouplerInitList
215)
216) ! ************************************************************************** !
217)
218) subroutine CouplerRead(coupler,input,option)
219) !
220) ! Reads a coupler from the input file
221) !
222) ! Author: Glenn Hammond
223) ! Date: 11/01/07
224) !
225)
226) use Input_Aux_module
227) use String_module
228) use Option_module
229)
230) implicit none
231)
232) type(option_type) :: option
233) type(coupler_type) :: coupler
234) type(input_type), pointer :: input
235)
236) character(len=MAXWORDLENGTH) :: word
237)
238) input%ierr = 0
239) do
240)
241) call InputReadPflotranString(input,option)
242) if (InputError(input)) exit
243) if (InputCheckExit(input,option)) exit
244)
245) call InputReadWord(input,option,word,PETSC_TRUE)
246) call InputErrorMsg(input,option,'keyword','COUPLER')
247) call StringToUpper(word)
248)
249) select case(trim(word))
250)
251) case('REGION','SURF_REGION')
252) call InputReadWord(input,option,coupler%region_name,PETSC_TRUE)
253) case('FLOW_CONDITION','SURF_FLOW_CONDITION')
254) call InputReadWord(input,option,coupler%flow_condition_name,PETSC_TRUE)
255) case('TRANSPORT_CONDITION')
256) call InputReadWord(input,option,coupler%tran_condition_name,PETSC_TRUE)
257) case default
258) call InputKeywordUnrecognized(word,'coupler ',option)
259) end select
260)
261) enddo
262)
263) end subroutine CouplerRead
264)
265) ! ************************************************************************** !
266)
267) subroutine CouplerAddToList(new_coupler,list)
268) !
269) ! Adds a new coupler to a coupler list
270) !
271) ! Author: Glenn Hammond
272) ! Date: 11/01/07
273) !
274)
275) implicit none
276)
277) type(coupler_type), pointer :: new_coupler
278) type(coupler_list_type) :: list
279)
280) list%num_couplers = list%num_couplers + 1
281) new_coupler%id = list%num_couplers
282) if (.not.associated(list%first)) list%first => new_coupler
283) if (associated(list%last)) list%last%next => new_coupler
284) list%last => new_coupler
285)
286) end subroutine CouplerAddToList
287)
288) ! ************************************************************************** !
289)
290) subroutine CouplerListComputeConnections(grid,option,coupler_list)
291) !
292) ! computes connectivity for a list of couplers
293) !
294) ! Author: Glenn Hammond
295) ! Date: 02/20/08
296) !
297)
298) use Option_module
299) use Grid_module
300)
301) implicit none
302)
303) type(grid_type) :: grid
304) type(option_type) :: option
305) type(coupler_list_type), pointer :: coupler_list
306)
307) type(coupler_type), pointer :: coupler
308) PetscInt :: offset
309)
310) if (.not.associated(coupler_list)) return
311)
312) offset = 0
313) coupler => coupler_list%first
314) do
315) if (.not.associated(coupler)) exit
316) call CouplerComputeConnections(grid,option,coupler)
317) if (associated(coupler%connection_set)) then
318) coupler%connection_set%offset = offset
319) offset = offset + coupler%connection_set%num_connections
320) endif
321) coupler => coupler%next
322) enddo
323)
324) end subroutine CouplerListComputeConnections
325)
326) ! ************************************************************************** !
327)
328) subroutine CouplerComputeConnections(grid,option,coupler)
329) !
330) ! computes connectivity coupler to a grid
331) !
332) ! Author: Glenn Hammond
333) ! Date: 02/20/08
334) !
335)
336) use Connection_module
337) use Option_module
338) use Region_module
339) use Grid_module
340) use Dataset_Base_class
341) use Dataset_Gridded_HDF5_class
342) use Grid_Unstructured_Aux_module
343) use Grid_Unstructured_Explicit_module, only : UGridExplicitSetBoundaryConnect, &
344) UGridExplicitSetConnections
345)
346) implicit none
347)
348) type(grid_type) :: grid
349) type(option_type) :: option
350) type(coupler_type), pointer :: coupler_list
351)
352) PetscInt :: iconn
353) PetscInt :: cell_id_local, cell_id_ghosted
354) PetscInt :: connection_itype
355) PetscInt :: iface
356) type(connection_set_type), pointer :: connection_set
357) type(region_type), pointer :: region
358) type(coupler_type), pointer :: coupler
359) PetscBool :: nullify_connection_set
360) PetscErrorCode :: ierr
361)
362) if (.not.associated(coupler)) return
363)
364) nullify_connection_set = PETSC_FALSE
365) select case(coupler%itype)
366) case(INITIAL_COUPLER_TYPE)
367) if (associated(coupler%flow_condition)) then
368) if (associated(coupler%flow_condition%pressure)) then
369) if (coupler%flow_condition%pressure%itype /= HYDROSTATIC_BC .and. &
370) coupler%flow_condition%pressure%itype /= SEEPAGE_BC .and. &
371) coupler%flow_condition%pressure%itype /= CONDUCTANCE_BC) then
372) select type(selector => coupler%flow_condition%pressure%dataset)
373) class is(dataset_gridded_hdf5_type)
374) class default
375) nullify_connection_set = PETSC_TRUE
376) end select
377) endif
378) else if (associated(coupler%flow_condition%concentration)) then
379) ! need to calculate connection set
380) endif
381) !geh: this is a workaround for defining temperature with a gridded
382) ! dataset. still need to set up the connections.
383) if (associated(coupler%flow_condition%temperature)) then
384) select type(selector => coupler%flow_condition%temperature%dataset)
385) class is(dataset_gridded_hdf5_type)
386) nullify_connection_set = PETSC_FALSE
387) end select
388) endif
389) else
390) nullify_connection_set = PETSC_TRUE
391) endif
392) connection_itype = INITIAL_CONNECTION_TYPE
393) case(SRC_SINK_COUPLER_TYPE)
394) connection_itype = SRC_SINK_CONNECTION_TYPE
395) case(BOUNDARY_COUPLER_TYPE)
396) connection_itype = BOUNDARY_CONNECTION_TYPE
397) end select
398)
399) if (nullify_connection_set) then
400) nullify(coupler%connection_set)
401) return
402) endif
403)
404) region => coupler%region
405)
406) select case(grid%itype)
407) case(EXPLICIT_UNSTRUCTURED_GRID)
408) if (associated(region%explicit_faceset)) then
409) connection_set => &
410) UGridExplicitSetBoundaryConnect(grid%unstructured_grid% &
411) explicit_grid, &
412) region%cell_ids, &
413) region%explicit_faceset%face_centroids, &
414) region%explicit_faceset%face_areas, &
415) region%name,option)
416) else
417) connection_set => &
418) UGridExplicitSetConnections(grid%unstructured_grid% &
419) explicit_grid, &
420) region%cell_ids, &
421) connection_itype,option)
422) endif
423) case default
424) connection_set => ConnectionCreate(region%num_cells,connection_itype)
425)
426) ! if using higher order advection, allocate associated arrays
427) if (option%itranmode == EXPLICIT_ADVECTION .and. &
428) option%transport%tvd_flux_limiter /= 1 .and. & ! 1 = upwind
429) connection_set%itype == BOUNDARY_CONNECTION_TYPE) then
430) ! connections%id_up2 should remain null as it will not be used
431) allocate(connection_set%id_dn2(size(connection_set%id_dn)))
432) connection_set%id_dn2 = 0
433) endif
434)
435) iface = coupler%iface
436) do iconn = 1,region%num_cells
437)
438) cell_id_local = region%cell_ids(iconn)
439) if (associated(region%faces)) iface = region%faces(iconn)
440)
441) connection_set%id_dn(iconn) = cell_id_local
442)
443) call GridPopulateConnection(grid,connection_set,iface,iconn, &
444) cell_id_local,option)
445) enddo
446) end select
447)
448) coupler%connection_set => connection_set
449) nullify(connection_set)
450)
451) end subroutine CouplerComputeConnections
452)
453) ! ************************************************************************** !
454)
455) function CouplerGetNumConnectionsInList(list)
456) !
457) ! Returns the number of connections associated
458) ! with all couplers in the list
459) !
460) ! Author: Glenn Hammond
461) ! Date: 11/19/07
462) !
463)
464) implicit none
465)
466) type(coupler_list_type) :: list
467)
468) PetscInt :: CouplerGetNumConnectionsInList
469) type(coupler_type), pointer :: coupler
470)
471) CouplerGetNumConnectionsInList = 0
472) coupler => list%first
473)
474) do
475) if (.not.associated(coupler)) exit
476) CouplerGetNumConnectionsInList = CouplerGetNumConnectionsInList + &
477) coupler%connection_set%num_connections
478) coupler => coupler%next
479) enddo
480)
481) end function CouplerGetNumConnectionsInList
482)
483) ! ************************************************************************** !
484)
485) function CouplerGetPtrFromList(coupler_name,coupler_list)
486) !
487) ! Returns a pointer to the coupler matching
488) ! coupler_name
489) !
490) ! Author: Glenn Hammond
491) ! Date: 11/01/07
492) !
493)
494) use String_module
495)
496) implicit none
497)
498) type(coupler_type), pointer :: CouplerGetPtrFromList
499) character(len=MAXWORDLENGTH) :: coupler_name
500) PetscInt :: length
501) type(coupler_list_type) :: coupler_list
502)
503) type(coupler_type), pointer :: coupler
504)
505) nullify(CouplerGetPtrFromList)
506)
507) coupler => coupler_list%first
508) do
509) if (.not.associated(coupler)) exit
510) length = len_trim(coupler_name)
511) if (length == len_trim(coupler%name) .and. &
512) StringCompare(coupler%name,coupler_name,length)) then
513) CouplerGetPtrFromList => coupler
514) return
515) endif
516) coupler => coupler%next
517) enddo
518)
519) end function CouplerGetPtrFromList
520)
521) ! ************************************************************************** !
522)
523) subroutine CouplerDestroyList(coupler_list)
524) !
525) ! Deallocates a list of couplers
526) !
527) ! Author: Glenn Hammond
528) ! Date: 11/01/07
529) !
530)
531) implicit none
532)
533) type(coupler_list_type), pointer :: coupler_list
534)
535) type(coupler_type), pointer :: coupler, prev_coupler
536)
537) if (.not.associated(coupler_list)) return
538)
539) coupler => coupler_list%first
540) do
541) if (.not.associated(coupler)) exit
542) prev_coupler => coupler
543) coupler => coupler%next
544) call CouplerDestroy(prev_coupler)
545) enddo
546)
547) coupler_list%num_couplers = 0
548) nullify(coupler_list%first)
549) nullify(coupler_list%last)
550) if (associated(coupler_list%array)) deallocate(coupler_list%array)
551) nullify(coupler_list%array)
552)
553) deallocate(coupler_list)
554) nullify(coupler_list)
555)
556) end subroutine CouplerDestroyList
557)
558) ! ************************************************************************** !
559)
560) subroutine CouplerDestroy(coupler)
561) !
562) ! Destroys a coupler
563) !
564) ! Author: Glenn Hammond
565) ! Date: 10/23/07
566) !
567) use Utility_module, only : DeallocateArray
568)
569) implicit none
570)
571) type(coupler_type), pointer :: coupler
572)
573) if (.not.associated(coupler)) return
574)
575) ! since the below are simply pointers to objects in list that have already
576) ! or will be deallocated from the list, nullify instead of destroying
577)
578) nullify(coupler%flow_condition) ! since these are simply pointers to
579) nullify(coupler%tran_condition) ! since these are simply pointers to
580) nullify(coupler%region) ! conditoins in list, nullify
581)
582) call DeallocateArray(coupler%flow_aux_mapping)
583) call DeallocateArray(coupler%flow_bc_type)
584) call DeallocateArray(coupler%flow_aux_int_var)
585) call DeallocateArray(coupler%flow_aux_real_var)
586)
587) call ConnectionDestroy(coupler%connection_set)
588) nullify(coupler%connection_set)
589)
590) deallocate(coupler)
591) nullify(coupler)
592)
593) end subroutine CouplerDestroy
594)
595) end module Coupler_module