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