gtdata_internal_vartable.f90

Go to the documentation of this file.

!> @file gtdata_internal_vartable.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 Internal variable table module
!>
!> @private
!> This module should not be used directly by users.
!> @enden
!>
!> @ja
!> @brief 内部変数テーブルモジュール
!>
!> @private
!> このモジュールはユーザが直接使用すべきではありません。
!> @endja
!>
 
!>
!> @en
!> @brief gtool variable table management
!>
!> @private
!> This module is not directly referenced from the gtool module,
!> therefore naming conventions are quite flexible. Users must not call this.
!>
!> A gtool variable is actually just a handle and multi-dimensional iterator,
!> where the handle is a small integer value.
!> To access the actual entity, first lookup the map table using the handle value,
!> then lookup the variable table using the vid obtained there to get
!> the class and class-specific variable number. This is at most
!> pointer + offset reference cost.
!> While gtool variables create as many iterators as needed from entity variables,
!> this variable table creates only one entry per entity variable, so it has a reference count.
!> This eliminates the need for entity variables to manage reference counts.
!> @enden
!>
!> @ja
!> @brief gtool 変数表管理
!>
!> @private
!> このモジュールは gtool モジュールから直接には引用されないため、
!> 相当むちゃな名前の使い方をしている。ユーザは呼んではならない。
!>
!> gtool 変数というのは実は単なるハンドルと多次元イテレータであり、
!> ハンドルは小さな整数値である。
!> 実体にアクセスするためには、ハンドル値をキーにしてまずマップ表を引き、
!> そこで得られた vid をキーにして変数表を引いて、
!> 種別と種別ごとの変数番号を得る。これらはたかだかポインタ＋オフセット
!> 参照程度のコストである。
!> gtool 変数は実体変数からイテレータが必要なだけ作成されるが、
!> この変数表は実体変数につき１エントリしか作成しないので、参照数を持つ。
!> このため、実体変数は変数に付いて参照数管理をしなくてもよくなる。
!> @endja
!>
module gtdata_internal_vartable
 
  use gtdata_netcdf_types, only: gd_nc_variable_search
  use dc_types, only: string
  implicit none
  private
 
  integer, parameter, public :: vid_invalid = -1
 
  integer, parameter, public :: vtb_class_unused = 0
  integer, parameter, public :: vtb_class_netcdf = 1
  integer, parameter, public :: classes_max = 2
 
  type var_table_entry
    integer:: class
    integer:: cid
    integer:: refcount
  end type var_table_entry
 
  type(var_table_entry), save, allocatable:: table(:)
  integer, parameter:: table_ini_size = 16
 
  type(gd_nc_variable_search), public, save:: gdnc_search
 
  public:: vartableadd, vartabledelete, vartablemore, vartablelookup
  public:: vartable_dump
  public:: dimrange, ndims, query_growable
  private:: var_table_entry, table, table_ini_size
  private:: entry_cleanup
 
  interface dimrange
    module procedure dimrange_direct
  end interface
 
