init_surface.F90 coverage: 100.00 %func 70.34 %block
1) module Init_Surface_module
2)
3) use PFLOTRAN_Constants_module
4)
5) implicit none
6)
7) #include "petsc/finclude/petscsys.h"
8)
9) public :: SurfaceInitReadRequiredCards, &
10) InitSurfaceSetupRealization, &
11) InitSurfaceSetupSolvers
12) contains
13)
14) ! ************************************************************************** !
15)
16) subroutine SurfaceInitReadRequiredCards(surf_realization)
17) !
18) ! This routine reads the required input file cards related to surface flows
19) !
20) ! Author: Gautam Bisht, ORNL
21) ! Date: 02/18/12
22) !
23)
24) use Option_module
25) use Discretization_module
26) use Grid_module
27) use Input_Aux_module
28) use String_module
29) use Patch_module
30)
31) use Realization_Surface_class
32) use Surface_Auxiliary_module
33)
34) implicit none
35)
36) class(realization_surface_type) :: surf_realization
37) type(discretization_type), pointer :: discretization
38)
39) character(len=MAXSTRINGLENGTH) :: string
40)
41) type(patch_type), pointer :: patch
42) type(grid_type), pointer :: grid
43) type(option_type), pointer :: option
44) type(input_type), pointer :: input
45)
46) patch => surf_realization%patch
47) option => surf_realization%option
48) discretization => surf_realization%discretization
49)
50) input => surf_realization%input
51)
52) ! Read in select required cards
53) !.........................................................................
54)
55) ! GRID information
56) ! string = "GRID"
57) ! call InputFindStringInFile(input,option,string)
58) ! call InputFindStringErrorMsg(input,option,string)
59)
60) ! SURFACE_FLOW information
61) string = "SURFACE_FLOW"
62) call InputFindStringInFile(input,option,string)
63) if (InputError(input)) return
64) option%surf_flow_on = PETSC_TRUE
65) option%nsurfflowdof = 1
66)
67) string = "SURF_GRID"
68) call InputFindStringInFile(input,option,string)
69) ! call SurfaceFlowReadRequiredCardsFromInput(surf_realization,input,option)
70) call SurfaceInit(surf_realization,input,option)
71)
72) select case(discretization%itype)
73) case(STRUCTURED_GRID,UNSTRUCTURED_GRID)
74) patch => PatchCreate()
75) patch%grid => discretization%grid
76) patch%surf_or_subsurf_flag = SURFACE
77) if (.not.associated(surf_realization%patch_list)) then
78) surf_realization%patch_list => PatchCreateList()
79) endif
80) call PatchAddToList(patch,surf_realization%patch_list)
81) surf_realization%patch => patch
82) end select
83)
84) end subroutine SurfaceInitReadRequiredCards
85)
86) ! ************************************************************************** !
87)
88) subroutine SurfaceInit(surf_realization,input,option)
89) !
90) ! This routine reads required surface flow data from the input file
91) ! grids.
92) !
93) ! Author: Gautam Bisht, ORNL
94) ! Date: 02/09/12
95) !
96)
97) use Option_module
98) use Input_Aux_module
99) use String_module
100) use Surface_Material_module
101) use Realization_Surface_class
102) use Grid_module
103) use Grid_Structured_module
104) use Grid_Unstructured_module
105) use Grid_Unstructured_Aux_module
106) use Discretization_module
107) use Region_module
108) use Condition_module
109) use Grid_Unstructured_Aux_module
110)
111) implicit none
112)
113) class(realization_surface_type) :: surf_realization
114) type(discretization_type),pointer :: discretization
115) type(grid_type), pointer :: grid
116) type(input_type), pointer :: input
117) type(option_type) :: option
118) type(grid_unstructured_type), pointer :: un_str_sfgrid
119) character(len=MAXWORDLENGTH) :: word
120) character(len=MAXWORDLENGTH) :: unstructured_grid_ctype
121) PetscInt :: unstructured_grid_itype
122)
123) discretization => surf_realization%discretization
124)
125) input%ierr = 0
126) ! we initialize the word to blanks to avoid error reported by valgrind
127) word = ''
128)
129) call InputReadPflotranString(input,option)
130) call InputReadWord(input,option,word,PETSC_TRUE)
131) call InputErrorMsg(input,option,'keyword','SURFACE_FLOW')
132) call StringToUpper(word)
133)
134) select case(trim(word))
135) case ('TYPE')
136) call InputReadWord(input,option,word,PETSC_TRUE)
137) call InputErrorMsg(input,option,'keyword','TYPE')
138) call StringToUpper(word)
139)
140) select case(trim(word))
141) case ('UNSTRUCTURED')
142) unstructured_grid_itype = IMPLICIT_UNSTRUCTURED_GRID
143) unstructured_grid_ctype = 'implicit unstructured'
144) discretization%itype = UNSTRUCTURED_GRID
145) call InputReadNChars(input,option, &
146) discretization%filename, &
147) MAXSTRINGLENGTH, &
148) PETSC_TRUE)
149) call InputErrorMsg(input,option,'keyword','filename')
150)
151) grid => GridCreate()
152) un_str_sfgrid => UGridCreate()
153) un_str_sfgrid%grid_type = TWO_DIM_GRID
154) if (index(discretization%filename,'.h5') > 0) then
155) #if defined(PETSC_HAVE_HDF5)
156) call UGridReadHDF5SurfGrid( un_str_sfgrid, &
157) discretization%filename, &
158) option)
159) #endif
160) else
161) call UGridReadSurfGrid(un_str_sfgrid, &
162) surf_realization%subsurf_filename, &
163) discretization%filename, &
164) option)
165) endif
166) grid%unstructured_grid => un_str_sfgrid
167) discretization%grid => grid
168) grid%itype = unstructured_grid_itype
169) grid%ctype = unstructured_grid_ctype
170)
171) case default
172) option%io_buffer = 'Surface-flow supports only unstructured grid'
173) call printErrMsg(option)
174) end select
175) end select
176)
177) end subroutine SurfaceInit
178)
179) ! ************************************************************************** !
180)
181) subroutine InitSurfaceSetupRealization(surf_realization,subsurf_realization, &
182) waypoint_list)
183) !
184) ! Initializes material property data structres and assign them to the domain.
185) !
186) ! Author: Glenn Hammond
187) ! Date: 12/04/14
188) !
189) use Surface_Flow_module
190) use Realization_Surface_class
191) use Surface_TH_module
192) use Surface_Global_module
193) use Timestepper_Base_class
194) use Realization_Subsurface_class
195)
196) use Option_module
197) use Waypoint_module
198) use Condition_Control_module
199) use EOS_Water_module
200)
201) implicit none
202)
203) class(realization_surface_type), pointer :: surf_realization
204) class(realization_subsurface_type), pointer :: subsurf_realization
205) type(waypoint_list_type) :: waypoint_list
206)
207) type(option_type), pointer :: option
208) PetscReal :: dum1
209) PetscErrorCode :: ierr
210)
211) option => surf_realization%option
212)
213) ! initialize reference density
214) if (option%reference_water_density < 1.d-40) then
215) call EOSWaterDensity(option%reference_temperature, &
216) option%reference_pressure, &
217) option%reference_water_density, &
218) dum1,ierr)
219) endif
220)
221) call RealizSurfCreateDiscretization(surf_realization)
222)
223) ! Check if surface-flow is compatible with the given flowmode
224) select case(option%iflowmode)
225) case(RICHARDS_MODE,TH_MODE)
226) case default
227) option%io_buffer = 'For surface-flow only RICHARDS and TH mode implemented'
228) call printErrMsgByRank(option)
229) end select
230)
231) call SurfaceInitReadRegionFiles(surf_realization)
232) call RealizSurfMapSurfSubsurfGrids(subsurf_realization,surf_realization)
233) call RealizSurfLocalizeRegions(surf_realization)
234) call RealizSurfPassFieldPtrToPatches(surf_realization)
235) call RealizSurfProcessMatProp(surf_realization)
236) call RealizSurfProcessCouplers(surf_realization)
237) call RealizSurfProcessConditions(surf_realization)
238) !call RealProcessFluidProperties(surf_realization)
239) call SurfaceInitMatPropToRegions(surf_realization)
240) call RealizSurfInitAllCouplerAuxVars(surf_realization)
241) !call SurfaceRealizationPrintCouplers(surf_realization)
242)
243) ! add waypoints associated with boundary conditions, source/sinks etc. to list
244) call RealizSurfAddWaypointsToList(surf_realization,waypoint_list)
245)
246) select case(option%iflowmode)
247) case(RICHARDS_MODE)
248) call SurfaceFlowSetup(surf_realization)
249) case default
250) case(TH_MODE)
251) call SurfaceTHSetup(surf_realization)
252) end select
253)
254) call SurfaceGlobalSetup(surf_realization)
255) ! initialize FLOW
256) ! set up auxillary variable arrays
257)
258) ! assign initial conditionsRealizAssignFlowInitCond
259) call CondControlAssignFlowInitCondSurface(surf_realization)
260)
261) ! override initial conditions if they are to be read from a file
262) if (len_trim(option%surf_initialize_flow_filename) > 1) then
263) option%io_buffer = 'For surface-flow initial conditions cannot be read from file'
264) call printErrMsgByRank(option)
265) endif
266)
267) select case(option%iflowmode)
268) case(RICHARDS_MODE)
269) call SurfaceFlowUpdateAuxVars(surf_realization)
270) case(TH_MODE)
271) call SurfaceTHUpdateAuxVars(surf_realization)
272) case default
273) option%io_buffer = 'For surface-flow only RICHARDS and TH mode implemented'
274) call printErrMsgByRank(option)
275) end select
276)
277) end subroutine InitSurfaceSetupRealization
278)
279) ! ************************************************************************** !
280)
281) subroutine InitSurfaceSetupSolvers(surf_realization,solver,final_time)
282) !
283) ! Initializes material property data structres and assign them to the domain.
284) !
285) ! Author: Glenn Hammond
286) ! Date: 12/04/14
287) !
288) use Realization_Surface_class
289) use Option_module
290)
291) use Solver_module
292) use Convergence_module
293) use Discretization_module
294) use Surface_Flow_module
295) use Surface_TH_module
296)
297) implicit none
298)
299) #include "petsc/finclude/petscvec.h"
300) #include "petsc/finclude/petscvec.h90"
301) #include "petsc/finclude/petscmat.h"
302) #include "petsc/finclude/petscmat.h90"
303) #include "petsc/finclude/petscsnes.h"
304) #include "petsc/finclude/petscpc.h"
305) #include "petsc/finclude/petscts.h"
306)
307) class(realization_surface_type) :: surf_realization
308) type(solver_type), pointer :: solver
309) PetscReal :: final_time
310)
311) type(option_type), pointer :: option
312) type(convergence_context_type), pointer :: convergence_context
313) SNESLineSearch :: linesearch
314) character(len=MAXSTRINGLENGTH) :: string
315) PetscErrorCode :: ierr
316)
317) option => surf_realization%option
318)
319) call printMsg(option," Beginning setup of FLOW SNES ")
320)
321) ! Setup PETSc TS for explicit surface flow solution
322) call printMsg(option," Beginning setup of SURF FLOW TS ")
323)
324) call SolverCreateTS(solver,option%mycomm)
325) call TSSetProblemType(solver%ts,TS_NONLINEAR, &
326) ierr);CHKERRQ(ierr)
327) call TSSetDuration(solver%ts,ONE_INTEGER,final_time,ierr);CHKERRQ(ierr)
328)
329) end subroutine InitSurfaceSetupSolvers
330)
331) ! ************************************************************************** !
332)
333) subroutine SurfaceInitMatPropToRegions(surf_realization)
334) !
335) ! This routine assigns surface material properties to associated regions in
336) ! the model (similar to assignMaterialPropToRegions)
337) !
338) ! Author: Gautam Bisht, ORNL
339) ! Date: 02/13/12
340) !
341)
342) use Realization_Surface_class
343) use Discretization_module
344) use Strata_module
345) use Region_module
346) use Material_module
347) use Option_module
348) use Grid_module
349) use Field_module
350) use Patch_module
351) use Surface_Field_module
352) use Surface_Material_module
353)
354) use HDF5_module
355)
356) implicit none
357)
358) #include "petsc/finclude/petscvec.h"
359) #include "petsc/finclude/petscvec.h90"
360)
361) class(realization_surface_type) :: surf_realization
362)
363) PetscReal, pointer :: man0_p(:)
364) PetscReal, pointer :: vec_p(:)
365)
366) PetscInt :: icell, local_id, ghosted_id, natural_id, surf_material_id
367) PetscInt :: istart, iend
368) character(len=MAXSTRINGLENGTH) :: group_name
369) character(len=MAXSTRINGLENGTH) :: dataset_name
370) PetscErrorCode :: ierr
371)
372) type(option_type), pointer :: option
373) type(grid_type), pointer :: grid
374) type(discretization_type), pointer :: discretization
375) type(surface_field_type), pointer :: surf_field
376) type(strata_type), pointer :: strata
377) type(patch_type), pointer :: patch
378) type(patch_type), pointer :: cur_patch
379)
380) type(surface_material_property_type), pointer :: surf_material_property
381) type(surface_material_property_type), pointer :: null_surf_material_property
382) type(region_type), pointer :: region
383) PetscBool :: update_ghosted_material_ids
384)
385) option => surf_realization%option
386) discretization => surf_realization%discretization
387) surf_field => surf_realization%surf_field
388)
389) ! loop over all patches and allocation material id arrays
390) cur_patch => surf_realization%patch_list%first
391) do
392) if (.not.associated(cur_patch)) exit
393) if (.not.associated(cur_patch%imat)) then
394) allocate(cur_patch%imat(cur_patch%grid%ngmax))
395) ! initialize to "unset"
396) cur_patch%imat = UNINITIALIZED_INTEGER
397) ! also allocate saturation function id
398) allocate(cur_patch%sat_func_id(cur_patch%grid%ngmax))
399) cur_patch%sat_func_id = UNINITIALIZED_INTEGER
400) endif
401) cur_patch => cur_patch%next
402) enddo
403)
404) ! if material ids are set based on region, as opposed to being read in
405) ! we must communicate the ghosted ids. This flag toggles this operation.
406) update_ghosted_material_ids = PETSC_FALSE
407) cur_patch => surf_realization%patch_list%first
408) do
409) if (.not.associated(cur_patch)) exit
410) grid => cur_patch%grid
411) strata => cur_patch%strata_list%first
412) do
413) if (.not.associated(strata)) exit
414) ! Read in cell by cell material ids if they exist
415) if (.not.associated(strata%region) .and. strata%active) then
416) option%io_buffer = 'Reading of material prop from file for' // &
417) ' surface flow is not implemented.'
418) call printErrMsgByRank(option)
419) !call readMaterialsFromFile(realization,strata%realization_dependent, &
420) ! strata%material_property_filename)
421) ! Otherwise, set based on region
422) else if (strata%active) then
423) update_ghosted_material_ids = PETSC_TRUE
424) region => strata%region
425) surf_material_property => strata%surf_material_property
426) if (associated(region)) then
427) istart = 1
428) iend = region%num_cells
429) else
430) istart = 1
431) iend = grid%nlmax
432) endif
433) do icell=istart, iend
434) if (associated(region)) then
435) local_id = region%cell_ids(icell)
436) else
437) local_id = icell
438) endif
439) ghosted_id = grid%nL2G(local_id)
440) cur_patch%imat(ghosted_id) = surf_material_property%internal_id
441) enddo
442) endif
443) strata => strata%next
444) enddo
445) cur_patch => cur_patch%next
446) enddo
447)
448) if (update_ghosted_material_ids) then
449) ! update ghosted material ids
450) call RealizSurfLocalToLocalWithArray(surf_realization,MATERIAL_ID_ARRAY)
451) endif
452)
453) ! set cell by cell material properties
454) ! create null material property for inactive cells
455) null_surf_material_property => SurfaceMaterialPropertyCreate()
456) cur_patch => surf_realization%patch_list%first
457) do
458) if (.not.associated(cur_patch)) exit
459)
460) call VecGetArrayF90(surf_field%mannings0,man0_p,ierr);CHKERRQ(ierr)
461)
462) do local_id = 1, grid%nlmax
463) ghosted_id = grid%nL2G(local_id)
464) surf_material_id = cur_patch%imat(ghosted_id)
465) if (surf_material_id == 0) then ! accomodate inactive cells
466) surf_material_property = null_surf_material_property
467) else if ( surf_material_id > 0 .and. &
468) surf_material_id <= &
469) size(surf_realization%surf_material_property_array)) then
470) surf_material_property => &
471) surf_realization%surf_material_property_array(surf_material_id)%ptr
472) if (.not.associated(surf_material_property)) then
473) write(dataset_name,*) surf_material_id
474) option%io_buffer = 'No material property for surface material id ' // &
475) trim(adjustl(dataset_name)) &
476) // ' defined in input file.'
477) call printErrMsgByRank(option)
478) endif
479) else if (Uninitialized(surf_material_id)) then
480) write(dataset_name,*) grid%nG2A(ghosted_id)
481) option%io_buffer = 'Uninitialized surface material id in patch at cell ' // &
482) trim(adjustl(dataset_name))
483) call printErrMsgByRank(option)
484) else if (surf_material_id > size(surf_realization%surf_material_property_array)) then
485) write(option%io_buffer,*) surf_material_id
486) option%io_buffer = 'Unmatched surface material id in patch:' // &
487) adjustl(trim(option%io_buffer))
488) call printErrMsgByRank(option)
489) else
490) option%io_buffer = 'Something messed up with surface material ids. ' // &
491) ' Possibly material ids not assigned to all grid cells. ' // &
492) ' Contact Glenn!'
493) call printErrMsgByRank(option)
494) endif
495) man0_p(local_id) = surf_material_property%mannings
496) enddo ! local_id - loop
497)
498) call VecRestoreArrayF90(surf_field%mannings0,man0_p,ierr);CHKERRQ(ierr)
499)
500) cur_patch => cur_patch%next
501) enddo ! looping over patches
502)
503) call SurfaceMaterialPropertyDestroy(null_surf_material_property)
504) nullify(null_surf_material_property)
505)
506) call DiscretizationGlobalToLocal(discretization,surf_field%mannings0, &
507) surf_field%mannings_loc,ONEDOF)
508)
509) end subroutine SurfaceInitMatPropToRegions
510)
511) ! ************************************************************************** !
512)
513) subroutine SurfaceInitReadRegionFiles(surf_realization)
514) !
515) ! This routine reads surface region files
516) !
517) ! Author: Gautam Bisht, ORNL
518) ! Date: 02/20/12
519) !
520)
521) use Realization_Surface_class
522) use Region_module
523) use HDF5_module
524) use Grid_module
525) use Option_module
526)
527) implicit none
528)
529) class(realization_surface_type) :: surf_realization
530)
531) type(option_type), pointer :: option
532) type(region_type), pointer :: surf_region
533) PetscBool :: cell_ids_exists
534) PetscBool :: face_ids_exists
535) PetscBool :: vert_ids_exists
536)
537) option => surf_realization%option
538) surf_region => surf_realization%surf_regions%first
539) do
540) if (.not.associated(surf_region)) exit
541) if (len_trim(surf_region%filename) > 1) then
542) if (index(surf_region%filename,'.h5') > 0) then
543) if (surf_region%grid_type == STRUCTURED_GRID) then
544) !call HDF5ReadRegionFromFile(surf_realization,surf_region,surf_region%filename)
545) else
546) #if defined(PETSC_HAVE_HDF5)
547) if ( .not. surf_region%hdf5_ugrid_kludge) then
548)
549) call HDF5QueryRegionDefinition(surf_region, surf_region%filename, surf_realization%option, &
550) cell_ids_exists, face_ids_exists, vert_ids_exists)
551)
552) if ( (.not. cell_ids_exists) .and. &
553) (.not. face_ids_exists) .and. &
554) (.not. vert_ids_exists)) then
555)
556) option%io_buffer = '"Regions/' // trim(surf_region%name) // &
557) ' is not defined by "Cell Ids" or "Face Ids" or "Vertex Ids".'
558) call printErrMsg(option)
559) end if
560)
561) if (cell_ids_exists .or. face_ids_exists) then
562) call HDF5ReadRegionFromFile(surf_realization%patch%grid, surf_region, surf_region%filename, option)
563) else
564) call HDF5ReadRegionDefinedByVertex(option, &
565) surf_region, surf_region%filename)
566) end if
567)
568) else
569) call HDF5ReadUnstructuredGridRegionFromFile(surf_realization%option, &
570) surf_region, &
571) surf_region%filename)
572) endif
573) #endif
574) endif
575) else if (index(surf_region%filename,'.ss') > 0) then
576) surf_region%sideset => RegionCreateSideset()
577) call RegionReadFromFile(surf_region%sideset,surf_region%filename, &
578) surf_realization%option)
579) else
580) call RegionReadFromFile(surf_region,surf_realization%option, &
581) surf_region%filename)
582) endif
583) endif
584) surf_region => surf_region%next
585) enddo
586)
587) end subroutine SurfaceInitReadRegionFiles
588)
589)
590) end module Init_Surface_module