unify: add %create(fill_value=)

Author: scivision

src/interface.f90

@@ -103,7 +103,7 @@ module h5mpi
 
 interface !< write.f90
 
-module subroutine hdf_create_user(self, dname, dtype, dset_dims, mem_dims, chunk_size, compact, charlen)
+module subroutine hdf_create_user(self, dname, dtype, dset_dims, mem_dims, chunk_size, compact, charlen, fill_value)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
 integer(HID_T), intent(in) :: dtype
@@ -112,11 +112,12 @@ module subroutine hdf_create_user(self, dname, dtype, dset_dims, mem_dims, chunk
 integer, intent(in), dimension(:), optional :: chunk_size  !< (:) instead of size(dims) due to intel fortran quirk
 logical, intent(in), optional :: compact
 integer, intent(in), optional :: charlen
+class(*), intent(in), optional :: fill_value
 end subroutine
 
 module subroutine hdf_create(self, dname, dtype, mem_dims, dset_dims, &
   filespace_id, memspace, dset_id, dtype_id, &
-  istart, iend, stride, chunk_size, compact, charlen)
+  istart, iend, stride, chunk_size, compact, charlen, fill_value)
 
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
@@ -127,6 +128,7 @@ module subroutine hdf_create(self, dname, dtype, mem_dims, dset_dims, &
 integer, intent(in), dimension(:), optional :: chunk_size, istart, iend, stride
 logical, intent(in), optional :: compact
 integer, intent(in), optional :: charlen !< length of character scalar
+class(*), intent(in), optional :: fill_value
 end subroutine
 
 module subroutine write_group(self, group_path)

src/write.f90

@@ -4,7 +4,8 @@
 h5fflush_f, &
 h5screate_f, h5sclose_f, h5screate_simple_f, &
 h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, &
-h5pset_chunk_f, h5pset_layout_f, h5pset_deflate_f, h5pset_shuffle_f, h5pset_fletcher32_f, h5pcreate_f, h5pclose_f, &
+h5pset_chunk_f, h5pset_layout_f, h5pset_deflate_f, h5pset_shuffle_f, h5pset_fletcher32_f, &
+h5pcreate_f, h5pclose_f, h5pset_fill_value_f, &
 H5P_DATASET_CREATE_F, &
 h5gopen_f, h5gcreate_f, h5gclose_f, &
 H5Lcreate_soft_f, h5lexists_f, &
@@ -38,7 +39,7 @@
 
 call hdf_create(self, dname, dtype, mem_dims=mdims, dset_dims=ddims, &
   filespace_id=file_space_id, memspace=mem_space_id, dset_id=dset_id, dtype_id=dtype_id, compact=compact, &
-  charlen=charlen)
+  charlen=charlen, fill_value=fill_value)
 
 call h5dclose_f(dset_id, ierr)
 if(ierr /= 0) error stop "ERROR:h5fortran:write:create_user: closing dataset: " // dname // " in " // self%filename
@@ -146,6 +147,29 @@
   type_id = dtype
 endif
 
+!> fill value
+if(present(fill_value)) then
+  if(dcpl == H5P_DEFAULT_F) then
+    call h5pcreate_f(H5P_DATASET_CREATE_F, dcpl, ierr)
+    if (ierr /= 0) error stop "ERROR:h5fortran:set_fill:h5pcreate: " // self%filename
+  endif
+
+  select type (fill_value)
+  !! type_id MUST equal the fill_value type or "transfer()" like bit pattern unexpected data will result
+  type is (real(real32))
+    call h5pset_fill_value_f(dcpl, H5T_NATIVE_REAL, fill_value, ierr)
+  type is (real(real64))
+    call h5pset_fill_value_f(dcpl, H5T_NATIVE_DOUBLE, fill_value, ierr)
+  type is (integer(int32))
+    call h5pset_fill_value_f(dcpl, H5T_NATIVE_INTEGER, fill_value, ierr)
+  !! int64 is NOT available for h5pset_fill_value_f
+  type is (character(*))
+    call h5pset_fill_value_f(dcpl, type_id, fill_value, ierr)
+  class default
+    error stop "ERROR:h5fortran:create: unknown fill value type"
+  end select
+endif
+
 !> create dataset
 call h5dcreate_f(self%file_id, dname, type_id=type_id, space_id=filespace_id, dset_id=dset_id, hdferr=ierr, dcpl_id=dcpl)
 if (ierr /= 0) error stop "ERROR:h5fortran:hdf_create:h5dcreate: " // dname // " in " // self%filename

