path: root/fortran/test/tH5T_F03.F90

!****h* root/fortran/test/tH5T_F03.f90
!
! NAME
!  tH5T_F03.f90
!
! FUNCTION
!  Test FORTRAN HDF5 H5T APIs which are dependent on FORTRAN 2003
!  features.
!
! COPYRIGHT
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!   Copyright by The HDF Group.                                               *
!   All rights reserved.                                                      *
!                                                                             *
!   This file is part of HDF5.  The full HDF5 copyright notice, including     *
!   terms governing use, modification, and redistribution, is contained in    *
!   the COPYING file, which can be found at the root of the source code       *
!   distribution tree, or in https://www.hdfgroup.org/licenses.               *
!   If you do not have access to either file, you may request a copy from     *
!   help@hdfgroup.org.                                                        *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
!
! CONTAINS SUBROUTINES
!  test_array_compound_atomic, test_array_compound_array,
!  test_array_bkg, test_h5kind_to_type
!
!*****

! *****************************************
! ***        H 5 T   T E S T S
! *****************************************

!***************************************************************
!**
!**  test_array_compound_atomic(): Test basic array datatype code.
!**  Tests 1-D array of compound datatypes (with no array fields)
!**
!***************************************************************
!
#include <H5config_f.inc>

MODULE TH5T_F03

  USE HDF5
  USE TH5_MISC
  USE TH5_MISC_GEN
  USE ISO_C_BINDING

CONTAINS

SUBROUTINE test_array_compound_atomic(total_error)

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error
  ! 1-D dataset WITH fixed dimensions
  INTEGER, PARAMETER :: SPACE1_RANK = 1
  INTEGER, PARAMETER :: SPACE1_DIM1 = 4
  ! 1-D array datatype
  INTEGER, PARAMETER :: ARRAY1_RANK= 1
  INTEGER, PARAMETER :: ARRAY1_DIM1= 4
  CHARACTER(LEN=10), PARAMETER :: FILENAME = "tarray1.h5"

  TYPE s1_t
     SEQUENCE
     INTEGER :: i
     REAL :: f
  END TYPE s1_t
  TYPE(s1_t), DIMENSION(:,:), ALLOCATABLE, TARGET :: wdata !  Information to write
  TYPE(s1_t), DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata !  Information read in
  INTEGER(hid_t) :: fid1       ! HDF5 File IDs
  INTEGER(hid_t) :: dataset    ! Dataset ID
  INTEGER(hid_t) :: sid1       ! Dataspace ID
  INTEGER(hid_t) :: tid1       ! Array Datatype ID
  INTEGER(hid_t) :: tid2       ! Compound Datatype ID

  INTEGER(HSIZE_T), DIMENSION(1) :: sdims1 = (/SPACE1_DIM1/)
  INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/ARRAY1_DIM1/)
  INTEGER :: ndims !  Array rank for reading
  INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading
  INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims ! Array dimensions for reading
  INTEGER :: nmemb ! Number of compound members
  CHARACTER(LEN=20) :: mname ! Name of compound field
  INTEGER(size_t) :: off   ! Offset of compound field
  INTEGER(hid_t) :: mtid   ! Datatype ID for field
  INTEGER :: i,j      !  counting variables

  INTEGER :: error    !  Generic RETURN value
  INTEGER :: namelen
  LOGICAL :: flag

  TYPE(C_PTR) :: f_ptr ! Needed to pass the pointer, for g95 compiler to work

  ALLOCATE( wdata(1:SPACE1_DIM1,1:ARRAY1_DIM1) )
  ALLOCATE( rdata(1:SPACE1_DIM1,1:ARRAY1_DIM1) )

  ! Initialize array data to write
  DO i = 1, SPACE1_DIM1
     DO j = 1, ARRAY1_DIM1
        wdata(i,j)%i = i * 10 + j
        wdata(i,j)%f = i * 2.5 + j
     ENDDO
  ENDDO

  ! Create file
  CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid1,error)
  CALL check("h5fcreate_f", error, total_error)

  ! Create dataspace for datasets
  CALL h5screate_simple_f(SPACE1_RANK, sdims1, sid1, error)
  CALL check("h5screate_simple_f", error, total_error)

  CALL h5tcreate_f(H5T_COMPOUND_F, H5OFFSETOF(C_LOC(wdata(1,1)), C_LOC(wdata(2,1))), tid2, error)
  CALL check("h5tcreate_f", error, total_error)

  ! Insert integer field
  CALL h5tinsert_f(tid2, "i", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%i)), H5T_NATIVE_INTEGER, error)
  CALL check("h5tinsert_f", error, total_error)

  ! Insert float field

  CALL h5tinsert_f(tid2, "f", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%f)), H5T_NATIVE_REAL, error)
  CALL check("h5tinsert_f", error, total_error)

  !  Create an array datatype to refer to
  CALL h5tarray_create_f(tid2, ARRAY1_RANK, tdims1, tid1, error)
  CALL check("h5tarray_create_f", error, total_error)

  ! Close compound datatype
  CALL h5tclose_f(tid2,error)
  CALL check("h5tclose_f", error, total_error)


  ! Create a dataset
  CALL h5dcreate_f(fid1,"Dataset1",tid1, sid1, dataset,error)
  CALL check("h5dcreate_f", error, total_error)

  ! Write dataset to disk

  ALLOCATE(rdims(1:2)) ! dummy not needed

  f_ptr = C_LOC(wdata(1,1))
  CALL h5dwrite_f(dataset, tid1, f_ptr, error )
  CALL check("h5dwrite_f", error, total_error)
  ! Close Dataset
  CALL h5dclose_f(dataset, error)
  CALL check("h5dclose_f", error, total_error)

  ! Close datatype
  CALL h5tclose_f(tid1,error)
  CALL check("h5tclose_f", error, total_error)

  ! Close disk dataspace
  CALL h5sclose_f(sid1,error)
  CALL check("h5sclose_f", error, total_error)

  ! Close file
  CALL h5fclose_f(fid1,error)
  CALL check("h5fclose_f", error, total_error)

  ! Re-open file
  CALL h5fopen_f (FILENAME, H5F_ACC_RDONLY_F, fid1, error)
  CALL check("h5fopen_f", error, total_error)

  ! Open the dataset
  CALL h5dopen_f(fid1, "Dataset1", dataset, error)
  CALL check("h5dopen_f", error, total_error)

  ! Get the datatype
  CALL h5dget_type_f(dataset, tid1, error)
  CALL check("h5dget_type_f", error, total_error)

  ! Check the array rank
  CALL h5tget_array_ndims_f(tid1, ndims, error)
  CALL check("h5tget_array_ndims_f", error, total_error)
  CALL VERIFY("h5tget_array_ndims_f",ndims, ARRAY1_RANK, total_error)

  ! Get the array dimensions
  ALLOCATE(rdims1(1:ndims))
  CALL h5tget_array_dims_f(tid1, rdims1, error)
  CALL check("h5tget_array_dims_f", error, total_error)


  ! Check the array dimensions
  DO i = 1, ndims
     CALL VERIFY("h5tget_array_dims_f", INT(rdims1(i)), INT(tdims1(i)), total_error)
  ENDDO

  ! Get the compound datatype
  CALL h5tget_super_f(tid1, tid2, error)
  CALL check("h5tget_super_f", error, total_error)

  ! Check the number of members
  CALL h5tget_nmembers_f(tid2, nmemb, error)
  CALL check("h5tget_nmembers_f", error, total_error)
  CALL VERIFY("h5tget_nmembers_f", nmemb, 2, total_error)

  ! Check the 1st field's name
  CALL H5Tget_member_name_f(tid2, 0, mname, namelen,error)
  CALL check("H5Tget_member_name_f", error, total_error)
  CALL verify("H5Tget_member_name_f",mname(1:namelen),"i", total_error)

  !  Check the 1st field's offset
  CALL H5Tget_member_offset_f(tid2, 0, off, error)
  CALL check("H5Tget_member_offset_f", error, total_error)
  CALL VERIFY("H5Tget_member_offset_f",INT(off),0, total_error)


  ! Check the 1st field's datatype
  CALL H5Tget_member_type_f(tid2, 0, mtid, error)
  CALL check("H5Tget_member_type_f", error, total_error)

  CALL H5Tequal_f(mtid, H5T_NATIVE_INTEGER, flag, error)
  CALL check("H5Tequal_f", error, total_error)
  CALL verify("H5Tequal_f", flag, .TRUE., total_error)

  CALL h5tclose_f(mtid,error)
  CALL check("h5tclose_f", error, total_error)

  ! Check the 2nd field's name
  CALL H5Tget_member_name_f(tid2, 1, mname, namelen,error)
  CALL check("H5Tget_member_name_f", error, total_error)
  CALL verify("H5Tget_member_name_f",mname(1:namelen),"f", total_error)

  !  Check the 2nd field's offset
  CALL H5Tget_member_offset_f(tid2, 1, off, error)
  CALL check("H5Tget_member_offset_f", error, total_error)
  CALL VERIFY("H5Tget_member_offset_f",INT(off),INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%f))), total_error)

  ! Check the 2nd field's datatype
  CALL H5Tget_member_type_f(tid2, 1, mtid, error)
  CALL check("H5Tget_member_type_f", error, total_error)

  CALL H5Tequal_f(mtid, H5T_NATIVE_REAL, flag, error)
  CALL check("H5Tequal_f", error, total_error)
  CALL verify("H5Tequal_f", flag, .TRUE., total_error)

  CALL h5tclose_f(mtid,error)
  CALL check("h5tclose_f", error, total_error)

  !  Close Compound Datatype
  CALL h5tclose_f(tid2, error)
  CALL check("h5tclose_f", error, total_error)

  ! Read dataset from disk

  f_ptr = C_LOC(rdata(1,1))
  CALL H5Dread_f(dataset, tid1, f_ptr, error, H5S_ALL_F, H5S_ALL_F, H5P_DEFAULT_F)
  CALL check("H5Dread_f", error, total_error)

  ! Compare data read in
  DO i = 1, SPACE1_DIM1
     DO j = 1, ARRAY1_DIM1
        IF(wdata(i,j)%i.NE.rdata(i,j)%i)THEN
           PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
           total_error = total_error + 1
        ENDIF
        CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',wdata(i,j)%f, rdata(i,j)%f, total_error)
     ENDDO
  ENDDO

  ! Close Datatype
  CALL h5tclose_f(tid1,error)
  CALL check("h5tclose_f", error, total_error)

  ! Close Dataset
  CALL h5dclose_f(dataset, error)
  CALL check("h5dclose_f", error, total_error)

  ! Close file
  CALL h5fclose_f(fid1,error)
  CALL check("h5fclose_f", error, total_error)

