From ea66068977639b7b2737bb9db1e59b26db914d1e Mon Sep 17 00:00:00 2001 From: Elena Pourmal Date: Wed, 22 Jun 2005 13:23:21 -0500 Subject: [svn-r10970] Purpose: New feature/bug #350 fix Description: When compiler flag was used to set the size of Fortran integer to 8 bytes, library would fail. Solution: Cleaned up the code; added detection of Fortran INTEGER type size and appropriately defined int_f type for C-stubs routines. Platforms tested: Solaris 2.8 32 and 64-bit, AIX 5.1 64-bit parallel PGI Fortran with -i8 flag on heping Absoft Fortran with -i8 flag on heping g95 on mir (Fortran integer is 8 bytes by default that cannot be changed - compiler bug ;-) AIX Fortran with -qintsize=8 32 and 64-bit modes on copper Misc. update: --- fortran/src/H5Aff.f90 | 4 +- fortran/src/H5Df.c | 9 +++-- fortran/src/H5Dff.f90 | 5 +-- fortran/src/H5Ff.c | 20 +++++----- fortran/src/H5Fff.f90 | 14 +++---- fortran/src/H5Pf.c | 2 +- fortran/src/H5Tf.c | 11 +++--- fortran/src/H5_f.c | 23 ++++++++++-- fortran/src/H5_ff.f90 | 4 +- fortran/src/H5f90global.f90 | 18 ++++----- fortran/src/H5f90proto.h | 4 +- fortran/src/H5match_types.c | 8 ++-- fortran/src/H5test_kind.f90 | 25 +++++++++++++ fortran/test/fortranlib_test.f90 | 13 ------- fortran/test/tH5F.f90 | 4 +- fortran/test/tH5I.f90 | 5 ++- fortran/test/tH5P.f90 | 10 +++-- hl/fortran/src/H5IMfc.c | 10 ++--- hl/fortran/src/H5LTf90proto.h | 4 +- hl/fortran/src/H5LTfc.c | 76 +++++++++++++++++++++++--------------- hl/fortran/test/tstimage.f90 | 2 - hl/fortran/test/tstlite.f90 | 3 +- hl/src/H5IM.c | 67 ++++++++++++++++++++++++++++----- hl/src/H5IM.h | 11 +++--- hl/src/H5LT.c | 80 ++++++++++++++++++++++++++++++++++++++++ hl/src/H5LT.h | 11 ++++++ release_docs/RELEASE.txt | 6 +++ 27 files changed, 323 insertions(+), 126 deletions(-) diff --git a/fortran/src/H5Aff.f90 b/fortran/src/H5Aff.f90 index 56d5782..7b772f3 100644 --- a/fortran/src/H5Aff.f90 +++ b/fortran/src/H5Aff.f90 @@ -153,7 +153,7 @@ INTEGER(HID_T), OPTIONAL, INTENT(IN) :: creation_prp ! Attribute creation property ! list identifier - INTEGER :: creation_prp_default + INTEGER(HID_T) :: creation_prp_default INTEGER(SIZE_T) :: namelen ! INTEGER, EXTERNAL :: h5acreate_c ! MS FORTRAN needs explicit interface for C functions called here. @@ -171,7 +171,7 @@ INTEGER(SIZE_T) :: namelen INTEGER(HID_T), INTENT(IN) :: type_id INTEGER(HID_T), INTENT(IN) :: space_id - INTEGER :: creation_prp_default + INTEGER(HID_T) :: creation_prp_default INTEGER(HID_T), INTENT(OUT) :: attr_id END FUNCTION h5acreate_c END INTERFACE diff --git a/fortran/src/H5Df.c b/fortran/src/H5Df.c index ccf9804..d8abc88 100644 --- a/fortran/src/H5Df.c +++ b/fortran/src/H5Df.c @@ -91,6 +91,9 @@ nh5dopen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dset_id) int c_namelen; hid_t c_loc_id; hid_t c_dset_id; + hid_t plist; + off_t offset; + hsize_t size; /* * Convert FORTRAN name to C name @@ -759,7 +762,7 @@ nh5dwrite_vl_integer_c ( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_ hid_t c_file_space_id; hid_t c_xfer_prp; herr_t status; - int *tmp; + int_f *tmp; size_t max_len; hvl_t *c_buf; @@ -777,7 +780,7 @@ nh5dwrite_vl_integer_c ( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_ c_buf = (hvl_t *)malloc((size_t)num_elem * sizeof(hvl_t)); if (c_buf == NULL) return ret_value; - tmp = (int *)buf; + tmp = (int_f *)buf; for (i=0; i < num_elem; i++) { c_buf[i].len = (size_t)len[i]; c_buf[i].p = tmp; @@ -849,7 +852,7 @@ nh5dread_vl_integer_c ( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_s if ( status < 0 ) goto DONE; for (i=0; i < num_elem; i++) { len[i] = (size_t_f)c_buf[i].len; - memcpy(&buf[i*max_len], c_buf[i].p, c_buf[i].len*sizeof(int)); + memcpy(&buf[i*max_len], c_buf[i].p, c_buf[i].len*sizeof(int_f)); } H5Dvlen_reclaim(c_mem_type_id, c_mem_space_id, H5P_DEFAULT, c_buf); ret_value = 0; diff --git a/fortran/src/H5Dff.f90 b/fortran/src/H5Dff.f90 index 7ceb9f0..a279e87 100644 --- a/fortran/src/H5Dff.f90 +++ b/fortran/src/H5Dff.f90 @@ -165,7 +165,7 @@ INTEGER(HID_T), OPTIONAL, INTENT(IN) :: creation_prp ! Dataset creation propertly ! list identifier - INTEGER :: creation_prp_default + INTEGER(HID_T) :: creation_prp_default INTEGER :: namelen ! Name length ! INTEGER, EXTERNAL :: h5dcreate_c @@ -184,7 +184,7 @@ INTEGER :: namelen INTEGER(HID_T), INTENT(IN) :: type_id INTEGER(HID_T), INTENT(IN) :: space_id - INTEGER :: creation_prp_default + INTEGER(HID_T) :: creation_prp_default INTEGER(HID_T), INTENT(OUT) :: dset_id END FUNCTION h5dcreate_c END INTERFACE @@ -629,7 +629,6 @@ if (present(xfer_prp)) xfer_prp_default = xfer_prp if (present(mem_space_id)) mem_space_id_default = mem_space_id if (present(file_space_id)) file_space_id_default = file_space_id - hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & file_space_id_default, xfer_prp_default, & buf, dims) diff --git a/fortran/src/H5Ff.c b/fortran/src/H5Ff.c index 9ad8de7..cc3fb36 100644 --- a/fortran/src/H5Ff.c +++ b/fortran/src/H5Ff.c @@ -36,7 +36,7 @@ nh5fcreate_c(_fcd name, int_f *namelen, int_f *access_flags, hid_t_f* crt_prp, h { int ret_value = -1; char *c_name; - int c_namelen; + int_f c_namelen; hid_t c_file_id; unsigned c_access_flags; hid_t c_crt_prp; @@ -65,7 +65,7 @@ nh5fcreate_c(_fcd name, int_f *namelen, int_f *access_flags, hid_t_f* crt_prp, h * Convert FORTRAN name to C name */ c_namelen = *namelen; - c_name = (char *)HD5f2cstring(name, c_namelen); + c_name = (char *)HD5f2cstring(name, (size_t)c_namelen); if (c_name == NULL) return ret_value; /* @@ -133,7 +133,7 @@ nh5fmount_c (hid_t_f *loc_id, _fcd dsetname, int_f *namelen, hid_t_f *file_id, h { int ret_value = -1; char *c_name; - int c_namelen; + int_f c_namelen; hid_t c_loc_id; hid_t c_file_id; hid_t c_acc_prp; @@ -153,7 +153,7 @@ nh5fmount_c (hid_t_f *loc_id, _fcd dsetname, int_f *namelen, hid_t_f *file_id, h * Convert FORTRAN name to C name */ c_namelen = *namelen; - c_name = (char *)HD5f2cstring(dsetname, c_namelen); + c_name = (char *)HD5f2cstring(dsetname, (size_t)c_namelen); if (c_name == NULL) return ret_value; /* @@ -183,7 +183,7 @@ nh5funmount_c (hid_t_f *loc_id, _fcd dsetname, int_f *namelen) { int ret_value = -1; char *c_name; - int c_namelen; + int_f c_namelen; hid_t c_loc_id; htri_t status; @@ -193,7 +193,7 @@ nh5funmount_c (hid_t_f *loc_id, _fcd dsetname, int_f *namelen) * Convert FORTRAN name to C name */ c_namelen = *namelen; - c_name = (char *)HD5f2cstring(dsetname, c_namelen); + c_name = (char *)HD5f2cstring(dsetname, (size_t)c_namelen); if (c_name == NULL) return ret_value; /* @@ -227,7 +227,7 @@ nh5fopen_c (_fcd name, int_f *namelen, int_f *access_flags, hid_t_f *acc_prp, hi { int ret_value = -1; char *c_name; - int c_namelen; + int_f c_namelen; hid_t c_file_id; unsigned c_access_flags; hid_t c_acc_prp; @@ -249,7 +249,7 @@ nh5fopen_c (_fcd name, int_f *namelen, int_f *access_flags, hid_t_f *acc_prp, hi * Convert FORTRAN name to C name */ c_namelen = *namelen; - c_name = (char *)HD5f2cstring(name, c_namelen); + c_name = (char *)HD5f2cstring(name, (size_t)c_namelen); if (c_name == NULL) return ret_value; /* @@ -360,14 +360,14 @@ nh5fis_hdf5_c (_fcd name, int_f *namelen, int_f *flag) { int ret_value = -1; char *c_name; - int c_namelen; + int_f c_namelen; htri_t status; /* * Convert FORTRAN name to C name */ c_namelen = *namelen; - c_name = (char *)HD5f2cstring(name, c_namelen); + c_name = (char *)HD5f2cstring(name, (size_t)c_namelen); if (c_name == NULL) return ret_value; /* diff --git a/fortran/src/H5Fff.f90 b/fortran/src/H5Fff.f90 index 4fbeba9..126fde1 100644 --- a/fortran/src/H5Fff.f90 +++ b/fortran/src/H5Fff.f90 @@ -68,8 +68,8 @@ INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp ! File access property list ! identifier - INTEGER :: creation_prp_default - INTEGER :: access_prp_default + INTEGER(HID_T) :: creation_prp_default + INTEGER(HID_T) :: access_prp_default INTEGER :: namelen ! Length of the name character string ! INTEGER, EXTERNAL :: h5fcreate_c @@ -86,8 +86,8 @@ CHARACTER(LEN=*), INTENT(IN) :: name INTEGER, INTENT(IN) :: access_flags INTEGER(HID_T), INTENT(OUT) :: file_id - INTEGER, INTENT(IN) :: creation_prp_default - INTEGER, INTENT(IN) :: access_prp_default + INTEGER(HID_T), INTENT(IN) :: creation_prp_default + INTEGER(HID_T), INTENT(IN) :: access_prp_default INTEGER :: namelen END FUNCTION h5fcreate_c END INTERFACE @@ -223,7 +223,7 @@ INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp ! File access property list ! identifier - INTEGER :: access_prp_default + INTEGER(HID_T) :: access_prp_default INTEGER :: namelen ! Length of the name character string ! INTEGER, EXTERNAL :: h5fmount_c @@ -360,7 +360,7 @@ INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp ! File access property list ! identifier - INTEGER :: access_prp_default + INTEGER(HID_T) :: access_prp_default INTEGER :: namelen ! Length of the name character string ! INTEGER, EXTERNAL :: h5fopen_c @@ -377,7 +377,7 @@ CHARACTER(LEN=*), INTENT(IN) :: name INTEGER :: namelen INTEGER, INTENT(IN) :: access_flags - INTEGER, INTENT(IN) :: access_prp_default + INTEGER(HID_T), INTENT(IN) :: access_prp_default INTEGER(HID_T), INTENT(OUT) :: file_id END FUNCTION h5fopen_c END INTERFACE diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c index 910ab89..2b6e8be 100644 --- a/fortran/src/H5Pf.c +++ b/fortran/src/H5Pf.c @@ -1646,7 +1646,7 @@ nh5pget_external_c(hid_t_f *prp_id, int_f *idx, size_t_f* name_size, _fcd name, * Call H5Pget_external function. */ c_prp_id = (hid_t)*prp_id; - c_idx = (unsigned)*idx; + c_idx = (unsigned)*idx; status = H5Pget_external(c_prp_id, c_idx, c_namelen, c_name, &c_offset, &size ); if (status < 0) goto DONE; diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c index 8fbcbef..cd1ccd0 100644 --- a/fortran/src/H5Tf.c +++ b/fortran/src/H5Tf.c @@ -1397,7 +1397,7 @@ nh5tenum_insert_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) hid_t c_type_id; char* c_name; int c_namelen; - int c_value; + int_f c_value; herr_t error; c_namelen = *namelen; @@ -1437,11 +1437,11 @@ nh5tenum_nameof_c(hid_t_f *type_id, int_f* value, _fcd name, size_t_f* namelen) char* c_name; size_t c_namelen; herr_t error; - int c_value; + int_f c_value; c_value = *value; c_namelen = ((size_t)*namelen) +1; c_name = (char *)malloc(sizeof(char)*c_namelen); - c_type_id = *type_id; + c_type_id = (hid_t)*type_id; error = H5Tenum_nameof(c_type_id, &c_value, c_name, c_namelen); HD5packFstring(c_name, _fcdtocp(name), (int)strlen(c_name)); HDfree(c_name); @@ -1472,17 +1472,16 @@ nh5tenum_valueof_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) hid_t c_type_id; char* c_name; int c_namelen; - int c_value; herr_t error; c_namelen = *namelen; c_name = (char *)HD5f2cstring(name, c_namelen); if (c_name == NULL) return ret_value; c_type_id = *type_id; - error = H5Tenum_valueof(c_type_id, c_name, &c_value); + error = H5Tenum_valueof(c_type_id, c_name, value); HDfree(c_name); + if(error < 0) return ret_value; - *value = (int_f)c_value; ret_value = 0; return ret_value; } diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index 07eff36..8d88667 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -43,7 +43,22 @@ nh5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertype int ret_value = -1; hid_t c_type_id; + size_t tmp_val; + +/* Fortran INTEGER is may not be the same as C in; 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; + } /*end if */ + else if (sizeof(int_f) == sizeof(long)) { + if ((types[0] = (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; + } /*end else */ + /* Accomodate Crays with this check */ if(sizeof(real_f)==sizeof(double)) { if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value; @@ -52,11 +67,13 @@ nh5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertype if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value; } /* end else */ if ((types[2] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value; + /* if ((types[3] = H5Tcopy(H5T_NATIVE_UINT8)) < 0) return ret_value; */ if ((c_type_id = H5Tcopy(H5T_FORTRAN_S1)) < 0) return ret_value; - if(H5Tset_size(c_type_id, 1) < 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; @@ -188,7 +205,7 @@ int_f nh5init_flags_c( int_f *h5d_flags, int_f *h5f_flags, int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, int_f *h5g_flags, int_f *h5i_flags, - int_f *h5p_flags, int_f *h5r_flags, int_f *h5s_flags, + hid_t_f *h5p_flags, int_f *h5r_flags, int_f *h5s_flags, int_f *h5t_flags, int_f *h5z_flags) { int ret_value = -1; @@ -317,7 +334,7 @@ nh5init_flags_c( int_f *h5d_flags, int_f *h5f_flags, h5s_flags[3] = H5S_SELECT_SET; h5s_flags[4] = H5S_SELECT_OR; h5s_flags[5] = (int_f)H5S_UNLIMITED; - h5s_flags[6] = H5S_ALL; + h5s_flags[6] = (int_f)H5S_ALL; h5s_flags[7] = H5S_SELECT_NOOP; h5s_flags[8] = H5S_SELECT_AND; diff --git a/fortran/src/H5_ff.f90 b/fortran/src/H5_ff.f90 index 1e8d215..4974c9a 100644 --- a/fortran/src/H5_ff.f90 +++ b/fortran/src/H5_ff.f90 @@ -91,9 +91,9 @@ INTEGER i_H5G_flags(H5G_FLAGS_LEN) INTEGER i_H5D_flags(H5D_FLAGS_LEN) INTEGER i_H5FD_flags(H5FD_FLAGS_LEN) - INTEGER i_H5FD_hid_flags(H5FD_HID_FLAGS_LEN) + INTEGER(HID_T) i_H5FD_hid_flags(H5FD_HID_FLAGS_LEN) INTEGER i_H5I_flags(H5I_FLAGS_LEN) - INTEGER i_H5P_flags(H5P_FLAGS_LEN) + INTEGER(HID_T) i_H5P_flags(H5P_FLAGS_LEN) INTEGER i_H5R_flags(H5R_FLAGS_LEN) INTEGER i_H5S_flags(H5S_FLAGS_LEN) INTEGER i_H5T_flags(H5T_FLAGS_LEN) diff --git a/fortran/src/H5f90global.f90 b/fortran/src/H5f90global.f90 index b17680e..ebd3c93 100644 --- a/fortran/src/H5f90global.f90 +++ b/fortran/src/H5f90global.f90 @@ -313,7 +313,7 @@ ! H5FD file drivers flags declaration ! INTEGER, PARAMETER :: H5FD_HID_FLAGS_LEN = 8 - INTEGER H5FD_hid_flags(H5FD_HID_FLAGS_LEN) + INTEGER(HID_T) H5FD_hid_flags(H5FD_HID_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) !DEC$ ATTRIBUTES DLLEXPORT :: /H5FD_HID_FLAGS/ !DEC$endif @@ -369,19 +369,19 @@ ! H5P flags declaration ! INTEGER, PARAMETER :: H5P_FLAGS_LEN = 7 - INTEGER H5P_flags(H5P_FLAGS_LEN) + INTEGER(HID_T) H5P_flags(H5P_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) !DEC$ ATTRIBUTES DLLEXPORT :: /H5P_FLAGS/ !DEC$endif COMMON /H5P_FLAGS/ H5P_flags - INTEGER :: H5P_FILE_CREATE_F - INTEGER :: H5P_FILE_ACCESS_F - INTEGER :: H5P_DATASET_CREATE_F - INTEGER :: H5P_DATASET_XFER_F - INTEGER :: H5P_MOUNT_F - INTEGER :: H5P_DEFAULT_F - INTEGER :: H5P_NO_CLASS_F + INTEGER(HID_T) :: H5P_FILE_CREATE_F + INTEGER(HID_T) :: H5P_FILE_ACCESS_F + INTEGER(HID_T) :: H5P_DATASET_CREATE_F + INTEGER(HID_T) :: H5P_DATASET_XFER_F + INTEGER(HID_T) :: H5P_MOUNT_F + INTEGER(HID_T) :: H5P_DEFAULT_F + INTEGER(HID_T) :: H5P_NO_CLASS_F EQUIVALENCE(H5P_flags(1), H5P_FILE_CREATE_F) EQUIVALENCE(H5P_flags(2), H5P_FILE_ACCESS_F) diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 537ae97..6768f19 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -50,7 +50,7 @@ H5_FCDLL int_f nh5freopen_c (hid_t_f *file_id1, hid_t_f *file_id2); H5_FCDLL int_f nh5fget_create_plist_c (hid_t_f *file_id, hid_t_f *prop_id); H5_FCDLL int_f nh5fget_access_plist_c (hid_t_f *file_id, hid_t_f *access_id); H5_FCDLL int_f nh5fget_obj_count_c (hid_t_f *file_id, int_f *obj_type, int_f *obj_count); -H5_FCDLL int_f nh5fget_obj_ids_c (hid_t_f *file_id, int_f *obj_type, int_f *max_objs, int_f *obj_ids); +H5_FCDLL int_f nh5fget_obj_ids_c (hid_t_f *file_id, int_f *obj_type, int_f *max_objs, hid_t_f *obj_ids); H5_FCDLL int_f nh5fget_freespace_c (hid_t_f *file_id, hssize_t_f *free_space); H5_FCDLL int_f nh5fflush_c (hid_t_f *obj_id, int_f *scope); H5_FCDLL int_f nh5fget_name_c(hid_t_f *obj_id, size_t_f *size, _fcd buf, size_t_f *buflen); @@ -653,7 +653,7 @@ H5_FCDLL int_f nh5close_types_c(hid_t_f *types, int_f *lentypes, hid_t_f * float H5_FCDLL int_f nh5init_flags_c( int_f *h5d_flags, int_f *h5f_flags, int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, int_f *h5g_flags, int_f *h5i_flags, - int_f *h5p_flags, int_f *h5r_flags, int_f *h5s_flags, + hid_t_f *h5p_flags, int_f *h5r_flags, int_f *h5s_flags, int_f *h5t_flags, int_f *h5z_flags); H5_FCDLL int_f nh5init1_flags_c(int_f *h5lib_flags); H5_FCDLL int_f nh5get_libversion_c(int_f *majnum, int_f *minnum, int_f *relnum); diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c index 97dcf33..2edc813 100644 --- a/fortran/src/H5match_types.c +++ b/fortran/src/H5match_types.c @@ -221,13 +221,13 @@ int main() #endif /* int */ -#if defined H5_FORTRAN_HAS_INTEGER_8 && H5_SIZEOF_INT >= 8 +#if defined H5_FORTRAN_HAS_NATIVE_8 writeToFiles("INT", "int_f", 8); -#elif defined H5_FORTRAN_HAS_INTEGER_4 && H5_SIZEOF_INT >= 4 +#elif defined H5_FORTRAN_HAS_NATIVE_4 writeToFiles("INT", "int_f", 4); -#elif defined H5_FORTRAN_HAS_INTEGER_2 && H5_SIZEOF_INT >= 2 +#elif defined H5_FORTRAN_HAS_NATIVE_2 writeToFiles("INT", "int_f", 2); -#elif defined H5_FORTRAN_HAS_INTEGER_1 && H5_SIZEOF_INT >= 1 +#elif defined H5_FORTRAN_HAS_NATIVE_1 writeToFiles("INT", "int_f", 1); #else /* Error: couldn't find a size for int */ diff --git a/fortran/src/H5test_kind.f90 b/fortran/src/H5test_kind.f90 index db2971e..1f5dca3 100644 --- a/fortran/src/H5test_kind.f90 +++ b/fortran/src/H5test_kind.f90 @@ -23,11 +23,36 @@ ! Generate a program write(*,*) "program int_kind" write(*,*) "write(*,*) "" /*generating header file*/ """ + j = 0 + write(*, "("" call i"", i2.2,""()"")") j do i = 1, ii j = kind_numbers(i) write(*, "("" call i"", i2.2,""()"")") j enddo write(*,*) "end program int_kind" + j = 0 + write(*, "("" subroutine i"" i2.2,""()"")") j + write(*,*)" implicit none" + write(*,*)" integer :: a" + write(*,*)" integer :: a_size" + write(*,*)" a_size = bit_size(a)" + write(*,*)" if (a_size .eq. 8) then" + write(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_NATIVE_1"" " + write(*,*)" endif" + write(*,*)" if (a_size .eq. 16) then" + write(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_NATIVE_2"" " + write(*,*)" endif" + write(*,*)" if (a_size .eq. 32) then" + write(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_NATIVE_4"" " + write(*,*)" endif" + write(*,*)" if (a_size .eq. 64) then" + write(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_NATIVE_8"" " + write(*,*)" endif" + write(*,*)" if (a_size .eq. 128) then" + write(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_NATIVE_16"" " + write(*,*)" endif" + write(*,*)" return" + write(*,*)" end subroutine" do i = 1, ii j = kind_numbers(i) write(*, "("" subroutine i"" i2.2,""()"")") j diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90 index 6481c8b..b736edf 100644 --- a/fortran/test/fortranlib_test.f90 +++ b/fortran/test/fortranlib_test.f90 @@ -61,7 +61,6 @@ write(*,*) ' ========================== ' write(*,*) ' FORTRAN tests ' write(*,*) ' ========================== ' - CALL h5get_libversion_f(majnum, minnum, relnum, total_error) if(total_error .eq. 0) then @@ -76,7 +75,6 @@ endif write(*,*) ! CALL h5check_version_f(1,4,4,total_error) - ! write(*,*) '=========================================' ! write(*,*) 'Testing FILE Interface ' ! write(*,*) '=========================================' @@ -88,7 +86,6 @@ write(*, fmt = e_format) error_string total_error = total_error + mounting_total_error - error_string = failure CALL reopentest(cleanup, reopen_total_error) IF (reopen_total_error == 0) error_string = success @@ -96,7 +93,6 @@ write(*, fmt = '(58x,a)', advance = 'no') ' ' write(*, fmt = e_format) error_string total_error = total_error + reopen_total_error - error_string = failure CALL file_close(cleanup, fclose_total_error) IF (fclose_total_error == 0) error_string = success @@ -113,7 +109,6 @@ write(*, fmt = e_format) error_string total_error = total_error + fspace_total_error - ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing DATASET Interface ' @@ -126,7 +121,6 @@ write(*, fmt = '(57x,a)', advance = 'no') ' ' write(*, fmt = e_format) error_string total_error = total_error + dataset_total_error - error_string = failure CALL extenddsettest(cleanup, extend_dataset_total_error) IF (extend_dataset_total_error == 0) error_string = success @@ -134,7 +128,6 @@ write(*, fmt = '(46x,a)', advance = 'no') ' ' write(*, fmt = e_format) error_string total_error = total_error + extend_dataset_total_error - ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing DATASPACE Interface ' @@ -204,7 +197,6 @@ ! write(*,*) '=========================================' ! write(*,*) 'Testing DATATYPE interface ' ! write(*,*) '=========================================' - error_string = failure CALL basic_data_type_test(cleanup, basic_datatype_total_error) IF (basic_datatype_total_error == 0) error_string = success @@ -220,7 +212,6 @@ write(*, fmt = '(47x,a)', advance = 'no') ' ' write(*, fmt = e_format) error_string total_error = total_error + total_error_compoundtest - error_string = failure CALL enumtest(cleanup, enum_total_error) IF (enum_total_error == 0) error_string = success @@ -228,8 +219,6 @@ write(*, fmt = '(51x,a)', advance = 'no') ' ' write(*, fmt = e_format) error_string total_error = total_error + enum_total_error - - ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing PROPERTY interface ' @@ -251,7 +240,6 @@ write(*, fmt = '(47x,a)', advance = 'no') ' ' write(*, fmt = e_format) error_string total_error = total_error + multi_file_total_error - ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing ATTRIBUTE interface ' @@ -277,7 +265,6 @@ write(*, fmt = '(54x,a)', advance = 'no') ' ' write(*, fmt = e_format) error_string total_error = total_error + identifier_total_error - error_string = failure CALL filters_test(cleanup, z_total_error) IF (z_total_error == 0) error_string = success diff --git a/fortran/test/tH5F.f90 b/fortran/test/tH5F.f90 index d1e0064..46832bb 100644 --- a/fortran/test/tH5F.f90 +++ b/fortran/test/tH5F.f90 @@ -678,8 +678,10 @@ write(*,*) "File should be closed at this point, error" endif - if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + if(cleanup) then + CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) + endif deallocate(obj_ids) RETURN diff --git a/fortran/test/tH5I.f90 b/fortran/test/tH5I.f90 index 8790bc3..6864c4b 100644 --- a/fortran/test/tH5I.f90 +++ b/fortran/test/tH5I.f90 @@ -257,13 +257,14 @@ ! Close the file by decrementing the reference count CALL h5idec_ref_f(file_id, ref_count, error) - CALL check("h5iinc_ref_f",error,total_error) + CALL check("h5idec_ref_f",error,total_error) CALL verify("get file ref count wrong",ref_count,0,total_error) - ! Try closing the file again (should fail) + CALL h5eset_auto_f(0, error) CALL h5fclose_f(file_id, error) CALL verify("file close should fail",error,-1,total_error) ! Clear the error stack from the file close failure + CALL h5eset_auto_f(1, error) CALL h5eclear_f(error) if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90 index 19a657f..af301aa 100644 --- a/fortran/test/tH5P.f90 +++ b/fortran/test/tH5P.f90 @@ -44,6 +44,7 @@ !specified dataset INTEGER(SIZE_T) :: namesize INTEGER(HSIZE_T) :: size, buf_size + INTEGER :: idx buf_size = 4*1024*1024 @@ -95,10 +96,13 @@ CALL check("h5pclose_f", error, total_error) CALL h5sclose_f(space_id, error) CALL check("h5sclose_f", error, total_error) - ! Read dataset creation information + CALL h5fclose_f(file_id, error) + + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, file_id, error) CALL h5dopen_f(file_id, "dset1", dataset_id, error) CALL check("h5dopen_f",error,total_error) + ! Read dataset creation information CALL h5dget_create_plist_f(dataset_id, plist_id, error) CALL check("h5dget_create_plist_f",error,total_error) CALL h5pget_external_count_f(plist_id, count, error) @@ -108,7 +112,8 @@ total_error = total_error + 1 end if namesize = 10 - CALL h5pget_external_f(plist_id, 0, namesize, name, file_offset, & + idx = 0 + CALL h5pget_external_f(plist_id, idx, namesize, name, file_offset, & file_bytes, error) CALL check("h5pget_external_f",error,total_error) if(file_offset .ne. 0 ) then @@ -282,7 +287,6 @@ CALL check("h5fclose_f", error, total_error) CALL h5pclose_f(fapl, error) CALL check("h5pclose_f", error, total_error) - ! ! Open the existing file. ! diff --git a/hl/fortran/src/H5IMfc.c b/hl/fortran/src/H5IMfc.c index f4c71cb..7d09f10 100755 --- a/hl/fortran/src/H5IMfc.c +++ b/hl/fortran/src/H5IMfc.c @@ -16,6 +16,7 @@ #include "H5IM.h" #include "H5LTf90proto.h" +#include "../../../fortran/src/H5f90i_gen.h" /*------------------------------------------------------------------------- @@ -43,7 +44,7 @@ nh5immake_image_8bit_c (hid_t_f *loc_id, _fcd name, hsize_t_f *width, hsize_t_f *height, - void *buf) + int_f *buf) { int ret_value = -1; herr_t ret; @@ -54,7 +55,7 @@ nh5immake_image_8bit_c (hid_t_f *loc_id, /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen = (int)*namelen; c_name = (char *)HD5f2cstring(name, c_namelen); if (c_name == NULL) return ret_value; @@ -62,7 +63,6 @@ nh5immake_image_8bit_c (hid_t_f *loc_id, * Call H5IMmake_image_8bitf function. */ c_loc_id = (hid_t)*loc_id; - ret = H5IMmake_image_8bitf(c_loc_id,c_name,*width,*height,buf); if (ret < 0) return ret_value; @@ -93,7 +93,7 @@ int_f nh5imread_image_c (hid_t_f *loc_id, int_f *namelen, _fcd name, - void *buf) + int_f *buf) { int ret_value = -1; herr_t ret; @@ -105,7 +105,7 @@ nh5imread_image_c (hid_t_f *loc_id, /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen = (int)*namelen; c_name = (char *)HD5f2cstring(name, c_namelen); if (c_name == NULL) return ret_value; diff --git a/hl/fortran/src/H5LTf90proto.h b/hl/fortran/src/H5LTf90proto.h index 2b8e932..e3c36fd 100755 --- a/hl/fortran/src/H5LTf90proto.h +++ b/hl/fortran/src/H5LTf90proto.h @@ -245,13 +245,13 @@ nh5immake_image_8bit_c (hid_t_f *loc_id, _fcd name, hsize_t_f *width, hsize_t_f *height, - void *buf); + int_f *buf); H5_DLL int_f nh5imread_image_c (hid_t_f *loc_id, int_f *namelen, _fcd name, - void *buf); + int_f *buf); H5_DLL int_f diff --git a/hl/fortran/src/H5LTfc.c b/hl/fortran/src/H5LTfc.c index d36128f..15733ab 100755 --- a/hl/fortran/src/H5LTfc.c +++ b/hl/fortran/src/H5LTfc.c @@ -291,7 +291,7 @@ nh5ltset_attribute_int_c(hid_t_f *loc_id, c_name = (char *)HD5f2cstring(dsetname, c_namelen); if (c_name == NULL) return ret_value; - c_attrnamelen = *attrnamelen; + c_attrnamelen = (int)*attrnamelen; c_attrname = (char *)HD5f2cstring(attrname, c_attrnamelen); if (c_attrname == NULL) return ret_value; @@ -301,8 +301,15 @@ nh5ltset_attribute_int_c(hid_t_f *loc_id, c_loc_id = (hid_t)*loc_id; c_size = (size_t)*size; - ret = H5LTset_attribute_int(c_loc_id,c_name,c_attrname,buf,c_size); - + if (sizeof(int_f) == sizeof(int)) + ret = H5LTset_attribute_int(c_loc_id,c_name,c_attrname,buf,c_size); + else if (sizeof(int_f) == sizeof(long)) + ret = H5LTset_attribute_long(c_loc_id,c_name,c_attrname,buf,c_size); + else if (sizeof(int_f) == sizeof(long long)) + ret = H5LTset_attribute_long_long(c_loc_id,c_name,c_attrname,buf,c_size); + else + return ret_value; + if (ret < 0) return ret_value; ret_value = 0; return ret_value; @@ -311,7 +318,7 @@ nh5ltset_attribute_int_c(hid_t_f *loc_id, /*------------------------------------------------------------------------- * Function: H5LTset_attribute_float_c * - * Purpose: Call H5LTset_attribute_int + * Purpose: Call H5LTset_attribute_float * * Return: Success: 0, Failure: -1 * @@ -357,7 +364,7 @@ nh5ltset_attribute_float_c(hid_t_f *loc_id, if (c_attrname == NULL) return ret_value; /* - * Call H5LTset_attribute_int function. + * Call H5LTset_attribute_float function. */ c_loc_id = (hid_t)*loc_id; c_size = (size_t)*size; @@ -373,7 +380,7 @@ nh5ltset_attribute_float_c(hid_t_f *loc_id, /*------------------------------------------------------------------------- * Function: H5LTset_attribute_double_c * - * Purpose: Call H5LTset_attribute_int + * Purpose: Call H5LTset_attribute_double * * Return: Success: 0, Failure: -1 * @@ -419,7 +426,7 @@ nh5ltset_attribute_double_c(hid_t_f *loc_id, if (c_attrname == NULL) return ret_value; /* - * Call H5LTset_attribute_int function. + * Call H5LTset_attribute_double function. */ c_loc_id = (hid_t)*loc_id; c_size = (size_t)*size; @@ -434,7 +441,7 @@ nh5ltset_attribute_double_c(hid_t_f *loc_id, /*------------------------------------------------------------------------- * Function: H5LTset_attribute_string_c * - * Purpose: Call H5LTset_attribute_int + * Purpose: Call H5LTset_attribute_string * * Return: Success: 0, Failure: -1 * @@ -478,7 +485,7 @@ nh5ltset_attribute_string_c(hid_t_f *loc_id, if (c_attrname == NULL) return ret_value; /* - * Call H5LTset_attribute_int function. + * Call H5LTset_attribute_string function. */ c_loc_id = (hid_t)*loc_id; @@ -527,11 +534,11 @@ nh5ltget_attribute_int_c(hid_t_f *loc_id, /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen = (int)*namelen; c_name = (char *)HD5f2cstring(dsetname, c_namelen); if (c_name == NULL) return ret_value; - c_attrnamelen = *attrnamelen; + c_attrnamelen = (int)*attrnamelen; c_attrname = (char *)HD5f2cstring(attrname, c_attrnamelen); if (c_attrname == NULL) return ret_value; @@ -539,8 +546,15 @@ nh5ltget_attribute_int_c(hid_t_f *loc_id, * Call H5LTget_attribute_int function. */ c_loc_id = (hid_t)*loc_id; - - ret = H5LTget_attribute_int(c_loc_id,c_name,c_attrname,buf); + + if(sizeof(int_f) == sizeof(int)) + ret = H5LTget_attribute_int(c_loc_id,c_name,c_attrname,buf); + else if (sizeof(int_f) == sizeof(long)) + ret = H5LTget_attribute_long(c_loc_id,c_name,c_attrname,buf); + else if (sizeof(int_f) == sizeof(long long)) + ret = H5LTget_attribute_long_long(c_loc_id,c_name,c_attrname,buf); + else + return ret_value; if (ret < 0) return ret_value; ret_value = 0; @@ -586,11 +600,11 @@ nh5ltget_attribute_float_c(hid_t_f *loc_id, /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen = (int)*namelen; c_name = (char *)HD5f2cstring(dsetname, c_namelen); if (c_name == NULL) return ret_value; - c_attrnamelen = *attrnamelen; + c_attrnamelen = (int)*attrnamelen; c_attrname = (char *)HD5f2cstring(attrname, c_attrnamelen); if (c_attrname == NULL) return ret_value; @@ -644,11 +658,11 @@ nh5ltget_attribute_double_c(hid_t_f *loc_id, /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen = (int)*namelen; c_name = (char *)HD5f2cstring(dsetname, c_namelen); if (c_name == NULL) return ret_value; - c_attrnamelen = *attrnamelen; + c_attrnamelen = (int)*attrnamelen; c_attrname = (char *)HD5f2cstring(attrname, c_attrnamelen); if (c_attrname == NULL) return ret_value; @@ -702,11 +716,11 @@ nh5ltget_attribute_string_c(hid_t_f *loc_id, /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen = (int)*namelen; c_name = (char *)HD5f2cstring(dsetname, c_namelen); if (c_name == NULL) return ret_value; - c_attrnamelen = *attrnamelen; + c_attrnamelen = (int)*attrnamelen; c_attrname = (char *)HD5f2cstring(attrname, c_attrnamelen); if (c_attrname == NULL) return ret_value; @@ -753,11 +767,12 @@ nh5ltget_dataset_ndims_c(hid_t_f *loc_id, hid_t c_loc_id; char *c_name; int c_namelen; + int c_rank; /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen = (int)*namelen; c_name = (char *)HD5f2cstring(name, c_namelen); if (c_name == NULL) return ret_value; @@ -766,9 +781,10 @@ nh5ltget_dataset_ndims_c(hid_t_f *loc_id, */ c_loc_id = (hid_t)*loc_id; - ret = H5LTget_dataset_ndims(c_loc_id, c_name, rank); + ret = H5LTget_dataset_ndims(c_loc_id, c_name, &c_rank); if (ret < 0) return ret_value; + *rank = (int_f)c_rank; ret_value = 0; return ret_value; } @@ -805,7 +821,7 @@ nh5ltfind_dataset_c(hid_t_f *loc_id, /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen = (int)*namelen; c_name = (char *)HD5f2cstring(name, c_namelen); if (c_name == NULL) return -1; @@ -858,7 +874,7 @@ nh5ltget_dataset_info_c(hid_t_f *loc_id, /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen = (int)*namelen; c_name = (char *)HD5f2cstring(name, c_namelen); if (c_name == NULL) return ret_value; @@ -915,26 +931,28 @@ nh5ltget_attribute_ndims_c(hid_t_f *loc_id, char *c_attrname; int c_namelen; int c_attrnamelen; + int c_rank; /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen =(int) *namelen; c_name = (char *)HD5f2cstring(dsetname, c_namelen); if (c_name == NULL) return ret_value; - c_attrnamelen = *attrnamelen; + c_attrnamelen = (int)*attrnamelen; c_attrname = (char *)HD5f2cstring(attrname, c_attrnamelen); if (c_attrname == NULL) return ret_value; /* - * Call H5LTset_attribute_int function. + * Call H5LTset_attribute_ndims function. */ c_loc_id = (hid_t)*loc_id; - ret = H5LTget_attribute_ndims(c_loc_id,c_name,c_attrname,rank); + ret = H5LTget_attribute_ndims(c_loc_id,c_name,c_attrname,&c_rank); if (ret < 0) return ret_value; + *rank = (int_f)c_rank; ret_value = 0; return ret_value; } @@ -984,11 +1002,11 @@ nh5ltget_attribute_info_c(hid_t_f *loc_id, /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; + c_namelen = (int)*namelen; c_name = (char *)HD5f2cstring(name, c_namelen); if (c_name == NULL) return ret_value; - c_attrnamelen = *attrnamelen; + c_attrnamelen = (int)*attrnamelen; c_attrname = (char *)HD5f2cstring(attrname, c_attrnamelen); if (c_attrname == NULL) return ret_value; diff --git a/hl/fortran/test/tstimage.f90 b/hl/fortran/test/tstimage.f90 index 42fe52a..d820caf 100755 --- a/hl/fortran/test/tstimage.f90 +++ b/hl/fortran/test/tstimage.f90 @@ -127,12 +127,10 @@ call test_begin(' Make/Read image 8bit ') ! write image. ! call h5immake_image_8bit_f(file_id,dsetname1,width,height,buf1,errcode) - ! ! read image. ! call h5imread_image_f(file_id,dsetname1,bufr1,errcode) - ! ! compare read and write buffers. ! diff --git a/hl/fortran/test/tstlite.f90 b/hl/fortran/test/tstlite.f90 index f34053a..f043c8f 100644 --- a/hl/fortran/test/tstlite.f90 +++ b/hl/fortran/test/tstlite.f90 @@ -707,7 +707,6 @@ call test_begin(' Get dataset dimensions ') !------------------------------------------------------------------------- call h5ltget_dataset_ndims_f(file_id, dsetname4, rankr, errcode) - if ( rankr .ne. rank ) then print *, 'h5ltget_dataset_ndims_f return error' stop @@ -952,4 +951,4 @@ end subroutine test_begin subroutine passed() write(*, fmt = '(6a)') 'PASSED' -end subroutine passed \ No newline at end of file +end subroutine passed diff --git a/hl/src/H5IM.c b/hl/src/H5IM.c index b7e8060..a6709c0 100644 --- a/hl/src/H5IM.c +++ b/hl/src/H5IM.c @@ -11,6 +11,8 @@ ****************************************************************************/ #include "H5IM.h" +#include "../../fortran/src/H5f90i_gen.h" + #include #include @@ -24,7 +26,7 @@ herr_t H5IM_get_palette( hid_t loc_id, const char *image_name, int pal_number, hid_t tid, - void *pal_data); + int_f *pal_data); /*------------------------------------------------------------------------- @@ -1292,7 +1294,7 @@ herr_t H5IMmake_image_8bitf( hid_t loc_id, const char *dset_name, hsize_t width, hsize_t height, - void *buf ) + int_f *buf ) { hid_t did; /* dataset ID */ hid_t sid; /* space ID */ @@ -1313,13 +1315,24 @@ herr_t H5IMmake_image_8bitf( hid_t loc_id, return -1; /* create the dataset as H5T_NATIVE_UCHAR */ - if ((did=H5Dcreate(loc_id,dset_name,H5T_NATIVE_UCHAR,sid,H5P_DEFAULT))<0) + if ((did=H5Dcreate(loc_id,dset_name,H5T_NATIVE_UINT8,sid,H5P_DEFAULT))<0) return -1; /* write with memory type H5T_NATIVE_INT */ + /* Use long type if Fortran integer is 8 bytes and C long long is also 8 bytes*/ + /* Fail if otherwise */ if (buf) { + if (sizeof(int_f) == sizeof(int)) { if (H5Dwrite(did,H5T_NATIVE_INT,H5S_ALL,H5S_ALL,H5P_DEFAULT,buf)<0) + return -1;} + else if (sizeof(int_f) == sizeof(long)) { + if (H5Dwrite(did,H5T_NATIVE_LONG,H5S_ALL,H5S_ALL,H5P_DEFAULT,buf)<0) + return -1;} + else if (sizeof(int_f) == sizeof(long long)) { + if (H5Dwrite(did,H5T_NATIVE_LLONG,H5S_ALL,H5S_ALL,H5P_DEFAULT,buf)<0) + return -1;} + else return -1; } @@ -1382,7 +1395,7 @@ herr_t H5IMmake_image_24bitf( hid_t loc_id, hsize_t width, hsize_t height, const char *interlace, - void *buf) + int_f *buf) { hid_t did; /* dataset ID */ hid_t sid; /* space ID */ @@ -1425,7 +1438,16 @@ herr_t H5IMmake_image_24bitf( hid_t loc_id, /* write with memory type H5T_NATIVE_INT */ if (buf) { + if (sizeof(int_f) == sizeof(int)) { if (H5Dwrite(did,H5T_NATIVE_INT,H5S_ALL,H5S_ALL,H5P_DEFAULT,buf)<0) + return -1;} + else if (sizeof(int_f) == sizeof(long)) { + if (H5Dwrite(did,H5T_NATIVE_LONG,H5S_ALL,H5S_ALL,H5P_DEFAULT,buf)<0) + return -1;} + else if (sizeof(int_f) == sizeof(long long)) { + if (H5Dwrite(did,H5T_NATIVE_LLONG,H5S_ALL,H5S_ALL,H5P_DEFAULT,buf)<0) + return -1;} + else return -1; } @@ -1484,7 +1506,7 @@ herr_t H5IMmake_image_24bitf( hid_t loc_id, herr_t H5IMread_imagef( hid_t loc_id, const char *dset_name, - void *buf ) + int_f *buf ) { hid_t did; @@ -1493,13 +1515,21 @@ herr_t H5IMread_imagef( hid_t loc_id, return -1; /* read to memory type H5T_NATIVE_INT */ + if (sizeof(int_f) == sizeof(int)){ if ( H5Dread( did, H5T_NATIVE_INT, H5S_ALL, H5S_ALL, H5P_DEFAULT, buf ) < 0 ) + goto out;} + else if (sizeof(int_f) == sizeof(long)) { + if ( H5Dread( did, H5T_NATIVE_LONG, H5S_ALL, H5S_ALL, H5P_DEFAULT, buf ) < 0 ) + goto out;} + else if (sizeof(int_f) == sizeof(long long)) { + if ( H5Dread( did, H5T_NATIVE_LLONG, H5S_ALL, H5S_ALL, H5P_DEFAULT, buf ) < 0 ) + goto out;} + else goto out; /* close */ if ( H5Dclose( did ) ) return -1; - return 0; out: @@ -1536,7 +1566,7 @@ out: herr_t H5IMmake_palettef( hid_t loc_id, const char *pal_name, const hsize_t *pal_dims, - void *pal_data ) + int_f *pal_data ) { @@ -1567,7 +1597,16 @@ herr_t H5IMmake_palettef( hid_t loc_id, /* write with memory type H5T_NATIVE_INT */ if (pal_data) { + if (sizeof(int_f) == sizeof(int)) { if (H5Dwrite(did,H5T_NATIVE_INT,H5S_ALL,H5S_ALL,H5P_DEFAULT,pal_data)<0) + return -1;} + else if (sizeof(int_f) == sizeof(long)) { + if (H5Dwrite(did,H5T_NATIVE_LONG,H5S_ALL,H5S_ALL,H5P_DEFAULT,pal_data)<0) + return -1;} + else if (sizeof(int_f) == sizeof(long long)) { + if (H5Dwrite(did,H5T_NATIVE_LLONG,H5S_ALL,H5S_ALL,H5P_DEFAULT,pal_data)<0) + return -1;} + else return -1; } @@ -1622,9 +1661,17 @@ herr_t H5IMmake_palettef( hid_t loc_id, herr_t H5IMget_palettef( hid_t loc_id, const char *image_name, int pal_number, - void *pal_data ) + int_f *pal_data ) { - return H5IM_get_palette(loc_id,image_name,pal_number,H5T_NATIVE_INT,pal_data); + if(sizeof(int_f) == sizeof(int)) + return H5IM_get_palette(loc_id,image_name,pal_number,H5T_NATIVE_INT,pal_data); + else if (sizeof(int_f) == sizeof(long)) + return H5IM_get_palette(loc_id,image_name,pal_number,H5T_NATIVE_LONG,pal_data); + else if (sizeof(int_f) == sizeof(long long)) + return H5IM_get_palette(loc_id,image_name,pal_number,H5T_NATIVE_LLONG,pal_data); + else + return -1; + } /*------------------------------------------------------------------------- @@ -1659,7 +1706,7 @@ herr_t H5IM_get_palette( hid_t loc_id, const char *image_name, int pal_number, hid_t tid, - void *pal_data) + int_f *pal_data) { hid_t image_id; int has_pal; diff --git a/hl/src/H5IM.h b/hl/src/H5IM.h index 6b7b6d8..27359dd 100644 --- a/hl/src/H5IM.h +++ b/hl/src/H5IM.h @@ -16,6 +16,7 @@ #define _H5IM_H #include "H5LT.h" +#include "../../fortran/src/H5f90i_gen.h" #ifdef __cplusplus extern "C" { @@ -93,28 +94,28 @@ herr_t H5IMmake_image_8bitf( hid_t loc_id, const char *dset_name, hsize_t width, hsize_t height, - void *buf ); + int_f *buf ); herr_t H5IMmake_image_24bitf( hid_t loc_id, const char *dset_name, hsize_t width, hsize_t height, const char *interlace, - void *buf); + int_f *buf); herr_t H5IMread_imagef( hid_t loc_id, const char *dset_name, - void *buf ); + int_f *buf ); herr_t H5IMmake_palettef( hid_t loc_id, const char *pal_name, const hsize_t *pal_dims, - void *pal_data ); + int_f *pal_data ); herr_t H5IMget_palettef( hid_t loc_id, const char *image_name, int pal_number, - void *pal_data ); + int_f *pal_data ); #ifdef __cplusplus diff --git a/hl/src/H5LT.c b/hl/src/H5LT.c index daa420c..acee4a7 100644 --- a/hl/src/H5LT.c +++ b/hl/src/H5LT.c @@ -1560,6 +1560,38 @@ herr_t H5LTset_attribute_long( hid_t loc_id, return 0; } +/*------------------------------------------------------------------------- + * Function: H5LTset_attribute_long_long + * + * Purpose: Create and write an attribute. + * + * Return: Success: 0, Failure: -1 + * + * Programmer: Elena Pourmal, epourmal@ncsa.uiuc.edu + * + * Date: June 17, 2005 + * + * Comments: This function was added to support 8-bytes int_f type that + * may correspond to INTEGER*8 in Fortran + * + *------------------------------------------------------------------------- + */ + +herr_t H5LTset_attribute_long_long( hid_t loc_id, + const char *obj_name, + const char *attr_name, + const long long *data, + size_t size ) +{ + + if ( H5LT_set_attribute_numerical( loc_id, obj_name, attr_name, size, + H5T_NATIVE_LLONG, data ) < 0 ) + return -1; + + return 0; + +} + /*------------------------------------------------------------------------- * Function: H5LTset_attribute_ulong @@ -2416,6 +2448,54 @@ herr_t H5LTget_attribute_long( hid_t loc_id, return 0; } +/*------------------------------------------------------------------------- + * Function: H5LTget_attribute_long_long + * + * Purpose: Reads an attribute named attr_name + * + * Return: Success: 0, Failure: -1 + * + * Programmer: Elena Pourmal, epourmal@ncsa.uiuc.edu + * + * Date: June 17, 2005 + * + * Comments: This funstion was added to suuport INTEGER*8 Fortran types + * + * Modifications: + * + *------------------------------------------------------------------------- + */ +herr_t H5LTget_attribute_long_long( hid_t loc_id, + const char *obj_name, + const char *attr_name, + long long *data ) +{ + + /* identifiers */ + hid_t obj_id; + H5G_stat_t statbuf; + + /* Get the type of object */ + if (H5Gget_objinfo(loc_id, obj_name, 1, &statbuf)<0) + return -1; + + /* Open the object */ + if ((obj_id = H5LT_open_id( loc_id, obj_name, statbuf.type )) < 0) + return -1; + + /* Get the attribute */ + if ( H5LT_get_attribute_mem( obj_id, attr_name, H5T_NATIVE_LLONG, data ) < 0 ) + return -1; + + /* Close the object */ + if ( H5LT_close_id( obj_id, statbuf.type ) < 0 ) + return -1; + + return 0; + +} + +/*------------------------------------------------------------------------- /*------------------------------------------------------------------------- * Function: H5LTget_attribute_ulong diff --git a/hl/src/H5LT.h b/hl/src/H5LT.h index 3380888..63f9c8e 100644 --- a/hl/src/H5LT.h +++ b/hl/src/H5LT.h @@ -211,6 +211,12 @@ herr_t H5LTset_attribute_long( hid_t loc_id, const long *buffer, size_t size ); +herr_t H5LTset_attribute_long_long( hid_t loc_id, + const char *obj_name, + const char *attr_name, + const long long *buffer, + size_t size ); + herr_t H5LTset_attribute_ulong( hid_t loc_id, const char *obj_name, const char *attr_name, @@ -282,6 +288,11 @@ herr_t H5LTget_attribute_long( hid_t loc_id, const char *attr_name, long *data ); +herr_t H5LTget_attribute_long_long( hid_t loc_id, + const char *obj_name, + const char *attr_name, + long long *data ); + herr_t H5LTget_attribute_ulong( hid_t loc_id, const char *obj_name, const char *attr_name, diff --git a/release_docs/RELEASE.txt b/release_docs/RELEASE.txt index dd327f6..127517a 100644 --- a/release_docs/RELEASE.txt +++ b/release_docs/RELEASE.txt @@ -236,6 +236,12 @@ New Features EIP 2004/07/08 - h5dwrite/read_f and h5awrite/read_f functions only accept dims parameter of the type INTEGER(HSIZE_T). + - added support for native integers of 8 bytes (i.e. when special + compiler flag is specified to set native fortran integers to 8 bytes, + for example, -i8 flag for PGI and Absoft Fortran compilers, + -qintsize=8 flag for IBM xlf compiler). + EIP 2005/06/20 + Tools: ------ -- cgit v0.12