mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-03-31 17:10:47 +08:00
Code Issues Packages Projects Releases Wiki Activity

Add Fortran Selection IO APIs (#2864)

Browse Source 
new selection IO fortran APIs with tests
This commit is contained in:
Scot Breitenfeld 2023-05-01 17:21:47 -05:00 committed by GitHub
parent 9ea976b9b6
commit a0340338e5
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
11 changed files with 413 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
doxygen/aliases
View File

@ -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"

134
fortran/src/H5Pff.F90
View File

@ -606,6 +606,140 @@ CONTAINS
hdferr = h5pget_userblock_c(prp_id, block_size)
END SUBROUTINE h5pget_userblock_f
!>
!! \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
!!

3
fortran/src/H5_f.c
View File

@ -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

63
fortran/src/H5_ff.F90
View File

@ -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)

6
fortran/src/H5f90global.F90
View File

@ -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
!

4
fortran/src/hdf5_fortrandll.def.in
View File

@ -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

77
fortran/test/H5_test_buildiface.F90
View File

@ -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"

6
fortran/test/fortranlib_test.F90
View File

@ -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 '

164
fortran/test/tH5P.F90
View File

@ -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

6
release_docs/RELEASE.txt
View File

@ -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:
------------

1
testpar/CMakeLists.txt
View File

@ -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