gdncvarattrtrue.f90

Go to the documentation of this file.

!> @file gdncvarattrtrue.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 logical (boolean) attribute value
!> @enden
!>
!> @ja
!> @brief 論理 (真偽値) 属性の取得
!> @endja
!>
 
!>
!> @en
!> @brief Get attribute value as logical
!>
!> Interprets an attribute value as a boolean. The following are interpreted
!> as false (case-insensitive):
!> - Numeric: 0, 0.0
!> - String: "0", "0.0", ".0", "0.", "0.0D0", "FALSE", ".FALSE.", "F"
!>
!> All other values are interpreted as true.
!> @enden
!>
!> @ja
!> @brief 属性値を論理値として取得
!>
!> 属性値を真偽値として解釈します。以下は偽として解釈されます (大文字小文字無視):
!> - 数値: 0, 0.0
!> - 文字列: "0", "0.0", ".0", "0.", "0.0D0", "FALSE", ".FALSE.", "F"
!>
!> それ以外の値は全て真として解釈されます。
!> @endja
!>
!> @param[in]  var     @en Variable handle @enden @ja 変数ハンドル @endja
!> @param[in]  name    @en Attribute name @enden @ja 属性名 @endja
!> @param[out] value   @en Logical result @enden @ja 論理値結果 @endja
!> @param[in]  default @en Default value if attribute not found (optional) @enden
!>                     @ja 属性未検出時のデフォルト値 (省略可能) @endja
!>
subroutine gdncvargetattrlogical(var, name, value, default)
 
  use gtdata_netcdf_types, only: gd_nc_variable, gd_nc_variable_entry
  use gtdata_netcdf_internal, only: vtable_lookup
  use gtdata_netcdf_generic, only: get_attr, inquireplus
  use dc_types, only: string
  use netcdf, only: nf90_max_name, nf90_noerr, nf90_char, nf90_inquire_attribute, nf90_get_att
  use dc_error
  use dc_string
  implicit none
  type(gd_nc_variable), intent(in):: var
  character(len = *), intent(in):: name
  logical, intent(out):: value
  logical, intent(in), optional:: default
  type(gd_nc_variable_entry):: ent
  character(len = STRING):: cbuffer
  character(len = 7):: c_default
  character(len = NF90_MAX_NAME):: aname
  real, allocatable:: rbuf(:)
  integer:: stat, xtype, attrlen
  integer:: varid
  stat = vtable_lookup(var, ent)
  if (stat /= nf90_noerr) goto 999
  ! 大域属性サポート
  call inquireplus(var, name, &
    & varid=varid, nf_attrname=aname)
  stat = nf90_inquire_attribute(ent%fileid, varid, aname, xtype=xtype, len=attrlen)
  if (stat /= nf90_noerr) goto 999
  if (xtype == nf90_char) then
    c_default = "0"
    if (present(default)) then
      if (default) c_default = "1"
    endif
    call get_attr(var, name, cbuffer, c_default, stat)
    ! もうちょっとましな方法があるべきだが。
    select case(cbuffer)
    case("", "0", "0.0", "0.", ".0", "FALSE", "false", ".FALSE.", &
      & ".false.", "F", "f", "0.0D0", "0.0d0")
      value = .false.
    case default
      value = .true.
    end select
  else
    allocate(rbuf(attrlen))
    stat = nf90_get_att(ent%fileid, varid, aname, rbuf)
    if (stat /= nf90_noerr) goto 999
    value = (abs(rbuf(1)) > tiny(0.0))
  endif
  return
 
999 continue
  value = .false.
  if (present(default)) value = default
end subroutine gdncvargetattrlogical