checkpoint_surface.F90 coverage: 0.00 %func 0.00 %block
1) module Checkpoint_Surface_Header_module
2)
3) implicit none
4)
5) private
6)
7) #include "petsc/finclude/petscsys.h"
8)
9) ! We must manually specify the number of bytes required for the
10) ! checkpoint header ('surface_bagsize'), since sizeof() is not supported by
11) ! some Fortran compilers. To be on the safe side, we assume an integer is 8
12) ! bytes.
13) ! Currently:
14) ! PetscReal: 5
15) ! PetscInt: 5
16) ! Total: 10 * 8 = 80
17) ! IMPORTANT: If you change the contents of the header, you MUST update
18) ! 'surface_bagsize' or risk corrupting memory.
19) #ifdef PetscSizeT
20) PetscSizeT, parameter :: surface_bagsize = 80
21) #else
22) ! PETSC_SIZEOF_SIZE_T isn't defined, so we just have to assume that it
23) ! is 8 bytes. This is dangerous, but what can we do?
24) integer*8, parameter :: surface_bagsize = 80
25) #endif
26)
27) public :: surface_bagsize
28) type, public :: surface_checkpoint_header_type
29)
30) integer*8 :: revision_number ! increment this every time there is a change
31)
32) integer*8 :: grid_discretization_type
33)
34) integer*8 :: nsurfflowdof
35) integer*8 :: surface_flow_formulation
36) real*8 :: surf_flow_time
37) real*8 :: surf_flow_dt
38) real*8 :: surf_flow_prev_dt
39)
40) integer*8 :: subsurf_surf_coupling
41) real*8 :: surf_subsurf_coupling_time
42) real*8 :: surf_subsurf_coupling_flow_dt
43)
44) end type surface_checkpoint_header_type
45) end module Checkpoint_Surface_Header_module
46)
47) module Checkpoint_Surface_module
48)
49) use Checkpoint_Surface_Header_module
50)
51) use PFLOTRAN_Constants_module
52)
53) implicit none
54)
55) private
56)
57) public :: SurfaceCheckpointBinary, SurfaceRestartBinary
58) public :: SurfaceCheckpointProcessModelBinary, &
59) SurfaceRestartProcessModelBinary
60)
61) #include "petsc/finclude/petscsys.h"
62) #include "petsc/finclude/petscvec.h"
63) #include "petsc/finclude/petscvec.h90"
64) #include "petsc/finclude/petscdm.h"
65) #include "petsc/finclude/petscdm.h90"
66) #include "petsc/finclude/petscdef.h"
67) #include "petsc/finclude/petscis.h"
68) #include "petsc/finclude/petscis.h90"
69) #include "petsc/finclude/petsclog.h"
70) #include "petsc/finclude/petscviewer.h"
71) #include "petsc/finclude/petscbag.h"
72)
73) Interface PetscBagGetData
74) Subroutine PetscBagGetData(bag,ctx,ierr)
75) use Checkpoint_Surface_Header_module
76) PetscBag bag
77) type(surface_checkpoint_header_type), pointer :: ctx
78) PetscErrorCode ierr
79) End Subroutine
80) End Interface PetscBagGetData
81)
82) contains
83)
84) ! ************************************************************************** !
85)
86) subroutine SurfaceCheckpointBinary(surf_realization, &
87) surf_flow_prev_dt, &
88) id)
89) !
90) ! This subroutine writes a checkpoint file for surface realization.
91) !
92) ! Author: Gautam Bisht, LBNL
93) ! Date: 06/11/13
94) !
95)
96) use Realization_Surface_class
97) use Surface_Field_module
98) use Grid_module
99) use Discretization_module
100) use Output_Aux_module
101) use Option_module
102)
103) implicit none
104)
105) class(realization_surface_type) :: surf_realization
106) PetscReal :: surf_flow_prev_dt
107) PetscInt, intent(in) :: id ! id should not be altered within this subroutine
108)
109) character(len=MAXSTRINGLENGTH) :: filename
110) character(len=MAXWORDLENGTH) :: id_string
111) PetscViewer :: viewer
112) PetscBag :: bag
113) type(surface_checkpoint_header_type), pointer :: surf_header
114) PetscErrorCode :: ierr
115) PetscLogDouble :: tstart, tend
116)
117) Vec :: global_vec
118) PetscInt :: int_flag
119)
120) type(surface_field_type), pointer :: surf_field
121) type(option_type), pointer :: option
122) type(grid_type), pointer :: grid
123) type(discretization_type), pointer :: discretization
124) type(output_option_type), pointer :: output_option
125) PetscInt :: i, j, k
126)
127) surf_field => surf_realization%surf_field
128) option => surf_realization%option
129) discretization => surf_realization%discretization
130) grid => discretization%grid
131)
132) option%io_buffer = 'Checkpointing of surface flow must be updated.'
133) call printErrMsg(option)
134)
135) ! Open the checkpoint file.
136) call PetscTime(tstart,ierr);CHKERRQ(ierr)
137) if (id < 0) then
138) filename = trim(option%global_prefix) // trim(option%group_prefix) // &
139) '-restart-surf.chk'
140) else
141) write(id_string,'(i8)') id
142) filename = trim(option%global_prefix) // trim(option%group_prefix) // &
143) '-surf.chk' // trim(adjustl(id_string))
144) endif
145)
146) call PetscViewerCreate(option%mycomm,viewer,ierr);CHKERRQ(ierr)
147) call PetscViewerSetType(viewer,PETSCVIEWERBINARY,ierr);CHKERRQ(ierr)
148) call PetscViewerFileSetMode(viewer,FILE_MODE_WRITE,ierr);CHKERRQ(ierr)
149) call PetscViewerBinarySkipInfo(viewer,ierr);CHKERRQ(ierr)
150) call PetscViewerFileSetName(viewer,filename,ierr);CHKERRQ(ierr)
151)
152) call PetscBagCreate(option%mycomm,surface_bagsize, bag, ierr);CHKERRQ(ierr)
153) call PetscBagGetData(bag, surf_header, ierr);CHKERRQ(ierr)
154)
155) call SurfCheckpointRegisterBagHeader(bag,surf_header)
156)
157) ! Register
158) surf_header%grid_discretization_type = grid%itype
159)
160) surf_header%nsurfflowdof = option%nsurfflowdof
161) surf_header%surface_flow_formulation = option%surface_flow_formulation
162) surf_header%surf_flow_time = option%surf_flow_time
163) surf_header%surf_flow_dt = option%surf_flow_dt
164) surf_header%surf_flow_prev_dt = surf_flow_prev_dt
165)
166) surf_header%subsurf_surf_coupling = option%subsurf_surf_coupling
167) surf_header%surf_subsurf_coupling_time = option%surf_subsurf_coupling_time
168) surf_header%surf_subsurf_coupling_flow_dt = option%surf_subsurf_coupling_flow_dt
169)
170) ! Actually write the components of the PetscBag and then free it.
171) call PetscBagView(bag, viewer, ierr);CHKERRQ(ierr)
172) call PetscBagDestroy(bag, ierr);CHKERRQ(ierr)
173)
174) !--------------------------------------------------------------------
175) ! Dump all the relevant vectors.
176) !--------------------------------------------------------------------
177)
178) if (option%nflowdof > 0) then
179) call DiscretizationCreateVector(discretization,ONEDOF, &
180) global_vec,GLOBAL,option)
181) ! grid%flow_xx is the vector into which all of the primary variables are
182) ! packed for the TSSolve().
183) call VecView(surf_field%flow_xx, viewer, ierr);CHKERRQ(ierr)
184)
185) ! Mannings coefficient.
186) call DiscretizationLocalToGlobal(discretization,surf_field%mannings_loc, &
187) global_vec,ONEDOF)
188) call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
189) endif
190)
191) if (global_vec /= 0) then
192) call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
193) endif
194)
195) ! We are finished, so clean up.
196) call PetscViewerDestroy(viewer, ierr);CHKERRQ(ierr)
197)
198) write(option%io_buffer,'(" --> Dump checkpoint file: ", a32)') trim(filename)
199) call printMsg(option)
200)
201) call PetscTime(tend,ierr);CHKERRQ(ierr)
202) write(option%io_buffer, &
203) '(" Seconds to write to checkpoint file: ", f10.2)') tend-tstart
204) call printMsg(option)
205)
206) end subroutine SurfaceCheckpointBinary
207)
208) ! ************************************************************************** !
209)
210) subroutine SurfaceRestartBinary(surf_realization, surf_flow_prev_dt, surf_flow_read)
211) !
212) ! This subroutine restarts surface-realization simulation by reading a
213) ! checkpoint file.
214) !
215) ! Author: Gautam Bisht, LBNL
216) ! Date: 06/11/13
217) !
218)
219)
220) use Realization_Surface_class
221) use Surface_Field_module
222) use Grid_module
223) use Discretization_module
224) use Output_Aux_module
225) use Option_module
226)
227) implicit none
228)
229) class(realization_surface_type) :: surf_realization
230) PetscReal :: surf_flow_prev_dt
231) PetscBool :: surf_flow_read
232)
233) type(surface_field_type), pointer :: surf_field
234) type(option_type), pointer :: option
235) type(grid_type), pointer :: grid
236) type(discretization_type), pointer :: discretization
237)
238) PetscViewer :: viewer
239) PetscBag :: bag
240) type(surface_checkpoint_header_type), pointer :: surf_header
241) PetscLogDouble :: tstart, tend
242) PetscErrorCode :: ierr
243)
244) Vec :: global_vec
245) character(len=MAXSTRINGLENGTH) :: string
246)
247) surf_field => surf_realization%surf_field
248) option => surf_realization%option
249) discretization => surf_realization%discretization
250) grid => discretization%grid
251)
252) call PetscTime(tstart,ierr);CHKERRQ(ierr)
253) option%io_buffer = '--> Open checkpoint file: ' // &
254) trim(option%surf_restart_filename)
255) call printMsg(option)
256) call PetscViewerBinaryOpen(option%mycomm,option%surf_restart_filename, &
257) FILE_MODE_READ,viewer,ierr);CHKERRQ(ierr)
258) ! skip reading info file when loading, but not working
259) call PetscViewerBinarySetSkipOptions(viewer,PETSC_TRUE,ierr);CHKERRQ(ierr)
260)
261) ! Get the header data.
262) call PetscBagCreate(option%mycomm, surface_bagsize, bag, ierr);CHKERRQ(ierr)
263) call PetscBagGetData(bag, surf_header, ierr);CHKERRQ(ierr)
264) call SurfCheckpointRegisterBagHeader(bag,surf_header)
265) call PetscBagLoad(viewer, bag, ierr);CHKERRQ(ierr)
266)
267) if (surf_header%revision_number /= CHECKPOINT_REVISION_NUMBER) then
268) write(string,*) surf_header%revision_number
269) option%io_buffer = 'The revision number # of checkpoint file (' // &
270) trim(option%surf_restart_filename) // ', rev=' // &
271) trim(adjustl(string)) // &
272) ') does not match the current revision number' // &
273) ' of PFLOTRAN checkpoint files ('
274) write(string,*) CHECKPOINT_REVISION_NUMBER
275) option%io_buffer = trim(option%io_buffer) // trim(adjustl(string)) // ').'
276) call printErrMsg(option)
277) endif
278)
279) if (surf_header%grid_discretization_type /= grid%itype) then
280) write(string,*) surf_header%grid_discretization_type
281) option%io_buffer = 'The discretization of checkpoint file (' // &
282) trim(option%restart_filename) // ', grid_type=' // &
283) trim(adjustl(string)) // &
284) ') does not match the discretization of the current problem' // &
285) ' grid_type= ('
286) write(string,*) grid%itype
287) option%io_buffer = trim(option%io_buffer) // trim(adjustl(string)) // ').'
288) call printErrMsg(option)
289) endif
290)
291) ! Check DOFs in surface-flow
292) if (option%nsurfflowdof /= surf_header%nsurfflowdof) then
293) write(string,*) surf_header%nsurfflowdof
294) option%io_buffer = 'Number of surface-flow dofs in restart file (' // &
295) trim(adjustl(string)) // &
296) ') does not match the number of surface-flow dofs in the input file ('
297) write(string,*) option%nsurfflowdof
298) option%io_buffer = trim(option%io_buffer) // string // ')'
299) call printErrMsg(option)
300) endif
301)
302) ! Check surface-flow formulation
303) if (option%surface_flow_formulation /= surf_header%surface_flow_formulation) then
304) option%io_buffer = 'Surface flow formulation in restart file ' // &
305) ' does not match the surface flow formulation the input file '
306) option%io_buffer = trim(option%io_buffer)
307) call printErrMsg(option)
308) endif
309)
310) ! Save values from header
311) if (option%surf_flow_on .and. &
312) option%nsurfflowdof == surf_header%nsurfflowdof) then
313)
314) option%surf_flow_time = surf_header%surf_flow_time
315) option%surf_flow_dt = surf_header%surf_flow_dt
316) surf_flow_prev_dt = surf_header%surf_flow_prev_dt
317)
318) option%subsurf_surf_coupling = surf_header%subsurf_surf_coupling
319) option%surf_subsurf_coupling_time = surf_header%surf_subsurf_coupling_time
320) option%surf_subsurf_coupling_flow_dt = surf_header%surf_subsurf_coupling_flow_dt
321)
322) surf_flow_read = PETSC_TRUE
323) endif
324)
325) if (surf_flow_read) then
326) call DiscretizationCreateVector(discretization,ONEDOF, &
327) global_vec,GLOBAL,option)
328) ! Load the PETSc vectors.
329) call VecLoad(surf_field%flow_xx,viewer,ierr);CHKERRQ(ierr)
330) call DiscretizationGlobalToLocal(discretization,surf_field%flow_xx, &
331) surf_field%flow_xx_loc,NFLOWDOF)
332) call VecCopy(surf_field%flow_xx,surf_field%flow_yy,ierr);CHKERRQ(ierr)
333)
334) call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
335) call DiscretizationGlobalToLocal(discretization,global_vec, &
336) surf_field%mannings_loc,ONEDOF)
337) endif
338)
339) ! We are finished, so clean up.
340) if (global_vec /= 0) then
341) call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
342) endif
343)
344) call PetscViewerDestroy(viewer, ierr);CHKERRQ(ierr)
345) call PetscTime(tend,ierr);CHKERRQ(ierr)
346)
347) call PetscBagDestroy(bag, ierr);CHKERRQ(ierr)
348)
349) write(option%io_buffer, &
350) '(" Seconds to read to checkpoint file: ", f6.2)') tend-tstart
351) call printMsg(option)
352)
353)
354) end subroutine SurfaceRestartBinary
355)
356) ! ************************************************************************** !
357)
358) subroutine SurfCheckpointRegisterBagHeader(bag,header)
359) !
360) ! This subroutine registers entities within the PETSc bag to header for
361) ! surface-realization.
362) !
363) ! Author: Gautam Bisht, LBNL
364) ! Date: 06/11/13
365) !
366)
367) implicit none
368)
369) PetscBag :: bag
370) type(surface_checkpoint_header_type), pointer :: header
371)
372) PetscInt :: i
373) PetscErrorCode :: ierr
374)
375) i = CHECKPOINT_REVISION_NUMBER
376) call PetscBagRegisterInt(bag,header%revision_number,i, &
377) "revision_number", &
378) "revision_number", &
379) ierr);CHKERRQ(ierr)
380) ! Register variables that are passed into timestepper().
381) call PetscBagRegisterInt(bag,header%grid_discretization_type, 0, &
382) "grid_discretization_type", &
383) "grid_discretization_type", &
384) ierr);CHKERRQ(ierr)
385) ! Surface-flow
386) call PetscBagRegisterInt(bag,header%nsurfflowdof,0, &
387) "nsurfflowdof", &
388) "Number of surface flow degrees of freedom", &
389) ierr);CHKERRQ(ierr)
390) call PetscBagRegisterInt(bag,header%surface_flow_formulation,0, &
391) "surface_flow_formulation", &
392) "Type of surface-flow formulation", &
393) ierr);CHKERRQ(ierr)
394)
395) call PetscBagRegisterReal(bag,header%surf_flow_time,0.d0, &
396) "surf_flow_time", &
397) "Surface Flow Simulation time (seconds)", &
398) ierr);CHKERRQ(ierr)
399) call PetscBagRegisterReal(bag,header%surf_flow_dt,0.d0, &
400) "surf_flow_dt", &
401) "Current size of surface flow timestep (seconds)", &
402) ierr);CHKERRQ(ierr)
403) call PetscBagRegisterReal(bag,header%surf_flow_prev_dt,0.d0, &
404) "surf_flow_prev_dt", &
405) "Previous size of surfae flow timestep (seconds)", &
406) ierr);CHKERRQ(ierr)
407)
408) ! Surface-Subsurface coupling
409) call PetscBagRegisterReal(bag,header%subsurf_surf_coupling,0, &
410) "subsurf_surf_coupling", &
411) "Type of surface-subsurface coupling", &
412) ierr);CHKERRQ(ierr)
413) call PetscBagRegisterReal(bag,header%surf_subsurf_coupling_time,0.d0, &
414) "surf_subsurf_coupling_time", &
415) "Surface-Subsurface coupling time (seconds)", &
416) ierr);CHKERRQ(ierr)
417) call PetscBagRegisterReal(bag,header%surf_subsurf_coupling_flow_dt,0.d0, &
418) "surf_subsurf_coupling_flow_dt", &
419) "Surface-Subsurface coupling timestep (seconds)", &
420) ierr);CHKERRQ(ierr)
421)
422) end subroutine SurfCheckpointRegisterBagHeader
423)
424) ! ************************************************************************** !
425)
426) subroutine SurfaceCheckpointProcessModelBinary(viewer, surf_realization)
427) !
428) ! This subroutine writes a checkpoint file for surface realization using
429) ! process model approach.
430) !
431) ! Author: Gautam Bisht, LBNL
432) ! Date: 09/19/13
433) !
434)
435) use Realization_Surface_class
436) use Surface_Field_module
437) use Grid_module
438) use Discretization_module
439) use Output_Aux_module
440) use Option_module
441)
442) implicit none
443)
444) #include "petsc/finclude/petscviewer.h"
445) #include "petsc/finclude/petscvec.h"
446) #include "petsc/finclude/petscvec.h90"
447)
448) class(realization_surface_type) :: surf_realization
449) PetscViewer :: viewer
450)
451) type(surface_field_type), pointer :: surf_field
452) type(option_type), pointer :: option
453) type(grid_type), pointer :: grid
454) type(discretization_type), pointer :: discretization
455) PetscErrorCode :: ierr
456) Vec :: global_vec
457)
458) surf_field => surf_realization%surf_field
459) option => surf_realization%option
460) discretization => surf_realization%discretization
461) grid => discretization%grid
462)
463) global_vec = 0
464) !--------------------------------------------------------------------
465) ! Dump all the relevant vectors.
466) !--------------------------------------------------------------------
467)
468) if (option%nflowdof > 0) then
469) call DiscretizationCreateVector(discretization,ONEDOF, &
470) global_vec,GLOBAL,option)
471) ! grid%flow_xx is the vector into which all of the primary variables are
472) ! packed for the TSSolve().
473) call VecView(surf_field%flow_xx, viewer, ierr);CHKERRQ(ierr)
474)
475) ! Mannings coefficient.
476) call DiscretizationLocalToGlobal(discretization,surf_field%mannings_loc, &
477) global_vec,ONEDOF)
478) call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
479) endif
480)
481) if (global_vec /= 0) then
482) call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
483) endif
484)
485) end subroutine SurfaceCheckpointProcessModelBinary
486)
487) ! ************************************************************************** !
488)
489) subroutine SurfaceRestartProcessModelBinary(viewer,surf_realization)
490) !
491) ! This subroutine reads a checkpoint file for surface realization using
492) ! process model approach.
493) !
494) ! Author: Gautam Bisht, LBNL
495) ! Date: 09/19/13
496) !
497)
498) use Realization_Surface_class
499) use Surface_Field_module
500) use Grid_module
501) use Discretization_module
502) use Output_Aux_module
503) use Option_module
504)
505) implicit none
506)
507) class(realization_surface_type) :: surf_realization
508) PetscViewer :: viewer
509)
510) type(surface_field_type), pointer :: surf_field
511) type(option_type), pointer :: option
512) type(grid_type), pointer :: grid
513) type(discretization_type), pointer :: discretization
514) PetscErrorCode :: ierr
515) Vec :: global_vec
516)
517) surf_field => surf_realization%surf_field
518) option => surf_realization%option
519) discretization => surf_realization%discretization
520) grid => discretization%grid
521)
522) global_vec = 0
523)
524) if (option%surf_flow_on) then
525) call DiscretizationCreateVector(discretization,ONEDOF, &
526) global_vec,GLOBAL,option)
527) ! Load the PETSc vectors.
528) call VecLoad(surf_field%flow_xx,viewer,ierr);CHKERRQ(ierr)
529) call DiscretizationGlobalToLocal(discretization,surf_field%flow_xx, &
530) surf_field%flow_xx_loc,NFLOWDOF)
531) call VecCopy(surf_field%flow_xx,surf_field%flow_yy,ierr);CHKERRQ(ierr)
532)
533) call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
534) call DiscretizationGlobalToLocal(discretization,global_vec, &
535) surf_field%mannings_loc,ONEDOF)
536) endif
537)
538) ! We are finished, so clean up.
539) if (global_vec /= 0) then
540) call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
541) endif
542)
543) end subroutine SurfaceRestartProcessModelBinary
544)
545) end module Checkpoint_Surface_module