test/CMakeLists.txt

@@ -50,7 +50,7 @@ target_link_libraries(test_write PRIVATE h5mpi::h5mpi)
 
 add_test(NAME write COMMAND test_write)
 
-set(test_names array attributes cast destructor exist groups layout shape
+set(test_names array attributes cast destructor exist fill groups layout shape
 string string_read
 )
 

test/test_fill.f90

@@ -0,0 +1,73 @@
+program fill
+
+use, intrinsic:: ieee_arithmetic, only : ieee_value, ieee_quiet_nan, ieee_is_finite
+
+use h5mpi, only : hdf5_file
+use hdf5, only : HSIZE_T, H5T_NATIVE_REAL, H5T_NATIVE_DOUBLE, H5T_NATIVE_INTEGER, H5T_NATIVE_CHARACTER
+use mpi, only : mpi_init, MPI_COMM_WORLD, mpi_comm_rank
+
+implicit none (type, external)
+
+external :: mpi_finalize
+
+type(hdf5_file) :: h5
+
+character(*), parameter :: fn = "test_fill.h5"
+
+real :: NaN, r(3)
+integer :: i(2), ierr, mpi_id
+character(10) :: c, fill_value
+
+call mpi_init(ierr)
+if (ierr /= 0) error stop "mpi_init"
+
+call mpi_comm_rank(MPI_COMM_WORLD, mpi_id, ierr)
+if (ierr /= 0) error stop "mpi_comm_rank"
+
+NaN = ieee_value(0., ieee_quiet_nan)
+
+call h5%open(fn, action="w", mpi=.true.)
+
+call h5%create("/r32", H5T_NATIVE_REAL, dset_dims=[3], fill_value=NaN)
+call h5%create("/r64", H5T_NATIVE_DOUBLE, dset_dims=[3], fill_value=NaN)
+call h5%create("/i32", H5T_NATIVE_INTEGER, dset_dims=[2], fill_value=-1)
+
+!> Note that character fill value must have same length as dataset, hence we use a character(10)
+fill_value = "NaN"
+call h5%create("/char", H5T_NATIVE_CHARACTER, dset_dims=[1], fill_value=fill_value, charlen=10)
+fill_value = ""
+call h5%create("/char_blank", H5T_NATIVE_CHARACTER, dset_dims=[1], fill_value=fill_value, charlen=10)
+fill_value = " "
+call h5%create("/char_space", H5T_NATIVE_CHARACTER, dset_dims=[1], fill_value=fill_value, charlen=10)
+
+call h5%close()
+
+
+call h5%open(fn, action="r", mpi=.true.)
+
+call h5%read("/r32", r)
+if(any(ieee_is_finite(r))) error stop "real32: expected all NaN"
+
+call h5%read("/r64", r)
+if(any(ieee_is_finite(r))) error stop "real64: expected all NaN"
+
+call h5%read("/i32", i)
+if(any(i /= -1)) error stop "int32: expected all -1"
+
+call h5%read("/char", c)
+if(c /= "NaN") error stop "char: expected 'NaN', got: " // c
+
+call h5%read("/char_blank", c)
+if(c /= "") error stop "char: expected '', got: " // c
+
+call h5%read("/char_space", c)
+if(c /= " ") error stop "char: expected ' ', got: " // c
+
+call h5%close()
+
+if(mpi_id == 0) print *, "OK: fill value"
+
+call mpi_finalize(ierr)
+if (ierr /= 0) error stop "mpi_finalize"
+
+end program