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.                                               *
!   Copyright by the Board of Trustees of the University of Illinois.         *
!   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 files COPYING and Copyright.html.  COPYING can be found at the root   *
!   of the source code distribution tree; Copyright.html can be found at the  *
!   root level of an installed copy of the electronic HDF5 document set and   *
!   is linked from the top-level documents page.  It can also be found at     *
!   http://hdfgroup.org/HDF5/doc/Copyright.html.  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)
!**
!****************************************************************/
!
SUBROUTINE test_array_compound_atomic(total_error)

  USE HDF5 
  USE ISO_C_BINDING
  IMPLICIT NONE

  INTEGER, INTENT(INOUT) :: total_error
  ! 1-D dataset WITH fixed dimensions 
  CHARACTER(LEN=6), PARAMETER :: SPACE1_NAME = "Space1"
  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
     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(SIZE_T) :: type_sizei  ! Size of the integer datatype 
  INTEGER(SIZE_T) :: type_sizer  ! Size of the real datatype

  INTEGER(SIZE_T) :: sizeof_compound ! total size of compound
  INTEGER :: error    !  Generic RETURN value 
  INTEGER(SIZE_T)     ::   offset     ! Member's offset
  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 verifystring("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 VerifyLogical("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 verifystring("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 VerifyLogical("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)
  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
        IF(wdata(i,j)%f.NE.rdata(i,j)%f)THEN
           PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
           total_error = total_error + 1
        ENDIF
     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)
    
    USE HDF5 
    USE ISO_C_BINDING
    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 
       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(HID_T) :: dt5_id      ! Memory datatype identifier 

    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(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(size_t) :: offset   ! Offset of compound field 
    INTEGER(hid_t) :: mtid   ! Datatype ID for field  
    INTEGER(hid_t) :: mtid2   ! Datatype ID for field  
    INTEGER(SIZE_T) :: type_sizei  ! Size of the integer datatype 
    INTEGER(SIZE_T) :: type_sizer  ! Size of the real datatype 
    INTEGER(SIZE_T) :: type_sizec  ! Size of the character datatype
    INTEGER(SIZE_T) :: sizeof_compound ! total size of compound

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

    INTEGER :: error
    CHARACTER(LEN=2) :: ichr2
    INTEGER(SIZE_T) :: sizechar
    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))), 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 verifystring("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 VerifyLogical("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 verifystring("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 verifystring("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)))), 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 VerifyLogical("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 VerifyLogical("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
             IF(wdata(i,j)%f(k).NE.rdata(i,j)%f(k))THEN
                PRINT*, 'ERROR: Wrong real array data is read back by H5Dread_f '
                total_error = total_error + 1
             ENDIF
             IF(wdata(i,j)%c(k).NE.rdata(i,j)%c(k))THEN
                PRINT*, 'ERROR: Wrong character array data is read back by H5Dread_f '
                total_error = total_error + 1
             ENDIF
          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)
    
    USE HDF5 
    USE ISO_C_BINDING
    IMPLICIT NONE

    INTEGER, PARAMETER :: r_k4 = SELECTED_REAL_KIND(5)
    INTEGER, PARAMETER :: r_k8 = SELECTED_REAL_KIND(10)

    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=r_k4), DIMENSION(1:ALEN) :: b
       REAL(KIND=r_k8), 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=r_k4), 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
    
    TYPE(c_funptr) :: func

