gdncattrgetnum.f90

Go to the documentation of this file.

! -*- coding: utf-8; mode: f90 -*-
!-------------------------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-------------------------------------------------------------------------------------
!
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
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
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