string: unify with h5fortran, incl. UTF8 passthrough

Author: scivision

CMakeLists.txt

@@ -50,6 +50,26 @@ endif()
 
 # --- HDF5-MPI object oriented API
 
+add_library(h5mpi)
+target_include_directories(h5mpi PUBLIC
+$<BUILD_INTERFACE:${CMAKE_CURRENT_BINARY_DIR}/include>
+$<INSTALL_INTERFACE:include>
+)
+target_link_libraries(h5mpi PUBLIC HDF5::HDF5 MPI::MPI_Fortran)
+set_target_properties(h5mpi PROPERTIES
+Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/include
+LABELS core
+VERSION ${PROJECT_VERSION}
+)
+
+# GLOBAL needed for use by FetchContent
+add_library(h5mpi::h5mpi INTERFACE IMPORTED GLOBAL)
+target_link_libraries(h5mpi::h5mpi INTERFACE h5mpi)
+
+install(FILES ${CMAKE_CURRENT_BINARY_DIR}/include/h5mpi.mod TYPE INCLUDE)
+
+install(TARGETS h5mpi EXPORT ${PROJECT_NAME}-targets)
+
 add_subdirectory(src)
 
 if(${PROJECT_NAME}_BUILD_TESTING)

cmake/hdf5.cmake

@@ -84,7 +84,7 @@ INACTIVITY_TIMEOUT 60
 file(MAKE_DIRECTORY ${HDF5_INCLUDE_DIRS})
 # avoid race condition
 
-# this GLOBAL is required to be visible via other project's FetchContent of h5fortran
+# this GLOBAL is required to be visible via other project's FetchContent
 add_library(HDF5::HDF5 INTERFACE IMPORTED GLOBAL)
 target_include_directories(HDF5::HDF5 INTERFACE "${HDF5_INCLUDE_DIRS}")
 target_link_libraries(HDF5::HDF5 INTERFACE "${HDF5_LIBRARIES}")

src/CMakeLists.txt

@@ -4,21 +4,11 @@ hdf5_compression_flag()
 configure_file(hdf5_config.f90.in hdf5_config.f90 @ONLY)
 
 # main library
-add_library(h5mpi
+target_sources(h5mpi PRIVATE
 utils.f90
 ${CMAKE_CURRENT_BINARY_DIR}/hdf5_config.f90
-read.f90 read_scalar.f90 reader.f90
+read.f90 read_scalar.f90 read_scalar_ascii.f90 reader.f90
 write.f90 write_scalar.f90 writer.f90
 interface.f90
 attr.f90 attr_read.f90 attr_write.f90
 )
-target_link_libraries(h5mpi PRIVATE HDF5::HDF5 MPI::MPI_Fortran)
-set_target_properties(h5mpi PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/include)
-target_include_directories(h5mpi PUBLIC
-$<BUILD_INTERFACE:${CMAKE_CURRENT_BINARY_DIR}/include>
-$<INSTALL_INTERFACE:include>
-)
-
-install(TARGETS h5mpi EXPORT ${PROJECT_NAME}-targets)
-
-install(FILES ${CMAKE_CURRENT_BINARY_DIR}/include/h5mpi.mod TYPE INCLUDE)

src/read_scalar.f90

@@ -1,53 +1,39 @@
 submodule (h5mpi:hdf5_read) read_scalar
 
-use h5lt, only : h5ltread_dataset_string_f
-use hdf5, only : h5dread_f, h5dget_space_f, h5dvlen_get_max_len_f, h5dread_vl_f, h5dvlen_reclaim_f,&
-h5tis_variable_str_f, &
-h5sclose_f, &
-H5T_STR_NULLTERM_F
+use hdf5, only : H5Dread_f, &
+H5Sclose_f
 
 implicit none (type, external)
 
+interface
+
+module subroutine read_scalar_char(A, dset_id, file_space_id, mem_space_id, dims)
+class(*), intent(inout) :: A
+integer(HID_T), intent(in) :: dset_id, file_space_id
+integer(HID_T), intent(inout) :: mem_space_id
+integer(HSIZE_T), intent(in) :: dims(:)
+end subroutine
+
+end interface
+
 contains
 
 
 module procedure h5read_scalar
 
 integer(HSIZE_T) :: dims(0)
-integer(SIZE_T) :: dsize
-integer(HID_T) :: dset_id, type_id, xfer_id, space_id
-integer :: dclass, ier, i, pad_type
+integer(HID_T) :: dset_id, xfer_id, file_space_id, mem_space_id
+integer :: dclass, ier
 
-logical :: vector_scalar, vstatus
+logical :: is_scalar
 
-real(real32) :: buf_r32(1)
-real(real64) :: buf_r64(1)
-integer(int32) :: buf_i32(1)
-integer(int64) :: buf_i64(1)
+file_space_id = H5S_ALL_F
+mem_space_id = H5S_ALL_F
 
-call hdf_rank_check(self, dname, rank(A), vector_scalar)
-if(vector_scalar) then
-  select type(A)
-  type is (real(real32))
-    call h5read_1d(self, dname, buf_r32)
-    A = buf_r32(1)
-  type is (real(real64))
-    call h5read_1d(self, dname, buf_r64)
-    A = buf_r64(1)
-  type is (integer(int32))
-    call h5read_1d(self, dname, buf_i32)
-    A = buf_i32(1)
-  type is (integer(int64))
-    call h5read_1d(self, dname, buf_i64)
-    A = buf_i64(1)
-  class default
-    error stop "h5fortran:read:vector_scalar: unknown memory variable type" // dname
-  end select
-  return
-endif
+call hdf_rank_check(self, dname, rank(A), is_scalar)
 
-call h5dopen_f(self%file_id, dname, dset_id, ier)
-if(ier/=0) error stop 'h5fortran:reader: ' // dname // ' could not be opened in ' // self%filename
+call H5Dopen_f(self%file_id, dname, dset_id, ier)
+if(ier/=0) error stop 'ERROR:h5fortran:reader: ' // dname // ' could not be opened in ' // self%filename
 
 call get_dset_class(self, dname, dclass, dset_id)
 
@@ -62,99 +48,40 @@
 if(dclass == H5T_FLOAT_F) then
   select type(A)
   type is (real(real64))
-    call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, A, dims, ier)
+    call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE, A, dims, ier)
   type is (real(real32))
