datatype option for write

this would avoid implied temporary array casts in user code, if it works

test:lt: more robust

% write(): add datatype= optional parameter

test:cast: check other arrays, print class

test: print cast details

Author: scivision

.github/workflows/oneapi-linux.yml

@@ -24,6 +24,12 @@ on:
       - "!memcheck.cmake"
       - "!coverage.cmake"
       - "!example/*"
+  workflow_dispatch:
+
+# avoid wasted runs
+concurrency:
+  group: ${{ github.workflow }}-${{ github.ref }}
+  cancel-in-progress: true
 
 
 jobs:
@@ -35,7 +41,7 @@ jobs:
     steps:
     - uses: actions/checkout@v4
 
-    - uses: actions/setup-python@v4
+    - uses: actions/setup-python@v5
       with:
         python-version: '3.12'
 

API.md

@@ -63,7 +63,7 @@ type(hdf5_file) :: h1, h2, h3
 ```
 
 ```fortran
-call h%open(filename, action, comp_lvl)
+call h % open(filename, action, comp_lvl)
 !! Opens hdf5 file
 
 character(*), intent(in) :: filename
@@ -215,15 +215,41 @@ character(*), intent(in) :: target, &  !< target path to link dataset
 ## file write operations
 
 ```fortran
-call h%write(dname, A, chunk_size, istart, iend, stride, compact)
+call h % write(dname, A, chunk_size, istart, iend, stride, compact, datatype)
 !! write 0d..7d dataset
 character(*), intent(in) :: dname
 class(*), intent(in) :: A(:)  !< array to write
 integer, intent(in), optional :: chunk_size(rank(A))
 integer, intent(in), optional, dimension(:) :: istart, iend, stride  !< array slicing
 logical, intent(in), optional :: compact  !< faster I/O for sub-64 kB datasets
+integer, intent(in), optional :: datatype  !< HDF5 datatype
 ```
 
