! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! 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 files COPYING and Copyright.html. COPYING can be found at the root * ! of the source code distribution tree; Copyright.html can be found at the * ! root level of an installed copy of the electronic HDF5 document set and * ! is linked from the top-level documents page. It can also be found at * ! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * ! access to either file, you may request a copy from help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! SUBROUTINE attribute_test(cleanup, total_error) ! This subroutine tests following functionalities: ! h5acreate_f, h5awrite_f, h5aclose_f,h5aread_f, h5aopen_name_f, ! h5aget_name_f,h5aget_space_f, h5aget_type_f, ! USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=5), PARAMETER :: filename = "atest" !File name CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=9), PARAMETER :: dsetname = "atestdset" !Dataset name CHARACTER(LEN=11), PARAMETER :: aname = "attr_string" !String Attribute name CHARACTER(LEN=14), PARAMETER :: aname2 = "attr_character"!Character Attribute name CHARACTER(LEN=11), PARAMETER :: aname3 = "attr_double" !DOuble Attribute name CHARACTER(LEN=9), PARAMETER :: aname4 = "attr_real" !Real Attribute name CHARACTER(LEN=12), PARAMETER :: aname5 = "attr_integer" !Integer Attribute name ! !data space rank and dimensions ! INTEGER, PARAMETER :: RANK = 2 INTEGER, PARAMETER :: NX = 4 INTEGER, PARAMETER :: NY = 5 INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dataspace ! Dataspace identifier for dataset INTEGER(HID_T) :: attr_id !String Attribute identifier INTEGER(HID_T) :: attr2_id !Character Attribute identifier INTEGER(HID_T) :: attr3_id !Double Attribute identifier INTEGER(HID_T) :: attr4_id !Real Attribute identifier INTEGER(HID_T) :: attr5_id !Integer Attribute identifier INTEGER(HID_T) :: aspace_id !String Attribute Dataspace identifier INTEGER(HID_T) :: aspace2_id !Character Attribute Dataspace identifier INTEGER(HID_T) :: aspace3_id !Double Attribute Dataspace identifier INTEGER(HID_T) :: aspace4_id !Real Attribute Dataspace identifier INTEGER(HID_T) :: aspace5_id !Integer Attribute Dataspace identifier INTEGER(HID_T) :: atype_id !String Attribute Datatype identifier INTEGER(HID_T) :: atype2_id !Character Attribute Datatype identifier INTEGER(HID_T) :: atype3_id !Double Attribute Datatype identifier INTEGER(HID_T) :: atype4_id !Real Attribute Datatype identifier INTEGER(HID_T) :: atype5_id !Integer Attribute Datatype identifier INTEGER(HSIZE_T), DIMENSION(1) :: adims = (/2/) ! Attribute dimension INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension INTEGER :: arank = 1 ! Attribure rank INTEGER(SIZE_T) :: attrlen ! Length of the attribute string INTEGER(HID_T) :: attr_space !Returned String Attribute Space identifier INTEGER(HID_T) :: attr2_space !Returned other Attribute Space identifier INTEGER(HID_T) :: attr_type !Returned Attribute Datatype identifier INTEGER(HID_T) :: attr2_type !Returned CHARACTER Attribute Datatype identifier INTEGER(HID_T) :: attr3_type !Returned DOUBLE Attribute Datatype identifier INTEGER(HID_T) :: attr4_type !Returned REAL Attribute Datatype identifier INTEGER(HID_T) :: attr5_type !Returned INTEGER Attribute Datatype identifier INTEGER :: num_attrs !number of attributes CHARACTER(LEN=256) :: attr_name !buffer to put attr_name INTEGER(SIZE_T) :: name_size = 80 !attribute name length CHARACTER(LEN=35), DIMENSION(2) :: attr_data ! String attribute data CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back ! string attr data CHARACTER :: attr_character_data = 'A' DOUBLE PRECISION, DIMENSION(1) :: attr_double_data = 3.459 REAL, DIMENSION(1) :: attr_real_data = 4.0 INTEGER, DIMENSION(1) :: attr_integer_data = 5 INTEGER(HSIZE_T), DIMENSION(7) :: data_dims CHARACTER :: aread_character_data ! variable to put read back Character attr data INTEGER, DIMENSION(1) :: aread_integer_data ! variable to put read back integer attr data DOUBLE PRECISION, DIMENSION(1) :: aread_double_data ! variable to put read back double attr data REAL, DIMENSION(1) :: aread_real_data ! variable to put read back real attr data ! !general purpose integer ! INTEGER :: i, j INTEGER :: error ! Error flag ! !The dimensions for the dataset. ! INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) ! !data buffers ! INTEGER, DIMENSION(NX,NY) :: data_in, data_out ! !Initialize data_in buffer ! do i = 1, NX do j = 1, NY data_in(i,j) = (i-1) + (j-1) end do end do ! ! Initialize attribute's data ! attr_data(1) = 'Dataset character attribute' attr_data(2) = 'Some other string here ' attrlen = len(attr_data(1)) ! ! Create the file. ! CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) if (error .ne. 0) then write(*,*) "Cannot modify file name" stop endif CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f",error,total_error) ! !Create data space for the dataset. ! CALL h5screate_simple_f(RANK, dims, dataspace, error) CALL check("h5screate_simple_f",error,total_error) ! ! create dataset in the file. ! CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, & dset_id, error) CALL check("h5dcreate_f",error,total_error) ! ! Write data_in to the dataset ! data_dims(1) = NX data_dims(2) = NY CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error) CALL check("h5dwrite_f",error,total_error) ! ! Create scalar data space for the String attribute. ! CALL h5screate_simple_f(arank, adims, aspace_id, error) CALL check("h5screate_simple_f",error,total_error) ! ! Create scalar data space for all other attributes. ! CALL h5screate_simple_f(arank, adims2, aspace2_id, error) CALL check("h5screate_simple_f",error,total_error) ! ! Create datatype for the String attribute. ! CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, error) CALL check("h5tcopy_f",error,total_error) CALL h5tset_size_f(atype_id, attrlen, error) CALL check("h5tset_size_f",error,total_error) ! ! Create datatype for the Character attribute. ! CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype2_id, error) CALL check("h5tcopy_f",error,total_error) ! ! Create datatype for the Double attribute. ! CALL h5tcopy_f(H5T_NATIVE_DOUBLE, atype3_id, error) CALL check("h5tcopy_f",error,total_error) ! ! Create datatype for the Real attribute. ! CALL h5tcopy_f(H5T_NATIVE_REAL, atype4_id, error) CALL check("h5tcopy_f",error,total_error) ! ! Create datatype for the Integer attribute. ! CALL h5tcopy_f(H5T_NATIVE_INTEGER, atype5_id, error) CALL check("h5tcopy_f",error,total_error) ! ! Create dataset String attribute. ! CALL h5acreate_f(dset_id, aname, atype_id, aspace_id, & attr_id, error) CALL check("h5acreate_f",error,total_error) ! ! Create dataset CHARACTER attribute. ! CALL h5acreate_f(dset_id, aname2, atype2_id, aspace2_id, & attr2_id, error) CALL check("h5acreate_f",error,total_error) ! ! Create dataset DOUBLE attribute. ! CALL h5acreate_f(dset_id, aname3, atype3_id, aspace2_id, & attr3_id, error) CALL check("h5acreate_f",error,total_error) ! ! Create dataset REAL attribute. ! CALL h5acreate_f(dset_id, aname4, atype4_id, aspace2_id, & attr4_id, error) CALL check("h5acreate_f",error,total_error) ! ! Create dataset INTEGER attribute. ! CALL h5acreate_f(dset_id, aname5, atype5_id, aspace2_id, & attr5_id, error) CALL check("h5acreate_f",error,total_error) ! ! Write the String attribute data. ! data_dims(1) = 2 CALL h5awrite_f(attr_id, atype_id, attr_data, data_dims, error) CALL check("h5awrite_f",error,total_error) ! ! Write the Character attribute data. ! CALL h5awrite_f(attr2_id, atype2_id, attr_character_data, data_dims, error) CALL check("h5awrite_f",error,total_error) ! ! Write the DOUBLE attribute data. ! data_dims(1) = 1 CALL h5awrite_f(attr3_id, atype3_id, attr_double_data, data_dims, error) CALL check("h5awrite_f",error,total_error) ! ! Write the Real attribute data. ! data_dims(1) = 1 CALL h5awrite_f(attr4_id, atype4_id, attr_real_data, data_dims, error) CALL check("h5awrite_f",error,total_error) ! ! Write the Integer attribute data. ! data_dims(1) = 1 CALL h5awrite_f(attr5_id, atype5_id, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) ! ! Close the attribute. ! CALL h5aclose_f(attr_id, error) CALL check("h5aclose_f",error,total_error) CALL h5aclose_f(attr2_id, error) CALL check("h5aclose_f",error,total_error) CALL h5aclose_f(attr3_id, error) CALL check("h5aclose_f",error,total_error) CALL h5aclose_f(attr4_id, error) CALL check("h5aclose_f",error,total_error) CALL h5aclose_f(attr5_id, error) CALL check("h5aclose_f",error,total_error) CALL h5tclose_f(atype_id, error) CALL check("h5tclose_f",error,total_error) CALL h5tclose_f(atype2_id, error) CALL check("h5tclose_f",error,total_error) CALL h5tclose_f(atype3_id, error) CALL check("h5tclose_f",error,total_error) CALL h5tclose_f(atype4_id, error) CALL check("h5tclose_f",error,total_error) CALL h5tclose_f(atype5_id, error) CALL check("h5tclose_f",error,total_error) ! ! Terminate access to the data space. ! CALL h5sclose_f(aspace_id, error) CALL check("h5sclose_f",error,total_error) CALL h5sclose_f(aspace2_id, error) CALL check("h5sclose_f",error,total_error) ! ! Terminate access to the dataset. ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f",error,total_error) ! ! Terminate access to the file. ! CALL h5fclose_f(file_id, error) CALL check("h5fclose_f",error,total_error) ! ! Open file ! CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, file_id, error) CALL check("h5open_f",error,total_error) ! ! Reopen dataset ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f",error,total_error) ! !open the String attrbute by name ! CALL h5aopen_name_f(dset_id, aname, attr_id, error) CALL check("h5aopen_name_f",error,total_error) ! !open the CHARACTER attrbute by name ! CALL h5aopen_name_f(dset_id, aname2, attr2_id, error) CALL check("h5aopen_name_f",error,total_error) ! !open the DOUBLE attrbute by name ! CALL h5aopen_name_f(dset_id, aname3, attr3_id, error) CALL check("h5aopen_name_f",error,total_error) ! !open the REAL attrbute by name ! CALL h5aopen_name_f(dset_id, aname4, attr4_id, error) CALL check("h5aopen_name_f",error,total_error) ! !open the INTEGER attrbute by name ! CALL h5aopen_name_f(dset_id, aname5, attr5_id, error) CALL check("h5aopen_idx_f",error,total_error) ! !get the attrbute name ! CALL h5aget_name_f(attr5_id, name_size, attr_name, error) CALL check("h5aget_name_f",error,total_error) if (attr_name(1:12) .ne. aname5) then total_error = total_error + 1 end if if (error .ne. 12) then total_error = total_error + 1 end if ! !get the STRING attrbute space ! CALL h5aget_space_f(attr_id, attr_space, error) CALL check("h5aget_space_f",error,total_error) ! !get other attrbute space ! CALL h5aget_space_f(attr2_id, attr2_space, error) CALL check("h5aget_space_f",error,total_error) ! !get the string attrbute datatype ! CALL h5aget_type_f(attr_id, attr_type, error) CALL check("h5aget_type_f",error,total_error) ! !get the character attrbute datatype ! CALL h5aget_type_f(attr2_id, attr2_type, error) CALL check("h5aget_type_f",error,total_error) ! !get the double attrbute datatype ! CALL h5aget_type_f(attr3_id, attr3_type, error) CALL check("h5aget_type_f",error,total_error) ! !get the real attrbute datatype ! CALL h5aget_type_f(attr4_id, attr4_type, error) CALL check("h5aget_type_f",error,total_error) ! !get the integer attrbute datatype ! CALL h5aget_type_f(attr5_id, attr5_type, error) CALL check("h5aget_type_f",error,total_error) ! !get number of attributes ! CALL h5aget_num_attrs_f(dset_id, num_attrs, error) CALL check("h5aget_num_attrs_f",error,total_error) if (num_attrs .ne. 5) then write(*,*) "got number of attributes wrong", num_attrs total_error = total_error +1 end if ! !set the read back data type's size ! CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, error) CALL check("h5tcopy_f",error,total_error) CALL h5tset_size_f(atype_id, attrlen, error) CALL check("h5tset_size_f",error,total_error) ! !read the string attribute data back to memory ! data_dims(1) = 2 CALL h5aread_f(attr_id, atype_id, aread_data, data_dims, error) CALL check("h5aread_f",error,total_error) if ( (aread_data(1) .ne. attr_data(1)) .or. (aread_data(2) .ne. attr_data(2)) ) then write(*,*) "Read back string attrbute is wrong", aread_data(1), aread_data(2) total_error = total_error + 1 end if ! !read the CHARACTER attribute data back to memory ! CALL h5aread_f(attr2_id, H5T_NATIVE_CHARACTER, aread_character_data, data_dims, error) CALL check("h5aread_f",error,total_error) if (aread_character_data .ne. 'A' ) then write(*,*) "Read back character attrbute is wrong ",aread_character_data total_error = total_error + 1 end if ! !read the double attribute data back to memory ! data_dims(1) = 1 CALL h5aread_f(attr3_id, H5T_NATIVE_DOUBLE, aread_double_data, data_dims, error) CALL check("h5aread_f",error,total_error) if (aread_double_data(1) .ne. 3.459 ) then write(*,*) "Read back double attrbute is wrong", aread_double_data(1) total_error = total_error + 1 end if ! !read the real attribute data back to memory ! data_dims(1) = 1 CALL h5aread_f(attr4_id, H5T_NATIVE_REAL, aread_real_data, data_dims, error) CALL check("h5aread_f",error,total_error) if (aread_real_data(1) .ne. 4.0 ) then write(*,*) "Read back real attrbute is wrong ", aread_real_data total_error = total_error + 1 end if ! !read the Integer attribute data back to memory ! data_dims(1) = 1 CALL h5aread_f(attr5_id, H5T_NATIVE_INTEGER, aread_integer_data, data_dims, error) CALL check("h5aread_f",error,total_error) if (aread_integer_data(1) .ne. 5 ) then write(*,*) "Read back integer attrbute is wrong ", aread_integer_data total_error = total_error + 1 end if ! ! Close the attribute. ! CALL h5aclose_f(attr_id, error) CALL check("h5aclose_f",error,total_error) CALL h5aclose_f(attr2_id, error) CALL check("h5aclose_f",error,total_error) CALL h5aclose_f(attr3_id, error) CALL check("h5aclose_f",error,total_error) CALL h5aclose_f(attr4_id, error) CALL check("h5aclose_f",error,total_error) CALL h5aclose_f(attr5_id, error) CALL check("h5aclose_f",error,total_error) ! ! Delete the attribute from the Dataset. ! CALL h5adelete_f(dset_id, aname, error) CALL check("h5adelete_f",error,total_error) ! !get number of attributes ! CALL h5aget_num_attrs_f(dset_id, num_attrs, error) CALL check("h5aget_num_attrs_f",error,total_error) if (num_attrs .ne. 4) then write(*,*) "got number of attributes wrong", num_attrs total_error = total_error +1 end if CALL h5sclose_f(attr_space, error) CALL check("h5sclose_f",error,total_error) CALL h5sclose_f(attr2_space, error) CALL check("h5sclose_f",error,total_error) ! ! Terminate access to the data type. ! CALL h5tclose_f(attr_type, error) CALL check("h5tclose_f",error,total_error) CALL h5tclose_f(attr2_type, error) CALL check("h5tclose_f",error,total_error) CALL h5tclose_f(attr3_type, error) CALL check("h5tclose_f",error,total_error) CALL h5tclose_f(attr4_type, error) CALL check("h5tclose_f",error,total_error) CALL h5tclose_f(attr5_type, error) CALL check("h5tclose_f",error,total_error) ! ! End access to the dataset and release resources used by it. ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f",error,total_error) ! ! Close the file. ! CALL h5fclose_f(file_id, error) CALL check("h5fclose_f",error,total_error) ! ! Remove the file ! if (cleanup) call h5_cleanup_f(filename, H5P_DEFAULT_F, error) RETURN END SUBROUTINE attribute_test