summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2012-09-27 19:13:13 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2012-09-27 19:13:13 (GMT)
commita81cc2ac7ef875999f01a91a9a492e19da94ce56 (patch)
treee55aba0e61a9b044c3782b7438fc3bf68f1ee2d5 /fortran
parent0710ab3955c9d5cf7e5ba4be3b48c6e8380553ae (diff)
downloadhdf5-a81cc2ac7ef875999f01a91a9a492e19da94ce56.zip
hdf5-a81cc2ac7ef875999f01a91a9a492e19da94ce56.tar.gz
hdf5-a81cc2ac7ef875999f01a91a9a492e19da94ce56.tar.bz2
[svn-r22824] FIX: HDFFV-8118: Support Fortran compiler flags that change the default size of integer and real
Tested: jam(gnu,intel), machine with gcc 4.7 and C long double = 16 bytes.
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Rf.c41
-rw-r--r--fortran/src/H5Rff.f9061
-rw-r--r--fortran/src/H5Rff_F03.f90174
-rw-r--r--fortran/src/H5Rff_F90.f9065
-rw-r--r--fortran/src/H5f90proto.h2
-rw-r--r--fortran/src/H5match_types.c24
-rw-r--r--fortran/src/hdf5_fortrandll.def2
-rw-r--r--fortran/test/fortranlib_test_1_8.f90141
-rw-r--r--fortran/test/fortranlib_test_F03.f905
-rw-r--r--fortran/test/tH5A.f904
-rw-r--r--fortran/test/tH5T.f904
-rw-r--r--fortran/test/tH5T_F03.f90158
12 files changed, 437 insertions, 244 deletions
diff --git a/fortran/src/H5Rf.c b/fortran/src/H5Rf.c
index 86e0e61..0799e11 100644
--- a/fortran/src/H5Rf.c
+++ b/fortran/src/H5Rf.c
@@ -331,6 +331,47 @@ done:
return ret_value;
} /* end nh5rget_region_region_c() */
+/****if* H5Rf/h5rget_region_ptr_c
+ * NAME
+ * h5rget_region_ptr_c
+ * PURPOSE
+ * Call H5Rget_region to dereference dataspace region
+ * INPUTS
+ * dset_id - dataset identifier
+ * ref - reference to the dataset region
+ * OUTPUTS
+ * space_id - dereferenced dataset dataspace identifier
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * August 4, 2012
+ * HISTORY
+ *
+ * SOURCE
+*/
+int_f
+nh5rget_region_ptr_c(hid_t_f *dset_id, void *ref, hid_t_f *space_id)
+/******/
+{
+ hid_t c_space_id;
+ hdset_reg_ref_t ref_c;
+ int_f ret_value = 0;
+
+ /*
+ * Call H5Rget_region function.
+ */
+ if((c_space_id = H5Rget_region((hid_t)*dset_id, H5R_DATASET_REGION, ref)) < 0)
+ HGOTO_DONE(FAIL)
+
+ /* Copy the dataspace ID */
+ *space_id = (hid_t_f)c_space_id;
+
+done:
+ return ret_value;
+} /* end nh5rget_region_ptr_c() */
+
+
/****if* H5Rf/h5rget_object_type_obj_c
* NAME
* h5rget_object_type_obj_c
diff --git a/fortran/src/H5Rff.f90 b/fortran/src/H5Rff.f90
index 35a3ed6..89ffc10 100644
--- a/fortran/src/H5Rff.f90
+++ b/fortran/src/H5Rff.f90
@@ -53,12 +53,6 @@ MODULE H5R
! END TYPE
!
- INTERFACE h5rget_region_f
-
- MODULE PROCEDURE h5rget_region_region_f
-
- END INTERFACE
-
INTERFACE h5rget_object_type_f
MODULE PROCEDURE h5rget_object_type_obj_f
@@ -67,61 +61,6 @@ MODULE H5R
CONTAINS
-!****s* H5R/h5rget_region_region_f
-!
-! NAME
-! h5rget_region_region_f
-!
-! PURPOSE
-! Retrieves a dataspace with the specified region selected
-!
-! INPUTS
-! dset_id - identifier of the dataset containing
-! reference to the regions
-! ref - reference to open
-! OUTPUTS
-! space_id - dataspace identifier
-! hdferr - Returns 0 if successful and -1 if fails
-! AUTHOR
-! Elena Pourmal
-! August 12, 1999
-!
-! HISTORY
-! Explicit Fortran interfaces were added for
-! called C functions (it is needed for Windows
-! port). February 28, 2001
-!
-! NOTES
-! This is a module procedure for the h5rget_region_f subroutine.
-!
-! SOURCE
- SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr)
- IMPLICIT NONE
- INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier
- TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference
- INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier
- INTEGER, INTENT(OUT) :: hdferr ! Error code
-!*****
- INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference
-
- INTERFACE
- INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id)
- USE H5GLOBAL
- !DEC$IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c
- !DEC$ENDIF
- INTEGER(HID_T), INTENT(IN) :: dset_id
- ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3
- INTEGER :: ref_f(REF_REG_BUF_LEN)
- INTEGER(HID_T), INTENT(OUT) :: space_id
- END FUNCTION h5rget_region_region_c
- END INTERFACE
-
- ref_f = ref%ref
- hdferr = h5rget_region_region_c(dset_id, ref_f, space_id )
-
- END SUBROUTINE h5rget_region_region_f
-
!****s* H5R/h5rget_object_type_obj_f
!
! NAME
diff --git a/fortran/src/H5Rff_F03.f90 b/fortran/src/H5Rff_F03.f90
index 7f66745..88ec8cf 100644
--- a/fortran/src/H5Rff_F03.f90
+++ b/fortran/src/H5Rff_F03.f90
@@ -37,6 +37,7 @@
!*****
MODULE H5R_PROVISIONAL
USE H5GLOBAL
+ USE, INTRINSIC :: ISO_C_BINDING
! If you change the value of these parameters, do not forget to change corresponding
! values in the H5f90.h file.
@@ -51,6 +52,19 @@ MODULE H5R_PROVISIONAL
! INTEGER ref(REF_REG_BUF_LEN)
! END TYPE
!
+
+ TYPE :: hdset_reg_ref_t_f03
+ INTEGER(C_SIGNED_CHAR), DIMENSION(1:H5R_DSET_REG_REF_BUF_SIZE_F) :: ref
+ END TYPE hdset_reg_ref_t_f03
+
+ INTERFACE h5rget_region_f
+
+ MODULE PROCEDURE h5rget_region_region_f ! obsolete
+ MODULE PROCEDURE h5rget_region_ptr_f ! F2003
+
+ END INTERFACE
+
+
INTERFACE h5rcreate_f
MODULE PROCEDURE h5rcreate_object_f ! obsolete
@@ -123,8 +137,114 @@ MODULE H5R_PROVISIONAL
END FUNCTION h5rcreate_ptr_c
END INTERFACE
+ INTERFACE
+ INTEGER FUNCTION h5rget_region_ptr_c(dset_id, ref, space_id)
+ USE, INTRINSIC :: ISO_C_BINDING
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_PTR_C':: h5rget_region_ptr_c
+ !DEC$ENDIF
+ INTEGER(HID_T), INTENT(IN) :: dset_id
+ TYPE(C_PTR), VALUE :: ref
+ INTEGER(HID_T), INTENT(OUT) :: space_id
+ END FUNCTION h5rget_region_ptr_c
+ END INTERFACE
+
CONTAINS
+!****s* H5R/h5rget_region_region_f
+!
+! NAME
+! h5rget_region_region_f
+!
+! PURPOSE
+! Retrieves a dataspace with the specified region selected
+!
+! INPUTS
+! dset_id - identifier of the dataset containing
+! reference to the regions
+! ref - reference to open
+! OUTPUTS
+! space_id - dataspace identifier
+! hdferr - Returns 0 if successful and -1 if fails
+! AUTHOR
+! Elena Pourmal
+! August 12, 1999
+!
+! HISTORY
+! Explicit Fortran interfaces were added for
+! called C functions (it is needed for Windows
+! port). February 28, 2001
+!
+! NOTES
+! This is a module procedure for the h5rget_region_f subroutine.
+!
+! SOURCE
+ SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr)
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier
+ TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference
+ INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+!*****
+ INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference
+
+ INTERFACE
+ INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c
+ !DEC$ENDIF
+ INTEGER(HID_T), INTENT(IN) :: dset_id
+ ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3
+ INTEGER :: ref_f(REF_REG_BUF_LEN)
+ INTEGER(HID_T), INTENT(OUT) :: space_id
+ END FUNCTION h5rget_region_region_c
+ END INTERFACE
+
+ ref_f = ref%ref
+ hdferr = h5rget_region_region_c(dset_id, ref_f, space_id )
+
+ END SUBROUTINE h5rget_region_region_f
+
+!****s* H5R/h5rget_region_ptr_f
+!
+! NAME
+! h5rget_region_ptr_f
+!
+! PURPOSE
+! Retrieves a dataspace with the specified region
+! selected using pointer
+!
+! INPUTS
+! dset_id - identifier of the dataset containing
+! reference to the regions
+! ref - reference to open
+! OUTPUTS
+! space_id - dataspace identifier
+! hdferr - Returns 0 if successful and -1 if fails
+! AUTHOR
+! M. Scot Breitenfeld
+! August 4, 2012
+!
+! NOTES
+! This is a module procedure for the h5rget_region_f subroutine.
+!
+! SOURCE
+ SUBROUTINE h5rget_region_ptr_f(dset_id, ref, space_id, hdferr)
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier
+ TYPE(C_PTR), INTENT(IN) :: ref ! Dataset region reference
+ INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+!*****
+ INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference
+
+ hdferr = h5rget_region_ptr_c(dset_id, ref, space_id )
+
+ END SUBROUTINE h5rget_region_ptr_f
+
+
!****s* H5R (F03)/h5rcreate_object_f
!
! NAME
@@ -175,7 +295,7 @@ CONTAINS
END SUBROUTINE h5rcreate_object_f
-!****s* H5R (F03)/h5rcreate_region_f
+!****s* H5R (F90)/h5rcreate_region_f
!
! NAME
! h5rcreate_region_f
@@ -183,16 +303,15 @@ CONTAINS
! PURPOSE
! Creates reference to the dataset region
!
-! Inputs:
+! INPUTS
! loc_id - location identifier
! name - name of the dataset at the specified location
! space_id - dataspace identifier that describes selected region
-! Outputs:
+! OUTPUTS
! ref - reference to the dataset region
! hdferr: - error code
! Success: 0
! Failure: -1
-!
! AUTHOR
! Elena Pourmal
! August 12, 1999
@@ -205,46 +324,39 @@ CONTAINS
! NOTES
! This is a module procedure for the h5rcreate_f subroutine.
!
-! Signature:
+! SOURCE
SUBROUTINE h5rcreate_region_f(loc_id, name, space_id, ref, hdferr)
- USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: loc_id ! Location identifier
CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the dataset at location specified
! by loc_id identifier
INTEGER(HID_T), INTENT(IN) :: space_id ! Dataset's dataspace identifier
- TYPE(hdset_reg_ref_t_f), INTENT(INOUT), TARGET :: ref ! Dataset region reference
+ TYPE(hdset_reg_ref_t_f), INTENT(OUT) :: ref ! Dataset region reference
INTEGER, INTENT(OUT) :: hdferr ! Error code
!*****
INTEGER :: namelen ! Name length
INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference
- TYPE(C_PTR) :: f_ptr
-
-! !$ INTERFACE
-! !$ INTEGER FUNCTION h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id)
-! !$ USE H5GLOBAL
-! !$ !DEC$IF DEFINED(HDF5F90_WINDOWS)
-! !$ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RCREATE_REGION_C':: h5rcreate_region_c
-! !$ !DEC$ENDIF
-! !$ !DEC$ATTRIBUTES reference :: name
-! !$ ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3
-! !$ INTEGER :: ref_f(REF_REG_BUF_LEN)
-! !$ INTEGER(HID_T), INTENT(IN) :: loc_id
-! !$ CHARACTER(LEN=*), INTENT(IN) :: name
-! !$ INTEGER :: namelen
-! !$ INTEGER(HID_T), INTENT(IN) :: space_id
-! !$ END FUNCTION h5rcreate_region_c
-! !$ END INTERFACE
-
- f_ptr = C_LOC(ref)
+ INTERFACE
+ INTEGER FUNCTION h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RCREATE_REGION_C':: h5rcreate_region_c
+ !DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: name
+ ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3
+ INTEGER :: ref_f(REF_REG_BUF_LEN)
+ INTEGER(HID_T), INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ INTEGER :: namelen
+ INTEGER(HID_T), INTENT(IN) :: space_id
+ END FUNCTION h5rcreate_region_c
+ END INTERFACE
namelen = LEN(name)
- hdferr = h5rcreate_ptr_c(f_ptr, loc_id, name, namelen, 1, space_id)
-
-! !$ ref_f = 0
-! !$ hdferr = h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id )
-! !$ ref%ref = ref_f
+ ref_f = 0
+ hdferr = h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id )
+ ref%ref = ref_f
END SUBROUTINE h5rcreate_region_f
diff --git a/fortran/src/H5Rff_F90.f90 b/fortran/src/H5Rff_F90.f90
index 3f02825..0190e57 100644
--- a/fortran/src/H5Rff_F90.f90
+++ b/fortran/src/H5Rff_F90.f90
@@ -72,8 +72,73 @@ MODULE H5R_PROVISIONAL
END INTERFACE
+ INTERFACE h5rget_region_f
+
+ MODULE PROCEDURE h5rget_region_region_f
+
+ END INTERFACE
+
+
CONTAINS
+
+!****s* H5R/h5rget_region_region_f
+!
+! NAME
+! h5rget_region_region_f
+!
+! PURPOSE
+! Retrieves a dataspace with the specified region selected
+!
+! INPUTS
+! dset_id - identifier of the dataset containing
+! reference to the regions
+! ref - reference to open
+! OUTPUTS
+! space_id - dataspace identifier
+! hdferr - Returns 0 if successful and -1 if fails
+! AUTHOR
+! Elena Pourmal
+! August 12, 1999
+!
+! HISTORY
+! Explicit Fortran interfaces were added for
+! called C functions (it is needed for Windows
+! port). February 28, 2001
+!
+! NOTES
+! This is a module procedure for the h5rget_region_f subroutine.
+!
+! SOURCE
+ SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr)
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier
+ TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference
+ INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+!*****
+ INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference
+
+ INTERFACE
+ INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c
+ !DEC$ENDIF
+ INTEGER(HID_T), INTENT(IN) :: dset_id
+ ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3
+ INTEGER :: ref_f(REF_REG_BUF_LEN)
+ INTEGER(HID_T), INTENT(OUT) :: space_id
+ END FUNCTION h5rget_region_region_c
+ END INTERFACE
+
+ ref_f = ref%ref
+ hdferr = h5rget_region_region_c(dset_id, ref_f, space_id )
+
+ END SUBROUTINE h5rget_region_region_f
+
+
+
!****s* H5R (F90)/h5rcreate_object_f
!
! NAME
diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h
index 94bc63b..b1e650a 100644
--- a/fortran/src/H5f90proto.h
+++ b/fortran/src/H5f90proto.h
@@ -1179,6 +1179,7 @@ H5_FCDLL int_f nh5pget_mpio_actual_io_mode_c(hid_t_f *dxpl_id, int_f *actual_io_
#define nh5rdereference_object_c H5_FC_FUNC_(h5rdereference_object_c, H5RDEREFERENCE_OBJECT_C)
#define nh5rdereference_ptr_c H5_FC_FUNC_(h5rdereference_ptr_c, H5RDEREFERENCE_PTR_C)
#define nh5rget_region_region_c H5_FC_FUNC_(h5rget_region_region_c, H5RGET_REGION_REGION_C)
+#define nh5rget_region_ptr_c H5_FC_FUNC_(h5rget_region_ptr_c, H5RGET_REGION_PTR_C)
#define nh5rget_object_type_obj_c H5_FC_FUNC_(h5rget_object_type_obj_c, H5RGET_OBJECT_TYPE_OBJ_C)
#define nh5rget_name_object_c H5_FC_FUNC_(h5rget_name_object_c, H5RGET_NAME_OBJECT_C)
#define nh5rget_name_region_c H5_FC_FUNC_(h5rget_name_region_c, H5RGET_NAME_REGION_C)
@@ -1193,6 +1194,7 @@ H5_FCDLL int_f nh5rdereference_region_c (hid_t_f *dset_id, int_f *ref, hid_t_f *
H5_FCDLL int_f nh5rdereference_object_c (hid_t_f *dset_id, haddr_t_f *ref, hid_t_f *obj_id);
H5_FCDLL int_f nh5rdereference_ptr_c (hid_t_f *obj_id, int_f *ref_type, void *ref, hid_t_f *ref_obj_id);
H5_FCDLL int_f nh5rget_region_region_c (hid_t_f *dset_id, int_f *ref, hid_t_f *space_id);
+H5_FCDLL int_f nh5rget_region_ptr_c(hid_t_f *dset_id, void *ref, hid_t_f *space_id);
H5_FCDLL int_f nh5rget_object_type_obj_c (hid_t_f *dset_id, haddr_t_f *ref, int_f *obj_type);
H5_FCDLL int_f nh5rget_name_object_c (hid_t_f *loc_id, haddr_t_f *ref, _fcd name, size_t_f *name_len, size_t_f *size_default);
H5_FCDLL int_f nh5rget_name_region_c (hid_t_f *loc_id, int_f *ref, _fcd name, size_t_f *name_len, size_t_f *size_default);
diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c
index 61504ec..4c83d21 100644
--- a/fortran/src/H5match_types.c
+++ b/fortran/src/H5match_types.c
@@ -533,7 +533,21 @@ int main(void)
/* double_f */
#if defined H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND
- writeFloatToFiles("Fortran_DOUBLE", "double_f", 16, H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND);
+ if(H5_C_HAS_REAL_NATIVE_16 != 0) { /* Check if C has 16 byte floats */
+ writeFloatToFiles("Fortran_DOUBLE", "double_f", 16, H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND);
+ } else {
+#if defined H5_FORTRAN_HAS_REAL_NATIVE_8_KIND /* Fall back to 8 byte floats */
+ writeFloatToFiles("Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_REAL_NATIVE_8_KIND);
+ }
+#elif defined H5_FORTRAN_HAS_REAL_NATIVE_4_KIND /* Fall back to 4 byte floats */
+ writeFloatToFiles("Fortran_DOUBLE", "double_f", 4, H5_FORTRAN_HAS_REAL_NATIVE_4_KIND);
+ }
+#else
+ /* Error: couldn't find a size for double_f when fortran has 16 byte reals */
+ return -1;
+ }
+#endif
+
#elif defined H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND
writeFloatToFiles("Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND);
#else
@@ -541,6 +555,14 @@ int main(void)
return -1;
#endif
+ /* Need the buffer size for the fortran derive type 'hdset_reg_ref_t_f03'
+ * in order to be interoperable with C's structure, the C buffer size
+ * H5R_DSET_REG_REF_BUF_SIZE is (sizeof(haddr_t)+4)
+ */
+
+ fprintf(fort_header, " INTEGER, PARAMETER :: H5R_DSET_REG_REF_BUF_SIZE_F = %u\n", H5_SIZEOF_HADDR_T + 4 );
+
+
/* Close files */
endCfile();
endFfile();
diff --git a/fortran/src/hdf5_fortrandll.def b/fortran/src/hdf5_fortrandll.def
index 29e83f5..735189a 100644
--- a/fortran/src/hdf5_fortrandll.def
+++ b/fortran/src/hdf5_fortrandll.def
@@ -429,7 +429,9 @@ H5R_PROVISIONAL_mp_H5RCREATE_OBJECT_F
H5R_PROVISIONAL_mp_H5RCREATE_REGION_F
H5R_PROVISIONAL_mp_H5RDEREFERENCE_OBJECT_F
H5R_PROVISIONAL_mp_H5RDEREFERENCE_REGION_F
+H5R_PROVISIONAL_mp_H5RGET_REGION_PTR_F
H5R_mp_H5RGET_REGION_REGION_F
+
H5R_mp_H5RGET_OBJECT_TYPE_OBJ_F
H5R_PROVISIONAL_mp_H5RGET_NAME_OBJECT_F
H5R_PROVISIONAL_mp_H5RGET_NAME_REGION_F
diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90
index 321cb99..d3ced72 100644
--- a/fortran/test/fortranlib_test_1_8.f90
+++ b/fortran/test/fortranlib_test_1_8.f90
@@ -94,12 +94,6 @@ PROGRAM fortranlibtest
total_error)
ret_total_error = 0
- CALL test_nbit(cleanup, ret_total_error )
- CALL write_test_status(ret_total_error, &
- ' Testing nbit filter', &
- total_error)
-
- ret_total_error = 0
CALL test_scaleoffset(cleanup, ret_total_error )
CALL write_test_status(ret_total_error, &
' Testing scaleoffset filter', &
@@ -401,141 +395,6 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
END SUBROUTINE test_h5s_encode
!-------------------------------------------------------------------------
-! Function: test_nbit
-!
-! Purpose: Tests (real) datatype for nbit filter
-!
-! Return: Success: 0
-! Failure: >0
-!
-! Programmer: M. Scot Breitenfeld
-! Decemeber 7, 2010
-!
-! Modifications:
-!
-!-------------------------------------------------------------------------
-!
-
-SUBROUTINE test_nbit(cleanup, total_error )
-
- USE HDF5
-
- IMPLICIT NONE
- INTEGER, PARAMETER :: wp = KIND(1.0)
- LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(INOUT) :: total_error
- INTEGER(hid_t) :: file
-
- INTEGER(hid_t) :: dataset, datatype, space, dc
- INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/)
- INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/)
- ! orig_data[] are initialized to be within the range that can be represented by
- ! dataset datatype (no precision loss during datatype conversion)
- !
- REAL(kind=wp), DIMENSION(1:2,1:5) :: orig_data = RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, &
- 5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) )
- REAL(kind=wp), DIMENSION(1:2,1:5) :: new_data
- INTEGER(size_t) :: PRECISION, offset
- INTEGER :: error
- LOGICAL :: status
- INTEGER*8 :: ii
- INTEGER(size_t) :: i, j
-
-
- ! check to see if filter is available
- CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error)
- IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter
- total_error = -1 ! so return
- RETURN
- ENDIF
-
- CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error)
- CALL check("H5Fcreate_f", error, total_error)
-
- ! Define dataset datatype (integer), and set precision, offset
- CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error)
- CALL CHECK(" H5Tcopy_f", error, total_error)
- CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error)
- CALL CHECK(" H5Tset_fields_f", error, total_error)
- offset = 7
- CALL H5Tset_offset_f(datatype, offset, error)
- CALL CHECK(" H5Tset_offset_f", error, total_error)
- PRECISION = 20
- CALL H5Tset_precision_f(datatype,PRECISION, error)
- CALL CHECK(" H5Tset_precision_f", error, total_error)
-
- CALL H5Tset_size_f(datatype, 4_size_t, error)
- CALL CHECK(" H5Tset_size_f", error, total_error)
-
- CALL H5Tset_ebias_f(datatype, 31_size_t, error)
- CALL CHECK(" H5Tset_ebias_f", error, total_error)
-
- ! Create the data space
- CALL H5Screate_simple_f(2, dims, space, error)
- CALL CHECK(" H5Screate_simple_f", error, total_error)
-
- ! USE nbit filter
- CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error)
- CALL CHECK(" H5Pcreate_f", error, total_error)
-
- CALL H5Pset_chunk_f(dc, 2, chunk_dim, error)
- CALL CHECK(" H5Pset_chunk_f", error, total_error)
- CALL H5Pset_nbit_f(dc, error)
- CALL CHECK(" H5Pset_nbit_f", error, total_error)
-
- ! Create the dataset
- CALL H5Dcreate_f(file, "nbit_real", datatype, &
- space, dataset, error, dc)
- CALL CHECK(" H5Dcreate_f", error, total_error)
-
- !----------------------------------------------------------------------
- ! STEP 1: Test nbit by setting up a chunked dataset and writing
- ! to it.
- !----------------------------------------------------------------------
- !
- CALL H5Dwrite_f(dataset, H5T_NATIVE_REAL, orig_data, dims, error)
- CALL CHECK(" H5Dwrite_f", error, total_error)
-
- !----------------------------------------------------------------------
- ! STEP 2: Try to read the data we just wrote.
- !----------------------------------------------------------------------
- !
- CALL H5Dread_f(dataset, H5T_NATIVE_REAL, new_data, dims, error)
- CALL CHECK(" H5Dread_f", error, total_error)
-
- ! Check that the values read are the same as the values written
- ! Assume size of long long = size of double
- !
- 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
- total_error = total_error + 1
- WRITE(*,'(" Read different values than written.")')
- WRITE(*,'(" At index ", 2(1X,I0))') i, j
- EXIT i_loop
- END IF
- ENDDO j_loop
- ENDDO i_loop
-
- !----------------------------------------------------------------------
- ! 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_nbit
-
-!-------------------------------------------------------------------------
! Function: test_scaleoffset
!
! Purpose: Tests the integer datatype for scaleoffset filter
diff --git a/fortran/test/fortranlib_test_F03.f90 b/fortran/test/fortranlib_test_F03.f90
index 1b69f7f..b674452 100644
--- a/fortran/test/fortranlib_test_F03.f90
+++ b/fortran/test/fortranlib_test_F03.f90
@@ -139,6 +139,11 @@ PROGRAM fortranlibtest_F03
ret_total_error = 0
CALL test_iter_group(ret_total_error)
CALL write_test_status(ret_total_error, ' Testing Group Iteration Functionality', total_error)
+
+ ret_total_error = 0
+ CALL test_nbit(ret_total_error)
+ CALL write_test_status(ret_total_error, ' Testing nbit filter', total_error)
+
! write(*,*)
! write(*,*) '========================================='
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90
index 03522f7..cecaded 100644
--- a/fortran/test/tH5A.f90
+++ b/fortran/test/tH5A.f90
@@ -100,7 +100,7 @@
CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back
! string attr data
CHARACTER :: attr_character_data = 'A'
- DOUBLE PRECISION, DIMENSION(1) :: attr_double_data = 3.459
+ REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459
REAL, DIMENSION(1) :: attr_real_data = 4.0
INTEGER, DIMENSION(1) :: attr_integer_data = 5
INTEGER(HSIZE_T), DIMENSION(7) :: data_dims
@@ -109,7 +109,7 @@
CHARACTER :: aread_character_data ! variable to put read back Character attr data
INTEGER, DIMENSION(1) :: aread_integer_data ! variable to put read back integer attr data
INTEGER, DIMENSION(1) :: aread_null_data = 7 ! variable to put read back null attr data
- DOUBLE PRECISION, DIMENSION(1) :: aread_double_data ! variable to put read back double attr data
+ REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: aread_double_data ! variable to put read back double attr data
REAL, DIMENSION(1) :: aread_real_data ! variable to put read back real attr data
!
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index 9605c45..b42a8e6 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -86,8 +86,8 @@
CHARACTER(LEN=2), DIMENSION(dimsize) :: char_member_out ! Buffer to read data out
INTEGER, DIMENSION(dimsize) :: int_member
INTEGER, DIMENSION(dimsize) :: int_member_out
- DOUBLE PRECISION, DIMENSION(dimsize) :: double_member
- DOUBLE PRECISION, DIMENSION(dimsize) :: double_member_out
+ REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member
+ REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member_out
REAL, DIMENSION(dimsize) :: real_member
REAL, DIMENSION(dimsize) :: real_member_out
INTEGER :: i
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90
index 215ac9e..2cf0a84 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.f90
@@ -1976,8 +1976,8 @@ SUBROUTINE t_regref(total_error)
INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims
INTEGER(hssize_t) :: npoints
- TYPE(hdset_reg_ref_t_f), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer
- TYPE(hdset_reg_ref_t_f), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer
+ TYPE(hdset_reg_ref_t_f03), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer
+ TYPE(hdset_reg_ref_t_f03), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer
INTEGER(size_t) :: size
CHARACTER(LEN=1), DIMENSION(1:ds2dim0,1:ds2dim1), TARGET :: wdata2
@@ -2058,7 +2058,6 @@ SUBROUTINE t_regref(total_error)
CALL check("h5sclose_f",error, total_error)
CALL h5fclose_f(file , error)
CALL check("h5fclose_f",error, total_error)
-
!
! Now we begin the read section of this example.
!
@@ -2095,10 +2094,11 @@ SUBROUTINE t_regref(total_error)
! Open the referenced object, retrieve its region as a
! dataspace selection.
!
- CALL H5Rdereference_f(dset, rdata(i), dset2, error)
+ f_ptr = C_LOC(rdata(i))
+ CALL H5Rdereference_f(dset, H5R_DATASET_REGION_F, f_ptr, dset2, error)
CALL check("H5Rdereference_f",error, total_error)
- CALL H5Rget_region_f(dset, rdata(i), space, error)
+ CALL H5Rget_region_f(dset, f_ptr, space, error)
CALL check("H5Rget_region_f",error, total_error)
!
@@ -2754,7 +2754,7 @@ SUBROUTINE t_string(total_error)
CALL check("H5Dget_type_f",error, total_error)
CALL H5Tget_size_f(filetype, size, error)
CALL check("H5Tget_size_f",error, total_error)
- CALL VERIFY("H5Tget_size_f", size, sdim, total_error)
+ CALL VERIFY("H5Tget_size_f", INT(size), INT(sdim), total_error)
!
! Get dataspace.
!
@@ -2801,3 +2801,149 @@ SUBROUTINE t_string(total_error)
END SUBROUTINE t_string
+!-------------------------------------------------------------------------
+! Function: test_nbit
+!
+! Purpose: Tests (real, 4 byte) datatype for nbit filter
+!
+! Return: Success: 0
+! Failure: >0
+!
+! Programmer: M. Scot Breitenfeld
+! Decemeber 7, 2010
+!
+! Modifications: Moved this subroutine from the 1.8 test file and
+! modified it to use F2003 features.
+! This routine requires 4 byte reals, so we use F2003 features to
+! ensure the requirement is satisfied in a portable way.
+! The need for this arises when a user specifies the default real is 8 bytes.
+! MSB 7/31/12
+!
+!-------------------------------------------------------------------------
+!
+
+SUBROUTINE test_nbit(cleanup, total_error )
+
+ USE HDF5
+ 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
+
+ INTEGER(hid_t) :: dataset, datatype, space, dc, mem_type_id
+ INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/)
+ INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/)
+ ! orig_data[] are initialized to be within the range that can be represented by
+ ! dataset datatype (no precision loss during datatype conversion)
+ !
+ REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: orig_data = &
+ RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, &
+ 5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) )
+ REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: new_data
+ INTEGER(size_t) :: PRECISION, offset
+ INTEGER :: error
+ LOGICAL :: status
+ INTEGER(size_t) :: i, j
+ TYPE(C_PTR) :: f_ptr
+
+ ! check to see if filter is available
+ CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error)
+ IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter
+ total_error = -1 ! so return
+ RETURN
+ ENDIF
+
+ CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error)
+ CALL check("H5Fcreate_f", error, total_error)
+
+ ! Define dataset datatype (integer), and set precision, offset
+ CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error)
+ CALL CHECK(" H5Tcopy_f", error, total_error)
+ CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error)
+ CALL CHECK(" H5Tset_fields_f", error, total_error)
+ offset = 7
+ CALL H5Tset_offset_f(datatype, offset, error)
+ CALL CHECK(" H5Tset_offset_f", error, total_error)
+ PRECISION = 20
+ CALL H5Tset_precision_f(datatype,PRECISION, error)
+ CALL CHECK(" H5Tset_precision_f", error, total_error)
+
+ CALL H5Tset_size_f(datatype, 4_size_t, error)
+ CALL CHECK(" H5Tset_size_f", error, total_error)
+
+ CALL H5Tset_ebias_f(datatype, 31_size_t, error)
+ CALL CHECK(" H5Tset_ebias_f", error, total_error)
+
+ ! Create the data space
+ CALL H5Screate_simple_f(2, dims, space, error)
+ CALL CHECK(" H5Screate_simple_f", error, total_error)
+
+ ! USE nbit filter
+ CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error)
+ CALL CHECK(" H5Pcreate_f", error, total_error)
+
+ CALL H5Pset_chunk_f(dc, 2, chunk_dim, error)
+ CALL CHECK(" H5Pset_chunk_f", error, total_error)
+ CALL H5Pset_nbit_f(dc, error)
+ CALL CHECK(" H5Pset_nbit_f", error, total_error)
+
+ ! Create the dataset
+ CALL H5Dcreate_f(file, "nbit_real", datatype, &
+ space, dataset, error, dc)
+ CALL CHECK(" H5Dcreate_f", error, total_error)
+
+ !----------------------------------------------------------------------
+ ! STEP 1: Test nbit by setting up a chunked dataset and writing
+ ! to it.
+ !----------------------------------------------------------------------
+ !
+ mem_type_id = h5kind_to_type(wp,H5_REAL_KIND)
+
+ f_ptr = C_LOC(orig_data(1,1))
+ CALL H5Dwrite_f(dataset, mem_type_id, f_ptr, error)
+ CALL CHECK(" H5Dwrite_f", error, total_error)
+
+ !----------------------------------------------------------------------
+ ! STEP 2: Try to read the data we just wrote.
+ !----------------------------------------------------------------------
+ !
+ f_ptr = C_LOC(new_data(1,1))
+ CALL H5Dread_f(dataset, mem_type_id, f_ptr, error)
+ CALL CHECK(" H5Dread_f", error, total_error)
+
+ ! Check that the values read are the same as the values written
+ ! Assume size of long long = size of double
+ !
+ 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
+ total_error = total_error + 1
+ WRITE(*,'(" Read different values than written.")')
+ WRITE(*,'(" At index ", 2(1X,I0))') i, j
+ EXIT i_loop
+ END IF
+ ENDDO j_loop
+ ENDDO i_loop
+
+ !----------------------------------------------------------------------
+ ! 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_nbit
+
+