mirror of
https://github.com/HDFGroup/hdf5.git
synced 2024-11-27 02:10:55 +08:00
89fbe00dec
* commit '54957d37f5aa73912763dbb6e308555e863c43f4': Commit copyright header change for src/H5PLpkg.c which was added after running script to make changes. Add new files in release_docs to MANIFEST. Cimmit changes to Makefile.in(s) and H5PL.c that resulted from running autogen.sh. Merge pull request #407 in HDFFV/hdf5 from ~LRKNOX/hdf5_lrk:hdf5_1_10_1 to hdf5_1_10_1 Change copyright headers to replace url referring to file to be removed and replace it with new url for COPYING file.
792 lines
28 KiB
Fortran
792 lines
28 KiB
Fortran
!****h* root/fortran/test/tH5O.f90
|
|
!
|
|
! NAME
|
|
! tH5O.f90
|
|
!
|
|
! FUNCTION
|
|
! Basic testing of Fortran H5O APIs.
|
|
!
|
|
! COPYRIGHT
|
|
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
|
! Copyright by The HDF Group. *
|
|
! Copyright by the Board of Trustees of the University of Illinois. *
|
|
! All rights reserved. *
|
|
! *
|
|
! This file is part of HDF5. The full HDF5 copyright notice, including *
|
|
! terms governing use, modification, and redistribution, is contained in *
|
|
! the COPYING file, which can be found at the root of the source code *
|
|
! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. *
|
|
! If you do not have access to either file, you may request a copy from *
|
|
! help@hdfgroup.org. *
|
|
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
|
!
|
|
! CONTAINS SUBROUTINES
|
|
! test_h5o, test_h5o_link, test_h5o_plist
|
|
!
|
|
!*****
|
|
MODULE TH5O
|
|
|
|
USE HDF5 ! This module contains all necessary modules
|
|
USE TH5_MISC
|
|
USE TH5_MISC_GEN
|
|
|
|
CONTAINS
|
|
|
|
SUBROUTINE test_h5o(cleanup, total_error)
|
|
|
|
IMPLICIT NONE
|
|
LOGICAL, INTENT(IN) :: cleanup
|
|
INTEGER, INTENT(INOUT) :: total_error
|
|
INTEGER :: error
|
|
|
|
CALL test_h5o_plist(total_error) ! Test object creation properties
|
|
CALL test_h5o_link(total_error) ! Test object link routine
|
|
|
|
IF(cleanup) CALL h5_cleanup_f("TestFile", H5P_DEFAULT_F, error)
|
|
CALL check("h5_cleanup_f", error, total_error)
|
|
IF(cleanup) CALL h5_cleanup_f("test", H5P_DEFAULT_F, error)
|
|
CALL check("h5_cleanup_f", error, total_error)
|
|
|
|
END SUBROUTINE test_h5o
|
|
|
|
!***************************************************************
|
|
!**
|
|
!** test_h5o_link: Test creating link to object
|
|
!**
|
|
!***************************************************************
|
|
|
|
SUBROUTINE test_h5o_link(total_error)
|
|
|
|
IMPLICIT NONE
|
|
INTEGER, INTENT(INOUT) :: total_error
|
|
|
|
INTEGER(HID_T) :: file_id
|
|
INTEGER(HID_T) :: group_id
|
|
INTEGER(HID_T) :: space_id
|
|
INTEGER(HID_T) :: dset_id
|
|
INTEGER(HID_T) :: type_id
|
|
INTEGER(HID_T) :: fapl_id
|
|
INTEGER(HID_T) :: lcpl_id
|
|
INTEGER(HID_T) :: ocpypl_id
|
|
CHARACTER(LEN=11), PARAMETER :: TEST_FILENAME = 'TestFile.h5'
|
|
INTEGER, PARAMETER :: TEST6_DIM1 = 2, TEST6_DIM2 = 5
|
|
!EP INTEGER(HSIZE_T), DIMENSION(1:2), PARAMETER :: dims = (/TEST6_DIM1,TEST6_DIM2/)
|
|
INTEGER(HSIZE_T), DIMENSION(1:2) :: dims = (/TEST6_DIM1,TEST6_DIM2/)
|
|
!EP INTEGER, DIMENSION(1:TEST6_DIM1,1:TEST6_DIM2) :: wdata, rdata
|
|
INTEGER, DIMENSION(TEST6_DIM1,TEST6_DIM2) :: wdata, rdata
|
|
|
|
INTEGER, PARAMETER :: TRUE = 1
|
|
|
|
LOGICAL :: committed ! Whether the named datatype is committed
|
|
|
|
INTEGER :: i, j
|
|
INTEGER :: error ! Value returned from API calls
|
|
|
|
CHARACTER(LEN=14) :: NAME_DATATYPE_SIMPLE="H5T_NATIVE_INT"
|
|
CHARACTER(LEN=16) :: NAME_DATATYPE_SIMPLE2="H5T_NATIVE_INT-2"
|
|
INTEGER(HID_T) :: tid, tid2
|
|
LOGICAL :: flag
|
|
|
|
! Data for tested h5ocopy_f
|
|
CHARACTER(LEN=3) , PARAMETER :: dataset = "DS1"
|
|
INTEGER , PARAMETER :: dim0 = 4
|
|
|
|
INTEGER(HSIZE_T), DIMENSION(1:1) :: dims2 = (/dim0/) ! size read/write buffer
|
|
INTEGER , DIMENSION(1:dim0) :: wdata2 ! Write buffer
|
|
LOGICAL :: link_exists
|
|
CHARACTER(LEN=8) :: chr_exact
|
|
CHARACTER(LEN=10) :: chr_lg
|
|
INTEGER(size_t) :: nlinks
|
|
INTEGER(HID_T) :: plist = -1
|
|
|
|
CHARACTER(LEN=20) :: dset_comment = "dataset comment"
|
|
CHARACTER(LEN=13) :: grp_comment = "group comment"
|
|
CHARACTER(LEN=10) :: comment_sm ! to small comment sized buffer
|
|
CHARACTER(LEN=15) :: comment ! exact comment sized buffer
|
|
CHARACTER(LEN=20) :: comment_lg ! large comment sized buffer
|
|
INTEGER(HSSIZE_T) :: comment_size
|
|
INTEGER(SIZE_T) :: comment_size2
|
|
|
|
! Initialize the raw data
|
|
DO i = 1, TEST6_DIM1
|
|
DO j = 1, TEST6_DIM2
|
|
wdata(i,j) = i*j
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Create the dataspace
|
|
CALL h5screate_simple_f(2, dims, space_id, error)
|
|
CALL check("h5screate_simple_f",error,total_error)
|
|
|
|
! Create LCPL with intermediate group creation flag set
|
|
CALL H5Pcreate_f(H5P_LINK_CREATE_F, lcpl_id, error)
|
|
CALL check("h5Pcreate_f",error,total_error)
|
|
|
|
CALL H5Pset_create_inter_group_f(lcpl_id, TRUE, error)
|
|
CALL check("H5Pset_create_inter_group_f",error,total_error)
|
|
|
|
! Loop over using new group format
|
|
! for(new_format = FALSE; new_format <= TRUE; new_format++) {
|
|
|
|
! Make a FAPL that uses the "use the latest version of the format" bounds
|
|
CALL H5Pcreate_f(H5P_FILE_ACCESS_F,fapl_id,error)
|
|
CALL check("h5Pcreate_f",error,total_error)
|
|
|
|
! Set the "use the latest version of the format" bounds for creating objects in the file
|
|
|
|
CALL H5Pset_libver_bounds_f(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error)
|
|
CALL check("H5Pset_libver_bounds_f",error, total_error)
|
|
|
|
! Create a new HDF5 file
|
|
CALL H5Fcreate_f(TEST_FILENAME, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl_id)
|
|
CALL check("H5Fcreate_f", error, total_error)
|
|
|
|
! Close the FAPL
|
|
CALL h5pclose_f(fapl_id, error)
|
|
CALL check("h5pclose_f",error,total_error)
|
|
|
|
! Create and commit a datatype with no name
|
|
CALL H5Tcopy_f( H5T_NATIVE_INTEGER, type_id, error)
|
|
CALL check("H5Tcopy_F",error,total_error)
|
|
|
|
CALL H5Tcommit_anon_f(file_id, type_id, error) ! using no optional parameters
|
|
CALL check("H5Tcommit_anon_F",error,total_error)
|
|
|
|
CALL H5Tcommitted_f(type_id, committed, error)
|
|
CALL check("H5Tcommitted_f",error,total_error)
|
|
CALL verify("H5Tcommitted_f", committed, .TRUE., total_error)
|
|
|
|
! Create a dataset with no name using the committed datatype
|
|
CALL H5Dcreate_anon_f(file_id, type_id, space_id, dset_id, error ) ! using no optional parameters
|
|
CALL check("H5Dcreate_anon_f",error,total_error)
|
|
!
|
|
! Verify that we can write to and read from the dataset
|
|
!
|
|
! Write the data to the dataset
|
|
|
|
!EP CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata, dims, error, &
|
|
!EP mem_space_id=H5S_ALL_F, file_space_id=H5S_ALL_F, xfer_prp = H5P_DEFAULT_F)
|
|
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata, dims, error)
|
|
CALL check("h5dwrite_f", error, total_error)
|
|
|
|
! Read the data back
|
|
!EP CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error, &
|
|
!EP mem_space_id=H5S_ALL_F, file_space_id=H5S_ALL_F, xfer_prp = H5P_DEFAULT_F)
|
|
CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error)
|
|
CALL check("h5dread_f", error, total_error)
|
|
|
|
! Verify the data
|
|
DO i = 1, TEST6_DIM1
|
|
DO j = 1, TEST6_DIM2
|
|
CALL verify("H5Dread_f",wdata(i,j),rdata(i,j),total_error)
|
|
wdata(i,j) = i*j
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Create a group with no name
|
|
|
|
CALL H5Gcreate_anon_f(file_id, group_id, error)
|
|
CALL check("H5Gcreate_anon", error, total_error)
|
|
|
|
! Link nameless datatype into nameless group
|
|
CALL H5Olink_f(type_id, group_id, "datatype", error, H5P_DEFAULT_F)
|
|
CALL check("H5Olink_f", error, total_error)
|
|
|
|
! Link nameless dataset into nameless group with intermediate group
|
|
CALL H5Olink_f(dset_id, group_id, "inter_group/dataset", error, lcpl_id, H5P_DEFAULT_F)
|
|
CALL check("H5Olink_f", error, total_error)
|
|
|
|
! Close IDs for dataset and datatype
|
|
CALL h5dclose_f(dset_id, error)
|
|
CALL check("h5dclose_f", error, total_error)
|
|
CALL h5tclose_f(type_id, error)
|
|
CALL check("h5tclose_f", error, total_error)
|
|
|
|
! Re-open datatype using new link
|
|
CALL H5Topen_f(group_id, "datatype", type_id, error)
|
|
CALL check("h5topen_f", error, total_error)
|
|
|
|
! Link nameless group to root group and close the group ID
|
|
CALL H5Olink_f(group_id, file_id, "/group", error)
|
|
CALL check("H5Olink_f", error, total_error)
|
|
|
|
CALL h5gclose_f(group_id, error)
|
|
CALL check("h5gclose_f",error,total_error)
|
|
|
|
! Open dataset through root group and verify its data
|
|
CALL H5Dopen_f(file_id, "/group/inter_group/dataset", dset_id, error)
|
|
CALL check("test_lcpl.h5dopen_f", error, total_error)
|
|
|
|
! Read data from dataset
|
|
!EP CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error, &
|
|
!EP H5S_ALL_F, H5S_ALL_F, xfer_prp = H5P_DEFAULT_F)
|
|
CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error)
|
|
CALL check("h5dread_f", error, total_error)
|
|
|
|
! Verify the data
|
|
DO i = 1, TEST6_DIM1
|
|
DO j = 1, TEST6_DIM2
|
|
CALL verify("H5Dread",wdata(i,j),rdata(i,j),total_error)
|
|
ENDDO
|
|
ENDDO
|
|
! Close open IDs
|
|
|
|
CALL h5dclose_f(dset_id, error)
|
|
CALL check("h5dclose_f",error,total_error)
|
|
CALL h5tclose_f(type_id, error)
|
|
CALL check("h5tclose_f",error,total_error)
|
|
|
|
! Close remaining IDs
|
|
CALL h5sclose_f(space_id, error)
|
|
CALL check("h5sclose_f",error,total_error)
|
|
CALL h5pclose_f(lcpl_id,error)
|
|
CALL check("h5pclose_f", error, total_error)
|
|
|
|
! *********************
|
|
! CHECK H5OCOPY_F
|
|
! *********************
|
|
|
|
DO i = 1, dim0
|
|
wdata2(i) = i-1
|
|
ENDDO
|
|
!
|
|
! Create dataspace. Setting size to be the current size.
|
|
!
|
|
CALL h5screate_simple_f(1, dims2, space_id, error)
|
|
CALL check("h5screate_simple_f", error, total_error)
|
|
!
|
|
! Create intermediate groups
|
|
!
|
|
CALL h5gcreate_f(file_id,"/G1",group_id,error)
|
|
CALL check("h5gcreate_f", error, total_error)
|
|
CALL h5gcreate_f(file_id,"/G1/G2",group_id,error)
|
|
CALL check("h5gcreate_f", error, total_error)
|
|
CALL h5gcreate_f(file_id,"/G1/G2/G3",group_id,error)
|
|
CALL check("h5gcreate_f", error, total_error)
|
|
|
|
! Try putting a comment on the group /G1/G2/G3 by name
|
|
CALL h5oset_comment_by_name_f(file_id, "/G1/G2/G3", grp_comment, error)
|
|
CALL check("h5oset_comment_by_name_f", error, total_error)
|
|
|
|
comment_lg = ' '
|
|
|
|
CALL h5oget_comment_by_name_f(file_id, "/G1/G2/G3", comment_lg, error)
|
|
CALL check("h5oget_comment_by_name_f", error, total_error)
|
|
|
|
IF(comment_lg(1:13).NE.grp_comment)THEN
|
|
CALL check("h5oget_comment_by_name_f", -1, total_error)
|
|
ENDIF
|
|
IF(comment_lg(14:20).NE.' ')THEN ! make sure no NULL terminator
|
|
CALL check("h5oget_comment_by_name_f", -1, total_error)
|
|
ENDIF
|
|
|
|
! Try putting a comment on the group /G1/G2/G3 by name with trailing blanks
|
|
|
|
CALL h5oset_comment_by_name_f(file_id, "/G1/G2/G3"//' ', grp_comment, error)
|
|
CALL check("h5oset_comment_by_name_f", error, total_error)
|
|
|
|
comment_lg = ' '
|
|
|
|
CALL h5oget_comment_by_name_f(file_id, "/G1/G2/G3"//' ', comment_lg, error)
|
|
CALL check("h5oget_comment_by_name_f", error, total_error)
|
|
|
|
IF(comment_lg(1:13).NE.grp_comment)THEN
|
|
CALL check("h5oget_comment_by_name_f", -1, total_error)
|
|
ENDIF
|
|
IF(comment_lg(14:20).NE.' ')THEN ! make sure no NULL terminator
|
|
CALL check("h5oget_comment_by_name_f", -1, total_error)
|
|
ENDIF
|
|
|
|
!
|
|
! Create the dataset
|
|
!
|
|
CALL h5dcreate_f(group_id, dataset, H5T_STD_I32LE, space_id, dset_id, error)
|
|
CALL check("h5dcreate_f", error, total_error)
|
|
|
|
! Putting a comment on the dataset
|
|
CALL h5oset_comment_f(dset_id, dset_comment, error)
|
|
CALL check("h5oset_comment_f", error, total_error)
|
|
|
|
! Try reading into a buffer that is the correct size
|
|
|
|
CALL h5oget_comment_f(dset_id, comment, error)
|
|
CALL check("h5oget_comment_f", error, total_error)
|
|
|
|
IF(comment(1:15).NE.dset_comment(1:15))THEN
|
|
CALL check("h5oget_comment_f", -1, total_error)
|
|
ENDIF
|
|
|
|
! Try reading into a buffer that is to small
|
|
|
|
CALL h5oget_comment_f(dset_id, comment_sm, error)
|
|
CALL check("h5oget_comment_f", error, total_error)
|
|
|
|
IF(comment_sm(1:10).NE.dset_comment(1:10))THEN
|
|
CALL check("h5oget_comment_f", -1, total_error)
|
|
ENDIF
|
|
|
|
! Try reading into a buffer that is larger then needed
|
|
|
|
comment_lg = ' '
|
|
|
|
CALL h5oget_comment_f(dset_id, comment_lg, error)
|
|
CALL check("h5oget_comment_f", error, total_error)
|
|
|
|
IF(comment_lg(1:15).NE.dset_comment)THEN
|
|
CALL check("h5oget_comment_f", -1, total_error)
|
|
ENDIF
|
|
IF(comment_lg(16:20).NE.' ')THEN ! make sure no NULL terminator
|
|
CALL check("h5oget_comment_f", -1, total_error)
|
|
ENDIF
|
|
!
|
|
! Check optional parameter
|
|
!
|
|
CALL h5oget_comment_f(dset_id, comment_lg, error, comment_size)
|
|
CALL check("h5oget_comment_f", error, total_error)
|
|
|
|
IF( comment_size.NE.15)THEN
|
|
CALL check("h5oget_comment_f", -1, total_error)
|
|
ENDIF
|
|
|
|
! CHECK h5oget_comment_by_name_f
|
|
|
|
! Try reading into a buffer that is the correct size
|
|
|
|
CALL h5oget_comment_by_name_f(dset_id, ".", comment, error)
|
|
CALL check("h5oget_comment_by_name_f", error, total_error)
|
|
|
|
IF(comment(1:15).NE.dset_comment(1:15))THEN
|
|
CALL check("h5oget_comment_by_name_f", -1, total_error)
|
|
ENDIF
|
|
|
|
! Try with trailing blanks in the name
|
|
|
|
CALL h5oget_comment_by_name_f(dset_id, ". ", comment, error)
|
|
CALL check("h5oget_comment_by_name_f", error, total_error)
|
|
|
|
IF(comment(1:15).NE.dset_comment(1:15))THEN
|
|
CALL check("h5oget_comment_by_name_f", -1, total_error)
|
|
ENDIF
|
|
|
|
!
|
|
! Check optional parameter
|
|
!
|
|
CALL h5oget_comment_by_name_f(dset_id, ". ", comment_lg, error, comment_size2)
|
|
CALL check("h5oget_comment_by_name_f", error, total_error)
|
|
|
|
IF( comment_size2.NE.15)THEN
|
|
CALL check("h5oget_comment_by_name_f", -1, total_error)
|
|
ENDIF
|
|
|
|
!
|
|
! Write the data to the dataset.
|
|
!
|
|
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata2, dims2, error)
|
|
CALL check("h5dwrite_f", error, total_error)
|
|
|
|
! *************************
|
|
! CHECK H5OEXISTS_BY_NAME_F
|
|
! *************************
|
|
|
|
! Create a soft link to /G1
|
|
CALL h5lcreate_soft_f("/G1", file_id, "/G1_LINK", error)
|
|
CALL check("h5lcreate_soft_f", error, total_error)
|
|
|
|
|
|
! Create a soft link to /G1000, does not exist
|
|
CALL h5lcreate_soft_f("/G1000", file_id, "/G1_FALSE", error)
|
|
CALL check("h5lcreate_soft_f", error, total_error)
|
|
|
|
! Create a soft link to /G1_LINK
|
|
CALL h5lcreate_soft_f("/G1_FALSE", file_id, "/G2_FALSE", error)
|
|
CALL check("h5lcreate_soft_f", error, total_error)
|
|
|
|
! See if the link exists
|
|
CALL h5oexists_by_name_f(file_id,"/G1_LINK", link_exists, error)
|
|
CALL check("h5oexists_by_name_f", error, total_error)
|
|
|
|
! Object should exist
|
|
IF(.NOT.link_exists)THEN
|
|
CALL check("h5oexists_by_name_f", -1, total_error)
|
|
ENDIF
|
|
|
|
chr_exact = "/G1_LINK"
|
|
! See if the link exists
|
|
CALL h5oexists_by_name_f(file_id,chr_exact, link_exists, error, H5P_DEFAULT_F)
|
|
CALL check("h5oexists_by_name_f", error, total_error)
|
|
|
|
! Object should exist
|
|
IF(.NOT.link_exists)THEN
|
|
CALL check("h5oexists_by_name_f", -1, total_error)
|
|
ENDIF
|
|
|
|
chr_lg = "/G1_LINK"
|
|
! See if the link exists
|
|
CALL h5oexists_by_name_f(file_id,chr_lg, link_exists, error, H5P_DEFAULT_F)
|
|
CALL check("h5oexists_by_name_f", error, total_error)
|
|
|
|
! Object should exist
|
|
IF(.NOT.link_exists)THEN
|
|
CALL check("h5oexists_by_name_f", -1, total_error)
|
|
ENDIF
|
|
|
|
chr_lg = "/G1_LINK "
|
|
! See if the link exists
|
|
CALL h5oexists_by_name_f(file_id,chr_lg, link_exists, error, H5P_DEFAULT_F)
|
|
CALL check("h5oexists_by_name_f", error, total_error)
|
|
|
|
! Object should exist
|
|
IF(.NOT.link_exists)THEN
|
|
CALL check("h5oexists_by_name_f", -1, total_error)
|
|
ENDIF
|
|
|
|
! See if the link exists
|
|
CALL h5oexists_by_name_f(file_id,"/G1_FALSE", link_exists, error)
|
|
CALL check("h5oexists_by_name_f", error, total_error)
|
|
|
|
! Object should not exist
|
|
IF(link_exists)THEN
|
|
CALL check("h5oexists_by_name_f", -1, total_error)
|
|
ENDIF
|
|
|
|
! Check optional parameter
|
|
|
|
CALL h5pcreate_f(H5P_LINK_ACCESS_F,plist,error)
|
|
CALL check("h5pcreate_f",error,total_error)
|
|
|
|
nlinks = 2
|
|
CALL h5pset_nlinks_f(plist, nlinks, error)
|
|
CALL check("h5pset_nlinks_f", error, total_error)
|
|
! Ensure that nlinks was set successfully
|
|
nlinks = 0
|
|
CALL h5pget_nlinks_f(plist, nlinks, error)
|
|
CALL check("h5pget_nlinks_f",error,total_error)
|
|
CALL verify("h5pget_nlinks_f", INT(nlinks), 2, total_error)
|
|
|
|
! See if the link exists
|
|
CALL h5oexists_by_name_f(file_id,"/G1_LINK", link_exists, error, plist)
|
|
CALL check("h5oexists_by_name_f", error, total_error)
|
|
|
|
! Object should exist
|
|
IF(.not.link_exists)THEN
|
|
CALL check("h5oexists_by_name_f", -1, total_error)
|
|
ENDIF
|
|
!
|
|
! Close and release resources.
|
|
!
|
|
CALL h5dclose_f(dset_id , error)
|
|
CALL check(" h5dclose_f", error, total_error)
|
|
CALL h5sclose_f(space_id, error)
|
|
CALL check("h5sclose_f", error, total_error)
|
|
CALL h5gclose_f(group_id, error)
|
|
CALL check("h5gclose_f", error, total_error)
|
|
|
|
! Test opening an object by index, note
|
|
CALL h5oopen_by_idx_f(file_id, "/G1/G2/G3", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, group_id, error)
|
|
CALL check("h5oopen_by_idx_f", error, total_error)
|
|
|
|
CALL h5oclose_f(group_id, error)
|
|
CALL check("h5gclose_f", error, total_error)
|
|
|
|
!
|
|
! create property to pass copy options
|
|
!
|
|
CALL h5pcreate_f(H5P_LINK_CREATE_F, lcpl_id, error)
|
|
CALL check("h5Pcreate_f", error, total_error)
|
|
|
|
CALL h5pset_create_inter_group_f(lcpl_id, TRUE, error)
|
|
CALL check("H5Pset_create_inter_group_f", error, total_error)
|
|
!
|
|
! Check optional parameter lcpl_id, this would fail if lcpl_id was not specified
|
|
!
|
|
CALL h5ocopy_f(file_id, "/G1/G2/G3/DS1", file_id, "/G1/G_cp1/DS2", error, lcpl_id=lcpl_id)
|
|
CALL check("h5ocopy_f -- W/ OPTION: lcpl_id", error ,total_error)
|
|
|
|
CALL h5pclose_f(lcpl_id, error)
|
|
CALL check("h5pclose_f",error,total_error)
|
|
|
|
CALL h5pcreate_f(H5P_OBJECT_COPY_F, ocpypl_id, error)
|
|
CALL check("h5Pcreate_f",error,total_error)
|
|
|
|
CALL h5pset_copy_object_f(ocpypl_id, H5O_COPY_SHALLOW_HIERARCHY_F, error)
|
|
CALL check("H5Pset_copy_object_f",error,total_error)
|
|
|
|
CALL h5ocopy_f(file_id, "/G1/G2", file_id, "/G1/G_cp2", error, ocpypl_id=ocpypl_id)
|
|
CALL check("h5ocopy_f",error,total_error)
|
|
|
|
! Makes sure the "DS1" dataset was not copied since we set a
|
|
! flag to copy only immediate members of a group.
|
|
! Therefore, this should fail.
|
|
CALL h5dopen_f(file_id, "/G1/G_cp2/DS1", dset_id, error)
|
|
IF(error.EQ.0)THEN
|
|
CALL check("h5ocopy_f -- W/ OPTION: ocpypl_id", -1, total_error)
|
|
ENDIF
|
|
|
|
CALL h5pclose_f(ocpypl_id, error)
|
|
CALL check("h5pclose_f",error,total_error)
|
|
|
|
! create datatype
|
|
CALL h5tcopy_f(H5T_NATIVE_INTEGER, tid, error)
|
|
CALL check("h5tcopy_f", error, total_error)
|
|
|
|
! create named datatype
|
|
CALL h5tcommit_f(file_id, NAME_DATATYPE_SIMPLE, tid, error)
|
|
CALL check("h5tcommit_f", error, total_error)
|
|
|
|
! close the datatype
|
|
CALL h5tclose_f(tid, error)
|
|
CALL check("h5tclose_f",error, total_error)
|
|
|
|
CALL h5ocopy_f(file_id, NAME_DATATYPE_SIMPLE, file_id, NAME_DATATYPE_SIMPLE2, error)
|
|
CALL check("h5ocopy_f",error,total_error)
|
|
|
|
! open the datatype for copy
|
|
CALL h5topen_f(file_id, NAME_DATATYPE_SIMPLE, tid, error)
|
|
CALL check("h5topen_f",error,total_error)
|
|
|
|
! open the copied datatype
|
|
CALL h5topen_f(file_id, NAME_DATATYPE_SIMPLE2, tid2, error)
|
|
CALL check("h5topen_f",error,total_error)
|
|
|
|
! Compare the datatypes
|
|
CALL h5tequal_f(tid, tid2, flag, error)
|
|
IF(.NOT.flag)THEN
|
|
CALL check("h5ocopy_f FAILED", -1, total_error)
|
|
ENDIF
|
|
|
|
! close the destination datatype
|
|
CALL h5tclose_f(tid, error)
|
|
CALL check("h5tclose_f",error,total_error)
|
|
|
|
! close the destination datatype
|
|
CALL h5tclose_f(tid2, error)
|
|
CALL check("h5tclose_f",error,total_error)
|
|
|
|
CALL h5fclose_f(file_id, error)
|
|
CALL check("h5fclose_f",error,total_error)
|
|
|
|
END SUBROUTINE test_h5o_link
|
|
|
|
!***************************************************************
|
|
!**
|
|
!** test_h5o_plist(): Test object creation properties
|
|
!**
|
|
!***************************************************************
|
|
|
|
SUBROUTINE test_h5o_plist(total_error)
|
|
|
|
IMPLICIT NONE
|
|
INTEGER, INTENT(INOUT) :: total_error
|
|
|
|
INTEGER(hid_t) :: fid ! HDF5 File ID
|
|
INTEGER(hid_t) :: grp, dset, dtype, dspace ! Object identifiers
|
|
INTEGER(hid_t) :: fapl ! File access property list
|
|
INTEGER(hid_t) :: gcpl, dcpl, tcpl ! Object creation properties
|
|
INTEGER :: def_max_compact, def_min_dense ! Default phase change parameters
|
|
INTEGER :: max_compact, min_dense ! Actual phase change parameters
|
|
INTEGER :: error ! Value returned from API calls
|
|
CHARACTER(LEN=7), PARAMETER :: TEST_FILENAME = 'test.h5'
|
|
|
|
|
|
! PRINT*,'Testing object creation properties'
|
|
|
|
! Make a FAPL that uses the "use the latest version of the format" flag
|
|
CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error)
|
|
CALL check("H5Pcreate_f", error, total_error)
|
|
|
|
! Set the "use the latest version of the format" bounds for creating objects in the file
|
|
CALL H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error)
|
|
CALL check("H5Pcreate_f", error, total_error)
|
|
|
|
! Create a new HDF5 file
|
|
CALL H5Fcreate_f(TEST_FILENAME, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl)
|
|
CALL check("H5Fcreate_f", error, total_error)
|
|
|
|
! Create group, dataset & named datatype creation property lists
|
|
CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl, error)
|
|
CALL check("H5Pcreate_f", error, total_error)
|
|
CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dcpl, error)
|
|
CALL check("H5Pcreate_f", error, total_error)
|
|
CALL H5Pcreate_f(H5P_DATATYPE_CREATE_F, tcpl, error)
|
|
CALL check("H5Pcreate_f", error, total_error)
|
|
|
|
! Retrieve default attribute phase change values
|
|
CALL H5Pget_attr_phase_change_f(gcpl, def_max_compact, def_min_dense, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
|
|
! Set non-default attribute phase change values on each creation property list
|
|
CALL H5Pset_attr_phase_change_f(gcpl, def_max_compact+1, def_min_dense-1, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL H5Pset_attr_phase_change_f(dcpl, def_max_compact+1, def_min_dense-1, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL H5Pset_attr_phase_change_f(tcpl, def_max_compact+1, def_min_dense-1, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
|
|
! Retrieve attribute phase change values on each creation property list and verify
|
|
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
|
|
|
|
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
|
|
|
|
CALL H5Pget_attr_phase_change_f(tcpl, max_compact, min_dense, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
|
|
|
|
! Create a group, dataset, and committed datatype within the file,
|
|
! using the respective type of creation property lists.
|
|
!
|
|
|
|
! Create the group anonymously and link it in
|
|
CALL H5Gcreate_anon_f(fid, grp, error, gcpl_id=gcpl)
|
|
CALL check("H5Gcreate_anon_f", error, total_error)
|
|
|
|
CALL H5Olink_f(grp, fid, "group", error)
|
|
CALL check("H5Olink_f", error, total_error)
|
|
|
|
! Commit the type inside the group anonymously and link it in
|
|
CALL h5tcopy_f(H5T_NATIVE_INTEGER, dtype, error)
|
|
CALL check("h5tcopy_f", error, total_error)
|
|
|
|
CALL H5Tcommit_anon_f(fid, dtype, error, tcpl_id=tcpl)
|
|
CALL check("H5Tcommit_anon_f",error,total_error)
|
|
|
|
CALL H5Olink_f(dtype, fid, "datatype", error)
|
|
CALL check("H5Olink_f", error, total_error)
|
|
|
|
! Create the dataspace for the dataset.
|
|
CALL h5screate_f(H5S_SCALAR_F, dspace, error)
|
|
CALL check("h5screate_f",error,total_error)
|
|
|
|
! Create the dataset anonymously and link it in
|
|
CALL H5Dcreate_anon_f(fid, H5T_NATIVE_INTEGER, dspace, dset, error, dcpl )
|
|
CALL check("H5Dcreate_anon_f",error,total_error)
|
|
|
|
CALL H5Olink_f(dset, fid, "dataset", error)
|
|
CALL check("H5Olink_f", error, total_error)
|
|
|
|
CALL h5sclose_f(dspace, error)
|
|
CALL check("h5sclose_f",error,total_error)
|
|
|
|
! Close current creation property lists
|
|
CALL h5pclose_f(gcpl,error)
|
|
CALL check("h5pclose_f", error, total_error)
|
|
CALL h5pclose_f(dcpl,error)
|
|
CALL check("h5pclose_f", error, total_error)
|
|
CALL h5pclose_f(tcpl,error)
|
|
CALL check("h5pclose_f", error, total_error)
|
|
|
|
! Retrieve each object's creation property list
|
|
CALL H5Gget_create_plist_f(grp, gcpl, error)
|
|
CALL check("H5Gget_create_plist", error, total_error)
|
|
|
|
CALL H5Tget_create_plist_f(dtype, tcpl, error)
|
|
CALL check("H5Tget_create_plist_f", error, total_error)
|
|
|
|
CALL H5Dget_create_plist_f(dset, dcpl, error)
|
|
CALL check("H5Dget_create_plist_f", error, total_error)
|
|
|
|
! Retrieve attribute phase change values on each creation property list and verify
|
|
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
|
|
|
|
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
|
|
|
|
CALL H5Pget_attr_phase_change_f(tcpl, max_compact, min_dense, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
|
|
|
|
! Close current objects
|
|
CALL h5pclose_f(gcpl,error)
|
|
CALL check("h5pclose_f", error, total_error)
|
|
CALL h5pclose_f(dcpl,error)
|
|
CALL check("h5pclose_f", error, total_error)
|
|
CALL h5pclose_f(tcpl,error)
|
|
CALL check("h5pclose_f", error, total_error)
|
|
|
|
CALL h5gclose_f(grp, error)
|
|
CALL check("h5gclose_f",error,total_error)
|
|
|
|
CALL h5tclose_f(dtype, error)
|
|
CALL check("h5tclose_f",error,total_error)
|
|
CALL h5dclose_f(dset, error)
|
|
CALL check("h5dclose_f",error,total_error)
|
|
CALL h5fclose_f(fid, error)
|
|
CALL check("h5fclose_f",error,total_error)
|
|
! Re-open the file and check that the object creation properties persist
|
|
CALL h5fopen_f(TEST_FILENAME, H5F_ACC_RDONLY_F, fid, error, access_prp=fapl)
|
|
CALL check("H5fopen_f",error,total_error)
|
|
|
|
! Re-open objects
|
|
CALL H5Gopen_f(fid, "group", grp, error)
|
|
CALL check("h5gopen_f", error, total_error)
|
|
|
|
CALL H5Topen_f(fid, "datatype", dtype,error)
|
|
CALL check("h5topen_f", error, total_error)
|
|
|
|
CALL H5Dopen_f(fid, "dataset", dset, error)
|
|
CALL check("h5dopen_f", error, total_error)
|
|
|
|
! Retrieve each object's creation property list
|
|
CALL H5Gget_create_plist_f(grp, gcpl, error)
|
|
CALL check("H5Gget_create_plist", error, total_error)
|
|
|
|
CALL H5Tget_create_plist_f(dtype, tcpl, error)
|
|
CALL check("H5Tget_create_plist_f", error, total_error)
|
|
|
|
CALL H5Dget_create_plist_f(dset, dcpl, error)
|
|
CALL check("H5Dget_create_plist_f", error, total_error)
|
|
|
|
! Retrieve attribute phase change values on each creation property list and verify
|
|
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
|
|
|
|
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
|
|
|
|
CALL H5Pget_attr_phase_change_f(tcpl, max_compact, min_dense, error)
|
|
CALL check("H5Pget_attr_phase_change_f", error, total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
|
|
CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
|
|
|
|
! Close current objects
|
|
CALL h5pclose_f(gcpl,error)
|
|
CALL check("h5pclose_f", error, total_error)
|
|
CALL h5pclose_f(dcpl,error)
|
|
CALL check("h5pclose_f", error, total_error)
|
|
CALL h5pclose_f(tcpl,error)
|
|
CALL check("h5pclose_f", error, total_error)
|
|
|
|
CALL h5gclose_f(grp, error)
|
|
CALL check("h5gclose_f",error,total_error)
|
|
|
|
CALL h5tclose_f(dtype, error)
|
|
CALL check("h5tclose_f",error,total_error)
|
|
CALL h5dclose_f(dset, error)
|
|
CALL check("h5dclose_f",error,total_error)
|
|
CALL h5fclose_f(fid, error)
|
|
CALL check("h5fclose_f",error,total_error)
|
|
|
|
! Close the FAPL
|
|
CALL H5Pclose_f(fapl, error)
|
|
CALL check("H5Pclose_f", error, total_error)
|
|
|
|
END SUBROUTINE test_h5o_plist
|
|
|
|
END MODULE TH5O
|