Read a scalar attribute under a given group.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| class(hdf5_obj), | intent(inout) | :: | this |
A HDF5 object |
||
| character(len=*), | intent(in) | :: | groupname |
Groupname |
||
| character(len=*), | intent(in) | :: | label |
Attribute label |
||
| class(*), | intent(out), | target | :: | val |
Attribute value |
impure subroutine hdf5_obj_ReadAttributes0D(this,groupname,label,val) !> Read a scalar attribute under a given group. use iso_c_binding implicit none class(hdf5_obj), intent(inout) :: this !! A HDF5 object character(len=*), intent(in) :: groupname !! Groupname character(len=*), intent(in) :: label !! Attribute label class(*), intent(out), & target :: val !! Attribute value ! Work variables integer :: ierr integer(HID_T) :: obj integer, target :: int2log type(c_ptr) :: fptr integer(HID_T) :: dtype integer(HID_T) :: sid integer(HID_T) :: attrid integer(HSIZE_T):: dims(1) integer(HSIZE_T):: maxdims(1) ! Open group call this%OpenGroup(groupname) ! Open the attribute if (trim(adjustl(groupname)).eq.'/') then call H5Aopen_f(this%fid, trim(adjustl(label)), attrid, ierr, aapl_id=H5P_DEFAULT_F) else ! Get this group's object obj = this%GetGroupObject(groupname) if (obj.eq.-1_HID_T) & call this%parallel%Stop("Unable to find group "//trim(adjustl(groupname))//" in hdf5 file "//this%filename) call H5Aopen_f(obj, trim(adjustl(label)), attrid, ierr, aapl_id=H5P_DEFAULT_F) end if ! Get datatype and spaceid call H5Aget_type_f(attrid,dtype,ierr) call H5Aget_space_f(attrid,sid,ierr) ! Check dimensions call H5Sget_simple_extent_dims_f(sid, dims, maxdims, ierr) if (dims(1).ne.1) & call this%parallel%Stop("Size mismatch when reading attribute"//trim(adjustl(label))//" under "//trim(adjustl(groupname))//" in hdf5 file "//this%filename) ! Read attribute select type(val) type is (real(leapDP)) fptr = c_loc(val) type is (real(leapSP)) fptr = c_loc(val) type is (integer(leapI4)) fptr = c_loc(val) type is (integer(leapI8)) fptr = c_loc(val) type is (logical) fptr = c_loc(int2log) end select call H5Aread_f(attrid, dtype,fptr, ierr) select type(val) type is (logical) if (int2log.eq.1) then val = .true. else val = .false. end if end select ! Deallocate pointer fptr = c_null_ptr ! Remove attribute ID call H5Aclose_f(attrid, ierr) ! Close data space call H5Sclose_f(sid, ierr) ! Close group call this%CloseGroup(groupname) return end subroutine hdf5_obj_ReadAttributes0D