END SUBROUTINE test_array_compound_atomic
!!$
!!$!***************************************************************
!!$!**
!!$!**  test_array_compound_array(): Test basic array datatype code.
!!$!**      Tests 1-D array of compound datatypes (with array fields)
!!$!**
!!$!***************************************************************
!!$
  SUBROUTINE test_array_compound_array(total_error)

    IMPLICIT NONE

    INTEGER, INTENT(INOUT) :: total_error

    !  1-D array datatype
    INTEGER, PARAMETER :: ARRAY1_RANK= 1
    INTEGER, PARAMETER :: ARRAY1_DIM1= 3
    INTEGER, PARAMETER :: ARRAY2_DIM1= 5

    INTEGER, PARAMETER :: SPACE1_RANK = 1
    INTEGER, PARAMETER :: SPACE1_DIM1 = 4
    CHARACTER(LEN=10), PARAMETER :: FILENAME = "tarray2.h5"

    TYPE st_t_struct !  Typedef for compound datatype
       SEQUENCE
       INTEGER :: i
       REAL, DIMENSION(1:ARRAY2_DIM1) :: f
       CHARACTER(LEN=2), DIMENSION(1:ARRAY2_DIM1) :: c
    END TYPE st_t_struct
    !  Information to write
    TYPE(st_t_struct), DIMENSION(1:SPACE1_DIM1,1:ARRAY1_DIM1), TARGET :: wdata
    !  Information read in
    TYPE(st_t_struct), DIMENSION(1:SPACE1_DIM1,1:ARRAY1_DIM1), TARGET :: rdata


    INTEGER(hid_t) :: fid1      !  HDF5 File IDs
    INTEGER(hid_t) :: dataset   !  Dataset ID
    integer(hid_t) :: sid1      !  Dataspace ID
    integer(hid_t) :: tid1      !  Array Datatype ID
    integer(hid_t) :: tid2      !  Compound Datatype ID
    integer(hid_t) :: tid3      !  Nested Array Datatype ID
    integer(hid_t) :: tid4      !  Nested Array Datatype ID

    INTEGER(HSIZE_T), DIMENSION(1) :: sdims1 = (/SPACE1_DIM1/)
    INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/ARRAY1_DIM1/)
    INTEGER(HSIZE_T), DIMENSION(1) :: tdims2=(/ARRAY2_DIM1/)

    INTEGER  ndims      ! Array rank for reading

    INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading

    INTEGER :: nmemb ! Number of compound members
    CHARACTER(LEN=20) :: mname ! Name of compound field
    INTEGER(size_t) :: off   ! Offset of compound field
    INTEGER(hid_t) :: mtid   ! Datatype ID for field
    INTEGER(hid_t) :: mtid2   ! Datatype ID for field

    INTEGER :: mclass     !  Datatype class for field
    INTEGER :: i,j,k      ! counting variables

    INTEGER :: error
    CHARACTER(LEN=2) :: ichr2
    INTEGER :: namelen
    LOGICAL :: flag
    INTEGER(HID_T) :: atype_id       !String Attribute Datatype identifier
    INTEGER(SIZE_T) :: attrlen    ! Length of the attribute string

    TYPE(c_ptr) :: f_ptr

    !  Initialize array data to write
    DO i = 1, SPACE1_DIM1
       DO j = 1, array1_DIM1
          wdata(i,j)%i = i*10+j
          DO k = 1, ARRAY2_DIM1
             wdata(i,j)%f(k) = 10*i+j+.5
             WRITE(ichr2,'(I2.2)') k
             wdata(i,j)%c(k) = ichr2
          ENDDO
       ENDDO
    ENDDO

    !  Create file
    CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid1,error)
    CALL check("h5fcreate_f", error, total_error)


    !  Create dataspace for datasets
    CALL h5screate_simple_f(SPACE1_RANK, sdims1, sid1, error)
    CALL check("h5screate_simple_f", error, total_error)

    !  Create a compound datatype to refer to
    !
    CALL h5tcreate_f(H5T_COMPOUND_F,  H5OFFSETOF(C_LOC(wdata(1,1)), C_LOC(wdata(2,1))), tid2, error)
    CALL check("h5tcreate_f", error, total_error)

    ! Insert integer field
    CALL h5tinsert_f(tid2, "i", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%i)), H5T_NATIVE_INTEGER, error)
    CALL check("h5tinsert_f", error, total_error)

    ! Create an array of floats datatype
    CALL h5tarray_create_f(H5T_NATIVE_REAL, ARRAY1_RANK, tdims2, tid3, error)
    CALL check("h5tarray_create_f", error, total_error)
    ! Insert float array field

    CALL h5tinsert_f(tid2, "f", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%f)), tid3, error)
    CALL check("h5tinsert_f", error, total_error)

    !
    ! Create datatype for the String attribute.
    !
    CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, error)
    CALL check("h5tcopy_f",error,total_error)

    attrlen = LEN(wdata(1,1)%c(1))
    CALL h5tset_size_f(atype_id, attrlen, error)
    CALL check("h5tset_size_f",error,total_error)

    ! Create an array of character datatype
    CALL h5tarray_create_f(atype_id, ARRAY1_RANK, tdims2, tid4, error)
    CALL check("h5tarray_create_f", error, total_error)

    ! Insert character array field
    CALL h5tinsert_f(tid2, "c", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%c(1)(1:1))), tid4, error)
    CALL check("h5tinsert2_f", error, total_error)

    !  Close array of floats field datatype
    CALL h5tclose_f(tid3,error)
    CALL check("h5tclose_f", error, total_error)

    CALL h5tclose_f(tid4,error)
    CALL check("h5tclose_f", error, total_error)

    ! Create an array datatype to refer to
    CALL h5tarray_create_f(tid2, ARRAY1_RANK, tdims1, tid1, error)
    CALL check("h5tarray_create_f", error, total_error)

    ! Close compound datatype
    CALL h5tclose_f(tid2,error)
    CALL check("h5tclose_f", error, total_error)

    !  Create a dataset
    CALL h5dcreate_f(fid1,"Dataset1",tid1, sid1, dataset,error)
    CALL check("h5dcreate_f", error, total_error)


    ! Write dataset to disk
    f_ptr = C_LOC(wdata(1,1))
    CALL h5dwrite_f(dataset, tid1, f_ptr, error )
    CALL check("h5dwrite_f", error, total_error)

    ! Close Dataset
    CALL h5dclose_f(dataset, error)
    CALL check("h5dclose_f", error, total_error)

    !  Close datatype
    CALL h5tclose_f(tid1,error)
    CALL check("h5tclose_f", error, total_error)

    ! Close disk dataspace
    CALL h5sclose_f(sid1,error)
    CALL check("h5sclose_f", error, total_error)

    ! Close file
    CALL h5fclose_f(fid1,error)
    CALL check("h5fclose_f", error, total_error)

    !  Re-open file
    CALL h5fopen_f (FILENAME, H5F_ACC_RDONLY_F, fid1, error)
    CALL check("h5fopen_f", error, total_error)

    ! Open the dataset

    CALL h5dopen_f(fid1, "Dataset1", dataset, error)
    CALL check("h5dopen_f", error, total_error)

    !  Get the datatype
    CALL h5dget_type_f(dataset, tid1, error)
    CALL check("h5dget_type_f", error, total_error)

    !  Check the array rank
    CALL h5tget_array_ndims_f(tid1, ndims, error)
    CALL check("h5tget_array_ndims_f", error, total_error)
    CALL VERIFY("h5tget_array_ndims_f",ndims, ARRAY1_RANK, total_error)


    ! Get the array dimensions
    ALLOCATE(rdims1(1:ndims))
    CALL h5tget_array_dims_f(tid1, rdims1, error)
    CALL check("h5tget_array_dims_f", error, total_error)

    !  Check the array dimensions
    DO i = 1, ndims
       CALL VERIFY("h5tget_array_dims_f", INT(rdims1(i)), INT(tdims1(i)), total_error)
    ENDDO

    !  Get the compound datatype
    CALL h5tget_super_f(tid1, tid2, error)
    CALL check("h5tget_super_f", error, total_error)

    !  Check the number of members
    CALL h5tget_nmembers_f(tid2, nmemb, error)
    CALL check("h5tget_nmembers_f", error, total_error)
    CALL VERIFY("h5tget_nmembers_f", nmemb, 3, total_error)

    !  Check the 1st field's name
    CALL H5Tget_member_name_f(tid2, 0, mname, namelen,error)
    CALL check("H5Tget_member_name_f", error, total_error)
    CALL verify("H5Tget_member_name_f",mname(1:namelen),"i", total_error)

    !  Check the 1st field's offset

    CALL H5Tget_member_offset_f(tid2, 0, off, error)
    CALL check("H5Tget_member_offset_f", error, total_error)
    CALL VERIFY("H5Tget_member_offset_f",INT(off),0, total_error)

    !  Check the 1st field's datatype
    CALL H5Tget_member_type_f(tid2, 0, mtid, error)
    CALL check("H5Tget_member_type_f", error, total_error)

    CALL H5Tequal_f(mtid, H5T_NATIVE_INTEGER, flag, error)
    CALL check("H5Tequal_f", error, total_error)
    CALL verify("H5Tequal_f", flag, .TRUE., total_error)

    CALL h5tclose_f(mtid,error)
    CALL check("h5tclose_f", error, total_error)

    !  Check the 2nd field's name
    CALL H5Tget_member_name_f(tid2, 1, mname, namelen,error)
    CALL check("H5Tget_member_name_f", error, total_error)
    CALL verify("H5Tget_member_name_f",mname(1:namelen),"f", total_error)

    !  Check the 2nd field's offset
    CALL H5Tget_member_offset_f(tid2, 1, off, error)
    CALL check("H5Tget_member_offset_f", error, total_error)
    CALL VERIFY("H5Tget_member_offset_f",INT(off),INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%f))), total_error)

    !  Check the 2nd field's datatype
    CALL H5Tget_member_type_f(tid2, 1, mtid, error)
    CALL check("H5Tget_member_type_f", error, total_error)

    !  Get the 2nd field's class
    CALL H5Tget_class_f(mtid, mclass, error)
    CALL check("H5Tget_class_f", error, total_error)
    CALL VERIFY("H5Tget_class_f",mclass, H5T_ARRAY_F, total_error)

    !  Check the array rank
    CALL h5tget_array_ndims_f(mtid, ndims, error)
    CALL check("h5tget_array_ndims_f", error, total_error)
    CALL VERIFY("h5tget_array_ndims_f",ndims, ARRAY1_RANK, total_error)

    !  Get the array dimensions
    CALL h5tget_array_dims_f(mtid, rdims1, error)
    CALL check("h5tget_array_dims_f", error, total_error)

    !  Check the array dimensions
    DO i = 1, ndims
       CALL VERIFY("h5tget_array_dims_f", INT(rdims1(i)), INT(tdims2(i)), total_error)
    ENDDO

    !  Check the 3rd field's name
    CALL H5Tget_member_name_f(tid2, 2, mname, namelen,error)
    CALL check("H5Tget_member_name_f", error, total_error)
    CALL verify("H5Tget_member_name_f",mname(1:namelen),"c", total_error)

    !  Check the 3rd field's offset
    CALL H5Tget_member_offset_f(tid2, 2, off, error)
    CALL check("H5Tget_member_offset_f", error, total_error)
    CALL VERIFY("H5Tget_member_offset_f",INT(off),&
         INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%c(1)(1:1)))), total_error)

    !  Check the 3rd field's datatype
    CALL H5Tget_member_type_f(tid2, 2, mtid2, error)
    CALL check("H5Tget_member_type_f", error, total_error)

    !  Get the 3rd field's class
    CALL H5Tget_class_f(mtid2, mclass, error)
    CALL check("H5Tget_class_f", error, total_error)
    CALL VERIFY("H5Tget_class_f",mclass, H5T_ARRAY_F, total_error)

    !  Check the array rank
    CALL h5tget_array_ndims_f(mtid2, ndims, error)
    CALL check("h5tget_array_ndims_f", error, total_error)
    CALL VERIFY("h5tget_array_ndims_f",ndims, ARRAY1_RANK, total_error)

    !  Get the array dimensions
    CALL h5tget_array_dims_f(mtid2, rdims1, error)
    CALL check("h5tget_array_dims_f", error, total_error)

    !  Check the array dimensions
    DO i = 1, ndims
       CALL VERIFY("h5tget_array_dims_f", INT(rdims1(i)), INT(tdims2(i)), total_error)
    ENDDO

    !  Check the nested array's datatype
    CALL H5Tget_super_f(mtid, tid3, error)
    CALL check("H5Tget_super_f", error, total_error)

    CALL H5Tequal_f(tid3, H5T_NATIVE_REAL, flag, error)
    CALL check("H5Tequal_f", error, total_error)
    CALL verify("H5Tequal_f", flag, .TRUE., total_error)

    !  Check the nested array's datatype
    CALL H5Tget_super_f(mtid2, tid3, error)
    CALL check("H5Tget_super_f", error, total_error)

    CALL H5Tequal_f(tid3, atype_id, flag, error)
    CALL check("H5Tequal_f", error, total_error)
    CALL verify("H5Tequal_f", flag, .TRUE., total_error)

    !  Close the array's base type datatype
    CALL h5tclose_f(tid3, error)
    CALL check("h5tclose_f", error, total_error)

    !  Close the member datatype
    CALL h5tclose_f(mtid,error)
    CALL check("h5tclose_f", error, total_error)

    !  Close the member datatype
    CALL h5tclose_f(mtid2,error)
    CALL check("h5tclose_f", error, total_error)

    !  Close Compound Datatype
    CALL h5tclose_f(tid2,error)
    CALL check("h5tclose_f", error, total_error)

    !  READ dataset from disk

    f_ptr = c_null_ptr
    f_ptr = C_LOC(rdata(1,1))
    CALL H5Dread_f(dataset, tid1, f_ptr, error)
    CALL check("H5Dread_f", error, total_error)

    !  Compare data read in
    DO i = 1, SPACE1_DIM1
       DO j = 1, ARRAY1_DIM1
          IF(wdata(i,j)%i.NE.rdata(i,j)%i)THEN
             PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
             total_error = total_error + 1
          ENDIF
          DO k = 1, ARRAY2_DIM1
             CALL VERIFY("h5dread_f",wdata(i,j)%f(k),rdata(i,j)%f(k),total_error)
             IF(total_error.NE.0) PRINT*,'ERROR: Wrong real array data is read back by H5Dread_f'
             CALL VERIFY("h5dread_f",wdata(i,j)%c(k),rdata(i,j)%c(k),total_error)
             IF(total_error.NE.0) PRINT*,'ERROR: Wrong character array data is read back by H5Dread_f'
          ENDDO
       ENDDO
    ENDDO

    !  Close Datatype
    CALL h5tclose_f(tid1,error)
    CALL check("h5tclose_f", error, total_error)

    !  Close Dataset
    CALL h5dclose_f(dataset, error)
    CALL check("h5dclose_f", error, total_error)

    !  Close file
    CALL h5fclose_f(fid1,error)
    CALL check("h5fclose_f", error, total_error)
  END SUBROUTINE test_array_compound_array
!!$
!!$!***************************************************************
!!$!**
!!$!**  test_array_bkg(): Test basic array datatype code.
!!$!**      Tests reading compound datatype with array fields and
!!$!**          writing partial fields.
!!$!**
!!$!***************************************************************
!!$
  SUBROUTINE test_array_bkg(total_error)

    IMPLICIT NONE

    INTEGER, INTENT(INOUT) :: total_error

    INTEGER, PARAMETER :: LENGTH = 5
    INTEGER, PARAMETER :: ALEN = 10
    INTEGER, PARAMETER :: RANK = 1
    INTEGER, PARAMETER :: NMAX = 100
    CHARACTER(LEN=17), PARAMETER :: FIELDNAME = "ArrayofStructures"

    INTEGER(hid_t) :: fid, array_dt
    INTEGER(hid_t) :: space
    INTEGER(hid_t) :: type
    INTEGER(hid_t) :: dataset

    INTEGER(hsize_t), DIMENSION(1:1) :: dim =(/LENGTH/)
    INTEGER(hsize_t), DIMENSION(1:1) :: dima =(/ALEN/)

    INTEGER :: i, j
    INTEGER, DIMENSION(1:3) :: ndims = (/1,1,1/)

    TYPE CmpField_struct
       INTEGER, DIMENSION(1:ALEN) :: a
       REAL(KIND=sp), DIMENSION(1:ALEN) :: b
       REAL(KIND=dp), DIMENSION(1:ALEN) :: c
    ENDTYPE CmpField_struct

    TYPE(CmpField_struct), DIMENSION(1:LENGTH), TARGET :: cf
    TYPE(CmpField_struct), DIMENSION(1:LENGTH), TARGET :: cfr

    TYPE CmpDTSinfo_struct
       INTEGER :: nsubfields
       CHARACTER(LEN=5), DIMENSION(1:nmax) :: name
       INTEGER(size_t), DIMENSION(1:nmax) :: offset
       INTEGER(hid_t), DIMENSION(1:nmax) :: datatype
    END TYPE CmpDTSinfo_struct

    TYPE(CmpDTSinfo_struct) :: dtsinfo

    TYPE fld_t_struct
       REAL(KIND=sp), DIMENSION(1:ALEN) :: b
    END TYPE fld_t_struct

    INTEGER(SIZE_T) :: type_sizei  ! Size of the integer datatype
    INTEGER(SIZE_T) :: type_sizer  ! Size of the real datatype
    INTEGER(SIZE_T) :: type_sized  ! Size of the double datatype
    INTEGER(SIZE_T) :: sizeof_compound ! total size of compound

    TYPE(fld_t_struct), DIMENSION(1:LENGTH), TARGET :: fld
    TYPE(fld_t_struct), DIMENSION(1:LENGTH), TARGET :: fldr

    CHARACTER(LEN=10), PARAMETER :: FILENAME = "tarray3.h5"

    INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading
    INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims ! Array dimensions for reading

    INTEGER :: error
    TYPE(c_ptr) :: f_ptr

!     Initialize the data
!     -------------------

    DO i = 1, LENGTH
       DO j = 1, ALEN
          cf(i)%a(j) = 100*(i+1) + j
          cf(i)%b(j) = (100.*(i+1) + 0.01*j)
          cf(i)%c(j) = 100.*(i+1) + 0.02*j
       ENDDO
    ENDDO

    ! Set the number of data members
    ! ------------------------------

    dtsinfo%nsubfields = 3

    ! Initialize the offsets
    ! -----------------------
    CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, error)
    CALL check("h5tget_size_f", error, total_error)
    IF(h5_sizeof(cf(1)%b(1)).EQ.4_size_t)THEN
       CALL h5tget_size_f(H5T_NATIVE_REAL_C_FLOAT, type_sizer, error)
       CALL check("h5tget_size_f", error, total_error)
    ELSE IF(h5_sizeof(cf(1)%b(1)).EQ.8_size_t)THEN
       CALL h5tget_size_f(H5T_NATIVE_REAL_C_DOUBLE, type_sizer, error)
       CALL check("h5tget_size_f", error, total_error)
    ENDIF

    CALL h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, error)
    CALL check("h5tget_size_f", error, total_error)

    dtsinfo%offset(1)   = H5OFFSETOF(C_LOC(cf(1)),C_LOC(cf(1)%a(1)))
    dtsinfo%offset(2)   = H5OFFSETOF(C_LOC(cf(1)),C_LOC(cf(1)%b(1)))
    dtsinfo%offset(3)   = H5OFFSETOF(C_LOC(cf(1)),C_LOC(cf(1)%c(1)))


    ! Initialize the data type IDs
    ! ----------------------------
    dtsinfo%datatype(1) = H5T_NATIVE_INTEGER;
    dtsinfo%datatype(2) = H5T_NATIVE_REAL_C_FLOAT;
    dtsinfo%datatype(3) = H5T_NATIVE_REAL_C_DOUBLE;


    ! Initialize the names of data members
    ! ------------------------------------

    dtsinfo%name(1) = "One  "
    dtsinfo%name(2) = "Two  "
    dtsinfo%name(3) = "Three"

    ! Create file
    ! -----------
    CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid,error)
    CALL check("h5fcreate_f", error, total_error)


    ! Create data space
    ! -----------------
    CALL h5screate_simple_f(RANK, dim, space, error)
    CALL check("h5screate_simple_f", error, total_error)


    ! Create the memory data type
    ! ---------------------------

    CALL h5tcreate_f(H5T_COMPOUND_F, H5OFFSETOF(C_LOC(cf(1)), C_LOC(cf(2))), type, error)
    CALL check("h5tcreate_f", error, total_error)

    ! Add  members to the compound data type
    ! --------------------------------------

    DO i = 1, dtsinfo%nsubfields
       CALL h5tarray_create_f(dtsinfo%datatype(i), ndims(i), dima, array_dt, error)
       CALL check("h5tarray_create_f", error, total_error)
       CALL H5Tinsert_f(type, dtsinfo%name(i), dtsinfo%offset(i), array_dt, error)
       CALL check("h5tinsert_f", error, total_error)

       CALL h5tclose_f(array_dt,error)
       CALL check("h5tclose_f", error, total_error)
    ENDDO

    ! Create the dataset
    ! ------------------ /
    CALL h5dcreate_f(fid,FIELDNAME,type, space, dataset,error)
    CALL check("h5dcreate_f", error, total_error)

    ! Write data to the dataset
    ! -------------------------

    ALLOCATE(rdims(1:2)) ! dummy not needed

    f_ptr = C_LOC(cf(1))

    CALL h5dwrite_f(dataset, type, f_ptr, error )
    CALL check("h5dwrite_f", error, total_error)


    ALLOCATE(rdims1(1:2)) ! dummy not needed
    f_ptr = C_LOC(cfr(1))
    CALL H5Dread_f(dataset, type, f_ptr, error)
    CALL check("H5Dread_f", error, total_error)

    ! Verify correct data
    ! -------------------
    DO i = 1, LENGTH
       DO j = 1, ALEN
           IF( cf(i)%a(j) .NE. cfr(i)%a(j) )THEN
             PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
             total_error = total_error + 1
          ENDIF
          CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',cf(i)%b(j), cfr(i)%b(j), total_error)
          CALL VERIFY('ERROR: Wrong double data is read back by H5Dread_f ',cf(i)%c(j), cfr(i)%c(j), total_error)
       ENDDO
    ENDDO


    ! Release IDs
    ! -----------
    CALL h5tclose_f(type,error)
    CALL check("h5tclose_f", error, total_error)
    CALL h5sclose_f(space,error)
    CALL check("h5sclose_f", error, total_error)
    CALL h5dclose_f(dataset, error)
    CALL check("h5dclose_f", error, total_error)
    CALL h5fclose_f(fid,error)
    CALL check("h5fclose_f", error, total_error)

    !****************************
    ! Reopen the file and update
    !****************************

    CALL h5fopen_f (FILENAME, H5F_ACC_RDWR_F, fid, error)
    CALL check("h5fopen_f", error, total_error)

    CALL h5dopen_f(fid, FIELDNAME, dataset, error)
    CALL check("h5dopen_f", error, total_error)

    sizeof_compound =  INT( type_sizer*ALEN, size_t)

    CALL h5tcreate_f(H5T_COMPOUND_F, sizeof_compound , type, error)
    CALL check("h5tcreate_f", error, total_error)

    CALL h5tarray_create_f(H5T_NATIVE_REAL_C_FLOAT, 1, dima, array_dt, error)
    CALL check("h5tarray_create_f", error, total_error)

    CALL h5tinsert_f(TYPE, "Two", 0_size_t, array_dt, error)
    CALL check("h5tinsert_f", error, total_error)

    ! Initialize the data to overwrite
    ! --------------------------------
    DO i = 1, LENGTH
       DO j = 1, ALEN
          fld(i)%b(j) = 1.313
          cf(i)%b(j) = fld(i)%b(j)
       ENDDO
    ENDDO

    f_ptr = C_LOC(fld(1))

    CALL h5dwrite_f(dataset, TYPE, f_ptr, error )
    CALL check("h5dwrite_f", error, total_error)


    !  Read just the field changed

    f_ptr = C_LOC(fldr(1))
    CALL H5Dread_f(dataset, TYPE, f_ptr, error)
    CALL check("H5Dread_f", error, total_error)

    DO i = 1, LENGTH
       DO j = 1, ALEN
          CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',fld(i)%b(j), fldr(i)%b(j), total_error)
       ENDDO
    ENDDO
    CALL h5tclose_f(TYPE,error)
    CALL check("h5tclose_f", error, total_error)
    CALL h5tclose_f(array_dt,error)
    CALL check("h5tclose_f", error, total_error)

    CALL h5dget_type_f(dataset, type, error)
    CALL check("h5dget_type_f", error, total_error)


    !  Read the entire dataset again

    f_ptr = C_LOC(cfr(1))
    CALL H5Dread_f(dataset, TYPE, f_ptr, error)
    CALL check("H5Dread_f", error, total_error)


    ! Verify correct data
    ! -------------------

    DO i = 1, LENGTH
       DO j = 1, ALEN
          CALL VERIFY('ERROR: Wrong integer data is read back by H5Dread_f ',cf(i)%a(j), cfr(i)%a(j), total_error)
          CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',cf(i)%b(j),cfr(i)%b(j), total_error)
          CALL VERIFY('ERROR: Wrong double data is read back by H5Dread_f ',cf(i)%c(j), cfr(i)%c(j), total_error)
       ENDDO
    ENDDO

    CALL h5dclose_f(dataset, error)
    CALL check("h5dclose_f", error, total_error)

    CALL h5tclose_f(type,error)
    CALL check("h5tclose_f", error, total_error)

    CALL h5fclose_f(fid,error)
    CALL check("h5fclose_f", error, total_error)

!**************************************************
! Reopen the file and print out all the data again
!**************************************************

    CALL h5fopen_f (FILENAME, H5F_ACC_RDWR_F, fid, error)
    CALL check("h5fopen_f", error, total_error)


    CALL h5dopen_f(fid, FIELDNAME, dataset, error)
    CALL check("h5dopen_f", error, total_error)


    CALL h5dget_type_f(dataset, type, error)
    CALL check("h5dget_type_f", error, total_error)


    ! Reset the data to read in
    ! -------------------------

    DO i = 1, LENGTH
       cfr(i)%a(:) = 0
       cfr(i)%b(:) = 0
       cfr(i)%c(:) = 0
    ENDDO

    f_ptr = C_LOC(cfr(1))
    CALL H5Dread_f(dataset, TYPE, f_ptr, error)
    CALL check("H5Dread_f", error, total_error)

    ! Verify correct data
    ! -------------------

    DO i = 1, LENGTH
       DO j = 1, ALEN
          CALL VERIFY('ERROR: Wrong integer data is read back by H5Dread_f ',cf(i)%a(j), cfr(i)%a(j), total_error)
          CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',cf(i)%b(j),cfr(i)%b(j), total_error)
          CALL VERIFY('ERROR: Wrong double data is read back by H5Dread_f ',cf(i)%c(j), cfr(i)%c(j), total_error)
       ENDDO
    ENDDO

    CALL h5dclose_f(dataset, error)
    CALL check("h5dclose_f", error, total_error)

    CALL h5tclose_f(type,error)
    CALL check("h5tclose_f", error, total_error)

    CALL h5fclose_f(fid,error)
    CALL check("h5fclose_f", error, total_error)

  END SUBROUTINE test_array_bkg

  SUBROUTINE test_h5kind_to_type(total_error)

    IMPLICIT NONE

    INTEGER, INTENT(INOUT) :: total_error

    INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(2) !should map to INTEGER*1 on most modern processors
    INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(4) !should map to INTEGER*2 on most modern processors
    INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors
    INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors
#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
    INTEGER, PARAMETER :: int_kind_32 = SELECTED_INT_KIND(36) !should map to INTEGER*16 on most modern processors
    INTEGER(int_kind_32), DIMENSION(1:4), TARGET :: dset_data_i32, data_out_i32
    INTEGER(HID_T) :: dset_id32     ! Dataset identifier
    CHARACTER(LEN=6), PARAMETER :: dsetname16 = "dset16"     ! Dataset name
#endif
    INTEGER, PARAMETER :: real_kind_7  = C_FLOAT   !should map to REAL*4 on most modern processors
    INTEGER, PARAMETER :: real_kind_15 = C_DOUBLE  !should map to REAL*8 on most modern processors

! Check if C has quad precision extension
#if H5_HAVE_FLOAT128!=0
! Check if Fortran supports quad precision
# if H5_PAC_FC_MAX_REAL_PRECISION > 26
    INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(31)
# else
    INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(15,307)
# endif
#else
! Check if the default of long double is quad precision
# if H5_PAC_C_MAX_REAL_PRECISION  > 26
#   if H5_PAC_FC_MAX_REAL_PRECISION > 26
    INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(31)
#   else
    INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(15,307)
#   endif
# else
    INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(15,307)
# endif
#endif
    REAL(real_kind_31), DIMENSION(1:4), TARGET :: dset_data_r31, data_out_r31
    INTEGER(HID_T) :: dset_idr16      ! Dataset identifier
    CHARACTER(LEN=7), PARAMETER :: dsetnamer16 = "dsetr16"     ! Dataset name

    CHARACTER(LEN=12), PARAMETER :: filename = "dsetf_F03.h5" ! File name
    CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1"     ! Dataset name
    CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2"     ! Dataset name
    CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4"     ! Dataset name
    CHARACTER(LEN=5), PARAMETER :: dsetname8 = "dset8"     ! Dataset name
    CHARACTER(LEN=6), PARAMETER :: dsetnamer = "dsetr"     ! Dataset name
    CHARACTER(LEN=6), PARAMETER :: dsetnamer4 = "dsetr4"     ! Dataset name
    CHARACTER(LEN=6), PARAMETER :: dsetnamer8 = "dsetr8"     ! Dataset name

    INTEGER(HID_T) :: file_id       ! File identifier
    INTEGER(HID_T) :: dset_id1      ! Dataset identifier
    INTEGER(HID_T) :: dset_id4      ! Dataset identifier
    INTEGER(HID_T) :: dset_id8      ! Dataset identifier
    INTEGER(HID_T) :: dset_id16     ! Dataset identifier
    INTEGER(HID_T) :: dset_idr       ! Dataset identifier
    INTEGER(HID_T) :: dset_idr4      ! Dataset identifier
    INTEGER(HID_T) :: dset_idr8      ! Dataset identifier

    INTEGER :: error ! Error flag
    INTEGER :: i

! Data buffers:

    INTEGER(int_kind_1), DIMENSION(1:4), TARGET :: dset_data_i1, data_out_i1
    INTEGER(int_kind_4), DIMENSION(1:4), TARGET :: dset_data_i4, data_out_i4
    INTEGER(int_kind_8), DIMENSION(1:4), TARGET :: dset_data_i8, data_out_i8
    INTEGER(int_kind_16), DIMENSION(1:4), TARGET :: dset_data_i16, data_out_i16

    REAL, DIMENSION(1:4), TARGET :: dset_data_r, data_out_r
    REAL(real_kind_7), DIMENSION(1:4), TARGET :: dset_data_r7, data_out_r7
    REAL(real_kind_15), DIMENSION(1:4), TARGET :: dset_data_r15, data_out_r15

    INTEGER(HSIZE_T), DIMENSION(1:1) :: data_dims = (/4/)
    INTEGER(HID_T) :: dspace_id     ! Dataspace identifier

    TYPE(C_PTR) :: f_ptr

    !
    ! Initialize the dset_data array.
    !
    DO i = 1, 4
       dset_data_i1(i)  = HUGE(0_int_kind_1)-INT(i,int_kind_1)
       dset_data_i4(i)  = HUGE(0_int_kind_4)-INT(i,int_kind_4)
       dset_data_i8(i)  = HUGE(0_int_kind_8)-INT(i,int_kind_8)
       dset_data_i16(i) = HUGE(0_int_kind_16)-INT(i,int_kind_16)
#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
       dset_data_i32(i) = HUGE(0_int_kind_32)-INT(i,int_kind_32)
#endif
       dset_data_r(i) = 4.0*ATAN(1.0)-REAL(i-1)
       dset_data_r7(i) = 4.0_real_kind_7*ATAN(1.0_real_kind_7)-REAL(i-1,real_kind_7)
       dset_data_r15(i) = 4.0_real_kind_15*ATAN(1.0_real_kind_15)-REAL(i-1,real_kind_15)
       dset_data_r31(i) = 4.0_real_kind_31*ATAN(1.0_real_kind_31)-REAL(i-1,real_kind_31)

    END DO

    CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error)
    CALL check("h5fcreate_f",error, total_error)
  !
  ! Create dataspaces for datasets
  !
    CALL h5screate_simple_f(1, data_dims , dspace_id, error)
    CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset.
  !
    CALL H5Dcreate_f(file_id, dsetname1, h5kind_to_type(int_kind_1,H5_INTEGER_KIND),  dspace_id, dset_id1, error)
    CALL check("H5Dcreate_f",error, total_error)
    CALL H5Dcreate_f(file_id, dsetname2, h5kind_to_type(int_kind_4,H5_INTEGER_KIND),  dspace_id, dset_id4, error)
    CALL check("H5Dcreate_f",error, total_error)
    CALL H5Dcreate_f(file_id, dsetname4, h5kind_to_type(int_kind_8,H5_INTEGER_KIND),  dspace_id, dset_id8, error)
    CALL check("H5Dcreate_f",error, total_error)
    CALL H5Dcreate_f(file_id, dsetname8, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), dspace_id, dset_id16, error)
    CALL check("H5Dcreate_f",error, total_error)
#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
    CALL H5Dcreate_f(file_id, dsetname16, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), dspace_id, dset_id32, error)
    CALL check("H5Dcreate_f",error, total_error)
#endif
    CALL H5Dcreate_f(file_id, dsetnamer, H5T_NATIVE_REAL, dspace_id, dset_idr, error)
    CALL check("H5Dcreate_f",error, total_error)
    CALL H5Dcreate_f(file_id, dsetnamer4, h5kind_to_type(real_kind_7,H5_REAL_KIND),  dspace_id, dset_idr4, error)
    CALL check("H5Dcreate_f",error, total_error)
    CALL H5Dcreate_f(file_id, dsetnamer8, h5kind_to_type(real_kind_15,H5_REAL_KIND), dspace_id, dset_idr8, error)
    CALL check("H5Dcreate_f",error, total_error)
!#ifdef H5_HAVE_FLOAT128
    CALL H5Dcreate_f(file_id, dsetnamer16, h5kind_to_type(real_kind_31,H5_REAL_KIND), dspace_id, dset_idr16, error)
    CALL check("H5Dcreate_f",error, total_error)
!#endif
  !
  ! Write the dataset.
  !
    f_ptr = C_LOC(dset_data_i1(1))
    CALL h5dwrite_f(dset_id1, h5kind_to_type(int_kind_1,H5_INTEGER_KIND), f_ptr, error)
    CALL check("H5Dwrite_f",error, total_error)
    f_ptr = C_LOC(dset_data_i4(1))
    CALL h5dwrite_f(dset_id4, h5kind_to_type(int_kind_4,H5_INTEGER_KIND), f_ptr, error)
    CALL check("H5Dwrite_f",error, total_error)
    f_ptr = C_LOC(dset_data_i8(1))
    CALL h5dwrite_f(dset_id8, h5kind_to_type(int_kind_8,H5_INTEGER_KIND), f_ptr, error)
    CALL check("H5Dwrite_f",error, total_error)
    f_ptr = C_LOC(dset_data_i16(1))
    CALL h5dwrite_f(dset_id16, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), f_ptr, error)
    CALL check("H5Dwrite_f",error, total_error)
#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
    f_ptr = C_LOC(dset_data_i32(1))
    CALL h5dwrite_f(dset_id32, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), f_ptr, error)
    CALL check("H5Dwrite_f",error, total_error)
#endif
    f_ptr = C_LOC(dset_data_r(1))
    CALL h5dwrite_f(dset_idr, H5T_NATIVE_REAL, f_ptr, error)
    CALL check("H5Dwrite_f",error, total_error)
    f_ptr = C_LOC(dset_data_r7(1))
    CALL h5dwrite_f(dset_idr4, h5kind_to_type(real_kind_7,H5_REAL_KIND), f_ptr, error)
    CALL check("H5Dwrite_f",error, total_error)
    f_ptr = C_LOC(dset_data_r15(1))
    CALL h5dwrite_f(dset_idr8, h5kind_to_type(real_kind_15,H5_REAL_KIND), f_ptr, error)
    CALL check("H5Dwrite_f",error, total_error)
!#ifdef H5_HAVE_FLOAT128
    f_ptr = C_LOC(dset_data_r31(1))
    CALL h5dwrite_f(dset_idr16, h5kind_to_type(real_kind_31,H5_REAL_KIND), f_ptr, error)
    CALL check("H5Dwrite_f",error, total_error)
