string array support for attributes

This commit is contained in:
Martin Diehl 2021-07-24 17:18:31 +02:00
parent eef7b8f0a9
commit 59d09d708e
1 changed files with 84 additions and 7 deletions

View File

@ -71,6 +71,7 @@ module HDF5_utilities
module procedure HDF5_addAttribute_str module procedure HDF5_addAttribute_str
module procedure HDF5_addAttribute_int module procedure HDF5_addAttribute_int
module procedure HDF5_addAttribute_real module procedure HDF5_addAttribute_real
module procedure HDF5_addAttribute_str_array
module procedure HDF5_addAttribute_int_array module procedure HDF5_addAttribute_int_array
module procedure HDF5_addAttribute_real_array module procedure HDF5_addAttribute_real_array
end interface HDF5_addAttribute end interface HDF5_addAttribute
@ -270,7 +271,7 @@ end subroutine HDF5_closeGroup
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief check whether a group or a dataset exists !> @brief Check whether a group or a dataset exists.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function HDF5_objectExists(loc_id,path) logical function HDF5_objectExists(loc_id,path)
@ -280,6 +281,7 @@ logical function HDF5_objectExists(loc_id,path)
integer :: hdferr integer :: hdferr
character(len=:), allocatable :: p character(len=:), allocatable :: p
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -298,7 +300,7 @@ end function HDF5_objectExists
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief adds a string attribute to the path given relative to the location !> @brief Add a string attribute to the path given relative to the location.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
@ -313,6 +315,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
character(len=:,kind=C_CHAR), allocatable,target :: attrValue_ character(len=:,kind=C_CHAR), allocatable,target :: attrValue_
type(c_ptr), target, dimension(1) :: ptr type(c_ptr), target, dimension(1) :: ptr
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -326,6 +329,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5tcopy_f(H5T_STRING, type_id, hdferr) call h5tcopy_f(H5T_STRING, type_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then if (attrExists) then
@ -336,6 +340,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, type_id, c_loc(ptr(1)), hdferr) call h5awrite_f(attr_id, type_id, c_loc(ptr(1)), hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr) call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(type_id,hdferr) call h5tclose_f(type_id,hdferr)
@ -347,7 +352,7 @@ end subroutine HDF5_addAttribute_str
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief adds a integer attribute to the path given relative to the location !> @brief Add an integer attribute to the path given relative to the location.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path) subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
@ -361,6 +366,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
logical :: attrExists logical :: attrExists
character(len=:), allocatable :: p character(len=:), allocatable :: p
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -369,6 +375,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
call h5screate_f(H5S_SCALAR_F,space_id,hdferr) call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then if (attrExists) then
@ -379,6 +386,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr) call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr) call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr) call h5sclose_f(space_id,hdferr)
@ -388,7 +396,7 @@ end subroutine HDF5_addAttribute_int
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief adds a integer attribute to the path given relative to the location !> @brief Add a real attribute to the path given relative to the location.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path) subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
@ -402,6 +410,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
logical :: attrExists logical :: attrExists
character(len=:), allocatable :: p character(len=:), allocatable :: p
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -410,6 +419,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
call h5screate_f(H5S_SCALAR_F,space_id,hdferr) call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then if (attrExists) then
@ -420,6 +430,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr) call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr) call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr) call h5sclose_f(space_id,hdferr)
@ -429,7 +440,67 @@ end subroutine HDF5_addAttribute_real
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief adds a integer attribute to the path given relative to the location !> @brief Add a string array attribute to the path given relative to the location.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel
character(len=*), intent(in), dimension(:) :: attrValue
character(len=*), intent(in), optional :: path
integer(HID_T) :: attr_id, space_id, filetype_id, memtype_id
integer :: hdferr
logical :: attrExists
character(len=:), allocatable :: p
type(C_PTR) :: f_ptr
character(len=:), allocatable, dimension(:), target :: attrValue_
if (present(path)) then
p = trim(path)
else
p = '.'
endif
attrValue_ = attrValue
call h5tcopy_f(H5T_C_S1,filetype_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tset_size_f(filetype_id, int(len(attrValue_)+1,C_SIZE_T),hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tset_size_f(memtype_id, int(len(attrValue_),C_SIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5screate_simple_f(1,shape(attrValue_,kind=HSIZE_T),space_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),filetype_id,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
f_ptr = c_loc(attrValue_)
call h5awrite_f(attr_id, memtype_id, f_ptr, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(memtype_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(filetype_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_addAttribute_str_array
!--------------------------------------------------------------------------------------------------
!> @brief Add an integer array attribute to the path given relative to the location.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path) subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
@ -444,6 +515,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
logical :: attrExists logical :: attrExists
character(len=:), allocatable :: p character(len=:), allocatable :: p
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -454,6 +526,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size) call h5screate_simple_f(1, array_size, space_id, hdferr, array_size)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then if (attrExists) then
@ -464,6 +537,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr) call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr) call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr) call h5sclose_f(space_id,hdferr)
@ -473,7 +547,7 @@ end subroutine HDF5_addAttribute_int_array
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief adds a real attribute to the path given relative to the location !> @brief Add a real array attribute to the path given relative to the location.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path) subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
@ -488,6 +562,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
logical :: attrExists logical :: attrExists
character(len=:), allocatable :: p character(len=:), allocatable :: p
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -498,6 +573,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size) call h5screate_simple_f(1, array_size, space_id, hdferr, array_size)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then if (attrExists) then
@ -508,6 +584,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr) call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr) call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr) call h5sclose_f(space_id,hdferr)
@ -517,7 +594,7 @@ end subroutine HDF5_addAttribute_real_array
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief set link to object in results file !> @brief Set link to object in results file.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_setLink(loc_id,target_name,link_name) subroutine HDF5_setLink(loc_id,target_name,link_name)