| Class | gtdata_internal_vartable |
| In: |
gtdata/gtdata_internal_vartable.f90
|
このモジュールは gtool モジュールから直接には引用されないため、 相当むちゃな名前の使い方をしている。ユーザは呼んではならない。
gtool 変数というのは実は単なるハンドルと多次元イテレータであり、 ハンドルは小さな整数値である。 実体にアクセスするためには、ハンドル値をキーにしてまずマップ表を引き、 そこで得られた vid をキーにして変数表を引いて、 種別と種別ごとの変数番号を得る。これらはたかだかポインタ+オフセット 参照程度のコストである。 gtool 変数は実体変数からイテレータが必要なだけ作成されるが、 この変数表は実体変数につき1エントリしか作成しないので、参照数を持つ。 このため、実体変数は変数に付いて参照数管理をしなくてもよくなる。
| Subroutine : | |
| vid : | integer, intent(out) |
| class : | integer, intent(in) |
| cid : | integer, intent(in) |
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 |
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 |
同じファイル番号の変数表の中身を返す
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 |
同じファイル番号の参照カウントを増加する。
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) |
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
| Function : | |
| result : | integer |
| vid : | integer, intent(in) |
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) |
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) |
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