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

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