diff options
32 files changed, 2882 insertions, 1403 deletions
diff --git a/fortran/src/H5Dff.F90 b/fortran/src/H5Dff.F90 index 6073570..2353ca2 100644 --- a/fortran/src/H5Dff.F90 +++ b/fortran/src/H5Dff.F90 @@ -2283,6 +2283,8 @@ CONTAINS !! \param hdferr \fortran_error !! \param xfer_prp Identifier of a transfer property list for this I/O operation. !! +!! See C API: @ref H5Dread_multi() +!! SUBROUTINE h5dread_multi_f(count, dset_id, mem_type_id, mem_space_id, file_space_id, buf, hdferr, xfer_prp) IMPLICIT NONE @@ -2320,6 +2322,7 @@ CONTAINS hdferr = H5Dread_multi(count, dset_id, mem_type_id, mem_space_id, file_space_id, xfer_prp_default, buf) END SUBROUTINE h5dread_multi_f + !> !! \ingroup FH5D !! @@ -2334,6 +2337,8 @@ CONTAINS !! \param hdferr \fortran_error !! \param xfer_prp Identifier of a transfer property list for this I/O operation. !! +!! See C API: @ref H5Dwrite_multi() +!! SUBROUTINE h5dwrite_multi_f(count, dset_id, mem_type_id, mem_space_id, file_space_id, buf, hdferr, xfer_prp) IMPLICIT NONE @@ -2372,6 +2377,141 @@ CONTAINS END SUBROUTINE h5dwrite_multi_f +!> +!! \ingroup FH5D +!! +!! \brief Reads a raw data chunk directly from a dataset in a file into a buffer. +!! +!! \param dset_id Identifier of the dataset to read from +!! \param offset Logical position of the chunk's first element in the dataspace, \Bold{0-based indices} +!! \param filters Mask for identifying the filters in use +!! \param buf Buffer containing data to be read from the chunk +!! \param hdferr \fortran_error +!! \param dxpl_id Dataset transfer property list identifier +!! +!! See C API: @ref H5Dread_chunk() +!! + SUBROUTINE h5dread_chunk_f(dset_id, offset, filters, buf, hdferr, dxpl_id) + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: dset_id + INTEGER(HSIZE_T) , INTENT(IN), DIMENSION(:) :: offset + INTEGER(C_INT32_T), INTENT(INOUT) :: filters + TYPE(C_PTR) :: buf + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: dxpl_id + + INTEGER(HID_T) :: dxpl_id_default + INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: offset_c + INTEGER(HSIZE_T) :: i, rank + + INTERFACE + INTEGER(C_INT) FUNCTION H5Dread_chunk(dset_id, dxpl_id, offset, filters, buf) & + BIND(C, NAME='H5Dread_chunk') + IMPORT :: SIZE_T, HSIZE_T, HID_T + IMPORT :: C_PTR, C_INT32_T, C_INT + IMPLICIT NONE + INTEGER(HID_T) , VALUE :: dset_id + INTEGER(HID_T) , VALUE :: dxpl_id + INTEGER(HSIZE_T) , DIMENSION(*) :: offset + INTEGER(C_INT32_T) :: filters + TYPE(C_PTR) , VALUE :: buf + END FUNCTION H5Dread_chunk + END INTERFACE + + dxpl_id_default = H5P_DEFAULT_F + IF (PRESENT(dxpl_id)) dxpl_id_default = dxpl_id + + rank = SIZE(offset, KIND=HSIZE_T) + + ALLOCATE(offset_c(rank), STAT=hdferr) + IF (hdferr .NE. 0 ) THEN + hdferr = -1 + RETURN + ENDIF + + ! + ! Reverse dimensions due to C-FORTRAN storage order + ! + DO i = 1, rank + offset_c(i) = offset(rank - i + 1) + ENDDO + + hdferr = INT(H5Dread_chunk(dset_id, dxpl_id_default, offset_c, filters, buf)) + + DEALLOCATE(offset_c) + + END SUBROUTINE h5dread_chunk_f + +!> +!! \ingroup FH5D +!! +!! \brief Writes a raw data chunk from a buffer directly to a dataset in a file. +!! +!! \param dset_id Identifier of the dataset to write to +!! \param filters Mask for identifying the filters in use +!! \param offset Logical position of the chunk's first element in the dataspace, \Bold{0-based indices} +!! \param data_size Size of the actual data to be written in bytes +!! \param buf Buffer containing data to be written to the chunk +!! \param hdferr \fortran_error +!! \param dxpl_id Dataset transfer property list identifier +!! +!! See C API: @ref H5Dwrite_chunk() +!! + SUBROUTINE h5dwrite_chunk_f(dset_id, filters, offset, data_size, buf, hdferr, dxpl_id) + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: dset_id + INTEGER(C_INT32_T), INTENT(IN) :: filters + INTEGER(HSIZE_T) , INTENT(IN), DIMENSION(:) :: offset + INTEGER(SIZE_T) , INTENT(IN) :: data_size + TYPE(C_PTR) :: buf + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: dxpl_id + + INTEGER(HID_T) :: dxpl_id_default + INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: offset_c + INTEGER(HSIZE_T) :: i, rank + + INTERFACE + INTEGER(C_INT) FUNCTION H5Dwrite_chunk(dset_id, dxpl_id, filters, offset, data_size, buf) & + BIND(C, NAME='H5Dwrite_chunk') + IMPORT :: SIZE_T, HSIZE_T, HID_T + IMPORT :: C_PTR, C_INT32_T, C_INT + IMPLICIT NONE + INTEGER(HID_T) , VALUE :: dset_id + INTEGER(HID_T) , VALUE :: dxpl_id + INTEGER(C_INT32_T), VALUE :: filters + INTEGER(HSIZE_T), DIMENSION(*) :: offset + INTEGER(SIZE_T) , VALUE :: data_size + TYPE(C_PTR) , VALUE :: buf + END FUNCTION H5Dwrite_chunk + END INTERFACE + + dxpl_id_default = H5P_DEFAULT_F + IF (PRESENT(dxpl_id)) dxpl_id_default = dxpl_id + + rank = SIZE(offset, KIND=HSIZE_T) + + ALLOCATE(offset_c(rank), STAT=hdferr) + IF (hdferr .NE. 0 ) THEN + hdferr = -1 + RETURN + ENDIF + + ! + ! Reverse dimensions due to C-FORTRAN storage order + ! + DO i = 1, rank + offset_c(i) = offset(rank - i + 1) + ENDDO + + hdferr = INT(H5Dwrite_chunk(dset_id, dxpl_id_default, filters, offset_c, data_size, buf)) + + DEALLOCATE(offset_c) + + END SUBROUTINE h5dwrite_chunk_f + END MODULE H5D diff --git a/fortran/src/H5Fff.F90 b/fortran/src/H5Fff.F90 index f8a7405..e053874 100644 --- a/fortran/src/H5Fff.F90 +++ b/fortran/src/H5Fff.F90 @@ -43,7 +43,6 @@ MODULE H5F ! Number of objects opened in H5open_f INTEGER(SIZE_T) :: H5OPEN_NUM_OBJ - #ifndef H5_DOXYGEN INTERFACE INTEGER(C_INT) FUNCTION h5fis_accessible(name, & @@ -58,6 +57,40 @@ MODULE H5F END INTERFACE #endif +!> @brief H5F_info_t_super derived type. + TYPE, BIND(C) :: H5F_info_super_t + INTEGER(C_INT) :: version !< Superblock version number + INTEGER(HSIZE_T) :: super_size !< Superblock size + INTEGER(HSIZE_T) :: super_ext_size !< Superblock extension size + END TYPE H5F_info_super_t + +!> @brief H5F_info_t_free derived type. + TYPE, BIND(C) :: H5F_info_free_t + INTEGER(C_INT) :: version !< Version # of file free space management + INTEGER(HSIZE_T) :: meta_size !< Free space manager metadata size + INTEGER(HSIZE_T) :: tot_space !< Amount of free space in the file + END TYPE H5F_info_free_t + +!> @brief H5_ih_info_t derived type. + TYPE, BIND(C) :: H5_ih_info_t + INTEGER(HSIZE_T) :: heap_size !< Heap size + INTEGER(HSIZE_T) :: index_size !< btree and/or list + END TYPE H5_ih_info_t + +!> @brief H5F_info_t_sohm derived type. + TYPE, BIND(C) :: H5F_info_sohm_t + INTEGER(C_INT) :: version !< Version # of shared object header info + INTEGER(HSIZE_T) :: hdr_size !< Shared object header message header size + TYPE(H5_ih_info_t) :: msgs_info !< Shared object header message index & heap size + END TYPE H5F_info_sohm_t + +!> @brief h5f_info_t derived type. + TYPE, BIND(C) :: h5f_info_t + TYPE(H5F_info_super_t) :: super + TYPE(H5F_info_free_t) :: free + TYPE(H5F_info_sohm_t) :: sohm + END TYPE h5f_info_t + CONTAINS !> !! \ingroup FH5F @@ -1093,5 +1126,35 @@ CONTAINS END SUBROUTINE h5fset_dset_no_attrs_hint_f +!> +!! \ingroup FH5F +!! +!! \brief Retrieves global file information +!! +!! \param obj_id Object identifier. The identifier may be that of a file, group, dataset, named datatype, or attribute. +!! \param file_info Buffer for global file information +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Fget_info2() +!! + SUBROUTINE H5Fget_info_f(obj_id, file_info, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: obj_id + TYPE(H5F_INFO_T), INTENT(OUT) :: file_info + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5Fget_info(obj_id, file_info) BIND(C, NAME='H5Fget_info2') + IMPORT :: HID_T, C_INT, H5F_INFO_T + IMPLICIT NONE + INTEGER(HID_T) , VALUE :: obj_id + TYPE(H5F_INFO_T), VALUE :: file_info + END FUNCTION H5Fget_info + END INTERFACE + + hdferr = INT(H5Fget_info(obj_id, file_info)) + + END SUBROUTINE H5Fget_info_f + END MODULE H5F diff --git a/fortran/src/H5Lff.F90 b/fortran/src/H5Lff.F90 index c474754..f61af02 100644 --- a/fortran/src/H5Lff.F90 +++ b/fortran/src/H5Lff.F90 @@ -748,10 +748,10 @@ CONTAINS link_exists_c = H5Lexists(loc_id, c_name, lapl_id_default) link_exists = .FALSE. - IF(link_exists_c.GT.0) link_exists = .TRUE. + IF(link_exists_c.GT.0_C_INT) link_exists = .TRUE. hdferr = 0 - IF(link_exists_c.LT.0) hdferr = -1 + IF(link_exists_c.LT.0_C_INT) hdferr = -1 END SUBROUTINE h5lexists_f @@ -1462,7 +1462,7 @@ CONTAINS !! SUBROUTINE h5literate_by_name_f(loc_id, group_name, index_type, order, & idx, op, op_data, return_value, hdferr, lapl_id) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_FUNPTR + IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: group_name @@ -1509,4 +1509,104 @@ CONTAINS END SUBROUTINE h5literate_by_name_f +!> +!! \ingroup FH5L +!! +!! \brief Recursively visits all links starting from a specified group. +!! +!! \param grp_id Group identifier +!! \param idx_type Index type +!! \param order Iteration order +!! \param op Callback function +!! \param op_data User-defined callback function context +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Lvisit2() +!! + SUBROUTINE H5Lvisit_f(grp_id, idx_type, order, op, op_data, hdferr) + + IMPLICIT NONE + + INTEGER(hid_t), INTENT(IN) :: grp_id + INTEGER , INTENT(IN) :: idx_type + INTEGER , INTENT(IN) :: order + TYPE(C_FUNPTR) :: op + TYPE(C_PTR) :: op_data + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5Lvisit(grp_id, idx_type, order, op, op_data) BIND(C, NAME='H5Lvisit2') + IMPORT :: c_char, c_int, c_ptr, c_funptr + IMPORT :: HID_T, SIZE_T, HSIZE_T + IMPLICIT NONE + INTEGER(hid_t), VALUE :: grp_id + INTEGER , VALUE :: idx_type + INTEGER , VALUE :: order + TYPE(C_FUNPTR), VALUE :: op + TYPE(C_PTR) , VALUE :: op_data + END FUNCTION H5Lvisit + END INTERFACE + + hdferr = INT(H5Lvisit(grp_id, INT(idx_type, C_INT), INT(order, C_INT), op, op_data)) + + END SUBROUTINE H5Lvisit_f + +!> +!! \ingroup FH5L +!! +!! \brief Recursively visits all links starting from a specified group. +!! +!! \param loc_id Location identifier +!! \param group_name Group name +!! \param idx_type Index type +!! \param order Iteration order +!! \param op Callback function +!! \param op_data User-defined callback function context +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list +!! +!! +!! See C API: @ref H5Lvisit_by_name2() +!! + SUBROUTINE H5Lvisit_by_name_f(loc_id, group_name, idx_type, order, op, op_data, hdferr, lapl_id) + + IMPLICIT NONE + + INTEGER(hid_t), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER , INTENT(IN) :: idx_type + INTEGER , INTENT(IN) :: order + TYPE(C_FUNPTR) :: op + TYPE(C_PTR) :: op_data + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(group_name)+1,KIND=C_CHAR) :: c_name + + INTERFACE + INTEGER(C_INT) FUNCTION H5Lvisit_by_name(loc_id, group_name, idx_type, order, op, op_data, lapl_id_default) & + BIND(C, NAME='H5Lvisit_by_name2') + IMPORT :: C_CHAR, C_INT, C_PTR, C_FUNPTR + IMPORT :: HID_T, SIZE_T, HSIZE_T + IMPLICIT NONE + INTEGER(hid_t), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: group_name + INTEGER , VALUE :: idx_type + INTEGER , VALUE :: order + TYPE(C_FUNPTR), VALUE :: op + TYPE(C_PTR) , VALUE :: op_data + INTEGER(HID_T), VALUE :: lapl_id_default + END FUNCTION H5Lvisit_by_name + END INTERFACE + + c_name = TRIM(group_name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = INT(H5Lvisit_by_name(loc_id, c_name, INT(idx_type, C_INT), INT(order, C_INT), op, op_data, lapl_id_default)) + + END SUBROUTINE H5Lvisit_by_name_f + END MODULE H5L diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c index 0efd205..3a97d7e 100644 --- a/fortran/src/H5Pf.c +++ b/fortran/src/H5Pf.c @@ -358,76 +358,6 @@ h5pget_chunk_c(hid_t_f *prp_id, int_f *max_rank, hsize_t_f *dims) return ret_value; } -/****if* H5Pf/h5pset_fill_value_c - * NAME - * h5pset_fill_value_c - * PURPOSE - * Call H5Pset_fill_value to set a fillvalue for a dataset - * INPUTS - * prp_id - property list identifier - * type_id - datatype identifier (fill value is of type type_id) - * fillvalue - fillvalue - * RETURNS - * 0 on success, -1 on failure - * SOURCE - */ -int_f -h5pset_fill_value_c(hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue) -/******/ -{ - int ret_value = -1; - hid_t c_prp_id; - hid_t c_type_id; - herr_t ret; - - /* - * Call H5Pset_fill_value function. - */ - c_prp_id = (hid_t)*prp_id; - c_type_id = (hid_t)*type_id; - ret = H5Pset_fill_value(c_prp_id, c_type_id, fillvalue); - - if (ret < 0) - return ret_value; - ret_value = 0; - return ret_value; -} - -/****if* H5Pf/h5pget_fill_value_c - * NAME - * h5pget_fill_value_c - * PURPOSE - * Call H5Pget_fill_value to set a fillvalue for a dataset - * INPUTS - * prp_id - property list identifier - * type_id - datatype identifier (fill value is of type type_id) - * fillvalue - fillvalue - * RETURNS - * 0 on success, -1 on failure - * SOURCE - */ -int_f -h5pget_fill_value_c(hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue) -/******/ -{ - int ret_value = -1; - hid_t c_prp_id; - hid_t c_type_id; - herr_t ret; - - /* - * Call H5Pget_fill_value function. - */ - c_prp_id = (hid_t)*prp_id; - c_type_id = (hid_t)*type_id; - ret = H5Pget_fill_value(c_prp_id, c_type_id, fillvalue); - - if (ret < 0) - return ret_value; - ret_value = 0; - return ret_value; -} - /****if* H5Pf/h5pget_version_c * NAME * h5pget_version_c @@ -487,77 +417,6 @@ h5pget_version_c(hid_t_f *prp_id, int_f *boot, int_f *freelist, int_f *stab, int } #endif /* H5_NO_DEPRECATED_SYMBOLS */ -/****if* H5Pf/h5pget_userblock_c - * NAME - * h5pget_userblock_c - * PURPOSE - * Call H5Pget_userblock to get the size of a user block in - * a file creation property list - * INPUTS - * prp_id - property list identifier - * Outputs size - Size of the user-block in bytes - * RETURNS - * 0 on success, -1 on failure - * SOURCE - */ -int_f -h5pget_userblock_c(hid_t_f *prp_id, hsize_t_f *size) -/******/ -{ - int ret_value = -1; - hid_t c_prp_id; - herr_t ret; - hsize_t c_size; - - /* - * Call H5Pget_userblock function. - */ - c_prp_id = (hid_t)*prp_id; - ret = H5Pget_userblock(c_prp_id, &c_size); - if (ret < 0) - return ret_value; - - *size = (hsize_t_f)c_size; - ret_value = 0; - - return ret_value; -} - -/****if* H5Pf/h5pset_userblock_c - * NAME - * h5pset_userblock_c - * PURPOSE - * Call H5Pset_userblock to set the size of a user block in - * a file creation property list - * INPUTS - * prp_id - property list identifier - * size - Size of the user-block in bytes - * RETURNS - * 0 on success, -1 on failure - * SOURCE - */ -int_f -h5pset_userblock_c(hid_t_f *prp_id, hsize_t_f *size) -/******/ -{ - int ret_value = -1; - hid_t c_prp_id; - herr_t ret; - hsize_t c_size; - c_size = (hsize_t)*size; - - /* - * Call H5Pset_userblock function. - */ - c_prp_id = (hid_t)*prp_id; - ret = H5Pset_userblock(c_prp_id, c_size); - - if (ret < 0) - return ret_value; - ret_value = 0; - return ret_value; -} - /****if* H5Pf/h5pget_sizes_c * NAME * h5pget_sizes_c diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index 5f76b6c..87da5d5 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -101,28 +101,29 @@ MODULE H5P MODULE PROCEDURE h5pinsert_ptr END INTERFACE + INTERFACE - INTEGER FUNCTION h5pget_fill_value_c(prp_id, type_id, fillvalue) & - BIND(C, NAME='h5pget_fill_value_c') - IMPORT :: c_ptr + INTEGER(C_INT) FUNCTION H5Pset_fill_value(prp_id, type_id, fillvalue) & + BIND(C, NAME='H5Pset_fill_value') + IMPORT :: C_INT, C_PTR IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER(HID_T), INTENT(IN) :: type_id - TYPE(C_PTR), VALUE :: fillvalue - END FUNCTION h5pget_fill_value_c + INTEGER(hid_t), VALUE :: prp_id + INTEGER(hid_t), VALUE :: type_id + TYPE(C_PTR) , VALUE :: fillvalue + END FUNCTION H5Pset_fill_value END INTERFACE INTERFACE - INTEGER FUNCTION h5pset_fill_value_c(prp_id, type_id, fillvalue) & - BIND(C, NAME='h5pset_fill_value_c') - IMPORT :: c_ptr + INTEGER(C_INT) FUNCTION H5Pget_fill_value(prp_id, type_id, fillvalue) & + BIND(C, NAME='H5Pget_fill_value') + IMPORT :: C_INT, C_PTR IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER(HID_T), INTENT(IN) :: type_id - TYPE(C_PTR), VALUE :: fillvalue - END FUNCTION h5pset_fill_value_c + INTEGER(hid_t), VALUE :: prp_id + INTEGER(hid_t), VALUE :: type_id + TYPE(C_PTR) , VALUE :: fillvalue + END FUNCTION H5Pget_fill_value END INTERFACE INTERFACE @@ -514,7 +515,7 @@ CONTAINS !! !! \brief Retrieves the version information of various objects for a file creation property list. !! -!! \param prp_id File createion property list identifier. +!! \param prp_id File creation property list identifier. !! \param boot Super block version number. !! \param freelist Global freelist version number. !! \param stab Symbol table version number. @@ -565,16 +566,17 @@ CONTAINS INTEGER(HSIZE_T), INTENT(IN) :: size INTEGER, INTENT(OUT) :: hdferr INTERFACE - INTEGER FUNCTION h5pset_userblock_c(prp_id, size) & - BIND(C,NAME='h5pset_userblock_c') + INTEGER FUNCTION H5Pset_userblock(prp_id, size) & + BIND(C,NAME='H5Pset_userblock') IMPORT :: HID_T, HSIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER(HSIZE_T), INTENT(IN) :: size - END FUNCTION h5pset_userblock_c + INTEGER(HID_T) , VALUE :: prp_id + INTEGER(HSIZE_T), VALUE :: size + END FUNCTION H5Pset_userblock END INTERFACE - hdferr = h5pset_userblock_c(prp_id, size) + hdferr = H5Pset_userblock(prp_id, size) + END SUBROUTINE h5pset_userblock_f !> @@ -594,15 +596,17 @@ CONTAINS INTEGER(HSIZE_T), INTENT(OUT) :: block_size INTEGER, INTENT(OUT) :: hdferr INTERFACE - INTEGER FUNCTION h5pget_userblock_c(prp_id, block_size) & - BIND(C,NAME='h5pget_userblock_c') + INTEGER FUNCTION H5Pget_userblock(prp_id, block_size) & + BIND(C,NAME='H5Pget_userblock') IMPORT :: HID_T, HSIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER(HSIZE_T), INTENT(OUT) :: block_size - END FUNCTION h5pget_userblock_c + INTEGER(HID_T) , VALUE :: prp_id + INTEGER(HSIZE_T) :: block_size + END FUNCTION H5Pget_userblock END INTERFACE - hdferr = h5pget_userblock_c(prp_id, block_size) + + hdferr = H5Pget_userblock(prp_id, block_size) + END SUBROUTINE h5pget_userblock_f !> @@ -4592,11 +4596,12 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) INTEGER(HID_T), INTENT(IN) :: type_id INTEGER, INTENT(IN), TARGET :: fillvalue INTEGER, INTENT(OUT) :: hdferr + TYPE(C_PTR) :: f_ptr ! C address f_ptr = C_LOC(fillvalue) - hdferr = h5pset_fill_value_c(prp_id, type_id, f_ptr) + hdferr = INT(H5Pset_fill_value(prp_id, type_id, f_ptr)) END SUBROUTINE h5pset_fill_value_integer @@ -4610,7 +4615,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) f_ptr = C_LOC(fillvalue) - hdferr = h5pget_fill_value_c(prp_id, type_id, f_ptr) + hdferr = INT(H5Pget_fill_value(prp_id, type_id, f_ptr)) END SUBROUTINE h5pget_fill_value_integer @@ -4623,7 +4628,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) TYPE(C_PTR) :: f_ptr ! C address f_ptr = C_LOC(fillvalue(1:1)) - hdferr = h5pset_fill_value_c(prp_id, type_id, f_ptr) + hdferr = INT(H5Pset_fill_value(prp_id, type_id, f_ptr)) END SUBROUTINE h5pset_fill_value_char @@ -4650,7 +4655,8 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ENDIF f_ptr = C_LOC(chr(1)(1:1)) - hdferr = h5pget_fill_value_c(prp_id, type_id, f_ptr) + + hdferr = INT(H5Pget_fill_value(prp_id, type_id, f_ptr)) DO i = 1, chr_len fillvalue(i:i) = chr(i) @@ -4663,10 +4669,10 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER(HID_T), INTENT(IN) :: type_id - TYPE(C_PTR), INTENT(IN) :: fillvalue + TYPE(C_PTR) :: fillvalue INTEGER, INTENT(OUT) :: hdferr - hdferr = h5pset_fill_value_c(prp_id, type_id, fillvalue) + hdferr = INT(H5Pset_fill_value(prp_id, type_id, fillvalue)) END SUBROUTINE h5pset_fill_value_ptr @@ -4674,10 +4680,10 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER(HID_T), INTENT(IN) :: type_id - TYPE(C_PTR) , INTENT(IN) :: fillvalue + TYPE(C_PTR) :: fillvalue INTEGER , INTENT(OUT) :: hdferr - hdferr = h5pget_fill_value_c(prp_id, type_id, fillvalue) + hdferr = INT(H5Pget_fill_value(prp_id, type_id, fillvalue)) END SUBROUTINE h5pget_fill_value_ptr @@ -5322,11 +5328,46 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) hdferr = h5pget_fapl_ioc(prp_id, f_ptr) END SUBROUTINE h5pget_fapl_ioc_f + #endif !> !! \ingroup FH5P !! +!! \brief Retrieves local and global causes that broke collective I/O on the last parallel I/O call. +!! +!! \param plist_id Dataset transfer property list identifier +!! \param local_no_collective_cause An enumerated set value indicating the causes that prevented collective I/O in the local process +!! \param global_no_collective_cause An enumerated set value indicating the causes across all processes that prevented collective I/O +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Pget_mpio_no_collective_cause() +!! + SUBROUTINE h5pget_mpio_no_collective_cause_f(plist_id, local_no_collective_cause, global_no_collective_cause, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: plist_id + INTEGER(C_INT32_T), INTENT(OUT) :: local_no_collective_cause + INTEGER(C_INT32_T), INTENT(OUT) :: global_no_collective_cause + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5Pget_mpio_no_collective_cause(plist_id, local_no_collective_cause, global_no_collective_cause) & + BIND(C, NAME='H5Pget_mpio_no_collective_cause') + IMPORT :: HID_T, C_INT, C_INT32_T + IMPLICIT NONE + INTEGER(HID_T) , VALUE :: plist_id + INTEGER(C_INT32_T) :: local_no_collective_cause + INTEGER(C_INT32_T) :: global_no_collective_cause + END FUNCTION H5Pget_mpio_no_collective_cause + END INTERFACE + + hdferr = INT(H5Pget_mpio_no_collective_cause(plist_id, local_no_collective_cause, global_no_collective_cause)) + + END SUBROUTINE h5pget_mpio_no_collective_cause_f + +!> +!! \ingroup FH5P +!! !! \brief Set the MPI communicator and info. !! !! \param prp_id File access property list identifier. @@ -6274,5 +6315,182 @@ END SUBROUTINE h5pget_virtual_dsetname_f END SUBROUTINE h5pset_file_locking_f +!> +!! \ingroup FH5P +!! +!! \brief Retrieves the cause for not performing selection or vector I/O on the last parallel I/O call. +!! +!! \param plist_id Dataset transfer property list identifier +!! \param no_selection_io_cause A bitwise set value indicating the relevant causes that prevented selection I/O from being performed +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Pget_no_selection_io_cause() +!! + SUBROUTINE h5pget_no_selection_io_cause_f(plist_id, no_selection_io_cause, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: plist_id + INTEGER(C_INT32_T), INTENT(OUT) :: no_selection_io_cause + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5Pget_no_selection_io_cause(plist_id, no_selection_io_cause) & + BIND(C, NAME='H5Pget_no_selection_io_cause') + IMPORT :: HID_T, C_INT, C_INT32_T + IMPLICIT NONE + INTEGER(HID_T) , VALUE :: plist_id + INTEGER(C_INT32_T) :: no_selection_io_cause + END FUNCTION H5Pget_no_selection_io_cause + END INTERFACE + + hdferr = INT( H5Pget_no_selection_io_cause(plist_id, no_selection_io_cause)) + + END SUBROUTINE h5pget_no_selection_io_cause_f + + +!> +!! \ingroup FH5P +!! +!! \brief Sets the file space handling strategy and persisting free-space values for a file creation property list. +!! +!! \param plist_id File creation property list identifier +!! \param strategy The file space handling strategy to be used. See: H5F_fspace_strategy_t +!! \param persist Indicates whether free space should be persistent or not +!! \param threshold The smallest free-space section size that the free space manager will track +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Pset_file_space_strategy() +!! + SUBROUTINE H5Pset_file_space_strategy_f(plist_id, strategy, persist, threshold, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: plist_id + INTEGER(C_INT) , INTENT(IN) :: strategy + LOGICAL , INTENT(IN) :: persist + INTEGER(HSIZE_T), INTENT(IN) :: threshold + INTEGER , INTENT(OUT) :: hdferr + + LOGICAL(C_BOOL) :: c_persist + + INTERFACE + INTEGER(C_INT) FUNCTION H5Pset_file_space_strategy(plist_id, strategy, persist, threshold) & + BIND(C, NAME='H5Pset_file_space_strategy') + IMPORT :: HID_T, HSIZE_T, C_INT, C_INT32_T, C_BOOL + IMPLICIT NONE + INTEGER(HID_T) , VALUE :: plist_id + INTEGER(C_INT) , VALUE :: strategy + LOGICAL(C_BOOL) , VALUE :: persist + INTEGER(HSIZE_T), VALUE :: threshold + END FUNCTION H5Pset_file_space_strategy + END INTERFACE + + ! Transfer value of Fortran LOGICAL to C C_BOOL type + c_persist = persist + + hdferr = INT( H5Pset_file_space_strategy(plist_id, strategy, c_persist, threshold) ) + + END SUBROUTINE H5Pset_file_space_strategy_f + +!> +!! \ingroup FH5P +!! +!! \brief Gets the file space handling strategy and persisting free-space values for a file creation property list. +!! +!! \param plist_id File creation property list identifier +!! \param strategy The file space handling strategy to be used. +!! \param persist Indicate whether free space should be persistent or not +!! \param threshold The free-space section size threshold value +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Pget_file_space_strategy() +!! + SUBROUTINE h5pget_file_space_strategy_f(plist_id, strategy, persist, threshold, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: plist_id + INTEGER(C_INT) , INTENT(OUT) :: strategy + LOGICAL , INTENT(OUT) :: persist + INTEGER(HSIZE_T), INTENT(OUT) :: threshold + INTEGER , INTENT(OUT) :: hdferr + + LOGICAL(C_BOOL) :: c_persist + + INTERFACE + INTEGER(C_INT) FUNCTION H5Pget_file_space_strategy(plist_id, strategy, persist, threshold) & + BIND(C, NAME='H5Pget_file_space_strategy') + IMPORT :: HID_T, HSIZE_T, C_INT, C_INT32_T, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), VALUE :: plist_id + INTEGER(C_INT) :: strategy + LOGICAL(C_BOOL) :: persist + INTEGER(HSIZE_T) :: threshold + END FUNCTION H5Pget_file_space_strategy + END INTERFACE + + hdferr = INT( H5Pget_file_space_strategy(plist_id, strategy, c_persist, threshold) ) + + ! Transfer value of Fortran LOGICAL and C C_BOOL type + persist = .FALSE. + IF(hdferr .GE. 0) persist = c_persist + + END SUBROUTINE h5pget_file_space_strategy_f + +!> +!! \ingroup FH5P +!! +!! \brief Sets the file space page size for a file creation property list. +!! +!! \param prp_id File creation property list identifier +!! \param fsp_size File space page size +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Pset_file_space_page_size() +!! + SUBROUTINE h5pset_file_space_page_size_f(prp_id, fsp_size, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HSIZE_T), INTENT(IN) :: fsp_size + INTEGER, INTENT(OUT) :: hdferr + INTERFACE + INTEGER(C_INT) FUNCTION H5Pset_file_space_page_size(prp_id, fsp_size) & + BIND(C,NAME='H5Pset_file_space_page_size') + IMPORT :: C_INT, HID_T, HSIZE_T + IMPLICIT NONE + INTEGER(HID_T) , VALUE :: prp_id + INTEGER(HSIZE_T), VALUE :: fsp_size + END FUNCTION H5Pset_file_space_page_size + END INTERFACE + + hdferr = INT(h5pset_file_space_page_size(prp_id, fsp_size)) + + END SUBROUTINE h5pset_file_space_page_size_f + +!> +!! \ingroup FH5P +!! +!! \brief Gets the file space page size for a file creation property list. +!! +!! \param prp_id File creation property list identifier +!! \param fsp_size File space page size +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Pget_file_space_page_size() +!! + SUBROUTINE h5pget_file_space_page_size_f(prp_id, fsp_size, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HSIZE_T), INTENT(OUT) :: fsp_size + INTEGER, INTENT(OUT) :: hdferr + INTERFACE + INTEGER(C_INT) FUNCTION H5Pget_file_space_page_size(prp_id, fsp_size) & + BIND(C,NAME='H5Pget_file_space_page_size') + IMPORT :: C_INT, HID_T, HSIZE_T + IMPLICIT NONE + INTEGER(HID_T), VALUE :: prp_id + INTEGER(HSIZE_T) :: fsp_size + END FUNCTION H5Pget_file_space_page_size + END INTERFACE + + hdferr = INT(h5pget_file_space_page_size(prp_id, fsp_size)) + + END SUBROUTINE h5pget_file_space_page_size_f + END MODULE H5P diff --git a/fortran/src/H5Sff.F90 b/fortran/src/H5Sff.F90 index fff32c0..5a1ca53 100644 --- a/fortran/src/H5Sff.F90 +++ b/fortran/src/H5Sff.F90 @@ -439,6 +439,91 @@ CONTAINS !> !! \ingroup FH5S !! +!! \brief Checks if two selections are the same shape. +!! +!! \param space1_id Dataspace identifier +!! \param space2_id Dataspace identifier +!! \param same Value of check +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Sselect_shape_same() +!! + SUBROUTINE H5Sselect_shape_same_f(space1_id, space2_id, same, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space1_id + INTEGER(HID_T), INTENT(IN) :: space2_id + LOGICAL , INTENT(OUT) :: same + INTEGER , INTENT(OUT) :: hdferr + + INTEGER(C_INT) :: c_same + + INTERFACE + INTEGER(C_INT) FUNCTION H5Sselect_shape_same(space1_id, space2_id) BIND(C,NAME='H5Sselect_shape_same') + IMPORT :: C_INT, HID_T + IMPLICIT NONE + INTEGER(HID_T), VALUE :: space1_id + INTEGER(HID_T), VALUE :: space2_id + END FUNCTION H5Sselect_shape_same + END INTERFACE + + c_same = H5Sselect_shape_same(space1_id, space2_id) + + same = .FALSE. + IF(c_same .GT. 0_C_INT) same = .TRUE. + + hdferr = 0 + IF(c_same .LT. 0_C_INT) hdferr = -1 + + END SUBROUTINE H5Sselect_shape_same_f + +!> +!! \ingroup FH5S +!! +!! \brief Checks if current selection intersects with a block. +!! +!! \param space_id Dataspace identifier +!! \param istart Starting coordinate of the block +!! \param iend Opposite ("ending") coordinate of the block +!! \param intersects Dataspace intersects with the block specified +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Sselect_intersect_block() +!! + + SUBROUTINE H5Sselect_intersect_block_f(space_id, istart, iend, intersects, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: space_id + INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: istart + INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: iend + LOGICAL, INTENT(OUT) :: intersects + INTEGER, INTENT(OUT) :: hdferr + + INTEGER(C_INT) :: c_intersects + + INTERFACE + INTEGER(C_INT) FUNCTION H5Sselect_intersect_block(space_id, istart, iend) & + BIND(C,NAME='H5Sselect_intersect_block') + IMPORT :: C_INT, HID_T, HSIZE_T + IMPLICIT NONE + INTEGER(HID_T), VALUE :: space_id + INTEGER(HSIZE_T), DIMENSION(*) :: istart + INTEGER(HSIZE_T), DIMENSION(*) :: iend + END FUNCTION H5Sselect_intersect_block + END INTERFACE + + c_intersects = H5Sselect_intersect_block(space_id, istart, iend) + + intersects = .FALSE. + IF(c_intersects .GT. 0_C_INT) intersects = .TRUE. + + hdferr = 0 + IF(c_intersects .LT. 0_C_INT) hdferr = -1 + + END SUBROUTINE H5Sselect_intersect_block_f + +!> +!! \ingroup FH5S +!! !! \brief Resets the selection region to include no elements. !! !! \param space_id The identifier for the dataspace in which the selection is being reset. @@ -808,7 +893,7 @@ CONTAINS !! \param operator Flag, valid values are: !! \li H5S_SELECT_SET_F !! \li H5S_SELECT_OR_F -!! \param start Array with hyperslab offsets. +!! \param start Array with hyperslab offsets, \Bold{0-based indices}. !! \param count Number of blocks included in the hyperslab. !! \param hdferr \fortran_error !! \param stride Array with hyperslab strides. diff --git a/fortran/src/H5_buildiface.F90 b/fortran/src/H5_buildiface.F90 index 1827204..cd4580b 100644 --- a/fortran/src/H5_buildiface.F90 +++ b/fortran/src/H5_buildiface.F90 @@ -890,7 +890,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' INTEGER, INTENT(OUT) :: hdferr ' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr ' WRITE(11,'(A)') ' f_ptr = C_LOC(fillvalue)' - WRITE(11,'(A)') ' hdferr = h5pset_fill_value_c(prp_id, type_id, f_ptr)' + WRITE(11,'(A)') ' hdferr = INT(h5pset_fill_value(prp_id, type_id, f_ptr))' WRITE(11,'(A)') ' END SUBROUTINE h5pset_fill_value_kind_'//TRIM(ADJUSTL(chr2)) ENDDO @@ -912,7 +912,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' INTEGER, INTENT(OUT) :: hdferr' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' WRITE(11,'(A)') ' f_ptr = C_LOC(fillvalue)' - WRITE(11,'(A)') ' hdferr = h5pget_fill_value_c(prp_id, type_id, f_ptr)' + WRITE(11,'(A)') ' hdferr = INT(h5pget_fill_value(prp_id, type_id, f_ptr))' WRITE(11,'(A)') ' END SUBROUTINE h5pget_fill_value_kind_'//TRIM(ADJUSTL(chr2)) ENDDO diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index da2b5d9..067cd3e 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -449,6 +449,34 @@ h5init_flags_c(int_f *h5d_flags, size_t_f *h5d_size_flags, int_f *h5e_flags, hid h5d_flags[30] = (int_f)H5D_SELECTION_IO_MODE_OFF; h5d_flags[31] = (int_f)H5D_SELECTION_IO_MODE_ON; + h5d_flags[32] = H5D_MPIO_COLLECTIVE; + h5d_flags[33] = H5D_MPIO_SET_INDEPENDENT; + h5d_flags[34] = H5D_MPIO_DATATYPE_CONVERSION; + h5d_flags[35] = H5D_MPIO_DATA_TRANSFORMS; + h5d_flags[36] = H5D_MPIO_MPI_OPT_TYPES_ENV_VAR_DISABLED; + h5d_flags[37] = H5D_MPIO_NOT_SIMPLE_OR_SCALAR_DATASPACES; + h5d_flags[38] = H5D_MPIO_NOT_CONTIGUOUS_OR_CHUNKED_DATASET; + h5d_flags[39] = H5D_MPIO_PARALLEL_FILTERED_WRITES_DISABLED; + h5d_flags[40] = H5D_MPIO_ERROR_WHILE_CHECKING_COLLECTIVE_POSSIBLE; + h5d_flags[41] = H5D_MPIO_NO_SELECTION_IO; + h5d_flags[42] = H5D_MPIO_NO_COLLECTIVE_MAX_CAUSE; + + h5d_flags[43] = H5D_SEL_IO_DISABLE_BY_API; + h5d_flags[44] = H5D_SEL_IO_NOT_CONTIGUOUS_OR_CHUNKED_DATASET; + h5d_flags[45] = H5D_SEL_IO_CONTIGUOUS_SIEVE_BUFFER; + h5d_flags[46] = H5D_SEL_IO_NO_VECTOR_OR_SELECTION_IO_CB; + h5d_flags[47] = H5D_SEL_IO_PAGE_BUFFER; + h5d_flags[48] = H5D_SEL_IO_DATASET_FILTER; + h5d_flags[49] = H5D_SEL_IO_CHUNK_CACHE; + h5d_flags[50] = H5D_SEL_IO_TCONV_BUF_TOO_SMALL; + h5d_flags[51] = H5D_SEL_IO_BKG_BUF_TOO_SMALL; + h5d_flags[52] = H5D_SEL_IO_DEFAULT_OFF; + h5d_flags[53] = H5D_MPIO_NO_SELECTION_IO_CAUSES; + + h5d_flags[54] = H5D_MPIO_NO_CHUNK_OPTIMIZATION; + h5d_flags[55] = H5D_MPIO_LINK_CHUNK; + h5d_flags[56] = H5D_MPIO_MULTI_CHUNK; + /* * H5E flags */ @@ -497,10 +525,15 @@ h5init_flags_c(int_f *h5d_flags, size_t_f *h5d_size_flags, int_f *h5e_flags, hid h5f_flags[18] = (int_f)H5F_LIBVER_ERROR; h5f_flags[19] = (int_f)H5F_LIBVER_NBOUNDS; h5f_flags[20] = (int_f)H5F_UNLIMITED; - h5f_flags[21] = (int_f)H5F_LIBVER_V18; - h5f_flags[22] = (int_f)H5F_LIBVER_V110; - h5f_flags[23] = (int_f)H5F_LIBVER_V112; - h5f_flags[24] = (int_f)H5F_LIBVER_V114; + h5f_flags[21] = (int_f)H5F_FSPACE_STRATEGY_FSM_AGGR; + h5f_flags[22] = (int_f)H5F_FSPACE_STRATEGY_PAGE; + h5f_flags[23] = (int_f)H5F_FSPACE_STRATEGY_AGGR; + h5f_flags[24] = (int_f)H5F_FSPACE_STRATEGY_NONE; + h5f_flags[25] = (int_f)H5F_FSPACE_STRATEGY_NTYPES; + h5f_flags[26] = (int_f)H5F_LIBVER_V18; + h5f_flags[27] = (int_f)H5F_LIBVER_V110; + h5f_flags[28] = (int_f)H5F_LIBVER_V112; + h5f_flags[29] = (int_f)H5F_LIBVER_V114; /* * H5FD flags diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90 index 42e7058..7bd2e26 100644 --- a/fortran/src/H5_ff.F90 +++ b/fortran/src/H5_ff.F90 @@ -58,7 +58,7 @@ MODULE H5LIB ! ! H5F flags declaration ! - INTEGER, PARAMETER :: H5F_FLAGS_LEN = 25 + INTEGER, PARAMETER :: H5F_FLAGS_LEN = 30 INTEGER, DIMENSION(1:H5F_FLAGS_LEN) :: H5F_flags ! ! H5generic flags declaration @@ -76,7 +76,7 @@ MODULE H5LIB ! ! H5D flags declaration ! - INTEGER, PARAMETER :: H5D_FLAGS_LEN = 32 + INTEGER, PARAMETER :: H5D_FLAGS_LEN = 57 INTEGER, DIMENSION(1:H5D_FLAGS_LEN) :: H5D_flags INTEGER, PARAMETER :: H5D_SIZE_FLAGS_LEN = 2 INTEGER(SIZE_T), DIMENSION(1:H5D_SIZE_FLAGS_LEN) :: H5D_size_flags @@ -168,7 +168,7 @@ MODULE H5LIB INTEGER, DIMENSION(1:H5LIB_FLAGS_LEN) :: H5LIB_flags PUBLIC :: h5open_f, h5close_f, h5get_libversion_f, h5dont_atexit_f, h5kind_to_type, h5offsetof, h5gmtime - PUBLIC :: h5garbage_collect_f, h5check_version_f + PUBLIC :: h5garbage_collect_f, h5check_version_f, h5get_free_list_sizes_f CONTAINS !> @@ -350,31 +350,36 @@ CONTAINS ! ! H5F flags ! - H5F_ACC_RDWR_F = H5F_flags(1) - H5F_ACC_RDONLY_F = H5F_flags(2) - H5F_ACC_TRUNC_F = H5F_flags(3) - H5F_ACC_EXCL_F = H5F_flags(4) - H5F_ACC_DEBUG_F = H5F_flags(5) - H5F_SCOPE_LOCAL_F = H5F_flags(6) - H5F_SCOPE_GLOBAL_F = H5F_flags(7) - H5F_CLOSE_DEFAULT_F = H5F_flags(8) - H5F_CLOSE_WEAK_F = H5F_flags(9) - H5F_CLOSE_SEMI_F = H5F_flags(10) - H5F_CLOSE_STRONG_F = H5F_flags(11) - H5F_OBJ_FILE_F = H5F_flags(12) - H5F_OBJ_DATASET_F = H5F_flags(13) - H5F_OBJ_GROUP_F = H5F_flags(14) - H5F_OBJ_DATATYPE_F = H5F_flags(15) - H5F_OBJ_ALL_F = H5F_flags(16) - H5F_LIBVER_EARLIEST_F = H5F_flags(17) - H5F_LIBVER_LATEST_F = H5F_flags(18) - H5F_LIBVER_ERROR_F = H5F_flags(19) - H5F_LIBVER_NBOUNDS_F = H5F_flags(20) - H5F_UNLIMITED_F = H5F_flags(21) - H5F_LIBVER_V18_F = H5F_flags(22) - H5F_LIBVER_V110_F = H5F_flags(23) - H5F_LIBVER_V112_F = H5F_flags(24) - H5F_LIBVER_V114_F = H5F_flags(25) + H5F_ACC_RDWR_F = H5F_flags(1) + H5F_ACC_RDONLY_F = H5F_flags(2) + H5F_ACC_TRUNC_F = H5F_flags(3) + H5F_ACC_EXCL_F = H5F_flags(4) + H5F_ACC_DEBUG_F = H5F_flags(5) + H5F_SCOPE_LOCAL_F = H5F_flags(6) + H5F_SCOPE_GLOBAL_F = H5F_flags(7) + H5F_CLOSE_DEFAULT_F = H5F_flags(8) + H5F_CLOSE_WEAK_F = H5F_flags(9) + H5F_CLOSE_SEMI_F = H5F_flags(10) + H5F_CLOSE_STRONG_F = H5F_flags(11) + H5F_OBJ_FILE_F = H5F_flags(12) + H5F_OBJ_DATASET_F = H5F_flags(13) + H5F_OBJ_GROUP_F = H5F_flags(14) + H5F_OBJ_DATATYPE_F = H5F_flags(15) + H5F_OBJ_ALL_F = H5F_flags(16) + H5F_LIBVER_EARLIEST_F = H5F_flags(17) + H5F_LIBVER_LATEST_F = H5F_flags(18) + H5F_LIBVER_ERROR_F = H5F_flags(19) + H5F_LIBVER_NBOUNDS_F = H5F_flags(20) + H5F_UNLIMITED_F = H5F_flags(21) + H5F_FSPACE_STRATEGY_FSM_AGGR_F = H5F_flags(22) + H5F_FSPACE_STRATEGY_PAGE_F = H5F_flags(23) + H5F_FSPACE_STRATEGY_AGGR_F = H5F_flags(24) + H5F_FSPACE_STRATEGY_NONE_F = H5F_flags(25) + H5F_FSPACE_STRATEGY_NTYPES_F = H5F_flags(26) + H5F_LIBVER_V18_F = H5F_flags(27) + H5F_LIBVER_V110_F = H5F_flags(28) + H5F_LIBVER_V112_F = H5F_flags(29) + H5F_LIBVER_V114_F = H5F_flags(30) ! ! H5generic flags ! @@ -439,6 +444,31 @@ CONTAINS H5D_SELECTION_IO_MODE_DEFAULT_F = H5D_flags(30) H5D_SELECTION_IO_MODE_OFF_F = H5D_flags(31) H5D_SELECTION_IO_MODE_ON_F = H5D_flags(32) + H5D_MPIO_COLLECTIVE_F = H5D_flags(33) + H5D_MPIO_SET_INDEPENDENT_F = H5D_flags(34) + H5D_MPIO_DATATYPE_CONVERSION_F = H5D_flags(35) + H5D_MPIO_DATA_TRANSFORMS_F = H5D_flags(36) + H5D_MPIO_MPI_OPT_TYPES_ENV_VAR_DISABLED_F = H5D_flags(37) + H5D_MPIO_NOT_SIMPLE_OR_SCALAR_DATASPACES_F = H5D_flags(38) + H5D_MPIO_NOT_CONTIGUOUS_OR_CHUNKED_DATASET_F = H5D_flags(39) + H5D_MPIO_PARALLEL_FILTERED_WRITES_DISABLED_F = H5D_flags(40) + H5D_MPIO_ERROR_WHILE_CHECKING_COLLECTIVE_POSSIBLE_F = H5D_flags(41) + H5D_MPIO_NO_SELECTION_IO_F = H5D_flags(42) + H5D_MPIO_NO_COLLECTIVE_MAX_CAUSE_F = H5D_flags(43) + H5D_SEL_IO_DISABLE_BY_API_F = H5D_flags(44) + H5D_SEL_IO_NOT_CONTIGUOUS_OR_CHUNKED_DATASET_F = H5D_flags(45) + H5D_SEL_IO_CONTIGUOUS_SIEVE_BUFFER_F = H5D_flags(46) + H5D_SEL_IO_NO_VECTOR_OR_SELECTION_IO_CB_F = H5D_flags(47) + H5D_SEL_IO_PAGE_BUFFER_F = H5D_flags(48) + H5D_SEL_IO_DATASET_FILTER_F = H5D_flags(49) + H5D_SEL_IO_CHUNK_CACHE_F = H5D_flags(50) + H5D_SEL_IO_TCONV_BUF_TOO_SMALL_F = H5D_flags(51) + H5D_SEL_IO_BKG_BUF_TOO_SMALL_F = H5D_flags(52) + H5D_SEL_IO_DEFAULT_OFF_F = H5D_flags(53) + H5D_MPIO_NO_SELECTION_IO_CAUSES_F = H5D_flags(54) + H5D_MPIO_NO_CHUNK_OPTIMIZATION_F = H5D_flags(55) + H5D_MPIO_LINK_CHUNK_F = H5D_flags(56) + H5D_MPIO_MULTI_CHUNK_F = H5D_flags(57) H5D_CHUNK_CACHE_NSLOTS_DFLT_F = H5D_size_flags(1) H5D_CHUNK_CACHE_NBYTES_DFLT_F = H5D_size_flags(2) @@ -801,6 +831,8 @@ CONTAINS !! \param relnum Release version of the library. !! \param error \fortran_error !! +!! See C API: @ref H5get_libversion() +!! SUBROUTINE h5get_libversion_f(majnum, minnum, relnum, error) IMPLICIT NONE INTEGER, INTENT(OUT) :: majnum, minnum, relnum, error @@ -826,6 +858,8 @@ CONTAINS !! \param relnum Release version of the library. !! \param error \fortran_error !! +!! See C API: @ref H5check_version() +!! SUBROUTINE h5check_version_f(majnum, minnum, relnum, error) IMPLICIT NONE INTEGER, INTENT(IN) :: majnum, minnum, relnum @@ -848,6 +882,8 @@ CONTAINS !! !! \param error \fortran_error !! +!! See C API: @ref H5garbage_collect() +!! SUBROUTINE h5garbage_collect_f(error) IMPLICIT NONE INTEGER, INTENT(OUT) :: error @@ -867,6 +903,8 @@ CONTAINS !! !! \param error \fortran_error !! +!! See C API: @ref H5dont_atexit() +!! SUBROUTINE h5dont_atexit_f(error) IMPLICIT NONE INTEGER, INTENT(OUT) :: error @@ -882,6 +920,41 @@ CONTAINS !> !! \ingroup FH5 +!! \brief Gets the current size of the free lists used to manage memory +!! +!! \param reg_size The current size of all "regular" free list memory used +!! \param arr_size The current size of all "array" free list memory used +!! \param blk_size The current size of all "block" free list memory used +!! \param fac_size The current size of all "factory" free list memory used +!! \param error \fortran_error +!! +!! See C API: @ref H5get_free_list_sizes() +!! + SUBROUTINE h5get_free_list_sizes_f(reg_size, arr_size, blk_size, fac_size, error) + IMPLICIT NONE + INTEGER(C_SIZE_T), INTENT(OUT) :: reg_size + INTEGER(C_SIZE_T), INTENT(OUT) :: arr_size + INTEGER(C_SIZE_T), INTENT(OUT) :: blk_size + INTEGER(C_SIZE_T), INTENT(OUT) :: fac_size + INTEGER, INTENT(OUT) :: error + + INTERFACE + INTEGER(C_INT) FUNCTION H5get_free_list_sizes(reg_size, arr_size, blk_size, fac_size) BIND(C,NAME='H5get_free_list_sizes') + IMPORT :: C_INT, C_SIZE_T + IMPLICIT NONE + INTEGER(C_SIZE_T), INTENT(OUT) :: reg_size + INTEGER(C_SIZE_T), INTENT(OUT) :: arr_size + INTEGER(C_SIZE_T), INTENT(OUT) :: blk_size + INTEGER(C_SIZE_T), INTENT(OUT) :: fac_size + END FUNCTION H5get_free_list_sizes + END INTERFACE + + error = INT(H5get_free_list_sizes(reg_size, arr_size, blk_size, fac_size)) + + END SUBROUTINE h5get_free_list_sizes_f + +!> +!! \ingroup FH5 !! !! \brief Converts the KIND to the correct HDF type !! diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90 index 62b107c..e60f1e8 100644 --- a/fortran/src/H5f90global.F90 +++ b/fortran/src/H5f90global.F90 @@ -227,6 +227,11 @@ MODULE H5GLOBAL !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_V110_F !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_V112_F !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_V114_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_FSPACE_STRATEGY_FSM_AGGR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_FSPACE_STRATEGY_PAGE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_FSPACE_STRATEGY_AGGR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_FSPACE_STRATEGY_NONE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_FSPACE_STRATEGY_NTYPES_F !DEC$endif !> \addtogroup FH5F !> @{ @@ -255,6 +260,11 @@ MODULE H5GLOBAL INTEGER :: H5F_LIBVER_V110_F !< H5F_LIBVER_V110 INTEGER :: H5F_LIBVER_V112_F !< H5F_LIBVER_V112 INTEGER :: H5F_LIBVER_V114_F !< H5F_LIBVER_V114 + INTEGER :: H5F_FSPACE_STRATEGY_FSM_AGGR_F !< H5F_FSPACE_STRATEGY_FSM_AGGR + INTEGER :: H5F_FSPACE_STRATEGY_PAGE_F !< H5F_FSPACE_STRATEGY_PAGE + INTEGER :: H5F_FSPACE_STRATEGY_AGGR_F !< H5F_FSPACE_STRATEGY_AGGR + INTEGER :: H5F_FSPACE_STRATEGY_NONE_F !< H5F_FSPACE_STRATEGY_NONE + INTEGER :: H5F_FSPACE_STRATEGY_NTYPES_F !< H5F_FSPACE_STRATEGY_NTYPES !> @} ! ! H5G flags declaration @@ -330,6 +340,34 @@ MODULE H5GLOBAL !DEC$ATTRIBUTES DLLEXPORT :: H5D_SELECTION_IO_MODE_DEFAULT_F !DEC$ATTRIBUTES DLLEXPORT :: H5D_SELECTION_IO_MODE_OFF_F !DEC$ATTRIBUTES DLLEXPORT :: H5D_SELECTION_IO_MODE_ON_F + + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_COLLECTIVE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_SET_INDEPENDENT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_DATATYPE_CONVERSION_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_DATA_TRANSFORMS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_MPI_OPT_TYPES_ENV_VAR_DISABLED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_NOT_SIMPLE_OR_SCALAR_DATASPACES_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_NOT_CONTIGUOUS_OR_CHUNKED_DATASET_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_PARALLEL_FILTERED_WRITES_DISABLED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_ERROR_WHILE_CHECKING_COLLECTIVE_POSSIBLE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_NO_SELECTION_IO_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_NO_COLLECTIVE_MAX_CAUSE_F + + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SEL_IO_DISABLE_BY_API_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SEL_IO_NOT_CONTIGUOUS_OR_CHUNKED_DATASET_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SEL_IO_CONTIGUOUS_SIEVE_BUFFER_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SEL_IO_NO_VECTOR_OR_SELECTION_IO_CB_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SEL_IO_PAGE_BUFFER_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SEL_IO_DATASET_FILTER_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SEL_IO_CHUNK_CACHE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SEL_IO_TCONV_BUF_TOO_SMALL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SEL_IO_BKG_BUF_TOO_SMALL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SEL_IO_DEFAULT_OFF_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_NO_SELECTION_IO_CAUSES_F + + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_NO_CHUNK_OPTIMIZATION_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_LINK_CHUNK_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_MULTI_CHUNK_F !DEC$endif !> \addtogroup FH5D !> @{ @@ -375,9 +413,37 @@ MODULE H5GLOBAL INTEGER :: H5D_VDS_FIRST_MISSING_F !< H5D_VDS_FIRST_MISSING INTEGER :: H5D_VDS_LAST_AVAILABLE_F !< H5D_VDS_LAST_AVAILABLE INTEGER :: H5D_VIRTUAL_F !< H5D_VIRTUAL - INTEGER :: H5D_SELECTION_IO_MODE_DEFAULT_F !< H5D_SELECTION_IO_MODE_DEFAULT_F - INTEGER :: H5D_SELECTION_IO_MODE_OFF_F !< H5D_SELECTION_IO_MODE_OFF_F - INTEGER :: H5D_SELECTION_IO_MODE_ON_F !< H5D_SELECTION_IO_MODE_ON_F + INTEGER :: H5D_SELECTION_IO_MODE_DEFAULT_F !< H5D_SELECTION_IO_MODE_DEFAULT + INTEGER :: H5D_SELECTION_IO_MODE_OFF_F !< H5D_SELECTION_IO_MODE_OFF + INTEGER :: H5D_SELECTION_IO_MODE_ON_F !< H5D_SELECTION_IO_MODE_ON + + INTEGER :: H5D_MPIO_COLLECTIVE_F !< H5D_MPIO_COLLECTIVE + INTEGER :: H5D_MPIO_SET_INDEPENDENT_F !< H5D_MPIO_SET_INDEPENDENT + INTEGER :: H5D_MPIO_DATATYPE_CONVERSION_F !< H5D_MPIO_DATATYPE_CONVERSION + INTEGER :: H5D_MPIO_DATA_TRANSFORMS_F !< H5D_MPIO_DATA_TRANSFORMS + INTEGER :: H5D_MPIO_MPI_OPT_TYPES_ENV_VAR_DISABLED_F !< H5D_MPIO_MPI_OPT_TYPES_ENV_VAR_DISABLED + INTEGER :: H5D_MPIO_NOT_SIMPLE_OR_SCALAR_DATASPACES_F !< H5D_MPIO_NOT_SIMPLE_OR_SCALAR_DATASPACES + INTEGER :: H5D_MPIO_NOT_CONTIGUOUS_OR_CHUNKED_DATASET_F !< H5D_MPIO_NOT_CONTIGUOUS_OR_CHUNKED_DATASET + INTEGER :: H5D_MPIO_PARALLEL_FILTERED_WRITES_DISABLED_F !< H5D_MPIO_PARALLEL_FILTERED_WRITES_DISABLED + INTEGER :: H5D_MPIO_ERROR_WHILE_CHECKING_COLLECTIVE_POSSIBLE_F !< H5D_MPIO_ERROR_WHILE_CHECKING_COLLECTIVE_POSSIBLE + INTEGER :: H5D_MPIO_NO_SELECTION_IO_F !< H5D_MPIO_NO_SELECTION_IO + INTEGER :: H5D_MPIO_NO_COLLECTIVE_MAX_CAUSE_F !< H5D_MPIO_NO_COLLECTIVE_MAX_CAUSE + + INTEGER :: H5D_SEL_IO_DISABLE_BY_API_F !< H5D_SEL_IO_DISABLE_BY_API + INTEGER :: H5D_SEL_IO_NOT_CONTIGUOUS_OR_CHUNKED_DATASET_F !< H5D_SEL_IO_NOT_CONTIGUOUS_OR_CHUNKED_DATASET + INTEGER :: H5D_SEL_IO_CONTIGUOUS_SIEVE_BUFFER_F !< H5D_SEL_IO_CONTIGUOUS_SIEVE_BUFFER + INTEGER :: H5D_SEL_IO_NO_VECTOR_OR_SELECTION_IO_CB_F !< H5D_SEL_IO_NO_VECTOR_OR_SELECTION_IO_CB + INTEGER :: H5D_SEL_IO_PAGE_BUFFER_F !< H5D_SEL_IO_PAGE_BUFFER + INTEGER :: H5D_SEL_IO_DATASET_FILTER_F !< H5D_SEL_IO_DATASET_FILTER + INTEGER :: H5D_SEL_IO_CHUNK_CACHE_F !< H5D_SEL_IO_CHUNK_CACHE + INTEGER :: H5D_SEL_IO_TCONV_BUF_TOO_SMALL_F !< H5D_SEL_IO_TCONV_BUF_TOO_SMALL + INTEGER :: H5D_SEL_IO_BKG_BUF_TOO_SMALL_F !< H5D_SEL_IO_BKG_BUF_TOO_SMALL + INTEGER :: H5D_SEL_IO_DEFAULT_OFF_F !< H5D_SEL_IO_DEFAULT_OFF + INTEGER :: H5D_MPIO_NO_SELECTION_IO_CAUSES_F !< H5D_MPIO_NO_SELECTION_IO_CAUSES + + INTEGER :: H5D_MPIO_NO_CHUNK_OPTIMIZATION_F !< H5D_MPIO_NO_CHUNK_OPTIMIZATION + INTEGER :: H5D_MPIO_LINK_CHUNK_F !< H5D_MPIO_LINK_CHUNK + INTEGER :: H5D_MPIO_MULTI_CHUNK_F !< H5D_MPIO_MULTI_CHUNK ! ! H5E flags declaration ! diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 5b34dd6..28a4fa6 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -376,9 +376,7 @@ H5_FCDLL int_f h5pset_deflate_c(hid_t_f *prp_id, int_f *level); H5_FCDLL int_f h5pset_chunk_c(hid_t_f *prp_id, int_f *rank, hsize_t_f *dims); H5_FCDLL int_f h5pget_chunk_c(hid_t_f *prp_id, int_f *max_rank, hsize_t_f *dims); H5_FCDLL int_f h5pset_file_image_c(hid_t_f *fapl_id, void *buf_ptr, size_t_f *buf_len); -H5_FCDLL int_f h5pset_fill_value_c(hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue); H5_FCDLL int_f h5pget_file_image_c(hid_t_f *fapl_id, void **buf_ptr, size_t_f *buf_len); -H5_FCDLL int_f h5pget_fill_value_c(hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue); H5_FCDLL int_f h5pset_preserve_c(hid_t_f *prp_id, int_f *flag); H5_FCDLL int_f h5pget_preserve_c(hid_t_f *prp_id, int_f *flag); H5_FCDLL int_f h5pget_version_c(hid_t_f *prp_id, int_f *boot, int_f *freelist, int_f *stab, int_f *shhdr); diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 9e1bb2e..e6bb95a 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -9,6 +9,7 @@ H5LIB_mp_H5DONT_ATEXIT_F H5LIB_mp_H5KIND_TO_TYPE H5LIB_mp_H5OFFSETOF H5LIB_mp_H5GMTIME +H5LIB_mp_H5GET_FREE_LIST_SIZES_F ; H5A H5A_mp_H5AWRITE_CHAR_SCALAR H5A_mp_H5AREAD_CHAR_SCALAR @@ -101,6 +102,8 @@ H5D_mp_H5DREAD_MULTI_F H5D_mp_H5DWRITE_MULTI_F H5D_mp_H5DWRITE_ASYNC_F H5D_mp_H5DREAD_ASYNC_F +H5D_mp_H5DWRITE_CHUNK_F +H5D_mp_H5DREAD_CHUNK_F ; H5E H5E_mp_H5ECLEAR_F H5E_mp_H5EPRINT_F @@ -142,6 +145,7 @@ H5F_mp_H5FGET_FILESIZE_F H5F_mp_H5FGET_FILE_IMAGE_F H5F_mp_H5FGET_DSET_NO_ATTRS_HINT_F H5F_mp_H5FSET_DSET_NO_ATTRS_HINT_F +H5F_mp_H5FGET_INFO_F ; H5G H5G_mp_H5GOPEN_F H5G_mp_H5GOPEN_ASYNC_F @@ -220,6 +224,9 @@ H5L_mp_H5LGET_NAME_BY_IDX_F H5L_mp_H5LITERATE_F H5L_mp_H5LITERATE_ASYNC_F H5L_mp_H5LITERATE_BY_NAME_F +H5L_mp_H5VISIT_F +H5L_mp_H5VISIT_BY_NAME_F + ; H5O H5O_mp_H5OCLOSE_F H5O_mp_H5OCLOSE_ASYNC_F @@ -405,6 +412,11 @@ H5P_mp_H5PSET_SELECTION_IO_F H5P_mp_H5PGET_SELECTION_IO_F H5P_mp_H5PSET_MODIFY_WRITE_BUF_F H5P_mp_H5PGET_MODIFY_WRITE_BUF_F +H5P_mp_H5PGET_NO_SELECTION_IO_CAUSE_F +H5P_mp_H5PSET_FILE_SPACE_STRATEGY_F +H5P_mp_H5PGET_FILE_SPACE_STRATEGY_F +H5P_mp_H5PSET_FILE_SPACE_PAGE_SIZE_F +H5P_mp_H5PGET_FILE_SPACE_PAGE_SIZE_F ; Parallel @H5_NOPAREXP@H5P_mp_H5PSET_FAPL_MPIO_F @H5_NOPAREXP@H5P_mp_H5PGET_FAPL_MPIO_F @@ -421,6 +433,7 @@ H5P_mp_H5PGET_MODIFY_WRITE_BUF_F @H5_NOPAREXP@H5P_mp_H5PGET_ALL_COLL_METADATA_OPS_F @H5_NOPAREXP@H5P_mp_H5PSET_COLL_METADATA_WRITE_F @H5_NOPAREXP@H5P_mp_H5PGET_COLL_METADATA_WRITE_F +@H5_NOPAREXP@H5P_mp_H5PGET_MPIO_NO_COLLECTIVE_CAUSE_F ; H5R H5R_mp_H5RCREATE_OBJECT_F H5R_mp_H5RCREATE_REGION_F @@ -449,6 +462,8 @@ H5S_mp_H5SSELECT_ELEMENTS_F H5S_mp_H5SSELECT_ALL_F H5S_mp_H5SSELECT_NONE_F H5S_mp_H5SSELECT_VALID_F +H5S_mp_H5SSELECT_SHAPE_SAME_F +H5S_mp_H5SSELECT_INTERSECT_BLOCK_F H5S_mp_H5SGET_SIMPLE_EXTENT_NPOINTS_F H5S_mp_H5SGET_SELECT_NPOINTS_F H5S_mp_H5SGET_SIMPLE_EXTENT_NDIMS_F diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt index 67c8b75..ff27943 100644 --- a/fortran/test/CMakeLists.txt +++ b/fortran/test/CMakeLists.txt @@ -285,7 +285,6 @@ endif () add_executable (fortranlib_test_F03 fortranlib_test_F03.F90 tH5E_F03.F90 - tH5F_F03.F90 tH5L_F03.F90 tH5O_F03.F90 tH5P_F03.F90 diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am index 6ceddd6..6d11dcc 100644 --- a/fortran/test/Makefile.am +++ b/fortran/test/Makefile.am @@ -46,7 +46,7 @@ fortranlib_test_SOURCES = tH5F.F90 tH5D.F90 tH5R.F90 tH5S.F90 tH5T.F90 tH5VL.F90 fortranlib_test_1_8_SOURCES = tH5O.F90 tH5A_1_8.F90 tH5G_1_8.F90 tH5MISC_1_8.F90 tHDF5_1_8.F90 \ fortranlib_test_1_8.F90 -fortranlib_test_F03_SOURCES = tH5E_F03.F90 tH5F_F03.F90 tH5L_F03.F90 \ +fortranlib_test_F03_SOURCES = tH5E_F03.F90 tH5L_F03.F90 \ tH5O_F03.F90 tH5P_F03.F90 tH5T_F03.F90 tHDF5_F03.F90 fortranlib_test_F03.F90 vol_connector_SOURCES=vol_connector.F90 diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90 index eb587a9..e0a837a 100644 --- a/fortran/test/fortranlib_test.F90 +++ b/fortran/test/fortranlib_test.F90 @@ -92,6 +92,14 @@ PROGRAM fortranlibtest CALL file_space("file_space",cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' File free space test', total_error) + ret_total_error = 0 + CALL test_file_info("file_info",cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' File information test', total_error) + + ret_total_error = 0 + CALL test_get_file_image(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing get file image ', total_error) + ! ! '=========================================' ! 'Testing DATASET Interface ' @@ -114,6 +122,11 @@ PROGRAM fortranlibtest CALL test_dset_fill(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Filling dataspace elements', total_error) + ! Direct chunk IO + ret_total_error = 0 + CALL test_direct_chunk_io(cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' Direct chunk IO', total_error) + ! ! '=========================================' ! 'Testing DATASPACE Interface ' diff --git a/fortran/test/fortranlib_test_1_8.F90 b/fortran/test/fortranlib_test_1_8.F90 index fde3faa..6b3e7fa 100644 --- a/fortran/test/fortranlib_test_1_8.F90 +++ b/fortran/test/fortranlib_test_1_8.F90 @@ -103,6 +103,12 @@ PROGRAM fortranlibtest ' Testing basic generic property list class creation functionality', & total_error) + ret_total_error = 0 + CALL test_freelist(ret_total_error) + CALL write_test_status(ret_total_error, & + ' Testing free list', & + total_error) + WRITE(*,*) WRITE(*,*) ' ============================================ ' diff --git a/fortran/test/fortranlib_test_F03.F90 b/fortran/test/fortranlib_test_F03.F90 index 6c53cc0..85ab744 100644 --- a/fortran/test/fortranlib_test_F03.F90 +++ b/fortran/test/fortranlib_test_F03.F90 @@ -135,10 +135,14 @@ PROGRAM fortranlibtest_F03 CALL write_test_status(ret_total_error, ' Test basic generic property list callback functionality', total_error) ret_total_error = 0 - CALL test_iter_group(ret_total_error) + CALL test_iter_group(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Testing group iteration functionality', total_error) ret_total_error = 0 + CALL test_visit(cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' Testing link visit functionality', total_error) + + ret_total_error = 0 CALL test_nbit(ret_total_error) CALL write_test_status(ret_total_error, ' Testing nbit filter', total_error) @@ -171,10 +175,6 @@ PROGRAM fortranlibtest_F03 CALL test_obj_info(ret_total_error) CALL write_test_status(ret_total_error, ' Testing object info functions ', total_error) - ret_total_error = 0 - CALL test_get_file_image(ret_total_error) - CALL write_test_status(ret_total_error, ' Testing get file image ', total_error) - ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing VDS ' diff --git a/fortran/test/tH5D.F90 b/fortran/test/tH5D.F90 index b5ad6e8..4005c78 100644 --- a/fortran/test/tH5D.F90 +++ b/fortran/test/tH5D.F90 @@ -990,8 +990,176 @@ CONTAINS ENDIF ENDDO - END SUBROUTINE test_dset_fill + SUBROUTINE test_direct_chunk_io(cleanup, total_error) + + USE ISO_C_BINDING + + IMPLICIT NONE + + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + CHARACTER(LEN=4), PARAMETER :: filename = "doIO" + CHARACTER(LEN=80) :: fix_filename + + CHARACTER(LEN=15), PARAMETER :: dsetname = "dset" + + INTEGER :: RANK = 2 + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier + INTEGER(HID_T) :: dcpl ! dataset creation property identifier + + ! + !dataset dimensions at creation time + ! + INTEGER, PARAMETER :: DIM0 = 4 + INTEGER, PARAMETER :: DIM1 = 32 + INTEGER(SIZE_T), PARAMETER :: CHUNK0 = DIM0 + INTEGER(SIZE_T), PARAMETER :: CHUNK1 = DIM1/2 + INTEGER(HSIZE_T), DIMENSION(2) :: offset + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/DIM0,DIM1/) + INTEGER(C_INT), DIMENSION(CHUNK0,CHUNK1), TARGET :: wdata1, rdata1, wdata2, rdata2 + INTEGER(HSIZE_T), DIMENSION(2) :: chunk = (/CHUNK0, CHUNK1/) + INTEGER :: i, j, n + INTEGER :: error + TYPE(C_PTR) :: f_ptr + INTEGER(C_int32_t) :: filters + INTEGER(SIZE_T) :: sizeINT + INTEGER(HID_T) :: dxpl + + ! + !Create a new file using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + IF (error .NE. 0) THEN + WRITE(*,*) "Cannot modify filename" + STOP + ENDIF + + CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl, error) + CALL check("h5pcreate_f",error,total_error) + + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! Dataset Fortran + + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl, error) + CALL check("h5pcreate_f",error,total_error) + + CALL h5pset_chunk_f(dcpl, RANK, chunk, error) + CALL check("h5pset_chunk_f",error,total_error) + + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, dset_id, error, dcpl ) + CALL check("h5dcreate_f",error,total_error) + + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f",error,total_error) + + n = 0 + DO i = 1, CHUNK0 + DO j = 1, CHUNK1 + n = n + 1 + wdata1(i,j) = n + wdata2(i,j) = n*10 + END DO + END DO + +#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + sizeINT = storage_size(i, KIND=size_t)/storage_size(c_char_'a',c_size_t) +#else + sizeINT = SIZEOF(i) +#endif + + f_ptr = C_LOC(wdata1) + offset(1:2) = (/0, 0/) + CALL H5Dwrite_chunk_f(dset_id, 0_C_INT32_T, offset, CHUNK0 * CHUNK1 * sizeINT, f_ptr, error) + CALL check("h5dwrite_f",error,total_error) + + f_ptr = C_LOC(wdata2) + offset(1:2) = (/0, 16/) + CALL H5Dwrite_chunk_f(dset_id, 0_C_INT32_T, offset, CHUNK0 * CHUNK1 * sizeINT, f_ptr, error, dxpl) + CALL check("h5dwrite_f",error,total_error) + + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !read the data back + ! + !Open the file. + ! + CALL h5fopen_f(fix_filename, H5F_ACC_RDONLY_F, file_id, error) + CALL check("hfopen_f",error,total_error) + + ! + !Open the dataset. + ! + CALL h5dopen_f(file_id, dsetname, dset_id, error) + CALL check("h5dopen_f",error,total_error) + + f_ptr = C_LOC(rdata1) + filters = 99 + offset(1:2) = (/0, 0/) + CALL H5Dread_chunk_f(dset_id, offset, filters, f_ptr, error) + CALL check("H5Dread_chunk_f",error,total_error) + + ! Verify that the data read was correct. + DO i = 1, CHUNK0 + DO j = 1, CHUNK1 + CALL VERIFY("H5Dread_chunk_f", rdata1(i,j), wdata1(i,j), total_error) + IF(total_error.NE.0) EXIT + ENDDO + ENDDO + + CALL VERIFY("H5Dread_chunk_f",filters, 0_C_INT32_T, total_error) + + f_ptr = C_LOC(rdata2) + offset(1:2) = (/0, 16/) + CALL H5Dread_chunk_f(dset_id, offset, filters, f_ptr, error, dxpl) + CALL check("H5Dread_chunk_f",error,total_error) + + ! Verify that the data read was correct. + DO i = 1, CHUNK0 + DO j = 1, CHUNK1 + CALL VERIFY("H5Dread_chunk_f", rdata2(i,j), wdata2(i,j), total_error) + IF(total_error.NE.0) EXIT + ENDDO + ENDDO + + CALL VERIFY("H5Dread_chunk_f",filters, 0_C_INT32_T, total_error) + + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + CALL h5pclose_f(dxpl, error) + CALL check("h5pclose_f",error,total_error) + + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + RETURN + END SUBROUTINE test_direct_chunk_io + END MODULE TH5D diff --git a/fortran/test/tH5F.F90 b/fortran/test/tH5F.F90 index c255755..a5b67ac 100644 --- a/fortran/test/tH5F.F90 +++ b/fortran/test/tH5F.F90 @@ -21,7 +21,7 @@ ! ! CONTAINS SUBROUTINES ! mountingtest, reopentest, get_name_test, plisttest, -! file_close, file_space, h5openclose +! file_close, file_space, h5openclose, test_get_file_image ! !***** ! @@ -30,8 +30,17 @@ ! access the dataset from the second file as a member of a group ! in the first file. +! ***************************************** +! *** H 5 F T E S T S +! ***************************************** + MODULE TH5F + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + USE ISO_C_BINDING + CONTAINS SUBROUTINE h5openclose(total_error) @@ -131,1008 +140,1311 @@ CONTAINS RETURN END SUBROUTINE h5openclose - SUBROUTINE mountingtest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - ! - !the respective filename is "mount1.h5" and "mount2.h5" - ! - CHARACTER(LEN=6) :: filename1 - CHARACTER(LEN=6) :: filename2 - CHARACTER(LEN=80) :: fix_filename1 - CHARACTER(LEN=80) :: fix_filename2 - - ! - !data space rank and dimensions - ! - INTEGER, PARAMETER :: RANK = 2 - INTEGER, PARAMETER :: NX = 4 - INTEGER, PARAMETER :: NY = 5 - - ! - ! File identifiers - ! - INTEGER(HID_T) :: file1_id, file2_id - - ! - ! Group identifier - ! - INTEGER(HID_T) :: gid - - ! - ! dataset identifier - ! - INTEGER(HID_T) :: dset_id - - ! - ! data space identifier - ! - INTEGER(HID_T) :: dataspace - - ! - ! data type identifier - ! - INTEGER(HID_T) :: dtype_id - - ! - !The dimensions for the dataset. - ! - INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) - - ! - !return value for testing whether a file is in hdf5 format - ! - LOGICAL :: status - - ! - !flag to check operation success - ! - INTEGER :: error - - ! - !general purpose integer - ! - INTEGER :: i, j - - !number of objects - INTEGER(SIZE_T) :: obj_count - INTEGER(HID_T) :: t1, t2, t3, t4 - - ! File numbers - INTEGER :: file_num1 - INTEGER :: file_num2 - - ! - !data buffers - ! - INTEGER, DIMENSION(NX,NY) :: data_in, data_out - - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - filename1 = "mount1" - filename2 = "mount2" - - do i = 1,80 - fix_filename1(i:i) = " " - fix_filename2(i:i) = " " - enddo - ! - !Initialize data_in buffer - ! - do j = 1, NY - do i = 1, NX - data_in(i,j) = (i-1) + (j-1) - end do - end do - - ! - ! Fix names of the files - ! - CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) - if(error .ne. 0) stop - CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) - if(error .ne. 0) stop - - ! Test object counts - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t1, error) - CALL check(" h5tcopy_f",error,total_error) - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t2, error) - CALL check(" h5tcopy_f",error,total_error) - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t3, error) - CALL check(" h5tcopy_f",error,total_error) - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t4, error) - CALL check(" h5tcopy_f",error,total_error) - - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) - - IF(obj_count.NE.4)THEN - total_error = total_error + 1 - ENDIF + SUBROUTINE mountingtest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error - ! - !Create first file "mount1.h5" using default properties. - ! - CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) - CALL check("h5fcreate_f",error,total_error) + ! + ! the respective filenames are "mount1.h5" and "mount2.h5" + ! + CHARACTER(LEN=6) :: filename1 + CHARACTER(LEN=6) :: filename2 + CHARACTER(LEN=80) :: fix_filename1 + CHARACTER(LEN=80) :: fix_filename2 - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) + ! + ! data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 5 - IF(obj_count.NE.5)THEN - total_error = total_error + 1 - ENDIF + ! + ! File identifiers + ! + INTEGER(HID_T) :: file1_id, file2_id - CALL h5tclose_f(t1, error) - CALL check("h5tclose_f",error,total_error) - CALL h5tclose_f(t2, error) - CALL check("h5tclose_f",error,total_error) - CALL h5tclose_f(t3, error) - CALL check("h5tclose_f",error,total_error) - CALL h5tclose_f(t4, error) - CALL check("h5tclose_f",error,total_error) + ! + ! Group identifier + ! + INTEGER(HID_T) :: gid - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) + ! + ! dataset identifier + ! + INTEGER(HID_T) :: dset_id - IF(obj_count.NE.1)THEN - total_error = total_error + 1 - ENDIF + ! + ! data space identifier + ! + INTEGER(HID_T) :: dataspace - ! - !Create group "/G" inside file "mount1.h5". - ! - CALL h5gcreate_f(file1_id, "/G", gid, error) - CALL check("h5gcreate_f",error,total_error) - ! - !close file and group identifiers. - ! - CALL h5gclose_f(gid, error) - CALL check("h5gclose_f",error,total_error) - CALL h5fclose_f(file1_id, error) - CALL check("h5fclose_f",error,total_error) - - ! - !Create second file "mount2.h5" using default properties. - ! - CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - !Create data space for the dataset. - ! - CALL h5screate_simple_f(RANK, dims, dataspace, error) - CALL check("h5screate_simple_f",error,total_error) - - ! - !Create dataset "/D" inside file "mount2.h5". - ! - CALL h5dcreate_f(file2_id, "/D", H5T_NATIVE_INTEGER, dataspace, & - dset_id, error) - CALL check("h5dcreate_f",error,total_error) - - ! - ! Write data_in to the dataset - ! - data_dims(1) = NX - data_dims(2) = NY - CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error) - CALL check("h5dwrite_f",error,total_error) - - ! - !close file, dataset and dataspace identifiers. - ! - CALL h5sclose_f(dataspace, error) - CALL check("h5sclose_f",error,total_error) - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - CALL h5fclose_f(file2_id, error) - CALL check("h5fclose_f",error,total_error) - - ! - !test whether files are accessible as HDF5 (new, VOL-safe, way) - ! - CALL h5fis_accessible_f(fix_filename1, status, error) - CALL check("h5fis_accessible_f",error,total_error) - IF ( .NOT. status ) THEN - write(*,*) "File ", fix_filename1, " is not accessible as hdf5" - stop - END IF + ! + ! data type identifier + ! + INTEGER(HID_T) :: dtype_id - CALL h5fis_accessible_f(fix_filename2, status, error) - CALL check("h5fis_accessible_f",error,total_error) - IF ( .NOT. status ) THEN - write(*,*) "File ", fix_filename2, " is not accessible as hdf5" - stop - END IF + ! + !The dimensions for the dataset. + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) - ! - !test whether files are in hdf5 format (old way) - ! - CALL h5fis_hdf5_f(fix_filename1, status, error) - CALL check("h5fis_hdf5_f",error,total_error) - IF ( .NOT. status ) THEN - write(*,*) "File ", fix_filename1, " is not in hdf5 format" - stop - END IF + ! + !return value for testing whether a file is in hdf5 format + ! + LOGICAL :: status - CALL h5fis_hdf5_f(fix_filename2, status, error) - CALL check("h5fis_hdf5_f",error,total_error) - IF ( .NOT. status ) THEN - write(*,*) "File ", fix_filename2, " is not in hdf5 format" - stop - END IF + ! + !flag to check operation success + ! + INTEGER :: error - ! - !reopen both files. - ! - CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) - CALL check("hfopen_f",error,total_error) + ! + !general purpose integer + ! + INTEGER :: i, j - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) + !number of objects + INTEGER(SIZE_T) :: obj_count + INTEGER(HID_T) :: t1, t2, t3, t4 - IF(obj_count.NE.1)THEN - total_error = total_error + 1 - ENDIF + ! File numbers + INTEGER :: file_num1 + INTEGER :: file_num2 - CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) - CALL check("h5fopen_f",error,total_error) + ! + !data buffers + ! + INTEGER, DIMENSION(NX,NY) :: data_in, data_out - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) + INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + filename1 = "mount1" + filename2 = "mount2" - IF(obj_count.NE.2)THEN - total_error = total_error + 1 - ENDIF + do i = 1,80 + fix_filename1(i:i) = " " + fix_filename2(i:i) = " " + enddo + ! + !Initialize data_in buffer + ! + do j = 1, NY + do i = 1, NX + data_in(i,j) = (i-1) + (j-1) + end do + end do - ! - !Check file numbers - ! - CALL h5fget_fileno_f(file1_id, file_num1, error) - CALL check("h5fget_fileno_f",error,total_error) - CALL h5fget_fileno_f(file2_id, file_num2, error) - CALL check("h5fget_fileno_f",error,total_error) - IF(file_num1 .EQ. file_num2) THEN - write(*,*) "file numbers aren't supposed to match" - END IF + ! + ! Fix names of the files + ! + CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) + if(error .ne. 0) stop + CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) + if(error .ne. 0) stop + + ! Test object counts + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t1, error) + CALL check(" h5tcopy_f",error,total_error) + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t2, error) + CALL check(" h5tcopy_f",error,total_error) + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t3, error) + CALL check(" h5tcopy_f",error,total_error) + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t4, error) + CALL check(" h5tcopy_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.4)THEN + total_error = total_error + 1 + ENDIF - ! - !mount the second file under the first file's "/G" group. - ! - CALL h5fmount_f (file1_id, "/G", file2_id, error) - CALL check("h5fmount_f",error,total_error) - - - ! - !Access dataset D in the first file under /G/D name. - ! - CALL h5dopen_f(file1_id, "/G/D", dset_id, error) - CALL check("h5dopen_f",error,total_error) - - ! - !Get dataset's data type. - ! - CALL h5dget_type_f(dset_id, dtype_id, error) - CALL check("h5dget_type_f",error,total_error) - - ! - !Read the dataset. - ! - CALL h5dread_f(dset_id, dtype_id, data_out, data_dims, error) - CALL check("h5dread_f",error,total_error) - - ! - !Compare the data. - ! - do i = 1, NX - do j = 1, NY - IF (data_out(i,j) .NE. data_in(i, j)) THEN - total_error = total_error + 1 - END IF - end do - end do - - - ! - !Close dset_id and dtype_id. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - CALL h5tclose_f(dtype_id, error) - CALL check("h5tclose_f",error,total_error) - - ! - !unmount the second file. - ! - CALL h5funmount_f(file1_id, "/G", error); - CALL check("h5funmount_f",error,total_error) - - ! - !Close both files. - ! - - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) - - IF(obj_count.NE.2)THEN - total_error = total_error + 1 - ENDIF + ! + !Create first file "mount1.h5" using default properties. + ! + CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) + CALL check("h5fcreate_f",error,total_error) - CALL h5fclose_f(file1_id, error) - CALL check("h5fclose_f",error,total_error) - CALL h5fclose_f(file2_id, error) - CALL check("h5fclose_f",error,total_error) + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) + IF(obj_count.NE.5)THEN + total_error = total_error + 1 + ENDIF - IF(obj_count.NE.0)THEN - total_error = total_error + 1 - ENDIF + CALL h5tclose_f(t1, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(t2, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(t3, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(t4, error) + CALL check("h5tclose_f",error,total_error) - if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN - END SUBROUTINE mountingtest + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) -! -! The following subroutine tests h5freopen_f. -! It creates the file which has name "reopen.h5" and -! the "/dset" dataset inside the file. -! writes the data to the file, close the dataset. -! Reopen the file based upon the file_id, open the -! dataset use the reopen_id then reads the -! dataset back to memory to test whether the data -! read is identical to the data written -! + IF(obj_count.NE.1)THEN + total_error = total_error + 1 + ENDIF - SUBROUTINE reopentest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - ! - CHARACTER(LEN=6), PARAMETER :: filename = "reopen" - CHARACTER(LEN=80) :: fix_filename - - INTEGER(HID_T) :: file_id, reopen_id ! File identifiers - INTEGER(HID_T) :: dset_id ! Dataset identifier - - ! - !dataset name is "dset" - ! - CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" - - ! - !data space rank and dimensions - ! - INTEGER, PARAMETER :: RANK = 2 - INTEGER, PARAMETER :: NX = 4 - INTEGER, PARAMETER :: NY = 6 - - ! - ! data space identifier - ! - INTEGER(HID_T) :: dataspace - - ! - !The dimensions for the dataset. - ! - INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) - - ! - !flag to check operation success - ! - INTEGER :: error - - ! - !general purpose integer - ! - INTEGER :: i, j - - ! - !array to store data - ! - INTEGER, DIMENSION(4,6) :: dset_data, data_out - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - INTEGER(HSIZE_T) :: file_size - INTEGER :: file_num1 - INTEGER :: file_num2 - CHARACTER(LEN=80) :: file_name - INTEGER(SIZE_T) :: name_size - - ! - !initialize the dset_data array which will be written to the "/dset" - ! - do j = 1, NY - do i = 1, NX - dset_data(i,j) = (i-1)*6 + j; - end do - end do - - ! - !Create file "reopen.h5" using default properties. - ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - !Create data space for the dataset. - ! - CALL h5screate_simple_f(RANK, dims, dataspace, error) - CALL check("h5screate_simple_f",error,total_error) - - ! - !Create dataset "/dset" inside the file . - ! - CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, & - dset_id, error) - CALL check("h5dcreate_f",error,total_error) - - ! - !Write the dataset. - ! - data_dims(1) = NX - data_dims(2) = NY - CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) - CALL check("h5dwrite_f",error,total_error) - - ! - !close the dataset. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - - ! - !close the dataspace. - ! - CALL h5sclose_f(dataspace, error) - CALL check("h5sclose_f",error,total_error) - - ! - !Reopen file dsetf.h5. - ! - CALL h5freopen_f(file_id, reopen_id, error) - CALL check("h5freopen_f",error,total_error) - ! - !Check file size - ! - CALL h5fget_filesize_f(file_id, file_size, error) - CALL check("h5fget_filesize_f",error,total_error) - - ! - !Check file numbers - ! - CALL h5fget_fileno_f(file_id, file_num1, error) - CALL check("h5fget_fileno_f",error,total_error) - CALL h5fget_fileno_f(reopen_id, file_num2, error) - CALL check("h5fget_fileno_f",error,total_error) - IF(file_num1 .NE. file_num2) THEN - write(*,*) "file numbers don't match" - END IF - - ! - !Open the dataset based on the reopen_id. - ! - CALL h5dopen_f(reopen_id, dsetname, dset_id, error) - CALL check("h5dopen_f",error,total_error) - ! - !Get file name from the dataset identifier - ! - CALL h5fget_name_f(dset_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(file_name(1:name_size) .NE. fix_filename(1:name_size)) THEN - write(*,*) "file name obtained from the dataset id is incorrect" - END IF - - ! - !Read the dataset. - ! - CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error) - CALL check("h5dread_f",error,total_error) - - ! - !Compare the data. - ! - do i = 1, NX - do j = 1, NY - IF (data_out(i,j) .NE. dset_data(i, j)) THEN - write(*, *) "reopen test error occurred" - END IF - end do - end do - - - ! - !Close the dataset. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - - ! - !Close the file identifiers. - ! - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f",error,total_error) - CALL h5fclose_f(reopen_id, error) - CALL check("h5fclose_f",error,total_error) - - - if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN - - END SUBROUTINE reopentest - -! The following subroutine checks that h5fget_name_f produces -! correct output for a given obj_id and filename. -! - SUBROUTINE check_get_name(obj_id, fix_filename, len_filename, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - INTEGER(HID_T) :: obj_id ! Object identifier - CHARACTER(LEN=80), INTENT(IN) :: fix_filename ! Expected filename - INTEGER, INTENT(IN) :: len_filename ! The length of the filename - INTEGER, INTENT(INOUT) :: total_error ! Error count - - CHARACTER(LEN=80):: file_name ! Filename buffer - INTEGER:: error ! HDF5 error code - INTEGER(SIZE_T):: name_size ! Filename length - - INTEGER, PARAMETER :: sm_len = 2 - CHARACTER(LEN=len_filename) :: filename_exact - CHARACTER(LEN=len_filename-sm_len) :: filename_sm - - ! - !Get file name from the dataset identifier - ! - - ! Use an uninitialized buffer - CALL h5fget_name_f(obj_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. LEN_TRIM(fix_filename))THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" + ! + !Create group "/G" inside file "mount1.h5". + ! + CALL h5gcreate_f(file1_id, "/G", gid, error) + CALL check("h5gcreate_f",error,total_error) + ! + !close file and group identifiers. + ! + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f",error,total_error) + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Create second file "mount2.h5" using default properties. + ! + CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Create data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Create dataset "/D" inside file "mount2.h5". + ! + CALL h5dcreate_f(file2_id, "/D", H5T_NATIVE_INTEGER, dataspace, & + dset_id, error) + CALL check("h5dcreate_f",error,total_error) + + ! + ! Write data_in to the dataset + ! + data_dims(1) = NX + data_dims(2) = NY + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !close file, dataset and dataspace identifiers. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !test whether files are accessible as HDF5 (new, VOL-safe, way) + ! + CALL h5fis_accessible_f(fix_filename1, status, error) + CALL check("h5fis_accessible_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename1, " is not accessible as hdf5" + stop + END IF + + CALL h5fis_accessible_f(fix_filename2, status, error) + CALL check("h5fis_accessible_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename2, " is not accessible as hdf5" + stop + END IF + + ! + !test whether files are in hdf5 format (old way) + ! + CALL h5fis_hdf5_f(fix_filename1, status, error) + CALL check("h5fis_hdf5_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename1, " is not in hdf5 format" + stop + END IF + + CALL h5fis_hdf5_f(fix_filename2, status, error) + CALL check("h5fis_hdf5_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename2, " is not in hdf5 format" + stop + END IF + + ! + !reopen both files. + ! + CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) + CALL check("hfopen_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.1)THEN + total_error = total_error + 1 + ENDIF + + CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) + CALL check("h5fopen_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.2)THEN + total_error = total_error + 1 + ENDIF + + ! + !Check file numbers + ! + CALL h5fget_fileno_f(file1_id, file_num1, error) + CALL check("h5fget_fileno_f",error,total_error) + CALL h5fget_fileno_f(file2_id, file_num2, error) + CALL check("h5fget_fileno_f",error,total_error) + IF(file_num1 .EQ. file_num2) THEN + write(*,*) "file numbers aren't supposed to match" + END IF + + ! + !mount the second file under the first file's "/G" group. + ! + CALL h5fmount_f (file1_id, "/G", file2_id, error) + CALL check("h5fmount_f",error,total_error) + + + ! + !Access dataset D in the first file under /G/D name. + ! + CALL h5dopen_f(file1_id, "/G/D", dset_id, error) + CALL check("h5dopen_f",error,total_error) + + ! + !Get dataset's data type. + ! + CALL h5dget_type_f(dset_id, dtype_id, error) + CALL check("h5dget_type_f",error,total_error) + + ! + !Read the dataset. + ! + CALL h5dread_f(dset_id, dtype_id, data_out, data_dims, error) + CALL check("h5dread_f",error,total_error) + + ! + !Compare the data. + ! + do i = 1, NX + do j = 1, NY + IF (data_out(i,j) .NE. data_in(i, j)) THEN total_error = total_error + 1 END IF + end do + end do - ! Use a buffer initialized with spaces - file_name(:) = " " - CALL h5fget_name_f(obj_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. LEN_TRIM(fix_filename))THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - ! Use a buffer initialized with non-whitespace characters - file_name(:) = "a" - CALL h5fget_name_f(obj_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. LEN_TRIM(fix_filename))THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - ! Use a buffer which is the exact size needed to hold the filename - CALL h5fget_name_f(obj_id, filename_exact, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. len_filename)THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(filename_exact .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - ! Use a buffer which is smaller than needed to hold the filename - CALL h5fget_name_f(obj_id, filename_sm, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. len_filename)THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(filename_sm(1:len_filename-sm_len) .NE. fix_filename(1:len_filename-sm_len)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - END SUBROUTINE check_get_name - -! The following subroutine tests h5fget_name_f. -! It creates the file which has name "filename.h5" and -! tests that h5fget_name_f also returns the name "filename.h5" -! - SUBROUTINE get_name_test(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - CHARACTER(LEN=*), PARAMETER :: filename = "filename" - CHARACTER(LEN=80) :: fix_filename - INTEGER :: len_filename - - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: g_id ! Group identifier - - ! - ! Flag to check operation success - ! - INTEGER :: error - - ! - ! Create file "filename.h5" using default properties. - ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - IF (error .NE. 0) THEN - WRITE(*,*) "Cannot modify filename" - STOP - ENDIF - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - ! Create group. - ! - CALL h5gopen_f(file_id,"/",g_id, error) - CALL check("h5gopen_f",error,total_error) - - len_filename = LEN_TRIM(fix_filename) - CALL check_get_name(file_id, fix_filename, len_filename, total_error) - CALL check_get_name(g_id, fix_filename, len_filename, total_error) - - ! Close the group. - ! - CALL h5gclose_f(g_id, error) - CALL check("h5gclose_f",error,total_error) - - ! - ! Close the file identifiers. - ! - CALL h5fclose_f(file_id, error) + ! + !Close dset_id and dtype_id. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5tclose_f(dtype_id, error) + CALL check("h5tclose_f",error,total_error) + + ! + !unmount the second file. + ! + CALL h5funmount_f(file1_id, "/G", error); + CALL check("h5funmount_f",error,total_error) + + ! + !Close both files. + ! + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.2)THEN + total_error = total_error + 1 + ENDIF + + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.0)THEN + total_error = total_error + 1 + ENDIF + + if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN + END SUBROUTINE mountingtest + + ! + ! The following subroutine tests h5freopen_f. + ! It creates the file which has name "reopen.h5" and + ! the "/dset" dataset inside the file. + ! writes the data to the file, close the dataset. + ! Reopen the file based upon the file_id, open the + ! dataset use the reopen_id then reads the + ! dataset back to memory to test whether the data + ! read is identical to the data written + ! + + SUBROUTINE reopentest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + ! + CHARACTER(LEN=6), PARAMETER :: filename = "reopen" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: file_id, reopen_id ! File identifiers + INTEGER(HID_T) :: dset_id ! Dataset identifier + + ! + !dataset name is "dset" + ! + CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" + + ! + !data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 6 + + ! + ! data space identifier + ! + INTEGER(HID_T) :: dataspace + + ! + !The dimensions for the dataset. + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) + + ! + !flag to check operation success + ! + INTEGER :: error + + ! + !general purpose integer + ! + INTEGER :: i, j + + ! + !array to store data + ! + INTEGER, DIMENSION(4,6) :: dset_data, data_out + INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + INTEGER(HSIZE_T) :: file_size + INTEGER :: file_num1 + INTEGER :: file_num2 + CHARACTER(LEN=80) :: file_name + INTEGER(SIZE_T) :: name_size + + ! + !initialize the dset_data array which will be written to the "/dset" + ! + do j = 1, NY + do i = 1, NX + dset_data(i,j) = (i-1)*6 + j; + end do + end do + + ! + !Create file "reopen.h5" using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Create data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Create dataset "/dset" inside the file . + ! + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, & + dset_id, error) + CALL check("h5dcreate_f",error,total_error) + + ! + !Write the dataset. + ! + data_dims(1) = NX + data_dims(2) = NY + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !close the dataspace. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + + ! + !Reopen file dsetf.h5. + ! + CALL h5freopen_f(file_id, reopen_id, error) + CALL check("h5freopen_f",error,total_error) + ! + !Check file size + ! + CALL h5fget_filesize_f(file_id, file_size, error) + CALL check("h5fget_filesize_f",error,total_error) + + ! + !Check file numbers + ! + CALL h5fget_fileno_f(file_id, file_num1, error) + CALL check("h5fget_fileno_f",error,total_error) + CALL h5fget_fileno_f(reopen_id, file_num2, error) + CALL check("h5fget_fileno_f",error,total_error) + IF(file_num1 .NE. file_num2) THEN + write(*,*) "file numbers don't match" + END IF + + ! + !Open the dataset based on the reopen_id. + ! + CALL h5dopen_f(reopen_id, dsetname, dset_id, error) + CALL check("h5dopen_f",error,total_error) + ! + !Get file name from the dataset identifier + ! + CALL h5fget_name_f(dset_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(file_name(1:name_size) .NE. fix_filename(1:name_size)) THEN + write(*,*) "file name obtained from the dataset id is incorrect" + END IF + + ! + !Read the dataset. + ! + CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error) + CALL check("h5dread_f",error,total_error) + + ! + !Compare the data. + ! + do i = 1, NX + do j = 1, NY + IF (data_out(i,j) .NE. dset_data(i, j)) THEN + write(*, *) "reopen test error occurred" + END IF + end do + end do + + + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the file identifiers. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + CALL h5fclose_f(reopen_id, error) + CALL check("h5fclose_f",error,total_error) + + + if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN + + END SUBROUTINE reopentest + + ! The following subroutine checks that h5fget_name_f produces + ! correct output for a given obj_id and filename. + ! + SUBROUTINE check_get_name(obj_id, fix_filename, len_filename, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + INTEGER(HID_T) :: obj_id ! Object identifier + CHARACTER(LEN=80), INTENT(IN) :: fix_filename ! Expected filename + INTEGER, INTENT(IN) :: len_filename ! The length of the filename + INTEGER, INTENT(INOUT) :: total_error ! Error count + + CHARACTER(LEN=80):: file_name ! Filename buffer + INTEGER:: error ! HDF5 error code + INTEGER(SIZE_T):: name_size ! Filename length + + INTEGER, PARAMETER :: sm_len = 2 + CHARACTER(LEN=len_filename) :: filename_exact + CHARACTER(LEN=len_filename-sm_len) :: filename_sm + + ! + !Get file name from the dataset identifier + ! + + ! Use an uninitialized buffer + CALL h5fget_name_f(obj_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. LEN_TRIM(fix_filename))THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer initialized with spaces + file_name(:) = " " + CALL h5fget_name_f(obj_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. LEN_TRIM(fix_filename))THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer initialized with non-whitespace characters + file_name(:) = "a" + CALL h5fget_name_f(obj_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. LEN_TRIM(fix_filename))THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer which is the exact size needed to hold the filename + CALL h5fget_name_f(obj_id, filename_exact, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. len_filename)THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(filename_exact .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer which is smaller than needed to hold the filename + CALL h5fget_name_f(obj_id, filename_sm, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. len_filename)THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(filename_sm(1:len_filename-sm_len) .NE. fix_filename(1:len_filename-sm_len)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + END SUBROUTINE check_get_name + + ! The following subroutine tests h5fget_name_f. + ! It creates the file which has name "filename.h5" and + ! tests that h5fget_name_f also returns the name "filename.h5" + ! + + SUBROUTINE get_name_test(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + CHARACTER(LEN=*), PARAMETER :: filename = "filename" + CHARACTER(LEN=80) :: fix_filename + INTEGER :: len_filename + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: g_id ! Group identifier + + ! + ! Flag to check operation success + ! + INTEGER :: error + + ! + ! Create file "filename.h5" using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + IF (error .NE. 0) THEN + WRITE(*,*) "Cannot modify filename" + STOP + ENDIF + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + ! Create group. + ! + CALL h5gopen_f(file_id,"/",g_id, error) + CALL check("h5gopen_f",error,total_error) + + len_filename = LEN_TRIM(fix_filename) + CALL check_get_name(file_id, fix_filename, len_filename, total_error) + CALL check_get_name(g_id, fix_filename, len_filename, total_error) + + ! Close the group. + ! + CALL h5gclose_f(g_id, error) + CALL check("h5gclose_f",error,total_error) + + ! + ! Close the file identifiers. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN + + END SUBROUTINE get_name_test + + + ! + ! The following example demonstrates how to get creation property list, + ! and access property list. + ! We first create a file using the default creation and access property + ! list. Then, the file was closed and reopened. We then get the + ! creation and access property lists of the first file. The second file is + ! created using the got property lists + + SUBROUTINE plisttest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + ! + !file names are "plist1.h5" and "plist2.h5" + ! + CHARACTER(LEN=6), PARAMETER :: filename1 = "plist1" + CHARACTER(LEN=80) :: fix_filename1 + CHARACTER(LEN=6), PARAMETER :: filename2 = "plist2" + CHARACTER(LEN=80) :: fix_filename2 + + INTEGER(HID_T) :: file1_id, file2_id ! File identifiers + INTEGER(HID_T) :: prop_id ! File creation property list identifier + INTEGER(HID_T) :: access_id ! File Access property list identifier + + !flag to check operation success + INTEGER :: error + + ! + !Create a file1 using default properties. + ! + CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify file name" + stop + endif + CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Terminate access to the file. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Open an existing file. + ! + CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) + CALL check("h5fopen_f",error,total_error) + + ! + !get the creation property list. + ! + CALL h5fget_create_plist_f(file1_id, prop_id, error) + CALL check("h5fget_create_plist_f",error,total_error) + + ! + !get the access property list. + ! + CALL h5fget_access_plist_f(file1_id, access_id, error) + CALL check("h5fget_access_plist_f",error,total_error) + + ! + !based on the creation property list id and access property list id + !create a new file + ! + CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify file name" + stop + endif + CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error, & + prop_id, access_id) + CALL check("h5create_f",error,total_error) + + ! + !Close all the property lists. + ! + CALL h5pclose_f(prop_id, error) + CALL check("h5pclose_f",error,total_error) + CALL h5pclose_f(access_id, error) + CALL check("h5pclose_f",error,total_error) + + ! + !Terminate access to the files. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f",error,total_error) + + if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN + + END SUBROUTINE plisttest + + + ! + ! The following subroutine tests h5pget(set)_fclose_degree_f + ! + + SUBROUTINE file_close(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error + + ! + CHARACTER(LEN=10), PARAMETER :: filename = "file_close" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: fid, fid_d, fid1, fid2, fid3 ! File identifiers + INTEGER(HID_T) :: fapl, fapl1, fapl2, fapl3 ! File access identifiers + INTEGER(HID_T) :: fid_d_fapl, fid1_fapl ! File access identifiers + LOGICAL :: flag + INTEGER(SIZE_T) :: obj_count, obj_countf + INTEGER(HID_T), ALLOCATABLE, DIMENSION(:) :: obj_ids + INTEGER(SIZE_T) :: i + + CALL h5eset_auto_f(0, error) + + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error) + CALL check("h5fcreate_f",error,total_error) + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl, H5F_CLOSE_DEFAULT_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl1, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl1, H5F_CLOSE_WEAK_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl2, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl2, H5F_CLOSE_SEMI_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl3, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl3, H5F_CLOSE_STRONG_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid1, error, access_prp=fapl1) + CALL check("h5fopen_f",error,total_error) + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid_d, error, access_prp=fapl) + CALL check("h5fopen_f",error,total_error) + CALL h5fget_access_plist_f(fid1, fid1_fapl, error) + CALL check("h5fget_access_plist_f",error,total_error) + CALL h5fget_access_plist_f(fid_d, fid_d_fapl, error) + CALL check("h5fget_access_plist_f",error,total_error) + + CALL h5pequal_f(fid_d_fapl, fid1_fapl, flag, error) + CALL check("h5pequal_f",error,total_error) + if (.NOT. flag) then + write(*,*) " File access lists should be equal, error " + total_error=total_error + 1 + endif + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid2, error, access_prp=fapl2) + if( error .ne. -1) then + total_error = total_error + 1 + write(*,*) " Open with H5F_CLOSE_SEMI should fail " + endif + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid3, error, access_prp=fapl3) + if( error .ne. -1) then + total_error = total_error + 1 + write(*,*) " Open with H5F_CLOSE_STRONG should fail " + endif + + CALL h5fget_obj_count_f(fid1, H5F_OBJ_ALL_F, obj_count, error) + CALL check("h5fget_obj_count_f",error,total_error) + if(error .eq.0 .and. obj_count .ne. 3) then + total_error = total_error + 1 + write(*,*) "Wrong number of open objects reported, error" + endif + CALL h5fget_obj_count_f(fid1, H5F_OBJ_FILE_F, obj_countf, error) + CALL check("h5fget_obj_count_f",error,total_error) + if(error .eq.0 .and. obj_countf .ne. 3) then + total_error = total_error + 1 + write(*,*) "Wrong number of open objects reported, error" + endif + allocate(obj_ids(obj_countf), stat = error) + CALL h5fget_obj_ids_f(fid, H5F_OBJ_FILE_F, obj_countf, obj_ids, error) + CALL check("h5fget_obj_ids_f",error,total_error) + if(error .eq. 0) then + do i = 1, obj_countf + CALL h5fclose_f(obj_ids(i), error) CALL check("h5fclose_f",error,total_error) + enddo + endif + + CALL h5fclose_f(fid, error) + if(error .eq. 0) then + total_error = total_error + 1 + write(*,*) "File should be closed at this point, error" + endif + CALL h5fclose_f(fid1, error) + if(error .eq. 0) then + total_error = total_error + 1 + write(*,*) "File should be closed at this point, error" + endif + CALL h5fclose_f(fid_d, error) + if(error .eq. 0) then + total_error = total_error + 1 + write(*,*) "File should be closed at this point, error" + endif + + if(cleanup) then + CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + endif + deallocate(obj_ids) + RETURN - IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN + END SUBROUTINE file_close - END SUBROUTINE get_name_test + ! + ! The following subroutine tests h5fget_freespace_f + ! + SUBROUTINE file_space(filename, cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + CHARACTER(*), INTENT(IN) :: filename + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error + ! + CHARACTER(LEN=3), PARAMETER :: grpname = "grp" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: fid ! File identifiers + INTEGER(HSSIZE_T) :: free_space + INTEGER(HID_T) :: group_id ! Group identifier + + INTEGER(HID_T) :: fcpl + INTEGER(HSIZE_T), PARAMETER :: set_usrblck_size = 512 + INTEGER(HSIZE_T) :: usrblck_size + + CALL h5eset_auto_f(0, error) + + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + + CALL h5pcreate_f(H5P_FILE_CREATE_F, fcpl, error) + CALL check("h5pcreate_f",error, total_error) + + CALL H5Pset_userblock_f(fcpl, set_usrblck_size, error ) + CALL check("h5pset_userblock_f", error, total_error) + + CALL H5Pget_userblock_f(fcpl, usrblck_size, error ) + CALL check("h5pget_userblock_f", error, total_error) + + IF(usrblck_size .NE. set_usrblck_size) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong size of a user block, ", usrblck_size + ENDIF + + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error, creation_prp=fcpl ) + CALL check("h5fcreate_f",error,total_error) + + CALL h5pclose_f(fcpl, error) + CALL check("H5Pclose_f", error, total_error) + + CALL h5fget_freespace_f(fid, free_space, error) + CALL check("h5fget_freespace_f",error,total_error) + IF(error .EQ.0 .AND. free_space .NE. 1248) THEN + total_error = total_error + 1 + WRITE(*,*) "1: Wrong amount of free space reported, ", free_space + ENDIF + + ! Create group in the file. + CALL h5gcreate_f(fid, grpname, group_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! Close group + CALL h5gclose_f(group_id, error) + CALL check("h5gclose_f", error, total_error) + + ! Check the free space now + CALL h5fget_freespace_f(fid, free_space, error) + CALL check("h5fget_freespace_f",error,total_error) + IF(error .EQ.0 .AND. free_space .NE. 216) THEN + total_error = total_error + 1 + WRITE(*,*) "2: Wrong amount of free space reported, ", free_space + ENDIF + + !Unlink the group + CALL h5gunlink_f(fid, grpname, error) + CALL check("h5gunlink_f", error, total_error) + + ! Check the free space now + CALL h5fget_freespace_f(fid, free_space, error) + CALL check("h5fget_freespace_f",error,total_error) + IF(error .EQ.0 .AND. free_space .NE. 1248) THEN + total_error = total_error + 1 + WRITE(*,*) "3: Wrong amount of free space reported, ", free_space + ENDIF + + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN -! -! The following example demonstrates how to get creation property list, -! and access property list. -! We first create a file using the default creation and access property -! list. Then, the file was closed and reopened. We then get the -! creation and access property lists of the first file. The second file is -! created using the got property lists - - SUBROUTINE plisttest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - ! - !file names are "plist1.h5" and "plist2.h5" - ! - CHARACTER(LEN=6), PARAMETER :: filename1 = "plist1" - CHARACTER(LEN=80) :: fix_filename1 - CHARACTER(LEN=6), PARAMETER :: filename2 = "plist2" - CHARACTER(LEN=80) :: fix_filename2 - - INTEGER(HID_T) :: file1_id, file2_id ! File identifiers - INTEGER(HID_T) :: prop_id ! File creation property list identifier - INTEGER(HID_T) :: access_id ! File Access property list identifier - - !flag to check operation success - INTEGER :: error - - ! - !Create a file1 using default properties. - ! - CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify file name" - stop - endif - CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - !Terminate access to the file. - ! - CALL h5fclose_f(file1_id, error) - CALL check("h5fclose_f",error,total_error) - - ! - !Open an existing file. - ! - CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) - CALL check("h5fopen_f",error,total_error) - - ! - !get the creation property list. - ! - CALL h5fget_create_plist_f(file1_id, prop_id, error) - CALL check("h5fget_create_plist_f",error,total_error) - - ! - !get the access property list. - ! - CALL h5fget_access_plist_f(file1_id, access_id, error) - CALL check("h5fget_access_plist_f",error,total_error) - - ! - !based on the creation property list id and access property list id - !create a new file - ! - CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify file name" - stop - endif - CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error, & - prop_id, access_id) - CALL check("h5create_f",error,total_error) - - ! - !Close all the property lists. - ! - CALL h5pclose_f(prop_id, error) - CALL check("h5pclose_f",error,total_error) - CALL h5pclose_f(access_id, error) - CALL check("h5pclose_f",error,total_error) - - ! - !Terminate access to the files. - ! - CALL h5fclose_f(file1_id, error) - CALL check("h5fclose_f",error,total_error) - - CALL h5fclose_f(file2_id, error) - CALL check("h5fclose_f",error,total_error) - - if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN - - END SUBROUTINE plisttest + END SUBROUTINE file_space + ! + ! The following subroutine tests h5fget_info_f + ! -! -! The following subroutine tests h5pget(set)_fclose_degree_f -! + SUBROUTINE test_file_info(filename, cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + CHARACTER(*), INTENT(IN) :: filename + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error + ! + CHARACTER(LEN=3), PARAMETER :: grpname = "grp" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: fid ! File identifiers + INTEGER(HID_T) :: group_id ! Group identifier + + TYPE(H5F_INFO_T) :: file_info + INTEGER(HID_T) :: fapl, fcpl + INTEGER :: strategy + LOGICAL :: persist + INTEGER(HSIZE_T) :: threshold, fsp_size + + CALL h5eset_auto_f(0, error) + + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f",error, total_error) + + CALL h5pcreate_f(H5P_FILE_CREATE_F, fcpl, error) + CALL check("h5pcreate_f",error, total_error) + + CALL h5pset_libver_bounds_f(fapl, H5F_LIBVER_V114_F, H5F_LIBVER_V114_F, error) + CALL check("h5pset_libver_bounds_f",error, total_error) + CALL h5pset_file_space_strategy_f(fcpl, H5F_FSPACE_STRATEGY_PAGE_F, .TRUE., 4_HSIZE_T, error) + CALL check("h5pset_file_space_strategy_f",error, total_error) + + CALL h5pget_file_space_strategy_f(fcpl, strategy, persist, threshold, error) + CALL check("h5pget_file_space_strategy_f",error, total_error) + + IF(strategy .NE. H5F_FSPACE_STRATEGY_PAGE_F) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_strategy_f: wrong strategy, ",strategy + ENDIF + IF(persist .NEQV. .TRUE.) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_strategy_f: wrong persist, ",persist + ENDIF + IF(threshold .NE. 4_HSIZE_T) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_strategy_f: wrong threshold, ",threshold + ENDIF + + CALL h5pset_file_space_page_size_f(fcpl, 512_HSIZE_T, error) + CALL check("H5Pset_file_space_page_size_f",error, total_error) + + CALL h5pget_file_space_page_size_f(fcpl, fsp_size, error) + CALL check("H5Pset_file_space_page_size_f",error, total_error) + + IF(fsp_size .NE. 512_HSIZE_T) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_page_size_f: wrong size, ",fsp_size + ENDIF + + CALL h5pset_alignment_f(fapl, 1_HSIZE_T, 1024_HSIZE_T, error) + CALL check("h5pset_alignment_f",error, total_error) + + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl, creation_prp=fcpl) + CALL check("h5fcreate_f",error,total_error) + + ! Create group in the file. + CALL h5gcreate_f(fid, grpname, group_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! Close group + CALL h5gclose_f(group_id, error) + CALL check("h5gclose_f", error, total_error) + + !Unlink the group + CALL h5gunlink_f(fid, grpname, error) + CALL check("h5gunlink_f", error, total_error) + + ! Check H5Fget_info_f + CALL h5fget_info_f(fid, file_info, error) + CALL check("h5fget_info_f", error, total_error) + + IF(file_info%super%version .NE. 3) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong super%version, ",file_info%free%tot_space + ENDIF + + IF(file_info%super%super_size .NE. 48) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong super%super_size, ",file_info%free%tot_space + ENDIF + + IF(file_info%super%super_ext_size .NE. 156) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong super%super_ext_size, ",file_info%super%super_ext_size + ENDIF + + IF(file_info%free%version .NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong free%version, ",file_info%free%version + ENDIF + + IF(file_info%free%tot_space .NE. 161) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong free%tot_space, ",file_info%free%tot_space + ENDIF + + IF(file_info%sohm%version.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%version ",file_info%sohm%version + ENDIF + + IF(file_info%sohm%hdr_size.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%hdr_size ",file_info%sohm%hdr_size + ENDIF + + IF(file_info%sohm%msgs_info%heap_size.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%msgs_info%heap_size ",file_info%sohm%msgs_info%heap_size + ENDIF + + IF(file_info%sohm%msgs_info%index_size.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%msgs_info%heap_size ",file_info%sohm%msgs_info%index_size + ENDIF + + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + CALL h5pclose_f(fapl, error) + CALL check("H5Pclose_f", error, total_error) + CALL h5pclose_f(fcpl, error) + CALL check("H5Pclose_f", error, total_error) + + if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN - SUBROUTINE file_close(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - INTEGER :: error - - ! - CHARACTER(LEN=10), PARAMETER :: filename = "file_close" - CHARACTER(LEN=80) :: fix_filename - - INTEGER(HID_T) :: fid, fid_d, fid1, fid2, fid3 ! File identifiers - INTEGER(HID_T) :: fapl, fapl1, fapl2, fapl3 ! File access identifiers - INTEGER(HID_T) :: fid_d_fapl, fid1_fapl ! File access identifiers - LOGICAL :: flag - INTEGER(SIZE_T) :: obj_count, obj_countf - INTEGER(HID_T), ALLOCATABLE, DIMENSION(:) :: obj_ids - INTEGER(SIZE_T) :: i - - CALL h5eset_auto_f(0, error) - - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error) - CALL check("h5fcreate_f",error,total_error) - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl, H5F_CLOSE_DEFAULT_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl1, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl1, H5F_CLOSE_WEAK_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl2, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl2, H5F_CLOSE_SEMI_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl3, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl3, H5F_CLOSE_STRONG_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid1, error, access_prp=fapl1) - CALL check("h5fopen_f",error,total_error) - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid_d, error, access_prp=fapl) - CALL check("h5fopen_f",error,total_error) - CALL h5fget_access_plist_f(fid1, fid1_fapl, error) - CALL check("h5fget_access_plist_f",error,total_error) - CALL h5fget_access_plist_f(fid_d, fid_d_fapl, error) - CALL check("h5fget_access_plist_f",error,total_error) - - CALL h5pequal_f(fid_d_fapl, fid1_fapl, flag, error) - CALL check("h5pequal_f",error,total_error) - if (.NOT. flag) then - write(*,*) " File access lists should be equal, error " - total_error=total_error + 1 - endif - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid2, error, access_prp=fapl2) - if( error .ne. -1) then - total_error = total_error + 1 - write(*,*) " Open with H5F_CLOSE_SEMI should fail " - endif - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid3, error, access_prp=fapl3) - if( error .ne. -1) then - total_error = total_error + 1 - write(*,*) " Open with H5F_CLOSE_STRONG should fail " - endif - - CALL h5fget_obj_count_f(fid1, H5F_OBJ_ALL_F, obj_count, error) - CALL check("h5fget_obj_count_f",error,total_error) - if(error .eq.0 .and. obj_count .ne. 3) then - total_error = total_error + 1 - write(*,*) "Wrong number of open objects reported, error" - endif - CALL h5fget_obj_count_f(fid1, H5F_OBJ_FILE_F, obj_countf, error) - CALL check("h5fget_obj_count_f",error,total_error) - if(error .eq.0 .and. obj_countf .ne. 3) then - total_error = total_error + 1 - write(*,*) "Wrong number of open objects reported, error" - endif - allocate(obj_ids(obj_countf), stat = error) - CALL h5fget_obj_ids_f(fid, H5F_OBJ_FILE_F, obj_countf, obj_ids, error) - CALL check("h5fget_obj_ids_f",error,total_error) - if(error .eq. 0) then - do i = 1, obj_countf - CALL h5fclose_f(obj_ids(i), error) - CALL check("h5fclose_f",error,total_error) - enddo - endif - - CALL h5fclose_f(fid, error) - if(error .eq. 0) then - total_error = total_error + 1 - write(*,*) "File should be closed at this point, error" - endif - CALL h5fclose_f(fid1, error) - if(error .eq. 0) then - total_error = total_error + 1 - write(*,*) "File should be closed at this point, error" - endif - CALL h5fclose_f(fid_d, error) - if(error .eq. 0) then - total_error = total_error + 1 - write(*,*) "File should be closed at this point, error" - endif - - if(cleanup) then - CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - endif - deallocate(obj_ids) - RETURN - - END SUBROUTINE file_close + END SUBROUTINE test_file_info -! -! The following subroutine tests h5fget_freespace_f -! + SUBROUTINE test_get_file_image(total_error) + ! + ! Tests the wrapper for h5fget_file_image + ! + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error ! returns error + + CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: file_image_ptr ! Image from file + CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: image_ptr ! Image from h5fget_file_image_f + + INTEGER, DIMENSION(1:100), TARGET :: data ! Write data + INTEGER :: file_sz + INTEGER(size_t) :: i + INTEGER(hid_t) :: file_id = -1 ! File identifier + INTEGER(hid_t) :: dset_id = -1 ! Dataset identifier + INTEGER(hid_t) :: space_id = -1 ! Dataspace identifier + INTEGER(hsize_t), DIMENSION(1:2) :: dims ! Dataset dimensions + INTEGER(size_t) :: itmp_a ! General purpose integer + INTEGER(size_t) :: image_size ! Size of image + TYPE(C_PTR) :: f_ptr ! Pointer + INTEGER(hid_t) :: fapl ! File access property + INTEGER :: error ! Error flag + + ! Create new properties for file access + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f", error, total_error) + + ! Set standard I/O driver + CALL h5pset_fapl_stdio_f(fapl, error) + CALL check("h5pset_fapl_stdio_f", error, total_error) + + ! Create the file + CALL h5fcreate_f("tget_file_image.h5", H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) + CALL check("h5fcreate_f", error, total_error) + + ! Set up data space for new data set + dims(1:2) = (/10,10/) + + CALL h5screate_simple_f(2, dims, space_id, error) + CALL check("h5screate_simple_f", error, total_error) + + ! Create a dataset + CALL h5dcreate_f(file_id, "dset 0", H5T_NATIVE_INTEGER, space_id, dset_id, error) + CALL check("h5dcreate_f", error, total_error) + + ! Write some data to the data set + DO i = 1, 100 + data(i) = INT(i) + ENDDO + + f_ptr = C_LOC(data(1)) + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error) + CALL check("h5dwrite_f",error, total_error) + + ! Flush the file + CALL h5fflush_f(file_id, H5F_SCOPE_GLOBAL_F, error) + CALL check("h5fflush_f",error, total_error) + + ! Open the test file using standard I/O calls + OPEN(UNIT=10,FILE='tget_file_image.h5', ACCESS='STREAM') + ! Get the size of the test file + ! + ! Since we use the eoa to calculate the image size, the file size + ! may be larger. This is OK, as long as (in this specialized instance) + ! the remainder of the file is all '\0's. + ! + ! With latest mods to truncate call in core file drive, + ! file size should match image size; get the file size + INQUIRE(UNIT=10, SIZE=file_sz) + CLOSE(UNIT=10) + + ! I. Get buffer size needed to hold the buffer + + ! A. Preferred way to get the size + f_ptr = C_NULL_PTR + CALL h5fget_file_image_f(file_id, f_ptr, INT(0, size_t), error, image_size) + CALL check("h5fget_file_image_f",error, total_error) + CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) + + ! B. f_ptr set to point to an incorrect buffer, should pass anyway + f_ptr = C_LOC(data(1)) + itmp_a = 1 + CALL h5fget_file_image_f(file_id, f_ptr, itmp_a, error, image_size) + CALL check("h5fget_file_image_f",error, total_error) + CALL verify("h5fget_file_image_f", INT(itmp_a), 1, total_error) ! Routine should not change the value + CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) + + ! Allocate a buffer of the appropriate size + ALLOCATE(image_ptr(1:image_size)) + + ! Load the image of the file into the buffer + f_ptr = C_LOC(image_ptr(1)(1:1)) + CALL h5fget_file_image_f(file_id, f_ptr, image_size, error) + CALL check("h5fget_file_image_f",error, total_error) + + ! Close dset and space + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + ! Close the test file + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error, total_error) + + ! Allocate a buffer for the test file image + ALLOCATE(file_image_ptr(1:image_size)) + + ! Open the test file using standard I/O calls + OPEN(UNIT=10,FILE='tget_file_image.h5', FORM='UNFORMATTED', ACCESS='STREAM') + + ! Read the test file from disk into the buffer + DO i = 1, image_size + READ(10) file_image_ptr(i) + ENDDO + + CLOSE(10) + + ! verify the file and the image contain the same data + DO i = 1, image_size + ! convert one byte to an unsigned integer + IF( ICHAR(file_image_ptr(i)) .NE. ICHAR(image_ptr(i)))THEN + total_error = total_error + 1 + EXIT + ENDIF + ENDDO + + ! release resources + DEALLOCATE(file_image_ptr,image_ptr) - SUBROUTINE file_space(filename, cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - CHARACTER(*), INTENT(IN) :: filename - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - INTEGER :: error - ! - CHARACTER(LEN=3), PARAMETER :: grpname = "grp" - CHARACTER(LEN=80) :: fix_filename - - INTEGER(HID_T) :: fid ! File identifiers - INTEGER(HSSIZE_T) :: free_space - INTEGER(HID_T) :: group_id ! Group identifier - - CALL h5eset_auto_f(0, error) - - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error) - CALL check("h5fcreate_f",error,total_error) - - CALL h5fget_freespace_f(fid, free_space, error) - CALL check("h5fget_freespace_f",error,total_error) - if(error .eq.0 .and. free_space .ne. 1248) then - total_error = total_error + 1 - write(*,*) "1: Wrong amount of free space reported, ", free_space - endif - - ! Create group in the file. - CALL h5gcreate_f(fid, grpname, group_id, error) - CALL check("h5gcreate_f",error,total_error) - - ! Close group - CALL h5gclose_f(group_id, error) - CALL check("h5gclose_f", error, total_error) - - ! Check the free space now - CALL h5fget_freespace_f(fid, free_space, error) - CALL check("h5fget_freespace_f",error,total_error) - if(error .eq.0 .and. free_space .ne. 216) then - total_error = total_error + 1 - write(*,*) "2: Wrong amount of free space reported, ", free_space - endif - - !Unlink the group - CALL h5gunlink_f(fid, grpname, error) - CALL check("h5gunlink_f", error, total_error) - - ! Check the free space now - CALL h5fget_freespace_f(fid, free_space, error) - CALL check("h5fget_freespace_f",error,total_error) - if(error .eq.0 .and. free_space .ne. 1248) then - total_error = total_error + 1 - write(*,*) "3: Wrong amount of free space reported, ", free_space - endif - - CALL h5fclose_f(fid, error) - CALL check("h5fclose_f",error,total_error) - - if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN - - END SUBROUTINE file_space + END SUBROUTINE test_get_file_image END MODULE TH5F diff --git a/fortran/test/tH5F_F03.F90 b/fortran/test/tH5F_F03.F90 deleted file mode 100644 index 27bd30e..0000000 --- a/fortran/test/tH5F_F03.F90 +++ /dev/null @@ -1,177 +0,0 @@ -!****h* root/fortran/test/tH5F_F03 -! -! NAME -! tH5F_F03.F90 -! -! FUNCTION -! Test FORTRAN HDF5 H5F APIs which are dependent on FORTRAN 2003 -! features. -! -! COPYRIGHT -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! Copyright by The HDF Group. * -! All rights reserved. * -! * -! This file is part of HDF5. The full HDF5 copyright notice, including * -! terms governing use, modification, and redistribution, is contained in * -! the COPYING file, which can be found at the root of the source code * -! distribution tree, or in https://www.hdfgroup.org/licenses. * -! If you do not have access to either file, you may request a copy from * -! help@hdfgroup.org. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! -! NOTES -! Tests the H5F APIs functionalities of: -! h5fget_file_image_f -! -! CONTAINS SUBROUTINES -! test_get_file_image -! -!***** - -! ***************************************** -! *** H 5 F T E S T S -! ***************************************** - -MODULE TH5F_F03 - - USE HDF5 - USE TH5_MISC - USE TH5_MISC_GEN - USE ISO_C_BINDING - -CONTAINS - -SUBROUTINE test_get_file_image(total_error) - ! - ! Tests the wrapper for h5fget_file_image - ! - IMPLICIT NONE - - INTEGER, INTENT(INOUT) :: total_error ! returns error - - CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: file_image_ptr ! Image from file - CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: image_ptr ! Image from h5fget_file_image_f - - INTEGER, DIMENSION(1:100), TARGET :: data ! Write data - INTEGER :: file_sz - INTEGER(size_t) :: i - INTEGER(hid_t) :: file_id = -1 ! File identifier - INTEGER(hid_t) :: dset_id = -1 ! Dataset identifier - INTEGER(hid_t) :: space_id = -1 ! Dataspace identifier - INTEGER(hsize_t), DIMENSION(1:2) :: dims ! Dataset dimensions - INTEGER(size_t) :: itmp_a ! General purpose integer - INTEGER(size_t) :: image_size ! Size of image - TYPE(C_PTR) :: f_ptr ! Pointer - INTEGER(hid_t) :: fapl ! File access property - INTEGER :: error ! Error flag - - ! Create new properties for file access - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) - CALL check("h5pcreate_f", error, total_error) - - ! Set standard I/O driver - CALL h5pset_fapl_stdio_f(fapl, error) - CALL check("h5pset_fapl_stdio_f", error, total_error) - - ! Create the file - CALL h5fcreate_f("tget_file_image.h5", H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) - CALL check("h5fcreate_f", error, total_error) - - ! Set up data space for new data set - dims(1:2) = (/10,10/) - - CALL h5screate_simple_f(2, dims, space_id, error) - CALL check("h5screate_simple_f", error, total_error) - - ! Create a dataset - CALL h5dcreate_f(file_id, "dset 0", H5T_NATIVE_INTEGER, space_id, dset_id, error) - CALL check("h5dcreate_f", error, total_error) - - ! Write some data to the data set - DO i = 1, 100 - data(i) = INT(i) - ENDDO - - f_ptr = C_LOC(data(1)) - CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error) - CALL check("h5dwrite_f",error, total_error) - - ! Flush the file - CALL h5fflush_f(file_id, H5F_SCOPE_GLOBAL_F, error) - CALL check("h5fflush_f",error, total_error) - - ! Open the test file using standard I/O calls - OPEN(UNIT=10,FILE='tget_file_image.h5', ACCESS='STREAM') - ! Get the size of the test file - ! - ! Since we use the eoa to calculate the image size, the file size - ! may be larger. This is OK, as long as (in this specialized instance) - ! the remainder of the file is all '\0's. - ! - ! With latest mods to truncate call in core file drive, - ! file size should match image size; get the file size - INQUIRE(UNIT=10, SIZE=file_sz) - CLOSE(UNIT=10) - - ! I. Get buffer size needed to hold the buffer - - ! A. Preferred way to get the size - f_ptr = C_NULL_PTR - CALL h5fget_file_image_f(file_id, f_ptr, INT(0, size_t), error, image_size) - CALL check("h5fget_file_image_f",error, total_error) - CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) - - ! B. f_ptr set to point to an incorrect buffer, should pass anyway - f_ptr = C_LOC(data(1)) - itmp_a = 1 - CALL h5fget_file_image_f(file_id, f_ptr, itmp_a, error, image_size) - CALL check("h5fget_file_image_f",error, total_error) - CALL verify("h5fget_file_image_f", INT(itmp_a), 1, total_error) ! Routine should not change the value - CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) - - ! Allocate a buffer of the appropriate size - ALLOCATE(image_ptr(1:image_size)) - - ! Load the image of the file into the buffer - f_ptr = C_LOC(image_ptr(1)(1:1)) - CALL h5fget_file_image_f(file_id, f_ptr, image_size, error) - CALL check("h5fget_file_image_f",error, total_error) - - ! Close dset and space - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f", error, total_error) - CALL h5sclose_f(space_id, error) - CALL check("h5sclose_f", error, total_error) - ! Close the test file - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f",error, total_error) - - ! Allocate a buffer for the test file image - ALLOCATE(file_image_ptr(1:image_size)) - - ! Open the test file using standard I/O calls - OPEN(UNIT=10,FILE='tget_file_image.h5', FORM='UNFORMATTED', ACCESS='STREAM') - - ! Read the test file from disk into the buffer - DO i = 1, image_size - READ(10) file_image_ptr(i) - ENDDO - - CLOSE(10) - - ! verify the file and the image contain the same data - DO i = 1, image_size - ! convert one byte to an unsigned integer - IF( ICHAR(file_image_ptr(i)) .NE. ICHAR(image_ptr(i)))THEN - total_error = total_error + 1 - EXIT - ENDIF - ENDDO - - ! release resources - DEALLOCATE(file_image_ptr,image_ptr) - -END SUBROUTINE test_get_file_image - -END MODULE TH5F_F03 diff --git a/fortran/test/tH5L_F03.F90 b/fortran/test/tH5L_F03.F90 index e09ad5e..426e005 100644 --- a/fortran/test/tH5L_F03.F90 +++ b/fortran/test/tH5L_F03.F90 @@ -27,11 +27,21 @@ ! test_iter_group ! !***** + +MODULE EXTENTS + + IMPLICIT NONE + + INTEGER, PARAMETER :: MAX_CHAR_LEN = 30 + +END MODULE EXTENTS + MODULE liter_cb_mod USE HDF5 USE TH5_MISC USE TH5_MISC_GEN + USE EXTENTS USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE @@ -44,7 +54,7 @@ MODULE liter_cb_mod ! Custom group iteration callback data TYPE, bind(c) :: iter_info - CHARACTER(KIND=C_CHAR), DIMENSION(1:10) :: name ! The name of the object + CHARACTER(KIND=C_CHAR), DIMENSION(1:MAX_CHAR_LEN) :: name ! The name of the object INTEGER(c_int) :: TYPE ! The TYPE of the object INTEGER(c_int) :: command ! The TYPE of RETURN value END TYPE iter_info @@ -62,7 +72,7 @@ CONTAINS IMPLICIT NONE INTEGER(HID_T), VALUE :: group - CHARACTER(LEN=1), DIMENSION(1:10) :: name + CHARACTER(LEN=1), DIMENSION(1:MAX_CHAR_LEN) :: name TYPE (H5L_info_t) :: link_info @@ -72,13 +82,23 @@ CONTAINS INTEGER, SAVE :: count INTEGER, SAVE :: count2 + INTEGER :: nlen, i + liter_cb = 0 !!$ iter_info *info = (iter_info *)op_data; !!$ static int count = 0; !!$ static int count2 = 0; - - op_data%name(1:10) = name(1:10) + nlen = 0 + DO i = 1, MAX_CHAR_LEN + IF( name(i) .EQ. CHAR(0) )THEN + nlen = i - 1 + EXIT + ENDIF + ENDDO + IF(nlen.NE.0)THEN + op_data%name(1:nlen) = name(1:nlen) + ENDIF SELECT CASE (op_data%command) @@ -105,6 +125,67 @@ CONTAINS END FUNCTION liter_cb END MODULE liter_cb_mod +MODULE lvisit_cb_mod + + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + USE EXTENTS + USE, INTRINSIC :: ISO_C_BINDING + IMPLICIT NONE + + ! Custom group iteration callback data + TYPE, bind(c) :: visit_info + CHARACTER(KIND=C_CHAR), DIMENSION(1:11*MAX_CHAR_LEN) :: name ! The name of the object + INTEGER(c_int) :: TYPE ! The TYPE of the object + INTEGER(c_int) :: command ! The TYPE of RETURN value + INTEGER(c_int) :: n_obj ! The TYPE of RETURN value + END TYPE visit_info + +CONTAINS + +!*************************************************************** +!** +!** lvisit_cb(): Custom link visit callback routine. +!** +!*************************************************************** + + INTEGER(KIND=C_INT) FUNCTION lvisit_cb(group, name, link_info, op_data) bind(C) + + IMPLICIT NONE + + INTEGER(HID_T), VALUE :: group + CHARACTER(LEN=1), DIMENSION(1:MAX_CHAR_LEN) :: name + + TYPE(H5L_info_t) :: link_info + TYPE(visit_info) :: op_data + + INTEGER :: nlen, i, istart, iend + + op_data%n_obj = op_data%n_obj + 1 + + nlen = 1 + DO i = 1, MAX_CHAR_LEN + IF( name(i) .EQ. CHAR(0) )THEN + nlen = i - 1 + EXIT + ENDIF + ENDDO + IF(nlen.NE.0)THEN + istart = (op_data%n_obj-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + !PRINT*,istart, iend, name(1:nlen) + op_data%name(istart:istart+nlen-1) = name(1:nlen) + !op_data%name((op_data%n_obj-1)*MAX_CHAR_LEN)(1:nlen) = name(1:nlen) + !PRINT*,op_data%name(istart:istart+nlen) + ENDIF + + ! PRINT*,op_data%name + lvisit_cb = 0 + + END FUNCTION lvisit_cb +END MODULE lvisit_cb_mod + MODULE TH5L_F03 CONTAINS @@ -119,12 +200,14 @@ CONTAINS !** test_iter_group(): Test group iteration functionality !** !*************************************************************** -SUBROUTINE test_iter_group(total_error) +SUBROUTINE test_iter_group(cleanup, total_error) USE liter_cb_mod IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T) :: fapl INTEGER(HID_T) :: file ! File ID INTEGER(hid_t) :: dataset ! Dataset ID @@ -165,7 +248,6 @@ SUBROUTINE test_iter_group(total_error) f1 = C_FUNLOC(liter_cb) f2 = C_LOC(info) - CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, error) CALL check("H5Literate_f", error, total_error) @@ -311,6 +393,188 @@ SUBROUTINE test_iter_group(total_error) CALL H5Fclose_f(file, error) CALL check("H5Fclose_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f("titerate", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + END SUBROUTINE test_iter_group +!*************************************************************** +!** +!** Test HL visit functionality +!** +!*************************************************************** +SUBROUTINE test_visit(cleanup, total_error) + + USE lvisit_cb_mod + IMPLICIT NONE + + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T) :: fapl + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: gid, gid2 ! Group IDs + INTEGER(HID_T) :: sid ! Dataspace ID + INTEGER(HID_T) :: did ! Dataset ID + CHARACTER(LEN=11) :: DATAFILE = "tvisit.h5" + + TYPE(C_FUNPTR) :: f1 + TYPE(C_PTR) :: f2 + TYPE(visit_info), TARGET :: udata + + CHARACTER(LEN=MAX_CHAR_LEN), DIMENSION(1:11) :: obj_list + CHARACTER(LEN=MAX_CHAR_LEN) :: tmp + INTEGER :: error + INTEGER :: istart, iend, i, j + + obj_list(1) = "Dataset_zero" + obj_list(2) = "Group1" + obj_list(3) = "Group1/Dataset_one" + obj_list(4) = "Group1/Group2" + obj_list(5) = "Group1/Group2/Dataset_two" + obj_list(6) = "hard_one" + obj_list(7) = "hard_two" + obj_list(8) = "hard_zero" + obj_list(9) = "soft_dangle" + obj_list(10) = "soft_one" + obj_list(11) = "soft_two" + + fid = H5I_INVALID_HID_F + gid = H5I_INVALID_HID_F + gid2 = H5I_INVALID_HID_F + sid = H5I_INVALID_HID_F + did = H5I_INVALID_HID_F + + ! Get the default FAPL + CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f", error, total_error) + + ! Set the "use the latest version of the format" bounds for creating objects in the file + CALL H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) + CALL check("H5Pset_libver_bounds_f",error, total_error) + + ! Create the test file with the datasets + CALL h5fcreate_f(DATAFILE, H5F_ACC_TRUNC_F, fid, error, H5P_DEFAULT_F, fapl) + CALL check("h5fcreate_f", error, total_error) + + ! Create group + CALL h5gcreate_f(fid, "/Group1", gid, error) + CALL check("h5gcreate_f", error, total_error) + + ! Create nested group + CALL h5gcreate_f(gid, "Group2", gid2, error) + CALL check("h5gcreate_f", error, total_error) + + ! Close groups + CALL h5gclose_f(gid2, error) + CALL check("h5gclose_f", error, total_error) + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f", error, total_error) + + ! Create soft links to groups created + CALL h5lcreate_soft_f("/Group1", fid, "/soft_one", error) + CALL check("h5lcreate_soft_f", error, total_error) + + CALL h5lcreate_soft_f("/Group1/Group2", fid, "/soft_two", error) + CALL check("h5lcreate_soft_f", error, total_error) + + ! Create dangling soft link + CALL h5lcreate_soft_f("nowhere", fid, "/soft_dangle", error) + CALL check("h5lcreate_soft_f", error, total_error) + + ! Create hard links to all groups + CALL h5lcreate_hard_f(fid, "/", fid, "hard_zero", error) + CALL check("h5lcreate_hard_f1", error, total_error) + + CALL h5lcreate_hard_f(fid, "/Group1", fid, "hard_one", error) + CALL check("h5lcreate_hard_f2", error, total_error) + CALL h5lcreate_hard_f(fid, "/Group1/Group2", fid, "hard_two", error) + CALL check("h5lcreate_hard_f3", error, total_error) + + ! Create dataset in each group + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f", error, total_error) + + CALL h5dcreate_f(fid, "/Dataset_zero", H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f", error, total_error) + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5dcreate_f(fid, "/Group1/Dataset_one", H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f", error, total_error) + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5dcreate_f(fid, "/Group1/Group2/Dataset_two", H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f3", error, total_error) + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f", error, total_error) + + ! Test visit functions + + f1 = C_FUNLOC(lvisit_cb) + f2 = C_LOC(udata) + + udata%n_obj = 0 + udata%name(:) = " " + CALL h5lvisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, error) + CALL check("h5lvisit_f", error, total_error) + + IF(udata%n_obj.NE.11)THEN + CALL check("h5lvisit_f: Wrong number of objects visited", -1, total_error) + ENDIF + + DO i = 1, udata%n_obj + istart = (i-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + tmp = " " + DO j = 1, MAX_CHAR_LEN + IF(udata%name(istart+j-1) .NE. " ")THEN + tmp(j:j) = udata%name(istart+j-1) + ELSE + EXIT + ENDIF + ENDDO + IF( TRIM(tmp) .NE. TRIM(obj_list(i)(:)) )THEN + CALL check("h5lvisit_f: Wrong object list from visit", -1, total_error) + EXIT + ENDIF + ENDDO + + udata%n_obj = 0 + udata%name(:) = " " + CALL h5lvisit_by_name_f(fid, "/", H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, error) + CALL check("h5lvisit_by_name_f", error, total_error) + + IF(udata%n_obj.NE.11)THEN + CALL check("h5lvisit_by_name_f: Wrong number of objects visited", -1, total_error) + ENDIF + + DO i = 1, udata%n_obj + istart = (i-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + tmp = " " + DO j = 1, MAX_CHAR_LEN + IF(udata%name(istart+j-1) .NE. " ")THEN + tmp(j:j) = udata%name(istart+j-1) + ELSE + EXIT + ENDIF + ENDDO + IF( TRIM(tmp) .NE. TRIM(obj_list(i)(:)) )THEN + CALL check("h5lvisit_by_name_f: Wrong object list from visit", -1, total_error) + EXIT + ENDIF + ENDDO + + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f("tvisit", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + +END SUBROUTINE test_visit + END MODULE TH5L_F03 diff --git a/fortran/test/tH5MISC_1_8.F90 b/fortran/test/tH5MISC_1_8.F90 index 85f9634..bd3ce3f 100644 --- a/fortran/test/tH5MISC_1_8.F90 +++ b/fortran/test/tH5MISC_1_8.F90 @@ -476,4 +476,68 @@ SUBROUTINE test_scaleoffset(cleanup, total_error ) END SUBROUTINE test_scaleoffset +SUBROUTINE test_freelist(total_error) + + IMPLICIT NONE + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(hid_t) :: sid + INTEGER(hsize_t), DIMENSION(1:1) :: dims = (/8/) + INTEGER(hsize_t), DIMENSION(1:1,1:4) :: coord + INTEGER(size_t) :: reg_size_start ! Initial amount of regular memory allocated + INTEGER(size_t) :: arr_size_start ! Initial amount of array memory allocated + INTEGER(size_t) :: blk_size_start ! Initial amount of block memory allocated + INTEGER(size_t) :: fac_size_start ! Initial amount of factory memory allocated + INTEGER(size_t) :: reg_size_final ! Final amount of regular memory allocated + INTEGER(size_t) :: arr_size_final ! Final amount of array memory allocated + INTEGER(size_t) :: blk_size_final ! Final amount of BLOCK memory allocated + INTEGER(size_t) :: fac_size_final ! Final amount of factory memory allocated + INTEGER :: error + + coord(1,1:4) = (/3,4,5,6/) + + ! Create dataspace + ! (Allocates array free-list nodes) + CALL h5screate_simple_f(1, dims, sid, error) + CALL CHECK("h5screate_simple_f", error, total_error) + + ! Select sequence of 4 points + CALL h5sselect_elements_f(sid, H5S_SELECT_SET_F, 1, 4_size_t, coord, error) + CALL CHECK("h5sselect_elements_f", error, total_error) + + ! Close dataspace + CALL h5sclose_f(sid, error) + CALL CHECK("h5sclose_f", error, total_error) + + ! Retrieve initial free list values + CALL h5get_free_list_sizes_f(reg_size_start, arr_size_start, blk_size_start, fac_size_start, error) + CALL check("h5get_free_list_sizes_f", error, total_error) + + IF(reg_size_start.LT.0 .OR. & + arr_size_start.LT.0 .OR. & + blk_size_start.LT.0 .OR. & + fac_size_start.LT.0 & + )THEN + CALL check("h5get_free_list_sizes_f", -1, total_error) + ENDIF + + CALL h5garbage_collect_f(error) + CALL check("h5garbage_collect_f", error, total_error) + + ! Retrieve initial free list values + CALL h5get_free_list_sizes_f(reg_size_final, arr_size_final, blk_size_final, fac_size_final, error) + CALL check("h5get_free_list_sizes_f", error, total_error) + + ! All the free list values should be <= previous values + IF( reg_size_final .GT. reg_size_start) & + CALL check("h5get_free_list_sizes_f: reg_size_final > reg_size_start", -1, total_error) + IF( arr_size_final .GT. arr_size_start) & + CALL check("h5get_free_list_sizes_f: arr_size_final > arr_size_start", -1, total_error) + IF( blk_size_final .GT. blk_size_start) & + CALL check("h5get_free_list_sizes_f: blk_size_final > blk_size_start", -1, total_error) + IF( fac_size_final .GT. fac_size_start) & + CALL check("h5get_free_list_sizes_f: fac_size_final > fac_size_start", -1, total_error) + +END SUBROUTINE test_freelist + END MODULE TH5MISC_1_8 diff --git a/fortran/test/tH5P_F03.F90 b/fortran/test/tH5P_F03.F90 index 606a9cd..4f390d5 100644 --- a/fortran/test/tH5P_F03.F90 +++ b/fortran/test/tH5P_F03.F90 @@ -155,8 +155,6 @@ SUBROUTINE test_create(total_error) fill_ctype%a = 5555. fill_ctype%x = 55 - f_ptr = C_LOC(fill_ctype) - ! Test various fill values CALL H5Pset_fill_value_f(dcpl, H5T_NATIVE_CHARACTER, 'X', error) CALL check("H5Pset_fill_value_f",error, total_error) diff --git a/fortran/test/tH5Sselect.F90 b/fortran/test/tH5Sselect.F90 index bf1658c..6dfd7e6 100644 --- a/fortran/test/tH5Sselect.F90 +++ b/fortran/test/tH5Sselect.F90 @@ -126,7 +126,6 @@ CONTAINS INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims - ! !This writes data to the HDF5 file. ! @@ -807,6 +806,12 @@ CONTAINS INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims + LOGICAL :: same, intersects + INTEGER(HID_T) :: scalar_all_sid + + INTEGER(hsize_t), DIMENSION(1:2) :: block_start = (/0, 0/) ! Start offset for BLOCK + INTEGER(hsize_t), DIMENSION(1:2) :: block_end = (/2, 3/) ! END offset for BLOCK + ! !initialize the coord array to give the selected points' position ! @@ -848,6 +853,22 @@ CONTAINS CALL h5screate_simple_f(RANK, dimsf, dataspace, error) CALL check("h5screate_simple_f", error, total_error) + ! Check shape same API + CALL h5sselect_shape_same_f(dataspace, dataspace, same, error) + CALL check("h5sselect_shape_same_f", error, total_error) + CALL VERIFY("h5sselect_shape_same_f", same, .TRUE., total_error) + + CALL h5screate_f(H5S_SCALAR_F, scalar_all_sid, error) + CALL check("h5screate_f", error, total_error) + + same = .TRUE. + CALL h5sselect_shape_same_f(dataspace, scalar_all_sid, same, error) + CALL check("h5sselect_shape_same_f", error, total_error) + CALL VERIFY("h5sselect_shape_same_f", same, .FALSE., total_error) + + CALL h5sclose_f(scalar_all_sid,error) + CALL check("h5sclose_f", error, total_error) + ! ! Create the dataset with default properties ! @@ -863,6 +884,33 @@ CONTAINS CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, data_dims, error) CALL check("h5dwrite_f", error, total_error) + ! Set selection to 'all' + CALL h5sselect_all_f(dataspace, error) + CALL check("h5sselect_all_f", error, total_error) + + ! Test block intersection with 'all' selection (always true) + CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) + CALL check("h5sselect_intersect_block_f", error, total_error) + CALL verify("h5sselect_intersect_block_f", intersects, .TRUE., total_error) + + ! Select 2x2 region of the dataset + CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, offset, count, error) + CALL check("h5sselect_hyperslab_f", error, total_error) + + ! Check an intersecting region + block_start(1:2) = (/1,0/) + block_end(1:2) = (/2,2/) + CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) + CALL check("h5sselect_intersect_block_f", error, total_error) + CALL verify("h5sselect_intersect_block_f", intersects, .TRUE., total_error) + + ! Check a non-intersecting region + block_start(1:2) = (/2,1/) + block_end(1:2) = (/4,5/) + CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) + CALL check("h5sselect_intersect_block_f", error, total_error) + CALL verify("h5sselect_intersect_block_f2", intersects, .FALSE., total_error) + ! !Close the dataspace for the dataset. ! @@ -998,6 +1046,9 @@ CONTAINS ! DEALLOCATE(pointlist) + + + ! !Close the dataspace for the dataset. ! diff --git a/fortran/test/tHDF5_F03.F90 b/fortran/test/tHDF5_F03.F90 index dc4da31..1ef7626 100644 --- a/fortran/test/tHDF5_F03.F90 +++ b/fortran/test/tHDF5_F03.F90 @@ -28,7 +28,6 @@ MODULE THDF5_F03 USE TH5_MISC USE TH5E_F03 - USE TH5F_F03 USE TH5L_F03 USE TH5O_F03 USE TH5P_F03 diff --git a/fortran/testpar/hyper.F90 b/fortran/testpar/hyper.F90 index 8051b38..2120f48 100644 --- a/fortran/testpar/hyper.F90 +++ b/fortran/testpar/hyper.F90 @@ -51,6 +51,11 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) INTEGER :: actual_io_mode ! The type of I/O performed by this process LOGICAL :: is_coll LOGICAL :: is_coll_true = .TRUE. + + INTEGER(C_INT32_T) :: local_no_collective_cause + INTEGER(C_INT32_T) :: global_no_collective_cause + INTEGER(C_INT32_T) :: no_selection_io_cause + ! ! initialize the array data between the processes (3) ! for the 12 size array we get @@ -231,28 +236,50 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) CALL h5dwrite_f(dset_id,H5T_NATIVE_INTEGER,wbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id) CALL check("h5dwrite_f", hdferror, nerrors) - ! Check h5pget_mpio_actual_io_mode_f function CALL h5pget_mpio_actual_io_mode_f(dxpl_id, actual_io_mode, hdferror) CALL check("h5pget_mpio_actual_io_mode_f", hdferror, nerrors) -! MSB -- TODO FIX: skipping for now since multi-dataset -! has no specific path for contiguous collective -! -! IF(do_collective.AND.do_chunk)THEN -! IF(actual_io_mode.NE.H5D_MPIO_CHUNK_COLLECTIVE_F)THEN -! CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) -! ENDIF -! ELSEIF(.NOT.do_collective)THEN -! IF(actual_io_mode.NE.H5D_MPIO_NO_COLLECTIVE_F)THEN -! CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) -! ENDIF -! ELSEIF( do_collective.AND.(.NOT.do_chunk))THEN -! IF(actual_io_mode.NE.H5D_MPIO_CONTIG_COLLECTIVE_F)THEN -! CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) -! ENDIF -! ENDIF -! MSB + CALL h5pget_mpio_no_collective_cause_f(dxpl_id, local_no_collective_cause, global_no_collective_cause, hdferror) + CALL check("h5pget_mpio_no_collective_cause_f", hdferror, nerrors) + + IF(do_collective) THEN + IF(local_no_collective_cause .NE. H5D_MPIO_COLLECTIVE_F) & + CALL check("h5pget_mpio_no_collective_cause_f", -1, nerrors) + IF(global_no_collective_cause .NE. H5D_MPIO_COLLECTIVE_F) & + CALL check("h5pget_mpio_no_collective_cause_f", -1, nerrors) + ELSE + IF(local_no_collective_cause .NE. H5D_MPIO_SET_INDEPENDENT_F) & + CALL check("h5pget_mpio_no_collective_cause_f", -1, nerrors) + IF(global_no_collective_cause .NE. H5D_MPIO_SET_INDEPENDENT_F) & + CALL check("h5pget_mpio_no_collective_cause_f", -1, nerrors) + ENDIF + + IF(do_collective.AND.do_chunk)THEN + IF(actual_io_mode.NE.H5D_MPIO_CHUNK_COLLECTIVE_F)THEN + CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) + ENDIF + ELSEIF(.NOT.do_collective)THEN + IF(actual_io_mode.NE.H5D_MPIO_NO_COLLECTIVE_F)THEN + CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) + ENDIF + ELSEIF( do_collective.AND.(.NOT.do_chunk))THEN + IF(actual_io_mode.NE.H5D_MPIO_CONTIG_COLLECTIVE_F)THEN + CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) + ENDIF + ENDIF + + CALL h5pset_selection_io_f(dxpl_id, H5D_SELECTION_IO_MODE_OFF_F, hdferror) + CALL check("h5pset_selection_io_f", hdferror, nerrors) + + CALL h5dwrite_f(dset_id,H5T_NATIVE_INTEGER,wbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id) + CALL check("h5dwrite_f", hdferror, nerrors) + + CALL h5pget_no_selection_io_cause_f(dxpl_id, no_selection_io_cause, hdferror) + CALL check("h5pget_no_selection_io_cause_f", hdferror, nerrors) + + IF(no_selection_io_cause .NE. H5D_SEL_IO_DISABLE_BY_API_F) & + CALL check("h5pget_no_selection_io_cause_f", -1, nerrors) ! ! close HDF5 I/O diff --git a/hl/fortran/src/CMakeLists.txt b/hl/fortran/src/CMakeLists.txt index 0aa0f15..d9f0af2 100644 --- a/hl/fortran/src/CMakeLists.txt +++ b/hl/fortran/src/CMakeLists.txt @@ -111,6 +111,7 @@ set (HDF5_HL_F90_F_BASE_SOURCES ${HDF5_HL_F90_SRC_SOURCE_DIR}/H5TBff.F90 ${HDF5_HL_F90_SRC_SOURCE_DIR}/H5LTff.F90 ${HDF5_HL_F90_SRC_SOURCE_DIR}/H5IMff.F90 + ${HDF5_HL_F90_SRC_SOURCE_DIR}/H5DOff.F90 ) if (BUILD_STATIC_LIBS) @@ -242,6 +243,7 @@ set (mod_export_files h5lt.mod h5lt_const.mod h5im.mod + h5do.mod ) if (BUILD_STATIC_LIBS) diff --git a/hl/fortran/src/H5DOff.F90 b/hl/fortran/src/H5DOff.F90 new file mode 100644 index 0000000..df4157c --- /dev/null +++ b/hl/fortran/src/H5DOff.F90 @@ -0,0 +1,91 @@ +!> @defgroup FH5DO Fortran High Level Optimized Interface +!! +!! @see H5DO, C-HL API +!! +!! @see @ref H5DO_UG, User Guide +!! + +!> @ingroup FH5DO +!! +!! @brief This module contains Fortran interfaces for H5DO +! +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the COPYING file, which can be found at the root of the source code * +! distribution tree, or in https://www.hdfgroup.org/licenses. * +! If you do not have access to either file, you may request a copy from * +! help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! _____ __ __ _____ ____ _____ _______ _ _ _______ +! |_ _| \/ | __ \ / __ \| __ \__ __|/\ | \ | |__ __| +! **** | | | \ / | |__) | | | | |__) | | | / \ | \| | | | **** +! **** | | | |\/| | ___/| | | | _ / | | / /\ \ | . ` | | | **** +! **** _| |_| | | | | | |__| | | \ \ | |/ ____ \| |\ | | | **** +! |_____|_| |_|_| \____/|_| \_\ |_/_/ \_\_| \_| |_| +! +! If you add a new function here then you MUST add the function name to the +! Windows dll file 'hdf5_hl_fortrandll.def.in' in the hl/fortran/src directory. +! This is needed for Windows based operating systems. +! + +MODULE H5DO + + USE h5fortran_types + USE hdf5 + IMPLICIT NONE + +CONTAINS + +!> +!! \ingroup FH5DO +!! +!! \brief Appends data to a dataset along a specified dimension. +!! +!! \param dset_id Dataset identifier +!! \param dxpl_id Dataset transfer property list identifier +!! \param axis Dataset Dimension (0-based) for the append +!! \param extension Number of elements to append for the axis-th dimension +!! \param memtype The memory datatype identifier +!! \param buf Buffer with data for the append +!! \param errcode \fortran_error +!! +!! See C API: @ref H5DOappend() +!! + SUBROUTINE H5DOappend_f (dset_id, dxpl_id, axis, extension, memtype, buf, errcode) + + IMPLICIT NONE + + INTEGER(hid_t) , INTENT(IN) :: dset_id + INTEGER(hid_t) , INTENT(IN) :: dxpl_id + INTEGER , INTENT(IN) :: axis + INTEGER(SIZE_T), INTENT(IN) :: extension + INTEGER(hid_t) , INTENT(IN) :: memtype + TYPE(C_PTR) :: buf + INTEGER , INTENT(OUT) :: errcode + + INTERFACE + INTEGER(C_INT) FUNCTION H5DOappend(dset_id, dxpl_id, axis, extension, memtype, buf) & + BIND(C,NAME='H5DOappend') + + IMPORT :: C_INT, C_PTR + IMPORT :: HID_T, SIZE_T + IMPLICIT NONE + + INTEGER(hid_t) , VALUE :: dset_id + INTEGER(hid_t) , VALUE :: dxpl_id + INTEGER(C_INT) , VALUE :: axis + INTEGER(SIZE_T), VALUE :: extension + INTEGER(hid_t) , VALUE :: memtype + TYPE(C_PTR) , VALUE :: buf + END FUNCTION H5DOappend + END INTERFACE + + errcode = INT(H5DOappend(dset_id, dxpl_id, INT(axis,C_INT), extension, memtype, buf)) + + END SUBROUTINE H5DOappend_f + +END MODULE H5DO diff --git a/hl/fortran/src/Makefile.am b/hl/fortran/src/Makefile.am index 8fe618d..5834c99 100644 --- a/hl/fortran/src/Makefile.am +++ b/hl/fortran/src/Makefile.am @@ -44,7 +44,7 @@ endif # List sources to include in the HDF5 HL Fortran library. libhdf5hl_fortran_la_SOURCES=H5DSfc.c H5LTfc.c H5IMfc.c H5IMcc.c H5TBfc.c \ - H5DSff.F90 H5LTff.F90 H5TBff.F90 H5IMff.F90 H5LTff_gen.F90 H5TBff_gen.F90 + H5DSff.F90 H5LTff.F90 H5TBff.F90 H5IMff.F90 H5DOff.F90 H5LTff_gen.F90 H5TBff_gen.F90 # HDF5 HL Fortran library depends on HDF5 Library. libhdf5hl_fortran_la_LIBADD=$(LIBH5_HL) $(LIBH5F) @@ -111,6 +111,7 @@ H5DSff.lo: $(srcdir)/H5DSff.F90 H5LTff.lo: $(srcdir)/H5LTff.F90 H5IMff.lo: $(srcdir)/H5IMff.F90 H5TBff.lo: $(srcdir)/H5TBff.F90 +H5DOff.lo: $(srcdir)/H5DOff.F90 H5LTff_gen.lo: H5LTff.lo H5LTff_gen.F90 H5TBff_gen.lo: H5TBff.lo H5LTff_gen.F90 H5TBff_gen.F90 include $(top_srcdir)/config/conclude_fc.am diff --git a/hl/fortran/src/hdf5_hl_fortrandll.def.in b/hl/fortran/src/hdf5_hl_fortrandll.def.in index b48cae3..5f6d0b3 100644 --- a/hl/fortran/src/hdf5_hl_fortrandll.def.in +++ b/hl/fortran/src/hdf5_hl_fortrandll.def.in @@ -88,3 +88,5 @@ H5TB_CONST_mp_H5TBINSERT_FIELD_F_STRING H5TB_CONST_mp_H5TBDELETE_FIELD_F H5TB_CONST_mp_H5TBGET_TABLE_INFO_F H5TB_CONST_mp_H5TBGET_FIELD_INFO_F +; H5DO +H5DO_mp_H5DOAPPEND_F diff --git a/release_docs/RELEASE.txt b/release_docs/RELEASE.txt index 4e32cc7..985cbf5 100644 --- a/release_docs/RELEASE.txt +++ b/release_docs/RELEASE.txt @@ -249,6 +249,14 @@ New Features h5pset_selection_io_f, h5pget_selection_io_f h5pset_modify_write_buf_f, h5pget_modify_write_buf_f + - Added Fortran APIs: + h5get_free_list_sizes_f, h5dwrite_chunk_f, h5dread_chunk_f, + h5fget_info_f, h5lvisit_f, h5lvisit_by_name_f, + h5pget_no_selection_io_cause_f, h5pget_mpio_no_collective_cause_f, + h5sselect_shape_same_f, h5sselect_intersect_block_f, + h5pget_file_space_page_size_f, h5pset_file_space_page_size_f, + h5pget_file_space_strategy_f, h5pset_file_space_strategy_f + C++ Library: ------------ - @@ -266,7 +274,7 @@ New Features High-Level APIs: ---------------- - - + - Added Fortran HL API: h5doappend_f C Packet Table API: diff --git a/src/H5Spublic.h b/src/H5Spublic.h index 737e88b..2b6384f 100644 --- a/src/H5Spublic.h +++ b/src/H5Spublic.h @@ -1194,8 +1194,9 @@ H5_DLL herr_t H5Sselect_elements(hid_t space_id, H5S_seloper_t op, size_t num_el * 2x2 blocks of array elements starting with location (1,1) with the * selected blocks at locations (1,1), (5,1), (9,1), (1,5), (5,5), etc.; * in Fortran, they will specify a hyperslab consisting of 21 2x2 - * blocks of array elements starting with location (2,2) with the - * selected blocks at locations (2,2), (6,2), (10,2), (2,6), (6,6), etc. + * blocks of array elements starting with location (2,2), since \p start + * is 0-based indexed, with the selected blocks at + * locations (2,2), (6,2), (10,2), (2,6), (6,6), etc. * * Regions selected with this function call default to C order * iteration when I/O is performed. |