summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2014-04-08 19:34:42 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2014-04-08 19:34:42 (GMT)
commit9cd1a1bb60c66650208033d61ff377df5ac1a72e (patch)
tree1983e8fbd82c084d515a6dd1554b094a44123811 /fortran
parentd1f2b1a682213d98db080e91c09d3f95b4f2b3b0 (diff)
downloadhdf5-9cd1a1bb60c66650208033d61ff377df5ac1a72e.zip
hdf5-9cd1a1bb60c66650208033d61ff377df5ac1a72e.tar.gz
hdf5-9cd1a1bb60c66650208033d61ff377df5ac1a72e.tar.bz2
[svn-r24986] Comparing REALs now converts all REALs to double precision and then compares if the two numbers are equivalent.
Tested: jam (gnu, intel)
Diffstat (limited to 'fortran')
-rw-r--r--fortran/test/tH5A.f9024
-rw-r--r--fortran/test/tH5P.f9022
-rw-r--r--fortran/test/tH5P_F03.f9016
-rw-r--r--fortran/test/tH5T.f9021
-rw-r--r--fortran/test/tH5T_F03.f9038
-rw-r--r--fortran/test/tH5VL.f909
-rw-r--r--fortran/test/tf.f90371
7 files changed, 214 insertions, 287 deletions
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90
index b43707c..07ca6da 100644
--- a/fortran/test/tH5A.f90
+++ b/fortran/test/tH5A.f90
@@ -519,27 +519,21 @@ 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)
- 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
+
+ IF( .NOT.dreal_eq( REAL(aread_double_data(1),dp), 3.459_dp) )THEN
+ WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1)
+ total_error = total_error + 1
+ ENDIF
!
!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)
- 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
+ IF( .NOT.dreal_eq( REAL(aread_real_data(1),dp), 4.0_dp) )THEN
+ WRITE(*,*) "Read back real attrbute is wrong", aread_real_data(1)
+ total_error = total_error + 1
+ ENDIF
!
!read the Integer attribute data back to memory
!
diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90
index 454f507..c94d564 100644
--- a/fortran/test/tH5P.f90
+++ b/fortran/test/tH5P.f90
@@ -474,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)
- CALL compare_floats(w0_1, w0_4, differ)
- IF(differ)THEN
+
+ IF( .NOT.dreal_eq( REAL(w0_1,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
@@ -533,8 +533,7 @@ 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)
- CALL compare_floats(w0_2, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -566,8 +565,7 @@ 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)
- CALL compare_floats(w0_3, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(w0_3,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f4", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -587,8 +585,7 @@ 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)
- CALL compare_floats(w0_2, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -608,8 +605,7 @@ 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)
- CALL compare_floats(w0_2, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
! Don't close dapl2, we will use it in the next section
@@ -646,8 +642,7 @@ 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)
- CALL compare_floats(w0_2, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
@@ -672,8 +667,7 @@ 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)
- CALL compare_floats(w0_3, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(w0_3,dp), REAL( w0_4, dp)) ) 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 9f71a73..6039a52 100644
--- a/fortran/test/tH5P_F03.f90
+++ b/fortran/test/tH5P_F03.f90
@@ -205,20 +205,8 @@ 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)
- 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. &
+ IF( .NOT.dreal_eq( REAL(rd_c%a,dp), REAL(fill_ctype%a, dp)) .OR. &
+ .NOT.dreal_eq( REAL(rd_c%y,dp), REAL(fill_ctype%y, dp)) .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 aac5f33..8ac91d2 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -528,13 +528,7 @@ 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
- 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
+ IF( .NOT.dreal_eq( REAL(double_member_out(i),dp), REAL( double_member(i), dp)) ) THEN
write(*,*) " Wrong double precision data is read back "
total_error = total_error + 1
endif
@@ -551,13 +545,12 @@ 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
- 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
+ DO i = 1, dimsize
+ IF( .NOT.dreal_eq( REAL(real_member_out(i),dp), REAL( real_member(i), dp)) ) THEN
+ WRITE(*,*) " Wrong real precision data is read back "
+ total_error = total_error + 1
+ ENDIF
+ ENDDO
!
! *-----------------------------------------------------------------------
! * Test encoding and decoding compound datatypes
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90
index bd6a701..fc3ebd0 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, differ
+ LOGICAL :: flag
TYPE(C_PTR) :: f_ptr ! Needed to pass the pointer, for g95 compiler to work
@@ -258,8 +258,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(wdata(i,j)%f, rdata(i,j)%f, differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(wdata(i,j)%f,dp), REAL( rdata(i,j)%f, dp)) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -349,7 +348,6 @@ 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
@@ -622,8 +620,8 @@ END SUBROUTINE test_array_compound_atomic
total_error = total_error + 1
ENDIF
DO k = 1, ARRAY2_DIM1
- CALL compare_floats(wdata(i,j)%f(k), rdata(i,j)%f(k), differ)
- IF(differ)THEN
+
+ IF(wdata(i,j)%f(k).NE.rdata(i,j)%f(k))THEN
PRINT*, 'ERROR: Wrong real array data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -722,7 +720,6 @@ END SUBROUTINE test_array_compound_atomic
INTEGER :: error
TYPE(c_ptr) :: f_ptr
- LOGICAL :: differ
! Initialize the data
! -------------------
@@ -834,13 +831,11 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%b(j), cfr(i)%b(j), differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%b(j),dp), REAL( cfr(i)%b(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%c(j),dp), REAL( cfr(i)%c(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -903,8 +898,7 @@ END SUBROUTINE test_array_compound_atomic
DO i = 1, LENGTH
DO j = 1, ALEN
- CALL compare_floats(fld(i)%b(j), fldr(i)%b(j), differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(fld(i)%b(j),dp), REAL( fldr(i)%b(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -935,13 +929,11 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%b(j), cfr(i)%b(j), differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%b(j),dp), REAL(cfr(i)%b(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%c(j),dp), REAL(cfr(i)%c(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -995,13 +987,11 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%b(j),cfr(i)%b(j), differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%b(j),dp), REAL(cfr(i)%b(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%c(j),dp), REAL(cfr(i)%c(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -1184,7 +1174,7 @@ END SUBROUTINE test_array_compound_atomic
CALL verify_Fortran_INTEGER_4("h5kind_to_type2",INT(dset_data_i4(i),int_kind_8),INT(data_out_i4(i),int_kind_8),total_error)
CALL verify_Fortran_INTEGER_4("h5kind_to_type3",INT(dset_data_i8(i),int_kind_8),INT(data_out_i8(i),int_kind_8),total_error)
CALL verify_Fortran_INTEGER_4("h5kind_to_type4",INT(dset_data_i16(i),int_kind_8),INT(data_out_i16(i),int_kind_8),total_error)
-
+
CALL verify_real_kind_7("h5kind_to_type5",REAL(dset_data_r(i),real_kind_7),REAL(data_out_r(i),real_kind_7),total_error)
CALL verify_real_kind_7("h5kind_to_type6",REAL(dset_data_r7(i),real_kind_7),REAL(data_out_r7(i),real_kind_7),total_error)
CALL verify_real_kind_7("h5kind_to_type7",REAL(dset_data_r15(i),real_kind_7),REAL(data_out_r15(i),real_kind_7),total_error)
@@ -3006,7 +2996,6 @@ 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)
@@ -3079,8 +3068,7 @@ 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
- CALL compare_floats(new_data(i,j), orig_data(i,j), differ)
- IF(differ)THEN
+ IF( .NOT.dreal_eq( REAL(new_data(i,j),dp), REAL( orig_data(i,j), dp)) ) 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 d34b42c..f063722 100644
--- a/fortran/test/tH5VL.f90
+++ b/fortran/test/tH5VL.f90
@@ -331,11 +331,10 @@ CONTAINS
CALL check("h5dread_real_f", error, total_error)
do ih = 1, data_dims(2)
do jh = 1, len_out(ih)
- 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
+ IF( .NOT.dreal_eq( REAL(vl_real_data(jh,ih),dp), REAL(vl_real_data_out(jh,ih), dp)) ) 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 cfa403a..2964840 100644
--- a/fortran/test/tf.f90
+++ b/fortran/test/tf.f90
@@ -24,71 +24,44 @@
!
! CONTAINS SUBROUTINES
! write_test_status, check, verify, verifyLogical, verifyString, h5_fixname_f,
-! h5_cleanup_f, h5_exit_f, h5_env_nocleanup_f
+! h5_cleanup_f, h5_exit_f, h5_env_nocleanup_f,dreal_eqv
!
!*****
-
MODULE TH5_MISC
-
-INTERFACE compare_floats
- MODULE PROCEDURE compare_floats_4
- MODULE PROCEDURE compare_floats_8
-END INTERFACE
+ INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15, 307)
CONTAINS
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
-!DEC$attributes dllexport :: compare_floats_4
+!DEC$attributes dllexport :: dreal_eq
!DEC$endif
-SUBROUTINE compare_floats_4(val1, val2, stat)
- INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(6, 37) !should map to REAL*4 on most modern processors
- REAL(sp) :: val1, val2
- LOGICAL, INTENT(OUT) :: stat
- REAL(sp) :: EPS4 = 1.E-06
- stat = .TRUE.
- IF (ABS(val1 - val2) .LE. EPS4) THEN
- stat = .FALSE.
- ENDIF
- RETURN
-END SUBROUTINE compare_floats_4
+ LOGICAL FUNCTION dreal_eq(a,b)
+ ! Check if two double precision reals are equivalent
+ REAL(dp), INTENT (in):: a,b
+ REAL(dp), PARAMETER :: eps = 1.e-8
+ dreal_eq = ABS(a-b) .LT. eps
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_DLL)
-!DEC$attributes dllexport :: compare_floats_8
-!DEC$endif
-SUBROUTINE compare_floats_8(val1, val2, stat)
- INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15, 307) !should map to REAL*8 on most modern processors
- REAL(dp) :: val1, val2
- LOGICAL, INTENT(OUT) :: stat
- REAL(dp) :: EPS8 = 1.D-12
- stat = .TRUE.
- IF (ABS(val1 - val2) .LE. EPS8) THEN
- stat = .FALSE.
- ENDIF
- RETURN
-END SUBROUTINE compare_floats_8
+ END FUNCTION dreal_eq
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verify_real_kind_7
!DEC$endif
-SUBROUTINE verify_real_kind_7(string,value,correct_value,total_error)
- USE HDF5
- INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
- CHARACTER(LEN=*) :: string
- REAL(real_kind_7) :: value, correct_value
- INTEGER :: total_error
- LOGICAL :: differ
- CALL compare_floats(value, correct_value, differ)
- IF (differ) THEN
- total_error=total_error+1
- WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string
- ENDIF
- RETURN
-END SUBROUTINE verify_real_kind_7
+ SUBROUTINE verify_real_kind_7(string,value,correct_value,total_error)
+ USE HDF5
+ INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
+ CHARACTER(LEN=*) :: string
+ REAL(real_kind_7) :: value, correct_value
+ INTEGER :: total_error
+ IF (.NOT.dreal_eq( REAL(value,dp), REAL(correct_value, dp)) ) THEN
+ total_error=total_error+1
+ WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string
+ ENDIF
+ RETURN
+ END SUBROUTINE verify_real_kind_7
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
@@ -96,7 +69,7 @@ END SUBROUTINE verify_real_kind_7
!DEC$endif
SUBROUTINE write_test_status( test_result, test_title, total_error)
-! Writes the results of the tests
+ ! Writes the results of the tests
IMPLICIT NONE
@@ -109,11 +82,11 @@ END SUBROUTINE verify_real_kind_7
! Controls the output style for reporting test results
- CHARACTER(LEN=8) :: error_string
- CHARACTER(LEN=8), PARAMETER :: success = ' PASSED '
- CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*'
- CHARACTER(LEN=8), PARAMETER :: skip = '--SKIP--'
-
+ CHARACTER(LEN=8) :: error_string
+ CHARACTER(LEN=8), PARAMETER :: success = ' PASSED '
+ CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*'
+ CHARACTER(LEN=8), PARAMETER :: skip = '--SKIP--'
+
error_string = failure
IF (test_result == 0) THEN
@@ -133,76 +106,76 @@ END SUBROUTINE verify_real_kind_7
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: check
!DEC$endif
-SUBROUTINE check(string,error,total_error)
- CHARACTER(LEN=*) :: string
- INTEGER :: error, total_error
- IF (error .LT. 0) THEN
- total_error=total_error+1
- WRITE(*,*) string, " FAILED"
- ENDIF
- RETURN
-END SUBROUTINE check
+ SUBROUTINE check(string,error,total_error)
+ CHARACTER(LEN=*) :: string
+ INTEGER :: error, total_error
+ IF (error .LT. 0) THEN
+ total_error=total_error+1
+ WRITE(*,*) string, " FAILED"
+ ENDIF
+ RETURN
+ END SUBROUTINE check
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verify
!DEC$endif
-SUBROUTINE verify(string,value,correct_value,total_error)
- CHARACTER(LEN=*) :: string
- INTEGER :: value, correct_value, total_error
- IF (value .NE. correct_value) THEN
- total_error=total_error+1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
-END SUBROUTINE verify
+ SUBROUTINE VERIFY(string,value,correct_value,total_error)
+ CHARACTER(LEN=*) :: string
+ INTEGER :: value, correct_value, total_error
+ IF (value .NE. correct_value) THEN
+ total_error=total_error+1
+ WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
+ ENDIF
+ RETURN
+ END SUBROUTINE verify
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verify_Fortran_INTEGER_4
!DEC$endif
-SUBROUTINE verify_Fortran_INTEGER_4(string,value,correct_value,total_error)
- USE HDF5
- INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) ! should map to INTEGER*4 on most modern processors
- CHARACTER(LEN=*) :: string
- INTEGER(int_kind_8) :: value, correct_value
- INTEGER :: total_error
- IF (value .NE. correct_value) THEN
- total_error=total_error+1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
-END SUBROUTINE verify_Fortran_INTEGER_4
+ SUBROUTINE verify_Fortran_INTEGER_4(string,value,correct_value,total_error)
+ USE HDF5
+ INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) ! should map to INTEGER*4 on most modern processors
+ CHARACTER(LEN=*) :: string
+ INTEGER(int_kind_8) :: value, correct_value
+ INTEGER :: total_error
+ IF (value .NE. correct_value) THEN
+ total_error=total_error+1
+ WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
+ ENDIF
+ RETURN
+ END SUBROUTINE verify_Fortran_INTEGER_4
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verifyLogical
!DEC$endif
-SUBROUTINE verifyLogical(string,value,correct_value,total_error)
- CHARACTER(LEN=*) :: string
- LOGICAL :: value, correct_value
- INTEGER :: total_error
- IF (value .NEQV. correct_value) THEN
- total_error = total_error + 1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
-END SUBROUTINE verifyLogical
-
+ SUBROUTINE verifyLogical(string,value,correct_value,total_error)
+ CHARACTER(LEN=*) :: string
+ LOGICAL :: value, correct_value
+ INTEGER :: total_error
+ IF (value .NEQV. correct_value) THEN
+ total_error = total_error + 1
+ WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
+ ENDIF
+ RETURN
+ END SUBROUTINE verifyLogical
+
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verifyString
!DEC$endif
-SUBROUTINE verifyString(string, value,correct_value,total_error)
- CHARACTER*(*) :: string
- CHARACTER*(*) :: value, correct_value
- INTEGER :: total_error
- IF (TRIM(value) .NE. TRIM(correct_value)) THEN
- total_error = total_error + 1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
-END SUBROUTINE verifyString
+ SUBROUTINE verifyString(string, value,correct_value,total_error)
+ CHARACTER*(*) :: string
+ CHARACTER*(*) :: value, correct_value
+ INTEGER :: total_error
+ IF (TRIM(value) .NE. TRIM(correct_value)) THEN
+ total_error = total_error + 1
+ WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
+ ENDIF
+ RETURN
+ END SUBROUTINE verifyString
!----------------------------------------------------------------------
@@ -225,46 +198,46 @@ END SUBROUTINE verifyString
!
!
!----------------------------------------------------------------------
-SUBROUTINE h5_fixname_f(base_name, full_name, fapl, hdferr)
+ SUBROUTINE h5_fixname_f(base_name, full_name, fapl, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5_fixname_f
!DEC$endif
- USE H5GLOBAL
- IMPLICIT NONE
- CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name
- CHARACTER(LEN=*), INTENT(IN) :: full_name ! full name
- INTEGER, INTENT(OUT) :: hdferr ! Error code
- INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list
-
- INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string
- INTEGER(SIZE_T) :: full_namelen ! Length of the full name character string
+ USE H5GLOBAL
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name
+ CHARACTER(LEN=*), INTENT(IN) :: full_name ! full name
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+ INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list
+
+ INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string
+ INTEGER(SIZE_T) :: full_namelen ! Length of the full name character string
! INTEGER(HID_T) :: fapl_default
- INTERFACE
- INTEGER FUNCTION h5_fixname_c(base_name, base_namelen, fapl, &
- full_name, full_namelen)
- USE H5GLOBAL
- !DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_FIXNAME_C':: h5_fixname_c
- !DEC$ ENDIF
- !DEC$ATTRIBUTES reference :: base_name
- !DEC$ATTRIBUTES reference :: full_name
- CHARACTER(LEN=*), INTENT(IN) :: base_name
- INTEGER(SIZE_T) :: base_namelen
- INTEGER(HID_T), INTENT(IN) :: fapl
- CHARACTER(LEN=*), INTENT(IN) :: full_name
- INTEGER(SIZE_T) :: full_namelen
- END FUNCTION h5_fixname_c
- END INTERFACE
-
- base_namelen = LEN(base_name)
- full_namelen = LEN(full_name)
- hdferr = h5_fixname_c(base_name, base_namelen, fapl, &
- full_name, full_namelen)
-
-END SUBROUTINE h5_fixname_f
+ INTERFACE
+ INTEGER FUNCTION h5_fixname_c(base_name, base_namelen, fapl, &
+ full_name, full_namelen)
+ USE H5GLOBAL
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_FIXNAME_C':: h5_fixname_c
+ !DEC$ ENDIF
+ !DEC$ATTRIBUTES reference :: base_name
+ !DEC$ATTRIBUTES reference :: full_name
+ CHARACTER(LEN=*), INTENT(IN) :: base_name
+ INTEGER(SIZE_T) :: base_namelen
+ INTEGER(HID_T), INTENT(IN) :: fapl
+ CHARACTER(LEN=*), INTENT(IN) :: full_name
+ INTEGER(SIZE_T) :: full_namelen
+ END FUNCTION h5_fixname_c
+ END INTERFACE
+
+ base_namelen = LEN(base_name)
+ full_namelen = LEN(full_name)
+ hdferr = h5_fixname_c(base_name, base_namelen, fapl, &
+ full_name, full_namelen)
+
+ END SUBROUTINE h5_fixname_f
!----------------------------------------------------------------------
! Name: h5_cleanup_f
@@ -285,37 +258,37 @@ END SUBROUTINE h5_fixname_f
!
!
!----------------------------------------------------------------------
-SUBROUTINE h5_cleanup_f(base_name, fapl, hdferr)
+ SUBROUTINE h5_cleanup_f(base_name, fapl, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5_cleanup_f
!DEC$endif
- USE H5GLOBAL
- IMPLICIT NONE
- CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name
- INTEGER, INTENT(OUT) :: hdferr ! Error code
- INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list
-
- INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string
-
- INTERFACE
- INTEGER FUNCTION h5_cleanup_c(base_name, base_namelen, fapl)
- USE H5GLOBAL
- !DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_CLEANUP_C':: h5_cleanup_c
- !DEC$ ENDIF
- !DEC$ATTRIBUTES reference :: base_name
- CHARACTER(LEN=*), INTENT(IN) :: base_name
- INTEGER(SIZE_T) :: base_namelen
- INTEGER(HID_T), INTENT(IN) :: fapl
- END FUNCTION h5_cleanup_c
- END INTERFACE
-
- base_namelen = LEN(base_name)
- hdferr = h5_cleanup_c(base_name, base_namelen, fapl)
-
-END SUBROUTINE h5_cleanup_f
+ USE H5GLOBAL
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+ INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list
+
+ INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string
+
+ INTERFACE
+ INTEGER FUNCTION h5_cleanup_c(base_name, base_namelen, fapl)
+ USE H5GLOBAL
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_CLEANUP_C':: h5_cleanup_c
+ !DEC$ ENDIF
+ !DEC$ATTRIBUTES reference :: base_name
+ CHARACTER(LEN=*), INTENT(IN) :: base_name
+ INTEGER(SIZE_T) :: base_namelen
+ INTEGER(HID_T), INTENT(IN) :: fapl
+ END FUNCTION h5_cleanup_c
+ END INTERFACE
+
+ base_namelen = LEN(base_name)
+ hdferr = h5_cleanup_c(base_name, base_namelen, fapl)
+
+ END SUBROUTINE h5_cleanup_f
!----------------------------------------------------------------------
! Name: h5_exit_f
@@ -337,27 +310,27 @@ END SUBROUTINE h5_cleanup_f
!
!
!----------------------------------------------------------------------
-SUBROUTINE h5_exit_f(status)
+ SUBROUTINE h5_exit_f(status)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5_exit_f
!DEC$endif
- IMPLICIT NONE
- INTEGER, INTENT(IN) :: status ! Return code
-
- INTERFACE
- SUBROUTINE h5_exit_c(status)
- !DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_EXIT_C':: h5_exit_c
- !DEC$ ENDIF
- INTEGER, INTENT(IN) :: status
- END SUBROUTINE h5_exit_c
- END INTERFACE
+ IMPLICIT NONE
+ INTEGER, INTENT(IN) :: status ! Return code
- CALL h5_exit_c(status)
+ INTERFACE
+ SUBROUTINE h5_exit_c(status)
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_EXIT_C':: h5_exit_c
+ !DEC$ ENDIF
+ INTEGER, INTENT(IN) :: status
+ END SUBROUTINE h5_exit_c
+ END INTERFACE
+
+ CALL h5_exit_c(status)
-END SUBROUTINE h5_exit_f
+ END SUBROUTINE h5_exit_f
!----------------------------------------------------------------------
! Name: h5_env_nocleanup_f
@@ -374,31 +347,29 @@ END SUBROUTINE h5_exit_f
! September 30, 2008
!
!----------------------------------------------------------------------
-SUBROUTINE h5_env_nocleanup_f(HDF5_NOCLEANUP)
+ SUBROUTINE h5_env_nocleanup_f(HDF5_NOCLEANUP)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5_env_nocleanup_f
!DEC$endif
- IMPLICIT NONE
- LOGICAL, INTENT(OUT) :: HDF5_NOCLEANUP ! Return code
- INTEGER :: status
-
- INTERFACE
- SUBROUTINE h5_env_nocleanup_c(status)
- !DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_ENV_NOCLEANUP_C':: h5_env_nocleanup_c
- !DEC$ ENDIF
- INTEGER :: status
- END SUBROUTINE h5_env_nocleanup_c
- END INTERFACE
-
- CALL h5_env_nocleanup_c(status)
-
- HDF5_NOCLEANUP = .FALSE.
- IF(status.EQ.1)THEN
- HDF5_NOCLEANUP = .TRUE.
- ENDIF
-
-END SUBROUTINE h5_env_nocleanup_f
+ IMPLICIT NONE
+ LOGICAL, INTENT(OUT) :: HDF5_NOCLEANUP ! Return code
+ INTEGER :: status
+
+ INTERFACE
+ SUBROUTINE h5_env_nocleanup_c(status)
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_ENV_NOCLEANUP_C':: h5_env_nocleanup_c
+ !DEC$ ENDIF
+ INTEGER :: status
+ END SUBROUTINE h5_env_nocleanup_c
+ END INTERFACE
+
+ CALL h5_env_nocleanup_c(status)
+
+ HDF5_NOCLEANUP = .FALSE.
+ IF(status.EQ.1) HDF5_NOCLEANUP = .TRUE.
+
+ END SUBROUTINE h5_env_nocleanup_f
END MODULE TH5_MISC