[svn-r14902] Merged fortran_1_8 branch changes r14505:14901 into the trunk. New fortran wrappers added.

1 files changed, 966 insertions, 0 deletions

diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90
new file mode 100644
index 0000000..970f570
--- /dev/null
+++ b/fortran/test/fortranlib_test_1_8.f90
@@ -0,0 +1,966 @@
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
+!   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.     *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
+!
+!
+! 
+!    Testing Fortran wrappers introduced in 1.8 release.
+!
+PROGRAM fortranlibtest
+
+  USE HDF5
+
+  IMPLICIT NONE
+  INTEGER :: total_error = 0
+  INTEGER :: error 
+  INTEGER :: mounting_total_error = 0
+  INTEGER :: reopen_total_error = 0
+  INTEGER :: fclose_total_error = 0
+  INTEGER :: fspace_total_error = 0
+  INTEGER :: dataset_total_error = 0
+  INTEGER :: extend_dataset_total_error = 0
+  INTEGER :: refobj_total_error = 0
+  INTEGER :: refreg_total_error = 0
+  INTEGER :: dataspace_total_error = 0
+  INTEGER :: hyperslab_total_error = 0
+  INTEGER :: element_total_error = 0
+  INTEGER :: basic_select_total_error = 0
+  INTEGER :: total_error_compoundtest = 0
+  INTEGER :: basic_datatype_total_error = 0
+  INTEGER :: enum_total_error = 0
+  INTEGER :: external_total_error = 0
+  INTEGER :: multi_file_total_error = 0
+  INTEGER :: attribute_total_error = 0
+  INTEGER :: group_total_error = 0
+  INTEGER :: majnum, minnum, relnum
+  CHARACTER(LEN=8) error_string
+  CHARACTER(LEN=8) :: success = ' PASSED '
+  CHARACTER(LEN=8) :: failure = '*FAILED*'
+  CHARACTER(LEN=4) :: e_format ='(8a)'
+  LOGICAL :: cleanup = .TRUE.
+  !     LOGICAL :: cleanup = .FALSE.
+
+  CALL h5open_f(error) 
+  WRITE(*,*) '                       ==========================                            '
+  WRITE(*,*) '                              FORTRAN 1.8 tests '
+  WRITE(*,*) '                       ==========================                            '
+  CALL h5get_libversion_f(majnum, minnum, relnum, total_error)
+  IF(total_error .EQ. 0) THEN
+     WRITE(*, '(" FORTRANLIB_TEST is linked with HDF5 Library version ")', advance="NO")
+     WRITE(*, '(I1)', advance="NO") majnum
+     WRITE(*, '(".")', advance="NO") 
+     WRITE(*, '(I1)', advance="NO") minnum
+     WRITE(*, '(" release ")', advance="NO")
+     WRITE(*, '(I3)') relnum
+  ELSE
+     total_error = total_error + 1
+  ENDIF
+  WRITE(*,*)
+
+  error_string = failure
+  CALL file_space(cleanup, fspace_total_error)
+  IF (fspace_total_error == 0) error_string = success
+  WRITE(*, fmt = '(21a)', advance = 'no') ' File free space test'     
+  WRITE(*, fmt = '(49x,a)', advance = 'no') ' ' 
+  WRITE(*, fmt = e_format) error_string
+  total_error = total_error + fspace_total_error 
+
+  !     write(*,*)
+  !     write(*,*) '========================================='
+  !     write(*,*) 'Testing ATTRIBUTE interface              ' 
+  !     write(*,*) '========================================='
+
+  error_string = failure
+  CALL attribute_test_1_8(cleanup, attribute_total_error)
+  WRITE(*, fmt = '(15a)', advance = 'no') ' ATTRIBUTE TEST'     
+  WRITE(*, fmt = '(55x,a)', advance = 'no')  ' '
+  IF (attribute_total_error == 0) error_string = success
+  WRITE(*, fmt = e_format) error_string
+  total_error = total_error + attribute_total_error
+
+  CALL group_test(cleanup, group_total_error)
+  WRITE(*, fmt = '(15a)', advance = 'no') ' GROUP TEST'     
+  WRITE(*, fmt = '(55x,a)', advance = 'no')  ' '
+  IF (group_total_error == 0) error_string = success
+  WRITE(*, fmt = e_format) error_string
+  total_error = total_error + group_total_error
+
+  CALL test_h5o(cleanup, group_total_error )
+  WRITE(*, fmt = '(15a)', advance = 'no') ' H5O TEST'     
+  WRITE(*, fmt = '(55x,a)', advance = 'no')  ' '
+  IF (group_total_error == 0) error_string = success
+  WRITE(*, fmt = e_format) error_string
+  total_error = total_error + group_total_error
+
+  CALL dtransform(cleanup, group_total_error)
+  WRITE(*, fmt = '(15a)', advance = 'no') ' Dtransform TEST'     
+  WRITE(*, fmt = '(55x,a)', advance = 'no')  ' '
+  IF (group_total_error == 0) error_string = success
+  WRITE(*, fmt = e_format) error_string
+  total_error = total_error + group_total_error
+
+  CALL test_genprop_basic_class(cleanup, group_total_error)
+  WRITE(*, fmt = '(30a)', advance = 'no') ' test_genprop_basic_class TEST'     
+  WRITE(*, fmt = '(55x,a)', advance = 'no')  ' '
+  IF (group_total_error == 0) error_string = success
+  WRITE(*, fmt = e_format) error_string
+  total_error = total_error + group_total_error
+  CALL test_h5s_encode(cleanup, group_total_error)
+  WRITE(*, fmt = '(15a)', advance = 'no') ' test_h5s_encode TEST'     
+  WRITE(*, fmt = '(55x,a)', advance = 'no')  ' '
+  IF (group_total_error == 0) error_string = success
+  WRITE(*, fmt = e_format) error_string
+  total_error = total_error + group_total_error
+
+!  CALL test_hard_query(group_total_error)
+
+  total_error = total_error + group_total_error
+
+  WRITE(*,*)
+
+  WRITE(*,*) '                  ============================================  '
+  WRITE(*, fmt = '(19x, 27a)', advance='NO') ' FORTRAN tests completed with '
+  WRITE(*, fmt = '(i4)', advance='NO') total_error
+  WRITE(*, fmt = '(12a)' ) ' error(s) ! '
+  WRITE(*,*) '                  ============================================  '
+
+  CALL h5close_f(error)
+
+  ! if errors detected, exit with non-zero code.
+  IF (total_error .NE. 0) CALL h5_exit_f (1)
+
+END PROGRAM fortranlibtest
+
+SUBROUTINE dtransform(cleanup, total_error)
+  USE HDF5 ! This module contains all necessary modules 
+  
+  IMPLICIT NONE
+  LOGICAL, INTENT(IN)  :: cleanup
+  INTEGER, INTENT(INOUT) :: total_error
+
+  INTEGER(HID_T) :: dxpl_id_c_to_f, dxpl_id_c_to_f_copy
+  INTEGER(HID_T) :: dxpl_id_simple, dxpl_id_polynomial, dxpl_id_polynomial_copy, dxpl_id_utrans_inv, file_id
+  
+  CHARACTER(LEN=15), PARAMETER :: c_to_f = "(9/5.0)*x + 123"
+  INTEGER :: error
+  CHARACTER(LEN=15) :: ptrgetTest
+  CHARACTER(LEN=7) :: ptrgetTest_small
+  CHARACTER(LEN=30) :: ptrgetTest_big
+
+  INTEGER(SIZE_T) :: size
+
+
+  CALL H5Fcreate_f("dtransform.h5", H5F_ACC_TRUNC_F, file_id, error)
+  CALL check("dtransform.H5Fcreate_f", error, total_error)
+
+  CALL H5Pcreate_f(H5P_DATASET_XFER_F, dxpl_id_c_to_f, error)
+  CALL check("dtransform.H5Pcreate_f", error, total_error)
+  
+  CALL H5Pset_data_transform_f(dxpl_id_c_to_f, c_to_f, error)
+  CALL check("dtransform.H5Pset_data_transform_f", error, total_error)
+
+  CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest, error, size=size)
+  CALL check("dtransform.H5Pget_data_transform_f",  error, total_error)
+  CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f, ptrgetTest, total_error)
+  CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
+
+! check case when receiving buffer to small
+
+  CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_small, error, size=size)
+  CALL check("dtransform.H5Pget_data_transform_f",  error, total_error)
+  CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:7), ptrgetTest_small, total_error)
+  CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
+
+! check case when receiving buffer to big
+
+  CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_big, error, size=size)
+  CALL check("dtransform.H5Pget_data_transform_f",  error, total_error)
+  CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:15), ptrgetTest_big(1:15), total_error)
+  CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size), 15, total_error)
+
+  CALL H5Fclose_f(file_id, error)
+  CALL check("H5Fclose_f", error, total_error)
+
+  IF(cleanup) CALL h5_cleanup_f("dtransform", H5P_DEFAULT_F, error)
+  CALL check("h5_cleanup_f", error, total_error)
+
+
+END SUBROUTINE dtransform
+
+
+!/****************************************************************
+!**
+!**  test_genprop_basic_class(): Test basic generic property list code.
+!**      Tests creating new generic classes.
+!**
+!****************************************************************/
+
+SUBROUTINE test_genprop_basic_class(cleanup, total_error)
+
+  USE HDF5 ! This module contains all necessary modules 
+  
+  IMPLICIT NONE
+  LOGICAL, INTENT(IN)  :: cleanup
+  INTEGER, INTENT(INOUT) :: total_error
+
+  INTEGER(HID_T) :: cid1		!/* Generic Property class ID */
+  INTEGER(HID_T) :: cid2		!/* Generic Property class ID */
+  INTEGER(HID_T) :: cid3		!/* Generic Property class ID */
+
+  CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1"
+  CHARACTER(LEN=7)  :: name              ! /* Name of class */
+  CHARACTER(LEN=10) :: name_big          ! /* Name of class bigger buffer */
+  CHARACTER(LEN=4)  :: name_small        ! /* Name of class smaller buffer*/
+  INTEGER :: error
+  INTEGER :: size
+  LOGICAL :: flag
+
+  !/* Output message about test being performed */
+
+  WRITE(*,*) "Testing Basic Generic Property List Class Creation Functionality"
+
+  ! /* Create a new generic class, derived from the root of the class hierarchy */
+  CALL H5Pcreate_class_f(H5P_ROOT_F, CLASS1_NAME, cid1, error)
+  CALL check("H5Pcreate_class", error, total_error)
+
+  ! /* Check class name */
+  CALL H5Pget_class_name_f(cid1, name, size, error)
+  CALL check("H5Pget_class_name", error, total_error)
+  CALL VERIFY("H5Pget_class_name", size,7,error)
+  CALL verifystring("H5Pget_class_name", name, CLASS1_NAME, error)
+  IF(error.NE.0)THEN
+     WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME
+     total_error = total_error + 1
+  ENDIF  
+  
+  ! /* Check class name smaller buffer*/
+  CALL H5Pget_class_name_f(cid1, name_small, size, error)
+  CALL check("H5Pget_class_name", error, total_error)
+  CALL VERIFY("H5Pget_class_name", size,7,error)
+  CALL verifystring("H5Pget_class_name", name_small(1:4), CLASS1_NAME(1:4), error)
+  IF(error.NE.0)THEN
+     WRITE(*,*) 'Class names do not match! name=',name_small(1:4), 'CLASS1_NAME=',CLASS1_NAME(1:4)
+     total_error = total_error + 1
+  ENDIF
+
+  ! /* Check class name bigger buffer*/
+  CALL H5Pget_class_name_f(cid1, name_big, size, error)
+  CALL check("H5Pget_class_name", error, total_error)
+  CALL VERIFY("H5Pget_class_name", size,7,error)
+  CALL verifystring("H5Pget_class_name", TRIM(name_big), TRIM(CLASS1_NAME), error)
+  IF(error.NE.0)THEN
+     WRITE(*,*) 'Class names do not match! name=',TRIM(name_small), 'CLASS1_NAME=',TRIM(CLASS1_NAME)
+     total_error = total_error + 1
+  ENDIF
+
+  ! /* Check class parent */
+  CALL H5Pget_class_parent_f(cid1, cid2, error)
+  CALL check("H5Pget_class_parent_f", error, total_error)
+
+  ! /* Verify class parent correct */
+  CALL H5Pequal_f(cid2, H5P_ROOT_F, flag, error)
+  CALL check("H5Pequal_f", error, total_error)
+  CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error)
+
+
+  ! /* Make certain false postives aren't being returned */
+  CALL H5Pequal_f(cid2, H5P_FILE_CREATE_F, flag, error)
+  CALL check("H5Pequal_f", error, total_error)
+  CALL verifylogical("H5Pequal_f", flag, .FALSE., total_error)
+
+  !/* Close parent class */
+  CALL H5Pclose_class_f(cid2, error)
+  CALL check("H5Pclose_class_f", error, total_error)
+
+
+  !/* Close class */
+  CALL H5Pclose_class_f(cid1, error)
+  CALL check("H5Pclose_class_f", error, total_error)
+
+END SUBROUTINE test_genprop_basic_class
+
+SUBROUTINE test_h5s_encode(cleanup, total_error)
+
+!/****************************************************************
+!**
+!**  test_h5s_encode(): Test H5S (dataspace) encoding and decoding.
+!**
+!****************************************************************/
+
+  USE HDF5 ! This module contains all necessary modules 
+  
+  IMPLICIT NONE
+  LOGICAL, INTENT(IN)  :: cleanup
+  INTEGER, INTENT(INOUT) :: total_error
+
+  INTEGER(hid_t) :: sid1, sid2, sid3!	/* Dataspace ID		*/
+  INTEGER(hid_t) :: decoded_sid1, decoded_sid2, decoded_sid3
+  INTEGER :: rank	!/* LOGICAL rank of dataspace	*/
+  INTEGER(size_t) :: sbuf_size=0, null_size=0, scalar_size=0
+
+! Make sure the size is large, need variable length in fortran 2003
+  CHARACTER(LEN=288) :: sbuf
+  CHARACTER(LEN=288) :: scalar_buf
+! F2003  CHARACTER(LEN=:), ALLOCATABLE :: sbuf
+
+!    unsigned char       *sbuf=NULL, *null_sbuf=NULL, *scalar_buf=NULL;
+!    hsize_t		tdims[4];	/* Dimension array to test with */
+  INTEGER(hsize_t) :: n ! /* Number of dataspace elements */
+
+  INTEGER(hsize_t), DIMENSION(1:3) :: start = (/0, 0, 0/)
+  INTEGER(hsize_t), DIMENSION(1:3) :: stride = (/2, 5, 3/)
+  INTEGER(hsize_t), DIMENSION(1:3) :: count = (/2, 2, 2/)
+  INTEGER(hsize_t), DIMENSION(1:3) :: BLOCK = (/1, 3, 1/)
+
+  INTEGER :: space_type
+
+!    H5S_sel_type        sel_type;
+!    hssize_t            nblocks;
+  !
+  !Dataset dimensions 
+  !
+  INTEGER, PARAMETER :: SPACE1_DIM1= 3,  SPACE1_DIM2=15, SPACE1_DIM3=13
+
+  INTEGER(HSIZE_T), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/)
+  INTEGER :: SPACE1_RANK = 3
+  INTEGER :: error
+
+  !/* Output message about test being performed */
+  WRITE(*,*) "Testing Dataspace Encoding and Decoding"
+
+  !/*-------------------------------------------------------------------------
+  ! * Test encoding and decoding of simple dataspace and hyperslab selection.
+  ! *-------------------------------------------------------------------------
+  ! */
+  
+  CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error)
+  CALL check("H5Screate_simple", error, total_error)
+  
+  CALL h5sselect_hyperslab_f(sid1, H5S_SELECT_SET_F, &
+       start, count, error, stride=stride, BLOCK=BLOCK) 
+  CALL check("h5sselect_hyperslab_f", error, total_error)
+  
+  
+  !/* Encode simple data space in a buffer */
+
+  !         First find the buffer size
+  CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
+  CALL check("H5Sencode", error, total_error)
+
+  ! In fortran 2003 we can allocate the needed character size here
+
+  ! /* Try decoding bogus buffer */
+
+  CALL H5Sdecode_f(sbuf, decoded_sid1, error)
+  CALL VERIFY("H5Sdecode", error, -1, total_error)
+
+  CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
+  CALL check("H5Sencode", error, total_error)
+
+  ! /* Decode from the dataspace buffer and return an object handle */
+  CALL H5Sdecode_f(sbuf, decoded_sid1, error)
+  CALL check("H5Sdecode", error, total_error)
+
+
+  ! /* Verify the decoded dataspace */
+  CALL h5sget_simple_extent_npoints_f(decoded_sid1, n, error)
+  CALL check("h5sget_simple_extent_npoints_f", error, total_error)
+  CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3, &
+       total_error)
+
+!!$
+!!$    rank = H5Sget_simple_extent_ndims(decoded_sid1);
+!!$    CHECK(rank, FAIL, "H5Sget_simple_extent_ndims");
+!!$    VERIFY(rank, SPACE1_RANK, "H5Sget_simple_extent_ndims");
+!!$
+!!$    rank = H5Sget_simple_extent_dims(decoded_sid1, tdims, NULL);
+!!$    CHECK(rank, FAIL, "H5Sget_simple_extent_dims");
+!!$    VERIFY(HDmemcmp(tdims, dims1, SPACE1_RANK * sizeof(hsize_t)), 0,
+!!$	   "H5Sget_simple_extent_dims");
+!!$
+!!$    /* Verify hyperslabe selection */
+!!$    sel_type = H5Sget_select_type(decoded_sid1);
+!!$    VERIFY(sel_type, H5S_SEL_HYPERSLABS, "H5Sget_select_type");
+!!$
+!!$    nblocks = H5Sget_select_hyper_nblocks(decoded_sid1);
+!!$    VERIFY(nblocks, 2*2*2, "H5Sget_select_hyper_nblocks");
+!!$
+  !
+  !Close the dataspace for the dataset.
+  !
+  CALL h5sclose_f(sid1, error)
+  CALL check("h5sclose_f", error, total_error)
+ 
+  CALL h5sclose_f(decoded_sid1, error)
+  CALL check("h5sclose_f", error, total_error)    
+
+!!$
+!!$    ret = H5Sclose(decoded_sid1);
+!!$    CHECK(ret, FAIL, "H5Sclose");
+!!$
+!!$    /*-------------------------------------------------------------------------
+!!$     * Test encoding and decoding of null dataspace.
+!!$     *-------------------------------------------------------------------------
+!!$     */
+!!$    sid2 = H5Screate(H5S_NULL);
+!!$    CHECK(sid2, FAIL, "H5Screate");
+!!$
+!!$    /* Encode null data space in a buffer */
+!!$    ret = H5Sencode(sid2, NULL, &null_size);
+!!$    CHECK(ret, FAIL, "H5Sencode");
+!!$
+!!$    if(null_size>0)
+!!$        null_sbuf = (unsigned char*)HDcalloc((size_t)1, null_size);
+!!$
+!!$    ret = H5Sencode(sid2, null_sbuf, &null_size);
+!!$    CHECK(ret, FAIL, "H5Sencode");
+!!$
+!!$    /* Decode from the dataspace buffer and return an object handle */
+!!$    decoded_sid2=H5Sdecode(null_sbuf);
+!!$    CHECK(decoded_sid2, FAIL, "H5Sdecode");
+!!$
+!!$    /* Verify decoded dataspace */
+!!$    space_type = H5Sget_simple_extent_type(decoded_sid2);
+!!$    VERIFY(space_type, H5S_NULL, "H5Sget_simple_extent_type");
+!!$
+!!$    ret = H5Sclose(sid2);
+!!$    CHECK(ret, FAIL, "H5Sclose");
+!!$
+!!$    ret = H5Sclose(decoded_sid2);
+!!$    CHECK(ret, FAIL, "H5Sclose");
+!!$
+  ! /*-------------------------------------------------------------------------
+  !  * Test encoding and decoding of scalar dataspace.
+  !  *-------------------------------------------------------------------------
+  !  */
+  ! /* Create scalar dataspace */
+
+  CALL H5Screate_f(H5S_SCALAR_F, sid3, error)
+  CALL check("H5Screate_f",error, total_error)
+
+  ! /* Encode scalar data space in a buffer */
+
+  !        First find the buffer size
+  CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error)
+  CALL check("H5Sencode_f", error, total_error)
+
+  ! encode
+
+  CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error)
+  CALL check("H5Sencode_f", error, total_error)
+
+
+  ! /* Decode from the dataspace buffer and return an object handle */
+
+  CALL H5Sdecode_f(scalar_buf, decoded_sid3, error)
+  CALL check("H5Sdecode_f", error, total_error)
+
+
+  ! /* Verify extent type */
+
+  CALL H5Sget_simple_extent_type_f(decoded_sid3, space_type, error)
+  CALL check("H5Sget_simple_extent_type_f", error, total_error)
+  CALL VERIFY("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error)
+
+  ! /* Verify decoded dataspace */
+  CALL h5sget_simple_extent_npoints_f(decoded_sid3, n, error)
+  CALL check("h5sget_simple_extent_npoints_f", error, total_error)
+  CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), 1, total_error)
+
+  CALL H5Sget_simple_extent_ndims_f(decoded_sid3, rank, error)
+  CALL CHECK("H5Sget_simple_extent_ndims_f", error, total_error)
+  CALL VERIFY("H5Sget_simple_extent_ndims_f", rank, 0, total_error )
+
+  CALL h5sclose_f(sid3, error)
+  CALL check("h5sclose_f", error, total_error)
+ 
+  CALL h5sclose_f(decoded_sid3, error)
+  CALL check("h5sclose_f", error, total_error)
+
+END SUBROUTINE test_h5s_encode
+
+!/*-------------------------------------------------------------------------
+! * Function:    test_hard_query
+! *
+! * Purpose:     Tests H5Tcompiler_conv() for querying whether a conversion is
+! *              a hard one.
+! *
+! * Return:      Success:        0
+! *
+! *              Failure:        number of errors
+! *
+! * Programmer:  Raymond Lu
+! *              Friday, Sept 2, 2005
+! *
+! * Modifications:
+! *
+! *-------------------------------------------------------------------------
+! */
+
+!!$SUBROUTINE test_hard_query(total_error)
+!!$
+!!$  USE HDF5 ! This module contains all necessary modules 
+!!$  
+!!$  IMPLICIT NONE
+!!$  INTEGER, INTENT(INOUT) :: total_error
+!!$
+!!$  INTEGER :: error
+!!$  LOGICAL :: flag
+!!$
+!!$  WRITE(*,*) "query functions of compiler conversion"
+!!$
+!!$  ! /* Verify the conversion from int to float is a hard conversion. */
+!!$
+!!$  CALL H5Tcompiler_conv_f(H5T_INTEGER_F, H5T_FLOAT_F, flag, error)
+!!$  CALL check("H5Tcompiler_conv", error, total_error)
+!!$  CALL VerifyLogical("H5Tcompiler_conv", flag, .TRUE.,total_error)
+
+!!$    if((ret = H5Tcompiler_conv(H5T_NATIVE_INT, H5T_NATIVE_FLOAT))!=TRUE) {
+!!$        H5_FAILED();
+!!$        printf("Can't query conversion function\n");
+!!$        goto error;
+!!$    }
+
+!!$    /* Unregister the hard conversion from int to float.  Verify the conversion
+!!$     * is a soft conversion. */
+!!$    H5Tunregister(H5T_PERS_HARD, NULL, H5T_NATIVE_INT, H5T_NATIVE_FLOAT, H5T_conv_int_float);
+!!$    if((ret = H5Tcompiler_conv(H5T_NATIVE_INT, H5T_NATIVE_FLOAT))!=FALSE) {
+!!$        H5_FAILED();
+!!$        printf("Can't query conversion function\n");
+!!$        goto error;
+!!$    }
+!!$
+!!$    /* Register the hard conversion from int to float.  Verify the conversion
+!!$     * is a hard conversion. */
+!!$    H5Tregister(H5T_PERS_HARD, "int_flt", H5T_NATIVE_INT, H5T_NATIVE_FLOAT, H5T_conv_int_float);
+!!$    if((ret = H5Tcompiler_conv(H5T_NATIVE_INT, H5T_NATIVE_FLOAT))!=TRUE) {
+!!$        H5_FAILED();
+!!$        printf("Can't query conversion function\n");
+!!$        goto error;
+!!$    }
+!!$
+!!$    PASSED();
+!!$    reset_hdf5();
+!!$
+!!$    return 0;
+!!$
+!!$END SUBROUTINE test_hard_query
+
+
+!/*-------------------------------------------------------------------------
+! * Function:    test_encode
+! *
+! * Purpose:     Tests functions of encoding and decoding datatype.
+! *
+! * Return:      Success:        0
+! *
+! *              Failure:        number of errors
+! *
+! * Programmer:  Raymond Lu
+! *              July 14, 2004
+! *
+! * Modifications:
+! *
+! *-------------------------------------------------------------------------
+! */
+
+!!$SUBROUTINE test_encode(total_error)
+!!$
+!!$  USE HDF5 ! This module contains all necessary modules 
+!!$      struct s1 {
+!!$        int    a;
+!!$        float  b;
+!!$        long   c;
+!!$        double d;
+!!$    };
+!!$  IMPLICIT NONE
+!!$  INTEGER, INTENT(INOUT) :: total_error
+!!$  INTEGER(SIZE_T), PARAMETER :: sizechar = 1024
+!!$  INTEGER :: error
+!!$  INTEGER(hid_t) :: file=-1, tid1=-1, tid2=-1
+!!$  INTEGER(hid_t) :: decoded_tid1=-1, decoded_tid2=-1
+!!$  CHARACTER(LEN=1024) :: filename = 'encode.h5'
+!!$    char        compnd_type[]="Compound_type", enum_type[]="Enum_type";
+!!$    short       enum_val;
+!!$    size_t      cmpd_buf_size = 0;
+!!$    size_t      enum_buf_size = 0;
+!!$    unsigned char       *cmpd_buf=NULL, *enum_buf=NULL;
+!!$    herr_t      ret;
+!!$    INTEGER(HID_T) :: dt5_id      ! Memory datatype identifier 
+!!$
+!!$    INTEGER(SIZE_T)     ::   type_sizec  ! Size of the character datatype
+!!$
+!!$   WRITE(*,*) "functions of encoding and decoding datatypes"
+!!$
+!!$   !/* Create File */
+!!$
+!!$   CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
+!!$   CALL check("H5Fcreate_f", error, total_error)
+!!$
+!!$   !/*-----------------------------------------------------------------------
+!!$   ! * Create compound and enumerate datatypes
+!!$   ! *-----------------------------------------------------------------------
+!!$   ! */
+!!$
+!!$   ! /* Create a compound datatype */
+!!$   CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, error)
+!!$   CALL check("h5tcopy_f", error, total_error)
+!!$   sizechar = 2
+!!$   CALL h5tset_size_f(dt5_id, sizechar, error)
+!!$   CALL check("h5tset_size_f", error, total_error)
+!!$   CALL h5tget_size_f(dt5_id, type_sizec, error)
+!!$   CALL check("h5tget_size_f", error, total_error)
+!!$
+!!$   CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizec, error)
+!!$   CALL check("h5tget_size_f", error, total_error)
+!!$   CALL h5tcreate_f(H5T_COMPOUND_F, type_sizec, dtype_id, error)
+!!$
+!!$
+!!$    if((tid1=H5Tcreate(H5T_COMPOUND, sizeof(struct s1))) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't create datatype!\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tinsert(tid1, "a", HOFFSET(struct s1, a), H5T_NATIVE_INT) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't insert field 'a'\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tinsert(tid1, "b", HOFFSET(struct s1, b), H5T_NATIVE_FLOAT) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't insert field 'b'\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tinsert(tid1, "c", HOFFSET(struct s1, c), H5T_NATIVE_LONG) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't insert field 'c'\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tinsert(tid1, "d", HOFFSET(struct s1, d), H5T_NATIVE_DOUBLE) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't insert field 'd'\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Create a enumerate datatype */
+!!$    if((tid2=H5Tcreate(H5T_ENUM, sizeof(short))) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't create enumerate type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tenum_insert(tid2, "RED", (enum_val=0,&enum_val)) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't insert field into enumeration type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tenum_insert(tid2, "GREEN", (enum_val=1,&enum_val)) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't insert field into enumeration type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tenum_insert(tid2, "BLUE", (enum_val=2,&enum_val)) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't insert field into enumeration type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tenum_insert(tid2, "ORANGE", (enum_val=3,&enum_val)) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't insert field into enumeration type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tenum_insert(tid2, "YELLOW", (enum_val=4,&enum_val)) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't insert field into enumeration type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /*-----------------------------------------------------------------------
+!!$     * Test encoding and decoding compound and enumerate datatypes
+!!$     *-----------------------------------------------------------------------
+!!$     */
+!!$    /* Encode compound type in a buffer */
+!!$    if(H5Tencode(tid1, NULL, &cmpd_buf_size) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't encode compound type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    if(cmpd_buf_size>0)
+!!$        cmpd_buf = (unsigned char*)calloc(1, cmpd_buf_size);
+!!$
+!!$    /* Try decoding bogus buffer */
+!!$    H5E_BEGIN_TRY {
+!!$	ret = H5Tdecode(cmpd_buf);
+!!$    } H5E_END_TRY;
+!!$    if(ret!=FAIL) {
+!!$        H5_FAILED();
+!!$        printf("Decoded bogus buffer!\n");
+!!$        goto error;
+!!$    }
+!!$
+!!$    if(H5Tencode(tid1, cmpd_buf, &cmpd_buf_size) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't encode compound type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Decode from the compound buffer and return an object handle */
+!!$    if((decoded_tid1 = H5Tdecode(cmpd_buf)) < 0)
+!!$        FAIL_PUTS_ERROR("Can't decode compound type\n")
+!!$
+!!$    /* Verify that the datatype was copied exactly */
+!!$    if(H5Tequal(decoded_tid1, tid1)<=0) {
+!!$        H5_FAILED();
+!!$        printf("Datatype wasn't encoded & decoded identically\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Query member number and member index by name, for compound type. */
+!!$    if(H5Tget_nmembers(decoded_tid1)!=4) {
+!!$        H5_FAILED();
+!!$        printf("Can't get member number\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tget_member_index(decoded_tid1, "c")!=2) {
+!!$        H5_FAILED();
+!!$        printf("Can't get correct index number\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$
+!!$    /* Encode enumerate type in a buffer */
+!!$    if(H5Tencode(tid2, NULL, &enum_buf_size) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't encode enumerate type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    if(enum_buf_size>0)
+!!$        enum_buf = (unsigned char*)calloc(1, enum_buf_size);
+!!$
+!!$    if(H5Tencode(tid2, enum_buf, &enum_buf_size) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't encode enumerate type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Decode from the enumerate buffer and return an object handle */
+!!$    if((decoded_tid2=H5Tdecode(enum_buf)) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't decode enumerate type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Verify that the datatype was copied exactly */
+!!$    if(H5Tequal(decoded_tid2, tid2)<=0) {
+!!$        H5_FAILED();
+!!$        printf("Datatype wasn't encoded & decoded identically\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Query member number and member index by name, for enumeration type. */
+!!$    if(H5Tget_nmembers(decoded_tid2)!=5) {
+!!$        H5_FAILED();
+!!$        printf("Can't get member number\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tget_member_index(decoded_tid2, "ORANGE") != 3) {
+!!$        H5_FAILED();
+!!$        printf("Can't get correct index number\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /*-----------------------------------------------------------------------
+!!$     * Commit and reopen the compound and enumerate datatypes
+!!$     *-----------------------------------------------------------------------
+!!$     */
+!!$    /* Commit compound datatype and close it */
+!!$    if(H5Tcommit2(file, compnd_type, tid1, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't commit compound datatype\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tclose(tid1) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't close datatype\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tclose(decoded_tid1) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't close datatype\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    free(cmpd_buf);
+!!$    cmpd_buf_size = 0;
+!!$
+!!$    /* Commit enumeration datatype and close it */
+!!$    if(H5Tcommit2(file, enum_type, tid2, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't commit compound datatype\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tclose(tid2) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't close datatype\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tclose(decoded_tid2) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't close datatype\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    free(enum_buf);
+!!$    enum_buf_size = 0;
+!!$
+!!$    /* Open the dataytpe for query */
+!!$    if((tid1 = H5Topen2(file, compnd_type, H5P_DEFAULT)) < 0)
+!!$        FAIL_STACK_ERROR
+!!$    if((tid2 = H5Topen2(file, enum_type, H5P_DEFAULT)) < 0)
+!!$        FAIL_STACK_ERROR
+!!$
+!!$
+!!$    /* Encode compound type in a buffer */
+!!$    if(H5Tencode(tid1, NULL, &cmpd_buf_size) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't encode compound type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    if(cmpd_buf_size>0)
+!!$        cmpd_buf = (unsigned char*)calloc(1, cmpd_buf_size);
+!!$
+!!$    if(H5Tencode(tid1, cmpd_buf, &cmpd_buf_size) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't encode compound type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Decode from the compound buffer and return an object handle */
+!!$    if((decoded_tid1 = H5Tdecode(cmpd_buf)) < 0)
+!!$        FAIL_PUTS_ERROR("Can't decode compound type\n")
+!!$
+!!$    /* Verify that the datatype was copied exactly */
+!!$    if(H5Tequal(decoded_tid1, tid1)<=0) {
+!!$        H5_FAILED();
+!!$        printf("Datatype wasn't encoded & decoded identically\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Query member number and member index by name, for compound type. */
+!!$    if(H5Tget_nmembers(decoded_tid1)!=4) {
+!!$        H5_FAILED();
+!!$        printf("Can't get member number\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tget_member_index(decoded_tid1, "c")!=2) {
+!!$        H5_FAILED();
+!!$        printf("Can't get correct index number\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /*-----------------------------------------------------------------------
+!!$     * Test encoding and decoding compound and enumerate datatypes
+!!$     *-----------------------------------------------------------------------
+!!$     */
+!!$    /* Encode enumerate type in a buffer */
+!!$    if(H5Tencode(tid2, NULL, &enum_buf_size) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't encode enumerate type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    if(enum_buf_size>0)
+!!$        enum_buf = (unsigned char*)calloc(1, enum_buf_size);
+!!$
+!!$    if(H5Tencode(tid2, enum_buf, &enum_buf_size) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't encode enumerate type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Decode from the enumerate buffer and return an object handle */
+!!$    if((decoded_tid2=H5Tdecode(enum_buf)) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't decode enumerate type\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Verify that the datatype was copied exactly */
+!!$    if(H5Tequal(decoded_tid2, tid2)<=0) {
+!!$        H5_FAILED();
+!!$        printf("Datatype wasn't encoded & decoded identically\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /* Query member number and member index by name, for enumeration type. */
+!!$    if(H5Tget_nmembers(decoded_tid2)!=5) {
+!!$        H5_FAILED();
+!!$        printf("Can't get member number\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tget_member_index(decoded_tid2, "ORANGE")!=3) {
+!!$        H5_FAILED();
+!!$        printf("Can't get correct index number\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    /*-----------------------------------------------------------------------
+!!$     * Close and release
+!!$     *-----------------------------------------------------------------------
+!!$     */
+!!$    /* Close datatype and file */
+!!$    if(H5Tclose(tid1) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't close datatype\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tclose(tid2) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't close datatype\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    if(H5Tclose(decoded_tid1) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't close datatype\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$    if(H5Tclose(decoded_tid2) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't close datatype\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    if(H5Fclose(file) < 0) {
+!!$        H5_FAILED();
+!!$        printf("Can't close file\n");
+!!$        goto error;
+!!$    } /* end if */
+!!$
+!!$    free(cmpd_buf);
+!!$    free(enum_buf);
+!!$
+!!$    PASSED();
+!!$    return 0;
+!!$
+!!$ error:
+!!$    H5E_BEGIN_TRY {
+!!$        H5Tclose (tid1);
+!!$        H5Tclose (tid2);
+!!$        H5Tclose (decoded_tid1);
+!!$        H5Tclose (decoded_tid2);
+!!$        H5Fclose (file);
+!!$    } H5E_END_TRY;
+!!$    return 1;
+!!$}