Branch data 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 [ - + ]: 30715922 : 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 : 30715922 : integer,allocatable :: xsum(:)
34 : : #endif
35 : : ! *************************************************************************
36 : :
37 : 30715922 : ier=0
38 : : #if defined HAVE_MPI
39 [ + + ]: 30715922 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
40 : 37177 : n1 = size(xval)
41 : :
42 : : ! Accumulate xval on all proc. in comm
43 : : #if defined HAVE_MPI2_INPLACE
44 [ + - ]: 37177 : if (xmpi_use_inplace_operations) then
45 [ - + ]: 37177 : 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 : 30715922 : 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 : 5688032 : 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 : 5688032 : ier=0
123 : : #if defined HAVE_MPI
124 [ + + ]: 5688032 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
125 : : ! Accumulate xval on all proc. in comm
126 : 301429 : arr_xval(1) = xval
127 : 301429 : call MPI_ALLREDUCE(arr_xval,arr_xsum,1,MPI_INTEGER,MPI_SUM,comm,ier)
128 : 301429 : xval = arr_xsum(1)
129 : : end if
130 : : #endif
131 : 5688032 : 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 [ - + ]: 4524 : 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 : 4524 : integer,allocatable :: xsum(:,:,:,:)
606 : : #endif
607 : : ! *************************************************************************
608 : :
609 : 4524 : ier=0
610 : : #if defined HAVE_MPI
611 [ + + ]: 4524 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
612 : 4507 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
613 [ + + ]: 4507 : if (nproc_space_comm /= 1) then
614 : 4348 : n1 =size(xval,dim=1)
615 : 4348 : n2 =size(xval,dim=2)
616 : 4348 : n3 =size(xval,dim=3)
617 : 4348 : 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 : 4348 : ntot=int(n1,kind=int64)*n2*n3*n4
623 [ + - ]: 4348 : if (ntot<=xmpi_maxint32_64) then
624 : 4348 : 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 [ + - + - ]: 4348 : 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 [ - + ]: 4348 : 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 [ - + ]: 4348 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
646 : : end if
647 : : end if
648 : : #endif
649 : :
650 : 4524 : 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 [ - + ]: 28407595 : 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 : 28407595 : real(dp),allocatable :: xsum(:)
708 : : #endif
709 : : ! *************************************************************************
710 : :
711 : 28407595 : ier=0
712 : : #if defined HAVE_MPI
713 [ + + ]: 28407595 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
714 : 990506 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
715 [ + + ]: 990506 : if (nproc_space_comm /= 1) then
716 : 272024 : n1 = size(xval)
717 : :
718 : : ! Accumulate xval on all proc. in comm
719 : : #if defined HAVE_MPI2_INPLACE
720 [ + - ]: 272024 : if (xmpi_use_inplace_operations) then
721 [ - + ]: 272024 : 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 : 28407595 : 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 : 33407819 : 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 : 33407819 : ier=0
885 : : #if defined HAVE_MPI
886 [ + + ]: 33407819 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
887 : : ! Accumulate xval on all proc. in comm
888 : 780733 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
889 [ + + ]: 780733 : if (nproc_space_comm /= 1) then
890 : 688714 : arr_xval(1) = xval
891 : 688714 : call MPI_ALLREDUCE(arr_xval,arr_xsum,1,MPI_DOUBLE_PRECISION,MPI_SUM,comm,ier)
892 : 688714 : xval = arr_xsum(1)
893 : : end if
894 : : end if
895 : : #endif
896 : :
897 : 33407819 : 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 [ - + ]: 224967 : 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 : 224967 : real(dp) , allocatable :: xsum(:)
956 : : #endif
957 : : ! *************************************************************************
958 : :
959 : 224967 : ier=0
960 : : #if defined HAVE_MPI
961 [ + + ]: 224967 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
962 : 224443 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
963 [ + + ]: 224443 : if (nproc_space_comm /= 1) then
964 : :
965 : : ! Accumulate xval on all proc. in comm
966 : : #if defined HAVE_MPI2_INPLACE
967 [ + - ]: 164558 : if (xmpi_use_inplace_operations) then
968 [ - + ]: 164558 : 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 : 224967 : 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 [ - + ]: 65960554 : 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 : 65960554 : real(dp),allocatable :: xsum(:,:)
1669 : : #endif
1670 : : ! *************************************************************************
1671 : :
1672 : 65960554 : ier=0
1673 : : #if defined HAVE_MPI
1674 : 65960554 : l_use_omp_map=.false.
1675 [ + + ]: 65960554 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
1676 [ + + ]: 65960554 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1677 : 2477742 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1678 [ + + ]: 2477742 : if (nproc_space_comm /= 1) then
1679 : 2405906 : n1 = size(xval,dim=1)
1680 : 2405906 : 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 : 2405906 : ntot=int(n1,kind=int64)*n2
1686 [ + - ]: 2405906 : if (ntot<=xmpi_maxint32_64) then
1687 : 2405906 : 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 [ + - + - ]: 2405906 : 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 [ + - ]: 2405906 : if(.not. l_use_omp_map) then
1697 [ - + ]: 2405906 : 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 [ - + ]: 2405906 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
1748 : : end if
1749 : : end if
1750 : : #endif
1751 : :
1752 : 65960554 : 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 [ - + ]: 6264944 : 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 : 6264944 : real(dp),allocatable :: xsum(:,:,:)
1816 : : #endif
1817 : : ! *************************************************************************
1818 : :
1819 : 6264944 : ier=0
1820 : : #if defined HAVE_MPI
1821 : 6264944 : l_use_omp_map=.false.
1822 [ - + ]: 6264944 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
1823 [ + + ]: 6264944 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1824 : 772892 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1825 [ + + ]: 772892 : if (nproc_space_comm /= 1) then
1826 : 117936 : n1 = size(xval,dim=1)
1827 : 117936 : n2 = size(xval,dim=2)
1828 : 117936 : 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 : 117936 : ntot=int(n1,kind=int64)*n2*n3
1834 [ + - ]: 117936 : if (ntot<=xmpi_maxint32_64) then
1835 : 117936 : 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 [ + - + - ]: 117936 : 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 [ + - ]: 117936 : if(.not. l_use_omp_map) then
1845 [ + + ]: 117936 : 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 [ - + ]: 117936 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
1899 : : end if
1900 : : end if
1901 : : #endif
1902 : :
1903 : 6264944 : 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 [ - + ]: 526743 : 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 : 526743 : real(dp),allocatable :: xsum(:,:,:,:)
1962 : : #endif
1963 : : ! *************************************************************************
1964 : :
1965 : 526743 : ier=0
1966 : : #if defined HAVE_MPI
1967 [ + + ]: 526743 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1968 : 522741 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1969 [ + + ]: 522741 : if (nproc_space_comm /= 1) then
1970 : 521638 : n1 = size(xval,dim=1)
1971 : 521638 : n2 = size(xval,dim=2)
1972 : 521638 : n3 = size(xval,dim=3)
1973 : 521638 : 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 : 521638 : ntot=int(n1,kind=int64)*n2*n3*n4
1979 [ + - ]: 521638 : if (ntot<=xmpi_maxint32_64) then
1980 : 521638 : 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 [ + - + - ]: 521638 : 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 [ - + ]: 521638 : 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 [ - + ]: 521638 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
2002 : : end if
2003 : : end if
2004 : : #endif
2005 : :
2006 : 526743 : 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 [ - + ]: 87167429 : 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 : 87167429 : real(dp),allocatable :: xsum(:,:,:,:,:)
2065 : : #endif
2066 : : ! *************************************************************************
2067 : :
2068 : 87167429 : ier=0
2069 : : #if defined HAVE_MPI
2070 [ + + ]: 87167429 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2071 : 1951233 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2072 [ + + ]: 1951233 : if (nproc_space_comm /= 1) then
2073 : 601594 : n1 = size(xval,dim=1)
2074 : 601594 : n2 = size(xval,dim=2)
2075 : 601594 : n3 = size(xval,dim=3)
2076 : 601594 : n4 = size(xval,dim=4)
2077 : 601594 : 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 : 601594 : ntot=int(n1,kind=int64)*n2*n3*n4*n5
2083 [ + - ]: 601594 : if (ntot<=xmpi_maxint32_64) then
2084 : 601594 : 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 [ + - + - ]: 601594 : 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 [ - + ]: 601594 : 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 [ - + ]: 601594 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
2106 : : end if
2107 : : end if
2108 : : #endif
2109 : :
2110 : 87167429 : 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 [ - + - + ]: 11427 : 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 : 11427 : ier=0
2378 : : #if defined HAVE_MPI
2379 [ + + ]: 11427 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2380 : : ! Accumulate xval on all proc. in comm
2381 [ - + - + ]: 11410 : 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 : 11427 : 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 : 364592 : 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 : 364592 : ier=0
2571 : : #if defined HAVE_MPI
2572 [ + + ]: 364592 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2573 : 334606 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2574 [ + + ]: 334606 : if (nproc_space_comm /= 1) then
2575 : : ! Accumulate xval on all proc. in comm
2576 : 2688 : arr_xval(1) = xval
2577 : 2688 : call MPI_ALLREDUCE(arr_xval,arr_xsum,1,MPI_DOUBLE_COMPLEX,MPI_SUM,comm,ier)
2578 : 2688 : xval = arr_xsum(1)
2579 : : end if
2580 : : end if
2581 : : #endif
2582 : :
2583 : 364592 : 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 [ - + ]: 4450613 : 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 : 4450613 : complex(dp),allocatable :: xsum(:,:)
2741 : : #endif
2742 : : ! *************************************************************************
2743 : :
2744 : 4450613 : ier=0
2745 : : #if defined HAVE_MPI
2746 : 4450613 : l_use_omp_map=.false.
2747 [ + + ]: 4450613 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
2748 [ + + ]: 4450613 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
2749 : 4428613 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
2750 [ + + ]: 4428613 : if (nproc_space_comm /= 1) then
2751 : 4416322 : n1 =size(xval,dim=1)
2752 : 4416322 : 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 : 4416322 : ntot=int(n1,kind=int64)*n2
2758 [ + - ]: 4416322 : if (ntot<=xmpi_maxint32_64) then
2759 : 4416322 : 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 [ + - + - ]: 4416322 : 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 [ + - ]: 4416322 : if(.not. l_use_omp_map) then
2769 [ - + ]: 4416322 : 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 [ - + ]: 4416322 : if (ntot>xmpi_maxint32_64) call xmpi_largetype_free(my_dt,my_op)
2820 : : end if
2821 : : end if
2822 : : #endif
2823 : :
2824 : 4450613 : 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 : : !!***
|
