diff options
40 files changed, 1154 insertions, 844 deletions
@@ -363,6 +363,7 @@ ./fortran/test/tH5G_1_8.f90 ./fortran/test/tH5I.f90 ./fortran/test/tH5L_F03.f90 +./fortran/test/tH5MISC_1_8.f90 ./fortran/test/tH5O.f90 ./fortran/test/tH5O_F03.f90 ./fortran/test/tH5P_F03.f90 @@ -374,6 +375,9 @@ ./fortran/test/tH5T.f90 ./fortran/test/tH5VL.f90 ./fortran/test/tH5Z.f90 +./fortran/test/tHDF5_1_8.f90 +./fortran/test/tHDF5_F03.f90 +./fortran/test/tHDF5.f90 ./fortran/testpar/Makefile.am ./fortran/testpar/Makefile.in diff --git a/fortran/examples/h5_extend.f90 b/fortran/examples/h5_extend.f90 index 1316281..315d84f 100644 --- a/fortran/examples/h5_extend.f90 +++ b/fortran/examples/h5_extend.f90 @@ -73,7 +73,7 @@ PROGRAM H5_EXTEND ! !general purpose integer ! - INTEGER :: i, j + INTEGER(HSIZE_T) :: i, j ! !flag to check operation success diff --git a/fortran/examples/hyperslab.f90 b/fortran/examples/hyperslab.f90 index ca27f35..7823ff6 100644 --- a/fortran/examples/hyperslab.f90 +++ b/fortran/examples/hyperslab.f90 @@ -33,8 +33,6 @@ INTEGER(HSIZE_T), DIMENSION(3) :: dimsm = (/7,7,3/) ! Dataset dimensions ! in memory - INTEGER(HSIZE_T), DIMENSION(2) :: dims_out ! Buffer to read in dataset - ! dimesions INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/5,6/) ! Dataset dimensions. INTEGER(HSIZE_T), DIMENSION(2) :: count = (/3,4/) @@ -49,16 +47,15 @@ INTEGER, DIMENSION(7,7,3) :: data_out ! Output buffer INTEGER :: dsetrank = 2 ! Dataset rank ( in file ) INTEGER :: memrank = 3 ! Dataset rank ( in memory ) - INTEGER :: rank INTEGER :: i, j, k - INTEGER :: error, error_n ! Error flags + INTEGER :: error ! Error flag INTEGER(HSIZE_T), DIMENSION(3) :: data_dims - ! - ! Write data to the HDF5 file. - ! + ! + ! Write data to the HDF5 file. + ! ! ! Data initialization. diff --git a/fortran/examples/rwdset_fortran2003.f90 b/fortran/examples/rwdset_fortran2003.f90 index 74bda85..d65db9e 100644 --- a/fortran/examples/rwdset_fortran2003.f90 +++ b/fortran/examples/rwdset_fortran2003.f90 @@ -53,13 +53,11 @@ PROGRAM RWDSET_FORTRAN2003 INTEGER(HID_T) :: dset_idr8 ! Dataset identifier INTEGER :: error ! Error flag - INTEGER :: i, j + INTEGER :: i ! Data buffers: - INTEGER, DIMENSION(1:4) :: dset_data - - INTEGER(int_kind_1), DIMENSION(1:4), TARGET :: dset_data_i1, data_out_i1 + INTEGER(int_kind_1), DIMENSION(1:4), TARGET :: dset_data_i1 INTEGER(int_kind_4), DIMENSION(1:4), TARGET :: dset_data_i4, data_out_i4 INTEGER(int_kind_8), DIMENSION(1:4), TARGET :: dset_data_i8, data_out_i8 INTEGER(int_kind_16), DIMENSION(1:4), TARGET :: dset_data_i16, data_out_i16 @@ -73,7 +71,6 @@ PROGRAM RWDSET_FORTRAN2003 INTEGER(HID_T) :: dspace_id ! Dataspace identifier TYPE(C_PTR) :: f_ptr - INTEGER(hid_t) :: datatype !/* Common datatype ID */ ! ! Initialize FORTRAN interface. diff --git a/fortran/examples/selectele.f90 b/fortran/examples/selectele.f90 index 3ab7ebc..dcd2379 100644 --- a/fortran/examples/selectele.f90 +++ b/fortran/examples/selectele.f90 @@ -64,14 +64,13 @@ INTEGER :: i, j INTEGER :: error ! Error flag - LOGICAL :: status INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - ! - ! Create two files containing identical datasets. Write 0's to one - ! and 1's to the other. - ! + ! + ! Create two files containing identical datasets. Write 0's to one + ! and 1's to the other. + ! ! ! Data initialization. diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt index dac8243..17c55a5 100644 --- a/fortran/test/CMakeLists.txt +++ b/fortran/test/CMakeLists.txt @@ -65,6 +65,7 @@ add_executable (testhdf5_fortran tH5T.f90 tH5VL.f90 tH5Z.f90 + tHDF5.f90 ) TARGET_NAMING (testhdf5_fortran ${LIB_TYPE}) TARGET_FORTRAN_PROPERTIES (testhdf5_fortran " " " ") @@ -86,6 +87,8 @@ add_executable (testhdf5_fortran_1_8 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 + tH5MISC_1_8.f90 + tHDF5_1_8.f90 ) TARGET_NAMING (testhdf5_fortran_1_8 ${LIB_TYPE}) TARGET_FORTRAN_PROPERTIES (testhdf5_fortran_1_8 " " " ") @@ -111,6 +114,7 @@ if (HDF5_ENABLE_F2003) tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 + tHDF5_F03.f90 ) TARGET_NAMING (fortranlib_test_F03 ${LIB_TYPE}) TARGET_FORTRAN_PROPERTIES (fortranlib_test_F03 " " " ") diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am index ea58b2d..a9efb7f 100644 --- a/fortran/test/Makefile.am +++ b/fortran/test/Makefile.am @@ -17,7 +17,8 @@ # # HDF5-Fortran test/Makefile(.in) # - +# Autoconf cannot figure out dependencies between modules; disable parallel make +.NOTPARALLEL: include $(top_srcdir)/config/commence.am # Include files @@ -59,16 +60,15 @@ libh5test_fortran_la_SOURCES= tf.f90 t.c fortranlib_test_FCFLAGS=$(AM_FCFLAGS) fortranlib_test_CFLAGS=$(AM_CFLAGS) -fortranlib_test_SOURCES = fortranlib_test.f90 \ - 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 +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 = fortranlib_test_1_8.f90 \ - tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 +fortranlib_test_1_8_SOURCES = tH5F.f90 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 = fortranlib_test_F03.f90 \ - tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 + fortranlib_test_F03_SOURCES = tH5F.f90 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 diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in index e827662..f3b918c 100644 --- a/fortran/test/Makefile.in +++ b/fortran/test/Makefile.in @@ -14,23 +14,6 @@ @SET_MAKE@ -# -# 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. -# -# HDF5-Fortran test/Makefile(.in) -# - VPATH = @srcdir@ am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' am__make_running_with_option = \ @@ -138,16 +121,15 @@ fflush2_OBJECTS = $(am_fflush2_OBJECTS) fflush2_LDADD = $(LDADD) fflush2_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) $(LIBH5F) \ $(LIBHDF5) -am_fortranlib_test_OBJECTS = \ - fortranlib_test-fortranlib_test.$(OBJEXT) \ - fortranlib_test-tH5F.$(OBJEXT) fortranlib_test-tH5D.$(OBJEXT) \ - fortranlib_test-tH5R.$(OBJEXT) fortranlib_test-tH5S.$(OBJEXT) \ - fortranlib_test-tH5T.$(OBJEXT) fortranlib_test-tH5VL.$(OBJEXT) \ - fortranlib_test-tH5Z.$(OBJEXT) \ +am_fortranlib_test_OBJECTS = fortranlib_test-tH5F.$(OBJEXT) \ + fortranlib_test-tH5D.$(OBJEXT) fortranlib_test-tH5R.$(OBJEXT) \ + fortranlib_test-tH5S.$(OBJEXT) fortranlib_test-tH5T.$(OBJEXT) \ + fortranlib_test-tH5VL.$(OBJEXT) fortranlib_test-tH5Z.$(OBJEXT) \ fortranlib_test-tH5Sselect.$(OBJEXT) \ fortranlib_test-tH5P.$(OBJEXT) fortranlib_test-tH5A.$(OBJEXT) \ fortranlib_test-tH5I.$(OBJEXT) fortranlib_test-tH5G.$(OBJEXT) \ - fortranlib_test-tH5E.$(OBJEXT) + fortranlib_test-tH5E.$(OBJEXT) fortranlib_test-tHDF5.$(OBJEXT) \ + fortranlib_test-fortranlib_test.$(OBJEXT) fortranlib_test_OBJECTS = $(am_fortranlib_test_OBJECTS) fortranlib_test_LDADD = $(LDADD) fortranlib_test_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \ @@ -156,24 +138,26 @@ fortranlib_test_LINK = $(LIBTOOL) $(AM_V_lt) --tag=FC \ $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=link $(FCLD) \ $(fortranlib_test_FCFLAGS) $(FCFLAGS) $(AM_LDFLAGS) $(LDFLAGS) \ -o $@ -am_fortranlib_test_1_8_OBJECTS = fortranlib_test_1_8.$(OBJEXT) \ - tH5F.$(OBJEXT) tH5O.$(OBJEXT) tH5A_1_8.$(OBJEXT) \ - tH5G_1_8.$(OBJEXT) +am_fortranlib_test_1_8_OBJECTS = tH5F.$(OBJEXT) tH5O.$(OBJEXT) \ + tH5A_1_8.$(OBJEXT) tH5G_1_8.$(OBJEXT) tH5MISC_1_8.$(OBJEXT) \ + tHDF5_1_8.$(OBJEXT) fortranlib_test_1_8.$(OBJEXT) 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 = fortranlib_test_F03.f90 \ - tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 tH5O_F03.f90 \ - tH5P_F03.f90 tH5T_F03.f90 -@FORTRAN_2003_CONDITIONAL_F_TRUE@am_fortranlib_test_F03_OBJECTS = fortranlib_test_F03.$(OBJEXT) \ +am__fortranlib_test_F03_SOURCES_DIST = tH5F.f90 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@ tH5F.$(OBJEXT) \ @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@ tH5T_F03.$(OBJEXT) \ +@FORTRAN_2003_CONDITIONAL_F_TRUE@ tHDF5_F03.$(OBJEXT) \ +@FORTRAN_2003_CONDITIONAL_F_TRUE@ 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) \ @@ -763,15 +747,14 @@ libh5test_fortran_la_SOURCES = tf.f90 t.c # Automake will complain about this without the following workaround. fortranlib_test_FCFLAGS = $(AM_FCFLAGS) fortranlib_test_CFLAGS = $(AM_CFLAGS) -fortranlib_test_SOURCES = fortranlib_test.f90 \ - 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 +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 = fortranlib_test_1_8.f90 \ - tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 +fortranlib_test_1_8_SOURCES = tH5F.f90 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 = fortranlib_test_F03.f90 \ -@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 +@FORTRAN_2003_CONDITIONAL_F_TRUE@fortranlib_test_F03_SOURCES = tH5F.f90 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 fflush1_SOURCES = fflush1.f90 fflush2_SOURCES = fflush2.f90 @@ -920,12 +903,6 @@ distclean-compile: .f90.lo: $(AM_V_FC)$(LTFCCOMPILE) -c -o $@ $(FCFLAGS_f90) $< -fortranlib_test-fortranlib_test.o: fortranlib_test.f90 - $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-fortranlib_test.o $(FCFLAGS_f90) `test -f 'fortranlib_test.f90' || echo '$(srcdir)/'`fortranlib_test.f90 - -fortranlib_test-fortranlib_test.obj: fortranlib_test.f90 - $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-fortranlib_test.obj $(FCFLAGS_f90) `if test -f 'fortranlib_test.f90'; then $(CYGPATH_W) 'fortranlib_test.f90'; else $(CYGPATH_W) '$(srcdir)/fortranlib_test.f90'; fi` - fortranlib_test-tH5F.o: tH5F.f90 $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tH5F.o $(FCFLAGS_f90) `test -f 'tH5F.f90' || echo '$(srcdir)/'`tH5F.f90 @@ -1004,6 +981,18 @@ fortranlib_test-tH5E.o: tH5E.f90 fortranlib_test-tH5E.obj: tH5E.f90 $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tH5E.obj $(FCFLAGS_f90) `if test -f 'tH5E.f90'; then $(CYGPATH_W) 'tH5E.f90'; else $(CYGPATH_W) '$(srcdir)/tH5E.f90'; fi` +fortranlib_test-tHDF5.o: tHDF5.f90 + $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tHDF5.o $(FCFLAGS_f90) `test -f 'tHDF5.f90' || echo '$(srcdir)/'`tHDF5.f90 + +fortranlib_test-tHDF5.obj: tHDF5.f90 + $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tHDF5.obj $(FCFLAGS_f90) `if test -f 'tHDF5.f90'; then $(CYGPATH_W) 'tHDF5.f90'; else $(CYGPATH_W) '$(srcdir)/tHDF5.f90'; fi` + +fortranlib_test-fortranlib_test.o: fortranlib_test.f90 + $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-fortranlib_test.o $(FCFLAGS_f90) `test -f 'fortranlib_test.f90' || echo '$(srcdir)/'`fortranlib_test.f90 + +fortranlib_test-fortranlib_test.obj: fortranlib_test.f90 + $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-fortranlib_test.obj $(FCFLAGS_f90) `if test -f 'fortranlib_test.f90'; then $(CYGPATH_W) 'fortranlib_test.f90'; else $(CYGPATH_W) '$(srcdir)/fortranlib_test.f90'; fi` + mostlyclean-libtool: -rm -f *.lo @@ -1401,6 +1390,25 @@ uninstall-am: uninstall uninstall-am +# +# 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. +# +# HDF5-Fortran test/Makefile(.in) +# +# Autoconf cannot figure out dependencies between modules; disable parallel make +.NOTPARALLEL: + # List all build rules defined by HDF5 Makefiles as "PHONY" targets here. # This tells the Makefiles that these targets are not files to be built but # commands that should be executed even if a file with the same name already diff --git a/fortran/test/fflush1.f90 b/fortran/test/fflush1.f90 index d35bfff..ca2550f 100644 --- a/fortran/test/fflush1.f90 +++ b/fortran/test/fflush1.f90 @@ -30,6 +30,7 @@ PROGRAM FFLUSH1EXAMPLE USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE @@ -149,7 +150,7 @@ IF (total_error .ne. 0) CALL h5_exit_f (1) - 001 STOP + STOP END PROGRAM FFLUSH1EXAMPLE diff --git a/fortran/test/fflush2.f90 b/fortran/test/fflush2.f90 index d699150..04ce439 100644 --- a/fortran/test/fflush2.f90 +++ b/fortran/test/fflush2.f90 @@ -30,6 +30,7 @@ PROGRAM FFLUSH2EXAMPLE USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE @@ -39,7 +40,6 @@ ! !data space rank and dimensions ! - INTEGER, PARAMETER :: RANK = 2 INTEGER, PARAMETER :: NX = 4 INTEGER, PARAMETER :: NY = 5 diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90 index 6268d15..79ff161 100644 --- a/fortran/test/fortranlib_test.f90 +++ b/fortran/test/fortranlib_test.f90 @@ -27,6 +27,7 @@ PROGRAM fortranlibtest USE HDF5 + USE THDF5 IMPLICIT NONE INTEGER :: total_error = 0 @@ -72,14 +73,9 @@ PROGRAM fortranlibtest CALL reopentest(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Reopen test', total_error) -!DEC$ if defined(H5_VMS) - GOTO 8 -!DEC$ else ret_total_error = 0 CALL file_close(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' File open/close test', total_error) -!DEC$ endif -8 CONTINUE ret_total_error = 0 CALL file_space("file_space",cleanup, ret_total_error) @@ -143,11 +139,11 @@ PROGRAM fortranlibtest CALL write_test_status(ret_total_error, ' Element selection functions test ', total_error) ret_total_error = 0 - CALL test_select_combine(cleanup, ret_total_error) + CALL test_select_combine(ret_total_error) CALL write_test_status(ret_total_error, ' Selection combinations test ', total_error) ret_total_error = 0 - CALL test_select_bounds(cleanup, ret_total_error) + CALL test_select_bounds(ret_total_error) CALL write_test_status(ret_total_error, ' Selection bounds test ', total_error) ! write(*,*) @@ -155,7 +151,7 @@ PROGRAM fortranlibtest ! write(*,*) 'Testing DATATYPE interface ' ! write(*,*) '=========================================' ret_total_error = 0 - CALL basic_data_type_test(cleanup, ret_total_error) + CALL basic_data_type_test(ret_total_error) CALL write_test_status(ret_total_error, ' Basic datatype test', total_error) ret_total_error = 0 @@ -179,14 +175,9 @@ PROGRAM fortranlibtest CALL external_test(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' External dataset test', total_error) -!DEC$ if defined(H5_VMS) - GOTO 9 -!DEC$ else ret_total_error = 0 CALL multi_file_test(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Multi file driver test', total_error) -!DEC$ endif -9 CONTINUE ret_total_error = 0 CALL test_chunk_cache (cleanup, ret_total_error) @@ -211,7 +202,7 @@ PROGRAM fortranlibtest CALL write_test_status(ret_total_error, ' Identifier test', total_error) ret_total_error = 0 - CALL filters_test(cleanup, ret_total_error) + CALL filters_test(ret_total_error) CALL write_test_status(ret_total_error, ' Filters test', total_error) ret_total_error = 0 diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90 index dc45560..66f799b 100644 --- a/fortran/test/fortranlib_test_1_8.f90 +++ b/fortran/test/fortranlib_test_1_8.f90 @@ -27,7 +27,8 @@ PROGRAM fortranlibtest USE HDF5 - + USE THDF5_1_8 + USE TH5_MISC IMPLICIT NONE INTEGER :: total_error = 0 INTEGER :: error @@ -113,445 +114,3 @@ PROGRAM fortranlibtest IF (total_error .NE. 0) CALL h5_exit_f (1) END PROGRAM fortranlibtest - -SUBROUTINE dtransform(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - INTEGER(HID_T) :: dxpl_id_c_to_f - INTEGER(HID_T) :: file_id - - CHARACTER(LEN=15), PARAMETER :: c_to_f = "(9/5.0)*x + 123" - INTEGER :: error - CHARACTER(LEN=15) :: ptrgetTest - CHARACTER(LEN=7) :: ptrgetTest_small - CHARACTER(LEN=30) :: ptrgetTest_big - - INTEGER(SIZE_T) :: size - - CALL H5Fcreate_f("dtransform.h5", H5F_ACC_TRUNC_F, file_id, error) - CALL check("dtransform.H5Fcreate_f", error, total_error) - - CALL H5Pcreate_f(H5P_DATASET_XFER_F, dxpl_id_c_to_f, error) - CALL check("dtransform.H5Pcreate_f", error, total_error) - - CALL H5Pset_data_transform_f(dxpl_id_c_to_f, c_to_f, error) - CALL check("dtransform.H5Pset_data_transform_f", error, 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) - -! 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) - -! 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 H5Fclose_f(file_id, error) - CALL check("H5Fclose_f", error, total_error) - - IF(cleanup) CALL h5_cleanup_f("dtransform", H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - - -END SUBROUTINE dtransform - - -!/**************************************************************** -!** -!** test_genprop_basic_class(): Test basic generic property list code. -!** Tests creating new generic classes. -!** -!****************************************************************/ - -SUBROUTINE test_genprop_basic_class(cleanup, total_error) - - USE HDF5 ! This module contains all necessary modules - - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - INTEGER(HID_T) :: cid1 !/* Generic Property class ID */ - INTEGER(HID_T) :: cid2 !/* Generic Property class ID */ - - CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1" - CHARACTER(LEN=7) :: name ! /* Name of class */ - CHARACTER(LEN=10) :: name_big ! /* Name of class bigger buffer */ - CHARACTER(LEN=4) :: name_small ! /* Name of class smaller buffer*/ - INTEGER :: error - INTEGER :: size - LOGICAL :: flag - - !/* Output message about test being performed */ - - !WRITE(*,*) "Testing Basic Generic Property List Class Creation Functionality" - - ! Try some bogus value for class identifier; function should fail gracefully - - cid1 = 456 - CALL H5Pget_class_name_f(cid1, name, size, 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) - CALL check("H5Pcreate_class", error, 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) - IF(error.NE.0)THEN - WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME - total_error = total_error + 1 - ENDIF - - ! /* 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) - 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 - ENDIF - - ! /* 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) - 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 - ENDIF - - ! /* Check class parent */ - CALL H5Pget_class_parent_f(cid1, cid2, error) - CALL check("H5Pget_class_parent_f", error, 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) - - - ! /* 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) - - !/* Close parent class */ - CALL H5Pclose_class_f(cid2, error) - CALL check("H5Pclose_class_f", error, total_error) - - - !/* Close class */ - CALL H5Pclose_class_f(cid1, error) - CALL check("H5Pclose_class_f", error, total_error) - -END SUBROUTINE test_genprop_basic_class - -SUBROUTINE test_h5s_encode(cleanup, total_error) - -!/**************************************************************** -!** -!** test_h5s_encode(): Test H5S (dataspace) encoding and decoding. -!** -!****************************************************************/ - - USE HDF5 ! This module contains all necessary modules - - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - INTEGER(hid_t) :: sid1, sid3! /* Dataspace ID */ - INTEGER(hid_t) :: decoded_sid1, decoded_sid3 - INTEGER :: rank !/* LOGICAL rank of dataspace */ - INTEGER(size_t) :: sbuf_size=0, scalar_size=0 - -! Make sure the size is large - CHARACTER(LEN=288) :: sbuf - CHARACTER(LEN=288) :: scalar_buf - - INTEGER(hsize_t) :: n ! /* Number of dataspace elements */ - - INTEGER(hsize_t), DIMENSION(1:3) :: start = (/0, 0, 0/) - INTEGER(hsize_t), DIMENSION(1:3) :: stride = (/2, 5, 3/) - INTEGER(hsize_t), DIMENSION(1:3) :: count = (/2, 2, 2/) - INTEGER(hsize_t), DIMENSION(1:3) :: BLOCK = (/1, 3, 1/) - - INTEGER :: space_type - ! - ! Dataset dimensions - ! - INTEGER, PARAMETER :: SPACE1_DIM1= 3, SPACE1_DIM2=15, SPACE1_DIM3=13 - - INTEGER(HSIZE_T), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/) - INTEGER :: SPACE1_RANK = 3 - INTEGER :: error - - !/*------------------------------------------------------------------------- - ! * Test encoding and decoding of simple dataspace and hyperslab selection. - ! *------------------------------------------------------------------------- - ! */ - - CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error) - CALL check("H5Screate_simple", error, total_error) - - CALL h5sselect_hyperslab_f(sid1, H5S_SELECT_SET_F, & - start, count, error, stride=stride, BLOCK=BLOCK) - CALL check("h5sselect_hyperslab_f", error, total_error) - - - !/* Encode simple data space in a buffer */ - - ! First find the buffer size - CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) - CALL check("H5Sencode", error, total_error) - - - ! /* Try decoding bogus buffer */ - - CALL H5Sdecode_f(sbuf, decoded_sid1, error) - CALL VERIFY("H5Sdecode", error, -1, total_error) - - CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) - CALL check("H5Sencode", error, total_error) - - ! /* Decode from the dataspace buffer and return an object handle */ - CALL H5Sdecode_f(sbuf, decoded_sid1, error) - CALL check("H5Sdecode", error, 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), SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3, & - total_error) - - ! - !Close the dataspace for the dataset. - ! - CALL h5sclose_f(sid1, error) - CALL check("h5sclose_f", error, total_error) - - CALL h5sclose_f(decoded_sid1, error) - CALL check("h5sclose_f", error, total_error) - - ! /*------------------------------------------------------------------------- - ! * Test encoding and decoding of scalar dataspace. - ! *------------------------------------------------------------------------- - ! */ - ! /* Create scalar dataspace */ - - CALL H5Screate_f(H5S_SCALAR_F, sid3, error) - CALL check("H5Screate_f",error, total_error) - - ! /* Encode scalar data space in a buffer */ - - ! First find the buffer size - CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error) - CALL check("H5Sencode_f", error, total_error) - - ! encode - - CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error) - CALL check("H5Sencode_f", error, total_error) - - - ! /* Decode from the dataspace buffer and return an object handle */ - - CALL H5Sdecode_f(scalar_buf, decoded_sid3, error) - CALL check("H5Sdecode_f", error, total_error) - - - ! /* Verify extent type */ - - 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) - - ! /* 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 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 h5sclose_f(sid3, error) - CALL check("h5sclose_f", error, total_error) - - CALL h5sclose_f(decoded_sid3, error) - CALL check("h5sclose_f", error, total_error) - -END SUBROUTINE test_h5s_encode - -!------------------------------------------------------------------------- -! Function: test_scaleoffset -! -! Purpose: Tests the integer datatype for scaleoffset filter -! with fill value set -! -! Return: Success: 0 -! Failure: >0 -! -! Programmer: M. Scot Breitenfeld -! Decemeber 11, 2010 -! -! Modifications: -! -!------------------------------------------------------------------------- -! - -SUBROUTINE test_scaleoffset(cleanup, total_error ) - - USE HDF5 - - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - INTEGER(hid_t) :: file - - INTEGER(hid_t) :: dataset, datatype, space, mspace, dc - INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2, 5/) - INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2, 5/) - INTEGER, DIMENSION(1:2,1:5) :: orig_data - INTEGER, DIMENSION(1:2,1:5) :: new_data - INTEGER(hsize_t), DIMENSION(1:2) :: start ! Start of hyperslab - INTEGER(hsize_t), DIMENSION(1:2) :: stride ! Stride of hyperslab - INTEGER(hsize_t), DIMENSION(1:2) :: count ! BLOCK count - INTEGER(hsize_t), DIMENSION(1:2) :: BLOCK ! BLOCK sizes - INTEGER :: fillval - INTEGER(size_t) :: j - REAL :: x - INTEGER :: error - LOGICAL :: status - - ! check to see if filter is available - CALL H5Zfilter_avail_f(H5Z_FILTER_SCALEOFFSET_F, status, error) - IF(.NOT.status)THEN ! We don't have H5Z_FILTER_SCALEOFFSET_F filter - total_error = -1 ! so return - RETURN - ENDIF - - CALL H5Fcreate_f("h5scaleoffset.h5", H5F_ACC_TRUNC_F, file, error) - CALL check("H5Fcreate_f", error, total_error) - - CALL H5Tcopy_f(H5T_NATIVE_INTEGER, datatype, error) - CALL CHECK(" H5Tcopy_f", error, total_error) - - ! Set order of dataset datatype - CALL H5Tset_order_f(datatype, H5T_ORDER_BE_F, error) - CALL CHECK(" H5Tset_order_f", error, total_error) - - ! Create the data space for the dataset - CALL H5Screate_simple_f(2, dims, space, error) - CALL CHECK(" H5Screate_simple_f", error, total_error) - - ! Create the dataset property list - CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error) - CALL CHECK(" H5Pcreate_f", error, total_error) - - ! Set fill value - fillval = 10000 - CALL H5Pset_fill_value_f(dc, H5T_NATIVE_INTEGER, fillval, error) - CALL CHECK(" H5Pset_fill_value_f", error, total_error) - - ! Set up to use scaleoffset filter, let library calculate minbits - CALL H5Pset_chunk_f(dc, 2, chunk_dim, error) - CALL CHECK(" H5Pset_chunk_f", error, total_error) - - CALL H5Pset_scaleoffset_f(dc, H5Z_SO_INT_F, H5Z_SO_INT_MINBITS_DEFAULT_F, error) - CALL CHECK(" H5Pset_scaleoffset_f", error, total_error) - - ! Create the dataset - CALL H5Dcreate_f(file, "scaleoffset_int", datatype, & - space, dataset, error, dc) - CALL CHECK(" H5Dcreate_f", error, total_error) - - ! Create the memory data space - CALL H5Screate_simple_f(2, dims, mspace, error) - CALL CHECK(" H5Screate_simple_f", error, total_error) - - ! Select hyperslab for data to write, using 1x5 blocks, - ! (1,1) stride and (1,1) count starting at the position (0,0) - - start(1:2) = (/0,0/) - stride(1:2) = (/1,1/) - COUNT(1:2) = (/1,1/) - BLOCK(1:2) = (/1,5/) - - CALL H5Sselect_hyperslab_f(mspace, H5S_SELECT_SET_F, start, & - count, error, stride, BLOCK) - CALL CHECK(" H5Sselect_hyperslab_f", error, total_error) - - CALL RANDOM_SEED() - ! Initialize data of hyperslab - DO j = 1, dims(2) - CALL RANDOM_NUMBER(x) - orig_data(1,j) = INT(x*10000.) - IF(MOD(j,2_size_t).EQ.0)THEN - orig_data(1,j) = - orig_data(1,j) - ENDIF - ENDDO - - !---------------------------------------------------------------------- - ! STEP 1: Test scaleoffset by setting up a chunked dataset and writing - ! to it. - !---------------------------------------------------------------------- - - ! Only data in the hyperslab will be written, other value should be fill value - CALL H5Dwrite_f(dataset, H5T_NATIVE_INTEGER, orig_data, dims, error, mspace, mspace, H5P_DEFAULT_F) - CALL CHECK(" H5Dwrite_f", error, total_error) - - !---------------------------------------------------------------------- - ! STEP 2: Try to read the data we just wrote. - !---------------------------------------------------------------------- - - ! Read the dataset back - - CALL H5Dread_f(dataset, H5T_NATIVE_INTEGER, new_data, dims, error, mspace, mspace, H5P_DEFAULT_F) - CALL CHECK(" H5Dread_f", error, total_error) - - ! Check that the values read are the same as the values written - DO j = 1, dims(2) - IF(new_data(1,j) .NE. orig_data(1,j))THEN - total_error = total_error + 1 - WRITE(*,'(" Read different values than written.")') - WRITE(*,'(" At index ", 2(1X,I0))') 1, j - EXIT - ENDIF - ENDDO - !---------------------------------------------------------------------- - ! Cleanup - !---------------------------------------------------------------------- - CALL H5Tclose_f(datatype, error) - CALL CHECK(" H5Tclose_f", error, total_error) - CALL H5Pclose_f(dc, error) - CALL CHECK(" H5Pclose_f", error, total_error) - CALL H5Sclose_f(space, error) - CALL CHECK(" H5Sclose_f", error, total_error) - CALL H5Dclose_f(dataset, error) - CALL CHECK(" H5Dclose_f", error, total_error) - CALL H5Fclose_f(file, error) - CALL CHECK(" H5Fclose_f", error, total_error) - -END SUBROUTINE test_scaleoffset diff --git a/fortran/test/fortranlib_test_F03.f90 b/fortran/test/fortranlib_test_F03.f90 index dbdc184..5b386b9 100644 --- a/fortran/test/fortranlib_test_F03.f90 +++ b/fortran/test/fortranlib_test_F03.f90 @@ -28,12 +28,12 @@ PROGRAM fortranlibtest_F03 USE HDF5 - + USE THDF5_F03 + IMPLICIT NONE INTEGER :: total_error = 0 INTEGER :: error INTEGER :: majnum, minnum, relnum - LOGICAL :: szip_flag INTEGER :: ret_total_error LOGICAL :: cleanup, status diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90 index cecaded..f5f4525 100644 --- a/fortran/test/tH5A.f90 +++ b/fortran/test/tH5A.f90 @@ -27,7 +27,9 @@ ! ! !***** +MODULE TH5A +CONTAINS SUBROUTINE attribute_test(cleanup, total_error) ! This subroutine tests following functionalities: @@ -36,7 +38,7 @@ ! USE HDF5 ! This module contains all necessary modules - + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error @@ -100,7 +102,7 @@ CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back ! string attr data CHARACTER :: attr_character_data = 'A' - REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459 + REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459D0 REAL, DIMENSION(1) :: attr_real_data = 4.0 INTEGER, DIMENSION(1) :: attr_integer_data = 5 INTEGER(HSIZE_T), DIMENSION(7) :: data_dims @@ -127,6 +129,7 @@ !data buffers ! INTEGER, DIMENSION(NX,NY) :: data_in + LOGICAL :: differ ! @@ -516,7 +519,8 @@ data_dims(1) = 1 CALL h5aread_f(attr3_id, H5T_NATIVE_DOUBLE, aread_double_data, data_dims, error) CALL check("h5aread_f",error,total_error) - IF (aread_double_data(1) .NE. 3.459 ) THEN + CALL compare_floats(aread_double_data(1), 3.459D0, differ) + IF (differ) THEN WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1) total_error = total_error + 1 END IF @@ -526,7 +530,8 @@ data_dims(1) = 1 CALL h5aread_f(attr4_id, H5T_NATIVE_REAL, aread_real_data, data_dims, error) CALL check("h5aread_f",error,total_error) - IF (aread_real_data(1) .NE. 4.0 ) THEN + CALL compare_floats(aread_real_data(1), 4.0, differ) + IF (differ) THEN WRITE(*,*) "Read back real attrbute is wrong ", aread_real_data total_error = total_error + 1 END IF @@ -624,3 +629,4 @@ RETURN END SUBROUTINE attribute_test +END MODULE TH5A diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90 index 32cb228..02bef53 100644 --- a/fortran/test/tH5A_1_8.f90 +++ b/fortran/test/tH5A_1_8.f90 @@ -30,7 +30,9 @@ ! test_attr_basic_write, test_attr_many, attr_open_check, ! !***** +MODULE TH5A_1_8 +CONTAINS SUBROUTINE attribute_test_1_8(cleanup, total_error) ! This subroutine tests following 1.8 functionalities: @@ -40,27 +42,12 @@ SUBROUTINE attribute_test_1_8(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 - CHARACTER(LEN=5), PARAMETER :: filename = "atest" !File name - CHARACTER(LEN=9), PARAMETER :: dsetname = "atestdset" !Dataset name - CHARACTER(LEN=11), PARAMETER :: aname = "attr_string" !String Attribute name - CHARACTER(LEN=14), PARAMETER :: aname2 = "attr_character"!Character Attribute name - CHARACTER(LEN=11), PARAMETER :: aname3 = "attr_double" !DOuble Attribute name - CHARACTER(LEN=9), PARAMETER :: aname4 = "attr_real" !Real Attribute name - CHARACTER(LEN=12), PARAMETER :: aname5 = "attr_integer" !Integer Attribute name - CHARACTER(LEN=9), PARAMETER :: aname6 = "attr_null" !Null Attribute name - - ! - !data space rank and dimensions - ! - INTEGER, PARAMETER :: RANK = 2 - INTEGER, PARAMETER :: NX = 4 - INTEGER, PARAMETER :: NY = 5 - ! !general purpose integer ! @@ -213,8 +200,10 @@ 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 + ! - - - arg types - - - INTEGER(HID_T), INTENT(IN) :: fcpl @@ -401,6 +390,8 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error) !** !****************************************************************/ USE HDF5 + USE TH5_MISC + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fcpl @@ -413,8 +404,6 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error) INTEGER(HID_T) :: dataset CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" - INTEGER, PARAMETER :: NUM_DSETS = 3 - INTEGER :: error @@ -532,6 +521,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) !****************************************************************/ USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -746,6 +736,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) !****************************************************************/ USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -951,6 +942,7 @@ 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 @@ -1091,6 +1083,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) !****************************************************************/ USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -1105,7 +1098,6 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2" - INTEGER, PARAMETER :: NUM_DSETS = 3 INTEGER(HID_T) :: dataset, dataset2 @@ -1127,22 +1119,11 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) CHARACTER(LEN=7) :: attrname CHARACTER(LEN=11) :: attrname2 - CHARACTER(LEN=1), PARAMETER :: chr1 = '.' - INTEGER :: u - INTEGER, PARAMETER :: SPACE1_RANK = 3 - INTEGER, PARAMETER :: NX = 20 - INTEGER, PARAMETER :: NY = 5 - INTEGER, PARAMETER :: NZ = 10 INTEGER(HID_T) :: my_fcpl CHARACTER(LEN=5), PARAMETER :: TYPE1_NAME = "/Type" - INTEGER, PARAMETER :: SPACE1_DIM1 = 4 - INTEGER, PARAMETER :: SPACE1_DIM2 = 8 - INTEGER, PARAMETER :: SPACE1_DIM3 = 10 - - INTEGER :: test_shared INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension INTEGER :: arank = 1 ! Attribure rank @@ -1412,6 +1393,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) !****************************************************************/ USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -1457,7 +1439,6 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) INTEGER(SIZE_T) :: size CHARACTER(LEN=8) :: tmpname - CHARACTER(LEN=1), PARAMETER :: chr1 = '.' INTEGER :: idx_type INTEGER :: order @@ -1773,6 +1754,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) !****************************************************************/ USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -1786,7 +1768,6 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2" - INTEGER, PARAMETER :: NUM_DSETS = 3 INTEGER(HID_T) :: dataset, dataset2 @@ -1806,13 +1787,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) INTEGER, DIMENSION(1) :: attr_integer_data CHARACTER(LEN=7) :: attrname - CHARACTER(LEN=1), PARAMETER :: chr1 = '.' - INTEGER :: u - INTEGER, PARAMETER :: SPACE1_RANK = 3 - INTEGER, PARAMETER :: NX = 20 - INTEGER, PARAMETER :: NY = 5 - INTEGER, PARAMETER :: NZ = 10 INTEGER(HID_T) :: my_fcpl CHARACTER(LEN=5), PARAMETER :: TYPE1_NAME = "/Type" @@ -2056,6 +2031,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) !****************************************************************/ USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -2207,6 +2183,7 @@ END SUBROUTINE test_attr_dense_open SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error) USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -2302,6 +2279,7 @@ END SUBROUTINE test_attr_dense_verify SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error ) USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -2424,6 +2402,7 @@ END SUBROUTINE test_attr_corder_create_basic SUBROUTINE test_attr_basic_write(fapl, total_error) USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -2445,8 +2424,6 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) CHARACTER(LEN=25) :: check_name CHARACTER(LEN=18) :: chr_exact_size - INTEGER, PARAMETER :: SPACE1_RANK = 2 - CHARACTER(LEN=5), PARAMETER :: ATTR1_NAME="Attr1" INTEGER, PARAMETER :: ATTR1_RANK = 1 INTEGER, PARAMETER :: ATTR1_DIM1 = 3 @@ -2623,6 +2600,7 @@ END SUBROUTINE test_attr_basic_write SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -2740,6 +2718,7 @@ 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 @@ -2750,7 +2729,6 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) INTEGER :: u CHARACTER (LEN=8) :: attrname - INTEGER, PARAMETER :: NUM_DSETS = 3 INTEGER :: error LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute @@ -2835,3 +2813,4 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) ENDDO END SUBROUTINE attr_open_check +END MODULE TH5A_1_8 diff --git a/fortran/test/tH5D.f90 b/fortran/test/tH5D.f90 index 9f7b50c..c0eb8f9 100644 --- a/fortran/test/tH5D.f90 +++ b/fortran/test/tH5D.f90 @@ -34,8 +34,12 @@ !***** ! +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 @@ -204,7 +208,7 @@ 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 writen" + write(*,*) "data read is not the same as the data written" END IF end do end do @@ -252,8 +256,10 @@ 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 @@ -308,6 +314,7 @@ !general purpose integer ! INTEGER :: i, j + INTEGER(HSIZE_T) :: ih, jh ! !flag to check operation success @@ -484,9 +491,9 @@ ! !Compare the data. ! - do i = 1, dims1(1) - do j = 1, dims1(2) - IF (data_out(i,j) .NE. data_in(i, j)) THEN + 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 @@ -527,5 +534,5 @@ RETURN END SUBROUTINE extenddsettest - +END MODULE TH5D diff --git a/fortran/test/tH5E.f90 b/fortran/test/tH5E.f90 index 4d431a1..5f680e2 100644 --- a/fortran/test/tH5E.f90 +++ b/fortran/test/tH5E.f90 @@ -31,11 +31,16 @@ ! !***** ! +MODULE TH5E + +CONTAINS + SUBROUTINE error_report_test(cleanup, total_error) ! This subroutine tests following functionalities: h5eprint_f USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -92,3 +97,6 @@ CALL check("h5_cleanup_f", error, total_error) RETURN END SUBROUTINE error_report_test + +END MODULE TH5E + diff --git a/fortran/test/tH5E_F03.f90 b/fortran/test/tH5E_F03.f90 index 04e3190..82ba27c 100644 --- a/fortran/test/tH5E_F03.f90 +++ b/fortran/test/tH5E_F03.f90 @@ -34,10 +34,8 @@ ! ***************************************** ! *** H 5 E T E S T S ! ***************************************** - MODULE test_my_hdf5_error_handler - IMPLICIT NONE CONTAINS @@ -56,9 +54,8 @@ CONTAINS IMPLICIT NONE ! estack_id is always passed from C as: H5E_DEFAULT - INTEGER(HID_T) :: estack_id + INTEGER(HID_T) :: estack_id ! data that was registered with H5Eset_auto_f -! INTEGER, DIMENSION(1:2) :: data_inout INTEGER :: data_inout PRINT*, " " @@ -82,10 +79,10 @@ CONTAINS IMPLICIT NONE ! estack_id is always passed from C as: H5E_DEFAULT - INTEGER(HID_T) :: estack_id + INTEGER(HID_T) :: estack_id ! data that was registered with H5Eset_auto_f TYPE(C_PTR) :: data_inout - + PRINT*, " " PRINT*, " Subtest: H5Eset_auto_f custom error message with callback, NO DATA" PRINT*, " -This message should be written to standard out- " @@ -94,12 +91,19 @@ CONTAINS my_hdf5_error_handler_nodata = 1 ! this is not used by the C routine END FUNCTION my_hdf5_error_handler_nodata - + END MODULE test_my_hdf5_error_handler + + +MODULE TH5E_F03 + +CONTAINS + SUBROUTINE test_error(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING USE test_my_hdf5_error_handler @@ -109,27 +113,17 @@ SUBROUTINE test_error(total_error) INTEGER :: total_error INTEGER(hid_t) :: file INTEGER(hid_t) :: dataset, space - INTEGER(hid_t) :: estack_id INTEGER(hsize_t), DIMENSION(1:2) :: dims - CHARACTER(LEN=10) :: FUNC_test_error = "test_error" - TYPE(C_FUNPTR) :: old_func - TYPE(C_PTR) :: old_data, null_data INTEGER :: error - TYPE(C_FUNPTR) :: op - INTEGER, DIMENSION(1:100,1:200), TARGET :: ipoints2 - !! INTEGER, DIMENSION(1:2), TARGET :: my_hdf5_error_handler_data INTEGER, DIMENSION(:), POINTER :: ptr_data INTEGER, TARGET :: my_hdf5_error_handler_data TYPE(C_PTR) :: f_ptr TYPE(C_FUNPTR) :: func TYPE(C_PTR), TARGET :: f_ptr1 - TYPE(C_FUNPTR), TARGET :: func1 INTEGER, DIMENSION(1:1) :: array_shape - LOGICAL :: is_associated - ! my_hdf5_error_handler_data(1:2) =(/1,2/) my_hdf5_error_handler_data = 99 CALL h5fcreate_f("terror.h5", H5F_ACC_TRUNC_F, file, error) CALL check("h5fcreate_f", error, total_error) @@ -208,3 +202,5 @@ SUBROUTINE test_error(total_error) CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error) END SUBROUTINE test_error + +END MODULE TH5E_F03 diff --git a/fortran/test/tH5F.f90 b/fortran/test/tH5F.f90 index d8f683c..ad95ae4 100644 --- a/fortran/test/tH5F.f90 +++ b/fortran/test/tH5F.f90 @@ -31,8 +31,16 @@ ! and another file with a dataset. Mounting is used to ! access the dataset from the second file as a member of a group ! in the first file. + + + +MODULE TH5F + +CONTAINS + SUBROUTINE mountingtest(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 @@ -289,6 +297,7 @@ SUBROUTINE reopentest(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 @@ -475,6 +484,7 @@ SUBROUTINE plisttest(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 @@ -574,6 +584,7 @@ SUBROUTINE file_close(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 @@ -702,6 +713,7 @@ SUBROUTINE file_space(filename, cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE CHARACTER(*), INTENT(IN) :: filename LOGICAL, INTENT(IN) :: cleanup @@ -770,4 +782,4 @@ END SUBROUTINE file_space - +END MODULE TH5F diff --git a/fortran/test/tH5F_F03.f90 b/fortran/test/tH5F_F03.f90 index 79b0458..c878a59 100644 --- a/fortran/test/tH5F_F03.f90 +++ b/fortran/test/tH5F_F03.f90 @@ -36,11 +36,16 @@ ! *** H 5 F T E S T S ! ***************************************** +MODULE TH5F_F03 + +CONTAINS + SUBROUTINE test_get_file_image(total_error) ! ! Tests the wrapper for h5fget_file_image ! - USE HDF5 + USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -169,3 +174,5 @@ SUBROUTINE test_get_file_image(total_error) DEALLOCATE(file_image_ptr,image_ptr) END SUBROUTINE test_get_file_image + +END MODULE TH5F_F03 diff --git a/fortran/test/tH5G.f90 b/fortran/test/tH5G.f90 index 6befa94..b64c759 100644 --- a/fortran/test/tH5G.f90 +++ b/fortran/test/tH5G.f90 @@ -27,6 +27,10 @@ ! !***** +MODULE TH5G + +CONTAINS + SUBROUTINE group_test(cleanup, total_error) ! This subroutine tests following functionalities: @@ -35,6 +39,7 @@ ! h5gget_comment_f USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -254,3 +259,5 @@ if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) END SUBROUTINE group_test + +END MODULE TH5G diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90 index fd55ba9..5e6f50a 100644 --- a/fortran/test/tH5G_1_8.f90 +++ b/fortran/test/tH5G_1_8.f90 @@ -28,12 +28,18 @@ ! lapl_nlinks ! !***** + +MODULE TH5G_1_8 + +CONTAINS + SUBROUTINE group_test(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 + INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T) :: fapl, fapl2, my_fapl ! /* File access property lists */ @@ -134,9 +140,10 @@ 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(OUT) :: total_error + INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl INTEGER(HID_T) :: gcpl_id ! /* Group creation property list ID */ @@ -450,9 +457,10 @@ 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(OUT) :: total_error + INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl INTEGER(HID_T) :: file_id !/* File ID */ @@ -646,9 +654,10 @@ 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(OUT) :: total_error + INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl INTEGER(HID_T) :: file, scalar, grp, d1 @@ -661,10 +670,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER :: corder ! Specifies the link’s creation order position. LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid. INTEGER :: link_type ! Specifies the link class: - ! H5L_TYPE_HARD_F - Hard link - ! H5L_TYPE_SOFT_F - Soft link - ! H5L_TYPE_EXTERNAL_F - External link - ! H5L_TYPE_ERROR _F - Error + ! H5L_TYPE_HARD_F - Hard link + ! H5L_TYPE_SOFT_F - Soft link + ! H5L_TYPE_EXTERNAL_F - External link + ! H5L_TYPE_ERROR _F - Error INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value @@ -741,9 +750,10 @@ 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(OUT) :: total_error + INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl_id INTEGER(HID_T):: file_id @@ -768,10 +778,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER :: corder ! Specifies the link’s creation order position. LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid. INTEGER :: link_type ! Specifies the link class: - ! H5L_TYPE_HARD_F - Hard link - ! H5L_TYPE_SOFT_F - Soft link - ! H5L_TYPE_EXTERNAL_F - External link - ! H5L_TYPE_ERROR _F - Error + ! H5L_TYPE_HARD_F - Hard link + ! H5L_TYPE_SOFT_F - Soft link + ! H5L_TYPE_EXTERNAL_F - External link + ! H5L_TYPE_ERROR _F - Error INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value @@ -948,9 +958,10 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl2 INTEGER :: error @@ -962,8 +973,8 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) INTEGER(size_t) :: lheap_size_hint !/* Local heap size hint */ INTEGER :: max_compact !/* Maximum # of links to store in group compactly */ INTEGER :: min_dense !/* Minimum # of links to store in group "densely" */ - INTEGER :: est_num_entries !/* Estimated # of entries in group */ - INTEGER :: est_name_len !/* Estimated length of entry name */ + INTEGER :: est_num_entries !/* Estimated # of entries in group */ + INTEGER :: est_name_len !/* Estimated length of entry name */ CHARACTER(LEN=NAME_BUF_SIZE) :: filename = 'fixx.h5' INTEGER(SIZE_T) :: LIFECYCLE_LOCAL_HEAP_SIZE_HINT = 256 INTEGER :: LIFECYCLE_MAX_COMPACT = 4 @@ -1096,9 +1107,10 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) ! USE ISO_C_BINDING USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl INTEGER :: error @@ -1165,9 +1177,10 @@ 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(OUT) :: total_error + INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl INTEGER(HID_T) :: file_id ! /* File ID */ @@ -1406,6 +1419,7 @@ 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 @@ -1509,6 +1523,7 @@ 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 @@ -1526,10 +1541,10 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & INTEGER :: corder ! Specifies the link’s creation order position. LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid. INTEGER :: link_type ! Specifies the link class: - ! H5L_TYPE_HARD_F - Hard link - ! H5L_TYPE_SOFT_F - Soft link - ! H5L_TYPE_EXTERNAL_F - External link - ! H5L_TYPE_ERROR _F - Error + ! H5L_TYPE_HARD_F - Hard link + ! H5L_TYPE_SOFT_F - Soft link + ! H5L_TYPE_EXTERNAL_F - External link + ! H5L_TYPE_ERROR _F - Error INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value @@ -1635,13 +1650,11 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL check("h5sget_simple_extent_dims_f",error, total_error) DO i = 1, 2 - tmp1 = dimsout(i) - tmp2 = extend_dim(i) -!EP CALL VERIFY("H5Sget_simple_extent_dims", dimsout(i), extend_dim(i), total_error) + tmp1 = INT(dimsout(i)) + tmp2 = INT(extend_dim(i)) CALL VERIFY("H5Sget_simple_extent_dims", tmp1, tmp2, total_error) -!EP CALL VERIFY("H5Sget_simple_extent_dims", maxdimsout(i), dims(i), total_error) - tmp1 = maxdimsout(i) - tmp2 = dims(i) + tmp1 = INT(maxdimsout(i)) + tmp2 = INT(dims(i)) CALL VERIFY("H5Sget_simple_extent_dims", tmp1, tmp2, total_error) ENDDO @@ -1822,6 +1835,7 @@ 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 @@ -1885,6 +1899,7 @@ END SUBROUTINE objcopy SUBROUTINE lapl_nlinks( fapl, total_error) USE HDF5 + USE TH5_MISC IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl @@ -2140,3 +2155,5 @@ SUBROUTINE lapl_nlinks( fapl, total_error) CALL check("H5Fclose_f", error, total_error) END SUBROUTINE lapl_nlinks + +END MODULE TH5G_1_8 diff --git a/fortran/test/tH5I.f90 b/fortran/test/tH5I.f90 index 184edaf..9ea20f0 100644 --- a/fortran/test/tH5I.f90 +++ b/fortran/test/tH5I.f90 @@ -26,12 +26,16 @@ ! identifier_test ! !***** +MODULE TH5I + +CONTAINS SUBROUTINE identifier_test(cleanup, total_error) ! 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 @@ -311,3 +315,5 @@ RETURN END SUBROUTINE identifier_test + +END MODULE TH5I diff --git a/fortran/test/tH5L_F03.f90 b/fortran/test/tH5L_F03.f90 index f71f450..8cc17fb 100644 --- a/fortran/test/tH5L_F03.f90 +++ b/fortran/test/tH5L_F03.f90 @@ -30,14 +30,13 @@ ! test_iter_group ! !***** - MODULE liter_cb_mod USE HDF5 USE ISO_C_BINDING IMPLICIT NONE - - TYPE iter_enum + + TYPE iter_enum INTEGER RET_ZERO INTEGER RET_TWO INTEGER RET_CHANGE @@ -74,7 +73,7 @@ CONTAINS TYPE(iter_info) :: op_data INTEGER, SAVE :: count - INTEGER, SAVE :: count2 + INTEGER, SAVE :: count2 !!$ !!$ iter_info *info = (iter_info *)op_data; @@ -108,6 +107,10 @@ CONTAINS END FUNCTION liter_cb END MODULE liter_cb_mod +MODULE TH5L_F03 + +CONTAINS + ! ***************************************** ! *** H 5 L T E S T S ! ***************************************** @@ -121,34 +124,29 @@ END MODULE liter_cb_mod SUBROUTINE test_iter_group(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING USE liter_cb_mod IMPLICIT NONE INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T) :: fapl - INTEGER(HID_T) :: file ! File ID + INTEGER(HID_T) :: file ! File ID INTEGER(hid_t) :: dataset ! Dataset ID INTEGER(hid_t) :: datatype ! Common datatype ID INTEGER(hid_t) :: filespace ! Common dataspace ID - INTEGER(hid_t) :: root_group,grp ! Root group ID - INTEGER i,j ! counting variable - INTEGER(hsize_t) idx ! Index in the group + INTEGER(hid_t) :: grp ! Group ID + INTEGER i,j ! counting variable + INTEGER(hsize_t) idx ! Index in the group CHARACTER(LEN=11) :: DATAFILE = "titerate.h5" INTEGER, PARAMETER :: ndatasets = 50 CHARACTER(LEN=10) :: name ! temporary name buffer CHARACTER(LEN=10), DIMENSION(1:ndatasets+2) :: lnames ! Names of the links created -!!$ char dataset_name[NAMELEN]; dataset name TYPE(iter_info), TARGET :: info -!!$ iter_info info; Custom iteration information -!!$ H5G_info_t ginfo; Buffer for querying object's info -!!$ herr_t ret; Generic return value - INTEGER :: error INTEGER :: ret_value - TYPE(C_PTR) :: f_ptr TYPE(C_FUNPTR) :: f1 TYPE(C_PTR) :: f2 CHARACTER(LEN=2) :: ichr2 @@ -319,3 +317,5 @@ SUBROUTINE test_iter_group(total_error) CALL check("H5Fclose_f", error, total_error) END SUBROUTINE test_iter_group + +END MODULE TH5L_F03 diff --git a/fortran/test/tH5MISC_1_8.f90 b/fortran/test/tH5MISC_1_8.f90 new file mode 100644 index 0000000..bb7d50a --- /dev/null +++ b/fortran/test/tH5MISC_1_8.f90 @@ -0,0 +1,474 @@ +!****h* root/fortran/test/tH5MISC_1_8.f90 +! +! NAME +! tH5MISC_1_8.f90 +! +! FUNCTION +! Basic testing of Fortran API's introduced in 1.8 release. +! +! 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 TH5MISC_1_8 + +CONTAINS + +SUBROUTINE dtransform(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 + + INTEGER(HID_T) :: dxpl_id_c_to_f + INTEGER(HID_T) :: file_id + + CHARACTER(LEN=15), PARAMETER :: c_to_f = "(9/5.0)*x + 123" + INTEGER :: error + CHARACTER(LEN=15) :: ptrgetTest + CHARACTER(LEN=7) :: ptrgetTest_small + CHARACTER(LEN=30) :: ptrgetTest_big + + INTEGER(SIZE_T) :: size + + CALL H5Fcreate_f("dtransform.h5", H5F_ACC_TRUNC_F, file_id, error) + CALL check("dtransform.H5Fcreate_f", error, total_error) + + CALL H5Pcreate_f(H5P_DATASET_XFER_F, dxpl_id_c_to_f, error) + CALL check("dtransform.H5Pcreate_f", error, total_error) + + CALL H5Pset_data_transform_f(dxpl_id_c_to_f, c_to_f, error) + CALL check("dtransform.H5Pset_data_transform_f", error, 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) + +! 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) + +! 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 H5Fclose_f(file_id, error) + CALL check("H5Fclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f("dtransform", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + +END SUBROUTINE dtransform + + +!/**************************************************************** +!** +!** test_genprop_basic_class(): Test basic generic property list code. +!** Tests creating new generic classes. +!** +!****************************************************************/ + +SUBROUTINE test_genprop_basic_class(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 + + INTEGER(HID_T) :: cid1 !/* Generic Property class ID */ + INTEGER(HID_T) :: cid2 !/* Generic Property class ID */ + + CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1" + CHARACTER(LEN=7) :: name ! /* Name of class */ + CHARACTER(LEN=10) :: name_big ! /* Name of class bigger buffer */ + CHARACTER(LEN=4) :: name_small ! /* Name of class smaller buffer*/ + INTEGER :: error + INTEGER :: size + LOGICAL :: flag + + !/* Output message about test being performed */ + + !WRITE(*,*) "Testing Basic Generic Property List Class Creation Functionality" + + ! Try some bogus value for class identifier; function should fail gracefully + + cid1 = 456 + CALL H5Pget_class_name_f(cid1, name, size, 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) + CALL check("H5Pcreate_class", error, 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) + IF(error.NE.0)THEN + WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME + total_error = total_error + 1 + ENDIF + + ! /* 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) + 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 + ENDIF + + ! /* 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) + 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 + ENDIF + + ! /* Check class parent */ + CALL H5Pget_class_parent_f(cid1, cid2, error) + CALL check("H5Pget_class_parent_f", error, 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) + + + ! /* 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) + + !/* Close parent class */ + CALL H5Pclose_class_f(cid2, error) + CALL check("H5Pclose_class_f", error, total_error) + + + !/* Close class */ + CALL H5Pclose_class_f(cid1, error) + CALL check("H5Pclose_class_f", error, total_error) + +END SUBROUTINE test_genprop_basic_class + +SUBROUTINE test_h5s_encode(cleanup, total_error) + +!/**************************************************************** +!** +!** test_h5s_encode(): Test H5S (dataspace) encoding and decoding. +!** +!****************************************************************/ + + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(hid_t) :: sid1, sid3! /* Dataspace ID */ + INTEGER(hid_t) :: decoded_sid1, decoded_sid3 + INTEGER :: rank !/* LOGICAL rank of dataspace */ + INTEGER(size_t) :: sbuf_size=0, scalar_size=0 + +! Make sure the size is large + CHARACTER(LEN=288) :: sbuf + CHARACTER(LEN=288) :: scalar_buf + + INTEGER(hsize_t) :: n ! /* Number of dataspace elements */ + + INTEGER(hsize_t), DIMENSION(1:3) :: start = (/0, 0, 0/) + INTEGER(hsize_t), DIMENSION(1:3) :: stride = (/2, 5, 3/) + INTEGER(hsize_t), DIMENSION(1:3) :: count = (/2, 2, 2/) + INTEGER(hsize_t), DIMENSION(1:3) :: BLOCK = (/1, 3, 1/) + + INTEGER :: space_type + ! + ! Dataset dimensions + ! + INTEGER, PARAMETER :: SPACE1_DIM1= 3, SPACE1_DIM2=15, SPACE1_DIM3=13 + + INTEGER(HSIZE_T), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/) + INTEGER :: SPACE1_RANK = 3 + INTEGER :: error + + !/*------------------------------------------------------------------------- + ! * Test encoding and decoding of simple dataspace and hyperslab selection. + ! *------------------------------------------------------------------------- + ! */ + + CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error) + CALL check("H5Screate_simple", error, total_error) + + CALL h5sselect_hyperslab_f(sid1, H5S_SELECT_SET_F, & + start, count, error, stride=stride, BLOCK=BLOCK) + CALL check("h5sselect_hyperslab_f", error, total_error) + + + !/* Encode simple data space in a buffer */ + + ! First find the buffer size + CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) + CALL check("H5Sencode", error, total_error) + + + ! /* Try decoding bogus buffer */ + + CALL H5Sdecode_f(sbuf, decoded_sid1, error) + CALL VERIFY("H5Sdecode", error, -1, total_error) + + CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) + CALL check("H5Sencode", error, total_error) + + ! /* Decode from the dataspace buffer and return an object handle */ + CALL H5Sdecode_f(sbuf, decoded_sid1, error) + CALL check("H5Sdecode", error, 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), SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3, & + total_error) + + ! + !Close the dataspace for the dataset. + ! + CALL h5sclose_f(sid1, error) + CALL check("h5sclose_f", error, total_error) + + CALL h5sclose_f(decoded_sid1, error) + CALL check("h5sclose_f", error, total_error) + + ! /*------------------------------------------------------------------------- + ! * Test encoding and decoding of scalar dataspace. + ! *------------------------------------------------------------------------- + ! */ + ! /* Create scalar dataspace */ + + CALL H5Screate_f(H5S_SCALAR_F, sid3, error) + CALL check("H5Screate_f",error, total_error) + + ! /* Encode scalar data space in a buffer */ + + ! First find the buffer size + CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error) + CALL check("H5Sencode_f", error, total_error) + + ! encode + + CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error) + CALL check("H5Sencode_f", error, total_error) + + + ! /* Decode from the dataspace buffer and return an object handle */ + + CALL H5Sdecode_f(scalar_buf, decoded_sid3, error) + CALL check("H5Sdecode_f", error, total_error) + + + ! /* Verify extent type */ + + 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) + + ! /* 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 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 h5sclose_f(sid3, error) + CALL check("h5sclose_f", error, total_error) + + CALL h5sclose_f(decoded_sid3, error) + CALL check("h5sclose_f", error, total_error) + +END SUBROUTINE test_h5s_encode + +!------------------------------------------------------------------------- +! Function: test_scaleoffset +! +! Purpose: Tests the integer datatype for scaleoffset filter +! with fill value set +! +! Return: Success: 0 +! Failure: >0 +! +! Programmer: M. Scot Breitenfeld +! Decemeber 11, 2010 +! +! Modifications: +! +!------------------------------------------------------------------------- +! + +SUBROUTINE test_scaleoffset(cleanup, total_error ) + + USE HDF5 + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER(hid_t) :: file + + INTEGER(hid_t) :: dataset, datatype, space, mspace, dc + INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2, 5/) + INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2, 5/) + INTEGER, DIMENSION(1:2,1:5) :: orig_data + INTEGER, DIMENSION(1:2,1:5) :: new_data + INTEGER(hsize_t), DIMENSION(1:2) :: start ! Start of hyperslab + INTEGER(hsize_t), DIMENSION(1:2) :: stride ! Stride of hyperslab + INTEGER(hsize_t), DIMENSION(1:2) :: count ! BLOCK count + INTEGER(hsize_t), DIMENSION(1:2) :: BLOCK ! BLOCK sizes + INTEGER :: fillval + INTEGER(size_t) :: j + REAL :: x + INTEGER :: error + LOGICAL :: status + + ! check to see if filter is available + CALL H5Zfilter_avail_f(H5Z_FILTER_SCALEOFFSET_F, status, error) + IF(.NOT.status)THEN ! We don't have H5Z_FILTER_SCALEOFFSET_F filter + total_error = -1 ! so return + RETURN + ENDIF + + CALL H5Fcreate_f("h5scaleoffset.h5", H5F_ACC_TRUNC_F, file, error) + CALL check("H5Fcreate_f", error, total_error) + + CALL H5Tcopy_f(H5T_NATIVE_INTEGER, datatype, error) + CALL CHECK(" H5Tcopy_f", error, total_error) + + ! Set order of dataset datatype + CALL H5Tset_order_f(datatype, H5T_ORDER_BE_F, error) + CALL CHECK(" H5Tset_order_f", error, total_error) + + ! Create the data space for the dataset + CALL H5Screate_simple_f(2, dims, space, error) + CALL CHECK(" H5Screate_simple_f", error, total_error) + + ! Create the dataset property list + CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error) + CALL CHECK(" H5Pcreate_f", error, total_error) + + ! Set fill value + fillval = 10000 + CALL H5Pset_fill_value_f(dc, H5T_NATIVE_INTEGER, fillval, error) + CALL CHECK(" H5Pset_fill_value_f", error, total_error) + + ! Set up to use scaleoffset filter, let library calculate minbits + CALL H5Pset_chunk_f(dc, 2, chunk_dim, error) + CALL CHECK(" H5Pset_chunk_f", error, total_error) + + CALL H5Pset_scaleoffset_f(dc, H5Z_SO_INT_F, H5Z_SO_INT_MINBITS_DEFAULT_F, error) + CALL CHECK(" H5Pset_scaleoffset_f", error, total_error) + + ! Create the dataset + CALL H5Dcreate_f(file, "scaleoffset_int", datatype, & + space, dataset, error, dc) + CALL CHECK(" H5Dcreate_f", error, total_error) + + ! Create the memory data space + CALL H5Screate_simple_f(2, dims, mspace, error) + CALL CHECK(" H5Screate_simple_f", error, total_error) + + ! Select hyperslab for data to write, using 1x5 blocks, + ! (1,1) stride and (1,1) count starting at the position (0,0) + + start(1:2) = (/0,0/) + stride(1:2) = (/1,1/) + COUNT(1:2) = (/1,1/) + BLOCK(1:2) = (/1,5/) + + CALL H5Sselect_hyperslab_f(mspace, H5S_SELECT_SET_F, start, & + count, error, stride, BLOCK) + CALL CHECK(" H5Sselect_hyperslab_f", error, total_error) + + CALL RANDOM_SEED() + ! Initialize data of hyperslab + DO j = 1, INT(dims(2)) + CALL RANDOM_NUMBER(x) + orig_data(1,j) = INT(x*10000.) + IF(MOD(j,2_size_t).EQ.0)THEN + orig_data(1,j) = - orig_data(1,j) + ENDIF + ENDDO + + !---------------------------------------------------------------------- + ! STEP 1: Test scaleoffset by setting up a chunked dataset and writing + ! to it. + !---------------------------------------------------------------------- + + ! Only data in the hyperslab will be written, other value should be fill value + CALL H5Dwrite_f(dataset, H5T_NATIVE_INTEGER, orig_data, dims, error, mspace, mspace, H5P_DEFAULT_F) + CALL CHECK(" H5Dwrite_f", error, total_error) + + !---------------------------------------------------------------------- + ! STEP 2: Try to read the data we just wrote. + !---------------------------------------------------------------------- + + ! Read the dataset back + + CALL H5Dread_f(dataset, H5T_NATIVE_INTEGER, new_data, dims, error, mspace, mspace, H5P_DEFAULT_F) + CALL CHECK(" H5Dread_f", error, total_error) + + ! Check that the values read are the same as the values written + DO j = 1, INT(dims(2)) + IF(new_data(1,j) .NE. orig_data(1,j))THEN + total_error = total_error + 1 + WRITE(*,'(" Read different values than written.")') + WRITE(*,'(" At index ", 2(1X,I0))') 1, j + EXIT + ENDIF + ENDDO + !---------------------------------------------------------------------- + ! Cleanup + !---------------------------------------------------------------------- + CALL H5Tclose_f(datatype, error) + CALL CHECK(" H5Tclose_f", error, total_error) + CALL H5Pclose_f(dc, error) + CALL CHECK(" H5Pclose_f", error, total_error) + CALL H5Sclose_f(space, error) + CALL CHECK(" H5Sclose_f", error, total_error) + CALL H5Dclose_f(dataset, error) + CALL CHECK(" H5Dclose_f", error, total_error) + CALL H5Fclose_f(file, error) + CALL CHECK(" H5Fclose_f", error, total_error) + +END SUBROUTINE test_scaleoffset + +END MODULE TH5MISC_1_8 diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90 index ea91631..f8bf4f6 100644 --- a/fortran/test/tH5O.f90 +++ b/fortran/test/tH5O.f90 @@ -26,9 +26,13 @@ ! test_h5o, test_h5o_link, test_h5o_plist ! !***** +MODULE TH5O + +CONTAINS SUBROUTINE test_h5o(cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -54,6 +58,7 @@ 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(OUT) :: total_error @@ -66,7 +71,6 @@ SUBROUTINE test_h5o_link(total_error) INTEGER(HID_T) :: fapl_id INTEGER(HID_T) :: lcpl_id INTEGER(HID_T) :: ocpypl_id - INTEGER(HID_T) :: mem_space_id, file_space_id, xfer_prp CHARACTER(LEN=11), PARAMETER :: TEST_FILENAME = 'TestFile.h5' INTEGER, PARAMETER :: TEST6_DIM1 = 2, TEST6_DIM2 = 5 !EP INTEGER(HSIZE_T), DIMENSION(1:2), PARAMETER :: dims = (/TEST6_DIM1,TEST6_DIM2/) @@ -74,11 +78,11 @@ SUBROUTINE test_h5o_link(total_error) !EP INTEGER, DIMENSION(1:TEST6_DIM1,1:TEST6_DIM2) :: wdata, rdata INTEGER, DIMENSION(TEST6_DIM1,TEST6_DIM2) :: wdata, rdata - INTEGER, PARAMETER :: TRUE = 1, FALSE = 0 + INTEGER, PARAMETER :: TRUE = 1 LOGICAL :: committed ! /* Whether the named datatype is committed - INTEGER :: i, n, j + INTEGER :: i, j INTEGER :: error ! /* Value returned from API calls CHARACTER(LEN=14) :: NAME_DATATYPE_SIMPLE="H5T_NATIVE_INT" @@ -91,8 +95,7 @@ SUBROUTINE test_h5o_link(total_error) INTEGER , PARAMETER :: dim0 = 4 INTEGER(HSIZE_T), DIMENSION(1:1) :: dims2 = (/dim0/) ! size read/write buffer - INTEGER , DIMENSION(1:dim0) :: wdata2, & ! Write buffer - rdata2 ! Read buffer + INTEGER , DIMENSION(1:dim0) :: wdata2 ! Write buffer LOGICAL :: link_exists CHARACTER(LEN=8) :: chr_exact CHARACTER(LEN=10) :: chr_lg @@ -576,6 +579,7 @@ 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(OUT) :: total_error @@ -789,3 +793,5 @@ SUBROUTINE test_h5o_plist(total_error) CALL check("H5Pclose_f", error, total_error) END SUBROUTINE test_h5o_plist + +END MODULE TH5O diff --git a/fortran/test/tH5O_F03.f90 b/fortran/test/tH5O_F03.f90 index f060a7d..598e83e 100644 --- a/fortran/test/tH5O_F03.f90 +++ b/fortran/test/tH5O_F03.f90 @@ -112,6 +112,10 @@ CONTAINS END MODULE visit_cb + +MODULE TH5O_F03 + +CONTAINS !/**************************************************************** !** !** test_h5o_refcount(): Test H5O refcounting functions. @@ -121,6 +125,7 @@ END MODULE visit_cb SUBROUTINE test_h5o_refcount(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -259,6 +264,7 @@ END SUBROUTINE test_h5o_refcount SUBROUTINE obj_visit(total_error) USE HDF5 + USE TH5_MISC USE visit_cb USE ISO_C_BINDING @@ -268,7 +274,6 @@ SUBROUTINE obj_visit(total_error) TYPE(ovisit_ud_t), TARGET :: udata ! User-data for visiting INTEGER(hid_t) :: fid = -1 - INTEGER(hid_t) :: gid = -1 ! Group ID TYPE(C_PTR) :: f_ptr TYPE(C_FUNPTR) :: fun_ptr CHARACTER(LEN=180) :: object_name @@ -344,6 +349,7 @@ END SUBROUTINE obj_visit SUBROUTINE obj_info(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -356,7 +362,6 @@ SUBROUTINE obj_info(total_error) TYPE(hobj_ref_t_f), TARGET :: wref ! Reference to write TYPE(hobj_ref_t_f), TARGET :: rref ! Reference to read TYPE(H5O_info_t) :: oinfo ! Object info struct - INTEGER :: count = 0 ! Count within iterated group INTEGER :: error TYPE(C_PTR) :: f_ptr @@ -477,6 +482,7 @@ END SUBROUTINE obj_info SUBROUTINE build_visit_file(fid) USE HDF5 + USE TH5_MISC IMPLICIT NONE INTEGER(hid_t) :: fid ! File ID @@ -545,3 +551,5 @@ SUBROUTINE build_visit_file(fid) CALL H5Tclose_f(tid, error) END SUBROUTINE build_visit_file + +END MODULE TH5O_F03 diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90 index 4c78334..6db6b1a 100644 --- a/fortran/test/tH5P.f90 +++ b/fortran/test/tH5P.f90 @@ -26,6 +26,9 @@ ! external_test, multi_file_test ! !***** +MODULE TH5P + +CONTAINS SUBROUTINE external_test(cleanup, total_error) @@ -34,6 +37,7 @@ SUBROUTINE external_test(cleanup, total_error) ! h5pget_external_f USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -150,6 +154,7 @@ 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 @@ -419,6 +424,7 @@ END SUBROUTINE multi_file_test SUBROUTINE test_chunk_cache(cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -427,7 +433,6 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CHARACTER(LEN=14), PARAMETER :: filename="chunk_cache" CHARACTER(LEN=80) :: fix_filename INTEGER(hid_t) :: fid = -1 ! File ID - INTEGER(hid_t) :: file INTEGER(hid_t) :: fapl_local = -1 ! Local fapl INTEGER(hid_t) :: fapl_def = -1 ! Default fapl INTEGER(hid_t) :: dcpl = -1 ! Dataset creation property list ID @@ -445,6 +450,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) INTEGER(size_t) rdcc_nelmts INTEGER(size_t) rdcc_nbytes REAL :: rdcc_w0 + LOGICAL :: differ CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) @@ -468,7 +474,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL check("H5Pget_chunk_cache_f", error, total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_1), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_1), INT(nbytes_4), total_error) - IF(w0_1.NE.w0_4)THEN + CALL compare_floats(w0_1, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF @@ -526,7 +533,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL check("H5Pget_chunk_cache_f", error, total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF(w0_2.NE.w0_4)THEN + CALL compare_floats(w0_2, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF CALL H5Pclose_f(dapl2,error) @@ -558,7 +566,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL check("H5Pget_chunk_cache_f", error, total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF(w0_3.NE.w0_4)THEN + CALL compare_floats(w0_3, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f4", .TRUE., .FALSE., total_error) ENDIF CALL H5Pclose_f(dapl2,error) @@ -578,7 +587,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL check("H5Pget_chunk_cache_f", error, total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF(w0_2.NE.w0_4)THEN + CALL compare_floats(w0_2, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF CALL H5Pclose_f(dapl2,error) @@ -598,7 +608,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL check("H5Pget_chunk_cache_f", error, total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF(w0_2.NE.w0_4)THEN + CALL compare_floats(w0_2, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF ! Don't close dapl2, we will use it in the next section @@ -635,7 +646,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL check("H5Pget_chunk_cache_f", error, total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF(w0_2.NE.w0_4)THEN + CALL compare_floats(w0_2, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF @@ -660,7 +672,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL check("H5Pget_chunk_cache_f", error, total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF(w0_3.NE.w0_4)THEN + CALL compare_floats(w0_3, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF @@ -687,3 +700,5 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL check("h5_cleanup_f", error, total_error) END SUBROUTINE test_chunk_cache + +END MODULE TH5P diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90 index 398fb87..dbc4927 100644 --- a/fortran/test/tH5P_F03.f90 +++ b/fortran/test/tH5P_F03.f90 @@ -34,7 +34,6 @@ ! ***************************************** ! *** H 5 P T E S T S ! ***************************************** - MODULE test_genprop_cls_cb1_mod ! Callback subroutine for test_genprop_class_callback @@ -70,6 +69,10 @@ CONTAINS END MODULE test_genprop_cls_cb1_mod +MODULE TH5P_F03 + +CONTAINS + !/*------------------------------------------------------------------------- ! * Function: test_create ! * @@ -90,6 +93,7 @@ END MODULE test_genprop_cls_cb1_mod SUBROUTINE test_create(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -97,8 +101,7 @@ SUBROUTINE test_create(total_error) INTEGER(HID_T) :: fapl INTEGER(hid_t) :: file=-1, space=-1, dcpl=-1, comp_type_id=-1 - INTEGER(hid_t) :: dset1=-1, dset2=-1, dset3=-1, dset4=-1, dset5=-1, & - dset6=-1, dset7=-1, dset8=-1, dset9=-1 + INTEGER(hid_t) :: dset9=-1 INTEGER(hsize_t), DIMENSION(1:5), PARAMETER :: cur_size = (/2, 8, 8, 4, 2/) INTEGER(hsize_t), DIMENSION(1:5), PARAMETER :: ch_size= (/1, 1, 1, 4, 1/) CHARACTER(LEN=14) :: filename ='test_create.h5' @@ -112,15 +115,10 @@ SUBROUTINE test_create(total_error) END TYPE comp_datatype TYPE(comp_datatype), TARGET :: rd_c, fill_ctype - - INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype - INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype - INTEGER(SIZE_T) :: type_sized ! Size of the double datatype - INTEGER(SIZE_T) :: type_sizec ! Size of the double datatype - INTEGER(SIZE_T) :: sizeof_compound ! total size of compound INTEGER :: error INTEGER(SIZE_T) :: h5off TYPE(C_PTR) :: f_ptr + LOGICAL :: differ1, differ2 !/* ! * Create a file. @@ -166,7 +164,7 @@ 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) - fill_ctype%y = 4444. + fill_ctype%y = 4444.D0 fill_ctype%z = 'S' fill_ctype%a = 5555. fill_ctype%x = 55 @@ -207,10 +205,12 @@ SUBROUTINE test_create(total_error) CALL H5Pget_fill_value_f(dcpl, comp_type_id, f_ptr, error) CALL check("H5Pget_fill_value_f", error, total_error) - IF( rd_c%a .NE. fill_ctype%a .OR. & - rd_c%y .NE. fill_ctype%y .OR. & - rd_c%x .NE. fill_ctype%x .OR. & - rd_c%z .NE. fill_ctype%z )THEN + CALL compare_floats(rd_c%a, fill_ctype%a, differ1) + CALL compare_floats(rd_c%y, fill_ctype%y, differ2) + IF( differ1 .OR. & + differ2 .OR. & + rd_c%x .NE. fill_ctype%x .OR. & + rd_c%z .NE. fill_ctype%z )THEN PRINT*,"***ERROR: Returned wrong fill value" total_error = total_error + 1 @@ -242,6 +242,7 @@ SUBROUTINE test_genprop_class_callback(total_error) ! USE HDF5 + USE TH5_MISC USE ISO_C_BINDING USE test_genprop_cls_cb1_mod IMPLICIT NONE @@ -261,8 +262,8 @@ SUBROUTINE test_genprop_class_callback(total_error) TYPE(cb_struct), TARGET :: crt_cb_struct, cls_cb_struct CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1" - TYPE(C_FUNPTR) :: f1, f3, f5 - TYPE(C_PTR) :: f2, f4, f6 + TYPE(C_FUNPTR) :: f1, f5 + TYPE(C_PTR) :: f2, f6 CHARACTER(LEN=10) :: PROP1_NAME = "Property 1" INTEGER(SIZE_T) :: PROP1_SIZE = 10 @@ -379,6 +380,7 @@ 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 @@ -451,6 +453,7 @@ 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 @@ -547,7 +550,7 @@ SUBROUTINE external_test_offset(cleanup,total_error) CALL h5sclose_f(hs_space, error) CALL check("h5sclose_f", error, total_error) - DO i = hs_start(1)+1, hs_start(1)+hs_count(1) + DO i = INT(hs_start(1))+1, INT(hs_start(1)+hs_count(1)) IF(whole(i) .NE. i-1)THEN WRITE(*,*) "Incorrect value(s) read." total_error = total_error + 1 @@ -575,3 +578,4 @@ SUBROUTINE external_test_offset(cleanup,total_error) CALL check("h5_cleanup_f", error, total_error) END SUBROUTINE external_test_offset +END MODULE TH5P_F03 diff --git a/fortran/test/tH5R.f90 b/fortran/test/tH5R.f90 index ac105fc..fbdf99f 100644 --- a/fortran/test/tH5R.f90 +++ b/fortran/test/tH5R.f90 @@ -31,8 +31,13 @@ ! !***** ! +MODULE TH5R + +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(OUT) :: total_error @@ -66,7 +71,6 @@ SUBROUTINE refobjtest(cleanup, total_error) CHARACTER(LEN=7) :: buf ! buffer to hold the region name CHARACTER(LEN=16) :: buf_big ! buffer bigger then needed - CHARACTER(LEN=4) :: buf_small ! buffer smaller then needed INTEGER(SIZE_T) :: buf_size ! returned size of the region buffer name ! @@ -241,6 +245,7 @@ END SUBROUTINE refobjtest ! 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 @@ -478,3 +483,4 @@ SUBROUTINE refregtest(cleanup, total_error) END SUBROUTINE refregtest +END MODULE TH5R diff --git a/fortran/test/tH5S.f90 b/fortran/test/tH5S.f90 index e3a44ad..ea06165 100644 --- a/fortran/test/tH5S.f90 +++ b/fortran/test/tH5S.f90 @@ -33,10 +33,14 @@ ! dataspace_basic_test ! !***** +MODULE TH5S + +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 @@ -289,3 +293,4 @@ RETURN END SUBROUTINE dataspace_basic_test +END MODULE TH5S diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90 index 1cbabe8..e4455be 100644 --- a/fortran/test/tH5Sselect.f90 +++ b/fortran/test/tH5Sselect.f90 @@ -36,10 +36,14 @@ ! ! !***** +MODULE TH5SSELECT + +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 @@ -319,6 +323,7 @@ SUBROUTINE test_select_element(cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -695,6 +700,7 @@ SUBROUTINE test_basic_select(cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -805,8 +811,6 @@ INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims - INTEGER :: i - ! !initialize the coord array to give the selected points' position ! @@ -1033,6 +1037,7 @@ SUBROUTINE test_select_point(cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -1073,10 +1078,10 @@ SUBROUTINE test_select_point(cleanup, total_error) !!$ *tbuf; /* temporary buffer pointer */ INTEGER :: i,j; !/* Counters */ ! struct pnt_iter pi; /* Custom Pointer iterator struct */ - INTEGER :: error !/* Generic return value */ + INTEGER :: error !/* Generic return value */ CHARACTER(LEN=9) :: filename = 'h5s_hyper' CHARACTER(LEN=80) :: fix_filename - CHARACTER(LEN=1), DIMENSION(1:SPACE2_DIM1,1:SPACE2_DIM2) :: wbuf, rbuf + CHARACTER(LEN=1), DIMENSION(1:SPACE2_DIM1,1:SPACE2_DIM2) :: wbuf CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) IF (error .NE. 0) THEN @@ -1357,11 +1362,11 @@ END SUBROUTINE test_select_point !** !****************************************************************/ -SUBROUTINE test_select_combine(cleanup, total_error) +SUBROUTINE test_select_combine(total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error INTEGER, PARAMETER :: SPACE7_RANK = 2 @@ -1779,11 +1784,11 @@ END SUBROUTINE test_select_combine !** !****************************************************************/ -SUBROUTINE test_select_bounds(cleanup, total_error) +SUBROUTINE test_select_bounds(total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error INTEGER, PARAMETER :: SPACE11_RANK=2 @@ -1991,3 +1996,5 @@ SUBROUTINE test_select_bounds(cleanup, total_error) CALL check("h5sclose_f", error, total_error) END SUBROUTINE test_select_bounds + +END MODULE TH5SSELECT diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index b42a8e6..60ddefb 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -27,6 +27,10 @@ ! !***** +MODULE TH5T + +CONTAINS + SUBROUTINE compoundtest(cleanup, total_error) ! ! This program creates a dataset that is one dimensional array of @@ -43,8 +47,8 @@ ! h5tget_class_f, h5tget_member_name_f, h5tget_member_offset_f, h5tget_member_type_f, ! h5tequal_f, h5tinsert_array_f, h5tcommit_f, h5tencode_f, h5tdecode_f - USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -105,11 +109,10 @@ CHARACTER(LEN=1024) :: cmpd_buf INTEGER(SIZE_T) :: cmpd_buf_size=0 - INTEGER(HID_T) :: decoded_sid1 INTEGER(HID_T) :: decoded_tid1 INTEGER(HID_T) :: fixed_str1, fixed_str2 - LOGICAL :: are_equal + LOGICAL :: are_equal, differ INTEGER(SIZE_T), PARAMETER :: str_size = 10 INTEGER(SIZE_T) :: query_size @@ -242,36 +245,6 @@ offset = offset + type_sized ! Offset of the last member is 14 CALL h5tinsert_f(dtype_id, "real_field", offset, H5T_NATIVE_REAL, error) CALL check("h5tinsert_f", error, total_error) - -!!$ !/*----------------------------------------------------------------------- -!!$ ! * Test encoding and decoding compound datatypes -!!$ ! *----------------------------------------------------------------------- -!!$ !*/ -!!$ ! /* Encode compound type in a buffer */ -!!$ -!!$ ! First find the buffer size -!!$ -!!$ CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) -!!$ CALL check("H5Tencode_f", error, total_error) -!!$ -!!$ ! /* Try decoding bogus buffer */ -!!$ -!!$ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) -!!$ CALL VERIFY("H5Tdecode_f", error, -1, total_error) -!!$ -!!$ CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) -!!$ CALL check("H5Tencode_f", error, total_error) -!!$ -!!$ ! /* Decode from the compound buffer and return an object handle */ -!!$ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) -!!$ CALL check("H5Tdecode_f", error, total_error) -!!$ -!!$ ! /* Verify that the datatype was copied exactly */ -!!$ -!!$ CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error) -!!$ CALL check("H5Tequal_f", error, total_error) -!!$ CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error) - ! ! Create the dataset with compound datatype. ! @@ -555,7 +528,8 @@ CALL h5dread_f(dset_id, dt3_id, double_member_out, data_dims, error) CALL check("h5dread_f", error, total_error) do i = 1, dimsize - if (double_member_out(i) .ne. double_member(i)) then + CALL compare_floats(double_member_out(i), double_member(i), differ) + if (differ) then write(*,*) " Wrong double precision data is read back " total_error = total_error + 1 endif @@ -573,7 +547,8 @@ CALL h5dread_f(dset_id, dt4_id, real_member_out, data_dims, error) CALL check("h5dread_f", error, total_error) do i = 1, dimsize - if (real_member_out(i) .ne. real_member(i)) then + CALL compare_floats(real_member_out(i), real_member(i), differ) + if (differ) then write(*,*) " Wrong real precision data is read back " total_error = total_error + 1 endif @@ -632,7 +607,7 @@ - SUBROUTINE basic_data_type_test(cleanup, total_error) + SUBROUTINE basic_data_type_test(total_error) ! This subroutine tests following functionalities: ! H5tget_precision_f, H5tset_precision_f, H5tget_offset_f @@ -642,9 +617,9 @@ ! H5tset_cset_f, H5tget_strpad_f, H5tset_strpad_f USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T) :: dtype1_id, dtype2_id, dtype3_id, dtype4_id, dtype5_id @@ -859,6 +834,7 @@ SUBROUTINE enumtest(cleanup, total_error) USE HDF5 + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -999,6 +975,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -1181,3 +1158,5 @@ SUBROUTINE test_derived_flt(cleanup, total_error) CALL check("h5_cleanup_f", error, total_error) END SUBROUTINE test_derived_flt + +END MODULE TH5T diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90 index a9a6487..bd6a701 100644 --- a/fortran/test/tH5T_F03.f90 +++ b/fortran/test/tH5T_F03.f90 @@ -41,15 +41,23 @@ !** !****************************************************************/ ! + +MODULE TH5T_F03 + + USE HDF5 + 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 ! 1-D dataset WITH fixed dimensions - CHARACTER(LEN=6), PARAMETER :: SPACE1_NAME = "Space1" INTEGER, PARAMETER :: SPACE1_RANK = 1 INTEGER, PARAMETER :: SPACE1_DIM1 = 4 ! 1-D array datatype @@ -63,11 +71,11 @@ SUBROUTINE test_array_compound_atomic(total_error) END TYPE s1_t TYPE(s1_t), DIMENSION(:,:), ALLOCATABLE, TARGET :: wdata ! Information to write TYPE(s1_t), DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata ! Information read in - INTEGER(hid_t) :: fid1 ! HDF5 File IDs - INTEGER(hid_t) :: dataset ! Dataset ID - INTEGER(hid_t) :: sid1 ! Dataspace ID - INTEGER(hid_t) :: tid1 ! Array Datatype ID - INTEGER(hid_t) :: tid2 ! Compound Datatype ID + INTEGER(hid_t) :: fid1 ! HDF5 File IDs + INTEGER(hid_t) :: dataset ! Dataset ID + INTEGER(hid_t) :: sid1 ! Dataspace ID + INTEGER(hid_t) :: tid1 ! Array Datatype ID + INTEGER(hid_t) :: tid2 ! Compound Datatype ID INTEGER(HSIZE_T), DIMENSION(1) :: sdims1 = (/SPACE1_DIM1/) INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/ARRAY1_DIM1/) @@ -79,14 +87,10 @@ SUBROUTINE test_array_compound_atomic(total_error) INTEGER(size_t) :: off ! Offset of compound field INTEGER(hid_t) :: mtid ! Datatype ID for field INTEGER :: i,j ! counting variables - INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype - INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype - INTEGER(SIZE_T) :: sizeof_compound ! total size of compound INTEGER :: error ! Generic RETURN value - INTEGER(SIZE_T) :: offset ! Member's offset INTEGER :: namelen - LOGICAL :: flag + LOGICAL :: flag, differ TYPE(C_PTR) :: f_ptr ! Needed to pass the pointer, for g95 compiler to work @@ -254,7 +258,8 @@ SUBROUTINE test_array_compound_atomic(total_error) PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF(wdata(i,j)%f.NE.rdata(i,j)%f)THEN + CALL compare_floats(wdata(i,j)%f, rdata(i,j)%f, differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -285,6 +290,7 @@ END SUBROUTINE test_array_compound_atomic SUBROUTINE test_array_compound_array(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -310,14 +316,13 @@ END SUBROUTINE test_array_compound_atomic TYPE(st_t_struct), DIMENSION(1:SPACE1_DIM1,1:ARRAY1_DIM1), TARGET :: rdata - INTEGER(hid_t) :: fid1 ! HDF5 File IDs - INTEGER(hid_t) :: dataset ! Dataset ID + INTEGER(hid_t) :: fid1 ! HDF5 File IDs + INTEGER(hid_t) :: dataset ! Dataset ID integer(hid_t) :: sid1 ! Dataspace ID integer(hid_t) :: tid1 ! Array Datatype ID integer(hid_t) :: tid2 ! Compound Datatype ID integer(hid_t) :: tid3 ! Nested Array Datatype ID integer(hid_t) :: tid4 ! Nested Array Datatype ID - INTEGER(HID_T) :: dt5_id ! Memory datatype identifier INTEGER(HSIZE_T), DIMENSION(1) :: sdims1 = (/SPACE1_DIM1/) INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/ARRAY1_DIM1/) @@ -326,31 +331,25 @@ END SUBROUTINE test_array_compound_atomic INTEGER ndims ! Array rank for reading INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading - INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims ! Array dimensions for reading INTEGER :: nmemb ! Number of compound members CHARACTER(LEN=20) :: mname ! Name of compound field INTEGER(size_t) :: off ! Offset of compound field - INTEGER(size_t) :: offset ! Offset of compound field INTEGER(hid_t) :: mtid ! Datatype ID for field INTEGER(hid_t) :: mtid2 ! Datatype ID for field - INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype - INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype - INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype - INTEGER(SIZE_T) :: sizeof_compound ! total size of compound INTEGER :: mclass ! Datatype class for field INTEGER :: i,j,k ! counting variables INTEGER :: error CHARACTER(LEN=2) :: ichr2 - INTEGER(SIZE_T) :: sizechar INTEGER :: namelen LOGICAL :: flag INTEGER(HID_T) :: atype_id !String Attribute Datatype identifier INTEGER(SIZE_T) :: attrlen ! Length of the attribute string TYPE(c_ptr) :: f_ptr + LOGICAL :: differ ! Initialize array data to write DO i = 1, SPACE1_DIM1 @@ -623,7 +622,8 @@ END SUBROUTINE test_array_compound_atomic total_error = total_error + 1 ENDIF DO k = 1, ARRAY2_DIM1 - IF(wdata(i,j)%f(k).NE.rdata(i,j)%f(k))THEN + CALL compare_floats(wdata(i,j)%f(k), rdata(i,j)%f(k), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real array data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -659,6 +659,7 @@ END SUBROUTINE test_array_compound_atomic SUBROUTINE test_array_bkg(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -721,9 +722,8 @@ END SUBROUTINE test_array_compound_atomic INTEGER :: error TYPE(c_ptr) :: f_ptr + LOGICAL :: differ - TYPE(c_funptr) :: func - ! Initialize the data ! ------------------- @@ -834,11 +834,13 @@ END SUBROUTINE test_array_compound_atomic PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( cf(i)%b(j) .NE. cfr(i)%b(j) )THEN + CALL compare_floats(cf(i)%b(j), cfr(i)%b(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( cf(i)%c(j) .NE. cfr(i)%c(j) )THEN + CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -901,7 +903,8 @@ END SUBROUTINE test_array_compound_atomic DO i = 1, LENGTH DO j = 1, ALEN - IF( fld(i)%b(j) .NE. fldr(i)%b(j) )THEN + CALL compare_floats(fld(i)%b(j), fldr(i)%b(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -932,11 +935,13 @@ END SUBROUTINE test_array_compound_atomic PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( cf(i)%b(j) .NE. cfr(i)%b(j) )THEN + CALL compare_floats(cf(i)%b(j), cfr(i)%b(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( cf(i)%c(j) .NE. cfr(i)%c(j) )THEN + CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -990,11 +995,13 @@ END SUBROUTINE test_array_compound_atomic PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( cf(i)%b(j) .NE. cfr(i)%b(j) )THEN + CALL compare_floats(cf(i)%b(j),cfr(i)%b(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( cf(i)%c(j) .NE. cfr(i)%c(j) )THEN + CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -1018,6 +1025,7 @@ END SUBROUTINE test_array_compound_atomic USE ISO_C_BINDING USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE @@ -1050,12 +1058,10 @@ END SUBROUTINE test_array_compound_atomic INTEGER(HID_T) :: dset_idr8 ! Dataset identifier INTEGER :: error ! Error flag - INTEGER :: i, j + INTEGER :: i ! Data buffers: - INTEGER, DIMENSION(1:4) :: dset_data - INTEGER(int_kind_1), DIMENSION(1:4), TARGET :: dset_data_i1, data_out_i1 INTEGER(int_kind_4), DIMENSION(1:4), TARGET :: dset_data_i4, data_out_i4 INTEGER(int_kind_8), DIMENSION(1:4), TARGET :: dset_data_i8, data_out_i8 @@ -1069,7 +1075,6 @@ END SUBROUTINE test_array_compound_atomic INTEGER(HID_T) :: dspace_id ! Dataspace identifier TYPE(C_PTR) :: f_ptr - INTEGER(hid_t) :: datatype ! Common datatype ID ! ! Initialize the dset_data array. @@ -1220,8 +1225,9 @@ END SUBROUTINE test_h5kind_to_type !************************************************************ SUBROUTINE t_array(total_error) - USE HDF5 USE ISO_C_BINDING + USE HDF5 + USE TH5_MISC IMPLICIT NONE @@ -1233,10 +1239,8 @@ SUBROUTINE t_array(total_error) INTEGER , PARAMETER :: adim0 = 3 INTEGER , PARAMETER :: adim1 = 5 INTEGER(HID_T) :: file, filetype, memtype, space, dset ! Handles - INTEGER :: hdferr INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/) INTEGER(HSIZE_T), DIMENSION(1:2) :: adims = (/adim0, adim1/) - INTEGER(HSIZE_T), DIMENSION(1:3) :: bdims = (/dim0, adim0, adim1/) INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims INTEGER, DIMENSION(1:dim0, 1:adim0, 1:adim1), TARGET :: wdata ! Write buffer INTEGER, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: rdata ! Read buffer @@ -1337,9 +1341,9 @@ SUBROUTINE t_array(total_error) ! ! Output the data to the screen. ! - i_loop: DO i = 1, dims(1) - DO j=1, adim0 - DO k = 1, adim1 + i_loop: DO i = 1, INT(dims(1)) + DO j=1, INT(adim0) + DO k = 1, INT(adim1) CALL VERIFY("H5Sget_simple_extent_dims_f", rdata(i,j,k), wdata(i,j,k), total_error) IF(total_error.NE.0) EXIT i_loop ENDDO @@ -1365,6 +1369,7 @@ END SUBROUTINE t_array SUBROUTINE t_enum(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -1497,8 +1502,8 @@ SUBROUTINE t_enum(total_error) ! ! Output the data to the screen. ! - i_loop: DO i = 1, dims(1) - DO j = 1, dims(2) + i_loop: DO i = 1, INT(dims(1)) + DO j = 1, INT(dims(2)) ! ! Get the name of the enumeration member. ! @@ -1527,6 +1532,7 @@ END SUBROUTINE t_enum SUBROUTINE t_bit(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -1617,8 +1623,8 @@ SUBROUTINE t_bit(total_error) ! ! Output the data to the screen. ! - i_loop: DO i = 1, dims(1) - DO j = 1, dims(2) + i_loop: DO i = 1, INT(dims(1)) + DO j = 1, INT(dims(2)) A = IAND(rdata(i,j), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "A" B = IAND(ISHFT(rdata(i,j),-2), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "B" C = IAND(ISHFT(rdata(i,j),-4), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "C" @@ -1652,6 +1658,7 @@ END SUBROUTINE t_bit SUBROUTINE t_opaque(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -1675,7 +1682,7 @@ SUBROUTINE t_opaque(total_error) INTEGER :: taglen INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims - INTEGER :: i + INTEGER(hsize_t) :: i CHARACTER(LEN=1) :: ichr TYPE(C_PTR) :: f_ptr INTEGER :: error @@ -1799,6 +1806,7 @@ END SUBROUTINE t_opaque SUBROUTINE t_objref(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -1905,7 +1913,7 @@ SUBROUTINE t_objref(total_error) ! ! Output the data to the screen. ! - DO i = 1, maxdims(1) + DO i = 1, INT(maxdims(1)) ! ! Open the referenced object, get its name and type. ! @@ -1951,6 +1959,7 @@ END SUBROUTINE t_objref SUBROUTINE t_regref(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -1984,7 +1993,7 @@ SUBROUTINE t_regref(total_error) CHARACTER(LEN=80),DIMENSION(1:1), TARGET :: rdata2 CHARACTER(LEN=80) :: name - INTEGER :: i + INTEGER(hsize_t) :: i TYPE(C_PTR) :: f_ptr CHARACTER(LEN=ds2dim0) :: chrvar CHARACTER(LEN=20), DIMENSION(1:2) :: chrref_correct @@ -2150,6 +2159,7 @@ END SUBROUTINE t_regref SUBROUTINE t_vlen(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -2159,7 +2169,7 @@ SUBROUTINE t_vlen(total_error) CHARACTER(LEN=3) , PARAMETER :: dataset = "DS1" INTEGER, PARAMETER :: LEN0 = 3 INTEGER, PARAMETER :: LEN1 = 12 - INTEGER :: dim0 + INTEGER(hsize_t) :: dim0 INTEGER(HID_T) :: file, filetype, memtype, space, dset ! Handles INTEGER :: error @@ -2266,7 +2276,7 @@ SUBROUTINE t_vlen(total_error) dim0 = dims(1) 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(1)), INT(dim0), total_error) ! ! Create the memory datatype. @@ -2281,7 +2291,7 @@ SUBROUTINE t_vlen(total_error) CALL H5Dread_f(dset, memtype, f_ptr, error) CALL check("H5Dread_f",error, total_error) - DO i = 1, dims(1) + DO i = 1, INT(dims(1)) CALL c_f_pointer(rdata(i)%p, ptr_r, [rdata(i)%len] ) DO j = 1, rdata(i)%len CALL VERIFY("t_vlen", ptr_r(j), ptr(i)%data(j), total_error) @@ -2307,6 +2317,7 @@ END SUBROUTINE t_vlen SUBROUTINE t_vlstring(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -2328,7 +2339,7 @@ SUBROUTINE t_vlstring(total_error) CHARACTER(LEN=sdim), DIMENSION(:), ALLOCATABLE :: rdata ! Read buffer INTEGER(HSIZE_T), DIMENSION(2) :: data_dims = (/sdim,dim0/) INTEGER(SIZE_T), DIMENSION(4) :: str_len = (/7,7,5,7/) - INTEGER :: i + INTEGER(hsize_t) :: i ! ! Create a new file using the default properties. @@ -2427,6 +2438,7 @@ 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 @@ -2439,7 +2451,6 @@ SUBROUTINE t_vlstring_readwrite(total_error) INTEGER(HSIZE_T) , PARAMETER :: dim0 = 4 INTEGER(HSIZE_T) , PARAMETER :: dim1 = 2 - INTEGER(SIZE_T) , PARAMETER :: sdim = 7 INTEGER(HID_T) :: file, filetype, space, dset ! Handles INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/) INTEGER(HSIZE_T), DIMENSION(1:2) :: dims2D = (/dim1,dim0/) @@ -2468,7 +2479,8 @@ SUBROUTINE t_vlstring_readwrite(total_error) CHARACTER(len=8, kind=c_char), DIMENSION(1:4) :: data_w ! A pointer to a Fortran string CHARACTER(len=8, kind=c_char), DIMENSION(1:dim1,1:dim0) :: data2D_w ! A pointer to a Fortran string TYPE(C_PTR) :: f_ptr - INTEGER :: i, j, len + INTEGER(hsize_t) :: i, j + INTEGER :: len INTEGER :: error ! Initialize array of C pointers @@ -2677,6 +2689,7 @@ END SUBROUTINE t_vlstring_readwrite SUBROUTINE t_string(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -2697,7 +2710,7 @@ SUBROUTINE t_string(total_error) CHARACTER(LEN=sdim), DIMENSION(1:dim0), TARGET :: & wdata = (/"Parting", "is such", "sweet ", "sorrow."/) CHARACTER(LEN=sdim), DIMENSION(:), ALLOCATABLE, TARGET :: rdata - INTEGER :: i + INTEGER(hsize_t) :: i INTEGER(SIZE_T) :: size TYPE(C_PTR) :: f_ptr ! @@ -2800,23 +2813,23 @@ SUBROUTINE t_string(total_error) END SUBROUTINE t_string -SUBROUTINE vl_test_special_char(cleanup, total_error) +SUBROUTINE vl_test_special_char(total_error) - USE hdf5 + USE HDF5 + USE TH5_MISC IMPLICIT NONE - INTERFACE - SUBROUTINE setup_buffer(data_in, line_lengths, char_type) - USE hdf5 - USE ISO_C_BINDING - IMPLICIT NONE - CHARACTER(len=*), DIMENSION(:) :: data_in - INTEGER(size_t), DIMENSION(:) :: line_lengths - CHARACTER(KIND=C_CHAR,LEN=*) :: char_type - END SUBROUTINE setup_buffer - END INTERFACE +! INTERFACE +! SUBROUTINE setup_buffer(data_in, line_lengths, char_type) +! USE HDF5 +! USE ISO_C_BINDING +! IMPLICIT NONE +! CHARACTER(len=*), DIMENSION(:) :: data_in +! INTEGER(size_t), DIMENSION(:) :: line_lengths +! CHARACTER(KIND=C_CHAR,LEN=*) :: char_type +! END SUBROUTINE setup_buffer +! END INTERFACE - LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=16), PARAMETER :: filename = "t_controlchar.h5" @@ -2967,14 +2980,14 @@ END SUBROUTINE setup_buffer !------------------------------------------------------------------------- ! -SUBROUTINE test_nbit(cleanup, total_error ) +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 - LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error INTEGER(hid_t) :: file @@ -2991,8 +3004,9 @@ SUBROUTINE test_nbit(cleanup, total_error ) INTEGER(size_t) :: PRECISION, offset INTEGER :: error LOGICAL :: status - INTEGER(size_t) :: i, j + INTEGER(hsize_t) :: i, j TYPE(C_PTR) :: f_ptr + LOGICAL :: differ ! check to see if filter is available CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error) @@ -3065,7 +3079,8 @@ SUBROUTINE test_nbit(cleanup, 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(new_data(i,j) .NE. orig_data(i,j))THEN + CALL compare_floats(new_data(i,j), orig_data(i,j), differ) + IF(differ)THEN total_error = total_error + 1 WRITE(*,'(" Read different values than written.")') WRITE(*,'(" At index ", 2(1X,I0))') i, j @@ -3114,6 +3129,7 @@ SUBROUTINE t_enum_conv(total_error) !------------------------------------------------------------------------- ! USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -3125,7 +3141,7 @@ SUBROUTINE t_enum_conv(total_error) INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors - INTEGER(hid_t) :: cwg=-1, dtype=-1, space=-1, dset=-1, memtype ! Handles + INTEGER(hid_t) :: cwg=-1, dtype=-1, space=-1, dset=-1 ! Handles INTEGER(hid_t) :: file ! Handles ! Enumerated type @@ -3161,6 +3177,7 @@ SUBROUTINE t_enum_conv(total_error) INTEGER(hsize_t), DIMENSION(1:1) :: ds_size = (/20/) INTEGER(size_t) :: i + INTEGER(hsize_t) :: ih INTEGER :: error TYPE(C_PTR) :: f_ptr INTEGER(HID_T) :: m_baset ! Memory base type @@ -3223,10 +3240,10 @@ SUBROUTINE t_enum_conv(total_error) CALL check(" h5dread_f", error, total_error) ! Check values - DO i = 1, ds_size(1) - IF(data1(i) .NE. data2(i))THEN + DO ih = 1, ds_size(1) + IF(data1(ih) .NE. data2(ih))THEN total_error = total_error + 1 - WRITE(*,'(" 1. data1(",I0,")=",I0," .NE. data2(",I0,")=",I0)') i, data1(i),i,data2(i) + WRITE(*,'(" 1. data1(",I0,")=",I0," .NE. data2(",I0,")=",I0)') ih, data1(ih),i,data2(ih) EXIT ENDIF ENDDO @@ -3237,10 +3254,10 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) ! Check values - DO i = 1, ds_size(1) - IF(data1(i) .NE. data_short(i))THEN + DO ih = 1, ds_size(1) + IF(data1(ih) .NE. data_short(ih))THEN total_error = total_error + 1 - WRITE(*,'(" 2. data1(",I0,")=",I0," .NE. data_short(",I0,")=",I0)') i, data1(i),i,data_short(i) + WRITE(*,'(" 2. data1(",I0,")=",I0," .NE. data_short(",I0,")=",I0)') ih, data1(ih),i,data_short(ih) EXIT ENDIF ENDDO @@ -3253,11 +3270,11 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) ! Check values - DO i = 1, ds_size(1) - IF(data1(i) .NE. INT(data_double(i)))THEN + DO ih = 1, ds_size(1) + IF(data1(ih) .NE. INT(data_double(ih)))THEN total_error = total_error + 1 WRITE(*,'(" 3. data_double(",I0,")=",I0," .NE. data_double(",I0,")=",I0)') & - i, INT(data1(i)), i, INT(data_double(i)) + ih, INT(data1(ih)), ih, INT(data_double(ih)) EXIT ENDIF ENDDO @@ -3270,11 +3287,11 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) ! Check values - DO i = 1, ds_size(1) - IF(data1(i) .NE. INT(data_i8(i)))THEN + DO ih = 1, ds_size(1) + IF(data1(ih) .NE. INT(data_i8(ih)))THEN total_error = total_error + 1 WRITE(*,'(" 4. data_i8(",I0,")=",I0," .NE. data_i8(",I0,")=",I0)') & - i, INT(data1(i)), i, INT(data_i8(i)) + ih, INT(data1(ih)), i, INT(data_i8(ih)) EXIT ENDIF ENDDO @@ -3287,11 +3304,11 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) ! Check values - DO i = 1, ds_size(1) - IF(data1(i) .NE. INT(data_i16(i)))THEN + DO ih = 1, ds_size(1) + IF(data1(ih) .NE. INT(data_i16(ih)))THEN total_error = total_error + 1 WRITE(*,'(" 5. data_i16(",I0,")=",I0," .NE. data_i16(",I0,")=",I0)') & - i, INT(data1(i)), i, INT(data_i16(i)) + ih, INT(data1(ih)), i, INT(data_i16(ih)) EXIT ENDIF ENDDO @@ -3304,11 +3321,11 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) ! Check values - DO i = 1, ds_size(1) - IF(data1(i) .NE. INT(data_r7(i)))THEN + DO ih = 1, ds_size(1) + IF(data1(ih) .NE. INT(data_r7(ih)))THEN total_error = total_error + 1 WRITE(*,'(" 6. data_r7(",I0,")=",I0," .NE. data_r7(",I0,")=",I0)') & - i, INT(data1(i)), i, INT(data_r7(i)) + ih, INT(data1(ih)), i, INT(data_r7(ih)) EXIT ENDIF ENDDO @@ -3335,10 +3352,10 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) - DO i = 1, ds_size(1) - IF(data1(i) .NE. data_int(i))THEN + DO ih = 1, ds_size(1) + IF(data1(ih) .NE. data_int(ih))THEN total_error = total_error + 1 - WRITE(*,'(" 7. data1(",I0,")=",I0," .NE. data_int(",I0,")=",I0)') i, data1(i),i,data_int(i) + WRITE(*,'(" 7. data1(",I0,")=",I0," .NE. data_int(",I0,")=",I0)') ih, data1(ih),i,data_int(ih) EXIT ENDIF ENDDO @@ -3363,10 +3380,10 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) - DO i = 1, ds_size(1) - IF(data1(i) .NE. INT(data_double(i)))THEN + DO ih = 1, ds_size(1) + IF(data1(ih) .NE. INT(data_double(ih)))THEN total_error = total_error + 1 - WRITE(*,'(" 8. data1(",I0,")=",I0," .NE. data_double(",I0,")=",I0)') i, data1(i),i,INT(data_double(i)) + WRITE(*,'(" 8. data1(",I0,")=",I0," .NE. data_double(",I0,")=",I0)') ih, data1(ih),ih,INT(data_double(ih)) EXIT ENDIF ENDDO @@ -3391,10 +3408,10 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) - DO i = 1, ds_size(1) - IF(data1(i) .NE. INT(data_r7(i)))THEN + DO ih = 1, ds_size(1) + IF(data1(ih) .NE. INT(data_r7(ih)))THEN total_error = total_error + 1 - WRITE(*,'(" 9. data1(",I0,")=",I0," .NE. data_r7(",I0,")=",I0)') i, data1(i),i,INT(data_r7(i)) + WRITE(*,'(" 9. data1(",I0,")=",I0," .NE. data_r7(",I0,")=",I0)') ih, data1(ih),ih,INT(data_r7(ih)) EXIT ENDIF ENDDO @@ -3420,10 +3437,10 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) - DO i = 1, ds_size(1) - IF(data1(i) .NE. data_i16(i))THEN + DO ih = 1, ds_size(1) + IF(data1(ih) .NE. data_i16(ih))THEN total_error = total_error + 1 - WRITE(*,'(" 10. data1(",I0,")=",I0," .NE. data_i16(",I0,")=",I0)') i, data1(i),i,data_i16(i) + WRITE(*,'(" 10. data1(",I0,")=",I0," .NE. data_i16(",I0,")=",I0)') ih, data1(ih),ih,data_i16(ih) EXIT ENDIF ENDDO @@ -3444,3 +3461,4 @@ SUBROUTINE t_enum_conv(total_error) END SUBROUTINE t_enum_conv +END MODULE TH5T_F03 diff --git a/fortran/test/tH5VL.f90 b/fortran/test/tH5VL.f90 index 85feb2b..d34b42c 100644 --- a/fortran/test/tH5VL.f90 +++ b/fortran/test/tH5VL.f90 @@ -27,8 +27,13 @@ ! !***** +MODULE TH5VL + +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 @@ -54,6 +59,7 @@ INTEGER :: error ! Error flag INTEGER :: i, j !general purpose integers + INTEGER(HSIZE_T) :: ih, jh !general purpose integers INTEGER(HSIZE_T), DIMENSION(2) :: data_dims = (/5,6/) INTEGER(SIZE_T) max_len @@ -150,14 +156,14 @@ CALL h5dread_vl_f(dset_id, vltype_id, vl_int_data_out, data_dims, len_out, & error, mem_space_id = dspace_id, file_space_id = dspace_id) CALL check("h5dread_int_f", error, total_error) - do i = 1, data_dims(2) - do j = 1, len_out(i) - if(vl_int_data(j,i) .ne. vl_int_data_out(j,i)) then + do ih = 1, data_dims(2) + do jh = 1, len_out(ih) + if(vl_int_data(jh,ih) .ne. vl_int_data_out(jh,ih)) then total_error = total_error + 1 write(*,*) "h5dread_vl_f returned incorrect data" endif enddo - if (len(i) .ne. len_out(i)) then + if (len(ih) .ne. len_out(ih)) then total_error = total_error + 1 write(*,*) "h5dread_vl_f returned incorrect data" endif @@ -189,6 +195,7 @@ SUBROUTINE vl_test_real(cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -214,10 +221,12 @@ INTEGER :: error ! Error flag INTEGER :: i, j !general purpose integers + INTEGER(HSIZE_T) :: ih, jh !general purpose integers INTEGER(HSIZE_T), DIMENSION(2) :: data_dims = (/5,6/) INTEGER(SIZE_T) max_len INTEGER(HID_T) :: vl_type_id LOGICAL :: vl_flag + LOGICAL :: differ ! ! Initialize the vl_int_data array. @@ -320,14 +329,15 @@ 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 i = 1, data_dims(2) - do j = 1, len_out(i) - if(vl_real_data(j,i) .ne. vl_real_data_out(j,i)) then + do ih = 1, data_dims(2) + do jh = 1, len_out(ih) + CALL compare_floats(vl_real_data(jh,ih), vl_real_data_out(jh,ih), differ) + if(differ) then total_error = total_error + 1 write(*,*) "h5dread_vl_f returned incorrect data" endif enddo - if (len(i) .ne. len_out(i)) then + if (len(ih) .ne. len_out(ih)) then total_error = total_error + 1 write(*,*) "h5dread_vl_f returned incorrect data" endif @@ -360,6 +370,7 @@ SUBROUTINE vl_test_string(cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -383,7 +394,7 @@ CHARACTER(LEN=10), DIMENSION(4) :: string_data_out ! Data buffers INTEGER :: error ! Error flag - INTEGER :: i !general purpose integers + INTEGER(HSIZE_T) :: ih !general purpose integers INTEGER(HSIZE_T), DIMENSION(2) :: data_dims = (/10,4/) INTEGER(HID_T) :: vl_type_id LOGICAL :: vl_flag @@ -474,13 +485,13 @@ CALL h5dread_vl_f(dset_id, H5T_STRING, string_data_out, data_dims, & str_len_out, error) CALL check("h5dread_string_f", error, total_error) - do 100 i = 1, data_dims(2) - if(str_len(i) .ne. str_len_out(i)) then + do 100 ih = 1, data_dims(2) + if(str_len(ih) .ne. str_len_out(ih)) then total_error=total_error + 1 write(*,*) 'Returned string length is incorrect' goto 100 endif - if(string_data(1)(1:str_len(i)) .ne. string_data_out(1)(1:str_len(i))) then + if(string_data(1)(1:str_len(ih)) .ne. string_data_out(1)(1:str_len(ih))) then write(*,*) ' Returned string is wrong' total_error = total_error + 1 endif @@ -506,4 +517,4 @@ RETURN END SUBROUTINE vl_test_string - +END MODULE TH5VL diff --git a/fortran/test/tH5Z.f90 b/fortran/test/tH5Z.f90 index cd6a343..4201960 100644 --- a/fortran/test/tH5Z.f90 +++ b/fortran/test/tH5Z.f90 @@ -26,15 +26,18 @@ ! filters_test, szip_test ! !***** +MODULE TH5Z - SUBROUTINE filters_test(cleanup, total_error) +CONTAINS + + SUBROUTINE filters_test(total_error) ! This subroutine tests following functionalities: h5zfilter_avail_f, h5zunregister_f USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error LOGICAL :: status INTEGER(HID_T) :: crtpr_id, xfer_id @@ -165,6 +168,7 @@ SUBROUTINE szip_test(szip_flag, cleanup, total_error) USE HDF5 ! This module contains all necessary modules + USE TH5_MISC IMPLICIT NONE LOGICAL, INTENT(OUT) :: szip_flag @@ -412,3 +416,4 @@ RETURN END SUBROUTINE szip_test +END MODULE TH5Z diff --git a/fortran/test/tHDF5.f90 b/fortran/test/tHDF5.f90 new file mode 100644 index 0000000..e73fed2 --- /dev/null +++ b/fortran/test/tHDF5.f90 @@ -0,0 +1,45 @@ +!****h* ROBODoc/HDF5 +! +! NAME +! MODULE THDF5 +! +! FILE +! src/fortran/test/tHDF5.f90 +! +! PURPOSE +! This is the test module used for testing the Fortran90 HDF library APIs. +! +! 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 THDF5 + USE TH5_MISC + USE TH5A + USE TH5D + USE TH5E + USE TH5F + USE TH5G + USE TH5I + USE TH5P + USE TH5R + USE TH5S + USE TH5SSELECT + USE TH5T + USE TH5VL + USE TH5Z +END MODULE THDF5 diff --git a/fortran/test/tHDF5_1_8.f90 b/fortran/test/tHDF5_1_8.f90 new file mode 100644 index 0000000..47eec16 --- /dev/null +++ b/fortran/test/tHDF5_1_8.f90 @@ -0,0 +1,38 @@ +!****h* ROBODoc/HDF5 +! +! NAME +! MODULE THDF5_1_8 +! +! FILE +! src/fortran/test/tHDF5_1_8.f90 +! +! PURPOSE +! This is the test module used for testing the Fortran90 HDF library +! 1.8.* APIs +! +! 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 THDF5_1_8 + USE TH5_MISC + USE TH5MISC_1_8 + USE TH5A_1_8 + USE TH5G_1_8 + USE TH5F + USE TH5O +END MODULE THDF5_1_8 diff --git a/fortran/test/tHDF5_F03.f90 b/fortran/test/tHDF5_F03.f90 new file mode 100644 index 0000000..3dbec11 --- /dev/null +++ b/fortran/test/tHDF5_F03.f90 @@ -0,0 +1,39 @@ +!****h* ROBODoc/HDF5 +! +! NAME +! MODULE THDF5_F03 +! +! FILE +! src/fortran/test/tHDF5_F03.f90 +! +! PURPOSE +! This is the test module used for testing the Fortran2003 HDF +! library APIS. +! +! 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 THDF5_F03 + USE TH5_MISC + USE TH5E_F03 + USE TH5F_F03 + USE TH5L_F03 + USE TH5O_F03 + USE TH5P_F03 + USE TH5T_F03 +END MODULE THDF5_F03 diff --git a/fortran/test/tf.f90 b/fortran/test/tf.f90 index 4f73fda..cfa403a 100644 --- a/fortran/test/tf.f90 +++ b/fortran/test/tf.f90 @@ -28,18 +28,62 @@ ! !***** +MODULE TH5_MISC + + +INTERFACE compare_floats + MODULE PROCEDURE compare_floats_4 + MODULE PROCEDURE compare_floats_8 +END INTERFACE + +CONTAINS + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: compare_floats_4 +!DEC$endif +SUBROUTINE compare_floats_4(val1, val2, stat) + INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(6, 37) !should map to REAL*4 on most modern processors + REAL(sp) :: val1, val2 + LOGICAL, INTENT(OUT) :: stat + REAL(sp) :: EPS4 = 1.E-06 + stat = .TRUE. + IF (ABS(val1 - val2) .LE. EPS4) THEN + stat = .FALSE. + ENDIF + RETURN +END SUBROUTINE compare_floats_4 + + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: compare_floats_8 +!DEC$endif +SUBROUTINE compare_floats_8(val1, val2, stat) + INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15, 307) !should map to REAL*8 on most modern processors + REAL(dp) :: val1, val2 + LOGICAL, INTENT(OUT) :: stat + REAL(dp) :: EPS8 = 1.D-12 + stat = .TRUE. + IF (ABS(val1 - val2) .LE. EPS8) THEN + stat = .FALSE. + ENDIF + RETURN +END SUBROUTINE compare_floats_8 + !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: verify_real_kind_7 !DEC$endif SUBROUTINE verify_real_kind_7(string,value,correct_value,total_error) USE HDF5 - INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors CHARACTER(LEN=*) :: string REAL(real_kind_7) :: value, correct_value INTEGER :: total_error - IF (value .NE. correct_value) THEN + LOGICAL :: differ + CALL compare_floats(value, correct_value, differ) + IF (differ) THEN total_error=total_error+1 WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string ENDIF @@ -121,7 +165,8 @@ 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, total_error + 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 @@ -356,4 +401,4 @@ SUBROUTINE h5_env_nocleanup_f(HDF5_NOCLEANUP) ENDIF END SUBROUTINE h5_env_nocleanup_f - +END MODULE TH5_MISC |