53 USE iso_c_binding,
ONLY: c_int, c_size_t, c_loc, c_null_ptr, c_ptr
54 USE xt_core,
ONLY: xt_abort, xt_mpi_fint_kind
57 #include "xt_slice_c_loc.inc"
61 TYPE,
BIND(c),
PUBLIC :: xt_com_list
63 INTEGER(c_int) :: rank
67 INTEGER,
POINTER :: transfer_pos(:)
71 TYPE,
BIND(c) :: xt_com_pos_c
72 TYPE(c_ptr) :: transfer_pos
73 INTEGER(c_int) :: num_transfer_pos
74 INTEGER(c_int) :: rank
81 FUNCTION xmi_new_f2c(num_src_intersections, src_com, &
82 num_dst_intersections, dst_com, &
83 src_idxlist, dst_idxlist, comm)
RESULT(xmap) &
84 bind(c, name=
'xt_xmap_intersection_new_f2c')
85 IMPORT :: c_int, c_ptr, xt_mpi_fint_kind
86 INTEGER(c_int),
VALUE,
INTENT(in) :: num_src_intersections, &
88 TYPE(c_ptr),
VALUE,
INTENT(in) :: src_com, dst_com, src_idxlist, &
90 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: comm
92 END FUNCTION xmi_new_f2c
94 FUNCTION xmi_ext_new_f2c(num_src_intersections, src_com, &
95 num_dst_intersections, dst_com, &
96 src_idxlist, dst_idxlist, comm)
RESULT(xmap) &
97 bind(c, name=
'xt_xmap_intersection_ext_new_f2c')
98 IMPORT :: c_int, c_ptr, xt_mpi_fint_kind
99 INTEGER(c_int),
VALUE,
INTENT(in) :: num_src_intersections, &
100 num_dst_intersections
101 TYPE(c_ptr),
VALUE,
INTENT(in) :: src_com, dst_com, src_idxlist, &
103 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: comm
105 END FUNCTION xmi_ext_new_f2c
107 FUNCTION xmi_pos_new_f2c(num_src_msg, src_com, num_dst_msg, dst_com, comm) &
109 bind(c, name=
'xt_xmap_intersection_pos_new_f2c')
110 IMPORT :: c_int, c_ptr, xt_mpi_fint_kind, xt_com_pos_c
111 INTEGER(c_int),
VALUE,
INTENT(in) :: num_src_msg, num_dst_msg
112 TYPE(xt_com_pos_c),
INTENT(in) :: src_com(*), dst_com(*)
113 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: comm
115 END FUNCTION xmi_pos_new_f2c
119 MODULE PROCEDURE xmi_new_i_a_i_a
120 MODULE PROCEDURE xmi_new_a_a
124 MODULE PROCEDURE xmi_ext_new_i_a_i_a
125 MODULE PROCEDURE xmi_ext_new_a_a
129 MODULE PROCEDURE xmi_pos_new_a_a
130 MODULE PROCEDURE xmi_pos_new_i_a_i_a
133 CHARACTER(len=*),
PARAMETER :: filename =
'xt_xmap_intersection_f.f90'
135 FUNCTION xmi_new_i_a_i_a(num_src_intersections, src_com, &
136 num_dst_intersections, dst_com, &
137 src_idxlist, dst_idxlist, comm)
RESULT(xmap)
138 INTEGER(c_int),
VALUE,
INTENT(in) :: num_src_intersections, &
139 num_dst_intersections
140 TYPE(
xt_com_list),
TARGET,
INTENT(in) :: src_com(num_src_intersections), &
141 dst_com(num_dst_intersections)
142 TYPE(xt_idxlist),
INTENT(in) :: src_idxlist, dst_idxlist
143 INTEGER,
INTENT(in) :: comm
144 TYPE(xt_xmap) :: xmap
145 TYPE(c_ptr) :: src_com_p, dst_com_p
147 src_com_p = c_loc(src_com)
148 dst_com_p = c_loc(dst_com)
149 xmap = xt_xmap_c2f(xmi_new_f2c(&
150 num_src_intersections, src_com_p, &
151 num_dst_intersections, dst_com_p, &
153 END FUNCTION xmi_new_i_a_i_a
155 FUNCTION xmi_new_a_a(src_com, dst_com, src_idxlist, dst_idxlist, comm) &
157 TYPE(
xt_com_list),
TARGET,
INTENT(in) :: src_com(:), dst_com(:)
158 TYPE(xt_idxlist),
INTENT(in) :: src_idxlist, dst_idxlist
159 INTEGER,
INTENT(in) :: comm
160 TYPE(xt_xmap) :: xmap
162 TYPE(
xt_com_list),
ALLOCATABLE,
TARGET :: src_com_a(:), dst_com_a(:)
163 TYPE(c_ptr) :: src_com_p, dst_com_p
164 INTEGER(c_int) :: num_src_intersections_c, num_dst_intersections_c
165 num_src_intersections_c = int(
SIZE(src_com), c_int)
166 num_dst_intersections_c = int(
SIZE(dst_com), c_int)
167 CALL com_p_arg(src_com, src_com_a, src_com_p)
168 CALL com_p_arg(dst_com, dst_com_a, dst_com_p)
170 xmap = xt_xmap_c2f(xmi_new_f2c(num_src_intersections_c, src_com_p, &
171 num_dst_intersections_c, dst_com_p, &
173 END FUNCTION xmi_new_a_a
175 FUNCTION xmi_ext_new_i_a_i_a(num_src_intersections, src_com, &
176 num_dst_intersections, dst_com, &
177 src_idxlist, dst_idxlist, comm)
RESULT(xmap)
178 INTEGER(c_int),
VALUE,
INTENT(in) :: num_src_intersections, &
179 num_dst_intersections
180 TYPE(
xt_com_list),
TARGET,
INTENT(in) :: src_com(num_src_intersections), &
181 dst_com(num_dst_intersections)
182 TYPE(xt_idxlist),
INTENT(in) :: src_idxlist, dst_idxlist
183 INTEGER,
INTENT(in) :: comm
184 TYPE(xt_xmap) :: xmap
185 INTEGER(c_int) :: num_src_intersections_c, num_dst_intersections_c
186 num_src_intersections_c = int(num_src_intersections, c_int)
187 num_dst_intersections_c = int(num_dst_intersections, c_int)
189 xmap = xt_xmap_c2f(xmi_ext_new_f2c(&
190 num_src_intersections_c, c_loc(src_com), &
191 num_dst_intersections_c, c_loc(dst_com), &
193 END FUNCTION xmi_ext_new_i_a_i_a
195 FUNCTION xmi_ext_new_a_a(src_com, dst_com, src_idxlist, dst_idxlist, comm) &
197 TYPE(
xt_com_list),
TARGET,
INTENT(in) :: src_com(:), dst_com(:)
198 TYPE(xt_idxlist),
INTENT(in) :: src_idxlist, dst_idxlist
199 INTEGER,
INTENT(in) :: comm
200 TYPE(xt_xmap) :: xmap
202 TYPE(
xt_com_list),
ALLOCATABLE,
TARGET :: src_com_a(:), dst_com_a(:)
203 TYPE(c_ptr) :: src_com_p, dst_com_p
204 INTEGER(c_int) :: num_src_intersections_c, num_dst_intersections_c
205 num_src_intersections_c = int(
SIZE(src_com), c_int)
206 num_dst_intersections_c = int(
SIZE(dst_com), c_int)
208 CALL com_p_arg(src_com, src_com_a, src_com_p)
209 CALL com_p_arg(dst_com, dst_com_a, dst_com_p)
211 xmap = xt_xmap_c2f(xmi_ext_new_f2c(&
212 num_src_intersections_c, src_com_p, &
213 num_dst_intersections_c, dst_com_p, &
215 END FUNCTION xmi_ext_new_a_a
217 FUNCTION xmi_pos_new_i_a_i_a( &
218 num_src_msg, src_com, num_dst_msg, dst_com, comm)
RESULT(xmap)
219 TYPE(
xt_com_pos),
TARGET,
INTENT(in) :: src_com(:), dst_com(:)
220 INTEGER,
INTENT(in) :: num_src_msg, num_dst_msg
221 INTEGER,
INTENT(in) :: comm
222 TYPE(xt_xmap) :: xmap
224 INTEGER(c_int) :: num_src_msg_c, num_dst_msg_c
225 TYPE(xt_com_pos_c),
ALLOCATABLE :: src_com_c(:), dst_com_c(:)
226 INTEGER(c_int),
TARGET,
ALLOCATABLE :: pos_buffer(:)
227 INTEGER :: pos_buffer_offset, size_pos_buf
229 size_pos_buf = num_pos_copy(num_src_msg, src_com) + &
230 num_pos_copy(num_dst_msg, dst_com)
231 ALLOCATE(pos_buffer(size_pos_buf))
233 num_src_msg_c = int(num_src_msg, c_int)
234 num_dst_msg_c = int(num_dst_msg, c_int)
236 pos_buffer_offset = 0
237 CALL generate_xt_com_pos_c(num_src_msg, src_com, src_com_c, &
238 size_pos_buf, pos_buffer, pos_buffer_offset)
239 CALL generate_xt_com_pos_c(num_dst_msg, dst_com, dst_com_c, &
240 size_pos_buf, pos_buffer, pos_buffer_offset)
243 xt_xmap_c2f(xmi_pos_new_f2c(&
244 num_src_msg_c, src_com_c, num_dst_msg_c, dst_com_c, comm))
246 END FUNCTION xmi_pos_new_i_a_i_a
248 PURE FUNCTION num_pos_copy(num_msg, com_pos)
RESULT(total_num_pos)
249 INTEGER,
INTENT(in) :: num_msg
252 INTEGER :: total_num_pos
253 #if defined __PGI && __PGIC__ > 15 && __PGIC__ < 20
254 INTEGER,
POINTER :: pos(:)
257 #ifdef HAVE_FC_IS_CONTIGUOUS
258 IF (kind(com_pos(i)%transfer_pos) == c_int)
THEN
260 #if defined __PGI && __PGIC__ > 15 && __PGIC__ < 20
261 pos => com_pos(i)%transfer_pos
262 IF (.NOT. is_contiguous(pos))
THEN
264 IF (.NOT. is_contiguous(com_pos(i)%transfer_pos))
THEN
266 total_num_pos = total_num_pos &
267 +
SIZE(com_pos(i)%transfer_pos)
273 total_num_pos = total_num_pos +
SIZE(com_pos(i)%transfer_pos)
275 #ifdef HAVE_FC_IS_CONTIGUOUS
278 END FUNCTION num_pos_copy
280 SUBROUTINE generate_xt_com_pos_c(num_msg, com_pos, com_pos_c, &
281 size_pos_buf, pos_buffer, &
283 INTEGER,
INTENT(in) :: num_msg
284 TYPE(
xt_com_pos),
TARGET,
INTENT(in) :: com_pos(:)
285 TYPE(xt_com_pos_c),
ALLOCATABLE,
INTENT(out) :: com_pos_c(:)
286 INTEGER,
INTENT(in) :: size_pos_buf
287 INTEGER(c_int),
TARGET,
INTENT(inout) :: pos_buffer(size_pos_buf)
288 INTEGER,
INTENT(inout) :: pos_buffer_offset
289 INTEGER :: i, j, num_pos
290 #if defined __PGI && __PGIC__ > 15 && __PGIC__ < 20
291 INTEGER,
POINTER :: pos(:)
293 ALLOCATE(com_pos_c(num_msg))
296 num_pos =
SIZE(com_pos(i)%transfer_pos)
297 #ifdef HAVE_FC_IS_CONTIGUOUS
298 # if defined __PGI && __PGIC__ > 15 && __PGIC__ < 20
299 pos => com_pos(i)%transfer_pos
300 IF (kind(1) == c_int .AND. is_contiguous(pos))
THEN
302 IF (kind(1) == c_int .AND. is_contiguous(com_pos(i)%transfer_pos))
THEN
304 com_pos_c(i)%transfer_pos = c_loc(com_pos(i)%transfer_pos(1))
308 pos_buffer(pos_buffer_offset + j) = &
309 int(com_pos(i)%transfer_pos(j), c_int)
311 com_pos_c(i)%transfer_pos = c_loc(pos_buffer(pos_buffer_offset+1))
312 pos_buffer_offset = pos_buffer_offset + num_pos
313 #ifdef HAVE_FC_IS_CONTIGUOUS
316 com_pos_c(i)%num_transfer_pos = int(num_pos, c_int)
317 com_pos_c(i)%rank = int(com_pos(i)%rank, c_int)
320 END SUBROUTINE generate_xt_com_pos_c
322 FUNCTION xmi_pos_new_a_a(src_com, dst_com, comm)
RESULT(xmap)
323 TYPE(
xt_com_pos),
INTENT(in) :: src_com(:), dst_com(:)
324 INTEGER,
INTENT(in) :: comm
325 TYPE(xt_xmap) :: xmap
328 xmi_pos_new_i_a_i_a(
SIZE(src_com), src_com,
SIZE(dst_com), dst_com, comm)
329 END FUNCTION xmi_pos_new_a_a
331 SUBROUTINE com_p_arg(com, com_a, com_p)
333 TYPE(
xt_com_list),
TARGET,
ALLOCATABLE,
INTENT(inout) :: com_a(:)
334 TYPE(c_ptr),
INTENT(out) :: com_p
337 LOGICAL :: com_is_contiguous
338 #ifndef HAVE_FC_IS_CONTIGUOUS
341 bind(c, name=
'xt_com_list_contiguous')
350 IF (com_size > huge(1_c_int)) &
351 CALL xt_abort(
'invalid size', filename, __line__)
352 IF (com_size > 0)
THEN
353 IF (com_size > 1)
THEN
354 #ifdef HAVE_FC_IS_CONTIGUOUS
355 com_is_contiguous = is_contiguous(com)
359 IF (com_is_contiguous)
THEN
360 xt_slice_c_loc(com(1), com_p)
362 ALLOCATE(com_a(com_size))
367 xt_slice_c_loc(com(1), com_p)
372 END SUBROUTINE com_p_arg
type(xt_xmap) function, public xt_xmap_c2f(xmap)
Xt_xmap xt_xmap_intersection_ext_new(int num_src_intersections, const struct Xt_com_list src_com[num_src_intersections], int num_dst_intersections, const struct Xt_com_list dst_com[num_dst_intersections], Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)
Xt_xmap xt_xmap_intersection_pos_new(int num_src_msg, const struct Xt_com_pos src_com[num_src_msg], int num_dst_msg, const struct Xt_com_pos dst_com[num_dst_msg], MPI_Comm comm)
Xt_xmap xt_xmap_intersection_new(int num_src_intersections, const struct Xt_com_list src_com[num_src_intersections], int num_dst_intersections, const struct Xt_com_list dst_com[num_dst_intersections], Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)
int xt_com_list_contiguous(const struct Xt_com_list *p_com_a, const struct Xt_com_list *p_com_b)
Xt_idxlist xt_idxlist_f2c(struct xt_idxlist_f *p)