Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
xt_idxvec_f.f90
Go to the documentation of this file.
1
13
14!
15! Keywords:
16! Maintainer: Jörg Behrens <behrens@dkrz.de>
17! Moritz Hanke <hanke@dkrz.de>
18! Thomas Jahns <jahns@dkrz.de>
19! URL: https://dkrz-sw.gitlab-pages.dkrz.de/yaxt/
20!
21! Redistribution and use in source and binary forms, with or without
22! modification, are permitted provided that the following conditions are
23! met:
24!
25! Redistributions of source code must retain the above copyright notice,
26! this list of conditions and the following disclaimer.
27!
28! Redistributions in binary form must reproduce the above copyright
29! notice, this list of conditions and the following disclaimer in the
30! documentation and/or other materials provided with the distribution.
31!
32! Neither the name of the DKRZ GmbH nor the names of its contributors
33! may be used to endorse or promote products derived from this software
34! without specific prior written permission.
35!
36! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
37! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
38! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
39! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
40! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
41! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
42! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
43! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
44! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
45! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
46! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
47!
48#include "fc_feature_defs.inc"
49MODULE xt_idxvec
50 USE xt_core, ONLY: i2, i4, i8, xt_int_kind, xt_abort, xt_stripe
51 USE xt_idxlist_abstract, ONLY: xt_idxlist, xt_idxlist_c2f
52 use, INTRINSIC :: iso_c_binding, only: c_ptr, c_int
53 IMPLICIT NONE
54 PRIVATE
55 INTERFACE xt_idxvec_new
56 MODULE PROCEDURE xt_idxvec_new_a1d
57 MODULE PROCEDURE xt_idxvec_new_a1d_i2
58 MODULE PROCEDURE xt_idxvec_new_a1d_i4
59 MODULE PROCEDURE xt_idxvec_new_a1d_i8
60 MODULE PROCEDURE xt_idxvec_new_a2d
61 MODULE PROCEDURE xt_idxvec_new_a2d_i2
62 MODULE PROCEDURE xt_idxvec_new_a2d_i4
63 MODULE PROCEDURE xt_idxvec_new_a2d_i8
64 MODULE PROCEDURE xt_idxvec_new_a3d
65 MODULE PROCEDURE xt_idxvec_new_a3d_i2
66 MODULE PROCEDURE xt_idxvec_new_a3d_i4
67 MODULE PROCEDURE xt_idxvec_new_a3d_i8
68 MODULE PROCEDURE xt_idxvec_new_a4d
69 MODULE PROCEDURE xt_idxvec_new_a4d_i2
70 MODULE PROCEDURE xt_idxvec_new_a4d_i4
71 MODULE PROCEDURE xt_idxvec_new_a4d_i8
72 MODULE PROCEDURE xt_idxvec_new_a5d
73 MODULE PROCEDURE xt_idxvec_new_a5d_i2
74 MODULE PROCEDURE xt_idxvec_new_a5d_i4
75 MODULE PROCEDURE xt_idxvec_new_a5d_i8
76 MODULE PROCEDURE xt_idxvec_new_a6d
77 MODULE PROCEDURE xt_idxvec_new_a6d_i2
78 MODULE PROCEDURE xt_idxvec_new_a6d_i4
79 MODULE PROCEDURE xt_idxvec_new_a6d_i8
80 MODULE PROCEDURE xt_idxvec_new_a7d
81 MODULE PROCEDURE xt_idxvec_new_a7d_i2
82 MODULE PROCEDURE xt_idxvec_new_a7d_i4
83 MODULE PROCEDURE xt_idxvec_new_a7d_i8
84 END INTERFACE xt_idxvec_new
85
87 MODULE PROCEDURE xt_idxvec_from_stripes_new_a
88 MODULE PROCEDURE xt_idxvec_from_stripes_new_a_i2
89 MODULE PROCEDURE xt_idxvec_from_stripes_new_a_i4
90 MODULE PROCEDURE xt_idxvec_from_stripes_new_a_i8
91 END INTERFACE xt_idxvec_from_stripes_new
92
94
95 INTERFACE
96 FUNCTION xt_idxvec_new_c(idxvec, num_indices) &
97 bind(c, name='xt_idxvec_new') result(res_ptr)
98 IMPORT :: xt_int_kind, c_ptr, c_int
99 IMPLICIT NONE
100 INTEGER(xt_int_kind), INTENT(in) :: idxvec(*)
101 INTEGER(c_int), VALUE, INTENT(in) :: num_indices
102 TYPE(c_ptr) :: res_ptr
103 END FUNCTION xt_idxvec_new_c
104
105 FUNCTION xt_idxvec_from_stripes_new_c(stripes, num_stripes) &
106 bind(c, name='xt_idxvec_from_stripes_new') result(res_ptr)
107 IMPORT :: xt_stripe, c_int, c_ptr
108 IMPLICIT NONE
109 TYPE(xt_stripe), INTENT(in) :: stripes(*)
110 INTEGER(c_int), VALUE, INTENT(in) :: num_stripes
111 TYPE(c_ptr) :: res_ptr
112 END FUNCTION xt_idxvec_from_stripes_new_c
113 END INTERFACE
114
115 CHARACTER(len=*), PARAMETER :: filename = 'xt_idxvec_f.f90'
116CONTAINS
117
118 FUNCTION xt_idxvec_new_a1d(idxvec) RESULT(res)
119 INTEGER(xt_int_kind), INTENT(in) :: idxvec(:)
120 TYPE(xt_idxlist) :: res
121
122 INTEGER(xt_int_kind) :: idxvec_dummy(1)
123 INTEGER(c_int) :: num_indices_c
124 IF (SIZE(idxvec) > huge(num_indices_c)) &
125 CALL xt_abort("too many idxvec elements", filename, __line__)
126 num_indices_c = int(SIZE(idxvec), c_int)
127 IF (num_indices_c > 0_c_int) THEN
128 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
129 ELSE
130 idxvec_dummy(1) = huge(idxvec_dummy)
131 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
132 END IF
133 END FUNCTION xt_idxvec_new_a1d
134
135 FUNCTION xt_idxvec_new_a1d_i2(idxvec, num_indices) RESULT(res)
136 INTEGER(xt_int_kind), INTENT(in) :: idxvec(*)
137 INTEGER(i2), VALUE, INTENT(in) :: num_indices
138 TYPE(xt_idxlist) :: res
139 INTEGER(c_int) :: num_indices_c
140
141 num_indices_c = int(num_indices, c_int)
142 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
143 END FUNCTION xt_idxvec_new_a1d_i2
144
145 FUNCTION xt_idxvec_new_a1d_i4(idxvec, num_indices) RESULT(res)
146 INTEGER(xt_int_kind), INTENT(in) :: idxvec(*)
147 INTEGER(i4), VALUE, INTENT(in) :: num_indices
148 TYPE(xt_idxlist) :: res
149 INTEGER(c_int) :: num_indices_c
150
151 IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
152 CALL xt_abort("too many idxvec elements", filename, __line__)
153 num_indices_c = int(num_indices, c_int)
154 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
155 END FUNCTION xt_idxvec_new_a1d_i4
156
157 FUNCTION xt_idxvec_new_a1d_i8(idxvec, num_indices) RESULT(res)
158 INTEGER(xt_int_kind), INTENT(in) :: idxvec(*)
159 INTEGER(i8), VALUE, INTENT(in) :: num_indices
160 TYPE(xt_idxlist) :: res
161 INTEGER(c_int) :: num_indices_c
162
163 IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
164 CALL xt_abort("too many idxvec elements", filename, __line__)
165 num_indices_c = int(num_indices, c_int)
166 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
167 END FUNCTION xt_idxvec_new_a1d_i8
168
169 FUNCTION xt_idxvec_new_a2d(idxvec) RESULT(res)
170 INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:)
171 TYPE(xt_idxlist) :: res
172 INTEGER(xt_int_kind) :: idxvec_dummy(1)
173 INTEGER(c_int) :: num_indices_c
174 IF (SIZE(idxvec) > huge(num_indices_c)) &
175 CALL xt_abort("too many idxvec elements", filename, __line__)
176 num_indices_c = int(SIZE(idxvec), c_int)
177 IF (num_indices_c > 0_c_int) THEN
178 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
179 ELSE
180 idxvec_dummy(1) = huge(idxvec_dummy)
181 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
182 END IF
183 END FUNCTION xt_idxvec_new_a2d
184
185 FUNCTION xt_idxvec_new_a2d_i2(idxvec, num_indices) RESULT(res)
186 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,*)
187 INTEGER(i2), VALUE, INTENT(in) :: num_indices
188 TYPE(xt_idxlist) :: res
189 INTEGER(c_int) :: num_indices_c
190
191 num_indices_c = int(num_indices, c_int)
192 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
193 END FUNCTION xt_idxvec_new_a2d_i2
194
195 FUNCTION xt_idxvec_new_a2d_i4(idxvec, num_indices) RESULT(res)
196 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,*)
197 INTEGER(i4), VALUE, INTENT(in) :: num_indices
198 TYPE(xt_idxlist) :: res
199 INTEGER(c_int) :: num_indices_c
200
201 IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
202 CALL xt_abort("too many idxvec elements", filename, __line__)
203 num_indices_c = int(num_indices, c_int)
204 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
205 END FUNCTION xt_idxvec_new_a2d_i4
206
207 FUNCTION xt_idxvec_new_a2d_i8(idxvec, num_indices) RESULT(res)
208 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,*)
209 INTEGER(i8), VALUE, INTENT(in) :: num_indices
210 TYPE(xt_idxlist) :: res
211 INTEGER(c_int) :: num_indices_c
212
213 IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
214 CALL xt_abort("too many idxvec elements", filename, __line__)
215 num_indices_c = int(num_indices, c_int)
216 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
217 END FUNCTION xt_idxvec_new_a2d_i8
218
219 FUNCTION xt_idxvec_new_a3d(idxvec) RESULT(res)
220 INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:)
221 TYPE(xt_idxlist) :: res
222
223 INTEGER(xt_int_kind) :: idxvec_dummy(1)
224 INTEGER(c_int) :: num_indices_c
225 IF (SIZE(idxvec) > huge(num_indices_c)) &
226 CALL xt_abort("too many idxvec elements", filename, __line__)
227 num_indices_c = int(SIZE(idxvec), c_int)
228 IF (num_indices_c > 0_c_int) THEN
229 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
230 ELSE
231 idxvec_dummy(1) = huge(idxvec_dummy)
232 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
233 END IF
234 END FUNCTION xt_idxvec_new_a3d
235
236 FUNCTION xt_idxvec_new_a3d_i2(idxvec, num_indices) RESULT(res)
237 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,*)
238 INTEGER(i2), VALUE, INTENT(in) :: num_indices
239 TYPE(xt_idxlist) :: res
240 INTEGER(c_int) :: num_indices_c
241 num_indices_c = int(num_indices, c_int)
242 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
243 END FUNCTION xt_idxvec_new_a3d_i2
244
245 FUNCTION xt_idxvec_new_a3d_i4(idxvec, num_indices) RESULT(res)
246 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,*)
247 INTEGER(i4), VALUE, INTENT(in) :: num_indices
248 TYPE(xt_idxlist) :: res
249 INTEGER(c_int) :: num_indices_c
250 IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
251 CALL xt_abort("too many idxvec elements", filename, __line__)
252 num_indices_c = int(num_indices, c_int)
253 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
254 END FUNCTION xt_idxvec_new_a3d_i4
255
256 FUNCTION xt_idxvec_new_a3d_i8(idxvec, num_indices) RESULT(res)
257 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,*)
258 INTEGER(i8), VALUE, INTENT(in) :: num_indices
259 TYPE(xt_idxlist) :: res
260 INTEGER(c_int) :: num_indices_c
261 IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
262 CALL xt_abort("too many idxvec elements", filename, __line__)
263 num_indices_c = int(num_indices, c_int)
264 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
265 END FUNCTION xt_idxvec_new_a3d_i8
266
267 FUNCTION xt_idxvec_new_a4d(idxvec) RESULT(res)
268 INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:)
269 TYPE(xt_idxlist) :: res
270
271 INTEGER(xt_int_kind) :: idxvec_dummy(1)
272 INTEGER(c_int) :: num_indices
273 IF (SIZE(idxvec) > huge(num_indices)) &
274 CALL xt_abort("too many idxvec elements", filename, __line__)
275 num_indices = int(SIZE(idxvec), c_int)
276 IF (num_indices > 0) THEN
277 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices))
278 ELSE
279 idxvec_dummy(1) = huge(idxvec_dummy)
280 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices))
281 END IF
282 END FUNCTION xt_idxvec_new_a4d
283
284 FUNCTION xt_idxvec_new_a4d_i2(idxvec, num_indices) RESULT(res)
285 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,*)
286 INTEGER(i2), VALUE, INTENT(in) :: num_indices
287 TYPE(xt_idxlist) :: res
288 INTEGER(c_int) :: num_indices_c
289
290 num_indices_c = int(num_indices, c_int)
291 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
292 END FUNCTION xt_idxvec_new_a4d_i2
293
294 FUNCTION xt_idxvec_new_a4d_i4(idxvec, num_indices) RESULT(res)
295 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,*)
296 INTEGER(i4), VALUE, INTENT(in) :: num_indices
297 TYPE(xt_idxlist) :: res
298 INTEGER(c_int) :: num_indices_c
299
300 IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
301 CALL xt_abort("too many idxvec elements", filename, __line__)
302 num_indices_c = int(num_indices, c_int)
303 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
304 END FUNCTION xt_idxvec_new_a4d_i4
305
306 FUNCTION xt_idxvec_new_a4d_i8(idxvec, num_indices) RESULT(res)
307 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,*)
308 INTEGER(i8), VALUE, INTENT(in) :: num_indices
309 TYPE(xt_idxlist) :: res
310 INTEGER(c_int) :: num_indices_c
311
312 IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
313 CALL xt_abort("too many idxvec elements", filename, __line__)
314 num_indices_c = int(num_indices, c_int)
315 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
316 END FUNCTION xt_idxvec_new_a4d_i8
317
318 FUNCTION xt_idxvec_new_a5d(idxvec) RESULT(res)
319 INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:,:)
320 TYPE(xt_idxlist) :: res
321
322 INTEGER(xt_int_kind) :: idxvec_dummy(1)
323 INTEGER(c_int) :: num_indices_c
324 IF (SIZE(idxvec) > huge(num_indices_c)) &
325 CALL xt_abort("too many idxvec elements", filename, __line__)
326 num_indices_c = int(SIZE(idxvec), c_int)
327 IF (num_indices_c > 0_c_int) THEN
328 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
329 ELSE
330 idxvec_dummy(1) = huge(idxvec_dummy)
331 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
332 END IF
333 END FUNCTION xt_idxvec_new_a5d
334
335 FUNCTION xt_idxvec_new_a5d_i2(idxvec, num_indices) RESULT(res)
336 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,*)
337 INTEGER(i2), VALUE, INTENT(in) :: num_indices
338 TYPE(xt_idxlist) :: res
339 INTEGER(c_int) :: num_indices_c
340
341 num_indices_c = int(num_indices, c_int)
342 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
343
344 END FUNCTION xt_idxvec_new_a5d_i2
345
346 FUNCTION xt_idxvec_new_a5d_i4(idxvec, num_indices) RESULT(res)
347 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,*)
348 INTEGER(i4), VALUE, INTENT(in) :: num_indices
349 TYPE(xt_idxlist) :: res
350 INTEGER(c_int) :: num_indices_c
351
352 IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
353 CALL xt_abort("too many idxvec elements", filename, __line__)
354 num_indices_c = int(num_indices, c_int)
355 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
356 END FUNCTION xt_idxvec_new_a5d_i4
357
358 FUNCTION xt_idxvec_new_a5d_i8(idxvec, num_indices) RESULT(res)
359 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,*)
360 INTEGER(i8), VALUE, INTENT(in) :: num_indices
361 TYPE(xt_idxlist) :: res
362 INTEGER(c_int) :: num_indices_c
363
364 IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
365 CALL xt_abort("too many idxvec elements", filename, __line__)
366 num_indices_c = int(num_indices, c_int)
367 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
368 END FUNCTION xt_idxvec_new_a5d_i8
369
370 FUNCTION xt_idxvec_new_a6d(idxvec) RESULT(res)
371 INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:,:,:)
372 TYPE(xt_idxlist) :: res
373
374 INTEGER(xt_int_kind) :: idxvec_dummy(1)
375 INTEGER(c_int) :: num_indices_c
376
377 IF (SIZE(idxvec) > huge(num_indices_c)) &
378 CALL xt_abort("too many idxvec elements", filename, __line__)
379 num_indices_c = int(SIZE(idxvec), c_int)
380 IF (num_indices_c > 0_c_int) THEN
381 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
382 ELSE
383 idxvec_dummy(1) = huge(idxvec_dummy)
384 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
385 END IF
386 END FUNCTION xt_idxvec_new_a6d
387
388 FUNCTION xt_idxvec_new_a6d_i2(idxvec, num_indices) RESULT(res)
389 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,*)
390 INTEGER(i2), VALUE, INTENT(in) :: num_indices
391
392 TYPE(xt_idxlist) :: res
393 INTEGER(c_int) :: num_indices_c
394
395 num_indices_c = int(num_indices, c_int)
396 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
397 END FUNCTION xt_idxvec_new_a6d_i2
398
399 FUNCTION xt_idxvec_new_a6d_i4(idxvec, num_indices) RESULT(res)
400 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,*)
401 INTEGER(i4), VALUE, INTENT(in) :: num_indices
402 TYPE(xt_idxlist) :: res
403 INTEGER(c_int) :: num_indices_c
404
405 IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
406 CALL xt_abort("too many idxvec elements", filename, __line__)
407 num_indices_c = int(num_indices, c_int)
408 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
409 END FUNCTION xt_idxvec_new_a6d_i4
410
411 FUNCTION xt_idxvec_new_a6d_i8(idxvec, num_indices) RESULT(res)
412 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,*)
413 INTEGER(i8), VALUE, INTENT(in) :: num_indices
414 TYPE(xt_idxlist) :: res
415 INTEGER(c_int) :: num_indices_c
416
417 IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
418 CALL xt_abort("too many idxvec elements", filename, __line__)
419 num_indices_c = int(num_indices, c_int)
420 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
421 END FUNCTION xt_idxvec_new_a6d_i8
422
423 FUNCTION xt_idxvec_new_a7d(idxvec) RESULT(res)
424 INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:,:,:,:)
425 TYPE(xt_idxlist) :: res
426
427 INTEGER(xt_int_kind) :: idxvec_dummy(1)
428 INTEGER(c_int) :: num_indices_c
429 IF (SIZE(idxvec) > huge(num_indices_c)) &
430 CALL xt_abort("too many idxvec elements", filename, __line__)
431 num_indices_c = int(SIZE(idxvec), c_int)
432 IF (num_indices_c > 0_c_int) THEN
433 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
434 ELSE
435 idxvec_dummy(1) = huge(idxvec_dummy)
436 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
437 END IF
438 END FUNCTION xt_idxvec_new_a7d
439
440 FUNCTION xt_idxvec_new_a7d_i2(idxvec, num_indices) RESULT(res)
441 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,1,*)
442 INTEGER(i2), VALUE, INTENT(in) :: num_indices
443 TYPE(xt_idxlist) :: res
444 INTEGER(c_int) :: num_indices_c
445
446 num_indices_c = int(num_indices, c_int)
447 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
448 END FUNCTION xt_idxvec_new_a7d_i2
449
450 FUNCTION xt_idxvec_new_a7d_i4(idxvec, num_indices) RESULT(res)
451 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,1,*)
452 INTEGER(i4), VALUE, INTENT(in) :: num_indices
453 TYPE(xt_idxlist) :: res
454 INTEGER(c_int) :: num_indices_c
455
456 IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
457 CALL xt_abort("too many idxvec elements", filename, __line__)
458 num_indices_c = int(num_indices, c_int)
459 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
460 END FUNCTION xt_idxvec_new_a7d_i4
461
462 FUNCTION xt_idxvec_new_a7d_i8(idxvec, num_indices) RESULT(res)
463 INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,1,*)
464 INTEGER(i8), VALUE, INTENT(in) :: num_indices
465 TYPE(xt_idxlist) :: res
466 INTEGER(c_int) :: num_indices_c
467
468 IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
469 CALL xt_abort("too many idxvec elements", filename, __line__)
470 num_indices_c = int(num_indices, c_int)
471 res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
472 END FUNCTION xt_idxvec_new_a7d_i8
473
474 FUNCTION xt_idxvec_from_stripes_new_a(stripes) RESULT(res)
475 TYPE(xt_stripe), INTENT(in) :: stripes(:)
476 TYPE(xt_idxlist) :: res
477 INTEGER(c_int) :: num_stripes_c
478 num_stripes_c = int(SIZE(stripes), c_int)
479 res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
480 END FUNCTION xt_idxvec_from_stripes_new_a
481
482 FUNCTION xt_idxvec_from_stripes_new_a_i2(stripes, num_stripes) RESULT(res)
483 TYPE(xt_stripe), INTENT(in) :: stripes(*)
484 INTEGER(i2), INTENT(in) :: num_stripes
485 TYPE(xt_idxlist) :: res
486 INTEGER(c_int) :: num_stripes_c
487 num_stripes_c = int(num_stripes, c_int)
488 res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
489 END FUNCTION xt_idxvec_from_stripes_new_a_i2
490
491 FUNCTION xt_idxvec_from_stripes_new_a_i4(stripes, num_stripes) RESULT(res)
492 TYPE(xt_stripe), INTENT(in) :: stripes(*)
493 INTEGER(i4), INTENT(in) :: num_stripes
494 TYPE(xt_idxlist) :: res
495 INTEGER(c_int) :: num_stripes_c
496
497 IF (i4 /= c_int .AND. num_stripes > huge(1_c_int)) &
498 CALL xt_abort("too many stripes", filename, __line__)
499 num_stripes_c = int(num_stripes, c_int)
500 res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
501 END FUNCTION xt_idxvec_from_stripes_new_a_i4
502
503 FUNCTION xt_idxvec_from_stripes_new_a_i8(stripes, num_stripes) RESULT(res)
504 TYPE(xt_stripe), INTENT(in) :: stripes(*)
505 INTEGER(i8), INTENT(in) :: num_stripes
506 TYPE(xt_idxlist) :: res
507 INTEGER(c_int) :: num_stripes_c
508
509 IF (i8 /= c_int .AND. num_stripes > huge(1_c_int)) &
510 CALL xt_abort("too many stripes", filename, __line__)
511 num_stripes_c = int(num_stripes, c_int)
512 res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
513 END FUNCTION xt_idxvec_from_stripes_new_a_i8
514
515END MODULE xt_idxvec
516!
517! Local Variables:
518! f90-continuation-indent: 5
519! coding: utf-8
520! indent-tabs-mode: nil
521! show-trailing-whitespace: t
522! require-trailing-newline: t
523! End:
524!
Xt_idxlist xt_idxvec_from_stripes_new(const struct Xt_stripe *stripes, int num_stripes)
Xt_idxlist xt_idxvec_new(const Xt_int *idxlist, int num_indices)
Definition xt_idxvec.c:213