変数 var の dimord 番目の位置に次元 dimvar を追加します。 dimord 番目以降の次元は 1 つ後ろにずれます。 もし dimord が var の有効次元数よりも大きい場合、 (有効次元数 + 1) が与えられたものと見なされます。
エラーが生じた場合、メッセージを出力してプログラムは強制終了します。 err を与えてある場合にはの引数に .true. が返り、プログラムは終了しません。
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.
72
73 if (dimord < 1) then
74 call endsub(subname,
"negative dimord=%d invalid", i=(/dimord/))
75 return
76 endif
77
78
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))
93 tmpmap = map(1)
94 deallocate(map)
95
96
98 if (dimord > ndimsp + 1) then
99 id = ndimsp + 1
100 else
101 id = dimord
102 endif
103 allocate(map(nd + 1))
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
122
123999 continue
124 err = (stat /= 0)
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
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)