1!****h* root/fortran/test/tH5D.f90 2! 3! NAME 4! tH5D.f90 5! 6! FUNCTION 7! Basic testing of Fortran H5D 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 H5D APIs functionalities of: 25! h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, h5dget_type_f, 26! h5dread_f, and h5dwrite_f, h5dget_space_status_f 27! 28! 29! CONTAINS SUBROUTINES 30! datasettest, extenddsettest 31! 32!***** 33 34! 35MODULE TH5D 36 37 USE HDF5 ! This module contains all necessary modules 38 USE TH5_MISC 39 USE TH5_MISC_GEN 40 41CONTAINS 42 SUBROUTINE datasettest(cleanup, total_error) 43 44 IMPLICIT NONE 45 LOGICAL, INTENT(IN) :: cleanup 46 INTEGER, INTENT(OUT) :: total_error 47 48 CHARACTER(LEN=5), PARAMETER :: filename = "dsetf" ! File name 49 CHARACTER(LEN=80) :: fix_filename 50 CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name 51 CHARACTER(LEN=9), PARAMETER :: null_dsetname = "null_dset" ! Dataset name 52 53 INTEGER(HID_T) :: file_id ! File identifier 54 INTEGER(HID_T) :: dset_id ! Dataset identifier 55 INTEGER(HID_T) :: null_dset ! Null dataset identifier 56 INTEGER(HID_T) :: dspace_id ! Dataspace identifier 57 INTEGER(HID_T) :: null_dspace ! Null dataspace identifier 58 INTEGER(HID_T) :: dtype_id ! Datatype identifier 59 60 INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions 61 INTEGER :: rank = 2 ! Dataset rank 62 63 INTEGER, DIMENSION(4,6) :: dset_data, data_out ! Data buffers 64 INTEGER :: error ! Error flag 65 66 INTEGER :: i, j !general purpose integers 67 INTEGER(HSIZE_T), DIMENSION(2) :: data_dims 68 INTEGER(HSIZE_T), DIMENSION(1) :: null_data_dim 69 INTEGER :: null_dset_data = 1 ! null data 70 INTEGER :: flag ! Space allocation status 71 72 ! 73 ! Initialize the dset_data array. 74 ! 75 DO i = 1, 4 76 DO j = 1, 6 77 dset_data(i,j) = (i-1)*6 + j; 78 END DO 79 END DO 80 ! 81 ! Create a new file using default properties. 82 ! 83 CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) 84 IF (error .NE. 0) THEN 85 WRITE(*,*) "Cannot modify filename" 86 STOP 87 ENDIF 88 CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) 89 CALL check("h5fcreate_f", error, total_error) 90 ! 91 ! Create the dataspace. 92 ! 93 CALL h5screate_simple_f(rank, dims, dspace_id, error) 94 CALL check("h5screate_simple_f", error, total_error) 95 ! 96 ! Create null dataspace. 97 ! 98 CALL h5screate_f(H5S_NULL_F, null_dspace, error) 99 CALL check("h5screate_simple_f", error, total_error) 100 ! 101 ! Create the dataset with default properties. 102 ! 103 CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dspace_id, & 104 dset_id, error) 105 CALL check("h5dcreate_f", error, total_error) 106 ! 107 ! Create the null dataset. 108 ! 109 CALL h5dcreate_f(file_id, null_dsetname, H5T_NATIVE_INTEGER, null_dspace, null_dset, error) 110 CALL check("h5dcreate_f", error, total_error) 111 ! 112 ! Write the dataset. 113 ! 114 data_dims(1) = 4 115 data_dims(2) = 6 116 CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) 117 CALL check("h5dwrite_f", error, total_error) 118 ! 119 ! Write null dataset. Nothing can be written. 120 ! 121 null_data_dim(1) = 1 122 CALL h5dwrite_f(null_dset, H5T_NATIVE_INTEGER, null_dset_data, null_data_dim, error) 123 CALL check("h5dwrite_f", error, total_error) 124 ! 125 ! End access to the dataset and release resources used by it. 126 ! 127 CALL h5dclose_f(dset_id, error) 128 CALL check("h5dclose_f", error, total_error) 129 CALL h5dclose_f(null_dset, error) 130 CALL check("h5dclose_f", error, total_error) 131 ! 132 ! Terminate access to the data space. 133 ! 134 CALL h5sclose_f(dspace_id, error) 135 CALL check("h5sclose_f", error, total_error) 136 CALL h5sclose_f(null_dspace, error) 137 CALL check("h5sclose_f", error, total_error) 138 ! 139 ! Close the file. 140 ! 141 CALL h5fclose_f(file_id, error) 142 CALL check("h5fclose_f", error, total_error) 143 ! 144 ! Open the existing file. 145 ! 146 CALL h5fopen_f (fix_filename, H5F_ACC_RDWR_F, file_id, error) 147 CALL check("h5fopen_f", error, total_error) 148 ! 149 ! Open the existing dataset. 150 ! 151 CALL h5dopen_f(file_id, dsetname, dset_id, error) 152 CALL check("h5dopen_f", error, total_error) 153 CALL h5dopen_f(file_id, null_dsetname, null_dset, error) 154 CALL check("h5dopen_f", error, total_error) 155 156 ! Test whether space has been allocated for a dataset 157 CALL h5dget_space_status_f(dset_id, flag, error) 158 CALL check("h5dget_space_status_f",error, total_error) 159 CALL VERIFY("h5dget_space_status_f", flag, H5D_SPACE_STS_ALLOCATED_F, total_error) 160 161 CALL h5dget_space_status_f(null_dset, flag, error) 162 CALL check("h5dget_space_status_f",error, total_error) 163 CALL VERIFY("h5dget_space_status_f", flag, H5D_SPACE_STS_NOT_ALLOCATED_F, total_error) 164 ! 165 ! Get the dataset type. 166 ! 167 CALL h5dget_type_f(dset_id, dtype_id, error) 168 CALL check("h5dget_type_f", error, total_error) 169 ! 170 ! Get the data space. 171 ! 172 CALL h5dget_space_f(dset_id, dspace_id, error) 173 CALL check("h5dget_space_f", error, total_error) 174 ! 175 ! Read the dataset. 176 ! 177 CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error) 178 CALL check("h5dread_f", error, total_error) 179 ! 180 ! Read the null dataset. Nothing should be read. 181 ! 182 CALL h5dread_f(null_dset, H5T_NATIVE_INTEGER, null_dset_data, null_data_dim, error) 183 CALL check("h5dread_f", error, total_error) 184 ! 185 !Compare the data. 186 ! 187 DO i = 1, 4 188 DO j = 1, 6 189 IF (data_out(i,j) .NE. dset_data(i, j)) THEN 190 WRITE(*, *) "dataset test error occured" 191 WRITE(*,*) "data read is not the same as the data written" 192 END IF 193 END DO 194 END DO 195 ! 196 ! Check if no change to null_dset_data 197 ! 198 IF (null_dset_data .NE. 1) THEN 199 WRITE(*, *) "null dataset test error occured" 200 END IF 201 ! 202 ! End access to the dataset and release resources used by it. 203 ! 204 CALL h5dclose_f(dset_id, error) 205 CALL check("h5dclose_f", error, total_error) 206 CALL h5dclose_f(null_dset, error) 207 CALL check("h5dclose_f", error, total_error) 208 ! 209 ! Terminate access to the data space. 210 ! 211 CALL h5sclose_f(dspace_id, error) 212 CALL check("h5sclose_f", error, total_error) 213 214 ! 215 ! Terminate access to the data type. 216 ! 217 CALL h5tclose_f(dtype_id, error) 218 CALL check("h5tclose_f", error, total_error) 219 ! 220 ! Close the file. 221 ! 222 CALL h5fclose_f(file_id, error) 223 CALL check("h5fclose_f", error, total_error) 224 IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) 225 CALL check("h5_cleanup_f", error, total_error) 226 227 RETURN 228 END SUBROUTINE datasettest 229 230! 231!the following subroutine tests h5dextend_f functionality 232! 233 234 SUBROUTINE extenddsettest(cleanup, total_error) 235 236 IMPLICIT NONE 237 238 LOGICAL, INTENT(IN) :: cleanup 239 INTEGER, INTENT(OUT) :: total_error 240 241 ! 242 !the dataset is stored in file "extf.h5" 243 ! 244 CHARACTER(LEN=4), PARAMETER :: filename = "extf" 245 CHARACTER(LEN=80) :: fix_filename 246 247 ! 248 !dataset name is "ExtendibleArray" 249 ! 250 CHARACTER(LEN=15), PARAMETER :: dsetname = "ExtendibleArray" 251 252 ! 253 !dataset rank is 2 254 ! 255 INTEGER :: RANK = 2 256 257 INTEGER(HID_T) :: file_id ! File identifier 258 INTEGER(HID_T) :: dset_id ! Dataset identifier 259 INTEGER(HID_T) :: dataspace ! Dataspace identifier 260 INTEGER(HID_T) :: memspace ! memory Dataspace identifier 261 INTEGER(HID_T) :: crp_list ! dataset creatation property identifier 262 263 ! 264 !dataset dimensions at creation time 265 ! 266 INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/3,3/) 267 268 ! 269 !data dimensions 270 ! 271 INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/10,3/) 272 273 ! 274 !Maximum dimensions 275 ! 276 INTEGER(HSIZE_T), DIMENSION(2) :: maxdims 277 278 ! 279 !data arrays for reading and writing 280 ! 281 INTEGER, DIMENSION(10,3) :: data_in, data_out 282 283 ! 284 !Size of data in the file 285 ! 286 INTEGER(HSIZE_T), DIMENSION(2) :: size 287 288 ! 289 !general purpose integer 290 ! 291 INTEGER :: i, j 292 INTEGER(HSIZE_T) :: ih, jh 293 294 ! 295 !flag to check operation success 296 ! 297 INTEGER :: error 298 299 ! 300 !Variables used in reading data back 301 ! 302 INTEGER(HSIZE_T), DIMENSION(2) :: dimsr, maxdimsr 303 INTEGER :: rankr 304 INTEGER(HSIZE_T), DIMENSION(2) :: data_dims 305 306 ! 307 !data initialization 308 ! 309 DO i = 1, 10 310 DO j = 1, 3 311 data_in(i,j) = 2 312 END DO 313 END DO 314 315 ! 316 !Initialize FORTRAN predifined datatypes 317 ! 318! CALL h5init_types_f(error) 319! CALL check("h5init_types_f",error,total_error) 320 321 ! 322 !Create a new file using default properties. 323 ! 324 CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) 325 IF (error .NE. 0) THEN 326 WRITE(*,*) "Cannot modify filename" 327 STOP 328 ENDIF 329 CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) 330 CALL check("h5fcreate_f",error,total_error) 331 332 ! 333 !Create the data space with unlimited dimensions. 334 ! 335 maxdims = (/H5S_UNLIMITED_F, H5S_UNLIMITED_F/) 336 337 CALL h5screate_simple_f(RANK, dims, dataspace, error, maxdims) 338 CALL check("h5screate_simple_f",error,total_error) 339 340 ! 341 !Modify dataset creation properties, i.e. enable chunking 342 ! 343 CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error) 344 CALL check("h5pcreate_f",error,total_error) 345 346 CALL h5pset_chunk_f(crp_list, RANK, dims1, error) 347 CALL check("h5pset_chunk_f",error,total_error) 348 349 ! 350 !Create a dataset with 3X3 dimensions using cparms creation propertie . 351 ! 352 CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, dset_id, error, crp_list ) 353 CALL check("h5dcreate_f",error,total_error) 354 355 ! 356 !Extend the dataset. This call assures that dataset is 3 x 3. 357 ! 358 SIZE(1) = 3 359 SIZE(2) = 3 360 CALL h5dextend_f(dset_id, size, error) 361 CALL check("h5dextend_f",error,total_error) 362 363 364 ! 365 !Extend the dataset. Dataset becomes 10 x 3. 366 ! 367 SIZE(1) = 10; 368 SIZE(2) = 3; 369 CALL h5dextend_f(dset_id, size, error) 370 CALL check("h5dextend_f",error,total_error) 371 372 ! 373 !Write the data of size 10X3 to the extended dataset. 374 ! 375 data_dims(1) = 10 376 data_dims(2) = 3 377 CALL H5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error) 378 CALL check("h5dwrite_f",error,total_error) 379 380 ! 381 !Close the dataspace for the dataset. 382 ! 383 CALL h5sclose_f(dataspace, error) 384 CALL check("h5sclose_f",error,total_error) 385 386 ! 387 !Close the property list. 388 ! 389 CALL h5pclose_f(crp_list, error) 390 CALL check("h5pclose_f",error,total_error) 391 ! 392 !Close the dataset. 393 ! 394 CALL h5dclose_f(dset_id, error) 395 CALL check("h5dclose_f",error,total_error) 396 397 ! 398 !Close the file. 399 ! 400 CALL h5fclose_f(file_id, error) 401 CALL check("h5fclose_f",error,total_error) 402 403 ! 404 !read the data back 405 ! 406 !Open the file. 407 ! 408 CALL h5fopen_f (fix_filename, H5F_ACC_RDONLY_F, file_id, error) 409 CALL check("hfopen_f",error,total_error) 410 411 ! 412 !Open the dataset. 413 ! 414 CALL h5dopen_f(file_id, dsetname, dset_id, error) 415 CALL check("h5dopen_f",error,total_error) 416 417 ! 418 !Get dataset's dataspace handle. 419 ! 420 CALL h5dget_space_f(dset_id, dataspace, error) 421 CALL check("h5dget_space_f",error,total_error) 422 423 ! 424 !Get dataspace's rank. 425 ! 426 CALL h5sget_simple_extent_ndims_f(dataspace, rankr, error) 427 CALL check("h5sget_simple_extent_ndims_f",error,total_error) 428 IF (rankr .NE. RANK) THEN 429 WRITE(*,*) "dataset rank error occured" 430 STOP 431 END IF 432 433 ! 434 !Get dataspace's dimensinons. 435 ! 436 CALL h5sget_simple_extent_dims_f(dataspace, dimsr, maxdimsr, error) 437 CALL check("h5sget_simple_extent_dims_f",error,total_error) 438 IF ((dimsr(1) .NE. dims1(1)) .OR. (dimsr(2) .NE. dims1(2))) THEN 439 WRITE(*,*) "dataset dimensions error occured" 440 STOP 441 END IF 442 443 ! 444 !Get creation property list. 445 ! 446 CALL h5dget_create_plist_f(dset_id, crp_list, error) 447 CALL check("h5dget_create_plist_f",error,total_error) 448 449 450 ! 451 !create memory dataspace. 452 ! 453 CALL h5screate_simple_f(rankr, dimsr, memspace, error) 454 CALL check("h5screate_simple_f",error,total_error) 455 456 ! 457 !Read data 458 ! 459 CALL H5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, memspace, dataspace) 460 CALL check("h5dread_f",error,total_error) 461 462 463 ! 464 !Compare the data. 465 ! 466 DO ih = 1, dims1(1) 467 DO jh = 1, dims1(2) 468 IF (data_out(ih,jh) .NE. data_in(ih, jh)) THEN 469 WRITE(*, *) "extend dataset test error occured" 470 WRITE(*, *) "read value is not the same as the written values" 471 END IF 472 END DO 473 END DO 474 475 ! 476 !Close the dataspace for the dataset. 477 ! 478 CALL h5sclose_f(dataspace, error) 479 CALL check("h5sclose_f",error,total_error) 480 481 ! 482 !Close the memspace for the dataset. 483 ! 484 CALL h5sclose_f(memspace, error) 485 CALL check("h5sclose_f",error,total_error) 486 487 ! 488 !Close the property list. 489 ! 490 CALL h5pclose_f(crp_list, error) 491 CALL check("h5pclose_f",error,total_error) 492 493 ! 494 !Close the dataset. 495 ! 496 CALL h5dclose_f(dset_id, error) 497 CALL check("h5dclose_f",error,total_error) 498 499 ! 500 !Close the file. 501 ! 502 CALL h5fclose_f(file_id, error) 503 CALL check("h5fclose_f",error,total_error) 504 IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) 505 CALL check("h5_cleanup_f", error, total_error) 506 507 RETURN 508 END SUBROUTINE extenddsettest 509 510! 511! The following subroutine tests h5dget_offset_f functionality 512! 513 514 SUBROUTINE test_userblock_offset(cleanup, total_error) 515 516 USE ISO_C_BINDING 517 518 IMPLICIT NONE 519 LOGICAL, INTENT(IN) :: cleanup 520 INTEGER, INTENT(OUT) :: total_error 521 ! 522 !the dataset is stored in file "offset.h5" 523 ! 524 INTEGER, PARAMETER :: dset_dim1=2, dset_dim2=10 525 CHARACTER(LEN=6), PARAMETER :: filename = "offset" 526 CHARACTER(LEN=80) :: fix_filename 527 528 INTEGER(hid_t) :: file, fcpl, dataset, space 529 INTEGER :: i, j, n, ios 530 INTEGER(hsize_t), DIMENSION(1:2) :: dims 531 INTEGER(haddr_t) :: offset 532 INTEGER, DIMENSION(1:dset_dim1,1:dset_dim2), TARGET :: rdata, data_in 533 INTEGER :: error 534 TYPE(C_PTR) :: f_ptr 535 ! 536 !Create a new file using default properties. 537 ! 538 CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) 539 IF (error .NE. 0) THEN 540 WRITE(*,*) "Cannot modify filename" 541 STOP 542 ENDIF 543 544 CALL h5pcreate_f(H5P_FILE_CREATE_F, fcpl, error) 545 CALL check("h5pcreate_f",error,total_error) 546 547 ! Initialize the dataset 548 n = 0 549 DO i = 1, dset_dim1 550 DO j = 1, dset_dim2 551 n = n + 1 552 data_in(i,j) = n 553 END DO 554 END DO 555 CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file, error, fcpl) 556 CALL check("h5fcreate_f",error,total_error) 557 558 ! Create the data space 559 dims(1:2) = (/dset_dim1,dset_dim2/) 560 561 CALL h5screate_simple_f(2, dims, space, error) 562 CALL check("h5screate_simple_f",error,total_error) 563 564 ! Create the dataset 565 CALL h5dcreate_f(file, "dset1", H5T_NATIVE_INTEGER, space, dataset, error) 566 CALL check("h5dcreate_f", error, total_error) 567 568 ! Test dataset address. Should be undefined. 569 CALL h5dget_offset_f(dataset, offset, error) 570 CALL VERIFY("h5dget_offset_f",offset, HADDR_UNDEF_F, total_error) 571 572 ! Write the data to the dataset 573 f_ptr = C_LOC(data_in(1,1)) 574 CALL h5dwrite_f(dataset, H5T_NATIVE_INTEGER, f_ptr, error) 575 CALL check("h5dwrite_f", error, total_error) 576 577 ! Test dataset address in file. Open the same file as a C file, seek 578 ! the data position as H5Dget_offset points to, read the dataset, and 579 ! compare it with the data written in. 580 CALL h5dget_offset_f(dataset, offset, error) 581 CALL check("h5dget_offset_f", error, total_error) 582 IF(offset.EQ.HADDR_UNDEF_F)THEN 583 total_error = total_error + 1 584 ENDIF 585 586 CALL h5dclose_f(dataset, error) 587 CALL check("h5dclose_f", error, total_error) 588 CALL h5fclose_f(file, error) 589 CALL check("h5fclose_f", error, total_error) 590 591 IF(total_error.NE.0) RETURN 592 593 OPEN(10,FILE=fix_filename, ACCESS="STREAM", IOSTAT=ios) 594 IF(ios.NE.0)THEN 595 WRITE(*,'(A)') "Failed to open file "//TRIM(fix_filename) 596 total_error = total_error + 1 597 RETURN 598 ENDIF 599 ! The pos= specifier illustrates that positions are in bytes, 600 ! starting from byte 1 (as opposed to C, where they start from byte 0) 601 READ(10, POS=offset+1, IOSTAT=ios) rdata 602 IF(ios.NE.0)THEN 603 WRITE(*,'(A)') "Failed to read data from stream I/O " 604 total_error = total_error + 1 605 CLOSE(10) 606 RETURN 607 ENDIF 608 609 ! Check that the values read are the same as the values written 610 DO i = 1, dset_dim1 611 DO j = 1, dset_dim2 612 CALL VERIFY("h5dget_offset_f",rdata(i,j), data_in(i,j), total_error) 613 IF(total_error.NE.0)THEN 614 WRITE(*,'(A)') " Read different values than written." 615 WRITE(*,'(2(A,I0))') " At index ",i,",",j 616 CLOSE(10) 617 RETURN 618 ENDIF 619 END DO 620 END DO 621 622 CLOSE(10) 623 624 IF(cleanup) CALL h5_cleanup_f(fix_filename, H5P_DEFAULT_F, error) 625 CALL check("h5_cleanup_f", error, total_error) 626 IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) 627 CALL check("h5_cleanup_f", error, total_error) 628 629 END SUBROUTINE test_userblock_offset 630 631END MODULE TH5D 632 633