Yet Another eXchange Tool  0.9.0
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
51  use, INTRINSIC :: iso_c_binding, only: c_ptr, c_int
52  IMPLICIT NONE
53  PRIVATE
54  INTERFACE xt_idxvec_new
55  MODULE PROCEDURE xt_idxvec_new_a1d
56  MODULE PROCEDURE xt_idxvec_new_a1d_i2
57  MODULE PROCEDURE xt_idxvec_new_a1d_i4
58  MODULE PROCEDURE xt_idxvec_new_a1d_i8
59  MODULE PROCEDURE xt_idxvec_new_a2d
60  MODULE PROCEDURE xt_idxvec_new_a2d_i2
61  MODULE PROCEDURE xt_idxvec_new_a2d_i4
62  MODULE PROCEDURE xt_idxvec_new_a2d_i8
63  MODULE PROCEDURE xt_idxvec_new_a3d
64  MODULE PROCEDURE xt_idxvec_new_a3d_i2
65  MODULE PROCEDURE xt_idxvec_new_a3d_i4
66  MODULE PROCEDURE xt_idxvec_new_a3d_i8
67  MODULE PROCEDURE xt_idxvec_new_a4d
68  MODULE PROCEDURE xt_idxvec_new_a4d_i2
69  MODULE PROCEDURE xt_idxvec_new_a4d_i4
70  MODULE PROCEDURE xt_idxvec_new_a4d_i8
71  MODULE PROCEDURE xt_idxvec_new_a5d
72  MODULE PROCEDURE xt_idxvec_new_a5d_i2
73  MODULE PROCEDURE xt_idxvec_new_a5d_i4
74  MODULE PROCEDURE xt_idxvec_new_a5d_i8
75  MODULE PROCEDURE xt_idxvec_new_a6d
76  MODULE PROCEDURE xt_idxvec_new_a6d_i2
77  MODULE PROCEDURE xt_idxvec_new_a6d_i4
78  MODULE PROCEDURE xt_idxvec_new_a6d_i8
79  MODULE PROCEDURE xt_idxvec_new_a7d
80  MODULE PROCEDURE xt_idxvec_new_a7d_i2
81  MODULE PROCEDURE xt_idxvec_new_a7d_i4
82  MODULE PROCEDURE xt_idxvec_new_a7d_i8
83  END INTERFACE xt_idxvec_new
84 
86  MODULE PROCEDURE xt_idxvec_from_stripes_new_a
87  MODULE PROCEDURE xt_idxvec_from_stripes_new_a_i2
88  MODULE PROCEDURE xt_idxvec_from_stripes_new_a_i4
89  MODULE PROCEDURE xt_idxvec_from_stripes_new_a_i8
90  END INTERFACE xt_idxvec_from_stripes_new
91 
93 
94  INTERFACE
95  FUNCTION xt_idxvec_new_c(idxvec, num_indices) &
96  bind(c, name='xt_idxvec_new') result(res_ptr)
97  IMPORT :: xt_int_kind, c_ptr, c_int
98  IMPLICIT NONE
99  INTEGER(xt_int_kind), INTENT(in) :: idxvec(*)
100  INTEGER(c_int), VALUE, INTENT(in) :: num_indices
101  TYPE(c_ptr) :: res_ptr
102  END FUNCTION xt_idxvec_new_c
103 
104  FUNCTION xt_idxvec_from_stripes_new_c(stripes, num_stripes) &
105  bind(c, name='xt_idxvec_from_stripes_new') result(res_ptr)
106  IMPORT :: xt_stripe, c_int, c_ptr
107  IMPLICIT NONE
108  TYPE(xt_stripe), INTENT(in) :: stripes(*)
109  INTEGER(c_int), VALUE, INTENT(in) :: num_stripes
110  TYPE(c_ptr) :: res_ptr
111  END FUNCTION xt_idxvec_from_stripes_new_c
112  END INTERFACE
113 
114  CHARACTER(len=*), PARAMETER :: filename = 'xt_idxvec_f.f90'
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("too many idxvec elements", filename, __line__)
125  num_indices_c = int(SIZE(idxvec), c_int)
126  IF (num_indices_c > 0_c_int) THEN
127  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
128  ELSE
129  idxvec_dummy(1) = huge(idxvec_dummy)
130  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
131  END IF
132  END FUNCTION xt_idxvec_new_a1d
133 
134  FUNCTION xt_idxvec_new_a1d_i2(idxvec, num_indices) RESULT(res)
135  INTEGER(xt_int_kind), INTENT(in) :: idxvec(*)
136  INTEGER(i2), VALUE, INTENT(in) :: num_indices
137  TYPE(Xt_idxlist) :: res
138  INTEGER(c_int) :: num_indices_c
139 
140  num_indices_c = int(num_indices, c_int)
141  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
142  END FUNCTION xt_idxvec_new_a1d_i2
143 
144  FUNCTION xt_idxvec_new_a1d_i4(idxvec, num_indices) RESULT(res)
145  INTEGER(xt_int_kind), INTENT(in) :: idxvec(*)
146  INTEGER(i4), VALUE, INTENT(in) :: num_indices
147  TYPE(Xt_idxlist) :: res
148  INTEGER(c_int) :: num_indices_c
149 
150  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
151  CALL xt_abort("too many idxvec elements", filename, __line__)
152  num_indices_c = int(num_indices, c_int)
153  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
154  END FUNCTION xt_idxvec_new_a1d_i4
155 
156  FUNCTION xt_idxvec_new_a1d_i8(idxvec, num_indices) RESULT(res)
157  INTEGER(xt_int_kind), INTENT(in) :: idxvec(*)
158  INTEGER(i8), VALUE, INTENT(in) :: num_indices
159  TYPE(Xt_idxlist) :: res
160  INTEGER(c_int) :: num_indices_c
161 
162  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
163  CALL xt_abort("too many idxvec elements", filename, __line__)
164  num_indices_c = int(num_indices, c_int)
165  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
166  END FUNCTION xt_idxvec_new_a1d_i8
167 
168  FUNCTION xt_idxvec_new_a2d(idxvec) RESULT(res)
169  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:)
170  TYPE(Xt_idxlist) :: res
171  INTEGER(xt_int_kind) :: idxvec_dummy(1)
172  INTEGER(c_int) :: num_indices_c
173  IF (SIZE(idxvec) > huge(num_indices_c)) &
174  CALL xt_abort("too many idxvec elements", filename, __line__)
175  num_indices_c = int(SIZE(idxvec), c_int)
176  IF (num_indices_c > 0_c_int) THEN
177  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
178  ELSE
179  idxvec_dummy(1) = huge(idxvec_dummy)
180  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
181  END IF
182  END FUNCTION xt_idxvec_new_a2d
183 
184  FUNCTION xt_idxvec_new_a2d_i2(idxvec, num_indices) RESULT(res)
185  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,*)
186  INTEGER(i2), VALUE, INTENT(in) :: num_indices
187  TYPE(Xt_idxlist) :: res
188  INTEGER(c_int) :: num_indices_c
189 
190  num_indices_c = int(num_indices, c_int)
191  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
192  END FUNCTION xt_idxvec_new_a2d_i2
193 
194  FUNCTION xt_idxvec_new_a2d_i4(idxvec, num_indices) RESULT(res)
195  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,*)
196  INTEGER(i4), VALUE, INTENT(in) :: num_indices
197  TYPE(Xt_idxlist) :: res
198  INTEGER(c_int) :: num_indices_c
199 
200  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
201  CALL xt_abort("too many idxvec elements", filename, __line__)
202  num_indices_c = int(num_indices, c_int)
203  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
204  END FUNCTION xt_idxvec_new_a2d_i4
205 
206  FUNCTION xt_idxvec_new_a2d_i8(idxvec, num_indices) RESULT(res)
207  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,*)
208  INTEGER(i8), VALUE, INTENT(in) :: num_indices
209  TYPE(Xt_idxlist) :: res
210  INTEGER(c_int) :: num_indices_c
211 
212  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
213  CALL xt_abort("too many idxvec elements", filename, __line__)
214  num_indices_c = int(num_indices, c_int)
215  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
216  END FUNCTION xt_idxvec_new_a2d_i8
217 
218  FUNCTION xt_idxvec_new_a3d(idxvec) RESULT(res)
219  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:)
220  TYPE(Xt_idxlist) :: res
221 
222  INTEGER(xt_int_kind) :: idxvec_dummy(1)
223  INTEGER(c_int) :: num_indices_c
224  IF (SIZE(idxvec) > huge(num_indices_c)) &
225  CALL xt_abort("too many idxvec elements", filename, __line__)
226  num_indices_c = int(SIZE(idxvec), c_int)
227  IF (num_indices_c > 0_c_int) THEN
228  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
229  ELSE
230  idxvec_dummy(1) = huge(idxvec_dummy)
231  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
232  END IF
233  END FUNCTION xt_idxvec_new_a3d
234 
235  FUNCTION xt_idxvec_new_a3d_i2(idxvec, num_indices) RESULT(res)
236  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,*)
237  INTEGER(i2), VALUE, INTENT(in) :: num_indices
238  TYPE(Xt_idxlist) :: res
239  INTEGER(c_int) :: num_indices_c
240  num_indices_c = int(num_indices, c_int)
241  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
242  END FUNCTION xt_idxvec_new_a3d_i2
243 
244  FUNCTION xt_idxvec_new_a3d_i4(idxvec, num_indices) RESULT(res)
245  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,*)
246  INTEGER(i4), VALUE, INTENT(in) :: num_indices
247  TYPE(Xt_idxlist) :: res
248  INTEGER(c_int) :: num_indices_c
249  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
250  CALL xt_abort("too many idxvec elements", filename, __line__)
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_i4
254 
255  FUNCTION xt_idxvec_new_a3d_i8(idxvec, num_indices) RESULT(res)
256  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,*)
257  INTEGER(i8), VALUE, INTENT(in) :: num_indices
258  TYPE(Xt_idxlist) :: res
259  INTEGER(c_int) :: num_indices_c
260  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
261  CALL xt_abort("too many idxvec elements", filename, __line__)
262  num_indices_c = int(num_indices, c_int)
263  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
264  END FUNCTION xt_idxvec_new_a3d_i8
265 
266  FUNCTION xt_idxvec_new_a4d(idxvec) RESULT(res)
267  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:)
268  TYPE(Xt_idxlist) :: res
269 
270  INTEGER(xt_int_kind) :: idxvec_dummy(1)
271  INTEGER(c_int) :: num_indices
272  IF (SIZE(idxvec) > huge(num_indices)) &
273  CALL xt_abort("too many idxvec elements", filename, __line__)
274  num_indices = int(SIZE(idxvec), c_int)
275  IF (num_indices > 0) THEN
276  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices))
277  ELSE
278  idxvec_dummy(1) = huge(idxvec_dummy)
279  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices))
280  END IF
281  END FUNCTION xt_idxvec_new_a4d
282 
283  FUNCTION xt_idxvec_new_a4d_i2(idxvec, num_indices) RESULT(res)
284  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,*)
285  INTEGER(i2), VALUE, INTENT(in) :: num_indices
286  TYPE(Xt_idxlist) :: res
287  INTEGER(c_int) :: num_indices_c
288 
289  num_indices_c = int(num_indices, c_int)
290  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
291  END FUNCTION xt_idxvec_new_a4d_i2
292 
293  FUNCTION xt_idxvec_new_a4d_i4(idxvec, num_indices) RESULT(res)
294  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,*)
295  INTEGER(i4), VALUE, INTENT(in) :: num_indices
296  TYPE(Xt_idxlist) :: res
297  INTEGER(c_int) :: num_indices_c
298 
299  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
300  CALL xt_abort("too many idxvec elements", filename, __line__)
301  num_indices_c = int(num_indices, c_int)
302  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
303  END FUNCTION xt_idxvec_new_a4d_i4
304 
305  FUNCTION xt_idxvec_new_a4d_i8(idxvec, num_indices) RESULT(res)
306  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,*)
307  INTEGER(i8), VALUE, INTENT(in) :: num_indices
308  TYPE(Xt_idxlist) :: res
309  INTEGER(c_int) :: num_indices_c
310 
311  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
312  CALL xt_abort("too many idxvec elements", filename, __line__)
313  num_indices_c = int(num_indices, c_int)
314  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
315  END FUNCTION xt_idxvec_new_a4d_i8
316 
317  FUNCTION xt_idxvec_new_a5d(idxvec) RESULT(res)
318  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:,:)
319  TYPE(Xt_idxlist) :: res
320 
321  INTEGER(xt_int_kind) :: idxvec_dummy(1)
322  INTEGER(c_int) :: num_indices_c
323  IF (SIZE(idxvec) > huge(num_indices_c)) &
324  CALL xt_abort("too many idxvec elements", filename, __line__)
325  num_indices_c = int(SIZE(idxvec), c_int)
326  IF (num_indices_c > 0_c_int) THEN
327  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
328  ELSE
329  idxvec_dummy(1) = huge(idxvec_dummy)
330  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
331  END IF
332  END FUNCTION xt_idxvec_new_a5d
333 
334  FUNCTION xt_idxvec_new_a5d_i2(idxvec, num_indices) RESULT(res)
335  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,*)
336  INTEGER(i2), VALUE, INTENT(in) :: num_indices
337  TYPE(Xt_idxlist) :: res
338  INTEGER(c_int) :: num_indices_c
339 
340  num_indices_c = int(num_indices, c_int)
341  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
342 
343  END FUNCTION xt_idxvec_new_a5d_i2
344 
345  FUNCTION xt_idxvec_new_a5d_i4(idxvec, num_indices) RESULT(res)
346  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,*)
347  INTEGER(i4), VALUE, INTENT(in) :: num_indices
348  TYPE(Xt_idxlist) :: res
349  INTEGER(c_int) :: num_indices_c
350 
351  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
352  CALL xt_abort("too many idxvec elements", filename, __line__)
353  num_indices_c = int(num_indices, c_int)
354  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
355  END FUNCTION xt_idxvec_new_a5d_i4
356 
357  FUNCTION xt_idxvec_new_a5d_i8(idxvec, num_indices) RESULT(res)
358  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,*)
359  INTEGER(i8), VALUE, INTENT(in) :: num_indices
360  TYPE(Xt_idxlist) :: res
361  INTEGER(c_int) :: num_indices_c
362 
363  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
364  CALL xt_abort("too many idxvec elements", filename, __line__)
365  num_indices_c = int(num_indices, c_int)
366  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
367  END FUNCTION xt_idxvec_new_a5d_i8
368 
369  FUNCTION xt_idxvec_new_a6d(idxvec) RESULT(res)
370  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:,:,:)
371  TYPE(Xt_idxlist) :: res
372 
373  INTEGER(xt_int_kind) :: idxvec_dummy(1)
374  INTEGER(c_int) :: num_indices_c
375 
376  IF (SIZE(idxvec) > huge(num_indices_c)) &
377  CALL xt_abort("too many idxvec elements", filename, __line__)
378  num_indices_c = int(SIZE(idxvec), c_int)
379  IF (num_indices_c > 0_c_int) THEN
380  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
381  ELSE
382  idxvec_dummy(1) = huge(idxvec_dummy)
383  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
384  END IF
385  END FUNCTION xt_idxvec_new_a6d
386 
387  FUNCTION xt_idxvec_new_a6d_i2(idxvec, num_indices) RESULT(res)
388  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,*)
389  INTEGER(i2), VALUE, INTENT(in) :: num_indices
390 
391  TYPE(Xt_idxlist) :: res
392  INTEGER(c_int) :: num_indices_c
393 
394  num_indices_c = int(num_indices, c_int)
395  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
396  END FUNCTION xt_idxvec_new_a6d_i2
397 
398  FUNCTION xt_idxvec_new_a6d_i4(idxvec, num_indices) RESULT(res)
399  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,*)
400  INTEGER(i4), VALUE, INTENT(in) :: num_indices
401  TYPE(Xt_idxlist) :: res
402  INTEGER(c_int) :: num_indices_c
403 
404  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
405  CALL xt_abort("too many idxvec elements", filename, __line__)
406  num_indices_c = int(num_indices, c_int)
407  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
408  END FUNCTION xt_idxvec_new_a6d_i4
409 
410  FUNCTION xt_idxvec_new_a6d_i8(idxvec, num_indices) RESULT(res)
411  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,*)
412  INTEGER(i8), VALUE, INTENT(in) :: num_indices
413  TYPE(Xt_idxlist) :: res
414  INTEGER(c_int) :: num_indices_c
415 
416  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
417  CALL xt_abort("too many idxvec elements", filename, __line__)
418  num_indices_c = int(num_indices, c_int)
419  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
420  END FUNCTION xt_idxvec_new_a6d_i8
421 
422  FUNCTION xt_idxvec_new_a7d(idxvec) RESULT(res)
423  INTEGER(xt_int_kind), INTENT(in) :: idxvec(:,:,:,:,:,:,:)
424  TYPE(Xt_idxlist) :: res
425 
426  INTEGER(xt_int_kind) :: idxvec_dummy(1)
427  INTEGER(c_int) :: num_indices_c
428  IF (SIZE(idxvec) > huge(num_indices_c)) &
429  CALL xt_abort("too many idxvec elements", filename, __line__)
430  num_indices_c = int(SIZE(idxvec), c_int)
431  IF (num_indices_c > 0_c_int) THEN
432  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
433  ELSE
434  idxvec_dummy(1) = huge(idxvec_dummy)
435  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec_dummy, num_indices_c))
436  END IF
437  END FUNCTION xt_idxvec_new_a7d
438 
439  FUNCTION xt_idxvec_new_a7d_i2(idxvec, num_indices) RESULT(res)
440  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,1,*)
441  INTEGER(i2), VALUE, INTENT(in) :: num_indices
442  TYPE(Xt_idxlist) :: res
443  INTEGER(c_int) :: num_indices_c
444 
445  num_indices_c = int(num_indices, c_int)
446  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
447  END FUNCTION xt_idxvec_new_a7d_i2
448 
449  FUNCTION xt_idxvec_new_a7d_i4(idxvec, num_indices) RESULT(res)
450  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,1,*)
451  INTEGER(i4), VALUE, INTENT(in) :: num_indices
452  TYPE(Xt_idxlist) :: res
453  INTEGER(c_int) :: num_indices_c
454 
455  IF (i4 /= c_int .AND. num_indices > huge(1_c_int)) &
456  CALL xt_abort("too many idxvec elements", filename, __line__)
457  num_indices_c = int(num_indices, c_int)
458  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
459  END FUNCTION xt_idxvec_new_a7d_i4
460 
461  FUNCTION xt_idxvec_new_a7d_i8(idxvec, num_indices) RESULT(res)
462  INTEGER(xt_int_kind), INTENT(in) :: idxvec(1,1,1,1,1,1,*)
463  INTEGER(i8), VALUE, INTENT(in) :: num_indices
464  TYPE(Xt_idxlist) :: res
465  INTEGER(c_int) :: num_indices_c
466 
467  IF (i8 /= c_int .AND. num_indices > huge(1_c_int)) &
468  CALL xt_abort("too many idxvec elements", filename, __line__)
469  num_indices_c = int(num_indices, c_int)
470  res = xt_idxlist_c2f(xt_idxvec_new_c(idxvec, num_indices_c))
471  END FUNCTION xt_idxvec_new_a7d_i8
472 
473  FUNCTION xt_idxvec_from_stripes_new_a(stripes) RESULT(res)
474  TYPE(xt_stripe), INTENT(in) :: stripes(:)
475  TYPE(Xt_idxlist) :: res
476  INTEGER(c_int) :: num_stripes_c
477  num_stripes_c = int(SIZE(stripes), c_int)
478  res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
479  END FUNCTION xt_idxvec_from_stripes_new_a
480 
481  FUNCTION xt_idxvec_from_stripes_new_a_i2(stripes, num_stripes) RESULT(res)
482  TYPE(xt_stripe), INTENT(in) :: stripes(*)
483  INTEGER(i2), INTENT(in) :: num_stripes
484  TYPE(Xt_idxlist) :: res
485  INTEGER(c_int) :: num_stripes_c
486  num_stripes_c = int(num_stripes, c_int)
487  res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
488  END FUNCTION xt_idxvec_from_stripes_new_a_i2
489 
490  FUNCTION xt_idxvec_from_stripes_new_a_i4(stripes, num_stripes) RESULT(res)
491  TYPE(xt_stripe), INTENT(in) :: stripes(*)
492  INTEGER(i4), INTENT(in) :: num_stripes
493  TYPE(Xt_idxlist) :: res
494  INTEGER(c_int) :: num_stripes_c
495 
496  IF (i4 /= c_int .AND. num_stripes > huge(1_c_int)) &
497  CALL xt_abort("too many stripes", filename, __line__)
498  num_stripes_c = int(num_stripes, c_int)
499  res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
500  END FUNCTION xt_idxvec_from_stripes_new_a_i4
501 
502  FUNCTION xt_idxvec_from_stripes_new_a_i8(stripes, num_stripes) RESULT(res)
503  TYPE(xt_stripe), INTENT(in) :: stripes(*)
504  INTEGER(i8), INTENT(in) :: num_stripes
505  TYPE(Xt_idxlist) :: res
506  INTEGER(c_int) :: num_stripes_c
507 
508  IF (i8 /= c_int .AND. num_stripes > huge(1_c_int)) &
509  CALL xt_abort("too many stripes", filename, __line__)
510  num_stripes_c = int(num_stripes, c_int)
511  res = xt_idxlist_c2f(xt_idxvec_from_stripes_new_c(stripes, num_stripes_c))
512  END FUNCTION xt_idxvec_from_stripes_new_a_i8
513 
514 END MODULE xt_idxvec
515 !
516 ! Local Variables:
517 ! f90-continuation-indent: 5
518 ! coding: utf-8
519 ! indent-tabs-mode: nil
520 ! show-trailing-whitespace: t
521 ! require-trailing-newline: t
522 ! End:
523 !
integer, parameter, public i8
Definition: xt_core_f.f90:60
integer, parameter, public xt_int_kind
Definition: xt_core_f.f90:54
integer, parameter, public i4
Definition: xt_core_f.f90:59
integer, parameter, public i2
Definition: xt_core_f.f90:58
type(xt_idxlist) function, public xt_idxlist_c2f(idxlist)
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:163