gtdata_internal_map Module Reference

Data Types
type	gt_dimmap
type	map_table_entry
interface	dimrange

Functions/Subroutines
subroutine	dimrange_by_dimno (var, dimno, dimlo, dimhi)
subroutine	map_dup (var, source_var)
subroutine, public	map_create (var, class, cid, ndims, allcount, stat)
subroutine, public	maptabadd (mapid, vid)
subroutine, public	maptabdelete (var, err)
subroutine, public	map_lookup (var, vid, map, ndims)
subroutine	map_set (var, map, stat)
subroutine, public	var_class (var, class, cid)
subroutine	map_set_ndims (var, ndims, stat)
subroutine	map_set_rank (var, rank, stat)
subroutine, public	map_to_internal_specs (var, specs, ndims)
subroutine	map_allocate (map, ndims)
subroutine	map_apply (var, map)
subroutine	map_resize (var, ndims)
subroutine	gtvar_dump (var)
integer function	dimord_skip_compact (dimord, map)

Detailed Description

Map table management for gtool variables

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.

Function/Subroutine Documentation

dimord_skip_compact()

integer function gtdata_internal_map::dimord_skip_compact	(	integer, intent(in)	dimord,
		type(gt_dimmap), dimension(:), intent(in)	map )

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.

Parameters

[in]	dimord	Compact dimension order
[in]	map	Dimension map array

Returns

External dimension number (-1 if not found)

Definition at line 826 of file gtdata_internal_map.f90.

    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

References dc_trace::dbgmessage().

Here is the call graph for this function:

dimrange_by_dimno()

subroutine gtdata_internal_map::dimrange_by_dimno	(	type(gt_variable), intent(in)	var,
		integer, intent(in)	dimno,
		integer, intent(out)	dimlo,
		integer, intent(out)	dimhi )

Get internal index range for specified dimension

Parameters

[in]	var	Variable handle
[in]	dimno	Dimension number
[out]	dimlo	Lower bound of dimension
[out]	dimhi	Upper bound of dimension

Definition at line 155 of file gtdata_internal_map.f90.

    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)

gtvar_dump()

subroutine gtdata_internal_map::gtvar_dump

(

type(gt_variable), intent(in)

var

)

Dump variable properties for debugging

Parameters

[in]

var

Variable handle

Definition at line 767 of file gtdata_internal_map.f90.

    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)

References dc_trace::dbgmessage(), and gtdata_internal_vartable::vartable_dump().

Here is the call graph for this function:

map_allocate()

subroutine gtdata_internal_map::map_allocate	(	type(gt_dimmap), dimension(:), pointer	map,
		integer, intent(in)	ndims )

Allocate and initialize dimension map entries

Parameters

[out]	map	Pointer to allocated map array
[in]	ndims	Number of entries to allocate

Definition at line 655 of file gtdata_internal_map.f90.

    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.

map_apply()

subroutine gtdata_internal_map::map_apply	(	type(gt_variable), intent(inout)	var,
		type(gt_dimmap), dimension(:), pointer	map )

Apply map table to variable

Parameters

[in,out]	var	Variable handle
[in,out]	map	Dimension map to apply (deallocated and replaced)

Definition at line 687 of file gtdata_internal_map.f90.

    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

map_create()

subroutine, public gtdata_internal_map::map_create	(	type(gt_variable), intent(out)	var,
		integer, intent(in)	class,
		integer, intent(in)	cid,
		integer, intent(in)	ndims,
		integer, dimension(:), intent(in)	allcount,
		integer, intent(out)	stat )

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.

Parameters

[out]	var	Created variable handle
[in]	class	Internal class (VTB_CLASS_NETCDF, etc.)
[in]	cid	Internal identifier
[in]	ndims	Number of dimensions
[in]	allcount	Array of dimension lengths
[out]	stat	Status code

Definition at line 246 of file gtdata_internal_map.f90.

    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

References dc_error::dc_noerr, dc_error::gt_enomoredims, map_allocate(), maptabadd(), gtdata_internal_vartable::ndims(), and gtdata_internal_vartable::vartableadd().

Here is the call graph for this function:

map_dup()

subroutine gtdata_internal_map::map_dup	(	type(gt_variable), intent(out)	var,
		type(gt_variable), intent(in)	source_var )

Duplicate a variable

Parameters

[out]	var	Duplicated variable handle
[in]	source_var	Source variable handle to copy

Definition at line 184 of file gtdata_internal_map.f90.

    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/))

