simulation_base.F90       coverage:  66.67 %func     68.79 %block


     1) module Simulation_Base_class
     2) 
     3)   use PMC_Base_class
     4)   use PM_Base_class
     5)   use Option_module
     6)   use Output_Aux_module
     7)   use Output_module
     8)   use Simulation_Aux_module
     9)   use Waypoint_module
    10)   
    11)   use PFLOTRAN_Constants_module
    12) 
    13)   implicit none
    14) 
    15) #include "petsc/finclude/petscsys.h"
    16)   
    17)   private
    18) 
    19)   type, public :: simulation_base_type
    20)     type(option_type), pointer :: option
    21)     type(waypoint_list_type), pointer :: waypoint_list_outer ! for outer sync loop
    22)     type(checkpoint_option_type), pointer :: checkpoint_option
    23)     type(output_option_type), pointer :: output_option
    24)     PetscInt :: stop_flag
    25)     class(pmc_base_type), pointer :: process_model_coupler_list
    26)     class(pm_base_type), pointer :: process_model_list
    27)     type(simulation_aux_type), pointer :: sim_aux
    28)   contains
    29)     procedure, public :: Init => SimulationBaseInit
    30)     procedure, public :: InitializeRun => SimulationBaseInitializeRun
    31)     procedure, public :: InputRecord => SimulationInputRecord
    32)     procedure, public :: JumpStart => SimulationBaseJumpStart
    33)     procedure, public :: ExecuteRun
    34)     procedure, public :: RunToTime
    35)     procedure, public :: FinalizeRun => SimulationBaseFinalizeRun
    36)     procedure, public :: Strip => SimulationBaseStrip
    37)   end type simulation_base_type
    38)   
    39)   public :: SimulationBaseCreate, &
    40)             SimulationBaseInit, &
    41)             SimulationBaseInitializeRun, &
    42)             SimulationInputRecordPrint, &
    43)             SimulationInputRecord, &
    44)             SimulationGetFinalWaypointTime, &
    45)             SimulationBaseFinalizeRun, &
    46)             SimulationBaseStrip, &
    47)             SimulationBaseDestroy
    48)   
    49) contains
    50) 
    51) ! ************************************************************************** !
    52) 
    53) function SimulationBaseCreate(option)
    54)   ! 
    55)   ! Allocates and initializes a new simulation object
    56)   ! 
    57)   ! Author: Glenn Hammond
    58)   ! Date: 06/11/13
    59)   ! 
    60) 
    61)   use Option_module
    62) 
    63)   implicit none
    64)   
    65)   class(simulation_base_type), pointer :: SimulationBaseCreate
    66) 
    67)   type(option_type), pointer :: option
    68)   
    69)   allocate(SimulationBaseCreate)
    70)   call SimulationBaseCreate%Init(option)
    71) 
    72) end function SimulationBaseCreate
    73) 
    74) ! ************************************************************************** !
    75) 
    76) subroutine SimulationBaseInit(this,option)
    77)   ! 
    78)   ! Initializes a new simulation object
    79)   ! 
    80)   ! Author: Glenn Hammond
    81)   ! Date: 06/11/13
    82)   ! 
    83)   use Timestepper_Base_class, only : TS_CONTINUE
    84)   use Option_module
    85)   use Output_Aux_module
    86)   use Waypoint_module
    87) 
    88)   implicit none
    89)   
    90)   class(simulation_base_type) :: this
    91)   type(option_type), pointer :: option
    92) 
    93)   this%option => option
    94)   this%waypoint_list_outer => WaypointListCreate()
    95)   this%output_option => OutputOptionCreate()
    96)   nullify(this%checkpoint_option)
    97)   nullify(this%process_model_coupler_list)
    98)   nullify(this%process_model_list)
    99)   this%sim_aux => SimAuxCreate()
   100)   this%stop_flag = TS_CONTINUE
   101) 
   102) end subroutine SimulationBaseInit
   103) 
   104) ! ************************************************************************** !
   105) 
   106) subroutine SimulationBaseInitializeRun(this)
   107)   ! 
   108)   ! Initializes simulation
   109)   ! 
   110)   ! Author: Glenn Hammond
   111)   ! Date: 06/11/13
   112)   ! 
   113) 
   114)   use Logging_module
   115)   use Option_module
   116) #if defined(PETSC_HAVE_HDF5)
   117)   use hdf5
   118) #endif
   119) 
   120)   implicit none
   121)   
   122) #include "petsc/finclude/petscviewer.h"  
   123) 
   124)   class(simulation_base_type) :: this
   125) 
   126) #if defined(SCORPIO_WRITE) || !defined(PETSC_HAVE_HDF5)
   127)   integer :: chk_grp_id
   128) #else
   129)   integer(HID_T) :: chk_grp_id
   130) #endif
   131)   PetscViewer :: viewer
   132)   PetscErrorCode :: ierr
   133)   
   134) #ifdef DEBUG
   135)   call printMsg(this%option,'SimulationBaseInitializeRun()')
   136) #endif
   137)   
   138)   if (associated(this%process_model_coupler_list)) then
   139)     if (this%option%restart_flag) then
   140)       if (index(this%option%restart_filename,'.chk') > 0) then
   141)         call this%process_model_coupler_list%RestartBinary(viewer)
   142)       elseif (index(this%option%restart_filename,'.h5') > 0) then
   143) #if !defined(PETSC_HAVE_HDF5)
   144)          this%option%io_buffer = 'HDF5 formatted restart not supported &
   145)               &unless PFLOTRAN is compiled with HDF5 libraries enabled.'
   146)          call printErrMsg(this%option)
   147) #else
   148)         call this%process_model_coupler_list%RestartHDF5(chk_grp_id)
   149) #endif
   150)       else
   151)         this%option%io_buffer = 'Unknown restart filename format. ' // &
   152)         'Only *.chk and *.h5 supported.'
   153)         call printErrMsg(this%option)
   154)       endif
   155)     endif
   156)   
   157)     ! initialize performs overwrite of restart, if applicable
   158)     call this%process_model_coupler_list%InitializeRun()  
   159)     call this%JumpStart()
   160)   endif
   161)   
   162)   call SimulationInputRecordPrint(this)
   163)   call printMsg(this%option," ")
   164)   call printMsg(this%option,"  Finished Initialization")
   165)   call PetscLogEventEnd(logging%event_init,ierr);CHKERRQ(ierr)
   166)   ! pushed in PFLOTRANInitializePostPetsc()
   167)   call PetscLogStagePop(ierr);CHKERRQ(ierr)
   168) 
   169)   ! popped in FinalizeRun()
   170)   call PetscLogStagePush(logging%stage(TS_STAGE),ierr);CHKERRQ(ierr)
   171)   
   172) end subroutine SimulationBaseInitializeRun
   173) 
   174) ! ************************************************************************** !
   175) 
   176) subroutine SimulationInputRecordPrint(this)
   177)   ! 
   178)   ! Writes ingested information to the input record file.
   179)   ! 
   180)   ! Author: Jenn Frederick, SNL
   181)   ! Date: 03/17/2016
   182)   ! 
   183)   use Checkpoint_module
   184) 
   185)   implicit none
   186)   
   187)   class(simulation_base_type) :: this
   188) 
   189)   character(len=MAXWORDLENGTH) :: word
   190)   PetscInt :: id = INPUT_RECORD_UNIT
   191)   PetscBool :: is_open
   192) 
   193)   inquire(id, OPENED=is_open)
   194)   if (is_open .and. OptionPrintToFile(this%option)) then
   195)   !----------------------------------------------------------------------------
   196)     ! print checkpoint information
   197)     call CheckpointInputRecord(this%checkpoint_option,this%waypoint_list_outer)
   198)   
   199)     write(id,'(a)') ' '
   200)     ! print process model coupler and process model information
   201)     call this%process_model_coupler_list%InputRecord()
   202)     
   203)     ! print simulation-specific information
   204)     call this%InputRecord()
   205)   !----------------------------------------------------------------------------
   206)   endif
   207) 
   208) end subroutine SimulationInputRecordPrint
   209) 
   210) ! ************************************************************************** !
   211) 
   212) subroutine SimulationInputRecord(this)
   213)   ! 
   214)   ! Writes ingested information to the input record file.
   215)   ! This subroutine must be extended in the extended simulation objects.
   216)   ! 
   217)   ! Author: Jenn Frederick, SNL
   218)   ! Date: 03/17/2016
   219)   ! 
   220) 
   221)   implicit none
   222)   
   223)   class(simulation_base_type) :: this
   224) 
   225) #ifdef DEBUG
   226)   call printMsg(this%option,'SimulationInputRecord()')
   227) #endif
   228) 
   229)   this%option%io_buffer = 'SimulationInputRecord must be extended for ' // &
   230)     'each simulation mode.'
   231)   call printErrMsg(this%option)
   232) 
   233) end subroutine SimulationInputRecord
   234) 
   235) ! ************************************************************************** !
   236) 
   237) subroutine SimulationBaseJumpStart(this)
   238)   ! 
   239)   ! Gets the time stepping, etc. up and running
   240)   ! 
   241)   ! Author: Glenn Hammond
   242)   ! Date: 08/11/14
   243)   ! 
   244)   use Option_module
   245)   
   246)   implicit none
   247)   
   248)   class(simulation_base_type) :: this
   249)   
   250) #ifdef DEBUG
   251)   call printMsg(this%option,'SimulationBaseJumpStart()')
   252) #endif
   253) 
   254)   this%option%io_buffer = 'SimulationBaseJumpStart must be extended for ' // &
   255)     'each simulation mode.'
   256)   call printErrMsg(this%option)
   257)   
   258) end subroutine SimulationBaseJumpStart
   259) 
   260) ! ************************************************************************** !
   261) 
   262) subroutine ExecuteRun(this)
   263)   ! 
   264)   ! Initializes simulation
   265)   ! 
   266)   ! Author: Glenn Hammond
   267)   ! Date: 06/11/13
   268)   ! 
   269) 
   270)   use Waypoint_module
   271)   use Timestepper_Base_class, only : TS_CONTINUE
   272)   use Checkpoint_module
   273) 
   274)   implicit none
   275)   
   276)   class(simulation_base_type) :: this
   277)   
   278)   PetscReal :: final_time
   279)   PetscReal :: sync_time
   280)   type(waypoint_type), pointer :: cur_waypoint
   281)   character(len=MAXSTRINGLENGTH) :: append_name
   282) 
   283) #ifdef DEBUG
   284)   call printMsg(this%option,'SimulationBaseExecuteRun()')
   285) #endif
   286) 
   287)   if (.not.associated(this%process_model_coupler_list)) then
   288)     return
   289)   endif
   290) 
   291)   append_name = '-restart'
   292) 
   293)   final_time = SimulationGetFinalWaypointTime(this)
   294)   cur_waypoint => this%waypoint_list_outer%first
   295)   call WaypointSkipToTime(cur_waypoint,this%option%time)
   296)   do
   297)     if (this%stop_flag /= TS_CONTINUE) exit ! end simulation
   298)     if (.not.associated(cur_waypoint)) exit
   299)     call this%RunToTime(min(final_time,cur_waypoint%time))
   300)     cur_waypoint => cur_waypoint%next
   301)   enddo
   302)   if (associated(this%process_model_coupler_list%checkpoint_option)) then
   303)     call this%process_model_coupler_list%Checkpoint(append_name)
   304)   endif
   305) 
   306) end subroutine ExecuteRun
   307) 
   308) ! ************************************************************************** !
   309) 
   310) subroutine RunToTime(this,target_time)
   311)   ! 
   312)   ! Executes simulation
   313)   ! 
   314)   ! Author: Glenn Hammond
   315)   ! Date: 06/11/13
   316)   ! 
   317) 
   318)   use Option_module
   319)   use Simulation_Aux_module
   320) 
   321)   implicit none
   322)   
   323) #include "petsc/finclude/petscviewer.h" 
   324) 
   325)   class(simulation_base_type) :: this
   326)   PetscReal :: target_time
   327)   
   328)   class(pmc_base_type), pointer :: cur_process_model_coupler
   329)   
   330) #ifdef DEBUG
   331)   call printMsg(this%option,'SimulationBaseRunToTime()')
   332) #endif
   333)   
   334)   call this%process_model_coupler_list%RunToTime(target_time,this%stop_flag)
   335) 
   336) end subroutine RunToTime
   337) 
   338) ! ************************************************************************** !
   339) 
   340) subroutine SimulationBaseFinalizeRun(this)
   341)   ! 
   342)   ! Finalizes simulation
   343)   ! 
   344)   ! Author: Glenn Hammond
   345)   ! Date: 06/11/13
   346)   ! 
   347) 
   348)   use Logging_module
   349)   use Timestepper_Base_class, only : TS_STOP_WALLCLOCK_EXCEEDED
   350)   
   351)   implicit none
   352)   
   353)   class(simulation_base_type) :: this
   354)   
   355)   PetscErrorCode :: ierr
   356)   
   357)   class(pmc_base_type), pointer :: cur_process_model_coupler
   358) 
   359) #ifdef DEBUG
   360)   call printMsg(this%option,'SimulationBaseFinalizeRun()')
   361) #endif
   362)   
   363)   if (this%stop_flag == TS_STOP_WALLCLOCK_EXCEEDED) then
   364)     call printMsg(this%option,"Wallclock stop time exceeded.  Exiting!!!")
   365)     call printMsg(this%option,"")
   366)   endif
   367)   
   368)   if (associated(this%process_model_coupler_list)) then
   369)     call this%process_model_coupler_list%FinalizeRun()
   370)   endif
   371)   
   372)   ! pushed in InitializeRun()
   373)   call PetscLogStagePop(ierr);CHKERRQ(ierr)
   374)   ! popped in OptionFinalize()
   375)   call PetscLogStagePush(logging%stage(FINAL_STAGE),ierr);CHKERRQ(ierr)
   376)   
   377) end subroutine SimulationBaseFinalizeRun
   378) 
   379) ! ************************************************************************** !
   380) 
   381) function SimulationGetFinalWaypointTime(this)
   382)   ! 
   383)   ! Returns the earliest final waypoint time
   384)   ! from the top layer of process model
   385)   ! couplers.
   386)   ! 
   387)   ! Author: Glenn Hammond
   388)   ! Date: 06/12/13
   389)   ! 
   390) 
   391)   use Waypoint_module
   392) 
   393)   implicit none
   394)   
   395)   class(simulation_base_type) :: this
   396)   
   397)   PetscReal :: SimulationGetFinalWaypointTime
   398) 
   399)   class(pmc_base_type), pointer :: cur_process_model_coupler
   400)   PetscReal :: final_time
   401)   
   402)   SimulationGetFinalWaypointTime = 0.d0
   403)   
   404)   cur_process_model_coupler => this%process_model_coupler_list
   405)   do
   406)     if (.not.associated(cur_process_model_coupler)) exit
   407)     final_time = WaypointListGetFinalTime(cur_process_model_coupler% &
   408)                                             waypoint_list)
   409)     if (SimulationGetFinalWaypointTime < 1.d-40 .or. &
   410)         final_time < SimulationGetFinalWaypointTime) then
   411)       SimulationGetFinalWaypointTime = final_time
   412)     endif
   413)     cur_process_model_coupler => cur_process_model_coupler%peer
   414)   enddo
   415) 
   416) end function SimulationGetFinalWaypointTime
   417) 
   418) ! ************************************************************************** !
   419) 
   420) subroutine SimulationBaseStrip(this)
   421)   ! 
   422)   ! Deallocates members of simulation base
   423)   ! 
   424)   ! Author: Glenn Hammond
   425)   ! Date: 06/11/13
   426)   ! 
   427)   use Input_Aux_module
   428)   use Waypoint_module
   429)   use EOS_module
   430)   
   431)   implicit none
   432)   
   433)   class(simulation_base_type) :: this
   434)   
   435) #ifdef DEBUG
   436)   call printMsg(this%option,'SimulationBaseStrip()')
   437) #endif
   438)   call WaypointListDestroy(this%waypoint_list_outer)
   439)   call SimAuxDestroy(this%sim_aux)
   440)   call CheckpointOptionDestroy(this%checkpoint_option)
   441)   call OutputOptionDestroy(this%output_option)
   442)   if (associated(this%process_model_coupler_list)) then
   443)     call this%process_model_coupler_list%Destroy()
   444)     ! destroy does not currently destroy; it strips
   445)     deallocate(this%process_model_coupler_list)
   446)     nullify(this%process_model_coupler_list)
   447)   endif
   448)   call InputDbaseDestroy()
   449) 
   450)   call AllEOSDBaseDestroy()
   451)   
   452) end subroutine SimulationBaseStrip
   453) 
   454) ! ************************************************************************** !
   455) 
   456) subroutine SimulationBaseDestroy(simulation)
   457)   ! 
   458)   ! Deallocates a simulation
   459)   ! 
   460)   ! Author: Glenn Hammond
   461)   ! Date: 06/11/13
   462)   ! 
   463) 
   464)   implicit none
   465)   
   466)   class(simulation_base_type), pointer :: simulation
   467)   
   468) #ifdef DEBUG
   469)   call printMsg(simulation%option,'SimulationDestroy()')
   470) #endif
   471)   
   472)   if (.not.associated(simulation)) return
   473)   
   474)   call simulation%Strip()
   475)   deallocate(simulation)
   476)   nullify(simulation)
   477)   
   478) end subroutine SimulationBaseDestroy
   479)   
   480) end module Simulation_Base_class

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