timestepper_surface.F90       coverage:  28.57 %func     39.18 %block


     1) module Timestepper_Surface_class
     2) 
     3)   use Timestepper_Base_class
     4)   use Solver_module
     5)   use Waypoint_module
     6) 
     7)   use PFLOTRAN_Constants_module
     8) 
     9)   implicit none
    10) 
    11) #include "petsc/finclude/petscsys.h"
    12) 
    13)   private
    14) 
    15)   type, public, extends(timestepper_base_type) :: timestepper_surface_type
    16)     PetscReal :: dt_max_allowable
    17)     PetscReal :: surf_subsurf_coupling_flow_dt
    18)     type(solver_type), pointer :: solver
    19)   contains
    20)     procedure, public :: CheckpointBinary => TimestepperSurfaceCheckpointBinary
    21)     procedure, public :: Init => TimestepperSurfaceInit
    22)     procedure, public :: RestartBinary => TimestepperSurfaceRestartBinary
    23)     procedure, public :: Reset => TimestepperSurfaceReset
    24)     procedure, public :: SetTargetTime => TimestepperSurfaceSetTargetTime
    25)     procedure, public :: InputRecord => TimestepperSurfInputRecord
    26)     procedure, public :: Strip => TimestepperSurfaceStrip
    27)     procedure, public :: StepDT => TimestepperSurfaceStepDT
    28)   end type timestepper_surface_type
    29) 
    30)   ! For checkpointing
    31)   type, public, extends(stepper_base_header_type) :: timestepper_surface_header_type
    32)     real*8 :: dt_max_allowable
    33)     real*8 :: surf_subsurf_coupling_flow_dt
    34)   end type timestepper_surface_header_type
    35)   PetscSizeT, parameter, private :: bagsize = 80 ! 64 (base) + 16 (BE)
    36) 
    37)   interface PetscBagGetData
    38)     subroutine PetscBagGetData(bag,header,ierr)
    39)       import :: timestepper_surface_header_type
    40)       implicit none
    41) #include "petsc/finclude/petscbag.h"
    42)       PetscBag :: bag
    43)       class(timestepper_surface_header_type), pointer :: header
    44)       PetscErrorCode :: ierr
    45)     end subroutine
    46)   end interface PetscBagGetData
    47) 
    48)   public TimestepperSurfaceSetTargetTime, &
    49)          TimestepperSurfaceCreate
    50) 
    51) contains
    52) 
    53) ! ************************************************************************** !
    54) 
    55) function TimestepperSurfaceCreate()
    56)   ! 
    57)   ! This routine
    58)   ! 
    59)   ! Author: Gautam Bisht, LBNL
    60)   ! Date: 07/03/13
    61)   ! 
    62) 
    63)   implicit none
    64)   
    65)   class(timestepper_surface_type), pointer :: TimestepperSurfaceCreate
    66)   
    67)   class(timestepper_surface_type), pointer :: surf_timestepper
    68)   
    69)   allocate(surf_timestepper)
    70)   call surf_timestepper%Init()
    71)   
    72)   surf_timestepper%solver => SolverCreate()
    73)   
    74)   TimestepperSurfaceCreate => surf_timestepper
    75)   
    76) end function TimestepperSurfaceCreate
    77) 
    78) ! ************************************************************************** !
    79) 
    80) subroutine TimestepperSurfaceInit(this)
    81)   ! 
    82)   ! This routine
    83)   ! 
    84)   ! Author: Gautam Bisht, LBNL
    85)   ! Date: 07/03/13
    86)   ! 
    87) 
    88)   implicit none
    89)   
    90)   class (timestepper_surface_type) :: this
    91) 
    92)   call TimestepperBaseInit(this)
    93) 
    94)   this%dt_max_allowable = 0.d0
    95)   this%surf_subsurf_coupling_flow_dt = 0.d0
    96)   
    97) end subroutine TimestepperSurfaceInit
    98) 
    99) ! ************************************************************************** !
   100) 
   101) subroutine TimestepperSurfaceSetTargetTime(this,sync_time,option,stop_flag, &
   102)                                            snapshot_plot_flag, &
   103)                                            observation_plot_flag, &
   104)                                            massbal_plot_flag,checkpoint_flag)
   105)   ! 
   106)   ! This routine ?
   107)   ! 
   108)   ! Author: Gautam Bisht, LBNL
   109)   ! Date: 07/02/13
   110)   ! 
   111) 
   112)   use Option_module
   113) 
   114)   implicit none
   115) 
   116)   class(timestepper_surface_type) :: this
   117)   PetscReal :: sync_time
   118)   type(option_type) :: option
   119)   PetscInt :: stop_flag
   120)   PetscBool :: snapshot_plot_flag
   121)   PetscBool :: observation_plot_flag
   122)   PetscBool :: massbal_plot_flag
   123)   PetscBool :: checkpoint_flag
   124) 
   125)   PetscReal :: dt
   126)   PetscReal :: target_time
   127)   PetscReal :: max_time
   128)   PetscReal :: tolerance
   129)   PetscBool :: equal_to_or_exceeds_waypoint
   130)   PetscBool :: equal_to_or_exceeds_sync_time
   131)   PetscBool :: force_to_match_waypoint
   132)   type(waypoint_type), pointer :: cur_waypoint
   133)   
   134)   cur_waypoint => this%cur_waypoint
   135) 
   136)   dt = min(this%dt_max_allowable,this%dt_max)
   137)   target_time = this%target_time + dt
   138)   tolerance = this%time_step_tolerance
   139) 
   140)   snapshot_plot_flag = PETSC_FALSE
   141)   observation_plot_flag = PETSC_FALSE
   142)   massbal_plot_flag = PETSC_FALSE
   143)   
   144)   if (cur_waypoint%time < 1.d-40) then
   145)     cur_waypoint => cur_waypoint%next
   146)   endif
   147) 
   148)   force_to_match_waypoint = WaypointForceMatchToTime(cur_waypoint)
   149)   equal_to_or_exceeds_waypoint = target_time + tolerance*dt >= cur_waypoint%time
   150)   equal_to_or_exceeds_sync_time = target_time + tolerance*dt >= sync_time
   151) 
   152)   if (equal_to_or_exceeds_sync_time .or. &
   153)       (equal_to_or_exceeds_waypoint .and. force_to_match_waypoint)) then
   154) 
   155)     max_time = min(sync_time,cur_waypoint%time)
   156)     ! decrement by time step size
   157)     target_time = target_time - dt
   158)     ! set new time step size based on max time
   159)     dt = max_time - target_time
   160)     target_time = target_time + dt
   161) 
   162)     if (max_time == cur_waypoint%time) then
   163)       if (cur_waypoint%print_snap_output) snapshot_plot_flag = PETSC_TRUE
   164)       if (cur_waypoint%print_checkpoint) checkpoint_flag = PETSC_TRUE
   165)     endif
   166) 
   167)     if (equal_to_or_exceeds_sync_time) then
   168)       max_time = sync_time
   169)       ! decrement by time step size
   170)       target_time = target_time - dt
   171)       ! set new time step size based on max time
   172)       dt = max_time - target_time
   173)       target_time = target_time + dt
   174) 
   175)     endif
   176) 
   177)     if (equal_to_or_exceeds_waypoint .and. force_to_match_waypoint) then
   178)       max_time = cur_waypoint%time
   179)       ! decrement by time step size
   180)       target_time = target_time - dt
   181)       ! set new time step size based on max time
   182)       dt = max_time - target_time
   183) 
   184)       target_time = target_time + dt
   185) 
   186)       if (cur_waypoint%print_snap_output) snapshot_plot_flag = PETSC_TRUE
   187)       if (cur_waypoint%print_checkpoint) checkpoint_flag = PETSC_TRUE
   188)     endif
   189)   
   190)   endif
   191) 
   192)   if (target_time >= cur_waypoint%time) then
   193)     cur_waypoint => cur_waypoint%next
   194)   endif
   195)   this%dt = dt
   196)   this%target_time = target_time
   197)   this%cur_waypoint => cur_waypoint
   198)   if (.not.associated(cur_waypoint)) stop_flag = TS_STOP_END_SIMULATION
   199) 
   200) end subroutine TimestepperSurfaceSetTargetTime
   201) 
   202) ! ************************************************************************** !
   203) 
   204) subroutine TimestepperSurfaceStepDT(this,process_model,stop_flag)
   205)   ! 
   206)   ! This is a dummy routine added to be extended in timestepper_surface_type
   207)   ! 
   208)   ! Author: Gautam Bisht, LBNL
   209)   ! Date: 07/03/13
   210)   ! 
   211) 
   212)   use PM_Base_class
   213)   use PM_Surface_Flow_class
   214)   use Option_module
   215)   use Output_module, only : Output
   216)   use Surface_Flow_module
   217)   
   218)   implicit none
   219) 
   220) #include "petsc/finclude/petscvec.h"
   221) #include "petsc/finclude/petscvec.h90"
   222) #include "petsc/finclude/petscsnes.h"
   223) #include "petsc/finclude/petscts.h"  
   224) 
   225)   class(timestepper_surface_type) :: this
   226)   class(pm_base_type) :: process_model
   227)   PetscInt :: stop_flag
   228) 
   229)   PetscReal :: time
   230)   PetscReal :: dtime
   231)   PetscReal :: tmp
   232)   type(solver_type), pointer :: solver
   233)   type(option_type), pointer :: option
   234)   PetscErrorCode :: ierr
   235) 
   236)   solver => this%solver
   237)   option => process_model%option
   238) 
   239)   call process_model%PreSolve()
   240) 
   241)   call TSSetTimeStep(solver%ts,option%surf_flow_dt,ierr);CHKERRQ(ierr)
   242)   call TSSetExactFinalTime(solver%ts,TS_EXACTFINALTIME_MATCHSTEP, &
   243)                            ierr);CHKERRQ(ierr)
   244)   call TSSolve(solver%ts,process_model%solution_vec,ierr);CHKERRQ(ierr)
   245)   call TSGetTime(solver%ts,time,ierr);CHKERRQ(ierr)
   246)   call TSGetTimeStep(solver%ts,dtime,ierr);CHKERRQ(ierr)
   247) 
   248)   call process_model%PostSolve()
   249) 
   250)   this%steps = this%steps + 1
   251) 
   252)   if (option%print_screen_flag) then
   253)     write(*, '(" SURFACE FLOW ",i6," Time= ",1pe12.5," Dt= ",1pe12.5," [",a1,"]")') &
   254)       this%steps, &
   255)       time/process_model%output_option%tconv, &
   256)       dtime/process_model%output_option%tconv, &
   257)       process_model%output_option%tunit
   258)   endif
   259) 
   260) end subroutine TimestepperSurfaceStepDT
   261) 
   262) ! ************************************************************************** !
   263) 
   264) subroutine TimestepperSurfaceCheckpointBinary(this,viewer,option)
   265)   ! 
   266)   ! This checkpoints parameters/variables associated with surface-timestepper
   267)   ! 
   268)   ! Author: Gautam Bisht, LBNL
   269)   ! Date: 09/18/13
   270)   ! 
   271) 
   272)   use Option_module
   273) 
   274)   implicit none
   275) 
   276) #include "petsc/finclude/petscviewer.h"
   277) #include "petsc/finclude/petscbag.h"
   278) 
   279)   class(timestepper_surface_type) :: this
   280)   PetscViewer :: viewer
   281)   type(option_type) :: option
   282) 
   283)   class(timestepper_surface_header_type), pointer :: header
   284)   PetscBag :: bag
   285)   PetscErrorCode :: ierr
   286) 
   287)   call PetscBagCreate(option%mycomm,bagsize,bag,ierr);CHKERRQ(ierr)
   288)   call PetscBagGetData(bag,header,ierr);CHKERRQ(ierr)
   289)   call TimestepperSurfaceRegisterHeader(this,bag,header)
   290)   call TimestepperSurfaceSetHeader(this,bag,header)
   291)   call PetscBagView(bag,viewer,ierr);CHKERRQ(ierr)
   292)   call PetscBagDestroy(bag,ierr);CHKERRQ(ierr)
   293) 
   294) end subroutine TimestepperSurfaceCheckpointBinary
   295) 
   296) ! ************************************************************************** !
   297) 
   298) subroutine TimestepperSurfaceRestartBinary(this,viewer,option)
   299)   ! 
   300)   ! This checkpoints parameters/variables associated with surface-timestepper
   301)   ! 
   302)   ! Author: Gautam Bisht, LBNL
   303)   ! Date: 09/18/13
   304)   ! 
   305) 
   306)   use Option_module
   307) 
   308)   implicit none
   309) 
   310) #include "petsc/finclude/petscviewer.h"
   311) #include "petsc/finclude/petscbag.h"
   312) 
   313)   class(timestepper_surface_type) :: this
   314)   PetscViewer :: viewer
   315)   type(option_type) :: option
   316) 
   317)   class(timestepper_surface_header_type), pointer :: header
   318)   PetscBag :: bag
   319)   PetscErrorCode :: ierr
   320) 
   321)   call PetscBagCreate(option%mycomm,bagsize,bag,ierr);CHKERRQ(ierr)
   322)   call PetscBagGetData(bag,header,ierr);CHKERRQ(ierr)
   323)   call TimestepperSurfaceRegisterHeader(this,bag,header)
   324)   call PetscBagLoad(viewer,bag,ierr);CHKERRQ(ierr)
   325)   call TimestepperSurfaceGetHeader(this,header)
   326)   call PetscBagDestroy(bag,ierr);CHKERRQ(ierr)
   327) 
   328) end subroutine TimestepperSurfaceRestartBinary
   329) 
   330) ! ************************************************************************** !
   331) 
   332) subroutine TimestepperSurfaceRegisterHeader(this,bag,header)
   333)   ! 
   334)   ! This subroutine register header entries for surface-flow.
   335)   ! 
   336)   ! Author: Gautam Bisht, LBNL
   337)   ! Date: 09/19/13
   338)   ! 
   339) 
   340)   use Option_module
   341) 
   342)   implicit none
   343) 
   344) #include "petsc/finclude/petscviewer.h"
   345) #include "petsc/finclude/petscbag.h"
   346) 
   347)   class(timestepper_surface_type) :: this
   348)   class(timestepper_surface_header_type) :: header
   349)   PetscBag :: bag
   350) 
   351)   PetscErrorCode :: ierr
   352) 
   353)   ! bagsize = 2 * 8 bytes = 16 bytes
   354)   call PetscBagRegisterReal(bag,header%dt_max_allowable,0.d0, &
   355)                            "dt_max_allowable","",ierr);CHKERRQ(ierr)
   356)   call PetscBagRegisterReal(bag,header%surf_subsurf_coupling_flow_dt,0.d0, &
   357)                            "surf_subsurf_coupling_flow_dt","", &
   358)                             ierr);CHKERRQ(ierr)
   359) 
   360)   call TimestepperBaseRegisterHeader(this,bag,header)
   361) 
   362) end subroutine TimestepperSurfaceRegisterHeader
   363) 
   364) ! ************************************************************************** !
   365) 
   366) subroutine TimestepperSurfaceSetHeader(this,bag,header)
   367)   ! 
   368)   ! This subroutine sets values in checkpoint header.
   369)   ! 
   370)   ! Author: Gautam Bisht, LBNL
   371)   ! Date: 09/19/13
   372)   ! 
   373) 
   374)   use Option_module
   375) 
   376)   implicit none
   377) 
   378) #include "petsc/finclude/petscviewer.h"
   379) #include "petsc/finclude/petscbag.h"
   380) 
   381)   class(timestepper_surface_type) :: this
   382)   class(timestepper_surface_header_type) :: header
   383)   PetscBag :: bag
   384) 
   385)   PetscErrorCode :: ierr
   386) 
   387)   header%dt_max_allowable = this%dt_max_allowable
   388)   header%surf_subsurf_coupling_flow_dt = this%surf_subsurf_coupling_flow_dt
   389) 
   390)   call TimestepperBaseSetHeader(this,bag,header)
   391) 
   392) end subroutine TimestepperSurfaceSetHeader
   393) 
   394) ! ************************************************************************** !
   395) 
   396) subroutine TimestepperSurfaceGetHeader(this,header)
   397)   ! 
   398)   ! This subroutine gets values in checkpoint header.
   399)   ! 
   400)   ! Author: Gautam Bisht, LBNL
   401)   ! Date: 09/19/13
   402)   ! 
   403) 
   404)   use Option_module
   405) 
   406)   implicit none
   407) 
   408) #include "petsc/finclude/petscviewer.h"
   409) 
   410)   class(timestepper_surface_type) :: this
   411)   class(timestepper_surface_header_type) :: header
   412) 
   413)   PetscErrorCode :: ierr
   414) 
   415)   this%dt_max_allowable = header%dt_max_allowable
   416)   this%surf_subsurf_coupling_flow_dt = header%surf_subsurf_coupling_flow_dt
   417) 
   418)   call TimestepperBaseGetHeader(this,header)
   419) 
   420)   call TSSetTime(this%solver%ts,this%target_time,ierr);CHKERRQ(ierr)
   421) 
   422) end subroutine TimestepperSurfaceGetHeader
   423) 
   424) ! ************************************************************************** !
   425) 
   426) subroutine TimestepperSurfaceReset(this)
   427) 
   428)   implicit none
   429) 
   430)   class(timestepper_surface_type) :: this
   431) 
   432)   PetscErrorCode :: ierr
   433) 
   434) #if 0
   435)   !TODO(Gautam): set these back to their initial values as if a simulation
   436)   !              were initialized, but not yet run
   437)   this%dt_max_allowable = header%dt_max_allowable
   438)   this%surf_subsurf_coupling_flow_dt = header%surf_subsurf_coupling_flow_dt
   439) 
   440)   call TimestepperBaseReset(this)
   441) 
   442)   !TODO(Gautam): this%target_time is set to 0.d0 in TimestepperBaseReset(). Is
   443)   !              that OK? - Glenn
   444)   call TSSetTime(this%solver%ts,this%target_time,ierr);CHKERRQ(ierr)
   445) #endif
   446) 
   447) end subroutine TimestepperSurfaceReset
   448) 
   449) ! ************************************************************************** !
   450) 
   451) subroutine TimestepperSurfacePrintInfo(this,option)
   452)   ! 
   453)   ! Prints settings for base timestepper.
   454)   ! 
   455)   ! Author: Glenn Hammond
   456)   ! Date: 12/04/14
   457)   ! 
   458)   use Option_module
   459) 
   460)   implicit none
   461)   
   462) #include "petsc/finclude/petscts.h"  
   463) 
   464)   class(timestepper_surface_type) :: this
   465)   type(option_type) :: option
   466)   
   467)   PetscErrorCode :: ierr
   468)   
   469)   if (OptionPrintToScreen(option)) then
   470)     write(*,*) ' '
   471)     write(*,*) 'Surface Flow TS Solver:'
   472)     call TSView(this%solver%ts,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
   473)   endif
   474)   call TimestepperBasePrintInfo(this,option)
   475)   call SolverPrintNewtonInfo(this%solver,this%name,option)
   476)   call SolverPrintLinearInfo(this%solver,this%name,option)
   477)   
   478) end subroutine TimestepperSurfacePrintInfo
   479) 
   480) ! ************************************************************************** !
   481) 
   482) subroutine TimestepperSurfInputRecord(this)
   483)   ! 
   484)   ! Prints information about the time stepper to the input record.
   485)   ! To get a## format, must match that in simulation types.
   486)   ! 
   487)   ! Author: Jenn Frederick, SNL
   488)   ! Date: 03/17/2016
   489)   ! 
   490)   
   491)   implicit none
   492)   
   493)   class(timestepper_surface_type) :: this
   494) 
   495)   PetscInt :: id
   496)   character(len=MAXWORDLENGTH) :: word
   497)    
   498)   id = INPUT_RECORD_UNIT
   499) 
   500)   write(id,'(a29)',advance='no') 'pmc timestepper: '
   501)   write(id,'(a)') this%name
   502) 
   503)   write(id,'(a29)',advance='no') 'max timestep size: '
   504)   write(word,*) this%dt_max_allowable
   505)   write(id,'(a)') trim(adjustl(word)) // ' sec'
   506) 
   507) end subroutine TimestepperSurfInputRecord
   508) 
   509) ! ************************************************************************** !
   510) 
   511) subroutine TimestepperSurfaceStrip(this)
   512)   ! 
   513)   ! Deallocates members of a surface time stepper
   514)   ! 
   515)   ! Author: Glenn Hammond
   516)   ! Date: 12/02/14
   517)   ! 
   518) 
   519)   implicit none
   520)   
   521)   class(timestepper_surface_type) :: this
   522)   
   523)   call TimestepperBaseStrip(this)
   524)   call SolverDestroy(this%solver)
   525) 
   526) end subroutine TimestepperSurfaceStrip
   527) 
   528) ! ************************************************************************** !
   529) 
   530) subroutine TimestepperSurfaceDestroy(this)
   531)   ! 
   532)   ! Deallocates a surface time stepper
   533)   ! 
   534)   ! Author: Glenn Hammond
   535)   ! Date: 12/02/14
   536)   ! 
   537) 
   538)   implicit none
   539)   
   540)   class(timestepper_surface_type) :: this
   541)   
   542)   call TimestepperSurfaceStrip(this)
   543)   
   544) end subroutine TimestepperSurfaceDestroy
   545) 
   546) end module Timestepper_Surface_class

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