contains
 
  !>
  !> @en
  !> @brief Dump variable table entry for debugging
  !> @param[in] vid Variable ID to dump
  !> @enden
  !>
  !> @ja
  !> @brief デバッグ用変数テーブルエントリのダンプ
  !> @param[in] vid ダンプする変数ID
  !> @endja
  !>
  subroutine vartable_dump(vid)
    use dc_trace, only: dbgmessage
    use gtdata_netcdf_generic, only: tostring
    use gtdata_netcdf_types, only: gd_nc_variable
    integer, intent(in):: vid
    character(10):: class
    if (.not. allocated(table)) return
    if (vid <= 0 .or. vid > size(table)) return
    select case(table(vid)%class)
    case(vtb_class_netcdf)
      class = 'netcdf'
    case default
      write(class, fmt="(i10)") table(vid)%class
    end select
    call dbgmessage('[vartable %d: class=%c cid=%d ref=%d]', &
      & i=(/vid, table(vid)%cid, table(vid)%refcount/), &
      & c1=trim(class))
    select case(table(vid)%class)
    case(vtb_class_netcdf)
      call dbgmessage('[%c]', c1=trim(tostring(gd_nc_variable(table(vid)%cid))))
    end select
  end subroutine vartable_dump
 
  !>
  !> @en
  !> @brief Initialize variable table entries to unused state
  !> @param[out] vtb_entry Array of table entries to initialize
  !> @enden
  !>
  !> @ja
  !> @brief 変数テーブルエントリを未使用状態に初期化
  !> @param[out] vtb_entry 初期化するテーブルエントリ配列
  !> @endja
  !>
  subroutine entry_cleanup(vtb_entry)
    type(var_table_entry), intent(out):: vtb_entry(:)
    vtb_entry(:)%class = vtb_class_unused
    vtb_entry(:)%cid = -1
    vtb_entry(:)%refcount = 0
  end subroutine entry_cleanup
 
  !>
  !> @en
  !> @brief Add entry to variable table
  !>
  !> If an entry with the same class and cid already exists,
  !> increments its reference count. Otherwise, creates a new entry.
  !> @param[out] vid Assigned variable ID
  !> @param[in]  class Variable class (VTB_CLASS_NETCDF, etc.)
  !> @param[in]  cid   Class-specific ID
  !> @enden
  !>
  !> @ja
  !> @brief 変数テーブルにエントリを追加
  !>
  !> 同じ class と cid を持つエントリが既に存在する場合、
  !> その参照カウントを増加します。そうでなければ新しいエントリを作成します。
  !> @param[out] vid 割り当てられた変数ID
  !> @param[in]  class 変数クラス (VTB_CLASS_NETCDF 等)
  !> @param[in]  cid   クラス固有のID
  !> @endja
  !>
  subroutine vartableadd(vid, class, cid)
    use dc_trace, only: dbgmessage
    integer, intent(out):: vid
    integer, intent(in):: class, cid
    type(var_table_entry), allocatable:: tmp_table(:)
    integer:: n
  continue
    ! 必要ならば初期幅確保
    if (.not. allocated(table)) then
      allocate(table(table_ini_size))
      call entry_cleanup(table(:))
    endif
    ! 該当があれば参照数増加
    do, n = 1, size(table)
      if (table(n)%class == class .and. table(n)%cid == cid) then
        table(n)%refcount = table(n)%refcount + 1
        call dbgmessage('gtdata_vartable.add(class=%d cid=%d) found (ref=%d)', &
          & i=(/table(n)%class, table(n)%cid, table(n)%refcount/))
        vid = n
        return
      endif
    enddo
    ! もし空きが無ければ表を拡張
    if (all(table(:)%class /= vtb_class_unused)) then
      n = size(table)
      allocate(tmp_table(n))
      tmp_table(:) = table(:)
      deallocate(table)
      allocate(table(n * 2))
      table(1:n) = tmp_table(1:n)
      deallocate(tmp_table)
      table(n+1:n*2) = var_table_entry(vtb_class_unused, -1, 0)
    endif
    do, n = 1, size(table)
      if (table(n)%class == vtb_class_unused) then
        table(n)%class = class
        table(n)%cid = cid
        table(n)%refcount = 1
        vid = n
        return
      endif
    enddo
    vid = vid_invalid
  end subroutine vartableadd
 
  !>
  !> @en
  !> @brief Delete entry from variable table
  !>
  !> Decrements the reference count. When it reaches zero,
  !> action is set to .true. indicating actual deletion should occur.
  !> @param[in]  vid    Variable ID to delete
  !> @param[out] action .true. if actual deletion should be performed
  !> @param[out] err    Error flag (optional)
  !> @enden
  !>
  !> @ja
  !> @brief 変数テーブルからエントリを削除
  !>
  !> 参照カウントを減少させます。ゼロになった場合、
  !> 実際の削除を行うべきことを示すために action に .true. が設定されます。
  !> @param[in]  vid    削除する変数ID
  !> @param[out] action 実際の削除を行うべきかどうか
  !> @param[out] err    エラーフラグ (省略可能)
  !> @endja
  !>
  subroutine vartabledelete(vid, action, err)
    integer, intent(in):: vid
    logical, intent(out):: action
    logical, intent(out), optional:: err
    if (.not. allocated(table)) goto 999
    if (vid <= 0 .or. vid > size(table)) goto 999
    if (table(vid)%class <= vtb_class_unused) goto 999
    if (table(vid)%class > classes_max) goto 999
    table(vid)%refcount = max(table(vid)%refcount - 1, 0)
    action = (table(vid)%refcount == 0)
    if (present(err)) err = .false.
    return
999 continue
    action = .false.
    if (present(err)) err = .true.
  end subroutine vartabledelete
 
  !>
  !> @en
  !> @brief Look up variable table entry
  !>
  !> Returns the class and cid of the entry with the specified vid.
  !> @param[in]  vid   Variable ID to look up
  !> @param[out] class Variable class (optional)
  !> @param[out] cid   Class-specific ID (optional)
  !> @enden
  !>
  !> @ja
  !> @brief 変数テーブルエントリを検索
  !>
  !> 指定された vid を持つエントリの class と cid を返します。
  !> @param[in]  vid   検索する変数ID
  !> @param[out] class 変数クラス (省略可能)
  !> @param[out] cid   クラス固有のID (省略可能)
  !> @endja
  !>
  subroutine vartablelookup(vid, class, cid)
    integer, intent(in):: vid
    integer, intent(out), optional:: class, cid
    if (.not. allocated(table)) goto 999
    if (vid <= 0 .or. vid > size(table)) goto 999
    if (table(vid)%class <= vtb_class_unused) goto 999
    if (table(vid)%class > classes_max) goto 999
    if (present(class)) class = table(vid)%class
    if (present(cid)) cid = table(vid)%cid
    return
999 continue
    if (present(class)) class = vtb_class_unused
  end subroutine vartablelookup
 
  !>
  !> @en
  !> @brief Increment reference count of variable table entry
  !> @param[in]  vid Variable ID
  !> @param[out] err Error flag (optional)
  !> @enden
  !>
  !> @ja
  !> @brief 変数テーブルエントリの参照カウントを増加
  !> @param[in]  vid 変数ID
  !> @param[out] err エラーフラグ (省略可能)
  !> @endja
  !>
  subroutine vartablemore(vid, err)
    integer, intent(in):: vid
    logical, intent(out), optional:: err
    if (.not. allocated(table)) goto 999
    if (vid <= 0 .or. vid > size(table)) goto 999
    if (table(vid)%class <= vtb_class_unused) goto 999
    if (table(vid)%class > classes_max) goto 999
    table(vid)%refcount = table(vid)%refcount + 1
    if (present(err)) err = .false.
    return
999 continue
    if (present(err)) err = .true.
  end subroutine vartablemore
 
  !>
  !> @en
  !> @brief Get dimension range of variable
  !> @param[in]  vid   Variable ID
  !> @param[out] dimlo Lower bound of dimension (always 1)
  !> @param[out] dimhi Upper bound of dimension (total length)
  !> @enden
  !>
  !> @ja
  !> @brief 変数の次元範囲を取得
  !> @param[in]  vid   変数ID
  !> @param[out] dimlo 次元の下限 (常に1)
  !> @param[out] dimhi 次元の上限 (全長)
  !> @endja
  !>
  subroutine dimrange_direct(vid, dimlo, dimhi)
    use gtdata_netcdf_types, only: gd_nc_variable
    use gtdata_netcdf_generic, only: gdncinquire => inquire
    use dc_error, only: storeerror, nf90_einval
    integer, intent(in):: vid
    integer, intent(out):: dimlo, dimhi
    integer:: class, cid
    call vartablelookup(vid, class, cid)
    select case(class)
    case(vtb_class_netcdf)
      dimlo = 1
      call gdncinquire(gd_nc_variable(cid), dimlen=dimhi)
    case default
      call storeerror(nf90_einval, 'gtdata::dimrange')
    end select
  end subroutine dimrange_direct
 
  !>
  !> @en
  !> @brief Get number of dimensions of variable
  !> @param[in] vid Variable ID
  !> @return Number of dimensions
  !> @enden
  !>
  !> @ja
  !> @brief 変数の次元数を取得
  !> @param[in] vid 変数ID
  !> @return 次元数
  !> @endja
  !>
  integer function ndims(vid) result(result)
    use gtdata_netcdf_types, only: gd_nc_variable
    use gtdata_netcdf_generic, only: gdncinquire => inquire
    use dc_error, only: storeerror, nf90_einval
    integer, intent(in):: vid
    integer:: class, cid
    call vartablelookup(vid, class, cid)
    select case(class)
    case(vtb_class_netcdf)
      call gdncinquire(gd_nc_variable(cid), ndims=result)
    case default
      call storeerror(nf90_einval, 'gtdata::ndims')
    end select
  end function ndims
 
  !>
  !> @en
  !> @brief Query whether variable has unlimited dimension
  !> @param[in]  vid    Variable ID
  !> @param[out] result .true. if variable has unlimited dimension
  !> @enden
  !>
  !> @ja
  !> @brief 変数が無制限次元を持つか問い合わせ
  !> @param[in]  vid    変数ID
  !> @param[out] result 無制限次元を持つ場合 .true.
  !> @endja
  !>
  subroutine query_growable(vid, result)
    use gtdata_netcdf_types, only: gd_nc_variable
    use gtdata_netcdf_generic, only: inquire
    use dc_error, only: storeerror, nf90_einval
    integer, intent(in):: vid
    logical, intent(out):: result
    integer:: class, cid
    call vartablelookup(vid, class, cid)
    select case(class)
    case(vtb_class_netcdf)
      call inquire(gd_nc_variable(cid), growable=result)
    case default
      call storeerror(nf90_einval, 'gtdata::ndims')
    end select
  end subroutine query_growable
 
end module gtdata_internal_vartable