[svn-r29062] HDFFV-9564: Implement VDS Fortran wrappers.

Tested: h5committest.new

1 files changed, 472 insertions, 0 deletions

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