diff options
Diffstat (limited to 'fortran/test/tH5A.f90')
| -rw-r--r-- | fortran/test/tH5A.f90 | 27 |
1 files changed, 16 insertions, 11 deletions
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90 index cecaded..07ca6da 100644 --- a/fortran/test/tH5A.f90 +++ b/fortran/test/tH5A.f90 @@ -27,7 +27,9 @@ ! ! !***** +MODULE TH5A +CONTAINS SUBROUTINE attribute_test(cleanup, total_error) ! This subroutine tests following functionalities: @@ -36,10 +38,10 @@ ! USE HDF5 ! This module contains all necessary modules - + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(INOUT) :: total_error CHARACTER(LEN=5), PARAMETER :: filename = "atest" !File name CHARACTER(LEN=80) :: fix_filename @@ -100,7 +102,7 @@ CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back ! string attr data CHARACTER :: attr_character_data = 'A' - REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459 + REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459D0 REAL, DIMENSION(1) :: attr_real_data = 4.0 INTEGER, DIMENSION(1) :: attr_integer_data = 5 INTEGER(HSIZE_T), DIMENSION(7) :: data_dims @@ -127,6 +129,7 @@ !data buffers ! INTEGER, DIMENSION(NX,NY) :: data_in + LOGICAL :: differ ! @@ -516,20 +519,21 @@ 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 (aread_double_data(1) .NE. 3.459 ) 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) - IF (aread_real_data(1) .NE. 4.0 ) 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 ! @@ -624,3 +628,4 @@ RETURN END SUBROUTINE attribute_test +END MODULE TH5A |