summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Pff.F9014
-rw-r--r--fortran/src/H5_f.c236
-rw-r--r--fortran/src/H5_ff.F9038
-rw-r--r--fortran/src/H5f90global.F9043
-rw-r--r--fortran/src/H5match_types.c40
-rw-r--r--fortran/test/fortranlib_test_F03.F902
-rw-r--r--fortran/test/tH5T_F03.F9042
7 files changed, 181 insertions, 234 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..9d4c297 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
@@ -55,173 +59,136 @@ 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 H5T_NATIVE_INTEGER_#
+ */
+ for(i=0;i<4;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] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[i], 128) < 0) return ret_value;
+ } /*end else */
+
+ }
+
+#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+ /*
+ * FIND H5T_NATIVE_INTEGER_KIND(5), INTEGER*16
+ */
+ if (sizeof(int_16_f) == sizeof(char)) {
+ if ((types[4] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
+ } /*end if */
+ else if (sizeof(int_16_f) == sizeof(short)) {
+ if ((types[4] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
+ } /*end if */
+ else if (sizeof(int_16_f) == sizeof(int)) {
+ if ((types[4] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
+ } /*end if */
+ else if (sizeof(int_16_f) == sizeof(long long)) {
+ if ((types[4] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
+ } /*end else */
+ else {
+ if ((types[4] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[4], 128) < 0) return ret_value;
+ } /*end else */
+#else
+ if ((types[4] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+ if ( H5Tset_precision (types[4], 128) < 0) return ret_value;
+#endif
-/* 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 ((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;
-
-/*
- 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;
-*/
+ types[8] = (hid_t_f)c_type_id;
-
-/* 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,60 +196,35 @@ 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
diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90
index 169864f..9717d17 100644
--- a/fortran/src/H5_ff.F90
+++ b/fortran/src/H5_ff.F90
@@ -379,27 +379,24 @@ 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
+ !PRINT*,ikind, Fortran_INTEGER_AVAIL_KINDS(i),H5T_NATIVE_INTEGER_KIND(i)
+ 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
@@ -414,9 +411,6 @@ CONTAINS
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/H5match_types.c b/fortran/src/H5match_types.c
index 98128db..6f5af49 100644
--- a/fortran/src/H5match_types.c
+++ b/fortran/src/H5match_types.c
@@ -100,7 +100,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\
@@ -175,6 +175,11 @@ int main(void)
H5_FORTRAN_NUM_INTEGER_KINDS = (int)(sizeof(IntKinds)/sizeof(IntKinds[0]));
H5_FORTRAN_NUM_REAL_KINDS = (int)(sizeof(RealKinds)/sizeof(RealKinds[0]));
+
+
+ fprintf(fort_header," INTEGER, PARAMETER :: H5_FORTRAN_NUM_INTEGER_KINDS = %d\n", H5_FORTRAN_NUM_INTEGER_KINDS);
+
+
for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) {
if(sizeof(long long) == IntKinds_SizeOf[i])
writeTypedef("int", "long long", IntKinds[i]);
@@ -258,7 +263,7 @@ int main(void)
/* haddr_t */
for(i=0;i< H5_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], IntKinds[i]);
break;
}
if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
@@ -269,7 +274,7 @@ int main(void)
/* hsize_t */
for(i=0;i< H5_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], IntKinds[i]);
break;
}
if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
@@ -280,7 +285,7 @@ int main(void)
/* hssize_t */
for(i=0;i< H5_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], IntKinds[i]);
break;
}
if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
@@ -291,7 +296,7 @@ int main(void)
/* off_t */
for(i=0;i< H5_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], IntKinds[i]);
break;
}
if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
@@ -302,7 +307,7 @@ int main(void)
/* size_t */
for(i=0;i< H5_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], IntKinds[i]);
break;
}
if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
@@ -311,7 +316,7 @@ int main(void)
}
/* 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, H5_FORTRAN_NATIVE_INTEGER_KIND);
/* int_1, int_2, int_4, int_8 */
@@ -327,16 +332,29 @@ int main(void)
FoundIntSize[3] = -1;
FoundIntSize[4] = -1;
+ fprintf(fort_header," INTEGER, DIMENSION(1:%d), PARAMETER :: Fortran_INTEGER_AVAIL_KINDS = (/", H5_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]); */
+ fprintf(fort_header,"%d",(int)IntKinds[i]);
+ if(i==H5_FORTRAN_NUM_INTEGER_KINDS-1) {
+ fprintf(fort_header,"/)\n");
+ } else {
+ fprintf(fort_header,",");
+ }
+
}
+
+
+
+
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(chrA, "Fortran_INTEGER_KINDS_%d", FoundIntSizeKind[i]);
sprintf(chrB, "int_%d_f", FoundIntSize[i]);
writeToFiles("int",chrA, chrB, FoundIntSize[i], FoundIntSizeKind[i]);
}
@@ -347,7 +365,7 @@ int main(void)
{
if( FoundIntSize[j] > 0) /* Found the next highest */
{
- sprintf(chrA, "Fortran_INTEGER_%d", (-1)*FoundIntSize[i]);
+ sprintf(chrA, "Fortran_INTEGER_KINDS_%d", (-1)*FoundIntSizeKind[i]);
sprintf(chrB, "int_%d_f", (-1)*FoundIntSize[i]);
writeToFiles("int",chrA, chrB, FoundIntSize[j], FoundIntSizeKind[j]);
flag = 1;
@@ -360,7 +378,7 @@ int main(void)
{
if( FoundIntSize[j] > 0) /* Found the next lowest */
{
- sprintf(chrA, "Fortran_INTEGER_%d", (-1)*FoundIntSize[i]);
+ sprintf(chrA, "Fortran_INTEGER_KINDS_%d", (-1)*FoundIntSizeKind[i]);
sprintf(chrB, "int_%d_f", (-1)*FoundIntSize[i]);
writeToFiles("int",chrA, chrB, FoundIntSize[j], FoundIntSizeKind[j]);
flag = 1;
@@ -391,7 +409,7 @@ int main(void)
/* hid_t */
for(i=0;i< H5_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], IntKinds[i]);
break;
}
if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) )
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..a9148a7 100644
--- a/fortran/test/tH5T_F03.F90
+++ b/fortran/test/tH5T_F03.F90
@@ -1144,33 +1144,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 +2000,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 +2112,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 +2886,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