! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! 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. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! ! The following example shows how to create and close a group. ! It creates a file called 'group.h5', creates a group ! called MyGroup in the root group, and then closes the group and file. ! PROGRAM TEST USE HDF5 ! This module contains all necessary modules USE H5LT ! This module contains all necessary modules HDF5 Lite IMPLICIT NONE CHARACTER(LEN=12), PARAMETER :: filename = "M1.50Z.se.h5" ! File name INTEGER(HID_T) :: file_id ! File identifier CHARACTER(LEN=7), PARAMETER :: groupname = "cycle-1" ! Group name INTEGER(HID_T) :: group_id ! Group identifier ! First dataset w/o attribute CHARACTER(LEN=4), PARAMETER :: dsetname = "A" ! Dataset name INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier REAL*8, DIMENSION(4) :: dset_data ! Data arrays INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/1,4/) ! Dataset dimensions INTEGER(HSIZE_T), DIMENSION(2) :: data_dims INTEGER :: rank = 2 ! Dataset rank ! String attribute CHARACTER(LEN=*), PARAMETER :: aname = "codev" ! Attribute name INTEGER(HID_T) :: attr_id ! Attribute identifier INTEGER(HID_T) :: aspace_id ! Attribute Dataspace identifier INTEGER(HID_T) :: atype_id ! Attribute Dataspace identifier INTEGER(HSIZE_T), DIMENSION(1) :: adims = (/2/) ! Attribute dimension INTEGER :: arank = 1 ! Attribure rank INTEGER(SIZE_T) :: attrlen ! Length of the attribute CHARACTER(LEN=80), DIMENSION(2) :: attr_data ! Attribute data INTEGER(HSIZE_T), DIMENSION(1) :: attr_dims ! Double attribute CHARACTER(LEN=*), PARAMETER :: aname2 = "R_sol" ! Attribute name INTEGER(HID_T) :: attr_id2 ! Attribute identifier INTEGER(HID_T) :: aspace_id2 ! Attribute Dataspace identifier INTEGER(HID_T) :: atype_id2 ! Attribute Dataspace identifier INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension INTEGER :: arank2 = 1 ! Attribure rank DOUBLE PRECISION, DIMENSION(1) :: attr_data2 ! Attribute data INTEGER(HSIZE_T), DIMENSION(1) :: attr_dims2 ! SE_DATASET for the group CHARACTER(LEN=*), PARAMETER :: dsetname2 = "SE_DATASET" ! Dataset name INTEGER(HID_T) :: dset_id2 ! Dataset identifier INTEGER(HID_T) :: dspace_id2 ! Dataspace identifier REAL*8, DIMENSION(3,5) :: dset_data2 ! Data arrays INTEGER(HSIZE_T), DIMENSION(2) :: dims2 = (/3,5/) ! Dataset dimensions INTEGER(HSIZE_T), DIMENSION(2) :: data_dims2 INTEGER :: rank2 = 2 ! Dataset rank INTEGER :: error ! Error flag ! Initialize FORTRAN interface. CALL h5open_f(error) ! Create a new file using default properties. CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Create a group with attributes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Create a group CALL h5gcreate_f(file_id, groupname, group_id, error) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! String attribute attr_data(1) = "helix.phys.uvic.ca:" attr_data(2) = "\astro\jcpassy\awesome\blossom" attrlen = 80 ! Create scalar data space for the attribute. CALL h5screate_simple_f(arank, adims, aspace_id, error) ! Create datatype for the attribute. CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, error) CALL h5tset_size_f(atype_id, attrlen, error) ! Create dataset attribute. CALL h5acreate_f(group_id, aname, atype_id, aspace_id, attr_id, error) ! Write the attribute data. attr_dims(1) = 2 CALL h5awrite_f(attr_id, atype_id, attr_data, attr_dims, error) ! Close the attribute. CALL h5aclose_f(attr_id, error) ! Terminate access to the data space. CALL h5sclose_f(aspace_id, error) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Double attribute attr_data2(1) = 1876564421.342345 ! Create scalar data space for the attribute. CALL h5screate_simple_f(arank2, adims2, aspace_id2, error) ! Create datatype for the attribute. CALL h5tcopy_f(H5T_NATIVE_DOUBLE, atype_id2, error) ! Create dataset attribute. CALL h5acreate_f(group_id, aname2, atype_id2, aspace_id2, attr_id2, error) ! Write the attribute data. attr_dims2(1) = 2 CALL h5awrite_f(attr_id2, atype_id2, attr_data2, attr_dims2, error) ! Close the attribute. CALL h5aclose_f(attr_id2, error) ! Terminate access to the data space. CALL h5sclose_f(aspace_id2, error) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! SE_DATASET attached to the group CALL h5screate_simple_f(rank2, dims2, dspace_id2, error) ! Initialization ! Mass dset_data2(1,1) = 5.0; dset_data2(1,2) = 4.0; dset_data2(1,3) = 3.0; dset_data2(1,4) = 2.0; dset_data2(1,5) = 1.0; ! Radius dset_data2(2,1) = 3.0; dset_data2(2,2) = 2.5; dset_data2(2,3) = 2.0; dset_data2(2,4) = 1.0; dset_data2(2,5) = 0.5; ! Rho dset_data2(3,1) = 7.0; dset_data2(3,2) = 6.5; dset_data2(3,3) = 6.0; dset_data2(3,4) = 5.5; dset_data2(3,5) = 5.0; ! Create dataset CALL h5dcreate_f(group_id, dsetname2, H5T_NATIVE_DOUBLE, dspace_id2, dset_id2, error) ! Write dataset data_dims2(1) = 3 data_dims2(2) = 5 CALL h5dwrite_f(dset_id2, H5T_NATIVE_DOUBLE, dset_data2, data_dims2, error) ! End access to the dataset and release resources used by it. CALL h5dclose_f(dset_id2, error) ! Terminate access to the data space. CALL h5sclose_f(dspace_id2, error) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Close the group. CALL h5gclose_f(group_id, error) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Create a simple dataset with no attribute !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Create the dataspace CALL h5screate_simple_f(rank, dims, dspace_id, error) ! Initialize dataset array dset_data(1) = 1.0; dset_data(2) = 4.0; dset_data(3) = 12.0; dset_data(4) = 16.0; ! Create the dataset with default properties CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_DOUBLE, dspace_id, dset_id, error) ! Write first dataset. data_dims(1) = 1 data_dims(2) = 4 CALL h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dset_data, data_dims, error) ! End access to the dataset and release resources used by it. CALL h5dclose_f(dset_id, error) ! Terminate access to the data space. CALL h5sclose_f(dspace_id, error) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Terminate access to the file. CALL h5fclose_f(file_id, error) ! Close FORTRAN interface. CALL h5close_f(error) END PROGRAM TEST