diff options
Diffstat (limited to 'HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.F90')
| -rw-r--r-- | HDF5Examples/FORTRAN/H5G/h5ex_g_traverse.F90 | 249 |
1 files changed, 249 insertions, 0 deletions
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 + + + |