summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2023-12-22 21:57:16 (GMT)
committerGitHub <noreply@github.com>2023-12-22 21:57:16 (GMT)
commit695efa94dfcd62c5ef42d03a7f1425c4105819df (patch)
treeaa51dc928c79a19b4f0db9a458312b55a789b3a2
parent366f2d94a3f5ee20287de8062a2a2c895e9eb856 (diff)
downloadhdf5-695efa94dfcd62c5ef42d03a7f1425c4105819df.zip
hdf5-695efa94dfcd62c5ef42d03a7f1425c4105819df.tar.gz
hdf5-695efa94dfcd62c5ef42d03a7f1425c4105819df.tar.bz2
Added new H5G Fortran HDF5examples (#3908)
* updated traverse example * added H5PAR success statement * skipping H5_f90_h5ex_g_traverse
-rw-r--r--HDF5Examples/CMakeLists.txt1
-rw-r--r--HDF5Examples/FORTRAN/H5G/CMakeLists.txt49
-rw-r--r--HDF5Examples/FORTRAN/H5G/Fortran_sourcefiles.cmake30
-rw-r--r--HDF5Examples/FORTRAN/H5G/h5_version.h.in23
-rw-r--r--HDF5Examples/FORTRAN/H5G/h5ex_g_intermediate.F90130
-rw-r--r--HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.F90115
-rw-r--r--HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.h5bin0 -> 2928 bytes
-rw-r--r--HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.F90249
-rw-r--r--HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.h5bin0 -> 6312 bytes
-rw-r--r--HDF5Examples/FORTRAN/H5G/h5ex_g_visit.F90158
-rw-r--r--HDF5Examples/FORTRAN/H5G/h5ex_g_visit.h5bin0 -> 6312 bytes
-rw-r--r--HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_iterate_F03.tst5
-rw-r--r--HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_traverse_F03.tst32
-rw-r--r--HDF5Examples/FORTRAN/H5G/tfiles/18/F03/h5ex_g_visit_F03.tst8
-rw-r--r--HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_intermediate.tst5
-rw-r--r--HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_iterate.tst5
-rw-r--r--HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_iterate_F03.tst5
-rw-r--r--HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse.tst (renamed from HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse_F03.tst)0
-rw-r--r--HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_visit.tst19
-rw-r--r--HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_visit_F03.tst8
-rw-r--r--HDF5Examples/FORTRAN/H5PAR/CMakeLists.txt5
-rw-r--r--HDF5Examples/FORTRAN/H5PAR/ph5_f90_dataset.F901
-rw-r--r--HDF5Examples/FORTRAN/H5PAR/ph5_f90_file_create.F902
-rw-r--r--HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_chunk.F905
-rw-r--r--HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_col.F902
-rw-r--r--HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_pattern.F902
-rw-r--r--HDF5Examples/FORTRAN/H5PAR/ph5_f90_hyperslab_by_row.F903
27 files changed, 768 insertions, 94 deletions
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
--- /dev/null
+++ b/HDF5Examples/FORTRAN/H5G/h5ex_g_iterate.h5
Binary files 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
--- /dev/null
+++ b/HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.h5
Binary files 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
--- /dev/null
+++ b/HDF5Examples/FORTRAN/H5G/h5ex_g_visit.h5
Binary files 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_F03.tst b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse.tst
index 9d44d2f..9d44d2f 100644
--- a/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse_F03.tst
+++ b/HDF5Examples/FORTRAN/H5G/tfiles/18/h5ex_g_traverse.tst
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