summaryrefslogtreecommitdiffstats
path: root/fortran/test
diff options
context:
space:
mode:
Diffstat (limited to 'fortran/test')
-rw-r--r--fortran/test/CMakeLists.txt4
-rw-r--r--fortran/test/Makefile.am16
-rw-r--r--fortran/test/Makefile.in98
-rw-r--r--fortran/test/fflush1.f903
-rw-r--r--fortran/test/fflush2.f902
-rw-r--r--fortran/test/fortranlib_test.f9019
-rw-r--r--fortran/test/fortranlib_test_1_8.f90445
-rw-r--r--fortran/test/fortranlib_test_F03.f904
-rw-r--r--fortran/test/tH5A.f9014
-rw-r--r--fortran/test/tH5A_1_8.f9061
-rw-r--r--fortran/test/tH5D.f9017
-rw-r--r--fortran/test/tH5E.f908
-rw-r--r--fortran/test/tH5E_F03.f9030
-rw-r--r--fortran/test/tH5F.f9014
-rw-r--r--fortran/test/tH5F_F03.f909
-rw-r--r--fortran/test/tH5G.f907
-rw-r--r--fortran/test/tH5G_1_8.f9073
-rw-r--r--fortran/test/tH5I.f906
-rw-r--r--fortran/test/tH5L_F03.f9028
-rw-r--r--fortran/test/tH5MISC_1_8.f90474
-rw-r--r--fortran/test/tH5O.f9016
-rw-r--r--fortran/test/tH5O_F03.f9012
-rw-r--r--fortran/test/tH5P.f9031
-rw-r--r--fortran/test/tH5P_F03.f9038
-rw-r--r--fortran/test/tH5R.f908
-rw-r--r--fortran/test/tH5S.f905
-rw-r--r--fortran/test/tH5Sselect.f9023
-rw-r--r--fortran/test/tH5T.f9053
-rw-r--r--fortran/test/tH5T_F03.f90226
-rw-r--r--fortran/test/tH5VL.f9037
-rw-r--r--fortran/test/tH5Z.f909
-rw-r--r--fortran/test/tHDF5.f9045
-rw-r--r--fortran/test/tHDF5_1_8.f9038
-rw-r--r--fortran/test/tHDF5_F03.f9039
-rw-r--r--fortran/test/tf.f9053
35 files changed, 1139 insertions, 826 deletions
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