diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2016-10-06 20:34:39 (GMT) |
---|---|---|
committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2016-10-06 20:34:39 (GMT) |
commit | c604bca0445ba1d05a976a673768fa677422e93e (patch) | |
tree | 7d5438638d4081cb0fcbd1620f6ca0eaf543f1fe /fortran | |
parent | 783f01f478f99711710b24d8c85b0555dcdcf1fc (diff) | |
parent | f9364c0080405bb36d704eb3f9505029d3da41f4 (diff) | |
download | hdf5-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.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 |
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 |