From c783decba564668b94009236d9b74f888fbae006 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 28 Sep 2012 10:31:22 -0500 Subject: [svn-r22840] Merged changes from the trunk into the branch, svn merge -r22479:22826 https://svn.hdfgroup.uiuc.edu/hdf5/trunk/fortran tested: jam (gnu, intel, pgi) koala (gnu, pgi) --- fortran/src/H5Df.c | 2 - fortran/src/H5FDmpiof.c | 37 +++++ fortran/src/H5FDmpioff.f90 | 45 ++++++ fortran/src/H5Rf.c | 41 +++++ fortran/src/H5Rff.f90 | 61 ------- fortran/src/H5Rff_F03.f90 | 174 ++++++++++++++++---- fortran/src/H5Rff_F90.f90 | 65 ++++++++ fortran/src/H5_f.c | 69 ++++---- fortran/src/H5_ff.f90 | 3 + fortran/src/H5f90global.f90 | 56 ++++--- fortran/src/H5f90kit.c | 2 +- fortran/src/H5f90proto.h | 37 ++++- fortran/src/H5match_types.c | 24 ++- fortran/src/h5fc.in | 4 + fortran/src/hdf5_fortrandll.def | 2 + fortran/src/phdf5_fortrandll.def | 5 + fortran/test/fortranlib_test_1_8.f90 | 141 ---------------- fortran/test/fortranlib_test_F03.f90 | 9 ++ fortran/test/tH5A.f90 | 4 +- fortran/test/tH5T.f90 | 4 +- fortran/test/tH5T_F03.f90 | 303 ++++++++++++++++++++++++++++++++++- fortran/testpar/hyper.f90 | 19 +++ 22 files changed, 796 insertions(+), 311 deletions(-) diff --git a/fortran/src/H5Df.c b/fortran/src/H5Df.c index 6bb1f1c..ab7adf7 100644 --- a/fortran/src/H5Df.c +++ b/fortran/src/H5Df.c @@ -2409,8 +2409,6 @@ nh5dread_f_c ( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_space_id, /* * Call H5Dread function. */ - - status = H5Dread(c_dset_id, c_mem_type_id, c_mem_space_id, c_file_space_id, c_xfer_prp, buf); if ( status < 0 ) return ret_value; diff --git a/fortran/src/H5FDmpiof.c b/fortran/src/H5FDmpiof.c index 89b4180..993b5ac 100644 --- a/fortran/src/H5FDmpiof.c +++ b/fortran/src/H5FDmpiof.c @@ -300,3 +300,40 @@ nh5pget_fapl_mpiposix_c(hid_t_f *prp_id, int_f* comm, int_f* flag) ret_value = 0; return ret_value; } + +/****if* H5Pf/h5pget_mpio_actual_io_mode_c + * NAME + * h5pget_mpio_actual_io_mode_c + * PURPOSE + * Calls H5Pget_mpio_actual_io_mode + * + * INPUTS + * dxpl_id - Dataset transfer property list identifier. + * OUTPUTS + * actual_io_mode - The type of I/O performed by this process. + * + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * July 27, 2012 + * SOURCE +*/ +int_f +nh5pget_mpio_actual_io_mode_c(hid_t_f *dxpl_id, int_f *actual_io_mode) +/******/ +{ + int ret_value = -1; + H5D_mpio_actual_io_mode_t c_actual_io_mode; + + /* + * Call H5Pget_mpio_actual_io_mode_f function. + */ + if( (H5Pget_mpio_actual_io_mode((hid_t)*dxpl_id, &c_actual_io_mode)) <0 ) + return ret_value; /* error occurred */ + + *actual_io_mode =(int_f)c_actual_io_mode; + + ret_value = 0; + return ret_value; +} diff --git a/fortran/src/H5FDmpioff.f90 b/fortran/src/H5FDmpioff.f90 index ea9283c..f6f3108 100644 --- a/fortran/src/H5FDmpioff.f90 +++ b/fortran/src/H5FDmpioff.f90 @@ -234,4 +234,49 @@ CONTAINS IF (flag .EQ. 1) use_gpfs = .TRUE. END SUBROUTINE h5pget_fapl_mpiposix_f + +!****s* H5P/h5pget_mpio_actual_io_mode_f +! NAME +! h5pget_mpio_actual_io_mode_f +! +! PURPOSE +! Retrieves the type of I/O that HDF5 actually performed on the last +! parallel I/O call. This is not necessarily the type of I/O requested. +! +! INPUTS +! dxpl_id - Dataset transfer property list identifier. +! OUTPUTS +! actual_io_mode - The type of I/O performed by this process. +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! July 27, 2012 +! +! HISTORY +! +! Fortran90 Interface: + SUBROUTINE h5pget_mpio_actual_io_mode_f(dxpl_id, actual_io_mode, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dxpl_id + INTEGER , INTENT(OUT) :: actual_io_mode + INTEGER , INTENT(OUT) :: hdferr +!***** + INTERFACE + INTEGER FUNCTION h5pget_mpio_actual_io_mode_c(dxpl_id, actual_io_mode) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5PGET_MPIO_ACTUAL_IO_MODE_C'::h5pget_mpio_actual_io_mode_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: dxpl_id + INTEGER , INTENT(OUT) :: actual_io_mode + END FUNCTION h5pget_mpio_actual_io_mode_c + END INTERFACE + + actual_io_mode = -1 + + hdferr = h5pget_mpio_actual_io_mode_c(dxpl_id, actual_io_mode) + + END SUBROUTINE h5pget_mpio_actual_io_mode_f + END MODULE H5FDMPIO diff --git a/fortran/src/H5Rf.c b/fortran/src/H5Rf.c index 0c3e5a7..d9f4231 100644 --- a/fortran/src/H5Rf.c +++ b/fortran/src/H5Rf.c @@ -331,6 +331,47 @@ done: return ret_value; } /* end nh5rget_region_region_c() */ +/****if* H5Rf/h5rget_region_ptr_c + * NAME + * h5rget_region_ptr_c + * PURPOSE + * Call H5Rget_region to dereference dataspace region + * INPUTS + * dset_id - dataset identifier + * ref - reference to the dataset region + * OUTPUTS + * space_id - dereferenced dataset dataspace identifier + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * August 4, 2012 + * HISTORY + * + * SOURCE +*/ +int_f +nh5rget_region_ptr_c(hid_t_f *dset_id, void *ref, hid_t_f *space_id) +/******/ +{ + hid_t c_space_id; + hdset_reg_ref_t ref_c; + int_f ret_value = 0; + + /* + * Call H5Rget_region function. + */ + if((c_space_id = H5Rget_region((hid_t)*dset_id, H5R_DATASET_REGION, ref)) < 0) + HGOTO_DONE(FAIL) + + /* Copy the dataspace ID */ + *space_id = (hid_t_f)c_space_id; + +done: + return ret_value; +} /* end nh5rget_region_ptr_c() */ + + /****if* H5Rf/h5rget_object_type_obj_c * NAME * h5rget_object_type_obj_c diff --git a/fortran/src/H5Rff.f90 b/fortran/src/H5Rff.f90 index 35a3ed6..89ffc10 100644 --- a/fortran/src/H5Rff.f90 +++ b/fortran/src/H5Rff.f90 @@ -53,12 +53,6 @@ MODULE H5R ! END TYPE ! - INTERFACE h5rget_region_f - - MODULE PROCEDURE h5rget_region_region_f - - END INTERFACE - INTERFACE h5rget_object_type_f MODULE PROCEDURE h5rget_object_type_obj_f @@ -67,61 +61,6 @@ MODULE H5R CONTAINS -!****s* H5R/h5rget_region_region_f -! -! NAME -! h5rget_region_region_f -! -! PURPOSE -! Retrieves a dataspace with the specified region selected -! -! INPUTS -! dset_id - identifier of the dataset containing -! reference to the regions -! ref - reference to open -! OUTPUTS -! space_id - dataspace identifier -! hdferr - Returns 0 if successful and -1 if fails -! AUTHOR -! Elena Pourmal -! August 12, 1999 -! -! HISTORY -! Explicit Fortran interfaces were added for -! called C functions (it is needed for Windows -! port). February 28, 2001 -! -! NOTES -! This is a module procedure for the h5rget_region_f subroutine. -! -! SOURCE - SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr) - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier - TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference - INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier - INTEGER, INTENT(OUT) :: hdferr ! Error code -!***** - INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference - - INTERFACE - INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id) - USE H5GLOBAL - !DEC$IF DEFINED(HDF5F90_WINDOWS) - !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c - !DEC$ENDIF - INTEGER(HID_T), INTENT(IN) :: dset_id - ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 - INTEGER :: ref_f(REF_REG_BUF_LEN) - INTEGER(HID_T), INTENT(OUT) :: space_id - END FUNCTION h5rget_region_region_c - END INTERFACE - - ref_f = ref%ref - hdferr = h5rget_region_region_c(dset_id, ref_f, space_id ) - - END SUBROUTINE h5rget_region_region_f - !****s* H5R/h5rget_object_type_obj_f ! ! NAME diff --git a/fortran/src/H5Rff_F03.f90 b/fortran/src/H5Rff_F03.f90 index 7f66745..88ec8cf 100644 --- a/fortran/src/H5Rff_F03.f90 +++ b/fortran/src/H5Rff_F03.f90 @@ -37,6 +37,7 @@ !***** MODULE H5R_PROVISIONAL USE H5GLOBAL + USE, INTRINSIC :: ISO_C_BINDING ! If you change the value of these parameters, do not forget to change corresponding ! values in the H5f90.h file. @@ -51,6 +52,19 @@ MODULE H5R_PROVISIONAL ! INTEGER ref(REF_REG_BUF_LEN) ! END TYPE ! + + TYPE :: hdset_reg_ref_t_f03 + INTEGER(C_SIGNED_CHAR), DIMENSION(1:H5R_DSET_REG_REF_BUF_SIZE_F) :: ref + END TYPE hdset_reg_ref_t_f03 + + INTERFACE h5rget_region_f + + MODULE PROCEDURE h5rget_region_region_f ! obsolete + MODULE PROCEDURE h5rget_region_ptr_f ! F2003 + + END INTERFACE + + INTERFACE h5rcreate_f MODULE PROCEDURE h5rcreate_object_f ! obsolete @@ -123,8 +137,114 @@ MODULE H5R_PROVISIONAL END FUNCTION h5rcreate_ptr_c END INTERFACE + INTERFACE + INTEGER FUNCTION h5rget_region_ptr_c(dset_id, ref, space_id) + USE, INTRINSIC :: ISO_C_BINDING + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_PTR_C':: h5rget_region_ptr_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: dset_id + TYPE(C_PTR), VALUE :: ref + INTEGER(HID_T), INTENT(OUT) :: space_id + END FUNCTION h5rget_region_ptr_c + END INTERFACE + CONTAINS +!****s* H5R/h5rget_region_region_f +! +! NAME +! h5rget_region_region_f +! +! PURPOSE +! Retrieves a dataspace with the specified region selected +! +! INPUTS +! dset_id - identifier of the dataset containing +! reference to the regions +! ref - reference to open +! OUTPUTS +! space_id - dataspace identifier +! hdferr - Returns 0 if successful and -1 if fails +! AUTHOR +! Elena Pourmal +! August 12, 1999 +! +! HISTORY +! Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). February 28, 2001 +! +! NOTES +! This is a module procedure for the h5rget_region_f subroutine. +! +! SOURCE + SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference + INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code +!***** + INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference + + INTERFACE + INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: dset_id + ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 + INTEGER :: ref_f(REF_REG_BUF_LEN) + INTEGER(HID_T), INTENT(OUT) :: space_id + END FUNCTION h5rget_region_region_c + END INTERFACE + + ref_f = ref%ref + hdferr = h5rget_region_region_c(dset_id, ref_f, space_id ) + + END SUBROUTINE h5rget_region_region_f + +!****s* H5R/h5rget_region_ptr_f +! +! NAME +! h5rget_region_ptr_f +! +! PURPOSE +! Retrieves a dataspace with the specified region +! selected using pointer +! +! INPUTS +! dset_id - identifier of the dataset containing +! reference to the regions +! ref - reference to open +! OUTPUTS +! space_id - dataspace identifier +! hdferr - Returns 0 if successful and -1 if fails +! AUTHOR +! M. Scot Breitenfeld +! August 4, 2012 +! +! NOTES +! This is a module procedure for the h5rget_region_f subroutine. +! +! SOURCE + SUBROUTINE h5rget_region_ptr_f(dset_id, ref, space_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + TYPE(C_PTR), INTENT(IN) :: ref ! Dataset region reference + INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code +!***** + INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference + + hdferr = h5rget_region_ptr_c(dset_id, ref, space_id ) + + END SUBROUTINE h5rget_region_ptr_f + + !****s* H5R (F03)/h5rcreate_object_f ! ! NAME @@ -175,7 +295,7 @@ CONTAINS END SUBROUTINE h5rcreate_object_f -!****s* H5R (F03)/h5rcreate_region_f +!****s* H5R (F90)/h5rcreate_region_f ! ! NAME ! h5rcreate_region_f @@ -183,16 +303,15 @@ CONTAINS ! PURPOSE ! Creates reference to the dataset region ! -! Inputs: +! INPUTS ! loc_id - location identifier ! name - name of the dataset at the specified location ! space_id - dataspace identifier that describes selected region -! Outputs: +! OUTPUTS ! ref - reference to the dataset region ! hdferr: - error code ! Success: 0 ! Failure: -1 -! ! AUTHOR ! Elena Pourmal ! August 12, 1999 @@ -205,46 +324,39 @@ CONTAINS ! NOTES ! This is a module procedure for the h5rcreate_f subroutine. ! -! Signature: +! SOURCE SUBROUTINE h5rcreate_region_f(loc_id, name, space_id, ref, hdferr) - USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id ! Location identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the dataset at location specified ! by loc_id identifier INTEGER(HID_T), INTENT(IN) :: space_id ! Dataset's dataspace identifier - TYPE(hdset_reg_ref_t_f), INTENT(INOUT), TARGET :: ref ! Dataset region reference + TYPE(hdset_reg_ref_t_f), INTENT(OUT) :: ref ! Dataset region reference INTEGER, INTENT(OUT) :: hdferr ! Error code !***** INTEGER :: namelen ! Name length INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference - TYPE(C_PTR) :: f_ptr - -! !$ INTERFACE -! !$ INTEGER FUNCTION h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id) -! !$ USE H5GLOBAL -! !$ !DEC$IF DEFINED(HDF5F90_WINDOWS) -! !$ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RCREATE_REGION_C':: h5rcreate_region_c -! !$ !DEC$ENDIF -! !$ !DEC$ATTRIBUTES reference :: name -! !$ ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 -! !$ INTEGER :: ref_f(REF_REG_BUF_LEN) -! !$ INTEGER(HID_T), INTENT(IN) :: loc_id -! !$ CHARACTER(LEN=*), INTENT(IN) :: name -! !$ INTEGER :: namelen -! !$ INTEGER(HID_T), INTENT(IN) :: space_id -! !$ END FUNCTION h5rcreate_region_c -! !$ END INTERFACE - - f_ptr = C_LOC(ref) + INTERFACE + INTEGER FUNCTION h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RCREATE_REGION_C':: h5rcreate_region_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: name + ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 + INTEGER :: ref_f(REF_REG_BUF_LEN) + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER :: namelen + INTEGER(HID_T), INTENT(IN) :: space_id + END FUNCTION h5rcreate_region_c + END INTERFACE namelen = LEN(name) - hdferr = h5rcreate_ptr_c(f_ptr, loc_id, name, namelen, 1, space_id) - -! !$ ref_f = 0 -! !$ hdferr = h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id ) -! !$ ref%ref = ref_f + ref_f = 0 + hdferr = h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id ) + ref%ref = ref_f END SUBROUTINE h5rcreate_region_f diff --git a/fortran/src/H5Rff_F90.f90 b/fortran/src/H5Rff_F90.f90 index 3f02825..0190e57 100644 --- a/fortran/src/H5Rff_F90.f90 +++ b/fortran/src/H5Rff_F90.f90 @@ -72,8 +72,73 @@ MODULE H5R_PROVISIONAL END INTERFACE + INTERFACE h5rget_region_f + + MODULE PROCEDURE h5rget_region_region_f + + END INTERFACE + + CONTAINS + +!****s* H5R/h5rget_region_region_f +! +! NAME +! h5rget_region_region_f +! +! PURPOSE +! Retrieves a dataspace with the specified region selected +! +! INPUTS +! dset_id - identifier of the dataset containing +! reference to the regions +! ref - reference to open +! OUTPUTS +! space_id - dataspace identifier +! hdferr - Returns 0 if successful and -1 if fails +! AUTHOR +! Elena Pourmal +! August 12, 1999 +! +! HISTORY +! Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). February 28, 2001 +! +! NOTES +! This is a module procedure for the h5rget_region_f subroutine. +! +! SOURCE + SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference + INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code +!***** + INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference + + INTERFACE + INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: dset_id + ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 + INTEGER :: ref_f(REF_REG_BUF_LEN) + INTEGER(HID_T), INTENT(OUT) :: space_id + END FUNCTION h5rget_region_region_c + END INTERFACE + + ref_f = ref%ref + hdferr = h5rget_region_region_c(dset_id, ref_f, space_id ) + + END SUBROUTINE h5rget_region_region_f + + + !****s* H5R (F90)/h5rcreate_object_f ! ! NAME diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index 05b7da0..7b55384 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -330,20 +330,21 @@ nh5close_types_c( hid_t_f * types, int_f *lentypes, * PURPOSE * Initialize Fortran flags * INPUTS - * h5d_flags - H5D inteface flags - * h5e_flags - H5E inteface flags - * h5e_hid_flags - H5E inteface flags of type hid_t - * h5f_flags - H5F interface flags - * h5fd_flags - H5FD interface flags - * h5fd_hid_flags - H5FD interface flags of type hid_t - * h5g_flags - H5G interface flags - * h5i_flags - H5I interface flags - * h5p_flags - H5P interface flags - * h5p_flags_int - H5P interface flags of type integer - * h5r_flags - H5R interface flags - * h5s_flags - H5S interface flags - * h5t_flags - H5T interface flags - * h5z_flags - H5Z interface flags + * h5d_flags - H5D inteface flags + * h5e_flags - H5E inteface flags + * h5e_hid_flags - H5E inteface flags of type hid_t + * h5f_flags - H5F interface flags + * h5fd_flags - H5FD interface flags + * h5fd_hid_flags - H5FD interface flags of type hid_t + * h5g_flags - H5G interface flags + * h5i_flags - H5I interface flags + * h5p_flags - H5P interface flags + * h5p_flags_int - H5P interface flags of type integer + * h5r_flags - H5R interface flags + * h5s_flags - H5S interface flags + * h5s_hsize_flags - H5S interface flags of type hsize_t + * h5t_flags - H5T interface flags + * h5z_flags - H5Z interface flags * OUTPUTS * None * RETURNS @@ -368,7 +369,7 @@ nh5init_flags_c( int_f *h5d_flags, int_f *h5e_flags, hid_t_f *h5e_hid_flags, int int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, int_f *h5g_flags, int_f *h5i_flags, int_f *h5l_flags, int_f *h5o_flags, hid_t_f *h5p_flags, int_f *h5p_flags_int, int_f *h5r_flags, int_f *h5s_flags, - int_f *h5t_flags, int_f *h5z_flags, int_f *h5_generic_flags) + hsize_t_f *h5s_hsize_flags, int_f *h5t_flags, int_f *h5z_flags, int_f *h5_generic_flags) /******/ { int ret_value = -1; @@ -579,31 +580,29 @@ nh5init_flags_c( int_f *h5d_flags, int_f *h5e_flags, hid_t_f *h5e_hid_flags, int /* * H5S flags */ - - h5s_flags[0] = (int_f)H5S_SCALAR; h5s_flags[1] = (int_f)H5S_SIMPLE; h5s_flags[2] = (int_f)H5S_NULL; h5s_flags[3] = (int_f)H5S_SELECT_SET; h5s_flags[4] = (int_f)H5S_SELECT_OR; - h5s_flags[5] = (int_f)H5S_UNLIMITED; - h5s_flags[6] = (int_f)H5S_ALL; - - h5s_flags[7] = (int_f)H5S_SELECT_NOOP; - h5s_flags[8] = (int_f)H5S_SELECT_AND; - h5s_flags[9] = (int_f)H5S_SELECT_XOR; - h5s_flags[10] = (int_f)H5S_SELECT_NOTB; - h5s_flags[11] = (int_f)H5S_SELECT_NOTA; - h5s_flags[12] = (int_f)H5S_SELECT_APPEND; - h5s_flags[13] = (int_f)H5S_SELECT_PREPEND; - h5s_flags[14] = (int_f)H5S_SELECT_INVALID; - - - h5s_flags[15] = (int_f)H5S_SEL_ERROR; - h5s_flags[16] = (int_f)H5S_SEL_NONE; - h5s_flags[17] = (int_f)H5S_SEL_POINTS; - h5s_flags[18] = (int_f)H5S_SEL_HYPERSLABS; - h5s_flags[19] = (int_f)H5S_SEL_ALL; + h5s_flags[5] = (int_f)H5S_ALL; + + h5s_flags[6] = (int_f)H5S_SELECT_NOOP; + h5s_flags[7] = (int_f)H5S_SELECT_AND; + h5s_flags[8] = (int_f)H5S_SELECT_XOR; + h5s_flags[9] = (int_f)H5S_SELECT_NOTB; + h5s_flags[10] = (int_f)H5S_SELECT_NOTA; + h5s_flags[11] = (int_f)H5S_SELECT_APPEND; + h5s_flags[12] = (int_f)H5S_SELECT_PREPEND; + h5s_flags[13] = (int_f)H5S_SELECT_INVALID; + + h5s_flags[14] = (int_f)H5S_SEL_ERROR; + h5s_flags[15] = (int_f)H5S_SEL_NONE; + h5s_flags[16] = (int_f)H5S_SEL_POINTS; + h5s_flags[17] = (int_f)H5S_SEL_HYPERSLABS; + h5s_flags[18] = (int_f)H5S_SEL_ALL; + + h5s_hsize_flags[0] = (hsize_t_f)H5S_UNLIMITED; /* * H5T flags diff --git a/fortran/src/H5_ff.f90 b/fortran/src/H5_ff.f90 index 57c1afd..4000ba1 100644 --- a/fortran/src/H5_ff.f90 +++ b/fortran/src/H5_ff.f90 @@ -100,6 +100,7 @@ CONTAINS i_H5P_flags_int, & i_H5R_flags, & i_H5S_flags, & + i_H5S_hsize_flags, & i_H5T_flags, & i_H5Z_flags, & i_H5generic_flags) @@ -118,6 +119,7 @@ CONTAINS INTEGER i_H5P_flags_int(H5P_FLAGS_INT_LEN) INTEGER i_H5R_flags(H5R_FLAGS_LEN) INTEGER i_H5S_flags(H5S_FLAGS_LEN) + INTEGER(HSIZE_T) i_H5S_hsize_flags(H5S_HSIZE_FLAGS_LEN) INTEGER i_H5T_flags(H5T_FLAGS_LEN) INTEGER i_H5Z_flags(H5Z_FLAGS_LEN) INTEGER i_H5generic_flags(H5generic_FLAGS_LEN) @@ -150,6 +152,7 @@ CONTAINS H5P_flags_int, & H5R_flags, & H5S_flags, & + H5S_hsize_flags, & H5T_flags, & H5Z_flags, & H5generic_flags) diff --git a/fortran/src/H5f90global.f90 b/fortran/src/H5f90global.f90 index da7a736..3d4f7f8 100644 --- a/fortran/src/H5f90global.f90 +++ b/fortran/src/H5f90global.f90 @@ -105,8 +105,13 @@ MODULE H5GLOBAL H5T_STD_U8LE, & H5T_STD_U16BE, & H5T_STD_U16LE, & - H5T_STD_U32BE, & - H5T_STD_U32LE, & + H5T_STD_U32BE + +! NOTE: Splitting the line since the Fortran 95 standard limits the number of +! continuation lines to 39; the F03/F08 standard limits the number +! to 255 lines. + + INTEGER(HID_T) H5T_STD_U32LE, & H5T_STD_U64BE, & H5T_STD_U64LE, & H5T_STRING, & @@ -685,18 +690,23 @@ MODULE H5GLOBAL ! ! H5S flags declaration ! - INTEGER, PARAMETER :: H5S_FLAGS_LEN = 20 + INTEGER, PARAMETER :: H5S_FLAGS_LEN = 19 INTEGER H5S_flags(H5S_FLAGS_LEN) + INTEGER, PARAMETER :: H5S_HSIZE_FLAGS_LEN = 1 + INTEGER(HSIZE_T) H5S_hsize_flags(H5S_HSIZE_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) !DEC$ATTRIBUTES DLLEXPORT :: /H5S_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: /H5S_HSIZE_FLAGS/ !DEC$endif COMMON /H5S_FLAGS/ H5S_flags + COMMON /H5S_HSIZE_FLAGS/ H5S_hsize_flags + + INTEGER(HSIZE_T) :: H5S_UNLIMITED_F INTEGER :: H5S_SCALAR_F INTEGER :: H5S_SIMPLE_F INTEGER :: H5S_NULL_F - INTEGER :: H5S_UNLIMITED_F INTEGER :: H5S_ALL_F INTEGER :: H5S_SELECT_NOOP_F @@ -710,36 +720,36 @@ MODULE H5GLOBAL INTEGER :: H5S_SELECT_PREPEND_F INTEGER :: H5S_SELECT_INVALID_F - INTEGER :: H5S_SEL_ERROR_F INTEGER :: H5S_SEL_NONE_F INTEGER :: H5S_SEL_POINTS_F INTEGER :: H5S_SEL_HYPERSLABS_F INTEGER :: H5S_SEL_ALL_F + EQUIVALENCE(H5S_hsize_flags(1), H5S_UNLIMITED_F) EQUIVALENCE(H5S_flags(1), H5S_SCALAR_F) EQUIVALENCE(H5S_flags(2), H5S_SIMPLE_F) EQUIVALENCE(H5S_flags(3), H5S_NULL_F) EQUIVALENCE(H5S_flags(4), H5S_SELECT_SET_F) EQUIVALENCE(H5S_flags(5), H5S_SELECT_OR_F) - EQUIVALENCE(H5S_flags(6), H5S_UNLIMITED_F) - EQUIVALENCE(H5S_flags(7), H5S_ALL_F) - - EQUIVALENCE(H5S_flags(8), H5S_SELECT_NOOP_F) - EQUIVALENCE(H5S_flags(9), H5S_SELECT_AND_F) - EQUIVALENCE(H5S_flags(10), H5S_SELECT_XOR_F) - EQUIVALENCE(H5S_flags(11), H5S_SELECT_NOTB_F) - EQUIVALENCE(H5S_flags(12), H5S_SELECT_NOTA_F) - EQUIVALENCE(H5S_flags(13), H5S_SELECT_APPEND_F) - EQUIVALENCE(H5S_flags(14), H5S_SELECT_PREPEND_F) - EQUIVALENCE(H5S_flags(15), H5S_SELECT_INVALID_F) - - - EQUIVALENCE(H5S_flags(16), H5S_SEL_ERROR_F) - EQUIVALENCE(H5S_flags(17), H5S_SEL_NONE_F) - EQUIVALENCE(H5S_flags(18), H5S_SEL_POINTS_F) - EQUIVALENCE(H5S_flags(19), H5S_SEL_HYPERSLABS_F) - EQUIVALENCE(H5S_flags(20), H5S_SEL_ALL_F) + EQUIVALENCE(H5S_flags(6), H5S_ALL_F) + + EQUIVALENCE(H5S_flags(7), H5S_SELECT_NOOP_F) + EQUIVALENCE(H5S_flags(8), H5S_SELECT_AND_F) + EQUIVALENCE(H5S_flags(9), H5S_SELECT_XOR_F) + EQUIVALENCE(H5S_flags(10), H5S_SELECT_NOTB_F) + EQUIVALENCE(H5S_flags(11), H5S_SELECT_NOTA_F) + EQUIVALENCE(H5S_flags(12), H5S_SELECT_APPEND_F) + EQUIVALENCE(H5S_flags(13), H5S_SELECT_PREPEND_F) + EQUIVALENCE(H5S_flags(14), H5S_SELECT_INVALID_F) + + + EQUIVALENCE(H5S_flags(15), H5S_SEL_ERROR_F) + EQUIVALENCE(H5S_flags(16), H5S_SEL_NONE_F) + EQUIVALENCE(H5S_flags(17), H5S_SEL_POINTS_F) + EQUIVALENCE(H5S_flags(18), H5S_SEL_HYPERSLABS_F) + EQUIVALENCE(H5S_flags(19), H5S_SEL_ALL_F) + ! ! H5T flags declaration ! diff --git a/fortran/src/H5f90kit.c b/fortran/src/H5f90kit.c index 059685e..0bc721f 100644 --- a/fortran/src/H5f90kit.c +++ b/fortran/src/H5f90kit.c @@ -53,7 +53,7 @@ HD5f2cstring(_fcd fdesc, size_t len) /* Search for the end of the string */ str = _fcdtocp(fdesc); - for(i = (int)len - 1; i >= 0 && !HDisgraph((int)str[i]); i--) + for(i = (int)len - 1; i >= 0 && HDisspace((int)str[i]) && str[i] == ' '; i--) /*EMPTY*/; /* Allocate C string */ diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index a504653..b1e650a 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -806,11 +806,21 @@ H5_FCDLL int_f nh5tconvert_c(hid_t_f *src_id, hid_t_f *dst_id, size_t_f *nelmts, #define nh5olink_c H5_FC_FUNC_(h5olink_c, H5OLINK_C) #define nh5oopen_c H5_FC_FUNC_(h5oopen_c, H5OOPEN_C) #define nh5oclose_c H5_FC_FUNC_(h5oclose_c, H5OCLOSE_C) -#define nh5ovisit_c H5_FC_FUNC_(h5ovisit_c,H5OVISIT_C) +#define nh5ovisit_c H5_FC_FUNC_(h5ovisit_c, H5OVISIT_C) +#define nh5ovisit_by_name_c H5_FC_FUNC_(h5ovisit_by_name_c, H5OVISIT_BY_NAME_C) +#define nh5oget_info_c H5_FC_FUNC_(h5oget_info_c, H5OGET_INFO_C) +#define nh5oget_info_by_idx_c H5_FC_FUNC_(h5oget_info_by_idx_c ,H5OGET_INFO_BY_IDX_C) #define nh5oget_info_by_name_c H5_FC_FUNC_(h5oget_info_by_name_c ,H5OGET_INFO_BY_NAME_C) #define nh5oopen_by_addr_c H5_FC_FUNC_(h5oopen_by_addr_c, H5OOPEN_BY_ADDR_C) #define nh5ocopy_c H5_FC_FUNC_(h5ocopy_c, H5OCOPY_C) - +#define nh5odecr_refcount_c H5_FC_FUNC_(h5odecr_refcount_c, H5ODECR_REFCOUNT_C) +#define nh5oincr_refcount_c H5_FC_FUNC_(h5oincr_refcount_c, H5OINCR_REFCOUNT_C) +#define nh5oexists_by_name_c H5_FC_FUNC_(h5oexists_by_name_c, H5OEXISTS_BY_NAME_C) +#define nh5oset_comment_c H5_FC_FUNC_(h5oset_comment_c, H5OSET_COMMENT_C) +#define nh5oset_comment_by_name_c H5_FC_FUNC_(h5oset_comment_by_name_c, H5OSET_COMMENT_BY_NAME_C) +#define nh5oopen_by_idx_c H5_FC_FUNC_(h5oopen_by_idx_c, H5OOPEN_BY_IDX_C) +#define nh5oget_comment_c H5_FC_FUNC_(h5oget_comment_c, H5OGET_COMMENT_C) +#define nh5oget_comment_by_name_c H5_FC_FUNC_(h5oget_comment_by_name_c, H5OGET_COMMENT_BY_NAME_C) H5_FCDLL int_f nh5oopen_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *obj_id); H5_FCDLL int_f nh5oclose_c (hid_t_f *object_id ); @@ -818,11 +828,26 @@ H5_FCDLL int_f nh5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *ob H5_FCDLL int_f nh5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, size_t_f *namelen, hid_t_f *lcpl_id, hid_t_f *lapl_id); H5_FCDLL int_f nh5ovisit_c (hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data); -H5_FCDLL int_f nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen,hid_t_f *lapl_id, +H5_FCDLL int_f nh5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f *index_type, int_f *order, + H5O_iterate_t op, void *op_data, hid_t_f *lapl_id ); +H5_FCDLL int_f nh5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info); +H5_FCDLL int_f nh5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, + int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info); +H5_FCDLL int_f nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, H5O_info_t_f *object_info); H5_FCDLL int_f nh5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, hid_t_f *ocpypl_id, hid_t_f *lcpl_id ); +H5_FCDLL int_f nh5odecr_refcount_c (hid_t_f *object_id); +H5_FCDLL int_f nh5oincr_refcount_c (hid_t_f *object_id); +H5_FCDLL int_f nh5oexists_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id); +H5_FCDLL int_f nh5oset_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentlen); +H5_FCDLL int_f nh5oset_comment_by_name_c (hid_t_f *object_id, _fcd name, size_t_f *namelen, _fcd comment, size_t_f *commentlen, hid_t_f *lapl_id); +H5_FCDLL int_f nh5oopen_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id); +H5_FCDLL int_f nh5oget_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentsize, hssize_t_f *bufsize); +H5_FCDLL int_f nh5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size, + _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id); /* * Functions from H5Pf.c */ @@ -982,6 +1007,7 @@ H5_FCDLL int_f nh5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_nam #define nh5pget_nlinks_c H5_FC_FUNC_(h5pget_nlinks_c, H5PGET_NLINKS_C) #define nh5pset_chunk_cache_c H5_FC_FUNC_(h5pset_chunk_cache_c, H5PSET_CHUNK_CACHE_C) #define nh5pget_chunk_cache_c H5_FC_FUNC_(h5pget_chunk_cache_c, H5PGET_CHUNK_CACHE_C) +#define nh5pget_mpio_actual_io_mode_c H5_FC_FUNC_(h5pget_mpio_actual_io_mode_c, H5PGET_MPIO_ACTUAL_IO_MODE_C) H5_FCDLL int_f nh5pcreate_c ( hid_t_f *cls, hid_t_f *prp_id ); H5_FCDLL int_f nh5pclose_c ( hid_t_f *prp_id ); @@ -1142,6 +1168,7 @@ H5_FCDLL int_f nh5pset_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks); H5_FCDLL int_f nh5pget_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks); H5_FCDLL int_f nh5pset_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, size_t_f *rdcc_nbytes, real_f *rdcc_w0); H5_FCDLL int_f nh5pget_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, size_t_f *rdcc_nbytes, real_f *rdcc_w0); +H5_FCDLL int_f nh5pget_mpio_actual_io_mode_c(hid_t_f *dxpl_id, int_f *actual_io_mode); /* * Functions frome H5Rf.c */ @@ -1152,6 +1179,7 @@ H5_FCDLL int_f nh5pget_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, si #define nh5rdereference_object_c H5_FC_FUNC_(h5rdereference_object_c, H5RDEREFERENCE_OBJECT_C) #define nh5rdereference_ptr_c H5_FC_FUNC_(h5rdereference_ptr_c, H5RDEREFERENCE_PTR_C) #define nh5rget_region_region_c H5_FC_FUNC_(h5rget_region_region_c, H5RGET_REGION_REGION_C) +#define nh5rget_region_ptr_c H5_FC_FUNC_(h5rget_region_ptr_c, H5RGET_REGION_PTR_C) #define nh5rget_object_type_obj_c H5_FC_FUNC_(h5rget_object_type_obj_c, H5RGET_OBJECT_TYPE_OBJ_C) #define nh5rget_name_object_c H5_FC_FUNC_(h5rget_name_object_c, H5RGET_NAME_OBJECT_C) #define nh5rget_name_region_c H5_FC_FUNC_(h5rget_name_region_c, H5RGET_NAME_REGION_C) @@ -1166,6 +1194,7 @@ H5_FCDLL int_f nh5rdereference_region_c (hid_t_f *dset_id, int_f *ref, hid_t_f * H5_FCDLL int_f nh5rdereference_object_c (hid_t_f *dset_id, haddr_t_f *ref, hid_t_f *obj_id); H5_FCDLL int_f nh5rdereference_ptr_c (hid_t_f *obj_id, int_f *ref_type, void *ref, hid_t_f *ref_obj_id); H5_FCDLL int_f nh5rget_region_region_c (hid_t_f *dset_id, int_f *ref, hid_t_f *space_id); +H5_FCDLL int_f nh5rget_region_ptr_c(hid_t_f *dset_id, void *ref, hid_t_f *space_id); H5_FCDLL int_f nh5rget_object_type_obj_c (hid_t_f *dset_id, haddr_t_f *ref, int_f *obj_type); H5_FCDLL int_f nh5rget_name_object_c (hid_t_f *loc_id, haddr_t_f *ref, _fcd name, size_t_f *name_len, size_t_f *size_default); H5_FCDLL int_f nh5rget_name_region_c (hid_t_f *loc_id, int_f *ref, _fcd name, size_t_f *name_len, size_t_f *size_default); @@ -1235,7 +1264,7 @@ H5_FCDLL int_f nh5init_flags_c(int_f *h5d_flags, int_f *h5e_flags, hid_t_f *h5e_ int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, int_f *h5g_flags, int_f *h5i_flags, int_f *h5l_flags, int_f *h5o_flags, hid_t_f *h5p_flags, int_f *h5p_flags_int, int_f *h5r_flags, int_f *h5s_flags, - int_f *h5t_flags, int_f *h5z_flags, int_f *h5_generic_flags); + hsize_t_f *h5s_hsize_flags, int_f *h5t_flags, int_f *h5z_flags, int_f *h5_generic_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); H5_FCDLL int_f nh5check_version_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 61504ec..4c83d21 100644 --- a/fortran/src/H5match_types.c +++ b/fortran/src/H5match_types.c @@ -533,7 +533,21 @@ int main(void) /* double_f */ #if defined H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND - writeFloatToFiles("Fortran_DOUBLE", "double_f", 16, H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND); + if(H5_C_HAS_REAL_NATIVE_16 != 0) { /* Check if C has 16 byte floats */ + writeFloatToFiles("Fortran_DOUBLE", "double_f", 16, H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND); + } else { +#if defined H5_FORTRAN_HAS_REAL_NATIVE_8_KIND /* Fall back to 8 byte floats */ + writeFloatToFiles("Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_REAL_NATIVE_8_KIND); + } +#elif defined H5_FORTRAN_HAS_REAL_NATIVE_4_KIND /* Fall back to 4 byte floats */ + writeFloatToFiles("Fortran_DOUBLE", "double_f", 4, H5_FORTRAN_HAS_REAL_NATIVE_4_KIND); + } +#else + /* Error: couldn't find a size for double_f when fortran has 16 byte reals */ + return -1; + } +#endif + #elif defined H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND writeFloatToFiles("Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND); #else @@ -541,6 +555,14 @@ int main(void) return -1; #endif + /* Need the buffer size for the fortran derive type 'hdset_reg_ref_t_f03' + * in order to be interoperable with C's structure, the C buffer size + * H5R_DSET_REG_REF_BUF_SIZE is (sizeof(haddr_t)+4) + */ + + fprintf(fort_header, " INTEGER, PARAMETER :: H5R_DSET_REG_REF_BUF_SIZE_F = %u\n", H5_SIZEOF_HADDR_T + 4 ); + + /* Close files */ endCfile(); endFfile(); diff --git a/fortran/src/h5fc.in b/fortran/src/h5fc.in index 2d7b5b4..4985650 100644 --- a/fortran/src/h5fc.in +++ b/fortran/src/h5fc.in @@ -98,6 +98,10 @@ FFLAGS="${HDF5_FFLAGS:-$FFLAGSBASE}" LDFLAGS="${HDF5_LDFLAGS:-$LDFLAGSBASE}" LIBS="${HDF5_LIBS:-$LIBSBASE}" +# If static was disabled, @HDF5_USE_SHLIB@ will be yes. In that case +# HDF5_USE_SHLIB should be set to yes because there are no static +# lib files. +HDF5_USE_SHLIB="@HDF5_USE_SHLIB@" USE_SHARED_LIB="${HDF5_USE_SHLIB:-no}" usage() { diff --git a/fortran/src/hdf5_fortrandll.def b/fortran/src/hdf5_fortrandll.def index 29e83f5..735189a 100644 --- a/fortran/src/hdf5_fortrandll.def +++ b/fortran/src/hdf5_fortrandll.def @@ -429,7 +429,9 @@ H5R_PROVISIONAL_mp_H5RCREATE_OBJECT_F H5R_PROVISIONAL_mp_H5RCREATE_REGION_F H5R_PROVISIONAL_mp_H5RDEREFERENCE_OBJECT_F H5R_PROVISIONAL_mp_H5RDEREFERENCE_REGION_F +H5R_PROVISIONAL_mp_H5RGET_REGION_PTR_F H5R_mp_H5RGET_REGION_REGION_F + H5R_mp_H5RGET_OBJECT_TYPE_OBJ_F H5R_PROVISIONAL_mp_H5RGET_NAME_OBJECT_F H5R_PROVISIONAL_mp_H5RGET_NAME_REGION_F diff --git a/fortran/src/phdf5_fortrandll.def b/fortran/src/phdf5_fortrandll.def index 7a196cd..c3342d3 100644 --- a/fortran/src/phdf5_fortrandll.def +++ b/fortran/src/phdf5_fortrandll.def @@ -528,4 +528,9 @@ H5Z_mp_H5ZFILTER_AVAIL_F H5Z_mp_H5ZGET_FILTER_INFO_F ; Parallel H5FDMPIO_mp_H5PSET_FAPL_MPIO_F +H5FDMPIO_mp_H5PGET_FAPL_MPIO_F H5FDMPIO_mp_H5PSET_DXPL_MPIO_F +H5FDMPIO_mp_H5PGET_DXPL_MPIO_F +H5FDMPIO_mp_H5PSET_FAPL_MPIPOSIX_F +H5FDMPIO_mp_H5PGET_FAPL_MPIPOSIX_F +H5FDMPIO_mp_H5PGET_MPIO_ACTUAL_IO_MODE_F \ No newline at end of file diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90 index 321cb99..d3ced72 100644 --- a/fortran/test/fortranlib_test_1_8.f90 +++ b/fortran/test/fortranlib_test_1_8.f90 @@ -94,12 +94,6 @@ PROGRAM fortranlibtest total_error) ret_total_error = 0 - CALL test_nbit(cleanup, ret_total_error ) - CALL write_test_status(ret_total_error, & - ' Testing nbit filter', & - total_error) - - ret_total_error = 0 CALL test_scaleoffset(cleanup, ret_total_error ) CALL write_test_status(ret_total_error, & ' Testing scaleoffset filter', & @@ -401,141 +395,6 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) END SUBROUTINE test_h5s_encode !------------------------------------------------------------------------- -! Function: test_nbit -! -! Purpose: Tests (real) datatype for nbit filter -! -! Return: Success: 0 -! Failure: >0 -! -! Programmer: M. Scot Breitenfeld -! Decemeber 7, 2010 -! -! Modifications: -! -!------------------------------------------------------------------------- -! - -SUBROUTINE test_nbit(cleanup, total_error ) - - USE HDF5 - - IMPLICIT NONE - INTEGER, PARAMETER :: wp = KIND(1.0) - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - INTEGER(hid_t) :: file - - INTEGER(hid_t) :: dataset, datatype, space, dc - INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/) - INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/) - ! orig_data[] are initialized to be within the range that can be represented by - ! dataset datatype (no precision loss during datatype conversion) - ! - REAL(kind=wp), DIMENSION(1:2,1:5) :: orig_data = RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, & - 5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) ) - REAL(kind=wp), DIMENSION(1:2,1:5) :: new_data - INTEGER(size_t) :: PRECISION, offset - INTEGER :: error - LOGICAL :: status - INTEGER*8 :: ii - INTEGER(size_t) :: i, j - - - ! check to see if filter is available - CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error) - IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter - total_error = -1 ! so return - RETURN - ENDIF - - CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error) - CALL check("H5Fcreate_f", error, total_error) - - ! Define dataset datatype (integer), and set precision, offset - CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error) - CALL CHECK(" H5Tcopy_f", error, total_error) - CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error) - CALL CHECK(" H5Tset_fields_f", error, total_error) - offset = 7 - CALL H5Tset_offset_f(datatype, offset, error) - CALL CHECK(" H5Tset_offset_f", error, total_error) - PRECISION = 20 - CALL H5Tset_precision_f(datatype,PRECISION, error) - CALL CHECK(" H5Tset_precision_f", error, total_error) - - CALL H5Tset_size_f(datatype, 4_size_t, error) - CALL CHECK(" H5Tset_size_f", error, total_error) - - CALL H5Tset_ebias_f(datatype, 31_size_t, error) - CALL CHECK(" H5Tset_ebias_f", error, total_error) - - ! Create the data space - CALL H5Screate_simple_f(2, dims, space, error) - CALL CHECK(" H5Screate_simple_f", error, total_error) - - ! USE nbit filter - CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error) - CALL CHECK(" H5Pcreate_f", error, total_error) - - CALL H5Pset_chunk_f(dc, 2, chunk_dim, error) - CALL CHECK(" H5Pset_chunk_f", error, total_error) - CALL H5Pset_nbit_f(dc, error) - CALL CHECK(" H5Pset_nbit_f", error, total_error) - - ! Create the dataset - CALL H5Dcreate_f(file, "nbit_real", datatype, & - space, dataset, error, dc) - CALL CHECK(" H5Dcreate_f", error, total_error) - - !---------------------------------------------------------------------- - ! STEP 1: Test nbit by setting up a chunked dataset and writing - ! to it. - !---------------------------------------------------------------------- - ! - CALL H5Dwrite_f(dataset, H5T_NATIVE_REAL, orig_data, dims, error) - CALL CHECK(" H5Dwrite_f", error, total_error) - - !---------------------------------------------------------------------- - ! STEP 2: Try to read the data we just wrote. - !---------------------------------------------------------------------- - ! - CALL H5Dread_f(dataset, H5T_NATIVE_REAL, new_data, dims, error) - CALL CHECK(" H5Dread_f", error, total_error) - - ! Check that the values read are the same as the values written - ! Assume size of long long = size of double - ! - i_loop: DO i = 1, dims(1) - j_loop: DO j = 1, dims(2) - IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN - IF(new_data(i,j) .NE. orig_data(i,j))THEN - total_error = total_error + 1 - WRITE(*,'(" Read different values than written.")') - WRITE(*,'(" At index ", 2(1X,I0))') i, j - EXIT i_loop - END IF - ENDDO j_loop - ENDDO i_loop - - !---------------------------------------------------------------------- - ! Cleanup - !---------------------------------------------------------------------- - ! - CALL H5Tclose_f(datatype, error) - CALL CHECK(" H5Tclose_f", error, total_error) - CALL H5Pclose_f(dc, error) - CALL CHECK(" H5Pclose_f", error, total_error) - CALL H5Sclose_f(space, error) - CALL CHECK(" H5Sclose_f", error, total_error) - CALL H5Dclose_f(dataset, error) - CALL CHECK(" H5Dclose_f", error, total_error) - CALL H5Fclose_f(file, error) - CALL CHECK(" H5Fclose_f", error, total_error) - -END SUBROUTINE test_nbit - -!------------------------------------------------------------------------- ! Function: test_scaleoffset ! ! Purpose: Tests the integer datatype for scaleoffset filter diff --git a/fortran/test/fortranlib_test_F03.f90 b/fortran/test/fortranlib_test_F03.f90 index 8ebee82..bdc12d6 100644 --- a/fortran/test/fortranlib_test_F03.f90 +++ b/fortran/test/fortranlib_test_F03.f90 @@ -112,6 +112,10 @@ PROGRAM fortranlibtest_F03 CALL write_test_status(ret_total_error, ' Testing writing/reading string datatypes, using C_LOC', total_error) ret_total_error = 0 + CALL vl_test_special_char(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing string datatypes containing control characters', total_error) + + ret_total_error = 0 CALL test_create(ret_total_error) CALL write_test_status(ret_total_error, & ' Testing filling functions', & @@ -134,6 +138,11 @@ PROGRAM fortranlibtest_F03 ret_total_error = 0 CALL test_iter_group(ret_total_error) CALL write_test_status(ret_total_error, ' Testing Group Iteration Functionality', total_error) + + ret_total_error = 0 + CALL test_nbit(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing nbit filter', total_error) + ! write(*,*) ! write(*,*) '=========================================' diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90 index 03522f7..cecaded 100644 --- a/fortran/test/tH5A.f90 +++ b/fortran/test/tH5A.f90 @@ -100,7 +100,7 @@ CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back ! string attr data CHARACTER :: attr_character_data = 'A' - DOUBLE PRECISION, DIMENSION(1) :: attr_double_data = 3.459 + REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459 REAL, DIMENSION(1) :: attr_real_data = 4.0 INTEGER, DIMENSION(1) :: attr_integer_data = 5 INTEGER(HSIZE_T), DIMENSION(7) :: data_dims @@ -109,7 +109,7 @@ CHARACTER :: aread_character_data ! variable to put read back Character attr data INTEGER, DIMENSION(1) :: aread_integer_data ! variable to put read back integer attr data INTEGER, DIMENSION(1) :: aread_null_data = 7 ! variable to put read back null attr data - DOUBLE PRECISION, DIMENSION(1) :: aread_double_data ! variable to put read back double attr data + REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: aread_double_data ! variable to put read back double attr data REAL, DIMENSION(1) :: aread_real_data ! variable to put read back real attr data ! diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index 9605c45..b42a8e6 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -86,8 +86,8 @@ CHARACTER(LEN=2), DIMENSION(dimsize) :: char_member_out ! Buffer to read data out INTEGER, DIMENSION(dimsize) :: int_member INTEGER, DIMENSION(dimsize) :: int_member_out - DOUBLE PRECISION, DIMENSION(dimsize) :: double_member - DOUBLE PRECISION, DIMENSION(dimsize) :: double_member_out + REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member + REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member_out REAL, DIMENSION(dimsize) :: real_member REAL, DIMENSION(dimsize) :: real_member_out INTEGER :: i diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90 index 215ac9e..dbd8b0a 100644 --- a/fortran/test/tH5T_F03.f90 +++ b/fortran/test/tH5T_F03.f90 @@ -103,7 +103,7 @@ SUBROUTINE test_array_compound_atomic(total_error) ! Create file CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid1,error) - CALL check("h5fcreate_f", error, total_error) + CALL check("h5fcreate_f", error, total_error) ! Create dataspace for datasets CALL h5screate_simple_f(SPACE1_RANK, sdims1, sid1, error) @@ -1976,8 +1976,8 @@ SUBROUTINE t_regref(total_error) INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims INTEGER(hssize_t) :: npoints - TYPE(hdset_reg_ref_t_f), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer - TYPE(hdset_reg_ref_t_f), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer + TYPE(hdset_reg_ref_t_f03), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer + TYPE(hdset_reg_ref_t_f03), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer INTEGER(size_t) :: size CHARACTER(LEN=1), DIMENSION(1:ds2dim0,1:ds2dim1), TARGET :: wdata2 @@ -2058,7 +2058,6 @@ SUBROUTINE t_regref(total_error) CALL check("h5sclose_f",error, total_error) CALL h5fclose_f(file , error) CALL check("h5fclose_f",error, total_error) - ! ! Now we begin the read section of this example. ! @@ -2095,10 +2094,11 @@ SUBROUTINE t_regref(total_error) ! Open the referenced object, retrieve its region as a ! dataspace selection. ! - CALL H5Rdereference_f(dset, rdata(i), dset2, error) + f_ptr = C_LOC(rdata(i)) + CALL H5Rdereference_f(dset, H5R_DATASET_REGION_F, f_ptr, dset2, error) CALL check("H5Rdereference_f",error, total_error) - - CALL H5Rget_region_f(dset, rdata(i), space, error) + + CALL H5Rget_region_f(dset, f_ptr, space, error) CALL check("H5Rget_region_f",error, total_error) ! @@ -2754,7 +2754,7 @@ SUBROUTINE t_string(total_error) CALL check("H5Dget_type_f",error, total_error) CALL H5Tget_size_f(filetype, size, error) CALL check("H5Tget_size_f",error, total_error) - CALL VERIFY("H5Tget_size_f", size, sdim, total_error) + CALL VERIFY("H5Tget_size_f", INT(size), INT(sdim), total_error) ! ! Get dataspace. ! @@ -2800,4 +2800,291 @@ SUBROUTINE t_string(total_error) END SUBROUTINE t_string +SUBROUTINE vl_test_special_char(cleanup, total_error) + + USE hdf5 + IMPLICIT NONE + + INTERFACE + SUBROUTINE setup_buffer(data_in, line_lengths, char_type) + USE hdf5 + USE ISO_C_BINDING + IMPLICIT NONE + CHARACTER(len=*), DIMENSION(:) :: data_in + INTEGER(size_t), DIMENSION(:) :: line_lengths + CHARACTER(KIND=C_CHAR,LEN=*) :: char_type + END SUBROUTINE setup_buffer + END INTERFACE + + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=16), PARAMETER :: filename = "t_controlchar.h5" + INTEGER, PARAMETER :: line_length = 10 + INTEGER(hid_t) :: file + INTEGER(hid_t) :: dataset0 + CHARACTER(len=line_length), DIMENSION(1:100) :: data_in + CHARACTER(len=line_length), DIMENSION(1:100) :: data_out + INTEGER(size_t), DIMENSION(1:100) :: line_lengths + INTEGER(hid_t) :: string_id, space, dcpl + INTEGER(hsize_t), DIMENSION(1:1) :: dims = (/0/) + INTEGER(hsize_t), DIMENSION(1:1) :: max_dims = (/0/) + INTEGER(hsize_t), DIMENSION(1:2) :: data_dims = (/0,0/) + INTEGER(hsize_t), DIMENSION(1:1) :: chunk =(/10/) + INTEGER, PARAMETER :: ncontrolchar = 7 + CHARACTER(KIND=C_CHAR,LEN=1), DIMENSION(1:ncontrolchar) :: controlchar = & + (/C_ALERT, C_BACKSPACE,C_CARRIAGE_RETURN, C_FORM_FEED,C_HORIZONTAL_TAB,C_VERTICAL_TAB, C_NEW_LINE/) + INTEGER :: i, j, n, error + n = 8 + ! + ! Create a new file using the default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error) + CALL check("h5fcreate_f",error, total_error) + + max_dims = (/H5S_UNLIMITED_F/) + + ! + ! Create the memory datatype. + ! + CALL h5tcopy_f(h5t_string, string_id, error) + CALL check("h5tcopy_f", error, total_error) + CALL h5tset_strpad_f(string_id, h5t_str_nullpad_f, error) + CALL check("h5tset_strpad_f", error, total_error) + dims(1) = n + ! + ! Create dataspace. + ! + CALL h5screate_simple_f(1, dims, space, error, max_dims) + CALL check("h5screate_simple_f", error, total_error) + CALL h5pcreate_f(h5p_dataset_create_f, dcpl, error) + CALL check("h5pcreate_f", error, total_error) + CALL h5pset_chunk_f(dcpl, 1, chunk, error) + CALL check("h5pset_chunk_f", error, total_error) + + data_dims(1) = line_length + data_dims(2) = n + ! + ! Create data with strings containing various control characters. + ! + DO i = 1, ncontrolchar + ! + ! Create the dataset, for the string with control character and write the string data to it. + ! + CALL h5dcreate_f(file, controlchar(i), string_id, space, dataset0, error, dcpl) + CALL check("h5dcreate_f", error, total_error) + CALL setup_buffer(data_in(1:n), line_lengths, controlchar(i)) + CALL h5dwrite_vl_f(dataset0, string_id, data_in(1:n), data_dims, line_lengths(1:n), error, space) + CALL check("h5dwrite_vl_f", error, total_error) + ! + ! Read the string back. + ! + CALL h5dread_vl_f(dataset0, string_id, data_out(1:n), data_dims, line_lengths(1:n), error, space) + CALL check("h5dread_vl_f", error, total_error) + + DO j = 1, n + IF(data_in(j).NE.data_out(j))THEN + total_error = total_error + 1 + EXIT + ENDIF + ENDDO + + CALL h5dclose_f(dataset0, error) + CALL check("h5dclose_f", error, total_error) + ENDDO + + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f", error, total_error) + CALL h5sclose_f(space, error) + CALL check("h5sclose_f", error, total_error) + CALL h5fclose_f(file, error) + CALL check("h5fclose_f", error, total_error) + +END SUBROUTINE vl_test_special_char + + +SUBROUTINE setup_buffer(data_in, line_lengths, char_type) + + USE HDF5 + USE ISO_C_BINDING + + IMPLICIT NONE + + ! Creates a simple "Data_in" consisting of the letters of the alphabet, + ! one per line, with a control character. + + CHARACTER(len=10), DIMENSION(:) :: data_in + INTEGER(size_t), DIMENSION(:) :: line_lengths + INTEGER, DIMENSION(1:3) :: letters + CHARACTER(LEN=3) :: lets + CHARACTER(KIND=C_CHAR,LEN=*) :: char_type + INTEGER :: i, j, n, ff + + ! Convert the letters and special character to integers + lets = 'abc' + + READ(lets,'(3A1)') letters + READ(char_type,'(A1)') ff + n = SIZE(data_in) + j = 1 + DO i=1,n-1 + IF( j .EQ. 4 )THEN + WRITE(data_in(i:i),'(A1)') ff + ELSE + WRITE(data_in(i:i),'(A1)') letters(j) + ENDIF + line_lengths(i) = LEN_TRIM(data_in(i)) + j = j + 1 + IF( j .EQ. 5 ) j = 1 + END DO + WRITE(data_in(n:n),'(A1)') ff + line_lengths(n) = 1 + +END SUBROUTINE setup_buffer + +!------------------------------------------------------------------------- +! Function: test_nbit +! +! Purpose: Tests (real, 4 byte) datatype for nbit filter +! +! Return: Success: 0 +! Failure: >0 +! +! Programmer: M. Scot Breitenfeld +! Decemeber 7, 2010 +! +! Modifications: Moved this subroutine from the 1.8 test file and +! modified it to use F2003 features. +! This routine requires 4 byte reals, so we use F2003 features to +! ensure the requirement is satisfied in a portable way. +! The need for this arises when a user specifies the default real is 8 bytes. +! MSB 7/31/12 +! +!------------------------------------------------------------------------- +! + +SUBROUTINE test_nbit(cleanup, total_error ) + + USE HDF5 + USE ISO_C_BINDING + + IMPLICIT NONE + INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER(hid_t) :: file + + INTEGER(hid_t) :: dataset, datatype, space, dc, mem_type_id + INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/) + INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/) + ! orig_data[] are initialized to be within the range that can be represented by + ! dataset datatype (no precision loss during datatype conversion) + ! + REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: orig_data = & + RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, & + 5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) ) + REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: new_data + INTEGER(size_t) :: PRECISION, offset + INTEGER :: error + LOGICAL :: status + INTEGER(size_t) :: i, j + TYPE(C_PTR) :: f_ptr + + ! check to see if filter is available + CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error) + IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter + total_error = -1 ! so return + RETURN + ENDIF + + CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error) + CALL check("H5Fcreate_f", error, total_error) + + ! Define dataset datatype (integer), and set precision, offset + CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error) + CALL CHECK(" H5Tcopy_f", error, total_error) + CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error) + CALL CHECK(" H5Tset_fields_f", error, total_error) + offset = 7 + CALL H5Tset_offset_f(datatype, offset, error) + CALL CHECK(" H5Tset_offset_f", error, total_error) + PRECISION = 20 + CALL H5Tset_precision_f(datatype,PRECISION, error) + CALL CHECK(" H5Tset_precision_f", error, total_error) + + CALL H5Tset_size_f(datatype, 4_size_t, error) + CALL CHECK(" H5Tset_size_f", error, total_error) + + CALL H5Tset_ebias_f(datatype, 31_size_t, error) + CALL CHECK(" H5Tset_ebias_f", error, total_error) + + ! Create the data space + CALL H5Screate_simple_f(2, dims, space, error) + CALL CHECK(" H5Screate_simple_f", error, total_error) + + ! USE nbit filter + CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error) + CALL CHECK(" H5Pcreate_f", error, total_error) + + CALL H5Pset_chunk_f(dc, 2, chunk_dim, error) + CALL CHECK(" H5Pset_chunk_f", error, total_error) + CALL H5Pset_nbit_f(dc, error) + CALL CHECK(" H5Pset_nbit_f", error, total_error) + + ! Create the dataset + CALL H5Dcreate_f(file, "nbit_real", datatype, & + space, dataset, error, dc) + CALL CHECK(" H5Dcreate_f", error, total_error) + + !---------------------------------------------------------------------- + ! STEP 1: Test nbit by setting up a chunked dataset and writing + ! to it. + !---------------------------------------------------------------------- + ! + mem_type_id = h5kind_to_type(wp,H5_REAL_KIND) + + f_ptr = C_LOC(orig_data(1,1)) + CALL H5Dwrite_f(dataset, mem_type_id, f_ptr, error) + CALL CHECK(" H5Dwrite_f", error, total_error) + + !---------------------------------------------------------------------- + ! STEP 2: Try to read the data we just wrote. + !---------------------------------------------------------------------- + ! + f_ptr = C_LOC(new_data(1,1)) + CALL H5Dread_f(dataset, mem_type_id, f_ptr, error) + CALL CHECK(" H5Dread_f", error, total_error) + + ! Check that the values read are the same as the values written + ! Assume size of long long = size of double + ! + i_loop: DO i = 1, dims(1) + j_loop: DO j = 1, dims(2) + IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN + IF(new_data(i,j) .NE. orig_data(i,j))THEN + total_error = total_error + 1 + WRITE(*,'(" Read different values than written.")') + WRITE(*,'(" At index ", 2(1X,I0))') i, j + EXIT i_loop + END IF + ENDDO j_loop + ENDDO i_loop + + !---------------------------------------------------------------------- + ! Cleanup + !---------------------------------------------------------------------- + ! + CALL H5Tclose_f(datatype, error) + CALL CHECK(" H5Tclose_f", error, total_error) + CALL H5Pclose_f(dc, error) + CALL CHECK(" H5Pclose_f", error, total_error) + CALL H5Sclose_f(space, error) + CALL CHECK(" H5Sclose_f", error, total_error) + CALL H5Dclose_f(dataset, error) + CALL CHECK(" H5Dclose_f", error, total_error) + CALL H5Fclose_f(file, error) + CALL CHECK(" H5Fclose_f", error, total_error) + +END SUBROUTINE test_nbit + diff --git a/fortran/testpar/hyper.f90 b/fortran/testpar/hyper.f90 index 1d65ae1..1a580ca 100644 --- a/fortran/testpar/hyper.f90 +++ b/fortran/testpar/hyper.f90 @@ -50,6 +50,7 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) INTEGER :: icount ! number of elements in array CHARACTER(len=80) :: filename ! filename INTEGER :: i + INTEGER :: actual_io_mode ! The type of I/O performed by this process !////////////////////////////////////////////////////////// ! initialize the array data between the processes (3) @@ -180,6 +181,24 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) CALL check("h5dwrite_f", hdferror, nerrors) + ! Check h5pget_mpio_actual_io_mode_f function + 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 + !////////////////////////////////////////////////////////// ! close HDF5 I/O !////////////////////////////////////////////////////////// -- cgit v0.12