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

IO: Rewrite subroutine store_datablocks_h5().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-23 09:58:02 -03:00
parent 7dd68c6ea7
commit 0d65f08499
1 changed files with 48 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
sources/io.F90
View File

@ -4825,7 +4825,7 @@ module io
character(len=64) :: blk_name
integer(hid_t) :: grp_id, blk_id
integer(kind=4) :: n
integer(kind=4) :: l
integer(hsize_t), dimension(4) :: pdims = 1
integer(hsize_t), dimension(5) :: cdims = 1
@ -4837,51 +4837,56 @@ module io
status = 0
call h5gcreate_f(loc_id, 'datablocks', grp_id, status)
if (status >= 0) then
if (get_dblocks() > 0) then
n = 0
pdata => list_data
do while(associated(pdata))
n = n + 1
write(blk_name, "('datablock_', i0)") n
call h5gcreate_f(grp_id, blk_name, blk_id, status)
if (status >= 0) then
call store_attribute_h5(blk_id, 'meta', &
H5T_NATIVE_INTEGER, 1, pdata%meta%id, status)
pdims = shape(pdata%q)
cdims = shape(pdata%uu)
call store_dataset_h5(blk_id, 'primitive_variables', &
H5T_NATIVE_DOUBLE, pdims, pdata%q, status)
if (status < 0) &
call print_message(loc, "Could not store the primitive " // &
"variables in " // trim(blk_name) // "!")
call store_dataset_h5(blk_id, 'conservative_variables', &
H5T_NATIVE_DOUBLE, cdims, pdata%uu, status)
if (status < 0) &
call print_message(loc, "Could not store the conservative " // &
"variables in " // trim(blk_name) // "!")
call h5gclose_f(blk_id, status)
if (status < 0) &
call print_message(loc, "Could not close group for " // &
trim(blk_name) // "!")
else
call print_message(loc, "Could not create group for " // &
trim(blk_name) // "!")
end if
pdata => pdata%next
end do ! data blocks
end if ! dblocks > 0
call h5gclose_f(grp_id, status)
if (status < 0) &
call print_message(loc, "Could not close group 'datablocks'!")
else
if (status /= 0) then
call print_message(loc, "Could not create group 'datablocks'!")
end if
if (get_dblocks() > 0) then
l = 0
pdata => list_data
do while(associated(pdata))
l = l + 1
write(blk_name, "('datablock_', i0)") l
call h5gcreate_f(grp_id, blk_name, blk_id, status)
if (status == 0) then
call store_attribute_h5(blk_id, 'meta', &
H5T_NATIVE_INTEGER, 1, pdata%meta%id, status)
pdims = shape(pdata%q)
cdims = shape(pdata%uu)
call store_dataset_h5(blk_id, 'primitive_variables', &
H5T_NATIVE_DOUBLE, pdims, pdata%q, status)
if (status /= 0) &
call print_message(loc, &
"Could not store the primitive variables in " // &
trim(blk_name) // "!")
call store_dataset_h5(blk_id, 'conservative_variables', &
H5T_NATIVE_DOUBLE, cdims, pdata%uu, status)
if (status /= 0) &
call print_message(loc, &
"Could not store the conservative variables in " // &
trim(blk_name) // "!")
call h5gclose_f(blk_id, status)
if (status /= 0) &
call print_message(loc, &
"Could not close group for " // trim(blk_name) // "!")
else
call print_message(loc, &
"Could not create group for " // trim(blk_name) // "!")
end if
pdata => pdata%next
end do
end if
call h5gclose_f(grp_id, status)
if (status /= 0) &
call print_message(loc, "Could not close group 'datablocks'!")
!-------------------------------------------------------------------------------
!
end subroutine store_datablocks_h5