Yet Another eXchange Tool  DO_NOT_EDIT_HERE
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://doc.redmine.dkrz.de/yaxt/html/
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 MODULE xt_idxvec
49  USE xt_core, ONLY: i2, i4, i8, xt_int_kind, xt_abort, xt_stripe, &
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 CONTAINS
116 
117  FUNCTION xt_idxvec_new_a1d(idxvec) RESULT(res)
118  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:)
119  TYPE(xt_idxlist) :: res
120 
121  INTEGER(xt_int_kind) :: idxvec_dummy(1)
122  INTEGER(c_int) :: num_indices_c
123  IF (SIZE(idxvec) > huge(num_indices_c)) &
124  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
125  __file__, &
126  __line__)
127  num_indices_c = int(SIZE(idxvec), c_int)
128  IF (num_indices_c > 0_c_int) THEN
129  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
130  ELSE
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(xt_get_default_comm(), "too many idxvec elements", &
153  __file__, &
154  __line__)
155  num_indices_c = int(num_indices, c_int)
156  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
157  END FUNCTION xt_idxvec_new_a1d_i4
158 
159  FUNCTION xt_idxvec_new_a1d_i8(idxvec, num_indices) RESULT(res)
160  INTEGER(xt_int_kind), INTENT(in) :: idxvec(*)
161  INTEGER(i8), VALUE, INTENT(in) :: num_indices
162  TYPE(xt_idxlist) :: res
163  INTEGER(c_int) :: num_indices_c
164 
165  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
166  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
167  __file__, &
168  __line__)
169  num_indices_c = int(num_indices, c_int)
170  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
171  END FUNCTION xt_idxvec_new_a1d_i8
172 
173  FUNCTION xt_idxvec_new_a2d(idxvec) RESULT(res)
174  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:)
175  TYPE(xt_idxlist) :: res
176  INTEGER(xt_int_kind) :: idxvec_dummy(1)
177  INTEGER(c_int) :: num_indices_c
178  IF (SIZE(idxvec) > huge(num_indices_c)) &
179  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
180  __file__, &
181  __line__)
182  num_indices_c = int(SIZE(idxvec), c_int)
183  IF (num_indices_c > 0_c_int) THEN
184  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
185  ELSE
186  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
187  END IF
188  END FUNCTION xt_idxvec_new_a2d
189 
190  FUNCTION xt_idxvec_new_a2d_i2(idxvec, num_indices) RESULT(res)
191  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,*)
192  INTEGER(i2), VALUE, INTENT(in) :: num_indices
193  TYPE(xt_idxlist) :: res
194  INTEGER(c_int) :: num_indices_c
195 
196  num_indices_c = int(num_indices, c_int)
197  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
198  END FUNCTION xt_idxvec_new_a2d_i2
199 
200  FUNCTION xt_idxvec_new_a2d_i4(idxvec, num_indices) RESULT(res)
201  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,*)
202  INTEGER(i4), VALUE, INTENT(in) :: num_indices
203  TYPE(xt_idxlist) :: res
204  INTEGER(c_int) :: num_indices_c
205 
206  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
207  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
208  __file__, &
209  __line__)
210  num_indices_c = int(num_indices, c_int)
211  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
212  END FUNCTION xt_idxvec_new_a2d_i4
213 
214  FUNCTION xt_idxvec_new_a2d_i8(idxvec, num_indices) RESULT(res)
215  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,*)
216  INTEGER(i8), VALUE, INTENT(in) :: num_indices
217  TYPE(xt_idxlist) :: res
218  INTEGER(c_int) :: num_indices_c
219 
220  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
221  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
222  __file__, &
223  __line__)
224  num_indices_c = int(num_indices, c_int)
225  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
226  END FUNCTION xt_idxvec_new_a2d_i8
227 
228  FUNCTION xt_idxvec_new_a3d(idxvec) RESULT(res)
229  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:)
230  TYPE(xt_idxlist) :: res
231 
232  INTEGER(xt_int_kind) :: idxvec_dummy(1)
233  INTEGER(c_int) :: num_indices_c
234  IF (SIZE(idxvec) > huge(num_indices_c)) &
235  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
236  __file__, &
237  __line__)
238  num_indices_c = int(SIZE(idxvec), c_int)
239  IF (num_indices_c > 0_c_int) THEN
240  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
241  ELSE
242  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
243  END IF
244  END FUNCTION xt_idxvec_new_a3d
245 
246  FUNCTION xt_idxvec_new_a3d_i2(idxvec, num_indices) RESULT(res)
247  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,*)
248  INTEGER(i2), VALUE, INTENT(in) :: num_indices
249  TYPE(xt_idxlist) :: res
250  INTEGER(c_int) :: num_indices_c
251  num_indices_c = int(num_indices, c_int)
252  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
253  END FUNCTION xt_idxvec_new_a3d_i2
254 
255  FUNCTION xt_idxvec_new_a3d_i4(idxvec, num_indices) RESULT(res)
256  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,*)
257  INTEGER(i4), VALUE, INTENT(in) :: num_indices
258  TYPE(xt_idxlist) :: res
259  INTEGER(c_int) :: num_indices_c
260  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
261  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
262  __file__, &
263  __line__)
264  num_indices_c = int(num_indices, c_int)
265  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
266  END FUNCTION xt_idxvec_new_a3d_i4
267 
268  FUNCTION xt_idxvec_new_a3d_i8(idxvec, num_indices) RESULT(res)
269  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,*)
270  INTEGER(i8), VALUE, INTENT(in) :: num_indices
271  TYPE(xt_idxlist) :: res
272  INTEGER(c_int) :: num_indices_c
273  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
274  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
275  __file__, &
276  __line__)
277  num_indices_c = int(num_indices, c_int)
278  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
279  END FUNCTION xt_idxvec_new_a3d_i8
280 
281  FUNCTION xt_idxvec_new_a4d(idxvec) RESULT(res)
282  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:)
283  TYPE(xt_idxlist) :: res
284 
285  INTEGER(xt_int_kind) :: idxvec_dummy(1)
286  INTEGER(c_int) :: num_indices
287  IF (SIZE(idxvec) > huge(num_indices)) &
288  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
289  __file__, &
290  __line__)
291  num_indices = int(SIZE(idxvec), c_int)
292  IF (num_indices > 0) THEN
293  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices))
294  ELSE
295  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices))
296  END IF
297  END FUNCTION xt_idxvec_new_a4d
298 
299  FUNCTION xt_idxvec_new_a4d_i2(idxvec, num_indices) RESULT(res)
300  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,*)
301  INTEGER(i2), VALUE, INTENT(in) :: num_indices
302  TYPE(xt_idxlist) :: res
303  INTEGER(c_int) :: num_indices_c
304 
305  num_indices_c = int(num_indices, c_int)
306  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
307  END FUNCTION xt_idxvec_new_a4d_i2
308 
309  FUNCTION xt_idxvec_new_a4d_i4(idxvec, num_indices) RESULT(res)
310  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,*)
311  INTEGER(i4), VALUE, INTENT(in) :: num_indices
312  TYPE(xt_idxlist) :: res
313  INTEGER(c_int) :: num_indices_c
314 
315  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
316  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
317  __file__, &
318  __line__)
319  num_indices_c = int(num_indices, c_int)
320  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
321  END FUNCTION xt_idxvec_new_a4d_i4
322 
323  FUNCTION xt_idxvec_new_a4d_i8(idxvec, num_indices) RESULT(res)
324  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,*)
325  INTEGER(i8), VALUE, INTENT(in) :: num_indices
326  TYPE(xt_idxlist) :: res
327  INTEGER(c_int) :: num_indices_c
328 
329  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
330  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
331  __file__, &
332  __line__)
333  num_indices_c = int(num_indices, c_int)
334  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
335  END FUNCTION xt_idxvec_new_a4d_i8
336 
337  FUNCTION xt_idxvec_new_a5d(idxvec) RESULT(res)
338  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:,:)
339  TYPE(xt_idxlist) :: res
340 
341  INTEGER(xt_int_kind) :: idxvec_dummy(1)
342  INTEGER(c_int) :: num_indices_c
343  IF (SIZE(idxvec) > huge(num_indices_c)) &
344  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
345  __file__, &
346  __line__)
347  num_indices_c = int(SIZE(idxvec), c_int)
348  IF (num_indices_c > 0_c_int) THEN
349  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
350  ELSE
351  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
352  END IF
353  END FUNCTION xt_idxvec_new_a5d
354 
355  FUNCTION xt_idxvec_new_a5d_i2(idxvec, num_indices) RESULT(res)
356  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,*)
357  INTEGER(i2), VALUE, INTENT(in) :: num_indices
358  TYPE(xt_idxlist) :: res
359  INTEGER(c_int) :: num_indices_c
360 
361  num_indices_c = int(num_indices, c_int)
362  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
363 
364  END FUNCTION xt_idxvec_new_a5d_i2
365 
366  FUNCTION xt_idxvec_new_a5d_i4(idxvec, num_indices) RESULT(res)
367  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,*)
368  INTEGER(i4), VALUE, INTENT(in) :: num_indices
369  TYPE(xt_idxlist) :: res
370  INTEGER(c_int) :: num_indices_c
371 
372  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
373  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
374  __file__, &
375  __line__)
376  num_indices_c = int(num_indices, c_int)
377  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
378  END FUNCTION xt_idxvec_new_a5d_i4
379 
380  FUNCTION xt_idxvec_new_a5d_i8(idxvec, num_indices) RESULT(res)
381  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,*)
382  INTEGER(i8), VALUE, INTENT(in) :: num_indices
383  TYPE(xt_idxlist) :: res
384  INTEGER(c_int) :: num_indices_c
385 
386  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
387  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
388  __file__, &
389  __line__)
390  num_indices_c = int(num_indices, c_int)
391  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
392  END FUNCTION xt_idxvec_new_a5d_i8
393 
394  FUNCTION xt_idxvec_new_a6d(idxvec) RESULT(res)
395  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:,:,:)
396  TYPE(xt_idxlist) :: res
397 
398  INTEGER(xt_int_kind) :: idxvec_dummy(1)
399  INTEGER(c_int) :: num_indices_c
400 
401  IF (SIZE(idxvec) > huge(num_indices_c)) &
402  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
403  __file__, &
404  __line__)
405  num_indices_c = int(SIZE(idxvec), c_int)
406  IF (num_indices_c > 0_c_int) THEN
407  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
408  ELSE
409  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
410  END IF
411  END FUNCTION xt_idxvec_new_a6d
412 
413  FUNCTION xt_idxvec_new_a6d_i2(idxvec, num_indices) RESULT(res)
414  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,*)
415  INTEGER(i2), VALUE, INTENT(in) :: num_indices
416 
417  TYPE(xt_idxlist) :: res
418  INTEGER(c_int) :: num_indices_c
419 
420  num_indices_c = int(num_indices, c_int)
421  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
422  END FUNCTION xt_idxvec_new_a6d_i2
423 
424  FUNCTION xt_idxvec_new_a6d_i4(idxvec, num_indices) RESULT(res)
425  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,*)
426  INTEGER(i4), VALUE, INTENT(in) :: num_indices
427  TYPE(xt_idxlist) :: res
428  INTEGER(c_int) :: num_indices_c
429 
430  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
431  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
432  __file__, &
433  __line__)
434  num_indices_c = int(num_indices, c_int)
435  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
436  END FUNCTION xt_idxvec_new_a6d_i4
437 
438  FUNCTION xt_idxvec_new_a6d_i8(idxvec, num_indices) RESULT(res)
439  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,*)
440  INTEGER(i8), VALUE, INTENT(in) :: num_indices
441  TYPE(xt_idxlist) :: res
442  INTEGER(c_int) :: num_indices_c
443 
444  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
445  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
446  __file__, &
447  __line__)
448  num_indices_c = int(num_indices, c_int)
449  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
450  END FUNCTION xt_idxvec_new_a6d_i8
451 
452  FUNCTION xt_idxvec_new_a7d(idxvec) RESULT(res)
453  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:,:,:,:)
454  TYPE(xt_idxlist) :: res
455 
456  INTEGER(xt_int_kind) :: idxvec_dummy(1)
457  INTEGER(c_int) :: num_indices_c
458  IF (SIZE(idxvec) > huge(num_indices_c)) &
459  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
460  __file__, &
461  __line__)
462  num_indices_c = int(SIZE(idxvec), c_int)
463  IF (num_indices_c > 0_c_int) THEN
464  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
465  ELSE
466  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
467  END IF
468  END FUNCTION xt_idxvec_new_a7d
469 
470  FUNCTION xt_idxvec_new_a7d_i2(idxvec, num_indices) RESULT(res)
471  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,1,*)
472  INTEGER(i2), VALUE, INTENT(in) :: num_indices
473  TYPE(xt_idxlist) :: res
474  INTEGER(c_int) :: num_indices_c
475 
476  num_indices_c = int(num_indices, c_int)
477  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
478  END FUNCTION xt_idxvec_new_a7d_i2
479 
480  FUNCTION xt_idxvec_new_a7d_i4(idxvec, num_indices) RESULT(res)
481  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,1,*)
482  INTEGER(i4), VALUE, INTENT(in) :: num_indices
483  TYPE(xt_idxlist) :: res
484  INTEGER(c_int) :: num_indices_c
485 
486  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
487  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
488  __file__, &
489  __line__)
490  num_indices_c = int(num_indices, c_int)
491  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
492  END FUNCTION xt_idxvec_new_a7d_i4
493 
494  FUNCTION xt_idxvec_new_a7d_i8(idxvec, num_indices) RESULT(res)
495  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,1,*)
496  INTEGER(i8), VALUE, INTENT(in) :: num_indices
497  TYPE(xt_idxlist) :: res
498  INTEGER(c_int) :: num_indices_c
499 
500  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
501  CALL xt_abort(xt_get_default_comm(), "too many idxvec elements", &
502  __file__, &
503  __line__)
504  num_indices_c = int(num_indices, c_int)
505  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
506  END FUNCTION xt_idxvec_new_a7d_i8
507 
508  FUNCTION xt_idxvec_from_stripes_new_a(stripes) RESULT(res)
509  TYPE(xt_stripe), INTENT(in) :: stripes(:)
510  TYPE(xt_idxlist) :: res
511  INTEGER(c_int) :: num_stripes_c
512  num_stripes_c = int(SIZE(stripes), c_int)
513  res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
514  END FUNCTION xt_idxvec_from_stripes_new_a
515 
516  FUNCTION xt_idxvec_from_stripes_new_a_i2(stripes, num_stripes) RESULT(res)
517  TYPE(xt_stripe), INTENT(in) :: stripes(*)
518  INTEGER(i2), INTENT(in) :: num_stripes
519  TYPE(xt_idxlist) :: res
520  INTEGER(c_int) :: num_stripes_c
521  num_stripes_c = int(num_stripes, c_int)
522  res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
523  END FUNCTION xt_idxvec_from_stripes_new_a_i2
524 
525  FUNCTION xt_idxvec_from_stripes_new_a_i4(stripes, num_stripes) RESULT(res)
526  TYPE(xt_stripe), INTENT(in) :: stripes(*)
527  INTEGER(i4), INTENT(in) :: num_stripes
528  TYPE(xt_idxlist) :: res
529  INTEGER(c_int) :: num_stripes_c
530 
531  IF (i4 /= c_int .AND. num_stripes > huge(1_c_int)) &
532  CALL xt_abort(xt_get_default_comm(), "too many stripes", &
533  __file__, &
534  __line__)
535  num_stripes_c = int(num_stripes, c_int)
536  res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
537  END FUNCTION xt_idxvec_from_stripes_new_a_i4
538 
539  FUNCTION xt_idxvec_from_stripes_new_a_i8(stripes, num_stripes) RESULT(res)
540  TYPE(xt_stripe), INTENT(in) :: stripes(*)
541  INTEGER(i8), INTENT(in) :: num_stripes
542  TYPE(xt_idxlist) :: res
543  INTEGER(c_int) :: num_stripes_c
544 
545  IF (i8 /= c_int .AND. num_stripes > huge(1_c_int)) &
546  CALL xt_abort(xt_get_default_comm(), "too many stripes", &
547  __file__, &
548  __line__)
549  num_stripes_c = int(num_stripes, c_int)
550  res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
551  END FUNCTION xt_idxvec_from_stripes_new_a_i8
552 
553 END MODULE xt_idxvec
554 !
555 ! Local Variables:
556 ! f90-continuation-indent: 5
557 ! coding: utf-8
558 ! indent-tabs-mode: nil
559 ! show-trailing-whitespace: t
560 ! require-trailing-newline: t
561 ! End:
562 !
Xt_idxlist xt_idxvec_from_stripes_new(const struct Xt_stripe *stripes, int num_stripes)
integer, parameter, public i8
Definition: xt_core_f.f90:60
integer, parameter, public i4
Definition: xt_core_f.f90:59
type(xt_idxlist) function, public xt_idxlist_c2f(idxlist)
integer, parameter, public i2
Definition: xt_core_f.f90:58
integer, parameter, public xt_int_kind
Definition: xt_core_f.f90:54
Xt_idxlist xt_idxvec_new(const Xt_int *idxlist, int num_indices)
Definition: xt_idxvec.c:163