From 249bcf447f27491fa9a4b37b1fcb9650628e57f1 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Wed, 4 May 2022 15:56:48 -0500 Subject: [PATCH] Update to new multi dataset Fortran API and tests. (#1724) * Update to new multi dataset Fortran API and tests. * Sync Fortran with develop. * skipping h5pget_mpio_actual_io_mode_f for now --- fortran/src/H5Af.c | 8 +- fortran/src/H5Aff.F90 | 14 +- fortran/src/H5Df.c | 81 +---------- fortran/src/H5Dff.F90 | 131 ++++++++++-------- fortran/src/H5Ff.c | 4 +- fortran/src/H5Fff.F90 | 2 +- fortran/src/H5Gf.c | 8 +- fortran/src/H5Gff.F90 | 32 ++--- fortran/src/H5Lff.F90 | 6 +- fortran/src/H5Pf.c | 30 ++-- fortran/src/H5Pff.F90 | 16 +-- fortran/src/H5Sf.c | 8 +- fortran/src/H5Sff.F90 | 2 +- fortran/src/H5Tf.c | 6 +- fortran/src/H5Tff.F90 | 4 +- fortran/src/H5_buildiface.F90 | 8 +- fortran/src/H5_f.c | 20 +-- fortran/src/H5_ff.F90 | 15 +- fortran/src/H5f90global.F90 | 4 +- fortran/src/H5f90proto.h | 21 +-- fortran/src/h5fc.in | 6 +- fortran/test/tH5T_F03.F90 | 123 ++++++++++------ fortran/testpar/CMakeLists.txt | 21 +-- fortran/testpar/Makefile.am | 5 +- fortran/testpar/hyper.f90 | 31 +++-- .../{multidsetrw_F03.F90 => multidsetrw.F90} | 68 +++++---- fortran/testpar/ptest.f90 | 13 +- fortran/testpar/ptest_F03.F90 | 104 -------------- 28 files changed, 333 insertions(+), 458 deletions(-) rename fortran/testpar/{multidsetrw_F03.F90 => multidsetrw.F90} (80%) delete mode 100644 fortran/testpar/ptest_F03.F90 diff --git a/fortran/src/H5Af.c b/fortran/src/H5Af.c index f78ade2eba1..db1c040d099 100644 --- a/fortran/src/H5Af.c +++ b/fortran/src/H5Af.c @@ -272,7 +272,7 @@ h5arename_by_name_c(hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, _fcd * PURPOSE * Call H5Aopen to open an attribute * INPUTS - * obj_id - Identifer for object to which attribute is attached + * obj_id - Identifier for object to which attribute is attached * attr_name - Attribute access property list * attr_namelen - size of attr_name * aapl_id - Link access property list @@ -317,7 +317,7 @@ h5aopen_c(hid_t_f *obj_id, _fcd attr_name, size_t_f *attr_namelen, hid_t_f *aapl * PURPOSE * Call h5adelete_by_name to remove an attribute from a specified location * INPUTS - * loc_id - identifer for object to which attribute is attached + * loc_id - identifier for object to which attribute is attached * obj_name - object identifier * obj_namelen - name length * attr_name - name of the attribute @@ -424,7 +424,7 @@ h5adelete_by_idx_c(hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, int_f * INPUTS * * - * loc_id - Identifer for object to which attribute is attached + * loc_id - Identifier for object to which attribute is attached * obj_name - Name of object, relative to location, * from which attribute is to be removed *TEST* check NULL * idx_type - Type of index; Possible values are: @@ -532,7 +532,7 @@ h5aget_name_by_idx_c(hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, int_ * aapl_id - Attribute access property list * lapl_id - Link access property list * OUTPUTS - * attr_id - attribute identifer + * attr_id - attribute identifier * RETURNS * 0 on success, -1 on failure * AUTHOR diff --git a/fortran/src/H5Aff.F90 b/fortran/src/H5Aff.F90 index 8f5699306f9..53f0a399497 100644 --- a/fortran/src/H5Aff.F90 +++ b/fortran/src/H5Aff.F90 @@ -211,7 +211,7 @@ END SUBROUTINE h5acreate_f ! ! INPUTS ! obj_id - identifier of a group, dataset, or named -! datatype atttribute to be attached to +! datatype attribute to be attached to ! name - attribute name ! OUTPUTS ! attr_id - attribute identifier @@ -487,7 +487,7 @@ END SUBROUTINE h5aget_name_f SUBROUTINE h5aget_name_by_idx_f(loc_id, obj_name, idx_type, order, & n, name, hdferr, size, lapl_id) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifer for object to which attribute is attached + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifier for object to which attribute is attached CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object, relative to location, ! from which attribute is to be removed *TEST* check NULL INTEGER, INTENT(IN) :: idx_type ! Type of index; Possible values are: @@ -846,7 +846,7 @@ END SUBROUTINE H5Arename_by_name_f ! identifier and attribute name ! ! INPUTS -! obj_id - Identifer for object to which attribute is attached +! obj_id - Identifier for object to which attribute is attached ! attr_name - Name of attribute to open ! OUTPUTS ! attr_id - attribute identifier @@ -934,7 +934,7 @@ END SUBROUTINE H5Aopen_f ! SOURCE SUBROUTINE H5Adelete_by_idx_f(loc_id, obj_name, idx_type, order, n, hdferr, lapl_id) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifer for object to which attribute is attached + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifier for object to which attribute is attached CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object, relative to location, ! from which attribute is to be removed INTEGER, INTENT(IN) :: idx_type ! Type of index; Possible values are: @@ -991,7 +991,7 @@ END SUBROUTINE H5Adelete_by_idx_f ! Removes an attribute from a specified location ! ! INPUTS -! loc_id - Identifer for object to which attribute is attached +! loc_id - Identifier for object to which attribute is attached ! obj_name - Name of attribute to open ! attr_name - Attribute access property list ! lapl_id - Link access property list @@ -1005,7 +1005,7 @@ END SUBROUTINE H5Adelete_by_idx_f ! SOURCE SUBROUTINE H5Adelete_by_name_f(loc_id, obj_name, attr_name, hdferr, lapl_id) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifer for object to which attribute is attached + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifier for object to which attribute is attached CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object, relative to location, ! from which attribute is to be removed CHARACTER(LEN=*), INTENT(IN) :: attr_name ! Name of attribute to delete @@ -1841,7 +1841,7 @@ END SUBROUTINE H5Aread_char_scalar_fix ! dims parameter was added to make code portable; ! Aprile 4, 2001 ! -! Changed buf intent to INOUT to be consistant +! Changed buf intent to INOUT to be consistent ! with how the C functions handles it. The pg ! compiler will return 0 if a buf value is not set. ! February, 2008 diff --git a/fortran/src/H5Df.c b/fortran/src/H5Df.c index a08d22bf562..a780683fc62 100644 --- a/fortran/src/H5Df.c +++ b/fortran/src/H5Df.c @@ -145,7 +145,7 @@ h5dopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dapl_id, hid_t_f * Elena Pourmal * Tuesday, May 14, 2002 * HISTORY - * This function was added to accomodate h5dwrite_f with the + * This function was added to accommodate h5dwrite_f with the * dims argument being of INTEGER(HSIZE_T) type * SOURCE */ @@ -217,7 +217,7 @@ h5dwrite_ref_reg_c(hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id * Elena Pourmal * Wednesday, May 15, 2002 * HISTORY - * This function was added to accomodate h5dread_f subroutine + * This function was added to accommodate h5dread_f subroutine * with the dims parameter being of INTEGER(HSIZE_T_F) size. * SOURCE */ @@ -495,10 +495,10 @@ h5dget_storage_size_c(hid_t_f *dset_id, hsize_t_f *size) c_dset_id = (hid_t)*dset_id; c_size = H5Dget_storage_size(c_dset_id); - if (c_size == 0) - return ret_value; - *size = (hsize_t_f)c_size; - ret_value = 0; + if (c_size != 0) { + ret_value = 0; + } + *size = (hsize_t_f)c_size; return ret_value; } @@ -783,7 +783,7 @@ h5dwrite_vl_string_c(hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_ return ret_value; } /* - * Move data from temorary buffer + * Move data from temporary buffer */ tmp_p = tmp; for (i = 0; i < num_elem; i++) { @@ -1354,70 +1354,3 @@ h5dvlen_reclaim_c(hid_t_f *type_id, hid_t_f *space_id, hid_t_f *plist_id, void * ret_value = 0; return ret_value; } - -/****if* H5FDmpio/h5dread_multi_c - * NAME - * h5dread_multi_c - * PURPOSE - * Calls H5Dread_multi - * - * INPUTS - * dxpl_id - dataset transfer property. - * count - the number of accessing datasets. - * OUTPUTS - * info - the array of dataset information and read buffer. - * - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * March 25, 2014 - * SOURCE - */ -int_f -nh5dread_multi_c(hid_t_f *dxpl_id, size_t_f *count, H5D_rw_multi_t_f *info) -/******/ -{ - int ret_value = -1; - /* - * Call H5Dread_multi function. - */ - if ((H5Dread_multi((hid_t)*dxpl_id, (size_t)*count, info)) < 0) - return ret_value; /* error occurred */ - - ret_value = 0; - return ret_value; -} - -/****if* H5FDmpio/h5dwrite_multi_c - * NAME - * h5dwrite_multi_c - * PURPOSE - * Calls H5Dwrite_multi - * - * INPUTS - * count - the number of accessing datasets. - * dxpl_id - dataset transfer property. - * Info - the array of dataset information and write buffer. - * - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * March 25, 2014 - * SOURCE - */ -int_f -nh5dwrite_multi_c(hid_t_f *dxpl_id, size_t_f *count, H5D_rw_multi_t_f *info) -/******/ -{ - int ret_value = -1; - /* - * Call H5Dwrite_multi function. - */ - if ((H5Dwrite_multi((hid_t)*dxpl_id, (size_t)*count, info)) < 0) - return ret_value; /* error occurred */ - - ret_value = 0; - return ret_value; -} diff --git a/fortran/src/H5Dff.F90 b/fortran/src/H5Dff.F90 index 8d415907600..7dfaf5e6431 100644 --- a/fortran/src/H5Dff.F90 +++ b/fortran/src/H5Dff.F90 @@ -90,17 +90,6 @@ MODULE H5D USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR USE H5GLOBAL - ! Derived data type matching the C structure for H5Dread_multi and - ! H5Dwrite_multi - - TYPE, BIND(C) :: H5D_rw_multi_t - INTEGER(HID_T) :: dset_id - INTEGER(HID_T) :: dset_space_id - INTEGER(HID_T) :: mem_type_id - INTEGER(HID_T) :: mem_space_id - TYPE(C_PTR) :: buf - END TYPE H5D_rw_multi_t - PRIVATE h5dread_vl_integer, h5dread_vl_real, h5dread_vl_string PRIVATE h5dwrite_vl_integer, h5dwrite_vl_real, h5dwrite_vl_string PRIVATE h5dwrite_reference_obj, h5dwrite_reference_dsetreg, h5dwrite_char_scalar, h5dwrite_ptr @@ -487,7 +476,7 @@ END SUBROUTINE h5dget_type_f ! ! Changed name from the now obsolete h5dextend_f ! to h5dset_extent_f. Provided interface to old name -! for backward compatability. -MSB- March 14, 2008 +! for backward compatibility. -MSB- March 14, 2008 ! ! SOURCE SUBROUTINE h5dset_extent_f(dataset_id, size, hdferr) @@ -1206,7 +1195,7 @@ SUBROUTINE h5dwrite_reference_obj(dset_id, mem_type_id, buf, dims, hdferr, & IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier - INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: dims ! size of the bufffer buf + INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: dims ! size of the buffer buf TYPE(hobj_ref_t_f), DIMENSION(dims(1)), INTENT(IN), TARGET :: buf ! Data buffer INTEGER, INTENT(OUT) :: hdferr ! Error code INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id ! Memory dataspace identfier @@ -1238,7 +1227,7 @@ SUBROUTINE h5dwrite_reference_dsetreg(dset_id, mem_type_id, buf, dims, hdferr, & IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier - INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: dims ! size of the bufffer buf + INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: dims ! size of the buffer buf TYPE(hdset_reg_ref_t_f), DIMENSION(dims(1)), INTENT(IN), TARGET :: buf ! Data buffer INTEGER, INTENT(OUT) :: hdferr ! Error code INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id ! Memory dataspace identfier @@ -1636,8 +1625,7 @@ END SUBROUTINE h5dread_ptr ! Inputs: ! fill_value - fill value ! space_id - memory space selection identifier -! buf - data buffer iin memory ro apply selection to -! - of k-th dimension of the buf array +! buf - memory buffer containing the selection to be filled ! Outputs: ! hdferr: - error code ! Success: 0 @@ -1687,8 +1675,7 @@ END SUBROUTINE h5dfill_integer ! Inputs: ! fill_value - fill value ! space_id - memory space selection identifier -! buf - data buffer iin memory ro apply selection to -! - of k-th dimension of the buf array +! buf - memory buffer containing the selection to be filled ! Outputs: ! hdferr: - error code ! Success: 0 @@ -1735,8 +1722,7 @@ END SUBROUTINE h5dfill_c_float ! Inputs: ! fill_value - fill value ! space_id - memory space selection identifier - ! buf - data buffer iin memory ro apply selection to - ! - of k-th dimension of the buf array + ! buf - memory buffer containing the selection to be filled ! Outputs: ! hdferr: - error code ! Success: 0 @@ -1810,8 +1796,7 @@ END SUBROUTINE h5dfill_c_long_double ! Inputs: ! fill_value - fill value ! space_id - memory space selection identifier -! buf - data buffer iin memory ro apply selection to -! - of k-th dimension of the buf array +! buf - memory buffer containing the selection to be filled ! Outputs: ! hdferr: - error code ! Success: 0 @@ -1898,41 +1883,55 @@ END SUBROUTINE H5Dvlen_reclaim_f ! Reads data from a file to memory buffers for multiple datasets ! ! INPUTS -! file_id - file or group id for the location of datasets. -! dxpl_id - dataset transfer property. -! count - the number of accessing datasets. +! count - the number of datasets. +! dset_id - Identifier of the dataset to read from +! mem_type_id - Identifier of the memory datatype +! mem_space_id - Identifier of the memory dataspace +! file_space_id - Identifier of the dataset's dataspace in the file +! dxpl_id - dataset transfer property. ! ! OUTPUTS -! info - the array of dataset information and read buffer. +! buf - Buffer to receive data read from file ! AUTHOR ! M. Scot Breitenfeld ! March 25, 2014 ! ! SOURCE - SUBROUTINE H5Dread_multi_f(dxpl_id, count, info, hdferr) + SUBROUTINE H5Dread_multi_f(count, dset_id, mem_type_id, mem_space_id, file_space_id, buf, hdferr, dxpl_id) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: dxpl_id - INTEGER(SIZE_T), INTENT(IN) :: count - TYPE(H5D_rw_multi_t), INTENT(OUT), DIMENSION(1:count) :: info - INTEGER, INTENT(OUT) :: hdferr + INTEGER(SIZE_T), INTENT(IN) :: count + INTEGER(HID_T), INTENT(IN), DIMENSION(1:count) :: dset_id + INTEGER(HID_T), INTENT(IN), DIMENSION(1:count) :: mem_type_id + INTEGER(HID_T), INTENT(IN), DIMENSION(1:count) :: mem_space_id + INTEGER(HID_T), INTENT(IN), DIMENSION(1:count) :: file_space_id + TYPE(C_PTR), DIMENSION(1:count) :: buf + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: dxpl_id !***** + INTEGER(HID_T) :: dxpl_id_default INTERFACE - INTEGER FUNCTION H5Dread_multi_c(dxpl_id, count, info) - ! INTEGER FUNCTION H5Dread_multi(dxpl_id, count, info) BIND(C, NAME='H5Dread_multi') + INTEGER FUNCTION H5Dread_multi(count, dset_id, mem_type_id, mem_space_id, file_space_id, dxpl_id, buf) & + BIND(C, NAME='H5Dread_multi') IMPORT :: SIZE_T IMPORT :: HID_T - IMPORT :: H5D_rw_multi_t + IMPORT :: C_PTR IMPLICIT NONE - INTEGER(HID_T) :: dxpl_id - INTEGER(SIZE_T) :: count - TYPE(H5D_rw_multi_t), DIMENSION(1:count) :: info - END FUNCTION H5Dread_multi_c - ! END FUNCTION H5Dread_multi - END INTERFACE - hdferr = H5Dread_multi_c(dxpl_id, count, info) -! hdferr = H5Dread_multi(dxpl_id, count, info) + INTEGER(SIZE_T), VALUE :: count + INTEGER(HID_T), DIMENSION(1:count) :: dset_id + INTEGER(HID_T), DIMENSION(1:count) :: mem_type_id + INTEGER(HID_T), DIMENSION(1:count) :: mem_space_id + INTEGER(HID_T), DIMENSION(1:count) :: file_space_id + INTEGER(HID_T) :: dxpl_id + TYPE(C_PTR), DIMENSION(1:count) :: buf + END FUNCTION H5Dread_multi + END INTERFACE + + dxpl_id_default = H5P_DEFAULT_F + IF (PRESENT(dxpl_id)) dxpl_id_default = dxpl_id + + hdferr = H5Dread_multi(count, dset_id, mem_type_id, mem_space_id, file_space_id, dxpl_id, buf) END SUBROUTINE H5Dread_multi_f @@ -1945,42 +1944,56 @@ END SUBROUTINE H5Dread_multi_f ! Writes data in memory to a file for multiple datasets ! ! INPUTS -! file_id - file or group id for the location of datasets, -! count - the number of accessing datasets. -! dxpl_id - dataset transfer property. +! count - the number of datasets. +! dset_id - Identifier of the dataset to read from +! mem_type_id - Identifier of the memory datatype +! mem_space_id - Identifier of the memory dataspace +! file_space_id - Identifier of the dataset's dataspace in the file +! dxpl_id - dataset transfer property. +! buf - Buffer to write to file ! ! OUTPUTS -! Info - the array of dataset information and write buffer. +! ! AUTHOR ! M. Scot Breitenfeld ! March 25, 2014 ! ! SOURCE - SUBROUTINE H5Dwrite_multi_f(dxpl_id, count, info, hdferr) + SUBROUTINE H5Dwrite_multi_f(count, dset_id, mem_type_id, mem_space_id, file_space_id, buf, hdferr, dxpl_id) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: dxpl_id INTEGER(SIZE_T), INTENT(IN) :: count - TYPE(H5D_rw_multi_t), INTENT(IN), DIMENSION(1:count) :: info + INTEGER(HID_T), INTENT(IN), DIMENSION(1:count) :: dset_id + INTEGER(HID_T), INTENT(IN), DIMENSION(1:count) :: mem_type_id + INTEGER(HID_T), INTENT(IN), DIMENSION(1:count) :: mem_space_id + INTEGER(HID_T), INTENT(IN), DIMENSION(1:count) :: file_space_id + TYPE(C_PTR), DIMENSION(1:count) :: buf INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(IN), OPTIONAL :: dxpl_id !***** + INTEGER(HID_T) :: dxpl_id_default INTERFACE -! INTEGER FUNCTION H5Dwrite_multi(dxpl_id, count, info) BIND(C, NAME='H5Dwrite_multi') - INTEGER FUNCTION H5Dwrite_multi_c(dxpl_id, count, info) + INTEGER FUNCTION H5Dwrite_multi(count, dset_id, mem_type_id, mem_space_id, file_space_id, dxpl_id, buf) & + BIND(C, NAME='H5Dwrite_multi') IMPORT :: SIZE_T IMPORT :: HID_T - IMPORT :: H5D_rw_multi_t + IMPORT :: C_PTR IMPLICIT NONE - INTEGER(HID_T) :: dxpl_id - INTEGER(SIZE_T) :: count - TYPE(H5D_rw_multi_t), DIMENSION(1:count) :: info - END FUNCTION H5Dwrite_multi_c -! END FUNCTION H5Dwrite_multi + INTEGER(SIZE_T), VALUE :: count + INTEGER(HID_T), DIMENSION(1:count) :: dset_id + INTEGER(HID_T), DIMENSION(1:count) :: mem_type_id + INTEGER(HID_T), DIMENSION(1:count) :: mem_space_id + INTEGER(HID_T), DIMENSION(1:count) :: file_space_id + INTEGER(HID_T) :: dxpl_id + TYPE(C_PTR), DIMENSION(1:count) :: buf + END FUNCTION H5Dwrite_multi END INTERFACE - hdferr = H5Dwrite_multi_c(dxpl_id, count, info) -! hdferr = H5Dwrite_multi(dxpl_id, count, info) + dxpl_id_default = H5P_DEFAULT_F + IF (PRESENT(dxpl_id)) dxpl_id_default = dxpl_id + + hdferr = H5Dwrite_multi(count, dset_id, mem_type_id, mem_space_id, file_space_id, dxpl_id, buf) END SUBROUTINE H5Dwrite_multi_f diff --git a/fortran/src/H5Ff.c b/fortran/src/H5Ff.c index f943200e72f..339f8b78f36 100644 --- a/fortran/src/H5Ff.c +++ b/fortran/src/H5Ff.c @@ -583,7 +583,7 @@ h5fget_name_c(hid_t_f *obj_id, size_t_f *size, _fcd buf, size_t_f *buflen) int_f ret_value = 0; /* Return value */ /* - * Allocate buffer to hold name of an attribute + * Allocate buffer to hold name of file */ if (NULL == (c_buf = (char *)HDmalloc((size_t)*buflen + 1))) HGOTO_DONE(FAIL); @@ -591,7 +591,7 @@ h5fget_name_c(hid_t_f *obj_id, size_t_f *size, _fcd buf, size_t_f *buflen) /* * Call H5Fget_name function */ - if ((size_c = H5Fget_name((hid_t)*obj_id, c_buf, (size_t)*buflen)) < 0) + if ((size_c = H5Fget_name((hid_t)*obj_id, c_buf, (size_t)*buflen + 1)) < 0) HGOTO_DONE(FAIL); /* diff --git a/fortran/src/H5Fff.F90 b/fortran/src/H5Fff.F90 index a273431e763..ecb40b7e3c1 100644 --- a/fortran/src/H5Fff.F90 +++ b/fortran/src/H5Fff.F90 @@ -97,7 +97,7 @@ SUBROUTINE h5fcreate_f(name, access_flags, file_id, hdferr, & INTEGER(HID_T), INTENT(OUT) :: file_id ! File identifier INTEGER, INTENT(OUT) :: hdferr ! Error code INTEGER(HID_T), OPTIONAL, INTENT(IN) :: creation_prp - ! File creation propertly + ! File creation property ! list identifier INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp ! File access property list diff --git a/fortran/src/H5Gf.c b/fortran/src/H5Gf.c index f445fee597f..02017613675 100644 --- a/fortran/src/H5Gf.c +++ b/fortran/src/H5Gf.c @@ -390,13 +390,13 @@ h5glink_c(hid_t_f *loc_id, int_f *link_type, _fcd current_name, int_f *current_n * Call H5Glink2 to link the specified type * INPUTS * cur_loc_id - identifier of file or group - * cur_name - name of the existing object for hard link releative + * cur_name - name of the existing object for hard link relative * to cur_loc_id location, * anything for the soft link * current_namelen - current name length * link_type - link type * new_loc_id - location identifier - * new_name - new name for the object releative to the new_loc_id + * new_name - new name for the object relative to the new_loc_id * location * new_namelen - new_name length * RETURNS @@ -879,7 +879,7 @@ h5gget_create_plist_c(hid_t_f *grp_id, hid_t_f *gcpl_id) * February 15, 2008 * HISTORY * - * - Added 'mounted' paramater + * - Added 'mounted' parameter * M. Scot Breitenfeld * July 16, 2008 * SOURCE @@ -1014,7 +1014,7 @@ h5gget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, * February 18, 2008 * HISTORY * - * - Added 'mounted' paramater + * - Added 'mounted' parameter * M. Scot Breitenfeld * July 16, 2008 * SOURCE diff --git a/fortran/src/H5Gff.F90 b/fortran/src/H5Gff.F90 index 9e7665f0fdb..bfca595a407 100644 --- a/fortran/src/H5Gff.F90 +++ b/fortran/src/H5Gff.F90 @@ -73,7 +73,7 @@ MODULE H5G ! called C functions (it is needed for Windows ! port). March 5, 2001 ! -! Added additional optional paramaters in 1.8 +! Added additional optional parameters in 1.8 ! MSB - February 27, 2008 ! ! SOURCE @@ -491,8 +491,8 @@ SUBROUTINE h5glink_f(loc_id, link_type, current_name, & INTEGER, INTENT(OUT) :: hdferr ! Error code !***** - INTEGER :: current_namelen ! Lenghth of the current_name string - INTEGER :: new_namelen ! Lenghth of the new_name string + INTEGER :: current_namelen ! Length of the current_name string + INTEGER :: new_namelen ! Length of the new_name string INTERFACE INTEGER FUNCTION h5glink_c(loc_id, link_type, current_name, & @@ -524,7 +524,7 @@ END SUBROUTINE h5glink_f ! PURPOSE ! Creates a link of the specified type from new_name ! to current_name. current_name and new_name are interpreted -! releative to current and new location identifiers. +! relative to current and new location identifiers. ! ! INPUTS ! cur_loc_id - location identifier @@ -559,8 +559,8 @@ SUBROUTINE h5glink2_f(cur_loc_id, cur_name, link_type, new_loc_id, & INTEGER, INTENT(OUT) :: hdferr ! Error code !***** - INTEGER :: cur_namelen ! Lenghth of the current_name string - INTEGER :: new_namelen ! Lenghth of the new_name string + INTEGER :: cur_namelen ! Length of the current_name string + INTEGER :: new_namelen ! Length of the new_name string INTERFACE INTEGER FUNCTION h5glink2_c(cur_loc_id, cur_name, cur_namelen, & @@ -617,7 +617,7 @@ SUBROUTINE h5gunlink_f(loc_id, name, hdferr) CHARACTER(LEN=*), INTENT(IN) :: name ! Name of an object INTEGER, INTENT(OUT) :: hdferr ! Error code !***** - INTEGER :: namelen ! Lenghth of the name character string + INTEGER :: namelen ! Length of the name character string INTERFACE INTEGER FUNCTION h5gunlink_c(loc_id, name, namelen) BIND(C,NAME='h5gunlink_c') @@ -666,8 +666,8 @@ SUBROUTINE h5gmove_f(loc_id, name, new_name, hdferr) CHARACTER(LEN=*), INTENT(IN) :: new_name ! New name of an object INTEGER, INTENT(OUT) :: hdferr ! Error code !***** - INTEGER :: namelen ! Lenghth of the current_name string - INTEGER :: new_namelen ! Lenghth of the new_name string + INTEGER :: namelen ! Length of the current_name string + INTEGER :: new_namelen ! Length of the new_name string INTERFACE INTEGER FUNCTION h5gmove_c(loc_id, name, namelen, new_name, new_namelen) BIND(C,NAME='h5gmove_c') @@ -715,7 +715,7 @@ SUBROUTINE h5gmove2_f(src_loc_id, src_name, dst_loc_id, dst_name, hdferr) INTEGER, INTENT(OUT) :: hdferr ! Error code !***** INTEGER :: src_namelen ! Length of the current_name string - INTEGER :: dst_namelen ! Lenghth of the new_name string + INTEGER :: dst_namelen ! Length of the new_name string INTERFACE INTEGER FUNCTION h5gmove2_c(src_loc_id, src_name, src_namelen, & @@ -776,7 +776,7 @@ SUBROUTINE h5gget_linkval_f(loc_id, name, size, buffer, hdferr) ! points to INTEGER, INTENT(OUT) :: hdferr ! Error code !***** - INTEGER :: namelen ! Lenghth of the current_name string + INTEGER :: namelen ! Length of the current_name string INTERFACE INTEGER FUNCTION h5gget_linkval_c(loc_id, name, namelen, size, buffer) BIND(C,NAME='h5gget_linkval_c') @@ -827,8 +827,8 @@ SUBROUTINE h5gset_comment_f(loc_id, name, comment, hdferr) CHARACTER(LEN=*), INTENT(IN) :: comment ! New name of an object INTEGER, INTENT(OUT) :: hdferr ! Error code !***** - INTEGER :: namelen ! Lenghth of the current_name string - INTEGER :: commentlen ! Lenghth of the comment string + INTEGER :: namelen ! Length of the current_name string + INTEGER :: commentlen ! Length of the comment string INTERFACE INTEGER FUNCTION h5gset_comment_c(loc_id, name, namelen, & @@ -1024,7 +1024,7 @@ END SUBROUTINE h5gget_create_plist_f ! ! HISTORY ! -! - Added 'mounted' paramater +! - Added 'mounted' parameter ! M. Scot Breitenfeld ! July 16, 2008 ! @@ -1104,7 +1104,7 @@ END SUBROUTINE h5gget_info_f ! February 18, 2008 ! ! HISTORY -! Added 'mounted' paramater +! Added 'mounted' parameter ! M. Scot Breitenfeld ! July 16, 2008 ! @@ -1206,7 +1206,7 @@ END SUBROUTINE h5gget_info_by_idx_f ! February 18, 2008 ! ! HISTORY -! Added 'mounted' paramater +! Added 'mounted' parameter ! M. Scot Breitenfeld ! July 16, 2008 ! SOURCE diff --git a/fortran/src/H5Lff.F90 b/fortran/src/H5Lff.F90 index 3bfcf65b5b3..a568824c4f2 100644 --- a/fortran/src/H5Lff.F90 +++ b/fortran/src/H5Lff.F90 @@ -469,7 +469,7 @@ END SUBROUTINE h5lcreate_external_f ! SOURCE SUBROUTINE h5ldelete_by_idx_f(loc_id, group_name, index_field, order, n, hdferr, lapl_id) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifer for object to which attribute is attached + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifier for object to which attribute is attached CHARACTER(LEN=*), INTENT(IN) :: group_name ! Name of object, relative to location, ! from which attribute is to be removed INTEGER, INTENT(IN) :: index_field ! Type of index; Possible values are: @@ -1315,7 +1315,7 @@ END SUBROUTINE h5lget_name_by_idx_f ! Inputs: ! group_id - Identifier specifying subject group ! index_type - Type of index which determines the order: -! H5_INDEX_NAME_F - Alpha-numeric index on name +! H5_INDEX_NAME_F - Alphanumeric index on name ! H5_INDEX_CRT_ORDER_F - Index on creation order ! order - Order within index: ! H5_ITER_INC_F - Increasing order @@ -1391,7 +1391,7 @@ END SUBROUTINE h5literate_f ! loc_id - File or group identifier specifying location of subject group ! group_name - Name of subject group ! index_type - Type of index which determines the order: -! H5_INDEX_NAME_F - Alpha-numeric index on name +! H5_INDEX_NAME_F - Alphanumeric index on name ! H5_INDEX_CRT_ORDER_F - Index on creation order ! order - Order within index: ! H5_ITER_INC_F - Increasing order diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c index 1f7495595ec..ab09ab9c6ea 100644 --- a/fortran/src/H5Pf.c +++ b/fortran/src/H5Pf.c @@ -145,7 +145,7 @@ h5pcopy_c(hid_t_f *prp_id, hid_t_f *new_prp_id) * plist1_id - property list identifier * plist2_id - property list identifier * OUTPUTS - * c_flag - flag to indicate that lists are eqaul + * c_flag - flag to indicate that lists are equal * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -936,7 +936,7 @@ h5pset_fapl_stdio_c(hid_t_f *prp_id) * NAME * h5pget_fapl_stdio_c * PURPOSE - * Call H5Pget_fapl_stdio to determine whther the low level file driver + * Call H5Pget_fapl_stdio to determine whether the low level file driver * uses the functions declared in the stdio.h * INPUTS * prp_id - property list identifier @@ -1013,7 +1013,7 @@ h5pset_fapl_sec2_c(hid_t_f *prp_id) * NAME * h5pget_fapl_sec2_c * PURPOSE - * Call H5Pget_fapl_stdio to determine whther the low level file driver + * Call H5Pget_fapl_stdio to determine whether the low level file driver * uses the functions declared in the unistd.h * INPUTS * prp_id - property list identifier @@ -2186,7 +2186,7 @@ h5pset_fclose_degree_c(hid_t_f *fapl_id, int_f *degree) * PURPOSE * Call H5Pset_buffer to set size of conversion buffer * INPUTS - * prp_id - t`dataset trasfer property list identifier + * prp_id - t`dataset transfer property list identifier * size - size of the buffer * OUTPUTS * NONE @@ -2221,7 +2221,7 @@ h5pset_buffer_c(hid_t_f *prp_id, hsize_t_f *size) * PURPOSE * Call H5Pget_buffer to get size of conversion buffer * INPUTS - * prp_id - t`dataset trasfer property list identifier + * prp_id - t`dataset transfer property list identifier * OUTPUTS * size - size of conversion buffer * RETURNS @@ -3005,11 +3005,11 @@ h5pget_nprops_c(hid_t_f *plist, size_t_f *nprops) * h5pget_class_parent_c * PURPOSE * Call H5Pget_class_parent to get the parent class of - * a genereic property class + * a generic property class * INPUTS * prp_id - property list to query * OUTPUTS - * parent_id - parent classs identifier + * parent_id - parent class identifier * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -3505,7 +3505,7 @@ h5pset_family_offset_c(hid_t_f *prp_id, hsize_t_f *offset) * NAME * h5pset_fapl_multi_c * PURPOSE - * Call H5Pset_fapl_multi to set multi file dirver + * Call H5Pset_fapl_multi to set multi file driver * INPUTS * prp_id - file_creation property list identifier * mem_map - memory mapping array @@ -3570,7 +3570,7 @@ h5pset_fapl_multi_c(hid_t_f *prp_id, int_f *memb_map, hid_t_f *memb_fapl, _fcd m tmp_p = tmp_p + c_lenmax; } /* - * Take care of othe arguments + * Take care of other arguments */ tmp_max_addr = (long double)(HADDR_MAX); c_prp_id = (hid_t)*prp_id; @@ -3603,7 +3603,7 @@ h5pset_fapl_multi_c(hid_t_f *prp_id, int_f *memb_map, hid_t_f *memb_fapl, _fcd m * NAME * h5pset_fapl_multi_sc * PURPOSE - * Call H5Pset_fapl_multi to set multi file dirver + * Call H5Pset_fapl_multi to set multi file driver * INPUTS * prp_id - file_creation property list identifier * RETURNS @@ -3641,7 +3641,7 @@ h5pset_fapl_multi_sc(hid_t_f *prp_id, int_f *flag) * NAME * h5pget_fapl_multi_c * PURPOSE - * Call H5Pget_fapl_multi to set multi file dirver + * Call H5Pget_fapl_multi to set multi file driver * INPUTS * prp_id - file_creation property list identifier * lenmax - length of the name a sdeclared in Fortran @@ -4607,7 +4607,7 @@ h5pget_copy_object_c(hid_t_f *ocp_plist_id, int_f *copy_options) * INPUTS * * prp_id - property list identifier to query - * expression_len - buffer size transorm expression + * expression_len - buffer size transform expression * * Output: * expression - buffer to hold transform expression @@ -4670,7 +4670,7 @@ h5pget_data_transform_c(hid_t_f *plist_id, _fcd expression, int_f *expression_le * * prp_id - property list identifier to query * expression - buffer to hold transform expression - * expression_len - buffer size transorm expression + * expression_len - buffer size transform expression * * Output: * @@ -5478,7 +5478,7 @@ h5pget_fapl_mpio_c(hid_t_f *prp_id, int_f *comm, int_f *info) * h5pset_dxpl_mpio_c * PURPOSE * Call H5Pset_dxpl_mpio to set transfer mode of the dataset - * trasfer property list + * transfer property list * INPUTS * prp_id - property list identifier * data_xfer_mode - transfer mode @@ -5530,7 +5530,7 @@ h5pset_dxpl_mpio_c(hid_t_f *prp_id, int_f *data_xfer_mode) * h5pget_dxpl_mpio_c * PURPOSE * Call H5Pget_dxpl_mpio to get transfer mode of the dataset - * trasfer property list + * transfer property list * INPUTS * prp_id - property list identifier * data_xfer_mode - buffer to retrieve transfer mode diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index a7f236651ba..c55b7d9806a 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -500,7 +500,7 @@ END SUBROUTINE h5pclose_f ! a chunked layout dataset. ! ! INPUTS -! prp_id - datatset creation property list identifier +! prp_id - dataset creation property list identifier ! ndims - number of dimensions for each chunk ! dims - array with dimension sizes for each chunk ! OUTPUTS @@ -1880,7 +1880,7 @@ END SUBROUTINE h5pset_fapl_split_f ! INPUTS ! ! prp_id - file access property list identifier -! gc_reference - flag for stting garbage collection on +! gc_reference - flag for setting garbage collection on ! and off (1 or 0) ! OUTPUTS ! @@ -1931,7 +1931,7 @@ END SUBROUTINE h5pset_gc_references_f ! prp_id - file access property list identifier ! OUTPUTS ! -! gc_reference - flag for stting garbage collection on +! gc_reference - flag for setting garbage collection on ! and off (1 or 0) ! hdferr - error code ! Success: 0 @@ -2659,7 +2659,7 @@ END SUBROUTINE h5pset_fclose_degree_f ! h5pequal_f ! ! PURPOSE -! Checks if two property lists are eqaul +! Checks if two property lists are equal ! ! INPUTS ! @@ -3059,7 +3059,7 @@ END SUBROUTINE h5pget_fill_time_f ! INPUTS ! ! plist_id - file access property list identifier -! size - metatdata block size +! size - metadata block size ! OUTPUTS ! ! hdferr - error code @@ -3103,7 +3103,7 @@ END SUBROUTINE h5pset_meta_block_size_f ! plist_id - file access property list identifier ! OUTPUTS ! -! size - metatdata block size +! size - metadata block size ! hdferr - error code ! Success: 0 ! Failure: -1 @@ -3596,7 +3596,7 @@ END SUBROUTINE h5pget_class_name_f ! h5pget_class_parent_f ! ! PURPOSE -! Retrieves the parent class of a genric property class. +! Retrieves the parent class of a generic property class. ! ! INPUTS ! @@ -5391,7 +5391,7 @@ END SUBROUTINE h5pget_copy_object_f ! ! HISTORY ! -! Should hdferr return just 0 or 1 and add another arguement for the size? +! Should hdferr return just 0 or 1 and add another argument for the size? ! Fortran90 Interface: SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) IMPLICIT NONE diff --git a/fortran/src/H5Sf.c b/fortran/src/H5Sf.c index 341acfdbf62..ea42a3180a1 100644 --- a/fortran/src/H5Sf.c +++ b/fortran/src/H5Sf.c @@ -388,7 +388,7 @@ h5sget_select_bounds_c(hid_t_f *space_id, hsize_t_f *start, hsize_t_f *end) * PURPOSE * Call H5Sget_select_elem_pointlist * get a list of element points in the - * current dataspace selectin. + * current dataspace selection. * Starting with the startpoint-th point in the * list of points, numpoints points are put into the user's * buffer. If the user's buffer fills up before numpoints @@ -759,7 +759,7 @@ h5soffset_simple_c(hid_t_f *space_id, hssize_t_f *offset) * space_id - identifier of the dataspace * rank - dataspace rank * current_size - array with the new dimension sizes - * maximum_size - aray with maximum sizes of dimensions + * maximum_size - array with maximum sizes of dimensions * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -804,7 +804,7 @@ h5sset_extent_simple_c(hid_t_f *space_id, int_f *rank, hsize_t_f *current_size, * space_id - identifier of the dataspace * OUTPUTS * dims - array with the dimension sizes - * maxdims - aray with maximum sizes of dimensions + * maxdims - array with maximum sizes of dimensions * RETURNS * number of dataspace dimensions (rank) on success, -1 on failure * AUTHOR @@ -852,7 +852,7 @@ h5sget_simple_extent_dims_c(hid_t_f *space_id, hsize_t_f *dims, hsize_t_f *maxdi * NAME * h5sis_simple_c * PURPOSE - * Call H5Sis_simple to detrmine if the dataspace + * Call H5Sis_simple to determine if the dataspace * is simple. * INPUTS * space_id - identifier of the dataspace diff --git a/fortran/src/H5Sff.F90 b/fortran/src/H5Sff.F90 index 62d665a85d5..76b0dea69cb 100644 --- a/fortran/src/H5Sff.F90 +++ b/fortran/src/H5Sff.F90 @@ -447,7 +447,7 @@ END SUBROUTINE h5sget_select_elem_npoints_f ! INPUTS ! space_id - dataspace identifier ! startpoint - element point to start with -! num_points - number of elemnt points to get +! num_points - number of element points to get ! OUTPUTS ! buf - buffer with element points selected ! hdferr - Returns 0 if successful and -1 if fails diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c index 1516cc78381..f3016f13ef7 100644 --- a/fortran/src/H5Tf.c +++ b/fortran/src/H5Tf.c @@ -1560,7 +1560,7 @@ h5tget_member_type_c(hid_t_f *type_id, int_f *field_idx, hid_t_f *datatype) * Call H5Tcreate to create a datatype * INPUTS * cls - class type - * size - size of the class memeber + * size - size of the class member * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -2033,7 +2033,7 @@ h5tvlen_create_c(hid_t_f *type_id, hid_t_f *vltype_id) * NAME * h5tis_variable_str_c * PURPOSE - * Call H5Tis_variable_str to detrmine if the datatype + * Call H5Tis_variable_str to determine if the datatype * is a variable string. * INPUTS * type_id - identifier of the dataspace @@ -2069,7 +2069,7 @@ h5tis_variable_str_c(hid_t_f *type_id, int_f *flag) * NAME * h5tget_member_class_c * PURPOSE - * Call H5Tget_member_class to detrmine ithe class of the compound + * Call H5Tget_member_class to determine ithe class of the compound * datatype member * INPUTS * type_id - identifier of the dataspace diff --git a/fortran/src/H5Tff.F90 b/fortran/src/H5Tff.F90 index 0eab39eac6d..7582dab1f4e 100644 --- a/fortran/src/H5Tff.F90 +++ b/fortran/src/H5Tff.F90 @@ -86,7 +86,7 @@ MODULE H5T ! called C functions (it is needed for Windows ! port). March 7, 2001 ! -! Added optional parameter 'tapl_id' for compatability +! Added optional parameter 'tapl_id' for compatibility ! with H5Topen2. April 9, 2009. ! ! SOURCE @@ -212,7 +212,7 @@ END SUBROUTINE h5tcommit_f ! h5tcopy_f ! ! PURPOSE -! Creates a copy of exisiting datatype. +! Creates a copy of existing datatype. ! ! INPUTS ! type_id - datatype identifier diff --git a/fortran/src/H5_buildiface.F90 b/fortran/src/H5_buildiface.F90 index fb3a002d7df..090b6dbcd67 100644 --- a/fortran/src/H5_buildiface.F90 +++ b/fortran/src/H5_buildiface.F90 @@ -14,7 +14,7 @@ ! ! NOTES ! This program uses the Fortran 2008 intrinsic function STORAGE_SIZE or SIZEOF -! depending on availablity.It generates code that makes use of +! depending on availability.It generates code that makes use of ! STORAGE_SIZE/SIZEOF in H5_gen.F90. STORAGE_SIZE is standard ! compliant and should always be chosen over SIZEOF. ! @@ -437,7 +437,7 @@ PROGRAM H5_buildiface ! dims parameter was added to make code portable; ! Aprile 4, 2001 ! -! Changed buf intent to INOUT to be consistant +! Changed buf intent to INOUT to be consistent ! with how the C functions handles it. The pg ! compiler will return 0 if a buf value is not set. ! February, 2008 @@ -564,7 +564,7 @@ PROGRAM H5_buildiface ! dims parameter was added to make code portable; ! Aprile 4, 2001 ! -! Changed buf intent to INOUT to be consistant +! Changed buf intent to INOUT to be consistent ! with how the C functions handles it. The pg ! compiler will return 0 if a buf value is not set. ! February, 2008 @@ -677,7 +677,7 @@ PROGRAM H5_buildiface ! Optional parameters: ! mem_space_id - memory dataspace identifier ! file_space_id - file dataspace identifier -! xfer_prp - trasfer property list identifier +! xfer_prp - transfer property list identifier ! ! AUTHOR ! Elena Pourmal diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index d245caed461..468debefbbf 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -65,12 +65,6 @@ h5init_types_c(hid_t_f *types, hid_t_f *floatingtypes, hid_t_f *integertypes) * 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) @@ -96,6 +90,12 @@ h5init_types_c(hid_t_f *types, hid_t_f *floatingtypes, hid_t_f *integertypes) } /*end else */ } + /* Initialized missing INTEGER KIND types to default to native integer */ + for (i = H5_FORTRAN_NUM_INTEGER_KINDS; i < 5; i++) { + if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) + return ret_value; + } + if (sizeof(int_f) == sizeof(int)) { if ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value; @@ -118,24 +118,20 @@ h5init_types_c(hid_t_f *types, hid_t_f *floatingtypes, hid_t_f *integertypes) 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[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[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[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[7] = H5Tcopy(H5T_NATIVE_FLOAT)) < 0) @@ -169,12 +165,10 @@ h5init_types_c(hid_t_f *types, hid_t_f *floatingtypes, hid_t_f *integertypes) 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[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value; } /*end else */ -#endif /* * FIND H5T_NATIVE_REAL_C_DOUBLE */ @@ -186,12 +180,10 @@ h5init_types_c(hid_t_f *types, hid_t_f *floatingtypes, hid_t_f *integertypes) 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[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value; } /*end else */ -#endif /* * FIND H5T_NATIVE_REAL_C_LONG_DOUBLE */ diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90 index f56cdd940fa..0aa4b041ee1 100644 --- a/fortran/src/H5_ff.F90 +++ b/fortran/src/H5_ff.F90 @@ -250,6 +250,9 @@ END FUNCTION h5init1_flags_c END INTERFACE + ! Check if H5open_f has already been called. If so, skip doing it again. + IF(H5OPEN_NUM_OBJ .NE. 0) RETURN + error = h5init_types_c(predef_types, floating_types, integer_types) H5T_NATIVE_INTEGER_KIND(1:5) = predef_types(1:5) @@ -668,6 +671,7 @@ END SUBROUTINE h5open_f ! October 13, 2011 ! Fortran90 Interface: SUBROUTINE h5close_f(error) + USE H5F, ONLY : h5fget_obj_count_f, H5OPEN_NUM_OBJ IMPLICIT NONE INTEGER, INTENT(OUT) :: error !***** @@ -685,10 +689,17 @@ INTEGER FUNCTION h5close_types_c(p_types, P_TYPES_LEN, & INTEGER(HID_T), DIMENSION(1:I_TYPES_LEN) :: i_types END FUNCTION h5close_types_c END INTERFACE + + ! Check if h5close_f has already been called. Skip doing it again. + IF(H5OPEN_NUM_OBJ .EQ. 0) RETURN + error = h5close_types_c(predef_types, PREDEF_TYPES_LEN, & floating_types, FLOATING_TYPES_LEN, & integer_types, INTEGER_TYPES_LEN ) + ! Reset the number of open objects from h5open_f to zero + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, H5OPEN_NUM_OBJ, error) + END SUBROUTINE h5close_f !****s* H5LIB/h5get_libversion_f @@ -701,7 +712,7 @@ END SUBROUTINE h5close_f ! ! Outputs: ! majnum - major version of the library -! minum - minor version of the library +! minnum - minor version of the library ! relnum - release version of the library ! error - Returns 0 if successful and -1 if fails ! @@ -736,7 +747,7 @@ END SUBROUTINE h5get_libversion_f ! ! Inputs: ! majnum - major version of the library -! minum - minor version of the library +! minnum - minor version of the library ! relnum - release version of the library ! ! Outputs: diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90 index 8f2b5ae106d..eb3b87e32d9 100644 --- a/fortran/src/H5f90global.F90 +++ b/fortran/src/H5f90global.F90 @@ -855,7 +855,7 @@ SUBROUTINE H5_Fortran_string_f2c(f_string, c_string) END SUBROUTINE H5_Fortran_string_f2c -! Copy Fortran string to C charater array, assuming the C array is one-char +! Copy Fortran string to C character array, assuming the C array is one-char ! longer for the terminating null char. ! fstring : the Fortran input string ! cstring : the C output string (with memory already allocated) @@ -883,7 +883,7 @@ END SUBROUTINE H5_Fortran_string_f2c !!$ cstring(j) = C_NULL_CHAR !!$end subroutine MPIR_Fortran_string_f2c !!$ -!!$! Copy C charater array to Fortran string +!!$! Copy C character array to Fortran string !!$subroutine MPIR_Fortran_string_c2f(cstring, fstring) !!$ implicit none !!$ character(kind=c_char), intent(in) :: cstring(:) diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 066bc36dc1c..4aa33f62c7b 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -20,21 +20,6 @@ H5_FCDLL char *HD5f2cstring(_fcd fdesc, size_t len); H5_FCDLL void HD5packFstring(char *src, char *dest, size_t len); -/* - * Storage struct used by H5Dread_multi and H5Dwrite_multi, - * interoperable with Fortran. - */ -typedef struct H5D_rw_multi_t_f { - hid_t dset_id; /* dstaset ID */ - hid_t dset_space_id; /* dataset selection dataspace ID */ - hid_t mem_type_id; /* memory datatype ID */ - hid_t mem_space_id; /* memory selection dataspace ID */ - union { - void * rbuf; /* pointer to read buffer */ - const void *wbuf; /* pointer to write buffer */ - } u; -} H5D_rw_multi_t_f; - /* * Storage info struct used by H5O_info_t and H5F_info_t * interoperable with Fortran. @@ -155,8 +140,6 @@ H5_FCDLL int_f h5sextent_equal_c(hid_t_f *space1_id, hid_t_f *space2_id, hid_t_f /* * Functions from H5Df.c */ -#define nh5dread_multi_c H5_FC_FUNC_(h5dread_multi_c, H5DREAD_MULTI_C) -#define nh5dwrite_multi_c H5_FC_FUNC_(h5dwrite_multi_c, H5DWRITE_MULTI_C) H5_FCDLL int_f h5dcreate_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *space_id, hid_t_f *lcpl_id, hid_t_f *dcpl_id, hid_t_f *dapl_id, hid_t_f *dset_id); @@ -203,8 +186,6 @@ H5_FCDLL int_f h5dread_f_c(hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_ hid_t_f *file_space_id, hid_t_f *xfer_prp, void *buf); H5_FCDLL int_f h5dvlen_reclaim_c(hid_t_f *type_id, hid_t_f *space_id, hid_t_f *plist_id, void *buf); -H5_FCDLL int_f h5dread_multi_c(hid_t_f *dxpl_id, size_t_f *count, H5D_rw_multi_t_f *info); -H5_FCDLL int_f h5dwrite_multi_c(hid_t_f *dxpl_id, size_t_f *count, H5D_rw_multi_t_f *info); /* * Functions from H5Gf.c */ @@ -559,7 +540,7 @@ H5_FCDLL int_f h5pget_dxpl_mpio_c(hid_t_f *prp_id, int_f *data_xfer_mode); H5_FCDLL int_f h5pset_dxpl_mpio_c(hid_t_f *prp_id, int_f *data_xfer_mode); #endif /* - * Functions frome H5Rf.c + * Functions from H5Rf.c */ H5_FCDLL int_f h5rcreate_region_c(int_f *ref, hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *space_id); H5_FCDLL int_f h5rcreate_ptr_c(void *ref, hid_t_f *loc_id, _fcd name, int_f *namelen, int_f *ref_type, diff --git a/fortran/src/h5fc.in b/fortran/src/h5fc.in index a56d38d79ba..661fde5d523 100644 --- a/fortran/src/h5fc.in +++ b/fortran/src/h5fc.in @@ -38,7 +38,7 @@ HL="@HL@" ## $FLINKER $FCFLAGS $H5BLD_FCFLAGS $F9XSUFFIXFLAG $LDFLAGS $LIBS ## ## $fmodules $link_objs $link_args $shared_link ## ## ## -## These settings can be overriden by setting HDF5_FCFLAGS, ## +## These settings can be overridden by setting HDF5_FCFLAGS, ## ## HDF5_LDFLAGS, or HDF5_LIBS in the environment. ## ## ## ############################################################################ @@ -136,7 +136,7 @@ usage() { echo " shared libraries]" echo " " echo " You can also add or change paths and flags to the compile line using" - echo " the following environment varibles or by assigning them to their counterparts" + echo " the following environment variables or by assigning them to their counterparts" echo " in the 'Things You Can Modify to Override...'" section of $prog_name echo " " echo " Variable Current value to be replaced" @@ -298,7 +298,7 @@ fi if test "x$do_link" = "xyes"; then shared_link="" -# conditionnaly link with the hl library +# conditionally link with the hl library if test "X$HL" = "Xhl"; then libraries=" $libraries -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 " else diff --git a/fortran/test/tH5T_F03.F90 b/fortran/test/tH5T_F03.F90 index b3072f656d3..02e848e492c 100644 --- a/fortran/test/tH5T_F03.F90 +++ b/fortran/test/tH5T_F03.F90 @@ -3434,7 +3434,11 @@ SUBROUTINE multiple_dset_rw(total_error) INTEGER :: error ! HDF hdferror flag INTEGER(SIZE_T), PARAMETER :: ndset = 5 ! Number of data sets - + INTEGER(HID_T), DIMENSION(:), ALLOCATABLE :: dset_id + INTEGER(HID_T), DIMENSION(:), ALLOCATABLE :: mem_type_id + INTEGER(HID_T), DIMENSION(:), ALLOCATABLE :: mem_space_id + INTEGER(HID_T), DIMENSION(:), ALLOCATABLE :: file_space_id + INTEGER, PARAMETER :: idim=10, idim2=5, idim3=3 ! size of integer array INTEGER, PARAMETER :: rdim=5 ! size of real array INTEGER, PARAMETER :: cdim=3 ! size of character array @@ -3442,7 +3446,7 @@ SUBROUTINE multiple_dset_rw(total_error) INTEGER, PARAMETER :: ddim=2 ! size of derived type array INTEGER :: i,j,k - TYPE(H5D_rw_multi_t), ALLOCATABLE, DIMENSION(:) :: info_md ! array to hold the multi-datasets + TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: buf_md ! array to hold the multi-datasets INTEGER, DIMENSION(1:idim), TARGET :: wbuf_int ! integer write buffer INTEGER, DIMENSION(1:idim,idim2,idim3), TARGET :: wbuf_intmd @@ -3464,8 +3468,33 @@ SUBROUTINE multiple_dset_rw(total_error) INTEGER(HSIZE_T), DIMENSION(1:1) :: dims ! dimension of the spaces INTEGER(HSIZE_T), DIMENSION(1:3) :: dimsmd ! dimension of the spaces INTEGER(HID_T) :: file_id, strtype ! handles + INTEGER(SIZE_T) :: obj_count - ALLOCATE(info_md(1:ndset),stat=error) + ALLOCATE(buf_md(1:ndset),stat=error) + IF (error .NE. 0) THEN + WRITE(*,*) 'allocate error' + total_error = total_error + 1 + RETURN + ENDIF + ALLOCATE(dset_id(1:ndset),stat=error) + IF (error .NE. 0) THEN + WRITE(*,*) 'allocate error' + total_error = total_error + 1 + RETURN + ENDIF + ALLOCATE(mem_type_id(1:ndset),stat=error) + IF (error .NE. 0) THEN + WRITE(*,*) 'allocate error' + total_error = total_error + 1 + RETURN + ENDIF + ALLOCATE(mem_space_id(1:ndset),stat=error) + IF (error .NE. 0) THEN + WRITE(*,*) 'allocate error' + total_error = total_error + 1 + RETURN + ENDIF + ALLOCATE(file_space_id(1:ndset),stat=error) IF (error .NE. 0) THEN WRITE(*,*) 'allocate error' total_error = total_error + 1 @@ -3479,66 +3508,66 @@ SUBROUTINE multiple_dset_rw(total_error) ! wbuf_real(1:rdim) = (/(i,i=1,rdim)/) dims(1) = rdim - info_md(1)%buf = C_LOC(wbuf_real(1)) - info_md(1)%mem_type_id = H5T_NATIVE_REAL - CALL h5screate_simple_f(1, dims, info_md(1)%dset_space_id, error) + buf_md(1) = C_LOC(wbuf_real(1)) + mem_type_id(1) = H5T_NATIVE_REAL + CALL h5screate_simple_f(1, dims, file_space_id(1), error) CALL check("h5screate_simple_f", error, total_error) - CALL h5dcreate_f(file_id, "ds real", info_md(1)%mem_type_id, info_md(1)%dset_space_id, info_md(1)%dset_id, error) + CALL h5dcreate_f(file_id, "ds real", mem_type_id(1), file_space_id(1), dset_id(1), error) CALL check("h5dcreate_f", error, total_error) - info_md(1)%mem_space_id = info_md(1)%dset_space_id + mem_space_id(1) = file_space_id(1) ! Create integer dataset (1D) wbuf_int(1:idim) = (/(i,i=1,idim)/) dims(1) = idim - info_md(2)%buf = C_LOC(wbuf_int(1)) - info_md(2)%mem_type_id = H5T_NATIVE_INTEGER - CALL h5screate_simple_f(1, dims, info_md(2)%dset_space_id, error) + buf_md(2) = C_LOC(wbuf_int(1)) + mem_type_id(2) = H5T_NATIVE_INTEGER + CALL h5screate_simple_f(1, dims, file_space_id(2), error) CALL check("h5screate_simple_f", error, total_error) - CALL h5dcreate_f(file_id, "ds int", info_md(2)%mem_type_id, info_md(2)%dset_space_id, info_md(2)%dset_id, error) + CALL h5dcreate_f(file_id, "ds int", mem_type_id(2), file_space_id(2), dset_id(2), error) CALL check("h5dcreate_f", error, total_error) - info_md(2)%mem_space_id = info_md(2)%dset_space_id + mem_space_id(2) = file_space_id(2) ! Create character dataset wbuf_chr(1:cdim) = (/'ab','cd','ef'/) dims(1) = cdim - info_md(cdim)%buf = C_LOC(wbuf_chr(1)(1:1)) - CALL H5Tcopy_f(H5T_FORTRAN_S1, info_md(cdim)%mem_type_id, error) + buf_md(3) = C_LOC(wbuf_chr(1)(1:1)) + CALL H5Tcopy_f(H5T_FORTRAN_S1, mem_type_id(3), error) CALL check("H5Tcopy_f", error, total_error) - CALL H5Tset_size_f(info_md(cdim)%mem_type_id, INT(sdim,SIZE_T), error) + CALL H5Tset_size_f(mem_type_id(3), INT(sdim,SIZE_T), error) CALL check("H5Tset_size_f", error, total_error) - CALL h5screate_simple_f(1, dims, info_md(cdim)%dset_space_id, error) + CALL h5screate_simple_f(1, dims, file_space_id(3), error) CALL check("h5screate_simple_f", error, total_error) - CALL h5dcreate_f(file_id, "ds chr", info_md(cdim)%mem_type_id, info_md(cdim)%dset_space_id, info_md(cdim)%dset_id, error) + CALL h5dcreate_f(file_id, "ds chr", mem_type_id(3), file_space_id(3), dset_id(3), error) CALL check("h5dcreate_f", error, total_error) - info_md(cdim)%mem_space_id = info_md(cdim)%dset_space_id + mem_space_id(3) = file_space_id(3) ! Create derived type dataset wbuf_derived(1:ddim)%r = (/10.,20./) wbuf_derived(1:ddim)%i = (/30,40/) wbuf_derived(1:ddim)%c = (/'wx','yz'/) - info_md(4)%buf = C_LOC(wbuf_derived(1)%r) - CALL h5tcreate_f(H5T_COMPOUND_F, H5OFFSETOF(C_LOC(wbuf_derived(1)), C_LOC(wbuf_derived(2))), info_md(4)%mem_type_id, error) + buf_md(4) = C_LOC(wbuf_derived(1)%r) + CALL h5tcreate_f(H5T_COMPOUND_F, H5OFFSETOF(C_LOC(wbuf_derived(1)), C_LOC(wbuf_derived(2))), mem_type_id(4), error) CALL check("h5tcreate_f", error, total_error) - CALL h5tinsert_f(info_md(4)%mem_type_id, "real", & + CALL h5tinsert_f(mem_type_id(4), "real", & H5OFFSETOF(C_LOC(wbuf_derived(1)),C_LOC(wbuf_derived(1)%r)), H5T_NATIVE_REAL, error) CALL check("h5tinsert_f", error, total_error) - CALL h5tinsert_f(info_md(4)%mem_type_id, "int", & + CALL h5tinsert_f(mem_type_id(4), "int", & H5OFFSETOF(C_LOC(wbuf_derived(1)),C_LOC(wbuf_derived(1)%i)), H5T_NATIVE_INTEGER, error) CALL check("h5tinsert_f", error, total_error) CALL h5tcopy_f(H5T_NATIVE_CHARACTER, strtype, error) CALL check("h5tcopy_f", error, total_error) CALL h5tset_size_f(strtype, INT(sdim,size_t), error) CALL check("h5tset_size_f", error, total_error) - CALL h5tinsert_f(info_md(4)%mem_type_id, "chr", & + CALL h5tinsert_f(mem_type_id(4), "chr", & H5OFFSETOF(C_LOC(wbuf_derived(1)),C_LOC(wbuf_derived(1)%c(1:1))), strtype, error) CALL check("h5tinsert_f", error, total_error) dims(1) = ddim - CALL h5screate_simple_f(1, dims, info_md(4)%dset_space_id, error) + CALL h5screate_simple_f(1, dims, file_space_id(4), error) CALL check("h5screate_simple_f", error, total_error) - CALL h5dcreate_f(file_id, "ds derived", info_md(4)%mem_type_id, info_md(4)%dset_space_id, info_md(4)%dset_id, error) + CALL h5dcreate_f(file_id, "ds derived", mem_type_id(4), file_space_id(4), dset_id(4), error) CALL check("h5dcreate_f", error, total_error) - info_md(4)%mem_space_id = info_md(4)%dset_space_id + mem_space_id(4) = file_space_id(4) ! Create integer dataset (3D) @@ -3552,28 +3581,28 @@ SUBROUTINE multiple_dset_rw(total_error) ENDDO dimsmd(1:3) = (/idim,idim2,idim3/) - info_md(5)%buf = C_LOC(wbuf_intmd(1,1,1)) - info_md(5)%mem_type_id = H5T_NATIVE_INTEGER - CALL h5screate_simple_f(3, dimsmd, info_md(5)%dset_space_id, error) + buf_md(5) = C_LOC(wbuf_intmd(1,1,1)) + mem_type_id(5) = H5T_NATIVE_INTEGER + CALL h5screate_simple_f(3, dimsmd, file_space_id(5), error) CALL check("h5screate_simple_f", error, total_error) - CALL h5dcreate_f(file_id, "ds int 3d", info_md(5)%mem_type_id, info_md(5)%dset_space_id, info_md(5)%dset_id, error) + CALL h5dcreate_f(file_id, "ds int 3d", mem_type_id(5), file_space_id(5), dset_id(5), error) CALL check("h5dcreate_f", error, total_error) - info_md(5)%mem_space_id = info_md(5)%dset_space_id + mem_space_id(5) = file_space_id(5) ! write all the datasets - CALL h5dwrite_multi_f(H5P_DEFAULT_F, ndset, info_md, error) + CALL h5dwrite_multi_f(ndset, dset_id, mem_type_id, mem_space_id, file_space_id, buf_md, error) CALL check("h5dwrite_multi_f", error, total_error) ! point to read buffers - info_md(1)%buf = C_LOC(rbuf_real(1)) - info_md(2)%buf = C_LOC(rbuf_int(1)) - info_md(3)%buf = C_LOC(rbuf_chr(1)(1:1)) - info_md(4)%buf = C_LOC(rbuf_derived(1)%r) - info_md(5)%buf = C_LOC(rbuf_intmd(1,1,1)) + buf_md(1) = C_LOC(rbuf_real(1)) + buf_md(2) = C_LOC(rbuf_int(1)) + buf_md(3) = C_LOC(rbuf_chr(1)(1:1)) + buf_md(4) = C_LOC(rbuf_derived(1)%r) + buf_md(5) = C_LOC(rbuf_intmd(1,1,1)) ! read all the datasets - CALL h5dread_multi_f(H5P_DEFAULT_F, ndset, info_md, error) + CALL h5dread_multi_f(ndset, dset_id, mem_type_id, mem_space_id, file_space_id, buf_md, error) CALL check("h5dread_multi_f", error, total_error) ! check the written and read in values @@ -3613,6 +3642,22 @@ SUBROUTINE multiple_dset_rw(total_error) ENDDO ENDDO + DO i = 1, ndset + CALL H5Dclose_f(dset_id(i), error) + CALL check("H5Dclose_f", error, total_error) + CALL H5Sclose_f(file_space_id(i), error) + CALL check("H5Sclose_f", error, total_error) + ENDDO + CALL H5Tclose_f(mem_type_id(4), error) + CALL check("H5Tclose_f", error, total_error) + + CALL h5fget_obj_count_f(file_id, H5F_OBJ_ALL_F, obj_count, error) + IF(obj_count.NE.1)THEN + total_error = total_error + 1 + END IF + + CALL H5Fclose_f(file_id, error) + END SUBROUTINE multiple_dset_rw diff --git a/fortran/testpar/CMakeLists.txt b/fortran/testpar/CMakeLists.txt index dd3e8d8959f..6ab498c510b 100644 --- a/fortran/testpar/CMakeLists.txt +++ b/fortran/testpar/CMakeLists.txt @@ -20,6 +20,7 @@ add_executable (parallel_test ptest.f90 hyper.f90 mdset.f90 + multidsetrw.F90 ) target_include_directories (parallel_test PRIVATE ${TESTPAR_INCLUDES} @@ -59,26 +60,6 @@ if(MSVC) set_property(TARGET parallel_test PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") endif() -#-- Adding test for parallel_test_F03 -if (HDF5_ENABLE_F2003) - add_executable (parallel_test_F03 - ptest_F03.F90 - multidsetrw_F03.F90 - ) - TARGET_NAMING (parallel_test_F03 ${LIB_TYPE}) - TARGET_FORTRAN_PROPERTIES (parallel_test_F03 " " " ") - target_link_libraries (parallel_test_F03 - ${HDF5_F90_TEST_LIB_TARGET} - ${HDF5_F90_LIB_TARGET} - ${HDF5_LIB_TARGET} - ) - if (WIN32 AND MSVC) - target_link_libraries (parallel_test_F03 "ws2_32.lib") - endif (WIN32 AND MSVC) - set_target_properties (parallel_test_F03 PROPERTIES LINKER_LANGUAGE Fortran) - set_target_properties (parallel_test_F03 PROPERTIES FOLDER test/fortran) -endif (HDF5_ENABLE_F2003) - if (HDF5_TEST_FORTRAN AND HDF5_TEST_PARALLEL) include (CMakeTests.cmake) endif () diff --git a/fortran/testpar/Makefile.am b/fortran/testpar/Makefile.am index 412900c573b..d1bb911911f 100644 --- a/fortran/testpar/Makefile.am +++ b/fortran/testpar/Makefile.am @@ -33,15 +33,14 @@ else endif # These are our main targets -TEST_PROG_PARA=parallel_test parallel_test_F03 +TEST_PROG_PARA=parallel_test check_PROGRAMS=$(TEST_PROG_PARA) # Temporary files CHECK_CLEANFILES+=parf[12].h5 # Test source files -parallel_test_SOURCES=ptest.f90 hyper.f90 mdset.f90 -parallel_test_F03_SOURCES=ptest_F03.F90 multidsetrw_F03.F90 +parallel_test_SOURCES=ptest.f90 hyper.f90 mdset.f90 multidsetrw.F90 # The tests depend on several libraries. LDADD=$(LIBH5FTEST) $(LIBH5TEST) $(LIBH5F) $(LIBHDF5) diff --git a/fortran/testpar/hyper.f90 b/fortran/testpar/hyper.f90 index d4a60d9c39a..f1e8d321d6f 100644 --- a/fortran/testpar/hyper.f90 +++ b/fortran/testpar/hyper.f90 @@ -237,19 +237,23 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) CALL h5pget_mpio_actual_io_mode_f(dxpl_id, actual_io_mode, hdferror) CALL check("h5pget_mpio_actual_io_mode_f", hdferror, nerrors) - IF(do_collective.AND.do_chunk)THEN - IF(actual_io_mode.NE.H5D_MPIO_CHUNK_COLLECTIVE_F)THEN - CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) - ENDIF - ELSEIF(.NOT.do_collective)THEN - IF(actual_io_mode.NE.H5D_MPIO_NO_COLLECTIVE_F)THEN - CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) - ENDIF - ELSEIF( do_collective.AND.(.NOT.do_chunk))THEN - IF(actual_io_mode.NE.H5D_MPIO_CONTIG_COLLECTIVE_F)THEN - CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) - ENDIF - ENDIF +! MSB -- TODO FIX: skipping for now since multi-dataset +! has no specific path for contiguous collective +! +! IF(do_collective.AND.do_chunk)THEN +! IF(actual_io_mode.NE.H5D_MPIO_CHUNK_COLLECTIVE_F)THEN +! CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) +! ENDIF +! ELSEIF(.NOT.do_collective)THEN +! IF(actual_io_mode.NE.H5D_MPIO_NO_COLLECTIVE_F)THEN +! CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) +! ENDIF +! ELSEIF( do_collective.AND.(.NOT.do_chunk))THEN +! IF(actual_io_mode.NE.H5D_MPIO_CONTIG_COLLECTIVE_F)THEN +! CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) +! ENDIF +! ENDIF +! MSB ! ! close HDF5 I/O @@ -318,7 +322,6 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror) CALL check("h5pcreate_f", hdferror, nerrors) - IF (do_collective) THEN CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror) CALL check("h5pcreate_f", hdferror, nerrors) diff --git a/fortran/testpar/multidsetrw_F03.F90 b/fortran/testpar/multidsetrw.F90 similarity index 80% rename from fortran/testpar/multidsetrw_F03.F90 rename to fortran/testpar/multidsetrw.F90 index 177f94ed430..f1c6660a462 100644 --- a/fortran/testpar/multidsetrw_F03.F90 +++ b/fortran/testpar/multidsetrw.F90 @@ -32,28 +32,34 @@ SUBROUTINE pmultiple_dset_hyper_rw(do_collective, do_chunk, mpi_size, mpi_rank, INTEGER, INTENT(in) :: mpi_rank ! rank of the calling process in the communicator INTEGER, INTENT(inout) :: nerrors ! number of errors CHARACTER(LEN=80):: dsetname ! Dataset name - TYPE(H5D_rw_multi_t), ALLOCATABLE, DIMENSION(:) :: info_md INTEGER(hsize_t), DIMENSION(1:2) :: cdims ! chunk dimensions - INTEGER(SIZE_T):: ndsets INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: filespace ! Dataspace identifier in file INTEGER(HID_T) :: memspace ! Dataspace identifier in memory INTEGER(HID_T) :: plist_id ! Property list identifier INTEGER(HID_T) :: dcpl_id ! Dataset creation property list INTEGER(HSIZE_T), DIMENSION(1:2) :: dimsf ! Dataset dimensions. - INTEGER(HSIZE_T), DIMENSION(1:2) :: dimsfi = (/5,8/) INTEGER(HSIZE_T), DIMENSION(1:2) :: count INTEGER(HSSIZE_T), DIMENSION(1:2) :: offset INTEGER, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: DATA ! Data to write INTEGER, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: rDATA ! Data to write INTEGER, PARAMETER :: rank = 2 ! Dataset rank - INTEGER :: i, j, k, istart + INTEGER :: i + INTEGER(HSIZE_T) :: ii, jj, kk, istart INTEGER :: error ! Error flags - dimsf = (/5_hsize_t,INT(mpi_size, hsize_t)*8_hsize_t/) - ndsets = 5; + INTEGER(SIZE_T), PARAMETER :: ndsets = 5 + INTEGER(HID_T), DIMENSION(1:ndsets) :: dset_id + INTEGER(HID_T), DIMENSION(1:ndsets) :: mem_type_id + INTEGER(HID_T), DIMENSION(1:ndsets) :: mem_space_id + INTEGER(HID_T), DIMENSION(1:ndsets) :: file_space_id + TYPE(C_PTR), DIMENSION(1:ndsets) :: buf_md + INTEGER(SIZE_T) :: obj_count + + dimsf(1) = 5_hsize_t + dimsf(2) = INT(mpi_size, hsize_t)*8_hsize_t ! ! Setup file access property list with parallel I/O access. @@ -109,9 +115,6 @@ SUBROUTINE pmultiple_dset_hyper_rw(do_collective, do_chunk, mpi_size, mpi_rank, ALLOCATE ( DATA(COUNT(1),COUNT(2), ndsets)) ALLOCATE ( rdata(COUNT(1),COUNT(2), ndsets)) - ALLOCATE(info_md(1:ndsets)) - - ! ! Create property list for collective dataset write ! CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, error) @@ -127,53 +130,53 @@ SUBROUTINE pmultiple_dset_hyper_rw(do_collective, do_chunk, mpi_size, mpi_rank, ! ! Create the dataset with default properties. ! - info_md(1:ndsets)%mem_type_id = H5T_NATIVE_INTEGER - info_md(1:ndsets)%mem_space_id = memspace - info_md(1:ndsets)%dset_space_id = filespace + mem_type_id(1:ndsets) = H5T_NATIVE_INTEGER + mem_space_id(1:ndsets) = memspace + file_space_id(1:ndsets)= filespace - DO i = 1, ndsets + DO ii = 1, ndsets ! Create the data - DO k = 1, COUNT(1) - DO j = 1, COUNT(2) - istart = (k-1)*dimsf(2) + mpi_rank*COUNT(2) - DATA(k,j,i) = (istart + j)*10**(i-1) + DO kk = 1, COUNT(1) + DO jj = 1, COUNT(2) + istart = (kk-1)*dimsf(2) + mpi_rank*COUNT(2) + DATA(kk,jj,ii) = INT((istart + jj)*10**(ii-1)) ENDDO ENDDO ! Point to te data - info_md(i)%buf = C_LOC(DATA(1,1,i)) + buf_md(ii) = C_LOC(DATA(1,1,ii)) ! direct the output of the write statement to unit "dsetname" - WRITE(dsetname,'("dataset ",I0)') i + WRITE(dsetname,'("dataset ",I0)') ii ! create the dataset - CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, filespace, info_md(i)%dset_id, error, dcpl_id) + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, filespace, dset_id(ii), error, dcpl_id) CALL check("h5dcreate_f", error, nerrors) ENDDO ! ! Write the dataset collectively. - ! - CALL h5dwrite_multi_f(plist_id, ndsets, info_md, error) + ! + CALL h5dwrite_multi_f(ndsets, dset_id, mem_type_id, mem_space_id, file_space_id, buf_md, error) CALL check("h5dwrite_multi_f", error, nerrors) DO i = 1, ndsets ! Point to the read buffer - info_md(i)%buf = C_LOC(rdata(1,1,i)) + buf_md(i) = C_LOC(rdata(1,1,i)) ENDDO - CALL H5Dread_multi_f(plist_id, ndsets, info_md, error) + CALL H5Dread_multi_f(ndsets, dset_id, mem_type_id, mem_space_id, file_space_id, buf_md, error) CALL check("h5dread_multi_f", error, nerrors) DO i = 1, ndsets ! Close all the datasets - CALL h5dclose_f(info_md(i)%dset_id, error) + CALL h5dclose_f(dset_id(i), error) CALL check("h5dclose_f", error, nerrors) ENDDO ! check the data read and write buffers - DO i = 1, ndsets + DO ii = 1, ndsets ! Create the data - DO k = 1, COUNT(1) - DO j = 1, COUNT(2) - IF(rDATA(k,j,i).NE.DATA(k,j,i))THEN + DO kk = 1, COUNT(1) + DO jj = 1, COUNT(2) + IF(rDATA(kk,jj,ii).NE.DATA(kk,jj,ii))THEN nerrors = nerrors + 1 ENDIF ENDDO @@ -194,9 +197,16 @@ SUBROUTINE pmultiple_dset_hyper_rw(do_collective, do_chunk, mpi_size, mpi_rank, ! ! Close the dataset and property list. ! + CALL h5pclose_f(dcpl_id, error) + CALL check("h5pclose_f", error, nerrors) CALL h5pclose_f(plist_id, error) CALL check("h5pclose_f", error, nerrors) + CALL h5fget_obj_count_f(file_id, H5F_OBJ_ALL_F, obj_count, error) + IF(obj_count.NE.1)THEN + nerrors = nerrors + 1 + END IF + ! ! Close the file. ! diff --git a/fortran/testpar/ptest.f90 b/fortran/testpar/ptest.f90 index 30abb889738..ec5aef616d2 100644 --- a/fortran/testpar/ptest.f90 +++ b/fortran/testpar/ptest.f90 @@ -76,7 +76,18 @@ PROGRAM parallel_test CALL multiple_dset_write(length, do_collective(1), do_chunk(1), mpi_size, mpi_rank, ret_total_error) IF(mpi_rank==0) CALL write_test_status(ret_total_error, & 'Writing/reading several datasets (contiguous layout, independent MPI I/O)', total_error) - + ! + ! test write/read multiple hyperslab datasets + ! + DO i = 1, 2 + DO j = 1, 2 + ret_total_error = 0 + CALL pmultiple_dset_hyper_rw(do_collective(j), do_chunk(i), mpi_size, mpi_rank, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + "Writing/reading multiple datasets by hyperslab ("//TRIM(chr_chunk(i))//" layout, "& + //TRIM(chr_collective(j))//" MPI I/O)", total_error) + ENDDO + ENDDO ! ! close HDF5 interface ! diff --git a/fortran/testpar/ptest_F03.F90 b/fortran/testpar/ptest_F03.F90 deleted file mode 100644 index e23d2e86e90..00000000000 --- a/fortran/testpar/ptest_F03.F90 +++ /dev/null @@ -1,104 +0,0 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! Copyright by The HDF Group. * -! Copyright by the Board of Trustees of the University of Illinois. * -! All rights reserved. * -! * -! This file is part of HDF5. The full HDF5 copyright notice, including * -! terms governing use, modification, and redistribution, is contained in * -! the files COPYING and Copyright.html. COPYING can be found at the root * -! of the source code distribution tree; Copyright.html can be found at the * -! root level of an installed copy of the electronic HDF5 document set and * -! is linked from the top-level documents page. It can also be found at * -! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * -! access to either file, you may request a copy from help@hdfgroup.org. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * - -! -! MAIN PROGRAM FOR PARALLEL HDF5 FORTRAN 2003 TESTS -! - -PROGRAM parallel_test_F03 - USE hdf5 - USE TH5_MISC - USE mpi - IMPLICIT NONE - - INTEGER :: mpierror ! MPI hdferror flag - INTEGER :: hdferror ! HDF hdferror flag - INTEGER :: nerrors = 0 ! number of errors - INTEGER :: mpi_size ! number of processes in the group of communicator - INTEGER :: mpi_rank ! rank of the calling process in the communicator - INTEGER :: i,j - ! use collective MPI I/O - LOGICAL, DIMENSION(1:2) :: do_collective = (/.FALSE.,.TRUE./) - CHARACTER(LEN=11), DIMENSION(1:2) :: chr_collective =(/"independent", "collective "/) - ! use chunking - LOGICAL, DIMENSION(1:2) :: do_chunk = (/.FALSE.,.TRUE./) - CHARACTER(LEN=10), DIMENSION(1:2) :: chr_chunk =(/"contiguous", "chunk "/) - INTEGER :: total_error = 0 - - ! - ! initialize MPI - ! - CALL mpi_init(mpierror) - IF (mpierror .NE. MPI_SUCCESS) WRITE(*,*) "MPI_INIT *FAILED*" - CALL mpi_comm_rank( MPI_COMM_WORLD, mpi_rank, mpierror ) - IF (mpierror .NE. MPI_SUCCESS) WRITE(*,*) "MPI_COMM_RANK *FAILED* Process = ", mpi_rank - CALL mpi_comm_size( MPI_COMM_WORLD, mpi_size, mpierror ) - IF (mpierror .NE. MPI_SUCCESS) WRITE(*,*) "MPI_COMM_SIZE *FAILED* Process = ", mpi_rank - - ! - ! initialize the HDF5 fortran interface - ! - CALL h5open_f(hdferror) - ! - ! test write/read multiple hyperslab datasets - ! - DO i = 1, 2 - DO j = 1, 2 - nerrors = 0 - CALL pmultiple_dset_hyper_rw(do_collective(j), do_chunk(i), mpi_size, mpi_rank, nerrors) - IF(mpi_rank==0) CALL write_test_status(nerrors, & - "Writing/reading multiple datasets by hyperslab ("//TRIM(chr_chunk(i))//" layout, "& - //TRIM(chr_collective(j))//" MPI I/O)",total_error) - ENDDO - ENDDO -!!$ -!!$ do_collective = .FALSE. -!!$ do_chunk = .FALSE. -!!$ IF (mpi_rank == 0) WRITE(*,*) 'Writing/Reading multiple hyperslab datasets (contiguous layout, independent MPI IO)' -!!$ CALL pmultiple_dset_hyper_rw(do_collective, do_chunk, mpi_size, mpi_rank, nerrors) -!!$ -!!$ do_collective = .TRUE. -!!$ do_chunk = .TRUE. -!!$ IF (mpi_rank == 0) WRITE(*,*) 'Writing/Reading multiple hyperslab datasets (chunked, collective MPI IO)' -!!$ CALL pmultiple_dset_hyper_rw(do_collective, do_chunk, mpi_size, mpi_rank, nerrors) -!!$ -!!$ do_collective = .FALSE. -!!$ do_chunk = .TRUE. -!!$ IF (mpi_rank == 0) WRITE(*,*) 'Writing/Reading multiple hyperslab datasets (chunked, independent MPI IO)' -!!$ CALL pmultiple_dset_hyper_rw(do_collective, do_chunk, mpi_size, mpi_rank, nerrors) - - ! - ! close HDF5 interface - ! - CALL h5close_f(hdferror) - - ! - ! close MPI - ! - IF (total_error == 0) THEN - CALL mpi_finalize(mpierror) - IF (mpierror .NE. MPI_SUCCESS) THEN - WRITE(*,*) "MPI_FINALIZE *FAILED* Process = ", mpi_rank - ENDIF - ELSE - WRITE(*,'(I0, A, I0)') total_error, ' Errors detected in process ', mpi_rank - CALL mpi_abort(MPI_COMM_WORLD, 1, mpierror) - IF (mpierror .NE. MPI_SUCCESS) THEN - WRITE(*,*) "MPI_ABORT *FAILED* Process = ", mpi_rank - ENDIF - ENDIF - -END PROGRAM parallel_test_F03 -