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