Class gtdata_internal_vartable
In: gtdata/gtdata_internal_vartable.f90

このモジュールは gtool モジュールから直接には引用されないため、 相当むちゃな名前の使い方をしている。ユーザは呼んではならない。

gtool 変数表

gtool 変数というのは実は単なるハンドルと多次元イテレータであり、 ハンドルは小さな整数値である。 実体にアクセスするためには、ハンドル値をキーにしてまずマップ表を引き、 そこで得られた vid をキーにして変数表を引いて、 種別と種別ごとの変数番号を得る。これらはたかだかポインタ+オフセット 参照程度のコストである。 gtool 変数は実体変数からイテレータが必要なだけ作成されるが、 この変数表は実体変数につき1エントリしか作成しないので、参照数を持つ。 このため、実体変数は変数に付いて参照数管理をしなくてもよくなる。

Methods

Included Modules

gtdata_netcdf_types dc_types dc_trace gtdata_netcdf_generic dc_error

Public Instance methods

CLASSES_MAX
Constant :
CLASSES_MAX = 2 :integer, parameter, public
VTB_CLASS_MEMORY
Constant :
VTB_CLASS_MEMORY = 1 :integer, parameter, public
VTB_CLASS_NETCDF
Constant :
VTB_CLASS_NETCDF = 2 :integer, parameter, public
VTB_CLASS_UNUSED
Constant :
VTB_CLASS_UNUSED = 0 :integer, parameter, public
Subroutine :
vid :integer, intent(out)
class :integer, intent(in)
cid :integer, intent(in)

[Source]

  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
Subroutine :
vid :integer, intent(in)
action :logical, intent(out)
err :logical, intent(out), optional

[Source]

  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
Subroutine :
vid :integer, intent(in)
class :integer, intent(out), optional
cid :integer, intent(out), optional

同じファイル番号の変数表の中身を返す

[Source]

  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
Subroutine :
vid :integer, intent(in)
err :logical, intent(out), optional

同じファイル番号の参照カウントを増加する。

[Source]

  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
Subroutine :
vid :integer, intent(in)
dimlo :integer, intent(out)
dimhi :integer, intent(out)

[Source]

  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, nf_einval, gt_efake
    integer, intent(in):: vid
    integer, intent(out):: dimlo, dimhi
    integer:: class, cid
    call VarTableLookup(vid, class, cid)
    select case(class)
    case(VTB_CLASS_MEMORY)
      call storeerror(gt_efake, 'gtdata::dimrange')
    case(VTB_CLASS_NETCDF)
      dimlo = 1
      call GDNcInquire(GD_NC_VARIABLE(cid), dimlen=dimhi)
    case default
      call storeerror(nf_einval, 'gtdata::dimrange')
    end select
  end subroutine dimrange_direct
gdnc_search
Variable :
gdnc_search :type(GD_NC_VARIABLE_SEARCH), public, save
Function :
result :integer
vid :integer, intent(in)

[Source]

  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, nf_einval
    integer, intent(in):: vid
    integer:: class, cid
    call VarTableLookup(vid, class, cid)
    select case(class)
    case(VTB_CLASS_MEMORY)
      result = 1
    case(VTB_CLASS_NETCDF)
      call GDNcInquire(GD_NC_VARIABLE(cid), ndims=result)
    case default
      call storeerror(nf_einval, 'gtdata::ndims')
    end select
  end function ndims
Subroutine :
vid :integer, intent(in)
result :logical, intent(out)

[Source]

  subroutine query_growable(vid, result)
    use gtdata_netcdf_types, only: GD_NC_VARIABLE
    use gtdata_netcdf_generic, only: inquire 
    use dc_error, only: storeerror, nf_einval
    integer, intent(in):: vid
    logical, intent(out):: result
    integer:: class, cid
    call vartablelookup(vid, class, cid)
    select case(class)
    case(vtb_class_memory)
      result = .false.
    case(vtb_class_netcdf)
      call inquire(GD_NC_VARIABLE(cid), growable=result)
    case default
      call storeerror(nf_einval, 'gtdata::ndims')
    end select
  end subroutine query_growable
Subroutine :
vid :integer, intent(in)

[Source]

  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(vtb_class_memory)
      class = 'memory'
    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
vid_invalid
Constant :
vid_invalid = -1 :integer, parameter, public