Line data Source code
1 : !{\src2tex{textfont=tt}}
2 : !!****f* ABINIT/xmpi_sum_int
3 : !! NAME
4 : !! xmpi_sum_int
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_sum is the generic function.
10 : !!
11 : !! COPYRIGHT
12 : !! Copyright (C) 2001-2026 ABINIT group (AR,XG,MB)
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 : !! MPI2 defines an option MPI_IN_PLACE to do the SUM in-place in the case of intra-communicators.
19 : !! The additional array xsum is therefore not needed if MPI_INPLACE is defined.
20 : !!
21 : !! SOURCE
22 :
23 30715265 : subroutine xmpi_sum_int(xval,comm,ier)
24 :
25 : !Arguments ------------------------------------
26 : integer, DEV_CONTARRD intent(inout) :: xval(:)
27 : integer,intent(in) :: comm
28 : integer,intent(out) :: ier
29 :
30 : !Local variables-------------------------------
31 : #if defined HAVE_MPI
32 : integer :: n1
33 30715265 : integer,allocatable :: xsum(:)
34 : #endif
35 : ! *************************************************************************
36 :
37 30715265 : ier=0
38 : #if defined HAVE_MPI
39 30715265 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
40 36524 : n1 = size(xval)
41 :
42 : ! Accumulate xval on all proc. in comm
43 : #if defined HAVE_MPI2_INPLACE
44 36524 : if (xmpi_use_inplace_operations) then
45 36524 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,n1,MPI_INTEGER,MPI_SUM,comm,ier)
46 : else
47 : #endif
48 0 : ABI_STAT_MALLOC(xsum,(n1), ier)
49 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_int')
50 0 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_INTEGER,MPI_SUM,comm,ier)
51 0 : xval (:) = xsum(:)
52 0 : ABI_FREE(xsum)
53 : #if defined HAVE_MPI2_INPLACE
54 : end if
55 : #endif
56 :
57 : end if
58 : #endif
59 :
60 30715265 : end subroutine xmpi_sum_int
61 : !!***
62 :
63 : !> wrapper arround xmpi_sum_int than can be called in C/CUDA
64 0 : subroutine xmpi_sum_int_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_int_c")
65 :
66 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
67 : implicit none
68 :
69 : ! dummy args
70 : type(c_ptr), intent(inout) :: xval_ptr
71 : integer(kind=c_int32_t), value, intent(in) :: xval_size
72 : integer(kind=c_int32_t), intent(in) :: comm
73 : integer(kind=c_int32_t), intent(out) :: ier
74 :
75 : ! local vars
76 : integer, pointer :: xval(:) => null()
77 : integer(kind=c_int32_t) :: arr_xval_size(1)
78 :
79 0 : arr_xval_size(1) = xval_size
80 : ! convert the c pointer into a fortran array
81 0 : call c_f_pointer(xval_ptr, xval, arr_xval_size)
82 :
83 0 : call xmpi_sum_int(xval, comm, ier)
84 :
85 0 : end subroutine xmpi_sum_int_c
86 :
87 : !----------------------------------------------------------------------
88 :
89 : !!****f* ABINIT/xmpi_sum_intv
90 : !! NAME
91 : !! xmpi_sum_intv
92 : !!
93 : !! FUNCTION
94 : !! Combines values from all processes and distribute
95 : !! the result back to all processes.
96 : !! Target: scalar integers.
97 : !!
98 : !! INPUTS
99 : !! comm= MPI communicator
100 : !!
101 : !! OUTPUT
102 : !! ier= exit status, a non-zero value meaning there is an error
103 : !!
104 : !! SIDE EFFECTS
105 : !! xval= buffer array
106 : !!
107 : !! SOURCE
108 :
109 5686724 : subroutine xmpi_sum_intv(xval,comm,ier)
110 :
111 : !Arguments----------------------
112 : integer,intent(inout) :: xval
113 : integer,intent(in) :: comm
114 : integer,intent(out) :: ier
115 :
116 : !Local variables----------------
117 : #if defined HAVE_MPI
118 : integer :: arr_xsum(1),arr_xval(1)
119 : #endif
120 : ! *************************************************************************
121 :
122 5686724 : ier=0
123 : #if defined HAVE_MPI
124 5686724 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
125 : ! Accumulate xval on all proc. in comm
126 300233 : arr_xval(1) = xval
127 300233 : call MPI_ALLREDUCE(arr_xval,arr_xsum,1,MPI_INTEGER,MPI_SUM,comm,ier)
128 300233 : xval = arr_xsum(1)
129 : end if
130 : #endif
131 5686724 : end subroutine xmpi_sum_intv
132 : !!***
133 :
134 : !> wrapper arround xmpi_sum_intv than can be called in C/CUDA
135 0 : subroutine xmpi_sum_intv_c(xval_ptr,comm,ier) bind(c, name="xmpi_sum_intv_c")
136 :
137 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
138 : implicit none
139 :
140 : ! dummy args
141 : type(c_ptr), intent(inout) :: xval_ptr
142 : integer(kind=c_int32_t), intent(in) :: comm
143 : integer(kind=c_int32_t), intent(out) :: ier
144 :
145 : ! local vars
146 : integer, pointer :: xval => null()
147 :
148 : ! convert the c pointer into a fortran variable
149 0 : call c_f_pointer(xval_ptr, xval)
150 :
151 0 : call xmpi_sum_intv(xval, comm, ier)
152 :
153 0 : end subroutine xmpi_sum_intv_c
154 :
155 :
156 : !----------------------------------------------------------------------
157 :
158 : !!****f* ABINIT/xmpi_sum_intv2
159 : !! NAME
160 : !! xmpi_sum_intv2
161 : !!
162 : !! FUNCTION
163 : !! Combines values from all processes and distribute
164 : !! the result back to all processes.
165 : !! Target: scalar integer without transfers.
166 : !!
167 : !! INPUTS
168 : !! comm= MPI communicator
169 : !!
170 : !! OUTPUT
171 : !! ier= exit status, a non-zero value meaning there is an error
172 : !!
173 : !! SIDE EFFECTS
174 : !! xval= buffer array
175 : !! xsum= receive buffer
176 : !!
177 : !! SOURCE
178 :
179 38 : subroutine xmpi_sum_intv2(xval,xsum,comm,ier)
180 :
181 : !Arguments---------------------
182 : integer,intent(inout) :: xval,xsum
183 : integer,intent(in) :: comm
184 : integer,intent(out) :: ier
185 :
186 : !Local variables----------------
187 : #if defined HAVE_MPI
188 : integer :: arr_xsum(1),arr_xval(1)
189 : #endif
190 : ! *************************************************************************
191 :
192 38 : ier=0
193 : #if defined HAVE_MPI
194 38 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
195 38 : arr_xval(1) = xval
196 38 : call MPI_ALLREDUCE(arr_xval,arr_xsum,1,MPI_INTEGER,MPI_SUM,comm,ier)
197 38 : xsum=arr_xsum(1)
198 : else
199 : #endif
200 0 : xsum=xval
201 : #if defined HAVE_MPI
202 : end if
203 : #endif
204 :
205 38 : end subroutine xmpi_sum_intv2
206 : !!***
207 :
208 : !> wrapper arround xmpi_sum_intv2 than can be called in C/CUDA
209 0 : subroutine xmpi_sum_intv2_c(xval_ptr,xsum_ptr,comm,ier) bind(c, name="xmpi_sum_intv2_c")
210 :
211 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
212 : implicit none
213 :
214 : ! dummy args
215 : type(c_ptr), intent(inout) :: xval_ptr
216 : type(c_ptr), intent(inout) :: xsum_ptr
217 : integer(kind=c_int32_t), intent(in) :: comm
218 : integer(kind=c_int32_t), intent(out) :: ier
219 :
220 : ! local vars
221 : integer, pointer :: xval => null()
222 : integer, pointer :: xsum => null()
223 :
224 : ! convert the c pointer into a fortran variable
225 0 : call c_f_pointer(xval_ptr, xval)
226 0 : call c_f_pointer(xsum_ptr, xsum)
227 :
228 0 : call xmpi_sum_intv2(xval, xsum, comm, ier)
229 :
230 0 : end subroutine xmpi_sum_intv2_c
231 :
232 : !!****f* ABINIT/xmpi_sum_intn
233 : !! NAME
234 : !! xmpi_sum_intn
235 : !!
236 : !! FUNCTION
237 : !! Combines values from all processes and distribute
238 : !! the result back to all processes.
239 : !! Target: one-dimensional integer arrays.
240 : !!
241 : !! INPUTS
242 : !! n1= first dimension of the array
243 : !! comm= MPI communicator
244 : !!
245 : !! OUTPUT
246 : !! ier= exit status, a non-zero value meaning there is an error
247 : !!
248 : !! SIDE EFFECTS
249 : !! xval= buffer array
250 : !!
251 : !! SOURCE
252 :
253 0 : subroutine xmpi_sum_intn(xval,n1,comm,ier)
254 :
255 : !Arguments-------------------------
256 : integer, DEV_CONTARRD intent(inout) :: xval(:)
257 : integer,intent(in) :: n1
258 : integer,intent(in) :: comm
259 : integer,intent(out) :: ier
260 :
261 : !Local variables-------------------
262 : #if defined HAVE_MPI
263 : integer :: nproc_space_comm
264 0 : integer , allocatable :: xsum(:)
265 : #endif
266 : ! *************************************************************************
267 :
268 0 : ier=0
269 : #if defined HAVE_MPI
270 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
271 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
272 0 : if (nproc_space_comm /= 1) then
273 :
274 : ! Accumulate xval on all proc. in comm
275 : #if defined HAVE_MPI2_INPLACE
276 0 : if (xmpi_use_inplace_operations) then
277 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,n1,MPI_INTEGER,MPI_SUM,comm,ier)
278 : else
279 : #endif
280 0 : ABI_STAT_MALLOC(xsum,(n1), ier)
281 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_intn')
282 0 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_INTEGER,MPI_SUM,comm,ier)
283 0 : xval (:) = xsum(:)
284 0 : ABI_FREE(xsum)
285 : #if defined HAVE_MPI2_INPLACE
286 : endif
287 : #endif
288 :
289 : end if
290 : end if
291 : #endif
292 :
293 0 : end subroutine xmpi_sum_intn
294 : !!***
295 :
296 : !> wrapper arround xmpi_sum_intn than can be called in C/CUDA
297 0 : subroutine xmpi_sum_intn_c(xval_ptr,xval_size,n1,comm,ier) bind(c, name="xmpi_sum_intn_c")
298 :
299 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
300 : implicit none
301 :
302 : ! dummy args
303 : type(c_ptr), intent(inout) :: xval_ptr
304 : integer(kind=c_int32_t), value, intent(in) :: xval_size
305 : integer(kind=c_int32_t), intent(in) :: n1
306 : integer(kind=c_int32_t), intent(in) :: comm
307 : integer(kind=c_int32_t), intent(out) :: ier
308 :
309 : ! local vars
310 : integer, pointer :: xval(:) => null()
311 : integer(kind=c_int32_t) :: arr_xval_size(1)
312 :
313 0 : arr_xval_size(1) = xval_size
314 : ! convert the c pointer into a fortran array
315 0 : call c_f_pointer(xval_ptr, xval, arr_xval_size)
316 :
317 0 : call xmpi_sum_intn(xval, n1, comm, ier)
318 :
319 0 : end subroutine xmpi_sum_intn_c
320 :
321 : !----------------------------------------------------------------------
322 :
323 : !!****f* ABINIT/xmpi_sum_int2t
324 : !! NAME
325 : !! xmpi_sum_int2t
326 : !!
327 : !! FUNCTION
328 : !! Combines values from all processes and distribute
329 : !! the result back to all processes.
330 : !! Target: one-dimensional integer array without transfers.
331 : !!
332 : !! INPUTS
333 : !! n1= first dimension of the array
334 : !! comm= MPI communicator
335 : !!
336 : !! OUTPUT
337 : !! ier= exit status, a non-zero value meaning there is an error
338 : !!
339 : !! SIDE EFFECTS
340 : !! xval= buffer array
341 : !! xsum= receive buffer
342 : !!
343 : !! SOURCE
344 :
345 788 : subroutine xmpi_sum_int2t(xval,xsum,n1,comm,ier)
346 :
347 : !Arguments-------------------------
348 : integer, DEV_CONTARRD intent(inout) :: xval(:),xsum(:)
349 : integer,intent(in) :: n1
350 : integer,intent(in) :: comm
351 : integer,intent(out) :: ier
352 : ! *************************************************************************
353 :
354 788 : ier=0
355 : #if defined HAVE_MPI
356 788 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
357 : ! Accumulate xval on all proc. in comm
358 772 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_INTEGER,MPI_SUM,comm,ier)
359 : else
360 : #endif
361 32 : xsum=xval
362 : #if defined HAVE_MPI
363 : end if
364 : #endif
365 :
366 788 : end subroutine xmpi_sum_int2t
367 : !!***
368 :
369 : !----------------------------------------------------------------------
370 :
371 : !!****f* ABINIT/xmpi_sum_int2d
372 : !! NAME
373 : !! xmpi_sum_int2d
374 : !!
375 : !! FUNCTION
376 : !! Combines values from all processes and distribute
377 : !! the result back to all processes.
378 : !! Target: two-dimensional integer arrays.
379 : !!
380 : !! INPUTS
381 : !! comm= MPI communicator
382 : !!
383 : !! OUTPUT
384 : !! ier= exit status, a non-zero value meaning there is an error
385 : !!
386 : !! SIDE EFFECTS
387 : !! xval= buffer array
388 : !!
389 : !! SOURCE
390 :
391 857 : subroutine xmpi_sum_int2d(xval,comm,ier)
392 :
393 : !Arguments-------------------------
394 : integer, DEV_CONTARRD intent(inout) :: xval(:,:)
395 : integer,intent(in) :: comm
396 : integer,intent(out) :: ier
397 :
398 : !Local variables-------------------
399 : #if defined HAVE_MPI
400 : integer :: my_dt,my_op,n1,n2,nn,nproc_space_comm
401 : integer(kind=int64) :: ntot
402 857 : integer,allocatable :: xsum(:,:)
403 : #endif
404 : ! *************************************************************************
405 :
406 857 : ier=0
407 : #if defined HAVE_MPI
408 857 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
409 852 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
410 852 : if (nproc_space_comm /= 1) then
411 174 : n1 =size(xval,dim=1)
412 174 : n2 =size(xval,dim=2)
413 :
414 : !This product of dimensions can be greater than a 32bit integer
415 : !We use a INT64 to store it. If it is too large, we switch to an
416 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
417 174 : ntot=int(n1,kind=int64)*n2
418 174 : if (ntot<=xmpi_maxint32_64) then
419 174 : nn=n1*n2 ; my_dt=MPI_INTEGER ; my_op=MPI_SUM
420 : else
421 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_INTEGER,my_dt,my_op,MPI_SUM)
422 : end if
423 :
424 : ! Accumulate xval on all proc. in comm
425 : #if defined HAVE_MPI2_INPLACE
426 174 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
427 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
428 174 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
429 : else
430 : #endif
431 0 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
432 0 : if (ier/=0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_int2d')
433 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
434 0 : xval (:,:) = xsum(:,:)
435 0 : ABI_FREE(xsum)
436 : #if defined HAVE_MPI2_INPLACE
437 : end if
438 : #endif
439 :
440 174 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
441 : end if
442 : end if
443 : #endif
444 :
445 857 : end subroutine xmpi_sum_int2d
446 : !!***
447 :
448 : !> wrapper arround xmpi_sum_int2d than can be called in C/CUDA
449 0 : subroutine xmpi_sum_int2d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_int2d_c")
450 :
451 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
452 : implicit none
453 :
454 : ! dummy args
455 : type(c_ptr), intent(inout) :: xval_ptr
456 : integer(kind=c_int32_t), intent(in) :: xval_size(2)
457 : integer(kind=c_int32_t), intent(in) :: comm
458 : integer(kind=c_int32_t), intent(out) :: ier
459 :
460 : ! local vars
461 : integer, pointer :: xval(:,:) => null()
462 :
463 : ! convert the c pointer into a fortran array
464 0 : call c_f_pointer(xval_ptr, xval, xval_size)
465 :
466 0 : call xmpi_sum_int2d(xval, comm, ier)
467 :
468 0 : end subroutine xmpi_sum_int2d_c
469 :
470 : !----------------------------------------------------------------------
471 :
472 : !!****f* ABINIT/xmpi_sum_int3d
473 : !! NAME
474 : !! xmpi_sum_int3d
475 : !!
476 : !! FUNCTION
477 : !! Combines values from all processes and distribute
478 : !! the result back to all processes.
479 : !! Target: three-dimensional integer arrays.
480 : !!
481 : !! INPUTS
482 : !! comm= MPI communicator
483 : !!
484 : !! OUTPUT
485 : !! ier= exit status, a non-zero value meaning there is an error
486 : !!
487 : !! SIDE EFFECTS
488 : !! xval= buffer array
489 : !!
490 : !! SOURCE
491 :
492 706 : subroutine xmpi_sum_int3d(xval,comm,ier)
493 :
494 : !Arguments-------------------------
495 : integer, DEV_CONTARRD intent(inout) :: xval(:,:,:)
496 : integer,intent(in) :: comm
497 : integer,intent(out) :: ier
498 :
499 : !Local variables-------------------
500 : #if defined HAVE_MPI
501 : integer :: my_dt,my_op,n1,n2,n3,nn,nproc_space_comm
502 : integer(kind=int64) :: ntot
503 706 : integer,allocatable :: xsum(:,:,:)
504 : #endif
505 : ! *************************************************************************
506 :
507 706 : ier=0
508 : #if defined HAVE_MPI
509 706 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
510 706 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
511 706 : if (nproc_space_comm /= 1) then
512 234 : n1 =size(xval,dim=1)
513 234 : n2 =size(xval,dim=2)
514 234 : n3 =size(xval,dim=3)
515 :
516 : !This product of dimensions can be greater than a 32bit integer
517 : !We use a INT64 to store it. If it is too large, we switch to an
518 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
519 234 : ntot=int(n1,kind=int64)*n2*n3
520 234 : if (ntot<=xmpi_maxint32_64) then
521 234 : nn=n1*n2*n3 ; my_dt=MPI_INTEGER ; my_op=MPI_SUM
522 : else
523 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_INTEGER,my_dt,my_op,MPI_SUM)
524 : end if
525 :
526 : ! Accumulate xval on all proc. in comm
527 : #if defined HAVE_MPI2_INPLACE
528 234 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
529 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
530 234 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
531 : #endif
532 : else
533 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
534 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_int3d')
535 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
536 0 : xval (:,:,:) = xsum(:,:,:)
537 0 : ABI_FREE(xsum)
538 : #if defined HAVE_MPI2_INPLACE
539 : end if
540 : #endif
541 :
542 234 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
543 : end if
544 : end if
545 : #endif
546 :
547 706 : end subroutine xmpi_sum_int3d
548 : !!***
549 :
550 : !> wrapper arround xmpi_sum_int3d than can be called in C/CUDA
551 0 : subroutine xmpi_sum_int3d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_int3d_c")
552 :
553 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
554 : implicit none
555 :
556 : ! dummy args
557 : type(c_ptr), intent(inout) :: xval_ptr
558 : integer(kind=c_int32_t), intent(in) :: xval_size(3)
559 : integer(kind=c_int32_t), intent(in) :: comm
560 : integer(kind=c_int32_t), intent(out) :: ier
561 :
562 : ! local vars
563 : integer, pointer :: xval(:,:,:) => null()
564 :
565 : ! convert the c pointer into a fortran array
566 0 : call c_f_pointer(xval_ptr, xval, xval_size)
567 :
568 0 : call xmpi_sum_int3d(xval, comm, ier)
569 :
570 0 : end subroutine xmpi_sum_int3d_c
571 :
572 : !----------------------------------------------------------------------
573 :
574 : !!****f* ABINIT/xmpi_sum_int4d
575 : !! NAME
576 : !! xmpi_sum_int4d
577 : !!
578 : !! FUNCTION
579 : !! Combines values from all processes and distribute
580 : !! the result back to all processes.
581 : !! Target: four-dimensional integer arrays.
582 : !!
583 : !! INPUTS
584 : !! comm= MPI communicator
585 : !!
586 : !! OUTPUT
587 : !! ier= exit status, a non-zero value meaning there is an error
588 : !!
589 : !! SIDE EFFECTS
590 : !! xval= buffer array
591 : !!
592 : !! SOURCE
593 :
594 4420 : subroutine xmpi_sum_int4d(xval,comm,ier)
595 :
596 : !Arguments-------------------------
597 : integer, DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
598 : integer,intent(in) :: comm
599 : integer,intent(out) :: ier
600 :
601 : !Local variables-------------------
602 : #if defined HAVE_MPI
603 : integer :: my_dt,my_op,n1,n2,n3,n4,nn,nproc_space_comm
604 : integer(kind=int64) :: ntot
605 4420 : integer,allocatable :: xsum(:,:,:,:)
606 : #endif
607 : ! *************************************************************************
608 :
609 4420 : ier=0
610 : #if defined HAVE_MPI
611 4420 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
612 4403 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
613 4403 : if (nproc_space_comm /= 1) then
614 4244 : n1 =size(xval,dim=1)
615 4244 : n2 =size(xval,dim=2)
616 4244 : n3 =size(xval,dim=3)
617 4244 : n4 =size(xval,dim=4)
618 :
619 : !This product of dimensions can be greater than a 32bit integer
620 : !We use a INT64 to store it. If it is too large, we switch to an
621 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
622 4244 : ntot=int(n1,kind=int64)*n2*n3*n4
623 4244 : if (ntot<=xmpi_maxint32_64) then
624 4244 : nn=n1*n2*n3*n4 ; my_dt=MPI_INTEGER ; my_op=MPI_SUM
625 : else
626 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_INTEGER,my_dt,my_op,MPI_SUM)
627 : end if
628 :
629 : ! Accumulate xval on all proc. in comm
630 : #if defined HAVE_MPI2_INPLACE
631 4244 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
632 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
633 4244 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
634 : else
635 : #endif
636 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
637 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_int4d')
638 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
639 0 : xval (:,:,:,:) = xsum(:,:,:,:)
640 0 : ABI_FREE(xsum)
641 : #if defined HAVE_MPI2_INPLACE
642 : end if
643 : #endif
644 :
645 4244 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
646 : end if
647 : end if
648 : #endif
649 :
650 4420 : end subroutine xmpi_sum_int4d
651 : !!***
652 :
653 : !> wrapper arround xmpi_sum_int4d than can be called in C/CUDA
654 0 : subroutine xmpi_sum_int4d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_int4d_c")
655 :
656 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
657 : implicit none
658 :
659 : ! dummy args
660 : type(c_ptr), intent(inout) :: xval_ptr
661 : integer(kind=c_int32_t), intent(in) :: xval_size(4)
662 : integer(kind=c_int32_t), intent(in) :: comm
663 : integer(kind=c_int32_t), intent(out) :: ier
664 :
665 : ! local vars
666 : integer, pointer :: xval(:,:,:,:) => null()
667 :
668 : ! convert the c pointer into a fortran array
669 0 : call c_f_pointer(xval_ptr, xval, xval_size)
670 :
671 0 : call xmpi_sum_int4d(xval, comm, ier)
672 :
673 0 : end subroutine xmpi_sum_int4d_c
674 :
675 : !----------------------------------------------------------------------
676 :
677 : !!****f* ABINIT/xmpi_sum_dp
678 : !! NAME
679 : !! xmpi_sum_dp
680 : !!
681 : !! FUNCTION
682 : !! Combines values from all processes and distribute
683 : !! the result back to all processes.
684 : !! Target: one-dimensional double precision arrays.
685 : !!
686 : !! INPUTS
687 : !! comm= MPI communicator
688 : !!
689 : !! OUTPUT
690 : !! ier= exit status, a non-zero value meaning there is an error
691 : !!
692 : !! SIDE EFFECTS
693 : !! xval= buffer array
694 : !!
695 : !! SOURCE
696 :
697 28034202 : subroutine xmpi_sum_dp(xval,comm,ier)
698 :
699 : !Arguments-------------------------
700 : real(dp), DEV_CONTARRD intent(inout) :: xval(:)
701 : integer,intent(in) :: comm
702 : integer,intent(out) :: ier
703 :
704 : !Local variables-------------------
705 : #if defined HAVE_MPI
706 : integer :: n1,nproc_space_comm
707 28034202 : real(dp),allocatable :: xsum(:)
708 : #endif
709 : ! *************************************************************************
710 :
711 28034202 : ier=0
712 : #if defined HAVE_MPI
713 28034202 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
714 989678 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
715 989678 : if (nproc_space_comm /= 1) then
716 271296 : n1 = size(xval)
717 :
718 : ! Accumulate xval on all proc. in comm
719 : #if defined HAVE_MPI2_INPLACE
720 271296 : if (xmpi_use_inplace_operations) then
721 271296 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,n1,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
722 : else
723 : #endif
724 0 : ABI_STAT_MALLOC(xsum,(n1), ier)
725 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_dp')
726 0 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
727 0 : xval (:) = xsum(:)
728 0 : ABI_FREE(xsum)
729 : #if defined HAVE_MPI2_INPLACE
730 : end if
731 : #endif
732 :
733 : end if
734 : end if
735 : #endif
736 :
737 28034202 : end subroutine xmpi_sum_dp
738 : !!***
739 :
740 : !> wrapper arround xmpi_sum_dp than can be called in C/CUDA
741 0 : subroutine xmpi_sum_dp_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_dp_c")
742 :
743 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
744 : implicit none
745 :
746 : ! dummy args
747 : type(c_ptr), intent(inout) :: xval_ptr
748 : integer(kind=c_int32_t), value, intent(in) :: xval_size
749 : integer(kind=c_int32_t), intent(in) :: comm
750 : integer(kind=c_int32_t), intent(out) :: ier
751 :
752 : ! local vars
753 : real(dp), pointer :: xval(:) => null()
754 : integer(kind=c_int32_t) :: arr_xval_size(1)
755 :
756 0 : arr_xval_size(1) = xval_size
757 : ! convert the c pointer into a fortran array
758 0 : call c_f_pointer(xval_ptr, xval, arr_xval_size)
759 :
760 0 : call xmpi_sum_dp(xval, comm, ier)
761 :
762 0 : end subroutine xmpi_sum_dp_c
763 :
764 : !----------------------------------------------------------------------
765 :
766 : !!****f* ABINIT/xmpi_sum_dpvt
767 : !! NAME
768 : !! xmpi_sum_dpvt
769 : !!
770 : !! FUNCTION
771 : !! Combines values from all processes and distribute
772 : !! the result back to all processes.
773 : !! Target: scalar double precisions.
774 : !!
775 : !! INPUTS
776 : !! xval= buffer array
777 : !! comm= MPI communicator
778 : !!
779 : !! OUTPUT
780 : !! xsum= receive buffer
781 : !! ier= exit status, a non-zero value meaning there is an error
782 : !!
783 : !! SIDE EFFECTS
784 : !! None
785 : !!
786 : !! SOURCE
787 :
788 0 : subroutine xmpi_sum_dpvt(xval,xsum,comm,ier)
789 :
790 : !Arguments-------------------------
791 : real(dp),intent(in) :: xval
792 : real(dp),intent(out) :: xsum
793 : integer ,intent(in) :: comm
794 : integer ,intent(out) :: ier
795 :
796 : !Local variables-------------------
797 : #if defined HAVE_MPI
798 : integer :: nproc_space_comm
799 : real(dp) :: arr_xsum(1),arr_xval(1)
800 : #endif
801 : ! *************************************************************************
802 :
803 0 : ier=0
804 : #if defined HAVE_MPI
805 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
806 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
807 0 : if (nproc_space_comm /= 1) then
808 : ! Accumulate xval on all proc. in comm
809 0 : arr_xval(1) = xval
810 0 : call MPI_ALLREDUCE(arr_xval,arr_xsum,1,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
811 0 : xsum=arr_xsum(1)
812 : else
813 0 : xsum=xval
814 : end if
815 : else
816 : #endif
817 0 : xsum=xval
818 : #if defined HAVE_MPI
819 : end if
820 : #endif
821 :
822 0 : end subroutine xmpi_sum_dpvt
823 : !!***
824 :
825 : !> wrapper arround xmpi_sum_dpvt than can be called in C/CUDA
826 0 : subroutine xmpi_sum_dpvt_c(xval_ptr,xsum_ptr,comm,ier) bind(c, name="xmpi_sum_dpvt_c")
827 :
828 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
829 : implicit none
830 :
831 : ! dummy args
832 : type(c_ptr), intent(inout) :: xval_ptr
833 : type(c_ptr), intent(inout) :: xsum_ptr
834 : integer(kind=c_int32_t), intent(in) :: comm
835 : integer(kind=c_int32_t), intent(out) :: ier
836 :
837 : ! local vars
838 : real(dp), pointer :: xval => null()
839 : real(dp), pointer :: xsum => null()
840 :
841 : ! convert the c pointer into a fortran array
842 0 : call c_f_pointer(xval_ptr, xval)
843 0 : call c_f_pointer(xsum_ptr, xsum)
844 :
845 0 : call xmpi_sum_dpvt(xval, xsum, comm, ier)
846 :
847 0 : end subroutine xmpi_sum_dpvt_c
848 :
849 : !----------------------------------------------------------------------
850 :
851 : !!****f* ABINIT/xmpi_sum_dpv
852 : !! NAME
853 : !! xmpi_sum_dpv
854 : !!
855 : !! FUNCTION
856 : !! Combines values from all processes and distribute
857 : !! the result back to all processes.
858 : !! Target: scalar double precisions.
859 : !!
860 : !! INPUTS
861 : !! comm= MPI communicator
862 : !!
863 : !! OUTPUT
864 : !! ier= exit status, a non-zero value meaning there is an error
865 : !!
866 : !! SIDE EFFECTS
867 : !! xval= buffer array
868 : !!
869 : !! SOURCE
870 33406387 : subroutine xmpi_sum_dpv(xval,comm,ier)
871 :
872 : !Arguments-------------------------
873 : real(dp),intent(inout) :: xval
874 : integer ,intent(in) :: comm
875 : integer ,intent(out) :: ier
876 :
877 : !Local variables-------------------
878 : #if defined HAVE_MPI
879 : integer :: nproc_space_comm
880 : real(dp) :: arr_xsum(1),arr_xval(1)
881 : #endif
882 : ! *************************************************************************
883 :
884 33406387 : ier=0
885 : #if defined HAVE_MPI
886 33406387 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
887 : ! Accumulate xval on all proc. in comm
888 780141 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
889 780141 : if (nproc_space_comm /= 1) then
890 688122 : arr_xval(1) = xval
891 688122 : call MPI_ALLREDUCE(arr_xval,arr_xsum,1,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
892 688122 : xval = arr_xsum(1)
893 : end if
894 : end if
895 : #endif
896 :
897 33406387 : end subroutine xmpi_sum_dpv
898 : !!***
899 :
900 : !> wrapper arround xmpi_sum_dpv than can be called in C/CUDA
901 0 : subroutine xmpi_sum_dpv_c(xval_ptr,comm,ier) bind(c, name="xmpi_sum_dpv_c")
902 :
903 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
904 : implicit none
905 :
906 : ! dummy args
907 : type(c_ptr), intent(inout) :: xval_ptr
908 : integer(kind=c_int32_t), intent(in) :: comm
909 : integer(kind=c_int32_t), intent(out) :: ier
910 :
911 : ! local vars
912 : real(dp), pointer :: xval => null()
913 :
914 : ! convert the c pointer into a fortran array
915 0 : call c_f_pointer(xval_ptr, xval)
916 :
917 0 : call xmpi_sum_dpv(xval, comm, ier)
918 :
919 0 : end subroutine xmpi_sum_dpv_c
920 :
921 : !----------------------------------------------------------------------
922 :
923 : !!****f* ABINIT/xmpi_sum_dpn
924 : !! NAME
925 : !! xmpi_sum_dpn
926 : !!
927 : !! FUNCTION
928 : !! Combines values from all processes and distribute
929 : !! the result back to all processes.
930 : !! Target: one-dimensional double precision arrays.
931 : !!
932 : !! INPUTS
933 : !! n1= first dimension of the array
934 : !! comm= MPI communicator
935 : !!
936 : !! OUTPUT
937 : !! ier= exit status, a non-zero value meaning there is an error
938 : !!
939 : !! SIDE EFFECTS
940 : !! xval= buffer array
941 : !!
942 : !! SOURCE
943 :
944 224339 : subroutine xmpi_sum_dpn(xval,n1,comm,ier)
945 :
946 : !Arguments-------------------------
947 : real(dp), DEV_CONTARRD intent(inout) :: xval(:)
948 : integer ,intent(in) :: n1
949 : integer ,intent(in) :: comm
950 : integer ,intent(out) :: ier
951 :
952 : !Local variables-------------------
953 : #if defined HAVE_MPI
954 : integer :: nproc_space_comm
955 224339 : real(dp) , allocatable :: xsum(:)
956 : #endif
957 : ! *************************************************************************
958 :
959 224339 : ier=0
960 : #if defined HAVE_MPI
961 224339 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
962 223815 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
963 223815 : if (nproc_space_comm /= 1) then
964 :
965 : ! Accumulate xval on all proc. in comm
966 : #if defined HAVE_MPI2_INPLACE
967 163930 : if (xmpi_use_inplace_operations) then
968 163930 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,n1,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
969 : else
970 : #endif
971 0 : ABI_STAT_MALLOC(xsum,(n1), ier)
972 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_dpn')
973 0 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
974 0 : xval (:) = xsum(:)
975 0 : ABI_FREE(xsum)
976 : #if defined HAVE_MPI2_INPLACE
977 : end if
978 : #endif
979 :
980 : end if
981 : end if
982 : #endif
983 :
984 224339 : end subroutine xmpi_sum_dpn
985 : !!***
986 :
987 : !> wrapper arround xmpi_sum_dpn than can be called in C/CUDA
988 0 : subroutine xmpi_sum_dpn_c(xval_ptr,xval_size,n1,comm,ier) bind(c, name="xmpi_sum_dpn_c")
989 :
990 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
991 : implicit none
992 :
993 : ! dummy args
994 : type(c_ptr), intent(inout) :: xval_ptr
995 : integer(kind=c_int32_t), value, intent(in) :: xval_size
996 : integer(kind=c_int32_t), intent(in) :: n1
997 : integer(kind=c_int32_t), intent(in) :: comm
998 : integer(kind=c_int32_t), intent(out) :: ier
999 :
1000 : ! local vars
1001 : real(dp), pointer :: xval(:) => null()
1002 : integer(kind=c_int32_t) :: arr_xval_size(1)
1003 :
1004 0 : arr_xval_size(1) = xval_size
1005 : ! convert the c pointer into a fortran array
1006 0 : call c_f_pointer(xval_ptr, xval, arr_xval_size)
1007 :
1008 0 : call xmpi_sum_dpn(xval, n1, comm, ier)
1009 :
1010 0 : end subroutine xmpi_sum_dpn_c
1011 :
1012 : !----------------------------------------------------------------------
1013 :
1014 : !!****f* ABINIT/xmpi_sum_sp2d
1015 : !! NAME
1016 : !! xmpi_sum_sp2d
1017 : !!
1018 : !! FUNCTION
1019 : !! Combines values from all processes and distribute
1020 : !! the result back to all processes.
1021 : !! Target: double precision two-dimensional arrays.
1022 : !!
1023 : !! INPUTS
1024 : !! comm= MPI communicator
1025 : !!
1026 : !! OUTPUT
1027 : !! ier= exit status, a non-zero value meaning there is an error
1028 : !!
1029 : !! SIDE EFFECTS
1030 : !! xval= buffer array
1031 : !!
1032 : !! SOURCE
1033 :
1034 0 : subroutine xmpi_sum_sp2d(xval,comm,ier)
1035 :
1036 : !Arguments-------------------------
1037 : real(sp), DEV_CONTARRD intent(inout) :: xval(:,:)
1038 : integer ,intent(in) :: comm
1039 : integer ,intent(out) :: ier
1040 :
1041 : !Local variables-------------------
1042 : #if defined HAVE_MPI
1043 : integer :: my_dt,my_op,n1,n2,nn,nproc_space_comm
1044 : integer(kind=int64) :: ntot
1045 0 : real(sp),allocatable :: xsum(:,:)
1046 : #endif
1047 : ! *************************************************************************
1048 :
1049 0 : ier=0
1050 : #if defined HAVE_MPI
1051 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1052 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1053 0 : if (nproc_space_comm /= 1) then
1054 0 : n1 = size(xval,dim=1)
1055 0 : n2 = size(xval,dim=2)
1056 :
1057 : !This product of dimensions can be greater than a 32bit integer
1058 : !We use a INT64 to store it. If it is too large, we switch to an
1059 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1060 0 : ntot=int(n1,kind=int64)*n2
1061 0 : if (ntot<=xmpi_maxint32_64) then
1062 0 : nn=n1*n2 ; my_dt=MPI_REAL ; my_op=MPI_SUM
1063 : else
1064 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_REAL,my_dt,my_op,MPI_SUM)
1065 : end if
1066 :
1067 : ! Accumulate xval on all proc. in comm
1068 : #if defined HAVE_MPI2_INPLACE
1069 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
1070 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
1071 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1072 : else
1073 : #endif
1074 0 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
1075 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_sp2d')
1076 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1077 0 : xval (:,:) = xsum(:,:)
1078 0 : ABI_FREE(xsum)
1079 : #if defined HAVE_MPI2_INPLACE
1080 : end if
1081 : #endif
1082 :
1083 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
1084 : end if
1085 : end if
1086 : #endif
1087 :
1088 0 : end subroutine xmpi_sum_sp2d
1089 : !!***
1090 :
1091 : !> wrapper arround xmpi_sum_sp2d than can be called in C/CUDA
1092 0 : subroutine xmpi_sum_sp2d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_sp2d_c")
1093 :
1094 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
1095 : implicit none
1096 :
1097 : ! dummy args
1098 : type(c_ptr), intent(inout) :: xval_ptr
1099 : integer(kind=c_int32_t), intent(in) :: xval_size(2)
1100 : integer(kind=c_int32_t), intent(in) :: comm
1101 : integer(kind=c_int32_t), intent(out) :: ier
1102 :
1103 : ! local vars
1104 : real(sp), pointer :: xval(:,:) => null()
1105 :
1106 : ! convert the c pointer into a fortran array
1107 0 : call c_f_pointer(xval_ptr, xval, xval_size)
1108 :
1109 0 : call xmpi_sum_sp2d(xval, comm, ier)
1110 :
1111 0 : end subroutine xmpi_sum_sp2d_c
1112 :
1113 : !----------------------------------------------------------------------
1114 :
1115 : !!****f* ABINIT/xmpi_sum_sp3d
1116 : !! NAME
1117 : !! xmpi_sum_sp3d
1118 : !!
1119 : !! FUNCTION
1120 : !! Combines values from all processes and distribute
1121 : !! the result back to all processes.
1122 : !! Target: double precision three-dimensional arrays.
1123 : !!
1124 : !! INPUTS
1125 : !! comm= MPI communicator
1126 : !!
1127 : !! OUTPUT
1128 : !! ier= exit status, a non-zero value meaning there is an error
1129 : !!
1130 : !! SIDE EFFECTS
1131 : !! xval= buffer array
1132 : !!
1133 : !! SOURCE
1134 :
1135 0 : subroutine xmpi_sum_sp3d(xval,comm,ier)
1136 :
1137 : !Arguments-------------------------
1138 : real(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
1139 : integer ,intent(in) :: comm
1140 : integer ,intent(out) :: ier
1141 :
1142 : !Local variables-------------------
1143 : #if defined HAVE_MPI
1144 : integer :: my_dt,my_op,n1,n2,n3,nn,nproc_space_comm
1145 : integer(kind=int64) :: ntot
1146 0 : real(sp),allocatable :: xsum(:,:,:)
1147 : #endif
1148 : ! *************************************************************************
1149 :
1150 0 : ier=0
1151 : #if defined HAVE_MPI
1152 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1153 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1154 0 : if (nproc_space_comm /= 1) then
1155 0 : n1 = size(xval,dim=1)
1156 0 : n2 = size(xval,dim=2)
1157 0 : n3 = size(xval,dim=3)
1158 :
1159 : !This product of dimensions can be greater than a 32bit integer
1160 : !We use a INT64 to store it. If it is too large, we switch to an
1161 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1162 0 : ntot=int(n1,kind=int64)*n2*n3
1163 0 : if (ntot<=xmpi_maxint32_64) then
1164 0 : nn=n1*n2*n3 ; my_dt=MPI_REAL ; my_op=MPI_SUM
1165 : else
1166 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_REAL,my_dt,my_op,MPI_SUM)
1167 : end if
1168 :
1169 : ! Accumulate xval on all proc. in comm
1170 : #if defined HAVE_MPI2_INPLACE
1171 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
1172 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
1173 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1174 : else
1175 : #endif
1176 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
1177 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_sp3d')
1178 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1179 0 : xval (:,:,:) = xsum(:,:,:)
1180 0 : ABI_FREE(xsum)
1181 : #if defined HAVE_MPI2_INPLACE
1182 : end if
1183 : #endif
1184 :
1185 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
1186 : end if
1187 : end if
1188 : #endif
1189 :
1190 0 : end subroutine xmpi_sum_sp3d
1191 : !!***
1192 :
1193 : !> wrapper arround xmpi_sum_sp3d than can be called in C/CUDA
1194 0 : subroutine xmpi_sum_sp3d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_sp3d_c")
1195 :
1196 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
1197 : implicit none
1198 :
1199 : ! dummy args
1200 : type(c_ptr), intent(inout) :: xval_ptr
1201 : integer(kind=c_int32_t), intent(in) :: xval_size(3)
1202 : integer(kind=c_int32_t), intent(in) :: comm
1203 : integer(kind=c_int32_t), intent(out) :: ier
1204 :
1205 : ! local vars
1206 : real(sp), pointer :: xval(:,:,:) => null()
1207 :
1208 : ! convert the c pointer into a fortran array
1209 0 : call c_f_pointer(xval_ptr, xval, xval_size)
1210 :
1211 0 : call xmpi_sum_sp3d(xval, comm, ier)
1212 :
1213 0 : end subroutine xmpi_sum_sp3d_c
1214 :
1215 : !----------------------------------------------------------------------
1216 :
1217 : !!****f* ABINIT/xmpi_sum_sp4d
1218 : !! NAME
1219 : !! xmpi_sum_sp4d
1220 : !!
1221 : !! FUNCTION
1222 : !! Combines values from all processes and distribute
1223 : !! the result back to all processes.
1224 : !! Target: double precision four-dimensional arrays.
1225 : !!
1226 : !! INPUTS
1227 : !! comm= MPI communicator
1228 : !!
1229 : !! OUTPUT
1230 : !! ier= exit status, a non-zero value meaning there is an error
1231 : !!
1232 : !! SIDE EFFECTS
1233 : !! xval= buffer array
1234 : !!
1235 : !! SOURCE
1236 0 : subroutine xmpi_sum_sp4d(xval,comm,ier)
1237 :
1238 : !Arguments-------------------------
1239 : real(sp),DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
1240 : integer ,intent(in) :: comm
1241 : integer ,intent(out) :: ier
1242 :
1243 : !Local variables-------------------
1244 : #if defined HAVE_MPI
1245 : integer :: my_dt,my_op,n1,n2,n3,n4,nn,nproc_space_comm
1246 : integer(kind=int64) :: ntot
1247 0 : real(sp),allocatable :: xsum(:,:,:,:)
1248 : #endif
1249 : ! *************************************************************************
1250 :
1251 0 : ier=0
1252 : #if defined HAVE_MPI
1253 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1254 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1255 0 : if (nproc_space_comm /= 1) then
1256 0 : n1 = size(xval,dim=1)
1257 0 : n2 = size(xval,dim=2)
1258 0 : n3 = size(xval,dim=3)
1259 0 : n4 = size(xval,dim=4)
1260 :
1261 : !This product of dimensions can be greater than a 32bit integer
1262 : !We use a INT64 to store it. If it is too large, we switch to an
1263 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1264 0 : ntot=int(n1,kind=int64)*n2*n3*n4
1265 0 : if (ntot<=xmpi_maxint32_64) then
1266 0 : nn=n1*n2*n3*n4 ; my_dt=MPI_REAL ; my_op=MPI_SUM
1267 : else
1268 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_REAL,my_dt,my_op,MPI_SUM)
1269 : end if
1270 :
1271 : ! Accumulate xval on all proc. in comm
1272 : #if defined HAVE_MPI2_INPLACE
1273 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
1274 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
1275 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1276 : else
1277 : #endif
1278 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
1279 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_sp4d')
1280 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1281 0 : xval (:,:,:,:) = xsum(:,:,:,:)
1282 0 : ABI_FREE(xsum)
1283 : #if defined HAVE_MPI2_INPLACE
1284 : endif
1285 : #endif
1286 :
1287 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
1288 : end if
1289 : end if
1290 : #endif
1291 :
1292 0 : end subroutine xmpi_sum_sp4d
1293 : !!***
1294 :
1295 : !> wrapper arround xmpi_sum_sp4d than can be called in C/CUDA
1296 0 : subroutine xmpi_sum_sp4d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_sp4d_c")
1297 :
1298 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
1299 : implicit none
1300 :
1301 : ! dummy args
1302 : type(c_ptr), intent(inout) :: xval_ptr
1303 : integer(kind=c_int32_t), intent(in) :: xval_size(4)
1304 : integer(kind=c_int32_t), intent(in) :: comm
1305 : integer(kind=c_int32_t), intent(out) :: ier
1306 :
1307 : ! local vars
1308 : real(sp), pointer :: xval(:,:,:,:) => null()
1309 :
1310 : ! convert the c pointer into a fortran array
1311 0 : call c_f_pointer(xval_ptr, xval, xval_size)
1312 :
1313 0 : call xmpi_sum_sp4d(xval, comm, ier)
1314 :
1315 0 : end subroutine xmpi_sum_sp4d_c
1316 :
1317 : !----------------------------------------------------------------------
1318 :
1319 : !!****f* ABINIT/xmpi_sum_sp5d
1320 : !! NAME
1321 : !! xmpi_sum_sp5d
1322 : !!
1323 : !! FUNCTION
1324 : !! Combines values from all processes and distribute
1325 : !! the result back to all processes.
1326 : !! Target: double precision five-dimensional arrays.
1327 : !!
1328 : !! INPUTS
1329 : !! comm= MPI communicator
1330 : !!
1331 : !! OUTPUT
1332 : !! ier= exit status, a non-zero value meaning there is an error
1333 : !!
1334 : !! SIDE EFFECTS
1335 : !! xval= buffer array
1336 : !!
1337 : !! SOURCE
1338 0 : subroutine xmpi_sum_sp5d(xval,comm,ier)
1339 :
1340 : !Arguments-------------------------
1341 : real(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
1342 : integer ,intent(in) :: comm
1343 : integer ,intent(out) :: ier
1344 :
1345 : !Local variables-------------------
1346 : #if defined HAVE_MPI
1347 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,nn,nproc_space_comm
1348 : integer(kind=int64) :: ntot
1349 0 : real(sp),allocatable :: xsum(:,:,:,:,:)
1350 : #endif
1351 : ! *************************************************************************
1352 :
1353 0 : ier=0
1354 : #if defined HAVE_MPI
1355 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1356 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1357 0 : if (nproc_space_comm /= 1) then
1358 0 : n1 = size(xval,dim=1)
1359 0 : n2 = size(xval,dim=2)
1360 0 : n3 = size(xval,dim=3)
1361 0 : n4 = size(xval,dim=4)
1362 0 : n5 = size(xval,dim=5)
1363 :
1364 : !This product of dimensions can be greater than a 32bit integer
1365 : !We use a INT64 to store it. If it is too large, we switch to an
1366 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1367 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5
1368 0 : if (ntot<=xmpi_maxint32_64) then
1369 0 : nn=n1*n2*n3*n4*n5 ; my_dt=MPI_REAL ; my_op=MPI_SUM
1370 : else
1371 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_REAL,my_dt,my_op,MPI_SUM)
1372 : end if
1373 :
1374 : ! Accumulate xval on all proc. in comm
1375 : #if defined HAVE_MPI2_INPLACE
1376 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
1377 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
1378 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1379 : else
1380 : #endif
1381 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5), ier)
1382 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_sp5d')
1383 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1384 0 : xval (:,:,:,:,:) = xsum(:,:,:,:,:)
1385 0 : ABI_FREE(xsum)
1386 : #if defined HAVE_MPI2_INPLACE
1387 : endif
1388 : #endif
1389 :
1390 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
1391 : end if
1392 : end if
1393 : #endif
1394 :
1395 0 : end subroutine xmpi_sum_sp5d
1396 : !!***
1397 :
1398 : !> wrapper arround xmpi_sum_sp5d than can be called in C/CUDA
1399 0 : subroutine xmpi_sum_sp5d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_sp5d_c")
1400 :
1401 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
1402 : implicit none
1403 :
1404 : ! dummy args
1405 : type(c_ptr), intent(inout) :: xval_ptr
1406 : integer(kind=c_int32_t), intent(in) :: xval_size(5)
1407 : integer(kind=c_int32_t), intent(in) :: comm
1408 : integer(kind=c_int32_t), intent(out) :: ier
1409 :
1410 : ! local vars
1411 : real(sp), pointer :: xval(:,:,:,:,:) => null()
1412 :
1413 : ! convert the c pointer into a fortran array
1414 0 : call c_f_pointer(xval_ptr, xval, xval_size)
1415 :
1416 0 : call xmpi_sum_sp5d(xval, comm, ier)
1417 :
1418 0 : end subroutine xmpi_sum_sp5d_c
1419 :
1420 : !----------------------------------------------------------------------
1421 :
1422 : !!****f* ABINIT/xmpi_sum_sp6d
1423 : !! NAME
1424 : !! xmpi_sum_sp6d
1425 : !!
1426 : !! FUNCTION
1427 : !! Combines values from all processes and distribute
1428 : !! the result back to all processes.
1429 : !! Target: double precision six-dimensional arrays.
1430 : !!
1431 : !! INPUTS
1432 : !! comm= MPI communicator
1433 : !!
1434 : !! OUTPUT
1435 : !! ier= exit status, a non-zero value meaning there is an error
1436 : !!
1437 : !! SIDE EFFECTS
1438 : !! xval= buffer array
1439 : !!
1440 : !! SOURCE
1441 0 : subroutine xmpi_sum_sp6d(xval,comm,ier)
1442 :
1443 : !Arguments-------------------------
1444 : real(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:)
1445 : integer ,intent(in) :: comm
1446 : integer ,intent(out) :: ier
1447 :
1448 : !Local variables-------------------
1449 : #if defined HAVE_MPI
1450 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6,nn,nproc_space_comm
1451 : integer(kind=int64) :: ntot
1452 0 : real(sp), allocatable :: xsum(:,:,:,:,:,:)
1453 : #endif
1454 : ! *************************************************************************
1455 :
1456 0 : ier=0
1457 : #if defined HAVE_MPI
1458 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1459 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1460 0 : if (nproc_space_comm /= 1) then
1461 0 : n1 = size(xval,dim=1)
1462 0 : n2 = size(xval,dim=2)
1463 0 : n3 = size(xval,dim=3)
1464 0 : n4 = size(xval,dim=4)
1465 0 : n5 = size(xval,dim=5)
1466 0 : n6 = size(xval,dim=6)
1467 :
1468 : !This product of dimensions can be greater than a 32bit integer
1469 : !We use a INT64 to store it. If it is too large, we switch to an
1470 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1471 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5*n6
1472 0 : if (ntot<=xmpi_maxint32_64) then
1473 0 : nn=n1*n2*n3*n4*n5*n6 ; my_dt=MPI_REAL ; my_op=MPI_SUM
1474 : else
1475 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_REAL,my_dt,my_op,MPI_SUM)
1476 : end if
1477 :
1478 : ! Accumulate xval on all proc. in comm
1479 : #if defined HAVE_MPI2_INPLACE
1480 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
1481 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
1482 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1483 : else
1484 : #endif
1485 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6), ier)
1486 0 : if (ier/=0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_sp6d')
1487 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1488 0 : xval (:,:,:,:,:,:) = xsum(:,:,:,:,:,:)
1489 0 : ABI_FREE(xsum)
1490 : #if defined HAVE_MPI2_INPLACE
1491 : end if
1492 : #endif
1493 :
1494 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
1495 : end if
1496 : end if
1497 : #endif
1498 :
1499 0 : end subroutine xmpi_sum_sp6d
1500 : !!***
1501 :
1502 : !> wrapper arround xmpi_sum_sp6d than can be called in C/CUDA
1503 0 : subroutine xmpi_sum_sp6d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_sp6d_c")
1504 :
1505 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
1506 : implicit none
1507 :
1508 : ! dummy args
1509 : type(c_ptr), intent(inout) :: xval_ptr
1510 : integer(kind=c_int32_t), intent(in) :: xval_size(6)
1511 : integer(kind=c_int32_t), intent(in) :: comm
1512 : integer(kind=c_int32_t), intent(out) :: ier
1513 :
1514 : ! local vars
1515 : real(sp), pointer :: xval(:,:,:,:,:,:) => null()
1516 :
1517 : ! convert the c pointer into a fortran array
1518 0 : call c_f_pointer(xval_ptr, xval, xval_size)
1519 :
1520 0 : call xmpi_sum_sp6d(xval, comm, ier)
1521 :
1522 0 : end subroutine xmpi_sum_sp6d_c
1523 :
1524 : !----------------------------------------------------------------------
1525 :
1526 : !!****f* ABINIT/xmpi_sum_sp7d
1527 : !! NAME
1528 : !! xmpi_sum_sp7d
1529 : !!
1530 : !! FUNCTION
1531 : !! Combines values from all processes and distribute
1532 : !! the result back to all processes.
1533 : !! Target: double precision six-dimensional arrays.
1534 : !!
1535 : !! INPUTS
1536 : !! comm= MPI communicator
1537 : !!
1538 : !! OUTPUT
1539 : !! ier= exit status, a non-zero value meaning there is an error
1540 : !!
1541 : !! SIDE EFFECTS
1542 : !! xval= buffer array
1543 : !!
1544 : !! SOURCE
1545 0 : subroutine xmpi_sum_sp7d(xval,comm,ier)
1546 :
1547 : !Arguments-------------------------
1548 : real(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:,:)
1549 : integer ,intent(in) :: comm
1550 : integer ,intent(out) :: ier
1551 :
1552 : !Local variables-------------------
1553 : #if defined HAVE_MPI
1554 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6,n7,nn,nproc_space_comm
1555 : integer(kind=int64) :: ntot
1556 0 : real(sp),allocatable :: xsum(:,:,:,:,:,:,:)
1557 : #endif
1558 : ! *************************************************************************
1559 0 : ier=0
1560 : #if defined HAVE_MPI
1561 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1562 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1563 0 : if (nproc_space_comm /= 1) then
1564 0 : n1 = size(xval,dim=1)
1565 0 : n2 = size(xval,dim=2)
1566 0 : n3 = size(xval,dim=3)
1567 0 : n4 = size(xval,dim=4)
1568 0 : n5 = size(xval,dim=5)
1569 0 : n6 = size(xval,dim=6)
1570 0 : n7 = size(xval,dim=7)
1571 :
1572 : !This product of dimensions can be greater than a 32bit integer
1573 : !We use a INT64 to store it. If it is too large, we switch to an
1574 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1575 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5*n6*n7
1576 0 : if (ntot<=xmpi_maxint32_64) then
1577 0 : nn=n1*n2*n3*n4*n5*n6*n7 ; my_dt=MPI_REAL ; my_op=MPI_SUM
1578 : else
1579 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_REAL,my_dt,my_op,MPI_SUM)
1580 : end if
1581 :
1582 : ! Accumulate xval on all proc. in comm
1583 : #if defined HAVE_MPI2_INPLACE
1584 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
1585 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
1586 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1587 : else
1588 : #endif
1589 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6,n7), ier)
1590 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_sp7d')
1591 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1592 0 : xval (:,:,:,:,:,:,:) = xsum(:,:,:,:,:,:,:)
1593 0 : ABI_FREE(xsum)
1594 : #if defined HAVE_MPI2_INPLACE
1595 : endif
1596 : #endif
1597 :
1598 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
1599 : end if
1600 : end if
1601 : #endif
1602 :
1603 0 : end subroutine xmpi_sum_sp7d
1604 : !!***
1605 :
1606 : !> wrapper arround xmpi_sum_sp7d than can be called in C/CUDA
1607 0 : subroutine xmpi_sum_sp7d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_sp7d_c")
1608 :
1609 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
1610 : implicit none
1611 :
1612 : ! dummy args
1613 : type(c_ptr), intent(inout) :: xval_ptr
1614 : integer(kind=c_int32_t), intent(in) :: xval_size(7)
1615 : integer(kind=c_int32_t), intent(in) :: comm
1616 : integer(kind=c_int32_t), intent(out) :: ier
1617 :
1618 : ! local vars
1619 : real(sp), pointer :: xval(:,:,:,:,:,:,:) => null()
1620 :
1621 : ! convert the c pointer into a fortran array
1622 0 : call c_f_pointer(xval_ptr, xval, xval_size)
1623 :
1624 0 : call xmpi_sum_sp7d(xval, comm, ier)
1625 :
1626 0 : end subroutine xmpi_sum_sp7d_c
1627 :
1628 :
1629 : !----------------------------------------------------------------------
1630 :
1631 : !!****f* ABINIT/xmpi_sum_dp2d
1632 : !! NAME
1633 : !! xmpi_sum_dp2d
1634 : !!
1635 : !! FUNCTION
1636 : !! Combines values from all processes and distribute
1637 : !! the result back to all processes.
1638 : !! Target: double precision two-dimensional arrays.
1639 : !!
1640 : !! INPUTS
1641 : !! comm= MPI communicator
1642 : !! use_omp_map= wether to use OpenMP GPU mapping (fefault: false)
1643 : !!
1644 : !! OUTPUT
1645 : !! ier= exit status, a non-zero value meaning there is an error
1646 : !!
1647 : !! SIDE EFFECTS
1648 : !! xval= buffer array
1649 : !!
1650 : !! SOURCE
1651 :
1652 65943258 : subroutine xmpi_sum_dp2d(xval,comm,ier,use_omp_map)
1653 :
1654 : !Arguments-------------------------
1655 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:)
1656 : integer ,intent(in) :: comm
1657 : logical ,intent(in), optional :: use_omp_map
1658 : integer ,intent(out) :: ier
1659 :
1660 : !Local variables-------------------
1661 : #if defined HAVE_MPI
1662 : integer :: my_dt,my_op,n1,n2,nn,nproc_space_comm
1663 : #ifdef HAVE_GPU_MPI
1664 : integer :: i1,i2
1665 : #endif
1666 : logical :: l_use_omp_map
1667 : integer(kind=int64) :: ntot
1668 65943258 : real(dp),allocatable :: xsum(:,:)
1669 : #endif
1670 : ! *************************************************************************
1671 :
1672 65943258 : ier=0
1673 : #if defined HAVE_MPI
1674 65943258 : l_use_omp_map=.false.
1675 65943258 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
1676 65943258 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1677 2475902 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1678 2475902 : if (nproc_space_comm /= 1) then
1679 2404454 : n1 = size(xval,dim=1)
1680 2404454 : n2 = size(xval,dim=2)
1681 :
1682 : !This product of dimensions can be greater than a 32bit integer
1683 : !We use a INT64 to store it. If it is too large, we switch to an
1684 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1685 2404454 : ntot=int(n1,kind=int64)*n2
1686 2404454 : if (ntot<=xmpi_maxint32_64) then
1687 2404454 : nn=n1*n2 ; my_dt=MPI_DOUBLE_PRECISION ; my_op=MPI_SUM
1688 : else
1689 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
1690 : end if
1691 :
1692 : ! Accumulate xval on all proc. in comm
1693 : #if defined HAVE_MPI2_INPLACE
1694 2404454 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
1695 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
1696 2404454 : if(.not. l_use_omp_map) then
1697 2404454 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1698 : else
1699 : #ifdef HAVE_OPENMP_OFFLOAD
1700 : #ifdef HAVE_GPU_MPI
1701 : ! Proper GPU-aware call
1702 : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
1703 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1704 : !$OMP END TARGET DATA
1705 : #else
1706 : !$OMP TARGET UPDATE FROM(xval)
1707 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1708 : !$OMP TARGET UPDATE TO(xval)
1709 : #endif
1710 : #endif
1711 : end if
1712 : else
1713 : #endif
1714 0 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
1715 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_dp2d')
1716 0 : if(.not. l_use_omp_map) then
1717 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1718 0 : xval (:,:) = xsum(:,:)
1719 : else
1720 : #ifdef HAVE_OPENMP_OFFLOAD
1721 : !$OMP TARGET ENTER DATA MAP(alloc:xsum)
1722 : #ifdef HAVE_GPU_MPI
1723 : ! Proper GPU-aware call
1724 : !$OMP TARGET DATA USE_DEVICE_ADDR(xval,xsum)
1725 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1726 : !$OMP END TARGET DATA
1727 : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO COLLAPSE(2) PRIVATE(i2,i1) MAP(to:xval,xsum)
1728 : do i2=1,n2
1729 : do i1=1,n1
1730 : xval(i1,i2)=xsum(i1,i2)
1731 : end do
1732 : end do
1733 : #else
1734 : !$OMP TARGET UPDATE FROM(xval)
1735 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1736 : xval (:,:) = xsum(:,:)
1737 : !$OMP TARGET UPDATE TO(xval)
1738 : #endif
1739 : !$OMP TARGET EXIT DATA MAP(delete:xsum)
1740 : #endif
1741 : end if
1742 0 : ABI_FREE(xsum)
1743 : #if defined HAVE_MPI2_INPLACE
1744 : endif
1745 : #endif
1746 :
1747 2404454 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
1748 : end if
1749 : end if
1750 : #endif
1751 :
1752 65943258 : end subroutine xmpi_sum_dp2d
1753 : !!***
1754 :
1755 : !> wrapper arround xmpi_sum_dp2d than can be called in C/CUDA
1756 0 : subroutine xmpi_sum_dp2d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_dp2d_c")
1757 :
1758 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
1759 : implicit none
1760 :
1761 : ! dummy args
1762 : type(c_ptr), intent(inout) :: xval_ptr
1763 : integer(kind=c_int32_t), intent(in) :: xval_size(2)
1764 : integer(kind=c_int32_t), intent(in) :: comm
1765 : integer(kind=c_int32_t), intent(out) :: ier
1766 :
1767 : ! local vars
1768 : real(dp), pointer :: xval(:,:) => null()
1769 :
1770 : ! convert the c pointer into a fortran array
1771 0 : call c_f_pointer(xval_ptr, xval, xval_size)
1772 :
1773 0 : call xmpi_sum_dp2d(xval, comm, ier)
1774 :
1775 0 : end subroutine xmpi_sum_dp2d_c
1776 :
1777 : !----------------------------------------------------------------------
1778 :
1779 : !!****f* ABINIT/xmpi_sum_dp3d
1780 : !! NAME
1781 : !! xmpi_sum_dp3d
1782 : !!
1783 : !! FUNCTION
1784 : !! Combines values from all processes and distribute
1785 : !! the result back to all processes.
1786 : !! Target: double precision three-dimensional arrays.
1787 : !!
1788 : !! INPUTS
1789 : !! comm= MPI communicator
1790 : !!
1791 : !! OUTPUT
1792 : !! ier= exit status, a non-zero value meaning there is an error
1793 : !!
1794 : !! SIDE EFFECTS
1795 : !! xval= buffer array
1796 : !!
1797 : !! SOURCE
1798 :
1799 5934427 : subroutine xmpi_sum_dp3d(xval,comm,ier,use_omp_map)
1800 :
1801 : !Arguments-------------------------
1802 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
1803 : integer ,intent(in) :: comm
1804 : logical ,intent(in), optional :: use_omp_map
1805 : integer ,intent(out) :: ier
1806 :
1807 : !Local variables-------------------
1808 : #if defined HAVE_MPI
1809 : integer :: my_dt,my_op,n1,n2,n3,nn,nproc_space_comm
1810 : #ifdef HAVE_GPU_MPI
1811 : integer :: i1,i2,i3
1812 : #endif
1813 : logical :: l_use_omp_map
1814 : integer(kind=int64) :: ntot
1815 5934427 : real(dp),allocatable :: xsum(:,:,:)
1816 : #endif
1817 : ! *************************************************************************
1818 :
1819 5934427 : ier=0
1820 : #if defined HAVE_MPI
1821 5934427 : l_use_omp_map=.false.
1822 5934427 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
1823 5934427 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1824 771772 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1825 771772 : if (nproc_space_comm /= 1) then
1826 116816 : n1 = size(xval,dim=1)
1827 116816 : n2 = size(xval,dim=2)
1828 116816 : n3 = size(xval,dim=3)
1829 :
1830 : !This product of dimensions can be greater than a 32bit integer
1831 : !We use a INT64 to store it. If it is too large, we switch to an
1832 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1833 116816 : ntot=int(n1,kind=int64)*n2*n3
1834 116816 : if (ntot<=xmpi_maxint32_64) then
1835 116816 : nn=n1*n2*n3 ; my_dt=MPI_DOUBLE_PRECISION ; my_op=MPI_SUM
1836 : else
1837 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
1838 : end if
1839 :
1840 : ! Accumulate xval on all proc. in comm
1841 : #if defined HAVE_MPI2_INPLACE
1842 116816 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
1843 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
1844 116816 : if(.not. l_use_omp_map) then
1845 116816 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1846 : else
1847 : #ifdef HAVE_OPENMP_OFFLOAD
1848 : #ifdef HAVE_GPU_MPI
1849 : ! Proper GPU-aware call
1850 : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
1851 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1852 : !$OMP END TARGET DATA
1853 : #else
1854 : !$OMP TARGET UPDATE FROM(xval)
1855 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1856 : !$OMP TARGET UPDATE TO(xval)
1857 : #endif
1858 : #endif
1859 : end if ! l_use_omp_map
1860 : else
1861 : #endif
1862 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
1863 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_dp3d')
1864 0 : if(.not. l_use_omp_map) then
1865 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1866 0 : xval (:,:,:) = xsum(:,:,:)
1867 : else
1868 : #ifdef HAVE_OPENMP_OFFLOAD
1869 : !$OMP TARGET ENTER DATA MAP(alloc:xsum)
1870 : #ifdef HAVE_GPU_MPI
1871 : ! Proper GPU-aware call
1872 : !$OMP TARGET DATA USE_DEVICE_ADDR(xval,xsum)
1873 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1874 : !$OMP END TARGET DATA
1875 : !$OMP TARGET TEAMS DISTRIBUTE PRIVATE(i3) MAP(to:xval,xsum)
1876 : do i3=1,n3
1877 : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i2,i1)
1878 : do i2=1,n2
1879 : do i1=1,n1
1880 : xval(i1,i2,i3)=xsum(i1,i2,i3)
1881 : end do
1882 : end do
1883 : end do
1884 : #else
1885 : !$OMP TARGET UPDATE FROM(xval)
1886 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1887 : xval (:,:,:) = xsum(:,:,:)
1888 : !$OMP TARGET UPDATE TO(xval)
1889 : #endif
1890 : !$OMP TARGET EXIT DATA MAP(delete:xsum)
1891 : #endif
1892 : end if ! l_use_omp_map
1893 0 : ABI_FREE(xsum)
1894 : #if defined HAVE_MPI2_INPLACE
1895 : endif
1896 : #endif
1897 :
1898 116816 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
1899 : end if
1900 : end if
1901 : #endif
1902 :
1903 5934427 : end subroutine xmpi_sum_dp3d
1904 : !!***
1905 :
1906 : !> wrapper arround xmpi_sum_dp3d than can be called in C/CUDA
1907 0 : subroutine xmpi_sum_dp3d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_dp3d_c")
1908 :
1909 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
1910 : implicit none
1911 :
1912 : ! dummy args
1913 : type(c_ptr), intent(inout) :: xval_ptr
1914 : integer(kind=c_int32_t), intent(in) :: xval_size(3)
1915 : integer(kind=c_int32_t), intent(in) :: comm
1916 : integer(kind=c_int32_t), intent(out) :: ier
1917 :
1918 : ! local vars
1919 : real(dp), pointer :: xval(:,:,:) => null()
1920 :
1921 : ! convert the c pointer into a fortran array
1922 0 : call c_f_pointer(xval_ptr, xval, xval_size)
1923 :
1924 0 : call xmpi_sum_dp3d(xval, comm, ier)
1925 :
1926 0 : end subroutine xmpi_sum_dp3d_c
1927 :
1928 : !----------------------------------------------------------------------
1929 :
1930 : !!****f* ABINIT/xmpi_sum_dp4d
1931 : !! NAME
1932 : !! xmpi_sum_dp4d
1933 : !!
1934 : !! FUNCTION
1935 : !! Combines values from all processes and distribute
1936 : !! the result back to all processes.
1937 : !! Target: double precision four-dimensional arrays.
1938 : !!
1939 : !! INPUTS
1940 : !! comm= MPI communicator
1941 : !!
1942 : !! OUTPUT
1943 : !! ier= exit status, a non-zero value meaning there is an error
1944 : !!
1945 : !! SIDE EFFECTS
1946 : !! xval= buffer array
1947 : !!
1948 : !! SOURCE
1949 :
1950 525337 : subroutine xmpi_sum_dp4d(xval,comm,ier)
1951 :
1952 : !Arguments-------------------------
1953 : real(dp),DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
1954 : integer ,intent(in) :: comm
1955 : integer ,intent(out) :: ier
1956 :
1957 : !Local variables-------------------
1958 : #if defined HAVE_MPI
1959 : integer :: my_dt,my_op,n1,n2,n3,n4,nn,nproc_space_comm
1960 : integer(kind=int64) :: ntot
1961 525337 : real(dp),allocatable :: xsum(:,:,:,:)
1962 : #endif
1963 : ! *************************************************************************
1964 :
1965 525337 : ier=0
1966 : #if defined HAVE_MPI
1967 525337 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1968 521335 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1969 521335 : if (nproc_space_comm /= 1) then
1970 520266 : n1 = size(xval,dim=1)
1971 520266 : n2 = size(xval,dim=2)
1972 520266 : n3 = size(xval,dim=3)
1973 520266 : n4 = size(xval,dim=4)
1974 :
1975 : !This product of dimensions can be greater than a 32bit integer
1976 : !We use a INT64 to store it. If it is too large, we switch to an
1977 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1978 520266 : ntot=int(n1,kind=int64)*n2*n3*n4
1979 520266 : if (ntot<=xmpi_maxint32_64) then
1980 520266 : nn=n1*n2*n3*n4 ; my_dt=MPI_DOUBLE_PRECISION ; my_op=MPI_SUM
1981 : else
1982 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
1983 : end if
1984 :
1985 : ! Accumulate xval on all proc. in comm
1986 : #if defined HAVE_MPI2_INPLACE
1987 520266 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
1988 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
1989 520266 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
1990 : else
1991 : #endif
1992 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
1993 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_dp4d')
1994 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
1995 0 : xval (:,:,:,:) = xsum(:,:,:,:)
1996 0 : ABI_FREE(xsum)
1997 : #if defined HAVE_MPI2_INPLACE
1998 : endif
1999 : #endif
2000 :
2001 520266 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
2002 : end if
2003 : end if
2004 : #endif
2005 :
2006 525337 : end subroutine xmpi_sum_dp4d
2007 : !!***
2008 :
2009 : !> wrapper arround xmpi_sum_dp4d than can be called in C/CUDA
2010 0 : subroutine xmpi_sum_dp4d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_dp4d_c")
2011 :
2012 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
2013 : implicit none
2014 :
2015 : ! dummy args
2016 : type(c_ptr), intent(inout) :: xval_ptr
2017 : integer(kind=c_int32_t), intent(in) :: xval_size(4)
2018 : integer(kind=c_int32_t), intent(in) :: comm
2019 : integer(kind=c_int32_t), intent(out) :: ier
2020 :
2021 : ! local vars
2022 : real(dp), pointer :: xval(:,:,:,:) => null()
2023 :
2024 : ! convert the c pointer into a fortran array
2025 0 : call c_f_pointer(xval_ptr, xval, xval_size)
2026 :
2027 0 : call xmpi_sum_dp4d(xval, comm, ier)
2028 :
2029 0 : end subroutine xmpi_sum_dp4d_c
2030 :
2031 : !----------------------------------------------------------------------
2032 :
2033 : !!****f* ABINIT/xmpi_sum_dp5d
2034 : !! NAME
2035 : !! xmpi_sum_dp5d
2036 : !!
2037 : !! FUNCTION
2038 : !! Combines values from all processes and distribute
2039 : !! the result back to all processes.
2040 : !! Target: double precision five-dimensional arrays.
2041 : !!
2042 : !! INPUTS
2043 : !! comm= MPI communicator
2044 : !!
2045 : !! OUTPUT
2046 : !! ier= exit status, a non-zero value meaning there is an error
2047 : !!
2048 : !! SIDE EFFECTS
2049 : !! xval= buffer array
2050 : !!
2051 : !! SOURCE
2052 :
2053 87167386 : subroutine xmpi_sum_dp5d(xval,comm,ier)
2054 :
2055 : !Arguments-------------------------
2056 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
2057 : integer ,intent(in) :: comm
2058 : integer ,intent(out) :: ier
2059 :
2060 : !Local variables-------------------
2061 : #if defined HAVE_MPI
2062 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,nn,nproc_space_comm
2063 : integer(kind=int64) :: ntot
2064 87167386 : real(dp),allocatable :: xsum(:,:,:,:,:)
2065 : #endif
2066 : ! *************************************************************************
2067 :
2068 87167386 : ier=0
2069 : #if defined HAVE_MPI
2070 87167386 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2071 1951190 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2072 1951190 : if (nproc_space_comm /= 1) then
2073 601586 : n1 = size(xval,dim=1)
2074 601586 : n2 = size(xval,dim=2)
2075 601586 : n3 = size(xval,dim=3)
2076 601586 : n4 = size(xval,dim=4)
2077 601586 : n5 = size(xval,dim=5)
2078 :
2079 : !This product of dimensions can be greater than a 32bit integer
2080 : !We use a INT64 to store it. If it is too large, we switch to an
2081 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
2082 601586 : ntot=int(n1,kind=int64)*n2*n3*n4*n5
2083 601586 : if (ntot<=xmpi_maxint32_64) then
2084 601586 : nn=n1*n2*n3*n4*n5 ; my_dt=MPI_DOUBLE_PRECISION ; my_op=MPI_SUM
2085 : else
2086 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
2087 : end if
2088 :
2089 : ! Accumulate xval on all proc. in comm
2090 : #if defined HAVE_MPI2_INPLACE
2091 601586 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
2092 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
2093 601586 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
2094 : else
2095 : #endif
2096 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5), ier)
2097 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_dp5d')
2098 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
2099 0 : xval (:,:,:,:,:) = xsum(:,:,:,:,:)
2100 0 : ABI_FREE(xsum)
2101 : #if defined HAVE_MPI2_INPLACE
2102 : endif
2103 : #endif
2104 :
2105 601586 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
2106 : end if
2107 : end if
2108 : #endif
2109 :
2110 87167386 : end subroutine xmpi_sum_dp5d
2111 : !!***
2112 :
2113 : !> wrapper arround xmpi_sum_dp5d than can be called in C/CUDA
2114 0 : subroutine xmpi_sum_dp5d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_dp5d_c")
2115 :
2116 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
2117 : implicit none
2118 :
2119 : ! dummy args
2120 : type(c_ptr), intent(inout) :: xval_ptr
2121 : integer(kind=c_int32_t), intent(in) :: xval_size(5)
2122 : integer(kind=c_int32_t), intent(in) :: comm
2123 : integer(kind=c_int32_t), intent(out) :: ier
2124 :
2125 : ! local vars
2126 : real(dp), pointer :: xval(:,:,:,:,:) => null()
2127 :
2128 : ! convert the c pointer into a fortran array
2129 0 : call c_f_pointer(xval_ptr, xval, xval_size)
2130 :
2131 0 : call xmpi_sum_dp5d(xval, comm, ier)
2132 :
2133 0 : end subroutine xmpi_sum_dp5d_c
2134 :
2135 : !----------------------------------------------------------------------
2136 :
2137 : !!****f* ABINIT/xmpi_sum_dp6d
2138 : !! NAME
2139 : !! xmpi_sum_dp6d
2140 : !!
2141 : !! FUNCTION
2142 : !! Combines values from all processes and distribute
2143 : !! the result back to all processes.
2144 : !! Target: double precision six-dimensional arrays.
2145 : !!
2146 : !! INPUTS
2147 : !! comm= MPI communicator
2148 : !!
2149 : !! OUTPUT
2150 : !! ier= exit status, a non-zero value meaning there is an error
2151 : !!
2152 : !! SIDE EFFECTS
2153 : !! xval= buffer array
2154 : !!
2155 : !! SOURCE
2156 6998811 : subroutine xmpi_sum_dp6d(xval,comm,ier)
2157 :
2158 : !Arguments-------------------------
2159 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:)
2160 : integer ,intent(in) :: comm
2161 : integer ,intent(out) :: ier
2162 :
2163 : !Local variables-------------------
2164 : #if defined HAVE_MPI
2165 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6,nn,nproc_space_comm
2166 : integer(kind=int64) :: ntot
2167 6998811 : real(dp), allocatable :: xsum(:,:,:,:,:,:)
2168 : #endif
2169 : ! *************************************************************************
2170 :
2171 6998811 : ier=0
2172 : #if defined HAVE_MPI
2173 6998811 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2174 33582 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2175 33582 : if (nproc_space_comm /= 1) then
2176 11758 : n1 = size(xval,dim=1)
2177 11758 : n2 = size(xval,dim=2)
2178 11758 : n3 = size(xval,dim=3)
2179 11758 : n4 = size(xval,dim=4)
2180 11758 : n5 = size(xval,dim=5)
2181 11758 : n6 = size(xval,dim=6)
2182 :
2183 : !This product of dimensions can be greater than a 32bit integer
2184 : !We use a INT64 to store it. If it is too large, we switch to an
2185 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
2186 11758 : ntot=int(n1,kind=int64)*n2*n3*n4*n5*n6
2187 11758 : if (ntot<=xmpi_maxint32_64) then
2188 11758 : nn=n1*n2*n3*n4*n5*n6 ; my_dt=MPI_DOUBLE_PRECISION ; my_op=MPI_SUM
2189 : else
2190 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
2191 : end if
2192 :
2193 : ! Accumulate xval on all proc. in comm
2194 : #if defined HAVE_MPI2_INPLACE
2195 11758 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
2196 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
2197 11758 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
2198 : else
2199 : #endif
2200 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6), ier)
2201 0 : if (ier/=0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_dp6d')
2202 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
2203 0 : xval (:,:,:,:,:,:) = xsum(:,:,:,:,:,:)
2204 0 : ABI_FREE(xsum)
2205 : #if defined HAVE_MPI2_INPLACE
2206 : endif
2207 : #endif
2208 :
2209 11758 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
2210 : end if
2211 : end if
2212 : #endif
2213 :
2214 6998811 : end subroutine xmpi_sum_dp6d
2215 : !!***
2216 :
2217 : !> wrapper arround xmpi_sum_dp6d than can be called in C/CUDA
2218 0 : subroutine xmpi_sum_dp6d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_dp6d_c")
2219 :
2220 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
2221 : implicit none
2222 :
2223 : ! dummy args
2224 : type(c_ptr), intent(inout) :: xval_ptr
2225 : integer(kind=c_int32_t), intent(in) :: xval_size(6)
2226 : integer(kind=c_int32_t), intent(in) :: comm
2227 : integer(kind=c_int32_t), intent(out) :: ier
2228 :
2229 : ! local vars
2230 : real(dp), pointer :: xval(:,:,:,:,:,:) => null()
2231 :
2232 : ! convert the c pointer into a fortran array
2233 0 : call c_f_pointer(xval_ptr, xval, xval_size)
2234 :
2235 0 : call xmpi_sum_dp6d(xval, comm, ier)
2236 :
2237 0 : end subroutine xmpi_sum_dp6d_c
2238 :
2239 : !----------------------------------------------------------------------
2240 :
2241 : !!****f* ABINIT/xmpi_sum_dp7d
2242 : !! NAME
2243 : !! xmpi_sum_dp7d
2244 : !!
2245 : !! FUNCTION
2246 : !! Combines values from all processes and distribute
2247 : !! the result back to all processes.
2248 : !! Target: double precision six-dimensional arrays.
2249 : !!
2250 : !! INPUTS
2251 : !! comm= MPI communicator
2252 : !!
2253 : !! OUTPUT
2254 : !! ier= exit status, a non-zero value meaning there is an error
2255 : !!
2256 : !! SIDE EFFECTS
2257 : !! xval= buffer array
2258 : !!
2259 : !! SOURCE
2260 :
2261 248 : subroutine xmpi_sum_dp7d(xval,comm,ier)
2262 :
2263 : !Arguments-------------------------
2264 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:,:)
2265 : integer ,intent(in) :: comm
2266 : integer ,intent(out) :: ier
2267 :
2268 : !Local variables-------------------
2269 : #if defined HAVE_MPI
2270 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6,n7,nn,nproc_space_comm
2271 : integer(kind=int64) :: ntot
2272 248 : real(dp),allocatable :: xsum(:,:,:,:,:,:,:)
2273 : #endif
2274 : ! *************************************************************************
2275 248 : ier=0
2276 : #if defined HAVE_MPI
2277 248 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2278 245 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2279 245 : if (nproc_space_comm /= 1) then
2280 84 : n1 = size(xval,dim=1)
2281 84 : n2 = size(xval,dim=2)
2282 84 : n3 = size(xval,dim=3)
2283 84 : n4 = size(xval,dim=4)
2284 84 : n5 = size(xval,dim=5)
2285 84 : n6 = size(xval,dim=6)
2286 84 : n7 = size(xval,dim=7)
2287 :
2288 : !This product of dimensions can be greater than a 32bit integer
2289 : !We use a INT64 to store it. If it is too large, we switch to an
2290 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
2291 84 : ntot=int(n1,kind=int64)*n2*n3*n4*n5*n6*n7
2292 84 : if (ntot<=xmpi_maxint32_64) then
2293 84 : nn=n1*n2*n3*n4*n5*n6*n7 ; my_dt=MPI_DOUBLE_PRECISION ; my_op=MPI_SUM
2294 : else
2295 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
2296 : end if
2297 :
2298 : ! Accumulate xval on all proc. in comm
2299 : #if defined HAVE_MPI2_INPLACE
2300 84 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
2301 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
2302 84 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
2303 : else
2304 : #endif
2305 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6,n7), ier)
2306 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_dp7d')
2307 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
2308 0 : xval (:,:,:,:,:,:,:) = xsum(:,:,:,:,:,:,:)
2309 0 : ABI_FREE(xsum)
2310 : #if defined HAVE_MPI2_INPLACE
2311 : endif
2312 : #endif
2313 :
2314 84 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
2315 : end if
2316 : end if
2317 : #endif
2318 :
2319 248 : end subroutine xmpi_sum_dp7d
2320 : !!***
2321 :
2322 : !> wrapper arround xmpi_sum_dp7d than can be called in C/CUDA
2323 0 : subroutine xmpi_sum_dp7d_c(xval_ptr,xval_size,comm,ier) bind(c, name="xmpi_sum_dp7d_c")
2324 :
2325 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_int32_t
2326 : implicit none
2327 :
2328 : ! dummy args
2329 : type(c_ptr), intent(inout) :: xval_ptr
2330 : integer(kind=c_int32_t), intent(in) :: xval_size(7)
2331 : integer(kind=c_int32_t), intent(in) :: comm
2332 : integer(kind=c_int32_t), intent(out) :: ier
2333 :
2334 : ! local vars
2335 : real(dp), pointer :: xval(:,:,:,:,:,:,:) => null()
2336 :
2337 : ! convert the c pointer into a fortran array
2338 0 : call c_f_pointer(xval_ptr, xval, xval_size)
2339 :
2340 0 : call xmpi_sum_dp7d(xval, comm, ier)
2341 :
2342 0 : end subroutine xmpi_sum_dp7d_c
2343 :
2344 : !----------------------------------------------------------------------
2345 :
2346 : !!****f* ABINIT/xmpi_sum_dp2t
2347 : !! NAME
2348 : !! xmpi_sum_dp2t
2349 : !!
2350 : !! FUNCTION
2351 : !! Combines values from all processes and distribute
2352 : !! the result back to all processes.
2353 : !! Target: double precision one-dimensional array without transfers.
2354 : !!
2355 : !! INPUTS
2356 : !! n1= first dimension of the array
2357 : !! comm= MPI communicator
2358 : !!
2359 : !! OUTPUT
2360 : !! ier= exit status, a non-zero value meaning there is an error
2361 : !!
2362 : !! SIDE EFFECTS
2363 : !! xval= buffer array
2364 : !! xsum= receive buffer
2365 : !!
2366 : !! SOURCE
2367 :
2368 11415 : subroutine xmpi_sum_dp2t(xval,xsum,n1,comm,ier)
2369 :
2370 : !Arguments-------------------------
2371 : real(dp), DEV_CONTARRD intent(inout) :: xval(:),xsum(:)
2372 : integer ,intent(in) :: n1
2373 : integer ,intent(in) :: comm
2374 : integer ,intent(out) :: ier
2375 : ! *************************************************************************
2376 :
2377 11415 : ier=0
2378 : #if defined HAVE_MPI
2379 11415 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2380 : ! Accumulate xval on all proc. in comm
2381 11398 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
2382 : else
2383 : #endif
2384 457 : xsum=xval
2385 : #if defined HAVE_MPI
2386 : end if
2387 : #endif
2388 :
2389 11415 : end subroutine xmpi_sum_dp2t
2390 : !!***
2391 :
2392 : !----------------------------------------------------------------------
2393 :
2394 : !!****f* ABINIT/xmpi_sum_dp2d2t
2395 : !! NAME
2396 : !! xmpi_sum_dp2d2t
2397 : !!
2398 : !! FUNCTION
2399 : !! Combines values from all processes and distribute
2400 : !! the result back to all processes.
2401 : !! Target: double precisions bi-dimensional array
2402 : !!
2403 : !! INPUTS
2404 : !! n = total send size
2405 : !! xval= buffer array
2406 : !! comm= MPI communicator
2407 : !!
2408 : !! OUTPUT
2409 : !! xsum= receive buffer
2410 : !! ier= exit status, a non-zero value meaning there is an error
2411 : !!
2412 : !! SOURCE
2413 :
2414 0 : subroutine xmpi_sum_dp2d2t(xval,xsum,n,comm,ier)
2415 :
2416 : !Arguments-------------------------
2417 : real(dp), DEV_CONTARRD intent(in) :: xval(:,:)
2418 : real(dp), DEV_CONTARRD intent(out) :: xsum(:,:)
2419 : integer ,intent(in) :: n
2420 : integer ,intent(in) :: comm
2421 : integer ,intent(out) :: ier
2422 : ! *************************************************************************
2423 :
2424 0 : ier=0
2425 : #if defined HAVE_MPI
2426 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2427 : ! Accumulate xval on all proc. in comm
2428 0 : call MPI_ALLREDUCE(xval,xsum,n,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
2429 : else
2430 : #endif
2431 0 : xsum=xval
2432 : #if defined HAVE_MPI
2433 : end if
2434 : #endif
2435 :
2436 0 : end subroutine xmpi_sum_dp2d2t
2437 : !!***
2438 :
2439 : !----------------------------------------------------------------------
2440 :
2441 : !!****f* ABINIT/xmpi_sum_dp3d2t
2442 : !! NAME
2443 : !! xmpi_sum_dp3d2t
2444 : !!
2445 : !! FUNCTION
2446 : !! Combines values from all processes and distribute
2447 : !! the result back to all processes.
2448 : !! Target: double precision three-dimensional array without transfers.
2449 : !!
2450 : !! INPUTS
2451 : !! n1= first dimension of the array
2452 : !! comm= MPI communicator
2453 : !!
2454 : !! OUTPUT
2455 : !! ier= exit status, a non-zero value meaning there is an error
2456 : !!
2457 : !! SIDE EFFECTS
2458 : !! xval= buffer array
2459 : !! xsum= receive buffer
2460 : !!
2461 : !! SOURCE
2462 :
2463 0 : subroutine xmpi_sum_dp3d2t(xval,xsum,n1,comm,ier)
2464 :
2465 : !Arguments-------------------------
2466 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:),xsum(:,:,:)
2467 : integer ,intent(in) :: n1
2468 : integer ,intent(in) :: comm
2469 : integer ,intent(out) :: ier
2470 : ! *************************************************************************
2471 :
2472 0 : ier=0
2473 : #if defined HAVE_MPI
2474 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2475 : ! Accumulate xval on all proc. in comm
2476 0 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
2477 : else
2478 : #endif
2479 0 : xsum=xval
2480 : #if defined HAVE_MPI
2481 : end if
2482 : #endif
2483 :
2484 0 : end subroutine xmpi_sum_dp3d2t
2485 : !!***
2486 :
2487 : !----------------------------------------------------------------------
2488 :
2489 : !!****f* ABINIT/xmpi_sum_dp4d2t
2490 : !! NAME
2491 : !! xmpi_sum_dp4d2t
2492 : !!
2493 : !! FUNCTION
2494 : !! Combines values from all processes and distribute
2495 : !! the result back to all processes.
2496 : !! Target: double precision four-dimensional array without transfers.
2497 : !!
2498 : !! INPUTS
2499 : !! n1= first dimension of the array
2500 : !! comm= MPI communicator
2501 : !!
2502 : !! OUTPUT
2503 : !! ier= exit status, a non-zero value meaning there is an error
2504 : !!
2505 : !! SIDE EFFECTS
2506 : !! xval= buffer array
2507 : !! xsum= receive buffer
2508 : !!
2509 : !! SOURCE
2510 :
2511 0 : subroutine xmpi_sum_dp4d2t(xval,xsum,n1,comm,ier)
2512 :
2513 : !Arguments-------------------------
2514 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:),xsum(:,:,:,:)
2515 : integer ,intent(in) :: n1
2516 : integer ,intent(in) :: comm
2517 : integer ,intent(out) :: ier
2518 : ! *************************************************************************
2519 :
2520 0 : ier=0
2521 : #if defined HAVE_MPI
2522 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2523 : ! Accumulate xval on all proc. in comm
2524 0 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
2525 : else
2526 : #endif
2527 0 : xsum=xval
2528 : #if defined HAVE_MPI
2529 : end if
2530 : #endif
2531 :
2532 0 : end subroutine xmpi_sum_dp4d2t
2533 : !!***
2534 :
2535 : !----------------------------------------------------------------------
2536 :
2537 : !!****f* ABINIT/xmpi_sum_c0dc
2538 : !! NAME
2539 : !! xmpi_sum_c0dc
2540 : !!
2541 : !! FUNCTION
2542 : !! Combines values from all processes and distribute the result back to all processes.
2543 : !! Target: double complex scalar
2544 : !!
2545 : !! INPUTS
2546 : !! comm= MPI communicator
2547 : !!
2548 : !! OUTPUT
2549 : !! ier= exit status, a non-zero value meaning there is an error
2550 : !!
2551 : !! SIDE EFFECTS
2552 : !! xval= scalar to be summed.
2553 : !!
2554 : !! SOURCE
2555 :
2556 351836 : subroutine xmpi_sum_c0dc(xval,comm,ier)
2557 :
2558 : !Arguments-------------------------
2559 : complex(dp),intent(inout) :: xval
2560 : integer,intent(in) :: comm
2561 : integer,intent(out) :: ier
2562 :
2563 : !Local variables-------------------
2564 : #if defined HAVE_MPI
2565 : integer :: nproc_space_comm
2566 : complex(dp) :: arr_xsum(1),arr_xval(1)
2567 : #endif
2568 : ! *************************************************************************
2569 :
2570 351836 : ier=0
2571 : #if defined HAVE_MPI
2572 351836 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2573 334558 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2574 334558 : if (nproc_space_comm /= 1) then
2575 : ! Accumulate xval on all proc. in comm
2576 2640 : arr_xval(1) = xval
2577 2640 : call MPI_ALLREDUCE(arr_xval,arr_xsum,1,MPI_DOUBLE_COMPLEX,MPI_SUM,comm,ier)
2578 2640 : xval = arr_xsum(1)
2579 : end if
2580 : end if
2581 : #endif
2582 :
2583 351836 : end subroutine xmpi_sum_c0dc
2584 : !!***
2585 :
2586 : !----------------------------------------------------------------------
2587 :
2588 : !!****f* ABINIT/xmpi_sum_c0sc
2589 : !! NAME
2590 : !! xmpi_sum_c0sc
2591 : !!
2592 : !! FUNCTION
2593 : !! Combines values from all processes and distribute the result back to all processes.
2594 : !! Target: single-precision complex scalar
2595 : !!
2596 : !! INPUTS
2597 : !! comm= MPI communicator
2598 : !!
2599 : !! OUTPUT
2600 : !! ier= exit status, a non-zero value meaning there is an error
2601 : !!
2602 : !! SIDE EFFECTS
2603 : !! xval= scalar to be summed.
2604 : !!
2605 : !! SOURCE
2606 :
2607 0 : subroutine xmpi_sum_c0sc(xval,comm,ier)
2608 :
2609 : !Arguments-------------------------
2610 : complex(sp),intent(inout) :: xval
2611 : integer,intent(in) :: comm
2612 : integer,intent(out) :: ier
2613 :
2614 : !Local variables-------------------
2615 : #if defined HAVE_MPI
2616 : integer :: nproc_space_comm
2617 : complex(sp) :: arr_xsum(1),arr_xval(1)
2618 : #endif
2619 : ! *************************************************************************
2620 :
2621 0 : ier=0
2622 : #if defined HAVE_MPI
2623 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2624 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2625 0 : if (nproc_space_comm /= 1) then
2626 : ! Accumulate xval on all proc. in comm
2627 0 : arr_xval(1) = xval
2628 0 : call MPI_ALLREDUCE(arr_xval,arr_xsum,1,MPI_COMPLEX,MPI_SUM,comm,ier)
2629 0 : xval = arr_xsum(1)
2630 : end if
2631 : end if
2632 : #endif
2633 :
2634 0 : end subroutine xmpi_sum_c0sc
2635 : !!***
2636 :
2637 : !----------------------------------------------------------------------
2638 :
2639 : !!****f* ABINIT/xmpi_sum_c1dc
2640 : !! NAME
2641 : !! xmpi_sum_c1dc
2642 : !!
2643 : !! FUNCTION
2644 : !! Combines values from all processes and distribute
2645 : !! the result back to all processes.
2646 : !! Target: one-dimensional double complex arrays.
2647 : !!
2648 : !! INPUTS
2649 : !! comm= MPI communicator
2650 : !!
2651 : !! OUTPUT
2652 : !! ier= exit status, a non-zero value meaning there is an error
2653 : !!
2654 : !! SIDE EFFECTS
2655 : !! xval= buffer array
2656 : !!
2657 : !! SOURCE
2658 :
2659 42432 : subroutine xmpi_sum_c1dc(xval,comm,ier)
2660 :
2661 : !Arguments-------------------------
2662 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:)
2663 : integer,intent(in) :: comm
2664 : integer,intent(out) :: ier
2665 :
2666 : !Local variables-------------------
2667 : #if defined HAVE_MPI
2668 : integer :: n1,nproc_space_comm
2669 42432 : complex(dp) , allocatable :: xsum(:)
2670 : #endif
2671 : ! *************************************************************************
2672 :
2673 42432 : ier=0
2674 : #if defined HAVE_MPI
2675 42432 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2676 38291 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2677 38291 : if (nproc_space_comm /= 1) then
2678 9988 : n1 =size(xval,dim=1)
2679 :
2680 : ! Accumulate xval on all proc. in comm
2681 : #if defined HAVE_MPI2_INPLACE
2682 9988 : if (xmpi_use_inplace_operations) then
2683 9988 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,n1,MPI_DOUBLE_COMPLEX,MPI_SUM,comm,ier)
2684 : else
2685 : #endif
2686 0 : ABI_STAT_MALLOC(xsum,(n1), ier)
2687 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c1dc')
2688 0 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_DOUBLE_COMPLEX,MPI_SUM,comm,ier)
2689 0 : xval (:) = xsum(:)
2690 0 : ABI_FREE(xsum)
2691 : #if defined HAVE_MPI2_INPLACE
2692 : endif
2693 : #endif
2694 :
2695 : end if
2696 : end if
2697 : #endif
2698 :
2699 42432 : end subroutine xmpi_sum_c1dc
2700 : !!***
2701 :
2702 : !----------------------------------------------------------------------
2703 :
2704 : !!****f* ABINIT/xmpi_sum_c2dc
2705 : !! NAME
2706 : !! xmpi_sum_c2dc
2707 : !!
2708 : !! FUNCTION
2709 : !! Combines values from all processes and distribute
2710 : !! the result back to all processes.
2711 : !! Target: two-dimensional double complex arrays.
2712 : !!
2713 : !! INPUTS
2714 : !! comm= MPI communicator
2715 : !!
2716 : !! OUTPUT
2717 : !! ier= exit status, a non-zero value meaning there is an error
2718 : !!
2719 : !! SIDE EFFECTS
2720 : !! xval= buffer array
2721 : !!
2722 : !! SOURCE
2723 :
2724 4447673 : subroutine xmpi_sum_c2dc(xval,comm,ier,use_omp_map)
2725 :
2726 : !Arguments-------------------------
2727 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:)
2728 : integer,intent(in) :: comm
2729 : logical,intent(in), optional :: use_omp_map
2730 : integer,intent(out) :: ier
2731 :
2732 : !Local variables-------------------
2733 : #if defined HAVE_MPI
2734 : integer :: my_dt,my_op,n1,n2,nn,nproc_space_comm
2735 : #ifdef HAVE_GPU_MPI
2736 : integer :: i1,i2
2737 : #endif
2738 : logical :: l_use_omp_map
2739 : integer(kind=int64) :: ntot
2740 4447673 : complex(dp),allocatable :: xsum(:,:)
2741 : #endif
2742 : ! *************************************************************************
2743 :
2744 4447673 : ier=0
2745 : #if defined HAVE_MPI
2746 4447673 : l_use_omp_map=.false.
2747 4447673 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
2748 4447673 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2749 4425673 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2750 4425673 : if (nproc_space_comm /= 1) then
2751 4413382 : n1 =size(xval,dim=1)
2752 4413382 : n2 =size(xval,dim=2)
2753 :
2754 : !This product of dimensions can be greater than a 32bit integer
2755 : !We use a INT64 to store it. If it is too large, we switch to an
2756 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
2757 4413382 : ntot=int(n1,kind=int64)*n2
2758 4413382 : if (ntot<=xmpi_maxint32_64) then
2759 4413382 : nn=n1*n2 ; my_dt=MPI_DOUBLE_COMPLEX ; my_op=MPI_SUM
2760 : else
2761 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
2762 : end if
2763 :
2764 : ! Accumulate xval on all proc. in comm
2765 : #if defined HAVE_MPI2_INPLACE
2766 4413382 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
2767 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
2768 4413382 : if(.not. l_use_omp_map) then
2769 4413382 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
2770 : else
2771 : #ifdef HAVE_OPENMP_OFFLOAD
2772 : #ifdef HAVE_GPU_MPI
2773 : ! Proper GPU-aware call
2774 : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
2775 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
2776 : !$OMP END TARGET DATA
2777 : #else
2778 : !$OMP TARGET UPDATE FROM(xval)
2779 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
2780 : !$OMP TARGET UPDATE TO(xval)
2781 : #endif
2782 : #endif
2783 : end if ! use_omp_map
2784 : else
2785 : #endif
2786 0 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
2787 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c2dc')
2788 0 : if(.not. l_use_omp_map) then
2789 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
2790 0 : xval (:,:) = xsum(:,:)
2791 : else
2792 : #ifdef HAVE_OPENMP_OFFLOAD
2793 : !$OMP TARGET ENTER DATA MAP(alloc:xsum)
2794 : #ifdef HAVE_GPU_MPI
2795 : ! Proper GPU-aware call
2796 : !$OMP TARGET DATA USE_DEVICE_ADDR(xval,xsum)
2797 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
2798 : !$OMP END TARGET DATA
2799 : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO COLLAPSE(2) PRIVATE(i2,i1) MAP(to:xval,xsum)
2800 : do i2=1,n2
2801 : do i1=1,n1
2802 : xval(i1,i2)=xsum(i1,i2)
2803 : end do
2804 : end do
2805 : #else
2806 : !$OMP TARGET UPDATE FROM(xval)
2807 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
2808 : xval (:,:) = xsum(:,:)
2809 : !$OMP TARGET UPDATE TO(xval)
2810 : #endif
2811 : !$OMP TARGET EXIT DATA MAP(delete:xsum)
2812 : #endif
2813 : end if
2814 0 : ABI_FREE(xsum)
2815 : #if defined HAVE_MPI2_INPLACE
2816 : end if
2817 : #endif
2818 :
2819 4413382 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
2820 : end if
2821 : end if
2822 : #endif
2823 :
2824 4447673 : end subroutine xmpi_sum_c2dc
2825 : !!***
2826 :
2827 : !----------------------------------------------------------------------
2828 :
2829 : !!****f* ABINIT/xmpi_sum_c3dc
2830 : !! NAME
2831 : !! xmpi_sum_c3dc
2832 : !!
2833 : !! FUNCTION
2834 : !! Combines values from all processes and distribute
2835 : !! the result back to all processes.
2836 : !! Target: three-dimensional double complex arrays.
2837 : !!
2838 : !! INPUTS
2839 : !! comm= MPI communicator
2840 : !!
2841 : !! OUTPUT
2842 : !! ier= exit status, a non-zero value meaning there is an error
2843 : !!
2844 : !! SIDE EFFECTS
2845 : !! xval= buffer array
2846 : !!
2847 : !! SOURCE
2848 :
2849 1956 : subroutine xmpi_sum_c3dc(xval,comm,ier)
2850 :
2851 : !Arguments-------------------------
2852 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
2853 : integer,intent(in) :: comm
2854 : integer,intent(out) :: ier
2855 :
2856 : !Local variables-------------------
2857 : #if defined HAVE_MPI
2858 : integer :: my_dt,my_op,n1,n2,n3,nn,nproc_space_comm
2859 : integer(kind=int64) :: ntot
2860 1956 : complex(dp),allocatable :: xsum(:,:,:)
2861 : #endif
2862 : ! *************************************************************************
2863 :
2864 1956 : ier=0
2865 : #if defined HAVE_MPI
2866 1956 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2867 1954 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2868 1954 : if (nproc_space_comm /= 1) then
2869 298 : n1 =size(xval,dim=1)
2870 298 : n2 =size(xval,dim=2)
2871 298 : n3 =size(xval,dim=3)
2872 :
2873 : !This product of dimensions can be greater than a 32bit integer
2874 : !We use a INT64 to store it. If it is too large, we switch to an
2875 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
2876 298 : ntot=int(n1,kind=int64)*n2*n3
2877 298 : if (ntot<=xmpi_maxint32_64) then
2878 298 : nn=n1*n2*n3 ; my_dt=MPI_DOUBLE_COMPLEX ; my_op=MPI_SUM
2879 : else
2880 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
2881 : end if
2882 :
2883 : ! Accumulate xval on all proc. in comm
2884 : #if defined HAVE_MPI2_INPLACE
2885 298 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
2886 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
2887 298 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
2888 : else
2889 : #endif
2890 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
2891 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c3dc')
2892 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
2893 0 : xval (:,:,:) = xsum(:,:,:)
2894 0 : ABI_FREE(xsum)
2895 : #if defined HAVE_MPI2_INPLACE
2896 : end if
2897 : #endif
2898 :
2899 298 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
2900 : end if
2901 : end if
2902 : #endif
2903 :
2904 1956 : end subroutine xmpi_sum_c3dc
2905 : !!***
2906 :
2907 : !----------------------------------------------------------------------
2908 :
2909 : !!****f* ABINIT/xmpi_sum_c4dc
2910 : !! NAME
2911 : !! xmpi_sum_c4dc
2912 : !!
2913 : !! FUNCTION
2914 : !! Combines values from all processes and distribute
2915 : !! the result back to all processes.
2916 : !! Target: four-dimensional double complex arrays.
2917 : !!
2918 : !! INPUTS
2919 : !! comm= MPI communicator
2920 : !!
2921 : !! OUTPUT
2922 : !! ier= exit status, a non-zero value meaning there is an error
2923 : !!
2924 : !! SIDE EFFECTS
2925 : !! xval= buffer array
2926 : !!
2927 : !! SOURCE
2928 :
2929 288352 : subroutine xmpi_sum_c4dc(xval,comm,ier)
2930 :
2931 : !Arguments-------------------------
2932 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
2933 : integer,intent(in) :: comm
2934 : integer,intent(out) :: ier
2935 :
2936 : !Local variables-------------------
2937 : #if defined HAVE_MPI
2938 : integer :: my_dt,my_op,n1,n2,n3,n4,nn,nproc_space_comm
2939 : integer(kind=int64) :: ntot
2940 288352 : complex(dp),allocatable :: xsum(:,:,:,:)
2941 : #endif
2942 : ! *************************************************************************
2943 :
2944 288352 : ier=0
2945 : #if defined HAVE_MPI
2946 288352 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2947 285064 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2948 285064 : if (nproc_space_comm /= 1) then
2949 3926 : n1 =size(xval,dim=1)
2950 3926 : n2 =size(xval,dim=2)
2951 3926 : n3 =size(xval,dim=3)
2952 3926 : n4 =size(xval,dim=4)
2953 :
2954 : !This product of dimensions can be greater than a 32bit integer
2955 : !We use a INT64 to store it. If it is too large, we switch to an
2956 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
2957 3926 : ntot=int(n1,kind=int64)*n2*n3*n4
2958 3926 : if (ntot<=xmpi_maxint32_64) then
2959 3926 : nn=n1*n2*n3*n4 ; my_dt=MPI_DOUBLE_COMPLEX ; my_op=MPI_SUM
2960 : else
2961 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
2962 : end if
2963 :
2964 : ! Accumulate xval on all proc. in comm
2965 : #if defined HAVE_MPI2_INPLACE
2966 3926 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
2967 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
2968 3926 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
2969 : else
2970 : #endif
2971 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
2972 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c4dc')
2973 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
2974 0 : xval (:,:,:,:) = xsum(:,:,:,:)
2975 0 : ABI_FREE(xsum)
2976 : #if defined HAVE_MPI2_INPLACE
2977 : endif
2978 : #endif
2979 :
2980 3926 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
2981 : end if
2982 : end if
2983 : #endif
2984 :
2985 288352 : end subroutine xmpi_sum_c4dc
2986 : !!***
2987 :
2988 : !----------------------------------------------------------------------
2989 :
2990 : !!****f* ABINIT/xmpi_sum_c5dc
2991 : !! NAME
2992 : !! xmpi_sum_c5dc
2993 : !!
2994 : !! FUNCTION
2995 : !! Combines values from all processes and distribute the result back to all processes.
2996 : !! Target: five-dimensional double precision complex arrays.
2997 : !!
2998 : !! INPUTS
2999 : !! comm= MPI communicator
3000 : !!
3001 : !! OUTPUT
3002 : !! ier= exit status, a non-zero value meaning there is an error
3003 : !!
3004 : !! SIDE EFFECTS
3005 : !! xval= buffer array
3006 : !!
3007 : !! SOURCE
3008 :
3009 667 : subroutine xmpi_sum_c5dc(xval,comm,ier)
3010 :
3011 : !Arguments-------------------------
3012 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
3013 : integer,intent(in) :: comm
3014 : integer,intent(out) :: ier
3015 :
3016 : !Local variables-------------------
3017 : #if defined HAVE_MPI
3018 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,nn,nproc_space_comm
3019 : integer(kind=int64) :: ntot
3020 667 : complex(dp),allocatable :: xsum(:,:,:,:,:)
3021 : #endif
3022 : ! *************************************************************************
3023 :
3024 667 : ier=0
3025 : #if defined HAVE_MPI
3026 667 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
3027 667 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
3028 667 : if (nproc_space_comm /= 1) then
3029 210 : n1 =size(xval,dim=1)
3030 210 : n2 =size(xval,dim=2)
3031 210 : n3 =size(xval,dim=3)
3032 210 : n4 =size(xval,dim=4)
3033 210 : n5 =size(xval,dim=5)
3034 :
3035 : !This product of dimensions can be greater than a 32bit integer
3036 : !We use a INT64 to store it. If it is too large, we switch to an
3037 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
3038 210 : ntot=int(n1,kind=int64)*n2*n3*n4*n5
3039 210 : if (ntot<=xmpi_maxint32_64) then
3040 210 : nn=n1*n2*n3*n4*n5 ; my_dt=MPI_DOUBLE_COMPLEX ; my_op=MPI_SUM
3041 : else
3042 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
3043 : end if
3044 :
3045 : ! Accumulate xval on all proc. in comm
3046 : #if defined HAVE_MPI2_INPLACE
3047 210 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
3048 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
3049 210 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
3050 : else
3051 : #endif
3052 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5), ier)
3053 0 : if (ier/=0) call xmpi_abort(comm,msg='error allocating xsum in xmpi_sum_c5dc')
3054 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
3055 0 : xval (:,:,:,:,:) = xsum(:,:,:,:,:)
3056 0 : ABI_FREE(xsum)
3057 : #if defined HAVE_MPI2_INPLACE
3058 : endif
3059 : #endif
3060 :
3061 210 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
3062 : end if
3063 : end if
3064 : #endif
3065 :
3066 667 : end subroutine xmpi_sum_c5dc
3067 : !!***
3068 :
3069 : !----------------------------------------------------------------------
3070 :
3071 : !!****f* ABINIT/xmpi_sum_c6dc
3072 : !! NAME
3073 : !! xmpi_sum_c6dc
3074 : !!
3075 : !! FUNCTION
3076 : !! Combines values from all processes and distribute the result back to all processes.
3077 : !! Target: six-dimensional double precision complex arrays.
3078 : !!
3079 : !! INPUTS
3080 : !! comm= MPI communicator
3081 : !!
3082 : !! OUTPUT
3083 : !! ier= exit status, a non-zero value meaning there is an error
3084 : !!
3085 : !! SIDE EFFECTS
3086 : !! xval= buffer array
3087 : !!
3088 : !! SOURCE
3089 :
3090 0 : subroutine xmpi_sum_c6dc(xval,comm,ier)
3091 :
3092 : !Arguments-------------------------
3093 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:)
3094 : integer,intent(in) :: comm
3095 : integer,intent(out) :: ier
3096 :
3097 : !Local variables-------------------
3098 : #if defined HAVE_MPI
3099 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6,nn,nproc_space_comm
3100 : integer(kind=int64) :: ntot
3101 0 : complex(dp),allocatable :: xsum(:,:,:,:,:,:)
3102 : #endif
3103 : ! *************************************************************************
3104 :
3105 0 : ier=0
3106 : #if defined HAVE_MPI
3107 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
3108 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
3109 0 : if (nproc_space_comm /= 1) then
3110 0 : n1 =size(xval,dim=1)
3111 0 : n2 =size(xval,dim=2)
3112 0 : n3 =size(xval,dim=3)
3113 0 : n4 =size(xval,dim=4)
3114 0 : n5 =size(xval,dim=5)
3115 0 : n6 =size(xval,dim=6)
3116 :
3117 : !This product of dimensions can be greater than a 32bit integer
3118 : !We use a INT64 to store it. If it is too large, we switch to an
3119 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
3120 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5*n6
3121 0 : if (ntot<=xmpi_maxint32_64) then
3122 0 : nn=n1*n2*n3*n4*n5*n6 ; my_dt=MPI_DOUBLE_COMPLEX ; my_op=MPI_SUM
3123 : else
3124 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
3125 : end if
3126 :
3127 : ! Accumulate xval on all proc. in comm
3128 : #if defined HAVE_MPI2_INPLACE
3129 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
3130 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
3131 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
3132 : else
3133 : #endif
3134 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6), ier)
3135 0 : if (ier/=0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c6dc')
3136 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
3137 0 : xval = xsum
3138 0 : ABI_FREE(xsum)
3139 : #if defined HAVE_MPI2_INPLACE
3140 : endif
3141 : #endif
3142 :
3143 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
3144 : end if
3145 : end if
3146 : #endif
3147 :
3148 0 : end subroutine xmpi_sum_c6dc
3149 : !!***
3150 :
3151 : !----------------------------------------------------------------------
3152 :
3153 : !!****f* ABINIT/xmpi_sum_c7dc
3154 : !! NAME
3155 : !! xmpi_sum_c7dc
3156 : !!
3157 : !! FUNCTION
3158 : !! Combines values from all processes and distribute the result back to all processes.
3159 : !! Target: six-dimensional double precision complex arrays.
3160 : !!
3161 : !! INPUTS
3162 : !! comm= MPI communicator
3163 : !!
3164 : !! OUTPUT
3165 : !! ier= exit status, a non-zero value meaning there is an error
3166 : !!
3167 : !! SIDE EFFECTS
3168 : !! xval= buffer array
3169 : !!
3170 : !! SOURCE
3171 :
3172 0 : subroutine xmpi_sum_c7dc(xval,comm,ier)
3173 :
3174 : !Arguments-------------------------
3175 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:,:)
3176 : integer,intent(in) :: comm
3177 : integer,intent(out) :: ier
3178 :
3179 : !Local variables-------------------
3180 : #if defined HAVE_MPI
3181 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6,n7,nn,nproc_space_comm
3182 : integer(kind=int64) :: ntot
3183 0 : complex(dp),allocatable :: xsum(:,:,:,:,:,:,:)
3184 : #endif
3185 : ! *************************************************************************
3186 :
3187 0 : ier=0
3188 : #if defined HAVE_MPI
3189 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
3190 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
3191 0 : if (nproc_space_comm /= 1) then
3192 0 : n1 =size(xval,dim=1)
3193 0 : n2 =size(xval,dim=2)
3194 0 : n3 =size(xval,dim=3)
3195 0 : n4 =size(xval,dim=4)
3196 0 : n5 =size(xval,dim=5)
3197 0 : n6 =size(xval,dim=6)
3198 0 : n7 =size(xval,dim=7)
3199 :
3200 : !This product of dimensions can be greater than a 32bit integer
3201 : !We use a INT64 to store it. If it is too large, we switch to an
3202 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
3203 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5*n6*n7
3204 0 : if (ntot<=xmpi_maxint32_64) then
3205 0 : nn=n1*n2*n3*n4*n5*n6*n7 ; my_dt=MPI_DOUBLE_COMPLEX ; my_op=MPI_SUM
3206 : else
3207 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
3208 : end if
3209 :
3210 : ! Accumulate xval on all proc. in comm
3211 : #if defined HAVE_MPI2_INPLACE
3212 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
3213 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
3214 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
3215 : else
3216 : #endif
3217 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6,n7),ier)
3218 0 : if (ier/=0) call xmpi_abort(comm=comm,msg='error allocating xsum in xmpi_sum_c7dc')
3219 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
3220 0 : xval = xsum
3221 0 : ABI_FREE(xsum)
3222 : #if defined HAVE_MPI2_INPLACE
3223 : endif
3224 : #endif
3225 :
3226 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
3227 : end if
3228 : end if
3229 : #endif
3230 :
3231 0 : end subroutine xmpi_sum_c7dc
3232 : !!***
3233 :
3234 : !----------------------------------------------------------------------
3235 :
3236 : !!****f* ABINIT/xmpi_sum_c1cplx
3237 : !! NAME
3238 : !! xmpi_sum_c1cplx
3239 : !!
3240 : !! FUNCTION
3241 : !! Combines values from all processes and distribute
3242 : !! the result back to all processes.
3243 : !! Target: one-dimensional complex arrays.
3244 : !!
3245 : !! INPUTS
3246 : !! comm= MPI communicator
3247 : !!
3248 : !! OUTPUT
3249 : !! ier= exit status, a non-zero value meaning there is an error
3250 : !!
3251 : !! SIDE EFFECTS
3252 : !! xval= buffer array
3253 : !!
3254 : !! SOURCE
3255 :
3256 0 : subroutine xmpi_sum_c1cplx(xval,comm,ier)
3257 :
3258 : !Arguments----------------
3259 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:)
3260 : integer,intent(in) :: comm
3261 : integer,intent(out) :: ier
3262 :
3263 : !Local variables--------------
3264 : #if defined HAVE_MPI
3265 : integer :: n1,nproc_space_comm
3266 0 : complex(sp),allocatable :: xsum(:)
3267 : #endif
3268 : ! *************************************************************************
3269 :
3270 0 : ier=0
3271 : #if defined HAVE_MPI
3272 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
3273 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
3274 0 : if (nproc_space_comm /= 1) then
3275 0 : n1 =size(xval,dim=1)
3276 :
3277 : ! Accumulate xval on all proc. in comm
3278 : #if defined HAVE_MPI2_INPLACE
3279 0 : if (xmpi_use_inplace_operations) then
3280 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,n1,MPI_COMPLEX,MPI_SUM,comm,ier)
3281 : else
3282 : #endif
3283 0 : ABI_STAT_MALLOC(xsum,(n1), ier)
3284 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c1cplx')
3285 0 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_COMPLEX,MPI_SUM,comm,ier)
3286 0 : xval (:) = xsum(:)
3287 0 : ABI_FREE(xsum)
3288 : #if defined HAVE_MPI2_INPLACE
3289 : endif
3290 : #endif
3291 :
3292 : end if
3293 : end if
3294 : #endif
3295 :
3296 0 : end subroutine xmpi_sum_c1cplx
3297 : !!***
3298 :
3299 : !----------------------------------------------------------------------
3300 :
3301 : !!****f* ABINIT/xmpi_sum_c2cplx
3302 : !! NAME
3303 : !! xmpi_sum_c2cplx
3304 : !!
3305 : !! FUNCTION
3306 : !! Combines values from all processes and distribute
3307 : !! the result back to all processes.
3308 : !! Target: two-dimensional complex arrays.
3309 : !!
3310 : !! INPUTS
3311 : !! comm= MPI communicator
3312 : !!
3313 : !! OUTPUT
3314 : !! ier= exit status, a non-zero value meaning there is an error
3315 : !!
3316 : !! SIDE EFFECTS
3317 : !! xval= buffer array
3318 : !!
3319 : !! SOURCE
3320 :
3321 0 : subroutine xmpi_sum_c2cplx(xval,comm,ier)
3322 :
3323 : !Arguments----------------
3324 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:)
3325 : integer,intent(in) :: comm
3326 : integer,intent(out) :: ier
3327 :
3328 : !Local variables--------------
3329 : #if defined HAVE_MPI
3330 : integer :: my_dt,my_op,n1,n2,nn,nproc_space_comm
3331 : integer(kind=int64) :: ntot
3332 0 : complex(sp), allocatable :: xsum(:,:)
3333 : #endif
3334 : ! *************************************************************************
3335 :
3336 0 : ier=0
3337 : #if defined HAVE_MPI
3338 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
3339 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
3340 0 : if (nproc_space_comm /= 1) then
3341 0 : n1 =size(xval,dim=1)
3342 0 : n2 =size(xval,dim=2)
3343 :
3344 : !This product of dimensions can be greater than a 32bit integer
3345 : !We use a INT64 to store it. If it is too large, we switch to an
3346 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
3347 0 : ntot=int(n1,kind=int64)*n2
3348 0 : if (ntot<=xmpi_maxint32_64) then
3349 0 : nn=n1*n2 ; my_dt=MPI_COMPLEX ; my_op=MPI_SUM
3350 : else
3351 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
3352 : end if
3353 :
3354 : ! Accumulate xval on all proc. in comm
3355 : #if defined HAVE_MPI2_INPLACE
3356 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
3357 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
3358 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
3359 : else
3360 : #endif
3361 0 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
3362 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c2cplx')
3363 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
3364 0 : xval (:,:) = xsum(:,:)
3365 0 : ABI_FREE(xsum)
3366 : #if defined HAVE_MPI2_INPLACE
3367 : endif
3368 : #endif
3369 :
3370 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
3371 : end if
3372 : end if
3373 : #endif
3374 :
3375 0 : end subroutine xmpi_sum_c2cplx
3376 : !!***
3377 :
3378 : !----------------------------------------------------------------------
3379 :
3380 : !!****f* ABINIT/xmpi_sum_c3cplx
3381 : !! NAME
3382 : !! xmpi_sum_c3cplx
3383 : !!
3384 : !! FUNCTION
3385 : !! Combines values from all processes and distribute
3386 : !! the result back to all processes.
3387 : !! Target: three-dimensional complex arrays.
3388 : !!
3389 : !! INPUTS
3390 : !! comm= MPI communicator
3391 : !!
3392 : !! OUTPUT
3393 : !! ier= exit status, a non-zero value meaning there is an error
3394 : !!
3395 : !! SIDE EFFECTS
3396 : !! xval= buffer array
3397 : !!
3398 : !! SOURCE
3399 :
3400 0 : subroutine xmpi_sum_c3cplx(xval,comm,ier)
3401 :
3402 : !Arguments----------------
3403 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
3404 : integer,intent(in) :: comm
3405 : integer,intent(out) :: ier
3406 :
3407 : !Local variables--------------
3408 : #if defined HAVE_MPI
3409 : integer :: my_dt,my_op,n1,n2,n3,nn,nproc_space_comm
3410 : integer(kind=int64) :: ntot
3411 0 : complex(sp), allocatable :: xsum(:,:,:)
3412 : #endif
3413 : ! *************************************************************************
3414 :
3415 0 : ier=0
3416 : #if defined HAVE_MPI
3417 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
3418 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
3419 0 : if (nproc_space_comm /= 1) then
3420 0 : n1 =size(xval,dim=1)
3421 0 : n2 =size(xval,dim=2)
3422 0 : n3 =size(xval,dim=3)
3423 :
3424 : !This product of dimensions can be greater than a 32bit integer
3425 : !We use a INT64 to store it. If it is too large, we switch to an
3426 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
3427 0 : ntot=int(n1,kind=int64)*n2*n3
3428 0 : if (ntot<=xmpi_maxint32_64) then
3429 0 : nn=n1*n2*n3 ; my_dt=MPI_COMPLEX ; my_op=MPI_SUM
3430 : else
3431 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
3432 : end if
3433 :
3434 : ! Accumulate xval on all proc. in comm
3435 : #if defined HAVE_MPI2_INPLACE
3436 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
3437 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
3438 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
3439 : else
3440 : #endif
3441 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
3442 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c3cplx')
3443 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
3444 0 : xval (:,:,:) = xsum(:,:,:)
3445 0 : ABI_FREE(xsum)
3446 : #if defined HAVE_MPI2_INPLACE
3447 : endif
3448 : #endif
3449 :
3450 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
3451 : end if
3452 : end if
3453 : #endif
3454 :
3455 0 : end subroutine xmpi_sum_c3cplx
3456 : !!***
3457 :
3458 : !----------------------------------------------------------------------
3459 :
3460 : !!****f* ABINIT/xmpi_sum_c4cplx
3461 : !! NAME
3462 : !! xmpi_sum_c4cplx
3463 : !!
3464 : !! FUNCTION
3465 : !! Combines values from all processes and distribute
3466 : !! the result back to all processes.
3467 : !! Target: four-dimensional complex arrays.
3468 : !!
3469 : !! INPUTS
3470 : !! comm= MPI communicator
3471 : !!
3472 : !! OUTPUT
3473 : !! ier= exit status, a non-zero value meaning there is an error
3474 : !!
3475 : !! SIDE EFFECTS
3476 : !! xval= buffer array
3477 : !!
3478 : !! SOURCE
3479 :
3480 0 : subroutine xmpi_sum_c4cplx(xval,comm,ier)
3481 :
3482 : !Arguments----------------
3483 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
3484 : integer,intent(in) :: comm
3485 : integer,intent(out) :: ier
3486 :
3487 : !Local variables--------------
3488 : #if defined HAVE_MPI
3489 : integer :: my_dt,my_op,n1,n2,n3,n4,nn,nproc_space_comm
3490 : integer(kind=int64) :: ntot
3491 0 : complex(sp),allocatable :: xsum(:,:,:,:)
3492 : #endif
3493 : ! *************************************************************************
3494 :
3495 0 : ier=0
3496 : #if defined HAVE_MPI
3497 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
3498 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
3499 0 : if (nproc_space_comm /= 1) then
3500 0 : n1 =size(xval,dim=1)
3501 0 : n2 =size(xval,dim=2)
3502 0 : n3 =size(xval,dim=3)
3503 0 : n4 =size(xval,dim=4)
3504 :
3505 : !This product of dimensions can be greater than a 32bit integer
3506 : !We use a INT64 to store it. If it is too large, we switch to an
3507 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
3508 0 : ntot=int(n1,kind=int64)*n2*n3*n4
3509 0 : if (ntot<=xmpi_maxint32_64) then
3510 0 : nn=n1*n2*n3*n4 ; my_dt=MPI_COMPLEX ; my_op=MPI_SUM
3511 : else
3512 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
3513 : end if
3514 :
3515 : ! Accumulate xval on all proc. in comm
3516 : #if defined HAVE_MPI2_INPLACE
3517 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
3518 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
3519 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
3520 : else
3521 : #endif
3522 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
3523 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c4cplx')
3524 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
3525 0 : xval (:,:,:,:) = xsum(:,:,:,:)
3526 0 : ABI_FREE(xsum)
3527 : #if defined HAVE_MPI2_INPLACE
3528 : endif
3529 : #endif
3530 :
3531 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
3532 : end if
3533 : end if
3534 : #endif
3535 :
3536 0 : end subroutine xmpi_sum_c4cplx
3537 : !!***
3538 :
3539 : !----------------------------------------------------------------------
3540 :
3541 : !!****f* ABINIT/xmpi_sum_c5cplx
3542 : !! NAME
3543 : !! xmpi_sum_c5cplx
3544 : !!
3545 : !! FUNCTION
3546 : !! Combines values from all processes and distribute
3547 : !! the result back to all processes.
3548 : !! Target: five-dimensional complex arrays.
3549 : !!
3550 : !! INPUTS
3551 : !! comm= MPI communicator
3552 : !!
3553 : !! OUTPUT
3554 : !! ier= exit status, a non-zero value meaning there is an error
3555 : !!
3556 : !! SIDE EFFECTS
3557 : !! xval= buffer array
3558 : !!
3559 : !! SOURCE
3560 :
3561 0 : subroutine xmpi_sum_c5cplx(xval,comm,ier)
3562 :
3563 : !Arguments----------------
3564 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
3565 : integer,intent(in) :: comm
3566 : integer,intent(out) :: ier
3567 :
3568 : !Local variables--------------
3569 : #if defined HAVE_MPI
3570 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,nn,nproc_space_comm
3571 : integer(kind=int64) :: ntot
3572 0 : complex(sp),allocatable :: xsum(:,:,:,:,:)
3573 : #endif
3574 : ! *************************************************************************
3575 :
3576 0 : ier=0
3577 : #if defined HAVE_MPI
3578 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
3579 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
3580 0 : if (nproc_space_comm /= 1) then
3581 0 : n1 =size(xval,dim=1)
3582 0 : n2 =size(xval,dim=2)
3583 0 : n3 =size(xval,dim=3)
3584 0 : n4 =size(xval,dim=4)
3585 0 : n5 =size(xval,dim=5)
3586 :
3587 : !This product of dimensions can be greater than a 32bit integer
3588 : !We use a INT64 to store it. If it is too large, we switch to an
3589 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
3590 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5
3591 0 : if (ntot<=xmpi_maxint32_64) then
3592 0 : nn=n1*n2*n3*n4*n5 ; my_dt=MPI_COMPLEX ; my_op=MPI_SUM
3593 : else
3594 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
3595 : end if
3596 :
3597 : ! Accumulate xval on all proc. in comm
3598 : #if defined HAVE_MPI2_INPLACE
3599 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
3600 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
3601 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
3602 : else
3603 : #endif
3604 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5), ier)
3605 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c5cplx')
3606 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
3607 0 : xval (:,:,:,:,:) = xsum(:,:,:,:,:)
3608 0 : ABI_FREE(xsum)
3609 : #if defined HAVE_MPI2_INPLACE
3610 : endif
3611 : #endif
3612 :
3613 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
3614 : end if
3615 : end if
3616 : #endif
3617 :
3618 0 : end subroutine xmpi_sum_c5cplx
3619 : !!***
3620 :
3621 : !----------------------------------------------------------------------
3622 :
3623 : !!****f* ABINIT/xmpi_sum_c6cplx
3624 : !! NAME
3625 : !! xmpi_sum_c6cplx
3626 : !!
3627 : !! FUNCTION
3628 : !! Combines values from all processes and distribute the result back to all processes.
3629 : !! Target: six-dimensional complex arrays.
3630 : !!
3631 : !! INPUTS
3632 : !! comm= MPI communicator
3633 : !!
3634 : !! OUTPUT
3635 : !! ier= exit status, a non-zero value meaning there is an error
3636 : !!
3637 : !! SIDE EFFECTS
3638 : !! xval= buffer array
3639 : !!
3640 : !! SOURCE
3641 :
3642 0 : subroutine xmpi_sum_c6cplx(xval,comm,ier)
3643 :
3644 : !Arguments----------------
3645 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:)
3646 : integer,intent(in) :: comm
3647 : integer,intent(out) :: ier
3648 :
3649 : !Local variables--------------
3650 : #if defined HAVE_MPI
3651 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6,nn,nproc_space_comm
3652 : integer(kind=int64) :: ntot
3653 0 : complex(sp),allocatable :: xsum(:,:,:,:,:,:)
3654 : #endif
3655 : ! *************************************************************************
3656 :
3657 0 : ier=0
3658 : #if defined HAVE_MPI
3659 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
3660 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
3661 0 : if (nproc_space_comm /= 1) then
3662 0 : n1 =size(xval,dim=1)
3663 0 : n2 =size(xval,dim=2)
3664 0 : n3 =size(xval,dim=3)
3665 0 : n4 =size(xval,dim=4)
3666 0 : n5 =size(xval,dim=5)
3667 0 : n6 =size(xval,dim=6)
3668 :
3669 : !This product of dimensions can be greater than a 32bit integer
3670 : !We use a INT64 to store it. If it is too large, we switch to an
3671 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
3672 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5*n6
3673 0 : if (ntot<=xmpi_maxint32_64) then
3674 0 : nn=n1*n2*n3*n4*n5*n6 ; my_dt=MPI_COMPLEX ; my_op=MPI_SUM
3675 : else
3676 0 : nn=1 ; call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
3677 : end if
3678 :
3679 : ! Accumulate xval on all proc. in comm
3680 : #if defined HAVE_MPI2_INPLACE
3681 0 : if (xmpi_use_inplace_operations .and. my_op == MPI_SUM) then
3682 : if (my_op/=MPI_SUM) call xmpi_abort(msg="Too many data for in-place reductions!")
3683 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,xval,nn,my_dt,my_op,comm,ier)
3684 : else
3685 : #endif
3686 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6), ier)
3687 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum_c6cplx')
3688 0 : call MPI_ALLREDUCE(xval,xsum,nn,my_dt,my_op,comm,ier)
3689 0 : xval = xsum
3690 0 : ABI_FREE(xsum)
3691 : #if defined HAVE_MPI2_INPLACE
3692 : endif
3693 : #endif
3694 :
3695 0 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
3696 : end if
3697 : end if
3698 : #endif
3699 :
3700 0 : end subroutine xmpi_sum_c6cplx
3701 : !!***
3702 :
3703 : !----------------------------------------------------------------------
3704 :
3705 : !!****f* ABINIT/xmpi_sum_coeff5d1
3706 : !! NAME
3707 : !! xmpi_sum_coeff5d1
3708 : !!
3709 : !! FUNCTION
3710 : !! Combines values from all processes and distribute the result back to all processes.
3711 : !! Target: coeff5_type 1D-structure
3712 : !!
3713 : !! INPUTS
3714 : !! comm= MPI communicator
3715 : !!
3716 : !! OUTPUT
3717 : !! ier= exit status, a non-zero value meaning there is an error
3718 : !!
3719 : !! SIDE EFFECTS
3720 : !! xval = coeff5d_type array structure (input and output)
3721 : !!
3722 : !! SOURCE
3723 :
3724 0 : subroutine xmpi_sum_coeff5d1(xval,comm,ier)
3725 :
3726 : !Arguments ------------------------------------
3727 : type(coeff5_type),intent(inout) :: xval(:)
3728 : integer,intent(in) :: comm
3729 : integer,intent(out) :: ier
3730 :
3731 : !Local variables-------------------------------
3732 : #if defined HAVE_MPI
3733 : integer :: buf_size,i2,i3,i4,i5,ii,indx_buf,n1,n2,n3,n4,n5,nb,nproc_space_comm
3734 0 : integer, allocatable :: dims(:,:)
3735 0 : real(dp),allocatable :: buf(:),xsum(:)
3736 : #endif
3737 : ! *************************************************************************
3738 :
3739 0 : ier=0
3740 : #if defined HAVE_MPI
3741 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
3742 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
3743 0 : if (nproc_space_comm /= 1) then
3744 0 : nb = size(xval,1)
3745 :
3746 : ! Retrieve sizes of 'value' fields
3747 0 : ABI_MALLOC(dims,(5,nb))
3748 0 : buf_size=0
3749 0 : do ii=1,nb
3750 0 : if (.not.allocated(xval(ii)%value)) &
3751 0 : & call xmpi_abort(msg='bug in xmpi_sum(coeff5): xval should be allocated!')
3752 0 : dims(1,ii)=size(xval(ii)%value,dim=1)
3753 0 : dims(2,ii)=size(xval(ii)%value,dim=2)
3754 0 : dims(3,ii)=size(xval(ii)%value,dim=3)
3755 0 : dims(4,ii)=size(xval(ii)%value,dim=4)
3756 0 : dims(5,ii)=size(xval(ii)%value,dim=5)
3757 0 : buf_size=buf_size+dims(1,ii)*dims(2,ii)*dims(3,ii)*dims(4,ii)*dims(5,ii)
3758 : end do
3759 :
3760 : ! Fill in buffer
3761 0 : ABI_STAT_MALLOC(buf,(buf_size) ,ier)
3762 0 : if (ier/= 0) call xmpi_abort(msg='error allocating buf in xmpi_sum(coeff5)!')
3763 : indx_buf=1
3764 0 : do ii=1,nb
3765 0 : n1=dims(1,ii); n2=dims(2,ii)
3766 0 : n3=dims(3,ii); n4=dims(4,ii); n5=dims(5,ii)
3767 0 : do i5=1,n5
3768 0 : do i4=1,n4
3769 0 : do i3=1,n3
3770 0 : do i2=1,n2
3771 0 : buf(indx_buf:indx_buf+n1-1)=xval(ii)%value(1:n1,i2,i3,i4,i5)
3772 0 : indx_buf=indx_buf+n1
3773 : end do
3774 : end do
3775 : end do
3776 : end do
3777 : end do
3778 :
3779 : ! Accumulate xval%value on all proc. in comm
3780 : #if defined HAVE_MPI2_INPLACE
3781 0 : if (xmpi_use_inplace_operations) then
3782 0 : call MPI_ALLREDUCE(MPI_IN_PLACE,buf,buf_size,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
3783 : else
3784 : #endif
3785 0 : ABI_STAT_MALLOC(xsum,(buf_size), ier)
3786 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_sum(coeff5)!')
3787 0 : call MPI_ALLREDUCE(buf,xsum,buf_size,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
3788 0 : buf = xsum
3789 0 : ABI_FREE(xsum)
3790 : #if defined HAVE_MPI2_INPLACE
3791 : endif
3792 : #endif
3793 :
3794 : ! Transfer buffer into output datastructure
3795 0 : indx_buf=1
3796 0 : do ii=1,nb
3797 0 : n1=dims(1,ii); n2=dims(2,ii)
3798 0 : n3=dims(3,ii); n4=dims(4,ii); n5=dims(5,ii)
3799 0 : do i5=1,n5
3800 0 : do i4=1,n4
3801 0 : do i3=1,n3
3802 0 : do i2=1,n2
3803 0 : xval(ii)%value(1:n1,i2,i3,i4,i5)=buf(indx_buf:indx_buf+n1-1)
3804 0 : indx_buf=indx_buf+n1
3805 : end do
3806 : end do
3807 : end do
3808 : end do
3809 : end do
3810 :
3811 0 : ABI_FREE(dims)
3812 0 : ABI_FREE(buf)
3813 :
3814 : end if
3815 : end if
3816 : #endif
3817 :
3818 0 : end subroutine xmpi_sum_coeff5d1
3819 : !!***
|
