55#include "fc_feature_defs.inc"
57 USE xt_core,
ONLY: xt_abort, xt_mpi_fint_kind, i2, i4, i8
59 USE xt_xmap_abstract,
ONLY:
xt_xmap
60 USE iso_c_binding,
ONLY: c_int, c_null_ptr, c_ptr, c_loc, c_associated
61 USE xt_mpi,
ONLY: mpi_address_kind
63#include "xt_slice_c_loc.inc"
69 TYPE,
BIND(C),
PUBLIC :: xt_redist
73 TYPE(c_ptr) :: cptr = c_null_ptr
76 TYPE,
BIND(c),
PUBLIC :: xt_offset_ext
77 INTEGER(c_int) :: start, size, stride
80 TYPE,
BIND(c),
PUBLIC :: xt_aoffset_ext
81 INTEGER(mpi_address_kind) :: start
82 INTEGER(c_int) :: size
83 INTEGER(mpi_address_kind) :: stride
86 TYPE,
BIND(c),
PUBLIC :: xt_redist_msg
87 INTEGER(xt_mpi_fint_kind) :: rank, datatype
93 FUNCTION xt_redist_f2c(redist) bind(c, name='xt_redist_f2c')
RESULT(p)
102 MODULE PROCEDURE xt_redist_delete_1
103 MODULE PROCEDURE xt_redist_delete_a1d
107 SUBROUTINE xt_redist_delete_c(redist) &
108 bind(c, name=
'xt_redist_delete')
111 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist
112 END SUBROUTINE xt_redist_delete_c
116 MODULE PROCEDURE xt_redist_is_null
117 END INTERFACE xt_is_null
121 MODULE PROCEDURE xt_redist_s_exchange_a1d
122 MODULE PROCEDURE xt_redist_s_exchange_i2_a1d
123 MODULE PROCEDURE xt_redist_s_exchange_i4_a1d
124 MODULE PROCEDURE xt_redist_s_exchange_i8_a1d
129 MODULE PROCEDURE xt_redist_a_exchange_a1d
130 MODULE PROCEDURE xt_redist_a_exchange_i2_a1d
131 MODULE PROCEDURE xt_redist_a_exchange_i4_a1d
132 MODULE PROCEDURE xt_redist_a_exchange_i8_a1d
137 SUBROUTINE xt_redist_s_exchange_c(redist, num_ptr, src_data_cptr, &
138 dst_data_cptr) bind(C, name='xt_redist_s_exchange')
139 import:: c_ptr, c_int
140 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist
141 INTEGER(c_int),
VALUE,
INTENT(in) :: num_ptr
142 TYPE(c_ptr),
INTENT(in) :: src_data_cptr(num_ptr), dst_data_cptr(num_ptr)
143 END SUBROUTINE xt_redist_s_exchange_c
145 SUBROUTINE xt_redist_a_exchange_c(redist, num_ptr, src_data_cptr, &
146 dst_data_cptr, request) bind(C, name='xt_redist_a_exchange')
148 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist
149 INTEGER(c_int),
VALUE,
INTENT(in) :: num_ptr
150 TYPE(c_ptr),
INTENT(in) :: src_data_cptr(num_ptr), dst_data_cptr(num_ptr)
152 END SUBROUTINE xt_redist_a_exchange_c
154 FUNCTION xt_redist_get_mpi_comm(redist) &
155 bind(c, name=
'xt_redist_get_mpi_comm_c2f') result(comm)
158 INTEGER(xt_mpi_fint_kind) :: comm
159 END FUNCTION xt_redist_get_mpi_comm
161 FUNCTION xt_redist_get_num_send_msg_c(redist)
RESULT(num_send_msg) &
162 bind(c, name=
'xt_redist_get_num_send_msg')
163 IMPORT :: c_ptr, c_int
165 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist
166 INTEGER(c_int) :: num_send_msg
167 END FUNCTION xt_redist_get_num_send_msg_c
169 FUNCTION xt_redist_get_num_recv_msg_c(redist)
RESULT(num_recv_msg) &
170 bind(c, name=
'xt_redist_get_num_recv_msg')
171 IMPORT :: c_ptr, c_int
173 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist
174 INTEGER(c_int) :: num_recv_msg
175 END FUNCTION xt_redist_get_num_recv_msg_c
177 FUNCTION xt_redist_get_recv_mpi_datatype(redist, rank) &
178 bind(c, name=
'xt_redist_get_recv_MPI_Datatype_c2f') result(dt)
181 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: rank
182 INTEGER(xt_mpi_fint_kind) :: dt
183 END FUNCTION xt_redist_get_recv_mpi_datatype
185 FUNCTION xt_redist_get_send_mpi_datatype(redist, rank) &
186 bind(c, name=
'xt_redist_get_send_MPI_Datatype_c2f') result(dt)
189 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: rank
190 INTEGER(xt_mpi_fint_kind) :: dt
191 END FUNCTION xt_redist_get_send_mpi_datatype
194 src_displacements, dst_displacements, comm_f) &
195 bind(c, name=
'xt_redist_collection_static_new_f') result(res)
196 IMPORT ::
xt_redist, mpi_address_kind, c_ptr, xt_mpi_fint_kind
198 TYPE(
xt_redist),
INTENT(in) :: redists_f(*)
199 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: num_redists
200 INTEGER(mpi_address_kind),
INTENT(in) :: src_displacements(*), &
202 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: comm_f
207 src_displacements, dst_displacements, comm_f, config) &
208 bind(c, name=
'xt_redist_collection_static_custom_new_f') result(res)
211 TYPE(
xt_redist),
INTENT(in) :: redists_f(*)
212 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: num_redists
213 INTEGER(mpi_address_kind),
INTENT(in) :: src_displacements(*), &
215 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: comm_f
221 comm_f) bind(C, name='xt_redist_collection_new_f')
RESULT(res)
222 IMPORT ::
xt_redist, mpi_address_kind, c_ptr, xt_mpi_fint_kind
224 TYPE(
xt_redist),
INTENT(in) :: redists_f(*)
225 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: &
226 num_redists, cache_size, comm_f
231 cache_size, comm_f, config) &
232 bind(c, name=
'xt_redist_collection_custom_new_f') result(res)
235 TYPE(
xt_redist),
INTENT(in) :: redists_f(*)
236 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: &
237 num_redists, cache_size, comm_f
243 num_dst_ext, dst_extents, datatype) &
244 bind(c, name=
'xt_redist_p2p_ext_new_c2f') result(redist)
246 TYPE(
xt_xmap),
INTENT(in) :: xmap
247 INTEGER(c_int),
VALUE,
INTENT(in) :: num_src_ext, num_dst_ext
248 TYPE(
xt_offset_ext),
INTENT(in) :: src_extents(num_src_ext), &
249 dst_extents(num_dst_ext)
250 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
251 TYPE(c_ptr) :: redist
255 num_dst_ext, dst_extents, datatype, config) &
256 bind(c, name=
'xt_redist_p2p_ext_custom_new_c2f') result(redist)
259 TYPE(
xt_xmap),
INTENT(in) :: xmap
260 INTEGER(c_int),
VALUE,
INTENT(in) :: num_src_ext, num_dst_ext
261 TYPE(
xt_offset_ext),
INTENT(in) :: src_extents(num_src_ext), &
262 dst_extents(num_dst_ext)
263 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
265 TYPE(c_ptr) :: redist
269 num_dst_ext, dst_extents, datatype) &
270 bind(c, name=
'xt_redist_p2p_aext_new_c2f') result(redist)
272 TYPE(
xt_xmap),
INTENT(in) :: xmap
273 INTEGER(c_int),
VALUE,
INTENT(in) :: num_src_ext, num_dst_ext
275 dst_extents(num_dst_ext)
276 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
277 TYPE(c_ptr) :: redist
281 num_dst_ext, dst_extents, datatype, config) &
282 bind(c, name=
'xt_redist_p2p_aext_custom_new_c2f') result(redist)
285 TYPE(
xt_xmap),
INTENT(in) :: xmap
286 INTEGER(c_int),
VALUE,
INTENT(in) :: num_src_ext, num_dst_ext
288 dst_extents(num_dst_ext)
289 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
291 TYPE(c_ptr) :: redist
294 FUNCTION xt_redist_repeat_new_c(redist_f, src_extent, dst_extent, &
295 num_repetitions, displacements) &
296 bind(c, name=
'xt_redist_repeat_new') result(res)
297 IMPORT ::
xt_redist, mpi_address_kind, c_ptr, xt_mpi_fint_kind, c_int
299 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist_f
300 INTEGER(mpi_address_kind),
VALUE,
INTENT(in) :: src_extent, dst_extent
301 INTEGER(c_int),
VALUE,
INTENT(in) :: num_repetitions
302 INTEGER(c_int),
INTENT(in) :: displacements(*)
304 END FUNCTION xt_redist_repeat_new_c
306 FUNCTION xt_redist_repeat_custom_new_c(redist_f, src_extent, dst_extent, &
307 num_repetitions, displacements, config) &
308 bind(c, name=
'xt_redist_repeat_custom_new') result(res)
309 IMPORT ::
xt_redist, mpi_address_kind, c_ptr, xt_mpi_fint_kind, c_int
311 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist_f
312 INTEGER(mpi_address_kind),
VALUE,
INTENT(in) :: src_extent, dst_extent
313 INTEGER(c_int),
VALUE,
INTENT(in) :: num_repetitions
314 INTEGER(c_int),
INTENT(in) :: displacements(*)
315 TYPE(c_ptr),
VALUE,
INTENT(in) :: config
317 END FUNCTION xt_redist_repeat_custom_new_c
319 FUNCTION xt_redist_repeat_asym_new_c(redist_f, src_extent, dst_extent, &
320 num_repetitions, src_displacements, dst_displacements) &
321 bind(c, name=
'xt_redist_repeat_asym_new') result(res)
322 IMPORT ::
xt_redist, mpi_address_kind, c_ptr, xt_mpi_fint_kind, c_int
324 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist_f
325 INTEGER(mpi_address_kind),
VALUE,
INTENT(in) :: src_extent, dst_extent
326 INTEGER(c_int),
VALUE,
INTENT(in) :: num_repetitions
327 INTEGER(c_int),
INTENT(in) :: src_displacements(*), dst_displacements(*)
329 END FUNCTION xt_redist_repeat_asym_new_c
331 FUNCTION xt_redist_repeat_asym_custom_new_c(redist_f, src_extent, &
332 dst_extent, num_repetitions, src_displacements, dst_displacements, &
334 bind(c, name=
'xt_redist_repeat_asym_custom_new') result(res)
335 IMPORT ::
xt_redist, mpi_address_kind, c_ptr, xt_mpi_fint_kind, c_int
337 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist_f
338 INTEGER(mpi_address_kind),
VALUE,
INTENT(in) :: src_extent, dst_extent
339 INTEGER(c_int),
VALUE,
INTENT(in) :: num_repetitions
340 INTEGER(c_int),
INTENT(in) :: src_displacements(*), dst_displacements(*)
341 TYPE(c_ptr),
VALUE,
INTENT(in) :: config
343 END FUNCTION xt_redist_repeat_asym_custom_new_c
346 recv_msgs_f, comm_f) &
347 bind(c, name=
'xt_redist_single_array_base_new_c2f') result(res)
348 IMPORT :: c_ptr, c_int, xt_mpi_fint_kind
350 INTEGER(c_int),
VALUE :: nsend, nrecv
351 TYPE(c_ptr),
VALUE,
INTENT(in) :: send_msgs_f, recv_msgs_f
352 INTEGER(xt_mpi_fint_kind),
VALUE :: comm_f
357 send_msgs_f, recv_msgs_f, comm_f, config) &
358 bind(c, name=
'xt_redist_single_array_base_custom_new_c2f') result(res)
359 IMPORT :: c_ptr, c_int, xt_mpi_fint_kind,
xt_config
361 INTEGER(c_int),
VALUE :: nsend, nrecv
362 TYPE(c_ptr),
VALUE,
INTENT(in) :: send_msgs_f, recv_msgs_f
363 INTEGER(xt_mpi_fint_kind),
VALUE :: comm_f
371 MODULE PROCEDURE xt_redist_collection_static_new_a_i_2ak_i
372 MODULE PROCEDURE xt_redist_collection_static_new_a_i_2ak_i_cfg
373 MODULE PROCEDURE xt_redist_collection_static_new_a_2ak_i
374 MODULE PROCEDURE xt_redist_collection_static_new_a_2ak_i_cfg
378 MODULE PROCEDURE xt_redist_collection_static_new_a_i_2ak_i_cfg
379 MODULE PROCEDURE xt_redist_collection_static_new_a_2ak_i_cfg
383 MODULE PROCEDURE xt_redist_collection_new_a_3i
384 MODULE PROCEDURE xt_redist_collection_new_a_3i_cfg
385 MODULE PROCEDURE xt_redist_collection_new_a_2i
386 MODULE PROCEDURE xt_redist_collection_new_a_2i_cfg
387 MODULE PROCEDURE xt_redist_collection_new_a_i
388 MODULE PROCEDURE xt_redist_collection_new_a_i_cfg
392 MODULE PROCEDURE xt_redist_collection_new_a_3i_cfg
393 MODULE PROCEDURE xt_redist_collection_new_a_2i_cfg
394 MODULE PROCEDURE xt_redist_collection_new_a_i_cfg
398 MODULE PROCEDURE xt_redist_p2p_ext_new_i2_a1d_i2_a1d
399 MODULE PROCEDURE xt_redist_p2p_ext_new_i2_a1d_i2_a1d_cfg
400 MODULE PROCEDURE xt_redist_p2p_ext_new_i4_a1d_i4_a1d
401 MODULE PROCEDURE xt_redist_p2p_ext_new_i4_a1d_i4_a1d_cfg
402 MODULE PROCEDURE xt_redist_p2p_ext_new_i8_a1d_i8_a1d
403 MODULE PROCEDURE xt_redist_p2p_ext_new_i8_a1d_i8_a1d_cfg
404 MODULE PROCEDURE xt_redist_p2p_ext_new_a1d_a1d
405 MODULE PROCEDURE xt_redist_p2p_ext_new_a1d_a1d_cfg
409 MODULE PROCEDURE xt_redist_p2p_ext_new_i2_a1d_i2_a1d_cfg
410 MODULE PROCEDURE xt_redist_p2p_ext_new_i4_a1d_i4_a1d_cfg
411 MODULE PROCEDURE xt_redist_p2p_ext_new_i8_a1d_i8_a1d_cfg
412 MODULE PROCEDURE xt_redist_p2p_ext_new_a1d_a1d_cfg
416 MODULE PROCEDURE xt_redist_p2p_aext_new_i2_a1d_i2_a1d
417 MODULE PROCEDURE xt_redist_p2p_aext_new_i2_a1d_i2_a1d_cfg
418 MODULE PROCEDURE xt_redist_p2p_aext_new_i4_a1d_i4_a1d
419 MODULE PROCEDURE xt_redist_p2p_aext_new_i4_a1d_i4_a1d_cfg
420 MODULE PROCEDURE xt_redist_p2p_aext_new_i8_a1d_i8_a1d
421 MODULE PROCEDURE xt_redist_p2p_aext_new_i8_a1d_i8_a1d_cfg
422 MODULE PROCEDURE xt_redist_p2p_aext_new_a1d_a1d
423 MODULE PROCEDURE xt_redist_p2p_aext_new_a1d_a1d_cfg
427 MODULE PROCEDURE xt_redist_p2p_aext_new_i2_a1d_i2_a1d_cfg
428 MODULE PROCEDURE xt_redist_p2p_aext_new_i4_a1d_i4_a1d_cfg
429 MODULE PROCEDURE xt_redist_p2p_aext_new_i8_a1d_i8_a1d_cfg
430 MODULE PROCEDURE xt_redist_p2p_aext_new_a1d_a1d_cfg
434 MODULE PROCEDURE xt_redist_repeat_new_i4_a1d
435 MODULE PROCEDURE xt_redist_repeat_new_i4_a1d_cfg
436 MODULE PROCEDURE xt_redist_repeat_new_a1d
437 MODULE PROCEDURE xt_redist_repeat_new_a1d_cfg
438 MODULE PROCEDURE xt_redist_repeat_asym_new_i4_a1d
439 MODULE PROCEDURE xt_redist_repeat_asym_new_i4_a1d_cfg
440 MODULE PROCEDURE xt_redist_repeat_asym_new_a1d
441 MODULE PROCEDURE xt_redist_repeat_asym_new_a1d_cfg
445 MODULE PROCEDURE xt_redist_repeat_new_i4_a1d_cfg
446 MODULE PROCEDURE xt_redist_repeat_new_a1d_cfg
447 MODULE PROCEDURE xt_redist_repeat_asym_new_i4_a1d_cfg
448 MODULE PROCEDURE xt_redist_repeat_asym_new_a1d_cfg
452 MODULE PROCEDURE xt_redist_single_array_base_new_i2_a1d_i2_a1d
453 MODULE PROCEDURE xt_redist_single_array_base_new_i2_a1d_i2_a1d_cfg
454 MODULE PROCEDURE xt_redist_single_array_base_new_i4_a1d_i4_a1d
455 MODULE PROCEDURE xt_redist_single_array_base_new_i4_a1d_i4_a1d_cfg
456 MODULE PROCEDURE xt_redist_single_array_base_new_i8_a1d_i8_a1d
457 MODULE PROCEDURE xt_redist_single_array_base_new_i8_a1d_i8_a1d_cfg
458 MODULE PROCEDURE xt_redist_single_array_base_new_a1d_a1d
459 MODULE PROCEDURE xt_redist_single_array_base_new_a1d_a1d_cfg
463 MODULE PROCEDURE xt_redist_single_array_base_new_i2_a1d_i2_a1d_cfg
464 MODULE PROCEDURE xt_redist_single_array_base_new_i4_a1d_i4_a1d_cfg
465 MODULE PROCEDURE xt_redist_single_array_base_new_i8_a1d_i8_a1d_cfg
466 MODULE PROCEDURE xt_redist_single_array_base_new_a1d_a1d_cfg
477 xt_redist_get_send_mpi_datatype, xt_redist_get_recv_mpi_datatype, &
483 CHARACTER(len=*),
PARAMETER :: filename =
'xt_redist_f.f90'
486 FUNCTION xt_redist_is_null(redist)
RESULT(p)
489 p = .NOT. c_associated(redist%cptr)
490 END FUNCTION xt_redist_is_null
492 FUNCTION xt_redist_c2f(redist)
RESULT(p)
493 TYPE(c_ptr),
INTENT(in) :: redist
496 END FUNCTION xt_redist_c2f
502 FUNCTION xt_redist_copy_c(redist) bind(C, name='xt_redist_copy')
504 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist
505 TYPE(c_ptr) :: xt_redist_copy_c
506 END FUNCTION xt_redist_copy_c
508 redist_copy%cptr = xt_redist_copy_c(redist%cptr)
511 SUBROUTINE xt_redist_delete_1(redist)
513 CALL xt_redist_delete_c(redist%cptr)
514 redist%cptr = c_null_ptr
515 END SUBROUTINE xt_redist_delete_1
517 SUBROUTINE xt_redist_delete_a1d(redists)
518 TYPE(
xt_redist),
INTENT(inout) :: redists(:)
522 CALL xt_redist_delete_c(redists(i)%cptr)
523 redists(i)%cptr = c_null_ptr
525 END SUBROUTINE xt_redist_delete_a1d
529 INTEGER :: num_send_msg
531 n = xt_redist_get_num_send_msg_c(redist%cptr)
532 IF (n > huge(num_send_msg) .OR. n < -huge(num_send_msg)) &
533 CALL xt_abort(
"num_send_msg out of bounds", filename, __line__)
534 num_send_msg = int(n)
539 INTEGER :: num_recv_msg
541 n = xt_redist_get_num_recv_msg_c(redist%cptr)
542 IF (n > huge(num_recv_msg) .OR. n < -huge(num_recv_msg)) &
543 CALL xt_abort(
"num_recv_msg out of bounds", filename, __line__)
544 num_recv_msg = int(n)
549 TYPE(c_ptr),
INTENT(in) :: src_data_cptr, dst_data_cptr
551 SUBROUTINE xt_redist_s_exchange1_c(redist, src_data_cptr, dst_data_cptr) &
552 bind(c, name=
'xt_redist_s_exchange1')
554 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist
555 TYPE(c_ptr),
VALUE :: src_data_cptr, dst_data_cptr
556 END SUBROUTINE xt_redist_s_exchange1_c
558 CALL xt_redist_s_exchange1_c(redist%cptr, src_data_cptr, dst_data_cptr)
564 TYPE(c_ptr) :: src_data_cptr, dst_data_cptr
567 SUBROUTINE xt_redist_a_exchange1_c(redist, src_data_cptr, &
568 dst_data_cptr, request_c) bind(C, name='xt_redist_a_exchange1')
570 TYPE(c_ptr),
VALUE,
INTENT(in) :: redist
571 TYPE(c_ptr),
VALUE :: src_data_cptr, dst_data_cptr
573 END SUBROUTINE xt_redist_a_exchange1_c
575 CALL xt_redist_a_exchange1_c(redist%cptr, src_data_cptr, &
576 & dst_data_cptr, request)
579 SUBROUTINE xt_redist_s_exchange_a1d(redist, src_data_cptr, dst_data_cptr)
581 TYPE(c_ptr),
INTENT(in) :: src_data_cptr(:), dst_data_cptr(:)
583 INTEGER(c_int) :: num_ptr_c
584#if __INTEL_COMPILER == 1910 && __INTEL_COMPILER_UPDATE == 2
585 TYPE(c_ptr) :: contig_src_data_cptr(size(src_data_cptr)), &
586 contig_dst_data_cptr(size(dst_data_cptr))
587 contig_src_data_cptr = src_data_cptr
588 contig_dst_data_cptr = dst_data_cptr
590 n =
SIZE(src_data_cptr)
591 IF (n /=
SIZE(dst_data_cptr) .OR. n > huge(1_c_int)) &
592 CALL xt_abort(
"invalid number of pointers", filename, __line__)
593 num_ptr_c = int(n, c_int)
594#if __INTEL_COMPILER == 1910 && __INTEL_COMPILER_UPDATE == 2
595 CALL xt_redist_s_exchange_c(redist%cptr, num_ptr_c, &
596 contig_src_data_cptr, contig_dst_data_cptr)
598 CALL xt_redist_s_exchange_c(redist%cptr, num_ptr_c, &
599 src_data_cptr, dst_data_cptr)
601 END SUBROUTINE xt_redist_s_exchange_a1d
603 SUBROUTINE xt_redist_a_exchange_a1d(redist, src_data_cptr, dst_data_cptr, &
606 TYPE(c_ptr),
INTENT(in) :: src_data_cptr(:), dst_data_cptr(:)
609 INTEGER(c_int) :: num_ptr_c
610#if __INTEL_COMPILER == 1910 && __INTEL_COMPILER_UPDATE == 2
611 TYPE(c_ptr) :: contig_src_data_cptr(size(src_data_cptr)), &
612 contig_dst_data_cptr(size(dst_data_cptr))
613 contig_src_data_cptr = src_data_cptr
614 contig_dst_data_cptr = dst_data_cptr
616 num_ptr =
SIZE(src_data_cptr)
617 IF (num_ptr /=
SIZE(dst_data_cptr) .OR. num_ptr > huge(1_c_int)) &
618 CALL xt_abort(
"invalid number of pointers", filename, __line__)
619 num_ptr_c = int(num_ptr, c_int)
620#if __INTEL_COMPILER == 1910 && __INTEL_COMPILER_UPDATE == 2
621 CALL xt_redist_a_exchange_c(redist%cptr, num_ptr_c, &
622 contig_src_data_cptr, contig_dst_data_cptr, request)
624 CALL xt_redist_a_exchange_c(redist%cptr, num_ptr_c, &
625 src_data_cptr, dst_data_cptr, request)
627 END SUBROUTINE xt_redist_a_exchange_a1d
629 SUBROUTINE xt_redist_s_exchange_i2_a1d(redist, num_ptr, &
630 src_data_cptr, dst_data_cptr)
632 INTEGER(i2),
INTENT(in) :: num_ptr
633 TYPE(c_ptr),
INTENT(in) :: src_data_cptr(num_ptr), dst_data_cptr(num_ptr)
634 INTEGER(c_int) :: num_ptr_c
635 IF (num_ptr < 0_i2) &
636 CALL xt_abort(
"invalid number of pointers", filename, __line__)
637 num_ptr_c = int(num_ptr, c_int)
638 CALL xt_redist_s_exchange_c(redist%cptr, num_ptr_c, &
639 src_data_cptr, dst_data_cptr)
640 END SUBROUTINE xt_redist_s_exchange_i2_a1d
642 SUBROUTINE xt_redist_a_exchange_i2_a1d(redist, num_ptr, &
643 src_data_cptr, dst_data_cptr, request)
645 INTEGER(i2),
INTENT(in) :: num_ptr
647 TYPE(c_ptr),
INTENT(in) :: src_data_cptr(num_ptr), dst_data_cptr(num_ptr)
648 INTEGER(c_int) :: num_ptr_c
649 IF (num_ptr < 0_i2) &
650 CALL xt_abort(
"invalid number of pointers", filename, __line__)
651 num_ptr_c = int(num_ptr, c_int)
652 CALL xt_redist_a_exchange_c(redist%cptr, num_ptr_c, &
653 src_data_cptr, dst_data_cptr, request)
654 END SUBROUTINE xt_redist_a_exchange_i2_a1d
656 SUBROUTINE xt_redist_s_exchange_i4_a1d(redist, num_ptr, &
657 src_data_cptr, dst_data_cptr)
659 INTEGER(i4),
INTENT(in) :: num_ptr
660 TYPE(c_ptr),
INTENT(in) :: src_data_cptr(num_ptr), dst_data_cptr(num_ptr)
661 INTEGER(c_int) :: num_ptr_c
662 IF (num_ptr < 0_i4 .OR. num_ptr > huge(1_c_int)) &
663 CALL xt_abort(
"invalid number of pointers", filename, __line__)
664 num_ptr_c = int(num_ptr, c_int)
665 CALL xt_redist_s_exchange_c(redist%cptr, num_ptr_c, &
666 src_data_cptr, dst_data_cptr)
667 END SUBROUTINE xt_redist_s_exchange_i4_a1d
669 SUBROUTINE xt_redist_a_exchange_i4_a1d(redist, num_ptr, &
670 src_data_cptr, dst_data_cptr, request)
672 INTEGER(i4),
INTENT(in) :: num_ptr
674 TYPE(c_ptr),
INTENT(in) :: src_data_cptr(num_ptr), dst_data_cptr(num_ptr)
675 INTEGER(c_int) :: num_ptr_c
676 IF (num_ptr < 0_i4 .OR. num_ptr > huge(1_c_int)) &
677 CALL xt_abort(
"invalid number of pointers", filename, __line__)
678 num_ptr_c = int(num_ptr, c_int)
679 CALL xt_redist_a_exchange_c(redist%cptr, num_ptr_c, &
680 src_data_cptr, dst_data_cptr, request)
681 END SUBROUTINE xt_redist_a_exchange_i4_a1d
683 SUBROUTINE xt_redist_s_exchange_i8_a1d(redist, num_ptr, &
684 src_data_cptr, dst_data_cptr)
686 INTEGER(i8),
INTENT(in) :: num_ptr
687 TYPE(c_ptr),
INTENT(in) :: src_data_cptr(num_ptr), dst_data_cptr(num_ptr)
688 INTEGER(c_int) :: num_ptr_c
689 IF (num_ptr < 0_i8 .OR. num_ptr > huge(1_c_int)) &
690 CALL xt_abort(
"invalid number of pointers", filename, __line__)
691 num_ptr_c = int(num_ptr, c_int)
692 CALL xt_redist_s_exchange_c(redist%cptr, num_ptr_c, &
693 src_data_cptr, dst_data_cptr)
694 END SUBROUTINE xt_redist_s_exchange_i8_a1d
696 SUBROUTINE xt_redist_a_exchange_i8_a1d(redist, num_ptr, &
697 src_data_cptr, dst_data_cptr, request)
699 INTEGER(i8),
INTENT(in) :: num_ptr
701 TYPE(c_ptr),
INTENT(in) :: src_data_cptr(num_ptr), dst_data_cptr(num_ptr)
702 INTEGER(c_int) :: num_ptr_c
703 IF (num_ptr < 0_i8 .OR. num_ptr > huge(1_c_int)) &
704 CALL xt_abort(
"invalid number of pointers", filename, __line__)
705 num_ptr_c = int(num_ptr, c_int)
706 CALL xt_redist_a_exchange_c(redist%cptr, num_ptr_c, &
707 src_data_cptr, dst_data_cptr, request)
708 END SUBROUTINE xt_redist_a_exchange_i8_a1d
711 TYPE(
xt_xmap),
INTENT(in) :: xmap
712 INTEGER,
INTENT(in) :: datatype
716 bind(c, name=
'xt_redist_p2p_new_f') result(res_ptr)
719 TYPE(
xt_xmap),
INTENT(in) :: xmap
720 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
721 TYPE(c_ptr) :: res_ptr
728 TYPE(
xt_xmap),
INTENT(in) :: xmap
729 INTEGER,
INTENT(in) :: datatype
734 bind(c, name=
'xt_redist_p2p_custom_new_f') result(res_ptr)
737 TYPE(
xt_xmap),
INTENT(in) :: xmap
738 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
740 TYPE(c_ptr) :: res_ptr
749 TYPE(
xt_xmap),
INTENT(in) :: xmap
750 INTEGER,
INTENT(in) :: src_offsets(*)
751 INTEGER,
INTENT(in) :: dst_offsets(*)
752 INTEGER,
INTENT(in) :: datatype
756 datatype) bind(C, name='xt_redist_p2p_off_new_f')
RESULT(res_ptr)
759 TYPE(
xt_xmap),
INTENT(in) :: xmap
760 INTEGER(xt_mpi_fint_kind),
INTENT(in) :: src_offsets(*), dst_offsets(*)
761 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
762 TYPE(c_ptr) :: res_ptr
769 datatype, config)
RESULT(res)
771 TYPE(
xt_xmap),
INTENT(in) :: xmap
772 INTEGER,
INTENT(in) :: src_offsets(*), dst_offsets(*)
773 INTEGER,
INTENT(in) :: datatype
778 datatype, config) bind(C, name='xt_redist_p2p_off_custom_new_f') &
782 TYPE(
xt_xmap),
INTENT(in) :: xmap
783 INTEGER(xt_mpi_fint_kind),
INTENT(in) :: src_offsets(*), dst_offsets(*)
784 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
786 TYPE(c_ptr) :: res_ptr
794 & dst_block_sizes, dst_block_num, &
798 TYPE(
xt_xmap),
INTENT(in) :: xmap
799 INTEGER(c_int),
INTENT(in) :: src_block_sizes(*), src_block_num, &
800 dst_block_sizes(*), dst_block_num
801 INTEGER,
INTENT(in) :: datatype
805 & src_block_sizes, src_block_num, &
806 & dst_block_sizes, dst_block_num, &
808 bind(c, name=
'xt_redist_p2p_blocks_new_f') result(res_ptr)
811 TYPE(
xt_xmap),
INTENT(in) :: xmap
812 INTEGER(c_int),
VALUE,
INTENT(in) :: src_block_num, dst_block_num
813 INTEGER(c_int),
INTENT(in) :: src_block_sizes(*), dst_block_sizes(*)
814 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
815 TYPE(c_ptr) :: res_ptr
819 & src_block_sizes, src_block_num, &
820 & dst_block_sizes, dst_block_num, &
826 & dst_block_sizes, dst_block_num, &
827 & datatype, config) &
830 TYPE(
xt_xmap),
INTENT(in) :: xmap
831 INTEGER(c_int),
INTENT(in) :: src_block_sizes(*), src_block_num, &
832 dst_block_sizes(*), dst_block_num
833 INTEGER,
INTENT(in) :: datatype
838 & src_block_sizes, src_block_num, &
839 & dst_block_sizes, dst_block_num, &
840 & datatype, config) &
841 bind(c, name=
'xt_redist_p2p_blocks_custom_new_f') result(res_ptr)
844 TYPE(
xt_xmap),
INTENT(in) :: xmap
845 INTEGER(c_int),
VALUE,
INTENT(in) :: src_block_num, dst_block_num
846 INTEGER(c_int),
INTENT(in) :: src_block_sizes(*), dst_block_sizes(*)
847 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
849 TYPE(c_ptr) :: res_ptr
853 & src_block_sizes, src_block_num, &
854 & dst_block_sizes, dst_block_num, datatype, config)
858 src_block_sizes, src_block_num, &
859 dst_block_offsets, dst_block_sizes, dst_block_num, &
860 datatype)
RESULT(res)
862 TYPE(
xt_xmap),
INTENT(in) :: xmap
863 INTEGER(c_int),
INTENT(in) :: src_block_offsets(*)
864 INTEGER(c_int),
INTENT(in) :: src_block_sizes(*)
865 INTEGER(c_int),
VALUE,
INTENT(in) :: src_block_num
866 INTEGER(c_int),
INTENT(in) :: dst_block_offsets(*)
867 INTEGER(c_int),
INTENT(in) :: dst_block_sizes(*)
868 INTEGER(c_int),
VALUE,
INTENT(in) :: dst_block_num
869 INTEGER,
INTENT(in) :: datatype
873 src_block_sizes, src_block_num, &
874 dst_block_offsets, dst_block_sizes, dst_block_num, &
875 datatype) bind(C, name='xt_redist_p2p_blocks_off_new_f') &
879 TYPE(
xt_xmap),
INTENT(in) :: xmap
880 INTEGER(c_int),
INTENT(in) :: src_block_offsets(*), src_block_sizes(*),&
881 dst_block_offsets(*), dst_block_sizes(*)
882 INTEGER(c_int),
VALUE,
INTENT(in) :: src_block_num, dst_block_num
883 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
884 TYPE(c_ptr) :: res_ptr
888 src_block_sizes, src_block_num, &
889 dst_block_offsets, dst_block_sizes, dst_block_num, datatype)
893 src_block_sizes, src_block_num, &
894 dst_block_offsets, dst_block_sizes, dst_block_num, &
895 datatype, config)
RESULT(res)
897 TYPE(
xt_xmap),
INTENT(in) :: xmap
898 INTEGER(c_int),
INTENT(in) :: src_block_offsets(*), src_block_sizes(*), &
899 dst_block_offsets(*), dst_block_sizes(*)
900 INTEGER(c_int),
INTENT(in) :: src_block_num, dst_block_num
901 INTEGER,
INTENT(in) :: datatype
906 src_block_sizes, src_block_num, &
907 dst_block_offsets, dst_block_sizes, dst_block_num, &
909 bind(c, name=
'xt_redist_p2p_blocks_off_custom_new_f') result(res_ptr)
912 TYPE(
xt_xmap),
INTENT(in) :: xmap
913 INTEGER(c_int),
INTENT(in) :: src_block_offsets(*), src_block_sizes(*),&
914 dst_block_offsets(*), dst_block_sizes(*)
915 INTEGER(c_int),
VALUE,
INTENT(in) :: src_block_num
916 INTEGER(c_int),
VALUE,
INTENT(in) :: dst_block_num
917 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: datatype
919 TYPE(c_ptr) :: res_ptr
924 src_block_offsets, src_block_sizes, src_block_num, &
925 dst_block_offsets, dst_block_sizes, dst_block_num, &
929 FUNCTION xt_redist_collection_static_new_a_i_2ak_i(redists, num_redists, &
930 src_displacements, dst_displacements, comm)
RESULT(res)
931 TYPE(
xt_redist),
INTENT(in) :: redists(*)
932 INTEGER,
INTENT(in) :: num_redists, comm
933 INTEGER(mpi_address_kind),
INTENT(in) :: src_displacements(*), &
936 INTEGER(c_int) :: num_redists_c
937 num_redists_c = int(num_redists, c_int)
939 num_redists_c, src_displacements, dst_displacements, comm)
940 END FUNCTION xt_redist_collection_static_new_a_i_2ak_i
942 FUNCTION xt_redist_collection_static_new_a_i_2ak_i_cfg(redists, num_redists, &
943 src_displacements, dst_displacements, comm, config)
RESULT(res)
944 TYPE(
xt_redist),
INTENT(in) :: redists(*)
945 INTEGER,
INTENT(in) :: num_redists, comm
946 INTEGER(mpi_address_kind),
INTENT(in) :: src_displacements(*), &
950 INTEGER(c_int) :: num_redists_c
951 num_redists_c = int(num_redists, c_int)
953 num_redists_c, src_displacements, dst_displacements, comm, config)
954 END FUNCTION xt_redist_collection_static_new_a_i_2ak_i_cfg
956 FUNCTION xt_redist_collection_static_new_a_2ak_i(redists, &
957 src_displacements, dst_displacements, comm)
RESULT(res)
958 TYPE(
xt_redist),
INTENT(in) :: redists(:)
959 INTEGER,
INTENT(in) :: comm
960 INTEGER(mpi_address_kind),
INTENT(in) :: src_displacements(:), &
963 INTEGER :: num_redists
964 num_redists =
SIZE(redists)
965 IF (num_redists /=
SIZE(src_displacements) &
966 .OR. num_redists /=
SIZE(dst_displacements)) &
967 CALL xt_abort(
"invalid number of redists", filename, __line__)
969 num_redists, src_displacements, dst_displacements, comm)
970 END FUNCTION xt_redist_collection_static_new_a_2ak_i
972 FUNCTION xt_redist_collection_static_new_a_2ak_i_cfg(redists, &
973 src_displacements, dst_displacements, comm, config)
RESULT(res)
974 TYPE(
xt_redist),
INTENT(in) :: redists(:)
975 INTEGER,
INTENT(in) :: comm
976 INTEGER(mpi_address_kind),
INTENT(in) :: src_displacements(:), &
980 INTEGER :: num_redists
981 num_redists =
SIZE(redists)
982 IF (num_redists /=
SIZE(src_displacements) &
983 .OR. num_redists /=
SIZE(dst_displacements)) &
984 CALL xt_abort(
"invalid number of redists", filename, __line__)
986 num_redists, src_displacements, dst_displacements, comm, config)
987 END FUNCTION xt_redist_collection_static_new_a_2ak_i_cfg
989 FUNCTION xt_redist_collection_new_a_3i(redists, num_redists, cache_size, &
991 TYPE(
xt_redist),
INTENT(in) :: redists(*)
992 INTEGER,
INTENT(in) :: num_redists, cache_size, comm
996 END FUNCTION xt_redist_collection_new_a_3i
998 FUNCTION xt_redist_collection_new_a_3i_cfg(redists, num_redists, cache_size, &
999 comm, config)
RESULT(res)
1000 TYPE(
xt_redist),
INTENT(in) :: redists(*)
1001 INTEGER,
INTENT(in) :: num_redists, cache_size, comm
1005 cache_size, comm, config)
1006 END FUNCTION xt_redist_collection_new_a_3i_cfg
1008 FUNCTION xt_redist_collection_new_a_2i(redists, cache_size, comm) &
1010 TYPE(
xt_redist),
INTENT(in) :: redists(:)
1011 INTEGER,
INTENT(in) :: cache_size, comm
1013 INTEGER :: num_redists
1014 num_redists =
SIZE(redists)
1016 num_redists, cache_size, comm)
1017 END FUNCTION xt_redist_collection_new_a_2i
1019 FUNCTION xt_redist_collection_new_a_2i_cfg(redists, cache_size, comm, &
1021 TYPE(
xt_redist),
INTENT(in) :: redists(:)
1022 INTEGER,
INTENT(in) :: cache_size, comm
1025 INTEGER :: num_redists
1026 num_redists =
SIZE(redists)
1028 num_redists, cache_size, comm, config)
1029 END FUNCTION xt_redist_collection_new_a_2i_cfg
1031 FUNCTION xt_redist_collection_new_a_i(redists, comm) &
1033 TYPE(
xt_redist),
INTENT(in) :: redists(:)
1034 INTEGER,
INTENT(in) :: comm
1037 res = xt_redist_collection_new_a_3i(redists,
SIZE(redists), -1, comm)
1038 END FUNCTION xt_redist_collection_new_a_i
1040 FUNCTION xt_redist_collection_new_a_i_cfg(redists, comm, config) &
1042 TYPE(
xt_redist),
INTENT(in) :: redists(:)
1043 INTEGER,
INTENT(in) :: comm
1047 res = xt_redist_collection_new_a_3i_cfg(redists,
SIZE(redists), &
1049 END FUNCTION xt_redist_collection_new_a_i_cfg
1052 FUNCTION xt_redist_repeat_new_i4_a1d(redist, src_extent, dst_extent, &
1053 num_repetitions, displacements)
RESULT(res)
1055 INTEGER(mpi_address_kind),
INTENT(in) :: src_extent, dst_extent
1056 INTEGER(i4),
INTENT(in) :: num_repetitions
1057 INTEGER(c_int),
INTENT(in) :: displacements(num_repetitions)
1059 INTEGER(c_int) :: num_repetitions_c
1060 num_repetitions_c = int(num_repetitions, c_int)
1061 res%cptr = xt_redist_repeat_new_c(redist%cptr, &
1062 src_extent, dst_extent, num_repetitions_c, displacements)
1063 END FUNCTION xt_redist_repeat_new_i4_a1d
1065 FUNCTION xt_redist_repeat_new_i4_a1d_cfg(redist, src_extent, dst_extent, &
1066 num_repetitions, displacements, config)
RESULT(res)
1068 INTEGER(mpi_address_kind),
INTENT(in) :: src_extent, dst_extent
1069 INTEGER(i4),
INTENT(in) :: num_repetitions
1070 INTEGER(c_int),
INTENT(in) :: displacements(num_repetitions)
1073 INTEGER(c_int) :: num_repetitions_c
1074 num_repetitions_c = int(num_repetitions, c_int)
1075 res%cptr = xt_redist_repeat_custom_new_c(redist%cptr, &
1076 src_extent, dst_extent, num_repetitions_c, displacements, &
1078 END FUNCTION xt_redist_repeat_new_i4_a1d_cfg
1080 FUNCTION xt_redist_repeat_new_a1d(redist, src_extent, dst_extent, &
1081 displacements)
RESULT(res)
1083 INTEGER(mpi_address_kind),
INTENT(in) :: src_extent, dst_extent
1084 INTEGER(c_int),
INTENT(in) :: displacements(:)
1086 INTEGER(c_int) :: num_repetitions_c
1087 num_repetitions_c = int(
SIZE(displacements), c_int)
1088 res%cptr = xt_redist_repeat_new_c(redist%cptr, &
1089 src_extent, dst_extent, num_repetitions_c, displacements)
1090 END FUNCTION xt_redist_repeat_new_a1d
1092 FUNCTION xt_redist_repeat_new_a1d_cfg(redist, src_extent, dst_extent, &
1093 displacements, config)
RESULT(res)
1095 INTEGER(mpi_address_kind),
INTENT(in) :: src_extent, dst_extent
1096 INTEGER(c_int),
INTENT(in) :: displacements(:)
1099 INTEGER(c_int) :: num_repetitions_c
1100 num_repetitions_c = int(
SIZE(displacements), c_int)
1101 res%cptr = xt_redist_repeat_custom_new_c(redist%cptr, &
1102 src_extent, dst_extent, num_repetitions_c, displacements, &
1104 END FUNCTION xt_redist_repeat_new_a1d_cfg
1106 FUNCTION xt_redist_repeat_asym_new_i4_a1d(redist, src_extent, dst_extent, &
1107 num_repetitions, src_displacements, dst_displacements)
RESULT(res)
1109 INTEGER(mpi_address_kind),
INTENT(in) :: src_extent, dst_extent
1110 INTEGER(i4),
INTENT(in) :: num_repetitions
1111 INTEGER(c_int),
INTENT(in) :: src_displacements(num_repetitions), &
1112 & dst_displacements(num_repetitions)
1114 INTEGER(c_int) :: num_repetitions_c
1115 num_repetitions_c = int(num_repetitions, c_int)
1116 res%cptr = xt_redist_repeat_asym_new_c(redist%cptr, &
1117 src_extent, dst_extent, num_repetitions_c, src_displacements, &
1119 END FUNCTION xt_redist_repeat_asym_new_i4_a1d
1121 FUNCTION xt_redist_repeat_asym_new_i4_a1d_cfg(redist, src_extent, dst_extent,&
1122 num_repetitions, src_displacements, dst_displacements, config) &
1125 INTEGER(mpi_address_kind),
INTENT(in) :: src_extent, dst_extent
1126 INTEGER(i4),
INTENT(in) :: num_repetitions
1127 INTEGER(c_int),
INTENT(in) :: src_displacements(num_repetitions), &
1128 & dst_displacements(num_repetitions)
1131 INTEGER(c_int) :: num_repetitions_c
1132 num_repetitions_c = int(num_repetitions, c_int)
1133 res%cptr = xt_redist_repeat_asym_custom_new_c(redist%cptr, &
1134 src_extent, dst_extent, num_repetitions_c, src_displacements, &
1136 END FUNCTION xt_redist_repeat_asym_new_i4_a1d_cfg
1138 FUNCTION xt_redist_repeat_asym_new_a1d(redist, src_extent, dst_extent, &
1139 src_displacements, dst_displacements)
RESULT(res)
1141 INTEGER(mpi_address_kind),
INTENT(in) :: src_extent, dst_extent
1142 INTEGER(c_int),
INTENT(in) :: src_displacements(:), dst_displacements(:)
1144 INTEGER(i4) :: num_repetitions
1145 num_repetitions =
SIZE(src_displacements)
1146 IF (num_repetitions /=
SIZE(dst_displacements)) &
1147 CALL xt_abort(
"inequal size for src and dst displacements", &
1149 res%cptr = xt_redist_repeat_asym_new_c(redist%cptr, &
1150 src_extent, dst_extent, num_repetitions, src_displacements, &
1152 END FUNCTION xt_redist_repeat_asym_new_a1d
1154 FUNCTION xt_redist_repeat_asym_new_a1d_cfg(redist, src_extent, dst_extent, &
1155 src_displacements, dst_displacements, config)
RESULT(res)
1157 INTEGER(mpi_address_kind),
INTENT(in) :: src_extent, dst_extent
1158 INTEGER(c_int),
INTENT(in) :: src_displacements(:), dst_displacements(:)
1161 INTEGER(i4) :: num_repetitions
1162 num_repetitions =
SIZE(src_displacements)
1163 IF (num_repetitions /=
SIZE(dst_displacements)) &
1164 CALL xt_abort(
"inequal size for src and dst displacements", &
1166 res%cptr = xt_redist_repeat_asym_custom_new_c(redist%cptr, &
1167 src_extent, dst_extent, num_repetitions, src_displacements, &
1169 END FUNCTION xt_redist_repeat_asym_new_a1d_cfg
1171 FUNCTION xt_redist_p2p_ext_new_i2_a1d_i2_a1d(xmap, num_src_ext, src_extents, &
1172 num_dst_ext, dst_extents, datatype)
RESULT(redist)
1173 TYPE(
xt_xmap),
INTENT(in) :: xmap
1174 INTEGER(i2),
INTENT(in) :: num_src_ext, num_dst_ext
1175 TYPE(
xt_offset_ext),
INTENT(in) :: src_extents(num_src_ext), &
1176 dst_extents(num_dst_ext)
1177 INTEGER,
INTENT(in) :: datatype
1179 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1180 IF (num_src_ext < 0_i2 .OR. num_src_ext > huge(1_c_int) &
1181 .OR. num_dst_ext < 0_i2 .OR. num_dst_ext > huge(1_c_int)) &
1182 CALL xt_abort(
"invalid number of extents", filename, __line__)
1183 num_src_ext_c = int(num_src_ext, c_int)
1184 num_dst_ext_c = int(num_dst_ext, c_int)
1186 num_src_ext_c, src_extents, num_dst_ext_c, dst_extents, datatype)
1187 END FUNCTION xt_redist_p2p_ext_new_i2_a1d_i2_a1d
1189 FUNCTION xt_redist_p2p_ext_new_i2_a1d_i2_a1d_cfg(xmap, num_src_ext, &
1190 src_extents, num_dst_ext, dst_extents, datatype, config)
RESULT(redist)
1191 TYPE(
xt_xmap),
INTENT(in) :: xmap
1192 INTEGER(i2),
INTENT(in) :: num_src_ext, num_dst_ext
1193 TYPE(
xt_offset_ext),
INTENT(in) :: src_extents(num_src_ext), &
1194 dst_extents(num_dst_ext)
1195 INTEGER,
INTENT(in) :: datatype
1198 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1199 IF (num_src_ext < 0_i2 .OR. num_src_ext > huge(1_c_int) &
1200 .OR. num_dst_ext < 0_i2 .OR. num_dst_ext > huge(1_c_int)) &
1201 CALL xt_abort(
"invalid number of extents", filename, __line__)
1202 num_src_ext_c = int(num_src_ext, c_int)
1203 num_dst_ext_c = int(num_dst_ext, c_int)
1205 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1206 END FUNCTION xt_redist_p2p_ext_new_i2_a1d_i2_a1d_cfg
1208 FUNCTION xt_redist_p2p_ext_new_i4_a1d_i4_a1d(xmap, num_src_ext, src_extents, &
1209 num_dst_ext, dst_extents, datatype)
RESULT(redist)
1210 TYPE(
xt_xmap),
INTENT(in) :: xmap
1211 INTEGER(i4),
INTENT(in) :: num_src_ext, num_dst_ext
1212 TYPE(
xt_offset_ext),
INTENT(in) :: src_extents(num_src_ext), &
1213 dst_extents(num_dst_ext)
1214 INTEGER,
INTENT(in) :: datatype
1216 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1217 IF (num_src_ext < 0_i4 .OR. num_src_ext > huge(1_c_int) &
1218 .OR. num_dst_ext < 0_i4 .OR. num_dst_ext > huge(1_c_int)) &
1219 CALL xt_abort(
"invalid number of extents", filename, __line__)
1220 num_src_ext_c = int(num_src_ext, c_int)
1221 num_dst_ext_c = int(num_dst_ext, c_int)
1223 src_extents, num_dst_ext_c, dst_extents, datatype)
1224 END FUNCTION xt_redist_p2p_ext_new_i4_a1d_i4_a1d
1226 FUNCTION xt_redist_p2p_ext_new_i4_a1d_i4_a1d_cfg(xmap, num_src_ext, &
1227 src_extents, num_dst_ext, dst_extents, datatype, config)
RESULT(redist)
1228 TYPE(
xt_xmap),
INTENT(in) :: xmap
1229 INTEGER(i4),
INTENT(in) :: num_src_ext, num_dst_ext
1230 TYPE(
xt_offset_ext),
INTENT(in) :: src_extents(num_src_ext), &
1231 dst_extents(num_dst_ext)
1232 INTEGER,
INTENT(in) :: datatype
1235 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1236 IF (num_src_ext < 0_i4 .OR. num_src_ext > huge(1_c_int) &
1237 .OR. num_dst_ext < 0_i4 .OR. num_dst_ext > huge(1_c_int)) &
1238 CALL xt_abort(
"invalid number of extents", filename, __line__)
1239 num_src_ext_c = int(num_src_ext, c_int)
1240 num_dst_ext_c = int(num_dst_ext, c_int)
1242 num_src_ext_c, src_extents, num_dst_ext_c, dst_extents, datatype, &
1244 END FUNCTION xt_redist_p2p_ext_new_i4_a1d_i4_a1d_cfg
1246 FUNCTION xt_redist_p2p_ext_new_i8_a1d_i8_a1d(xmap, num_src_ext, src_extents, &
1247 num_dst_ext, dst_extents, datatype)
RESULT(redist)
1248 TYPE(
xt_xmap),
INTENT(in) :: xmap
1249 INTEGER(i8),
INTENT(in) :: num_src_ext, num_dst_ext
1250 TYPE(
xt_offset_ext),
INTENT(in) :: src_extents(num_src_ext), &
1251 dst_extents(num_dst_ext)
1252 INTEGER,
INTENT(in) :: datatype
1254 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1255 IF (num_src_ext < 0_i8 .OR. num_src_ext > huge(1_c_int) &
1256 .OR. num_dst_ext < 0_i8 .OR. num_dst_ext > huge(1_c_int)) &
1257 CALL xt_abort(
"invalid number of extents", filename, __line__)
1258 num_src_ext_c = int(num_src_ext, c_int)
1259 num_dst_ext_c = int(num_dst_ext, c_int)
1261 src_extents, num_dst_ext_c, dst_extents, datatype)
1262 END FUNCTION xt_redist_p2p_ext_new_i8_a1d_i8_a1d
1264 FUNCTION xt_redist_p2p_ext_new_i8_a1d_i8_a1d_cfg(xmap, num_src_ext, &
1265 src_extents, num_dst_ext, dst_extents, datatype, config)
RESULT(redist)
1266 TYPE(
xt_xmap),
INTENT(in) :: xmap
1267 INTEGER(i8),
INTENT(in) :: num_src_ext, num_dst_ext
1268 TYPE(
xt_offset_ext),
INTENT(in) :: src_extents(num_src_ext), &
1269 dst_extents(num_dst_ext)
1270 INTEGER,
INTENT(in) :: datatype
1273 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1274 IF (num_src_ext < 0_i8 .OR. num_src_ext > huge(1_c_int) &
1275 .OR. num_dst_ext < 0_i8 .OR. num_dst_ext > huge(1_c_int)) &
1276 CALL xt_abort(
"invalid number of extents", filename, __line__)
1277 num_src_ext_c = int(num_src_ext, c_int)
1278 num_dst_ext_c = int(num_dst_ext, c_int)
1280 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1281 END FUNCTION xt_redist_p2p_ext_new_i8_a1d_i8_a1d_cfg
1283 FUNCTION xt_redist_p2p_ext_new_a1d_a1d(xmap, src_extents, dst_extents, &
1284 datatype)
RESULT(redist)
1285 TYPE(
xt_xmap),
INTENT(in) :: xmap
1286 TYPE(
xt_offset_ext),
INTENT(in) :: src_extents(:), dst_extents(:)
1287 INTEGER,
INTENT(in) :: datatype
1289 INTEGER :: num_src_ext, num_dst_ext
1290 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1291 num_src_ext =
SIZE(src_extents)
1292 num_dst_ext =
SIZE(dst_extents)
1293 IF (num_src_ext > huge(1_c_int) .OR. num_dst_ext > huge(1_c_int)) &
1294 CALL xt_abort(
"invalid number of extents", filename, __line__)
1295 num_src_ext_c = int(num_src_ext, c_int)
1296 num_dst_ext_c = int(num_dst_ext, c_int)
1298 src_extents, num_dst_ext_c, dst_extents, datatype)
1299 END FUNCTION xt_redist_p2p_ext_new_a1d_a1d
1301 FUNCTION xt_redist_p2p_ext_new_a1d_a1d_cfg(xmap, src_extents, dst_extents, &
1302 datatype, config)
RESULT(redist)
1303 TYPE(
xt_xmap),
INTENT(in) :: xmap
1304 TYPE(
xt_offset_ext),
INTENT(in) :: src_extents(:), dst_extents(:)
1305 INTEGER,
INTENT(in) :: datatype
1308 INTEGER :: num_src_ext, num_dst_ext
1309 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1310 num_src_ext =
SIZE(src_extents)
1311 num_dst_ext =
SIZE(dst_extents)
1312 IF (num_src_ext > huge(1_c_int) .OR. num_dst_ext > huge(1_c_int)) &
1313 CALL xt_abort(
"invalid number of extents", filename, __line__)
1314 num_src_ext_c = int(num_src_ext, c_int)
1315 num_dst_ext_c = int(num_dst_ext, c_int)
1317 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1318 END FUNCTION xt_redist_p2p_ext_new_a1d_a1d_cfg
1320 FUNCTION xt_redist_p2p_aext_new_i2_a1d_i2_a1d(xmap, num_src_ext, src_extents,&
1321 num_dst_ext, dst_extents, datatype)
RESULT(redist)
1322 TYPE(
xt_xmap),
INTENT(in) :: xmap
1323 INTEGER(i2),
INTENT(in) :: num_src_ext, num_dst_ext
1325 dst_extents(num_dst_ext)
1326 INTEGER,
INTENT(in) :: datatype
1328 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1329 IF (num_src_ext < 0_i2 .OR. num_src_ext > huge(1_c_int) &
1330 .OR. num_dst_ext < 0_i2 .OR. num_dst_ext > huge(1_c_int)) &
1331 CALL xt_abort(
"invalid number of extents", filename, __line__)
1332 num_src_ext_c = int(num_src_ext, c_int)
1333 num_dst_ext_c = int(num_dst_ext, c_int)
1335 num_src_ext_c, src_extents, num_dst_ext_c, dst_extents, datatype)
1336 END FUNCTION xt_redist_p2p_aext_new_i2_a1d_i2_a1d
1338 FUNCTION xt_redist_p2p_aext_new_i2_a1d_i2_a1d_cfg(xmap, num_src_ext, &
1339 src_extents, num_dst_ext, dst_extents, datatype, config)
RESULT(redist)
1340 TYPE(
xt_xmap),
INTENT(in) :: xmap
1341 INTEGER(i2),
INTENT(in) :: num_src_ext, num_dst_ext
1343 dst_extents(num_dst_ext)
1344 INTEGER,
INTENT(in) :: datatype
1347 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1348 IF (num_src_ext < 0_i2 .OR. num_src_ext > huge(1_c_int) &
1349 .OR. num_dst_ext < 0_i2 .OR. num_dst_ext > huge(1_c_int)) &
1350 CALL xt_abort(
"invalid number of extents", filename, __line__)
1351 num_src_ext_c = int(num_src_ext, c_int)
1352 num_dst_ext_c = int(num_dst_ext, c_int)
1354 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1355 END FUNCTION xt_redist_p2p_aext_new_i2_a1d_i2_a1d_cfg
1357 FUNCTION xt_redist_p2p_aext_new_i4_a1d_i4_a1d(xmap, num_src_ext, src_extents,&
1358 num_dst_ext, dst_extents, datatype)
RESULT(redist)
1359 TYPE(
xt_xmap),
INTENT(in) :: xmap
1360 INTEGER(i4),
INTENT(in) :: num_src_ext, num_dst_ext
1362 dst_extents(num_dst_ext)
1363 INTEGER,
INTENT(in) :: datatype
1365 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1366 IF (num_src_ext < 0_i4 .OR. num_src_ext > huge(1_c_int) &
1367 .OR. num_dst_ext < 0_i4 .OR. num_dst_ext > huge(1_c_int)) &
1368 CALL xt_abort(
"invalid number of extents", filename, __line__)
1369 num_src_ext_c = int(num_src_ext, c_int)
1370 num_dst_ext_c = int(num_dst_ext, c_int)
1372 src_extents, num_dst_ext_c, dst_extents, datatype)
1373 END FUNCTION xt_redist_p2p_aext_new_i4_a1d_i4_a1d
1375 FUNCTION xt_redist_p2p_aext_new_i4_a1d_i4_a1d_cfg(xmap, num_src_ext, &
1376 src_extents, num_dst_ext, dst_extents, datatype, config)
RESULT(redist)
1377 TYPE(
xt_xmap),
INTENT(in) :: xmap
1378 INTEGER(i4),
INTENT(in) :: num_src_ext, num_dst_ext
1380 dst_extents(num_dst_ext)
1381 INTEGER,
INTENT(in) :: datatype
1384 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1385 IF (num_src_ext < 0_i4 .OR. num_src_ext > huge(1_c_int) &
1386 .OR. num_dst_ext < 0_i4 .OR. num_dst_ext > huge(1_c_int)) &
1387 CALL xt_abort(
"invalid number of extents", filename, __line__)
1388 num_src_ext_c = int(num_src_ext, c_int)
1389 num_dst_ext_c = int(num_dst_ext, c_int)
1391 num_src_ext_c, src_extents, num_dst_ext_c, dst_extents, datatype, &
1393 END FUNCTION xt_redist_p2p_aext_new_i4_a1d_i4_a1d_cfg
1395 FUNCTION xt_redist_p2p_aext_new_i8_a1d_i8_a1d(xmap, num_src_ext, src_extents,&
1396 num_dst_ext, dst_extents, datatype)
RESULT(redist)
1397 TYPE(
xt_xmap),
INTENT(in) :: xmap
1398 INTEGER(i8),
INTENT(in) :: num_src_ext, num_dst_ext
1400 dst_extents(num_dst_ext)
1401 INTEGER,
INTENT(in) :: datatype
1403 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1404 IF (num_src_ext < 0_i8 .OR. num_src_ext > huge(1_c_int) &
1405 .OR. num_dst_ext < 0_i8 .OR. num_dst_ext > huge(1_c_int)) &
1406 CALL xt_abort(
"invalid number of extents", filename, __line__)
1407 num_src_ext_c = int(num_src_ext, c_int)
1408 num_dst_ext_c = int(num_dst_ext, c_int)
1410 src_extents, num_dst_ext_c, dst_extents, datatype)
1411 END FUNCTION xt_redist_p2p_aext_new_i8_a1d_i8_a1d
1413 FUNCTION xt_redist_p2p_aext_new_i8_a1d_i8_a1d_cfg(xmap, num_src_ext, &
1414 src_extents, num_dst_ext, dst_extents, datatype, config)
RESULT(redist)
1415 TYPE(
xt_xmap),
INTENT(in) :: xmap
1416 INTEGER(i8),
INTENT(in) :: num_src_ext, num_dst_ext
1418 dst_extents(num_dst_ext)
1419 INTEGER,
INTENT(in) :: datatype
1422 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1423 IF (num_src_ext < 0_i8 .OR. num_src_ext > huge(1_c_int) &
1424 .OR. num_dst_ext < 0_i8 .OR. num_dst_ext > huge(1_c_int)) &
1425 CALL xt_abort(
"invalid number of extents", filename, __line__)
1426 num_src_ext_c = int(num_src_ext, c_int)
1427 num_dst_ext_c = int(num_dst_ext, c_int)
1429 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1430 END FUNCTION xt_redist_p2p_aext_new_i8_a1d_i8_a1d_cfg
1432 FUNCTION xt_redist_p2p_aext_new_a1d_a1d(xmap, src_extents, dst_extents, &
1433 datatype)
RESULT(redist)
1434 TYPE(
xt_xmap),
INTENT(in) :: xmap
1435 TYPE(
xt_aoffset_ext),
INTENT(in) :: src_extents(:), dst_extents(:)
1436 INTEGER,
INTENT(in) :: datatype
1438 INTEGER :: num_src_ext, num_dst_ext
1439 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1440 num_src_ext =
SIZE(src_extents)
1441 num_dst_ext =
SIZE(dst_extents)
1442 IF (num_src_ext > huge(1_c_int) .OR. num_dst_ext > huge(1_c_int)) &
1443 CALL xt_abort(
"invalid number of extents", filename, __line__)
1444 num_src_ext_c = int(num_src_ext, c_int)
1445 num_dst_ext_c = int(num_dst_ext, c_int)
1447 src_extents, num_dst_ext_c, dst_extents, datatype)
1448 END FUNCTION xt_redist_p2p_aext_new_a1d_a1d
1450 FUNCTION xt_redist_p2p_aext_new_a1d_a1d_cfg(xmap, src_extents, dst_extents, &
1451 datatype, config)
RESULT(redist)
1452 TYPE(
xt_xmap),
INTENT(in) :: xmap
1453 TYPE(
xt_aoffset_ext),
INTENT(in) :: src_extents(:), dst_extents(:)
1454 INTEGER,
INTENT(in) :: datatype
1457 INTEGER :: num_src_ext, num_dst_ext
1458 INTEGER(c_int) :: num_src_ext_c, num_dst_ext_c
1459 num_src_ext =
SIZE(src_extents)
1460 num_dst_ext =
SIZE(dst_extents)
1461 IF (num_src_ext > huge(1_c_int) .OR. num_dst_ext > huge(1_c_int)) &
1462 CALL xt_abort(
"invalid number of extents", filename, __line__)
1463 num_src_ext_c = int(num_src_ext, c_int)
1464 num_dst_ext_c = int(num_dst_ext, c_int)
1466 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1467 END FUNCTION xt_redist_p2p_aext_new_a1d_a1d_cfg
1469 FUNCTION xt_redist_single_array_base_new_i2_a1d_i2_a1d( &
1470 nsend, nrecv, send_msgs, recv_msgs, comm)
RESULT(redist)
1471 INTEGER(i2),
INTENT(in) :: nsend, nrecv
1473 send_msgs(nsend), recv_msgs(nrecv)
1474 INTEGER,
INTENT(in) :: comm
1477 INTEGER(c_int) :: nsend_c, nrecv_c
1478 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1480 IF (nsend < 0_i2 .OR. nsend > huge(1_c_int) &
1481 .OR. nrecv < 0_i2 .OR. nrecv > huge(1_c_int)) &
1482 CALL xt_abort(
"invalid number of send messages", filename, __line__)
1483 IF (nsend > 0_i2)
THEN
1484 send_msgs_p = c_loc(send_msgs)
1486 send_msgs_p = c_null_ptr
1488 IF (nrecv > 0_i2)
THEN
1489 recv_msgs_p = c_loc(recv_msgs)
1491 recv_msgs_p = c_null_ptr
1493 nsend_c = int(nsend, c_int)
1494 nrecv_c = int(nrecv, c_int)
1496 nsend_c, nrecv_c, send_msgs_p, recv_msgs_p, comm)
1497 END FUNCTION xt_redist_single_array_base_new_i2_a1d_i2_a1d
1499 FUNCTION xt_redist_single_array_base_new_i2_a1d_i2_a1d_cfg( &
1500 nsend, nrecv, send_msgs, recv_msgs, comm, config)
RESULT(redist)
1501 INTEGER(i2),
INTENT(in) :: nsend, nrecv
1503 send_msgs(nsend), recv_msgs(nrecv)
1504 INTEGER,
INTENT(in) :: comm
1508 INTEGER(c_int) :: nsend_c, nrecv_c
1509 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1511 IF (nsend < 0_i2 .OR. nsend > huge(1_c_int) &
1512 .OR. nrecv < 0_i2 .OR. nrecv > huge(1_c_int)) &
1513 CALL xt_abort(
"invalid number of send messages", filename, __line__)
1514 IF (nsend > 0_i2)
THEN
1515 send_msgs_p = c_loc(send_msgs)
1517 send_msgs_p = c_null_ptr
1519 IF (nrecv > 0_i2)
THEN
1520 recv_msgs_p = c_loc(recv_msgs)
1522 recv_msgs_p = c_null_ptr
1524 nsend_c = int(nsend, c_int)
1525 nrecv_c = int(nrecv, c_int)
1527 nsend_c, nrecv_c, send_msgs_p, recv_msgs_p, comm, config)
1528 END FUNCTION xt_redist_single_array_base_new_i2_a1d_i2_a1d_cfg
1530 FUNCTION xt_redist_single_array_base_new_i4_a1d_i4_a1d( &
1531 nsend, nrecv, send_msgs, recv_msgs, comm)
RESULT(redist)
1532 INTEGER(i4),
INTENT(in) :: nsend, nrecv
1534 send_msgs(nsend), recv_msgs(nrecv)
1535 INTEGER,
INTENT(in) :: comm
1538 INTEGER(c_int) :: nsend_c, nrecv_c
1539 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1541 IF (nsend < 0_i4 .OR. nsend > huge(1_c_int) &
1542 .OR. nrecv < 0_i4 .OR. nrecv > huge(1_c_int)) &
1543 CALL xt_abort(
"invalid number of send messages", filename, __line__)
1544 IF (nsend > 0_i4)
THEN
1545 send_msgs_p = c_loc(send_msgs)
1547 send_msgs_p = c_null_ptr
1549 IF (nrecv > 0_i4)
THEN
1550 recv_msgs_p = c_loc(recv_msgs)
1552 recv_msgs_p = c_null_ptr
1554 nsend_c = int(nsend, c_int)
1555 nrecv_c = int(nrecv, c_int)
1557 nsend_c, nrecv_c, send_msgs_p, recv_msgs_p, comm))
1558 END FUNCTION xt_redist_single_array_base_new_i4_a1d_i4_a1d
1560 FUNCTION xt_redist_single_array_base_new_i4_a1d_i4_a1d_cfg( &
1561 nsend, nrecv, send_msgs, recv_msgs, comm, config)
RESULT(redist)
1562 INTEGER(i4),
INTENT(in) :: nsend, nrecv
1564 send_msgs(nsend), recv_msgs(nrecv)
1565 INTEGER,
INTENT(in) :: comm
1569 INTEGER(c_int) :: nsend_c, nrecv_c
1570 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1572 IF (nsend < 0_i4 .OR. nsend > huge(1_c_int) &
1573 .OR. nrecv < 0_i4 .OR. nrecv > huge(1_c_int)) &
1574 CALL xt_abort(
"invalid number of send messages", filename, __line__)
1575 IF (nsend > 0_i4)
THEN
1576 send_msgs_p = c_loc(send_msgs)
1578 send_msgs_p = c_null_ptr
1580 IF (nrecv > 0_i4)
THEN
1581 recv_msgs_p = c_loc(recv_msgs)
1583 recv_msgs_p = c_null_ptr
1585 nsend_c = int(nsend, c_int)
1586 nrecv_c = int(nrecv, c_int)
1588 nsend_c, nrecv_c, send_msgs_p, recv_msgs_p, comm, config)
1589 END FUNCTION xt_redist_single_array_base_new_i4_a1d_i4_a1d_cfg
1591 FUNCTION xt_redist_single_array_base_new_i8_a1d_i8_a1d( &
1592 nsend, nrecv, send_msgs, recv_msgs, comm)
RESULT(redist)
1593 INTEGER(i8),
INTENT(in) :: nsend, nrecv
1595 send_msgs(nsend), recv_msgs(nrecv)
1596 INTEGER,
INTENT(in) :: comm
1599 INTEGER(c_int) :: nsend_c, nrecv_c
1600 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1602 IF (nsend < 0_i8 .OR. nsend > huge(1_c_int) &
1603 .OR. nrecv < 0_i8 .OR. nrecv > huge(1_c_int)) &
1604 CALL xt_abort(
"invalid number of send messages", filename, __line__)
1605 IF (nsend > 0_i8)
THEN
1606 send_msgs_p = c_loc(send_msgs)
1608 send_msgs_p = c_null_ptr
1610 IF (nrecv > 0_i8)
THEN
1611 recv_msgs_p = c_loc(recv_msgs)
1613 recv_msgs_p = c_null_ptr
1615 nsend_c = int(nsend, c_int)
1616 nrecv_c = int(nrecv, c_int)
1618 nsend_c, nrecv_c, send_msgs_p, recv_msgs_p, comm)
1619 END FUNCTION xt_redist_single_array_base_new_i8_a1d_i8_a1d
1621 FUNCTION xt_redist_single_array_base_new_i8_a1d_i8_a1d_cfg( &
1622 nsend, nrecv, send_msgs, recv_msgs, comm, config)
RESULT(redist)
1623 INTEGER(i8),
INTENT(in) :: nsend, nrecv
1625 send_msgs(nsend), recv_msgs(nrecv)
1626 INTEGER,
INTENT(in) :: comm
1630 INTEGER(c_int) :: nsend_c, nrecv_c
1631 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1633 IF (nsend < 0_i8 .OR. nsend > huge(1_c_int) &
1634 .OR. nrecv < 0_i8 .OR. nrecv > huge(1_c_int)) &
1635 CALL xt_abort(
"invalid number of send messages", filename, __line__)
1636 IF (nsend > 0_i8)
THEN
1637 send_msgs_p = c_loc(send_msgs)
1639 send_msgs_p = c_null_ptr
1641 IF (nrecv > 0_i8)
THEN
1642 recv_msgs_p = c_loc(recv_msgs)
1644 recv_msgs_p = c_null_ptr
1646 nsend_c = int(nsend, c_int)
1647 nrecv_c = int(nrecv, c_int)
1649 nsend_c, nrecv_c, send_msgs_p, recv_msgs_p, comm, config)
1650 END FUNCTION xt_redist_single_array_base_new_i8_a1d_i8_a1d_cfg
1652 FUNCTION xt_redist_single_array_base_new_a1d_a1d(send_msgs, recv_msgs, comm) &
1654 TYPE(
xt_redist_msg),
TARGET,
INTENT(in) :: send_msgs(:), recv_msgs(:)
1655 INTEGER,
INTENT(in) :: comm
1658 INTEGER :: nsend, nrecv
1659 INTEGER(c_int) :: nsend_c, nrecv_c
1660 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1661 TYPE(
xt_redist_msg),
ALLOCATABLE,
TARGET :: send_msgs_a(:), recv_msgs_a(:)
1663 nsend =
SIZE(send_msgs)
1664 nrecv =
SIZE(recv_msgs)
1666 CALL msgs_p_arg(send_msgs, send_msgs_a, send_msgs_p)
1667 CALL msgs_p_arg(recv_msgs, recv_msgs_a, recv_msgs_p)
1669 IF (nsend < 0 .OR. nsend > huge(1_c_int) &
1670 .OR. nrecv < 0 .OR. nrecv > huge(1_c_int)) &
1671 CALL xt_abort(
"invalid number of send messages", filename, __line__)
1672 nsend_c = int(nsend, c_int)
1673 nrecv_c = int(nrecv, c_int)
1675 nsend_c, nrecv_c, send_msgs_p, recv_msgs_p, comm)
1676 END FUNCTION xt_redist_single_array_base_new_a1d_a1d
1678 FUNCTION xt_redist_single_array_base_new_a1d_a1d_cfg(send_msgs, recv_msgs, &
1679 comm, config)
RESULT(redist)
1680 TYPE(
xt_redist_msg),
TARGET,
INTENT(in) :: send_msgs(:), recv_msgs(:)
1681 INTEGER,
INTENT(in) :: comm
1685 INTEGER :: nsend, nrecv
1686 INTEGER(c_int) :: nsend_c, nrecv_c
1687 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1688 TYPE(
xt_redist_msg),
ALLOCATABLE,
TARGET :: send_msgs_a(:), recv_msgs_a(:)
1690 nsend =
SIZE(send_msgs)
1691 nrecv =
SIZE(recv_msgs)
1693 CALL msgs_p_arg(send_msgs, send_msgs_a, send_msgs_p)
1694 CALL msgs_p_arg(recv_msgs, recv_msgs_a, recv_msgs_p)
1696 IF (nsend < 0 .OR. nsend > huge(1_c_int) &
1697 .OR. nrecv < 0 .OR. nrecv > huge(1_c_int)) &
1698 CALL xt_abort(
"invalid number of send messages", filename, __line__)
1699 nsend_c = int(nsend, c_int)
1700 nrecv_c = int(nrecv, c_int)
1702 nsend_c, nrecv_c, send_msgs_p, recv_msgs_p, comm, config)
1703 END FUNCTION xt_redist_single_array_base_new_a1d_a1d_cfg
1705 SUBROUTINE msgs_p_arg(msgs, msgs_a, msgs_p)
1707 TYPE(
xt_redist_msg),
TARGET,
ALLOCATABLE,
INTENT(inout) :: msgs_a(:)
1708 TYPE(c_ptr),
INTENT(out) :: msgs_p
1710 INTEGER :: msgs_size
1711 LOGICAL :: msgs_is_contiguous
1712#ifndef HAVE_FC_IS_CONTIGUOUS
1715 bind(c, name=
'xt_redist_msg_contiguous')
1723 msgs_size =
SIZE(msgs)
1724 IF (msgs_size > huge(1_c_int)) &
1725 CALL xt_abort(
'invalid size', filename, __line__)
1726 IF (msgs_size > 0)
THEN
1727 IF (msgs_size > 1)
THEN
1728#ifdef HAVE_FC_IS_CONTIGUOUS
1729 msgs_is_contiguous = is_contiguous(msgs)
1733 IF (msgs_is_contiguous)
THEN
1734 xt_slice_c_loc(msgs(1), msgs_p)
1736 ALLOCATE(msgs_a(msgs_size))
1738 msgs_p = c_loc(msgs_a)
1741 xt_slice_c_loc(msgs(1), msgs_p)
1746 END SUBROUTINE msgs_p_arg
1748END MODULE xt_redist_base
1756 MODULE PROCEDURE xt_redist_p2p_orig_new
void xt_redist_delete(Xt_redist redist)
int xt_redist_get_num_recv_msg(Xt_redist redist)
int xt_redist_get_num_send_msg(Xt_redist redist)
void xt_redist_a_exchange1(Xt_redist redist, const void *src_data, void *dst_data, Xt_request *request)
Xt_redist xt_redist_copy(Xt_redist redist)
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)
Xt_redist xt_redist_collection_new(Xt_redist *redists, int num_redists, int cache_size, MPI_Comm comm)
Xt_redist xt_redist_collection_custom_new(Xt_redist *redists, int num_redists, int cache_size, MPI_Comm comm, Xt_config config)
Xt_redist xt_redist_collection_static_new(Xt_redist *redists, int num_redists, const MPI_Aint src_displacements[num_redists], const MPI_Aint dst_displacements[num_redists], MPI_Comm comm)
Xt_redist xt_redist_collection_static_custom_new(Xt_redist *redists, int num_redists, const MPI_Aint src_displacements[num_redists], const MPI_Aint dst_displacements[num_redists], MPI_Comm comm, Xt_config config)
Xt_redist xt_redist_p2p_custom_new(Xt_xmap xmap, MPI_Datatype datatype, Xt_config config)
Xt_redist xt_redist_p2p_off_new(Xt_xmap xmap, const int *src_offsets, const int *dst_offsets, MPI_Datatype datatype)
Xt_redist xt_redist_p2p_blocks_custom_new(Xt_xmap xmap, const int *src_block_sizes, int src_block_num, const int *dst_block_sizes, int dst_block_num, MPI_Datatype datatype, Xt_config config)
Xt_redist xt_redist_p2p_new(Xt_xmap xmap, MPI_Datatype datatype)
Xt_redist xt_redist_p2p_off_custom_new(Xt_xmap xmap, const int *src_offsets, const int *dst_offsets, MPI_Datatype datatype, Xt_config config)
Xt_redist xt_redist_p2p_blocks_off_custom_new(Xt_xmap xmap, const int *src_block_offsets, const int *src_block_sizes, int src_block_num, const int *dst_block_offsets, const int *dst_block_sizes, int dst_block_num, MPI_Datatype datatype, Xt_config config)
Xt_redist xt_redist_p2p_ext_new(Xt_xmap xmap, int num_src_ext, const struct Xt_offset_ext src_extents[], int num_dst_ext, const struct Xt_offset_ext dst_extents[], MPI_Datatype datatype)
Xt_redist xt_redist_p2p_blocks_off_new(Xt_xmap xmap, const int *src_block_offsets, const int *src_block_sizes, int src_block_num, const int *dst_block_offsets, const int *dst_block_sizes, int dst_block_num, MPI_Datatype datatype)
Xt_redist xt_redist_p2p_aext_new(Xt_xmap xmap, int num_src_ext, const struct Xt_aoffset_ext src_extents[], int num_dst_ext, const struct Xt_aoffset_ext dst_extents[], MPI_Datatype datatype)
Xt_redist xt_redist_p2p_blocks_new(Xt_xmap xmap, const int *src_block_sizes, int src_block_num, const int *dst_block_sizes, int dst_block_num, MPI_Datatype datatype)
Xt_redist xt_redist_p2p_aext_custom_new(Xt_xmap xmap, int num_src_ext, const struct Xt_aoffset_ext src_extents[], int num_dst_ext, const struct Xt_aoffset_ext dst_extents[], MPI_Datatype datatype, Xt_config config)
Xt_redist xt_redist_p2p_ext_custom_new(Xt_xmap xmap, int num_src_ext, const struct Xt_offset_ext src_extents[], int num_dst_ext, const struct Xt_offset_ext dst_extents[], MPI_Datatype datatype, Xt_config config)
Xt_redist xt_redist_repeat_custom_new(Xt_redist redist, MPI_Aint src_extent, MPI_Aint dst_extent, int num_repetitions, const int displacements[num_repetitions], Xt_config config)
Xt_redist xt_redist_repeat_new(Xt_redist redist, MPI_Aint src_extent, MPI_Aint dst_extent, int num_repetitions, const int displacements[num_repetitions])
Xt_redist xt_redist_single_array_base_new(int nsend, int nrecv, const struct Xt_redist_msg send_msgs[], const struct Xt_redist_msg recv_msgs[], MPI_Comm comm)
Xt_redist xt_redist_single_array_base_custom_new(int nsend, int nrecv, const struct Xt_redist_msg send_msgs[], const struct Xt_redist_msg recv_msgs[], MPI_Comm comm, Xt_config config)
Xt_redist xt_redist_f2c(struct xt_redist_f *p)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_ext_custom_new_c2f(Xt_xmap *xmap, int num_src_ext, struct Xt_offset_ext src_extents[], int num_dst_ext, struct Xt_offset_ext dst_extents[], MPI_Fint datatype_f, struct xt_config_f *config)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_blocks_off_custom_new_f(struct xt_xmap_f *xmap_f, int *src_block_offsets, int *src_block_sizes, int src_block_num, int *dst_block_offsets, int *dst_block_sizes, int dst_block_num, MPI_Fint datatype_f, struct xt_config_f *config)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_new_f(struct xt_xmap_f *xmap_f, MPI_Fint datatype_f)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_blocks_new_f(struct xt_xmap_f *xmap_f, int *src_block_sizes, int src_block_num, int *dst_block_sizes, int dst_block_num, MPI_Fint datatype_f)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_off_new_f(struct xt_xmap_f *xmap_f, MPI_Fint *src_offsets, MPI_Fint *dst_offsets, MPI_Fint datatype_f)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_ext_new_c2f(Xt_xmap *xmap, int num_src_ext, struct Xt_offset_ext src_extents[], int num_dst_ext, struct Xt_offset_ext dst_extents[], MPI_Fint datatype_f)
PPM_DSO_INTERNAL Xt_redist xt_redist_collection_static_custom_new_f(Xt_redist *redists, MPI_Fint num_redists, MPI_Aint *src_displacements, MPI_Aint *dst_displacements, MPI_Fint comm_f, struct xt_config_f *config)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_aext_custom_new_c2f(Xt_xmap *xmap, int num_src_ext, struct Xt_aoffset_ext src_extents[], int num_dst_ext, struct Xt_aoffset_ext dst_extents[], MPI_Fint datatype_f, struct xt_config_f *config)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_off_custom_new_f(struct xt_xmap_f *xmap_f, MPI_Fint *src_offsets, MPI_Fint *dst_offsets, MPI_Fint datatype_f, struct xt_config_f *config)
PPM_DSO_INTERNAL void * xt_redist_single_array_base_new_c2f(int nsend, int nrecv, const struct xt_redist_msg_f *send_msgs_f, const struct xt_redist_msg_f *recv_msgs_f, MPI_Fint comm_f)
PPM_DSO_INTERNAL Xt_redist xt_redist_collection_custom_new_f(Xt_redist *redists, MPI_Fint num_redists, MPI_Fint cache_size, MPI_Fint comm_f, struct xt_config_f *config)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_aext_new_c2f(Xt_xmap *xmap, int num_src_ext, struct Xt_aoffset_ext src_extents[], int num_dst_ext, struct Xt_aoffset_ext dst_extents[], MPI_Fint datatype_f)
PPM_DSO_INTERNAL Xt_redist xt_redist_collection_new_f(Xt_redist *redists, MPI_Fint num_redists, MPI_Fint cache_size, MPI_Fint comm_f)
PPM_DSO_INTERNAL void * xt_redist_single_array_base_custom_new_c2f(int nsend, int nrecv, const struct xt_redist_msg_f *send_msgs_f, const struct xt_redist_msg_f *recv_msgs_f, MPI_Fint comm_f, const struct xt_config_f *config)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_custom_new_f(struct xt_xmap_f *xmap_f, MPI_Fint datatype_f, struct xt_config_f *config)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_blocks_custom_new_f(struct xt_xmap_f *xmap_f, int *src_block_sizes, int src_block_num, int *dst_block_sizes, int dst_block_num, MPI_Fint datatype_f, struct xt_config_f *config)
PPM_DSO_INTERNAL int xt_redist_msg_contiguous(const struct xt_redist_msg_f *p_msgs_a, const struct xt_redist_msg_f *p_msgs_b)
Xt_config xt_config_f2c(struct xt_config_f *p)
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_blocks_off_new_f(struct xt_xmap_f *xmap_f, int *src_block_offsets, int *src_block_sizes, int src_block_num, int *dst_block_offsets, int *dst_block_sizes, int dst_block_num, MPI_Fint datatype_f)
PPM_DSO_INTERNAL Xt_redist xt_redist_collection_static_new_f(Xt_redist *redists, MPI_Fint num_redists, MPI_Aint *src_displacements, MPI_Aint *dst_displacements, MPI_Fint comm_f)