add rewrite char

ref: add char write

Author: scivision

benchmark/CMakeLists.txt

@@ -4,13 +4,18 @@ project(h5mpi-benchmark
 LANGUAGES C Fortran
 )
 
-cmake_path(SET CMAKE_MODULE_PATH ${CMAKE_CURRENT_LIST_DIR}/Modules)
+cmake_path(SET CMAKE_MODULE_PATH ${CMAKE_CURRENT_LIST_DIR}/../cmake/Modules)
+
+find_package(MPI COMPONENTS Fortran REQUIRED)
+find_package(HDF5 COMPONENTS parallel Fortran REQUIRED)
 
 # --- auto-ignore build directory
 if(NOT EXISTS ${PROJECT_BINARY_DIR}/.gitignore)
   file(WRITE ${PROJECT_BINARY_DIR}/.gitignore "*")
 endif()
 
+add_subdirectory(test)
+
 set(runner_os \"${CMAKE_SYSTEM_NAME} ${CMAKE_SYSTEM_PROCESSOR}\")
 configure_file(perf.in.f90 perf.f90 @ONLY)
 add_library(perf OBJECT

reference/CMakeLists.txt

@@ -4,13 +4,29 @@ project(ref
 LANGUAGES C Fortran
 )
 
-cmake_path(SET CMAKE_MODULE_PATH ${CMAKE_CURRENT_LIST_DIR}/Modules)
+enable_testing()
+
+cmake_path(SET CMAKE_MODULE_PATH ${CMAKE_CURRENT_LIST_DIR}/../cmake/Modules)
+
+find_package(MPI COMPONENTS Fortran REQUIRED)
+find_package(HDF5 COMPONENTS parallel Fortran REQUIRED)
 
 # --- auto-ignore build directory
 if(NOT EXISTS ${PROJECT_BINARY_DIR}/.gitignore)
   file(WRITE ${PROJECT_BINARY_DIR}/.gitignore "*")
 endif()
 
+add_executable(write_char write_char.f90)
+target_link_libraries(write_char PRIVATE HDF5::HDF5 MPI::MPI_Fortran)
+add_test(NAME WriteChar
+COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 2 $<TARGET_FILE:write_char>
+WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}
+)
+
 # old standalone example, not useful for production.
-add_executable(simple simple.f90)
-target_link_libraries(simple PRIVATE HDF5::HDF5 MPI::MPI_Fortran)
+add_executable(write_coll write_collective.f90)
+target_link_libraries(write_coll PRIVATE HDF5::HDF5 MPI::MPI_Fortran)
+add_test(NAME WriteCollective
+COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 2 $<TARGET_FILE:write_coll>
+WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}
+)

reference/write_char.f90

