gtool5 Fortran 90/95 ライブラリ 1.0.0-rc5
English
Loading...
Searching...
No Matches
Functions/Subroutines
gtvaradddim.f90 File Reference

次元の追加 More...

Go to the source code of this file.

Functions/Subroutines

subroutine gtvaradddim (var, dimord, dimvar, err)
 

Detailed Description

次元の追加

Author
Eizi TOYODA, Yasuhiro MORIKAWA

Definition in file gtvaradddim.f90.

Function/Subroutine Documentation

◆ gtvaradddim()

subroutine gtvaradddim ( type(gt_variable), intent(in)  var,
integer, intent(in)  dimord,
type(gt_variable), intent(in)  dimvar,
logical, intent(out)  err 
)

変数に次元を追加

変数 var の dimord 番目の位置に次元 dimvar を追加します。 dimord 番目以降の次元は 1 つ後ろにずれます。 もし dimord が var の有効次元数よりも大きい場合、 (有効次元数 + 1) が与えられたものと見なされます。

エラーが生じた場合、メッセージを出力してプログラムは強制終了します。 err を与えてある場合にはの引数に .true. が返り、プログラムは終了しません。

Parameters
[in]var変数ハンドル
[in]dimord挿入位置の次元順序番号
[in]dimvar追加する次元変数
[out]errエラーフラグ

Definition at line 55 of file gtvaradddim.f90.

56 use gtdata_types, only: gt_variable
57 use gtdata_generic, only: inquire
60 implicit none
61 type(GT_VARIABLE), intent(in):: var
62 type(GT_VARIABLE), intent(in):: dimvar
63 integer, intent(in):: dimord
64 logical, intent(out):: err
65 type(gt_dimmap), pointer:: map(:)
66 type(gt_dimmap):: tmpmap
67 integer:: id, nd, ndimsp, stat, vid
68 character(*), parameter:: subname = 'GTVarAddDim'
69continue
70 err = .true.
71 call beginsub(subname)
72
73 if (dimord < 1) then
74 call endsub(subname, "negative dimord=%d invalid", i=(/dimord/))
75 return
76 endif
77
78 ! dimvar をチェックしマップ設定を tmpmap に保存
79 call map_lookup(dimvar, vid=vid, ndims=nd)
80 if (vid < 0) then
81 call endsub(subname, "dimvar invalid")
82 return
83 endif
84 if (nd <= 0) then
85 call endsub(subname, "dimvar nondimensional")
86 return
87 else if (nd > 1) then
88 call endsub(subname, "dimvar multidimensional")
89 return
90 endif
91 allocate(map(nd))
92 call map_lookup(dimvar, map=map)
93 tmpmap = map(1)
94 deallocate(map)
95
96 ! dimord 番目 (ただし ndimsp + 1 を越えない) に挿入する隙間をあける
97 call map_lookup(var, ndims=ndimsp)
98 if (dimord > ndimsp + 1) then
99 id = ndimsp + 1
100 else
101 id = dimord
102 endif
103 allocate(map(nd + 1))
104 call map_resize(var, nd + 1)
105 call map_lookup(var, map=map)
106 map(id+1: nd+1) = map(id: nd)
107
108 ! 新しい次元への参照を挿入
109 map(id)%dimno = -1
110 call inquire(dimvar, url=map(id)%url)
111 map(id)%allcount = tmpmap%allcount
112 map(id)%offset = tmpmap%offset
113 map(id)%step = tmpmap%step
114 map(id)%start = tmpmap%start
115 map(id)%count = tmpmap%count
116 map(id)%stride = tmpmap%stride
117
118 ! 登録
119 call map_set(var, map=map, stat=stat)
120 if (stat /= 0) goto 999
121 call map_set_ndims(var, ndims=ndimsp + 1, stat=stat)
122
123999 continue
124 err = (stat /= 0)
125 call endsub(subname)
デバッグ時の追跡用モジュール
Definition dc_trace.f90:150
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
Definition dc_trace.f90:661
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
Definition dc_trace.f90:457
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Definition dc_trace.f90:580
subroutine, public map_lookup(var, vid, map, ndims)
subroutine map_set_ndims(var, ndims, stat)
subroutine map_set(var, map, stat)
subroutine map_resize(var, ndims)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_trace::endsub(), gtdata_internal_map::map_lookup(), gtdata_internal_map::map_resize(), gtdata_internal_map::map_set(), and gtdata_internal_map::map_set_ndims().

Here is the call graph for this function: