gdncattrgetnum.f90

Go to the documentation of this file.

! -*- coding: utf-8; mode: f90 -*-
!-------------------------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-------------------------------------------------------------------------------------
!> @file gdncattrgetnum.erb
!>
!> @attention
!> This file is generated from ../../../../../src/gtdata/gtdata_netcdf/gdncattrgetnum.erb by ERB included Ruby 3.3.8.
!> Please do not edit this file directly.
!>
!> @author Eizi TOYODA, Yasuhiro MORIKAWA
!> @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 numeric attributes from netCDF variables
!>
!> Low-level interface for reading numeric attributes without precision loss.
!>
!> Return status interpretation:
!> | stat value | Meaning |
!> |------------|---------|
!> | stat < 0 | Error, or the attribute does not exist |
!> | stat = 0 ... size(value) | Attribute fully read, size is stat elements |
!> | stat > size(value) | Array too short, stat elements are required |
!>
!> @note If the attribute is character type and exceeds STRING characters,
!>       GT_ECHARSHORT is returned.
!> @enden
!>
!> @ja
!> @brief netCDF 変数から数値属性を取得
!>
!> 情報落ちのない低レベルインターフェイス。
!>
!> 戻り値 stat の解釈:
!> | stat の値 | 意味 |
!> |-----------|------|
!> | stat < 0 | エラー、あるいはその属性は存在しなかった |
!> | stat = 0 ... size(value) | その属性を全部読み取った。サイズは stat 個 |
!> | stat > size(value) | 配列長不足のため属性が全部読み取れなかった。stat 個必要 |
!>
!> @note 属性が文字型で STRING 文字を越える場合、GT_ECHARSHORT が返る
!> @endja
!>
!
!>
!> @en
!> @brief Get numeric attribute value (int type)
!>
!> Retrieves a numeric attribute from a netCDF variable.
!> @enden
!>
!> @ja
!> @brief 数値属性の取得 (int 型)
!>
!> netCDF 変数から数値属性を取得します。
!> @endja
!>
!> @param[in]  var     @en Variable handle @enden @ja 変数ハンドル @endja
!> @param[in]  name    @en Attribute name @enden @ja 属性名 @endja
!> @param[out] value   @en Array to store attribute values @enden @ja 属性値を格納する配列 @endja
!> @param[out] stat    @en Status (see file header for interpretation) @enden @ja ステータス (解釈はファイルヘッダ参照) @endja
!> @param[in]  default @en Default value if attribute not found (optional) @enden @ja 属性未検出時のデフォルト値 (省略可能) @endja
!>
subroutine gdncattrgetint(var, name, value, stat, default)
  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_char, &
    & nf90_enomem, &
    & nf90_inquire_attribute, &
    & nf90_get_att
  use dc_url,     only: gt_plus
  use gtdata_netcdf_generic, only: get_attr
  use dc_types,   only: string
  use dc_string
  implicit none
  type(gd_nc_variable),       intent(in) :: var
  character(len = *),      intent(in) :: name
  integer,            intent(out):: stat
  integer, intent(out):: value(:)
  integer,  intent(in), optional:: default
  integer,  allocatable:: rbuffer(:)
  character(STRING)      :: cbuffer
  character(STRING), pointer :: lbuffer(:)
  integer           :: attrlen, xtype, i, xferend, iname, varid
  type(gd_nc_variable_entry):: ent
  continue
  stat = vtable_lookup(var, ent)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 型と長さを取得
  if (name(1:1) == gt_plus) then
    iname = 2
    varid = nf90_global
  else
    iname = 1
    varid = ent%varid
  endif
  stat = nf90_inquire_attribute(ent%fileid, varid, &
    name = name(iname:), xtype = xtype, len = attrlen)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 文字型の場合は長さをコンマで分解した語数と読み替える
  if (xtype == nf90_char) then
    call get_attr(var, name, cbuffer, "", stat)
    if (stat /= 0) return
    call split(cbuffer, lbuffer, ", ")
    attrlen = size(lbuffer)
  endif
  ! 結果を入れるところがなければ長さだけを伝え終了
  if (size(value) == 0) then
    if (xtype == nf90_char) deallocate(lbuffer)
    stat = attrlen
    return
  endif
  ! 型に応じて要求されただけ値を転送
  xferend = min(size(value), attrlen)
  if (present(default)) value(xferend+1: ) = default
  if (xtype == nf90_char) then
    do, i = 1, xferend
      value(i) = stoi(lbuffer(i))
    enddo
    deallocate(lbuffer)
    stat = attrlen
    return
  else
    allocate(rbuffer(attrlen), stat=stat)
    if (stat /= 0) then
      stat = nf90_enomem
      return
    endif
    stat = nf90_get_att(ent%fileid, varid, name(iname:), rbuffer)
    if (stat == nf90_noerr) then
      value(1:xferend) = rbuffer(1:xferend)
      stat = attrlen
    endif
    deallocate(rbuffer)
    return
  endif
end subroutine gdncattrgetint
!>
!> @en
!> @brief Get numeric attribute value (real type)
!>
!> Retrieves a numeric attribute from a netCDF variable.
!> @enden
!>
!> @ja
!> @brief 数値属性の取得 (real 型)
!>
!> netCDF 変数から数値属性を取得します。
!> @endja
!>
!> @param[in]  var     @en Variable handle @enden @ja 変数ハンドル @endja
!> @param[in]  name    @en Attribute name @enden @ja 属性名 @endja
!> @param[out] value   @en Array to store attribute values @enden @ja 属性値を格納する配列 @endja
!> @param[out] stat    @en Status (see file header for interpretation) @enden @ja ステータス (解釈はファイルヘッダ参照) @endja
!> @param[in]  default @en Default value if attribute not found (optional) @enden @ja 属性未検出時のデフォルト値 (省略可能) @endja
!>
subroutine gdncattrgetreal(var, name, value, stat, default)
  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_char, &
    & nf90_enomem, &
    & nf90_inquire_attribute, &
    & nf90_get_att
  use dc_url,     only: gt_plus
  use gtdata_netcdf_generic, only: get_attr
  use dc_types,   only: string, sp
  use dc_string
  implicit none
  type(gd_nc_variable),       intent(in) :: var
  character(len = *),      intent(in) :: name
  integer,            intent(out):: stat
  real(SP), intent(out):: value(:)
  real(SP),  intent(in), optional:: default
  real(SP),  allocatable:: rbuffer(:)
  character(STRING)      :: cbuffer
  character(STRING), pointer :: lbuffer(:)
  integer           :: attrlen, xtype, i, xferend, iname, varid
  type(gd_nc_variable_entry):: ent
  continue
  stat = vtable_lookup(var, ent)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 型と長さを取得
  if (name(1:1) == gt_plus) then
    iname = 2
    varid = nf90_global
  else
    iname = 1
    varid = ent%varid
  endif
  stat = nf90_inquire_attribute(ent%fileid, varid, &
    name = name(iname:), xtype = xtype, len = attrlen)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 文字型の場合は長さをコンマで分解した語数と読み替える
  if (xtype == nf90_char) then
    call get_attr(var, name, cbuffer, "", stat)
    if (stat /= 0) return
    call split(cbuffer, lbuffer, ", ")
    attrlen = size(lbuffer)
  endif
  ! 結果を入れるところがなければ長さだけを伝え終了
  if (size(value) == 0) then
    if (xtype == nf90_char) deallocate(lbuffer)
    stat = attrlen
    return
  endif
  ! 型に応じて要求されただけ値を転送
  xferend = min(size(value), attrlen)
  if (present(default)) value(xferend+1: ) = default
  if (xtype == nf90_char) then
    do, i = 1, xferend
      value(i) = real(stod(lbuffer(i)), kind=kind(value(i)))
    enddo
    deallocate(lbuffer)
    stat = attrlen
    return
  else
    allocate(rbuffer(attrlen), stat=stat)
    if (stat /= 0) then
      stat = nf90_enomem
      return
    endif
    stat = nf90_get_att(ent%fileid, varid, name(iname:), rbuffer)
    if (stat == nf90_noerr) then
      value(1:xferend) = rbuffer(1:xferend)
      stat = attrlen
    endif
    deallocate(rbuffer)
    return
  endif
end subroutine gdncattrgetreal
!>
!> @en
!> @brief Get numeric attribute value (double type)
!>
!> Retrieves a numeric attribute from a netCDF variable.
!> @enden
!>
!> @ja
!> @brief 数値属性の取得 (double 型)
!>
!> netCDF 変数から数値属性を取得します。
!> @endja
!>
!> @param[in]  var     @en Variable handle @enden @ja 変数ハンドル @endja
!> @param[in]  name    @en Attribute name @enden @ja 属性名 @endja
!> @param[out] value   @en Array to store attribute values @enden @ja 属性値を格納する配列 @endja
!> @param[out] stat    @en Status (see file header for interpretation) @enden @ja ステータス (解釈はファイルヘッダ参照) @endja
!> @param[in]  default @en Default value if attribute not found (optional) @enden @ja 属性未検出時のデフォルト値 (省略可能) @endja
!>
subroutine gdncattrgetdouble(var, name, value, stat, default)
  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_char, &
    & nf90_enomem, &
    & nf90_inquire_attribute, &
    & nf90_get_att
  use dc_url,     only: gt_plus
  use gtdata_netcdf_generic, only: get_attr
  use dc_types,   only: string, dp
  use dc_string
  implicit none
  type(gd_nc_variable),       intent(in) :: var
  character(len = *),      intent(in) :: name
  integer,            intent(out):: stat
  real(DP), intent(out):: value(:)
  real(DP),  intent(in), optional:: default
  real(DP),  allocatable:: rbuffer(:)
  character(STRING)      :: cbuffer
  character(STRING), pointer :: lbuffer(:)
  integer           :: attrlen, xtype, i, xferend, iname, varid
  type(gd_nc_variable_entry):: ent
  continue
  stat = vtable_lookup(var, ent)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 型と長さを取得
  if (name(1:1) == gt_plus) then
    iname = 2
    varid = nf90_global
  else
    iname = 1
    varid = ent%varid
  endif
  stat = nf90_inquire_attribute(ent%fileid, varid, &
    name = name(iname:), xtype = xtype, len = attrlen)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 文字型の場合は長さをコンマで分解した語数と読み替える
  if (xtype == nf90_char) then
    call get_attr(var, name, cbuffer, "", stat)
    if (stat /= 0) return
    call split(cbuffer, lbuffer, ", ")
    attrlen = size(lbuffer)
  endif
  ! 結果を入れるところがなければ長さだけを伝え終了
  if (size(value) == 0) then
    if (xtype == nf90_char) deallocate(lbuffer)
    stat = attrlen
    return
  endif
  ! 型に応じて要求されただけ値を転送
  xferend = min(size(value), attrlen)
  if (present(default)) value(xferend+1: ) = default
  if (xtype == nf90_char) then
    do, i = 1, xferend
      value(i) = stod(lbuffer(i))
    enddo
    deallocate(lbuffer)
    stat = attrlen
    return
  else
    allocate(rbuffer(attrlen), stat=stat)
    if (stat /= 0) then
      stat = nf90_enomem
      return
    endif
    stat = nf90_get_att(ent%fileid, varid, name(iname:), rbuffer)
    if (stat == nf90_noerr) then
      value(1:xferend) = rbuffer(1:xferend)
      stat = attrlen
    endif
    deallocate(rbuffer)
    return
  endif
end subroutine gdncattrgetdouble