@@ -0,0 +1,165 @@
+module proto
+
+use mpi, only : MPI_INFO_NULL, MPI_COMM_WORLD
+use hdf5
+
+implicit none (type, external)
+
+private
+public :: create_file, create_dataset, write_dataset
+
+contains
+
+subroutine create_file(fn, file_id)
+
+character(*), intent(in) :: fn
+integer(HID_T), intent(out) :: file_id
+
+integer(HID_T) ::  fapl
+integer :: ierr
+
+! collective: setup for MPI access
+call h5pcreate_f(H5P_FILE_ACCESS_F, fapl, ierr)
+call h5pset_fapl_mpio_f(fapl, MPI_COMM_WORLD, MPI_INFO_NULL, ierr)
+
+! collective: create file
+call h5fcreate_f(fn, H5F_ACC_TRUNC_F, file_id, ierr, access_prp = fapl)
+if(ierr/=0) error stop "h5fcreate"
+call h5pclose_f(fapl, ierr)
+if(ierr/=0) error stop "h5pclose"
+
+end subroutine create_file
+
+
+subroutine create_dataset(dset_name, file_id, dtype, dset_id, filespace, type_id, charlen)
+
+character(*), intent(in) :: dset_name
+integer(HID_T), intent(in) :: file_id, dtype
+integer(HID_T), intent(out) :: dset_id, filespace
+integer(HID_T), optional, intent(out) :: type_id
+integer, optional, intent(in) :: charlen
+
+integer :: ierr
+integer(HID_T) :: dcpl
+
+dcpl = H5P_DEFAULT_F
+
+call h5screate_f(H5S_SCALAR_F, filespace, ierr)
+if(ierr/=0) error stop "h5screate"
+
+if(dtype == H5T_NATIVE_CHARACTER) then
+  if(.not.present(charlen)) error stop "character needs charlen"
+  if(.not.present(type_id)) error stop "character needs type_id"
+  ! define character
+  CALL h5tcopy_f(H5T_NATIVE_CHARACTER, type_id, ierr)
+  if(ierr/=0) error stop "h5tcopy"
+  CALL h5tset_size_f(type_id, int(charlen, SIZE_T), ierr)
+  if(ierr/=0) error stop "h5tset_size"
+else
+  type_id = dtype
+endif
+
+! collective: create dataset
+call h5dcreate_f(file_id, dset_name, type_id, filespace, dset_id, ierr, dcpl_id=dcpl)
+if(ierr/=0) error stop "h5dcreate"
+
+call h5pclose_f(dcpl, ierr)
+if (ierr /= 0) error stop "h5pclose"
+
+end subroutine create_dataset
+
+
+subroutine write_dataset(dset_id, type_id, data, dset_dims)
+
+integer(HID_T), intent(in) :: dset_id, type_id
+class(*), intent(in) :: data
+integer(HSIZE_T), intent(in) :: dset_dims(:)
+
+integer(HID_T) :: dxpl
+integer :: ierr
+
+  ! Create property list for collective dataset write
+call h5pcreate_f(H5P_DATASET_XFER_F, dxpl, ierr)
+if (ierr/=0) error stop "h5pcreate"
+call h5pset_dxpl_mpio_f(dxpl, H5FD_MPIO_COLLECTIVE_F, ierr)
+if (ierr/=0) error stop "h5pset_dxpl"
+
+! For independent write use
+! call h5pset_dxpl_mpio_f(dcpl, H5FD_MPIO_INDEPENDENT_F, ierr)
+
+! collective: Write dataset
+select type(data)
+type is (character(*))
+  call h5dwrite_f(dset_id, type_id, data, dset_dims, ierr, xfer_prp = dxpl)
+class default
+  error stop "write_dataset: unhandled type"
+end select
+if (ierr/=0) error stop "h5dwrite"
+
+
+call h5tclose_f(type_id, ierr)
+if(ierr/=0) error stop "h5tclose"
+call h5pclose_f(dxpl, ierr)
+if (ierr/=0) error stop "h5pclose"
+call h5dclose_f(dset_id, ierr)
+if (ierr/=0) error stop "h5dclose"
+
+end subroutine write_dataset
+
+end module proto
+
+
+program simple
+!! this example has undesirable effect that all workers must have copy of data.
+!! we "broadcast" our simulated data here implicitly
+!! a more optimal case is to use hyperslabs with each worker
+
+use mpi, only : mpi_init
+use hdf5
+use proto
+
+implicit none (type, external)
+
+external :: mpi_finalize
+
+character(:), allocatable :: fn
+
+integer(HID_T) :: file_id, dset_id, filespace, dcpl, type_id
+
+character(:), allocatable :: c1, c2
+
+integer(HSIZE_T) :: dset_dims(0)
+
+integer :: ierr, i, j, k
+
+call mpi_init(ierr)
+
+fn = "char.h5"
+c1 = "42"
+c2 = "this is a Little string!"
+
+call h5open_f(ierr)
+if(ierr/=0) error stop "h5open"
+
+call create_file(fn, file_id)
+
+call create_dataset("/c1", file_id, H5T_NATIVE_CHARACTER, dset_id, filespace, type_id, len(c1))
+call write_dataset(dset_id, type_id, c1, dset_dims)
+
+call create_dataset("/c2", file_id, H5T_NATIVE_CHARACTER, dset_id, filespace, type_id, len(c2))
+call write_dataset(dset_id, type_id, c2, dset_dims)
+
+! wind down
+call h5sclose_f(filespace, ierr)
+if (ierr/=0) error stop "h5sclose"
+call h5fclose_f(file_id, ierr)
+if (ierr/=0) error stop "h5fclose"
+call h5close_f(ierr)
+if (ierr/=0) error stop "h5close"
+
+call mpi_finalize(ierr)
+if (ierr/=0) error stop "mpi_finalize"
+
+print *,"OK: write collective"
+
+end program

reference/simple.f90 renamed to reference/write_collective.f90

@@ -80,5 +80,8 @@ program simple
 call h5close_f(ierr)
 
 call mpi_finalize(ierr)
+if (ierr/=0) error stop "mpi_finalize"
+
+print *,"OK: write collective"
 
 end program

src/interface.f90

