47#include "fc_feature_defs.inc"
48MODULE xt_redist_logical
52#ifdef HAVE_FC_IS_CONTIGUOUS
53 USE xt_core,
ONLY: xt_abort
55#ifdef HAVE_FC_LOGICAL_INTEROP
56 USE iso_c_binding,
ONLY: c_ptr, c_loc
58 USE iso_c_binding,
ONLY: c_ptr
62 CHARACTER(len=*),
PARAMETER :: filename =
'xt_redist_logical.f90'
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
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
86 SUBROUTINE xt_redist_s_exchange_l_1d_as(redist, src_size, src_data, &
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)
97 CALL xt_slice_c_loc(src_data, src_data_cptr)
98 CALL xt_slice_c_loc(dst_data, dst_data_cptr)
101 END SUBROUTINE xt_redist_s_exchange_l_1d_as
104 SUBROUTINE xt_redist_s_exchange_l_1d(redist, src_data, dst_data)
106 LOGICAL,
TARGET,
INTENT(in) :: src_data(:)
107 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:)
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
120 IF (dst_size > 0)
THEN
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
130 SUBROUTINE xt_redist_s_exchange_l_2d(redist, src_data, dst_data)
132 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:)
133 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:)
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
146 IF (dst_size > 0)
THEN
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
156 SUBROUTINE xt_redist_s_exchange_l_3d(redist, src_data, dst_data)
158 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:,:)
159 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:,:)
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
172 IF (dst_size > 0)
THEN
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
182 SUBROUTINE xt_redist_s_exchange_l_4d(redist, src_data, dst_data)
184 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:,:,:)
185 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:,:,:)
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
198 IF (dst_size > 0)
THEN
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
208 SUBROUTINE xt_redist_s_exchange_l_5d(redist, src_data, dst_data)
210 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:,:,:,:)
211 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:,:,:,:)
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
224 IF (dst_size > 0)
THEN
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
234 SUBROUTINE xt_redist_s_exchange_l_6d(redist, src_data, dst_data)
236 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:,:,:,:,:)
237 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:,:,:,:,:)
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
250 IF (dst_size > 0)
THEN
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
260 SUBROUTINE xt_redist_s_exchange_l_7d(redist, src_data, dst_data)
262 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:,:,:,:,:,:)
263 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:,:,:,:,:,:)
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
276 IF (dst_size > 0)
THEN
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
286 SUBROUTINE xt_redist_a_exchange_l_1d_as(redist, src_size, src_data, &
287 dst_size, dst_data, request)
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)
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)
300 CALL xt_slice_c_loc(src_data, src_data_cptr)
303#ifdef HAVE_FC_LOGICAL_INTEROP
304 src_data_cptr = c_loc(dummy)
306 CALL xt_slice_c_loc(dummy, src_data_cptr)
309 IF (dst_size > 0)
THEN
310#ifdef HAVE_FC_LOGICAL_INTEROP
311 dst_data_cptr = c_loc(dst_data)
313 CALL xt_slice_c_loc(dst_data, dst_data_cptr)
316#ifdef HAVE_FC_LOGICAL_INTEROP
317 dst_data_cptr = c_loc(dummy)
319 CALL xt_slice_c_loc(dummy, dst_data_cptr)
323 END SUBROUTINE xt_redist_a_exchange_l_1d_as
326 SUBROUTINE xt_redist_a_exchange_l_1d(redist, src_data, dst_data, &
329 LOGICAL,
TARGET,
INTENT(in) :: src_data(:)
330 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:)
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!',&
341 CALL xt_redist_a_exchange_l_1d_as(redist, src_size, src_data, dst_size, &
343 END SUBROUTINE xt_redist_a_exchange_l_1d
346 SUBROUTINE xt_redist_a_exchange_l_2d(redist, src_data, dst_data, &
349 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:)
350 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:)
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!',&
361 CALL xt_redist_a_exchange_l_1d_as(redist, src_size, src_data, dst_size, &
363 END SUBROUTINE xt_redist_a_exchange_l_2d
366 SUBROUTINE xt_redist_a_exchange_l_3d(redist, src_data, dst_data, &
369 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:,:)
370 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:,:)
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!',&
381 CALL xt_redist_a_exchange_l_1d_as(redist, src_size, src_data, dst_size, &
383 END SUBROUTINE xt_redist_a_exchange_l_3d
386 SUBROUTINE xt_redist_a_exchange_l_4d(redist, src_data, dst_data, &
389 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:,:,:)
390 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:,:,:)
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!',&
401 CALL xt_redist_a_exchange_l_1d_as(redist, src_size, src_data, dst_size, &
403 END SUBROUTINE xt_redist_a_exchange_l_4d
406 SUBROUTINE xt_redist_a_exchange_l_5d(redist, src_data, dst_data, &
409 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:,:,:,:)
410 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:,:,:,:)
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!',&
421 CALL xt_redist_a_exchange_l_1d_as(redist, src_size, src_data, dst_size, &
423 END SUBROUTINE xt_redist_a_exchange_l_5d
426 SUBROUTINE xt_redist_a_exchange_l_6d(redist, src_data, dst_data, &
429 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:,:,:,:,:)
430 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:,:,:,:,:)
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!',&
441 CALL xt_redist_a_exchange_l_1d_as(redist, src_size, src_data, dst_size, &
443 END SUBROUTINE xt_redist_a_exchange_l_6d
446 SUBROUTINE xt_redist_a_exchange_l_7d(redist, src_data, dst_data, &
449 LOGICAL,
TARGET,
INTENT(in) :: src_data(:,:,:,:,:,:,:)
450 LOGICAL,
TARGET,
INTENT(inout) :: dst_data(:,:,:,:,:,:,:)
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!',&
461 CALL xt_redist_a_exchange_l_1d_as(redist, src_size, src_data, dst_size, &
463 END SUBROUTINE xt_redist_a_exchange_l_7d
464END MODULE xt_redist_logical
void xt_redist_a_exchange1(Xt_redist redist, const void *src_data, void *dst_data, Xt_request *request)
void xt_redist_s_exchange(Xt_redist redist, int num_arrays, const void *const src_data[], void *const dst_data[])
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)