IO: Rewrite write_restart_snapshot_h5().

Also rename it to store_restart_snapshot_h5().

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-21 17:27:22 -03:00
parent ab20167cb5
commit 9e87eb0740

View File

@ -700,7 +700,7 @@ module io
select case(snapshot_format)
#ifdef HDF5
case(snapshot_hdf5)
call write_restart_snapshot_h5(problem, nrun, status)
call store_restart_snapshot_h5(problem, nrun, status)
#endif /* HDF5 */
case default
call write_restart_snapshot_xml(problem, nrun, status)
@ -3742,91 +3742,59 @@ module io
!
!===============================================================================
!
! subroutine WRITE_RESTART_SNAPSHOT_H5:
! subroutine STORE_RESTART_SNAPSHOT_H5:
! ------------------------------------
!
! Subroutine writes restart snapshot, i.e. parameters, meta and data blocks
! to the HDF5 format restart files in order to resume a terminated job later.
! Subroutine stores restart snapshots in the HDF5 format.
!
! Arguments:
!
! problem - the problem's name;
! nrun - the snapshot number;
! iret - the return flag to inform if subroutine succeeded or failed;
! status - the subroutine call status;
!
!===============================================================================
!
subroutine write_restart_snapshot_h5(problem, nrun, iret)
subroutine store_restart_snapshot_h5(problem, nrun, status)
use hdf5 , only : hid_t
use hdf5 , only : H5F_ACC_TRUNC_F, H5F_SCOPE_GLOBAL_F
use hdf5 , only : h5fcreate_f, h5fflush_f, h5fclose_f
use iso_fortran_env, only : error_unit
use mpitools , only : nproc
use hdf5
use helpers , only : print_message
use mpitools, only : nproc
implicit none
character(len=*), intent(in) :: problem
integer , intent(in) :: nrun
integer , intent(out) :: iret
integer , intent(out) :: status
character(len=64) :: fl
integer(hid_t) :: fid
integer :: err
character(len=255) :: fname
integer(hid_t) :: file_id
character(len=*), parameter :: loc = 'IO::write_restart_snapshot_h5()'
character(len=*), parameter :: loc = 'IO::store_restart_snapshot_h5()'
!-------------------------------------------------------------------------------
!
! prepare the restart snapshot filename
!
write (fl, "('r',i6.6,'_',i5.5,'.h5')") nrun, nproc
write(fname, "('r',i6.6,'_',i5.5,'.h5')") nrun, nproc
! create the new HDF5 file to store the snapshot
!
call h5fcreate_f(fl, H5F_ACC_TRUNC_F, fid, err)
! if the file could not be created, print message and quit
!
if (err < 0) then
write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "Cannot create file: " // trim(fl)
iret = 201
call h5fcreate_f(fname, H5F_ACC_TRUNC_F, file_id, status)
if (status < 0) then
call print_message(loc, "Could not create file " // trim(fname))
return
end if
! write the global attributes
!
call store_attributes_h5(fid, problem, .true., err)
call store_attributes_h5(file_id, problem, .true., status)
! write all metablocks which represent the internal structure of domain
!
call write_metablocks_h5(fid)
call write_metablocks_h5(file_id)
! write all datablocks which represent the all variables
!
call store_datablocks_h5(fid, err)
call store_datablocks_h5(file_id, status)
! flush the file
!
call h5fflush_f(fid, H5F_SCOPE_GLOBAL_F, err)
! close the file
!
call h5fclose_f(fid, err)
! if the file could not be closed print message and quit
!
if (err > 0) then
write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "Cannot close file: " // trim(fl)
iret = 203
return
end if
call h5fclose_f(file_id, status)
if (status < 0) &
call print_message(loc, "Could not close file " // trim(fname))
!-------------------------------------------------------------------------------
!
end subroutine write_restart_snapshot_h5
end subroutine store_restart_snapshot_h5
!
!===============================================================================
!