!     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(sizeof(cf(1)%b(1)).EQ.4)THEN
       CALL h5tget_size_f(H5T_NATIVE_REAL_4, type_sizer, error)
       CALL check("h5tget_size_f", error, total_error)
    ELSE IF(sizeof(cf(1)%b(1)).EQ.8)THEN
       CALL h5tget_size_f(H5T_NATIVE_REAL_8, 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_4;
    dtsinfo%datatype(3) = H5T_NATIVE_REAL_8;


    ! 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
          IF( cf(i)%b(j) .NE. cfr(i)%b(j) )THEN
             PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
             total_error = total_error + 1
          ENDIF
          IF( cf(i)%c(j) .NE. cfr(i)%c(j) )THEN
             PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
             total_error = total_error + 1
          ENDIF
       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_4, 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
          IF( fld(i)%b(j) .NE. fldr(i)%b(j) )THEN
             PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
             total_error = total_error + 1
          ENDIF
       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
           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
          IF( cf(i)%b(j) .NE. cfr(i)%b(j) )THEN
             PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
             total_error = total_error + 1
          ENDIF
          IF( cf(i)%c(j) .NE. cfr(i)%c(j) )THEN
             PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
             total_error = total_error + 1
          ENDIF
       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
           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
          IF( cf(i)%b(j) .NE. cfr(i)%b(j) )THEN
             PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
             total_error = total_error + 1
          ENDIF
          IF( cf(i)%c(j) .NE. cfr(i)%c(j) )THEN
             PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
             total_error = total_error + 1
          ENDIF
       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)

    USE ISO_C_BINDING
    USE HDF5 ! This module contains all necessary modules

    IMPLICIT NONE
    
    INTEGER, INTENT(INOUT) :: total_error
    
    INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(Fortran_INTEGER_1)  !should map to INTEGER*1 on most modern processors
    INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(Fortran_INTEGER_2)  !should map to INTEGER*2 on most modern processors
    INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4)  !should map to INTEGER*4 on most modern processors
    INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(Fortran_INTEGER_8) !should map to INTEGER*8 on most modern processors
    
    INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
    INTEGER, PARAMETER :: real_kind_15 = SELECTED_REAL_KIND(Fortran_REAL_8) !should map to REAL*8 on most modern processors
    
    CHARACTER(LEN=8), PARAMETER :: filename = "dsetf.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, j
    
