Yet Another eXchange Tool  0.9.0
xt_xmap_f.f90
Go to the documentation of this file.
1 
13 
14 !
15 ! Keywords:
16 ! Maintainer: Jörg Behrens <behrens@dkrz.de>
17 ! Moritz Hanke <hanke@dkrz.de>
18 ! Thomas Jahns <jahns@dkrz.de>
19 ! URL: https://doc.redmine.dkrz.de/yaxt/html/
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 !
49  USE iso_c_binding, ONLY: c_int, c_ptr, c_null_ptr, &
50  c_associated, c_f_pointer, c_loc
51  USE xt_core, ONLY: xt_abort, xt_mpi_fint_kind, xt_pos_ext, i2, i4, i8
53  IMPLICIT NONE
54  PRIVATE
55  PUBLIC :: xt_xmap_c2f, xt_xmap_f2c, xt_is_null
71 
72 
73  ! note: this type must not be extended to contain any other
74  ! components, its memory pattern has to match void * exactly, which
75  ! it does because of C constraints
76  TYPE, BIND(C), PUBLIC :: xt_xmap
77 #ifndef __G95__
78  PRIVATE
79 #endif
80  TYPE(c_ptr) :: cptr = c_null_ptr
81  END TYPE xt_xmap
82 
83  TYPE, BIND(c), PUBLIC :: xt_xmap_iter
84 #ifndef __G95__
85  PRIVATE
86 #endif
87  TYPE(c_ptr) :: cptr = c_null_ptr
88  END TYPE xt_xmap_iter
89 
90  ENUM, BIND( C )
92  END ENUM
93  INTEGER, PARAMETER :: xt_reorder_type_kind = kind(xt_reorder_none)
94 
95  INTERFACE
96  ! this function must not be implemented in Fortran because
97  ! PGI 11.x chokes on that
98  FUNCTION xt_xmap_f2c(xmap) bind(c, name='xt_xmap_f2c') RESULT(p)
99  IMPORT :: c_ptr, xt_xmap
100  IMPLICIT NONE
101  TYPE(xt_xmap), INTENT(in) :: xmap
102  TYPE(c_ptr) :: p
103  END FUNCTION xt_xmap_f2c
104 
105  SUBROUTINE xt_xmap_delete_c(xmap) bind(C, name='xt_xmap_delete')
106  IMPORT :: c_ptr
107  IMPLICIT NONE
108  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
109  END SUBROUTINE xt_xmap_delete_c
110 
111  END INTERFACE
112 
113  INTERFACE xt_xmap_delete
114  MODULE PROCEDURE xt_xmap_delete_1
115  MODULE PROCEDURE xt_xmap_delete_a1d
116  END INTERFACE xt_xmap_delete
117 
118  INTERFACE xt_is_null
119  MODULE PROCEDURE xt_xmap_is_null
120  MODULE PROCEDURE xt_xmap_iterator_is_null
121  END INTERFACE xt_is_null
122 
123  INTERFACE
124  FUNCTION xt_xmap_iterator_get_num_transfer_pos_c(iter) RESULT(num) &
125  bind(c, name='xt_xmap_iterator_get_num_transfer_pos')
126  IMPORT :: c_int, c_ptr
127  TYPE(c_ptr), VALUE, INTENT(in) :: iter
128  INTEGER(c_int) :: num
129  END FUNCTION xt_xmap_iterator_get_num_transfer_pos_c
130 
131  FUNCTION xt_xmap_iterator_get_num_transfer_pos_ext_c(iter) RESULT(num) &
132  bind(c, name='xt_xmap_iterator_get_num_transfer_pos_ext')
133  IMPORT :: c_int, c_ptr
134  TYPE(c_ptr), VALUE, INTENT(in) :: iter
135  INTEGER(c_int) :: num
136  END FUNCTION xt_xmap_iterator_get_num_transfer_pos_ext_c
137  END INTERFACE
138 
139  INTERFACE xt_xmap_spread
140  MODULE PROCEDURE xt_xmap_spread_a1d
141  MODULE PROCEDURE xt_xmap_spread_i2_a1d
142  MODULE PROCEDURE xt_xmap_spread_i4_a1d
143  MODULE PROCEDURE xt_xmap_spread_i8_a1d
144  END INTERFACE xt_xmap_spread
145 
146  CHARACTER(len=*), PARAMETER :: filename = 'xt_xmap_f.f90'
147 CONTAINS
148 
149  FUNCTION xt_xmap_is_null(xmap) RESULT(p)
150  TYPE(xt_xmap), INTENT(in) :: xmap
151  LOGICAL :: p
152  p = .NOT. c_associated(xmap%cptr)
153  END FUNCTION xt_xmap_is_null
154 
155 
156  FUNCTION xt_xmap_c2f(xmap) RESULT(p)
157  TYPE(c_ptr), INTENT(in) :: xmap
158  TYPE(xt_xmap) :: p
159  p%cptr = xmap
160  END FUNCTION xt_xmap_c2f
161 
162  FUNCTION xt_xmap_copy(xmap) RESULT(xmap_copy)
163  TYPE(xt_xmap), INTENT(in) :: xmap
164  TYPE(xt_xmap) :: xmap_copy
165  INTERFACE
166  FUNCTION xt_xmap_copy_c(xmap) bind(C, name='xt_xmap_copy') RESULT(res_ptr)
167  IMPORT :: xt_xmap, c_ptr
168  IMPLICIT NONE
169  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
170  TYPE(c_ptr) :: res_ptr
171  END FUNCTION xt_xmap_copy_c
172  END INTERFACE
173  xmap_copy%cptr = xt_xmap_copy_c(xmap%cptr)
174  END FUNCTION xt_xmap_copy
175  SUBROUTINE xt_xmap_delete_1(xmap)
176  TYPE(xt_xmap), INTENT(inout) :: xmap
177  CALL xt_xmap_delete_c(xt_xmap_f2c(xmap))
178  xmap%cptr = c_null_ptr
179  END SUBROUTINE xt_xmap_delete_1
180 
181  SUBROUTINE xt_xmap_delete_a1d(xmaps)
182  TYPE(xt_xmap), INTENT(inout) :: xmaps(:)
183  INTEGER :: i, n
184  n = SIZE(xmaps)
185  DO i = 1, n
186  CALL xt_xmap_delete_c(xt_xmap_f2c(xmaps(i)))
187  xmaps(i)%cptr = c_null_ptr
188  END DO
189  END SUBROUTINE xt_xmap_delete_a1d
190 
191  FUNCTION xt_xmap_all2all_new(src_idxlist, dst_idxlist, comm) RESULT(xmap)
192  IMPLICIT NONE
193  TYPE(xt_idxlist), INTENT(in) :: src_idxlist
194  TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
195  INTEGER, VALUE, INTENT(in) :: comm
196  TYPE(xt_xmap) :: xmap
197 
198  INTERFACE
199  FUNCTION xt_xmap_all2all_new_f(src_idxlist, dst_idxlist, comm) &
200  bind(c, name='xt_xmap_all2all_new_f') result(xmap_ptr)
201  IMPORT :: xt_idxlist, xt_xmap, xt_mpi_fint_kind, c_ptr
202  IMPLICIT NONE
203  TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
204  INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: comm
205  TYPE(c_ptr) :: xmap_ptr
206  END FUNCTION xt_xmap_all2all_new_f
207  END INTERFACE
208 
209  xmap = xt_xmap_c2f(xt_xmap_all2all_new_f(src_idxlist, dst_idxlist, comm))
210  END FUNCTION xt_xmap_all2all_new
211 
212  FUNCTION xt_xmap_dist_dir_new(src_idxlist, dst_idxlist, comm) RESULT(xmap)
213  IMPLICIT NONE
214  TYPE(xt_idxlist), INTENT(in) :: src_idxlist
215  TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
216  INTEGER, VALUE, INTENT(in) :: comm
217  TYPE(xt_xmap) :: xmap
218 
219  INTERFACE
220  FUNCTION xt_xmap_dist_dir_new_f(src_idxlist, dst_idxlist, comm) &
221  bind(c, name='xt_xmap_dist_dir_new_f') result(xmap_ptr)
222  IMPORT :: xt_idxlist, xt_xmap, xt_mpi_fint_kind, c_ptr
223  IMPLICIT NONE
224  TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
225  INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: comm
226  TYPE(c_ptr) :: xmap_ptr
227  END FUNCTION xt_xmap_dist_dir_new_f
228  END INTERFACE
229 
230  xmap = xt_xmap_c2f(xt_xmap_dist_dir_new_f(src_idxlist, dst_idxlist, comm))
231  END FUNCTION xt_xmap_dist_dir_new
232 
233  FUNCTION xt_xmap_dist_dir_intercomm_new(src_idxlist, dst_idxlist, &
234  inter_comm, intra_comm) RESULT(xmap)
235  IMPLICIT NONE
236  TYPE(xt_idxlist), INTENT(in) :: src_idxlist
237  TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
238  INTEGER, VALUE, INTENT(in) :: inter_comm, intra_comm
239  TYPE(xt_xmap) :: xmap
240 
241  INTERFACE
242  FUNCTION xt_xmap_dist_dir_intercomm_new_f(src_idxlist, dst_idxlist, &
243  inter_comm, intra_comm) &
244  bind(c, name='xt_xmap_dist_dir_intercomm_new_f') result(xmap_ptr)
245  IMPORT :: xt_idxlist, xt_xmap, xt_mpi_fint_kind, c_ptr
246  IMPLICIT NONE
247  TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
248  INTEGER(xt_mpi_fint_kind), VALUE, INTENT(in) :: inter_comm, intra_comm
249  TYPE(c_ptr) :: xmap_ptr
251  END INTERFACE
252 
253  xmap = xt_xmap_c2f(xt_xmap_dist_dir_intercomm_new_f(src_idxlist, &
254  dst_idxlist, inter_comm, intra_comm))
255  END FUNCTION xt_xmap_dist_dir_intercomm_new
256 
257  FUNCTION xt_xmap_get_num_destinations(xmap) RESULT(num)
258  TYPE(xt_xmap), INTENT(in) :: xmap
259  INTEGER :: num
260  INTERFACE
261  FUNCTION xt_xmap_get_num_destinations_c(xmap) RESULT(num) &
262  bind(c, name='xt_xmap_get_num_destinations')
263  IMPORT :: c_ptr, c_int
264  IMPLICIT NONE
265  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
266  INTEGER(c_int) :: num
267  END FUNCTION xt_xmap_get_num_destinations_c
268  END INTERFACE
269  num = int(xt_xmap_get_num_destinations_c(xmap%cptr))
270  END FUNCTION xt_xmap_get_num_destinations
271 
272  FUNCTION xt_xmap_get_num_sources(xmap) RESULT(num)
273  TYPE(xt_xmap), INTENT(in) :: xmap
274  INTEGER :: num
275  INTERFACE
276  FUNCTION xt_xmap_get_num_sources_c(xmap) RESULT(num) &
277  bind(c, name='xt_xmap_get_num_sources')
278  IMPORT :: c_ptr, c_int
279  IMPLICIT NONE
280  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
281  INTEGER(c_int) :: num
282  END FUNCTION xt_xmap_get_num_sources_c
283  END INTERFACE
284  num = int(xt_xmap_get_num_sources_c(xmap%cptr))
285  END FUNCTION xt_xmap_get_num_sources
286 
287  SUBROUTINE xt_xmap_get_destination_ranks(xmap, ranks)
288  TYPE(xt_xmap), INTENT(in) :: xmap
289  INTEGER(c_int), INTENT(out) :: ranks(*)
290  INTERFACE
291  SUBROUTINE xt_xmap_get_destination_ranks_c(xmap, ranks) &
292  bind(c, name='xt_xmap_get_destination_ranks')
293  IMPORT :: c_ptr, c_int
294  IMPLICIT NONE
295  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
296  INTEGER(c_int), INTENT(out) :: ranks(*)
297  END SUBROUTINE xt_xmap_get_destination_ranks_c
298  END INTERFACE
299  CALL xt_xmap_get_destination_ranks_c(xmap%cptr, ranks)
300  END SUBROUTINE xt_xmap_get_destination_ranks
301 
302  SUBROUTINE xt_xmap_get_source_ranks(xmap, ranks)
303  TYPE(xt_xmap), INTENT(in) :: xmap
304  INTEGER(c_int), INTENT(out) :: ranks(*)
305  INTERFACE
306  SUBROUTINE xt_xmap_get_source_ranks_c(xmap, ranks) &
307  bind(c, name='xt_xmap_get_source_ranks')
308  IMPORT :: c_ptr, c_int
309  IMPLICIT NONE
310  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
311  INTEGER(c_int), INTENT(out) :: ranks(*)
312  END SUBROUTINE xt_xmap_get_source_ranks_c
313  END INTERFACE
314  CALL xt_xmap_get_source_ranks_c(xmap%cptr, ranks)
315  END SUBROUTINE xt_xmap_get_source_ranks
316 
317  FUNCTION xt_xmap_get_max_src_pos(xmap) RESULT(num)
318  TYPE(xt_xmap), INTENT(in) :: xmap
319  INTEGER :: num
320  INTERFACE
321  FUNCTION xt_xmap_get_max_src_pos_c(xmap) RESULT(num) &
322  bind(c, name='xt_xmap_get_max_src_pos')
323  IMPORT :: c_ptr, c_int
324  IMPLICIT NONE
325  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
326  INTEGER(c_int) :: num
327  END FUNCTION xt_xmap_get_max_src_pos_c
328  END INTERFACE
329  num = int(xt_xmap_get_max_src_pos_c(xmap%cptr))
330  END FUNCTION xt_xmap_get_max_src_pos
331 
332  FUNCTION xt_xmap_get_max_dst_pos(xmap) RESULT(num)
333  TYPE(xt_xmap), INTENT(in) :: xmap
334  INTEGER :: num
335  INTERFACE
336  FUNCTION xt_xmap_get_max_dst_pos_c(xmap) RESULT(num) &
337  bind(c, name='xt_xmap_get_max_dst_pos')
338  IMPORT :: c_ptr, c_int
339  IMPLICIT NONE
340  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
341  INTEGER(c_int) :: num
342  END FUNCTION xt_xmap_get_max_dst_pos_c
343  END INTERFACE
344  num = int(xt_xmap_get_max_dst_pos_c(xmap%cptr))
345  END FUNCTION xt_xmap_get_max_dst_pos
346 
347  FUNCTION xt_xmap_reorder(xmap, reorder_type) RESULT(xmap_reorder)
348  IMPLICIT NONE
349  TYPE(xt_xmap), INTENT(in) :: xmap
350  INTEGER(xt_reorder_type_kind), INTENT(in) :: reorder_type
351  TYPE(xt_xmap) :: xmap_reorder
352  INTERFACE
353  FUNCTION xt_xmap_reorder_c(xmap, reorder_type) &
354  bind(c, name='xt_xmap_reorder') result(xmap_reorder_ptr)
355  import:: xt_reorder_type_kind, c_ptr
356  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
357  INTEGER(xt_reorder_type_kind), VALUE, INTENT(in) :: reorder_type
358  TYPE(c_ptr) :: xmap_reorder_ptr
359  END FUNCTION xt_xmap_reorder_c
360  END INTERFACE
361 
362  IF (reorder_type < 0_xt_reorder_type_kind .OR. &
363  reorder_type > huge(1_c_int)) &
364  CALL xt_abort("invalid reorder type", filename, __line__)
365  xmap_reorder%cptr = xt_xmap_reorder_c(xmap%cptr, reorder_type)
366  END FUNCTION xt_xmap_reorder
367 
368  FUNCTION xt_xmap_update_positions(xmap, src_positions, dst_positions) &
369  result(xmap_updated)
370  IMPLICIT NONE
371  TYPE(xt_xmap), INTENT(in) :: xmap
372  INTEGER, TARGET, INTENT(in) :: src_positions(*)
373  INTEGER, TARGET, INTENT(in) :: dst_positions(*)
374  TYPE(xt_xmap) :: xmap_updated
375  INTEGER(c_int), TARGET, ALLOCATABLE :: src_positions_c(:), dst_positions_c(:)
376  TYPE(c_ptr) :: src_positions_p, dst_positions_p
377  INTERFACE
378  FUNCTION xt_xmap_update_positions_c(xmap, src_positions, dst_positions) &
379  bind(c, name='xt_xmap_update_positions') result(xmap_updated_ptr)
380  import:: c_ptr
381  TYPE(c_ptr), VALUE, INTENT(in) :: xmap, src_positions, dst_positions
382  TYPE(c_ptr) :: xmap_updated_ptr
383  END FUNCTION xt_xmap_update_positions_c
384  END INTERFACE
385 
386  IF (c_int == kind(1)) THEN
387  src_positions_p = c_loc(src_positions)
388  dst_positions_p = c_loc(dst_positions)
389  ELSE
390  CALL arg2ci(xt_xmap_get_max_src_pos(xmap), src_positions, src_positions_c)
391  src_positions_p = c_loc(src_positions_c)
392  CALL arg2ci(xt_xmap_get_max_dst_pos(xmap), dst_positions, dst_positions_c)
393  dst_positions_p = c_loc(dst_positions_c)
394  END IF
395  xmap_updated%cptr = &
396  xt_xmap_update_positions_c(xmap%cptr, src_positions_p, dst_positions_p)
397  CONTAINS
398  SUBROUTINE arg2ci(n, arg, argc)
399  INTEGER, INTENT(in) :: n, arg(*)
400  INTEGER(c_int), ALLOCATABLE, INTENT(inout) :: argc(:)
401  INTEGER :: i
402  ALLOCATE(argc(n))
403  DO i = 1, n
404  argc(i) = int(arg(i), c_int)
405  END DO
406  END SUBROUTINE arg2ci
407  END FUNCTION xt_xmap_update_positions
408 
409  FUNCTION xt_xmap_spread_a1d(xmap, src_displacements, dst_displacements) &
410  result(xmap_spread)
411  IMPLICIT NONE
412  TYPE(xt_xmap), INTENT(in) :: xmap
413  INTEGER, INTENT(in) :: src_displacements(:)
414  INTEGER, INTENT(in) :: dst_displacements(:)
415  TYPE(xt_xmap) :: xmap_spread
416  INTEGER :: num_repetitions
417  INTEGER(i8) :: num_repetitions_i8
418  num_repetitions = SIZE(src_displacements)
419  IF (num_repetitions /= SIZE(dst_displacements)) &
420  CALL xt_abort("invalid number of repetitions", filename, __line__)
421  num_repetitions_i8 = int(num_repetitions, i8)
422  xmap_spread = &
423  xt_xmap_spread( &
424  xmap, num_repetitions_i8, src_displacements, dst_displacements);
425  END FUNCTION xt_xmap_spread_a1d
426 
427  FUNCTION xt_xmap_spread_i2_a1d(xmap, num_repetitions, src_displacements, &
428  dst_displacements) &
429  result(xmap_spread)
430  IMPLICIT NONE
431  TYPE(xt_xmap), INTENT(in) :: xmap
432  INTEGER(i2), INTENT(in) :: num_repetitions
433  INTEGER, INTENT(in) :: src_displacements(num_repetitions)
434  INTEGER, INTENT(in) :: dst_displacements(num_repetitions)
435  TYPE(xt_xmap) :: xmap_spread
436  INTEGER(i8) :: num_repetitions_i8
437  num_repetitions_i8 = int(num_repetitions, i8)
438  xmap_spread = &
439  xt_xmap_spread( &
440  xmap, num_repetitions_i8, src_displacements, dst_displacements);
441  END FUNCTION xt_xmap_spread_i2_a1d
442 
443  FUNCTION xt_xmap_spread_i4_a1d(xmap, num_repetitions, src_displacements, &
444  dst_displacements) &
445  result(xmap_spread)
446  IMPLICIT NONE
447  TYPE(xt_xmap), INTENT(in) :: xmap
448  INTEGER(i4), INTENT(in) :: num_repetitions
449  INTEGER, INTENT(in) :: src_displacements(num_repetitions)
450  INTEGER, INTENT(in) :: dst_displacements(num_repetitions)
451  TYPE(xt_xmap) :: xmap_spread
452  INTEGER(i8) :: num_repetitions_i8
453  num_repetitions_i8 = int(num_repetitions, i8)
454  xmap_spread = &
455  xt_xmap_spread( &
456  xmap, num_repetitions_i8, src_displacements, dst_displacements);
457  END FUNCTION xt_xmap_spread_i4_a1d
458 
459  FUNCTION xt_xmap_spread_i8_a1d(xmap, num_repetitions, src_displacements, &
460  dst_displacements) &
461  result(xmap_spread)
462  IMPLICIT NONE
463  TYPE(xt_xmap), INTENT(in) :: xmap
464  INTEGER(i8), INTENT(in) :: num_repetitions
465  INTEGER, TARGET, INTENT(in) :: src_displacements(num_repetitions)
466  INTEGER, TARGET, INTENT(in) :: dst_displacements(num_repetitions)
467  INTEGER(c_int) :: num_repetitions_c
468  TYPE(xt_xmap) :: xmap_spread
469  INTEGER(c_int), TARGET, ALLOCATABLE :: &
470  src_displacements_c(:), dst_displacements_c(:)
471  TYPE(c_ptr) :: src_displacements_p, dst_displacements_p
472  INTERFACE
473  FUNCTION xt_xmap_spread_c(xmap, num_repetitions, src_displacements, &
474  dst_displacements) &
475  bind(c, name='xt_xmap_spread') result(xmap_spread_ptr)
476  import:: c_ptr, c_int
477  TYPE(c_ptr), VALUE, INTENT(in) :: &
478  xmap, src_displacements, dst_displacements
479  INTEGER(c_int), VALUE, INTENT(in) :: num_repetitions
480  TYPE(c_ptr) :: xmap_spread_ptr
481  END FUNCTION xt_xmap_spread_c
482  END INTERFACE
483  IF (num_repetitions < 0_c_int .OR. &
484  num_repetitions > huge(1_c_int)) &
485  CALL xt_abort("invalid number of extents", filename, __line__)
486  num_repetitions_c = int(num_repetitions, c_int)
487  IF (c_int == kind(1)) THEN
488  src_displacements_p = c_loc(src_displacements)
489  dst_displacements_p = c_loc(dst_displacements)
490  ELSE
491  CALL arg2ci(src_displacements, src_displacements_c)
492  src_displacements_p = c_loc(src_displacements_c)
493  CALL arg2ci(dst_displacements, dst_displacements_c)
494  dst_displacements_p = c_loc(dst_displacements_c)
495  END IF
496  xmap_spread%cptr = &
497  xt_xmap_spread_c( &
498  xmap%cptr, num_repetitions_c, src_displacements_p, dst_displacements_p)
499  CONTAINS
500  SUBROUTINE arg2ci(arg, argc)
501  INTEGER, INTENT(in) :: arg(*)
502  INTEGER(c_int), ALLOCATABLE, INTENT(inout) :: argc(:)
503  INTEGER :: i, n
504  n = int(num_repetitions)
505  ALLOCATE(argc(n))
506  DO i = 1, n
507  argc(i) = int(arg(i), c_int)
508  END DO
509  END SUBROUTINE arg2ci
510  END FUNCTION xt_xmap_spread_i8_a1d
511 
512  FUNCTION xt_xmap_get_out_iterator(xmap) RESULT(iter)
513  TYPE(xt_xmap), INTENT(in) :: xmap
514  TYPE(xt_xmap_iter) :: iter
515  INTERFACE
516  FUNCTION xt_xmap_get_out_iterator_c(xmap) RESULT(cptr) &
517  bind(c, name='xt_xmap_get_out_iterator')
518  IMPORT :: c_ptr
519  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
520  TYPE(c_ptr) :: cptr
521  END FUNCTION xt_xmap_get_out_iterator_c
522  END INTERFACE
523  iter%cptr = xt_xmap_get_out_iterator_c(xmap%cptr)
524  END FUNCTION xt_xmap_get_out_iterator
525 
526  FUNCTION xt_xmap_get_in_iterator(xmap) RESULT(iter)
527  TYPE(xt_xmap), INTENT(in) :: xmap
528  TYPE(xt_xmap_iter) :: iter
529  INTERFACE
530  FUNCTION xt_xmap_get_in_iterator_c(xmap) RESULT(cptr) &
531  bind(c, name='xt_xmap_get_in_iterator')
532  IMPORT :: c_ptr
533  TYPE(c_ptr), VALUE, INTENT(in) :: xmap
534  TYPE(c_ptr) :: cptr
535  END FUNCTION xt_xmap_get_in_iterator_c
536  END INTERFACE
537  iter%cptr = xt_xmap_get_in_iterator_c(xmap%cptr)
538  END FUNCTION xt_xmap_get_in_iterator
539 
540  FUNCTION xt_xmap_iterator_is_null(iter) RESULT(p)
541  TYPE(xt_xmap_iter), INTENT(in) :: iter
542  LOGICAL :: p
543  p = .NOT. c_associated(iter%cptr)
544  END FUNCTION xt_xmap_iterator_is_null
545 
546  FUNCTION xt_xmap_iterator_next(iter) RESULT(avail)
547  TYPE(xt_xmap_iter), INTENT(inout) :: iter
548  LOGICAL :: avail
549  INTERFACE
550  FUNCTION xt_xmap_iterator_next_c(iter) RESULT(avail) &
551  bind(c, name='xt_xmap_iterator_next')
552  IMPORT :: c_ptr, c_int
553  TYPE(c_ptr), VALUE, INTENT(in) :: iter
554  INTEGER(c_int) :: avail
555  END FUNCTION xt_xmap_iterator_next_c
556  END INTERFACE
557  avail = xt_xmap_iterator_next_c(iter%cptr) /= 0
558  END FUNCTION xt_xmap_iterator_next
559 
560  FUNCTION xt_xmap_iterator_get_rank(iter) RESULT(rank)
561  TYPE(xt_xmap_iter), INTENT(in) :: iter
562  INTEGER :: rank
563  INTERFACE
564  FUNCTION xt_xmap_iterator_get_rank_c(iter) RESULT(rank) &
565  bind(c, name='xt_xmap_iterator_get_rank')
566  IMPORT :: c_ptr, c_int
567  TYPE(c_ptr), VALUE, INTENT(in) :: iter
568  INTEGER(c_int) :: rank
569  END FUNCTION xt_xmap_iterator_get_rank_c
570  END INTERFACE
571  rank = int(xt_xmap_iterator_get_rank_c(iter%cptr))
572  END FUNCTION xt_xmap_iterator_get_rank
573 
575  FUNCTION xt_xmap_iterator_get_transfer_pos(iter) RESULT(transfer_pos)
576  TYPE(xt_xmap_iter), INTENT(in) :: iter
577  INTEGER(c_int), POINTER :: transfer_pos(:)
578 
579  INTERFACE
580  FUNCTION xt_xmap_iterator_get_transfer_pos_c(iter) RESULT(transfer_pos) &
581  bind(c, name='xt_xmap_iterator_get_transfer_pos')
582  IMPORT :: c_ptr
583  TYPE(c_ptr), VALUE, INTENT(in) :: iter
584  TYPE(c_ptr) :: transfer_pos
585  END FUNCTION xt_xmap_iterator_get_transfer_pos_c
586  END INTERFACE
587  INTEGER :: n(1)
588  TYPE(c_ptr) :: transfer_pos_cptr
589  NULLIFY(transfer_pos)
590  n(1) = int(xt_xmap_iterator_get_num_transfer_pos_c(iter%cptr))
591  transfer_pos_cptr = xt_xmap_iterator_get_transfer_pos_c(iter%cptr)
592  CALL c_f_pointer(transfer_pos_cptr, transfer_pos, n)
594 
595  FUNCTION xt_xmap_iterator_get_num_transfer_pos(iter) RESULT(num)
596  TYPE(xt_xmap_iter), INTENT(in) :: iter
597  INTEGER :: num
598  num = int(xt_xmap_iterator_get_num_transfer_pos_c(iter%cptr))
600 
602  FUNCTION xt_xmap_iterator_get_transfer_pos_ext(iter) RESULT(transfer_pos_ext)
603  TYPE(xt_xmap_iter), INTENT(in) :: iter
604  TYPE(xt_pos_ext), POINTER :: transfer_pos_ext(:)
605 
606  INTERFACE
607  FUNCTION xt_xmap_iterator_get_transfer_pos_ext_c(iter) &
608  result(transfer_pos_ext) &
609  bind(c, name='xt_xmap_iterator_get_transfer_pos_ext')
610  IMPORT :: c_ptr
611  TYPE(c_ptr), VALUE, INTENT(in) :: iter
612  TYPE(c_ptr) :: transfer_pos_ext
613  END FUNCTION xt_xmap_iterator_get_transfer_pos_ext_c
614  END INTERFACE
615  INTEGER :: n(1)
616  TYPE(c_ptr) :: transfer_pos_ext_cptr
617  NULLIFY(transfer_pos_ext)
618  n(1) = int(xt_xmap_iterator_get_num_transfer_pos_ext_c(iter%cptr))
619  transfer_pos_ext_cptr = xt_xmap_iterator_get_transfer_pos_ext_c(iter%cptr)
620  CALL c_f_pointer(transfer_pos_ext_cptr, transfer_pos_ext, n)
622 
623  FUNCTION xt_xmap_iterator_get_num_transfer_pos_ext(iter) RESULT(num)
624  TYPE(xt_xmap_iter), INTENT(in) :: iter
625  INTEGER :: num
626  num = int(xt_xmap_iterator_get_num_transfer_pos_ext_c(iter%cptr))
628 
629  SUBROUTINE xt_xmap_iterator_delete(iter)
630  TYPE(xt_xmap_iter), INTENT(inout) :: iter
631  INTERFACE
632  SUBROUTINE xt_xmap_iterator_delete_c(iter) &
633  bind(c, name='xt_xmap_iterator_delete')
634  IMPORT :: c_ptr
635  TYPE(c_ptr), VALUE, INTENT(in) :: iter
636  END SUBROUTINE xt_xmap_iterator_delete_c
637  END INTERFACE
638  CALL xt_xmap_iterator_delete_c(iter%cptr)
639  iter%cptr = c_null_ptr
640  END SUBROUTINE xt_xmap_iterator_delete
641 END MODULE xt_xmap_abstract
642 !
643 ! Local Variables:
644 ! f90-continuation-indent: 5
645 ! coding: utf-8
646 ! indent-tabs-mode: nil
647 ! show-trailing-whitespace: t
648 ! require-trailing-newline: t
649 ! End:
650 !
integer, parameter, public i8
Definition: xt_core_f.f90:60
integer, parameter, public i4
Definition: xt_core_f.f90:59
integer, parameter, public i2
Definition: xt_core_f.f90:58
@, public xt_reorder_none
Definition: xt_xmap_f.f90:91
@, public xt_reorder_send_up
Definition: xt_xmap_f.f90:91
type(xt_xmap) function, public xt_xmap_c2f(xmap)
Definition: xt_xmap_f.f90:157
integer, parameter, public xt_reorder_type_kind
Definition: xt_xmap_f.f90:93
@, public xt_reorder_recv_up
Definition: xt_xmap_f.f90:91
describes range of positions starting with start up to start + size - 1 i.e. [start,...
Definition: xt_core_f.f90:91
Xt_xmap xt_xmap_update_positions(Xt_xmap xmap, const int *src_positions, const int *dst_positions)
Definition: xt_xmap.c:146
int xt_xmap_iterator_next(Xt_xmap_iter iter)
Definition: xt_xmap.c:100
Xt_xmap xt_xmap_reorder(Xt_xmap xmap, enum xt_reorder_type type)
Definition: xt_xmap.c:142
void xt_xmap_delete(Xt_xmap xmap)
Definition: xt_xmap.c:85
Xt_xmap_iter xt_xmap_get_out_iterator(Xt_xmap xmap)
Definition: xt_xmap.c:95
int xt_xmap_iterator_get_num_transfer_pos_ext(Xt_xmap_iter iter)
Definition: xt_xmap.c:125
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:151
int const * xt_xmap_iterator_get_transfer_pos(Xt_xmap_iter iter)
Definition: xt_xmap.c:110
void xt_xmap_iterator_delete(Xt_xmap_iter iter)
Definition: xt_xmap.c:129
int xt_xmap_get_num_destinations(Xt_xmap xmap)
Definition: xt_xmap.c:60
Xt_xmap xt_xmap_copy(Xt_xmap xmap)
Definition: xt_xmap.c:80
int xt_xmap_iterator_get_rank(Xt_xmap_iter iter)
Definition: xt_xmap.c:105
int xt_xmap_get_max_dst_pos(Xt_xmap xmap)
Definition: xt_xmap.c:138
int xt_xmap_get_num_sources(Xt_xmap xmap)
Definition: xt_xmap.c:65
void xt_xmap_get_source_ranks(Xt_xmap xmap, int *ranks)
Definition: xt_xmap.c:75
const struct Xt_pos_ext * xt_xmap_iterator_get_transfer_pos_ext(Xt_xmap_iter iter)
Definition: xt_xmap.c:121
Xt_xmap_iter xt_xmap_get_in_iterator(Xt_xmap xmap)
Definition: xt_xmap.c:90
void xt_xmap_get_destination_ranks(Xt_xmap xmap, int *ranks)
Definition: xt_xmap.c:70
int xt_xmap_get_max_src_pos(Xt_xmap xmap)
Definition: xt_xmap.c:134
int xt_xmap_iterator_get_num_transfer_pos(Xt_xmap_iter iter)
Definition: xt_xmap.c:115
Xt_xmap xt_xmap_all2all_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)
Xt_xmap xt_xmap_dist_dir_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)
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_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:231
Xt_xmap xt_xmap_f2c(struct xt_xmap_f *p)
Definition: yaxt_f2c.c:176
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:223