check_attribute_params Subroutine

public subroutine check_attribute_params(attribute, nm, sz, class_id, dims)

Arguments

Type IntentOptional Attributes Name
integer(kind=hid_t), intent(in) :: attribute
character(len=*), intent(in) :: nm
integer(kind=hsize_t), intent(in) :: sz
integer(kind=hdf_err), intent(in) :: class_id
integer(kind=hsize_t), intent(in) :: dims(:)

Contents


Source Code

    subroutine check_attribute_params(attribute, nm, sz, class_id, dims)

        ! Check that a attribute has the character that is required of it
        ! before reading in.

      integer(hid_t), intent(in) :: attribute
      integer(hdf_err), intent(in) :: class_id
      character(*), intent(in) :: nm
      integer(hsize_t), intent(in) :: sz
      integer(hsize_t), intent(in) :: dims(:)
      character(*), parameter :: t_r = 'check_attribute_params'

      integer(hid_t) :: rank, type_id

      integer(hid_t) :: dataspace
      integer(hdf_err) :: err, ds_class, ds_rank
      integer(hsize_t) :: ds_dims(size(dims)), ds_max_dims(size(dims)), ds_sz

      ! Get the type associated with the attribute. Check that it is an
      ! array with components that have the right number of bytes, and the
      ! correct base class type
      call h5aget_type_f(attribute, type_id, err)
      call h5tget_size_f(type_id, ds_sz, err)
      call h5tget_class_f(type_id, ds_class, err)
      call h5tclose_f(type_id, err)

      if (ds_sz /= sz .or. ds_class /= class_id) then
         write(stdout,*) 'Attribute name: ', nm
         call stop_all(t_r, "Invalid attribute type information found")
      end if

      ! Get the dataspace for the attribute. Check that the attribute has the
      ! requested dimensions
      call h5aget_space_f(attribute, dataspace, err)
      call h5sget_simple_extent_ndims_f(dataspace, ds_rank, err)

      rank = size(dims)
      if (rank /= ds_rank) then
         write(stdout,*) 'Attribute name: ', nm
         write(stdout,*) 'ranks', rank, ds_rank
         call stop_all(t_r, "Invalid attribute rank found")
      end if

      call h5sget_simple_extent_dims_f(dataspace, ds_dims, ds_max_dims, err)
      if (.not. all(dims == ds_dims)) then
         write(stdout,*) 'Attribute name: ', nm
         call stop_all(t_r, "Invalid attribute dimensions found")
      end if
      call h5sclose_f(dataspace, err)

    end subroutine check_attribute_params