gtdata_internal_map.f90

Go to the documentation of this file.

!> @file gtdata_internal_map.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 map table module for gtool variables
!>
!> @private
!> This module should not be used directly by users.
!> @enden
!>
!> @ja
!> @brief gtool 変数用の内部マップテーブルモジュール
!>
!> @private
!> このモジュールはユーザが直接使用すべきではありません。
!> @endja
!>
 
!>
!> @en
!> @brief Map table management for gtool variables
!>
!> @private
!> A gtool variable is actually an integer handle that serves as a key
!> to the map table. The map table (maptab) contains the entity table
!> entry number and dimension rewriting/iterator tables.
!>
!> Reference counting is not implemented at this level. That is,
!> map table and entity table have one-to-one correspondence,
!> and users are free to copy handles.
!> Of course, users must close (i.e., MapTabDelete) the handle
!> exactly once.
!> @enden
!>
!> @ja
!> @brief gtool 変数のマップテーブル管理
!>
!> @private
!> gtool 変数というのは実はマップ表のキーとなる整数ハンドルである。
!> マップ表 maptab には実体表のエントリ番号と次元書き換え／イテレータ
!> の表が載っている。
!>
!> このレベルにおける参照カウントは作らないことにする。つまり、
!> マップ表と実体表は一対一対応するし、
!> ユーザがハンドルをコピーするのは勝手である。
!> もちろんユーザには必ずただ１回
!> 当該ハンドルを close すなわち maptabdelete する義務がある。
!> @endja
!>
module gtdata_internal_map
 
  use dc_types, only: string
  use gtdata_internal_vartable, only: vid_invalid, &
    & vtb_class_unused, vtb_class_netcdf
    ! これらは, 外部から gtdata_internal_vartable を直接呼ばないようにするため,
    ! gtdata_internal_map を介して公開する.
 
  implicit none
 
  !>
  !> @en
  !> @brief Dimension mapping table entry type
  !>
  !> Contains dimension rewriting information and iterator state.
  !> @enden
  !>
  !> @ja
  !> @brief 次元マッピングテーブルエントリ型
  !>
  !> 次元書き換え情報とイテレータ状態を格納します。
  !> @endja
  !>
  type gt_dimmap
    integer:: dimno
          ! 正ならば実体変数の次元番号, 他変数参照時は非正値
    character(len=STRING):: url
          ! 次元変数の url
    integer:: offset
          !=== 実体と gtool ユーザの格子番号対応
          !
          ! ユーザからみて 1..allcount が実体の
          ! (1..allcount) * step + offset に写像される。
          ! これらの値の変更の際は実体変数の許容添字範囲および
          ! 成長可能性を確認する必要あり。
          ! start 値に対するオフセット。
    integer:: step
          ! 1 か -1 の値をとることが期待される。
    integer:: allcount
          ! 見掛けの格子番号上限: start + count * stride <= allcount
    integer:: start
          !=== イテレータ本体
          ! 入出力範囲は (start:start+count*stride:stride) である。
          ! イテレータ start 値
    integer:: count
          ! イテレータ count 値
    integer:: stride
          ! イテレータ stride 値
    logical:: scalar
          ! スカラー変数である場合, .true.
  end type gt_dimmap
 
  !>
  !> @en
  !> @brief Map table entry type
  !>
  !> Contains variable ID, number of dimensions, and pointer to dimension map array.
  !> @enden
  !>
  !> @ja
  !> @brief マップテーブルエントリ型
  !>
  !> 変数ID、次元数、次元マップ配列へのポインタを格納します。
  !> @endja
  !>
  type map_table_entry
    integer:: vid
    integer:: ndims
    type(gt_dimmap), pointer:: map(:)
  end type map_table_entry
 
  type(map_table_entry), save, target, allocatable:: maptab(:)
  integer, parameter:: maptab_init_size = 16
 
  public:: maptabadd, maptabdelete, map_lookup
  public:: var_class, map_create, map_to_internal_specs, dimrange
  public:: vid_invalid, vtb_class_unused, vtb_class_netcdf
  private:: maptab, maptab_init_size
 
  interface dimrange
    module procedure dimrange_by_dimno
  end interface
 
