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

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody