realization_surface.F90 coverage: 85.00 %func 67.87 %block
1) module Realization_Surface_class
2)
3) use Realization_Base_class
4)
5) use Condition_module
6) use Debug_module
7) use Discretization_module
8) use Input_Aux_module
9) use Option_module
10) use Patch_module
11) use Region_module
12) use Surface_Field_module
13) use Surface_Material_module
14) use Dataset_Base_class
15) use Reaction_Aux_module
16) use Output_Aux_module
17)
18) use PFLOTRAN_Constants_module
19)
20) implicit none
21)
22) private
23)
24)
25) #include "petsc/finclude/petscsys.h"
26)
27) PetscReal, parameter :: eps = 1.D-8
28)
29) type, public, extends(realization_base_type) :: realization_surface_type
30)
31) type(surface_field_type), pointer :: surf_field
32) type(region_list_type), pointer :: surf_regions
33) type(condition_list_type),pointer :: surf_flow_conditions
34) type(tran_condition_list_type),pointer :: surf_transport_conditions
35) type(surface_material_property_type), pointer :: surf_material_properties
36) type(surface_material_property_ptr_type), pointer :: surf_material_property_array(:)
37) type(reaction_type), pointer :: surf_reaction
38) character(len=MAXSTRINGLENGTH) :: surf_filename
39) character(len=MAXSTRINGLENGTH) :: subsurf_filename
40)
41) class(dataset_base_type), pointer :: datasets
42)
43) PetscReal :: dt_max
44) PetscReal :: dt_init
45) PetscReal :: dt_coupling
46)
47) PetscInt :: iter_count
48) PetscBool :: first_time
49)
50) end type realization_surface_type
51)
52) ! 123456789+123456789+123456789+1
53) public :: RealizSurfCreate, &
54) RealizSurfDestroy, &
55) RealizSurfStrip, &
56) RealizSurfAddWaypointsToList, &
57) RealizSurfCreateDiscretization, &
58) RealizSurfAddCoupler, &
59) RealizSurfAddStrata, &
60) RealizSurfLocalizeRegions, &
61) RealizSurfPassFieldPtrToPatches, &
62) RealizSurfProcessCouplers, &
63) RealizSurfLocalToLocalWithArray, &
64) RealizSurfProcessConditions, &
65) RealizSurfProcessFlowConditions, &
66) RealizSurfMapSurfSubsurfGrids, &
67) RealizSurfInitAllCouplerAuxVars, &
68) RealizSurfAllCouplerAuxVars, &
69) RealizSurfProcessMatProp, &
70) RealizSurfUpdate, &
71) ! RealizSurfCreateSurfSubsurfVec, &
72) ! RealizSurfUpdateSubsurfBC, &
73) ! RealizSurfUpdateSurfBC, &
74) ! RealizSurfSurf2SubsurfFlux, &
75) RealizSurfGetVariable
76)
77) !TODO(intel)
78) ! public :: SurfaceRealizationGetVariable
79)
80) ! interface SurfaceRealizationGetVariable
81) ! module procedure :: RealizationGetVariable ! from Realization_Base_class
82) ! end interface
83)
84) contains
85)
86) ! ************************************************************************** !
87)
88) function RealizSurfCreate(option)
89) !
90) ! This routine allocates and initializes a new SurfaceRealization object
91) !
92) ! Author: Gautam Bisht, ORNL
93) ! Date: 02/16/12
94) !
95)
96) implicit none
97)
98) type(option_type), pointer :: option
99) class(realization_surface_type),pointer :: RealizSurfCreate
100) class(realization_surface_type),pointer :: surf_realization
101)
102) allocate(surf_realization)
103) call RealizationBaseInit(surf_realization,option)
104) surf_realization%option => option
105) nullify(surf_realization%input)
106)
107) surf_realization%surf_field => SurfaceFieldCreate()
108) !geh: debug, output_option, patch_list already allocated in
109) ! RealizationBaseInit()
110) !geh: surf_realization%debug => DebugCreate()
111) !geh: surf_realization%output_option => OutputOptionCreate()
112) !geh: surf_realization%patch_list => PatchCreateList()
113)
114) nullify(surf_realization%surf_material_properties)
115) nullify(surf_realization%surf_material_property_array)
116)
117) allocate(surf_realization%surf_regions)
118) call RegionInitList(surf_realization%surf_regions)
119)
120) allocate(surf_realization%surf_flow_conditions)
121) call FlowConditionInitList(surf_realization%surf_flow_conditions)
122) allocate(surf_realization%surf_transport_conditions)
123) call TranConditionInitList(surf_realization%surf_transport_conditions)
124)
125) nullify(surf_realization%surf_reaction)
126) nullify(surf_realization%datasets)
127)
128) surf_realization%iter_count = 0
129) surf_realization%dt_init = 1.d0
130) surf_realization%dt_max = 1.d0
131) surf_realization%dt_coupling = 0.d0
132)
133) surf_realization%first_time = PETSC_TRUE
134) RealizSurfCreate => surf_realization
135)
136) end function RealizSurfCreate
137)
138) ! ************************************************************************** !
139)
140) subroutine RealizSurfAddCoupler(surf_realization,coupler)
141) !
142) ! This routine adds a copy of a coupler to a list
143) !
144) ! Author: Gautam Bisht, ORNL
145) ! Date: 02/10/12
146) !
147)
148) use Coupler_module
149)
150) implicit none
151)
152) class(realization_surface_type) :: surf_realization
153) type(coupler_type), pointer :: coupler
154)
155) type(patch_type), pointer :: cur_patch
156) type(coupler_type), pointer :: new_coupler
157)
158) cur_patch => surf_realization%patch_list%first
159) do
160) if (.not.associated(cur_patch)) exit
161) ! only add to flow list for now, since they will be split out later
162) new_coupler => CouplerCreate(coupler)
163) select case(coupler%itype)
164) case(BOUNDARY_COUPLER_TYPE)
165) call CouplerAddToList(new_coupler,cur_patch%boundary_condition_list)
166) case(INITIAL_COUPLER_TYPE)
167) call CouplerAddToList(new_coupler,cur_patch%initial_condition_list)
168) case(SRC_SINK_COUPLER_TYPE)
169) call CouplerAddToList(new_coupler,cur_patch%source_sink_list)
170) end select
171) nullify(new_coupler)
172) cur_patch => cur_patch%next
173) enddo
174)
175) call CouplerDestroy(coupler)
176)
177) end subroutine RealizSurfAddCoupler
178)
179) ! ************************************************************************** !
180)
181) subroutine RealizSurfProcessCouplers(surf_realization)
182) !
183) ! This routine sets connectivity and pointers for couplers related to
184) ! surface flow.
185) !
186) ! Author: Gautam Bisht, ORNL
187) ! Date: 02/17/12
188) !
189)
190) use Option_module
191)
192) implicit none
193)
194) class(realization_surface_type) :: surf_realization
195) type(patch_type), pointer :: cur_patch
196)
197) cur_patch => surf_realization%patch_list%first
198) do
199) if (.not.associated(cur_patch)) exit
200) call PatchProcessCouplers(cur_patch,surf_realization%surf_flow_conditions, &
201) surf_realization%surf_transport_conditions, &
202) surf_realization%option)
203) cur_patch => cur_patch%next
204) enddo
205)
206) end subroutine RealizSurfProcessCouplers
207)
208) ! ************************************************************************** !
209)
210) subroutine RealizSurfProcessMatProp(surf_realization)
211) !
212) ! This routine sets up linkeage between surface material properties
213) !
214) ! Author: Gautam Bisht, ORNL
215) ! Date: 02/17/12
216) !
217)
218) use String_module
219)
220) implicit none
221)
222) class(realization_surface_type) :: surf_realization
223)
224) PetscBool :: found
225) PetscInt :: i
226) type(option_type), pointer :: option
227) character(len=MAXSTRINGLENGTH) :: string
228)
229) type(patch_type), pointer :: cur_patch
230)
231) option => surf_realization%option
232)
233) ! organize lists
234) call SurfaceMaterialPropConvertListToArray( &
235) surf_realization%surf_material_properties, &
236) surf_realization%surf_material_property_array, &
237) option)
238)
239) ! set up mirrored pointer arrays within patches to saturation functions
240) ! and material properties
241) cur_patch => surf_realization%patch_list%first
242) do
243) if (.not.associated(cur_patch)) exit
244) cur_patch%surf_material_properties => surf_realization%surf_material_properties
245) call SurfaceMaterialPropConvertListToArray( &
246) cur_patch%surf_material_properties, &
247) cur_patch%surf_material_property_array, &
248) option)
249) ! create mapping of internal to external material id
250) call SurfaceMaterialCreateIntToExtMapping(cur_patch%surf_material_property_array, &
251) cur_patch%imat_internal_to_external)
252)
253) cur_patch => cur_patch%next
254) enddo
255)
256) end subroutine RealizSurfProcessMatProp
257)
258) ! ************************************************************************** !
259)
260) subroutine RealizSurfLocalizeRegions(surf_realization)
261) !
262) ! This routine localizes surface regions within each patch
263) ! (similar to RealizationLocalizeRegions)
264) !
265) ! Author: Gautam Bisht, ORNL
266) ! Date: 02/17/12
267) !
268)
269) use Option_module
270) use String_module
271) use Grid_module
272)
273) implicit none
274)
275) class(realization_surface_type) :: surf_realization
276)
277) type(patch_type), pointer :: cur_patch
278) type (region_type), pointer :: cur_region
279) type(option_type), pointer :: option
280) type(region_type), pointer :: patch_region
281)
282) option => surf_realization%option
283)
284) ! localize the regions on each patch
285) cur_patch => surf_realization%patch_list%first
286) do
287) if (.not.associated(cur_patch)) exit
288) call PatchLocalizeRegions(cur_patch,surf_realization%surf_regions, &
289) surf_realization%option)
290) cur_patch => cur_patch%next
291) enddo
292)
293) end subroutine RealizSurfLocalizeRegions
294)
295) ! ************************************************************************** !
296)
297) subroutine RealizSurfAddStrata(surf_realization,strata)
298) !
299) ! This routine adds a copy of a strata to a list
300) !
301) ! Author: Gautam Bisht, ORNL
302) ! Date: 02/17/12
303) !
304)
305) use Strata_module
306)
307) implicit none
308)
309) class(realization_surface_type) :: surf_realization
310) type(strata_type), pointer :: strata
311)
312) type(patch_type), pointer :: cur_patch
313) type(strata_type), pointer :: new_strata
314)
315) cur_patch => surf_realization%patch_list%first
316) do
317) if (.not.associated(cur_patch)) exit
318) new_strata => StrataCreate(strata)
319) call StrataAddToList(new_strata,cur_patch%strata_list)
320) nullify(new_strata)
321) cur_patch => cur_patch%next
322) enddo
323)
324) call StrataDestroy(strata)
325)
326) end subroutine RealizSurfAddStrata
327)
328) ! ************************************************************************** !
329)
330) subroutine RealizSurfCreateDiscretization(surf_realization)
331) !
332) ! This routine creates grid
333) !
334) ! Author: Gautam Bisht, ORNL
335) ! Date: 02/17/12
336) !
337)
338) use Grid_module
339) use Grid_Unstructured_Aux_module, only : UGridMapIndices
340) use Grid_Unstructured_module, only : UGridEnsureRightHandRule
341) use Coupler_module
342) use Discretization_module
343) use Grid_Unstructured_Cell_module
344) use DM_Kludge_module
345)
346) implicit none
347)
348) class(realization_surface_type) :: surf_realization
349) type(discretization_type), pointer :: discretization
350) type(grid_type), pointer :: grid
351) type(surface_field_type), pointer :: surf_field
352) type(option_type), pointer :: option
353) type(dm_ptr_type), pointer :: dm_ptr
354)
355) PetscErrorCode :: ierr
356)
357) option => surf_realization%option
358) surf_field => surf_realization%surf_field
359) discretization => surf_realization%discretization
360)
361) call DiscretizationCreateDMs(discretization, option%nsurfflowdof, &
362) ZERO_INTEGER, ZERO_INTEGER, &
363) ZERO_INTEGER, ZERO_INTEGER, &
364) option)
365)
366) ! n degree of freedom, global
367) call DiscretizationCreateVector(discretization,NFLOWDOF,surf_field%flow_xx, &
368) GLOBAL,option)
369) call VecSet(surf_field%flow_xx,0.d0,ierr);CHKERRQ(ierr)
370)
371) call DiscretizationDuplicateVector(discretization,surf_field%flow_xx, &
372) surf_field%flow_yy)
373) call DiscretizationDuplicateVector(discretization,surf_field%flow_xx, &
374) surf_field%flow_dxx)
375) call DiscretizationDuplicateVector(discretization,surf_field%flow_xx, &
376) surf_field%flow_r)
377) call DiscretizationDuplicateVector(discretization,surf_field%flow_xx, &
378) surf_field%flow_accum)
379) call DiscretizationDuplicateVector(discretization,surf_field%flow_xx, &
380) surf_field%work)
381)
382) ! 1 degree of freedom, global
383) call DiscretizationCreateVector(discretization,ONEDOF,surf_field%mannings0, &
384) GLOBAL,option)
385) call VecSet(surf_field%mannings0,0.d0,ierr);CHKERRQ(ierr)
386)
387) call DiscretizationDuplicateVector(discretization,surf_field%mannings0, &
388) surf_field%area)
389) call DiscretizationDuplicateVector(discretization,surf_field%mannings0, &
390) surf_field%press_subsurf)
391) call DiscretizationDuplicateVector(discretization,surf_field%mannings0, &
392) surf_field%temp_subsurf)
393) ! n degrees of freedom, local
394) call DiscretizationCreateVector(discretization,NFLOWDOF,surf_field%flow_xx_loc, &
395) LOCAL,option)
396) call VecSet(surf_field%flow_xx_loc,0.d0,ierr);CHKERRQ(ierr)
397) call DiscretizationDuplicateVector(discretization,surf_field%flow_xx_loc, &
398) surf_field%work_loc)
399)
400) ! 1-dof degrees of freedom, local
401) call DiscretizationCreateVector(discretization,ONEDOF,surf_field%mannings_loc, &
402) LOCAL,option)
403) call VecSet(surf_field%mannings_loc,0.d0,ierr);CHKERRQ(ierr)
404)
405) grid => discretization%grid
406)
407) ! set up nG2L, NL2G, etc.
408) call UGridMapIndices(grid%unstructured_grid,discretization%dm_1dof%ugdm, &
409) grid%nG2L,grid%nL2G,grid%nG2A,option)
410) call GridComputeCoordinates(grid,discretization%origin_global,option, &
411) discretization%dm_1dof%ugdm)
412) call UGridEnsureRightHandRule(grid%unstructured_grid,grid%x, &
413) grid%y,grid%z,grid%nG2A,grid%nL2G,option)
414)
415) ! set up internal connectivity, distance, etc.
416) call GridComputeInternalConnect(grid,option,discretization%dm_1dof%ugdm)
417) call GridComputeAreas(grid,surf_field%area,option)
418)
419) ! Allocate vectors to hold flowrate quantities
420) if (surf_realization%output_option%print_hdf5_mass_flowrate.or. &
421) surf_realization%output_option%print_hdf5_energy_flowrate.or. &
422) surf_realization%output_option%print_hdf5_aveg_mass_flowrate.or. &
423) surf_realization%output_option%print_hdf5_aveg_energy_flowrate) then
424)
425) call VecCreateMPI(option%mycomm, &
426) (option%nflowdof*MAX_FACE_PER_CELL_SURF+1)*surf_realization%patch%grid%nlmax, &
427) PETSC_DETERMINE,surf_field%flowrate_inst,ierr);CHKERRQ(ierr)
428) call VecSet(surf_field%flowrate_inst,0.d0,ierr);CHKERRQ(ierr)
429)
430) ! If average flowrate has to be saved, create a vector for it
431) if (surf_realization%output_option%print_hdf5_aveg_mass_flowrate.or. &
432) surf_realization%output_option%print_hdf5_aveg_energy_flowrate) then
433) call VecCreateMPI(option%mycomm, &
434) (option%nflowdof*MAX_FACE_PER_CELL_SURF+1)*surf_realization%patch%grid%nlmax, &
435) PETSC_DETERMINE,surf_field%flowrate_aveg,ierr);CHKERRQ(ierr)
436) call VecSet(surf_field%flowrate_aveg,0.d0,ierr);CHKERRQ(ierr)
437) endif
438) endif
439)
440) end subroutine RealizSurfCreateDiscretization
441)
442) ! ************************************************************************** !
443)
444) subroutine RealizSurfPassFieldPtrToPatches(surf_realization)
445) !
446) ! This routine
447) !
448) ! Author: Gautam Bisht, ORNL
449) ! Date: 02/19/12
450) !
451)
452) use Option_module
453)
454) implicit none
455)
456) class(realization_surface_type) :: surf_realization
457)
458) type(patch_type), pointer :: cur_patch
459)
460) cur_patch => surf_realization%patch_list%first
461) do
462) if (.not.associated(cur_patch)) exit
463) cur_patch%surf_field => surf_realization%surf_field
464) cur_patch => cur_patch%next
465) enddo
466)
467) end subroutine RealizSurfPassFieldPtrToPatches
468)
469) ! ************************************************************************** !
470)
471) subroutine RealizSurfProcessConditions(surf_realization)
472) !
473) ! This routine
474) !
475) ! Author: Gautam Bisht, ORNL
476) ! Date: 02/19/12
477) !
478)
479) implicit none
480)
481) class(realization_surface_type) :: surf_realization
482)
483) if (surf_realization%option%nflowdof > 0) then
484) call RealizSurfProcessFlowConditions(surf_realization)
485) endif
486) if (surf_realization%option%ntrandof > 0) then
487) !call SurfaceRealProcessTranConditions(surf_realization)
488) endif
489)
490) end subroutine RealizSurfProcessConditions
491)
492) ! ************************************************************************** !
493)
494) subroutine RealizSurfLocalToLocalWithArray(surf_realization,array_id)
495) !
496) ! This routine takes an F90 array that is ghosted and updates the ghosted
497) ! values (similar to RealLocalToLocalWithArray)
498) !
499) ! Author: Gautam Bisht, ORNL
500) ! Date: 02/13/12
501) !
502)
503) use Grid_module
504) use Surface_Field_module
505)
506) implicit none
507)
508) class(realization_surface_type) :: surf_realization
509) PetscInt :: array_id
510)
511) type(patch_type), pointer :: cur_patch
512) type(grid_type), pointer :: grid
513) type(surface_field_type), pointer :: surf_field
514)
515) surf_field => surf_realization%surf_field
516)
517) cur_patch => surf_realization%patch_list%first
518) do
519) if (.not.associated(cur_patch)) exit
520) grid => cur_patch%grid
521) select case(array_id)
522) case(MATERIAL_ID_ARRAY)
523) call GridCopyIntegerArrayToVec(grid, cur_patch%imat,surf_field%work_loc, &
524) grid%ngmax)
525) end select
526) cur_patch => cur_patch%next
527) enddo
528) call DiscretizationLocalToLocal(surf_realization%discretization, &
529) surf_field%work_loc, &
530) surf_field%work_loc,ONEDOF)
531) cur_patch => surf_realization%patch_list%first
532) do
533) if (.not.associated(cur_patch)) exit
534) grid => cur_patch%grid
535)
536) select case(array_id)
537) case(MATERIAL_ID_ARRAY)
538) call GridCopyVecToIntegerArray(grid, cur_patch%imat,surf_field%work_loc, &
539) grid%ngmax)
540) end select
541) cur_patch => cur_patch%next
542) enddo
543)
544) end subroutine RealizSurfLocalToLocalWithArray
545)
546) ! ************************************************************************** !
547)
548) subroutine RealizSurfProcessFlowConditions(surf_realization)
549) !
550) ! This routine sets linkage of flow conditions to dataset
551) !
552) ! Author: Gautam Bisht, ORNL
553) ! Date: 02/20/12
554) !
555)
556) use Dataset_Base_class
557) use Dataset_module
558)
559) implicit none
560)
561) class(realization_surface_type) :: surf_realization
562)
563) type(flow_condition_type), pointer :: cur_surf_flow_condition
564) type(flow_sub_condition_type), pointer :: cur_surf_flow_sub_condition
565) type(option_type), pointer :: option
566) character(len=MAXSTRINGLENGTH) :: string
567) character(len=MAXWORDLENGTH) :: dataset_name
568) class(dataset_base_type), pointer :: dataset
569) PetscInt :: i
570)
571) option => surf_realization%option
572)
573) ! loop over flow conditions looking for linkage to datasets
574) cur_surf_flow_condition => surf_realization%surf_flow_conditions%first
575) do
576) if (.not.associated(cur_surf_flow_condition)) exit
577) string = 'flow_condition ' // trim(cur_surf_flow_condition%name)
578) ! find datum dataset
579) call DatasetFindInList(surf_realization%datasets, &
580) cur_surf_flow_condition%datum, &
581) cur_surf_flow_condition%default_time_storage, &
582) string,option)
583) select case(option%iflowmode)
584) case(RICHARDS_MODE,TH_MODE)
585) do i = 1, size(cur_surf_flow_condition%sub_condition_ptr)
586) ! find dataset
587) call DatasetFindInList(surf_realization%datasets, &
588) cur_surf_flow_condition%sub_condition_ptr(i)%ptr%dataset, &
589) cur_surf_flow_condition%default_time_storage, &
590) string,option)
591) ! find gradient dataset
592) call DatasetFindInList(surf_realization%datasets, &
593) cur_surf_flow_condition%sub_condition_ptr(i)%ptr%gradient, &
594) cur_surf_flow_condition%default_time_storage, &
595) string,option)
596) enddo
597) case default
598) option%io_buffer='RealizSurfProcessFlowConditions not implemented in this mode'
599) call printErrMsg(option)
600) end select
601) cur_surf_flow_condition => cur_surf_flow_condition%next
602) enddo
603)
604) end subroutine RealizSurfProcessFlowConditions
605)
606) ! ************************************************************************** !
607)
608) subroutine RealizSurfInitAllCouplerAuxVars(surf_realization)
609) !
610) ! This routine initializez coupler auxillary variables within list
611) !
612) ! Author: Gautam Bisht, ORNL
613) ! Date: 02/21/12
614) !
615)
616) use Option_module
617)
618) implicit none
619)
620) class(realization_surface_type) :: surf_realization
621)
622) type(patch_type), pointer :: cur_patch
623)
624) call FlowConditionUpdate(surf_realization%surf_flow_conditions, &
625) surf_realization%option, &
626) surf_realization%option%time)
627)
628) cur_patch => surf_realization%patch_list%first
629) do
630) if (.not.associated(cur_patch)) exit
631) call PatchInitAllCouplerAuxVars(cur_patch, &
632) surf_realization%option)
633) cur_patch => cur_patch%next
634) enddo
635)
636) end subroutine RealizSurfInitAllCouplerAuxVars
637)
638) ! ************************************************************************** !
639)
640) subroutine RealizSurfAllCouplerAuxVars(surf_realization,force_update_flag)
641) !
642) ! This routine updates auxiliary variables associated with couplers in the
643) ! list.
644) !
645) ! Author: Gautam Bisht, LBNL
646) ! Date: 04/18/13
647) !
648)
649) use Option_module
650)
651) implicit none
652)
653) class(realization_surface_type) :: surf_realization
654) PetscBool :: force_update_flag
655)
656) call PatchUpdateAllCouplerAuxVars(surf_realization%patch,force_update_flag, &
657) surf_realization%option)
658)
659) end subroutine RealizSurfAllCouplerAuxVars
660)
661) ! ************************************************************************** !
662)
663) subroutine RealizSurfMapSurfSubsurfGrids(realization,surf_realization)
664) !
665) ! This routine creates vector scatter contexts between surface and subsurface
666) ! grids.
667) ! Algorithm:
668) ! - It uses a similar logic of Matrix-Vector multiplication used in
669) ! UGridMapSideSet() subroutine. The algorithm here is extended to use
670) ! Matrix-Matrix mulitplication
671) !
672) ! Author: Gautam Bisht, ORNL
673) ! Date: 01/17/12
674) !
675)
676) use Grid_module
677) use String_module
678) use Grid_Unstructured_module
679) use Grid_Unstructured_Aux_module
680) use Grid_Unstructured_Cell_module
681) use Realization_Subsurface_class
682) use Option_module
683) use Patch_module
684) use Region_module
685)
686) implicit none
687)
688) #include "petsc/finclude/petscvec.h"
689) #include "petsc/finclude/petscvec.h90"
690) #include "petsc/finclude/petscmat.h"
691) #include "petsc/finclude/petscmat.h90"
692)
693) class(realization_subsurface_type), pointer :: realization
694) class(realization_surface_type), pointer :: surf_realization
695)
696) type(option_type), pointer :: option
697) type(grid_unstructured_type),pointer :: subsurf_grid
698) type(grid_unstructured_type),pointer :: surf_grid
699) type(patch_type), pointer :: cur_patch
700) type(region_type), pointer :: cur_region, top_region
701) type(region_type), pointer :: patch_region
702)
703) Mat :: Mat_vert_to_face_subsurf
704) Mat :: Mat_vert_to_face_subsurf_transp
705) Mat :: Mat_vert_to_face_surf
706) Mat :: Mat_vert_to_face_surf_transp
707) Mat :: prod
708) Vec :: subsurf_petsc_ids, surf_petsc_ids
709)
710) PetscViewer :: viewer
711)
712)
713) character(len=MAXSTRINGLENGTH) :: string
714) PetscInt,pointer ::int_array(:)
715) PetscInt :: offset
716) PetscInt :: int_array4(4)
717) PetscInt :: int_array4_0(4,1)
718) PetscInt :: nvertices
719) PetscInt :: iface
720) PetscInt :: local_id, ii, jj
721) PetscInt :: cell_type
722) PetscInt :: ivertex, vertex_id_local
723) PetscReal :: real_array4(4)
724) PetscReal, pointer :: vec_ptr(:)
725)
726) PetscErrorCode :: ierr
727) PetscBool :: found
728)
729) found = PETSC_FALSE
730)
731) if (.not.associated(realization)) return
732)
733) option => realization%option
734) subsurf_grid => realization%discretization%grid%unstructured_grid
735) surf_grid => surf_realization%discretization%grid%unstructured_grid
736)
737) ! localize the regions on each patch
738) cur_patch => realization%patch_list%first
739) do
740) if (.not.associated(cur_patch)) exit
741) cur_region => cur_patch%region_list%first
742) do
743) if (.not.associated(cur_region)) exit
744) if (StringCompare(cur_region%name,'top')) then
745) found = PETSC_TRUE
746) top_region => cur_region
747) exit
748) endif
749) cur_region => cur_region%next
750) enddo
751) cur_patch => cur_patch%next
752) enddo
753)
754) if (found.eqv.PETSC_FALSE) then
755) option%io_buffer = 'When running with -DSURFACE_FLOW need to specify ' // &
756) ' in the inputfile explicitly region: top '
757) call printErrMsg(option)
758) endif
759)
760) call MatCreateAIJ(option%mycomm, &
761) top_region%num_cells, &
762) PETSC_DECIDE, &
763) PETSC_DETERMINE, &
764) subsurf_grid%num_vertices_global, &
765) 4, &
766) PETSC_NULL_INTEGER, &
767) 4, &
768) PETSC_NULL_INTEGER, &
769) Mat_vert_to_face_subsurf, &
770) ierr);CHKERRQ(ierr)
771)
772) call MatCreateAIJ(option%mycomm, &
773) PETSC_DECIDE, &
774) top_region%num_cells, &
775) subsurf_grid%num_vertices_global, &
776) PETSC_DETERMINE, &
777) 12, &
778) PETSC_NULL_INTEGER, &
779) 12, &
780) PETSC_NULL_INTEGER, &
781) Mat_vert_to_face_subsurf_transp, &
782) ierr);CHKERRQ(ierr)
783)
784) call VecCreateMPI(option%mycomm,top_region%num_cells,PETSC_DETERMINE, &
785) subsurf_petsc_ids,ierr);CHKERRQ(ierr)
786) call MatZeroEntries(Mat_vert_to_face_subsurf,ierr);CHKERRQ(ierr)
787) real_array4 = 1.d0
788)
789) call VecGetArrayF90(subsurf_petsc_ids,vec_ptr,ierr);CHKERRQ(ierr)
790)
791) offset=0
792) call MPI_Exscan(top_region%num_cells,offset, &
793) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
794)
795) do ii = 1, top_region%num_cells
796) local_id = top_region%cell_ids(ii)
797) vec_ptr(ii) = subsurf_grid%cell_ids_petsc(local_id)
798) iface = top_region%faces(ii)
799) cell_type = subsurf_grid%cell_type(local_id)
800) !nfaces = UCellGetNFaces(cell_type,option)
801)
802) call UCellGetNFaceVertsandVerts(option,cell_type,iface,nvertices, &
803) int_array4)
804) ! For this matrix:
805) ! irow = local face id
806) ! icol = natural (global) vertex id
807) do ivertex = 1, nvertices
808) vertex_id_local = &
809) subsurf_grid%cell_vertices(int_array4(ivertex),local_id)
810) int_array4_0(ivertex,1) = &
811) subsurf_grid%vertex_ids_natural(vertex_id_local)-1
812) enddo
813) call MatSetValues(Mat_vert_to_face_subsurf, &
814) 1,ii-1+offset, &
815) nvertices,int_array4_0, &
816) real_array4, &
817) INSERT_VALUES,ierr);CHKERRQ(ierr)
818) call MatSetValues(Mat_vert_to_face_subsurf_transp, &
819) nvertices,int_array4_0, &
820) 1,ii-1+offset, &
821) real_array4, &
822) INSERT_VALUES,ierr);CHKERRQ(ierr)
823) enddo
824)
825) call VecRestoreArrayF90(subsurf_petsc_ids,vec_ptr,ierr);CHKERRQ(ierr)
826)
827) call MatAssemblyBegin(Mat_vert_to_face_subsurf,MAT_FINAL_ASSEMBLY, &
828) ierr);CHKERRQ(ierr)
829) call MatAssemblyEnd(Mat_vert_to_face_subsurf,MAT_FINAL_ASSEMBLY, &
830) ierr);CHKERRQ(ierr)
831) call MatAssemblyBegin(Mat_vert_to_face_subsurf_transp,MAT_FINAL_ASSEMBLY, &
832) ierr);CHKERRQ(ierr)
833) call MatAssemblyEnd(Mat_vert_to_face_subsurf_transp,MAT_FINAL_ASSEMBLY, &
834) ierr);CHKERRQ(ierr)
835)
836) #if UGRID_DEBUG
837) string = 'Mat_vert_to_face_subsurf.out'
838) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
839) call MatView(Mat_vert_to_face_subsurf,viewer,ierr);CHKERRQ(ierr)
840) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
841) #endif
842)
843) !call MatTranspose(Mat_vert_to_face_subsurf,MAT_INITIAL_MATRIX, &
844) ! Mat_vert_to_face_subsurf_transp,ierr)
845)
846) #if UGRID_DEBUG
847) string = 'Mat_vert_to_face_subsurf_transp.out'
848) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
849) call MatView(Mat_vert_to_face_subsurf_transp,viewer,ierr);CHKERRQ(ierr)
850) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
851)
852) string = 'subsurf_petsc_ids.out'
853) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
854) call VecView(subsurf_petsc_ids,viewer,ierr);CHKERRQ(ierr)
855) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
856) #endif
857)
858) call MatCreateAIJ(option%mycomm, &
859) surf_grid%nlmax, &
860) PETSC_DECIDE, &
861) PETSC_DETERMINE, &
862) subsurf_grid%num_vertices_global, &
863) 4, &
864) PETSC_NULL_INTEGER, &
865) 4, &
866) PETSC_NULL_INTEGER, &
867) Mat_vert_to_face_surf, &
868) ierr);CHKERRQ(ierr)
869)
870) call MatCreateAIJ(option%mycomm, &
871) PETSC_DECIDE, &
872) surf_grid%nlmax, &
873) subsurf_grid%num_vertices_global, &
874) PETSC_DETERMINE, &
875) 12, &
876) PETSC_NULL_INTEGER, &
877) 12, &
878) PETSC_NULL_INTEGER, &
879) Mat_vert_to_face_surf_transp, &
880) ierr);CHKERRQ(ierr)
881)
882) call VecCreateMPI(option%mycomm,surf_grid%nlmax,PETSC_DETERMINE, &
883) surf_petsc_ids,ierr);CHKERRQ(ierr)
884) offset=0
885) call MPI_Exscan(surf_grid%nlmax,offset, &
886) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
887)
888) call VecGetArrayF90(surf_petsc_ids,vec_ptr,ierr);CHKERRQ(ierr)
889)
890) do local_id = 1, surf_grid%nlmax
891) cell_type = surf_grid%cell_type(local_id)
892) vec_ptr(local_id) = surf_grid%cell_ids_petsc(local_id)
893)
894) int_array4_0 = 0
895) nvertices = surf_grid%cell_vertices(0,local_id)
896) do ivertex = 1, nvertices
897) vertex_id_local = surf_grid%cell_vertices(ivertex,local_id)
898) int_array4_0(ivertex,1) = &
899) surf_grid%vertex_ids_natural(vertex_id_local)-1
900) enddo
901) call MatSetValues(Mat_vert_to_face_surf,1,local_id-1+offset, &
902) nvertices,int_array4_0,real_array4, &
903) INSERT_VALUES,ierr);CHKERRQ(ierr)
904) call MatSetValues(Mat_vert_to_face_surf_transp, &
905) nvertices,int_array4_0, &
906) 1,local_id-1+offset, &
907) real_array4, &
908) INSERT_VALUES,ierr);CHKERRQ(ierr)
909) enddo
910)
911) call VecRestoreArrayF90(surf_petsc_ids,vec_ptr,ierr);CHKERRQ(ierr)
912)
913) call MatAssemblyBegin(Mat_vert_to_face_surf,MAT_FINAL_ASSEMBLY, &
914) ierr);CHKERRQ(ierr)
915) call MatAssemblyEnd(Mat_vert_to_face_surf,MAT_FINAL_ASSEMBLY, &
916) ierr);CHKERRQ(ierr)
917)
918) call MatAssemblyBegin(Mat_vert_to_face_surf_transp,MAT_FINAL_ASSEMBLY, &
919) ierr);CHKERRQ(ierr)
920) call MatAssemblyEnd(Mat_vert_to_face_surf_transp,MAT_FINAL_ASSEMBLY, &
921) ierr);CHKERRQ(ierr)
922)
923) #if UGRID_DEBUG
924) string = 'Mat_vert_to_face_surf.out'
925) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
926) call MatView(Mat_vert_to_face_surf,viewer,ierr);CHKERRQ(ierr)
927) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
928)
929) string = 'surf_petsc_ids.out'
930) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
931) call VecView(surf_petsc_ids,viewer,ierr);CHKERRQ(ierr)
932) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
933) #endif
934)
935) !call MatTranspose(Mat_vert_to_face_surf,MAT_INITIAL_MATRIX, &
936) ! Mat_vert_to_face_surf_transp,ierr)
937)
938) #if UGRID_DEBUG
939) string = 'Mat_vert_to_face_surf_transp.out'
940) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
941) call MatView(Mat_vert_to_face_surf_transp,viewer,ierr);CHKERRQ(ierr)
942) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
943) #endif
944)
945) call MatMatMult(Mat_vert_to_face_subsurf,Mat_vert_to_face_surf_transp, &
946) MAT_INITIAL_MATRIX,PETSC_DEFAULT_REAL,prod, &
947) ierr);CHKERRQ(ierr)
948)
949) #if UGRID_DEBUG
950) string = 'prod.out'
951) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
952) call MatView(prod,viewer,ierr);CHKERRQ(ierr)
953) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
954) #endif
955)
956) call RealizSurfMapSurfSubsurfGrid(realization, surf_realization, prod, TWO_DIM_GRID, &
957) surf_petsc_ids)
958) call MatDestroy(prod,ierr);CHKERRQ(ierr)
959)
960) call MatMatMult(Mat_vert_to_face_surf,Mat_vert_to_face_subsurf_transp, &
961) MAT_INITIAL_MATRIX,PETSC_DEFAULT_REAL,prod, &
962) ierr);CHKERRQ(ierr)
963)
964) #if UGRID_DEBUG
965) string = 'prod_2.out'
966) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
967) call MatView(prod,viewer,ierr);CHKERRQ(ierr)
968) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
969) #endif
970) call RealizSurfMapSurfSubsurfGrid(realization, surf_realization, prod, THREE_DIM_GRID, &
971) subsurf_petsc_ids)
972)
973) call MatDestroy(prod,ierr);CHKERRQ(ierr)
974)
975) call MatDestroy(Mat_vert_to_face_subsurf,ierr);CHKERRQ(ierr)
976) call MatDestroy(Mat_vert_to_face_subsurf_transp,ierr);CHKERRQ(ierr)
977) call MatDestroy(Mat_vert_to_face_surf,ierr);CHKERRQ(ierr)
978) call MatDestroy(Mat_vert_to_face_surf_transp,ierr);CHKERRQ(ierr)
979)
980) call VecDestroy(subsurf_petsc_ids,ierr);CHKERRQ(ierr)
981) call VecDestroy(surf_petsc_ids,ierr);CHKERRQ(ierr)
982)
983) end subroutine RealizSurfMapSurfSubsurfGrids
984)
985) ! ************************************************************************** !
986)
987) subroutine RealizSurfMapSurfSubsurfGrid( &
988) realization, & !<
989) surf_realization, & !<
990) prod_mat, & !< Mat-Mat-Mult matrix
991) source_grid_flag, & !< To identify a surface or subsurface grid
992) source_petsc_ids & !< MPI-Vector containing cell ids in PETSc order
993) )
994) !
995) ! This subroutine creates a single vector scatter context
996) ! Algorithm:
997) !
998) ! Author: Gautam Bisht, ORNL
999) ! Date: 01/18/12
1000) !
1001)
1002) use Grid_module
1003) use String_module
1004) use Grid_Unstructured_module
1005) use Grid_Unstructured_Cell_module
1006) use Realization_Subsurface_class
1007) use Option_module
1008) use Field_module
1009) use Surface_Field_module
1010) use Grid_Unstructured_module
1011) use Discretization_module
1012) use Grid_Unstructured_Aux_module
1013) use DM_Kludge_module
1014)
1015) implicit none
1016)
1017) #include "petsc/finclude/petscvec.h"
1018) #include "petsc/finclude/petscvec.h90"
1019) #include "petsc/finclude/petscmat.h"
1020) #include "petsc/finclude/petscmat.h90"
1021)
1022) class(realization_subsurface_type), pointer :: realization
1023) class(realization_surface_type), pointer :: surf_realization
1024) Mat :: prod_mat
1025) PetscInt :: source_grid_flag
1026) Vec :: source_petsc_ids
1027)
1028) Mat :: prod_loc_mat
1029) Vec :: source_loc_vec
1030) Vec :: corr_dest_ids_vec
1031) Vec :: corr_dest_ids_vec_ndof
1032) Vec :: source_petsc_ids_ndof
1033) IS :: is_tmp1, is_tmp2
1034) IS :: is_tmp3, is_tmp4
1035) PetscInt,pointer :: corr_v2_ids(:)
1036) VecScatter :: scatter
1037) VecScatter :: scatter_ndof
1038)
1039) PetscViewer :: viewer
1040)
1041) type(option_type), pointer :: option
1042) type(field_type), pointer :: field
1043) type(surface_field_type), pointer :: surf_field
1044)
1045) type(dm_ptr_type), pointer :: dm_ptr
1046) character(len=MAXSTRINGLENGTH) :: string
1047) PetscInt,pointer ::int_array(:)
1048) PetscInt :: offset
1049) PetscInt :: int_array4(4)
1050) PetscInt :: int_array4_0(4,1)
1051) PetscReal :: real_array4(4)
1052) PetscInt :: ii, jj
1053) PetscReal, pointer :: vec_ptr(:)
1054) PetscInt :: ivertex, cell_id, vertex_id_local
1055) PetscReal :: max_value
1056)
1057) PetscInt, pointer :: ia_p(:), ja_p(:)
1058) PetscInt :: nrow,rstart,rend,icol(1)
1059) PetscInt :: index
1060) PetscInt :: vertex_id
1061) PetscOffset :: iia,jja,iicol
1062) PetscBool :: done
1063) PetscScalar, pointer :: aa_v(:)
1064) PetscInt :: row, col
1065)
1066) PetscErrorCode :: ierr
1067) PetscBool :: found
1068) PetscInt :: nlocal
1069)
1070) option => realization%option
1071) field => realization%field
1072) surf_field => surf_realization%surf_field
1073)
1074) if (option%mycommsize > 1) then
1075) ! From the MPI-Matrix get the local-matrix
1076) call MatMPIAIJGetLocalMat(prod_mat,MAT_INITIAL_MATRIX,prod_loc_mat, &
1077) ierr);CHKERRQ(ierr)
1078) ! Get i and j indices of the local-matrix
1079) call MatGetRowIJF90(prod_loc_mat, ONE_INTEGER, PETSC_FALSE, PETSC_FALSE, &
1080) nrow, ia_p, ja_p, done, ierr);CHKERRQ(ierr)
1081) ! Get values stored in the local-matrix
1082) call MatSeqAIJGetArrayF90(prod_loc_mat,aa_v,ierr);CHKERRQ(ierr)
1083) else
1084) ! Get i and j indices of the local-matrix
1085) call MatGetRowIJF90(prod_mat, ONE_INTEGER, PETSC_FALSE, PETSC_FALSE, &
1086) nrow, ia_p, ja_p, done, ierr);CHKERRQ(ierr)
1087) ! Get values stored in the local-matrix
1088) call MatSeqAIJGetArrayF90(prod_mat,aa_v,ierr);CHKERRQ(ierr)
1089) endif
1090)
1091) ! For each row of the local-matrix, find the column with the largest value
1092) allocate(corr_v2_ids(nrow))
1093) row = 1
1094) col = 0
1095) do ii = 1, nrow
1096) max_value = 0.d0
1097) do jj = ia_p(ii), ia_p(ii + 1) - 1
1098) if (aa_v(jj) > max_value) then
1099) corr_v2_ids(ii) = ja_p(jj)
1100) max_value = aa_v(jj)
1101) endif
1102) enddo
1103) if (max_value<3) then
1104) option%io_buffer = 'Atleast three vertices need to form a face'
1105) call printErrMsg(option)
1106) endif
1107) enddo
1108)
1109) offset = 0
1110) call MPI_Exscan(nrow,offset,ONE_INTEGER_MPI, &
1111) MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
1112) allocate(int_array(nrow))
1113) do ii = 1, nrow
1114) int_array(ii) = (ii-1)+offset
1115) enddo
1116) call ISCreateGeneral(option%mycomm,nrow, &
1117) int_array,PETSC_COPY_VALUES,is_tmp1,ierr);CHKERRQ(ierr)
1118) call ISCreateBlock(option%mycomm,option%nflowdof,nrow, &
1119) int_array,PETSC_COPY_VALUES,is_tmp3,ierr);CHKERRQ(ierr)
1120)
1121) do ii = 1, nrow
1122) int_array(ii) = corr_v2_ids(ii)-1
1123) enddo
1124) call ISCreateGeneral(option%mycomm,nrow, &
1125) int_array,PETSC_COPY_VALUES,is_tmp2,ierr);CHKERRQ(ierr)
1126) call ISCreateBlock(option%mycomm,option%nflowdof,nrow, &
1127) int_array,PETSC_COPY_VALUES,is_tmp4,ierr);CHKERRQ(ierr)
1128) deallocate(int_array)
1129)
1130) call VecCreateMPI(option%mycomm,nrow,PETSC_DETERMINE, &
1131) corr_dest_ids_vec,ierr);CHKERRQ(ierr)
1132) call VecScatterCreate(source_petsc_ids,is_tmp2,corr_dest_ids_vec,is_tmp1, &
1133) scatter,ierr);CHKERRQ(ierr)
1134) call ISDestroy(is_tmp1,ierr);CHKERRQ(ierr)
1135) call ISDestroy(is_tmp2,ierr);CHKERRQ(ierr)
1136)
1137) call VecScatterBegin(scatter,source_petsc_ids,corr_dest_ids_vec, &
1138) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1139) call VecScatterEnd(scatter,source_petsc_ids,corr_dest_ids_vec, &
1140) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1141) select case(source_grid_flag)
1142) case(TWO_DIM_GRID)
1143) dm_ptr => DiscretizationGetDMPtrFromIndex(surf_realization%discretization,ONEDOF)
1144) call VecScatterCopy(scatter,dm_ptr%ugdm%scatter_bet_grids, &
1145) ierr);CHKERRQ(ierr)
1146) call VecScatterCopy(scatter,dm_ptr%ugdm%scatter_bet_grids_1dof, &
1147) ierr);CHKERRQ(ierr)
1148) case(THREE_DIM_GRID)
1149) dm_ptr => DiscretizationGetDMPtrFromIndex(realization%discretization,ONEDOF)
1150) call VecScatterCopy(scatter,dm_ptr%ugdm%scatter_bet_grids, &
1151) ierr);CHKERRQ(ierr)
1152) call VecScatterCopy(scatter,dm_ptr%ugdm%scatter_bet_grids_1dof, &
1153) ierr);CHKERRQ(ierr)
1154) end select
1155) call VecScatterDestroy(scatter,ierr);CHKERRQ(ierr)
1156)
1157) #if UGRID_DEBUG
1158) if (source_grid_flag==TWO_DIM_GRID) write(string,*) 'surf'
1159) if (source_grid_flag==THREE_DIM_GRID) write(string,*) 'subsurf'
1160) string = adjustl(string)
1161) string = 'corr_dest_ids_vec_' // trim(string) // '.out'
1162) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
1163) call VecView(corr_dest_ids_vec,viewer,ierr);CHKERRQ(ierr)
1164) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1165) #endif
1166)
1167) call VecDestroy(corr_dest_ids_vec,ierr);CHKERRQ(ierr)
1168) if (option%mycommsize>1) then
1169) call MatSeqAIJRestoreArrayF90(prod_loc_mat,aa_v,ierr);CHKERRQ(ierr)
1170) call MatDestroy(prod_loc_mat,ierr);CHKERRQ(ierr)
1171) else
1172) call MatSeqAIJRestoreArrayF90(prod_mat,aa_v,ierr);CHKERRQ(ierr)
1173) endif
1174)
1175) #if UGRID_DEBUG
1176) if (source_grid_flag==TWO_DIM_GRID) write(string,*) 'surf'
1177) if (source_grid_flag==THREE_DIM_GRID) write(string,*) 'subsurf'
1178) string = adjustl(string)
1179) string = 'scatter_bet_grids_' // trim(string) // '.out'
1180) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
1181) call VecScatterView(dm_ptr%ugdm%scatter_bet_grids,viewer,ierr);CHKERRQ(ierr)
1182) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1183) #endif
1184)
1185) ! Create stridded vectors
1186) call VecCreate(option%mycomm,corr_dest_ids_vec_ndof,ierr);CHKERRQ(ierr)
1187) call VecSetSizes(corr_dest_ids_vec_ndof,nrow*option%nflowdof, &
1188) PETSC_DECIDE,ierr);CHKERRQ(ierr)
1189) call VecSetBlockSize(corr_dest_ids_vec_ndof,option%nflowdof, &
1190) ierr);CHKERRQ(ierr)
1191) call VecSetFromOptions(corr_dest_ids_vec_ndof,ierr);CHKERRQ(ierr)
1192)
1193) call VecGetLocalSize(source_petsc_ids,nlocal,ierr);CHKERRQ(ierr)
1194) call VecCreate(option%mycomm,source_petsc_ids_ndof,ierr);CHKERRQ(ierr)
1195) call VecSetSizes(source_petsc_ids_ndof,nlocal*option%nflowdof, &
1196) PETSC_DECIDE,ierr);CHKERRQ(ierr)
1197) call VecSetBlockSize(source_petsc_ids_ndof,option%nflowdof, &
1198) ierr);CHKERRQ(ierr)
1199) call VecSetFromOptions(source_petsc_ids_ndof,ierr);CHKERRQ(ierr)
1200)
1201) ! Create stridded vectors-scatter context
1202) call VecScatterCreate(source_petsc_ids_ndof,is_tmp4, &
1203) corr_dest_ids_vec_ndof,is_tmp3, &
1204) scatter_ndof,ierr);CHKERRQ(ierr)
1205)
1206) ! Save the stridded vectors-scatter context
1207) select case(source_grid_flag)
1208) case(TWO_DIM_GRID)
1209) dm_ptr => DiscretizationGetDMPtrFromIndex(surf_realization%discretization,NFLOWDOF)
1210) case(THREE_DIM_GRID)
1211) dm_ptr => DiscretizationGetDMPtrFromIndex(realization%discretization,NFLOWDOF)
1212) end select
1213) call VecScatterCopy(scatter_ndof,dm_ptr%ugdm%scatter_bet_grids_ndof, &
1214) ierr);CHKERRQ(ierr)
1215)
1216) ! Cleanup
1217) call VecScatterDestroy(scatter_ndof,ierr);CHKERRQ(ierr)
1218) call VecDestroy(source_petsc_ids_ndof,ierr);CHKERRQ(ierr)
1219) call VecDestroy(corr_dest_ids_vec_ndof,ierr);CHKERRQ(ierr)
1220)
1221) end subroutine RealizSurfMapSurfSubsurfGrid
1222)
1223) ! ************************************************************************** !
1224)
1225) subroutine RealizSurfDestroy(surf_realization)
1226) !
1227) ! This routine destroys RealizSurf object
1228) !
1229) ! Author: Gautam Bisht, ORNL
1230) ! Date: 02/16/12
1231) !
1232)
1233) implicit none
1234)
1235) class(realization_surface_type), pointer :: surf_realization
1236)
1237) if (.not.associated(surf_realization)) return
1238)
1239) !geh: deallocate everything in base
1240) call RealizationBaseStrip(surf_realization)
1241)
1242) call SurfaceFieldDestroy(surf_realization%surf_field)
1243)
1244) call OutputOptionDestroy(surf_realization%output_option)
1245)
1246) call RegionDestroyList(surf_realization%surf_regions)
1247)
1248) call FlowConditionDestroyList(surf_realization%surf_flow_conditions)
1249)
1250) call TranConditionDestroyList(surf_realization%surf_transport_conditions)
1251)
1252) call PatchDestroyList(surf_realization%patch_list)
1253)
1254) if (associated(surf_realization%debug)) deallocate(surf_realization%debug)
1255) nullify(surf_realization%debug)
1256)
1257) if (associated(surf_realization%surf_material_property_array)) &
1258) deallocate(surf_realization%surf_material_property_array)
1259) nullify(surf_realization%surf_material_property_array)
1260) call SurfaceMaterialPropertyDestroy(surf_realization%surf_material_properties)
1261)
1262) call DiscretizationDestroy(surf_realization%discretization)
1263)
1264) if (associated(surf_realization)) deallocate(surf_realization)
1265) nullify(surf_realization)
1266)
1267) end subroutine RealizSurfDestroy
1268)
1269)
1270) ! ************************************************************************** !
1271)
1272) subroutine RealizSurfStrip(surf_realization)
1273) !
1274) ! This routine destroys RealizSurf object
1275) !
1276) ! Author: Gautam Bisht, ORNL
1277) ! Date: 02/16/12
1278) !
1279)
1280) implicit none
1281)
1282) class(realization_surface_type), pointer :: surf_realization
1283)
1284) if (.not.associated(surf_realization)) return
1285)
1286) !geh: deallocate everything in base
1287) call RealizationBaseStrip(surf_realization)
1288)
1289) call SurfaceFieldDestroy(surf_realization%surf_field)
1290)
1291) call OutputOptionDestroy(surf_realization%output_option)
1292)
1293) call RegionDestroyList(surf_realization%surf_regions)
1294)
1295) call FlowConditionDestroyList(surf_realization%surf_flow_conditions)
1296)
1297) call TranConditionDestroyList(surf_realization%surf_transport_conditions)
1298)
1299) call PatchDestroyList(surf_realization%patch_list)
1300)
1301) if (associated(surf_realization%debug)) deallocate(surf_realization%debug)
1302) nullify(surf_realization%debug)
1303)
1304) if (associated(surf_realization%surf_material_property_array)) &
1305) deallocate(surf_realization%surf_material_property_array)
1306) nullify(surf_realization%surf_material_property_array)
1307) call SurfaceMaterialPropertyDestroy(surf_realization%surf_material_properties)
1308)
1309) call DiscretizationDestroy(surf_realization%discretization)
1310)
1311) call ReactionDestroy(surf_realization%reaction,surf_realization%option)
1312)
1313) end subroutine RealizSurfStrip
1314)
1315) ! ************************************************************************** !
1316)
1317) subroutine RealizSurfUpdate(surf_realization)
1318) !
1319) ! This routine updates parameters in realization (eg. conditions, bcs, srcs)
1320) !
1321) ! Author: Gautam Bisht, ORNL
1322) ! Date: 05/22/12
1323) !
1324)
1325) implicit none
1326)
1327) class(realization_surface_type) :: surf_realization
1328)
1329) PetscBool :: force_update_flag = PETSC_FALSE
1330)
1331) ! must update conditions first
1332) call FlowConditionUpdate(surf_realization%surf_flow_conditions, &
1333) surf_realization%option, &
1334) surf_realization%option%time)
1335)
1336) call RealizSurfAllCouplerAuxVars(surf_realization,force_update_flag)
1337)
1338) end subroutine RealizSurfUpdate
1339)
1340) ! ************************************************************************** !
1341)
1342) subroutine RealizSurfGetVariable(surf_realization,vec,ivar,isubvar,isubvar1)
1343) !
1344) ! This routine extracts variables indexed by ivar and isubvar from surface
1345) ! realization.
1346) !
1347) ! Author: Gautam Bisht, ORNL
1348) ! Date: 05/22/12
1349) !
1350)
1351) use Option_module
1352) use Surface_Field_module
1353)
1354) implicit none
1355)
1356) class(realization_surface_type) :: surf_realization
1357) Vec :: vec
1358) PetscInt :: ivar
1359) PetscInt :: isubvar
1360) PetscInt, optional :: isubvar1
1361)
1362) call PatchGetVariable(surf_realization%patch, &
1363) surf_realization%surf_field, &
1364) !surf_realization%reaction, &
1365) surf_realization%option, &
1366) surf_realization%output_option, &
1367) vec,ivar,isubvar,isubvar1)
1368)
1369) end subroutine RealizSurfGetVariable
1370)
1371) ! ************************************************************************** !
1372)
1373) subroutine RealizSurfAddWaypointsToList(surf_realization,waypoint_list)
1374) !
1375) ! This routine creates waypoints assocated with source/sink, boundary
1376) ! condition, etc. and adds to a list
1377) !
1378) ! Author: Gautam Bisht, LBNL
1379) ! Date: 03/15/13
1380) !
1381)
1382) use Option_module
1383) use Waypoint_module
1384) use Time_Storage_module
1385)
1386) implicit none
1387)
1388) class(realization_surface_type) :: surf_realization
1389) type(waypoint_list_type) :: waypoint_list
1390)
1391) type(flow_condition_type), pointer :: cur_flow_condition
1392) type(flow_sub_condition_type), pointer :: sub_condition
1393) type(waypoint_type), pointer :: waypoint, cur_waypoint
1394) type(option_type), pointer :: option
1395) PetscInt :: itime, isub_condition
1396) PetscReal :: temp_real, final_time
1397) PetscReal, pointer :: times(:)
1398)
1399) option => surf_realization%option
1400) nullify(times)
1401)
1402) ! set flag for final output
1403) cur_waypoint => waypoint_list%first
1404) do
1405) if (.not.associated(cur_waypoint)) exit
1406) if (cur_waypoint%final) then
1407) cur_waypoint%print_snap_output = &
1408) surf_realization%output_option%print_final_snap
1409) exit
1410) endif
1411) cur_waypoint => cur_waypoint%next
1412) enddo
1413) ! use final time in conditional below
1414) if (associated(cur_waypoint)) then
1415) final_time = cur_waypoint%time
1416) else
1417) option%io_buffer = 'Final time not found in RealizSurfAddWaypointsToList'
1418) call printErrMsg(option)
1419) endif
1420)
1421) ! add update of flow conditions
1422) cur_flow_condition => surf_realization%surf_flow_conditions%first
1423) do
1424) if (.not.associated(cur_flow_condition)) exit
1425) if (cur_flow_condition%sync_time_with_update) then
1426) do isub_condition = 1, cur_flow_condition%num_sub_conditions
1427) sub_condition => cur_flow_condition%sub_condition_ptr(isub_condition)%ptr
1428) !TODO(geh): check if this updated more than simply the flow_dataset (i.e. datum and gradient)
1429) !geh: followup - no, datum/gradient are not considered. Should they be considered?
1430) call TimeStorageGetTimes(sub_condition%dataset%time_storage, option, &
1431) final_time, times)
1432) if (associated(times)) then
1433) if (size(times) > 1000) then
1434) option%io_buffer = 'For flow condition "' // &
1435) trim(cur_flow_condition%name) // &
1436) '" dataset "' // trim(sub_condition%name) // &
1437) '", the number of times is excessive for synchronization ' // &
1438) 'with waypoints.'
1439) call printErrMsg(option)
1440) endif
1441) do itime = 1, size(times)
1442) waypoint => WaypointCreate()
1443) waypoint%time = times(itime)
1444) waypoint%update_conditions = PETSC_TRUE
1445) call WaypointInsertInList(waypoint,waypoint_list)
1446) enddo
1447) deallocate(times)
1448) nullify(times)
1449) endif
1450) enddo
1451) endif
1452) cur_flow_condition => cur_flow_condition%next
1453) enddo
1454)
1455) end subroutine RealizSurfAddWaypointsToList
1456)
1457) end module Realization_Surface_class