contains
 
  !>
  !> @en
  !> @brief Get internal index range for specified dimension
  !> @param[in]  var   Variable handle
  !> @param[in]  dimno Dimension number
  !> @param[out] dimlo Lower bound of dimension
  !> @param[out] dimhi Upper bound of dimension
  !> @enden
  !>
  !> @ja
  !> @brief 指定された次元の内部的添字番号範囲を取得
  !> @param[in]  var   変数ハンドル
  !> @param[in]  dimno 次元番号
  !> @param[out] dimlo 次元の下限
  !> @param[out] dimhi 次元の上限
  !> @endja
  !>
  subroutine dimrange_by_dimno(var, dimno, dimlo, dimhi)
    use gtdata_types, only: gt_variable
    use gtdata_generic, only: open, close
    use gtdata_internal_vartable, only: dimrange
    type(gt_variable), intent(in):: var
    integer, intent(in):: dimno
    integer, intent(out):: dimlo, dimhi
    type(gt_variable):: dimvar
    integer:: vid
    call open(dimvar, var, dimno, count_compact=.true., &
      & inherit_slice=.false.)
    call map_lookup(dimvar, vid=vid)
    call dimrange(vid, dimlo, dimhi)
    call close(dimvar)
  end subroutine dimrange_by_dimno
 
  !>
  !> @en
  !> @brief Duplicate a variable
  !> @param[out] var        Duplicated variable handle
  !> @param[in]  source_var Source variable handle to copy
  !> @enden
  !>
  !> @ja
  !> @brief 変数を複製
  !> @param[out] var        複製された変数ハンドル
  !> @param[in]  source_var コピー元の変数ハンドル
  !> @endja
  !>
  subroutine map_dup(var, source_var)
    use gtdata_types, only: gt_variable
    use gtdata_internal_vartable, only: vartableadd, vartablelookup
    use dc_trace, only: dbgmessage
    type(gt_variable), intent(out):: var
    type(gt_variable), intent(in):: source_var
    integer:: vid, mid1, mid2, vid2, nd, class, cid
    call map_lookup(source_var, vid=vid)
    if (vid < 0) then
      var = gt_variable(-1)
      return
    endif
    if (vid == 0) then
      vid2 = 0
    else
      call vartablelookup(vid, class=class, cid=cid)
      call vartableadd(vid2, class, cid)
    endif
    call maptabadd(var%mapid, vid2)
    mid1 = source_var%mapid
    mid2 = var%mapid
    maptab(mid2)%ndims = maptab(mid1)%ndims
    if (associated(maptab(mid1)%map)) then
      nd = size(maptab(mid1)%map)
      allocate(maptab(mid2)%map(nd))
      maptab(mid2)%map(1:nd) = maptab(mid1)%map(1:nd)
    else
      nullify(maptab(mid2)%map)
    endif
    call dbgmessage('map_dup mapid(%d from %d) vid(%d from %d)', &
      & i=(/mid2, mid1, maptab(mid2)%vid, maptab(mid1)%vid/))
  end subroutine map_dup
 
  !>
  !> @en
  !> @brief Create a variable with specified properties
  !>
  !> Creates variable var with internal class, internal cid,
  !> apparent number of dimensions ndims, and apparent dimension lengths allcount(:).
  !> Initialization is performed assuming zero offset.
  !> @param[out] var      Created variable handle
  !> @param[in]  class    Internal class (VTB_CLASS_NETCDF, etc.)
  !> @param[in]  cid      Internal identifier
  !> @param[in]  ndims    Number of dimensions
  !> @param[in]  allcount Array of dimension lengths
  !> @param[out] stat     Status code
  !> @enden
  !>
  !> @ja
  !> @brief 指定されたプロパティで変数を作成
  !>
  !> 変数 var を作成する。内部種別 class, 内部識別子 cid,
  !> 外見的次元数 ndims, 外見的次元長 allcount(:) を与える。
  !> オフセットゼロを仮定して諸元の初期化が行われる。
  !> @param[out] var      作成された変数ハンドル
  !> @param[in]  class    内部種別 (VTB_CLASS_NETCDF 等)
  !> @param[in]  cid      内部識別子
  !> @param[in]  ndims    次元数
  !> @param[in]  allcount 次元長の配列
  !> @param[out] stat     ステータスコード
  !> @endja
  !>
  subroutine map_create(var, class, cid, ndims, allcount, stat)
    use gtdata_types, only: gt_variable
    use gtdata_internal_vartable, only: vartableadd
    use dc_error, only: gt_enomoredims, dc_noerr
    type(gt_variable), intent(out):: var
    integer, intent(in):: class, cid, ndims, allcount(:)
    integer, intent(out):: stat
    type(gt_dimmap), pointer:: map(:)
    integer:: vid, i
  continue
 
    stat = dc_noerr
    if ( ndims < 0 ) then
      stat = gt_enomoredims
      goto 999
    end if
    call vartableadd(vid, class, cid)
    call maptabadd(var%mapid, vid)
    if (ndims > 0) then
      call map_allocate(map, ndims)
      maptab(var%mapid)%ndims = ndims
      maptab(var%mapid)%map => map
 
      do, i = 1, ndims
        map(i)%dimno = i
        map(i)%allcount = allcount(i)
        map(i)%count = allcount(i)
        map(i)%offset = 0
        map(i)%start = 1
        map(i)%step = 1
        map(i)%stride = 1
        map(i)%scalar = .false.
      enddo
    else
      ! スカラー変数 (ndims = 0) の場合
      call map_allocate(map, 1)
      maptab(var%mapid)%ndims = 0
      maptab(var%mapid)%map => map
      map(1)%dimno = 1
      map(1)%allcount = 1
      map(1)%count = 1
      map(1)%offset = 0
      map(1)%start = 1
      map(1)%step = 1
      map(1)%stride = 1
      map(1)%scalar = .true.
    end if
 
