simulation_surfsubsurface.F90       coverage:  77.78 %func     53.85 %block


     1) module Simulation_Surf_Subsurf_class
     2) 
     3)   use Simulation_Surface_class
     4)   use Simulation_Subsurface_class
     5)   use Regression_module
     6)   use Option_module
     7)   use PMC_Base_class
     8)   use PMC_Subsurface_class
     9)   use PMC_Surface_class
    10)   use Realization_Subsurface_class
    11)   use Realization_Surface_class
    12)   use Waypoint_module
    13) 
    14)   use PFLOTRAN_Constants_module
    15) 
    16)   implicit none
    17) 
    18)   private
    19) 
    20) #include "petsc/finclude/petscsys.h"
    21) 
    22)   type, public, extends(simulation_subsurface_type) :: &
    23)     simulation_surfsubsurface_type
    24)     class(pmc_surface_type), pointer :: surf_flow_process_model_coupler
    25)     class(realization_surface_type), pointer :: surf_realization
    26)     type(waypoint_list_type), pointer :: waypoint_list_surfsubsurface
    27)   contains
    28)     procedure, public :: Init => SurfSubsurfaceSimulationInit
    29)     procedure, public :: InitializeRun => SurfSubsurfaceInitializeRun
    30)     procedure, public :: InputRecord => SurfSubsurfaceInputRecord
    31)     procedure, public :: FinalizeRun => SurfSubsurfaceFinalizeRun
    32)     procedure, public :: Strip => SurfSubsurfaceSimulationStrip
    33)     procedure, public :: ExecuteRun => SurfSubsurfaceExecuteRun
    34)     procedure, public :: RunToTime => SurfSubsurfaceSimulationRunToTime
    35)   end type simulation_surfsubsurface_type
    36) 
    37)   public :: SurfSubsurfaceSimulationCreate, &
    38)             SurfSubsurfaceSimulationInit, &
    39)             SurfSubsurfaceFinalizeRun, &
    40)             SurfSubsurfaceSimulationStrip, &
    41)             SurfSubsurfaceSimulationDestroy
    42) 
    43) contains
    44) 
    45) ! ************************************************************************** !
    46) 
    47) function SurfSubsurfaceSimulationCreate(option)
    48)   ! 
    49)   ! This routine
    50)   ! 
    51)   ! Author: Gautam Bisht, LBNL
    52)   ! Date: 06/28/13
    53)   ! 
    54) 
    55)   use Option_module
    56)   
    57)   implicit none
    58)   
    59)   type(option_type), pointer :: option
    60) 
    61)   class(simulation_surfsubsurface_type), pointer :: SurfSubsurfaceSimulationCreate
    62)   
    63)   print *, 'SurfSubsurfaceSimulationCreate'
    64)   
    65)   allocate(SurfSubsurfaceSimulationCreate)
    66)   call SurfSubsurfaceSimulationCreate%Init(option)
    67)   
    68) end function SurfSubsurfaceSimulationCreate
    69) 
    70) ! ************************************************************************** !
    71) 
    72) subroutine SurfSubsurfaceSimulationInit(this,option)
    73)   ! 
    74)   ! This routine
    75)   ! 
    76)   ! Author: Gautam Bisht, LBNL
    77)   ! Date: 06/28/13
    78)   ! 
    79)   use Waypoint_module
    80)   use Option_module
    81)   
    82)   implicit none
    83)   
    84)   class(simulation_surfsubsurface_type) :: this
    85)   type(option_type), pointer :: option
    86)   
    87)   call SubsurfaceSimulationInit(this,option)
    88)   nullify(this%surf_realization)
    89)   this%waypoint_list_surfsubsurface => WaypointListCreate()
    90)   
    91) end subroutine SurfSubsurfaceSimulationInit
    92) 
    93) ! ************************************************************************** !
    94) 
    95) subroutine SurfSubsurfaceInitializeRun(this)
    96)   ! 
    97)   ! This routine
    98)   ! 
    99)   ! Author: Gautam Bisht, LBNL
   100)   ! Date: 06/28/13
   101)   ! 
   102) 
   103)   use Logging_module
   104)   use Output_module
   105)   use PMC_Surface_class
   106) 
   107)   implicit none
   108)   
   109) #include "petsc/finclude/petscviewer.h"
   110) 
   111)   class(simulation_surfsubsurface_type) :: this
   112) 
   113)   class(pmc_base_type), pointer :: cur_process_model_coupler
   114)   class(pmc_base_type), pointer :: cur_process_model_coupler_top
   115)   class(pmc_base_type), pointer :: cur_process_model_coupler_below
   116)   PetscInt :: depth
   117)   PetscErrorCode :: ierr
   118)   PetscViewer :: viewer
   119)   
   120)   call printMsg(this%option,'Simulation%InitializeRun()')
   121) 
   122)   call this%process_model_coupler_list%InitializeRun()
   123) 
   124)   if (this%option%restart_flag) then
   125)     call this%process_model_coupler_list%RestartBinary(viewer)
   126)     cur_process_model_coupler => this%process_model_coupler_list
   127)     select type(pmc => cur_process_model_coupler)
   128)       class is(pmc_surface_type)
   129)         select case(this%option%iflowmode)
   130)           case (RICHARDS_MODE)
   131)             call pmc%PMCSurfaceGetAuxDataAfterRestart()
   132)           case (TH_MODE)
   133)             call pmc%PMCSurfaceGetAuxDataAfterRestart()
   134)           case default
   135)             call printErrMsg(this%option,'SurfSubsurfaceInitializeRun ' // &
   136)                   'not supported in current flow mode.')
   137)         end select
   138)     end select
   139) 
   140)   endif
   141) 
   142) end subroutine SurfSubsurfaceInitializeRun
   143) 
   144) ! ************************************************************************** !
   145) 
   146) subroutine SurfSubsurfaceInputRecord(this)
   147)   ! 
   148)   ! Writes ingested information to the input record file.
   149)   ! 
   150)   ! Author: Jenn Frederick, SNL
   151)   ! Date: 03/17/2016
   152)   ! 
   153)   use Output_module
   154) 
   155)   implicit none
   156)   
   157)   class(simulation_surfsubsurface_type) :: this
   158)   
   159)   character(len=MAXWORDLENGTH) :: word
   160)   PetscInt :: id = INPUT_RECORD_UNIT
   161)  
   162)   write(id,'(a29)',advance='no') 'simulation type: '
   163)   write(id,'(a)') 'surface-subsurface'
   164) 
   165)   ! print output file information
   166)   call OutputInputRecord(this%output_option,this%waypoint_list_surfsubsurface)
   167) 
   168) end subroutine SurfSubsurfaceInputRecord
   169) 
   170) ! ************************************************************************** !
   171) 
   172) subroutine SurfSubsurfaceExecuteRun(this)
   173)   ! 
   174)   ! This routine
   175)   ! 
   176)   ! Author: Gautam Bisht, LBNL
   177)   ! Date: 06/28/13
   178)   ! 
   179) 
   180)   use Simulation_Base_class
   181)   use Timestepper_Base_class, only : TS_CONTINUE
   182)   use Checkpoint_module
   183) 
   184)   implicit none
   185)   
   186)   class(simulation_surfsubsurface_type) :: this
   187) 
   188)   PetscReal :: time
   189)   PetscReal :: final_time
   190)   PetscReal :: dt
   191)   character(len=MAXSTRINGLENGTH) :: append_name
   192) 
   193)   time = 0.d0
   194)   time = this%option%time
   195) 
   196)   final_time = SimulationGetFinalWaypointTime(this)
   197)   append_name = '-restart'
   198) 
   199)   call printMsg(this%option,'SurfSubsurfaceExecuteRun()')
   200) 
   201)   if (.not.associated(this%surf_realization)) then
   202)     call this%RunToTime(final_time)
   203) 
   204)   else
   205) 
   206)     ! If simulation is decoupled surface-subsurface simulation, set
   207)     ! dt_coupling to be dt_max
   208)     if (this%surf_realization%dt_coupling == 0.d0) &
   209)       this%surf_realization%dt_coupling = this%surf_realization%dt_max
   210) 
   211)     do
   212)       if (time + this%surf_realization%dt_coupling > final_time) then
   213)         dt = final_time-time
   214)       else
   215)         dt = this%surf_realization%dt_coupling
   216)       endif
   217) 
   218)       time = time + dt
   219)       call this%RunToTime(time)
   220) 
   221)       if (this%stop_flag /= TS_CONTINUE) exit ! end simulation
   222) 
   223)       if (time >= final_time) exit
   224)     enddo
   225) 
   226)   endif
   227)   if (associated(this%process_model_coupler_list%checkpoint_option)) then
   228)     append_name = CheckpointFilename(append_name,this%option)
   229)     call this%process_model_coupler_list%Checkpoint(append_name)
   230)   endif
   231) 
   232) end subroutine SurfSubsurfaceExecuteRun
   233) 
   234) ! ************************************************************************** !
   235) 
   236) subroutine SurfSubsurfaceFinalizeRun(this)
   237)   ! 
   238)   ! This routine
   239)   ! 
   240)   ! Author: Gautam Bisht, LBNL
   241)   ! Date: 06/28/13
   242)   ! 
   243) 
   244)   use Simulation_Base_class
   245)   use Timestepper_Base_class
   246) 
   247)   implicit none
   248)   
   249)   class(simulation_surfsubsurface_type) :: this
   250)   
   251)   PetscErrorCode :: ierr
   252)   
   253)   call printMsg(this%option,'SurfSubsurfaceFinalizeRun()')
   254)   
   255)   call SubsurfaceFinalizeRun(this)
   256)   !call SurfaceFinalizeRun(this)
   257)   
   258) end subroutine SurfSubsurfaceFinalizeRun
   259) 
   260) ! ************************************************************************** !
   261) 
   262) subroutine SurfSubsurfaceSimulationStrip(this)
   263)   ! 
   264)   ! This routine
   265)   ! 
   266)   ! Author: Gautam Bisht, LBNL
   267)   ! Date: 06/28/13
   268)   ! 
   269)   use Waypoint_module
   270)   use Simulation_Base_class
   271) 
   272)   implicit none
   273)   
   274)   class(simulation_surfsubsurface_type) :: this
   275)   
   276)   call printMsg(this%option,'SurfSubsurfaceSimulationStrip()')
   277)   
   278)   call SubsurfaceSimulationStrip(this)
   279)   call RealizSurfStrip(this%surf_realization)
   280)   deallocate(this%surf_realization)
   281)   nullify(this%surf_realization)
   282)   call WaypointListDestroy(this%waypoint_list_surfsubsurface)
   283)  
   284) end subroutine SurfSubsurfaceSimulationStrip
   285) 
   286) ! ************************************************************************** !
   287) 
   288) subroutine SurfSubsurfaceSimulationRunToTime(this,target_time)
   289)   ! 
   290)   ! This routine executes surface-subsurface simualation
   291)   ! 
   292)   ! Author: Gautam Bisht, LBNL
   293)   ! Date: 06/27/13
   294)   ! 
   295) 
   296)   use Option_module
   297)   use Simulation_Aux_module
   298) 
   299)   implicit none
   300) 
   301) #include "petsc/finclude/petscviewer.h"
   302) 
   303)   class(simulation_surfsubsurface_type) :: this
   304)   PetscReal :: target_time
   305) 
   306)   class(pmc_base_type), pointer :: cur_process_model_coupler
   307)   PetscViewer :: viewer
   308) 
   309) #ifdef DEBUG
   310)   call printMsg(this%option,'RunToTime()')
   311) #endif
   312)   call this%process_model_coupler_list%RunToTime(target_time,this%stop_flag)
   313) 
   314) end subroutine SurfSubsurfaceSimulationRunToTime
   315) 
   316) ! ************************************************************************** !
   317) 
   318) subroutine SurfSubsurfaceSimulationDestroy(simulation)
   319)   ! 
   320)   ! This routine
   321)   ! 
   322)   ! Author: Gautam Bisht, LBNL
   323)   ! Date: 06/28/13
   324)   ! 
   325) 
   326)   implicit none
   327)   
   328)   class(simulation_surfsubsurface_type), pointer :: simulation
   329)   
   330)   call printMsg(simulation%option,'SimulationDestroy()')
   331)   
   332)   if (.not.associated(simulation)) return
   333)   
   334)   call simulation%Strip()
   335)   deallocate(simulation)
   336)   nullify(simulation)
   337)   
   338) end subroutine SurfSubsurfaceSimulationDestroy
   339) 
   340) end module Simulation_Surf_Subsurf_class

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