mirror of
https://github.com/HDFGroup/hdf5.git
synced 2026-09-25 04:09:44 +03:00
Scot Breitenfeld
695efa94df
* updated traverse example * added H5PAR success statement * skipping H5_f90_h5ex_g_traverse
131 lines
3.7 KiB
Fortran
131 lines
3.7 KiB
Fortran
!************************************************************
|
|
!
|
|
! 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
|