999 continue
    return
  end subroutine map_create
 
  !>
  !> @en
  !> @brief Add entry to map table
  !>
  !> Adds an entry to the map table with the specified vid
  !> (which should already be added to the entity table).
  !> @param[out] mapid Map table entry ID
  !> @param[in]  vid   Variable table entry ID
  !> @enden
  !>
  !> @ja
  !> @brief マップテーブルにエントリを追加
  !>
  !> すでに実体表に追加されたエントリ番号 vid を指定して、
  !> マップ表にエントリを追加する。
  !> @param[out] mapid マップテーブルエントリID
  !> @param[in]  vid   変数テーブルエントリID
  !> @endja
  !>
  subroutine maptabadd(mapid, vid)
    integer, intent(out):: mapid
    integer, intent(in):: vid
    type(map_table_entry), allocatable:: tmp_maptab(:)
    integer:: i, n
    ! 必要なら初期確保
    if (.not. allocated(maptab)) then
      allocate(maptab(maptab_init_size))
      maptab(:)%vid = vid_invalid
      do, n = 1, maptab_init_size
        nullify(maptab(n)%map)
      enddo
    endif
    ! 空き地があればそこに割り当て
    do, i = 1, size(maptab)
      if (maptab(i)%vid == vid_invalid) then
        mapid = i
        maptab(mapid)%vid = vid
        return
      endif
    enddo
    ! 空き地はなかったのだから倍幅確保
    n = size(maptab)
    allocate(tmp_maptab(n))
    tmp_maptab(:) = maptab(:)
    deallocate(maptab)
    allocate(maptab(n * 2))
    ! 確保したところはクリア
    maptab(1:n) = tmp_maptab(1:n)
    do, i = n + 1, (2 * size(tmp_maptab))
      maptab(i)%vid = vid_invalid
      nullify(maptab(i)%map)
    enddo
    deallocate(tmp_maptab)
    mapid = n + 1
    maptab(mapid)%vid = vid
  end subroutine maptabadd
 
  !>
  !> @en
  !> @brief Delete variable from map table
  !>
  !> Removes variable var from the map table.
  !> Does not touch the entity table.
  !> @param[in]  var Variable handle to delete
  !> @param[out] err Error flag (optional)
  !> @enden
  !>
  !> @ja
  !> @brief 変数をマップテーブルから削除
  !>
  !> 変数 var をマップ表から削除する。
  !> 実体表には手をつけない。
  !> @param[in]  var 削除する変数ハンドル
  !> @param[out] err エラーフラグ (省略可能)
  !> @endja
  !>
  subroutine maptabdelete(var, err)
    use dc_error, only: nf90_enotvar, storeerror, dc_noerr
    use gtdata_types, only: gt_variable
    use dc_trace, only: dbgmessage
    implicit none
    type(gt_variable), intent(in):: var
    logical, intent(out), optional:: err
    integer:: mapid
    mapid = var%mapid
    if (.not. allocated(maptab)) goto 999
    if (mapid <= 0 .or. mapid > size(maptab)) goto 999
    if (maptab(mapid)%vid == vid_invalid) goto 999
    maptab(mapid)%vid = vid_invalid
    if (associated(maptab(mapid)%map)) deallocate(maptab(mapid)%map)
    call storeerror(dc_noerr, 'maptabdelete', err)
    call dbgmessage('gtdata_internal_map table %d deleted', i=(/mapid/))
    return
