gtvargetattr.f90

Go to the documentation of this file.

!> @file gtvargetattr.f90
!>
!> @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 Numeric attribute input
!>
!> These subroutines are provided through gtdata_generic.
!> Various type variants exist but use the same underlying structure.
!> @enden
!>
!> @ja
!> @brief 数値型属性の入力
!>
!> これらのサブルーチンは gtdata_generic から提供されます。
!> 引数の型に応じて様々なバリアントがありますが、下部構造では同じものを使用しています。
!> @endja
!>
 
!>
!> @en
!> @brief Get attribute value (integer scalar)
!>
!> Returns the value of attribute attrname attached to variable var.
!> Get_Attr is a generic name for multiple subroutines, so value
!> can accept various types of variables (including pointers).
!>
!> If the attribute value cannot be retrieved normally and default
!> is provided, that value is returned. Default values when default
!> is not provided are:
!> - character: "" (empty string)
!> - real: NF90_FILL_REAL
!> - real(DP): NF90_FILL_DOUBLE
!> - integer: NF90_FILL_INT
!>
!> When value is a pointer, it is automatically allocated according
!> to the attribute value. Always pass it in a null state.
!>
!> When value is a fixed-length array, default is required because
!> Fortran language specifications require different interfaces
!> for pointer and non-pointer forms.
!> @param[in]  var      Variable handle
!> @param[in]  attrname Attribute name
!> @param[out] value    Attribute value (integer)
!> @param[in]  default  Default value (optional)
!> @enden
!>
!> @ja
!> @brief 属性値の取得 (整数スカラ)
!>
!> 変数 var に付加されている属性 attrname の値を返します。
!> Get_Attr は複数のサブルーチンの総称名なので、
!> value には様々な型の変数 (ポインタも可能) を与えることが可能です。
!>
!> 属性の値が正常に取得できず、且つ default が与えられていた場合、
!> その値が返ります。default が与えられない場合のデフォルトの値は
!> それぞれ以下の通りです。
!> - character: "" (空文字)
!> - real: NF90_FILL_REAL
!> - real(DP): NF90_FILL_DOUBLE
!> - integer: NF90_FILL_INT
!>
!> value にポインタを与えた場合、属性の値に応じて自動的に
!> 割り付けが行われます。そのため、必ず空状態にしてから与えてください。
!>
!> value に固定長配列を用意する場合 default が必須になりますが、
!> これは Fortran の言語仕様上ポインタ方式と引用仕様が同じであってはならないためです。
!> @param[in]  var      変数ハンドル
!> @param[in]  attrname 属性名
!> @param[out] value    属性値 (整数)
!> @param[in]  default  デフォルト値 (省略可能)
!> @endja
!>
subroutine gtvargetattri(var, attrname, value, default)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use netcdf, only: nf90_fill_int
  use dc_error, only: gt_enotvar, storeerror
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: attrname
  integer, intent(out):: value
  integer, intent(in), optional:: default
  integer:: stat, buffer(1), class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(gd_nc_variable(cid), attrname, buffer, stat, default)
    if (stat >= 1) then
      value = buffer(1)
      return
    end if
  else
    call storeerror(gt_enotvar, "GTVarGetAttrI")
  endif
  value = nf90_fill_int
  if (present(default)) value = default
end subroutine gtvargetattri
 
!> @en
!> @brief Get attribute value (real scalar)
!> @param[in]  var      Variable handle
!> @param[in]  attrname Attribute name
!> @param[out] value    Attribute value (real)
!> @param[in]  default  Default value (optional)
!> @enden
!> @ja
!> @brief 属性値の取得 (実数スカラ)
!> @param[in]  var      変数ハンドル
!> @param[in]  attrname 属性名
!> @param[out] value    属性値 (実数)
!> @param[in]  default  デフォルト値 (省略可能)
!> @endja
subroutine gtvargetattrr(var, attrname, value, default)
  use gtdata_types, only: gt_variable
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf
  use dc_error, only: gt_ebadvar, storeerror
  use netcdf, only: nf90_fill_float
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: attrname
  real, intent(out):: value
  real, intent(in), optional:: default
  integer:: stat
  real:: buffer(1)
  integer:: class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(gd_nc_variable(cid), attrname, value=buffer, &
      & stat=stat, default=default)
    if (stat >= 1) then
      value = buffer(1)
      return
    endif
  else
    call storeerror(gt_ebadvar, "GTVarGetAttrR")
  endif
  if (present(default)) then
    value = default
  else
    value = nf90_fill_float
  endif
end subroutine gtvargetattrr
 
!> @en
!> @brief Get attribute value (double precision scalar)
!> @param[in]  var      Variable handle
!> @param[in]  attrname Attribute name
!> @param[out] value    Attribute value (double precision)
!> @param[in]  default  Default value (optional)
!> @enden
!> @ja
!> @brief 属性値の取得 (倍精度実数スカラ)
!> @param[in]  var      変数ハンドル
!> @param[in]  attrname 属性名
!> @param[out] value    属性値 (倍精度実数)
!> @param[in]  default  デフォルト値 (省略可能)
!> @endja
subroutine gtvargetattrd(var, attrname, value, default)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error, only: gt_enotvar, storeerror
  use dc_types, only: dp
  use netcdf, only: nf90_fill_double
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: attrname
  real(DP), intent(out):: value
  real(DP), intent(in), optional:: default
  integer:: stat
  real(DP):: buffer(1)
  integer:: class, cid
continue
  call var_class(var, class, cid)
  select case(class)
  case (vtb_class_netcdf)
    call get_attr(gd_nc_variable(cid), attrname, value=buffer, &
      & stat=stat, default=default)
    if (stat >= 1) then
      value = buffer(1)
      return
    end if
  case default
    call storeerror(gt_enotvar, "GTVarGetAttrR")
  end select
  value = nf90_fill_double
  if (present(default)) value = default
end subroutine
 
!> @en
!> @brief Get attribute value (integer pointer array)
!>
!> When receiving with a pointer array, entities are allocated
!> for as many interpretable values as exist.
!> @param[in]  var   Variable handle
!> @param[in]  name  Attribute name
!> @param[out] value Attribute value (integer pointer)
!> @enden
!> @ja
!> @brief 属性値の取得 (整数ポインタ配列)
!>
!> ポインタ配列を使って受け取る場合は解釈可能な数だけ実体が割り付けられます。
!> @param[in]  var   変数ハンドル
!> @param[in]  name  属性名
!> @param[out] value 属性値 (整数ポインタ)
!> @endja
subroutine gtvargetattrip(var, name, value)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error, only: gt_enotvar, storeerror
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  integer, pointer:: value(:) !(out)
  integer:: stat, class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    allocate(value(1))
    call get_attr(gd_nc_variable(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(gd_nc_variable(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else
    call storeerror(gt_enotvar, "GTVarGetAttrIP")
  endif
end subroutine gtvargetattrip
 
!> @en
!> @brief Get attribute value (real pointer array)
!> @param[in]  var   Variable handle
!> @param[in]  name  Attribute name
!> @param[out] value Attribute value (real pointer)
!> @enden
!> @ja
!> @brief 属性値の取得 (実数ポインタ配列)
!> @param[in]  var   変数ハンドル
!> @param[in]  name  属性名
!> @param[out] value 属性値 (実数ポインタ)
!> @endja
subroutine gtvargetattrrp(var, name, value)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error, only: gt_enotvar, storeerror
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  real, pointer:: value(:) !(out)
  integer:: stat, class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    allocate(value(1))
    call get_attr(gd_nc_variable(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(gd_nc_variable(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else
    nullify(value)
    call storeerror(gt_enotvar, "GTVarGetAttrRP")
  endif
end subroutine gtvargetattrrp
 
!> @en
!> @brief Get attribute value (double precision pointer array)
!> @param[in]  var   Variable handle
!> @param[in]  name  Attribute name
!> @param[out] value Attribute value (double precision pointer)
!> @enden
!> @ja
!> @brief 属性値の取得 (倍精度実数ポインタ配列)
!> @param[in]  var   変数ハンドル
!> @param[in]  name  属性名
!> @param[out] value 属性値 (倍精度実数ポインタ)
!> @endja
subroutine gtvargetattrdp(var, name, value)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_types, only: dp
  use dc_error, only: gt_enotvar, storeerror
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  real(DP), pointer:: value(:) !(out)
  integer:: stat, class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    allocate(value(1))
    call get_attr(gd_nc_variable(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(gd_nc_variable(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else
    call storeerror(gt_enotvar, "GTVarGetAttrRP")
  endif
end subroutine gtvargetattrdp
 
!> @en
!> @brief Get attribute value (integer fixed-length array)
!>
!> When receiving as a fixed-length array, excess attribute values
!> are truncated. When attribute length is insufficient, default
!> values fill the remainder (default is required unlike pointer form).
!> @param[in]  var     Variable handle
!> @param[in]  name    Attribute name
!> @param[out] value   Attribute value (integer array)
!> @param[in]  default Default fill value
!> @enden
!> @ja
!> @brief 属性値の取得 (整数固定長配列)
!>
!> 固定長配列として受け取る場合は属性長があまっている場合には切り捨てられ、
!> 属性長が足りない場合は default 値 (ポインタと違い必須) を埋めます。
!> @param[in]  var     変数ハンドル
!> @param[in]  name    属性名
!> @param[out] value   属性値 (整数配列)
!> @param[in]  default デフォルト充填値
!> @endja
subroutine gtvargetattria(var, name, value, default)
  use gtdata_types, only: gt_variable
  use gtdata_generic, only: friend => get_attr
  use gtdata_internal_map, only: var_class, vtb_class_netcdf
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error, only: gt_enotvar, storeerror
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  integer, intent(out):: value(:)
  integer, intent(in):: default
  integer:: stat, class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(gd_nc_variable(cid), name, value, stat, default)
  else
    call storeerror(gt_enotvar, "GTVarGetAttrIA")
  endif
end subroutine gtvargetattria
 
!> @en
!> @brief Get attribute value (real fixed-length array)
!> @param[in]  var     Variable handle
!> @param[in]  name    Attribute name
!> @param[out] value   Attribute value (real array)
!> @param[in]  default Default fill value
!> @enden
!> @ja
!> @brief 属性値の取得 (実数固定長配列)
!> @param[in]  var     変数ハンドル
!> @param[in]  name    属性名
!> @param[out] value   属性値 (実数配列)
!> @param[in]  default デフォルト充填値
!> @endja
subroutine gtvargetattrra(var, name, value, default)
  use gtdata_types, only: gt_variable
  use gtdata_generic, only: friend => get_attr
  use gtdata_internal_map, only: var_class, vtb_class_netcdf
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error, only: gt_enotvar, storeerror
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  real, intent(out):: value(:)
  real, intent(in):: default
  integer:: class, cid, stat
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(gd_nc_variable(cid), name, value, stat, default)
  else
    call storeerror(gt_enotvar, "GTVarGetAttrRA")
  endif
end subroutine gtvargetattrra
 
!> @en
!> @brief Get attribute value (double precision fixed-length array)
!> @param[in]  var     Variable handle
!> @param[in]  name    Attribute name
!> @param[out] value   Attribute value (double precision array)
!> @param[in]  default Default fill value
!> @enden
!> @ja
!> @brief 属性値の取得 (倍精度実数固定長配列)
!> @param[in]  var     変数ハンドル
!> @param[in]  name    属性名
!> @param[out] value   属性値 (倍精度実数配列)
!> @param[in]  default デフォルト充填値
!> @endja
subroutine gtvargetattrda(var, name, value, default)
  use gtdata_types, only: gt_variable
  use gtdata_generic, only: friend => get_attr
  use gtdata_internal_map, only: var_class, vtb_class_netcdf
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_types, only: dp
  use dc_error, only: gt_enotvar, storeerror
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  real(DP), intent(out):: value(:)
  real(DP), intent(in):: default
  integer:: stat, class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(gd_nc_variable(cid), name, value, stat, default)
  else
    call storeerror(gt_enotvar, "GTVarGetAttrRA")
  endif
end subroutine gtvargetattrda