From 695efa94dfcd62c5ef42d03a7f1425c4105819df Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 22 Dec 2023 14:57:16 -0700 Subject: Added new H5G Fortran HDF5examples (#3908) * updated traverse example * added H5PAR success statement * skipping H5_f90_h5ex_g_traverse --- HDF5Examples/CMakeLists.txt | 1 + HDF5Examples/FORTRAN/H5G/CMakeLists.txt | 49 ++-- HDF5Examples/FORTRAN/H5G/Fortran_sourcefiles.cmake | 30 ++- HDF5Examples/FORTRAN/H5G/h5_version.h.in | 23 ++ HDF5Examples/FORTRAN/H5G/h5ex_g_intermediate.F90 | 130 +++++++++++ HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.F90 | 115 ++++++++++ HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.h5 | Bin 0 -> 2928 bytes HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.F90 | 249 +++++++++++++++++++++ HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.h5 | Bin 0 -> 6312 bytes HDF5Examples/FORTRAN/H5G/h5ex_g_visit.F90 | 158 +++++++++++++ HDF5Examples/FORTRAN/H5G/h5ex_g_visit.h5 | Bin 0 -> 6312 bytes .../H5G/tfiles/18/F03/h5ex_g_iterate_F03.tst | 5 - .../H5G/tfiles/18/F03/h5ex_g_traverse_F03.tst | 32 --- .../FORTRAN/H5G/tfiles/18/F03/h5ex_g_visit_F03.tst | 8 - .../FORTRAN/H5G/tfiles/18/h5ex_g_intermediate.tst | 5 + .../FORTRAN/H5G/tfiles/18/h5ex_g_iterate.tst | 5 + .../FORTRAN/H5G/tfiles/18/h5ex_g_iterate_F03.tst | 5 - .../FORTRAN/H5G/tfiles/18/h5ex_g_traverse.tst | 32 +++ .../FORTRAN/H5G/tfiles/18/h5ex_g_traverse_F03.tst | 32 --- .../FORTRAN/H5G/tfiles/18/h5ex_g_visit.tst | 19 ++ .../FORTRAN/H5G/tfiles/18/h5ex_g_visit_F03.tst | 8 - HDF5Examples/FORTRAN/H5PAR/CMakeLists.txt | 5 +- HDF5Examples/FORTRAN/H5PAR/ph5_f90_dataset.F90 | 1 + HDF5Examples/FORTRAN/H5PAR/ph5_f90_file_create.F90 | 2 +- .../FORTRAN/H5PAR/ph5_f90_hyperslab_by_chunk.F90 | 5 +- .../FORTRAN/H5PAR/ph5_f90_hyperslab_by_col.F90 | 2 +- .../FORTRAN/H5PAR/ph5_f90_hyperslab_by_pattern.F90 | 2 +- .../FORTRAN/H5PAR/ph5_f90_hyperslab_by_row.F90 | 3 +- 28 files changed, 800 insertions(+), 126 deletions(-) create mode 100644 HDF5Examples/FORTRAN/H5G/h5_version.h.in create mode 100644 HDF5Examples/FORTRAN/H5G/h5ex_g_intermediate.F90 create mode 100644 HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.F90 create mode 100644 HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.h5 create mode 100644 HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.F90 create mode 100644 HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.h5 create mode 100644 HDF5Examples/FORTRAN/H5G/h5ex_g_visit.F90 create mode 100644 HDF5Examples/FORTRAN/H5G/h5ex_g_visit.h5 delete mode 100644 HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_iterate_F03.tst delete mode 100644 HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_traverse_F03.tst delete mode 100644 HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_visit_F03.tst create mode 100644 HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_intermediate.tst create mode 100644 HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_iterate.tst delete mode 100644 HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_iterate_F03.tst create mode 100644 HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse.tst delete mode 100644 HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse_F03.tst create mode 100644 HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_visit.tst delete mode 100644 HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_visit_F03.tst diff --git a/HDF5Examples/CMakeLists.txt b/HDF5Examples/CMakeLists.txt index 00adfc0..6f8b53c 100644 --- a/HDF5Examples/CMakeLists.txt +++ b/HDF5Examples/CMakeLists.txt @@ -159,6 +159,7 @@ if (${H5_LIBVER_DIR} GREATER 16) endif () configure_file (${H5EX_F90_SRC_DIR}/H5D/h5_version.h.in ${PROJECT_BINARY_DIR}/FORTRAN/H5D/h5_version.h @ONLY) + configure_file (${H5EX_F90_SRC_DIR}/H5G/h5_version.h.in ${PROJECT_BINARY_DIR}/FORTRAN/H5G/h5_version.h @ONLY) else () set (HDF_BUILD_FORTRAN OFF CACHE BOOL "Build examples FORTRAN support" FORCE) endif () diff --git a/HDF5Examples/FORTRAN/H5G/CMakeLists.txt b/HDF5Examples/FORTRAN/H5G/CMakeLists.txt index 77bd0cb..dc8888a 100644 --- a/HDF5Examples/FORTRAN/H5G/CMakeLists.txt +++ b/HDF5Examples/FORTRAN/H5G/CMakeLists.txt @@ -172,21 +172,19 @@ endif () #endif () if (H5EX_BUILD_TESTING) -# if (HDF_ENABLE_F2003) -# set (exfiles -# h5ex_g_iterate -# h5ex_g_traverse -# h5ex_g_visit -# ) -# foreach (example ${exfiles}) -# add_custom_command ( -# TARGET ${EXAMPLE_VARNAME}_f90_${example} -# POST_BUILD -# COMMAND ${CMAKE_COMMAND} -# ARGS -E copy_if_different ${PROJECT_SOURCE_DIR}/${example}.h5 ${PROJECT_BINARY_DIR}/${example}.h5 -# ) -# endforeach () -# endif () + set (exfiles + h5ex_g_iterate + h5ex_g_traverse + h5ex_g_visit + ) + foreach (example ${exfiles}) + add_custom_command ( + TARGET ${EXAMPLE_VARNAME}_f90_${example} + POST_BUILD + COMMAND ${CMAKE_COMMAND} + ARGS -E copy_if_different ${PROJECT_SOURCE_DIR}/${example}.h5 ${PROJECT_BINARY_DIR}/${example}.h5 + ) + endforeach () macro (ADD_DUMP_TEST testname) add_test ( @@ -347,10 +345,21 @@ if (H5EX_BUILD_TESTING) ADD_DUMP_TEST (h5ex_g_create) ADD_H5_CMP_TEST (h5ex_g_corder) ADD_H5_CMP_TEST (h5ex_g_phase) -# if (HDF_ENABLE_F2003) -# ADD_H5_CMP_TEST (h5ex_g_iterate_F03) -# ADD_H5_CMP_TEST (h5ex_g_traverse_F03) -# ADD_H5_CMP_TEST (h5ex_g_visit_F03) -# endif () + + if (HDF5_VERSION_STRING VERSION_GREATER_EQUAL "1.10.0") + ADD_H5_CMP_TEST (h5ex_g_intermediate) + ADD_H5_CMP_TEST (h5ex_g_iterate) + ADD_H5_CMP_TEST (h5ex_g_visit) + #if (HDF5_VERSION_STRING VERSION_GREATER_EQUAL "1.14.3") + #ADD_H5_CMP_TEST (h5ex_g_traverse) + #endif() + else () + if (HDF_ENABLE_F2003) + ADD_H5_CMP_TEST (h5ex_g_intermediate) + ADD_H5_CMP_TEST (h5ex_g_iterate) + # ADD_H5_CMP_TEST (h5ex_g_traverse) + ADD_H5_CMP_TEST (h5ex_g_visit) + endif () + endif () endif () diff --git a/HDF5Examples/FORTRAN/H5G/Fortran_sourcefiles.cmake b/HDF5Examples/FORTRAN/H5G/Fortran_sourcefiles.cmake index fa38fe6..e2e8e9d 100644 --- a/HDF5Examples/FORTRAN/H5G/Fortran_sourcefiles.cmake +++ b/HDF5Examples/FORTRAN/H5G/Fortran_sourcefiles.cmake @@ -9,9 +9,27 @@ set (common_examples h5ex_g_phase h5ex_g_create ) - -#set (f03_examples -# h5ex_g_iterate_F03 -# h5ex_g_traverse_F03 -# h5ex_g_visit_F03 -#) +if (HDF5_VERSION_STRING VERSION_GREATER_EQUAL "1.10.0") + set (common_examples + ${common_examples} + h5ex_g_intermediate + h5ex_g_iterate + h5ex_g_visit + ) + if (HDF5_VERSION_STRING VERSION_GREATER_EQUAL "1.14.3") + set (common_examples + ${common_examples} + h5ex_g_traverse + ) + endif() +else () + if (HDF_ENABLE_F2003) + set (common_examples + ${common_examples} + h5ex_g_intermediate + h5ex_g_iterate + h5ex_g_traverse + h5ex_g_visit + ) + endif () +endif () diff --git a/HDF5Examples/FORTRAN/H5G/h5_version.h.in b/HDF5Examples/FORTRAN/H5G/h5_version.h.in new file mode 100644 index 0000000..6827675 --- /dev/null +++ b/HDF5Examples/FORTRAN/H5G/h5_version.h.in @@ -0,0 +1,23 @@ +! Version numbers +! +! For major interface/format changes +! +#define H5_VERS_MAJOR @H5_VERS_MAJOR@ +! +! For minor interface/format changes +! +#define H5_VERS_MINOR @H5_VERS_MINOR@ +! +! For tweaks, bug-fixes, or development +! +#define H5_VERS_RELEASE @H5_VERS_RELEASE@ + +! macros for comparing versions + +#define H5_VERSION_GE(Maj, Min, Rel) \ + (((H5_VERS_MAJOR == Maj) && (H5_VERS_MINOR == Min) && (H5_VERS_RELEASE >= Rel)) || \ + ((H5_VERS_MAJOR == Maj) && (H5_VERS_MINOR > Min)) || (H5_VERS_MAJOR > Maj)) + +#define H5_VERSION_LE(Maj, Min, Rel) \ + (((H5_VERS_MAJOR == Maj) && (H5_VERS_MINOR == Min) && (H5_VERS_RELEASE <= Rel)) || \ + ((H5_VERS_MAJOR == Maj) && (H5_VERS_MINOR < Min)) || (H5_VERS_MAJOR < Maj)) diff --git a/HDF5Examples/FORTRAN/H5G/h5ex_g_intermediate.F90 b/HDF5Examples/FORTRAN/H5G/h5ex_g_intermediate.F90 new file mode 100644 index 0000000..751b747 --- /dev/null +++ b/HDF5Examples/FORTRAN/H5G/h5ex_g_intermediate.F90 @@ -0,0 +1,130 @@ +!************************************************************ +! +! This example shows how to create intermediate groups with +! a single call to H5Gcreate. +! +!************************************************************/ + +MODULE g_intermediate + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + +CONTAINS + +!************************************************************ +! +! Operator function for H5Ovisit. This function prints the +! name and type of the object passed to it. +! +!************************************************************ + + INTEGER FUNCTION op_func(loc_id, name, info, cptr) bind(C) + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(LEN=1), DIMENSION(1:50) :: name ! We must have LEN=1 for bind(C) strings + ! in order to be standard compliant + TYPE(H5O_info_t) :: info + CHARACTER(LEN=50) :: name_string = ' ' + TYPE(C_PTR) :: cptr + INTEGER :: i + + DO i = 1, 50 + IF(name(i)(1:1).EQ.C_NULL_CHAR) EXIT ! Read up to the C NULL termination + name_string(i:i) = name(i)(1:1) + ENDDO + + WRITE(*,"('/')",ADVANCE="NO") ! Print root group in object path + ! + ! Check if the current object is the root group, and if not print + ! the full path name and type. + ! + IF(name(1)(1:1) .EQ. '.')THEN ! Root group, do not print '.' + WRITE(*,"(' (Group)')") + ELSE + IF(info%type.EQ.H5O_TYPE_GROUP_F)THEN + WRITE(*,'(A," (Group)")') TRIM(name_string) + ELSE IF(info%type.EQ.H5O_TYPE_DATASET_F)THEN + WRITE(*,'(A," (Dataset)")') TRIM(name_string) + ELSE IF(info%type.EQ.H5O_TYPE_NAMED_DATATYPE_F)THEN + WRITE(*,'(A," (Datatype)")') TRIM(name_string) + ELSE + WRITE(*,'(A," (Unknown)")') TRIM(name_string) + ENDIF + ENDIF + + op_func = 0 ! return successful + + END FUNCTION op_func + +END MODULE g_intermediate + +!************************************************************ +! +! Operator function to be called by H5Ovisit. +! +!************************************************************ +PROGRAM main + + USE HDF5 + USE ISO_C_BINDING + USE g_intermediate + + IMPLICIT NONE + + CHARACTER(LEN=22), PARAMETER :: filename = "h5ex_g_intermediate.h5" + INTEGER(HID_T) :: file + INTEGER(HID_T) :: group + INTEGER(HID_T) :: lcpl + INTEGER :: status + TYPE(C_FUNPTR) :: funptr + TYPE(C_PTR) :: f_ptr + INTEGER :: ret_value + + ! + ! Initialize FORTRAN interface. + ! + CALL H5open_f(status) + + file = H5I_INVALID_HID_F + group = H5I_INVALID_HID_F + lcpl = H5I_INVALID_HID_F + + ! + ! Create a new file using the default properties. + ! + CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file, status) + ! + ! Create link creation property list and set it to allow creation + ! of intermediate groups. + ! + CALL H5Pcreate_f(H5P_LINK_CREATE_F, lcpl, status) + CALL H5Pset_create_inter_group_f(lcpl, 1, status) + ! + ! Create the group /G1/G2/G3. Note that /G1 and /G1/G2 do not + ! exist yet. This call would cause an error if we did not use the + ! previously created property list. + ! + CALL H5Gcreate_f(file, "/G1/G2/G3", group, status, lcpl_id=lcpl) + ! + ! Print all the objects in the files to show that intermediate + ! groups have been created. See h5ex_g_visit_f for more information + ! on how to use H5Ovisit_f. + ! + WRITE(*,'(A)') "Objects in the file:" + funptr = C_FUNLOC(op_func) + f_ptr = C_NULL_PTR + CALL H5Ovisit_f(file, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, funptr, f_ptr, ret_value, status) + ! + ! Close and release resources. + ! + CALL H5Pclose_f(lcpl, status) + CALL H5Gclose_f(group, status) + CALL H5Fclose_f(file, status) + +END PROGRAM main diff --git a/HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.F90 b/HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.F90 new file mode 100644 index 0000000..ca43463 --- /dev/null +++ b/HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.F90 @@ -0,0 +1,115 @@ +!************************************************************ +! +! This example shows how to iterate over group members using +! H5Literate. +! +!************************************************************ +MODULE g_iterate + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + +CONTAINS + +!************************************************************ +! +! Operator function. Prints the name and type of the object +! being examined. +! +! ************************************************************ + + INTEGER FUNCTION op_func(loc_id, name, info, operator_data) bind(C) + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(LEN=1), DIMENSION(1:10) :: name ! must have LEN=1 for bind(C) strings + TYPE(C_PTR) :: info + TYPE(C_PTR) :: operator_data + + INTEGER :: status, i, len + + TYPE(H5O_info_t), TARGET :: infobuf + TYPE(C_PTR) :: ptr + CHARACTER(LEN=10) :: name_string + + ! + ! Get type of the object and display its name and type. + ! The name of the object is passed to this FUNCTION by + ! the Library. + ! + + DO i = 1, 10 + name_string(i:i) = name(i)(1:1) + ENDDO + + CALL H5Oget_info_by_name_f(loc_id, name_string, infobuf, status) + + ! Include the string up to the C NULL CHARACTER + len = 0 + DO + IF(name_string(len+1:len+1).EQ.C_NULL_CHAR.OR.len.GE.10) EXIT + len = len + 1 + ENDDO + + IF(infobuf%type.EQ.H5O_TYPE_GROUP_F)THEN + WRITE(*,*) " Group: ", name_string(1:len) + ELSE IF(infobuf%type.EQ.H5O_TYPE_DATASET_F)THEN + WRITE(*,*) " Dataset: ", name_string(1:len) + ELSE IF(infobuf%type.EQ.H5O_TYPE_NAMED_DATATYPE_F)THEN + WRITE(*,*) " Datatype: ", name_string(1:len) + ELSE + WRITE(*,*) " Unknown: ", name_string(1:len) + ENDIF + + op_func = 0 ! return successful + + END FUNCTION op_func + +END MODULE g_iterate + + +PROGRAM main + + USE HDF5 + USE ISO_C_BINDING + USE g_iterate + + IMPLICIT NONE + + CHARACTER(LEN=17), PARAMETER :: filename = "h5ex_g_iterate.h5" + INTEGER(HID_T) :: file ! Handle + INTEGER :: status + TYPE(C_FUNPTR) :: funptr + TYPE(C_PTR) :: ptr + INTEGER(hsize_t) :: idx + INTEGER :: ret_value + ! + ! Initialize FORTRAN interface. + ! + CALL h5open_f(status) + ! + ! Open file. + ! + CALL H5Fopen_f(filename, H5F_ACC_RDONLY_F, file, status) + ! + ! Begin iteration. + ! + WRITE(*,'(A)') "Objects in root group:" + + idx = 0 + funptr = C_FUNLOC(op_func) ! call back function + ptr = C_NULL_PTR + + CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, idx, funptr, ptr, ret_value, status) + + ! + ! Close and release resources. + ! + CALL H5Fclose_f(file, status) + +END PROGRAM main + diff --git a/HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.h5 b/HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.h5 new file mode 100644 index 0000000..6576e8f Binary files /dev/null and b/HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.h5 differ diff --git a/HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.F90 b/HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.F90 new file mode 100644 index 0000000..198d437 --- /dev/null +++ b/HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.F90 @@ -0,0 +1,249 @@ +!************************************************************ +! +! This example shows a way to recursively traverse the file +! using h5literate and h5literate_by_name_f. The method shown +! here guarantees that +! the recursion will not enter an infinite loop, but does +! not prevent objects from being visited more than once. +! The program prints the directory structure of the file +! specified in filename. The default file used by this example +! implements the structure described in the User's Guide, +! chapter 4, figure 26. +! +! ************************************************************ + +! An optional include to determine the correct HDF5 version +! for selecting the appropriate HDF5 API parameters. This is +! not part of the HDF5 library and is generally unnecessary. +#include "h5_version.h" + +MODULE g_traverse + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + + CHARACTER(LEN=18) :: filename = "h5ex_g_traverse.h5" + + ! + ! Define operator data structure type for H5Literate callback. + ! During recursive iteration, these structures will form a + ! linked list that can be searched for duplicate groups, + ! preventing infinite recursion. + ! + TYPE :: opdata + INTEGER :: recurs ! Recursion level. 0=root + TYPE(opdata), POINTER :: prev ! Pointer to previous opdata +#if H5_VERSION_GE(1, 12, 0) + TYPE(H5O_TOKEN_T_F) :: token ! Group token +#else + INTEGER(haddr_t) :: token ! Group address +#endif + END TYPE opdata + +CONTAINS + + ! + ! OPERATOR FUNCTION TO BE CALLED BY H5LITERATE_F + ! + ! ************************************************************ + ! + ! Operator function. This function prints the name and type + ! of the object passed to it. If the object is a group, it + ! is first checked against other groups in its path using + ! the group_check function, then if it is not a duplicate, + ! H5Literate is called for that group. This guarantees that + ! the program will not enter infinite recursion due to a + ! circular path in the file. + ! + ! ************************************************************ + + RECURSIVE INTEGER(KIND=C_INT) FUNCTION op_func(loc_id, name, info, operator_data) RESULT(ret_val) BIND(C) + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + + INTEGER(hid_t), VALUE :: loc_id + CHARACTER(LEN=1), DIMENSION(1:10) :: name ! Must have LEN=1 for bind(C) strings + TYPE(C_PTR), VALUE :: info + TYPE(C_PTR), VALUE :: operator_data + + INTEGER :: status, return_val + TYPE(h5o_info_t), TARGET :: infobuf + TYPE(C_PTR) :: ptr + CHARACTER(LEN=10) :: name_string + INTEGER :: i + TYPE(opdata), POINTER :: od + TYPE(opdata), TARGET :: nextod + INTEGER(HSIZE_T) :: idx + + TYPE(C_PTR) :: ptr2 + TYPE(C_FUNPTR) :: funptr + + CHARACTER(LEN=10) :: space + INTEGER :: spaces ! Number of whitespaces to prepend to output + INTEGER :: len + + ret_val = 0 + + name_string(1:10) = " " + len = 0 + DO + len = len + 1 + IF(name(len)(1:1).EQ.C_NULL_CHAR) EXIT + name_string(len:len) = name(len)(1:1) + ENDDO + len = len - 1 ! subtract NULL character + + space(1:10) = " " + + CALL C_F_POINTER(operator_data, od) + ! + ! Get type of the object and display its name and type. + ! The name of the object is passed to this function by + ! the Library. + ! + CALL H5Oget_info_by_name_f(loc_id, name_string, infobuf, status) + + spaces = 2*(od%recurs+1) + + WRITE(*,'(A)', ADVANCE='NO') space(1:spaces) ! Format output + + + IF(infobuf%type.EQ.H5O_TYPE_GROUP_F)THEN + + WRITE(*,'("Group: ",A," {")') name_string(1:len) + +! +! Check group address/token against linked list of operator +! data structures. We will always run the check, as the +! reference count cannot be relied upon if there are +! symbolic links, and H5Oget_info_by_name always follows +! symbolic links. Alternatively we could use H5Lget_info +! and never recurse on groups discovered by symbolic +! links, however it could still fail if an object's +! reference count was manually manipulated with +! H5Odecr_refcount. +! + + i = group_check(loc_id, od, infobuf%token) + + IF(i.EQ.1)THEN + WRITE(*,'(A)') space(1:spaces)//" Warning: Loop detected!" + ELSE + + nextod%recurs = od%recurs + 1 + nextod%prev => od + nextod%token = infobuf%token + idx = 0 + ptr2 = C_LOC(nextod%recurs) + funptr = C_FUNLOC(op_func) + CALL h5literate_by_name_f(loc_id, name_string, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, idx, & + funptr, ptr2, ret_val, status) + + ENDIF + WRITE(*,'(A)') space(1:spaces)//"}" + RETURN + ELSE IF(infobuf%type.EQ.H5O_TYPE_DATASET_F)THEN + WRITE(*,'("Dataset: ",A)') name_string(1:len) + ELSE IF(infobuf%type.EQ.H5O_TYPE_NAMED_DATATYPE_F)THEN + WRITE(*,'("Datatype: ",A)') name_string(1:len) + ELSE + WRITE(*,'("Unknown: ",A)') name_string(1:len) + ENDIF + +END FUNCTION op_func + +!************************************************************ +! +! This function recursively searches the linked list of +! opdata structures for one whose address/token matches +! target_token. Returns 1 if a match is found, and 0 +! otherwise. +! +! ************************************************************/ + + INTEGER RECURSIVE FUNCTION group_check(loc_id, od, target_token) result(g_c) + + IMPLICIT NONE + INTEGER :: i + TYPE(opdata), POINTER :: od + INTEGER(HID_T) :: loc_id + INTEGER :: cmp_value +#if H5_VERSION_GE(1, 14, 3) + TYPE(H5O_TOKEN_T_F) :: target_token + INTEGER :: status + CALL h5otoken_cmp_f(loc_id, od%token, target_token, cmp_value, status) +#else +#if H5_VERSION_GE(1, 12, 0) +#error "example only supports HDF5 versions < 1.12.0 and > 1.14.2" +#else + INTEGER(haddr_t) :: target_token + cmp_value = -1 + IF(od%token .EQ. target_token) cmp_value = 0 +#endif +#endif + IF (cmp_value.EQ.0)THEN + g_c = 1 ! Addresses/token match + ELSE IF (od%recurs.EQ.0)THEN + g_c = 0 ! Root group reached with no matches + ELSE + ! Recursively examine the next node + g_c = group_check(loc_id, od%prev, target_token) + END IF + END FUNCTION group_check + +END MODULE g_traverse + +PROGRAM main + + USE HDF5 + USE ISO_C_BINDING + + USE g_traverse + + IMPLICIT NONE + + INTEGER(hid_t) :: file ! Handle + INTEGER :: status + TYPE(h5o_info_t) :: infobuf + TYPE(opdata), TARGET :: od + TYPE(C_PTR) :: ptr + INTEGER(hsize_t) :: idx + INTEGER :: ret_value + TYPE(C_FUNPTR) :: funptr + ! + ! Initialize FORTRAN interface. + ! + CALL h5open_f(status) + ! + ! Open file and initialize the operator data structure. + ! + CALL H5Fopen_f(filename, H5F_ACC_RDONLY_F, file, status) + + CALL h5oget_info_by_name_f(file, "/", infobuf, status) + + od%recurs = 0 + od%prev => NULL() + od%token = infobuf%token + ! + ! Print the root group and formatting, begin iteration. + ! + idx = 0 + funptr = C_FUNLOC(op_func) + ptr = C_LOC(od) + + WRITE(*,'(A)') "/ {" + CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, idx, funptr, ptr, ret_value, status) + WRITE(*,'(A)') "}" + + ! + ! Close and release resources. + ! + CALL H5Fclose_f(file, status) + +END PROGRAM main + + + diff --git a/HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.h5 b/HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.h5 new file mode 100644 index 0000000..3d5d301 Binary files /dev/null and b/HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.h5 differ diff --git a/HDF5Examples/FORTRAN/H5G/h5ex_g_visit.F90 b/HDF5Examples/FORTRAN/H5G/h5ex_g_visit.F90 new file mode 100644 index 0000000..9719947 --- /dev/null +++ b/HDF5Examples/FORTRAN/H5G/h5ex_g_visit.F90 @@ -0,0 +1,158 @@ +!************************************************************ +! +! This example shows how to recursively traverse a file +! using H5Ovisit. The program prints all of +! the objects in the file specified in FILE. The default +! file used by this example implements the structure described +! in the User's Guide, chapter 4, figure 26. +! +!************************************************************ + +MODULE g_visit + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + +CONTAINS + +!************************************************************ +! +! Operator function for H5Ovisit. This function prints the +! name and type of the object passed to it. +! +!************************************************************ + + INTEGER FUNCTION op_func(loc_id, name, info, cptr) bind(C) + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(LEN=1), DIMENSION(1:50) :: name ! We must have LEN=1 for bind(C) strings + ! in order to be standard compliant + TYPE(H5O_info_t) :: info + CHARACTER(LEN=50) :: name_string + TYPE(C_PTR) :: cptr + INTEGER :: i + + name_string(:) = " " + DO i = 1, 50 + IF(name(i)(1:1).EQ.C_NULL_CHAR) EXIT ! Read up to the C NULL termination + name_string(i:i) = name(i)(1:1) + ENDDO + + WRITE(*,"('/')",ADVANCE="NO") ! Print root group in object path + ! + ! Check if the current object is the root group, and if not print + ! the full path name and type. + ! + IF(name(1)(1:1) .EQ. '.')THEN ! Root group, do not print '.' + WRITE(*,"(' (Group)')") + ELSE + IF(info%type.EQ.H5O_TYPE_GROUP_F)THEN + WRITE(*,'(A," (Group)")') TRIM(name_string) + ELSE IF(info%type.EQ.H5O_TYPE_DATASET_F)THEN + WRITE(*,'(A," (Dataset)")') TRIM(name_string) + ELSE IF(info%type.EQ.H5O_TYPE_NAMED_DATATYPE_F)THEN + WRITE(*,'(A," (Datatype)")') TRIM(name_string) + ELSE + WRITE(*,'(A," (Unknown)")') TRIM(name_string) + ENDIF + ENDIF + + op_func = 0 ! return successful + + END FUNCTION op_func + + +!************************************************************ +! +! Operator function for H5Lvisit_f. This function simply +! retrieves the info for the object the current link points +! to, and calls the operator function for H5Ovisit_f. +! +! ************************************************************/ + INTEGER FUNCTION op_func_L(loc_id, name, info, cptr) bind(C) + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + + INTEGER(HID_T), VALUE :: loc_id + CHARACTER(LEN=1), DIMENSION(1:50) :: name ! We must have LEN=1 for bind(C) strings + ! in order to be standard compliant + TYPE(H5L_info_t) :: info + TYPE(C_PTR) :: cptr + + CHARACTER(LEN=50) :: name_string + INTEGER :: i + INTEGER :: status; + TYPE(H5O_info_t) :: infobuf + + TYPE(C_PTR) :: ptr + + name_string(:) = " " + DO i = 1, 50 + IF(name(i)(1:1).EQ.C_NULL_CHAR) EXIT ! Read up to the C NULL termination + name_string(i:i) = name(i)(1:1) + ENDDO + + ! + ! Get type of the object and display its name and type. + ! The name of the object is passed to this function by + ! the Library. + ! + CALL H5Oget_info_by_name_f(loc_id, name_string, infobuf, status); + + op_func_L = op_func(loc_id, name_string, infobuf, cptr) + + END FUNCTION op_func_L + +END MODULE g_visit + +PROGRAM main + + USE HDF5 + USE ISO_C_BINDING + USE g_visit + + IMPLICIT NONE + + CHARACTER(LEN=15), PARAMETER :: filename = "h5ex_g_visit.h5" + INTEGER(HID_T) :: file ! Handle + INTEGER :: status + TYPE(C_FUNPTR) :: funptr + TYPE(C_PTR) :: ptr + INTEGER :: ret_value + ! + ! Initialize FORTRAN interface. + ! + CALL h5open_f(status) + + CALL H5Fopen_f(filename, H5F_ACC_RDONLY_F, file, status) + ! + ! Begin iteration using H5Ovisit + ! + WRITE(*,'(A)') "Objects in the file:" + + funptr = C_FUNLOC(op_func) + ptr = C_NULL_PTR + CALL H5Ovisit_f(file, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, funptr, ptr, ret_value, status) + + ! + ! Repeat the same process using H5Lvisit + ! + WRITE(*,'(/,A)') "Links in the file:" + + funptr = C_FUNLOC(op_func_L) + ptr = C_NULL_PTR + CALL H5Lvisit_f(file, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, funptr, ptr, ret_value, status) + + ! + ! Close and release resources. + ! + CALL H5Fclose_f(file, status) + +END PROGRAM main diff --git a/HDF5Examples/FORTRAN/H5G/h5ex_g_visit.h5 b/HDF5Examples/FORTRAN/H5G/h5ex_g_visit.h5 new file mode 100644 index 0000000..3d5d301 Binary files /dev/null and b/HDF5Examples/FORTRAN/H5G/h5ex_g_visit.h5 differ diff --git a/HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_iterate_F03.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_iterate_F03.tst deleted file mode 100644 index 10eb221..0000000 --- a/HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_iterate_F03.tst +++ /dev/null @@ -1,5 +0,0 @@ -Objects in root group: - Dataset: DS1 - Datatype: DT1 - Group: G1 - Dataset: L1 diff --git a/HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_traverse_F03.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_traverse_F03.tst deleted file mode 100644 index 9d44d2f..0000000 --- a/HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_traverse_F03.tst +++ /dev/null @@ -1,32 +0,0 @@ -/ { - Group: group1 { - Dataset: dset1 - Group: group3 { - Dataset: dset2 - Group: group4 { - Group: group1 { - Group: group5 { - Warning: Loop detected! - } - } - Group: group2 { - } - } - } - } - Group: group2 { - Dataset: dset2 - Group: group4 { - Group: group1 { - Group: group5 { - Dataset: dset1 - Group: group3 { - Warning: Loop detected! - } - } - } - Group: group2 { - } - } - } -} diff --git a/HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_visit_F03.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_visit_F03.tst deleted file mode 100644 index 1a1e825..0000000 --- a/HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_visit_F03.tst +++ /dev/null @@ -1,8 +0,0 @@ -Objects in the file: -/ (Group) -/group1 (Group) -/group1/dset1 (Dataset) -/group1/group3 (Group) -/group1/group3/group4 (Group) -/group1/group3/group4/group1 (Group) -/group1/group3/group4/group2 (Group) diff --git a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_intermediate.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_intermediate.tst new file mode 100644 index 0000000..b524067 --- /dev/null +++ b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_intermediate.tst @@ -0,0 +1,5 @@ +Objects in the file: +/ (Group) +/G1 (Group) +/G1/G2 (Group) +/G1/G2/G3 (Group) diff --git a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_iterate.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_iterate.tst new file mode 100644 index 0000000..66a4ae9 --- /dev/null +++ b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_iterate.tst @@ -0,0 +1,5 @@ +Objects in root group: + Dataset: DS1 + Datatype: DT1 + Group: G1 + Dataset: L1 diff --git a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_iterate_F03.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_iterate_F03.tst deleted file mode 100644 index 10eb221..0000000 --- a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_iterate_F03.tst +++ /dev/null @@ -1,5 +0,0 @@ -Objects in root group: - Dataset: DS1 - Datatype: DT1 - Group: G1 - Dataset: L1 diff --git a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse.tst new file mode 100644 index 0000000..9d44d2f --- /dev/null +++ b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse.tst @@ -0,0 +1,32 @@ +/ { + Group: group1 { + Dataset: dset1 + Group: group3 { + Dataset: dset2 + Group: group4 { + Group: group1 { + Group: group5 { + Warning: Loop detected! + } + } + Group: group2 { + } + } + } + } + Group: group2 { + Dataset: dset2 + Group: group4 { + Group: group1 { + Group: group5 { + Dataset: dset1 + Group: group3 { + Warning: Loop detected! + } + } + } + Group: group2 { + } + } + } +} diff --git a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse_F03.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse_F03.tst deleted file mode 100644 index 9d44d2f..0000000 --- a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse_F03.tst +++ /dev/null @@ -1,32 +0,0 @@ -/ { - Group: group1 { - Dataset: dset1 - Group: group3 { - Dataset: dset2 - Group: group4 { - Group: group1 { - Group: group5 { - Warning: Loop detected! - } - } - Group: group2 { - } - } - } - } - Group: group2 { - Dataset: dset2 - Group: group4 { - Group: group1 { - Group: group5 { - Dataset: dset1 - Group: group3 { - Warning: Loop detected! - } - } - } - Group: group2 { - } - } - } -} diff --git a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_visit.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_visit.tst new file mode 100644 index 0000000..126a588 --- /dev/null +++ b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_visit.tst @@ -0,0 +1,19 @@ +Objects in the file: +/ (Group) +/group1 (Group) +/group1/dset1 (Dataset) +/group1/group3 (Group) +/group1/group3/group4 (Group) +/group1/group3/group4/group1 (Group) +/group1/group3/group4/group2 (Group) + +Links in the file: +/group1 (Group) +/group1/dset1 (Dataset) +/group1/group3 (Group) +/group1/group3/dset2 (Dataset) +/group1/group3/group4 (Group) +/group1/group3/group4/group1 (Group) +/group1/group3/group4/group1/group5 (Group) +/group1/group3/group4/group2 (Group) +/group2 (Group) diff --git a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_visit_F03.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_visit_F03.tst deleted file mode 100644 index 1a1e825..0000000 --- a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_visit_F03.tst +++ /dev/null @@ -1,8 +0,0 @@ -Objects in the file: -/ (Group) -/group1 (Group) -/group1/dset1 (Dataset) -/group1/group3 (Group) -/group1/group3/group4 (Group) -/group1/group3/group4/group1 (Group) -/group1/group3/group4/group2 (Group) diff --git a/HDF5Examples/FORTRAN/H5PAR/CMakeLists.txt b/HDF5Examples/FORTRAN/H5PAR/CMakeLists.txt index 98ef271..d3124a1 100644 --- a/HDF5Examples/FORTRAN/H5PAR/CMakeLists.txt +++ b/HDF5Examples/FORTRAN/H5PAR/CMakeLists.txt @@ -66,11 +66,10 @@ if (H5EX_BUILD_TESTING) # Ensure that 24 is a multiple of the number of processes. # The number 24 corresponds to SPACE1_DIM1 and SPACE1_DIM2 defined in ph5example.c math(EXPR NUMPROCS "24 / ((24 + ${MPIEXEC_MAX_NUMPROCS} - 1) / ${MPIEXEC_MAX_NUMPROCS})") - foreach (example_name ${examples}) - if (${example_name} STREQUAL "ph5_hyperslab_by_col") + if (${example_name} STREQUAL "ph5_f90_hyperslab_by_row") ADD_GREP_TEST (${example_name} 2) - elseif (${example_name} STREQUAL "ph5_hyperslab_by_chunk" OR ${example_name} STREQUAL "ph5_hyperslab_by_pattern") + elseif (${example_name} STREQUAL "ph5_f90_hyperslab_by_chunk" OR ${example_name} STREQUAL "ph5_f90_hyperslab_by_pattern") ADD_GREP_TEST (${example_name} 4) else () ADD_GREP_TEST (${example_name} ${NUMPROCS}) diff --git a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_dataset.F90 b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_dataset.F90 index ce126a3..9819ab3 100644 --- a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_dataset.F90 +++ b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_dataset.F90 @@ -101,6 +101,7 @@ ! Close FORTRAN interface ! CALL h5close_f(error) + IF(mpi_rank.EQ.0) WRITE(*,'(A)') "PHDF5 example finished with no errors" CALL MPI_FINALIZE(mpierror) diff --git a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_file_create.F90 b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_file_create.F90 index f330d4e..7944b5a 100644 --- a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_file_create.F90 +++ b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_file_create.F90 @@ -53,7 +53,7 @@ ! Close FORTRAN interface ! CALL h5close_f(error) - + IF(mpi_rank.EQ.0) WRITE(*,'(A)') "PHDF5 example finished with no errors" CALL MPI_FINALIZE(mpierror) END PROGRAM FILE_CREATE diff --git a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_chunk.F90 b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_chunk.F90 index 3a707af..c74e55d 100644 --- a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_chunk.F90 +++ b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_chunk.F90 @@ -20,8 +20,7 @@ INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/4,8/) ! Dataset dimensions ! in the file. -! INTEGER, DIMENSION(7) :: dimsfi = (/4,8,0,0,0,0,0/) - INTEGER(HSIZE_T), DIMENSION (2) :: dimsfi = (/4,8/) + INTEGER(HSIZE_T), DIMENSION(2) :: dimsfi = (/4,8/) INTEGER(HSIZE_T), DIMENSION(2) :: chunk_dims = (/2,4/) ! Chunks dimensions INTEGER(HSIZE_T), DIMENSION(2) :: count @@ -163,7 +162,7 @@ ! Close FORTRAN interfaces and HDF5 library. ! CALL h5close_f(error) - + IF(mpi_rank.EQ.0) WRITE(*,'(A)') "PHDF5 example finished with no errors" 100 continue CALL MPI_FINALIZE(mpierror) diff --git a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_col.F90 b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_col.F90 index b7b46e8..dc92667 100644 --- a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_col.F90 +++ b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_col.F90 @@ -127,7 +127,7 @@ ! Close FORTRAN predefined datatypes. ! CALL h5close_f(error) - + IF(mpi_rank.EQ.0) WRITE(*,'(A)') "PHDF5 example finished with no errors" CALL MPI_FINALIZE(mpierror) END PROGRAM DATASET_BY_COL diff --git a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_pattern.F90 b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_pattern.F90 index 0f2077f..dd02c63 100644 --- a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_pattern.F90 +++ b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_pattern.F90 @@ -158,7 +158,7 @@ ! Close FORTRAN interfaces and HDF5 library. ! CALL h5close_f(error) - + IF(mpi_rank.EQ.0) WRITE(*,'(A)') "PHDF5 example finished with no errors" 100 continue CALL MPI_FINALIZE(mpierror) diff --git a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_row.F90 b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_row.F90 index 398be23..f66da2a 100644 --- a/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_row.F90 +++ b/HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_row.F90 @@ -147,8 +147,9 @@ ! Close FORTRAN interfaces and HDF5 library. ! CALL h5close_f(error) - + IF(mpi_rank.EQ.0) WRITE(*,'(A)') "PHDF5 example finished with no errors" 100 continue + CALL MPI_FINALIZE(mpierror) END PROGRAM DATASET_BY_ROW -- cgit v0.12