999 continue
    call storeerror(nf90_enotvar, 'maptabdelete', err)
  end subroutine maptabdelete
 
  !>
  !> @en
  !> @brief Look up map table entry
  !> @param[in]  var   Variable handle
  !> @param[out] vid   Variable table entry ID (optional)
  !> @param[out] map   Dimension map array (optional)
  !> @param[out] ndims Number of dimensions (optional)
  !> @enden
  !>
  !> @ja
  !> @brief マップテーブルエントリを検索
  !> @param[in]  var   変数ハンドル
  !> @param[out] vid   変数テーブルエントリID (省略可能)
  !> @param[out] map   次元マップ配列 (省略可能)
  !> @param[out] ndims 次元数 (省略可能)
  !> @endja
  !>
  subroutine map_lookup(var, vid, map, ndims)
    use gtdata_types, only: gt_variable
    type(gt_variable), intent(in):: var
    integer, intent(out), optional:: vid
    type(gt_dimmap), intent(out), optional:: map(:)
    integer, intent(out), optional:: ndims
    if (.not. allocated(maptab)) goto 999
    if (var%mapid <= 0 .or. var%mapid > size(maptab)) goto 999
    if (maptab(var%mapid)%vid == vid_invalid) goto 999
    if (present(vid)) vid = maptab(var%mapid)%vid
    if (present(map)) map(:) = maptab(var%mapid)%map(1:size(map))
    if (present(ndims)) ndims = maptab(var%mapid)%ndims
    return
999 continue
    if (present(vid)) vid = vid_invalid
    if (present(map)) then
      map(:)%dimno = -1
      map(:)%url = " "
    endif
    if (present(ndims)) ndims = 0
  end subroutine map_lookup
 
  !>
  !> @en
  !> @brief Set map table values
  !> @param[in]  var  Variable handle
  !> @param[in]  map  Dimension map array to set
  !> @param[out] stat Status code
  !> @enden
  !>
  !> @ja
  !> @brief マップテーブルの値を設定
  !> @param[in]  var  変数ハンドル
  !> @param[in]  map  設定する次元マップ配列
  !> @param[out] stat ステータスコード
  !> @endja
  !>
  subroutine map_set(var, map, stat)
    use gtdata_types, only: gt_variable
    use dc_error, only: nf90_enotvar, gt_enomoredims, dc_noerr
    type(gt_variable), intent(in):: var
    type(gt_dimmap), intent(in):: map(:)
    integer, intent(out):: stat
    if (.not. allocated(maptab)) goto 999
    if (var%mapid <= 0 .or. var%mapid > size(maptab)) goto 999
    if (maptab(var%mapid)%vid == vid_invalid) goto 999
    if (size(map) > size(maptab(var%mapid)%map)) then
      stat = gt_enomoredims
      return
    endif
    maptab(var%mapid)%map(1:size(map)) = map(:)
    stat = dc_noerr
    return
