summaryrefslogtreecommitdiffstats
path: root/fortran/test
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2015-08-11 14:35:30 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2015-08-11 14:35:30 (GMT)
commitcaf0e7692a2f3cf0f2d0957c30a404e6c706d3df (patch)
treeec3eddd4abad940acc89f83c0f114203ff3d6345 /fortran/test
parent3b4696ccd16c2b98e2700a46bf7a5c76ef4a9764 (diff)
downloadhdf5-caf0e7692a2f3cf0f2d0957c30a404e6c706d3df.zip
hdf5-caf0e7692a2f3cf0f2d0957c30a404e6c706d3df.tar.gz
hdf5-caf0e7692a2f3cf0f2d0957c30a404e6c706d3df.tar.bz2
[svn-r27493] Trying again to merge the F2003_v1.10 branch to the trunk.
Tested: h5committest --PASSED--
Diffstat (limited to 'fortran/test')
-rw-r--r--fortran/test/CMakeLists.txt143
-rw-r--r--fortran/test/H5_test_buildiface.F90306
-rw-r--r--fortran/test/Makefile.am61
-rw-r--r--fortran/test/Makefile.in224
-rw-r--r--fortran/test/fflush2.f90297
-rw-r--r--fortran/test/tH5A.f9019
-rw-r--r--fortran/test/tH5A_1_8.f90177
-rw-r--r--fortran/test/tH5D.f90950
-rw-r--r--fortran/test/tH5E_F03.f9019
-rw-r--r--fortran/test/tH5F_F03.f9013
-rw-r--r--fortran/test/tH5G_1_8.f90207
-rw-r--r--fortran/test/tH5I.f9010
-rw-r--r--fortran/test/tH5L_F03.f9027
-rw-r--r--fortran/test/tH5MISC_1_8.f9053
-rw-r--r--fortran/test/tH5O.f9056
-rw-r--r--fortran/test/tH5O_F03.f904
-rw-r--r--fortran/test/tH5P.f9071
-rw-r--r--fortran/test/tH5P_F03.f9065
-rw-r--r--fortran/test/tH5R.f9037
-rw-r--r--fortran/test/tH5S.f906
-rw-r--r--fortran/test/tH5Sselect.f90219
-rw-r--r--fortran/test/tH5T.f90259
-rw-r--r--fortran/test/tH5T_F03.F90 (renamed from fortran/test/tH5T_F03.f90)358
-rw-r--r--fortran/test/tH5VL.f9030
-rw-r--r--fortran/test/tHDF5.f901
-rw-r--r--fortran/test/tf.F90 (renamed from fortran/test/tf.f90)237
-rw-r--r--fortran/test/tf_F03.f90128
-rw-r--r--fortran/test/tf_F08.f90128
-rw-r--r--fortran/test/tf_F90.f9033
29 files changed, 2000 insertions, 2138 deletions
diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt
index a2711c0..19d4975 100644
--- a/fortran/test/CMakeLists.txt
+++ b/fortran/test/CMakeLists.txt
@@ -39,26 +39,11 @@ if (BUILD_SHARED_LIBS)
)
endif (BUILD_SHARED_LIBS)
-# See if the F2008 intrinsic STORAGE_SIZE and C_SIZEOF are supported. If not then
-# fall back to F2003. If F2003 not supported then use F90 for the tests.
-
-set_source_files_properties (tf_F90.f90 tf_F03.f90 tf_F08.f90 tf.f90 PROPERTIES LANGUAGE Fortran)
-if (FORTRAN_HAVE_STORAGE_SIZE AND FORTRAN_HAVE_C_SIZEOF)
- add_library (${HDF5_F90_TEST_LIB_TARGET} STATIC tf_F08.f90 tf.f90)
- if (BUILD_SHARED_LIBS)
- add_library (${HDF5_F90_TEST_LIBSH_TARGET} SHARED tf_F08.f90 tf.f90)
- endif (BUILD_SHARED_LIBS)
-elseif (HDF5_ENABLE_F2003)
- add_library (${HDF5_F90_TEST_LIB_TARGET} STATIC tf_F03.f90 tf.f90)
- if (BUILD_SHARED_LIBS)
- add_library (${HDF5_F90_TEST_LIBSH_TARGET} SHARED tf_F03.f90 tf.f90)
- endif (BUILD_SHARED_LIBS)
-else (FORTRAN_HAVE_STORAGE_SIZE AND FORTRAN_HAVE_C_SIZEOF)
- add_library (${HDF5_F90_TEST_LIB_TARGET} STATIC tf_F90.f90 tf.f90)
- if (BUILD_SHARED_LIBS)
- add_library (${HDF5_F90_TEST_LIBSH_TARGET} SHARED tf_F90.f90 tf.f90)
- endif (BUILD_SHARED_LIBS)
-endif (FORTRAN_HAVE_STORAGE_SIZE AND FORTRAN_HAVE_C_SIZEOF)
+set_source_files_properties (tf.F90 ${HDF5_F90_BINARY_DIR}/tf_gen.F90 PROPERTIES LANGUAGE Fortran)
+add_library (${HDF5_F90_TEST_LIB_TARGET} STATIC tf.F90 ${HDF5_F90_BINARY_DIR}/tf_gen.F90)
+if (BUILD_SHARED_LIBS)
+ add_library (${HDF5_F90_TEST_LIBSH_TARGET} SHARED tf.F90 ${HDF5_F90_BINARY_DIR}/tf_gen.F90)
+endif (BUILD_SHARED_LIBS)
TARGET_FORTRAN_PROPERTIES (${HDF5_F90_TEST_LIB_TARGET} STATIC " " " ")
target_link_libraries (${HDF5_F90_TEST_LIB_TARGET}
@@ -108,6 +93,40 @@ if (BUILD_SHARED_LIBS)
endif (BUILD_SHARED_LIBS)
#-----------------------------------------------------------------------------
+# Setup the Fortran auto-detection utilities
+# H5_test_buildiface.F90 used to generate various KIND test interfaces
+#-----------------------------------------------------------------------------
+
+add_executable (H5_test_buildiface
+ ${HDF5_F90_SRC_DIR}/test/H5_test_buildiface.F90
+ )
+
+if (WIN32 AND MSVC)
+ if (BUILD_SHARED_LIBS)
+ set_target_properties (H5_test_buildiface
+ PROPERTIES
+ COMPILE_FLAGS "/MT"
+ )
+ endif (BUILD_SHARED_LIBS)
+ set_target_properties (H5_test_buildiface
+ PROPERTIES
+ LINK_FLAGS "/SUBSYSTEM:CONSOLE"
+ )
+endif (WIN32 AND MSVC)
+set_target_properties (H5_test_buildiface PROPERTIES
+ LINKER_LANGUAGE Fortran
+ Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}
+)
+
+set (CMD $<TARGET_FILE:H5_test_buildiface>)
+add_custom_command (
+ OUTPUT ${HDF5_F90_BINARY_DIR}/tf_gen.F90
+ COMMAND ${CMD}
+ WORKING_DIRECTORY ${HDF5_F90_BINARY_DIR}
+ DEPENDS H5_test_buildiface
+)
+
+#-----------------------------------------------------------------------------
# Add Tests
#-----------------------------------------------------------------------------
@@ -234,62 +253,60 @@ if (BUILD_SHARED_LIBS)
endif (BUILD_SHARED_LIBS)
#-- Adding test for fortranlib_test_F03
-if (HDF5_ENABLE_F2003)
- add_executable (fortranlib_test_F03
+add_executable (fortranlib_test_F03
+ fortranlib_test_F03.f90
+ tH5E_F03.f90
+ tH5F_F03.f90
+ tH5L_F03.f90
+ tH5O_F03.f90
+ tH5P_F03.f90
+ tH5T_F03.F90
+ tHDF5_F03.f90
+)
+TARGET_NAMING (fortranlib_test_F03 STATIC)
+TARGET_FORTRAN_PROPERTIES (fortranlib_test_F03 STATIC " " " ")
+target_link_libraries (fortranlib_test_F03
+ ${HDF5_F90_TEST_LIB_TARGET}
+ ${HDF5_F90_LIB_TARGET}
+ ${HDF5_LIB_TARGET}
+)
+if (WIN32 AND MSVC)
+ target_link_libraries (fortranlib_test_F03 "ws2_32.lib")
+endif (WIN32 AND MSVC)
+target_include_directories (fortranlib_test_F03 PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static)
+set_target_properties (fortranlib_test_F03 PROPERTIES
+ LINKER_LANGUAGE Fortran
+ FOLDER test/fortran
+ Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static
+)
+if (BUILD_SHARED_LIBS)
+ add_executable (fortranlib_test_F03-shared
fortranlib_test_F03.f90
tH5E_F03.f90
tH5F_F03.f90
tH5L_F03.f90
tH5O_F03.f90
tH5P_F03.f90
- tH5T_F03.f90
+ tH5T_F03.F90
tHDF5_F03.f90
)
- TARGET_NAMING (fortranlib_test_F03 STATIC)
- TARGET_FORTRAN_PROPERTIES (fortranlib_test_F03 STATIC " " " ")
- target_link_libraries (fortranlib_test_F03
- ${HDF5_F90_TEST_LIB_TARGET}
- ${HDF5_F90_LIB_TARGET}
- ${HDF5_LIB_TARGET}
+ TARGET_NAMING (fortranlib_test_F03-shared SHARED)
+ TARGET_FORTRAN_PROPERTIES (fortranlib_test_F03-shared SHARED " " " ")
+ target_link_libraries (fortranlib_test_F03-shared
+ ${HDF5_F90_TEST_LIBSH_TARGET}
+ ${HDF5_F90_LIBSH_TARGET}
+ ${HDF5_LIBSH_TARGET}
)
if (WIN32 AND MSVC)
- target_link_libraries (fortranlib_test_F03 "ws2_32.lib")
+ target_link_libraries (fortranlib_test_F03-shared "ws2_32.lib")
endif (WIN32 AND MSVC)
- target_include_directories (fortranlib_test_F03 PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static)
- set_target_properties (fortranlib_test_F03 PROPERTIES
+ target_include_directories (fortranlib_test_F03-shared PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared)
+ set_target_properties (fortranlib_test_F03-shared PROPERTIES
LINKER_LANGUAGE Fortran
FOLDER test/fortran
- Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static
- )
- if (BUILD_SHARED_LIBS)
- add_executable (fortranlib_test_F03-shared
- fortranlib_test_F03.f90
- tH5E_F03.f90
- tH5F_F03.f90
- tH5L_F03.f90
- tH5O_F03.f90
- tH5P_F03.f90
- tH5T_F03.f90
- tHDF5_F03.f90
- )
- TARGET_NAMING (fortranlib_test_F03-shared SHARED)
- TARGET_FORTRAN_PROPERTIES (fortranlib_test_F03-shared SHARED " " " ")
- target_link_libraries (fortranlib_test_F03-shared
- ${HDF5_F90_TEST_LIBSH_TARGET}
- ${HDF5_F90_LIBSH_TARGET}
- ${HDF5_LIBSH_TARGET}
- )
- if (WIN32 AND MSVC)
- target_link_libraries (fortranlib_test_F03-shared "ws2_32.lib")
- endif (WIN32 AND MSVC)
- target_include_directories (fortranlib_test_F03-shared PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared)
- set_target_properties (fortranlib_test_F03-shared PROPERTIES
- LINKER_LANGUAGE Fortran
- FOLDER test/fortran
- Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared
- )
- endif (BUILD_SHARED_LIBS)
-endif (HDF5_ENABLE_F2003)
+ Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared
+)
+endif (BUILD_SHARED_LIBS)
#-- Adding test for fflush1
add_executable (fflush1 fflush1.f90)
diff --git a/fortran/test/H5_test_buildiface.F90 b/fortran/test/H5_test_buildiface.F90
new file mode 100644
index 0000000..30687df
--- /dev/null
+++ b/fortran/test/H5_test_buildiface.F90
@@ -0,0 +1,306 @@
+!****p* Program/H5_buildiface
+!
+! NAME
+! Executable: H5_buildiface
+!
+! FILE
+! fortran/src/H5_buildiface.f90
+!
+! PURPOSE
+! This stand alone program is used at build time to generate the program
+! H5fortran_detect.f90. It cycles through all the available KIND parameters for
+! integers and reals. The appropriate program and subroutines are then generated
+! depending on which of the KIND values are found.
+!
+! NOTES
+! This program uses the Fortran 2008 intrinsic function STORAGE_SIZE or SIZEOF
+! depending on availablity.It generates code that makes use of
+! STORAGE_SIZE/SIZEOF in H5fortran_detect.f90. STORAGE_SIZE is standard
+! compliant and should always be chosen over SIZEOF.
+!
+! The availability of STORAGE_SIZE/SIZEOF is checked at configure time and the TRUE/FALSE
+! condition is set in the configure variable "FORTRAN_HAVE_STORAGE_SIZE" or
+! "FORTRAN_HAVE_SIZEOF".
+!
+! The use of C_SIZOF(X) is not used since the argument X must be an interoperable
+! data entity.
+!
+! 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. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+! AUTHOR
+! M. Scot Breitenfeld
+!
+!*****
+
+#include <H5config_f.inc>
+
+PROGRAM H5_test_buildiface
+ USE, INTRINSIC :: ISO_C_BINDING
+ IMPLICIT NONE
+
+! These values are valid REAL KINDs (with corresponding C float) found during configure
+ H5_H5CONFIG_F_NUM_RKIND
+ H5_H5CONFIG_F_RKIND
+! These values are valid INTEGER KINDs (with corresponding C integer) found during configure
+ H5_H5CONFIG_F_NUM_IKIND
+ H5_H5CONFIG_F_IKIND
+
+ INTEGER :: i, j, k
+ INTEGER :: ji, jr, jd
+#ifdef H5_FORTRAN_HAVE_C_LONG_DOUBLE
+ REAL(KIND=C_LONG_DOUBLE) :: c_longdble
+#endif
+ REAL(KIND=C_DOUBLE) :: c_dble
+ REAL(KIND=C_FLOAT) :: c_flt
+ INTEGER :: sizeof_var
+ CHARACTER(LEN=2) :: chr2
+! subroutine rank of array being passed in
+ CHARACTER(LEN=2), DIMENSION(1:8), PARAMETER :: chr_rank=(/"_0","_1","_2","_3","_4","_5","_6","_7"/)
+! rank definitions
+ CHARACTER(LEN=70), DIMENSION(1:8), PARAMETER :: rank_dim_line=(/ &
+ ' ', &
+ ', DIMENSION(dims(1)) ', &
+ ', DIMENSION(dims(1),dims(2)) ', &
+ ', DIMENSION(dims(1),dims(2),dims(3)) ', &
+ ', DIMENSION(dims(1),dims(2),dims(3),dims(4)) ', &
+ ', DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) ', &
+ ', DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) ', &
+ ', DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7))' &
+ /)
+! pointer to the buffer
+ CHARACTER(LEN=37), DIMENSION(1:8), PARAMETER :: f_ptr_line=(/ &
+ ' f_ptr = C_LOC(buf) ', &
+ ' f_ptr = C_LOC(buf(1)) ', &
+ ' f_ptr = C_LOC(buf(1,1)) ', &
+ ' f_ptr = C_LOC(buf(1,1,1)) ', &
+ ' f_ptr = C_LOC(buf(1,1,1,1)) ', &
+ ' f_ptr = C_LOC(buf(1,1,1,1,1)) ', &
+ ' f_ptr = C_LOC(buf(1,1,1,1,1,1)) ', &
+ ' f_ptr = C_LOC(buf(1,1,1,1,1,1,1))' &
+ /)
+
+! Generate Fortran Check routines for the tests KIND interfaces.
+
+ OPEN(11,FILE='tf_gen.F90')
+ WRITE(11,'(40(A,/))') &
+'!****h* ROBODoc/TH5_MISC_gen.F90',&
+'!',&
+'! NAME',&
+'! TH5_MISC_gen',&
+'! ',&
+'! PURPOSE',&
+'! This module is generated at build by H5_test_buildiface.F90 to handle checking ',&
+'! in the tests all the detected KINDs.',&
+'!',&
+'! COPYRIGHT',&
+'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
+'! Copyright by The HDF Group. *',&
+'! 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. *',&
+'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
+'!',&
+'! AUTHOR',&
+'! H5_test_buildiface.F90',&
+'!',&
+'!*****'
+
+ WRITE(11,'(a)') "MODULE TH5_MISC_gen"
+
+ WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING'
+
+! Interfaces for validating REALs, INTEGERs, CHARACTERs, LOGICALs
+
+ WRITE(11,'(A)') ' INTERFACE verify'
+ DO i = 1, num_rkinds
+ j = rkind(i)
+ WRITE(chr2,'(I2)') j
+ WRITE(11,'(A)') " MODULE PROCEDURE verify_real_kind_"//TRIM(ADJUSTL(chr2))
+ END DO
+ DO i = 1, num_ikinds
+ j = ikind(i)
+ WRITE(chr2,'(I2)') j
+ WRITE(11,'(A)') " MODULE PROCEDURE verify_integer_kind_"//TRIM(ADJUSTL(chr2))
+ END DO
+ WRITE(11,'(A)') " MODULE PROCEDURE verify_character"
+ WRITE(11,'(A)') " MODULE PROCEDURE verify_logical"
+ WRITE(11,'(A)') " END INTERFACE"
+
+ WRITE(11,'(A)') ' INTERFACE check_real_eq'
+ DO i = 1, num_rkinds
+ j = rkind(i)
+ WRITE(chr2,'(I2)') j
+ WRITE(11,'(A)') " MODULE PROCEDURE real_eq_kind_"//TRIM(ADJUSTL(chr2))
+ END DO
+ WRITE(11,'(A)') " END INTERFACE"
+
+ WRITE(11,'(A)') 'CONTAINS'
+
+! ***************************
+! VALIDATE INTEGERS
+! ***************************
+ DO i = 1, num_ikinds
+ k = ikind(i)
+ WRITE(chr2,'(I2)') k
+! DLL definitions for windows
+ WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
+ WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_integer_kind_'//TRIM(ADJUSTL(chr2))
+ WRITE(11,'(A)') '!DEC$endif'
+
+! Subroutine API
+ WRITE(11,'(A)') ' SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)'
+ WRITE(11,'(A)') ' IMPLICIT NONE'
+ WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string'
+ WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//') :: value, correct_value'
+ WRITE(11,'(A)') ' INTEGER :: total_error'
+ WRITE(11,'(A)') ' IF (value .NE. correct_value) THEN'
+ WRITE(11,'(A)') ' total_error=total_error+1'
+ WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT INTEGER VALIDATION ", string'
+ WRITE(11,'(A)') ' ENDIF'
+ WRITE(11,'(A)') ' END SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2))
+ ENDDO
+
+! ***************************
+! VALIDATE REALS
+! ***************************
+ DO i = 1, num_rkinds
+ k = rkind(i)
+ WRITE(chr2,'(I2)') k
+! DLL definitions for windows
+ WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
+ WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_real_kind_'//TRIM(ADJUSTL(chr2))
+ WRITE(11,'(A)') '!DEC$endif'
+
+! Subroutine API
+ WRITE(11,'(A)') ' SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)'
+ WRITE(11,'(A)') ' IMPLICIT NONE'
+ WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string'
+ WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//') :: value, correct_value'
+ WRITE(11,'(A)') ' INTEGER :: total_error'
+ WRITE(11,'(A)') ' IF (.NOT.real_eq_kind_'//TRIM(ADJUSTL(chr2))//'( value, correct_value) ) THEN'
+ WRITE(11,'(A)') ' total_error=total_error+1'
+ WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string'
+ WRITE(11,'(A)') ' ENDIF'
+ WRITE(11,'(A)') ' END SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))
+
+
+! ***********************************
+! TEST IF TWO REAL NUMBERS ARE EQUAL
+! ***********************************
+
+! [1] The test performed is
+!
+! ABS( x - y ) < ( ULP * SPACING( MAX(ABS(x),ABS(y)) ) )
+!
+! The numbers are considered equal if true
+!
+! The intrinsic function SPACING(x) returns the absolute spacing of numbers
+! near the value of x,
+!
+! { EXPONENT(x)-DIGITS(x)
+! { 2.0 for x /= 0
+! SPACING(x) = {
+! {
+! { TINY(x) for x == 0
+!
+! The ULP optional argument scales the comparison:
+!
+! Unit of data precision. The acronym stands for "unit in
+! the last place," the smallest possible increment or decrement
+! that can be made using a machine's floating point arithmetic.
+! A 0.5 ulp maximum error is the best you could hope for, since
+! this corresponds to always rounding to the nearest representable
+! floating-point number. Value must be positive - if a negative
+! value is supplied, the absolute value is used.
+! If not specified, the default value is 1.
+!
+! James Van Buskirk and James Giles suggested this method for floating
+! point comparisons in the comp.lang.fortran newsgroup.
+!
+! Reference: [1] Paul van Delst, paul.vandelst@ssec.wisc.edu
+
+ WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
+ WRITE(11,'(A)') '!DEC$attributes dllexport :: real_eq_kind_'//TRIM(ADJUSTL(chr2))
+ WRITE(11,'(A)') '!DEC$endif'
+ WRITE(11,'(A)') ' LOGICAL FUNCTION real_eq_kind_'//TRIM(ADJUSTL(chr2))//'(a,b,ulp)'
+ WRITE(11,'(A)') ' IMPLICIT NONE'
+ WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'), INTENT (in):: a,b'
+ WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//') :: Rel'
+ WRITE(11,'(A)') ' INTEGER, OPTIONAL, INTENT( IN ) :: ulp'
+ WRITE(11,'(A)') ' IF ( PRESENT( ulp ) ) Rel = REAL( ABS(ulp), '//TRIM(ADJUSTL(chr2))//')'
+ WRITE(11,'(A)') ' Rel = 1.0_'//TRIM(ADJUSTL(chr2))
+ WRITE(11,'(A)') ' real_eq_kind_'//TRIM(ADJUSTL(chr2))//' = ABS( a - b ) < ( Rel * SPACING( MAX(ABS(a),ABS(b)) ) )'
+ WRITE(11,'(A)') ' END FUNCTION real_eq_kind_'//TRIM(ADJUSTL(chr2))
+ ENDDO
+
+! ***************************
+! VALIDATE CHARACTER STRINGS
+! ***************************
+
+! DLL definitions for windows
+ WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
+ WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_character'
+ WRITE(11,'(A)') '!DEC$endif'
+
+! Subroutine API
+ WRITE(11,'(A)') ' SUBROUTINE verify_character(string,value,correct_value,total_error)'
+ WRITE(11,'(A)') ' IMPLICIT NONE'
+ WRITE(11,'(A)') ' CHARACTER*(*) :: string'
+ WRITE(11,'(A)') ' CHARACTER*(*) :: value, correct_value'
+ WRITE(11,'(A)') ' INTEGER :: total_error'
+ WRITE(11,'(A)') ' IF (TRIM(value) .NE. TRIM(correct_value)) THEN'
+ WRITE(11,'(A)') ' total_error = total_error + 1'
+ WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string'
+ WRITE(11,'(A)') ' ENDIF'
+ WRITE(11,'(A)') ' END SUBROUTINE verify_character'
+
+! ***************************
+! VALIDATE LOGICAL
+! ***************************
+
+! DLL definitions for windows
+ WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
+ WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_logical'
+ WRITE(11,'(A)') '!DEC$endif'
+! Subroutine API
+ WRITE(11,'(A)') ' SUBROUTINE verify_logical(string,value,correct_value,total_error)'
+ WRITE(11,'(A)') ' IMPLICIT NONE'
+ WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string'
+ WRITE(11,'(A)') ' LOGICAL :: value, correct_value'
+ WRITE(11,'(A)') ' INTEGER :: total_error'
+ WRITE(11,'(A)') ' IF (value .NEQV. correct_value) THEN'
+ WRITE(11,'(A)') ' total_error = total_error + 1'
+ WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string'
+ WRITE(11,'(A)') ' ENDIF'
+
+ WRITE(11,'(A)') ' END SUBROUTINE verify_logical'
+
+ WRITE(11,'(A)') "END MODULE TH5_MISC_gen"
+
+ CLOSE(11)
+
+END PROGRAM H5_test_buildiface
+
+
+
diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am
index 735ab7a..608b1e9 100644
--- a/fortran/test/Makefile.am
+++ b/fortran/test/Makefile.am
@@ -36,40 +36,12 @@ else
AM_LDFLAGS+=-static
endif
-# Check if the compiler supports the Fortran 2003 standard
-# which should include the intrinsic module iso_c_binding
-if FORTRAN_2003_CONDITIONAL_F
- ff_PREFIX = F03
-else
- ff_PREFIX = F90
-endif
-
# Our main targets, the tests themselves
-TEST_PROG=fortranlib_test fflush1 fflush2 fortranlib_test_1_8
-
-if FORTRAN_2003_CONDITIONAL_F
- TEST_PROG += fortranlib_test_F03
-endif
+TEST_PROG=fortranlib_test fflush1 fflush2 fortranlib_test_1_8 fortranlib_test_F03
check_PROGRAMS=$(TEST_PROG)
-if FORTRAN_HAVE_STORAGE_SIZE
-if FORTRAN_HAVE_C_SIZEOF
- libh5test_fortran_la_SOURCES = tf_F08.f90
-else
- libh5test_fortran_la_SOURCES = tf_F03.f90
-endif
-else
-if FORTRAN_2003_CONDITIONAL_F
- libh5test_fortran_la_SOURCES = tf_F03.f90
-else
- libh5test_fortran_la_SOURCES = tf_F90.f90
-endif
-endif
-
-# tf.f90 depends on either tf_F08.f90 or tf_F03.f90 so they need to be
-# compiled first
-libh5test_fortran_la_SOURCES += tf.f90 t.c
+libh5test_fortran_la_SOURCES = tf_gen.F90 tf.F90 t.c
# Source files are used for both the library and fortranlib_test.
# Automake will complain about this without the following workaround.
@@ -79,13 +51,11 @@ fortranlib_test_CFLAGS=$(AM_CFLAGS)
fortranlib_test_SOURCES = tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 \
tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 tHDF5.f90 fortranlib_test.f90
-fortranlib_test_1_8_SOURCES = tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 tH5MISC_1_8.f90 tHDF5_1_8.f90\
+fortranlib_test_1_8_SOURCES = tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 tH5MISC_1_8.f90 tHDF5_1_8.f90 \
fortranlib_test_1_8.f90
-if FORTRAN_2003_CONDITIONAL_F
- fortranlib_test_F03_SOURCES = tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 \
- tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 tHDF5_F03.f90 fortranlib_test_F03.f90
-endif
+fortranlib_test_F03_SOURCES = tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 \
+ tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.F90 tHDF5_F03.f90 fortranlib_test_F03.f90
fflush1_SOURCES=fflush1.f90
@@ -106,13 +76,32 @@ maintainer-clean-local: clean-local
distclean-local: clean-local
clean-local:
@if test -n "$(F9XMODEXT)" && test "X$(F9XMODEXT)" != "Xo"; then \
- $(RM) *.$(F9XMODEXT); \
+ $(RM) *.$(F9XMODEXT) tf_gen.F90; \
fi
# Mark this directory as part of the Fortran API (this affects output
# from tests in conclude.am)
FORTRAN_API=yes
+# helper program we need to build.
+noinst_PROGRAMS = H5_test_buildiface
+
+# H5_test_buildiface.F90 generates all the test APIs that have a KIND type associated
+# with them.
+
+tf_gen.F90: H5_test_buildiface$(EXEEXT)
+ $(RUNSERIAL) ./H5_test_buildiface$(EXEEXT)
+
+# H5_test_buildiface.F90 is included in the distribution, and Automake knows
+# how to compile a fortran program given its sources.
+
+H5_test_buildiface_SOURCES = H5_test_buildiface.F90
+
+# The build of the H5_test_buildiface does depend on any libraries, so set it
+# to nothing.
+
+H5_test_buildiface_LDADD =
+
# fflush2 depends on files created by fflush1
fflush2.chkexe_: fflush1.chkexe_
diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in
index 4ec1ad5..4e9bbd6 100644
--- a/fortran/test/Makefile.in
+++ b/fortran/test/Makefile.in
@@ -14,6 +14,7 @@
@SET_MAKE@
+
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
@@ -87,9 +88,9 @@ DIST_COMMON = $(top_srcdir)/config/commence.am \
# want to build a shared C library and a static Fortran library. If so,
# pass the -static flag to the library linker.
@FORTRAN_SHARED_CONDITIONAL_FALSE@am__append_1 = -static
-@FORTRAN_2003_CONDITIONAL_F_TRUE@am__append_2 = fortranlib_test_F03
-check_PROGRAMS = $(am__EXEEXT_2)
-TESTS = $(am__EXEEXT_2)
+check_PROGRAMS = $(am__EXEEXT_1)
+noinst_PROGRAMS = H5_test_buildiface$(EXEEXT)
+TESTS = $(am__EXEEXT_1)
subdir = fortran/test
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/aclocal_cxx.m4 \
@@ -97,34 +98,25 @@ am__aclocal_m4_deps = $(top_srcdir)/m4/aclocal_cxx.m4 \
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(SHELL) $(top_srcdir)/bin/mkinstalldirs
-CONFIG_HEADER = $(top_builddir)/src/H5config.h
+CONFIG_HEADER = $(top_builddir)/src/H5config.h \
+ $(top_builddir)/fortran/src/H5config_f.inc
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
LTLIBRARIES = $(noinst_LTLIBRARIES)
libh5test_fortran_la_LIBADD =
-am__libh5test_fortran_la_SOURCES_DIST = tf_F90.f90 tf.f90 t.c \
- tf_F03.f90 tf_F08.f90
-@FORTRAN_2003_CONDITIONAL_F_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@am_libh5test_fortran_la_OBJECTS = tf_F90.lo \
-@FORTRAN_2003_CONDITIONAL_F_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@ tf.lo \
-@FORTRAN_2003_CONDITIONAL_F_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@ t.lo
-@FORTRAN_2003_CONDITIONAL_F_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@am_libh5test_fortran_la_OBJECTS = tf_F03.lo \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@ tf.lo \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@ t.lo
-@FORTRAN_HAVE_C_SIZEOF_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@am_libh5test_fortran_la_OBJECTS = tf_F03.lo \
-@FORTRAN_HAVE_C_SIZEOF_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@ tf.lo \
-@FORTRAN_HAVE_C_SIZEOF_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@ t.lo
-@FORTRAN_HAVE_C_SIZEOF_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@am_libh5test_fortran_la_OBJECTS = tf_F08.lo \
-@FORTRAN_HAVE_C_SIZEOF_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@ tf.lo \
-@FORTRAN_HAVE_C_SIZEOF_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@ t.lo
+am_libh5test_fortran_la_OBJECTS = tf_gen.lo tf.lo t.lo
libh5test_fortran_la_OBJECTS = $(am_libh5test_fortran_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
-@FORTRAN_2003_CONDITIONAL_F_TRUE@am__EXEEXT_1 = \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ fortranlib_test_F03$(EXEEXT)
-am__EXEEXT_2 = fortranlib_test$(EXEEXT) fflush1$(EXEEXT) \
- fflush2$(EXEEXT) fortranlib_test_1_8$(EXEEXT) $(am__EXEEXT_1)
+am__EXEEXT_1 = fortranlib_test$(EXEEXT) fflush1$(EXEEXT) \
+ fflush2$(EXEEXT) fortranlib_test_1_8$(EXEEXT) \
+ fortranlib_test_F03$(EXEEXT)
+PROGRAMS = $(noinst_PROGRAMS)
+am_H5_test_buildiface_OBJECTS = H5_test_buildiface.$(OBJEXT)
+H5_test_buildiface_OBJECTS = $(am_H5_test_buildiface_OBJECTS)
+H5_test_buildiface_DEPENDENCIES =
am_fflush1_OBJECTS = fflush1.$(OBJEXT)
fflush1_OBJECTS = $(am_fflush1_OBJECTS)
fflush1_LDADD = $(LDADD)
@@ -159,18 +151,10 @@ fortranlib_test_1_8_OBJECTS = $(am_fortranlib_test_1_8_OBJECTS)
fortranlib_test_1_8_LDADD = $(LDADD)
fortranlib_test_1_8_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \
$(LIBH5F) $(LIBHDF5)
-am__fortranlib_test_F03_SOURCES_DIST = tH5E_F03.f90 tH5F_F03.f90 \
- tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 \
- tHDF5_F03.f90 fortranlib_test_F03.f90
-@FORTRAN_2003_CONDITIONAL_F_TRUE@am_fortranlib_test_F03_OBJECTS = \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5E_F03.$(OBJEXT) \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F_F03.$(OBJEXT) \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5L_F03.$(OBJEXT) \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5O_F03.$(OBJEXT) \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5P_F03.$(OBJEXT) \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5T_F03.$(OBJEXT) \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tHDF5_F03.$(OBJEXT) \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ fortranlib_test_F03.$(OBJEXT)
+am_fortranlib_test_F03_OBJECTS = tH5E_F03.$(OBJEXT) tH5F_F03.$(OBJEXT) \
+ tH5L_F03.$(OBJEXT) tH5O_F03.$(OBJEXT) tH5P_F03.$(OBJEXT) \
+ tH5T_F03.$(OBJEXT) tHDF5_F03.$(OBJEXT) \
+ fortranlib_test_F03.$(OBJEXT)
fortranlib_test_F03_OBJECTS = $(am_fortranlib_test_F03_OBJECTS)
fortranlib_test_F03_LDADD = $(LDADD)
fortranlib_test_F03_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \
@@ -187,10 +171,28 @@ AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
-DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)/src
+DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)/src -I$(top_builddir)/fortran/src
depcomp = $(SHELL) $(top_srcdir)/bin/depcomp
am__depfiles_maybe = depfiles
am__mv = mv -f
+PPFCCOMPILE = $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
+ $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS)
+LTPPFCCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=FC $(AM_LIBTOOLFLAGS) \
+ $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) \
+ $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+ $(AM_FCFLAGS) $(FCFLAGS)
+AM_V_PPFC = $(am__v_PPFC_@AM_V@)
+am__v_PPFC_ = $(am__v_PPFC_@AM_DEFAULT_V@)
+am__v_PPFC_0 = @echo " PPFC " $@;
+am__v_PPFC_1 =
+FCLD = $(FC)
+FCLINK = $(LIBTOOL) $(AM_V_lt) --tag=FC $(AM_LIBTOOLFLAGS) \
+ $(LIBTOOLFLAGS) --mode=link $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \
+ $(AM_LDFLAGS) $(LDFLAGS) -o $@
+AM_V_FCLD = $(am__v_FCLD_@AM_V@)
+am__v_FCLD_ = $(am__v_FCLD_@AM_DEFAULT_V@)
+am__v_FCLD_0 = @echo " FCLD " $@;
+am__v_FCLD_1 =
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
@@ -216,21 +218,14 @@ AM_V_FC = $(am__v_FC_@AM_V@)
am__v_FC_ = $(am__v_FC_@AM_DEFAULT_V@)
am__v_FC_0 = @echo " FC " $@;
am__v_FC_1 =
-FCLD = $(FC)
-FCLINK = $(LIBTOOL) $(AM_V_lt) --tag=FC $(AM_LIBTOOLFLAGS) \
- $(LIBTOOLFLAGS) --mode=link $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \
- $(AM_LDFLAGS) $(LDFLAGS) -o $@
-AM_V_FCLD = $(am__v_FCLD_@AM_V@)
-am__v_FCLD_ = $(am__v_FCLD_@AM_DEFAULT_V@)
-am__v_FCLD_0 = @echo " FCLD " $@;
-am__v_FCLD_1 =
-SOURCES = $(libh5test_fortran_la_SOURCES) $(fflush1_SOURCES) \
+SOURCES = $(libh5test_fortran_la_SOURCES) \
+ $(H5_test_buildiface_SOURCES) $(fflush1_SOURCES) \
+ $(fflush2_SOURCES) $(fortranlib_test_SOURCES) \
+ $(fortranlib_test_1_8_SOURCES) $(fortranlib_test_F03_SOURCES)
+DIST_SOURCES = $(libh5test_fortran_la_SOURCES) \
+ $(H5_test_buildiface_SOURCES) $(fflush1_SOURCES) \
$(fflush2_SOURCES) $(fortranlib_test_SOURCES) \
$(fortranlib_test_1_8_SOURCES) $(fortranlib_test_F03_SOURCES)
-DIST_SOURCES = $(am__libh5test_fortran_la_SOURCES_DIST) \
- $(fflush1_SOURCES) $(fflush2_SOURCES) \
- $(fortranlib_test_SOURCES) $(fortranlib_test_1_8_SOURCES) \
- $(am__fortranlib_test_F03_SOURCES_DIST)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
@@ -522,14 +517,21 @@ F9XMODEXT = @F9XMODEXT@
F9XMODFLAG = @F9XMODFLAG@
F9XSUFFIXFLAG = @F9XSUFFIXFLAG@
FC = @FC@
-FC2003 = @FC2003@
FCFLAGS = @FCFLAGS@
FCFLAGS_f90 = @FCFLAGS_f90@
FCLIBS = @FCLIBS@
FC_VERSION = @FC_VERSION@
FGREP = @FGREP@
+FORTRAN_C_LONG_DOUBLE_IS_UNIQUE = @FORTRAN_C_LONG_DOUBLE_IS_UNIQUE@
+FORTRAN_HAVE_C_LONG_DOUBLE = @FORTRAN_HAVE_C_LONG_DOUBLE@
+FORTRAN_SIZEOF_LONG_DOUBLE = @FORTRAN_SIZEOF_LONG_DOUBLE@
FSEARCH_DIRS = @FSEARCH_DIRS@
GREP = @GREP@
+H5CONFIG_F_IKIND = @H5CONFIG_F_IKIND@
+H5CONFIG_F_NUM_IKIND = @H5CONFIG_F_NUM_IKIND@
+H5CONFIG_F_NUM_RKIND = @H5CONFIG_F_NUM_RKIND@
+H5CONFIG_F_RKIND = @H5CONFIG_F_RKIND@
+H5CONFIG_F_RKIND_SIZEOF = @H5CONFIG_F_RKIND_SIZEOF@
H5_CFLAGS = @H5_CFLAGS@
H5_CPPFLAGS = @H5_CPPFLAGS@
H5_CXXFLAGS = @H5_CXXFLAGS@
@@ -539,13 +541,12 @@ H5_LDFLAGS = @H5_LDFLAGS@
H5_VERSION = @H5_VERSION@
HADDR_T = @HADDR_T@
HAVE_DMALLOC = @HAVE_DMALLOC@
-HAVE_FORTRAN_2003 = @HAVE_FORTRAN_2003@
+HAVE_Fortran_INTEGER_SIZEOF_16 = @HAVE_Fortran_INTEGER_SIZEOF_16@
HAVE_PTHREAD = @HAVE_PTHREAD@
HDF5_HL = @HDF5_HL@
HDF5_INTERFACES = @HDF5_INTERFACES@
HDF_CXX = @HDF_CXX@
HDF_FORTRAN = @HDF_FORTRAN@
-HDF_FORTRAN2003 = @HDF_FORTRAN2003@
HID_T = @HID_T@
HL = @HL@
HL_FOR = @HL_FOR@
@@ -587,6 +588,18 @@ PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
+PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@
+PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@
+PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@
+PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@
+PAC_FC_ALL_REAL_KINDS_SIZEOF = @PAC_FC_ALL_REAL_KINDS_SIZEOF@
+PAC_FC_MAX_REAL_PRECISION = @PAC_FC_MAX_REAL_PRECISION@
+PAC_FORTRAN_NATIVE_DOUBLE_KIND = @PAC_FORTRAN_NATIVE_DOUBLE_KIND@
+PAC_FORTRAN_NATIVE_DOUBLE_SIZEOF = @PAC_FORTRAN_NATIVE_DOUBLE_SIZEOF@
+PAC_FORTRAN_NATIVE_INTEGER_KIND = @PAC_FORTRAN_NATIVE_INTEGER_KIND@
+PAC_FORTRAN_NATIVE_INTEGER_SIZEOF = @PAC_FORTRAN_NATIVE_INTEGER_SIZEOF@
+PAC_FORTRAN_NATIVE_REAL_KIND = @PAC_FORTRAN_NATIVE_REAL_KIND@
+PAC_FORTRAN_NATIVE_REAL_SIZEOF = @PAC_FORTRAN_NATIVE_REAL_SIZEOF@
PARALLEL = @PARALLEL@
PATH_SEPARATOR = @PATH_SEPARATOR@
PERL = @PERL@
@@ -732,39 +745,10 @@ CHECK_CLEANFILES = *.chkexe *.chklog *.clog *.clog2 *.h5 *.raw
# The Fortran test library
noinst_LTLIBRARIES = libh5test_fortran.la
-@FORTRAN_2003_CONDITIONAL_F_FALSE@ff_PREFIX = F90
-
-# Check if the compiler supports the Fortran 2003 standard
-# which should include the intrinsic module iso_c_binding
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ff_PREFIX = F03
# Our main targets, the tests themselves
-TEST_PROG = fortranlib_test fflush1 fflush2 fortranlib_test_1_8 \
- $(am__append_2)
-
-# tf.f90 depends on either tf_F08.f90 or tf_F03.f90 so they need to be
-# compiled first
-@FORTRAN_2003_CONDITIONAL_F_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@libh5test_fortran_la_SOURCES = tf_F90.f90 \
-@FORTRAN_2003_CONDITIONAL_F_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@ tf.f90 \
-@FORTRAN_2003_CONDITIONAL_F_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@ t.c
-
-# tf.f90 depends on either tf_F08.f90 or tf_F03.f90 so they need to be
-# compiled first
-@FORTRAN_2003_CONDITIONAL_F_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@libh5test_fortran_la_SOURCES = tf_F03.f90 \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@ tf.f90 \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_FALSE@ t.c
-
-# tf.f90 depends on either tf_F08.f90 or tf_F03.f90 so they need to be
-# compiled first
-@FORTRAN_HAVE_C_SIZEOF_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@libh5test_fortran_la_SOURCES = tf_F03.f90 \
-@FORTRAN_HAVE_C_SIZEOF_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@ tf.f90 \
-@FORTRAN_HAVE_C_SIZEOF_FALSE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@ t.c
-
-# tf.f90 depends on either tf_F08.f90 or tf_F03.f90 so they need to be
-# compiled first
-@FORTRAN_HAVE_C_SIZEOF_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@libh5test_fortran_la_SOURCES = tf_F08.f90 \
-@FORTRAN_HAVE_C_SIZEOF_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@ tf.f90 \
-@FORTRAN_HAVE_C_SIZEOF_TRUE@@FORTRAN_HAVE_STORAGE_SIZE_TRUE@ t.c
+TEST_PROG = fortranlib_test fflush1 fflush2 fortranlib_test_1_8 fortranlib_test_F03
+libh5test_fortran_la_SOURCES = tf_gen.F90 tf.F90 t.c
# Source files are used for both the library and fortranlib_test.
# Automake will complain about this without the following workaround.
@@ -773,11 +757,11 @@ fortranlib_test_CFLAGS = $(AM_CFLAGS)
fortranlib_test_SOURCES = tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 \
tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 tHDF5.f90 fortranlib_test.f90
-fortranlib_test_1_8_SOURCES = tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 tH5MISC_1_8.f90 tHDF5_1_8.f90\
+fortranlib_test_1_8_SOURCES = tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 tH5MISC_1_8.f90 tHDF5_1_8.f90 \
fortranlib_test_1_8.f90
-@FORTRAN_2003_CONDITIONAL_F_TRUE@fortranlib_test_F03_SOURCES = tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 tHDF5_F03.f90 fortranlib_test_F03.f90
+fortranlib_test_F03_SOURCES = tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 \
+ tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.F90 tHDF5_F03.f90 fortranlib_test_F03.f90
fflush1_SOURCES = fflush1.f90
fflush2_SOURCES = fflush2.f90
@@ -790,6 +774,14 @@ MOSTLYCLEANFILES = *.tmp
# from tests in conclude.am)
FORTRAN_API = yes
+# H5_test_buildiface.F90 is included in the distribution, and Automake knows
+# how to compile a fortran program given its sources.
+H5_test_buildiface_SOURCES = H5_test_buildiface.F90
+
+# The build of the H5_test_buildiface does depend on any libraries, so set it
+# to nothing.
+H5_test_buildiface_LDADD =
+
# Automake needs to be taught how to build lib, progs, and tests targets.
# These will be filled in automatically for the most part (e.g.,
# lib_LIBRARIES are built for lib target), but EXTRA_LIB, EXTRA_PROG, and
@@ -812,7 +804,7 @@ TEST_SCRIPT_PARA_CHKSH = $(TEST_SCRIPT_PARA:=.chkexe_)
all: all-am
.SUFFIXES:
-.SUFFIXES: .c .f90 .lo .log .o .obj .sh .sh$(EXEEXT) .trs
+.SUFFIXES: .F90 .c .f90 .lo .log .o .obj .sh .sh$(EXEEXT) .trs
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(top_srcdir)/config/commence.am $(top_srcdir)/config/conclude.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
@@ -868,6 +860,19 @@ clean-checkPROGRAMS:
echo " rm -f" $$list; \
rm -f $$list
+clean-noinstPROGRAMS:
+ @list='$(noinst_PROGRAMS)'; test -n "$$list" || exit 0; \
+ echo " rm -f" $$list; \
+ rm -f $$list || exit $$?; \
+ test -n "$(EXEEXT)" || exit 0; \
+ list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
+ echo " rm -f" $$list; \
+ rm -f $$list
+
+H5_test_buildiface$(EXEEXT): $(H5_test_buildiface_OBJECTS) $(H5_test_buildiface_DEPENDENCIES) $(EXTRA_H5_test_buildiface_DEPENDENCIES)
+ @rm -f H5_test_buildiface$(EXEEXT)
+ $(AM_V_FCLD)$(FCLINK) $(H5_test_buildiface_OBJECTS) $(H5_test_buildiface_LDADD) $(LIBS)
+
fflush1$(EXEEXT): $(fflush1_OBJECTS) $(fflush1_DEPENDENCIES) $(EXTRA_fflush1_DEPENDENCIES)
@rm -f fflush1$(EXEEXT)
$(AM_V_FCLD)$(FCLINK) $(fflush1_OBJECTS) $(fflush1_LDADD) $(LIBS)
@@ -896,6 +901,15 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/t.Plo@am__quote@
+.F90.o:
+ $(AM_V_PPFC)$(PPFCCOMPILE) -c -o $@ $<
+
+.F90.obj:
+ $(AM_V_PPFC)$(PPFCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+.F90.lo:
+ $(AM_V_PPFC)$(LTPPFCCOMPILE) -c -o $@ $<
+
.c.o:
@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@@ -1288,7 +1302,7 @@ check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
-all-am: Makefile $(LTLIBRARIES) all-local
+all-am: Makefile $(LTLIBRARIES) $(PROGRAMS) all-local
installdirs:
install: install-am
install-exec: install-exec-am
@@ -1327,7 +1341,7 @@ maintainer-clean-generic:
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool clean-local \
- clean-noinstLTLIBRARIES mostlyclean-am
+ clean-noinstLTLIBRARIES clean-noinstPROGRAMS mostlyclean-am
distclean: distclean-am
-rm -rf ./$(DEPDIR)
@@ -1400,19 +1414,19 @@ uninstall-am:
.PHONY: CTAGS GTAGS TAGS all all-am all-local check check-TESTS \
check-am clean clean-checkPROGRAMS clean-generic clean-libtool \
- clean-local clean-noinstLTLIBRARIES cscopelist-am ctags \
- ctags-am distclean distclean-compile distclean-generic \
- distclean-libtool distclean-local distclean-tags distdir dvi \
- dvi-am html html-am info info-am install install-am \
- install-data install-data-am install-dvi install-dvi-am \
- install-exec install-exec-am install-html install-html-am \
- install-info install-info-am install-man install-pdf \
- install-pdf-am install-ps install-ps-am install-strip \
- installcheck installcheck-am installdirs maintainer-clean \
- maintainer-clean-generic maintainer-clean-local mostlyclean \
- mostlyclean-compile mostlyclean-generic mostlyclean-libtool \
- mostlyclean-local pdf pdf-am ps ps-am recheck tags tags-am \
- uninstall uninstall-am
+ clean-local clean-noinstLTLIBRARIES clean-noinstPROGRAMS \
+ cscopelist-am ctags ctags-am distclean distclean-compile \
+ distclean-generic distclean-libtool distclean-local \
+ distclean-tags distdir dvi dvi-am html html-am info info-am \
+ install install-am install-data install-data-am install-dvi \
+ install-dvi-am install-exec install-exec-am install-html \
+ install-html-am install-info install-info-am install-man \
+ install-pdf install-pdf-am install-ps install-ps-am \
+ install-strip installcheck installcheck-am installdirs \
+ maintainer-clean maintainer-clean-generic \
+ maintainer-clean-local mostlyclean mostlyclean-compile \
+ mostlyclean-generic mostlyclean-libtool mostlyclean-local pdf \
+ pdf-am ps ps-am recheck tags tags-am uninstall uninstall-am
#
@@ -1453,9 +1467,15 @@ maintainer-clean-local: clean-local
distclean-local: clean-local
clean-local:
@if test -n "$(F9XMODEXT)" && test "X$(F9XMODEXT)" != "Xo"; then \
- $(RM) *.$(F9XMODEXT); \
+ $(RM) *.$(F9XMODEXT) tf_gen.F90; \
fi
+# H5_test_buildiface.F90 generates all the test APIs that have a KIND type associated
+# with them.
+
+tf_gen.F90: H5_test_buildiface$(EXEEXT)
+ $(RUNSERIAL) ./H5_test_buildiface$(EXEEXT)
+
# fflush2 depends on files created by fflush1
fflush2.chkexe_: fflush1.chkexe_
diff --git a/fortran/test/fflush2.f90 b/fortran/test/fflush2.f90
index 04ce439..4230832 100644
--- a/fortran/test/fflush2.f90
+++ b/fortran/test/fflush2.f90
@@ -27,152 +27,151 @@
!
!*****
- PROGRAM FFLUSH2EXAMPLE
-
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
- IMPLICIT NONE
-
- CHARACTER(LEN=7), PARAMETER :: filename = "fflush1"
- CHARACTER(LEN=80) :: fix_filename
-
- !
- !data space rank and dimensions
- !
- INTEGER, PARAMETER :: NX = 4
- INTEGER, PARAMETER :: NY = 5
-
- !
- ! File identifiers
- !
- INTEGER(HID_T) :: file_id
-
- !
- ! Group identifier
- !
- INTEGER(HID_T) :: gid
-
- !
- ! dataset identifier
- !
- INTEGER(HID_T) :: dset_id
-
-
- !
- ! data type identifier
- !
- INTEGER(HID_T) :: dtype_id
-
- !
- !flag to check operation success
- !
- INTEGER :: error
-
- !
- !general purpose integer
- !
- INTEGER :: i, j, total_error = 0
-
- !
- !data buffers
- !
- INTEGER, DIMENSION(NX,NY) :: data_out
- INTEGER(HSIZE_T), DIMENSION(2) :: data_dims
- data_dims(1) = NX
- data_dims(2) = NY
-
- !
- !Initialize FORTRAN predifined datatypes
- !
- CALL h5open_f(error)
- CALL check("h5open_f",error,total_error)
-
- !
- !Open the file.
- !
- CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
- if (error .ne. 0) then
- write(*,*) "Cannot modify filename"
- CALL h5_exit_f (1)
- endif
- CALL h5fopen_f(fix_filename, H5F_ACC_RDONLY_F, file_id, error)
- CALL check("h5fopen_f",error,total_error)
-
- !
- !Open the dataset
- !
- CALL h5dopen_f(file_id, "/D", dset_id, error)
- CALL check("h5dopen_f",error,total_error)
-
- !
- !Get dataset's data type.
- !
- CALL h5dget_type_f(dset_id, dtype_id, error)
- CALL check("h5dget_type_f",error,total_error)
-
- !
- !Read the dataset.
- !
- CALL h5dread_f(dset_id, dtype_id, data_out, data_dims, error)
- CALL check("h5dread_f",error,total_error)
-
- !
- !Print the dataset.
- !
- do i = 1, NX
- write(*,*) (data_out(i,j), j = 1, NY)
- end do
-!
-!result of the print statement
-!
-! 0, 1, 2, 3, 4
-! 1, 2, 3, 4, 5
-! 2, 3, 4, 5, 6
-! 3, 4, 5, 6, 7
-
- !
- !Open the group.
- !
- CALL h5gopen_f(file_id, "G", gid, error)
- CALL check("h5gopen_f",error,total_error)
-
- !
- !In case error happens, exit.
- !
- IF (error == -1) CALL h5_exit_f (1)
- !
- !Close the datatype
- !
- CALL h5tclose_f(dtype_id, error)
- CALL check("h5tclose_f",error,total_error)
-
- !
- !Close the dataset.
- !
- CALL h5dclose_f(dset_id, error)
- CALL check("h5dclose_f",error,total_error)
-
- !
- !Close the group.
- !
- CALL h5gclose_f(gid, error)
- CALL check("h5gclose_f",error,total_error)
-
- !
- !Close the file.
- !
- CALL h5fclose_f(file_id, error)
- CALL check("h5fclose_f",error,total_error)
-
- !
- !Close FORTRAN predifined datatypes
- !
- CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
- CALL h5close_f(error)
- CALL check("h5close_types_f",error,total_error)
-
- ! if errors detected, exit with non-zero code.
- IF (total_error .ne. 0) CALL h5_exit_f (1)
-
- END PROGRAM FFLUSH2EXAMPLE
+PROGRAM FFLUSH2EXAMPLE
+
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+
+ IMPLICIT NONE
+
+ CHARACTER(LEN=7), PARAMETER :: filename = "fflush1"
+ CHARACTER(LEN=80) :: fix_filename
+
+ !
+ !data space rank and dimensions
+ !
+ INTEGER, PARAMETER :: NX = 4
+ INTEGER, PARAMETER :: NY = 5
+
+ !
+ ! File identifiers
+ !
+ INTEGER(HID_T) :: file_id
+
+ !
+ ! Group identifier
+ !
+ INTEGER(HID_T) :: gid
+
+ !
+ ! dataset identifier
+ !
+ INTEGER(HID_T) :: dset_id
+
+
+ !
+ ! data type identifier
+ !
+ INTEGER(HID_T) :: dtype_id
+
+ !
+ !flag to check operation success
+ !
+ INTEGER :: error
+
+ !
+ !general purpose integer
+ !
+ INTEGER :: i, j, total_error = 0
+
+ !
+ !data buffers
+ !
+ INTEGER, DIMENSION(NX,NY) :: data_out
+ INTEGER(HSIZE_T), DIMENSION(2) :: data_dims
+ data_dims(1) = NX
+ data_dims(2) = NY
+
+ !
+ !Initialize FORTRAN predifined datatypes
+ !
+ CALL h5open_f(error)
+ CALL check("h5open_f",error,total_error)
+
+ !
+ !Open the file.
+ !
+ CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
+ IF (error .NE. 0) THEN
+ WRITE(*,*) "Cannot modify filename"
+ CALL h5_exit_f (1)
+ ENDIF
+ CALL h5fopen_f(fix_filename, H5F_ACC_RDONLY_F, file_id, error)
+ CALL check("h5fopen_f",error,total_error)
+
+ !
+ !Open the dataset
+ !
+ CALL h5dopen_f(file_id, "/D", dset_id, error)
+ CALL check("h5dopen_f",error,total_error)
+
+ !
+ !Get dataset's data type.
+ !
+ CALL h5dget_type_f(dset_id, dtype_id, error)
+ CALL check("h5dget_type_f",error,total_error)
+ !
+ !Read the dataset.
+ !
+ CALL h5dread_f(dset_id, dtype_id, data_out, data_dims, error)
+ CALL check("h5dread_f",error,total_error)
+
+ !
+ !Print the dataset.
+ !
+ DO i = 1, NX
+ WRITE(*,*) (data_out(i,j), j = 1, NY)
+ END DO
+ !
+ !result of the print statement
+ !
+ ! 0, 1, 2, 3, 4
+ ! 1, 2, 3, 4, 5
+ ! 2, 3, 4, 5, 6
+ ! 3, 4, 5, 6, 7
+
+ !
+ !Open the group.
+ !
+ CALL h5gopen_f(file_id, "G", gid, error)
+ CALL check("h5gopen_f",error,total_error)
+
+ !
+ !In case error happens, exit.
+ !
+ IF (error == -1) CALL h5_exit_f (1)
+ !
+ !Close the datatype
+ !
+ CALL h5tclose_f(dtype_id, error)
+ CALL check("h5tclose_f",error,total_error)
+
+ !
+ !Close the dataset.
+ !
+ CALL h5dclose_f(dset_id, error)
+ CALL check("h5dclose_f",error,total_error)
+
+ !
+ !Close the group.
+ !
+ CALL h5gclose_f(gid, error)
+ CALL check("h5gclose_f",error,total_error)
+
+ !
+ !Close the file.
+ !
+ CALL h5fclose_f(file_id, error)
+ CALL check("h5fclose_f",error,total_error)
+
+ !
+ !Close FORTRAN predifined datatypes
+ !
+ CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
+ CALL h5close_f(error)
+ CALL check("h5close_types_f",error,total_error)
+
+ ! if errors detected, exit with non-zero code.
+ IF (total_error .ne. 0) CALL h5_exit_f (1)
+
+END PROGRAM FFLUSH2EXAMPLE
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90
index e3b3b2a..5b814fa 100644
--- a/fortran/test/tH5A.f90
+++ b/fortran/test/tH5A.f90
@@ -29,6 +29,10 @@
!*****
MODULE TH5A
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE attribute_test(cleanup, total_error)
@@ -36,9 +40,6 @@ CONTAINS
! h5acreate_f, h5awrite_f, h5aclose_f,h5aread_f, h5aopen_name_f,
! h5aget_name_f,h5aget_space_f, h5aget_type_f,
!
-
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
@@ -309,7 +310,7 @@ CONTAINS
!
CALL h5aget_storage_size_f(attr_id, attr_storage, error)
CALL check("h5aget_storage_size_f",error,total_error)
-! CALL VERIFY("h5aget_storage_size_f",attr_storage,*SizeOf(attr_storage),total_error)
+! CALL verify("h5aget_storage_size_f",attr_storage,*SizeOf(attr_storage),total_error)
CALL h5aget_storage_size_f(attr2_id, attr_storage, error)
CALL check("h5aget_storage_size_f",error,total_error)
! CALL verify("h5aget_storage_size_f",attr_storage,1,total_error)
@@ -517,21 +518,15 @@ 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)
+ CALL VERIFY("Read back double attrbute is wrong", aread_double_data(1),3.459_Fortran_DOUBLE,total_error)
- 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( .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
+ CALL VERIFY("Read back real attrbute is wrong", aread_real_data(1),4.0,total_error)
!
!read the Integer attribute data back to memory
!
diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90
index 8e20100..c70e288 100644
--- a/fortran/test/tH5A_1_8.f90
+++ b/fortran/test/tH5A_1_8.f90
@@ -32,6 +32,10 @@
!*****
MODULE TH5A_1_8
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE attribute_test_1_8(cleanup, total_error)
@@ -41,8 +45,6 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
! H5Pset_shared_mesg_index_f
!
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -199,8 +201,6 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
! Needed for get_info_by_name
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
@@ -350,7 +350,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
! Verify creation order of attribute
- CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error)
+ CALL verify("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error)
CALL verify("H5Aget_info_by_name_f", corder, u, total_error)
@@ -363,7 +363,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
! Verify creation order of attribute
- CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error)
+ CALL verify("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error)
CALL verify("H5Aget_info_by_name_f", corder, u, total_error)
END DO
@@ -389,8 +389,7 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
!** Tests storing attribute with "null" dataspace
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
+
IMPLICIT NONE
@@ -473,22 +472,22 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
CALL H5Sextent_equal_f(attr_sid, null_sid, equal, error)
CALL check("H5Sextent_equal_f",error,total_error)
- CALL Verifylogical("H5Sextent_equal_f",equal,.TRUE.,total_error)
+ CALL verify("H5Sextent_equal_f",equal,.TRUE.,total_error)
CALL h5aget_storage_size_f(attr, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
- CALL VERIFY("h5aget_storage_size_f",INT(storage_size),0,total_error)
+ CALL verify("h5aget_storage_size_f",INT(storage_size),0,total_error)
CALL h5aget_info_f(attr, f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_f", error, total_error)
! Check the attribute's information
- CALL VERIFY("h5aget_info_f.corder",corder,0,total_error)
+ CALL verify("h5aget_info_f.corder",corder,0,total_error)
- CALL VERIFY("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
CALL h5aget_storage_size_f(attr, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
- CALL VERIFY("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error)
+ CALL verify("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error)
CALL h5aclose_f(attr,error)
CALL check("h5aclose_f",error,total_error)
@@ -520,9 +519,6 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(SIZE_T), PARAMETER :: NAME_BUF_SIZE = 7
@@ -735,9 +731,6 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
LOGICAL :: new_format
@@ -859,24 +852,24 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
CALL h5aget_info_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, 0_hsize_t, &
f_corder_valid, corder, cset, data_size, error, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("h5aget_info_by_idx_f",error,minusone,total_error)
+ CALL verify("h5aget_info_by_idx_f",error,minusone,total_error)
! 2) call by passing an integer with the INT(,hsize_t) declaration
CALL h5aget_info_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(0,hsize_t), &
f_corder_valid, corder, cset, data_size, error, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("h5aget_info_by_idx_f",error,minusone,total_error)
+ CALL verify("h5aget_info_by_idx_f",error,minusone,total_error)
! 3) call by passing a variable with the attribute hsize_t
CALL h5aget_info_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, hzero, &
f_corder_valid, corder, cset, data_size, error, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("h5aget_info_by_idx_f",error,minusone,total_error)
+ CALL verify("h5aget_info_by_idx_f",error,minusone,total_error)
CALL h5aget_name_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, &
hzero, tmpname, error, size, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("h5aget_name_by_idx_f",error,minusone,total_error)
+ CALL verify("h5aget_name_by_idx_f",error,minusone,total_error)
! Create attributes, up to limit of compact form
@@ -941,9 +934,6 @@ END SUBROUTINE test_attr_info_by_idx
SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER :: error, total_error
@@ -974,7 +964,7 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
! Verify the name for new link, in increasing creation order
@@ -983,12 +973,12 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CALL h5aget_name_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, &
n, tmpname, error, NAME_BUF_SIZE)
CALL check("h5aget_name_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_name_by_idx_f", INT(NAME_BUF_SIZE), 7, error)
+ CALL verify("h5aget_name_by_idx_f", INT(NAME_BUF_SIZE), 7, error)
IF(attrname.NE.tmpname)THEN
error = -1
ENDIF
- CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error)
+ CALL verify("h5aget_name_by_idx_f",error,0,total_error)
! Don't test "native" order if there is no creation order index, since
! * there's not a good way to easily predict the attribute's order in the name
@@ -999,13 +989,13 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,0,total_error)
! Verify the information for new attribute, in native creation order
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
! Verify the name for new link, in increasing native order
CALL h5aget_name_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, &
@@ -1015,14 +1005,14 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
WRITE(*,*) "ERROR: attribute name size wrong!"
error = -1
ENDIF
- CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error)
+ CALL verify("h5aget_name_by_idx_f",error,0,total_error)
END IF
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,0,total_error)
!EP CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, 0_HSIZE_T, &
@@ -1033,41 +1023,41 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, 0_HSIZE_T, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
! 2) call by passing an integer with the INT(,hsize_t) declaration
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, INT(0,HSIZE_T), &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
! 3) call by passing a variable with the attribute hsize_t
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
!EP CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_HSIZE_T, &
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,0,total_error)
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,0,total_error)
!EP CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, 0_HSIZE_T, &
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
- CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
+ CALL verify("h5aget_info_by_idx_f",corder,INT(n),total_error)
END SUBROUTINE attr_info_by_idx_check
@@ -1082,9 +1072,6 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fcpl
@@ -1371,7 +1358,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
! Check size of file
!filesize = h5_get_file_size(FILENAME);
- !VERIFY(filesize, empty_filesize, "h5_get_file_size");
+ !verify(filesize, empty_filesize, "h5_get_file_size");
ENDDO
! Close dataspaces
@@ -1392,9 +1379,6 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
LOGICAL, INTENT(IN) :: new_format
@@ -1518,7 +1502,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
! Check for deleting non-existant attribute
!EP CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, 0_HSIZE_T,error, lapl_id=H5P_DEFAULT_F)
CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, hzero,error, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
+ CALL verify("H5Adelete_by_idx_f",error,minusone,total_error)
! Create attributes, up to limit of compact form
DO u = 0, max_compact - 1
@@ -1546,7 +1530,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
! Check for out of bound deletions
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error, lapl_id=H5P_DEFAULT_F)
- CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
+ CALL verify("H5Adelete_by_idx_f",error,minusone,total_error)
ENDDO
@@ -1584,10 +1568,10 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
IF(new_format)THEN
IF(order.EQ.H5_ITER_INC_F)THEN
- CALL VERIFY("H5Aget_info_by_idx_f",corder,u + 1,total_error)
+ CALL verify("H5Aget_info_by_idx_f",corder,u + 1,total_error)
ENDIF
ELSE
- CALL VERIFY("H5Aget_info_by_idx_f",corder, max_compact-(u + 2),total_error)
+ CALL verify("H5Aget_info_by_idx_f",corder, max_compact-(u + 2),total_error)
ENDIF
! Verify the name for first attribute in appropriate order
@@ -1604,7 +1588,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
attrname = 'attr '//chr2
ENDIF
IF(TRIM(attrname).NE.TRIM(tmpname)) error = -1
- CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error)
+ CALL verify("h5aget_name_by_idx_f",error,0,total_error)
ENDDO
! Delete last attribute
@@ -1655,7 +1639,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
ENDDO
! Check for out of bound deletion
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error)
- CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
+ CALL verify("H5Adelete_by_idx_f",error,minusone,total_error)
ENDDO
! Work on all the datasets
@@ -1684,10 +1668,10 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
f_corder_valid, corder, cset, data_size, error)
IF(new_format)THEN
IF(order.EQ.H5_ITER_INC_F)THEN
- CALL VERIFY("H5Aget_info_by_idx_f",corder,u + 1,total_error)
+ CALL verify("H5Aget_info_by_idx_f",corder,u + 1,total_error)
ENDIF
ELSE
- CALL VERIFY("H5Aget_info_by_idx_f",corder, ((max_compact * 2) - (u + 2)), total_error)
+ CALL verify("H5Aget_info_by_idx_f",corder, ((max_compact * 2) - (u + 2)), total_error)
ENDIF
! Verify the name for first attribute in appropriate order
@@ -1705,7 +1689,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
attrname = 'attr '//chr2
ENDIF
IF(TRIM(attrname).NE.TRIM(tmpname)) error = -1
- CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error)
+ CALL verify("h5aget_name_by_idx_f",error,0,total_error)
ENDDO
@@ -1716,7 +1700,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
! Check for deletion on empty attribute storage again
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error)
- CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
+ CALL verify("H5Adelete_by_idx_f",error,minusone,total_error)
ENDDO
! Close Datasets
@@ -1753,9 +1737,6 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fcpl
@@ -2030,9 +2011,6 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
!**
!***************************************************************
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fcpl
@@ -2169,7 +2147,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
! Check size of file
! filesize = h5_get_file_size(FILENAME);
- ! VERIFY(filesize, empty_filesize, "h5_get_file_size")
+ ! verify(filesize, empty_filesize, "h5_get_file_size")
END SUBROUTINE test_attr_dense_open
@@ -2182,9 +2160,6 @@ END SUBROUTINE test_attr_dense_open
SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: loc_id
@@ -2227,7 +2202,7 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error)
CALL CHECK("H5Aread_F", error, total_error)
- CALL VERIFY("H5Aread_F", value, u, total_error)
+ CALL verify("H5Aread_F", value, u, total_error)
! Close attribute
CALL h5aclose_f(attr, error)
@@ -2259,7 +2234,7 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
data_dims(1) = 1
CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error)
CALL CHECK("H5Aread_f", error, total_error)
- CALL VERIFY("H5Aread_f", value, u, total_error)
+ CALL verify("H5Aread_f", value, u, total_error)
! Close attribute
@@ -2278,9 +2253,6 @@ END SUBROUTINE test_attr_dense_verify
SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fcpl
@@ -2314,14 +2286,14 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
! Get creation order indexing on object
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
- CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error)
+ CALL verify("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error)
! Setting invalid combination of a attribute order creation order indexing on should fail
CALL H5Pset_attr_creation_order_f(dcpl, H5P_CRT_ORDER_INDEXED_F, error)
- CALL VERIFY("H5Pset_attr_creation_order_f",error , minusone, total_error)
+ CALL verify("H5Pset_attr_creation_order_f",error , minusone, total_error)
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
- CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error)
+ CALL verify("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error)
! Set attribute creation order tracking & indexing for object
CALL h5pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), error)
@@ -2329,7 +2301,7 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
- CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , &
+ CALL verify("H5Pget_attr_creation_order_f",crt_order_flags , &
IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), total_error)
! Create dataspace for dataset
@@ -2374,7 +2346,7 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
! Query the attribute creation properties
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
- CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , &
+ CALL verify("H5Pget_attr_creation_order_f",crt_order_flags , &
IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), total_error )
! Close property list
@@ -2401,9 +2373,6 @@ END SUBROUTINE test_attr_corder_create_basic
SUBROUTINE test_attr_basic_write(fapl, total_error)
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -2512,7 +2481,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
CALL h5aget_storage_size_f(attr, attr_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
-!EP CALL VERIFY("h5aget_storage_size_f", INT(attr_size), 2*HSIZE_T, total_error)
+!EP CALL verify("h5aget_storage_size_f", INT(attr_size), 2*HSIZE_T, total_error)
! Read attribute information immediately, without closing attribute
@@ -2521,7 +2490,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
! Verify values read in
DO i = 1, ATTR1_DIM1
- CALL VERIFY('h5aread_f',attr_data1(i),read_data1(i), total_error)
+ CALL verify('h5aread_f',attr_data1(i),read_data1(i), total_error)
ENDDO
! CLOSE attribute
@@ -2570,7 +2539,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
size = 18
CALL H5Aget_name_f(attr, size, chr_exact_size, error)
CALL check('H5Aget_name_f',error,total_error)
- CALL VerifyString('H5Aget_name_f',chr_exact_size,ATTR_TMP_NAME, total_error)
+ CALL verify('H5Aget_name_f',chr_exact_size,ATTR_TMP_NAME, total_error)
! Close attribute
CALL h5aclose_f(attr, error)
@@ -2599,9 +2568,6 @@ END SUBROUTINE test_attr_basic_write
SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
LOGICAL, INTENT(IN) :: new_format
@@ -2656,19 +2622,19 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
WRITE(chr5,'(I5.5)') u
attrname = 'attr '//chr5
CALL H5Aexists_f( gid, attrname, exists, error)
- CALL VerifyLogical("H5Aexists",exists,.FALSE.,total_error )
+ CALL verify("H5Aexists",exists,.FALSE.,total_error )
CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error, lapl_id = H5P_DEFAULT_F)
- CALL VerifyLogical("H5Aexists_by_name_f",exists,.FALSE.,total_error )
+ CALL verify("H5Aexists_by_name_f",exists,.FALSE.,total_error )
CALL h5acreate_f(gid, attrname, H5T_NATIVE_INTEGER, sid, aid, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
CALL H5Aexists_f(gid, attrname, exists, error)
- CALL VerifyLogical("H5Aexists",exists,.TRUE.,total_error )
+ CALL verify("H5Aexists",exists,.TRUE.,total_error )
CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error)
- CALL VerifyLogical("H5Aexists_by_name_f",exists,.TRUE.,total_error )
+ CALL verify("H5Aexists_by_name_f",exists,.TRUE.,total_error )
attr_data1(1) = u
data_dims(1) = 1
@@ -2680,10 +2646,10 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
CALL check("h5aclose_f",error,total_error)
CALL H5Aexists_f(gid, attrname, exists, error)
- CALL VerifyLogical("H5Aexists",exists,.TRUE.,total_error )
+ CALL verify("H5Aexists",exists,.TRUE.,total_error )
CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error)
- CALL VerifyLogical("H5Aexists_by_name_f",exists,.TRUE.,total_error )
+ CALL verify("H5Aexists_by_name_f",exists,.TRUE.,total_error )
ENDDO
@@ -2717,9 +2683,6 @@ END SUBROUTINE test_attr_many
SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fid
CHARACTER(LEN=*), INTENT(IN) :: dsetname
@@ -2757,13 +2720,13 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
CALL check("h5aget_info_f",error,total_error)
! Check that the object's attributes are correct
- CALL VERIFY("h5aget_info_f.corder",corder,u,total_error)
- CALL Verifylogical("h5aget_info_f.corder_valid",f_corder_valid,.TRUE.,total_error)
- CALL VERIFY("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("h5aget_info_f.corder",corder,u,total_error)
+ CALL verify("h5aget_info_f.corder_valid",f_corder_valid,.TRUE.,total_error)
+ CALL verify("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
CALL h5aget_storage_size_f(attr_id, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
- CALL VERIFY("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error)
+ CALL verify("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error)
! Close attribute
@@ -2778,12 +2741,12 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_f",error,total_error)
! Check the attribute's information
- CALL VERIFY("h5aget_info_f",corder,u,total_error)
- CALL Verifylogical("h5aget_info_f",f_corder_valid,.TRUE.,total_error)
- CALL VERIFY("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("h5aget_info_f",corder,u,total_error)
+ CALL verify("h5aget_info_f",f_corder_valid,.TRUE.,total_error)
+ CALL verify("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error)
CALL h5aget_storage_size_f(attr_id, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
- CALL VERIFY("h5aget_info_f", INT(data_size), INT(storage_size), total_error)
+ CALL verify("h5aget_info_f", INT(data_size), INT(storage_size), total_error)
! Close attribute
CALL h5aclose_f(attr_id, error)
@@ -2800,12 +2763,12 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
CALL check("h5aget_info_f",error,total_error)
! Check the attribute's information
- CALL VERIFY("h5aget_info_f",corder,u,total_error)
- CALL Verifylogical("h5aget_info_f",f_corder_valid,.TRUE.,total_error)
- CALL VERIFY("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("h5aget_info_f",corder,u,total_error)
+ CALL verify("h5aget_info_f",f_corder_valid,.TRUE.,total_error)
+ CALL verify("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error)
CALL h5aget_storage_size_f(attr_id, storage_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
- CALL VERIFY("h5aget_info_f", INT(data_size), INT(storage_size), total_error)
+ CALL verify("h5aget_info_f", INT(data_size), INT(storage_size), total_error)
! Close attribute
CALL h5aclose_f(attr_id, error)
diff --git a/fortran/test/tH5D.f90 b/fortran/test/tH5D.f90
index c0eb8f9..b5febb3 100644
--- a/fortran/test/tH5D.f90
+++ b/fortran/test/tH5D.f90
@@ -36,503 +36,477 @@
!
MODULE TH5D
-CONTAINS
- SUBROUTINE datasettest(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
- IMPLICIT NONE
- LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
-
- CHARACTER(LEN=5), PARAMETER :: filename = "dsetf" ! File name
- CHARACTER(LEN=80) :: fix_filename
- CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name
- CHARACTER(LEN=9), PARAMETER :: null_dsetname = "null_dset" ! Dataset name
-
- INTEGER(HID_T) :: file_id ! File identifier
- INTEGER(HID_T) :: dset_id ! Dataset identifier
- INTEGER(HID_T) :: null_dset ! Null dataset identifier
- INTEGER(HID_T) :: dspace_id ! Dataspace identifier
- INTEGER(HID_T) :: null_dspace ! Null dataspace identifier
- INTEGER(HID_T) :: dtype_id ! Datatype identifier
-
-
- INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions
- INTEGER :: rank = 2 ! Dataset rank
-
- INTEGER, DIMENSION(4,6) :: dset_data, data_out ! Data buffers
- INTEGER :: error ! Error flag
-
- INTEGER :: i, j !general purpose integers
- INTEGER(HSIZE_T), DIMENSION(2) :: data_dims
- INTEGER(HSIZE_T), DIMENSION(1) :: null_data_dim
- INTEGER :: null_dset_data = 1 ! null data
- INTEGER :: flag ! Space allocation status
-
- !
- ! Initialize the dset_data array.
- !
- do i = 1, 4
- do j = 1, 6
- dset_data(i,j) = (i-1)*6 + j;
- end do
- end do
-
-
- !
- ! 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 null dataspace.
- !
- CALL h5screate_f(H5S_NULL_F, null_dspace, error)
- CALL check("h5screate_simple_f", error, total_error)
-
-
- !
- ! Create the dataset with default properties.
- !
- CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dspace_id, &
- dset_id, error)
- CALL check("h5dcreate_f", error, total_error)
- !
- ! Create the null dataset.
- !
- CALL h5dcreate_f(file_id, null_dsetname, H5T_NATIVE_INTEGER, null_dspace, &
- null_dset, error)
- CALL check("h5dcreate_f", error, total_error)
-
- !
- ! Write the dataset.
- !
- data_dims(1) = 4
- data_dims(2) = 6
- CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error)
- CALL check("h5dwrite_f", error, total_error)
- !
- ! Write null dataset. Nothing can be written.
- !
- null_data_dim(1) = 1
- CALL h5dwrite_f(null_dset, H5T_NATIVE_INTEGER, null_dset_data, null_data_dim, error)
- 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)
- CALL h5dclose_f(null_dset, 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)
- CALL h5sclose_f(null_dspace, error)
- CALL check("h5sclose_f", error, total_error)
-
- !
- ! Close the file.
- !
- CALL h5fclose_f(file_id, error)
- CALL check("h5fclose_f", error, total_error)
-
- !
- ! Open the existing file.
- !
- CALL h5fopen_f (fix_filename, H5F_ACC_RDWR_F, file_id, error)
- CALL check("h5fopen_f", error, total_error)
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
- !
- ! Open the existing dataset.
- !
- CALL h5dopen_f(file_id, dsetname, dset_id, error)
- CALL check("h5dopen_f", error, total_error)
- CALL h5dopen_f(file_id, null_dsetname, null_dset, error)
- CALL check("h5dopen_f", error, total_error)
-
- ! Test whether space has been allocated for a dataset
- CALL h5dget_space_status_f(dset_id, flag, error)
- CALL check("h5dget_space_status_f",error, total_error)
- CALL verify("h5dget_space_status_f", flag, H5D_SPACE_STS_ALLOCATED_F, total_error)
-
- CALL h5dget_space_status_f(null_dset, flag, error)
- CALL check("h5dget_space_status_f",error, total_error)
- CALL verify("h5dget_space_status_f", flag, H5D_SPACE_STS_NOT_ALLOCATED_F, total_error)
-
-
- !
- ! Get the dataset type.
- !
- CALL h5dget_type_f(dset_id, dtype_id, error)
- CALL check("h5dget_type_f", error, total_error)
-
- !
- ! Get the data space.
- !
- CALL h5dget_space_f(dset_id, dspace_id, error)
- CALL check("h5dget_space_f", error, total_error)
-
- !
- ! Read the dataset.
- !
- CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error)
- CALL check("h5dread_f", error, total_error)
- !
- ! Read the null dataset. Nothing should be read.
- !
- CALL h5dread_f(null_dset, H5T_NATIVE_INTEGER, null_dset_data, null_data_dim, error)
- CALL check("h5dread_f", error, total_error)
-
- !
- !Compare the data.
- !
- do i = 1, 4
- do j = 1, 6
- IF (data_out(i,j) .NE. dset_data(i, j)) THEN
- write(*, *) "dataset test error occured"
- write(*,*) "data read is not the same as the data written"
- END IF
- end do
- end do
-
- !
- ! Check if no change to null_dset_data
- !
- IF (null_dset_data .NE. 1) THEN
- write(*, *) "null dataset test error occured"
+CONTAINS
+ SUBROUTINE datasettest(cleanup, total_error)
+
+ IMPLICIT NONE
+ LOGICAL, INTENT(IN) :: cleanup
+ INTEGER, INTENT(OUT) :: total_error
+
+ CHARACTER(LEN=5), PARAMETER :: filename = "dsetf" ! File name
+ CHARACTER(LEN=80) :: fix_filename
+ CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name
+ CHARACTER(LEN=9), PARAMETER :: null_dsetname = "null_dset" ! Dataset name
+
+ INTEGER(HID_T) :: file_id ! File identifier
+ INTEGER(HID_T) :: dset_id ! Dataset identifier
+ INTEGER(HID_T) :: null_dset ! Null dataset identifier
+ INTEGER(HID_T) :: dspace_id ! Dataspace identifier
+ INTEGER(HID_T) :: null_dspace ! Null dataspace identifier
+ INTEGER(HID_T) :: dtype_id ! Datatype identifier
+
+ INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions
+ INTEGER :: rank = 2 ! Dataset rank
+
+ INTEGER, DIMENSION(4,6) :: dset_data, data_out ! Data buffers
+ INTEGER :: error ! Error flag
+
+ INTEGER :: i, j !general purpose integers
+ INTEGER(HSIZE_T), DIMENSION(2) :: data_dims
+ INTEGER(HSIZE_T), DIMENSION(1) :: null_data_dim
+ INTEGER :: null_dset_data = 1 ! null data
+ INTEGER :: flag ! Space allocation status
+
+ !
+ ! Initialize the dset_data array.
+ !
+ DO i = 1, 4
+ DO j = 1, 6
+ dset_data(i,j) = (i-1)*6 + j;
+ END DO
+ END DO
+ !
+ ! 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 null dataspace.
+ !
+ CALL h5screate_f(H5S_NULL_F, null_dspace, error)
+ CALL check("h5screate_simple_f", error, total_error)
+ !
+ ! Create the dataset with default properties.
+ !
+ CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dspace_id, &
+ dset_id, error)
+ CALL check("h5dcreate_f", error, total_error)
+ !
+ ! Create the null dataset.
+ !
+ CALL h5dcreate_f(file_id, null_dsetname, H5T_NATIVE_INTEGER, null_dspace, null_dset, error)
+ CALL check("h5dcreate_f", error, total_error)
+ !
+ ! Write the dataset.
+ !
+ data_dims(1) = 4
+ data_dims(2) = 6
+ CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error)
+ CALL check("h5dwrite_f", error, total_error)
+ !
+ ! Write null dataset. Nothing can be written.
+ !
+ null_data_dim(1) = 1
+ CALL h5dwrite_f(null_dset, H5T_NATIVE_INTEGER, null_dset_data, null_data_dim, error)
+ 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)
+ CALL h5dclose_f(null_dset, 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)
+ CALL h5sclose_f(null_dspace, error)
+ CALL check("h5sclose_f", error, total_error)
+ !
+ ! Close the file.
+ !
+ CALL h5fclose_f(file_id, error)
+ CALL check("h5fclose_f", error, total_error)
+ !
+ ! Open the existing file.
+ !
+ CALL h5fopen_f (fix_filename, H5F_ACC_RDWR_F, file_id, error)
+ CALL check("h5fopen_f", error, total_error)
+ !
+ ! Open the existing dataset.
+ !
+ CALL h5dopen_f(file_id, dsetname, dset_id, error)
+ CALL check("h5dopen_f", error, total_error)
+ CALL h5dopen_f(file_id, null_dsetname, null_dset, error)
+ CALL check("h5dopen_f", error, total_error)
+
+ ! Test whether space has been allocated for a dataset
+ CALL h5dget_space_status_f(dset_id, flag, error)
+ CALL check("h5dget_space_status_f",error, total_error)
+ CALL VERIFY("h5dget_space_status_f", flag, H5D_SPACE_STS_ALLOCATED_F, total_error)
+
+ CALL h5dget_space_status_f(null_dset, flag, error)
+ CALL check("h5dget_space_status_f",error, total_error)
+ CALL VERIFY("h5dget_space_status_f", flag, H5D_SPACE_STS_NOT_ALLOCATED_F, total_error)
+ !
+ ! Get the dataset type.
+ !
+ CALL h5dget_type_f(dset_id, dtype_id, error)
+ CALL check("h5dget_type_f", error, total_error)
+ !
+ ! Get the data space.
+ !
+ CALL h5dget_space_f(dset_id, dspace_id, error)
+ CALL check("h5dget_space_f", error, total_error)
+ !
+ ! Read the dataset.
+ !
+ CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error)
+ CALL check("h5dread_f", error, total_error)
+ !
+ ! Read the null dataset. Nothing should be read.
+ !
+ CALL h5dread_f(null_dset, H5T_NATIVE_INTEGER, null_dset_data, null_data_dim, error)
+ CALL check("h5dread_f", error, total_error)
+ !
+ !Compare the data.
+ !
+ DO i = 1, 4
+ DO j = 1, 6
+ IF (data_out(i,j) .NE. dset_data(i, j)) THEN
+ WRITE(*, *) "dataset test error occured"
+ WRITE(*,*) "data read is not the same as the data written"
END IF
-
- !
- ! End access to the dataset and release resources used by it.
- !
- CALL h5dclose_f(dset_id, error)
- CALL check("h5dclose_f", error, total_error)
- CALL h5dclose_f(null_dset, 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 data type.
- !
- CALL h5tclose_f(dtype_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)
- if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
- CALL check("h5_cleanup_f", error, total_error)
-
- RETURN
- END SUBROUTINE datasettest
-
+ END DO
+ END DO
+ !
+ ! Check if no change to null_dset_data
+ !
+ IF (null_dset_data .NE. 1) THEN
+ WRITE(*, *) "null dataset test error occured"
+ END IF
+ !
+ ! End access to the dataset and release resources used by it.
+ !
+ CALL h5dclose_f(dset_id, error)
+ CALL check("h5dclose_f", error, total_error)
+ CALL h5dclose_f(null_dset, 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 data type.
+ !
+ CALL h5tclose_f(dtype_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)
+ IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
+ CALL check("h5_cleanup_f", error, total_error)
+
+ RETURN
+ END SUBROUTINE datasettest
+
!
!the following subroutine tests h5dextend_f functionality
!
- SUBROUTINE extenddsettest(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
- IMPLICIT NONE
-
- LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
-
- !
- !the dataset is stored in file "extf.h5"
- !
- CHARACTER(LEN=4), PARAMETER :: filename = "extf"
- CHARACTER(LEN=80) :: fix_filename
-
- !
- !dataset name is "ExtendibleArray"
- !
- CHARACTER(LEN=15), PARAMETER :: dsetname = "ExtendibleArray"
-
- !
- !dataset rank is 2
- !
- INTEGER :: RANK = 2
-
- INTEGER(HID_T) :: file_id ! File identifier
- INTEGER(HID_T) :: dset_id ! Dataset identifier
- INTEGER(HID_T) :: dataspace ! Dataspace identifier
- INTEGER(HID_T) :: memspace ! memory Dataspace identifier
- INTEGER(HID_T) :: crp_list ! dataset creatation property identifier
-
- !
- !dataset dimensions at creation time
- !
- INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/3,3/)
-
- !
- !data dimensions
- !
- INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/10,3/)
-
- !
- !Maximum dimensions
- !
- INTEGER(HSIZE_T), DIMENSION(2) :: maxdims
-
- !
- !data arrays for reading and writing
- !
- INTEGER, DIMENSION(10,3) :: data_in, data_out
-
- !
- !Size of data in the file
- !
- INTEGER(HSIZE_T), DIMENSION(2) :: size
-
- !
- !general purpose integer
- !
- INTEGER :: i, j
- INTEGER(HSIZE_T) :: ih, jh
-
- !
- !flag to check operation success
- !
- INTEGER :: error
-
- !
- !Variables used in reading data back
- !
- INTEGER(HSIZE_T), DIMENSION(2) :: dimsr, maxdimsr
- INTEGER :: rankr
- INTEGER(HSIZE_T), DIMENSION(2) :: data_dims
-
- !
- !data initialization
- !
- do i = 1, 10
- do j = 1, 3
- data_in(i,j) = 2
- end do
- end do
-
- !
- !Initialize FORTRAN predifined datatypes
- !
+ SUBROUTINE extenddsettest(cleanup, total_error)
+
+ IMPLICIT NONE
+
+ LOGICAL, INTENT(IN) :: cleanup
+ INTEGER, INTENT(OUT) :: total_error
+
+ !
+ !the dataset is stored in file "extf.h5"
+ !
+ CHARACTER(LEN=4), PARAMETER :: filename = "extf"
+ CHARACTER(LEN=80) :: fix_filename
+
+ !
+ !dataset name is "ExtendibleArray"
+ !
+ CHARACTER(LEN=15), PARAMETER :: dsetname = "ExtendibleArray"
+
+ !
+ !dataset rank is 2
+ !
+ INTEGER :: RANK = 2
+
+ INTEGER(HID_T) :: file_id ! File identifier
+ INTEGER(HID_T) :: dset_id ! Dataset identifier
+ INTEGER(HID_T) :: dataspace ! Dataspace identifier
+ INTEGER(HID_T) :: memspace ! memory Dataspace identifier
+ INTEGER(HID_T) :: crp_list ! dataset creatation property identifier
+
+ !
+ !dataset dimensions at creation time
+ !
+ INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/3,3/)
+
+ !
+ !data dimensions
+ !
+ INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/10,3/)
+
+ !
+ !Maximum dimensions
+ !
+ INTEGER(HSIZE_T), DIMENSION(2) :: maxdims
+
+ !
+ !data arrays for reading and writing
+ !
+ INTEGER, DIMENSION(10,3) :: data_in, data_out
+
+ !
+ !Size of data in the file
+ !
+ INTEGER(HSIZE_T), DIMENSION(2) :: size
+
+ !
+ !general purpose integer
+ !
+ INTEGER :: i, j
+ INTEGER(HSIZE_T) :: ih, jh
+
+ !
+ !flag to check operation success
+ !
+ INTEGER :: error
+
+ !
+ !Variables used in reading data back
+ !
+ INTEGER(HSIZE_T), DIMENSION(2) :: dimsr, maxdimsr
+ INTEGER :: rankr
+ INTEGER(HSIZE_T), DIMENSION(2) :: data_dims
+
+ !
+ !data initialization
+ !
+ DO i = 1, 10
+ DO j = 1, 3
+ data_in(i,j) = 2
+ END DO
+ END DO
+
+ !
+ !Initialize FORTRAN predifined datatypes
+ !
! CALL h5init_types_f(error)
! CALL check("h5init_types_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 data space with unlimited dimensions.
- !
- maxdims = (/H5S_UNLIMITED_F, H5S_UNLIMITED_F/)
-
- CALL h5screate_simple_f(RANK, dims, dataspace, error, maxdims)
- CALL check("h5screate_simple_f",error,total_error)
-
- !
- !Modify dataset creation properties, i.e. enable chunking
- !
- CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error)
- CALL check("h5pcreat_f",error,total_error)
-
- CALL h5pset_chunk_f(crp_list, RANK, dims1, error)
- CALL check("h5pset_chunk_f",error,total_error)
-
- !
- !Create a dataset with 3X3 dimensions using cparms creation propertie .
- !
- CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, &
- dset_id, error, crp_list )
- CALL check("h5dcreate_f",error,total_error)
-
- !
- !Extend the dataset. This call assures that dataset is 3 x 3.
- !
- size(1) = 3
- size(2) = 3
- CALL h5dextend_f(dset_id, size, error)
- CALL check("h5dextend_f",error,total_error)
-
-
- !
- !Extend the dataset. Dataset becomes 10 x 3.
- !
- size(1) = 10;
- size(2) = 3;
- CALL h5dextend_f(dset_id, size, error)
- CALL check("h5dextend_f",error,total_error)
-
- !
- !Write the data of size 10X3 to the extended dataset.
- !
- data_dims(1) = 10
- data_dims(2) = 3
- CALL H5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error)
- CALL check("h5dwrite_f",error,total_error)
-
- !
- !Close the dataspace for the dataset.
- !
- CALL h5sclose_f(dataspace, error)
- CALL check("h5sclose_f",error,total_error)
-
- !
- !Close the property list.
- !
- CALL h5pclose_f(crp_list, error)
- CALL check("h5pclose_f",error,total_error)
- !
- !Close the dataset.
- !
- CALL h5dclose_f(dset_id, error)
- CALL check("h5dclose_f",error,total_error)
-
- !
- !Close the file.
- !
- CALL h5fclose_f(file_id, error)
- CALL check("h5fclose_f",error,total_error)
-
- !
- !read the data back
- !
- !Open the file.
- !
- CALL h5fopen_f (fix_filename, H5F_ACC_RDONLY_F, file_id, error)
- CALL check("hfopen_f",error,total_error)
-
- !
- !Open the dataset.
- !
- CALL h5dopen_f(file_id, dsetname, dset_id, error)
- CALL check("h5dopen_f",error,total_error)
-
- !
- !Get dataset's dataspace handle.
- !
- CALL h5dget_space_f(dset_id, dataspace, error)
- CALL check("h5dget_space_f",error,total_error)
-
- !
- !Get dataspace's rank.
- !
- CALL h5sget_simple_extent_ndims_f(dataspace, rankr, error)
- CALL check("h5sget_simple_extent_ndims_f",error,total_error)
- IF (rankr .NE. RANK) then
- write(*,*) "dataset rank error occured"
- stop
- END IF
-
- !
- !Get dataspace's dimensinons.
- !
- CALL h5sget_simple_extent_dims_f(dataspace, dimsr, maxdimsr, error)
- CALL check("h5sget_simple_extent_dims_f",error,total_error)
- IF ((dimsr(1) .NE. dims1(1)) .OR. (dimsr(2) .NE. dims1(2))) THEN
- write(*,*) "dataset dimensions error occured"
- stop
+ !
+ !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 data space with unlimited dimensions.
+ !
+ maxdims = (/H5S_UNLIMITED_F, H5S_UNLIMITED_F/)
+
+ CALL h5screate_simple_f(RANK, dims, dataspace, error, maxdims)
+ CALL check("h5screate_simple_f",error,total_error)
+
+ !
+ !Modify dataset creation properties, i.e. enable chunking
+ !
+ CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error)
+ CALL check("h5pcreat_f",error,total_error)
+
+ CALL h5pset_chunk_f(crp_list, RANK, dims1, error)
+ CALL check("h5pset_chunk_f",error,total_error)
+
+ !
+ !Create a dataset with 3X3 dimensions using cparms creation propertie .
+ !
+ CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, dset_id, error, crp_list )
+ CALL check("h5dcreate_f",error,total_error)
+
+ !
+ !Extend the dataset. This call assures that dataset is 3 x 3.
+ !
+ SIZE(1) = 3
+ SIZE(2) = 3
+ CALL h5dextend_f(dset_id, size, error)
+ CALL check("h5dextend_f",error,total_error)
+
+
+ !
+ !Extend the dataset. Dataset becomes 10 x 3.
+ !
+ SIZE(1) = 10;
+ SIZE(2) = 3;
+ CALL h5dextend_f(dset_id, size, error)
+ CALL check("h5dextend_f",error,total_error)
+
+ !
+ !Write the data of size 10X3 to the extended dataset.
+ !
+ data_dims(1) = 10
+ data_dims(2) = 3
+ CALL H5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error)
+ CALL check("h5dwrite_f",error,total_error)
+
+ !
+ !Close the dataspace for the dataset.
+ !
+ CALL h5sclose_f(dataspace, error)
+ CALL check("h5sclose_f",error,total_error)
+
+ !
+ !Close the property list.
+ !
+ CALL h5pclose_f(crp_list, error)
+ CALL check("h5pclose_f",error,total_error)
+ !
+ !Close the dataset.
+ !
+ CALL h5dclose_f(dset_id, error)
+ CALL check("h5dclose_f",error,total_error)
+
+ !
+ !Close the file.
+ !
+ CALL h5fclose_f(file_id, error)
+ CALL check("h5fclose_f",error,total_error)
+
+ !
+ !read the data back
+ !
+ !Open the file.
+ !
+ CALL h5fopen_f (fix_filename, H5F_ACC_RDONLY_F, file_id, error)
+ CALL check("hfopen_f",error,total_error)
+
+ !
+ !Open the dataset.
+ !
+ CALL h5dopen_f(file_id, dsetname, dset_id, error)
+ CALL check("h5dopen_f",error,total_error)
+
+ !
+ !Get dataset's dataspace handle.
+ !
+ CALL h5dget_space_f(dset_id, dataspace, error)
+ CALL check("h5dget_space_f",error,total_error)
+
+ !
+ !Get dataspace's rank.
+ !
+ CALL h5sget_simple_extent_ndims_f(dataspace, rankr, error)
+ CALL check("h5sget_simple_extent_ndims_f",error,total_error)
+ IF (rankr .NE. RANK) THEN
+ WRITE(*,*) "dataset rank error occured"
+ STOP
+ END IF
+
+ !
+ !Get dataspace's dimensinons.
+ !
+ CALL h5sget_simple_extent_dims_f(dataspace, dimsr, maxdimsr, error)
+ CALL check("h5sget_simple_extent_dims_f",error,total_error)
+ IF ((dimsr(1) .NE. dims1(1)) .OR. (dimsr(2) .NE. dims1(2))) THEN
+ WRITE(*,*) "dataset dimensions error occured"
+ STOP
+ END IF
+
+ !
+ !Get creation property list.
+ !
+ CALL h5dget_create_plist_f(dset_id, crp_list, error)
+ CALL check("h5dget_create_plist_f",error,total_error)
+
+
+ !
+ !create memory dataspace.
+ !
+ CALL h5screate_simple_f(rankr, dimsr, memspace, error)
+ CALL check("h5screate_simple_f",error,total_error)
+
+ !
+ !Read data
+ !
+ CALL H5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, memspace, dataspace)
+ CALL check("h5dread_f",error,total_error)
+
+
+ !
+ !Compare the data.
+ !
+ DO ih = 1, dims1(1)
+ DO jh = 1, dims1(2)
+ IF (data_out(ih,jh) .NE. data_in(ih, jh)) THEN
+ WRITE(*, *) "extend dataset test error occured"
+ WRITE(*, *) "read value is not the same as the written values"
END IF
-
- !
- !Get creation property list.
- !
- CALL h5dget_create_plist_f(dset_id, crp_list, error)
- CALL check("h5dget_create_plist_f",error,total_error)
-
-
- !
- !create memory dataspace.
- !
- CALL h5screate_simple_f(rankr, dimsr, memspace, error)
- CALL check("h5screate_simple_f",error,total_error)
-
- !
- !Read data
- !
- CALL H5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, &
- memspace, dataspace)
- CALL check("h5dread_f",error,total_error)
-
-
- !
- !Compare the data.
- !
- do ih = 1, dims1(1)
- do jh = 1, dims1(2)
- IF (data_out(ih,jh) .NE. data_in(ih, jh)) THEN
- write(*, *) "extend dataset test error occured"
- write(*, *) "read value is not the same as the written values"
- END IF
- end do
- end do
-
- !
- !Close the dataspace for the dataset.
- !
- CALL h5sclose_f(dataspace, error)
- CALL check("h5sclose_f",error,total_error)
-
- !
- !Close the memspace for the dataset.
- !
- CALL h5sclose_f(memspace, error)
- CALL check("h5sclose_f",error,total_error)
-
- !
- !Close the property list.
- !
- CALL h5pclose_f(crp_list, error)
- CALL check("h5pclose_f",error,total_error)
-
- !
- !Close the dataset.
- !
- CALL h5dclose_f(dset_id, error)
- CALL check("h5dclose_f",error,total_error)
-
- !
- !Close the file.
- !
- 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 extenddsettest
+ END DO
+ END DO
+
+ !
+ !Close the dataspace for the dataset.
+ !
+ CALL h5sclose_f(dataspace, error)
+ CALL check("h5sclose_f",error,total_error)
+
+ !
+ !Close the memspace for the dataset.
+ !
+ CALL h5sclose_f(memspace, error)
+ CALL check("h5sclose_f",error,total_error)
+
+ !
+ !Close the property list.
+ !
+ CALL h5pclose_f(crp_list, error)
+ CALL check("h5pclose_f",error,total_error)
+
+ !
+ !Close the dataset.
+ !
+ CALL h5dclose_f(dset_id, error)
+ CALL check("h5dclose_f",error,total_error)
+
+ !
+ !Close the file.
+ !
+ 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 extenddsettest
END MODULE TH5D
diff --git a/fortran/test/tH5E_F03.f90 b/fortran/test/tH5E_F03.f90
index a7d45f2..63e70a3 100644
--- a/fortran/test/tH5E_F03.f90
+++ b/fortran/test/tH5E_F03.f90
@@ -36,6 +36,9 @@
! *****************************************
MODULE test_my_hdf5_error_handler
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
CONTAINS
@@ -49,8 +52,6 @@ CONTAINS
! This error function handle works with only version 2 error stack
- USE HDF5
- USE ISO_C_BINDING
IMPLICIT NONE
! estack_id is always passed from C as: H5E_DEFAULT
@@ -74,8 +75,6 @@ CONTAINS
! This error function handle works with only version 2 error stack
- USE HDF5
- USE ISO_C_BINDING
IMPLICIT NONE
! estack_id is always passed from C as: H5E_DEFAULT
@@ -102,8 +101,6 @@ CONTAINS
SUBROUTINE test_error(total_error)
- USE HDF5
- USE TH5_MISC
USE ISO_C_BINDING
USE test_my_hdf5_error_handler
@@ -147,15 +144,15 @@ SUBROUTINE test_error(total_error)
! Create the erring dataset
CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error)
- CALL VERIFY("h5dcreate_f", error, -1, total_error)
+ CALL verify("h5dcreate_f", error, -1, total_error)
-!!$ CALL VERIFY("H5Eset_auto_f",my_hdf5_error_handler_data(1),10, total_error)
-!!$ CALL VERIFY("H5Eset_auto_f",my_hdf5_error_handler_data(2),20, total_error)
+!!$ CALL verify("H5Eset_auto_f",my_hdf5_error_handler_data(1),10, total_error)
+!!$ CALL verify("H5Eset_auto_f",my_hdf5_error_handler_data(2),20, total_error)
!!$ ! Test enabling and disabling default printing
!!$
!!$ CALL H5Eget_auto_f(H5E_DEFAULT_F, func1, f_ptr1, error)
-!!$ CALL VERIFY("H5Eget_auto_f", error, 0, total_error)
+!!$ CALL verify("H5Eget_auto_f", error, 0, total_error)
! PRINT*,c_associated(f_ptr1)
@@ -187,7 +184,7 @@ SUBROUTINE test_error(total_error)
CALL H5Eset_auto_f(1, error, H5E_DEFAULT_F, func, f_ptr)
CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error)
- CALL VERIFY("h5dcreate_f", error, -1, total_error)
+ CALL verify("h5dcreate_f", error, -1, total_error)
! turn on automatic printing with h5eprint_f which prints an error stack in the default manner.
diff --git a/fortran/test/tH5F_F03.f90 b/fortran/test/tH5F_F03.f90
index c878a59..9e23d19 100644
--- a/fortran/test/tH5F_F03.f90
+++ b/fortran/test/tH5F_F03.f90
@@ -38,16 +38,17 @@
MODULE TH5F_F03
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+ USE ISO_C_BINDING
+
CONTAINS
SUBROUTINE test_get_file_image(total_error)
!
! Tests the wrapper for h5fget_file_image
!
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error ! returns error
@@ -128,8 +129,8 @@ SUBROUTINE test_get_file_image(total_error)
itmp_a = 1
CALL h5fget_file_image_f(file_id, f_ptr, itmp_a, error, image_size)
CALL check("h5fget_file_image_f",error, total_error)
- CALL VERIFY("h5fget_file_image_f", INT(itmp_a), 1, total_error) ! Routine should not change the value
- CALL VERIFY("h5fget_file_image_f", file_sz, INT(image_size), total_error)
+ CALL verify("h5fget_file_image_f", INT(itmp_a), 1, total_error) ! Routine should not change the value
+ CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error)
! Allocate a buffer of the appropriate size
ALLOCATE(image_ptr(1:image_size))
diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90
index ab75163..ddc3736 100644
--- a/fortran/test/tH5G_1_8.f90
+++ b/fortran/test/tH5G_1_8.f90
@@ -31,11 +31,13 @@
MODULE TH5G_1_8
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE group_test(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -139,9 +141,6 @@ END SUBROUTINE group_test
SUBROUTINE group_info(cleanup, fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -269,7 +268,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! Check for out of bound query by index on empty group, should fail
CALL H5Gget_info_by_idx_f(group_id, ".", H5_INDEX_NAME_F, order, INT(0,HSIZE_T), &
storage_type, nlinks, max_corder, error)
- CALL VERIFY("H5Gget_info_by_idx_f", error, -1, total_error)
+ CALL verify("H5Gget_info_by_idx_f", error, -1, total_error)
! Create several links, up to limit of compact form
DO u = 0, max_compact-1
@@ -287,29 +286,29 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Gget_info_f", error, total_error)
! Check (new/empty) group's information
- CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_f", max_corder, 0, total_error)
- CALL VERIFY("H5Gget_info_f", nlinks, 0, total_error)
- CALL verifyLogical("H5Gget_info_f.mounted", mounted,.FALSE.,total_error)
+ CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_f", max_corder, 0, total_error)
+ CALL verify("H5Gget_info_f", nlinks, 0, total_error)
+ CALL verify("H5Gget_info_f.mounted", mounted,.FALSE.,total_error)
! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error, mounted=mounted)
CALL check("H5Gget_info_by_name_f", error, total_error)
! Check (new/empty) group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", max_corder, 0, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, 0, total_error)
- CALL verifyLogical("H5Gget_info_by_name_f.mounted", mounted,.FALSE.,total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f", max_corder, 0, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, 0, total_error)
+ CALL verify("H5Gget_info_by_name_f.mounted", mounted,.FALSE.,total_error)
! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name", error, total_error)
! Check (new/empty) group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", max_corder, 0, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, 0, total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f", max_corder, 0, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, 0, total_error)
! Create objects in new group created
DO v = 0, u
@@ -331,27 +330,27 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Gget_info_f", error, total_error)
! Check (new) group's information
- CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_f", nlinks, u+1, total_error)
! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name_f", error, total_error)
! Check (new) group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f",max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f",max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error)
! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name_f", error, total_error)
! Check (new) group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error)
! Retrieve group's information
IF(order.NE.H5_ITER_NATIVE_F)THEN
@@ -359,17 +358,17 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(u,HSIZE_T), &
storage_type, nlinks, max_corder, error,lapl_id=H5P_DEFAULT_F, mounted=mounted)
CALL check("H5Gget_info_by_idx_f", error, total_error)
- CALL verifyLogical("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error)
+ CALL verify("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error)
ELSE
CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(0,HSIZE_T), &
storage_type, nlinks, max_corder, error, mounted=mounted)
- CALL verifyLogical("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error)
+ CALL verify("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error)
CALL check("H5Gget_info_by_idx_f", error, total_error)
ENDIF
! Check (new) group's information
- CALL VERIFY("H5Gget_info_by_idx_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_idx_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_by_idx_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_by_idx_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_idx_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_by_idx_f", nlinks, u+1, total_error)
ENDIF
! Close group created
CALL H5Gclose_f(group_id2, error)
@@ -380,27 +379,27 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Gget_info_f", error, total_error)
! Check main group's information
- CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_f", nlinks, u+1, total_error)
! Retrieve main group's information, by name
CALL H5Gget_info_by_name_f(file_id, CORDER_GROUP_NAME, storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name_f", error, total_error)
! Check main group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error)
! Retrieve main group's information, by name
CALL H5Gget_info_by_name_f(group_id, ".", storage_type, nlinks, max_corder, error, H5P_DEFAULT_F)
CALL check("H5Gget_info_by_name_f", error, total_error)
! Check main group's information
- CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error)
! Create soft link in another group, to objects in main group
valname = CORDER_GROUP_NAME//objname
@@ -412,9 +411,9 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Gget_info_f", error, total_error)
! Check soft link group's information
- CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
- CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error)
- CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error)
+ CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
+ CALL verify("H5Gget_info_f", max_corder, u+1, total_error)
+ CALL verify("H5Gget_info_f", nlinks, u+1, total_error)
ENDDO
! Close the groups
@@ -456,9 +455,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
SUBROUTINE timestamps(cleanup, fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -491,7 +487,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
! Check default timestamp information
- CALL VerifyLogical("H5Pget_obj_track_times",track_times,.TRUE.,total_error)
+ CALL verify("H5Pget_obj_track_times",track_times,.TRUE.,total_error)
! Set a non-default object timestamp setting
CALL H5Pset_obj_track_times_f(gcpl_id, .FALSE., error)
@@ -502,7 +498,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
! Check default timestamp information
- CALL VerifyLogical("H5Pget_obj_track_times",track_times,.FALSE.,total_error)
+ CALL verify("H5Pget_obj_track_times",track_times,.FALSE.,total_error)
! Create file
!h5_fixname(FILENAME[0], fapl, filename, sizeof filename);
@@ -533,10 +529,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! Query & verify the object timestamp settings
CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
- CALL VerifyLogical("H5Pget_obj_track_times1",track_times,.FALSE.,total_error)
+ CALL verify("H5Pget_obj_track_times1",track_times,.FALSE.,total_error)
CALL H5Pget_obj_track_times_f(gcpl_id2, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
- CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error)
+ CALL verify("H5Pget_obj_track_times2",track_times,.TRUE.,total_error)
! Query the object information for each group
! if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR
@@ -593,10 +589,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
- CALL VerifyLogical("H5Pget_obj_track_times1",track_times,.FALSE.,total_error)
+ CALL verify("H5Pget_obj_track_times1",track_times,.FALSE.,total_error)
CALL H5Pget_obj_track_times_f(gcpl_id2, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
- CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error)
+ CALL verify("H5Pget_obj_track_times2",track_times,.TRUE.,total_error)
!!$
!!$ Query the object information for each group
!!$ if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR
@@ -653,9 +649,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
SUBROUTINE mklinks(fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -711,12 +704,12 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
error, H5P_DEFAULT_F)
CALL check("H5Lget_info_f",error,total_error)
-! CALL VerifyLogical("H5Lget_info_by_idx_f11", f_corder_valid, .TRUE., total_error)
+! CALL verify("H5Lget_info_by_idx_f11", f_corder_valid, .TRUE., total_error)
- CALL VERIFY("H5Lget_info_by_idx_f", H5L_TYPE_SOFT_F, link_type, total_error)
- CALL VERIFY("H5Lget_info_by_idx_f", cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("H5Lget_info_by_idx_f", H5L_TYPE_SOFT_F, link_type, total_error)
+ CALL verify("H5Lget_info_by_idx_f", cset, H5T_CSET_ASCII_F, total_error)
! should be '/d1' + NULL character = 4
- CALL VERIFY("H5Lget_info_by_idx_f", INT(val_size), 4, total_error)
+ CALL verify("H5Lget_info_by_idx_f", INT(val_size), 4, total_error)
! Create a symbolic link to something that doesn't exist
@@ -749,9 +742,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
SUBROUTINE test_move_preserves(fapl_id, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl_id
@@ -798,14 +788,14 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL H5Pget_link_creation_order_f(fcpl_id, crt_order_flags, error)
CALL check("H5Pget_link_creation_order_f",error, total_error)
- CALL VERIFY("H5Pget_link_creation_order_f",crt_order_flags,0, total_error)
+ CALL verify("H5Pget_link_creation_order_f",crt_order_flags,0, total_error)
CALL H5Pset_link_creation_order_f(fcpl_id, H5P_CRT_ORDER_TRACKED_F, error)
CALL check("H5Pset_link_creation_order_f", error, total_error)
CALL H5Pget_link_creation_order_f(fcpl_id, crt_order_flags, error)
CALL check("H5Pget_link_creation_order_f",error, total_error)
- CALL VERIFY("H5Pget_link_creation_order_f",crt_order_flags, H5P_CRT_ORDER_TRACKED_F, total_error)
+ CALL verify("H5Pget_link_creation_order_f",crt_order_flags, H5P_CRT_ORDER_TRACKED_F, total_error)
! Create file
! (with creation order tracking for the root group)
@@ -835,10 +825,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! if(H5Oget_info_by_name(file_id, "group", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR
old_cset = cset
- CALL VERIFY("H5Lget_info_f",old_cset,H5T_CSET_UTF8_F,total_error)
- CALL VerifyLogical("H5Lget_info_f",f_corder_valid,.TRUE.,total_error)
+ CALL verify("H5Lget_info_f",old_cset,H5T_CSET_UTF8_F,total_error)
+ CALL verify("H5Lget_info_f",f_corder_valid,.TRUE.,total_error)
old_corder = corder;
- CALL VERIFY("H5Lget_info_f",old_corder,0,total_error)
+ CALL verify("H5Lget_info_f",old_corder,0,total_error)
! old_modification_time = oinfo.mtime;
@@ -956,10 +946,6 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!
SUBROUTINE lifecycle(cleanup, fapl2, total_error)
-
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl2
@@ -1105,10 +1091,6 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
SUBROUTINE cklinks(fapl, total_error)
-! USE ISO_C_BINDING
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -1146,10 +1128,10 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
CALL H5Lexists_f(file,"d1",Lexists, error)
- CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error)
+ CALL verify("H5Lexists", Lexists,.TRUE.,total_error)
CALL H5Lexists_f(file,"grp1/hard",Lexists, error)
- CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error)
+ CALL verify("H5Lexists", Lexists,.TRUE.,total_error)
! Cleanup
CALL H5Fclose_f(file,error)
@@ -1176,9 +1158,6 @@ END SUBROUTINE cklinks
!
SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -1294,7 +1273,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
! Check for deletion on empty group
CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), error)
- CALL VERIFY("delete_by_idx.H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1)
+ CALL verify("delete_by_idx.H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1)
! Create several links, up to limit of compact form
DO u = 0, max_compact-1
! Make name for link
@@ -1319,7 +1298,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
htmp =9
!EP CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(u,HSIZE_T), error)
CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, htmp, error)
- CALL VERIFY("H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1)
+ CALL verify("H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1)
! Delete links from compact group
@@ -1340,21 +1319,21 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
CALL H5Iget_type_f(grp, id_type, error)
CALL check("H5Iget_type_f", error, total_error)
- CALL VERIFY("H5Iget_type_f", id_type, H5I_GROUP_F, total_error)
+ CALL verify("H5Iget_type_f", id_type, H5I_GROUP_F, total_error)
CALL H5Gclose_f(grp, error)
CALL check("H5Gclose_f", error, total_error)
- CALL VerifyLogical("H5Lget_info_by_idx_f", f_corder_valid, .TRUE., total_error)
+ CALL verify("H5Lget_info_by_idx_f", f_corder_valid, .TRUE., total_error)
- CALL VERIFY("H5Lget_info_by_idx_f", H5L_TYPE_HARD_F, link_type, total_error)
+ CALL verify("H5Lget_info_by_idx_f", H5L_TYPE_HARD_F, link_type, total_error)
IF(iorder.EQ.H5_ITER_INC_F)THEN
- CALL VERIFY("H5Lget_info_by_idx_f", corder, u+1, total_error)
+ CALL verify("H5Lget_info_by_idx_f", corder, u+1, total_error)
ELSE
- CALL VERIFY("H5Lget_info_by_idx_f", corder, (max_compact - (u + 2)), total_error)
+ CALL verify("H5Lget_info_by_idx_f", corder, (max_compact - (u + 2)), total_error)
ENDIF
- CALL VERIFY("H5Lget_info_by_idx_f",cset, H5T_CSET_ASCII_F, total_error)
+ CALL verify("H5Lget_info_by_idx_f",cset, H5T_CSET_ASCII_F, total_error)
@@ -1371,7 +1350,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
!!$ ENDIF
!!$ objname = 'fill '//chr2
!!$ PRINT*,objname, tmpname
-!!$ CALL verifyString("delete_by_idx.H5Lget_name_by_idx_f", objname, tmpname, total_error)
+!!$ CALL verify("delete_by_idx.H5Lget_name_by_idx_f", objname, tmpname, total_error)
ENDDO
! Close the group
@@ -1418,9 +1397,6 @@ END SUBROUTINE delete_by_idx
SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
hard_link, use_index, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: group_id
@@ -1455,14 +1431,14 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(0,HSIZE_T), &
link_type, f_corder_valid, corder, cset, address, val_size, error)
CALL check("H5Lget_info_by_idx_f", error, total_error)
- CALL VERIFY("H5Lget_info_by_idx_f", corder, 0, total_error)
+ CALL verify("H5Lget_info_by_idx_f", corder, 0, total_error)
! Verify the link information for new link, in increasing creation order
! HDmemset(&linfo, 0, sizeof(linfo));
CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), &
link_type, f_corder_valid, corder, cset, address, val_size, error)
CALL check("H5Lget_info_by_idx_f", error, total_error)
- CALL VERIFY("H5Lget_info_by_idx_f", corder, n, total_error)
+ CALL verify("H5Lget_info_by_idx_f", corder, n, total_error)
! Verify value for new soft link, in increasing creation order
!!$ IF(hard_link)THEN
@@ -1481,21 +1457,21 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), tmpname_small, error, size_tmp)
CALL check("link_info_by_idx_check.H5Lget_name_by_idx_f", error, total_error)
- CALL verifyString("link_info_by_idx_check.H5Lget_name_by_idx_f", &
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", &
linkname(1:LEN(tmpname_small)), tmpname_small(1:LEN(tmpname_small)), total_error)
- CALL VERIFY("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
! try it with the correct size
CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), tmpname, error, size=size_tmp)
CALL check("link_info_by_idx_check.H5Lget_name_by_idx_f", error, total_error)
- CALL verifyString("link_info_by_idx_check.H5Lget_name_by_idx_f", &
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", &
linkname(1:LEN(tmpname)), tmpname(1:LEN(tmpname)), total_error)
- CALL VERIFY("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), tmpname_big, error, size_tmp)
CALL check("link_info_by_idx_check.H5Lget_name_by_idx_f", error, total_error)
- CALL verifyString("link_info_by_idx_check.H5Lget_name_by_idx_f", &
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", &
linkname(1:7), tmpname_big(1:7), total_error)
- CALL VERIFY("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
+ CALL verify("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error)
! Try with a buffer set to small
@@ -1522,9 +1498,6 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
SUBROUTINE test_lcpl(cleanup, fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -1591,7 +1564,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
! * creation property list and is always ASCII.
!#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h --
- CALL VERIFY("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error)
+ CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error)
! Create and commit a datatype with the default LCPL
CALL h5tcopy_f(H5T_NATIVE_INTEGER, type_id, error)
@@ -1652,10 +1625,10 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
DO i = 1, 2
tmp1 = INT(dimsout(i))
tmp2 = INT(extend_dim(i))
- CALL VERIFY("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
+ CALL verify("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
tmp1 = INT(maxdimsout(i))
tmp2 = INT(dims(i))
- CALL VERIFY("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
+ CALL verify("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
ENDDO
! close data set
@@ -1722,7 +1695,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL H5Pget_char_encoding_f(lcpl_id, encoding, error)
CALL check("H5Pget_char_encoding_f", error, total_error)
- CALL VERIFY("H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error)
+ CALL verify("H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error)
! Check that its character encoding is UTF-8
CALL H5Lget_info_f(file_id, "dataset2", &
@@ -1744,7 +1717,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL H5Lexists_f(file_id,"/dataset2_link",Lexists, error)
CALL check("H5Lexists",error, total_error)
- CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error)
+ CALL verify("H5Lexists", Lexists,.TRUE.,total_error)
! Check that its character encoding is ASCII
CALL H5Lget_info_f(file_id, "/dataset2_link", &
@@ -1834,9 +1807,6 @@ END SUBROUTINE test_lcpl
SUBROUTINE objcopy(fapl, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -1867,7 +1837,7 @@ SUBROUTINE objcopy(fapl, total_error)
! Verify object copy flags
CALL H5Pget_copy_object_f(pid, cpy_flags, error)
CALL check("H5Pget_copy_object_f",error, total_error)
- CALL VERIFY("H5Pget_copy_object_f", cpy_flags, flag, total_error)
+ CALL verify("H5Pget_copy_object_f", cpy_flags, flag, total_error)
!!$
!!$ CALL test_copy_option(fcpl_src, fcpl_dst, my_fapl, H5O_COPY_WITHOUT_ATTR_FLAG,
@@ -1898,9 +1868,6 @@ END SUBROUTINE objcopy
SUBROUTINE lapl_nlinks( fapl, total_error)
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fapl
INTEGER, INTENT(INOUT) :: total_error
@@ -1972,7 +1939,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
nlinks = 0
CALL H5Pget_nlinks_f(plist, nlinks, error)
CALL check("H5Pset_nlinks_f",error,total_error)
- CALL VERIFY("H5Pset_nlinks_f",INT(nlinks), 20, total_error)
+ CALL verify("H5Pset_nlinks_f",INT(nlinks), 20, total_error)
! Open object through what is normally too many soft links using
@@ -1984,7 +1951,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
! Check name
CALL h5iget_name_f(gid, objname, buf_size, name_len, error)
CALL check("h5iget_name_f",error,total_error)
- CALL VerifyString("h5iget_name_f", TRIM(objname),"/soft17", total_error)
+ CALL verify("h5iget_name_f", TRIM(objname),"/soft17", total_error)
! Create group using soft link
CALL H5Gcreate_f(gid, "new_soft", gid2, error)
CALL check("H5Gcreate_f", error, total_error)
@@ -2006,12 +1973,12 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
CALL H5Pget_nlinks_f(plist, nlinks, error)
CALL check("H5Pget_nlinks_f",error,total_error)
- CALL VERIFY("H5Pget_nlinks_f", INT(nlinks), 4, total_error)
+ CALL verify("H5Pget_nlinks_f", INT(nlinks), 4, total_error)
! Try opening through what is now too many soft links
CALL H5Oopen_f(fid,"soft5",gid,error,plist)
- CALL VERIFY("H5Oopen_f", error, -1, total_error) ! should fail
+ CALL verify("H5Oopen_f", error, -1, total_error) ! should fail
! Open object through lesser soft link
CALL H5Oopen_f(fid,"soft4",gid,error,plist)
@@ -2020,7 +1987,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
! Check name
CALL h5iget_name_f(gid, objname, buf_size, name_len, error)
CALL check("h5iget_name_f",error,total_error)
- CALL VerifyString("h5iget_name_f", TRIM(objname),"/soft4", total_error)
+ CALL verify("h5iget_name_f", TRIM(objname),"/soft4", total_error)
! Test other functions that should use a LAPL
nlinks = 20
diff --git a/fortran/test/tH5I.f90 b/fortran/test/tH5I.f90
index 088b4eb..97c48c6 100644
--- a/fortran/test/tH5I.f90
+++ b/fortran/test/tH5I.f90
@@ -27,6 +27,10 @@
!
!*****
MODULE TH5I
+
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
CONTAINS
@@ -34,8 +38,6 @@ CONTAINS
! This subroutine tests following functionalities: h5iget_type_f
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -88,7 +90,7 @@ CONTAINS
dtype = -1
CALL H5Iis_valid_f(dtype, tri_ret, error)
CALL check("H5Iis_valid_f", error, total_error)
- CALL VerifyLogical("H5Iis_valid_f", tri_ret, .FALSE., total_error)
+ CALL verify("H5Iis_valid_f", tri_ret, .FALSE., total_error)
! Create a datatype id
CALL H5Tcopy_f(H5T_NATIVE_INTEGER,dtype,error)
@@ -97,7 +99,7 @@ CONTAINS
! Check that the ID is valid
CALL H5Iis_valid_f(dtype, tri_ret, error)
CALL check("H5Iis_valid_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", tri_ret, .TRUE., total_error)
+ CALL verify("H5Tequal_f", tri_ret, .TRUE., total_error)
CALL H5Tclose_f(dtype, error)
CALL check("H5Tclose_f", error, total_error)
diff --git a/fortran/test/tH5L_F03.f90 b/fortran/test/tH5L_F03.f90
index 795f1e2..40afdbc 100644
--- a/fortran/test/tH5L_F03.f90
+++ b/fortran/test/tH5L_F03.f90
@@ -32,8 +32,10 @@
!*****
MODULE liter_cb_mod
- USE HDF5
- USE ISO_C_BINDING
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+ USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
TYPE iter_enum
@@ -45,7 +47,7 @@ MODULE liter_cb_mod
! Custom group iteration callback data
TYPE, bind(c) :: iter_info
- CHARACTER(LEN=1), DIMENSION(1:10) :: name ! The name of the object
+ CHARACTER(KIND=C_CHAR), DIMENSION(1:10) :: name ! The name of the object
INTEGER(c_int) :: TYPE ! The TYPE of the object
INTEGER(c_int) :: command ! The TYPE of RETURN value
END TYPE iter_info
@@ -60,8 +62,6 @@ CONTAINS
INTEGER(KIND=C_INT) FUNCTION liter_cb(group, name, link_info, op_data) bind(C)
- USE HDF5
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER(HID_T), VALUE :: group
@@ -123,9 +123,6 @@ CONTAINS
!***************************************************************
SUBROUTINE test_iter_group(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
USE liter_cb_mod
IMPLICIT NONE
@@ -251,11 +248,11 @@ SUBROUTINE test_iter_group(total_error)
CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, error)
IF(error.LT.0) EXIT
! Verify return value from iterator gets propagated correctly
- CALL VERIFY("H5Literate", ret_value, 2, total_error)
+ CALL verify("H5Literate", ret_value, 2, total_error)
! Increment the number of times "2" is returned
i = i + 1
! Verify that the index is the correct value
- CALL VERIFY("H5Literate", INT(idx), INT(i), total_error)
+ CALL verify("H5Literate", INT(idx), INT(i), total_error)
IF(idx .GT.ndatasets+2)THEN
PRINT*,"ERROR: Group iteration function walked too far!"
ENDIF
@@ -264,14 +261,14 @@ SUBROUTINE test_iter_group(total_error)
DO j = 1, 10
ichr10(j:j) = info%name(j)(1:1)
ENDDO
- CALL verifystring("H5Literate_f", ichr10, lnames(INT(idx)), total_error)
+ CALL verify("H5Literate_f", ichr10, lnames(INT(idx)), total_error)
IF(i.EQ.52)EXIT ! prints out error message otherwise (for gcc/gfortran/g95) not intel (why) -FIXME- scot
END DO
! put check if did not walk far enough -scot FIXME
IF(i .NE. (NDATASETS + 2)) THEN
- CALL VERIFY("H5Literate_f", i, INT(NDATASETS + 2), total_error)
+ CALL verify("H5Literate_f", i, INT(NDATASETS + 2), total_error)
PRINT*,"ERROR: Group iteration function didn't perform multiple iterations correctly"
ENDIF
@@ -288,13 +285,13 @@ SUBROUTINE test_iter_group(total_error)
CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, error)
IF(error.LT.0) EXIT
- CALL VERIFY("H5Literate_f", ret_value, 1, total_error)
+ CALL verify("H5Literate_f", ret_value, 1, total_error)
! Increment the number of times "1" is returned
i = i + 1
! Verify that the index is the correct value
- CALL VERIFY("H5Literate_f", INT(idx), INT(i+10), total_error)
+ CALL verify("H5Literate_f", INT(idx), INT(i+10), total_error)
IF(idx .GT.ndatasets+2)THEN
PRINT*,"Group iteration function walked too far!"
@@ -304,7 +301,7 @@ SUBROUTINE test_iter_group(total_error)
ichr10(j:j) = info%name(j)(1:1)
ENDDO
! Verify that the correct name is retrieved
- CALL verifystring("H5Literate_f", ichr10, lnames(INT(idx)), total_error)
+ CALL verify("H5Literate_f", ichr10, lnames(INT(idx)), total_error)
IF(i.EQ.42)EXIT ! prints out error message otherwise (for gcc/gfortran/g95) not intel (why) -FIX- scot
ENDDO
diff --git a/fortran/test/tH5MISC_1_8.f90 b/fortran/test/tH5MISC_1_8.f90
index efaf594..ba3f095 100644
--- a/fortran/test/tH5MISC_1_8.f90
+++ b/fortran/test/tH5MISC_1_8.f90
@@ -25,11 +25,13 @@
!*****
MODULE TH5MISC_1_8
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE dtransform(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -57,22 +59,22 @@ SUBROUTINE dtransform(cleanup, total_error)
CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest, error, size=size)
CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
- CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f, ptrgetTest, total_error)
- CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", c_to_f, ptrgetTest, total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
! check case when receiving buffer to small
CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_small, error, size=size)
CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
- CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:7), ptrgetTest_small, total_error)
- CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", c_to_f(1:7), ptrgetTest_small, total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
! check case when receiving buffer to big
CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_big, error, size=size)
CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
- CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:15), ptrgetTest_big(1:15), total_error)
- CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size), 15, total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", c_to_f(1:15), ptrgetTest_big(1:15), total_error)
+ CALL verify("dtransform.H5Pget_data_transform_f", INT(size), 15, total_error)
CALL H5Fclose_f(file_id, error)
CALL check("H5Fclose_f", error, total_error)
@@ -92,9 +94,6 @@ END SUBROUTINE dtransform
SUBROUTINE test_genprop_basic_class(total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -117,7 +116,7 @@ SUBROUTINE test_genprop_basic_class(total_error)
cid1 = 456
CALL H5Pget_class_name_f(cid1, name, size, error)
- CALL VERIFY("H5Pget_class_name", error, -1, error)
+ CALL verify("H5Pget_class_name", error, -1, error)
! Create a new generic class, derived from the root of the class hierarchy
CALL H5Pcreate_class_f(H5P_ROOT_F, CLASS1_NAME, cid1, error)
@@ -126,8 +125,8 @@ SUBROUTINE test_genprop_basic_class(total_error)
! Check class name
CALL H5Pget_class_name_f(cid1, name, size, error)
CALL check("H5Pget_class_name", error, total_error)
- CALL VERIFY("H5Pget_class_name", size,7,error)
- CALL verifystring("H5Pget_class_name", name, CLASS1_NAME, error)
+ CALL verify("H5Pget_class_name", size,7,error)
+ CALL verify("H5Pget_class_name", name, CLASS1_NAME, error)
IF(error.NE.0)THEN
WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME
total_error = total_error + 1
@@ -136,8 +135,8 @@ SUBROUTINE test_genprop_basic_class(total_error)
! Check class name smaller buffer
CALL H5Pget_class_name_f(cid1, name_small, size, error)
CALL check("H5Pget_class_name", error, total_error)
- CALL VERIFY("H5Pget_class_name", size,7,error)
- CALL verifystring("H5Pget_class_name", name_small(1:4), CLASS1_NAME(1:4), error)
+ CALL verify("H5Pget_class_name", size,7,error)
+ CALL verify("H5Pget_class_name", name_small(1:4), CLASS1_NAME(1:4), error)
IF(error.NE.0)THEN
WRITE(*,*) 'Class names do not match! name=',name_small(1:4), 'CLASS1_NAME=',CLASS1_NAME(1:4)
total_error = total_error + 1
@@ -146,8 +145,8 @@ SUBROUTINE test_genprop_basic_class(total_error)
! Check class name bigger buffer
CALL H5Pget_class_name_f(cid1, name_big, size, error)
CALL check("H5Pget_class_name", error, total_error)
- CALL VERIFY("H5Pget_class_name", size,7,error)
- CALL verifystring("H5Pget_class_name", TRIM(name_big), TRIM(CLASS1_NAME), error)
+ CALL verify("H5Pget_class_name", size,7,error)
+ CALL verify("H5Pget_class_name", TRIM(name_big), TRIM(CLASS1_NAME), error)
IF(error.NE.0)THEN
WRITE(*,*) 'Class names do not match! name=',TRIM(name_small), 'CLASS1_NAME=',TRIM(CLASS1_NAME)
total_error = total_error + 1
@@ -160,13 +159,13 @@ SUBROUTINE test_genprop_basic_class(total_error)
! Verify class parent correct
CALL H5Pequal_f(cid2, H5P_ROOT_F, flag, error)
CALL check("H5Pequal_f", error, total_error)
- CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Pequal_f", flag, .TRUE., total_error)
! Make certain false postives aren't being returned
CALL H5Pequal_f(cid2, H5P_FILE_CREATE_F, flag, error)
CALL check("H5Pequal_f", error, total_error)
- CALL verifylogical("H5Pequal_f", flag, .FALSE., total_error)
+ CALL verify("H5Pequal_f", flag, .FALSE., total_error)
! Close parent class
CALL H5Pclose_class_f(cid2, error)
@@ -187,8 +186,6 @@ SUBROUTINE test_h5s_encode(total_error)
!**
!***************************************************************
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -241,7 +238,7 @@ SUBROUTINE test_h5s_encode(total_error)
! Try decoding bogus buffer
CALL H5Sdecode_f(sbuf, decoded_sid1, error)
- CALL VERIFY("H5Sdecode", error, -1, total_error)
+ CALL verify("H5Sdecode", error, -1, total_error)
CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
CALL check("H5Sencode", error, total_error)
@@ -254,7 +251,7 @@ SUBROUTINE test_h5s_encode(total_error)
! Verify the decoded dataspace
CALL h5sget_simple_extent_npoints_f(decoded_sid1, n, error)
CALL check("h5sget_simple_extent_npoints_f", error, total_error)
- CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), INT(SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3), &
+ CALL verify("h5sget_simple_extent_npoints_f", INT(n), INT(SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3), &
total_error)
!
@@ -297,16 +294,16 @@ SUBROUTINE test_h5s_encode(total_error)
CALL H5Sget_simple_extent_type_f(decoded_sid3, space_type, error)
CALL check("H5Sget_simple_extent_type_f", error, total_error)
- CALL VERIFY("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error)
+ CALL verify("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error)
! Verify decoded dataspace
CALL h5sget_simple_extent_npoints_f(decoded_sid3, n, error)
CALL check("h5sget_simple_extent_npoints_f", error, total_error)
- CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), 1, total_error)
+ CALL verify("h5sget_simple_extent_npoints_f", INT(n), 1, total_error)
CALL H5Sget_simple_extent_ndims_f(decoded_sid3, rank, error)
CALL CHECK("H5Sget_simple_extent_ndims_f", error, total_error)
- CALL VERIFY("H5Sget_simple_extent_ndims_f", rank, 0, total_error )
+ CALL verify("H5Sget_simple_extent_ndims_f", rank, 0, total_error )
CALL h5sclose_f(sid3, error)
CALL check("h5sclose_f", error, total_error)
@@ -335,8 +332,6 @@ END SUBROUTINE test_h5s_encode
SUBROUTINE test_scaleoffset(cleanup, total_error )
- USE HDF5
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90
index 99d4c22..51e1d64 100644
--- a/fortran/test/tH5O.f90
+++ b/fortran/test/tH5O.f90
@@ -28,11 +28,13 @@
!*****
MODULE TH5O
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE test_h5o(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -57,9 +59,6 @@ END SUBROUTINE test_h5o
SUBROUTINE test_h5o_link(total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -157,7 +156,7 @@ SUBROUTINE test_h5o_link(total_error)
CALL H5Tcommitted_f(type_id, committed, error)
CALL check("H5Tcommitted_f",error,total_error)
- CALL verifyLogical("H5Tcommitted_f", committed, .TRUE., total_error)
+ CALL verify("H5Tcommitted_f", committed, .TRUE., total_error)
! Create a dataset with no name using the committed datatype
CALL H5Dcreate_anon_f(file_id, type_id, space_id, dset_id, error ) ! using no optional parameters
@@ -181,7 +180,7 @@ SUBROUTINE test_h5o_link(total_error)
! Verify the data
DO i = 1, TEST6_DIM1
DO j = 1, TEST6_DIM2
- CALL VERIFY("H5Dread_f",wdata(i,j),rdata(i,j),total_error)
+ CALL verify("H5Dread_f",wdata(i,j),rdata(i,j),total_error)
wdata(i,j) = i*j
ENDDO
ENDDO
@@ -229,7 +228,7 @@ SUBROUTINE test_h5o_link(total_error)
! Verify the data
DO i = 1, TEST6_DIM1
DO j = 1, TEST6_DIM2
- CALL VERIFY("H5Dread",wdata(i,j),rdata(i,j),total_error)
+ CALL verify("H5Dread",wdata(i,j),rdata(i,j),total_error)
ENDDO
ENDDO
! Close open IDs
@@ -464,7 +463,7 @@ SUBROUTINE test_h5o_link(total_error)
nlinks = 0
CALL h5pget_nlinks_f(plist, nlinks, error)
CALL check("h5pget_nlinks_f",error,total_error)
- CALL VERIFY("h5pget_nlinks_f", INT(nlinks), 2, total_error)
+ CALL verify("h5pget_nlinks_f", INT(nlinks), 2, total_error)
! See if the link exists
CALL h5oexists_by_name_f(file_id,"/G1_LINK", link_exists, error, plist)
@@ -578,9 +577,6 @@ END SUBROUTINE test_h5o_link
SUBROUTINE test_h5o_plist(total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -631,18 +627,18 @@ SUBROUTINE test_h5o_plist(total_error)
! Retrieve attribute phase change values on each creation property list and verify
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(tcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
! Create a group, dataset, and committed datatype within the file,
! using the respective type of creation property lists.
@@ -700,18 +696,18 @@ SUBROUTINE test_h5o_plist(total_error)
! Retrieve attribute phase change values on each creation property list and verify
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(tcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
! Close current objects
CALL h5pclose_f(gcpl,error)
@@ -757,18 +753,18 @@ SUBROUTINE test_h5o_plist(total_error)
! Retrieve attribute phase change values on each creation property list and verify
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
CALL H5Pget_attr_phase_change_f(tcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
- CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
+ CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
! Close current objects
CALL h5pclose_f(gcpl,error)
diff --git a/fortran/test/tH5O_F03.f90 b/fortran/test/tH5O_F03.f90
index 8e014f4..834308b 100644
--- a/fortran/test/tH5O_F03.f90
+++ b/fortran/test/tH5O_F03.f90
@@ -31,7 +31,7 @@
MODULE visit_cb
USE HDF5
- USE ISO_C_BINDING
+ USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
@@ -53,7 +53,7 @@ MODULE visit_cb
!
! Object visit structs
TYPE, bind(c) :: obj_visit_t
- CHARACTER(LEN=1), DIMENSION(1:180) :: path ! Path to object
+ CHARACTER(KIND=C_CHAR), DIMENSION(1:180) :: path ! Path to object
INTEGER :: type_obj ! type of object
END TYPE obj_visit_t
diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90
index 7dcc580..39d8c1e 100644
--- a/fortran/test/tH5P.f90
+++ b/fortran/test/tH5P.f90
@@ -27,6 +27,9 @@
!
!*****
MODULE TH5P
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
CONTAINS
@@ -36,8 +39,6 @@ SUBROUTINE external_test(cleanup, total_error)
! h5pset_external_f, h5pget_external_count_f,
! h5pget_external_f
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -153,8 +154,6 @@ SUBROUTINE external_test(cleanup, total_error)
END SUBROUTINE external_test
SUBROUTINE multi_file_test(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -421,10 +420,7 @@ END SUBROUTINE multi_file_test
! April 16, 2009
!-------------------------------------------------------------------------
!
-SUBROUTINE test_chunk_cache(cleanup, total_error)
-
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
+SUBROUTINE test_chunk_cache(cleanup, total_error)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -470,19 +466,16 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_cache_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl1, nslots_4, nbytes_4, w0_4, 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.dreal_eq( REAL(w0_1,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ CALL verify("H5Pget_chunk_cache_f", nslots_1, nslots_4, total_error)
+ CALL verify("H5Pget_chunk_cache_f", nbytes_1, nbytes_4, total_error)
+ CALL verify("H5Pget_chunk_cache_f", w0_1, w0_4, total_error)
! Set a lapl property on dapl1 (to verify inheritance)
CALL H5Pset_nlinks_f(dapl1, 134_size_t , error)
CALL check("H5Pset_nlinks_f", error, total_error)
CALL H5Pget_nlinks_f(dapl1, nlinks, error)
CALL check("H5Pget_nlinks_f", error, total_error)
- CALL VERIFY("H5Pget_nlinks_f", INT(nlinks), 134, total_error)
+ CALL verify("H5Pget_nlinks_f", INT(nlinks), 134, total_error)
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_local, error)
@@ -529,11 +522,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Dget_access_plist_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, 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.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ 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 verify("H5Pget_chunk_cache_f", w0_2, w0_4, total_error)
CALL H5Pclose_f(dapl2,error)
CALL check("H5Pclose_f", error, total_error)
@@ -561,11 +552,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Dget_access_plist_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, 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.dreal_eq( REAL(w0_3,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f4", .TRUE., .FALSE., total_error)
- ENDIF
+ 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 verify("H5Pget_chunk_cache_f", w0_3, w0_4, total_error)
CALL H5Pclose_f(dapl2,error)
CALL check("H5Pclose_f", error, total_error)
@@ -581,11 +570,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Dget_access_plist_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, 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.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ 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 verify("H5Pget_chunk_cache_f", w0_2, w0_4, total_error)
CALL H5Pclose_f(dapl2,error)
CALL check("H5Pclose_f", error, total_error)
@@ -601,11 +588,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, 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.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ 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 verify("H5Pget_chunk_cache_f", w0_2, w0_4, total_error)
! Don't close dapl2, we will use it in the next section
! Modify cache values on fapl_local
@@ -638,11 +623,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Dget_access_plist_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, 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.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ 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 verify("H5Pget_chunk_cache_f", w0_2, w0_4, total_error)
! Test H5D_CHUNK_CACHE_NSLOTS_DEFAULT and H5D_CHUNK_CACHE_W0_DEFAULT
nslots_2 = H5D_CHUNK_CACHE_NSLOTS_DFLT_F
@@ -663,11 +646,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Dget_access_plist_f", error, total_error)
CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, 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.dreal_eq( REAL(w0_3,dp), REAL( w0_4, dp)) ) THEN
- CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
- ENDIF
+ 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 verify("H5Pget_chunk_cache_f", w0_3, w0_4, total_error)
! Close
diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90
index 56f9679..ec9fef2 100644
--- a/fortran/test/tH5P_F03.f90
+++ b/fortran/test/tH5P_F03.f90
@@ -52,8 +52,6 @@ CONTAINS
INTEGER FUNCTION test_genprop_cls_cb1_f(list_id, create_data ) bind(C)
- USE HDF5
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN), VALUE :: list_id
@@ -71,6 +69,11 @@ END MODULE test_genprop_cls_cb1_mod
MODULE TH5P_F03
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+ USE ISO_C_BINDING
+
CONTAINS
!-------------------------------------------------------------------------
@@ -92,9 +95,6 @@ CONTAINS
SUBROUTINE test_create(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -187,18 +187,12 @@ SUBROUTINE test_create(total_error)
CALL check("H5Pset_fill_value_f",error, total_error)
CALL h5pget_fill_value_f(dcpl, H5T_NATIVE_DOUBLE, dpfill, error)
CALL check("H5Pget_fill_value_f",error, total_error)
- IF(.NOT.dreal_eq( REAL(dpfill,dp), 1.0_dp))THEN
- PRINT*,"***ERROR: Returned wrong fill value (double)"
- total_error = total_error + 1
- ENDIF
+ CALL VERIFY("***ERROR: Returned wrong fill value (double)", dpfill, 1.0_dp, total_error)
CALL H5Pset_fill_value_f(dcpl, H5T_NATIVE_REAL, 2.0, error)
CALL check("H5Pset_fill_value_f",error, total_error)
CALL h5pget_fill_value_f(dcpl, H5T_NATIVE_REAL, rfill, error)
CALL check("H5Pget_fill_value_f",error, total_error)
- IF(.NOT.dreal_eq( REAL(rfill,dp), REAL(2.0,dp)))THEN
- PRINT*,"***ERROR: Returned wrong fill value (real)"
- total_error = total_error + 1
- ENDIF
+ CALL VERIFY("***ERROR: Returned wrong fill value (real)", rfill, 2.0, total_error)
! For the actual compound type
CALL H5Pset_fill_value_f(dcpl, comp_type_id, f_ptr, error)
@@ -234,10 +228,10 @@ 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)
+ CALL verify("***ERROR: Returned wrong fill value", rd_c%a, fill_ctype%a, total_error)
+ CALL verify("***ERROR: Returned wrong fill value", rd_c%y, fill_ctype%y, total_error)
- 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. &
+ IF( rd_c%x .NE. fill_ctype%x .OR. &
rd_c%z .NE. fill_ctype%z )THEN
PRINT*,"***ERROR: Returned wrong fill value"
@@ -269,9 +263,6 @@ SUBROUTINE test_genprop_class_callback(total_error)
!
!
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
USE test_genprop_cls_cb1_mod
IMPLICIT NONE
@@ -330,7 +321,7 @@ SUBROUTINE test_genprop_class_callback(total_error)
! Check the number of properties in class
CALL h5pget_nprops_f(cid1, nprops, error)
CALL check("h5pget_nprops_f", error, total_error)
- CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error)
+ CALL verify("h5pget_nprops_f", INT(nprops), 4, total_error)
! Initialize class callback structs
@@ -350,12 +341,12 @@ SUBROUTINE test_genprop_class_callback(total_error)
! Check that the list's class is correct
CALL H5Pequal_f(cid2, cid1, flag, error)
CALL check("H5Pequal_f", error, total_error)
- CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Pequal_f", flag, .TRUE., total_error)
! Check the class name
CALL H5Pget_class_name_f(cid2, CLASS1_NAME_BUF, CLASS1_NAME_SIZE, error)
CALL check("H5Pget_class_name_f", error, total_error)
- CALL verifystring("H5Pget_class_name_f", CLASS1_NAME_BUF, CLASS1_NAME, error)
+ CALL verify("H5Pget_class_name_f", CLASS1_NAME_BUF, CLASS1_NAME, error)
IF(error.NE.0)THEN
WRITE(*,*) 'Class names do not match! name=',CLASS1_NAME_BUF, 'CLASS1_NAME=',CLASS1_NAME
total_error = total_error + 1
@@ -365,42 +356,42 @@ SUBROUTINE test_genprop_class_callback(total_error)
CALL check("h5pclose_class_f", error, total_error)
! Verify that the creation callback occurred
- CALL VERIFY("h5pcreate_f", crt_cb_struct%count, 1, total_error)
- CALL VERIFY_INTEGER_HID_T("h5pcreate_f", crt_cb_struct%id, lid1, total_error)
+ CALL verify("h5pcreate_f", crt_cb_struct%count, 1, total_error)
+ CALL verify("h5pcreate_f", crt_cb_struct%id, lid1, total_error)
! Check the number of properties in list
CALL h5pget_nprops_f(lid1,nprops, error)
CALL check("h5pget_nprops_f", error, total_error)
- CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error)
+ CALL verify("h5pget_nprops_f", INT(nprops), 4, total_error)
! Create another property list from the class
CALL h5pcreate_f(cid1, lid2, error)
CALL check("h5pcreate_f", error, total_error)
! Verify that the creation callback occurred
- CALL VERIFY("h5pcreate_f", crt_cb_struct%count, 2, total_error)
- CALL VERIFY_INTEGER_HID_T("h5pcreate_f", crt_cb_struct%id, lid2, total_error)
+ CALL verify("h5pcreate_f", crt_cb_struct%count, 2, total_error)
+ CALL verify("h5pcreate_f", crt_cb_struct%id, lid2, total_error)
! Check the number of properties in list
CALL h5pget_nprops_f(lid2,nprops, error)
CALL check("h5pget_nprops_f", error, total_error)
- CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error)
+ CALL verify("h5pget_nprops_f", INT(nprops), 4, total_error)
! Close first list
CALL h5pclose_f(lid1, error);
CALL check("h5pclose_f", error, total_error)
! Verify that the close callback occurred
- CALL VERIFY("h5pcreate_f", cls_cb_struct%count, 1, total_error)
- CALL VERIFY_INTEGER_HID_T("h5pcreate_f", cls_cb_struct%id, lid1, total_error)
+ CALL verify("h5pcreate_f", cls_cb_struct%count, 1, total_error)
+ CALL verify("h5pcreate_f", cls_cb_struct%id, lid1, total_error)
! Close second list
CALL h5pclose_f(lid2, error);
CALL check("h5pclose_f", error, total_error)
! Verify that the close callback occurred
- CALL VERIFY("h5pcreate_f", cls_cb_struct%count, 2, total_error)
- CALL verify_INTEGER_HID_T("h5pcreate_f", cls_cb_struct%id, lid2, total_error)
+ CALL verify("h5pcreate_f", cls_cb_struct%count, 2, total_error)
+ CALL verify("h5pcreate_f", cls_cb_struct%id, lid2, total_error)
! Close class
CALL h5pclose_class_f(cid1, error)
@@ -423,8 +414,6 @@ END SUBROUTINE test_genprop_class_callback
SUBROUTINE test_h5p_file_image(total_error)
- USE HDF5
- USE TH5_MISC
USE, INTRINSIC :: iso_c_binding
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -475,11 +464,11 @@ SUBROUTINE test_h5p_file_image(total_error)
CALL check("h5pget_file_image_f", error, total_error)
! Check that sizes are the same, and that the buffers are identical but separate
- CALL VERIFY("h5pget_file_image_f", INT(temp_size), INT(size), total_error)
+ CALL verify("h5pget_file_image_f", INT(temp_size), INT(size), total_error)
! Verify the image data is correct
DO i = 1, count
- CALL VERIFY("h5pget_file_image_f", temp(i), buffer(i), total_error)
+ CALL verify("h5pget_file_image_f", temp(i), buffer(i), total_error)
ENDDO
END SUBROUTINE test_h5p_file_image
@@ -499,10 +488,6 @@ END SUBROUTINE test_h5p_file_image
!
SUBROUTINE external_test_offset(cleanup,total_error)
- USE ISO_C_BINDING
- USE TH5_MISC
- USE HDF5 ! This module contains all necessary modules
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
LOGICAL, INTENT(IN) :: cleanup
diff --git a/fortran/test/tH5R.f90 b/fortran/test/tH5R.f90
index bd6264f..ef392b4 100644
--- a/fortran/test/tH5R.f90
+++ b/fortran/test/tH5R.f90
@@ -33,11 +33,13 @@
!
MODULE TH5R
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE refobjtest(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
@@ -125,7 +127,6 @@ SUBROUTINE refobjtest(cleanup, total_error)
CALL check("h5tcopy_f",error,total_error)
CALL h5tcommit_f(file_id, "MyType", type_id, error)
CALL check("h5tcommit_f",error,total_error)
-
!
! Close dataspaces, groups and integer dataset
!
@@ -164,22 +165,22 @@ SUBROUTINE refobjtest(cleanup, total_error)
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),7, total_error)
- CALL VerifyString("H5Rget_name_f", buf, "/GROUP1", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),7, total_error)
+ CALL verify("H5Rget_name_f", buf, "/GROUP1", total_error)
! with buffer bigger then needed
CALL H5Rget_name_f(dsetr_id, ref(1), buf_big, error, buf_size )
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),7,total_error)
- CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/GROUP1", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),7,total_error)
+ CALL verify("H5Rget_name_f", TRIM(buf_big), "/GROUP1", total_error)
! getting path to dataset in /Group1
CALL H5Rget_name_f(dsetr_id, ref(2), buf_big, error, buf_size )
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),14,total_error)
- CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/GROUP1/GROUP2", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),14,total_error)
+ CALL verify("H5Rget_name_f", TRIM(buf_big), "/GROUP1/GROUP2", total_error)
!
!Close the dataset
@@ -233,7 +234,6 @@ SUBROUTINE refobjtest(cleanup, 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
@@ -244,9 +244,6 @@ END SUBROUTINE refobjtest
! and h5rdereference_f functionalities
!
SUBROUTINE refregtest(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-! use iso_c_binding ! NOTE: if this is uncommented, then need to move subroutine into another file.
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -408,23 +405,23 @@ SUBROUTINE refregtest(cleanup, total_error)
! Get name of the dataset the first region reference points to using H5Rget_name_f
CALL H5Rget_name_f(dsetr_id, ref_out(1), buf, error, buf_size )
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),7,total_error)
- CALL VerifyString("H5Rget_name_f", buf, "/MATRIX", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),7,total_error)
+ CALL verify("H5Rget_name_f", buf, "/MATRIX", total_error)
! Get name of the dataset the first region reference points to using H5Rget_name_f
! buffer bigger then needed
CALL H5Rget_name_f(dsetr_id, ref_out(1), buf_big, error, buf_size )
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),7,total_error)
- CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/MATRIX", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),7,total_error)
+ CALL verify("H5Rget_name_f", TRIM(buf_big), "/MATRIX", total_error)
! Get name of the dataset the first region reference points to using H5Rget_name_f
! buffer smaller then needed
CALL H5Rget_name_f(dsetr_id, ref_out(1), buf_small, error, buf_size )
CALL check("H5Rget_name_f", error, total_error)
- CALL VERIFY("H5Rget_name_f", INT(buf_size),7,total_error)
- CALL VerifyString("H5Rget_name_f", TRIM(buf_small), "/MAT", total_error)
+ CALL verify("H5Rget_name_f", INT(buf_size),7,total_error)
+ CALL verify("H5Rget_name_f", TRIM(buf_small), "/MAT", total_error)
!
! Dereference the first reference.
!
@@ -436,7 +433,7 @@ SUBROUTINE refregtest(cleanup, total_error)
! Get name of the dataset the second region reference points to using H5Rget_name_f
CALL H5Rget_name_f(dsetr_id, ref_out(2), buf, error) ! no optional size
CALL check("H5Rget_name_f", error, total_error)
- CALL VerifyString("H5Rget_name_f", TRIM(buf), "/MATRIX", total_error)
+ CALL verify("H5Rget_name_f", TRIM(buf), "/MATRIX", total_error)
!
! Read selected data from the dataset.
!
diff --git a/fortran/test/tH5S.f90 b/fortran/test/tH5S.f90
index eaaf29a..7223772 100644
--- a/fortran/test/tH5S.f90
+++ b/fortran/test/tH5S.f90
@@ -35,12 +35,14 @@
!*****
MODULE TH5S
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE dataspace_basic_test(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90
index 7d07308..aeb80e9 100644
--- a/fortran/test/tH5Sselect.f90
+++ b/fortran/test/tH5Sselect.f90
@@ -38,13 +38,14 @@
!*****
MODULE TH5SSELECT
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE test_select_hyperslab(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
@@ -699,8 +700,6 @@ CONTAINS
SUBROUTINE test_basic_select(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -1036,8 +1035,6 @@ CONTAINS
!***************************************************************
SUBROUTINE test_select_point(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -1140,9 +1137,9 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(1,i)), INT(coord1(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(2,i)), INT(coord1(2,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(3,i)), INT(coord1(3,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(1,i)), INT(coord1(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(2,i)), INT(coord1(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(3,i)), INT(coord1(3,i)), total_error)
ENDDO
CALL H5Sget_select_npoints_f(sid1, npoints, error)
@@ -1171,9 +1168,9 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(1,i)), INT(coord1(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(2,i)), INT(coord1(2,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord1(3,i)), INT(coord1(3,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(1,i)), INT(coord1(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(2,i)), INT(coord1(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(3,i)), INT(coord1(3,i)), total_error)
ENDDO
CALL H5Sget_select_npoints_f(sid1, npoints, error)
@@ -1202,8 +1199,8 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord2(1,i)), INT(coord2(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord2(2,i)), INT(coord2(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(1,i)), INT(coord2(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(2,i)), INT(coord2(2,i)), total_error)
ENDDO
!!$
@@ -1238,8 +1235,8 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord2(1,i)), INT(coord2(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord2(2,i)), INT(coord2(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(1,i)), INT(coord2(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(2,i)), INT(coord2(2,i)), total_error)
ENDDO
CALL H5Sget_select_npoints_f(sid2, npoints, error)
@@ -1284,8 +1281,8 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord3,error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord3(1,i)), INT(coord3(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord3(2,i)), INT(coord3(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(1,i)), INT(coord3(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(2,i)), INT(coord3(2,i)), total_error)
ENDDO
CALL H5Sget_select_npoints_f(sid2, npoints, error)
@@ -1311,8 +1308,8 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL h5sget_select_elem_pointlist_f(sid2, INT(POINT1_NPOINTS,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord3,error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord3(1,i)), INT(coord3(1,i)), total_error)
- CALL VERIFY("h5sget_select_elem_pointlist_f", INT(temp_coord3(2,i)), INT(coord3(2,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(1,i)), INT(coord3(1,i)), total_error)
+ CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(2,i)), INT(coord3(2,i)), total_error)
ENDDO
CALL H5Sget_select_npoints_f(sid2, npoints, error)
@@ -1363,8 +1360,6 @@ END SUBROUTINE test_select_point
!***************************************************************
SUBROUTINE test_select_combine(total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1400,7 +1395,7 @@ SUBROUTINE test_select_combine(total_error)
CALL H5Sget_select_type_f(all_id, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error)
! Copy base dataspace and set selection to "none"
CALL h5scopy_f(base_id, none_id, error)
@@ -1411,7 +1406,7 @@ SUBROUTINE test_select_combine(total_error)
CALL H5Sget_select_type_f(none_id, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_NONE_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_NONE_F), total_error)
! Copy "all" selection & space
CALL H5Scopy_f(all_id, space1, error)
@@ -1429,7 +1424,7 @@ SUBROUTINE test_select_combine(total_error)
! Verify that it's still "all" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1451,12 +1446,12 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the same at the original block
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there is only one block
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
! Retrieve the block defined
CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error)
@@ -1464,10 +1459,10 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the correct block is defined
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1490,12 +1485,12 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is an inversion of the original block
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there are two blocks
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error)
! Retrieve the block defined
@@ -1507,19 +1502,19 @@ SUBROUTINE test_select_combine(total_error)
! No guarantee is implied as the order in which blocks are listed.
! So this will ONLY work for square domains iblock(1:2) = (/5,5/)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 10, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(5,1,1)), 6, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(6,1,1)), 1, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(7,1,1)), 10, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(8,1,1)), 10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(5,1,1)), 6, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(6,1,1)), 1, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(7,1,1)), 10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(8,1,1)), 10, total_error)
! Otherwise make sure the "area" of the block is correct
area = (ABS(INT(blocks(1,1,1)-blocks(3,1,1)))+1)*(ABS(INT(blocks(2,1,1)-blocks(4,1,1)))+1)
area = area + (ABS(INT(blocks(5,1,1)-blocks(7,1,1)))+1)*(ABS(INT(blocks(6,1,1)-blocks(8,1,1)))+1)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", area, 80, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", area, 80, total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1542,12 +1537,12 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is an inversion of the original block
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there are two blocks
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error)
! Retrieve the block defined
blocks = -1 ! Reset block list
@@ -1559,19 +1554,19 @@ SUBROUTINE test_select_combine(total_error)
! No guarantee is implied as the order in which blocks are listed.
! So this will ONLY work for square domains iblock(1:2) = (/5,5/)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)),10, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(5,1,1)), 6, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(6,1,1)), 1, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(7,1,1)),10, total_error)
-!!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(8,1,1)),10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)),10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(5,1,1)), 6, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(6,1,1)), 1, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(7,1,1)),10, total_error)
+!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(8,1,1)),10, total_error)
! Otherwise make sure the "area" of the block is correct
area = (ABS(INT(blocks(1,1,1)-blocks(3,1,1)))+1)*(ABS(INT(blocks(2,1,1)-blocks(4,1,1)))+1)
area = area + (ABS(INT(blocks(5,1,1)-blocks(7,1,1)))+1)*(ABS(INT(blocks(6,1,1)-blocks(8,1,1)))+1)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", area, 80, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", area, 80, total_error)
! Close temporary dataspace
@@ -1594,7 +1589,7 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the "none" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1617,13 +1612,13 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the same as the original hyperslab
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there is only one block
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
! Retrieve the block defined
blocks = -1 ! Reset block list
@@ -1631,10 +1626,10 @@ SUBROUTINE test_select_combine(total_error)
CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
! Verify that the correct block is defined
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1657,7 +1652,7 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the "none" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1680,23 +1675,23 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the same as the original hyperslab
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there is only one block
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
! Retrieve the block defined
blocks = -1 ! Reset block list
CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error)
CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
! Verify that the correct block is defined
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1719,7 +1714,7 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the "none" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1741,12 +1736,12 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the new selection is the same as the original hyperslab
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
- CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
+ CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
! Verify that there is ONLY one BLOCK
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
- CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
+ CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
! Retrieve the block defined
@@ -1757,10 +1752,10 @@ SUBROUTINE test_select_combine(total_error)
! Verify that the correct block is defined
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
- CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
+ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
! Close temporary dataspace
CALL h5sclose_f(space1, error)
@@ -1785,8 +1780,6 @@ END SUBROUTINE test_select_combine
!***************************************************************
SUBROUTINE test_select_bounds(total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1817,10 +1810,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), SPACE11_DIM1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), SPACE11_DIM2, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(1), 1_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(2), 1_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1, hsize_t), total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2, hsize_t), total_error)
! Set offset for selection
offset(1:2) = 1
@@ -1831,10 +1824,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL verify("h5sget_select_bounds_f", INT(low_bounds(1)), 1, total_error)
- CALL verify("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
- CALL verify("h5sget_select_bounds_f", INT(high_bounds(1)), SPACE11_DIM1, total_error)
- CALL verify("h5sget_select_bounds_f", INT(high_bounds(2)), SPACE11_DIM2, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(1), 1_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(2), 1_hsize_t, total_error)
+ CALL VERIFY("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1, hsize_t), total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2, hsize_t), total_error)
! Reset offset for selection
offset(1:2) = 0
@@ -1847,7 +1840,7 @@ SUBROUTINE test_select_bounds(total_error)
! Get bounds for 'none' selection, should fail
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
- CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
+ CALL verify("h5sget_select_bounds_f", error, -1, total_error)
! Set point selection
@@ -1863,10 +1856,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-4), total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-4), total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(1), 3_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(2), 3_hsize_t, total_error)
+ CALL VERIFY("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1-4,hsize_t), total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2-4,hsize_t), total_error)
! Set bad offset for selection
@@ -1876,7 +1869,7 @@ SUBROUTINE test_select_bounds(total_error)
! Get bounds for hyperslab selection with negative offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
- CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
+ CALL verify("h5sget_select_bounds_f", error, -1, total_error)
! Set valid offset for selection
offset(1:2) = (/2,-2/)
@@ -1887,10 +1880,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 5, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-2), total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-6), total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(1), 5_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(2), 1_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1-2,hsize_t), total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2-6,hsize_t), total_error)
! Reset offset for selection
offset(1:2) = 0
@@ -1911,10 +1904,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 37, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 37, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(1), 3_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(2), 3_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(1), 37_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(2), 37_hsize_t, total_error)
! Set bad offset for selection
offset(1:2) = (/5,-5/)
@@ -1923,7 +1916,7 @@ SUBROUTINE test_select_bounds(total_error)
! Get bounds for hyperslab selection with negative offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
- CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
+ CALL verify("h5sget_select_bounds_f", error, -1, total_error)
! Set valid offset for selection
offset(1:2) = (/5,-2/)
@@ -1934,10 +1927,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 8, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 42, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 35, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(1), 8_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(2), 1_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(1), 42_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(2), 35_hsize_t, total_error)
! Reset offset for selection
offset(1:2) = 0
@@ -1958,10 +1951,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 50, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 50, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(1), 3_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(2), 3_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(1), 50_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(2), 50_hsize_t, total_error)
! Set bad offset for selection
offset(1:2) = (/5,-5/)
@@ -1970,7 +1963,7 @@ SUBROUTINE test_select_bounds(total_error)
! Get bounds for hyperslab selection with negative offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
- CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
+ CALL verify("h5sget_select_bounds_f", error, -1, total_error)
! Set valid offset for selection
offset(1:2) = (/5,-2/)
@@ -1981,10 +1974,10 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 8, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 55, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 48, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(1), 8_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", low_bounds(2), 1_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(1), 55_hsize_t, total_error)
+ CALL verify("h5sget_select_bounds_f", high_bounds(2), 48_hsize_t, total_error)
! Reset offset for selection
offset(1:2) = 0
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index 7822c16..efbceea 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -29,6 +29,10 @@
MODULE TH5T
+ USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
+
CONTAINS
SUBROUTINE compoundtest(cleanup, total_error)
@@ -47,8 +51,6 @@ CONTAINS
! 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
@@ -155,7 +157,6 @@ CONTAINS
CALL h5tclose_f(fixed_str2,error)
CALL check("h5tclose_f", error, total_error)
-
data_dims(1) = dimsize
!
! Initialize data buffer.
@@ -178,47 +179,47 @@ CONTAINS
! 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 check("h5pcreate_f", error, total_error)
CALL h5pset_preserve_f(plist_id, flag, error)
- CALL check("h5pset_preserve_f", error, total_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)
+ 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)
+ 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)
+ 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)
+ 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 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 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 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 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)
+ 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)
+ CALL check("h5tcreate_f", error, total_error)
!
! Insert memebers
!
@@ -226,19 +227,19 @@ CONTAINS
!
offset = 0
CALL h5tinsert_f(dtype_id, "char_field", offset, dt5_id, error)
- CALL check("h5tinsert_f", error, total_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)
+ 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)
+ CALL check("h5tinsert_f", error, total_error)
!
! REAL member
!
@@ -250,123 +251,122 @@ CONTAINS
!
CALL h5dcreate_f(file_id, dsetname, dtype_id, dspace_id, &
dset_id, error)
- CALL check("h5dcreate_f", error, total_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)
+ 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 check("h5tinsert_f", error, total_error)
!
CALL h5tcreate_f(H5T_COMPOUND_F, type_sizei, dt2_id, error)
- CALL check("h5tcreate_f", error, total_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 check("h5tinsert_f", error, total_error)
!
CALL h5tcreate_f(H5T_COMPOUND_F, type_sized, dt3_id, error)
- CALL check("h5tcreate_f", error, total_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 check("h5tinsert_f", error, total_error)
!
CALL h5tcreate_f(H5T_COMPOUND_F, type_sizer, dt4_id, error)
- CALL check("h5tcreate_f", error, total_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)
+ 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 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 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 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)
+ 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)
+ 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)
+ 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 check("h5tclose_f", error, total_error)
CALL h5tclose_f(dt1_id, error)
- CALL check("h5tclose_f", error, total_error)
+ CALL check("h5tclose_f", error, total_error)
CALL h5tclose_f(dt2_id, error)
- CALL check("h5tclose_f", error, total_error)
+ CALL check("h5tclose_f", error, total_error)
CALL h5tclose_f(dt3_id, error)
- CALL check("h5tclose_f", error, total_error)
+ CALL check("h5tclose_f", error, total_error)
CALL h5tclose_f(dt4_id, error)
- CALL check("h5tclose_f", error, total_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)
+ 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)
+ 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 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 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 check("h5tcommit_f", error, total_error)
CALL h5tclose_f(arrayt_id, error)
- CALL check("h5tclose_f", error, total_error)
+ CALL check("h5tclose_f", error, total_error)
CALL h5tclose_f(dtarray_id, error)
- CALL check("h5tclose_f", error, total_error)
+ CALL check("h5tclose_f", error, total_error)
!
! Close the file.
!
CALL h5fclose_f(file_id, error)
- CALL check("h5fclose_f", error, total_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)
+ 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)
+ 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 check("h5dget_type_f", error, total_error)
CALL h5tget_class_f(dtype_id, class, error)
- CALL check("h5dget_class_f", error, total_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)
+ 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
@@ -377,11 +377,11 @@ CONTAINS
!
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 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 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)
+ 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
@@ -394,16 +394,16 @@ CONTAINS
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)
+ 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)
+ 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
@@ -413,16 +413,16 @@ CONTAINS
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)
+ 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)
+ 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
@@ -432,16 +432,16 @@ CONTAINS
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)
+ 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)
+ 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
@@ -451,16 +451,16 @@ CONTAINS
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)
+ 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)
+ 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
@@ -476,22 +476,22 @@ CONTAINS
! 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)
+ 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 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 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)
+ 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)
+ 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)
+ 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 "
@@ -500,15 +500,15 @@ CONTAINS
enddo
!
CALL h5tcreate_f(H5T_COMPOUND_F, type_sizei, dt5_id, error)
- CALL check("h5tcreate_f", error, total_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)
+ 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)
+ 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 "
@@ -518,39 +518,33 @@ CONTAINS
!
!
CALL h5tcreate_f(H5T_COMPOUND_F, type_sized, dt3_id, error)
- CALL check("h5tcreate_f", error, total_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 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
- 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
- enddo
+ 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)
+ 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)
+ 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
- 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
+ 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
@@ -565,7 +559,7 @@ CONTAINS
! Try decoding bogus buffer
CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error)
- CALL VERIFY("H5Tdecode_f", error, -1, total_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)
@@ -578,27 +572,27 @@ CONTAINS
CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., 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 check("h5dclose_f", error, total_error)
CALL h5tclose_f(dt1_id, error)
- CALL check("h5tclose_f", error, total_error)
+ CALL check("h5tclose_f", error, total_error)
CALL h5tclose_f(dt2_id, error)
- CALL check("h5tclose_f", error, total_error)
+ CALL check("h5tclose_f", error, total_error)
CALL h5tclose_f(dt3_id, error)
- CALL check("h5tclose_f", error, total_error)
+ CALL check("h5tclose_f", error, total_error)
CALL h5tclose_f(dt4_id, error)
- CALL check("h5tclose_f", error, total_error)
+ CALL check("h5tclose_f", error, total_error)
CALL h5tclose_f(dt5_id, error)
- CALL check("h5tclose_f", error, total_error)
+ CALL check("h5tclose_f", error, total_error)
CALL h5fclose_f(file_id, error)
- CALL check("h5fclose_f", error, total_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)
+ IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
+ CALL check("h5_cleanup_f", error, total_error)
RETURN
END SUBROUTINE compoundtest
@@ -614,9 +608,6 @@ CONTAINS
! H5tset_norm_f, H5tget_inpad_f, H5tset_inpad_f, H5tget_cset_f,
! H5tset_cset_f, H5tget_strpad_f, H5tset_strpad_f
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(OUT) :: total_error
@@ -902,7 +893,7 @@ CONTAINS
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)
+ CALL verify("H5Tget_native_type_f",order1, order2, total_error)
! this test depends on whether -i8 was specified
@@ -910,11 +901,11 @@ CONTAINS
!!$ 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 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 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)
@@ -972,8 +963,6 @@ CONTAINS
SUBROUTINE test_derived_flt(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -1060,24 +1049,24 @@ SUBROUTINE test_derived_flt(cleanup, total_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)
+ 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 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 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 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)
+ CALL verify("H5Tget_ebias_f", INT(ebias1), 511, total_error)
!--------------------------------------------------------------------------
! * 2nd floating-point type
@@ -1121,24 +1110,24 @@ SUBROUTINE test_derived_flt(cleanup, total_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)
+ 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 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 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 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 verify("H5Tget_ebias_f", INT(ebias2), 63, total_error)
CALL h5tclose_f(tid1, error)
CALL check("h5tclose_f", error, total_error)
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.F90
index 32531b0..d50b76d 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.F90
@@ -41,19 +41,19 @@
!**
!***************************************************************
!
+#include <H5config_f.inc>
MODULE TH5T_F03
USE HDF5
+ USE TH5_MISC
+ USE TH5_MISC_GEN
USE ISO_C_BINDING
CONTAINS
SUBROUTINE test_array_compound_atomic(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -201,7 +201,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
! Check the 1st field's name
CALL H5Tget_member_name_f(tid2, 0, mname, namelen,error)
CALL check("H5Tget_member_name_f", error, total_error)
- CALL verifystring("H5Tget_member_name_f",mname(1:namelen),"i", total_error)
+ CALL verify("H5Tget_member_name_f",mname(1:namelen),"i", total_error)
! Check the 1st field's offset
CALL H5Tget_member_offset_f(tid2, 0, off, error)
@@ -215,7 +215,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
CALL H5Tequal_f(mtid, H5T_NATIVE_INTEGER, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
CALL h5tclose_f(mtid,error)
CALL check("h5tclose_f", error, total_error)
@@ -223,7 +223,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
! Check the 2nd field's name
CALL H5Tget_member_name_f(tid2, 1, mname, namelen,error)
CALL check("H5Tget_member_name_f", error, total_error)
- CALL verifystring("H5Tget_member_name_f",mname(1:namelen),"f", total_error)
+ CALL verify("H5Tget_member_name_f",mname(1:namelen),"f", total_error)
! Check the 2nd field's offset
CALL H5Tget_member_offset_f(tid2, 1, off, error)
@@ -236,7 +236,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
CALL H5Tequal_f(mtid, H5T_NATIVE_REAL, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
CALL h5tclose_f(mtid,error)
CALL check("h5tclose_f", error, total_error)
@@ -258,10 +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
- 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
+ CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',wdata(i,j)%f, rdata(i,j)%f, total_error)
ENDDO
ENDDO
@@ -288,9 +285,6 @@ END SUBROUTINE test_array_compound_atomic
!!$
SUBROUTINE test_array_compound_array(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -487,7 +481,7 @@ END SUBROUTINE test_array_compound_atomic
! Check the 1st field's name
CALL H5Tget_member_name_f(tid2, 0, mname, namelen,error)
CALL check("H5Tget_member_name_f", error, total_error)
- CALL verifystring("H5Tget_member_name_f",mname(1:namelen),"i", total_error)
+ CALL verify("H5Tget_member_name_f",mname(1:namelen),"i", total_error)
! Check the 1st field's offset
@@ -501,7 +495,7 @@ END SUBROUTINE test_array_compound_atomic
CALL H5Tequal_f(mtid, H5T_NATIVE_INTEGER, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
CALL h5tclose_f(mtid,error)
CALL check("h5tclose_f", error, total_error)
@@ -509,7 +503,7 @@ END SUBROUTINE test_array_compound_atomic
! Check the 2nd field's name
CALL H5Tget_member_name_f(tid2, 1, mname, namelen,error)
CALL check("H5Tget_member_name_f", error, total_error)
- CALL verifystring("H5Tget_member_name_f",mname(1:namelen),"f", total_error)
+ CALL verify("H5Tget_member_name_f",mname(1:namelen),"f", total_error)
! Check the 2nd field's offset
CALL H5Tget_member_offset_f(tid2, 1, off, error)
@@ -542,7 +536,7 @@ END SUBROUTINE test_array_compound_atomic
! Check the 3rd field's name
CALL H5Tget_member_name_f(tid2, 2, mname, namelen,error)
CALL check("H5Tget_member_name_f", error, total_error)
- CALL verifystring("H5Tget_member_name_f",mname(1:namelen),"c", total_error)
+ CALL verify("H5Tget_member_name_f",mname(1:namelen),"c", total_error)
! Check the 3rd field's offset
CALL H5Tget_member_offset_f(tid2, 2, off, error)
@@ -579,7 +573,7 @@ END SUBROUTINE test_array_compound_atomic
CALL H5Tequal_f(tid3, H5T_NATIVE_REAL, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
! Check the nested array's datatype
CALL H5Tget_super_f(mtid2, tid3, error)
@@ -587,7 +581,7 @@ END SUBROUTINE test_array_compound_atomic
CALL H5Tequal_f(tid3, atype_id, flag, error)
CALL check("H5Tequal_f", error, total_error)
- CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
+ CALL verify("H5Tequal_f", flag, .TRUE., total_error)
! Close the array's base type datatype
CALL h5tclose_f(tid3, error)
@@ -656,9 +650,6 @@ END SUBROUTINE test_array_compound_atomic
!!$
SUBROUTINE test_array_bkg(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -739,10 +730,10 @@ END SUBROUTINE test_array_compound_atomic
CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, error)
CALL check("h5tget_size_f", error, total_error)
IF(h5_sizeof(cf(1)%b(1)).EQ.4_size_t)THEN
- CALL h5tget_size_f(H5T_NATIVE_REAL_4, type_sizer, error)
+ CALL h5tget_size_f(H5T_NATIVE_REAL_C_FLOAT, type_sizer, error)
CALL check("h5tget_size_f", error, total_error)
ELSE IF(h5_sizeof(cf(1)%b(1)).EQ.8_size_t)THEN
- CALL h5tget_size_f(H5T_NATIVE_REAL_8, type_sizer, error)
+ CALL h5tget_size_f(H5T_NATIVE_REAL_C_DOUBLE, type_sizer, error)
CALL check("h5tget_size_f", error, total_error)
ENDIF
@@ -757,8 +748,8 @@ END SUBROUTINE test_array_compound_atomic
! Initialize the data type IDs
! ----------------------------
dtsinfo%datatype(1) = H5T_NATIVE_INTEGER;
- dtsinfo%datatype(2) = H5T_NATIVE_REAL_4;
- dtsinfo%datatype(3) = H5T_NATIVE_REAL_8;
+ dtsinfo%datatype(2) = H5T_NATIVE_REAL_C_FLOAT;
+ dtsinfo%datatype(3) = H5T_NATIVE_REAL_C_DOUBLE;
! Initialize the names of data members
@@ -828,14 +819,8 @@ 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.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
- 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
+ CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',cf(i)%b(j), cfr(i)%b(j), total_error)
+ CALL VERIFY('ERROR: Wrong double data is read back by H5Dread_f ',cf(i)%c(j), cfr(i)%c(j), total_error)
ENDDO
ENDDO
@@ -866,7 +851,7 @@ END SUBROUTINE test_array_compound_atomic
CALL h5tcreate_f(H5T_COMPOUND_F, sizeof_compound , type, error)
CALL check("h5tcreate_f", error, total_error)
- CALL h5tarray_create_f(H5T_NATIVE_REAL_4, 1, dima, array_dt, error)
+ CALL h5tarray_create_f(H5T_NATIVE_REAL_C_FLOAT, 1, dima, array_dt, error)
CALL check("h5tarray_create_f", error, total_error)
CALL h5tinsert_f(TYPE, "Two", 0_size_t, array_dt, error)
@@ -895,10 +880,7 @@ END SUBROUTINE test_array_compound_atomic
DO i = 1, LENGTH
DO j = 1, ALEN
- 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
+ CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',fld(i)%b(j), fldr(i)%b(j), total_error)
ENDDO
ENDDO
CALL h5tclose_f(TYPE,error)
@@ -922,18 +904,9 @@ END SUBROUTINE test_array_compound_atomic
DO i = 1, LENGTH
DO j = 1, ALEN
- IF( cf(i)%a(j) .NE. cfr(i)%a(j) )THEN
- PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
- 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
- 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
+ CALL VERIFY('ERROR: Wrong integer data is read back by H5Dread_f ',cf(i)%a(j), cfr(i)%a(j), total_error)
+ CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',cf(i)%b(j),cfr(i)%b(j), total_error)
+ CALL VERIFY('ERROR: Wrong double data is read back by H5Dread_f ',cf(i)%c(j), cfr(i)%c(j), total_error)
ENDDO
ENDDO
@@ -980,18 +953,9 @@ END SUBROUTINE test_array_compound_atomic
DO i = 1, LENGTH
DO j = 1, ALEN
- IF( cf(i)%a(j) .NE. cfr(i)%a(j) )THEN
- PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
- total_error = total_error + 1
- ENDIF
- 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
- 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
+ CALL VERIFY('ERROR: Wrong integer data is read back by H5Dread_f ',cf(i)%a(j), cfr(i)%a(j), total_error)
+ CALL VERIFY('ERROR: Wrong real data is read back by H5Dread_f ',cf(i)%b(j),cfr(i)%b(j), total_error)
+ CALL VERIFY('ERROR: Wrong double data is read back by H5Dread_f ',cf(i)%c(j), cfr(i)%c(j), total_error)
ENDDO
ENDDO
@@ -1006,26 +970,49 @@ END SUBROUTINE test_array_compound_atomic
END SUBROUTINE test_array_bkg
-
-
SUBROUTINE test_h5kind_to_type(total_error)
- USE ISO_C_BINDING
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
- INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(Fortran_INTEGER_1) !should map to INTEGER*1 on most modern processors
- INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(Fortran_INTEGER_2) !should map to INTEGER*2 on most modern processors
- INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) !should map to INTEGER*4 on most modern processors
- INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(Fortran_INTEGER_8) !should map to INTEGER*8 on most modern processors
-
- INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
- INTEGER, PARAMETER :: real_kind_15 = SELECTED_REAL_KIND(Fortran_REAL_8) !should map to REAL*8 on most modern processors
+ INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(2) !should map to INTEGER*1 on most modern processors
+ INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(4) !should map to INTEGER*2 on most modern processors
+ INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors
+ INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors
+#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+ INTEGER, PARAMETER :: int_kind_32 = SELECTED_INT_KIND(36) !should map to INTEGER*16 on most modern processors
+ INTEGER(int_kind_32), DIMENSION(1:4), TARGET :: dset_data_i32, data_out_i32
+ INTEGER(HID_T) :: dset_id32 ! Dataset identifier
+ CHARACTER(LEN=6), PARAMETER :: dsetname16 = "dset16" ! Dataset name
+#endif
+ INTEGER, PARAMETER :: real_kind_7 = C_FLOAT !should map to REAL*4 on most modern processors
+ INTEGER, PARAMETER :: real_kind_15 = C_DOUBLE !should map to REAL*8 on most modern processors
+! Check if C has quad precision extension
+#if H5_HAVE_FLOAT128!=0
+! Check if Fortran supports quad precision
+# if H5_PAC_FC_MAX_REAL_PRECISION > 26
+ INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(31)
+# else
+ INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(15,307)
+# endif
+#else
+! Check if the default of long double is quad precision
+# if H5_PAC_C_MAX_REAL_PRECISION > 26
+# if H5_PAC_FC_MAX_REAL_PRECISION > 26
+ INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(31)
+# else
+ INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(15,307)
+# endif
+# else
+ INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(15,307)
+# endif
+#endif
+ REAL(real_kind_31), DIMENSION(1:4), TARGET :: dset_data_r31, data_out_r31
+ INTEGER(HID_T) :: dset_idr16 ! Dataset identifier
+ CHARACTER(LEN=7), PARAMETER :: dsetnamer16 = "dsetr16" ! Dataset name
+
CHARACTER(LEN=12), PARAMETER :: filename = "dsetf_F03.h5" ! File name
CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
@@ -1067,14 +1054,17 @@ END SUBROUTINE test_array_compound_atomic
! Initialize the dset_data array.
!
DO i = 1, 4
- dset_data_i1(i) = i
- dset_data_i4(i) = i
- dset_data_i8(i) = i
- dset_data_i16(i) = i
-
- dset_data_r(i) = (i)*100.
- dset_data_r7(i) = (i)*100.
- dset_data_r15(i) = (i)*1000.
+ dset_data_i1(i) = HUGE(0_int_kind_1)-i
+ dset_data_i4(i) = HUGE(0_int_kind_4)-i
+ dset_data_i8(i) = HUGE(0_int_kind_8)-i
+ dset_data_i16(i) = HUGE(0_int_kind_16)-i
+#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+ dset_data_i32(i) = HUGE(0_int_kind_32)-i
+#endif
+ dset_data_r(i) = 4.0*ATAN(1.0)-REAL(i-1)
+ dset_data_r7(i) = 4.0_real_kind_7*ATAN(1.0_real_kind_7)-REAL(i-1,real_kind_7)
+ dset_data_r15(i) = 4.0_real_kind_15*ATAN(1.0_real_kind_15)-REAL(i-1,real_kind_15)
+ dset_data_r31(i) = 4.0_real_kind_31*ATAN(1.0_real_kind_31)-REAL(i-1,real_kind_31)
END DO
@@ -1096,14 +1086,20 @@ END SUBROUTINE test_array_compound_atomic
CALL check("H5Dcreate_f",error, total_error)
CALL H5Dcreate_f(file_id, dsetname8, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), dspace_id, dset_id16, error)
CALL check("H5Dcreate_f",error, total_error)
-
+#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+ CALL H5Dcreate_f(file_id, dsetname16, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), dspace_id, dset_id32, error)
+ CALL check("H5Dcreate_f",error, total_error)
+#endif
CALL H5Dcreate_f(file_id, dsetnamer, H5T_NATIVE_REAL, dspace_id, dset_idr, error)
CALL check("H5Dcreate_f",error, total_error)
CALL H5Dcreate_f(file_id, dsetnamer4, h5kind_to_type(real_kind_7,H5_REAL_KIND), dspace_id, dset_idr4, error)
CALL check("H5Dcreate_f",error, total_error)
CALL H5Dcreate_f(file_id, dsetnamer8, h5kind_to_type(real_kind_15,H5_REAL_KIND), dspace_id, dset_idr8, error)
CALL check("H5Dcreate_f",error, total_error)
-
+!#ifdef H5_HAVE_FLOAT128
+ CALL H5Dcreate_f(file_id, dsetnamer16, h5kind_to_type(real_kind_31,H5_REAL_KIND), dspace_id, dset_idr16, error)
+ CALL check("H5Dcreate_f",error, total_error)
+!#endif
!
! Write the dataset.
!
@@ -1119,6 +1115,11 @@ END SUBROUTINE test_array_compound_atomic
f_ptr = C_LOC(dset_data_i16(1))
CALL h5dwrite_f(dset_id16, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), f_ptr, error)
CALL check("H5Dwrite_f",error, total_error)
+#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+ f_ptr = C_LOC(dset_data_i32(1))
+ CALL h5dwrite_f(dset_id32, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), f_ptr, error)
+ CALL check("H5Dwrite_f",error, total_error)
+#endif
f_ptr = C_LOC(dset_data_r(1))
CALL h5dwrite_f(dset_idr, H5T_NATIVE_REAL, f_ptr, error)
CALL check("H5Dwrite_f",error, total_error)
@@ -1128,6 +1129,11 @@ END SUBROUTINE test_array_compound_atomic
f_ptr = C_LOC(dset_data_r15(1))
CALL h5dwrite_f(dset_idr8, h5kind_to_type(real_kind_15,H5_REAL_KIND), f_ptr, error)
CALL check("H5Dwrite_f",error, total_error)
+!#ifdef H5_HAVE_FLOAT128
+ f_ptr = C_LOC(dset_data_r31(1))
+ CALL h5dwrite_f(dset_idr16, h5kind_to_type(real_kind_31,H5_REAL_KIND), f_ptr, error)
+ CALL check("H5Dwrite_f",error, total_error)
+!#endif
!
! Close the file
!
@@ -1155,6 +1161,11 @@ END SUBROUTINE test_array_compound_atomic
f_ptr = C_LOC(data_out_i16)
CALL h5dread_f(dset_id16, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
+#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+ f_ptr = C_LOC(data_out_i32)
+ CALL h5dread_f(dset_id32, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), f_ptr, error)
+ CALL check("h5dread_f",error, total_error)
+#endif
f_ptr = C_LOC(data_out_r)
CALL h5dread_f(dset_idr, H5T_NATIVE_REAL, f_ptr, error)
CALL check("h5dread_f",error, total_error)
@@ -1164,20 +1175,25 @@ END SUBROUTINE test_array_compound_atomic
f_ptr = C_LOC(data_out_r15)
CALL h5dread_f(dset_idr8, h5kind_to_type(real_kind_15,H5_REAL_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
-
+ f_ptr = C_LOC(data_out_r31)
+ CALL h5dread_f(dset_idr16, h5kind_to_type(real_kind_31,H5_REAL_KIND), f_ptr, error)
+ CALL check("h5dread_f",error, total_error)
DO i = 1, 4
- CALL verify_Fortran_INTEGER_4("h5kind_to_type1",INT(dset_data_i1(i),int_kind_8),INT(data_out_i1(i),int_kind_8),total_error)
- 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("h5kind_to_type",dset_data_i1(i),data_out_i1(i),total_error)
+ CALL verify("h5kind_to_type",dset_data_i4(i),data_out_i4(i),total_error)
+ CALL verify("h5kind_to_type",dset_data_i8(i),data_out_i8(i),total_error)
+ CALL verify("h5kind_to_type",dset_data_i16(i),data_out_i16(i),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)
-
+#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+ CALL verify("h5kind_to_type",dset_data_i32(i),data_out_i32(i),total_error)
+#endif
+ CALL verify("h5kind_to_type",dset_data_r(i),data_out_r(i),total_error)
+ CALL verify("h5kind_to_type",dset_data_r7(i),data_out_r7(i),total_error)
+ CALL verify("h5kind_to_type",dset_data_r15(i),data_out_r15(i),total_error)
+ CALL verify("h5kind_to_type",dset_data_r31(i),data_out_r31(i),total_error)
END DO
-
+
!
! Close the dataset.
!
@@ -1212,10 +1228,6 @@ END SUBROUTINE test_h5kind_to_type
!************************************************************
SUBROUTINE t_array(total_error)
- USE ISO_C_BINDING
- USE HDF5
- USE TH5_MISC
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1300,8 +1312,8 @@ SUBROUTINE t_array(total_error)
CALL check("h5dget_type_f",error, error)
CALL H5Tget_array_dims_f(filetype, adims, error)
CALL check("h5dget_type_f",error, total_error)
- CALL VERIFY("H5Tget_array_dims_f", INT(adims(1)), adim0, total_error)
- CALL VERIFY("H5Tget_array_dims_f", INT(adims(2)), adim1, total_error)
+ CALL VERIFY("H5Tget_array_dims_f", adims(1), INT(adim0,hsize_t), total_error)
+ CALL VERIFY("H5Tget_array_dims_f", adims(2), INT(adim1,hsize_t), total_error)
!
! Get dataspace and allocate memory for read buffer. This is a
! three dimensional attribute when the array datatype is included.
@@ -1310,7 +1322,7 @@ SUBROUTINE t_array(total_error)
CALL check("H5Dget_space_f",error, error)
CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
CALL check("H5Sget_simple_extent_dims_f",error, total_error)
- CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), dim0, total_error)
+ CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
ALLOCATE(rdata(1:dims(1),1:adims(1),1:adims(2)))
!
@@ -1355,10 +1367,6 @@ END SUBROUTINE t_array
SUBROUTINE t_enum(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1419,7 +1427,8 @@ SUBROUTINE t_enum(total_error)
! Insert enumerated value for memtype.
!
val(1) = i
- CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), C_LOC(val(1)), error)
+ f_ptr = C_LOC(val(1))
+ CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), f_ptr, error)
CALL check("H5Tenum_insert_f", error, total_error)
!
! Insert enumerated value for filetype. We must first convert
@@ -1478,8 +1487,8 @@ SUBROUTINE t_enum(total_error)
CALL check("H5Dget_space_f",error, total_error)
CALL h5sget_simple_extent_dims_f(space, dims, maxdims, error)
CALL check("H5Sget_simple_extent_dims_f",error, total_error)
- CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), dim0, total_error)
- CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(2)), dim1, total_error)
+ CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
+ CALL VERIFY("H5Sget_simple_extent_dims_f", dims(2), INT(dim1,hsize_t), total_error)
ALLOCATE(rdata(1:dims(1),1:dims(2)))
@@ -1501,7 +1510,7 @@ SUBROUTINE t_enum(total_error)
CALL h5tenum_nameof_f( memtype, rdata(i,j), NAME_BUF_SIZE, name, error)
CALL check("h5tenum_nameof_f",error, total_error)
idx = MOD( (j-1)*(i-1), PLASMA+1 ) + 1
- CALL verifystring("h5tenum_nameof_f",TRIM(name),TRIM(names(idx)), total_error)
+ CALL verify("h5tenum_nameof_f",TRIM(name),TRIM(names(idx)), total_error)
IF(total_error.NE.0) EXIT i_loop
ENDDO
ENDDO i_loop
@@ -1522,10 +1531,6 @@ END SUBROUTINE t_enum
SUBROUTINE t_bit(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1602,8 +1607,8 @@ SUBROUTINE t_bit(total_error)
CALL check("H5Dget_space_f",error, total_error)
CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
CALL check("H5Sget_simple_extent_dims_f",error, total_error)
- CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), dim0, total_error)
- CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(2)), dim1, total_error)
+ CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
+ CALL VERIFY("H5Sget_simple_extent_dims_f", dims(2), INT(dim1,hsize_t), total_error)
ALLOCATE(rdata(1:dims(1),1:dims(2)))
!
! Read the data.
@@ -1648,10 +1653,6 @@ END SUBROUTINE t_bit
SUBROUTINE t_opaque(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1746,19 +1747,19 @@ SUBROUTINE t_opaque(total_error)
CALL h5tget_tag_f(dtype, tag_sm, taglen, error)
CALL check("h5tget_tag_f",error, total_error)
CALL VERIFY("h5tget_tag_f", taglen, 15, total_error)
- CALL verifystring("h5tget_tag_f",tag_sm,"Character arra", total_error)
+ CALL verify("h5tget_tag_f",tag_sm,"Character arra", total_error)
! Test reading into a string that is exact
CALL h5tget_tag_f(dtype, tag_exact, taglen, error)
CALL check("h5tget_tag_f",error, total_error)
CALL VERIFY("h5tget_tag_f", taglen, 15, total_error)
- CALL verifystring("h5tget_tag_f",tag_exact,"Character array", total_error)
+ CALL verify("h5tget_tag_f",tag_exact,"Character array", total_error)
! Test reading into a string that is to big
CALL h5tget_tag_f(dtype, tag_big, taglen, error)
CALL check("h5tget_tag_f",error, total_error)
CALL VERIFY("h5tget_tag_f", taglen, 15, total_error)
- CALL verifystring("h5tget_tag_f",tag_big,"Character array ", total_error)
+ CALL verify("h5tget_tag_f",tag_big,"Character array ", total_error)
!
! Get dataspace and allocate memory for read buffer.
@@ -1767,7 +1768,7 @@ SUBROUTINE t_opaque(total_error)
CALL check("H5Dget_space_f",error, total_error)
CALL h5sget_simple_extent_dims_f(space, dims, maxdims, error)
CALL check("H5Sget_simple_extent_dims_f",error, total_error)
- CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), dim0, total_error)
+ CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
ALLOCATE(rdata(1:dims(1)))
!
! Read the data.
@@ -1777,7 +1778,7 @@ SUBROUTINE t_opaque(total_error)
CALL check("H5Dread_f",error, total_error)
!
DO i = 1, dims(1)
- CALL verifystring("t_opaque",TRIM(rdata(i)),TRIM(wdata(i)), total_error)
+ CALL verify("t_opaque",TRIM(rdata(i)),TRIM(wdata(i)), total_error)
ENDDO
!
! Close and release resources.
@@ -1796,10 +1797,6 @@ END SUBROUTINE t_opaque
SUBROUTINE t_objref(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1892,7 +1889,7 @@ SUBROUTINE t_objref(total_error)
CALL check("H5Dget_space_f",error, total_error)
CALL h5sget_simple_extent_dims_f(space, dims, maxdims, error)
CALL check("H5Sget_simple_extent_dims_f",error, total_error)
- CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), dim0, total_error)
+ CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
ALLOCATE(rdata(1:maxdims(1)))
!
@@ -1923,9 +1920,9 @@ SUBROUTINE t_objref(total_error)
! Print the object type and close the object.
!
IF(objtype.EQ.H5G_GROUP_F)THEN
- CALL verifystring("t_objref", name(1:name_size),"/G1", total_error)
+ CALL verify("t_objref", name(1:name_size),"/G1", total_error)
ELSE IF(objtype.EQ.H5G_DATASET_F)THEN
- CALL verifystring("t_objref", name(1:name_size),"/DS2", total_error)
+ CALL verify("t_objref", name(1:name_size),"/DS2", total_error)
ELSE
total_error = total_error + 1
ENDIF
@@ -1949,10 +1946,6 @@ END SUBROUTINE t_objref
SUBROUTINE t_regref(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -2075,7 +2068,7 @@ SUBROUTINE t_regref(total_error)
CALL check("H5Dget_space_f",error, total_error)
CALL h5sget_simple_extent_dims_f(space, dims, maxdims, error)
CALL check("H5Sget_simple_extent_dims_f",error, total_error)
- CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), dim0, total_error)
+ CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
ALLOCATE(rdata(1:dims(1)))
CALL h5sclose_f(space, error)
CALL check("h5sclose_f",error, total_error)
@@ -2108,7 +2101,7 @@ SUBROUTINE t_regref(total_error)
CALL H5Iget_name_f(dset2, name, 80_size_t, size, error)
CALL check("H5Iget_name_f",error, total_error)
CALL VERIFY("H5Iget_name_f", INT(size), LEN_TRIM(name), total_error)
- CALL verifystring("H5Iget_name_f",name(1:size),TRIM(name), total_error)
+ CALL verify("H5Iget_name_f",name(1:size),TRIM(name), total_error)
!
! Allocate space for the read buffer.
!
@@ -2126,7 +2119,7 @@ SUBROUTINE t_regref(total_error)
f_ptr = C_LOC(rdata2(1)(1:1))
CALL h5dread_f( dset2, H5T_NATIVE_INTEGER_1, f_ptr, error, memspace, space)
CALL check("H5Dread_f",error, total_error)
- CALL verifystring("h5dread_f",rdata2(1)(1:npoints),TRIM(chrref_correct(i)), total_error)
+ CALL verify("h5dread_f",rdata2(1)(1:npoints),TRIM(chrref_correct(i)), total_error)
CALL H5Sclose_f(space, error)
CALL check("h5sclose_f",error, total_error)
@@ -2149,10 +2142,6 @@ END SUBROUTINE t_regref
SUBROUTINE t_vlen(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -2307,10 +2296,6 @@ END SUBROUTINE t_vlen
SUBROUTINE t_vlstring(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -2409,7 +2394,7 @@ SUBROUTINE t_vlstring(total_error)
! Output the data to the screen.
!
DO i = 1, dims(1)
- CALL verifystring("h5dopen_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
+ CALL verify("h5dopen_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
END DO
DEALLOCATE(rdata)
@@ -2428,10 +2413,6 @@ SUBROUTINE t_vlstring_readwrite(total_error)
! test writing and reading vl string using h5dread_f and h5dwrite_f, C_LOC and C_F_POINTER
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -2611,7 +2592,7 @@ SUBROUTINE t_vlstring_readwrite(total_error)
IF(DATA(len+1:len+1).EQ.C_NULL_CHAR.OR.len.GE.8) EXIT
len = len + 1
ENDDO
- CALL verifystring("h5dread_f",data(1:len), data_w(i)(1:len), total_error)
+ CALL verify("h5dread_f",data(1:len), data_w(i)(1:len), total_error)
END DO
DEALLOCATE(rdata)
@@ -2659,7 +2640,7 @@ SUBROUTINE t_vlstring_readwrite(total_error)
IF(DATA(len+1:len+1).EQ.C_NULL_CHAR.OR.len.GE.8) EXIT
len = len + 1
ENDDO
- CALL verifystring("h5dread_f",DATA(1:len), data2D_w(i,j)(1:len), total_error)
+ CALL verify("h5dread_f",DATA(1:len), data2D_w(i,j)(1:len), total_error)
ENDDO
END DO
@@ -2679,10 +2660,6 @@ END SUBROUTINE t_vlstring_readwrite
SUBROUTINE t_string(total_error)
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -2766,7 +2743,7 @@ SUBROUTINE t_string(total_error)
CALL check("H5Dget_space_f",error, total_error)
CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
CALL check("H5Sget_simple_extent_dims_f",error, total_error)
- CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), dim0, total_error)
+ CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error)
ALLOCATE(rdata(1:dims(1)))
!
@@ -2784,7 +2761,7 @@ SUBROUTINE t_string(total_error)
CALL check("H5Dread_f",error, total_error)
DO i = 1, dims(1)
- CALL verifystring("h5dread_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
+ CALL verify("h5dread_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
END DO
DEALLOCATE(rdata)
@@ -2806,8 +2783,6 @@ END SUBROUTINE t_string
SUBROUTINE vl_test_special_char(total_error)
- USE HDF5
- USE TH5_MISC
IMPLICIT NONE
! INTERFACE
@@ -2909,9 +2884,6 @@ END SUBROUTINE vl_test_special_char
SUBROUTINE setup_buffer(data_in, line_lengths, char_type)
- USE HDF5
- USE ISO_C_BINDING
-
IMPLICIT NONE
! Creates a simple "Data_in" consisting of the letters of the alphabet,
@@ -2973,12 +2945,8 @@ END SUBROUTINE setup_buffer
SUBROUTINE test_nbit(total_error )
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
-
IMPLICIT NONE
- INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
+ INTEGER, PARAMETER :: wp = C_FLOAT !should map to REAL*4 on most modern processors
INTEGER, INTENT(INOUT) :: total_error
INTEGER(hid_t) :: file
@@ -3068,8 +3036,10 @@ 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.dreal_eq( REAL(new_data(i,j),dp), REAL( orig_data(i,j), dp)) ) THEN
+
+ IF( .NOT.check_real_eq( new_data(i,j), orig_data(i,j)) ) THEN
total_error = total_error + 1
WRITE(*,'(" Read different values than written.")')
WRITE(*,'(" At index ", 2(1X,I0))') i, j
@@ -3117,18 +3087,15 @@ SUBROUTINE t_enum_conv(total_error)
! No reliance on C tests.
!-------------------------------------------------------------------------
!
- USE HDF5
- USE TH5_MISC
- USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
- INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) !should map to INTEGER*4 on most modern processors
- INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(Fortran_INTEGER_8)!should map to INTEGER*8 on most modern processors
+ INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors
+ INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors
- INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
+ INTEGER, PARAMETER :: real_kind_7 = C_FLOAT !should map to REAL*4 on most modern processors
INTEGER(hid_t) :: cwg=-1, dtype=-1, space=-1, dset=-1 ! Handles
INTEGER(hid_t) :: file ! Handles
@@ -3188,20 +3155,25 @@ SUBROUTINE t_enum_conv(total_error)
!
! Initialize enum data.
!
+
val = E1_RED
CALL H5Tenum_insert_f(dtype, "RED", C_LOC(val), error)
CALL check("h5tenum_insert_f",error, total_error)
val = E1_GREEN
- CALL H5Tenum_insert_f(dtype, "GREEN", C_LOC(val), error)
+ f_ptr = C_LOC(val)
+ CALL H5Tenum_insert_f(dtype, "GREEN", f_ptr, error)
CALL check("h5tenum_insert_f",error, total_error)
val = E1_BLUE
- CALL H5Tenum_insert_f(dtype, "BLUE", C_LOC(val), error)
+ f_ptr = C_LOC(val)
+ CALL H5Tenum_insert_f(dtype, "BLUE", f_ptr, error)
CALL check("h5tenum_insert_f",error, total_error)
val = E1_WHITE
- CALL H5Tenum_insert_f(dtype, "WHITE", C_LOC(val), error)
+ f_ptr = C_LOC(val)
+ CALL H5Tenum_insert_f(dtype, "WHITE", f_ptr, error)
CALL check("h5tenum_insert_f",error, total_error)
val = E1_BLACK
- CALL H5Tenum_insert_f(dtype, "BLACK", C_LOC(val), error)
+ f_ptr = C_LOC(val)
+ CALL H5Tenum_insert_f(dtype, "BLACK", f_ptr, error)
CALL check("h5tenum_insert_f",error, total_error)
!
! Create dataspace. Setting maximum size to be the current size.
@@ -3268,8 +3240,8 @@ SUBROUTINE t_enum_conv(total_error)
ENDIF
ENDDO
- ! Test converting the data to (SELECTED_INT_KIND(Fortran_INTEGER_4)) number.
- ! Read enum data back as (SELECTED_INT_KIND(Fortran_INTEGER_4)) number
+ ! Test converting the data to (SELECTED_INT_KIND(9)) number.
+ ! Read enum data back as (SELECTED_INT_KIND(9)) number
m_baset = h5kind_to_type(int_kind_8, H5_INTEGER_KIND) ! Memory base type
f_ptr = C_LOC(data_i8(1))
@@ -3285,8 +3257,8 @@ SUBROUTINE t_enum_conv(total_error)
ENDIF
ENDDO
- ! Test converting the data to (SELECTED_INT_KIND(Fortran_INTEGER_8)) number.
- ! Read enum data back as (SELECTED_INT_KIND(Fortran_INTEGER_8)) number
+ ! Test converting the data to (SELECTED_INT_KIND(18)) number.
+ ! Read enum data back as (SELECTED_INT_KIND(18)) number
m_baset = h5kind_to_type(int_kind_16, H5_INTEGER_KIND) ! Memory base type
f_ptr = C_LOC(data_i16(1))
@@ -3302,8 +3274,8 @@ SUBROUTINE t_enum_conv(total_error)
ENDIF
ENDDO
- ! Test converting the data to SELECTED_REAL_KIND(Fortran_REAL_4) number.
- ! Read enum data back as SELECTED_REAL_KIND(Fortran_REAL_4) number
+ ! Test converting the data to C_FLOAT number.
+ ! Read enum data back as C_FLOAT number
m_baset = h5kind_to_type(KIND(data_r7(1)), H5_REAL_KIND) ! Memory base type
f_ptr = C_LOC(data_r7(1))
@@ -3380,10 +3352,10 @@ SUBROUTINE t_enum_conv(total_error)
CALL check("h5dclose_f", error, total_error)
!*********************************************************
- !* Dataset of real SELECTED_REAL_KIND(Fortran_REAL_4) type
+ !* Dataset of real C_FLOAT type
!*********************************************************
- ! Create a dataset of SELECTED_REAL_KIND(Fortran_REAL_4) and write enum data to it
+ ! Create a dataset of C_FLOAT and write enum data to it
m_baset = h5kind_to_type(KIND(data_r7(1)), H5_REAL_KIND) ! Memory base type
CALL h5dcreate_f(cwg, "color_table4", m_baset, space, dset, error)
CALL check("h5dcreate_f", error, total_error)
@@ -3408,10 +3380,10 @@ SUBROUTINE t_enum_conv(total_error)
CALL check("h5dclose_f", error, total_error)
! *****************************************************************
- ! * Dataset of integer SELECTED_INT_KIND(Fortran_INTEGER_8) type
+ ! * Dataset of integer SELECTED_INT_KIND(18) type
! *****************************************************************
- ! Create a integer dataset of (SELECTED_INT_KIND(Fortran_INTEGER_8)) and write enum data to it
+ ! Create a integer dataset of (SELECTED_INT_KIND(18)) and write enum data to it
m_baset = h5kind_to_type(KIND(data_i16(1)), H5_INTEGER_KIND) ! Memory base type
CALL h5dcreate_f(cwg, "color_table5", m_baset, space, dset, error)
CALL check("h5dcreate_f", error, total_error)
diff --git a/fortran/test/tH5VL.f90 b/fortran/test/tH5VL.f90
index 651ca75..834fbde 100644
--- a/fortran/test/tH5VL.f90
+++ b/fortran/test/tH5VL.f90
@@ -28,12 +28,13 @@
!*****
MODULE TH5VL
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ USE TH5_MISC_GEN
CONTAINS
SUBROUTINE vl_test_integer(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -194,8 +195,6 @@ CONTAINS
END SUBROUTINE vl_test_integer
SUBROUTINE vl_test_real(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -328,18 +327,15 @@ CONTAINS
CALL h5dread_vl_f(dset_id, vltype_id, vl_real_data_out, data_dims, len_out, &
error, mem_space_id = dspace_id, file_space_id = dspace_id)
CALL check("h5dread_real_f", error, total_error)
- do ih = 1, data_dims(2)
- do jh = 1, len_out(ih)
- 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
- write(*,*) "h5dread_vl_f returned incorrect data"
- endif
- enddo
+ DO ih = 1, data_dims(2)
+ DO jh = 1, len_out(ih)
+ CALL VERIFY("h5dread_vl_f returned incorrect data",vl_real_data(jh,ih),vl_real_data_out(jh,ih), total_error)
+ ENDDO
+ IF (LEN(ih) .NE. len_out(ih)) THEN
+ total_error = total_error + 1
+ WRITE(*,*) "h5dread_vl_f returned incorrect data"
+ ENDIF
+ ENDDO
!
@@ -367,8 +363,6 @@ CONTAINS
END SUBROUTINE vl_test_real
SUBROUTINE vl_test_string(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
- USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
diff --git a/fortran/test/tHDF5.f90 b/fortran/test/tHDF5.f90
index e73fed2..d12bb25 100644
--- a/fortran/test/tHDF5.f90
+++ b/fortran/test/tHDF5.f90
@@ -29,6 +29,7 @@
MODULE THDF5
USE TH5_MISC
+ USE TH5_MISC_GEN
USE TH5A
USE TH5D
USE TH5E
diff --git a/fortran/test/tf.f90 b/fortran/test/tf.F90
index 450daf2..7d67f30 100644
--- a/fortran/test/tf.f90
+++ b/fortran/test/tf.F90
@@ -27,43 +27,35 @@
! h5_cleanup_f, h5_exit_f, h5_env_nocleanup_f,dreal_eqv
!
!*****
-MODULE TH5_MISC
- USE TH5_MISC_PROVISIONAL
+#include "H5config_f.inc"
- IMPLICIT NONE
+MODULE TH5_MISC
-CONTAINS
+ USE, INTRINSIC :: ISO_C_BINDING
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: dreal_eq
-!DEC$endif
- 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
+ IMPLICIT NONE
- END FUNCTION dreal_eq
+ INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(5) ! This should map to REAL*4 on most modern processors
+ INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors
+
+ ! generic compound datatype
+ TYPE, BIND(C) :: comp_datatype
+ REAL :: a
+ INTEGER :: x
+ DOUBLE PRECISION :: y
+ CHARACTER(KIND=C_CHAR) :: z
+ END TYPE comp_datatype
+
+ PUBLIC :: H5_SIZEOF
+ INTERFACE H5_SIZEOF
+ MODULE PROCEDURE H5_SIZEOF_CMPD
+ MODULE PROCEDURE H5_SIZEOF_CHR
+ MODULE PROCEDURE H5_SIZEOF_I
+ MODULE PROCEDURE H5_SIZEOF_SP,H5_SIZEOF_DP
+ END INTERFACE
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_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
- 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
+CONTAINS
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_TEST_DLL)
@@ -118,84 +110,6 @@ CONTAINS
RETURN
END SUBROUTINE check
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_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
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: verify_INTEGER_HID_T
-!DEC$endif
- SUBROUTINE verify_INTEGER_HID_T(string,value,correct_value,total_error)
- USE HDF5
- CHARACTER(LEN=*) :: string
- INTEGER(HID_T) :: 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_INTEGER_HID_T
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_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
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_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
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_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
-
-
!----------------------------------------------------------------------
! Name: h5_fixname_f
!
@@ -390,4 +304,109 @@ CONTAINS
IF(status.EQ.1) HDF5_NOCLEANUP = .TRUE.
END SUBROUTINE h5_env_nocleanup_f
+
+! ---------------------------------------------------------------------------------------------------
+! H5_SIZEOF routines
+!
+! NOTES
+! (1) The Sun/Oracle compiler has the following restrictions on the SIZEOF intrinsic function:
+!
+! "The SIZEOF intrinsic cannot be applied to arrays of an assumed size, characters of a
+! length that is passed, or subroutine calls or names. SIZEOF returns default INTEGER*4 data.
+! If compiling for a 64-bit environment, the compiler will issue a warning if the result overflows
+! the INTEGER*4 data range. To use SIZEOF in a 64-bit environment with arrays larger
+! than the INTEGER*4 limit (2 Gbytes), the SIZEOF function and
+! the variables receiving the result must be declared INTEGER*8."
+!
+! Thus, we can not overload the H5_SIZEOF function to handle arrays (as used in tH5P_F03.f90), or
+! characters that do not have a set length (as used in tH5P_F03.f90), sigh...
+!
+! (2) F08+TS29113 requires C interoperable variable as argument for C_SIZEOF.
+!
+! (3) Unfortunately we need to wrap the C_SIZEOF/STORAGE_SIZE functions to handle different
+! data types from the various tests.
+!
+! ---------------------------------------------------------------------------------------------------
+
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_TEST_DLL)
+!DEC$attributes dllexport :: h5_sizeof_cmpd
+!DEC$endif
+ INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_CMPD(a)
+ IMPLICIT NONE
+ TYPE(comp_datatype), INTENT(in) :: a
+
+#ifdef H5_FORTRAN_FORTRAN_HAVE_C_SIZEOF
+ H5_SIZEOF_CMPD = C_SIZEOF(a)
+#else
+ H5_SIZEOF_CMPD = SIZEOF(a)
+#endif
+
+ END FUNCTION H5_SIZEOF_CMPD
+
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_TEST_DLL)
+!DEC$attributes dllexport :: h5_sizeof_chr
+!DEC$endif
+ INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_CHR(a)
+ IMPLICIT NONE
+ CHARACTER(LEN=1), INTENT(in) :: a
+
+#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
+ H5_SIZEOF_CHR = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t)
+#else
+ H5_SIZEOF_CHR = SIZEOF(a)
+#endif
+
+ END FUNCTION H5_SIZEOF_CHR
+
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_TEST_DLL)
+!DEC$attributes dllexport :: h5_sizeof_i
+!DEC$endif
+ INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_I(a)
+ IMPLICIT NONE
+ INTEGER, INTENT(in):: a
+
+#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
+ H5_SIZEOF_I = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t)
+#else
+ H5_SIZEOF_I = SIZEOF(a)
+#endif
+
+ END FUNCTION H5_SIZEOF_I
+
+
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_TEST_DLL)
+!DEC$attributes dllexport :: h5_sizeof_sp
+!DEC$endif
+ INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_SP(a)
+ IMPLICIT NONE
+ REAL(sp), INTENT(in):: a
+
+#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
+ H5_SIZEOF_SP = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t)
+#else
+ H5_SIZEOF_SP = SIZEOF(a)
+#endif
+
+ END FUNCTION H5_SIZEOF_SP
+
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_TEST_DLL)
+!DEC$attributes dllexport :: h5_sizeof_dp
+!DEC$endif
+ INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_DP(a)
+ IMPLICIT NONE
+ REAL(dp), INTENT(in):: a
+
+#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
+ H5_SIZEOF_DP = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t)
+#else
+ H5_SIZEOF_DP = SIZEOF(a)
+#endif
+
+ END FUNCTION H5_SIZEOF_DP
+
END MODULE TH5_MISC
diff --git a/fortran/test/tf_F03.f90 b/fortran/test/tf_F03.f90
deleted file mode 100644
index b3f1399..0000000
--- a/fortran/test/tf_F03.f90
+++ /dev/null
@@ -1,128 +0,0 @@
-!****h* root/fortran/test/tf_F03.f90
-!
-! NAME
-! tf_F03.f90
-!
-! FUNCTION
-! Contains functions that are part of the F2003 standard, and are not F2008 compliant.
-! Needed by the hdf5 fortran tests.
-!
-! 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
-! H5_SIZEOF
-!
-! NOTES
-! The Sun/Oracle compiler has the following restrictions on the SIZEOF intrinsic function:
-!
-! "The SIZEOF intrinsic cannot be applied to arrays of an assumed size, characters of a
-! length that is passed, or subroutine calls or names. SIZEOF returns default INTEGER*4 data.
-! If compiling for a 64-bit environment, the compiler will issue a warning if the result overflows
-! the INTEGER*4 data range. To use SIZEOF in a 64-bit environment with arrays larger
-! than the INTEGER*4 limit (2 Gbytes), the SIZEOF function and
-! the variables receiving the result must be declared INTEGER*8."
-!
-! Thus, we can not overload the H5_SIZEOF function to handle arrays (as used in tH5P_F03.f90), or
-! characters that do not have a set length (as used in tH5P_F03.f90), sigh...
-!
-!*****
-MODULE TH5_MISC_PROVISIONAL
-
- USE ISO_C_BINDING
- IMPLICIT NONE
-
- INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(5) ! This should map to REAL*4 on most modern processors
- INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors
-
- ! generic compound datatype
- TYPE, BIND(C) :: comp_datatype
- REAL :: a
- INTEGER :: x
- DOUBLE PRECISION :: y
- CHARACTER(LEN=1) :: z
- END TYPE comp_datatype
-
- PUBLIC :: H5_SIZEOF
- INTERFACE H5_SIZEOF
- MODULE PROCEDURE H5_SIZEOF_CMPD
- MODULE PROCEDURE H5_SIZEOF_I, H5_SIZEOF_CHR
- MODULE PROCEDURE H5_SIZEOF_SP,H5_SIZEOF_DP
- END INTERFACE
-
-CONTAINS
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: h5_sizeof_cmpd
- !DEC$endif
- INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_CMPD(a)
- IMPLICIT NONE
- TYPE(comp_datatype), INTENT(in) :: a
-
- H5_SIZEOF_CMPD = SIZEOF(a)
-
- END FUNCTION H5_SIZEOF_CMPD
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: h5_sizeof_chr
-!DEC$endif
- INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_CHR(a)
- IMPLICIT NONE
- CHARACTER(LEN=1), INTENT(in):: a
-
- H5_SIZEOF_CHR = SIZEOF(a)
-
- END FUNCTION H5_SIZEOF_CHR
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: h5_sizeof_i
-!DEC$endif
- INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_I(a)
- IMPLICIT NONE
- INTEGER, INTENT(in):: a
-
- H5_SIZEOF_I = SIZEOF(a)
-
- END FUNCTION H5_SIZEOF_I
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: h5_sizeof_sp
-!DEC$endif
- INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_SP(a)
- IMPLICIT NONE
- REAL(sp), INTENT(in):: a
-
- H5_SIZEOF_SP = SIZEOF(a)
-
- END FUNCTION H5_SIZEOF_SP
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: h5_sizeof_dp
-!DEC$endif
- INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_DP(a)
- IMPLICIT NONE
- REAL(dp), INTENT(in):: a
-
- H5_SIZEOF_DP = SIZEOF(a)
-
- END FUNCTION H5_SIZEOF_DP
-
-END MODULE TH5_MISC_PROVISIONAL
diff --git a/fortran/test/tf_F08.f90 b/fortran/test/tf_F08.f90
deleted file mode 100644
index 20c2859..0000000
--- a/fortran/test/tf_F08.f90
+++ /dev/null
@@ -1,128 +0,0 @@
-!****h* root/fortran/test/tf_F08.f90
-!
-! NAME
-! tf_F08.f90
-!
-! FUNCTION
-! Contains functions that are part of the F2008 standard and needed by
-! the hdf5 fortran tests.
-!
-! 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
-! H5_SIZEOF
-!
-! NOTES
-! This file contains "sizeof" functions that are F2008 standard compliant
-! and replace the non-standard 'SIZEOF' functions found in the file tf_F03.
-! Unfortunity we need to wrap the C_SIZEOF/STORAGE_SIZE functions to handle different
-! data types from the various tests.
-!
-! F08+TS29113 requires C interoperable variable as argument for C_SIZEOF.
-!
-! This file will be build instead of tf_F03.f90 if the intrinsic fortran
-! function C_SIZEOF/STORAGE_SIZE is found during configure.
-!
-!*****
-MODULE TH5_MISC_PROVISIONAL
-
- USE ISO_C_BINDING
- IMPLICIT NONE
-
- INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(5) ! This should map to REAL*4 on most modern processors
- INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors
-
- ! generic compound datatype
- TYPE, BIND(C) :: comp_datatype
- REAL :: a
- INTEGER :: x
- DOUBLE PRECISION :: y
- CHARACTER(LEN=1) :: z
- END TYPE comp_datatype
-
- PUBLIC :: H5_SIZEOF
- INTERFACE H5_SIZEOF
- MODULE PROCEDURE H5_SIZEOF_CMPD
- MODULE PROCEDURE H5_SIZEOF_CHR
- MODULE PROCEDURE H5_SIZEOF_I
- MODULE PROCEDURE H5_SIZEOF_SP,H5_SIZEOF_DP
- END INTERFACE
-
-CONTAINS
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: h5_sizeof_cmpd
-!DEC$endif
- INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_CMPD(a)
- IMPLICIT NONE
- TYPE(comp_datatype), INTENT(in) :: a
-
- H5_SIZEOF_CMPD = C_SIZEOF(a)
-
- END FUNCTION H5_SIZEOF_CMPD
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: h5_sizeof_chr
-!DEC$endif
- INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_CHR(a)
- IMPLICIT NONE
- CHARACTER(LEN=*), INTENT(in) :: a
-
- H5_SIZEOF_CHR = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t)
-
- END FUNCTION H5_SIZEOF_CHR
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: h5_sizeof_i
-!DEC$endif
- INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_I(a)
- IMPLICIT NONE
- INTEGER, INTENT(in):: a
-
- H5_SIZEOF_I = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t)
-
- END FUNCTION H5_SIZEOF_I
-
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: h5_sizeof_sp
-!DEC$endif
- INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_SP(a)
- IMPLICIT NONE
- REAL(sp), INTENT(in):: a
-
- H5_SIZEOF_SP = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t)
-
- END FUNCTION H5_SIZEOF_SP
-
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_TEST_DLL)
-!DEC$attributes dllexport :: h5_sizeof_dp
-!DEC$endif
- INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_DP(a)
- IMPLICIT NONE
- REAL(dp), INTENT(in):: a
-
- H5_SIZEOF_DP = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t)
-
- END FUNCTION H5_SIZEOF_DP
-
-END MODULE TH5_MISC_PROVISIONAL
diff --git a/fortran/test/tf_F90.f90 b/fortran/test/tf_F90.f90
deleted file mode 100644
index 11a047c..0000000
--- a/fortran/test/tf_F90.f90
+++ /dev/null
@@ -1,33 +0,0 @@
-!****h* root/fortran/test/tf_F90.f90
-!
-! NAME
-! tf_F90.f90
-!
-! FUNCTION
-! Module for when the compiler is not F2003 or F2008 compliant.
-! Needed by tf.f90 for the test programs.
-!
-! 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. *
-! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-!
-!*****
-MODULE TH5_MISC_PROVISIONAL
- IMPLICIT NONE
-
- INTEGER, PARAMETER :: sp = KIND(0.0)
- INTEGER, PARAMETER :: dp = KIND(0.D0)
-
-END MODULE TH5_MISC_PROVISIONAL