! gtvaropenbydimord.f90 - open(GT_VARIABLE, GT_VARIABLE, integer)
! Copyright (C) GFD Dennou Club, 2000.  All rights reserved
!
! open(dimvar, var, dimord, [count_compact], [err]) は
! 既に開かれた変数 var の ord 番目の次元にあたる変数を
! 開き dimvar に格納する。
! 順序 dimord は現在の入出力範囲が
! 幅 1 になっている (コンパクト化している）を飛ばした
! 順序であるが、count_compact に真を指定すると
! すべての次元のなかの順序になる。
!
subroutine GTVarOpenByDimOrd(var, source_var, dimord, count_compact, err)
    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, message
    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
