!****h* root/fortran/test/tH5Sselect.f90 ! ! NAME ! tH5Sselect.f90 ! ! FUNCTION ! Basic testing of Fortran H5S, Selection-related Dataspace Interface, APIs. ! ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! 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 COPYING file, which can be found at the root of the source code * ! distribution tree, or in https://www.hdfgroup.org/licenses. * ! If you do not have access to either file, you may request a copy from * ! help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! NOTES ! Tests the following functionalities: ! h5sget_select_npoints_f, h5sselect_elements_f, h5sselect_all_f, ! h5sselect_none_f, h5sselect_valid_f, h5sselect_hyperslab_f, ! h5sget_select_bounds_f, h5sget_select_elem_pointlist_f, ! h5sget_select_elem_npoints_f, h5sget_select_hyper_blocklist_f, ! h5sget_select_hyper_nblocks_f, h5sget_select_npoints_f ! ! CONTAINS SUBROUTINES ! test_select_hyperslab, test_select_element, test_basic_select, ! test_select_point, test_select_combine, test_select_bounds ! ! !***** MODULE TH5SSELECT USE HDF5 ! This module contains all necessary modules USE TH5_MISC USE TH5_MISC_GEN CONTAINS SUBROUTINE test_select_hyperslab(cleanup, total_error) IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error CHARACTER(LEN=7), PARAMETER :: filename = "tselect" CHARACTER(LEN=80) :: fix_filename ! !dataset name is "IntArray" ! CHARACTER(LEN=8), PARAMETER :: dsetname = "IntArray" INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dataspace ! Dataspace identifier INTEGER(HID_T) :: memspace ! memspace identifier ! !Memory space dimensions ! INTEGER(HSIZE_T), DIMENSION(3) :: dimsm = (/7,7,3/) ! !Dataset dimensions ! INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/5,6/) ! !Size of the hyperslab in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: count = (/3,4/) ! !hyperslab offset in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: offset = (/1,2/) ! !Size of the hyperslab in memory ! INTEGER(HSIZE_T), DIMENSION(3) :: count_out = (/3,4,1/) ! !hyperslab offset in memory ! INTEGER(HSIZE_T), DIMENSION(3) :: offset_out = (/3,0,0/) ! !data to write ! INTEGER, DIMENSION(5,6) :: data ! !output buffer ! INTEGER, DIMENSION(7,7,3) :: data_out ! !dataset space rank ! INTEGER :: dsetrank = 2 ! !memspace rank ! INTEGER :: memrank = 3 ! !general purpose integer ! INTEGER :: i, j ! !flag to check operation success ! INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims ! !This writes data to the HDF5 file. ! ! !data initialization ! do i = 1, 5 do j = 1, 6 data(i,j) = (i-1) + (j-1); end do end do ! ! 0, 1, 2, 3, 4, 5 ! 1, 2, 3, 4, 5, 6 ! 2, 3, 4, 5, 6, 7 ! 3, 4, 5, 6, 7, 8 ! 4, 5, 6, 7, 8, 9 ! ! !Initialize FORTRAN predefined datatypes ! ! CALL h5init_types_f(error) ! CALL check("h5init_types_f", error, total_error) ! !Create a new file using default properties. ! CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) if (error .ne. 0) then write(*,*) "Cannot modify filename" stop endif CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f", error, total_error) ! !Create the data space for the dataset. ! CALL h5screate_simple_f(dsetrank, dimsf, dataspace, error) CALL check("h5screate_simple_f", error, total_error) ! ! Create the dataset with default properties ! CALL h5dcreate_f(file_id, dsetname, H5T_STD_I32BE, dataspace, & dset_id, error) CALL check("h5dcreate_f", error, total_error) ! ! Write the dataset ! data_dims(1) = 5 data_dims(2) = 6 CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, data_dims, error) CALL check("h5dwrite_f", error, total_error) ! !Close the dataspace for the dataset. ! CALL h5sclose_f(dataspace, error) CALL check("h5sclose_f", error, total_error) ! !Close the dataset. ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) ! !Close the file. ! CALL h5fclose_f(file_id, error) CALL check("h5fclose_f", error, total_error) ! !This reads the hyperslab from the sds.h5 file just !created, into a 2-dimensional plane of the 3-dimensional array. ! ! !initialize data_out array ! ! do i = 1, 7 ! do j = 1, 7 ! do k = 1,3 ! data_out(i,j,k) = 0; ! end do ! end do ! end do ! !Open the file. ! CALL h5fopen_f (fix_filename, H5F_ACC_RDONLY_F, file_id, error) CALL check("h5fopen_f", error, total_error) ! !Open the dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f", error, total_error) ! !Get dataset's dataspace handle. ! CALL h5dget_space_f(dset_id, dataspace, error) CALL check("h5dget_space_f", error, total_error) ! !Select hyperslab in the dataset. ! CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, & offset, count, error) CALL check("h5sselect_hyperslab_f", error, total_error) ! !create memory dataspace. ! CALL h5screate_simple_f(memrank, dimsm, memspace, error) CALL check("h5screate_simple_f", error, total_error) ! !Select hyperslab in memory. ! CALL h5sselect_hyperslab_f(memspace, H5S_SELECT_SET_F, & offset_out, count_out, error) CALL check("h5sselect_hyperslab_f", error, total_error) ! !Read data from hyperslab in the file into the hyperslab in !memory and display. ! data_dims(1) = 7 data_dims(2) = 7 data_dims(3) = 3 CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, & memspace, dataspace) CALL check("h5dread_f", error, total_error) ! !Display data_out array ! !do i = 1, 7 ! print *, (data_out(i,j,1), j = 1,7) !end do ! 0 0 0 0 0 0 0 ! 0 0 0 0 0 0 0 ! 0 0 0 0 0 0 0 ! 3 4 5 6 0 0 0 ! 4 5 6 7 0 0 0 ! 5 6 7 8 0 0 0 ! 0 0 0 0 0 0 0 ! ! !Close the dataspace for the dataset. ! CALL h5sclose_f(dataspace, error) CALL check("h5sclose_f", error, total_error) ! !Close the memoryspace. ! CALL h5sclose_f(memspace, error) CALL check("h5sclose_f", error, total_error) ! !Close the dataset. ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) ! !Close the file. ! CALL h5fclose_f(file_id, error) CALL check("h5fclose_f", error, total_error) if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) RETURN END SUBROUTINE test_select_hyperslab ! ! Subroutine to test selection iterations ! SUBROUTINE test_select_iter(cleanup, total_error) IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error INTEGER, PARAMETER :: POINT1_NPOINTS = 10 INTEGER(SIZE_T), PARAMETER :: SEL_ITER_MAX_SEQ = 256 ! Information for testing selection iterators INTEGER, PARAMETER :: rank = 2 INTEGER(SIZE_T), PARAMETER :: NUMP = 4 INTEGER(hsize_t), DIMENSION(2) :: dims1 = (/12, 6/) ! 2-D Dataspace dimensions INTEGER(HID_T) :: sid ! Dataspace ID INTEGER(HID_T) :: iter_id ! Dataspace selection iterator ID INTEGER(HSIZE_T), DIMENSION(rank, POINT1_NPOINTS) :: coord1 ! Coordinates for point selection INTEGER(HSIZE_T), DIMENSION(2) :: start ! Hyperslab start INTEGER(HSIZE_T), DIMENSION(2) :: stride ! Hyperslab stride INTEGER(HSIZE_T), DIMENSION(2) :: count ! Hyperslab block count INTEGER(HSIZE_T), DIMENSION(2) :: BLOCK ! Hyperslab block size INTEGER(SIZE_T) :: nseq ! # of sequences retrieved INTEGER(SIZE_T) :: nbytes ! # of bytes retrieved INTEGER(HSIZE_T), DIMENSION(SEL_ITER_MAX_SEQ) :: off ! Offsets for retrieved sequences INTEGER(SIZE_T), DIMENSION(SEL_ITER_MAX_SEQ) :: ilen ! Lengths for retrieved sequences INTEGER :: sel_type ! Selection type INTEGER :: error ! Error return value integer(size_t) :: i ! Create dataspace CALL H5Screate_simple_f(2, dims1, sid, error) CALL check("H5Screate_simple_f", error, total_error) ! Test iterators on various basic selection types DO sel_type = H5S_SEL_NONE_F, H5S_SEL_ALL_F IF(sel_type .EQ. H5S_SEL_NONE_F)THEN ! "None" selection CALL H5Sselect_none_f(sid, error) CALL check("H5Sselect_none_f", error, total_error) ELSE IF(sel_type.EQ.H5S_SEL_POINTS_F)THEN ! Point selection ! Select sequence of four points coord1(1, 1) = 1 coord1(2, 1) = 2 coord1(1, 2) = 3 coord1(2, 2) = 4 coord1(1, 3) = 5 coord1(2, 3) = 6 coord1(1, 4) = 7 coord1(2, 4) = 8 CALL H5Sselect_elements_f(sid, H5S_SELECT_SET_F, rank, NUMP, coord1, error) CALL check("H5Sselect_elements_f", error, total_error) ELSE IF(sel_type.EQ.H5S_SEL_HYPERSLABS_F)THEN ! Hyperslab selection ! Select regular hyperslab start(1) = 0 start(2) = 0 stride(1) = 1 stride(2) = 1 COUNT(1) = 4 COUNT(2) = 4 BLOCK(1) = 1 BLOCK(2) = 1 CALL H5Sselect_hyperslab_f(sid, H5S_SELECT_SET_F, start, count, error, stride=stride, BLOCK=BLOCK) CALL check("H5Sselect_hyperslab_f", error, total_error) ELSE IF(sel_type.EQ.H5S_SEL_ALL_F)THEN ! "All" selection CALL H5Sselect_all_f(sid, error) CALL check("H5Sselect_all_f", error, total_error) ELSE CALL check("Incorrect selection option", error, total_error) ENDIF ! Create selection iterator object CALL H5Ssel_iter_create_f(sid, 1_size_t, H5S_SEL_ITER_SHARE_WITH_DATASPACE_F, iter_id, error) CALL check("H5Ssel_iter_create_f", error, total_error) ! Try retrieving all sequence off = -99 ilen = -99 CALL H5Ssel_iter_get_seq_list_f(iter_id, SEL_ITER_MAX_SEQ, 1024_size_t * 1024_size_t, nseq, nbytes, off, ilen, error) CALL check("H5Ssel_iter_get_seq_list_f", error, total_error) ! Check results from retrieving sequence list IF (sel_type .EQ. H5S_SEL_NONE_F)THEN ! "None" selection CALL VERIFY("H5Ssel_iter_get_seq_list_f", nseq, INT(0,SIZE_T), total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", nbytes, INT(0,SIZE_T), total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(1), INT(-99,HSIZE_T), total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(1), INT(-99,SIZE_T), total_error) ELSE IF (sel_type .EQ. H5S_SEL_POINTS_F)THEN ! Point selection CALL VERIFY("H5Ssel_iter_get_seq_list_f", nseq, 4_SIZE_T, total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", nbytes, 4_SIZE_T, total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(NUMP+1), INT(-99,HSIZE_T), total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(NUMP+1), INT(-99,SIZE_T), total_error) DO i = 1, NUMP CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(i), INT((i-1)*26+12,HSIZE_T), total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(i), INT(1,SIZE_T), total_error) ENDDO ELSE IF (sel_type .eq. H5S_SEL_HYPERSLABS_F)THEN ! Hyperslab selection CALL VERIFY("H5Ssel_iter_get_seq_list_f", nseq, 4_SIZE_T, total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", nbytes, 16_SIZE_T, total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(NUMP+1), INT(-99,HSIZE_T), total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(NUMP+1), INT(-99,SIZE_T), total_error) DO i = 1, NUMP CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(i), INT((i-1)*12,HSIZE_T), total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(i), INT(4,SIZE_T), total_error) ENDDO ELSE IF (sel_type.EQ.H5S_SEL_ALL_F)THEN ! "All" selection CALL VERIFY("H5Ssel_iter_get_seq_list_f", nseq, 1_SIZE_T, total_error ) CALL VERIFY("H5Ssel_iter_get_seq_list_f", nbytes, 72_SIZE_T, total_error ) CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(1), INT(0,HSIZE_T), total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(1), INT(72,SIZE_T), total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(2), INT(-99,HSIZE_T), total_error) CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(2), INT(-99,SIZE_T), total_error) ELSE CALL check("Incorrect selection option", error, total_error) ENDIF ! Reset iterator CALL H5Ssel_iter_reset_f(iter_id, sid, error) CALL check("H5Ssel_iter_reset_f", error, total_error) ! Close selection iterator CALL H5Ssel_iter_close_f(iter_id, error) CALL check("H5Ssel_iter_close_f", error, total_error) END DO ! Create selection iterator object CALL H5Ssel_iter_create_f(sid, 1_size_t, H5S_SEL_ITER_GET_SEQ_LIST_SORTED_F, iter_id, error) CALL check("H5Ssel_iter_create_f", error, total_error) ! Reset iterator CALL H5Ssel_iter_reset_f(iter_id, sid, error) CALL check("H5Ssel_iter_reset_f", error, total_error) CALL h5sclose_f(sid, error) CALL check("h5sclose_f", error, total_error) END SUBROUTINE test_select_iter ! ! Subroutine to test element selection ! SUBROUTINE test_select_element(cleanup, total_error) IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error ! !the dataset1 is stored in file "copy1.h5" ! CHARACTER(LEN=13), PARAMETER :: filename1 = "tselect_copy1" CHARACTER(LEN=80) :: fix_filename1 ! !the dataset2 is stored in file "copy2.h5" ! CHARACTER(LEN=13), PARAMETER :: filename2 = "tselect_copy2" CHARACTER(LEN=80) :: fix_filename2 ! !dataset1 name is "Copy1" ! CHARACTER(LEN=8), PARAMETER :: dsetname1 = "Copy1" ! !dataset2 name is "Copy2" ! CHARACTER(LEN=8), PARAMETER :: dsetname2 = "Copy2" ! !dataset rank ! INTEGER, PARAMETER :: RANK = 2 ! !number of points selected ! INTEGER(SIZE_T), PARAMETER :: NUMP = 2 INTEGER(HID_T) :: file1_id ! File1 identifier INTEGER(HID_T) :: file2_id ! File2 identifier INTEGER(HID_T) :: dset1_id ! Dataset1 identifier INTEGER(HID_T) :: dset2_id ! Dataset2 identifier INTEGER(HID_T) :: dataspace1 ! Dataspace identifier INTEGER(HID_T) :: dataspace2 ! Dataspace identifier INTEGER(HID_T) :: memspace ! memspace identifier ! !Memory space dimensions ! INTEGER(HSIZE_T), DIMENSION(1) :: dimsm = (/2/) ! !Dataset dimensions ! INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/3,4/) ! !Points positions in the file ! INTEGER(HSIZE_T), DIMENSION(RANK,NUMP) :: coord ! !data buffers ! INTEGER, DIMENSION(3,4) :: buf1, buf2, bufnew ! !value to write ! INTEGER, DIMENSION(2) :: val = (/53, 59/) ! !memory rank ! INTEGER :: memrank = 1 ! !general purpose integer ! INTEGER :: i, j ! !flag to check operation success ! INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims ! !Create two files containing identical datasets. Write 0's to one !and 1's to the other. ! ! !data initialization ! do i = 1, 3 do j = 1, 4 buf1(i,j) = 0; end do end do do i = 1, 3 do j = 1, 4 buf2(i,j) = 1; end do end do ! !Initialize FORTRAN predefined datatypes ! ! CALL h5init_types_f(error) ! CALL check("h5init_types_f", error, total_error) ! !Create file1, file2 using default properties. ! CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) if (error .ne. 0) then write(*,*) "Cannot modify filename" stop endif CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) CALL check("h5fcreate_f", error, total_error) CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) if (error .ne. 0) then write(*,*) "Cannot modify filename" stop endif CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error) CALL check("h5fcreate_f", error, total_error) ! !Create the data space for the datasets. ! CALL h5screate_simple_f(RANK, dimsf, dataspace1, error) CALL check("h5screate_simple_f", error, total_error) CALL h5screate_simple_f(RANK, dimsf, dataspace2, error) CALL check("h5screate_simple_f", error, total_error) ! ! Create the datasets with default properties ! CALL h5dcreate_f(file1_id, dsetname1, H5T_NATIVE_INTEGER, dataspace1, & dset1_id, error) CALL check("h5dcreate_f", error, total_error) CALL h5dcreate_f(file2_id, dsetname2, H5T_NATIVE_INTEGER, dataspace2, & dset2_id, error) CALL check("h5dcreate_f", error, total_error) ! ! Write the datasets ! data_dims(1) = 3 data_dims(2) = 4 CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, buf1, data_dims, error) CALL check("h5dwrite_f", error, total_error) CALL h5dwrite_f(dset2_id, H5T_NATIVE_INTEGER, buf2, data_dims, error) CALL check("h5dwrite_f", error, total_error) ! !Close the dataspace for the datasets. ! CALL h5sclose_f(dataspace1, error) CALL check("h5sclose_f", error, total_error) CALL h5sclose_f(dataspace2, error) CALL check("h5sclose_f", error, total_error) ! !Close the datasets. ! CALL h5dclose_f(dset1_id, error) CALL check("h5dclose_f", error, total_error) CALL h5dclose_f(dset2_id, error) CALL check("h5dclose_f", error, total_error) ! !Close the files. ! CALL h5fclose_f(file1_id, error) CALL check("h5fclose_f", error, total_error) CALL h5fclose_f(file2_id, error) CALL check("h5fclose_f", error, total_error) ! !Open the two files. Select two points in one file, write values to !those point locations, then do H5Scopy and write the values to the !other file. Close files. ! ! !Open the files. ! CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) CALL check("h5fopen_f", error, total_error) CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) CALL check("h5fopen_f", error, total_error) ! !Open the datasets. ! CALL h5dopen_f(file1_id, dsetname1, dset1_id, error) CALL check("h5dopen_f", error, total_error) CALL h5dopen_f(file2_id, dsetname2, dset2_id, error) CALL check("h5dopen_f", error, total_error) ! !Get dataset1's dataspace handle. ! CALL h5dget_space_f(dset1_id, dataspace1, error) CALL check("h5dget_space_f", error, total_error) ! !create memory dataspace. ! CALL h5screate_simple_f(memrank, dimsm, memspace, error) CALL check("h5screate_simple_f", error, total_error) ! !Set the selected point positions.Because Fortran array index starts ! from 1, so add one to the actual select points in C ! coord(1,1) = 1 coord(2,1) = 2 coord(1,2) = 1 coord(2,2) = 4 ! !Select the elements in file space ! CALL h5sselect_elements_f(dataspace1, H5S_SELECT_SET_F, RANK, NUMP,& coord, error) CALL check("h5sselect_elements_f", error, total_error) ! !Write value into the selected points in dataset1 ! data_dims(1) = 2 CALL H5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, val, data_dims, error, & mem_space_id=memspace, file_space_id=dataspace1) CALL check("h5dwrite_f", error, total_error) ! !Copy the daspace1 into dataspace2 ! CALL h5scopy_f(dataspace1, dataspace2, error) CALL check("h5scopy_f", error, total_error) ! !Write value into the selected points in dataset2 ! CALL H5dwrite_f(dset2_id, H5T_NATIVE_INTEGER, val, data_dims, error, & mem_space_id=memspace, file_space_id=dataspace2) CALL check("h5dwrite_f", error, total_error) ! !Close the dataspace for the datasets. ! CALL h5sclose_f(dataspace1, error) CALL check("h5sclose_f", error, total_error) CALL h5sclose_f(dataspace2, error) CALL check("h5sclose_f", error, total_error) ! !Close the memoryspace. ! CALL h5sclose_f(memspace, error) CALL check("h5sclose_f", error, total_error) ! !Close the datasets. ! CALL h5dclose_f(dset1_id, error) CALL check("h5dclose_f", error, total_error) CALL h5dclose_f(dset2_id, error) CALL check("h5dclose_f", error, total_error) ! !Close the files. ! CALL h5fclose_f(file1_id, error) CALL check("h5fclose_f", error, total_error) CALL h5fclose_f(file2_id, error) CALL check("h5fclose_f", error, total_error) ! !Open both files and print the contents of the datasets. ! ! !Open the files. ! CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) CALL check("h5fopen_f", error, total_error) CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) CALL check("h5fopen_f", error, total_error) ! !Open the datasets. ! CALL h5dopen_f(file1_id, dsetname1, dset1_id, error) CALL check("h5dopen_f", error, total_error) CALL h5dopen_f(file2_id, dsetname2, dset2_id, error) CALL check("h5dopen_f", error, total_error) ! !Read dataset1. ! data_dims(1) = 3 data_dims(2) = 4 CALL h5dread_f(dset1_id, H5T_NATIVE_INTEGER, bufnew, data_dims, error) CALL check("h5dread_f", error, total_error) ! !Display the data read from dataset "Copy1" ! !write(*,*) "The data in dataset Copy1 is: " !do i = 1, 3 ! print *, (bufnew(i,j), j = 1,4) !end do ! !Read dataset2. ! CALL h5dread_f(dset2_id, H5T_NATIVE_INTEGER, bufnew, data_dims, error) CALL check("h5dread_f", error, total_error) ! !Display the data read from dataset "Copy2" ! !write(*,*) "The data in dataset Copy2 is: " !do i = 1, 3 ! print *, (bufnew(i,j), j = 1,4) !end do ! !Close the datasets. ! CALL h5dclose_f(dset1_id, error) CALL check("h5dclose_f", error, total_error) CALL h5dclose_f(dset2_id, error) CALL check("h5dclose_f", error, total_error) ! !Close the files. ! CALL h5fclose_f(file1_id, error) CALL check("h5fclose_f", error, total_error) CALL h5fclose_f(file2_id, error) CALL check("h5fclose_f", error, total_error) if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) RETURN END SUBROUTINE test_select_element SUBROUTINE test_basic_select(cleanup, total_error) IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error ! !the dataset is stored in file "testselect.h5" ! CHARACTER(LEN=10), PARAMETER :: filename = "testselect" CHARACTER(LEN=80) :: fix_filename ! !dataspace rank ! INTEGER, PARAMETER :: RANK = 2 ! !select NUMP_POINTS points from the file ! INTEGER(SIZE_T), PARAMETER :: NUMPS = 10 ! !dataset name is "testselect" ! CHARACTER(LEN=10), PARAMETER :: dsetname = "testselect" INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dataspace ! Dataspace identifier ! !Dataset dimensions ! INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/5,6/) ! !Size of the hyperslab in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: count = (/2,2/) ! !hyperslab offset in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: offset = (/0,0/) ! !start block for getting the selected hyperslab ! INTEGER(HSIZE_T) :: startblock = 0 ! !start point for getting the selected elements ! INTEGER(HSIZE_T) :: startpoint = 0 ! !Stride of the hyperslab in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: stride = (/3,3/) ! !BLock size of the hyperslab in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: block = (/2,2/) ! !array to give selected points' coordinations ! INTEGER(HSIZE_T), DIMENSION(RANK, NUMPS) :: coord ! !Number of hyperslabs selected in the current dataspace ! INTEGER(HSSIZE_T) :: num_blocks ! !allocatable array for putting a list of hyperslabs !selected in the current file dataspace ! INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: blocklist ! !Number of points selected in the current dataspace ! INTEGER(HSSIZE_T) :: num_points INTEGER(HSIZE_T) :: num1_points ! !allocatable array for putting a list of points !selected in the current file dataspace ! INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: pointlist ! !start and end bounds in the current dataspace selection ! INTEGER(HSIZE_T), DIMENSION(RANK) :: startout, endout ! !data to write ! INTEGER, DIMENSION(5,6) :: data ! !flag to check operation success ! INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims LOGICAL :: same, intersects INTEGER(HID_T) :: scalar_all_sid INTEGER(hsize_t), DIMENSION(1:2) :: block_start = (/0, 0/) ! Start offset for BLOCK INTEGER(hsize_t), DIMENSION(1:2) :: block_end = (/2, 3/) ! END offset for BLOCK ! !initialize the coord array to give the selected points' position ! coord(1,1) = 1 coord(2,1) = 1 coord(1,2) = 1 coord(2,2) = 3 coord(1,3) = 1 coord(2,3) = 5 coord(1,4) = 3 coord(2,4) = 1 coord(1,5) = 3 coord(2,5) = 3 coord(1,6) = 3 coord(2,6) = 5 coord(1,7) = 4 coord(2,7) = 3 coord(1,8) = 4 coord(2,8) = 1 coord(1,9) = 5 coord(2,9) = 3 coord(1,10) = 5 coord(2,10) = 5 ! !Create a new file using default properties. ! CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) if (error .ne. 0) then write(*,*) "Cannot modify filename" stop endif CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f", error, total_error) ! !Create the data space for the dataset. ! CALL h5screate_simple_f(RANK, dimsf, dataspace, error) CALL check("h5screate_simple_f", error, total_error) ! Check shape same API CALL h5sselect_shape_same_f(dataspace, dataspace, same, error) CALL check("h5sselect_shape_same_f", error, total_error) CALL VERIFY("h5sselect_shape_same_f", same, .TRUE., total_error) CALL h5screate_f(H5S_SCALAR_F, scalar_all_sid, error) CALL check("h5screate_f", error, total_error) same = .TRUE. CALL h5sselect_shape_same_f(dataspace, scalar_all_sid, same, error) CALL check("h5sselect_shape_same_f", error, total_error) CALL VERIFY("h5sselect_shape_same_f", same, .FALSE., total_error) CALL h5sclose_f(scalar_all_sid,error) CALL check("h5sclose_f", error, total_error) ! ! Create the dataset with default properties ! CALL h5dcreate_f(file_id, dsetname, H5T_STD_I32BE, dataspace, & dset_id, error) CALL check("h5dcreate_f", error, total_error) ! ! Write the dataset ! data_dims(1) = 5 data_dims(2) = 6 CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, data_dims, error) CALL check("h5dwrite_f", error, total_error) ! Set selection to 'all' CALL h5sselect_all_f(dataspace, error) CALL check("h5sselect_all_f", error, total_error) ! Test block intersection with 'all' selection (always true) CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) CALL check("h5sselect_intersect_block_f", error, total_error) CALL verify("h5sselect_intersect_block_f", intersects, .TRUE., total_error) ! Select 2x2 region of the dataset CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, offset, count, error) CALL check("h5sselect_hyperslab_f", error, total_error) ! Check an intersecting region block_start(1:2) = (/1,0/) block_end(1:2) = (/2,2/) CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) CALL check("h5sselect_intersect_block_f", error, total_error) CALL verify("h5sselect_intersect_block_f", intersects, .TRUE., total_error) ! Check a non-intersecting region block_start(1:2) = (/2,1/) block_end(1:2) = (/4,5/) CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) CALL check("h5sselect_intersect_block_f", error, total_error) CALL verify("h5sselect_intersect_block_f2", intersects, .FALSE., total_error) ! !Close the dataspace for the dataset. ! CALL h5sclose_f(dataspace, error) CALL check("h5sclose_f", error, total_error) ! !Close the dataset. ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) ! !Close the file. ! CALL h5fclose_f(file_id, error) CALL check("h5fclose_f", error, total_error) ! !Open the file. ! CALL h5fopen_f (fix_filename, H5F_ACC_RDONLY_F, file_id, error) CALL check("h5fopen_f", error, total_error) ! !Open the dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f", error, total_error) ! !Get dataset's dataspace handle. ! CALL h5dget_space_f(dset_id, dataspace, error) CALL check("h5dget_space_f", error, total_error) ! !Select hyperslab in the dataset. ! CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, & offset, count, error, stride, block) CALL check("h5sselect_hyperslab_f", error, total_error) ! !get the number of hyperslab blocks in the current dataspac selection ! CALL h5sget_select_hyper_nblocks_f(dataspace, num_blocks, error) CALL check("h5sget_select_hyper_nblocks_f", error, total_error) IF (num_blocks .NE. 4) write (*,*) "error occurred with num_blocks" !write(*,*) num_blocks !result of num_blocks is 4 ! !allocate the blocklist array ! ALLOCATE(blocklist(num_blocks*RANK*2), STAT= error) if(error .NE. 0) then STOP endif ! !get the list of hyperslabs selected in the current dataspac selection ! CALL h5sget_select_hyper_blocklist_f(dataspace, startblock, & num_blocks, blocklist, error) CALL check("h5sget_select_hyper_blocklist_f", error, total_error) ! write(*,*) (blocklist(i), i =1, num_blocks*RANK*2) !result of blocklist selected is: !1, 1, 2, 2, 4, 1, 5, 2, 1, 4, 2, 5, 4, 4, 5, 5 ! !deallocate the blocklist array ! DEALLOCATE(blocklist) ! !get the selection bounds in the current dataspac selection ! CALL h5sget_select_bounds_f(dataspace, startout, endout, error) CALL check("h5sget_select_bounds_f", error, total_error) IF ( (startout(1) .ne. 1) .or. (startout(2) .ne. 1) ) THEN write(*,*) "error occurred to select_bounds's start position" END IF IF ( (endout(1) .ne. 5) .or. (endout(2) .ne. 5) ) THEN write(*,*) "error occurred to select_bounds's end position" END IF !write(*,*) (startout(i), i = 1, RANK) !result of startout is 0, 0 !write(*,*) (endout(i), i = 1, RANK) !result of endout is 5, 5 ! !allocate the pointlist array ! ! ALLOCATE(pointlist(num_blocks*RANK), STAT= error) ALLOCATE(pointlist(20), STAT= error) if(error .NE. 0) then STOP endif ! !Select the elements in file space ! CALL h5sselect_elements_f(dataspace, H5S_SELECT_SET_F, RANK, NUMPS,& coord, error) CALL check("h5sselect_elements_f", error, total_error) ! !Get the number of selected elements ! CALL h5sget_select_elem_npoints_f(dataspace, num_points, error) CALL check("h5sget_select_elem_npoints_f", error, total_error) IF (num_points .NE. 10) write(*,*) "error occurred with num_points" !write(*,*) num_points ! result of num_points is 10 ! !Get the list of selected elements ! num1_points = num_points CALL h5sget_select_elem_pointlist_f(dataspace, startpoint, & num1_points, pointlist, error) CALL check("h5sget_select_elem_pointlist_f", error, total_error) !write(*,*) (pointlist(i), i =1, num1_points*RANK) !result of pintlist is: !1, 1, 3, 1, 5, 1, 1, 3, 3, 3, 5, 3, 3, !4, 1, 4, 3, 5, 5, 5 ! !deallocate the pointlist array ! DEALLOCATE(pointlist) ! !Close the dataspace for the dataset. ! CALL h5sclose_f(dataspace, error) CALL check("h5sclose_f", error, total_error) ! !Close the dataset. ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) ! !Close the file. ! CALL h5fclose_f(file_id, error) CALL check("h5fclose_f", error, total_error) if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) RETURN END SUBROUTINE test_basic_select !*************************************************************** !** !** test_select_point(): Test basic H5S (dataspace) selection code. !** Tests element selections between dataspaces of various sizes !** and dimensionalities. !** !*************************************************************** SUBROUTINE test_select_point(cleanup, total_error) IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T) :: xfer_plist INTEGER, PARAMETER :: SPACE1_DIM1=3 INTEGER, PARAMETER :: SPACE1_DIM2=15 INTEGER, PARAMETER :: SPACE1_DIM3=13 INTEGER, PARAMETER :: SPACE2_DIM1=30 INTEGER, PARAMETER :: SPACE2_DIM2=26 INTEGER, PARAMETER :: SPACE3_DIM1=15 INTEGER, PARAMETER :: SPACE3_DIM2=26 INTEGER, PARAMETER :: SPACE1_RANK=3 INTEGER, PARAMETER :: SPACE2_RANK=2 INTEGER, PARAMETER :: SPACE3_RANK=2 ! Element selection information INTEGER, PARAMETER :: POINT1_NPOINTS=10 INTEGER(hid_t) ::fid1 ! HDF5 File IDs INTEGER(hid_t) ::dataset ! Dataset ID INTEGER(hid_t) ::sid1,sid2 ! Dataspace ID INTEGER(hsize_t), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/) INTEGER(hsize_t), DIMENSION(1:2) :: dims2 = (/SPACE2_DIM1, SPACE2_DIM2/) INTEGER(hsize_t), DIMENSION(1:2) :: dims3 = (/SPACE3_DIM1, SPACE3_DIM2/) INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: coord1 ! Coordinates for point selection INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: temp_coord1 ! Coordinates for point selection INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: coord2 ! Coordinates for point selection INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: temp_coord2 ! Coordinates for point selection INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: coord3 ! Coordinates for point selection INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: temp_coord3 ! Coordinates for point selection INTEGER(hssize_t) :: npoints !!$ uint8_t *wbuf, buffer to write to disk !!$ *rbuf, buffer read from disk !!$ *tbuf; temporary buffer pointer INTEGER :: i,j; ! Counters ! struct pnt_iter pi; Custom Pointer iterator struct INTEGER :: error ! Generic return value CHARACTER(LEN=9) :: filename = 'h5s_hyper' CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=1), DIMENSION(1:SPACE2_DIM1,1:SPACE2_DIM2) :: wbuf CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) IF (error .NE. 0) THEN WRITE(*,*) "Cannot modify filename" STOP ENDIF xfer_plist = H5P_DEFAULT_F ! MESSAGE(5, ("Testing Element Selection Functions\n")); ! Allocate write & read buffers !!$ wbuf = malloc(sizeof(uint8_t) * SPACE2_DIM1 * SPACE2_DIM2); !!$ rbuf = calloc(sizeof(uint8_t), (size_t)(SPACE3_DIM1 * SPACE3_DIM2)); !!$ ! Initialize WRITE buffer DO i = 1, SPACE2_DIM1 DO j = 1, SPACE2_DIM2 wbuf(i,j) = 'a' ENDDO ENDDO !!$ for(i=0, tbuf=wbuf; i