summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2014-04-12 03:26:21 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2014-04-12 03:26:21 (GMT)
commit19c485a128e4d860a537a14c91e38bc87dc6db25 (patch)
tree7333e607cf9093aa8020f5a2fa9af159379d845a /fortran
parent33956e594a10ecab24867ab0c3347452f22b4e11 (diff)
downloadhdf5-19c485a128e4d860a537a14c91e38bc87dc6db25.zip
hdf5-19c485a128e4d860a537a14c91e38bc87dc6db25.tar.gz
hdf5-19c485a128e4d860a537a14c91e38bc87dc6db25.tar.bz2
[svn-r25027] Merged changes from the trunk to the branch,
svn merge -r24929:25009 https://svn.hdfgroup.uiuc.edu/hdf5/trunk/fortran tested: jam (gnu)
Diffstat (limited to 'fortran')
-rw-r--r--fortran/examples/h5_extend.f902
-rw-r--r--fortran/examples/hyperslab.f9011
-rw-r--r--fortran/examples/rwdset_fortran2003.f907
-rw-r--r--fortran/examples/selectele.f909
-rw-r--r--fortran/src/H5Fff_F03.f9011
-rw-r--r--fortran/src/H5Pf.c70
-rw-r--r--fortran/src/H5Pff_F03.f90106
-rw-r--r--fortran/src/H5f90proto.h4
-rw-r--r--fortran/src/README_DEVELOPEMENT26
-rw-r--r--fortran/src/hdf5_fortrandll.def.in2
-rw-r--r--fortran/test/CMakeLists.txt4
-rw-r--r--fortran/test/Makefile.am29
-rw-r--r--fortran/test/Makefile.in137
-rw-r--r--fortran/test/fflush1.f903
-rw-r--r--fortran/test/fflush2.f902
-rw-r--r--fortran/test/fortranlib_test.f9019
-rw-r--r--fortran/test/fortranlib_test_1_8.f90445
-rw-r--r--fortran/test/fortranlib_test_F03.f908
-rw-r--r--fortran/test/tH5A.f9027
-rw-r--r--fortran/test/tH5A_1_8.f9061
-rw-r--r--fortran/test/tH5D.f9017
-rw-r--r--fortran/test/tH5E.f9010
-rw-r--r--fortran/test/tH5E_F03.f9030
-rw-r--r--fortran/test/tH5F.f9027
-rw-r--r--fortran/test/tH5F_F03.f909
-rw-r--r--fortran/test/tH5G.f909
-rw-r--r--fortran/test/tH5G_1_8.f9073
-rw-r--r--fortran/test/tH5I.f908
-rw-r--r--fortran/test/tH5L_F03.f9028
-rw-r--r--fortran/test/tH5MISC_1_8.f90474
-rw-r--r--fortran/test/tH5O.f9022
-rw-r--r--fortran/test/tH5O_F03.f9012
-rw-r--r--fortran/test/tH5P.f9031
-rw-r--r--fortran/test/tH5P_F03.f90128
-rw-r--r--fortran/test/tH5R.f9012
-rw-r--r--fortran/test/tH5S.f907
-rw-r--r--fortran/test/tH5Sselect.f9043
-rw-r--r--fortran/test/tH5T.f9061
-rw-r--r--fortran/test/tH5T_F03.f90212
-rw-r--r--fortran/test/tH5VL.f9042
-rw-r--r--fortran/test/tH5Z.f909
-rw-r--r--fortran/test/tHDF5.f9045
-rw-r--r--fortran/test/tHDF5_1_8.f9038
-rw-r--r--fortran/test/tHDF5_F03.f9039
-rw-r--r--fortran/test/tf.f90348
-rw-r--r--fortran/testpar/Makefile.am3
-rw-r--r--fortran/testpar/Makefile.in3
-rw-r--r--fortran/testpar/hyper.f903
-rw-r--r--fortran/testpar/mdset.f903
49 files changed, 1633 insertions, 1096 deletions
diff --git a/fortran/examples/h5_extend.f90 b/fortran/examples/h5_extend.f90
index 1316281..315d84f 100644
--- a/fortran/examples/h5_extend.f90
+++ b/fortran/examples/h5_extend.f90
@@ -73,7 +73,7 @@ PROGRAM H5_EXTEND
!
!general purpose integer
!
- INTEGER :: i, j
+ INTEGER(HSIZE_T) :: i, j
!
!flag to check operation success
diff --git a/fortran/examples/hyperslab.f90 b/fortran/examples/hyperslab.f90
index ca27f35..7823ff6 100644
--- a/fortran/examples/hyperslab.f90
+++ b/fortran/examples/hyperslab.f90
@@ -33,8 +33,6 @@
INTEGER(HSIZE_T), DIMENSION(3) :: dimsm = (/7,7,3/) ! Dataset dimensions
! in memory
- INTEGER(HSIZE_T), DIMENSION(2) :: dims_out ! Buffer to read in dataset
- ! dimesions
INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/5,6/) ! Dataset dimensions.
INTEGER(HSIZE_T), DIMENSION(2) :: count = (/3,4/)
@@ -49,16 +47,15 @@
INTEGER, DIMENSION(7,7,3) :: data_out ! Output buffer
INTEGER :: dsetrank = 2 ! Dataset rank ( in file )
INTEGER :: memrank = 3 ! Dataset rank ( in memory )
- INTEGER :: rank
INTEGER :: i, j, k
- INTEGER :: error, error_n ! Error flags
+ INTEGER :: error ! Error flag
INTEGER(HSIZE_T), DIMENSION(3) :: data_dims
- !
- ! Write data to the HDF5 file.
- !
+ !
+ ! Write data to the HDF5 file.
+ !
!
! Data initialization.
diff --git a/fortran/examples/rwdset_fortran2003.f90 b/fortran/examples/rwdset_fortran2003.f90
index 74bda85..d65db9e 100644
--- a/fortran/examples/rwdset_fortran2003.f90
+++ b/fortran/examples/rwdset_fortran2003.f90
@@ -53,13 +53,11 @@ PROGRAM RWDSET_FORTRAN2003
INTEGER(HID_T) :: dset_idr8 ! Dataset identifier
INTEGER :: error ! Error flag
- INTEGER :: i, j
+ INTEGER :: i
! Data buffers:
- INTEGER, DIMENSION(1:4) :: dset_data
-
- INTEGER(int_kind_1), DIMENSION(1:4), TARGET :: dset_data_i1, data_out_i1
+ INTEGER(int_kind_1), DIMENSION(1:4), TARGET :: dset_data_i1
INTEGER(int_kind_4), DIMENSION(1:4), TARGET :: dset_data_i4, data_out_i4
INTEGER(int_kind_8), DIMENSION(1:4), TARGET :: dset_data_i8, data_out_i8
INTEGER(int_kind_16), DIMENSION(1:4), TARGET :: dset_data_i16, data_out_i16
@@ -73,7 +71,6 @@ PROGRAM RWDSET_FORTRAN2003
INTEGER(HID_T) :: dspace_id ! Dataspace identifier
TYPE(C_PTR) :: f_ptr
- INTEGER(hid_t) :: datatype !/* Common datatype ID */
!
! Initialize FORTRAN interface.
diff --git a/fortran/examples/selectele.f90 b/fortran/examples/selectele.f90
index 3ab7ebc..dcd2379 100644
--- a/fortran/examples/selectele.f90
+++ b/fortran/examples/selectele.f90
@@ -64,14 +64,13 @@
INTEGER :: i, j
INTEGER :: error ! Error flag
- LOGICAL :: status
INTEGER(HSIZE_T), DIMENSION(2) :: data_dims
- !
- ! Create two files containing identical datasets. Write 0's to one
- ! and 1's to the other.
- !
+ !
+ ! Create two files containing identical datasets. Write 0's to one
+ ! and 1's to the other.
+ !
!
! Data initialization.
diff --git a/fortran/src/H5Fff_F03.f90 b/fortran/src/H5Fff_F03.f90
index 83d46be..d819c34 100644
--- a/fortran/src/H5Fff_F03.f90
+++ b/fortran/src/H5Fff_F03.f90
@@ -30,13 +30,11 @@
!
!*****
-
MODULE H5F_PROVISIONAL
USE H5GLOBAL
USE, INTRINSIC :: ISO_C_BINDING
-
CONTAINS
!****s* H5F (F03)/h5fget_file_image_f_F03
!
@@ -82,14 +80,13 @@ CONTAINS
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5FGET_FILE_IMAGE_C'::h5fget_file_image_c
!DEC$ENDIF
- INTEGER(HID_T) , INTENT(IN) :: file_id
- TYPE(C_PTR) , VALUE :: buf_ptr
- INTEGER(SIZE_T) , INTENT(IN) :: buf_len
- INTEGER(SIZE_T), INTENT(IN) :: buf_size
+ INTEGER(HID_T) , INTENT(IN) :: file_id
+ TYPE(C_PTR) , VALUE :: buf_ptr
+ INTEGER(SIZE_T), INTENT(IN) :: buf_len
+ INTEGER(SIZE_T), INTENT(IN) :: buf_size
END FUNCTION h5fget_file_image_c
END INTERFACE
-
IF(PRESENT(buf_size))THEN
buf_ptr = C_NULL_PTR
ENDIF
diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c
index 7a3f899..98e5ff6 100644
--- a/fortran/src/H5Pf.c
+++ b/fortran/src/H5Pf.c
@@ -5546,3 +5546,73 @@ nh5pget_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, size_t_f *rdcc_nb
ret_value = 0;
return ret_value;
}
+
+/*----------------------------------------------------------------------------
+ * Name: h5pset_file_image_c
+ * Purpose: Calls H5Pset_file_image
+ *
+ * Inputs:
+ * fapl_id - File access property list identifier
+ * buf_ptr - Pointer to the initial file image,
+ * or NULL if no initial file image is desired
+ * buf_len - Size of the supplied buffer, or 0 (zero) if no initial image is desired
+ *
+ * Returns: 0 on success, -1 on failure
+ * Programmer: M. Scot Breitenfeld
+ * February 19, 2012
+ *---------------------------------------------------------------------------*/
+
+int_f
+nh5pset_file_image_c(hid_t_f *fapl_id, void *buf_ptr, size_t_f *buf_len)
+{
+ int ret_value = -1;
+ /*
+ * Call H5Pset_file_image function.
+ */
+ if( (H5Pset_file_image((hid_t)*fapl_id, buf_ptr, (size_t)*buf_len)) <0 )
+ return ret_value; /* error occurred */
+
+ ret_value = 0;
+ return ret_value;
+}
+
+/*----------------------------------------------------------------------------
+ * Name: h5pget_file_image_c
+ * Purpose: Calls H5Pget_file_image
+ *
+ * Inputs:
+ * fapl_id - File access property list identifier
+ * Outputs:
+ * buf_ptr - Pointer to the initial file image,
+ * or NULL if no initial file image is desired
+ * buf_len - Size of the supplied buffer, or 0 (zero) if no initial image is desired
+ *
+ * Returns: 0 on success, -1 on failure
+ * Programmer: M. Scot Breitenfeld
+ * February 19, 2012
+ *---------------------------------------------------------------------------*/
+
+int_f
+nh5pget_file_image_c(hid_t_f *fapl_id, void **buf_ptr, size_t_f *buf_len_ptr)
+{
+ int ret_value = -1;
+ size_t c_buf_len_ptr;
+ void *c_buf_ptr = NULL;
+
+ c_buf_len_ptr = (size_t)*buf_len_ptr;
+
+ /*
+ * Call H5Pget_file_image function.
+ */
+ if( (H5Pget_file_image((hid_t)*fapl_id, (void **)&c_buf_ptr, &c_buf_len_ptr)) <0 )
+ return ret_value; /* error occurred */
+
+ HDmemcpy((void *)*buf_ptr, (void *)c_buf_ptr, c_buf_len_ptr);
+
+ *buf_len_ptr=(size_t_f)c_buf_len_ptr;
+
+ ret_value = 0;
+ if(c_buf_ptr) HDfree(c_buf_ptr);
+
+ return ret_value;
+}
diff --git a/fortran/src/H5Pff_F03.f90 b/fortran/src/H5Pff_F03.f90
index 7fb6ff9..806c308 100644
--- a/fortran/src/H5Pff_F03.f90
+++ b/fortran/src/H5Pff_F03.f90
@@ -1181,5 +1181,111 @@ CONTAINS
END SUBROUTINE h5pcreate_class_f
+!
+!****s* H5P (F03)/h5pset_file_image_f_F03
+!
+! NAME
+! h5pset_file_image_f
+!
+! PURPOSE
+! Sets an initial file image in a memory buffer.
+!
+! Inputs:
+! fapl_id - File access property list identifier
+! buf_ptr - Pointer to the initial file image,
+! or C_NULL_PTR if no initial file image is desired
+! buf_len - Size of the supplied buffer, or 0 (zero) if no initial image is desired
+!
+! Outputs:
+! hdferr - Returns 0 if successful and -1 if fails
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! February 19, 2012
+!
+! Fortran2003 Interface:
+ SUBROUTINE h5pset_file_image_f(fapl_id, buf_ptr, buf_len, hdferr)
+ USE iso_c_binding
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: fapl_id
+ TYPE(C_PTR) , INTENT(IN) :: buf_ptr
+ INTEGER(SIZE_T), INTENT(IN) :: buf_len
+ INTEGER , INTENT(OUT) :: hdferr
+!*****
+ INTERFACE
+ INTEGER FUNCTION h5pset_file_image_c(fapl_id, buf_ptr, buf_len)
+ USE iso_c_binding
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDCLOSEF90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5PSET_FILE_IMAGE_C'::h5pset_file_image_c
+ !DEC$ENDIF
+ INTEGER(HID_T), INTENT(IN) :: fapl_id
+ TYPE(C_PTR), VALUE :: buf_ptr
+ INTEGER(SIZE_T), INTENT(IN) :: buf_len
+ END FUNCTION h5pset_file_image_c
+ END INTERFACE
+
+ hdferr = h5pset_file_image_c(fapl_id, buf_ptr, buf_len)
+
+ END SUBROUTINE h5pset_file_image_f
+!
+!****s* H5P (F03)/h5pget_file_image_f_F03
+!
+! NAME
+! h5pget_file_image_f
+!
+! PURPOSE
+! Retrieves a copy of the file image designated as the initial content and structure of a file.
+!
+! Inputs:
+! fapl_id - File access property list identifier.
+!
+! Outputs:
+! buf_ptr - Will hold either a C_NULL_PTR or a scalar of type
+! c_loc. If buf_ptr is not C_NULL_PTR, on successful
+! return, buf_ptr shall contain a C pointer to a copy
+! of the initial image provided in the last call to
+! H5Pset_file_image_f for the supplied fapl_id, or
+! buf_ptr shall contain a C_NULL_PTR if there is no
+! initial image set.
+!
+! buf_len_ptr - Contains the value of the buffer parameter for
+! the initial image in the supplied fapl_id. The value
+! will be 0 if no initial image is set.
+!
+!
+! hdferr - Returns 0 if successful and -1 if fails
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! February 19, 2012
+!
+! Fortran2003 Interface:
+ SUBROUTINE h5pget_file_image_f(fapl_id, buf_ptr, buf_len_ptr, hdferr)
+ USE iso_c_binding
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: fapl_id
+ TYPE(C_PTR) , INTENT(OUT), DIMENSION(*) :: buf_ptr
+ INTEGER(SIZE_T), INTENT(OUT) :: buf_len_ptr
+ INTEGER , INTENT(OUT) :: hdferr
+
+!*****
+ INTERFACE
+ INTEGER FUNCTION h5pget_file_image_c(fapl_id, buf_ptr, buf_len_ptr)
+ USE iso_c_binding
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDCLOSEF90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5PGET_FILE_IMAGE_C'::h5pget_file_image_c
+ !DEC$ENDIF
+ INTEGER(HID_T), INTENT(IN) :: fapl_id
+ TYPE(C_PTR), DIMENSION(*), INTENT(OUT) :: buf_ptr
+ INTEGER(SIZE_T), INTENT(OUT) :: buf_len_ptr
+ END FUNCTION h5pget_file_image_c
+ END INTERFACE
+
+ hdferr = h5pget_file_image_c(fapl_id, buf_ptr, buf_len_ptr)
+
+ END SUBROUTINE h5pget_file_image_f
+
END MODULE H5P_PROVISIONAL
diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h
index ae848bf..a0a4f64 100644
--- a/fortran/src/H5f90proto.h
+++ b/fortran/src/H5f90proto.h
@@ -863,11 +863,13 @@ H5_FCDLL int_f nh5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *
#define nh5pget_preserve_c H5_FC_FUNC_(h5pget_preserve_c, H5PGET_PRESERVE_C)
#define nh5pset_chunk_c H5_FC_FUNC_(h5pset_chunk_c, H5PSET_CHUNK_C)
#define nh5pget_chunk_c H5_FC_FUNC_(h5pget_chunk_c, H5PGET_CHUNK_C)
+#define nh5pset_file_image_c H5_FC_FUNC_(h5pset_file_image_c,H5PSET_FILE_IMAGE_C)
#define nh5pset_fill_valuec_c H5_FC_FUNC_(h5pset_fill_valuec_c, H5PSET_FILL_VALUEC_C)
#define nh5pset_fill_value_c H5_FC_FUNC_(h5pset_fill_value_c, H5PSET_FILL_VALUE_C)
#define nh5pset_fill_value_integer_c H5_FC_FUNC_(h5pset_fill_value_integer_c, H5PSET_FILL_VALUE_INTEGER_C)
#define nh5pset_fill_value_real_c H5_FC_FUNC_(h5pset_fill_value_real_c, H5PSET_FILL_VALUE_REAL_C)
#define nh5pset_fill_value_double_c H5_FC_FUNC_(h5pset_fill_value_double_c, H5PSET_FILL_VALUE_DOUBLE_C)
+#define nh5pget_file_image_c H5_FC_FUNC_(h5pget_file_image_c,H5PGET_FILE_IMAGE_C)
#define nh5pget_fill_valuec_c H5_FC_FUNC_(h5pget_fill_valuec_c, H5PGET_FILL_VALUEC_C)
#define nh5pget_fill_value_c H5_FC_FUNC_(h5pget_fill_value_c, H5PGET_FILL_VALUE_C)
#define nh5pget_fill_value_integer_c H5_FC_FUNC_(h5pget_fill_value_integer_c, H5PGET_FILL_VALUE_INTEGER_C)
@@ -1017,11 +1019,13 @@ H5_FCDLL int_f nh5pget_class_c ( hid_t_f *prp_id , int_f *classtype);
H5_FCDLL int_f nh5pset_deflate_c ( hid_t_f *prp_id , int_f *level);
H5_FCDLL int_f nh5pset_chunk_c ( hid_t_f *prp_id, int_f *rank, hsize_t_f *dims );
H5_FCDLL int_f nh5pget_chunk_c ( hid_t_f *prp_id, int_f *max_rank, hsize_t_f *dims );
+H5_FCDLL int_f nh5pset_file_image_c (hid_t_f *fapl_id, void *buf_ptr, size_t_f *buf_len);
H5_FCDLL int_f nh5pset_fill_valuec_c (hid_t_f *prp_id, hid_t_f *type_id, _fcd fillvalue);
H5_FCDLL int_f nh5pset_fill_value_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue);
H5_FCDLL int_f nh5pset_fill_value_integer_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue);
H5_FCDLL int_f nh5pset_fill_value_real_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue);
H5_FCDLL int_f nh5pset_fill_value_double_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue);
+H5_FCDLL int_f nh5pget_file_image_c (hid_t_f *fapl_id, void **buf_ptr, size_t_f *buf_len);
H5_FCDLL int_f nh5pget_fill_valuec_c (hid_t_f *prp_id, hid_t_f *type_id, _fcd fillvalue);
H5_FCDLL int_f nh5pget_fill_value_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue);
H5_FCDLL int_f nh5pget_fill_value_integer_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue);
diff --git a/fortran/src/README_DEVELOPEMENT b/fortran/src/README_DEVELOPEMENT
index dc65f47..43982e1 100644
--- a/fortran/src/README_DEVELOPEMENT
+++ b/fortran/src/README_DEVELOPEMENT
@@ -1,13 +1,15 @@
-Procedure to add a new function:
+Procedure to add a new function
+---------------------------------
(1) Edit the fortran/src/H5*ff.f90 file
-(2) Edit the fortran/sr/H5*f.c file
+(2) Edit the fortran/src/H5*f.c file
(3) Edit the fortran/src/H5f90proto.h file
+(4) Add the new function to fortran/src/hdf5_fortrandll.def.in
+Procedure for passing C variables to Fortran
+---------------------------------------------
-
-Procedure:
-(1) Find the struct name you are interested in:
+(1) Find the C struct name you are interested in:
(a) src/H5public.h if it is a generic type, i.e. H5_*
or
(b) src/H5*public.h if is a specific type, i.e. H5*_
@@ -17,7 +19,7 @@ Procedure:
(b) edit fortran/src/H5f90proto.h and edit nh5init_flags_c interface call
(3) Edit the function call in fortran/src/H5_ff.f90
- (a) edit the call FUNCTION h5init_flags_c
+ (a) edit the call: FUNCTION h5init_flags_c
(b) edit h5init_flags_c call in h5open_f to match the number of arguments passing
(4) add the size of the array and array to fortran/src/H5f90global.f90
@@ -25,12 +27,12 @@ Procedure:
NOTE: To just add a default C value argument, do steps (2a) and (4)
-Adding a new file to the repository
--------------------------------------
-Add the name of the file to:
- (1) Makefile.am located in the same directory as the newfile
- (2) MANIFEST located in the top level directory
+Procedure for adding a new file to the repository
+--------------------------------------------------
+Add the name of the file to the:
+ (1) Makefile.am located in the same directory as the newfile
+ (2) CMakeLists.txt located in the same directory as the newfile
+ (3) MANIFEST located in the top level directory
-If you add a new file, be sure to add it to the MANIFEST located in the top directory
diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in
index c549d34..41e93e4 100644
--- a/fortran/src/hdf5_fortrandll.def.in
+++ b/fortran/src/hdf5_fortrandll.def.in
@@ -454,6 +454,8 @@ H5P_mp_H5PGET_CHUNK_CACHE_F
@H5_NOF03EXP@H5P_PROVISIONAL_mp_H5PGET_PTR
@H5_NOF03EXP@H5P_PROVISIONAL_mp_H5PREGISTER_PTR
@H5_NOF03EXP@H5P_PROVISIONAL_mp_H5PINSERT_PTR
+@H5_NOF03EXP@H5P_PROVISIONAL_mp_H5PGET_FILE_IMAGE_F
+@H5_NOF03EXP@H5P_PROVISIONAL_mp_H5PSET_FILE_IMAGE_F
; H5R
H5R_PROVISIONAL_mp_H5RCREATE_OBJECT_F
H5R_PROVISIONAL_mp_H5RCREATE_REGION_F
diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt
index dac8243..17c55a5 100644
--- a/fortran/test/CMakeLists.txt
+++ b/fortran/test/CMakeLists.txt
@@ -65,6 +65,7 @@ add_executable (testhdf5_fortran
tH5T.f90
tH5VL.f90
tH5Z.f90
+ tHDF5.f90
)
TARGET_NAMING (testhdf5_fortran ${LIB_TYPE})
TARGET_FORTRAN_PROPERTIES (testhdf5_fortran " " " ")
@@ -86,6 +87,8 @@ add_executable (testhdf5_fortran_1_8
tH5O.f90
tH5A_1_8.f90
tH5G_1_8.f90
+ tH5MISC_1_8.f90
+ tHDF5_1_8.f90
)
TARGET_NAMING (testhdf5_fortran_1_8 ${LIB_TYPE})
TARGET_FORTRAN_PROPERTIES (testhdf5_fortran_1_8 " " " ")
@@ -111,6 +114,7 @@ if (HDF5_ENABLE_F2003)
tH5O_F03.f90
tH5P_F03.f90
tH5T_F03.f90
+ tHDF5_F03.f90
)
TARGET_NAMING (fortranlib_test_F03 ${LIB_TYPE})
TARGET_FORTRAN_PROPERTIES (fortranlib_test_F03 " " " ")
diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am
index ea58b2d..9c6b906 100644
--- a/fortran/test/Makefile.am
+++ b/fortran/test/Makefile.am
@@ -17,7 +17,8 @@
#
# HDF5-Fortran test/Makefile(.in)
#
-
+# Autoconf cannot figure out dependencies between modules; disable parallel make
+.NOTPARALLEL:
include $(top_srcdir)/config/commence.am
# Include files
@@ -59,16 +60,15 @@ libh5test_fortran_la_SOURCES= tf.f90 t.c
fortranlib_test_FCFLAGS=$(AM_FCFLAGS)
fortranlib_test_CFLAGS=$(AM_CFLAGS)
-fortranlib_test_SOURCES = fortranlib_test.f90 \
- tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 \
- tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90
+fortranlib_test_SOURCES = tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 \
+ tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 tHDF5.f90 fortranlib_test.f90
-fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \
- tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90
+fortranlib_test_1_8_SOURCES = tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 tH5MISC_1_8.f90 tHDF5_1_8.f90\
+ fortranlib_test_1_8.f90
if FORTRAN_2003_CONDITIONAL_F
- fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \
- tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+ fortranlib_test_F03_SOURCES = tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 \
+ tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 tHDF5_F03.f90 fortranlib_test_F03.f90
endif
@@ -79,9 +79,20 @@ fflush2_SOURCES=fflush2.f90
LDADD=libh5test_fortran.la $(LIBH5TEST) $(LIBH5F) $(LIBHDF5)
# Temporary files
-CHECK_CLEANFILES+=*.h5
+CHECK_CLEANFILES+=*.h5 *.raw
MOSTLYCLEANFILES=*.tmp
+# Fortran module files can have different extensions and different names
+# (e.g., different capitalizations) on different platforms. Write rules
+# for them explicitly rather than trying to teach automake about them.
+# They should be installed as headers and removed during clean.
+maintainer-clean-local: clean-local
+distclean-local: clean-local
+clean-local:
+ @if test -n "$(F9XMODEXT)" && test "X$(F9XMODEXT)" != "Xo"; then \
+ $(RM) *.$(F9XMODEXT); \
+ fi
+
# Mark this directory as part of the Fortran API (this affects output
# from tests in conclude.am)
FORTRAN_API=yes
diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in
index e827662..9a0dca3 100644
--- a/fortran/test/Makefile.in
+++ b/fortran/test/Makefile.in
@@ -14,23 +14,6 @@
@SET_MAKE@
-#
-# Copyright by The HDF Group.
-# Copyright by the Board of Trustees of the University of Illinois.
-# All rights reserved.
-#
-# This file is part of HDF5. The full HDF5 copyright notice, including
-# terms governing use, modification, and redistribution, is contained in
-# the files COPYING and Copyright.html. COPYING can be found at the root
-# of the source code distribution tree; Copyright.html can be found at the
-# root level of an installed copy of the electronic HDF5 document set and
-# is linked from the top-level documents page. It can also be found at
-# http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have
-# access to either file, you may request a copy from help@hdfgroup.org.
-#
-# HDF5-Fortran test/Makefile(.in)
-#
-
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
@@ -138,16 +121,15 @@ fflush2_OBJECTS = $(am_fflush2_OBJECTS)
fflush2_LDADD = $(LDADD)
fflush2_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) $(LIBH5F) \
$(LIBHDF5)
-am_fortranlib_test_OBJECTS = \
- fortranlib_test-fortranlib_test.$(OBJEXT) \
- fortranlib_test-tH5F.$(OBJEXT) fortranlib_test-tH5D.$(OBJEXT) \
- fortranlib_test-tH5R.$(OBJEXT) fortranlib_test-tH5S.$(OBJEXT) \
- fortranlib_test-tH5T.$(OBJEXT) fortranlib_test-tH5VL.$(OBJEXT) \
- fortranlib_test-tH5Z.$(OBJEXT) \
+am_fortranlib_test_OBJECTS = fortranlib_test-tH5F.$(OBJEXT) \
+ fortranlib_test-tH5D.$(OBJEXT) fortranlib_test-tH5R.$(OBJEXT) \
+ fortranlib_test-tH5S.$(OBJEXT) fortranlib_test-tH5T.$(OBJEXT) \
+ fortranlib_test-tH5VL.$(OBJEXT) fortranlib_test-tH5Z.$(OBJEXT) \
fortranlib_test-tH5Sselect.$(OBJEXT) \
fortranlib_test-tH5P.$(OBJEXT) fortranlib_test-tH5A.$(OBJEXT) \
fortranlib_test-tH5I.$(OBJEXT) fortranlib_test-tH5G.$(OBJEXT) \
- fortranlib_test-tH5E.$(OBJEXT)
+ fortranlib_test-tH5E.$(OBJEXT) fortranlib_test-tHDF5.$(OBJEXT) \
+ fortranlib_test-fortranlib_test.$(OBJEXT)
fortranlib_test_OBJECTS = $(am_fortranlib_test_OBJECTS)
fortranlib_test_LDADD = $(LDADD)
fortranlib_test_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \
@@ -156,24 +138,26 @@ fortranlib_test_LINK = $(LIBTOOL) $(AM_V_lt) --tag=FC \
$(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=link $(FCLD) \
$(fortranlib_test_FCFLAGS) $(FCFLAGS) $(AM_LDFLAGS) $(LDFLAGS) \
-o $@
-am_fortranlib_test_1_8_OBJECTS = fortranlib_test_1_8.$(OBJEXT) \
- tH5F.$(OBJEXT) tH5O.$(OBJEXT) tH5A_1_8.$(OBJEXT) \
- tH5G_1_8.$(OBJEXT)
+am_fortranlib_test_1_8_OBJECTS = tH5F.$(OBJEXT) tH5O.$(OBJEXT) \
+ tH5A_1_8.$(OBJEXT) tH5G_1_8.$(OBJEXT) tH5MISC_1_8.$(OBJEXT) \
+ tHDF5_1_8.$(OBJEXT) fortranlib_test_1_8.$(OBJEXT)
fortranlib_test_1_8_OBJECTS = $(am_fortranlib_test_1_8_OBJECTS)
fortranlib_test_1_8_LDADD = $(LDADD)
fortranlib_test_1_8_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \
$(LIBH5F) $(LIBHDF5)
-am__fortranlib_test_F03_SOURCES_DIST = fortranlib_test_F03.f90 \
- tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 tH5O_F03.f90 \
- tH5P_F03.f90 tH5T_F03.f90
-@FORTRAN_2003_CONDITIONAL_F_TRUE@am_fortranlib_test_F03_OBJECTS = fortranlib_test_F03.$(OBJEXT) \
+am__fortranlib_test_F03_SOURCES_DIST = tH5F.f90 tH5E_F03.f90 \
+ tH5F_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 \
+ tH5T_F03.f90 tHDF5_F03.f90 fortranlib_test_F03.f90
+@FORTRAN_2003_CONDITIONAL_F_TRUE@am_fortranlib_test_F03_OBJECTS = \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5E_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5L_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5O_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5P_F03.$(OBJEXT) \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5T_F03.$(OBJEXT)
+@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5T_F03.$(OBJEXT) \
+@FORTRAN_2003_CONDITIONAL_F_TRUE@ tHDF5_F03.$(OBJEXT) \
+@FORTRAN_2003_CONDITIONAL_F_TRUE@ fortranlib_test_F03.$(OBJEXT)
fortranlib_test_F03_OBJECTS = $(am_fortranlib_test_F03_OBJECTS)
fortranlib_test_F03_LDADD = $(LDADD)
fortranlib_test_F03_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \
@@ -744,7 +728,7 @@ TRACE = perl $(top_srcdir)/bin/trace
# *.clog are from the MPE option.
# Temporary files
-CHECK_CLEANFILES = *.chkexe *.chklog *.clog *.h5
+CHECK_CLEANFILES = *.chkexe *.chklog *.clog *.h5 *.raw
# The Fortran test library
noinst_LTLIBRARIES = libh5test_fortran.la
@@ -763,15 +747,14 @@ libh5test_fortran_la_SOURCES = tf.f90 t.c
# Automake will complain about this without the following workaround.
fortranlib_test_FCFLAGS = $(AM_FCFLAGS)
fortranlib_test_CFLAGS = $(AM_CFLAGS)
-fortranlib_test_SOURCES = fortranlib_test.f90 \
- tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 \
- tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90
+fortranlib_test_SOURCES = tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 \
+ tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 tHDF5.f90 fortranlib_test.f90
-fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \
- tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90
+fortranlib_test_1_8_SOURCES = tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 tH5MISC_1_8.f90 tHDF5_1_8.f90\
+ fortranlib_test_1_8.f90
-@FORTRAN_2003_CONDITIONAL_F_TRUE@fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+@FORTRAN_2003_CONDITIONAL_F_TRUE@fortranlib_test_F03_SOURCES = tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 \
+@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 tHDF5_F03.f90 fortranlib_test_F03.f90
fflush1_SOURCES = fflush1.f90
fflush2_SOURCES = fflush2.f90
@@ -920,12 +903,6 @@ distclean-compile:
.f90.lo:
$(AM_V_FC)$(LTFCCOMPILE) -c -o $@ $(FCFLAGS_f90) $<
-fortranlib_test-fortranlib_test.o: fortranlib_test.f90
- $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-fortranlib_test.o $(FCFLAGS_f90) `test -f 'fortranlib_test.f90' || echo '$(srcdir)/'`fortranlib_test.f90
-
-fortranlib_test-fortranlib_test.obj: fortranlib_test.f90
- $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-fortranlib_test.obj $(FCFLAGS_f90) `if test -f 'fortranlib_test.f90'; then $(CYGPATH_W) 'fortranlib_test.f90'; else $(CYGPATH_W) '$(srcdir)/fortranlib_test.f90'; fi`
-
fortranlib_test-tH5F.o: tH5F.f90
$(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tH5F.o $(FCFLAGS_f90) `test -f 'tH5F.f90' || echo '$(srcdir)/'`tH5F.f90
@@ -1004,6 +981,18 @@ fortranlib_test-tH5E.o: tH5E.f90
fortranlib_test-tH5E.obj: tH5E.f90
$(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tH5E.obj $(FCFLAGS_f90) `if test -f 'tH5E.f90'; then $(CYGPATH_W) 'tH5E.f90'; else $(CYGPATH_W) '$(srcdir)/tH5E.f90'; fi`
+fortranlib_test-tHDF5.o: tHDF5.f90
+ $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tHDF5.o $(FCFLAGS_f90) `test -f 'tHDF5.f90' || echo '$(srcdir)/'`tHDF5.f90
+
+fortranlib_test-tHDF5.obj: tHDF5.f90
+ $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tHDF5.obj $(FCFLAGS_f90) `if test -f 'tHDF5.f90'; then $(CYGPATH_W) 'tHDF5.f90'; else $(CYGPATH_W) '$(srcdir)/tHDF5.f90'; fi`
+
+fortranlib_test-fortranlib_test.o: fortranlib_test.f90
+ $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-fortranlib_test.o $(FCFLAGS_f90) `test -f 'fortranlib_test.f90' || echo '$(srcdir)/'`fortranlib_test.f90
+
+fortranlib_test-fortranlib_test.obj: fortranlib_test.f90
+ $(AM_V_FC)$(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-fortranlib_test.obj $(FCFLAGS_f90) `if test -f 'fortranlib_test.f90'; then $(CYGPATH_W) 'fortranlib_test.f90'; else $(CYGPATH_W) '$(srcdir)/fortranlib_test.f90'; fi`
+
mostlyclean-libtool:
-rm -f *.lo
@@ -1314,14 +1303,14 @@ maintainer-clean-generic:
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
-clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
+clean-am: clean-checkPROGRAMS clean-generic clean-libtool clean-local \
clean-noinstLTLIBRARIES mostlyclean-am
distclean: distclean-am
-rm -rf ./$(DEPDIR)
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
- distclean-tags
+ distclean-local distclean-tags
dvi: dvi-am
@@ -1366,7 +1355,8 @@ installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -rf ./$(DEPDIR)
-rm -f Makefile
-maintainer-clean-am: distclean-am maintainer-clean-generic
+maintainer-clean-am: distclean-am maintainer-clean-generic \
+ maintainer-clean-local
mostlyclean: mostlyclean-am
@@ -1387,20 +1377,40 @@ uninstall-am:
.PHONY: CTAGS GTAGS TAGS all all-am all-local check check-TESTS \
check-am clean clean-checkPROGRAMS clean-generic clean-libtool \
- clean-noinstLTLIBRARIES cscopelist-am ctags ctags-am distclean \
- distclean-compile distclean-generic distclean-libtool \
- distclean-tags distdir dvi dvi-am html html-am info info-am \
- install install-am install-data install-data-am install-dvi \
- install-dvi-am install-exec install-exec-am install-html \
- install-html-am install-info install-info-am install-man \
- install-pdf install-pdf-am install-ps install-ps-am \
- install-strip installcheck installcheck-am installdirs \
- maintainer-clean maintainer-clean-generic mostlyclean \
+ clean-local clean-noinstLTLIBRARIES cscopelist-am ctags \
+ ctags-am distclean distclean-compile distclean-generic \
+ distclean-libtool distclean-local distclean-tags distdir dvi \
+ dvi-am html html-am info info-am install install-am \
+ install-data install-data-am install-dvi install-dvi-am \
+ install-exec install-exec-am install-html install-html-am \
+ install-info install-info-am install-man install-pdf \
+ install-pdf-am install-ps install-ps-am install-strip \
+ installcheck installcheck-am installdirs maintainer-clean \
+ maintainer-clean-generic maintainer-clean-local mostlyclean \
mostlyclean-compile mostlyclean-generic mostlyclean-libtool \
mostlyclean-local pdf pdf-am ps ps-am recheck tags tags-am \
uninstall uninstall-am
+#
+# Copyright by The HDF Group.
+# Copyright by the Board of Trustees of the University of Illinois.
+# All rights reserved.
+#
+# This file is part of HDF5. The full HDF5 copyright notice, including
+# terms governing use, modification, and redistribution, is contained in
+# the files COPYING and Copyright.html. COPYING can be found at the root
+# of the source code distribution tree; Copyright.html can be found at the
+# root level of an installed copy of the electronic HDF5 document set and
+# is linked from the top-level documents page. It can also be found at
+# http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have
+# access to either file, you may request a copy from help@hdfgroup.org.
+#
+# HDF5-Fortran test/Makefile(.in)
+#
+# Autoconf cannot figure out dependencies between modules; disable parallel make
+.NOTPARALLEL:
+
# List all build rules defined by HDF5 Makefiles as "PHONY" targets here.
# This tells the Makefiles that these targets are not files to be built but
# commands that should be executed even if a file with the same name already
@@ -1412,6 +1422,17 @@ uninstall-am:
help:
@$(top_srcdir)/bin/makehelp
+# Fortran module files can have different extensions and different names
+# (e.g., different capitalizations) on different platforms. Write rules
+# for them explicitly rather than trying to teach automake about them.
+# They should be installed as headers and removed during clean.
+maintainer-clean-local: clean-local
+distclean-local: clean-local
+clean-local:
+ @if test -n "$(F9XMODEXT)" && test "X$(F9XMODEXT)" != "Xo"; then \
+ $(RM) *.$(F9XMODEXT); \
+ fi
+
# fflush2 depends on files created by fflush1
fflush2.chkexe_: fflush1.chkexe_
diff --git a/fortran/test/fflush1.f90 b/fortran/test/fflush1.f90
index d35bfff..ca2550f 100644
--- a/fortran/test/fflush1.f90
+++ b/fortran/test/fflush1.f90
@@ -30,6 +30,7 @@
PROGRAM FFLUSH1EXAMPLE
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
@@ -149,7 +150,7 @@
IF (total_error .ne. 0) CALL h5_exit_f (1)
- 001 STOP
+ STOP
END PROGRAM FFLUSH1EXAMPLE
diff --git a/fortran/test/fflush2.f90 b/fortran/test/fflush2.f90
index d699150..04ce439 100644
--- a/fortran/test/fflush2.f90
+++ b/fortran/test/fflush2.f90
@@ -30,6 +30,7 @@
PROGRAM FFLUSH2EXAMPLE
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
@@ -39,7 +40,6 @@
!
!data space rank and dimensions
!
- INTEGER, PARAMETER :: RANK = 2
INTEGER, PARAMETER :: NX = 4
INTEGER, PARAMETER :: NY = 5
diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90
index 6268d15..79ff161 100644
--- a/fortran/test/fortranlib_test.f90
+++ b/fortran/test/fortranlib_test.f90
@@ -27,6 +27,7 @@
PROGRAM fortranlibtest
USE HDF5
+ USE THDF5
IMPLICIT NONE
INTEGER :: total_error = 0
@@ -72,14 +73,9 @@ PROGRAM fortranlibtest
CALL reopentest(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' Reopen test', total_error)
-!DEC$ if defined(H5_VMS)
- GOTO 8
-!DEC$ else
ret_total_error = 0
CALL file_close(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' File open/close test', total_error)
-!DEC$ endif
-8 CONTINUE
ret_total_error = 0
CALL file_space("file_space",cleanup, ret_total_error)
@@ -143,11 +139,11 @@ PROGRAM fortranlibtest
CALL write_test_status(ret_total_error, ' Element selection functions test ', total_error)
ret_total_error = 0
- CALL test_select_combine(cleanup, ret_total_error)
+ CALL test_select_combine(ret_total_error)
CALL write_test_status(ret_total_error, ' Selection combinations test ', total_error)
ret_total_error = 0
- CALL test_select_bounds(cleanup, ret_total_error)
+ CALL test_select_bounds(ret_total_error)
CALL write_test_status(ret_total_error, ' Selection bounds test ', total_error)
! write(*,*)
@@ -155,7 +151,7 @@ PROGRAM fortranlibtest
! write(*,*) 'Testing DATATYPE interface '
! write(*,*) '========================================='
ret_total_error = 0
- CALL basic_data_type_test(cleanup, ret_total_error)
+ CALL basic_data_type_test(ret_total_error)
CALL write_test_status(ret_total_error, ' Basic datatype test', total_error)
ret_total_error = 0
@@ -179,14 +175,9 @@ PROGRAM fortranlibtest
CALL external_test(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' External dataset test', total_error)
-!DEC$ if defined(H5_VMS)
- GOTO 9
-!DEC$ else
ret_total_error = 0
CALL multi_file_test(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' Multi file driver test', total_error)
-!DEC$ endif
-9 CONTINUE
ret_total_error = 0
CALL test_chunk_cache (cleanup, ret_total_error)
@@ -211,7 +202,7 @@ PROGRAM fortranlibtest
CALL write_test_status(ret_total_error, ' Identifier test', total_error)
ret_total_error = 0
- CALL filters_test(cleanup, ret_total_error)
+ CALL filters_test(ret_total_error)
CALL write_test_status(ret_total_error, ' Filters test', total_error)
ret_total_error = 0
diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90
index dc45560..66f799b 100644
--- a/fortran/test/fortranlib_test_1_8.f90
+++ b/fortran/test/fortranlib_test_1_8.f90
@@ -27,7 +27,8 @@
PROGRAM fortranlibtest
USE HDF5
-
+ USE THDF5_1_8
+ USE TH5_MISC
IMPLICIT NONE
INTEGER :: total_error = 0
INTEGER :: error
@@ -113,445 +114,3 @@ PROGRAM fortranlibtest
IF (total_error .NE. 0) CALL h5_exit_f (1)
END PROGRAM fortranlibtest
-
-SUBROUTINE dtransform(cleanup, total_error)
- USE HDF5 ! This module contains all necessary modules
-
- IMPLICIT NONE
- LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(INOUT) :: total_error
-
- INTEGER(HID_T) :: dxpl_id_c_to_f
- INTEGER(HID_T) :: file_id
-
- CHARACTER(LEN=15), PARAMETER :: c_to_f = "(9/5.0)*x + 123"
- INTEGER :: error
- CHARACTER(LEN=15) :: ptrgetTest
- CHARACTER(LEN=7) :: ptrgetTest_small
- CHARACTER(LEN=30) :: ptrgetTest_big
-
- INTEGER(SIZE_T) :: size
-
- CALL H5Fcreate_f("dtransform.h5", H5F_ACC_TRUNC_F, file_id, error)
- CALL check("dtransform.H5Fcreate_f", error, total_error)
-
- CALL H5Pcreate_f(H5P_DATASET_XFER_F, dxpl_id_c_to_f, error)
- CALL check("dtransform.H5Pcreate_f", error, total_error)
-
- CALL H5Pset_data_transform_f(dxpl_id_c_to_f, c_to_f, error)
- CALL check("dtransform.H5Pset_data_transform_f", error, total_error)
-
- CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest, error, size=size)
- CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
- CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f, ptrgetTest, total_error)
- CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
-
-! check case when receiving buffer to small
-
- CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_small, error, size=size)
- CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
- CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:7), ptrgetTest_small, total_error)
- CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
-
-! check case when receiving buffer to big
-
- CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_big, error, size=size)
- CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
- CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:15), ptrgetTest_big(1:15), total_error)
- CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size), 15, total_error)
-
- CALL H5Fclose_f(file_id, error)
- CALL check("H5Fclose_f", error, total_error)
-
- IF(cleanup) CALL h5_cleanup_f("dtransform", H5P_DEFAULT_F, error)
- CALL check("h5_cleanup_f", error, total_error)
-
-
-END SUBROUTINE dtransform
-
-
-!/****************************************************************
-!**
-!** test_genprop_basic_class(): Test basic generic property list code.
-!** Tests creating new generic classes.
-!**
-!****************************************************************/
-
-SUBROUTINE test_genprop_basic_class(cleanup, total_error)
-
- USE HDF5 ! This module contains all necessary modules
-
- IMPLICIT NONE
- LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(INOUT) :: total_error
-
- INTEGER(HID_T) :: cid1 !/* Generic Property class ID */
- INTEGER(HID_T) :: cid2 !/* Generic Property class ID */
-
- CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1"
- CHARACTER(LEN=7) :: name ! /* Name of class */
- CHARACTER(LEN=10) :: name_big ! /* Name of class bigger buffer */
- CHARACTER(LEN=4) :: name_small ! /* Name of class smaller buffer*/
- INTEGER :: error
- INTEGER :: size
- LOGICAL :: flag
-
- !/* Output message about test being performed */
-
- !WRITE(*,*) "Testing Basic Generic Property List Class Creation Functionality"
-
- ! Try some bogus value for class identifier; function should fail gracefully
-
- cid1 = 456
- CALL H5Pget_class_name_f(cid1, name, size, error)
- CALL VERIFY("H5Pget_class_name", error, -1, error)
-
- ! /* Create a new generic class, derived from the root of the class hierarchy */
- CALL H5Pcreate_class_f(H5P_ROOT_F, CLASS1_NAME, cid1, error)
- CALL check("H5Pcreate_class", error, total_error)
-
- ! /* Check class name */
- CALL H5Pget_class_name_f(cid1, name, size, error)
- CALL check("H5Pget_class_name", error, total_error)
- CALL VERIFY("H5Pget_class_name", size,7,error)
- CALL verifystring("H5Pget_class_name", name, CLASS1_NAME, error)
- IF(error.NE.0)THEN
- WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME
- total_error = total_error + 1
- ENDIF
-
- ! /* Check class name smaller buffer*/
- CALL H5Pget_class_name_f(cid1, name_small, size, error)
- CALL check("H5Pget_class_name", error, total_error)
- CALL VERIFY("H5Pget_class_name", size,7,error)
- CALL verifystring("H5Pget_class_name", name_small(1:4), CLASS1_NAME(1:4), error)
- IF(error.NE.0)THEN
- WRITE(*,*) 'Class names do not match! name=',name_small(1:4), 'CLASS1_NAME=',CLASS1_NAME(1:4)
- total_error = total_error + 1
- ENDIF
-
- ! /* Check class name bigger buffer*/
- CALL H5Pget_class_name_f(cid1, name_big, size, error)
- CALL check("H5Pget_class_name", error, total_error)
- CALL VERIFY("H5Pget_class_name", size,7,error)
- CALL verifystring("H5Pget_class_name", TRIM(name_big), TRIM(CLASS1_NAME), error)
- IF(error.NE.0)THEN
- WRITE(*,*) 'Class names do not match! name=',TRIM(name_small), 'CLASS1_NAME=',TRIM(CLASS1_NAME)
- total_error = total_error + 1
- ENDIF
-
- ! /* Check class parent */
- CALL H5Pget_class_parent_f(cid1, cid2, error)
- CALL check("H5Pget_class_parent_f", error, total_error)
-
- ! /* Verify class parent correct */
- CALL H5Pequal_f(cid2, H5P_ROOT_F, flag, error)
- CALL check("H5Pequal_f", error, total_error)
- CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error)
-
-
- ! /* Make certain false postives aren't being returned */
- CALL H5Pequal_f(cid2, H5P_FILE_CREATE_F, flag, error)
- CALL check("H5Pequal_f", error, total_error)
- CALL verifylogical("H5Pequal_f", flag, .FALSE., total_error)
-
- !/* Close parent class */
- CALL H5Pclose_class_f(cid2, error)
- CALL check("H5Pclose_class_f", error, total_error)
-
-
- !/* Close class */
- CALL H5Pclose_class_f(cid1, error)
- CALL check("H5Pclose_class_f", error, total_error)
-
-END SUBROUTINE test_genprop_basic_class
-
-SUBROUTINE test_h5s_encode(cleanup, total_error)
-
-!/****************************************************************
-!**
-!** test_h5s_encode(): Test H5S (dataspace) encoding and decoding.
-!**
-!****************************************************************/
-
- USE HDF5 ! This module contains all necessary modules
-
- IMPLICIT NONE
- LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(INOUT) :: total_error
-
- INTEGER(hid_t) :: sid1, sid3! /* Dataspace ID */
- INTEGER(hid_t) :: decoded_sid1, decoded_sid3
- INTEGER :: rank !/* LOGICAL rank of dataspace */
- INTEGER(size_t) :: sbuf_size=0, scalar_size=0
-
-! Make sure the size is large
- CHARACTER(LEN=288) :: sbuf
- CHARACTER(LEN=288) :: scalar_buf
-
- INTEGER(hsize_t) :: n ! /* Number of dataspace elements */
-
- INTEGER(hsize_t), DIMENSION(1:3) :: start = (/0, 0, 0/)
- INTEGER(hsize_t), DIMENSION(1:3) :: stride = (/2, 5, 3/)
- INTEGER(hsize_t), DIMENSION(1:3) :: count = (/2, 2, 2/)
- INTEGER(hsize_t), DIMENSION(1:3) :: BLOCK = (/1, 3, 1/)
-
- INTEGER :: space_type
- !
- ! Dataset dimensions
- !
- INTEGER, PARAMETER :: SPACE1_DIM1= 3, SPACE1_DIM2=15, SPACE1_DIM3=13
-
- INTEGER(HSIZE_T), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/)
- INTEGER :: SPACE1_RANK = 3
- INTEGER :: error
-
- !/*-------------------------------------------------------------------------
- ! * Test encoding and decoding of simple dataspace and hyperslab selection.
- ! *-------------------------------------------------------------------------
- ! */
-
- CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error)
- CALL check("H5Screate_simple", error, total_error)
-
- CALL h5sselect_hyperslab_f(sid1, H5S_SELECT_SET_F, &
- start, count, error, stride=stride, BLOCK=BLOCK)
- CALL check("h5sselect_hyperslab_f", error, total_error)
-
-
- !/* Encode simple data space in a buffer */
-
- ! First find the buffer size
- CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
- CALL check("H5Sencode", error, total_error)
-
-
- ! /* Try decoding bogus buffer */
-
- CALL H5Sdecode_f(sbuf, decoded_sid1, error)
- CALL VERIFY("H5Sdecode", error, -1, total_error)
-
- CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
- CALL check("H5Sencode", error, total_error)
-
- ! /* Decode from the dataspace buffer and return an object handle */
- CALL H5Sdecode_f(sbuf, decoded_sid1, error)
- CALL check("H5Sdecode", error, total_error)
-
-
- ! /* Verify the decoded dataspace */
- CALL h5sget_simple_extent_npoints_f(decoded_sid1, n, error)
- CALL check("h5sget_simple_extent_npoints_f", error, total_error)
- CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3, &
- total_error)
-
- !
- !Close the dataspace for the dataset.
- !
- CALL h5sclose_f(sid1, error)
- CALL check("h5sclose_f", error, total_error)
-
- CALL h5sclose_f(decoded_sid1, error)
- CALL check("h5sclose_f", error, total_error)
-
- ! /*-------------------------------------------------------------------------
- ! * Test encoding and decoding of scalar dataspace.
- ! *-------------------------------------------------------------------------
- ! */
- ! /* Create scalar dataspace */
-
- CALL H5Screate_f(H5S_SCALAR_F, sid3, error)
- CALL check("H5Screate_f",error, total_error)
-
- ! /* Encode scalar data space in a buffer */
-
- ! First find the buffer size
- CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error)
- CALL check("H5Sencode_f", error, total_error)
-
- ! encode
-
- CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error)
- CALL check("H5Sencode_f", error, total_error)
-
-
- ! /* Decode from the dataspace buffer and return an object handle */
-
- CALL H5Sdecode_f(scalar_buf, decoded_sid3, error)
- CALL check("H5Sdecode_f", error, total_error)
-
-
- ! /* Verify extent type */
-
- CALL H5Sget_simple_extent_type_f(decoded_sid3, space_type, error)
- CALL check("H5Sget_simple_extent_type_f", error, total_error)
- CALL VERIFY("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error)
-
- ! /* Verify decoded dataspace */
- CALL h5sget_simple_extent_npoints_f(decoded_sid3, n, error)
- CALL check("h5sget_simple_extent_npoints_f", error, total_error)
- CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), 1, total_error)
-
- CALL H5Sget_simple_extent_ndims_f(decoded_sid3, rank, error)
- CALL CHECK("H5Sget_simple_extent_ndims_f", error, total_error)
- CALL VERIFY("H5Sget_simple_extent_ndims_f", rank, 0, total_error )
-
- CALL h5sclose_f(sid3, error)
- CALL check("h5sclose_f", error, total_error)
-
- CALL h5sclose_f(decoded_sid3, error)
- CALL check("h5sclose_f", error, total_error)
-
-END SUBROUTINE test_h5s_encode
-
-!-------------------------------------------------------------------------
-! Function: test_scaleoffset
-!
-! Purpose: Tests the integer datatype for scaleoffset filter
-! with fill value set
-!
-! Return: Success: 0
-! Failure: >0
-!
-! Programmer: M. Scot Breitenfeld
-! Decemeber 11, 2010
-!
-! Modifications:
-!
-!-------------------------------------------------------------------------
-!
-
-SUBROUTINE test_scaleoffset(cleanup, total_error )
-
- USE HDF5
-
- IMPLICIT NONE
- LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(INOUT) :: total_error
- INTEGER(hid_t) :: file
-
- INTEGER(hid_t) :: dataset, datatype, space, mspace, dc
- INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2, 5/)
- INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2, 5/)
- INTEGER, DIMENSION(1:2,1:5) :: orig_data
- INTEGER, DIMENSION(1:2,1:5) :: new_data
- INTEGER(hsize_t), DIMENSION(1:2) :: start ! Start of hyperslab
- INTEGER(hsize_t), DIMENSION(1:2) :: stride ! Stride of hyperslab
- INTEGER(hsize_t), DIMENSION(1:2) :: count ! BLOCK count
- INTEGER(hsize_t), DIMENSION(1:2) :: BLOCK ! BLOCK sizes
- INTEGER :: fillval
- INTEGER(size_t) :: j
- REAL :: x
- INTEGER :: error
- LOGICAL :: status
-
- ! check to see if filter is available
- CALL H5Zfilter_avail_f(H5Z_FILTER_SCALEOFFSET_F, status, error)
- IF(.NOT.status)THEN ! We don't have H5Z_FILTER_SCALEOFFSET_F filter
- total_error = -1 ! so return
- RETURN
- ENDIF
-
- CALL H5Fcreate_f("h5scaleoffset.h5", H5F_ACC_TRUNC_F, file, error)
- CALL check("H5Fcreate_f", error, total_error)
-
- CALL H5Tcopy_f(H5T_NATIVE_INTEGER, datatype, error)
- CALL CHECK(" H5Tcopy_f", error, total_error)
-
- ! Set order of dataset datatype
- CALL H5Tset_order_f(datatype, H5T_ORDER_BE_F, error)
- CALL CHECK(" H5Tset_order_f", error, total_error)
-
- ! Create the data space for the dataset
- CALL H5Screate_simple_f(2, dims, space, error)
- CALL CHECK(" H5Screate_simple_f", error, total_error)
-
- ! Create the dataset property list
- CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error)
- CALL CHECK(" H5Pcreate_f", error, total_error)
-
- ! Set fill value
- fillval = 10000
- CALL H5Pset_fill_value_f(dc, H5T_NATIVE_INTEGER, fillval, error)
- CALL CHECK(" H5Pset_fill_value_f", error, total_error)
-
- ! Set up to use scaleoffset filter, let library calculate minbits
- CALL H5Pset_chunk_f(dc, 2, chunk_dim, error)
- CALL CHECK(" H5Pset_chunk_f", error, total_error)
-
- CALL H5Pset_scaleoffset_f(dc, H5Z_SO_INT_F, H5Z_SO_INT_MINBITS_DEFAULT_F, error)
- CALL CHECK(" H5Pset_scaleoffset_f", error, total_error)
-
- ! Create the dataset
- CALL H5Dcreate_f(file, "scaleoffset_int", datatype, &
- space, dataset, error, dc)
- CALL CHECK(" H5Dcreate_f", error, total_error)
-
- ! Create the memory data space
- CALL H5Screate_simple_f(2, dims, mspace, error)
- CALL CHECK(" H5Screate_simple_f", error, total_error)
-
- ! Select hyperslab for data to write, using 1x5 blocks,
- ! (1,1) stride and (1,1) count starting at the position (0,0)
-
- start(1:2) = (/0,0/)
- stride(1:2) = (/1,1/)
- COUNT(1:2) = (/1,1/)
- BLOCK(1:2) = (/1,5/)
-
- CALL H5Sselect_hyperslab_f(mspace, H5S_SELECT_SET_F, start, &
- count, error, stride, BLOCK)
- CALL CHECK(" H5Sselect_hyperslab_f", error, total_error)
-
- CALL RANDOM_SEED()
- ! Initialize data of hyperslab
- DO j = 1, dims(2)
- CALL RANDOM_NUMBER(x)
- orig_data(1,j) = INT(x*10000.)
- IF(MOD(j,2_size_t).EQ.0)THEN
- orig_data(1,j) = - orig_data(1,j)
- ENDIF
- ENDDO
-
- !----------------------------------------------------------------------
- ! STEP 1: Test scaleoffset by setting up a chunked dataset and writing
- ! to it.
- !----------------------------------------------------------------------
-
- ! Only data in the hyperslab will be written, other value should be fill value
- CALL H5Dwrite_f(dataset, H5T_NATIVE_INTEGER, orig_data, dims, error, mspace, mspace, H5P_DEFAULT_F)
- CALL CHECK(" H5Dwrite_f", error, total_error)
-
- !----------------------------------------------------------------------
- ! STEP 2: Try to read the data we just wrote.
- !----------------------------------------------------------------------
-
- ! Read the dataset back
-
- CALL H5Dread_f(dataset, H5T_NATIVE_INTEGER, new_data, dims, error, mspace, mspace, H5P_DEFAULT_F)
- CALL CHECK(" H5Dread_f", error, total_error)
-
- ! Check that the values read are the same as the values written
- DO j = 1, dims(2)
- IF(new_data(1,j) .NE. orig_data(1,j))THEN
- total_error = total_error + 1
- WRITE(*,'(" Read different values than written.")')
- WRITE(*,'(" At index ", 2(1X,I0))') 1, j
- EXIT
- ENDIF
- ENDDO
- !----------------------------------------------------------------------
- ! Cleanup
- !----------------------------------------------------------------------
- CALL H5Tclose_f(datatype, error)
- CALL CHECK(" H5Tclose_f", error, total_error)
- CALL H5Pclose_f(dc, error)
- CALL CHECK(" H5Pclose_f", error, total_error)
- CALL H5Sclose_f(space, error)
- CALL CHECK(" H5Sclose_f", error, total_error)
- CALL H5Dclose_f(dataset, error)
- CALL CHECK(" H5Dclose_f", error, total_error)
- CALL H5Fclose_f(file, error)
- CALL CHECK(" H5Fclose_f", error, total_error)
-
-END SUBROUTINE test_scaleoffset
diff --git a/fortran/test/fortranlib_test_F03.f90 b/fortran/test/fortranlib_test_F03.f90
index 939435b..1b8cf97 100644
--- a/fortran/test/fortranlib_test_F03.f90
+++ b/fortran/test/fortranlib_test_F03.f90
@@ -28,12 +28,12 @@
PROGRAM fortranlibtest_F03
USE HDF5
-
+ USE THDF5_F03
+
IMPLICIT NONE
INTEGER :: total_error = 0
INTEGER :: error
INTEGER :: majnum, minnum, relnum
- LOGICAL :: szip_flag
INTEGER :: ret_total_error
LOGICAL :: cleanup, status
@@ -144,6 +144,10 @@ PROGRAM fortranlibtest_F03
CALL external_test_offset(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' Testing external dataset with offset', total_error)
+ ret_total_error = 0
+ CALL test_h5p_file_image(ret_total_error)
+ CALL write_test_status(ret_total_error, ' Testing h5pset/get file image', total_error)
+
! write(*,*)
! write(*,*) '========================================='
! write(*,*) 'Testing GROUP interface '
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90
index cecaded..07ca6da 100644
--- a/fortran/test/tH5A.f90
+++ b/fortran/test/tH5A.f90
@@ -27,7 +27,9 @@
!
!
!*****
+MODULE TH5A
+CONTAINS
SUBROUTINE attribute_test(cleanup, total_error)
! This subroutine tests following functionalities:
@@ -36,10 +38,10 @@
!
USE HDF5 ! This module contains all necessary modules
-
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=5), PARAMETER :: filename = "atest" !File name
CHARACTER(LEN=80) :: fix_filename
@@ -100,7 +102,7 @@
CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back
! string attr data
CHARACTER :: attr_character_data = 'A'
- REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459
+ REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459D0
REAL, DIMENSION(1) :: attr_real_data = 4.0
INTEGER, DIMENSION(1) :: attr_integer_data = 5
INTEGER(HSIZE_T), DIMENSION(7) :: data_dims
@@ -127,6 +129,7 @@
!data buffers
!
INTEGER, DIMENSION(NX,NY) :: data_in
+ LOGICAL :: differ
!
@@ -516,20 +519,21 @@
data_dims(1) = 1
CALL h5aread_f(attr3_id, H5T_NATIVE_DOUBLE, aread_double_data, data_dims, error)
CALL check("h5aread_f",error,total_error)
- IF (aread_double_data(1) .NE. 3.459 ) THEN
- WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1)
- total_error = total_error + 1
- END IF
+
+ IF( .NOT.dreal_eq( REAL(aread_double_data(1),dp), 3.459_dp) )THEN
+ WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1)
+ total_error = total_error + 1
+ ENDIF
!
!read the real attribute data back to memory
!
data_dims(1) = 1
CALL h5aread_f(attr4_id, H5T_NATIVE_REAL, aread_real_data, data_dims, error)
CALL check("h5aread_f",error,total_error)
- IF (aread_real_data(1) .NE. 4.0 ) THEN
- WRITE(*,*) "Read back real attrbute is wrong ", aread_real_data
- total_error = total_error + 1
- END IF
+ IF( .NOT.dreal_eq( REAL(aread_real_data(1),dp), 4.0_dp) )THEN
+ WRITE(*,*) "Read back real attrbute is wrong", aread_real_data(1)
+ total_error = total_error + 1
+ ENDIF
!
!read the Integer attribute data back to memory
!
@@ -624,3 +628,4 @@
RETURN
END SUBROUTINE attribute_test
+END MODULE TH5A
diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90
index 32cb228..02bef53 100644
--- a/fortran/test/tH5A_1_8.f90
+++ b/fortran/test/tH5A_1_8.f90
@@ -30,7 +30,9 @@
! test_attr_basic_write, test_attr_many, attr_open_check,
!
!*****
+MODULE TH5A_1_8
+CONTAINS
SUBROUTINE attribute_test_1_8(cleanup, total_error)
! This subroutine tests following 1.8 functionalities:
@@ -40,27 +42,12 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
!
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
- CHARACTER(LEN=5), PARAMETER :: filename = "atest" !File name
- CHARACTER(LEN=9), PARAMETER :: dsetname = "atestdset" !Dataset name
- CHARACTER(LEN=11), PARAMETER :: aname = "attr_string" !String Attribute name
- CHARACTER(LEN=14), PARAMETER :: aname2 = "attr_character"!Character Attribute name
- CHARACTER(LEN=11), PARAMETER :: aname3 = "attr_double" !DOuble Attribute name
- CHARACTER(LEN=9), PARAMETER :: aname4 = "attr_real" !Real Attribute name
- CHARACTER(LEN=12), PARAMETER :: aname5 = "attr_integer" !Integer Attribute name
- CHARACTER(LEN=9), PARAMETER :: aname6 = "attr_null" !Null Attribute name
-
- !
- !data space rank and dimensions
- !
- INTEGER, PARAMETER :: RANK = 2
- INTEGER, PARAMETER :: NX = 4
- INTEGER, PARAMETER :: NY = 5
-
!
!general purpose integer
!
@@ -213,8 +200,10 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
! Needed for get_info_by_name
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
+
! - - - arg types - - -
INTEGER(HID_T), INTENT(IN) :: fcpl
@@ -401,6 +390,8 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
!**
!****************************************************************/
USE HDF5
+ USE TH5_MISC
+
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fcpl
@@ -413,8 +404,6 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
INTEGER(HID_T) :: dataset
CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1"
- INTEGER, PARAMETER :: NUM_DSETS = 3
-
INTEGER :: error
@@ -532,6 +521,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
!****************************************************************/
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -746,6 +736,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
!****************************************************************/
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -951,6 +942,7 @@ END SUBROUTINE test_attr_info_by_idx
SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -1091,6 +1083,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
!****************************************************************/
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -1105,7 +1098,6 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1"
CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2"
- INTEGER, PARAMETER :: NUM_DSETS = 3
INTEGER(HID_T) :: dataset, dataset2
@@ -1127,22 +1119,11 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
CHARACTER(LEN=7) :: attrname
CHARACTER(LEN=11) :: attrname2
- CHARACTER(LEN=1), PARAMETER :: chr1 = '.'
-
INTEGER :: u
- INTEGER, PARAMETER :: SPACE1_RANK = 3
- INTEGER, PARAMETER :: NX = 20
- INTEGER, PARAMETER :: NY = 5
- INTEGER, PARAMETER :: NZ = 10
INTEGER(HID_T) :: my_fcpl
CHARACTER(LEN=5), PARAMETER :: TYPE1_NAME = "/Type"
- INTEGER, PARAMETER :: SPACE1_DIM1 = 4
- INTEGER, PARAMETER :: SPACE1_DIM2 = 8
- INTEGER, PARAMETER :: SPACE1_DIM3 = 10
-
-
INTEGER :: test_shared
INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension
INTEGER :: arank = 1 ! Attribure rank
@@ -1412,6 +1393,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
!****************************************************************/
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -1457,7 +1439,6 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
INTEGER(SIZE_T) :: size
CHARACTER(LEN=8) :: tmpname
- CHARACTER(LEN=1), PARAMETER :: chr1 = '.'
INTEGER :: idx_type
INTEGER :: order
@@ -1773,6 +1754,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
!****************************************************************/
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -1786,7 +1768,6 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1"
CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2"
- INTEGER, PARAMETER :: NUM_DSETS = 3
INTEGER(HID_T) :: dataset, dataset2
@@ -1806,13 +1787,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
INTEGER, DIMENSION(1) :: attr_integer_data
CHARACTER(LEN=7) :: attrname
- CHARACTER(LEN=1), PARAMETER :: chr1 = '.'
-
INTEGER :: u
- INTEGER, PARAMETER :: SPACE1_RANK = 3
- INTEGER, PARAMETER :: NX = 20
- INTEGER, PARAMETER :: NY = 5
- INTEGER, PARAMETER :: NZ = 10
INTEGER(HID_T) :: my_fcpl
CHARACTER(LEN=5), PARAMETER :: TYPE1_NAME = "/Type"
@@ -2056,6 +2031,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
!****************************************************************/
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -2207,6 +2183,7 @@ END SUBROUTINE test_attr_dense_open
SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -2302,6 +2279,7 @@ END SUBROUTINE test_attr_dense_verify
SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -2424,6 +2402,7 @@ END SUBROUTINE test_attr_corder_create_basic
SUBROUTINE test_attr_basic_write(fapl, total_error)
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -2445,8 +2424,6 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
CHARACTER(LEN=25) :: check_name
CHARACTER(LEN=18) :: chr_exact_size
- INTEGER, PARAMETER :: SPACE1_RANK = 2
-
CHARACTER(LEN=5), PARAMETER :: ATTR1_NAME="Attr1"
INTEGER, PARAMETER :: ATTR1_RANK = 1
INTEGER, PARAMETER :: ATTR1_DIM1 = 3
@@ -2623,6 +2600,7 @@ END SUBROUTINE test_attr_basic_write
SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -2740,6 +2718,7 @@ END SUBROUTINE test_attr_many
SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fid
@@ -2750,7 +2729,6 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
INTEGER :: u
CHARACTER (LEN=8) :: attrname
- INTEGER, PARAMETER :: NUM_DSETS = 3
INTEGER :: error
LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute
INTEGER :: corder ! Is a positive integer containing the creation order of the attribute
@@ -2835,3 +2813,4 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
ENDDO
END SUBROUTINE attr_open_check
+END MODULE TH5A_1_8
diff --git a/fortran/test/tH5D.f90 b/fortran/test/tH5D.f90
index 9f7b50c..c0eb8f9 100644
--- a/fortran/test/tH5D.f90
+++ b/fortran/test/tH5D.f90
@@ -34,8 +34,12 @@
!*****
!
+MODULE TH5D
+
+CONTAINS
SUBROUTINE datasettest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -204,7 +208,7 @@
do j = 1, 6
IF (data_out(i,j) .NE. dset_data(i, j)) THEN
write(*, *) "dataset test error occured"
- write(*,*) "data read is not the same as the data writen"
+ write(*,*) "data read is not the same as the data written"
END IF
end do
end do
@@ -252,8 +256,10 @@
SUBROUTINE extenddsettest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
+
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
@@ -308,6 +314,7 @@
!general purpose integer
!
INTEGER :: i, j
+ INTEGER(HSIZE_T) :: ih, jh
!
!flag to check operation success
@@ -484,9 +491,9 @@
!
!Compare the data.
!
- do i = 1, dims1(1)
- do j = 1, dims1(2)
- IF (data_out(i,j) .NE. data_in(i, j)) THEN
+ do ih = 1, dims1(1)
+ do jh = 1, dims1(2)
+ IF (data_out(ih,jh) .NE. data_in(ih, jh)) THEN
write(*, *) "extend dataset test error occured"
write(*, *) "read value is not the same as the written values"
END IF
@@ -527,5 +534,5 @@
RETURN
END SUBROUTINE extenddsettest
-
+END MODULE TH5D
diff --git a/fortran/test/tH5E.f90 b/fortran/test/tH5E.f90
index 4d431a1..10ecaf6 100644
--- a/fortran/test/tH5E.f90
+++ b/fortran/test/tH5E.f90
@@ -31,15 +31,20 @@
!
!*****
!
+MODULE TH5E
+
+CONTAINS
+
SUBROUTINE error_report_test(cleanup, total_error)
! This subroutine tests following functionalities: h5eprint_f
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=6), PARAMETER :: filename = "etestf" ! File name
CHARACTER(LEN=80) :: fix_filename
@@ -92,3 +97,6 @@
CALL check("h5_cleanup_f", error, total_error)
RETURN
END SUBROUTINE error_report_test
+
+END MODULE TH5E
+
diff --git a/fortran/test/tH5E_F03.f90 b/fortran/test/tH5E_F03.f90
index 04e3190..82ba27c 100644
--- a/fortran/test/tH5E_F03.f90
+++ b/fortran/test/tH5E_F03.f90
@@ -34,10 +34,8 @@
! *****************************************
! *** H 5 E T E S T S
! *****************************************
-
MODULE test_my_hdf5_error_handler
- IMPLICIT NONE
CONTAINS
@@ -56,9 +54,8 @@ CONTAINS
IMPLICIT NONE
! estack_id is always passed from C as: H5E_DEFAULT
- INTEGER(HID_T) :: estack_id
+ INTEGER(HID_T) :: estack_id
! data that was registered with H5Eset_auto_f
-! INTEGER, DIMENSION(1:2) :: data_inout
INTEGER :: data_inout
PRINT*, " "
@@ -82,10 +79,10 @@ CONTAINS
IMPLICIT NONE
! estack_id is always passed from C as: H5E_DEFAULT
- INTEGER(HID_T) :: estack_id
+ INTEGER(HID_T) :: estack_id
! data that was registered with H5Eset_auto_f
TYPE(C_PTR) :: data_inout
-
+
PRINT*, " "
PRINT*, " Subtest: H5Eset_auto_f custom error message with callback, NO DATA"
PRINT*, " -This message should be written to standard out- "
@@ -94,12 +91,19 @@ CONTAINS
my_hdf5_error_handler_nodata = 1 ! this is not used by the C routine
END FUNCTION my_hdf5_error_handler_nodata
-
+
END MODULE test_my_hdf5_error_handler
+
+
+MODULE TH5E_F03
+
+CONTAINS
+
SUBROUTINE test_error(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
USE test_my_hdf5_error_handler
@@ -109,27 +113,17 @@ SUBROUTINE test_error(total_error)
INTEGER :: total_error
INTEGER(hid_t) :: file
INTEGER(hid_t) :: dataset, space
- INTEGER(hid_t) :: estack_id
INTEGER(hsize_t), DIMENSION(1:2) :: dims
- CHARACTER(LEN=10) :: FUNC_test_error = "test_error"
- TYPE(C_FUNPTR) :: old_func
- TYPE(C_PTR) :: old_data, null_data
INTEGER :: error
- TYPE(C_FUNPTR) :: op
- INTEGER, DIMENSION(1:100,1:200), TARGET :: ipoints2
- !! INTEGER, DIMENSION(1:2), TARGET :: my_hdf5_error_handler_data
INTEGER, DIMENSION(:), POINTER :: ptr_data
INTEGER, TARGET :: my_hdf5_error_handler_data
TYPE(C_PTR) :: f_ptr
TYPE(C_FUNPTR) :: func
TYPE(C_PTR), TARGET :: f_ptr1
- TYPE(C_FUNPTR), TARGET :: func1
INTEGER, DIMENSION(1:1) :: array_shape
- LOGICAL :: is_associated
- ! my_hdf5_error_handler_data(1:2) =(/1,2/)
my_hdf5_error_handler_data = 99
CALL h5fcreate_f("terror.h5", H5F_ACC_TRUNC_F, file, error)
CALL check("h5fcreate_f", error, total_error)
@@ -208,3 +202,5 @@ SUBROUTINE test_error(total_error)
CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error)
END SUBROUTINE test_error
+
+END MODULE TH5E_F03
diff --git a/fortran/test/tH5F.f90 b/fortran/test/tH5F.f90
index d8f683c..931a046 100644
--- a/fortran/test/tH5F.f90
+++ b/fortran/test/tH5F.f90
@@ -1,4 +1,4 @@
-!****h* root/fortran/test/tH5F.f90
+!***rh* root/fortran/test/tH5F.f90
!
! NAME
! tH5F.f90
@@ -31,11 +31,19 @@
! and another file with a dataset. Mounting is used to
! access the dataset from the second file as a member of a group
! in the first file.
+
+
+
+MODULE TH5F
+
+CONTAINS
+
SUBROUTINE mountingtest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
!
!the respective filename is "mount1.h5" and "mount2.h5"
@@ -241,7 +249,6 @@
do i = 1, NX
do j = 1, NY
IF (data_out(i,j) .NE. data_in(i, j)) THEN
- write(*, *) "mounting test error occured"
END IF
end do
end do
@@ -289,9 +296,10 @@
SUBROUTINE reopentest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
!
CHARACTER(LEN=6), PARAMETER :: filename = "reopen"
@@ -475,9 +483,10 @@
SUBROUTINE plisttest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
!
!file names are "plist1.h5" and "plist2.h5"
@@ -574,9 +583,10 @@
SUBROUTINE file_close(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER :: error
!
@@ -702,10 +712,11 @@
SUBROUTINE file_space(filename, cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
CHARACTER(*), INTENT(IN) :: filename
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER :: error
!
CHARACTER(LEN=3), PARAMETER :: grpname = "grp"
@@ -770,4 +781,4 @@
END SUBROUTINE file_space
-
+END MODULE TH5F
diff --git a/fortran/test/tH5F_F03.f90 b/fortran/test/tH5F_F03.f90
index 79b0458..c878a59 100644
--- a/fortran/test/tH5F_F03.f90
+++ b/fortran/test/tH5F_F03.f90
@@ -36,11 +36,16 @@
! *** H 5 F T E S T S
! *****************************************
+MODULE TH5F_F03
+
+CONTAINS
+
SUBROUTINE test_get_file_image(total_error)
!
! Tests the wrapper for h5fget_file_image
!
- USE HDF5
+ USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -169,3 +174,5 @@ SUBROUTINE test_get_file_image(total_error)
DEALLOCATE(file_image_ptr,image_ptr)
END SUBROUTINE test_get_file_image
+
+END MODULE TH5F_F03
diff --git a/fortran/test/tH5G.f90 b/fortran/test/tH5G.f90
index 6befa94..2ba174c 100644
--- a/fortran/test/tH5G.f90
+++ b/fortran/test/tH5G.f90
@@ -27,6 +27,10 @@
!
!*****
+MODULE TH5G
+
+CONTAINS
+
SUBROUTINE group_test(cleanup, total_error)
! This subroutine tests following functionalities:
@@ -35,10 +39,11 @@
! h5gget_comment_f
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=5), PARAMETER :: filename = "gtest" !File name
CHARACTER(LEN=80) :: fix_filename
@@ -254,3 +259,5 @@
if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
CALL check("h5_cleanup_f", error, total_error)
END SUBROUTINE group_test
+
+END MODULE TH5G
diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90
index fd55ba9..5e6f50a 100644
--- a/fortran/test/tH5G_1_8.f90
+++ b/fortran/test/tH5G_1_8.f90
@@ -28,12 +28,18 @@
! lapl_nlinks
!
!*****
+
+MODULE TH5G_1_8
+
+CONTAINS
+
SUBROUTINE group_test(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T) :: fapl, fapl2, my_fapl ! /* File access property lists */
@@ -134,9 +140,10 @@ END SUBROUTINE group_test
SUBROUTINE group_info(cleanup, fapl, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
INTEGER(HID_T) :: gcpl_id ! /* Group creation property list ID */
@@ -450,9 +457,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
SUBROUTINE timestamps(cleanup, fapl, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
INTEGER(HID_T) :: file_id !/* File ID */
@@ -646,9 +654,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
SUBROUTINE mklinks(fapl, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
INTEGER(HID_T) :: file, scalar, grp, d1
@@ -661,10 +670,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER :: corder ! Specifies the link’s creation order position.
LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid.
INTEGER :: link_type ! Specifies the link class:
- ! H5L_TYPE_HARD_F - Hard link
- ! H5L_TYPE_SOFT_F - Soft link
- ! H5L_TYPE_EXTERNAL_F - External link
- ! H5L_TYPE_ERROR _F - Error
+ ! H5L_TYPE_HARD_F - Hard link
+ ! H5L_TYPE_SOFT_F - Soft link
+ ! H5L_TYPE_EXTERNAL_F - External link
+ ! H5L_TYPE_ERROR _F - Error
INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to
INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value
@@ -741,9 +750,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
SUBROUTINE test_move_preserves(fapl_id, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl_id
INTEGER(HID_T):: file_id
@@ -768,10 +778,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER :: corder ! Specifies the link’s creation order position.
LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid.
INTEGER :: link_type ! Specifies the link class:
- ! H5L_TYPE_HARD_F - Hard link
- ! H5L_TYPE_SOFT_F - Soft link
- ! H5L_TYPE_EXTERNAL_F - External link
- ! H5L_TYPE_ERROR _F - Error
+ ! H5L_TYPE_HARD_F - Hard link
+ ! H5L_TYPE_SOFT_F - Soft link
+ ! H5L_TYPE_EXTERNAL_F - External link
+ ! H5L_TYPE_ERROR _F - Error
INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to
INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value
@@ -948,9 +958,10 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl2
INTEGER :: error
@@ -962,8 +973,8 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
INTEGER(size_t) :: lheap_size_hint !/* Local heap size hint */
INTEGER :: max_compact !/* Maximum # of links to store in group compactly */
INTEGER :: min_dense !/* Minimum # of links to store in group "densely" */
- INTEGER :: est_num_entries !/* Estimated # of entries in group */
- INTEGER :: est_name_len !/* Estimated length of entry name */
+ INTEGER :: est_num_entries !/* Estimated # of entries in group */
+ INTEGER :: est_name_len !/* Estimated length of entry name */
CHARACTER(LEN=NAME_BUF_SIZE) :: filename = 'fixx.h5'
INTEGER(SIZE_T) :: LIFECYCLE_LOCAL_HEAP_SIZE_HINT = 256
INTEGER :: LIFECYCLE_MAX_COMPACT = 4
@@ -1096,9 +1107,10 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
! USE ISO_C_BINDING
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
INTEGER :: error
@@ -1165,9 +1177,10 @@ END SUBROUTINE cklinks
SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
INTEGER(HID_T) :: file_id ! /* File ID */
@@ -1406,6 +1419,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
hard_link, use_index, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1509,6 +1523,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
SUBROUTINE test_lcpl(cleanup, fapl, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1526,10 +1541,10 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
INTEGER :: corder ! Specifies the link’s creation order position.
LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid.
INTEGER :: link_type ! Specifies the link class:
- ! H5L_TYPE_HARD_F - Hard link
- ! H5L_TYPE_SOFT_F - Soft link
- ! H5L_TYPE_EXTERNAL_F - External link
- ! H5L_TYPE_ERROR _F - Error
+ ! H5L_TYPE_HARD_F - Hard link
+ ! H5L_TYPE_SOFT_F - Soft link
+ ! H5L_TYPE_EXTERNAL_F - External link
+ ! H5L_TYPE_ERROR _F - Error
INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to
INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value
@@ -1635,13 +1650,11 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL check("h5sget_simple_extent_dims_f",error, total_error)
DO i = 1, 2
- tmp1 = dimsout(i)
- tmp2 = extend_dim(i)
-!EP CALL VERIFY("H5Sget_simple_extent_dims", dimsout(i), extend_dim(i), total_error)
+ tmp1 = INT(dimsout(i))
+ tmp2 = INT(extend_dim(i))
CALL VERIFY("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
-!EP CALL VERIFY("H5Sget_simple_extent_dims", maxdimsout(i), dims(i), total_error)
- tmp1 = maxdimsout(i)
- tmp2 = dims(i)
+ tmp1 = INT(maxdimsout(i))
+ tmp2 = INT(dims(i))
CALL VERIFY("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
ENDDO
@@ -1822,6 +1835,7 @@ END SUBROUTINE test_lcpl
SUBROUTINE objcopy(fapl, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
@@ -1885,6 +1899,7 @@ END SUBROUTINE objcopy
SUBROUTINE lapl_nlinks( fapl, total_error)
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fapl
@@ -2140,3 +2155,5 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
CALL check("H5Fclose_f", error, total_error)
END SUBROUTINE lapl_nlinks
+
+END MODULE TH5G_1_8
diff --git a/fortran/test/tH5I.f90 b/fortran/test/tH5I.f90
index 184edaf..088b4eb 100644
--- a/fortran/test/tH5I.f90
+++ b/fortran/test/tH5I.f90
@@ -26,16 +26,20 @@
! identifier_test
!
!*****
+MODULE TH5I
+
+CONTAINS
SUBROUTINE identifier_test(cleanup, total_error)
! This subroutine tests following functionalities: h5iget_type_f
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=6), PARAMETER :: filename = "itestf" ! File name
CHARACTER(LEN=80) :: fix_filename
@@ -311,3 +315,5 @@
RETURN
END SUBROUTINE identifier_test
+
+END MODULE TH5I
diff --git a/fortran/test/tH5L_F03.f90 b/fortran/test/tH5L_F03.f90
index f71f450..8cc17fb 100644
--- a/fortran/test/tH5L_F03.f90
+++ b/fortran/test/tH5L_F03.f90
@@ -30,14 +30,13 @@
! test_iter_group
!
!*****
-
MODULE liter_cb_mod
USE HDF5
USE ISO_C_BINDING
IMPLICIT NONE
-
- TYPE iter_enum
+
+ TYPE iter_enum
INTEGER RET_ZERO
INTEGER RET_TWO
INTEGER RET_CHANGE
@@ -74,7 +73,7 @@ CONTAINS
TYPE(iter_info) :: op_data
INTEGER, SAVE :: count
- INTEGER, SAVE :: count2
+ INTEGER, SAVE :: count2
!!$
!!$ iter_info *info = (iter_info *)op_data;
@@ -108,6 +107,10 @@ CONTAINS
END FUNCTION liter_cb
END MODULE liter_cb_mod
+MODULE TH5L_F03
+
+CONTAINS
+
! *****************************************
! *** H 5 L T E S T S
! *****************************************
@@ -121,34 +124,29 @@ END MODULE liter_cb_mod
SUBROUTINE test_iter_group(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
USE liter_cb_mod
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T) :: fapl
- INTEGER(HID_T) :: file ! File ID
+ INTEGER(HID_T) :: file ! File ID
INTEGER(hid_t) :: dataset ! Dataset ID
INTEGER(hid_t) :: datatype ! Common datatype ID
INTEGER(hid_t) :: filespace ! Common dataspace ID
- INTEGER(hid_t) :: root_group,grp ! Root group ID
- INTEGER i,j ! counting variable
- INTEGER(hsize_t) idx ! Index in the group
+ INTEGER(hid_t) :: grp ! Group ID
+ INTEGER i,j ! counting variable
+ INTEGER(hsize_t) idx ! Index in the group
CHARACTER(LEN=11) :: DATAFILE = "titerate.h5"
INTEGER, PARAMETER :: ndatasets = 50
CHARACTER(LEN=10) :: name ! temporary name buffer
CHARACTER(LEN=10), DIMENSION(1:ndatasets+2) :: lnames ! Names of the links created
-!!$ char dataset_name[NAMELEN]; dataset name
TYPE(iter_info), TARGET :: info
-!!$ iter_info info; Custom iteration information
-!!$ H5G_info_t ginfo; Buffer for querying object's info
-!!$ herr_t ret; Generic return value
-
INTEGER :: error
INTEGER :: ret_value
- TYPE(C_PTR) :: f_ptr
TYPE(C_FUNPTR) :: f1
TYPE(C_PTR) :: f2
CHARACTER(LEN=2) :: ichr2
@@ -319,3 +317,5 @@ SUBROUTINE test_iter_group(total_error)
CALL check("H5Fclose_f", error, total_error)
END SUBROUTINE test_iter_group
+
+END MODULE TH5L_F03
diff --git a/fortran/test/tH5MISC_1_8.f90 b/fortran/test/tH5MISC_1_8.f90
new file mode 100644
index 0000000..bb7d50a
--- /dev/null
+++ b/fortran/test/tH5MISC_1_8.f90
@@ -0,0 +1,474 @@
+!****h* root/fortran/test/tH5MISC_1_8.f90
+!
+! NAME
+! tH5MISC_1_8.f90
+!
+! FUNCTION
+! Basic testing of Fortran API's introduced in 1.8 release.
+!
+! COPYRIGHT
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+! Copyright by The HDF Group. *
+! Copyright by the Board of Trustees of the University of Illinois. *
+! All rights reserved. *
+! *
+! This file is part of HDF5. The full HDF5 copyright notice, including *
+! terms governing use, modification, and redistribution, is contained in *
+! the files COPYING and Copyright.html. COPYING can be found at the root *
+! of the source code distribution tree; Copyright.html can be found at the *
+! root level of an installed copy of the electronic HDF5 document set and *
+! is linked from the top-level documents page. It can also be found at *
+! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from help@hdfgroup.org. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+!*****
+MODULE TH5MISC_1_8
+
+CONTAINS
+
+SUBROUTINE dtransform(cleanup, total_error)
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+
+ IMPLICIT NONE
+ LOGICAL, INTENT(IN) :: cleanup
+ INTEGER, INTENT(INOUT) :: total_error
+
+ INTEGER(HID_T) :: dxpl_id_c_to_f
+ INTEGER(HID_T) :: file_id
+
+ CHARACTER(LEN=15), PARAMETER :: c_to_f = "(9/5.0)*x + 123"
+ INTEGER :: error
+ CHARACTER(LEN=15) :: ptrgetTest
+ CHARACTER(LEN=7) :: ptrgetTest_small
+ CHARACTER(LEN=30) :: ptrgetTest_big
+
+ INTEGER(SIZE_T) :: size
+
+ CALL H5Fcreate_f("dtransform.h5", H5F_ACC_TRUNC_F, file_id, error)
+ CALL check("dtransform.H5Fcreate_f", error, total_error)
+
+ CALL H5Pcreate_f(H5P_DATASET_XFER_F, dxpl_id_c_to_f, error)
+ CALL check("dtransform.H5Pcreate_f", error, total_error)
+
+ CALL H5Pset_data_transform_f(dxpl_id_c_to_f, c_to_f, error)
+ CALL check("dtransform.H5Pset_data_transform_f", error, total_error)
+
+ CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest, error, size=size)
+ CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
+ CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f, ptrgetTest, total_error)
+ CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
+
+! check case when receiving buffer to small
+
+ CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_small, error, size=size)
+ CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
+ CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:7), ptrgetTest_small, total_error)
+ CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error)
+
+! check case when receiving buffer to big
+
+ CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_big, error, size=size)
+ CALL check("dtransform.H5Pget_data_transform_f", error, total_error)
+ CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:15), ptrgetTest_big(1:15), total_error)
+ CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size), 15, total_error)
+
+ CALL H5Fclose_f(file_id, error)
+ CALL check("H5Fclose_f", error, total_error)
+
+ IF(cleanup) CALL h5_cleanup_f("dtransform", H5P_DEFAULT_F, error)
+ CALL check("h5_cleanup_f", error, total_error)
+
+
+END SUBROUTINE dtransform
+
+
+!/****************************************************************
+!**
+!** test_genprop_basic_class(): Test basic generic property list code.
+!** Tests creating new generic classes.
+!**
+!****************************************************************/
+
+SUBROUTINE test_genprop_basic_class(cleanup, total_error)
+
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+
+ IMPLICIT NONE
+ LOGICAL, INTENT(IN) :: cleanup
+ INTEGER, INTENT(INOUT) :: total_error
+
+ INTEGER(HID_T) :: cid1 !/* Generic Property class ID */
+ INTEGER(HID_T) :: cid2 !/* Generic Property class ID */
+
+ CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1"
+ CHARACTER(LEN=7) :: name ! /* Name of class */
+ CHARACTER(LEN=10) :: name_big ! /* Name of class bigger buffer */
+ CHARACTER(LEN=4) :: name_small ! /* Name of class smaller buffer*/
+ INTEGER :: error
+ INTEGER :: size
+ LOGICAL :: flag
+
+ !/* Output message about test being performed */
+
+ !WRITE(*,*) "Testing Basic Generic Property List Class Creation Functionality"
+
+ ! Try some bogus value for class identifier; function should fail gracefully
+
+ cid1 = 456
+ CALL H5Pget_class_name_f(cid1, name, size, error)
+ CALL VERIFY("H5Pget_class_name", error, -1, error)
+
+ ! /* Create a new generic class, derived from the root of the class hierarchy */
+ CALL H5Pcreate_class_f(H5P_ROOT_F, CLASS1_NAME, cid1, error)
+ CALL check("H5Pcreate_class", error, total_error)
+
+ ! /* Check class name */
+ CALL H5Pget_class_name_f(cid1, name, size, error)
+ CALL check("H5Pget_class_name", error, total_error)
+ CALL VERIFY("H5Pget_class_name", size,7,error)
+ CALL verifystring("H5Pget_class_name", name, CLASS1_NAME, error)
+ IF(error.NE.0)THEN
+ WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME
+ total_error = total_error + 1
+ ENDIF
+
+ ! /* Check class name smaller buffer*/
+ CALL H5Pget_class_name_f(cid1, name_small, size, error)
+ CALL check("H5Pget_class_name", error, total_error)
+ CALL VERIFY("H5Pget_class_name", size,7,error)
+ CALL verifystring("H5Pget_class_name", name_small(1:4), CLASS1_NAME(1:4), error)
+ IF(error.NE.0)THEN
+ WRITE(*,*) 'Class names do not match! name=',name_small(1:4), 'CLASS1_NAME=',CLASS1_NAME(1:4)
+ total_error = total_error + 1
+ ENDIF
+
+ ! /* Check class name bigger buffer*/
+ CALL H5Pget_class_name_f(cid1, name_big, size, error)
+ CALL check("H5Pget_class_name", error, total_error)
+ CALL VERIFY("H5Pget_class_name", size,7,error)
+ CALL verifystring("H5Pget_class_name", TRIM(name_big), TRIM(CLASS1_NAME), error)
+ IF(error.NE.0)THEN
+ WRITE(*,*) 'Class names do not match! name=',TRIM(name_small), 'CLASS1_NAME=',TRIM(CLASS1_NAME)
+ total_error = total_error + 1
+ ENDIF
+
+ ! /* Check class parent */
+ CALL H5Pget_class_parent_f(cid1, cid2, error)
+ CALL check("H5Pget_class_parent_f", error, total_error)
+
+ ! /* Verify class parent correct */
+ CALL H5Pequal_f(cid2, H5P_ROOT_F, flag, error)
+ CALL check("H5Pequal_f", error, total_error)
+ CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error)
+
+
+ ! /* Make certain false postives aren't being returned */
+ CALL H5Pequal_f(cid2, H5P_FILE_CREATE_F, flag, error)
+ CALL check("H5Pequal_f", error, total_error)
+ CALL verifylogical("H5Pequal_f", flag, .FALSE., total_error)
+
+ !/* Close parent class */
+ CALL H5Pclose_class_f(cid2, error)
+ CALL check("H5Pclose_class_f", error, total_error)
+
+
+ !/* Close class */
+ CALL H5Pclose_class_f(cid1, error)
+ CALL check("H5Pclose_class_f", error, total_error)
+
+END SUBROUTINE test_genprop_basic_class
+
+SUBROUTINE test_h5s_encode(cleanup, total_error)
+
+!/****************************************************************
+!**
+!** test_h5s_encode(): Test H5S (dataspace) encoding and decoding.
+!**
+!****************************************************************/
+
+ USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
+ IMPLICIT NONE
+ LOGICAL, INTENT(IN) :: cleanup
+ INTEGER, INTENT(INOUT) :: total_error
+
+ INTEGER(hid_t) :: sid1, sid3! /* Dataspace ID */
+ INTEGER(hid_t) :: decoded_sid1, decoded_sid3
+ INTEGER :: rank !/* LOGICAL rank of dataspace */
+ INTEGER(size_t) :: sbuf_size=0, scalar_size=0
+
+! Make sure the size is large
+ CHARACTER(LEN=288) :: sbuf
+ CHARACTER(LEN=288) :: scalar_buf
+
+ INTEGER(hsize_t) :: n ! /* Number of dataspace elements */
+
+ INTEGER(hsize_t), DIMENSION(1:3) :: start = (/0, 0, 0/)
+ INTEGER(hsize_t), DIMENSION(1:3) :: stride = (/2, 5, 3/)
+ INTEGER(hsize_t), DIMENSION(1:3) :: count = (/2, 2, 2/)
+ INTEGER(hsize_t), DIMENSION(1:3) :: BLOCK = (/1, 3, 1/)
+
+ INTEGER :: space_type
+ !
+ ! Dataset dimensions
+ !
+ INTEGER, PARAMETER :: SPACE1_DIM1= 3, SPACE1_DIM2=15, SPACE1_DIM3=13
+
+ INTEGER(HSIZE_T), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/)
+ INTEGER :: SPACE1_RANK = 3
+ INTEGER :: error
+
+ !/*-------------------------------------------------------------------------
+ ! * Test encoding and decoding of simple dataspace and hyperslab selection.
+ ! *-------------------------------------------------------------------------
+ ! */
+
+ CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error)
+ CALL check("H5Screate_simple", error, total_error)
+
+ CALL h5sselect_hyperslab_f(sid1, H5S_SELECT_SET_F, &
+ start, count, error, stride=stride, BLOCK=BLOCK)
+ CALL check("h5sselect_hyperslab_f", error, total_error)
+
+
+ !/* Encode simple data space in a buffer */
+
+ ! First find the buffer size
+ CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
+ CALL check("H5Sencode", error, total_error)
+
+
+ ! /* Try decoding bogus buffer */
+
+ CALL H5Sdecode_f(sbuf, decoded_sid1, error)
+ CALL VERIFY("H5Sdecode", error, -1, total_error)
+
+ CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
+ CALL check("H5Sencode", error, total_error)
+
+ ! /* Decode from the dataspace buffer and return an object handle */
+ CALL H5Sdecode_f(sbuf, decoded_sid1, error)
+ CALL check("H5Sdecode", error, total_error)
+
+
+ ! /* Verify the decoded dataspace */
+ CALL h5sget_simple_extent_npoints_f(decoded_sid1, n, error)
+ CALL check("h5sget_simple_extent_npoints_f", error, total_error)
+ CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3, &
+ total_error)
+
+ !
+ !Close the dataspace for the dataset.
+ !
+ CALL h5sclose_f(sid1, error)
+ CALL check("h5sclose_f", error, total_error)
+
+ CALL h5sclose_f(decoded_sid1, error)
+ CALL check("h5sclose_f", error, total_error)
+
+ ! /*-------------------------------------------------------------------------
+ ! * Test encoding and decoding of scalar dataspace.
+ ! *-------------------------------------------------------------------------
+ ! */
+ ! /* Create scalar dataspace */
+
+ CALL H5Screate_f(H5S_SCALAR_F, sid3, error)
+ CALL check("H5Screate_f",error, total_error)
+
+ ! /* Encode scalar data space in a buffer */
+
+ ! First find the buffer size
+ CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error)
+ CALL check("H5Sencode_f", error, total_error)
+
+ ! encode
+
+ CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error)
+ CALL check("H5Sencode_f", error, total_error)
+
+
+ ! /* Decode from the dataspace buffer and return an object handle */
+
+ CALL H5Sdecode_f(scalar_buf, decoded_sid3, error)
+ CALL check("H5Sdecode_f", error, total_error)
+
+
+ ! /* Verify extent type */
+
+ CALL H5Sget_simple_extent_type_f(decoded_sid3, space_type, error)
+ CALL check("H5Sget_simple_extent_type_f", error, total_error)
+ CALL VERIFY("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error)
+
+ ! /* Verify decoded dataspace */
+ CALL h5sget_simple_extent_npoints_f(decoded_sid3, n, error)
+ CALL check("h5sget_simple_extent_npoints_f", error, total_error)
+ CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), 1, total_error)
+
+ CALL H5Sget_simple_extent_ndims_f(decoded_sid3, rank, error)
+ CALL CHECK("H5Sget_simple_extent_ndims_f", error, total_error)
+ CALL VERIFY("H5Sget_simple_extent_ndims_f", rank, 0, total_error )
+
+ CALL h5sclose_f(sid3, error)
+ CALL check("h5sclose_f", error, total_error)
+
+ CALL h5sclose_f(decoded_sid3, error)
+ CALL check("h5sclose_f", error, total_error)
+
+END SUBROUTINE test_h5s_encode
+
+!-------------------------------------------------------------------------
+! Function: test_scaleoffset
+!
+! Purpose: Tests the integer datatype for scaleoffset filter
+! with fill value set
+!
+! Return: Success: 0
+! Failure: >0
+!
+! Programmer: M. Scot Breitenfeld
+! Decemeber 11, 2010
+!
+! Modifications:
+!
+!-------------------------------------------------------------------------
+!
+
+SUBROUTINE test_scaleoffset(cleanup, total_error )
+
+ USE HDF5
+ USE TH5_MISC
+ IMPLICIT NONE
+ LOGICAL, INTENT(IN) :: cleanup
+ INTEGER, INTENT(INOUT) :: total_error
+ INTEGER(hid_t) :: file
+
+ INTEGER(hid_t) :: dataset, datatype, space, mspace, dc
+ INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2, 5/)
+ INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2, 5/)
+ INTEGER, DIMENSION(1:2,1:5) :: orig_data
+ INTEGER, DIMENSION(1:2,1:5) :: new_data
+ INTEGER(hsize_t), DIMENSION(1:2) :: start ! Start of hyperslab
+ INTEGER(hsize_t), DIMENSION(1:2) :: stride ! Stride of hyperslab
+ INTEGER(hsize_t), DIMENSION(1:2) :: count ! BLOCK count
+ INTEGER(hsize_t), DIMENSION(1:2) :: BLOCK ! BLOCK sizes
+ INTEGER :: fillval
+ INTEGER(size_t) :: j
+ REAL :: x
+ INTEGER :: error
+ LOGICAL :: status
+
+ ! check to see if filter is available
+ CALL H5Zfilter_avail_f(H5Z_FILTER_SCALEOFFSET_F, status, error)
+ IF(.NOT.status)THEN ! We don't have H5Z_FILTER_SCALEOFFSET_F filter
+ total_error = -1 ! so return
+ RETURN
+ ENDIF
+
+ CALL H5Fcreate_f("h5scaleoffset.h5", H5F_ACC_TRUNC_F, file, error)
+ CALL check("H5Fcreate_f", error, total_error)
+
+ CALL H5Tcopy_f(H5T_NATIVE_INTEGER, datatype, error)
+ CALL CHECK(" H5Tcopy_f", error, total_error)
+
+ ! Set order of dataset datatype
+ CALL H5Tset_order_f(datatype, H5T_ORDER_BE_F, error)
+ CALL CHECK(" H5Tset_order_f", error, total_error)
+
+ ! Create the data space for the dataset
+ CALL H5Screate_simple_f(2, dims, space, error)
+ CALL CHECK(" H5Screate_simple_f", error, total_error)
+
+ ! Create the dataset property list
+ CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error)
+ CALL CHECK(" H5Pcreate_f", error, total_error)
+
+ ! Set fill value
+ fillval = 10000
+ CALL H5Pset_fill_value_f(dc, H5T_NATIVE_INTEGER, fillval, error)
+ CALL CHECK(" H5Pset_fill_value_f", error, total_error)
+
+ ! Set up to use scaleoffset filter, let library calculate minbits
+ CALL H5Pset_chunk_f(dc, 2, chunk_dim, error)
+ CALL CHECK(" H5Pset_chunk_f", error, total_error)
+
+ CALL H5Pset_scaleoffset_f(dc, H5Z_SO_INT_F, H5Z_SO_INT_MINBITS_DEFAULT_F, error)
+ CALL CHECK(" H5Pset_scaleoffset_f", error, total_error)
+
+ ! Create the dataset
+ CALL H5Dcreate_f(file, "scaleoffset_int", datatype, &
+ space, dataset, error, dc)
+ CALL CHECK(" H5Dcreate_f", error, total_error)
+
+ ! Create the memory data space
+ CALL H5Screate_simple_f(2, dims, mspace, error)
+ CALL CHECK(" H5Screate_simple_f", error, total_error)
+
+ ! Select hyperslab for data to write, using 1x5 blocks,
+ ! (1,1) stride and (1,1) count starting at the position (0,0)
+
+ start(1:2) = (/0,0/)
+ stride(1:2) = (/1,1/)
+ COUNT(1:2) = (/1,1/)
+ BLOCK(1:2) = (/1,5/)
+
+ CALL H5Sselect_hyperslab_f(mspace, H5S_SELECT_SET_F, start, &
+ count, error, stride, BLOCK)
+ CALL CHECK(" H5Sselect_hyperslab_f", error, total_error)
+
+ CALL RANDOM_SEED()
+ ! Initialize data of hyperslab
+ DO j = 1, INT(dims(2))
+ CALL RANDOM_NUMBER(x)
+ orig_data(1,j) = INT(x*10000.)
+ IF(MOD(j,2_size_t).EQ.0)THEN
+ orig_data(1,j) = - orig_data(1,j)
+ ENDIF
+ ENDDO
+
+ !----------------------------------------------------------------------
+ ! STEP 1: Test scaleoffset by setting up a chunked dataset and writing
+ ! to it.
+ !----------------------------------------------------------------------
+
+ ! Only data in the hyperslab will be written, other value should be fill value
+ CALL H5Dwrite_f(dataset, H5T_NATIVE_INTEGER, orig_data, dims, error, mspace, mspace, H5P_DEFAULT_F)
+ CALL CHECK(" H5Dwrite_f", error, total_error)
+
+ !----------------------------------------------------------------------
+ ! STEP 2: Try to read the data we just wrote.
+ !----------------------------------------------------------------------
+
+ ! Read the dataset back
+
+ CALL H5Dread_f(dataset, H5T_NATIVE_INTEGER, new_data, dims, error, mspace, mspace, H5P_DEFAULT_F)
+ CALL CHECK(" H5Dread_f", error, total_error)
+
+ ! Check that the values read are the same as the values written
+ DO j = 1, INT(dims(2))
+ IF(new_data(1,j) .NE. orig_data(1,j))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" Read different values than written.")')
+ WRITE(*,'(" At index ", 2(1X,I0))') 1, j
+ EXIT
+ ENDIF
+ ENDDO
+ !----------------------------------------------------------------------
+ ! Cleanup
+ !----------------------------------------------------------------------
+ CALL H5Tclose_f(datatype, error)
+ CALL CHECK(" H5Tclose_f", error, total_error)
+ CALL H5Pclose_f(dc, error)
+ CALL CHECK(" H5Pclose_f", error, total_error)
+ CALL H5Sclose_f(space, error)
+ CALL CHECK(" H5Sclose_f", error, total_error)
+ CALL H5Dclose_f(dataset, error)
+ CALL CHECK(" H5Dclose_f", error, total_error)
+ CALL H5Fclose_f(file, error)
+ CALL CHECK(" H5Fclose_f", error, total_error)
+
+END SUBROUTINE test_scaleoffset
+
+END MODULE TH5MISC_1_8
diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90
index ea91631..8672e3c 100644
--- a/fortran/test/tH5O.f90
+++ b/fortran/test/tH5O.f90
@@ -26,13 +26,17 @@
! test_h5o, test_h5o_link, test_h5o_plist
!
!*****
+MODULE TH5O
+
+CONTAINS
SUBROUTINE test_h5o(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER :: error
CALL test_h5o_plist(total_error) ! Test object creation properties
@@ -54,9 +58,10 @@ END SUBROUTINE test_h5o
SUBROUTINE test_h5o_link(total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T) :: file_id
INTEGER(HID_T) :: group_id
@@ -66,7 +71,6 @@ SUBROUTINE test_h5o_link(total_error)
INTEGER(HID_T) :: fapl_id
INTEGER(HID_T) :: lcpl_id
INTEGER(HID_T) :: ocpypl_id
- INTEGER(HID_T) :: mem_space_id, file_space_id, xfer_prp
CHARACTER(LEN=11), PARAMETER :: TEST_FILENAME = 'TestFile.h5'
INTEGER, PARAMETER :: TEST6_DIM1 = 2, TEST6_DIM2 = 5
!EP INTEGER(HSIZE_T), DIMENSION(1:2), PARAMETER :: dims = (/TEST6_DIM1,TEST6_DIM2/)
@@ -74,11 +78,11 @@ SUBROUTINE test_h5o_link(total_error)
!EP INTEGER, DIMENSION(1:TEST6_DIM1,1:TEST6_DIM2) :: wdata, rdata
INTEGER, DIMENSION(TEST6_DIM1,TEST6_DIM2) :: wdata, rdata
- INTEGER, PARAMETER :: TRUE = 1, FALSE = 0
+ INTEGER, PARAMETER :: TRUE = 1
LOGICAL :: committed ! /* Whether the named datatype is committed
- INTEGER :: i, n, j
+ INTEGER :: i, j
INTEGER :: error ! /* Value returned from API calls
CHARACTER(LEN=14) :: NAME_DATATYPE_SIMPLE="H5T_NATIVE_INT"
@@ -91,8 +95,7 @@ SUBROUTINE test_h5o_link(total_error)
INTEGER , PARAMETER :: dim0 = 4
INTEGER(HSIZE_T), DIMENSION(1:1) :: dims2 = (/dim0/) ! size read/write buffer
- INTEGER , DIMENSION(1:dim0) :: wdata2, & ! Write buffer
- rdata2 ! Read buffer
+ INTEGER , DIMENSION(1:dim0) :: wdata2 ! Write buffer
LOGICAL :: link_exists
CHARACTER(LEN=8) :: chr_exact
CHARACTER(LEN=10) :: chr_lg
@@ -576,9 +579,10 @@ END SUBROUTINE test_h5o_link
SUBROUTINE test_h5o_plist(total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(hid_t) :: fid ! HDF5 File ID
INTEGER(hid_t) :: grp, dset, dtype, dspace ! Object identifiers
@@ -789,3 +793,5 @@ SUBROUTINE test_h5o_plist(total_error)
CALL check("H5Pclose_f", error, total_error)
END SUBROUTINE test_h5o_plist
+
+END MODULE TH5O
diff --git a/fortran/test/tH5O_F03.f90 b/fortran/test/tH5O_F03.f90
index f060a7d..598e83e 100644
--- a/fortran/test/tH5O_F03.f90
+++ b/fortran/test/tH5O_F03.f90
@@ -112,6 +112,10 @@ CONTAINS
END MODULE visit_cb
+
+MODULE TH5O_F03
+
+CONTAINS
!/****************************************************************
!**
!** test_h5o_refcount(): Test H5O refcounting functions.
@@ -121,6 +125,7 @@ END MODULE visit_cb
SUBROUTINE test_h5o_refcount(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -259,6 +264,7 @@ END SUBROUTINE test_h5o_refcount
SUBROUTINE obj_visit(total_error)
USE HDF5
+ USE TH5_MISC
USE visit_cb
USE ISO_C_BINDING
@@ -268,7 +274,6 @@ SUBROUTINE obj_visit(total_error)
TYPE(ovisit_ud_t), TARGET :: udata ! User-data for visiting
INTEGER(hid_t) :: fid = -1
- INTEGER(hid_t) :: gid = -1 ! Group ID
TYPE(C_PTR) :: f_ptr
TYPE(C_FUNPTR) :: fun_ptr
CHARACTER(LEN=180) :: object_name
@@ -344,6 +349,7 @@ END SUBROUTINE obj_visit
SUBROUTINE obj_info(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -356,7 +362,6 @@ SUBROUTINE obj_info(total_error)
TYPE(hobj_ref_t_f), TARGET :: wref ! Reference to write
TYPE(hobj_ref_t_f), TARGET :: rref ! Reference to read
TYPE(H5O_info_t) :: oinfo ! Object info struct
- INTEGER :: count = 0 ! Count within iterated group
INTEGER :: error
TYPE(C_PTR) :: f_ptr
@@ -477,6 +482,7 @@ END SUBROUTINE obj_info
SUBROUTINE build_visit_file(fid)
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
INTEGER(hid_t) :: fid ! File ID
@@ -545,3 +551,5 @@ SUBROUTINE build_visit_file(fid)
CALL H5Tclose_f(tid, error)
END SUBROUTINE build_visit_file
+
+END MODULE TH5O_F03
diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90
index 4c78334..c94d564 100644
--- a/fortran/test/tH5P.f90
+++ b/fortran/test/tH5P.f90
@@ -26,6 +26,9 @@
! external_test, multi_file_test
!
!*****
+MODULE TH5P
+
+CONTAINS
SUBROUTINE external_test(cleanup, total_error)
@@ -34,10 +37,11 @@ SUBROUTINE external_test(cleanup, total_error)
! h5pget_external_f
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=8), PARAMETER :: filename = "external"
CHARACTER(LEN=80) :: fix_filename
@@ -150,10 +154,11 @@ END SUBROUTINE external_test
SUBROUTINE multi_file_test(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=9), PARAMETER :: filename = "multidset" ! File name
CHARACTER(LEN=80) :: fix_filename
@@ -419,15 +424,15 @@ END SUBROUTINE multi_file_test
SUBROUTINE test_chunk_cache(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=14), PARAMETER :: filename="chunk_cache"
CHARACTER(LEN=80) :: fix_filename
INTEGER(hid_t) :: fid = -1 ! File ID
- INTEGER(hid_t) :: file
INTEGER(hid_t) :: fapl_local = -1 ! Local fapl
INTEGER(hid_t) :: fapl_def = -1 ! Default fapl
INTEGER(hid_t) :: dcpl = -1 ! Dataset creation property list ID
@@ -445,6 +450,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
INTEGER(size_t) rdcc_nelmts
INTEGER(size_t) rdcc_nbytes
REAL :: rdcc_w0
+ LOGICAL :: differ
CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
@@ -468,7 +474,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_1), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_1), INT(nbytes_4), total_error)
- IF(w0_1.NE.w0_4)THEN
+
+ IF( .NOT.dreal_eq( REAL(w0_1,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
@@ -526,7 +533,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF(w0_2.NE.w0_4)THEN
+ IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -558,7 +565,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF(w0_3.NE.w0_4)THEN
+ IF( .NOT.dreal_eq( REAL(w0_3,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f4", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -578,7 +585,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF(w0_2.NE.w0_4)THEN
+ IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -598,7 +605,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF(w0_2.NE.w0_4)THEN
+ IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
! Don't close dapl2, we will use it in the next section
@@ -635,7 +642,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF(w0_2.NE.w0_4)THEN
+ IF( .NOT.dreal_eq( REAL(w0_2,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
@@ -660,7 +667,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- IF(w0_3.NE.w0_4)THEN
+ IF( .NOT.dreal_eq( REAL(w0_3,dp), REAL( w0_4, dp)) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
@@ -687,3 +694,5 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("h5_cleanup_f", error, total_error)
END SUBROUTINE test_chunk_cache
+
+END MODULE TH5P
diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90
index 02ca9dc..6039a52 100644
--- a/fortran/test/tH5P_F03.f90
+++ b/fortran/test/tH5P_F03.f90
@@ -34,7 +34,6 @@
! *****************************************
! *** H 5 P T E S T S
! *****************************************
-
MODULE test_genprop_cls_cb1_mod
! Callback subroutine for test_genprop_class_callback
@@ -70,6 +69,10 @@ CONTAINS
END MODULE test_genprop_cls_cb1_mod
+MODULE TH5P_F03
+
+CONTAINS
+
!/*-------------------------------------------------------------------------
! * Function: test_create
! *
@@ -90,6 +93,7 @@ END MODULE test_genprop_cls_cb1_mod
SUBROUTINE test_create(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -97,8 +101,7 @@ SUBROUTINE test_create(total_error)
INTEGER(HID_T) :: fapl
INTEGER(hid_t) :: file=-1, space=-1, dcpl=-1, comp_type_id=-1
- INTEGER(hid_t) :: dset1=-1, dset2=-1, dset3=-1, dset4=-1, dset5=-1, &
- dset6=-1, dset7=-1, dset8=-1, dset9=-1
+ INTEGER(hid_t) :: dset9=-1
INTEGER(hsize_t), DIMENSION(1:5), PARAMETER :: cur_size = (/2, 8, 8, 4, 2/)
INTEGER(hsize_t), DIMENSION(1:5), PARAMETER :: ch_size= (/1, 1, 1, 4, 1/)
CHARACTER(LEN=14) :: filename ='test_create.h5'
@@ -112,15 +115,10 @@ SUBROUTINE test_create(total_error)
END TYPE comp_datatype
TYPE(comp_datatype), TARGET :: rd_c, fill_ctype
-
- INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype
- INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype
- INTEGER(SIZE_T) :: type_sized ! Size of the double datatype
- INTEGER(SIZE_T) :: type_sizec ! Size of the double datatype
- INTEGER(SIZE_T) :: sizeof_compound ! total size of compound
INTEGER :: error
INTEGER(SIZE_T) :: h5off
TYPE(C_PTR) :: f_ptr
+ LOGICAL :: differ1, differ2
!/*
! * Create a file.
@@ -166,7 +164,7 @@ SUBROUTINE test_create(total_error)
CALL H5Pget_fill_value_f(dcpl, comp_type_id, f_ptr, error)
CALL check("H5Pget_fill_value_f",error, total_error)
- fill_ctype%y = 4444.
+ fill_ctype%y = 4444.D0
fill_ctype%z = 'S'
fill_ctype%a = 5555.
fill_ctype%x = 55
@@ -207,10 +205,10 @@ SUBROUTINE test_create(total_error)
CALL H5Pget_fill_value_f(dcpl, comp_type_id, f_ptr, error)
CALL check("H5Pget_fill_value_f", error, total_error)
- IF( rd_c%a .NE. fill_ctype%a .OR. &
- rd_c%y .NE. fill_ctype%y .OR. &
- rd_c%x .NE. fill_ctype%x .OR. &
- rd_c%z .NE. fill_ctype%z )THEN
+ IF( .NOT.dreal_eq( REAL(rd_c%a,dp), REAL(fill_ctype%a, dp)) .OR. &
+ .NOT.dreal_eq( REAL(rd_c%y,dp), REAL(fill_ctype%y, dp)) .OR. &
+ rd_c%x .NE. fill_ctype%x .OR. &
+ rd_c%z .NE. fill_ctype%z )THEN
PRINT*,"***ERROR: Returned wrong fill value"
total_error = total_error + 1
@@ -231,17 +229,18 @@ END SUBROUTINE test_create
SUBROUTINE test_genprop_class_callback(total_error)
- !/****************************************************************
- !**
- !** test_genprop_class_callback(): Test basic generic property list code.
- !** Tests callbacks for property lists in a generic class.
- !**
- !** FORTRAN TESTS:
- !** Tests function H5Pcreate_class_f with callback.
- !**
- !****************************************************************/
+ !
+ !
+ ! test_genprop_class_callback(): Test basic generic property list code.
+ ! Tests callbacks for property lists in a generic class.
+ !
+ ! FORTRAN TESTS:
+ ! Tests function H5Pcreate_class_f with callback.
+ !
+ !
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
USE test_genprop_cls_cb1_mod
IMPLICIT NONE
@@ -261,8 +260,8 @@ SUBROUTINE test_genprop_class_callback(total_error)
TYPE(cb_struct), TARGET :: crt_cb_struct, cls_cb_struct
CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1"
- TYPE(C_FUNPTR) :: f1, f3, f5
- TYPE(C_PTR) :: f2, f4, f6
+ TYPE(C_FUNPTR) :: f1, f5
+ TYPE(C_PTR) :: f2, f6
CHARACTER(LEN=10) :: PROP1_NAME = "Property 1"
INTEGER(SIZE_T) :: PROP1_SIZE = 10
@@ -364,6 +363,79 @@ SUBROUTINE test_genprop_class_callback(total_error)
END SUBROUTINE test_genprop_class_callback
!-------------------------------------------------------------------------
+! Function: test_h5p_file_image
+!
+! Purpose: Tests APIs:
+! h5pget_file_image_f and h5pset_file_image_f
+!
+! Return: Success: 0
+! Failure: -1
+!
+! FORTRAN Programmer: M. Scot Breitenfeld
+! April 1, 2014
+!-------------------------------------------------------------------------
+
+SUBROUTINE test_h5p_file_image(total_error)
+
+ USE HDF5
+ USE TH5_MISC
+ USE, INTRINSIC :: iso_c_binding
+ IMPLICIT NONE
+ INTEGER, INTENT(INOUT) :: total_error
+ INTEGER(hid_t) :: fapl_1 = -1
+ INTEGER, PARAMETER :: count = 10
+ INTEGER, DIMENSION(1:count), TARGET :: buffer
+ INTEGER, DIMENSION(1:count), TARGET :: temp
+ INTEGER :: i
+ INTEGER(size_t) :: size
+ INTEGER(size_t) :: temp_size
+ INTEGER :: error ! error return value
+ TYPE(C_PTR) :: f_ptr
+ TYPE(C_PTR), DIMENSION(1:count) :: f_ptr1
+ TYPE(C_PTR), DIMENSION(1:1) :: f_ptr2
+
+ ! Initialize file image buffer
+ DO i = 1, count
+ buffer(i) = i*10
+ ENDDO
+
+ ! Create fapl
+ CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_1, error)
+ CALL check("h5pcreate_f", error, total_error)
+
+ ! Test with NULL ptr
+ f_ptr2(1) = C_NULL_PTR
+ temp_size = 1
+ CALL h5pget_file_image_f(fapl_1, f_ptr2, temp_size, error)
+ CALL check("h5pget_file_image_f", error, total_error)
+ CALL verify("h5pget_file_image_f", INT(temp_size), 0, total_error)
+
+ ! Set file image
+ f_ptr = C_LOC(buffer(1))
+ size = SIZEOF(buffer)
+ CALL h5pset_file_image_f(fapl_1, f_ptr, size, error)
+ CALL check("h5pset_file_image_f", error, total_error)
+
+ ! Get the same data back
+ DO i = 1, count
+ f_ptr1(i) = C_LOC(temp(i))
+ ENDDO
+
+ temp_size = 0
+ CALL h5pget_file_image_f(fapl_1, f_ptr1, temp_size, error)
+ CALL check("h5pget_file_image_f", error, total_error)
+
+ ! Check that sizes are the same, and that the buffers are identical but separate
+ CALL VERIFY("h5pget_file_image_f", INT(temp_size), INT(size), total_error)
+
+ ! Verify the image data is correct
+ DO i = 1, count
+ CALL VERIFY("h5pget_file_image_f", temp(i), buffer(i), total_error)
+ ENDDO
+
+END SUBROUTINE test_h5p_file_image
+
+!-------------------------------------------------------------------------
! Function: external_test_offset
!
! Purpose: Tests APIs:
@@ -379,10 +451,11 @@ END SUBROUTINE test_genprop_class_callback
SUBROUTINE external_test_offset(cleanup,total_error)
USE ISO_C_BINDING
+ USE TH5_MISC
USE HDF5 ! This module contains all necessary modules
IMPLICIT NONE
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
LOGICAL, INTENT(IN) :: cleanup
INTEGER(hid_t) :: fapl=-1 ! file access property list
@@ -475,7 +548,7 @@ SUBROUTINE external_test_offset(cleanup,total_error)
CALL h5sclose_f(hs_space, error)
CALL check("h5sclose_f", error, total_error)
- DO i = hs_start(1)+1, hs_start(1)+hs_count(1)
+ DO i = INT(hs_start(1))+1, INT(hs_start(1)+hs_count(1))
IF(whole(i) .NE. i-1)THEN
WRITE(*,*) "Incorrect value(s) read."
total_error = total_error + 1
@@ -503,3 +576,4 @@ SUBROUTINE external_test_offset(cleanup,total_error)
CALL check("h5_cleanup_f", error, total_error)
END SUBROUTINE external_test_offset
+END MODULE TH5P_F03
diff --git a/fortran/test/tH5R.f90 b/fortran/test/tH5R.f90
index ac105fc..bd6264f 100644
--- a/fortran/test/tH5R.f90
+++ b/fortran/test/tH5R.f90
@@ -31,11 +31,16 @@
!
!*****
!
+MODULE TH5R
+
+CONTAINS
+
SUBROUTINE refobjtest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=9), PARAMETER :: filename = "reference"
CHARACTER(LEN=80) :: fix_filename
@@ -66,7 +71,6 @@ SUBROUTINE refobjtest(cleanup, total_error)
CHARACTER(LEN=7) :: buf ! buffer to hold the region name
CHARACTER(LEN=16) :: buf_big ! buffer bigger then needed
- CHARACTER(LEN=4) :: buf_small ! buffer smaller then needed
INTEGER(SIZE_T) :: buf_size ! returned size of the region buffer name
!
@@ -241,11 +245,12 @@ END SUBROUTINE refobjtest
!
SUBROUTINE refregtest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
! use iso_c_binding ! NOTE: if this is uncommented, then need to move subroutine into another file.
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=6), PARAMETER :: filename = "Refreg"
CHARACTER(LEN=80) :: fix_filename
@@ -478,3 +483,4 @@ SUBROUTINE refregtest(cleanup, total_error)
END SUBROUTINE refregtest
+END MODULE TH5R
diff --git a/fortran/test/tH5S.f90 b/fortran/test/tH5S.f90
index e3a44ad..eaaf29a 100644
--- a/fortran/test/tH5S.f90
+++ b/fortran/test/tH5S.f90
@@ -33,14 +33,18 @@
! dataspace_basic_test
!
!*****
+MODULE TH5S
+
+CONTAINS
SUBROUTINE dataspace_basic_test(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=10), PARAMETER :: filename1 = "basicspace" ! File1 name
CHARACTER(LEN=9), PARAMETER :: filename2 = "copyspace" ! File2 name
@@ -289,3 +293,4 @@
RETURN
END SUBROUTINE dataspace_basic_test
+END MODULE TH5S
diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90
index 1cbabe8..ba68d62 100644
--- a/fortran/test/tH5Sselect.f90
+++ b/fortran/test/tH5Sselect.f90
@@ -36,14 +36,18 @@
!
!
!*****
+MODULE TH5SSELECT
+
+CONTAINS
SUBROUTINE test_select_hyperslab(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=7), PARAMETER :: filename = "tselect"
CHARACTER(LEN=80) :: fix_filename
@@ -319,10 +323,11 @@
SUBROUTINE test_select_element(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
!
!the dataset1 is stored in file "copy1.h5"
@@ -695,10 +700,11 @@
SUBROUTINE test_basic_select(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
!
!the dataset is stored in file "testselect.h5"
@@ -805,8 +811,6 @@
INTEGER :: error
INTEGER(HSIZE_T), DIMENSION(3) :: data_dims
- INTEGER :: i
-
!
!initialize the coord array to give the selected points' position
!
@@ -1033,10 +1037,11 @@
SUBROUTINE test_select_point(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T) :: xfer_plist
INTEGER, PARAMETER :: SPACE1_DIM1=3
@@ -1073,10 +1078,10 @@ SUBROUTINE test_select_point(cleanup, total_error)
!!$ *tbuf; /* temporary buffer pointer */
INTEGER :: i,j; !/* Counters */
! struct pnt_iter pi; /* Custom Pointer iterator struct */
- INTEGER :: error !/* Generic return value */
+ INTEGER :: error !/* Generic return value */
CHARACTER(LEN=9) :: filename = 'h5s_hyper'
CHARACTER(LEN=80) :: fix_filename
- CHARACTER(LEN=1), DIMENSION(1:SPACE2_DIM1,1:SPACE2_DIM2) :: wbuf, rbuf
+ CHARACTER(LEN=1), DIMENSION(1:SPACE2_DIM1,1:SPACE2_DIM2) :: wbuf
CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
IF (error .NE. 0) THEN
@@ -1357,12 +1362,12 @@ END SUBROUTINE test_select_point
!**
!****************************************************************/
-SUBROUTINE test_select_combine(cleanup, total_error)
+SUBROUTINE test_select_combine(total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER, PARAMETER :: SPACE7_RANK = 2
INTEGER, PARAMETER :: SPACE7_DIM1 = 10
@@ -1779,12 +1784,12 @@ END SUBROUTINE test_select_combine
!**
!****************************************************************/
-SUBROUTINE test_select_bounds(cleanup, total_error)
+SUBROUTINE test_select_bounds(total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
INTEGER, PARAMETER :: SPACE11_RANK=2
INTEGER, PARAMETER :: SPACE11_DIM1=100
@@ -1860,8 +1865,8 @@ SUBROUTINE test_select_bounds(cleanup, total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 3, total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 3, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), SPACE11_DIM1-4, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), SPACE11_DIM2-4, total_error)
+ CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-4), total_error)
+ CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-4), total_error)
! /* Set bad offset for selection */
@@ -1884,8 +1889,8 @@ SUBROUTINE test_select_bounds(cleanup, total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(1)), 5, total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(low_bounds(2)), 1, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), SPACE11_DIM1-2, total_error)
- CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), SPACE11_DIM2-6, total_error)
+ CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-2), total_error)
+ CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-6), total_error)
! /* Reset offset for selection */
offset(1:2) = 0
@@ -1991,3 +1996,5 @@ SUBROUTINE test_select_bounds(cleanup, total_error)
CALL check("h5sclose_f", error, total_error)
END SUBROUTINE test_select_bounds
+
+END MODULE TH5SSELECT
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index b42a8e6..8ac91d2 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -27,6 +27,10 @@
!
!*****
+MODULE TH5T
+
+CONTAINS
+
SUBROUTINE compoundtest(cleanup, total_error)
!
! This program creates a dataset that is one dimensional array of
@@ -43,8 +47,8 @@
! h5tget_class_f, h5tget_member_name_f, h5tget_member_offset_f, h5tget_member_type_f,
! h5tequal_f, h5tinsert_array_f, h5tcommit_f, h5tencode_f, h5tdecode_f
-
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -105,11 +109,10 @@
CHARACTER(LEN=1024) :: cmpd_buf
INTEGER(SIZE_T) :: cmpd_buf_size=0
- INTEGER(HID_T) :: decoded_sid1
INTEGER(HID_T) :: decoded_tid1
INTEGER(HID_T) :: fixed_str1, fixed_str2
- LOGICAL :: are_equal
+ LOGICAL :: are_equal, differ
INTEGER(SIZE_T), PARAMETER :: str_size = 10
INTEGER(SIZE_T) :: query_size
@@ -242,36 +245,6 @@
offset = offset + type_sized ! Offset of the last member is 14
CALL h5tinsert_f(dtype_id, "real_field", offset, H5T_NATIVE_REAL, error)
CALL check("h5tinsert_f", error, total_error)
-
-!!$ !/*-----------------------------------------------------------------------
-!!$ ! * Test encoding and decoding compound datatypes
-!!$ ! *-----------------------------------------------------------------------
-!!$ !*/
-!!$ ! /* Encode compound type in a buffer */
-!!$
-!!$ ! First find the buffer size
-!!$
-!!$ CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error)
-!!$ CALL check("H5Tencode_f", error, total_error)
-!!$
-!!$ ! /* Try decoding bogus buffer */
-!!$
-!!$ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error)
-!!$ CALL VERIFY("H5Tdecode_f", error, -1, total_error)
-!!$
-!!$ CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error)
-!!$ CALL check("H5Tencode_f", error, total_error)
-!!$
-!!$ ! /* Decode from the compound buffer and return an object handle */
-!!$ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error)
-!!$ CALL check("H5Tdecode_f", error, total_error)
-!!$
-!!$ ! /* Verify that the datatype was copied exactly */
-!!$
-!!$ CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error)
-!!$ CALL check("H5Tequal_f", error, total_error)
-!!$ CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
-
!
! Create the dataset with compound datatype.
!
@@ -555,7 +528,7 @@
CALL h5dread_f(dset_id, dt3_id, double_member_out, data_dims, error)
CALL check("h5dread_f", error, total_error)
do i = 1, dimsize
- if (double_member_out(i) .ne. double_member(i)) then
+ IF( .NOT.dreal_eq( REAL(double_member_out(i),dp), REAL( double_member(i), dp)) ) THEN
write(*,*) " Wrong double precision data is read back "
total_error = total_error + 1
endif
@@ -572,12 +545,12 @@
!
CALL h5dread_f(dset_id, dt4_id, real_member_out, data_dims, error)
CALL check("h5dread_f", error, total_error)
- do i = 1, dimsize
- if (real_member_out(i) .ne. real_member(i)) then
- write(*,*) " Wrong real precision data is read back "
- total_error = total_error + 1
- endif
- enddo
+ DO i = 1, dimsize
+ IF( .NOT.dreal_eq( REAL(real_member_out(i),dp), REAL( real_member(i), dp)) ) THEN
+ WRITE(*,*) " Wrong real precision data is read back "
+ total_error = total_error + 1
+ ENDIF
+ ENDDO
!
! *-----------------------------------------------------------------------
! * Test encoding and decoding compound datatypes
@@ -632,7 +605,7 @@
- SUBROUTINE basic_data_type_test(cleanup, total_error)
+ SUBROUTINE basic_data_type_test(total_error)
! This subroutine tests following functionalities:
! H5tget_precision_f, H5tset_precision_f, H5tget_offset_f
@@ -642,9 +615,9 @@
! H5tset_cset_f, H5tget_strpad_f, H5tset_strpad_f
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
INTEGER(HID_T) :: dtype1_id, dtype2_id, dtype3_id, dtype4_id, dtype5_id
@@ -859,6 +832,7 @@
SUBROUTINE enumtest(cleanup, total_error)
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -999,6 +973,7 @@
SUBROUTINE test_derived_flt(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -1181,3 +1156,5 @@ SUBROUTINE test_derived_flt(cleanup, total_error)
CALL check("h5_cleanup_f", error, total_error)
END SUBROUTINE test_derived_flt
+
+END MODULE TH5T
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90
index a9a6487..fc3ebd0 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.f90
@@ -41,15 +41,23 @@
!**
!****************************************************************/
!
+
+MODULE TH5T_F03
+
+ USE HDF5
+ USE ISO_C_BINDING
+
+CONTAINS
+
SUBROUTINE test_array_compound_atomic(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
! 1-D dataset WITH fixed dimensions
- CHARACTER(LEN=6), PARAMETER :: SPACE1_NAME = "Space1"
INTEGER, PARAMETER :: SPACE1_RANK = 1
INTEGER, PARAMETER :: SPACE1_DIM1 = 4
! 1-D array datatype
@@ -63,11 +71,11 @@ SUBROUTINE test_array_compound_atomic(total_error)
END TYPE s1_t
TYPE(s1_t), DIMENSION(:,:), ALLOCATABLE, TARGET :: wdata ! Information to write
TYPE(s1_t), DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata ! Information read in
- INTEGER(hid_t) :: fid1 ! HDF5 File IDs
- INTEGER(hid_t) :: dataset ! Dataset ID
- INTEGER(hid_t) :: sid1 ! Dataspace ID
- INTEGER(hid_t) :: tid1 ! Array Datatype ID
- INTEGER(hid_t) :: tid2 ! Compound Datatype ID
+ INTEGER(hid_t) :: fid1 ! HDF5 File IDs
+ INTEGER(hid_t) :: dataset ! Dataset ID
+ INTEGER(hid_t) :: sid1 ! Dataspace ID
+ INTEGER(hid_t) :: tid1 ! Array Datatype ID
+ INTEGER(hid_t) :: tid2 ! Compound Datatype ID
INTEGER(HSIZE_T), DIMENSION(1) :: sdims1 = (/SPACE1_DIM1/)
INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/ARRAY1_DIM1/)
@@ -79,12 +87,8 @@ SUBROUTINE test_array_compound_atomic(total_error)
INTEGER(size_t) :: off ! Offset of compound field
INTEGER(hid_t) :: mtid ! Datatype ID for field
INTEGER :: i,j ! counting variables
- INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype
- INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype
- INTEGER(SIZE_T) :: sizeof_compound ! total size of compound
INTEGER :: error ! Generic RETURN value
- INTEGER(SIZE_T) :: offset ! Member's offset
INTEGER :: namelen
LOGICAL :: flag
@@ -254,7 +258,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF(wdata(i,j)%f.NE.rdata(i,j)%f)THEN
+ IF( .NOT.dreal_eq( REAL(wdata(i,j)%f,dp), REAL( rdata(i,j)%f, dp)) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -285,6 +289,7 @@ END SUBROUTINE test_array_compound_atomic
SUBROUTINE test_array_compound_array(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -310,14 +315,13 @@ END SUBROUTINE test_array_compound_atomic
TYPE(st_t_struct), DIMENSION(1:SPACE1_DIM1,1:ARRAY1_DIM1), TARGET :: rdata
- INTEGER(hid_t) :: fid1 ! HDF5 File IDs
- INTEGER(hid_t) :: dataset ! Dataset ID
+ INTEGER(hid_t) :: fid1 ! HDF5 File IDs
+ INTEGER(hid_t) :: dataset ! Dataset ID
integer(hid_t) :: sid1 ! Dataspace ID
integer(hid_t) :: tid1 ! Array Datatype ID
integer(hid_t) :: tid2 ! Compound Datatype ID
integer(hid_t) :: tid3 ! Nested Array Datatype ID
integer(hid_t) :: tid4 ! Nested Array Datatype ID
- INTEGER(HID_T) :: dt5_id ! Memory datatype identifier
INTEGER(HSIZE_T), DIMENSION(1) :: sdims1 = (/SPACE1_DIM1/)
INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/ARRAY1_DIM1/)
@@ -326,25 +330,18 @@ END SUBROUTINE test_array_compound_atomic
INTEGER ndims ! Array rank for reading
INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading
- INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims ! Array dimensions for reading
INTEGER :: nmemb ! Number of compound members
CHARACTER(LEN=20) :: mname ! Name of compound field
INTEGER(size_t) :: off ! Offset of compound field
- INTEGER(size_t) :: offset ! Offset of compound field
INTEGER(hid_t) :: mtid ! Datatype ID for field
INTEGER(hid_t) :: mtid2 ! Datatype ID for field
- INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype
- INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype
- INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype
- INTEGER(SIZE_T) :: sizeof_compound ! total size of compound
INTEGER :: mclass ! Datatype class for field
INTEGER :: i,j,k ! counting variables
INTEGER :: error
CHARACTER(LEN=2) :: ichr2
- INTEGER(SIZE_T) :: sizechar
INTEGER :: namelen
LOGICAL :: flag
INTEGER(HID_T) :: atype_id !String Attribute Datatype identifier
@@ -623,6 +620,7 @@ END SUBROUTINE test_array_compound_atomic
total_error = total_error + 1
ENDIF
DO k = 1, ARRAY2_DIM1
+
IF(wdata(i,j)%f(k).NE.rdata(i,j)%f(k))THEN
PRINT*, 'ERROR: Wrong real array data is read back by H5Dread_f '
total_error = total_error + 1
@@ -659,6 +657,7 @@ END SUBROUTINE test_array_compound_atomic
SUBROUTINE test_array_bkg(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -722,8 +721,6 @@ END SUBROUTINE test_array_compound_atomic
INTEGER :: error
TYPE(c_ptr) :: f_ptr
- TYPE(c_funptr) :: func
-
! Initialize the data
! -------------------
@@ -834,11 +831,11 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( cf(i)%b(j) .NE. cfr(i)%b(j) )THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%b(j),dp), REAL( cfr(i)%b(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( cf(i)%c(j) .NE. cfr(i)%c(j) )THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%c(j),dp), REAL( cfr(i)%c(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -901,7 +898,7 @@ END SUBROUTINE test_array_compound_atomic
DO i = 1, LENGTH
DO j = 1, ALEN
- IF( fld(i)%b(j) .NE. fldr(i)%b(j) )THEN
+ IF( .NOT.dreal_eq( REAL(fld(i)%b(j),dp), REAL( fldr(i)%b(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -932,11 +929,11 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( cf(i)%b(j) .NE. cfr(i)%b(j) )THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%b(j),dp), REAL(cfr(i)%b(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( cf(i)%c(j) .NE. cfr(i)%c(j) )THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%c(j),dp), REAL(cfr(i)%c(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -990,11 +987,11 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( cf(i)%b(j) .NE. cfr(i)%b(j) )THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%b(j),dp), REAL(cfr(i)%b(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- IF( cf(i)%c(j) .NE. cfr(i)%c(j) )THEN
+ IF( .NOT.dreal_eq( REAL(cf(i)%c(j),dp), REAL(cfr(i)%c(j), dp)) ) THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -1018,6 +1015,7 @@ END SUBROUTINE test_array_compound_atomic
USE ISO_C_BINDING
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
@@ -1050,12 +1048,10 @@ END SUBROUTINE test_array_compound_atomic
INTEGER(HID_T) :: dset_idr8 ! Dataset identifier
INTEGER :: error ! Error flag
- INTEGER :: i, j
+ INTEGER :: i
! Data buffers:
- INTEGER, DIMENSION(1:4) :: dset_data
-
INTEGER(int_kind_1), DIMENSION(1:4), TARGET :: dset_data_i1, data_out_i1
INTEGER(int_kind_4), DIMENSION(1:4), TARGET :: dset_data_i4, data_out_i4
INTEGER(int_kind_8), DIMENSION(1:4), TARGET :: dset_data_i8, data_out_i8
@@ -1069,7 +1065,6 @@ END SUBROUTINE test_array_compound_atomic
INTEGER(HID_T) :: dspace_id ! Dataspace identifier
TYPE(C_PTR) :: f_ptr
- INTEGER(hid_t) :: datatype ! Common datatype ID
!
! Initialize the dset_data array.
@@ -1179,7 +1174,7 @@ END SUBROUTINE test_array_compound_atomic
CALL verify_Fortran_INTEGER_4("h5kind_to_type2",INT(dset_data_i4(i),int_kind_8),INT(data_out_i4(i),int_kind_8),total_error)
CALL verify_Fortran_INTEGER_4("h5kind_to_type3",INT(dset_data_i8(i),int_kind_8),INT(data_out_i8(i),int_kind_8),total_error)
CALL verify_Fortran_INTEGER_4("h5kind_to_type4",INT(dset_data_i16(i),int_kind_8),INT(data_out_i16(i),int_kind_8),total_error)
-
+
CALL verify_real_kind_7("h5kind_to_type5",REAL(dset_data_r(i),real_kind_7),REAL(data_out_r(i),real_kind_7),total_error)
CALL verify_real_kind_7("h5kind_to_type6",REAL(dset_data_r7(i),real_kind_7),REAL(data_out_r7(i),real_kind_7),total_error)
CALL verify_real_kind_7("h5kind_to_type7",REAL(dset_data_r15(i),real_kind_7),REAL(data_out_r15(i),real_kind_7),total_error)
@@ -1220,8 +1215,9 @@ END SUBROUTINE test_h5kind_to_type
!************************************************************
SUBROUTINE t_array(total_error)
- USE HDF5
USE ISO_C_BINDING
+ USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
@@ -1233,10 +1229,8 @@ SUBROUTINE t_array(total_error)
INTEGER , PARAMETER :: adim0 = 3
INTEGER , PARAMETER :: adim1 = 5
INTEGER(HID_T) :: file, filetype, memtype, space, dset ! Handles
- INTEGER :: hdferr
INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/)
INTEGER(HSIZE_T), DIMENSION(1:2) :: adims = (/adim0, adim1/)
- INTEGER(HSIZE_T), DIMENSION(1:3) :: bdims = (/dim0, adim0, adim1/)
INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims
INTEGER, DIMENSION(1:dim0, 1:adim0, 1:adim1), TARGET :: wdata ! Write buffer
INTEGER, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: rdata ! Read buffer
@@ -1337,9 +1331,9 @@ SUBROUTINE t_array(total_error)
!
! Output the data to the screen.
!
- i_loop: DO i = 1, dims(1)
- DO j=1, adim0
- DO k = 1, adim1
+ i_loop: DO i = 1, INT(dims(1))
+ DO j=1, INT(adim0)
+ DO k = 1, INT(adim1)
CALL VERIFY("H5Sget_simple_extent_dims_f", rdata(i,j,k), wdata(i,j,k), total_error)
IF(total_error.NE.0) EXIT i_loop
ENDDO
@@ -1365,6 +1359,7 @@ END SUBROUTINE t_array
SUBROUTINE t_enum(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -1497,8 +1492,8 @@ SUBROUTINE t_enum(total_error)
!
! Output the data to the screen.
!
- i_loop: DO i = 1, dims(1)
- DO j = 1, dims(2)
+ i_loop: DO i = 1, INT(dims(1))
+ DO j = 1, INT(dims(2))
!
! Get the name of the enumeration member.
!
@@ -1527,6 +1522,7 @@ END SUBROUTINE t_enum
SUBROUTINE t_bit(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -1617,8 +1613,8 @@ SUBROUTINE t_bit(total_error)
!
! Output the data to the screen.
!
- i_loop: DO i = 1, dims(1)
- DO j = 1, dims(2)
+ i_loop: DO i = 1, INT(dims(1))
+ DO j = 1, INT(dims(2))
A = IAND(rdata(i,j), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "A"
B = IAND(ISHFT(rdata(i,j),-2), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "B"
C = IAND(ISHFT(rdata(i,j),-4), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "C"
@@ -1652,6 +1648,7 @@ END SUBROUTINE t_bit
SUBROUTINE t_opaque(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -1675,7 +1672,7 @@ SUBROUTINE t_opaque(total_error)
INTEGER :: taglen
INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims
- INTEGER :: i
+ INTEGER(hsize_t) :: i
CHARACTER(LEN=1) :: ichr
TYPE(C_PTR) :: f_ptr
INTEGER :: error
@@ -1799,6 +1796,7 @@ END SUBROUTINE t_opaque
SUBROUTINE t_objref(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -1905,7 +1903,7 @@ SUBROUTINE t_objref(total_error)
!
! Output the data to the screen.
!
- DO i = 1, maxdims(1)
+ DO i = 1, INT(maxdims(1))
!
! Open the referenced object, get its name and type.
!
@@ -1951,6 +1949,7 @@ END SUBROUTINE t_objref
SUBROUTINE t_regref(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -1984,7 +1983,7 @@ SUBROUTINE t_regref(total_error)
CHARACTER(LEN=80),DIMENSION(1:1), TARGET :: rdata2
CHARACTER(LEN=80) :: name
- INTEGER :: i
+ INTEGER(hsize_t) :: i
TYPE(C_PTR) :: f_ptr
CHARACTER(LEN=ds2dim0) :: chrvar
CHARACTER(LEN=20), DIMENSION(1:2) :: chrref_correct
@@ -2150,6 +2149,7 @@ END SUBROUTINE t_regref
SUBROUTINE t_vlen(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -2159,7 +2159,7 @@ SUBROUTINE t_vlen(total_error)
CHARACTER(LEN=3) , PARAMETER :: dataset = "DS1"
INTEGER, PARAMETER :: LEN0 = 3
INTEGER, PARAMETER :: LEN1 = 12
- INTEGER :: dim0
+ INTEGER(hsize_t) :: dim0
INTEGER(HID_T) :: file, filetype, memtype, space, dset ! Handles
INTEGER :: error
@@ -2266,7 +2266,7 @@ SUBROUTINE t_vlen(total_error)
dim0 = dims(1)
CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
CALL check("H5Sget_simple_extent_dims_f",error, total_error)
- CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), dim0, total_error)
+ CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), INT(dim0), total_error)
!
! Create the memory datatype.
@@ -2281,7 +2281,7 @@ SUBROUTINE t_vlen(total_error)
CALL H5Dread_f(dset, memtype, f_ptr, error)
CALL check("H5Dread_f",error, total_error)
- DO i = 1, dims(1)
+ DO i = 1, INT(dims(1))
CALL c_f_pointer(rdata(i)%p, ptr_r, [rdata(i)%len] )
DO j = 1, rdata(i)%len
CALL VERIFY("t_vlen", ptr_r(j), ptr(i)%data(j), total_error)
@@ -2307,6 +2307,7 @@ END SUBROUTINE t_vlen
SUBROUTINE t_vlstring(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -2328,7 +2329,7 @@ SUBROUTINE t_vlstring(total_error)
CHARACTER(LEN=sdim), DIMENSION(:), ALLOCATABLE :: rdata ! Read buffer
INTEGER(HSIZE_T), DIMENSION(2) :: data_dims = (/sdim,dim0/)
INTEGER(SIZE_T), DIMENSION(4) :: str_len = (/7,7,5,7/)
- INTEGER :: i
+ INTEGER(hsize_t) :: i
!
! Create a new file using the default properties.
@@ -2427,6 +2428,7 @@ SUBROUTINE t_vlstring_readwrite(total_error)
! test writing and reading vl string using h5dread_f and h5dwrite_f, C_LOC and C_F_POINTER
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -2439,7 +2441,6 @@ SUBROUTINE t_vlstring_readwrite(total_error)
INTEGER(HSIZE_T) , PARAMETER :: dim0 = 4
INTEGER(HSIZE_T) , PARAMETER :: dim1 = 2
- INTEGER(SIZE_T) , PARAMETER :: sdim = 7
INTEGER(HID_T) :: file, filetype, space, dset ! Handles
INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/)
INTEGER(HSIZE_T), DIMENSION(1:2) :: dims2D = (/dim1,dim0/)
@@ -2468,7 +2469,8 @@ SUBROUTINE t_vlstring_readwrite(total_error)
CHARACTER(len=8, kind=c_char), DIMENSION(1:4) :: data_w ! A pointer to a Fortran string
CHARACTER(len=8, kind=c_char), DIMENSION(1:dim1,1:dim0) :: data2D_w ! A pointer to a Fortran string
TYPE(C_PTR) :: f_ptr
- INTEGER :: i, j, len
+ INTEGER(hsize_t) :: i, j
+ INTEGER :: len
INTEGER :: error
! Initialize array of C pointers
@@ -2677,6 +2679,7 @@ END SUBROUTINE t_vlstring_readwrite
SUBROUTINE t_string(total_error)
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -2697,7 +2700,7 @@ SUBROUTINE t_string(total_error)
CHARACTER(LEN=sdim), DIMENSION(1:dim0), TARGET :: &
wdata = (/"Parting", "is such", "sweet ", "sorrow."/)
CHARACTER(LEN=sdim), DIMENSION(:), ALLOCATABLE, TARGET :: rdata
- INTEGER :: i
+ INTEGER(hsize_t) :: i
INTEGER(SIZE_T) :: size
TYPE(C_PTR) :: f_ptr
!
@@ -2800,23 +2803,23 @@ SUBROUTINE t_string(total_error)
END SUBROUTINE t_string
-SUBROUTINE vl_test_special_char(cleanup, total_error)
+SUBROUTINE vl_test_special_char(total_error)
- USE hdf5
+ USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
- INTERFACE
- SUBROUTINE setup_buffer(data_in, line_lengths, char_type)
- USE hdf5
- USE ISO_C_BINDING
- IMPLICIT NONE
- CHARACTER(len=*), DIMENSION(:) :: data_in
- INTEGER(size_t), DIMENSION(:) :: line_lengths
- CHARACTER(KIND=C_CHAR,LEN=*) :: char_type
- END SUBROUTINE setup_buffer
- END INTERFACE
+! INTERFACE
+! SUBROUTINE setup_buffer(data_in, line_lengths, char_type)
+! USE HDF5
+! USE ISO_C_BINDING
+! IMPLICIT NONE
+! CHARACTER(len=*), DIMENSION(:) :: data_in
+! INTEGER(size_t), DIMENSION(:) :: line_lengths
+! CHARACTER(KIND=C_CHAR,LEN=*) :: char_type
+! END SUBROUTINE setup_buffer
+! END INTERFACE
- LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
CHARACTER(LEN=16), PARAMETER :: filename = "t_controlchar.h5"
@@ -2967,14 +2970,14 @@ END SUBROUTINE setup_buffer
!-------------------------------------------------------------------------
!
-SUBROUTINE test_nbit(cleanup, total_error )
+SUBROUTINE test_nbit(total_error )
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
- LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
INTEGER(hid_t) :: file
@@ -2991,7 +2994,7 @@ SUBROUTINE test_nbit(cleanup, total_error )
INTEGER(size_t) :: PRECISION, offset
INTEGER :: error
LOGICAL :: status
- INTEGER(size_t) :: i, j
+ INTEGER(hsize_t) :: i, j
TYPE(C_PTR) :: f_ptr
! check to see if filter is available
@@ -3065,7 +3068,7 @@ SUBROUTINE test_nbit(cleanup, total_error )
i_loop: DO i = 1, dims(1)
j_loop: DO j = 1, dims(2)
IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN
- IF(new_data(i,j) .NE. orig_data(i,j))THEN
+ IF( .NOT.dreal_eq( REAL(new_data(i,j),dp), REAL( orig_data(i,j), dp)) ) THEN
total_error = total_error + 1
WRITE(*,'(" Read different values than written.")')
WRITE(*,'(" At index ", 2(1X,I0))') i, j
@@ -3114,6 +3117,7 @@ SUBROUTINE t_enum_conv(total_error)
!-------------------------------------------------------------------------
!
USE HDF5
+ USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE
@@ -3125,7 +3129,7 @@ SUBROUTINE t_enum_conv(total_error)
INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
- INTEGER(hid_t) :: cwg=-1, dtype=-1, space=-1, dset=-1, memtype ! Handles
+ INTEGER(hid_t) :: cwg=-1, dtype=-1, space=-1, dset=-1 ! Handles
INTEGER(hid_t) :: file ! Handles
! Enumerated type
@@ -3161,6 +3165,7 @@ SUBROUTINE t_enum_conv(total_error)
INTEGER(hsize_t), DIMENSION(1:1) :: ds_size = (/20/)
INTEGER(size_t) :: i
+ INTEGER(hsize_t) :: ih
INTEGER :: error
TYPE(C_PTR) :: f_ptr
INTEGER(HID_T) :: m_baset ! Memory base type
@@ -3223,10 +3228,10 @@ SUBROUTINE t_enum_conv(total_error)
CALL check(" h5dread_f", error, total_error)
! Check values
- DO i = 1, ds_size(1)
- IF(data1(i) .NE. data2(i))THEN
+ DO ih = 1, ds_size(1)
+ IF(data1(ih) .NE. data2(ih))THEN
total_error = total_error + 1
- WRITE(*,'(" 1. data1(",I0,")=",I0," .NE. data2(",I0,")=",I0)') i, data1(i),i,data2(i)
+ WRITE(*,'(" 1. data1(",I0,")=",I0," .NE. data2(",I0,")=",I0)') ih, data1(ih),i,data2(ih)
EXIT
ENDIF
ENDDO
@@ -3237,10 +3242,10 @@ SUBROUTINE t_enum_conv(total_error)
CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
CALL check("h5dread_f", error, total_error)
! Check values
- DO i = 1, ds_size(1)
- IF(data1(i) .NE. data_short(i))THEN
+ DO ih = 1, ds_size(1)
+ IF(data1(ih) .NE. data_short(ih))THEN
total_error = total_error + 1
- WRITE(*,'(" 2. data1(",I0,")=",I0," .NE. data_short(",I0,")=",I0)') i, data1(i),i,data_short(i)
+ WRITE(*,'(" 2. data1(",I0,")=",I0," .NE. data_short(",I0,")=",I0)') ih, data1(ih),i,data_short(ih)
EXIT
ENDIF
ENDDO
@@ -3253,11 +3258,11 @@ SUBROUTINE t_enum_conv(total_error)
CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
CALL check("h5dread_f", error, total_error)
! Check values
- DO i = 1, ds_size(1)
- IF(data1(i) .NE. INT(data_double(i)))THEN
+ DO ih = 1, ds_size(1)
+ IF(data1(ih) .NE. INT(data_double(ih)))THEN
total_error = total_error + 1
WRITE(*,'(" 3. data_double(",I0,")=",I0," .NE. data_double(",I0,")=",I0)') &
- i, INT(data1(i)), i, INT(data_double(i))
+ ih, INT(data1(ih)), ih, INT(data_double(ih))
EXIT
ENDIF
ENDDO
@@ -3270,11 +3275,11 @@ SUBROUTINE t_enum_conv(total_error)
CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
CALL check("h5dread_f", error, total_error)
! Check values
- DO i = 1, ds_size(1)
- IF(data1(i) .NE. INT(data_i8(i)))THEN
+ DO ih = 1, ds_size(1)
+ IF(data1(ih) .NE. INT(data_i8(ih)))THEN
total_error = total_error + 1
WRITE(*,'(" 4. data_i8(",I0,")=",I0," .NE. data_i8(",I0,")=",I0)') &
- i, INT(data1(i)), i, INT(data_i8(i))
+ ih, INT(data1(ih)), i, INT(data_i8(ih))
EXIT
ENDIF
ENDDO
@@ -3287,11 +3292,11 @@ SUBROUTINE t_enum_conv(total_error)
CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
CALL check("h5dread_f", error, total_error)
! Check values
- DO i = 1, ds_size(1)
- IF(data1(i) .NE. INT(data_i16(i)))THEN
+ DO ih = 1, ds_size(1)
+ IF(data1(ih) .NE. INT(data_i16(ih)))THEN
total_error = total_error + 1
WRITE(*,'(" 5. data_i16(",I0,")=",I0," .NE. data_i16(",I0,")=",I0)') &
- i, INT(data1(i)), i, INT(data_i16(i))
+ ih, INT(data1(ih)), i, INT(data_i16(ih))
EXIT
ENDIF
ENDDO
@@ -3304,11 +3309,11 @@ SUBROUTINE t_enum_conv(total_error)
CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
CALL check("h5dread_f", error, total_error)
! Check values
- DO i = 1, ds_size(1)
- IF(data1(i) .NE. INT(data_r7(i)))THEN
+ DO ih = 1, ds_size(1)
+ IF(data1(ih) .NE. INT(data_r7(ih)))THEN
total_error = total_error + 1
WRITE(*,'(" 6. data_r7(",I0,")=",I0," .NE. data_r7(",I0,")=",I0)') &
- i, INT(data1(i)), i, INT(data_r7(i))
+ ih, INT(data1(ih)), i, INT(data_r7(ih))
EXIT
ENDIF
ENDDO
@@ -3335,10 +3340,10 @@ SUBROUTINE t_enum_conv(total_error)
CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
CALL check("h5dread_f", error, total_error)
- DO i = 1, ds_size(1)
- IF(data1(i) .NE. data_int(i))THEN
+ DO ih = 1, ds_size(1)
+ IF(data1(ih) .NE. data_int(ih))THEN
total_error = total_error + 1
- WRITE(*,'(" 7. data1(",I0,")=",I0," .NE. data_int(",I0,")=",I0)') i, data1(i),i,data_int(i)
+ WRITE(*,'(" 7. data1(",I0,")=",I0," .NE. data_int(",I0,")=",I0)') ih, data1(ih),i,data_int(ih)
EXIT
ENDIF
ENDDO
@@ -3363,10 +3368,10 @@ SUBROUTINE t_enum_conv(total_error)
CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
CALL check("h5dread_f", error, total_error)
- DO i = 1, ds_size(1)
- IF(data1(i) .NE. INT(data_double(i)))THEN
+ DO ih = 1, ds_size(1)
+ IF(data1(ih) .NE. INT(data_double(ih)))THEN
total_error = total_error + 1
- WRITE(*,'(" 8. data1(",I0,")=",I0," .NE. data_double(",I0,")=",I0)') i, data1(i),i,INT(data_double(i))
+ WRITE(*,'(" 8. data1(",I0,")=",I0," .NE. data_double(",I0,")=",I0)') ih, data1(ih),ih,INT(data_double(ih))
EXIT
ENDIF
ENDDO
@@ -3391,10 +3396,10 @@ SUBROUTINE t_enum_conv(total_error)
CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
CALL check("h5dread_f", error, total_error)
- DO i = 1, ds_size(1)
- IF(data1(i) .NE. INT(data_r7(i)))THEN
+ DO ih = 1, ds_size(1)
+ IF(data1(ih) .NE. INT(data_r7(ih)))THEN
total_error = total_error + 1
- WRITE(*,'(" 9. data1(",I0,")=",I0," .NE. data_r7(",I0,")=",I0)') i, data1(i),i,INT(data_r7(i))
+ WRITE(*,'(" 9. data1(",I0,")=",I0," .NE. data_r7(",I0,")=",I0)') ih, data1(ih),ih,INT(data_r7(ih))
EXIT
ENDIF
ENDDO
@@ -3420,10 +3425,10 @@ SUBROUTINE t_enum_conv(total_error)
CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
CALL check("h5dread_f", error, total_error)
- DO i = 1, ds_size(1)
- IF(data1(i) .NE. data_i16(i))THEN
+ DO ih = 1, ds_size(1)
+ IF(data1(ih) .NE. data_i16(ih))THEN
total_error = total_error + 1
- WRITE(*,'(" 10. data1(",I0,")=",I0," .NE. data_i16(",I0,")=",I0)') i, data1(i),i,data_i16(i)
+ WRITE(*,'(" 10. data1(",I0,")=",I0," .NE. data_i16(",I0,")=",I0)') ih, data1(ih),ih,data_i16(ih)
EXIT
ENDIF
ENDDO
@@ -3444,3 +3449,4 @@ SUBROUTINE t_enum_conv(total_error)
END SUBROUTINE t_enum_conv
+END MODULE TH5T_F03
diff --git a/fortran/test/tH5VL.f90 b/fortran/test/tH5VL.f90
index 85feb2b..f063722 100644
--- a/fortran/test/tH5VL.f90
+++ b/fortran/test/tH5VL.f90
@@ -27,8 +27,13 @@
!
!*****
+MODULE TH5VL
+
+CONTAINS
+
SUBROUTINE vl_test_integer(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -54,6 +59,7 @@
INTEGER :: error ! Error flag
INTEGER :: i, j !general purpose integers
+ INTEGER(HSIZE_T) :: ih, jh !general purpose integers
INTEGER(HSIZE_T), DIMENSION(2) :: data_dims = (/5,6/)
INTEGER(SIZE_T) max_len
@@ -150,14 +156,14 @@
CALL h5dread_vl_f(dset_id, vltype_id, vl_int_data_out, data_dims, len_out, &
error, mem_space_id = dspace_id, file_space_id = dspace_id)
CALL check("h5dread_int_f", error, total_error)
- do i = 1, data_dims(2)
- do j = 1, len_out(i)
- if(vl_int_data(j,i) .ne. vl_int_data_out(j,i)) then
+ do ih = 1, data_dims(2)
+ do jh = 1, len_out(ih)
+ if(vl_int_data(jh,ih) .ne. vl_int_data_out(jh,ih)) then
total_error = total_error + 1
write(*,*) "h5dread_vl_f returned incorrect data"
endif
enddo
- if (len(i) .ne. len_out(i)) then
+ if (len(ih) .ne. len_out(ih)) then
total_error = total_error + 1
write(*,*) "h5dread_vl_f returned incorrect data"
endif
@@ -189,6 +195,7 @@
SUBROUTINE vl_test_real(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -214,10 +221,12 @@
INTEGER :: error ! Error flag
INTEGER :: i, j !general purpose integers
+ INTEGER(HSIZE_T) :: ih, jh !general purpose integers
INTEGER(HSIZE_T), DIMENSION(2) :: data_dims = (/5,6/)
INTEGER(SIZE_T) max_len
INTEGER(HID_T) :: vl_type_id
LOGICAL :: vl_flag
+ LOGICAL :: differ
!
! Initialize the vl_int_data array.
@@ -320,14 +329,14 @@
CALL h5dread_vl_f(dset_id, vltype_id, vl_real_data_out, data_dims, len_out, &
error, mem_space_id = dspace_id, file_space_id = dspace_id)
CALL check("h5dread_real_f", error, total_error)
- do i = 1, data_dims(2)
- do j = 1, len_out(i)
- if(vl_real_data(j,i) .ne. vl_real_data_out(j,i)) then
- total_error = total_error + 1
- write(*,*) "h5dread_vl_f returned incorrect data"
- endif
+ do ih = 1, data_dims(2)
+ do jh = 1, len_out(ih)
+ IF( .NOT.dreal_eq( REAL(vl_real_data(jh,ih),dp), REAL(vl_real_data_out(jh,ih), dp)) ) THEN
+ total_error = total_error + 1
+ WRITE(*,*) "h5dread_vl_f returned incorrect data"
+ ENDIF
enddo
- if (len(i) .ne. len_out(i)) then
+ if (len(ih) .ne. len_out(ih)) then
total_error = total_error + 1
write(*,*) "h5dread_vl_f returned incorrect data"
endif
@@ -360,6 +369,7 @@
SUBROUTINE vl_test_string(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -383,7 +393,7 @@
CHARACTER(LEN=10), DIMENSION(4) :: string_data_out ! Data buffers
INTEGER :: error ! Error flag
- INTEGER :: i !general purpose integers
+ INTEGER(HSIZE_T) :: ih !general purpose integers
INTEGER(HSIZE_T), DIMENSION(2) :: data_dims = (/10,4/)
INTEGER(HID_T) :: vl_type_id
LOGICAL :: vl_flag
@@ -474,13 +484,13 @@
CALL h5dread_vl_f(dset_id, H5T_STRING, string_data_out, data_dims, &
str_len_out, error)
CALL check("h5dread_string_f", error, total_error)
- do 100 i = 1, data_dims(2)
- if(str_len(i) .ne. str_len_out(i)) then
+ do 100 ih = 1, data_dims(2)
+ if(str_len(ih) .ne. str_len_out(ih)) then
total_error=total_error + 1
write(*,*) 'Returned string length is incorrect'
goto 100
endif
- if(string_data(1)(1:str_len(i)) .ne. string_data_out(1)(1:str_len(i))) then
+ if(string_data(1)(1:str_len(ih)) .ne. string_data_out(1)(1:str_len(ih))) then
write(*,*) ' Returned string is wrong'
total_error = total_error + 1
endif
@@ -506,4 +516,4 @@
RETURN
END SUBROUTINE vl_test_string
-
+END MODULE TH5VL
diff --git a/fortran/test/tH5Z.f90 b/fortran/test/tH5Z.f90
index cd6a343..4201960 100644
--- a/fortran/test/tH5Z.f90
+++ b/fortran/test/tH5Z.f90
@@ -26,15 +26,18 @@
! filters_test, szip_test
!
!*****
+MODULE TH5Z
- SUBROUTINE filters_test(cleanup, total_error)
+CONTAINS
+
+ SUBROUTINE filters_test(total_error)
! This subroutine tests following functionalities: h5zfilter_avail_f, h5zunregister_f
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
LOGICAL :: status
INTEGER(HID_T) :: crtpr_id, xfer_id
@@ -165,6 +168,7 @@
SUBROUTINE szip_test(szip_flag, cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(OUT) :: szip_flag
@@ -412,3 +416,4 @@
RETURN
END SUBROUTINE szip_test
+END MODULE TH5Z
diff --git a/fortran/test/tHDF5.f90 b/fortran/test/tHDF5.f90
new file mode 100644
index 0000000..e73fed2
--- /dev/null
+++ b/fortran/test/tHDF5.f90
@@ -0,0 +1,45 @@
+!****h* ROBODoc/HDF5
+!
+! NAME
+! MODULE THDF5
+!
+! FILE
+! src/fortran/test/tHDF5.f90
+!
+! PURPOSE
+! This is the test module used for testing the Fortran90 HDF library APIs.
+!
+! COPYRIGHT
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+! Copyright by The HDF Group. *
+! Copyright by the Board of Trustees of the University of Illinois. *
+! All rights reserved. *
+! *
+! This file is part of HDF5. The full HDF5 copyright notice, including *
+! terms governing use, modification, and redistribution, is contained in *
+! the files COPYING and Copyright.html. COPYING can be found at the root *
+! of the source code distribution tree; Copyright.html can be found at the *
+! root level of an installed copy of the electronic HDF5 document set and *
+! is linked from the top-level documents page. It can also be found at *
+! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from help@hdfgroup.org. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+!*****
+
+MODULE THDF5
+ USE TH5_MISC
+ USE TH5A
+ USE TH5D
+ USE TH5E
+ USE TH5F
+ USE TH5G
+ USE TH5I
+ USE TH5P
+ USE TH5R
+ USE TH5S
+ USE TH5SSELECT
+ USE TH5T
+ USE TH5VL
+ USE TH5Z
+END MODULE THDF5
diff --git a/fortran/test/tHDF5_1_8.f90 b/fortran/test/tHDF5_1_8.f90
new file mode 100644
index 0000000..47eec16
--- /dev/null
+++ b/fortran/test/tHDF5_1_8.f90
@@ -0,0 +1,38 @@
+!****h* ROBODoc/HDF5
+!
+! NAME
+! MODULE THDF5_1_8
+!
+! FILE
+! src/fortran/test/tHDF5_1_8.f90
+!
+! PURPOSE
+! This is the test module used for testing the Fortran90 HDF library
+! 1.8.* APIs
+!
+! COPYRIGHT
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+! Copyright by The HDF Group. *
+! Copyright by the Board of Trustees of the University of Illinois. *
+! All rights reserved. *
+! *
+! This file is part of HDF5. The full HDF5 copyright notice, including *
+! terms governing use, modification, and redistribution, is contained in *
+! the files COPYING and Copyright.html. COPYING can be found at the root *
+! of the source code distribution tree; Copyright.html can be found at the *
+! root level of an installed copy of the electronic HDF5 document set and *
+! is linked from the top-level documents page. It can also be found at *
+! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from help@hdfgroup.org. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+!*****
+
+MODULE THDF5_1_8
+ USE TH5_MISC
+ USE TH5MISC_1_8
+ USE TH5A_1_8
+ USE TH5G_1_8
+ USE TH5F
+ USE TH5O
+END MODULE THDF5_1_8
diff --git a/fortran/test/tHDF5_F03.f90 b/fortran/test/tHDF5_F03.f90
new file mode 100644
index 0000000..3dbec11
--- /dev/null
+++ b/fortran/test/tHDF5_F03.f90
@@ -0,0 +1,39 @@
+!****h* ROBODoc/HDF5
+!
+! NAME
+! MODULE THDF5_F03
+!
+! FILE
+! src/fortran/test/tHDF5_F03.f90
+!
+! PURPOSE
+! This is the test module used for testing the Fortran2003 HDF
+! library APIS.
+!
+! COPYRIGHT
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+! Copyright by The HDF Group. *
+! Copyright by the Board of Trustees of the University of Illinois. *
+! All rights reserved. *
+! *
+! This file is part of HDF5. The full HDF5 copyright notice, including *
+! terms governing use, modification, and redistribution, is contained in *
+! the files COPYING and Copyright.html. COPYING can be found at the root *
+! of the source code distribution tree; Copyright.html can be found at the *
+! root level of an installed copy of the electronic HDF5 document set and *
+! is linked from the top-level documents page. It can also be found at *
+! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from help@hdfgroup.org. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+!*****
+
+MODULE THDF5_F03
+ USE TH5_MISC
+ USE TH5E_F03
+ USE TH5F_F03
+ USE TH5L_F03
+ USE TH5O_F03
+ USE TH5P_F03
+ USE TH5T_F03
+END MODULE THDF5_F03
diff --git a/fortran/test/tf.f90 b/fortran/test/tf.f90
index 4f73fda..2964840 100644
--- a/fortran/test/tf.f90
+++ b/fortran/test/tf.f90
@@ -24,27 +24,44 @@
!
! CONTAINS SUBROUTINES
! write_test_status, check, verify, verifyLogical, verifyString, h5_fixname_f,
-! h5_cleanup_f, h5_exit_f, h5_env_nocleanup_f
+! h5_cleanup_f, h5_exit_f, h5_env_nocleanup_f,dreal_eqv
!
!*****
+MODULE TH5_MISC
+
+ INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15, 307)
+
+CONTAINS
+
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_DLL)
+!DEC$attributes dllexport :: dreal_eq
+!DEC$endif
+ LOGICAL FUNCTION dreal_eq(a,b)
+
+ ! Check if two double precision reals are equivalent
+ REAL(dp), INTENT (in):: a,b
+ REAL(dp), PARAMETER :: eps = 1.e-8
+ dreal_eq = ABS(a-b) .LT. eps
+
+ END FUNCTION dreal_eq
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verify_real_kind_7
!DEC$endif
-SUBROUTINE verify_real_kind_7(string,value,correct_value,total_error)
- USE HDF5
-
- INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
- CHARACTER(LEN=*) :: string
- REAL(real_kind_7) :: value, correct_value
- INTEGER :: total_error
- IF (value .NE. correct_value) THEN
- total_error=total_error+1
- WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string
- ENDIF
- RETURN
-END SUBROUTINE verify_real_kind_7
+ SUBROUTINE verify_real_kind_7(string,value,correct_value,total_error)
+ USE HDF5
+ INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
+ CHARACTER(LEN=*) :: string
+ REAL(real_kind_7) :: value, correct_value
+ INTEGER :: total_error
+ IF (.NOT.dreal_eq( REAL(value,dp), REAL(correct_value, dp)) ) THEN
+ total_error=total_error+1
+ WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string
+ ENDIF
+ RETURN
+ END SUBROUTINE verify_real_kind_7
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
@@ -52,7 +69,7 @@ END SUBROUTINE verify_real_kind_7
!DEC$endif
SUBROUTINE write_test_status( test_result, test_title, total_error)
-! Writes the results of the tests
+ ! Writes the results of the tests
IMPLICIT NONE
@@ -65,11 +82,11 @@ END SUBROUTINE verify_real_kind_7
! 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*'
- CHARACTER(LEN=8), PARAMETER :: skip = '--SKIP--'
-
+ CHARACTER(LEN=8) :: error_string
+ CHARACTER(LEN=8), PARAMETER :: success = ' PASSED '
+ CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*'
+ CHARACTER(LEN=8), PARAMETER :: skip = '--SKIP--'
+
error_string = failure
IF (test_result == 0) THEN
@@ -89,75 +106,76 @@ END SUBROUTINE verify_real_kind_7
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: check
!DEC$endif
-SUBROUTINE check(string,error,total_error)
- CHARACTER(LEN=*) :: string
- INTEGER :: error, total_error
- IF (error .LT. 0) THEN
- total_error=total_error+1
- WRITE(*,*) string, " FAILED"
- ENDIF
- RETURN
-END SUBROUTINE check
+ SUBROUTINE check(string,error,total_error)
+ CHARACTER(LEN=*) :: string
+ INTEGER :: error, total_error
+ IF (error .LT. 0) THEN
+ total_error=total_error+1
+ WRITE(*,*) string, " FAILED"
+ ENDIF
+ RETURN
+ END SUBROUTINE check
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verify
!DEC$endif
-SUBROUTINE verify(string,value,correct_value,total_error)
- CHARACTER(LEN=*) :: string
- INTEGER :: value, correct_value, total_error
- IF (value .NE. correct_value) THEN
- total_error=total_error+1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
-END SUBROUTINE verify
+ SUBROUTINE VERIFY(string,value,correct_value,total_error)
+ CHARACTER(LEN=*) :: string
+ INTEGER :: value, correct_value, total_error
+ IF (value .NE. correct_value) THEN
+ total_error=total_error+1
+ WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
+ ENDIF
+ RETURN
+ END SUBROUTINE verify
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verify_Fortran_INTEGER_4
!DEC$endif
-SUBROUTINE verify_Fortran_INTEGER_4(string,value,correct_value,total_error)
- USE HDF5
- INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) ! should map to INTEGER*4 on most modern processors
- CHARACTER(LEN=*) :: string
- INTEGER(int_kind_8) :: value, correct_value, total_error
- IF (value .NE. correct_value) THEN
- total_error=total_error+1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
-END SUBROUTINE verify_Fortran_INTEGER_4
+ SUBROUTINE verify_Fortran_INTEGER_4(string,value,correct_value,total_error)
+ USE HDF5
+ INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) ! should map to INTEGER*4 on most modern processors
+ CHARACTER(LEN=*) :: string
+ INTEGER(int_kind_8) :: value, correct_value
+ INTEGER :: total_error
+ IF (value .NE. correct_value) THEN
+ total_error=total_error+1
+ WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
+ ENDIF
+ RETURN
+ END SUBROUTINE verify_Fortran_INTEGER_4
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verifyLogical
!DEC$endif
-SUBROUTINE verifyLogical(string,value,correct_value,total_error)
- CHARACTER(LEN=*) :: string
- LOGICAL :: value, correct_value
- INTEGER :: total_error
- IF (value .NEQV. correct_value) THEN
- total_error = total_error + 1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
-END SUBROUTINE verifyLogical
-
+ SUBROUTINE verifyLogical(string,value,correct_value,total_error)
+ CHARACTER(LEN=*) :: string
+ LOGICAL :: value, correct_value
+ INTEGER :: total_error
+ IF (value .NEQV. correct_value) THEN
+ total_error = total_error + 1
+ WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
+ ENDIF
+ RETURN
+ END SUBROUTINE verifyLogical
+
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verifyString
!DEC$endif
-SUBROUTINE verifyString(string, value,correct_value,total_error)
- CHARACTER*(*) :: string
- CHARACTER*(*) :: value, correct_value
- INTEGER :: total_error
- IF (TRIM(value) .NE. TRIM(correct_value)) THEN
- total_error = total_error + 1
- WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
- ENDIF
- RETURN
-END SUBROUTINE verifyString
+ SUBROUTINE verifyString(string, value,correct_value,total_error)
+ CHARACTER*(*) :: string
+ CHARACTER*(*) :: value, correct_value
+ INTEGER :: total_error
+ IF (TRIM(value) .NE. TRIM(correct_value)) THEN
+ total_error = total_error + 1
+ WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
+ ENDIF
+ RETURN
+ END SUBROUTINE verifyString
!----------------------------------------------------------------------
@@ -180,46 +198,46 @@ END SUBROUTINE verifyString
!
!
!----------------------------------------------------------------------
-SUBROUTINE h5_fixname_f(base_name, full_name, fapl, hdferr)
+ SUBROUTINE h5_fixname_f(base_name, full_name, fapl, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5_fixname_f
!DEC$endif
- USE H5GLOBAL
- IMPLICIT NONE
- CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name
- CHARACTER(LEN=*), INTENT(IN) :: full_name ! full name
- INTEGER, INTENT(OUT) :: hdferr ! Error code
- INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list
-
- INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string
- INTEGER(SIZE_T) :: full_namelen ! Length of the full name character string
+ USE H5GLOBAL
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name
+ CHARACTER(LEN=*), INTENT(IN) :: full_name ! full name
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+ INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list
+
+ INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string
+ INTEGER(SIZE_T) :: full_namelen ! Length of the full name character string
! INTEGER(HID_T) :: fapl_default
- INTERFACE
- INTEGER FUNCTION h5_fixname_c(base_name, base_namelen, fapl, &
- full_name, full_namelen)
- USE H5GLOBAL
- !DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_FIXNAME_C':: h5_fixname_c
- !DEC$ ENDIF
- !DEC$ATTRIBUTES reference :: base_name
- !DEC$ATTRIBUTES reference :: full_name
- CHARACTER(LEN=*), INTENT(IN) :: base_name
- INTEGER(SIZE_T) :: base_namelen
- INTEGER(HID_T), INTENT(IN) :: fapl
- CHARACTER(LEN=*), INTENT(IN) :: full_name
- INTEGER(SIZE_T) :: full_namelen
- END FUNCTION h5_fixname_c
- END INTERFACE
-
- base_namelen = LEN(base_name)
- full_namelen = LEN(full_name)
- hdferr = h5_fixname_c(base_name, base_namelen, fapl, &
- full_name, full_namelen)
-
-END SUBROUTINE h5_fixname_f
+ INTERFACE
+ INTEGER FUNCTION h5_fixname_c(base_name, base_namelen, fapl, &
+ full_name, full_namelen)
+ USE H5GLOBAL
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_FIXNAME_C':: h5_fixname_c
+ !DEC$ ENDIF
+ !DEC$ATTRIBUTES reference :: base_name
+ !DEC$ATTRIBUTES reference :: full_name
+ CHARACTER(LEN=*), INTENT(IN) :: base_name
+ INTEGER(SIZE_T) :: base_namelen
+ INTEGER(HID_T), INTENT(IN) :: fapl
+ CHARACTER(LEN=*), INTENT(IN) :: full_name
+ INTEGER(SIZE_T) :: full_namelen
+ END FUNCTION h5_fixname_c
+ END INTERFACE
+
+ base_namelen = LEN(base_name)
+ full_namelen = LEN(full_name)
+ hdferr = h5_fixname_c(base_name, base_namelen, fapl, &
+ full_name, full_namelen)
+
+ END SUBROUTINE h5_fixname_f
!----------------------------------------------------------------------
! Name: h5_cleanup_f
@@ -240,37 +258,37 @@ END SUBROUTINE h5_fixname_f
!
!
!----------------------------------------------------------------------
-SUBROUTINE h5_cleanup_f(base_name, fapl, hdferr)
+ SUBROUTINE h5_cleanup_f(base_name, fapl, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5_cleanup_f
!DEC$endif
- USE H5GLOBAL
- IMPLICIT NONE
- CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name
- INTEGER, INTENT(OUT) :: hdferr ! Error code
- INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list
-
- INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string
-
- INTERFACE
- INTEGER FUNCTION h5_cleanup_c(base_name, base_namelen, fapl)
- USE H5GLOBAL
- !DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_CLEANUP_C':: h5_cleanup_c
- !DEC$ ENDIF
- !DEC$ATTRIBUTES reference :: base_name
- CHARACTER(LEN=*), INTENT(IN) :: base_name
- INTEGER(SIZE_T) :: base_namelen
- INTEGER(HID_T), INTENT(IN) :: fapl
- END FUNCTION h5_cleanup_c
- END INTERFACE
-
- base_namelen = LEN(base_name)
- hdferr = h5_cleanup_c(base_name, base_namelen, fapl)
-
-END SUBROUTINE h5_cleanup_f
+ USE H5GLOBAL
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+ INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list
+
+ INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string
+
+ INTERFACE
+ INTEGER FUNCTION h5_cleanup_c(base_name, base_namelen, fapl)
+ USE H5GLOBAL
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_CLEANUP_C':: h5_cleanup_c
+ !DEC$ ENDIF
+ !DEC$ATTRIBUTES reference :: base_name
+ CHARACTER(LEN=*), INTENT(IN) :: base_name
+ INTEGER(SIZE_T) :: base_namelen
+ INTEGER(HID_T), INTENT(IN) :: fapl
+ END FUNCTION h5_cleanup_c
+ END INTERFACE
+
+ base_namelen = LEN(base_name)
+ hdferr = h5_cleanup_c(base_name, base_namelen, fapl)
+
+ END SUBROUTINE h5_cleanup_f
!----------------------------------------------------------------------
! Name: h5_exit_f
@@ -292,27 +310,27 @@ END SUBROUTINE h5_cleanup_f
!
!
!----------------------------------------------------------------------
-SUBROUTINE h5_exit_f(status)
+ SUBROUTINE h5_exit_f(status)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5_exit_f
!DEC$endif
- IMPLICIT NONE
- INTEGER, INTENT(IN) :: status ! Return code
-
- INTERFACE
- SUBROUTINE h5_exit_c(status)
- !DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_EXIT_C':: h5_exit_c
- !DEC$ ENDIF
- INTEGER, INTENT(IN) :: status
- END SUBROUTINE h5_exit_c
- END INTERFACE
+ IMPLICIT NONE
+ INTEGER, INTENT(IN) :: status ! Return code
- CALL h5_exit_c(status)
+ INTERFACE
+ SUBROUTINE h5_exit_c(status)
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_EXIT_C':: h5_exit_c
+ !DEC$ ENDIF
+ INTEGER, INTENT(IN) :: status
+ END SUBROUTINE h5_exit_c
+ END INTERFACE
+
+ CALL h5_exit_c(status)
-END SUBROUTINE h5_exit_f
+ END SUBROUTINE h5_exit_f
!----------------------------------------------------------------------
! Name: h5_env_nocleanup_f
@@ -329,31 +347,29 @@ END SUBROUTINE h5_exit_f
! September 30, 2008
!
!----------------------------------------------------------------------
-SUBROUTINE h5_env_nocleanup_f(HDF5_NOCLEANUP)
+ SUBROUTINE h5_env_nocleanup_f(HDF5_NOCLEANUP)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5_env_nocleanup_f
!DEC$endif
- IMPLICIT NONE
- LOGICAL, INTENT(OUT) :: HDF5_NOCLEANUP ! Return code
- INTEGER :: status
-
- INTERFACE
- SUBROUTINE h5_env_nocleanup_c(status)
- !DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_ENV_NOCLEANUP_C':: h5_env_nocleanup_c
- !DEC$ ENDIF
- INTEGER :: status
- END SUBROUTINE h5_env_nocleanup_c
- END INTERFACE
-
- CALL h5_env_nocleanup_c(status)
-
- HDF5_NOCLEANUP = .FALSE.
- IF(status.EQ.1)THEN
- HDF5_NOCLEANUP = .TRUE.
- ENDIF
-
-END SUBROUTINE h5_env_nocleanup_f
-
+ IMPLICIT NONE
+ LOGICAL, INTENT(OUT) :: HDF5_NOCLEANUP ! Return code
+ INTEGER :: status
+
+ INTERFACE
+ SUBROUTINE h5_env_nocleanup_c(status)
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_ENV_NOCLEANUP_C':: h5_env_nocleanup_c
+ !DEC$ ENDIF
+ INTEGER :: status
+ END SUBROUTINE h5_env_nocleanup_c
+ END INTERFACE
+
+ CALL h5_env_nocleanup_c(status)
+
+ HDF5_NOCLEANUP = .FALSE.
+ IF(status.EQ.1) HDF5_NOCLEANUP = .TRUE.
+
+ END SUBROUTINE h5_env_nocleanup_f
+END MODULE TH5_MISC
diff --git a/fortran/testpar/Makefile.am b/fortran/testpar/Makefile.am
index 2e85f3b..517a3c8 100644
--- a/fortran/testpar/Makefile.am
+++ b/fortran/testpar/Makefile.am
@@ -21,7 +21,8 @@
include $(top_srcdir)/config/commence.am
# Include files
-AM_FCFLAGS+=-I$(top_srcdir)/fortran/src -I$(top_srcdir)/fortran/test $(F9XMODFLAG)$(top_builddir)/fortran/src
+AM_FCFLAGS+=-I$(top_srcdir)/fortran/src -I$(top_srcdir)/fortran/test $(F9XMODFLAG)$(top_builddir)/fortran/src \
+ $(F9XMODFLAG)$(top_builddir)/fortran/test
# Some Fortran compilers can't build shared libraries, so sometimes we
# want to build a shared C library and a static Fortran library. If so,
diff --git a/fortran/testpar/Makefile.in b/fortran/testpar/Makefile.in
index e078c3a..8ee5e43 100644
--- a/fortran/testpar/Makefile.in
+++ b/fortran/testpar/Makefile.in
@@ -399,7 +399,8 @@ AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
# Include files
AM_FCFLAGS = @AM_FCFLAGS@ @H5_FCFLAGS@ -I$(top_srcdir)/fortran/src \
-I$(top_srcdir)/fortran/test \
- $(F9XMODFLAG)$(top_builddir)/fortran/src
+ $(F9XMODFLAG)$(top_builddir)/fortran/src \
+ $(F9XMODFLAG)$(top_builddir)/fortran/test
AM_LDFLAGS = @AM_LDFLAGS@ @H5_LDFLAGS@ $(am__append_1)
AM_MAKEFLAGS = @AM_MAKEFLAGS@
AR = @AR@
diff --git a/fortran/testpar/hyper.f90 b/fortran/testpar/hyper.f90
index 1a580ca..a2e2e07 100644
--- a/fortran/testpar/hyper.f90
+++ b/fortran/testpar/hyper.f90
@@ -19,7 +19,8 @@
!//////////////////////////////////////////////////////////
SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors)
- USE hdf5
+ USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
INCLUDE 'mpif.h'
diff --git a/fortran/testpar/mdset.f90 b/fortran/testpar/mdset.f90
index 9d14a50..7fe431b 100644
--- a/fortran/testpar/mdset.f90
+++ b/fortran/testpar/mdset.f90
@@ -19,7 +19,8 @@
!//////////////////////////////////////////////////////////
SUBROUTINE multiple_dset_write(length, do_collective, do_chunk, mpi_size, mpi_rank, nerrors)
- USE hdf5
+ USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
INCLUDE 'mpif.h'