gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

IO: Rewrite read_snapshot_parameter_double_h5().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-23 10:18:07 -03:00
parent e1b3e2f10f
commit 92622f1b17
1 changed files with 44 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
sources/io.F90
View File

@ -3251,92 +3251,68 @@ module io
!
! Arguments:
!
! pname - the parameter name;
! pvalue - the parameter value;
! iret - the success flag (the success is 0, failure otherwise);
! pname - the parameter's name;
! pvalue - the parameter's value;
! status - the subroutine call status;
!
!===============================================================================
!
subroutine read_snapshot_parameter_double_h5(pname, pvalue, iret)
subroutine read_snapshot_parameter_double_h5(pname, pvalue, status)
! import external procedures
!
use hdf5 , only : hid_t
use hdf5 , only : H5F_ACC_RDONLY_F
use hdf5 , only : H5T_NATIVE_DOUBLE
use hdf5 , only : hid_t, hsize_t
use hdf5 , only : h5fopen_f, h5fclose_f
use hdf5 , only : h5gopen_f, h5gclose_f
use hdf5 , only : h5aexists_by_name_f
use hdf5 , only : h5aopen_by_name_f, h5aread_f, h5aclose_f
use iso_fortran_env, only : error_unit
use mpitools , only : nproc
use parameters , only : get_parameter
use hdf5
use helpers, only : print_message
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
character(len=*), intent(in) :: pname
real(kind=8) , intent(inout) :: pvalue
integer , intent(inout) :: iret
integer , intent(inout) :: status
! local variables
!
logical :: info
character(len=255) :: rname
integer :: np
integer(hid_t) :: fid, gid, aid
integer(hsize_t) :: am(1) = 1
character(len=255) :: fname
logical :: flag
integer(hid_t) :: file_id, grp_id
! local parameters
!
character(len=*), parameter :: loc = &
'IO::read_snapshot_parameter_double_h5()'
!
!-------------------------------------------------------------------------------
!
! reset the success flag
!
iret = 0
status = 0
! generate the filename of the restart snapshot
!
info = .false.
np = nproc + 1
do while (.not. info .and. np >= 0)
np = np - 1
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, np
inquire(file = rname, exist = info)
end do
! procees if file exists
!
if (info) then
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
if (iret >= 0) then
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
call h5aread_f(aid, H5T_NATIVE_DOUBLE, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
end if
call h5gclose_f(gid, iret)
end if
call h5fclose_f(fid, iret)
end if
else
write(error_unit,"('[', a, ']: ', a)") trim(loc) &
, "Snapshot " // trim(rname) // " file does not exist!"
iret = 1
write(fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, 0
inquire(file=fname, exist=flag)
if (.not. flag) then
call print_message(loc, "Restart snapshot " // trim(fname) // &
" does not exist!")
status = 1
return
end if
call h5fopen_f(fname, H5F_ACC_RDONLY_F, file_id, status)
if (status /= 0) then
call print_message(loc, "Could not open " // trim(fname) // "!")
return
end if
call h5gopen_f(file_id, 'attributes', grp_id, status)
if (status == 0) then
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_DOUBLE, 1, pvalue, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
call h5gclose_f(grp_id, status)
if (status /= 0) &
call print_message(loc, "Could not close group 'attributes'!")
else
call print_message(loc, "Could not open group 'attributes'!")
end if
call h5fclose_f(file_id, status)
if (status /= 0) &
call print_message(loc, "Could not close " // trim(fname) // "!")
!-------------------------------------------------------------------------------
!
end subroutine read_snapshot_parameter_double_h5