! 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, 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