@@ -413,21 +413,26 @@ subroutine ph5open(self, filename, action, mpi, comp_lvl, shuffle, fletcher32, d
 integer :: ierr
 integer(HID_T) :: fapl !< file access property list
 
+if(self%is_open()) then
+  write(stderr,*) 'h5fortran:open: file handle already open: '//self%filename
+  return
+endif
+
 laction = "rw"
 if (present(action)) laction = action
 
 self%use_mpi = mpi
 
 if(self%use_mpi) then
-  call mpi_comm_rank(MPI_COMM_WORLD, self%mpi_id, ierr)
+  call mpi_comm_rank(mpi_h5comm, self%mpi_id, ierr)
   if(ierr /= 0) error stop "ERROR:h5fortran:open: could not get MPI ID"
 endif
 
 if(present(debug)) self%debug = debug
 
 call get_hdf5_config(self%parallel_compression)
 if(self%use_mpi .and. .not. self%parallel_compression .and. self%comp_lvl > 0) then
-  write(stderr, '(a)') "h5fortran:open: parallel compression is NOT available"
+  write(stderr, '(a)') "WARNING:h5fortran:open: parallel compression is NOT available"
   !! don't set to 0 because non-MPI writes can compress.
   !! We warn again and disable compression for each attempted MPI compress write.
 endif
@@ -443,34 +448,34 @@ subroutine ph5open(self, filename, action, mpi, comp_lvl, shuffle, fletcher32, d
 if(present(fletcher32)) self%fletcher32 = fletcher32
 
 if(self%comp_lvl < 0) then
-  write(stderr, '(a)') "h5fortran:open: compression level must be >= 0, setting comp_lvl = 0"
+  write(stderr, '(a)') "ERROR:h5fortran:open: compression level must be >= 0, setting comp_lvl = 0"
   self%comp_lvl = 0
 elseif(self%comp_lvl > 9) then
-  write(stderr, '(a)') "h5fortran:open: compression level must be <= 9, setting comp_lvl = 9"
+  write(stderr, '(a)') "ERROR:h5fortran:open: compression level must be <= 9, setting comp_lvl = 9"
   self%comp_lvl = 9
 endif
 
 call h5open_f(ierr)
-if(ierr/=0) error stop "h5open: could not open HDF5 library"
+if(ierr/=0) error stop "ERROR:h5fortran:h5open: could not open HDF5 library"
 !! OK to call repeatedly
 !! https://support.hdfgroup.org/HDF5/doc/RM/RM_H5.html#Library-Open
 
 if(self%use_mpi) then
   !! collective: setup for MPI access
   call h5pcreate_f(H5P_FILE_ACCESS_F, fapl, ierr)
-  if(ierr/=0) error stop "h5open:h5pcreate could not collective open property"
+  if(ierr/=0) error stop "ERROR:h5fortran:open:h5pcreate could not collective open property for " // filename
   call h5pset_fapl_mpio_f(fapl, mpi_h5comm, mpi_h5info, ierr)
-  if(ierr/=0) error stop "h5open:h5pset_fapl_mpio could not collective open file"
+  if(ierr/=0) error stop "ERROR:h5fortran:open:h5pset_fapl_mpio could not collective open file for " // filename
 else
   fapl = H5P_DEFAULT_F
 endif
 
 select case(laction)
 case('r')
-  if(.not. is_hdf5(filename)) error stop "h5fortran:open: file does not exist: "//filename
+  if(.not. is_hdf5(filename)) error stop "ERROR:h5fortran:open: file does not exist: "//filename
   call h5fopen_f(filename, H5F_ACC_RDONLY_F, self%file_id, ierr, access_prp=fapl)
 case('r+')
-  if(.not. is_hdf5(filename)) error stop "h5fortran:open: file does not exist: "//filename
+  if(.not. is_hdf5(filename)) error stop "ERROR:h5fortran:open: file does not exist: "//filename
   call h5fopen_f(filename, H5F_ACC_RDWR_F, self%file_id, ierr, access_prp=fapl)
 case('rw', 'a')
   if(is_hdf5(filename)) then
@@ -481,14 +486,14 @@ subroutine ph5open(self, filename, action, mpi, comp_lvl, shuffle, fletcher32, d
 case ('w')
   call h5fcreate_f(filename, H5F_ACC_TRUNC_F, self%file_id, ierr, access_prp=fapl)
 case default
-  error stop 'h5fortran:open Unsupported action= ' // laction
+  error stop 'ERROR:h5fortran:open Unsupported action ' // laction // ' for ' // filename
 end select
 
-if(ierr/=0) error stop "h5open/create: could not initialize HDF5 file: " // filename // " action: " // laction
+if(ierr/=0) error stop "ERROR:h5open/create: could not initialize HDF5 file: " // filename // " action: " // laction
 
 if(fapl /= H5P_DEFAULT_F) then
   call h5pclose_f(fapl, ierr)
-  if(ierr/=0) error stop "h5mpi:open:h5pclose: " // filename
+  if(ierr/=0) error stop "ERROR:h5fortran:open:h5pclose: " // filename
 endif
 
 self%filename = filename
@@ -582,7 +587,7 @@ logical function is_open(self)
 integer :: ierr
 
 call h5iis_valid_f(self%file_id, is_open, ierr)
-if(ierr /= 0) error stop "h5fortran:is_open:h5iis_valid: " // self%filename
+if(ierr /= 0) error stop "ERROR:h5fortran:is_open:h5iis_valid: " // self%filename
 
 ! call h5iget_type_f(self%file_id, hid_type, ierr)
 ! if(ierr /= 0 .or. hid_type /= H5I_FILE_F) is_open = .false.