IO: Rewrite write_snapshot_h5().

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-19 23:44:04 -03:00
parent ff4f600922
commit 3987c45cfe

@ -799,7 +799,7 @@ module io
select case(snapshot_format)
#ifdef HDF5
case(snapshot_hdf5)
call write_snapshot_h5(problem)
call write_snapshot_h5(problem, status)
if (with_xdmf) then
call write_snapshot_xdmf()
if (master) call write_snapshot_xdmf_master()
@ -3879,99 +3879,51 @@ module io
! subroutine WRITE_SNAPSHOT_H5:
! ----------------------------
!
! Subroutine writes the current simulation snapshot, i.e. parameters,
! coordinates and variables to the HDF5 format files for further processing.
! Subroutine stores the current simulation snapshot, i.e. parameters,
! coordinates and variables as the HDF5 file.
!
! Arguments:
!
! problem - the problem's name;
! status - the subroutine call status;
!
!===============================================================================
!
subroutine write_snapshot_h5(problem)
subroutine write_snapshot_h5(problem, 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(out) :: status
character(len=64) :: fl
character(len=255) :: fname
integer(hid_t) :: fid
integer :: err
character(len=*), parameter :: loc = 'IO::write_snapshot_h5()'
!-------------------------------------------------------------------------------
!
! prepare the restart snapshot filename
!
write (fl, "(a1,i6.6,'_',i5.5,'.h5')") ftype, isnap, nproc
write(fname,"('p',i6.6,'_',i5.5,'.h5')") isnap, 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)
call h5fcreate_f(fname, H5F_ACC_TRUNC_F, fid, status)
if (status < 0) then
call print_message(loc, "Could not create file " // trim(fname))
return
end if
! write the global attributes
!
call write_attributes_h5(fid, problem)
! write the coordinates (data block bounds, refinement levels, etc.)
!
call write_coordinates_h5(fid)
! depending on the selected type of output file write the right groups
!
select case(ftype)
case('c')
! write the variables stored in data blocks (leafs)
!
call write_conservative_variables_h5(fid)
case('p')
! write the variables stored in data blocks (leafs)
!
call write_primitive_variables_h5(fid)
case default
! print information about unsupported file format and quit
!
write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "File type is not suppoerted!"
call h5fclose_f(fid, err)
return
end select
! 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)
call h5fclose_f(fid, status)
if (status > 0) then
call print_message(loc, "Could not close file " // trim(fname))
return
end if