gtvaropenbydimord.f90

Path: src/gtvaropenbydimord.f90
Last Update: Wed Jul 20 18:22:24 JST 2005

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 に真を指定すると すべての次元のなかの順序になる。

Methods

GTVarOpenByDimOrd  

Included Modules

gtdata_types gt_map an_generic gtdata_generic dc_trace dc_string dc_error

Public Instance methods

GTVarOpenByDimOrd(var, source_var, dimord, count_compact, err)
var :type(GT_VARIABLE), intent(out)
source_var :type(GT_VARIABLE), intent(in)
dimord :integer, intent(in)
count_compact :logical, intent(in), optional
err :logical, intent(out), optional

[Source]

subroutine GTVarOpenByDimOrd(var, source_var, dimord, count_compact, err)

    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

[Validate]