References dc_trace::dbgmessage(), map_lookup(), maptabadd(), gtdata_internal_vartable::vartableadd(), and gtdata_internal_vartable::vartablelookup().

Here is the call graph for this function:

map_lookup()

subroutine, public gtdata_internal_map::map_lookup	(	type(gt_variable), intent(in)	var,
		integer, intent(out), optional	vid,
		type(gt_dimmap), dimension(:), intent(out), optional	map,
		integer, intent(out), optional	ndims )

Look up map table entry

Parameters

[in]	var	Variable handle
[out]	vid	Variable table entry ID (optional)
[out]	map	Dimension map array (optional)
[out]	ndims	Number of dimensions (optional)

Definition at line 412 of file gtdata_internal_map.f90.

    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

map_resize()

subroutine gtdata_internal_map::map_resize	(	type(gt_variable), intent(in)	var,
		integer, intent(in)	ndims )

Resize dimension table of variable

Parameters

[in]	var	Variable handle
[in]	ndims	New size of dimension table

Definition at line 728 of file gtdata_internal_map.f90.

    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

References map_allocate().

Here is the call graph for this function:

map_set()

subroutine gtdata_internal_map::map_set	(	type(gt_variable), intent(in)	var,
		type(gt_dimmap), dimension(:), intent(in)	map,
		integer, intent(out)	stat )

Set map table values

Parameters

[in]	var	Variable handle
[in]	map	Dimension map array to set
[out]	stat	Status code

Definition at line 449 of file gtdata_internal_map.f90.

    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

References dc_error::dc_noerr, and dc_error::gt_enomoredims.

map_set_ndims()

subroutine gtdata_internal_map::map_set_ndims	(	type(gt_variable), intent(in)	var,
		integer, intent(in)	ndims,
		integer, intent(out)	stat )

Change number of dimensions of variable

Parameters

[in]	var	Variable handle
[in]	ndims	New number of dimensions
[out]	stat	Status code

Definition at line 509 of file gtdata_internal_map.f90.

    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

References dc_error::dc_noerr, dc_error::gt_enomoredims, and map_lookup().

Here is the call graph for this function:

map_set_rank()

subroutine gtdata_internal_map::map_set_rank	(	type(gt_variable), intent(in)	var,
		integer, intent(in)	rank,
		integer, intent(out)	stat )

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.

Parameters

[in]	var	Variable handle
[in]	rank	Target rank
[out]	stat	Status code

Definition at line 560 of file gtdata_internal_map.f90.

    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

References dc_error::dc_noerr, dc_error::gt_enomoredims, and map_lookup().

Here is the call graph for this function:

map_to_internal_specs()

subroutine, public gtdata_internal_map::map_to_internal_specs	(	type(gt_variable), intent(in)	var,
		integer, dimension(:, :), pointer	specs,
		integer, intent(out), optional	ndims )

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).

Parameters

[in]	var	Variable handle
[out]	specs	Pointer to specs array (allocated internally)
[out]	ndims	Number of internal dimensions (optional)

Definition at line 609 of file gtdata_internal_map.f90.

    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

References map_lookup(), and gtdata_internal_vartable::ndims().

Here is the call graph for this function:

maptabadd()

subroutine, public gtdata_internal_map::maptabadd	(	integer, intent(out)	mapid,
		integer, intent(in)	vid )

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).

Parameters

[out]	mapid	Map table entry ID
[in]	vid	Variable table entry ID

Definition at line 317 of file gtdata_internal_map.f90.

    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

maptabdelete()

subroutine, public gtdata_internal_map::maptabdelete	(	type(gt_variable), intent(in)	var,
		logical, intent(out), optional	err )

Delete variable from map table

Removes variable var from the map table. Does not touch the entity table.

Parameters

[in]	var	Variable handle to delete
[out]	err	Error flag (optional)

Definition at line 374 of file gtdata_internal_map.f90.

    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)

References dc_trace::dbgmessage(), dc_error::dc_noerr, and dc_error::storeerror().

Here is the call graph for this function:

var_class()

subroutine, public gtdata_internal_map::var_class	(	type(gt_variable), intent(in)	var,
		integer, intent(out), optional	class,
		integer, intent(out), optional	cid )

Get internal class and identifier of variable

Parameters

[in]	var	Variable handle
[out]	class	Internal class (optional)
[out]	cid	Internal identifier (optional)

Definition at line 484 of file gtdata_internal_map.f90.

    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)

References map_lookup(), and gtdata_internal_vartable::vartablelookup().

Here is the call graph for this function: