gdncvarinquire.f90

Go to the documentation of this file.

!> @file gdncvarinquire.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 Inquire variable or attribute information
!>
!> These subroutines and functions are provided as gtdata_netcdf_generic#Inquire
!> through gtdata_netcdf_generic.
!> @enden
!>
!> @ja
!> @brief 変数または属性に関する問い合わせ
!>
!> これらのサブルーチン、関数は gtdata_netcdf_generic から
!> gtdata_netcdf_generic#Inquire として提供されます。
!> @endja
!>
 
!>
!> @en
!> @brief Inquire variable information
!>
!> Retrieves various information about a variable. Each output argument
!> is optional and only computed if provided.
!> @enden
!>
!> @ja
!> @brief 変数情報を問い合わせ
!>
!> 変数に関する様々な情報を取得します。各出力引数は省略可能で、
!> 与えられた場合のみ計算されます。
!> @endja
!>
!> @param[in]  var      @en Variable handle @enden @ja 変数ハンドル @endja
!> @param[out] ndims    @en Number of dimensions (optional) @enden
!>                      @ja 次元数 (省略可能) @endja
!> @param[out] dimlen   @en Total dimension length (optional) @enden
!>                      @ja 全次元長 (省略可能) @endja
!> @param[out] growable @en Has unlimited dimension (optional) @enden
!>                      @ja 無制限次元を持つか (省略可能) @endja
!> @param[out] name     @en Variable name (optional) @enden
!>                      @ja 変数名 (省略可能) @endja
!> @param[out] url      @en Full URL including filename (optional) @enden
!>                      @ja ファイル名を含む完全 URL (省略可能) @endja
!> @param[out] xtype    @en Type name (optional) @enden
!>                      @ja 型名 (省略可能) @endja
!>
subroutine gdncvarinquire(var, ndims, dimlen, growable, name, url, xtype)
  use gtdata_netcdf_types, only: gd_nc_variable, gd_nc_variable_entry
  use gtdata_netcdf_file_generic, only: gdncfileinquire
  use gtdata_netcdf_internal, only: vtable_lookup
  use gtdata_netcdf_generic, only: gdncxtypename
  use dc_trace, only: beginsub, endsub, dbgmessage
  use netcdf, only: nf90_noerr, nf90_max_name, &
    & nf90_inquire_variable, nf90_inquire_dimension, nf90_inquire
  implicit none
  type(gd_nc_variable), intent(in):: var
  integer, intent(out), optional:: ndims
  integer, intent(out), optional:: dimlen
  logical, intent(out), optional:: growable
  character(*), intent(out), optional:: name
  character(*), intent(out), optional:: url
  character(*), intent(out), optional:: xtype
 
  ! 内部変数
  type(gd_nc_variable_entry):: ent
  integer:: stat, length, i, i_xtype, idim_growable
  character(len = *), parameter:: subname = 'GDNcVarInquire'
  character(len = NF90_MAX_NAME):: buffer
  character(len = NF90_MAX_NAME):: fbuffer
continue
  call beginsub(subname, 'var.id=%d', i=(/var%id/))
 
  ! フェイルセーフ用にエラー値をまず入れる
  if (present(ndims)) ndims = -1
  if (present(dimlen)) dimlen = -1
 
  ! 変数実体の探索
  stat = vtable_lookup(var, ent)
  if (stat /= nf90_noerr) then
    call endsub(subname, 'var not found')
    return
  endif
 
  ! 各引数が与えられている場合について値を取得する動作を
 
  if (present(ndims)) then
    if (associated(ent%dimids)) then
      ndims = size(ent%dimids)
    else
      ndims = 0
    endif
  endif
 
  if (present(dimlen)) then
    dimlen = 1
    if (ent%dimid > 0) then
      ! 実体に次元としての問い合わせが可能な場合
      stat = nf90_inquire_dimension(ent%fileid, ent%dimid, len = dimlen)
      if (stat /= nf90_noerr) then
        dimlen = -1
        call endsub(subname, 'dimlen err')
        return
      endif
    else
      ! 実体が変数として問い合わせるしかない場合
      if (associated(ent%dimids)) then
        do, i = 1, size(ent%dimids)
          stat = nf90_inquire_dimension(ent%fileid, ent%dimids(i), len = length)
          if (stat /= nf90_noerr) then
            dimlen = -1
            exit
          endif
          dimlen = dimlen * length
        enddo
      endif
    endif
  endif
 
  if (present(xtype)) then
    stat = nf90_inquire_variable(ent%fileid, ent%varid, xtype=i_xtype)
    if (stat /= nf90_noerr) i_xtype = 0
    call gdncxtypename(i_xtype, xtype)
  endif
 
  if (present(name)) then
    call local_getname(ent, buffer)
    name = buffer
  endif
 
  if (present(url)) then
    call local_getname(ent, buffer)
    call dbgmessage('ent%%fileid=%d', i=(/ent%fileid/))
    call gdncfileinquire(ent%fileid, name=fbuffer)
    url = trim(fbuffer) // '?' // buffer
  endif
 
  if (present(growable)) then
    growable = .false.
    stat = vtable_lookup(var, ent)
    if (stat /= nf90_noerr) return
    stat = nf90_inquire(ent%fileid, unlimiteddimid = idim_growable)
    if (stat /= nf90_noerr) return
 
    if (ent%varid > 0) then
      if (.not. associated(ent%dimids)) return
      do, i = 1, size(ent%dimids)
        if (ent%dimids(i) == idim_growable) growable = .true.
      enddo
    else
      growable = (ent%dimid == idim_growable)
    endif
  endif
 
  ! 安全に終った
  call endsub(subname, 'ok')
  return
 
contains
 
  subroutine local_getname(ent, varname)
    use netcdf, only: &
      & nf90_inquire_dimension, nf90_inquire_variable, nf90_noerr
    type(gd_nc_variable_entry), intent(in):: ent
    character(len = *), intent(out):: varname
    if (ent%dimid > 0) then
      stat = nf90_inquire_dimension(ent%fileid, ent%dimid, name = varname)
    else
      stat = nf90_inquire_variable(ent%fileid, ent%varid, name = varname)
    endif
    if (stat /= nf90_noerr) varname = ""
  end subroutine local_getname
 
end subroutine gdncvarinquire