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

IO: Handle properly strings and scalars in store_attribute_h5().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-20 20:30:25 -03:00
parent 20c8946912
commit c93031cdcf
1 changed files with 29 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
sources/io.F90
View File

@ -5482,31 +5482,54 @@ module io
type(*) , target , intent(in) :: buf
integer , intent(out) :: status
logical :: equal
integer :: ndims
integer(hid_t) :: space_id, attr_id
integer(hid_t) :: space_id, attr_id, mem_id
character(len=*), parameter :: loc = 'IO::store_attribute_h5()'
!-------------------------------------------------------------------------------
!
ndims = rank(dims)
if (ndims == 1 .and. dims(1) == 1) then
call h5tequal_f(type_id, H5T_NATIVE_CHARACTER, equal, status)
if (status < 0) &
call print_message(loc, "Could not compare datatypes.")
if (equal) then
call h5tcopy_f(H5T_NATIVE_CHARACTER, mem_id, status)
if (status >= 0) then
call h5tset_size_f(mem_id, dims(1), status)
if (status < 0) &
call print_message(loc, "Could not set the datatype dimension!")
else
call print_message(loc, "Could not copy datatype!")
end if
call h5screate_f(H5S_SCALAR_F, space_id, status)
if (status < 0) &
call print_message(loc, "Could not create dataspace!")
call h5screate_f(H5S_SCALAR_F, space_id, status)
else if (ndims == 1 .and. dims(1) == 1) then
call h5tcopy_f(type_id, mem_id, status)
if (status < 0) &
call print_message(loc, "Could not copy datatype!")
call h5screate_f(H5S_SCALAR_F, space_id, status)
else
call h5tcopy_f(type_id, mem_id, status)
if (status < 0) &
call print_message(loc, "Could not copy datatype!")
call h5screate_simple_f(ndims, dims, space_id, status)
end if
if (status >= 0) then
call h5acreate_f(loc_id, name, type_id, space_id, attr_id, status)
call h5acreate_f(loc_id, name, mem_id, space_id, attr_id, status)
if (status >= 0) then
call h5awrite_f(attr_id, type_id, c_loc(buf), status)
call h5awrite_f(attr_id, mem_id, c_loc(buf), status)
if (status >= 0) then
call h5aclose_f(attr_id, status)
if (status < 0) then
call print_message(loc, &
call print_message(loc, &
"Could not close the attribute: " // trim(name))
end if
else
call print_message(loc, &
call print_message(loc, &
"Could not write the attribute: " // trim(name))
end if
else