h5ex_t_vlenatt_F03.F90

!************************************************************
!
!  This example shows how to read and write variable-length
!  datatypes to an attribute.  The program first writes two
!  variable-length integer arrays to the attribute then
!  closes the file.  Next, it reopens the file, reads back
!  the data, and outputs it to the screen.
!
!  This file is intended for use with HDF5 Library version 1.8
!  with --enable-fortran2003 
!
!************************************************************

PROGRAM main

  USE HDF5
  USE ISO_C_BINDING
  
  IMPLICIT NONE

  CHARACTER(LEN=21), PARAMETER :: filename  = "h5ex_t_vlenatt_F03.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"
  CHARACTER(LEN=2) , PARAMETER :: attribute = "A1"
  INTEGER, PARAMETER :: LEN0 = 3
  INTEGER, PARAMETER :: LEN1 = 12

  INTEGER(HID_T)  :: file, filetype, memtype, space, dset, attr ! Handles
  INTEGER :: hdferr
  INTEGER(HSIZE_T), DIMENSION(1:2)   :: maxdims
  INTEGER :: i, j

  ! vl data
  TYPE vl
     INTEGER, DIMENSION(:), POINTER :: data
  END TYPE vl
  TYPE(vl), DIMENSION(:), ALLOCATABLE :: ptr

  TYPE(hvl_t), DIMENSION(1:2), TARGET :: wdata ! Array of vlen structures
  TYPE(hvl_t), DIMENSION(1:2), TARGET :: rdata ! Pointer to vlen structures

  INTEGER(hsize_t), DIMENSION(1:1) :: dims = (/2/)
  INTEGER, DIMENSION(:), POINTER :: ptr_r 
  TYPE(C_PTR) :: f_ptr
  
  !
  ! Initialize FORTRAN interface.
  !
  CALL h5open_f(hdferr)
  !
  ! Initialize variable-length data.  wdata(1) is a countdown of
  ! length LEN0, wdata(2) is a Fibonacci sequence of length LEN1.
  !
  wdata(1)%len = LEN0
  wdata(2)%len = LEN1

  ALLOCATE( ptr(1:2) )
  ALLOCATE( ptr(1)%data(1:wdata(1)%len) )
  ALLOCATE( ptr(2)%data(1:wdata(2)%len) )

  DO i=1, wdata(1)%len
     ptr(1)%data(i) = wdata(1)%len - i + 1 ! 3 2 1
  ENDDO
  wdata(1)%p = C_LOC(ptr(1)%data(1))

  ptr(2)%data(1:2) = 1
  DO i = 3, wdata(2)%len
     ptr(2)%data(i) = ptr(2)%data(i-1) + ptr(2)%data(i-2) ! (1 1 2 3 5 8 etc.)
  ENDDO
  wdata(2)%p = C_LOC(ptr(2)%data(1))

  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, hdferr)
  !
  ! Create variable-length datatype for file and memory.
  !
  CALL h5tvlen_create_f(H5T_STD_I32LE, filetype, hdferr)
  CALL h5tvlen_create_f(H5T_NATIVE_INTEGER, memtype, hdferr)
  !
  ! Create dataset with a null dataspace.
  !
  CALL h5screate_f(H5S_NULL_F, space, hdferr)
  CALL h5dcreate_f(file, dataset, H5T_STD_I32LE, space, dset, hdferr)
  CALL h5sclose_f(space, hdferr)  !
  ! Create dataspace.
  !
  CALL h5screate_simple_f(1, dims, space, hdferr)
  !
  ! Create the attribute and write the variable-length data to it
  !
  CALL h5acreate_f(dset, attribute, filetype, space, attr, hdferr)

  f_ptr = C_LOC(wdata(1))
  CALL h5awrite_f(attr, memtype, f_ptr, hdferr)

  !
  ! Close and release resources.  Note the use of H5Dvlen_reclaim
  ! removes the need to manually deallocate the previously allocated
  ! data.
  !
  CALL h5aclose_f(attr , hdferr)
  CALL h5dclose_f(dset , hdferr)
  CALL h5sclose_f(space, hdferr)
  CALL h5tclose_f(filetype, hdferr)
  CALL h5tclose_f(memtype, hdferr)
  CALL h5fclose_f(file , hdferr)
  DEALLOCATE(ptr)

  !
  ! Now we begin the read section of this example.

  !
  ! Open file and dataset, and attribute.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, hdferr)
  CALL h5dopen_f(file, dataset, dset, hdferr)
  CALL h5aopen_f(dset, attribute, attr, hdferr)
  !
  ! Get dataspace and allocate memory for array of vlen structures.
  ! This does not actually allocate memory for the vlen data, that
  ! will be done by the library.
  !
  CALL h5aget_space_f(attr, space, hdferr)
  CALL h5sget_simple_extent_dims_f(space, dims, maxdims, hdferr)
  !
  ! Create the memory datatype.
  !
  CALL h5tvlen_create_f(H5T_NATIVE_INTEGER, memtype, hdferr)

  !
  ! Read the data.
  !
  f_ptr = C_LOC(rdata(1))
  CALL h5aread_f(attr, memtype, f_ptr, hdferr)
  !
  ! Output the variable-length data to the screen.
  !
  DO i = 1, dims(1)
     WRITE(*,'(A,"(",I0,"):",/,"{")', ADVANCE="no") attribute,i
     CALL c_f_pointer(rdata(i)%p, ptr_r, [rdata(i)%len] )
     DO j = 1, rdata(i)%len
        WRITE(*,'(1X,I0)', ADVANCE='no') ptr_r(j)
        IF ( j .LT. rdata(i)%len) WRITE(*,'(",")', ADVANCE='no')
     ENDDO
     WRITE(*,'( " }")')
  ENDDO

  !
  ! Close and release resources.  Note the use of H5Dvlen_reclaim
  ! removes the need to manually deallocate the previously allocated
  ! data.
  !
  CALL h5dvlen_reclaim_f(memtype, space, H5P_DEFAULT_F, f_ptr, hdferr)
  CALL h5aclose_f(attr , hdferr)
  CALL h5dclose_f(dset , hdferr)
  CALL h5sclose_f(space, hdferr)
  CALL h5tclose_f(memtype, hdferr)
  CALL h5fclose_f(file , hdferr)

END PROGRAM main