Added new H5G Fortran HDF5examples

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}/H5D/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 ()

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 ()

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 ()

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))

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

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
+