999 continue
    stat = nf90_enotvar
  end subroutine map_set
 
  !>
  !> @en
  !> @brief Get internal class and identifier of variable
  !> @param[in]  var   Variable handle
  !> @param[out] class Internal class (optional)
  !> @param[out] cid   Internal identifier (optional)
  !> @enden
  !>
  !> @ja
  !> @brief 変数の内部種別と識別子を取得
  !> @param[in]  var   変数ハンドル
  !> @param[out] class 内部種別 (省略可能)
  !> @param[out] cid   内部識別子 (省略可能)
  !> @endja
  !>
  subroutine var_class(var, class, cid)
    use gtdata_types, only: gt_variable
    use gtdata_internal_vartable, only: vartablelookup
    type(gt_variable), intent(in):: var
    integer, intent(out), optional:: class, cid
    integer:: vid
    call map_lookup(var, vid=vid)
    call vartablelookup(vid, class=class, cid=cid)
  end subroutine var_class
 
  !>
  !> @en
  !> @brief Change number of dimensions of variable
  !> @param[in]  var   Variable handle
  !> @param[in]  ndims New number of dimensions
  !> @param[out] stat  Status code
  !> @enden
  !>
  !> @ja
  !> @brief 変数の次元数を変更
  !> @param[in]  var   変数ハンドル
  !> @param[in]  ndims 新しい次元数
  !> @param[out] stat  ステータスコード
  !> @endja
  !>
  subroutine map_set_ndims(var, ndims, stat)
    use gtdata_types, only: gt_variable
    use dc_error, only: nf90_enotvar, gt_enomoredims, dc_noerr
    type(gt_variable), intent(in):: var
    integer, intent(in):: ndims
    integer, intent(out):: stat
    integer:: vid
    call map_lookup(var, vid=vid)
    if (vid == vid_invalid) then
      stat = nf90_enotvar
      return
    endif
    if (.not. associated(maptab(var%mapid)%map)) then
      if (ndims == 0) then
        stat = dc_noerr
        maptab(var%mapid)%ndims = 0
      else
        stat = gt_enomoredims
      endif
    else
      if (ndims > size(maptab(var%mapid)%map)) then
        stat = gt_enomoredims
      else
        stat = dc_noerr
        maptab(var%mapid)%ndims = ndims
      endif
    endif
  end subroutine map_set_ndims
 
  !>
  !> @en
  !> @brief Reduce variable rank to specified value
  !>
  !> Reduces the rank (number of non-degenerate dimensions) of variable var
  !> to rank by setting count values to 1.
  !> Does not increase rank or manipulate apparent dimension count.
  !> @param[in]  var  Variable handle
  !> @param[in]  rank Target rank
  !> @param[out] stat Status code
  !> @enden
  !>
  !> @ja
  !> @brief 変数のランクを指定値に減少
  !>
  !> 変数 var のランク(非縮退次元数)を rank に減らすように
  !> count 値を1に減らす。ランクを増やすことや外見次元数の操作はしない。
  !> @param[in]  var  変数ハンドル
  !> @param[in]  rank 目標ランク
  !> @param[out] stat ステータスコード
  !> @endja
  !>
  subroutine map_set_rank(var, rank, stat)
    use gtdata_types, only: gt_variable
    use dc_error, only: nf90_enotvar, gt_enomoredims, dc_noerr
    type(gt_variable), intent(in):: var
    integer, intent(in):: rank
    integer, intent(out):: stat
    type(gt_dimmap), pointer:: tmpmap(:)
    integer:: ndims
    integer:: vid, nd
    call map_lookup(var, vid, ndims=ndims)
    if (vid == vid_invalid) then
      stat = nf90_enotvar
      return
    endif
    if (ndims < rank) then
      stat = gt_enomoredims
      return
    endif
    tmpmap => maptab(var%mapid)%map
    do, nd = ndims, 1, -1
      if (count(tmpmap(1:ndims)%count > 1) <= rank) exit
      tmpmap(nd)%count = 1
    enddo
    stat = dc_noerr
  end subroutine map_set_rank
 
  !>
  !> @en
  !> @brief Convert map table to netCDF internal specifications
  !>
  !> Creates start, count, stride, imap suitable for netCDF arguments
  !> from the map table. Note that negative stride is not handled
  !> (temporarily handled by gdncvarget/gdncvarput).
  !> @param[in]  var   Variable handle
  !> @param[out] specs Pointer to specs array (allocated internally)
  !> @param[out] ndims Number of internal dimensions (optional)
  !> @enden
  !>
  !> @ja
  !> @brief マップテーブルをnetCDF内部仕様に変換
  !>
  !> マップ表から netCDF の引数にふさわしい start, count, stride, imap
  !> を作成する。ただし、stride が負になるばあいは対策されていない。
  !> (暫定的に gdncvarget/gdncvarput が対応している)
  !> @param[in]  var   変数ハンドル
  !> @param[out] specs specs配列へのポインタ (内部で割り当て)
  !> @param[out] ndims 内部次元数 (省略可能)
  !> @endja
  !>
  subroutine map_to_internal_specs(var, specs, ndims)
    use gtdata_types, only: gt_variable
    use gtdata_internal_vartable, only: num_dimensions => ndims
    type(gt_variable), intent(in):: var
    integer, pointer:: specs(:, :)
    integer, intent(out), optional:: ndims
    type(gt_dimmap), pointer:: it
    integer:: vid, i, j, imap, internal_ndims
    integer:: external_ndims
  continue
    call map_lookup(var, vid, ndims=external_ndims)
    internal_ndims = num_dimensions(vid)
    if (present(ndims)) ndims = internal_ndims
    allocate(specs(max(1, internal_ndims), 4))
    specs(:, 1) = 1
    specs(:, 2) = 1
    specs(:, 3) = 1
    specs(:, 4) = 0
    imap = 1
    do, i = 1, size(maptab(var%mapid)%map)
      it => maptab(var%mapid)%map(i)
      j = it%dimno
      if (j > 0 .and. j <= internal_ndims) then
        specs(j, 1) = it%start + it%offset
        specs(j, 2) = it%count
        if (i > external_ndims) specs(j, 2) = 1
        specs(j, 3) = it%stride * it%step
        specs(j, 4) = imap
      endif
      imap = imap * it%count
    enddo
  end subroutine map_to_internal_specs
 
  !>
  !> @en
  !> @brief Allocate and initialize dimension map entries
  !> @param[out] map   Pointer to allocated map array
  !> @param[in]  ndims Number of entries to allocate
  !> @enden
  !>
  !> @ja
  !> @brief 次元マップエントリを割り当て初期化
  !> @param[out] map   割り当てられたマップ配列へのポインタ
  !> @param[in]  ndims 割り当てるエントリ数
  !> @endja
  !>
  subroutine map_allocate(map, ndims)
    type(gt_dimmap), pointer:: map(:)
    integer, intent(in):: ndims
    if (ndims <= 0) then
      nullify(map)
      return
    endif
    allocate(map(1:ndims))
    map(1:ndims)%dimno = -1
    map(1:ndims)%url = ' '
    map(1:ndims)%allcount = 0
    map(1:ndims)%offset = 0
    map(1:ndims)%step = 1
    map(1:ndims)%start = 1
    map(1:ndims)%count = 0
    map(1:ndims)%stride = 1
    map(1:ndims)%scalar = .false.
  end subroutine map_allocate
 
  !>
  !> @en
  !> @brief Apply map table to variable
  !> @param[inout] var Variable handle
  !> @param[inout] map Dimension map to apply (deallocated and replaced)
  !> @enden
  !>
  !> @ja
  !> @brief 変数にマップテーブルを適用
  !> @param[inout] var 変数ハンドル
  !> @param[inout] map 適用する次元マップ (解放され置き換えられる)
  !> @endja
  !>
  subroutine map_apply(var, map)
    use gtdata_types, only: gt_variable
    type(gt_variable), intent(inout):: var
    type(gt_dimmap), pointer:: map(:)
    type(gt_dimmap), pointer:: tmpmap(:), varmap
    integer:: i, nd
    nd = size(map)
    allocate(tmpmap(nd))
    do, i = 1, nd
      tmpmap(i)%allcount = map(i)%allcount
      tmpmap(i)%count = map(i)%count
      if (map(i)%dimno > 0) then
        varmap => maptab(var%mapid)%map(map(i)%dimno)
        tmpmap(i)%url = varmap%url
        tmpmap(i)%dimno = varmap%dimno
        tmpmap(i)%offset = varmap%offset + map(i)%offset
        tmpmap(i)%step = varmap%step * map(i)%step
      else
        tmpmap(i)%url = map(i)%url
        tmpmap(i)%dimno = 0
        tmpmap(i)%offset = map(i)%offset
        tmpmap(i)%step = map(i)%step
      endif
    enddo
    deallocate(map)
    map => tmpmap
  end subroutine map_apply
 
  !>
  !> @en
  !> @brief Resize dimension table of variable
  !> @param[in] var   Variable handle
  !> @param[in] ndims New size of dimension table
  !> @enden
  !>
  !> @ja
  !> @brief 変数の次元テーブルのサイズを変更
  !> @param[in] var   変数ハンドル
  !> @param[in] ndims 次元テーブルの新しいサイズ
  !> @endja
  !>
  subroutine map_resize(var, ndims)
    use gtdata_types, only: gt_variable
    type(gt_variable), intent(in):: var
    integer, intent(in):: ndims
    type(gt_dimmap), pointer:: newmap(:)
    type(gt_dimmap), pointer:: tmpmap(:)
    integer:: n
    if (associated(maptab(var%mapid)%map)) then
      tmpmap => maptab(var%mapid)%map
      call map_allocate(newmap, ndims)
      n = min(size(tmpmap), ndims)
      newmap(1:n) = tmpmap(1:n)
      deallocate(tmpmap)
      maptab(var%mapid)%map => newmap
      newmap(n+1:ndims)%dimno = -1
      newmap(n+1:ndims)%url = ' '
      newmap(n+1:ndims)%allcount = 0
      newmap(n+1:ndims)%offset = 0
      newmap(n+1:ndims)%step = 1
      newmap(n+1:ndims)%start = 1
      newmap(n+1:ndims)%count = 0
      newmap(n+1:ndims)%stride = 1
    else
      call map_allocate(maptab(var%mapid)%map, ndims)
      n = 1
    endif
  end subroutine map_resize
 
  !>
  !> @en
  !> @brief Dump variable properties for debugging
  !> @param[in] var Variable handle
  !> @enden
  !>
  !> @ja
  !> @brief デバッグ用変数プロパティのダンプ
  !> @param[in] var 変数ハンドル
  !> @endja
  !>
  subroutine gtvar_dump(var)
    use gtdata_types, only: gt_variable
    use gtdata_internal_vartable, only: vartable_dump
    use dc_trace, only: debug, dbgmessage
    type(gt_variable), intent(in):: var
    integer:: idim, imap
    logical:: dbg_mode
  continue
    call debug( dbg_mode )
    if (.not. dbg_mode) return
    imap = var%mapid
    if (imap < 1 .or. imap > size(maptab)) then
      call dbgmessage('[gt_variable %d: invalid id]', i=(/imap/))
      return
    endif
    if (associated(maptab(imap)%map)) then
      call dbgmessage('[gt_variable %d: ndims=%d, map.size=%d]', &
        & i=(/imap, maptab(imap)%ndims, size(maptab(imap)%map)/))
      do, idim = 1, size(maptab(imap)%map)
        call dbgmessage('[dim%d dimno=%d ofs=%d step=%d' &
          &// ' all=%d start=%d count=%d stride=%d url=%c]', &
          & c1=trim(maptab(imap)%map(idim)%url), &
          & i=(/idim, maptab(imap)%map(idim)%dimno, &
          & maptab(imap)%map(idim)%offset, &
          & maptab(imap)%map(idim)%step, &
          & maptab(imap)%map(idim)%allcount, &
          & maptab(imap)%map(idim)%start, &
          & maptab(imap)%map(idim)%count, &
          & maptab(imap)%map(idim)%stride/))
      enddo
    else
      call dbgmessage('[gt_variable %d: ndims=%d, map=null]', &
        & i=(/imap, maptab(imap)%ndims/))
    endif
    call vartable_dump(maptab(imap)%vid)
  end subroutine gtvar_dump
 
  !>
  !> @en
  !> @brief Find external dimension number for compact dimension order
  !>
  !> Identifies the dimension at compact dimension order dimord
  !> (counting only non-degenerate dimensions) and returns
  !> the external dimension number.
  !> @param[in] dimord Compact dimension order
  !> @param[in] map    Dimension map array
  !> @return External dimension number (-1 if not found)
  !> @enden
  !>
  !> @ja
  !> @brief 縮約次元番号に対する外部次元番号を検索
  !>
  !> 次元表の中で非縮退次元だけを数えた次元番号 dimord の次元を
  !> 特定し、外部向けの次元番号を返す。
  !> @param[in] dimord 縮約次元番号
  !> @param[in] map    次元マップ配列
  !> @return 外部次元番号 (見つからない場合は -1)
  !> @endja
  !>
  integer function dimord_skip_compact(dimord, map) result(result)
    use dc_trace, only: dbgmessage
    integer, intent(in):: dimord
    type(gt_dimmap), intent(in):: map(:)
    integer:: nd, id
    result = -1
    nd = 0
    do, id = 1, size(map)
      if (map(id)%count < 2) cycle
      nd = nd + 1
      if (nd < dimord) cycle
      result = id
      call dbgmessage('compact dim skip: %d <= %d', i=(/result, dimord/))
      exit
    enddo
  end function dimord_skip_compact
 
end module gtdata_internal_map