-    call h5dread_f(dset_id, H5T_NATIVE_REAL, A, dims, ier)
+    call H5Dread_f(dset_id, H5T_NATIVE_REAL, A, dims, ier)
   class default
-    error stop 'h5fortran:read: real disk dataset ' // dname // ' needs real memory variable'
+    error stop 'ERROR:h5fortran:read: real disk dataset ' // dname // ' needs real memory variable'
   end select
 elseif(dclass == H5T_INTEGER_F) then
   select type(A)
   type is (integer(int32))
-    call h5dread_f(dset_id, H5T_NATIVE_INTEGER, A, dims, ier)
+    call H5Dread_f(dset_id, H5T_NATIVE_INTEGER, A, dims, ier)
   type is (integer(int64))
-    call h5dread_f(dset_id, H5T_STD_I64LE, A, dims, ier)
+    call H5Dread_f(dset_id, H5T_STD_I64LE, A, dims, ier)
   class default
-    error stop 'h5fortran:read: integer disk dataset ' // dname // ' needs integer memory variable'
+    error stop 'ERROR:h5fortran:read: integer disk dataset ' // dname // ' needs integer memory variable'
   end select
 elseif(dclass == H5T_STRING_F) then
-  select type(A)
-  type is (character(*))
-    call H5Dget_type_f(dset_id, type_id, ier)
-    if(ier/=0) error stop "h5fortran:read:h5tget_type " // dname // " in " // self%filename
-    call h5tis_variable_str_f(type_id, vstatus, ier)
-    if(ier/=0) error stop "h5fortran:read:h5tis_variable_str " // dname // " in " // self%filename
-
-    if(vstatus) then
-      call H5Dget_space_f(dset_id, space_id, ier)
-      if(ier/=0) error stop "h5fortran:read:h5dget_space " // dname // " in " // self%filename
-      !call h5dvlen_get_max_len_f(dset_id, type_id, space_id, dsize, ier)
-      !if(ier/=0) error stop "h5fortran:read:h5dvlen_get_max_len " // dname // " in " // self%filename
-
-      block
-      character(10000) :: buf_char(1)
-      !! TODO: dynamically determine buffer size
-      integer(HSIZE_T) :: vldims(2)
-      integer(SIZE_T) :: vlen(1)
-
-      vldims = [len(buf_char), 1]
-
-      call h5dread_vl_f(dset_id, type_id, buf_char, vldims, vlen, hdferr=ier, mem_space_id=space_id)
-      if(ier/=0) error stop "h5fortran:read:h5dread_vl " // dname // " in " // self%filename
-
-      i = index(buf_char(1), c_null_char) - 1
-      if (i == -1) i = len_trim(buf_char(1))
-
-      A = buf_char(1)(:i)
-
-      ! call h5dvlen_reclaim_f(type_id, H5S_ALL_F, H5P_DEFAULT_F, buf_char, ier)
-      end block
-
-      call h5sclose_f(space_id, ier)
-      if(ier/=0) error stop "h5fortran:read:h5sclose " // dname // " in " // self%filename
-    else
-      call H5Tget_strpad_f(type_id, pad_type, ier)
-      if(ier/=0) error stop "h5fortran:read:h5tget_strpad " // dname // " in " // self%filename
-
-      call H5Tget_size_f(type_id, dsize, ier) !< only for non-variable
-      if(ier/=0) error stop "h5fortran:read:h5tget_size " // dname // " in " // self%filename
-
-      if(dsize > len(A)) then
-        write(stderr,'(a,i0,a3,i0,1x,a)') "h5fortran:read:string: buffer too small: ", dsize, " > ", len(A), &
-            dname // " in " // self%filename
-        error stop
-      endif
-
-      block
-      character(dsize) :: buf_char
-
-      call h5ltread_dataset_string_f(self%file_id, dname, buf_char, ier)
-      if(ier/=0) error stop "h5fortran:read:h5l5read_dataset_string " // dname // " in " // self%filename
-
-      i = index(buf_char, c_null_char) - 1
-      if (i == -1) i = len_trim(buf_char)
-
-      A = buf_char(:i)
-      end block
-    endif
-
-    call h5tclose_f(type_id, ier)
-    if(ier/=0) error stop "h5fortran:read:h5tclose " // dname // " in " // self%filename
-
-  class default
-    error stop "h5fortran:read: character disk dataset " // dname // " needs character memory variable"
-  end select
+  call read_scalar_char(A, dset_id, file_space_id, mem_space_id, dims)
 else
   error stop 'ERROR:h5fortran:reader: non-handled datatype--please reach out to developers.'
 end if
 if(ier/=0) error stop 'ERROR:h5fortran:reader: reading ' // dname // ' from ' // self%filename
 
