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