| Class | gtdata_internal_map |
| In: |
gtdata/gtdata_internal_map.f90
|
gtool 変数というのは実はマップ表のキーとなる整数ハンドルである。 マップ表 maptab には実体表のエントリ番号と次元書き換え/イテレータ の表が載っている。 このレベルにおける参照カウントは作らないことにする。つまり、 マップ表と実体表は一対一対応するし、 ユーザがハンドルをコピーするのは勝手である。 もちろんユーザには必ずただ1回 当該ハンドルを close すなわち maptabdelete する義務がある。
| Derived Type : | |||
| dimno : | integer
| ||
| url : | character(len=STRING)
| ||
| offset : | integer
| ||
| step : | integer
| ||
| allcount : | integer
| ||
| start : | integer
| ||
| count : | integer
| ||
| stride : | integer
| ||
| scalar : | logical
|
次元書き換え表
| Subroutine : | |
| mapid : | integer, intent(out) |
| vid : | integer, intent(in) |
すでに実体表に追加されたエントリ番号 vid を指定して、 マップ表にエントリを追加する。
subroutine MapTabAdd(mapid, vid)
! すでに実体表に追加されたエントリ番号 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
| Subroutine : | |
| var : | type(gt_variable), intent(in) |
| err : | logical, intent(out), optional |
変数 var をマップ表から削除する。 実体表には手をつけない。
subroutine MapTabDelete(var, err)
! 変数 var をマップ表から削除する。
! 実体表には手をつけない。
use dc_error, only: NF_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(NF_ENOTVAR, 'maptabdelete', err)
end subroutine MapTabDelete
| Constant : | |
| VTB_CLASS_MEMORY = 1 : | integer, parameter, public |
Original external subprogram is gtdata_internal_vartable#VTB_CLASS_MEMORY
| Constant : | |
| VTB_CLASS_NETCDF = 2 : | integer, parameter, public |
Original external subprogram is gtdata_internal_vartable#VTB_CLASS_NETCDF
| Constant : | |
| VTB_CLASS_UNUSED = 0 : | integer, parameter, public |
Original external subprogram is gtdata_internal_vartable#VTB_CLASS_UNUSED
| Function : | |
| result : | integer |
| dimord : | integer, intent(in) |
| map(:) : | type(GT_DIMMAP), intent(in) |
次元表の中で非縮退次元だけを数えた次元番号 dimord の次元を 特定し、外部向けの次元番号を返す。
integer function dimord_skip_compact(dimord, map) result(result)
! 次元表の中で非縮退次元だけを数えた次元番号 dimord の次元を
! 特定し、外部向けの次元番号を返す。
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
| Subroutine : | |
| var : | type(gt_variable), intent(in) |
| dimno : | integer, intent(in) |
| dimlo : | integer, intent(out) |
| dimhi : | integer, intent(out) |
変数と次元番号を指定して、当該次元の内部的添字番号範囲を得る
Alias for dimrange_by_dimno
| Subroutine : | |
| var : | type(gt_variable), intent(in) |
| dimno : | integer, intent(in) |
| dimlo : | integer, intent(out) |
| dimhi : | integer, intent(out) |
変数と次元番号を指定して、当該次元の内部的添字番号範囲を得る
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.)
call map_lookup(dimvar, vid=vid)
call dimrange(vid, dimlo, dimhi)
call close(dimvar)
end subroutine dimrange_by_dimno
| Subroutine : | |
| var : | type(gt_variable), intent(in) |
変数のプロパティを出力
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
if (.not. debug()) 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
| Subroutine : | |
| map(:) : | type(GT_DIMMAP), pointer |
| ndims : | integer, intent(in) |
次元表エントリに ndims 個のエントリを割り付け初期化する。
subroutine map_allocate(map, ndims)
! 次元表エントリに 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
| Subroutine : | |
| var : | type(GT_VARIABLE), intent(inout) |
| map(:) : | type(GT_DIMMAP), pointer |
変数 var にマップ表 map を組み合わせる
subroutine map_apply(var, map)
! 変数 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
| Subroutine : | |
| var : | type(gt_variable), intent(out) |
| class : | integer, intent(in) |
| cid : | integer, intent(in) |
| ndims : | integer, intent(in) |
| allcount(:) : | integer, intent(in) |
| stat : | integer, intent(out) |
変数 var を作成する。内部種別 class, 内部識別子 cid, 外見的次元数 ndims, 外見的次元長 allcount(:) を与える。 オフセットゼロを仮定して諸元の初期化が行われる。
subroutine map_create(var, class, cid, ndims, allcount, stat)
! 変数 var を作成する。内部種別 class, 内部識別子 cid,
! 外見的次元数 ndims, 外見的次元長 allcount(:) を与える。
! オフセットゼロを仮定して諸元の初期化が行われる。
use gtdata_types, only: gt_variable
use gtdata_internal_vartable, only: VarTableAdd
use dc_error, only: NF_ENOTVAR, 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
| Subroutine : | |
| var : | type(gt_variable), intent(out) |
| source_var : | type(gt_variable), intent(in) |
変数 source_var の複写 var を作成する
subroutine map_dup(var, source_var)
! 変数 source_var の複写 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
| Subroutine : | |
| var : | type(gt_variable), intent(in) |
| vid : | integer, intent(out), optional |
| map(:) : | type(GT_DIMMAP), intent(out), optional |
| ndims : | integer, intent(out), optional |
同じファイル番号の変数表の中身を返す
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
| Subroutine : | |
| var : | type(GT_VARIABLE), intent(in) |
| ndims : | integer, intent(in) |
変数 var の次元表の大きさを変える
subroutine map_resize(var, ndims)
! 変数 var の次元表の大きさを変える
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
| Subroutine : | |
| var : | type(gt_variable), intent(in) |
| map(:) : | type(GT_DIMMAP), intent(in) |
| stat : | integer, intent(out) |
同じファイル番号の変数表の値を設定する
subroutine map_set(var, map, stat)
! 同じファイル番号の変数表の値を設定する
use gtdata_types, only: gt_variable
use dc_error, only: NF_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 = NF_ENOTVAR
end subroutine map_set
| Subroutine : | |
| var : | type(gt_variable), intent(in) |
| ndims : | integer, intent(in) |
| stat : | integer, intent(out) |
変数 var の次元数を ndims に変える。
subroutine map_set_ndims(var, ndims, stat)
! 変数 var の次元数を ndims に変える。
use gtdata_types, only: gt_variable
use gtdata_internal_vartable, only: vartablelookup
use dc_error, only: NF_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 = NF_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
| Subroutine : | |
| var : | type(gt_variable), intent(in) |
| rank : | integer, intent(in) |
| stat : | integer, intent(out) |
変数 var のランク(非縮退次元数)を rank に減らすように count 値を1に減らす。ランクを増やすことや外見次元数の操作はしない。
subroutine map_set_rank(var, rank, stat)
! 変数 var のランク(非縮退次元数)を rank に減らすように
! count 値を1に減らす。ランクを増やすことや外見次元数の操作はしない。
use gtdata_types, only: gt_variable
use gtdata_internal_vartable, only: vartablelookup
use dc_error, only: NF_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 = NF_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
| Subroutine : | |
| var : | type(gt_variable), intent(in) |
| specs(:, :) : | integer, pointer |
| ndims : | integer, intent(out), optional |
マップ表から netCDF の引数にふさわしい start, count, stride, imap を作成する。ただし、stride が負になるばあいは対策されていない。 (暫定的に gdncvarget/gdncvarput が対応している)
subroutine map_to_internal_specs(var, specs, ndims)
! マップ表から netCDF の引数にふさわしい start, count, stride, imap
! を作成する。ただし、stride が負になるばあいは対策されていない。
! (暫定的に gdncvarget/gdncvarput が対応している)
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
| Subroutine : | |
| var : | type(gt_variable), intent(in) |
| class : | integer, intent(out), optional |
| cid : | integer, intent(out), optional |
変数 var を指定して、内部種別 class, 内部識別子 cid を得る。
subroutine var_class(var, class, cid)
! 変数 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
| Constant : | |
| vid_invalid = -1 : | integer, parameter, public |
Original external subprogram is gtdata_internal_vartable#vid_invalid