gtvaropenbydimord.f90

subroutine GTVarOpenByDimOrd(var, source_var, dimord, count_compact, err)
  !
  !== gtool4 データのオープン
  !
  ! 既に開かれた変数 *source_var* の *dimord* 番目の次元にあたる変数を
  ! 開き var に格納します。順序 *dimord* は現在の入出力範囲が
  ! 幅１になっている (コンパクト化している) を飛ばした
  ! 順序であすが、*count_compact* に <tt>.true.</tt>を指定すると
  ! すべての次元のなかの順序になります。
  !
  ! Open された変数は必ず Close されなければなりません。
  !
  ! *dimord* == 0 の場合は変数自体を再度開きます。これは参照カウンタを
  ! 増加させる手段です。
  !
  ! *Open* は 2 つのサブルーチンの総称名であり、
  ! 変数 URL を直接指定することで開くことも可能です。
  ! 下記のサブルーチンを参照ください。
  !
  !=== 補足
  !
  ! 変数 URL にファイル名部を指定しない場合、gtool.nc であるとみなされます。
  !
  ! 変数 URL にファイル名だけを指定した場合、開かれる変数は以下の規則
  ! で選択されます。
  !
  ! * 次元変数は選択されない
  ! * なるべく先に定義された変数が選択される
  !
  use gtdata_types, only: GT_VARIABLE
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory,  map_dup, map_create, map_lookup, gt_dimmap,  map_set, dimord_skip_compact
  use an_generic, only: Open, an_variable, inquire
  use gtdata_generic, only: gt_open => open
  use dc_trace, only: beginsub, endsub, DbgMessage
  use dc_string, only: var_str
  use dc_error
  implicit none
  type(GT_VARIABLE), intent(out):: var
  type(GT_VARIABLE), intent(in):: source_var
  integer, intent(in):: dimord
  logical, intent(in), optional:: count_compact
  logical, intent(out), optional:: err
  integer:: sclass, scid, ld, sndims, stat, udimord, idimord
  type(an_variable):: an
  type(gt_dimmap), allocatable:: map_src(:)
  type(gt_dimmap):: map_result(1)
  logical:: cnt_compact
continue
  call beginsub('gtvaropen-by-dimord', 'var.mapid=%d dimord=%d',  i=(/source_var%mapid, dimord/))

  ! 変数それ自体を開き直す処理
  if (dimord == 0) then
    call map_dup(var, source_var)
    if (present(err)) err = .false.
    call endsub('gtvaropen-by-dimord', 'dup')
    return
  endif

  ! 表を引き、dimord 番 (count_compact に注意) の次元の内部変数
  ! 次元番号を調べる。
  call map_lookup(source_var, ndims=sndims)
  if (sndims <= 0 .or. dimord > sndims) then
    stat = gt_enomoredims
    goto 999
  endif
  allocate(map_src(sndims))
  call map_lookup(source_var, map=map_src)
  cnt_compact = .false.
  if (present(count_compact)) cnt_compact = count_compact
  if (cnt_compact) then
    udimord = dimord
  else
    udimord = dimord_skip_compact(dimord, map=map_src)
  endif
  if (udimord <= 0 .or. udimord > size(map_src)) then
    stat = gt_enomoredims
    goto 999
  endif

  idimord = map_src(udimord)%dimno
  if (idimord < 1) then
    call gt_open(var, map_src(udimord)%url, err=err)
    ! storeerror はしなくてよい
    deallocate(map_src)
    goto 1000
  endif

  ! 実態種別に合わせ「次元変数オープン」処理
  call var_class(source_var, sclass, scid)
  if (sclass == vtb_class_netcdf) then
    call Open(an, an_variable(scid), idimord, err)
    call inquire(an, dimlen=ld)
    call map_create(var, vtb_class_netcdf, an%id, 1, (/ld/))
    call map_lookup(var, map=map_result)
    map_result(1)%offset = map_src(udimord)%offset
    map_result(1)%step = map_src(udimord)%step
    map_result(1)%allcount = map_src(udimord)%allcount
    map_result(1)%start = map_src(udimord)%start
    map_result(1)%count = map_src(udimord)%count
    map_result(1)%stride = map_src(udimord)%stride
    call map_set(var, map=map_result, stat=stat)
  else if (sclass == vtb_class_memory) then
    var = source_var
    stat = dc_noerr
  else
    stat = gt_efake
  endif

  deallocate(map_src)
999 continue
  call StoreError(stat, "gtvaropen-by-dimord", cause_i=dimord)
1000 continue
  call endsub('gtvaropen-by-dimord', 'result_var=%d', i=(/var%mapid/))
end subroutine GTVarOpenByDimOrd