! Data buffers:

    INTEGER, DIMENSION(1:4) :: dset_data

    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
    INTEGER(hid_t) :: datatype         ! Common datatype ID 

    !
    ! Initialize the dset_data array.
    !
    DO i = 1, 4
       dset_data_i1(i)  = i
       dset_data_i4(i)  = i
       dset_data_i8(i)  = i
       dset_data_i16(i) = i

       dset_data_r(i) = (i)*100.
       dset_data_r7(i) = (i)*100.
       dset_data_r15(i) = (i)*1000.
       
    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)
    
    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)

  !
  ! 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)
    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)
  !
  ! 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)
    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)
    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)
    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)
    CALL h5dread_f(dset_id16, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
    f_ptr = C_LOC(data_out_r)
    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)
    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)
    CALL h5dread_f(dset_idr8, h5kind_to_type(real_kind_15,H5_REAL_KIND), f_ptr,  error)
    CALL check("h5dread_f",error, total_error)
    
    DO i = 1, 4
       
       CALL verify_Fortran_INTEGER_4("h5kind_to_type1",INT(dset_data_i1(i),int_kind_8),INT(data_out_i1(i),int_kind_8),total_error)
       CALL verify_Fortran_INTEGER_4("h5kind_to_type2",INT(dset_data_i4(i),int_kind_8),INT(data_out_i4(i),int_kind_8),total_error)
       CALL verify_Fortran_INTEGER_4("h5kind_to_type3",INT(dset_data_i8(i),int_kind_8),INT(data_out_i8(i),int_kind_8),total_error)
       CALL verify_Fortran_INTEGER_4("h5kind_to_type4",INT(dset_data_i16(i),int_kind_8),INT(data_out_i16(i),int_kind_8),total_error)

       CALL verify_real_kind_7("h5kind_to_type5",REAL(dset_data_r(i),real_kind_7),REAL(data_out_r(i),real_kind_7),total_error)
       CALL verify_real_kind_7("h5kind_to_type6",REAL(dset_data_r7(i),real_kind_7),REAL(data_out_r7(i),real_kind_7),total_error)
       CALL verify_real_kind_7("h5kind_to_type7",REAL(dset_data_r15(i),real_kind_7),REAL(data_out_r15(i),real_kind_7),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)

  USE HDF5
  USE ISO_C_BINDING
  
  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 :: hdferr
  INTEGER(HSIZE_T), DIMENSION(1:1)   :: dims = (/dim0/)
  INTEGER(HSIZE_T), DIMENSION(1:2)   :: adims = (/adim0, adim1/)
  INTEGER(HSIZE_T), DIMENSION(1:3)   :: bdims = (/dim0, 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", INT(adims(1)), adim0, total_error)
  CALL VERIFY("H5Tget_array_dims_f", INT(adims(2)), adim1, 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", INT(dims(1)), dim0, 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, dims(1)
             DO j=1, adim0
                DO k = 1, 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)

  USE HDF5
  USE ISO_C_BINDING

  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, LIQUID=1, GAS=2, 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
     CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), val(1), 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)
     CALL H5Tenum_insert_f(filetype, TRIM(names(i+1)), val(1), error)
     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", INT(dims(1)), dim0, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(2)), dim1, 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, dims(1)
             DO j = 1, 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 verifystring("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)

  USE HDF5
  USE ISO_C_BINDING

  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 =  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", INT(dims(1)), dim0, total_error)
  CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(2)), dim1, 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, dims(1)
            DO j = 1, 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)

  USE HDF5
  USE ISO_C_BINDING

  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 :: 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))
  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 verifystring("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 verifystring("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 verifystring("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", INT(dims(1)), dim0, total_error)
  ALLOCATE(rdata(1:dims(1)))
  !
  ! Read the data.
  !
  f_ptr = C_LOC(rdata(1))
  CALL h5dread_f(dset, dtype, f_ptr, error)
  CALL check("H5Dread_f",error, total_error)
  !
  DO i = 1, dims(1)
     CALL verifystring("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)

  USE HDF5
  USE ISO_C_BINDING

  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", INT(dims(1)), dim0, 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, 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 verifystring("t_objref", name(1:name_size),"/G1", total_error)
     ELSE IF(objtype.EQ.H5G_DATASET_F)THEN
        CALL verifystring("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)

  USE HDF5
  USE ISO_C_BINDING

  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_f), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer
  TYPE(hdset_reg_ref_t_f), 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 :: 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_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", INT(dims(1)), dim0, 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.
     !
     CALL H5Rdereference_f(dset, rdata(i), dset2, error)
     CALL check("H5Rdereference_f",error, total_error)
     
     CALL H5Rget_region_f(dset, rdata(i), 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 verifystring("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))
     CALL h5dread_f( dset2, H5T_NATIVE_INTEGER_1, f_ptr, error, memspace, space)
     CALL check("H5Dread_f",error, total_error)
     CALL verifystring("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)

  USE HDF5
  USE ISO_C_BINDING

  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 :: 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, wdata(1)%len
     ptr(1)%data(i) = wdata(1)%len - i + 1 ! 3 2 1
  ENDDO
  wdata(1)%p = C_LOC(ptr(1)%data(1))

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

  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, 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)), 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, dims(1)
     CALL c_f_pointer(rdata(i)%p, ptr_r, [rdata(i)%len] )
     DO j = 1, 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)

  USE HDF5
  USE ISO_C_BINDING

  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 :: 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 verifystring("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

  USE HDF5
  USE ISO_C_BINDING

  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(SIZE_T)  , PARAMETER :: sdim = 7
  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 :: i, j, len
  INTEGER :: error

  ! Initialize array of C pointers

  wdata(1) = C_LOC(A(1))
  wdata(2) = C_LOC(B(1))
  wdata(3) = C_LOC(C(1))
  wdata(4) = C_LOC(D(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))
  wdata2D(1,2) = C_LOC(A12(1))
  wdata2D(1,3) = C_LOC(A13(1))
  wdata2D(1,4) = C_LOC(A14(1))
  wdata2D(2,1) = C_LOC(A21(1))
  wdata2D(2,2) = C_LOC(A22(1))
  wdata2D(2,3) = C_LOC(A23(1))
  wdata2D(2,4) = C_LOC(A24(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 verifystring("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 verifystring("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)

  USE HDF5
  USE ISO_C_BINDING

  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 :: 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", size, 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", INT(dims(1)), dim0, 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 verifystring("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