diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000..37c2b957 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +build/ +.envrc +*.h5 diff --git a/API.md b/API.md index 6181f98c..1bf4b871 100644 --- a/API.md +++ b/API.md @@ -322,6 +322,32 @@ class(*), intent(out) :: attrval(:) !< character, real, integer call h%delete_attr(dname, attr) ``` +## Iterate over all datasets in a group + +```fortran +call h%iterate(group, callback) + +character(*), intent(in) :: group +subroutine callback(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + character(len=*), intent(in) :: object_name + character(len=*), intent(in) :: object_type +end subroutine +``` + +## Visit recursively all datasets starting from a group + +```fortran +call h%visit(group, callback) + +character(*), intent(in) :: group +subroutine callback(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + character(len=*), intent(in) :: object_name + character(len=*), intent(in) :: object_type +end subroutine +``` + ## high level operations These are single-call operations that are slower than the object-oriented methods above. diff --git a/CMakeLists.txt b/CMakeLists.txt index d2ca2087..19941270 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -51,6 +51,7 @@ endif() # --- h5fortran library add_library(h5fortran) + target_include_directories(h5fortran PUBLIC $ $ diff --git a/flake.lock b/flake.lock new file mode 100644 index 00000000..032fb8b8 --- /dev/null +++ b/flake.lock @@ -0,0 +1,61 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1751274312, + "narHash": "sha256-/bVBlRpECLVzjV19t5KMdMFWSwKLtb5RyXdjz3LJT+g=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "50ab793786d9de88ee30ec4e4c24fb4236fc2674", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-24.11", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 00000000..bfccda1f --- /dev/null +++ b/flake.nix @@ -0,0 +1,243 @@ +{ + description = "h5fortran development shells"; + + inputs = { + nixpkgs.url = "github:NixOS/nixpkgs/nixos-24.11"; + flake-utils.url = "github:numtide/flake-utils"; + }; + + outputs = + { + self, + nixpkgs, + flake-utils, + }: + flake-utils.lib.eachDefaultSystem ( + system: + let + pkgs = import nixpkgs { + inherit system; + config = { + allowUnfree = true; + }; + }; + + common-build-tools = with pkgs; [ + cmake + ninja + pkg-config + git + ]; + + mkGccShell = + { + name, + gcc-pkg, + gfortran-pkg, + packages ? [ ], + shellHookExtra ? "", + }: + pkgs.mkShell { + inherit name; + packages = + common-build-tools + ++ [ + gcc-pkg + gfortran-pkg + pkgs.hdf5 + pkgs.zlib + pkgs.python3 + ] + ++ packages; + + shellHook = '' + export CC=${gcc-pkg}/bin/gcc + export FC=${gfortran-pkg}/bin/gfortran + export CXX=${gcc-pkg}/bin/g++ + echo "h5fortran: ${name}" + echo "CC: $CC FC: $FC CXX: $CXX" + echo "HDF5: ${pkgs.hdf5.dev}" + ${shellHookExtra} + ''; + + HDF5_DIR = "${pkgs.hdf5.dev}"; + }; + in + { + devShells.default = mkGccShell { + name = "h5fortran-gcc-default"; + gcc-pkg = pkgs.gcc14; + gfortran-pkg = pkgs.gfortran14; + shellHookExtra = ''echo "Build: cmake -Bbuild -G Ninja --workflow --preset default"''; + }; + + devShells.gcc-old = mkGccShell { + name = "h5fortran-gcc-11"; + gcc-pkg = pkgs.gcc11; + gfortran-pkg = pkgs.gfortran11; + shellHookExtra = ''echo "Build: cmake -Bbuild -G Ninja --workflow --preset default"''; + }; + + devShells.gcc-new = mkGccShell { + name = "h5fortran-gcc-14"; + gcc-pkg = pkgs.gcc14; + gfortran-pkg = pkgs.gfortran14; + shellHookExtra = ''echo "Build: cmake -Bbuild -G Ninja --workflow --preset default"''; + }; + + devShells.flang = pkgs.mkShell { + name = "h5fortran-flang"; + packages = + common-build-tools + ++ [ + pkgs.llvmPackages.clang + pkgs.llvmPackages.flang + pkgs.llvmPackages.llvm + pkgs.llvmPackages.libomp + pkgs.hdf5 + pkgs.zlib + ]; + + shellHook = '' + export CC=${pkgs.llvmPackages.clang}/bin/clang + export CXX=${pkgs.llvmPackages.clang}/bin/clang++ + export FC=${pkgs.llvmPackages.flang}/bin/flang-new + echo "h5fortran: LLVM/Flang + HDF5 + CMake + Ninja" + echo "HDF5: ${pkgs.hdf5.dev}" + ''; + + HDF5_DIR = "${pkgs.hdf5.dev}"; + }; + + devShells.fpm = pkgs.mkShell { + name = "h5fortran-fpm"; + packages = + common-build-tools + ++ [ + pkgs.gcc14 + pkgs.gfortran14 + pkgs.hdf5 + pkgs.zlib + pkgs.fpm + pkgs.python3 + ]; + + shellHook = '' + export CC=${pkgs.gcc14}/bin/gcc + export FC=${pkgs.gfortran14}/bin/gfortran + export CXX=${pkgs.gcc14}/bin/g++ + export FPM_FFLAGS="-I${pkgs.hdf5.dev}/include" + export FPM_LDFLAGS="-L${pkgs.hdf5.lib}/lib" + echo "h5fortran: fpm + GCC + HDF5" + echo "Build: fpm build" + ''; + }; + + devShells.testing = mkGccShell { + name = "h5fortran-testing"; + gcc-pkg = pkgs.gcc14; + gfortran-pkg = pkgs.gfortran14; + packages = with pkgs; [ + valgrind + gcovr + ]; + shellHookExtra = '' + echo "Tools: valgrind, gcovr, python (h5py/numpy)" + echo "Build: cmake -Bbuild -G Ninja --workflow --preset default" + ''; + }; + + devShells.cmake-old = pkgs.mkShell { + name = "h5fortran-cmake-old"; + packages = with pkgs; [ + cmake_3_24 + ninja + pkg-config + gcc14 + gfortran14 + hdf5 + zlib + git + ]; + + shellHook = '' + export CC=${pkgs.gcc14}/bin/gcc + export FC=${pkgs.gfortran14}/bin/gfortran + export CXX=${pkgs.gcc14}/bin/g++ + echo "h5fortran: CMake 3.24 (old) + GCC 14 + HDF5 + Ninja" + echo "HDF5: ${pkgs.hdf5.dev}" + ''; + + HDF5_DIR = "${pkgs.hdf5.dev}"; + }; + + devShells.oneapi = pkgs.mkShell { + name = "h5fortran-oneapi"; + packages = with pkgs; + common-build-tools + ++ [ + pkgs.intel-oneapi.hpc + pkgs.hdf5-fortran + pkgs.zlib + pkgs.python3 + pkgs.stdenv.cc + ]; + + shellHook = '' + # Source Intel oneAPI environment + if [ -d /opt/intel/oneapi ]; then + source /opt/intel/oneapi/setvars.sh >/dev/null 2>&1 + fi + + # Create icx wrapper with proper linker paths + _NIX_GLIBC_LIB=$(dirname $(gcc -print-file-name=Scrt1.o)) + _NIX_GCC_CRT=$(dirname $(gcc -print-file-name=crtbeginS.o)) + _NIX_GCC_SLIB=$(dirname $(gcc -print-file-name=libgcc_s.so)) + _ICX_WRAPPER=$(mktemp /tmp/icx-wrapper-XXXXXX) + cat > "$_ICX_WRAPPER" << EOF +#!/usr/bin/env bash +exec ${pkgs.intel-oneapi.hpc}/bin/icx -L$_NIX_GLIBC_LIB -L$_NIX_GCC_CRT -L$_NIX_GCC_SLIB -B$_NIX_GLIBC_LIB -B$_NIX_GCC_CRT "\$@" +EOF + chmod +x "$_ICX_WRAPPER" + + export CC="$_ICX_WRAPPER" + export CXX=${pkgs.intel-oneapi.hpc}/bin/icpx + export FC=${pkgs.intel-oneapi.hpc}/bin/ifx + export PATH=${pkgs.intel-oneapi.hpc}/bin:$PATH + export LD_LIBRARY_PATH=${pkgs.intel-oneapi.hpc}/lib:$_NIX_GLIBC_LIB:$_NIX_GCC_CRT:$_NIX_GCC_SLIB:$LD_LIBRARY_PATH + + echo "h5fortran: Intel oneAPI (ifx/icx) + HDF5 + CMake + Ninja" + echo "CC: $CC FC: $FC" + echo "HDF5: ${pkgs.hdf5-fortran.dev}" + ''; + + HDF5_DIR = "${pkgs.hdf5-fortran.dev}"; + }; + + devShells.coverage = mkGccShell { + name = "h5fortran-coverage"; + gcc-pkg = pkgs.gcc14; + gfortran-pkg = pkgs.gfortran14; + packages = with pkgs; [ + gcovr + lcov + ]; + shellHookExtra = '' + echo "Tools: gcovr, lcov" + echo "Build: cmake -Bbuild -G Ninja --preset coverage" + ''; + }; + + devShells.shared = mkGccShell { + name = "h5fortran-shared"; + gcc-pkg = pkgs.gcc14; + gfortran-pkg = pkgs.gfortran14; + shellHookExtra = '' + echo "Build: cmake -Bbuild -G Ninja --workflow --preset shared" + ''; + }; + + packages = { }; + } + ); +} diff --git a/fpm.toml b/fpm.toml index d31b1c1b..4a7c50cb 100644 --- a/fpm.toml +++ b/fpm.toml @@ -74,6 +74,18 @@ main = "test_shape.f90" name = "string" main = "test_string.f90" +[[test]] +name = "visit" +main = "test_visit.f90" + +[[test]] +name = "iterate" +main = "test_iterate.f90" + [[test]] name = "version" main = "test_version.f90" + +[[test]] +name = "swmr" +main = "test_swmr.f90" diff --git a/shell.nix b/shell.nix new file mode 100644 index 00000000..4aa14458 --- /dev/null +++ b/shell.nix @@ -0,0 +1,33 @@ +let + lock = builtins.fromJSON (builtins.readFile ./flake.lock); + pkgs = import + ( + fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/${lock.nodes.nixpkgs.locked.rev}.tar.gz"; + sha256 = lock.nodes.nixpkgs.locked.narHash; + } + ) + { }; + hdf5 = pkgs.hdf5.override { fortranSupport = true; }; +in +pkgs.mkShell { + name = "h5fortran"; + packages = [ + pkgs.cmake + pkgs.ninja + pkgs.gcc + pkgs.gfortran + hdf5 + pkgs.zlib + pkgs.python3 + pkgs.git + pkgs.pkg-config + ]; + + shellHook = '' + echo "h5fortran: GCC (default) + HDF5 + CMake + Ninja" + echo "Build: cmake -Bbuild -G Ninja --workflow --preset default" + ''; + + HDF5_DIR = "${hdf5.dev}"; +} diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 94ffe9d4..f7108177 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -1,12 +1,16 @@ set(s ${CMAKE_CURRENT_SOURCE_DIR}) target_sources(h5fortran PRIVATE -${s}/utils.f90 ${s}/datatype.f90 ${s}/deflate.f90 +${s}/interface.f90 +${s}/utils.f90 +${s}/datatype.f90 +${s}/deflate.f90 ${s}/read.f90 ${s}/read_scalar.f90 ${s}/read_ascii.f90 ${s}/reader.f90 ${s}/write.f90 ${s}/write_scalar.f90 ${s}/writer.f90 ${s}/reader_lt.f90 ${s}/writer_lt.f90 -${s}/interface.f90 ${s}/attr.f90 ${s}/attr_read.f90 ${s}/attr_write.f90 +${s}/iterate.f90 +${s}/visit.f90 ) diff --git a/src/interface.f90 b/src/interface.f90 index 12963adb..66848209 100644 --- a/src/interface.f90 +++ b/src/interface.f90 @@ -24,6 +24,7 @@ module h5fortran logical :: debug = .false. logical :: fletcher32 = .false. logical :: shuffle = .false. +logical :: swmr = .false. integer :: comp_lvl = 0 !! compression level (1-9) 0: disable compression @@ -38,7 +39,10 @@ module h5fortran procedure, public :: write_group => create_group !< legacy procedure, public :: create_group procedure, public :: create => hdf_create_user -procedure, public :: flush => hdf_flush +generic, public :: flush => hdf_flush, hdf_flush_dataset +procedure, private :: hdf_flush +procedure, private :: hdf_flush_dataset +procedure, public :: refresh => hdf_refresh procedure, public :: filesize => hdf_filesize procedure, public :: ndim => hdf_get_ndim procedure, public :: ndims => hdf_get_ndim !< legacy @@ -57,6 +61,8 @@ module h5fortran procedure, public :: is_open procedure, public :: delete_attr => attr_delete procedure, public :: exist_attr => attr_exist +procedure, public :: iterate => hdf_iterate +procedure, public :: visit => hdf_visit !! procedures without mapping !> below are procedure that need generic mapping (type or rank agnostic) @@ -161,6 +167,12 @@ module subroutine hdf_flush(self) class(hdf5_file), intent(in) :: self end subroutine +module subroutine hdf_flush_dataset(self, dname) +!! request HDF5 to flush dataset to disk. +class(hdf5_file), intent(in) :: self +character(*), intent(in) :: dname +end subroutine + end interface interface !< writer_lt.f90 @@ -397,6 +409,11 @@ module logical function hdf_check_exist(self, obj_name) character(*), intent(in) :: obj_name end function +module subroutine hdf_refresh(self, dname) +class(hdf5_file), intent(in) :: self +character(*), intent(in) :: dname +end subroutine + end interface @@ -649,6 +666,58 @@ module logical function attr_exist(self, obj_name, attr_name) character(*), intent(in) :: obj_name, attr_name end function +module subroutine hdf_iterate(self, group_name, callback) + !! Opens the HDF5 file and the specified group, then iterates over + !! all members of the group. For each member the user‐provided + !! callback is invoked with: + !! + !! group_name - name of the group + !! object_name - name of the member object + !! object_type - a short string indicating type ("group", "dataset", + !! "datatype", or "other") + class(hdf5_file), intent(in) :: self + character(len=*), intent(in) :: group_name + interface + subroutine user_callback_interface(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + !! The name of the group being traversed. + character(len=*), intent(in) :: object_name + !! The name of the object encountered. + character(len=*), intent(in) :: object_type + !!A short description such as "group", "dataset", + !! "datatype", or "other" + end subroutine + end interface + + procedure(user_callback_interface) :: callback +end subroutine + +module subroutine hdf_visit(self, group_name, callback) + !! Opens the HDF5 file and the specified group, then visits recursively + !! all members of the group. For each member the user‐provided + !! callback is invoked with: + !! + !! group_name - name of the group + !! object_name - name of the member object + !! object_type - a short string indicating type ("group", "dataset", + !! "datatype", or "other") + class(hdf5_file), intent(in) :: self + character(len=*), intent(in) :: group_name + interface + subroutine user_callback_interface(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + !! The name of the group being traversed. + character(len=*), intent(in) :: object_name + !! The name of the object encountered. + character(len=*), intent(in) :: object_type + !!A short description such as "group", "dataset", + !! "datatype", or "other" + end subroutine + end interface + + procedure(user_callback_interface) :: callback +end subroutine + end interface @@ -660,7 +729,7 @@ module function id2name(id) character(:), allocatable :: id2name end function -module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, debug, ok) +module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, debug, swmr, ok) !! open/create file !! !! PARAMETERS: @@ -676,6 +745,7 @@ module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, logical, intent(in), optional :: shuffle logical, intent(in), optional :: fletcher32 logical, intent(in), optional :: debug +logical, intent(in), optional :: swmr logical, intent(out), optional :: ok end subroutine diff --git a/src/iterate.f90 b/src/iterate.f90 new file mode 100644 index 00000000..b0cecc66 --- /dev/null +++ b/src/iterate.f90 @@ -0,0 +1,91 @@ +submodule (h5fortran) iterate_smod + use hdf5 + use, intrinsic :: iso_c_binding + implicit none + + interface + subroutine user_callback_interface(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + character(len=*), intent(in) :: object_name + character(len=*), intent(in) :: object_type + end subroutine + end interface + +contains + + module procedure hdf_iterate + implicit none + integer(hid_t) :: group_id + integer(c_int) :: status + integer(hsize_t) :: idx + type(c_funptr) :: funptr + type(c_ptr) :: op_data_ptr + integer(c_int) :: return_value + procedure(user_callback_interface), pointer :: user_callback => null() + + user_callback => callback + + call H5Gopen_f(self%file_id, trim(group_name), group_id, status) + call estop(status, "hdf_iterate:H5Gopen_f", self%filename, "Error opening group: " // trim(group_name)) + + idx = 0_hsize_t + op_data_ptr = C_NULL_PTR + funptr = c_funloc(internal_iterate_callback) + + call H5Literate_f(group_id, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, idx, funptr, op_data_ptr, return_value, status) + call estop(status, "hdf_iterate:H5Literate_f", self%filename, "Error during iteration of group: " // trim(group_name)) + if (return_value < 0) then + call estop(1_c_int, "hdf_iterate:H5Literate", self%filename, "Error during iteration of group: " // trim(group_name)) + end if + + call H5Gclose_f(group_id, status) + + contains + + integer(c_int) function internal_iterate_callback(grp_id, name, info, op_data) bind(C) + implicit none + integer(c_intptr_t), value :: grp_id + character(kind=c_char), intent(in) :: name(*) + type(h5l_info_t), intent(in) :: info + type(c_ptr), value :: op_data + + integer :: i, ln, obj_status + integer(hid_t) :: loc_id + type(h5o_info_t) :: obj_info + character(len=256) :: name_str + character(:), allocatable :: object_type + + if (info % corder == info % corder) continue + if (c_associated(op_data)) continue + + ln = 0 + do i = 1, 256 + if (name(i) == c_null_char) exit + name_str(i:i) = name(i) + ln = i + end do + + loc_id = int(grp_id, hid_t) + call H5Oget_info_by_name_f(loc_id, name_str(1:ln), obj_info, obj_status) + if (obj_status == 0) then + if (obj_info % type == H5O_TYPE_GROUP_F) then + object_type = "group" + else if (obj_info % type == H5O_TYPE_DATASET_F) then + object_type = "dataset" + else if (obj_info % type == H5O_TYPE_NAMED_DATATYPE_F) then + object_type = "datatype" + else + object_type = "other" + end if + else + object_type = "other" + end if + + call user_callback(group_name, name_str(1:ln), object_type) + + internal_iterate_callback = 0 + end function internal_iterate_callback + + end procedure hdf_iterate + +end submodule diff --git a/src/read.f90 b/src/read.f90 index 8616c009..2285a4d1 100644 --- a/src/read.f90 +++ b/src/read.f90 @@ -6,6 +6,7 @@ H5Aget_space_f, H5Aget_type_f, H5Aopen_by_name_f, H5Aclose_f, H5Aget_storage_size_f, & h5pget_layout_f, h5pget_chunk_f, h5pclose_f, h5pget_nfilters_f, h5pget_filter_f, & H5Dget_create_plist_f, h5dget_type_f, h5dopen_f, h5dclose_f, H5Dget_space_f, H5Dget_storage_size_f, & +H5Fflush_f, H5F_SCOPE_GLOBAL_F, & H5Iget_type_f, & h5lexists_f, & H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, H5Sget_simple_extent_npoints_f, H5Sclose_f, & @@ -139,4 +140,16 @@ end procedure hdf_check_exist +module procedure hdf_refresh + +integer :: ier + +if(.not. self%is_open()) error stop "ERROR:h5fortran:refresh: file is not open: " // self%filename + +call H5Fflush_f(self%file_id, H5F_SCOPE_GLOBAL_F, ier) +call estop(ier, "refresh:H5Fflush", self%filename, dname) + +end procedure hdf_refresh + + end submodule hdf5_read diff --git a/src/utils.f90 b/src/utils.f90 index b366b2b8..0c32984c 100644 --- a/src/utils.f90 +++ b/src/utils.f90 @@ -6,9 +6,12 @@ h5open_f, h5close_f, & H5Fopen_f, h5fcreate_f, h5fclose_f, h5fis_hdf5_f, h5fget_filesize_f, & h5fget_obj_count_f, h5fget_obj_ids_f, h5fget_name_f, & +h5pcreate_f, h5pclose_f, h5pset_libver_bounds_f, & h5sselect_hyperslab_f, h5screate_simple_f, & H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, H5Sget_simple_extent_npoints_f, & H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F, H5F_ACC_TRUNC_F, H5F_ACC_EXCL_F, & +H5F_LIBVER_LATEST_F, H5F_LIBVER_EARLIEST_F, & +H5P_FILE_ACCESS_F, & H5F_OBJ_FILE_F, H5F_OBJ_GROUP_F, H5F_OBJ_DATASET_F, H5F_OBJ_DATATYPE_F, H5F_OBJ_ALL_F, & H5D_CONTIGUOUS_F, H5D_CHUNKED_F, H5D_COMPACT_F, & H5I_FILE_F, & @@ -42,6 +45,7 @@ if(present(ok)) ok = .true. if(present(debug)) self%debug = debug +if(present(swmr)) self%swmr = swmr self%filename = filename @@ -126,30 +130,50 @@ fapl = H5P_DEFAULT_F -if (any(self%file_mode == [H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F])) then - if(.not. is_hdf5(filename)) then - write(stderr, '(a,i0)') "ERROR:h5fortran:open: is not an HDF5 file: " // self%filename // " file mode ", self%file_mode +if (self%swmr) then + call H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, ier) + call estop(ier, "h5open:H5Pcreate", self%filename, ok=ok) if (present(ok)) then - ok = .false. - return - else - error stop + if(.not. ok) return + endif + call H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, ier) + call estop(ier, "h5open:H5Pset_libver_bounds", self%filename, ok=ok) + if (present(ok)) then + if(.not. ok) return endif endif - call H5Fopen_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl) - call estop(ier, "h5open:H5Fopen", self%filename, ok=ok) - if (present(ok)) then - if(.not. ok) return + + if (any(self%file_mode == [H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F])) then + if(.not. is_hdf5(filename)) then + write(stderr, '(a,i0)') "ERROR:h5fortran:open: is not an HDF5 file: " // self%filename // " file mode ", self%file_mode + if (present(ok)) then + ok = .false. + return + else + error stop + endif + endif + + call H5Fopen_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl) + + call estop(ier, "h5open:H5Fopen", self%filename, ok=ok) + if (present(ok)) then + if(.not. ok) return + endif + elseif(self%file_mode == H5F_ACC_TRUNC_F) then + call H5Fcreate_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl) + call estop(ier, "h5open:H5Fcreate", self%filename, ok=ok) + if (present(ok)) then + if(.not. ok) return + endif + else + error stop "ERROR:h5fortran:open: Unsupported file mode: " // self%filename endif -elseif(self%file_mode == H5F_ACC_TRUNC_F) then - call H5Fcreate_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl) - call estop(ier, "h5open:H5Fcreate", self%filename, ok=ok) - if (present(ok)) then - if(.not. ok) return + + if (fapl /= H5P_DEFAULT_F) then + call H5Pclose_f(fapl, ier) + call estop(ier, "h5open:H5Pclose", self%filename, ok=ok) endif -else - error stop "ERROR:h5fortran:open: Unsupported file mode: " // self%filename -endif end procedure h5open @@ -366,8 +390,9 @@ write(stderr,*) "ERROR:h5fortran:get_slice: memory size /= dataset size: check variable slice (index). " // & " Dset_dims:", ddims, "C Mem_dims:", c_mem_dims, "mem_dims:", mem_dims, "rank(mem_dims):", rank(mem_dims) error stop "ERROR:h5fortran:get_slice " // dset_name -elseif(any(iend-istart+1 > ddims)) then - write(stderr,*) "ERROR:h5fortran:get_slice: iend: ", iend, ' > dset_dims: ', ddims +elseif(any(iend-istart > ddims)) then + write(stderr,*) "ERROR:h5fortran:get_slice: slice bigger than dataset: check variable slice (index). " // & + " Dset_dims:", ddims, "C Mem_dims:", c_mem_dims, "mem_dims:", mem_dims, "rank(mem_dims):", rank(mem_dims) error stop "ERROR:h5fortran:get_slice " // dset_name endif diff --git a/src/visit.f90 b/src/visit.f90 new file mode 100644 index 00000000..3920b7ec --- /dev/null +++ b/src/visit.f90 @@ -0,0 +1,81 @@ +submodule (h5fortran) visit_smod + use hdf5 + use, intrinsic :: iso_c_binding + implicit none + + interface + subroutine user_callback_interface(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + character(len=*), intent(in) :: object_name + character(len=*), intent(in) :: object_type + end subroutine + end interface + +contains + + module procedure hdf_visit + implicit none + integer(hid_t) :: group_id + integer(c_int) :: status + type(c_funptr) :: funptr + type(c_ptr) :: op_data_ptr + integer(c_int) :: return_value + procedure(user_callback_interface), pointer :: user_callback => null() + + user_callback => callback + + call H5Gopen_f(self%file_id, trim(group_name), group_id, status) + call estop(status, "hdf_visit:H5Gopen_f", self%filename, "Error opening group: " // trim(group_name)) + + op_data_ptr = C_NULL_PTR + funptr = c_funloc(internal_visit_callback) + + call H5Ovisit_f(group_id, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, funptr, op_data_ptr, return_value, status) + call estop(status, "hdf_visit:H5Ovisit_f", self%filename, "Error during visit of group: " // trim(group_name)) + if (return_value < 0) then + call estop(1_c_int, "hdf_visit:H5Ovisit", self%filename, "Error during visit of group: " // trim(group_name)) + end if + + call H5Gclose_f(group_id, status) + + contains + + integer(c_int) function internal_visit_callback(grp_id, name, info, op_data) bind(C) + implicit none + integer(c_intptr_t), value :: grp_id + character(kind=c_char), intent(in) :: name(*) + type(h5o_info_t), intent(in) :: info + type(c_ptr), value :: op_data + + character(len=256) :: name_str + character(:), allocatable :: object_type + integer :: i, ln + + if (grp_id /= 0_c_intptr_t) continue + if (c_associated(op_data)) continue + + ln = 0 + do i = 1, 256 + if (name(i) == c_null_char) exit + name_str(i:i) = name(i) + ln = i + end do + + if (info % type == H5O_TYPE_GROUP_F) then + object_type = "group" + else if (info % type == H5O_TYPE_DATASET_F) then + object_type = "dataset" + else if (info % type == H5O_TYPE_NAMED_DATATYPE_F) then + object_type = "datatype" + else + object_type = "other" + end if + + call user_callback(group_name, name_str(1:ln), object_type) + + internal_visit_callback = 0 + end function internal_visit_callback + + end procedure hdf_visit + +end submodule diff --git a/src/write.f90 b/src/write.f90 index 87320f6e..22439e0e 100644 --- a/src/write.f90 +++ b/src/write.f90 @@ -91,7 +91,9 @@ call estop(ier, "create:H5Dget_space", self%filename, dname) - if (present(istart) .and. present(iend)) then + if (present(istart)) then + if(any(istart < 1)) error stop 'ERROR:h5fortran:create: istart must be >= 1' + if(any(iend < istart)) error stop 'ERROR:h5fortran:create: iend must be >= istart' call H5Sget_simple_extent_ndims_f(filespace_id, drank, ier) call estop(ier, "create:H5Sget_simple_extent_ndims", self%filename, dname) @@ -116,17 +118,14 @@ allocate(ddims(drank), maxdims(drank)) call H5Sget_simple_extent_dims_f(filespace_id, ddims, maxdims, ier) - if (ier /= drank) error stop 'ERROR:h5fortran:create: H5Sget_simple_extent_dims: ' // dname // ' in ' // self%filename + if (ier /= drank) & + error stop 'ERROR:h5fortran:create: H5Sget_simple_extent_dims: ' // dname // ' in ' // self%filename - do i = 1, drank - if (iend(i) - istart(i) > ddims(i)) emsg = 'ERROR:h5fortran:create: iend - istart > dset_dims' - enddo - if (allocated(emsg)) then - write(stderr,*) emsg // " dataset: " // dname // " file: " // self%filename // " istart: ", & - istart, " iend: ", iend, " ddims: ", ddims, " maxdims: ", maxdims + if(any(iend - istart > ddims)) then + write(stderr,*) 'ERROR:h5fortran:create: iend - istart > dset_dims dataset: ', dname, & + ' file: ', self%filename, ' istart: ', istart, ' iend: ', iend, ' ddims: ', ddims error stop endif - else if (size(mem_dims) == 0) then !! scalar @@ -418,4 +417,16 @@ end subroutine guess_chunk_size end procedure hdf_flush +module procedure hdf_flush_dataset + +integer :: ier + +if(.not. self%is_open()) error stop "ERROR:h5fortran:flush: file is not open: " // self%filename + +call H5Fflush_f(self%file_id, H5F_SCOPE_GLOBAL_F, ier) +call estop(ier, "flush:H5Fflush", self%filename, dname) + +end procedure hdf_flush_dataset + + end submodule write diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 84a05fa4..163c259f 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -74,7 +74,7 @@ endfunction(setup_test) set(test_names array attributes cast deflate_write deflate_read deflate_props destructor exist groups layout lt scalar shape string version write -fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable) +fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable iterate visit swmr) if(HAVE_IEEE_ARITH) list(APPEND test_names fill) endif() @@ -113,9 +113,6 @@ endif() if(h5py_ok) -set_property(TEST string_read PROPERTY FIXTURES_REQUIRED h5str) -set_property(TEST string_read PROPERTY REQUIRED_FILES ${string_file}) - add_test(NAME PythonAttributes COMMAND Python::Interpreter ${CMAKE_CURRENT_SOURCE_DIR}/generate_attributes.py ${attr_file} ) diff --git a/test/test_iterate.f90 b/test/test_iterate.f90 new file mode 100644 index 00000000..4351c3a7 --- /dev/null +++ b/test/test_iterate.f90 @@ -0,0 +1,48 @@ +program test_iterate + use, intrinsic :: iso_fortran_env, only: real64 + use h5fortran + use hdf5 + implicit none + + type(hdf5_file) :: h + character(*), parameter :: filename='test_iterate.h5' + integer :: i + + i = 0 + + ! Create a sample HDF5 file + call h%open(filename, "w") + + call h%create_group("/group1") + call h%create_group("/group1/group2") + call h%write("/dataset1", 1.0_real64) + call h%write("/group1/dataset2", 2.0_real64) + + call h%close() + + ! Reopen the file for testing + call h%open(filename, "r") + + ! iterate the root group + print*, "test_iterate: iterating root group" + call h%iterate("/", my_callback) + + print*, "test_iterate: iterating /group1" + ! iterate a subgroup + call h%iterate("/group1", my_callback) + + call h%close() + + print*, "test_iterate: found ", i, " objects" + if (i /= 4) error stop "test_iterate: expected 4 objects" + +contains + + ! Define a callback subroutine + subroutine my_callback(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name, object_name, object_type + print *, "test_iterate: at group ", trim(group_name), ' we found ', trim(object_name), ' which is a ', trim(object_type) + i = i + 1 + end subroutine my_callback + +end program test_iterate diff --git a/test/test_swmr.f90 b/test/test_swmr.f90 new file mode 100644 index 00000000..5eeca064 --- /dev/null +++ b/test/test_swmr.f90 @@ -0,0 +1,41 @@ +program test_swmr + use h5fortran, only: hdf5_file + implicit none + + character(*), parameter :: fn = 'test_swmr.h5' + type(hdf5_file) :: h_write, h_read + integer, parameter :: n = 10 + real :: dat(n), dat_out(n) + integer :: i + + do i = 1, n + dat(i) = real(i) + end do + + ! Writer: create with swmr mode + call h_write%open(fn, action='w', swmr=.true.) + call h_write%write('/data', dat) + call h_write%flush('/data') + + ! Writer: update data while still open + dat = dat * 2.0 + call h_write%write('/data', dat) + call h_write%flush('/data') + call h_write%close() + + ! Reader: open file created with swmr mode + call h_read%open(fn, action='r') + call h_read%refresh('/data') + call h_read%read('/data', dat_out) + call h_read%close() + + if (any(dat_out /= dat)) then + print '(A)', 'ERROR: data mismatch' + print '(A,10F5.2)', 'Expected:', dat + print '(A,10F5.2)', 'Got: ', dat_out + call exit(1) + end if + + print '(A)', 'PASSED: SWMR write/update/read' + +end program test_swmr \ No newline at end of file diff --git a/test/test_visit.f90 b/test/test_visit.f90 new file mode 100644 index 00000000..172cfe43 --- /dev/null +++ b/test/test_visit.f90 @@ -0,0 +1,48 @@ +program test_visit + use, intrinsic :: iso_fortran_env, only: real64 + use h5fortran + use hdf5 + implicit none + + type(hdf5_file) :: h + character(*), parameter :: filename='test_visit.h5' + integer :: i + + i = 0 + + ! Create a sample HDF5 file + call h%open(filename, "w") + + call h%create_group("/group1") + call h%create_group("/group1/group2") + call h%write("/dataset1", 1.0_real64) + call h%write("/group1/dataset2", 2.0_real64) + + call h%close() + + ! Reopen the file for testing + call h%open(filename, "r") + + ! visit the root group + print*, "test_visit: visiting root group" + call h%visit("/", my_callback) + + print*, "test_visit: visiting /group1" + ! visit a subgroup + call h%visit("/group1", my_callback) + + call h%close() + + print*, "test_visit: found ", i, " objects" + if (i /= 8) error stop "test_visit: expected 8 objects" + +contains + + ! Define a callback subroutine + subroutine my_callback(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name, object_name, object_type + print *, "test_visit: at group ", trim(group_name), ' we found ', trim(object_name), ' that is a ', trim(object_type) + i = i + 1 + end subroutine my_callback + +end program test_visit