From a0340338e53d4b34127a7e5356b28b1640f9414c Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Mon, 1 May 2023 17:21:47 -0500 Subject: Add Fortran Selection IO APIs (#2864) new selection IO fortran APIs with tests --- doxygen/aliases | 1 + fortran/src/H5Pff.F90 | 134 +++++++++++++++++++++++++++++ fortran/src/H5_f.c | 3 + fortran/src/H5_ff.F90 | 63 +++++++------- fortran/src/H5f90global.F90 | 6 ++ fortran/src/hdf5_fortrandll.def.in | 4 + fortran/test/H5_test_buildiface.F90 | 77 +++++++++++++---- fortran/test/fortranlib_test.F90 | 6 +- fortran/test/tH5P.F90 | 164 +++++++++++++++++++++++++++++++++++- release_docs/RELEASE.txt | 6 +- testpar/CMakeLists.txt | 1 + 11 files changed, 413 insertions(+), 52 deletions(-) diff --git a/doxygen/aliases b/doxygen/aliases index 27090e6..96977f3 100644 --- a/doxygen/aliases +++ b/doxygen/aliases @@ -383,4 +383,5 @@ ALIASES += fortran_obsolete="Obsolete API, use the Fortran 2003 version instead. ALIASES += fortran_file="Pointer to filename the async subroutine is being called from, filename must be null character terminated" ALIASES += fortran_func="Pointer to function name the async subroutine is being called in, func must be null character terminated" ALIASES += fortran_line="Line number the async subroutine is being called at" +ALIASES += fortran_plist_id="Property list identifier" diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index 75cd323..49917dd 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -609,6 +609,140 @@ CONTAINS !> !! \ingroup FH5P !! +!! \brief Sets the selection I/O mode +!! +!! \param plist_id \fortran_plist_id +!! \param selection_io_mode The selection I/O mode +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Pset_selection_io() +!! + SUBROUTINE h5pset_selection_io_f(plist_id, selection_io_mode, hdferr) + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: plist_id + INTEGER, INTENT(IN) :: selection_io_mode + INTEGER, INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5Pset_selection_io(plist_id, selection_io_mode) BIND(C, NAME='H5Pset_selection_io') + IMPORT :: HID_T, C_INT + IMPLICIT NONE + INTEGER(HID_T), VALUE :: plist_id + INTEGER(C_INT), VALUE :: selection_io_mode + END FUNCTION H5Pset_selection_io + END INTERFACE + + hdferr = INT(H5Pset_selection_io(plist_id, INT(selection_io_mode, C_INT))) + + END SUBROUTINE h5pset_selection_io_f + +!> +!! \ingroup FH5P +!! +!! \brief Retrieves the selection I/O mode +!! +!! \param plist_id \fortran_plist_id +!! \param selection_io_mode The selection I/O mode +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Pget_selection_io() +!! + SUBROUTINE h5pget_selection_io_f(plist_id, selection_io_mode, hdferr) + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: plist_id + INTEGER, INTENT(OUT) :: selection_io_mode + INTEGER, INTENT(OUT) :: hdferr + + INTEGER(C_INT) :: c_selection_io_mode + + INTERFACE + INTEGER(C_INT) FUNCTION H5Pget_selection_io(plist_id, selection_io_mode) BIND(C, NAME='H5Pget_selection_io') + IMPORT :: HID_T, C_INT + IMPLICIT NONE + INTEGER(HID_T), VALUE :: plist_id + INTEGER(C_INT) :: selection_io_mode + END FUNCTION H5Pget_selection_io + END INTERFACE + + hdferr = INT(H5Pget_selection_io(plist_id, c_selection_io_mode)) + selection_io_mode = INT(c_selection_io_mode) + + END SUBROUTINE h5pget_selection_io_f + +!> +!! \ingroup FH5P +!! +!! \brief Allows the library to modify the contents of the write buffer +!! +!! \param plist_id \fortran_plist_id +!! \param modify_write_buf Whether the library can modify the contents of the write buffer +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Pset_modify_write_buf() +!! + SUBROUTINE h5pset_modify_write_buf_f(plist_id, modify_write_buf, hdferr) + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: plist_id + LOGICAL, INTENT(IN) :: modify_write_buf + INTEGER, INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5Pset_modify_write_buf(plist_id, modify_write_buf) BIND(C, NAME='H5Pset_modify_write_buf') + IMPORT :: HID_T, C_INT, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), VALUE :: plist_id + LOGICAL(C_BOOL), VALUE :: modify_write_buf + END FUNCTION H5Pset_modify_write_buf + END INTERFACE + + hdferr = INT(H5Pset_modify_write_buf(plist_id, LOGICAL(modify_write_buf, C_BOOL))) + + END SUBROUTINE h5pset_modify_write_buf_f + +!> +!! \ingroup FH5P +!! +!! \brief Retrieves the "modify write buffer" property +!! +!! \param plist_id \fortran_plist_id +!! \param modify_write_buf Whether the library can modify the contents of the write buffer +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Pget_modify_write_buf() +!! + SUBROUTINE h5pget_modify_write_buf_f(plist_id, modify_write_buf, hdferr) + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: plist_id + LOGICAL, INTENT(OUT) :: modify_write_buf + INTEGER, INTENT(OUT) :: hdferr + + LOGICAL(C_BOOL) :: c_modify_write_buf + + INTERFACE + INTEGER(C_INT) FUNCTION H5Pget_modify_write_buf(plist_id, modify_write_buf) BIND(C, NAME='H5Pget_modify_write_buf') + IMPORT :: HID_T, C_INT, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), VALUE :: plist_id + LOGICAL(C_BOOL) :: modify_write_buf + END FUNCTION H5Pget_modify_write_buf + END INTERFACE + + hdferr = INT(H5Pget_modify_write_buf(plist_id, c_modify_write_buf)) + modify_write_buf = LOGICAL(c_modify_write_buf) + + END SUBROUTINE h5pget_modify_write_buf_f + +!> +!! \ingroup FH5P +!! !! \brief Sets the byte size of the offsets and lengths used to address objects in an HDF5 file. !! !! \param prp_id File creation property list identifier. diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index 3e1b65d..a9f2d96 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -467,6 +467,9 @@ h5init_flags_c(int_f *h5d_flags, size_t_f *h5d_size_flags, int_f *h5e_flags, hid h5d_flags[26] = (int_f)H5D_VDS_FIRST_MISSING; h5d_flags[27] = (int_f)H5D_VDS_LAST_AVAILABLE; h5d_flags[28] = (int_f)H5D_VIRTUAL; + h5d_flags[29] = (int_f)H5D_SELECTION_IO_MODE_DEFAULT; + h5d_flags[30] = (int_f)H5D_SELECTION_IO_MODE_OFF; + h5d_flags[31] = (int_f)H5D_SELECTION_IO_MODE_ON; /* * H5E flags diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90 index f952cac..651c96d 100644 --- a/fortran/src/H5_ff.F90 +++ b/fortran/src/H5_ff.F90 @@ -77,7 +77,7 @@ MODULE H5LIB ! ! H5D flags declaration ! - INTEGER, PARAMETER :: H5D_FLAGS_LEN = 29 + INTEGER, PARAMETER :: H5D_FLAGS_LEN = 32 INTEGER, DIMENSION(1:H5D_FLAGS_LEN) :: H5D_flags INTEGER, PARAMETER :: H5D_SIZE_FLAGS_LEN = 2 INTEGER(SIZE_T), DIMENSION(1:H5D_SIZE_FLAGS_LEN) :: H5D_size_flags @@ -394,35 +394,38 @@ CONTAINS ! ! H5D flags ! - H5D_COMPACT_F = H5D_flags(1) - H5D_CONTIGUOUS_F = H5D_flags(2) - H5D_CHUNKED_F = H5D_flags(3) - H5D_ALLOC_TIME_ERROR_F = H5D_flags(4) - H5D_ALLOC_TIME_DEFAULT_F = H5D_flags(5) - H5D_ALLOC_TIME_EARLY_F = H5D_flags(6) - H5D_ALLOC_TIME_LATE_F = H5D_flags(7) - H5D_ALLOC_TIME_INCR_F = H5D_flags(8) - H5D_SPACE_STS_ERROR_F = H5D_flags(9) - H5D_SPACE_STS_NOT_ALLOCATED_F = H5D_flags(10) - H5D_SPACE_STS_PART_ALLOCATED_F = H5D_flags(11) - H5D_SPACE_STS_ALLOCATED_F = H5D_flags(12) - H5D_FILL_TIME_ERROR_F = H5D_flags(13) - H5D_FILL_TIME_ALLOC_F = H5D_flags(14) - H5D_FILL_TIME_NEVER_F = H5D_flags(15) - H5D_FILL_VALUE_ERROR_F = H5D_flags(16) - H5D_FILL_VALUE_UNDEFINED_F = H5D_flags(17) - H5D_FILL_VALUE_DEFAULT_F = H5D_flags(18) - H5D_FILL_VALUE_USER_DEFINED_F = H5D_flags(19) - H5D_CHUNK_CACHE_W0_DFLT_F = H5D_flags(20) - H5D_MPIO_NO_COLLECTIVE_F = H5D_flags(21) - H5D_MPIO_CHUNK_INDEPENDENT_F = H5D_flags(22) - H5D_MPIO_CHUNK_COLLECTIVE_F = H5D_flags(23) - H5D_MPIO_CHUNK_MIXED_F = H5D_flags(24) - H5D_MPIO_CONTIG_COLLECTIVE_F = H5D_flags(25) - H5D_VDS_ERROR_F = H5D_flags(26) - H5D_VDS_FIRST_MISSING_F = H5D_flags(27) - H5D_VDS_LAST_AVAILABLE_F = H5D_flags(28) - H5D_VIRTUAL_F = H5D_flags(29) + H5D_COMPACT_F = H5D_flags(1) + H5D_CONTIGUOUS_F = H5D_flags(2) + H5D_CHUNKED_F = H5D_flags(3) + H5D_ALLOC_TIME_ERROR_F = H5D_flags(4) + H5D_ALLOC_TIME_DEFAULT_F = H5D_flags(5) + H5D_ALLOC_TIME_EARLY_F = H5D_flags(6) + H5D_ALLOC_TIME_LATE_F = H5D_flags(7) + H5D_ALLOC_TIME_INCR_F = H5D_flags(8) + H5D_SPACE_STS_ERROR_F = H5D_flags(9) + H5D_SPACE_STS_NOT_ALLOCATED_F = H5D_flags(10) + H5D_SPACE_STS_PART_ALLOCATED_F = H5D_flags(11) + H5D_SPACE_STS_ALLOCATED_F = H5D_flags(12) + H5D_FILL_TIME_ERROR_F = H5D_flags(13) + H5D_FILL_TIME_ALLOC_F = H5D_flags(14) + H5D_FILL_TIME_NEVER_F = H5D_flags(15) + H5D_FILL_VALUE_ERROR_F = H5D_flags(16) + H5D_FILL_VALUE_UNDEFINED_F = H5D_flags(17) + H5D_FILL_VALUE_DEFAULT_F = H5D_flags(18) + H5D_FILL_VALUE_USER_DEFINED_F = H5D_flags(19) + H5D_CHUNK_CACHE_W0_DFLT_F = H5D_flags(20) + H5D_MPIO_NO_COLLECTIVE_F = H5D_flags(21) + H5D_MPIO_CHUNK_INDEPENDENT_F = H5D_flags(22) + H5D_MPIO_CHUNK_COLLECTIVE_F = H5D_flags(23) + H5D_MPIO_CHUNK_MIXED_F = H5D_flags(24) + H5D_MPIO_CONTIG_COLLECTIVE_F = H5D_flags(25) + H5D_VDS_ERROR_F = H5D_flags(26) + H5D_VDS_FIRST_MISSING_F = H5D_flags(27) + H5D_VDS_LAST_AVAILABLE_F = H5D_flags(28) + H5D_VIRTUAL_F = H5D_flags(29) + H5D_SELECTION_IO_MODE_DEFAULT_F = H5D_flags(30) + H5D_SELECTION_IO_MODE_OFF_F = H5D_flags(31) + H5D_SELECTION_IO_MODE_ON_F = H5D_flags(32) H5D_CHUNK_CACHE_NSLOTS_DFLT_F = H5D_size_flags(1) H5D_CHUNK_CACHE_NBYTES_DFLT_F = H5D_size_flags(2) diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90 index 984cae9..c37e22d 100644 --- a/fortran/src/H5f90global.F90 +++ b/fortran/src/H5f90global.F90 @@ -330,6 +330,9 @@ MODULE H5GLOBAL !DEC$ATTRIBUTES DLLEXPORT :: H5D_VDS_FIRST_MISSING_F !DEC$ATTRIBUTES DLLEXPORT :: H5D_VDS_LAST_AVAILABLE_F !DEC$ATTRIBUTES DLLEXPORT :: H5D_VIRTUAL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SELECTION_IO_MODE_DEFAULT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SELECTION_IO_MODE_OFF_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SELECTION_IO_MODE_ON_F !DEC$endif !> \addtogroup FH5D !> @{ @@ -375,6 +378,9 @@ MODULE H5GLOBAL INTEGER :: H5D_VDS_FIRST_MISSING_F !< H5D_VDS_FIRST_MISSING INTEGER :: H5D_VDS_LAST_AVAILABLE_F !< H5D_VDS_LAST_AVAILABLE INTEGER :: H5D_VIRTUAL_F !< H5D_VIRTUAL + INTEGER :: H5D_SELECTION_IO_MODE_DEFAULT_F !< H5D_SELECTION_IO_MODE_DEFAULT_F + INTEGER :: H5D_SELECTION_IO_MODE_OFF_F !< H5D_SELECTION_IO_MODE_OFF_F + INTEGER :: H5D_SELECTION_IO_MODE_ON_F !< H5D_SELECTION_IO_MODE_ON_F ! ! H5E flags declaration ! diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index e55be46..4719633 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -391,6 +391,10 @@ H5P_mp_H5PSET_VOL_F H5P_mp_H5PGET_VOL_ID_F H5P_mp_H5PSET_FILE_LOCKING_F H5P_mp_H5PGET_FILE_LOCKING_F +H5P_mp_H5PSET_SELECTION_IO_F +H5P_mp_H5PGET_SELECTION_IO_F +H5P_mp_H5PSET_MODIFY_WRITE_BUF_F +H5P_mp_H5PGET_MODIFY_WRITE_BUF_F ; Parallel @H5_NOPAREXP@H5P_mp_H5PSET_FAPL_MPIO_F @H5_NOPAREXP@H5P_mp_H5PGET_FAPL_MPIO_F diff --git a/fortran/test/H5_test_buildiface.F90 b/fortran/test/H5_test_buildiface.F90 index 0ea3852..ca945db 100644 --- a/fortran/test/H5_test_buildiface.F90 +++ b/fortran/test/H5_test_buildiface.F90 @@ -133,14 +133,25 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') '!DEC$endif' ! Subroutine API - WRITE(11,'(A)') ' SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)' + WRITE(11,'(A)') ' SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error,chck_eq)' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string' WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//') :: value, correct_value' WRITE(11,'(A)') ' INTEGER :: total_error' - WRITE(11,'(A)') ' IF (value .NE. correct_value) THEN' - WRITE(11,'(A)') ' total_error=total_error+1' - WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT INTEGER VALIDATION ", string' + WRITE(11,'(A)') ' LOGICAL, OPTIONAL :: chck_eq' + WRITE(11,'(A)') ' LOGICAL :: chck_eq_opt' + WRITE(11,'(A)') ' chck_eq_opt = .TRUE.' + WRITE(11,'(A)') ' IF(PRESENT(chck_eq)) chck_eq_opt = chck_eq' + WRITE(11,'(A)') ' IF(chck_eq_opt .EQV. .TRUE.)THEN' + WRITE(11,'(A)') ' IF (value .NE. correct_value) THEN' + WRITE(11,'(A)') ' total_error=total_error+1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT INTEGER VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' + WRITE(11,'(A)') ' ELSE' + WRITE(11,'(A)') ' IF (value .EQ. correct_value) THEN' + WRITE(11,'(A)') ' total_error=total_error+1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT INTEGER VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' END SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2)) ENDDO @@ -157,14 +168,25 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') '!DEC$endif' ! Subroutine API - WRITE(11,'(A)') ' SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)' + WRITE(11,'(A)') ' SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error,chck_eq)' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string' WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//') :: value, correct_value' WRITE(11,'(A)') ' INTEGER :: total_error' - WRITE(11,'(A)') ' IF (.NOT.real_eq_kind_'//TRIM(ADJUSTL(chr2))//'( value, correct_value) ) THEN' - WRITE(11,'(A)') ' total_error=total_error+1' - WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string' + WRITE(11,'(A)') ' LOGICAL, OPTIONAL :: chck_eq' + WRITE(11,'(A)') ' LOGICAL :: chck_eq_opt' + WRITE(11,'(A)') ' chck_eq_opt = .TRUE.' + WRITE(11,'(A)') ' IF(PRESENT(chck_eq)) chck_eq_opt = chck_eq' + WRITE(11,'(A)') ' IF(chck_eq_opt .EQV. .TRUE.)THEN' + WRITE(11,'(A)') ' IF (.NOT.real_eq_kind_'//TRIM(ADJUSTL(chr2))//'( value, correct_value) ) THEN' + WRITE(11,'(A)') ' total_error=total_error+1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' + WRITE(11,'(A)') ' ELSE' + WRITE(11,'(A)') ' IF (real_eq_kind_'//TRIM(ADJUSTL(chr2))//'( value, correct_value) ) THEN' + WRITE(11,'(A)') ' total_error=total_error+1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' END SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2)) @@ -228,14 +250,25 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') '!DEC$endif' ! Subroutine API - WRITE(11,'(A)') ' SUBROUTINE verify_character(string,value,correct_value,total_error)' + WRITE(11,'(A)') ' SUBROUTINE verify_character(string,value,correct_value,total_error,chck_eq)' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' CHARACTER*(*) :: string' WRITE(11,'(A)') ' CHARACTER*(*) :: value, correct_value' WRITE(11,'(A)') ' INTEGER :: total_error' - WRITE(11,'(A)') ' IF (TRIM(value) .NE. TRIM(correct_value)) THEN' - WRITE(11,'(A)') ' total_error = total_error + 1' - WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' LOGICAL, OPTIONAL :: chck_eq' + WRITE(11,'(A)') ' LOGICAL :: chck_eq_opt' + WRITE(11,'(A)') ' chck_eq_opt = .TRUE.' + WRITE(11,'(A)') ' IF(PRESENT(chck_eq)) chck_eq_opt = chck_eq' + WRITE(11,'(A)') ' IF(chck_eq_opt .EQV. .TRUE.)THEN' + WRITE(11,'(A)') ' IF (TRIM(value) .NE. TRIM(correct_value)) THEN' + WRITE(11,'(A)') ' total_error = total_error + 1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' + WRITE(11,'(A)') ' ELSE' + WRITE(11,'(A)') ' IF (TRIM(value) .EQ. TRIM(correct_value)) THEN' + WRITE(11,'(A)') ' total_error = total_error + 1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' END SUBROUTINE verify_character' @@ -248,16 +281,26 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_logical' WRITE(11,'(A)') '!DEC$endif' ! Subroutine API - WRITE(11,'(A)') ' SUBROUTINE verify_logical(string,value,correct_value,total_error)' + WRITE(11,'(A)') ' SUBROUTINE verify_logical(string,value,correct_value,total_error,chck_eq)' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string' WRITE(11,'(A)') ' LOGICAL :: value, correct_value' WRITE(11,'(A)') ' INTEGER :: total_error' - WRITE(11,'(A)') ' IF (value .NEQV. correct_value) THEN' - WRITE(11,'(A)') ' total_error = total_error + 1' - WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' LOGICAL, OPTIONAL :: chck_eq' + WRITE(11,'(A)') ' LOGICAL :: chck_eq_opt' + WRITE(11,'(A)') ' chck_eq_opt = .TRUE.' + WRITE(11,'(A)') ' IF(PRESENT(chck_eq)) chck_eq_opt = chck_eq' + WRITE(11,'(A)') ' IF(chck_eq_opt .EQV. .TRUE.)THEN' + WRITE(11,'(A)') ' IF (value .NEQV. correct_value) THEN' + WRITE(11,'(A)') ' total_error = total_error + 1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' + WRITE(11,'(A)') ' ELSE' + WRITE(11,'(A)') ' IF (value .EQV. correct_value) THEN' + WRITE(11,'(A)') ' total_error = total_error + 1' + WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' + WRITE(11,'(A)') ' ENDIF' WRITE(11,'(A)') ' ENDIF' - WRITE(11,'(A)') ' END SUBROUTINE verify_logical' WRITE(11,'(A)') "END MODULE TH5_MISC_gen" diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90 index d7fca7d..ec0dcec 100644 --- a/fortran/test/fortranlib_test.F90 +++ b/fortran/test/fortranlib_test.F90 @@ -193,7 +193,7 @@ PROGRAM fortranlibtest ret_total_error = 0 CALL external_test(cleanup, ret_total_error) - CALL write_test_status(ret_total_error, ' External dataset test', total_error) + CALL write_test_status(ret_total_error, ' External dataset and Selection IO test', total_error) ret_total_error = 0 CALL multi_file_test(cleanup, ret_total_error) @@ -207,6 +207,10 @@ PROGRAM fortranlibtest CALL test_misc_properties(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Miscellaneous properties', total_error) + ret_total_error = 0 + CALL test_in_place_conversion(cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' Test in-place conversion', total_error) + ! ! '=========================================' ! 'Testing ATTRIBUTE interface ' diff --git a/fortran/test/tH5P.F90 b/fortran/test/tH5P.F90 index 3db5b28..37ecdac 100644 --- a/fortran/test/tH5P.F90 +++ b/fortran/test/tH5P.F90 @@ -34,8 +34,8 @@ SUBROUTINE external_test(cleanup, total_error) ! This subroutine tests following functionalities: ! h5pset_external_f, h5pget_external_count_f, -! h5pget_external_f - +! h5pget_external_f, h5pget_selection_io_f +! h5pSet_selection_io_f IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup @@ -62,6 +62,7 @@ SUBROUTINE external_test(cleanup, total_error) INTEGER(SIZE_T) :: namesize INTEGER(HSIZE_T) :: size, buf_size INTEGER :: idx + INTEGER :: selection_io_mode buf_size = 4*1024*1024 @@ -77,6 +78,44 @@ SUBROUTINE external_test(cleanup, total_error) CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, error) CALL check("h5pcreate_f", error, total_error) + + ! Check default Selection IO state + CALL h5pget_selection_io_f(plist_id, selection_io_mode, error) + CALL check("h5pget_selection_io_f", error, total_error) + CALL VERIFY("h5pget_selection_io_f", selection_io_mode, H5D_SELECTION_IO_MODE_DEFAULT_F, total_error) + + ! Turn off Section IO + CALL h5pset_selection_io_f(plist_id, H5D_SELECTION_IO_MODE_OFF_F, error) + CALL check("h5pset_selection_io_f", error, total_error) + + CALL h5pget_selection_io_f(plist_id, selection_io_mode, error) + CALL check("h5pget_selection_io_f", error, total_error) + CALL VERIFY("h5pget_selection_io_f", selection_io_mode, H5D_SELECTION_IO_MODE_OFF_F, total_error) + + ! Turn on Section IO + CALL h5pset_selection_io_f(plist_id, H5D_SELECTION_IO_MODE_ON_F, error) + CALL check("h5pset_selection_io_f", error, total_error) + + CALL h5pget_selection_io_f(plist_id, selection_io_mode, error) + CALL check("h5pget_selection_io_f", error, total_error) + CALL VERIFY("h5pget_selection_io_f", selection_io_mode, H5D_SELECTION_IO_MODE_ON_F, total_error) + + ! Turn off Section IO + CALL h5pset_selection_io_f(plist_id, H5D_SELECTION_IO_MODE_OFF_F, error) + CALL check("h5pset_selection_io_f", error, total_error) + + CALL h5pget_selection_io_f(plist_id, selection_io_mode, error) + CALL check("h5pget_selection_io_f", error, total_error) + CALL VERIFY("h5pget_selection_io_f", selection_io_mode, H5D_SELECTION_IO_MODE_OFF_F, total_error) + + ! Change back to the default + CALL h5pset_selection_io_f(plist_id, H5D_SELECTION_IO_MODE_DEFAULT_F, error) + CALL check("h5pset_selection_io_f", error, total_error) + + CALL h5pget_selection_io_f(plist_id, selection_io_mode, error) + CALL check("h5pget_selection_io_f", error, total_error) + CALL VERIFY("h5pget_selection_io_f", selection_io_mode, H5D_SELECTION_IO_MODE_DEFAULT_F, total_error) + CALL h5pset_buffer_f(plist_id, buf_size, error) CALL check("h5pset_buffer_f", error, total_error) CALL h5pget_buffer_f(plist_id, size, error) @@ -796,4 +835,125 @@ SUBROUTINE test_misc_properties(cleanup, total_error) END SUBROUTINE test_misc_properties +!------------------------------------------------------------------------- +! Function: test_in_place_conversion +! +! Purpose: single dataset reader/write, smaller mem type, no background buffer +! -- create dataset with H5T_NATIVE_DOUBLE +! -- write dataset with H5T_NATIVE_REAL +! -- read dataset with H5T_NATIVE_REAL +! +! Tests APIs: +! h5pset_modify_write_buf_f, h5pget_modify_write_buf_f +! +! Return: Success: 0 +! Failure: >0 +! +!------------------------------------------------------------------------- +! +SUBROUTINE test_in_place_conversion(cleanup, total_error) + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + CHARACTER(LEN=12), PARAMETER :: filename = "inplace_conv" + CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dspace_id ! Dataspace identifier + INTEGER(HID_T) :: plist_id + LOGICAL :: modify_write_buf + INTEGER :: error !error code + + INTEGER, PARAMETER :: array_len = 10 + INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/array_len/) ! Dataset dimensions + INTEGER :: rank = 1 ! Dataset rank + + REAL(KIND=Fortran_DOUBLE), DIMENSION(1:array_len), TARGET :: wbuf_d + REAL(KIND=Fortran_DOUBLE), DIMENSION(1:array_len) :: wbuf_d_org + REAL(KIND=Fortran_REAL) , DIMENSION(1:array_len), TARGET :: rbuf + INTEGER :: i + TYPE(C_PTR) :: f_ptr + + ! create the data + DO i = 1, array_len + wbuf_d(i) = 1_Fortran_DOUBLE + 0.123456789123456_Fortran_DOUBLE + wbuf_d_org(i) = wbuf_d(i) + ENDDO + + ! + !Create file "inplace_conv.h5" using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + IF (error .NE. 0) STOP "Cannot modify filename" + + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + ! + ! Create the dataspace. + ! + CALL h5screate_simple_f(rank, dims, dspace_id, error) + CALL check("h5screate_simple_f", error, total_error) + + ! Create dataset transfer property list + CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, error) + CALL check("h5pcreate_f", error, total_error) + + CALL h5pset_selection_io_f(plist_id, H5D_SELECTION_IO_MODE_ON_F, error) + CALL check("h5pset_selection_io_f", error, total_error) + + CALL h5pget_modify_write_buf_f(plist_id, modify_write_buf, error) + CALL check("h5pget_modify_write_buf_f", error, total_error) + CALL VERIFY("h5pget_modify_write_buf_f", modify_write_buf, .FALSE., total_error) + + ! Set to modify the write buffer + CALL h5pset_modify_write_buf_f(plist_id, .TRUE., error) + CALL check("h5pset_modify_write_buf_f", error, total_error) + + CALL h5pget_modify_write_buf_f(plist_id, modify_write_buf, error) + CALL check("h5pget_modify_write_buf_f", error, total_error) + CALL VERIFY("h5pget_modify_write_buf_f", modify_write_buf, .TRUE., total_error) + + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_REAL, dspace_id, dset_id, error) + CALL check("h5dcreate_f", error, total_error) + + f_ptr = C_LOC(wbuf_d) + CALL h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, error, H5S_ALL_F, H5S_ALL_F, xfer_prp=plist_id) + CALL check("h5dwrite_f", error, total_error) + + ! Should not be equal for in-place buffer use + CALL VERIFY("h5dwrite_f -- in-place", wbuf_d(1), wbuf_d_org(1), total_error, .FALSE.) + + f_ptr = C_LOC(rbuf) + CALL h5dread_f(dset_id, H5T_NATIVE_REAL, f_ptr, error) + CALL check("h5dread_f", error, total_error) + + DO i = 1, array_len + CALL VERIFY("h5dwrite_f -- in-place", rbuf(i), REAL(wbuf_d_org(i), Fortran_REAL), total_error) + ENDDO + + ! + ! End access to the dataset and release resources used by it. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + ! + ! Terminate access to the data space. + ! + CALL h5sclose_f(dspace_id, error) + CALL check("h5sclose_f", error, total_error) + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + CALL h5pclose_f(plist_id, error) + CALL check("h5pclose_f", error, total_error) + +END SUBROUTINE test_in_place_conversion + END MODULE TH5P diff --git a/release_docs/RELEASE.txt b/release_docs/RELEASE.txt index 89a821c..b3aa5b6 100644 --- a/release_docs/RELEASE.txt +++ b/release_docs/RELEASE.txt @@ -123,9 +123,11 @@ New Features Fortran Library: ---------------- - - Added Fortran async APIs + - Fortran async APIs H5A, H5D, H5ES, H5G, H5F, H5L and H5O were added. - H5A, H5D, H5ES, H5G, H5F, H5L and H5O async APIs were added. + - Added Fortran APIs: + h5pset_selection_io_f, h5pget_selection_io_f + h5pset_modify_write_buf_f, h5pget_modify_write_buf_f C++ Library: ------------ diff --git a/testpar/CMakeLists.txt b/testpar/CMakeLists.txt index 3a44fca..fb66e76 100644 --- a/testpar/CMakeLists.txt +++ b/testpar/CMakeLists.txt @@ -8,6 +8,7 @@ project (HDF5_TEST_PAR C) set (testphdf5_SOURCES ${HDF5_TEST_PAR_SOURCE_DIR}/testphdf5.c ${HDF5_TEST_PAR_SOURCE_DIR}/t_dset.c + ${HDF5_TEST_PAR_SOURCE_DIR}/t_select_io_dset.c ${HDF5_TEST_PAR_SOURCE_DIR}/t_file.c ${HDF5_TEST_PAR_SOURCE_DIR}/t_file_image.c ${HDF5_TEST_PAR_SOURCE_DIR}/t_mdset.c -- cgit v0.12