gdncattrgetchar.f90

Go to the documentation of this file.

!> @file gdncattrgetchar.f90
!>
!> @author GFD Dennou Club
!> @copyright Copyright (C) GFD Dennou Club, 2000-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. See [COPYRIGHT](@ref COPYRIGHT) in detail
!>
!> @en
!> @brief Get character attribute from netCDF variable
!> @enden
!>
!> @ja
!> @brief netCDF 変数から文字属性を取得
!> @endja
!>
 
!>
!> @en
!> @brief Get attribute value as character string
!>
!> Retrieves an attribute value, converting to character string if needed.
!> Numeric attributes are converted to string representation.
!> @enden
!>
!> @ja
!> @brief 属性値を文字列として取得
!>
!> 属性値を取得し、必要に応じて文字列に変換します。
!> 数値属性は文字列表現に変換されます。
!> @endja
!>
!> @param[in]  var     @en Variable handle @enden @ja 変数ハンドル @endja
!> @param[in]  name    @en Attribute name @enden @ja 属性名 @endja
!> @param[out] value   @en Retrieved value @enden @ja 取得した値 @endja
!> @param[in]  default @en Default value if attribute not found @enden
!>                     @ja 属性未検出時のデフォルト値 @endja
!> @param[out] stat    @en Status code @enden @ja ステータスコード @endja
!>
subroutine gdncattrgetchar(var, name, value, default, stat)
  use gtdata_netcdf_types, only: gd_nc_variable, gd_nc_variable_entry
  use gtdata_netcdf_internal, only: vtable_lookup
  use netcdf, only: nf90_noerr, nf90_global, nf90_inquire_attribute, nf90_char, nf90_get_att, &
    & nf90_double, nf90_float
  use dc_url, only: gt_plus
  use dc_string, only: tochar
  use dc_trace, only: beginsub, endsub
  use dc_error
  implicit none
  type(gd_nc_variable), intent(in):: var
  character(len = *), intent(in):: name
  character(len = *), intent(out):: value
  character(len = *), intent(in):: default
  integer, intent(out):: stat
  type(gd_nc_variable_entry):: ent
  character(len = 64):: buffer
  double precision, allocatable:: dbuf(:)
  integer, allocatable:: ibuf(:)
  character, allocatable:: cbuf(:)
  integer:: xtype, attrlen, i, iname, varid
  character(len = *), parameter:: subname = "GDNcAttrGetChar"
  continue
  call beginsub(subname, "var=%d name=%c default=%c", i=(/var%id/), &
    & c1=trim(name), c2=trim(default))
  stat = vtable_lookup(var, ent)
  if (stat /= nf90_noerr) goto 900
  if (name(1:1) == gt_plus) then
    varid = nf90_global
    iname = 2
  else
    varid = ent%varid
    iname = 1
  endif
  stat = nf90_inquire_attribute(ent%fileid, varid, name(iname:), xtype=xtype, len=attrlen)
  if (stat /= nf90_noerr) goto 900
  if (xtype == nf90_char .and. attrlen <= len(buffer)) then
    stat = nf90_get_att(ent%fileid, varid, name(iname:), buffer)
    if (stat /= nf90_noerr) goto 900
    value = buffer(1: attrlen)
    if (attrlen > len(value)) stat = gt_echarshort
  else if (xtype == nf90_char) then
    ! UNIDATA NetCDF ライブラリでは文字列引数の長さを
    ! まったく取得していないので先頭が結合していれば OK のはず
    allocate(cbuf(attrlen))
    stat = nf90_get_att(ent%fileid, varid, name(iname:), cbuf(1))
    if (stat /= nf90_noerr) goto 900
    do, i = 1, attrlen
      value(i:i) = cbuf(i)
    enddo
    if (attrlen < len(value)) value(attrlen + 1: ) = ' '
    if (attrlen > len(value)) stat = gt_echarshort
    deallocate(cbuf)
  else if (xtype == nf90_double .or. xtype == nf90_float) then
    allocate(dbuf(attrlen))
    stat = nf90_get_att(ent%fileid, varid, name(iname:), dbuf)
    if (stat /= nf90_noerr) goto 900
    value = tochar(dbuf)
    deallocate(dbuf)
  else
    allocate(ibuf(attrlen))
    stat = nf90_get_att(ent%fileid, varid, name(iname:), ibuf)
    if (stat /= nf90_noerr) goto 900
    value = tochar(ibuf)
    deallocate(ibuf)
  endif
  call endsub(subname)
  return
  ! デフォルト処理
900 continue
  value = default
  call endsub(subname, "value := default")
  return
end subroutine gdncattrgetchar