From 32703c9fc5a315a005abf26965d5545043fd3605 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Mon, 8 Jun 2015 16:13:15 -0500 Subject: [svn-r27164] various bug fixes for DT --- MANIFEST | 8 +- Makefile.in | 1 + c++/Makefile.in | 1 + c++/examples/Makefile.in | 1 + c++/src/Makefile.in | 1 + c++/test/Makefile.in | 1 + configure | 86 +- configure.ac | 13 +- examples/Makefile.in | 1 + fortran/Makefile.in | 1 + fortran/examples/Makefile.in | 1 + fortran/examples/rwdset_fortran2003.f90 | 12 +- fortran/src/H5_ff.F90 | 2 + fortran/src/H5config_f.inc.in | 3 + fortran/src/H5match_types.c | 4 +- fortran/src/Makefile.in | 1 + fortran/test/Makefile.in | 1 + fortran/test/tH5T.f90 | 2 + fortran/test/tH5T_F03.F90 | 17 +- fortran/testpar/Makefile.in | 1 + hl/Makefile.in | 1 + hl/c++/Makefile.in | 1 + hl/c++/examples/Makefile.in | 1 + hl/c++/src/Makefile.in | 1 + hl/c++/test/Makefile.in | 1 + hl/examples/Makefile.in | 1 + hl/fortran/Makefile.in | 1 + hl/fortran/examples/Makefile.in | 1 + hl/fortran/src/H5LTff.F90 | 2 +- hl/fortran/src/Makefile.in | 1 + hl/fortran/test/Makefile.am | 8 +- hl/fortran/test/Makefile.in | 40 +- hl/fortran/test/tstds.F90 | 353 +++++++ hl/fortran/test/tstds.f90 | 353 ------- hl/fortran/test/tstimage.F90 | 339 ++++++ hl/fortran/test/tstimage.f90 | 339 ------ hl/fortran/test/tstlite.F90 | 1715 +++++++++++++++++++++++++++++++ hl/fortran/test/tstlite.f90 | 1711 ------------------------------ hl/fortran/test/tsttable.F90 | 465 +++++++++ hl/fortran/test/tsttable.f90 | 465 --------- hl/src/Makefile.in | 1 + hl/test/Makefile.in | 1 + hl/tools/Makefile.in | 1 + hl/tools/gif2h5/Makefile.in | 1 + m4/aclocal_fc.m4 | 34 + src/H5config.h.in | 3 + src/Makefile.in | 1 + test/Makefile.in | 1 + testpar/Makefile.in | 1 + tools/Makefile.in | 1 + tools/h5copy/Makefile.in | 1 + tools/h5diff/Makefile.in | 1 + tools/h5dump/Makefile.in | 1 + tools/h5import/Makefile.in | 1 + tools/h5jam/Makefile.in | 1 + tools/h5ls/Makefile.in | 1 + tools/h5repack/Makefile.in | 1 + tools/h5stat/Makefile.in | 1 + tools/lib/Makefile.in | 1 + tools/misc/Makefile.in | 1 + tools/perform/Makefile.in | 1 + 61 files changed, 3096 insertions(+), 2917 deletions(-) create mode 100644 hl/fortran/test/tstds.F90 delete mode 100644 hl/fortran/test/tstds.f90 create mode 100644 hl/fortran/test/tstimage.F90 delete mode 100644 hl/fortran/test/tstimage.f90 create mode 100644 hl/fortran/test/tstlite.F90 delete mode 100644 hl/fortran/test/tstlite.f90 create mode 100644 hl/fortran/test/tsttable.F90 delete mode 100644 hl/fortran/test/tsttable.f90 diff --git a/MANIFEST b/MANIFEST index 8ff62b6..7da4d28 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2339,10 +2339,10 @@ ./hl/fortran/src/Makefile.in ./hl/fortran/test/Makefile.am ./hl/fortran/test/Makefile.in -./hl/fortran/test/tstds.f90 -./hl/fortran/test/tstimage.f90 -./hl/fortran/test/tstlite.f90 -./hl/fortran/test/tsttable.f90 +./hl/fortran/test/tstds.F90 +./hl/fortran/test/tstimage.F90 +./hl/fortran/test/tstlite.F90 +./hl/fortran/test/tsttable.F90 # hl c++ ./hl/c++/COPYING diff --git a/Makefile.in b/Makefile.in index a1edd4c..6088c33 100644 --- a/Makefile.in +++ b/Makefile.in @@ -353,6 +353,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/c++/Makefile.in b/c++/Makefile.in index 8fdfb06..c916f89 100644 --- a/c++/Makefile.in +++ b/c++/Makefile.in @@ -513,6 +513,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/c++/examples/Makefile.in b/c++/examples/Makefile.in index 433f3e2..bebe35d 100644 --- a/c++/examples/Makefile.in +++ b/c++/examples/Makefile.in @@ -461,6 +461,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/c++/src/Makefile.in b/c++/src/Makefile.in index dcfac25..83d515a 100644 --- a/c++/src/Makefile.in +++ b/c++/src/Makefile.in @@ -524,6 +524,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/c++/test/Makefile.in b/c++/test/Makefile.in index 0b8ae50..bba5059 100644 --- a/c++/test/Makefile.in +++ b/c++/test/Makefile.in @@ -515,6 +515,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/configure b/configure index 8fddc6a..554db12 100755 --- a/configure +++ b/configure @@ -719,6 +719,7 @@ am__fastdepCXX_TRUE CXXDEPMODE ac_ct_CXX CXXFLAGS +PAC_C_MAX_REAL_PRECISION FORTRAN_HAVE_C_LONG_DOUBLE HAVE_Fortran_INTEGER_SIZEOF_16 PAC_FORTRAN_NATIVE_DOUBLE_SIZEOF @@ -6980,8 +6981,8 @@ rm -f core conftest.err conftest.$ac_objext \ else if test "X$HAVE_SIZEOF_FORTRAN" = "Xyes";then FC_SIZEOF_A="SIZEOF(a)" - FC_SIZEOF_B="SIZEOF(a)" - FC_SIZEOF_C="SIZEOF(a)" + FC_SIZEOF_B="SIZEOF(b)" + FC_SIZEOF_C="SIZEOF(c)" else ## If neither intrinsic functions SIZEOF or STORAGE_SIZE is available then stop configure with an error as_fn_error $? "Fortran compiler requires either intrinsic functions SIZEOF or STORAGE_SIZE" "$LINENO" 5 @@ -7490,6 +7491,7 @@ ac_compiler_gnu=$ac_cv_fc_compiler_gnu + ## Setting definition if there is a 16 byte fortran integer if `echo $PAC_FC_ALL_INTEGER_KINDS_SIZEOF | grep '16' >/dev/null`; then HAVE_Fortran_INTEGER_SIZEOF_16="1" @@ -7537,18 +7539,88 @@ $as_echo "#define FORTRAN_HAVE_C_LONG_DOUBLE 1" >>confdefs.h $as_echo "#define FORTRAN_SIZEOF_LONG_DOUBLE SIZEOF_LONG_DOUBLE" >>confdefs.h -else - FC="no" -fi - ## Change back to the C language -ac_ext=c + ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking maximum decimal precision for C" >&5 +$as_echo_n "checking maximum decimal precision for C... " >&6; } +rm -f pac_Cconftest.out + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + + #include + #include + #if __STDC_VERSION__ >= 199901L + #define C_LDBL_DIG DECIMAL_DIG + #else + #define C_LDBL_DIG LDBL_DIG + #endif + +#ifdef FC_DUMMY_MAIN +#ifndef FC_DUMMY_MAIN_EQ_F77 +# ifdef __cplusplus + extern "C" +# endif + int FC_DUMMY_MAIN() { return 1; } +#endif +#endif +int +main () +{ + + FILE * pFile; + pFile = fopen("pac_Cconftest.out","w"); + fprintf(pFile, "%d\n", C_LDBL_DIG); + + ; + return 0; +} + +_ACEOF + if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else + if ac_fn_c_try_run "$LINENO"; then : + + if test -s pac_Cconftest.out ; then + LDBL_DIG="`cat pac_Cconftest.out`" + +cat >>confdefs.h <<_ACEOF +#define PAC_C_MAX_REAL_PRECISION $LDBL_DIG +_ACEOF + + else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: No output from test program!" >&5 +$as_echo "$as_me: WARNING: No output from test program!" >&2;} + fi + rm -f pac_Cconftest.out + +else + + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: C program fails to build or run!" >&5 +$as_echo "$as_me: WARNING: C program fails to build or run!" >&2;} + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $LDBL_DIG" >&5 +$as_echo "$LDBL_DIG" >&6; } + +else + FC="no" +fi + ## ---------------------------------------------------------------------- ## Check if they would like the C++ interface compiled ## diff --git a/configure.ac b/configure.ac index dc06081..90f7d67 100644 --- a/configure.ac +++ b/configure.ac @@ -438,8 +438,8 @@ if test "X$HDF_FORTRAN" = "Xyes"; then else if test "X$HAVE_SIZEOF_FORTRAN" = "Xyes";then FC_SIZEOF_A="SIZEOF(a)" - FC_SIZEOF_B="SIZEOF(a)" - FC_SIZEOF_C="SIZEOF(a)" + FC_SIZEOF_B="SIZEOF(b)" + FC_SIZEOF_C="SIZEOF(c)" else ## If neither intrinsic functions SIZEOF or STORAGE_SIZE is available then stop configure with an error AC_MSG_ERROR([Fortran compiler requires either intrinsic functions SIZEOF or STORAGE_SIZE]) @@ -472,6 +472,7 @@ if test "X$HDF_FORTRAN" = "Xyes"; then AC_SUBST([PAC_FORTRAN_NATIVE_DOUBLE_SIZEOF]) AC_SUBST([HAVE_Fortran_INTEGER_SIZEOF_16]) AC_SUBST([FORTRAN_HAVE_C_LONG_DOUBLE]) + AC_SUBST([PAC_C_MAX_REAL_PRECISION]) ## Setting definition if there is a 16 byte fortran integer if `echo $PAC_FC_ALL_INTEGER_KINDS_SIZEOF | grep '16' >/dev/null`; then @@ -487,7 +488,7 @@ if test "X$HDF_FORTRAN" = "Xyes"; then ##fi ##PAC_FC_AVAIL_INTEGER_MODELS - + if test "X$HAVE_STORAGE_SIZE_FORTRAN" = "Xyes"; then AC_DEFINE([FORTRAN_HAVE_STORAGE_SIZE], [1], [Define if we have Fortran intrinsic STORAGE_SIZE]) @@ -506,13 +507,13 @@ if test "X$HDF_FORTRAN" = "Xyes"; then AC_DEFINE([FORTRAN_HAVE_C_LONG_DOUBLE], [1], [Define if we have Fortran C_LONG_DOUBLE]) fi AC_DEFINE([FORTRAN_SIZEOF_LONG_DOUBLE], [SIZEOF_LONG_DOUBLE], [Determine the size of C long double]) +## Change back to the C language + AC_LANG_POP(Fortran) + PAC_LDBL_DIG else FC="no" fi -## Change back to the C language -AC_LANG_POP(Fortran) - ## ---------------------------------------------------------------------- ## Check if they would like the C++ interface compiled ## diff --git a/examples/Makefile.in b/examples/Makefile.in index 1056bd2..20b0183 100644 --- a/examples/Makefile.in +++ b/examples/Makefile.in @@ -461,6 +461,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/fortran/Makefile.in b/fortran/Makefile.in index d3b941d..6427d4c 100644 --- a/fortran/Makefile.in +++ b/fortran/Makefile.in @@ -517,6 +517,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/fortran/examples/Makefile.in b/fortran/examples/Makefile.in index c517d7a..d0400c0 100644 --- a/fortran/examples/Makefile.in +++ b/fortran/examples/Makefile.in @@ -461,6 +461,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/fortran/examples/rwdset_fortran2003.f90 b/fortran/examples/rwdset_fortran2003.f90 index d65db9e..cd932bd 100644 --- a/fortran/examples/rwdset_fortran2003.f90 +++ b/fortran/examples/rwdset_fortran2003.f90 @@ -28,13 +28,13 @@ PROGRAM RWDSET_FORTRAN2003 IMPLICIT NONE - INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(Fortran_INTEGER_1) !should map to INTEGER*1 on most modern processors - INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(Fortran_INTEGER_2) !should map to INTEGER*2 on most modern processors - INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) !should map to INTEGER*4 on most modern processors - INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(Fortran_INTEGER_8) !should map to INTEGER*8 on most modern processors + INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(2) !should map to INTEGER*1 on most modern processors + INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(4) !should map to INTEGER*2 on most modern processors + INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors + INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors - INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors - INTEGER, PARAMETER :: real_kind_15 = SELECTED_REAL_KIND(Fortran_REAL_8) !should map to REAL*8 on most modern processors + INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(6,37) !should map to REAL*4 on most modern processors + INTEGER, PARAMETER :: real_kind_15 = SELECTED_REAL_KIND(15,307) !should map to REAL*8 on most modern processors CHARACTER(LEN=8), PARAMETER :: filename = "dsetf.h5" ! File name CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90 index 74838cf..7939644 100644 --- a/fortran/src/H5_ff.F90 +++ b/fortran/src/H5_ff.F90 @@ -397,6 +397,8 @@ CONTAINS h5_type = H5T_NATIVE_FLOAT_128 #endif #endif + ELSE + h5_type = -1 ENDIF ENDIF diff --git a/fortran/src/H5config_f.inc.in b/fortran/src/H5config_f.inc.in index c8fcf31..dbbf43b 100644 --- a/fortran/src/H5config_f.inc.in +++ b/fortran/src/H5config_f.inc.in @@ -33,3 +33,6 @@ ! Define if INTEGER*16 is available #undef HAVE_Fortran_INTEGER_SIZEOF_16 +! Maximum decimal precision for C +#undef PAC_C_MAX_REAL_PRECISION + diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c index 366e3da..c22f423 100644 --- a/fortran/src/H5match_types.c +++ b/fortran/src/H5match_types.c @@ -163,6 +163,7 @@ int main(void) int H5_FORTRAN_NUM_INTEGER_KINDS; int H5_FORTRAN_NUM_REAL_KINDS; + int found_long_double = 0; /* Open target files */ c_header = fopen(CFILE, "w"); @@ -206,7 +207,6 @@ int main(void) /* (b) Define c_float_x */ - int found_long_double = 0; for(i=0;i< H5_FORTRAN_NUM_REAL_KINDS;i++) { if (sizeof(float) == RealKinds_SizeOf[i]) { @@ -551,12 +551,12 @@ int main(void) fprintf(fort_header, " INTEGER, PARAMETER :: H5R_DSET_REG_REF_BUF_SIZE_F = %u\n", H5_SIZEOF_HADDR_T + 4 ); - /* Close files */ endCfile(); endFfile(); fclose(c_header); fclose(fort_header); + return 0; } diff --git a/fortran/src/Makefile.in b/fortran/src/Makefile.in index 54f2065..0abfb53 100644 --- a/fortran/src/Makefile.in +++ b/fortran/src/Makefile.in @@ -562,6 +562,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in index 431c42a..6478b50 100644 --- a/fortran/test/Makefile.in +++ b/fortran/test/Makefile.in @@ -573,6 +573,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index 9aaaa73..d845f73 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -213,8 +213,10 @@ CONTAINS CALL check("h5tget_size_f", error, total_error) CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, error) CALL check("h5tget_size_f", error, total_error) + PRINT*,H5T_NATIVE_DOUBLE CALL h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, error) CALL check("h5tget_size_f", error, total_error) + stop CALL h5tget_size_f(H5T_NATIVE_REAL, type_sizer, error) CALL check("h5tget_size_f", error, total_error) !write(*,*) "get sizes", type_sizec, type_sizei, type_sizer, type_sized diff --git a/fortran/test/tH5T_F03.F90 b/fortran/test/tH5T_F03.F90 index ee9f2f2..995243f 100644 --- a/fortran/test/tH5T_F03.F90 +++ b/fortran/test/tH5T_F03.F90 @@ -994,10 +994,25 @@ END SUBROUTINE test_array_compound_atomic INTEGER, PARAMETER :: real_kind_7 = C_FLOAT !should map to REAL*4 on most modern processors INTEGER, PARAMETER :: real_kind_15 = C_DOUBLE !should map to REAL*8 on most modern processors +! Check if C has quad precision extension #if H5_HAVE_FLOAT128!=0 +! Check if Fortran supports quad precision +# if H5_PAC_FC_MAX_REAL_PRECISION > 26 INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(31) +# else + INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(15,307) +# endif #else - INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(17) +! Check if the default of long double is quad precision +# if H5_PAC_C_MAX_REAL_PRECISION > 26 +# if H5_PAC_FC_MAX_REAL_PRECISION > 26 + INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(31) +# else + INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(15,307) +# endif +# else + INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(15,307) +# endif #endif REAL(real_kind_31), DIMENSION(1:4), TARGET :: dset_data_r31, data_out_r31 INTEGER(HID_T) :: dset_idr16 ! Dataset identifier diff --git a/fortran/testpar/Makefile.in b/fortran/testpar/Makefile.in index 6c81b76..79db2dc 100644 --- a/fortran/testpar/Makefile.in +++ b/fortran/testpar/Makefile.in @@ -513,6 +513,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/Makefile.in b/hl/Makefile.in index e1f7ed5..a178fc1 100644 --- a/hl/Makefile.in +++ b/hl/Makefile.in @@ -517,6 +517,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/c++/Makefile.in b/hl/c++/Makefile.in index 68a8868..08e1fff 100644 --- a/hl/c++/Makefile.in +++ b/hl/c++/Makefile.in @@ -513,6 +513,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/c++/examples/Makefile.in b/hl/c++/examples/Makefile.in index c19b82a..3eb154a 100644 --- a/hl/c++/examples/Makefile.in +++ b/hl/c++/examples/Makefile.in @@ -460,6 +460,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/c++/src/Makefile.in b/hl/c++/src/Makefile.in index ea6449e..88056fd 100644 --- a/hl/c++/src/Makefile.in +++ b/hl/c++/src/Makefile.in @@ -516,6 +516,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/c++/test/Makefile.in b/hl/c++/test/Makefile.in index 2188d62..dc4e8a2 100644 --- a/hl/c++/test/Makefile.in +++ b/hl/c++/test/Makefile.in @@ -513,6 +513,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/examples/Makefile.in b/hl/examples/Makefile.in index 891d82f..602cd7c 100644 --- a/hl/examples/Makefile.in +++ b/hl/examples/Makefile.in @@ -460,6 +460,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/fortran/Makefile.in b/hl/fortran/Makefile.in index 81194a5..08cf1d8 100644 --- a/hl/fortran/Makefile.in +++ b/hl/fortran/Makefile.in @@ -517,6 +517,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/fortran/examples/Makefile.in b/hl/fortran/examples/Makefile.in index 8803e1e..72f00da 100644 --- a/hl/fortran/examples/Makefile.in +++ b/hl/fortran/examples/Makefile.in @@ -460,6 +460,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/fortran/src/H5LTff.F90 b/hl/fortran/src/H5LTff.F90 index c1ca6be..3216b0a 100644 --- a/hl/fortran/src/H5LTff.F90 +++ b/hl/fortran/src/H5LTff.F90 @@ -3568,7 +3568,7 @@ CONTAINS #ifdef H5_FORTRAN_HAVE_STORAGE_SIZE SizeOf_buf_type = STORAGE_SIZE(buf(1)(1:1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) #else - SizeOf_buf_type = SIZEOF((buf(1)(1:1)) + SizeOf_buf_type = SIZEOF(buf(1:1)(1:1)) #endif namelen = LEN(dset_name) diff --git a/hl/fortran/src/Makefile.in b/hl/fortran/src/Makefile.in index a06331c..35886b6 100644 --- a/hl/fortran/src/Makefile.in +++ b/hl/fortran/src/Makefile.in @@ -537,6 +537,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/fortran/test/Makefile.am b/hl/fortran/test/Makefile.am index fa3a803..18fdaf3 100644 --- a/hl/fortran/test/Makefile.am +++ b/hl/fortran/test/Makefile.am @@ -39,10 +39,10 @@ check_PROGRAMS=$(TEST_PROG) LDADD= $(LIBH5F_HL) $(LIBH5F) $(LIBH5_HL) $(LIBHDF5) # Source files for the programs -tstds_SOURCES=tstds.f90 -tstlite_SOURCES=tstlite.f90 -tstimage_SOURCES=tstimage.f90 -tsttable_SOURCES=tsttable.f90 +tstds_SOURCES=tstds.F90 +tstlite_SOURCES=tstlite.F90 +tstimage_SOURCES=tstimage.F90 +tsttable_SOURCES=tsttable.F90 # Temporary files. CHECK_CLEANFILES+=dsetf[1-5].h5 f1img.h5 f1tab.h5 tstds.h5 diff --git a/hl/fortran/test/Makefile.in b/hl/fortran/test/Makefile.in index be12387..6389d6b 100644 --- a/hl/fortran/test/Makefile.in +++ b/hl/fortran/test/Makefile.in @@ -151,13 +151,16 @@ am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) am__v_at_0 = @ am__v_at_1 = DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)/src -I$(top_builddir)/fortran/src -FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS) -LTFCCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=FC $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -AM_V_FC = $(am__v_FC_@AM_V@) -am__v_FC_ = $(am__v_FC_@AM_DEFAULT_V@) -am__v_FC_0 = @echo " FC " $@; -am__v_FC_1 = +PPFCCOMPILE = $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) +LTPPFCCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=FC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) \ + $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ + $(AM_FCFLAGS) $(FCFLAGS) +AM_V_PPFC = $(am__v_PPFC_@AM_V@) +am__v_PPFC_ = $(am__v_PPFC_@AM_DEFAULT_V@) +am__v_PPFC_0 = @echo " PPFC " $@; +am__v_PPFC_1 = FCLD = $(FC) FCLINK = $(LIBTOOL) $(AM_V_lt) --tag=FC $(AM_LIBTOOLFLAGS) \ $(LIBTOOLFLAGS) --mode=link $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ @@ -525,6 +528,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ @@ -685,10 +689,10 @@ TEST_PROG = tstds tstlite tstimage tsttable LDADD = $(LIBH5F_HL) $(LIBH5F) $(LIBH5_HL) $(LIBHDF5) # Source files for the programs -tstds_SOURCES = tstds.f90 -tstlite_SOURCES = tstlite.f90 -tstimage_SOURCES = tstimage.f90 -tsttable_SOURCES = tsttable.f90 +tstds_SOURCES = tstds.F90 +tstlite_SOURCES = tstlite.F90 +tstimage_SOURCES = tstimage.F90 +tsttable_SOURCES = tsttable.F90 # Mark this directory as part of the Fortran API (this affects output # from tests in conclude.am) @@ -716,7 +720,7 @@ TEST_SCRIPT_PARA_CHKSH = $(TEST_SCRIPT_PARA:=.chkexe_) all: all-am .SUFFIXES: -.SUFFIXES: .f90 .lo .log .o .obj .sh .sh$(EXEEXT) .trs +.SUFFIXES: .F90 .lo .log .o .obj .sh .sh$(EXEEXT) .trs $(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(top_srcdir)/config/commence.am $(top_srcdir)/config/conclude.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ @@ -780,14 +784,14 @@ mostlyclean-compile: distclean-compile: -rm -f *.tab.c -.f90.o: - $(AM_V_FC)$(FCCOMPILE) -c -o $@ $(FCFLAGS_f90) $< +.F90.o: + $(AM_V_PPFC)$(PPFCCOMPILE) -c -o $@ $< -.f90.obj: - $(AM_V_FC)$(FCCOMPILE) -c -o $@ $(FCFLAGS_f90) `$(CYGPATH_W) '$<'` +.F90.obj: + $(AM_V_PPFC)$(PPFCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` -.f90.lo: - $(AM_V_FC)$(LTFCCOMPILE) -c -o $@ $(FCFLAGS_f90) $< +.F90.lo: + $(AM_V_PPFC)$(LTPPFCCOMPILE) -c -o $@ $< mostlyclean-libtool: -rm -f *.lo diff --git a/hl/fortran/test/tstds.F90 b/hl/fortran/test/tstds.F90 new file mode 100644 index 0000000..cbf6c38 --- /dev/null +++ b/hl/fortran/test/tstds.F90 @@ -0,0 +1,353 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * 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. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +PROGRAM test_ds + + IMPLICIT NONE + + INTEGER :: err + + CALL test_testds(err) + + IF(err.LT.0)THEN + WRITE(*,'(5X,A)') "DIMENSION SCALES TEST *FAILED*" + ENDIF + +END PROGRAM test_ds + +SUBROUTINE test_testds(err) + + USE HDF5 + USE H5LT + USE H5DS + + IMPLICIT NONE + + INTEGER, PARAMETER :: RANK = 2 ! rank of DATA dataset + INTEGER, PARAMETER :: DIM_DATA = 12 + INTEGER, PARAMETER :: DIM1_SIZE = 3 + INTEGER, PARAMETER :: DIM2_SIZE = 4 + INTEGER, PARAMETER :: DIM1 = 1 + INTEGER, PARAMETER :: DIM2 = 2 + INTEGER, PARAMETER :: FAILED = -1 + + CHARACTER(LEN=6), PARAMETER :: DSET_NAME = "Mydata" + CHARACTER(LEN=5), PARAMETER :: DS_1_NAME = "Yaxis" + CHARACTER(LEN=5), PARAMETER :: DS_1_NAME_A = "Yaxiz" + CHARACTER(LEN=5), PARAMETER :: DS_2_NAME = "Xaxis" + + + INTEGER(hid_t) :: fid ! file ID + INTEGER(hid_t) :: did ! dataset ID + INTEGER(hid_t) :: dsid ! DS dataset ID + INTEGER :: rankds = 1 ! rank of DS dataset + INTEGER(hsize_t), DIMENSION(1:rank) :: dims = (/DIM2_SIZE,DIM1_SIZE/) ! size of DATA dataset + INTEGER, DIMENSION(1:DIM_DATA) :: buf = (/1,2,3,4,5,6,7,8,9,10,11,12/) ! DATA of DATA dataset + INTEGER(hsize_t), DIMENSION(1:1) :: s1_dim = (/DIM1_SIZE/) ! size of DS 1 dataset + INTEGER(hsize_t), DIMENSION(1:1) :: s2_dim = (/DIM2_SIZE/) ! size of DS 2 dataset + REAL, DIMENSION(1:DIM1_SIZE) :: s1_wbuf = (/10,20,30/) ! DATA of DS 1 dataset + INTEGER, DIMENSION(1:DIM2_SIZE) :: s2_wbuf = (/10,20,50,100/) ! DATA of DS 2 dataset + INTEGER :: err + INTEGER :: num_scales + INTEGER(size_t) :: name_len + CHARACTER(LEN=80) :: name + INTEGER(size_t) :: label_len + CHARACTER(LEN=80) :: label + LOGICAL :: is_attached, is_scale + + ! + ! Initialize FORTRAN predefined datatypes. + ! + CALL h5open_f(err) + IF(err.LT.0) RETURN + + ! create a file using default properties + CALL H5Fcreate_f("tstds.h5",H5F_ACC_TRUNC_F, fid, err) + IF(err.LT.0) RETURN + + ! make a dataset + CALL H5LTmake_dataset_int_f(fid,DSET_NAME,rank,dims,buf, err) + IF(err.LT.0) RETURN + + ! make a DS dataset for the first dimension + CALL H5LTmake_dataset_float_f(fid,DS_1_NAME,rankds,s1_dim,s1_wbuf,err) + IF(err.LT.0) RETURN + + ! make a DS dataset for the second dimension + CALL H5LTmake_dataset_int_f(fid,DS_2_NAME,rankds,s2_dim,s2_wbuf,err) + IF(err.LT.0) RETURN + + !------------------------------------------------------------------------- + ! attach the DS_1_NAME dimension scale to DSET_NAME at dimension 1 + !------------------------------------------------------------------------- + + CALL test_begin(' Test Attaching Dimension Scale ') + + ! get the dataset id for DSET_NAME + CALL H5Dopen_f(fid, DSET_NAME, did, err) + IF(err.LT.0) RETURN + + ! get the DS dataset id + CALL H5Dopen_f(fid, DS_1_NAME, dsid, err) + IF(err.LT.0) RETURN + + ! check attaching to a non-existent dimension; should fail + CALL H5DSattach_scale_f(did, dsid, 20, err) + IF(err.NE.-1) THEN + err = FAILED ! should fail, mark as an error + CALL write_test_status(err) + RETURN + ENDIF + + ! attach the DS_1_NAME dimension scale to DSET_NAME at dimension index 1 + CALL H5DSattach_scale_f(did, dsid, DIM1, err) + IF(err.EQ.-1) THEN + CALL write_test_status(err) + RETURN + ENDIF + CALL write_test_status(err) + + CALL test_begin(' Test If Dimension Scale Attached ') + + CALL H5DSis_attached_f(did, dsid, DIM1, is_attached, err) + IF(err.EQ.-1.OR..NOT.is_attached) THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + CALL write_test_status(err) + + ! Check to see how many Dimension Scales are attached + + CALL test_begin(' Test Getting Number Dimension Scales ') + + CALL H5DSget_num_scales_f(did, DIM1, num_scales, err) + IF(err.LT.0.OR.num_scales.NE.1)THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + CALL write_test_status(err) + + CALL test_begin(' Test Detaching Dimension Scale ') + + ! Detach scale + CALL H5DSdetach_scale_f(did, dsid, DIM1, err) + IF(err.LT.0) RETURN + + ! Check to see if a dimension scale is attached, should be .false. + CALL H5DSis_attached_f(did, dsid, DIM1, is_attached, err) + IF(err.LT.0.OR.is_attached)THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + CALL write_test_status(err) + + !------------------------------------------------------------------------- + ! set the DS_1_NAME dimension scale to DSET_NAME at dimension 0 + !------------------------------------------------------------------------- + + CALL test_begin(' Test Setting Dimension Scale ') + + CALL H5DSset_scale_f(dsid, err, "Dimension Scale Set 1") + IF(err.LT.0.OR.is_attached)THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + CALL write_test_status(err) + + CALL test_begin(' Test If Dimension Scale ') + + CALL H5DSis_scale_f(dsid, is_scale, err) + IF(err.LT.0.OR..NOT.is_scale)THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + CALL write_test_status(err) + + ! Get scale name; test to large character buffer + + CALL test_begin(' Test Getting Dimension Scale By Name ') + + name_len = 25 + name = '' + CALL H5DSget_scale_name_f(dsid, name, name_len, err) + IF(err.LT.0 .OR. & + name_len.NE.21 .OR. & + TRIM(name).NE."Dimension Scale Set 1" .OR. & + name(22:25).NE.' ')THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + + ! Get scale name; test exact size character buffer + name_len = 21 + name = '' + CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err) + IF(err.LT.0.OR.name_len.NE.21.OR.TRIM(name).NE."Dimension Scale Set 1")THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + + ! Get scale name; test to small character buffer + name_len = 5 + name = '' + CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err) + IF(err.LT.0.OR.name_len.NE.21.OR.TRIM(name).NE."Dimen")THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + + ! close DS id + CALL H5Dclose_f(dsid, err) + IF(err.LT.0) RETURN + + !------------------------------------------------------------------------- + ! attach the DS_2_NAME dimension scale to DSET_NAME + !------------------------------------------------------------------------- + + ! get the DS dataset id + CALL H5Dopen_f(fid, DS_2_NAME, dsid, err) + IF(err.LT.0) RETURN + + ! attach the DS_2_NAME dimension scale to DSET_NAME as the 2nd dimension (index 2) + CALL H5DSattach_scale_f(did, dsid, DIM2, err) + IF(err.LT.0) RETURN + + CALL H5DSis_attached_f(did, dsid, DIM2, is_attached, err) + IF(err.LT.0) RETURN + + ! test sending no Dimension Scale name + + CALL H5DSset_scale_f(dsid, err) + IF(err.LT.0)THEN + CALL write_test_status(err) + RETURN + ENDIF + + CALL H5DSis_scale_f(dsid, is_scale, err) + IF(err.LT.0.OR..NOT.is_scale)THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + + ! Get scale name when there is no scale name + name_len = 5 + name = '' + CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err) + IF(err.LT.0.OR.name_len.NE.0)THEN ! name_len is 0 if no name is found + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + + CALL write_test_status(err) + + CALL test_begin(' Test Setting Dimension Scale Label ') + + CALL H5DSset_label_f(did, DIM2, "Label12", err) + IF(err.LT.0)THEN + CALL write_test_status(err) + RETURN + ENDIF + + ! Test label where character length is to small + + label_len = 5 + label = '' + CALL H5DSget_label_f(did, DIM2, label(1:label_len), label_len, err) + IF(err.LT.0.OR.label(1:5).NE."Label".OR.label_len.NE.7)THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + + ! Test label where character length is exact + + label_len = 7 + label = '' + CALL H5DSget_label_f(did, DIM2, label(1:label_len), label_len, err) + IF(err.LT.0.OR.label(1:label_len).NE."Label12".OR.label_len.NE.7)THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + + ! Test label where character length is to big + + label_len = 25 + label = '' + CALL H5DSget_label_f(did, DIM2, label, label_len, err) + IF(err.LT.0.OR. & + label(1:label_len).NE."Label12" .OR. & + label_len.NE.7 .OR. & + label(8:25).NE.' ')THEN + err = FAILED + CALL write_test_status(err) + RETURN + ENDIF + CALL write_test_status(err) + + ! close DS id + CALL H5Dclose_f(dsid, err) + IF(err.LT.0) RETURN + + ! close file + CALL H5Fclose_f(fid, err) + IF(err.LT.0) RETURN + +END SUBROUTINE test_testds + +!------------------------------------------------------------------------- +! test_begin +!------------------------------------------------------------------------- + +SUBROUTINE test_begin(string) + CHARACTER(LEN=*), INTENT(IN) :: string + WRITE(*, fmt = '(A)', advance = 'no') ADJUSTL(string) +END SUBROUTINE test_begin + +!------------------------------------------------------------------------- +! passed/failed +!------------------------------------------------------------------------- +SUBROUTINE write_test_status( test_result) + +! Writes the results of the tests + + IMPLICIT NONE + + INTEGER, INTENT(IN) :: test_result ! negative, failed + ! 0 , passed + +! Controls the output style for reporting test results + + CHARACTER(LEN=8) :: error_string + CHARACTER(LEN=8), PARAMETER :: success = ' PASSED ' + CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*' + + error_string = failure + IF (test_result .EQ. 0) THEN + error_string = success + ENDIF + + WRITE(*, fmt = '(T34, A)') error_string + +END SUBROUTINE write_test_status diff --git a/hl/fortran/test/tstds.f90 b/hl/fortran/test/tstds.f90 deleted file mode 100644 index cbf6c38..0000000 --- a/hl/fortran/test/tstds.f90 +++ /dev/null @@ -1,353 +0,0 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! * 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -PROGRAM test_ds - - IMPLICIT NONE - - INTEGER :: err - - CALL test_testds(err) - - IF(err.LT.0)THEN - WRITE(*,'(5X,A)') "DIMENSION SCALES TEST *FAILED*" - ENDIF - -END PROGRAM test_ds - -SUBROUTINE test_testds(err) - - USE HDF5 - USE H5LT - USE H5DS - - IMPLICIT NONE - - INTEGER, PARAMETER :: RANK = 2 ! rank of DATA dataset - INTEGER, PARAMETER :: DIM_DATA = 12 - INTEGER, PARAMETER :: DIM1_SIZE = 3 - INTEGER, PARAMETER :: DIM2_SIZE = 4 - INTEGER, PARAMETER :: DIM1 = 1 - INTEGER, PARAMETER :: DIM2 = 2 - INTEGER, PARAMETER :: FAILED = -1 - - CHARACTER(LEN=6), PARAMETER :: DSET_NAME = "Mydata" - CHARACTER(LEN=5), PARAMETER :: DS_1_NAME = "Yaxis" - CHARACTER(LEN=5), PARAMETER :: DS_1_NAME_A = "Yaxiz" - CHARACTER(LEN=5), PARAMETER :: DS_2_NAME = "Xaxis" - - - INTEGER(hid_t) :: fid ! file ID - INTEGER(hid_t) :: did ! dataset ID - INTEGER(hid_t) :: dsid ! DS dataset ID - INTEGER :: rankds = 1 ! rank of DS dataset - INTEGER(hsize_t), DIMENSION(1:rank) :: dims = (/DIM2_SIZE,DIM1_SIZE/) ! size of DATA dataset - INTEGER, DIMENSION(1:DIM_DATA) :: buf = (/1,2,3,4,5,6,7,8,9,10,11,12/) ! DATA of DATA dataset - INTEGER(hsize_t), DIMENSION(1:1) :: s1_dim = (/DIM1_SIZE/) ! size of DS 1 dataset - INTEGER(hsize_t), DIMENSION(1:1) :: s2_dim = (/DIM2_SIZE/) ! size of DS 2 dataset - REAL, DIMENSION(1:DIM1_SIZE) :: s1_wbuf = (/10,20,30/) ! DATA of DS 1 dataset - INTEGER, DIMENSION(1:DIM2_SIZE) :: s2_wbuf = (/10,20,50,100/) ! DATA of DS 2 dataset - INTEGER :: err - INTEGER :: num_scales - INTEGER(size_t) :: name_len - CHARACTER(LEN=80) :: name - INTEGER(size_t) :: label_len - CHARACTER(LEN=80) :: label - LOGICAL :: is_attached, is_scale - - ! - ! Initialize FORTRAN predefined datatypes. - ! - CALL h5open_f(err) - IF(err.LT.0) RETURN - - ! create a file using default properties - CALL H5Fcreate_f("tstds.h5",H5F_ACC_TRUNC_F, fid, err) - IF(err.LT.0) RETURN - - ! make a dataset - CALL H5LTmake_dataset_int_f(fid,DSET_NAME,rank,dims,buf, err) - IF(err.LT.0) RETURN - - ! make a DS dataset for the first dimension - CALL H5LTmake_dataset_float_f(fid,DS_1_NAME,rankds,s1_dim,s1_wbuf,err) - IF(err.LT.0) RETURN - - ! make a DS dataset for the second dimension - CALL H5LTmake_dataset_int_f(fid,DS_2_NAME,rankds,s2_dim,s2_wbuf,err) - IF(err.LT.0) RETURN - - !------------------------------------------------------------------------- - ! attach the DS_1_NAME dimension scale to DSET_NAME at dimension 1 - !------------------------------------------------------------------------- - - CALL test_begin(' Test Attaching Dimension Scale ') - - ! get the dataset id for DSET_NAME - CALL H5Dopen_f(fid, DSET_NAME, did, err) - IF(err.LT.0) RETURN - - ! get the DS dataset id - CALL H5Dopen_f(fid, DS_1_NAME, dsid, err) - IF(err.LT.0) RETURN - - ! check attaching to a non-existent dimension; should fail - CALL H5DSattach_scale_f(did, dsid, 20, err) - IF(err.NE.-1) THEN - err = FAILED ! should fail, mark as an error - CALL write_test_status(err) - RETURN - ENDIF - - ! attach the DS_1_NAME dimension scale to DSET_NAME at dimension index 1 - CALL H5DSattach_scale_f(did, dsid, DIM1, err) - IF(err.EQ.-1) THEN - CALL write_test_status(err) - RETURN - ENDIF - CALL write_test_status(err) - - CALL test_begin(' Test If Dimension Scale Attached ') - - CALL H5DSis_attached_f(did, dsid, DIM1, is_attached, err) - IF(err.EQ.-1.OR..NOT.is_attached) THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - CALL write_test_status(err) - - ! Check to see how many Dimension Scales are attached - - CALL test_begin(' Test Getting Number Dimension Scales ') - - CALL H5DSget_num_scales_f(did, DIM1, num_scales, err) - IF(err.LT.0.OR.num_scales.NE.1)THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - CALL write_test_status(err) - - CALL test_begin(' Test Detaching Dimension Scale ') - - ! Detach scale - CALL H5DSdetach_scale_f(did, dsid, DIM1, err) - IF(err.LT.0) RETURN - - ! Check to see if a dimension scale is attached, should be .false. - CALL H5DSis_attached_f(did, dsid, DIM1, is_attached, err) - IF(err.LT.0.OR.is_attached)THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - CALL write_test_status(err) - - !------------------------------------------------------------------------- - ! set the DS_1_NAME dimension scale to DSET_NAME at dimension 0 - !------------------------------------------------------------------------- - - CALL test_begin(' Test Setting Dimension Scale ') - - CALL H5DSset_scale_f(dsid, err, "Dimension Scale Set 1") - IF(err.LT.0.OR.is_attached)THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - CALL write_test_status(err) - - CALL test_begin(' Test If Dimension Scale ') - - CALL H5DSis_scale_f(dsid, is_scale, err) - IF(err.LT.0.OR..NOT.is_scale)THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - CALL write_test_status(err) - - ! Get scale name; test to large character buffer - - CALL test_begin(' Test Getting Dimension Scale By Name ') - - name_len = 25 - name = '' - CALL H5DSget_scale_name_f(dsid, name, name_len, err) - IF(err.LT.0 .OR. & - name_len.NE.21 .OR. & - TRIM(name).NE."Dimension Scale Set 1" .OR. & - name(22:25).NE.' ')THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - - ! Get scale name; test exact size character buffer - name_len = 21 - name = '' - CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err) - IF(err.LT.0.OR.name_len.NE.21.OR.TRIM(name).NE."Dimension Scale Set 1")THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - - ! Get scale name; test to small character buffer - name_len = 5 - name = '' - CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err) - IF(err.LT.0.OR.name_len.NE.21.OR.TRIM(name).NE."Dimen")THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - - ! close DS id - CALL H5Dclose_f(dsid, err) - IF(err.LT.0) RETURN - - !------------------------------------------------------------------------- - ! attach the DS_2_NAME dimension scale to DSET_NAME - !------------------------------------------------------------------------- - - ! get the DS dataset id - CALL H5Dopen_f(fid, DS_2_NAME, dsid, err) - IF(err.LT.0) RETURN - - ! attach the DS_2_NAME dimension scale to DSET_NAME as the 2nd dimension (index 2) - CALL H5DSattach_scale_f(did, dsid, DIM2, err) - IF(err.LT.0) RETURN - - CALL H5DSis_attached_f(did, dsid, DIM2, is_attached, err) - IF(err.LT.0) RETURN - - ! test sending no Dimension Scale name - - CALL H5DSset_scale_f(dsid, err) - IF(err.LT.0)THEN - CALL write_test_status(err) - RETURN - ENDIF - - CALL H5DSis_scale_f(dsid, is_scale, err) - IF(err.LT.0.OR..NOT.is_scale)THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - - ! Get scale name when there is no scale name - name_len = 5 - name = '' - CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err) - IF(err.LT.0.OR.name_len.NE.0)THEN ! name_len is 0 if no name is found - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - - CALL write_test_status(err) - - CALL test_begin(' Test Setting Dimension Scale Label ') - - CALL H5DSset_label_f(did, DIM2, "Label12", err) - IF(err.LT.0)THEN - CALL write_test_status(err) - RETURN - ENDIF - - ! Test label where character length is to small - - label_len = 5 - label = '' - CALL H5DSget_label_f(did, DIM2, label(1:label_len), label_len, err) - IF(err.LT.0.OR.label(1:5).NE."Label".OR.label_len.NE.7)THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - - ! Test label where character length is exact - - label_len = 7 - label = '' - CALL H5DSget_label_f(did, DIM2, label(1:label_len), label_len, err) - IF(err.LT.0.OR.label(1:label_len).NE."Label12".OR.label_len.NE.7)THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - - ! Test label where character length is to big - - label_len = 25 - label = '' - CALL H5DSget_label_f(did, DIM2, label, label_len, err) - IF(err.LT.0.OR. & - label(1:label_len).NE."Label12" .OR. & - label_len.NE.7 .OR. & - label(8:25).NE.' ')THEN - err = FAILED - CALL write_test_status(err) - RETURN - ENDIF - CALL write_test_status(err) - - ! close DS id - CALL H5Dclose_f(dsid, err) - IF(err.LT.0) RETURN - - ! close file - CALL H5Fclose_f(fid, err) - IF(err.LT.0) RETURN - -END SUBROUTINE test_testds - -!------------------------------------------------------------------------- -! test_begin -!------------------------------------------------------------------------- - -SUBROUTINE test_begin(string) - CHARACTER(LEN=*), INTENT(IN) :: string - WRITE(*, fmt = '(A)', advance = 'no') ADJUSTL(string) -END SUBROUTINE test_begin - -!------------------------------------------------------------------------- -! passed/failed -!------------------------------------------------------------------------- -SUBROUTINE write_test_status( test_result) - -! Writes the results of the tests - - IMPLICIT NONE - - INTEGER, INTENT(IN) :: test_result ! negative, failed - ! 0 , passed - -! Controls the output style for reporting test results - - CHARACTER(LEN=8) :: error_string - CHARACTER(LEN=8), PARAMETER :: success = ' PASSED ' - CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*' - - error_string = failure - IF (test_result .EQ. 0) THEN - error_string = success - ENDIF - - WRITE(*, fmt = '(T34, A)') error_string - -END SUBROUTINE write_test_status diff --git a/hl/fortran/test/tstimage.F90 b/hl/fortran/test/tstimage.F90 new file mode 100644 index 0000000..0bff6b2 --- /dev/null +++ b/hl/fortran/test/tstimage.F90 @@ -0,0 +1,339 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! 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. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! +! This file contains the FORTRAN90 tests for H5LT +! + +program image_test + +call make_image1() + +end program image_test + + +!------------------------------------------------------------------------- +! make_image1 +!------------------------------------------------------------------------- + +subroutine make_image1() + +use h5im ! module of H5IM +use hdf5 ! module of HDF5 library + +implicit none + +character(len=8), parameter :: filename = "f1img.h5" ! file name +character(len=4), parameter :: dsetname1 = "img1" ! dataset name +character(len=4), parameter :: dsetname2 = "img2" ! dataset name +character(len=15), parameter :: il ="INTERLACE_PIXEL"! dataset name +integer(hid_t) :: file_id ! file identifier +integer(hsize_t), parameter :: width = 500 ! width of image +integer(hsize_t), parameter :: height = 200 ! height of image +integer, parameter :: pal_entries = 9 ! palette number of entries +integer, dimension(width*height) :: buf1 ! data buffer +integer, dimension(width*height) :: bufr1 ! data buffer +integer, dimension(width*height*3) :: buf2 ! data buffer +integer, dimension(width*height*3) :: bufr2 ! data buffer +integer(hsize_t) :: widthr ! width of image +integer(hsize_t) :: heightr ! height of image +integer(hsize_t) :: planesr ! color planes +integer(hsize_t) :: npalsr ! palettes +character(len=15) :: interlacer ! interlace +integer :: errcode ! error flag +integer :: is_image ! error flag +integer :: i, j, n ! general purpose integers +! +! palette +! create a 9 entry palette +! +character(len=4), parameter :: pal_name = "pal1" ! dataset name +integer(hsize_t), dimension(2) :: pal_dims = (/pal_entries,3/) ! palette dimensions +integer(hsize_t), dimension(2) :: pal_dims_out ! palette dimensions +integer, dimension(pal_entries*3) :: pal_data_out ! data buffer +integer(hsize_t) :: npals ! number of palettes +integer :: pal_number ! palette number +integer :: is_palette ! is palette +integer :: space +integer, dimension(pal_entries*3) :: pal_data_in = (/& + 0,0,168,& ! dark blue + 0,0,252,& ! blue + 0,168,252,& ! ocean blue + 84,252,252,& ! light blue + 168,252,168,& ! light green + 0,252,168,& ! green + 252,252,84,& ! yellow + 252,168,0,& ! orange + 252,0,0/) ! red + + +! create an 8bit image of 9 values divided evenly by the array +! +space = width*height / pal_entries; +n = 0; j = 0; +do i = 1, width*height + buf1(i) = n + if ( j > space ) then + n = n + 1; + j = 0; + endif + if (n>pal_entries-1) n=0; + j = j +1; +end do + +! +! create a 3 byte rgb image +! +n = 0; j = 0; +do i = 1, width*height*3 + buf2(i) = n; + if (j == 3) then + n = n + 1; + j = 0; + endif + if (n>255) n=0; + j = j +1; +end do + + +! Initialize FORTRAN predefined datatypes. +! +call h5open_f(errcode) +! +! Create a new file using default properties. +! +call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + +!------------------------------------------------------------------------- +! indexed image +!------------------------------------------------------------------------- + +call test_begin(' Make/Read image 8bit ') + +! +! write image. +! +call h5immake_image_8bit_f(file_id,dsetname1,width,height,buf1,errcode) +! +! read image. +! +call h5imread_image_f(file_id,dsetname1,bufr1,errcode) +! +! compare read and write buffers. +! +do i = 1, width*height + if ( buf1(i) /= bufr1(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr1(i), ' and ', buf1(i) + stop + endif +end do + +! +! get image info. +! +call h5imget_image_info_f(file_id,dsetname1,widthr,heightr,planesr,interlacer,npalsr,errcode) + +if ( (widthr /= widthr) .or. (heightr /= height) .or. (planesr /= 1)) then + print *, 'h5imget_image_info_f bad value' + stop +endif + +is_image = h5imis_image_f(file_id,dsetname1) +if ( is_image /= 1) then + print *, 'h5imis_image_f bad value' + stop +endif + + +call passed() + +!------------------------------------------------------------------------- +! true color image +!------------------------------------------------------------------------- + +call test_begin(' Make/Read image 24bit ') + +! +! write image. +! +call h5immake_image_24bit_f(file_id,dsetname2,width,height,il,buf2,errcode) + +! +! read image. +! +call h5imread_image_f(file_id,dsetname2,bufr2,errcode) + +! +! compare read and write buffers. +! +do i = 1, width*height*3 + if ( buf2(i) /= bufr2(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr2(i), ' and ', buf2(i) + stop + endif +end do + +! +! get image info. +! +call h5imget_image_info_f(file_id,dsetname2,widthr,heightr,planesr,interlacer,npalsr,errcode) + +if ( (widthr /= widthr) .or. (heightr /= height) .or. (planesr /= 3)) then + print *, 'h5imget_image_info_f bad value' + stop +endif + +is_image = h5imis_image_f(file_id,dsetname2) +if ( is_image /= 1) then + print *, 'h5imis_image_f bad value' + stop +endif + + + +call passed() + +!------------------------------------------------------------------------- +! palette +!------------------------------------------------------------------------- + +call test_begin(' Make palette ') + +! +! make palette. +! +call h5immake_palette_f(file_id,pal_name,pal_dims,pal_data_in,errcode) + +call passed() + + +call test_begin(' Link/Unlink palette ') + +! +! link palette. +! +call h5imlink_palette_f(file_id,dsetname1,pal_name,errcode) + + +! +! read palette. +! +pal_number = 0 +call h5imget_palette_f(file_id,dsetname1,pal_number,pal_data_out,errcode) + +! +! compare read and write buffers. +! +do i = 1, pal_entries*3 + if ( pal_data_in(i) /= pal_data_out(i) ) then + print *, 'read buffer differs from write buffer' + print *, pal_data_in(i), ' and ', pal_data_out(i) + stop + endif +end do + +! +! get number of palettes +! +call h5imget_npalettes_f(file_id,dsetname1,npals,errcode) + +if ( npals /= 1) then + print *, 'h5imget_npalettes_f bad value' + stop +endif + +! +! get palette info +! +pal_number = 0 +call h5imget_palette_info_f(file_id,dsetname1,pal_number,pal_dims_out,errcode) + +if ( (pal_dims_out(1) /= pal_dims(1)) .or. (pal_dims_out(2) /= pal_dims(2))) then + print *, 'h5imget_palette_info_f bad value' + stop +endif + +! +! is palette +! +is_palette = h5imis_palette_f(file_id,pal_name) + +if ( is_palette /= 1 ) then + print *, 'h5imis_palette_f bad value' + stop +endif + +! +! unlink palette. +! +call h5imunlink_palette_f(file_id,dsetname1,pal_name,errcode) + +! +! get number of palettes +! +call h5imget_npalettes_f(file_id,dsetname1,npals,errcode ) + +if ( npals /= 0) then + print *, 'h5imget_npalettes_f bad value' + stop +endif + + +! +! link palette again +! +call h5imlink_palette_f(file_id,dsetname1,pal_name,errcode) + +call passed() + + +!------------------------------------------------------------------------- +! end +!------------------------------------------------------------------------- + +! +! Close the file. +! +call h5fclose_f(file_id, errcode) + +! +! Close FORTRAN predefined datatypes. +! +call h5close_f(errcode) + +! +! end function. +! +end subroutine make_image1 + +!------------------------------------------------------------------------- +! test_begin +!------------------------------------------------------------------------- + +subroutine test_begin(string) +character(len=*), intent(in) :: string +write(*, fmt = '(14a)', advance = 'no') string +write(*, fmt = '(40x,a)', advance = 'no') ' ' +end subroutine test_begin + +!------------------------------------------------------------------------- +! passed +!------------------------------------------------------------------------- + +subroutine passed() +write(*, fmt = '(6a)') 'PASSED' +end subroutine passed diff --git a/hl/fortran/test/tstimage.f90 b/hl/fortran/test/tstimage.f90 deleted file mode 100644 index 0bff6b2..0000000 --- a/hl/fortran/test/tstimage.f90 +++ /dev/null @@ -1,339 +0,0 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! -! -! This file contains the FORTRAN90 tests for H5LT -! - -program image_test - -call make_image1() - -end program image_test - - -!------------------------------------------------------------------------- -! make_image1 -!------------------------------------------------------------------------- - -subroutine make_image1() - -use h5im ! module of H5IM -use hdf5 ! module of HDF5 library - -implicit none - -character(len=8), parameter :: filename = "f1img.h5" ! file name -character(len=4), parameter :: dsetname1 = "img1" ! dataset name -character(len=4), parameter :: dsetname2 = "img2" ! dataset name -character(len=15), parameter :: il ="INTERLACE_PIXEL"! dataset name -integer(hid_t) :: file_id ! file identifier -integer(hsize_t), parameter :: width = 500 ! width of image -integer(hsize_t), parameter :: height = 200 ! height of image -integer, parameter :: pal_entries = 9 ! palette number of entries -integer, dimension(width*height) :: buf1 ! data buffer -integer, dimension(width*height) :: bufr1 ! data buffer -integer, dimension(width*height*3) :: buf2 ! data buffer -integer, dimension(width*height*3) :: bufr2 ! data buffer -integer(hsize_t) :: widthr ! width of image -integer(hsize_t) :: heightr ! height of image -integer(hsize_t) :: planesr ! color planes -integer(hsize_t) :: npalsr ! palettes -character(len=15) :: interlacer ! interlace -integer :: errcode ! error flag -integer :: is_image ! error flag -integer :: i, j, n ! general purpose integers -! -! palette -! create a 9 entry palette -! -character(len=4), parameter :: pal_name = "pal1" ! dataset name -integer(hsize_t), dimension(2) :: pal_dims = (/pal_entries,3/) ! palette dimensions -integer(hsize_t), dimension(2) :: pal_dims_out ! palette dimensions -integer, dimension(pal_entries*3) :: pal_data_out ! data buffer -integer(hsize_t) :: npals ! number of palettes -integer :: pal_number ! palette number -integer :: is_palette ! is palette -integer :: space -integer, dimension(pal_entries*3) :: pal_data_in = (/& - 0,0,168,& ! dark blue - 0,0,252,& ! blue - 0,168,252,& ! ocean blue - 84,252,252,& ! light blue - 168,252,168,& ! light green - 0,252,168,& ! green - 252,252,84,& ! yellow - 252,168,0,& ! orange - 252,0,0/) ! red - - -! create an 8bit image of 9 values divided evenly by the array -! -space = width*height / pal_entries; -n = 0; j = 0; -do i = 1, width*height - buf1(i) = n - if ( j > space ) then - n = n + 1; - j = 0; - endif - if (n>pal_entries-1) n=0; - j = j +1; -end do - -! -! create a 3 byte rgb image -! -n = 0; j = 0; -do i = 1, width*height*3 - buf2(i) = n; - if (j == 3) then - n = n + 1; - j = 0; - endif - if (n>255) n=0; - j = j +1; -end do - - -! Initialize FORTRAN predefined datatypes. -! -call h5open_f(errcode) -! -! Create a new file using default properties. -! -call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) - -!------------------------------------------------------------------------- -! indexed image -!------------------------------------------------------------------------- - -call test_begin(' Make/Read image 8bit ') - -! -! write image. -! -call h5immake_image_8bit_f(file_id,dsetname1,width,height,buf1,errcode) -! -! read image. -! -call h5imread_image_f(file_id,dsetname1,bufr1,errcode) -! -! compare read and write buffers. -! -do i = 1, width*height - if ( buf1(i) /= bufr1(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufr1(i), ' and ', buf1(i) - stop - endif -end do - -! -! get image info. -! -call h5imget_image_info_f(file_id,dsetname1,widthr,heightr,planesr,interlacer,npalsr,errcode) - -if ( (widthr /= widthr) .or. (heightr /= height) .or. (planesr /= 1)) then - print *, 'h5imget_image_info_f bad value' - stop -endif - -is_image = h5imis_image_f(file_id,dsetname1) -if ( is_image /= 1) then - print *, 'h5imis_image_f bad value' - stop -endif - - -call passed() - -!------------------------------------------------------------------------- -! true color image -!------------------------------------------------------------------------- - -call test_begin(' Make/Read image 24bit ') - -! -! write image. -! -call h5immake_image_24bit_f(file_id,dsetname2,width,height,il,buf2,errcode) - -! -! read image. -! -call h5imread_image_f(file_id,dsetname2,bufr2,errcode) - -! -! compare read and write buffers. -! -do i = 1, width*height*3 - if ( buf2(i) /= bufr2(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufr2(i), ' and ', buf2(i) - stop - endif -end do - -! -! get image info. -! -call h5imget_image_info_f(file_id,dsetname2,widthr,heightr,planesr,interlacer,npalsr,errcode) - -if ( (widthr /= widthr) .or. (heightr /= height) .or. (planesr /= 3)) then - print *, 'h5imget_image_info_f bad value' - stop -endif - -is_image = h5imis_image_f(file_id,dsetname2) -if ( is_image /= 1) then - print *, 'h5imis_image_f bad value' - stop -endif - - - -call passed() - -!------------------------------------------------------------------------- -! palette -!------------------------------------------------------------------------- - -call test_begin(' Make palette ') - -! -! make palette. -! -call h5immake_palette_f(file_id,pal_name,pal_dims,pal_data_in,errcode) - -call passed() - - -call test_begin(' Link/Unlink palette ') - -! -! link palette. -! -call h5imlink_palette_f(file_id,dsetname1,pal_name,errcode) - - -! -! read palette. -! -pal_number = 0 -call h5imget_palette_f(file_id,dsetname1,pal_number,pal_data_out,errcode) - -! -! compare read and write buffers. -! -do i = 1, pal_entries*3 - if ( pal_data_in(i) /= pal_data_out(i) ) then - print *, 'read buffer differs from write buffer' - print *, pal_data_in(i), ' and ', pal_data_out(i) - stop - endif -end do - -! -! get number of palettes -! -call h5imget_npalettes_f(file_id,dsetname1,npals,errcode) - -if ( npals /= 1) then - print *, 'h5imget_npalettes_f bad value' - stop -endif - -! -! get palette info -! -pal_number = 0 -call h5imget_palette_info_f(file_id,dsetname1,pal_number,pal_dims_out,errcode) - -if ( (pal_dims_out(1) /= pal_dims(1)) .or. (pal_dims_out(2) /= pal_dims(2))) then - print *, 'h5imget_palette_info_f bad value' - stop -endif - -! -! is palette -! -is_palette = h5imis_palette_f(file_id,pal_name) - -if ( is_palette /= 1 ) then - print *, 'h5imis_palette_f bad value' - stop -endif - -! -! unlink palette. -! -call h5imunlink_palette_f(file_id,dsetname1,pal_name,errcode) - -! -! get number of palettes -! -call h5imget_npalettes_f(file_id,dsetname1,npals,errcode ) - -if ( npals /= 0) then - print *, 'h5imget_npalettes_f bad value' - stop -endif - - -! -! link palette again -! -call h5imlink_palette_f(file_id,dsetname1,pal_name,errcode) - -call passed() - - -!------------------------------------------------------------------------- -! end -!------------------------------------------------------------------------- - -! -! Close the file. -! -call h5fclose_f(file_id, errcode) - -! -! Close FORTRAN predefined datatypes. -! -call h5close_f(errcode) - -! -! end function. -! -end subroutine make_image1 - -!------------------------------------------------------------------------- -! test_begin -!------------------------------------------------------------------------- - -subroutine test_begin(string) -character(len=*), intent(in) :: string -write(*, fmt = '(14a)', advance = 'no') string -write(*, fmt = '(40x,a)', advance = 'no') ' ' -end subroutine test_begin - -!------------------------------------------------------------------------- -! passed -!------------------------------------------------------------------------- - -subroutine passed() -write(*, fmt = '(6a)') 'PASSED' -end subroutine passed diff --git a/hl/fortran/test/tstlite.F90 b/hl/fortran/test/tstlite.F90 new file mode 100644 index 0000000..26e9467 --- /dev/null +++ b/hl/fortran/test/tstlite.F90 @@ -0,0 +1,1715 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! 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. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! +! This file contains the FORTRAN90 tests for H5LT +! +#include + +PROGRAM lite_test + + CALL test_dataset1D() + CALL test_dataset2D() + CALL test_dataset3D() + CALL test_datasetND(4) + CALL test_datasetND(5) + CALL test_datasetND(6) + CALL test_datasetND(7) + CALL test_datasets() + CALL test_attributes() + +END PROGRAM lite_test + + +!------------------------------------------------------------------------- +! test_dataset1D +!------------------------------------------------------------------------- + +SUBROUTINE test_dataset1D() + +USE, INTRINSIC :: ISO_C_BINDING +USE H5LT ! module of H5LT +USE HDF5 ! module of HDF5 library + +IMPLICIT NONE + +INTEGER, PARAMETER :: DIM1 = 4; ! Dimension of array +CHARACTER(len=9), PARAMETER :: filename = "dsetf1.h5"! File name +CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name +CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name +CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name +INTEGER(HID_T) :: file_id ! File identifier +INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions +INTEGER :: rank = 1 ! Dataset rank +INTEGER, DIMENSION(DIM1) :: buf1 ! Data buffer +INTEGER, DIMENSION(DIM1) :: bufr1 ! Data buffer +REAL, DIMENSION(DIM1) :: buf2 ! Data buffer +REAL, DIMENSION(DIM1) :: bufr2 ! Data buffer +DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf3 ! Data buffer +DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr3 ! Data buffer +INTEGER :: errcode ! Error flag +INTEGER :: i ! general purpose integer +TYPE(C_PTR) :: f_ptr +integer(HID_T) :: mytype + +CALL test_begin(' Make/Read datasets (1D) ') + +! +! Initialize the data array. +! +DO i = 1, DIM1 + buf1(i) = i; + buf2(i) = i; + buf3(i) = i; +END DO + +! +! Initialize FORTRAN predefined datatypes. +! +CALL h5open_f(errcode) + +! +! Create a new file using default properties. +! +CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + +!------------------------------------------------------------------------- +! H5T_NATIVE_INTEGER +!------------------------------------------------------------------------- + +! +! write dataset. +! +CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf1, errcode) + +! +! read dataset. +! +CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr1, dims, errcode) + +! +! compare read and write buffers. +! +DO i = 1, DIM1 + IF ( buf1(i) .NE. bufr1(i) ) THEN + PRINT *, 'read buffer differs from write buffer (I)' + PRINT *, bufr1(i), ' and ', buf1(i) + STOP + ENDIF +END DO + +!------------------------------------------------------------------------- +! H5T_NATIVE_REAL +!------------------------------------------------------------------------- + +! +! write dataset. +! +CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_REAL, buf2, errcode) + +! +! read dataset. +! +CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_REAL, bufr2, dims, errcode) + +! +! compare read and write buffers. +! +DO i = 1, DIM1 + IF ( buf2(i) .NE. bufr2(i) ) THEN + PRINT *, 'read buffer differs from write buffer (R)' + PRINT *, bufr2(i), ' and ', buf2(i) + STOP + ENDIF +END DO + +!------------------------------------------------------------------------- +! H5T_NATIVE_DOUBLE +!------------------------------------------------------------------------- + +! +! write dataset. +! +f_ptr = C_LOC(buf3(1)) +mytype = h5kind_to_type(KIND(buf3(1)), H5_REAL_KIND) +CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, & + mytype, f_ptr, errcode) +!CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_DOUBLE, buf3, errcode) +! h5kind_to_type(KIND(buf3(1)), H5_REAL_KIND) +! +! read dataset. +! +f_ptr = C_LOC(bufr3(1)) +CALL h5ltread_dataset_f(file_id, dsetname3, & + h5kind_to_type(KIND(bufr3(1)), H5_REAL_KIND), f_ptr, errcode) +!CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_DOUBLE, bufr3, dims, errcode) + +! +! compare read and write buffers. +! +DO i = 1, DIM1 + IF ( buf3(i) .NE. bufr3(i) ) THEN + PRINT *, 'read buffer differs from write buffer (D)' + PRINT *, bufr3(i), ' and ', buf3(i) + STOP + ENDIF +END DO + +! +! Close the file. +! +CALL h5fclose_f(file_id, errcode) + +! +! Close FORTRAN predefined datatypes. +! +CALL h5close_f(errcode) + +CALL passed() +! +! end function. +! +END SUBROUTINE test_dataset1D + +!------------------------------------------------------------------------- +! test_dataset2D +!------------------------------------------------------------------------- + +SUBROUTINE test_dataset2D() + +USE, INTRINSIC :: ISO_C_BINDING +USE H5LT ! module of H5LT +USE HDF5 ! module of HDF5 library + +IMPLICIT NONE + + +INTEGER(HSIZE_T), PARAMETER :: DIM1 = 4; ! columns +INTEGER(HSIZE_T), PARAMETER :: DIM2 = 6; ! rows +CHARACTER(len=9), PARAMETER :: filename = "dsetf2.h5"! File name +CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name +CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name +CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name +CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name +INTEGER(HID_T) :: file_id ! File identifier +INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions +INTEGER :: rank = 2 ! Dataset rank +INTEGER, DIMENSION(DIM1*DIM2) :: buf ! Data buffer +INTEGER, DIMENSION(DIM1*DIM2) :: bufr ! Data buffer +INTEGER, DIMENSION(DIM1,DIM2) :: buf2 ! Data buffer +INTEGER, DIMENSION(DIM1,DIM2) :: buf2r ! Data buffer +REAL, DIMENSION(DIM1,DIM2), TARGET :: buf3 ! Data buffer +REAL, DIMENSION(DIM1,DIM2), TARGET :: buf3r ! Data buffer +DOUBLE PRECISION, DIMENSION(DIM1,DIM2), TARGET :: buf4 ! Data buffer +DOUBLE PRECISION, DIMENSION(DIM1,DIM2), TARGET :: buf4r ! Data buffer +INTEGER :: errcode ! Error flag +INTEGER(HSIZE_T) :: i, j, n ! general purpose integers +TYPE(C_PTR) :: f_ptr + +CALL test_begin(' Make/Read datasets (2D) ') + + +! +! Initialize the data arrays. +! +n=1 +DO i = 1, DIM1*DIM2 + buf(i) = INT(n) + n = n + 1 +END DO + +DO i = 1, dims(1) + DO j = 1, dims(2) + buf2(i,j) = INT((i-1)*dims(2) + j) + buf3(i,j) = INT((i-1)*dims(2) + j) + buf4(i,j) = INT((i-1)*dims(2) + j) + END DO +END DO + + +! +! Initialize FORTRAN predefined datatypes. +! +CALL h5open_f(errcode) + +! +! Create a new file using default properties. +! +CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + +!------------------------------------------------------------------------- +! H5T_NATIVE_INT 1D buffer +!------------------------------------------------------------------------- + +! +! write dataset. +! +CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode) + +! +! read dataset. +! +CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode) + +! +! compare read and write buffers. +! +DO i = 1, DIM1*DIM2 + IF ( buf(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufr(i), ' and ', buf(i) + STOP + ENDIF +END DO + +!------------------------------------------------------------------------- +! H5T_NATIVE_INT 2D buffer +!------------------------------------------------------------------------- + +! +! write dataset. +! +CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode) + +! +! read dataset. +! +CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode) + +! +! compare read and write buffers. +! +DO i = 1, dims(1) + DO j = 1, dims(2) + IF ( buf2(i,j) .NE. buf2r(i,j) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, buf2r(i,j), ' and ', buf2(i,j) + STOP + ENDIF + END DO +END DO + +!------------------------------------------------------------------------- +! H5T_NATIVE_REAL +!------------------------------------------------------------------------- + +! +! write dataset. +! +f_ptr = C_LOC(buf3(1,1)) +CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode) +!CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode) + +! +! read dataset. +! +f_ptr = C_LOC(buf3r(1,1)) +CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) +!CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode) + +! +! compare read and write buffers. +! +DO i = 1, dims(1) + DO j = 1, dims(2) + IF ( buf3(i,j) .NE. buf3r(i,j) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, buf3r(i,j), ' and ', buf3(i,j) + STOP + ENDIF + END DO +END DO + +!------------------------------------------------------------------------- +! H5T_NATIVE_DOUBLE +!------------------------------------------------------------------------- + +! +! write dataset. +! +f_ptr = C_LOC(buf4(1,1)) +CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode) +!CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, buf4, errcode) + +! +! read dataset. +f_ptr = C_LOC(buf4r(1,1)) +CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + +!CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, buf4r, dims, errcode) + +! +! compare read and write buffers. +! +DO i = 1, dims(1) + DO j = 1, dims(2) + IF ( buf4(i,j) .NE. buf4r(i,j) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, buf4r(i,j), ' and ', buf4(i,j) + STOP + ENDIF + END DO +END DO + +! +! Close the file. +! +CALL h5fclose_f(file_id, errcode) + +! +! Close FORTRAN predefined datatypes. +! +CALL h5close_f(errcode) + +CALL passed() +! +! end function. +! +END SUBROUTINE test_dataset2D + + +!------------------------------------------------------------------------- +! test_dataset3D +!------------------------------------------------------------------------- + + +SUBROUTINE test_dataset3D() +USE, INTRINSIC :: ISO_C_BINDING +USE H5LT ! module of H5LT +USE HDF5 ! module of HDF5 library + +IMPLICIT NONE + +INTEGER, PARAMETER :: DIM1 = 6 ! columns +INTEGER, PARAMETER :: DIM2 = 4 ! rows +INTEGER, PARAMETER :: DIM3 = 2 ! layers +CHARACTER(len=9), PARAMETER :: filename = "dsetf3.h5" ! File name +CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name +CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name +CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name +CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name +INTEGER(HID_T) :: file_id ! File identifier +INTEGER(HSIZE_T), DIMENSION(3) :: dims = (/DIM1,DIM2,DIM3/) ! Dataset dimensions +INTEGER(HSIZE_T), DIMENSION(3) :: dimsr ! Dataset dimensions +INTEGER, DIMENSION(DIM1*DIM2*DIM3) :: buf ! Data buffer +INTEGER, DIMENSION(DIM1*DIM2*DIM3) :: bufr ! Data buffer +INTEGER, DIMENSION(DIM1,DIM2,DIM3) :: buf2 ! Data buffer +INTEGER, DIMENSION(DIM1,DIM2,DIM3) :: buf2r ! Data buffer +REAL, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf3 ! Data buffer +REAL, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf3r ! Data buffer +DOUBLE PRECISION, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf4 ! Data buffer +DOUBLE PRECISION, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf4r ! Data buffer +INTEGER :: rank = 3 ! Dataset rank +INTEGER :: errcode ! Error flag +INTEGER(HSIZE_T) :: i, j, k, n ! general purpose integers +INTEGER :: type_class +INTEGER(SIZE_T) :: type_size +TYPE(C_PTR) :: f_ptr +CALL test_begin(' Make/Read datasets (3D) ') + + +! +! Initialize the data array. +! +n=1 +DO i = 1, DIM1*DIM2*DIM3 + buf(i) = INT(n) + n = n + 1 +END DO + +n = 1 +DO i = 1, dims(1) + DO j = 1, dims(2) + DO k = 1, dims(3) + buf2(i,j,k) = INT(n) + buf3(i,j,k) = INT(n) + buf4(i,j,k) = INT(n) + n = n + 1 + END DO + END DO +END DO + +! +! Initialize FORTRAN predefined datatypes. +! +CALL h5open_f(errcode) + +! +! Create a new file using default properties. +! +CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + +!------------------------------------------------------------------------- +! H5T_NATIVE_INT 1D buffer +!------------------------------------------------------------------------- + +! +! write dataset. +! +CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode) + +! +! read dataset. +! +CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode) + +! +! compare read and write buffers. +! +DO i = 1, DIM1*DIM2*DIM3 + IF ( buf(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufr(i), ' and ', buf(i) + STOP + ENDIF +END DO + +!------------------------------------------------------------------------- +! H5T_NATIVE_INT 3D buffer +!------------------------------------------------------------------------- + +! +! write dataset. +! +CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode) + +! +! read dataset. +! +CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode) + +! +! compare read and write buffers. +! +DO i = 1, dims(1) + DO j = 1, dims(2) + DO k = 1, dims(3) + IF ( buf2(i,j,k) .NE. buf2r(i,j,k) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, buf2r(i,j,k), ' and ', buf2(i,j,k) + STOP + ENDIF + END DO + END DO +END DO + +!------------------------------------------------------------------------- +! H5T_NATIVE_REAL +!------------------------------------------------------------------------- + +! +! write dataset. +! +f_ptr = C_LOC(buf3(1,1,1)) +CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode) +!CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode) + +! +! read dataset. +! +f_ptr = C_LOC(buf3r(1,1,1)) +CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) +!CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode) + +! +! compare read and write buffers. +! +DO i = 1, dims(1) + DO j = 1, dims(2) + DO k = 1, dims(3) + IF ( buf3(i,j,k) .NE. buf3r(i,j,k) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, buf3r(i,j,k), ' and ', buf3(i,j,k) + STOP + ENDIF + END DO + END DO +END DO + +!------------------------------------------------------------------------- +! H5T_NATIVE_DOUBLE +!------------------------------------------------------------------------- + +! +! write dataset. +! +f_ptr = C_LOC(buf4(1,1,1)) +CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode) + +! +! read dataset. +! +f_ptr = C_LOC(buf4r(1,1,1)) +CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + +! +! compare read and write buffers. +! +DO i = 1, dims(1) + DO j = 1, dims(2) + DO k = 1, dims(3) + IF ( buf4(i,j,k) .NE. buf4r(i,j,k) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, buf4r(i,j,k), ' and ', buf4(i,j,k) + STOP + ENDIF + END DO + END DO +END DO + +CALL h5ltget_dataset_info_f(file_id,dsetname4,dimsr,type_class,type_size,errcode ) + +! +! compare dimensions +! +DO i = 1, rank + IF ( dimsr(i) .NE. dims(i) ) THEN + PRINT *, 'dimensions differ ' + STOP + ENDIF +END DO + +! +! Close the file. +! +CALL h5fclose_f(file_id, errcode) + +! +! Close FORTRAN predefined datatypes. +! +CALL h5close_f(errcode) + +CALL passed() +! +! end function. +! +END SUBROUTINE test_dataset3D + +!------------------------------------------------------------------------- +! test_datasetND +!------------------------------------------------------------------------- + + +SUBROUTINE test_datasetND(rank) + + USE, INTRINSIC :: ISO_C_BINDING + USE H5LT ! module of H5LT + USE HDF5 ! module of HDF5 library + + IMPLICIT NONE + + INTEGER :: rank ! Dataset rank + + INTEGER, PARAMETER :: DIM1 = 2 ! columns + INTEGER, PARAMETER :: DIM2 = 4 ! rows + INTEGER, PARAMETER :: DIM3 = 2 ! layers + INTEGER, PARAMETER :: DIM4 = 5 ! columns + INTEGER, PARAMETER :: DIM5 = 4 ! rows + INTEGER, PARAMETER :: DIM6 = 3 ! layers + INTEGER, PARAMETER :: DIM7 = 2 ! layers + CHARACTER(len=9), PARAMETER :: filename = "dsetf3.h5" ! File name + CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name + CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name + CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HSIZE_T), DIMENSION(7) :: dims + INTEGER(HSIZE_T), DIMENSION(7) :: dimsr ! Dataset dimensions + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: ibuf_4 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: ibufr_4 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: ibuf_5 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: ibufr_5 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:) :: ibuf_6 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:) :: ibufr_6 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:) :: ibuf_7 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:) :: ibufr_7 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: rbuf_4 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: rbufr_4 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: rbuf_5 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: rbufr_5 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: rbuf_6 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: rbufr_6 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: rbuf_7 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: rbufr_7 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: dbuf_4 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: dbufr_4 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: dbuf_5 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: dbufr_5 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: dbuf_6 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: dbufr_6 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: dbuf_7 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: dbufr_7 ! Data buffer + INTEGER :: errcode ! Error flag + INTEGER(HSIZE_T) :: i, j, k, l, m, n, o, nn ! general purpose integers + INTEGER :: type_class + INTEGER(SIZE_T) :: type_size + CHARACTER(LEN=1) :: ichr1 + TYPE(C_PTR) :: f_ptr + + WRITE(ichr1,'(I1.1)') rank + CALL test_begin(' Make/Read datasets ('//ichr1//'D) ') +! +! Initialize the data array. +! + IF(rank.EQ.4)THEN + + ALLOCATE(ibuf_4 (1:DIM1,1:DIM2,1:DIM3,1:DIM4)) + ALLOCATE(ibufr_4(1:DIM1,1:DIM2,1:DIM3,1:DIM4)) + ALLOCATE(rbuf_4 (1:DIM1,1:DIM2,1:DIM3,1:DIM4)) + ALLOCATE(rbufr_4(1:DIM1,1:DIM2,1:DIM3,1:DIM4)) + ALLOCATE(dbuf_4 (1:DIM1,1:DIM2,1:DIM3,1:DIM4)) + ALLOCATE(dbufr_4(1:DIM1,1:DIM2,1:DIM3,1:DIM4)) + + dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,0,0,0/) + + nn = 1 + DO i = 1, DIM1 + DO j = 1, DIM2 + DO k = 1, DIM3 + DO l = 1, DIM4 + ibuf_4(i,j,k,l) = INT(nn) + rbuf_4(i,j,k,l) = INT(nn) + dbuf_4(i,j,k,l) = INT(nn) + nn = nn + 1 + END DO + END DO + END DO + ENDDO + + ELSE IF(rank.EQ.5)THEN + + ALLOCATE(ibuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) + ALLOCATE(ibufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) + ALLOCATE(rbuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) + ALLOCATE(rbufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) + ALLOCATE(dbuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) + ALLOCATE(dbufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) + + dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,DIM5,0,0/) + + nn = 1 + DO i = 1, DIM1 + DO j = 1, DIM2 + DO k = 1, DIM3 + DO l = 1, DIM4 + DO m = 1, DIM5 + ibuf_5(i,j,k,l,m) = INT(nn) + rbuf_5(i,j,k,l,m) = INT(nn) + dbuf_5(i,j,k,l,m) = INT(nn) + nn = nn + 1 + END DO + END DO + END DO + ENDDO + ENDDO + + ELSE IF(rank.EQ.6)THEN + + ALLOCATE(ibuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) + ALLOCATE(ibufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) + ALLOCATE(rbuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) + ALLOCATE(rbufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) + ALLOCATE(dbuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) + ALLOCATE(dbufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) + + dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,DIM5,DIM6,0/) + + nn = 1 + DO i = 1, DIM1 + DO j = 1, DIM2 + DO k = 1, DIM3 + DO l = 1, DIM4 + DO m = 1, DIM5 + DO n = 1, DIM6 + ibuf_6(i,j,k,l,m,n) = INT(nn) + rbuf_6(i,j,k,l,m,n) = INT(nn) + dbuf_6(i,j,k,l,m,n) = INT(nn) + nn = nn + 1 + END DO + END DO + END DO + ENDDO + ENDDO + ENDDO + + ELSE IF(rank.EQ.7)THEN + + ALLOCATE(ibuf_7 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) + ALLOCATE(ibufr_7(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) + ALLOCATE(rbuf_7 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) + ALLOCATE(rbufr_7(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) + ALLOCATE(dbuf_7 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) + ALLOCATE(dbufr_7(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) + + dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,DIM5,DIM6,DIM7/) + + nn = 1 + DO i = 1, DIM1 + DO j = 1, DIM2 + DO k = 1, DIM3 + DO l = 1, DIM4 + DO m = 1, DIM5 + DO n = 1, DIM6 + DO o = 1, DIM7 + ibuf_7(i,j,k,l,m,n,o) = INT(nn) + rbuf_7(i,j,k,l,m,n,o) = INT(nn) + dbuf_7(i,j,k,l,m,n,o) = INT(nn) + nn = nn + 1 + END DO + END DO + END DO + ENDDO + ENDDO + ENDDO + ENDDO + + ENDIF + + ! + ! Initialize FORTRAN predefined datatypes. + ! + CALL h5open_f(errcode) + + ! + ! Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + + !------------------------------------------------------------------------- + ! H5T_NATIVE_INT ND buffer + !------------------------------------------------------------------------- + + ! + ! write dataset. + ! + IF(rank.EQ.4)THEN + CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_4, errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(ibuf_5(1,1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_6, errcode) + ELSE IF(rank.EQ.7)THEN + CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_7, errcode) + ENDIF + + + ! + ! read dataset. + ! + IF(rank.EQ.4)THEN + CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_4, dims(1:rank), errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(ibufr_5(1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_6, dims(1:rank), errcode) + ELSE IF(rank.EQ.7)THEN + CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_7, dims(1:rank), errcode) + ENDIF + + ! + ! compare read and write buffers. + ! + DO i = 1, dims(1) + DO j = 1, dims(2) + DO k = 1, dims(3) + DO l = 1, dims(4) + IF(rank.EQ.4)THEN + IF ( ibuf_4(i,j,k,l) .NE. ibufr_4(i,j,k,l) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, ibuf_4(i,j,k,l), ' and ', ibufr_4(i,j,k,l) + STOP + ENDIF + ENDIF + DO m = 1, dims(5) + IF(rank.EQ.5)THEN + IF ( ibuf_5(i,j,k,l,m) .NE. ibufr_5(i,j,k,l,m) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, ibuf_5(i,j,k,l,m), ' and ', ibufr_5(i,j,k,l,m) + STOP + ENDIF + ENDIF + DO n = 1, dims(6) + IF(rank.EQ.6)THEN + IF ( ibuf_6(i,j,k,l,m,n) .NE. ibufr_6(i,j,k,l,m,n) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, ibuf_6(i,j,k,l,m,n), ' and ', ibufr_6(i,j,k,l,m,n) + STOP + ENDIF + ENDIF + DO o = 1, dims(7) + IF(rank.EQ.7)THEN + IF ( ibuf_7(i,j,k,l,m,n,o) .NE. ibufr_7(i,j,k,l,m,n,o) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, ibuf_7(i,j,k,l,m,n,o), ' and ', ibufr_7(i,j,k,l,m,n,o) + STOP + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + !------------------------------------------------------------------------- + ! H5T_NATIVE_REAL + !------------------------------------------------------------------------- + + ! + ! write dataset. + ! + IF(rank.EQ.4)THEN + f_ptr = C_LOC(rbuf_4(1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode) + ! CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_4, errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(rbuf_5(1,1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + f_ptr = C_LOC(rbuf_6(1,1,1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode) + !CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_6, errcode) + ELSE IF(rank.EQ.7)THEN + f_ptr = C_LOC(rbuf_7(1,1,1,1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode) + !CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_7, errcode) + ENDIF + + + ! + ! read dataset. + ! + IF(rank.EQ.4)THEN + f_ptr = C_LOC(rbufr_4(1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(rbufr_5(1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + f_ptr = C_LOC(rbufr_6(1,1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) + ELSE IF(rank.EQ.7)THEN + f_ptr = C_LOC(rbufr_7(1,1,1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) + ENDIF + + ! + ! compare read and write buffers. + ! + DO i = 1, dims(1) + DO j = 1, dims(2) + DO k = 1, dims(3) + DO l = 1, dims(4) + IF(rank.EQ.4)THEN + IF ( rbuf_4(i,j,k,l) .NE. rbufr_4(i,j,k,l) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, rbuf_4(i,j,k,l), ' and ', rbufr_4(i,j,k,l) + STOP + ENDIF + ENDIF + DO m = 1, dims(5) + IF(rank.EQ.5)THEN + IF ( rbuf_5(i,j,k,l,m) .NE. rbufr_5(i,j,k,l,m) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, rbuf_5(i,j,k,l,m), ' and ', rbufr_5(i,j,k,l,m) + STOP + ENDIF + ENDIF + DO n = 1, dims(6) + IF(rank.EQ.6)THEN + IF ( rbuf_6(i,j,k,l,m,n) .NE. rbufr_6(i,j,k,l,m,n) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, rbuf_6(i,j,k,l,m,n), ' and ', rbufr_6(i,j,k,l,m,n) + STOP + ENDIF + ENDIF + DO o = 1, dims(7) + IF(rank.EQ.7)THEN + IF ( rbuf_7(i,j,k,l,m,n,o) .NE. rbufr_7(i,j,k,l,m,n,o) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, rbuf_7(i,j,k,l,m,n,o), ' and ', rbufr_7(i,j,k,l,m,n,o) + STOP + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + + !------------------------------------------------------------------------- + ! H5T_NATIVE_DOUBLE + !------------------------------------------------------------------------- + + ! + ! write dataset. + ! + IF(rank.EQ.4)THEN + f_ptr = C_LOC(dbuf_4(1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(dbuf_5(1,1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + f_ptr = C_LOC(dbuf_6(1,1,1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.7)THEN + f_ptr = C_LOC(dbuf_7(1,1,1,1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) + ENDIF + + + ! + ! read dataset. + ! + IF(rank.EQ.4)THEN + f_ptr = C_LOC(dbufr_4(1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(dbufr_5(1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + f_ptr = C_LOC(dbufr_6(1,1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.7)THEN + f_ptr = C_LOC(dbufr_7(1,1,1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + ENDIF + + ! + ! compare read and write buffers. + ! + DO i = 1, dims(1) + DO j = 1, dims(2) + DO k = 1, dims(3) + DO l = 1, dims(4) + IF(rank.EQ.4)THEN + IF ( dbuf_4(i,j,k,l) .NE. dbufr_4(i,j,k,l) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, dbuf_4(i,j,k,l), ' and ', dbufr_4(i,j,k,l) + STOP + ENDIF + ENDIF + DO m = 1, dims(5) + IF(rank.EQ.5)THEN + IF ( dbuf_5(i,j,k,l,m) .NE. dbufr_5(i,j,k,l,m) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, dbuf_5(i,j,k,l,m), ' and ', dbufr_5(i,j,k,l,m) + STOP + ENDIF + ENDIF + DO n = 1, dims(6) + IF(rank.EQ.6)THEN + IF ( dbuf_6(i,j,k,l,m,n) .NE. dbufr_6(i,j,k,l,m,n) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, dbuf_6(i,j,k,l,m,n), ' and ', dbufr_6(i,j,k,l,m,n) + STOP + ENDIF + ENDIF + DO o = 1, dims(7) + IF(rank.EQ.7)THEN + IF ( dbuf_7(i,j,k,l,m,n,o) .NE. dbufr_7(i,j,k,l,m,n,o) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, dbuf_7(i,j,k,l,m,n,o), ' and ', dbufr_7(i,j,k,l,m,n,o) + STOP + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + + CALL h5ltget_dataset_info_f(file_id,dsetname4,dimsr,type_class,type_size,errcode ) + + ! + ! compare dimensions + ! + DO i = 1, rank + IF ( dimsr(i) .NE. dims(i) ) THEN + PRINT *, 'dimensions differ ' + STOP + ENDIF + END DO + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) + + ! DEALLOCATE RESOURCES + + IF(rank.EQ.4)THEN + DEALLOCATE(ibuf_4, ibufr_4, rbuf_4, rbufr_4, dbuf_4, dbufr_4) + ELSE IF(rank.EQ.5)THEN + DEALLOCATE(ibuf_5, ibufr_5, rbuf_5, rbufr_5, dbuf_5, dbufr_5) + ELSE IF(rank.EQ.6)THEN + DEALLOCATE(ibuf_6, ibufr_6, rbuf_6, rbufr_6, dbuf_6, dbufr_6) + ELSE IF(rank.EQ.7)THEN + DEALLOCATE(ibuf_7, ibufr_7, rbuf_7, rbufr_7, dbuf_7, dbufr_7) + ENDIF + + CALL passed() + ! + ! end function. + ! +END SUBROUTINE test_datasetND + + + +!------------------------------------------------------------------------- +! test_datasets +!------------------------------------------------------------------------- + +SUBROUTINE test_datasets() + + USE, INTRINSIC :: ISO_C_BINDING + USE H5LT ! module of H5LT + USE HDF5 ! module of HDF5 library + + IMPLICIT NONE + + CHARACTER(len=9), PARAMETER :: filename = "dsetf4.h5"! File name + INTEGER(HID_T) :: file_id ! File identifier + INTEGER :: errcode ! Error flag + INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array + CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name + CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name + CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name + CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name + CHARACTER(LEN=5), PARAMETER :: dsetname5 = "dset5" ! Dataset name + INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions + INTEGER(HSIZE_T), DIMENSION(1) :: dimsr ! Dataset dimensions + INTEGER :: rank = 1 ! Dataset rank + INTEGER :: rankr ! Dataset rank + CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer + CHARACTER(LEN=8) :: buf1r ! Data buffer + INTEGER, DIMENSION(DIM1) :: buf2 ! Data buffer + INTEGER, DIMENSION(DIM1) :: bufr2 ! Data buffer + REAL, DIMENSION(DIM1), TARGET :: buf3 ! Data buffer + REAL, DIMENSION(DIM1) , TARGET :: bufr3 ! Data buffer + DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf4 ! Data buffer + DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr4 ! Data buffer + INTEGER :: i, n ! general purpose integer + INTEGER :: has ! general purpose integer + INTEGER :: type_class + INTEGER(SIZE_T) :: type_size + LOGICAL :: path_valid ! status of the path + CHARACTER(LEN=6) :: chr_exact + CHARACTER(LEN=8) :: chr_lg + TYPE(C_PTR) :: f_ptr + + ! + ! Initialize FORTRAN predefined datatypes. + ! + CALL h5open_f(errcode) + + ! + ! Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + + ! + ! Initialize the data array. + ! + n = 1 + DO i = 1, DIM1 + buf2(i) = n + buf3(i) = n + buf4(i) = n + n = n + 1 + END DO + + !------------------------------------------------------------------------- + ! int + !------------------------------------------------------------------------- + + CALL test_begin(' Make/Read datasets (integer) ') + + ! + ! write dataset. + ! + CALL h5ltmake_dataset_int_f(file_id, dsetname2, rank, dims, buf2, errcode) + + ! + ! read dataset. + ! + CALL h5ltread_dataset_int_f(file_id, dsetname2, bufr2, dims, errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, DIM1 + IF ( buf2(i) .NE. bufr2(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufr2(i), ' and ', buf2(i) + STOP + ENDIF + END DO + + CALL passed() + + + !------------------------------------------------------------------------- + ! real + !------------------------------------------------------------------------- + + CALL test_begin(' Make/Read datasets (float) ') + + + ! + ! write dataset. + ! + f_ptr = C_LOC(buf3(1)) + CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode) + + ! + ! read dataset. + ! + f_ptr = C_LOC(bufr3(1)) + CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, DIM1 + IF ( buf3(i) .NE. bufr3(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufr3(i), ' and ', buf3(i) + STOP + ENDIF + END DO + + CALL passed() + + !------------------------------------------------------------------------- + ! double + !------------------------------------------------------------------------- + + CALL test_begin(' Make/Read datasets (double) ') + + + ! + ! write dataset. + ! + f_ptr = C_LOC(buf4(1)) + CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode) + !CALL h5ltmake_dataset_double_f(file_id, dsetname4, rank, dims, buf4, errcode) + + ! + ! read dataset. + ! + !!!f_ptr = C_LOC(buf4(1)) MSB + !!!CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) MSB + CALL h5ltread_dataset_double_f(file_id, dsetname4, bufr4, dims, errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, DIM1 + IF ( buf4(i) .NE. bufr4(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufr4(i), ' and ', buf4(i) + STOP + ENDIF + END DO + + CALL passed() + + + !------------------------------------------------------------------------- + ! string + !------------------------------------------------------------------------- + + CALL test_begin(' Make/Read datasets (string) ') + + + ! + ! write dataset. + ! + CALL h5ltmake_dataset_string_f(file_id, dsetname5, buf1, errcode) + + ! + ! read dataset. + ! + CALL h5ltread_dataset_string_f(file_id, dsetname5, buf1r, errcode) + + ! + ! compare read and write buffers. + ! + IF ( buf1 .NE. buf1r ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, buf1, ' and ', buf1r + STOP + ENDIF + + CALL passed() + + CALL test_begin(' Test h5ltpath_valid_f ') + ! + ! test function h5ltpath_valid_f + ! + chr_exact = "/"//dsetname2 ! test character buffer the exact size needed + CALL h5ltpath_valid_f(file_id, chr_exact, .TRUE., path_valid, errcode) + IF(errcode.LT.0.OR..NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + chr_lg = "/"//dsetname2 ! test character buffer larger then needed + CALL h5ltpath_valid_f(file_id, chr_lg, .TRUE., path_valid, errcode) + IF(errcode.LT.0.OR..NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + CALL h5ltpath_valid_f(file_id, chr_lg, .FALSE., path_valid, errcode) + IF(errcode.LT.0.OR..NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + ! Should fail, dataset does not exist + CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .TRUE., path_valid, errcode) + IF(errcode.LT.0.OR.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .FALSE., path_valid, errcode) + IF(errcode.LT.0.OR.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + ! Create a dangling soft link + CALL h5lcreate_soft_f("/G2", file_id, "/G3", errcode) + + ! Should pass, does not check for dangled link + CALL h5ltpath_valid_f(file_id, "/G3", .FALSE., path_valid, errcode) + IF(.NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + ! Should fail, dangled link + CALL h5ltpath_valid_f(file_id, "/G2", .TRUE., path_valid, errcode) + IF(path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + CALL passed() + + + CALL test_begin(' Get dataset dimensions/info ') + + !------------------------------------------------------------------------- + ! h5ltget_dataset_ndims_f + !------------------------------------------------------------------------- + + CALL h5ltget_dataset_ndims_f(file_id, dsetname4, rankr, errcode) + IF ( rankr .NE. rank ) THEN + PRINT *, 'h5ltget_dataset_ndims_f return error' + STOP + ENDIF + + + !------------------------------------------------------------------------- + ! test h5ltfind_dataset_f function + !------------------------------------------------------------------------- + + + has = h5ltfind_dataset_f(file_id,dsetname4) + IF ( has .NE. 1 ) THEN + PRINT *, 'h5ltfind_dataset_f return error' + STOP + ENDIF + + !------------------------------------------------------------------------- + ! test h5ltget_dataset_info_f function + !------------------------------------------------------------------------- + + + CALL h5ltget_dataset_info_f(file_id,dsetname4,dimsr,type_class,type_size,errcode ) + + ! + ! compare dimensions + ! + DO i = 1, rank + IF ( dimsr(i) .NE. dims(i) ) THEN + PRINT *, 'dimensions differ ' + STOP + ENDIF + END DO + + IF ( type_class .NE. 1 ) THEN ! H5T_FLOAT + PRINT *, 'wrong type class ' + STOP + ENDIF + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) + + CALL passed() + ! + ! end function. + ! +END SUBROUTINE test_datasets + + + +!------------------------------------------------------------------------- +! test_attributes +!------------------------------------------------------------------------- + +SUBROUTINE test_attributes() + + USE, INTRINSIC :: ISO_C_BINDING + USE H5LT ! module of H5LT + USE HDF5 ! module of HDF5 library + + IMPLICIT NONE + + CHARACTER(len=9), PARAMETER :: filename = "dsetf5.h5"! File name + CHARACTER(len=9), PARAMETER :: filename1 ="tattr.h5" ! C written attribute file + INTEGER(HID_T) :: file_id ! File identifier +! INTEGER(HID_T) :: file_id1 + INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array + CHARACTER(LEN=5), PARAMETER :: attrname1 = "attr1" ! Attribute name + CHARACTER(LEN=5), PARAMETER :: attrname2 = "attr2" ! Attribute name + CHARACTER(LEN=5), PARAMETER :: attrname3 = "attr3" ! Attribute name + CHARACTER(LEN=5), PARAMETER :: attrname4 = "attr4" ! Attribute name + CHARACTER(LEN=5), PARAMETER :: attrname5 = "attr5" ! Attribute name + CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer + CHARACTER(LEN=16), PARAMETER :: buf_c = "string attribute" + CHARACTER(LEN=8) :: bufr1 ! Data buffer + CHARACTER(LEN=10) :: bufr1_lg ! Data buffer +! CHARACTER(LEN=16) :: bufr_c ! Data buffer +! CHARACTER(LEN=18) :: bufr_c_lg ! Data buffer + INTEGER, DIMENSION(DIM1) :: buf2 ! Data buffer + INTEGER, DIMENSION(DIM1) :: bufr2 ! Data buffer + REAL, DIMENSION(DIM1), target :: buf3 ! Data buffer + REAL, DIMENSION(DIM1), target :: bufr3 ! Data buffer + DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf4 ! Data buffer + DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr4 ! Data buffer + INTEGER :: errcode ! Error flag + INTEGER :: i, n ! general purpose integer + INTEGER(SIZE_T) size ! size of attribute array + INTEGER :: rankr ! rank + INTEGER(HSIZE_T), DIMENSION(1) :: dimsr ! attribute dimensions + INTEGER :: type_class + INTEGER(SIZE_T) :: type_size + INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions + INTEGER :: rank = 1 ! Dataset rank + CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name + INTEGER, DIMENSION(DIM1) :: buf ! Data buffer + INTEGER(SIZE_T) :: SizeOf_buf_type + TYPE(C_PTR) :: f_ptr + + ! + ! Initialize FORTRAN predefined datatypes. + ! + CALL h5open_f(errcode) + ! + ! Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + ! + ! make a dataset. + ! + CALL h5ltmake_dataset_int_f(file_id, dsetname1, rank, dims, buf, errcode) + + ! + ! Initialize the data array. + ! + size = DIM1 + n = 1 + DO i = 1, DIM1 + buf2(i) = n + buf3(i) = n + buf4(i) = n + n = n + 1 + END DO + + + !------------------------------------------------------------------------- + ! int + !------------------------------------------------------------------------- + + CALL test_begin(' Set/Get attributes int ') + + + ! + ! write attribute. + ! + CALL h5ltset_attribute_int_f(file_id,dsetname1,attrname2,buf2,size,errcode) + + ! + ! read attribute. + ! + CALL h5ltget_attribute_int_f(file_id,dsetname1,attrname2,bufr2,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, DIM1 + IF ( buf2(i) .NE. bufr2(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufr2(i), ' and ', buf2(i) + STOP + ENDIF + END DO + + CALL passed() + + !------------------------------------------------------------------------- + ! float + !------------------------------------------------------------------------- + + CALL test_begin(' Set/Get attributes float ') + + + ! + ! write attribute. + ! +#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + SizeOf_buf_type = STORAGE_SIZE(buf3(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) +#else + SizeOf_buf_type = SIZEOF(buf3(1)) +#endif + f_ptr = C_LOC(buf3(1)) + CALL h5ltset_attribute_f(file_id,dsetname1,attrname3,f_ptr,"REAL", SizeOf_buf_type, size,errcode) + !CALL h5ltset_attribute_float_f(file_id,dsetname1,attrname3,buf3,size,errcode) + ! + ! read attribute. + ! +#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + SizeOf_buf_type = STORAGE_SIZE(bufr3(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) +#else + SizeOf_buf_type = SIZEOF(bufr3(1)) +#endif + + f_ptr = C_LOC(bufr3(1)) + CALL h5ltget_attribute_f(file_id,dsetname1,attrname3,f_ptr,"REAL",SizeOf_buf_type,errcode) + !CALL h5ltget_attribute_float_f(file_id,dsetname1,attrname3,bufr3,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, DIM1 + IF ( buf3(i) .NE. bufr3(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufr3(i), ' and ', buf3(i) + STOP + ENDIF + END DO + + CALL passed() + + !------------------------------------------------------------------------- + ! double + !------------------------------------------------------------------------- + + CALL test_begin(' Set/Get attributes double ') + +#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + SizeOf_buf_type = STORAGE_SIZE(buf4(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) +#else + SizeOf_buf_type = SIZEOF(buf4(1)) +#endif + ! + ! write attribute. + ! + f_ptr = C_LOC(buf4(1)) + CALL h5ltset_attribute_f(file_id,dsetname1,attrname4,f_ptr,"real", SizeOf_buf_type, size, errcode) + + !CALL h5ltset_attribute_double_f(file_id,dsetname1,attrname4,f_ptr,"Real", SizeOf_buf_type, size, errcode) + + ! + ! read attribute. + ! + +#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + SizeOf_buf_type = STORAGE_SIZE(bufr4(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) +#else + SizeOf_buf_type = SIZEOF(bufr4(1)) +#endif + + f_ptr = C_LOC(bufr4(1)) + CALL h5ltget_attribute_f(file_id,dsetname1,attrname4,f_ptr,"REAL",SizeOf_buf_type,errcode) + +! CALL h5ltget_attribute_double_f(file_id,dsetname1,attrname4,bufr4,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, DIM1 + IF ( buf4(i) .NE. bufr4(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufr4(i), ' and ', buf4(i) + STOP + ENDIF + END DO + + CALL passed() + + !------------------------------------------------------------------------- + ! string + !------------------------------------------------------------------------- + + CALL test_begin(' Set/Get attributes string ') + + ! + ! write attribute. + ! + CALL h5ltset_attribute_string_f(file_id,dsetname1,attrname5,buf1,errcode) + + ! + ! read attribute into a fortran character buf that is the same size as buf1. + ! + CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1,errcode) + + ! + ! compare read and write buffers. + ! + IF ( buf1 .NE. bufr1 ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, buf1, ' and ', bufr1 + STOP + ENDIF + + ! + ! read attribute into a fortran character buf that is larger then buf1. + ! + CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1_lg,errcode) + + ! + ! compare read and write buffers, make sure C NULL character was removed. + ! + IF ( buf1(1:8) .NE. bufr1_lg(1:8) .AND. bufr1_lg(9:10) .NE. ' ' ) THEN + PRINT *, 'larger read buffer differs from write buffer' + PRINT *, buf1, ' and ', bufr1_lg + STOP + ENDIF + + ! + ! ** Test reading a string that was created with a C program ** + ! + +!!$ CALL h5fopen_f(filename1, H5F_ACC_RDONLY_F, file_id1, errcode) +!!$ +!!$ CALL h5ltget_attribute_string_f(file_id1, "/", "attr5", bufr_c, errcode) +!!$ ! +!!$ ! compare read and write buffers. +!!$ ! +!!$ IF ( bufr_c .NE. buf_c ) THEN +!!$ PRINT *, 'read buffer differs from write buffer' +!!$ PRINT *, bufr1, ' and ', buf_c +!!$ STOP +!!$ ENDIF +!!$ ! +!!$ ! read attribute into a fortran character buf that is larger then buf_c. +!!$ ! +!!$ CALL h5ltget_attribute_string_f(file_id1, "/", "attr5", bufr_c_lg, errcode) +!!$ +!!$ ! +!!$ ! compare read and write buffers, make sure C NULL character was removed. +!!$ ! +!!$ IF ( buf_c(1:16) .NE. bufr_c_lg(1:16) .AND. bufr_c_lg(17:18) .NE. ' ' ) THEN +!!$ PRINT *, 'larger read buffer differs from write buffer' +!!$ PRINT *, buf_c, ' and ', bufr_c_lg +!!$ STOP +!!$ ENDIF + +!!$ CALL h5fclose_f(file_id1, errcode) + + CALL passed() + + !------------------------------------------------------------------------- + ! get attribute rank + !------------------------------------------------------------------------- + + CALL test_begin(' Get attribute rank/info ') + + + CALL h5ltget_attribute_ndims_f(file_id,dsetname1,attrname2,rankr,errcode) + + IF ( rankr .NE. 1 ) THEN + PRINT *, 'h5ltget_attribute_ndims_f return error' + STOP + ENDIF + + + CALL h5ltget_attribute_info_f(file_id,dsetname1,attrname2,dimsr,type_class,type_size,errcode) + + ! + ! compare dimensions + ! + DO i = 1, rank + IF ( dimsr(i) .NE. dims(i) ) THEN + PRINT *, 'dimensions differ ' + STOP + ENDIF + END DO + + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) + + CALL passed() + ! + ! end function. + ! +END SUBROUTINE test_attributes + +!------------------------------------------------------------------------- +! test_begin +!------------------------------------------------------------------------- + +SUBROUTINE test_begin(string) + CHARACTER(LEN=*), INTENT(IN) :: string + WRITE(*, fmt = '(14a)', advance = 'no') string + WRITE(*, fmt = '(40x,a)', advance = 'no') ' ' +END SUBROUTINE test_begin + +!------------------------------------------------------------------------- +! passed +!------------------------------------------------------------------------- + +SUBROUTINE passed() + WRITE(*, fmt = '(6a)') 'PASSED' +END SUBROUTINE passed diff --git a/hl/fortran/test/tstlite.f90 b/hl/fortran/test/tstlite.f90 deleted file mode 100644 index da44eb7..0000000 --- a/hl/fortran/test/tstlite.f90 +++ /dev/null @@ -1,1711 +0,0 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! -! -! This file contains the FORTRAN90 tests for H5LT -! - -PROGRAM lite_test - - CALL test_dataset1D() - CALL test_dataset2D() - CALL test_dataset3D() - CALL test_datasetND(4) - CALL test_datasetND(5) - CALL test_datasetND(6) - CALL test_datasetND(7) - CALL test_datasets() - CALL test_attributes() - -END PROGRAM lite_test - - -!------------------------------------------------------------------------- -! test_dataset1D -!------------------------------------------------------------------------- - -SUBROUTINE test_dataset1D() - -USE, INTRINSIC :: ISO_C_BINDING -USE H5LT ! module of H5LT -USE HDF5 ! module of HDF5 library - -IMPLICIT NONE - -INTEGER, PARAMETER :: DIM1 = 4; ! Dimension of array -CHARACTER(len=9), PARAMETER :: filename = "dsetf1.h5"! File name -CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name -CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name -CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name -INTEGER(HID_T) :: file_id ! File identifier -INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions -INTEGER :: rank = 1 ! Dataset rank -INTEGER, DIMENSION(DIM1) :: buf1 ! Data buffer -INTEGER, DIMENSION(DIM1) :: bufr1 ! Data buffer -REAL, DIMENSION(DIM1) :: buf2 ! Data buffer -REAL, DIMENSION(DIM1) :: bufr2 ! Data buffer -DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf3 ! Data buffer -DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr3 ! Data buffer -INTEGER :: errcode ! Error flag -INTEGER :: i ! general purpose integer -TYPE(C_PTR) :: f_ptr -integer(HID_T) :: mytype - -CALL test_begin(' Make/Read datasets (1D) ') - -! -! Initialize the data array. -! -DO i = 1, DIM1 - buf1(i) = i; - buf2(i) = i; - buf3(i) = i; -END DO - -! -! Initialize FORTRAN predefined datatypes. -! -CALL h5open_f(errcode) - -! -! Create a new file using default properties. -! -CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) - -!------------------------------------------------------------------------- -! H5T_NATIVE_INTEGER -!------------------------------------------------------------------------- - -! -! write dataset. -! -CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf1, errcode) - -! -! read dataset. -! -CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr1, dims, errcode) - -! -! compare read and write buffers. -! -DO i = 1, DIM1 - IF ( buf1(i) .NE. bufr1(i) ) THEN - PRINT *, 'read buffer differs from write buffer (I)' - PRINT *, bufr1(i), ' and ', buf1(i) - STOP - ENDIF -END DO - -!------------------------------------------------------------------------- -! H5T_NATIVE_REAL -!------------------------------------------------------------------------- - -! -! write dataset. -! -CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_REAL, buf2, errcode) - -! -! read dataset. -! -CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_REAL, bufr2, dims, errcode) - -! -! compare read and write buffers. -! -DO i = 1, DIM1 - IF ( buf2(i) .NE. bufr2(i) ) THEN - PRINT *, 'read buffer differs from write buffer (R)' - PRINT *, bufr2(i), ' and ', buf2(i) - STOP - ENDIF -END DO - -!------------------------------------------------------------------------- -! H5T_NATIVE_DOUBLE -!------------------------------------------------------------------------- - -! -! write dataset. -! -f_ptr = C_LOC(buf3(1)) -mytype = h5kind_to_type(KIND(buf3(1)), H5_REAL_KIND) -CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, & - mytype, f_ptr, errcode) -!CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_DOUBLE, buf3, errcode) -! h5kind_to_type(KIND(buf3(1)), H5_REAL_KIND) -! -! read dataset. -! -f_ptr = C_LOC(bufr3(1)) -CALL h5ltread_dataset_f(file_id, dsetname3, & - h5kind_to_type(KIND(bufr3(1)), H5_REAL_KIND), f_ptr, errcode) -!CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_DOUBLE, bufr3, dims, errcode) - -! -! compare read and write buffers. -! -DO i = 1, DIM1 - IF ( buf3(i) .NE. bufr3(i) ) THEN - PRINT *, 'read buffer differs from write buffer (D)' - PRINT *, bufr3(i), ' and ', buf3(i) - STOP - ENDIF -END DO - -! -! Close the file. -! -CALL h5fclose_f(file_id, errcode) - -! -! Close FORTRAN predefined datatypes. -! -CALL h5close_f(errcode) - -CALL passed() -! -! end function. -! -END SUBROUTINE test_dataset1D - -!------------------------------------------------------------------------- -! test_dataset2D -!------------------------------------------------------------------------- - -SUBROUTINE test_dataset2D() - -USE, INTRINSIC :: ISO_C_BINDING -USE H5LT ! module of H5LT -USE HDF5 ! module of HDF5 library - -IMPLICIT NONE - - -INTEGER(HSIZE_T), PARAMETER :: DIM1 = 4; ! columns -INTEGER(HSIZE_T), PARAMETER :: DIM2 = 6; ! rows -CHARACTER(len=9), PARAMETER :: filename = "dsetf2.h5"! File name -CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name -CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name -CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name -CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name -INTEGER(HID_T) :: file_id ! File identifier -INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions -INTEGER :: rank = 2 ! Dataset rank -INTEGER, DIMENSION(DIM1*DIM2) :: buf ! Data buffer -INTEGER, DIMENSION(DIM1*DIM2) :: bufr ! Data buffer -INTEGER, DIMENSION(DIM1,DIM2) :: buf2 ! Data buffer -INTEGER, DIMENSION(DIM1,DIM2) :: buf2r ! Data buffer -REAL, DIMENSION(DIM1,DIM2), TARGET :: buf3 ! Data buffer -REAL, DIMENSION(DIM1,DIM2), TARGET :: buf3r ! Data buffer -DOUBLE PRECISION, DIMENSION(DIM1,DIM2), TARGET :: buf4 ! Data buffer -DOUBLE PRECISION, DIMENSION(DIM1,DIM2), TARGET :: buf4r ! Data buffer -INTEGER :: errcode ! Error flag -INTEGER(HSIZE_T) :: i, j, n ! general purpose integers -TYPE(C_PTR) :: f_ptr - -CALL test_begin(' Make/Read datasets (2D) ') - - -! -! Initialize the data arrays. -! -n=1 -DO i = 1, DIM1*DIM2 - buf(i) = INT(n) - n = n + 1 -END DO - -DO i = 1, dims(1) - DO j = 1, dims(2) - buf2(i,j) = INT((i-1)*dims(2) + j) - buf3(i,j) = INT((i-1)*dims(2) + j) - buf4(i,j) = INT((i-1)*dims(2) + j) - END DO -END DO - - -! -! Initialize FORTRAN predefined datatypes. -! -CALL h5open_f(errcode) - -! -! Create a new file using default properties. -! -CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) - -!------------------------------------------------------------------------- -! H5T_NATIVE_INT 1D buffer -!------------------------------------------------------------------------- - -! -! write dataset. -! -CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode) - -! -! read dataset. -! -CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode) - -! -! compare read and write buffers. -! -DO i = 1, DIM1*DIM2 - IF ( buf(i) .NE. bufr(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufr(i), ' and ', buf(i) - STOP - ENDIF -END DO - -!------------------------------------------------------------------------- -! H5T_NATIVE_INT 2D buffer -!------------------------------------------------------------------------- - -! -! write dataset. -! -CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode) - -! -! read dataset. -! -CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode) - -! -! compare read and write buffers. -! -DO i = 1, dims(1) - DO j = 1, dims(2) - IF ( buf2(i,j) .NE. buf2r(i,j) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, buf2r(i,j), ' and ', buf2(i,j) - STOP - ENDIF - END DO -END DO - -!------------------------------------------------------------------------- -! H5T_NATIVE_REAL -!------------------------------------------------------------------------- - -! -! write dataset. -! -f_ptr = C_LOC(buf3(1,1)) -CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode) -!CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode) - -! -! read dataset. -! -f_ptr = C_LOC(buf3r(1,1)) -CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) -!CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode) - -! -! compare read and write buffers. -! -DO i = 1, dims(1) - DO j = 1, dims(2) - IF ( buf3(i,j) .NE. buf3r(i,j) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, buf3r(i,j), ' and ', buf3(i,j) - STOP - ENDIF - END DO -END DO - -!------------------------------------------------------------------------- -! H5T_NATIVE_DOUBLE -!------------------------------------------------------------------------- - -! -! write dataset. -! -f_ptr = C_LOC(buf4(1,1)) -CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode) -!CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, buf4, errcode) - -! -! read dataset. -f_ptr = C_LOC(buf4r(1,1)) -CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - -!CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, buf4r, dims, errcode) - -! -! compare read and write buffers. -! -DO i = 1, dims(1) - DO j = 1, dims(2) - IF ( buf4(i,j) .NE. buf4r(i,j) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, buf4r(i,j), ' and ', buf4(i,j) - STOP - ENDIF - END DO -END DO - -! -! Close the file. -! -CALL h5fclose_f(file_id, errcode) - -! -! Close FORTRAN predefined datatypes. -! -CALL h5close_f(errcode) - -CALL passed() -! -! end function. -! -END SUBROUTINE test_dataset2D - - -!------------------------------------------------------------------------- -! test_dataset3D -!------------------------------------------------------------------------- - - -SUBROUTINE test_dataset3D() -USE, INTRINSIC :: ISO_C_BINDING -USE H5LT ! module of H5LT -USE HDF5 ! module of HDF5 library - -IMPLICIT NONE - -INTEGER, PARAMETER :: DIM1 = 6 ! columns -INTEGER, PARAMETER :: DIM2 = 4 ! rows -INTEGER, PARAMETER :: DIM3 = 2 ! layers -CHARACTER(len=9), PARAMETER :: filename = "dsetf3.h5" ! File name -CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name -CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name -CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name -CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name -INTEGER(HID_T) :: file_id ! File identifier -INTEGER(HSIZE_T), DIMENSION(3) :: dims = (/DIM1,DIM2,DIM3/) ! Dataset dimensions -INTEGER(HSIZE_T), DIMENSION(3) :: dimsr ! Dataset dimensions -INTEGER, DIMENSION(DIM1*DIM2*DIM3) :: buf ! Data buffer -INTEGER, DIMENSION(DIM1*DIM2*DIM3) :: bufr ! Data buffer -INTEGER, DIMENSION(DIM1,DIM2,DIM3) :: buf2 ! Data buffer -INTEGER, DIMENSION(DIM1,DIM2,DIM3) :: buf2r ! Data buffer -REAL, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf3 ! Data buffer -REAL, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf3r ! Data buffer -DOUBLE PRECISION, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf4 ! Data buffer -DOUBLE PRECISION, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf4r ! Data buffer -INTEGER :: rank = 3 ! Dataset rank -INTEGER :: errcode ! Error flag -INTEGER(HSIZE_T) :: i, j, k, n ! general purpose integers -INTEGER :: type_class -INTEGER(SIZE_T) :: type_size -TYPE(C_PTR) :: f_ptr -CALL test_begin(' Make/Read datasets (3D) ') - - -! -! Initialize the data array. -! -n=1 -DO i = 1, DIM1*DIM2*DIM3 - buf(i) = INT(n) - n = n + 1 -END DO - -n = 1 -DO i = 1, dims(1) - DO j = 1, dims(2) - DO k = 1, dims(3) - buf2(i,j,k) = INT(n) - buf3(i,j,k) = INT(n) - buf4(i,j,k) = INT(n) - n = n + 1 - END DO - END DO -END DO - -! -! Initialize FORTRAN predefined datatypes. -! -CALL h5open_f(errcode) - -! -! Create a new file using default properties. -! -CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) - -!------------------------------------------------------------------------- -! H5T_NATIVE_INT 1D buffer -!------------------------------------------------------------------------- - -! -! write dataset. -! -CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode) - -! -! read dataset. -! -CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode) - -! -! compare read and write buffers. -! -DO i = 1, DIM1*DIM2*DIM3 - IF ( buf(i) .NE. bufr(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufr(i), ' and ', buf(i) - STOP - ENDIF -END DO - -!------------------------------------------------------------------------- -! H5T_NATIVE_INT 3D buffer -!------------------------------------------------------------------------- - -! -! write dataset. -! -CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode) - -! -! read dataset. -! -CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode) - -! -! compare read and write buffers. -! -DO i = 1, dims(1) - DO j = 1, dims(2) - DO k = 1, dims(3) - IF ( buf2(i,j,k) .NE. buf2r(i,j,k) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, buf2r(i,j,k), ' and ', buf2(i,j,k) - STOP - ENDIF - END DO - END DO -END DO - -!------------------------------------------------------------------------- -! H5T_NATIVE_REAL -!------------------------------------------------------------------------- - -! -! write dataset. -! -f_ptr = C_LOC(buf3(1,1,1)) -CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode) -!CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode) - -! -! read dataset. -! -f_ptr = C_LOC(buf3r(1,1,1)) -CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) -!CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode) - -! -! compare read and write buffers. -! -DO i = 1, dims(1) - DO j = 1, dims(2) - DO k = 1, dims(3) - IF ( buf3(i,j,k) .NE. buf3r(i,j,k) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, buf3r(i,j,k), ' and ', buf3(i,j,k) - STOP - ENDIF - END DO - END DO -END DO - -!------------------------------------------------------------------------- -! H5T_NATIVE_DOUBLE -!------------------------------------------------------------------------- - -! -! write dataset. -! -f_ptr = C_LOC(buf4(1,1,1)) -CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode) - -! -! read dataset. -! -f_ptr = C_LOC(buf4r(1,1,1)) -CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - -! -! compare read and write buffers. -! -DO i = 1, dims(1) - DO j = 1, dims(2) - DO k = 1, dims(3) - IF ( buf4(i,j,k) .NE. buf4r(i,j,k) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, buf4r(i,j,k), ' and ', buf4(i,j,k) - STOP - ENDIF - END DO - END DO -END DO - -CALL h5ltget_dataset_info_f(file_id,dsetname4,dimsr,type_class,type_size,errcode ) - -! -! compare dimensions -! -DO i = 1, rank - IF ( dimsr(i) .NE. dims(i) ) THEN - PRINT *, 'dimensions differ ' - STOP - ENDIF -END DO - -! -! Close the file. -! -CALL h5fclose_f(file_id, errcode) - -! -! Close FORTRAN predefined datatypes. -! -CALL h5close_f(errcode) - -CALL passed() -! -! end function. -! -END SUBROUTINE test_dataset3D - -!------------------------------------------------------------------------- -! test_datasetND -!------------------------------------------------------------------------- - - -SUBROUTINE test_datasetND(rank) - - USE, INTRINSIC :: ISO_C_BINDING - USE H5LT ! module of H5LT - USE HDF5 ! module of HDF5 library - - IMPLICIT NONE - - INTEGER :: rank ! Dataset rank - - INTEGER, PARAMETER :: DIM1 = 2 ! columns - INTEGER, PARAMETER :: DIM2 = 4 ! rows - INTEGER, PARAMETER :: DIM3 = 2 ! layers - INTEGER, PARAMETER :: DIM4 = 5 ! columns - INTEGER, PARAMETER :: DIM5 = 4 ! rows - INTEGER, PARAMETER :: DIM6 = 3 ! layers - INTEGER, PARAMETER :: DIM7 = 2 ! layers - CHARACTER(len=9), PARAMETER :: filename = "dsetf3.h5" ! File name - CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name - CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name - CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HSIZE_T), DIMENSION(7) :: dims - INTEGER(HSIZE_T), DIMENSION(7) :: dimsr ! Dataset dimensions - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: ibuf_4 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: ibufr_4 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: ibuf_5 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: ibufr_5 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:) :: ibuf_6 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:) :: ibufr_6 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:) :: ibuf_7 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:) :: ibufr_7 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: rbuf_4 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: rbufr_4 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: rbuf_5 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: rbufr_5 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: rbuf_6 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: rbufr_6 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: rbuf_7 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: rbufr_7 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: dbuf_4 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: dbufr_4 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: dbuf_5 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: dbufr_5 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: dbuf_6 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: dbufr_6 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: dbuf_7 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: dbufr_7 ! Data buffer - INTEGER :: errcode ! Error flag - INTEGER(HSIZE_T) :: i, j, k, l, m, n, o, nn ! general purpose integers - INTEGER :: type_class - INTEGER(SIZE_T) :: type_size - CHARACTER(LEN=1) :: ichr1 - TYPE(C_PTR) :: f_ptr - - WRITE(ichr1,'(I1.1)') rank - CALL test_begin(' Make/Read datasets ('//ichr1//'D) ') -! -! Initialize the data array. -! - IF(rank.EQ.4)THEN - - ALLOCATE(ibuf_4 (1:DIM1,1:DIM2,1:DIM3,1:DIM4)) - ALLOCATE(ibufr_4(1:DIM1,1:DIM2,1:DIM3,1:DIM4)) - ALLOCATE(rbuf_4 (1:DIM1,1:DIM2,1:DIM3,1:DIM4)) - ALLOCATE(rbufr_4(1:DIM1,1:DIM2,1:DIM3,1:DIM4)) - ALLOCATE(dbuf_4 (1:DIM1,1:DIM2,1:DIM3,1:DIM4)) - ALLOCATE(dbufr_4(1:DIM1,1:DIM2,1:DIM3,1:DIM4)) - - dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,0,0,0/) - - nn = 1 - DO i = 1, DIM1 - DO j = 1, DIM2 - DO k = 1, DIM3 - DO l = 1, DIM4 - ibuf_4(i,j,k,l) = INT(nn) - rbuf_4(i,j,k,l) = INT(nn) - dbuf_4(i,j,k,l) = INT(nn) - nn = nn + 1 - END DO - END DO - END DO - ENDDO - - ELSE IF(rank.EQ.5)THEN - - ALLOCATE(ibuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) - ALLOCATE(ibufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) - ALLOCATE(rbuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) - ALLOCATE(rbufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) - ALLOCATE(dbuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) - ALLOCATE(dbufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) - - dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,DIM5,0,0/) - - nn = 1 - DO i = 1, DIM1 - DO j = 1, DIM2 - DO k = 1, DIM3 - DO l = 1, DIM4 - DO m = 1, DIM5 - ibuf_5(i,j,k,l,m) = INT(nn) - rbuf_5(i,j,k,l,m) = INT(nn) - dbuf_5(i,j,k,l,m) = INT(nn) - nn = nn + 1 - END DO - END DO - END DO - ENDDO - ENDDO - - ELSE IF(rank.EQ.6)THEN - - ALLOCATE(ibuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) - ALLOCATE(ibufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) - ALLOCATE(rbuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) - ALLOCATE(rbufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) - ALLOCATE(dbuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) - ALLOCATE(dbufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) - - dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,DIM5,DIM6,0/) - - nn = 1 - DO i = 1, DIM1 - DO j = 1, DIM2 - DO k = 1, DIM3 - DO l = 1, DIM4 - DO m = 1, DIM5 - DO n = 1, DIM6 - ibuf_6(i,j,k,l,m,n) = INT(nn) - rbuf_6(i,j,k,l,m,n) = INT(nn) - dbuf_6(i,j,k,l,m,n) = INT(nn) - nn = nn + 1 - END DO - END DO - END DO - ENDDO - ENDDO - ENDDO - - ELSE IF(rank.EQ.7)THEN - - ALLOCATE(ibuf_7 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) - ALLOCATE(ibufr_7(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) - ALLOCATE(rbuf_7 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) - ALLOCATE(rbufr_7(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) - ALLOCATE(dbuf_7 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) - ALLOCATE(dbufr_7(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7)) - - dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,DIM5,DIM6,DIM7/) - - nn = 1 - DO i = 1, DIM1 - DO j = 1, DIM2 - DO k = 1, DIM3 - DO l = 1, DIM4 - DO m = 1, DIM5 - DO n = 1, DIM6 - DO o = 1, DIM7 - ibuf_7(i,j,k,l,m,n,o) = INT(nn) - rbuf_7(i,j,k,l,m,n,o) = INT(nn) - dbuf_7(i,j,k,l,m,n,o) = INT(nn) - nn = nn + 1 - END DO - END DO - END DO - ENDDO - ENDDO - ENDDO - ENDDO - - ENDIF - - ! - ! Initialize FORTRAN predefined datatypes. - ! - CALL h5open_f(errcode) - - ! - ! Create a new file using default properties. - ! - CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) - - !------------------------------------------------------------------------- - ! H5T_NATIVE_INT ND buffer - !------------------------------------------------------------------------- - - ! - ! write dataset. - ! - IF(rank.EQ.4)THEN - CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_4, errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(ibuf_5(1,1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_6, errcode) - ELSE IF(rank.EQ.7)THEN - CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_7, errcode) - ENDIF - - - ! - ! read dataset. - ! - IF(rank.EQ.4)THEN - CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_4, dims(1:rank), errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(ibufr_5(1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_6, dims(1:rank), errcode) - ELSE IF(rank.EQ.7)THEN - CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_7, dims(1:rank), errcode) - ENDIF - - ! - ! compare read and write buffers. - ! - DO i = 1, dims(1) - DO j = 1, dims(2) - DO k = 1, dims(3) - DO l = 1, dims(4) - IF(rank.EQ.4)THEN - IF ( ibuf_4(i,j,k,l) .NE. ibufr_4(i,j,k,l) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, ibuf_4(i,j,k,l), ' and ', ibufr_4(i,j,k,l) - STOP - ENDIF - ENDIF - DO m = 1, dims(5) - IF(rank.EQ.5)THEN - IF ( ibuf_5(i,j,k,l,m) .NE. ibufr_5(i,j,k,l,m) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, ibuf_5(i,j,k,l,m), ' and ', ibufr_5(i,j,k,l,m) - STOP - ENDIF - ENDIF - DO n = 1, dims(6) - IF(rank.EQ.6)THEN - IF ( ibuf_6(i,j,k,l,m,n) .NE. ibufr_6(i,j,k,l,m,n) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, ibuf_6(i,j,k,l,m,n), ' and ', ibufr_6(i,j,k,l,m,n) - STOP - ENDIF - ENDIF - DO o = 1, dims(7) - IF(rank.EQ.7)THEN - IF ( ibuf_7(i,j,k,l,m,n,o) .NE. ibufr_7(i,j,k,l,m,n,o) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, ibuf_7(i,j,k,l,m,n,o), ' and ', ibufr_7(i,j,k,l,m,n,o) - STOP - ENDIF - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - !------------------------------------------------------------------------- - ! H5T_NATIVE_REAL - !------------------------------------------------------------------------- - - ! - ! write dataset. - ! - IF(rank.EQ.4)THEN - f_ptr = C_LOC(rbuf_4(1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode) - ! CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_4, errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(rbuf_5(1,1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - f_ptr = C_LOC(rbuf_6(1,1,1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode) - !CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_6, errcode) - ELSE IF(rank.EQ.7)THEN - f_ptr = C_LOC(rbuf_7(1,1,1,1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode) - !CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_7, errcode) - ENDIF - - - ! - ! read dataset. - ! - IF(rank.EQ.4)THEN - f_ptr = C_LOC(rbufr_4(1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(rbufr_5(1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - f_ptr = C_LOC(rbufr_6(1,1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) - ELSE IF(rank.EQ.7)THEN - f_ptr = C_LOC(rbufr_7(1,1,1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) - ENDIF - - ! - ! compare read and write buffers. - ! - DO i = 1, dims(1) - DO j = 1, dims(2) - DO k = 1, dims(3) - DO l = 1, dims(4) - IF(rank.EQ.4)THEN - IF ( rbuf_4(i,j,k,l) .NE. rbufr_4(i,j,k,l) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, rbuf_4(i,j,k,l), ' and ', rbufr_4(i,j,k,l) - STOP - ENDIF - ENDIF - DO m = 1, dims(5) - IF(rank.EQ.5)THEN - IF ( rbuf_5(i,j,k,l,m) .NE. rbufr_5(i,j,k,l,m) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, rbuf_5(i,j,k,l,m), ' and ', rbufr_5(i,j,k,l,m) - STOP - ENDIF - ENDIF - DO n = 1, dims(6) - IF(rank.EQ.6)THEN - IF ( rbuf_6(i,j,k,l,m,n) .NE. rbufr_6(i,j,k,l,m,n) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, rbuf_6(i,j,k,l,m,n), ' and ', rbufr_6(i,j,k,l,m,n) - STOP - ENDIF - ENDIF - DO o = 1, dims(7) - IF(rank.EQ.7)THEN - IF ( rbuf_7(i,j,k,l,m,n,o) .NE. rbufr_7(i,j,k,l,m,n,o) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, rbuf_7(i,j,k,l,m,n,o), ' and ', rbufr_7(i,j,k,l,m,n,o) - STOP - ENDIF - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - - !------------------------------------------------------------------------- - ! H5T_NATIVE_DOUBLE - !------------------------------------------------------------------------- - - ! - ! write dataset. - ! - IF(rank.EQ.4)THEN - f_ptr = C_LOC(dbuf_4(1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(dbuf_5(1,1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - f_ptr = C_LOC(dbuf_6(1,1,1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.7)THEN - f_ptr = C_LOC(dbuf_7(1,1,1,1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) - ENDIF - - - ! - ! read dataset. - ! - IF(rank.EQ.4)THEN - f_ptr = C_LOC(dbufr_4(1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(dbufr_5(1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - f_ptr = C_LOC(dbufr_6(1,1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.7)THEN - f_ptr = C_LOC(dbufr_7(1,1,1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - ENDIF - - ! - ! compare read and write buffers. - ! - DO i = 1, dims(1) - DO j = 1, dims(2) - DO k = 1, dims(3) - DO l = 1, dims(4) - IF(rank.EQ.4)THEN - IF ( dbuf_4(i,j,k,l) .NE. dbufr_4(i,j,k,l) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, dbuf_4(i,j,k,l), ' and ', dbufr_4(i,j,k,l) - STOP - ENDIF - ENDIF - DO m = 1, dims(5) - IF(rank.EQ.5)THEN - IF ( dbuf_5(i,j,k,l,m) .NE. dbufr_5(i,j,k,l,m) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, dbuf_5(i,j,k,l,m), ' and ', dbufr_5(i,j,k,l,m) - STOP - ENDIF - ENDIF - DO n = 1, dims(6) - IF(rank.EQ.6)THEN - IF ( dbuf_6(i,j,k,l,m,n) .NE. dbufr_6(i,j,k,l,m,n) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, dbuf_6(i,j,k,l,m,n), ' and ', dbufr_6(i,j,k,l,m,n) - STOP - ENDIF - ENDIF - DO o = 1, dims(7) - IF(rank.EQ.7)THEN - IF ( dbuf_7(i,j,k,l,m,n,o) .NE. dbufr_7(i,j,k,l,m,n,o) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, dbuf_7(i,j,k,l,m,n,o), ' and ', dbufr_7(i,j,k,l,m,n,o) - STOP - ENDIF - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - - CALL h5ltget_dataset_info_f(file_id,dsetname4,dimsr,type_class,type_size,errcode ) - - ! - ! compare dimensions - ! - DO i = 1, rank - IF ( dimsr(i) .NE. dims(i) ) THEN - PRINT *, 'dimensions differ ' - STOP - ENDIF - END DO - - ! - ! Close the file. - ! - CALL h5fclose_f(file_id, errcode) - - ! - ! Close FORTRAN predefined datatypes. - ! - CALL h5close_f(errcode) - - ! DEALLOCATE RESOURCES - - IF(rank.EQ.4)THEN - DEALLOCATE(ibuf_4, ibufr_4, rbuf_4, rbufr_4, dbuf_4, dbufr_4) - ELSE IF(rank.EQ.5)THEN - DEALLOCATE(ibuf_5, ibufr_5, rbuf_5, rbufr_5, dbuf_5, dbufr_5) - ELSE IF(rank.EQ.6)THEN - DEALLOCATE(ibuf_6, ibufr_6, rbuf_6, rbufr_6, dbuf_6, dbufr_6) - ELSE IF(rank.EQ.7)THEN - DEALLOCATE(ibuf_7, ibufr_7, rbuf_7, rbufr_7, dbuf_7, dbufr_7) - ENDIF - - CALL passed() - ! - ! end function. - ! -END SUBROUTINE test_datasetND - - - -!------------------------------------------------------------------------- -! test_datasets -!------------------------------------------------------------------------- - -SUBROUTINE test_datasets() - - USE, INTRINSIC :: ISO_C_BINDING - USE H5LT ! module of H5LT - USE HDF5 ! module of HDF5 library - - IMPLICIT NONE - - CHARACTER(len=9), PARAMETER :: filename = "dsetf4.h5"! File name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER :: errcode ! Error flag - INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array - CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name - CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name - CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name - CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name - CHARACTER(LEN=5), PARAMETER :: dsetname5 = "dset5" ! Dataset name - INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions - INTEGER(HSIZE_T), DIMENSION(1) :: dimsr ! Dataset dimensions - INTEGER :: rank = 1 ! Dataset rank - INTEGER :: rankr ! Dataset rank - CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer - CHARACTER(LEN=8) :: buf1r ! Data buffer - INTEGER, DIMENSION(DIM1) :: buf2 ! Data buffer - INTEGER, DIMENSION(DIM1) :: bufr2 ! Data buffer - REAL, DIMENSION(DIM1), TARGET :: buf3 ! Data buffer - REAL, DIMENSION(DIM1) , TARGET :: bufr3 ! Data buffer - DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf4 ! Data buffer - DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr4 ! Data buffer - INTEGER :: i, n ! general purpose integer - INTEGER :: has ! general purpose integer - INTEGER :: type_class - INTEGER(SIZE_T) :: type_size - LOGICAL :: path_valid ! status of the path - CHARACTER(LEN=6) :: chr_exact - CHARACTER(LEN=8) :: chr_lg - TYPE(C_PTR) :: f_ptr - - ! - ! Initialize FORTRAN predefined datatypes. - ! - CALL h5open_f(errcode) - - ! - ! Create a new file using default properties. - ! - CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) - - ! - ! Initialize the data array. - ! - n = 1 - DO i = 1, DIM1 - buf2(i) = n - buf3(i) = n - buf4(i) = n - n = n + 1 - END DO - - !------------------------------------------------------------------------- - ! int - !------------------------------------------------------------------------- - - CALL test_begin(' Make/Read datasets (integer) ') - - ! - ! write dataset. - ! - CALL h5ltmake_dataset_int_f(file_id, dsetname2, rank, dims, buf2, errcode) - - ! - ! read dataset. - ! - CALL h5ltread_dataset_int_f(file_id, dsetname2, bufr2, dims, errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, DIM1 - IF ( buf2(i) .NE. bufr2(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufr2(i), ' and ', buf2(i) - STOP - ENDIF - END DO - - CALL passed() - - - !------------------------------------------------------------------------- - ! real - !------------------------------------------------------------------------- - - CALL test_begin(' Make/Read datasets (float) ') - - - ! - ! write dataset. - ! - f_ptr = C_LOC(buf3(1)) - CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode) - - ! - ! read dataset. - ! - f_ptr = C_LOC(bufr3(1)) - CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, DIM1 - IF ( buf3(i) .NE. bufr3(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufr3(i), ' and ', buf3(i) - STOP - ENDIF - END DO - - CALL passed() - - !------------------------------------------------------------------------- - ! double - !------------------------------------------------------------------------- - - CALL test_begin(' Make/Read datasets (double) ') - - - ! - ! write dataset. - ! - f_ptr = C_LOC(buf4(1)) - CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode) - !CALL h5ltmake_dataset_double_f(file_id, dsetname4, rank, dims, buf4, errcode) - - ! - ! read dataset. - ! - f_ptr = C_LOC(buf4(1)) - CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - !CALL h5ltread_dataset_double_f(file_id, dsetname4, bufr4, dims, errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, DIM1 - IF ( buf4(i) .NE. bufr4(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufr4(i), ' and ', buf4(i) - STOP - ENDIF - END DO - - CALL passed() - - - !------------------------------------------------------------------------- - ! string - !------------------------------------------------------------------------- - - CALL test_begin(' Make/Read datasets (string) ') - - - ! - ! write dataset. - ! - CALL h5ltmake_dataset_string_f(file_id, dsetname5, buf1, errcode) - - ! - ! read dataset. - ! - CALL h5ltread_dataset_string_f(file_id, dsetname5, buf1r, errcode) - - ! - ! compare read and write buffers. - ! - IF ( buf1 .NE. buf1r ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, buf1, ' and ', buf1r - STOP - ENDIF - - CALL passed() - - CALL test_begin(' Test h5ltpath_valid_f ') - ! - ! test function h5ltpath_valid_f - ! - chr_exact = "/"//dsetname2 ! test character buffer the exact size needed - CALL h5ltpath_valid_f(file_id, chr_exact, .TRUE., path_valid, errcode) - IF(errcode.LT.0.OR..NOT.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - chr_lg = "/"//dsetname2 ! test character buffer larger then needed - CALL h5ltpath_valid_f(file_id, chr_lg, .TRUE., path_valid, errcode) - IF(errcode.LT.0.OR..NOT.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - CALL h5ltpath_valid_f(file_id, chr_lg, .FALSE., path_valid, errcode) - IF(errcode.LT.0.OR..NOT.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - ! Should fail, dataset does not exist - CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .TRUE., path_valid, errcode) - IF(errcode.LT.0.OR.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .FALSE., path_valid, errcode) - IF(errcode.LT.0.OR.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - ! Create a dangling soft link - CALL h5lcreate_soft_f("/G2", file_id, "/G3", errcode) - - ! Should pass, does not check for dangled link - CALL h5ltpath_valid_f(file_id, "/G3", .FALSE., path_valid, errcode) - IF(.NOT.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - ! Should fail, dangled link - CALL h5ltpath_valid_f(file_id, "/G2", .TRUE., path_valid, errcode) - IF(path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - CALL passed() - - - CALL test_begin(' Get dataset dimensions/info ') - - !------------------------------------------------------------------------- - ! h5ltget_dataset_ndims_f - !------------------------------------------------------------------------- - - CALL h5ltget_dataset_ndims_f(file_id, dsetname4, rankr, errcode) - IF ( rankr .NE. rank ) THEN - PRINT *, 'h5ltget_dataset_ndims_f return error' - STOP - ENDIF - - - !------------------------------------------------------------------------- - ! test h5ltfind_dataset_f function - !------------------------------------------------------------------------- - - - has = h5ltfind_dataset_f(file_id,dsetname4) - IF ( has .NE. 1 ) THEN - PRINT *, 'h5ltfind_dataset_f return error' - STOP - ENDIF - - !------------------------------------------------------------------------- - ! test h5ltget_dataset_info_f function - !------------------------------------------------------------------------- - - - CALL h5ltget_dataset_info_f(file_id,dsetname4,dimsr,type_class,type_size,errcode ) - - ! - ! compare dimensions - ! - DO i = 1, rank - IF ( dimsr(i) .NE. dims(i) ) THEN - PRINT *, 'dimensions differ ' - STOP - ENDIF - END DO - - IF ( type_class .NE. 1 ) THEN ! H5T_FLOAT - PRINT *, 'wrong type class ' - STOP - ENDIF - - ! - ! Close the file. - ! - CALL h5fclose_f(file_id, errcode) - ! - ! Close FORTRAN predefined datatypes. - ! - CALL h5close_f(errcode) - - CALL passed() - ! - ! end function. - ! -END SUBROUTINE test_datasets - - - -!------------------------------------------------------------------------- -! test_attributes -!------------------------------------------------------------------------- - -SUBROUTINE test_attributes() - - USE, INTRINSIC :: ISO_C_BINDING - USE H5LT ! module of H5LT - USE HDF5 ! module of HDF5 library - - IMPLICIT NONE - - CHARACTER(len=9), PARAMETER :: filename = "dsetf5.h5"! File name - CHARACTER(len=9), PARAMETER :: filename1 ="tattr.h5" ! C written attribute file - INTEGER(HID_T) :: file_id ! File identifier -! INTEGER(HID_T) :: file_id1 - INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array - CHARACTER(LEN=5), PARAMETER :: attrname1 = "attr1" ! Attribute name - CHARACTER(LEN=5), PARAMETER :: attrname2 = "attr2" ! Attribute name - CHARACTER(LEN=5), PARAMETER :: attrname3 = "attr3" ! Attribute name - CHARACTER(LEN=5), PARAMETER :: attrname4 = "attr4" ! Attribute name - CHARACTER(LEN=5), PARAMETER :: attrname5 = "attr5" ! Attribute name - CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer - CHARACTER(LEN=16), PARAMETER :: buf_c = "string attribute" - CHARACTER(LEN=8) :: bufr1 ! Data buffer - CHARACTER(LEN=10) :: bufr1_lg ! Data buffer -! CHARACTER(LEN=16) :: bufr_c ! Data buffer -! CHARACTER(LEN=18) :: bufr_c_lg ! Data buffer - INTEGER, DIMENSION(DIM1) :: buf2 ! Data buffer - INTEGER, DIMENSION(DIM1) :: bufr2 ! Data buffer - REAL, DIMENSION(DIM1), target :: buf3 ! Data buffer - REAL, DIMENSION(DIM1), target :: bufr3 ! Data buffer - DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf4 ! Data buffer - DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr4 ! Data buffer - INTEGER :: errcode ! Error flag - INTEGER :: i, n ! general purpose integer - INTEGER(SIZE_T) size ! size of attribute array - INTEGER :: rankr ! rank - INTEGER(HSIZE_T), DIMENSION(1) :: dimsr ! attribute dimensions - INTEGER :: type_class - INTEGER(SIZE_T) :: type_size - INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions - INTEGER :: rank = 1 ! Dataset rank - CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name - INTEGER, DIMENSION(DIM1) :: buf ! Data buffer - INTEGER(SIZE_T) :: SizeOf_buf_type - TYPE(C_PTR) :: f_ptr - - ! - ! Initialize FORTRAN predefined datatypes. - ! - CALL h5open_f(errcode) - ! - ! Create a new file using default properties. - ! - CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) - ! - ! make a dataset. - ! - CALL h5ltmake_dataset_int_f(file_id, dsetname1, rank, dims, buf, errcode) - - ! - ! Initialize the data array. - ! - size = DIM1 - n = 1 - DO i = 1, DIM1 - buf2(i) = n - buf3(i) = n - buf4(i) = n - n = n + 1 - END DO - - - !------------------------------------------------------------------------- - ! int - !------------------------------------------------------------------------- - - CALL test_begin(' Set/Get attributes int ') - - - ! - ! write attribute. - ! - CALL h5ltset_attribute_int_f(file_id,dsetname1,attrname2,buf2,size,errcode) - - ! - ! read attribute. - ! - CALL h5ltget_attribute_int_f(file_id,dsetname1,attrname2,bufr2,errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, DIM1 - IF ( buf2(i) .NE. bufr2(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufr2(i), ' and ', buf2(i) - STOP - ENDIF - END DO - - CALL passed() - - !------------------------------------------------------------------------- - ! float - !------------------------------------------------------------------------- - - CALL test_begin(' Set/Get attributes float ') - - - ! - ! write attribute. - ! -!#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE - SizeOf_buf_type = STORAGE_SIZE(buf3(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) -!#else -! SizeOf_buf_type = SIZEOF(bufr4(1)) -!#endif - f_ptr = C_LOC(buf3(1)) - CALL h5ltset_attribute_f(file_id,dsetname1,attrname3,f_ptr,"REAL", SizeOf_buf_type, size,errcode) - !CALL h5ltset_attribute_float_f(file_id,dsetname1,attrname3,buf3,size,errcode) - ! - ! read attribute. - ! -!#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE - SizeOf_buf_type = STORAGE_SIZE(bufr3(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) -!#else -! SizeOf_buf_type = SIZEOF(bufr4(1)) -!#endif - - f_ptr = C_LOC(bufr3(1)) - CALL h5ltget_attribute_f(file_id,dsetname1,attrname3,f_ptr,"REAL",SizeOf_buf_type,errcode) - !CALL h5ltget_attribute_float_f(file_id,dsetname1,attrname3,bufr3,errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, DIM1 - IF ( buf3(i) .NE. bufr3(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufr3(i), ' and ', buf3(i) - STOP - ENDIF - END DO - - CALL passed() - - !------------------------------------------------------------------------- - ! double - !------------------------------------------------------------------------- - - CALL test_begin(' Set/Get attributes double ') - - SizeOf_buf_type = STORAGE_SIZE(buf4(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) - - ! - ! write attribute. - ! - f_ptr = C_LOC(buf4(1)) - CALL h5ltset_attribute_f(file_id,dsetname1,attrname4,f_ptr,"real", SizeOf_buf_type, size, errcode) - - !CALL h5ltset_attribute_double_f(file_id,dsetname1,attrname4,f_ptr,"Real", SizeOf_buf_type, size, errcode) - - ! - ! read attribute. - ! - -!#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE - SizeOf_buf_type = STORAGE_SIZE(bufr4(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) -!#else -! SizeOf_buf_type = SIZEOF(bufr4(1)) -!#endif - - f_ptr = C_LOC(bufr4(1)) - CALL h5ltget_attribute_f(file_id,dsetname1,attrname4,f_ptr,"REAL",SizeOf_buf_type,errcode) - -! CALL h5ltget_attribute_double_f(file_id,dsetname1,attrname4,bufr4,errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, DIM1 - IF ( buf4(i) .NE. bufr4(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufr4(i), ' and ', buf4(i) - STOP - ENDIF - END DO - - CALL passed() - - !------------------------------------------------------------------------- - ! string - !------------------------------------------------------------------------- - - CALL test_begin(' Set/Get attributes string ') - - ! - ! write attribute. - ! - CALL h5ltset_attribute_string_f(file_id,dsetname1,attrname5,buf1,errcode) - - ! - ! read attribute into a fortran character buf that is the same size as buf1. - ! - CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1,errcode) - - ! - ! compare read and write buffers. - ! - IF ( buf1 .NE. bufr1 ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, buf1, ' and ', bufr1 - STOP - ENDIF - - ! - ! read attribute into a fortran character buf that is larger then buf1. - ! - CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1_lg,errcode) - - ! - ! compare read and write buffers, make sure C NULL character was removed. - ! - IF ( buf1(1:8) .NE. bufr1_lg(1:8) .AND. bufr1_lg(9:10) .NE. ' ' ) THEN - PRINT *, 'larger read buffer differs from write buffer' - PRINT *, buf1, ' and ', bufr1_lg - STOP - ENDIF - - ! - ! ** Test reading a string that was created with a C program ** - ! - -!!$ CALL h5fopen_f(filename1, H5F_ACC_RDONLY_F, file_id1, errcode) -!!$ -!!$ CALL h5ltget_attribute_string_f(file_id1, "/", "attr5", bufr_c, errcode) -!!$ ! -!!$ ! compare read and write buffers. -!!$ ! -!!$ IF ( bufr_c .NE. buf_c ) THEN -!!$ PRINT *, 'read buffer differs from write buffer' -!!$ PRINT *, bufr1, ' and ', buf_c -!!$ STOP -!!$ ENDIF -!!$ ! -!!$ ! read attribute into a fortran character buf that is larger then buf_c. -!!$ ! -!!$ CALL h5ltget_attribute_string_f(file_id1, "/", "attr5", bufr_c_lg, errcode) -!!$ -!!$ ! -!!$ ! compare read and write buffers, make sure C NULL character was removed. -!!$ ! -!!$ IF ( buf_c(1:16) .NE. bufr_c_lg(1:16) .AND. bufr_c_lg(17:18) .NE. ' ' ) THEN -!!$ PRINT *, 'larger read buffer differs from write buffer' -!!$ PRINT *, buf_c, ' and ', bufr_c_lg -!!$ STOP -!!$ ENDIF - -!!$ CALL h5fclose_f(file_id1, errcode) - - CALL passed() - - !------------------------------------------------------------------------- - ! get attribute rank - !------------------------------------------------------------------------- - - CALL test_begin(' Get attribute rank/info ') - - - CALL h5ltget_attribute_ndims_f(file_id,dsetname1,attrname2,rankr,errcode) - - IF ( rankr .NE. 1 ) THEN - PRINT *, 'h5ltget_attribute_ndims_f return error' - STOP - ENDIF - - - CALL h5ltget_attribute_info_f(file_id,dsetname1,attrname2,dimsr,type_class,type_size,errcode) - - ! - ! compare dimensions - ! - DO i = 1, rank - IF ( dimsr(i) .NE. dims(i) ) THEN - PRINT *, 'dimensions differ ' - STOP - ENDIF - END DO - - - ! - ! Close the file. - ! - CALL h5fclose_f(file_id, errcode) - ! - ! Close FORTRAN predefined datatypes. - ! - CALL h5close_f(errcode) - - CALL passed() - ! - ! end function. - ! -END SUBROUTINE test_attributes - -!------------------------------------------------------------------------- -! test_begin -!------------------------------------------------------------------------- - -SUBROUTINE test_begin(string) - CHARACTER(LEN=*), INTENT(IN) :: string - WRITE(*, fmt = '(14a)', advance = 'no') string - WRITE(*, fmt = '(40x,a)', advance = 'no') ' ' -END SUBROUTINE test_begin - -!------------------------------------------------------------------------- -! passed -!------------------------------------------------------------------------- - -SUBROUTINE passed() - WRITE(*, fmt = '(6a)') 'PASSED' -END SUBROUTINE passed diff --git a/hl/fortran/test/tsttable.F90 b/hl/fortran/test/tsttable.F90 new file mode 100644 index 0000000..f679982 --- /dev/null +++ b/hl/fortran/test/tsttable.F90 @@ -0,0 +1,465 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! 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. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! +! This file contains the FORTRAN90 tests for H5LT +! + +PROGRAM table_test + + CALL test_table1() + +END PROGRAM table_test + + +!------------------------------------------------------------------------- +! test_table1 +!------------------------------------------------------------------------- + +SUBROUTINE test_table1() + + USE H5TB ! module of H5TB + USE HDF5 ! module of HDF5 library + + IMPLICIT NONE + + CHARACTER(len=8), PARAMETER :: filename = "f1tab.h5" ! File name + CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HSIZE_T), PARAMETER :: nfields = 4 ! nfields + INTEGER(HSIZE_T), PARAMETER :: nrecords = 5 ! nrecords + CHARACTER(LEN=10),DIMENSION(1:nfields) :: field_names ! field names + INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_offset ! field offset + INTEGER(HID_T), DIMENSION(1:nfields) :: field_types ! field types + INTEGER(HSIZE_T), PARAMETER :: chunk_size = 5 ! chunk size + INTEGER, PARAMETER :: compress = 0 ! compress + INTEGER :: errcode = 0 ! Error flag + INTEGER :: i ! general purpose integer + INTEGER(SIZE_T) :: type_size ! Size of the datatype + INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype + INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype + INTEGER(SIZE_T) :: type_sized ! Size of the double precision datatype + INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype + INTEGER(HID_T) :: type_id_c ! Memory datatype identifier (for character field) + INTEGER(SIZE_T) :: offset ! Member's offset + INTEGER(HSIZE_T) :: start = 0 ! start record + INTEGER, DIMENSION(nrecords) :: bufi ! Data buffer + INTEGER, DIMENSION(nrecords) :: bufir ! Data buffer + REAL, DIMENSION(nrecords) :: bufr ! Data buffer + REAL, DIMENSION(nrecords) :: bufrr ! Data buffer + DOUBLE PRECISION, DIMENSION(nrecords) :: bufd ! Data buffer + DOUBLE PRECISION, DIMENSION(nrecords) :: bufdr ! Data buffer + CHARACTER(LEN=2), DIMENSION(nrecords), PARAMETER :: bufs = (/"AB","CD","EF","GH","IJ"/) ! Data buffer + CHARACTER(LEN=2), DIMENSION(nrecords) :: bufsr ! Data buffer + INTEGER(HSIZE_T) :: nfieldsr ! nfields + INTEGER(HSIZE_T) :: nrecordsr ! nrecords + CHARACTER(LEN=9), DIMENSION(1:nfields) :: field_namesr ! field names + INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_offsetr ! field offset + INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_sizesr ! field sizes + INTEGER(SIZE_T) :: type_sizeout = 0 ! size of the datatype + INTEGER :: maxlen = 0 ! max chararter length of a field name + + + ! + ! Initialize the data arrays. + ! + DO i = 1, nrecords + bufi(i) = i + bufr(i) = i + bufd(i) = i + END DO + + ! + ! Initialize FORTRAN predefined datatypes. + ! + CALL h5open_f(errcode) + + ! + ! Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + + + !------------------------------------------------------------------------- + ! make table + ! initialize the table parameters + !------------------------------------------------------------------------- + + field_names(1) = "field1" + field_names(2) = "field2a" + field_names(3) = "field3ab" + field_names(4) = "field4abc" + + ! + ! calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, type_id_c, errcode) + type_size = 2 + CALL h5tset_size_f(type_id_c, type_size, errcode) + CALL h5tget_size_f(type_id_c, type_sizec, errcode) + CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, errcode) + CALL h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, errcode) + CALL h5tget_size_f(H5T_NATIVE_REAL, type_sizer, errcode) + type_size = type_sizec + type_sizei + type_sized + type_sizer + + ! + ! type ID's + ! + field_types(1) = type_id_c + field_types(2) = H5T_NATIVE_INTEGER + field_types(3) = H5T_NATIVE_DOUBLE + field_types(4) = H5T_NATIVE_REAL + + ! + ! offsets + ! + offset = 0 + field_offset(1) = offset + offset = offset + type_sizec ! Offset of the second memeber is 2 + field_offset(2) = offset + offset = offset + type_sizei ! Offset of the second memeber is 6 + field_offset(3) = offset + offset = offset + type_sized ! Offset of the second memeber is 14 + field_offset(4) = offset + + !------------------------------------------------------------------------- + ! make table + !------------------------------------------------------------------------- + + CALL test_begin(' Make table ') + + CALL h5tbmake_table_f(dsetname1,& + file_id,& + dsetname1,& + nfields,& + nrecords,& + type_size,& + field_names,& + field_offset,& + field_types,& + chunk_size,& + compress,& + errcode ) + + CALL passed() + + + !------------------------------------------------------------------------- + ! write field + !------------------------------------------------------------------------- + + CALL test_begin(' Read/Write field by name ') + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& + bufs,errcode) + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& + bufi,errcode) + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& + bufd,errcode) + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& + bufr,errcode) + + !------------------------------------------------------------------------- + ! read field + !------------------------------------------------------------------------- + + ! Read an invalid field, should fail + CALL h5tbread_field_name_f(file_id,dsetname1,'DoesNotExist',start,nrecords,type_sizec,& + bufsr,errcode) + + IF(errcode.GE.0)THEN + PRINT *, 'error in h5tbread_field_name_f' + CALL h5fclose_f(file_id, errcode) + CALL h5close_f(errcode) + STOP + ENDIF + + ! Read a valid field, should pass + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& + bufsr,errcode) + IF(errcode.LT.0)THEN + PRINT *, 'error in h5tbread_field_name_f' + CALL h5fclose_f(file_id, errcode) + CALL h5close_f(errcode) + STOP + ENDIF + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufsr(i) .NE. bufs(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufsr(i), ' and ', bufs(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& + bufir,errcode) + + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufir(i) .NE. bufi(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufir(i), ' and ', bufi(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& + bufdr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufdr(i) .NE. bufd(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufdr(i), ' and ', bufd(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& + bufrr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufrr(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufrr(i), ' and ', bufr(i) + STOP + ENDIF + END DO + + + CALL passed() + + !------------------------------------------------------------------------- + ! write field + !------------------------------------------------------------------------- + + CALL test_begin(' Read/Write field by index ') + + CALL h5tbwrite_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& + bufs,errcode) + + CALL h5tbwrite_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& + bufi,errcode) + + CALL h5tbwrite_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& + bufd,errcode) + + CALL h5tbwrite_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& + bufr,errcode) + + + + !------------------------------------------------------------------------- + ! read field + !------------------------------------------------------------------------- + + CALL h5tbread_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& + bufsr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufsr(i) .NE. bufs(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufsr(i), ' and ', bufs(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& + bufir,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufir(i) .NE. bufi(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufir(i), ' and ', bufi(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& + bufdr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufdr(i) .NE. bufd(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufdr(i), ' and ', bufd(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& + bufrr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufrr(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufrr(i), ' and ', bufr(i) + STOP + ENDIF + END DO + + + CALL passed() + + + !------------------------------------------------------------------------- + ! Insert field + ! we insert a field callsed "field5" with the same type and buffer as field 4 (Real) + !------------------------------------------------------------------------- + + CALL test_begin(' Insert field ') + + CALL h5tbinsert_field_f(file_id,dsetname1,"field5",field_types(4),4,bufr,errcode) + CALL h5tbread_field_index_f(file_id,dsetname1,5,start,nrecords,type_sizer,& + bufrr,errcode) + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufrr(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufrr(i), ' and ', bufr(i) + STOP + ENDIF + END DO + + + CALL passed() + + !------------------------------------------------------------------------- + ! Delete field + !------------------------------------------------------------------------- + + CALL test_begin(' Delete field ') + + CALL h5tbdelete_field_f(file_id,dsetname1,"field4abc",errcode) + + CALL passed() + + + !------------------------------------------------------------------------- + ! Gets the number of records and fields + !------------------------------------------------------------------------- + + CALL test_begin(' Get table info ') + + CALL h5tbget_table_info_f(file_id,dsetname1,nfieldsr,nrecordsr,errcode ) + + IF ( nfieldsr .NE. nfields .AND. nrecordsr .NE. nrecords ) THEN + PRINT *, 'h5tbget_table_info_f return error' + STOP + ENDIF + + CALL passed() + + !------------------------------------------------------------------------- + ! Get information about fields + !------------------------------------------------------------------------- + + CALL test_begin(' Get fields info ') + + CALL h5tbget_field_info_f(file_id, dsetname1, nfields, field_namesr, field_sizesr,& + field_offsetr, type_sizeout, errcode, maxlen ) + + IF ( errcode.NE.0 ) THEN + WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: RETURN ERROR")') + STOP + ENDIF + + ! "field4abc" was deleted and "field5" was added. + field_names(4) = "field5" + + IF ( maxlen .NE. 8 ) THEN + WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: INCORRECT MAXIMUM CHARACTER LENGTH OF THE FIELD NAMES")') + WRITE(*,'(5X,"RETURNED VALUE = ", I0, ", CORRECT VALUE = ", I0)') maxlen, 8 + STOP + ENDIF + + DO i = 1, nfields + IF ( field_namesr(i) .NE. field_names(i)) THEN + WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: READ/WRITE FIELD NAMES DIFFER")') + WRITE(*,'(27X,A," AND ",A)') TRIM(field_namesr(i)), TRIM(field_names(i)) + STOP + ENDIF + END DO + + CALL passed() + + + !------------------------------------------------------------------------- + ! end + !------------------------------------------------------------------------- + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) + + ! + ! end function. + ! +END SUBROUTINE test_table1 + + +!------------------------------------------------------------------------- +! test_begin +!------------------------------------------------------------------------- + +SUBROUTINE test_begin(string) + CHARACTER(LEN=*), INTENT(IN) :: string + WRITE(*, fmt = '(14a)', advance = 'no') string + WRITE(*, fmt = '(40x,a)', advance = 'no') ' ' +END SUBROUTINE test_begin + +!------------------------------------------------------------------------- +! passed +!------------------------------------------------------------------------- + +SUBROUTINE passed() + WRITE(*, fmt = '(6a)') 'PASSED' +END SUBROUTINE passed + + diff --git a/hl/fortran/test/tsttable.f90 b/hl/fortran/test/tsttable.f90 deleted file mode 100644 index f679982..0000000 --- a/hl/fortran/test/tsttable.f90 +++ /dev/null @@ -1,465 +0,0 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! -! -! This file contains the FORTRAN90 tests for H5LT -! - -PROGRAM table_test - - CALL test_table1() - -END PROGRAM table_test - - -!------------------------------------------------------------------------- -! test_table1 -!------------------------------------------------------------------------- - -SUBROUTINE test_table1() - - USE H5TB ! module of H5TB - USE HDF5 ! module of HDF5 library - - IMPLICIT NONE - - CHARACTER(len=8), PARAMETER :: filename = "f1tab.h5" ! File name - CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HSIZE_T), PARAMETER :: nfields = 4 ! nfields - INTEGER(HSIZE_T), PARAMETER :: nrecords = 5 ! nrecords - CHARACTER(LEN=10),DIMENSION(1:nfields) :: field_names ! field names - INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_offset ! field offset - INTEGER(HID_T), DIMENSION(1:nfields) :: field_types ! field types - INTEGER(HSIZE_T), PARAMETER :: chunk_size = 5 ! chunk size - INTEGER, PARAMETER :: compress = 0 ! compress - INTEGER :: errcode = 0 ! Error flag - INTEGER :: i ! general purpose integer - INTEGER(SIZE_T) :: type_size ! Size of the datatype - INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype - INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype - INTEGER(SIZE_T) :: type_sized ! Size of the double precision datatype - INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype - INTEGER(HID_T) :: type_id_c ! Memory datatype identifier (for character field) - INTEGER(SIZE_T) :: offset ! Member's offset - INTEGER(HSIZE_T) :: start = 0 ! start record - INTEGER, DIMENSION(nrecords) :: bufi ! Data buffer - INTEGER, DIMENSION(nrecords) :: bufir ! Data buffer - REAL, DIMENSION(nrecords) :: bufr ! Data buffer - REAL, DIMENSION(nrecords) :: bufrr ! Data buffer - DOUBLE PRECISION, DIMENSION(nrecords) :: bufd ! Data buffer - DOUBLE PRECISION, DIMENSION(nrecords) :: bufdr ! Data buffer - CHARACTER(LEN=2), DIMENSION(nrecords), PARAMETER :: bufs = (/"AB","CD","EF","GH","IJ"/) ! Data buffer - CHARACTER(LEN=2), DIMENSION(nrecords) :: bufsr ! Data buffer - INTEGER(HSIZE_T) :: nfieldsr ! nfields - INTEGER(HSIZE_T) :: nrecordsr ! nrecords - CHARACTER(LEN=9), DIMENSION(1:nfields) :: field_namesr ! field names - INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_offsetr ! field offset - INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_sizesr ! field sizes - INTEGER(SIZE_T) :: type_sizeout = 0 ! size of the datatype - INTEGER :: maxlen = 0 ! max chararter length of a field name - - - ! - ! Initialize the data arrays. - ! - DO i = 1, nrecords - bufi(i) = i - bufr(i) = i - bufd(i) = i - END DO - - ! - ! Initialize FORTRAN predefined datatypes. - ! - CALL h5open_f(errcode) - - ! - ! Create a new file using default properties. - ! - CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) - - - !------------------------------------------------------------------------- - ! make table - ! initialize the table parameters - !------------------------------------------------------------------------- - - field_names(1) = "field1" - field_names(2) = "field2a" - field_names(3) = "field3ab" - field_names(4) = "field4abc" - - ! - ! calculate total size by calculating sizes of each member - ! - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, type_id_c, errcode) - type_size = 2 - CALL h5tset_size_f(type_id_c, type_size, errcode) - CALL h5tget_size_f(type_id_c, type_sizec, errcode) - CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, errcode) - CALL h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, errcode) - CALL h5tget_size_f(H5T_NATIVE_REAL, type_sizer, errcode) - type_size = type_sizec + type_sizei + type_sized + type_sizer - - ! - ! type ID's - ! - field_types(1) = type_id_c - field_types(2) = H5T_NATIVE_INTEGER - field_types(3) = H5T_NATIVE_DOUBLE - field_types(4) = H5T_NATIVE_REAL - - ! - ! offsets - ! - offset = 0 - field_offset(1) = offset - offset = offset + type_sizec ! Offset of the second memeber is 2 - field_offset(2) = offset - offset = offset + type_sizei ! Offset of the second memeber is 6 - field_offset(3) = offset - offset = offset + type_sized ! Offset of the second memeber is 14 - field_offset(4) = offset - - !------------------------------------------------------------------------- - ! make table - !------------------------------------------------------------------------- - - CALL test_begin(' Make table ') - - CALL h5tbmake_table_f(dsetname1,& - file_id,& - dsetname1,& - nfields,& - nrecords,& - type_size,& - field_names,& - field_offset,& - field_types,& - chunk_size,& - compress,& - errcode ) - - CALL passed() - - - !------------------------------------------------------------------------- - ! write field - !------------------------------------------------------------------------- - - CALL test_begin(' Read/Write field by name ') - - CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& - bufs,errcode) - - CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& - bufi,errcode) - - CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& - bufd,errcode) - - CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& - bufr,errcode) - - !------------------------------------------------------------------------- - ! read field - !------------------------------------------------------------------------- - - ! Read an invalid field, should fail - CALL h5tbread_field_name_f(file_id,dsetname1,'DoesNotExist',start,nrecords,type_sizec,& - bufsr,errcode) - - IF(errcode.GE.0)THEN - PRINT *, 'error in h5tbread_field_name_f' - CALL h5fclose_f(file_id, errcode) - CALL h5close_f(errcode) - STOP - ENDIF - - ! Read a valid field, should pass - CALL h5tbread_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& - bufsr,errcode) - IF(errcode.LT.0)THEN - PRINT *, 'error in h5tbread_field_name_f' - CALL h5fclose_f(file_id, errcode) - CALL h5close_f(errcode) - STOP - ENDIF - - ! - ! compare read and write buffers. - ! - DO i = 1, nrecords - IF ( bufsr(i) .NE. bufs(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufsr(i), ' and ', bufs(i) - STOP - ENDIF - END DO - - CALL h5tbread_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& - bufir,errcode) - - - ! - ! compare read and write buffers. - ! - DO i = 1, nrecords - IF ( bufir(i) .NE. bufi(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufir(i), ' and ', bufi(i) - STOP - ENDIF - END DO - - CALL h5tbread_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& - bufdr,errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, nrecords - IF ( bufdr(i) .NE. bufd(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufdr(i), ' and ', bufd(i) - STOP - ENDIF - END DO - - CALL h5tbread_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& - bufrr,errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, nrecords - IF ( bufrr(i) .NE. bufr(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufrr(i), ' and ', bufr(i) - STOP - ENDIF - END DO - - - CALL passed() - - !------------------------------------------------------------------------- - ! write field - !------------------------------------------------------------------------- - - CALL test_begin(' Read/Write field by index ') - - CALL h5tbwrite_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& - bufs,errcode) - - CALL h5tbwrite_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& - bufi,errcode) - - CALL h5tbwrite_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& - bufd,errcode) - - CALL h5tbwrite_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& - bufr,errcode) - - - - !------------------------------------------------------------------------- - ! read field - !------------------------------------------------------------------------- - - CALL h5tbread_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& - bufsr,errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, nrecords - IF ( bufsr(i) .NE. bufs(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufsr(i), ' and ', bufs(i) - STOP - ENDIF - END DO - - CALL h5tbread_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& - bufir,errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, nrecords - IF ( bufir(i) .NE. bufi(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufir(i), ' and ', bufi(i) - STOP - ENDIF - END DO - - CALL h5tbread_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& - bufdr,errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, nrecords - IF ( bufdr(i) .NE. bufd(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufdr(i), ' and ', bufd(i) - STOP - ENDIF - END DO - - CALL h5tbread_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& - bufrr,errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, nrecords - IF ( bufrr(i) .NE. bufr(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufrr(i), ' and ', bufr(i) - STOP - ENDIF - END DO - - - CALL passed() - - - !------------------------------------------------------------------------- - ! Insert field - ! we insert a field callsed "field5" with the same type and buffer as field 4 (Real) - !------------------------------------------------------------------------- - - CALL test_begin(' Insert field ') - - CALL h5tbinsert_field_f(file_id,dsetname1,"field5",field_types(4),4,bufr,errcode) - CALL h5tbread_field_index_f(file_id,dsetname1,5,start,nrecords,type_sizer,& - bufrr,errcode) - ! - ! compare read and write buffers. - ! - DO i = 1, nrecords - IF ( bufrr(i) .NE. bufr(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufrr(i), ' and ', bufr(i) - STOP - ENDIF - END DO - - - CALL passed() - - !------------------------------------------------------------------------- - ! Delete field - !------------------------------------------------------------------------- - - CALL test_begin(' Delete field ') - - CALL h5tbdelete_field_f(file_id,dsetname1,"field4abc",errcode) - - CALL passed() - - - !------------------------------------------------------------------------- - ! Gets the number of records and fields - !------------------------------------------------------------------------- - - CALL test_begin(' Get table info ') - - CALL h5tbget_table_info_f(file_id,dsetname1,nfieldsr,nrecordsr,errcode ) - - IF ( nfieldsr .NE. nfields .AND. nrecordsr .NE. nrecords ) THEN - PRINT *, 'h5tbget_table_info_f return error' - STOP - ENDIF - - CALL passed() - - !------------------------------------------------------------------------- - ! Get information about fields - !------------------------------------------------------------------------- - - CALL test_begin(' Get fields info ') - - CALL h5tbget_field_info_f(file_id, dsetname1, nfields, field_namesr, field_sizesr,& - field_offsetr, type_sizeout, errcode, maxlen ) - - IF ( errcode.NE.0 ) THEN - WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: RETURN ERROR")') - STOP - ENDIF - - ! "field4abc" was deleted and "field5" was added. - field_names(4) = "field5" - - IF ( maxlen .NE. 8 ) THEN - WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: INCORRECT MAXIMUM CHARACTER LENGTH OF THE FIELD NAMES")') - WRITE(*,'(5X,"RETURNED VALUE = ", I0, ", CORRECT VALUE = ", I0)') maxlen, 8 - STOP - ENDIF - - DO i = 1, nfields - IF ( field_namesr(i) .NE. field_names(i)) THEN - WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: READ/WRITE FIELD NAMES DIFFER")') - WRITE(*,'(27X,A," AND ",A)') TRIM(field_namesr(i)), TRIM(field_names(i)) - STOP - ENDIF - END DO - - CALL passed() - - - !------------------------------------------------------------------------- - ! end - !------------------------------------------------------------------------- - - ! - ! Close the file. - ! - CALL h5fclose_f(file_id, errcode) - - ! - ! Close FORTRAN predefined datatypes. - ! - CALL h5close_f(errcode) - - ! - ! end function. - ! -END SUBROUTINE test_table1 - - -!------------------------------------------------------------------------- -! test_begin -!------------------------------------------------------------------------- - -SUBROUTINE test_begin(string) - CHARACTER(LEN=*), INTENT(IN) :: string - WRITE(*, fmt = '(14a)', advance = 'no') string - WRITE(*, fmt = '(40x,a)', advance = 'no') ' ' -END SUBROUTINE test_begin - -!------------------------------------------------------------------------- -! passed -!------------------------------------------------------------------------- - -SUBROUTINE passed() - WRITE(*, fmt = '(6a)') 'PASSED' -END SUBROUTINE passed - - diff --git a/hl/src/Makefile.in b/hl/src/Makefile.in index ef49563..2092562 100644 --- a/hl/src/Makefile.in +++ b/hl/src/Makefile.in @@ -515,6 +515,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/test/Makefile.in b/hl/test/Makefile.in index 6d6df30..1bfce03 100644 --- a/hl/test/Makefile.in +++ b/hl/test/Makefile.in @@ -552,6 +552,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/tools/Makefile.in b/hl/tools/Makefile.in index d1f3002..b8babca 100644 --- a/hl/tools/Makefile.in +++ b/hl/tools/Makefile.in @@ -514,6 +514,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/hl/tools/gif2h5/Makefile.in b/hl/tools/gif2h5/Makefile.in index e79cadb..9928c00 100644 --- a/hl/tools/gif2h5/Makefile.in +++ b/hl/tools/gif2h5/Makefile.in @@ -528,6 +528,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/m4/aclocal_fc.m4 b/m4/aclocal_fc.m4 index 8051752..febd73c 100644 --- a/m4/aclocal_fc.m4 +++ b/m4/aclocal_fc.m4 @@ -510,3 +510,37 @@ rm -f pac_fconftest.out AC_MSG_RESULT([$pack_int_sizeof]) AC_LANG_POP([Fortran]) ]) + +AC_DEFUN([PAC_LDBL_DIG],[ +AC_MSG_CHECKING([maximum decimal precision for C]) +rm -f pac_Cconftest.out + AC_LANG_CONFTEST([ + AC_LANG_PROGRAM([ + #include + #include + #if __STDC_VERSION__ >= 199901L + #define C_LDBL_DIG DECIMAL_DIG + #else + #define C_LDBL_DIG LDBL_DIG + #endif + ],[[ + FILE * pFile; + pFile = fopen("pac_Cconftest.out","w"); + fprintf(pFile, "%d\n", C_LDBL_DIG); + ]]) + ]) + AC_RUN_IFELSE([],[ + if test -s pac_Cconftest.out ; then + LDBL_DIG="`cat pac_Cconftest.out`" + AC_DEFINE_UNQUOTED([PAC_C_MAX_REAL_PRECISION], $LDBL_DIG, [Determine the decimal precision of C long double]) + else + AC_MSG_WARN([No output from test program!]) + fi + rm -f pac_Cconftest.out + ],[ + AC_MSG_WARN([C program fails to build or run!]) + ],[]) +AC_MSG_RESULT([$LDBL_DIG]) +]) + + diff --git a/src/H5config.h.in b/src/H5config.h.in index ffbc4c2..3f432d5 100644 --- a/src/H5config.h.in +++ b/src/H5config.h.in @@ -422,6 +422,9 @@ /* Define to the version of this package. */ #undef PACKAGE_VERSION +/* Determine the decimal precision of C long double */ +#undef PAC_C_MAX_REAL_PRECISION + /* Define Fortran Maximum Real Decimal Precision */ #undef PAC_FC_MAX_REAL_PRECISION diff --git a/src/Makefile.in b/src/Makefile.in index 75feb9e..de573f0 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -576,6 +576,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/test/Makefile.in b/test/Makefile.in index e26066a..38986f8 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -920,6 +920,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/testpar/Makefile.in b/testpar/Makefile.in index 83c39d9..1e022e2 100644 --- a/testpar/Makefile.in +++ b/testpar/Makefile.in @@ -543,6 +543,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/Makefile.in b/tools/Makefile.in index 7f4b9d7..eb45a0d 100644 --- a/tools/Makefile.in +++ b/tools/Makefile.in @@ -514,6 +514,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/h5copy/Makefile.in b/tools/h5copy/Makefile.in index 10d1385..b20c389 100644 --- a/tools/h5copy/Makefile.in +++ b/tools/h5copy/Makefile.in @@ -522,6 +522,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/h5diff/Makefile.in b/tools/h5diff/Makefile.in index b0157f7..d071705 100644 --- a/tools/h5diff/Makefile.in +++ b/tools/h5diff/Makefile.in @@ -529,6 +529,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/h5dump/Makefile.in b/tools/h5dump/Makefile.in index b8ea56a..36d32bb 100644 --- a/tools/h5dump/Makefile.in +++ b/tools/h5dump/Makefile.in @@ -528,6 +528,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/h5import/Makefile.in b/tools/h5import/Makefile.in index 18de006..091125e 100644 --- a/tools/h5import/Makefile.in +++ b/tools/h5import/Makefile.in @@ -522,6 +522,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/h5jam/Makefile.in b/tools/h5jam/Makefile.in index 3cd0190..4498f09 100644 --- a/tools/h5jam/Makefile.in +++ b/tools/h5jam/Makefile.in @@ -534,6 +534,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/h5ls/Makefile.in b/tools/h5ls/Makefile.in index 174ad99..adb3b2f 100644 --- a/tools/h5ls/Makefile.in +++ b/tools/h5ls/Makefile.in @@ -514,6 +514,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/h5repack/Makefile.in b/tools/h5repack/Makefile.in index 4c188bd..ed58bd6 100644 --- a/tools/h5repack/Makefile.in +++ b/tools/h5repack/Makefile.in @@ -546,6 +546,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/h5stat/Makefile.in b/tools/h5stat/Makefile.in index 084b75b..ff4e99a 100644 --- a/tools/h5stat/Makefile.in +++ b/tools/h5stat/Makefile.in @@ -524,6 +524,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/lib/Makefile.in b/tools/lib/Makefile.in index d747707..9d62e57 100644 --- a/tools/lib/Makefile.in +++ b/tools/lib/Makefile.in @@ -511,6 +511,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/misc/Makefile.in b/tools/misc/Makefile.in index 818dd6b..8767a53 100644 --- a/tools/misc/Makefile.in +++ b/tools/misc/Makefile.in @@ -549,6 +549,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ diff --git a/tools/perform/Makefile.in b/tools/perform/Makefile.in index d7f240d..0539283 100644 --- a/tools/perform/Makefile.in +++ b/tools/perform/Makefile.in @@ -553,6 +553,7 @@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ +PAC_C_MAX_REAL_PRECISION = @PAC_C_MAX_REAL_PRECISION@ PAC_FC_ALL_INTEGER_KINDS = @PAC_FC_ALL_INTEGER_KINDS@ PAC_FC_ALL_INTEGER_KINDS_SIZEOF = @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ PAC_FC_ALL_REAL_KINDS = @PAC_FC_ALL_REAL_KINDS@ -- cgit v0.12