diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | fortran/src/CMakeLists.txt | 1 | ||||
| -rw-r--r-- | fortran/src/H5Dff.F90 | 2 | ||||
| -rw-r--r-- | fortran/src/H5Eff.F90 | 2 | ||||
| -rw-r--r-- | fortran/src/H5Fff.F90 | 2 | ||||
| -rw-r--r-- | fortran/src/H5Gff.F90 | 2 | ||||
| -rw-r--r-- | fortran/src/H5Off.F90 | 2 | ||||
| -rw-r--r-- | fortran/src/H5Pff.F90 | 517 | ||||
| -rw-r--r-- | fortran/src/H5Rff.F90 | 2 | ||||
| -rw-r--r-- | fortran/src/H5Sff.F90 | 118 | ||||
| -rw-r--r-- | fortran/src/H5_buildiface.F90 | 2 | ||||
| -rw-r--r-- | fortran/src/H5_f.c | 4 | ||||
| -rw-r--r-- | fortran/src/H5f90.h | 2 | ||||
| -rw-r--r-- | fortran/src/H5f90global.F90 | 23 | ||||
| -rw-r--r-- | fortran/src/H5fortkit.F90 | 58 | ||||
| -rw-r--r-- | fortran/src/HDF5.F90 | 2 | ||||
| -rw-r--r-- | fortran/src/Makefile.am | 6 | ||||
| -rw-r--r-- | fortran/src/hdf5_fortrandll.def.in | 12 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test_F03.F90 | 8 | ||||
| -rw-r--r-- | fortran/test/tH5P_F03.F90 | 472 |
20 files changed, 1219 insertions, 19 deletions
@@ -216,6 +216,7 @@ ./fortran/src/H5f90global.F90 ./fortran/src/H5f90i.h ./fortran/src/H5f90kit.c +./fortran/src/H5fortkit.F90 ./fortran/src/H5f90proto.h ./fortran/src/H5match_types.c ./fortran/src/HDF5.F90 diff --git a/fortran/src/CMakeLists.txt b/fortran/src/CMakeLists.txt index dc884d5..5854f75 100644 --- a/fortran/src/CMakeLists.txt +++ b/fortran/src/CMakeLists.txt @@ -161,6 +161,7 @@ set (f90_F_BASE_SRCS # normal distribution ${HDF5_F90_SRC_SOURCE_DIR}/H5f90global.F90 + ${HDF5_F90_SRC_SOURCE_DIR}/H5fortkit.F90 ${HDF5_F90_SRC_SOURCE_DIR}/H5_ff.F90 ${HDF5_F90_SRC_SOURCE_DIR}/H5Aff.F90 ${HDF5_F90_SRC_SOURCE_DIR}/H5Dff.F90 diff --git a/fortran/src/H5Dff.F90 b/fortran/src/H5Dff.F90 index e44d90e..b372dc1 100644 --- a/fortran/src/H5Dff.F90 +++ b/fortran/src/H5Dff.F90 @@ -4,7 +4,7 @@ ! MODULE H5D ! ! FILE -! fortran/src/H5Dff.f90 +! fortran/src/H5Dff.F90 ! ! PURPOSE ! This file contains Fortran interfaces for H5D functions. diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index a2efe61..7a0b15b 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -4,7 +4,7 @@ ! MODULE H5E ! ! FILE -! fortran/src/H5Eff.f90 +! fortran/src/H5Eff.F90 ! ! PURPOSE ! This Module contains Fortran interfaces for H5E functions. diff --git a/fortran/src/H5Fff.F90 b/fortran/src/H5Fff.F90 index c69ad82..165fba0 100644 --- a/fortran/src/H5Fff.F90 +++ b/fortran/src/H5Fff.F90 @@ -4,7 +4,7 @@ ! MODULE H5F ! ! FILE -! H5Fff.f90 +! H5Fff.F90 ! ! PURPOSE ! This file contains Fortran interfaces for H5F functions. diff --git a/fortran/src/H5Gff.F90 b/fortran/src/H5Gff.F90 index 2e002b5..30076a4 100644 --- a/fortran/src/H5Gff.F90 +++ b/fortran/src/H5Gff.F90 @@ -4,7 +4,7 @@ ! MODULE H5G ! ! FILE -! fortran/src/H5Gff.f90 +! fortran/src/H5Gff.F90 ! ! PURPOSE ! This file contains Fortran interfaces for H5G functions. diff --git a/fortran/src/H5Off.F90 b/fortran/src/H5Off.F90 index da940df..8d4fb16 100644 --- a/fortran/src/H5Off.F90 +++ b/fortran/src/H5Off.F90 @@ -4,7 +4,7 @@ ! MODULE H5O ! ! FILE -! fortran/src/H5Off.f90 +! fortran/src/H5Off.F90 ! ! PURPOSE ! This file contains Fortran interfaces for H5O functions. diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index 97f907b..6c6abe4 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -42,7 +42,8 @@ MODULE H5P USE, INTRINSIC :: ISO_C_BINDING USE H5GLOBAL - + USE H5fortkit + INTERFACE h5pset_fapl_multi_f MODULE PROCEDURE h5pset_fapl_multi_l MODULE PROCEDURE h5pset_fapl_multi_s @@ -7321,6 +7322,520 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) END SUBROUTINE h5pget_mpio_actual_io_mode_f #endif +! +! V I R T U A L D A T S E T S +! + +!****s* +! NAME +! h5pset_virtual_view_f +! +! PURPOSE +! Sets the view of the virtual dataset (VDS) to include or exclude missing mapped elements. +! +! INPUTS +! dapl_id - Identifier of the virtual dataset access property list. +! view - Flag specifying the extent of the data to be included in the view. +! Valid values are: +! H5D_VDS_FIRST_MISSING_F +! H5D_VDS_LAST_AVAILABLE_F +! +! OUTPUTS +! +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! Nov 2, 2015 +! +! +! SOURCE + SUBROUTINE h5pset_virtual_view_f(dapl_id, view, hdferr) + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: dapl_id + INTEGER , INTENT(IN) :: view + INTEGER , INTENT(OUT) :: hdferr + +!***** + INTERFACE + INTEGER FUNCTION h5pset_virtual_view(dapl_id, view) BIND(C,NAME='H5Pset_virtual_view') + IMPORT :: HID_T, ENUM_T + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: dapl_id + INTEGER(ENUM_T), INTENT(IN), VALUE :: view + END FUNCTION h5pset_virtual_view + END INTERFACE + + hdferr = INT( h5pset_virtual_view(dapl_id, INT(view,ENUM_T)) ) + + END SUBROUTINE h5pset_virtual_view_f + +!****s* +! NAME +! h5pget_virtual_view_f +! +! PURPOSE +! Retrieves the view of a virtual dataset accessed with dapl_id. +! +! INPUTS +! dapl_id - Dataset access property list identifier for the virtual dataset +! +! OUTPUTS +! view - The flag specifying the view of the virtual dataset. +! Valid values are: +! H5D_VDS_FIRST_MISSING_F +! H5D_VDS_LAST_AVAILABLE_F +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! Nov 2, 2015 +! +! SOURCE + SUBROUTINE h5pget_virtual_view_f(dapl_id, view, hdferr) + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: dapl_id + INTEGER , INTENT(INOUT) :: view + INTEGER , INTENT(OUT) :: hdferr +!***** + INTEGER(ENUM_T) :: view_enum + INTERFACE + INTEGER FUNCTION h5pget_virtual_view(dapl_id, view) BIND(C,NAME='H5Pget_virtual_view') + IMPORT :: HID_T, ENUM_T + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: dapl_id + INTEGER(ENUM_T), INTENT(OUT) :: view + END FUNCTION h5pget_virtual_view + END INTERFACE + + hdferr = INT( h5pget_virtual_view(dapl_id, view_enum) ) + view = INT(view_enum) + + END SUBROUTINE h5pget_virtual_view_f + +!****s* +! NAME +! h5pset_virtual_printf_gap_f +! +! PURPOSE +! Sets the maximum number of missing source files and/or datasets with the printf-style names +! when getting the extent of an unlimited virtual dataset. +! +! INPUTS +! dapl_id - Dataset access property list identifier for the virtual dataset. +! gap_size - Maximum number of files and/or datasets allowed to be missing for determining +! the extent of an unlimited virtual dataset with printf-style mappings. +! +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! Nov 2, 2015 +! +! HISTORY +! +! SOURCE + SUBROUTINE h5pset_virtual_printf_gap_f(dapl_id, gap_size, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: dapl_id + INTEGER(HSIZE_T), INTENT(IN) :: gap_size + INTEGER , INTENT(OUT) :: hdferr +!***** + INTERFACE + INTEGER FUNCTION h5pset_virtual_printf_gap(dapl_id, gap_size) BIND(C,NAME='H5Pset_virtual_printf_gap') + IMPORT :: HID_T, HSIZE_T + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: dapl_id + INTEGER(HSIZE_T), INTENT(IN), VALUE :: gap_size + END FUNCTION h5pset_virtual_printf_gap + END INTERFACE + + hdferr = INT( h5pset_virtual_printf_gap(dapl_id, gap_size) ) + + END SUBROUTINE h5pset_virtual_printf_gap_f + +!****s* +! NAME +! h5pget_virtual_printf_gap_f +! +! PURPOSE +! Returns the maximum number of missing source files and/or datasets with the +! printf-style names when getting the extent for an unlimited virtual dataset. +! +! INPUTS +! dapl_id - Dataset access property list identifier for the virtual dataset +! +! OUTPUTS +! gap_size - Maximum number of the files and/or datasets allowed to be missing for +! determining the extent of an unlimited virtual dataset with printf-style mappings. +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! M. Scot Breitenfeld +! Nov 2, 2015 +! +! HISTORY +! +! SOURCE + SUBROUTINE h5pget_virtual_printf_gap_f(dapl_id, gap_size, hdferr) + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: dapl_id + INTEGER(HSIZE_T), INTENT(OUT) :: gap_size + INTEGER , INTENT(OUT) :: hdferr +!***** + INTERFACE + INTEGER FUNCTION h5pget_virtual_printf_gap(dapl_id, gap_size) BIND(C,NAME='H5Pget_virtual_printf_gap') + IMPORT :: HID_T, HSIZE_T + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: dapl_id + INTEGER(HSIZE_T), INTENT(OUT) :: gap_size + END FUNCTION h5pget_virtual_printf_gap + END INTERFACE + + hdferr = INT( h5pget_virtual_printf_gap(dapl_id, gap_size) ) + + END SUBROUTINE h5pget_virtual_printf_gap_f + +!****s* +! NAME +! h5pset_virtual_f +! +! PURPOSE +! Sets the mapping between virtual and source datasets. +! +! INPUTS +! dcpl_id - The identifier of the dataset creation property list that will be +! used when creating the virtual dataset. +! vspace_id - The dataspace identifier with the selection within the virtual +! dataset applied, possibly an unlimited selection. +! src_file_name - The name of the HDF5 file where the source dataset is located. +! src_dset_name - The path to the HDF5 dataset in the file specified by src_file_name. +! src_space_id - The source dataset’s dataspace identifier with a selection applied, possibly an unlimited selection +! +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails + +! AUTHOR +! M. Scot Breitenfeld +! Nov 2, 2015 +! +! HISTORY +! +! SOURCE + SUBROUTINE h5pset_virtual_f(dcpl_id, vspace_id, src_file_name, src_dset_name, src_space_id, hdferr) + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: dcpl_id + INTEGER(HID_T), INTENT(IN) :: vspace_id + CHARACTER(LEN=*), INTENT(IN) :: src_file_name + CHARACTER(LEN=*), INTENT(IN) :: src_dset_name + INTEGER(HID_T), INTENT(IN) :: src_space_id + INTEGER, INTENT(OUT) :: hdferr +!***** + CHARACTER(LEN=LEN_TRIM(src_file_name)+1,KIND=C_CHAR) :: c_src_file_name + CHARACTER(LEN=LEN_TRIM(src_dset_name)+1,KIND=C_CHAR) :: c_src_dset_name + + INTERFACE + INTEGER FUNCTION h5pset_virtual(dcpl_id, vspace_id, c_src_file_name, c_src_dset_name, src_space_id) & + BIND(C,NAME='H5Pset_virtual') + IMPORT :: C_CHAR + IMPORT :: HID_T + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: dcpl_id + INTEGER(HID_T), INTENT(IN), VALUE :: vspace_id + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: c_src_file_name + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: c_src_dset_name + INTEGER(HID_T), INTENT(IN), VALUE :: src_space_id + END FUNCTION h5pset_virtual + END INTERFACE + + c_src_file_name = TRIM(src_file_name)//C_NULL_CHAR + c_src_dset_name = TRIM(src_dset_name)//C_NULL_CHAR + + hdferr = h5pset_virtual(dcpl_id, vspace_id, c_src_file_name, c_src_dset_name, src_space_id) + + END SUBROUTINE h5pset_virtual_f + +!****s* +! NAME +! h5pget_virtual_count_f +! +! PURPOSE +! Gets the number of mappings for the virtual dataset. +! +! INPUTS +! dcpl_id - The identifier of the virtual dataset creation property list. +! +! OUTPUTS +! count - The number of mappings. +! hdferr - Returns 0 if successful and -1 if fails +! AUTHOR +! M. Scot Breitenfeld +! Nov 2, 2015 +! +! HISTORY +! +! SOURCE + SUBROUTINE h5pget_virtual_count_f(dcpl_id, count, hdferr) + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: dcpl_id + INTEGER(SIZE_T), INTENT(OUT) :: count + INTEGER, INTENT(OUT) :: hdferr +!***** + INTERFACE + INTEGER(HID_T) FUNCTION h5pget_virtual_count(dcpl_id, count) BIND(C,NAME='H5Pget_virtual_count') + IMPORT :: HID_T, SIZE_T + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN), VALUE :: dcpl_id + INTEGER(SIZE_T), INTENT(OUT) :: count + END FUNCTION h5pget_virtual_count + END INTERFACE + + hdferr = INT( h5pget_virtual_count(dcpl_id, count)) + + END SUBROUTINE h5pget_virtual_count_f + +!****s* +! NAME +! h5pget_virtual_vspace_f +! +! PURPOSE +! Gets a dataspace identifier for the selection within the virtual dataset used in the mapping. +! +! INPUTS +! dcpl_id - The identifier of the virtual dataset creation property list. +! index - Mapping index. +! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), +! where count is the number of mappings returned by h5pget_virtual_count. +! +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! Nov 2, 2015 +! +! HISTORY +! +! SOURCE + SUBROUTINE h5pget_virtual_vspace_f(dcpl_id, index, ds_id, hdferr) + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: dcpl_id + INTEGER(SIZE_T), INTENT(IN) :: index + INTEGER(HID_T) , INTENT(OUT) :: ds_id + INTEGER, INTENT(OUT) :: hdferr + +!***** + INTERFACE + INTEGER(HID_T) FUNCTION h5pget_virtual_vspace(dcpl_id, index) BIND(C,NAME='H5Pget_virtual_vspace') + IMPORT :: HID_T, SIZE_T + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN), VALUE :: dcpl_id + INTEGER(SIZE_T), INTENT(IN), VALUE :: index + END FUNCTION h5pget_virtual_vspace + END INTERFACE + + ds_id = h5pget_virtual_vspace(dcpl_id, index) + + hdferr = 0 + IF(ds_id.LT.0) hdferr = -1 + +END SUBROUTINE h5pget_virtual_vspace_f + +!****s* +! NAME +! h5pget_virtual_srcspace_f +! +! PURPOSE +! Gets a dataspace identifier for the selection within the source dataset used in the mapping. +! +! INPUTS +! dcpl_id - The identifier of the virtual dataset creation property list. +! index - Mapping index. +! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), +! where count is the number of mappings returned by h5pget_virtual_count. +! +! +! OUTPUTS +! ds_id - dataspace identifier +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! Nov 2, 2015 +! +! HISTORY +! +! SOURCE +SUBROUTINE h5pget_virtual_srcspace_f(dcpl_id, index, ds_id, hdferr) + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: dcpl_id + INTEGER(SIZE_T), INTENT(IN) :: index + INTEGER(HID_T) , INTENT(OUT) :: ds_id + INTEGER, INTENT(OUT) :: hdferr + +!***** + INTERFACE + INTEGER(HID_T) FUNCTION h5pget_virtual_srcspace(dcpl_id, index) BIND(C,NAME='H5Pget_virtual_srcspace') + IMPORT :: HID_T, SIZE_T + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN), VALUE :: dcpl_id + INTEGER(SIZE_T), INTENT(IN), VALUE :: index + END FUNCTION h5pget_virtual_srcspace + END INTERFACE + + ds_id = h5pget_virtual_srcspace(dcpl_id, index) + + hdferr = 0 + IF(ds_id.LT.0) hdferr = -1 + +END SUBROUTINE h5pget_virtual_srcspace_f + +!****s* +! NAME +! h5pget_virtual_filename_f +! +! PURPOSE +! Gets the filename of a source dataset used in the mapping. +! +! INPUTS +! dcpl_id - The identifier of the virtual dataset creation property list. +! index - Mapping index. +! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), +! where count is the number of mappings returned by h5pget_virtual_count. +! +! OUTPUTS +! name - A buffer containing the name of the file containing the source dataset. +! hdferr - Returns 0 if successful and -1 if fails. +! +! Optional parameters: +! name_len - The size of name needed to hold the filename. (OUT) +! +! AUTHOR +! M. Scot Breitenfeld +! Nov 2, 2015 +! +! HISTORY +! +! SOURCE +SUBROUTINE h5pget_virtual_filename_f(dcpl_id, index, name, hdferr, name_len) + + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: dcpl_id + INTEGER(SIZE_T) , INTENT(IN) :: index + CHARACTER(LEN=*), INTENT(OUT) :: name + INTEGER, INTENT(OUT) :: hdferr + INTEGER(SIZE_T), OPTIONAL :: name_len +!***** + + CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(1:LEN(name)+1), TARGET :: c_name + TYPE(C_PTR) :: f_ptr + + INTERFACE + INTEGER(SIZE_T) FUNCTION h5pget_virtual_filename(dcpl_id, index, name, size) BIND(C, NAME='H5Pget_virtual_filename') + IMPORT :: HID_T, SIZE_T, C_PTR, C_CHAR + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN), VALUE :: dcpl_id + INTEGER(SIZE_T), INTENT(IN), VALUE :: index + TYPE(C_PTR), VALUE :: name + INTEGER(SIZE_T), INTENT(IN), VALUE :: size + END FUNCTION h5pget_virtual_filename + END INTERFACE + + hdferr = 0 + IF(PRESENT(name_len))THEN + name_len = INT(h5pget_virtual_filename(dcpl_id, index, C_NULL_PTR, 0_SIZE_T), SIZE_T) + IF(name_len.LT.0) hdferr = -1 + ELSE + f_ptr = C_LOC(c_name(1)(1:1)) + + IF(INT(h5pget_virtual_filename(dcpl_id, index, f_ptr, INT(LEN(name)+1,SIZE_T)), SIZE_T).LT.0)THEN + hdferr = -1 + ELSE + CALL HD5c2fstring(name,c_name,LEN(name)) + ENDIF + + ENDIF + + +END SUBROUTINE h5pget_virtual_filename_f + +!****s* +! NAME +! h5pget_virtual_dsetname_f +! +! PURPOSE +! Gets the name of a source dataset used in the mapping. +! +! INPUTS +! dcpl_id - The identifier of the virtual dataset creation property list. +! index - Mapping index. +! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), +! where count is the number of mappings returned by h5pget_virtual_count. +! +! OUTPUTS +! name - A buffer containing the name of the source dataset. +! hdferr - Returns 0 if successful and -1 if fails. +! +! Optional parameters: +! name_len - The size of name needed to hold the source dataset name. (OUT) +! +! AUTHOR +! M. Scot Breitenfeld +! January 28, 2016 +! +! HISTORY +! +! SOURCE +SUBROUTINE h5pget_virtual_dsetname_f(dcpl_id, index, name, hdferr, name_len) + + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: dcpl_id + INTEGER(SIZE_T) , INTENT(IN) :: index + CHARACTER(LEN=*), INTENT(OUT) :: name + INTEGER, INTENT(OUT) :: hdferr + INTEGER(SIZE_T), OPTIONAL :: name_len +!***** + + CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(1:LEN(name)+1), TARGET :: c_name + TYPE(C_PTR) :: f_ptr + + INTERFACE + INTEGER(SIZE_T) FUNCTION h5pget_virtual_dsetname(dcpl_id, index, name, size) BIND(C, NAME='H5Pget_virtual_dsetname') + IMPORT :: HID_T, SIZE_T, C_PTR, C_CHAR + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN), VALUE :: dcpl_id + INTEGER(SIZE_T), INTENT(IN), VALUE :: index + TYPE(C_PTR), VALUE :: name + INTEGER(SIZE_T), INTENT(IN), VALUE :: size + END FUNCTION h5pget_virtual_dsetname + END INTERFACE + + hdferr = 0 + IF(PRESENT(name_len))THEN + name_len = INT(h5pget_virtual_dsetname(dcpl_id, index, C_NULL_PTR, 0_SIZE_T), SIZE_T) + IF(name_len.LT.0) hdferr = -1 + ELSE + f_ptr = C_LOC(c_name(1)(1:1)) + + IF(INT(h5pget_virtual_dsetname(dcpl_id, index, f_ptr, INT(LEN(name)+1,SIZE_T)), SIZE_T).LT.0)THEN + hdferr = -1 + ELSE + CALL HD5c2fstring(name,c_name,LEN(name)) + ENDIF + + ENDIF + +END SUBROUTINE h5pget_virtual_dsetname_f + END MODULE H5P diff --git a/fortran/src/H5Rff.F90 b/fortran/src/H5Rff.F90 index a90bd9a..7ba91c4 100644 --- a/fortran/src/H5Rff.F90 +++ b/fortran/src/H5Rff.F90 @@ -4,7 +4,7 @@ ! MODULE H5R ! ! FILE -! fortran/src/H5Rff.f90 +! fortran/src/H5Rff.F90 ! ! PURPOSE ! This file contains Fortran interfaces for H5R functions. diff --git a/fortran/src/H5Sff.F90 b/fortran/src/H5Sff.F90 index fd4226c..e9b9b73 100644 --- a/fortran/src/H5Sff.F90 +++ b/fortran/src/H5Sff.F90 @@ -4,7 +4,7 @@ ! MODULE H5S ! ! FILE -! fortran/src/H5Sff.f90 +! fortran/src/H5Sff.F90 ! ! PURPOSE ! This file contains Fortran interfaces for H5S functions. @@ -41,7 +41,7 @@ !***** MODULE H5S - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR, C_INT USE H5GLOBAL CONTAINS @@ -1751,4 +1751,118 @@ CONTAINS END SUBROUTINE h5sextent_equal_f +! +!****s* H5S/h5sget_regular_hyperslab_f +! +! NAME +! h5sget_regular_hyperslab_f +! +! PURPOSE +! Retrieves a regular hyperslab selection. +! +! INPUTS +! space_id - The identifier of the dataspace. +! OUTPUTS +! start - Offset of the start of the regular hyperslab. +! stride - Stride of the regular hyperslab. +! count - Number of blocks in the regular hyperslab. +! block - Size of a block in the regular hyperslab. +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! January, 28 2016 +! SOURCE + SUBROUTINE h5sget_regular_hyperslab_f(space_id, start, stride, count, block, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HSIZE_T), INTENT(OUT), DIMENSION(*), TARGET :: start + INTEGER(HSIZE_T), INTENT(OUT), DIMENSION(*), TARGET :: stride + INTEGER(HSIZE_T), INTENT(OUT), DIMENSION(*), TARGET :: count + INTEGER(HSIZE_T), INTENT(OUT), DIMENSION(*), TARGET :: block + INTEGER, INTENT(OUT) :: hdferr +!***** + TYPE(C_PTR) :: start_c, stride_c, count_c, block_c + INTEGER(C_INT) :: n + + INTERFACE + INTEGER FUNCTION h5sget_regular_hyperslab(space_id, start, stride, count, block) BIND(C,NAME='H5Sget_regular_hyperslab') + IMPORT :: HID_T, C_PTR + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: space_id + TYPE(C_PTR), VALUE :: start, stride, count, block + END FUNCTION h5sget_regular_hyperslab + END INTERFACE + + hdferr = 0 + + start_c = C_LOC(start(1)) + stride_c = C_LOC(stride(1)) + count_c = C_LOC(count(1)) + block_c = C_LOC(block(1)) + + IF(INT(h5sget_regular_hyperslab(space_id, start_c, stride_c, count_c, block_c)).LT.0) hdferr = -1 + + ! Reverse the C arrays description values of the hyperslab because + ! the hyperslab was for a C stored hyperslab + + CALL H5Sget_simple_extent_ndims_f(space_id,n,hdferr) + IF(hdferr.LT.0.OR.n.EQ.0)THEN + hdferr=-1 + ELSE + start(1:n) = start(n:1:-1) + stride(1:n) = stride(n:1:-1) + count(1:n) = count(n:1:-1) + block(1:n) = block(n:1:-1) + ENDIF + + END SUBROUTINE h5sget_regular_hyperslab_f + +!****s* H5S/h5sis_regular_hyperslab_f +! +! NAME +! h5sis_regular_hyperslab_f +! +! PURPOSE +! Retrieves a regular hyperslab selection. +! +! INPUTS +! space_id - The identifier of the dataspace. +! OUTPUTS +! IsRegular - TRUE or FALSE for hyperslab selection if successful. +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! January, 28 2016 +! SOURCE + SUBROUTINE h5sis_regular_hyperslab_f(space_id, IsRegular, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id + LOGICAL :: IsRegular + INTEGER, INTENT(OUT) :: hdferr +!***** + INTEGER(C_INT) :: status + + INTERFACE + INTEGER(C_INT) FUNCTION H5Sis_regular_hyperslab(space_id) BIND(C,NAME='H5Sis_regular_hyperslab') + IMPORT :: HID_T, C_INT + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: space_id + END FUNCTION H5Sis_regular_hyperslab + END INTERFACE + + status = H5Sis_regular_hyperslab(space_id) + + hdferr = 0 + IsRegular = .FALSE. + IF(status.GT.0)THEN + IsRegular = .TRUE. + ELSE IF(status.LT.0)THEN + hdferr = -1 + ENDIF + + END SUBROUTINE H5Sis_regular_hyperslab_f + END MODULE H5S diff --git a/fortran/src/H5_buildiface.F90 b/fortran/src/H5_buildiface.F90 index 9a42cbf..471052f 100644 --- a/fortran/src/H5_buildiface.F90 +++ b/fortran/src/H5_buildiface.F90 @@ -4,7 +4,7 @@ ! Executable: H5_buildiface ! ! FILE -! fortran/src/H5_buildiface.f90 +! fortran/src/H5_buildiface.F90 ! ! PURPOSE ! This stand alone program is used at build time to generate the module diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index f3bc42f..d7b952d 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -476,6 +476,10 @@ h5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags, h5d_flags[22] = (int_f)H5D_MPIO_CHUNK_COLLECTIVE; h5d_flags[23] = (int_f)H5D_MPIO_CHUNK_MIXED; h5d_flags[24] = (int_f)H5D_MPIO_CONTIGUOUS_COLLECTIVE; + h5d_flags[25] = (int_f)H5D_VDS_ERROR; + 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; /* * H5E flags diff --git a/fortran/src/H5f90.h b/fortran/src/H5f90.h index c45cfcb..7082d1d 100644 --- a/fortran/src/H5f90.h +++ b/fortran/src/H5f90.h @@ -22,7 +22,7 @@ #include "H5f90i.h" #include "H5f90proto.h" -/* Constants used in H5Rff.f90 and H5Rf.c files */ +/* Constants used in H5Rff.F90 and H5Rf.c files */ #define REF_REG_BUF_LEN_F 3 /* Constants used in H5Gf.c files */ diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90 index 947eff4..ac59251 100644 --- a/fortran/src/H5f90global.F90 +++ b/fortran/src/H5f90global.F90 @@ -4,7 +4,7 @@ ! MODULE H5GLOBAL ! ! FILE -! src/fortran/H5f90global.f90 +! src/fortran/H5f90global.F90 ! ! PURPOSE ! This module is used to pass C stubs for H5 Fortran APIs. The C stubs are @@ -46,12 +46,19 @@ MODULE H5GLOBAL IMPLICIT NONE + ! Enumerate data type that is interoperable with C. + ENUM, BIND(C) + ENUMERATOR :: enum_dtype + END ENUM + INTEGER, PARAMETER :: ENUM_T = KIND(enum_dtype) + + ! Definitions for reference datatypes. ! If you change the value of these parameters, do not forget to change corresponding ! values in the H5f90.h file. INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 - ! Parameters used in the function 'h5kind_to_type' located in H5_ff.f90. + ! Parameters used in the function 'h5kind_to_type' located in H5_ff.F90. ! The flag is used to tell the function whether the kind input variable ! is for a REAL or INTEGER data type. @@ -366,11 +373,11 @@ MODULE H5GLOBAL EQUIVALENCE(H5G_flags(10), H5G_STORAGE_TYPE_SYMBOL_TABLE_F) EQUIVALENCE(H5G_flags(11), H5G_STORAGE_TYPE_COMPACT_F) EQUIVALENCE(H5G_flags(12), H5G_STORAGE_TYPE_DENSE_F) + ! ! H5D flags declaration ! - - INTEGER, PARAMETER :: H5D_FLAGS_LEN = 25 + INTEGER, PARAMETER :: H5D_FLAGS_LEN = 29 INTEGER :: H5D_flags(H5D_FLAGS_LEN) INTEGER, PARAMETER :: H5D_SIZE_FLAGS_LEN = 2 INTEGER(SIZE_T) :: H5D_size_flags(H5D_SIZE_FLAGS_LEN) @@ -418,6 +425,10 @@ MODULE H5GLOBAL INTEGER :: H5D_MPIO_CHUNK_COLLECTIVE_F INTEGER :: H5D_MPIO_CHUNK_MIXED_F INTEGER :: H5D_MPIO_CONTIG_COLLECTIVE_F + INTEGER :: H5D_VDS_ERROR_F + INTEGER :: H5D_VDS_FIRST_MISSING_F + INTEGER :: H5D_VDS_LAST_AVAILABLE_F + INTEGER :: H5D_VIRTUAL_F EQUIVALENCE(H5D_flags(1), H5D_COMPACT_F) EQUIVALENCE(H5D_flags(2), H5D_CONTIGUOUS_F) @@ -449,6 +460,10 @@ MODULE H5GLOBAL EQUIVALENCE(H5D_flags(23), H5D_MPIO_CHUNK_COLLECTIVE_F) EQUIVALENCE(H5D_flags(24), H5D_MPIO_CHUNK_MIXED_F) EQUIVALENCE(H5D_flags(25), H5D_MPIO_CONTIG_COLLECTIVE_F) + EQUIVALENCE(H5D_flags(26), H5D_VDS_ERROR_F) + EQUIVALENCE(H5D_flags(27), H5D_VDS_FIRST_MISSING_F) + EQUIVALENCE(H5D_flags(28), H5D_VDS_LAST_AVAILABLE_F) + EQUIVALENCE(H5D_flags(29), H5D_VIRTUAL_F) EQUIVALENCE(H5D_size_flags(1), H5D_CHUNK_CACHE_NSLOTS_DFLT_F) EQUIVALENCE(H5D_size_flags(2), H5D_CHUNK_CACHE_NBYTES_DFLT_F) diff --git a/fortran/src/H5fortkit.F90 b/fortran/src/H5fortkit.F90 new file mode 100644 index 0000000..9afd890 --- /dev/null +++ b/fortran/src/H5fortkit.F90 @@ -0,0 +1,58 @@ +!****h* H5fortkit/H5fortkit +! PURPOSE +! Routines to deal with C-FORTRAN issues. +! +! COPYRIGHT +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +MODULE H5fortkit + +CONTAINS + +!****if* H5fortkit/HD5c2fstring +! NAME +! HD5c2fstring +! INPUTS +! cstring - C string stored as a string array of size 'len' of string size LEN=1 +! len - length of Fortran string +! OUTPUT +! fstring - Fortran string array of LEN=1 +! PURPOSE +! Copies a Fortran array of strings having a length of one to a fortran string and removes the C Null +! terminator. The Null terminator is returned from C when calling the C APIs directly. +! +! The fortran standard does not allow C_LOC to be used on a character string of +! length greater than one, which is why we use the array of characters instead. +! +! SOURCE + SUBROUTINE HD5c2fstring(fstring,cstring,len) +!***** + IMPLICIT NONE + + INTEGER :: i + INTEGER :: len + CHARACTER(LEN=len) :: fstring + CHARACTER(LEN=1), DIMENSION(1:len) :: cstring + + fstring = '' + DO i = 1, len + IF (cstring(i)(1:1)==CHAR(0)) EXIT + fstring(i:i) = cstring(i)(1:1) + END DO + + END SUBROUTINE HD5c2fstring + +END MODULE H5fortkit diff --git a/fortran/src/HDF5.F90 b/fortran/src/HDF5.F90 index 64f5be6..cbe4c83 100644 --- a/fortran/src/HDF5.F90 +++ b/fortran/src/HDF5.F90 @@ -4,7 +4,7 @@ ! MODULE HDF5 ! ! FILE -! src/fortran/src/HDF5.f90 +! src/fortran/src/HDF5.F90 ! ! PURPOSE ! This is the main module used for linking to the Fortran HDF library. diff --git a/fortran/src/Makefile.am b/fortran/src/Makefile.am index eb45f60..f4d192b 100644 --- a/fortran/src/Makefile.am +++ b/fortran/src/Makefile.am @@ -46,9 +46,9 @@ endif libhdf5_fortran_la_SOURCES=H5f90global.F90 \ H5fortran_types.F90 H5_ff.F90 H5Aff.F90 H5Dff.F90 H5Eff.F90 \ H5Fff.F90 H5Gff.F90 H5Iff.F90 H5Lff.F90 H5Off.F90 H5Pff.F90 H5Rff.F90 H5Sff.F90 \ - H5Tff.F90 H5Zff.F90 H5_gen.f90 \ + H5Tff.F90 H5Zff.F90 H5_gen.F90 H5fortkit.F90 \ H5f90kit.c H5_f.c H5Af.c H5Df.c H5Ef.c H5Ff.c H5Gf.c \ - H5If.c H5Lf.c H5Of.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c HDF5.f90 + H5If.c H5Lf.c H5Of.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c HDF5.F90 # HDF5 Fortran library depends on HDF5 Library. libhdf5_fortran_la_LIBADD=$(LIBHDF5) @@ -153,7 +153,7 @@ H5Gff.lo: $(srcdir)/H5Gff.F90 H5f90global.lo H5Iff.lo: $(srcdir)/H5Iff.F90 H5f90global.lo H5Lff.lo: $(srcdir)/H5Lff.F90 H5f90global.lo H5Off.lo: $(srcdir)/H5Off.F90 H5f90global.lo -H5Pff.lo: $(srcdir)/H5Pff.F90 H5f90global.lo +H5Pff.lo: $(srcdir)/H5Pff.F90 H5f90global.lo H5fortkit.lo H5Rff.lo: $(srcdir)/H5Rff.F90 H5f90global.lo H5Sff.lo: $(srcdir)/H5Sff.F90 H5f90global.lo H5Tff.lo: $(srcdir)/H5Tff.F90 H5f90global.lo diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 1333262..42b5642 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -318,6 +318,16 @@ H5P_mp_H5PREGISTER_PTR H5P_mp_H5PINSERT_PTR H5P_mp_H5PGET_FILE_IMAGE_F H5P_mp_H5PSET_FILE_IMAGE_F +H5P_mp_H5PSET_VIRTUAL_VIEW_F +H5P_mp_H5PGET_VIRTUAL_VIEW_F +H5P_mp_H5PSET_VIRTUAL_PRINTF_GAP_F +H5P_mp_H5PGET_VIRTUAL_PRINTF_GAP_F +H5P_mp_H5PSET_VIRTUAL_F +H5P_mp_H5PGET_VIRTUAL_COUNT_F +H5P_mp_H5PGET_VIRTUAL_VSPACE_F +H5P_mp_H5PGET_VIRTUAL_SRCSPACE_F +H5P_mp_H5PGET_VIRTUAL_FILENAME_F +H5P_mp_H5PGET_VIRTUAL_DSETNAME_F ; Parallel @H5_NOPAREXP@H5P_mp_H5PSET_FAPL_MPIO_F @H5_NOPAREXP@H5P_mp_H5PGET_FAPL_MPIO_F @@ -367,6 +377,8 @@ H5S_mp_H5SGET_SELECT_TYPE_F H5S_mp_H5SDECODE_F H5S_mp_H5SENCODE_F H5S_mp_H5SEXTENT_EQUAL_F +H5S_mp_H5SGET_REGULAR_HYPERSLAB_F +H5S_mp_H5SIS_REGULAR_HYPERSLAB_F ; H5T H5T_mp_H5TOPEN_F H5T_mp_H5TCOMMIT_F diff --git a/fortran/test/fortranlib_test_F03.F90 b/fortran/test/fortranlib_test_F03.F90 index 5b386b9..070cd73 100644 --- a/fortran/test/fortranlib_test_F03.F90 +++ b/fortran/test/fortranlib_test_F03.F90 @@ -174,6 +174,14 @@ PROGRAM fortranlibtest_F03 CALL test_get_file_image(ret_total_error) CALL write_test_status(ret_total_error, ' Testing get file image ', total_error) +! write(*,*) +! write(*,*) '=========================================' +! write(*,*) 'Testing VDS ' +! write(*,*) '=========================================' + + ret_total_error = 0 + CALL test_vds(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing vds ', total_error) WRITE(*,*) diff --git a/fortran/test/tH5P_F03.F90 b/fortran/test/tH5P_F03.F90 index 8982fc2..3cafdcb 100644 --- a/fortran/test/tH5P_F03.F90 +++ b/fortran/test/tH5P_F03.F90 @@ -617,4 +617,476 @@ SUBROUTINE external_test_offset(cleanup,total_error) CALL check("h5_cleanup_f", error, total_error) END SUBROUTINE external_test_offset + +!****h* root/fortran/test/tH5P_F03.f90 +! +! NAME +! test_vds +! +! FUNCTION +! Tests VDS API wrappers +! +! RETURNS: +! Success: 0 +! Failure: number of errors +! +! FORTRAN Programmer: M. Scot Breitenfeld +! February 1, 2016 +! +!------------------------------------------------------------------------- +! +SUBROUTINE test_vds(total_error) + + USE ISO_C_BINDING + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error + + INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors + INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors + + CHARACTER(LEN=6), PARAMETER :: VFILENAME="vds.h5" + CHARACTER(LEN=3), PARAMETER :: DATASET="VDS" + INTEGER :: VDSDIM0 + INTEGER, PARAMETER :: VDSDIM1 = 10 + INTEGER, PARAMETER :: VDSDIM2 = 15 + + INTEGER :: DIM0 + INTEGER, PARAMETER :: DIM0_1= 4 ! Initial size of the source datasets + INTEGER, PARAMETER :: DIM1 = 10 + INTEGER, PARAMETER :: DIM2 = 15 + INTEGER, PARAMETER :: RANK = 3 + INTEGER(hsize_t), PARAMETER :: PLANE_STRIDE = 4 + + CHARACTER(LEN=4), DIMENSION(1:PLANE_STRIDE) :: SRC_FILE = (/"a.h5","b.h5","c.h5","d.h5"/) + CHARACTER(LEN=3), DIMENSION(1:PLANE_STRIDE) :: SRC_DATASET = (/"AAA","BBB","CCC","DDD"/) + + + INTEGER(hid_t) :: vfile, file, src_space, mem_space, vspace, vdset, dset !Handles + INTEGER(hid_t) :: dcpl, dapl + INTEGER :: status, error + INTEGER(hsize_t), DIMENSION(1:3) :: vdsdims = (/4*DIM0_1, VDSDIM1, VDSDIM2/), & + vdsdims_max, & + dims = (/DIM0_1, DIM1, DIM2/), & + memdims = (/DIM0_1, DIM1, DIM2/), & + extdims = (/0, DIM1, DIM2/), & ! Dimensions of the extended source datasets + chunk_dims = (/DIM0_1, DIM1, DIM2/), & + dims_max, & + vdsdims_out, vdsdims_max_out, & + start, & ! Hyperslab parameters + stride, & + count, & + src_count, block + INTEGER(hsize_t), DIMENSION(1:2,1:3) :: vdsdims_out_correct + + INTEGER(hsize_t), DIMENSION(1:3) :: start_out, & !Hyperslab PARAMETER out + stride_out, count_out, count_correct, block_out + INTEGER(hsize_t), DIMENSION(1:3,1:PLANE_STRIDE) :: start_correct + + INTEGER :: i, j + INTEGER :: layout ! Storage layout + INTEGER(size_t) :: num_map ! Number of mappings + INTEGER(size_t) :: len ! Length of the string also a RETURN value + CHARACTER(LEN=180) :: filename + ! Different sized character buffers + CHARACTER(len=LEN(SRC_FILE(1))-3) :: SRC_FILE_LEN_TINY + CHARACTER(len=LEN(SRC_FILE(1))-1) :: SRC_FILE_LEN_SMALL + CHARACTER(len=LEN(SRC_FILE(1))) :: SRC_FILE_LEN_EXACT + CHARACTER(len=LEN(SRC_FILE(1))+1) :: SRC_FILE_LEN_LARGE + CHARACTER(len=LEN(SRC_FILE(1))+10) :: SRC_FILE_LEN_HUGE + CHARACTER(len=LEN(SRC_DATASET(1))) :: SRC_DATASET_LEN_EXACT + + INTEGER(HID_T) :: space_out + + INTEGER :: s_type, virtual_view + INTEGER :: type1, type2 + + CHARACTER(LEN=180) :: dsetname + INTEGER, DIMENSION(DIM0_1*DIM1*DIM2), TARGET :: wdata + TYPE(C_PTR) :: f_ptr + INTEGER(SIZE_T) :: nsize + LOGICAL :: IsRegular + INTEGER(HSIZE_T) :: gap_size + + ! For testing against + vdsdims_out_correct(1,1) = DIM0_1*5 + vdsdims_out_correct(2,1) = DIM0_1*8 + vdsdims_out_correct(1:2,2) = VDSDIM1 + vdsdims_out_correct(1:2,3) = VDSDIM2 + + VDSDIM0 = H5S_UNLIMITED_F + DIM0 = H5S_UNLIMITED_F + vdsdims_max = (/VDSDIM0, VDSDIM1, VDSDIM2/) + dims_max = (/DIM0, DIM1, DIM2/) + + ! + ! Create source files and datasets. + ! + DO i = 1, PLANE_STRIDE + ! + ! Initialize data for i-th source dataset. + DO j = 1, DIM0_1*DIM1*DIM2 + wdata(j) = i + ENDDO + ! + ! Create the source files and datasets. Write data to each dataset and + ! close all resources. + CALL h5fcreate_f(SRC_FILE(i), H5F_ACC_TRUNC_F, file, status) + CALL check("h5fcreate_f", error, total_error) + + CALL h5screate_simple_f(RANK, dims, src_space, error, dims_max) + 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, RANK, chunk_dims, error) + CALL check("h5pset_chunk_f",error, total_error) + + CALL h5dcreate_f(file, SRC_DATASET(i), H5T_NATIVE_INTEGER, src_space, dset, error, dcpl, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5dcreate_f",error, total_error) + f_ptr = C_LOC(wdata(1)) + CALL H5Dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, error) + CALL check("H5Dwrite_f",error, total_error) + CALL H5Sclose_f(src_space, error) + CALL check("H5Sclose_f",error, total_error) + CALL H5Pclose_f(dcpl, error) + CALL check("H5Pclose_f",error, total_error) + CALL H5Dclose_f(dset, error) + CALL check("H5Dclose_f",error, total_error) + CALL H5Fclose_f(file, error) + CALL check("H5Fclose_f",error, total_error) + ENDDO + + CALL h5fcreate_f(VFILENAME, H5F_ACC_TRUNC_F, vfile, error) + CALL check("h5fcreate_f", error, total_error) + + ! Create VDS dataspace. + CALL H5Screate_simple_f(RANK, vdsdims, vspace, error, vdsdims_max) + CALL check("H5Screate_simple_f", error, total_error) + + ! Create dataspaces for the source dataset. + CALL H5Screate_simple_f(RANK, dims, src_space, error, dims_max) + CALL check("H5Screate_simple_f", error, total_error) + + ! Create VDS creation property + CALL H5Pcreate_f (H5P_DATASET_CREATE_F, dcpl, error) + CALL check("H5Pcreate_f", error, total_error) + + ! Initialize hyperslab values + start(1:3) = 0 + stride(1:3) = (/PLANE_STRIDE,1_hsize_t,1_hsize_t/) ! we will select every fifth plane in VDS + count(1:3) = (/H5S_UNLIMITED_F,1_hsize_t,1_hsize_t/) + src_count(1:3) = (/H5S_UNLIMITED_F,1_hsize_t,1_hsize_t/) + block(1:3) = (/1, DIM1, DIM2/) + + ! + ! Build the mappings + ! + start_correct = 0 + CALL H5Sselect_hyperslab_f(src_space, H5S_SELECT_SET_F, start, src_count, error, block=block) + CALL check("H5Sselect_hyperslab_f", error, total_error) + DO i = 1, PLANE_STRIDE + start_correct(1,i) = start(1) + CALL H5Sselect_hyperslab_f(vspace, H5S_SELECT_SET_F, start, count, error, stride=stride, block=block) + CALL check("H5Sselect_hyperslab_f", error, total_error) + + IF(i.eq.1)THEN ! check src_file and src_dataset with trailing blanks + CALL H5Pset_virtual_f (dcpl, vspace, SRC_FILE(i)//" ", SRC_DATASET(i)//" ", src_space, error) + ELSE + CALL H5Pset_virtual_f (dcpl, vspace, SRC_FILE(i), SRC_DATASET(i), src_space, error) + ENDIF + CALL check("H5Pset_virtual_f", error, total_error) + start(1) = start(1) + 1 + ENDDO + + CALL H5Sselect_none_f(vspace, error) + CALL check("H5Sselect_none_f", error, total_error) + + ! Create a virtual dataset + CALL H5Dcreate_f(vfile, DATASET, H5T_NATIVE_INTEGER, vspace, vdset, error, dcpl, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("H5Dcreate_f", error, total_error) + CALL H5Sclose_f(vspace, error) + CALL check("H5Sclose_f", error, total_error) + CALL H5Sclose_f(src_space, error) + CALL check("H5Sclose_f", error, total_error) + CALL H5Pclose_f(dcpl, error) + CALL check("H5Pclose_f", error, total_error) + + ! Let's add data to the source datasets and check new dimensions for VDS + ! We will add only one plane to the first source dataset, two planes to the + ! second one, three to the third, and four to the forth. + + DO i = 1, PLANE_STRIDE + ! + ! Initialize data for i-th source dataset. + DO j = 1, i*DIM1*DIM2 + wdata(j) = 10*i + ENDDO + + ! + ! Open the source files and datasets. Append data to each dataset and + ! close all resources. + CALL H5Fopen_f (SRC_FILE(i), H5F_ACC_RDWR_F, file, error) + CALL check("H5Fopen_f", error, total_error) + CALL H5Dopen_f (file, SRC_DATASET(i), dset, error) + CALL check("H5Dopen_f", error, total_error) + extdims(1) = DIM0_1+i + CALL H5Dset_extent_f(dset, extdims, error) + CALL check("H5Dset_extent_f", error, total_error) + CALL H5Dget_space_f(dset, src_space, error) + CALL check("H5Dget_space_f", error, total_error) + + start(1:3) = (/DIM0_1,0,0/) + count(1:3) = 1 + block(1:3) = (/i, DIM1, DIM2/) + + memdims(1) = i + + CALL H5Screate_simple_f(RANK, memdims, mem_space, error) + CALL check("H5Screate_simple_f", error, total_error) + + CALL H5Sselect_hyperslab_f(src_space, H5S_SELECT_SET_F, start,count, error,block=block) + CALL check("H5Sselect_hyperslab_f", error, total_error) + f_ptr = C_LOC(wdata(1)) + CALL H5Dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, error, mem_space, src_space, H5P_DEFAULT_F) + CALL check("H5Dwrite_f", error, total_error) + CALL H5Sclose_f(src_space, error) + CALL check("H5Sclose_f", error, total_error) + call H5Dclose_f(dset, error) + CALL check("H5Dclose_f", error, total_error) + call H5Fclose_f(file, error) + CALL check("H5Fclose_f", error, total_error) + ENDDO + + call H5Dclose_f(vdset, error) + CALL check("H5Dclose_f", error, total_error) + call H5Fclose_f(vfile, error) + CALL check("H5Fclose_f", error, total_error) + + ! + ! begin the read section + ! + ! Open file and dataset using the default properties. + CALL H5Fopen_f(VFILENAME, H5F_ACC_RDONLY_F, vfile, error) + CALL check("H5Fopen_f", error, total_error) + + ! + ! Open VDS using different access properties to use max or + ! min extents depending on the sizes of the underlying datasets + CALL H5Pcreate_f(H5P_DATASET_ACCESS_F, dapl, error) + CALL check("H5Pcreate_f", error, total_error) + + DO i = 1, 2 + + IF(i.NE.1)THEN + CALL H5Pset_virtual_view_f(dapl, H5D_VDS_LAST_AVAILABLE_F, error) + CALL check("H5Pset_virtual_view_f", error, total_error) + ELSE + CALL H5Pset_virtual_view_f(dapl, H5D_VDS_FIRST_MISSING_F, error) + CALL check("H5Pset_virtual_view_f", error, total_error) + ENDIF + + CALL H5Dopen_f(vfile, DATASET, vdset, error, dapl) + CALL check("H5Dopen_f", error, total_error) + + ! Let's get space of the VDS and its dimension we should get 32(or 20)x10x10 + CALL H5Dget_space_f(vdset, vspace, error) + CALL check("H5Dget_space_f", error, total_error) + CALL H5Sget_simple_extent_dims_f(vspace, vdsdims_out, vdsdims_max_out, error) + CALL check("H5Sget_simple_extent_dims_f", error, total_error) + + ! check VDS dimensions + DO j = 1, RANK + IF(vdsdims_out(j).NE.vdsdims_out_correct(i,j))THEN + total_error = total_error + 1 + EXIT + ENDIF + ENDDO + + CALL H5Pget_virtual_view_f(dapl, virtual_view, error) + CALL check("h5pget_virtual_view_f", error, total_error) + + IF(i.EQ.1)THEN + IF(virtual_view .NE. H5D_VDS_FIRST_MISSING_F)THEN + total_error = total_error + 1 + ENDIF + ELSE + IF(virtual_view .NE. H5D_VDS_LAST_AVAILABLE_F)THEN + total_error = total_error + 1 + ENDIF + + ENDIF + + ! Close + CALL H5Dclose_f(vdset, error) + CALL check("H5Dclose_f", error, total_error) + CALL H5Sclose_f(vspace, error) + CALL check("H5Sclose_f", error, total_error) + ENDDO + + CALL H5Dopen_f(vfile, DATASET, vdset, error) + CALL check("H5Dopen_f", error, total_error) + + ! + ! Get creation property list and mapping properties. + ! + CALL H5Dget_create_plist_f (vdset, dcpl, error) + CALL check("H5Dget_create_plist_f", error, total_error) + + ! + ! Get storage layout. + CALL H5Pget_layout_f(dcpl, layout, error) + CALL check("H5Pget_layout_f", error, total_error) + + IF (H5D_VIRTUAL_F .NE. layout) THEN + PRINT*,"Wrong layout found" + total_error = total_error + 1 + ENDIF + + ! + ! Find number of mappings. + + CALL H5Pget_virtual_count_f(dcpl, num_map, error) + CALL check("H5Pget_virtual_count_f", error, total_error) + + IF(num_map.NE.4_size_t)THEN + PRINT*,"Number of mappings is incorrect" + total_error = total_error + 1 + ENDIF + ! + ! Get mapping parameters for each mapping. + ! + DO i = 1, num_map + CALL H5Pget_virtual_vspace_f(dcpl, INT(i-1,size_t), vspace, error) + CALL check("H5Pget_virtual_vspace_f", error, total_error) + + CALL h5sget_select_type_f(vspace, s_type, error) + CALL check("h5sget_select_type_f", error, total_error) + IF(s_type.EQ.H5S_SEL_HYPERSLABS_F)THEN + CALL H5Sis_regular_hyperslab_f(vspace, IsRegular, error) + CALL check("H5Sis_regular_hyperslab_f", error, total_error) + + IF(IsRegular)THEN + CALL H5Sget_regular_hyperslab_f(vspace, start_out, stride_out, count_out, block_out, error) + CALL check("H5Sget_regular_hyperslab_f", error, total_error) + DO j = 1, 3 + IF(start_out(j).NE.start_correct(j,i) .OR. & + stride_out(j).NE.stride(j).OR. & + count_out(j).NE.src_count(j))THEN + total_error = total_error + 1 + EXIT + ENDIF + ENDDO + ENDIF + END IF + + ! Get source file name + CALL H5Pget_virtual_filename_f(dcpl, INT(i-1, size_t), SRC_FILE_LEN_EXACT, error, nsize) + CALL check("H5Pget_virtual_count_f", error, total_error) + + IF(nsize.NE.LEN(SRC_FILE_LEN_EXACT))THEN + PRINT*,"virtual filenname size is incorrect" + total_error = total_error + 1 + ENDIF + ! check passing a buffer that is very small + CALL H5Pget_virtual_filename_f(dcpl, INT(i-1, size_t), SRC_FILE_LEN_TINY, error) + CALL check("H5Pget_virtual_filename_f", error, total_error) + IF(SRC_FILE_LEN_TINY.NE.SRC_FILE(i)(1:LEN(SRC_FILE_LEN_TINY)))THEN + PRINT*,"virtual filenname returned is incorrect" + total_error = total_error + 1 + ENDIF + ! check passing a buffer that small by one + CALL H5Pget_virtual_filename_f(dcpl, INT(i-1, size_t), SRC_FILE_LEN_SMALL, error) + CALL check("H5Pget_virtual_filename_f", error, total_error) + IF(SRC_FILE_LEN_SMALL.NE.SRC_FILE(i)(1:LEN(SRC_FILE_LEN_SMALL)))THEN + PRINT*,"virtual filenname returned is incorrect" + total_error = total_error + 1 + ENDIF + ! check passing a buffer that is exact + CALL H5Pget_virtual_filename_f(dcpl, INT(i-1, size_t), SRC_FILE_LEN_EXACT, error) + CALL check("H5Pget_virtual_filename_f", error, total_error) + IF(SRC_FILE_LEN_EXACT.NE.SRC_FILE(i)(1:LEN(SRC_FILE_LEN_EXACT)))THEN + PRINT*,"virtual filenname returned is incorrect" + total_error = total_error + 1 + ENDIF + ! check passing a buffer that bigger by one + CALL H5Pget_virtual_filename_f(dcpl, INT(i-1, size_t), SRC_FILE_LEN_LARGE, error) + CALL check("H5Pget_virtual_filename_f", error, total_error) + IF(SRC_FILE_LEN_LARGE(1:LEN(SRC_FILE_LEN_EXACT)).NE.SRC_FILE(i)(1:LEN(SRC_FILE_LEN_EXACT)).AND. & + SRC_FILE_LEN_LARGE(LEN(SRC_FILE_LEN_EXACT):).NE.'')THEN + PRINT*,"virtual filenname returned is incorrect" + total_error = total_error + 1 + ENDIF + ! check passing a buffer that is very big + CALL H5Pget_virtual_filename_f(dcpl, INT(i-1, size_t), SRC_FILE_LEN_HUGE, error) + CALL check("H5Pget_virtual_filename_f", error, total_error) + IF(SRC_FILE_LEN_HUGE(1:LEN(SRC_FILE_LEN_EXACT)).NE.SRC_FILE(i)(1:LEN(SRC_FILE_LEN_EXACT)).AND. & + SRC_FILE_LEN_HUGE(LEN(SRC_FILE_LEN_EXACT):).NE.'')THEN + PRINT*,"virtual filenname returned is incorrect" + total_error = total_error + 1 + ENDIF + ! Get source dataset name + CALL H5Pget_virtual_dsetname_f(dcpl, INT(i-1, size_t), SRC_DATASET_LEN_EXACT, error, nsize) + CALL check("H5Pget_virtual_dsetname_f", error, total_error) + + CALL H5Pget_virtual_dsetname_f(dcpl, INT(i-1, size_t), SRC_DATASET_LEN_EXACT, error) + CALL check("H5Pget_virtual_dsetname_f", error, total_error) + IF(SRC_DATASET_LEN_EXACT(1:LEN(SRC_DATASET_LEN_EXACT)).NE.SRC_DATASET(i)(1:LEN(SRC_DATASET_LEN_EXACT)).AND. & + SRC_DATASET_LEN_EXACT(LEN(SRC_DATASET_LEN_EXACT):).NE.'')THEN + PRINT*,"virtual dataset returned is incorrect" + total_error = total_error + 1 + ENDIF + + CALL h5pget_virtual_srcspace_f(dcpl, INT(i-1,size_t), space_out, error) + CALL check("H5Pget_virtual_srcspace_f", error, total_error) + + CALL h5sget_select_type_f(space_out, type1, error) + CALL check("H5Sget_select_type_f", error, total_error) + CALL h5sget_select_type_f(vspace, type2, error) + CALL check("H5Sget_select_type_f", error, total_error) + + IF(type1.NE.type2)THEN + total_error = total_error + 1 + ENDIF + + ENDDO + ! + ! Close and release resources. + + ! Clear virtual layout in DCPL + CALL h5pset_layout_f(dcpl, H5D_VIRTUAL_F,error) + CALL check("H5Pset_layout_f", error, total_error) + + CALL H5Pclose_f(dcpl, error) + CALL check("H5Pclose_f", error, total_error) + CALL H5Dclose_f(vdset, error) + CALL check("H5Dclose_f", error, total_error) + + ! Reopen VDS with printf gap set to 1 + + CALL H5Pset_virtual_printf_gap_f(dapl, 1_hsize_t, error) + CALL check("H5Pset_virtual_printf_gap_f", error, total_error) + + CALL H5Dopen_f(vfile, DATASET, vdset, error, dapl) + CALL check("H5Dopen_f", error, total_error) + + CALL H5Pget_virtual_printf_gap_f(dapl, gap_size, error) + CALL check("H5Pget_virtual_printf_gap_f", error, total_error) + + IF(gap_size.NE.1_hsize_t)THEN + PRINT*,"gapsize is incorrect" + total_error = total_error + 1 + ENDIF + + CALL H5Dclose_f(vdset, error) + CALL check("H5Dclose_f", error, total_error) + CALL H5Sclose_f(vspace, error) + CALL check("H5Sclose_f", error, total_error) + CALL H5Pclose_f(dapl, error) + CALL check("H5Pclose_f", error, total_error) + CALL H5Fclose_f(vfile, error) + CALL check("H5Fclose_f", error, total_error) + +END SUBROUTINE test_vds + + END MODULE TH5P_F03 |