Opens the variable corresponding to the dimord-th dimension of already-opened variable source_var and stores it in var. The order dimord skips dimensions with width 1 (compacted), but if count_compact is set to .true., all dimensions are counted.
Variables opened with Open must always be closed with Close.
When dimord == 0, the variable itself is reopened, incrementing the reference counter.
Open is a generic name for 2 subroutines; it is also possible to open by specifying the variable URL directly.
81 implicit none
82 type(GT_VARIABLE), intent(out):: var
83 type(GT_VARIABLE), intent(in):: source_var
84 integer, intent(in):: dimord
85 logical, intent(in), optional:: count_compact
86 logical, intent(in), optional:: inherit_slice
87 logical, intent(out), optional:: err
88 integer:: sclass, scid, ld, sndims, stat, udimord, idimord, cause_i
89 type(GD_NC_VARIABLE):: gdnc
90 type(GT_DIMMAP), allocatable:: map_src(:)
91 type(GT_DIMMAP):: map_result(1)
92 logical:: cnt_compact, keep_slice
93 character(STRING) :: endsub_msg
94 character(len = *), parameter:: subname = "GTVarOpen-By-Dimord"
95 character(len = *), parameter:: version = &
96 & '$Name: $' // &
97 & '$Id: gtvaropenbydimord.f90,v 1.5 2009-07-04 04:58:06 morikawa Exp $'
98continue
99 call beginsub(subname,
'var.mapid=%d dimord=%d ', &
100 & i=(/source_var%mapid, dimord/), version=version)
102 cause_i = dimord
103 endsub_msg = ''
104
105
106 if (dimord == 0) then
108 if (present(err)) err = .false.
109 endsub_msg = 'dup'
110 goto 999
111 endif
112
113
114
116 if (sndims <= 0 .or. dimord > sndims) then
118 goto 999
119 endif
120 allocate(map_src(sndims))
122 cnt_compact = .false.
124 cnt_compact = .true.
125 else
126 cnt_compact = .false.
127 end if
128 keep_slice = .true.
130 keep_slice = .false.
131 end if
132 call dbgmessage(
'count_compact=%y', l=(/cnt_compact/))
133
134 if (cnt_compact) then
135 udimord = dimord
136 else
138 endif
139 if (udimord <= 0 .or. udimord > size(map_src)) then
141 goto 999
142 endif
143
144 idimord = map_src(udimord)%dimno
145 if (idimord < 1) then
146 call gt_open(var, map_src(udimord)%url, err=err)
147
148 deallocate(map_src)
149 goto 999
150 endif
151
152
154 if (sclass == vtb_class_netcdf) then
157 call map_create(var, vtb_class_netcdf, gdnc%id, 1, (/ld/), stat)
159 cause_i = 1
160 goto 999
161 end if
163 map_result(1)%offset = map_src(udimord)%offset
164 map_result(1)%step = map_src(udimord)%step
165 map_result(1)%allcount = map_src(udimord)%allcount
166 if (keep_slice) then
167 map_result(1)%start = map_src(udimord)%start
168 map_result(1)%count = map_src(udimord)%count
169 map_result(1)%stride = map_src(udimord)%stride
170 else
171 map_result(1)%start = 1
172 map_result(1)%count = map_src(udimord)%allcount
173 map_result(1)%stride = 1
174 end if
175 call map_set(var, map=map_result, stat=stat)
176 else
178 endif
179
180 deallocate(map_src)
181 endsub_msg =
cprintf(
'result_var=%d', i=(/var%mapid/))
182999 continue
183 call storeerror(stat, subname, cause_i=cause_i, err=err)
184 call endsub(subname,
'%c', c1=trim(endsub_msg))
Basic open/close operations
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_noerr
Error storage variables
integer, parameter, public gt_efake
Positive error numbers are reserved for libc system error messages. Due to high system dependency and...
integer, parameter, public gt_enomoredims
-101 or less: Data structure errors
Judge optional control parameters.
logical function, public present_and_false(arg)
logical function, public present_and_true(arg)
Handling character types.
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)
Provides kind type parameter values.
integer, parameter, public string
Character length for string
subroutine, public map_lookup(var, vid, map, ndims)
subroutine map_set(var, map, stat)
integer function dimord_skip_compact(dimord, map)
subroutine, public var_class(var, class, cid)
subroutine, public map_create(var, class, cid, ndims, allcount, stat)
subroutine map_dup(var, source_var)