Branch data Line data Source code
1 : : !{\src2tex{textfont=tt}}
2 : : !!****f* ABINIT/xmpi_isum
3 : : !! NAME
4 : : !! xmpi_isum
5 : : !!
6 : : !! FUNCTION
7 : : !! This module contains functions that calls MPI routine,
8 : : !! if we compile the code using the MPI CPP flags.
9 : : !! xmpi_isum is the generic function.
10 : : !!
11 : : !! COPYRIGHT
12 : : !! Copyright (C) 2001-2026 ABINIT group (MG)
13 : : !! This file is distributed under the terms of the
14 : : !! GNU General Public License, see ~ABINIT/COPYING
15 : : !! or http://www.gnu.org/copyleft/gpl.txt .
16 : : !!
17 : : !! NOTES
18 : : !! MPI_IALLREDUCE(SENDBUF, RECVBUF, COUNT, DATATYPE, OP, COMM, REQUEST, IERROR)
19 : : !! <type> SENDBUF(*), RECVBUF(*)
20 : : !! INTEGER COUNT, DATATYPE, OP, COMM, REQUEST, IERROR
21 : : !!
22 : : !! SOURCE
23 : :
24 : : !!***
25 : :
26 : : !!****f* ABINIT/xmpi_isum_int0d
27 : : !! NAME
28 : : !! xmpi_isum_int0d
29 : : !!
30 : : !! FUNCTION
31 : : !! Combines values from all processes and distribute the result back to all processes.
32 : : !! Target: scalar integers. Non-blocking version.
33 : : !!
34 : : !! INPUTS
35 : : !!
36 : : !! OUTPUT
37 : : !!
38 : : !! SOURCE
39 : :
40 : 16 : subroutine xmpi_isum_int0d(xval, xsum, comm, request, ierr)
41 : :
42 : : !Arguments-------------------------
43 : : integer ABI_ASYNC, intent(in), target :: xval
44 : : integer ABI_ASYNC, intent(out), target :: xsum
45 : : integer,intent(in) :: comm
46 : : integer,intent(out) :: ierr, request
47 : :
48 : : !Local variables-------------------
49 : : integer :: itmp
50 : : #ifdef HAVE_MPI_IALLREDUCE
51 : 16 : integer, pointer :: arr_xval(:),arr_xsum(:)
52 : : type(c_ptr) :: cptr
53 : : #endif
54 : :
55 : : ! *************************************************************************
56 : :
57 : : #ifdef HAVE_MPI_IALLREDUCE
58 : 16 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
59 [ + + ]: 32 : cptr=c_loc(xval) ; call c_f_pointer(cptr,arr_xval,[1])
60 [ + + ]: 32 : cptr=c_loc(xsum) ; call c_f_pointer(cptr,arr_xsum,[1])
61 [ - + - + ]: 16 : call MPI_IALLREDUCE(arr_xval, arr_xsum, 1, MPI_INTEGER, MPI_SUM, comm, request, ierr)
62 : 16 : xmpi_count_requests = xmpi_count_requests + 1
63 : 16 : return
64 : : end if
65 : 0 : xsum = xval; request = xmpi_request_null
66 : 0 : return
67 : : #endif
68 : :
69 : : ! Call the blocking version and return null request.
70 : : !write(std_out,*)"will block here and return fake request"
71 : : itmp = xval
72 : : call xmpi_sum(itmp, comm, ierr)
73 : : xsum = itmp; request = xmpi_request_null
74 : :
75 [ + - ]: 16 : end subroutine xmpi_isum_int0d
76 : : !!***
77 : :
78 : : !!****f* ABINIT/xmpi_isum_ip_dp2d
79 : : !! NAME
80 : : !! xmpi_isum_ip_dp2d
81 : : !!
82 : : !! FUNCTION
83 : : !! Combines values from all processes and distribute the result back to all processes.
84 : : !! Target: scalar integers. Non-blocking INPLACE version.
85 : : !!
86 : : !! INPUTS
87 : : !!
88 : : !! OUTPUT
89 : : !!
90 : : !! SOURCE
91 : :
92 [ # # ]: 0 : subroutine xmpi_isum_ip_dp2d(xval, comm, request, ierr)
93 : :
94 : : !Arguments-------------------------
95 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:,:)
96 : : integer,intent(in) :: comm
97 : : integer,intent(out) :: ierr, request
98 : : #if !defined HAVE_MPI2_INPLACE
99 : : integer :: n1,n2
100 : : real(dp) ABI_ASYNC, allocatable :: xsum(:,:)
101 : : #endif
102 : :
103 : : ! *************************************************************************
104 : :
105 : : #ifdef HAVE_MPI_IALLREDUCE
106 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
107 : : #if defined HAVE_MPI2_INPLACE
108 [ # # # # ]: 0 : call MPI_IALLREDUCE(MPI_IN_PLACE, xval, product(shape(xval)), MPI_DOUBLE_PRECISION, MPI_SUM, comm, request, ierr)
109 : : #else
110 : : n1 = size(xval,1) ; n2 = size(xval,2)
111 : : ABI_STAT_MALLOC(xsum,(n1,n2), ierr)
112 : : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_isum_ip_dp2d')
113 : : call MPI_IALLREDUCE(xsum, xval, product(shape(xval)), MPI_DOUBLE_PRECISION, MPI_SUM, comm, request, ierr)
114 : : xval (:,:) = xsum(:,:)
115 : : ABI_FREE(xsum)
116 : : #endif
117 : 0 : xmpi_count_requests = xmpi_count_requests + 1
118 : 0 : return
119 : : end if
120 : 0 : request = xmpi_request_null
121 : 0 : return
122 : : #endif
123 : :
124 : : ! Call the blocking version and return null request.
125 : : call xmpi_sum(xval, comm, ierr)
126 : : request = xmpi_request_null
127 : :
128 : : end subroutine xmpi_isum_ip_dp2d
129 : : !!***
130 : :
131 : : !!****f* ABINIT/xmpi_isum_ip_dp3d
132 : : !! NAME
133 : : !! xmpi_isum_ip_dp3d
134 : : !!
135 : : !! FUNCTION
136 : : !! Combines values from all processes and distribute the result back to all processes.
137 : : !! Target: scalar integers. Non-blocking INPLACE version.
138 : : !!
139 : : !! INPUTS
140 : : !!
141 : : !! OUTPUT
142 : : !!
143 : : !! SOURCE
144 : :
145 [ # # ]: 0 : subroutine xmpi_isum_ip_dp3d(xval, comm, request, ierr)
146 : :
147 : : !Arguments-------------------------
148 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:,:,:)
149 : : integer,intent(in) :: comm
150 : : integer,intent(out) :: ierr, request
151 : : #if !defined HAVE_MPI2_INPLACE
152 : : integer :: n1,n2,n3
153 : : real(dp) ABI_ASYNC, allocatable :: xsum(:,:,:)
154 : : #endif
155 : :
156 : : ! *************************************************************************
157 : :
158 : : #ifdef HAVE_MPI_IALLREDUCE
159 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
160 : : #if defined HAVE_MPI2_INPLACE
161 [ # # # # ]: 0 : call MPI_IALLREDUCE(MPI_IN_PLACE, xval, product(shape(xval)), MPI_DOUBLE_PRECISION, MPI_SUM, comm, request, ierr)
162 : : #else
163 : : n1 = size(xval,1) ; n2 = size(xval,2) ; n3 = size(xval,3)
164 : : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ierr)
165 : : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_isum_ip_dp3d')
166 : : call MPI_IALLREDUCE(xsum, xval, product(shape(xval)), MPI_DOUBLE_PRECISION, MPI_SUM, comm, request, ierr)
167 : : xval (:,:,:) = xsum(:,:,:)
168 : : ABI_FREE(xsum)
169 : : #endif
170 : 0 : xmpi_count_requests = xmpi_count_requests + 1
171 : 0 : return
172 : : end if
173 : 0 : request = xmpi_request_null
174 : 0 : return
175 : : #endif
176 : :
177 : : ! Call the blocking version and return null request.
178 : : call xmpi_sum(xval, comm, ierr)
179 : : request = xmpi_request_null
180 : :
181 : : end subroutine xmpi_isum_ip_dp3d
182 : : !!***
183 : :
184 : : !!****f* ABINIT/xmpi_isum_ip_dp4d
185 : : !! NAME
186 : : !! xmpi_isum_ip_dp4d
187 : : !!
188 : : !! FUNCTION
189 : : !! Combines values from all processes and distribute the result back to all processes.
190 : : !! Target: scalar integers. Non-blocking INPLACE version.
191 : : !!
192 : : !! INPUTS
193 : : !!
194 : : !! OUTPUT
195 : : !!
196 : : !! SOURCE
197 : :
198 [ # # ]: 0 : subroutine xmpi_isum_ip_dp4d(xval, comm, request, ierr)
199 : :
200 : : !Arguments-------------------------
201 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:,:,:,:)
202 : : integer,intent(in) :: comm
203 : : integer,intent(out) :: ierr, request
204 : : #if !defined HAVE_MPI2_INPLACE
205 : : integer :: n1,n2,n3,n4
206 : : real(dp) ABI_ASYNC, allocatable :: xsum(:,:,:,:)
207 : : #endif
208 : :
209 : : ! *************************************************************************
210 : :
211 : : #ifdef HAVE_MPI_IALLREDUCE
212 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
213 : : #if defined HAVE_MPI2_INPLACE
214 [ # # # # ]: 0 : call MPI_IALLREDUCE(MPI_IN_PLACE, xval, product(shape(xval)), MPI_DOUBLE_PRECISION, MPI_SUM, comm, request, ierr)
215 : : #else
216 : : n1 = size(xval,1) ; n2 = size(xval,2) ; n3 = size(xval,3) ; n4 = size(xval,4)
217 : : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ierr)
218 : : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_isum_ip_dp4d')
219 : : call MPI_IALLREDUCE(xsum, xval, product(shape(xval)), MPI_DOUBLE_PRECISION, MPI_SUM, comm, request, ierr)
220 : : xval (:,:,:,:) = xsum(:,:,:,:)
221 : : ABI_FREE(xsum)
222 : : #endif
223 : 0 : xmpi_count_requests = xmpi_count_requests + 1
224 : 0 : return
225 : : end if
226 : 0 : request = xmpi_request_null
227 : 0 : return
228 : : #endif
229 : :
230 : : ! Call the blocking version and return null request.
231 : : call xmpi_sum(xval, comm, ierr)
232 : : request = xmpi_request_null
233 : :
234 : : end subroutine xmpi_isum_ip_dp4d
235 : : !!***
236 : :
237 : : !!****f* ABINIT/xmpi_isum_ip_spc1d
238 : : !! NAME
239 : : !! xmpi_isum_ip_spc1d
240 : : !!
241 : : !! FUNCTION
242 : : !! Combines values from all processes and distribute the result back to all processes.
243 : : !! Target: 1d single precision complex arrays. Non-blocking INPLACE version.
244 : : !!
245 : : !! INPUTS
246 : : !!
247 : : !! OUTPUT
248 : : !!
249 : : !! SOURCE
250 : :
251 [ # # ]: 0 : subroutine xmpi_isum_ip_spc1d(xval, comm, request, ierr)
252 : :
253 : : !Arguments-------------------------
254 : : complex(sp) ABI_ASYNC, intent(inout) :: xval(:)
255 : : integer,intent(in) :: comm
256 : : integer,intent(out) :: ierr, request
257 : : #if !defined HAVE_MPI2_INPLACE
258 : : integer :: n1
259 : : complex(sp) ABI_ASYNC, allocatable :: xsum(:)
260 : : #endif
261 : :
262 : : ! *************************************************************************
263 : :
264 : : #ifdef HAVE_MPI_IALLREDUCE
265 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
266 : : #if defined HAVE_MPI2_INPLACE
267 [ # # # # ]: 0 : call MPI_IALLREDUCE(MPI_IN_PLACE, xval, product(shape(xval)), MPI_COMPLEX, MPI_SUM, comm, request, ierr)
268 : : #else
269 : : n1 = size(xval,1)
270 : : ABI_STAT_MALLOC(xsum,(n1), ierr)
271 : : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_isum_ip_spc1d')
272 : : call MPI_IALLREDUCE(xsum, xval, product(shape(xval)), MPI_COMPLEX, MPI_SUM, comm, request, ierr)
273 : : xval (:) = xsum(:)
274 : : ABI_FREE(xsum)
275 : : #endif
276 : 0 : xmpi_count_requests = xmpi_count_requests + 1
277 : 0 : return
278 : : end if
279 : 0 : request = xmpi_request_null
280 : 0 : return
281 : : #endif
282 : :
283 : : ! Call the blocking version and return null request.
284 : : call xmpi_sum(xval, comm, ierr)
285 : : request = xmpi_request_null
286 : :
287 : : end subroutine xmpi_isum_ip_spc1d
288 : : !!***
289 : :
290 : : !!****f* ABINIT/xmpi_isum_ip_dpc1d
291 : : !! NAME
292 : : !! xmpi_isum_ip_dpc1d
293 : : !!
294 : : !! FUNCTION
295 : : !! Combines values from all processes and distribute the result back to all processes.
296 : : !! Target: 1d double precision complex arrays. Non-blocking INPLACE version.
297 : : !!
298 : : !! INPUTS
299 : : !!
300 : : !! OUTPUT
301 : : !!
302 : : !! SOURCE
303 : :
304 [ # # ]: 0 : subroutine xmpi_isum_ip_dpc1d(xval, comm, request, ierr)
305 : :
306 : : !Arguments-------------------------
307 : : complex(dp) ABI_ASYNC, intent(inout) :: xval(:)
308 : : integer,intent(in) :: comm
309 : : integer,intent(out) :: ierr, request
310 : : #if !defined HAVE_MPI2_INPLACE
311 : : integer :: n1
312 : : complex(dp) ABI_ASYNC, allocatable :: xsum(:)
313 : : #endif
314 : :
315 : : ! *************************************************************************
316 : :
317 : : #ifdef HAVE_MPI_IALLREDUCE
318 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
319 : : #if defined HAVE_MPI2_INPLACE
320 [ # # # # ]: 0 : call MPI_IALLREDUCE(MPI_IN_PLACE, xval, product(shape(xval)), MPI_DOUBLE_COMPLEX, MPI_SUM, comm, request, ierr)
321 : : #else
322 : : n1 = size(xval,1)
323 : : ABI_STAT_MALLOC(xsum,(n1), ierr)
324 : : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_isum_ip_dpc1d')
325 : : call MPI_IALLREDUCE(xsum, xval, product(shape(xval)), MPI_DOUBLE_COMPLEX, MPI_SUM, comm, request, ierr)
326 : : xval (:) = xsum(:)
327 : : ABI_FREE(xsum)
328 : : #endif
329 : 0 : xmpi_count_requests = xmpi_count_requests + 1
330 : 0 : return
331 : : end if
332 : 0 : request = xmpi_request_null
333 : 0 : return
334 : : #endif
335 : :
336 : : ! Call the blocking version and return null request.
337 : : call xmpi_sum(xval, comm, ierr)
338 : : request = xmpi_request_null
339 : :
340 : : end subroutine xmpi_isum_ip_dpc1d
341 : : !!***
342 : :
343 : : !!****f* ABINIT/xmpi_isum_ip_spc2d
344 : : !! NAME
345 : : !! xmpi_isum_ip_spc2d
346 : : !!
347 : : !! FUNCTION
348 : : !! Combines values from all processes and distribute the result back to all processes.
349 : : !! Target: 2d single precision complex arrays. Non-blocking INPLACE version.
350 : : !!
351 : : !! INPUTS
352 : : !!
353 : : !! OUTPUT
354 : : !!
355 : : !! SOURCE
356 : :
357 [ # # ]: 0 : subroutine xmpi_isum_ip_spc2d(xval, comm, request, ierr)
358 : :
359 : : !Arguments-------------------------
360 : : complex(sp) ABI_ASYNC, intent(inout) :: xval(:,:)
361 : : integer,intent(in) :: comm
362 : : integer,intent(out) :: ierr, request
363 : : #if !defined HAVE_MPI2_INPLACE
364 : : integer :: n1,n2
365 : : complex(sp) ABI_ASYNC, allocatable :: xsum(:,:)
366 : : #endif
367 : :
368 : : ! *************************************************************************
369 : :
370 : : #ifdef HAVE_MPI_IALLREDUCE
371 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
372 : : #if defined HAVE_MPI2_INPLACE
373 [ # # # # ]: 0 : call MPI_IALLREDUCE(MPI_IN_PLACE, xval, product(shape(xval)), MPI_COMPLEX, MPI_SUM, comm, request, ierr)
374 : : #else
375 : : n1 = size(xval,1) ; n2 = size(xval,2)
376 : : ABI_STAT_MALLOC(xsum,(n1,n2), ierr)
377 : : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_isum_ip_spc2d')
378 : : call MPI_IALLREDUCE(xsum, xval, product(shape(xval)), MPI_DOUBLE_COMPLEX, MPI_SUM, comm, request, ierr)
379 : : xval (:,:) = xsum(:,:)
380 : : ABI_FREE(xsum)
381 : : #endif
382 : 0 : xmpi_count_requests = xmpi_count_requests + 1
383 : 0 : return
384 : : end if
385 : 0 : request = xmpi_request_null
386 : 0 : return
387 : : #endif
388 : :
389 : : ! Call the blocking version and return null request.
390 : : call xmpi_sum(xval, comm, ierr)
391 : : request = xmpi_request_null
392 : :
393 : : end subroutine xmpi_isum_ip_spc2d
394 : : !!***
395 : :
396 : : !!****f* ABINIT/xmpi_isum_ip_dpc2d
397 : : !! NAME
398 : : !! xmpi_isum_ip_dpc2d
399 : : !!
400 : : !! FUNCTION
401 : : !! Combines values from all processes and distribute the result back to all processes.
402 : : !! Target: 2d double precision complex arrays. Non-blocking INPLACE version.
403 : : !!
404 : : !! INPUTS
405 : : !!
406 : : !! OUTPUT
407 : : !!
408 : : !! SOURCE
409 : :
410 [ # # ]: 0 : subroutine xmpi_isum_ip_dpc2d(xval, comm, request, ierr)
411 : :
412 : : !Arguments-------------------------
413 : : complex(dp) ABI_ASYNC, intent(inout) :: xval(:,:)
414 : : integer,intent(in) :: comm
415 : : integer,intent(out) :: ierr, request
416 : : #if !defined HAVE_MPI2_INPLACE
417 : : integer :: n1,n2
418 : : complex(dp) ABI_ASYNC, allocatable :: xsum(:,:)
419 : : #endif
420 : :
421 : : ! *************************************************************************
422 : :
423 : : #ifdef HAVE_MPI_IALLREDUCE
424 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
425 : : #if defined HAVE_MPI2_INPLACE
426 [ # # # # ]: 0 : call MPI_IALLREDUCE(MPI_IN_PLACE, xval, product(shape(xval)), MPI_DOUBLE_COMPLEX, MPI_SUM, comm, request, ierr)
427 : : #else
428 : : n1 = size(xval,1) ; n2 = size(xval,2)
429 : : ABI_STAT_MALLOC(xsum,(n1,n2), ierr)
430 : : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_isum_ip_spc2d')
431 : : call MPI_IALLREDUCE(xsum, xval, product(shape(xval)), MPI_DOUBLE_COMPLEX, MPI_SUM, comm, request, ierr)
432 : : xval (:,:) = xsum(:,:)
433 : : ABI_FREE(xsum)
434 : : #endif
435 : 0 : xmpi_count_requests = xmpi_count_requests + 1
436 : 0 : return
437 : : end if
438 : 0 : request = xmpi_request_null
439 : 0 : return
440 : : #endif
441 : :
442 : : ! Call the blocking version and return null request.
443 : : call xmpi_sum(xval, comm, ierr)
444 : : request = xmpi_request_null
445 : :
446 : : end subroutine xmpi_isum_ip_dpc2d
447 : : !!***
448 : :
449 : : !!****f* ABINIT/xmpi_isum_ip_spc3d
450 : : !! NAME
451 : : !! xmpi_isum_ip_spc3d
452 : : !!
453 : : !! FUNCTION
454 : : !! Combines values from all processes and distribute the result back to all processes.
455 : : !! Target: 3d single precision complex arrays. Non-blocking INPLACE version.
456 : : !!
457 : : !! INPUTS
458 : : !!
459 : : !! OUTPUT
460 : : !!
461 : : !! SOURCE
462 : :
463 [ # # ]: 0 : subroutine xmpi_isum_ip_spc3d(xval, comm, request, ierr)
464 : :
465 : : !Arguments-------------------------
466 : : complex(sp) ABI_ASYNC, intent(inout) :: xval(:,:,:)
467 : : integer,intent(in) :: comm
468 : : integer,intent(out) :: ierr, request
469 : : #if !defined HAVE_MPI2_INPLACE
470 : : integer :: n1,n2,n3
471 : : complex(sp) ABI_ASYNC, allocatable :: xsum(:,:,:)
472 : : #endif
473 : :
474 : : ! *************************************************************************
475 : :
476 : : #ifdef HAVE_MPI_IALLREDUCE
477 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
478 : : #if defined HAVE_MPI2_INPLACE
479 [ # # # # ]: 0 : call MPI_IALLREDUCE(MPI_IN_PLACE, xval, product(shape(xval)), MPI_COMPLEX, MPI_SUM, comm, request, ierr)
480 : : #else
481 : : n1 = size(xval,1) ; n2 = size(xval,2) ; n3 = size(xval,3)
482 : : ABI_STAT_MALLOC(xsum,(n1,n2,3), ierr)
483 : : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_isum_ip_spc3d')
484 : : call MPI_IALLREDUCE(xsum, xval, product(shape(xval)), MPI_DOUBLE_COMPLEX, MPI_SUM, comm, request, ierr)
485 : : xval (:,:,:) = xsum(:,:,:)
486 : : ABI_FREE(xsum)
487 : : #endif
488 : 0 : xmpi_count_requests = xmpi_count_requests + 1
489 : 0 : return
490 : : end if
491 : 0 : request = xmpi_request_null
492 : 0 : return
493 : : #endif
494 : :
495 : : ! Call the blocking version and return null request.
496 : : call xmpi_sum(xval, comm, ierr)
497 : : request = xmpi_request_null
498 : :
499 : : end subroutine xmpi_isum_ip_spc3d
500 : : !!***
501 : :
502 : : !!****f* ABINIT/xmpi_isum_ip_dpc3d
503 : : !! NAME
504 : : !! xmpi_isum_ip_dpc3d
505 : : !!
506 : : !! FUNCTION
507 : : !! Combines values from all processes and distribute the result back to all processes.
508 : : !! Target: 3d double precision complex arrays. Non-blocking INPLACE version.
509 : : !!
510 : : !! INPUTS
511 : : !!
512 : : !! OUTPUT
513 : : !!
514 : : !! SOURCE
515 : :
516 [ # # ]: 0 : subroutine xmpi_isum_ip_dpc3d(xval, comm, request, ierr)
517 : :
518 : : !Arguments-------------------------
519 : : complex(dp) ABI_ASYNC, intent(inout) :: xval(:,:,:)
520 : : integer,intent(in) :: comm
521 : : integer,intent(out) :: ierr, request
522 : : #if !defined HAVE_MPI2_INPLACE
523 : : integer :: n1,n2,n3
524 : : complex(sp) ABI_ASYNC, allocatable :: xsum(:,:,:)
525 : : #endif
526 : :
527 : : ! *************************************************************************
528 : :
529 : : #ifdef HAVE_MPI_IALLREDUCE
530 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
531 : : #if defined HAVE_MPI2_INPLACE
532 [ # # # # ]: 0 : call MPI_IALLREDUCE(MPI_IN_PLACE, xval, product(shape(xval)), MPI_DOUBLE_COMPLEX, MPI_SUM, comm, request, ierr)
533 : : #else
534 : : n1 = size(xval,1) ; n2 = size(xval,2) ; n3 = size(xval,3)
535 : : ABI_STAT_MALLOC(xsum,(n1,n2,3), ierr)
536 : : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_isum_ip_dpc3d')
537 : : call MPI_IALLREDUCE(xsum, xval, product(shape(xval)), MPI_DOUBLE_COMPLEX, MPI_SUM, comm, request, ierr)
538 : : xval (:,:,:) = xsum(:,:,:)
539 : : ABI_FREE(xsum)
540 : : #endif
541 : 0 : xmpi_count_requests = xmpi_count_requests + 1
542 : 0 : return
543 : : end if
544 : 0 : request = xmpi_request_null
545 : 0 : return
546 : : #endif
547 : :
548 : : ! Call the blocking version and return null request.
549 : : call xmpi_sum(xval, comm, ierr)
550 : : request = xmpi_request_null
551 : :
552 : : end subroutine xmpi_isum_ip_dpc3d
553 : : !!***
|
