Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
xt_xmap_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#include "fc_feature_defs.inc"
49MODULE xt_xmap_abstract
50 USE iso_c_binding, ONLY: c_int, c_ptr, c_null_ptr, &
51 c_associated, c_f_pointer, c_loc
52 USE xt_core, ONLY: xt_abort, xt_mpi_fint_kind, xt_pos_ext, i2, i4, i8
54 USE xt_idxlist_abstract, ONLY: xt_idxlist
55 IMPLICIT NONE
56 PRIVATE
57 PUBLIC :: xt_xmap_c2f, xt_xmap_f2c, xt_is_null
62 xt_reorder_type_kind, &
63 xt_reorder_none, xt_reorder_send_up, xt_reorder_recv_up, &
76
77
78 ! note: this type must not be extended to contain any other
79 ! components, its memory pattern has to match void * exactly, which
80 ! it does because of C constraints
81 TYPE, BIND(C), PUBLIC :: xt_xmap
82#ifndef __G95__
83 PRIVATE
84#endif
85 TYPE(c_ptr) :: cptr = c_null_ptr
86 END TYPE xt_xmap
87
88 TYPE, BIND(c), PUBLIC :: xt_xmap_iter
89#ifndef __G95__
90 PRIVATE
91#endif
92 TYPE(c_ptr) :: cptr = c_null_ptr
93 END TYPE xt_xmap_iter
94
95 ENUM, BIND( C )
96 ENUMERATOR :: xt_reorder_none, xt_reorder_send_up, xt_reorder_recv_up
97 END ENUM
98 INTEGER, PARAMETER :: xt_reorder_type_kind = kind(xt_reorder_none)
99
100 INTERFACE
101 ! this function must not be implemented in Fortran because
102 ! PGI 11.x chokes on that
103 FUNCTION xt_xmap_f2c(xmap) bind(c, name='xt_xmap_f2c') RESULT(p)
104 IMPORT :: c_ptr, xt_xmap
105 IMPLICIT NONE
106 TYPE(xt_xmap), INTENT(in) :: xmap
107 TYPE(c_ptr) :: p
108 END FUNCTION xt_xmap_f2c
109
110 SUBROUTINE xt_xmap_delete_c(xmap) bind(C, name='xt_xmap_delete')
111 IMPORT :: c_ptr
112 IMPLICIT NONE
113 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
114 END SUBROUTINE xt_xmap_delete_c
115
116 END INTERFACE
117
118 INTERFACE xt_xmap_delete
119 MODULE PROCEDURE xt_xmap_delete_1
120 MODULE PROCEDURE xt_xmap_delete_a1d
121 END INTERFACE xt_xmap_delete
122
123 INTERFACE xt_is_null
124 MODULE PROCEDURE xt_xmap_is_null
125 MODULE PROCEDURE xt_xmap_iterator_is_null
126 END INTERFACE xt_is_null
127
128 INTERFACE
129 FUNCTION xt_xmap_iterator_get_num_transfer_pos_c(iter) RESULT(num) &
130 bind(c, name='xt_xmap_iterator_get_num_transfer_pos')
131 IMPORT :: c_int, c_ptr
132 TYPE(c_ptr), VALUE, INTENT(in) :: iter
133 INTEGER(c_int) :: num
134 END FUNCTION xt_xmap_iterator_get_num_transfer_pos_c
135
136 FUNCTION xt_xmap_iterator_get_num_transfer_pos_ext_c(iter) RESULT(num) &
137 bind(c, name='xt_xmap_iterator_get_num_transfer_pos_ext')
138 IMPORT :: c_int, c_ptr
139 TYPE(c_ptr), VALUE, INTENT(in) :: iter
140 INTEGER(c_int) :: num
141 END FUNCTION xt_xmap_iterator_get_num_transfer_pos_ext_c
142 END INTERFACE
143
144 INTERFACE xt_xmap_spread
145 MODULE PROCEDURE xt_xmap_spread_a1d
146 MODULE PROCEDURE xt_xmap_spread_i2_a1d
147 MODULE PROCEDURE xt_xmap_spread_i4_a1d
148 MODULE PROCEDURE xt_xmap_spread_i8_a1d
149 END INTERFACE xt_xmap_spread
150
151 CHARACTER(len=*), PARAMETER :: filename = 'xt_xmap_f.f90'
152CONTAINS
153
154 FUNCTION xt_xmap_is_null(xmap) RESULT(p)
155 TYPE(xt_xmap), INTENT(in) :: xmap
156 LOGICAL :: p
157 p = .NOT. c_associated(xmap%cptr)
158 END FUNCTION xt_xmap_is_null
159
160
161 FUNCTION xt_xmap_c2f(xmap) RESULT(p)
162 TYPE(c_ptr), INTENT(in) :: xmap
163 TYPE(xt_xmap) :: p
164 p%cptr = xmap
165 END FUNCTION xt_xmap_c2f
166
167 FUNCTION xt_xmap_copy(xmap) RESULT(xmap_copy)
168 TYPE(xt_xmap), INTENT(in) :: xmap
169 TYPE(xt_xmap) :: xmap_copy
170 INTERFACE
171 FUNCTION xt_xmap_copy_c(xmap) bind(C, name='xt_xmap_copy') RESULT(res_ptr)
172 IMPORT :: xt_xmap, c_ptr
173 IMPLICIT NONE
174 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
175 TYPE(c_ptr) :: res_ptr
176 END FUNCTION xt_xmap_copy_c
177 END INTERFACE
178 xmap_copy%cptr = xt_xmap_copy_c(xmap%cptr)
179 END FUNCTION xt_xmap_copy
180 SUBROUTINE xt_xmap_delete_1(xmap)
181 TYPE(xt_xmap), INTENT(inout) :: xmap
182 CALL xt_xmap_delete_c(xmap%cptr)
183 xmap%cptr = c_null_ptr
184 END SUBROUTINE xt_xmap_delete_1
185
186 SUBROUTINE xt_xmap_delete_a1d(xmaps)
187 TYPE(xt_xmap), INTENT(inout) :: xmaps(:)
188 INTEGER :: i, n
189 n = SIZE(xmaps)
190 DO i = 1, n
191 CALL xt_xmap_delete_c(xmaps(i)%cptr)
192 xmaps(i)%cptr = c_null_ptr
193 END DO
194 END SUBROUTINE xt_xmap_delete_a1d
195
196 FUNCTION xt_xmap_all2all_new(src_idxlist, dst_idxlist, comm) RESULT(xmap)
197 IMPLICIT NONE
198 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
199 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
200 INTEGER, INTENT(in) :: comm
201 TYPE(xt_xmap) :: xmap
202
203 INTERFACE
204 FUNCTION xt_xmap_all2all_new_f(src_idxlist, dst_idxlist, comm) &
205 bind(c, name='xt_xmap_all2all_new_f') result(xmap_ptr)
206 IMPORT :: xt_idxlist, xt_xmap, xt_mpi_fint_kind, c_ptr
207 IMPLICIT NONE
208 TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
209 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: comm
210 TYPE(c_ptr) :: xmap_ptr
211 END FUNCTION xt_xmap_all2all_new_f
212 END INTERFACE
213
214 xmap%cptr = xt_xmap_all2all_new_f(src_idxlist, dst_idxlist, comm)
215 END FUNCTION xt_xmap_all2all_new
216
217 FUNCTION xt_xmap_all2all_custom_new(src_idxlist, dst_idxlist, comm, config) &
218 result(xmap)
219 IMPLICIT NONE
220 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
221 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
222 INTEGER, INTENT(in) :: comm
223 TYPE(xt_config), INTENT(in) :: config
224 TYPE(xt_xmap) :: xmap
225
226 INTERFACE
227 FUNCTION xt_xmap_all2all_custom_new_f(src_idxlist, dst_idxlist, comm, &
228 config) bind(C, name='xt_xmap_all2all_custom_new_f') RESULT(xmap_ptr)
229 IMPORT :: xt_idxlist, xt_xmap, xt_mpi_fint_kind, xt_config, c_ptr
230 IMPLICIT NONE
231 TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
232 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: comm
233 TYPE(xt_config), INTENT(in) :: config
234 TYPE(c_ptr) :: xmap_ptr
236 END INTERFACE
237
238 xmap%cptr = xt_xmap_all2all_custom_new_f(src_idxlist, dst_idxlist, &
239 comm, config)
240 END FUNCTION xt_xmap_all2all_custom_new
241
242 FUNCTION xt_xmap_dist_dir_new(src_idxlist, dst_idxlist, comm) RESULT(xmap)
243 IMPLICIT NONE
244 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
245 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
246 INTEGER, INTENT(in) :: comm
247 TYPE(xt_xmap) :: xmap
248
249 INTERFACE
250 FUNCTION xt_xmap_dist_dir_new_f(src_idxlist, dst_idxlist, comm) &
251 bind(c, name='xt_xmap_dist_dir_new_f') result(xmap_ptr)
252 IMPORT :: xt_idxlist, xt_xmap, xt_mpi_fint_kind, c_ptr
253 IMPLICIT NONE
254 TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
255 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: comm
256 TYPE(c_ptr) :: xmap_ptr
257 END FUNCTION xt_xmap_dist_dir_new_f
258 END INTERFACE
259
260 xmap%cptr = xt_xmap_dist_dir_new_f(src_idxlist, dst_idxlist, comm)
261 END FUNCTION xt_xmap_dist_dir_new
262
263 FUNCTION xt_xmap_dist_dir_custom_new(src_idxlist, dst_idxlist, comm, config) &
264 result(xmap)
265 IMPLICIT NONE
266 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
267 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
268 TYPE(xt_config), INTENT(in) :: config
269 INTEGER, INTENT(in) :: comm
270 TYPE(xt_xmap) :: xmap
271 INTERFACE
272 FUNCTION xt_xmap_dist_dir_custom_new_f(src_idxlist, dst_idxlist, comm, &
273 config) bind(C, name='xt_xmap_dist_dir_custom_new_f') &
274 result(xmap_ptr)
275 IMPORT :: xt_idxlist, xt_xmap, xt_mpi_fint_kind, xt_config, c_ptr
276 IMPLICIT NONE
277 TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
278 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: comm
279 TYPE(xt_config), INTENT(in) :: config
280 TYPE(c_ptr) :: xmap_ptr
282 END INTERFACE
283 xmap%cptr = xt_xmap_dist_dir_custom_new_f(src_idxlist, dst_idxlist, &
284 comm, config)
285 END FUNCTION xt_xmap_dist_dir_custom_new
286
287 FUNCTION xt_xmap_dist_dir_intercomm_new(src_idxlist, dst_idxlist, &
288 inter_comm, intra_comm) RESULT(xmap)
289 IMPLICIT NONE
290 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
291 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
292 INTEGER, INTENT(in) :: inter_comm, intra_comm
293 TYPE(xt_xmap) :: xmap
294
295 INTERFACE
296 FUNCTION xt_xmap_dist_dir_intercomm_new_f(src_idxlist, dst_idxlist, &
297 inter_comm, intra_comm) &
298 bind(c, name='xt_xmap_dist_dir_intercomm_new_f') result(xmap_ptr)
299 IMPORT :: xt_idxlist, xt_xmap, xt_mpi_fint_kind, c_ptr
300 IMPLICIT NONE
301 TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
302 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: inter_comm, intra_comm
303 TYPE(c_ptr) :: xmap_ptr
305 END INTERFACE
306
307 xmap%cptr = xt_xmap_dist_dir_intercomm_new_f(src_idxlist, &
308 dst_idxlist, inter_comm, intra_comm)
310
311 FUNCTION xt_xmap_dist_dir_intercomm_custom_new(src_idxlist, dst_idxlist, &
312 inter_comm, intra_comm, config) RESULT(xmap)
313 IMPLICIT NONE
314 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
315 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
316 INTEGER, INTENT(in) :: inter_comm, intra_comm
317 TYPE(xt_config), INTENT(in) :: config
318 TYPE(xt_xmap) :: xmap
319
320 INTERFACE
321 FUNCTION xt_xmap_dist_dir_intercomm_custom_new_f(src_idxlist, &
322 dst_idxlist, inter_comm, intra_comm, config) &
323 bind(c, name='xt_xmap_dist_dir_intercomm_custom_new_f') &
324 result(xmap_ptr)
325 IMPORT :: xt_idxlist, xt_xmap, xt_mpi_fint_kind, xt_config, c_ptr
326 IMPLICIT NONE
327 TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
328 INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: inter_comm, intra_comm
329 TYPE(xt_config), INTENT(in) :: config
330 TYPE(c_ptr) :: xmap_ptr
332 END INTERFACE
333
334 xmap%cptr = xt_xmap_dist_dir_intercomm_custom_new_f(src_idxlist, &
335 dst_idxlist, inter_comm, intra_comm, config)
337
338 FUNCTION xt_xmap_get_num_destinations(xmap) RESULT(num)
339 TYPE(xt_xmap), INTENT(in) :: xmap
340 INTEGER :: num
341 INTERFACE
342 FUNCTION xt_xmap_get_num_destinations_c(xmap) RESULT(num) &
343 bind(c, name='xt_xmap_get_num_destinations')
344 IMPORT :: c_ptr, c_int
345 IMPLICIT NONE
346 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
347 INTEGER(c_int) :: num
348 END FUNCTION xt_xmap_get_num_destinations_c
349 END INTERFACE
350 num = int(xt_xmap_get_num_destinations_c(xmap%cptr))
352
353 FUNCTION xt_xmap_get_num_sources(xmap) RESULT(num)
354 TYPE(xt_xmap), INTENT(in) :: xmap
355 INTEGER :: num
356 INTERFACE
357 FUNCTION xt_xmap_get_num_sources_c(xmap) RESULT(num) &
358 bind(c, name='xt_xmap_get_num_sources')
359 IMPORT :: c_ptr, c_int
360 IMPLICIT NONE
361 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
362 INTEGER(c_int) :: num
363 END FUNCTION xt_xmap_get_num_sources_c
364 END INTERFACE
365 num = int(xt_xmap_get_num_sources_c(xmap%cptr))
366 END FUNCTION xt_xmap_get_num_sources
367
368 SUBROUTINE xt_xmap_get_destination_ranks(xmap, ranks)
369 TYPE(xt_xmap), INTENT(in) :: xmap
370 INTEGER(c_int), INTENT(out) :: ranks(*)
371 INTERFACE
372 SUBROUTINE xt_xmap_get_destination_ranks_c(xmap, ranks) &
373 bind(c, name='xt_xmap_get_destination_ranks')
374 IMPORT :: c_ptr, c_int
375 IMPLICIT NONE
376 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
377 INTEGER(c_int), INTENT(out) :: ranks(*)
378 END SUBROUTINE xt_xmap_get_destination_ranks_c
379 END INTERFACE
380 CALL xt_xmap_get_destination_ranks_c(xmap%cptr, ranks)
381 END SUBROUTINE xt_xmap_get_destination_ranks
382
383 SUBROUTINE xt_xmap_get_source_ranks(xmap, ranks)
384 TYPE(xt_xmap), INTENT(in) :: xmap
385 INTEGER(c_int), INTENT(out) :: ranks(*)
386 INTERFACE
387 SUBROUTINE xt_xmap_get_source_ranks_c(xmap, ranks) &
388 bind(c, name='xt_xmap_get_source_ranks')
389 IMPORT :: c_ptr, c_int
390 IMPLICIT NONE
391 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
392 INTEGER(c_int), INTENT(out) :: ranks(*)
393 END SUBROUTINE xt_xmap_get_source_ranks_c
394 END INTERFACE
395 CALL xt_xmap_get_source_ranks_c(xmap%cptr, ranks)
396 END SUBROUTINE xt_xmap_get_source_ranks
397
398 FUNCTION xt_xmap_get_max_src_pos(xmap) RESULT(num)
399 TYPE(xt_xmap), INTENT(in) :: xmap
400 INTEGER :: num
401 INTERFACE
402 FUNCTION xt_xmap_get_max_src_pos_c(xmap) RESULT(num) &
403 bind(c, name='xt_xmap_get_max_src_pos')
404 IMPORT :: c_ptr, c_int
405 IMPLICIT NONE
406 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
407 INTEGER(c_int) :: num
408 END FUNCTION xt_xmap_get_max_src_pos_c
409 END INTERFACE
410 num = int(xt_xmap_get_max_src_pos_c(xmap%cptr))
411 END FUNCTION xt_xmap_get_max_src_pos
412
413 FUNCTION xt_xmap_get_max_dst_pos(xmap) RESULT(num)
414 TYPE(xt_xmap), INTENT(in) :: xmap
415 INTEGER :: num
416 INTERFACE
417 FUNCTION xt_xmap_get_max_dst_pos_c(xmap) RESULT(num) &
418 bind(c, name='xt_xmap_get_max_dst_pos')
419 IMPORT :: c_ptr, c_int
420 IMPLICIT NONE
421 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
422 INTEGER(c_int) :: num
423 END FUNCTION xt_xmap_get_max_dst_pos_c
424 END INTERFACE
425 num = int(xt_xmap_get_max_dst_pos_c(xmap%cptr))
426 END FUNCTION xt_xmap_get_max_dst_pos
427
428 FUNCTION xt_xmap_reorder(xmap, reorder_type) RESULT(xmap_reorder)
429 IMPLICIT NONE
430 TYPE(xt_xmap), INTENT(in) :: xmap
431 INTEGER(xt_reorder_type_kind), INTENT(in) :: reorder_type
432 TYPE(xt_xmap) :: xmap_reorder
433 ! fixme: evil hack because gfortran with all warnings enabled throws a
434 ! hissy fit for dummy arguments of type integer(xt_reorder_kind)
435 ! of bind(c) routines, but the value of xt_reorder_kind always
436 ! matches c_int for that compiler anyway
437#ifdef __GNUC__
438 LOGICAL, PARAMETER :: static_assert_xt_reorder_type_kind &
439 = xt_reorder_type_kind == c_int
440 INTEGER, PARAMETER :: assert_check &
441 = 1 / merge(1, 0, static_assert_xt_reorder_type_kind)
442# define xt_reorder_type_kind c_int
443#endif
444 INTERFACE
445 FUNCTION xt_xmap_reorder_c(xmap, reorder_type) &
446 bind(c, name='xt_xmap_reorder') result(xmap_reorder_ptr)
447 import:: xt_reorder_type_kind, c_ptr
448 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
449 INTEGER(xt_reorder_type_kind), VALUE, INTENT(in) :: reorder_type
450 TYPE(c_ptr) :: xmap_reorder_ptr
451 END FUNCTION xt_xmap_reorder_c
452 END INTERFACE
453#ifdef __GNUC__
454# define UNUSED(x) IF (SIZE( (/(x)/) ) < 0) CONTINUE
455 unused(assert_check)
456#endif
457
458 IF (reorder_type < 0_xt_reorder_type_kind .OR. &
459 reorder_type > huge(1_c_int)) &
460 CALL xt_abort("invalid reorder type", filename, __line__)
461 xmap_reorder%cptr = xt_xmap_reorder_c(xmap%cptr, reorder_type)
462 ! fixme: undo effect of above hack
463#ifdef __GNUC__
464# undef xt_reorder_type_kind
465#endif
466 END FUNCTION xt_xmap_reorder
467
468 FUNCTION xt_xmap_reorder_custom(xmap, reorder_type, config) &
469 result(xmap_reorder)
470 IMPLICIT NONE
471 TYPE(xt_xmap), INTENT(in) :: xmap
472 INTEGER(xt_reorder_type_kind), INTENT(in) :: reorder_type
473 TYPE(xt_config), INTENT(in) :: config
474 TYPE(xt_xmap) :: xmap_reorder
475 ! fixme: evil hack because gfortran with all warnings enabled throws a
476 ! hissy fit for dummy arguments of type integer(xt_reorder_kind)
477 ! of bind(c) routines, but the value of xt_reorder_kind always
478 ! matches c_int for that compiler anyway
479#ifdef __GNUC__
480 LOGICAL, PARAMETER :: static_assert_xt_reorder_type_kind &
481 = xt_reorder_type_kind == c_int
482 INTEGER, PARAMETER :: assert_check &
483 = 1 / merge(1, 0, static_assert_xt_reorder_type_kind)
484# define xt_reorder_type_kind c_int
485#endif
486 INTERFACE
487 FUNCTION xt_xmap_reorder_custom_c(xmap, reorder_type, config) &
488 bind(c, name='xt_xmap_reorder_custom') result(xmap_reorder_ptr)
489 import:: xt_reorder_type_kind, c_ptr
490 TYPE(c_ptr), VALUE, INTENT(in) :: xmap, config
491 INTEGER(xt_reorder_type_kind), VALUE, INTENT(in) :: reorder_type
492 TYPE(c_ptr) :: xmap_reorder_ptr
493 END FUNCTION xt_xmap_reorder_custom_c
494 END INTERFACE
495#ifdef __GNUC__
496# define UNUSED(x) IF (SIZE( (/(x)/) ) < 0) CONTINUE
497 unused(assert_check)
498#endif
499
500 IF (reorder_type < 0_xt_reorder_type_kind .OR. &
501 reorder_type > huge(1_c_int)) &
502 CALL xt_abort("invalid reorder type", filename, __line__)
503 xmap_reorder%cptr = xt_xmap_reorder_custom_c(xmap%cptr, reorder_type, &
504 xt_config_f2c(config))
505 ! fixme: undo effect of above hack
506#ifdef __GNUC__
507# undef xt_reorder_type_kind
508#endif
509 END FUNCTION xt_xmap_reorder_custom
510
511 FUNCTION xt_xmap_update_positions(xmap, src_positions, dst_positions) &
512 result(xmap_updated)
513 IMPLICIT NONE
514 TYPE(xt_xmap), INTENT(in) :: xmap
515 INTEGER, TARGET, INTENT(in) :: src_positions(*)
516 INTEGER, TARGET, INTENT(in) :: dst_positions(*)
517 TYPE(xt_xmap) :: xmap_updated
518 INTEGER(c_int), TARGET, ALLOCATABLE :: src_positions_c(:), dst_positions_c(:)
519 TYPE(c_ptr) :: src_positions_p, dst_positions_p
520 INTERFACE
521 FUNCTION xt_xmap_update_positions_c(xmap, src_positions, dst_positions) &
522 bind(c, name='xt_xmap_update_positions') result(xmap_updated_ptr)
523 import:: c_ptr
524 TYPE(c_ptr), VALUE, INTENT(in) :: xmap, src_positions, dst_positions
525 TYPE(c_ptr) :: xmap_updated_ptr
526 END FUNCTION xt_xmap_update_positions_c
527 END INTERFACE
528
529 IF (c_int == kind(1)) THEN
530 src_positions_p = c_loc(src_positions)
531 dst_positions_p = c_loc(dst_positions)
532 ELSE
533 CALL arg2ci(xt_xmap_get_max_src_pos(xmap), src_positions, src_positions_c)
534 src_positions_p = c_loc(src_positions_c)
535 CALL arg2ci(xt_xmap_get_max_dst_pos(xmap), dst_positions, dst_positions_c)
536 dst_positions_p = c_loc(dst_positions_c)
537 END IF
538 xmap_updated%cptr = &
539 xt_xmap_update_positions_c(xmap%cptr, src_positions_p, dst_positions_p)
540 CONTAINS
541 SUBROUTINE arg2ci(n, arg, argc)
542 INTEGER, INTENT(in) :: n, arg(*)
543 INTEGER(c_int), ALLOCATABLE, INTENT(inout) :: argc(:)
544 INTEGER :: i
545 ALLOCATE(argc(n))
546 DO i = 1, n
547 argc(i) = int(arg(i), c_int)
548 END DO
549 END SUBROUTINE arg2ci
550 END FUNCTION xt_xmap_update_positions
551
552 FUNCTION xt_xmap_spread_a1d(xmap, src_displacements, dst_displacements) &
553 result(xmap_spread)
554 IMPLICIT NONE
555 TYPE(xt_xmap), INTENT(in) :: xmap
556 INTEGER, INTENT(in) :: src_displacements(:)
557 INTEGER, INTENT(in) :: dst_displacements(:)
558 TYPE(xt_xmap) :: xmap_spread
559 INTEGER :: num_repetitions
560 INTEGER(i8) :: num_repetitions_i8
561 num_repetitions = SIZE(src_displacements)
562 IF (num_repetitions /= SIZE(dst_displacements)) &
563 CALL xt_abort("invalid number of repetitions", filename, __line__)
564 num_repetitions_i8 = int(num_repetitions, i8)
565 xmap_spread = &
567 xmap, num_repetitions_i8, src_displacements, dst_displacements);
568 END FUNCTION xt_xmap_spread_a1d
569
570 FUNCTION xt_xmap_spread_i2_a1d(xmap, num_repetitions, src_displacements, &
571 dst_displacements) &
572 result(xmap_spread)
573 IMPLICIT NONE
574 TYPE(xt_xmap), INTENT(in) :: xmap
575 INTEGER(i2), INTENT(in) :: num_repetitions
576 INTEGER, INTENT(in) :: src_displacements(num_repetitions)
577 INTEGER, INTENT(in) :: dst_displacements(num_repetitions)
578 TYPE(xt_xmap) :: xmap_spread
579 INTEGER(i8) :: num_repetitions_i8
580 num_repetitions_i8 = int(num_repetitions, i8)
581 xmap_spread = &
583 xmap, num_repetitions_i8, src_displacements, dst_displacements);
584 END FUNCTION xt_xmap_spread_i2_a1d
585
586 FUNCTION xt_xmap_spread_i4_a1d(xmap, num_repetitions, src_displacements, &
587 dst_displacements) &
588 result(xmap_spread)
589 IMPLICIT NONE
590 TYPE(xt_xmap), INTENT(in) :: xmap
591 INTEGER(i4), INTENT(in) :: num_repetitions
592 INTEGER, INTENT(in) :: src_displacements(num_repetitions)
593 INTEGER, INTENT(in) :: dst_displacements(num_repetitions)
594 TYPE(xt_xmap) :: xmap_spread
595 INTEGER(i8) :: num_repetitions_i8
596 num_repetitions_i8 = int(num_repetitions, i8)
597 xmap_spread = &
599 xmap, num_repetitions_i8, src_displacements, dst_displacements);
600 END FUNCTION xt_xmap_spread_i4_a1d
601
602 FUNCTION xt_xmap_spread_i8_a1d(xmap, num_repetitions, src_displacements, &
603 dst_displacements) &
604 result(xmap_spread)
605 IMPLICIT NONE
606 TYPE(xt_xmap), INTENT(in) :: xmap
607 INTEGER(i8), INTENT(in) :: num_repetitions
608 INTEGER, TARGET, INTENT(in) :: src_displacements(num_repetitions)
609 INTEGER, TARGET, INTENT(in) :: dst_displacements(num_repetitions)
610 INTEGER(c_int) :: num_repetitions_c
611 TYPE(xt_xmap) :: xmap_spread
612 INTEGER(c_int), TARGET, ALLOCATABLE :: &
613 src_displacements_c(:), dst_displacements_c(:)
614 TYPE(c_ptr) :: src_displacements_p, dst_displacements_p
615 INTERFACE
616 FUNCTION xt_xmap_spread_c(xmap, num_repetitions, src_displacements, &
617 dst_displacements) &
618 bind(c, name='xt_xmap_spread') result(xmap_spread_ptr)
619 import:: c_ptr, c_int
620 TYPE(c_ptr), VALUE, INTENT(in) :: &
621 xmap, src_displacements, dst_displacements
622 INTEGER(c_int), VALUE, INTENT(in) :: num_repetitions
623 TYPE(c_ptr) :: xmap_spread_ptr
624 END FUNCTION xt_xmap_spread_c
625 END INTERFACE
626 IF (num_repetitions < 0_c_int .OR. &
627 num_repetitions > huge(1_c_int)) &
628 CALL xt_abort("invalid number of extents", filename, __line__)
629 num_repetitions_c = int(num_repetitions, c_int)
630 IF (c_int == kind(1)) THEN
631 src_displacements_p = c_loc(src_displacements)
632 dst_displacements_p = c_loc(dst_displacements)
633 ELSE
634 CALL arg2ci(src_displacements, src_displacements_c)
635 src_displacements_p = c_loc(src_displacements_c)
636 CALL arg2ci(dst_displacements, dst_displacements_c)
637 dst_displacements_p = c_loc(dst_displacements_c)
638 END IF
639 xmap_spread%cptr = &
640 xt_xmap_spread_c( &
641 xmap%cptr, num_repetitions_c, src_displacements_p, dst_displacements_p)
642 CONTAINS
643 SUBROUTINE arg2ci(arg, argc)
644 INTEGER, INTENT(in) :: arg(*)
645 INTEGER(c_int), ALLOCATABLE, INTENT(inout) :: argc(:)
646 INTEGER :: i, n
647 n = int(num_repetitions)
648 ALLOCATE(argc(n))
649 DO i = 1, n
650 argc(i) = int(arg(i), c_int)
651 END DO
652 END SUBROUTINE arg2ci
653 END FUNCTION xt_xmap_spread_i8_a1d
654
655 FUNCTION xt_xmap_get_out_iterator(xmap) RESULT(iter)
656 TYPE(xt_xmap), INTENT(in) :: xmap
657 TYPE(xt_xmap_iter) :: iter
658 INTERFACE
659 FUNCTION xt_xmap_get_out_iterator_c(xmap) RESULT(cptr) &
660 bind(c, name='xt_xmap_get_out_iterator')
661 IMPORT :: c_ptr
662 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
663 TYPE(c_ptr) :: cptr
664 END FUNCTION xt_xmap_get_out_iterator_c
665 END INTERFACE
666 iter%cptr = xt_xmap_get_out_iterator_c(xmap%cptr)
667 END FUNCTION xt_xmap_get_out_iterator
668
669 FUNCTION xt_xmap_get_in_iterator(xmap) RESULT(iter)
670 TYPE(xt_xmap), INTENT(in) :: xmap
671 TYPE(xt_xmap_iter) :: iter
672 INTERFACE
673 FUNCTION xt_xmap_get_in_iterator_c(xmap) RESULT(cptr) &
674 bind(c, name='xt_xmap_get_in_iterator')
675 IMPORT :: c_ptr
676 TYPE(c_ptr), VALUE, INTENT(in) :: xmap
677 TYPE(c_ptr) :: cptr
678 END FUNCTION xt_xmap_get_in_iterator_c
679 END INTERFACE
680 iter%cptr = xt_xmap_get_in_iterator_c(xmap%cptr)
681 END FUNCTION xt_xmap_get_in_iterator
682
683 FUNCTION xt_xmap_iterator_is_null(iter) RESULT(p)
684 TYPE(xt_xmap_iter), INTENT(in) :: iter
685 LOGICAL :: p
686 p = .NOT. c_associated(iter%cptr)
687 END FUNCTION xt_xmap_iterator_is_null
688
689 FUNCTION xt_xmap_iterator_next(iter) RESULT(avail)
690 TYPE(xt_xmap_iter), INTENT(inout) :: iter
691 LOGICAL :: avail
692 INTERFACE
693 FUNCTION xt_xmap_iterator_next_c(iter) RESULT(avail) &
694 bind(c, name='xt_xmap_iterator_next')
695 IMPORT :: c_ptr, c_int
696 TYPE(c_ptr), VALUE, INTENT(in) :: iter
697 INTEGER(c_int) :: avail
698 END FUNCTION xt_xmap_iterator_next_c
699 END INTERFACE
700 avail = xt_xmap_iterator_next_c(iter%cptr) /= 0
701 END FUNCTION xt_xmap_iterator_next
702
703 FUNCTION xt_xmap_iterator_get_rank(iter) RESULT(rank)
704 TYPE(xt_xmap_iter), INTENT(in) :: iter
705 INTEGER :: rank
706 INTERFACE
707 FUNCTION xt_xmap_iterator_get_rank_c(iter) RESULT(rank) &
708 bind(c, name='xt_xmap_iterator_get_rank')
709 IMPORT :: c_ptr, c_int
710 TYPE(c_ptr), VALUE, INTENT(in) :: iter
711 INTEGER(c_int) :: rank
712 END FUNCTION xt_xmap_iterator_get_rank_c
713 END INTERFACE
714 rank = int(xt_xmap_iterator_get_rank_c(iter%cptr))
715 END FUNCTION xt_xmap_iterator_get_rank
716
718 FUNCTION xt_xmap_iterator_get_transfer_pos(iter) RESULT(transfer_pos)
719 TYPE(xt_xmap_iter), INTENT(in) :: iter
720 INTEGER(c_int), POINTER :: transfer_pos(:)
721
722 INTERFACE
723 FUNCTION xt_xmap_iterator_get_transfer_pos_c(iter) RESULT(transfer_pos) &
724 bind(c, name='xt_xmap_iterator_get_transfer_pos')
725 IMPORT :: c_ptr
726 TYPE(c_ptr), VALUE, INTENT(in) :: iter
727 TYPE(c_ptr) :: transfer_pos
728 END FUNCTION xt_xmap_iterator_get_transfer_pos_c
729 END INTERFACE
730 INTEGER :: n(1)
731 TYPE(c_ptr) :: transfer_pos_cptr
732 NULLIFY(transfer_pos)
733 n(1) = int(xt_xmap_iterator_get_num_transfer_pos_c(iter%cptr))
734 transfer_pos_cptr = xt_xmap_iterator_get_transfer_pos_c(iter%cptr)
735 CALL c_f_pointer(transfer_pos_cptr, transfer_pos, n)
737
738 FUNCTION xt_xmap_iterator_get_num_transfer_pos(iter) RESULT(num)
739 TYPE(xt_xmap_iter), INTENT(in) :: iter
740 INTEGER :: num
741 num = int(xt_xmap_iterator_get_num_transfer_pos_c(iter%cptr))
743
745 FUNCTION xt_xmap_iterator_get_transfer_pos_ext(iter) RESULT(transfer_pos_ext)
746 TYPE(xt_xmap_iter), INTENT(in) :: iter
747 TYPE(xt_pos_ext), POINTER :: transfer_pos_ext(:)
748
749 INTERFACE
750 FUNCTION xt_xmap_iterator_get_transfer_pos_ext_c(iter) &
751 result(transfer_pos_ext) &
752 bind(c, name='xt_xmap_iterator_get_transfer_pos_ext')
753 IMPORT :: c_ptr
754 TYPE(c_ptr), VALUE, INTENT(in) :: iter
755 TYPE(c_ptr) :: transfer_pos_ext
756 END FUNCTION xt_xmap_iterator_get_transfer_pos_ext_c
757 END INTERFACE
758 INTEGER :: n(1)
759 TYPE(c_ptr) :: transfer_pos_ext_cptr
760 NULLIFY(transfer_pos_ext)
761 n(1) = int(xt_xmap_iterator_get_num_transfer_pos_ext_c(iter%cptr))
762 transfer_pos_ext_cptr = xt_xmap_iterator_get_transfer_pos_ext_c(iter%cptr)
763 CALL c_f_pointer(transfer_pos_ext_cptr, transfer_pos_ext, n)
765
766 FUNCTION xt_xmap_iterator_get_num_transfer_pos_ext(iter) RESULT(num)
767 TYPE(xt_xmap_iter), INTENT(in) :: iter
768 INTEGER :: num
769 num = int(xt_xmap_iterator_get_num_transfer_pos_ext_c(iter%cptr))
771
772 SUBROUTINE xt_xmap_iterator_delete(iter)
773 TYPE(xt_xmap_iter), INTENT(inout) :: iter
774 INTERFACE
775 SUBROUTINE xt_xmap_iterator_delete_c(iter) &
776 bind(c, name='xt_xmap_iterator_delete')
777 IMPORT :: c_ptr
778 TYPE(c_ptr), VALUE, INTENT(in) :: iter
779 END SUBROUTINE xt_xmap_iterator_delete_c
780 END INTERFACE
781 CALL xt_xmap_iterator_delete_c(iter%cptr)
782 iter%cptr = c_null_ptr
783 END SUBROUTINE xt_xmap_iterator_delete
784END MODULE xt_xmap_abstract
785
787 USE xt_xmap_abstract, ONLY: xt_xmap_all2all_orig_new => xt_xmap_all2all_new, &
789 xt_xmap_dist_dir_orig_new => xt_xmap_dist_dir_new, &
791 xt_xmap_dist_dir_intercomm_orig_new => xt_xmap_dist_dir_intercomm_new, &
793 IMPLICIT NONE
794 PRIVATE
796 MODULE PROCEDURE xt_xmap_all2all_orig_new
797 MODULE PROCEDURE xt_xmap_all2all_custom_new
798 END INTERFACE xt_xmap_all2all_new
799 PUBLIC :: xt_xmap_all2all_new
801 MODULE PROCEDURE xt_xmap_dist_dir_orig_new
802 MODULE PROCEDURE xt_xmap_dist_dir_custom_new
803 END INTERFACE xt_xmap_dist_dir_new
804 PUBLIC :: xt_xmap_dist_dir_new
806 MODULE PROCEDURE xt_xmap_dist_dir_intercomm_orig_new
810END MODULE xt_xmap_rename
811!
812! Local Variables:
813! f90-continuation-indent: 5
814! coding: utf-8
815! indent-tabs-mode: nil
816! show-trailing-whitespace: t
817! require-trailing-newline: t
818! End:
819!
describes range of positions starting with start up to start + size - 1 i.e. [start,...
Definition xt_core_f.f90:94
Xt_xmap xt_xmap_update_positions(Xt_xmap xmap, const int *src_positions, const int *dst_positions)
Definition xt_xmap.c:154
int xt_xmap_iterator_next(Xt_xmap_iter iter)
Definition xt_xmap.c:101
Xt_xmap xt_xmap_reorder(Xt_xmap xmap, enum xt_reorder_type type)
Definition xt_xmap.c:143
void xt_xmap_delete(Xt_xmap xmap)
Definition xt_xmap.c:86
Xt_xmap_iter xt_xmap_get_out_iterator(Xt_xmap xmap)
Definition xt_xmap.c:96
int xt_xmap_iterator_get_num_transfer_pos_ext(Xt_xmap_iter iter)
Definition xt_xmap.c:126
Xt_xmap xt_xmap_spread(Xt_xmap xmap, int num_repetitions, const int src_displacements[num_repetitions], const int dst_displacements[num_repetitions])
Definition xt_xmap.c:159
void xt_xmap_iterator_delete(Xt_xmap_iter iter)
Definition xt_xmap.c:130
int xt_xmap_get_num_destinations(Xt_xmap xmap)
Definition xt_xmap.c:61
Xt_xmap xt_xmap_copy(Xt_xmap xmap)
Definition xt_xmap.c:81
int xt_xmap_iterator_get_rank(Xt_xmap_iter iter)
Definition xt_xmap.c:106
int xt_xmap_get_max_dst_pos(Xt_xmap xmap)
Definition xt_xmap.c:139
int xt_xmap_get_num_sources(Xt_xmap xmap)
Definition xt_xmap.c:66
const struct Xt_pos_ext * xt_xmap_iterator_get_transfer_pos_ext(Xt_xmap_iter iter)
Definition xt_xmap.c:122
void xt_xmap_get_source_ranks(Xt_xmap xmap, int *ranks)
Definition xt_xmap.c:76
Xt_xmap xt_xmap_reorder_custom(Xt_xmap xmap, enum xt_reorder_type type, Xt_config config)
Definition xt_xmap.c:148
Xt_xmap_iter xt_xmap_get_in_iterator(Xt_xmap xmap)
Definition xt_xmap.c:91
void xt_xmap_get_destination_ranks(Xt_xmap xmap, int *ranks)
Definition xt_xmap.c:71
int const * xt_xmap_iterator_get_transfer_pos(Xt_xmap_iter iter)
Definition xt_xmap.c:111
int xt_xmap_get_max_src_pos(Xt_xmap xmap)
Definition xt_xmap.c:135
int xt_xmap_iterator_get_num_transfer_pos(Xt_xmap_iter iter)
Definition xt_xmap.c:116
Xt_xmap xt_xmap_all2all_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)
Xt_xmap xt_xmap_all2all_custom_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm, Xt_config config)
Xt_xmap xt_xmap_dist_dir_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)
Xt_xmap xt_xmap_dist_dir_custom_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm, Xt_config config)
Xt_xmap xt_xmap_dist_dir_intercomm_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm inter_comm, MPI_Comm intra_comm)
Xt_xmap xt_xmap_dist_dir_intercomm_custom_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm inter_comm, MPI_Comm intra_comm, Xt_config config)
PPM_DSO_INTERNAL Xt_xmap xt_xmap_dist_dir_intercomm_new_f(struct xt_idxlist_f *src_idxlist_f, struct xt_idxlist_f *dst_idxlist_f, MPI_Fint inter_comm_f, MPI_Fint intra_comm_f)
Definition yaxt_f2c.c:281
PPM_DSO_INTERNAL Xt_xmap xt_xmap_dist_dir_new_f(struct xt_idxlist_f *src_idxlist_f, struct xt_idxlist_f *dst_idxlist_f, MPI_Fint comm_f)
Definition yaxt_f2c.c:263
PPM_DSO_INTERNAL Xt_xmap xt_xmap_dist_dir_intercomm_custom_new_f(struct xt_idxlist_f *src_idxlist_f, struct xt_idxlist_f *dst_idxlist_f, MPI_Fint inter_comm_f, MPI_Fint intra_comm_f, struct xt_config_f *config_f)
Definition yaxt_f2c.c:292
PPM_DSO_INTERNAL Xt_xmap xt_xmap_dist_dir_custom_new_f(struct xt_idxlist_f *src_idxlist_f, struct xt_idxlist_f *dst_idxlist_f, MPI_Fint comm_f, struct xt_config_f *config_f)
Definition yaxt_f2c.c:271
PPM_DSO_INTERNAL Xt_xmap xt_xmap_all2all_custom_new_f(struct xt_idxlist_f *src_idxlist_f, struct xt_idxlist_f *dst_idxlist_f, MPI_Fint comm_f, struct xt_config_f *config_f)
Definition yaxt_f2c.c:253
Xt_xmap xt_xmap_f2c(struct xt_xmap_f *p)
Definition yaxt_f2c.c:200
Xt_config xt_config_f2c(struct xt_config_f *p)
Definition yaxt_f2c.c:190