summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2014-04-08 01:00:24 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2014-04-08 01:00:24 (GMT)
commitd1f2b1a682213d98db080e91c09d3f95b4f2b3b0 (patch)
tree3f38c808358221ffbe9232ba1c23ebe439bfdb30 /fortran
parentff9a10cfdacfd30fc1720b7c82bc28d204b76ce2 (diff)
downloadhdf5-d1f2b1a682213d98db080e91c09d3f95b4f2b3b0.zip
hdf5-d1f2b1a682213d98db080e91c09d3f95b4f2b3b0.tar.gz
hdf5-d1f2b1a682213d98db080e91c09d3f95b4f2b3b0.tar.bz2
[svn-r24985] reverted the r24984 update.
Diffstat (limited to 'fortran')
-rw-r--r--fortran/test/tH5A.f9029
-rw-r--r--fortran/test/tH5P.f9024
-rw-r--r--fortran/test/tH5P_F03.f9017
-rw-r--r--fortran/test/tH5T.f9020
-rw-r--r--fortran/test/tH5T_F03.f9037
-rw-r--r--fortran/test/tH5VL.f9010
-rw-r--r--fortran/test/tf.f9058
-rw-r--r--fortran/test/tf_include.f9037
8 files changed, 96 insertions, 136 deletions
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90
index 5ba2d62..b43707c 100644
--- a/fortran/test/tH5A.f90
+++ b/fortran/test/tH5A.f90
@@ -117,7 +117,7 @@ CONTAINS
!
!general purpose integer
!
- INTEGER :: i, j, wp
+ INTEGER :: i, j
INTEGER :: error ! Error flag
!
@@ -129,6 +129,8 @@ CONTAINS
!data buffers
!
INTEGER, DIMENSION(NX,NY) :: data_in
+ LOGICAL :: differ
+
!
!Initialize data_in buffer
@@ -517,22 +519,27 @@ CONTAINS
data_dims(1) = 1
CALL h5aread_f(attr3_id, H5T_NATIVE_DOUBLE, aread_double_data, data_dims, error)
CALL check("h5aread_f",error,total_error)
-
- IF( .NOT.(aread_double_data(1) .REALEQ. 3.459_Fortran_DOUBLE) )THEN
- WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1)
- total_error = total_error + 1
- ENDIF
+ differ = .FALSE.
+ if(abs(aread_double_data(1)- 3.459D0) .ge. 1.D-08) then
+ differ = .TRUE.
+ endif
+ ! This is a temporary fix
+ !CALL compare_floats(aread_double_data(1), 3.459D0, differ)
+ IF (differ) THEN
+ WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1)
+ total_error = total_error + 1
+ END IF
!
!read the real attribute data back to memory
!
data_dims(1) = 1
CALL h5aread_f(attr4_id, H5T_NATIVE_REAL, aread_real_data, data_dims, error)
CALL check("h5aread_f",error,total_error)
-
- IF( .NOT.(aread_real_data(1) .REALEQ. REAL(4.0)) )THEN
- WRITE(*,*) "Read back real attrbute is wrong", aread_real_data(1)
- total_error = total_error + 1
- ENDIF
+ CALL compare_floats(aread_real_data(1), 4.0, differ)
+ IF (differ) THEN
+ WRITE(*,*) "Read back real attrbute is wrong ", aread_real_data
+ total_error = total_error + 1
+ END IF
!
!read the Integer attribute data back to memory
!
diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90
index 0ed12d2..454f507 100644
--- a/fortran/test/tH5P.f90
+++ b/fortran/test/tH5P.f90
@@ -450,6 +450,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
INTEGER(size_t) rdcc_nelmts
INTEGER(size_t) rdcc_nbytes
REAL :: rdcc_w0
+ LOGICAL :: differ
+
CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
IF (error .NE. 0) THEN
@@ -472,8 +474,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_1), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_1), INT(nbytes_4), total_error)
-
- IF( .NOT.( w0_1 .REALEQ. w0_4) )THEN
+ CALL compare_floats(w0_1, w0_4, differ)
+ IF(differ)THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
@@ -531,7 +533,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.( w0_2 .REALEQ. w0_4) )THEN
+ CALL compare_floats(w0_2, w0_4, differ)
+ IF(differ)THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -563,7 +566,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.( w0_3 .REALEQ. w0_4) )THEN
+ CALL compare_floats(w0_3, w0_4, differ)
+ IF(differ)THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f4", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -583,7 +587,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.( w0_2 .REALEQ. w0_4) ) THEN
+ CALL compare_floats(w0_2, w0_4, differ)
+ IF(differ)THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -603,7 +608,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.( w0_2 .REALEQ. w0_4) ) THEN
+ CALL compare_floats(w0_2, w0_4, differ)
+ IF(differ)THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
! Don't close dapl2, we will use it in the next section
@@ -640,7 +646,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.( w0_2 .REALEQ. w0_4) ) THEN
+ CALL compare_floats(w0_2, w0_4, differ)
+ IF(differ)THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
@@ -665,7 +672,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF( .NOT.( w0_3 .REALEQ. w0_4) ) THEN
+ CALL compare_floats(w0_3, w0_4, differ)
+ IF(differ)THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90
index af8cad0..9f71a73 100644
--- a/fortran/test/tH5P_F03.f90
+++ b/fortran/test/tH5P_F03.f90
@@ -118,6 +118,7 @@ SUBROUTINE test_create(total_error)
INTEGER :: error
INTEGER(SIZE_T) :: h5off
TYPE(C_PTR) :: f_ptr
+ LOGICAL :: differ1, differ2
!/*
! * Create a file.
@@ -204,8 +205,20 @@ SUBROUTINE test_create(total_error)
CALL H5Pget_fill_value_f(dcpl, comp_type_id, f_ptr, error)
CALL check("H5Pget_fill_value_f", error, total_error)
- IF( .NOT.(rd_c%a .REALEQ. fill_ctype%a) .OR. &
- .NOT.(rd_c%y .REALEQ. fill_ctype%y) .OR. &
+ differ1 = .FALSE.
+ differ2 = .FALSE.
+ if(abs(rd_c%a - fill_ctype%a) .ge. 1.D-08) then
+ differ1 = .TRUE.
+ endif
+ ! This is a workaround; needs to be fixed
+ !CALL compare_floats(rd_c%a, fill_ctype%a, differ1)
+ if(abs(rd_c%y - fill_ctype%y) .ge. 1.D-08) then
+ differ2 = .TRUE.
+ endif
+ ! This is a workaround; needs to be fixed
+ !CALL compare_floats(rd_c%y, fill_ctype%y, differ2)
+ IF( differ1 .OR. &
+ differ2 .OR. &
rd_c%x .NE. fill_ctype%x .OR. &
rd_c%z .NE. fill_ctype%z )THEN
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index cb8e27c..aac5f33 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -112,7 +112,7 @@ CONTAINS
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
@@ -528,8 +528,13 @@ CONTAINS
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( .NOT.(double_member_out(i) .REALEQ. double_member(i)) ) THEN
+ differ = .FALSE.
+ if (abs(double_member_out(i) - double_member(i)) .ge. 1.D-08) THEN
+ differ = .TRUE.
+ endif
+ ! This is temorary fix until we figure out how to compare floats
+ !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
@@ -547,10 +552,11 @@ CONTAINS
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( .NOT.(real_member_out(i) .REALEQ. real_member(i) ) ) THEN
- WRITE(*,*) " Wrong real precision data is read back "
- total_error = total_error + 1
- ENDIF
+ 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
enddo
!
! *-----------------------------------------------------------------------
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90
index f21f84a..bd6a701 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.f90
@@ -90,7 +90,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
INTEGER :: error ! Generic RETURN value
INTEGER :: namelen
- LOGICAL :: flag
+ LOGICAL :: flag, differ
TYPE(C_PTR) :: f_ptr ! Needed to pass the pointer, for g95 compiler to work
@@ -258,7 +258,8 @@ SUBROUTINE test_array_compound_atomic(total_error)
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( .NOT.( wdata(i,j)%f .REALEQ. rdata(i,j)%f) ) THEN
+ CALL compare_floats(wdata(i,j)%f, rdata(i,j)%f, differ)
+ IF(differ)THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -348,6 +349,7 @@ END SUBROUTINE test_array_compound_atomic
INTEGER(SIZE_T) :: attrlen ! Length of the attribute string
TYPE(c_ptr) :: f_ptr
+ LOGICAL :: differ
! Initialize array data to write
DO i = 1, SPACE1_DIM1
@@ -620,8 +622,8 @@ END SUBROUTINE test_array_compound_atomic
total_error = total_error + 1
ENDIF
DO k = 1, ARRAY2_DIM1
-
- IF(wdata(i,j)%f(k).NE.rdata(i,j)%f(k))THEN
+ CALL compare_floats(wdata(i,j)%f(k), rdata(i,j)%f(k), differ)
+ IF(differ)THEN
PRINT*, 'ERROR: Wrong real array data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -720,6 +722,7 @@ END SUBROUTINE test_array_compound_atomic
INTEGER :: error
TYPE(c_ptr) :: f_ptr
+ LOGICAL :: differ
! Initialize the data
! -------------------
@@ -831,12 +834,13 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
-
- IF( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN
+ CALL compare_floats(cf(i)%b(j), cfr(i)%b(j), differ)
+ IF(differ)THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN
+ CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ)
+ IF(differ)THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -899,7 +903,8 @@ END SUBROUTINE test_array_compound_atomic
DO i = 1, LENGTH
DO j = 1, ALEN
- IF( .NOT.(fld(i)%b(j) .REALEQ. fldr(i)%b(j) ) ) THEN
+ CALL compare_floats(fld(i)%b(j), fldr(i)%b(j), differ)
+ IF(differ)THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -930,11 +935,13 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN
+ CALL compare_floats(cf(i)%b(j), cfr(i)%b(j), differ)
+ IF(differ)THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN
+ CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ)
+ IF(differ)THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -988,11 +995,13 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN
+ CALL compare_floats(cf(i)%b(j),cfr(i)%b(j), differ)
+ IF(differ)THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN
+ CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ)
+ IF(differ)THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -2997,6 +3006,7 @@ SUBROUTINE test_nbit(total_error )
LOGICAL :: status
INTEGER(hsize_t) :: i, j
TYPE(C_PTR) :: f_ptr
+ LOGICAL :: differ
! check to see if filter is available
CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error)
@@ -3069,7 +3079,8 @@ SUBROUTINE test_nbit(total_error )
i_loop: DO i = 1, dims(1)
j_loop: DO j = 1, dims(2)
IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN
- IF( .NOT.(new_data(i,j) .REALEQ. orig_data(i,j) ) ) THEN
+ CALL compare_floats(new_data(i,j), orig_data(i,j), differ)
+ IF(differ)THEN
total_error = total_error + 1
WRITE(*,'(" Read different values than written.")')
WRITE(*,'(" At index ", 2(1X,I0))') i, j
diff --git a/fortran/test/tH5VL.f90 b/fortran/test/tH5VL.f90
index 6803f59..d34b42c 100644
--- a/fortran/test/tH5VL.f90
+++ b/fortran/test/tH5VL.f90
@@ -226,6 +226,7 @@ CONTAINS
INTEGER(SIZE_T) max_len
INTEGER(HID_T) :: vl_type_id
LOGICAL :: vl_flag
+ LOGICAL :: differ
!
! Initialize the vl_int_data array.
@@ -330,10 +331,11 @@ CONTAINS
CALL check("h5dread_real_f", error, total_error)
do ih = 1, data_dims(2)
do jh = 1, len_out(ih)
- IF( .NOT.(vl_real_data(jh,ih) .REALEQ. vl_real_data_out(jh,ih)) ) THEN
- total_error = total_error + 1
- WRITE(*,*) "h5dread_vl_f returned incorrect data"
- ENDIF
+ CALL compare_floats(vl_real_data(jh,ih), vl_real_data_out(jh,ih), differ)
+ if(differ) then
+ total_error = total_error + 1
+ write(*,*) "h5dread_vl_f returned incorrect data"
+ endif
enddo
if (len(ih) .ne. len_out(ih)) then
total_error = total_error + 1
diff --git a/fortran/test/tf.f90 b/fortran/test/tf.f90
index 78c7034..cfa403a 100644
--- a/fortran/test/tf.f90
+++ b/fortran/test/tf.f90
@@ -28,63 +28,13 @@
!
!*****
-! Define single, double and quadprecision
-
-MODULE h5_kinds
- INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(6, 37)
- INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15, 307)
- INTEGER, PARAMETER :: qp = SELECTED_REAL_KIND(33, 4931)
-END MODULE h5_kinds
-
-! Functions for Comparing two REAL numbers that
-! are quad, double and single precision.
-
-MODULE single_test_eqv
- USE h5_kinds, ONLY: wp => sp
- IMPLICIT NONE
-CONTAINS
- INCLUDE 'tf_include.f90'
-END MODULE single_test_eqv
-
-MODULE double_test_eqv
- USE h5_kinds, ONLY: wp => dp
- IMPLICIT NONE
-CONTAINS
- INCLUDE 'tf_include.f90'
-END MODULE double_test_eqv
-
-MODULE quad_test_eqv
- USE h5_kinds, ONLY: wp => qp
- IMPLICIT NONE
-CONTAINS
- INCLUDE 'tf_include.f90'
-END MODULE quad_test_eqv
-
-! Interface operator for comparing reals
-
-MODULE generic_eqv
-
- USE single_test_eqv, ONLY: test_eqv_1 => test_eqv
- USE double_test_eqv, ONLY: test_eqv_2 => test_eqv
- USE quad_test_eqv , ONLY: test_eqv_3 => test_eqv
- IMPLICIT NONE
- PRIVATE
- PUBLIC OPERATOR(.realeq.)
-
- INTERFACE OPERATOR(.realeq.)
- MODULE PROCEDURE test_eqv_1, test_eqv_2, test_eqv_3
- END INTERFACE
-
-END MODULE generic_eqv
-
MODULE TH5_MISC
- USE generic_eqv
- INTERFACE compare_floats
- MODULE PROCEDURE compare_floats_4
- MODULE PROCEDURE compare_floats_8
- END INTERFACE
+INTERFACE compare_floats
+ MODULE PROCEDURE compare_floats_4
+ MODULE PROCEDURE compare_floats_8
+END INTERFACE
CONTAINS
diff --git a/fortran/test/tf_include.f90 b/fortran/test/tf_include.f90
deleted file mode 100644
index bb7fd1b..0000000
--- a/fortran/test/tf_include.f90
+++ /dev/null
@@ -1,37 +0,0 @@
-!****h* root/fortran/test/tf_include.f90
-!
-! NAME
-! tf_include.f90
-!
-! FUNCTION
-! Contains overloaded operators for the hdf5 fortran tests, include in
-! tf.f90
-!
-! 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_eqv
-!
-!*****
-
-! Function for comparing two REAL(KIND=*) numbers.
-
-PURE FUNCTION test_eqv(a,b)
- LOGICAL test_eqv
- REAL(wp), INTENT (in):: a,b
- test_eqv = ABS(a-b) .LT. 1.e-8
-END FUNCTION test_eqv