diff options
Diffstat (limited to 'fortran/test/tH5T.f90')
| -rw-r--r-- | fortran/test/tH5T.f90 | 53 |
1 files changed, 16 insertions, 37 deletions
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index b42a8e6..60ddefb 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -27,6 +27,10 @@ ! !***** +MODULE TH5T + +CONTAINS + SUBROUTINE compoundtest(cleanup, total_error) ! ! This program creates a dataset that is one dimensional array of @@ -43,8 +47,8 @@ ! 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 - USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -105,11 +109,10 @@ CHARACTER(LEN=1024) :: cmpd_buf INTEGER(SIZE_T) :: cmpd_buf_size=0 - INTEGER(HID_T) :: decoded_sid1 INTEGER(HID_T) :: decoded_tid1 INTEGER(HID_T) :: fixed_str1, fixed_str2 - LOGICAL :: are_equal + LOGICAL :: are_equal, differ INTEGER(SIZE_T), PARAMETER :: str_size = 10 INTEGER(SIZE_T) :: query_size @@ -242,36 +245,6 @@ 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) - -!!$ !/*----------------------------------------------------------------------- -!!$ ! * 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 VerifyLogical("H5Tequal_f", flag, .TRUE., total_error) - ! ! Create the dataset with compound datatype. ! @@ -555,7 +528,8 @@ CALL h5dread_f(dset_id, dt3_id, double_member_out, data_dims, error) CALL check("h5dread_f", error, total_error) do i = 1, dimsize - if (double_member_out(i) .ne. double_member(i)) then + CALL compare_floats(double_member_out(i), double_member(i), differ) + if (differ) then write(*,*) " Wrong double precision data is read back " total_error = total_error + 1 endif @@ -573,7 +547,8 @@ CALL h5dread_f(dset_id, dt4_id, real_member_out, data_dims, error) CALL check("h5dread_f", error, total_error) do i = 1, dimsize - if (real_member_out(i) .ne. real_member(i)) then + CALL compare_floats(real_member_out(i), real_member(i), differ) + if (differ) then write(*,*) " Wrong real precision data is read back " total_error = total_error + 1 endif @@ -632,7 +607,7 @@ - SUBROUTINE basic_data_type_test(cleanup, total_error) + SUBROUTINE basic_data_type_test(total_error) ! This subroutine tests following functionalities: ! H5tget_precision_f, H5tset_precision_f, H5tget_offset_f @@ -642,9 +617,9 @@ ! H5tset_cset_f, H5tget_strpad_f, H5tset_strpad_f USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T) :: dtype1_id, dtype2_id, dtype3_id, dtype4_id, dtype5_id @@ -859,6 +834,7 @@ SUBROUTINE enumtest(cleanup, total_error) USE HDF5 + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -999,6 +975,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -1181,3 +1158,5 @@ SUBROUTINE test_derived_flt(cleanup, total_error) CALL check("h5_cleanup_f", error, total_error) END SUBROUTINE test_derived_flt + +END MODULE TH5T |