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