summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2016-10-06 20:34:39 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2016-10-06 20:34:39 (GMT)
commitc604bca0445ba1d05a976a673768fa677422e93e (patch)
tree7d5438638d4081cb0fcbd1620f6ca0eaf543f1fe /fortran
parent783f01f478f99711710b24d8c85b0555dcdcf1fc (diff)
parentf9364c0080405bb36d704eb3f9505029d3da41f4 (diff)
downloadhdf5-c604bca0445ba1d05a976a673768fa677422e93e.zip
hdf5-c604bca0445ba1d05a976a673768fa677422e93e.tar.gz
hdf5-c604bca0445ba1d05a976a673768fa677422e93e.tar.bz2
Merge pull request #47 in HDFFV/hdf5 from ~BRTNFLD/hdf5_msb:develop to develop
* commit 'f9364c0080405bb36d704eb3f9505029d3da41f4': removed the use of C_SIZEOF for non BIND(C) derived type Fixed test to use storage_size instead of c_sizeof when available. fixed missing closing bracket Removed unused variables. Fixed: Fortran_DOUBLE was being set to C_LONG_DOUBLE when C_LONG_DOUBLE is not available. Removed duplicate FCFLAG Removed duplicate FCFLAG. Added number of integer KINDs found to the header files. Added path to source include files when building buidiface. Added rule to build buildiface program, without a rule, build would add repeated compile options when using the NAG compiler. Misc. cleaning up of the program. Added SEQUENCE to derived types for NAG: misc. format code-cleanup Removed the use of hard-coded integer KINDs. Code clean-up. HDFFV-9973 Fortran library fails to compile and fails tests with NAG compiler
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Pff.F9014
-rw-r--r--fortran/src/H5_f.c238
-rw-r--r--fortran/src/H5_ff.F9039
-rw-r--r--fortran/src/H5f90global.F9043
-rw-r--r--fortran/src/H5fort_type_defines.h.in1
-rw-r--r--fortran/src/H5match_types.c149
-rw-r--r--fortran/test/Makefile.am4
-rw-r--r--fortran/test/fortranlib_test_F03.F902
-rw-r--r--fortran/test/tH5T_F03.F9046
-rw-r--r--fortran/test/tf.F9013
10 files changed, 211 insertions, 338 deletions
diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90
index 532ecc6..6ba5aeb 100644
--- a/fortran/src/H5Pff.F90
+++ b/fortran/src/H5Pff.F90
@@ -6397,18 +6397,18 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr)
!! SUBROUTINE h5pget_fill_value_f(prp_id, type_id, fillvalue, hdferr)
!! INTEGER(HID_T), INTENT(IN) :: prp_id
!! INTEGER(HID_T), INTENT(IN) :: type_id
-!! TYPE(C_PTR) , INTENT(OUT) :: fillvalue
+!! TYPE(C_PTR) :: fillvalue
!! INTEGER , INTENT(OUT) :: hdferr
!*****
SUBROUTINE h5pget_fill_value_ptr(prp_id, type_id, fillvalue, hdferr)
IMPLICIT NONE
- INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier
- INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of
- ! of fillvalue datatype
- ! (in memory)
- TYPE(C_PTR), INTENT(OUT) :: fillvalue ! Fillvalue
- INTEGER, INTENT(OUT) :: hdferr ! Error code
+ INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier
+ INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of
+ ! of fillvalue datatype
+ ! (in memory)
+ TYPE(C_PTR) :: fillvalue ! Fillvalue
+ INTEGER , INTENT(OUT) :: hdferr ! Error code
hdferr = h5pget_fill_value_c(prp_id, type_id, fillvalue)
diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c
index d7b952d..f9fe927 100644
--- a/fortran/src/H5_f.c
+++ b/fortran/src/H5_f.c
@@ -23,6 +23,10 @@
#include "H5f90.h"
#include "H5fort_type_defines.h"
+
+int IntKinds_SizeOf[] = H5_FORTRAN_INTEGER_KINDS_SIZEOF;
+
+
/****if* H5_f/h5init_types_c
* NAME
* h5init_types_c
@@ -30,16 +34,16 @@
* Initialize predefined datatypes in Fortran
* INPUTS
* types - array with the predefined Native Fortran
- * type, its element and length must be the
- * same as the types array defined in the
+ * type, its element and length must be the
+ * same as the types array defined in the
* H5f90global.F90
* floatingtypes - array with the predefined Floating Fortran
- * type, its element and length must be the
- * same as the floatingtypes array defined in the
- * H5f90global.F90
+ * type, its element and length must be the
+ * same as the floatingtypes array defined in the
+ * H5f90global.F90
* integertypes - array with the predefined Integer Fortran
- * type, its element and length must be the
- * same as the integertypes array defined in the
+ * type, its element and length must be the
+ * same as the integertypes array defined in the
* H5f90global.F90
* RETURNS
* 0 on success, -1 on failure
@@ -55,173 +59,116 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes
int ret_value = -1;
hid_t c_type_id;
size_t tmp_val;
+ int i;
+
+ /* Fortran INTEGER may not be the same as C; do all checking to find
+ an appropriate size
+ */
+
+ /*
+ * Find the HDF5 type of the Fortran Integer KIND.
+ */
+
+ /* Initialized INTEGER KIND types to default to native integer */
+ for(i=0;i<5;i++) {
+ if ((types[i] = (hid_t_f)H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+ }
+
+ for(i=0;i<H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
+ if ( IntKinds_SizeOf[i] == sizeof(char)) {
+ if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
+ } /*end if */
+ else if ( IntKinds_SizeOf[i] == sizeof(short)) {
+ if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
+ } /*end if */
+ else if ( IntKinds_SizeOf[i] == sizeof(int)) {
+ if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
+ } /*end if */
+ else if ( IntKinds_SizeOf[i] == sizeof(long long)) {
+ if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
+ } /*end if */
+ else {
+ if ((types[i] = (hid_t_f)H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[i], 128) < 0) return ret_value;
+ } /*end else */
+
+ }
-/* Fortran INTEGER may not be the same as C; do all checking to find
- an appropriate size
-*/
if (sizeof(int_f) == sizeof(int)) {
- if ((types[0] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
+ if ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
} /*end if */
else if (sizeof(int_f) == sizeof(long)) {
- if ((types[0] = (hid_t_f)H5Tcopy(H5T_NATIVE_LONG)) < 0) return ret_value;
+ if ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_LONG)) < 0) return ret_value;
} /*end if */
else
- if (sizeof(int_f) == sizeof(long long)) {
- if ((types[0] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
+ if (sizeof(int_f) == sizeof(long long)) {
+ if ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
} /*end else */
-
+
/* Find appropriate size to store Fortran REAL */
if(sizeof(real_f)==sizeof(float)) {
- if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
+ if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
} /* end if */
else if(sizeof(real_f)==sizeof(double)){
- if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+ if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
} /* end if */
#if H5_SIZEOF_LONG_DOUBLE!=0
else if (sizeof(real_f) == sizeof(long double)) {
- if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+ if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
} /* end else */
#endif
/* Find appropriate size to store Fortran DOUBLE */
if(sizeof(double_f)==sizeof(double)) {
- if ((types[2] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+ if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
}/*end if */
#if H5_SIZEOF_LONG_DOUBLE!=0
else if(sizeof(double_f)==sizeof(long double)) {
- if ((types[2] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+ if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
}/*end else */
#endif
#ifdef H5_HAVE_FLOAT128
else if(sizeof(double_f)==sizeof(__float128)) {
- if ((types[2] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
- if ( H5Tset_precision (types[2], 128) < 0) return ret_value;
+ if ((types[7] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[7], 128) < 0) return ret_value;
}/*end else */
#endif
-/*
- if ((types[3] = H5Tcopy(H5T_NATIVE_UINT8)) < 0) return ret_value;
-*/
if ((c_type_id = H5Tcopy(H5T_FORTRAN_S1)) < 0) return ret_value;
tmp_val = 1;
if(H5Tset_size(c_type_id, tmp_val) < 0) return ret_value;
if(H5Tset_strpad(c_type_id, H5T_STR_SPACEPAD) < 0) return ret_value;
- types[3] = (hid_t_f)c_type_id;
+ types[8] = (hid_t_f)c_type_id;
-/*
- if ((types[3] = H5Tcopy(H5T_C_S1)) < 0) return ret_value;
- if(H5Tset_strpad(types[3],H5T_STR_NULLTERM) < 0) return ret_value;
- if(H5Tset_size(types[3],1) < 0) return ret_value;
-*/
-
-
-/* if ((types[3] = H5Tcopy(H5T_STD_I8BE)) < 0) return ret_value;
-*/
- if ((types[4] = (hid_t_f)H5Tcopy(H5T_STD_REF_OBJ)) < 0) return ret_value;
- if ((types[5] = (hid_t_f)H5Tcopy(H5T_STD_REF_DSETREG)) < 0) return ret_value;
- /*
- * FIND H5T_NATIVE_INTEGER_1
- */
- if (sizeof(int_1_f) == sizeof(char)) {
- if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_1_f) == sizeof(short)) {
- if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_1_f) == sizeof(int)) {
- if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_1_f) == sizeof(long long)) {
- if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
- } /*end if */
- else {
- if ((types[6] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
- if ( H5Tset_precision (types[6], 128) < 0) return ret_value;
- } /*end else */
- /*
- * FIND H5T_NATIVE_INTEGER_2
- */
- if (sizeof(int_2_f) == sizeof(char)) {
- if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_2_f) == sizeof(short)) {
- if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_2_f) == sizeof(int)) {
- if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_2_f) == sizeof(long long)) {
- if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
- } /*end else */
- else {
- if ((types[7] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
- if ( H5Tset_precision (types[7], 128) < 0) return ret_value;
- } /*end else */
- /*
- * FIND H5T_NATIVE_INTEGER_4
- */
- if (sizeof(int_4_f) == sizeof(char)) {
- if ((types[8] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_4_f) == sizeof(short)) {
- if ((types[8] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_4_f) == sizeof(int)) {
- if ((types[8] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_4_f) == sizeof(long long)) {
- if ((types[8] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
- } /*end else */
- else {
- if ((types[8] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
- if ( H5Tset_precision (types[8], 128) < 0) return ret_value;
- } /*end else */
- /*
- * FIND H5T_NATIVE_INTEGER_8
- */
- if (sizeof(int_8_f) == sizeof(char)) {
- if ((types[9] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_8_f) == sizeof(short)) {
- if ((types[9] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_8_f) == sizeof(int)) {
- if ((types[9] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_8_f) == sizeof(long long)) {
- if ((types[9] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
- } /*end else */
- else {
- if ((types[9] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
- if ( H5Tset_precision (types[9], 128) < 0) return ret_value;
- } /*end else */
+ if ((types[9] = (hid_t_f)H5Tcopy(H5T_STD_REF_OBJ)) < 0) return ret_value;
+ if ((types[10] = (hid_t_f)H5Tcopy(H5T_STD_REF_DSETREG)) < 0) return ret_value;
/*
* FIND H5T_NATIVE_REAL_C_FLOAT
*/
if (sizeof(real_C_FLOAT_f) == sizeof(float)) {
- if ((types[10] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
+ if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
} /*end if */
else if (sizeof(real_C_FLOAT_f) == sizeof(double)) {
- if ((types[10] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+ if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
} /*end if */
#if H5_SIZEOF_LONG_DOUBLE!=0
else if (sizeof(real_C_FLOAT_f) == sizeof(long double)) {
- if ((types[10] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+ if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
} /*end else */
#endif
/*
* FIND H5T_NATIVE_REAL_C_DOUBLE
*/
if (sizeof(real_C_DOUBLE_f) == sizeof(float)) {
- if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
+ if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
} /*end if */
else if (sizeof(real_C_DOUBLE_f) == sizeof(double)) {
- if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+ if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
} /*end if */
#if H5_SIZEOF_LONG_DOUBLE!=0
else if (sizeof(real_C_DOUBLE_f) == sizeof(long double)) {
- if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+ if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
} /*end else */
#endif
/*
@@ -229,67 +176,44 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes
*/
#if H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE!=0
if (sizeof(real_C_LONG_DOUBLE_f) == sizeof(float)) {
- if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
+ if ((types[13] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
} /*end if */
else if (sizeof(real_C_LONG_DOUBLE_f) == sizeof(double)) {
- if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+ if ((types[13] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
} /*end if */
# if H5_FORTRAN_HAVE_C_LONG_DOUBLE!=0
else if (sizeof(real_C_LONG_DOUBLE_f) == sizeof(long double)) {
if ( H5_PAC_C_MAX_REAL_PRECISION >= H5_PAC_FC_MAX_REAL_PRECISION) {
- if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+ if ((types[13] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
}
else {
- if ((types[12] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
- if ( H5Tset_precision (types[12], 128) < 0) return ret_value;
+ if ((types[13] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[13], 128) < 0) return ret_value;
}
}
# else
- if ((types[12] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
- if ( H5Tset_precision (types[12], 64) < 0) return ret_value;
+ if ((types[13] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[13], 64) < 0) return ret_value;
# endif
#else
- if ((types[12] = H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+ if ((types[13] = H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
#endif
/*
* FIND H5T_NATIVE_B_8
*/
- if ((types[13] = (hid_t_f)H5Tcopy(H5T_NATIVE_B8)) < 0) return ret_value;
- if ((types[14] = (hid_t_f)H5Tcopy(H5T_NATIVE_B16)) < 0) return ret_value;
- if ((types[15] = (hid_t_f)H5Tcopy(H5T_NATIVE_B32)) < 0) return ret_value;
- if ((types[16] = (hid_t_f)H5Tcopy(H5T_NATIVE_B64)) < 0) return ret_value;
-
-#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
- /*
- * FIND H5T_NATIVE_INTEGER_16
- */
- if (sizeof(int_16_f) == sizeof(char)) {
- if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_16_f) == sizeof(short)) {
- if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_16_f) == sizeof(int)) {
- if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
- } /*end if */
- else if (sizeof(int_16_f) == sizeof(long long)) {
- if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
- } /*end else */
- else {
- if ((types[17] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
- if ( H5Tset_precision (types[17], 128) < 0) return ret_value;
- } /*end else */
-#else
- if ((types[17] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
- if ( H5Tset_precision (types[17], 128) < 0) return ret_value;
-#endif
+ if ((types[14] = (hid_t_f)H5Tcopy(H5T_NATIVE_B8)) < 0) return ret_value;
+ if ((types[15] = (hid_t_f)H5Tcopy(H5T_NATIVE_B16)) < 0) return ret_value;
+ if ((types[16] = (hid_t_f)H5Tcopy(H5T_NATIVE_B32)) < 0) return ret_value;
+ if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_B64)) < 0) return ret_value;
- /*
+ /*
* FIND H5T_NATIVE_FLOAT_128
*/
if ((types[18] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
if ( H5Tset_precision (types[18], 128) < 0) return ret_value;
+ /*--------------------------------------------------------------------------------------*/
+
if ((floatingtypes[0] = (hid_t_f)H5Tcopy(H5T_IEEE_F32BE)) < 0) return ret_value;
if ((floatingtypes[1] = (hid_t_f)H5Tcopy(H5T_IEEE_F32LE)) < 0) return ret_value;
if ((floatingtypes[2] = (hid_t_f)H5Tcopy(H5T_IEEE_F64BE)) < 0) return ret_value;
diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90
index 169864f..228e148 100644
--- a/fortran/src/H5_ff.F90
+++ b/fortran/src/H5_ff.F90
@@ -379,27 +379,23 @@ CONTAINS
IMPLICIT NONE
INTEGER, INTENT(IN) :: ikind
INTEGER, INTENT(IN) :: flag
-#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
- INTEGER :: Fortran_INTEGER_16
- Fortran_INTEGER_16=SELECTED_INT_KIND(36) !should map to INTEGER*16 on most modern processors
-#endif
-
-
+ INTEGER :: i
!*****
+
+!#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+! ! (1) The array index assumes INTEGER*16 the last integer in the series, and
+! ! (2) it should map to INTEGER*16 on most modern processors
+! H5T_NATIVE_INTEGER_KIND(H5_FORTRAN_NUM_INTEGER_KINDS)=SELECTED_INT_KIND(36)
+!#endif
+
+ h5_type = -1
IF(flag.EQ.H5_INTEGER_KIND)THEN
- IF(ikind.EQ.Fortran_INTEGER_1)THEN
- h5_type = H5T_NATIVE_INTEGER_1
- ELSE IF(ikind.EQ.Fortran_INTEGER_2)THEN
- h5_type = H5T_NATIVE_INTEGER_2
- ELSE IF(ikind.EQ.Fortran_INTEGER_4)THEN
- h5_type = H5T_NATIVE_INTEGER_4
- ELSE IF(ikind.EQ.Fortran_INTEGER_8)THEN
- h5_type = H5T_NATIVE_INTEGER_8
-#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
- ELSE IF(ikind.EQ.Fortran_INTEGER_16)THEN
- h5_type = H5T_NATIVE_INTEGER_16
-#endif
- ENDIF
+ do_kind: DO i = 1, H5_FORTRAN_NUM_INTEGER_KINDS
+ IF(ikind.EQ.Fortran_INTEGER_AVAIL_KINDS(i))THEN
+ h5_type = H5T_NATIVE_INTEGER_KIND(i)
+ EXIT do_kind
+ ENDIF
+ END DO do_kind
ELSE IF(flag.EQ.H5_REAL_KIND)THEN
IF(ikind.EQ.KIND(1.0_C_FLOAT))THEN
h5_type = H5T_NATIVE_REAL_C_FLOAT
@@ -409,14 +405,11 @@ CONTAINS
ELSE IF(ikind.EQ.KIND(1.0_C_LONG_DOUBLE))THEN
h5_type = H5T_NATIVE_REAL_C_LONG_DOUBLE
#endif
-#if H5_PAC_FC_MAX_REAL_PRECISION > 28
+#if H5_PAC_FC_MAX_REAL_PRECISION > 28
#if H5_HAVE_FLOAT128 == 1
ELSE
h5_type = H5T_NATIVE_FLOAT_128
#endif
-#else
- ELSE
- h5_type = -1
#endif
ENDIF
ENDIF
diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90
index af0a000..aef3e4d 100644
--- a/fortran/src/H5f90global.F90
+++ b/fortran/src/H5f90global.F90
@@ -115,8 +115,11 @@ MODULE H5GLOBAL
H5T_STD_U16BE, &
H5T_STD_U16LE, &
H5T_STD_U32BE
-
- INTEGER(HID_T) :: H5T_NATIVE_INTEGER_16 ! NEED IFDEF -MSB-
+
+ INTEGER, PARAMETER :: NUM_NATIVE_INTEGER_KIND = 5
+ ! INTEGER*1, INTEGER*2, INTEGER*4, INTEGER*8, INTEGER*16
+ INTEGER(HID_T), DIMENSION(1:NUM_NATIVE_INTEGER_KIND) :: H5T_NATIVE_INTEGER_KIND
+
INTEGER(HID_T) :: H5T_NATIVE_FLOAT_128 ! NEED IFDEF -MSB-
! NOTE: Splitting the line since the Fortran 95 standard limits the number of
@@ -144,24 +147,24 @@ MODULE H5GLOBAL
INTEGER(HID_T), DIMENSION(PREDEF_TYPES_LEN) :: predef_types
- EQUIVALENCE (predef_types(1), H5T_NATIVE_INTEGER)
- EQUIVALENCE (predef_types(2), H5T_NATIVE_REAL)
- EQUIVALENCE (predef_types(3), H5T_NATIVE_DOUBLE)
- EQUIVALENCE (predef_types(4), H5T_NATIVE_CHARACTER)
- EQUIVALENCE (predef_types(5), H5T_STD_REF_OBJ)
- EQUIVALENCE (predef_types(6), H5T_STD_REF_DSETREG)
- EQUIVALENCE (predef_types(7), H5T_NATIVE_INTEGER_1)
- EQUIVALENCE (predef_types(8), H5T_NATIVE_INTEGER_2)
- EQUIVALENCE (predef_types(9), H5T_NATIVE_INTEGER_4)
- EQUIVALENCE (predef_types(10), H5T_NATIVE_INTEGER_8)
- EQUIVALENCE (predef_types(11), H5T_NATIVE_REAL_C_FLOAT)
- EQUIVALENCE (predef_types(12), H5T_NATIVE_REAL_C_DOUBLE)
- EQUIVALENCE (predef_types(13), H5T_NATIVE_REAL_C_LONG_DOUBLE)
- EQUIVALENCE (predef_types(14), H5T_NATIVE_B8 )
- EQUIVALENCE (predef_types(15), H5T_NATIVE_B16)
- EQUIVALENCE (predef_types(16), H5T_NATIVE_B32)
- EQUIVALENCE (predef_types(17), H5T_NATIVE_B64)
- EQUIVALENCE (predef_types(18), H5T_NATIVE_INTEGER_16) ! ADDED NEW TYPE -MSB-
+ EQUIVALENCE (predef_types(1), H5T_NATIVE_INTEGER_KIND(1))
+ EQUIVALENCE (predef_types(2), H5T_NATIVE_INTEGER_KIND(2))
+ EQUIVALENCE (predef_types(3), H5T_NATIVE_INTEGER_KIND(3))
+ EQUIVALENCE (predef_types(4), H5T_NATIVE_INTEGER_KIND(4))
+ EQUIVALENCE (predef_types(5), H5T_NATIVE_INTEGER_KIND(5))
+ EQUIVALENCE (predef_types(6), H5T_NATIVE_INTEGER)
+ EQUIVALENCE (predef_types(7), H5T_NATIVE_REAL)
+ EQUIVALENCE (predef_types(8), H5T_NATIVE_DOUBLE)
+ EQUIVALENCE (predef_types(9), H5T_NATIVE_CHARACTER)
+ EQUIVALENCE (predef_types(10), H5T_STD_REF_OBJ)
+ EQUIVALENCE (predef_types(11), H5T_STD_REF_DSETREG)
+ EQUIVALENCE (predef_types(12), H5T_NATIVE_REAL_C_FLOAT)
+ EQUIVALENCE (predef_types(13), H5T_NATIVE_REAL_C_DOUBLE)
+ EQUIVALENCE (predef_types(14), H5T_NATIVE_REAL_C_LONG_DOUBLE)
+ EQUIVALENCE (predef_types(15), H5T_NATIVE_B8 )
+ EQUIVALENCE (predef_types(16), H5T_NATIVE_B16)
+ EQUIVALENCE (predef_types(17), H5T_NATIVE_B32)
+ EQUIVALENCE (predef_types(18), H5T_NATIVE_B64)
EQUIVALENCE (predef_types(19), H5T_NATIVE_FLOAT_128) ! ADDED NEW TYPE -MSB-
INTEGER(HID_T), DIMENSION(FLOATING_TYPES_LEN) :: floating_types
diff --git a/fortran/src/H5fort_type_defines.h.in b/fortran/src/H5fort_type_defines.h.in
index 0e14e86..6feed4f 100644
--- a/fortran/src/H5fort_type_defines.h.in
+++ b/fortran/src/H5fort_type_defines.h.in
@@ -7,6 +7,7 @@
#define H5_FORTRAN_NATIVE_REAL_SIZEOF @PAC_FORTRAN_NATIVE_REAL_SIZEOF@
#define H5_FORTRAN_NATIVE_DOUBLE_KIND @PAC_FORTRAN_NATIVE_DOUBLE_KIND@
#define H5_FORTRAN_NATIVE_DOUBLE_SIZEOF @PAC_FORTRAN_NATIVE_DOUBLE_SIZEOF@
+#define H5_FORTRAN_NUM_INTEGER_KINDS @PAC_FORTRAN_NUM_INTEGER_KINDS@
#define H5_FORTRAN_INTEGER_KINDS @PAC_FC_ALL_INTEGER_KINDS@
#define H5_FORTRAN_INTEGER_KINDS_SIZEOF @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@
#define H5_FORTRAN_REAL_KINDS @PAC_FC_ALL_REAL_KINDS@
diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c
index 98128db..2337fb3 100644
--- a/fortran/src/H5match_types.c
+++ b/fortran/src/H5match_types.c
@@ -51,7 +51,8 @@ FILE * fort_header;
/* Prototypes for the write routines */
void writeTypedef(const char* c_typedef, const char* c_type, int size);
void writeTypedefDefault(const char* c_typedef, int size);
-void writeToFiles(const char* c_typedef, const char* fortran_type, const char* c_type, int size, int kind);
+void writeToFiles(const char* c_typedef, const char* fortran_type, const char* c_type, int kind);
+void writeToCFileOnly(const char* c_typedef, const char* fortran_type, const char* c_type, int size);
void writeToFilesChr(const char* c_typedef, const char* fortran_type, const char* c_type, int size, const char* kind);
static void
@@ -100,7 +101,7 @@ initFfile(void)
! access to either file, you may request a copy from help@hdfgroup.org. *\n\
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\
!\n!\n\
-! This file is automatically generated and contains HDF5 Fortran90 type definitions.\n!\n\
+! This file is automatically generated by H5match_types.c and contains HDF5 Fortran90 type definitions.\n!\n\
MODULE H5FORTRAN_TYPES\n\
USE ISO_C_BINDING\n\
!\n\
@@ -135,10 +136,10 @@ void writeTypedefDefault(const char* c_typedef, int size)
}
/* Create matching Fortran and C types by writing to both files */
-void writeToFiles(const char* c_typedef, const char* fortran_type, const char* c_type, int size, int kind)
+void writeToFiles(const char* c_typedef, const char* fortran_type, const char* c_type, int kind)
{
fprintf(fort_header, " INTEGER, PARAMETER :: %s = %u\n", fortran_type, kind);
- fprintf(c_header, "typedef c_%s_%d %s;\n", c_typedef, size, c_type);
+ fprintf(c_header, "typedef c_%s_%d %s;\n", c_typedef, kind, c_type);
}
void writeToFilesChr(const char* c_typedef, const char* fortran_type, const char* c_type, int size, const char* kind)
{
@@ -147,9 +148,7 @@ void writeToFilesChr(const char* c_typedef, const char* fortran_type, const char
}
int main(void)
{
- int FoundIntSize[10];
- int FoundIntSizeKind[10];
- int i, j,flag;
+ int i;
char chrA[32],chrB[32];
int IntKinds[] = H5_FORTRAN_INTEGER_KINDS;
@@ -158,7 +157,7 @@ int main(void)
int RealKinds_SizeOf[] = H5_FORTRAN_REAL_KINDS_SIZEOF;
char Real_C_TYPES[10][32];
- int H5_FORTRAN_NUM_INTEGER_KINDS;
+ int FORTRAN_NUM_INTEGER_KINDS=H5_FORTRAN_NUM_INTEGER_KINDS;
int H5_FORTRAN_NUM_REAL_KINDS;
int found_long_double = 0;
@@ -172,10 +171,13 @@ int main(void)
/* (a) define c_int_x */
- H5_FORTRAN_NUM_INTEGER_KINDS = (int)(sizeof(IntKinds)/sizeof(IntKinds[0]));
+ FORTRAN_NUM_INTEGER_KINDS = (int)(sizeof(IntKinds)/sizeof(IntKinds[0]));
H5_FORTRAN_NUM_REAL_KINDS = (int)(sizeof(RealKinds)/sizeof(RealKinds[0]));
- for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
+ fprintf(fort_header," INTEGER, PARAMETER :: H5_FORTRAN_NUM_INTEGER_KINDS = %d\n", FORTRAN_NUM_INTEGER_KINDS);
+
+
+ for(i=0;i< FORTRAN_NUM_INTEGER_KINDS;i++) {
if(sizeof(long long) == IntKinds_SizeOf[i])
writeTypedef("int", "long long", IntKinds[i]);
else if(sizeof(long) == IntKinds[i])
@@ -256,122 +258,78 @@ int main(void)
fprintf(c_header, "\n");
/* haddr_t */
- for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
+ for(i=0;i< FORTRAN_NUM_INTEGER_KINDS;i++) {
if(IntKinds_SizeOf[i] == H5_SIZEOF_HADDR_T) {
- writeToFiles("int","HADDR_T", "haddr_t_f", H5_SIZEOF_HADDR_T, IntKinds[i]);
+ writeToFiles("int","HADDR_T", "haddr_t_f", IntKinds[i]);
break;
}
- if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
+ if(i == (FORTRAN_NUM_INTEGER_KINDS-1) )
/* Error: couldn't find a size for haddr_t */
return -1;
}
/* hsize_t */
- for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
+ for(i=0;i< FORTRAN_NUM_INTEGER_KINDS;i++) {
if(IntKinds_SizeOf[i] == H5_SIZEOF_HSIZE_T) {
- writeToFiles("hsize_t","HSIZE_T", "hsize_t_f", H5_SIZEOF_HSIZE_T, IntKinds[i]);
+ writeToFiles("hsize_t","HSIZE_T", "hsize_t_f", IntKinds[i]);
break;
}
- if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
+ if(i == (FORTRAN_NUM_INTEGER_KINDS-1) )
/* Error: couldn't find a size for hsize_t */
return -1;
}
/* hssize_t */
- for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
+ for(i=0;i< FORTRAN_NUM_INTEGER_KINDS;i++) {
if(IntKinds_SizeOf[i] == H5_SIZEOF_HSSIZE_T) {
- writeToFiles("int","HSSIZE_T", "hssize_t_f", H5_SIZEOF_HSSIZE_T, IntKinds[i]);
+ writeToFiles("int","HSSIZE_T", "hssize_t_f", IntKinds[i]);
break;
}
- if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
+ if(i == (FORTRAN_NUM_INTEGER_KINDS-1) )
/* Error: couldn't find a size for hssize_t */
return -1;
}
/* off_t */
- for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
+ for(i=0;i< FORTRAN_NUM_INTEGER_KINDS;i++) {
if(IntKinds_SizeOf[i] == H5_SIZEOF_OFF_T) {
- writeToFiles("int","OFF_T", "off_t_f", H5_SIZEOF_OFF_T, IntKinds[i]);
+ writeToFiles("int","OFF_T", "off_t_f", IntKinds[i]);
break;
}
- if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
+ if(i == (FORTRAN_NUM_INTEGER_KINDS-1) )
/* Error: couldn't find a size for off_t */
return -1;
}
/* size_t */
- for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
+ for(i=0;i< FORTRAN_NUM_INTEGER_KINDS;i++) {
if(IntKinds_SizeOf[i] == H5_SIZEOF_SIZE_T) {
- writeToFiles("size_t","SIZE_T", "size_t_f", H5_SIZEOF_SIZE_T, IntKinds[i]);
+ writeToFiles("size_t","SIZE_T", "size_t_f", IntKinds[i]);
break;
}
- if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
+ if(i == (FORTRAN_NUM_INTEGER_KINDS-1) )
/* Error: couldn't find a size for size_t */
return -1;
}
/* int */
- writeToFiles("int","Fortran_INTEGER", "int_f", H5_FORTRAN_NATIVE_INTEGER_SIZEOF, H5_FORTRAN_NATIVE_INTEGER_KIND);
+ writeToFiles("int","Fortran_INTEGER", "int_f", H5_FORTRAN_NATIVE_INTEGER_KIND);
/* int_1, int_2, int_4, int_8 */
-/* Defined different KINDs of integers: */
-/* if the integer kind is not available then we assign */
-/* it a value of the next larger one, but if the next */
-/* higher one is not available we assigned it the next lowest */
-
+/* Defined different KINDs of integers */
- FoundIntSize[0] = -1;
- FoundIntSize[1] = -1;
- FoundIntSize[2] = -1;
- FoundIntSize[3] = -1;
- FoundIntSize[4] = -1;
+ fprintf(fort_header," INTEGER, DIMENSION(1:%d), PARAMETER :: Fortran_INTEGER_AVAIL_KINDS = (/", FORTRAN_NUM_INTEGER_KINDS);
- for(i=0;i<H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
- FoundIntSize[i] = (int)IntKinds[i];
- FoundIntSizeKind[i] = (int)IntKinds_SizeOf[i];
-/* writeToFiles("int",chrA, chrB, FoundIntSize[i], FoundIntSizeKind[i]); */
- }
-
- for(i=0;i<H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
- if( FoundIntSize[i] > 0) /* Found the integer type */
- {
- sprintf(chrA, "Fortran_INTEGER_%d", FoundIntSize[i]);
- sprintf(chrB, "int_%d_f", FoundIntSize[i]);
- writeToFiles("int",chrA, chrB, FoundIntSize[i], FoundIntSizeKind[i]);
- }
- else /* Did not find the integer type */
- {
- flag = 0; /* flag indicating if found the next highest */
- for(j=i+1;j<4;j++) /* search for next highest */
- {
- if( FoundIntSize[j] > 0) /* Found the next highest */
- {
- sprintf(chrA, "Fortran_INTEGER_%d", (-1)*FoundIntSize[i]);
- sprintf(chrB, "int_%d_f", (-1)*FoundIntSize[i]);
- writeToFiles("int",chrA, chrB, FoundIntSize[j], FoundIntSizeKind[j]);
- flag = 1;
- break;
- }
- }
- if(flag == 0) /* No higher one found, so find next lowest */
- {
- for(j=2;j>-1;j--) /* Search for next lowest */
- {
- if( FoundIntSize[j] > 0) /* Found the next lowest */
- {
- sprintf(chrA, "Fortran_INTEGER_%d", (-1)*FoundIntSize[i]);
- sprintf(chrB, "int_%d_f", (-1)*FoundIntSize[i]);
- writeToFiles("int",chrA, chrB, FoundIntSize[j], FoundIntSizeKind[j]);
- flag = 1;
- break;
- }
- }
- }
- if(flag == 0) /* No higher or lower one found, indicating an error */
- return -1;
- }
+ for(i=0;i<FORTRAN_NUM_INTEGER_KINDS;i++) {
+ fprintf(fort_header,"%d",(int)IntKinds[i]);
+ if(i==FORTRAN_NUM_INTEGER_KINDS-1) {
+ fprintf(fort_header,"/)\n");
+ } else {
+ fprintf(fort_header,",");
}
+
+ }
/* real_4, real_8, real_16 */
@@ -384,27 +342,29 @@ int main(void)
if (RealKinds[i] > 0) {
sprintf(chrA, "Fortran_REAL_%s", Real_C_TYPES[i]);
sprintf(chrB, "real_%s_f", Real_C_TYPES[i]);
- writeToFiles("float",chrA, chrB, RealKinds[i], RealKinds_SizeOf[i]);
+ writeToFiles("float",chrA, chrB, RealKinds[i]);
}
}
/* hid_t */
- for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
+ for(i=0;i< FORTRAN_NUM_INTEGER_KINDS;i++) {
if(IntKinds_SizeOf[i] == H5_SIZEOF_HID_T) {
- writeToFiles("int","HID_T", "hid_t_f", H5_SIZEOF_HID_T, IntKinds[i]);
+ writeToFiles("int","HID_T", "hid_t_f", IntKinds[i]);
break;
}
- if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
+ if(i == (FORTRAN_NUM_INTEGER_KINDS-1) )
/* Error: couldn't find a size for hid_t */
return -1;
}
-
/* real_f */
- if(H5_FORTRAN_NATIVE_REAL_SIZEOF == sizeof(long double))
+#if H5_FORTRAN_HAVE_C_LONG_DOUBLE!=0
+ if(H5_FORTRAN_NATIVE_REAL_SIZEOF == sizeof(long double)) {
writeToFilesChr("float","Fortran_REAL", "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_LONG_DOUBLE");
- else if(H5_FORTRAN_NATIVE_REAL_SIZEOF == sizeof(double))
+ } else
+#endif
+ if(H5_FORTRAN_NATIVE_REAL_SIZEOF == sizeof(double)) {
writeToFilesChr("float","Fortran_REAL", "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_DOUBLE");
- else if(H5_FORTRAN_NATIVE_REAL_SIZEOF == sizeof(float))
+ } else if(H5_FORTRAN_NATIVE_REAL_SIZEOF == sizeof(float))
writeToFilesChr("float","Fortran_REAL", "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_FLOAT");
else {
/* No exact match, choose the next highest */
@@ -422,20 +382,23 @@ int main(void)
}
/* double_f */
- if(H5_FORTRAN_NATIVE_DOUBLE_SIZEOF == sizeof(long double))
+#if H5_FORTRAN_HAVE_C_LONG_DOUBLE!=0
+ if(H5_FORTRAN_NATIVE_DOUBLE_SIZEOF == sizeof(long double)){
writeToFilesChr("float","Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "C_LONG_DOUBLE");
- else if(H5_FORTRAN_NATIVE_DOUBLE_SIZEOF == sizeof(double))
+ } else
+#endif
+ if(H5_FORTRAN_NATIVE_DOUBLE_SIZEOF == sizeof(double)) {
writeToFilesChr("float","Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "C_DOUBLE");
- else if(H5_FORTRAN_NATIVE_DOUBLE_SIZEOF == sizeof(float))
+ } else if(H5_FORTRAN_NATIVE_DOUBLE_SIZEOF == sizeof(float))
writeToFilesChr("float","Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "C_FLOAT");
#ifdef H5_HAVE_FLOAT128
/* Don't select a higher precision than Fortran can support */
else if(sizeof(__float128) == H5_FORTRAN_NATIVE_DOUBLE_SIZEOF && H5_PAC_FC_MAX_REAL_PRECISION > 28) {
- writeToFilesChr("float","Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "C_FLOAT128");
+ writeToFilesChr("float","Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "Fortran_REAL_C_FLOAT128");
}
#else
else if(sizeof(long double) == H5_FORTRAN_NATIVE_DOUBLE_SIZEOF && H5_PAC_FC_MAX_REAL_PRECISION > 28) {
- writeToFilesChr("float","Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "C_FLOAT128");
+ writeToFilesChr("float","Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "Fortran_REAL_C_FLOAT128");
}
#endif
else {
diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am
index 60f9f53..3def26e 100644
--- a/fortran/test/Makefile.am
+++ b/fortran/test/Makefile.am
@@ -92,10 +92,10 @@ tf_gen.F90: H5_test_buildiface$(EXEEXT)
H5_test_buildiface_SOURCES = H5_test_buildiface.F90
-# The build of the H5_test_buildiface does depend on any libraries, so set it
+# The build of the H5_test_buildiface does not depend on any libraries, so set it
# to nothing.
-H5_test_buildiface_LDADD =
+H5_test_buildiface_LDADD =
# fflush2 depends on files created by fflush1
fflush2.chkexe_: fflush1.chkexe_
diff --git a/fortran/test/fortranlib_test_F03.F90 b/fortran/test/fortranlib_test_F03.F90
index 070cd73..5f5fd2d 100644
--- a/fortran/test/fortranlib_test_F03.F90
+++ b/fortran/test/fortranlib_test_F03.F90
@@ -131,7 +131,7 @@ PROGRAM fortranlibtest_F03
ret_total_error = 0
CALL test_array_bkg(ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing Partial I/O of Array Fields in Compound Datatype FunctionalityT', total_error)
+ CALL write_test_status(ret_total_error, ' Testing Partial I/O of Array Fields in Compound Datatype Functionality', total_error)
ret_total_error = 0
CALL test_genprop_class_callback(ret_total_error)
diff --git a/fortran/test/tH5T_F03.F90 b/fortran/test/tH5T_F03.F90
index 6ddded4..c8be606 100644
--- a/fortran/test/tH5T_F03.F90
+++ b/fortran/test/tH5T_F03.F90
@@ -66,6 +66,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
CHARACTER(LEN=10), PARAMETER :: FILENAME = "tarray1.h5"
TYPE s1_t
+ SEQUENCE
INTEGER :: i
REAL :: f
END TYPE s1_t
@@ -298,7 +299,8 @@ END SUBROUTINE test_array_compound_atomic
INTEGER, PARAMETER :: SPACE1_DIM1 = 4
CHARACTER(LEN=10), PARAMETER :: FILENAME = "tarray2.h5"
- TYPE st_t_struct ! Typedef for compound datatype
+ TYPE st_t_struct ! Typedef for compound datatype
+ SEQUENCE
INTEGER :: i
REAL, DIMENSION(1:ARRAY2_DIM1) :: f
CHARACTER(LEN=2), DIMENSION(1:ARRAY2_DIM1) :: c
@@ -1144,33 +1146,33 @@ END SUBROUTINE test_array_compound_atomic
!
! Read data back into an integer size that is larger then the original size used for
! writing the data
- f_ptr = C_LOC(data_out_i1)
+ f_ptr = C_LOC(data_out_i1(1))
CALL h5dread_f(dset_id1, h5kind_to_type(int_kind_1,H5_INTEGER_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
- f_ptr = C_LOC(data_out_i4)
+ f_ptr = C_LOC(data_out_i4(1))
CALL h5dread_f(dset_id4, h5kind_to_type(int_kind_4,H5_INTEGER_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
- f_ptr = C_LOC(data_out_i8)
+ f_ptr = C_LOC(data_out_i8(1))
CALL h5dread_f(dset_id8, h5kind_to_type(int_kind_8,H5_INTEGER_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
- f_ptr = C_LOC(data_out_i16)
+ f_ptr = C_LOC(data_out_i16(1))
CALL h5dread_f(dset_id16, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
- f_ptr = C_LOC(data_out_i32)
+ f_ptr = C_LOC(data_out_i32(1))
CALL h5dread_f(dset_id32, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
#endif
- f_ptr = C_LOC(data_out_r)
+ f_ptr = C_LOC(data_out_r(1))
CALL h5dread_f(dset_idr, H5T_NATIVE_REAL, f_ptr, error)
CALL check("h5dread_f",error, total_error)
- f_ptr = C_LOC(data_out_r7)
+ f_ptr = C_LOC(data_out_r7(1))
CALL h5dread_f(dset_idr4, h5kind_to_type(real_kind_7,H5_REAL_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
- f_ptr = C_LOC(data_out_r15)
+ f_ptr = C_LOC(data_out_r15(1))
CALL h5dread_f(dset_idr8, h5kind_to_type(real_kind_15,H5_REAL_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
- f_ptr = C_LOC(data_out_r31)
+ f_ptr = C_LOC(data_out_r31(1))
CALL h5dread_f(dset_idr16, h5kind_to_type(real_kind_31,H5_REAL_KIND), f_ptr, error)
CALL check("h5dread_f",error, total_error)
DO i = 1, 4
@@ -2000,7 +2002,7 @@ SUBROUTINE t_regref(total_error)
CALL h5dcreate_f(file,dataset2, H5T_STD_I8LE, space, dset2, error)
CALL check("h5dcreate_f",error, total_error)
f_ptr = C_LOC(wdata2(1,1))
- CALL h5dwrite_f(dset2, H5T_NATIVE_INTEGER_1, f_ptr, error)
+ CALL h5dwrite_f(dset2, H5T_NATIVE_INTEGER_KIND(1), f_ptr, error)
CALL check("h5dwrite_f",error, total_error)
!
! Create reference to a list of elements in dset2.
@@ -2112,7 +2114,7 @@ SUBROUTINE t_regref(total_error)
CALL check("h5screate_simple_f",error, total_error)
f_ptr = C_LOC(rdata2(1)(1:1))
- CALL h5dread_f( dset2, H5T_NATIVE_INTEGER_1, f_ptr, error, memspace, space)
+ CALL h5dread_f( dset2, H5T_NATIVE_INTEGER_KIND(1), f_ptr, error, memspace, space)
CALL check("H5Dread_f",error, total_error)
CALL verify("h5dread_f",rdata2(1)(1:npoints),TRIM(chrref_correct(i)), total_error)
@@ -2886,33 +2888,23 @@ SUBROUTINE setup_buffer(data_in, line_lengths, char_type)
CHARACTER(len=10), DIMENSION(:) :: data_in
INTEGER(size_t), DIMENSION(:) :: line_lengths
- INTEGER, DIMENSION(1:3) :: letters
- CHARACTER(LEN=3) :: lets
+ CHARACTER(LEN=3) :: lets = 'abc'
CHARACTER(KIND=C_CHAR,LEN=*) :: char_type
- CHARACTER(KIND=C_CHAR,LEN=1) :: char_tmp
- INTEGER :: i, j, n, ff
+ INTEGER :: i, j, n
- ! Convert the letters and special character to integers
- lets = 'abc'
-
- READ(lets,'(3A1)') letters
- READ(char_type,'(A1)') ff
n = SIZE(data_in)
j = 1
DO i=1,n-1
IF( j .EQ. 4 )THEN
- WRITE(char_tmp,'(A1)') ff
- data_in(i:i) = char_tmp
+ data_in(i:i) = char_type(1:1)
ELSE
- WRITE(char_tmp,'(A1)') letters(j)
- data_in(i:i) = char_tmp
+ data_in(i:i) = lets(j:j)
ENDIF
line_lengths(i) = LEN_TRIM(data_in(i))
j = j + 1
IF( j .EQ. 5 ) j = 1
END DO
- WRITE(char_tmp,'(A1)') ff
- data_in(n:n) = char_tmp
+ data_in(n:n) = char_type(1:1)
line_lengths(n) = 1
END SUBROUTINE setup_buffer
diff --git a/fortran/test/tf.F90 b/fortran/test/tf.F90
index 219254b..26b3e99 100644
--- a/fortran/test/tf.F90
+++ b/fortran/test/tf.F90
@@ -40,7 +40,8 @@ MODULE TH5_MISC
INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors
! generic compound datatype
- TYPE, BIND(C) :: comp_datatype
+ TYPE :: comp_datatype
+ SEQUENCE
REAL :: a
INTEGER :: x
DOUBLE PRECISION :: y
@@ -336,14 +337,10 @@ CONTAINS
IMPLICIT NONE
TYPE(comp_datatype), INTENT(in) :: a
-#ifdef H5_FORTRAN_HAVE_C_SIZEOF
- H5_SIZEOF_CMPD = C_SIZEOF(a)
+#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
+ H5_SIZEOF_CMPD = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t)
#else
-# ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
- H5_SIZEOF_CMPD = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t)
-# else
- H5_SIZEOF_CMPD = SIZEOF(a)
-# endif
+ H5_SIZEOF_CMPD = SIZEOF(a)
#endif
END FUNCTION H5_SIZEOF_CMPD