From def21b1e33f2499ed4d51af0708d12242d63fa63 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 21 Apr 2023 11:07:48 -0500 Subject: Added Fortran Async APIs (#2715) H5A, H5D, H5ES, H5G, H5F, H5L and H5O async APIs were added. --- doxygen/aliases | 4 + fortran/src/CMakeLists.txt | 4 + fortran/src/H5Af.c | 492 ------------- fortran/src/H5Aff.F90 | 1310 +++++++++++++++++++++++++++------ fortran/src/H5Df.c | 224 ------ fortran/src/H5Dff.F90 | 789 ++++++++++++++++---- fortran/src/H5ESff.F90 | 296 ++++++++ fortran/src/H5Eff.F90 | 4 +- fortran/src/H5Ff.c | 167 ----- fortran/src/H5Fff.F90 | 421 +++++++++-- fortran/src/H5Gf.c | 348 --------- fortran/src/H5Gff.F90 | 936 ++++++++++++++++++++---- fortran/src/H5Lf.c | 320 -------- fortran/src/H5Lff.F90 | 687 +++++++++++++---- fortran/src/H5Of.c | 225 +----- fortran/src/H5Off.F90 | 513 +++++++++++-- fortran/src/H5Pff.F90 | 62 +- fortran/src/H5Rff.F90 | 25 +- fortran/src/H5Sff.F90 | 14 +- fortran/src/H5Tff.F90 | 12 +- fortran/src/H5VLff.F90 | 27 +- fortran/src/H5_buildiface.F90 | 36 +- fortran/src/H5_f.c | 19 +- fortran/src/H5_ff.F90 | 29 +- fortran/src/H5config_f.inc.cmake | 6 + fortran/src/H5config_f.inc.in | 3 + fortran/src/H5f90global.F90 | 31 +- fortran/src/H5f90proto.h | 16 +- fortran/src/HDF5.F90 | 1 + fortran/src/Makefile.am | 9 +- fortran/src/hdf5_fortrandll.def.in | 52 +- fortran/test/Makefile.am | 2 +- fortran/test/tH5A_1_8.F90 | 5 + fortran/test/tH5G_1_8.F90 | 162 ++++- fortran/test/tf.F90 | 86 ++- fortran/testpar/CMakeLists.txt | 40 + fortran/testpar/Makefile.am | 3 +- fortran/testpar/async.F90 | 1417 ++++++++++++++++++++++++++++++++++++ fortran/testpar/ptest.F90 | 5 + fortran/testpar/subfiling.F90 | 14 +- release_docs/RELEASE.txt | 3 +- 41 files changed, 6152 insertions(+), 2667 deletions(-) create mode 100644 fortran/src/H5ESff.F90 create mode 100644 fortran/testpar/async.F90 diff --git a/doxygen/aliases b/doxygen/aliases index bb31325..27090e6 100644 --- a/doxygen/aliases +++ b/doxygen/aliases @@ -380,3 +380,7 @@ ALIASES += obj_info_fields="
FlagPurpose
!! \ingroup FH5A !! -!! \brief Creates a dataset as an attribute of a group, dataset, or named datatype +!! \brief Creates a dataset as an attribute of a group, dataset, or named datatype. !! !! \param loc_id Identifier of an object (group, dataset, or named datatype) attribute is attached to !! \param name Attribute name @@ -147,8 +161,8 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: attr_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: acpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: aapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: acpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: aapl_id INTEGER(HID_T) :: acpl_id_default INTEGER(HID_T) :: aapl_id_default @@ -158,6 +172,7 @@ CONTAINS space_id, acpl_id_default, aapl_id_default) BIND(C,NAME='H5Acreate2') IMPORT :: C_CHAR IMPORT :: HID_T + IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: loc_id CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name INTEGER(HID_T), INTENT(IN), VALUE :: type_id @@ -167,12 +182,13 @@ CONTAINS END FUNCTION H5Acreate2 END INTERFACE + c_name = TRIM(name)//C_NULL_CHAR + acpl_id_default = H5P_DEFAULT_F aapl_id_default = H5P_DEFAULT_F IF (PRESENT(acpl_id)) acpl_id_default = acpl_id IF (PRESENT(aapl_id)) aapl_id_default = aapl_id - c_name = TRIM(name)//C_NULL_CHAR attr_id = h5acreate2(loc_id, c_name, type_id, space_id, & acpl_id_default, aapl_id_default) @@ -184,10 +200,91 @@ CONTAINS !> !! \ingroup FH5A !! +!! \brief Asynchronously creates a dataset as an attribute of a group, dataset, or named datatype. +!! +!! \param loc_id Identifier of an object (group, dataset, or named datatype) attribute is attached to +!! \param name Attribute name +!! \param type_id Attribute datatype identifier +!! \param space_id Attribute dataspace identifier +!! \param attr_id Attribute identifier +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param acpl_id Attribute creation property list identifier +!! \param aapl_id Attribute access property list identifier +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Acreate_async() +!! + SUBROUTINE h5acreate_async_f(loc_id, name, type_id, space_id, attr_id, es_id, & + hdferr, acpl_id, aapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HID_T), INTENT(OUT) :: attr_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: acpl_id + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: aapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: acpl_id_default + INTEGER(HID_T) :: aapl_id_default + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + + INTERFACE + INTEGER(HID_T) FUNCTION H5Acreate_async(file, func, line, loc_id, name, type_id, & + space_id, acpl_id_default, aapl_id_default, es_id) BIND(C,NAME='H5Acreate_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: type_id + INTEGER(HID_T), VALUE :: space_id + INTEGER(HID_T), VALUE :: acpl_id_default + INTEGER(HID_T), VALUE :: aapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Acreate_async + END INTERFACE + + acpl_id_default = H5P_DEFAULT_F + aapl_id_default = H5P_DEFAULT_F + IF (PRESENT(acpl_id)) acpl_id_default = acpl_id + IF (PRESENT(aapl_id)) aapl_id_default = aapl_id + IF (PRESENT(file)) file_default = file + IF (PRESENT(func)) func_default = func + IF (PRESENT(line)) line_default = INT(line, C_INT) + + c_name = TRIM(name)//C_NULL_CHAR + + attr_id = h5acreate_async(file_default, func_default, line_default, & + loc_id, c_name, type_id, space_id, & + acpl_id_default, aapl_id_default, es_id) + + hdferr = 0 + IF(attr_id.LT.0) hdferr = -1 + + END SUBROUTINE h5acreate_async_f + +!> +!! \ingroup FH5A +!! !! \brief Opens an attribute specified by name. !! -!! \param obj_id Identifier of a group, dataset, or named -!! datatype attribute to be attached to +!! \param obj_id Identifier of a group, dataset, or named datatype attribute to be attached to !! \param name Attribute name !! \param attr_id Attribute identifier !! \param hdferr \fortran_error @@ -203,17 +300,6 @@ CONTAINS CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name -! H5Aopen_name is deprecated - INTERFACE - INTEGER(HID_T) FUNCTION H5Aopen(obj_id, name, aapl_id) BIND(C,NAME='H5Aopen') - IMPORT :: C_CHAR - IMPORT :: HID_T - INTEGER(HID_T), INTENT(IN), VALUE :: obj_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER(HID_T), INTENT(IN), VALUE :: aapl_id - END FUNCTION H5Aopen - END INTERFACE - c_name = TRIM(name)//C_NULL_CHAR attr_id = H5Aopen(obj_id, c_name, H5P_DEFAULT_F) @@ -221,11 +307,15 @@ CONTAINS IF(attr_id.LT.0) hdferr = -1 END SUBROUTINE H5Aopen_name_f + +#ifndef H5_NO_DEPRECATED_SYMBOLS !> !! \ingroup FH5A !! !! \brief Opens the attribute specified by its index. !! +!! \deprecation_note{H5Aopen_by_idx_f()} +!! !! \param obj_id Identifier of a group, dataset, or named datatype an attribute to be attached to !! \param index Index of the attribute to open (zero-based) !! \param attr_id Attribute identifier @@ -233,27 +323,30 @@ CONTAINS !! !! See C API: @ref H5Aopen_idx() !! - SUBROUTINE H5Aopen_idx_f(obj_id, index, attr_id, hdferr) + SUBROUTINE h5aopen_idx_f(obj_id, index, attr_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_id INTEGER, INTENT(IN) :: index INTEGER(HID_T), INTENT(OUT) :: attr_id INTEGER, INTENT(OUT) :: hdferr INTERFACE - INTEGER(HID_T) FUNCTION H5Aopen_by_idx(obj_id, index) BIND(C,NAME='H5Aopen_by_idx') + INTEGER(HID_T) FUNCTION H5Aopen_idx(obj_id, index) BIND(C,NAME='H5Aopen_idx') IMPORT :: HID_T IMPORT :: C_INT - INTEGER(HID_T), INTENT(IN) :: obj_id - INTEGER(C_INT), INTENT(IN) :: index - END FUNCTION H5Aopen_by_idx + IMPLICIT NONE + INTEGER(HID_T), VALUE :: obj_id + INTEGER(C_INT), VALUE :: index + END FUNCTION H5Aopen_idx END INTERFACE - attr_id = H5Aopen_by_idx(obj_id, INT(index, C_INT)) + attr_id = H5Aopen_idx(obj_id, INT(index, C_INT)) hdferr = 0 IF(attr_id.LT.0) hdferr = -1 - END SUBROUTINE H5Aopen_idx_f + END SUBROUTINE h5aopen_idx_f +#endif + !> !! \ingroup FH5A !! @@ -265,7 +358,7 @@ CONTAINS !! !! See C API: @ref H5Aget_space() !! - SUBROUTINE H5Aget_space_f(attr_id, space_id, hdferr) + SUBROUTINE h5aget_space_f(attr_id, space_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(OUT) :: space_id @@ -283,7 +376,7 @@ CONTAINS hdferr = 0 IF(space_id.LT.0) hdferr = -1 - END SUBROUTINE H5Aget_space_f + END SUBROUTINE h5aget_space_f !> !! \ingroup FH5A !! @@ -295,7 +388,7 @@ CONTAINS !! !! See C API: @ref H5Aget_type() !! - SUBROUTINE H5Aget_type_f(attr_id, type_id, hdferr) + SUBROUTINE h5aget_type_f(attr_id, type_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(OUT) :: type_id @@ -313,7 +406,7 @@ CONTAINS hdferr = 0 IF(type_id.LT.0) hdferr = -1 - END SUBROUTINE H5Aget_type_f + END SUBROUTINE h5aget_type_f !> !! \ingroup FH5A !! @@ -337,6 +430,7 @@ CONTAINS BIND(C,NAME='h5aget_name_c') IMPORT :: C_CHAR IMPORT :: HID_T, SIZE_T + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(SIZE_T), INTENT(IN) :: size CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: buf @@ -379,16 +473,12 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: obj_name INTEGER, INTENT(IN) :: idx_type - ! H5_INDEX_N_F - Number of indices defined - INTEGER, INTENT(IN) :: order - ! H5_ITER_NATIVE_F - No particular order, whatever is fastest - ! H5_ITER_N_F - Number of iteration orders INTEGER(HSIZE_T), INTENT(IN) :: n CHARACTER(LEN=*), INTENT(OUT) :: name INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id - INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + INTEGER(SIZE_T), INTENT(OUT), OPTIONAL :: size INTEGER(HID_T) :: lapl_id_default INTEGER(SIZE_T) :: obj_namelen INTEGER(SIZE_T) :: size_default @@ -444,6 +534,7 @@ CONTAINS INTERFACE INTEGER FUNCTION h5aget_num_attrs_c(obj_id, attr_num) BIND(C,name='h5aget_num_attrs_c') IMPORT :: HID_T + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_id INTEGER, INTENT(OUT) :: attr_num END FUNCTION h5aget_num_attrs_c @@ -464,7 +555,7 @@ CONTAINS !! !! See C API: @ref H5Adelete() !! - SUBROUTINE H5Adelete_f(obj_id, name, hdferr) + SUBROUTINE h5adelete_f(obj_id, name, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_id CHARACTER(LEN=*), INTENT(IN) :: name @@ -475,6 +566,7 @@ CONTAINS INTEGER FUNCTION H5Adelete_c(obj_id, name, namelen) BIND(C,NAME='h5adelete_c') IMPORT :: C_CHAR IMPORT :: HID_T, SIZE_T + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_id CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name INTEGER(SIZE_T) :: namelen @@ -483,7 +575,7 @@ CONTAINS namelen = LEN(name) hdferr = H5Adelete_c(obj_id, name, namelen) - END SUBROUTINE H5Adelete_f + END SUBROUTINE h5adelete_f !> !! \ingroup FH5A @@ -495,7 +587,7 @@ CONTAINS !! !! See C API: @ref H5Aclose() !! - SUBROUTINE H5Aclose_f(attr_id, hdferr) + SUBROUTINE h5aclose_f(attr_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER, INTENT(OUT) :: hdferr @@ -503,12 +595,61 @@ CONTAINS INTERFACE INTEGER FUNCTION H5Aclose(attr_id) BIND(C, NAME='H5Aclose') IMPORT :: HID_T + IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: attr_id END FUNCTION H5Aclose END INTERFACE hdferr = INT(H5Aclose(attr_id)) - END SUBROUTINE H5Aclose_f + END SUBROUTINE h5aclose_f + +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously closes the specified attribute. +!! +!! \param attr_id Attribute identifier +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Aclose_async() +!! + SUBROUTINE h5aclose_async_f(attr_id, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER FUNCTION H5Aclose_async(file, func, line, attr_id, es_id) BIND(C, NAME='H5Aclose_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: attr_id + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Aclose_async + END INTERFACE + + IF (PRESENT(file)) file_default = file + IF (PRESENT(func)) func_default = func + IF (PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = H5Aclose_async(file_default, func_default, line_default, attr_id, es_id) + + END SUBROUTINE h5aclose_async_f !> !! \ingroup FH5A @@ -521,7 +662,7 @@ CONTAINS !! !! See C API: @ref H5Aget_storage_size() !! - SUBROUTINE H5Aget_storage_size_f(attr_id, size, hdferr) + SUBROUTINE h5aget_storage_size_f(attr_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HSIZE_T), INTENT(OUT) :: size @@ -530,6 +671,7 @@ CONTAINS INTERFACE INTEGER(HSIZE_T) FUNCTION H5Aget_storage_size(attr_id) BIND(C,NAME='H5Aget_storage_size') IMPORT :: HID_T, HSIZE_T + IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: attr_id END FUNCTION H5Aget_storage_size END INTERFACE @@ -539,7 +681,7 @@ CONTAINS hdferr = 0 IF(size.LT.0) hdferr = -1 - END SUBROUTINE H5Aget_storage_size_f + END SUBROUTINE h5aget_storage_size_f !> !! \ingroup FH5A @@ -552,7 +694,7 @@ CONTAINS !! !! See C API: @ref H5Aget_create_plist() !! - SUBROUTINE H5Aget_create_plist_f(attr_id, creation_prop_id, hdferr) + SUBROUTINE h5aget_create_plist_f(attr_id, creation_prop_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(OUT) :: creation_prop_id @@ -560,6 +702,7 @@ CONTAINS INTERFACE INTEGER(HID_T) FUNCTION H5Aget_create_plist(attr_id) BIND(C,NAME='H5Aget_create_plist') IMPORT :: HID_T + IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: attr_id END FUNCTION H5Aget_create_plist END INTERFACE @@ -569,68 +712,139 @@ CONTAINS hdferr = 0 IF(creation_prop_id.LT.0) hdferr = -1 - END SUBROUTINE H5Aget_create_plist_f + END SUBROUTINE h5aget_create_plist_f !> !! \ingroup FH5A !! !! \brief Renames an attribute !! -!! \param loc_id Location or object identifier; may be dataset or group +!! \param loc_id Location or object identifier; may be dataset or group or named datatype !! \param obj_name Name of object, relative to location, whose attribute is to be renamed !! \param old_attr_name Prior attribute name !! \param new_attr_name New attribute name -!! \param lapl_id Link access property list identifier !! \param hdferr \fortran_error +!! \param lapl_id Link access property list identifier !! !! See C API: @ref H5Arename_by_name() !! - SUBROUTINE H5Arename_by_name_f(loc_id, obj_name, old_attr_name, new_attr_name, & + SUBROUTINE h5arename_by_name_f(loc_id, obj_name, old_attr_name, new_attr_name, & hdferr, lapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: obj_name CHARACTER(LEN=*), INTENT(IN) :: old_attr_name CHARACTER(LEN=*), INTENT(IN) :: new_attr_name - INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: obj_namelen - INTEGER(SIZE_T) :: old_attr_namelen - INTEGER(SIZE_T) :: new_attr_namelen + CHARACTER(LEN=LEN_TRIM(obj_name) +1,KIND=C_CHAR) :: c_obj_name + CHARACTER(LEN=LEN_TRIM(old_attr_name)+1,KIND=C_CHAR) :: c_old_attr_name + CHARACTER(LEN=LEN_TRIM(new_attr_name)+1,KIND=C_CHAR) :: c_new_attr_name INTERFACE - INTEGER FUNCTION H5Arename_by_name_c(loc_id, obj_name, obj_namelen, & - old_attr_name, old_attr_namelen, new_attr_name, new_attr_namelen, & - lapl_id_default) BIND(C,NAME='h5arename_by_name_c') + INTEGER FUNCTION H5Arename_by_name(loc_id, obj_name, & + old_attr_name, new_attr_name, lapl_id_default) & + BIND(C,NAME='H5Arename_by_name') IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T + IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: obj_name - INTEGER(SIZE_T) :: obj_namelen - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: old_attr_name - INTEGER(SIZE_T) :: old_attr_namelen - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: new_attr_name - INTEGER(SIZE_T) :: new_attr_namelen - INTEGER(HID_T) :: lapl_id_default + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: old_attr_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: new_attr_name + INTEGER(HID_T), VALUE :: lapl_id_default - END FUNCTION H5Arename_by_name_c + END FUNCTION H5Arename_by_name END INTERFACE - obj_namelen = LEN(obj_name) - old_attr_namelen = LEN(old_attr_name) - new_attr_namelen = LEN(new_attr_name) + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + c_old_attr_name = TRIM(old_attr_name)//C_NULL_CHAR + c_new_attr_name = TRIM(new_attr_name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default=lapl_id + + hdferr = 0 + hdferr = H5Arename_by_name(loc_id, c_obj_name, c_old_attr_name, c_new_attr_name, lapl_id_default) + + END SUBROUTINE h5arename_by_name_f +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously renames an attribute +!! +!! \param loc_id Location or object identifier; may be dataset or group or named datatype +!! \param obj_name Name of object, relative to location, whose attribute is to be renamed +!! \param old_attr_name Prior attribute name +!! \param new_attr_name New attribute name +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list identifier +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Arename_by_name() +!! + SUBROUTINE h5arename_by_name_async_f(loc_id, obj_name, old_attr_name, new_attr_name, es_id, & + hdferr, lapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + CHARACTER(LEN=*), INTENT(IN) :: old_attr_name + CHARACTER(LEN=*), INTENT(IN) :: new_attr_name + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lapl_id_default + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + CHARACTER(LEN=LEN_TRIM(obj_name) +1,KIND=C_CHAR) :: c_obj_name + CHARACTER(LEN=LEN_TRIM(old_attr_name)+1,KIND=C_CHAR) :: c_old_attr_name + CHARACTER(LEN=LEN_TRIM(new_attr_name)+1,KIND=C_CHAR) :: c_new_attr_name + + INTERFACE + INTEGER FUNCTION H5Arename_by_name_async(file, func, line, loc_id, obj_name, & + old_attr_name, new_attr_name, lapl_id_default, es_id) & + BIND(C,NAME='H5Arename_by_name_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: old_attr_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: new_attr_name + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Arename_by_name_async + END INTERFACE + + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + c_old_attr_name = TRIM(old_attr_name)//C_NULL_CHAR + c_new_attr_name = TRIM(new_attr_name)//C_NULL_CHAR lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default=lapl_id - hdferr = H5Arename_by_name_c(loc_id, obj_name, obj_namelen, & - old_attr_name, old_attr_namelen, new_attr_name, new_attr_namelen, & - lapl_id_default) + IF (PRESENT(file)) file_default = file + IF (PRESENT(func)) func_default = func + IF (PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = 0 + hdferr = H5Arename_by_name_async(file_default, func_default, line_default, & + loc_id, c_obj_name, c_old_attr_name, c_new_attr_name, lapl_id_default, es_id) - END SUBROUTINE H5Arename_by_name_f + END SUBROUTINE h5arename_by_name_async_f !> !! \ingroup FH5A @@ -646,45 +860,102 @@ CONTAINS !! !! See C API: @ref H5Aopen() !! - SUBROUTINE H5Aopen_f(obj_id, attr_name, attr_id, hdferr, aapl_id) + SUBROUTINE h5aopen_f(obj_id, attr_name, attr_id, hdferr, aapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_id CHARACTER(LEN=*), INTENT(IN) :: attr_name INTEGER(HID_T), INTENT(OUT) :: attr_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: aapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: aapl_id + INTEGER(HID_T) :: aapl_id_default + CHARACTER(LEN=LEN_TRIM(attr_name)+1,KIND=C_CHAR) :: c_attr_name - INTEGER(SIZE_T) :: attr_namelen + c_attr_name = TRIM(attr_name)//C_NULL_CHAR + + aapl_id_default = H5P_DEFAULT_F + IF(PRESENT(aapl_id)) aapl_id_default = aapl_id + + attr_id = INT(H5Aopen(obj_id, c_attr_name, aapl_id_default), HID_T) + + hdferr = 0 + IF(attr_id.LT.0) hdferr = -1 + + END SUBROUTINE h5aopen_f + +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously opens an attribute for an object specified by object identifier and attribute name. +!! +!! \param obj_id Identifier for object to which attribute is attached +!! \param attr_name Name of attribute to open +!! \param attr_id Attribute identifier +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param aapl_id Attribute access property list +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Aopen_async() +!! + SUBROUTINE h5aopen_async_f(obj_id, attr_name, attr_id, es_id, hdferr, aapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(IN) :: attr_name + INTEGER(HID_T), INTENT(OUT) :: attr_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: aapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN) , OPTIONAL :: line + + INTEGER(HID_T) :: aapl_id_default + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + CHARACTER(LEN=LEN_TRIM(attr_name)+1,KIND=C_CHAR) :: c_attr_name INTERFACE - INTEGER FUNCTION H5Aopen_c(obj_id, attr_name, attr_namelen, aapl_id_default, attr_id) & - BIND(C,NAME='h5aopen_c') - IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T - INTEGER(HID_T), INTENT(IN) :: obj_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: attr_name - INTEGER(HID_T) :: aapl_id_default - INTEGER(SIZE_T) :: attr_namelen - INTEGER(HID_T), INTENT(OUT) :: attr_id - END FUNCTION H5Aopen_c + INTEGER(HID_T) FUNCTION H5Aopen_async(file, func, line, & + obj_id, attr_name, aapl_id_default, es_id) BIND(C,NAME='H5Aopen_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: obj_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: attr_name + INTEGER(HID_T), VALUE :: aapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Aopen_async END INTERFACE - attr_namelen = LEN(attr_name) + c_attr_name = TRIM(attr_name)//C_NULL_CHAR aapl_id_default = H5P_DEFAULT_F IF(PRESENT(aapl_id)) aapl_id_default = aapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) - hdferr = H5Aopen_c(obj_id, attr_name, attr_namelen, aapl_id_default, attr_id) + attr_id = INT(H5Aopen_async(file_default, func_default, line_default, & + obj_id, c_attr_name, aapl_id_default, es_id), HID_T) + + hdferr = 0 + IF(attr_id.LT.0) hdferr = -1 - END SUBROUTINE H5Aopen_f + END SUBROUTINE h5aopen_async_f !> !! \ingroup FH5A !! !! \brief Deletes an attribute from an object according to index order !! -!! \param loc_id Location or object identifier; may be dataset or group +!! \param loc_id Location or object identifier; may be dataset or group or named datatype !! \param obj_name Name of object, relative to location, from which attribute is to be removed !! \param idx_type Type of index; Possible values are: !! \li H5_INDEX_UNKNOWN_F = -1 - Unknown index type @@ -705,7 +976,7 @@ CONTAINS !! !! See C API: @ref H5Adelete_by_idx() !! - SUBROUTINE H5Adelete_by_idx_f(loc_id, obj_name, idx_type, order, n, hdferr, lapl_id) + SUBROUTINE h5adelete_by_idx_f(loc_id, obj_name, idx_type, order, n, hdferr, lapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: obj_name @@ -713,7 +984,7 @@ CONTAINS INTEGER, INTENT(IN) :: order INTEGER(HSIZE_T), INTENT(IN) :: n INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER(SIZE_T) :: obj_namelen INTEGER(HID_T) :: lapl_id_default @@ -739,7 +1010,7 @@ CONTAINS obj_namelen = LEN(obj_name) hdferr = H5Adelete_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, n, lapl_id_default) - END SUBROUTINE H5Adelete_by_idx_f + END SUBROUTINE h5adelete_by_idx_f !> !! \ingroup FH5A @@ -760,7 +1031,7 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: obj_name CHARACTER(LEN=*), INTENT(IN) :: attr_name INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER(SIZE_T) :: attr_namelen INTEGER(SIZE_T) :: obj_namelen @@ -771,6 +1042,7 @@ CONTAINS BIND(C,NAME='h5adelete_by_name_c') IMPORT :: C_CHAR IMPORT :: HID_T, SIZE_T + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: obj_name CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: attr_name @@ -788,7 +1060,7 @@ CONTAINS hdferr = H5Adelete_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, lapl_id_default) - END SUBROUTINE H5Adelete_by_name_f + END SUBROUTINE h5adelete_by_name_f !> !! \ingroup FH5A @@ -817,7 +1089,7 @@ CONTAINS !! !! See C API: @ref H5Aopen_by_idx() !! - SUBROUTINE H5Aopen_by_idx_f(loc_id, obj_name, idx_type, order, n, attr_id, hdferr, aapl_id, lapl_id) + SUBROUTINE h5aopen_by_idx_f(loc_id, obj_name, idx_type, order, n, attr_id, hdferr, aapl_id, lapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: obj_name @@ -828,40 +1100,134 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: attr_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: aapl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id - INTEGER(SIZE_T) :: obj_namelen + INTEGER(HID_T), INTENT(IN), OPTIONAL :: aapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER(HID_T) :: aapl_id_default INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(obj_name)+1,KIND=C_CHAR) :: c_obj_name INTERFACE - INTEGER FUNCTION H5Aopen_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, n, & - aapl_id_default, lapl_id_default, attr_id) BIND(C,NAME='h5aopen_by_idx_c') - IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T, HSIZE_T - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: obj_name - INTEGER, INTENT(IN) :: idx_type - INTEGER, INTENT(IN) :: order - INTEGER(HSIZE_T), INTENT(IN) :: n - INTEGER(HID_T) :: aapl_id_default - INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: obj_namelen - INTEGER(HID_T), INTENT(OUT) :: attr_id - END FUNCTION H5Aopen_by_idx_c + INTEGER(HID_T) FUNCTION H5Aopen_by_idx(loc_id, obj_name, idx_type, order, n, & + aapl_id_default, lapl_id_default) BIND(C,NAME='H5Aopen_by_idx') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, HSIZE_T + IMPLICIT NONE + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + INTEGER(C_INT), VALUE :: idx_type + INTEGER(C_INT), VALUE :: order + INTEGER(HSIZE_T), VALUE :: n + INTEGER(HID_T), VALUE :: aapl_id_default + INTEGER(HID_T), VALUE :: lapl_id_default + END FUNCTION H5Aopen_by_idx END INTERFACE - obj_namelen = LEN(obj_name) + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + + aapl_id_default = H5P_DEFAULT_F + IF(PRESENT(aapl_id)) aapl_id_default = aapl_id + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + attr_id = INT(H5Aopen_by_idx(loc_id, c_obj_name, INT(idx_type, C_INT), INT(order, C_INT), n, & + aapl_id_default, lapl_id_default), HID_T) + + END SUBROUTINE h5aopen_by_idx_f + +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously opens an existing attribute that is attached to an object specified by location and name. +!! +!! \param loc_id Location of object to which attribute is attached. +!! \param obj_name Name of object to which attribute is attached, relative to location. +!! \param idx_type Type of index; Possible values are: +!! \li H5_INDEX_UNKNOWN_F = -1 - Unknown index type +!! \li H5_INDEX_NAME_F - Index on names +!! \li H5_INDEX_CRT_ORDER_F - Index on creation order +!! \li H5_INDEX_N_F - Number of indices defined +!! +!! \param order Order in which to iterate over index; Possible values are: +!! \li H5_ITER_UNKNOWN_F - Unknown order +!! \li H5_ITER_INC_F - Increasing order +!! \li H5_ITER_DEC_F - Decreasing order +!! \li H5_ITER_NATIVE_F - No particular order, whatever is fastest +!! \li H5_ITER_N_F - Number of iteration orders +!! \param n Attribute’s position in index. +!! \param attr_id Attribute identifier. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param aapl_id Attribute access property list. +!! \param lapl_id Link access property list. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Aopen_by_idx_async() +!! + SUBROUTINE h5aopen_by_idx_async_f(loc_id, obj_name, idx_type, order, n, attr_id, es_id, hdferr, & + aapl_id, lapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER, INTENT(IN) :: idx_type + INTEGER, INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T), INTENT(OUT) :: attr_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: aapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN) , OPTIONAL :: line + + INTEGER(HID_T) :: aapl_id_default + INTEGER(HID_T) :: lapl_id_default + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + CHARACTER(LEN=LEN_TRIM(obj_name)+1,KIND=C_CHAR) :: c_obj_name + + INTERFACE + INTEGER(HID_T) FUNCTION H5Aopen_by_idx_async(file, func, line, & + loc_id, obj_name, idx_type, order, n, & + aapl_id_default, lapl_id_default, es_id) BIND(C,NAME='H5Aopen_by_idx_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, HSIZE_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + INTEGER(C_INT), VALUE :: idx_type + INTEGER(C_INT), VALUE :: order + INTEGER(HSIZE_T), VALUE :: n + INTEGER(HID_T), VALUE :: aapl_id_default + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Aopen_by_idx_async + END INTERFACE + + c_obj_name = TRIM(obj_name)//C_NULL_CHAR aapl_id_default = H5P_DEFAULT_F IF(PRESENT(aapl_id)) aapl_id_default = aapl_id lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) - hdferr = H5Aopen_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, n, & - aapl_id_default, lapl_id_default, attr_id) + attr_id = INT(H5Aopen_by_idx_async(file_default, func_default, line_default, & + loc_id, c_obj_name, INT(idx_type, C_INT), INT(order, C_INT), n, & + aapl_id_default, lapl_id_default, es_id), HID_T) + + hdferr = 0 + IF(attr_id.LT.0) hdferr = -1 - END SUBROUTINE H5Aopen_by_idx_f + END SUBROUTINE h5aopen_by_idx_async_f !> !! \ingroup FH5A @@ -878,7 +1244,7 @@ CONTAINS !! !! See C API: @ref H5Aget_info() !! - SUBROUTINE H5Aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, hdferr) + SUBROUTINE h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id LOGICAL, INTENT(OUT) :: f_corder_valid @@ -907,12 +1273,12 @@ CONTAINS IF (corder_valid .EQ. 1) f_corder_valid =.TRUE. - END SUBROUTINE H5Aget_info_f + END SUBROUTINE h5aget_info_f !> !! \ingroup FH5A !! -!! \brief Retrieves attribute information, by attribute index position +!! \brief Retrieves attribute information by attribute index position !! !! \param loc_id Location of object to which attribute is attached !! \param obj_name Name of object to which attribute is attached, relative to location @@ -928,7 +1294,7 @@ CONTAINS !! !! See C API: @ref H5Aget_info_by_idx() !! - SUBROUTINE H5Aget_info_by_idx_f(loc_id, obj_name, idx_type, order, n, & + SUBROUTINE h5aget_info_by_idx_f(loc_id, obj_name, idx_type, order, n, & f_corder_valid, corder, cset, data_size, hdferr, lapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id @@ -946,7 +1312,7 @@ CONTAINS INTEGER, INTENT(OUT) :: cset INTEGER(HSIZE_T), INTENT(OUT) :: data_size INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER :: corder_valid INTEGER(SIZE_T) :: obj_namelen INTEGER(HID_T) :: lapl_id_default @@ -982,7 +1348,7 @@ CONTAINS f_corder_valid =.FALSE. IF (corder_valid .EQ. 1) f_corder_valid =.TRUE. - END SUBROUTINE H5Aget_info_by_idx_f + END SUBROUTINE h5aget_info_by_idx_f !> !! \ingroup FH5A @@ -1001,7 +1367,7 @@ CONTAINS !! !! See C API: @ref H5Aget_info_by_name() !! - SUBROUTINE H5Aget_info_by_name_f(loc_id, obj_name, attr_name, & + SUBROUTINE h5aget_info_by_name_f(loc_id, obj_name, attr_name, & f_corder_valid, corder, cset, data_size, hdferr, lapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id @@ -1014,7 +1380,7 @@ CONTAINS INTEGER, INTENT(OUT) :: cset INTEGER(HSIZE_T), INTENT(OUT) :: data_size INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER :: corder_valid INTEGER(SIZE_T) :: obj_namelen INTEGER(SIZE_T) :: attr_namelen @@ -1052,7 +1418,7 @@ CONTAINS f_corder_valid =.FALSE. IF (corder_valid .EQ. 1) f_corder_valid =.TRUE. - END SUBROUTINE H5Aget_info_by_name_f + END SUBROUTINE h5aget_info_by_name_f !> !! \ingroup FH5A @@ -1072,7 +1438,7 @@ CONTAINS !! !! See C API: @ref H5Acreate_by_name() !! - SUBROUTINE H5Acreate_by_name_f(loc_id, obj_name, attr_name, type_id, space_id, attr, hdferr, & + SUBROUTINE h5acreate_by_name_f(loc_id, obj_name, attr_name, type_id, space_id, attr, hdferr, & acpl_id, aapl_id, lapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id @@ -1086,37 +1452,126 @@ CONTAINS INTEGER(HID_T), INTENT(IN), OPTIONAL :: acpl_id INTEGER(HID_T), INTENT(IN), OPTIONAL :: aapl_id INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id - INTEGER(SIZE_T) :: obj_namelen - INTEGER(SIZE_T) :: attr_namelen INTEGER(HID_T) :: acpl_id_default INTEGER(HID_T) :: aapl_id_default INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(obj_name)+1,KIND=C_CHAR) :: c_obj_name + CHARACTER(LEN=LEN_TRIM(attr_name)+1,KIND=C_CHAR) :: c_attr_name INTERFACE - INTEGER FUNCTION H5Acreate_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, & - type_id, space_id, acpl_id_default, aapl_id_default, lapl_id_default, attr) & - BIND(C,NAME='h5acreate_by_name_c') + INTEGER(HID_T) FUNCTION H5Acreate_by_name(loc_id, obj_name, attr_name, & + type_id, space_id, acpl_id_default, aapl_id_default, lapl_id_default) & + BIND(C,NAME='H5Acreate_by_name') IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T + IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: obj_name - INTEGER(SIZE_T), INTENT(IN) :: obj_namelen - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: attr_name - INTEGER(SIZE_T), INTENT(IN) :: attr_namelen - INTEGER(HID_T), INTENT(IN) :: type_id - INTEGER(HID_T), INTENT(IN) :: space_id - INTEGER(HID_T) :: acpl_id_default - INTEGER(HID_T) :: aapl_id_default - INTEGER(HID_T) :: lapl_id_default - INTEGER(HID_T), INTENT(OUT) :: attr + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: attr_name + INTEGER(HID_T), VALUE :: type_id + INTEGER(HID_T), VALUE :: space_id + INTEGER(HID_T), VALUE :: acpl_id_default + INTEGER(HID_T), VALUE :: aapl_id_default + INTEGER(HID_T), VALUE :: lapl_id_default + END FUNCTION H5Acreate_by_name + END INTERFACE + + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + c_attr_name = TRIM(attr_name)//C_NULL_CHAR + + acpl_id_default = H5P_DEFAULT_F + aapl_id_default = H5P_DEFAULT_F + lapl_id_default = H5P_DEFAULT_F + + IF(PRESENT(acpl_id)) acpl_id_default = acpl_id + IF(PRESENT(aapl_id)) aapl_id_default = aapl_id + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + attr = INT(H5Acreate_by_name(loc_id, c_obj_name, c_attr_name, type_id, space_id, & + acpl_id_default, aapl_id_default, lapl_id_default), HID_T) + + hdferr = 0 + IF(attr.LT.0) hdferr = -1 + + END SUBROUTINE h5acreate_by_name_f + +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously creates an attribute attached to a specified object +!! +!! \param loc_id Location or object identifier; may be dataset or group +!! \param obj_name Name, relative to loc_id, of object that attribute is to be attached to +!! \param attr_name Attribute name +!! \param type_id Attribute datatype identifier +!! \param space_id Attribute dataspace identifier +!! \param attr An attribute identifier +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param acpl_id Attribute creation property list identifier (Currently not used.) +!! \param aapl_id Attribute access property list identifier (Currently not used.) +!! \param lapl_id Link access property list +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Acreate_by_name_async() +!! + SUBROUTINE h5acreate_by_name_async_f(loc_id, obj_name, attr_name, type_id, space_id, attr, es_id, hdferr, & + acpl_id, aapl_id, lapl_id, file, func, line) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + CHARACTER(LEN=*), INTENT(IN) :: attr_name + INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HID_T), INTENT(OUT) :: attr + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + + INTEGER(HID_T), INTENT(IN), OPTIONAL :: acpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: aapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line - END FUNCTION H5Acreate_by_name_c + INTEGER(HID_T) :: acpl_id_default + INTEGER(HID_T) :: aapl_id_default + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(obj_name)+1,KIND=C_CHAR) :: c_obj_name + CHARACTER(LEN=LEN_TRIM(attr_name)+1,KIND=C_CHAR) :: c_attr_name + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Acreate_by_name_async(file, func, line, loc_id, obj_name, attr_name, & + type_id, space_id, acpl_id_default, aapl_id_default, lapl_id_default, es_id) & + BIND(C,NAME='H5Acreate_by_name_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: attr_name + INTEGER(HID_T), VALUE :: type_id + INTEGER(HID_T), VALUE :: space_id + INTEGER(HID_T), VALUE :: acpl_id_default + INTEGER(HID_T), VALUE :: aapl_id_default + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Acreate_by_name_async END INTERFACE - obj_namelen = LEN(obj_name) - attr_namelen = LEN(attr_name) + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + c_attr_name = TRIM(attr_name)//C_NULL_CHAR acpl_id_default = H5P_DEFAULT_F aapl_id_default = H5P_DEFAULT_F @@ -1125,10 +1580,18 @@ CONTAINS IF(PRESENT(acpl_id)) acpl_id_default = acpl_id IF(PRESENT(aapl_id)) aapl_id_default = aapl_id IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + attr = H5Acreate_by_name_async(file_default, func_default, line_default, & + loc_id, c_obj_name, c_attr_name, & + type_id, space_id, acpl_id_default, aapl_id_default, lapl_id_default, es_id) + + hdferr = 0 + IF(attr.LT.0) hdferr = -1 - hdferr = H5Acreate_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, & - type_id, space_id, acpl_id_default, aapl_id_default, lapl_id_default, attr) - END SUBROUTINE H5Acreate_by_name_f + END SUBROUTINE h5acreate_by_name_async_f !> !! \ingroup FH5A @@ -1142,35 +1605,94 @@ CONTAINS !! !! See C API: @ref H5Aexists() !! - SUBROUTINE H5Aexists_f(obj_id, attr_name, attr_exists, hdferr) + SUBROUTINE h5aexists_f(obj_id, attr_name, attr_exists, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: obj_id + INTEGER(HID_T), INTENT(IN) :: obj_id CHARACTER(LEN=*), INTENT(IN) :: attr_name LOGICAL, INTENT(OUT) :: attr_exists INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T) :: attr_exists_c - INTEGER(SIZE_T) :: attr_namelen + + CHARACTER(LEN=LEN_TRIM(attr_name)+1,KIND=C_CHAR) :: c_attr_name + INTEGER(C_INT) :: attr_exists_c INTERFACE - INTEGER FUNCTION H5Aexists_c(obj_id, attr_name, attr_namelen, attr_exists_c) BIND(C,NAME='h5aexists_c') - IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T + INTEGER(C_INT) FUNCTION H5Aexists(obj_id, attr_name) BIND(C,NAME='H5Aexists') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: obj_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: attr_name - INTEGER(SIZE_T) :: attr_namelen - INTEGER(HID_T) :: attr_exists_c - END FUNCTION H5Aexists_c + INTEGER(HID_T), VALUE :: obj_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: attr_name + END FUNCTION H5Aexists END INTERFACE - attr_namelen = LEN(attr_name) + c_attr_name = TRIM(attr_name)//C_NULL_CHAR - hdferr = H5Aexists_c(obj_id, attr_name, attr_namelen, attr_exists_c) + attr_exists_c = H5Aexists(obj_id, c_attr_name) attr_exists = .FALSE. IF(attr_exists_c.GT.0) attr_exists = .TRUE. - END SUBROUTINE H5Aexists_f + hdferr = 0 + IF(attr_exists_c.LT.0) hdferr = -1 + + END SUBROUTINE h5aexists_f + +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously determines whether an attribute with a given name exists on an object +!! +!! \param obj_id Object identifier +!! \param attr_name Attribute name +!! \param attr_exists Pointer to attribute exists status, must be of type LOGICAL(C_BOOL) and initialize to .FALSE. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Aexists_async() +!! + SUBROUTINE h5aexists_async_f(obj_id, attr_name, attr_exists, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(IN) :: attr_name + TYPE(C_PTR) , INTENT(INOUT) :: attr_exists + INTEGER(HID_T) , INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + CHARACTER(LEN=LEN_TRIM(attr_name)+1,KIND=C_CHAR) :: c_attr_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Aexists_async(file, func, line, & + obj_id, attr_name, exists, es_id) BIND(C,NAME='H5Aexists_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: obj_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: attr_name + TYPE(C_PTR) , VALUE :: exists + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Aexists_async + END INTERFACE + + c_attr_name = TRIM(attr_name)//C_NULL_CHAR + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Aexists_async(file_default, func_default, line_default, obj_id, c_attr_name, attr_exists, es_id)) + + END SUBROUTINE h5aexists_async_f !> !! \ingroup FH5A @@ -1186,48 +1708,120 @@ CONTAINS !! !! See C API: @ref H5Aexists_by_name() !! - SUBROUTINE H5Aexists_by_name_f(loc_id, obj_name, attr_name, attr_exists, hdferr, lapl_id) + SUBROUTINE h5aexists_by_name_f(loc_id, obj_name, attr_name, attr_exists, hdferr, lapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: obj_name CHARACTER(LEN=*), INTENT(IN) :: attr_name LOGICAL, INTENT(OUT) :: attr_exists INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id - INTEGER :: attr_exists_c - INTEGER(SIZE_T) :: obj_namelen - INTEGER(SIZE_T) :: attr_namelen + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + INTEGER(C_INT) :: attr_exists_c INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(obj_name)+1,KIND=C_CHAR) :: c_obj_name + CHARACTER(LEN=LEN_TRIM(attr_name)+1,KIND=C_CHAR) :: c_attr_name INTERFACE - INTEGER FUNCTION H5Aexists_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, & - lapl_id_default, attr_exists_c) BIND(C,NAME='h5aexists_by_name_c') - IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T + INTEGER(C_INT) FUNCTION H5Aexists_by_name(loc_id, obj_name, attr_name, lapl_id_default) & + BIND(C,NAME='H5Aexists_by_name') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: obj_name - INTEGER(SIZE_T), INTENT(IN) :: obj_namelen - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: attr_name - INTEGER(SIZE_T), INTENT(IN) :: attr_namelen - INTEGER(HID_T), INTENT(IN) :: lapl_id_default - INTEGER, INTENT(OUT) :: attr_exists_c - END FUNCTION H5Aexists_by_name_c + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: attr_name + INTEGER(HID_T), VALUE :: lapl_id_default + END FUNCTION H5Aexists_by_name END INTERFACE - attr_namelen = LEN(attr_name) - obj_namelen = LEN(obj_name) + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + c_attr_name = TRIM(attr_name)//C_NULL_CHAR lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - hdferr = H5Aexists_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, lapl_id_default, attr_exists_c) + attr_exists_c = H5Aexists_by_name(loc_id, c_obj_name, c_attr_name, lapl_id_default) attr_exists = .FALSE. IF(attr_exists_c.GT.0) attr_exists = .TRUE. - END SUBROUTINE H5Aexists_by_name_f + hdferr = 0 + IF(attr_exists_c.LT.0) hdferr = -1 + + END SUBROUTINE h5aexists_by_name_f + +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously determines whether an attribute with a given name exists on an object +!! +!! \param loc_id Location identifier +!! \param obj_name Object name either relative to loc_id, absolute from the file’s root group, or '. '(a dot) +!! \param attr_name Attribute name +!! \param attr_exists Pointer to attribute exists status, must be of type LOGICAL(C_BOOL) and initialize to .FALSE. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list identifier +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Aexists_by_name_async() +!! + SUBROUTINE h5aexists_by_name_async_f(loc_id, obj_name, attr_name, attr_exists, es_id, hdferr, lapl_id, file, func, line) + IMPLICIT NONE + INTEGER (HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + CHARACTER(LEN=*), INTENT(IN) :: attr_name + TYPE(C_PTR) , INTENT(INOUT) :: attr_exists + INTEGER (HID_T), INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + INTEGER (HID_T), INTENT(IN) , OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN) , OPTIONAL :: line + + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(obj_name)+1,KIND=C_CHAR) :: c_obj_name + CHARACTER(LEN=LEN_TRIM(attr_name)+1,KIND=C_CHAR) :: c_attr_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Aexists_by_name_async(file, func, line, & + loc_id, obj_name, attr_name, exists, lapl_id_default, es_id) & + BIND(C,NAME='H5Aexists_by_name_async') + IMPORT :: C_CHAR, C_PTR, C_INT + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: attr_name + TYPE(C_PTR) , VALUE :: exists + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Aexists_by_name_async + END INTERFACE + + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + c_attr_name = TRIM(attr_name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Aexists_by_name_async(file_default, func_default, line_default, & + loc_id, c_obj_name, c_attr_name, attr_exists, lapl_id_default, es_id)) + + END SUBROUTINE h5aexists_by_name_async_f + !> !! \ingroup FH5A !! @@ -1243,50 +1837,129 @@ CONTAINS !! !! See C API: @ref H5Aopen_by_name() !! - SUBROUTINE H5Aopen_by_name_f(loc_id, obj_name, attr_name, attr_id, hdferr, aapl_id, lapl_id) + SUBROUTINE h5aopen_by_name_f(loc_id, obj_name, attr_name, attr_id, hdferr, aapl_id, lapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: obj_name CHARACTER(LEN=*), INTENT(IN) :: attr_name INTEGER(HID_T), INTENT(OUT) :: attr_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: aapl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: aapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + INTEGER(HID_T) :: aapl_id_default INTEGER(HID_T) :: lapl_id_default - - INTEGER(SIZE_T) :: obj_namelen - INTEGER(SIZE_T) :: attr_namelen + CHARACTER(LEN=LEN_TRIM(obj_name)+1,KIND=C_CHAR) :: c_obj_name + CHARACTER(LEN=LEN_TRIM(attr_name)+1,KIND=C_CHAR) :: c_attr_name INTERFACE - INTEGER FUNCTION H5Aopen_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, & - aapl_id_default, lapl_id_default, attr_id) BIND(C,NAME='h5aopen_by_name_c') + INTEGER(HID_T) FUNCTION H5Aopen_by_name(loc_id, obj_name, attr_name, aapl_id_default, lapl_id_default) & + BIND(C,NAME='H5Aopen_by_name') IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T + IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: obj_name - INTEGER(SIZE_T), INTENT(IN) :: obj_namelen - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: attr_name - INTEGER(SIZE_T), INTENT(IN) :: attr_namelen - INTEGER(HID_T) :: aapl_id_default - INTEGER(HID_T) :: lapl_id_default - INTEGER(HID_T), INTENT(OUT) :: attr_id - END FUNCTION H5Aopen_by_name_c + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: attr_name + INTEGER(HID_T), VALUE :: aapl_id_default + INTEGER(HID_T), VALUE :: lapl_id_default + END FUNCTION H5Aopen_by_name END INTERFACE - attr_namelen = LEN(attr_name) - obj_namelen = LEN(obj_name) + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + c_attr_name = TRIM(attr_name)//C_NULL_CHAR aapl_id_default = H5P_DEFAULT_F lapl_id_default = H5P_DEFAULT_F IF(PRESENT(aapl_id)) aapl_id_default = aapl_id IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - hdferr = H5Aopen_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, & - aapl_id_default, lapl_id_default, attr_id) + attr_id = INT(H5Aopen_by_name(loc_id, c_obj_name, c_attr_name, aapl_id_default, lapl_id_default), HID_T) - END SUBROUTINE H5Aopen_by_name_f + hdferr = 0 + IF(attr_id.LT.0) hdferr = -1 + + END SUBROUTINE h5aopen_by_name_f + +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously opens an attribute for an object by object name and attribute name. +!! +!! \param loc_id Location from which to find object to which attribute is attached +!! \param obj_name Object name either relative to loc_id, absolute from the file’s root group, or '.' (a dot) +!! \param attr_name Attribute name +!! \param attr_id Attribute identifier +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param aapl_id Attribute access property list (Currently unused; should be passed in as H5P_DEFAULT.) +!! \param lapl_id Link access property list identifier +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Aopen_by_name_async() +!! + SUBROUTINE h5aopen_by_name_async_f(loc_id, obj_name, attr_name, attr_id, es_id, hdferr, & + aapl_id, lapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + CHARACTER(LEN=*), INTENT(IN) :: attr_name + INTEGER(HID_T), INTENT(OUT) :: attr_id + INTEGER(HID_T), INTENT(IN) :: es_id + + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: aapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: aapl_id_default + INTEGER(HID_T) :: lapl_id_default + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + CHARACTER(LEN=LEN_TRIM(obj_name)+1,KIND=C_CHAR) :: c_obj_name + CHARACTER(LEN=LEN_TRIM(attr_name)+1,KIND=C_CHAR) :: c_attr_name + + INTERFACE + INTEGER(HID_T) FUNCTION H5Aopen_by_name_async(file, func, line, loc_id, obj_name, attr_name, & + aapl_id_default, lapl_id_default, es_id) BIND(C,NAME='H5Aopen_by_name_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: attr_name + INTEGER(HID_T), VALUE :: aapl_id_default + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Aopen_by_name_async + END INTERFACE + + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + c_attr_name = TRIM(attr_name)//C_NULL_CHAR + + aapl_id_default = H5P_DEFAULT_F + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(aapl_id)) aapl_id_default = aapl_id + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + attr_id = INT(H5Aopen_by_name_async(file_default, func_default, line_default, & + loc_id, c_obj_name, c_attr_name, aapl_id_default, lapl_id_default, es_id), HID_T) + + hdferr = 0 + IF(attr_id.LT.0) hdferr = -1 + + END SUBROUTINE h5aopen_by_name_async_f !> !! \ingroup FH5A @@ -1300,36 +1973,209 @@ CONTAINS !! !! See C API: @ref H5Arename() !! - SUBROUTINE H5Arename_f(loc_id, old_attr_name, new_attr_name, hdferr) + SUBROUTINE h5arename_f(loc_id, old_attr_name, new_attr_name, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: old_attr_name CHARACTER(LEN=*), INTENT(IN) :: new_attr_name INTEGER, INTENT(OUT) :: hdferr - INTEGER(SIZE_T) :: old_attr_namelen - INTEGER(SIZE_T) :: new_attr_namelen + + CHARACTER(LEN=LEN_TRIM(old_attr_name)+1,KIND=C_CHAR) :: c_old_attr_name + CHARACTER(LEN=LEN_TRIM(new_attr_name)+1,KIND=C_CHAR) :: c_new_attr_name INTERFACE - INTEGER FUNCTION H5Arename_c(loc_id, & - old_attr_name, old_attr_namelen, new_attr_name, new_attr_namelen) BIND(C,NAME='h5arename_c') + INTEGER FUNCTION H5Arename(loc_id, old_attr_name, new_attr_name) & + BIND(C,NAME='H5Arename') IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T + IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: old_attr_name + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: new_attr_name + END FUNCTION H5Arename + END INTERFACE + + c_old_attr_name = TRIM(old_attr_name)//C_NULL_CHAR + c_new_attr_name = TRIM(new_attr_name)//C_NULL_CHAR + + hdferr = H5Arename(loc_id, c_old_attr_name, c_new_attr_name) + + END SUBROUTINE h5arename_f + +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously renames an attribute +!! +!! \param loc_id Location or object identifier; may be dataset or group +!! \param old_attr_name Prior attribute name +!! \param new_attr_name New attribute name +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Arename_async() +!! + SUBROUTINE h5arename_async_f(loc_id, old_attr_name, new_attr_name, es_id, hdferr, & + file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: old_attr_name + CHARACTER(LEN=*), INTENT(IN) :: new_attr_name + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + CHARACTER(LEN=LEN_TRIM(old_attr_name)+1,KIND=C_CHAR) :: c_old_attr_name + CHARACTER(LEN=LEN_TRIM(new_attr_name)+1,KIND=C_CHAR) :: c_new_attr_name + + INTERFACE + INTEGER FUNCTION H5Arename_async(file, func, line, loc_id, old_attr_name, new_attr_name, es_id) & + BIND(C,NAME='H5Arename_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: old_attr_name - INTEGER(SIZE_T) :: old_attr_namelen CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: new_attr_name - INTEGER(SIZE_T) :: new_attr_namelen - END FUNCTION H5Arename_c + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Arename_async + END INTERFACE + + c_old_attr_name = TRIM(old_attr_name)//C_NULL_CHAR + c_new_attr_name = TRIM(new_attr_name)//C_NULL_CHAR + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = H5Arename_async(file_default, func_default, line_default, & + loc_id, c_old_attr_name, c_new_attr_name, es_id) + + END SUBROUTINE h5arename_async_f + +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously reads an attribute. +!! +!! \param attr_id Identifier of an attribute to read. +!! \param memtype_id Identifier of the attribute datatype (in memory). +!! \param buf Buffer for data to be read. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Aread_async() +!! + + SUBROUTINE h5aread_async_f(attr_id, mem_type_id, buf, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: mem_type_id + TYPE(C_PTR) , INTENT(OUT) :: buf + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER FUNCTION H5Aread_async(file, func, line, attr_id, mem_type_id, buf, es_id) & + BIND(C,NAME='H5Aread_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: attr_id + INTEGER(HID_T), VALUE :: mem_type_id + TYPE(C_PTR) , VALUE :: buf + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Aread_async + END INTERFACE + + IF (PRESENT(file)) file_default = file + IF (PRESENT(func)) func_default = func + IF (PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = H5Aread_async(file_default, func_default, line_default, attr_id, mem_type_id, buf, es_id) + + END SUBROUTINE h5aread_async_f + +!> +!! \ingroup FH5A +!! +!! \brief Asynchronously writes an attribute. +!! +!! \param attr_id Identifier of an attribute to read. +!! \param memtype_id Identifier of the attribute datatype (in memory). +!! \param buf Data to be written. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Awrite_async() +!! + + SUBROUTINE h5awrite_async_f(attr_id, mem_type_id, buf, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: mem_type_id + TYPE(C_PTR) , INTENT(IN) :: buf + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER FUNCTION H5Awrite_async(file, func, line, attr_id, mem_type_id, buf, es_id) & + BIND(C,NAME='H5Awrite_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: attr_id + INTEGER(HID_T), VALUE :: mem_type_id + TYPE(C_PTR) , VALUE :: buf + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Awrite_async END INTERFACE - old_attr_namelen = LEN(old_attr_name) - new_attr_namelen = LEN(new_attr_name) + IF (PRESENT(file)) file_default = file + IF (PRESENT(func)) func_default = func + IF (PRESENT(line)) line_default = INT(line, C_INT) - hdferr = H5Arename_c(loc_id, & - old_attr_name, old_attr_namelen, new_attr_name, new_attr_namelen) + hdferr = H5Awrite_async(file_default, func_default, line_default, attr_id, mem_type_id, buf, es_id) - END SUBROUTINE H5Arename_f + END SUBROUTINE h5awrite_async_f #ifdef H5_DOXYGEN @@ -1425,7 +2271,7 @@ CONTAINS #else - SUBROUTINE H5Awrite_char_scalar(attr_id, memtype_id, buf, dims, hdferr) + SUBROUTINE h5awrite_char_scalar(attr_id, memtype_id, buf, dims, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id @@ -1435,9 +2281,9 @@ CONTAINS CALL H5Awrite_char_scalar_fix(attr_id, memtype_id, buf, LEN(buf), dims, hdferr) - END SUBROUTINE H5Awrite_char_scalar + END SUBROUTINE h5awrite_char_scalar - SUBROUTINE H5Awrite_char_scalar_fix(attr_id, memtype_id, buf, buf_len, dims, hdferr) + SUBROUTINE h5awrite_char_scalar_fix(attr_id, memtype_id, buf, buf_len, dims, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id @@ -1451,9 +2297,9 @@ CONTAINS hdferr = H5Awrite_f_c(attr_id, memtype_id, f_ptr) - END SUBROUTINE H5Awrite_char_scalar_fix + END SUBROUTINE h5awrite_char_scalar_fix - SUBROUTINE H5Awrite_ptr(attr_id, mem_type_id, buf, hdferr) + SUBROUTINE h5awrite_ptr(attr_id, mem_type_id, buf, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: mem_type_id @@ -1462,9 +2308,9 @@ CONTAINS hdferr = H5Awrite_f_c(attr_id, mem_type_id, buf) - END SUBROUTINE H5Awrite_ptr + END SUBROUTINE h5awrite_ptr - SUBROUTINE H5Aread_char_scalar(attr_id, memtype_id, buf, dims, hdferr) + SUBROUTINE h5aread_char_scalar(attr_id, memtype_id, buf, dims, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id @@ -1489,18 +2335,18 @@ CONTAINS hdferr = H5Aread_f_c(attr_id, memtype_id, f_ptr) - END SUBROUTINE H5Aread_char_scalar_fix + END SUBROUTINE h5aread_char_scalar_fix - SUBROUTINE H5Aread_ptr(attr_id, mem_type_id, buf, hdferr) + SUBROUTINE h5aread_ptr(attr_id, mem_type_id, buf, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: mem_type_id - TYPE(C_PTR), INTENT(INOUT), TARGET :: buf + TYPE(C_PTR), INTENT(INOUT) :: buf INTEGER, INTENT(OUT) :: hdferr hdferr = H5Aread_f_c(attr_id, mem_type_id, buf) - END SUBROUTINE H5Aread_ptr + END SUBROUTINE h5aread_ptr #endif diff --git a/fortran/src/H5Df.c b/fortran/src/H5Df.c index e92e6a8..3df2fbf 100644 --- a/fortran/src/H5Df.c +++ b/fortran/src/H5Df.c @@ -20,111 +20,6 @@ #include "H5f90.h" -/****if* H5Df/h5dcreate_c - * NAME - * h5dcreate_c - * PURPOSE - * Call H5Dcreate2 to create a dataset - * INPUTS - * loc_id - file or group identifier - * name - name of the dataset - * namelen - name length - * type_id - datatype identifier - * space_id - dataspace identifier - * crt_pr - identifier of creation property list - * OUTPUTS - * dset_id - dataset identifier - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Wednesday, August 4, 1999 - * HISTORY - * - Added optional parameters introduced in version 1.8 - * February, 2008 - * SOURCE - */ -int_f -h5dcreate_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *space_id, hid_t_f *lcpl_id, - hid_t_f *dcpl_id, hid_t_f *dapl_id, hid_t_f *dset_id) -/******/ -{ - char *c_name = NULL; - hid_t c_dset_id; - int ret_value = -1; - - /* - * Convert FORTRAN name to C name - */ - if (NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen))) - goto DONE; - - /* - * Call H5Dcreate2 function. - */ - if ((c_dset_id = H5Dcreate2((hid_t)*loc_id, c_name, (hid_t)*type_id, (hid_t)*space_id, (hid_t)*lcpl_id, - (hid_t)*dcpl_id, (hid_t)*dapl_id)) < 0) - goto DONE; - *dset_id = (hid_t_f)c_dset_id; - - ret_value = 0; - -DONE: - if (c_name) - HDfree(c_name); - return ret_value; -} - -/****if* H5Df/h5dopen_c - * NAME - * h5dopen_c - * PURPOSE - * Call H5Dopen2 to open a dataset - * INPUTS - * loc_id - file or group identifier - * name - name of the dataset - * namelen - name length - * dapl_id - Dataset access property list - * OUTPUTS - * dset_id - dataset identifier - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Wednesday, August 4, 1999 - * HISTORY - * Added 1.8 parameter: dapl_id - * SOURCE - */ -int_f -h5dopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dapl_id, hid_t_f *dset_id) -/******/ -{ - char *c_name = NULL; - hid_t c_dset_id; - int ret_value = -1; - - /* - * Convert FORTRAN name to C name - */ - if (NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen))) - goto DONE; - - /* - * Call H5Dopen2 function. - */ - if ((c_dset_id = H5Dopen2((hid_t)*loc_id, c_name, (hid_t)*dapl_id)) < 0) - goto DONE; - - *dset_id = (hid_t_f)c_dset_id; - ret_value = 0; - -DONE: - if (c_name) - HDfree(c_name); - return ret_value; -} - /****if* H5Df/h5dwrite_ref_reg_c * NAME * h5dwrite_ref_reg_c @@ -268,71 +163,6 @@ h5dread_ref_reg_c(hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, return ret_value; } -/****if* H5Df/h5dclose_c - * NAME - * h5dclose_c - * PURPOSE - * Call H5Dclose to close a dataset - * INPUTS - * dset_id - identifier of the dataset to be closed - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Wednesday, August 4, 1999 - * HISTORY - * - * SOURCE - */ - -int_f -h5dclose_c(hid_t_f *dset_id) -/******/ -{ - int ret_value = 0; - hid_t c_dset_id; - c_dset_id = (hid_t)*dset_id; - if (H5Dclose(c_dset_id) < 0) - ret_value = -1; - return ret_value; -} - -/****if* H5Df/h5dget_space_c - * NAME - * h5dget_space_c - * PURPOSE - * Call H5Dget_space to obtain dataspace of a dataset - * INPUTS - * dset_id - identifier of the dataset - * OUTPUTS - * space_id - identifier of the dataset's dataspace - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Thursday, August 19, 1999 - * HISTORY - * - * SOURCE - */ - -int_f -h5dget_space_c(hid_t_f *dset_id, hid_t_f *space_id) -/******/ -{ - int ret_value = -1; - hid_t c_dset_id; - hid_t c_space_id; - - c_dset_id = (hid_t)*dset_id; - c_space_id = H5Dget_space(c_dset_id); - if (c_space_id < 0) - return ret_value; - ret_value = 0; - *space_id = (hid_t_f)c_space_id; - return ret_value; -} - /****if* H5Df/h5dget_type_c * NAME * h5dget_type_c @@ -410,60 +240,6 @@ h5dget_create_plist_c(hid_t_f *dset_id, hid_t_f *plist_id) return ret_value; } -/****if* H5Df/h5dset_extent_c - * NAME - * h5dset_extent_c - * PURPOSE - * Call H5Dset_extent to extend dataset with unlimited dimensions - * INPUTS - * dset_id - identifier of the dataset - * OUTPUTS - * dims - array with the dimension sizes - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Thursday, August 19, 1999 - * - * HISTORY - * Changed name from the now obsolete h5dextend - * to h5dset_extent in order to match new fortran interface. - * -MSB- March 14, 2008 - * SOURCE - */ - -int_f -h5dset_extent_c(hid_t_f *dset_id, hsize_t_f *dims) -/******/ -{ - hid_t c_space_id; - hsize_t c_dims[H5S_MAX_RANK]; - int rank; - int i; - int status; - int ret_value = -1; - - if ((c_space_id = H5Dget_space((hid_t)*dset_id)) < 0) - return ret_value; - - rank = H5Sget_simple_extent_ndims(c_space_id); - H5Sclose(c_space_id); - if (rank < 0) - return ret_value; - - /* - * Reverse dimensions due to C-FORTRAN storage order. - */ - for (i = 0; i < rank; i++) - c_dims[i] = (hsize_t)dims[rank - i - 1]; - - status = H5Dset_extent((hid_t)*dset_id, c_dims); - - if (status >= 0) - ret_value = 0; - return ret_value; -} - /****if* H5Df/h5dget_storage_size_c * NAME * h5dget_storage_size_c diff --git a/fortran/src/H5Dff.F90 b/fortran/src/H5Dff.F90 index bbfeb06..06034ac 100644 --- a/fortran/src/H5Dff.F90 +++ b/fortran/src/H5Dff.F90 @@ -88,6 +88,7 @@ MODULE H5D USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR USE H5GLOBAL USE H5LIB, ONLY : h5kind_to_type + USE H5S, ONLY : H5Sget_simple_extent_ndims_f, H5Sclose_f PRIVATE h5dread_vl_integer, h5dread_vl_real, h5dread_vl_string PRIVATE h5dwrite_vl_integer, h5dwrite_vl_real, h5dwrite_vl_string @@ -232,37 +233,119 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: space_id INTEGER(HID_T), INTENT(OUT) :: dset_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: dcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: dapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: dcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: dapl_id INTEGER(HID_T) :: lcpl_id_default INTEGER(HID_T) :: dcpl_id_default INTEGER(HID_T) :: dapl_id_default - - INTEGER :: namelen ! Name length + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTERFACE - INTEGER FUNCTION h5dcreate_c(loc_id, name, namelen, type_id, & - space_id, lcpl_id_default, dcpl_id_default, dapl_id_default, dset_id) & - BIND(C,NAME='h5dcreate_c') + INTEGER(HID_T) FUNCTION H5Dcreate2(loc_id, name, type_id, & + space_id, lcpl_id_default, dcpl_id_default, dapl_id_default) & + BIND(C,NAME='H5Dcreate2') IMPORT :: C_CHAR IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER(HID_T), INTENT(IN) :: type_id - INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: type_id + INTEGER(HID_T), VALUE :: space_id + INTEGER(HID_T), VALUE :: lcpl_id_default + INTEGER(HID_T), VALUE :: dcpl_id_default + INTEGER(HID_T), VALUE :: dapl_id_default + END FUNCTION H5Dcreate2 + END INTERFACE - INTEGER(HID_T) :: lcpl_id_default - INTEGER(HID_T) :: dcpl_id_default - INTEGER(HID_T) :: dapl_id_default + c_name = TRIM(name)//C_NULL_CHAR - INTEGER(HID_T), INTENT(OUT) :: dset_id - END FUNCTION h5dcreate_c + lcpl_id_default = H5P_DEFAULT_F + dcpl_id_default = H5P_DEFAULT_F + dapl_id_default = H5P_DEFAULT_F + + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + IF(PRESENT(dcpl_id)) dcpl_id_default = dcpl_id + IF(PRESENT(dapl_id)) dapl_id_default = dapl_id + + dset_id = INT(h5dcreate2(loc_id, c_name, type_id, space_id, & + lcpl_id_default, dcpl_id_default, dapl_id_default), HID_T) + + hdferr = 0 + IF(dset_id.LT.0) hdferr = -1 + + END SUBROUTINE h5dcreate_f + +!> +!! \ingroup FH5D +!! +!! \brief Asynchronously creates a dataset at the specified location. +!! +!! \param loc_id File or group identifier +!! \param name Dataset name +!! \param type_id Dataset datatype identifier +!! \param space_id Dataset dataspace identifier +!! \param dset_id Dataset identifier +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param dcpl_id Dataset creation property list +!! \param lcpl_id Link creation property list +!! \param dapl_id Dataset access property list +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Dcreate_async() +!! + SUBROUTINE h5dcreate_async_f(loc_id, name, type_id, space_id, dset_id, es_id, & + hdferr, dcpl_id, lcpl_id, dapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HID_T), INTENT(OUT) :: dset_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: dcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: dapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: dcpl_id_default + INTEGER(HID_T) :: dapl_id_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Dcreate_async(file, func, line, loc_id, name, type_id, & + space_id, lcpl_id_default, dcpl_id_default, dapl_id_default, es_id) & + BIND(C,NAME='H5Dcreate_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: type_id + INTEGER(HID_T), VALUE :: space_id + INTEGER(HID_T), VALUE :: lcpl_id_default + INTEGER(HID_T), VALUE :: dcpl_id_default + INTEGER(HID_T), VALUE :: dapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Dcreate_async END INTERFACE + c_name = TRIM(name)//C_NULL_CHAR + lcpl_id_default = H5P_DEFAULT_F dcpl_id_default = H5P_DEFAULT_F dapl_id_default = H5P_DEFAULT_F @@ -270,12 +353,18 @@ CONTAINS IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id IF(PRESENT(dcpl_id)) dcpl_id_default = dcpl_id IF(PRESENT(dapl_id)) dapl_id_default = dapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) - namelen = LEN(name) - hdferr = h5dcreate_c(loc_id, name, namelen, type_id, space_id, & - lcpl_id_default, dcpl_id_default, dapl_id_default, dset_id) + dset_id = h5dcreate_async(file_default, func_default, line_default, & + loc_id, c_name, type_id, space_id, & + lcpl_id_default, dcpl_id_default, dapl_id_default, es_id) - END SUBROUTINE h5dcreate_f + hdferr = 0 + IF(dset_id.LT.0) hdferr = -1 + + END SUBROUTINE h5dcreate_async_f !> !! \ingroup FH5D @@ -296,36 +385,105 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: name INTEGER(HID_T), INTENT(OUT) :: dset_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: dapl_id - INTEGER :: namelen ! Name length + INTEGER(HID_T), INTENT(IN), OPTIONAL :: dapl_id INTEGER(HID_T) :: dapl_id_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTERFACE - INTEGER FUNCTION h5dopen_c(loc_id, name, namelen, dapl_id_default, dset_id) & - BIND(C,NAME='h5dopen_c') + INTEGER(HID_T) FUNCTION H5Dopen2(loc_id, name, dapl_id_default) & + BIND(C,NAME='H5Dopen2') IMPORT :: C_CHAR IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER(HID_T), INTENT(IN) :: dapl_id_default - INTEGER(HID_T), INTENT(OUT) :: dset_id - END FUNCTION h5dopen_c + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T),VALUE :: dapl_id_default + END FUNCTION H5Dopen2 END INTERFACE + c_name = TRIM(name)//C_NULL_CHAR + dapl_id_default = H5P_DEFAULT_F IF(PRESENT(dapl_id)) dapl_id_default = dapl_id - namelen = LEN(name) - hdferr = h5dopen_c(loc_id, name, namelen, dapl_id_default, dset_id) + dset_id = INT(H5Dopen2(loc_id, c_name, dapl_id_default), HID_T) + + hdferr = 0 + IF(dset_id.LT.0) hdferr = -1 END SUBROUTINE h5dopen_f !> !! \ingroup FH5D !! +!! \brief Asynchronously opens an existing dataset. +!! +!! \param loc_id File or group identifier +!! \param name Dataset name +!! \param dset_id Dataset identifier +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param dapl_id Dataset access property list +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Dopen_async() +!! + SUBROUTINE h5dopen_async_f(loc_id, name, dset_id, es_id, hdferr, dapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T), INTENT(OUT) :: dset_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: dapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: dapl_id_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Dopen_async(file, func, line, loc_id, name, dapl_id_default, es_id) & + BIND(C,NAME='H5Dopen_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: dapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Dopen_async + END INTERFACE + + c_name = TRIM(name)//C_NULL_CHAR + + dapl_id_default = H5P_DEFAULT_F + IF(PRESENT(dapl_id)) dapl_id_default = dapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + dset_id = H5Dopen_async(file_default, func_default, line_default, & + loc_id, c_name, dapl_id_default, es_id) + + hdferr = 0 + IF(dset_id.LT.0) hdferr = -1 + + END SUBROUTINE h5dopen_async_f + +!> +!! \ingroup FH5D +!! !! \brief Closes a dataset. !! !! \param dset_id Dataset identifier @@ -337,22 +495,71 @@ CONTAINS IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id INTEGER, INTENT(OUT) :: hdferr + INTERFACE - INTEGER FUNCTION h5dclose_c(dset_id) & - BIND(C,NAME='h5dclose_c') + INTEGER(C_INT) FUNCTION H5Dclose(dset_id) BIND(C,NAME='H5Dclose') + IMPORT :: C_INT IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: dset_id - END FUNCTION h5dclose_c + INTEGER(HID_T), VALUE :: dset_id + END FUNCTION h5dclose END INTERFACE - hdferr = h5dclose_c(dset_id) + hdferr = INT(H5Dclose(dset_id)) END SUBROUTINE h5dclose_f !> !! \ingroup FH5D !! +!! \brief Asynchronously closes a dataset. +!! +!! \param dset_id Dataset identifier +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Dclose_async() +!! + SUBROUTINE h5dclose_async_f(dset_id, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Dclose_async(file, func, line, dset_id, es_id) BIND(C,NAME='H5Dclose_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: dset_id + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Dclose_async + END INTERFACE + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Dclose_async(file_default, func_default, line_default, dset_id, es_id)) + + END SUBROUTINE h5dclose_async_f + +!> +!! \ingroup FH5D +!! !! \brief Returns an identifier for a copy of the datatype for a !! dataset. !! @@ -386,29 +593,149 @@ CONTAINS !! \brief Extends a dataset with unlimited dimension. !! !! \param dataset_id Dataset identifier -!! \param size Array containing the new magnitude of each dimension +!! \param fsize Array containing the new magnitude of each dimension !! \param hdferr \fortran_error !! !! See C API: @ref H5Dset_extent() !! - SUBROUTINE h5dset_extent_f(dataset_id, size, hdferr) + SUBROUTINE h5dset_extent_f(dataset_id, fsize, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dataset_id - INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: size + INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: fsize INTEGER, INTENT(OUT) :: hdferr + + INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: csize + INTEGER(HID_T) :: space_id + INTEGER :: rank + INTEGER :: i + INTERFACE - INTEGER FUNCTION h5dset_extent_c(dataset_id, size) & - BIND(C,NAME='h5dset_extent_c') + INTEGER(C_INT) FUNCTION H5Dset_extent(dataset_id, size) & + BIND(C,NAME='H5Dset_extent') + IMPORT :: C_INT IMPORT :: HID_T, HSIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: dataset_id - INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: size - END FUNCTION h5dset_extent_c + INTEGER(HID_T), VALUE :: dataset_id + INTEGER(HSIZE_T), DIMENSION(*) :: size + END FUNCTION H5Dset_extent END INTERFACE - hdferr = H5Dset_extent_c(dataset_id, size) + CALL H5Dget_space_f(dataset_id, space_id, hdferr) + IF(hdferr.LT.0) RETURN + + CALL H5Sget_simple_extent_ndims_f(space_id, rank, hdferr) + IF( hdferr.LT.0 .OR. rank.LT.0 )THEN + CALL H5Sclose_f(space_id, hdferr) + hdferr = -1 + RETURN + ENDIF + CALL H5Sclose_f(space_id, hdferr) + IF(hdferr.LT.0) RETURN + + ALLOCATE(csize(rank), STAT=hdferr) + IF (hdferr .NE. 0 ) THEN + hdferr = -1 + RETURN + ENDIF + + ! + ! Reverse dimensions due to C-FORTRAN storage order. + ! + DO i = 1, rank + csize(i) = fsize(rank - i + 1) + ENDDO + + hdferr = INT(H5Dset_extent(dataset_id, csize)) + + DEALLOCATE(csize) + END SUBROUTINE h5dset_extent_f + +!> +!! \ingroup FH5D +!! +!! \brief Asynchronously extends a dataset with unlimited dimension. +!! +!! \param dataset_id Dataset identifier +!! \param fsize Array containing the new magnitude of each dimension +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Dset_extent_async() +!! + SUBROUTINE h5dset_extent_async_f(dataset_id, fsize, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dataset_id + INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: fsize + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: csize + INTEGER(HID_T) :: space_id + INTEGER :: rank + INTEGER :: i + + INTERFACE + INTEGER(C_INT) FUNCTION H5Dset_extent_async(file, func, line, dataset_id, size, es_id) & + BIND(C,NAME='H5Dset_extent_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, HSIZE_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: dataset_id + INTEGER(HSIZE_T), DIMENSION(*) :: size + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Dset_extent_async + END INTERFACE + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + CALL H5Dget_space_f(dataset_id, space_id, hdferr) + IF(hdferr.LT.0) RETURN + + CALL H5Sget_simple_extent_ndims_f(space_id, rank, hdferr) + IF( hdferr.LT.0 .OR. rank.LT.0 )THEN + CALL H5Sclose_f(space_id, hdferr) + hdferr = -1 + RETURN + ENDIF + CALL H5Sclose_f(space_id, hdferr) + IF(hdferr.LT.0) RETURN + + ALLOCATE(csize(rank), STAT=hdferr) + IF (hdferr .NE. 0 ) THEN + hdferr = -1 + RETURN + ENDIF + + ! + ! Reverse dimensions due to C-FORTRAN storage order. + ! + DO i = 1, rank + csize(i) = fsize(rank - i + 1) + ENDDO + + hdferr = INT(H5Dset_extent_async(file_default, func_default, line_default, & + dataset_id, csize, es_id)) + + DEALLOCATE(csize) + + END SUBROUTINE h5dset_extent_async_f + !> !! \ingroup FH5D !! @@ -551,8 +878,8 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: space_id INTEGER(HID_T), INTENT(OUT) :: dset_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: dcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: dapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: dcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: dapl_id INTEGER(HID_T) :: dcpl_id_default INTEGER(HID_T) :: dapl_id_default @@ -611,14 +938,14 @@ CONTAINS INTEGER(HSIZE_T), INTENT(IN), DIMENSION(2) :: dims INTEGER(SIZE_T), INTENT(INOUT), DIMENSION(*) :: len INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp END SUBROUTINE h5dread_vl_f !> !! \ingroup FH5D !! - !! \brief Writes variable-length data. F2003 API h5dwritef should be used instead. + !! \brief Writes variable-length data. F2003 API h5dwrite_f should be used instead. !! !! \param dset_id Dataset identifier. !! \param mem_type_id Memory datatype identifier. @@ -641,9 +968,9 @@ CONTAINS INTEGER(HSIZE_T), INTENT(IN), DIMENSION(2) :: dims INTEGER(SIZE_T), INTENT(IN), DIMENSION(*) :: len INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp END SUBROUTINE h5dwrite_vl_f #else @@ -657,9 +984,9 @@ CONTAINS INTEGER(SIZE_T), INTENT(IN), DIMENSION(*) :: len INTEGER, INTENT(IN), DIMENSION(dims(1),dims(2)), TARGET :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default INTEGER(HID_T) :: file_space_id_default @@ -707,9 +1034,9 @@ CONTAINS INTEGER(SIZE_T), INTENT(INOUT), DIMENSION(*) :: len INTEGER, INTENT(INOUT), DIMENSION(dims(1),dims(2)), TARGET :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default INTEGER(HID_T) :: file_space_id_default @@ -761,9 +1088,9 @@ CONTAINS REAL, INTENT(IN), & DIMENSION(dims(1),dims(2)) :: buf ! Data buffer INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default @@ -815,9 +1142,9 @@ CONTAINS REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2)) :: buf ! Data buffer INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default @@ -871,9 +1198,9 @@ CONTAINS INTEGER(SIZE_T), INTENT(IN), DIMENSION(*) :: str_len CHARACTER(LEN=*), INTENT(IN), DIMENSION(dims(2)) :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default @@ -925,9 +1252,9 @@ CONTAINS CHARACTER(LEN=*), INTENT(OUT), & DIMENSION(dims(2)) :: buf ! Data buffer INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default @@ -1001,8 +1328,7 @@ CONTAINS !> !! \ingroup FH5D !! -!! \brief Returns an identifier for a copy of the dataspace for a -!! dataset. +!! \brief Returns an identifier for a copy of the dataspace for a dataset. !! !! \param dataset_id Dataset identifier. !! \param dataspace_id Dataspace identifier. @@ -1016,20 +1342,78 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: dataspace_id INTEGER, INTENT(OUT) :: hdferr INTERFACE - INTEGER FUNCTION h5dget_space_c(dataset_id, dataspace_id) BIND(C,NAME='h5dget_space_c') + INTEGER(HID_T) FUNCTION H5Dget_space(dataset_id) BIND(C,NAME='H5Dget_space') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: dataset_id - INTEGER(HID_T), INTENT(OUT) :: dataspace_id - END FUNCTION h5dget_space_c + INTEGER(HID_T), VALUE :: dataset_id + END FUNCTION H5Dget_space END INTERFACE - hdferr = h5dget_space_c(dataset_id, dataspace_id) + dataspace_id = h5dget_space(dataset_id) + + hdferr = 0 + IF(dataspace_id.LT.0) hdferr = -1 + END SUBROUTINE h5dget_space_f !> !! \ingroup FH5D !! +!! \brief Asynchronously returns an identifier for a copy of the dataspace for a dataset. +!! +!! \param dataset_id Dataset identifier. +!! \param dataspace_id Dataspace identifier. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Dget_space_async() +!! + SUBROUTINE h5dget_space_async_f(dataset_id, dataspace_id, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dataset_id + INTEGER(HID_T), INTENT(OUT) :: dataspace_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Dget_space_async(file, func, line, dataset_id, es_id) & + BIND(C,NAME='H5Dget_space_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: dataset_id + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Dget_space_async + END INTERFACE + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + dataspace_id = H5Dget_space_async(file_default, func_default, line_default, & + dataset_id, es_id) + + hdferr = 0 + IF(dataspace_id.LT.0) hdferr = -1 + + END SUBROUTINE h5dget_space_async_f + +!> +!! \ingroup FH5D +!! !! \brief Returns a copy of the dataset creation property list. !! !! \param dset_id Dataset identifier. @@ -1091,7 +1475,141 @@ CONTAINS hdferr = H5Dvlen_reclaim_c(type_id, space_id, plist_id, buf) - END SUBROUTINE H5Dvlen_reclaim_f + END SUBROUTINE h5dvlen_reclaim_f + +!> +!! \ingroup FH5D +!! +!! \brief Asynchronously reads raw data from a dataset into a buffer. +!! +!! \param dset_id Identifier of the dataset read from. +!! \param mem_type_id Identifier of the memory datatype. +!! \param buf Buffer to receive data read from file. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param mem_space_id Identifier of the memory dataspace. +!! \param file_space_id Identifier of dataset's dataspace in the file. (Default: H5S_ALL_F) +!! \param xfer_prp Identifier of a transfer property list for this I/O operation. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Dread_async() +!! + SUBROUTINE h5dread_async_f(dset_id, mem_type_id, buf, es_id, hdferr, & + mem_space_id, file_space_id, xfer_prp, file, func, line) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id + INTEGER(HID_T), INTENT(IN) :: mem_type_id + TYPE(C_PTR), INTENT(INOUT) :: buf + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Dread_async(file, func, line, dset_id, mem_type_id, & + mem_space_id, file_space_id, xfer_prp, buf, es_id) BIND(C,NAME='H5Dread_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: dset_id + INTEGER(HID_T), VALUE :: mem_type_id + INTEGER(HID_T), VALUE :: mem_space_id + INTEGER(HID_T), VALUE :: file_space_id + INTEGER(HID_T), VALUE :: xfer_prp + TYPE(C_PTR) , VALUE :: buf + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Dread_async + END INTERFACE + + IF (PRESENT(file)) file_default = file + IF (PRESENT(func)) func_default = func + IF (PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = H5Dread_async(file_default, func_default, line_default, & + dset_id, mem_type_id, mem_space_id, file_space_id, xfer_prp, buf, es_id ) + + END SUBROUTINE h5dread_async_f + +!> +!! \ingroup FH5D +!! +!! \brief Asynchronously writes raw data from a buffer to a dataset. +!! +!! \param dset_id Identifier of the dataset to write to. +!! \param mem_type_id Identifier of the memory datatype. +!! \param buf Buffer with data to be written to the file. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param mem_space_id Identifier of the memory dataspace. +!! \param file_space_id Identifier of the dataset's dataspace in the file. +!! \param xfer_prp Identifier of a transfer property list for this I/O operation. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Dwrite_async() +!! + SUBROUTINE h5dwrite_async_f(dset_id, mem_type_id, buf, es_id, hdferr, & + mem_space_id, file_space_id, xfer_prp, file, func, line) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id + INTEGER(HID_T), INTENT(IN) :: mem_type_id + TYPE(C_PTR), INTENT(IN) :: buf + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Dwrite_async(file, func, line, dset_id, mem_type_id, & + mem_space_id, file_space_id, xfer_prp, buf, es_id) BIND(C,NAME='H5Dwrite_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: dset_id + INTEGER(HID_T), VALUE :: mem_type_id + INTEGER(HID_T), VALUE :: mem_space_id + INTEGER(HID_T), VALUE :: file_space_id + INTEGER(HID_T), VALUE :: xfer_prp + TYPE(C_PTR) , VALUE :: buf + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Dwrite_async + END INTERFACE + + IF (PRESENT(file)) file_default = file + IF (PRESENT(func)) func_default = func + IF (PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = H5Dwrite_async(file_default, func_default, line_default, & + dset_id, mem_type_id, mem_space_id, file_space_id, xfer_prp, buf, es_id) + + END SUBROUTINE h5dwrite_async_f #ifdef H5_DOXYGEN !> @@ -1118,9 +1636,9 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: mem_type_id TYPE(C_PTR), INTENT(IN) :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp END SUBROUTINE h5dwrite !> !! \ingroup FH5D @@ -1146,9 +1664,9 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: mem_type_id TYPE(C_PTR), INTENT(INOUT) :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp END SUBROUTINE h5dread_f !> @@ -1177,9 +1695,9 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: mem_type_id TYPE(TYPE), INTENT(IN) :: buf DIMENSION(*), INTEGER(HSIZE_T), INTENT(IN) :: dims - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp END SUBROUTINE h5dwrite_f___F90_VERSION !> @@ -1209,9 +1727,9 @@ CONTAINS INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims TYPE(TYPE), INTENT(INOUT) :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp END SUBROUTINE h5dread_f___F90_VERSION !> @@ -1273,9 +1791,9 @@ CONTAINS INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: dims TYPE(hobj_ref_t_f), DIMENSION(dims(1)), INTENT(IN), TARGET :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default @@ -1305,9 +1823,9 @@ CONTAINS INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: dims TYPE(hdset_reg_ref_t_f), DIMENSION(dims(1)), INTENT(IN), TARGET :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default @@ -1315,7 +1833,6 @@ CONTAINS INTEGER, ALLOCATABLE, DIMENSION(:) :: ref_buf INTEGER :: i INTEGER(HSIZE_T) :: j - TYPE(C_PTR) :: f_ptr INTERFACE INTEGER FUNCTION h5dwrite_ref_reg_c(dset_id, mem_type_id,& mem_space_id_default, & @@ -1339,7 +1856,6 @@ CONTAINS IF(PRESENT(xfer_prp)) xfer_prp_default = xfer_prp IF(PRESENT(mem_space_id)) mem_space_id_default = mem_space_id IF(PRESENT(file_space_id)) file_space_id_default = file_space_id - f_ptr = C_LOC(buf(1)) ALLOCATE(ref_buf(REF_REG_BUF_LEN*dims(1)), stat=hdferr) IF (hdferr .NE. 0 ) THEN @@ -1360,16 +1876,15 @@ CONTAINS SUBROUTINE h5dwrite_char_scalar(dset_id, mem_type_id, buf, dims, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id INTEGER(HID_T), INTENT(IN) :: mem_type_id INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims CHARACTER(*), INTENT(IN), TARGET :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp CALL h5dwrite_char_scalar_fix(dset_id, mem_type_id, buf, LEN(buf), dims, hdferr, & mem_space_id, file_space_id, xfer_prp) @@ -1378,7 +1893,6 @@ CONTAINS SUBROUTINE h5dwrite_char_scalar_fix(dset_id, mem_type_id, buf, buf_len, dims, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id INTEGER(HID_T), INTENT(IN) :: mem_type_id @@ -1386,9 +1900,9 @@ CONTAINS INTEGER, INTENT(IN) :: buf_len CHARACTER(LEN=buf_len), INTENT(IN), TARGET :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default INTEGER(HID_T) :: file_space_id_default @@ -1411,7 +1925,6 @@ CONTAINS SUBROUTINE h5dread_reference_obj(dset_id, mem_type_id, buf, dims, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id INTEGER(HID_T), INTENT(IN) :: mem_type_id @@ -1419,9 +1932,9 @@ CONTAINS TYPE(hobj_ref_t_f), INTENT(INOUT) , & DIMENSION(dims(1)), TARGET :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default @@ -1451,9 +1964,9 @@ CONTAINS TYPE(hdset_reg_ref_t_f), INTENT(INOUT), & DIMENSION(dims(1)), TARGET :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default INTEGER(HID_T) :: file_space_id_default @@ -1506,7 +2019,6 @@ CONTAINS SUBROUTINE h5dread_char_scalar(dset_id, mem_type_id, buf, dims, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id INTEGER(HID_T), INTENT(IN) :: mem_type_id @@ -1514,9 +2026,9 @@ CONTAINS CHARACTER(LEN=*), INTENT(INOUT) :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default @@ -1537,16 +2049,15 @@ CONTAINS SUBROUTINE h5dread_char_scalar_fix(dset_id, mem_type_id, buf, buf_len, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id INTEGER(HID_T), INTENT(IN) :: mem_type_id INTEGER, INTENT(IN) :: buf_len CHARACTER(LEN=buf_len), INTENT(INOUT), TARGET :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp TYPE(C_PTR) :: f_ptr @@ -1559,15 +2070,14 @@ CONTAINS SUBROUTINE h5dwrite_ptr(dset_id, mem_type_id, buf, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id INTEGER(HID_T), INTENT(IN) :: mem_type_id TYPE(C_PTR), INTENT(IN) :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default @@ -1588,15 +2098,14 @@ CONTAINS SUBROUTINE h5dread_ptr(dset_id, mem_type_id, buf, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id INTEGER(HID_T), INTENT(IN) :: mem_type_id TYPE(C_PTR), INTENT(INOUT) :: buf INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp INTEGER(HID_T) :: xfer_prp_default INTEGER(HID_T) :: mem_space_id_default @@ -1616,7 +2125,6 @@ CONTAINS END SUBROUTINE h5dread_ptr SUBROUTINE h5dfill_ptr(fill_value, fill_type_id, buf, buf_type_id, space_id, hdferr) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE TYPE(C_PTR) :: fill_value INTEGER(HID_T), INTENT(IN) :: fill_type_id @@ -1643,7 +2151,6 @@ CONTAINS END SUBROUTINE h5dfill_ptr SUBROUTINE h5dfill_integer(fill_value, space_id, buf, hdferr) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER, INTENT(IN), TARGET :: fill_value ! Fill value INTEGER(HID_T), INTENT(IN) :: space_id ! Memory dataspace selection identifier @@ -1667,7 +2174,6 @@ CONTAINS END SUBROUTINE h5dfill_integer SUBROUTINE h5dfill_c_float(fill_value, space_id, buf, hdferr) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE REAL(KIND=C_FLOAT), INTENT(IN), TARGET :: fill_value INTEGER(HID_T), INTENT(IN) :: space_id @@ -1739,7 +2245,6 @@ CONTAINS #endif SUBROUTINE h5dfill_char(fill_value, space_id, buf, hdferr) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE CHARACTER, INTENT(IN), TARGET :: fill_value INTEGER(HID_T), INTENT(IN) :: space_id @@ -1775,7 +2280,7 @@ CONTAINS !! \param hdferr \fortran_error !! \param xfer_prp Identifier of a transfer property list for this I/O operation. !! - SUBROUTINE H5Dread_multi_f(count, dset_id, mem_type_id, mem_space_id, file_space_id, buf, hdferr, xfer_prp) + SUBROUTINE h5dread_multi_f(count, dset_id, mem_type_id, mem_space_id, file_space_id, buf, hdferr, xfer_prp) IMPLICIT NONE INTEGER(SIZE_T), INTENT(IN) :: count @@ -1811,7 +2316,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 + END SUBROUTINE h5dread_multi_f !> !! \ingroup FH5D !! @@ -1826,7 +2331,7 @@ CONTAINS !! \param hdferr \fortran_error !! \param xfer_prp Identifier of a transfer property list for this I/O operation. !! - SUBROUTINE H5Dwrite_multi_f(count, dset_id, mem_type_id, mem_space_id, file_space_id, buf, hdferr, xfer_prp) + SUBROUTINE h5dwrite_multi_f(count, dset_id, mem_type_id, mem_space_id, file_space_id, buf, hdferr, xfer_prp) IMPLICIT NONE INTEGER(SIZE_T), INTENT(IN) :: count @@ -1862,7 +2367,7 @@ CONTAINS hdferr = H5Dwrite_multi(count, dset_id, mem_type_id, mem_space_id, file_space_id, xfer_prp_default, buf) - END SUBROUTINE H5Dwrite_multi_f + END SUBROUTINE h5dwrite_multi_f #endif diff --git a/fortran/src/H5ESff.F90 b/fortran/src/H5ESff.F90 new file mode 100644 index 0000000..5b19a51 --- /dev/null +++ b/fortran/src/H5ESff.F90 @@ -0,0 +1,296 @@ +!> @defgroup FH5ES Fortran Event Set (H5ES) Interface +!! +!! @see H5ES, C-API +!! +!! @see @ref H5ES_UG, User Guide +!! +! +! 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. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! + +MODULE H5ES + + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR, C_INT64_T, C_BOOL + USE H5GLOBAL + IMPLICIT NONE + +CONTAINS + +!> +!! \ingroup FH5ES +!! +!! \brief Creates an event set. +!! +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5EScreate() +!! + SUBROUTINE h5escreate_f(es_id, hdferr) + IMPLICIT NONE + + INTEGER(HID_T), INTENT(OUT) :: es_id + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(HID_T) FUNCTION H5EScreate() BIND(C,NAME='H5EScreate') + IMPORT :: HID_T + END FUNCTION H5EScreate + END INTERFACE + + es_id = H5EScreate() + + hdferr = 0 + IF(es_id.LT.0) hdferr = -1 + + END SUBROUTINE h5escreate_f +!> +!! \ingroup FH5ES +!! +!! \brief Retrieves number of events in an event set. +!! +!! \param es_id \es_id +!! \param count The number of events in the event set +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5ESget_count() +!! + SUBROUTINE h5esget_count_f(es_id, count, hdferr) + IMPLICIT NONE + + INTEGER(hid_t), INTENT(IN) :: es_id + INTEGER(size_t), INTENT(OUT) :: count + INTEGER, INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5ESget_count(es_id, count) BIND(C,NAME='H5ESget_count') + IMPORT :: C_INT + IMPORT :: HID_T, SIZE_T + INTEGER(HID_T), VALUE :: es_id + INTEGER(SIZE_T) :: count + END FUNCTION H5ESget_count + END INTERFACE + + hdferr = INT(H5ESget_count(es_id, count)) + + END SUBROUTINE h5esget_count_f +!> +!! \ingroup FH5ES +!! +!! \brief Retrieves the next operation counter to be assigned in an event set. +!! +!! \param es_id \es_id +!! \param counter The number of events in the event set +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5ESget_op_counter() +!! + SUBROUTINE h5esget_op_counter_f(es_id, counter, hdferr) + + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: es_id + INTEGER(C_INT64_T), INTENT(OUT) :: counter + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5ESget_op_counter(es_id, counter) BIND(C,NAME='H5ESget_op_counter') + IMPORT :: C_INT + IMPORT :: HID_T, C_INT64_T + INTEGER(HID_T) , VALUE :: es_id + INTEGER(C_INT64_T) :: counter + END FUNCTION H5ESget_op_counter + END INTERFACE + + hdferr = INT(H5ESget_op_counter(es_id, counter)) + + END SUBROUTINE h5esget_op_counter_f +!> +!! \ingroup FH5ES +!! +!! \brief Waits for operations in event set to complete. +!! +!! \param es_id \es_id +!! \param timeout The number of events in the event set +!! \param num_in_progress The number of operations still in progress +!! \param err_occurred Flag if an operation in the event set failed +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5ESwait() +!! + SUBROUTINE h5eswait_f(es_id, timeout, num_in_progress, err_occurred, hdferr) + + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: es_id + INTEGER(C_INT64_T), INTENT(IN) :: timeout + INTEGER(SIZE_T) , INTENT(OUT) :: num_in_progress + LOGICAL , INTENT(OUT) :: err_occurred + INTEGER , INTENT(OUT) :: hdferr + + LOGICAL(C_BOOL) :: err_occurred_c = .FALSE. + + INTERFACE + INTEGER(C_INT) FUNCTION H5ESwait(es_id, timeout, num_in_progress, err_occurred) BIND(C,NAME='H5ESwait') + IMPORT :: C_INT + IMPORT :: HID_T, C_INT64_T, SIZE_T, C_BOOL + INTEGER(HID_T) , VALUE :: es_id + INTEGER(C_INT64_T), VALUE :: timeout + INTEGER(SIZE_T) :: num_in_progress + LOGICAL(C_BOOL) :: err_occurred + END FUNCTION H5ESwait + END INTERFACE + + hdferr = INT(H5ESwait(es_id, timeout, num_in_progress, err_occurred_c)) + + ! Transfer value of C c_bool type to Fortran LOGICAL + err_occurred = err_occurred_c + + END SUBROUTINE h5eswait_f +!> +!! \ingroup FH5ES +!! +!! \brief Attempt to cancel operations in an event set. +!! +!! \param es_id \es_id +!! \param num_not_canceled The number of events not canceled +!! \param err_occurred Status indicating if error is present in the event set +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5EScancel() +!! + SUBROUTINE h5escancel_f(es_id, num_not_canceled, err_occurred, hdferr) + + IMPLICIT NONE + + INTEGER(hid_t) , INTENT(IN) :: es_id + INTEGER(size_t), INTENT(OUT) :: num_not_canceled + LOGICAL , INTENT(OUT) :: err_occurred + INTEGER , INTENT(OUT) :: hdferr + + LOGICAL(C_BOOL) :: err_occurred_c = .FALSE. + + INTERFACE + INTEGER(C_INT) FUNCTION H5EScancel(es_id, num_not_canceled, err_occurred) BIND(C,NAME='H5EScancel') + IMPORT :: C_INT + IMPORT :: HID_T, SIZE_T, C_BOOL + INTEGER(HID_T) , VALUE :: es_id + INTEGER(SIZE_T) :: num_not_canceled + LOGICAL(C_BOOL) :: err_occurred + END FUNCTION H5EScancel + END INTERFACE + + hdferr = INT(H5EScancel(es_id, num_not_canceled, err_occurred_c)) + + ! Transfer value of C c_bool type to Fortran LOGICAL + err_occurred = err_occurred_c + + END SUBROUTINE h5escancel_f +!> +!! \ingroup FH5ES +!! +!! \brief Checks for failed operations. +!! +!! \param es_id \es_id +!! \param err_occurred Status indicating if error is present in the event set +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5ESget_err_status() +!! + SUBROUTINE h5esget_err_status_f(es_id, err_occurred, hdferr) + + IMPLICIT NONE + + INTEGER(hid_t), INTENT(IN) :: es_id + LOGICAL , INTENT(OUT) :: err_occurred + INTEGER , INTENT(OUT) :: hdferr + + LOGICAL(C_BOOL) :: err_occurred_c = .FALSE. + + INTERFACE + INTEGER(C_INT) FUNCTION H5ESget_err_status(es_id, err_occurred) BIND(C,NAME='H5ESget_err_status') + IMPORT :: C_INT + IMPORT :: HID_T, C_BOOL + INTEGER(HID_T) , VALUE :: es_id + LOGICAL(C_BOOL) :: err_occurred + END FUNCTION H5ESget_err_status + END INTERFACE + + hdferr = INT(H5ESget_err_status(es_id, err_occurred_c)) + + ! Transfer value of C c_bool type to Fortran LOGICAL + err_occurred = err_occurred_c + + END SUBROUTINE h5esget_err_status_f +!> +!! \ingroup FH5ES +!! +!! \brief Retrieves the number of failed operations. +!! +!! \param es_id \es_id +!! \param num_errs Number of errors +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5ESget_err_count() +!! + SUBROUTINE h5esget_err_count_f(es_id, num_errs, hdferr) + + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: es_id + INTEGER(SIZE_T), INTENT(OUT) :: num_errs + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5ESget_err_count(es_id, num_errs) BIND(C,NAME='H5ESget_err_count') + IMPORT :: C_INT + IMPORT :: HID_T, SIZE_T + INTEGER(HID_T) , VALUE :: es_id + INTEGER(SIZE_T) :: num_errs + END FUNCTION H5ESget_err_count + END INTERFACE + + hdferr = INT(H5ESget_err_count(es_id, num_errs)) + + END SUBROUTINE h5esget_err_count_f + +!> +!! \ingroup FH5ES +!! +!! \brief Terminates access to an event set. +!! +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5ESclose() +!! + SUBROUTINE h5esclose_f(es_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5ESclose(es_id) BIND(C,NAME='H5ESclose') + IMPORT :: C_INT + IMPORT :: HID_T + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5ESclose + END INTERFACE + + hdferr = INT(H5ESclose(es_id)) + + END SUBROUTINE h5esclose_f + +END MODULE H5ES diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 26b2c77..a4c9e8c 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -58,7 +58,7 @@ CONTAINS SUBROUTINE h5eclear_f(hdferr, estack_id) IMPLICIT NONE INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: estack_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: estack_id INTEGER(HID_T) :: estack_id_default INTERFACE @@ -86,7 +86,7 @@ CONTAINS !! See C API: @ref H5Eprint2() !! SUBROUTINE h5eprint_f(hdferr, name) - CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: name + CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name INTEGER, INTENT(OUT) :: hdferr INTEGER :: namelen diff --git a/fortran/src/H5Ff.c b/fortran/src/H5Ff.c index 7402e18..b2f09ef 100644 --- a/fortran/src/H5Ff.c +++ b/fortran/src/H5Ff.c @@ -91,47 +91,6 @@ h5fcreate_c(_fcd name, int_f *namelen, int_f *access_flags, hid_t_f *crt_prp, hi return ret_value; } -/****if* H5Ff/h5fflush_c - * NAME - * h5fflush_c - * PURPOSE - * Call H5Fflush to flush the object - * INPUTS - * object_id - identifier of either a file, a dataset, - * a group, an attribute or a named data type - * scope - integer to specify the flushing action, either - * H5F_SCOPE_GLOBAL or H5F_SCOPE_LOCAL - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Xiangyang Su - * Friday, November 5, 1999 - * SOURCE - */ -int_f -h5fflush_c(hid_t_f *object_id, int_f *scope) -/******/ -{ - int ret_value = -1; - hid_t c_file_id; - H5F_scope_t c_scope; - htri_t status; - c_scope = (H5F_scope_t)*scope; - - /* - * Call H5Fflush function. - */ - - c_file_id = *object_id; - - status = H5Fflush(c_file_id, c_scope); - - if (status >= 0) - ret_value = 0; - - return ret_value; -} - /****if* H5Ff/h5fmount_c * NAME * h5fmount_c @@ -240,103 +199,6 @@ h5funmount_c(hid_t_f *loc_id, _fcd dsetname, int_f *namelen) return ret_value; } -/****if* H5Ff/h5fopen_c - * NAME - * h5fopen_c - * PURPOSE - * Call H5Fopen to open the file - * INPUTS - * name - name of the file - * namelen - name length - * access_flags - file access flags - * acc_prp - identifier of access property list - * OUTPUTS - * file_id - file identifier - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Tuesday, August 3, 1999 - * SOURCE - */ -int_f -h5fopen_c(_fcd name, int_f *namelen, int_f *access_flags, hid_t_f *acc_prp, hid_t_f *file_id) -/******/ -{ - int ret_value = -1; - char *c_name; - int_f c_namelen; - hid_t c_file_id; - unsigned c_access_flags; - hid_t c_acc_prp; - c_acc_prp = (hid_t)*acc_prp; - - /* - * Define access flags - */ - c_access_flags = (unsigned)*access_flags; - - /* - * Define access property - */ - c_acc_prp = *acc_prp; - - /* - * Convert FORTRAN name to C name - */ - c_namelen = *namelen; - c_name = (char *)HD5f2cstring(name, (size_t)c_namelen); - if (c_name == NULL) - return ret_value; - - /* - * Call H5Fopen function. - */ - c_file_id = H5Fopen(c_name, c_access_flags, c_acc_prp); - - if (c_file_id >= 0) { - ret_value = 0; - *file_id = (hid_t_f)c_file_id; - } /* end if */ - - HDfree(c_name); - return ret_value; -} - -/****if* H5Ff/h5freopen_c - * NAME - * h5freopen_c - * PURPOSE - * Call H5Freopen to open the file - * INPUTS - * file_id1 - file identifier - * OUTPUTS - * file_id2 - file identifier - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Xiangyang Su - * Wednesday, November 3, 1999 - * SOURCE - */ -int_f -h5freopen_c(hid_t_f *file_id1, hid_t_f *file_id2) -/******/ -{ - int ret_value = -1; - hid_t c_file_id1, c_file_id2; - - c_file_id1 = *file_id1; - c_file_id2 = H5Freopen(c_file_id1); - - if (c_file_id2 < 0) - return ret_value; - *file_id2 = (hid_t_f)c_file_id2; - - ret_value = 0; - return ret_value; -} - /****if* H5Ff/h5fget_create_plist_c * NAME * h5fget_create_plist_c @@ -407,35 +269,6 @@ h5fget_access_plist_c(hid_t_f *file_id, hid_t_f *access_id) return ret_value; } -/****if* H5Ff/h5fclose_c - * NAME - * h5fclose_c - * PURPOSE - * Call H5Fclose to close the file - * INPUTS - * file_id - identifier of the file to be closed - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Monday, July 26, 1999 - * HISTORY - * - * SOURCE - */ - -int_f -h5fclose_c(hid_t_f *file_id) -/******/ -{ - int ret_value = 0; - hid_t c_file_id; - - c_file_id = (hid_t)*file_id; - if (H5Fclose(c_file_id) < 0) - ret_value = -1; - return ret_value; -} /****if* H5Ff/h5fget_obj_count_c * NAME * h5fget_obj_count_c diff --git a/fortran/src/H5Fff.F90 b/fortran/src/H5Fff.F90 index 551db7d..f1a0d2a 100644 --- a/fortran/src/H5Fff.F90 +++ b/fortran/src/H5Fff.F90 @@ -43,6 +43,7 @@ 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, & @@ -81,46 +82,127 @@ CONTAINS INTEGER, INTENT(IN) :: access_flags INTEGER(HID_T), INTENT(OUT) :: file_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: creation_prp - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: creation_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: access_prp + INTEGER(HID_T) :: creation_prp_default INTEGER(HID_T) :: access_prp_default - INTEGER :: namelen ! Length of the name character string + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTERFACE - INTEGER FUNCTION h5fcreate_c(name, namelen, access_flags, & - creation_prp_default, access_prp_default, file_id) BIND(C,NAME='h5fcreate_c') + INTEGER(HID_T) FUNCTION H5Fcreate(name, access_flags, & + creation_prp_default, access_prp_default) BIND(C,NAME='H5Fcreate') IMPORT :: C_CHAR IMPORT :: HID_T - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER, INTENT(IN) :: access_flags - INTEGER(HID_T), INTENT(OUT) :: file_id - INTEGER(HID_T), INTENT(IN) :: creation_prp_default - INTEGER(HID_T), INTENT(IN) :: access_prp_default - INTEGER :: namelen - END FUNCTION h5fcreate_c + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER, VALUE :: access_flags + INTEGER(HID_T), VALUE :: creation_prp_default + INTEGER(HID_T), VALUE :: access_prp_default + END FUNCTION H5Fcreate END INTERFACE + c_name = TRIM(name)//C_NULL_CHAR + creation_prp_default = H5P_DEFAULT_F access_prp_default = H5P_DEFAULT_F IF (PRESENT(creation_prp)) creation_prp_default = creation_prp IF (PRESENT(access_prp)) access_prp_default = access_prp - namelen = LEN_TRIM(name) - hdferr = h5fcreate_c(name, namelen, access_flags, & - creation_prp_default, access_prp_default, file_id) + + file_id = h5fcreate(c_name, access_flags, & + creation_prp_default, access_prp_default) + + hdferr = 0 + IF(file_id.LT.0) hdferr = -1 END SUBROUTINE h5fcreate_f + !> !! \ingroup FH5F !! -!! \brief Flushes all buffers associated with a file to disk +!! \brief Asynchronously creates HDF5 files. !! -!! \param object_id Identifier of object used to identify the file. -!! \param scope Specifies the scope of the flushing action. Possible values are: -!! \li H5F_SCOPE_GLOBAL_F -!! \li H5F_SCOPE_LOCAL_F +!! \param name Name of the file to create +!! \param access_flags File access flags. Allowable values are: +!! \li H5F_ACC_TRUNC_F +!! \li H5F_ACC_EXCL_F +!! \param file_id File identifier +!! \param es_id \es_id !! \param hdferr \fortran_error +!! \param creation_prp File creation property list identifier +!! \param access_prp File access property list identifier +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Fcreate_async() +!! + SUBROUTINE h5fcreate_async_f(name, access_flags, file_id, es_id, hdferr, & + creation_prp, access_prp, file, func, line) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER, INTENT(IN) :: access_flags + INTEGER(HID_T), INTENT(OUT) :: file_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: creation_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: access_prp + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: creation_prp_default + INTEGER(HID_T) :: access_prp_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Fcreate_async(file, func, line, name, access_flags, & + creation_prp_default, access_prp_default, es_id) BIND(C,NAME='H5Fcreate_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER, VALUE :: access_flags + INTEGER(HID_T), VALUE :: creation_prp_default + INTEGER(HID_T), VALUE :: access_prp_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Fcreate_async + END INTERFACE + + c_name = TRIM(name)//C_NULL_CHAR + + creation_prp_default = H5P_DEFAULT_F + access_prp_default = H5P_DEFAULT_F + + IF(PRESENT(creation_prp)) creation_prp_default = creation_prp + IF(PRESENT(access_prp)) access_prp_default = access_prp + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + file_id = H5Fcreate_async(file_default, func_default, line_default, & + c_name, access_flags, creation_prp_default, access_prp_default, es_id) + + hdferr = 0 + IF(file_id.LT.0) hdferr = -1 + + END SUBROUTINE h5fcreate_async_f +!> +!! \ingroup FH5F +!! +!! \brief Flushes all buffers associated with a file to disk. +!! +!! \param object_id Identifier of object used to identify the file. +!! \param scope Specifies the scope of the flushing action. Possible values are: +!! \li H5F_SCOPE_GLOBAL_F +!! \li H5F_SCOPE_LOCAL_F +!! \param hdferr \fortran_error !! !! See C API: @ref H5Fflush() !! @@ -131,20 +213,75 @@ CONTAINS INTEGER, INTENT(OUT) :: hdferr INTERFACE - INTEGER FUNCTION h5fflush_c(object_id, scope) BIND(C,NAME='h5fflush_c') + INTEGER FUNCTION H5Fflush(object_id, scope) BIND(C,NAME='H5Fflush') + IMPORT :: C_INT IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: object_id - INTEGER, INTENT(IN) :: scope - END FUNCTION h5fflush_c + INTEGER(HID_T), VALUE :: object_id + INTEGER(C_INT), VALUE :: scope + END FUNCTION H5Fflush END INTERFACE - hdferr = h5fflush_c(object_id, scope) + hdferr = H5Fflush(object_id, INT(scope, C_INT)) END SUBROUTINE h5fflush_f !> !! \ingroup FH5F !! +!! \brief Asynchronously flushes all buffers associated with a file to disk. +!! +!! \param object_id Identifier of object used to identify the file. +!! \param scope Specifies the scope of the flushing action. Possible values are: +!! \li H5F_SCOPE_GLOBAL_F +!! \li H5F_SCOPE_LOCAL_F +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Fflush_async() +!! + SUBROUTINE h5fflush_async_f(object_id, scope, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: object_id + INTEGER, INTENT(IN) :: scope + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER FUNCTION H5Fflush_async(file, func, line, object_id, scope, es_id) & + BIND(C,NAME='H5Fflush_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: object_id + INTEGER(C_INT), VALUE :: scope + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Fflush_async + END INTERFACE + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = H5Fflush_async(file_default, func_default, line_default, & + object_id, INT(scope, C_INT), es_id) + + END SUBROUTINE h5fflush_async_f +!> +!! \ingroup FH5F +!! !! \brief Mounts a file. !! !! \param loc_id The identifier for of file or group in which name is defined. @@ -161,7 +298,7 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: name INTEGER(HID_T), INTENT(IN) :: child_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: access_prp INTEGER(HID_T) :: access_prp_default INTEGER :: namelen ! Length of the name character string @@ -219,6 +356,7 @@ CONTAINS hdferr = h5funmount_c(loc_id, name, namelen) END SUBROUTINE h5funmount_f + !> !! \ingroup FH5F !! @@ -240,30 +378,106 @@ CONTAINS INTEGER, INTENT(IN) :: access_flags INTEGER(HID_T), INTENT(OUT) :: file_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: access_prp + INTEGER(HID_T) :: access_prp_default - INTEGER :: namelen ! Length of the name character string + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTERFACE - INTEGER FUNCTION h5fopen_c(name, namelen, access_flags, & - access_prp_default, file_id) BIND(C,NAME='h5fopen_c') - IMPORT :: C_CHAR + INTEGER(HID_T) FUNCTION H5Fopen(name, access_flags, access_prp_default) & + BIND(C,NAME='H5Fopen') + IMPORT :: C_CHAR, C_INT, C_PTR IMPORT :: HID_T IMPLICIT NONE - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER, INTENT(IN) :: access_flags - INTEGER(HID_T), INTENT(IN) :: access_prp_default - INTEGER(HID_T), INTENT(OUT) :: file_id - END FUNCTION h5fopen_c + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(C_INT), VALUE :: access_flags + INTEGER(HID_T), VALUE :: access_prp_default + END FUNCTION H5Fopen END INTERFACE + c_name = TRIM(name)//C_NULL_CHAR + access_prp_default = H5P_DEFAULT_F - IF (PRESENT(access_prp)) access_prp_default = access_prp - namelen = LEN_TRIM(name) - hdferr = h5fopen_c(name, namelen, access_flags, & - access_prp_default, file_id) + + IF(PRESENT(access_prp)) access_prp_default = access_prp + + file_id = H5Fopen(c_name, INT(access_flags, C_INT), access_prp_default) + + hdferr = 0 + IF(file_id.LT.0) hdferr = -1 + END SUBROUTINE h5fopen_f + +!> +!! \ingroup FH5F +!! +!! \brief Asynchronously opens HDF5 file. +!! +!! \param name Name of the file to acecss. +!! \param access_flags File access flags. Allowable values are: +!! \li H5F_ACC_RDWR_F +!! \li H5F_ACC_RDONLY_F +!! \param file_id File identifier +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param access_prp File access property list identifier +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Fopen_async() +!! + SUBROUTINE h5fopen_async_f(name, access_flags, file_id, es_id, hdferr, & + access_prp, file, func, line) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER, INTENT(IN) :: access_flags + INTEGER(HID_T), INTENT(OUT) :: file_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: access_prp + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: access_prp_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Fopen_async(file, func, line, name, access_flags, access_prp_default, es_id) & + BIND(C,NAME='H5Fopen_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(C_INT), VALUE :: access_flags + INTEGER(HID_T), VALUE :: access_prp_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Fopen_async + END INTERFACE + + c_name = TRIM(name)//C_NULL_CHAR + + access_prp_default = H5P_DEFAULT_F + + IF(PRESENT(access_prp)) access_prp_default = access_prp + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + file_id = H5Fopen_async(file_default, func_default, line_default, & + c_name, INT(access_flags, C_INT), access_prp_default, es_id) + + hdferr = 0 + IF(file_id.LT.0) hdferr = -1 + + END SUBROUTINE h5fopen_async_f !> !! \ingroup FH5F !! @@ -281,20 +495,75 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: ret_file_id INTEGER, INTENT(OUT) :: hdferr INTERFACE - INTEGER FUNCTION h5freopen_c(file_id, ret_file_id) BIND(C,NAME='h5freopen_c') + INTEGER(HID_T) FUNCTION H5Freopen(file_id) BIND(C,NAME='H5Freopen') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: file_id - INTEGER(HID_T), INTENT(OUT) :: ret_file_id - END FUNCTION h5freopen_c + INTEGER(HID_T), VALUE :: file_id + END FUNCTION H5Freopen END INTERFACE - hdferr = h5freopen_c(file_id, ret_file_id) + ret_file_id = h5freopen(file_id) + + hdferr = 0 + IF(ret_file_id.LT.0) hdferr = -1 END SUBROUTINE h5freopen_f !> !! \ingroup FH5F !! +!! \brief Asynchronously reopens HDF5 file. +!! +!! \param file_id Identifier of a file for which an additional identifier is required. +!! \param ret_file_id New file identifier. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Freopen_async() +!! + SUBROUTINE h5freopen_async_f(file_id, ret_file_id, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: file_id + INTEGER(HID_T), INTENT(OUT) :: ret_file_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Freopen_async(file, func, line, file_id, es_id) & + BIND(C,NAME='H5Freopen_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: file_id + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Freopen_async + END INTERFACE + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + ret_file_id = h5freopen_async(file_default, func_default, line_default, file_id, es_id) + + hdferr = 0 + IF(ret_file_id.LT.0) hdferr = -1 + + END SUBROUTINE h5freopen_async_f +!> +!! \ingroup FH5F +!! !! \brief Returns a file creation property list identifier. !! !! \param file_id Identifier of a file to creation property list of. @@ -366,7 +635,7 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: name LOGICAL, INTENT(OUT) :: status INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp + INTEGER(HID_T), INTENT(IN), OPTIONAL :: access_prp INTEGER(HID_T) :: access_prp_default CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name @@ -437,20 +706,70 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: file_id INTEGER, INTENT(OUT) :: hdferr INTERFACE - INTEGER FUNCTION h5fclose_c(file_id) BIND(C,NAME='h5fclose_c') + INTEGER(C_INT) FUNCTION H5Fclose(file_id) BIND(C,NAME='H5Fclose') + IMPORT :: C_INT IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: file_id - END FUNCTION h5fclose_c + INTEGER(HID_T), VALUE :: file_id + END FUNCTION H5Fclose END INTERFACE - hdferr = h5fclose_c(file_id) + hdferr = INT(H5Fclose(file_id)) END SUBROUTINE h5fclose_f !> !! \ingroup FH5F !! +!! \brief Asynchronously closes HDF5 file. +!! +!! \param file_id File identifier +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Fclose_async() +!! + SUBROUTINE h5fclose_async_f(file_id, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: file_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Fclose_async(file, func, line, file_id, es_id) & + BIND(C,NAME='H5Fclose_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: file_id + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Fclose_async + END INTERFACE + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Fclose_async(file_default, func_default, line_default, file_id, es_id)) + + END SUBROUTINE h5fclose_async_f + +!> +!! \ingroup FH5F +!! !! \brief Gets number of the objects open within a file !! !! \param file_id File identifier. diff --git a/fortran/src/H5Gf.c b/fortran/src/H5Gf.c index 9513a58..445fcea 100644 --- a/fortran/src/H5Gf.c +++ b/fortran/src/H5Gf.c @@ -21,128 +21,6 @@ #include "H5f90.h" #include "H5Eprivate.h" -/****if* H5Gf/h5gcreate_c - * NAME - * h5gcreate_c - * PURPOSE - * Call H5Gcreate to create a group - * INPUTS - * loc_id - file or group identifier - * name - name of the group - * namelen - name length - * size_hint - length of names in the group - * OUTPUTS - * grp_id - group identifier - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Wednesday, August 5, 1999 - * HISTORY - * Changed to call H5Gcreate2 because H5Gcreate flip-flops and - * H5Gcreate1 can be compiled out of the library - * QAK - 2007/08/23 - * SOURCE - */ -int_f -h5gcreate_c(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, hid_t_f *grp_id, - hid_t_f *lcpl_id, hid_t_f *gcpl_id, hid_t_f *gapl_id) -/******/ -{ - hid_t c_gcpl_id = -1; /* Group creation property list */ - char *c_name = NULL; - hid_t c_grp_id; - int_f ret_value = -1; - - /* - * Convert FORTRAN name to C name - */ - if (NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen))) - goto DONE; - - /* - * Call H5Gcreate function. - */ - if (*size_hint == (size_t_f)OBJECT_NAMELEN_DEFAULT_F) { - c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name, (hid_t)*lcpl_id, (hid_t)*gcpl_id, (hid_t)*gapl_id); - } - else { - /* Create the group creation property list */ - if ((c_gcpl_id = H5Pcreate(H5P_GROUP_CREATE)) < 0) - goto DONE; - - /* Set the local heap size hint */ - if (H5Pset_local_heap_size_hint(c_gcpl_id, (size_t)*size_hint) < 0) - goto DONE; - - /* Create the group */ - c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name, H5P_DEFAULT, c_gcpl_id, H5P_DEFAULT); - } - if (c_grp_id < 0) - goto DONE; - - /* Everything OK, set values to return */ - *grp_id = (hid_t_f)c_grp_id; - ret_value = 0; - -DONE: - if (c_gcpl_id > 0) - H5Pclose(c_gcpl_id); - if (c_name) - HDfree(c_name); - return ret_value; -} - -/****if* H5Gf/h5gopen_c - * NAME - * h5gopen_c - * PURPOSE - * Call H5Gopen to open a dataset - * INPUTS - * loc_id - file or group identifier - * name - name of the group - * namelen - name length - * gapl_id - Group access property list identifier - * OUTPUTS - * grp_id - group identifier - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Wednesday, August 5, 1999 - * - * SOURCE - */ -int_f -h5gopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *gapl_id, hid_t_f *grp_id) -/******/ -{ - char *c_name = NULL; - hid_t c_grp_id; - int ret_value = -1; - - /* - * Convert FORTRAN name to C name - */ - if (NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen))) - goto DONE; - - /* - * Call H5Gopen function. - */ - if ((c_grp_id = H5Gopen2((hid_t)*loc_id, c_name, (hid_t)*gapl_id)) < 0) - goto DONE; - - /* Everything OK, set values to return */ - *grp_id = (hid_t_f)c_grp_id; - ret_value = 0; - -DONE: - if (c_name) - HDfree(c_name); - return ret_value; -} - /****if* H5Gf/h5gget_obj_info_idx_c * NAME * h5gget_obj_info_idx_c @@ -273,32 +151,6 @@ DONE: return ret_value; } -/****if* H5Gf/h5gclose_c - * NAME - * h5gclose_c - * PURPOSE - * Call H5Gclose to close the group - * INPUTS - * grp_id - identifier of the group to be closed - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Wednesday, August 5, 1999 - * SOURCE - */ - -int_f -h5gclose_c(hid_t_f *grp_id) -/******/ -{ - int ret_value = 0; - - if (H5Gclose((hid_t)*grp_id) < 0) - ret_value = -1; - return ret_value; -} - /****if* H5Gf/h5glink_c * NAME * h5glink_c @@ -852,203 +704,3 @@ h5gget_create_plist_c(hid_t_f *grp_id, hid_t_f *gcpl_id) done: return ret_value; } - -/****if* H5Gf/h5gget_info_c - * NAME - * h5gget_info_c - * PURPOSE - * Call H5Gget_info - * INPUTS - * group_id - Group identifier - * OUTPUTS - * - * storage_type - Type of storage for links in group: - * H5G_STORAGE_TYPE_COMPACT: Compact storage - * H5G_STORAGE_TYPE_DENSE: Indexed storage - * H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure - * - * nlinks - Number of links in group - * max_corder - Current maximum creation order value for group - * mounted - Whether group has a file mounted on it (0 = false, 1 = true) - * - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * February 15, 2008 - * HISTORY - * - * - Added 'mounted' parameter - * M. Scot Breitenfeld - * July 16, 2008 - * SOURCE - */ -int_f -h5gget_info_c(hid_t_f *group_id, int_f *storage_type, int_f *nlinks, int_f *max_corder, int_f *mounted) -/******/ -{ - - int_f ret_value = 0; /* Return value */ - H5G_info_t ginfo; - - /* - * Call H5Gget_info function. - */ - if (H5Gget_info((hid_t)*group_id, &ginfo) < 0) - HGOTO_DONE(FAIL); - - /* Unpack the structure */ - - *storage_type = (int_f)ginfo.storage_type; - *nlinks = (int_f)ginfo.nlinks; - *max_corder = (int_f)ginfo.max_corder; - *mounted = 0; - if (ginfo.mounted) - *mounted = 1; - -done: - return ret_value; -} - -/****if* H5Gf/h5gget_info_by_idx_c - * NAME - * h5gget_info_by_idx_c - * PURPOSE - * Call H5Gget_info_by_idx - * INPUTS - * - * loc_id - File or group identifier - * group_name - Name of group containing group for which information is to be retrieved - * group_namelen - name length - * index_type - Index type - * order - Order of the count in the index - * n - Position in the index of the group for which information is retrieved - * lapl_id - Link access property list - * OUTPUTS - * - * storage_type - Type of storage for links in group: - * H5G_STORAGE_TYPE_COMPACT: Compact storage - * H5G_STORAGE_TYPE_DENSE: Indexed storage - * H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure - * - * nlinks - Number of links in group - * max_corder - Current maximum creation order value for group - * mounted - Whether group has a file mounted on it (0 = false, 1 = true) - * - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * February 18, 2008 - * HISTORY - * - * - Added 'mounted' parameter - * M. Scot Breitenfeld - * July 16, 2008 - * SOURCE - */ -int_f -h5gget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, int_f *index_type, - int_f *order, hsize_t_f *n, hid_t_f *lapl_id, int_f *storage_type, int_f *nlinks, - int_f *max_corder, int_f *mounted) -/******/ -{ - char *c_group_name = NULL; /* Buffer to hold group name C string */ - int_f ret_value = 0; /* Return value */ - H5G_info_t ginfo; - /* - * Convert FORTRAN name to C name - */ - if ((c_group_name = HD5f2cstring(group_name, (size_t)*group_namelen)) == NULL) - HGOTO_DONE(FAIL); - - /* - * Call H5Gget_info_by_idx function. - */ - if (H5Gget_info_by_idx((hid_t)*loc_id, c_group_name, (H5_index_t)*index_type, (H5_iter_order_t)*order, - (hsize_t)*n, &ginfo, (hid_t)*lapl_id) < 0) - HGOTO_DONE(FAIL); - - /* Unpack the structure */ - - *storage_type = (int_f)ginfo.storage_type; - *nlinks = (int_f)ginfo.nlinks; - *max_corder = (int_f)ginfo.max_corder; - *mounted = 0; - if (ginfo.mounted) - *mounted = 1; - -done: - if (c_group_name) - HDfree(c_group_name); - return ret_value; -} - -/****if* H5Gf/h5gget_info_by_name_c - * NAME - * h5gget_info_by_name_c - * PURPOSE - * Call H5Gget_info_by_name - * INPUTS - * - * loc_id - File or group identifier - * group_name - Name of group containing group for which information is to be retrieved - * group_namelen - name length - * lapl_id - Link access property list - * OUTPUTS - * - * storage_type - Type of storage for links in group: - * H5G_STORAGE_TYPE_COMPACT: Compact storage - * H5G_STORAGE_TYPE_DENSE: Indexed storage - * H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure - * - * nlinks - Number of links in group - * max_corder - Current maximum creation order value for group - * mounted - Whether group has a file mounted on it (0 = false, 1 = true) - * - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * February 18, 2008 - * HISTORY - * - * - Added 'mounted' parameter - * M. Scot Breitenfeld - * July 16, 2008 - * SOURCE - */ -int_f -h5gget_info_by_name_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, hid_t_f *lapl_id, - int_f *storage_type, int_f *nlinks, int_f *max_corder, int_f *mounted) -/******/ -{ - char *c_group_name = NULL; /* Buffer to hold group name C string */ - int_f ret_value = 0; /* Return value */ - H5G_info_t ginfo; - /* - * Convert FORTRAN name to C name - */ - if ((c_group_name = HD5f2cstring(group_name, (size_t)*group_namelen)) == NULL) - HGOTO_DONE(FAIL); - - /* - * Call H5Gget_info_by_name function. - */ - if (H5Gget_info_by_name((hid_t)*loc_id, c_group_name, &ginfo, (hid_t)*lapl_id) < 0) - HGOTO_DONE(FAIL); - - /* Unpack the structure */ - - *storage_type = (int_f)ginfo.storage_type; - *nlinks = (int_f)ginfo.nlinks; - *max_corder = (int_f)ginfo.max_corder; - *mounted = 0; - if (ginfo.mounted) - *mounted = 1; - -done: - if (c_group_name) - HDfree(c_group_name); - return ret_value; -} diff --git a/fortran/src/H5Gff.F90 b/fortran/src/H5Gff.F90 index 436eece..655c226 100644 --- a/fortran/src/H5Gff.F90 +++ b/fortran/src/H5Gff.F90 @@ -36,8 +36,127 @@ ! MODULE H5G - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_CHAR + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_CHAR, C_INT USE H5GLOBAL + USE H5P, ONLY : H5Pcreate_f, H5Pset_local_heap_size_hint_f, H5Pclose_f + + +! +! @brief Fortran2003 Derived Type for @ref H5G_info_t +! + TYPE, BIND(C) :: H5G_info_t + INTEGER(C_INT ) :: storage_type !< Type of storage for links in group: + !< \li H5G_STORAGE_TYPE_COMPACT_F: Compact storage + !< \li H5G_STORAGE_TYPE_DENSE_F: Indexed storage + !< \li H5G_STORAGE_TYPE_SYMBOL_TABLE_F: Symbol tables, the original HDF5 structure + INTEGER(HSIZE_T) :: nlinks !< Number of links in group + INTEGER(C_INT64_T) :: max_corder !< Current maximum creation order value for group + LOGICAL(C_BOOL) :: mounted !< Whether group has a file mounted on it + END TYPE H5G_info_t + +#ifndef H5_DOXYGEN + INTERFACE H5Gget_info_f + MODULE PROCEDURE h5Gget_info_f90 + MODULE PROCEDURE h5Gget_info_f03 + END INTERFACE + + INTERFACE H5Gget_info_by_idx_f + MODULE PROCEDURE H5Gget_info_by_idx_f90 + MODULE PROCEDURE H5Gget_info_by_idx_f03 + END INTERFACE + + INTERFACE H5Gget_info_by_name_f + MODULE PROCEDURE H5Gget_info_by_name_f90 + MODULE PROCEDURE H5Gget_info_by_name_f03 + END INTERFACE + + INTERFACE + INTEGER(C_INT) FUNCTION H5Gget_info(loc_id, ginfo) BIND(C,NAME='H5Gget_info') + IMPORT :: C_INT, C_PTR + IMPORT :: HID_T + INTEGER(HID_T), VALUE :: loc_id + TYPE(C_PTR), VALUE :: ginfo + END FUNCTION H5Gget_info + END INTERFACE + + INTERFACE + INTEGER(C_INT) FUNCTION H5Gget_info_async(file, func, line, loc_id, ginfo, es_id) & + BIND(C,NAME='H5Gget_info_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + TYPE(C_PTR) , VALUE :: ginfo + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Gget_info_async + END INTERFACE + + INTERFACE + INTEGER(C_INT) FUNCTION H5Gget_info_by_idx(loc_id, group_name, idx_type, order, n, ginfo, lapl_id) & + BIND(C,NAME='H5Gget_info_by_idx') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, HSIZE_T + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: group_name + INTEGER(C_INT) , VALUE :: idx_type + INTEGER(C_INT) , VALUE :: order + INTEGER(HSIZE_T), VALUE :: n + TYPE(C_PTR) , VALUE :: ginfo + INTEGER(HID_T) , VALUE :: lapl_id + END FUNCTION H5Gget_info_by_idx + END INTERFACE + + INTERFACE + INTEGER(C_INT) FUNCTION H5Gget_info_by_idx_async(file, func, line, loc_id, & + group_name, idx_type, order, n, ginfo, lapl_id, es_id) & + BIND(C,NAME='H5Gget_info_by_idx_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, HSIZE_T + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: group_name + INTEGER(C_INT) , VALUE :: idx_type + INTEGER(C_INT) , VALUE :: order + INTEGER(HSIZE_T), VALUE :: n + TYPE(C_PTR) , VALUE :: ginfo + INTEGER(HID_T) , VALUE :: lapl_id + INTEGER(HID_T) , VALUE :: es_id + END FUNCTION H5Gget_info_by_idx_async + END INTERFACE + + INTERFACE + INTEGER(C_INT) FUNCTION H5Gget_info_by_name(loc_id, name, ginfo, lapl_id) & + BIND(C,NAME='H5Gget_info_by_name') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + TYPE(C_PTR), VALUE :: ginfo + INTEGER(HID_T), VALUE :: lapl_id + END FUNCTION H5Gget_info_by_name + END INTERFACE + + INTERFACE + INTEGER(C_INT) FUNCTION H5Gget_info_by_name_async(file, func, line,loc_id, name, ginfo, lapl_id, es_id) & + BIND(C,NAME='H5Gget_info_by_name_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + TYPE(C_PTR), VALUE :: ginfo + INTEGER(HID_T), VALUE :: lapl_id + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Gget_info_by_name_async + END INTERFACE + +#endif CONTAINS @@ -52,7 +171,7 @@ CONTAINS !! \param hdferr \fortran_error !! \param size_hint A parameter indicating the number of bytes to reserve for the names that will appear in the group. !! Set to OBJECT_NAMELEN_DEFAULT_F if using any of the optional parameters lcpl_id, gcpl_id, -!! and/or gapl_id when not using keywords in specifying the optional parameters. +!! and/or gapl_id when not using keywords in specifying the optional parameters. See @ref H5Gcreate1(). !! \param lcpl_id Property list for link creation. !! \param gcpl_id Property list for group creation. !! \param gapl_id Property list for group access. @@ -65,50 +184,187 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: name INTEGER(HID_T), INTENT(OUT) :: grp_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(SIZE_T), OPTIONAL, INTENT(IN) :: size_hint - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gapl_id + INTEGER(SIZE_T), INTENT(IN), OPTIONAL :: size_hint + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: gcpl_id + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: gapl_id INTEGER(HID_T) :: lcpl_id_default INTEGER(HID_T) :: gcpl_id_default INTEGER(HID_T) :: gapl_id_default - INTEGER :: namelen ! Length of the name character string INTEGER(SIZE_T) :: size_hint_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTERFACE - INTEGER FUNCTION h5gcreate_c(loc_id, name, namelen, & - size_hint_default, grp_id, lcpl_id_default, gcpl_id_default, gapl_id_default) & - BIND(C,NAME='h5gcreate_c') + INTEGER(HID_T) FUNCTION H5Gcreate2(loc_id, name, & + lcpl_id_default, gcpl_id_default, gapl_id_default) & + BIND(C,NAME='H5Gcreate2') IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER(SIZE_T) :: size_hint_default - INTEGER(HID_T), INTENT(OUT) :: grp_id - INTEGER(HID_T) :: lcpl_id_default - INTEGER(HID_T) :: gcpl_id_default - INTEGER(HID_T) :: gapl_id_default - END FUNCTION h5gcreate_c + IMPORT :: HID_T + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: lcpl_id_default + INTEGER(HID_T), VALUE :: gcpl_id_default + INTEGER(HID_T), VALUE :: gapl_id_default + END FUNCTION H5Gcreate2 END INTERFACE - size_hint_default = OBJECT_NAMELEN_DEFAULT_F - IF (PRESENT(size_hint)) size_hint_default = size_hint + hdferr = 0 + c_name = TRIM(name)//C_NULL_CHAR + lcpl_id_default = H5P_DEFAULT_F - IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id gcpl_id_default = H5P_DEFAULT_F - IF(PRESENT(gcpl_id)) gcpl_id_default = gcpl_id gapl_id_default = H5P_DEFAULT_F - IF(PRESENT(gapl_id)) gapl_id_default = gapl_id + size_hint_default = OBJECT_NAMELEN_DEFAULT_F - namelen = LEN(name) + IF(PRESENT(size_hint)) size_hint_default = size_hint + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + IF(PRESENT(gcpl_id)) gcpl_id_default = gcpl_id + IF(PRESENT(gapl_id)) gapl_id_default = gapl_id + ! + ! size_hint was introduced as an overload option for H5Gcreate1, + ! it was removed in H5Gcreate2. + ! + IF(size_hint_default .EQ. OBJECT_NAMELEN_DEFAULT_F)THEN + grp_id = H5Gcreate2(loc_id, c_name, & + lcpl_id_default, gcpl_id_default, gapl_id_default) + ELSE + ! Create the group creation property list + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id_default, hdferr) + IF(hdferr.LT.0) RETURN + + ! Set the local heap size hint + CALL H5Pset_local_heap_size_hint_f(gcpl_id_default, size_hint, hdferr) + IF(hdferr.LT.0)THEN + CALL H5Pclose_f(gcpl_id_default, hdferr) + hdferr = -1 + RETURN + END IF + + grp_id = H5Gcreate2(loc_id, c_name, & + H5P_DEFAULT_F, gcpl_id_default, H5P_DEFAULT_F) + + CALL H5Pclose_f(gcpl_id_default, hdferr) + IF(hdferr.LT.0) RETURN + ENDIF - hdferr = h5gcreate_c(loc_id, name, namelen, size_hint_default, grp_id, & - lcpl_id_default, gcpl_id_default, gapl_id_default) + IF(grp_id.LT.0) hdferr = -1 END SUBROUTINE h5gcreate_f + +!> +!! \ingroup FH5G +!! +!! \brief Asynchronously creates a new group. +!! +!! \param loc_id Location identifier. +!! \param name Group name at the specified location. +!! \param grp_id Group identifier. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param size_hint A parameter indicating the number of bytes to reserve for the names that will appear in the group. +!! Set to OBJECT_NAMELEN_DEFAULT_F if using any of the optional parameters lcpl_id, gcpl_id, +!! and/or gapl_id when not using keywords in specifying the optional parameters. See @ref H5Gcreate1(). +!! \param lcpl_id Property list for link creation. +!! \param gcpl_id Property list for group creation. +!! \param gapl_id Property list for group access. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Gcreate_async() +!! + SUBROUTINE h5gcreate_async_f(loc_id, name, grp_id, es_id, hdferr, & + size_hint, lcpl_id, gcpl_id, gapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T), INTENT(OUT) :: grp_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(SIZE_T), INTENT(IN), OPTIONAL :: size_hint + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: gcpl_id + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: gapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: gcpl_id_default + INTEGER(HID_T) :: gapl_id_default + INTEGER(SIZE_T) :: size_hint_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Gcreate_async(file, func, line, loc_id, name, & + lcpl_id_default, gcpl_id_default, gapl_id_default, es_id) & + BIND(C,NAME='H5Gcreate_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: lcpl_id_default + INTEGER(HID_T), VALUE :: gcpl_id_default + INTEGER(HID_T), VALUE :: gapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Gcreate_async + END INTERFACE + + hdferr = 0 + c_name = TRIM(name)//C_NULL_CHAR + + lcpl_id_default = H5P_DEFAULT_F + gcpl_id_default = H5P_DEFAULT_F + gapl_id_default = H5P_DEFAULT_F + size_hint_default = OBJECT_NAMELEN_DEFAULT_F + + IF(PRESENT(size_hint)) size_hint_default = size_hint + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + IF(PRESENT(gcpl_id)) gcpl_id_default = gcpl_id + IF(PRESENT(gapl_id)) gapl_id_default = gapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + ! + ! size_hint was introduced as an overload option for H5Gcreate1, + ! it was removed in H5Gcreate2. + ! + IF(size_hint_default .EQ. OBJECT_NAMELEN_DEFAULT_F)THEN + grp_id = H5Gcreate_async(file_default, func_default, line_default, loc_id, c_name, & + lcpl_id_default, gcpl_id_default, gapl_id_default, es_id) + ELSE + ! Create the group creation property list + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id_default, hdferr) + IF(hdferr.LT.0) RETURN + + ! Set the local heap size hint + CALL H5Pset_local_heap_size_hint_f(gcpl_id_default, size_hint, hdferr) + IF(hdferr.LT.0)THEN + CALL H5Pclose_f(gcpl_id_default, hdferr) + hdferr = -1 + RETURN + END IF + + grp_id = H5Gcreate_async(file_default, func_default, line_default, loc_id, c_name, & + H5P_DEFAULT_F, gcpl_id_default, H5P_DEFAULT_F, es_id) + + CALL H5Pclose_f(gcpl_id_default, hdferr) + IF(hdferr.LT.0) RETURN + ENDIF + + IF(grp_id.LT.0) hdferr = -1 + + END SUBROUTINE h5gcreate_async_f + !> !! \ingroup FH5G !! @@ -128,30 +384,100 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: name INTEGER(HID_T), INTENT(OUT) :: grp_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: gapl_id + + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTEGER(HID_T) :: gapl_id_default - INTEGER :: namelen ! Length of the name character string INTERFACE - INTEGER FUNCTION h5gopen_c(loc_id, name, namelen, gapl_id_default, grp_id) & - BIND(C,NAME='h5gopen_c') + INTEGER(HID_T) FUNCTION H5Gopen2(loc_id, name, gapl_id_default) & + BIND(C,NAME='H5Gopen2') IMPORT :: C_CHAR IMPORT :: HID_T - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER(HID_T), INTENT(IN) :: gapl_id_default - INTEGER(HID_T), INTENT(OUT) :: grp_id - END FUNCTION h5gopen_c + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: gapl_id_default + END FUNCTION H5Gopen2 END INTERFACE + c_name = TRIM(name)//C_NULL_CHAR + gapl_id_default = H5P_DEFAULT_F IF(PRESENT(gapl_id)) gapl_id_default = gapl_id - namelen = LEN(name) - hdferr = h5gopen_c(loc_id, name, namelen, gapl_id_default, grp_id) + grp_id = H5Gopen2(loc_id, c_name, gapl_id_default) + + hdferr = 0 + IF(grp_id.LT.0) hdferr = -1 END SUBROUTINE h5gopen_f + +!> +!! \ingroup FH5G +!! +!! \brief Asynchronously opens an existing group. +!! +!! \param loc_id Location identifier. +!! \param name Name of the group to open. +!! \param grp_id Group identifier. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param gapl_id Group access property list identifier. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Gopen_async() +!! + SUBROUTINE h5gopen_async_f(loc_id, name, grp_id, es_id, hdferr, & + gapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T), INTENT(OUT) :: grp_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: gapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: gapl_id_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Gopen_async(file, func, line, loc_id, name, gapl_id_default, es_id) & + BIND(C,NAME='H5Gopen_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: gapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Gopen_async + END INTERFACE + + c_name = TRIM(name)//C_NULL_CHAR + + gapl_id_default = H5P_DEFAULT_F + IF(PRESENT(gapl_id)) gapl_id_default = gapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + grp_id = H5Gopen_async(file_default, func_default, line_default, & + loc_id, c_name, gapl_id_default, es_id) + + hdferr = 0 + IF(grp_id.LT.0) hdferr = -1 + + END SUBROUTINE h5gopen_async_f !> !! \ingroup FH5G !! @@ -167,18 +493,66 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: grp_id INTEGER, INTENT(OUT) :: hdferr INTERFACE - INTEGER FUNCTION h5gclose_c(grp_id) BIND(C,NAME='h5gclose_c') + INTEGER(C_INT) FUNCTION H5Gclose(grp_id) BIND(C,NAME='H5Gclose') + IMPORT :: C_INT IMPORT :: HID_T - INTEGER(HID_T), INTENT(IN) :: grp_id - END FUNCTION h5gclose_c + INTEGER(HID_T), VALUE :: grp_id + END FUNCTION H5Gclose END INTERFACE - hdferr = h5gclose_c(grp_id) + hdferr = INT(H5Gclose(grp_id)) END SUBROUTINE h5gclose_f !> !! \ingroup FH5G !! +!! \brief Asynchronously closes the specified group. +!! +!! \param grp_id Group identifier. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Gclose_async() +!! + SUBROUTINE h5gclose_async_f(grp_id, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: grp_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Gclose_async(file, func, line, grp_id, es_id) & + BIND(C,NAME='H5Gclose_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: grp_id + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Gclose_async + END INTERFACE + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Gclose_async(file_default, func_default, line_default, grp_id, es_id)) + + END SUBROUTINE h5gclose_async_f +!> +!! \ingroup FH5G +!! !! \brief Returns name and type of the group member identified by its index. !! !! \param loc_id Location identifier. @@ -604,8 +978,8 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: loc_id INTEGER(HID_T), INTENT(OUT) :: grp_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: gcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: gapl_id INTEGER(HID_T) :: gcpl_id_default INTEGER(HID_T) :: gapl_id_default @@ -657,15 +1031,96 @@ CONTAINS END SUBROUTINE h5gget_create_plist_f +#ifdef H5_DOXYGEN !> !! \ingroup FH5G !! !! \brief Retrieves information about a group !! -!! \param group_id Group identifier. +!! \attention \fortran_approved +!! +!! \param loc_id Location identifier. The identifier may be that of a file, group, dataset, named datatype, or attribute. +!! \param ginfo Derived type in which group information is returned. +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Gget_info() +!! + SUBROUTINE h5gget_info_f(& +#else + SUBROUTINE h5gget_info_f03(& +#endif + loc_id, ginfo, hdferr) + + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: loc_id + TYPE(H5G_info_t), INTENT(OUT), TARGET :: ginfo + INTEGER , INTENT(OUT) :: hdferr + + TYPE(C_PTR) :: ptr + + ptr = C_LOC(ginfo) + + hdferr = INT(H5Gget_info(loc_id, ptr)) + +#ifdef H5_DOXYGEN + END SUBROUTINE h5gget_info_f +#else + END SUBROUTINE h5gget_info_f03 +#endif + +!> +!! \ingroup FH5G +!! +!! \brief Asynchronously retrieves information about a group +!! +!! \param loc_id Location identifier. The identifier may be that of a file, group, dataset, named datatype, or attribute. +!! \param ginfo Derived type in which group information is returned. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Gget_info_async() +!! + SUBROUTINE h5gget_info_async_f(loc_id, ginfo, es_id, hdferr, file, func, line) + + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: loc_id + TYPE(H5G_info_t), INTENT(OUT), TARGET :: ginfo + INTEGER(HID_T) , INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: ptr + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + ptr = C_LOC(ginfo) + + hdferr = INT(H5Gget_info_async(file_default, func_default, line_default, loc_id, ptr, es_id)) + + END SUBROUTINE h5gget_info_async_f + +!> +!! \ingroup FH5G +!! +!! \brief Retrieves information about a group. +!! +!! \attention \fortran_obsolete. Both nlinks and max_corder can overflow. +!! +!! \param loc_id Location identifier. The identifier may be that of a file, group, dataset, named datatype, or attribute. !! \param storage_type Type of storage for links in group: !! \li H5G_STORAGE_TYPE_COMPACT_F: Compact storage -!! \li H5G_STORAGE_TYPE_DENS_FE: Indexed storage +!! \li H5G_STORAGE_TYPE_DENSE_F: Indexed storage !! \li H5G_STORAGE_TYPE_SYMBOL_TABLE_F: Symbol tables, the original HDF5 structure !! \param nlinks Number of links in group. !! \param max_corder Current maximum creation order value for group. @@ -674,48 +1129,169 @@ CONTAINS !! !! See C API: @ref H5Gget_info() !! - SUBROUTINE h5gget_info_f(group_id, storage_type, nlinks, max_corder, hdferr, mounted) +#ifdef H5_DOXYGEN + SUBROUTINE h5gget_info_f(& +#else + SUBROUTINE h5gget_info_f90(& +#endif + loc_id, storage_type, nlinks, max_corder, hdferr, mounted) + IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: group_id + INTEGER(HID_T), INTENT(IN) :: loc_id INTEGER, INTENT(OUT) :: storage_type INTEGER, INTENT(OUT) :: nlinks INTEGER, INTENT(OUT) :: max_corder INTEGER, INTENT(OUT) :: hdferr LOGICAL, INTENT(OUT), OPTIONAL :: mounted - INTEGER :: mounted_c - INTERFACE - INTEGER FUNCTION h5gget_info_c(group_id, storage_type, nlinks, max_corder, mounted_c) & - BIND(C,NAME='h5gget_info_c') - IMPORT :: HID_T - INTEGER(HID_T), INTENT(IN) :: group_id - INTEGER, INTENT(OUT) :: storage_type - INTEGER, INTENT(OUT) :: nlinks - INTEGER, INTENT(OUT) :: max_corder - INTEGER :: mounted_c - END FUNCTION h5gget_info_c - END INTERFACE + TYPE(H5G_info_t), TARGET :: ginfo + TYPE(C_PTR) :: ptr + + ptr = C_LOC(ginfo) + hdferr = INT(H5Gget_info(loc_id, ptr)) - hdferr = h5gget_info_c(group_id, storage_type, nlinks, max_corder, mounted_c) + storage_type = INT(ginfo%storage_type) + nlinks = INT(ginfo%nlinks) + max_corder = INT(ginfo%max_corder) IF(PRESENT(mounted))THEN - IF(mounted_c.EQ.0) THEN - mounted = .FALSE. - ELSE + IF(ginfo%mounted) THEN mounted = .TRUE. + ELSE + mounted = .FALSE. ENDIF ENDIF - +#ifdef H5_DOXYGEN END SUBROUTINE h5gget_info_f +#else + END SUBROUTINE h5gget_info_f90 +#endif + +!> +!! \ingroup FH5G +!! +!! \brief Retrieves information about a group, according to the group’s position within an index. +!! +!! \attention \fortran_approved +!! +!! \param loc_id Location identifier. The identifier may be that of a file, group, dataset, named datatype, or attribute. +!! \param group_name Name of group containing group for which information is to be retrieved. +!! \param idx_type Index type. +!! \param order Order of the count in the index. +!! \param n Position in the index of the group for which information is retrieved. +!! \param ginfo Derived type in which group information is returned. +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list. +!! +!! See C API: @ref H5Gget_info_by_idx() +!! +#ifdef H5_DOXYGEN + SUBROUTINE h5gget_info_by_idx_f(& +#else + SUBROUTINE h5gget_info_by_idx_f03(& +#endif + loc_id, group_name, idx_type, order, n, ginfo, 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 + INTEGER(HSIZE_T), INTENT(IN) :: n + TYPE(H5G_info_t), INTENT(OUT), TARGET :: ginfo + 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_group_name + TYPE(C_PTR) :: ptr + + c_group_name = TRIM(group_name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + ptr = C_LOC(ginfo) + + hdferr = H5Gget_info_by_idx(loc_id, c_group_name, & + INT(idx_type,C_INT), INT(order, C_INT), n, ptr, lapl_id_default ) + +#ifdef H5_DOXYGEN + END SUBROUTINE h5gget_info_by_idx_f +#else + END SUBROUTINE h5gget_info_by_idx_f03 +#endif + +!> +!! \ingroup FH5G +!! +!! \brief Asynchronously retrieves information about a group, according to the group’s position within an index. +!! +!! \param loc_id Location identifier. The identifier may be that of a file, group, dataset, named datatype, or attribute. +!! \param group_name Name of group containing group for which information is to be retrieved. +!! \param idx_type Index type. +!! \param order Order of the count in the index. +!! \param n Position in the index of the group for which information is retrieved. +!! \param ginfo Derived type in which group information is returned. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Gget_info_by_idx_async() +!! + SUBROUTINE h5gget_info_by_idx_async_f(loc_id, group_name, idx_type, order, n, ginfo, es_id, hdferr, & + lapl_id, file, func, line) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER, INTENT(IN) :: idx_type + INTEGER, INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + TYPE(H5G_info_t), INTENT(OUT), TARGET :: ginfo + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(group_name)+1,KIND=C_CHAR) :: c_group_name + TYPE(C_PTR) :: ptr + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + c_group_name = TRIM(group_name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + ptr = C_LOC(ginfo) + + hdferr = H5Gget_info_by_idx_async(file_default, func_default, line_default, loc_id, c_group_name, & + INT(idx_type,C_INT), INT(order, C_INT), n, ptr, lapl_id_default, es_id ) + + END SUBROUTINE h5gget_info_by_idx_async_f + !> !! \ingroup FH5G !! !! \brief Retrieves information about a group, according to the group’s position within an index. !! +!! \attention \fortran_obsolete. Both nlinks and max_corder can overflow. +!! !! \param loc_id File or group identifier. !! \param group_name Name of group containing group for which information is to be retrieved. -!! \param index_type Index type. +!! \param idx_type Index type. !! \param order Order of the count in the index. !! \param n Position in the index of the group for which information is retrieved. !! \param storage_type Type of storage for links in group: @@ -730,71 +1306,164 @@ CONTAINS !! !! See C API: @ref H5Gget_info_by_idx() !! - SUBROUTINE h5gget_info_by_idx_f(loc_id, group_name, index_type, order, n, & +#ifdef H5_DOXYGEN + SUBROUTINE h5gget_info_by_idx_f(& +#else + SUBROUTINE h5gget_info_by_idx_f90(& +#endif + loc_id, group_name, idx_type, order, n, & storage_type, nlinks, max_corder, hdferr, lapl_id, mounted) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: group_name - INTEGER, INTENT(IN) :: index_type + INTEGER, INTENT(IN) :: idx_type INTEGER, INTENT(IN) :: order INTEGER(HSIZE_T), INTENT(IN) :: n - INTEGER, INTENT(OUT) :: storage_type INTEGER, INTENT(OUT) :: nlinks INTEGER, INTENT(OUT) :: max_corder INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id LOGICAL, INTENT(OUT), OPTIONAL :: mounted - INTEGER :: mounted_c - INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: group_name_len ! length of group name - INTERFACE - INTEGER FUNCTION h5gget_info_by_idx_c(loc_id, group_name, group_name_len, index_type, order, n, lapl_id_default, & - storage_type, nlinks, max_corder, mounted_c) BIND(C,NAME='h5gget_info_by_idx_c') - IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T, HSIZE_T - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: group_name - INTEGER, INTENT(IN) :: index_type - INTEGER, INTENT(IN) :: order - INTEGER(HSIZE_T), INTENT(IN) :: n - INTEGER(HID_T) :: lapl_id_default - INTEGER, INTENT(OUT) :: storage_type - INTEGER, INTENT(OUT) :: nlinks - INTEGER, INTENT(OUT) :: max_corder - - INTEGER(SIZE_T) :: group_name_len - INTEGER :: mounted_c - - END FUNCTION h5gget_info_by_idx_c - END INTERFACE + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(group_name)+1,KIND=C_CHAR) :: c_group_name + TYPE(H5G_info_t), TARGET :: ginfo + TYPE(C_PTR) :: ptr - group_name_len = LEN(group_name) + c_group_name = TRIM(group_name)//C_NULL_CHAR + ptr = C_LOC(ginfo) lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - hdferr = h5gget_info_by_idx_c(loc_id, group_name, group_name_len, & - index_type, order, n, lapl_id_default, & - storage_type, nlinks, max_corder, mounted_c) + + hdferr = H5Gget_info_by_idx(loc_id, c_group_name, & + INT(idx_type,C_INT), INT(order, C_INT), n, ptr, lapl_id_default ) + + storage_type = INT(ginfo%storage_type) + nlinks = INT(ginfo%nlinks) + max_corder = INT(ginfo%max_corder) IF(PRESENT(mounted))THEN - IF(mounted_c.EQ.0) THEN - mounted = .FALSE. - ELSE + IF(ginfo%mounted) THEN mounted = .TRUE. + ELSE + mounted = .FALSE. ENDIF ENDIF - +#ifdef H5_DOXYGEN END SUBROUTINE h5gget_info_by_idx_f +#else + END SUBROUTINE h5gget_info_by_idx_f90 +#endif !> !! \ingroup FH5G !! -!! \brief Retrieves information about a group. +!! \brief Retrieves information about a group by its name. +!! +!! \attention \fortran_approved +!! +!! \param loc_id File or group identifier. +!! \param name Name of group containing group for which information is to be retrieved. +!! \param ginfo Derived type in which group information is returned. +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list. +!! +!! See C API: @ref H5Gget_info_by_name() +!! +#ifdef H5_DOXYGEN + SUBROUTINE h5gget_info_by_name_f( & +#else + SUBROUTINE h5gget_info_by_name_f03( & +#endif + loc_id, name, ginfo, hdferr, lapl_id) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(H5G_info_t), INTENT(OUT), TARGET :: ginfo + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: ptr + + c_name = TRIM(name)//C_NULL_CHAR + ptr = C_LOC(ginfo) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = INT(h5gget_info_by_name(loc_id, c_name, ptr, lapl_id_default)) + +#ifdef H5_DOXYGEN + END SUBROUTINE h5gget_info_by_name_f +#else + END SUBROUTINE h5gget_info_by_name_f03 +#endif + +!> +!! \ingroup FH5G +!! +!! \brief Asynchronously retrieves information about a group by its name. +!! +!! \param loc_id File or group identifier. +!! \param name Name of group containing group for which information is to be retrieved. +!! \param ginfo Derived type in which group information is returned. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list. +!! +!! See C API: @ref H5Gget_info_by_name_async() +!! + SUBROUTINE h5gget_info_by_name_async_f(loc_id, name, ginfo, es_id, hdferr, & + lapl_id, file, func, line) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(H5G_info_t), INTENT(OUT), TARGET :: ginfo + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: ptr + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + c_name = TRIM(name)//C_NULL_CHAR + ptr = C_LOC(ginfo) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(h5gget_info_by_name_async(file_default, func_default, line_default, & + loc_id, c_name, ptr, lapl_id_default, es_id)) + + END SUBROUTINE h5gget_info_by_name_async_f + +!> +!! \ingroup FH5G +!! +!! \brief Retrieves information about a group by its name. +!! +!! \attention \fortran_obsolete. Both nlinks and max_corder can overflow. !! !! \param loc_id File or group identifier. -!! \param group_name Name of group containing group for which information is to be retrieved. +!! \param name Name of group containing group for which information is to be retrieved. !! \param storage_type Type of storage for links in group: !! \li H5G_STORAGE_TYPE_COMPACT_F: Compact storage !! \li H5G_STORAGE_TYPE_DENSE_F: Indexed storage @@ -807,56 +1476,53 @@ CONTAINS !! !! See C API: @ref H5Gget_info_by_name() !! - SUBROUTINE h5gget_info_by_name_f(loc_id, group_name, & - storage_type, nlinks, max_corder, hdferr, lapl_id, mounted) +#ifdef H5_DOXYGEN + SUBROUTINE h5gget_info_by_name_f( & +#else + SUBROUTINE h5gget_info_by_name_f90( & +#endif + loc_id, name, storage_type, nlinks, max_corder, hdferr, lapl_id, mounted) + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(LEN=*), INTENT(IN) :: group_name + CHARACTER(LEN=*), INTENT(IN) :: name INTEGER, INTENT(OUT) :: storage_type INTEGER, INTENT(OUT) :: nlinks INTEGER, INTENT(OUT) :: max_corder INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id LOGICAL, INTENT(OUT), OPTIONAL :: mounted - INTEGER :: mounted_c - INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: group_name_len ! length of group name - - INTERFACE - INTEGER FUNCTION h5gget_info_by_name_c(loc_id, group_name, group_name_len, lapl_id_default, & - storage_type, nlinks, max_corder, mounted_c) BIND(C,NAME='h5gget_info_by_name_c') - IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: group_name - INTEGER(HID_T), INTENT(IN) :: lapl_id_default - INTEGER, INTENT(OUT) :: storage_type - INTEGER, INTENT(OUT) :: nlinks - INTEGER, INTENT(OUT) :: max_corder - - INTEGER(SIZE_T) :: group_name_len - INTEGER :: mounted_c - END FUNCTION h5gget_info_by_name_c - END INTERFACE + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(H5G_info_t), TARGET :: ginfo + TYPE(C_PTR) :: ptr - group_name_len = LEN(group_name) + c_name = TRIM(name)//C_NULL_CHAR + ptr = C_LOC(ginfo) lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - hdferr = h5gget_info_by_name_c(loc_id, group_name, group_name_len, lapl_id_default, & - storage_type, nlinks, max_corder, mounted_c) + hdferr = INT(H5Gget_info_by_name(loc_id, c_name, ptr, lapl_id_default)) + + storage_type = INT(ginfo%storage_type) + nlinks = INT(ginfo%nlinks) + max_corder = INT(ginfo%max_corder) IF(PRESENT(mounted))THEN - IF(mounted_c.EQ.0) THEN - mounted = .FALSE. - ELSE + IF(ginfo%mounted) THEN mounted = .TRUE. + ELSE + mounted = .FALSE. ENDIF ENDIF +#ifdef H5_DOXYGEN END SUBROUTINE h5gget_info_by_name_f +#else + END SUBROUTINE h5gget_info_by_name_f90 +#endif END MODULE H5G diff --git a/fortran/src/H5Lf.c b/fortran/src/H5Lf.c index 6951fef..63bed99 100644 --- a/fortran/src/H5Lf.c +++ b/fortran/src/H5Lf.c @@ -144,277 +144,6 @@ done: return ret_value; } -/****if* H5Lf/h5ldelete_c - * NAME - * h5ldelete_c - * PURPOSE - * Call H5Ldelete - * INPUTS - * - * - * loc_id - Identifier of the file or group containing the object - * name - Name of the link to delete - * lapl_id - Link access property list identifier - * namelen - length of name - * - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * January, 2008 - * SOURCE - */ - -int_f -h5ldelete_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id) -/******/ -{ - char *c_name = NULL; - int_f ret_value = 0; - - /* - * Convert FORTRAN name to C name - */ - if ((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) - HGOTO_DONE(FAIL); - - /* - * Call H5Ldelete function. - */ - if (H5Ldelete((hid_t)*loc_id, c_name, (hid_t)*lapl_id) < 0) - HGOTO_DONE(FAIL); - -done: - if (c_name) - HDfree(c_name); - - return ret_value; -} - -/****if* H5Lf/h5lcreate_soft_c - * NAME - * h5lcreate_soft_c - * PURPOSE - * Call H5Lcreate_soft - * INPUTS - * - * - * target_path - Path to the target object, which is not required to exist. - * link_loc_id - The file or group identifier for the new link. - * link_name - The name of the new link. - * lcpl_id - Link creation property list identifier. - * lapl_id - Link access property list identifier. - * - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * February 20, 2008 - * SOURCE - */ - -int_f -h5lcreate_soft_c(_fcd target_path, size_t_f *target_path_len, hid_t_f *link_loc_id, _fcd link_name, - size_t_f *link_name_len, hid_t_f *lcpl_id, hid_t_f *lapl_id) -/******/ -{ - char *c_target_path = NULL; - char *c_link_name = NULL; - int_f ret_value = 0; - - /* - * Convert FORTRAN name to C name - */ - if ((c_target_path = HD5f2cstring(target_path, (size_t)*target_path_len)) == NULL) - HGOTO_DONE(FAIL); - if ((c_link_name = HD5f2cstring(link_name, (size_t)*link_name_len)) == NULL) - HGOTO_DONE(FAIL); - - /* - * Call H5Adelete function. - */ - if (H5Lcreate_soft(c_target_path, (hid_t)*link_loc_id, c_link_name, (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0) - HGOTO_DONE(FAIL); - -done: - if (c_target_path) - HDfree(c_target_path); - if (c_link_name) - HDfree(c_link_name); - - return ret_value; -} - -/****if* H5Lf/h5lcreate_hard_c - * NAME - * h5lcreate_hard_c - * PURPOSE - * Call H5Lcreate_hard - * INPUTS - * - * obj_loc_id - The file or group identifier for the target object. - * obj_name - Name of the target object, which must already exist. - * obj_namelen - Name length - * link_loc_id - The file or group identifier for the new link. - * link_name - The name of the new link. - * link_namelen- Name length - * lcpl_id - Link creation property list identifier. - * lapl_id - Link access property list identifier. - * - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * February 27, 2008 - * SOURCE - */ -int_f -h5lcreate_hard_c(hid_t_f *obj_loc_id, _fcd obj_name, size_t_f *obj_namelen, hid_t_f *link_loc_id, - _fcd link_name, size_t_f *link_namelen, hid_t_f *lcpl_id, hid_t_f *lapl_id) -/******/ -{ - char *c_obj_name = NULL; - char *c_link_name = NULL; - int_f ret_value = 0; - - /* - * Convert FORTRAN name to C name - */ - if ((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) - HGOTO_DONE(FAIL); - if ((c_link_name = HD5f2cstring(link_name, (size_t)*link_namelen)) == NULL) - HGOTO_DONE(FAIL); - - /* - * Call H5Lcreate_hard function. - */ - if (H5Lcreate_hard((hid_t)*obj_loc_id, c_obj_name, (hid_t)*link_loc_id, c_link_name, (hid_t)*lcpl_id, - (hid_t)*lapl_id) < 0) - HGOTO_DONE(FAIL); - -done: - if (c_obj_name) - HDfree(c_obj_name); - if (c_link_name) - HDfree(c_link_name); - - return ret_value; -} - -/****if* H5Lf/h5ldelete_by_idx_c - * NAME - * h5ldelete_by_idx_c - * PURPOSE - * Calls h5ldelete_by_idx - * INPUTS - * - * loc_id - File or group identifier specifying location of subject group - * group_name - Name of subject group - * group_namelen - Name length - * index_field - Type of index; Possible values are: - * H5_INDEX_UNKNOWN_F = -1 - Unknown index type - * H5_INDEX_NAME_F - Index on names - * H5_INDEX_CRT_ORDER_F - Index on creation order - * H5_INDEX_N_F - Number of indices defined - * order - Order within field or index; Possible values are: - * H5_ITER_UNKNOWN_F - Unknown order - * H5_ITER_INC_F - Increasing order - * H5_ITER_DEC_F - Decreasing order - * H5_ITER_NATIVE_F - No particular order, whatever is fastest - * H5_ITER_N_F - Number of iteration orders - * n - Link for which to retrieve information - * lapl_id - Link access property list - * - * OUTPUTS - * N/A - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * February 29, 2008 - * HISTORY - * N/A - * SOURCE - */ -int_f -h5ldelete_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, int_f *index_field, - int_f *order, hsize_t_f *n, hid_t_f *lapl_id) -/******/ -{ - char *c_group_name = NULL; /* Buffer to hold C string */ - H5_index_t c_index_field; - H5_iter_order_t c_order; - int_f ret_value = 0; /* Return value */ - - /* - * Convert FORTRAN name to C name - */ - if ((c_group_name = HD5f2cstring(group_name, (size_t)*group_namelen)) == NULL) - HGOTO_DONE(FAIL); - - c_index_field = (H5_index_t)*index_field; - c_order = (H5_iter_order_t)*order; - - /* - * Call H5Ldelete_by_name function. - */ - if (H5Ldelete_by_idx((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n, (hid_t)*lapl_id) < - 0) - HGOTO_DONE(FAIL); - -done: - if (c_group_name) - HDfree(c_group_name); - return ret_value; -} - -/****if* H5Lf/h5lexists_c - * NAME - * h5lexists_c - * PURPOSE - * Calls H5Lexists - * INPUTS - * - * loc_id - Identifier of the file or group to query. - * name - Link name to check - * lapl_id - Link access property list identifier. - * OUTPUTS - * - * link_exists_c - returns a positive value, for TRUE, or 0 (zero), for FALSE. - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * February 29, 2008 - * HISTORY - * - * SOURCE - */ -int_f -h5lexists_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, int_f *link_exists) -/******/ -{ - char *c_name = NULL; /* Buffer to hold C string */ - int_f ret_value = 0; /* Return value */ - - /* - * Convert FORTRAN name to C name - */ - if ((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) - HGOTO_DONE(FAIL); - - /* - * Call H5Lexists function. - */ - if ((*link_exists = (int_f)H5Lexists((hid_t)*loc_id, c_name, (hid_t)*lapl_id)) < 0) - HGOTO_DONE(FAIL); - -done: - if (c_name) - HDfree(c_name); - return ret_value; -} - /****if* H5Lf/h5lget_info_c * NAME * h5lget_info_c @@ -953,55 +682,6 @@ done: return ret_value; } -/****if* H5Lf/h5literate_c - * NAME - * h5literate_c - * PURPOSE - * Calls H5Literate - * INPUTS - * - * group_id - Identifier specifying subject group - * index_type - Type of index which determines the order - * order - Order within index - * idx - Iteration position at which to start - * op - Callback function passing data regarding the link to the calling application - * op_data - User-defined pointer to data required by the application for its processing of the link - * - * OUTPUTS - * - * idx - Position at which an interrupted iteration may be restarted - * - * RETURNS - * >0 on success, 0< on failure - * AUTHOR - * M. Scot Breitenfeld - * July 8, 2008 - * SOURCE - */ -int_f -h5literate_c(hid_t_f *group_id, int_f *index_type, int_f *order, hsize_t_f *idx, H5L_iterate2_t op, - void *op_data) -/******/ -{ - int_f ret_value = -1; /* Return value */ - herr_t func_ret_value; /* H5Linterate return value */ - hsize_t idx_c = 0; - - idx_c = (hsize_t)*idx; - - /* - * Call H5Linterate - */ - - func_ret_value = - H5Literate2((hid_t)*group_id, (H5_index_t)*index_type, (H5_iter_order_t)*order, &idx_c, op, op_data); - - ret_value = (int_f)func_ret_value; - *idx = (hsize_t_f)idx_c; - - return ret_value; -} - /****if* H5Lf/h5literate_by_name_c * NAME * h5literate_by_name_c diff --git a/fortran/src/H5Lff.F90 b/fortran/src/H5Lff.F90 index 8171c1b..9111144 100644 --- a/fortran/src/H5Lff.F90 +++ b/fortran/src/H5Lff.F90 @@ -42,13 +42,14 @@ MODULE H5L IMPLICIT NONE + TYPE, bind(c) :: union_t TYPE(H5O_TOKEN_T_F) :: token !< Type for object tokens INTEGER(size_t) :: val_size !< Size of a soft link or user-defined link value END TYPE union_t ! -! @brief Fortran2003 Derived Type for h5l_info_t +! @brief Fortran2003 Derived Type for @ref H5L_info_t ! TYPE, bind(c) :: h5l_info_t INTEGER(c_int) :: type !< Specifies the link class. Valid values include the following: @@ -90,8 +91,8 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: dest_name INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER(HID_T) :: lcpl_id_default INTEGER(HID_T) :: lapl_id_default @@ -147,34 +148,96 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: name INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: namelen + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTERFACE - INTEGER FUNCTION h5ldelete_c(loc_id, name, namelen, lapl_id_default) BIND(C,name='h5ldelete_c') - IMPORT :: c_char + INTEGER(C_INT) FUNCTION H5Ldelete(loc_id, name, lapl_id_default) BIND(C,name='H5Ldelete') + IMPORT :: C_CHAR, C_INT, C_PTR IMPORT :: HID_T, SIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: namelen - END FUNCTION h5ldelete_c + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: lapl_id_default + END FUNCTION h5ldelete END INTERFACE - namelen = LEN(name) + c_name = TRIM(name)//C_NULL_CHAR lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - hdferr = h5ldelete_c(loc_id, name, namelen, lapl_id_default) + hdferr = INT(H5Ldelete(loc_id, c_name, lapl_id_default)) END SUBROUTINE h5ldelete_f !> !! \ingroup FH5L !! +!! \brief Asynchronously removes a link from a group. +!! +!! \param loc_id Identifier of the file or group containing the object. +!! \param name Name of the link to delete. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list identifier. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Ldelete_async() +!! + SUBROUTINE h5ldelete_async_f(loc_id, name, es_id, hdferr, lapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Ldelete_async(file, func, line, loc_id, name, lapl_id_default, es_id) & + BIND(C,name='H5Ldelete_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, SIZE_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Ldelete_async + END INTERFACE + + c_name = TRIM(name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Ldelete_async(file_default, func_default, line_default, & + loc_id, c_name, lapl_id_default, es_id)) + + END SUBROUTINE h5ldelete_async_f + +!> +!! \ingroup FH5L +!! !! \brief Creates a soft link to an object. !! !! \param target_path Path to the target object, which is not required to exist. @@ -192,49 +255,118 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: link_loc_id CHARACTER(LEN=*), INTENT(IN) :: link_name INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + INTEGER(HID_T) :: lcpl_id_default INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: target_path_len - INTEGER(SIZE_T) :: link_name_len + CHARACTER(LEN=LEN_TRIM(target_path) +1,KIND=C_CHAR) :: c_target_path + CHARACTER(LEN=LEN_TRIM(link_name)+1,KIND=C_CHAR) :: c_link_name INTERFACE - INTEGER FUNCTION h5lcreate_soft_c(target_path, target_path_len, & - link_loc_id, & - link_name,link_name_len, & - lcpl_id_default, lapl_id_default ) BIND(C,NAME='h5lcreate_soft_c') - IMPORT :: c_char - IMPORT :: HID_T, SIZE_T + INTEGER(C_INT) FUNCTION H5Lcreate_soft(target_path, link_loc_id, link_name, & + lcpl_id_default, lapl_id_default ) BIND(C,NAME='H5Lcreate_soft') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T IMPLICIT NONE - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: target_path - INTEGER(SIZE_T) :: target_path_len - INTEGER(HID_T), INTENT(IN) :: link_loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: link_name - INTEGER(SIZE_T) :: link_name_len - INTEGER(HID_T) :: lcpl_id_default - INTEGER(HID_T) :: lapl_id_default - END FUNCTION h5lcreate_soft_c + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: target_path + INTEGER(HID_T), VALUE :: link_loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: link_name + INTEGER(HID_T), VALUE :: lcpl_id_default + INTEGER(HID_T), VALUE :: lapl_id_default + END FUNCTION H5Lcreate_soft END INTERFACE - target_path_len = LEN(target_path) - link_name_len = LEN(link_name) + c_target_path = TRIM(target_path)//C_NULL_CHAR + c_link_name = TRIM(link_name)//C_NULL_CHAR lcpl_id_default = H5P_DEFAULT_F - IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - hdferr = h5lcreate_soft_c(target_path, target_path_len,& - link_loc_id, & - link_name, link_name_len, & - lcpl_id_default, lapl_id_default ) + hdferr = INT(H5Lcreate_soft(c_target_path, link_loc_id, c_link_name, & + lcpl_id_default, lapl_id_default)) END SUBROUTINE h5lcreate_soft_f !> !! \ingroup FH5L !! +!! \brief Asynchronously creates a soft link to an object. +!! +!! \param target_path Path to the target object, which is not required to exist. +!! \param link_loc_id The file or group identifier for the new link. +!! \param link_name The name of the new link. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param lcpl_id Link creation property list identifier. +!! \param lapl_id Link access property list identifier. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Lcreate_soft_async() +!! + SUBROUTINE h5lcreate_soft_async_f(target_path, link_loc_id, link_name, es_id, hdferr,& + lcpl_id, lapl_id, file, func, line) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: target_path + INTEGER(HID_T), INTENT(IN) :: link_loc_id + CHARACTER(LEN=*), INTENT(IN) :: link_name + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(target_path) +1,KIND=C_CHAR) :: c_target_path + CHARACTER(LEN=LEN_TRIM(link_name)+1,KIND=C_CHAR) :: c_link_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Lcreate_soft_async(file, func, line, target_path, link_loc_id, link_name, & + lcpl_id_default, lapl_id_default, es_id) BIND(C,NAME='H5Lcreate_soft_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: target_path + INTEGER(HID_T), VALUE :: link_loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: link_name + INTEGER(HID_T), VALUE :: lcpl_id_default + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Lcreate_soft_async + END INTERFACE + + c_target_path = TRIM(target_path)//C_NULL_CHAR + c_link_name = TRIM(link_name)//C_NULL_CHAR + + lcpl_id_default = H5P_DEFAULT_F + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Lcreate_soft_async(file_default, func_default, line_default,& + c_target_path, link_loc_id, c_link_name, lcpl_id_default, lapl_id_default, es_id)) + + END SUBROUTINE h5lcreate_soft_async_f +!> +!! \ingroup FH5L +!! !! \brief Creates a hard link to an object. !! !! \param obj_loc_id The file or group identifier for the target object. @@ -247,51 +379,124 @@ CONTAINS !! !! See C API: @ref H5Lcreate_hard() !! - SUBROUTINE h5lcreate_hard_f(obj_loc_id, obj_name, link_loc_id, link_name, hdferr, lcpl_id, lapl_id) + SUBROUTINE h5lcreate_hard_f(obj_loc_id, obj_name, link_loc_id, link_name, hdferr, & + lcpl_id, lapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_loc_id CHARACTER(LEN=*), INTENT(IN) :: obj_name INTEGER(HID_T), INTENT(IN) :: link_loc_id CHARACTER(LEN=*), INTENT(IN) :: link_name - INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id INTEGER(HID_T) :: lcpl_id_default INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(obj_name) +1,KIND=C_CHAR) :: c_obj_name + CHARACTER(LEN=LEN_TRIM(link_name)+1,KIND=C_CHAR) :: c_link_name + INTERFACE + INTEGER(C_INT) FUNCTION H5Lcreate_hard(obj_loc_id, obj_name, & + link_loc_id, link_name, lcpl_id_default, lapl_id_default) BIND(C,NAME='H5Lcreate_hard') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + INTEGER(HID_T), VALUE :: obj_loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + INTEGER(HID_T), VALUE :: link_loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: link_name + INTEGER(HID_T), VALUE :: lcpl_id_default + INTEGER(HID_T), VALUE :: lapl_id_default + END FUNCTION H5Lcreate_hard + END INTERFACE - INTEGER(SIZE_T) :: obj_namelen - INTEGER(SIZE_T) :: link_namelen + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + c_link_name = TRIM(link_name)//C_NULL_CHAR + + lcpl_id_default = H5P_DEFAULT_F + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = INT(H5Lcreate_hard(obj_loc_id, c_obj_name, & + link_loc_id, c_link_name, lcpl_id_default, lapl_id_default)) + + END SUBROUTINE h5lcreate_hard_f +!> +!! \ingroup FH5L +!! +!! \brief Asynchronously creates a hard link to an object. +!! +!! \param obj_loc_id The file or group identifier for the target object. +!! \param obj_name Name of the target object, which must already exist. +!! \param link_loc_id The file or group identifier for the new link. +!! \param link_name The name of the new link. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param lcpl_id Link creation property list identifier. +!! \param lapl_id Link access property list identifier. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Lcreate_hard_async() +!! + SUBROUTINE h5lcreate_hard_async_f(obj_loc_id, obj_name, link_loc_id, link_name, es_id, hdferr, & + lcpl_id, lapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER(HID_T), INTENT(IN) :: link_loc_id + CHARACTER(LEN=*), INTENT(IN) :: link_name + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(obj_name) +1,KIND=C_CHAR) :: c_obj_name + CHARACTER(LEN=LEN_TRIM(link_name)+1,KIND=C_CHAR) :: c_link_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 INTERFACE - INTEGER FUNCTION h5lcreate_hard_c(obj_loc_id, obj_name, obj_namelen, & - link_loc_id, link_name, link_namelen, lcpl_id_default, lapl_id_default) BIND(C,NAME='h5lcreate_hard_c') - IMPORT :: c_char - IMPORT :: HID_T, SIZE_T + INTEGER(C_INT) FUNCTION H5Lcreate_hard_async(file, func, line, obj_loc_id, obj_name, & + link_loc_id, link_name, lcpl_id_default, lapl_id_default, es_id) BIND(C,NAME='H5Lcreate_hard_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: obj_loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: obj_name - INTEGER(HID_T), INTENT(IN) :: link_loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: link_name - INTEGER(SIZE_T) :: obj_namelen - INTEGER(SIZE_T) :: link_namelen - INTEGER(HID_T) :: lcpl_id_default - INTEGER(HID_T) :: lapl_id_default - END FUNCTION h5lcreate_hard_c + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: obj_loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: obj_name + INTEGER(HID_T), VALUE :: link_loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: link_name + INTEGER(HID_T), VALUE :: lcpl_id_default + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Lcreate_hard_async END INTERFACE - obj_namelen = LEN(obj_name) - link_namelen = LEN(link_name) + + c_obj_name = TRIM(obj_name)//C_NULL_CHAR + c_link_name = TRIM(link_name)//C_NULL_CHAR lcpl_id_default = H5P_DEFAULT_F - IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF (PRESENT(file)) file_default = file + IF (PRESENT(func)) func_default = func + IF (PRESENT(line)) line_default = INT(line, C_INT) - hdferr = h5lcreate_hard_c(obj_loc_id, obj_name, obj_namelen, & - link_loc_id, link_name, link_namelen, lcpl_id_default, lapl_id_default) + hdferr = INT(H5Lcreate_hard_async(file_default, func_default, line_default, obj_loc_id, c_obj_name, & + link_loc_id, c_link_name, lcpl_id_default, lapl_id_default, es_id)) - END SUBROUTINE h5lcreate_hard_f + END SUBROUTINE h5lcreate_hard_async_f !> !! \ingroup FH5L @@ -318,8 +523,8 @@ CONTAINS INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER(HID_T) :: lcpl_id_default INTEGER(HID_T) :: lapl_id_default @@ -391,37 +596,119 @@ CONTAINS INTEGER, INTENT(IN) :: order INTEGER(HSIZE_T), INTENT(IN) :: n INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: group_namelen + CHARACTER(LEN=LEN_TRIM(group_name)+1,KIND=C_CHAR) :: c_group_name INTERFACE - INTEGER FUNCTION h5ldelete_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, lapl_id_default) & - BIND(C,NAME='h5ldelete_by_idx_c') - IMPORT :: c_char - IMPORT :: HID_T, SIZE_T, HSIZE_T + INTEGER(C_INT) FUNCTION H5Ldelete_by_idx(loc_id, group_name, index_field, order, n, lapl_id_default) & + BIND(C,NAME='H5Ldelete_by_idx') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, HSIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: group_name - INTEGER, INTENT(IN) :: index_field - INTEGER, INTENT(IN) :: order - INTEGER(HSIZE_T), INTENT(IN) :: n - INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: group_namelen - END FUNCTION h5ldelete_by_idx_c + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: group_name + INTEGER(C_INT), VALUE :: index_field + INTEGER(C_INT), VALUE :: order + INTEGER(HSIZE_T), VALUE :: n + INTEGER(HID_T), VALUE :: lapl_id_default + END FUNCTION H5Ldelete_by_idx END INTERFACE + c_group_name = TRIM(group_name)//C_NULL_CHAR + lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - group_namelen = LEN(group_name) - hdferr = h5ldelete_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, lapl_id_default) + hdferr = INT(H5Ldelete_by_idx(loc_id, c_group_name, INT(index_field,C_INT), INT(order, C_INT), n, lapl_id_default)) END SUBROUTINE h5ldelete_by_idx_f !> !! \ingroup FH5L !! +!! \brief Asynchronously removes the nth link in a group. +!! +!! \param loc_id File or group identifier specifying location of subject group. +!! \param group_name Name of subject group. +!! \param index_field Type of index; Possible values are: +!! \li H5_INDEX_UNKNOWN_F = -1 - Unknown index type +!! \li H5_INDEX_NAME_F - Index on names +!! \li H5_INDEX_CRT_ORDER_F - Index on creation order +!! \li H5_INDEX_N_F - Number of indices defined +!! \param order Order within field or index; Possible values are: +!! \li H5_ITER_UNKNOWN_F - Unknown order +!! \li H5_ITER_INC_F - Increasing order +!! \li H5_ITER_DEC_F - Decreasing order +!! \li H5_ITER_NATIVE_F - No particular order, whatever is fastest +!! \li H5_ITER_N_F - Number of iteration orders +!! \param n Link for which to retrieve information. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Ldelete_by_idx_async() +!! + SUBROUTINE h5ldelete_by_idx_async_f(loc_id, group_name, index_field, order, n, es_id, hdferr, & + lapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER, INTENT(IN) :: index_field + INTEGER, INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(group_name)+1,KIND=C_CHAR) :: c_group_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Ldelete_by_idx_async(file, func, line, loc_id, group_name, index_field, order, n, & + lapl_id_default, es_id) BIND(C,NAME='H5Ldelete_by_idx_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, HSIZE_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: group_name + INTEGER(C_INT), VALUE :: index_field + INTEGER(C_INT), VALUE :: order + INTEGER(HSIZE_T), VALUE :: n + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Ldelete_by_idx_async + END INTERFACE + + c_group_name = TRIM(group_name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Ldelete_by_idx_async(file_default, func_default, line_default, & + loc_id, c_group_name, INT(index_field,C_INT), INT(order, C_INT), n, lapl_id_default, es_id)) + + END SUBROUTINE h5ldelete_by_idx_async_f + +!> +!! \ingroup FH5L +!! !! \brief Check if a link with a particular name exists in a group. !! !! \param loc_id Identifier of the file or group to query. @@ -438,41 +725,107 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: name LOGICAL, INTENT(OUT) :: link_exists INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id - INTEGER :: link_exists_c + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + + INTEGER(C_INT) :: link_exists_c INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: namelen + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTERFACE - INTEGER FUNCTION h5lexists_c(loc_id, name, namelen, lapl_id_default, link_exists_c) & - BIND(C,NAME='h5lexists_c') - IMPORT :: c_char - IMPORT :: HID_T, SIZE_T + INTEGER(C_INT) FUNCTION H5Lexists(loc_id, name, lapl_id_default) BIND(C,NAME='H5Lexists') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER(SIZE_T), INTENT(IN) :: namelen - INTEGER, INTENT(OUT) :: link_exists_c - INTEGER(HID_T) :: lapl_id_default + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: lapl_id_default - END FUNCTION h5lexists_c + END FUNCTION H5Lexists END INTERFACE - namelen = LEN(name) + c_name = TRIM(name)//C_NULL_CHAR lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - hdferr = h5lexists_c(loc_id, name, namelen, lapl_id_default, link_exists_c) + link_exists_c = H5Lexists(loc_id, c_name, lapl_id_default) link_exists = .FALSE. IF(link_exists_c.GT.0) link_exists = .TRUE. + hdferr = 0 + IF(link_exists_c.LT.0) hdferr = -1 + END SUBROUTINE h5lexists_f !> !! \ingroup FH5L !! +!! \brief Asynchronously checks if a link with a particular name exists in a group. +!! +!! \param loc_id Identifier of the file or group to query. +!! \param name Link name to check. +!! \param link_exists Pointer to Link exists status, must be of type LOGICAL(C_BOOL) and initialize to .FALSE. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list identifier. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Lexists_async() +!! + SUBROUTINE h5lexists_async_f(loc_id, name, link_exists, es_id, hdferr, lapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(C_PTR) , INTENT(INOUT) :: link_exists + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Lexists_async(file, func, line, & + loc_id, name, exists, lapl_id_default, es_id) BIND(C,NAME='H5Lexists_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + TYPE(C_PTR) , VALUE :: exists + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Lexists_async + END INTERFACE + + c_name = TRIM(name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Lexists_async(file_default, func_default, line_default, loc_id, c_name, & + link_exists, lapl_id_default, es_id)) + + END SUBROUTINE h5lexists_async_f + +!> +!! \ingroup FH5L +!! !! \brief Returns information about a link. !! !! \param link_loc_id File or group identifier. @@ -509,7 +862,7 @@ CONTAINS TYPE(H5O_TOKEN_T_F), INTENT(OUT), TARGET :: token INTEGER(SIZE_T), INTENT(OUT) :: val_size INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER(SIZE_T) :: link_namelen INTEGER(HID_T) :: lapl_id_default INTEGER :: corder_valid @@ -599,13 +952,11 @@ CONTAINS TYPE(H5O_TOKEN_T_F), INTENT(OUT), TARGET :: token INTEGER(SIZE_T), INTENT(OUT) :: val_size INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER :: corder_valid INTEGER(SIZE_T) :: group_namelen INTEGER(HID_T) :: lapl_id_default -! MS FORTRAN needs explicit interface for C functions called here. -! INTERFACE INTEGER FUNCTION h5lget_info_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & link_type, corder_valid, corder, cset, token, val_size, lapl_id_default) & @@ -697,8 +1048,8 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: dest_loc_id CHARACTER(LEN=*), INTENT(IN) :: dest_name INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER(SIZE_T) :: src_namelen INTEGER(SIZE_T) :: dest_namelen @@ -733,7 +1084,7 @@ CONTAINS src_namelen = LEN(src_name) dest_namelen = LEN(dest_name) - hdferr = H5Lmove_c(src_loc_id, src_name, src_namelen, dest_loc_id, & + hdferr = h5lmove_c(src_loc_id, src_name, src_namelen, dest_loc_id, & dest_name, dest_namelen, lcpl_id_default, lapl_id_default) END SUBROUTINE h5lmove_f @@ -775,9 +1126,9 @@ CONTAINS CHARACTER(LEN=*), INTENT(OUT) :: name INTEGER, INTENT(OUT) :: hdferr INTEGER(SIZE_T) :: group_namelen - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size + INTEGER(SIZE_T), INTENT(OUT), OPTIONAL :: size INTEGER(SIZE_T) :: size_default INTERFACE @@ -940,54 +1291,54 @@ CONTAINS !! !! \brief Iterates through links in a group. !! -!! \param group_id Identifier specifying subject group. -!! \param index_type Type of index which determines the order: +!! \param group_id Identifier specifying subject group. +!! \param idx_type Type of index which determines the order: !! \li H5_INDEX_NAME_F - Alphanumeric index on name !! \li H5_INDEX_CRT_ORDER_F - Index on creation order -!! \param order Order within index: +!! \param order Order within index: !! \li H5_ITER_INC_F - Increasing order !! \li H5_ITER_DEC_F - Decreasing order !! \li H5_ITER_NATIVE_F - Fastest available order !! \param idx Iteration position at which to start, or
!! Position at which an interrupted iteration may be restarted -!! \param op Callback function passing data regarding the link to the calling application. -!! \param op_data User-defined pointer to data required by the application for its processing of the link. -!! \param return_value Return context: +!! \param op Callback function passing data regarding the link to the calling application. +!! \param op_data User-defined pointer to data required by the application for its processing of the link. +!! \param return_value Return context: !! \li Success: The return value of the first operator that !! returns non-zero, or zero if all members were processed with no operator returning non-zero. !! \li Failure: Negative if something goes wrong within the !! library, or the negative value returned by one of the operators. -!! \param hdferr \fortran_error +!! \param hdferr \fortran_error !! !! See C API: @ref H5Literate2() !! - SUBROUTINE h5literate_f(group_id, index_type, order, idx, op, op_data, return_value, hdferr) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_FUNPTR + SUBROUTINE h5literate_f(group_id, idx_type, order, idx, op, op_data, return_value, hdferr) IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: group_id - INTEGER , INTENT(IN) :: index_type + INTEGER , INTENT(IN) :: idx_type INTEGER , INTENT(IN) :: order INTEGER(HSIZE_T), INTENT(INOUT) :: idx TYPE(C_FUNPTR) , INTENT(IN) :: op TYPE(C_PTR) , INTENT(IN) :: op_data INTEGER , INTENT(OUT) :: return_value INTEGER , INTENT(OUT) :: hdferr + INTERFACE - INTEGER FUNCTION h5literate_c(group_id, index_type, order, idx, op, op_data) & - BIND(C, NAME='h5literate_c') - IMPORT :: c_ptr, c_funptr + INTEGER(C_INT) FUNCTION H5Literate2(group_id, idx_type, order, idx, op, op_data) & + BIND(C, NAME='H5Literate2') + IMPORT :: C_INT, C_PTR, C_FUNPTR IMPORT :: HID_T, HSIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: group_id - INTEGER, INTENT(IN) :: index_type - INTEGER, INTENT(IN) :: order - INTEGER(HSIZE_T), INTENT(INOUT) :: idx - TYPE(C_FUNPTR), VALUE :: op - TYPE(C_PTR), VALUE :: op_data - END FUNCTION h5literate_c + INTEGER(HID_T) , VALUE :: group_id + INTEGER(C_INT) , VALUE :: idx_type + INTEGER(C_INT) , VALUE :: order + INTEGER(HSIZE_T) :: idx + TYPE(C_FUNPTR) , VALUE :: op + TYPE(C_PTR) , VALUE :: op_data + END FUNCTION H5Literate2 END INTERFACE - return_value = h5literate_c(group_id, index_type, order, idx, op, op_data) + return_value = INT(H5Literate2(group_id, INT(idx_type, C_INT), INT(order, C_INT), idx, op, op_data)) IF(return_value.GE.0)THEN hdferr = 0 @@ -1000,6 +1351,88 @@ CONTAINS !> !! \ingroup FH5L !! +!! \brief Asynchronously iterates through links in a group. +!! +!! \param group_id Identifier specifying subject group. +!! \param idx_type Type of index which determines the order: +!! \li H5_INDEX_NAME_F - Alphanumeric index on name +!! \li H5_INDEX_CRT_ORDER_F - Index on creation order +!! \param order Order within index: +!! \li H5_ITER_INC_F - Increasing order +!! \li H5_ITER_DEC_F - Decreasing order +!! \li H5_ITER_NATIVE_F - Fastest available order +!! \param idx Iteration position at which to start, or
+!! Position at which an interrupted iteration may be restarted +!! \param op Callback function passing data regarding the link to the calling application. +!! \param op_data User-defined pointer to data required by the application for its processing of the link. +!! \param return_value N/A +!! +!! \warning The returned value of the callback routine op will not be set +!! in \p return_value for H5Literate_async_f(), so \p return_value should +!! not be used for determining the return state of the callback routine. +!! +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Literate_async() +!! + SUBROUTINE h5literate_async_f(group_id, idx_type, order, idx, op, op_data, return_value, es_id, hdferr, & + file, func, line) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: group_id + INTEGER , INTENT(IN) :: idx_type + INTEGER , INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(INOUT) :: idx + TYPE(C_FUNPTR) , INTENT(IN) :: op + TYPE(C_PTR) , INTENT(IN) :: op_data + INTEGER , INTENT(OUT) :: return_value + INTEGER(HID_T) , INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Literate_async(file, func, line, & + group_id, idx_type, order, idx, op, op_data, es_id) BIND(C, NAME='H5Literate_async') + IMPORT :: C_CHAR, C_INT, C_PTR, C_FUNPTR + IMPORT :: HID_T, HSIZE_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T) , VALUE :: group_id + INTEGER(C_INT) , VALUE :: idx_type + INTEGER(C_INT) , VALUE :: order + INTEGER(HSIZE_T) :: idx + TYPE(C_FUNPTR) , VALUE :: op + TYPE(C_PTR) , VALUE :: op_data + INTEGER(HID_T) , VALUE :: es_id + END FUNCTION H5Literate_async + END INTERFACE + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + return_value = INT(H5Literate_async(file_default, func_default, line_default, & + group_id, INT(idx_type, C_INT), INT(order, C_INT), idx, op, op_data, es_id)) + + IF(return_value.GE.0)THEN + hdferr = 0 + ELSE + hdferr = -1 + END IF + + END SUBROUTINE h5literate_async_f + +!> +!! \ingroup FH5L +!! !! \brief Iterates through links in a group. !! !! \param loc_id File or group identifier specifying location of subject group. diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c index 019699e..186a9a2 100644 --- a/fortran/src/H5Of.c +++ b/fortran/src/H5Of.c @@ -132,76 +132,6 @@ done: return ret_value; } -/****if* H5Of/h5oopen_c - * NAME - * h5oopen_c - * PURPOSE - * Calls H5Oopen - * INPUTS - * loc_id - File or group identifier - * name - Attribute access property list - * namelen - Size of name - * lapl_id - Link access property list - * OUTPUTS - * obj_id - Dataset identifier - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * April 18, 2008 - * SOURCE - */ -int_f -h5oopen_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *obj_id) -/******/ -{ - char *c_name = NULL; /* Buffer to hold C string */ - int_f ret_value = 0; /* Return value */ - - /* - * Convert FORTRAN name to C name - */ - if ((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) - HGOTO_DONE(FAIL); - - /* - * Call H5Oopen function. - */ - if ((*obj_id = (hid_t_f)H5Oopen((hid_t)*loc_id, c_name, (hid_t)*lapl_id)) < 0) - HGOTO_DONE(FAIL); - -done: - if (c_name) - HDfree(c_name); - return ret_value; -} -/****if* H5Of/h5oclose_c - * NAME - * h5oclose_c - * PURPOSE - * Call H5Oclose - * INPUTS - * object_id - Object identifier - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * December 17, 2008 - * SOURCE - */ -int_f -h5oclose_c(hid_t_f *object_id) -/******/ -{ - int_f ret_value = 0; /* Return value */ - - if (H5Oclose((hid_t)*object_id) < 0) - HGOTO_DONE(FAIL); - -done: - return ret_value; -} - /****if* H5Of/h5ovisit_c * NAME * h5ovisit_c @@ -292,6 +222,11 @@ done: * namelen - Name length. * lapl_id - Link access property list. * fields - Flags specifying the fields to include in object_info. + * file - Filename the async subroutine is being called from + * func - Function name the async subroutine is being called in + * line - Line number the async subroutine is being called at + * es_id - Event set identifier + * * OUTPUTS * object_info - Buffer in which to return object information. * @@ -303,31 +238,30 @@ done: * SOURCE */ int_f -h5oget_info_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, - H5O_info_t_f *object_info, int_f *fields) +h5oget_info_by_name_c(hid_t_f *loc_id, char *name, hid_t_f *lapl_id, H5O_info_t_f *object_info, int_f *fields, + hid_t_f *es_id, char *file, char *func, int_f *line) /******/ { - char *c_name = NULL; /* Buffer to hold C string */ - int_f ret_value = 0; /* Return value */ + int_f ret_value = 0; /* Return value */ H5O_info2_t Oinfo; /* - * Convert FORTRAN name to C name - */ - if ((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) - HGOTO_DONE(FAIL); - - /* * Call H5Oinfo_by_name function. */ - if (H5Oget_info_by_name3((hid_t)*loc_id, c_name, &Oinfo, (unsigned)*fields, (hid_t)*lapl_id) < 0) - HGOTO_DONE(FAIL); + + if ((hid_t)*es_id != -1) { + if (H5Oget_info_by_name3((hid_t)*loc_id, name, &Oinfo, (unsigned)*fields, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + } + else { + if (H5Oget_info_by_name_async_wrap(file, func, (unsigned)*line, (hid_t)*loc_id, name, &Oinfo, + (unsigned)*fields, (hid_t)*lapl_id, (hid_t)*es_id) < 0) + HGOTO_DONE(FAIL); + } ret_value = fill_h5o_info_t_f(Oinfo, object_info); done: - if (c_name) - HDfree(c_name); return ret_value; } @@ -424,78 +358,22 @@ done: return ret_value; } -/* ***if* H5Of/H5Ocopy_c - * NAME - * H5Ocopy_c - * PURPOSE - * Calls H5Ocopy - * INPUTS - * src_loc_id - Object identifier indicating the location of the source object to be copied - * src_name - Name of the source object to be copied - * src_name_len - Length of src_name - * dst_loc_id - Location identifier specifying the destination - * dst_name - Name to be assigned to the new copy - * dst_name_len - Length of dst_name - * ocpypl_id - Object copy property list - * lcpl_id - Link creation property list for the new hard link - * - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * March 14, 2012 - * SOURCE - */ -int_f -h5ocopy_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, hid_t_f *dst_loc_id, _fcd dst_name, - size_t_f *dst_name_len, hid_t_f *ocpypl_id, hid_t_f *lcpl_id) -/******/ -{ - char *c_src_name = NULL; /* Buffer to hold C string */ - char *c_dst_name = NULL; /* Buffer to hold C string */ - - int_f ret_value = 0; /* Return value */ - - /* - * Convert FORTRAN name to C name - */ - if ((c_src_name = HD5f2cstring(src_name, (size_t)*src_name_len)) == NULL) - HGOTO_DONE(FAIL); - if ((c_dst_name = HD5f2cstring(dst_name, (size_t)*dst_name_len)) == NULL) - HGOTO_DONE(FAIL); - - /* - * Call H5Ocopy function. - */ - if (H5Ocopy((hid_t)*src_loc_id, c_src_name, (hid_t)*dst_loc_id, c_dst_name, (hid_t)*ocpypl_id, - (hid_t)*lcpl_id) < 0) - HGOTO_DONE(FAIL); - -done: - if (c_src_name) - HDfree(c_src_name); - if (c_dst_name) - HDfree(c_dst_name); - - return ret_value; -} - /****if* H5Of/h5ovisit_by_name_c * NAME * h5ovisit_by_name_c * PURPOSE * Calls H5Ovisit_by_name * INPUTS - * object_id - Identifier specifying subject group - * index_type - Type of index which determines the order - * order - Order within index - * idx - Iteration position at which to start - * op - Callback function passing data regarding the link to the calling application - * op_data - User-defined pointer to data required by the application for its processing of the link + * object_id - Identifier specifying subject group. + * index_type - Type of index which determines the order. + * order - Order within index. + * idx - Iteration position at which to start. + * op - Callback function passing data regarding the link to the calling application. + * op_data - User-defined pointer to data required by the application for its processing of the link. * fields - Flags specifying the fields to include in object_info. * * OUTPUTS - * idx - Position at which an interrupted iteration may be restarted + * idx - Position at which an interrupted iteration may be restarted. * * RETURNS * >0 on success, 0< on failure @@ -730,59 +608,6 @@ done: HDfree(c_comment); return ret_value; } -/****if* H5Of/h5oopen_by_idx_c - * NAME - * h5oopen_by_idx_c - * PURPOSE - * Calls H5Oopen_by_idx_c - * INPUTS - * loc_id - A file or group identifier. - * group_name - Name of group, relative to loc_id, in which object is located. - * group_namelen - Length of group_name - * index_type - Type of index by which objects are ordered. - * order - Order of iteration within index. - * n - Object to open. - * lapl_id - Link access property list. - * OUTPUTS - * obj_id - An object identifier for the opened object. - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * May 17, 2012 - * SOURCE - */ -int_f -h5oopen_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, int_f *index_type, int_f *order, - hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id) -/******/ -{ - char *c_group_name = NULL; /* Buffer to hold C string */ - int_f ret_value = 0; - H5_index_t c_index_type; - H5_iter_order_t c_order; - - /* - * Convert FORTRAN string to C string - */ - if ((c_group_name = HD5f2cstring(group_name, (size_t)*group_namelen)) == NULL) - HGOTO_DONE(FAIL); - - c_index_type = (H5_index_t)*index_type; - c_order = (H5_iter_order_t)*order; - - /* - * Call H5Oopen_by_idx function. - */ - if ((*obj_id = (hid_t_f)H5Oopen_by_idx((hid_t)*loc_id, c_group_name, c_index_type, c_order, (hsize_t)*n, - (hid_t)*lapl_id)) < 0) - HGOTO_DONE(FAIL); - -done: - if (c_group_name) - HDfree(c_group_name); - return ret_value; -} /****if* H5Of/h5oget_comment_c * NAME diff --git a/fortran/src/H5Off.F90 b/fortran/src/H5Off.F90 index 7bb3a0c..215f6e8 100644 --- a/fortran/src/H5Off.F90 +++ b/fortran/src/H5Off.F90 @@ -41,6 +41,7 @@ MODULE H5O USE H5GLOBAL IMPLICIT NONE + !> @brief h5o_info_t derived type. The time values are an integer array as specified in the Fortran intrinsic DATE_AND_TIME(VALUES). TYPE, BIND(C) :: h5o_info_t INTEGER(C_LONG) :: fileno !< File number that object is located in @@ -135,6 +136,24 @@ MODULE H5O TYPE(meta_size_t) :: meta_size END TYPE c_h5o_native_info_t + INTERFACE + INTEGER FUNCTION h5oget_info_by_name_c(loc_id, name, lapl_id_default, object_info, fields, & + es_id, file, func, line ) & + BIND(C, NAME='h5oget_info_by_name_c') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, SIZE_T + IMPLICIT NONE + INTEGER(HID_T) :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T) :: lapl_id_default + TYPE(C_PTR), VALUE :: object_info + INTEGER :: fields + INTEGER(HID_T) :: es_id + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT) :: line + END FUNCTION h5oget_info_by_name_c + END INTERFACE CONTAINS @@ -212,30 +231,100 @@ CONTAINS INTEGER(HID_T) , INTENT(OUT) :: obj_id INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lapl_id + INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: namelen + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTERFACE - INTEGER FUNCTION h5oopen_c(loc_id, name, namelen, lapl_id_default, obj_id) BIND(C,NAME='h5oopen_c') + INTEGER(HID_T) FUNCTION H5Oopen(loc_id, name, lapl_id_default) BIND(C,NAME='H5Oopen') IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T + IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER(HID_T) :: lapl_id_default - INTEGER(SIZE_T) :: namelen - INTEGER(HID_T), INTENT(OUT) :: obj_id - END FUNCTION h5oopen_c + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: lapl_id_default + END FUNCTION H5Oopen END INTERFACE - namelen = LEN(name) + c_name = TRIM(name)//C_NULL_CHAR lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - hdferr = h5oopen_c(loc_id, name, namelen, lapl_id_default, obj_id) + obj_id = H5Oopen(loc_id, c_name, lapl_id_default) + + hdferr = 0 + IF(obj_id.LT.0) hdferr = -1 END SUBROUTINE h5oopen_f + +!> +!! \ingroup FH5O +!! +!! \brief Asynchronously opens an object in an HDF5 file by location identifier and path name. +!! +!! \param loc_id File or group identifier. +!! \param name Path to the object, relative to loc_id. +!! \param obj_id Object identifier for the opened object. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param lapl_id Access property list identifier for the link pointing to the object. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Oopen_async() +!! + SUBROUTINE h5oopen_async_f(loc_id, name, obj_id, es_id, hdferr, lapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T) , INTENT(OUT) :: obj_id + INTEGER(HID_T) , INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Oopen_async(file, func, line, & + loc_id, name, lapl_id_default, es_id) BIND(C,NAME='H5Oopen_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Oopen_async + END INTERFACE + + c_name = TRIM(name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + obj_id = H5Oopen_async(file_default, func_default, line_default, & + loc_id, c_name, lapl_id_default, es_id) + + hdferr = 0 + IF(obj_id.LT.0) hdferr = -1 + + END SUBROUTINE h5oopen_async_f + !> !! \ingroup FH5O !! @@ -248,22 +337,69 @@ CONTAINS !! SUBROUTINE h5oclose_f(object_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: object_id + INTEGER(HID_T), INTENT(IN) :: object_id INTEGER , INTENT(OUT) :: hdferr INTERFACE - INTEGER FUNCTION h5oclose_c(object_id) BIND(C,NAME='h5oclose_c') + INTEGER(C_INT) FUNCTION H5Oclose(object_id) BIND(C,NAME='H5Oclose') + IMPORT :: C_INT IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: object_id - END FUNCTION h5oclose_c + INTEGER(HID_T), VALUE :: object_id + END FUNCTION H5Oclose END INTERFACE - hdferr = h5oclose_c(object_id) + hdferr = INT(H5Oclose(object_id)) + END SUBROUTINE h5oclose_f !> !! \ingroup FH5O !! +!! \brief Asynchronously closes an object in an HDF5 file. +!! +!! \param object_id Object identifier. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Oclose_async_f() +!! + SUBROUTINE h5oclose_async_f(object_id, es_id, hdferr, file, func, line) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: object_id + INTEGER(HID_T), INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Oclose_async(file, func, line, object_id, es_id) BIND(C,NAME='H5Oclose_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: object_id + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Oclose_async + END INTERFACE + + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Oclose_async(file_default, func_default, line_default, object_id, es_id)) + + END SUBROUTINE h5oclose_async_f + +!> +!! \ingroup FH5O +!! !! \brief Opens an object using its token within an HDF5 file. !! !! \param loc_id File or group identifier. @@ -318,43 +454,118 @@ CONTAINS INTEGER(HID_T) , INTENT(IN), OPTIONAL :: ocpypl_id INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lcpl_id - INTEGER(SIZE_T) :: src_name_len, dst_name_len INTEGER(HID_T) :: ocpypl_id_default, lcpl_id_default + CHARACTER(LEN=LEN_TRIM(src_name)+1,KIND=C_CHAR) :: c_src_name + CHARACTER(LEN=LEN_TRIM(dst_name)+1,KIND=C_CHAR) :: c_dst_name INTERFACE - INTEGER FUNCTION h5ocopy_c(src_loc_id, src_name, src_name_len, & - dst_loc_id, dst_name, dst_name_len, ocpypl_id_default, lcpl_id_default) & - BIND(C,NAME='h5ocopy_c') - IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T + INTEGER(C_INT) FUNCTION H5Ocopy(src_loc_id, src_name, dst_loc_id, dst_name, & + ocpypl_id_default, lcpl_id_default) BIND(C,NAME='H5Ocopy') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T) , INTENT(IN) :: src_loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: src_name - INTEGER(HID_T) , INTENT(IN) :: dst_loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: dst_name - INTEGER(HID_T) , INTENT(IN) :: ocpypl_id_default - INTEGER(HID_T) , INTENT(IN) :: lcpl_id_default - INTEGER(SIZE_T) :: src_name_len, dst_name_len - - END FUNCTION h5ocopy_c + INTEGER(HID_T) , VALUE :: src_loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: src_name + INTEGER(HID_T) , VALUE :: dst_loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: dst_name + INTEGER(HID_T) , VALUE :: ocpypl_id_default + INTEGER(HID_T) , VALUE :: lcpl_id_default + END FUNCTION H5Ocopy END INTERFACE - src_name_len = LEN(src_name) - dst_name_len = LEN(dst_name) + c_src_name = TRIM(src_name)//C_NULL_CHAR + c_dst_name = TRIM(dst_name)//C_NULL_CHAR ocpypl_id_default = H5P_DEFAULT_F + lcpl_id_default = H5P_DEFAULT_F IF(PRESENT(ocpypl_id)) ocpypl_id_default = ocpypl_id - lcpl_id_default = H5P_DEFAULT_F IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id - hdferr = h5ocopy_c(src_loc_id, src_name, src_name_len, & - dst_loc_id, dst_name, dst_name_len, ocpypl_id_default, lcpl_id_default) + hdferr = INT(H5Ocopy(src_loc_id, c_src_name, & + dst_loc_id, c_dst_name, ocpypl_id_default, lcpl_id_default)) END SUBROUTINE h5ocopy_f !> !! \ingroup FH5O !! +!! \brief Asynchronously copies an object in an HDF5 file. +!! +!! \param src_loc_id Object identifier indicating the location of the source object to be copied. +!! \param src_name Name of the source object to be copied. +!! \param dst_loc_id Location identifier specifying the destination. +!! \param dst_name Name to be assigned to the new copy. +!! \param ocpypl_id Object copy property list. +!! \param lcpl_id Link creation property list for the new hard link. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Ocopy_async() +!! + SUBROUTINE h5ocopy_async_f(src_loc_id, src_name, dst_loc_id, dst_name, es_id, hdferr, & + ocpypl_id, lcpl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: src_loc_id + CHARACTER(LEN=*), INTENT(IN) :: src_name + INTEGER(HID_T) , INTENT(IN) :: dst_loc_id + CHARACTER(LEN=*), INTENT(IN) :: dst_name + INTEGER(HID_T) , INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: ocpypl_id + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lcpl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line + + INTEGER(HID_T) :: ocpypl_id_default, lcpl_id_default + CHARACTER(LEN=LEN_TRIM(src_name)+1,KIND=C_CHAR) :: c_src_name + CHARACTER(LEN=LEN_TRIM(dst_name)+1,KIND=C_CHAR) :: c_dst_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(C_INT) FUNCTION H5Ocopy_async(file, func, line, src_loc_id, src_name, dst_loc_id, dst_name, & + ocpypl_id_default, lcpl_id_default, es_id) BIND(C,NAME='H5Ocopy_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT) , VALUE :: line + INTEGER(HID_T) , VALUE :: src_loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: src_name + INTEGER(HID_T) , VALUE :: dst_loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: dst_name + INTEGER(HID_T) , VALUE :: ocpypl_id_default + INTEGER(HID_T) , VALUE :: lcpl_id_default + INTEGER(HID_T) , VALUE :: es_id + END FUNCTION H5Ocopy_async + END INTERFACE + + c_src_name = TRIM(src_name)//C_NULL_CHAR + c_dst_name = TRIM(dst_name)//C_NULL_CHAR + + ocpypl_id_default = H5P_DEFAULT_F + lcpl_id_default = H5P_DEFAULT_F + IF(PRESENT(ocpypl_id)) ocpypl_id_default = ocpypl_id + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + hdferr = INT(H5Ocopy_async(file_default, func_default, line_default, & + src_loc_id, c_src_name, & + dst_loc_id, c_dst_name, ocpypl_id_default, lcpl_id_default, es_id)) + + END SUBROUTINE h5ocopy_async_f + +!> +!! \ingroup FH5O +!! !! \brief Decrements an object reference count. !! !! \param object_id Object identifier. @@ -577,7 +788,6 @@ CONTAINS !! \param n Object to open. !! \param obj_id An object identifier for the opened object. !! \param hdferr \fortran_error -!! !! \param lapl_id Link access property list. !! !! See C API: @ref H5Oopen_by_idx() @@ -585,43 +795,123 @@ CONTAINS SUBROUTINE h5oopen_by_idx_f(loc_id, group_name, index_type, order, n, obj_id, & hdferr, lapl_id) IMPLICIT NONE - INTEGER(HID_T) , INTENT(IN) :: loc_id - CHARACTER(LEN=*), INTENT(IN) :: group_name - INTEGER , INTENT(IN) :: index_type - INTEGER , INTENT(IN) :: order - INTEGER(HSIZE_T), INTENT(IN) :: n - INTEGER(HID_T) , INTENT(OUT) :: obj_id - INTEGER , INTENT(OUT) :: hdferr - INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id - INTEGER(SIZE_T) :: group_namelen + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER , INTENT(IN) :: index_type + INTEGER , INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T) , INTENT(OUT) :: obj_id + 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_group_name INTERFACE - INTEGER FUNCTION h5oopen_by_idx_c(loc_id, group_name, group_namelen, index_type, order, n, obj_id, lapl_id_default) & - BIND(C,NAME='h5oopen_by_idx_c') - IMPORT :: C_CHAR - IMPORT :: HID_T, SIZE_T, HSIZE_T + INTEGER(HID_T) FUNCTION H5Oopen_by_idx(loc_id, group_name, index_type, order, n, lapl_id_default) & + BIND(C,NAME='H5Oopen_by_idx') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, HSIZE_T IMPLICIT NONE - INTEGER(HID_T) , INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: group_name - INTEGER(SIZE_T) , INTENT(IN) :: group_namelen - INTEGER , INTENT(IN) :: index_type - INTEGER , INTENT(IN) :: order - INTEGER(HSIZE_T), INTENT(IN) :: n - INTEGER(HID_T) , INTENT(OUT) :: obj_id - INTEGER(HID_T) , INTENT(IN) :: lapl_id_default + INTEGER(HID_T) , VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: group_name + INTEGER(C_INT) , VALUE :: index_type + INTEGER(C_INT) , VALUE :: order + INTEGER(HSIZE_T), VALUE :: n + INTEGER(HID_T) , VALUE :: lapl_id_default + END FUNCTION H5Oopen_by_idx + END INTERFACE + + c_group_name = TRIM(group_name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + obj_id = H5Oopen_by_idx(loc_id, c_group_name, INT(index_type, C_INT), INT(order, C_INT), n, lapl_id_default) + + hdferr = 0 + IF(obj_id.LT.0) hdferr = -1 + + END SUBROUTINE H5oopen_by_idx_f + +!> +!! \ingroup FH5O +!! +!! \brief Asynchronously open the nth object in a group. +!! +!! \param loc_id A file or group identifier. +!! \param group_name Name of group, relative to loc_id, in which object is located. +!! \param index_type Type of index by which objects are ordered. +!! \param order Order of iteration within index, NOTE: zero-based. +!! \param n Object to open. +!! \param obj_id An object identifier for the opened object. +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! +!! \param lapl_id Link access property list. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Oopen_by_idx_async() +!! + SUBROUTINE h5oopen_by_idx_async_f(loc_id, group_name, index_type, order, n, obj_id, es_id, & + hdferr, lapl_id, file, func, line) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER , INTENT(IN) :: index_type + INTEGER , INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T) , INTENT(OUT) :: obj_id + INTEGER(HID_T) , INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lapl_id + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN), OPTIONAL :: line - END FUNCTION h5oopen_by_idx_c + INTEGER(HID_T) :: lapl_id_default + CHARACTER(LEN=LEN_TRIM(group_name)+1,KIND=C_CHAR) :: c_group_name + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + + INTERFACE + INTEGER(HID_T) FUNCTION H5Oopen_by_idx_async(file, func, line, & + loc_id, group_name, index_type, order, n, lapl_id_default, es_id) & + BIND(C,NAME='H5Oopen_by_idx_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T, HSIZE_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT) , VALUE :: line + INTEGER(HID_T) , VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: group_name + INTEGER(C_INT) , VALUE :: index_type + INTEGER(C_INT) , VALUE :: order + INTEGER(HSIZE_T), VALUE :: n + INTEGER(HID_T) , VALUE :: lapl_id_default + INTEGER(HID_T) , VALUE :: es_id + END FUNCTION H5Oopen_by_idx_async END INTERFACE - group_namelen = LEN(group_name) + c_group_name = TRIM(group_name)//C_NULL_CHAR lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) - hdferr = h5oopen_by_idx_c(loc_id, group_name, group_namelen, index_type, order, n, obj_id, lapl_id_default) + obj_id = H5Oopen_by_idx_async(file_default, func_default, line_default, & + loc_id, c_group_name, INT(index_type, C_INT), INT(order, C_INT), n, lapl_id_default, es_id) - END SUBROUTINE H5Oopen_by_idx_f + hdferr = 0 + IF(obj_id.LT.0) hdferr = -1 + + END SUBROUTINE H5oopen_by_idx_async_f !> !! \ingroup FH5O @@ -794,43 +1084,108 @@ CONTAINS INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id INTEGER , INTENT(IN) , OPTIONAL :: fields - INTEGER(SIZE_T) :: namelen INTEGER(HID_T) :: lapl_id_default TYPE(C_PTR) :: ptr INTEGER :: fields_c + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name - INTERFACE - INTEGER FUNCTION h5oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, object_info, fields) & - BIND(C, NAME='h5oget_info_by_name_c') - IMPORT :: c_char, c_ptr - IMPORT :: HID_T, SIZE_T - IMPLICIT NONE - INTEGER(HID_T) , INTENT(IN) :: loc_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER(SIZE_T) , INTENT(IN) :: namelen - INTEGER(HID_T) , INTENT(IN) :: lapl_id_default - TYPE(C_PTR), VALUE :: object_info - INTEGER , INTENT(IN) :: fields - END FUNCTION h5oget_info_by_name_c - END INTERFACE + ! Async -- Not Used -- + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + INTEGER(HID_T) :: es_id = -1 fields_c = H5O_INFO_ALL_F IF(PRESENT(fields)) fields_c = fields - namelen = LEN(name) + c_name = TRIM(name)//C_NULL_CHAR lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id ptr = C_LOC(object_info) - hdferr = H5Oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, ptr, fields_c) + hdferr = H5Oget_info_by_name_c(loc_id, c_name, lapl_id_default, ptr, fields_c, & + es_id, file_default, func_default, line_default) END SUBROUTINE H5Oget_info_by_name_f !> !! \ingroup FH5O !! +!! \brief Asynchronously retrieves the metadata for an object, identifying the object by location and relative name. +!! +!! \param loc_id File or group identifier specifying location of group in which object is located. +!! \param name Name of group, relative to loc_id. +!! \param object_info Pointer to buffer returning object information, points to variable of datatype TYPE(C_H5O_INFO_T). +!! \param es_id \es_id +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list. +!! \param fields Flags specifying the fields to include in object_info. +!! \param file \fortran_file +!! \param func \fortran_func +!! \param line \fortran_line +!! +!! See C API: @ref H5Oget_info_by_name_async() +!! + SUBROUTINE h5oget_info_by_name_async_f(loc_id, name, object_info, es_id, hdferr, & + lapl_id, fields, file, func, line) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(C_PTR) , INTENT(INOUT) :: object_info + INTEGER(HID_T) , INTENT(IN) :: es_id + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id + INTEGER , INTENT(IN) , OPTIONAL :: fields + TYPE(C_PTR), OPTIONAL :: file + TYPE(C_PTR), OPTIONAL :: func + INTEGER , INTENT(IN) , OPTIONAL :: line + + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + INTEGER(HID_T) :: lapl_id_default + TYPE(C_PTR) :: file_default = C_NULL_PTR + TYPE(C_PTR) :: func_default = C_NULL_PTR + INTEGER(KIND=C_INT) :: line_default = 0 + INTEGER(C_INT) :: fields_c + + INTERFACE + INTEGER(C_INT) FUNCTION H5Oget_info_by_name_async(file, func, line, & + loc_id, name, object_info, fields, lapl_id_default, es_id) BIND(C,NAME='H5Oget_info_by_name_async') + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), VALUE :: line + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + TYPE(C_PTR), VALUE :: object_info + INTEGER(C_INT), VALUE :: fields + INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: es_id + END FUNCTION H5Oget_info_by_name_async + END INTERFACE + + fields_c = INT(H5O_INFO_ALL_F, C_INT) + IF(PRESENT(fields)) fields_c = INT(fields, C_INT) + IF(PRESENT(file)) file_default = file + IF(PRESENT(func)) func_default = func + IF(PRESENT(line)) line_default = INT(line, C_INT) + + c_name = TRIM(name)//C_NULL_CHAR + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = H5Oget_info_by_name_async(file_default, func_default, line_default, & + loc_id, c_name, object_info, fields_c, lapl_id_default, es_id) + + END SUBROUTINE H5oget_info_by_name_async_f + +!> +!! \ingroup FH5O +!! !! \brief Retrieves the metadata for an object specified by an identifier. !! !! \param object_id Identifier for target object. diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index 75d7365..75cd323 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -188,7 +188,7 @@ MODULE H5P !> @brief H5FD_subfiling_params_t derived type used in the subfiling VFD. TYPE, BIND(C) :: H5FD_subfiling_params_t - INTEGER(ENUM_T) :: ioc_selection !< Method to select I/O concentrators + INTEGER(C_INT) :: ioc_selection !< Method to select I/O concentrators INTEGER(C_INT64_T) :: stripe_size !< Size (in bytes) of data stripes in subfiles INTEGER(C_INT32_T) :: stripe_count !< Target number of subfiles to use END TYPE H5FD_subfiling_params_t @@ -524,15 +524,13 @@ CONTAINS !! !! See C API: @ref H5Pget_version() !! - SUBROUTINE h5pget_version_f(prp_id, boot, freelist, & - stab, shhdr, hdferr) + SUBROUTINE h5pget_version_f(prp_id, boot, freelist, stab, shhdr, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, DIMENSION(:), INTENT(OUT) :: boot - INTEGER, DIMENSION(:), INTENT(OUT) :: freelist - - INTEGER, DIMENSION(:), INTENT(OUT) :: stab - INTEGER, DIMENSION(:), INTENT(OUT) :: shhdr + INTEGER, DIMENSION(*), INTENT(OUT) :: boot + INTEGER, DIMENSION(*), INTENT(OUT) :: freelist + INTEGER, DIMENSION(*), INTENT(OUT) :: stab + INTEGER, DIMENSION(*), INTENT(OUT) :: shhdr INTEGER, INTENT(OUT) :: hdferr INTERFACE @@ -2698,7 +2696,8 @@ CONTAINS !! \param memb_map Mapping array. !! \param memb_fapl Property list for each memory usage type. !! \param memb_name Names of member file. -!! \param memb_addr Offsets within the virtual address space, from 0 (zero) to HADDR_MAX_F, at which each type of data storage begins. +!! \param memb_addr Offsets within the virtual address space, from 0 (zero) to HADDR_MAX_F, +!! at which each type of data storage begins. !! \param relax Flag. !! \param hdferr \fortran_error !! @@ -2781,7 +2780,8 @@ CONTAINS !! \param memb_map Mapping array. !! \param memb_fapl Property list for each memory usage type. !! \param memb_name Names of member file. -!! \param memb_addr Offsets within the virtual address space, from 0 (zero) to HADDR_MAX_F, at which each type of data storage begins. +!! \param memb_addr Offsets within the virtual address space, from 0 (zero) to HADDR_MAX_F, at which +!! each type of data storage begins. !! \param relax Flag. !! \param hdferr \fortran_error !! \param maxlen_out Maximum length for memb_name array element. @@ -2793,7 +2793,7 @@ CONTAINS INTEGER(HID_T), DIMENSION(*), INTENT(OUT) :: memb_fapl CHARACTER(LEN=*), DIMENSION(*), INTENT(OUT) :: memb_name REAL, DIMENSION(*), INTENT(OUT) :: memb_addr - INTEGER, OPTIONAL, INTENT(OUT) :: maxlen_out + INTEGER, INTENT(OUT), OPTIONAL :: maxlen_out LOGICAL, INTENT(OUT) :: relax INTEGER, INTENT(OUT) :: hdferr @@ -3201,7 +3201,7 @@ CONTAINS INTEGER, INTENT(OUT) :: low INTEGER, INTENT(OUT) :: high INTEGER, INTENT(OUT) :: hdferr - INTEGER(ENUM_T) :: low_c, high_c + INTEGER(C_INT) :: low_c, high_c INTEGER(C_INT) :: hdferr_c ! ! MS FORTRAN needs explicit interface for C functions called here. @@ -3209,11 +3209,11 @@ CONTAINS INTERFACE INTEGER(C_INT) FUNCTION h5pget_libver_bounds(fapl_id, low, high) & BIND(C,NAME='H5Pget_libver_bounds') - IMPORT :: C_INT, HID_T, ENUM_T + IMPORT :: C_INT, HID_T IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) , VALUE :: fapl_id - INTEGER(ENUM_T), INTENT(OUT) :: low - INTEGER(ENUM_T), INTENT(OUT) :: high + INTEGER(C_INT), INTENT(OUT) :: low + INTEGER(C_INT), INTENT(OUT) :: high END FUNCTION h5pget_libver_bounds END INTERFACE @@ -3252,15 +3252,15 @@ CONTAINS INTERFACE INTEGER(C_INT) FUNCTION h5pset_libver_bounds(fapl_id, low, high) & BIND(C,NAME='H5Pset_libver_bounds') - IMPORT :: C_INT, HID_T, ENUM_T + IMPORT :: C_INT, HID_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: fapl_id - INTEGER(ENUM_T), INTENT(IN), VALUE :: low - INTEGER(ENUM_T), INTENT(IN), VALUE :: high + INTEGER(C_INT), INTENT(IN), VALUE :: low + INTEGER(C_INT), INTENT(IN), VALUE :: high END FUNCTION h5pset_libver_bounds END INTERFACE - hdferr_c = h5pset_libver_bounds(fapl_id, INT(low, ENUM_T), INT(high, ENUM_T)) + hdferr_c = h5pset_libver_bounds(fapl_id, INT(low, C_INT), INT(high, C_INT)) hdferr = 0 IF(hdferr_c.LT.0) hdferr = -1 @@ -5523,14 +5523,14 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) INTERFACE INTEGER FUNCTION h5pset_virtual_view(dapl_id, view) BIND(C,NAME='H5Pset_virtual_view') - IMPORT :: HID_T, ENUM_T + IMPORT :: C_INT, HID_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: dapl_id - INTEGER(ENUM_T), INTENT(IN), VALUE :: view + INTEGER(C_INT), INTENT(IN), VALUE :: view END FUNCTION h5pset_virtual_view END INTERFACE - hdferr = INT( h5pset_virtual_view(dapl_id, INT(view,ENUM_T)) ) + hdferr = INT( h5pset_virtual_view(dapl_id, INT(view,C_INT)) ) END SUBROUTINE h5pset_virtual_view_f @@ -5553,13 +5553,13 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) INTEGER(HID_T), INTENT(IN) :: dapl_id INTEGER , INTENT(INOUT) :: view INTEGER , INTENT(OUT) :: hdferr - INTEGER(ENUM_T) :: view_enum + INTEGER(C_INT) :: view_enum INTERFACE INTEGER FUNCTION h5pget_virtual_view(dapl_id, view) BIND(C,NAME='H5Pget_virtual_view') - IMPORT :: HID_T, ENUM_T + IMPORT :: C_INT, HID_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: dapl_id - INTEGER(ENUM_T), INTENT(OUT) :: view + INTEGER(C_INT), INTENT(OUT) :: view END FUNCTION h5pget_virtual_view END INTERFACE @@ -5636,8 +5636,10 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) !! !! \brief Sets the mapping between virtual and source datasets. !! -!! \param dcpl_id The identifier of the dataset creation property list that will be used when creating the virtual dataset. -!! \param vspace_id The dataspace identifier with the selection within the virtual dataset applied, possibly an unlimited selection. +!! \param dcpl_id The identifier of the dataset creation property list that will be used when creating the +!! virtual dataset. +!! \param vspace_id The dataspace identifier with the selection within the virtual dataset applied, possibly an +!! unlimited selection. !! \param src_file_name The name of the HDF5 file where the source dataset is located. !! \param src_dset_name The path to the HDF5 dataset in the file specified by src_file_name. !! \param src_space_id The source dataset’s dataspace identifier with a selection applied, possibly an unlimited selection. @@ -6051,7 +6053,8 @@ END SUBROUTINE h5pget_virtual_dsetname_f LOGICAL(C_BOOL) :: c_ignore_flag INTERFACE - INTEGER FUNCTION h5pget_file_locking(fapl_id, use_file_locking, ignore_disabled_locks) BIND(C, NAME='H5Pget_file_locking') + INTEGER FUNCTION h5pget_file_locking(fapl_id, use_file_locking, ignore_disabled_locks) & + BIND(C, NAME='H5Pget_file_locking') IMPORT :: HID_T, C_BOOL IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: fapl_id @@ -6090,7 +6093,8 @@ END SUBROUTINE h5pget_virtual_dsetname_f LOGICAL(C_BOOL) :: c_ignore_flag INTERFACE - INTEGER FUNCTION h5pset_file_locking(fapl_id, use_file_locking, ignore_disabled_locks) BIND(C, NAME='H5Pset_file_locking') + INTEGER FUNCTION h5pset_file_locking(fapl_id, use_file_locking, ignore_disabled_locks) & + BIND(C, NAME='H5Pset_file_locking') IMPORT :: HID_T, C_BOOL IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: fapl_id diff --git a/fortran/src/H5Rff.F90 b/fortran/src/H5Rff.F90 index 3aed34a..1b2cd8a 100644 --- a/fortran/src/H5Rff.F90 +++ b/fortran/src/H5Rff.F90 @@ -497,7 +497,7 @@ CONTAINS IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id TYPE(hobj_ref_t_f), INTENT(IN), TARGET :: ref - INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size + INTEGER(SIZE_T), INTENT(OUT), OPTIONAL :: size CHARACTER(LEN=*), INTENT(INOUT) :: name INTEGER, INTENT(OUT) :: hdferr @@ -533,7 +533,7 @@ CONTAINS IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id TYPE(hdset_reg_ref_t_f), INTENT(IN), TARGET :: ref - INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size + INTEGER(SIZE_T), INTENT(OUT), OPTIONAL :: size CHARACTER(LEN=*), INTENT(INOUT) :: name INTEGER, INTENT(OUT) :: hdferr INTEGER(SIZE_T) :: size_default @@ -580,7 +580,7 @@ CONTAINS TYPE(C_PTR), INTENT(IN) :: ref CHARACTER(LEN=*), INTENT(INOUT) :: name INTEGER, INTENT(OUT) :: hdferr - INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size + INTEGER(SIZE_T), INTENT(OUT), OPTIONAL :: size INTEGER(SIZE_T) :: size_default INTEGER(SIZE_T) :: name_len @@ -601,21 +601,20 @@ CONTAINS !! !! \brief Retrieves the type of object that an object reference points to. !! -!! loc_id - Identifier for the dataset containing the reference or for the group that dataset is in. -!! ref_type - Type of reference to query. -!! ref - Reference to query. -!! obj_type - Type of referenced object: -!! \li H5G_UNKNOWN_F -!! \li H H5G_GROUP_F -!! \li H H5G_DATASET_F -!! \li H H5G_TYPE_F -!! hdferr - \fortran_error +!! \param loc_id Identifier for the dataset containing the reference or for the group that dataset is in. +!! \param ref_type Type of reference to query. +!! \param ref Reference to query. +!! \param obj_type Type of referenced object: +!! \li H5G_UNKNOWN_F +!! \li H5G_GROUP_F +!! \li H5G_DATASET_F +!! \li H5G_TYPE_F +!! \param hdferr \fortran_error !! !! See C API: @ref H5Rget_obj_type3() !! SUBROUTINE h5rget_obj_type_f(loc_id, ref_type, ref, obj_type, hdferr) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id INTEGER, INTENT(IN) :: ref_type diff --git a/fortran/src/H5Sff.F90 b/fortran/src/H5Sff.F90 index 9a2f89a..72627d9 100644 --- a/fortran/src/H5Sff.F90 +++ b/fortran/src/H5Sff.F90 @@ -58,10 +58,10 @@ CONTAINS IMPLICIT NONE INTEGER, INTENT(IN) :: rank - INTEGER(HSIZE_T), INTENT(IN) :: dims(rank) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(1:rank) :: dims INTEGER(HID_T), INTENT(OUT) :: space_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HSIZE_T), OPTIONAL, INTENT(IN) :: maxdims(rank) + INTEGER(HSIZE_T), INTENT(IN), OPTIONAL, DIMENSION(1:rank) :: maxdims INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: f_maxdims INTERFACE @@ -81,9 +81,9 @@ CONTAINS RETURN ENDIF IF (PRESENT(maxdims)) THEN - f_maxdims = maxdims + f_maxdims(1:rank) = maxdims(1:rank) ELSE - f_maxdims = dims + f_maxdims(1:rank) = dims(1:rank) ENDIF hdferr = h5screate_simple_c(rank, dims, f_maxdims, space_id) DEALLOCATE(f_maxdims) @@ -823,8 +823,8 @@ CONTAINS INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: start INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: count INTEGER, INTENT(OUT) :: hdferr - INTEGER(HSIZE_T), DIMENSION(:), OPTIONAL, INTENT(IN) :: stride - INTEGER(HSIZE_T), DIMENSION(:), OPTIONAL, INTENT(IN) :: BLOCK + INTEGER(HSIZE_T), DIMENSION(:), INTENT(IN), OPTIONAL :: stride + INTEGER(HSIZE_T), DIMENSION(:), INTENT(IN), OPTIONAL :: BLOCK INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: def_block INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: def_stride INTEGER :: rank @@ -1225,7 +1225,7 @@ CONTAINS CHARACTER(LEN=*), INTENT(OUT) :: buf INTEGER(SIZE_T), INTENT(INOUT) :: nalloc INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: fapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: fapl_id INTEGER(HID_T) :: fapl_id_default INTERFACE diff --git a/fortran/src/H5Tff.F90 b/fortran/src/H5Tff.F90 index 006aa79..84b9654 100644 --- a/fortran/src/H5Tff.F90 +++ b/fortran/src/H5Tff.F90 @@ -80,7 +80,7 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: name INTEGER(HID_T), INTENT(OUT) :: type_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: tapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: tapl_id INTEGER :: namelen ! Name length INTEGER(HID_T) :: tapl_id_default @@ -126,9 +126,9 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: name INTEGER(HID_T), INTENT(IN) :: type_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: tcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: tapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: lcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: tcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: tapl_id INTEGER :: namelen ! Name length @@ -1793,8 +1793,8 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: loc_id INTEGER(HID_T), INTENT(IN) :: dtype_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: tcpl_id - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: tapl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: tcpl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: tapl_id INTEGER(HID_T) :: tcpl_id_default INTEGER(HID_T) :: tapl_id_default diff --git a/fortran/src/H5VLff.F90 b/fortran/src/H5VLff.F90 index 11ac349..3b451d0 100644 --- a/fortran/src/H5VLff.F90 +++ b/fortran/src/H5VLff.F90 @@ -64,7 +64,8 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: name INTEGER(HID_T), INTENT(OUT) :: vol_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: vipl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: vipl_id + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTEGER(HID_T) :: vipl_id_default @@ -73,8 +74,8 @@ CONTAINS BIND(C,NAME='H5VLregister_connector_by_name') IMPORT :: C_CHAR IMPORT :: HID_T - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER(HID_T), INTENT(IN), VALUE :: vipl_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: vipl_id END FUNCTION H5VLregister_connector_by_name END INTERFACE @@ -105,7 +106,7 @@ CONTAINS INTEGER, INTENT(IN) :: connector_value INTEGER(HID_T), INTENT(OUT) :: vol_id INTEGER, INTENT(OUT) :: hdferr - INTEGER(HID_T), OPTIONAL, INTENT(IN) :: vipl_id + INTEGER(HID_T), INTENT(IN), OPTIONAL :: vipl_id INTEGER(HID_T) :: vipl_id_default INTERFACE @@ -114,7 +115,7 @@ CONTAINS IMPORT :: HID_T IMPORT :: C_INT INTEGER(C_INT), VALUE :: connector_value - INTEGER(HID_T), INTENT(IN), VALUE :: vipl_id + INTEGER(HID_T), VALUE :: vipl_id END FUNCTION H5VLregister_connector_by_value END INTERFACE @@ -151,7 +152,7 @@ CONTAINS INTEGER(C_INT) FUNCTION H5VLis_connector_registered_by_name(name) BIND(C,NAME='H5VLis_connector_registered_by_name') IMPORT :: C_CHAR IMPORT :: C_INT - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name END FUNCTION H5VLis_connector_registered_by_name END INTERFACE @@ -219,7 +220,7 @@ CONTAINS INTERFACE INTEGER(HID_T) FUNCTION H5VLget_connector_id(obj_id) BIND(C,NAME='H5VLget_connector_id') IMPORT :: HID_T - INTEGER(HID_T), INTENT(IN) :: obj_id + INTEGER(HID_T), VALUE :: obj_id END FUNCTION H5VLget_connector_id END INTERFACE @@ -254,7 +255,7 @@ CONTAINS INTEGER(HID_T) FUNCTION H5VLget_connector_id_by_name(name) BIND(C,NAME='H5VLget_connector_id_by_name') IMPORT :: C_CHAR IMPORT :: HID_T - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name END FUNCTION H5VLget_connector_id_by_name END INTERFACE @@ -327,9 +328,9 @@ CONTAINS INTEGER(SIZE_T) FUNCTION H5VLget_connector_name(obj_id, name, size) BIND(C,NAME='H5VLget_connector_name') IMPORT :: HID_T, SIZE_T, C_PTR, C_CHAR IMPLICIT NONE - INTEGER(HID_T) , INTENT(IN), VALUE :: obj_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: name - INTEGER(SIZE_T), INTENT(IN), VALUE :: size + INTEGER(HID_T) , VALUE :: obj_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(SIZE_T), VALUE :: size END FUNCTION H5VLget_connector_name END INTERFACE @@ -367,7 +368,7 @@ CONTAINS INTERFACE INTEGER FUNCTION H5VLclose(vol_id) BIND(C, NAME='H5VLclose') IMPORT :: HID_T - INTEGER(HID_T), INTENT(IN), VALUE :: vol_id + INTEGER(HID_T), VALUE :: vol_id END FUNCTION H5VLclose END INTERFACE @@ -393,7 +394,7 @@ CONTAINS INTERFACE INTEGER FUNCTION H5VLunregister_connector(plugin_id) BIND(C, NAME='H5VLunregister_connector') IMPORT :: HID_T - INTEGER(HID_T), INTENT(IN), VALUE :: plugin_id + INTEGER(HID_T), VALUE :: plugin_id END FUNCTION H5VLunregister_connector END INTERFACE diff --git a/fortran/src/H5_buildiface.F90 b/fortran/src/H5_buildiface.F90 index c473e51..4572b4c 100644 --- a/fortran/src/H5_buildiface.F90 +++ b/fortran/src/H5_buildiface.F90 @@ -717,9 +717,9 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims' WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(INOUT)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER, INTENT(OUT) :: hdferr' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp' WRITE(11,'(A)') ' INTEGER(HID_T) :: xfer_prp_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: mem_space_id_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: file_space_id_default' @@ -756,9 +756,9 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims' WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(INOUT)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER, INTENT(OUT) :: hdferr' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp' WRITE(11,'(A)') ' INTEGER(HID_T) :: xfer_prp_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: mem_space_id_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: file_space_id_default' @@ -790,9 +790,9 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims' WRITE(11,'(A)') ' CHARACTER(LEN=*), INTENT(INOUT)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER, INTENT(OUT) :: hdferr' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp' WRITE(11,'(A)') ' INTEGER(HID_T) :: xfer_prp_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: mem_space_id_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: file_space_id_default' @@ -829,9 +829,9 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims' WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER, INTENT(OUT) :: hdferr' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp' WRITE(11,'(A)') ' INTEGER(HID_T) :: xfer_prp_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: mem_space_id_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: file_space_id_default' @@ -867,9 +867,9 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims' WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER, INTENT(OUT) :: hdferr' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp' WRITE(11,'(A)') ' INTEGER(HID_T) :: xfer_prp_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: mem_space_id_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: file_space_id_default' @@ -900,9 +900,9 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims' WRITE(11,'(A)') ' CHARACTER(LEN=*),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER, INTENT(OUT) :: hdferr' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id' - WRITE(11,'(A)') ' INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: mem_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: file_space_id' + WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN), OPTIONAL :: xfer_prp' WRITE(11,'(A)') ' INTEGER(HID_T) :: xfer_prp_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: mem_space_id_default' WRITE(11,'(A)') ' INTEGER(HID_T) :: file_space_id_default' diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index 90ca7d6..3e1b65d 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -386,6 +386,7 @@ h5close_types_c(hid_t_f *types, int_f *lentypes, hid_t_f *floatingtypes, int_f * * h5d_size_flags - H5D interface flags of type size_t * h5e_flags - H5E interface flags * h5e_hid_flags - H5E interface flags of type hid_t + * h5es_flags - H5ES interface flags * h5f_flags - H5F interface flags * h5fd_flags - H5FD interface flags * h5fd_hid_flags - H5FD interface flags of type hid_t @@ -424,10 +425,11 @@ h5close_types_c(hid_t_f *types, int_f *lentypes, hid_t_f *floatingtypes, int_f * */ int_f h5init_flags_c(int_f *h5d_flags, size_t_f *h5d_size_flags, int_f *h5e_flags, hid_t_f *h5e_hid_flags, - int_f *h5f_flags, int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, int_f *h5g_flags, - int_f *h5i_flags, int_f *h5l_flags, int_f *h5o_flags, hid_t_f *h5p_flags, int_f *h5p_flags_int, - int_f *h5r_flags, int_f *h5s_flags, hid_t_f *h5s_hid_flags, hsize_t_f *h5s_hsize_flags, - int_f *h5t_flags, int_f *h5z_flags, int_f *h5_generic_flags, haddr_t_f *h5_haddr_generic_flags) + H5ES_status_t *h5es_flags, hid_t_f *h5es_hid_flags, int_f *h5f_flags, int_f *h5fd_flags, + hid_t_f *h5fd_hid_flags, int_f *h5g_flags, int_f *h5i_flags, int_f *h5l_flags, + int_f *h5o_flags, hid_t_f *h5p_flags, int_f *h5p_flags_int, int_f *h5r_flags, int_f *h5s_flags, + hid_t_f *h5s_hid_flags, hsize_t_f *h5s_hsize_flags, int_f *h5t_flags, int_f *h5z_flags, + int_f *h5_generic_flags, haddr_t_f *h5_haddr_generic_flags) /******/ { /* @@ -475,6 +477,15 @@ h5init_flags_c(int_f *h5d_flags, size_t_f *h5d_size_flags, int_f *h5e_flags, hid h5e_flags[1] = (int_f)H5E_MINOR; h5e_flags[2] = (int_f)H5E_WALK_UPWARD; h5e_flags[3] = (int_f)H5E_WALK_DOWNWARD; + /* + * H5ES flags + */ + h5es_hid_flags[0] = (hid_t_f)H5ES_NONE; + + h5es_flags[0] = H5ES_STATUS_IN_PROGRESS; + h5es_flags[1] = H5ES_STATUS_SUCCEED; + h5es_flags[2] = H5ES_STATUS_CANCELED; + h5es_flags[3] = H5ES_STATUS_FAIL; /* * H5F flags diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90 index 31e0d28..f952cac 100644 --- a/fortran/src/H5_ff.F90 +++ b/fortran/src/H5_ff.F90 @@ -89,6 +89,13 @@ MODULE H5LIB INTEGER, PARAMETER :: H5E_HID_FLAGS_LEN = 1 INTEGER(HID_T), DIMENSION(1:H5E_HID_FLAGS_LEN) :: H5E_hid_flags ! + ! H5ES flags declaration + ! + INTEGER, PARAMETER :: H5ES_FLAGS_LEN = 4 + INTEGER, DIMENSION(1:H5ES_FLAGS_LEN) :: H5ES_flags + INTEGER, PARAMETER :: H5ES_HID_FLAGS_LEN = 1 + INTEGER(HID_T), DIMENSION(1:H5ES_HID_FLAGS_LEN) :: H5ES_hid_flags + ! ! H5FD flags declaration ! INTEGER, PARAMETER :: H5FD_FLAGS_LEN = 22 @@ -186,6 +193,8 @@ CONTAINS i_H5D_size_flags,& i_H5E_flags, & i_H5E_hid_flags, & + i_H5ES_flags, & + i_H5ES_hid_flags, & i_H5F_flags, & i_H5FD_flags, & i_H5FD_hid_flags, & @@ -207,6 +216,7 @@ CONTAINS IMPORT :: HID_T, SIZE_T, HSIZE_T, HADDR_T IMPORT :: H5D_FLAGS_LEN, H5D_SIZE_FLAGS_LEN, & H5E_FLAGS_LEN, H5E_HID_FLAGS_LEN, & + H5ES_FLAGS_LEN, H5ES_HID_FLAGS_LEN, & H5F_FLAGS_LEN, H5G_FLAGS_LEN, H5FD_FLAGS_LEN, & H5FD_HID_FLAGS_LEN, H5I_FLAGS_LEN, H5L_FLAGS_LEN, & H5O_FLAGS_LEN, H5P_FLAGS_LEN, H5P_FLAGS_INT_LEN, & @@ -217,6 +227,8 @@ CONTAINS INTEGER(SIZE_T) , DIMENSION(1:H5D_SIZE_FLAGS_LEN) :: i_H5D_size_flags INTEGER , DIMENSION(1:H5E_FLAGS_LEN) :: i_H5E_flags INTEGER(HID_T) , DIMENSION(1:H5E_HID_FLAGS_LEN) :: i_H5E_hid_flags + INTEGER , DIMENSION(1:H5ES_FLAGS_LEN) :: i_H5ES_flags + INTEGER(HID_T) , DIMENSION(1:H5ES_HID_FLAGS_LEN) :: i_H5ES_hid_flags INTEGER , DIMENSION(1:H5F_FLAGS_LEN) :: i_H5F_flags INTEGER , DIMENSION(1:H5G_FLAGS_LEN) :: i_H5G_flags INTEGER , DIMENSION(1:H5FD_FLAGS_LEN) :: i_H5FD_flags @@ -244,7 +256,7 @@ CONTAINS END FUNCTION h5init1_flags_c END INTERFACE - + error = 0 ! Check if H5open_f has already been called. If so, skip doing it again. IF(H5OPEN_NUM_OBJ .NE. 0) RETURN @@ -303,6 +315,8 @@ CONTAINS H5D_size_flags, & H5E_flags, & H5E_hid_flags, & + H5ES_flags, & + H5ES_hid_flags, & H5F_flags, & H5FD_flags, & H5FD_hid_flags, & @@ -422,6 +436,19 @@ CONTAINS H5E_WALK_UPWARD_F = H5E_flags(3) H5E_WALK_DOWNWARD_F = H5E_flags(4) ! + ! H5ES flags + ! + H5ES_NONE_F = H5ES_hid_flags(1) + + H5ES_STATUS_IN_PROGRESS_F = INT(H5ES_flags(1)) + H5ES_STATUS_SUCCEED_F = INT(H5ES_flags(2)) + H5ES_STATUS_CANCELED_F = INT(H5ES_flags(3)) + H5ES_STATUS_FAIL_F = INT(H5ES_flags(4)) + + H5ES_WAIT_FOREVER_F = HUGE(0_C_INT64_T) + H5ES_WAIT_NONE_F = 0_C_INT64_T + + ! ! H5FD flags ! H5FD_MPIO_INDEPENDENT_F = H5FD_flags(1) diff --git a/fortran/src/H5config_f.inc.cmake b/fortran/src/H5config_f.inc.cmake index 46dfb69..34fb091 100644 --- a/fortran/src/H5config_f.inc.cmake +++ b/fortran/src/H5config_f.inc.cmake @@ -76,3 +76,9 @@ ! Fortran compiler id #define H5_Fortran_COMPILER_ID @CMAKE_Fortran_COMPILER_ID@ + +! Define if deprecated public API symbols are disabled +#cmakedefine01 H5_NO_DEPRECATED_SYMBOLS +#if H5_NO_DEPRECATED_SYMBOLS == 0 +#undef H5_NO_DEPRECATED_SYMBOLS +#endif \ No newline at end of file diff --git a/fortran/src/H5config_f.inc.in b/fortran/src/H5config_f.inc.in index 0ce33ec..7fb76e1 100644 --- a/fortran/src/H5config_f.inc.in +++ b/fortran/src/H5config_f.inc.in @@ -74,3 +74,6 @@ ! Fortran compiler name #undef Fortran_COMPILER_ID +! Define if deprecated public API symbols are disabled +#undef NO_DEPRECATED_SYMBOLS + diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90 index 30bab33..984cae9 100644 --- a/fortran/src/H5f90global.F90 +++ b/fortran/src/H5f90global.F90 @@ -28,15 +28,8 @@ MODULE H5GLOBAL IMPLICIT NONE - ! Enumerate data type that is interoperable with C. - ENUM, BIND(C) - ENUMERATOR :: enum_dtype - END ENUM - !> \addtogroup FH5 !> @{ - INTEGER, PARAMETER :: ENUM_T = KIND(enum_dtype) !< Enumerate data type that is interoperable with C. - ! Parameters used in the function 'h5kind_to_type' located in H5_ff.F90. ! The flag is used to tell the function whether the kind input variable ! is for a REAL or INTEGER data type. @@ -382,10 +375,10 @@ 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 -!> @} ! ! H5E flags declaration ! +!> @} !DEC$if defined(BUILD_HDF5_DLL) !DEC$ATTRIBUTES DLLEXPORT :: H5E_DEFAULT_F !DEC$ATTRIBUTES DLLEXPORT :: H5E_MAJOR_F @@ -402,6 +395,28 @@ MODULE H5GLOBAL INTEGER :: H5E_WALK_DOWNWARD_F !< H5E_WALK_DOWNWARD !> @} ! + ! H5ES flags declaration + ! + !DEC$if defined(BUILD_HDF5_DLL) + !DEC$ATTRIBUTES DLLEXPORT :: H5ES_NONE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5ES_STATUS_IN_PROGRESS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5ES_STATUS_SUCCEED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5ES_STATUS_CANCELED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5ES_STATUS_FAIL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5ES_WAIT_FOREVER_F + !DEC$ATTRIBUTES DLLEXPORT :: H5ES_WAIT_NONE_F + !DEC$endif +!> \addtogroup FH5ES +!> @{ + INTEGER(HID_T) :: H5ES_NONE_F !< H5ES_NONE + INTEGER :: H5ES_STATUS_IN_PROGRESS_F !< H5ES_STATUS_IN_PROGRESS + INTEGER :: H5ES_STATUS_SUCCEED_F !< H5ES_STATUS_SUCCEED + INTEGER :: H5ES_STATUS_CANCELED_F !< H5ES_STATUS_CANCELED + INTEGER :: H5ES_STATUS_FAIL_F !< H5ES_STATUS_FAIL + INTEGER(C_INT64_T) :: H5ES_WAIT_FOREVER_F !< H5ES_WAIT_FOREVER + INTEGER(C_INT64_T) :: H5ES_WAIT_NONE_F !< H5ES_WAIT_NONE +!> @} + ! ! H5FD file drivers flags declaration ! !DEC$if defined(BUILD_HDF5_DLL) diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index f2a8419..11addfa 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -353,8 +353,8 @@ H5_FCDLL int_f h5oget_info_c(hid_t_f *object_id, H5O_info_t_f *object_info, int_ H5_FCDLL int_f h5oget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info, int_f *fields); -H5_FCDLL int_f h5oget_info_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, - H5O_info_t_f *object_info, int_f *fields); +H5_FCDLL int_f h5oget_info_by_name_c(hid_t_f *loc_id, char *name, hid_t_f *lapl_id, H5O_info_t_f *object_info, + int_f *fields, hid_t_f *es_id, char *file, char *func, int_f *line); H5_FCDLL int_f h5ocopy_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, hid_t_f *ocpypl_id, hid_t_f *lcpl_id); H5_FCDLL int_f h5odecr_refcount_c(hid_t_f *object_id); @@ -580,12 +580,12 @@ H5_FCDLL int_f h5init_types_c(hid_t_f *types, hid_t_f *floatingtypes, hid_t_f *i H5_FCDLL int_f h5close_types_c(hid_t_f *types, int_f *lentypes, hid_t_f *floatingtypes, int_f *floatinglen, hid_t_f *integertypes, int_f *integerlen); H5_FCDLL int_f h5init_flags_c(int_f *h5d_flags, size_t_f *h5d_size_flags, int_f *h5e_flags, - hid_t_f *h5e_hid_flags, int_f *h5f_flags, int_f *h5fd_flags, - hid_t_f *h5fd_hid_flags, int_f *h5g_flags, int_f *h5i_flags, int_f *h5l_flags, - int_f *h5o_flags, hid_t_f *h5p_flags, int_f *h5p_flags_int, int_f *h5r_flags, - int_f *h5s_flags, hid_t_f *h5s_hid_flags, hsize_t_f *h5s_hsize_flags, - int_f *h5t_flags, int_f *h5z_flags, int_f *h5_generic_flags, - haddr_t_f *h5_haddr_generic_flags); + hid_t_f *h5e_hid_flags, H5ES_status_t *h5es_flags, hid_t_f *h5es_hid_flags, + int_f *h5f_flags, int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, int_f *h5g_flags, + int_f *h5i_flags, int_f *h5l_flags, int_f *h5o_flags, hid_t_f *h5p_flags, + int_f *h5p_flags_int, int_f *h5r_flags, int_f *h5s_flags, + hid_t_f *h5s_hid_flags, hsize_t_f *h5s_hsize_flags, int_f *h5t_flags, + int_f *h5z_flags, int_f *h5_generic_flags, haddr_t_f *h5_haddr_generic_flags); H5_FCDLL int_f h5init1_flags_c(int_f *h5lib_flags); H5_FCDLL int_f h5get_libversion_c(int_f *majnum, int_f *minnum, int_f *relnum); H5_FCDLL int_f h5check_version_c(int_f *majnum, int_f *minnum, int_f *relnum); diff --git a/fortran/src/HDF5.F90 b/fortran/src/HDF5.F90 index 9fe6e19..faedc40 100644 --- a/fortran/src/HDF5.F90 +++ b/fortran/src/HDF5.F90 @@ -28,6 +28,7 @@ MODULE HDF5 USE H5F USE H5G USE H5E + USE H5ES USE H5I USE H5L USE H5S diff --git a/fortran/src/Makefile.am b/fortran/src/Makefile.am index 7d4154e..d42a41d 100644 --- a/fortran/src/Makefile.am +++ b/fortran/src/Makefile.am @@ -41,7 +41,7 @@ endif # Source files for the library. libhdf5_fortran_la_SOURCES=H5fortran_types.F90 H5f90global.F90 \ - H5_ff.F90 H5Aff.F90 H5Dff.F90 H5Eff.F90 \ + H5_ff.F90 H5Aff.F90 H5Dff.F90 H5Eff.F90 H5ESff.F90 \ H5Fff.F90 H5Gff.F90 H5Iff.F90 H5Lff.F90 H5Off.F90 H5Pff.F90 H5Rff.F90 H5Sff.F90 \ H5Tff.F90 H5VLff.F90 H5Zff.F90 H5_gen.F90 H5fortkit.F90 \ H5f90kit.c H5_f.c H5Af.c H5Df.c H5Ef.c H5Ff.c H5Gf.c \ @@ -143,10 +143,11 @@ H5f90global.lo: $(srcdir)/H5f90global.F90 H5fortran_types.lo H5_buildiface.lo: $(srcdir)/H5_buildiface.F90 H5_ff.lo: $(srcdir)/H5_ff.F90 H5Fff.lo H5f90global.lo H5Aff.lo: $(srcdir)/H5Aff.F90 H5f90global.lo -H5Dff.lo: $(srcdir)/H5Dff.F90 H5f90global.lo H5_ff.lo +H5Dff.lo: $(srcdir)/H5Dff.F90 H5f90global.lo H5_ff.lo H5Sff.lo H5Eff.lo: $(srcdir)/H5Eff.F90 H5f90global.lo +H5ESff.lo: $(srcdir)/H5ESff.F90 H5f90global.lo H5Fff.lo: $(srcdir)/H5Fff.F90 H5f90global.lo -H5Gff.lo: $(srcdir)/H5Gff.F90 H5f90global.lo +H5Gff.lo: $(srcdir)/H5Gff.F90 H5f90global.lo H5Pff.lo H5Iff.lo: $(srcdir)/H5Iff.F90 H5f90global.lo H5Lff.lo: $(srcdir)/H5Lff.F90 H5f90global.lo H5Off.lo: $(srcdir)/H5Off.F90 H5f90global.lo @@ -159,7 +160,7 @@ H5Zff.lo: $(srcdir)/H5Zff.F90 H5f90global.lo H5_gen.lo: H5_gen.F90 H5f90global.lo H5Aff.lo H5Dff.lo H5Pff.lo HDF5.lo: $(srcdir)/HDF5.F90 H5f90global.lo H5_ff.lo H5Aff.lo \ H5Dff.lo \ - H5Eff.lo \ + H5Eff.lo H5ESff.lo \ H5Fff.lo H5Gff.lo H5Iff.lo H5Lff.lo \ H5Off.lo H5Pff.lo H5Rff.lo \ H5Sff.lo H5Tff.lo H5Zff.lo H5_gen.lo diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 4fa6f6a..e55be46 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -13,8 +13,9 @@ H5LIB_mp_H5GMTIME H5A_mp_H5AWRITE_CHAR_SCALAR H5A_mp_H5AREAD_CHAR_SCALAR H5A_mp_H5ACREATE_F +H5A_mp_H5ACREATE_ASYNC_F H5A_mp_H5AOPEN_NAME_F -H5A_mp_H5AOPEN_IDX_F +@H5_NO_DEPRECATED_SYMBOLS@H5A_mp_H5AOPEN_IDX_F H5A_mp_H5AGET_SPACE_F H5A_mp_H5AGET_TYPE_F H5A_mp_H5AGET_NAME_F @@ -22,27 +23,41 @@ H5A_mp_H5AGET_NAME_BY_IDX_F H5A_mp_H5AGET_NUM_ATTRS_F H5A_mp_H5ADELETE_F H5A_mp_H5ACLOSE_F +H5A_mp_H5ACLOSE_ASYNC_F H5A_mp_H5AGET_STORAGE_SIZE_F H5A_mp_H5AGET_CREATE_PLIST_F H5A_mp_H5ARENAME_BY_NAME_F +H5A_mp_H5ARENAME_BY_NAME_ASYNC_F H5A_mp_H5AOPEN_F +H5A_mp_H5AOPEN_ASYNC_F H5A_mp_H5ADELETE_BY_IDX_F H5A_mp_H5ADELETE_BY_NAME_F H5A_mp_H5AOPEN_BY_IDX_F +H5A_mp_H5AOPEN_BY_IDX_ASYNC_F H5A_mp_H5AGET_INFO_F H5A_mp_H5AGET_INFO_BY_IDX_F H5A_mp_H5AGET_INFO_BY_NAME_F H5A_mp_H5ACREATE_BY_NAME_F +H5A_mp_H5ACREATE_BY_NAME_ASYNC_F H5A_mp_H5AEXISTS_F +H5A_mp_H5AEXISTS_ASYNC_F H5A_mp_H5AEXISTS_BY_NAME_F +H5A_mp_H5AEXISTS_BY_NAME_ASYNC_F H5A_mp_H5AOPEN_BY_NAME_F +H5A_mp_H5AOPEN_BY_NAME_ASYNC_F H5A_mp_H5AWRITE_PTR +H5A_mp_H5AWRITE_ASYNC_F H5A_mp_H5AREAD_PTR +H5A_mp_H5AREAD_ASYNC_F H5A_mp_H5ARENAME_F +H5A_mp_H5ARENAME_ASYNC_F ; H5D H5D_mp_H5DCREATE_F +H5D_mp_H5DCREATE_ASYNC_F H5D_mp_H5DOPEN_F +H5D_mp_H5DOPEN_ASYNC_F H5D_mp_H5DCLOSE_F +H5D_mp_H5DCLOSE_ASYNC_F H5D_mp_H5DWRITE_REFERENCE_OBJ H5D_mp_H5DWRITE_REFERENCE_DSETREG H5D_mp_H5DWRITE_CHAR_SCALAR @@ -50,8 +65,10 @@ H5D_mp_H5DREAD_REFERENCE_OBJ H5D_mp_H5DREAD_REFERENCE_DSETREG H5D_mp_H5DREAD_CHAR_SCALAR H5D_mp_H5DGET_SPACE_F +H5D_mp_H5DGET_SPACE_ASYNC_F H5D_mp_H5DGET_TYPE_F H5D_mp_H5DSET_EXTENT_F +H5D_mp_H5DSET_EXTENT_ASYNC_F H5D_mp_H5DGET_CREATE_PLIST_F H5D_mp_H5DGET_STORAGE_SIZE_F H5D_mp_H5DVLEN_GET_MAX_LEN_F @@ -82,6 +99,8 @@ H5D_mp_H5DREAD_PTR H5D_mp_H5DVLEN_RECLAIM_F H5D_mp_H5DREAD_MULTI_F H5D_mp_H5DWRITE_MULTI_F +H5D_mp_H5DWRITE_ASYNC_F +H5D_mp_H5DREAD_ASYNC_F ; H5E H5E_mp_H5ECLEAR_F H5E_mp_H5EPRINT_F @@ -90,15 +109,20 @@ H5E_mp_H5EGET_MINOR_F H5E_mp_H5ESET_AUTO_F ; H5F H5F_mp_H5FCREATE_F +H5F_mp_H5FCREATE_ASYNC_F H5F_mp_H5FFLUSH_F +H5F_mp_H5FFLUSH_ASYNC_F H5F_mp_H5FCLOSE_F +H5F_mp_H5FCLOSE_ASYNC_F H5F_mp_H5FGET_OBJ_COUNT_F H5F_mp_H5FGET_OBJ_IDS_F H5F_mp_H5FGET_FREESPACE_F H5F_mp_H5FMOUNT_F H5F_mp_H5FUNMOUNT_F H5F_mp_H5FOPEN_F +H5F_mp_H5FOPEN_ASYNC_F H5F_mp_H5FREOPEN_F +H5F_mp_H5FREOPEN_ASYNC_F H5F_mp_H5FGET_CREATE_PLIST_F H5F_mp_H5FGET_ACCESS_PLIST_F H5F_mp_H5FIS_ACCESSIBLE_F @@ -111,8 +135,11 @@ H5F_mp_H5FGET_DSET_NO_ATTRS_HINT_F H5F_mp_H5FSET_DSET_NO_ATTRS_HINT_F ; H5G H5G_mp_H5GOPEN_F +H5G_mp_H5GOPEN_ASYNC_F H5G_mp_H5GCREATE_F +H5G_mp_H5GCREATE_ASYNC_F H5G_mp_H5GCLOSE_F +H5G_mp_H5GCLOSE_ASYNC_F H5G_mp_H5GGET_OBJ_INFO_IDX_F H5G_mp_H5GN_MEMBERS_F H5G_mp_H5GLINK_F @@ -125,9 +152,15 @@ H5G_mp_H5GSET_COMMENT_F H5G_mp_H5GGET_COMMENT_F H5G_mp_H5GCREATE_ANON_F H5G_mp_H5GGET_CREATE_PLIST_F -H5G_mp_H5GGET_INFO_F -H5G_mp_H5GGET_INFO_BY_IDX_F -H5G_mp_H5GGET_INFO_BY_NAME_F +H5G_mp_H5GGET_INFO_F90 +H5G_mp_H5GGET_INFO_BY_IDX_F90 +H5G_mp_H5GGET_INFO_BY_NAME_F90 +H5G_mp_H5GGET_INFO_F03 +H5G_mp_H5GGET_INFO_BY_IDX_F03 +H5G_mp_H5GGET_INFO_BY_NAME_F03 +H5G_mp_H5GGET_INFO_ASYNC_F +H5G_mp_H5GGET_INFO_BY_IDX_ASYNC_F +H5G_mp_H5GGET_INFO_BY_NAME_ASYNC_F H5G_mp_H5GGET_OBJ_INFO_IDX_F ; H5GLOBAL ; PREDEFINED_TYPES DATA @@ -160,21 +193,29 @@ H5I_mp_H5IIS_VALID_F ; H5L H5L_mp_H5LCOPY_F H5L_mp_H5LDELETE_F +H5L_mp_H5LDELETE_ASYNC_F H5L_mp_H5LCREATE_SOFT_F +H5L_mp_H5LCREATE_SOFT_ASYNC_F H5L_mp_H5LCREATE_HARD_F +H5L_mp_H5LCREATE_HARD_ASYNC_F H5L_mp_H5LCREATE_EXTERNAL_F H5L_mp_H5LDELETE_BY_IDX_F +H5L_mp_H5LDELETE_BY_IDX_ASYNC_F H5L_mp_H5LEXISTS_F +H5L_mp_H5LEXISTS_ASYNC_F H5L_mp_H5LGET_INFO_F H5L_mp_H5LGET_INFO_BY_IDX_F H5L_mp_H5LIS_REGISTERED_F H5L_mp_H5LMOVE_F H5L_mp_H5LGET_NAME_BY_IDX_F H5L_mp_H5LITERATE_F +H5L_mp_H5LITERATE_ASYNC_F H5L_mp_H5LITERATE_BY_NAME_F ; H5O H5O_mp_H5OCLOSE_F +H5O_mp_H5OCLOSE_ASYNC_F H5O_mp_H5OCOPY_F +H5O_mp_H5OCOPY_ASYNC_F H5O_mp_H5ODECR_REFCOUNT_F H5O_mp_H5OEXISTS_BY_NAME_F H5O_mp_H5OGET_COMMENT_F @@ -183,11 +224,14 @@ H5O_mp_H5OINCR_REFCOUNT_F H5O_mp_H5OLINK_F H5O_mp_H5OOPEN_BY_TOKEN_F H5O_mp_H5OOPEN_BY_IDX_F +H5O_mp_H5OOPEN_BY_IDX_ASYNC_F H5O_mp_H5OOPEN_F +H5O_mp_H5OOPEN_ASYNC_F H5O_mp_H5OSET_COMMENT_F H5O_mp_H5OSET_COMMENT_BY_NAME_F H5O_mp_H5OGET_INFO_BY_IDX_F H5O_mp_H5OGET_INFO_BY_NAME_F +H5O_mp_H5OGET_INFO_BY_NAME_ASYNC_F H5O_mp_H5OGET_INFO_F H5O_mp_H5OVISIT_BY_NAME_F H5O_mp_H5OVISIT_F diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am index 7d85a27..6ceddd6 100644 --- a/fortran/test/Makefile.am +++ b/fortran/test/Makefile.am @@ -47,7 +47,7 @@ fortranlib_test_1_8_SOURCES = tH5O.F90 tH5A_1_8.F90 tH5G_1_8.F90 tH5MISC_1_8.F90 fortranlib_test_1_8.F90 fortranlib_test_F03_SOURCES = tH5E_F03.F90 tH5F_F03.F90 tH5L_F03.F90 \ - tH5O_F03.F90 tH5P_F03.F90 tH5T_F03.F90 tHDF5_F03.F90 fortranlib_test_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/tH5A_1_8.F90 b/fortran/test/tH5A_1_8.F90 index 5344f4b..d43279e 100644 --- a/fortran/test/tH5A_1_8.F90 +++ b/fortran/test/tH5A_1_8.F90 @@ -2614,6 +2614,7 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) WRITE(chr5,'(I5.5)') u attrname = 'attr '//chr5 CALL H5Aexists_f( gid, attrname, exists, error) + CALL check("H5Aexists_f", error, total_error) CALL verify("H5Aexists",exists,.FALSE.,total_error ) CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error, lapl_id = H5P_DEFAULT_F) @@ -2623,9 +2624,11 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) CALL check("h5acreate_f",error,total_error) CALL H5Aexists_f(gid, attrname, exists, error) + CALL check("H5Aexists_f", error, total_error) CALL verify("H5Aexists",exists,.TRUE.,total_error ) CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error) + CALL check("H5Aexists_by_name_f", error, total_error) CALL verify("H5Aexists_by_name_f",exists,.TRUE.,total_error ) attr_data1(1) = u @@ -2638,9 +2641,11 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) CALL check("h5aclose_f",error,total_error) CALL H5Aexists_f(gid, attrname, exists, error) + CALL check("H5Aexists_f", error, total_error) CALL verify("H5Aexists",exists,.TRUE.,total_error ) CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error) + CALL check("H5Aexists_by_name_f", error, total_error) CALL verify("H5Aexists_by_name_f",exists,.TRUE.,total_error ) ENDDO diff --git a/fortran/test/tH5G_1_8.F90 b/fortran/test/tH5G_1_8.F90 index a4b25f2..c820d78 100644 --- a/fortran/test/tH5G_1_8.F90 +++ b/fortran/test/tH5G_1_8.F90 @@ -163,6 +163,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure INTEGER :: nlinks ! Number of links in group INTEGER :: max_corder ! Current maximum creation order value for group + TYPE(H5G_info_t) :: ginfo INTEGER :: u,v ! Local index variables CHARACTER(LEN=2) :: chr2 @@ -283,29 +284,61 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("H5Gget_info_f", error, total_error) ! Check (new/empty) group's information - CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) - CALL verify("H5Gget_info_f", max_corder, 0, total_error) - CALL verify("H5Gget_info_f", nlinks, 0, total_error) + CALL verify("H5Gget_info_f.storage_type", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL verify("H5Gget_info_f.max_corder", max_corder, 0, total_error) + CALL VERIFY("H5Gget_info_f.nlinks", nlinks, 0, total_error) CALL verify("H5Gget_info_f.mounted", mounted,.FALSE.,total_error) + ! Retrieve group's information (F03) + CALL H5Gget_info_f(group_id2, ginfo, error) + CALL check("H5Gget_info_f", error, total_error) + + CALL VERIFY("H5Gget_info_f.storage_type", & + ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F,C_INT), total_error) + CALL verify("H5Gget_info_f.max_corder", ginfo%max_corder, 0_C_INT64_T, total_error) + CALL verify("H5Gget_info_f.nlinks", ginfo%nlinks, 0_HSIZE_T, total_error) + CALL verify("H5Gget_info_f.mounted", LOGICAL(ginfo%mounted), .FALSE.,total_error) + ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error, mounted=mounted) CALL check("H5Gget_info_by_name_f", error, total_error) ! Check (new/empty) group's information - CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) - CALL verify("H5Gget_info_by_name_f", max_corder, 0, total_error) - CALL verify("H5Gget_info_by_name_f", nlinks, 0, total_error) - CALL verify("H5Gget_info_by_name_f.mounted", mounted,.FALSE.,total_error) + CALL verify("H5Gget_info_by_name_f.storage_type", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL verify("H5Gget_info_by_name_f.max_corder", max_corder, 0, total_error) + CALL verify("H5Gget_info_by_name_f.nlinks", nlinks, 0, total_error) + CALL verify("H5Gget_info_by_name_f.mounted", mounted, .FALSE., total_error) + + ! Retrieve group's information (F03) + CALL H5Gget_info_by_name_f(group_id, objname, ginfo, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! Check (new/empty) group's information + CALL VERIFY("H5Gget_info_by_name_f.storage_type", & + ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_by_name_f.max_corder", ginfo%max_corder, 0_C_INT64_T, total_error) + CALL verify("H5Gget_info_by_name_f.nlinks", ginfo%nlinks, 0_HSIZE_T, total_error) + CALL VERIFY("H5Gget_info_by_name_f.mounted", LOGICAL(ginfo%mounted), .FALSE.,total_error) ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name", error, total_error) ! Check (new/empty) group's information - CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) - CALL verify("H5Gget_info_by_name_f", max_corder, 0, total_error) - CALL verify("H5Gget_info_by_name_f", nlinks, 0, total_error) + CALL VERIFY("H5Gget_info_by_name_f.storage_type", & + ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_by_name_f.max_corder", ginfo%max_corder, 0_C_INT64_T, total_error) + CALL verify("H5Gget_info_by_name_f.nlinks", ginfo%nlinks, 0_HSIZE_T, total_error) + + ! Retrieve group's information (F03) + CALL H5Gget_info_by_name_f(group_id2, ".", ginfo, error) + CALL check("H5Gget_info_by_name", error, total_error) + + ! Check (new/empty) group's information + CALL VERIFY("H5Gget_info_by_name_f.storage_type", & + ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_by_name_f.max_corder", ginfo%max_corder, 0_C_INT64_T, total_error) + CALL verify("H5Gget_info_by_name_f.nlinks", ginfo%nlinks, 0_HSIZE_T, total_error) ! Create objects in new group created DO v = 0, u @@ -331,6 +364,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_f", nlinks, u+1, total_error) + ! Retrieve group's information (F03) + CALL H5Gget_info_f(group_id2, ginfo, error) + CALL check("H5Gget_info_f", error, total_error) + + ! Check (new) group's information + CALL VERIFY("H5Gget_info_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL VERIFY("H5Gget_info_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL VERIFY("H5Gget_info_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name_f", error, total_error) @@ -340,6 +382,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_by_name_f",max_corder, u+1, total_error) CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error) + ! Retrieve group's information (F03) + CALL H5Gget_info_by_name_f(group_id, objname, ginfo, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! Check (new) group's information + CALL VERIFY("H5Gget_info_by_name_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL VERIFY("H5Gget_info_by_name_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL VERIFY("H5Gget_info_by_name_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name_f", error, total_error) @@ -349,6 +400,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error) + ! Retrieve group's information (F03) + CALL H5Gget_info_by_name_f(group_id2, ".", ginfo, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! Check (new) group's information + CALL VERIFY("H5Gget_info_by_name_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL VERIFY("H5Gget_info_by_name_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL VERIFY("H5Gget_info_by_name_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Retrieve group's information IF(order.NE.H5_ITER_NATIVE_F)THEN IF(order.EQ.H5_ITER_INC_F) THEN @@ -356,16 +416,31 @@ SUBROUTINE group_info(cleanup, fapl, total_error) storage_type, nlinks, max_corder, error,lapl_id=H5P_DEFAULT_F, mounted=mounted) CALL check("H5Gget_info_by_idx_f", error, total_error) CALL verify("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error) + + CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(u,HSIZE_T), & + ginfo, error,lapl_id=H5P_DEFAULT_F) + CALL check("H5Gget_info_by_idx_f", error, total_error) + CALL VERIFY("H5Gget_info_by_idx_f", LOGICAL(ginfo%mounted), .FALSE., total_error) + ELSE CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(0,HSIZE_T), & storage_type, nlinks, max_corder, error, mounted=mounted) + CALL check("H5Gget_info_by_idx_f", error, total_error) CALL verify("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error) + + CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(0,HSIZE_T), & + ginfo, error) CALL check("H5Gget_info_by_idx_f", error, total_error) + CALL verify("H5Gget_info_by_idx_f", LOGICAL(ginfo%mounted),.FALSE.,total_error) ENDIF ! Check (new) group's information CALL verify("H5Gget_info_by_idx_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL verify("H5Gget_info_by_idx_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_by_idx_f", nlinks, u+1, total_error) + + CALL VERIFY("H5Gget_info_by_idx_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_by_idx_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL verify("H5Gget_info_by_idx_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) ENDIF ! Close group created CALL H5Gclose_f(group_id2, error) @@ -380,6 +455,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_f", nlinks, u+1, total_error) + ! Retrieve main group's information (F03) + CALL H5Gget_info_f(group_id, ginfo, error) + CALL check("H5Gget_info_f", error, total_error) + + ! Check main group's information + CALL VERIFY("H5Gget_info_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL verify("H5Gget_info_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Retrieve main group's information, by name CALL H5Gget_info_by_name_f(file_id, CORDER_GROUP_NAME, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name_f", error, total_error) @@ -389,6 +473,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error) + ! Retrieve main group's information, by name (F03) + CALL H5Gget_info_by_name_f(file_id, CORDER_GROUP_NAME, ginfo, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! Check main group's information + CALL VERIFY("H5Gget_info_by_name_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F,C_INT), total_error) + CALL verify("H5Gget_info_by_name_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL verify("H5Gget_info_by_name_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Retrieve main group's information, by name CALL H5Gget_info_by_name_f(group_id, ".", storage_type, nlinks, max_corder, error, H5P_DEFAULT_F) CALL check("H5Gget_info_by_name_f", error, total_error) @@ -398,6 +491,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error) + ! Retrieve main group's information, by name + CALL H5Gget_info_by_name_f(group_id, ".", ginfo, error, H5P_DEFAULT_F) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! Check main group's information + CALL VERIFY("H5Gget_info_by_name_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_by_name_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL verify("H5Gget_info_by_name_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Create soft link in another group, to objects in main group valname = CORDER_GROUP_NAME//objname @@ -411,31 +513,39 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL verify("H5Gget_info_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_f", nlinks, u+1, total_error) + + ! Retrieve soft link group's information, by name (F03) + CALL H5Gget_info_f(soft_group_id, ginfo, error) + CALL check("H5Gget_info_f", error, total_error) + + ! Check soft link group's information + CALL VERIFY("H5Gget_info_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL verify("H5Gget_info_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) ENDDO ! Close the groups - CALL H5Gclose_f(group_id, error) - CALL check("H5Gclose_f", error, total_error) - CALL H5Gclose_f(soft_group_id, error) - CALL check("H5Gclose_f", error, total_error) + CALL H5Gclose_f(group_id, error) + CALL check("H5Gclose_f", error, total_error) + CALL H5Gclose_f(soft_group_id, error) + CALL check("H5Gclose_f", error, total_error) - ! Close the file - CALL H5Fclose_f(file_id, error) - CALL check("H5Fclose_f", error, total_error) - ENDDO + ! Close the file + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f", error, total_error) ENDDO ENDDO + ENDDO - ! Free resources - CALL H5Pclose_f(gcpl_id, error) - CALL check("H5Pclose_f", error, total_error) - - IF(cleanup) CALL h5_cleanup_f(prefix, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) + ! Free resources + CALL H5Pclose_f(gcpl_id, error) + CALL check("H5Pclose_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f(prefix, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) - END SUBROUTINE group_info +END SUBROUTINE group_info !------------------------------------------------------------------------- ! * Function: timestamps @@ -1119,9 +1229,11 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) CALL H5Lexists_f(file,"d1",Lexists, error) + CALL check("H5Lexists_f", error, total_error) CALL verify("H5Lexists", Lexists,.TRUE.,total_error) CALL H5Lexists_f(file,"grp1/hard",Lexists, error) + CALL check("H5Lexists_f", error, total_error) CALL verify("H5Lexists", Lexists,.TRUE.,total_error) ! Cleanup diff --git a/fortran/test/tf.F90 b/fortran/test/tf.F90 index 0c518f5..73f43bc 100644 --- a/fortran/test/tf.F90 +++ b/fortran/test/tf.F90 @@ -36,6 +36,8 @@ MODULE TH5_MISC INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(5) ! This should map to REAL*4 on most modern processors INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors + INTEGER, PARAMETER :: TAB_SPACE = 88 ! Tab spacing for printing results + ! generic compound datatype TYPE :: comp_datatype SEQUENCE @@ -57,6 +59,84 @@ CONTAINS !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_TEST_DLL) +!DEC$attributes dllexport :: write_test_header +!DEC$endif + SUBROUTINE write_test_header(title_header) + + ! Writes the test header + + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(IN) :: title_header ! test name + INTEGER, PARAMETER :: width = TAB_SPACE+10 + CHARACTER(LEN=2*width) ::title_centered =" " + INTEGER :: len, i + + len=LEN_TRIM(title_header) + title_centered(1:3) ="| |" + title_centered((width-len)/2:(width-len)/2+len) = TRIM(title_header) + title_centered(width-1:width+2) ="| |" + + WRITE(*,'(1X)', ADVANCE="NO") + DO i = 1, width-1 + WRITE(*,'("_")', ADVANCE="NO") + ENDDO + WRITE(*,'()') + WRITE(*,'("| ")', ADVANCE="NO") + DO i = 1, width-5 + WRITE(*,'("_")', ADVANCE="NO") + ENDDO + WRITE(*,'(" |")') + + WRITE(*,'("| |")', ADVANCE="NO") + DO i = 1, width-5 + WRITE(*,'(1X)', ADVANCE="NO") + ENDDO + WRITE(*,'("| |")') + + WRITE(*,'(A)') title_centered + + WRITE(*,'("| |")', ADVANCE="NO") + DO i = 1, width-5 + WRITE(*,'(1X)', ADVANCE="NO") + ENDDO + WRITE(*,'("| |")') + + WRITE(*,'("| |")', ADVANCE="NO") + DO i = 1, width-5 + WRITE(*,'("_")', ADVANCE="NO") + ENDDO + WRITE(*,'("| |")') + + WRITE(*,'("|")', ADVANCE="NO") + DO i = 1, width-1 + WRITE(*,'("_")', ADVANCE="NO") + ENDDO + WRITE(*,'("|",/)') + + END SUBROUTINE write_test_header + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_TEST_DLL) +!DEC$attributes dllexport :: write_test_footer +!DEC$endif + SUBROUTINE write_test_footer() + + ! Writes the test footer + + IMPLICIT NONE + INTEGER, PARAMETER :: width = TAB_SPACE+10 + INTEGER :: i + + DO i = 1, width + WRITE(*,'("_")', ADVANCE="NO") + ENDDO + WRITE(*,'(/)') + + END SUBROUTINE write_test_footer + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_TEST_DLL) !DEC$attributes dllexport :: write_test_status !DEC$endif SUBROUTINE write_test_status( test_result, test_title, total_error) @@ -78,7 +158,7 @@ CONTAINS CHARACTER(LEN=8), PARAMETER :: success = ' PASSED ' CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*' CHARACTER(LEN=8), PARAMETER :: skip = '--SKIP--' - + CHARACTER(LEN=10) :: FMT error_string = failure IF (test_result == 0) THEN @@ -86,8 +166,8 @@ CONTAINS ELSE IF (test_result == -1) THEN error_string = skip ENDIF - - WRITE(*, fmt = '(A, T88, A)') test_title, error_string + WRITE(FMT,'("(A,T",I0,",A)")') TAB_SPACE + WRITE(*, fmt = FMT) test_title, error_string IF(test_result.GT.0) total_error = total_error + test_result diff --git a/fortran/testpar/CMakeLists.txt b/fortran/testpar/CMakeLists.txt index 58ef95d..ca241f6 100644 --- a/fortran/testpar/CMakeLists.txt +++ b/fortran/testpar/CMakeLists.txt @@ -98,6 +98,46 @@ if(MSVC) set_property(TARGET subfiling_test PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") endif() +#-- Adding test for async_test +add_executable (async_test + async.F90 +) +target_include_directories (async_test + PRIVATE ${TESTPAR_INCLUDES} +) +target_compile_options(async_test + PRIVATE + "${HDF5_CMAKE_Fortran_FLAGS}" + $<$:${WIN_COMPILE_FLAGS}> +) +if (NOT BUILD_SHARED_LIBS) + target_link_libraries (async_test + PRIVATE + ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} ${LINK_Fortran_LIBS} + $<$:"ws2_32.lib"> + ) + set_target_properties (async_test PROPERTIES + FOLDER test/fortran + LINKER_LANGUAGE Fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static + ) +else () + target_link_libraries (async_test + PRIVATE + ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} ${LINK_Fortran_LIBS} + $<$:"ws2_32.lib"> + ) + set_target_properties (async_test PROPERTIES + FOLDER test/fortran + LINKER_LANGUAGE Fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared + ) +endif () + +if(MSVC) + set_property(TARGET async_test PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") +endif() + if (HDF5_TEST_FORTRAN AND HDF5_TEST_PARALLEL) include (CMakeTests.cmake) endif () diff --git a/fortran/testpar/Makefile.am b/fortran/testpar/Makefile.am index b1cefbc..7f9f284 100644 --- a/fortran/testpar/Makefile.am +++ b/fortran/testpar/Makefile.am @@ -32,7 +32,7 @@ else endif # These are our main targets -TEST_PROG_PARA=parallel_test subfiling_test +TEST_PROG_PARA=parallel_test subfiling_test async_test check_PROGRAMS=$(TEST_PROG_PARA) # Temporary files @@ -41,6 +41,7 @@ CHECK_CLEANFILES+=parf[12].h5 subf.h5* # Test source files parallel_test_SOURCES=ptest.F90 hyper.F90 mdset.F90 multidsetrw.F90 subfiling_test_SOURCES=subfiling.F90 +async_test_SOURCES=async.F90 # The tests depend on several libraries. LDADD=$(LIBH5FTEST) $(LIBH5TEST) $(LIBH5F) $(LIBHDF5) diff --git a/fortran/testpar/async.F90 b/fortran/testpar/async.F90 new file mode 100644 index 0000000..e3a80ad --- /dev/null +++ b/fortran/testpar/async.F90 @@ -0,0 +1,1417 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! 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. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! Tests async Fortran wrappers. It needs an async VOL. It will skip the tests if +! HDF5_VOL_CONNECTOR is not set or is set to a non-supporting async VOL. +! +MODULE test_async_APIs + + USE MPI + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + + INTEGER(C_INT), PARAMETER :: op_data_type = 200 + INTEGER(C_INT), PARAMETER :: op_data_command = 99 + + LOGICAL :: async_enabled = .TRUE. + LOGICAL :: mpi_thread_mult = .TRUE. + + ! Custom group iteration callback data + TYPE, bind(c) :: iter_info + CHARACTER(KIND=C_CHAR), DIMENSION(1:12) :: 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 + + CHARACTER(LEN=10), TARGET :: app_file = "async.F90"//C_NULL_CHAR + CHARACTER(LEN=10), TARGET :: app_func = "func_name"//C_NULL_CHAR + INTEGER :: app_line = 42 + +CONTAINS + + INTEGER(KIND=C_INT) FUNCTION liter_cb(group, name, link_info, op_data) bind(C) + + IMPLICIT NONE + + INTEGER(HID_T), VALUE :: group + CHARACTER(LEN=1), DIMENSION(1:12) :: name + TYPE (H5L_info_t) :: link_info + TYPE(iter_info) :: op_data + + liter_cb = 0 + + op_data%name(1:12) = name(1:12) + + SELECT CASE (op_data%command) + + CASE(0) + liter_cb = 0 + CASE(2) + liter_cb = op_data%command*10 + END SELECT + op_data%command = op_data_command + op_data%type = op_data_type + + END FUNCTION liter_cb + + SUBROUTINE H5ES_tests(cleanup, total_error) + ! + ! Test H5ES routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER :: nerrors = 0 + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5es_tests.h5" + INTEGER :: hdferror + + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: count + INTEGER(C_INT64_T) :: counter + INTEGER(SIZE_T) :: num_not_canceled + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, nerrors) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, nerrors) + + CALL H5ESget_count_f(es_id, count, hdferror) + CALL check("H5ESget_count_f", hdferror, nerrors) + CALL VERIFY("H5ESget_count_f", count, 0_SIZE_T,total_error) + + CALL H5EScancel_f(es_id, num_not_canceled, err_occurred, hdferror) + CALL check("H5EScancel_f", hdferror, nerrors) + CALL VERIFY("H5EScancel_f", num_not_canceled, 0_size_t, total_error) + CALL VERIFY("H5EScancel_f", err_occurred, .FALSE., total_error) + + CALL H5Fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, hdferror, access_prp = fapl_id) + CALL check("h5fcreate_f", hdferror, nerrors) + + CALL H5ESget_count_f(es_id, count, hdferror) + CALL check("H5ESget_count_f", hdferror, nerrors) + IF(async_enabled)THEN + CALL VERIFY("H5ESget_count_f", count, 2_SIZE_T,total_error) + ELSE + CALL VERIFY("H5ESget_count_f", count, 0_SIZE_T,total_error) + ENDIF + + CALL H5ESget_op_counter_f(es_id, counter, hdferror) + CALL check("H5ESget_op_counter_f", hdferror, nerrors) + IF(async_enabled)THEN + CALL VERIFY("H5ESget_op_counter_f", counter, 2_C_INT64_T, total_error) + ELSE + CALL VERIFY("H5ESget_op_counter_f", counter, 0_C_INT64_T, total_error) + ENDIF + + CALL H5Pclose_f(fapl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_f", hdferror, nerrors) + CALL H5ESget_count_f(es_id, count, hdferror) + CALL check("H5ESget_count_f", hdferror, nerrors) + IF(async_enabled)THEN + CALL VERIFY("H5ESget_count_f", count, 3_SIZE_T,total_error) + ELSE + CALL VERIFY("H5ESget_count_f", count, 0_SIZE_T,total_error) + ENDIF + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, nerrors) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + CALL H5ESget_count_f(es_id, count, hdferror) + CALL check("H5ESget_count_f", hdferror, nerrors) + CALL VERIFY("H5ESget_count_f", count, 0_SIZE_T,total_error) + + CALL H5ESclose_f(es_id, hdferror) + CALL check("H5ESclose_f", hdferror, nerrors) + + END SUBROUTINE H5ES_tests + + SUBROUTINE H5A_async_tests(cleanup, total_error) + ! + ! Test H5A async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5a_tests.h5" + INTEGER :: hdferror + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + CHARACTER(LEN=4), PARAMETER :: attr_name = "ATTR" + INTEGER, TARGET :: attr_data0 = 100 + INTEGER, TARGET :: attr_data1 = 101 + INTEGER, TARGET :: attr_data2 = 101 + INTEGER, TARGET :: attr_rdata0 + INTEGER, TARGET :: attr_rdata1 + INTEGER, TARGET :: attr_rdata2 + INTEGER(HID_T) :: space_id + INTEGER(HID_T) :: attr_id0, attr_id1, attr_id2 + LOGICAL :: exists + LOGICAL(C_BOOL), TARGET :: exists0 = .FALSE., exists1 = .FALSE., exists2 = .FALSE., exists3 = .FALSE. + TYPE(C_PTR) :: f_ptr, f_ptr1, f_ptr2 + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + ! + ! Create the file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, total_error) + + CALL h5fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, hdferror, access_prp = fapl_id ) + CALL check("h5fcreate_f",hdferror, total_error) + + CALL H5Screate_f(H5S_SCALAR_F, space_id, hdferror) + CALL check("H5Screate_f", hdferror, total_error) + + f_ptr1 = C_LOC(app_file) + f_ptr2 = C_LOC(app_func) + CALL h5acreate_async_f(file_id, attr_name, H5T_NATIVE_INTEGER, space_id, attr_id0, es_id, hdferror, & + file=f_ptr1, func=f_ptr2, line=app_line) + CALL check("h5acreate_f",hdferror,total_error) + + f_ptr = C_LOC(attr_data0) + CALL H5Awrite_async_f(attr_id0, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Awrite_async_f",hdferror,total_error) + + CALL H5Aclose_async_f(attr_id0, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL h5acreate_by_name_async_f(file_id, "/", TRIM(attr_name)//"00", & + H5T_NATIVE_INTEGER, space_id, attr_id1, es_id, hdferror) + CALL check("h5acreate_by_name_async_f",hdferror,total_error) + + CALL h5acreate_by_name_async_f(file_id, "/", TRIM(attr_name)//"01", & + H5T_NATIVE_INTEGER, space_id, attr_id2, es_id, hdferror) + CALL check("h5acreate_by_name_async_f",hdferror,total_error) + + f_ptr = C_LOC(attr_data1) + CALL H5Awrite_async_f(attr_id1, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Awrite_async_f",hdferror,total_error) + + CALL H5Aclose_async_f(attr_id1, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + f_ptr = C_LOC(attr_data2) + CALL H5Awrite_async_f(attr_id2, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Awrite_async_f",hdferror,total_error) + + CALL H5Aclose_async_f(attr_id2, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL H5Sclose_f(space_id, hdferror) + CALL check("H5Sclose_f",hdferror,total_error) + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("H5Fclose_async_f",hdferror, total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + CALL h5fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_async_f",hdferror, total_error) + + f_ptr = C_LOC(exists0) + CALL H5Aexists_async_f(file_id, attr_name, f_ptr, es_id, hdferror) + CALL check("H5Aexists_async_f",hdferror, total_error) + + f_ptr = C_LOC(exists1) + CALL H5Aexists_async_f(file_id, TRIM(attr_name)//"00", f_ptr, es_id, hdferror) + CALL check("H5Aexists_async_f",hdferror, total_error) + + f_ptr = C_LOC(exists2) + CALL H5Aexists_by_name_async_f(file_id, "/", attr_name, f_ptr, es_id, hdferror) + CALL check("H5Aexists_by_name_async_f",hdferror, total_error) + + f_ptr = C_LOC(exists3) + CALL H5Aexists_by_name_async_f(file_id, "/", TRIM(attr_name)//"00", f_ptr, es_id, hdferror) + CALL check("H5Aexists_by_name_async_f",hdferror, total_error) + + CALL H5Aopen_async_f(file_id, attr_name, attr_id0, es_id, hdferror) + CALL check("H5Aopen_async_f", hdferror, total_error) + + f_ptr = C_LOC(attr_rdata0) + CALL H5Aread_async_f(attr_id0, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Aread_async_f", hdferror, total_error) + + CALL H5Aclose_async_f(attr_id0, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL H5Aopen_by_name_async_f(file_id, "/", TRIM(attr_name)//"00", attr_id1, es_id, hdferror) + CALL check("H5Aopen_by_name_async_f", hdferror, total_error) + + f_ptr = C_LOC(attr_rdata1) + CALL H5Aread_async_f(attr_id1, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Aread_async_f", hdferror, total_error) + + CALL H5Aclose_async_f(attr_id1, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL H5Aopen_by_idx_async_f(file_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(2,HSIZE_T), attr_id2, es_id, hdferror) + CALL check("H5Aopen_by_idx_async_f", hdferror, total_error) + + f_ptr = C_LOC(attr_rdata2) + CALL H5Aread_async_f(attr_id2, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Aread_async_f", hdferror, total_error) + + CALL H5Aclose_async_f(attr_id2, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL H5Arename_async_f(file_id, TRIM(attr_name)//"00", TRIM(attr_name)//"05", es_id, hdferror) + CALL check("H5Arename_async_f",hdferror,total_error) + + CALL H5Arename_by_name_async_f(file_id, ".", TRIM(attr_name)//"01", TRIM(attr_name)//"06", es_id, hdferror) + CALL check("H5Arename_by_name_async_f",hdferror,total_error) + + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("H5Fclose_async_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + CALL VERIFY("H5Aexists_async_f", LOGICAL(exists0), .TRUE., total_error) + CALL VERIFY("H5Aexists_async_f", LOGICAL(exists1), .TRUE., total_error) + CALL VERIFY("H5Aexists_by_name_async_f", LOGICAL(exists2), .TRUE., total_error) + CALL VERIFY("H5Aexists_by_name_async_f", LOGICAL(exists3), .TRUE., total_error) + + CALL VERIFY("H5Aread_async_f", attr_rdata0, attr_data0, total_error) + CALL VERIFY("H5Aread_async_f", attr_rdata1, attr_data1, total_error) + CALL VERIFY("H5Aread_async_f", attr_rdata2, attr_data2, total_error) + + CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_f",hdferror, total_error) + + CALL H5Aexists_f(file_id, TRIM(attr_name)//"05", exists, hdferror) + CALL check("H5Aexist_f",hdferror, total_error) + CALL VERIFY("H5Arename_async_f", exists, .TRUE., total_error) + + CALL H5Aexists_f(file_id, TRIM(attr_name)//"06", exists, hdferror) + CALL check("H5Aexist_f",hdferror, total_error) + CALL VERIFY("H5Arename_by_name_async_f", exists, .TRUE., total_error) + + CALL H5Aexists_f(file_id, TRIM(attr_name)//"01", exists, hdferror) + CALL check("H5Aexist_f",hdferror, total_error) + CALL VERIFY("H5Arename_async_f", exists, .FALSE., total_error) + + CALL H5Aexists_f(file_id, TRIM(attr_name)//"02", exists, hdferror) + CALL check("H5Aexist_f",hdferror, total_error) + CALL VERIFY("H5Arename_by_name_async_f", exists, .FALSE., total_error) + + CALL H5Fclose_f(file_id, hdferror) + CALL check("H5Fclose_f",hdferror,total_error) + + CALL H5Pclose_f(fapl_id, hdferror) + CALL check(" H5Pclose_f",hdferror, total_error) + + CALL H5ESclose_f(es_id, hdferror) + CALL check("H5ESclose_f", hdferror, total_error) + + END SUBROUTINE H5A_async_tests + + SUBROUTINE H5D_async_tests(cleanup, total_error) + ! + ! Test H5D async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5d_tests.h5" + INTEGER :: hdferror + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + CHARACTER(LEN=8), PARAMETER :: dsetname = "IntArray" + INTEGER(HID_T) :: crp_list ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + + INTEGER(HID_T) :: filespace ! Dataspace identifier in file + INTEGER(HID_T) :: memspace ! Dataspace identifier in memory + INTEGER(HID_T) :: xfer_prp ! Property list identifier + TYPE(C_PTR) :: f_ptr + + INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/4/) + INTEGER(HSIZE_T), DIMENSION(1) :: dimsf + + INTEGER(HSIZE_T), DIMENSION(1) :: count + INTEGER(HSSIZE_T), DIMENSION(1) :: offset + INTEGER, ALLOCATABLE, DIMENSION(:), TARGET :: idata + INTEGER, ALLOCATABLE, DIMENSION(:), TARGET :: rdata + INTEGER(HSIZE_T), DIMENSION(1) :: idims, imaxdims + INTEGER(HSIZE_T), DIMENSION(1) :: maxdims + INTEGER(HSIZE_T) :: i + INTEGER(HSIZE_T), DIMENSION(1) :: extend_dim + INTEGER, TARGET :: fillvalue = 99 + + INTEGER :: error ! Error flags + INTEGER :: mpierror ! MPI error flag + INTEGER :: comm, info + INTEGER :: mpi_size, mpi_rank + + comm = MPI_COMM_WORLD + info = MPI_INFO_NULL + + CALL MPI_COMM_SIZE(comm, mpi_size, mpierror) + CALL MPI_COMM_RANK(comm, mpi_rank, mpierror) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + ! + ! Create the file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, total_error) + + CALL h5fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, error, access_prp = fapl_id ) + CALL check("h5fcreate_f",hdferror, total_error) + + dimsf(1) = dims(1)*mpi_size + ALLOCATE(idata(1:dims(1))) + + idata(:) = mpi_rank + + CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, hdferror) + CALL h5pset_chunk_f(crp_list, 1, dims, error) + f_ptr = C_LOC(fillvalue) + CALL h5pset_fill_value_f(crp_list, H5T_NATIVE_INTEGER, f_ptr, hdferror) + + ! + ! Create data space for the dataset. + ! + maxdims(1) = H5S_UNLIMITED_F + CALL h5screate_simple_f(1, dimsf, filespace, hdferror, maxdims) + CALL check("h5screate_simple_f", hdferror, total_error) + + ! + ! create contiguous dataset in the file. + CALL h5dcreate_async_f(file_id, dsetname, H5T_NATIVE_INTEGER, filespace, & + dset_id, es_id, hdferror, crp_list) + CALL check("h5dcreate_async_f", hdferror, total_error) + + COUNT(1) = dims(1) + offset(1) = mpi_rank * COUNT(1) + CALL h5screate_simple_f(1, dims(1), memspace, hdferror) + CALL check("h5screate_simple_f", hdferror, total_error) + + CALL h5sselect_hyperslab_f (filespace, H5S_SELECT_SET_F, offset, count, hdferror) + CALL check("h5sselect_hyperslab_f", hdferror, total_error) + + CALL h5pcreate_f(H5P_DATASET_XFER_F, xfer_prp, error) + CALL h5pset_dxpl_mpio_f(xfer_prp, H5FD_MPIO_COLLECTIVE_F, error) + + ! + ! Write data to the dataset + ! + f_ptr = C_LOC(idata) + CALL h5dwrite_async_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror, & + mem_space_id = memspace, file_space_id = filespace, xfer_prp = xfer_prp) + CALL check("h5dwrite_async_f", hdferror, total_error) + ! + ! Terminate access to the dataset. + ! + CALL h5dclose_async_f(dset_id, es_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + ! Close dataspaces. + ! + CALL h5sclose_f(filespace, hdferror) + CALL check("h5sclose_f",hdferror,total_error) + CALL h5sclose_f(memspace, error) + CALL check("h5sclose_f",hdferror,total_error) + CALL h5pclose_f(crp_list, hdferror) + CALL check("h5pclose_f",hdferror,total_error) + + ! + ! Close the file. + ! + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + ! Complete the operations + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + CALL VERIFY("H5ESwait_f", num_in_progress, 0_size_t , total_error) + + CALL h5fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id) + CALL check("h5fopen_async_f",hdferror,total_error) + + CALL h5dopen_async_f(file_id, dsetname, dset_id, es_id, hdferror) + CALL check("h5dopen_async_f",hdferror,total_error) + + CALL H5Dget_space_async_f(dset_id, filespace, es_id, hdferror) + CALL check("h5dopen_async_f",hdferror,total_error) + + CALL h5sget_simple_extent_dims_f(filespace, idims, imaxdims, hdferror) + CALL check("h5sget_simple_extent_dims_f", hdferror, total_error) + CALL VERIFY("h5sget_simple_extent_dims_f", idims(1), dimsf(1), total_error) + CALL VERIFY("h5sget_simple_extent_dims_f", imaxdims(1), H5S_UNLIMITED_F, total_error) + + ! Check reading the data back + ALLOCATE(rdata(1:dims(1))) + + CALL h5screate_simple_f(1, dims(1), memspace, hdferror) + CALL check("h5screate_simple_f", hdferror, total_error) + + CALL h5sselect_hyperslab_f (filespace, H5S_SELECT_SET_F, offset, count, hdferror) + CALL check("h5sselect_hyperslab_f", hdferror, total_error) + + f_ptr = C_LOC(rdata) + CALL h5dread_async_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror, & + mem_space_id = memspace, file_space_id = filespace, xfer_prp = xfer_prp) + CALL check("h5dread_async_f", hdferror, total_error) + + CALL h5sclose_f(filespace, hdferror) + CALL check("h5sclose_f",hdferror,total_error) + + CALL h5sclose_f(memspace, hdferror) + CALL check("h5sclose_f",hdferror,total_error) + + ! Extend the dataset + extend_dim(1) = dimsf(1)*2 + CALL H5Dset_extent_async_f(dset_id, extend_dim, es_id, hdferror) + CALL check("H5Dset_extent_async_f", error, total_error) + + CALL h5dclose_async_f(dset_id, es_id, error) + CALL check("h5dclose_async_f",error,total_error) + + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + ! Verify the data read + DO i = 1, dims(1) + CALL VERIFY("h5dread_f", idata(i), rdata(i), total_error) + ENDDO + + CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_f",error,total_error) + + CALL h5dopen_f(file_id, dsetname, dset_id, hdferror) + CALL check("h5dopen_async_f",hdferror,total_error) + + CALL H5Dget_space_f(dset_id, filespace, hdferror) + CALL check("h5dopen_async_f",hdferror,total_error) + + CALL H5Sget_simple_extent_dims_f(filespace, idims, imaxdims, hdferror) + CALL check("h5sget_simple_extent_dims_f", hdferror, total_error) + CALL VERIFY("h5sget_simple_extent_dims_f", idims(1), extend_dim(1), total_error) + CALL VERIFY("h5sget_simple_extent_dims_f", imaxdims(1), H5S_UNLIMITED_F, total_error) + + CALL h5sclose_f(filespace, hdferror) + CALL check("h5sclose_f",hdferror,total_error) + + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + CALL h5fclose_f(file_id, hdferror) + CALL check("h5fclose_f",hdferror,total_error) + + END SUBROUTINE H5D_async_tests + + + SUBROUTINE H5G_async_tests(cleanup, total_error) + ! + ! Test H5G async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5g_tests.h5" + INTEGER :: hdferror + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + CHARACTER(LEN=6), PARAMETER:: grpname="group1" + + INTEGER(HID_T) :: group_id, group_id1 + INTEGER(HID_T) :: gcpl_id + CHARACTER(LEN=2) :: chr2 + CHARACTER(LEN=7) :: objname ! Object name + INTEGER :: v, i + + TYPE(H5G_info_t), DIMENSION(1:3) :: ginfo + + INTEGER :: error + INTEGER :: mpierror ! MPI error flag + INTEGER :: comm, info + INTEGER :: mpi_size, mpi_rank + + comm = MPI_COMM_WORLD + info = MPI_INFO_NULL + + CALL MPI_COMM_SIZE(comm, mpi_size, mpierror) + CALL MPI_COMM_RANK(comm, mpi_rank, mpierror) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + ! + ! Create the file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, total_error) + + CALL h5fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, error, access_prp = fapl_id ) + CALL check("h5fcreate_f",hdferror, total_error) + + ! Test group API + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, hdferror ) + CALL check("H5Pcreate_f", hdferror, total_error) + + CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), hdferror) + CALL check("H5Pset_link_creation_order_f", hdferror, total_error) + + CALL H5Gcreate_async_f (file_id, grpname, group_id, es_id, hdferror, gcpl_id=gcpl_id) + CALL check("H5Gcreate_async_f", hdferror, total_error) + + ! Create objects in new group created + DO v = 0, 2 + ! Make name for link + WRITE(chr2,'(I2.2)') v + objname = 'fill '//chr2 + + ! Create hard link, with group object + CALL H5Gcreate_async_f(group_id, objname, group_id1, es_id, hdferror, gcpl_id=gcpl_id) + CALL check("H5Gcreate_async_f", hdferror, total_error) + + ! Close group created + CALL H5Gclose_async_f(group_id1, es_id, hdferror) + CALL check("H5Gclose_async_f", hdferror, total_error) + ENDDO + + CALL H5Pclose_f(gcpl_id, hdferror) + CALL check("H5Pclose_f", hdferror, total_error) + + CALL H5Gclose_async_f(group_id, es_id, hdferror) + CALL check("H5Gclose_async_f", hdferror, total_error) + + ! + ! Close the file. + ! + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + ! Complete the operations + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + CALL VERIFY("H5ESwait_f", num_in_progress, 0_size_t , total_error) + + CALL h5fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_async_f",hdferror,total_error) + + CALL h5gopen_async_f(file_id, grpname, group_id, es_id, hdferror) + CALL check("h5gopen_async_f",hdferror,total_error) + + CALL h5gget_info_async_f(group_id, ginfo(1), es_id, hdferror) + CALL check("H5Gget_info_async_f", hdferror, total_error) + + CALL H5Gget_info_by_name_async_f(group_id, ".", ginfo(2), es_id, hdferror) + CALL check("H5Gget_info_by_name_async_f", hdferror, total_error) + + CALL H5Gget_info_by_idx_async_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, & + INT(0,HSIZE_T), ginfo(3), es_id, error) + CALL check("H5Gget_info_by_idx_async_f", hdferror, total_error) + + CALL H5Gclose_async_f(group_id, es_id, hdferror) + CALL check("H5Gclose_async_f", hdferror, total_error) + + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + ! Verify the group APIs + DO i = 1, 2 + CALL VERIFY("H5Gget_info_by_name_f.storage_type", & + ginfo(i)%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL VERIFY("H5Gget_info_by_name_f.max_corder", ginfo(i)%max_corder, 3_C_INT64_T, total_error) + CALL VERIFY("H5Gget_info_by_name_f.nlinks", ginfo(i)%nlinks, 3_HSIZE_T, total_error) + CALL VERIFY("H5Gget_info_f.mounted", LOGICAL(ginfo(i)%mounted),.FALSE.,total_error) + ENDDO + CALL VERIFY("H5Gget_info_by_name_f.storage_type", & + ginfo(3)%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL VERIFY("H5Gget_info_by_name_f.max_corder", ginfo(3)%max_corder, 0_C_INT64_T, total_error) + CALL VERIFY("H5Gget_info_by_name_f.nlinks", ginfo(3)%nlinks, 0_HSIZE_T, total_error) + CALL VERIFY("H5Gget_info_f.mounted", LOGICAL(ginfo(3)%mounted),.FALSE.,total_error) + + END SUBROUTINE H5G_async_tests + + SUBROUTINE H5F_async_tests(cleanup, total_error) + ! + ! Test H5F async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5f_tests.h5" + INTEGER :: hdferror + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + INTEGER(HID_T) :: ret_file_id + + INTEGER :: error ! Error flags + INTEGER :: mpierror ! MPI error flag + INTEGER :: comm, info + INTEGER :: mpi_size, mpi_rank + + comm = MPI_COMM_WORLD + info = MPI_INFO_NULL + + CALL MPI_COMM_SIZE(comm, mpi_size, mpierror) + CALL MPI_COMM_RANK(comm, mpi_rank, mpierror) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + ! + ! Create the file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, total_error) + + CALL h5fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, error, access_prp = fapl_id ) + CALL check("h5fcreate_f",hdferror, total_error) + + ! + ! Close the file. + ! + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + ! Complete the operations + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + CALL VERIFY("H5ESwait_f", num_in_progress, 0_size_t , total_error) + + CALL H5Fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_async_f",hdferror,total_error) + + CALL H5Freopen_async_f(file_id, ret_file_id, es_id, hdferror) + CALL check("H5Freopen_async_f", hdferror, total_error) + + CALL H5Fclose_async_f(ret_file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + CALL H5Fflush_async_f(file_id, H5F_SCOPE_GLOBAL_F, es_id, hdferror) + CALL check("h5fflush_async_f",hdferror, total_error) + + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + END SUBROUTINE H5F_async_tests + + SUBROUTINE H5L_async_tests(cleanup, total_error) + ! + ! Test H5L async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5l_tests.h5" + INTEGER :: hdferror + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + INTEGER(hid_t) :: gid = -1, gid2 = -1, gid3 = -1 ! Group IDs + INTEGER(hid_t) :: aid = -1, aid2 = -1, aid3 = -1 ! Attribute ID + INTEGER(hid_t) :: sid = -1 ! Dataspace ID + CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group" + CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME2 = "corder_grp00" + LOGICAL(C_BOOL), TARGET :: exists1, exists2 + LOGICAL :: exists + TYPE(C_PTR) :: f_ptr + + INTEGER(HID_T) :: group_id ! Group ID + INTEGER(HID_T) :: gcpl_id ! Group creation property list ID + + INTEGER :: idx_type ! Type of index to operate on + LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) + ! Use index on creation order values + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" + + CHARACTER(LEN=7) :: objname ! Object name + + INTEGER :: u ! Local index variable + INTEGER :: Input1, i + INTEGER(HID_T) :: group_id2 + INTEGER :: iorder ! Order within in the index + CHARACTER(LEN=2) :: chr2 + ! + INTEGER(hsize_t) idx ! Index in the group + TYPE(iter_info), TARGET :: info + TYPE(C_FUNPTR) :: f1 + TYPE(C_PTR) :: f2 + INTEGER(C_INT) :: ret_value + + INTEGER :: error ! Error flags + INTEGER :: mpierror ! MPI error flag + INTEGER :: comm + INTEGER :: mpi_size, mpi_rank + + INTEGER(SIZE_T) :: count + + comm = MPI_COMM_WORLD + + CALL MPI_COMM_SIZE(comm, mpi_size, mpierror) + CALL MPI_COMM_RANK(comm, mpi_rank, mpierror) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + ! + ! Create the file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, total_error) + + CALL h5fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, error, access_prp = fapl_id ) + CALL check("h5fcreate_f",hdferror, total_error) + + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, hdferror ) + CALL check("H5Pcreate_f", hdferror, total_error) + + CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), hdferror) + CALL check("H5Pset_link_creation_order_f", hdferror, total_error) + + ! Create group with creation order tracking on + CALL H5Gcreate_async_f(file_id, CORDER_GROUP_NAME, gid3, es_id, hdferror, gcpl_id=gcpl_id) + CALL check("H5Gcreate_f", hdferror, total_error) + + ! Create group + CALL H5Gcreate_async_f(file_id, "/Group1", gid, es_id, hdferror) + CALL check("H5Gcreate_async_f",hdferror, total_error) + + ! Create nested group + CALL H5Gcreate_async_f(gid, "Group2", gid2, es_id, hdferror) + CALL check("H5Gcreate_async_f",hdferror, total_error) + + CALL H5Screate_f(H5S_SCALAR_F, sid, hdferror) + CALL check("H5Screate_f",hdferror, total_error) + CALL H5Acreate_async_f(gid2, "Attr1", H5T_NATIVE_INTEGER, sid, aid, es_id, hdferror) + CALL check("H5Acreate_async_f",hdferror, total_error) + CALL H5Acreate_async_f(gid2, "Attr2", H5T_NATIVE_INTEGER, sid, aid2, es_id, hdferror) + CALL check("H5Acreate_async_f",hdferror, total_error) + CALL H5Acreate_async_f(gid2, "Attr3", H5T_NATIVE_INTEGER, sid, aid3, es_id, hdferror) + CALL check("H5Acreate_async_f",hdferror, total_error) + CALL H5Aclose_async_f(aid, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror, total_error) + CALL H5Aclose_async_f(aid2, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror, total_error) + CALL H5Aclose_async_f(aid3, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror, total_error) + CALL H5Sclose_f(sid,hdferror) + CALL check("H5Sclose_f",hdferror, total_error) + + ! Close groups + CALL h5gclose_async_f(gid2, es_id, hdferror) + CALL check("h5gclose_async_f",hdferror, total_error) + CALL h5gclose_async_f(gid, es_id, hdferror) + CALL check("h5gclose_async_f",hdferror, total_error) + CALL h5gclose_async_f(gid3, es_id, hdferror) + CALL check("h5gclose_async_f",hdferror, total_error) + + ! Close the group creation property list + CALL H5Pclose_f(gcpl_id, hdferror) + CALL check("H5Pclose_f", hdferror, total_error) + + ! Create soft links to groups created + CALL H5Lcreate_soft_async_f("/Group1", file_id, "/soft_one", es_id, hdferror) + CALL H5Lcreate_soft_async_f("/Group1/Group2", file_id, "/soft_two", es_id, hdferror) + + ! Create hard links to all groups + CALL H5Lcreate_hard_async_f(file_id, "/", file_id, "hard_zero", es_id, hdferror) + CALL check("H5Lcreate_hard_async_f",hdferror, total_error) + CALL H5Lcreate_hard_async_f(file_id, "/Group1", file_id, "hard_one", es_id, hdferror) + CALL check("H5Lcreate_hard_async_f",hdferror, total_error) + CALL H5Lcreate_hard_async_f(file_id, "/Group1/Group2", file_id, "hard_two", es_id, hdferror) + CALL check("H5Lcreate_hard_async_f",hdferror, total_error) + + ! + ! Close the file. + ! + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + ! Complete the operations + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + CALL VERIFY("H5ESwait_f", num_in_progress, 0_size_t , total_error) + + CALL H5Fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_async_f",hdferror,total_error) + + exists1 = .FALSE. + f_ptr = C_LOC(exists1) + CALL H5Lexists_async_f(file_id, "hard_zero", f_ptr, es_id, hdferror) + CALL check("H5Lexists_async_f",hdferror,total_error) + + exists2 = .FALSE. + f_ptr = C_LOC(exists2) + CALL H5Lexists_async_f(file_id, "hard_two", f_ptr, es_id, hdferror) + CALL check("H5Lexists_async_f",hdferror,total_error) + + CALL H5Ldelete_async_f(file_id, "hard_two", es_id, hdferror) + CALL check("H5Ldelete_async_f",hdferror,total_error) + + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + CALL VERIFY("H5Lexists_async_f", LOGICAL(exists1), .TRUE., total_error) + CALL VERIFY("H5Lexists_async_f", LOGICAL(exists2), .TRUE., total_error) + + CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_f",hdferror, total_error) + + ! Verify the link was deleted + CALL H5Lexists_f(file_id, "hard_two", exists, hdferror) + CALL check("H5Lexist_f",hdferror, total_error) + CALL VERIFY("H5Ldelete_async_f", exists, .FALSE., total_error) + + CALL H5Fclose_f(file_id, hdferror) + CALL check("H5Fclose_f", hdferror,total_error) + + ! Loop over operating on different indices on link fields + DO idx_type = H5_INDEX_NAME_F, H5_INDEX_CRT_ORDER_F + ! Loop over operating in different orders + DO iorder = H5_ITER_INC_F, H5_ITER_DEC_F + ! Loop over using index for creation order value + DO i = 1, 2 + ! Create file + CALL H5Fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, hdferror, access_prp=fapl_id) + CALL check("H5Fcreate_async_f", hdferror, total_error) + + ! Create group creation property list + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, hdferror ) + CALL check("H5Pcreate_f", hdferror, total_error) + + ! Set creation order tracking & indexing on group + IF(use_index(i))THEN + Input1 = H5P_CRT_ORDER_INDEXED_F + ELSE + Input1 = 0 + ENDIF + + CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), hdferror) + CALL check("H5Pset_link_creation_order_f", hdferror, total_error) + + ! Create group with creation order tracking on + CALL H5Gcreate_async_f(file_id, CORDER_GROUP_NAME2, group_id, es_id, hdferror, gcpl_id=gcpl_id) + CALL check("H5Gcreate_async_f", hdferror, total_error) + + ! Query the group creation properties + CALL H5Pget_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferror) + CALL check("H5Pget_link_phase_change_f", hdferror, total_error) + + ! Create several links, up to limit of compact form + DO u = 0, max_compact-1 + ! Make name for link + WRITE(chr2,'(I2.2)') u + objname = 'fill '//chr2 + + ! Create hard link, with group object + CALL H5Gcreate_async_f(group_id, objname, group_id2, es_id, hdferror) + CALL check("H5Gcreate_async_f", hdferror, total_error) + CALL H5Gclose_async_f(group_id2, es_id, hdferror) + CALL check("H5Gclose_async_f", hdferror, total_error) + ENDDO + + ! Delete links from compact group + DO u = 0, (max_compact - 1) -1 + ! Delete first link in appropriate order + CALL H5Ldelete_by_idx_async_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), es_id, hdferror) + CALL check("H5Ldelete_by_idx_async_f", hdferror, total_error) + ENDDO + + idx = 0 + info%command = 2 + f1 = C_FUNLOC(liter_cb) + f2 = C_LOC(info) + + CALL H5Literate_async_f(file_id, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, es_id, hdferror) + CALL check("H5Literate_async_f", error, total_error) + + ! Close the group + CALL H5Gclose_async_f(group_id, es_id, hdferror) + CALL check("H5Gclose_async_f", hdferror, total_error) + ! Close the group creation property list + CALL H5Pclose_f(gcpl_id, hdferror) + CALL check("H5Pclose_f", hdferror, total_error) + ! Close the file + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("H5Fclose_async_f", hdferror, total_error) + + CALL H5ESget_count_f(es_id, count, hdferror) + + ! Complete the operations + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + CALL VERIFY("H5ESwait_f", num_in_progress, 0_size_t , total_error) + + ! NOTE: ret_value will not be correct since H5Literate_async is not returning a pointer return value, herr_t. + CALL VERIFY("H5Literate_async_f", info%type, op_data_type, total_error) + CALL VERIFY("H5Literate_async_f", info%command, op_data_command, total_error) + CALL VERIFY("H5Literate_async_f", info%name(1)(1:1), CORDER_GROUP_NAME2(1:1), total_error) + + ENDDO + ENDDO + + ENDDO + + CALL H5Pclose_f(fapl_id, hdferror) + CALL check(" H5Pclose_f",hdferror, total_error) + + CALL H5ESclose_f(es_id, hdferror) + CALL check("H5ESclose_f", hdferror, total_error) + + + END SUBROUTINE H5L_async_tests + + SUBROUTINE H5O_async_tests(cleanup, total_error) + ! + ! Test H5O async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T) :: file_id + INTEGER(HID_T) :: group_id, group_id1, group_id2, group_id3 + INTEGER(HID_T) :: space_id + INTEGER(HID_T) :: attr_id + INTEGER(HID_T) :: dset_id + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: lcpl_id + INTEGER(HID_T) :: ocpypl_id + TYPE(C_H5O_INFO_T), TARGET :: oinfo_f + TYPE(C_PTR) :: f_ptr + CHARACTER(len=80) :: filename = "h5o_tests.h5" + + INTEGER :: hdferror ! Value returned from API calls + + ! Data for tested h5ocopy_async_f + CHARACTER(LEN=3) , PARAMETER :: dataset = "DS1" + INTEGER , PARAMETER :: dim0 = 4 + + INTEGER(HSIZE_T), DIMENSION(1:1) :: dims2 = (/dim0/) ! size read/write buffer + INTEGER(C_INT), DIMENSION(1:8) :: atime, btime, ctime, mtime + + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + ! Make a FAPL that uses the "use the latest version of the format" bounds + CALL H5Pcreate_f(H5P_FILE_ACCESS_F,fapl_id,hdferror) + CALL check("h5Pcreate_f",hdferror,total_error) + + ! Set the "use the latest version of the format" bounds for creating objects in the file + CALL H5Pset_libver_bounds_f(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, hdferror) + CALL check("H5Pset_libver_bounds_f",hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + + ! Create a new HDF5 file + CALL H5Fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, hdferror, H5P_DEFAULT_F, fapl_id) + CALL check("H5Fcreate_f", hdferror, total_error) + + ! Close the FAPL + CALL h5pclose_f(fapl_id, hdferror) + CALL check("h5pclose_f",hdferror,total_error) + + ! + ! Create dataspace. Setting size to be the current size. + ! + CALL h5screate_simple_f(1, dims2, space_id, hdferror) + CALL check("h5screate_simple_f", hdferror, total_error) + ! + ! Create intermediate groups + ! + CALL h5gcreate_async_f(file_id,"/G1",group_id1,es_id,hdferror) + CALL check("h5gcreate_f", hdferror, total_error) + CALL h5gcreate_async_f(file_id,"/G1/G2",group_id2,es_id,hdferror) + CALL check("h5gcreate_f", hdferror, total_error) + CALL h5gcreate_async_f(file_id,"/G1/G2/G3",group_id3,es_id,hdferror) + CALL check("h5gcreate_f", hdferror, total_error) + + ! + ! Create the dataset + ! + CALL h5dcreate_async_f(group_id3, dataset, H5T_STD_I32LE, space_id, dset_id, es_id, hdferror) + CALL check("h5dcreate_f", hdferror, total_error) + + ! Create a soft link to /G1 + CALL h5lcreate_soft_async_f("/G1", file_id, "/G1_LINK", es_id, hdferror) + CALL check("h5lcreate_soft_f", hdferror, total_error) + + ! Create a soft link to /G1000, does not exist + CALL h5lcreate_soft_async_f("/G1000", file_id, "/G1_FALSE", es_id, hdferror) + CALL check("h5lcreate_soft_f", hdferror, total_error) + + ! Create a soft link to /G1_LINK + CALL h5lcreate_soft_async_f("/G1_FALSE", file_id, "/G2_FALSE", es_id, hdferror) + CALL check("h5lcreate_soft_f", hdferror, total_error) + ! + ! Close and release resources. + ! + CALL h5dclose_async_f(dset_id, es_id, hdferror) + CALL check(" h5dclose_f", hdferror, total_error) + CALL h5sclose_f(space_id, hdferror) + CALL check("h5sclose_f", hdferror, total_error) + CALL h5gclose_async_f(group_id1, es_id, hdferror) + CALL check("h5gclose_async_f", hdferror, total_error) + CALL h5gclose_async_f(group_id2, es_id, hdferror) + CALL check("h5gclose_async_f", hdferror, total_error) + CALL h5gclose_async_f(group_id3, es_id, hdferror) + CALL check("h5gclose_async_f", hdferror, total_error) + + ! Test opening an object by index + CALL h5oopen_by_idx_async_f(file_id, "/G1/G2/G3", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, group_id, es_id, hdferror) + CALL check("h5oopen_by_idx_f", hdferror, total_error) + + CALL h5oclose_async_f(group_id, es_id, hdferror) + CALL check("h5gclose_f", hdferror, total_error) + + ! Test opening an object + CALL h5oopen_async_f(file_id, "/G1/G2/G3", group_id, es_id, hdferror) + CALL check("h5oopen_by_idx_f", hdferror, total_error) + + CALL H5Screate_f(H5S_SCALAR_F, space_id, hdferror) + CALL check("H5Screate_f", hdferror, total_error) + + CALL h5acreate_async_f(group_id, "ATTR", H5T_NATIVE_INTEGER, space_id, attr_id, es_id, hdferror) + CALL check("h5acreate_f",hdferror,total_error) + + CALL H5Aclose_async_f(attr_id, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL h5oclose_async_f(group_id, es_id, hdferror) + CALL check("h5gclose_f", hdferror, total_error) + + f_ptr = C_LOC(oinfo_f) + CALL H5Oget_info_by_name_async_f(file_id, "/G1/G2/G3", f_ptr, es_id, hdferror, fields=H5O_INFO_ALL_F) + CALL check("H5Oget_info_by_name_async_f", hdferror, total_error) + ! + ! create property to pass copy options + ! + CALL h5pcreate_f(H5P_LINK_CREATE_F, lcpl_id, hdferror) + CALL check("h5Pcreate_f", hdferror, total_error) + + CALL h5pset_create_inter_group_f(lcpl_id, 1, hdferror) + CALL check("H5Pset_create_inter_group_f", hdferror, total_error) + ! + ! Check optional parameter lcpl_id, this would fail if lcpl_id was not specified + ! + CALL h5ocopy_async_f(file_id, "/G1/G2/G3/DS1", file_id, "/G1/G_cp1/DS2", es_id, hdferror, lcpl_id=lcpl_id) + CALL check("h5ocopy_f -- W/ OPTION: lcpl_id", hdferror ,total_error) + + CALL h5pclose_f(lcpl_id, hdferror) + CALL check("h5pclose_f",hdferror,total_error) + + CALL h5pcreate_f(H5P_OBJECT_COPY_F, ocpypl_id, hdferror) + CALL check("h5Pcreate_f",hdferror,total_error) + + CALL h5pset_copy_object_f(ocpypl_id, H5O_COPY_SHALLOW_HIERARCHY_F, hdferror) + CALL check("H5Pset_copy_object_f",hdferror,total_error) + + CALL h5ocopy_async_f(file_id, "/G1/G2", file_id, "/G1/G_cp2", es_id, hdferror, ocpypl_id=ocpypl_id) + CALL check("h5ocopy_f",hdferror,total_error) + + CALL h5pclose_f(ocpypl_id, hdferror) + CALL check("h5pclose_f",hdferror,total_error) + + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + IF( oinfo_f%fileno.LE.0 )THEN + hdferror = -1 + CALL check("H5Oget_info_by_name_async_f", hdferror, total_error) + ENDIF + + atime(1:8) = h5gmtime(oinfo_f%atime) + btime(1:8) = h5gmtime(oinfo_f%btime) + ctime(1:8) = h5gmtime(oinfo_f%ctime) + mtime(1:8) = h5gmtime(oinfo_f%mtime) + + IF( atime(1) .LT. 2021 .OR. & + btime(1).LT. 2021 .OR. & + ctime(1) .LT. 2021 .OR. & + mtime(1) .LT. 2021 )THEN + hdferror = -1 + ENDIF + CALL check("H5Oget_info_by_name_async_f", hdferror, total_error) + + CALL VERIFY("H5Oget_info_by_name_async_f", oinfo_f%num_attrs, 1_HSIZE_T, total_error) + CALL VERIFY("H5Oget_info_by_name_async_f", oinfo_f%type, INT(H5G_GROUP_F, C_INT), total_error) + + CALL H5ESclose_f(es_id, hdferror) + CALL check("H5ESclose_f", hdferror, total_error) + + END SUBROUTINE H5O_async_tests + +END MODULE test_async_APIs + +! +! The main program for async HDF5 Fortran tests +! +PROGRAM async_test + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_INT64_T + USE HDF5 + USE MPI + USE TH5_MISC + USE TH5_MISC_GEN + USE test_async_APIs + + IMPLICIT NONE + + INTEGER :: total_error = 0 ! sum of the number of errors + INTEGER :: mpierror ! MPI hdferror flag + INTEGER :: mpi_size ! number of processes in the group of communicator + INTEGER :: mpi_rank ! rank of the calling process in the communicator + INTEGER :: required, provided + + INTEGER(HID_T) :: vol_id + INTEGER :: hdferror + LOGICAL :: registered + INTEGER :: sum + INTEGER :: nerrors = 0 + + LOGICAL :: cleanup + INTEGER :: ret_total_error = 0 + + ! + ! initialize MPI + ! + required = MPI_THREAD_MULTIPLE + CALL mpi_init_thread(required, provided, mpierror) + IF (mpierror .NE. MPI_SUCCESS) THEN + WRITE(*,*) "MPI_INIT_THREAD *FAILED*" + nerrors = nerrors + 1 + ENDIF + IF (provided .NE. required) THEN + mpi_thread_mult = .FALSE. + ENDIF + + CALL mpi_comm_rank( MPI_COMM_WORLD, mpi_rank, mpierror ) + IF (mpierror .NE. MPI_SUCCESS) THEN + WRITE(*,*) "MPI_COMM_RANK *FAILED* Process = ", mpi_rank + nerrors = nerrors + 1 + ENDIF + CALL mpi_comm_size( MPI_COMM_WORLD, mpi_size, mpierror ) + IF (mpierror .NE. MPI_SUCCESS) THEN + WRITE(*,*) "MPI_COMM_SIZE *FAILED* Process = ", mpi_rank + nerrors = nerrors + 1 + ENDIF + + IF(nerrors.NE.0)THEN + IF(mpi_rank==0) CALL write_test_status(sum, & + 'Testing Initializing mpi_init_thread', total_error) + CALL MPI_Barrier(MPI_COMM_WORLD, mpierror) + CALL mpi_abort(MPI_COMM_WORLD, 1, mpierror) + ENDIF + + IF(mpi_rank==0) CALL write_test_header("ASYNC FORTRAN TESTING") + + ! + ! Initialize the HDF5 fortran interface + ! + CALL h5open_f(hdferror) + + + ! CHECK ASYNC VOLS AVAILABILITY + ! + ! (1) Check if ASYNC VOL is available + CALL H5VLis_connector_registered_by_name_f("async", registered, hdferror) + CALL check("H5VLis_connector_registered_by_name_f", hdferror, total_error) + + IF(.NOT.registered)THEN + + ! (2) check if the DAOS VOL is available + CALL H5VLis_connector_registered_by_name_f("daos", registered, hdferror) + CALL check("H5VLis_connector_registered_by_name_f", hdferror, total_error) + + IF(.NOT.registered)THEN + ! No async compatible VOL found + async_enabled = .FALSE. + ELSE + CALL H5Vlregister_connector_by_name_f("daos", vol_id, hdferror) + CALL check("H5Vlregister_connector_by_name_f", hdferror, total_error) + ENDIF + + ELSE + CALL H5Vlregister_connector_by_name_f("async", vol_id, hdferror) + CALL check("H5Vlregister_connector_by_name_f", hdferror, total_error) + ENDIF + + IF ( (async_enabled .EQV. .TRUE.) .AND. (mpi_thread_mult .EQV. .FALSE.) ) THEN + total_error = -1 ! Skip test + IF(mpi_rank==0) CALL write_test_status(total_error, & + "No MPI_Init_thread support for MPI_THREAD_MULTIPLE", total_error) + CALL MPI_Barrier(MPI_COMM_WORLD, mpierror) + CALL MPI_Finalize(mpierror) + STOP + ENDIF + +! IF(total_error.LT.0)THEN +! IF(mpi_rank==0) CALL write_test_status(total_error, & +! 'Testing async APIs', total_error) +! STOP +! ENDIF + + ! H5ES API TESTING + ret_total_error = 0 + CALL H5ES_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5ES API tests', total_error) + + ! H5A ASYNC API TESTING + ret_total_error = 0 + CALL H5A_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5A async API tests', total_error) + + ! H5D ASYNC API TESTING + ret_total_error = 0 + CALL H5D_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5D async API tests', total_error) + + ! H5G ASYNC API TESTING + ret_total_error = 0 + CALL H5G_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5G async API tests', total_error) + + ! H5F ASYNC API TESTING + ret_total_error = 0 + CALL H5F_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5F async API tests', total_error) + + ! H5L ASYNC API TESTING + ret_total_error = 0 + CALL H5L_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5L async API tests', total_error) + + ! H5O ASYNC API TESTING + ret_total_error = 0 + CALL H5O_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5O async API tests', total_error) + + IF(async_enabled)THEN + CALL H5VLclose_f(vol_id, hdferror) + CALL check("H5VLclose_f", hdferror, total_error) + ENDIF + + ! + ! close HDF5 interface + ! + CALL h5close_f(hdferror) + + CALL MPI_ALLREDUCE(total_error, sum, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, mpierror) + + IF(mpi_rank==0) CALL write_test_footer() + + ! + ! close MPI + ! + IF (sum == 0) THEN + CALL mpi_finalize(mpierror) + IF (mpierror .NE. MPI_SUCCESS) THEN + WRITE(*,*) "MPI_FINALIZE *FAILED* Process = ", mpi_rank + ENDIF + ELSE + WRITE(*,*) 'Errors detected in process ', mpi_rank + CALL mpi_abort(MPI_COMM_WORLD, 1, mpierror) + IF (mpierror .NE. MPI_SUCCESS) THEN + WRITE(*,*) "MPI_ABORT *FAILED* Process = ", mpi_rank + ENDIF + ENDIF + + ! + ! end main program + ! + +END PROGRAM async_test diff --git a/fortran/testpar/ptest.F90 b/fortran/testpar/ptest.F90 index 2974933..b754e29 100644 --- a/fortran/testpar/ptest.F90 +++ b/fortran/testpar/ptest.F90 @@ -55,6 +55,9 @@ PROGRAM parallel_test ! initialize the HDF5 fortran interface ! CALL h5open_f(hdferror) + + IF(mpi_rank==0) CALL write_test_header("COMPREHENSIVE PARALLEL FORTRAN TESTS") + ! ! test write/read dataset by hyperslabs (contiguous/chunk) with independent/collective MPI I/O ! @@ -94,6 +97,8 @@ PROGRAM parallel_test CALL MPI_ALLREDUCE(total_error, sum, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, mpierror) + IF(mpi_rank==0) CALL write_test_footer() + ! ! close MPI ! diff --git a/fortran/testpar/subfiling.F90 b/fortran/testpar/subfiling.F90 index 18614b6..043ac6c 100644 --- a/fortran/testpar/subfiling.F90 +++ b/fortran/testpar/subfiling.F90 @@ -91,6 +91,8 @@ PROGRAM subfiling_test ! CALL h5open_f(hdferror) + IF(mpi_rank==0) CALL write_test_header("SUBFILING FORTRAN TESTING") + ! *********************************** ! Test H5Pset/get_mpi_params_f APIs ! *********************************** @@ -384,6 +386,9 @@ PROGRAM subfiling_test WRITE(*,*) "MPI_ABORT *FAILED* Process = ", mpi_rank ENDIF ENDIF + + IF(mpi_rank==0) CALL write_test_footer() + ! ! end main program ! @@ -392,8 +397,13 @@ PROGRAM subfiling_test CALL mpi_init(mpierror) CALL mpi_comm_rank(MPI_COMM_WORLD, mpi_rank, mpierror) - IF(mpi_rank==0) CALL write_test_status( -1, & - 'Subfiling not enabled', total_error) + + IF(mpi_rank==0) THEN + CALL write_test_header("SUBFILING FORTRAN TESTING") + CALL write_test_status( -1, 'Subfiling not enabled', total_error) + CALL write_test_footer() + ENDIF + CALL mpi_finalize(mpierror) #endif diff --git a/release_docs/RELEASE.txt b/release_docs/RELEASE.txt index 62ac8f2..4de0b94 100644 --- a/release_docs/RELEASE.txt +++ b/release_docs/RELEASE.txt @@ -99,8 +99,9 @@ New Features Fortran Library: ---------------- - - + - Added Fortran async APIs + H5A, H5D, H5ES, H5G, H5F, H5L and H5O async APIs were added. C++ Library: ------------ -- cgit v0.12