1!****h* root/fortran/test/tH5Sselect.f90 2! 3! NAME 4! tH5Sselect.f90 5! 6! FUNCTION 7! Basic testing of Fortran H5S, Selection-related Dataspace Interface, APIs. 8! 9! COPYRIGHT 10! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11! Copyright by The HDF Group. * 12! Copyright by the Board of Trustees of the University of Illinois. * 13! All rights reserved. * 14! * 15! This file is part of HDF5. The full HDF5 copyright notice, including * 16! terms governing use, modification, and redistribution, is contained in * 17! the COPYING file, which can be found at the root of the source code * 18! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. * 19! If you do not have access to either file, you may request a copy from * 20! help@hdfgroup.org. * 21! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 22! 23! NOTES 24! Tests the following functionalities: 25! h5sget_select_npoints_f, h5sselect_elements_f, h5sselect_all_f, 26! h5sselect_none_f, h5sselect_valid_f, h5sselect_hyperslab_f, 27! h5sget_select_bounds_f, h5sget_select_elem_pointlist_f, 28! h5sget_select_elem_npoints_f, h5sget_select_hyper_blocklist_f, 29! h5sget_select_hyper_nblocks_f, h5sget_select_npoints_f 30! 31! CONTAINS SUBROUTINES 32! test_select_hyperslab, test_select_element, test_basic_select, 33! test_select_point, test_select_combine, test_select_bounds 34! 35! 36!***** 37MODULE TH5SSELECT 38 39 USE HDF5 ! This module contains all necessary modules 40 USE TH5_MISC 41 USE TH5_MISC_GEN 42 43CONTAINS 44 45 SUBROUTINE test_select_hyperslab(cleanup, total_error) 46 47 IMPLICIT NONE 48 LOGICAL, INTENT(IN) :: cleanup 49 INTEGER, INTENT(INOUT) :: total_error 50 51 CHARACTER(LEN=7), PARAMETER :: filename = "tselect" 52 CHARACTER(LEN=80) :: fix_filename 53 54 ! 55 !dataset name is "IntArray" 56 ! 57 CHARACTER(LEN=8), PARAMETER :: dsetname = "IntArray" 58 59 INTEGER(HID_T) :: file_id ! File identifier 60 INTEGER(HID_T) :: dset_id ! Dataset identifier 61 INTEGER(HID_T) :: dataspace ! Dataspace identifier 62 INTEGER(HID_T) :: memspace ! memspace identifier 63 64 ! 65 !Memory space dimensions 66 ! 67 INTEGER(HSIZE_T), DIMENSION(3) :: dimsm = (/7,7,3/) 68 69 70 ! 71 !Dataset dimensions 72 ! 73 INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/5,6/) 74 75 ! 76 !Size of the hyperslab in the file 77 ! 78 INTEGER(HSIZE_T), DIMENSION(2) :: count = (/3,4/) 79 80 ! 81 !hyperslab offset in the file 82 ! 83 INTEGER(HSIZE_T), DIMENSION(2) :: offset = (/1,2/) 84 85 ! 86 !Size of the hyperslab in memory 87 ! 88 INTEGER(HSIZE_T), DIMENSION(3) :: count_out = (/3,4,1/) 89 90 ! 91 !hyperslab offset in memory 92 ! 93 INTEGER(HSIZE_T), DIMENSION(3) :: offset_out = (/3,0,0/) 94 95 ! 96 !data to write 97 ! 98 INTEGER, DIMENSION(5,6) :: data 99 100 ! 101 !output buffer 102 ! 103 INTEGER, DIMENSION(7,7,3) :: data_out 104 105 106 ! 107 !dataset space rank 108 ! 109 INTEGER :: dsetrank = 2 110 111 ! 112 !memspace rank 113 ! 114 INTEGER :: memrank = 3 115 116 117 118 119 ! 120 !general purpose integer 121 ! 122 INTEGER :: i, j 123 124 ! 125 !flag to check operation success 126 ! 127 INTEGER :: error 128 INTEGER(HSIZE_T), DIMENSION(3) :: data_dims 129 130 131 ! 132 !This writes data to the HDF5 file. 133 ! 134 135 ! 136 !data initialization 137 ! 138 do i = 1, 5 139 do j = 1, 6 140 data(i,j) = (i-1) + (j-1); 141 end do 142 end do 143 ! 144 ! 0, 1, 2, 3, 4, 5 145 ! 1, 2, 3, 4, 5, 6 146 ! 2, 3, 4, 5, 6, 7 147 ! 3, 4, 5, 6, 7, 8 148 ! 4, 5, 6, 7, 8, 9 149 ! 150 151 ! 152 !Initialize FORTRAN predifined datatypes 153 ! 154! CALL h5init_types_f(error) 155! CALL check("h5init_types_f", error, total_error) 156 157 ! 158 !Create a new file using default properties. 159 ! 160 CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) 161 if (error .ne. 0) then 162 write(*,*) "Cannot modify filename" 163 stop 164 endif 165 CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) 166 CALL check("h5fcreate_f", error, total_error) 167 168 ! 169 !Create the data space for the dataset. 170 ! 171 CALL h5screate_simple_f(dsetrank, dimsf, dataspace, error) 172 CALL check("h5screate_simple_f", error, total_error) 173 174 ! 175 ! Create the dataset with default properties 176 ! 177 CALL h5dcreate_f(file_id, dsetname, H5T_STD_I32BE, dataspace, & 178 dset_id, error) 179 CALL check("h5dcreate_f", error, total_error) 180 181 ! 182 ! Write the dataset 183 ! 184 data_dims(1) = 5 185 data_dims(2) = 6 186 CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, data_dims, error) 187 CALL check("h5dwrite_f", error, total_error) 188 189 ! 190 !Close the dataspace for the dataset. 191 ! 192 CALL h5sclose_f(dataspace, error) 193 CALL check("h5sclose_f", error, total_error) 194 195 ! 196 !Close the dataset. 197 ! 198 CALL h5dclose_f(dset_id, error) 199 CALL check("h5dclose_f", error, total_error) 200 201 ! 202 !Close the file. 203 ! 204 CALL h5fclose_f(file_id, error) 205 CALL check("h5fclose_f", error, total_error) 206 207 ! 208 !This reads the hyperslab from the sds.h5 file just 209 !created, into a 2-dimensional plane of the 3-dimensional array. 210 ! 211 212 ! 213 !initialize data_out array 214 ! 215 ! do i = 1, 7 216 ! do j = 1, 7 217 ! do k = 1,3 218 ! data_out(i,j,k) = 0; 219 ! end do 220 ! end do 221 ! end do 222 223 ! 224 !Open the file. 225 ! 226 CALL h5fopen_f (fix_filename, H5F_ACC_RDONLY_F, file_id, error) 227 CALL check("h5fopen_f", error, total_error) 228 229 ! 230 !Open the dataset. 231 ! 232 CALL h5dopen_f(file_id, dsetname, dset_id, error) 233 CALL check("h5dopen_f", error, total_error) 234 235 ! 236 !Get dataset's dataspace handle. 237 ! 238 CALL h5dget_space_f(dset_id, dataspace, error) 239 CALL check("h5dget_space_f", error, total_error) 240 241 ! 242 !Select hyperslab in the dataset. 243 ! 244 CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, & 245 offset, count, error) 246 CALL check("h5sselect_hyperslab_f", error, total_error) 247 ! 248 !create memory dataspace. 249 ! 250 CALL h5screate_simple_f(memrank, dimsm, memspace, error) 251 CALL check("h5screate_simple_f", error, total_error) 252 253 ! 254 !Select hyperslab in memory. 255 ! 256 CALL h5sselect_hyperslab_f(memspace, H5S_SELECT_SET_F, & 257 offset_out, count_out, error) 258 CALL check("h5sselect_hyperslab_f", error, total_error) 259 260 ! 261 !Read data from hyperslab in the file into the hyperslab in 262 !memory and display. 263 ! 264 data_dims(1) = 7 265 data_dims(2) = 7 266 data_dims(3) = 3 267 CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, & 268 memspace, dataspace) 269 CALL check("h5dread_f", error, total_error) 270 271 ! 272 !Display data_out array 273 ! 274 !do i = 1, 7 275 ! print *, (data_out(i,j,1), j = 1,7) 276 !end do 277 278 ! 0 0 0 0 0 0 0 279 ! 0 0 0 0 0 0 0 280 ! 0 0 0 0 0 0 0 281 ! 3 4 5 6 0 0 0 282 ! 4 5 6 7 0 0 0 283 ! 5 6 7 8 0 0 0 284 ! 0 0 0 0 0 0 0 285 ! 286 287 ! 288 !Close the dataspace for the dataset. 289 ! 290 CALL h5sclose_f(dataspace, error) 291 CALL check("h5sclose_f", error, total_error) 292 293 ! 294 !Close the memoryspace. 295 ! 296 CALL h5sclose_f(memspace, error) 297 CALL check("h5sclose_f", error, total_error) 298 299 ! 300 !Close the dataset. 301 ! 302 CALL h5dclose_f(dset_id, error) 303 CALL check("h5dclose_f", error, total_error) 304 305 ! 306 !Close the file. 307 ! 308 CALL h5fclose_f(file_id, error) 309 CALL check("h5fclose_f", error, total_error) 310 311 312 if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) 313 CALL check("h5_cleanup_f", error, total_error) 314 RETURN 315 316 END SUBROUTINE test_select_hyperslab 317 318 ! 319 !Subroutine to test element selection 320 ! 321 322 SUBROUTINE test_select_element(cleanup, total_error) 323 324 USE HDF5 ! This module contains all necessary modules 325 USE TH5_MISC 326 327 IMPLICIT NONE 328 LOGICAL, INTENT(IN) :: cleanup 329 INTEGER, INTENT(INOUT) :: total_error 330 331 ! 332 !the dataset1 is stored in file "copy1.h5" 333 ! 334 CHARACTER(LEN=13), PARAMETER :: filename1 = "tselect_copy1" 335 CHARACTER(LEN=80) :: fix_filename1 336 337 ! 338 !the dataset2 is stored in file "copy2.h5" 339 ! 340 CHARACTER(LEN=13), PARAMETER :: filename2 = "tselect_copy2" 341 CHARACTER(LEN=80) :: fix_filename2 342 ! 343 !dataset1 name is "Copy1" 344 ! 345 CHARACTER(LEN=8), PARAMETER :: dsetname1 = "Copy1" 346 347 ! 348 !dataset2 name is "Copy2" 349 ! 350 CHARACTER(LEN=8), PARAMETER :: dsetname2 = "Copy2" 351 352 ! 353 !dataset rank 354 ! 355 INTEGER, PARAMETER :: RANK = 2 356 357 ! 358 !number of points selected 359 ! 360 INTEGER(SIZE_T), PARAMETER :: NUMP = 2 361 362 INTEGER(HID_T) :: file1_id ! File1 identifier 363 INTEGER(HID_T) :: file2_id ! File2 identifier 364 INTEGER(HID_T) :: dset1_id ! Dataset1 identifier 365 INTEGER(HID_T) :: dset2_id ! Dataset2 identifier 366 INTEGER(HID_T) :: dataspace1 ! Dataspace identifier 367 INTEGER(HID_T) :: dataspace2 ! Dataspace identifier 368 INTEGER(HID_T) :: memspace ! memspace identifier 369 370 ! 371 !Memory space dimensions 372 ! 373 INTEGER(HSIZE_T), DIMENSION(1) :: dimsm = (/2/) 374 375 ! 376 !Dataset dimensions 377 ! 378 INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/3,4/) 379 380 ! 381 !Points positions in the file 382 ! 383 INTEGER(HSIZE_T), DIMENSION(RANK,NUMP) :: coord 384 385 ! 386 !data buffers 387 ! 388 INTEGER, DIMENSION(3,4) :: buf1, buf2, bufnew 389 390 ! 391 !value to write 392 ! 393 INTEGER, DIMENSION(2) :: val = (/53, 59/) 394 395 ! 396 !memory rank 397 ! 398 INTEGER :: memrank = 1 399 400 ! 401 !general purpose integer 402 ! 403 INTEGER :: i, j 404 405 ! 406 !flag to check operation success 407 ! 408 INTEGER :: error 409 INTEGER(HSIZE_T), DIMENSION(3) :: data_dims 410 411 412 ! 413 !Create two files containing identical datasets. Write 0's to one 414 !and 1's to the other. 415 ! 416 417 ! 418 !data initialization 419 ! 420 do i = 1, 3 421 do j = 1, 4 422 buf1(i,j) = 0; 423 end do 424 end do 425 426 do i = 1, 3 427 do j = 1, 4 428 buf2(i,j) = 1; 429 end do 430 end do 431 432 ! 433 !Initialize FORTRAN predifined datatypes 434 ! 435! CALL h5init_types_f(error) 436! CALL check("h5init_types_f", error, total_error) 437 438 ! 439 !Create file1, file2 using default properties. 440 ! 441 CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) 442 if (error .ne. 0) then 443 write(*,*) "Cannot modify filename" 444 stop 445 endif 446 CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) 447 CALL check("h5fcreate_f", error, total_error) 448 449 CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) 450 if (error .ne. 0) then 451 write(*,*) "Cannot modify filename" 452 stop 453 endif 454 CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error) 455 CALL check("h5fcreate_f", error, total_error) 456 457 ! 458 !Create the data space for the datasets. 459 ! 460 CALL h5screate_simple_f(RANK, dimsf, dataspace1, error) 461 CALL check("h5screate_simple_f", error, total_error) 462 463 CALL h5screate_simple_f(RANK, dimsf, dataspace2, error) 464 CALL check("h5screate_simple_f", error, total_error) 465 466 ! 467 ! Create the datasets with default properties 468 ! 469 CALL h5dcreate_f(file1_id, dsetname1, H5T_NATIVE_INTEGER, dataspace1, & 470 dset1_id, error) 471 CALL check("h5dcreate_f", error, total_error) 472 473 CALL h5dcreate_f(file2_id, dsetname2, H5T_NATIVE_INTEGER, dataspace2, & 474 dset2_id, error) 475 CALL check("h5dcreate_f", error, total_error) 476 477 ! 478 ! Write the datasets 479 ! 480 data_dims(1) = 3 481 data_dims(2) = 4 482 CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, buf1, data_dims, error) 483 CALL check("h5dwrite_f", error, total_error) 484 485 CALL h5dwrite_f(dset2_id, H5T_NATIVE_INTEGER, buf2, data_dims, error) 486 CALL check("h5dwrite_f", error, total_error) 487 488 ! 489 !Close the dataspace for the datasets. 490 ! 491 CALL h5sclose_f(dataspace1, error) 492 CALL check("h5sclose_f", error, total_error) 493 494 CALL h5sclose_f(dataspace2, error) 495 CALL check("h5sclose_f", error, total_error) 496 497 ! 498 !Close the datasets. 499 ! 500 CALL h5dclose_f(dset1_id, error) 501 CALL check("h5dclose_f", error, total_error) 502 503 CALL h5dclose_f(dset2_id, error) 504 CALL check("h5dclose_f", error, total_error) 505 506 ! 507 !Close the files. 508 ! 509 CALL h5fclose_f(file1_id, error) 510 CALL check("h5fclose_f", error, total_error) 511 512 CALL h5fclose_f(file2_id, error) 513 CALL check("h5fclose_f", error, total_error) 514 515 ! 516 !Open the two files. Select two points in one file, write values to 517 !those point locations, then do H5Scopy and write the values to the 518 !other file. Close files. 519 ! 520 521 ! 522 !Open the files. 523 ! 524 CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) 525 CALL check("h5fopen_f", error, total_error) 526 527 CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) 528 CALL check("h5fopen_f", error, total_error) 529 530 ! 531 !Open the datasets. 532 ! 533 CALL h5dopen_f(file1_id, dsetname1, dset1_id, error) 534 CALL check("h5dopen_f", error, total_error) 535 536 CALL h5dopen_f(file2_id, dsetname2, dset2_id, error) 537 CALL check("h5dopen_f", error, total_error) 538 539 ! 540 !Get dataset1's dataspace handle. 541 ! 542 CALL h5dget_space_f(dset1_id, dataspace1, error) 543 CALL check("h5dget_space_f", error, total_error) 544 545 ! 546 !create memory dataspace. 547 ! 548 CALL h5screate_simple_f(memrank, dimsm, memspace, error) 549 CALL check("h5screate_simple_f", error, total_error) 550 551 ! 552 !Set the selected point positions.Because Fortran array index starts 553 ! from 1, so add one to the actual select points in C 554 ! 555 coord(1,1) = 1 556 coord(2,1) = 2 557 coord(1,2) = 1 558 coord(2,2) = 4 559 560 ! 561 !Select the elements in file space 562 ! 563 CALL h5sselect_elements_f(dataspace1, H5S_SELECT_SET_F, RANK, NUMP,& 564 coord, error) 565 CALL check("h5sselect_elements_f", error, total_error) 566 567 ! 568 !Write value into the selected points in dataset1 569 ! 570 data_dims(1) = 2 571 CALL H5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, val, data_dims, error, & 572 mem_space_id=memspace, file_space_id=dataspace1) 573 CALL check("h5dwrite_f", error, total_error) 574 575 ! 576 !Copy the daspace1 into dataspace2 577 ! 578 CALL h5scopy_f(dataspace1, dataspace2, error) 579 CALL check("h5scopy_f", error, total_error) 580 581 ! 582 !Write value into the selected points in dataset2 583 ! 584 CALL H5dwrite_f(dset2_id, H5T_NATIVE_INTEGER, val, data_dims, error, & 585 mem_space_id=memspace, file_space_id=dataspace2) 586 CALL check("h5dwrite_f", error, total_error) 587 588 ! 589 !Close the dataspace for the datasets. 590 ! 591 CALL h5sclose_f(dataspace1, error) 592 CALL check("h5sclose_f", error, total_error) 593 594 CALL h5sclose_f(dataspace2, error) 595 CALL check("h5sclose_f", error, total_error) 596 597 ! 598 !Close the memoryspace. 599 ! 600 CALL h5sclose_f(memspace, error) 601 CALL check("h5sclose_f", error, total_error) 602 603 ! 604 !Close the datasets. 605 ! 606 CALL h5dclose_f(dset1_id, error) 607 CALL check("h5dclose_f", error, total_error) 608 609 CALL h5dclose_f(dset2_id, error) 610 CALL check("h5dclose_f", error, total_error) 611 612 ! 613 !Close the files. 614 ! 615 CALL h5fclose_f(file1_id, error) 616 CALL check("h5fclose_f", error, total_error) 617 618 CALL h5fclose_f(file2_id, error) 619 CALL check("h5fclose_f", error, total_error) 620 621 ! 622 !Open both files and print the contents of the datasets. 623 ! 624 625 ! 626 !Open the files. 627 ! 628 CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) 629 CALL check("h5fopen_f", error, total_error) 630 631 CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) 632 CALL check("h5fopen_f", error, total_error) 633 634 ! 635 !Open the datasets. 636 ! 637 CALL h5dopen_f(file1_id, dsetname1, dset1_id, error) 638 CALL check("h5dopen_f", error, total_error) 639 640 CALL h5dopen_f(file2_id, dsetname2, dset2_id, error) 641 CALL check("h5dopen_f", error, total_error) 642 643 ! 644 !Read dataset1. 645 ! 646 data_dims(1) = 3 647 data_dims(2) = 4 648 CALL h5dread_f(dset1_id, H5T_NATIVE_INTEGER, bufnew, data_dims, error) 649 CALL check("h5dread_f", error, total_error) 650 651 ! 652 !Display the data read from dataset "Copy1" 653 ! 654 !write(*,*) "The data in dataset Copy1 is: " 655 !do i = 1, 3 656 ! print *, (bufnew(i,j), j = 1,4) 657 !end do 658 659 ! 660 !Read dataset2. 661 ! 662 CALL h5dread_f(dset2_id, H5T_NATIVE_INTEGER, bufnew, data_dims, error) 663 CALL check("h5dread_f", error, total_error) 664 665 ! 666 !Display the data read from dataset "Copy2" 667 ! 668 !write(*,*) "The data in dataset Copy2 is: " 669 !do i = 1, 3 670 ! print *, (bufnew(i,j), j = 1,4) 671 !end do 672 673 ! 674 !Close the datasets. 675 ! 676 CALL h5dclose_f(dset1_id, error) 677 CALL check("h5dclose_f", error, total_error) 678 679 CALL h5dclose_f(dset2_id, error) 680 CALL check("h5dclose_f", error, total_error) 681 682 ! 683 !Close the files. 684 ! 685 CALL h5fclose_f(file1_id, error) 686 CALL check("h5fclose_f", error, total_error) 687 688 CALL h5fclose_f(file2_id, error) 689 CALL check("h5fclose_f", error, total_error) 690 691 692 if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) 693 CALL check("h5_cleanup_f", error, total_error) 694 if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) 695 CALL check("h5_cleanup_f", error, total_error) 696 RETURN 697 END SUBROUTINE test_select_element 698 699 700 SUBROUTINE test_basic_select(cleanup, total_error) 701 702 IMPLICIT NONE 703 LOGICAL, INTENT(IN) :: cleanup 704 INTEGER, INTENT(INOUT) :: total_error 705 706 ! 707 !the dataset is stored in file "testselect.h5" 708 ! 709 CHARACTER(LEN=10), PARAMETER :: filename = "testselect" 710 CHARACTER(LEN=80) :: fix_filename 711 712 ! 713 !dataspace rank 714 ! 715 INTEGER, PARAMETER :: RANK = 2 716 717 ! 718 !select NUMP_POINTS points from the file 719 ! 720 INTEGER(SIZE_T), PARAMETER :: NUMPS = 10 721 722 ! 723 !dataset name is "testselect" 724 ! 725 CHARACTER(LEN=10), PARAMETER :: dsetname = "testselect" 726 727 INTEGER(HID_T) :: file_id ! File identifier 728 INTEGER(HID_T) :: dset_id ! Dataset identifier 729 INTEGER(HID_T) :: dataspace ! Dataspace identifier 730 731 ! 732 !Dataset dimensions 733 ! 734 INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/5,6/) 735 736 ! 737 !Size of the hyperslab in the file 738 ! 739 INTEGER(HSIZE_T), DIMENSION(2) :: count = (/2,2/) 740 741 ! 742 !hyperslab offset in the file 743 ! 744 INTEGER(HSIZE_T), DIMENSION(2) :: offset = (/0,0/) 745 746 ! 747 !start block for getting the selected hyperslab 748 ! 749 INTEGER(HSIZE_T) :: startblock = 0 750 751 ! 752 !start point for getting the selected elements 753 ! 754 INTEGER(HSIZE_T) :: startpoint = 0 755 756 ! 757 !Stride of the hyperslab in the file 758 ! 759 INTEGER(HSIZE_T), DIMENSION(2) :: stride = (/3,3/) 760 761 ! 762 !BLock size of the hyperslab in the file 763 ! 764 INTEGER(HSIZE_T), DIMENSION(2) :: block = (/2,2/) 765 766 ! 767 !array to give selected points' coordinations 768 ! 769 INTEGER(HSIZE_T), DIMENSION(RANK, NUMPS) :: coord 770 771 772 ! 773 !Number of hyperslabs selected in the current dataspace 774 ! 775 INTEGER(HSSIZE_T) :: num_blocks 776 777 ! 778 !allocatable array for putting a list of hyperslabs 779 !selected in the current file dataspace 780 ! 781 INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: blocklist 782 783 ! 784 !Number of points selected in the current dataspace 785 ! 786 INTEGER(HSSIZE_T) :: num_points 787 INTEGER(HSIZE_T) :: num1_points 788 789 ! 790 !allocatable array for putting a list of points 791 !selected in the current file dataspace 792 ! 793 INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: pointlist 794 795 ! 796 !start and end bounds in the current dataspace selection 797 ! 798 INTEGER(HSIZE_T), DIMENSION(RANK) :: startout, endout 799 800 ! 801 !data to write 802 ! 803 INTEGER, DIMENSION(5,6) :: data 804 805 ! 806 !flag to check operation success 807 ! 808 INTEGER :: error 809 INTEGER(HSIZE_T), DIMENSION(3) :: data_dims 810 811 ! 812 !initialize the coord array to give the selected points' position 813 ! 814 coord(1,1) = 1 815 coord(2,1) = 1 816 coord(1,2) = 1 817 coord(2,2) = 3 818 coord(1,3) = 1 819 coord(2,3) = 5 820 coord(1,4) = 3 821 coord(2,4) = 1 822 coord(1,5) = 3 823 coord(2,5) = 3 824 coord(1,6) = 3 825 coord(2,6) = 5 826 coord(1,7) = 4 827 coord(2,7) = 3 828 coord(1,8) = 4 829 coord(2,8) = 1 830 coord(1,9) = 5 831 coord(2,9) = 3 832 coord(1,10) = 5 833 coord(2,10) = 5 834 835 ! 836 !Create a new file using default properties. 837 ! 838 CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) 839 if (error .ne. 0) then 840 write(*,*) "Cannot modify filename" 841 stop 842 endif 843 CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) 844 CALL check("h5fcreate_f", error, total_error) 845 846 ! 847 !Create the data space for the dataset. 848 ! 849 CALL h5screate_simple_f(RANK, dimsf, dataspace, error) 850 CALL check("h5screate_simple_f", error, total_error) 851 852 ! 853 ! Create the dataset with default properties 854 ! 855 CALL h5dcreate_f(file_id, dsetname, H5T_STD_I32BE, dataspace, & 856 dset_id, error) 857 CALL check("h5dcreate_f", error, total_error) 858 859 ! 860 ! Write the dataset 861 ! 862 data_dims(1) = 5 863 data_dims(2) = 6 864 CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, data_dims, error) 865 CALL check("h5dwrite_f", error, total_error) 866 867 ! 868 !Close the dataspace for the dataset. 869 ! 870 CALL h5sclose_f(dataspace, error) 871 CALL check("h5sclose_f", error, total_error) 872 873 ! 874 !Close the dataset. 875 ! 876 CALL h5dclose_f(dset_id, error) 877 CALL check("h5dclose_f", error, total_error) 878 879 ! 880 !Close the file. 881 ! 882 CALL h5fclose_f(file_id, error) 883 CALL check("h5fclose_f", error, total_error) 884 885 ! 886 !Open the file. 887 ! 888 CALL h5fopen_f (fix_filename, H5F_ACC_RDONLY_F, file_id, error) 889 CALL check("h5fopen_f", error, total_error) 890 891 ! 892 !Open the dataset. 893 ! 894 CALL h5dopen_f(file_id, dsetname, dset_id, error) 895 CALL check("h5dopen_f", error, total_error) 896 897 ! 898 !Get dataset's dataspace handle. 899 ! 900 CALL h5dget_space_f(dset_id, dataspace, error) 901 CALL check("h5dget_space_f", error, total_error) 902 903 ! 904 !Select hyperslab in the dataset. 905 ! 906 CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, & 907 offset, count, error, stride, block) 908 CALL check("h5sselect_hyperslab_f", error, total_error) 909 910 ! 911 !get the number of hyperslab blocks in the current dataspac selection 912 ! 913 CALL h5sget_select_hyper_nblocks_f(dataspace, num_blocks, error) 914 CALL check("h5sget_select_hyper_nblocks_f", error, total_error) 915 IF (num_blocks .NE. 4) write (*,*) "error occured with num_blocks" 916 !write(*,*) num_blocks 917 !result of num_blocks is 4 918 919 ! 920 !allocate the blocklist array 921 ! 922 ALLOCATE(blocklist(num_blocks*RANK*2), STAT= error) 923 if(error .NE. 0) then 924 STOP 925 endif 926 927 ! 928 !get the list of hyperslabs selected in the current dataspac selection 929 ! 930 CALL h5sget_select_hyper_blocklist_f(dataspace, startblock, & 931 num_blocks, blocklist, error) 932 CALL check("h5sget_select_hyper_blocklist_f", error, total_error) 933! write(*,*) (blocklist(i), i =1, num_blocks*RANK*2) 934 !result of blocklist selected is: 935 !1, 1, 2, 2, 4, 1, 5, 2, 1, 4, 2, 5, 4, 4, 5, 5 936 937 ! 938 !deallocate the blocklist array 939 ! 940 DEALLOCATE(blocklist) 941 942 ! 943 !get the selection bounds in the current dataspac selection 944 ! 945 CALL h5sget_select_bounds_f(dataspace, startout, endout, error) 946 CALL check("h5sget_select_bounds_f", error, total_error) 947 IF ( (startout(1) .ne. 1) .or. (startout(2) .ne. 1) ) THEN 948 write(*,*) "error occured to select_bounds's start position" 949 END IF 950 951 IF ( (endout(1) .ne. 5) .or. (endout(2) .ne. 5) ) THEN 952 write(*,*) "error occured to select_bounds's end position" 953 END IF 954 !write(*,*) (startout(i), i = 1, RANK) 955 !result of startout is 0, 0 956 957 !write(*,*) (endout(i), i = 1, RANK) 958 !result of endout is 5, 5 959 960 ! 961 !allocate the pointlist array 962 ! 963! ALLOCATE(pointlist(num_blocks*RANK), STAT= error) 964 ALLOCATE(pointlist(20), STAT= error) 965 if(error .NE. 0) then 966 STOP 967 endif 968 969 ! 970 !Select the elements in file space 971 ! 972 CALL h5sselect_elements_f(dataspace, H5S_SELECT_SET_F, RANK, NUMPS,& 973 coord, error) 974 CALL check("h5sselect_elements_f", error, total_error) 975 976 ! 977 !Get the number of selected elements 978 ! 979 CALL h5sget_select_elem_npoints_f(dataspace, num_points, error) 980 CALL check("h5sget_select_elem_npoints_f", error, total_error) 981 IF (num_points .NE. 10) write(*,*) "error occured with num_points" 982 !write(*,*) num_points 983 ! result of num_points is 10 984 985 ! 986 !Get the list of selected elements 987 ! 988 num1_points = num_points 989 CALL h5sget_select_elem_pointlist_f(dataspace, startpoint, & 990 num1_points, pointlist, error) 991 CALL check("h5sget_select_elem_pointlist_f", error, total_error) 992 !write(*,*) (pointlist(i), i =1, num1_points*RANK) 993 !result of pintlist is: 994 !1, 1, 3, 1, 5, 1, 1, 3, 3, 3, 5, 3, 3, 995 !4, 1, 4, 3, 5, 5, 5 996 997 ! 998 !deallocate the pointlist array 999 ! 1000 DEALLOCATE(pointlist) 1001 1002 ! 1003 !Close the dataspace for the dataset. 1004 ! 1005 CALL h5sclose_f(dataspace, error) 1006 CALL check("h5sclose_f", error, total_error) 1007 1008 ! 1009 !Close the dataset. 1010 ! 1011 CALL h5dclose_f(dset_id, error) 1012 CALL check("h5dclose_f", error, total_error) 1013 1014 ! 1015 !Close the file. 1016 ! 1017 CALL h5fclose_f(file_id, error) 1018 CALL check("h5fclose_f", error, total_error) 1019 1020 1021 if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) 1022 CALL check("h5_cleanup_f", error, total_error) 1023 1024 RETURN 1025 END SUBROUTINE test_basic_select 1026 1027!*************************************************************** 1028!** 1029!** test_select_point(): Test basic H5S (dataspace) selection code. 1030!** Tests element selections between dataspaces of various sizes 1031!** and dimensionalities. 1032!** 1033!*************************************************************** 1034 1035SUBROUTINE test_select_point(cleanup, total_error) 1036 1037 IMPLICIT NONE 1038 LOGICAL, INTENT(IN) :: cleanup 1039 INTEGER, INTENT(INOUT) :: total_error 1040 INTEGER(HID_T) :: xfer_plist 1041 1042 INTEGER, PARAMETER :: SPACE1_DIM1=3 1043 INTEGER, PARAMETER :: SPACE1_DIM2=15 1044 INTEGER, PARAMETER :: SPACE1_DIM3=13 1045 INTEGER, PARAMETER :: SPACE2_DIM1=30 1046 INTEGER, PARAMETER :: SPACE2_DIM2=26 1047 INTEGER, PARAMETER :: SPACE3_DIM1=15 1048 INTEGER, PARAMETER :: SPACE3_DIM2=26 1049 1050 INTEGER, PARAMETER :: SPACE1_RANK=3 1051 INTEGER, PARAMETER :: SPACE2_RANK=2 1052 INTEGER, PARAMETER :: SPACE3_RANK=2 1053 1054 ! Element selection information 1055 INTEGER, PARAMETER :: POINT1_NPOINTS=10 1056 INTEGER(hid_t) ::fid1 ! HDF5 File IDs 1057 INTEGER(hid_t) ::dataset ! Dataset ID 1058 INTEGER(hid_t) ::sid1,sid2 ! Dataspace ID 1059 INTEGER(hsize_t), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/) 1060 INTEGER(hsize_t), DIMENSION(1:2) :: dims2 = (/SPACE2_DIM1, SPACE2_DIM2/) 1061 INTEGER(hsize_t), DIMENSION(1:2) :: dims3 = (/SPACE3_DIM1, SPACE3_DIM2/) 1062 1063 INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: coord1 ! Coordinates for point selection 1064 INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: temp_coord1 ! Coordinates for point selection 1065 INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: coord2 ! Coordinates for point selection 1066 INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: temp_coord2 ! Coordinates for point selection 1067 INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: coord3 ! Coordinates for point selection 1068 INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: temp_coord3 ! Coordinates for point selection 1069 INTEGER(hssize_t) :: npoints 1070 1071!!$ uint8_t *wbuf, buffer to write to disk 1072!!$ *rbuf, buffer read from disk 1073!!$ *tbuf; temporary buffer pointer 1074 INTEGER :: i,j; ! Counters 1075! struct pnt_iter pi; Custom Pointer iterator struct 1076 INTEGER :: error ! Generic return value 1077 CHARACTER(LEN=9) :: filename = 'h5s_hyper' 1078 CHARACTER(LEN=80) :: fix_filename 1079 CHARACTER(LEN=1), DIMENSION(1:SPACE2_DIM1,1:SPACE2_DIM2) :: wbuf 1080 1081 CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) 1082 IF (error .NE. 0) THEN 1083 WRITE(*,*) "Cannot modify filename" 1084 STOP 1085 ENDIF 1086 xfer_plist = H5P_DEFAULT_F 1087! MESSAGE(5, ("Testing Element Selection Functions\n")); 1088 1089 ! Allocate write & read buffers 1090!!$ wbuf = HDmalloc(sizeof(uint8_t) * SPACE2_DIM1 * SPACE2_DIM2); 1091!!$ rbuf = HDcalloc(sizeof(uint8_t), (size_t)(SPACE3_DIM1 * SPACE3_DIM2)); 1092!!$ 1093 ! Initialize WRITE buffer 1094 1095 DO i = 1, SPACE2_DIM1 1096 DO j = 1, SPACE2_DIM2 1097 wbuf(i,j) = 'a' 1098 ENDDO 1099 ENDDO 1100 1101!!$ for(i=0, tbuf=wbuf; i<SPACE2_DIM1; i++) 1102!!$ for(j=0; j<SPACE2_DIM2; j++) 1103!!$ *tbuf++=(uint8_t)((i*SPACE2_DIM2)+j); 1104 1105 ! Create file 1106 CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid1, error) 1107 CALL check("h5fcreate_f", error, total_error) 1108 1109 ! Create dataspace for dataset 1110 CALL h5screate_simple_f(SPACE1_RANK, dims1, sid1, error) 1111 CALL check("h5screate_simple_f", error, total_error) 1112 1113 ! Create dataspace for write buffer 1114 CALL h5screate_simple_f(SPACE2_RANK, dims2, sid2, error) 1115 CALL check("h5screate_simple_f", error, total_error) 1116 1117 ! Select sequence of ten points for disk dataset 1118 coord1(1,1)=1; coord1(2,1)=11; coord1(3,1)= 6; 1119 coord1(1,2)=2; coord1(2,2)= 3; coord1(3,2)= 8; 1120 coord1(1,3)=3; coord1(2,3)= 5; coord1(3,3)=10; 1121 coord1(1,4)=1; coord1(2,4)= 7; coord1(3,4)=12; 1122 coord1(1,5)=2; coord1(2,5)= 9; coord1(3,5)=14; 1123 coord1(1,6)=3; coord1(2,6)=13; coord1(3,6)= 1; 1124 coord1(1,7)=1; coord1(2,7)=15; coord1(3,7)= 3; 1125 coord1(1,8)=2; coord1(2,8)= 1; coord1(3,8)= 5; 1126 coord1(1,9)=3; coord1(2,9)= 2; coord1(3,9)= 7; 1127 coord1(1,10)=1; coord1(2,10)= 4; coord1(3,10)= 9 1128 1129 CALL h5sselect_elements_f(sid1, H5S_SELECT_SET_F, SPACE1_RANK, INT(POINT1_NPOINTS,size_t), coord1, error) 1130 CALL check("h5sselect_elements_f", error, total_error) 1131 1132 ! Verify correct elements selected 1133 1134 CALL h5sget_select_elem_pointlist_f(sid1, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord1,error) 1135 CALL check("h5sget_select_elem_pointlist_f", error, total_error) 1136 1137 DO i= 1, POINT1_NPOINTS 1138 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(1,i)), INT(coord1(1,i)), total_error) 1139 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(2,i)), INT(coord1(2,i)), total_error) 1140 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(3,i)), INT(coord1(3,i)), total_error) 1141 ENDDO 1142 1143 CALL H5Sget_select_npoints_f(sid1, npoints, error) 1144 CALL check("h5sget_select_npoints_f", error, total_error) 1145 CALL verify("h5sget_select_npoints_f", INT(npoints), 10, total_error) 1146 1147 ! Append another sequence of ten points to disk dataset 1148 1149 coord1(1,1)=1; coord1(2,1)=3; coord1(3,1)= 1; 1150 coord1(1,2)=2; coord1(2,2)=11; coord1(3,2)= 9; 1151 coord1(1,3)=3; coord1(2,3)= 9; coord1(3,3)=11; 1152 coord1(1,4)=1; coord1(2,4)= 8; coord1(3,4)=13; 1153 coord1(1,5)=2; coord1(2,5)= 4; coord1(3,5)=12; 1154 coord1(1,6)=3; coord1(2,6)= 2; coord1(3,6)= 2; 1155 coord1(1,7)=1; coord1(2,7)=14; coord1(3,7)= 8; 1156 coord1(1,8)=2; coord1(2,8)=15; coord1(3,8)= 7; 1157 coord1(1,9)=3; coord1(2,9)= 3; coord1(3,9)= 6; 1158 coord1(1,10)=1; coord1(2,10)= 7; coord1(3,10)= 14 1159 1160 1161 CALL h5sselect_elements_f(sid1, H5S_SELECT_APPEND_F, SPACE1_RANK, INT(POINT1_NPOINTS,size_t), coord1, error) 1162 CALL check("h5sselect_elements_f", error, total_error) 1163 ! Verify correct elements selected 1164 1165 CALL h5sget_select_elem_pointlist_f(sid1, INT(POINT1_NPOINTS,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord1,error) 1166 CALL check("h5sget_select_elem_pointlist_f", error, total_error) 1167 1168 DO i= 1, POINT1_NPOINTS 1169 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(1,i)), INT(coord1(1,i)), total_error) 1170 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(2,i)), INT(coord1(2,i)), total_error) 1171 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord1(3,i)), INT(coord1(3,i)), total_error) 1172 ENDDO 1173 1174 CALL H5Sget_select_npoints_f(sid1, npoints, error) 1175 CALL check("h5sget_select_npoints_f", error, total_error) 1176 CALL verify("h5sget_select_npoints_f", INT(npoints), 20, total_error) 1177 1178 ! Select sequence of ten points for memory dataset 1179 coord2(1,1)=13; coord2(2,1)= 4; 1180 coord2(1,2)=16; coord2(2,2)=14; 1181 coord2(1,3)= 8; coord2(2,3)=26; 1182 coord2(1,4)= 1; coord2(2,4)= 7; 1183 coord2(1,5)=14; coord2(2,5)= 1; 1184 coord2(1,6)=25; coord2(2,6)=12; 1185 coord2(1,7)=13; coord2(2,7)=22; 1186 coord2(1,8)=30; coord2(2,8)= 5; 1187 coord2(1,9)= 9; coord2(2,9)= 9; 1188 coord2(1,10)=20; coord2(2,10)=18 1189 1190 CALL h5sselect_elements_f(sid2, H5S_SELECT_SET_F, SPACE2_RANK, INT(POINT1_NPOINTS,size_t), coord2, error) 1191 CALL check("h5sselect_elements_f", error, total_error) 1192 1193 1194 ! Verify correct elements selected 1195 1196 CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord2,error) 1197 CALL check("h5sget_select_elem_pointlist_f", error, total_error) 1198 1199 DO i= 1, POINT1_NPOINTS 1200 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(1,i)), INT(coord2(1,i)), total_error) 1201 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(2,i)), INT(coord2(2,i)), total_error) 1202 ENDDO 1203 1204!!$ 1205!!$ Save points for later iteration 1206!!$ (these are in the second half of the buffer, because we are prepending 1207!!$ the next list of points to the beginning of the point selection list) 1208!!$ HDmemcpy(((char *)pi.coord)+sizeof(coord2),coord2,sizeof(coord2)); 1209!!$ 1210 1211 CALL H5Sget_select_npoints_f(sid2, npoints, error) 1212 CALL check("h5sget_select_npoints_f", error, total_error) 1213 CALL verify("h5sget_select_npoints_f", INT(npoints), 10, total_error) 1214 1215 ! Append another sequence of ten points to memory dataset 1216 coord2(1,1)=25; coord2(2,1)= 1; 1217 coord2(1,2)= 3; coord2(2,2)=26; 1218 coord2(1,3)=14; coord2(2,3)=18; 1219 coord2(1,4)= 9; coord2(2,4)= 4; 1220 coord2(1,5)=30; coord2(2,5)= 5; 1221 coord2(1,6)=12; coord2(2,6)=15; 1222 coord2(1,7)= 6; coord2(2,7)=23; 1223 coord2(1,8)=13; coord2(2,8)= 3; 1224 coord2(1,9)=22; coord2(2,9)=13; 1225 coord2(1,10)= 10; coord2(2,10)=19 1226 1227 CALL h5sselect_elements_f(sid2, H5S_SELECT_PREPEND_F, SPACE2_RANK, INT(POINT1_NPOINTS,size_t), coord2, error) 1228 CALL check("h5sselect_elements_f", error, total_error) 1229 1230 1231 ! Verify correct elements selected 1232 CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord2,error) 1233 CALL check("h5sget_select_elem_pointlist_f", error, total_error) 1234 1235 DO i= 1, POINT1_NPOINTS 1236 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(1,i)), INT(coord2(1,i)), total_error) 1237 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord2(2,i)), INT(coord2(2,i)), total_error) 1238 ENDDO 1239 1240 CALL H5Sget_select_npoints_f(sid2, npoints, error) 1241 CALL check("h5sget_select_npoints_f", error, total_error) 1242 CALL verify("h5sget_select_npoints_f", INT(npoints), 20, total_error) 1243 1244!!$ Save points for later iteration 1245!!$ HDmemcpy(pi.coord,coord2,sizeof(coord2)); 1246 1247 ! Create a dataset 1248 CALL h5dcreate_f(fid1, "Dataset1", H5T_NATIVE_CHARACTER, sid1, dataset, error) 1249 CALL check("h5dcreate_f", error, total_error) 1250 1251 ! Write selection to disk 1252 CALL h5dwrite_f(dataset, H5T_NATIVE_CHARACTER, wbuf, dims2, error, sid2, sid1, xfer_plist) 1253 CALL check("h5dwrite_f", error, total_error) 1254 1255 ! Close memory dataspace 1256 CALL h5sclose_f(sid2, error) 1257 CALL check("h5sclose_f", error, total_error) 1258 1259 ! Create dataspace for reading buffer 1260 CALL h5screate_simple_f(SPACE3_RANK, dims3, sid2, error) 1261 CALL check("h5screate_simple_f", error, total_error) 1262 1263 ! Select sequence of points for read dataset 1264 coord3(1,1)= 1; coord3(2,1)= 3; 1265 coord3(1,2)= 5; coord3(2,2)= 9; 1266 coord3(1,3)=14; coord3(2,3)=14; 1267 coord3(1,4)=15; coord3(2,4)=21; 1268 coord3(1,5)= 8; coord3(2,5)=10; 1269 coord3(1,6)= 3; coord3(2,6)= 1; 1270 coord3(1,7)= 10; coord3(2,7)=20; 1271 coord3(1,8)= 2; coord3(2,8)=23; 1272 coord3(1,9)=13; coord3(2,9)=22; 1273 coord3(1,10)=12; coord3(2,10)=7; 1274 1275 CALL h5sselect_elements_f(sid2, H5S_SELECT_SET_F, SPACE3_RANK, INT(POINT1_NPOINTS,size_t), coord3, error) 1276 CALL check("h5sselect_elements_f", error, total_error) 1277 1278 ! Verify correct elements selected 1279 CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord3,error) 1280 CALL check("h5sget_select_elem_pointlist_f", error, total_error) 1281 DO i= 1, POINT1_NPOINTS 1282 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(1,i)), INT(coord3(1,i)), total_error) 1283 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(2,i)), INT(coord3(2,i)), total_error) 1284 ENDDO 1285 1286 CALL H5Sget_select_npoints_f(sid2, npoints, error) 1287 CALL check("h5sget_select_npoints_f", error, total_error) 1288 CALL verify("h5sget_select_npoints_f", INT(npoints), 10, total_error) 1289 1290 ! Append another sequence of ten points to disk dataset 1291 coord3(1,1)=15; coord3(2,1)=26; 1292 coord3(1,2)= 1; coord3(2,2)= 1; 1293 coord3(1,3)=12; coord3(2,3)=12; 1294 coord3(1,4)= 6; coord3(2,4)=15; 1295 coord3(1,5)= 4; coord3(2,5)= 6; 1296 coord3(1,6)= 3; coord3(2,6)= 3; 1297 coord3(1,7)= 8; coord3(2,7)=14; 1298 coord3(1,8)=10; coord3(2,8)=17; 1299 coord3(1,9)=13; coord3(2,9)=23; 1300 coord3(1,10)=14; coord3(2,10)=10 1301 1302 CALL h5sselect_elements_f(sid2, H5S_SELECT_APPEND_F, SPACE3_RANK, INT(POINT1_NPOINTS,size_t), coord3, error) 1303 CALL check("h5sselect_elements_f", error, total_error) 1304 1305 ! Verify correct elements selected 1306 CALL h5sget_select_elem_pointlist_f(sid2, INT(POINT1_NPOINTS,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord3,error) 1307 CALL check("h5sget_select_elem_pointlist_f", error, total_error) 1308 DO i= 1, POINT1_NPOINTS 1309 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(1,i)), INT(coord3(1,i)), total_error) 1310 CALL verify("h5sget_select_elem_pointlist_f", INT(temp_coord3(2,i)), INT(coord3(2,i)), total_error) 1311 ENDDO 1312 1313 CALL H5Sget_select_npoints_f(sid2, npoints, error) 1314 CALL check("h5sget_select_npoints_f", error, total_error) 1315 CALL verify("h5sget_select_npoints_f", INT(npoints), 20, total_error) 1316 1317! F2003 feature 1318!!$ Read selection from disk 1319!!$ ret=H5Dread(dataset,H5T_NATIVE_UCHAR,sid2,sid1,xfer_plist,rbuf); 1320!!$ CHECK(ret, FAIL, "H5Dread"); 1321!!$ 1322!!$ Check that the values match with a dataset iterator 1323!!$ pi.buf=wbuf; 1324!!$ pi.offset=0; 1325!!$ ret = H5Diterate(rbuf,H5T_NATIVE_UCHAR,sid2,test_select_point_iter1,&pi); 1326!!$ CHECK(ret, FAIL, "H5Diterate"); 1327!!$ 1328! F2003 feature 1329 1330 ! Close memory dataspace 1331 CALL h5sclose_f(sid2, error) 1332 CALL check("h5sclose_f", error, total_error) 1333 1334 ! Close disk dataspace 1335 CALL h5sclose_f(sid1, error) 1336 CALL check("h5sclose_f", error, total_error) 1337 1338 ! Close Dataset 1339 CALL h5dclose_f(dataset, error) 1340 CALL check("h5dclose_f", error, total_error) 1341 1342 ! Close file 1343 CALL h5fclose_f(fid1, error) 1344 CALL check("h5fclose_f", error, total_error) 1345 1346 IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) 1347 CALL check("h5_cleanup_f", error, total_error) 1348 1349END SUBROUTINE test_select_point 1350 1351 1352!*************************************************************** 1353!** 1354!** test_select_combine(): Test basic H5S (dataspace) selection code. 1355!** Tests combining "all" and "none" selections with hyperslab 1356!** operations. 1357!** 1358!*************************************************************** 1359 1360SUBROUTINE test_select_combine(total_error) 1361 1362 IMPLICIT NONE 1363 INTEGER, INTENT(INOUT) :: total_error 1364 1365 INTEGER, PARAMETER :: SPACE7_RANK = 2 1366 INTEGER, PARAMETER :: SPACE7_DIM1 = 10 1367 INTEGER, PARAMETER :: SPACE7_DIM2 = 10 1368 1369 INTEGER(hid_t) :: base_id ! Base dataspace for test 1370 INTEGER(hid_t) :: all_id ! Dataspace for "all" selection 1371 INTEGER(hid_t) :: none_id ! Dataspace for "none" selection 1372 INTEGER(hid_t) :: space1 ! Temporary dataspace #1 1373 INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: start ! Hyperslab start 1374 INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: stride ! Hyperslab stride 1375 INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: icount ! Hyperslab count 1376 INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: iblock ! Hyperslab BLOCK 1377 INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: dims = (/SPACE7_DIM1,SPACE7_DIM2/) ! Dimensions of dataspace 1378 INTEGER :: sel_type ! Selection type 1379 INTEGER(hssize_t) :: nblocks ! Number of hyperslab blocks 1380 INTEGER(hsize_t), DIMENSION(1:128,1:2,1:SPACE7_RANK) :: blocks ! List of blocks 1381 INTEGER :: error, area 1382 1383 ! Create dataspace for dataset on disk 1384 CALL h5screate_simple_f(SPACE7_RANK, dims, base_id, error) 1385 CALL check("h5screate_simple_f", error, total_error) 1386 1387 ! Copy base dataspace and set selection to "all" 1388 CALL h5scopy_f(base_id, all_id, error) 1389 CALL check("h5scopy_f", error, total_error) 1390 1391 CALL H5Sselect_all_f(all_id, error) 1392 CALL check("H5Sselect_all_f", error, total_error) 1393 1394 CALL H5Sget_select_type_f(all_id, sel_type, error) 1395 CALL check("H5Sget_select_type_f", error, total_error) 1396 CALL verify("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error) 1397 1398 ! Copy base dataspace and set selection to "none" 1399 CALL h5scopy_f(base_id, none_id, error) 1400 CALL check("h5scopy_f", error, total_error) 1401 1402 CALL H5Sselect_none_f(none_id, error) 1403 CALL check("H5Sselect_none_f", error, total_error) 1404 1405 CALL H5Sget_select_type_f(none_id, sel_type, error) 1406 CALL check("H5Sget_select_type_f", error, total_error) 1407 CALL verify("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_NONE_F), total_error) 1408 1409 ! Copy "all" selection & space 1410 CALL H5Scopy_f(all_id, space1, error) 1411 CALL check("h5scopy_f", error, total_error) 1412 1413 ! 'OR' "all" selection with another hyperslab 1414 start(1:2) = 0 1415 stride(1:2) = 1 1416 icount(1:2) = 1 1417 iblock(1:2) = (/5,4/) 1418 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_OR_F, start, & 1419 icount, error, stride, iblock) 1420 CALL check("h5sselect_hyperslab_f", error, total_error) 1421 1422 ! Verify that it's still "all" selection 1423 CALL H5Sget_select_type_f(space1, sel_type, error) 1424 CALL check("H5Sget_select_type_f", error, total_error) 1425 CALL verify("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error) 1426 1427 ! Close temporary dataspace 1428 CALL h5sclose_f(space1, error) 1429 CALL check("h5sclose_f", error, total_error) 1430 1431 ! Copy "all" selection & space 1432 CALL H5Scopy_f(all_id, space1, error) 1433 CALL check("h5scopy_f", error, total_error) 1434 1435 ! 'AND' "all" selection with another hyperslab 1436 start(1:2) = 0 1437 stride(1:2) = 1 1438 icount(1:2) = 1 1439 iblock(1:2) = (/5,4/) 1440 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_AND_F, start, & 1441 icount, error, stride, iblock) 1442 CALL check("h5sselect_hyperslab_f", error, total_error) 1443 1444 ! Verify that the new selection is the same at the original block 1445 CALL H5Sget_select_type_f(space1, sel_type, error) 1446 CALL check("H5Sget_select_type_f", error, total_error) 1447 CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) 1448 1449 ! Verify that there is only one block 1450 CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) 1451 CALL check("h5sget_select_hyper_nblocks_f", error, total_error) 1452 CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error) 1453 1454 ! Retrieve the block defined 1455 CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) 1456 CALL check("h5sget_select_hyper_blocklist_f", error, total_error) 1457 1458 ! Verify that the correct block is defined 1459 1460 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) 1461 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error) 1462 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) 1463 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error) 1464 1465 ! Close temporary dataspace 1466 CALL h5sclose_f(space1, error) 1467 CALL check("h5sclose_f", error, total_error) 1468 1469 ! Copy "all" selection & space 1470 CALL H5Scopy_f(all_id, space1, error) 1471 CALL check("h5scopy_f", error, total_error) 1472 1473 ! 'XOR' "all" selection with another hyperslab 1474 start(1:2) = 0 1475 stride(1:2) = 1 1476 icount(1:2) = 1 1477 iblock(1:2) = (/5,4/) 1478 1479 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_XOR_F, start, & 1480 icount, error, stride, iblock) 1481 CALL check("h5sselect_hyperslab_f", error, total_error) 1482 1483 ! Verify that the new selection is an inversion of the original block 1484 CALL H5Sget_select_type_f(space1, sel_type, error) 1485 CALL check("H5Sget_select_type_f", error, total_error) 1486 CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) 1487 1488 ! Verify that there are two blocks 1489 CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) 1490 CALL check("h5sget_select_hyper_nblocks_f", error, total_error) 1491 CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error) 1492 1493 ! Retrieve the block defined 1494 1495 blocks = -1 ! Reset block list 1496 CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) 1497 CALL check("h5sget_select_hyper_blocklist_f", error, total_error) 1498 1499 ! Verify that the correct block is defined 1500 1501 ! No guarantee is implied as the order in which blocks are listed. 1502 ! So this will ONLY work for square domains iblock(1:2) = (/5,5/) 1503!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) 1504!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error) 1505!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) 1506!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 10, total_error) 1507!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(5,1,1)), 6, total_error) 1508!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(6,1,1)), 1, total_error) 1509!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(7,1,1)), 10, total_error) 1510!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(8,1,1)), 10, total_error) 1511 1512 ! Otherwise make sure the "area" of the block is correct 1513 area = (ABS(INT(blocks(1,1,1)-blocks(3,1,1)))+1)*(ABS(INT(blocks(2,1,1)-blocks(4,1,1)))+1) 1514 area = area + (ABS(INT(blocks(5,1,1)-blocks(7,1,1)))+1)*(ABS(INT(blocks(6,1,1)-blocks(8,1,1)))+1) 1515 CALL verify("h5sget_select_hyper_blocklist_f", area, 80, total_error) 1516 1517 ! Close temporary dataspace 1518 CALL h5sclose_f(space1, error) 1519 CALL check("h5sclose_f", error, total_error) 1520 1521 ! Copy "all" selection & space 1522 CALL H5Scopy_f(all_id, space1, error) 1523 CALL check("h5scopy_f", error, total_error) 1524 1525 ! 'NOTB' "all" selection with another hyperslab 1526 start(1:2) = 0 1527 stride(1:2) = 1 1528 icount(1:2) = 1 1529 iblock(1:2) = (/5,4/) !5 1530 1531 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTB_F, start, & 1532 icount, error, stride, iblock) 1533 CALL check("h5sselect_hyperslab_f", error, total_error) 1534 1535 ! Verify that the new selection is an inversion of the original block 1536 CALL H5Sget_select_type_f(space1, sel_type, error) 1537 CALL check("H5Sget_select_type_f", error, total_error) 1538 CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) 1539 1540 ! Verify that there are two blocks 1541 CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) 1542 CALL check("h5sget_select_hyper_nblocks_f", error, total_error) 1543 CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error) 1544 1545 ! Retrieve the block defined 1546 blocks = -1 ! Reset block list 1547 CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) 1548 CALL check("h5sget_select_hyper_blocklist_f", error, total_error) 1549 1550 ! Verify that the correct block is defined 1551 1552 ! No guarantee is implied as the order in which blocks are listed. 1553 ! So this will ONLY work for square domains iblock(1:2) = (/5,5/) 1554 1555!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) 1556!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error) 1557!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) 1558!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)),10, total_error) 1559!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(5,1,1)), 6, total_error) 1560!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(6,1,1)), 1, total_error) 1561!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(7,1,1)),10, total_error) 1562!!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(8,1,1)),10, total_error) 1563 1564 ! Otherwise make sure the "area" of the block is correct 1565 area = (ABS(INT(blocks(1,1,1)-blocks(3,1,1)))+1)*(ABS(INT(blocks(2,1,1)-blocks(4,1,1)))+1) 1566 area = area + (ABS(INT(blocks(5,1,1)-blocks(7,1,1)))+1)*(ABS(INT(blocks(6,1,1)-blocks(8,1,1)))+1) 1567 CALL verify("h5sget_select_hyper_blocklist_f", area, 80, total_error) 1568 1569 1570 ! Close temporary dataspace 1571 CALL h5sclose_f(space1, error) 1572 CALL check("h5sclose_f", error, total_error) 1573 ! Copy "all" selection & space 1574 CALL H5Scopy_f(all_id, space1, error) 1575 CALL check("h5scopy_f", error, total_error) 1576 1577 ! 'NOTA' "all" selection with another hyperslab 1578 start(1:2) = 0 1579 stride(1:2) = 1 1580 icount(1:2) = 1 1581 iblock(1:2) = (/5,4/) !5 1582 1583 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTA_F, start, & 1584 icount, error, stride, iblock) 1585 CALL check("h5sselect_hyperslab_f", error, total_error) 1586 1587 ! Verify that the new selection is the "none" selection 1588 CALL H5Sget_select_type_f(space1, sel_type, error) 1589 CALL check("H5Sget_select_type_f", error, total_error) 1590 CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error) 1591 1592 ! Close temporary dataspace 1593 CALL h5sclose_f(space1, error) 1594 CALL check("h5sclose_f", error, total_error) 1595 1596 ! Copy "none" selection & space 1597 CALL H5Scopy_f(none_id, space1, error) 1598 CALL check("h5scopy_f", error, total_error) 1599 1600 ! 'OR' "none" selection with another hyperslab 1601 start(1:2) = 0 1602 stride(1:2) = 1 1603 icount(1:2) = 1 1604 iblock(1:2) = (/5,4/) !5 1605 1606 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_OR_F, start, & 1607 icount, error, stride, iblock) 1608 CALL check("h5sselect_hyperslab_f", error, total_error) 1609 1610 ! Verify that the new selection is the same as the original hyperslab 1611 CALL H5Sget_select_type_f(space1, sel_type, error) 1612 CALL check("H5Sget_select_type_f", error, total_error) 1613 CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) 1614 1615 1616 ! Verify that there is only one block 1617 CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) 1618 CALL check("h5sget_select_hyper_nblocks_f", error, total_error) 1619 CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error) 1620 1621 ! Retrieve the block defined 1622 blocks = -1 ! Reset block list 1623 CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) 1624 CALL check("h5sget_select_hyper_blocklist_f", error, total_error) 1625 1626 ! Verify that the correct block is defined 1627 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) 1628 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error) 1629 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) 1630 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error) 1631 1632 ! Close temporary dataspace 1633 CALL h5sclose_f(space1, error) 1634 CALL check("h5sclose_f", error, total_error) 1635 1636 ! Copy "none" selection & space 1637 CALL H5Scopy_f(none_id, space1, error) 1638 CALL check("h5scopy_f", error, total_error) 1639 1640 ! 'AND' "none" selection with another hyperslab 1641 start(1:2) = 0 1642 stride(1:2) = 1 1643 icount(1:2) = 1 1644 iblock(1:2) = (/5,4/) !5 1645 1646 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_AND_F, start, & 1647 icount, error, stride, iblock) 1648 CALL check("h5sselect_hyperslab_f", error, total_error) 1649 1650 ! Verify that the new selection is the "none" selection 1651 CALL H5Sget_select_type_f(space1, sel_type, error) 1652 CALL check("H5Sget_select_type_f", error, total_error) 1653 CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error) 1654 1655 ! Close temporary dataspace 1656 CALL h5sclose_f(space1, error) 1657 CALL check("h5sclose_f", error, total_error) 1658 1659 ! Copy "none" selection & space 1660 CALL H5Scopy_f(none_id, space1, error) 1661 CALL check("h5scopy_f", error, total_error) 1662 1663 ! 'XOR' "none" selection with another hyperslab 1664 start(1:2) = 0 1665 stride(1:2) = 1 1666 icount(1:2) = 1 1667 iblock(1:2) = (/5,4/) !5 1668 1669 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_XOR_F, start, & 1670 icount, error, stride, iblock) 1671 CALL check("h5sselect_hyperslab_f", error, total_error) 1672 1673 ! Verify that the new selection is the same as the original hyperslab 1674 CALL H5Sget_select_type_f(space1, sel_type, error) 1675 CALL check("H5Sget_select_type_f", error, total_error) 1676 CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) 1677 1678 1679 ! Verify that there is only one block 1680 CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) 1681 CALL check("h5sget_select_hyper_nblocks_f", error, total_error) 1682 CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error) 1683 1684 ! Retrieve the block defined 1685 blocks = -1 ! Reset block list 1686 CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) 1687 CALL check("h5sget_select_hyper_blocklist_f", error, total_error) 1688 ! Verify that the correct block is defined 1689 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) 1690 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error) 1691 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) 1692 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error) 1693 1694 ! Close temporary dataspace 1695 CALL h5sclose_f(space1, error) 1696 CALL check("h5sclose_f", error, total_error) 1697 1698 ! Copy "none" selection & space 1699 CALL H5Scopy_f(none_id, space1, error) 1700 CALL check("h5scopy_f", error, total_error) 1701 1702 ! 'NOTB' "none" selection with another hyperslab 1703 start(1:2) = 0 1704 stride(1:2) = 1 1705 icount(1:2) = 1 1706 iblock(1:2) = (/5,4/) !5 1707 1708 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTB_F, start, & 1709 icount, error, stride, iblock) 1710 CALL check("h5sselect_hyperslab_f", error, total_error) 1711 1712 ! Verify that the new selection is the "none" selection 1713 CALL H5Sget_select_type_f(space1, sel_type, error) 1714 CALL check("H5Sget_select_type_f", error, total_error) 1715 CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error) 1716 1717 ! Close temporary dataspace 1718 CALL h5sclose_f(space1, error) 1719 CALL check("h5sclose_f", error, total_error) 1720 1721 ! Copy "none" selection & space 1722 CALL H5Scopy_f(none_id, space1, error) 1723 CALL check("h5scopy_f", error, total_error) 1724 1725 ! 'NOTA' "none" selection with another hyperslab 1726 start(1:2) = 0 1727 stride(1:2) = 1 1728 icount(1:2) = 1 1729 iblock(1:2) = (/5,4/) !5 1730 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTA_F, start, & 1731 icount, error, stride, iblock) 1732 CALL check("h5sselect_hyperslab_f", error, total_error) 1733 1734 ! Verify that the new selection is the same as the original hyperslab 1735 CALL H5Sget_select_type_f(space1, sel_type, error) 1736 CALL check("H5Sget_select_type_f", error, total_error) 1737 CALL verify("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) 1738 1739 ! Verify that there is ONLY one BLOCK 1740 CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) 1741 CALL check("h5sget_select_hyper_nblocks_f", error, total_error) 1742 CALL verify("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error) 1743 1744 ! Retrieve the block defined 1745 1746 blocks = -1 ! Reset block list 1747 CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) 1748 CALL check("h5sget_select_hyper_blocklist_f", error, total_error) 1749 1750 1751 ! Verify that the correct block is defined 1752 1753 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) 1754 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error) 1755 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) 1756 CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error) 1757 1758 ! Close temporary dataspace 1759 CALL h5sclose_f(space1, error) 1760 CALL check("h5sclose_f", error, total_error) 1761 1762 ! Close dataspaces 1763 1764 CALL h5sclose_f(base_id, error) 1765 CALL check("h5sclose_f", error, total_error) 1766 CALL h5sclose_f(all_id, error) 1767 CALL check("h5sclose_f", error, total_error) 1768 CALL h5sclose_f(none_id, error) 1769 CALL check("h5sclose_f", error, total_error) 1770 1771END SUBROUTINE test_select_combine 1772 1773!*************************************************************** 1774!** 1775!** test_select_bounds(): Tests selection bounds on dataspaces, 1776!** both with and without offsets. 1777!** 1778!*************************************************************** 1779 1780SUBROUTINE test_select_bounds(total_error) 1781 1782 IMPLICIT NONE 1783 INTEGER, INTENT(INOUT) :: total_error 1784 1785 INTEGER, PARAMETER :: SPACE11_RANK=2 1786 INTEGER, PARAMETER :: SPACE11_DIM1=100 1787 INTEGER, PARAMETER :: SPACE11_DIM2=50 1788 INTEGER, PARAMETER :: SPACE11_NPOINTS=4 1789 1790 INTEGER(hid_t) :: sid ! Dataspace ID 1791 INTEGER(hsize_t), DIMENSION(1:SPACE11_RANK) :: dims = (/SPACE11_DIM1, SPACE11_DIM2/) !Dataspace dimensions 1792 INTEGER(hsize_t), DIMENSION(SPACE11_RANK, SPACE11_NPOINTS) :: coord ! Coordinates for point selection 1793 INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: start ! The start of the hyperslab 1794 INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: stride ! The stride between block starts for the hyperslab 1795 INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: count ! The number of blocks for the hyperslab 1796 INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: BLOCK ! The size of each block for the hyperslab 1797 INTEGER(hssize_t), DIMENSION(SPACE11_RANK) :: offset ! Offset amount for selection 1798 INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: low_bounds ! The low bounds for the selection 1799 INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: high_bounds ! The high bounds for the selection 1800 1801 INTEGER :: error 1802 1803 ! Create dataspace 1804 CALL h5screate_simple_f(SPACE11_RANK, dims, sid, error) 1805 CALL check("h5screate_simple_f", error, total_error) 1806 1807 ! Get bounds for 'all' selection 1808 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1809 CALL check("h5sget_select_bounds_f", error, total_error) 1810 1811 CALL verify("h5sget_select_bounds_f", low_bounds(1), 1_hsize_t, total_error) 1812 CALL verify("h5sget_select_bounds_f", low_bounds(2), 1_hsize_t, total_error) 1813 CALL verify("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1, hsize_t), total_error) 1814 CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2, hsize_t), total_error) 1815 1816 ! Set offset for selection 1817 offset(1:2) = 1 1818 CALL H5Soffset_simple_f(sid, offset, error) 1819 CALL check("H5Soffset_simple_f", error, total_error) 1820 1821 ! Get bounds for 'all' selection with offset (which should be ignored) 1822 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1823 CALL check("h5sget_select_bounds_f", error, total_error) 1824 1825 CALL verify("h5sget_select_bounds_f", low_bounds(1), 1_hsize_t, total_error) 1826 CALL verify("h5sget_select_bounds_f", low_bounds(2), 1_hsize_t, total_error) 1827 CALL VERIFY("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1, hsize_t), total_error) 1828 CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2, hsize_t), total_error) 1829 1830 ! Reset offset for selection 1831 offset(1:2) = 0 1832 CALL H5Soffset_simple_f(sid, offset, error) 1833 CALL check("H5Soffset_simple_f", error, total_error) 1834 1835 ! Set 'none' selection 1836 CALL H5Sselect_none_f(sid, error) 1837 CALL check("H5Sselect_none_f", error, total_error) 1838 1839 ! Get bounds for 'none' selection, should fail 1840 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1841 CALL verify("h5sget_select_bounds_f", error, -1, total_error) 1842 1843 ! Set point selection 1844 1845 coord(1,1)= 3; coord(2,1)= 3; 1846 coord(1,2)= 3; coord(2,2)= 46; 1847 coord(1,3)= 96; coord(2,3)= 3; 1848 coord(1,4)= 96; coord(2,4)= 46; 1849 1850 CALL h5sselect_elements_f(sid, H5S_SELECT_SET_F, SPACE11_RANK, INT(SPACE11_NPOINTS,size_t), coord, error) 1851 CALL check("h5sselect_elements_f", error, total_error) 1852 1853 ! Get bounds for point selection 1854 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1855 CALL check("h5sget_select_bounds_f", error, total_error) 1856 1857 CALL verify("h5sget_select_bounds_f", low_bounds(1), 3_hsize_t, total_error) 1858 CALL verify("h5sget_select_bounds_f", low_bounds(2), 3_hsize_t, total_error) 1859 CALL VERIFY("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1-4,hsize_t), total_error) 1860 CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2-4,hsize_t), total_error) 1861 1862 ! Set bad offset for selection 1863 1864 offset(1:2) = (/5,-5/) 1865 CALL H5Soffset_simple_f(sid, offset, error) 1866 CALL check("H5Soffset_simple_f", error, total_error) 1867 1868 ! Get bounds for hyperslab selection with negative offset 1869 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1870 CALL verify("h5sget_select_bounds_f", error, -1, total_error) 1871 1872 ! Set valid offset for selection 1873 offset(1:2) = (/2,-2/) 1874 CALL H5Soffset_simple_f(sid, offset, error) 1875 CALL check("H5Soffset_simple_f", error, total_error) 1876 1877 ! Get bounds for point selection with offset 1878 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1879 CALL check("h5sget_select_bounds_f", error, total_error) 1880 1881 CALL verify("h5sget_select_bounds_f", low_bounds(1), 5_hsize_t, total_error) 1882 CALL verify("h5sget_select_bounds_f", low_bounds(2), 1_hsize_t, total_error) 1883 CALL verify("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1-2,hsize_t), total_error) 1884 CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2-6,hsize_t), total_error) 1885 1886 ! Reset offset for selection 1887 offset(1:2) = 0 1888 CALL H5Soffset_simple_f(sid, offset, error) 1889 CALL check("H5Soffset_simple_f", error, total_error) 1890 1891 ! Set "regular" hyperslab selection 1892 start(1:2) = 2 1893 stride(1:2) = 10 1894 count(1:2) = 4 1895 block(1:2) = 5 1896 1897 CALL h5sselect_hyperslab_f(sid, H5S_SELECT_SET_F, start, & 1898 count, error, stride, block) 1899 CALL check("h5sselect_hyperslab_f", error, total_error) 1900 1901 ! Get bounds for hyperslab selection 1902 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1903 CALL check("h5sget_select_bounds_f", error, total_error) 1904 1905 CALL verify("h5sget_select_bounds_f", low_bounds(1), 3_hsize_t, total_error) 1906 CALL verify("h5sget_select_bounds_f", low_bounds(2), 3_hsize_t, total_error) 1907 CALL verify("h5sget_select_bounds_f", high_bounds(1), 37_hsize_t, total_error) 1908 CALL verify("h5sget_select_bounds_f", high_bounds(2), 37_hsize_t, total_error) 1909 1910 ! Set bad offset for selection 1911 offset(1:2) = (/5,-5/) 1912 CALL H5Soffset_simple_f(sid, offset, error) 1913 CALL check("H5Soffset_simple_f", error, total_error) 1914 1915 ! Get bounds for hyperslab selection with negative offset 1916 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1917 CALL verify("h5sget_select_bounds_f", error, -1, total_error) 1918 1919 ! Set valid offset for selection 1920 offset(1:2) = (/5,-2/) 1921 CALL H5Soffset_simple_f(sid, offset, error) 1922 CALL check("H5Soffset_simple_f", error, total_error) 1923 1924 ! Get bounds for hyperslab selection with offset 1925 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1926 CALL check("h5sget_select_bounds_f", error, total_error) 1927 1928 CALL verify("h5sget_select_bounds_f", low_bounds(1), 8_hsize_t, total_error) 1929 CALL verify("h5sget_select_bounds_f", low_bounds(2), 1_hsize_t, total_error) 1930 CALL verify("h5sget_select_bounds_f", high_bounds(1), 42_hsize_t, total_error) 1931 CALL verify("h5sget_select_bounds_f", high_bounds(2), 35_hsize_t, total_error) 1932 1933 ! Reset offset for selection 1934 offset(1:2) = 0 1935 CALL H5Soffset_simple_f(sid, offset, error) 1936 CALL check("H5Soffset_simple_f", error, total_error) 1937 1938 ! Make "irregular" hyperslab selection 1939 start(1:2) = 20 1940 stride(1:2) = 20 1941 count(1:2) = 2 1942 block(1:2) = 10 1943 1944 CALL h5sselect_hyperslab_f(sid, H5S_SELECT_OR_F, start, & 1945 count, error, stride, block) 1946 CALL check("h5sselect_hyperslab_f", error, total_error) 1947 1948 ! Get bounds for hyperslab selection 1949 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1950 CALL check("h5sget_select_bounds_f", error, total_error) 1951 1952 CALL verify("h5sget_select_bounds_f", low_bounds(1), 3_hsize_t, total_error) 1953 CALL verify("h5sget_select_bounds_f", low_bounds(2), 3_hsize_t, total_error) 1954 CALL verify("h5sget_select_bounds_f", high_bounds(1), 50_hsize_t, total_error) 1955 CALL verify("h5sget_select_bounds_f", high_bounds(2), 50_hsize_t, total_error) 1956 1957 ! Set bad offset for selection 1958 offset(1:2) = (/5,-5/) 1959 CALL H5Soffset_simple_f(sid, offset, error) 1960 CALL check("H5Soffset_simple_f", error, total_error) 1961 1962 ! Get bounds for hyperslab selection with negative offset 1963 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1964 CALL verify("h5sget_select_bounds_f", error, -1, total_error) 1965 1966 ! Set valid offset for selection 1967 offset(1:2) = (/5,-2/) 1968 CALL H5Soffset_simple_f(sid, offset, error) 1969 CALL check("H5Soffset_simple_f", error, total_error) 1970 1971 ! Get bounds for hyperslab selection with offset 1972 CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) 1973 CALL check("h5sget_select_bounds_f", error, total_error) 1974 1975 CALL verify("h5sget_select_bounds_f", low_bounds(1), 8_hsize_t, total_error) 1976 CALL verify("h5sget_select_bounds_f", low_bounds(2), 1_hsize_t, total_error) 1977 CALL verify("h5sget_select_bounds_f", high_bounds(1), 55_hsize_t, total_error) 1978 CALL verify("h5sget_select_bounds_f", high_bounds(2), 48_hsize_t, total_error) 1979 1980 ! Reset offset for selection 1981 offset(1:2) = 0 1982 CALL H5Soffset_simple_f(sid, offset, error) 1983 CALL check("H5Soffset_simple_f", error, total_error) 1984 1985 ! Close the dataspace 1986 CALL h5sclose_f(sid, error) 1987 CALL check("h5sclose_f", error, total_error) 1988 1989END SUBROUTINE test_select_bounds 1990 1991END MODULE TH5SSELECT 1992