diff options
| -rw-r--r-- | config/cmake/HDF5UseFortran.cmake | 3 | ||||
| -rw-r--r-- | config/conclude_fc.am | 4 | ||||
| -rw-r--r-- | configure.ac | 1 | ||||
| -rw-r--r-- | fortran/src/H5Pff.F90 | 14 | ||||
| -rw-r--r-- | fortran/src/H5_f.c | 238 | ||||
| -rw-r--r-- | fortran/src/H5_ff.F90 | 39 | ||||
| -rw-r--r-- | fortran/src/H5f90global.F90 | 43 | ||||
| -rw-r--r-- | fortran/src/H5fort_type_defines.h.in | 1 | ||||
| -rw-r--r-- | fortran/src/H5match_types.c | 149 | ||||
| -rw-r--r-- | fortran/test/Makefile.am | 4 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test_F03.F90 | 2 | ||||
| -rw-r--r-- | fortran/test/tH5T_F03.F90 | 46 | ||||
| -rw-r--r-- | fortran/test/tf.F90 | 13 | ||||
| -rw-r--r-- | hl/fortran/src/H5TBff.F90 | 3 | ||||
| -rw-r--r-- | hl/fortran/src/Makefile.am | 2 | ||||
| -rw-r--r-- | hl/fortran/test/tsttable.F90 | 36 | ||||
| -rw-r--r-- | m4/aclocal_fc.m4 | 5 |
17 files changed, 240 insertions, 363 deletions
diff --git a/config/cmake/HDF5UseFortran.cmake b/config/cmake/HDF5UseFortran.cmake index 41efadc..eba448c 100644 --- a/config/cmake/HDF5UseFortran.cmake +++ b/config/cmake/HDF5UseFortran.cmake @@ -159,9 +159,12 @@ set(PAC_FC_ALL_REAL_KINDS "\{${pac_validRealKinds}\}") list(GET PROG_OUTPUT 3 NUM_IKIND) list(GET PROG_OUTPUT 4 NUM_RKIND) +set(PAC_FORTRAN_NUM_INTEGER_KINDS "${NUM_IKIND}") + set(H5CONFIG_F_NUM_IKIND "INTEGER, PARAMETER :: num_ikinds = ${NUM_IKIND}") set(H5CONFIG_F_IKIND "INTEGER, DIMENSION(1:num_ikinds) :: ikind = (/${pac_validIntKinds}/)") +message (STATUS "....NUMBER OF INTEGER KINDS FOUND ${PAC_FORTRAN_NUM_INTEGER_KINDS}") message (STATUS "....REAL KINDS FOUND ${PAC_FC_ALL_REAL_KINDS}") message (STATUS "....INTEGER KINDS FOUND ${PAC_FC_ALL_REAL_KINDS}") message (STATUS "....MAX DECIMAL PRECISION ${H5_PAC_FC_MAX_REAL_PRECISION}") diff --git a/config/conclude_fc.am b/config/conclude_fc.am index d9e7b56..6402412 100644 --- a/config/conclude_fc.am +++ b/config/conclude_fc.am @@ -26,8 +26,8 @@ LTPPFCCOMPILE = $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=co # Treat all .f90 and .F90 files as preprocessed Fortran. .f90.o: - $(PPFCCOMPILE) -c -o $@ $(FCFLAGS) $< + $(PPFCCOMPILE) -c -o $@ $< .F90.o: - $(PPFCCOMPILE) -c -o $@ $(FCFLAGS) $< + $(PPFCCOMPILE) -c -o $@ $< include $(top_srcdir)/config/conclude.am diff --git a/configure.ac b/configure.ac index 028bd5f..31b5e14 100644 --- a/configure.ac +++ b/configure.ac @@ -551,6 +551,7 @@ if test "X$HDF_FORTRAN" = "Xyes"; then AC_SUBST([PAC_FC_ALL_REAL_KINDS]) AC_SUBST([PAC_FC_MAX_REAL_PRECISION]) + AC_SUBST([PAC_FORTRAN_NUM_INTEGER_KINDS]) AC_SUBST([PAC_FC_ALL_INTEGER_KINDS]) AC_SUBST([PAC_FC_ALL_REAL_KINDS_SIZEOF]) AC_SUBST([PAC_FC_ALL_INTEGER_KINDS_SIZEOF]) 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 diff --git a/hl/fortran/src/H5TBff.F90 b/hl/fortran/src/H5TBff.F90 index a31c751..5d1ee35 100644 --- a/hl/fortran/src/H5TBff.F90 +++ b/hl/fortran/src/H5TBff.F90 @@ -376,7 +376,8 @@ CONTAINS INTEGER(size_t), INTENT(in) :: dst_size ! The size of the structure type INTEGER(size_t), DIMENSION(1:nfields), INTENT(in) :: dst_offset ! An array containing the offsets of the fields INTEGER(size_t), DIMENSION(1:nfields), INTENT(in) :: dst_sizes ! An array containing the sizes of the fields - TYPE(C_PTR), INTENT(OUT) :: dst_buf ! Buffer with data + TYPE(C_PTR) :: dst_buf ! Buffer with data !! do not use INTENT, causes NAG + ! to segfault in C APIs INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length diff --git a/hl/fortran/src/Makefile.am b/hl/fortran/src/Makefile.am index 571ca45..7ac18cd 100644 --- a/hl/fortran/src/Makefile.am +++ b/hl/fortran/src/Makefile.am @@ -86,8 +86,6 @@ H5LTff_gen.F90: H5HL_buildiface$(EXEEXT) H5TBff_gen.F90: H5HL_buildiface$(EXEEXT) -#H5TBff_gen.F90: H5HL_buildiface$(EXEEXT) - # H5HL_buildiface.F90 is included in the distribution, and Automake knows # how to compile a fortran program given its sources. diff --git a/hl/fortran/test/tsttable.F90 b/hl/fortran/test/tsttable.F90 index 62d291f..3cf8fed 100644 --- a/hl/fortran/test/tsttable.F90 +++ b/hl/fortran/test/tsttable.F90 @@ -185,7 +185,7 @@ SUBROUTINE test_table1() ! make table !------------------------------------------------------------------------- - test_txt = " Make table" + test_txt = "Make table" CALL test_begin(test_txt) CALL h5tbmake_table_f(dsetname1,& @@ -508,7 +508,6 @@ SUBROUTINE test_table1() WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: RETURN ERROR")') STOP ENDIF - ! "field4abc" was deleted and "field5" was added. field_names(4) = "field5" @@ -538,7 +537,6 @@ SUBROUTINE test_table1() ! CALL h5fclose_f(file_id, errcode) - ! ! end function. ! @@ -557,15 +555,16 @@ SUBROUTINE test_table2() IMPLICIT NONE - INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors - INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(9) ! (18) !should map to INTEGER*8 on most modern processors + INTEGER, PARAMETER :: i8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors + INTEGER, PARAMETER :: i16 = SELECTED_INT_KIND(9) ! (18) !should map to INTEGER*8 on most modern processors INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(5) ! This should map to REAL*4 on most modern processors INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors TYPE particle_t + SEQUENCE CHARACTER(LEN=11) :: name - INTEGER(KIND=int_kind_8) :: lati - INTEGER(KIND=int_kind_16) :: long + INTEGER(KIND=i8) :: lati + INTEGER(KIND=i16) :: long REAL(KIND=sp) :: pressure REAL(KIND=dp) :: temperature END TYPE particle_t @@ -607,23 +606,23 @@ SUBROUTINE test_table2() test_txt = "Testing H5TBread_table_f and H5TBmake_table_f (F2003)" CALL test_begin(test_txt) + ! Define an array of Particles p_data(1:nrecords) = (/ & - particle_t("zero ",0_int_kind_8,0_int_kind_16,0.0_sp,0.0_dp), & - particle_t("one ",10_int_kind_8,10_int_kind_16,10.0_sp,10.0_dp), & - particle_t("two ",20_int_kind_8,20_int_kind_16,20.0_sp,20.0_dp), & - particle_t("three ",30_int_kind_8,30_int_kind_16,30.0_sp,30.0_dp),& - particle_t("four ",40_int_kind_8,40_int_kind_16,40.0_sp,40.0_dp), & - particle_t("five ",50_int_kind_8,50_int_kind_16,50.0_sp,50.0_dp), & - particle_t("six ",60_int_kind_8,60_int_kind_16,60.0_sp,60.0_dp), & - particle_t("seven ",70_int_kind_8,70_int_kind_16,70.0_sp,70.0_dp) & + particle_t("zero ",0_i8,0_i16,0.0_sp,0.0_dp), & + particle_t("one ",10_i8,10_i16,10.0_sp,10.0_dp), & + particle_t("two ",20_i8,20_i16,20.0_sp,20.0_dp), & + particle_t("three ",30_i8,30_i16,30.0_sp,30.0_dp),& + particle_t("four ",40_i8,40_i16,40.0_sp,40.0_dp), & + particle_t("five ",50_i8,50_i16,50.0_sp,50.0_dp), & + particle_t("six ",60_i8,60_i16,60.0_sp,60.0_dp), & + particle_t("seven ",70_i8,70_i16,70.0_sp,70.0_dp) & /) - fill_data(1:nrecords) = particle_t("no data",-1_int_kind_8, -2_int_kind_16, -99.0_sp, -100.0_dp) + fill_data(1:nrecords) = particle_t("no data",-1_i8, -2_i16, -99.0_sp, -100.0_dp) compress = 0 - dst_size = H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(2))) #ifdef H5_FORTRAN_HAVE_STORAGE_SIZE @@ -673,11 +672,10 @@ SUBROUTINE test_table2() f_ptr1 = C_NULL_PTR f_ptr2 = C_LOC(fill_data(1)%name(1:1)) - CALL h5tbmake_table_f("Table Title Fill", file_id, table_name_fill, nfields, nrecords, & dst_size, field_names, dst_offset, field_type, & chunk_size, f_ptr2, compress, f_ptr1, errcode ) - + f_ptr3 = C_LOC(r_data(1)%name(1:1)) CALL h5tbread_table_f(file_id, table_name_fill, nfields, dst_size, dst_offset, dst_sizes, f_ptr3, errcode) diff --git a/m4/aclocal_fc.m4 b/m4/aclocal_fc.m4 index 763ab77..2213a7c 100644 --- a/m4/aclocal_fc.m4 +++ b/m4/aclocal_fc.m4 @@ -280,7 +280,8 @@ AC_RUN_IFELSE([$TEST_SRC], PAC_FC_ALL_INTEGER_KINDS="{`echo $pac_validIntKinds`}" PAC_FC_ALL_REAL_KINDS="{`echo $pac_validRealKinds`}" - H5CONFIG_F_NUM_IKIND="INTEGER, PARAMETER :: num_ikinds = `sed -n '4p' pac_fconftest.out`" + PAC_FORTRAN_NUM_INTEGER_KINDS="`sed -n '4p' pac_fconftest.out`" + H5CONFIG_F_NUM_IKIND="INTEGER, PARAMETER :: num_ikinds = `echo $PAC_FORTRAN_NUM_INTEGER_KINDS`" H5CONFIG_F_IKIND="INTEGER, DIMENSION(1:num_ikinds) :: ikind = (/`echo $pac_validIntKinds`/)" H5CONFIG_F_NUM_RKIND="INTEGER, PARAMETER :: num_rkinds = `sed -n '5p' pac_fconftest.out`" H5CONFIG_F_RKIND="INTEGER, DIMENSION(1:num_rkinds) :: rkind = (/`echo $pac_validRealKinds`/)" @@ -290,6 +291,8 @@ AC_RUN_IFELSE([$TEST_SRC], AC_DEFINE_UNQUOTED([H5CONFIG_F_RKIND], $H5CONFIG_F_RKIND, [Define valid Fortran REAL KINDs]) AC_DEFINE_UNQUOTED([H5CONFIG_F_IKIND], $H5CONFIG_F_IKIND, [Define valid Fortran INTEGER KINDs]) + AC_MSG_CHECKING([for Number of Fortran INTEGER KINDs]) + AC_MSG_RESULT([$PAC_FORTRAN_NUM_INTEGER_KINDS]) AC_MSG_CHECKING([for Fortran INTEGER KINDs]) AC_MSG_RESULT([$PAC_FC_ALL_INTEGER_KINDS]) AC_MSG_CHECKING([for Fortran REAL KINDs]) |