Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
xt_redist_f.f90
Go to the documentation of this file.
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!
48
54
55#include "fc_feature_defs.inc"
56MODULE xt_redist_base
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
62 USE xt_requests, ONLY: xt_request
63#include "xt_slice_c_loc.inc"
64 IMPLICIT NONE
65 PRIVATE
66 ! note: this type must not be extended to contain any other
67 ! components, its memory pattern has to match void * exactly, which
68 ! it does because of C constraints
69 TYPE, BIND(C), PUBLIC :: xt_redist
70#ifndef __G95__
71 PRIVATE
72#endif
73 TYPE(c_ptr) :: cptr = c_null_ptr
74 END TYPE xt_redist
75
76 TYPE, BIND(c), PUBLIC :: xt_offset_ext
77 INTEGER(c_int) :: start, size, stride
78 END TYPE xt_offset_ext
79
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
84 END TYPE xt_aoffset_ext
85
86 TYPE, BIND(c), PUBLIC :: xt_redist_msg
87 INTEGER(xt_mpi_fint_kind) :: rank, datatype
88 END TYPE xt_redist_msg
89
90 INTERFACE
91 ! this function must not be implemented in Fortran because
92 ! PGI 11.x chokes on that
93 FUNCTION xt_redist_f2c(redist) bind(c, name='xt_redist_f2c') RESULT(p)
94 IMPORT :: c_ptr, xt_redist
95 IMPLICIT NONE
96 TYPE(xt_redist), INTENT(in) :: redist
97 TYPE(c_ptr) :: p
98 END FUNCTION xt_redist_f2c
99 END INTERFACE
100
101 INTERFACE xt_redist_delete
102 MODULE PROCEDURE xt_redist_delete_1
103 MODULE PROCEDURE xt_redist_delete_a1d
104 END INTERFACE xt_redist_delete
105
106 INTERFACE
107 SUBROUTINE xt_redist_delete_c(redist) &
108 bind(c, name='xt_redist_delete')
109 IMPORT :: c_ptr
110 IMPLICIT NONE
111 TYPE(c_ptr), VALUE, INTENT(in) :: redist
112 END SUBROUTINE xt_redist_delete_c
113 END INTERFACE
114
115 INTERFACE xt_is_null
116 MODULE PROCEDURE xt_redist_is_null
117 END INTERFACE xt_is_null
118
119 INTERFACE xt_redist_s_exchange
120 MODULE PROCEDURE xt_redist_s_exchange1
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
125 END INTERFACE xt_redist_s_exchange
126
127 INTERFACE xt_redist_a_exchange
128 MODULE PROCEDURE xt_redist_a_exchange1
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
133 END INTERFACE xt_redist_a_exchange
134
135
136 INTERFACE
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
144
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')
147 import:: c_ptr, c_int, xt_request
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)
151 TYPE(xt_request), INTENT(out) :: request
152 END SUBROUTINE xt_redist_a_exchange_c
153
154 FUNCTION xt_redist_get_mpi_comm(redist) &
155 bind(c, name='xt_redist_get_mpi_comm_c2f') result(comm)
156 IMPORT :: xt_redist, xt_mpi_fint_kind
157 TYPE(xt_redist), INTENT(in) :: redist
158 INTEGER(xt_mpi_fint_kind) :: comm
159 END FUNCTION xt_redist_get_mpi_comm
160
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
164 IMPLICIT NONE
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
168
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
172 IMPLICIT NONE
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
176
177 FUNCTION xt_redist_get_recv_mpi_datatype(redist, rank) &
178 bind(c, name='xt_redist_get_recv_MPI_Datatype_c2f') result(dt)
179 IMPORT :: xt_redist, xt_mpi_fint_kind
180 TYPE(xt_redist), INTENT(in) :: redist
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
184
185 FUNCTION xt_redist_get_send_mpi_datatype(redist, rank) &
186 bind(c, name='xt_redist_get_send_MPI_Datatype_c2f') result(dt)
187 IMPORT :: xt_redist, xt_mpi_fint_kind
188 TYPE(xt_redist), INTENT(in) :: redist
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
192
193 FUNCTION xt_redist_collection_static_new_f(redists_f, num_redists, &
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
197 IMPLICIT NONE
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(*), &
201 dst_displacements(*)
202 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: comm_f
203 TYPE(c_ptr) :: res
205
206 FUNCTION xt_redist_collection_static_custom_new_f(redists_f, num_redists, &
207 src_displacements, dst_displacements, comm_f, config) &
208 bind(c, name='xt_redist_collection_static_custom_new_f') result(res)
209 IMPORT :: xt_redist, mpi_address_kind, c_ptr, xt_mpi_fint_kind, xt_config
210 IMPLICIT NONE
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(*), &
214 dst_displacements(*)
215 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: comm_f
216 TYPE(xt_config), INTENT(in) :: config
217 TYPE(c_ptr) :: res
219
220 FUNCTION xt_redist_collection_new_f(redists_f, num_redists, cache_size, &
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
223 IMPLICIT NONE
224 TYPE(xt_redist), INTENT(in) :: redists_f(*)
225 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: &
226 num_redists, cache_size, comm_f
227 TYPE(c_ptr) :: res
228 END FUNCTION xt_redist_collection_new_f
229
230 FUNCTION xt_redist_collection_custom_new_f(redists_f, num_redists, &
231 cache_size, comm_f, config) &
232 bind(c, name='xt_redist_collection_custom_new_f') result(res)
233 IMPORT :: xt_redist, mpi_address_kind, c_ptr, xt_mpi_fint_kind, xt_config
234 IMPLICIT NONE
235 TYPE(xt_redist), INTENT(in) :: redists_f(*)
236 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: &
237 num_redists, cache_size, comm_f
238 TYPE(xt_config), INTENT(in) :: config
239 TYPE(c_ptr) :: res
241
242 FUNCTION xt_redist_p2p_ext_new_c2f(xmap, num_src_ext, src_extents, &
243 num_dst_ext, dst_extents, datatype) &
244 bind(c, name='xt_redist_p2p_ext_new_c2f') result(redist)
245 IMPORT :: c_int, c_ptr, xt_offset_ext, xt_mpi_fint_kind, xt_xmap
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
252 END FUNCTION xt_redist_p2p_ext_new_c2f
253
254 FUNCTION xt_redist_p2p_ext_custom_new_c2f(xmap, num_src_ext, src_extents, &
255 num_dst_ext, dst_extents, datatype, config) &
256 bind(c, name='xt_redist_p2p_ext_custom_new_c2f') result(redist)
257 IMPORT :: c_int, c_ptr, xt_offset_ext, xt_mpi_fint_kind, xt_xmap, &
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
264 TYPE(xt_config), INTENT(in) :: config
265 TYPE(c_ptr) :: redist
267
268 FUNCTION xt_redist_p2p_aext_new_c2f(xmap, num_src_ext, src_extents, &
269 num_dst_ext, dst_extents, datatype) &
270 bind(c, name='xt_redist_p2p_aext_new_c2f') result(redist)
271 IMPORT :: c_int, c_ptr, xt_aoffset_ext, xt_mpi_fint_kind, xt_xmap
272 TYPE(xt_xmap), INTENT(in) :: xmap
273 INTEGER(c_int), VALUE, INTENT(in) :: num_src_ext, num_dst_ext
274 TYPE(xt_aoffset_ext), INTENT(in) :: src_extents(num_src_ext), &
275 dst_extents(num_dst_ext)
276 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: datatype
277 TYPE(c_ptr) :: redist
278 END FUNCTION xt_redist_p2p_aext_new_c2f
279
280 FUNCTION xt_redist_p2p_aext_custom_new_c2f(xmap, num_src_ext, src_extents, &
281 num_dst_ext, dst_extents, datatype, config) &
282 bind(c, name='xt_redist_p2p_aext_custom_new_c2f') result(redist)
283 IMPORT :: c_int, c_ptr, xt_aoffset_ext, xt_mpi_fint_kind, xt_xmap, &
285 TYPE(xt_xmap), INTENT(in) :: xmap
286 INTEGER(c_int), VALUE, INTENT(in) :: num_src_ext, num_dst_ext
287 TYPE(xt_aoffset_ext), INTENT(in) :: src_extents(num_src_ext), &
288 dst_extents(num_dst_ext)
289 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: datatype
290 TYPE(xt_config), INTENT(in) :: config
291 TYPE(c_ptr) :: redist
293
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
298 IMPLICIT NONE
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(*)
303 TYPE(c_ptr) :: res
304 END FUNCTION xt_redist_repeat_new_c
305
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
310 IMPLICIT NONE
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
316 TYPE(c_ptr) :: res
317 END FUNCTION xt_redist_repeat_custom_new_c
318
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
323 IMPLICIT NONE
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(*)
328 TYPE(c_ptr) :: res
329 END FUNCTION xt_redist_repeat_asym_new_c
330
331 FUNCTION xt_redist_repeat_asym_custom_new_c(redist_f, src_extent, &
332 dst_extent, num_repetitions, src_displacements, dst_displacements, &
333 config) &
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
336 IMPLICIT NONE
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
342 TYPE(c_ptr) :: res
343 END FUNCTION xt_redist_repeat_asym_custom_new_c
344
345 FUNCTION xt_redist_single_array_base_new_c2f(nsend, nrecv, send_msgs_f, &
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
349 IMPLICIT NONE
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
353 TYPE(c_ptr) :: res
355
356 FUNCTION xt_redist_single_array_base_custom_new_c2f(nsend, nrecv, &
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
360 IMPLICIT NONE
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
364 TYPE(xt_config), INTENT(in) :: config
365 TYPE(c_ptr) :: res
367
368 END INTERFACE
369
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
376
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
381
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
389 END INTERFACE xt_redist_collection_new
390
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
396
397 INTERFACE xt_redist_p2p_ext_new
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
406 END INTERFACE xt_redist_p2p_ext_new
407
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
413 END INTERFACE xt_redist_p2p_ext_custom_new
414
415 INTERFACE xt_redist_p2p_aext_new
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
424 END INTERFACE xt_redist_p2p_aext_new
425
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
432
433 INTERFACE xt_redist_repeat_new
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
442 END INTERFACE xt_redist_repeat_new
443
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
449 END INTERFACE xt_redist_repeat_custom_new
450
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
461
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
468
469 PUBLIC :: xt_redist_c2f, xt_redist_f2c, xt_is_null, xt_redist_copy, &
474 xt_redist_get_mpi_comm, xt_redist_p2p_ext_new, xt_redist_p2p_aext_new, &
477 xt_redist_get_send_mpi_datatype, xt_redist_get_recv_mpi_datatype, &
483 CHARACTER(len=*), PARAMETER :: filename = 'xt_redist_f.f90'
484CONTAINS
485
486 FUNCTION xt_redist_is_null(redist) RESULT(p)
487 TYPE(xt_redist), INTENT(in) :: redist
488 LOGICAL :: p
489 p = .NOT. c_associated(redist%cptr)
490 END FUNCTION xt_redist_is_null
491
492 FUNCTION xt_redist_c2f(redist) RESULT(p)
493 TYPE(c_ptr), INTENT(in) :: redist
494 TYPE(xt_redist) :: p
495 p%cptr = redist
496 END FUNCTION xt_redist_c2f
497
498 FUNCTION xt_redist_copy(redist) RESULT(redist_copy)
499 TYPE(xt_redist), INTENT(in) :: redist
500 TYPE(xt_redist) :: redist_copy
501 INTERFACE
502 FUNCTION xt_redist_copy_c(redist) bind(C, name='xt_redist_copy')
503 import:: c_ptr
504 TYPE(c_ptr), VALUE, INTENT(in) :: redist
505 TYPE(c_ptr) :: xt_redist_copy_c
506 END FUNCTION xt_redist_copy_c
507 END INTERFACE
508 redist_copy%cptr = xt_redist_copy_c(redist%cptr)
509 END FUNCTION xt_redist_copy
510
511 SUBROUTINE xt_redist_delete_1(redist)
512 TYPE(xt_redist), INTENT(inout) :: redist
513 CALL xt_redist_delete_c(redist%cptr)
514 redist%cptr = c_null_ptr
515 END SUBROUTINE xt_redist_delete_1
516
517 SUBROUTINE xt_redist_delete_a1d(redists)
518 TYPE(xt_redist), INTENT(inout) :: redists(:)
519 INTEGER :: i, n
520 n = SIZE(redists)
521 DO i = 1, n
522 CALL xt_redist_delete_c(redists(i)%cptr)
523 redists(i)%cptr = c_null_ptr
524 END DO
525 END SUBROUTINE xt_redist_delete_a1d
526
527 FUNCTION xt_redist_get_num_send_msg(redist) RESULT(num_send_msg)
528 TYPE(xt_redist), INTENT(in) :: redist
529 INTEGER :: num_send_msg
530 INTEGER(c_int) :: n
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)
535 END FUNCTION xt_redist_get_num_send_msg
536
537 FUNCTION xt_redist_get_num_recv_msg(redist) RESULT(num_recv_msg)
538 TYPE(xt_redist), INTENT(in) :: redist
539 INTEGER :: num_recv_msg
540 INTEGER(c_int) :: n
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)
545 END FUNCTION xt_redist_get_num_recv_msg
546
547 SUBROUTINE xt_redist_s_exchange1(redist, src_data_cptr, dst_data_cptr)
548 TYPE(xt_redist), INTENT(in) :: redist
549 TYPE(c_ptr), INTENT(in) :: src_data_cptr, dst_data_cptr
550 INTERFACE
551 SUBROUTINE xt_redist_s_exchange1_c(redist, src_data_cptr, dst_data_cptr) &
552 bind(c, name='xt_redist_s_exchange1')
553 import:: c_ptr
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
557 END INTERFACE
558 CALL xt_redist_s_exchange1_c(redist%cptr, src_data_cptr, dst_data_cptr)
559 END SUBROUTINE xt_redist_s_exchange1
560
561 SUBROUTINE xt_redist_a_exchange1(redist, src_data_cptr, dst_data_cptr, &
562 request)
563 TYPE(xt_redist), INTENT(in) :: redist
564 TYPE(c_ptr) :: src_data_cptr, dst_data_cptr
565 TYPE(xt_request), INTENT(out) :: request
566 INTERFACE
567 SUBROUTINE xt_redist_a_exchange1_c(redist, src_data_cptr, &
568 dst_data_cptr, request_c) bind(C, name='xt_redist_a_exchange1')
569 import:: c_ptr, xt_request
570 TYPE(c_ptr), VALUE, INTENT(in) :: redist
571 TYPE(c_ptr), VALUE :: src_data_cptr, dst_data_cptr
572 TYPE(xt_request), INTENT(out) :: request_c
573 END SUBROUTINE xt_redist_a_exchange1_c
574 END INTERFACE
575 CALL xt_redist_a_exchange1_c(redist%cptr, src_data_cptr, &
576 & dst_data_cptr, request)
577 END SUBROUTINE xt_redist_a_exchange1
578
579 SUBROUTINE xt_redist_s_exchange_a1d(redist, src_data_cptr, dst_data_cptr)
580 TYPE(xt_redist), INTENT(in) :: redist
581 TYPE(c_ptr), INTENT(in) :: src_data_cptr(:), dst_data_cptr(:)
582 INTEGER :: n
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
589#endif
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)
597#else
598 CALL xt_redist_s_exchange_c(redist%cptr, num_ptr_c, &
599 src_data_cptr, dst_data_cptr)
600#endif
601 END SUBROUTINE xt_redist_s_exchange_a1d
602
603 SUBROUTINE xt_redist_a_exchange_a1d(redist, src_data_cptr, dst_data_cptr, &
604 request)
605 TYPE(xt_redist), INTENT(in) :: redist
606 TYPE(c_ptr), INTENT(in) :: src_data_cptr(:), dst_data_cptr(:)
607 TYPE(xt_request), INTENT(out) :: request
608 INTEGER :: num_ptr
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
615#endif
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)
623#else
624 CALL xt_redist_a_exchange_c(redist%cptr, num_ptr_c, &
625 src_data_cptr, dst_data_cptr, request)
626#endif
627 END SUBROUTINE xt_redist_a_exchange_a1d
628
629 SUBROUTINE xt_redist_s_exchange_i2_a1d(redist, num_ptr, &
630 src_data_cptr, dst_data_cptr)
631 TYPE(xt_redist), INTENT(in) :: redist
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
641
642 SUBROUTINE xt_redist_a_exchange_i2_a1d(redist, num_ptr, &
643 src_data_cptr, dst_data_cptr, request)
644 TYPE(xt_redist), INTENT(in) :: redist
645 INTEGER(i2), INTENT(in) :: num_ptr
646 TYPE(xt_request), INTENT(out) :: request
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
655
656 SUBROUTINE xt_redist_s_exchange_i4_a1d(redist, num_ptr, &
657 src_data_cptr, dst_data_cptr)
658 TYPE(xt_redist), INTENT(in) :: redist
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
668
669 SUBROUTINE xt_redist_a_exchange_i4_a1d(redist, num_ptr, &
670 src_data_cptr, dst_data_cptr, request)
671 TYPE(xt_redist), INTENT(in) :: redist
672 INTEGER(i4), INTENT(in) :: num_ptr
673 TYPE(xt_request), INTENT(out) :: request
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
682
683 SUBROUTINE xt_redist_s_exchange_i8_a1d(redist, num_ptr, &
684 src_data_cptr, dst_data_cptr)
685 TYPE(xt_redist), INTENT(in) :: redist
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
695
696 SUBROUTINE xt_redist_a_exchange_i8_a1d(redist, num_ptr, &
697 src_data_cptr, dst_data_cptr, request)
698 TYPE(xt_redist), INTENT(in) :: redist
699 INTEGER(i8), INTENT(in) :: num_ptr
700 TYPE(xt_request), INTENT(out) :: request
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
709
710 FUNCTION xt_redist_p2p_new(xmap, datatype) RESULT(res)
711 TYPE(xt_xmap), INTENT(in) :: xmap
712 INTEGER, INTENT(in) :: datatype
713 TYPE(xt_redist) :: res
714 INTERFACE
715 FUNCTION xt_redist_p2p_new_f(xmap, datatype) &
716 bind(c, name='xt_redist_p2p_new_f') result(res_ptr)
717 import:: xt_xmap, xt_redist, c_int, c_ptr, xt_mpi_fint_kind
718 IMPLICIT NONE
719 TYPE(xt_xmap), INTENT(in) :: xmap
720 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: datatype
721 TYPE(c_ptr) :: res_ptr
722 END FUNCTION xt_redist_p2p_new_f
723 END INTERFACE
724 res%cptr = xt_redist_p2p_new_f(xmap, datatype)
725 END FUNCTION xt_redist_p2p_new
726
727 FUNCTION xt_redist_p2p_custom_new(xmap, datatype, config) RESULT(res)
728 TYPE(xt_xmap), INTENT(in) :: xmap
729 INTEGER, INTENT(in) :: datatype
730 TYPE(xt_config), INTENT(in) :: config
731 TYPE(xt_redist) :: res
732 INTERFACE
733 FUNCTION xt_redist_p2p_custom_new_f(xmap, datatype, config) &
734 bind(c, name='xt_redist_p2p_custom_new_f') result(res_ptr)
735 import:: xt_xmap, xt_redist, c_ptr, xt_mpi_fint_kind, xt_config
736 IMPLICIT NONE
737 TYPE(xt_xmap), INTENT(in) :: xmap
738 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: datatype
739 TYPE(xt_config), INTENT(in) :: config
740 TYPE(c_ptr) :: res_ptr
741 END FUNCTION xt_redist_p2p_custom_new_f
742 END INTERFACE
743 res%cptr = xt_redist_p2p_custom_new_f(xmap, datatype, config)
744 END FUNCTION xt_redist_p2p_custom_new
745
746 FUNCTION xt_redist_p2p_off_new(xmap, src_offsets, dst_offsets, datatype) &
747 result(res)
748 IMPLICIT NONE
749 TYPE(xt_xmap), INTENT(in) :: xmap
750 INTEGER, INTENT(in) :: src_offsets(*)
751 INTEGER, INTENT(in) :: dst_offsets(*)
752 INTEGER, INTENT(in) :: datatype
753 TYPE(xt_redist) :: res
754 INTERFACE
755 FUNCTION xt_redist_p2p_off_new_f(xmap, src_offsets, dst_offsets, &
756 datatype) bind(C, name='xt_redist_p2p_off_new_f') RESULT(res_ptr)
757 IMPORT :: xt_xmap, xt_redist, c_ptr, xt_mpi_fint_kind
758 IMPLICIT NONE
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
763 END FUNCTION xt_redist_p2p_off_new_f
764 END INTERFACE
765 res%cptr = xt_redist_p2p_off_new_f(xmap, src_offsets, dst_offsets, datatype)
766 END FUNCTION xt_redist_p2p_off_new
767
768 FUNCTION xt_redist_p2p_off_custom_new(xmap, src_offsets, dst_offsets, &
769 datatype, config) RESULT(res)
770 IMPLICIT NONE
771 TYPE(xt_xmap), INTENT(in) :: xmap
772 INTEGER, INTENT(in) :: src_offsets(*), dst_offsets(*)
773 INTEGER, INTENT(in) :: datatype
774 TYPE(xt_config), INTENT(in) :: config
775 TYPE(xt_redist) :: res
776 INTERFACE
777 FUNCTION xt_redist_p2p_off_custom_new_f(xmap, src_offsets, dst_offsets, &
778 datatype, config) bind(C, name='xt_redist_p2p_off_custom_new_f') &
779 result(res_ptr)
780 IMPORT :: xt_xmap, xt_redist, c_ptr, xt_mpi_fint_kind, xt_config
781 IMPLICIT NONE
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
785 TYPE(xt_config), INTENT(in) :: config
786 TYPE(c_ptr) :: res_ptr
788 END INTERFACE
789 res%cptr = xt_redist_p2p_off_custom_new_f(xmap, src_offsets, dst_offsets, &
790 datatype, config)
792
793 FUNCTION xt_redist_p2p_blocks_new(xmap, src_block_sizes, src_block_num, &
794 & dst_block_sizes, dst_block_num, &
795 & datatype) &
796 result(res)
797 IMPLICIT NONE
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
802 TYPE(xt_redist) :: res
803 INTERFACE
804 FUNCTION xt_redist_p2p_blocks_new_f(xmap, &
805 & src_block_sizes, src_block_num, &
806 & dst_block_sizes, dst_block_num, &
807 & datatype) &
808 bind(c, name='xt_redist_p2p_blocks_new_f') result(res_ptr)
809 IMPORT :: xt_xmap, xt_mpi_fint_kind, xt_redist, c_int, c_ptr
810 IMPLICIT NONE
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
816 END FUNCTION xt_redist_p2p_blocks_new_f
817 END INTERFACE
818 res%cptr = xt_redist_p2p_blocks_new_f(xmap, &
819 & src_block_sizes, src_block_num, &
820 & dst_block_sizes, dst_block_num, &
821 & datatype)
822 END FUNCTION xt_redist_p2p_blocks_new
823
824 FUNCTION xt_redist_p2p_blocks_custom_new(xmap, src_block_sizes, &
825 & src_block_num, &
826 & dst_block_sizes, dst_block_num, &
827 & datatype, config) &
828 result(res)
829 IMPLICIT NONE
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
834 TYPE(xt_config), INTENT(in) :: config
835 TYPE(xt_redist) :: res
836 INTERFACE
837 FUNCTION xt_redist_p2p_blocks_custom_new_f(xmap, &
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)
842 IMPORT :: xt_xmap, xt_mpi_fint_kind, xt_redist, c_int, c_ptr, xt_config
843 IMPLICIT NONE
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
848 TYPE(xt_config), INTENT(in) :: config
849 TYPE(c_ptr) :: res_ptr
851 END INTERFACE
852 res%cptr = xt_redist_p2p_blocks_custom_new_f(xmap, &
853 & src_block_sizes, src_block_num, &
854 & dst_block_sizes, dst_block_num, datatype, config)
856
857 FUNCTION xt_redist_p2p_blocks_off_new(xmap, src_block_offsets, &
858 src_block_sizes, src_block_num, &
859 dst_block_offsets, dst_block_sizes, dst_block_num, &
860 datatype) RESULT(res)
861 IMPLICIT NONE
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
870 TYPE(xt_redist) :: res
871 INTERFACE
872 FUNCTION xt_redist_p2p_blocks_off_new_f(xmap, src_block_offsets, &
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') &
876 result(res_ptr)
877 IMPORT :: xt_xmap, xt_redist, xt_mpi_fint_kind, c_int, c_ptr
878 IMPLICIT NONE
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
886 END INTERFACE
887 res%cptr = xt_redist_p2p_blocks_off_new_f(xmap, src_block_offsets, &
888 src_block_sizes, src_block_num, &
889 dst_block_offsets, dst_block_sizes, dst_block_num, datatype)
891
892 FUNCTION xt_redist_p2p_blocks_off_custom_new(xmap, src_block_offsets, &
893 src_block_sizes, src_block_num, &
894 dst_block_offsets, dst_block_sizes, dst_block_num, &
895 datatype, config) RESULT(res)
896 IMPLICIT NONE
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
902 TYPE(xt_config), INTENT(in) :: config
903 TYPE(xt_redist) :: res
904 INTERFACE
905 FUNCTION xt_redist_p2p_blocks_off_custom_new_f(xmap, src_block_offsets, &
906 src_block_sizes, src_block_num, &
907 dst_block_offsets, dst_block_sizes, dst_block_num, &
908 datatype, config) &
909 bind(c, name='xt_redist_p2p_blocks_off_custom_new_f') result(res_ptr)
910 IMPORT :: xt_xmap, xt_redist, xt_mpi_fint_kind, c_int, c_ptr, xt_config
911 IMPLICIT NONE
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
918 TYPE(xt_config), INTENT(in) :: config
919 TYPE(c_ptr) :: res_ptr
921 END INTERFACE
922
924 src_block_offsets, src_block_sizes, src_block_num, &
925 dst_block_offsets, dst_block_sizes, dst_block_num, &
926 datatype, config)
928
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(*), &
934 dst_displacements(*)
935 TYPE(xt_redist) :: res
936 INTEGER(c_int) :: num_redists_c
937 num_redists_c = int(num_redists, c_int)
938 res%cptr = xt_redist_collection_static_new_f(redists, &
939 num_redists_c, src_displacements, dst_displacements, comm)
940 END FUNCTION xt_redist_collection_static_new_a_i_2ak_i
941
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(*), &
947 dst_displacements(*)
948 TYPE(xt_config), INTENT(in) :: config
949 TYPE(xt_redist) :: res
950 INTEGER(c_int) :: num_redists_c
951 num_redists_c = int(num_redists, c_int)
952 res%cptr = xt_redist_collection_static_custom_new_f(redists, &
953 num_redists_c, src_displacements, dst_displacements, comm, config)
954 END FUNCTION xt_redist_collection_static_new_a_i_2ak_i_cfg
955
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(:), &
961 dst_displacements(:)
962 TYPE(xt_redist) :: res
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__)
968 res%cptr = xt_redist_collection_static_new_f(redists, &
969 num_redists, src_displacements, dst_displacements, comm)
970 END FUNCTION xt_redist_collection_static_new_a_2ak_i
971
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(:), &
977 dst_displacements(:)
978 TYPE(xt_config), INTENT(in) :: config
979 TYPE(xt_redist) :: res
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__)
985 res%cptr = xt_redist_collection_static_custom_new_f(redists, &
986 num_redists, src_displacements, dst_displacements, comm, config)
987 END FUNCTION xt_redist_collection_static_new_a_2ak_i_cfg
988
989 FUNCTION xt_redist_collection_new_a_3i(redists, num_redists, cache_size, &
990 comm) RESULT(res)
991 TYPE(xt_redist), INTENT(in) :: redists(*)
992 INTEGER, INTENT(in) :: num_redists, cache_size, comm
993 TYPE(xt_redist) :: res
994 res%cptr = xt_redist_collection_new_f(redists, num_redists, &
995 cache_size, comm)
996 END FUNCTION xt_redist_collection_new_a_3i
997
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
1002 TYPE(xt_config), INTENT(in) :: config
1003 TYPE(xt_redist) :: res
1004 res%cptr = xt_redist_collection_custom_new_f(redists, num_redists,&
1005 cache_size, comm, config)
1006 END FUNCTION xt_redist_collection_new_a_3i_cfg
1007
1008 FUNCTION xt_redist_collection_new_a_2i(redists, cache_size, comm) &
1009 result(res)
1010 TYPE(xt_redist), INTENT(in) :: redists(:)
1011 INTEGER, INTENT(in) :: cache_size, comm
1012 TYPE(xt_redist) :: res
1013 INTEGER :: num_redists
1014 num_redists = SIZE(redists)
1015 res%cptr = xt_redist_collection_new_f(redists, &
1016 num_redists, cache_size, comm)
1017 END FUNCTION xt_redist_collection_new_a_2i
1018
1019 FUNCTION xt_redist_collection_new_a_2i_cfg(redists, cache_size, comm, &
1020 config) RESULT(res)
1021 TYPE(xt_redist), INTENT(in) :: redists(:)
1022 INTEGER, INTENT(in) :: cache_size, comm
1023 TYPE(xt_config), INTENT(in) :: config
1024 TYPE(xt_redist) :: res
1025 INTEGER :: num_redists
1026 num_redists = SIZE(redists)
1027 res%cptr = xt_redist_collection_custom_new_f(redists, &
1028 num_redists, cache_size, comm, config)
1029 END FUNCTION xt_redist_collection_new_a_2i_cfg
1030
1031 FUNCTION xt_redist_collection_new_a_i(redists, comm) &
1032 result(res)
1033 TYPE(xt_redist), INTENT(in) :: redists(:)
1034 INTEGER, INTENT(in) :: comm
1035 TYPE(xt_redist) :: res
1036
1037 res = xt_redist_collection_new_a_3i(redists, SIZE(redists), -1, comm)
1038 END FUNCTION xt_redist_collection_new_a_i
1039
1040 FUNCTION xt_redist_collection_new_a_i_cfg(redists, comm, config) &
1041 result(res)
1042 TYPE(xt_redist), INTENT(in) :: redists(:)
1043 INTEGER, INTENT(in) :: comm
1044 TYPE(xt_config), INTENT(in) :: config
1045 TYPE(xt_redist) :: res
1046
1047 res = xt_redist_collection_new_a_3i_cfg(redists, SIZE(redists), &
1048 &-1, comm, config)
1049 END FUNCTION xt_redist_collection_new_a_i_cfg
1050
1051
1052 FUNCTION xt_redist_repeat_new_i4_a1d(redist, src_extent, dst_extent, &
1053 num_repetitions, displacements) RESULT(res)
1054 TYPE(xt_redist), INTENT(in) :: redist
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)
1058 TYPE(xt_redist) :: res
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
1064
1065 FUNCTION xt_redist_repeat_new_i4_a1d_cfg(redist, src_extent, dst_extent, &
1066 num_repetitions, displacements, config) RESULT(res)
1067 TYPE(xt_redist), INTENT(in) :: redist
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)
1071 TYPE(xt_config), INTENT(in) :: config
1072 TYPE(xt_redist) :: res
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, &
1077 xt_config_f2c(config))
1078 END FUNCTION xt_redist_repeat_new_i4_a1d_cfg
1079
1080 FUNCTION xt_redist_repeat_new_a1d(redist, src_extent, dst_extent, &
1081 displacements) RESULT(res)
1082 TYPE(xt_redist), INTENT(in) :: redist
1083 INTEGER(mpi_address_kind), INTENT(in) :: src_extent, dst_extent
1084 INTEGER(c_int), INTENT(in) :: displacements(:)
1085 TYPE(xt_redist) :: res
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
1091
1092 FUNCTION xt_redist_repeat_new_a1d_cfg(redist, src_extent, dst_extent, &
1093 displacements, config) RESULT(res)
1094 TYPE(xt_redist), INTENT(in) :: redist
1095 INTEGER(mpi_address_kind), INTENT(in) :: src_extent, dst_extent
1096 INTEGER(c_int), INTENT(in) :: displacements(:)
1097 TYPE(xt_config), INTENT(in) :: config
1098 TYPE(xt_redist) :: res
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, &
1103 xt_config_f2c(config))
1104 END FUNCTION xt_redist_repeat_new_a1d_cfg
1105
1106 FUNCTION xt_redist_repeat_asym_new_i4_a1d(redist, src_extent, dst_extent, &
1107 num_repetitions, src_displacements, dst_displacements) RESULT(res)
1108 TYPE(xt_redist), INTENT(in) :: redist
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)
1113 TYPE(xt_redist) :: res
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, &
1118 dst_displacements)
1119 END FUNCTION xt_redist_repeat_asym_new_i4_a1d
1120
1121 FUNCTION xt_redist_repeat_asym_new_i4_a1d_cfg(redist, src_extent, dst_extent,&
1122 num_repetitions, src_displacements, dst_displacements, config) &
1123 result(res)
1124 TYPE(xt_redist), INTENT(in) :: redist
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)
1129 TYPE(xt_config), INTENT(in) :: config
1130 TYPE(xt_redist) :: res
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, &
1135 dst_displacements, xt_config_f2c(config))
1136 END FUNCTION xt_redist_repeat_asym_new_i4_a1d_cfg
1137
1138 FUNCTION xt_redist_repeat_asym_new_a1d(redist, src_extent, dst_extent, &
1139 src_displacements, dst_displacements) RESULT(res)
1140 TYPE(xt_redist), INTENT(in) :: redist
1141 INTEGER(mpi_address_kind), INTENT(in) :: src_extent, dst_extent
1142 INTEGER(c_int), INTENT(in) :: src_displacements(:), dst_displacements(:)
1143 TYPE(xt_redist) :: res
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", &
1148 filename, __line__)
1149 res%cptr = xt_redist_repeat_asym_new_c(redist%cptr, &
1150 src_extent, dst_extent, num_repetitions, src_displacements, &
1151 dst_displacements)
1152 END FUNCTION xt_redist_repeat_asym_new_a1d
1153
1154 FUNCTION xt_redist_repeat_asym_new_a1d_cfg(redist, src_extent, dst_extent, &
1155 src_displacements, dst_displacements, config) RESULT(res)
1156 TYPE(xt_redist), INTENT(in) :: redist
1157 INTEGER(mpi_address_kind), INTENT(in) :: src_extent, dst_extent
1158 INTEGER(c_int), INTENT(in) :: src_displacements(:), dst_displacements(:)
1159 TYPE(xt_config), INTENT(in) :: config
1160 TYPE(xt_redist) :: res
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", &
1165 filename, __line__)
1166 res%cptr = xt_redist_repeat_asym_custom_new_c(redist%cptr, &
1167 src_extent, dst_extent, num_repetitions, src_displacements, &
1168 dst_displacements, xt_config_f2c(config))
1169 END FUNCTION xt_redist_repeat_asym_new_a1d_cfg
1170
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
1178 TYPE(xt_redist) :: redist
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)
1185 redist%cptr = xt_redist_p2p_ext_new_c2f(xmap, &
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
1188
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
1196 TYPE(xt_config), INTENT(in) :: config
1197 TYPE(xt_redist) :: redist
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)
1204 redist%cptr = xt_redist_p2p_ext_custom_new_c2f(xmap, num_src_ext_c, &
1205 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1206 END FUNCTION xt_redist_p2p_ext_new_i2_a1d_i2_a1d_cfg
1207
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
1215 TYPE(xt_redist) :: redist
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)
1222 redist%cptr = xt_redist_p2p_ext_new_c2f(xmap, num_src_ext_c, &
1223 src_extents, num_dst_ext_c, dst_extents, datatype)
1224 END FUNCTION xt_redist_p2p_ext_new_i4_a1d_i4_a1d
1225
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
1233 TYPE(xt_config), INTENT(in) :: config
1234 TYPE(xt_redist) :: redist
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)
1241 redist%cptr = xt_redist_p2p_ext_custom_new_c2f(xmap, &
1242 num_src_ext_c, src_extents, num_dst_ext_c, dst_extents, datatype, &
1243 config)
1244 END FUNCTION xt_redist_p2p_ext_new_i4_a1d_i4_a1d_cfg
1245
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
1253 TYPE(xt_redist) :: redist
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)
1260 redist%cptr = xt_redist_p2p_ext_new_c2f(xmap, num_src_ext_c, &
1261 src_extents, num_dst_ext_c, dst_extents, datatype)
1262 END FUNCTION xt_redist_p2p_ext_new_i8_a1d_i8_a1d
1263
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
1271 TYPE(xt_config), INTENT(in) :: config
1272 TYPE(xt_redist) :: redist
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)
1279 redist%cptr = xt_redist_p2p_ext_custom_new_c2f(xmap, num_src_ext_c, &
1280 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1281 END FUNCTION xt_redist_p2p_ext_new_i8_a1d_i8_a1d_cfg
1282
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
1288 TYPE(xt_redist) :: redist
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)
1297 redist%cptr = xt_redist_p2p_ext_new_c2f(xmap, num_src_ext_c, &
1298 src_extents, num_dst_ext_c, dst_extents, datatype)
1299 END FUNCTION xt_redist_p2p_ext_new_a1d_a1d
1300
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
1306 TYPE(xt_config), INTENT(in) :: config
1307 TYPE(xt_redist) :: redist
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)
1316 redist%cptr = xt_redist_p2p_ext_custom_new_c2f(xmap, num_src_ext_c, &
1317 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1318 END FUNCTION xt_redist_p2p_ext_new_a1d_a1d_cfg
1319
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
1324 TYPE(xt_aoffset_ext), INTENT(in) :: src_extents(num_src_ext), &
1325 dst_extents(num_dst_ext)
1326 INTEGER, INTENT(in) :: datatype
1327 TYPE(xt_redist) :: redist
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)
1334 redist%cptr = xt_redist_p2p_aext_new_c2f(xmap, &
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
1337
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
1342 TYPE(xt_aoffset_ext), INTENT(in) :: src_extents(num_src_ext), &
1343 dst_extents(num_dst_ext)
1344 INTEGER, INTENT(in) :: datatype
1345 TYPE(xt_config), INTENT(in) :: config
1346 TYPE(xt_redist) :: redist
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)
1353 redist%cptr = xt_redist_p2p_aext_custom_new_c2f(xmap, num_src_ext_c, &
1354 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1355 END FUNCTION xt_redist_p2p_aext_new_i2_a1d_i2_a1d_cfg
1356
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
1361 TYPE(xt_aoffset_ext), INTENT(in) :: src_extents(num_src_ext), &
1362 dst_extents(num_dst_ext)
1363 INTEGER, INTENT(in) :: datatype
1364 TYPE(xt_redist) :: redist
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)
1371 redist%cptr = xt_redist_p2p_aext_new_c2f(xmap, num_src_ext_c, &
1372 src_extents, num_dst_ext_c, dst_extents, datatype)
1373 END FUNCTION xt_redist_p2p_aext_new_i4_a1d_i4_a1d
1374
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
1379 TYPE(xt_aoffset_ext), INTENT(in) :: src_extents(num_src_ext), &
1380 dst_extents(num_dst_ext)
1381 INTEGER, INTENT(in) :: datatype
1382 TYPE(xt_config), INTENT(in) :: config
1383 TYPE(xt_redist) :: redist
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)
1390 redist%cptr = xt_redist_p2p_aext_custom_new_c2f(xmap, &
1391 num_src_ext_c, src_extents, num_dst_ext_c, dst_extents, datatype, &
1392 config)
1393 END FUNCTION xt_redist_p2p_aext_new_i4_a1d_i4_a1d_cfg
1394
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
1399 TYPE(xt_aoffset_ext), INTENT(in) :: src_extents(num_src_ext), &
1400 dst_extents(num_dst_ext)
1401 INTEGER, INTENT(in) :: datatype
1402 TYPE(xt_redist) :: redist
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)
1409 redist%cptr = xt_redist_p2p_aext_new_c2f(xmap, num_src_ext_c, &
1410 src_extents, num_dst_ext_c, dst_extents, datatype)
1411 END FUNCTION xt_redist_p2p_aext_new_i8_a1d_i8_a1d
1412
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
1417 TYPE(xt_aoffset_ext), INTENT(in) :: src_extents(num_src_ext), &
1418 dst_extents(num_dst_ext)
1419 INTEGER, INTENT(in) :: datatype
1420 TYPE(xt_config), INTENT(in) :: config
1421 TYPE(xt_redist) :: redist
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)
1428 redist%cptr = xt_redist_p2p_aext_custom_new_c2f(xmap, num_src_ext_c, &
1429 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1430 END FUNCTION xt_redist_p2p_aext_new_i8_a1d_i8_a1d_cfg
1431
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
1437 TYPE(xt_redist) :: redist
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)
1446 redist%cptr = xt_redist_p2p_aext_new_c2f(xmap, num_src_ext_c, &
1447 src_extents, num_dst_ext_c, dst_extents, datatype)
1448 END FUNCTION xt_redist_p2p_aext_new_a1d_a1d
1449
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
1455 TYPE(xt_config), INTENT(in) :: config
1456 TYPE(xt_redist) :: redist
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)
1465 redist%cptr = xt_redist_p2p_aext_custom_new_c2f(xmap, num_src_ext_c, &
1466 src_extents, num_dst_ext_c, dst_extents, datatype, config)
1467 END FUNCTION xt_redist_p2p_aext_new_a1d_a1d_cfg
1468
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
1472 TYPE(xt_redist_msg), TARGET, INTENT(in) :: &
1473 send_msgs(nsend), recv_msgs(nrecv)
1474 INTEGER, INTENT(in) :: comm
1475 TYPE(xt_redist) :: redist
1476
1477 INTEGER(c_int) :: nsend_c, nrecv_c
1478 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1479
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)
1485 ELSE
1486 send_msgs_p = c_null_ptr
1487 END IF
1488 IF (nrecv > 0_i2) THEN
1489 recv_msgs_p = c_loc(recv_msgs)
1490 ELSE
1491 recv_msgs_p = c_null_ptr
1492 END IF
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
1498
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
1502 TYPE(xt_redist_msg), TARGET, INTENT(in) :: &
1503 send_msgs(nsend), recv_msgs(nrecv)
1504 INTEGER, INTENT(in) :: comm
1505 TYPE(xt_config), INTENT(in) :: config
1506 TYPE(xt_redist) :: redist
1507
1508 INTEGER(c_int) :: nsend_c, nrecv_c
1509 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1510
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)
1516 ELSE
1517 send_msgs_p = c_null_ptr
1518 END IF
1519 IF (nrecv > 0_i2) THEN
1520 recv_msgs_p = c_loc(recv_msgs)
1521 ELSE
1522 recv_msgs_p = c_null_ptr
1523 END IF
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
1529
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
1533 TYPE(xt_redist_msg), TARGET, INTENT(in) :: &
1534 send_msgs(nsend), recv_msgs(nrecv)
1535 INTEGER, INTENT(in) :: comm
1536 TYPE(xt_redist) :: redist
1537
1538 INTEGER(c_int) :: nsend_c, nrecv_c
1539 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1540
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)
1546 ELSE
1547 send_msgs_p = c_null_ptr
1548 END IF
1549 IF (nrecv > 0_i4) THEN
1550 recv_msgs_p = c_loc(recv_msgs)
1551 ELSE
1552 recv_msgs_p = c_null_ptr
1553 END IF
1554 nsend_c = int(nsend, c_int)
1555 nrecv_c = int(nrecv, c_int)
1556 redist = xt_redist_c2f(xt_redist_single_array_base_new_c2f(&
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
1559
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
1563 TYPE(xt_redist_msg), TARGET, INTENT(in) :: &
1564 send_msgs(nsend), recv_msgs(nrecv)
1565 INTEGER, INTENT(in) :: comm
1566 TYPE(xt_config), INTENT(in) :: config
1567 TYPE(xt_redist) :: redist
1568
1569 INTEGER(c_int) :: nsend_c, nrecv_c
1570 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1571
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)
1577 ELSE
1578 send_msgs_p = c_null_ptr
1579 END IF
1580 IF (nrecv > 0_i4) THEN
1581 recv_msgs_p = c_loc(recv_msgs)
1582 ELSE
1583 recv_msgs_p = c_null_ptr
1584 END IF
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
1590
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
1594 TYPE(xt_redist_msg), TARGET, INTENT(in) :: &
1595 send_msgs(nsend), recv_msgs(nrecv)
1596 INTEGER, INTENT(in) :: comm
1597 TYPE(xt_redist) :: redist
1598
1599 INTEGER(c_int) :: nsend_c, nrecv_c
1600 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1601
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)
1607 ELSE
1608 send_msgs_p = c_null_ptr
1609 END IF
1610 IF (nrecv > 0_i8) THEN
1611 recv_msgs_p = c_loc(recv_msgs)
1612 ELSE
1613 recv_msgs_p = c_null_ptr
1614 END IF
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
1620
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
1624 TYPE(xt_redist_msg), TARGET, INTENT(in) :: &
1625 send_msgs(nsend), recv_msgs(nrecv)
1626 INTEGER, INTENT(in) :: comm
1627 TYPE(xt_config), INTENT(in) :: config
1628 TYPE(xt_redist) :: redist
1629
1630 INTEGER(c_int) :: nsend_c, nrecv_c
1631 TYPE(c_ptr) :: send_msgs_p, recv_msgs_p
1632
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)
1638 ELSE
1639 send_msgs_p = c_null_ptr
1640 END IF
1641 IF (nrecv > 0_i8) THEN
1642 recv_msgs_p = c_loc(recv_msgs)
1643 ELSE
1644 recv_msgs_p = c_null_ptr
1645 END IF
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
1651
1652 FUNCTION xt_redist_single_array_base_new_a1d_a1d(send_msgs, recv_msgs, comm) &
1653 result(redist)
1654 TYPE(xt_redist_msg), TARGET, INTENT(in) :: send_msgs(:), recv_msgs(:)
1655 INTEGER, INTENT(in) :: comm
1656 TYPE(xt_redist) :: redist
1657
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(:)
1662
1663 nsend = SIZE(send_msgs)
1664 nrecv = SIZE(recv_msgs)
1665
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)
1668
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
1677
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
1682 TYPE(xt_config), INTENT(in) :: config
1683 TYPE(xt_redist) :: redist
1684
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(:)
1689
1690 nsend = SIZE(send_msgs)
1691 nrecv = SIZE(recv_msgs)
1692
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)
1695
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
1704
1705 SUBROUTINE msgs_p_arg(msgs, msgs_a, msgs_p)
1706 TYPE(xt_redist_msg), TARGET, INTENT(in) :: msgs(:)
1707 TYPE(xt_redist_msg), TARGET, ALLOCATABLE, INTENT(inout) :: msgs_a(:)
1708 TYPE(c_ptr), INTENT(out) :: msgs_p
1709
1710 INTEGER :: msgs_size
1711 LOGICAL :: msgs_is_contiguous
1712#ifndef HAVE_FC_IS_CONTIGUOUS
1713 INTERFACE
1714 FUNCTION xt_redist_msg_contiguous(msgs_a, msgs_b) RESULT(p) &
1715 bind(c, name='xt_redist_msg_contiguous')
1716 IMPORT :: c_int, xt_redist_msg
1717 TYPE(xt_redist_msg), INTENT(in) :: msgs_a, msgs_b
1718 INTEGER(c_int) :: p
1719 END FUNCTION xt_redist_msg_contiguous
1720 END INTERFACE
1721#endif
1722
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)
1730#else
1731 msgs_is_contiguous = xt_redist_msg_contiguous(msgs(1), msgs(2)) /= 0
1732#endif
1733 IF (msgs_is_contiguous) THEN
1734 xt_slice_c_loc(msgs(1), msgs_p)
1735 ELSE
1736 ALLOCATE(msgs_a(msgs_size))
1737 msgs_a = msgs
1738 msgs_p = c_loc(msgs_a)
1739 END IF
1740 ELSE
1741 xt_slice_c_loc(msgs(1), msgs_p)
1742 END IF
1743 ELSE
1744 msgs_p = c_null_ptr
1745 END IF
1746 END SUBROUTINE msgs_p_arg
1747
1748END MODULE xt_redist_base
1749
1751 USE xt_redist_base, ONLY: xt_redist_p2p_orig_new => xt_redist_p2p_new, &
1753 IMPLICIT NONE
1754 PRIVATE
1756 MODULE PROCEDURE xt_redist_p2p_orig_new
1757 MODULE PROCEDURE xt_redist_p2p_custom_new
1758 END INTERFACE xt_redist_p2p_new
1759 PUBLIC :: xt_redist_p2p_new
1760END MODULE xt_redist_rename
1761!
1762! Local Variables:
1763! f90-continuation-indent: 5
1764! coding: utf-8
1765! indent-tabs-mode: nil
1766! show-trailing-whitespace: t
1767! require-trailing-newline: t
1768! End:
1769!
void xt_redist_delete(Xt_redist redist)
Definition xt_redist.c:74
int xt_redist_get_num_recv_msg(Xt_redist redist)
Definition xt_redist.c:108
int xt_redist_get_num_send_msg(Xt_redist redist)
Definition xt_redist.c:103
void xt_redist_a_exchange1(Xt_redist redist, const void *src_data, void *dst_data, Xt_request *request)
Definition xt_redist.c:97
Xt_redist xt_redist_copy(Xt_redist redist)
Definition xt_redist.c:69
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
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)
Definition yaxt_f2c.c:185
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)
Definition yaxt_f2c.c:373
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)
Definition yaxt_f2c.c:321
PPM_DSO_INTERNAL Xt_redist xt_redist_p2p_new_f(struct xt_xmap_f *xmap_f, MPI_Fint datatype_f)
Definition yaxt_f2c.c:431
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)
Definition yaxt_f2c.c:336
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)
Definition yaxt_f2c.c:408
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)
Definition yaxt_f2c.c:362
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)
Definition yaxt_f2c.c:463
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)
Definition yaxt_f2c.c:396
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)
Definition yaxt_f2c.c:419
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)
Definition yaxt_f2c.c:547
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)
Definition yaxt_f2c.c:496
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)
Definition yaxt_f2c.c:385
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)
Definition yaxt_f2c.c:481
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)
Definition yaxt_f2c.c:558
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)
Definition yaxt_f2c.c:438
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)
Definition yaxt_f2c.c:348
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)
Definition yaxt_f2c.c:624
Xt_config xt_config_f2c(struct xt_config_f *p)
Definition yaxt_f2c.c:190
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)
Definition yaxt_f2c.c:306
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)
Definition yaxt_f2c.c:446