+The "datatype" parameter is optional and defaults to the native type of the input array A.
+Rather than implicitly cast with array temporaries in end-user code, which can be slow and trigger memory issues or compiler bugs (like GCC 9.5.0), instead use the "datatype" parameter to specify the HDF5 datatype explicitly.
+For example, if the data in memory is real64, but it's desired to write real32 to disk to save disk space, do like:
+
+```fortran
+real(real64) :: darr(3,4,5)
+type(h5fortran) :: h
+
+call h % open("myfile.h5", action="w")
+
+call h % write("/my_3d_data", darr, datatype=H5T_NATIVE_REAL)
+```
+
+The HDF5
+[Fortran datatypes](https://support.hdfgroup.org/documentation/hdf5/latest/group___f_h5_t.html)
+include the following, assuming typical default Fortran compiler settings where "real" is 32-bit and "double" is 64-bit and so on:
+
+* H5T_NATIVE_REAL: float 32-bit
+* H5T_NATIVE_DOUBLE: float 64-bit
+* H5T_NATIVE_INTEGER: integer 32-bit
+* H5T_STD_I64LE: integer 64-bit
+
+---
+
+
 Write dataset attribute (e.g. units or instrument)
 
 ```fortran

CMakeLists.txt

@@ -1,4 +1,4 @@
-cmake_minimum_required(VERSION 3.20...3.30)
+cmake_minimum_required(VERSION 3.20...4.0)
 
 if(CMAKE_SOURCE_DIR STREQUAL CMAKE_BINARY_DIR)
   message(FATAL_ERROR "Please do out of source build like
@@ -7,7 +7,7 @@ endif()
 
 project(h5fortran
 LANGUAGES C Fortran
-VERSION 4.10.6
+VERSION 4.11.0
 )
 
 include(CTest)

fpm.toml

@@ -1,7 +1,7 @@
 name = "h5fortran"
 description = "Lightweight object-oriented HDF5 interface"
 categories = "io"
-version = "4.10.1"
+version = "4.11.0"
 
 [build]
 auto-tests = false

src/interface.f90

@@ -257,67 +257,75 @@ module subroutine lt7read(filename, dname, A)
 
 interface !< writer.f90
 
-module subroutine h5write_scalar(self, dname, A, compact)
+module subroutine h5write_scalar(self, dname, A, compact, datatype)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
 class(*), intent(in) :: A
 logical, intent(in), optional :: compact
+integer(HID_T), intent(in), optional :: datatype
 end subroutine
 
-module subroutine h5write_1d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims)
+module subroutine h5write_1d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims, datatype)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
 class(*), intent(in), dimension(:) :: A
 integer, intent(in), dimension(1), optional :: chunk_size, istart, iend, stride, dset_dims
 logical, intent(in), optional :: compact
+integer(HID_T), intent(in), optional :: datatype
 end subroutine
 
-module subroutine h5write_2d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims)
+module subroutine h5write_2d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims, datatype)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
 class(*), intent(in), dimension(:,:) :: A
 integer, intent(in), dimension(2), optional :: chunk_size, istart, iend, stride, dset_dims
 logical, intent(in), optional :: compact
+integer(HID_T), intent(in), optional :: datatype
 end subroutine
 
-module subroutine h5write_3d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims)
+module subroutine h5write_3d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims, datatype)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
 class(*), intent(in), dimension(:,:,:) :: A
 integer, intent(in), dimension(3), optional :: chunk_size, istart, iend, stride, dset_dims
 logical, intent(in), optional :: compact
+integer(HID_T), intent(in), optional :: datatype
 end subroutine
 
-module subroutine h5write_4d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims)
+module subroutine h5write_4d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims, datatype)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
 class(*), intent(in), dimension(:,:,:,:) :: A
 integer, intent(in), dimension(4), optional :: chunk_size, istart, iend, stride, dset_dims
 logical, intent(in), optional :: compact
+integer(HID_T), intent(in), optional :: datatype
 end subroutine
 
-module subroutine h5write_5d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims)
+module subroutine h5write_5d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims, datatype)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
 class(*), intent(in), dimension(:,:,:,:,:) :: A
 integer, intent(in), dimension(5), optional :: chunk_size, istart, iend, stride, dset_dims
 logical, intent(in), optional :: compact
+integer(HID_T), intent(in), optional :: datatype
 end subroutine
 
-module subroutine h5write_6d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims)
+module subroutine h5write_6d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims, datatype)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
 class(*), intent(in), dimension(:,:,:,:,:,:) :: A
 integer, intent(in), dimension(6), optional :: chunk_size, istart, iend, stride, dset_dims
 logical, intent(in), optional :: compact
+integer(HID_T), intent(in), optional :: datatype
 end subroutine
 
-module subroutine h5write_7d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims)
+module subroutine h5write_7d(self, dname, A, chunk_size, istart, iend, stride, compact, dset_dims, datatype)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
 class(*), intent(in), dimension(:,:,:,:,:,:,:) :: A
 integer, intent(in), dimension(7), optional :: chunk_size, istart, iend, stride, dset_dims
 logical, intent(in), optional :: compact
+integer(HID_T), intent(in), optional :: datatype
 end subroutine
 
 end interface

src/utils.f90

@@ -4,7 +4,7 @@
 h5eset_auto_f, &
 h5iis_valid_f, h5iget_name_f, H5Iget_type_f, &
 h5open_f, h5close_f, &
-h5fopen_f, h5fcreate_f, h5fclose_f, h5fis_hdf5_f, h5fget_filesize_f, &
+H5Fopen_f, h5fcreate_f, h5fclose_f, h5fis_hdf5_f, h5fget_filesize_f, &
 h5fget_obj_count_f, h5fget_obj_ids_f, h5fget_name_f, &
 h5sselect_hyperslab_f, h5screate_simple_f, &
 H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, H5Sget_simple_extent_npoints_f, &

src/write_scalar.f90

@@ -10,43 +10,51 @@
 module procedure h5write_scalar
 
 integer(HSIZE_T) :: dset_dims(0), mem_dims(0)
-integer(HID_T) :: file_space_id, dset_id, dtype_id, xfer_id, dtype
+integer(HID_T) :: file_space_id, dset_id, dtype_id, xfer_id, dtypew
 integer :: ier, charlen
 
 charlen = 0
 
+if (present(datatype)) then
+  dtypew = datatype
+else
+  select type (A)
+  type is (real(real32))
+    dtypew = H5T_NATIVE_REAL
+  type is (real(real64))
+    dtypew = H5T_NATIVE_DOUBLE
+  type is (integer(int32))
+    dtypew = H5T_NATIVE_INTEGER
+  type is (integer(int64))
+    dtypew = H5T_STD_I64LE
+  type is (character(*))
+    dtypew = H5T_NATIVE_CHARACTER
+  class default
+    error stop "ERROR:h5fortran:write: unknown variable type for " // dname
+  end select
+endif
+
 select type (A)
-type is (real(real32))
-  dtype = H5T_NATIVE_REAL
-type is (real(real64))
-  dtype = H5T_NATIVE_DOUBLE
-type is (integer(int32))
-  dtype = H5T_NATIVE_INTEGER
-type is (integer(int64))
-  dtype = H5T_STD_I64LE
-type is (character(*))
-  dtype = H5T_NATIVE_CHARACTER
-  charlen = len_trim(A)  !< workaround for GCC 8.3.0 bug
-  if(charlen == 0) charlen = 1 !< empty string is OK but charlen is strictly positive.
-class default
-  error stop "ERROR:h5fortran:write: unknown variable type for " // dname
+  type is (character(*))
+    charlen = len_trim(A)  !< workaround for GCC 8.3.0 bug
+    if(charlen == 0) charlen = 1 !< empty string is OK but charlen is strictly positive.
 end select
 
-call hdf_create(self, dname, dtype, mem_dims=mem_dims, dset_dims=dset_dims, &
+call hdf_create(self, dname, dtypew, mem_dims=mem_dims, dset_dims=dset_dims, &
   filespace_id=file_space_id, dset_id=dset_id, compact=compact, dtype_id=dtype_id, &
   charlen=charlen)
 
 xfer_id = H5P_DEFAULT_F
 
 select type (A)
 type is (real(real32))
-  call H5Dwrite_f(dset_id, dtype, A, dset_dims, ier, file_space_id=file_space_id, xfer_prp=xfer_id)
+  call H5Dwrite_f(dset_id, dtypew, A, dset_dims, ier, file_space_id=file_space_id, xfer_prp=xfer_id)
 type is (real(real64))
-  call H5Dwrite_f(dset_id, dtype, A, dset_dims, ier, file_space_id=file_space_id, xfer_prp=xfer_id)
+  call H5Dwrite_f(dset_id, dtypew, A, dset_dims, ier, file_space_id=file_space_id, xfer_prp=xfer_id)
 type is (integer(int32))
-  call H5Dwrite_f(dset_id, dtype, A, dset_dims, ier, file_space_id=file_space_id, xfer_prp=xfer_id)
+  call H5Dwrite_f(dset_id, dtypew, A, dset_dims, ier, file_space_id=file_space_id, xfer_prp=xfer_id)
 type is (integer(int64))
-  call H5Dwrite_f(dset_id, dtype, A, dset_dims, ier, file_space_id=file_space_id, xfer_prp=xfer_id)
+  call H5Dwrite_f(dset_id, dtypew, A, dset_dims, ier, file_space_id=file_space_id, xfer_prp=xfer_id)
 type is (character(*))
   call H5Dwrite_f(dset_id, dtype_id, trim(A), dset_dims, ier, file_space_id=file_space_id, xfer_prp=xfer_id)
 class default

src/writer.f90

@@ -1,6 +1,6 @@
 submodule (h5fortran:write) writer
 
-use hdf5, only: h5dwrite_f
+use hdf5, only: H5Dwrite_f
 
 implicit none
 

src/writer.inc

@@ -1,4 +1,4 @@
-integer(HID_T) :: file_space_id, mem_space_id, dset_id, xfer_id, dtype, dtype_id
+integer(HID_T) :: file_space_id, mem_space_id, dset_id, xfer_id, dtypew, dtype_id
 integer(HSIZE_T), dimension(rank(A)) :: mem_dims, dims_dset
 integer :: ier, charlen
 
@@ -12,24 +12,32 @@ endif
 
 charlen = 0
 
+if (present(datatype)) then
+  dtypew = datatype
+else
+  select type (A)
+  type is (real(real32))
+    dtypew = H5T_NATIVE_REAL
+  type is (real(real64))
+    dtypew = H5T_NATIVE_DOUBLE
+  type is (integer(int32))
+    dtypew = H5T_NATIVE_INTEGER
+  type is (integer(int64))
+    dtypew = H5T_STD_I64LE
+  type is (character(*))
+    dtypew = H5T_NATIVE_CHARACTER
+  class default
+    error stop "ERROR:h5fortran:writer:unknown variable type for " // dname
+  end select
+endif
+
 select type (A)
-type is (real(real32))
-  dtype = H5T_NATIVE_REAL
-type is (real(real64))
-  dtype = H5T_NATIVE_DOUBLE
-type is (integer(int32))
-  dtype = H5T_NATIVE_INTEGER
-type is (integer(int64))
-  dtype = H5T_STD_I64LE
-type is (character(*))
-  dtype = H5T_NATIVE_CHARACTER
-  charlen = len(A)  !< workaround for GCC 8.3.0 bug
-  if(charlen == 0) charlen = 1 !< empty string is OK but charlen is strictly positive.
-class default
-  error stop "ERROR:h5fortran:writer:unknown variable type for " // dname
+  type is (character(*))
+    charlen = len(A)  !< workaround for GCC 8.3.0 bug
+    if(charlen == 0) charlen = 1 !< empty string is OK but charlen is strictly positive.
 end select
 
-call hdf_create(self, dname, dtype, mem_dims, dims_dset, file_space_id, dset_id, &
+call hdf_create(self, dname, dtypew, mem_dims, dims_dset, file_space_id, dset_id, &
   chunk_size=chunk_size, istart=istart, iend=iend, stride=stride, compact=compact, &
   dtype_id=dtype_id, charlen=charlen)
 
@@ -44,13 +52,13 @@ xfer_id = H5P_DEFAULT_F
 
 select type (A)
 type is (real(real32))
-  call h5dwrite_f(dset_id, dtype, A, dims_dset, ier, file_space_id=file_space_id, mem_space_id=mem_space_id, xfer_prp=xfer_id)
+  call h5dwrite_f(dset_id, dtypew, A, dims_dset, ier, file_space_id=file_space_id, mem_space_id=mem_space_id, xfer_prp=xfer_id)
 type is (real(real64))
-  call h5dwrite_f(dset_id, dtype, A, dims_dset, ier, file_space_id=file_space_id, mem_space_id=mem_space_id, xfer_prp=xfer_id)
+  call h5dwrite_f(dset_id, dtypew, A, dims_dset, ier, file_space_id=file_space_id, mem_space_id=mem_space_id, xfer_prp=xfer_id)
 type is (integer(int32))
-  call h5dwrite_f(dset_id, dtype, A, dims_dset, ier, file_space_id=file_space_id, mem_space_id=mem_space_id, xfer_prp=xfer_id)
+  call h5dwrite_f(dset_id, dtypew, A, dims_dset, ier, file_space_id=file_space_id, mem_space_id=mem_space_id, xfer_prp=xfer_id)
 type is (integer(int64))
-  call h5dwrite_f(dset_id, dtype, A, dims_dset, ier, file_space_id=file_space_id, mem_space_id=mem_space_id, xfer_prp=xfer_id)
+  call h5dwrite_f(dset_id, dtypew, A, dims_dset, ier, file_space_id=file_space_id, mem_space_id=mem_space_id, xfer_prp=xfer_id)
 type is (character(*))
   call h5dwrite_f(dset_id, dtype_id, A, dims_dset, ier, file_space_id=file_space_id, mem_space_id=mem_space_id, xfer_prp=xfer_id)
 class default

test/test_cast.f90

@@ -24,7 +24,6 @@ subroutine test_cast_write(fn)
 character(*), intent(in) :: fn
 
 type(hdf5_file) :: h
-
 real(real64) :: darr(2) = 12._real64
 
 call h%open(fn, action='w')
@@ -37,8 +36,8 @@ subroutine test_cast_write(fn)
 call h%write('/1d_real32', [1._real32, 32._real32])
 call h%write('/1d_int32', [2_int32, 4_int32])
 call h%write('/char', "hello")
-call h%write('/cast/r64tor32', real(darr, real32))
-call h%write('/cast/i64toi32', int(42_int64, int32))
+call h%write('/cast/r64tor32', darr, datatype=H5T_NATIVE_REAL)
+call h%write('/cast/i64toi32', 42_int64, datatype=H5T_NATIVE_INTEGER)
 
 call h%close()
 
@@ -68,8 +67,6 @@ subroutine test_cast_read(fn)
 print '(a, i0)', 'H5T_NATIVE_INTEGER = ', H5T_NATIVE_INTEGER
 print '(a, i0)', 'H5T_NATIVE_CHARACTER = ', H5T_NATIVE_CHARACTER
 print '(a, i0)', 'H5T_STD_I64LE = ', H5T_STD_I64LE
-
-
 if (h%class("/scalar_int32") /= H5T_INTEGER_F) error stop "int32 not integer"
 if (h%class("/scalar_int64") /= H5T_INTEGER_F) error stop "int64 not integer"
 if (h%class("/1d_real32") /= H5T_FLOAT_F) error stop "1d_real32 not float"
@@ -84,7 +81,6 @@ subroutine test_cast_read(fn)
   write(stderr,*) "expected cast r64tor32 ", H5T_FLOAT_F, " but got ", h%class('/cast/r64tor32')
   error stop "cast not float"
 endif
-
 print *, "OK: class method"
 
 !> %dtype method