Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
xt_redist_int_i2.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#include "fc_feature_defs.inc"
48MODULE xt_redist_int_i2
49 USE xt_redist_base, ONLY: xt_redist, xt_redist_s_exchange1, &
51 USE xt_requests, ONLY: xt_request
52#ifdef HAVE_FC_IS_CONTIGUOUS
53 USE xt_core, ONLY: xt_abort
54#endif
55 USE iso_c_binding, ONLY: c_ptr, c_loc
56 IMPLICIT NONE
57 PRIVATE
58 CHARACTER(len=*), PARAMETER :: filename = 'xt_redist_int_i2.f90'
59 INTEGER, PARAMETER :: pi2 = 4
60 INTEGER, PARAMETER :: i2 = selected_int_kind(pi2)
61 PUBLIC :: i2
62 INTERFACE xt_redist_s_exchange
63 MODULE PROCEDURE xt_redist_s_exchange_i2_1d
64 MODULE PROCEDURE xt_redist_s_exchange_i2_2d
65 MODULE PROCEDURE xt_redist_s_exchange_i2_3d
66 MODULE PROCEDURE xt_redist_s_exchange_i2_4d
67 MODULE PROCEDURE xt_redist_s_exchange_i2_5d
68 MODULE PROCEDURE xt_redist_s_exchange_i2_6d
69 MODULE PROCEDURE xt_redist_s_exchange_i2_7d
70 END INTERFACE xt_redist_s_exchange
71 PUBLIC :: xt_redist_s_exchange
72 INTERFACE xt_redist_a_exchange
73 MODULE PROCEDURE xt_redist_a_exchange_i2_1d
74 MODULE PROCEDURE xt_redist_a_exchange_i2_2d
75 MODULE PROCEDURE xt_redist_a_exchange_i2_3d
76 MODULE PROCEDURE xt_redist_a_exchange_i2_4d
77 MODULE PROCEDURE xt_redist_a_exchange_i2_5d
78 MODULE PROCEDURE xt_redist_a_exchange_i2_6d
79 MODULE PROCEDURE xt_redist_a_exchange_i2_7d
80 END INTERFACE xt_redist_a_exchange
81 PUBLIC :: xt_redist_a_exchange
82CONTAINS
83
84 ! see @ref xt_redist_s_exchange
85 SUBROUTINE xt_redist_s_exchange_i2_1d_as(redist, src_size, src_data, &
86 dst_size, dst_data)
87 TYPE(xt_redist), INTENT(in) :: redist
88 INTEGER, INTENT(in) :: src_size, dst_size
89 INTEGER(i2), TARGET, INTENT(in) :: src_data(src_size)
90 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(dst_size)
91 TYPE(c_ptr) :: src_data_cptr, dst_data_cptr
92 src_data_cptr = c_loc(src_data)
93 dst_data_cptr = c_loc(dst_data)
94 CALL xt_redist_s_exchange1(redist, src_data_cptr, dst_data_cptr)
95 END SUBROUTINE xt_redist_s_exchange_i2_1d_as
96
97 ! see @ref xt_redist_s_exchange
98 SUBROUTINE xt_redist_s_exchange_i2_1d(redist, src_data, dst_data)
99 TYPE(xt_redist), INTENT(in) :: redist
100 INTEGER(i2), TARGET, INTENT(in) :: src_data(:)
101 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:)
102
103 INTEGER(i2), POINTER :: src_p(:), dst_p(:)
104 INTEGER(i2), TARGET :: dummy(1)
105 INTEGER :: src_size, dst_size
106 src_size = SIZE(src_data)
107 dst_size = SIZE(dst_data)
108 IF (src_size > 0) THEN
109 src_p => src_data
110 ELSE
111 src_p => dummy
112 src_size = 1
113 END IF
114 IF (dst_size > 0) THEN
115 dst_p => dst_data
116 ELSE
117 dst_p => dummy
118 dst_size = 1
119 END IF
120 CALL xt_redist_s_exchange_i2_1d_as(redist, src_size, src_p, dst_size, dst_p)
121 END SUBROUTINE xt_redist_s_exchange_i2_1d
122
123 ! see @ref xt_redist_s_exchange
124 SUBROUTINE xt_redist_s_exchange_i2_2d(redist, src_data, dst_data)
125 TYPE(xt_redist), INTENT(in) :: redist
126 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:)
127 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:)
128
129 INTEGER(i2), POINTER :: src_p(:,:), dst_p(:,:)
130 INTEGER(i2), TARGET :: dummy(1,1)
131 INTEGER :: src_size, dst_size
132 src_size = SIZE(src_data)
133 dst_size = SIZE(dst_data)
134 IF (src_size > 0) THEN
135 src_p => src_data
136 ELSE
137 src_p => dummy
138 src_size = 1
139 END IF
140 IF (dst_size > 0) THEN
141 dst_p => dst_data
142 ELSE
143 dst_p => dummy
144 dst_size = 1
145 END IF
146 CALL xt_redist_s_exchange_i2_1d_as(redist, src_size, src_p, dst_size, dst_p)
147 END SUBROUTINE xt_redist_s_exchange_i2_2d
148
149 ! see @ref xt_redist_s_exchange
150 SUBROUTINE xt_redist_s_exchange_i2_3d(redist, src_data, dst_data)
151 TYPE(xt_redist), INTENT(in) :: redist
152 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:,:)
153 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:,:)
154
155 INTEGER(i2), POINTER :: src_p(:,:,:), dst_p(:,:,:)
156 INTEGER(i2), TARGET :: dummy(1,1,1)
157 INTEGER :: src_size, dst_size
158 src_size = SIZE(src_data)
159 dst_size = SIZE(dst_data)
160 IF (src_size > 0) THEN
161 src_p => src_data
162 ELSE
163 src_p => dummy
164 src_size = 1
165 END IF
166 IF (dst_size > 0) THEN
167 dst_p => dst_data
168 ELSE
169 dst_p => dummy
170 dst_size = 1
171 END IF
172 CALL xt_redist_s_exchange_i2_1d_as(redist, src_size, src_p, dst_size, dst_p)
173 END SUBROUTINE xt_redist_s_exchange_i2_3d
174
175 ! see @ref xt_redist_s_exchange
176 SUBROUTINE xt_redist_s_exchange_i2_4d(redist, src_data, dst_data)
177 TYPE(xt_redist), INTENT(in) :: redist
178 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:,:,:)
179 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:,:,:)
180
181 INTEGER(i2), POINTER :: src_p(:,:,:,:), dst_p(:,:,:,:)
182 INTEGER(i2), TARGET :: dummy(1,1,1,1)
183 INTEGER :: src_size, dst_size
184 src_size = SIZE(src_data)
185 dst_size = SIZE(dst_data)
186 IF (src_size > 0) THEN
187 src_p => src_data
188 ELSE
189 src_p => dummy
190 src_size = 1
191 END IF
192 IF (dst_size > 0) THEN
193 dst_p => dst_data
194 ELSE
195 dst_p => dummy
196 dst_size = 1
197 END IF
198 CALL xt_redist_s_exchange_i2_1d_as(redist, src_size, src_p, dst_size, dst_p)
199 END SUBROUTINE xt_redist_s_exchange_i2_4d
200
201 ! see @ref xt_redist_s_exchange
202 SUBROUTINE xt_redist_s_exchange_i2_5d(redist, src_data, dst_data)
203 TYPE(xt_redist), INTENT(in) :: redist
204 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:,:,:,:)
205 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:)
206
207 INTEGER(i2), POINTER :: src_p(:,:,:,:,:), dst_p(:,:,:,:,:)
208 INTEGER(i2), TARGET :: dummy(1,1,1,1,1)
209 INTEGER :: src_size, dst_size
210 src_size = SIZE(src_data)
211 dst_size = SIZE(dst_data)
212 IF (src_size > 0) THEN
213 src_p => src_data
214 ELSE
215 src_p => dummy
216 src_size = 1
217 END IF
218 IF (dst_size > 0) THEN
219 dst_p => dst_data
220 ELSE
221 dst_p => dummy
222 dst_size = 1
223 END IF
224 CALL xt_redist_s_exchange_i2_1d_as(redist, src_size, src_p, dst_size, dst_p)
225 END SUBROUTINE xt_redist_s_exchange_i2_5d
226
227 ! see @ref xt_redist_s_exchange
228 SUBROUTINE xt_redist_s_exchange_i2_6d(redist, src_data, dst_data)
229 TYPE(xt_redist), INTENT(in) :: redist
230 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:,:,:,:,:)
231 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:)
232
233 INTEGER(i2), POINTER :: src_p(:,:,:,:,:,:), dst_p(:,:,:,:,:,:)
234 INTEGER(i2), TARGET :: dummy(1,1,1,1,1,1)
235 INTEGER :: src_size, dst_size
236 src_size = SIZE(src_data)
237 dst_size = SIZE(dst_data)
238 IF (src_size > 0) THEN
239 src_p => src_data
240 ELSE
241 src_p => dummy
242 src_size = 1
243 END IF
244 IF (dst_size > 0) THEN
245 dst_p => dst_data
246 ELSE
247 dst_p => dummy
248 dst_size = 1
249 END IF
250 CALL xt_redist_s_exchange_i2_1d_as(redist, src_size, src_p, dst_size, dst_p)
251 END SUBROUTINE xt_redist_s_exchange_i2_6d
252
253 ! see @ref xt_redist_s_exchange
254 SUBROUTINE xt_redist_s_exchange_i2_7d(redist, src_data, dst_data)
255 TYPE(xt_redist), INTENT(in) :: redist
256 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:,:,:,:,:,:)
257 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:,:)
258
259 INTEGER(i2), POINTER :: src_p(:,:,:,:,:,:,:), dst_p(:,:,:,:,:,:,:)
260 INTEGER(i2), TARGET :: dummy(1,1,1,1,1,1,1)
261 INTEGER :: src_size, dst_size
262 src_size = SIZE(src_data)
263 dst_size = SIZE(dst_data)
264 IF (src_size > 0) THEN
265 src_p => src_data
266 ELSE
267 src_p => dummy
268 src_size = 1
269 END IF
270 IF (dst_size > 0) THEN
271 dst_p => dst_data
272 ELSE
273 dst_p => dummy
274 dst_size = 1
275 END IF
276 CALL xt_redist_s_exchange_i2_1d_as(redist, src_size, src_p, dst_size, dst_p)
277 END SUBROUTINE xt_redist_s_exchange_i2_7d
278
279 ! see @ref xt_redist_a_exchange
280 SUBROUTINE xt_redist_a_exchange_i2_1d_as(redist, src_size, src_data, &
281 dst_size, dst_data, request)
282 TYPE(xt_redist), INTENT(in) :: redist
283 INTEGER, INTENT(in) :: src_size, dst_size
284 INTEGER(i2), TARGET, INTENT(in) :: src_data(src_size)
285 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(dst_size)
286 TYPE(xt_request), INTENT(out) :: request
287
288 INTEGER(i2), TARGET :: dummy(1)
289 TYPE(c_ptr) :: src_data_cptr, dst_data_cptr
290 IF (src_size > 0) THEN
291 src_data_cptr = c_loc(src_data)
292 ELSE
293 src_data_cptr = c_loc(dummy)
294 END IF
295 IF (dst_size > 0) THEN
296 dst_data_cptr = c_loc(dst_data)
297 ELSE
298 dst_data_cptr = c_loc(dummy)
299 END IF
300 CALL xt_redist_a_exchange1(redist, src_data_cptr, dst_data_cptr, request)
301 END SUBROUTINE xt_redist_a_exchange_i2_1d_as
302
303 ! see @ref xt_redist_a_exchange
304 SUBROUTINE xt_redist_a_exchange_i2_1d(redist, src_data, dst_data, &
305 request)
306 TYPE(xt_redist), INTENT(in) :: redist
307 INTEGER(i2), TARGET, INTENT(in) :: src_data(:)
308 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:)
309 TYPE(xt_request), INTENT(out) :: request
310
311 INTEGER :: src_size, dst_size
312 src_size = SIZE(src_data)
313 dst_size = SIZE(dst_data)
314#ifdef HAVE_FC_IS_CONTIGUOUS
315 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
316 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
317 filename, __line__)
318#endif
319 CALL xt_redist_a_exchange_i2_1d_as(redist, src_size, src_data, dst_size, &
320 dst_data, request)
321 END SUBROUTINE xt_redist_a_exchange_i2_1d
322
323 ! see @ref xt_redist_a_exchange
324 SUBROUTINE xt_redist_a_exchange_i2_2d(redist, src_data, dst_data, &
325 request)
326 TYPE(xt_redist), INTENT(in) :: redist
327 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:)
328 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:)
329 TYPE(xt_request), INTENT(out) :: request
330
331 INTEGER :: src_size, dst_size
332 src_size = SIZE(src_data)
333 dst_size = SIZE(dst_data)
334#ifdef HAVE_FC_IS_CONTIGUOUS
335 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
336 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
337 filename, __line__)
338#endif
339 CALL xt_redist_a_exchange_i2_1d_as(redist, src_size, src_data, dst_size, &
340 dst_data, request)
341 END SUBROUTINE xt_redist_a_exchange_i2_2d
342
343 ! see @ref xt_redist_a_exchange
344 SUBROUTINE xt_redist_a_exchange_i2_3d(redist, src_data, dst_data, &
345 request)
346 TYPE(xt_redist), INTENT(in) :: redist
347 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:,:)
348 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:,:)
349 TYPE(xt_request), INTENT(out) :: request
350
351 INTEGER :: src_size, dst_size
352 src_size = SIZE(src_data)
353 dst_size = SIZE(dst_data)
354#ifdef HAVE_FC_IS_CONTIGUOUS
355 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
356 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
357 filename, __line__)
358#endif
359 CALL xt_redist_a_exchange_i2_1d_as(redist, src_size, src_data, dst_size, &
360 dst_data, request)
361 END SUBROUTINE xt_redist_a_exchange_i2_3d
362
363 ! see @ref xt_redist_a_exchange
364 SUBROUTINE xt_redist_a_exchange_i2_4d(redist, src_data, dst_data, &
365 request)
366 TYPE(xt_redist), INTENT(in) :: redist
367 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:,:,:)
368 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:,:,:)
369 TYPE(xt_request), INTENT(out) :: request
370
371 INTEGER :: src_size, dst_size
372 src_size = SIZE(src_data)
373 dst_size = SIZE(dst_data)
374#ifdef HAVE_FC_IS_CONTIGUOUS
375 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
376 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
377 filename, __line__)
378#endif
379 CALL xt_redist_a_exchange_i2_1d_as(redist, src_size, src_data, dst_size, &
380 dst_data, request)
381 END SUBROUTINE xt_redist_a_exchange_i2_4d
382
383 ! see @ref xt_redist_a_exchange
384 SUBROUTINE xt_redist_a_exchange_i2_5d(redist, src_data, dst_data, &
385 request)
386 TYPE(xt_redist), INTENT(in) :: redist
387 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:,:,:,:)
388 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:)
389 TYPE(xt_request), INTENT(out) :: request
390
391 INTEGER :: src_size, dst_size
392 src_size = SIZE(src_data)
393 dst_size = SIZE(dst_data)
394#ifdef HAVE_FC_IS_CONTIGUOUS
395 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
396 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
397 filename, __line__)
398#endif
399 CALL xt_redist_a_exchange_i2_1d_as(redist, src_size, src_data, dst_size, &
400 dst_data, request)
401 END SUBROUTINE xt_redist_a_exchange_i2_5d
402
403 ! see @ref xt_redist_a_exchange
404 SUBROUTINE xt_redist_a_exchange_i2_6d(redist, src_data, dst_data, &
405 request)
406 TYPE(xt_redist), INTENT(in) :: redist
407 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:,:,:,:,:)
408 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:)
409 TYPE(xt_request), INTENT(out) :: request
410
411 INTEGER :: src_size, dst_size
412 src_size = SIZE(src_data)
413 dst_size = SIZE(dst_data)
414#ifdef HAVE_FC_IS_CONTIGUOUS
415 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
416 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
417 filename, __line__)
418#endif
419 CALL xt_redist_a_exchange_i2_1d_as(redist, src_size, src_data, dst_size, &
420 dst_data, request)
421 END SUBROUTINE xt_redist_a_exchange_i2_6d
422
423 ! see @ref xt_redist_a_exchange
424 SUBROUTINE xt_redist_a_exchange_i2_7d(redist, src_data, dst_data, &
425 request)
426 TYPE(xt_redist), INTENT(in) :: redist
427 INTEGER(i2), TARGET, INTENT(in) :: src_data(:,:,:,:,:,:,:)
428 INTEGER(i2), TARGET, INTENT(inout) :: dst_data(:,:,:,:,:,:,:)
429 TYPE(xt_request), INTENT(out) :: request
430
431 INTEGER :: src_size, dst_size
432 src_size = SIZE(src_data)
433 dst_size = SIZE(dst_data)
434#ifdef HAVE_FC_IS_CONTIGUOUS
435 IF (.NOT. (is_contiguous(src_data) .AND. is_contiguous(dst_data))) &
436 CALL xt_abort('arguments to xt_redist_a_exchange must be contiguous!',&
437 filename, __line__)
438#endif
439 CALL xt_redist_a_exchange_i2_1d_as(redist, src_size, src_data, dst_size, &
440 dst_data, request)
441 END SUBROUTINE xt_redist_a_exchange_i2_7d
442END MODULE xt_redist_int_i2
443!
444! Local Variables:
445! f90-continuation-indent: 5
446! coding: utf-8
447! mode: f90
448! indent-tabs-mode: nil
449! show-trailing-whitespace: t
450! require-trailing-newline: t
451! End:
452!
void xt_redist_a_exchange1(Xt_redist redist, const void *src_data, void *dst_data, Xt_request *request)
Definition xt_redist.c:97
void xt_redist_s_exchange(Xt_redist redist, int num_arrays, const void *const src_data[], void *const dst_data[])
Definition xt_redist.c:79
void xt_redist_a_exchange(Xt_redist redist, int num_arrays, const void *const src_data[], void *const dst_data[], Xt_request *request)
void xt_redist_s_exchange1(Xt_redist redist, const void *src_data, void *dst_data)
Definition xt_redist.c:92