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