diff options
Diffstat (limited to 'fortran/test/tH5T.f90')
| -rw-r--r-- | fortran/test/tH5T.f90 | 1149 |
1 files changed, 0 insertions, 1149 deletions
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 deleted file mode 100644 index efbceea..0000000 --- a/fortran/test/tH5T.f90 +++ /dev/null @@ -1,1149 +0,0 @@ -!****h* root/fortran/test/tH5T.f90 -! -! NAME -! tH5T.f90 -! -! FUNCTION -! Basic testing of Fortran H5T APIs. -! -! 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 -! compoundtest, basic_data_type_test, enumtest, test_derived_flt -! -!***** - -MODULE TH5T - - USE HDF5 - USE TH5_MISC - USE TH5_MISC_GEN - -CONTAINS - - SUBROUTINE compoundtest(cleanup, total_error) -! -! This program creates a dataset that is one dimensional array of -! structures { -! character*2 -! integer -! double precision -! real -! } -! Data is written and read back by fields. -! -! The following H5T interface functions are tested: -! h5tcopy_f, h5tset(get)_size_f, h5tcreate_f, h5tinsert_f, h5tclose_f, -! h5tget_class_f, h5tget_member_name_f, h5tget_member_offset_f, h5tget_member_type_f, -! h5tequal_f, h5tinsert_array_f, h5tcommit_f, h5tencode_f, h5tdecode_f - - - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error - - CHARACTER(LEN=8), PARAMETER :: filename = "compound" ! File name - CHARACTER(LEN=80) :: fix_filename - CHARACTER(LEN=8), PARAMETER :: dsetname = "Compound" ! Dataset name - INTEGER, PARAMETER :: dimsize = 6 ! Size of the dataset - INTEGER, PARAMETER :: COMP_NUM_MEMBERS = 4 ! Number of members in the compound datatype - - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier - INTEGER(HID_T) :: dspace_id ! Dataspace identifier - INTEGER(HID_T) :: dtype_id ! Compound datatype identifier - INTEGER(HID_T) :: dtarray_id ! Compound datatype identifier - INTEGER(HID_T) :: arrayt_id ! Array datatype identifier - INTEGER(HID_T) :: dt1_id ! Memory datatype identifier (for character field) - INTEGER(HID_T) :: dt2_id ! Memory datatype identifier (for integer field) - INTEGER(HID_T) :: dt3_id ! Memory datatype identifier (for double precision field) - INTEGER(HID_T) :: dt4_id ! Memory datatype identifier (for real field) - INTEGER(HID_T) :: dt5_id ! Memory datatype identifier - INTEGER(HID_T) :: membtype_id ! Datatype identifier - INTEGER(HID_T) :: plist_id ! Dataset trasfer property - - - INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/dimsize/) ! Dataset dimensions - INTEGER :: rank = 1 ! Dataset rank - - INTEGER :: error ! Error flag - INTEGER(SIZE_T) :: type_size ! Size of the datatype - INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype - INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype - INTEGER(SIZE_T) :: type_sized ! Size of the double precision datatype - INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype - INTEGER(SIZE_T) :: offset ! Member's offset - INTEGER(SIZE_T) :: offset_out ! Member's offset - CHARACTER(LEN=2), DIMENSION(dimsize) :: char_member - CHARACTER(LEN=2), DIMENSION(dimsize) :: char_member_out ! Buffer to read data out - INTEGER, DIMENSION(dimsize) :: int_member - INTEGER, DIMENSION(dimsize) :: int_member_out - REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member - REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member_out - REAL, DIMENSION(dimsize) :: real_member - REAL, DIMENSION(dimsize) :: real_member_out - INTEGER :: i - INTEGER :: class ! Datatype class - INTEGER :: num_members ! Number of members in the compound datatype - CHARACTER(LEN=256) :: member_name - INTEGER :: len ! Lenght of the name of the compound datatype member - INTEGER :: member_index ! index of the field - INTEGER(HSIZE_T), DIMENSION(3) :: array_dims=(/2,3,4/) - INTEGER :: array_dims_range = 3 - INTEGER :: elements = 24 ! number of elements in the array_dims array. - INTEGER(SIZE_T) :: sizechar - INTEGER(HSIZE_T), DIMENSION(1) :: data_dims - LOGICAL :: flag = .TRUE. - - CHARACTER(LEN=1024) :: cmpd_buf - INTEGER(SIZE_T) :: cmpd_buf_size=0 - INTEGER(HID_T) :: decoded_tid1 - - INTEGER(HID_T) :: fixed_str1, fixed_str2 - LOGICAL :: are_equal - INTEGER(SIZE_T), PARAMETER :: str_size = 10 - INTEGER(SIZE_T) :: query_size - - ! Test h5tcreate_f with H5T_STRING_F option: - ! Create fixed-length string in two ways and make sure they are the same - - CALL h5tcopy_f(H5T_FORTRAN_S1, fixed_str1, error) - CALL check("h5tcopy_f", error, total_error) - CALL h5tset_size_f(fixed_str1, str_size, error) - CALL check("h5tset_size_f", error, total_error) - CALL h5tset_strpad_f(fixed_str1, H5T_STR_NULLTERM_F, error) - CALL check("h5tset_strpad_f", error, total_error) - - CALL h5tcreate_f(H5T_STRING_F, str_size, fixed_str2, error) - CALL check("h5tcreate_f", error, total_error) - CALL h5tset_strpad_f(fixed_str2, H5T_STR_NULLTERM_F, error) - CALL check("h5tset_strpad_f", error, total_error) - - CALL h5tequal_f(fixed_str1, fixed_str2, are_equal, error) - IF(.NOT.are_equal)THEN - CALL check("h5tcreate_f", -1, total_error) - ENDIF - - CALL h5tget_size_f(fixed_str1, query_size, error) - CALL check("h5tget_size_f", error, total_error) - - IF(query_size.NE.str_size)THEN - CALL check("h5tget_size_f", -1, total_error) - ENDIF - - CALL h5tget_size_f(fixed_str2, query_size, error) - CALL check("h5tget_size_f", error, total_error) - - IF(query_size.NE.str_size)THEN - CALL check("h5tget_size_f", -1, total_error) - ENDIF - - CALL h5tclose_f(fixed_str1,error) - CALL check("h5tclose_f", error, total_error) - - CALL h5tclose_f(fixed_str2,error) - CALL check("h5tclose_f", error, total_error) - data_dims(1) = dimsize - ! - ! Initialize data buffer. - ! - do i = 1, dimsize - char_member(i)(1:1) = char(65+i) - char_member(i)(2:2) = char(65+i) - char_member_out(i)(1:1) = char(65) - char_member_out(i)(2:2) = char(65) - int_member(i) = i - int_member_out(i) = 0 - double_member(i) = 2.* i - double_member_out(i) = 0. - real_member(i) = 3. * i - real_member_out(i) = 0. - enddo - - ! - ! Set dataset transfer property to preserve partially initialized fields - ! during write/read to/from dataset with compound datatype. - ! - CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, error) - CALL check("h5pcreate_f", error, total_error) - CALL h5pset_preserve_f(plist_id, flag, error) - CALL check("h5pset_preserve_f", error, total_error) - ! - ! Create a new file using default properties. - ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) - CALL check("h5fcreate_f", error, total_error) - - ! - ! Create the dataspace. - ! - CALL h5screate_simple_f(rank, dims, dspace_id, error) - CALL check("h5screate_simple_f", error, total_error) - ! - ! Create compound datatype. - ! - ! First calculate total size by calculating sizes of each member - ! - 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_sizei, error) - CALL check("h5tget_size_f", error, total_error) - CALL h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, error) - CALL check("h5tget_size_f", error, total_error) - CALL h5tget_size_f(H5T_NATIVE_REAL, type_sizer, error) - CALL check("h5tget_size_f", error, total_error) - !write(*,*) "get sizes", type_sizec, type_sizei, type_sizer, type_sized - type_size = type_sizec + type_sizei + type_sized + type_sizer - CALL h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, error) - CALL check("h5tcreate_f", error, total_error) - ! - ! Insert memebers - ! - ! CHARACTER*2 memeber - ! - offset = 0 - CALL h5tinsert_f(dtype_id, "char_field", offset, dt5_id, error) - CALL check("h5tinsert_f", error, total_error) - ! - ! INTEGER member - ! - offset = offset + type_sizec ! Offset of the second memeber is 2 - CALL h5tinsert_f(dtype_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) - CALL check("h5tinsert_f", error, total_error) - ! - ! DOUBLE PRECISION member - ! - offset = offset + type_sizei ! Offset of the third memeber is 6 - CALL h5tinsert_f(dtype_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) - CALL check("h5tinsert_f", error, total_error) - ! - ! REAL member - ! - offset = offset + type_sized ! Offset of the last member is 14 - CALL h5tinsert_f(dtype_id, "real_field", offset, H5T_NATIVE_REAL, error) - CALL check("h5tinsert_f", error, total_error) - ! - ! Create the dataset with compound datatype. - ! - CALL h5dcreate_f(file_id, dsetname, dtype_id, dspace_id, & - dset_id, error) - CALL check("h5dcreate_f", error, total_error) - ! - ! Create memory types. We have to create a compound datatype - ! for each member we want to write. - ! - CALL h5tcreate_f(H5T_COMPOUND_F, type_sizec, dt1_id, error) - CALL check("h5tcreate_f", error, total_error) - offset = 0 - CALL h5tinsert_f(dt1_id, "char_field", offset, dt5_id, error) - CALL check("h5tinsert_f", error, total_error) - ! - CALL h5tcreate_f(H5T_COMPOUND_F, type_sizei, dt2_id, error) - CALL check("h5tcreate_f", error, total_error) - offset = 0 - CALL h5tinsert_f(dt2_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) - CALL check("h5tinsert_f", error, total_error) - ! - CALL h5tcreate_f(H5T_COMPOUND_F, type_sized, dt3_id, error) - CALL check("h5tcreate_f", error, total_error) - offset = 0 - CALL h5tinsert_f(dt3_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) - CALL check("h5tinsert_f", error, total_error) - ! - CALL h5tcreate_f(H5T_COMPOUND_F, type_sizer, dt4_id, error) - CALL check("h5tcreate_f", error, total_error) - offset = 0 - CALL h5tinsert_f(dt4_id, "real_field", offset, H5T_NATIVE_REAL, error) - CALL check("h5tinsert_f", error, total_error) - ! - ! Write data by fields in the datatype. Fields order is not important. - ! - CALL h5dwrite_f(dset_id, dt4_id, real_member, data_dims, error, xfer_prp = plist_id) - CALL check("h5dwrite_f", error, total_error) - CALL h5dwrite_f(dset_id, dt1_id, char_member, data_dims, error, xfer_prp = plist_id) - CALL check("h5dwrite_f", error, total_error) - CALL h5dwrite_f(dset_id, dt3_id, double_member, data_dims, error, xfer_prp = plist_id) - CALL check("h5dwrite_f", error, total_error) - CALL h5dwrite_f(dset_id, dt2_id, int_member, data_dims, error, xfer_prp = plist_id) - CALL check("h5dwrite_f", error, total_error) - - ! - ! End access to the dataset and release resources used by it. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f", error, total_error) - - ! - ! Terminate access to the data space. - ! - CALL h5sclose_f(dspace_id, error) - CALL check("h5sclose_f", error, total_error) - ! - ! Terminate access to the datatype - ! - CALL h5tclose_f(dtype_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dt1_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dt2_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dt3_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dt4_id, error) - CALL check("h5tclose_f", error, total_error) - ! - ! Create and store compound datatype with the character and - ! array members. - ! - type_size = type_sizec + elements*type_sizer ! Size of compound datatype - CALL h5tcreate_f(H5T_COMPOUND_F, type_size, dtarray_id, error) - CALL check("h5tcreate_f", error, total_error) - offset = 0 - CALL h5tinsert_f(dtarray_id, "char_field", offset, H5T_NATIVE_CHARACTER, error) - CALL check("h5tinsert_f", error, total_error) - offset = type_sizec - CALL h5tarray_create_f(H5T_NATIVE_REAL, array_dims_range, array_dims, arrayt_id, error) - CALL check("h5tarray_create_f", error, total_error) - CALL h5tinsert_f(dtarray_id,"array_field", offset, arrayt_id, error) - CALL check("h5tinsert_f", error, total_error) - CALL h5tcommit_f(file_id, "Compound_with_array_member", dtarray_id, error) - CALL check("h5tcommit_f", error, total_error) - CALL h5tclose_f(arrayt_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dtarray_id, error) - CALL check("h5tclose_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 (fix_filename, H5F_ACC_RDWR_F, file_id, error) - CALL check("h5fopen_f", error, total_error) - ! - ! Open the dataset. - ! - CALL h5dopen_f(file_id, dsetname, dset_id, error) - CALL check("h5dopen_f", error, total_error) - ! - ! Get datatype of the open dataset. - ! Check it class, number of members, and member's names. - ! - CALL h5dget_type_f(dset_id, dtype_id, error) - CALL check("h5dget_type_f", error, total_error) - CALL h5tget_class_f(dtype_id, class, error) - CALL check("h5dget_class_f", error, total_error) - if (class .ne. H5T_COMPOUND_F) then - write(*,*) " Wrong class type returned" - total_error = total_error + 1 - endif - CALL h5tget_nmembers_f(dtype_id, num_members, error) - CALL check("h5dget_nmembers_f", error, total_error) - if (num_members .ne. COMP_NUM_MEMBERS ) then - write(*,*) " Wrong number of members returned" - total_error = total_error + 1 - endif - ! - ! Go through the members and find out their names and offsets. - ! Also see if name corresponds to the index - ! - do i = 1, num_members - CALL h5tget_member_name_f(dtype_id, i-1, member_name, len, error) - CALL check("h5tget_member_name_f", error, total_error) - CALL h5tget_member_offset_f(dtype_id, i-1, offset_out, error) - CALL check("h5tget_member_offset_f", error, total_error) - CALL h5tget_member_index_f(dtype_id, member_name(1:len), member_index, error) - CALL check("h5tget_member_index_f", error, total_error) - if(member_index .ne. i-1) then - write(*,*) "Index returned is incorrect" - write(*,*) member_index, i-1 - total_error = total_error + 1 - endif - - CHECK_NAME: SELECT CASE (member_name(1:len)) - CASE("char_field") - if(offset_out .ne. 0) then - write(*,*) "Offset of the char member is incorrect" - total_error = total_error + 1 - endif - CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) - CALL check("h5tget_member_type_f", error, total_error) - CALL h5tequal_f(membtype_id, dt5_id, flag, error) - CALL check("h5tequal_f", error, total_error) - if(.not. flag) then - write(*,*) "Wrong member type returned for character member" - total_error = total_error + 1 - endif - CALL h5tget_member_class_f(dtype_id, i-1, class, error) - CALL check("h5tget_member_class_f",error, total_error) - if (class .ne. H5T_STRING_F) then - write(*,*) "Wrong class returned for character member" - total_error = total_error + 1 - endif - CASE("integer_field") - if(offset_out .ne. type_sizec) then - write(*,*) "Offset of the integer member is incorrect" - total_error = total_error + 1 - endif - CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) - CALL check("h5tget_member_type_f", error, total_error) - CALL h5tequal_f(membtype_id, H5T_NATIVE_INTEGER, flag, error) - CALL check("h5tequal_f", error, total_error) - if(.not. flag) then - write(*,*) "Wrong member type returned for integer memebr" - total_error = total_error + 1 - endif - CALL h5tget_member_class_f(dtype_id, i-1, class, error) - CALL check("h5tget_member_class_f",error, total_error) - if (class .ne. H5T_INTEGER_F) then - write(*,*) "Wrong class returned for INTEGER member" - total_error = total_error + 1 - endif - CASE("double_field") - if(offset_out .ne. (type_sizec+type_sizei)) then - write(*,*) "Offset of the double precision member is incorrect" - total_error = total_error + 1 - endif - CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) - CALL check("h5tget_member_type_f", error, total_error) - CALL h5tequal_f(membtype_id, H5T_NATIVE_DOUBLE, flag, error) - CALL check("h5tequal_f", error, total_error) - if(.not. flag) then - write(*,*) "Wrong member type returned for double precision memebr" - total_error = total_error + 1 - endif - CALL h5tget_member_class_f(dtype_id, i-1, class, error) - CALL check("h5tget_member_class_f",error, total_error) - if (class .ne. H5T_FLOAT_F) then - write(*,*) "Wrong class returned for double precision member" - total_error = total_error + 1 - endif - CASE("real_field") - if(offset_out .ne. (type_sizec+type_sizei+type_sized)) then - write(*,*) "Offset of the real member is incorrect" - total_error = total_error + 1 - endif - CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) - CALL check("h5tget_member_type_f", error, total_error) - CALL h5tequal_f(membtype_id, H5T_NATIVE_REAL, flag, error) - CALL check("h5tequal_f", error, total_error) - if(.not. flag) then - write(*,*) "Wrong member type returned for real memebr" - total_error = total_error + 1 - endif - CALL h5tget_member_class_f(dtype_id, i-1, class, error) - CALL check("h5tget_member_class_f",error, total_error) - if (class .ne. H5T_FLOAT_F) then - write(*,*) "Wrong class returned for real member" - total_error = total_error + 1 - endif - CASE DEFAULT - write(*,*) "Wrong member's name" - total_error = total_error + 1 - - END SELECT CHECK_NAME - - enddo - ! - ! Create memory datatype to read character member of the compound datatype. - ! - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt2_id, error) - CALL check("h5tcopy_f", error, total_error) - sizechar = 2 - CALL h5tset_size_f(dt2_id, sizechar, error) - CALL check("h5tset_size_f", error, total_error) - CALL h5tget_size_f(dt2_id, type_size, error) - CALL check("h5tget_size_f", error, total_error) - CALL h5tcreate_f(H5T_COMPOUND_F, type_size, dt1_id, error) - CALL check("h5tcreate_f", error, total_error) - offset = 0 - CALL h5tinsert_f(dt1_id, "char_field", offset, dt2_id, error) - CALL check("h5tinsert_f", error, total_error) - ! - ! Read part of the dataset - ! - CALL h5dread_f(dset_id, dt1_id, char_member_out, data_dims, error) - CALL check("h5dread_f", error, total_error) - do i = 1, dimsize - if (char_member_out(i) .ne. char_member(i)) then - write(*,*) " Wrong character data is read back " - total_error = total_error + 1 - endif - enddo - ! - CALL h5tcreate_f(H5T_COMPOUND_F, type_sizei, dt5_id, error) - CALL check("h5tcreate_f", error, total_error) - offset = 0 - CALL h5tinsert_f(dt5_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) - CALL check("h5tinsert_f", error, total_error) - ! - ! Read part of the dataset - ! - CALL h5dread_f(dset_id, dt5_id, int_member_out, data_dims, error) - CALL check("h5dread_f", error, total_error) - do i = 1, dimsize - if (int_member_out(i) .ne. int_member(i)) then - write(*,*) " Wrong integer data is read back " - total_error = total_error + 1 - endif - enddo - ! - ! - CALL h5tcreate_f(H5T_COMPOUND_F, type_sized, dt3_id, error) - CALL check("h5tcreate_f", error, total_error) - offset = 0 - CALL h5tinsert_f(dt3_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) - CALL check("h5tinsert_f", error, total_error) - ! - ! Read part of the dataset - ! - CALL h5dread_f(dset_id, dt3_id, double_member_out, data_dims, error) - CALL check("h5dread_f", error, total_error) - DO i = 1, dimsize - CALL VERIFY("h5dread_f:Wrong double precision data is read back", double_member_out(i), double_member(i), total_error) - ENDDO - ! - ! - CALL h5tcreate_f(H5T_COMPOUND_F, type_sizer, dt4_id, error) - CALL check("h5tcreate_f", error, total_error) - offset = 0 - CALL h5tinsert_f(dt4_id, "real_field", offset, H5T_NATIVE_REAL, error) - CALL check("h5tinsert_f", error, total_error) - ! - ! Read part of the dataset - ! - CALL h5dread_f(dset_id, dt4_id, real_member_out, data_dims, error) - CALL check("h5dread_f", error, total_error) - DO i = 1, dimsize - CALL VERIFY("h5dread_f:Wrong double precision data is read back", real_member_out(i), real_member(i), total_error) - ENDDO - ! - ! *----------------------------------------------------------------------- - ! * Test encoding and decoding compound datatypes - ! *----------------------------------------------------------------------- - ! - ! Encode compound type in a buffer - ! -- First find the buffer size - - CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) - CALL check("H5Tencode_f", error, total_error) - - ! Try decoding bogus buffer - - CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) - CALL verify("H5Tdecode_f", error, -1, total_error) - - CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) - CALL check("H5Tencode_f", error, total_error) - - ! Decode from the compound buffer and return an object handle - CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) - CALL check("H5Tdecode_f", error, total_error) - - ! Verify that the datatype was copied exactly - - CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error) - CALL check("H5Tequal_f", error, total_error) - CALL verify("H5Tequal_f", flag, .TRUE., total_error) - ! - ! Close all open objects. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f", error, total_error) - CALL h5tclose_f(dt1_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dt2_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dt3_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dt4_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dt5_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f", error, total_error) - - IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN - END SUBROUTINE compoundtest - - - - - SUBROUTINE basic_data_type_test(total_error) - -! This subroutine tests following functionalities: -! H5tget_precision_f, H5tset_precision_f, H5tget_offset_f -! H5tset_offset_f, H5tget_pad_f, H5tset_pad_f, H5tget_sign_f, -! H5tset_sign_f, H5tget_ebias_f,H5tset_ebias_f, H5tget_norm_f, -! H5tset_norm_f, H5tget_inpad_f, H5tset_inpad_f, H5tget_cset_f, -! H5tset_cset_f, H5tget_strpad_f, H5tset_strpad_f - - IMPLICIT NONE - INTEGER, INTENT(OUT) :: total_error - - INTEGER(HID_T) :: dtype1_id, dtype2_id, dtype3_id, dtype4_id, dtype5_id - ! datatype identifiers - INTEGER(SIZE_T) :: precision ! Datatype precision - INTEGER(SIZE_T) :: setprecision ! Datatype precision - INTEGER(SIZE_T) :: offset ! Datatype offset - INTEGER(SIZE_T) :: setoffset ! Datatype offset - INTEGER :: lsbpad !padding type of the least significant bit - INTEGER :: msbpad !padding type of the most significant bit - INTEGER :: sign !sign type for an integer type - INTEGER(SIZE_T) :: ebias1 !Datatype exponent bias of a floating-point type - INTEGER(SIZE_T) :: ebias2 !Datatype exponent bias of a floating-point type - INTEGER(SIZE_T) :: setebias - INTEGER :: norm !mantissa normalization of a floating-point datatype - INTEGER :: inpad !padding type for unused bits in floating-point datatypes. - INTEGER :: cset !character set type of a string datatype - INTEGER :: strpad !string padding method for a string datatype - INTEGER :: error !error flag - - - ! - ! Create a datatype - ! - CALL h5tcopy_f(H5T_STD_U16BE, dtype1_id, error) - CALL check("h5tcopy_f",error,total_error) - ! - !datatype type_id should be modifiable after h5tcopy_f - ! - setprecision = 12 - CALL h5tset_precision_f(dtype1_id, setprecision, error) - CALL check("h5set_precision_f",error,total_error) - CALL h5tget_precision_f(dtype1_id,precision, error) - CALL check("h5get_precision_f",error,total_error) - if(precision .ne. 12) then - write (*,*) "got precision is not correct" - total_error = total_error + 1 - end if - - CALL h5tcopy_f(H5T_STD_I32LE, dtype2_id, error) - CALL check("h5tcopy_f",error,total_error) - setprecision = 12 - CALL h5tset_precision_f(dtype2_id, setprecision, error) - CALL check("h5set_precision_f",error,total_error) - - setoffset = 2 - CALL h5tset_offset_f(dtype1_id, setoffset, error) - CALL check("h5set_offset_f",error,total_error) - setoffset = 10 - CALL h5tset_offset_f(dtype2_id, setoffset, error) - CALL check("h5set_offset_f",error,total_error) - CALL h5tget_offset_f(dtype2_id,offset, error) - CALL check("h5get_offset_f",error,total_error) - if(offset .ne. 10) then - write (*,*) "got offset is not correct" - total_error = total_error + 1 - end if - - CALL h5tset_pad_f(dtype2_id,H5T_PAD_ONE_F, H5T_PAD_ONE_F, error) - CALL check("h5set_pad_f",error,total_error) - CALL h5tget_pad_f(dtype2_id,lsbpad,msbpad, error) - CALL check("h5get_pad_f",error,total_error) - if((lsbpad .ne. H5T_PAD_ONE_F) .and. (msbpad .ne. H5T_PAD_ONE_F)) then - write (*,*) "got pad is not correct" - total_error = total_error + 1 - end if - -! CALL h5tset_sign_f(dtype2_id,H5T_SGN_2_F, error) -! CALL check("h5set_sign_f",error,total_error) -! CALL h5tget_sign_f(dtype2_id,sign, error) - CALL h5tget_sign_f(H5T_NATIVE_INTEGER, sign, error) - CALL check("h5tget_sign_f",error,total_error) - if(sign .ne. H5T_SGN_2_F ) then - write (*,*) "got sign is not correct" - total_error = total_error + 1 - end if - - CALL h5tcopy_f(H5T_IEEE_F64BE, dtype3_id, error) - CALL check("h5tcopy_f",error,total_error) - CALL h5tcopy_f(H5T_IEEE_F32LE, dtype4_id, error) - CALL check("h5tcopy_f",error,total_error) - - setebias = 257 - CALL h5tset_ebias_f(dtype3_id, setebias, error) - CALL check("h5tset_ebias_f",error,total_error) - setebias = 1 - CALL h5tset_ebias_f(dtype4_id, setebias, error) - CALL check("h5tset_ebias_f",error,total_error) - CALL h5tget_ebias_f(dtype3_id, ebias1, error) - CALL check("h5tget_ebias_f",error,total_error) - if(ebias1 .ne. 257 ) then - write (*,*) "got ebias is not correct" - total_error = total_error + 1 - end if - CALL h5tget_ebias_f(dtype4_id, ebias2, error) - CALL check("h5tget_ebias_f",error,total_error) - if(ebias2 .ne. 1 ) then - write (*,*) "got ebias is not correct" - total_error = total_error + 1 - end if - - !attention: - !It seems that I can't use H5T_NORM_IMPLIED_F to set the norm value - !because I got error for the get_norm function -! CALL h5tset_norm_f(dtype3_id,H5T_NORM_IMPLIED_F , error) -! CALL check("h5tset_norm_f",error,total_error) -! CALL h5tget_norm_f(dtype3_id, norm, error) -! CALL check("h5tget_norm_f",error,total_error) -! if(norm .ne. H5T_NORM_IMPLIED_F ) then -! write (*,*) "got norm is not correct" -! total_error = total_error + 1 -! end if - CALL h5tset_norm_f(dtype3_id, H5T_NORM_MSBSET_F , error) - CALL check("h5tset_norm_f",error,total_error) - CALL h5tget_norm_f(dtype3_id, norm, error) - CALL check("h5tget_norm_f",error,total_error) - if(norm .ne. H5T_NORM_MSBSET_F ) then - write (*,*) "got norm is not correct" - total_error = total_error + 1 - end if - - CALL h5tset_norm_f(dtype3_id, H5T_NORM_NONE_F , error) - CALL check("h5tset_norm_f",error,total_error) - CALL h5tget_norm_f(dtype3_id, norm, error) - CALL check("h5tget_norm_f",error,total_error) - if(norm .ne. H5T_NORM_NONE_F ) then - write (*,*) "got norm is not correct" - total_error = total_error + 1 - end if - - CALL h5tset_inpad_f(dtype3_id, H5T_PAD_ZERO_F , error) - CALL check("h5tset_inpad_f",error,total_error) - CALL h5tget_inpad_f(dtype3_id, inpad , error) - CALL check("h5tget_inpad_f",error,total_error) - if(inpad .ne. H5T_PAD_ZERO_F ) then - write (*,*) "got inpad is not correct" - total_error = total_error + 1 - end if - - CALL h5tset_inpad_f(dtype3_id,H5T_PAD_ONE_F , error) - CALL check("h5tset_inpad_f",error,total_error) - CALL h5tget_inpad_f(dtype3_id, inpad , error) - CALL check("h5tget_inpad_f",error,total_error) - if(inpad .ne. H5T_PAD_ONE_F ) then - write (*,*) "got inpad is not correct" - total_error = total_error + 1 - end if - - CALL h5tset_inpad_f(dtype3_id,H5T_PAD_BACKGROUND_F , error) - CALL check("h5tset_inpad_f",error,total_error) - CALL h5tget_inpad_f(dtype3_id, inpad , error) - CALL check("h5tget_inpad_f",error,total_error) - if(inpad .ne. H5T_PAD_BACKGROUND_F ) then - write (*,*) "got inpad is not correct" - total_error = total_error + 1 - end if - -! we should not apply h5tset_cset_f to non_character data typemake - -! CALL h5tset_cset_f(dtype4_id, H5T_CSET_ASCII_F, error) -! CALL check("h5tset_cset_f",error,total_error) -! CALL h5tget_cset_f(dtype4_id, cset, error) -! CALL check("h5tget_cset_f",error,total_error) -! if(cset .ne. H5T_CSET_ASCII_F ) then -! write (*,*) "got cset is not correct" -! total_error = total_error + 1 -! end if - - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dtype5_id, error) - CALL check("h5tcopy_f",error,total_error) - CALL h5tset_cset_f(dtype5_id, H5T_CSET_ASCII_F, error) - CALL check("h5tset_cset_f",error,total_error) - CALL h5tget_cset_f(dtype5_id, cset, error) - CALL check("h5tget_cset_f",error,total_error) - if(cset .ne. H5T_CSET_ASCII_F ) then - write (*,*) "got cset is not correct" - total_error = total_error + 1 - end if - CALL h5tset_strpad_f(dtype5_id, H5T_STR_NULLPAD_F, error) - CALL check("h5tset_strpad_f",error,total_error) - CALL h5tget_strpad_f(dtype5_id, strpad, error) - CALL check("h5tget_strpad_f",error,total_error) - if(strpad .ne. H5T_STR_NULLPAD_F ) then - write (*,*) "got strpad is not correct" - total_error = total_error + 1 - end if - - CALL h5tset_strpad_f(dtype5_id, H5T_STR_SPACEPAD_F, error) - CALL check("h5tset_strpad_f",error,total_error) - CALL h5tget_strpad_f(dtype5_id, strpad, error) - CALL check("h5tget_strpad_f",error,total_error) - if(strpad .ne. H5T_STR_SPACEPAD_F ) then - write (*,*) "got strpad is not correct" - total_error = total_error + 1 - end if - - CALL h5tclose_f(dtype1_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dtype2_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dtype3_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dtype4_id, error) - CALL check("h5tclose_f", error, total_error) - CALL h5tclose_f(dtype5_id, error) - CALL check("h5tclose_f", error, total_error) - - - RETURN - END SUBROUTINE basic_data_type_test - - SUBROUTINE enumtest(cleanup, total_error) - - USE HDF5 - USE TH5_MISC - IMPLICIT NONE - - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error - CHARACTER(LEN=4), PARAMETER :: filename="enum" - CHARACTER(LEN=80) :: fix_filename - CHARACTER(LEN=8), PARAMETER :: dsetname="enumdset" - CHARACTER(LEN=4) :: true ="TRUE" - CHARACTER(LEN=5) :: false="FALSE" - CHARACTER(LEN=5) :: mem_name - - INTEGER(HID_T) :: file_id - INTEGER(HID_T) :: dset_id - INTEGER(HID_T) :: dspace_id - INTEGER(HID_T) :: dtype_id, dtype, native_type - INTEGER :: error - INTEGER :: value - INTEGER(HSIZE_T), DIMENSION(1) :: dsize - INTEGER(SIZE_T) :: buf_size - INTEGER, DIMENSION(2) :: data - INTEGER(HSIZE_T), DIMENSION(7) :: dims - INTEGER :: order1, order2 -! INTEGER(SIZE_T) :: type_size1, type_size2 - INTEGER :: class - - dims(1) = 2 - dsize(1) = 2 - data(1) = 1 - data(2) = 0 - ! - ! Create a new file using default properties. - ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - IF (error .NE. 0) THEN - WRITE(*,*) "Cannot modify filename" - STOP - ENDIF - CALL h5fcreate_f(fix_filename,H5F_ACC_TRUNC_F,file_id,error) - CALL check("h5fcreate_f", error, total_error) - ! - ! Create enumeration datatype with tow values - ! - CALL h5tenum_create_f(H5T_NATIVE_INTEGER,dtype_id,error) - CALL check("h5tenum_create_f", error, total_error) - CALL h5tenum_insert_f(dtype_id,true,DATA(1),error) - CALL check("h5tenum_insert_f", error, total_error) - CALL h5tenum_insert_f(dtype_id,false,DATA(2),error) - CALL check("h5tenum_insert_f", error, total_error) - ! - ! Create write and close a dataset with enum datatype - ! - CALL h5screate_simple_f(1,dsize,dspace_id,error) - CALL check("h5screate_simple_f", error, total_error) - CALL h5dcreate_f(file_id,dsetname,dtype_id,dspace_id,dset_id,error) - CALL check("h5dcreate_f", error, total_error) - CALL h5dwrite_f(dset_id,dtype_id,DATA,dims,error) - CALL check("h5dwrite_f", error, total_error) - - CALL H5Dget_type_f(dset_id, dtype, error) - CALL check("H5Dget_type_f", error, total_error) - - CALL H5Tget_native_type_f(dtype, H5T_DIR_ASCEND_F, native_type, error) - CALL check("H5Tget_native_type_f",error, total_error) - - ! Verify the datatype retrieved and converted - CALL H5Tget_order_f(native_type, order1, error) - CALL check("H5Tget_order_f",error, total_error) - CALL H5Tget_order_f(H5T_NATIVE_INTEGER, order2, error) - CALL check("H5Tget_order_f",error, total_error) - CALL verify("H5Tget_native_type_f",order1, order2, total_error) - - ! this test depends on whether -i8 was specified - -!!$ CALL H5Tget_size_f(native_type, type_size1, error) -!!$ CALL check("H5Tget_size_f",error, total_error) -!!$ CALL H5Tget_size_f(H5T_STD_I32BE, type_size2, error) -!!$ CALL check("H5Tget_size_f",error, total_error) -!!$ CALL verify("H5Tget_native_type_f", INT(type_size1), INT(type_size2), total_error) - - CALL H5Tget_class_f(native_type, class, error) - CALL check("H5Tget_class_f",error, total_error) - CALL verify("H5Tget_native_type_f", INT(class), INT(H5T_ENUM_F), total_error) - - CALL h5dclose_f(dset_id,error) - CALL check("h5dclose_f", error, total_error) - CALL h5sclose_f(dspace_id,error) - CALL check("h5sclose_f", error, total_error) - ! - ! Get value of "TRUE" - ! - CALL h5tenum_valueof_f(dtype_id, "TRUE", value, error) - CALL check("h5tenum_valueof_f", error, total_error) - IF (value .NE. 1) THEN - WRITE(*,*) " Value of TRUE is not 1, error" - total_error = total_error + 1 - ENDIF - ! - ! Get name of 0 - ! - value = 0 - buf_size = 5 - CALL h5tenum_nameof_f(dtype_id, value, buf_size, mem_name, error) - CALL check("h5tenum_nameof_f", error, total_error) - IF (mem_name .NE. "FALSE") THEN - WRITE(*,*) " Wrong name for 0 value" - total_error = total_error + 1 - ENDIF - - CALL h5tclose_f(dtype_id,error) - CALL check("h5tclose_f", error, total_error) - CALL h5fclose_f(file_id,error) - CALL check("h5fclose_f", error, total_error) - - IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - - RETURN - END SUBROUTINE enumtest - -!------------------------------------------------------------------------- -! * Function: test_derived_flt -! * -! * Purpose: Tests user-define and query functions of floating-point types. -! * test h5tget/set_fields_f. -! * -! * Return: Success: 0 -! * -! * Failure: number of errors -! * -! * Fortran Programmer: M.S. Breitenfeld -! * September 9, 2008 -! * -! * Modifications: -! * -! *------------------------------------------------------------------------- -! - -SUBROUTINE test_derived_flt(cleanup, total_error) - - - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error - INTEGER(hid_t) :: file=-1, tid1=-1, tid2=-1 - INTEGER(hid_t) :: dxpl_id=-1 - INTEGER(size_t) :: spos, epos, esize, mpos, msize - - CHARACTER(LEN=15), PARAMETER :: filename="h5t_derived_flt" - CHARACTER(LEN=80) :: fix_filename - - INTEGER(SIZE_T) :: precision1, offset1, ebias1, size1 - INTEGER(SIZE_T) :: precision2, offset2, ebias2, size2 - - INTEGER :: error - - ! Create File - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - IF (error .NE. 0) THEN - WRITE(*,*) "Cannot modify filename" - STOP - ENDIF - - CALL h5fcreate_f(fix_filename,H5F_ACC_TRUNC_F,file,error) - CALL check("h5fcreate_f", error, total_error) - - CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, error) - CALL check("h5pcreate_f", error, total_error) - - CALL h5tcopy_f(H5T_IEEE_F64LE, tid1, error) - CALL check("h5tcopy_f",error,total_error) - - CALL h5tcopy_f(H5T_IEEE_F32LE, tid2, error) - CALL check("h5tcopy_f",error,total_error) - - !------------------------------------------------------------------------ - ! * 1st floating-point type - ! * size=7 byte, precision=42 bits, offset=3 bits, mantissa size=31 bits, - ! * mantissa position=3, exponent size=10 bits, exponent position=34, - ! * exponent bias=511. It can be illustrated in little-endian order as - ! * - ! * 6 5 4 3 2 1 0 - ! * ???????? ???SEEEE EEEEEEMM MMMMMMMM MMMMMMMM MMMMMMMM MMMMM??? - ! * - ! * To create a new floating-point type, the following properties must be - ! * set in the order of - ! * set fields -> set offset -> set precision -> set size. - ! * All these properties must be set before the type can function. Other - ! * properties can be set anytime. Derived type size cannot be expanded - ! * bigger than original size but can be decreased. There should be no - ! * holes among the significant bits. Exponent bias usually is set - ! * 2^(n-1)-1, where n is the exponent size. - ! *----------------------------------------------------------------------- - - CALL H5Tset_fields_f(tid1, INT(44,size_t), INT(34,size_t), INT(10,size_t), & - INT(3,size_t), INT(31,size_t), error) - CALL check("H5Tset_fields_f",error,total_error) - - CALL H5Tset_offset_f(tid1, INT(3,size_t), error) - CALL check("H5Tset_offset_f",error,total_error) - - CALL H5Tset_precision_f(tid1, INT(42,size_t), error) - CALL check("H5Tset_precision_f",error,total_error) - - CALL H5Tset_size_f(tid1, INT(7,size_t), error) - CALL check("H5Tset_size_f",error,total_error) - - CALL H5Tset_ebias_f(tid1, INT(511,size_t), error) - CALL check("H5Tset_ebias_f",error,total_error) - - CALL H5Tset_pad_f(tid1, H5T_PAD_ZERO_F, H5T_PAD_ZERO_F, error) - CALL check("H5Tset_pad_f",error,total_error) - - CALL h5tcommit_f(file, "new float type 1", tid1, error) - CALL check("h5tcommit_f", error, total_error) - - CALL h5tclose_f(tid1, error) - CALL check("h5tclose_f", error, total_error) - - CALL H5Topen_f(file, "new float type 1", tid1, error) - CALL check("H5Topen_f", error, total_error) - - CALL H5Tget_fields_f(tid1, spos, epos, esize, mpos, msize, error) - CALL check("H5Tget_fields_f", error, total_error) - - IF(spos.NE.44 .OR. epos.NE.34 .OR. esize.NE.10 .OR. mpos.NE.3 .OR. msize.NE.31)THEN - CALL verify("H5Tget_fields_f", -1, 0, total_error) - ENDIF - - CALL H5Tget_precision_f(tid1, precision1, error) - CALL check("H5Tget_precision_f", error, total_error) - CALL verify("H5Tget_precision_f", INT(precision1), 42, total_error) - - CALL H5Tget_offset_f(tid1, offset1, error) - CALL check("H5Tget_offset_f", error, total_error) - CALL verify("H5Tget_offset_f", INT(offset1), 3, total_error) - - CALL H5Tget_size_f(tid1, size1, error) - CALL check("H5Tget_size_f", error, total_error) - CALL verify("H5Tget_size_f", INT(size1), 7, total_error) - - CALL H5Tget_ebias_f(tid1, ebias1, error) - CALL check("H5Tget_ebias_f", error, total_error) - CALL verify("H5Tget_ebias_f", INT(ebias1), 511, total_error) - - !-------------------------------------------------------------------------- - ! * 2nd floating-point type - ! * size=3 byte, precision=24 bits, offset=0 bits, mantissa size=16 bits, - ! * mantissa position=0, exponent size=7 bits, exponent position=16, exponent - ! * bias=63. It can be illustrated in little-endian order as - ! * - ! * 2 1 0 - ! * SEEEEEEE MMMMMMMM MMMMMMMM - ! *-------------------------------------------------------------------------- - - CALL H5Tset_fields_f(tid2, INT(23,size_t), INT(16,size_t), INT(7,size_t), & - INT(0,size_t), INT(16,size_t), error) - CALL check("H5Tset_fields_f",error,total_error) - - CALL H5Tset_offset_f(tid2, INT(0,size_t), error) - CALL check("H5Tset_offset_f",error,total_error) - - CALL H5Tset_precision_f(tid2, INT(24,size_t), error) - CALL check("H5Tset_precision_f",error,total_error) - - CALL H5Tset_size_f(tid2, INT(3,size_t), error) - CALL check("H5Tset_size_f",error,total_error) - - CALL H5Tset_ebias_f(tid2, INT(63,size_t), error) - CALL check("H5Tset_ebias_f",error,total_error) - - CALL H5Tset_pad_f(tid2, H5T_PAD_ZERO_F, H5T_PAD_ZERO_F, error) - CALL check("H5Tset_pad_f",error,total_error) - - CALL h5tcommit_f(file, "new float type 2", tid2, error) - CALL check("h5tcommit_f", error, total_error) - - CALL h5tclose_f(tid2, error) - CALL check("h5tclose_f", error, total_error) - - CALL H5Topen_f(file, "new float type 2", tid2, error) - CALL check("H5Topen_f", error, total_error) - - CALL H5Tget_fields_f(tid2, spos, epos, esize, mpos, msize, error) - CALL check("H5Tget_fields_f", error, total_error) - - IF(spos.NE.23 .OR. epos.NE.16 .OR. esize.NE.7 .OR. mpos.NE.0 .OR. msize.NE.16)THEN - CALL verify("H5Tget_fields_f", -1, 0, total_error) - ENDIF - - CALL H5Tget_precision_f(tid2, precision2, error) - CALL check("H5Tget_precision_f", error, total_error) - CALL verify("H5Tget_precision_f", INT(precision2), 24, total_error) - - CALL H5Tget_offset_f(tid2, offset2, error) - CALL check("H5Tget_offset_f", error, total_error) - CALL verify("H5Tget_offset_f", INT(offset2), 0, total_error) - - CALL H5Tget_size_f(tid2, size2, error) - CALL check("H5Tget_size_f", error, total_error) - CALL verify("H5Tget_size_f", INT(size2), 3, total_error) - - CALL H5Tget_ebias_f(tid2, ebias2, error) - CALL check("H5Tget_ebias_f", error, total_error) - CALL verify("H5Tget_ebias_f", INT(ebias2), 63, total_error) - - CALL h5tclose_f(tid1, error) - CALL check("h5tclose_f", error, total_error) - - CALL h5tclose_f(tid2, error) - CALL check("h5tclose_f", error, total_error) - - CALL H5Pclose_f(dxpl_id, error) - CALL check("H5Pclose_f", error, total_error) - - CALL h5fclose_f(file,error) - CALL check("h5fclose_f", error, total_error) - - IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - -END SUBROUTINE test_derived_flt - -END MODULE TH5T |