-call h5dclose_f(dset_id, ier)
-if(ier /= 0) error stop "ERROR:h5fortran:reader: closing dataset: " // dname // " in " // self%filename
+call H5Dclose_f(dset_id, ier)
+if(ier /= 0) error stop "ERROR:h5fortran:read_scalar: closing dataset: " // dname // " in " // self%filename
 
-if(self%use_mpi) call h5pclose_f(xfer_id, ier)
+if(self%use_mpi) call H5Pclose_f(xfer_id, ier)
 if(ier /= 0) error stop "ERROR:h5fortran:writer closing property: " // dname // " in " // self%filename
 
+if(mem_space_id /= H5S_ALL_F) call H5Sclose_f(mem_space_id, ier)
+if(ier /= 0) error stop "ERROR:h5fortran:read_scalar closing memory dataspace: " // dname // " in " // self%filename
+
+if(file_space_id /= H5S_ALL_F) call H5Sclose_f(file_space_id, ier)
+if(ier /= 0) error stop "ERROR:h5fortran:read_scalar closing file dataspace: " // dname // " in " // self%filename
+
 end procedure h5read_scalar
 
 end submodule read_scalar

src/read_scalar_ascii.f90

@@ -0,0 +1,103 @@
+submodule (h5mpi:read_scalar) read_scalar_ascii
+
+use, intrinsic :: iso_c_binding, only : C_CHAR, C_F_POINTER
+use hdf5, only : H5T_STR_NULLTERM_F, &
+H5Dget_space_f, H5Dvlen_get_max_len_f, H5Dread_vl_f, H5Dvlen_reclaim_f, &
+H5Sget_simple_extent_dims_f, &
+H5Tis_variable_str_f
+
+implicit none (type, external)
+
+contains
+
+module procedure read_scalar_char
+
+integer(HID_T) :: type_id
+integer :: ier, i, pad_type, L
+integer(SIZE_T) :: dsize
+logical :: vstatus
+
+!> variable length string
+integer(HSIZE_T) :: dset_dims(1), maxdims(2)
+TYPE(C_PTR), DIMENSION(:), ALLOCATABLE, TARGET :: cbuf
+TYPE(C_PTR) :: f_ptr
+
+CHARACTER(10000, kind=c_char), POINTER :: cstr !< arbitrary maximum variable length string
+character(:), allocatable :: buf_char !< fixed length read
+character(1000) :: dset_name !< no specific maximum length for dataset name
+
+dset_name = id2name(dset_id)
+dset_dims = [1]
+
+select type(A)
+type is (character(*)) !< kind=c_char too
+  L = len(A)
+class default
+  error stop 'ERROR:h5fortran:read: character disk dataset ' // trim(dset_name) // ' needs character memory variable'
+end select
+
+call H5Dget_type_f(dset_id, type_id, ier)
+if(ier/=0) error stop "ERROR:h5fortran:read:H5Tget_type " // trim(dset_name)
+call H5Tis_variable_str_f(type_id, vstatus, ier)
+if(ier/=0) error stop "ERROR:h5fortran:read:H5Tis_variable_str " // trim(dset_name)
+
+if(vstatus) then
+  if(mem_space_id == H5S_ALL_F) call H5Dget_space_f(dset_id, mem_space_id, ier)
+  if(ier/=0) error stop "ERROR:h5fortran:read:vlen_char:H5Dget_space " // trim(dset_name)
+  !call H5Dvlen_get_max_len_f(dset_id, type_id, space_id, dsize, ier)
+  !if(ier/=0) error stop "h5fortran:read:H5Dvlen_get_max_len " // trim(dset_name)
+
+  call H5Sget_simple_extent_dims_f(mem_space_id, dset_dims, maxdims, ier)
+  if(ier/=0) error stop "h5fortran:read:vlen_char:H5Sget_simple_extent_dim " // trim(dset_name)
+
+  allocate(cbuf(1:dset_dims(1)))
+  f_ptr = C_LOC(cbuf(1))
+
+  call H5Dread_f(dset_id, type_id, f_ptr, ier)
+  if(ier/=0) error stop "h5fortran:read:vlen_char:H5Dread " // trim(dset_name)
+
+  call C_F_POINTER(cbuf(1), cstr)
+
+  i = index(cstr, c_null_char) - 1
+  if (i == -1) i = len_trim(cstr)
+  if(i > L) then
+    write(stderr,'(a,i0,a3,i0,1x,a)') "ERROR:h5fortran:read:vlen_char: buffer too small: ", i, " > ", L, trim(dset_name)
+    error stop
+  endif
+
+  select type(A)
+  type is (character(*)) !< kind=c_char too
+    A = cstr(:i)
+  end select
+else
+  call H5Tget_strpad_f(type_id, pad_type, ier)
+  if(ier/=0) error stop "ERROR:h5fortran:read:H5Tget_strpad " // trim(dset_name)
+
+  call H5Tget_size_f(type_id, dsize, ier) !< only for non-variable
+  if(ier/=0) error stop "ERROR:h5fortran:read:H5Tget_size " // trim(dset_name)
+
+  if(dsize > L) then
+    write(stderr,'(a,i0,a3,i0,1x,a)') "ERROR:h5fortran:read:string: buffer too small: ", dsize, " > ", L, trim(dset_name)
+    error stop
+  endif
+
+  allocate(character(dsize) :: buf_char)
+
+  call H5Dread_f(dset_id, type_id, buf_char, dims, ier, mem_space_id, file_space_id)
+  if(ier/=0) error stop "ERROR:h5fortran:read:H5Dread character " // trim(dset_name)
+
+  i = index(buf_char, c_null_char) - 1
+  if (i == -1) i = len_trim(buf_char)
+
+  select type(A)
+  type is (character(*)) !< kind=c_char too
+    A = buf_char(:i)
+  end select
+endif
+
+call H5Tclose_f(type_id, ier)
+if(ier/=0) error stop "ERROR:h5fortran:read:H5Tclose " // trim(dset_name)
+
+end procedure read_scalar_char
+
+end submodule read_scalar_ascii

src/write.f90

@@ -8,7 +8,7 @@
 H5P_DATASET_CREATE_F, &
 h5gopen_f, h5gcreate_f, h5gclose_f, &
 H5Lcreate_soft_f, h5lexists_f, &
-h5tcopy_f, h5tset_size_f, &
+h5tcopy_f, h5tclose_f, h5tset_size_f, &
 H5S_SCALAR_F, &
 H5D_COMPACT_F, &
 H5F_SCOPE_GLOBAL_F