checkpoint.F90 coverage: 95.24 %func 65.38 %block
1) module Checkpoint_module
2)
3) use PFLOTRAN_Constants_module
4)
5) implicit none
6)
7) private
8)
9) #include "petsc/finclude/petscsys.h"
10) #include "petsc/finclude/petscvec.h"
11) #include "petsc/finclude/petscvec.h90"
12) #include "petsc/finclude/petscdm.h"
13) #include "petsc/finclude/petscdm.h90"
14) #include "petsc/finclude/petscdef.h"
15) #include "petsc/finclude/petscis.h"
16) #include "petsc/finclude/petscis.h90"
17) #include "petsc/finclude/petsclog.h"
18) #include "petsc/finclude/petscviewer.h"
19)
20) type :: checkpoint_header_type
21) PetscInt :: version
22) PetscInt :: test_header_size
23) end type checkpoint_header_type
24)
25) type :: base_test_header_type
26) PetscInt :: int1
27) PetscReal :: real1
28) PetscInt :: int2
29) PetscReal :: real2
30) PetscInt :: int3
31) PetscReal :: real3
32) PetscInt :: int4
33) end type base_test_header_type
34)
35) type, extends(base_test_header_type) :: extended_test_header_type
36) PetscReal :: real4
37) PetscInt :: int5
38) PetscReal :: real5
39) end type extended_test_header_type
40)
41) interface PetscBagGetData
42) subroutine PetscBagGetData(bag,header,ierr)
43) import :: checkpoint_header_type
44) implicit none
45) #include "petsc/finclude/petscbag.h"
46) PetscBag :: bag
47) type(checkpoint_header_type), pointer :: header
48) PetscErrorCode :: ierr
49) end subroutine
50) end interface PetscBagGetData
51)
52) public :: CheckpointFilename, &
53) CheckpointAppendNameAtTime, &
54) CheckpointAppendNameAtTimestep, &
55) CheckpointOpenFileForWriteBinary, &
56) CheckPointWriteCompatibilityBinary, &
57) CheckPointReadCompatibilityBinary, &
58) CheckpointFlowProcessModelBinary, &
59) RestartFlowProcessModelBinary, &
60) #if defined(PETSC_HAVE_HDF5)
61) RestartFlowProcessModelHDF5, &
62) CheckpointOpenFileForWriteHDF5, &
63) CheckPointWriteCompatibilityHDF5, &
64) CheckpointFlowProcessModelHDF5, &
65) CheckPointWriteIntDatasetHDF5, &
66) CheckPointReadRealDatasetHDF5, &
67) CheckPointWriteRealDatasetHDF5, &
68) CheckPointReadIntDatasetHDF5, &
69) CheckpointOpenFileForReadHDF5, &
70) CheckPointReadCompatibilityHDF5, &
71) #endif
72) CheckpointPeriodicTimeWaypoints, &
73) CheckpointInputRecord, &
74) CheckpointRead
75)
76) contains
77)
78) ! ************************************************************************** !
79)
80) function CheckpointFilename(append_name, option)
81) !
82) ! This subroutine creates the filename of a checkpoint file without a suffix
83) !
84) ! Author: Gautam Bisht, LBNL
85) ! Date: 07/30/15
86) !
87)
88) use Option_module
89) use String_module, only : StringNull
90)
91) character(len=MAXSTRINGLENGTH) :: append_name
92) type(option_type) :: option
93)
94) character(len=MAXSTRINGLENGTH) :: CheckpointFilename
95)
96) CheckpointFilename = trim(option%global_prefix) // &
97) trim(option%group_prefix) // &
98) trim(adjustl(append_name))
99)
100) CheckpointFilename = adjustl(CheckpointFilename)
101)
102) end function CheckpointFilename
103)
104) ! ************************************************************************** !
105)
106) function CheckpointAppendNameAtTime(checkpoint_option,time,option)
107) !
108) ! This subroutine forms the appendage to the checkpoint filename.
109) !
110) ! Author: Jenn Frederick
111) ! Date: 1/29/2016
112) !
113)
114) use Output_Aux_module
115) use Units_module
116) use Option_module
117)
118) implicit none
119)
120) type(checkpoint_option_type) :: checkpoint_option
121) PetscReal :: time
122) type(option_type) :: option
123)
124) character(len=MAXSTRINGLENGTH) :: CheckpointAppendNameAtTime
125) character(len=MAXWORDLENGTH) :: word
126) PetscReal :: temp_time
127)
128) ! time is actually option%time. do not overwrite it.
129) temp_time = time * checkpoint_option%tconv
130) !write(time_string,'(1pe12.4)') time
131) write(word,'(f15.4)') temp_time
132) CheckpointAppendNameAtTime = '-' // trim(adjustl(word)) // &
133) trim(adjustl(checkpoint_option%tunit))
134)
135) end function CheckpointAppendNameAtTime
136)
137) ! ************************************************************************** !
138)
139) function CheckpointAppendNameAtTimestep(checkpoint_option,timestep,option)
140) !
141) ! This subroutine forms the appendage to the checkpoint filename.
142) !
143) ! Author: Jenn Frederick
144) ! Date: 1/29/2016
145) !
146)
147) use Output_Aux_module
148) use Units_module
149) use Option_module
150)
151) implicit none
152)
153) type(checkpoint_option_type) :: checkpoint_option
154) PetscInt :: timestep
155) type(option_type) :: option
156)
157) character(len=MAXSTRINGLENGTH) :: CheckpointAppendNameAtTimestep
158) character(len=MAXWORDLENGTH) :: word
159)
160) write(word,'(i9)') timestep
161) CheckpointAppendNameAtTimestep = '-' // 'ts' // trim(adjustl(word))
162)
163) end function CheckpointAppendNameAtTimestep
164)
165) ! ************************************************************************** !
166)
167) subroutine CheckpointOpenFileForWriteBinary(viewer,append_name,option)
168) !
169) ! Opens checkpoint file; sets format
170) !
171) ! Author: Glenn Hammond
172) ! Date: 07/26/13
173) !
174)
175) use Option_module
176)
177) implicit none
178)
179) #include "petsc/finclude/petscviewer.h"
180) #include "petsc/finclude/petscbag.h"
181)
182) PetscViewer :: viewer
183) character(len=MAXSTRINGLENGTH) :: append_name
184) type(option_type) :: option
185)
186) PetscErrorCode :: ierr
187) character(len=MAXSTRINGLENGTH) :: filename
188)
189) filename = CheckpointFilename(append_name,option)
190) filename = trim(filename) // '.chk'
191)
192) !geh: To skip .info file, need to split PetscViewerBinaryOpen()
193) ! into the routines it calls so that PetscViewerBinarySkipInfo()
194) ! can be called after PetscViewerSetType(), but before
195) ! PetscViewerFileSetName(). See note in PETSc docs.
196) !call PetscViewerBinaryOpen(option%mycomm, filename, FILE_MODE_WRITE, &
197) ! viewer, ierr)
198) call PetscViewerCreate(option%mycomm,viewer,ierr);CHKERRQ(ierr)
199) call PetscViewerSetType(viewer,PETSCVIEWERBINARY,ierr);CHKERRQ(ierr)
200) call PetscViewerFileSetMode(viewer,FILE_MODE_WRITE,ierr);CHKERRQ(ierr)
201) call PetscViewerBinarySkipInfo(viewer,ierr);CHKERRQ(ierr)
202) call PetscViewerFileSetName(viewer,filename,ierr);CHKERRQ(ierr)
203)
204) write(option%io_buffer,'(" --> Dump checkpoint file: ", a64)') &
205) trim(adjustl(filename))
206) call printMsg(option)
207)
208) end subroutine CheckpointOpenFileForWriteBinary
209)
210) ! ************************************************************************** !
211)
212) subroutine CheckPointWriteCompatibilityBinary(viewer,option)
213) !
214) ! Writes a PetscBag holding the version number and the size of a
215) ! complex extended class to ensure that the size of the class matches.
216) ! The purpose of this test is to catch incompatibility.
217) !
218) ! Technically, the BagSize should be 8 * the number of objects (int, real,
219) ! etc.). If we use 4 for PetscInt, the size is incorrect (due to padding
220) ! in the OS???). Anyway, using the following test sets a size sufficiently
221) ! large:
222) !
223) ! see PETSC_DIR/src/sys/examples/tutorials/ex5f90.F90
224) !
225) ! class(whatever_type), pointer :: header
226) ! type(whatever_type) :: dummy_header
227) ! character(len=1),pointer :: dummy_char(:)
228) ! PetscSizeT :: bagsize = size(transfer(dummy_header,dummy_char))
229) !
230) ! Author: Glenn Hammond
231) ! Date: 003/26/15
232) !
233) use Option_module
234)
235) implicit none
236)
237) #include "petsc/finclude/petscviewer.h"
238) #include "petsc/finclude/petscbag.h"
239)
240) PetscViewer :: viewer
241) type(option_type) :: option
242)
243) type(checkpoint_header_type), pointer :: header
244) type(checkpoint_header_type) :: dummy_header
245) character(len=1),pointer :: dummy_char(:)
246) PetscBag :: bag
247) PetscSizeT :: bagsize
248) PetscErrorCode :: ierr
249)
250) ! solely for test purposes here
251) type(extended_test_header_type) :: test_header
252)
253) bagsize = size(transfer(dummy_header,dummy_char))
254)
255) call PetscBagCreate(option%mycomm,bagsize,bag,ierr);CHKERRQ(ierr)
256) call PetscBagGetData(bag,header,ierr);CHKERRQ(ierr)
257) call PetscBagRegisterInt(bag,header%version,0, &
258) "checkpoint_version","",ierr);CHKERRQ(ierr)
259) call PetscBagRegisterInt(bag,header%test_header_size,0, &
260) "test_header_size","",ierr);CHKERRQ(ierr)
261) header%version = CHECKPOINT_REVISION_NUMBER
262) header%test_header_size = size(transfer(test_header,dummy_char))
263) call PetscBagView(bag,viewer,ierr);CHKERRQ(ierr)
264) call PetscBagDestroy(bag,ierr);CHKERRQ(ierr)
265)
266) end subroutine CheckPointWriteCompatibilityBinary
267)
268) ! ************************************************************************** !
269)
270) subroutine CheckPointReadCompatibilityBinary(viewer,option)
271) !
272) ! Reads in a PetscBag holding the version number and the size of a
273) ! complex extended class to ensure that the size of the class matches.
274) ! The purpose of this test is to catch incompatibility.
275) !
276) ! Technically, the BagSize should be 8 * the number of objects (int, real,
277) ! etc.). If we use 4 for PetscInt, the size is incorrect (due to padding
278) ! in the OS???). Anyway, using the following test sets a size sufficiently
279) ! large:
280) !
281) ! class(whatever_type), pointer :: header
282) ! type(whatever_type) :: dummy_header
283) ! character(len=1),pointer :: dummy_char(:)
284) ! PetscSizeT :: bagsize = size(transfer(dummy_header,dummy_char))
285) !
286) ! Author: Glenn Hammond
287) ! Date: 003/26/15
288) !
289) use Option_module
290)
291) implicit none
292)
293) #include "petsc/finclude/petscviewer.h"
294) #include "petsc/finclude/petscbag.h"
295)
296) PetscViewer :: viewer
297) type(option_type) :: option
298)
299) type(checkpoint_header_type), pointer :: header
300) type(checkpoint_header_type) :: dummy_header
301) character(len=1),pointer :: dummy_char(:)
302) PetscBag :: bag
303) PetscSizeT :: bagsize
304) PetscErrorCode :: ierr
305) character(len=MAXWORDLENGTH) :: word, word2
306) PetscInt :: temp_int
307)
308) ! solely for test purposes here
309) type(extended_test_header_type) :: test_header
310)
311) bagsize = size(transfer(dummy_header,dummy_char))
312)
313) call PetscBagCreate(option%mycomm,bagsize,bag,ierr);CHKERRQ(ierr)
314) call PetscBagGetData(bag,header,ierr);CHKERRQ(ierr)
315) call PetscBagRegisterInt(bag,header%version,0, &
316) "checkpoint_version","",ierr);CHKERRQ(ierr)
317) call PetscBagRegisterInt(bag,header%test_header_size,0, &
318) "test_header_size","",ierr);CHKERRQ(ierr)
319) call PetscBagLoad(viewer,bag,ierr);CHKERRQ(ierr)
320)
321) ! check compatibility
322) if (header%version /= CHECKPOINT_REVISION_NUMBER) then
323) write(word,*) header%version
324) write(word2,*) CHECKPOINT_REVISION_NUMBER
325) option%io_buffer = 'Incorrect checkpoint file format (' // &
326) trim(adjustl(word)) // ' vs ' // &
327) trim(adjustl(word2)) // ').'
328) call printErrMsg(option)
329) endif
330)
331) temp_int = size(transfer(test_header,dummy_char))
332) if (header%test_header_size /= temp_int) then
333) write(word,*) header%test_header_size
334) write(word2,*) temp_int
335) option%io_buffer = 'Inconsistent PetscBagSize (' // &
336) trim(adjustl(word)) // ' vs ' // &
337) trim(adjustl(word2)) // ').'
338) call printErrMsg(option)
339) endif
340)
341) call PetscBagDestroy(bag,ierr);CHKERRQ(ierr)
342)
343) end subroutine CheckPointReadCompatibilityBinary
344)
345) ! ************************************************************************** !
346)
347) subroutine CheckpointFlowProcessModelBinary(viewer,realization)
348) !
349) ! Checkpoints flow process model vectors
350) !
351) ! Author: Glenn Hammond
352) ! Date: 07/26/13
353) !
354)
355) use Option_module
356) use Realization_Subsurface_class
357) use Field_module
358) use Discretization_module
359) use Grid_module
360) use Material_module
361) use Variables_module, only : POROSITY, PERMEABILITY_X, PERMEABILITY_Y, &
362) PERMEABILITY_Z
363)
364) implicit none
365)
366) #include "petsc/finclude/petscviewer.h"
367) #include "petsc/finclude/petscvec.h"
368) #include "petsc/finclude/petscvec.h90"
369)
370) PetscViewer :: viewer
371) class(realization_subsurface_type) :: realization
372) PetscErrorCode :: ierr
373)
374) type(option_type), pointer :: option
375) type(field_type), pointer :: field
376) type(discretization_type), pointer :: discretization
377) type(grid_type), pointer :: grid
378) Vec :: global_vec
379)
380) option => realization%option
381) field => realization%field
382) discretization => realization%discretization
383) grid => realization%patch%grid
384)
385) global_vec = 0
386)
387) if (option%nflowdof > 0) then
388) call DiscretizationCreateVector(realization%discretization,ONEDOF, &
389) global_vec,GLOBAL,option)
390) ! grid%flow_xx is the vector into which all of the primary variables are
391) ! packed for the SNESSolve().
392) call VecView(field%flow_xx, viewer, ierr);CHKERRQ(ierr)
393)
394)
395) ! If we are running with multiple phases, we need to dump the vector
396) ! that indicates what phases are present, as well as the 'var' vector
397) ! that holds variables derived from the primary ones via the translator.
398) select case(option%iflowmode)
399) case(MPH_MODE,TH_MODE,RICHARDS_MODE,IMS_MODE,MIS_MODE, &
400) FLASH2_MODE,G_MODE,TOIL_IMS_MODE)
401) call DiscretizationLocalToGlobal(realization%discretization, &
402) field%iphas_loc,global_vec,ONEDOF)
403) call VecView(global_vec, viewer, ierr);CHKERRQ(ierr)
404) case default
405) end select
406)
407) ! Porosity and permeability.
408) ! (We only write diagonal terms of the permeability tensor for now,
409) ! since we have yet to add the full-tensor formulation.)
410) call MaterialGetAuxVarVecLoc(realization%patch%aux%Material, &
411) field%work_loc,POROSITY,ZERO_INTEGER)
412) call DiscretizationLocalToGlobal(discretization,field%work_loc, &
413) global_vec,ONEDOF)
414) call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
415) call MaterialGetAuxVarVecLoc(realization%patch%aux%Material, &
416) field%work_loc,PERMEABILITY_X,ZERO_INTEGER)
417) call DiscretizationLocalToGlobal(discretization,field%work_loc, &
418) global_vec,ONEDOF)
419) call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
420) call MaterialGetAuxVarVecLoc(realization%patch%aux%Material, &
421) field%work_loc,PERMEABILITY_Y,ZERO_INTEGER)
422) call DiscretizationLocalToGlobal(discretization,field%work_loc, &
423) global_vec,ONEDOF)
424) call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
425) call MaterialGetAuxVarVecLoc(realization%patch%aux%Material, &
426) field%work_loc,PERMEABILITY_Z,ZERO_INTEGER)
427) call DiscretizationLocalToGlobal(discretization,field%work_loc, &
428) global_vec,ONEDOF)
429) call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
430)
431) endif
432)
433) if (global_vec /= 0) then
434) call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
435) endif
436)
437) end subroutine CheckpointFlowProcessModelBinary
438)
439) ! ************************************************************************** !
440)
441) subroutine RestartFlowProcessModelBinary(viewer,realization)
442) !
443) ! Restarts flow process model
444) !
445) ! Author: Glenn Hammond
446) ! Date: 07/26/13
447) !
448)
449) use Option_module
450) use Realization_Subsurface_class
451) use Field_module
452) use Discretization_module
453) use Grid_module
454) use Global_module
455) use Material_module
456) use Variables_module, only : POROSITY, PERMEABILITY_X, PERMEABILITY_Y, &
457) PERMEABILITY_Z, STATE
458)
459) implicit none
460)
461) #include "petsc/finclude/petscviewer.h"
462) #include "petsc/finclude/petscvec.h"
463) #include "petsc/finclude/petscvec.h90"
464)
465) PetscViewer :: viewer
466) class(realization_subsurface_type) :: realization
467) PetscErrorCode :: ierr
468)
469) type(option_type), pointer :: option
470) type(field_type), pointer :: field
471) type(discretization_type), pointer :: discretization
472) type(grid_type), pointer :: grid
473) Vec :: global_vec
474)
475) option => realization%option
476) field => realization%field
477) discretization => realization%discretization
478) grid => realization%patch%grid
479)
480) global_vec = 0
481)
482) if (option%nflowdof > 0) then
483) call DiscretizationCreateVector(realization%discretization,ONEDOF, &
484) global_vec,GLOBAL,option)
485) ! Load the PETSc vectors.
486) call VecLoad(field%flow_xx,viewer,ierr);CHKERRQ(ierr)
487) call DiscretizationGlobalToLocal(discretization,field%flow_xx, &
488) field%flow_xx_loc,NFLOWDOF)
489) call VecCopy(field%flow_xx,field%flow_yy,ierr);CHKERRQ(ierr)
490)
491) select case(option%iflowmode)
492) case(MPH_MODE,TH_MODE,RICHARDS_MODE,IMS_MODE,MIS_MODE, &
493) FLASH2_MODE,G_MODE,TOIL_IMS_MODE)
494) call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
495) call DiscretizationGlobalToLocal(discretization,global_vec, &
496) field%iphas_loc,ONEDOF)
497) call VecCopy(field%iphas_loc,field%iphas_old_loc,ierr);CHKERRQ(ierr)
498) call DiscretizationLocalToLocal(discretization,field%iphas_loc, &
499) field%iphas_old_loc,ONEDOF)
500) if (option%iflowmode == G_MODE) then
501) ! need to copy iphase into global_auxvar%istate
502) call GlobalSetAuxVarVecLoc(realization,field%iphas_loc,STATE, &
503) ZERO_INTEGER)
504) endif
505) if (option%iflowmode == TOIL_IMS_MODE) then
506) !iphase value not needed - leave it as initialised
507) ! consider to remove iphase for all ims modes
508) endif
509) if (option%iflowmode == MPH_MODE) then
510) ! set vardof vec in mphase
511) endif
512) if (option%iflowmode == IMS_MODE) then
513) ! set vardof vec in mphase
514) endif
515) if (option%iflowmode == FLASH2_MODE) then
516) ! set vardof vec in mphase
517) endif
518)
519) case default
520) end select
521)
522) call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
523) call DiscretizationGlobalToLocal(discretization,global_vec, &
524) field%work_loc,ONEDOF)
525) call MaterialSetAuxVarVecLoc(realization%patch%aux%Material, &
526) field%work_loc,POROSITY,ZERO_INTEGER)
527) call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
528) call DiscretizationGlobalToLocal(discretization,global_vec, &
529) field%work_loc,ONEDOF)
530) call MaterialSetAuxVarVecLoc(realization%patch%aux%Material, &
531) field%work_loc,PERMEABILITY_X,ZERO_INTEGER)
532) call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
533) call DiscretizationGlobalToLocal(discretization,global_vec, &
534) field%work_loc,ONEDOF)
535) call MaterialSetAuxVarVecLoc(realization%patch%aux%Material, &
536) field%work_loc,PERMEABILITY_Y,ZERO_INTEGER)
537) call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
538) call DiscretizationGlobalToLocal(discretization,global_vec, &
539) field%work_loc,ONEDOF)
540) call MaterialSetAuxVarVecLoc(realization%patch%aux%Material, &
541) field%work_loc,PERMEABILITY_Z,ZERO_INTEGER)
542) endif
543)
544) if (global_vec /= 0) then
545) call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
546) endif
547)
548) end subroutine RestartFlowProcessModelBinary
549)
550) ! ************************************************************************** !
551)
552) #if defined(PETSC_HAVE_HDF5)
553) subroutine CheckpointOpenFileForWriteHDF5(file_id,grp_id,append_name,option, &
554) id_stamp)
555) !
556) ! Opens checkpoint file; sets format
557) !
558) ! Author: Gautam Bisht, LBNL
559) ! Date: 07/30/15
560) !
561) use Option_module
562) use hdf5
563)
564) implicit none
565)
566) type(option_type) :: option
567) character(len=MAXWORDLENGTH), optional, intent(in) :: id_stamp
568) character(len=MAXSTRINGLENGTH) :: append_name
569) character(len=MAXSTRINGLENGTH) :: string
570) character(len=MAXSTRINGLENGTH) :: filename
571) PetscErrorCode :: ierr
572) PetscMPIInt :: hdf5_err
573)
574) #if defined(SCORPIO_WRITE)
575) integer, intent(out) :: file_id
576) integer :: prop_id
577) integer,intent(out) :: grp_id
578) #else
579) integer(HID_T), intent(out) :: file_id
580) integer(HID_T) :: prop_id
581) integer(HID_T), intent(out) :: grp_id
582) #endif
583)
584) filename = CheckpointFilename(append_name, option)
585) filename = trim(filename) // '.h5'
586)
587) #if defined(SCORPIO_WRITE)
588) filename = trim(filename) // CHAR(0)
589) call scorpio_open_file(filename, option%iowrite_group_id, &
590) SCORPIO_FILE_CREATE, file_id, ierr)
591) #else
592)
593) ! initialize fortran interface
594) call h5open_f(hdf5_err)
595)
596) call h5pcreate_f(H5P_FILE_ACCESS_F, prop_id, hdf5_err)
597) #ifndef SERIAL_HDF5
598) call h5pset_fapl_mpio_f(prop_id, option%mycomm, MPI_INFO_NULL, hdf5_err)
599) #endif
600) call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdf5_err, &
601) H5P_DEFAULT_F, prop_id)
602) call h5pclose_f(prop_id, hdf5_err)
603)
604) #endif
605)
606) string = "Checkpoint"
607) call h5gcreate_f(file_id, string, grp_id, hdf5_err, OBJECT_NAMELEN_DEFAULT_F)
608)
609) write(option%io_buffer,'(" --> Dump checkpoint file: ", a64)') &
610) trim(adjustl(filename))
611) call printMsg(option)
612)
613) end subroutine CheckpointOpenFileForWriteHDF5
614)
615) ! ************************************************************************** !
616)
617) subroutine CheckpointOpenFileForReadHDF5(filename, file_id, grp_id, option)
618) !
619) ! Opens HDF5 checkpoint file for reading
620) !
621) ! Author: Gautam Bisht, LBNL
622) ! Date: 08/09/15
623) !
624) use Option_module
625) use hdf5
626)
627) implicit none
628)
629) character(len=MAXSTRINGLENGTH),intent(in) :: filename
630) type(option_type) :: option
631)
632) character(len=MAXSTRINGLENGTH) :: string
633) PetscErrorCode :: ierr
634) PetscMPIInt :: hdf5_err
635)
636) #if defined(SCORPIO)
637) integer, intent(out) :: file_id
638) integer :: prop_id
639) integer,intent(out) :: grp_id
640) #else
641) integer(HID_T), intent(out) :: file_id
642) integer(HID_T) :: prop_id
643) integer(HID_T), intent(out) :: grp_id
644) #endif
645)
646) #if defined(SCORPIO)
647) write(option%io_buffer, &
648) '("Checkpoint from HDF5 not supported for SCORPIO. Darn.")')
649) call printErrMsg(option)
650) #else
651)
652) ! initialize fortran interface
653) call h5open_f(hdf5_err)
654)
655) call h5pcreate_f(H5P_FILE_ACCESS_F, prop_id, hdf5_err)
656) #ifndef SERIAL_HDF5
657) call h5pset_fapl_mpio_f(prop_id, option%mycomm, MPI_INFO_NULL, hdf5_err)
658) #endif
659) call h5fopen_f(filename, H5F_ACC_RDONLY_F, file_id, hdf5_err, prop_id)
660) call h5pclose_f(prop_id, hdf5_err)
661)
662) string = "Checkpoint"
663) call h5gopen_f(file_id, string, grp_id, hdf5_err)
664) #endif
665)
666) end subroutine CheckpointOpenFileForReadHDF5
667)
668) ! ************************************************************************** !
669)
670) subroutine CheckPointWriteIntDatasetHDF5(chk_grp_id, dataset_name, dataset_rank, &
671) dims, start, length, stride, data_int_array, option)
672) !
673) ! Within a HDF5 group (chk_grp_id), creates a new dataset (named dataset_name)
674) ! and writes integer data type.
675) !
676) ! Author: Gautam Bisht
677) ! Date: 07/30/15
678) !
679) use Option_module
680) use hdf5
681) use HDF5_module, only : trick_hdf5
682)
683) implicit none
684)
685) #if defined(SCORPIO_WRITE)
686) integer :: chk_grp_id
687) PetscMPIInt :: dataset_rank
688) integer, pointer :: dims(:)
689) integer, pointer :: start(:)
690) integer, pointer :: stride(:)
691) integer, pointer :: length(:)
692) #else
693) integer(HID_T) :: chk_grp_id
694) character(len=MAXSTRINGLENGTH) :: dataset_name
695) PetscMPIInt :: dataset_rank
696) integer(HSIZE_T), pointer :: dims(:)
697) integer(HSIZE_T), pointer :: start(:)
698) integer(HSIZE_T), pointer :: stride(:)
699) integer(HSIZE_T), pointer :: length(:)
700) #endif
701) type(option_type) :: option
702)
703) integer(HID_T) :: data_set_id
704) integer(HID_T) :: grp_space_id
705) integer(HID_T) :: memory_space_id
706) integer(HID_T) :: prop_id
707) PetscErrorCode :: hdf5_err
708) PetscErrorCode :: hdf5_flag
709) PetscMPIInt, parameter :: ON=1, OFF=0
710)
711) PetscInt, pointer :: data_int_array(:)
712)
713) call h5screate_simple_f(dataset_rank, dims, memory_space_id, hdf5_err, dims)
714)
715) dataset_name = trim(adjustl(dataset_name)) // CHAR(0)
716)
717) call h5eset_auto_f(OFF, hdf5_err)
718) call h5dopen_f(chk_grp_id, dataset_name, data_set_id, hdf5_err)
719) hdf5_flag = hdf5_err
720) call h5eset_auto_f(ON, hdf5_err)
721)
722) if (hdf5_flag < 0) then
723) call h5pcreate_f(H5P_DATASET_CREATE_F, prop_id, hdf5_err)
724) call h5screate_simple_f(dataset_rank, dims, grp_space_id, hdf5_err, dims)
725) call h5dcreate_f(chk_grp_id, dataset_name, H5T_NATIVE_INTEGER, grp_space_id, &
726) data_set_id, hdf5_err, prop_id)
727) call h5pclose_f(prop_id, hdf5_err)
728) else
729) call h5dget_space_f(data_set_id, grp_space_id, hdf5_err)
730) endif
731)
732) call h5sselect_hyperslab_f(grp_space_id, H5S_SELECT_SET_F, start, length, &
733) hdf5_err, stride, stride)
734)
735) ! write the data
736) call h5pcreate_f(H5P_DATASET_XFER_F, prop_id, hdf5_err)
737) #ifndef SERIAL_HDF5
738) if (trick_hdf5) then
739) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_INDEPENDENT_F, &
740) hdf5_err)
741) else
742) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_COLLECTIVE_F, &
743) hdf5_err)
744) endif
745) #endif
746)
747) call h5dwrite_f(data_set_id, H5T_NATIVE_INTEGER, data_int_array, dims, &
748) hdf5_err, memory_space_id, grp_space_id, prop_id)
749)
750) call h5sclose_f(memory_space_id, hdf5_err)
751) call h5sclose_f(grp_space_id, hdf5_err)
752) call h5pclose_f(prop_id, hdf5_err)
753) call h5dclose_f(data_set_id, hdf5_err)
754)
755) end subroutine CheckPointWriteIntDatasetHDF5
756)
757) ! ************************************************************************** !
758)
759) subroutine CheckPointWriteRealDatasetHDF5(chk_grp_id, dataset_name, dataset_rank, &
760) dims, start, length, stride, data_real_array, option)
761) !
762) ! Within a HDF5 group (chk_grp_id), creates a new dataset (named dataset_name)
763) ! and writes integer data type.
764) !
765) ! Author: Gautam Bisht
766) ! Date: 07/30/15
767) !
768) use Option_module
769) use hdf5
770) use HDF5_module, only : trick_hdf5
771)
772) implicit none
773)
774) #include "petsc/finclude/petscviewer.h"
775) #include "petsc/finclude/petscbag.h"
776)
777) #if defined(SCORPIO_WRITE)
778) integer :: chk_grp_id
779) PetscMPIInt :: dataset_rank
780) integer, pointer :: dims(:)
781) integer, pointer :: start(:)
782) integer, pointer :: stride(:)
783) integer, pointer :: length(:)
784) #else
785) integer(HID_T) :: chk_grp_id
786) character(len=MAXSTRINGLENGTH) :: dataset_name
787) PetscMPIInt :: dataset_rank
788) integer(HSIZE_T), pointer :: dims(:)
789) integer(HSIZE_T), pointer :: start(:)
790) integer(HSIZE_T), pointer :: stride(:)
791) integer(HSIZE_T), pointer :: length(:)
792) #endif
793) type(option_type) :: option
794)
795) integer(HID_T) :: data_set_id
796) integer(HID_T) :: grp_space_id
797) integer(HID_T) :: memory_space_id
798) integer(HID_T) :: prop_id
799) PetscErrorCode :: hdf5_err
800) PetscErrorCode :: hdf5_flag
801) PetscMPIInt, parameter :: ON=1, OFF=0
802)
803) PetscReal, pointer :: data_real_array(:)
804)
805) call h5screate_simple_f(dataset_rank, dims, memory_space_id, hdf5_err, dims)
806)
807) dataset_name = trim(adjustl(dataset_name)) // CHAR(0)
808)
809) call h5eset_auto_f(OFF, hdf5_err)
810) call h5dopen_f(chk_grp_id, dataset_name, data_set_id, hdf5_err)
811) hdf5_flag = hdf5_err
812) call h5eset_auto_f(ON, hdf5_err)
813)
814) if (hdf5_flag < 0) then
815) call h5pcreate_f(H5P_DATASET_CREATE_F, prop_id, hdf5_err)
816) call h5screate_simple_f(dataset_rank, dims, grp_space_id, hdf5_err, dims)
817) call h5dcreate_f(chk_grp_id, dataset_name, H5T_NATIVE_DOUBLE, grp_space_id, &
818) data_set_id, hdf5_err, prop_id)
819) call h5pclose_f(prop_id, hdf5_err)
820) else
821) call h5dget_space_f(data_set_id, grp_space_id, hdf5_err)
822) endif
823)
824) call h5sselect_hyperslab_f(grp_space_id, H5S_SELECT_SET_F, start, length, &
825) hdf5_err, stride, stride)
826)
827) ! write the data
828) call h5pcreate_f(H5P_DATASET_XFER_F, prop_id, hdf5_err)
829) #ifndef SERIAL_HDF5
830) if (trick_hdf5) then
831) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_INDEPENDENT_F, &
832) hdf5_err)
833) else
834) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_COLLECTIVE_F, &
835) hdf5_err)
836) endif
837) #endif
838)
839) call h5dwrite_f(data_set_id, H5T_NATIVE_DOUBLE, data_real_array, dims, &
840) hdf5_err, memory_space_id, grp_space_id, prop_id)
841)
842) call h5sclose_f(memory_space_id, hdf5_err)
843) call h5sclose_f(grp_space_id, hdf5_err)
844) call h5pclose_f(prop_id, hdf5_err)
845) call h5dclose_f(data_set_id, hdf5_err)
846)
847) end subroutine CheckPointWriteRealDatasetHDF5
848)
849) ! ************************************************************************** !
850)
851) subroutine CheckPointReadIntDatasetHDF5(chk_grp_id, dataset_name, dataset_rank, &
852) dims, start, length, stride, data_int_array, option)
853) !
854) ! Within a HDF5 group (chk_grp_id), reads data from a dataset (named dataset_name)
855) !
856) ! Author: Gautam Bisht
857) ! Date: 08/16/15
858) !
859) use Option_module
860) use hdf5
861) use HDF5_module, only : trick_hdf5
862)
863) implicit none
864)
865)
866) #if defined(SCORPIO_WRITE)
867) integer :: chk_grp_id
868) PetscMPIInt :: dataset_rank
869) integer, pointer :: dims(:)
870) integer, pointer :: start(:)
871) integer, pointer :: stride(:)
872) integer, pointer :: length(:)
873) #else
874) integer(HID_T) :: chk_grp_id
875) character(len=MAXSTRINGLENGTH) :: dataset_name
876) PetscMPIInt :: dataset_rank
877) integer(HSIZE_T), pointer :: dims(:)
878) integer(HSIZE_T), pointer :: start(:)
879) integer(HSIZE_T), pointer :: stride(:)
880) integer(HSIZE_T), pointer :: length(:)
881) #endif
882) type(option_type) :: option
883)
884) integer(HID_T) :: data_set_id
885) integer(HID_T) :: grp_space_id
886) integer(HID_T) :: memory_space_id
887) integer(HID_T) :: prop_id
888) PetscErrorCode :: hdf5_err
889) PetscErrorCode :: hdf5_flag
890) PetscMPIInt, parameter :: ON=1, OFF=0
891)
892) PetscInt, pointer :: data_int_array(:)
893)
894) call h5screate_simple_f(dataset_rank, dims, memory_space_id, hdf5_err, dims)
895)
896) dataset_name = trim(adjustl(dataset_name)) // CHAR(0)
897)
898) call h5eset_auto_f(OFF, hdf5_err)
899) call h5dopen_f(chk_grp_id, dataset_name, data_set_id, hdf5_err)
900) hdf5_flag = hdf5_err
901) call h5eset_auto_f(ON, hdf5_err)
902)
903) call h5dget_space_f(data_set_id, grp_space_id, hdf5_err)
904)
905) call h5sselect_hyperslab_f(grp_space_id, H5S_SELECT_SET_F, start, length, &
906) hdf5_err, stride, stride)
907)
908) ! write the data
909) call h5pcreate_f(H5P_DATASET_XFER_F, prop_id, hdf5_err)
910) #ifndef SERIAL_HDF5
911) if (trick_hdf5) then
912) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_INDEPENDENT_F, &
913) hdf5_err)
914) else
915) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_COLLECTIVE_F, &
916) hdf5_err)
917) endif
918) #endif
919)
920) call h5dread_f(data_set_id, H5T_NATIVE_INTEGER, data_int_array, dims, &
921) hdf5_err, memory_space_id, grp_space_id, prop_id)
922)
923) call h5sclose_f(memory_space_id, hdf5_err)
924) call h5sclose_f(grp_space_id, hdf5_err)
925) call h5pclose_f(prop_id, hdf5_err)
926) call h5dclose_f(data_set_id, hdf5_err)
927)
928) end subroutine CheckPointReadIntDatasetHDF5
929)
930) ! ************************************************************************** !
931)
932) subroutine CheckPointReadRealDatasetHDF5(chk_grp_id, dataset_name, dataset_rank, &
933) dims, start, length, stride, data_real_array, option)
934) !
935) ! Within a HDF5 group (chk_grp_id), reads data from a dataset (named dataset_name)
936) !
937) ! Author: Gautam Bisht
938) ! Date: 08/16/15
939) !
940) use Option_module
941) use hdf5
942) use HDF5_module, only : trick_hdf5
943)
944) implicit none
945)
946)
947) #if defined(SCORPIO_WRITE)
948) integer :: chk_grp_id
949) PetscMPIInt :: dataset_rank
950) integer, pointer :: dims(:)
951) integer, pointer :: start(:)
952) integer, pointer :: stride(:)
953) integer, pointer :: length(:)
954) #else
955) integer(HID_T) :: chk_grp_id
956) character(len=MAXSTRINGLENGTH) :: dataset_name
957) PetscMPIInt :: dataset_rank
958) integer(HSIZE_T), pointer :: dims(:)
959) integer(HSIZE_T), pointer :: start(:)
960) integer(HSIZE_T), pointer :: stride(:)
961) integer(HSIZE_T), pointer :: length(:)
962) #endif
963) type(option_type) :: option
964)
965) integer(HID_T) :: data_set_id
966) integer(HID_T) :: grp_space_id
967) integer(HID_T) :: memory_space_id
968) integer(HID_T) :: prop_id
969) PetscErrorCode :: hdf5_err
970) PetscErrorCode :: hdf5_flag
971) PetscMPIInt, parameter :: ON=1, OFF=0
972)
973) PetscReal, pointer :: data_real_array(:)
974)
975) call h5screate_simple_f(dataset_rank, dims, memory_space_id, hdf5_err, dims)
976)
977) dataset_name = trim(adjustl(dataset_name)) // CHAR(0)
978)
979) call h5eset_auto_f(OFF, hdf5_err)
980) call h5dopen_f(chk_grp_id, dataset_name, data_set_id, hdf5_err)
981) hdf5_flag = hdf5_err
982) call h5eset_auto_f(ON, hdf5_err)
983)
984) call h5dget_space_f(data_set_id, grp_space_id, hdf5_err)
985)
986) call h5sselect_hyperslab_f(grp_space_id, H5S_SELECT_SET_F, start, length, &
987) hdf5_err, stride, stride)
988)
989) ! write the data
990) call h5pcreate_f(H5P_DATASET_XFER_F, prop_id, hdf5_err)
991) #ifndef SERIAL_HDF5
992) if (trick_hdf5) then
993) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_INDEPENDENT_F, &
994) hdf5_err)
995) else
996) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_COLLECTIVE_F, &
997) hdf5_err)
998) endif
999) #endif
1000)
1001) call h5dread_f(data_set_id, H5T_NATIVE_DOUBLE, data_real_array, dims, &
1002) hdf5_err, memory_space_id, grp_space_id, prop_id)
1003)
1004) call h5sclose_f(memory_space_id, hdf5_err)
1005) call h5sclose_f(grp_space_id, hdf5_err)
1006) call h5pclose_f(prop_id, hdf5_err)
1007) call h5dclose_f(data_set_id, hdf5_err)
1008)
1009) end subroutine CheckPointReadRealDatasetHDF5
1010)
1011) ! ************************************************************************** !
1012)
1013) subroutine CheckPointWriteCompatibilityHDF5(chk_grp_id, option)
1014) !
1015) ! Write the PFLOTRAN checkpoint version number. The purpose of this is to
1016) ! catch incompatibility.
1017) !
1018) ! Author: Gautam Bisht
1019) ! Date: 08/30/15
1020) !
1021) use Option_module
1022) use hdf5
1023)
1024) implicit none
1025)
1026) #if defined(SCORPIO_WRITE)
1027) integer :: chk_grp_id
1028) integer, pointer :: dims(:)
1029) integer, pointer :: start(:)
1030) integer, pointer :: stride(:)
1031) integer, pointer :: length(:)
1032) #else
1033) integer(HID_T) :: chk_grp_id
1034) integer(HSIZE_T), pointer :: dims(:)
1035) integer(HSIZE_T), pointer :: start(:)
1036) integer(HSIZE_T), pointer :: stride(:)
1037) integer(HSIZE_T), pointer :: length(:)
1038) #endif
1039) type(option_type) :: option
1040)
1041)
1042) PetscMPIInt :: dataset_rank
1043) character(len=MAXSTRINGLENGTH) :: dataset_name
1044) PetscInt, pointer :: int_array(:)
1045)
1046) dataset_name = "Revision Number" // CHAR(0)
1047)
1048) allocate(start(1))
1049) allocate(dims(1))
1050) allocate(length(1))
1051) allocate(stride(1))
1052) allocate(int_array(1))
1053)
1054) dataset_rank = 1
1055) dims(1) = ONE_INTEGER
1056) start(1) = 0
1057) length(1) = ONE_INTEGER
1058) stride(1) = ONE_INTEGER
1059)
1060) int_array(1) = CHECKPOINT_REVISION_NUMBER
1061)
1062) call CheckPointWriteIntDatasetHDF5(chk_grp_id, dataset_name, dataset_rank, &
1063) dims, start, length, stride, int_array, option)
1064)
1065) deallocate(start)
1066) deallocate(dims)
1067) deallocate(length)
1068) deallocate(stride)
1069) deallocate(int_array)
1070)
1071) end subroutine CheckPointWriteCompatibilityHDF5
1072)
1073) ! ************************************************************************** !
1074)
1075) subroutine CheckPointReadCompatibilityHDF5(chk_grp_id, option)
1076) !
1077) ! Reads the PFLOTRAN checkpoint version number. The purpose of this is to
1078) ! catch incompatibility.
1079) !
1080) ! Author: Gautam Bisht
1081) ! Date: 08/16/15
1082) !
1083) use Option_module
1084) use hdf5
1085)
1086) implicit none
1087)
1088) #if defined(SCORPIO_WRITE)
1089) integer :: chk_grp_id
1090) integer, pointer :: dims(:)
1091) integer, pointer :: start(:)
1092) integer, pointer :: stride(:)
1093) integer, pointer :: length(:)
1094) #else
1095) integer(HID_T) :: chk_grp_id
1096) integer(HSIZE_T), pointer :: dims(:)
1097) integer(HSIZE_T), pointer :: start(:)
1098) integer(HSIZE_T), pointer :: stride(:)
1099) integer(HSIZE_T), pointer :: length(:)
1100) #endif
1101) type(option_type) :: option
1102)
1103)
1104) PetscMPIInt :: dataset_rank
1105) character(len=MAXSTRINGLENGTH) :: dataset_name
1106) PetscInt, pointer :: int_array(:)
1107) character(len=MAXWORDLENGTH) :: word, word2
1108)
1109) dataset_name = "Revision Number" // CHAR(0)
1110)
1111) allocate(start(1))
1112) allocate(dims(1))
1113) allocate(length(1))
1114) allocate(stride(1))
1115) allocate(int_array(1))
1116)
1117) dataset_rank = 1
1118) dims(1) = ONE_INTEGER
1119) start(1) = 0
1120) length(1) = ONE_INTEGER
1121) stride(1) = ONE_INTEGER
1122)
1123) call CheckPointReadIntDatasetHDF5(chk_grp_id, dataset_name, dataset_rank, &
1124) dims, start, length, stride, int_array, option)
1125)
1126) if (int_array(1) /= CHECKPOINT_REVISION_NUMBER) then
1127) write(word,*) int_array(1)
1128) write(word2,*) CHECKPOINT_REVISION_NUMBER
1129) option%io_buffer = 'Incorrect checkpoint file format (' // &
1130) trim(adjustl(word)) // ' vs ' // &
1131) trim(adjustl(word2)) // ').'
1132) call printErrMsg(option)
1133) endif
1134)
1135) deallocate(start)
1136) deallocate(dims)
1137) deallocate(length)
1138) deallocate(stride)
1139) deallocate(int_array)
1140)
1141) end subroutine CheckPointReadCompatibilityHDF5
1142)
1143) ! ************************************************************************** !
1144)
1145) subroutine CheckpointFlowProcessModelHDF5(pm_grp_id, realization)
1146) !
1147) ! Checkpoints flow process model vectors
1148) !
1149) ! Author: Glenn Hammond
1150) ! Date: 07/26/13
1151) !
1152) use Option_module
1153) use Realization_Subsurface_class
1154) use Field_module
1155) use Discretization_module
1156) use Grid_module
1157) use Material_module
1158) use Variables_module, only : POROSITY, PERMEABILITY_X, PERMEABILITY_Y, &
1159) PERMEABILITY_Z
1160) use hdf5
1161) use HDF5_module, only : HDF5WriteDataSetFromVec
1162) implicit none
1163)
1164) #include "petsc/finclude/petscvec.h"
1165) #include "petsc/finclude/petscvec.h90"
1166)
1167) #if defined(SCORPIO_WRITE)
1168) integer :: pm_grp_id
1169) #else
1170) integer(HID_T) :: pm_grp_id
1171) #endif
1172) class(realization_subsurface_type) :: realization
1173) PetscErrorCode :: ierr
1174)
1175) type(option_type), pointer :: option
1176) type(field_type), pointer :: field
1177) type(discretization_type), pointer :: discretization
1178) type(grid_type), pointer :: grid
1179) Vec :: global_vec
1180) Vec :: natural_vec
1181) character(len=MAXSTRINGLENGTH) :: dataset_name
1182)
1183) option => realization%option
1184) field => realization%field
1185) discretization => realization%discretization
1186) grid => realization%patch%grid
1187)
1188) global_vec = 0
1189)
1190) if (option%nflowdof > 0) then
1191) call DiscretizationCreateVector(realization%discretization, NFLOWDOF, &
1192) natural_vec, NATURAL, option)
1193)
1194) call DiscretizationGlobalToNatural(discretization, field%flow_xx, &
1195) natural_vec, NFLOWDOF)
1196)
1197) dataset_name = "Primary_Variable" // CHAR(0)
1198) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
1199) pm_grp_id, H5T_NATIVE_DOUBLE)
1200) call VecDestroy(natural_vec, ierr);CHKERRQ(ierr)
1201)
1202) call DiscretizationCreateVector(realization%discretization, ONEDOF, &
1203) global_vec, GLOBAL,option)
1204) call DiscretizationCreateVector(realization%discretization, ONEDOF, &
1205) natural_vec, NATURAL, option)
1206)
1207) ! If we are running with multiple phases, we need to dump the vector
1208) ! that indicates what phases are present, as well as the 'var' vector
1209) ! that holds variables derived from the primary ones via the translator.
1210) select case(option%iflowmode)
1211) case(MPH_MODE,TH_MODE,RICHARDS_MODE,IMS_MODE,MIS_MODE, &
1212) FLASH2_MODE,G_MODE)
1213)
1214) call DiscretizationLocalToGlobal(realization%discretization, &
1215) field%iphas_loc,global_vec,ONEDOF)
1216)
1217) call DiscretizationGlobalToNatural(discretization, global_vec, &
1218) natural_vec, ONEDOF)
1219)
1220) dataset_name = "Secondary_Variable" // CHAR(0)
1221) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
1222) pm_grp_id, H5T_NATIVE_DOUBLE)
1223) case default
1224) end select
1225)
1226) ! Porosity and permeability.
1227) ! (We only write diagonal terms of the permeability tensor for now,
1228) ! since we have yet to add the full-tensor formulation.)
1229) call MaterialGetAuxVarVecLoc(realization%patch%aux%Material, &
1230) field%work_loc,POROSITY,ZERO_INTEGER)
1231) call DiscretizationLocalToGlobal(discretization,field%work_loc, &
1232) global_vec,ONEDOF)
1233) call DiscretizationGlobalToNatural(discretization, global_vec, &
1234) natural_vec, ONEDOF)
1235) dataset_name = "Porosity" // CHAR(0)
1236) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
1237) pm_grp_id, H5T_NATIVE_DOUBLE)
1238)
1239) call MaterialGetAuxVarVecLoc(realization%patch%aux%Material, &
1240) field%work_loc,PERMEABILITY_X,ZERO_INTEGER)
1241) call DiscretizationLocalToGlobal(discretization,field%work_loc, &
1242) global_vec,ONEDOF)
1243) call DiscretizationGlobalToNatural(discretization, global_vec, &
1244) natural_vec, ONEDOF)
1245) dataset_name = "Permeability_X" // CHAR(0)
1246) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
1247) pm_grp_id, H5T_NATIVE_DOUBLE)
1248)
1249) call MaterialGetAuxVarVecLoc(realization%patch%aux%Material, &
1250) field%work_loc,PERMEABILITY_Y,ZERO_INTEGER)
1251) call DiscretizationLocalToGlobal(discretization,field%work_loc, &
1252) global_vec,ONEDOF)
1253) call DiscretizationGlobalToNatural(discretization, global_vec, &
1254) natural_vec, ONEDOF)
1255) dataset_name = "Permeability_Y" // CHAR(0)
1256) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
1257) pm_grp_id, H5T_NATIVE_DOUBLE)
1258)
1259) call MaterialGetAuxVarVecLoc(realization%patch%aux%Material, &
1260) field%work_loc,PERMEABILITY_Z,ZERO_INTEGER)
1261) call DiscretizationLocalToGlobal(discretization,field%work_loc, &
1262) global_vec,ONEDOF)
1263) call DiscretizationGlobalToNatural(discretization, global_vec, &
1264) natural_vec, ONEDOF)
1265) dataset_name = "Permeability_Z" // CHAR(0)
1266) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
1267) pm_grp_id, H5T_NATIVE_DOUBLE)
1268)
1269) call VecDestroy(global_vec, ierr);CHKERRQ(ierr)
1270) call VecDestroy(natural_vec, ierr);CHKERRQ(ierr)
1271) endif
1272)
1273) end subroutine CheckpointFlowProcessModelHDF5
1274)
1275) ! ************************************************************************** !
1276)
1277) subroutine RestartFlowProcessModelHDF5(pm_grp_id, realization)
1278) !
1279) ! Restarts flow process model vectors
1280) !
1281) ! Author: Gautam Bisht, LBNL
1282) ! Date: 08/16/2015
1283) !
1284) use Option_module
1285) use Realization_Subsurface_class
1286) use Field_module
1287) use Discretization_module
1288) use Grid_module
1289) use Global_module
1290) use Material_module
1291) use Variables_module, only : POROSITY, PERMEABILITY_X, PERMEABILITY_Y, &
1292) PERMEABILITY_Z, STATE
1293) use hdf5
1294) use HDF5_module, only : HDF5ReadDataSetInVec
1295) implicit none
1296)
1297) #include "petsc/finclude/petscvec.h"
1298) #include "petsc/finclude/petscvec.h90"
1299)
1300) #if defined(SCORPIO_WRITE)
1301) integer :: pm_grp_id
1302) #else
1303) integer(HID_T) :: pm_grp_id
1304) #endif
1305) class(realization_subsurface_type) :: realization
1306) PetscErrorCode :: ierr
1307)
1308) type(option_type), pointer :: option
1309) type(field_type), pointer :: field
1310) type(discretization_type), pointer :: discretization
1311) type(grid_type), pointer :: grid
1312) Vec :: global_vec
1313) Vec :: natural_vec
1314) character(len=MAXSTRINGLENGTH) :: dataset_name
1315)
1316) option => realization%option
1317) field => realization%field
1318) discretization => realization%discretization
1319) grid => realization%patch%grid
1320)
1321) global_vec = 0
1322)
1323) if (option%nflowdof > 0) then
1324) call DiscretizationCreateVector(realization%discretization, NFLOWDOF, &
1325) natural_vec, NATURAL, option)
1326)
1327) dataset_name = "Primary_Variable" // CHAR(0)
1328) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
1329) pm_grp_id, H5T_NATIVE_DOUBLE)
1330)
1331) call DiscretizationNaturalToGlobal(discretization, natural_vec, field%flow_xx, &
1332) NFLOWDOF)
1333) call DiscretizationGlobalToLocal(discretization,field%flow_xx, &
1334) field%flow_xx_loc,NFLOWDOF)
1335) call VecCopy(field%flow_xx,field%flow_yy,ierr);CHKERRQ(ierr)
1336)
1337) call VecDestroy(natural_vec, ierr);CHKERRQ(ierr)
1338)
1339) call DiscretizationCreateVector(realization%discretization, ONEDOF, &
1340) global_vec, GLOBAL,option)
1341) call DiscretizationCreateVector(realization%discretization, ONEDOF, &
1342) natural_vec, NATURAL, option)
1343)
1344) ! If we are running with multiple phases, we need to dump the vector
1345) ! that indicates what phases are present, as well as the 'var' vector
1346) ! that holds variables derived from the primary ones via the translator.
1347) select case(option%iflowmode)
1348) case(MPH_MODE,TH_MODE,RICHARDS_MODE,IMS_MODE,MIS_MODE, &
1349) FLASH2_MODE,G_MODE)
1350)
1351) dataset_name = "Secondary_Variable" // CHAR(0)
1352) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
1353) pm_grp_id, H5T_NATIVE_DOUBLE)
1354)
1355) call DiscretizationNaturalToGlobal(discretization, natural_vec, global_vec, &
1356) ONEDOF)
1357)
1358) call DiscretizationGlobalToLocal(realization%discretization, &
1359) global_vec, field%iphas_loc, ONEDOF)
1360)
1361) call VecCopy(field%iphas_loc,field%iphas_old_loc,ierr);CHKERRQ(ierr)
1362) call DiscretizationLocalToLocal(discretization,field%iphas_loc, &
1363) field%iphas_old_loc,ONEDOF)
1364)
1365) if (option%iflowmode == G_MODE) then
1366) ! need to copy iphase into global_auxvar%istate
1367) call GlobalSetAuxVarVecLoc(realization,field%iphas_loc,STATE, &
1368) ZERO_INTEGER)
1369) endif
1370) if (option%iflowmode == MPH_MODE) then
1371) ! set vardof vec in mphase
1372) endif
1373) if (option%iflowmode == IMS_MODE) then
1374) ! set vardof vec in mphase
1375) endif
1376) if (option%iflowmode == FLASH2_MODE) then
1377) ! set vardof vec in mphase
1378) endif
1379)
1380) case default
1381) end select
1382)
1383) ! Porosity and permeability.
1384) ! (We only write diagonal terms of the permeability tensor for now,
1385) ! since we have yet to add the full-tensor formulation.)
1386) dataset_name = "Porosity" // CHAR(0)
1387) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
1388) pm_grp_id, H5T_NATIVE_DOUBLE)
1389) call DiscretizationNaturalToGlobal(discretization, natural_vec, global_vec, &
1390) ONEDOF)
1391) call DiscretizationGlobalToLocal(discretization, global_vec, field%work_loc, &
1392) ONEDOF)
1393) call MaterialSetAuxVarVecLoc(realization%patch%aux%Material, &
1394) field%work_loc,POROSITY,ZERO_INTEGER)
1395)
1396) dataset_name = "Permeability_X" // CHAR(0)
1397) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
1398) pm_grp_id, H5T_NATIVE_DOUBLE)
1399) call DiscretizationNaturalToGlobal(discretization, natural_vec, global_vec, &
1400) ONEDOF)
1401) call DiscretizationGlobalToLocal(discretization, global_vec, field%work_loc, &
1402) ONEDOF)
1403) call MaterialSetAuxVarVecLoc(realization%patch%aux%Material, &
1404) field%work_loc,PERMEABILITY_X,ZERO_INTEGER)
1405)
1406) dataset_name = "Permeability_Y" // CHAR(0)
1407) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
1408) pm_grp_id, H5T_NATIVE_DOUBLE)
1409) call DiscretizationNaturalToGlobal(discretization, natural_vec, global_vec, &
1410) ONEDOF)
1411) call DiscretizationGlobalToLocal(discretization, global_vec, field%work_loc, &
1412) ONEDOF)
1413) call MaterialSetAuxVarVecLoc(realization%patch%aux%Material, &
1414) field%work_loc,PERMEABILITY_Y,ZERO_INTEGER)
1415)
1416) dataset_name = "Permeability_Z" // CHAR(0)
1417) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
1418) pm_grp_id, H5T_NATIVE_DOUBLE)
1419) call DiscretizationNaturalToGlobal(discretization, natural_vec, global_vec, &
1420) ONEDOF)
1421) call DiscretizationGlobalToLocal(discretization, global_vec, field%work_loc, &
1422) ONEDOF)
1423) call MaterialSetAuxVarVecLoc(realization%patch%aux%Material, &
1424) field%work_loc,PERMEABILITY_Z,ZERO_INTEGER)
1425)
1426) call VecDestroy(global_vec, ierr);CHKERRQ(ierr)
1427) call VecDestroy(natural_vec, ierr);CHKERRQ(ierr)
1428) endif
1429)
1430) end subroutine RestartFlowProcessModelHDF5
1431) #endif
1432)
1433) ! ************************************************************************** !
1434)
1435) subroutine CheckpointRead(input,option,checkpoint_option,waypoint_list)
1436) !
1437) ! Reads the CHECKPOINT card in an input file.
1438) !
1439) ! Author: Jenn Frederick
1440) ! Date: 01/29/2016
1441) !
1442)
1443) use Option_module
1444) use Input_Aux_module
1445) use Output_Aux_module
1446) use Waypoint_module
1447) use String_module
1448) use Units_module
1449)
1450) implicit none
1451)
1452) type(input_type),pointer :: input
1453) type(option_type) :: option
1454) type(checkpoint_option_type), pointer :: checkpoint_option
1455) type(waypoint_list_type) :: waypoint_list
1456)
1457) character(len=MAXWORDLENGTH) :: word
1458) character(len=MAXWORDLENGTH) :: card
1459) character(len=MAXSTRINGLENGTH) :: temp_string
1460) character(len=MAXWORDLENGTH) :: internal_units
1461) character(len=MAXWORDLENGTH) :: default_time_units
1462) type(waypoint_type), pointer :: waypoint
1463) PetscReal :: units_conversion
1464) PetscReal :: temp_real
1465) PetscReal, pointer :: temp_real_array(:)
1466) PetscInt :: i
1467) PetscBool :: format_binary
1468) PetscBool :: format_hdf5
1469)
1470) if (.not.associated(checkpoint_option)) then
1471) checkpoint_option => CheckpointOptionCreate()
1472) endif
1473)
1474) format_binary = PETSC_FALSE
1475) format_hdf5 = PETSC_FALSE
1476) default_time_units = ''
1477) do
1478) call InputReadPflotranString(input,option)
1479) call InputReadStringErrorMsg(input,option,'CHECKPOINT')
1480) if (InputCheckExit(input,option)) exit
1481) call InputReadWord(input,option,word,PETSC_TRUE)
1482) call InputErrorMsg(input,option,'checkpoint option or value', &
1483) 'CHECKPOINT')
1484) call StringToUpper(word)
1485) select case(trim(word))
1486) case ('PERIODIC')
1487) call InputReadWord(input,option,word,PETSC_TRUE)
1488) call InputErrorMsg(input,option,'time increment', &
1489) 'CHECKPOINT,PERIODIC')
1490) select case(trim(word))
1491) case('TIME')
1492) call InputReadDouble(input,option,temp_real)
1493) call InputErrorMsg(input,option,'time increment', &
1494) 'CHECKPOINT,PERIODIC,TIME')
1495) call InputReadWord(input,option,word,PETSC_TRUE)
1496) call InputErrorMsg(input,option,'time increment units', &
1497) 'CHECKPOINT,PERIODIC,TIME')
1498) internal_units = 'sec'
1499) units_conversion = UnitsConvertToInternal(word, &
1500) internal_units,option)
1501) checkpoint_option%tconv = 1.d0/units_conversion
1502) checkpoint_option%tunit = trim(word)
1503) checkpoint_option%periodic_time_incr = temp_real*units_conversion
1504) case('TIMESTEP')
1505) call InputReadInt(input,option,checkpoint_option%periodic_ts_incr)
1506) call InputErrorMsg(input,option,'timestep increment', &
1507) 'CHECKPOINT,PERIODIC,TIMESTEP')
1508) case default
1509) call InputKeywordUnrecognized(word,'CHECKPOINT,PERIODIC', &
1510) option)
1511) end select
1512) case ('TIMES')
1513) call InputReadWord(input,option,word,PETSC_TRUE)
1514) call InputErrorMsg(input,option,'time units', &
1515) 'CHECKPOINT,TIMES')
1516) internal_units = 'sec'
1517) units_conversion = UnitsConvertToInternal(word,internal_units, &
1518) option)
1519) checkpoint_option%tconv = 1.d0/units_conversion
1520) checkpoint_option%tunit = trim(word)
1521) !geh: this needs to be tested.
1522) #if 0
1523) temp_string = 'CHECKPOINT,TIMES'
1524) nullify(temp_real_array)
1525) call UtilityReadArray(temp_real_array,NEG_ONE_INTEGER, &
1526) temp_string,input,option)
1527) do i = 1, size(temp_real_array)
1528) waypoint => WaypointCreate()
1529) waypoint%time = temp_real_array(i)*units_conversion
1530) waypoint%print_checkpoint = PETSC_TRUE
1531) call WaypointInsertInList(waypoint,waypoint_list)
1532) enddo
1533) call DeallocateArray(temp_real_array)
1534) #else
1535) do
1536) call InputReadDouble(input,option,temp_real)
1537) if (input%ierr /= 0) exit
1538) call InputErrorMsg(input,option,'checkpoint time', &
1539) 'CHECKPOINT,TIMES')
1540) waypoint => WaypointCreate()
1541) waypoint%time = temp_real * units_conversion
1542) waypoint%print_checkpoint = PETSC_TRUE
1543) call WaypointInsertInList(waypoint,waypoint_list)
1544) enddo
1545) #endif
1546) case ('FORMAT')
1547) call InputReadWord(input,option,word,PETSC_TRUE)
1548) call InputErrorMsg(input,option,'format type', &
1549) 'CHECKPOINT,FORMAT')
1550) call StringToUpper(word)
1551) select case(trim(word))
1552) case('BINARY')
1553) format_binary = PETSC_TRUE
1554) case('HDF5')
1555) format_hdf5 = PETSC_TRUE
1556) case default
1557) call InputKeywordUnrecognized(word,'CHECKPOINT,FORMAT', &
1558) option)
1559) end select
1560) case ('TIME_UNITS')
1561) call InputReadWord(input,option,default_time_units,PETSC_TRUE)
1562) call InputErrorMsg(input,option,'time units','CHECKPOINT')
1563) case default
1564) temp_string = 'Must specify PERIODIC TIME, PERIODIC TIMESTEP, &
1565) &TIMES, or FORMAT'
1566) call InputKeywordUnrecognized(word,'CHECKPOINT',temp_string,option)
1567) end select
1568) enddo
1569) if (len_trim(default_time_units) > 0) then
1570) internal_units = 'sec'
1571) units_conversion = UnitsConvertToInternal(default_time_units, &
1572) internal_units,option)
1573) checkpoint_option%tconv = 1.d0/units_conversion
1574) checkpoint_option%tunit = trim(default_time_units)
1575) endif
1576) if (format_binary .and. format_hdf5) then
1577) checkpoint_option%format = CHECKPOINT_BOTH
1578) else if (format_hdf5) then
1579) checkpoint_option%format = CHECKPOINT_HDF5
1580) else ! default
1581) checkpoint_option%format = CHECKPOINT_BINARY
1582) endif
1583)
1584) end subroutine CheckpointRead
1585)
1586) ! ************************************************************************** !
1587)
1588) subroutine CheckpointPeriodicTimeWaypoints(checkpoint_option,waypoint_list)
1589) !
1590) ! Inserts periodic time waypoints into list
1591) !
1592) ! Author: Glenn Hammond
1593) ! Date: 02/03/16
1594) !
1595)
1596) use Option_module
1597) use Waypoint_module
1598) use Output_Aux_module
1599) use Utility_module
1600)
1601) implicit none
1602)
1603) type(option_type) :: option
1604) type(checkpoint_option_type), pointer :: checkpoint_option
1605) type(waypoint_list_type) :: waypoint_list
1606) type(waypoint_type), pointer :: waypoint
1607) character(len=MAXWORDLENGTH) :: word
1608) PetscReal :: final_time
1609) PetscReal :: temp_real
1610) PetscReal :: num_waypoints, warning_num_waypoints
1611) PetscInt :: k
1612)
1613) final_time = WaypointListGetFinalTime(waypoint_list)
1614) warning_num_waypoints = 15000.0
1615)
1616) if (final_time < 1.d-40) then
1617) option%io_buffer = 'No final time specified in waypoint list. &
1618) &Send your input deck to pflotran-dev.'
1619) call printMsg(option)
1620) endif
1621)
1622) ! add waypoints for periodic checkpoint
1623) if (associated(checkpoint_option)) then
1624) if (Initialized(checkpoint_option%periodic_time_incr)) then
1625) temp_real = 0.d0
1626) num_waypoints = final_time / checkpoint_option%periodic_time_incr
1627) if ((num_waypoints > warning_num_waypoints) .and. &
1628) OptionPrintToScreen(option)) then
1629) write(word,*) floor(num_waypoints)
1630) write(*,*) 'WARNING: Large number (' // trim(adjustl(word)) // &
1631) ') of periodic checkpoints requested.'
1632) write(*,'(a68)',advance='no') ' Creating periodic checkpoint &
1633) &waypoints . . . Progress: 0%-'
1634) endif
1635) k = 0
1636) do
1637) k = k + 1
1638) temp_real = temp_real + checkpoint_option%periodic_time_incr
1639) if (temp_real > final_time) exit
1640) waypoint => WaypointCreate()
1641) waypoint%time = temp_real
1642) waypoint%print_checkpoint = PETSC_TRUE
1643) call WaypointInsertInList(waypoint,waypoint_list)
1644) if ((num_waypoints > warning_num_waypoints) .and. &
1645) OptionPrintToScreen(option)) then
1646) call PrintProgressBarInt(floor(num_waypoints),10,k)
1647) endif
1648) enddo
1649) endif
1650) endif
1651)
1652) end subroutine CheckpointPeriodicTimeWaypoints
1653)
1654) ! ************************************************************************** !
1655)
1656) subroutine CheckpointInputRecord(checkpoint_option,waypoint_list)
1657) !
1658) ! Writes ingested information to the input record file.
1659) !
1660) ! Author: Jenn Frederick, SNL
1661) ! Date: 03/17/2016
1662) !
1663) use Output_Aux_module
1664) use Waypoint_module
1665)
1666) implicit none
1667)
1668) type(checkpoint_option_type), pointer :: checkpoint_option
1669) type(waypoint_list_type), pointer :: waypoint_list
1670)
1671) type(waypoint_type), pointer :: cur_waypoint
1672) character(len=MAXWORDLENGTH) :: word
1673) character(len=MAXSTRINGLENGTH) :: string
1674) PetscBool :: checkpoints_found
1675) PetscInt :: id = INPUT_RECORD_UNIT
1676)
1677) write(id,'(a)') ' '
1678) write(id,'(a)') '---------------------------------------------------------&
1679) &-----------------------'
1680) write(id,'(a29)',advance='no') '---------------------------: '
1681) write(id,'(a)') 'CHECKPOINTS'
1682)
1683) if (associated(checkpoint_option)) then
1684) write(id,'(a29)',advance='no') 'periodic timestep: '
1685) if (checkpoint_option%periodic_ts_incr == 0) then
1686) write(id,'(a)') 'OFF'
1687) else
1688) write(id,'(a)') 'ON'
1689) write(id,'(a29)',advance='no') 'timestep increment: '
1690) write(word,*) checkpoint_option%periodic_ts_incr
1691) write(id,'(a)') adjustl(trim(word))
1692) endif
1693)
1694) write(id,'(a29)',advance='no') 'periodic time: '
1695) if (checkpoint_option%periodic_time_incr <= 0) then
1696) write(id,'(a)') 'OFF'
1697) else
1698) write(id,'(a)') 'ON'
1699) write(id,'(a29)',advance='no') 'time increment: '
1700) write(word,*) checkpoint_option%periodic_time_incr * &
1701) checkpoint_option%tconv
1702) write(id,'(a)') adjustl(trim(word)) // &
1703) adjustl(trim(checkpoint_option%tunit))
1704) endif
1705) endif
1706)
1707) string = ''
1708) checkpoints_found = PETSC_FALSE
1709) write(id,'(a29)',advance='no') 'specific times: '
1710) cur_waypoint => waypoint_list%first
1711) do
1712) if (.not.associated(cur_waypoint)) exit
1713) if (cur_waypoint%print_checkpoint) then
1714) checkpoints_found = PETSC_TRUE
1715) write(word,*) cur_waypoint%time*checkpoint_option%tconv
1716) string = trim(string) // adjustl(trim(word)) // ','
1717) endif
1718) cur_waypoint => cur_waypoint%next
1719) enddo
1720) if (checkpoints_found) then
1721) write(id,'(a)') 'ON'
1722) write(id,'(a29)',advance='no') 'times (' // &
1723) trim(checkpoint_option%tunit) // '): '
1724) write(id,'(a)') trim(string)
1725) else
1726) write(id,'(a)') 'OFF'
1727) endif
1728)
1729) end subroutine CheckpointInputRecord
1730)
1731) end module Checkpoint_module