!#endif
  !
  ! Close the file
  !
    CALL h5fclose_f(file_id, error)
    CALL check("h5fclose_f",error, total_error)

  ! Open the file

    CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file_id, error)
    CALL check("h5fopen_f",error, total_error)
  !
  ! Read the dataset.
  !
  ! Read data back into an integer size that is larger then the original size used for
  ! writing the data
    f_ptr = C_LOC(data_out_i1(1))
    CALL h5dread_f(dset_id1, h5kind_to_type(int_kind_1,H5_INTEGER_KIND), f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
    f_ptr = C_LOC(data_out_i4(1))
    CALL h5dread_f(dset_id4, h5kind_to_type(int_kind_4,H5_INTEGER_KIND), f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
    f_ptr = C_LOC(data_out_i8(1))
    CALL h5dread_f(dset_id8, h5kind_to_type(int_kind_8,H5_INTEGER_KIND), f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
    f_ptr = C_LOC(data_out_i16(1))
    CALL h5dread_f(dset_id16, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
    f_ptr = C_LOC(data_out_i32(1))
    CALL h5dread_f(dset_id32, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
#endif
    f_ptr = C_LOC(data_out_r(1))
    CALL h5dread_f(dset_idr, H5T_NATIVE_REAL, f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
    f_ptr = C_LOC(data_out_r7(1))
    CALL h5dread_f(dset_idr4, h5kind_to_type(real_kind_7,H5_REAL_KIND), f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
    f_ptr = C_LOC(data_out_r15(1))
    CALL h5dread_f(dset_idr8, h5kind_to_type(real_kind_15,H5_REAL_KIND), f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
    f_ptr = C_LOC(data_out_r31(1))
    CALL h5dread_f(dset_idr16, h5kind_to_type(real_kind_31,H5_REAL_KIND), f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
    DO i = 1, 4

       CALL verify("h5kind_to_type",dset_data_i1(i),data_out_i1(i),total_error)
       CALL verify("h5kind_to_type",dset_data_i4(i),data_out_i4(i),total_error)
       CALL verify("h5kind_to_type",dset_data_i8(i),data_out_i8(i),total_error)
       CALL verify("h5kind_to_type",dset_data_i16(i),data_out_i16(i),total_error)

#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
       CALL verify("h5kind_to_type",dset_data_i32(i),data_out_i32(i),total_error)
#endif
       CALL verify("h5kind_to_type",dset_data_r(i),data_out_r(i),total_error)
       CALL verify("h5kind_to_type",dset_data_r7(i),data_out_r7(i),total_error)
       CALL verify("h5kind_to_type",dset_data_r15(i),data_out_r15(i),total_error)
       CALL verify("h5kind_to_type",dset_data_r31(i),data_out_r31(i),total_error)
    END DO

  !
  ! Close the dataset.
  !
    CALL h5dclose_f(dset_id1, error)
    CALL check("h5dclose_f",error, total_error)
    CALL h5dclose_f(dset_id4, error)
    CALL check("h5dclose_f",error, total_error)
    CALL h5dclose_f(dset_id8, error)
    CALL check("h5dclose_f",error, total_error)
    CALL h5dclose_f(dset_id16, error)
    CALL check("h5dclose_f",error, total_error)
    CALL h5dclose_f(dset_idr4, error)
    CALL check("h5dclose_f",error, total_error)
    CALL h5dclose_f(dset_idr8, error)
    CALL check("h5dclose_f",error, total_error)
  !
  ! Close the file.
  !
    CALL h5fclose_f(file_id, error)
    CALL check("h5fclose_f",error, total_error)

END SUBROUTINE test_h5kind_to_type

!************************************************************
!
!  This test reads and writes array datatypes
!  to a dataset.  The test first writes integers arrays of
!  dimension ADIM0xADIM1 to a dataset with a dataspace of
!  DIM0, then closes the  file.  Next, it reopens the file,
!  reads back the data.
!
!************************************************************
SUBROUTINE t_array(total_error)

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error

  CHARACTER(LEN=19), PARAMETER :: filename  = "t_array_F03.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"
  INTEGER          , PARAMETER :: dim0      = 4
  INTEGER          , PARAMETER :: adim0     = 3
  INTEGER          , PARAMETER :: adim1     = 5
  INTEGER(HID_T)  :: file, filetype, memtype, space, dset ! Handles
  INTEGER(HSIZE_T), DIMENSION(1:1)   :: dims = (/dim0/)
  INTEGER(HSIZE_T), DIMENSION(1:2)   :: adims = (/adim0, adim1/)
  INTEGER(HSIZE_T), DIMENSION(1:2)   :: maxdims
  INTEGER, DIMENSION(1:dim0, 1:adim0, 1:adim1), TARGET :: wdata ! Write buffer
  INTEGER, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: rdata    ! Read buffer
  INTEGER :: i, j, k
  TYPE(C_PTR) :: f_ptr
  INTEGER :: error ! Error flag

  !
  ! Initialize data.  i is the element in the dataspace, j and k the
  ! elements within the array datatype.
  !
  DO i = 1, dim0
     DO j = 1, adim0
        DO k = 1, adim1
           wdata(i,j,k) = (i-1)*(j-1)-(j-1)*(k-1)+(i-1)*(k-1)
        ENDDO
     ENDDO
  ENDDO
  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f",error, error)
  !
  ! Create array datatypes for file and memory.
  !
  CALL H5Tarray_create_f(INT(H5T_STD_I64LE, HID_T), 2, adims, filetype, error)
  CALL check("H5Tarray_create_f",error, total_error)
  CALL H5Tarray_create_f(H5T_NATIVE_INTEGER, 2, adims, memtype, error)
  CALL check("H5Tarray_create_f",error, total_error)
  !
  ! Create dataspace.  Setting maximum size to be the current size.
  !
  CALL h5screate_simple_f(1, dims, space, error)
  CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset and write the array data to it.
  !
  CALL h5dcreate_f(file, dataset, filetype, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)
  f_ptr = C_LOC(wdata)
  CALL h5dwrite_f(dset, memtype, f_ptr, error)
  CALL check("h5dwrite_f",error, total_error)
  !
  ! Close and release resources.
  !
  CALL H5Dclose_f(dset, error)
  CALL check("h5dclose_f",error, total_error)
  CALL H5Sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Tclose_f(filetype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL H5Tclose_f(memtype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL H5Fclose_f(file, error)
  CALL check("h5fclose_f",error, total_error)
  !
  ! Now we begin the read section of this example.
  !
  ! Open file, dataset, and attribute.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
  CALL check("h5fopen_f",error, total_error)
  CALL h5dopen_f(file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)
  !
  ! Get the datatype and its dimensions.
  !
  CALL h5dget_type_f(dset, filetype, error)
  CALL check("h5dget_type_f",error, error)
  CALL H5Tget_array_dims_f(filetype, adims, error)
  CALL check("h5dget_type_f",error, total_error)
  CALL VERIFY("H5Tget_array_dims_f", adims(1), INT(adim0,hsize_t), total_error)
  CALL VERIFY("H5Tget_array_dims_f", adims(2), INT(adim1,hsize_t), total_error)
  !
  ! Get dataspace and allocate memory for read buffer.  This is a
  ! three dimensional attribute when the array datatype is included.
  !
  CALL H5Dget_space_f(dset, space, error)
  CALL check("H5Dget_space_f",error, error)
  CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)

  ALLOCATE(rdata(1:dims(1),1:adims(1),1:adims(2)))
  !
  ! Create the memory datatype.
  !
  CALL H5Tarray_create_f(H5T_NATIVE_INTEGER, 2, adims, memtype, error)
  CALL check("H5Tarray_create_f",error, total_error)
  !
  ! Read the data.
  !

  f_ptr = C_LOC(rdata)
  CALL H5Dread_f(dset, memtype, f_ptr, error)
  CALL check("H5Dread_f",error, total_error)
  !
  ! Output the data to the screen.
  !
  i_loop: DO i = 1, INT(dims(1))
             DO j=1, INT(adim0)
                DO k = 1, INT(adim1)
                   CALL VERIFY("H5Sget_simple_extent_dims_f",  rdata(i,j,k), wdata(i,j,k), total_error)
                   IF(total_error.NE.0) EXIT i_loop
                ENDDO
             ENDDO
          ENDDO i_loop
  !
  ! Close and release resources.
  !
  DEALLOCATE(rdata)
  CALL H5Dclose_f(dset, error)
  CALL check("h5dclose_f",error, total_error)
  CALL H5Sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Tclose_f(filetype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL H5Tclose_f(memtype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL H5Fclose_f(file, error)
  CALL check("h5fclose_f",error, total_error)

END SUBROUTINE t_array

SUBROUTINE t_enum(total_error)

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error

  CHARACTER(LEN=19), PARAMETER :: filename  = "t_enum_F03.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"
  INTEGER          , PARAMETER :: dim0      = 4
  INTEGER          , PARAMETER :: dim1      = 7
  INTEGER(HID_T)               :: F_BASET  ! File base type
  INTEGER(HID_T)               :: M_BASET  ! Memory base type
  INTEGER(SIZE_T)  , PARAMETER :: NAME_BUF_SIZE = 16

! Enumerated type
  INTEGER, PARAMETER :: SOLID=0, PLASMA=3

  INTEGER(HID_T) :: file, filetype, memtype, space, dset ! Handles

  INTEGER(hsize_t),   DIMENSION(1:2) :: dims = (/dim0, dim1/)
  INTEGER, DIMENSION(1:dim0, 1:dim1), TARGET :: wdata ! Write buffer
  INTEGER, DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata ! Read buffer
  INTEGER, DIMENSION(1:1), TARGET :: val

  CHARACTER(LEN=6), DIMENSION(1:4) :: &
       names = (/"SOLID ", "LIQUID", "GAS   ", "PLASMA"/)
  CHARACTER(LEN=NAME_BUF_SIZE) :: name
  INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims
  INTEGER :: i, j, idx
  TYPE(C_PTR) :: f_ptr
  INTEGER :: error ! Error flag
  !
  ! Initialize DATA.
  !
  F_BASET   = H5T_STD_I16BE      ! File base type
  M_BASET   = H5T_NATIVE_INTEGER ! Memory base type
  DO i = 1, dim0
     DO j = 1, dim1
        wdata(i,j) = MOD( (j-1)*(i-1), PLASMA+1)
     ENDDO
  ENDDO
  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f",error, total_error)
  !
  ! Create the enumerated datatypes for file and memory.  This
  ! process is simplified IF native types are used for the file,
  ! as only one type must be defined.
  !
  CALL h5tenum_create_f(F_BASET, filetype, error)
  CALL check("h5tenum_create_f",error, total_error)

  CALL h5tenum_create_f(M_BASET, memtype, error)
  CALL check("h5tenum_create_f",error, total_error)

  DO i = SOLID, PLASMA
     !
     ! Insert enumerated value for memtype.
     !
     val(1) = i
     f_ptr = C_LOC(val(1))
     CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), f_ptr, error)
     CALL check("H5Tenum_insert_f", error, total_error)
     !
     ! Insert enumerated value for filetype.  We must first convert
     ! the numerical value val to the base type of the destination.
     !
     f_ptr = C_LOC(val(1))
     CALL H5Tconvert_f(M_BASET, F_BASET, INT(1,SIZE_T), f_ptr, error)
     CALL check("H5Tconvert_f",error, total_error)
     IF(i.GE.1)THEN ! test both F90 and F03 APIs
        CALL H5Tenum_insert_f(filetype, TRIM(names(i+1)), f_ptr, error)
     ELSE
        CALL H5Tenum_insert_f(filetype, TRIM(names(i+1)), val(1), error)
     ENDIF
     CALL check("H5Tenum_insert_f",error, total_error)
  ENDDO
  !
  ! Create dataspace.  Setting maximum size to be the current size.
  !
  CALL h5screate_simple_f(2, dims, space, total_error)
  CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset and write the enumerated data to it.
  !
  CALL h5dcreate_f(file, dataset, filetype, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)
  f_ptr = C_LOC(wdata(1,1))
  CALL h5dwrite_f(dset, memtype, f_ptr, error)
  CALL check("h5dwrite_f",error, total_error)
  !
  ! Close and release resources.
  !
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL h5tclose_f(filetype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)

  !
  ! Now we begin the read section of this example.
  !
  ! Open file and dataset.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
  CALL check("h5fopen_f",error, total_error)
  CALL h5dopen_f (file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)
  CALL h5dopen_f(file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)
  !
  ! Get dataspace and allocate memory for read buffer.
  !
  CALL h5dget_space_f(dset,space, error)
  CALL check("H5Dget_space_f",error, total_error)
  CALL h5sget_simple_extent_dims_f(space, dims, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", dims(2), INT(dim1,hsize_t), total_error)

  ALLOCATE(rdata(1:dims(1),1:dims(2)))

  !
  ! Read the data.
  !
  f_ptr = C_LOC(rdata(1,1))
  CALL h5dread_f(dset, memtype, f_ptr, error)
  CALL check("H5Dread_f",error, total_error)

  !
  ! Output the data to the screen.
  !
  i_loop: DO i = 1, INT(dims(1))
             DO j = 1, INT(dims(2))
                !
                ! Get the name of the enumeration member.
                !
                CALL h5tenum_nameof_f( memtype, rdata(i,j), NAME_BUF_SIZE, name, error)
                CALL check("h5tenum_nameof_f",error, total_error)
                idx = MOD( (j-1)*(i-1), PLASMA+1 ) + 1
                CALL verify("h5tenum_nameof_f",TRIM(name),TRIM(names(idx)), total_error)
                IF(total_error.NE.0) EXIT i_loop
             ENDDO
          ENDDO i_loop
  !
  ! Close and release resources.
  !
  DEALLOCATE(rdata)
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL h5tclose_f(memtype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)

END SUBROUTINE t_enum

SUBROUTINE t_bit(total_error)

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error

  CHARACTER(LEN=20), PARAMETER :: filename  = "t_bit_F03.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"
  INTEGER          , PARAMETER :: dim0      = 4
  INTEGER          , PARAMETER :: dim1      = 7

  INTEGER(HID_T)  :: file, space, dset ! Handles
  INTEGER(HSIZE_T), DIMENSION(1:2)   :: dims = (/dim0, dim1/)
  INTEGER(HSIZE_T), DIMENSION(1:2)   :: maxdims
  INTEGER(C_SIGNED_CHAR), DIMENSION(1:dim0, 1:dim1), TARGET :: wdata              ! Write buffer
  INTEGER(C_SIGNED_CHAR), DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata    ! Read buffer
  INTEGER :: A, B, C, D
  INTEGER :: Aw, Bw, Cw, Dw
  INTEGER :: i, j
  INTEGER, PARAMETER :: hex =  INT(Z'00000003')
  TYPE(C_PTR) :: f_ptr
  INTEGER :: error     ! Error flag
  !
  ! Initialize data.  We will manually pack 4 2-bit integers into
  ! each unsigned char data element.
  !
  DO i = 0, dim0-1
     DO j = 0, dim1-1
        wdata(i+1,j+1) = 0
        wdata(i+1,j+1) = IOR( wdata(i+1,j+1), INT(IAND(i * j - j, hex),C_SIGNED_CHAR) )   ! Field "A"
        wdata(i+1,j+1) = IOR( wdata(i+1,j+1), INT(ISHFT(IAND(i,hex),2),C_SIGNED_CHAR) )   ! Field "B"
        wdata(i+1,j+1) = IOR( wdata(i+1,j+1), INT(ISHFT(IAND(j,hex),4),C_SIGNED_CHAR) )   ! Field "C"
        wdata(i+1,j+1) = IOR( wdata(i+1,j+1), INT(ISHFT(IAND(i+j,hex),6),C_SIGNED_CHAR) ) ! Field "D"
     ENDDO
  ENDDO
  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f",error, total_error)
  !
  ! Create dataspace.  Setting maximum size to be the current size.
  !
  CALL h5screate_simple_f(2, dims, space, error)
  CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset and write the bitfield data to it.
  !
  CALL H5Dcreate_f(file, dataset, H5T_STD_B8BE, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)
  f_ptr = C_LOC(wdata(1,1))
  CALL H5Dwrite_f(dset, H5T_NATIVE_B8, f_ptr, error)
  CALL check("h5dwrite_f",error, total_error)
  !
  ! Close and release resources.
  !
  CALL H5Dclose_f(dset, error)
  CALL check("h5dclose_f",error, total_error)
  CALL H5Sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Fclose_f(file, error)
  CALL check("h5fclose_f",error, total_error)
  !
  ! Now we begin the read section of this example.
  !
  ! Open file, dataset.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
  CALL check("h5fopen_f",error, total_error)
  CALL h5dopen_f(file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)
  !
  ! Get dataspace and allocate memory for read buffer.
  !
  CALL H5Dget_space_f(dset, space, error)
  CALL check("H5Dget_space_f",error, total_error)
  CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", dims(2), INT(dim1,hsize_t), total_error)
  ALLOCATE(rdata(1:dims(1),1:dims(2)))
  !
  ! Read the data.
  !
  f_ptr = C_LOC(rdata)
  CALL H5Dread_f(dset,  H5T_NATIVE_B8, f_ptr, error)
  CALL check("H5Dread_f",error, total_error)
  !
  ! Output the data to the screen.
  !
  i_loop: DO i = 1, INT(dims(1))
            DO j = 1, INT(dims(2))
               A = IAND(rdata(i,j), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "A"
               B = IAND(ISHFT(rdata(i,j),-2), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "B"
               C = IAND(ISHFT(rdata(i,j),-4), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "C"
               D = IAND(ISHFT(rdata(i,j),-6), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "D"

               Aw = IAND(wdata(i,j), INT(hex,C_SIGNED_CHAR))
               Bw = IAND(ISHFT(wdata(i,j),-2), INT(hex,C_SIGNED_CHAR))
               Cw = IAND(ISHFT(wdata(i,j),-4), INT(hex,C_SIGNED_CHAR))
               Dw = IAND(ISHFT(wdata(i,j),-6), INT(hex,C_SIGNED_CHAR))

               CALL VERIFY("bitfield", A, Aw, total_error)
               CALL VERIFY("bitfield", B, Bw, total_error)
               CALL VERIFY("bitfield", C, Cw, total_error)
               CALL VERIFY("bitfield", D, Dw, total_error)
               IF(total_error.NE.0) EXIT i_loop
            ENDDO
         ENDDO i_loop
  !
  ! Close and release resources.
  !
  DEALLOCATE(rdata)
  CALL H5Dclose_f(dset, error)
  CALL check("h5dclose_f",error, total_error)
  CALL H5Sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Fclose_f(file, error)
  CALL check("h5fclose_f",error, total_error)

END SUBROUTINE t_bit

SUBROUTINE t_opaque(total_error)

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error
  CHARACTER(LEN=20), PARAMETER :: filename  = "t_opaque_F03.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"
  INTEGER          , PARAMETER :: dim0      = 4
  INTEGER(SIZE_T)  , PARAMETER :: size      = 7
  INTEGER(HID_T)  :: file, space, dtype, dset ! Handles
  INTEGER(size_t) :: len
  INTEGER(hsize_t),   DIMENSION(1:1) :: dims = (/DIM0/)

  CHARACTER(LEN=size), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer
  CHARACTER(LEN=size), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer
  CHARACTER(LEN=size-1) :: str = "OPAQUE"

  CHARACTER(LEN=14) :: tag_sm    ! Test reading obaque tag into
  CHARACTER(LEN=15) :: tag_exact ! buffers that are: to small, exact
  CHARACTER(LEN=17) :: tag_big   ! and to big.

  INTEGER :: taglen
  INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims
  INTEGER(hsize_t) :: i
  CHARACTER(LEN=1) :: ichr
  TYPE(C_PTR) :: f_ptr
  INTEGER :: error
  !
  ! Initialize data.
  !
  DO i = 1, dim0
     WRITE(ichr,'(I1)') i-1
     wdata(i) = str//ichr
  ENDDO
  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f",error, total_error)
  !
  ! Create opaque datatype and set the tag to something appropriate.
  ! For this example we will write and view the data as a character
  ! array.
  !
  CALL h5tcreate_f(h5T_OPAQUE_F, size, dtype, error)
  CALL check("h5tcreate_f",error, total_error)
  CALL h5tset_tag_f(dtype,"Character array",error)
  CALL check("h5tset_tag_f",error, total_error)
  !
  ! Create dataspace.  Setting maximum size to be the current size.
  !
  CALL h5screate_simple_f(1, dims, space, error)
  CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset and write the opaque data to it.
  !
  CALL h5dcreate_f(file, dataset, dtype, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)
  f_ptr = C_LOC(wdata(1)(1:1))
  CALL h5dwrite_f(dset, dtype, f_ptr, error)
  CALL check("h5dwrite_f",error, total_error)
  !
  ! Close and release resources.
  !
  CALL H5Dclose_f(dset, error)
  CALL check("h5dclose_f",error, total_error)
  CALL H5Sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Tclose_f(dtype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL H5Fclose_f(file, error)
  CALL check("h5fclose_f",error, total_error)
  !
  ! Now we begin the read section of this example.
  !
  ! Open file and dataset.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
  CALL check("h5fopen_f",error, total_error)
  CALL h5dopen_f(file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)
  !
  ! Get datatype and properties for the datatype.
  !
  CALL h5dget_type_f(dset, dtype, error)
  CALL check("h5dget_type_f",error, total_error)
  CALL h5tget_size_f(dtype, len, error)
  CALL check("h5tget_size_f",error, total_error)

  ! Next tests should return
  ! opaque_tag = tag = "Character array" and the actual length = 15

  ! Test reading into a string that is to small
  CALL h5tget_tag_f(dtype, tag_sm, taglen, error)
  CALL check("h5tget_tag_f",error, total_error)
  CALL VERIFY("h5tget_tag_f", taglen, 15, total_error)
  CALL verify("h5tget_tag_f",tag_sm,"Character arra", total_error)

  ! Test reading into a string that is exact
  CALL h5tget_tag_f(dtype, tag_exact, taglen, error)
  CALL check("h5tget_tag_f",error, total_error)
  CALL VERIFY("h5tget_tag_f", taglen, 15, total_error)
  CALL verify("h5tget_tag_f",tag_exact,"Character array", total_error)

  ! Test reading into a string that is to big
  CALL h5tget_tag_f(dtype, tag_big, taglen, error)
  CALL check("h5tget_tag_f",error, total_error)
  CALL VERIFY("h5tget_tag_f", taglen, 15, total_error)
  CALL verify("h5tget_tag_f",tag_big,"Character array  ", total_error)

  !
  ! Get dataspace and allocate memory for read buffer.
  !
  CALL h5dget_space_f(dset, space, error)
  CALL check("H5Dget_space_f",error, total_error)
  CALL h5sget_simple_extent_dims_f(space, dims, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
  ALLOCATE(rdata(1:dims(1)))
  !
  ! Read the data.
  !
  f_ptr = C_LOC(rdata(1)(1:1))
  CALL h5dread_f(dset, dtype, f_ptr, error)
  CALL check("H5Dread_f",error, total_error)
  !
  DO i = 1, dims(1)
     CALL verify("t_opaque",TRIM(rdata(i)),TRIM(wdata(i)), total_error)
  ENDDO
  !
  ! Close and release resources.
  !
  DEALLOCATE(rdata)
  CALL H5Dclose_f(dset, error)
  CALL check("h5dclose_f",error, total_error)
  CALL H5Sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Tclose_f(dtype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL H5Fclose_f(file, error)
  CALL check("h5fclose_f",error, total_error)

END SUBROUTINE t_opaque

SUBROUTINE t_objref(total_error)

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error
  CHARACTER(LEN=20), PARAMETER :: filename  = "t_objref_F03.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"
  INTEGER          , PARAMETER :: dim0      = 2

  INTEGER(HID_T)  :: file, space, dset, obj ! Handles
  INTEGER :: error

  INTEGER(hsize_t),   DIMENSION(1:1) :: dims = (/dim0/)
  TYPE(hobj_ref_t_f), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer
  TYPE(hobj_ref_t_f), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer
  INTEGER :: objtype
  INTEGER(SIZE_T) :: name_size
  CHARACTER(LEN=80) :: name
  INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims
  INTEGER :: i
  TYPE(C_PTR) :: f_ptr
  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f",error, total_error)
  !
  ! Create a dataset with a null dataspace.
  !
  CALL h5screate_f(H5S_NULL_F,space,error)
  CALL check("h5screate_f",error, total_error)
  CALL h5dcreate_f(file, "DS2", H5T_STD_I32LE, space, obj, error)
  CALL check("h5dcreate_f",error, total_error)
  !
  CALL h5dclose_f(obj  , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  !
  ! Create a group.
  !
  CALL h5gcreate_f(file, "G1", obj, error)
  CALL check("h5gcreate_f",error, total_error)
  CALL h5gclose_f(obj, error)
  CALL check("h5gclose_f",error, total_error)
  !
  ! Create references to the previously created objects. note, space_id
  ! is not needed for object references.
  !
  f_ptr = C_LOC(wdata(1))
  CALL H5Rcreate_f(file, "G1", H5R_OBJECT_F, f_ptr, error)
  CALL check("H5Rcreate_f",error, total_error)
  f_ptr = C_LOC(wdata(2))
  CALL H5Rcreate_f(file, "DS2", H5R_OBJECT_F, f_ptr, error)
  CALL check("H5Rcreate_f",error, total_error)
  !
  ! Create dataspace.  Setting maximum size to be the current size.
  !
  CALL h5screate_simple_f(1, dims, space, error)
  CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset and write the object references to it.
  !
  CALL h5dcreate_f(file, dataset, H5T_STD_REF_OBJ, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)

  f_ptr = C_LOC(wdata(1))
  CALL h5dwrite_f(dset, H5T_STD_REF_OBJ, f_ptr, error)
  CALL check("h5dwrite_f",error, total_error)
  !
  ! Close and release resources.
  !
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)
  !
  ! Now we begin the read section of this example.
  !
  ! Open file and dataset.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
  CALL check("h5fopen_f",error, total_error)
  CALL h5dopen_f(file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)
  !
  ! Get dataspace and allocate memory for read buffer.
  !
  CALL h5dget_space_f(dset, space, error)
  CALL check("H5Dget_space_f",error, total_error)
  CALL h5sget_simple_extent_dims_f(space, dims, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)

  ALLOCATE(rdata(1:maxdims(1)))
  !
  ! Read the data.
  !
  f_ptr = C_LOC(rdata(1))
  CALL h5dread_f( dset, H5T_STD_REF_OBJ, f_ptr, error)
  CALL check("H5Dread_f",error, total_error)
  !
  ! Output the data to the screen.
  !
  DO i = 1, INT(maxdims(1))
     !
     ! Open the referenced object, get its name and type.
     !
     f_ptr = C_LOC(rdata(i))
     CALL H5Rdereference_f(dset, H5R_OBJECT_F, f_ptr, obj, error)
     CALL check("H5Rdereference_f",error, total_error)
     CALL H5Rget_obj_type_f(dset, H5R_OBJECT_F, f_ptr, objtype, error)
     CALL check("H5Rget_obj_type_f",error, total_error)
     !
     ! Get the length of the name and name
     !
     name(:) = ' ' ! initialize string to blanks
     CALL H5Iget_name_f(obj, name, 80_size_t, name_size, error)
     CALL check("H5Iget_name_f",error, total_error)
     !
     ! Print the object type and close the object.
     !
     IF(objtype.EQ.H5G_GROUP_F)THEN
        CALL verify("t_objref", name(1:name_size),"/G1", total_error)
     ELSE IF(objtype.EQ.H5G_DATASET_F)THEN
        CALL verify("t_objref", name(1:name_size),"/DS2", total_error)
     ELSE
        total_error = total_error + 1
     ENDIF
     CALL h5oclose_f(obj, error)
     CALL check("h5oclose_f",error, total_error)

  END DO
  !
  ! Close and release resources.
  !
  DEALLOCATE(rdata)
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)

END SUBROUTINE t_objref


SUBROUTINE t_regref(total_error)

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error
  CHARACTER(LEN=22), PARAMETER :: filename  = "t_regref_F03.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"
  CHARACTER(LEN=3) , PARAMETER :: dataset2  = "DS2"
  INTEGER          , PARAMETER :: dim0      = 2
  INTEGER          , PARAMETER :: ds2dim0   = 16
  INTEGER          , PARAMETER :: ds2dim1   = 3

  INTEGER(HID_T)  :: file, memspace, space, dset, dset2 ! Handles
  INTEGER :: error

  INTEGER(HSIZE_T), DIMENSION(1:1)   :: dims = (/dim0/)
  INTEGER(HSIZE_T), DIMENSION(1:1)   :: dims3
  INTEGER(HSIZE_T), DIMENSION(1:2)   :: dims2 = (/ds2dim0,ds2dim1/)

  INTEGER(HSIZE_T), DIMENSION(1:2,1:4) :: coords = RESHAPE((/2,1,12,3,1,2,5,3/),(/2,4/))

  INTEGER(HSIZE_T), DIMENSION(1:2) :: start=(/0,0/),stride=(/11,2/),count=(/2,2/), BLOCK=(/3,1/)

  INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims
  INTEGER(hssize_t) :: npoints
  TYPE(hdset_reg_ref_t_f03), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer
  TYPE(hdset_reg_ref_t_f03), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer

  INTEGER(size_t) :: size
  CHARACTER(LEN=1), DIMENSION(1:ds2dim0,1:ds2dim1), TARGET :: wdata2

  CHARACTER(LEN=80),DIMENSION(1:1), TARGET :: rdata2
  CHARACTER(LEN=80) :: name
  INTEGER(hsize_t) :: i
  TYPE(C_PTR) :: f_ptr
  CHARACTER(LEN=ds2dim0) :: chrvar
  CHARACTER(LEN=20), DIMENSION(1:2) :: chrref_correct

  chrvar = "The quick brown "
  READ(chrvar,'(16A1)') wdata2(1:16,1)
  chrvar = "fox jumps over  "
  READ(chrvar,'(16A1)') wdata2(1:16,2)
  chrvar = "the 5 lazy dogs "
  READ(chrvar,'(16A1)') wdata2(1:16,3)

  chrref_correct(1) = 'hdf5'
  chrref_correct(2) = 'Therowthedog'

  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f",error, total_error)
  !
  ! Create a dataset with character data.
  !
  CALL h5screate_simple_f(2, dims2, space, error)
  CALL check("h5screate_simple_f",error, total_error)
  CALL h5dcreate_f(file,dataset2, H5T_STD_I8LE, space, dset2, error)
  CALL check("h5dcreate_f",error, total_error)
  f_ptr = C_LOC(wdata2(1,1))
  CALL h5dwrite_f(dset2, H5T_NATIVE_INTEGER_KIND(1), f_ptr, error)
  CALL check("h5dwrite_f",error, total_error)
  !
  ! Create reference to a list of elements in dset2.
  !
  CALL h5sselect_elements_f(space, H5S_SELECT_SET_F, 2, INT(4,size_t), coords, error)
  CALL check("h5sselect_elements_f",error, total_error)
  f_ptr = C_LOC(wdata(1))
  CALL h5rcreate_f(file, DATASET2, H5R_DATASET_REGION_F, f_ptr, error, space)
  CALL check("h5rcreate_f",error, total_error)
  !
  ! Create reference to a hyperslab in dset2, close dataspace.
  !
  CALL h5sselect_hyperslab_f (space, H5S_SELECT_SET_F, start, count, error, stride, block)
  CALL check("h5sselect_hyperslab_f",error, total_error)
  f_ptr = C_LOC(wdata(2))
  CALL h5rcreate_f(file, DATASET2, H5R_DATASET_REGION_F, f_ptr, error, space)
  CALL check("h5rcreate_f",error, total_error)

  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  !
  ! Create dataspace.  Setting maximum size to the current size.
  !
  CALL h5screate_simple_f(1, dims, space, error)
  CALL check("h5screate_simple_f",error, total_error)

  !
  ! Create the dataset and write the region references to it.
  !
  CALL h5dcreate_f(file, dataset, H5T_STD_REF_DSETREG, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)
  f_ptr = C_LOC(wdata(1))
  CALL h5dwrite_f(dset, H5T_STD_REF_DSETREG, f_ptr, error)
  CALL check("h5dwrite_f",error, total_error)
  !
  ! Close and release resources.
  !
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5dclose_f(dset2, error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)
  !
  ! Now we begin the read section of this example.
  !
  !
  ! Open file and dataset.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
  CALL check("h5fopen_f",error, total_error)
  CALL h5dopen_f(file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)
  !
  ! Get dataspace and allocate memory for read buffer.
  !
  CALL h5dget_space_f(dset, space, error)
  CALL check("H5Dget_space_f",error, total_error)
  CALL h5sget_simple_extent_dims_f(space, dims, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
  ALLOCATE(rdata(1:dims(1)))
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  !
  ! Read the data.
  !
  f_ptr = C_LOC(rdata(1))
  CALL h5dread_f( dset, H5T_STD_REF_DSETREG, f_ptr, error)
  CALL check("H5Dread_f",error, total_error)
  !
  ! Output the data to the screen.
  !
  DO i = 1, dims(1)

     !
     ! Open the referenced object, retrieve its region as a
     ! dataspace selection.
     !
     f_ptr = C_LOC(rdata(i))
     CALL H5Rdereference_f(dset, H5R_DATASET_REGION_F, f_ptr, dset2, error)
     CALL check("H5Rdereference_f",error, total_error)

     CALL H5Rget_region_f(dset, f_ptr, space, error)
     CALL check("H5Rget_region_f",error, total_error)

     !
     ! Get the object's name
     !
     name(:) = ' ' ! initialize string to blanks
     CALL H5Iget_name_f(dset2, name, 80_size_t, size, error)
     CALL check("H5Iget_name_f",error, total_error)
     CALL VERIFY("H5Iget_name_f", INT(size), LEN_TRIM(name), total_error)
     CALL verify("H5Iget_name_f",name(1:size),TRIM(name), total_error)
     !
     ! Allocate space for the read buffer.
     !
     CALL H5Sget_select_npoints_f(space, npoints, error)
     CALL check("H5Sget_select_npoints_f",error, total_error)
     CALL VERIFY("H5Sget_select_npoints_f", INT(npoints), LEN_TRIM(chrref_correct(i)), total_error)

     dims3(1) = npoints
     !
     ! Read the dataset region.
     !
     CALL h5screate_simple_f(1, dims3, memspace, error)
     CALL check("h5screate_simple_f",error, total_error)

     f_ptr = C_LOC(rdata2(1)(1:1))
     CALL h5dread_f( dset2, H5T_NATIVE_INTEGER_KIND(1), f_ptr, error, memspace, space)
     CALL check("H5Dread_f",error, total_error)
     CALL verify("h5dread_f",rdata2(1)(1:npoints),TRIM(chrref_correct(i)), total_error)

     CALL H5Sclose_f(space, error)
     CALL check("h5sclose_f",error, total_error)
     CALL H5Sclose_f(memspace, error)
     CALL check("h5sclose_f",error, total_error)
     CALL H5Dclose_f(dset2, error)
     CALL check("h5dclose_f",error, total_error)

  END DO
  !
  ! Close and release resources.
  !
  DEALLOCATE(rdata)
  CALL H5Dclose_f(dset, error)
  CALL check("h5dclose_f",error, total_error)
  CALL H5Fclose_f(file, error)
  CALL check("h5fclose_f",error, total_error)

END SUBROUTINE t_regref

SUBROUTINE t_vlen(total_error)

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error
  CHARACTER(LEN=18), PARAMETER :: filename  = "t_vlen_F03.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"
  INTEGER, PARAMETER :: LEN0 = 3
  INTEGER, PARAMETER :: LEN1 = 12
  INTEGER(hsize_t) :: dim0

  INTEGER(HID_T)  :: file, filetype, memtype, space, dset ! Handles
  INTEGER :: error
  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, TARGET :: 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 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, INT(wdata(1)%len)
     ptr(1)%data(i) = INT(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, INT(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, error)
  CALL check("h5fcreate_f",error, total_error)
  !
  ! Create variable-length datatype for file and memory.
  !
  CALL H5Tvlen_create_f(H5T_STD_I32LE, filetype, error)
  CALL check("H5Tvlen_create_f",error, total_error)
  CALL H5Tvlen_create_f(H5T_NATIVE_INTEGER, memtype, error)
  CALL check("H5Tvlen_create_f",error, total_error)
  !
  ! Create dataspace.
  !
  CALL h5screate_simple_f(1, dims, space, error)
  CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset and write the variable-length data to it.
  !
  CALL H5Dcreate_f(file, dataset, filetype, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)

  f_ptr = C_LOC(wdata(1))
  CALL h5dwrite_f(dset, memtype, f_ptr, error)
  CALL check("h5dwrite_f",error, total_error)
  !
  ! Close and release resources.  Note the use of H5Dvlen_reclaim
  ! removes the need to manually deallocate the previously allocated
  ! data.
  !

  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Tclose_f(filetype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL H5Tclose_f(memtype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)

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

  !
  ! Open file and dataset.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
  CALL check("h5fopen_f",error, total_error)
  CALL h5dopen_f(file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)

  !
  ! 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 H5Dget_space_f(dset, space, error)
  CALL check("H5Dget_space_f",error, total_error)
  dim0 = dims(1)
  CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), INT(dim0), total_error)

  !
  ! Create the memory datatype.
  !
  CALL H5Tvlen_create_f(H5T_NATIVE_INTEGER, memtype, error)
  CALL check("H5Tvlen_create_f",error, total_error)

  !
  ! Read the data.
  !
  f_ptr = C_LOC(rdata(1))
  CALL H5Dread_f(dset, memtype, f_ptr, error)
  CALL check("H5Dread_f",error, total_error)

  DO i = 1, INT(dims(1))
     CALL c_f_pointer(rdata(i)%p, ptr_r, [rdata(i)%len] )
     DO j = 1, INT(rdata(i)%len)
        CALL VERIFY("t_vlen", ptr_r(j), ptr(i)%data(j), total_error)
     ENDDO
  ENDDO
  !
  ! Close and release resources.
  !
  DEALLOCATE(ptr)
  CALL h5dvlen_reclaim_f(memtype, space, H5P_DEFAULT_F, f_ptr, error)
  CALL h5dclose_f(dset, error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Tclose_f(memtype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL h5fclose_f(file, error)
  CALL check("h5fclose_f",error, total_error)

END SUBROUTINE t_vlen


SUBROUTINE t_vlstring(total_error)

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error

  CHARACTER(LEN=18), PARAMETER :: filename  = "t_vlstring.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"

  INTEGER(SIZE_T), PARAMETER :: dim0      = 4
  INTEGER(SIZE_T), PARAMETER :: sdim      = 7
  INTEGER(HID_T)  :: file, filetype, space, dset ! Handles
  INTEGER :: error
  INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/)
  INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims

  CHARACTER(LEN=sdim), DIMENSION(1:dim0), TARGET :: &
       wdata = (/"Parting", "is such", "sweet  ", "sorrow."/) ! Write buffer
  CHARACTER(LEN=sdim), DIMENSION(:), ALLOCATABLE :: rdata ! Read buffer
  INTEGER(HSIZE_T), DIMENSION(2) :: data_dims = (/sdim,dim0/)
  INTEGER(SIZE_T), DIMENSION(4) :: str_len = (/7,7,5,7/)
  INTEGER(hsize_t) :: i

  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f",error, total_error)
  !
  ! Create file and memory datatypes.  For this example we will save
  ! the strings as C variable length strings, H5T_STRING is defined
  ! as a variable length string.
  !
  CALL H5Tcopy_f(H5T_STRING, filetype, error)
  CALL check("H5Tcopy_f",error, total_error)
  CALL H5Tset_strpad_f(filetype, H5T_STR_NULLPAD_F, error)
  CALL check("H5Tset_strpad_f",error, total_error)
  !
  ! Create dataspace.
  !
  CALL h5screate_simple_f(1, dims, space, error)
  CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset and write the variable-length string data to
  ! it.
  !
  CALL h5dcreate_f(file, dataset, filetype, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)

  CALL h5dwrite_vl_f(dset, filetype, wdata, data_dims, str_len, error, space)
  CALL check("h5dwrite_vl_f",error, total_error)

  !
  ! Close and release resources.
  !
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Tclose_f(filetype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)

  !
  ! Now we begin the read section of this example.
  !
  !
  ! Open file and dataset.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
  CALL check("h5fopen_f",error, total_error)
  CALL h5dopen_f(file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)
  !
  ! Get the datatype.
  !
  CALL H5Dget_type_f(dset, filetype, error)
  CALL check("H5Dget_type_f",error, total_error)
  !
  ! Get dataspace and allocate memory for read buffer.
  !
  CALL H5Dget_space_f(dset, space, error)
  CALL check("H5Dget_space_f",error, total_error)
  CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), INT(dim0), total_error)

  ALLOCATE(rdata(1:dims(1)))

  !
  ! Read the data.
  !
  CALL h5dread_vl_f(dset, filetype, rdata, data_dims, str_len, error, space)
  CALL check("H5Dread_vl_f",error, total_error)

  !
  ! Output the data to the screen.
  !
  DO i = 1, dims(1)
     CALL verify("h5dopen_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
  END DO

  DEALLOCATE(rdata)
  CALL h5dclose_f(dset, error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Tclose_f(filetype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)

END SUBROUTINE t_vlstring

SUBROUTINE t_vlstring_readwrite(total_error)

! test writing and reading vl string using h5dread_f and h5dwrite_f, C_LOC and C_F_POINTER

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error

  CHARACTER(LEN=19), PARAMETER :: filename  = "t_vlstringrw_F03.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"
  CHARACTER(LEN=3) , PARAMETER :: dataset2D = "DS2"

  INTEGER(HSIZE_T) , PARAMETER :: dim0 = 4
  INTEGER(HSIZE_T) , PARAMETER :: dim1 = 2
  INTEGER(HID_T)               :: file, filetype, space, dset ! Handles
  INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/)
  INTEGER(HSIZE_T), DIMENSION(1:2) :: dims2D = (/dim1,dim0/)
  INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims

  TYPE(C_PTR), DIMENSION(1:dim0), TARGET :: wdata
  CHARACTER(len=7, KIND=c_char), DIMENSION(1:1), TARGET :: A = "123456"//C_NULL_CHAR
  CHARACTER(len=5, KIND=c_char), DIMENSION(1:1), TARGET :: B = "7890"//C_NULL_CHAR
  CHARACTER(len=4, KIND=c_char), DIMENSION(1:1), TARGET :: C = "abc"//C_NULL_CHAR
  CHARACTER(len=3, KIND=c_char), DIMENSION(1:1), TARGET :: D = "df"//C_NULL_CHAR

  TYPE(C_PTR), DIMENSION(1:dim1,1:dim0), TARGET :: wdata2D

  CHARACTER(len=7, KIND=c_char), DIMENSION(1:1), TARGET :: A11 = "A(1,1)"//C_NULL_CHAR
  CHARACTER(len=4, KIND=c_char), DIMENSION(1:1), TARGET :: A12 = "A12"//C_NULL_CHAR
  CHARACTER(len=5, KIND=c_char), DIMENSION(1:1), TARGET :: A13 = "A_13"//C_NULL_CHAR
  CHARACTER(len=8, KIND=c_char), DIMENSION(1:1), TARGET :: A14 = "A_{1,4}"//C_NULL_CHAR
  CHARACTER(len=8, KIND=c_char), DIMENSION(1:1), TARGET :: A21 = "A_{2,1}"//C_NULL_CHAR
  CHARACTER(len=5, KIND=c_char), DIMENSION(1:1), TARGET :: A22 = "A_22"//C_NULL_CHAR
  CHARACTER(len=4, KIND=c_char), DIMENSION(1:1), TARGET :: A23 = "A23"//C_NULL_CHAR
  CHARACTER(len=7, KIND=c_char), DIMENSION(1:1), TARGET :: A24 = "A(2,4)"//C_NULL_CHAR

  TYPE(C_PTR), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer
  TYPE(C_PTR), DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata2D ! Read 2D buffer
  CHARACTER(len=8, kind=c_char), POINTER :: data ! A pointer to a Fortran string
  CHARACTER(len=8, kind=c_char), DIMENSION(1:4) :: data_w ! A pointer to a Fortran string
  CHARACTER(len=8, kind=c_char), DIMENSION(1:dim1,1:dim0) :: data2D_w ! A pointer to a Fortran string
  TYPE(C_PTR) :: f_ptr
  INTEGER(hsize_t) :: i, j
  INTEGER :: len
  INTEGER :: error

  ! Initialize array of C pointers

  wdata(1) = C_LOC(A(1)(1:1))
  wdata(2) = C_LOC(B(1)(1:1))
  wdata(3) = C_LOC(C(1)(1:1))
  wdata(4) = C_LOC(D(1)(1:1))

  data_w(1) = A(1)
  data_w(2) = B(1)
  data_w(3) = C(1)
  data_w(4) = D(1)

  wdata2D(1,1) = C_LOC(A11(1)(1:1))
  wdata2D(1,2) = C_LOC(A12(1)(1:1))
  wdata2D(1,3) = C_LOC(A13(1)(1:1))
  wdata2D(1,4) = C_LOC(A14(1)(1:1))
  wdata2D(2,1) = C_LOC(A21(1)(1:1))
  wdata2D(2,2) = C_LOC(A22(1)(1:1))
  wdata2D(2,3) = C_LOC(A23(1)(1:1))
  wdata2D(2,4) = C_LOC(A24(1)(1:1))

  data2D_w(1,1) = A11(1)
  data2D_w(1,2) = A12(1)
  data2D_w(1,3) = A13(1)
  data2D_w(1,4) = A14(1)
  data2D_w(2,1) = A21(1)
  data2D_w(2,2) = A22(1)
  data2D_w(2,3) = A23(1)
  data2D_w(2,4) = A24(1)

  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f",error, total_error)
  !
  ! Create file and memory datatypes.  For this test we will save
  ! the strings as C variable length strings, H5T_STRING is defined
  ! as a variable length string.
  !
  CALL H5Tcopy_f(H5T_STRING, filetype, error)
  CALL check("H5Tcopy_f",error, total_error)
  !
  ! Create dataspace.
  !
  CALL h5screate_simple_f(1, dims, space, error)
  CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset and write the variable-length string data to
  ! it.
  !
  CALL h5dcreate_f(file, dataset, filetype, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)

  f_ptr = C_LOC(wdata(1))
  CALL h5dwrite_f(dset, filetype, f_ptr, error)
  CALL check("h5dwrite_f",error, total_error)

  !
  ! Close and release resources.
  !
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)

  !
  ! Create dataspace.
  !
  CALL h5screate_simple_f(2, dims2D, space, error)
  CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset and write the variable-length string data to
  ! it.
  !
  CALL h5dcreate_f(file, dataset2D, filetype, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)

  f_ptr = C_LOC(wdata2D(1,1))
  CALL h5dwrite_f(dset, filetype, f_ptr, error)
  CALL check("h5dwrite_f",error, total_error)

  !
  ! Close and release resources.
  !
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)

  CALL H5Tclose_f(filetype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)

  !
  ! Now we begin the read section of this test.
  !
  !
  ! Open file and dataset.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
  CALL check("h5fopen_f",error, total_error)
  CALL h5dopen_f(file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)
  !
  ! Get the datatype.
  !
  CALL H5Dget_type_f(dset, filetype, error)
  CALL check("H5Dget_type_f",error, total_error)
  !
  ! Get dataspace and allocate memory for read buffer.
  !
  CALL H5Dget_space_f(dset, space, error)
  CALL check("H5Dget_space_f",error, total_error)

  CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  ALLOCATE(rdata(1:dims(1)))
  !
  ! Read the data.
  !

  f_ptr = C_LOC(rdata(1))
  CALL h5dread_f(dset, H5T_STRING, f_ptr, error)
  CALL check("H5Dread_f",error, total_error)

  !
  ! Check the data.
  !
  DO i = 1, dims(1)
     CALL C_F_POINTER(rdata(i), data)
     len = 0
     DO
        IF(DATA(len+1:len+1).EQ.C_NULL_CHAR.OR.len.GE.8) EXIT
        len = len + 1
     ENDDO
     CALL verify("h5dread_f",data(1:len), data_w(i)(1:len), total_error)
  END DO

  DEALLOCATE(rdata)
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  !
  ! Test reading in 2D dataset
  !
  CALL h5dopen_f(file, dataset2D, dset, error)
  CALL check("h5dopen_f",error, total_error)
  !
  ! Get the datatype.
  !
  CALL H5Dget_type_f(dset, filetype, error)
  CALL check("H5Dget_type_f",error, total_error)
  !
  ! Get dataspace and allocate memory for read buffer.
  !
  CALL H5Dget_space_f(dset, space, error)
  CALL check("H5Dget_space_f",error, total_error)


  CALL H5Sget_simple_extent_dims_f(space, dims2D, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  ALLOCATE(rdata2D(1:dims2D(1),1:dims2D(2)))

  !
  ! Read the data.
  !

  f_ptr = C_LOC(rdata2D(1,1))
  CALL h5dread_f(dset, H5T_STRING, f_ptr, error)
  CALL check("H5Dread_f",error, total_error)

  !
  ! Check the data.
  !
  DO i = 1, dims2D(1)
     DO j = 1, dims2D(2)
        CALL C_F_POINTER(rdata2D(i,j), DATA)
        len = 0
        DO
           IF(DATA(len+1:len+1).EQ.C_NULL_CHAR.OR.len.GE.8) EXIT
           len = len + 1
        ENDDO
        CALL verify("h5dread_f",DATA(1:len), data2D_w(i,j)(1:len), total_error)
     ENDDO
  END DO

  DEALLOCATE(rdata2D)
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)

  CALL H5Tclose_f(filetype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)

END SUBROUTINE t_vlstring_readwrite


SUBROUTINE t_string(total_error)

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error

  CHARACTER(LEN=20), PARAMETER :: filename  = "t_string_F03.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset   = "DS1"
  INTEGER          , PARAMETER :: dim0      = 4
  INTEGER(SIZE_T)  , PARAMETER :: sdim      = 8

  INTEGER(HID_T)  :: file, filetype, memtype, space, dset ! Handles
  INTEGER :: error

  INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/)
  INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims

  CHARACTER(LEN=sdim), DIMENSION(1:dim0), TARGET :: &
       wdata = (/"Parting", "is such", "sweet  ", "sorrow."/)
  CHARACTER(LEN=sdim), DIMENSION(:), ALLOCATABLE, TARGET :: rdata
  INTEGER(hsize_t) :: i
  INTEGER(SIZE_T) :: size
  TYPE(C_PTR) :: f_ptr
  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f",error, total_error)
  !
  ! Create file datatypes.  For this example we will save
  ! the strings as FORTRAN strings
  !
  CALL H5Tcopy_f(H5T_FORTRAN_S1, filetype, error)
  CALL check("H5Tcopy_f",error, total_error)
  CALL H5Tset_size_f(filetype, sdim, error)
  CALL check("H5Tset_size_f",error, total_error)
  !
  ! Create dataspace.
  !
  CALL h5screate_simple_f(1, dims, space, error)
  CALL check("h5screate_simple_f",error, total_error)
  !
  ! Create the dataset and write the string data to it.
  !
  CALL h5dcreate_f(file, dataset, filetype, space, dset, error)
  CALL check("h5dcreate_f",error, total_error)

  f_ptr = C_LOC(wdata(1)(1:1))
  CALL H5Dwrite_f(dset, filetype, f_ptr, error)
  CALL check("H5Dwrite_f",error, total_error)
  !
  ! Close and release resources.
  !
  CALL h5dclose_f(dset , error)
  CALL check("h5dclose_f",error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Tclose_f(filetype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL h5fclose_f(file , error)
  CALL check("h5fclose_f",error, total_error)
  !
  ! Now we begin the read section of this example.
  !
  ! Open file and dataset.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
  CALL check("h5fopen_f",error, total_error)
  CALL h5dopen_f(file, dataset, dset, error)
  CALL check("h5dopen_f",error, total_error)
  !
  ! Get the datatype and its size.
  !
  CALL H5Dget_type_f(dset, filetype, error)
  CALL check("H5Dget_type_f",error, total_error)
  CALL H5Tget_size_f(filetype, size, error)
  CALL check("H5Tget_size_f",error, total_error)
  CALL VERIFY("H5Tget_size_f", INT(size), INT(sdim), total_error)
  !
  ! Get dataspace.
  !
  CALL H5Dget_space_f(dset, space, error)
  CALL check("H5Dget_space_f",error, total_error)
  CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
  CALL check("H5Sget_simple_extent_dims_f",error, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)

  ALLOCATE(rdata(1:dims(1)))
  !
  ! Create the memory datatype.
  !
  CALL H5Tcopy_f(H5T_FORTRAN_S1, memtype, error)
  CALL check("H5Tcopy_f",error, total_error)
  CALL H5Tset_size_f(memtype, sdim, error)
  CALL check("H5Tset_size_f",error, total_error)
  !
  ! Read the data.
  !
  f_ptr = C_LOC(rdata(1)(1:1))
  CALL H5Dread_f(dset, memtype, f_ptr, error, space)
  CALL check("H5Dread_f",error, total_error)

  DO i = 1, dims(1)
     CALL verify("h5dread_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
  END DO

  DEALLOCATE(rdata)

  !
  ! Close and release resources.
  !
  CALL H5Dclose_f(dset, error)
  CALL check("h5dclose_f",error, total_error)
  CALL H5Sclose_f(space, error)
  CALL check("h5sclose_f",error, total_error)
  CALL H5Tclose_f(memtype, error)
  CALL check("h5tclose_f",error, total_error)
  CALL H5Fclose_f(file, error)
  CALL check("h5fclose_f",error, total_error)


END SUBROUTINE t_string

SUBROUTINE vl_test_special_char(total_error)

  IMPLICIT NONE

!  INTERFACE
!     SUBROUTINE setup_buffer(data_in, line_lengths, char_type)
!       USE HDF5
!       USE ISO_C_BINDING
!     IMPLICIT NONE
!       CHARACTER(len=*), DIMENSION(:) :: data_in
!       INTEGER(size_t), DIMENSION(:) :: line_lengths
!       CHARACTER(KIND=C_CHAR,LEN=*) :: char_type
!     END SUBROUTINE setup_buffer
!  END INTERFACE

  INTEGER, INTENT(OUT) :: total_error

  CHARACTER(LEN=16), PARAMETER :: filename  = "t_controlchar.h5"
  INTEGER, PARAMETER :: line_length = 10
  INTEGER(hid_t) :: file
  INTEGER(hid_t) :: dataset0
  CHARACTER(len=line_length), DIMENSION(1:100) :: data_in
  CHARACTER(len=line_length), DIMENSION(1:100) :: data_out
  INTEGER(size_t), DIMENSION(1:100) :: line_lengths
  INTEGER(hid_t) :: string_id, space, dcpl
  INTEGER(hsize_t), DIMENSION(1:1) :: dims = (/0/)
  INTEGER(hsize_t), DIMENSION(1:1) :: max_dims = (/0/)
  INTEGER(hsize_t), DIMENSION(1:2) :: data_dims = (/0,0/)
  INTEGER(hsize_t), DIMENSION(1:1) :: chunk =(/10/)
  INTEGER, PARAMETER :: ncontrolchar = 7
  CHARACTER(KIND=C_CHAR,LEN=1), DIMENSION(1:ncontrolchar) :: controlchar = &
       (/C_ALERT, C_BACKSPACE,C_CARRIAGE_RETURN, C_FORM_FEED,C_HORIZONTAL_TAB,C_VERTICAL_TAB, C_NEW_LINE/)
  INTEGER :: i, j, n, error
  n = 8
  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f",error, total_error)

  max_dims = (/H5S_UNLIMITED_F/)

  !
  ! Create the memory datatype.
  !
  CALL h5tcopy_f(h5t_string, string_id, error)
  CALL check("h5tcopy_f", error, total_error)
  CALL h5tset_strpad_f(string_id, h5t_str_nullpad_f, error)
  CALL check("h5tset_strpad_f", error, total_error)
  dims(1) = n
  !
  ! Create dataspace.
  !
  CALL h5screate_simple_f(1, dims, space, error, max_dims)
  CALL check("h5screate_simple_f", error, total_error)
  CALL h5pcreate_f(h5p_dataset_create_f, dcpl, error)
  CALL check("h5pcreate_f", error, total_error)
  CALL h5pset_chunk_f(dcpl, 1, chunk, error)
  CALL check("h5pset_chunk_f", error, total_error)

  data_dims(1) = line_length
  data_dims(2) = n
  !
  ! Create data with strings containing various control characters.
  !
  DO i = 1, ncontrolchar
     !
     ! Create the dataset, for the string with control character and write the string data to it.
     !
     CALL h5dcreate_f(file, controlchar(i), string_id, space, dataset0, error, dcpl)
     CALL check("h5dcreate_f", error, total_error)
     CALL setup_buffer(data_in(1:n), line_lengths, controlchar(i))
     CALL h5dwrite_vl_f(dataset0, string_id, data_in(1:n), data_dims, line_lengths(1:n), error, space)
     CALL check("h5dwrite_vl_f", error, total_error)
     !
     ! Read the string back.
     !
     CALL h5dread_vl_f(dataset0, string_id, data_out(1:n), data_dims, line_lengths(1:n), error, space)
     CALL check("h5dread_vl_f", error, total_error)

     DO j = 1, n
        IF(data_in(j).NE.data_out(j))THEN
           total_error = total_error + 1
           EXIT
        ENDIF
     ENDDO

     CALL h5dclose_f(dataset0, error)
     CALL check("h5dclose_f", error, total_error)
  ENDDO

  CALL h5pclose_f(dcpl, error)
  CALL check("h5pclose_f", error, total_error)
  CALL h5sclose_f(space, error)
  CALL check("h5sclose_f", error, total_error)
  CALL h5fclose_f(file, error)
  CALL check("h5fclose_f", error, total_error)

END SUBROUTINE vl_test_special_char


SUBROUTINE setup_buffer(data_in, line_lengths, char_type)

  IMPLICIT NONE

  ! Creates a simple "Data_in" consisting of the letters of the alphabet,
  ! one per line, with a control character.

  CHARACTER(len=10), DIMENSION(:) :: data_in
  INTEGER(size_t), DIMENSION(:) :: line_lengths
  CHARACTER(LEN=3) :: lets = 'abc'
  CHARACTER(KIND=C_CHAR,LEN=*) :: char_type
  INTEGER :: i, j, n

  n = SIZE(data_in)
  j = 1
  DO i=1,n-1
     IF( j .EQ. 4 )THEN
        data_in(i:i) = char_type(1:1)
     ELSE
        data_in(i:i) = lets(j:j)
     ENDIF
     line_lengths(i) = LEN_TRIM(data_in(i))
     j = j + 1
     IF( j .EQ. 5 ) j = 1
  END DO
  data_in(n:n) =  char_type(1:1)
  line_lengths(n) = 1

END SUBROUTINE setup_buffer

!-------------------------------------------------------------------------
! Function:    test_nbit
!
! Purpose:     Tests (real, 4 byte) datatype for nbit filter
!
! Return:      Success:        0
!              Failure:        >0
!-------------------------------------------------------------------------
!

SUBROUTINE test_nbit(total_error )

  IMPLICIT NONE
  INTEGER, PARAMETER :: wp = C_FLOAT !should map to REAL*4 on most modern processors
  INTEGER, INTENT(INOUT) :: total_error
  INTEGER(hid_t) :: file

  INTEGER(hid_t) :: dataset, datatype, space, dc, mem_type_id
  INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/)
  INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/)
  ! orig_data[] are initialized to be within the range that can be represented by
  ! dataset datatype (no precision loss during datatype conversion)
  !
  REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: orig_data = &
       RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, &
       5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) )
  REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: new_data
  INTEGER(size_t) :: PRECISION, offset
  INTEGER :: error
  LOGICAL :: status
  INTEGER(hsize_t) :: i, j
  TYPE(C_PTR) :: f_ptr

  ! check to see if filter is available
  CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error)
  IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter
     total_error = -1     ! so return
     RETURN
  ENDIF

  CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error)
  CALL check("H5Fcreate_f", error, total_error)

  ! Define dataset datatype (integer), and set precision, offset
  CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error)
  CALL CHECK(" H5Tcopy_f", error, total_error)
  CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error)
  CALL CHECK(" H5Tset_fields_f", error, total_error)
  offset = 7
  CALL H5Tset_offset_f(datatype, offset, error)
  CALL CHECK(" H5Tset_offset_f", error, total_error)
  PRECISION = 20
  CALL H5Tset_precision_f(datatype,PRECISION, error)
  CALL CHECK(" H5Tset_precision_f", error, total_error)

  CALL H5Tset_size_f(datatype, 4_size_t, error)
  CALL CHECK(" H5Tset_size_f", error, total_error)

  CALL H5Tset_ebias_f(datatype, 31_size_t, error)
  CALL CHECK(" H5Tset_ebias_f", error, total_error)

  ! Create the data space
  CALL H5Screate_simple_f(2, dims, space, error)
  CALL CHECK(" H5Screate_simple_f", error, total_error)

  ! USE nbit filter
  CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error)
  CALL CHECK(" H5Pcreate_f", error, total_error)

  CALL H5Pset_chunk_f(dc, 2, chunk_dim, error)
  CALL CHECK(" H5Pset_chunk_f", error, total_error)
  CALL H5Pset_nbit_f(dc, error)
  CALL CHECK(" H5Pset_nbit_f", error, total_error)

  ! Create the dataset
  CALL  H5Dcreate_f(file, "nbit_real", datatype, &
       space, dataset, error, dc)
  CALL CHECK(" H5Dcreate_f", error, total_error)

  !----------------------------------------------------------------------
  ! STEP 1: Test nbit by setting up a chunked dataset and writing
  ! to it.
  !----------------------------------------------------------------------
  !
  mem_type_id = h5kind_to_type(wp,H5_REAL_KIND)

  f_ptr = C_LOC(orig_data(1,1))
  CALL H5Dwrite_f(dataset, mem_type_id, f_ptr, error)
  CALL CHECK(" H5Dwrite_f", error, total_error)

  !----------------------------------------------------------------------
  ! STEP 2: Try to read the data we just wrote.
  !----------------------------------------------------------------------
  !
  f_ptr = C_LOC(new_data(1,1))
  CALL H5Dread_f(dataset, mem_type_id, f_ptr, error)
  CALL CHECK(" H5Dread_f", error, total_error)

  ! Check that the values read are the same as the values written
  ! Assume size of long long = size of double
  !
  i_loop: DO i = 1, dims(1)
     j_loop: DO j = 1, dims(2)

        IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE  ! skip IF value is NaN

        IF( .NOT.check_real_eq( new_data(i,j), orig_data(i,j)) ) THEN
           total_error = total_error + 1
           WRITE(*,'("    Read different values than written.")')
           WRITE(*,'("    At index ", 2(1X,I0))') i, j
           EXIT i_loop
        END IF
     ENDDO j_loop
  ENDDO i_loop

  !----------------------------------------------------------------------
  ! Cleanup
  !----------------------------------------------------------------------
  !
  CALL H5Tclose_f(datatype, error)
  CALL CHECK(" H5Tclose_f", error, total_error)
  CALL H5Pclose_f(dc, error)
  CALL CHECK(" H5Pclose_f", error, total_error)
  CALL H5Sclose_f(space, error)
  CALL CHECK(" H5Sclose_f", error, total_error)
  CALL H5Dclose_f(dataset, error)
  CALL CHECK(" H5Dclose_f", error, total_error)
  CALL H5Fclose_f(file, error)
  CALL CHECK(" H5Fclose_f", error, total_error)

END SUBROUTINE test_nbit


SUBROUTINE t_enum_conv(total_error)

!-------------------------------------------------------------------------
! Subroutine: t_enum_conv
!
! Purpose: Tests converting data from enumeration datatype
!          to numeric (integer or floating-point number)
!          datatype. Tests various KINDs of INTEGERs
!          and REALs. Checks reading enum data into
!          INTEGER and REAL KINDs.
!
! Return: Success:	0
!	  Failure:	number of errors
!
! Note:        Adapted from C test (enum.c -- test_conv)
!              No reliance on C tests.
!-------------------------------------------------------------------------
!

  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error

  INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9)   !should map to INTEGER*4 on most modern processors
  INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors

  INTEGER, PARAMETER :: real_kind_7 = C_FLOAT  !should map to REAL*4 on most modern processors

  INTEGER(hid_t) :: cwg=-1, dtype=-1, space=-1, dset=-1 ! Handles
  INTEGER(hid_t) :: file ! Handles

  ! Enumerated type
  ENUM, BIND(C)
    ENUMERATOR :: E1_RED, E1_GREEN, E1_BLUE, E1_WHITE, E1_BLACK
  END ENUM

  INTEGER(KIND(E1_RED)), TARGET :: val

  ! Enumerated data array
  ! Some values are out of range for testing. The library should accept them
  INTEGER(KIND(E1_RED)), DIMENSION(1:20), TARGET :: data1 = (/INT(E1_RED,KIND(E1_RED)), &
       INT(E1_GREEN,KIND(E1_RED)), INT(E1_BLUE,KIND(E1_RED)),  &
       INT(E1_GREEN,KIND(E1_RED)), INT(E1_WHITE,KIND(E1_RED)), &
       INT(E1_WHITE,KIND(E1_RED)), INT(E1_BLACK,KIND(E1_RED)), &
       INT(E1_GREEN,KIND(E1_RED)), INT(E1_BLUE,KIND(E1_RED)), &
       INT(E1_RED,KIND(E1_RED)), INT(E1_RED,KIND(E1_RED)), INT(E1_BLUE,KIND(E1_RED)), &
       INT(E1_GREEN,KIND(E1_RED)), INT(E1_BLACK,KIND(E1_RED)), INT(E1_WHITE,KIND(E1_RED)),&
       INT(E1_RED,KIND(E1_RED)), INT(E1_WHITE,KIND(E1_RED)), &
       INT(0,KIND(E1_RED)), INT(-1,KIND(E1_RED)), INT(-2,KIND(E1_RED))/)

  ! Reading array for enum data
  INTEGER(KIND(E1_RED)), DIMENSION(1:20), TARGET :: data2

  ! Reading array's for converted enum data
  INTEGER(C_SHORT), DIMENSION(1:20), TARGET :: data_short
  INTEGER(C_INT), DIMENSION(1:20), TARGET :: data_int
  REAL(C_DOUBLE), DIMENSION(1:20), TARGET :: data_double

  INTEGER(int_kind_8), DIMENSION(1:20), TARGET :: data_i8
  INTEGER(int_kind_16), DIMENSION(1:20), TARGET :: data_i16
  REAL(real_kind_7), DIMENSION(1:20), TARGET :: data_r7

  INTEGER(hsize_t), DIMENSION(1:1) :: ds_size = (/20/)
  INTEGER(size_t) :: i
  INTEGER(hsize_t) :: ih
  INTEGER :: error
  TYPE(C_PTR) :: f_ptr
  INTEGER(HID_T) :: m_baset  ! Memory base type
  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f("enum1.h5", H5F_ACC_TRUNC_F, file, error)
  CALL check("h5fcreate_f", error, total_error)
  !
  ! Create a new group using the default properties.
  !
  CALL h5gcreate_f(file, "test_conv", cwg, error)
  CALL check("h5gcreate_f",error, total_error)
  !
  ! Create a enum type
  !
  CALL H5Tcreate_f(H5T_ENUM_F, H5OFFSETOF(C_LOC(data1(1)), C_LOC(data1(2))), dtype, error)
  CALL check("h5tcreate_f",error, total_error)
  !
  ! Initialize enum data.
  !

  val = E1_RED
  CALL H5Tenum_insert_f(dtype, "RED", C_LOC(val), error)
  CALL check("h5tenum_insert_f",error, total_error)
  val = E1_GREEN
  f_ptr = C_LOC(val)
  CALL H5Tenum_insert_f(dtype, "GREEN", f_ptr, error)
  CALL check("h5tenum_insert_f",error, total_error)
  val = E1_BLUE
  f_ptr = C_LOC(val)
  CALL H5Tenum_insert_f(dtype, "BLUE", f_ptr, error)
  CALL check("h5tenum_insert_f",error, total_error)
  val = E1_WHITE
  f_ptr = C_LOC(val)
  CALL H5Tenum_insert_f(dtype, "WHITE", f_ptr, error)
  CALL check("h5tenum_insert_f",error, total_error)
  val = E1_BLACK
  f_ptr = C_LOC(val)
  CALL H5Tenum_insert_f(dtype, "BLACK", f_ptr, error)
  CALL check("h5tenum_insert_f",error, total_error)
  !
  ! Create dataspace.  Setting maximum size to be the current size.
  !
  CALL h5screate_simple_f(1, ds_size, space, error)
  CALL check("h5screate_simple_f", error, total_error)

  ! ***************************************
  ! * Dataset of enumeration type
  ! ***************************************
  !
  ! Create a dataset of enum type and write enum data to it

  CALL h5dcreate_f(cwg, "color_table1", dtype, space, dset, error)
  CALL check("h5dcreate_f", error, total_error)

  f_ptr = C_LOC(data1(1))
  CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space)
  CALL check(" h5dwrite_f", error, total_error)

  ! Test reading back the data with no conversion

  f_ptr = C_LOC(data2(1))
  CALL h5dread_f(dset, dtype, f_ptr, error, space, space)
  CALL check(" h5dread_f", error, total_error)

  ! Check values
  DO ih = 1, ds_size(1)
     IF(data1(ih) .NE. data2(ih))THEN
        total_error = total_error + 1
        WRITE(*,'("    1. data1(",I0,")=",I0," .NE. data2(",I0,")=",I0)') ih, data1(ih),i,data2(ih)
        EXIT
     ENDIF
  ENDDO

  ! Test converting the data to integer (KIND=C_SHORT). Read enum data back as integer
  m_baset = h5kind_to_type(KIND(data_short(1)), H5_INTEGER_KIND) ! Memory base type
  f_ptr = C_LOC(data_short(1))
  CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
  CALL check("h5dread_f", error, total_error)
  ! Check values
  DO ih = 1, ds_size(1)
     IF(data1(ih) .NE. data_short(ih))THEN
        total_error = total_error + 1
        WRITE(*,'("    2. data1(",I0,")=",I0," .NE. data_short(",I0,")=",I0)') ih, data1(ih),i,data_short(ih)
        EXIT
     ENDIF
  ENDDO

  ! Test converting the data to (KIND=C_double) number.
  ! Read enum data back as (KIND=C_double) number

  m_baset = h5kind_to_type(KIND(data_double(1)), H5_REAL_KIND) ! Memory base type
  f_ptr = C_LOC(data_double(1))
  CALL h5dread_f(dset,  m_baset, f_ptr, error, space, space)
  CALL check("h5dread_f", error, total_error)
  ! Check values
  DO ih = 1, ds_size(1)
     IF(data1(ih) .NE. INT(data_double(ih)))THEN
        total_error = total_error + 1
        WRITE(*,'("    3. data_double(",I0,")=",I0," .NE. data_double(",I0,")=",I0)') &
             ih, INT(data1(ih)), ih, INT(data_double(ih))
        EXIT
     ENDIF
  ENDDO

  ! Test converting the data to (SELECTED_INT_KIND(9)) number.
  ! Read enum data back as (SELECTED_INT_KIND(9)) number

  m_baset = h5kind_to_type(int_kind_8, H5_INTEGER_KIND) ! Memory base type
  f_ptr = C_LOC(data_i8(1))
  CALL h5dread_f(dset,  m_baset, f_ptr, error, space, space)
  CALL check("h5dread_f", error, total_error)
  ! Check values
  DO ih = 1, ds_size(1)
     IF(data1(ih) .NE. INT(data_i8(ih)))THEN
        total_error = total_error + 1
        WRITE(*,'("    4. data_i8(",I0,")=",I0," .NE. data_i8(",I0,")=",I0)') &
             ih, INT(data1(ih)), i, INT(data_i8(ih))
        EXIT
     ENDIF
  ENDDO

  ! Test converting the data to (SELECTED_INT_KIND(18)) number.
  ! Read enum data back as (SELECTED_INT_KIND(18)) number

  m_baset = h5kind_to_type(int_kind_16, H5_INTEGER_KIND) ! Memory base type
  f_ptr = C_LOC(data_i16(1))
  CALL h5dread_f(dset,  m_baset, f_ptr, error, space, space)
  CALL check("h5dread_f", error, total_error)
  ! Check values
  DO ih = 1, ds_size(1)
     IF(data1(ih) .NE. INT(data_i16(ih)))THEN
        total_error = total_error + 1
        WRITE(*,'("    5. data_i16(",I0,")=",I0," .NE. data_i16(",I0,")=",I0)') &
             ih, INT(data1(ih)), i, INT(data_i16(ih))
        EXIT
     ENDIF
  ENDDO

  ! Test converting the data to C_FLOAT number.
  ! Read enum data back as C_FLOAT number

  m_baset = h5kind_to_type(KIND(data_r7(1)), H5_REAL_KIND) ! Memory base type
  f_ptr = C_LOC(data_r7(1))
  CALL h5dread_f(dset,  m_baset, f_ptr, error, space, space)
  CALL check("h5dread_f", error, total_error)
  ! Check values
  DO ih = 1, ds_size(1)
     IF(data1(ih) .NE. INT(data_r7(ih)))THEN
        total_error = total_error + 1
        WRITE(*,'("    6. data_r7(",I0,")=",I0," .NE. data_r7(",I0,")=",I0)') &
             ih, INT(data1(ih)), i, INT(data_r7(ih))
        EXIT
     ENDIF
  ENDDO

  CALL h5dclose_f(dset, error)
  CALL check("h5dclose_f", error, total_error)

  ! ***************************************
  ! *    Dataset of C_int type
  ! ***************************************

  ! Create a integer dataset of KIND=C_INT and write enum data to it
  m_baset = h5kind_to_type(KIND(data_int(1)), H5_INTEGER_KIND) ! Memory base type
  CALL h5dcreate_f(cwg, "color_table2", m_baset, space, dset, error)
  CALL check("h5dcreate_f", error, total_error)

  ! Write the enum data
  f_ptr = C_LOC(data1(1))
  CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space)
  CALL check("h5dwrite_f", error, total_error)

  ! Test reading back the data with no conversion
  f_ptr = C_LOC(data_int(1))
  CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
  CALL check("h5dread_f", error, total_error)

  DO ih = 1, ds_size(1)
     IF(data1(ih) .NE. data_int(ih))THEN
        total_error = total_error + 1
        WRITE(*,'("    7. data1(",I0,")=",I0," .NE. data_int(",I0,")=",I0)') ih, data1(ih),i,data_int(ih)
        EXIT
     ENDIF
  ENDDO
  CALL h5dclose_f(dset, error)
  CALL check("h5dclose_f", error, total_error)

  !**************************************
  !*    Dataset of C_double type
  !**************************************

  ! Create a dataset of KIND=C_DOUBLE and write enum data to it
  m_baset = h5kind_to_type(KIND(data_double(1)), H5_REAL_KIND) ! Memory base type
  CALL h5dcreate_f(cwg, "color_table3", m_baset, space, dset,  error)
  CALL check("h5dcreate_f", error, total_error)

  f_ptr = C_LOC(data1(1))
  CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space)
  CALL check("h5dwrite_f", error, total_error)

  ! Test reading back the data with no conversion
  f_ptr = C_LOC(data_double(1))
  CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
  CALL check("h5dread_f", error, total_error)

  DO ih = 1, ds_size(1)
     IF(data1(ih) .NE. INT(data_double(ih)))THEN
        total_error = total_error + 1
        WRITE(*,'("    8. data1(",I0,")=",I0," .NE. data_double(",I0,")=",I0)') ih, data1(ih),ih,INT(data_double(ih))
        EXIT
     ENDIF
  ENDDO
  CALL h5dclose_f(dset, error)
  CALL check("h5dclose_f", error, total_error)

  !*********************************************************
  !* Dataset of real C_FLOAT type
  !*********************************************************

  ! Create a dataset of C_FLOAT and write enum data to it
  m_baset = h5kind_to_type(KIND(data_r7(1)), H5_REAL_KIND) ! Memory base type
  CALL h5dcreate_f(cwg, "color_table4", m_baset, space, dset,  error)
  CALL check("h5dcreate_f", error, total_error)

  f_ptr = C_LOC(data1(1))
  CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space)
  CALL check("h5dwrite_f", error, total_error)

  ! Test reading back the data with no conversion
  f_ptr = C_LOC(data_r7(1))
  CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
  CALL check("h5dread_f", error, total_error)

  DO ih = 1, ds_size(1)
     IF(data1(ih) .NE. INT(data_r7(ih)))THEN
        total_error = total_error + 1
        WRITE(*,'("    9. data1(",I0,")=",I0," .NE. data_r7(",I0,")=",I0)') ih, data1(ih),ih,INT(data_r7(ih))
        EXIT
     ENDIF
  ENDDO
  CALL h5dclose_f(dset, error)
  CALL check("h5dclose_f", error, total_error)

  ! *****************************************************************
  ! * Dataset of integer SELECTED_INT_KIND(18) type
  ! *****************************************************************

  ! Create a integer dataset of (SELECTED_INT_KIND(18)) and write enum data to it
  m_baset = h5kind_to_type(KIND(data_i16(1)), H5_INTEGER_KIND) ! Memory base type
  CALL h5dcreate_f(cwg, "color_table5", m_baset, space, dset, error)
  CALL check("h5dcreate_f", error, total_error)

  ! Write the enum data
  f_ptr = C_LOC(data1(1))
  CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space)
  CALL check("h5dwrite_f", error, total_error)

  ! Test reading back the data with no conversion
  f_ptr = C_LOC(data_i16(1))
  CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
  CALL check("h5dread_f", error, total_error)

  DO ih = 1, ds_size(1)
     IF(data1(ih) .NE. data_i16(ih))THEN
        total_error = total_error + 1
        WRITE(*,'("    10. data1(",I0,")=",I0," .NE. data_i16(",I0,")=",I0)') ih, data1(ih),ih,data_i16(ih)
        EXIT
     ENDIF
  ENDDO
  CALL h5dclose_f(dset, error)
  CALL check("h5dclose_f", error, total_error)

  !
  ! Close and release resources.
  !
  CALL h5sclose_f(space, error)
  CALL check("H5Sclose_f", error, total_error)
  CALL h5tclose_f(dtype, error)
  CALL check("H5Tclose_f", error, total_error)
  CALL h5gclose_f(cwg, error)
  CALL check("h5gclose_f",error, total_error)
  CALL h5fclose_f(file, error)
  CALL check("H5Fclose_f", error, total_error)

END SUBROUTINE t_enum_conv

! Tests the reading and writing of multiple datasets using H5Dread_multi and
! H5Dwrite_multi

SUBROUTINE multiple_dset_rw(total_error)

!-------------------------------------------------------------------------
! Subroutine: multiple_dset_rw
!
! Purpose:  Tests the reading and writing of multiple datasets 
!           using H5Dread_multi and H5Dwrite_multi
!
! Return: Success:      0
!         Failure:      number of errors
!-------------------------------------------------------------------------
!
  USE iso_c_binding
  USE hdf5
  IMPLICIT NONE
  
  INTEGER, INTENT(INOUT) :: total_error   ! number of errors
  INTEGER :: error                        ! HDF hdferror flag
  
  INTEGER(SIZE_T), PARAMETER :: ndset = 5 ! Number of data sets
  INTEGER(HID_T), DIMENSION(:), ALLOCATABLE :: dset_id
  INTEGER(HID_T), DIMENSION(:), ALLOCATABLE :: mem_type_id
  INTEGER(HID_T), DIMENSION(:), ALLOCATABLE :: mem_space_id
  INTEGER(HID_T), DIMENSION(:), ALLOCATABLE :: file_space_id

  INTEGER, PARAMETER :: idim=10, idim2=5, idim3=3 ! size of integer array
  INTEGER, PARAMETER :: rdim=5  ! size of real array
  INTEGER, PARAMETER :: cdim=3  ! size of character array
  INTEGER, PARAMETER :: sdim=2  ! length of character string
  INTEGER, PARAMETER :: ddim=2  ! size of derived type array
  INTEGER  :: i,j,k
  
  TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: buf_md ! array to hold the multi-datasets
  
  INTEGER, DIMENSION(1:idim), TARGET :: wbuf_int             ! integer write buffer
  INTEGER, DIMENSION(1:idim,idim2,idim3), TARGET :: wbuf_intmd
  REAL, DIMENSION(1:rdim), TARGET :: wbuf_real               ! real write buffer
  CHARACTER(LEN=sdim), DIMENSION(1:cdim), TARGET :: wbuf_chr ! character write buffer
  INTEGER, DIMENSION(1:idim), TARGET :: rbuf_int             ! integer read buffer
  INTEGER, DIMENSION(1:idim,idim2,idim3), TARGET :: rbuf_intmd ! integer read buffer
  REAL, DIMENSION(1:rdim), TARGET :: rbuf_real               ! real read buffer
  CHARACTER(LEN=sdim), DIMENSION(1:cdim), TARGET :: rbuf_chr ! character read buffer

  TYPE derived
     REAL :: r
     INTEGER :: i
     CHARACTER(LEN=sdim) :: c
  END TYPE derived

  TYPE(derived), DIMENSION(1:ddim), TARGET :: wbuf_derived ! derived type write buffer
  TYPE(derived), DIMENSION(1:ddim), TARGET :: rbuf_derived ! derived type read buffer
  INTEGER(HSIZE_T), DIMENSION(1:1) :: dims ! dimension of the spaces
  INTEGER(HSIZE_T), DIMENSION(1:3) :: dimsmd ! dimension of the spaces
  INTEGER(HID_T) :: file_id, strtype ! handles
  INTEGER(SIZE_T) :: obj_count

  ALLOCATE(buf_md(1:ndset),stat=error)
  IF (error .NE. 0) THEN
     WRITE(*,*) 'allocate error'
     total_error = total_error + 1
     RETURN
  ENDIF
  ALLOCATE(dset_id(1:ndset),stat=error)
  IF (error .NE. 0) THEN
     WRITE(*,*) 'allocate error'
     total_error = total_error + 1
     RETURN
  ENDIF
  ALLOCATE(mem_type_id(1:ndset),stat=error)
  IF (error .NE. 0) THEN
     WRITE(*,*) 'allocate error'
     total_error = total_error + 1
     RETURN
  ENDIF
  ALLOCATE(mem_space_id(1:ndset),stat=error)
  IF (error .NE. 0) THEN
     WRITE(*,*) 'allocate error'
     total_error = total_error + 1
     RETURN
  ENDIF
  ALLOCATE(file_space_id(1:ndset),stat=error)
  IF (error .NE. 0) THEN
     WRITE(*,*) 'allocate error'
     total_error = total_error + 1
     RETURN
  ENDIF

  CALL h5fcreate_f("multidset_rw.h5", H5F_ACC_TRUNC_F, file_id, error)
  CALL check("h5fcreate_f", error, total_error)
  !
  ! Create real dataset
  !
  wbuf_real(1:rdim) = (/(i,i=1,rdim)/)
  dims(1) = rdim
  buf_md(1) = C_LOC(wbuf_real(1))
  mem_type_id(1) = H5T_NATIVE_REAL
  CALL h5screate_simple_f(1, dims, file_space_id(1), error)
  CALL check("h5screate_simple_f", error, total_error)
  CALL h5dcreate_f(file_id, "ds real", mem_type_id(1), file_space_id(1), dset_id(1), error)
  CALL check("h5dcreate_f", error, total_error)
  mem_space_id(1) = file_space_id(1)

  ! Create integer dataset (1D)
  wbuf_int(1:idim) = (/(i,i=1,idim)/)
  dims(1) = idim
  buf_md(2) = C_LOC(wbuf_int(1))
  mem_type_id(2) = H5T_NATIVE_INTEGER
  CALL h5screate_simple_f(1, dims, file_space_id(2), error)
  CALL check("h5screate_simple_f", error, total_error)
  CALL h5dcreate_f(file_id, "ds int", mem_type_id(2), file_space_id(2), dset_id(2), error)
  CALL check("h5dcreate_f", error, total_error)
  mem_space_id(2) = file_space_id(2)

  ! Create character dataset
  wbuf_chr(1:cdim) = (/'ab','cd','ef'/)
  dims(1) = cdim
  buf_md(3) = C_LOC(wbuf_chr(1)(1:1))
  CALL H5Tcopy_f(H5T_FORTRAN_S1, mem_type_id(3), error)
  CALL check("H5Tcopy_f", error, total_error)
  CALL H5Tset_size_f(mem_type_id(3), INT(sdim,SIZE_T), error)
  CALL check("H5Tset_size_f", error, total_error)
  CALL h5screate_simple_f(1, dims, file_space_id(3), error)
  CALL check("h5screate_simple_f", error, total_error)
  CALL h5dcreate_f(file_id, "ds chr", mem_type_id(3), file_space_id(3), dset_id(3), error)
  CALL check("h5dcreate_f", error, total_error)
  mem_space_id(3) = file_space_id(3)

  ! Create derived type dataset
  wbuf_derived(1:ddim)%r = (/10.,20./)
  wbuf_derived(1:ddim)%i = (/30,40/)
  wbuf_derived(1:ddim)%c = (/'wx','yz'/)
  buf_md(4) = C_LOC(wbuf_derived(1)%r)
  CALL h5tcreate_f(H5T_COMPOUND_F, H5OFFSETOF(C_LOC(wbuf_derived(1)), C_LOC(wbuf_derived(2))), mem_type_id(4), error)
  CALL check("h5tcreate_f", error, total_error)
  CALL h5tinsert_f(mem_type_id(4), "real", &
       H5OFFSETOF(C_LOC(wbuf_derived(1)),C_LOC(wbuf_derived(1)%r)), H5T_NATIVE_REAL, error)
  CALL check("h5tinsert_f", error, total_error)
  CALL h5tinsert_f(mem_type_id(4), "int", &
       H5OFFSETOF(C_LOC(wbuf_derived(1)),C_LOC(wbuf_derived(1)%i)), H5T_NATIVE_INTEGER, error)
  CALL check("h5tinsert_f", error, total_error)
  CALL h5tcopy_f(H5T_NATIVE_CHARACTER, strtype, error)
  CALL check("h5tcopy_f", error, total_error)
  CALL h5tset_size_f(strtype, INT(sdim,size_t), error)  
  CALL check("h5tset_size_f", error, total_error)
  CALL h5tinsert_f(mem_type_id(4), "chr", &
       H5OFFSETOF(C_LOC(wbuf_derived(1)),C_LOC(wbuf_derived(1)%c(1:1))), strtype, error)
  CALL check("h5tinsert_f", error, total_error)

  dims(1) = ddim
  CALL h5screate_simple_f(1, dims, file_space_id(4), error)
  CALL check("h5screate_simple_f", error, total_error)
  CALL h5dcreate_f(file_id, "ds derived", mem_type_id(4), file_space_id(4), dset_id(4), error)
  CALL check("h5dcreate_f", error, total_error)
  mem_space_id(4) = file_space_id(4)


  ! Create integer dataset (3D)

  DO i = 1, idim
     DO j = 1, idim2
        DO k = 1, idim3
           wbuf_intmd(i,j,k) = i*j
        ENDDO
     ENDDO
  ENDDO

  dimsmd(1:3) = (/idim,idim2,idim3/)
  buf_md(5) = C_LOC(wbuf_intmd(1,1,1))
  mem_type_id(5) = H5T_NATIVE_INTEGER
  CALL h5screate_simple_f(3, dimsmd, file_space_id(5), error)
  CALL check("h5screate_simple_f", error, total_error)
  CALL h5dcreate_f(file_id, "ds int 3d", mem_type_id(5), file_space_id(5), dset_id(5), error)
  CALL check("h5dcreate_f", error, total_error)
  mem_space_id(5) = file_space_id(5)

  ! write all the datasets
  CALL h5dwrite_multi_f(ndset, dset_id, mem_type_id, mem_space_id, file_space_id, buf_md, error)
  CALL check("h5dwrite_multi_f", error, total_error)

  ! point to read buffers

  buf_md(1) = C_LOC(rbuf_real(1))
  buf_md(2) = C_LOC(rbuf_int(1))
  buf_md(3) = C_LOC(rbuf_chr(1)(1:1))
  buf_md(4) = C_LOC(rbuf_derived(1)%r)
  buf_md(5) = C_LOC(rbuf_intmd(1,1,1))

  ! read all the datasets
  CALL h5dread_multi_f(ndset, dset_id, mem_type_id, mem_space_id, file_space_id, buf_md, error)
  CALL check("h5dread_multi_f", error, total_error)

  ! check the written and read in values
  error = 0
  DO i = 1, rdim
     CALL VERIFY("h5dread_multi_f",rbuf_real(i), wbuf_real(i), error)
  END DO
  total_error = total_error + error
  DO i = 1, idim
     CALL VERIFY("h5dread_multi_f",rbuf_int(i),wbuf_int(i), error)
  END DO
  total_error = total_error + error
  DO i = 1, cdim
     CALL VERIFY("h5dread_multi_f",rbuf_chr(i),wbuf_chr(i), error)
  END DO
  total_error = total_error + error
  error = 0
  DO i = 1, ddim
     CALL VERIFY("h5dread_multi_f",rbuf_derived(i)%r,wbuf_derived(i)%r,error)
     CALL VERIFY("h5dread_multi_f",rbuf_derived(i)%i,wbuf_derived(i)%i,error)
     CALL VERIFY("h5dread_multi_f",rbuf_derived(i)%c,wbuf_derived(i)%c,error)
  END DO
  total_error = total_error + error
  DO i = 1, idim
     DO j = 1, idim2
        DO k = 1, idim3
           IF(rbuf_intmd(i,j,k).NE.wbuf_intmd(i,j,k))THEN
              total_error = total_error + 1
           END IF
        END DO
     ENDDO
  ENDDO

  DO i = 1, ndset
     CALL H5Dclose_f(dset_id(i), error)
     CALL check("H5Dclose_f", error, total_error)
     CALL H5Sclose_f(file_space_id(i), error)
     CALL check("H5Sclose_f", error, total_error)
  ENDDO
  CALL H5Tclose_f(mem_type_id(4), error)
  CALL check("H5Tclose_f", error, total_error)

  CALL h5fget_obj_count_f(file_id, H5F_OBJ_ALL_F, obj_count, error)
  IF(obj_count.NE.1)THEN
     total_error = total_error + 1
  END IF

  CALL H5Fclose_f(file_id, error)

END SUBROUTINE multiple_dset_rw


END MODULE TH5T_F03