Line data Source code
1 : !{\src2tex{textfont=tt}}
2 : !!****f* ABINIT/xmpi_sum_master
3 : !! NAME
4 : !! xmpi_sum_master
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_master 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 : !! The workspace array xsum is filled to zeros to avoid SIFPE in [mpiio][t28_MPI4][np=4] on tikal_gnu_4.9_mpich
19 : !! On this bot, the code is compiled with -ffpe-trap and the illegal operation in the MPI library
20 : !! make tests using xmpi_sum_master abort.
21 : !! Strictly speaking the initialization is not needed because xsum has intent(out) --> bug in mpich3-3.1.3 (gcc492)
22 : !!
23 : !! SOURCE
24 :
25 : !!***
26 :
27 : !!****f* ABINIT/xmpi_sum_master_int
28 : !! NAME
29 : !! xmpi_sum_master_int
30 : !!
31 : !! FUNCTION
32 : !! Reduces values on all processes to a single value.
33 : !! Target: integer scalars.
34 : !!
35 : !! INPUTS
36 : !! master= master MPI node
37 : !! comm= MPI communicator
38 : !!
39 : !! OUTPUT
40 : !! ier= exit status, a non-zero value meaning there is an error
41 : !!
42 : !! SIDE EFFECTS
43 : !! xval= buffer array
44 : !!
45 : !! SOURCE
46 :
47 0 : subroutine xmpi_sum_master_int(xval,master,comm,ier)
48 :
49 : !Arguments-------------------------
50 : integer,intent(inout) :: xval
51 : integer ,intent(in) :: master
52 : integer ,intent(in) :: comm
53 : integer ,intent(out) :: ier
54 :
55 : !Local variables-------------------
56 : #if defined HAVE_MPI
57 : integer :: nproc_space_comm
58 : integer :: arr_xsum(1),arr_xval(1)
59 : #endif
60 :
61 : ! *************************************************************************
62 :
63 0 : ier=0
64 : #if defined HAVE_MPI
65 0 : if (comm /= MPI_COMM_NULL) then
66 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
67 0 : if (nproc_space_comm /= 1) then
68 : ! Accumulate xval on all proc. in comm
69 0 : arr_xval(1) = xval
70 0 : call MPI_REDUCE(arr_xval,arr_xsum,1,MPI_INTEGER,MPI_SUM,master,comm,ier)
71 0 : xval = arr_xsum(1)
72 : end if
73 : end if
74 : #endif
75 0 : end subroutine xmpi_sum_master_int
76 : !!***
77 :
78 : !!****f* ABINIT/xmpi_sum_master_dp
79 : !! NAME
80 : !! xmpi_sum_master_p
81 : !!
82 : !! FUNCTION
83 : !! Reduces values on all processes to a single value.
84 : !! Target: integer scalars.
85 : !!
86 : !! INPUTS
87 : !! master= master MPI node
88 : !! comm= MPI communicator
89 : !!
90 : !! OUTPUT
91 : !! ier= exit status, a non-zero value meaning there is an error
92 : !!
93 : !! SIDE EFFECTS
94 : !! xval= buffer array
95 : !!
96 : !! SOURCE
97 :
98 4184 : subroutine xmpi_sum_master_dp(xval,master,comm,ier)
99 :
100 : !Arguments-------------------------
101 : real(dp),intent(inout) :: xval
102 : integer ,intent(in) :: master
103 : integer ,intent(in) :: comm
104 : integer ,intent(out) :: ier
105 :
106 : !Local variables-------------------
107 : #if defined HAVE_MPI
108 : integer :: nproc_space_comm
109 : real(dp) :: arr_xsum(1)
110 : #endif
111 :
112 : ! *************************************************************************
113 :
114 4184 : ier=0
115 : #if defined HAVE_MPI
116 4184 : if (comm /= MPI_COMM_NULL) then
117 4184 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
118 4184 : if (nproc_space_comm /= 1) then
119 : ! Accumulate xval on all proc. in comm
120 0 : call MPI_REDUCE([xval],arr_xsum,1,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
121 0 : xval = arr_xsum(1)
122 : end if
123 : end if
124 : #endif
125 4184 : end subroutine xmpi_sum_master_dp
126 : !!***
127 :
128 : !!****f* ABINIT/xmpi_sum_master_int2d
129 : !! NAME
130 : !! xmpi_sum_master_int2d
131 : !!
132 : !! FUNCTION
133 : !! Reduces values on all processes to a single value.
134 : !! Target: two-dimensional integer arrays.
135 : !!
136 : !! INPUTS
137 : !! master= master MPI node
138 : !! comm= MPI communicator
139 : !!
140 : !! OUTPUT
141 : !! ier= exit status, a non-zero value meaning there is an error
142 : !!
143 : !! SIDE EFFECTS
144 : !! xval= buffer array
145 : !!
146 : !! SOURCE
147 :
148 1014 : subroutine xmpi_sum_master_int2d(xval,master,comm,ier)
149 :
150 : !Arguments ------------------------------------
151 : integer, DEV_CONTARRD intent(inout) :: xval(:,:)
152 : integer,intent(in) :: master,comm
153 : integer,intent(out) :: ier
154 :
155 : !Local variables-------------------------------
156 : #if defined HAVE_MPI
157 : integer :: my_dt,my_op,n1,n2
158 : integer(kind=int64) :: ntot
159 1014 : integer, allocatable :: xsum(:,:)
160 : integer :: nproc_space_comm
161 : #endif
162 :
163 : ! *************************************************************************
164 :
165 1014 : ier=0
166 : #if defined HAVE_MPI
167 1014 : if (comm /= MPI_COMM_NULL) then
168 1014 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
169 1014 : if (nproc_space_comm /= 1) then
170 1014 : n1 = size(xval,dim=1)
171 1014 : n2 = size(xval,dim=2)
172 :
173 4056 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
174 1014 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
175 1994190 : xsum = 0 ! See notes
176 :
177 : !This product of dimensions can be greater than a 32bit integer
178 : !We use a INT64 to store it. If it is too large, we switch to an
179 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
180 1014 : ntot=int(n1,kind=int64)*n2
181 :
182 : ! Accumulate xval on all proc. in comm
183 1014 : if (ntot<=xmpi_maxint32_64) then
184 1014 : call MPI_reduce(xval,xsum,n1*n2,MPI_INTEGER,MPI_SUM,master,comm,ier)
185 : else
186 0 : call xmpi_largetype_create(ntot,MPI_INTEGER,my_dt,my_op,MPI_SUM)
187 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
188 0 : call xmpi_largetype_free(my_dt,my_op)
189 : end if
190 :
191 1994190 : xval = xsum
192 1014 : ABI_FREE(xsum)
193 : end if
194 : end if
195 : #endif
196 :
197 1014 : end subroutine xmpi_sum_master_int2d
198 : !!***
199 :
200 : !!****f* ABINIT/xmpi_sum_master_dp1d
201 : !! NAME
202 : !! xmpi_sum_master_dp1d
203 : !!
204 : !! FUNCTION
205 : !! Reduces values on all processes to a single value.
206 : !! Target: double precision one-dimensional arrays.
207 : !!
208 : !! INPUTS
209 : !! master= master MPI node
210 : !! comm= MPI communicator
211 : !!
212 : !! OUTPUT
213 : !! ier= exit status, a non-zero value meaning there is an error
214 : !!
215 : !! SIDE EFFECTS
216 : !! xval= buffer array
217 : !!
218 : !! SOURCE
219 :
220 236 : subroutine xmpi_sum_master_dp1d(xval,master,comm,ier)
221 :
222 : !Arguments-------------------------
223 : real(dp), DEV_CONTARRD intent(inout) :: xval(:)
224 : integer ,intent(in) :: master
225 : integer ,intent(in) :: comm
226 : integer ,intent(out) :: ier
227 :
228 : !Local variables-------------------
229 : #if defined HAVE_MPI
230 : integer :: n1
231 236 : real(dp) , allocatable :: xsum(:)
232 : integer :: nproc_space_comm
233 : #endif
234 :
235 : ! *************************************************************************
236 :
237 236 : ier=0
238 : #if defined HAVE_MPI
239 236 : if (comm /= MPI_COMM_NULL) then
240 236 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
241 236 : if (nproc_space_comm /= 1) then
242 0 : n1 = size(xval,dim=1)
243 : ! Accumulate xval on all proc. in comm
244 0 : ABI_STAT_MALLOC(xsum,(n1), ier)
245 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
246 0 : xsum = zero ! See notes
247 0 : call MPI_REDUCE(xval,xsum,n1,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
248 0 : xval (:) = xsum(:)
249 0 : ABI_FREE(xsum)
250 : end if
251 : end if
252 : #endif
253 236 : end subroutine xmpi_sum_master_dp1d
254 : !!***
255 :
256 : !!****f* ABINIT/xmpi_sum_master_dp2d
257 : !! NAME
258 : !! xmpi_sum_master_dp2d
259 : !!
260 : !! FUNCTION
261 : !! Reduces values on all processes to a single value.
262 : !! Target: double precision two-dimensional arrays.
263 : !!
264 : !! INPUTS
265 : !! master= master MPI node
266 : !! comm= MPI communicator
267 : !!
268 : !! OUTPUT
269 : !! ier= exit status, a non-zero value meaning there is an error
270 : !!
271 : !! SIDE EFFECTS
272 : !! xval= buffer array
273 : !!
274 : !! SOURCE
275 :
276 40661218 : subroutine xmpi_sum_master_dp2d(xval,master,comm,ier)
277 :
278 : !Arguments-------------------------
279 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:)
280 : integer ,intent(in) :: master
281 : integer ,intent(in) :: comm
282 : integer ,intent(out) :: ier
283 :
284 : !Local variables-------------------
285 : #if defined HAVE_MPI
286 : integer :: my_dt,my_op,n1,n2
287 : integer(kind=int64) :: ntot
288 40661218 : real(dp) , allocatable :: xsum(:,:)
289 : integer :: nproc_space_comm
290 : #endif
291 :
292 : ! *************************************************************************
293 :
294 40661218 : ier=0
295 : #if defined HAVE_MPI
296 40661218 : if (comm /= MPI_COMM_NULL) then
297 40661218 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
298 40661218 : if (nproc_space_comm /= 1) then
299 80688 : n1 = size(xval,dim=1)
300 80688 : n2 = size(xval,dim=2)
301 :
302 322752 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
303 80688 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
304 717641536 : xsum = zero ! See notes
305 :
306 : !This product of dimensions can be greater than a 32bit integer
307 : !We use a INT64 to store it. If it is too large, we switch to an
308 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
309 80688 : ntot=int(n1,kind=int64)*n2
310 :
311 : ! Accumulate xval on all proc. in comm
312 80688 : if (ntot<=xmpi_maxint32_64) then
313 80688 : call MPI_reduce(xval,xsum,n1*n2,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
314 : else
315 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
316 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
317 0 : call xmpi_largetype_free(my_dt,my_op)
318 : end if
319 :
320 717641536 : xval (:,:) = xsum(:,:)
321 80688 : ABI_FREE(xsum)
322 : end if
323 : end if
324 : #endif
325 40661218 : end subroutine xmpi_sum_master_dp2d
326 : !!***
327 :
328 : !!****f* ABINIT/xmpi_sum_master_dp3d
329 : !! NAME
330 : !! xmpi_sum_master_dp3d
331 : !!
332 : !! FUNCTION
333 : !! Reduces values on all processes to a single value.
334 : !! Target: double precision three-dimensional arrays.
335 : !!
336 : !! INPUTS
337 : !! master= master MPI node
338 : !! comm= MPI communicator
339 : !!
340 : !! OUTPUT
341 : !! ier= exit status, a non-zero value meaning there is an error
342 : !!
343 : !! SIDE EFFECTS
344 : !! xval= buffer array
345 : !!
346 : !! SOURCE
347 :
348 22269 : subroutine xmpi_sum_master_dp3d(xval,master,comm,ier)
349 :
350 : !Arguments-------------------------
351 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
352 : integer ,intent(in) :: master
353 : integer ,intent(in) :: comm
354 : integer ,intent(out) :: ier
355 :
356 : !Local variables-------------------
357 : #if defined HAVE_MPI
358 : integer :: my_dt,my_op,n1,n2,n3
359 : integer(kind=int64) :: ntot
360 22269 : real(dp) , allocatable :: xsum(:,:,:)
361 : integer :: nproc_space_comm
362 : #endif
363 :
364 : ! *************************************************************************
365 :
366 22269 : ier=0
367 : #if defined HAVE_MPI
368 22269 : if (comm /= MPI_COMM_NULL) then
369 22269 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
370 22269 : if (nproc_space_comm /= 1) then
371 5084 : n1 = size(xval,dim=1)
372 5084 : n2 = size(xval,dim=2)
373 5084 : n3 = size(xval,dim=3)
374 25420 : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
375 5084 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
376 34695044 : xsum = zero ! See notes
377 :
378 :
379 : !This product of dimensions can be greater than a 32bit integer
380 : !We use a INT64 to store it. If it is too large, we switch to an
381 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
382 5084 : ntot=int(n1,kind=int64)*n2*n3
383 :
384 : ! Accumulate xval on all proc. in comm
385 5084 : if (ntot<=xmpi_maxint32_64) then
386 5084 : call MPI_reduce(xval,xsum,n1*n2*n3,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
387 : else
388 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
389 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
390 0 : call xmpi_largetype_free(my_dt,my_op)
391 : end if
392 :
393 34695044 : xval (:,:,:) = xsum(:,:,:)
394 5084 : ABI_FREE(xsum)
395 : end if
396 : end if
397 : #endif
398 :
399 22269 : end subroutine xmpi_sum_master_dp3d
400 : !!***
401 :
402 : !!****f* ABINIT/xmpi_sum_master_dp4d
403 : !! NAME
404 : !! xmpi_sum_master_dp4d
405 : !!
406 : !! FUNCTION
407 : !! Reduces values on all processes to a single value.
408 : !! Target: double precision four-dimensional arrays.
409 : !!
410 : !! INPUTS
411 : !! master= master MPI node
412 : !! comm= MPI communicator
413 : !!
414 : !! OUTPUT
415 : !! ier= exit status, a non-zero value meaning there is an error
416 : !!
417 : !! SIDE EFFECTS
418 : !! xval= buffer array
419 : !!
420 : !! SOURCE
421 :
422 52 : subroutine xmpi_sum_master_dp4d(xval,master,comm,ier)
423 :
424 : !Arguments-------------------------
425 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
426 : integer ,intent(in) :: master
427 : integer ,intent(in) :: comm
428 : integer ,intent(out) :: ier
429 :
430 : !Local variables-------------------
431 : #if defined HAVE_MPI
432 : integer :: my_dt,my_op,n1,n2,n3,n4
433 : integer(kind=int64) :: ntot
434 52 : real(dp) , allocatable :: xsum(:,:,:,:)
435 : integer :: nproc_space_comm
436 : #endif
437 :
438 : ! *************************************************************************
439 :
440 52 : ier=0
441 : #if defined HAVE_MPI
442 52 : if (comm /= MPI_COMM_NULL) then
443 52 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
444 52 : if (nproc_space_comm /= 1) then
445 0 : n1 = size(xval,dim=1)
446 0 : n2 = size(xval,dim=2)
447 0 : n3 = size(xval,dim=3)
448 0 : n4 = size(xval,dim=4)
449 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
450 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
451 0 : xsum = zero ! See notes
452 :
453 : !This product of dimensions can be greater than a 32bit integer
454 : !We use a INT64 to store it. If it is too large, we switch to an
455 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
456 0 : ntot=int(n1,kind=int64)*n2*n3*n4
457 :
458 : ! Accumulate xval on all proc. in comm
459 0 : if (ntot<=xmpi_maxint32_64) then
460 0 : call MPI_reduce(xval,xsum,n1*n2*n3*n4,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
461 : else
462 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
463 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
464 0 : call xmpi_largetype_free(my_dt,my_op)
465 : end if
466 :
467 0 : xval (:,:,:,:) = xsum(:,:,:,:)
468 0 : ABI_FREE(xsum)
469 : end if
470 : end if
471 : #endif
472 :
473 52 : end subroutine xmpi_sum_master_dp4d
474 : !!***
475 :
476 : !!****f* ABINIT/xmpi_sum_master_dp5d
477 : !! NAME
478 : !! xmpi_sum_master_dp5d
479 : !!
480 : !! FUNCTION
481 : !! Reduces values on all processes to a single value.
482 : !! Target: double precision five-dimensional arrays.
483 : !!
484 : !! INPUTS
485 : !! master= master MPI node
486 : !! comm= MPI communicator
487 : !!
488 : !! OUTPUT
489 : !! ier= exit status, a non-zero value meaning there is an error
490 : !!
491 : !! SIDE EFFECTS
492 : !! xval= buffer array
493 : !!
494 : !! SOURCE
495 :
496 3 : subroutine xmpi_sum_master_dp5d(xval,master,comm,ier)
497 :
498 : !Arguments ------------------------------------
499 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
500 : integer ,intent(in) :: master
501 : integer ,intent(in) :: comm
502 : integer ,intent(out) :: ier
503 :
504 : !Local variables-------------------------------
505 : #if defined HAVE_MPI
506 : integer :: my_dt,my_op,n1,n2,n3,n4,n5
507 : integer(kind=int64) :: ntot
508 3 : real(dp), allocatable :: xsum(:,:,:,:,:)
509 : integer :: nproc_space_comm
510 : #endif
511 :
512 : ! *************************************************************************
513 :
514 3 : ier=0
515 : #if defined HAVE_MPI
516 3 : if (comm /= MPI_COMM_NULL) then
517 3 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
518 3 : if (nproc_space_comm /= 1) then
519 0 : n1 = size(xval,dim=1)
520 0 : n2 = size(xval,dim=2)
521 0 : n3 = size(xval,dim=3)
522 0 : n4 = size(xval,dim=4)
523 0 : n5 = size(xval,dim=5)
524 :
525 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5), ier)
526 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
527 0 : xsum = zero ! See notes
528 :
529 : !This product of dimensions can be greater than a 32bit integer
530 : !We use a INT64 to store it. If it is too large, we switch to an
531 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
532 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5
533 :
534 : ! Accumulate xval on all proc. in comm
535 0 : if (ntot<=xmpi_maxint32_64) then
536 0 : call MPI_reduce(xval,xsum,n1*n2*n3*n4*n5,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
537 : else
538 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
539 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
540 0 : call xmpi_largetype_free(my_dt,my_op)
541 : end if
542 :
543 0 : xval (:,:,:,:,:) = xsum(:,:,:,:,:)
544 0 : ABI_FREE(xsum)
545 : end if
546 : end if
547 : #endif
548 :
549 3 : end subroutine xmpi_sum_master_dp5d
550 : !!***
551 :
552 : !!****f* ABINIT/xmpi_sum_master_dp6d
553 : !! NAME
554 : !! xmpi_sum_master_dp6d
555 : !!
556 : !! FUNCTION
557 : !! Reduces values on all processes to a single value.
558 : !! Target: double precision six-dimensional arrays.
559 : !!
560 : !! INPUTS
561 : !! master= master MPI node
562 : !! comm= MPI communicator
563 : !!
564 : !! OUTPUT
565 : !! ier= exit status, a non-zero value meaning there is an error
566 : !!
567 : !! SIDE EFFECTS
568 : !! xval= buffer array
569 : !!
570 : !! SOURCE
571 :
572 6 : subroutine xmpi_sum_master_dp6d(xval,master,comm,ier)
573 :
574 : !Arguments ------------------------------------
575 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:)
576 : integer ,intent(in) :: master
577 : integer ,intent(in) :: comm
578 : integer ,intent(out) :: ier
579 :
580 : !Local variables-------------------------------
581 : #if defined HAVE_MPI
582 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6
583 : integer(kind=int64) :: ntot
584 6 : real(dp), allocatable :: xsum(:,:,:,:,:,:)
585 : integer :: nproc_space_comm
586 : #endif
587 :
588 : ! *************************************************************************
589 :
590 6 : ier=0
591 : #if defined HAVE_MPI
592 6 : if (comm /= MPI_COMM_NULL) then
593 6 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
594 6 : if (nproc_space_comm /= 1) then
595 0 : n1 = size(xval,dim=1)
596 0 : n2 = size(xval,dim=2)
597 0 : n3 = size(xval,dim=3)
598 0 : n4 = size(xval,dim=4)
599 0 : n5 = size(xval,dim=5)
600 0 : n6 = size(xval,dim=6)
601 :
602 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6), ier)
603 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
604 0 : xsum = zero ! See notes
605 :
606 : !This product of dimensions can be greater than a 32bit integer
607 : !We use a INT64 to store it. If it is too large, we switch to an
608 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
609 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5*n6
610 :
611 : ! Accumulate xval on all proc. in comm
612 0 : if (ntot<=xmpi_maxint32_64) then
613 0 : call MPI_reduce(xval,xsum,n1*n2*n3*n4*n5*n6,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
614 : else
615 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
616 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
617 0 : call xmpi_largetype_free(my_dt,my_op)
618 : end if
619 :
620 0 : xval (:,:,:,:,:,:) = xsum(:,:,:,:,:,:)
621 0 : ABI_FREE(xsum)
622 : end if
623 : end if
624 : #endif
625 :
626 6 : end subroutine xmpi_sum_master_dp6d
627 : !!***
628 :
629 : !!****f* ABINIT/xmpi_sum_master_dp7d
630 : !! NAME
631 : !! xmpi_sum_master_dp7d
632 : !!
633 : !! FUNCTION
634 : !! Reduces values on all processes to a single value.
635 : !! Target: double precision seven-dimensional arrays.
636 : !!
637 : !! INPUTS
638 : !! master= master MPI node
639 : !! comm= MPI communicator
640 : !!
641 : !! OUTPUT
642 : !! ier= exit status, a non-zero value meaning there is an error
643 : !!
644 : !! SIDE EFFECTS
645 : !! xval= buffer array
646 : !!
647 : !! SOURCE
648 :
649 0 : subroutine xmpi_sum_master_dp7d(xval,master,comm,ier)
650 :
651 : !Arguments ------------------------------------
652 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:,:)
653 : integer ,intent(in) :: master
654 : integer ,intent(in) :: comm
655 : integer ,intent(out) :: ier
656 :
657 : !Local variables-------------------------------
658 : #if defined HAVE_MPI
659 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6,n7
660 : integer(kind=int64) :: ntot
661 0 : real(dp), allocatable :: xsum(:,:,:,:,:,:,:)
662 : integer :: nproc_space_comm
663 : #endif
664 :
665 : ! *************************************************************************
666 :
667 0 : ier=0
668 : #if defined HAVE_MPI
669 0 : if (comm /= MPI_COMM_NULL) then
670 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
671 0 : if (nproc_space_comm /= 1) then
672 0 : n1 = size(xval,dim=1)
673 0 : n2 = size(xval,dim=2)
674 0 : n3 = size(xval,dim=3)
675 0 : n4 = size(xval,dim=4)
676 0 : n5 = size(xval,dim=5)
677 0 : n6 = size(xval,dim=6)
678 0 : n7 = size(xval,dim=7)
679 :
680 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6,n7), ier)
681 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
682 0 : xsum = zero ! See notes
683 :
684 : !This product of dimensions can be greater than a 32bit integer
685 : !We use a INT64 to store it. If it is too large, we switch to an
686 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
687 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5*n6*n7
688 :
689 : ! Accumulate xval on all proc. in comm
690 0 : if (ntot<=xmpi_maxint32_64) then
691 0 : call MPI_reduce(xval,xsum,n1*n2*n3*n4*n5*n6*n7,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
692 : else
693 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
694 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
695 0 : call xmpi_largetype_free(my_dt,my_op)
696 : end if
697 :
698 0 : xval (:,:,:,:,:,:,:) = xsum(:,:,:,:,:,:,:)
699 0 : ABI_FREE(xsum)
700 : end if
701 : end if
702 : #endif
703 :
704 0 : end subroutine xmpi_sum_master_dp7d
705 : !!***
706 :
707 : !!****f* ABINIT/xmpi_sum_master_int4d
708 : !! NAME
709 : !! xmpi_sum_master_int4d
710 : !!
711 : !! FUNCTION
712 : !! Reduces values on all processes to a single value.
713 : !! Target: four-diemnsional integer arrays.
714 : !!
715 : !! INPUTS
716 : !! master= master MPI node
717 : !! comm= MPI communicator
718 : !!
719 : !! OUTPUT
720 : !! ier= exit status, a non-zero value meaning there is an error
721 : !!
722 : !! SIDE EFFECTS
723 : !! xval= buffer array
724 : !!
725 : !! SOURCE
726 :
727 0 : subroutine xmpi_sum_master_int4d(xval,master,comm,ier)
728 :
729 : !Arguments ------------------------------------
730 : integer, DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
731 : integer,intent(in) :: master
732 : integer,intent(in) :: comm
733 : integer,intent(out) :: ier
734 :
735 : !Local variables-------------------------------
736 : #if defined HAVE_MPI
737 : integer :: my_dt,my_op,n1,n2,n3,n4
738 : integer(kind=int64) :: ntot
739 0 : integer, allocatable :: xsum(:,:,:,:)
740 : integer :: nproc_space_comm
741 : #endif
742 :
743 : ! *************************************************************************
744 :
745 0 : ier=0
746 : #if defined HAVE_MPI
747 0 : if (comm /= MPI_COMM_NULL) then
748 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
749 0 : if (nproc_space_comm /= 1) then
750 0 : n1 = size(xval,dim=1)
751 0 : n2 = size(xval,dim=2)
752 0 : n3 = size(xval,dim=3)
753 0 : n4 = size(xval,dim=4)
754 :
755 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
756 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
757 0 : xsum = 0 ! See notes
758 :
759 : !This product of dimensions can be greater than a 32bit integer
760 : !We use a INT64 to store it. If it is too large, we switch to an
761 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
762 0 : ntot=int(n1,kind=int64)*n2*n3*n4
763 :
764 : ! Accumulate xval on all proc. in comm
765 0 : if (ntot<=xmpi_maxint32_64) then
766 0 : call MPI_reduce(xval,xsum,n1*n2*n3*n4,MPI_INTEGER,MPI_SUM,master,comm,ier)
767 : else
768 0 : call xmpi_largetype_create(ntot,MPI_INTEGER,my_dt,my_op,MPI_SUM)
769 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
770 0 : call xmpi_largetype_free(my_dt,my_op)
771 : end if
772 :
773 0 : xval (:,:,:,:) = xsum(:,:,:,:)
774 0 : ABI_FREE(xsum)
775 : end if
776 : end if
777 : #endif
778 :
779 0 : end subroutine xmpi_sum_master_int4d
780 : !!***
781 :
782 : !!****f* ABINIT/xmpi_sum_master_c1cplx
783 : !! NAME
784 : !! xmpi_sum_master_c1cplx
785 : !!
786 : !! FUNCTION
787 : !! Reduces values on all processes to a single value.
788 : !! Target: one-dimensional complex arrays.
789 : !!
790 : !! INPUTS
791 : !! master= master MPI node
792 : !! comm= MPI communicator
793 : !!
794 : !! OUTPUT
795 : !! ier= exit status, a non-zero value meaning there is an error
796 : !!
797 : !! SIDE EFFECTS
798 : !! xval= buffer array
799 : !!
800 : !! SOURCE
801 :
802 0 : subroutine xmpi_sum_master_c1cplx(xval,master,comm,ier)
803 :
804 : !Arguments-------------------------
805 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:)
806 : integer ,intent(in) :: master
807 : integer ,intent(in) :: comm
808 : integer ,intent(out) :: ier
809 :
810 : !Local variables-------------------
811 : #if defined HAVE_MPI
812 : integer :: n1,nproc_space_comm
813 0 : complex(sp),allocatable :: xsum(:)
814 : #endif
815 : ! *************************************************************************
816 :
817 0 : ier=0
818 : #if defined HAVE_MPI
819 0 : if (comm /= MPI_COMM_NULL) then
820 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
821 0 : if (nproc_space_comm /= 1) then
822 0 : n1 = size(xval,dim=1)
823 0 : ABI_STAT_MALLOC(xsum,(n1), ier)
824 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
825 0 : xsum = (0_sp,0_sp) ! See notes
826 : ! Collect xval from processors on master in comm
827 0 : call MPI_REDUCE(xval,xsum,n1,MPI_COMPLEX,MPI_SUM,master,comm,ier)
828 0 : xval = xsum
829 0 : ABI_FREE(xsum)
830 : end if
831 : end if
832 : #endif
833 :
834 0 : end subroutine xmpi_sum_master_c1cplx
835 : !!***
836 :
837 : !!****f* ABINIT/xmpi_sum_master_c2cplx
838 : !! NAME
839 : !! xmpi_sum_master_c2cplx
840 : !!
841 : !! FUNCTION
842 : !! Reduces values on all processes to a single value.
843 : !! Target: two-dimensional complex arrays.
844 : !!
845 : !! INPUTS
846 : !! master= master MPI node
847 : !! comm= MPI communicator
848 : !!
849 : !! OUTPUT
850 : !! ier= exit status, a non-zero value meaning there is an error
851 : !!
852 : !! SIDE EFFECTS
853 : !! xval= buffer array
854 : !!
855 : !! SOURCE
856 :
857 0 : subroutine xmpi_sum_master_c2cplx(xval,master,comm,ier)
858 :
859 : !Arguments-------------------------
860 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:)
861 : integer,intent(in) :: master
862 : integer,intent(in) :: comm
863 : integer,intent(out) :: ier
864 :
865 : !Local variables-------------------
866 : #if defined HAVE_MPI
867 : integer :: my_dt,my_op,n1,n2
868 : integer(kind=int64) :: ntot
869 : integer :: nproc_space_comm
870 0 : complex(sp),allocatable :: xsum(:,:)
871 : #endif
872 : ! *************************************************************************
873 :
874 0 : ier=0
875 : #if defined HAVE_MPI
876 0 : if (comm /= MPI_COMM_NULL) then
877 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
878 0 : if (nproc_space_comm /= 1) then
879 0 : n1 = size(xval,dim=1)
880 0 : n2 = size(xval,dim=2)
881 :
882 0 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
883 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
884 0 : xsum = (0_sp,0_sp) ! See notes
885 :
886 : !This product of dimensions can be greater than a 32bit integer
887 : !We use a INT64 to store it. If it is too large, we switch to an
888 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
889 0 : ntot=int(n1,kind=int64)*n2
890 :
891 : ! Accumulate xval on all proc. in comm
892 0 : if (ntot<=xmpi_maxint32_64) then
893 0 : call MPI_reduce(xval,xsum,n1*n2,MPI_COMPLEX,MPI_SUM,master,comm,ier)
894 : else
895 0 : call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
896 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
897 0 : call xmpi_largetype_free(my_dt,my_op)
898 : end if
899 :
900 0 : xval (:,:) = xsum(:,:)
901 0 : ABI_FREE(xsum)
902 : end if
903 : end if
904 : #endif
905 :
906 0 : end subroutine xmpi_sum_master_c2cplx
907 : !!***
908 :
909 : !!****f* ABINIT/xmpi_sum_master_c3cplx
910 : !! NAME
911 : !! xmpi_sum_master_c3cplx
912 : !!
913 : !! FUNCTION
914 : !! Reduces values on all processes to a single value.
915 : !! Target: three-dimensional complex arrays.
916 : !!
917 : !! INPUTS
918 : !! master= master MPI node
919 : !! comm= MPI communicator
920 : !!
921 : !! OUTPUT
922 : !! ier= exit status, a non-zero value meaning there is an error
923 : !!
924 : !! SIDE EFFECTS
925 : !! xval= buffer array
926 : !!
927 : !! SOURCE
928 :
929 0 : subroutine xmpi_sum_master_c3cplx(xval,master,comm,ier)
930 :
931 : !Arguments-------------------------
932 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
933 : integer,intent(in) :: master
934 : integer,intent(in) :: comm
935 : integer,intent(out) :: ier
936 :
937 : !Local variables-------------------
938 : #if defined HAVE_MPI
939 : integer :: my_dt,my_op,n1,n2,n3
940 : integer(kind=int64) :: ntot
941 0 : complex(sp), allocatable :: xsum(:,:,:)
942 : integer :: nproc_space_comm
943 : #endif
944 : ! *************************************************************************
945 :
946 0 : ier=0
947 : #if defined HAVE_MPI
948 0 : if (comm /= MPI_COMM_NULL) then
949 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
950 0 : if (nproc_space_comm /= 1) then
951 0 : n1 = size(xval,dim=1)
952 0 : n2 = size(xval,dim=2)
953 0 : n3 = size(xval,dim=3)
954 :
955 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
956 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
957 0 : xsum = (0_sp,0_sp) ! See notes
958 :
959 : !This product of dimensions can be greater than a 32bit integer
960 : !We use a INT64 to store it. If it is too large, we switch to an
961 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
962 0 : ntot=int(n1,kind=int64)*n2*n3
963 :
964 : ! Accumulate xval on all proc. in comm
965 0 : if (ntot<=xmpi_maxint32_64) then
966 0 : call MPI_reduce(xval,xsum,n1*n2*n3,MPI_COMPLEX,MPI_SUM,master,comm,ier)
967 : else
968 0 : call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
969 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
970 0 : call xmpi_largetype_free(my_dt,my_op)
971 : end if
972 :
973 0 : xval (:,:,:) = xsum(:,:,:)
974 0 : ABI_FREE(xsum)
975 : end if
976 : end if
977 : #endif
978 :
979 0 : end subroutine xmpi_sum_master_c3cplx
980 : !!***
981 :
982 : !!****f* ABINIT/xmpi_sum_master_c4cplx
983 : !! NAME
984 : !! xmpi_sum_master_c4cplx
985 : !!
986 : !! FUNCTION
987 : !! Reduces values on all processes to a single value.
988 : !! Target: four-dimensional complex arrays.
989 : !!
990 : !! INPUTS
991 : !! master= master MPI node
992 : !! comm= MPI communicator
993 : !!
994 : !! OUTPUT
995 : !! ier= exit status, a non-zero value meaning there is an error
996 : !!
997 : !! SIDE EFFECTS
998 : !! xval= buffer array
999 : !!
1000 : !! SOURCE
1001 :
1002 0 : subroutine xmpi_sum_master_c4cplx(xval,master,comm,ier)
1003 :
1004 : !Arguments-------------------------
1005 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
1006 : integer,intent(in) :: master
1007 : integer,intent(in) :: comm
1008 : integer,intent(out) :: ier
1009 :
1010 : !Local variables-------------------
1011 : #if defined HAVE_MPI
1012 : integer :: my_dt,my_op,n1,n2,n3,n4
1013 : integer(kind=int64) :: ntot
1014 : integer :: nproc_space_comm
1015 0 : complex(sp), allocatable :: xsum(:,:,:,:)
1016 : #endif
1017 : ! *************************************************************************
1018 :
1019 0 : ier=0
1020 : #if defined HAVE_MPI
1021 0 : if (comm /= MPI_COMM_NULL) then
1022 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1023 0 : if (nproc_space_comm /= 1) then
1024 0 : n1 = size(xval,dim=1)
1025 0 : n2 = size(xval,dim=2)
1026 0 : n3 = size(xval,dim=3)
1027 0 : n4 = size(xval,dim=4)
1028 :
1029 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
1030 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1031 0 : xsum = (0_sp,0_sp) ! See notes
1032 :
1033 : !This product of dimensions can be greater than a 32bit integer
1034 : !We use a INT64 to store it. If it is too large, we switch to an
1035 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1036 0 : ntot=int(n1,kind=int64)*n2*n3*n4
1037 :
1038 : ! Accumulate xval on all proc. in comm
1039 0 : if (ntot<=xmpi_maxint32_64) then
1040 0 : call MPI_reduce(xval,xsum,n1*n2*n3*n4,MPI_COMPLEX,MPI_SUM,master,comm,ier)
1041 : else
1042 0 : call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
1043 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1044 0 : call xmpi_largetype_free(my_dt,my_op)
1045 : end if
1046 :
1047 0 : xval (:,:,:,:) = xsum(:,:,:,:)
1048 0 : ABI_FREE(xsum)
1049 : end if
1050 : end if
1051 : #endif
1052 0 : end subroutine xmpi_sum_master_c4cplx
1053 : !!***
1054 :
1055 : !----------------------------------------------------------------------
1056 :
1057 : !!****f* ABINIT/xmpi_sum_master_c5cplx
1058 : !! NAME
1059 : !! xmpi_sum_master_c5cplx
1060 : !!
1061 : !! FUNCTION
1062 : !! Reduces values on all processes to a single value.
1063 : !! Target: five-dimensional single precision complex arrays.
1064 : !!
1065 : !! INPUTS
1066 : !! master= master MPI node
1067 : !! comm= MPI communicator
1068 : !!
1069 : !! OUTPUT
1070 : !! ier= exit status, a non-zero value meaning there is an error
1071 : !!
1072 : !! SIDE EFFECTS
1073 : !! xval= buffer array
1074 : !!
1075 : !! SOURCE
1076 :
1077 0 : subroutine xmpi_sum_master_c5cplx(xval,master,comm,ier)
1078 :
1079 : !Arguments-------------------------
1080 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
1081 : integer,intent(in) :: master
1082 : integer,intent(in) :: comm
1083 : integer,intent(out) :: ier
1084 :
1085 : !Local variables-------------------
1086 : #if defined HAVE_MPI
1087 : integer :: my_dt,my_op,n1,n2,n3,n4,n5
1088 : integer(kind=int64) :: ntot
1089 0 : complex(sp),allocatable :: xsum(:,:,:,:,:)
1090 : integer :: nproc_space_comm
1091 : #endif
1092 : ! *************************************************************************
1093 :
1094 0 : ier=0
1095 : #if defined HAVE_MPI
1096 0 : if (comm /= MPI_COMM_NULL) then
1097 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1098 0 : if (nproc_space_comm /= 1) then
1099 0 : n1 = size(xval,dim=1)
1100 0 : n2 = size(xval,dim=2)
1101 0 : n3 = size(xval,dim=3)
1102 0 : n4 = size(xval,dim=4)
1103 0 : n5 = size(xval,dim=5)
1104 :
1105 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5), ier)
1106 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1107 0 : xsum = (0_sp,0_sp) ! See notes
1108 :
1109 : !This product of dimensions can be greater than a 32bit integer
1110 : !We use a INT64 to store it. If it is too large, we switch to an
1111 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1112 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5
1113 :
1114 : ! Accumulate xval on all proc. in comm
1115 0 : if (ntot<=xmpi_maxint32_64) then
1116 0 : call MPI_reduce(xval,xsum,n1*n2*n3*n4*n5,MPI_COMPLEX,MPI_SUM,master,comm,ier)
1117 : else
1118 0 : call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
1119 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1120 0 : call xmpi_largetype_free(my_dt,my_op)
1121 : end if
1122 :
1123 0 : xval = xsum
1124 0 : ABI_FREE(xsum)
1125 : end if
1126 : end if
1127 : #endif
1128 0 : end subroutine xmpi_sum_master_c5cplx
1129 : !!***
1130 :
1131 : !!****f* ABINIT/xmpi_sum_master_c1dpc
1132 : !! NAME
1133 : !! xmpi_sum_master_c1dpc
1134 : !!
1135 : !! FUNCTION
1136 : !! Reduces values on all processes to a single value.
1137 : !! Target: one-dimensional double complex arrays.
1138 : !!
1139 : !! INPUTS
1140 : !! master= master MPI node
1141 : !! comm= MPI communicator
1142 : !!
1143 : !! OUTPUT
1144 : !! ier= exit status, a non-zero value meaning there is an error
1145 : !!
1146 : !! SIDE EFFECTS
1147 : !! xval= buffer array
1148 : !!
1149 : !! SOURCE
1150 :
1151 454 : subroutine xmpi_sum_master_c1dpc(xval,master,comm,ier)
1152 :
1153 : !Arguments-------------------------
1154 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:)
1155 : integer,intent(in) :: master
1156 : integer,intent(in) :: comm
1157 : integer,intent(out) :: ier
1158 :
1159 : !Local variables-------------------
1160 : #if defined HAVE_MPI
1161 : integer :: n1
1162 : integer :: nproc_space_comm
1163 454 : complex(dp),allocatable :: xsum(:)
1164 : #endif
1165 :
1166 : ! *************************************************************************
1167 :
1168 454 : ier=0
1169 : #if defined HAVE_MPI
1170 454 : if (comm /= MPI_COMM_NULL) then
1171 454 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1172 454 : if (nproc_space_comm /= 1) then
1173 72 : n1 = size(xval,dim=1)
1174 : ! Collect xval from processors on master in comm
1175 216 : ABI_STAT_MALLOC(xsum,(n1), ier)
1176 72 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1177 27720 : xsum = (0_dp,0_dp) ! See notes
1178 72 : call MPI_REDUCE(xval,xsum,n1,MPI_DOUBLE_COMPLEX,MPI_SUM,master,comm,ier)
1179 27720 : xval (:) = xsum(:)
1180 72 : ABI_FREE(xsum)
1181 : end if
1182 : end if
1183 : #endif
1184 :
1185 454 : end subroutine xmpi_sum_master_c1dpc
1186 : !!***
1187 :
1188 : !!****f* ABINIT/xmpi_sum_master_c2dpc
1189 : !! NAME
1190 : !! xmpi_sum_master_c2dpc
1191 : !!
1192 : !! FUNCTION
1193 : !! Reduces values on all processes to a single value.
1194 : !! Target: two-dimensional double complex arrays.
1195 : !!
1196 : !! INPUTS
1197 : !! master= master MPI node
1198 : !! comm= MPI communicator
1199 : !!
1200 : !! OUTPUT
1201 : !! ier= exit status, a non-zero value meaning there is an error
1202 : !!
1203 : !! SIDE EFFECTS
1204 : !! xval= buffer array
1205 : !!
1206 : !! SOURCE
1207 :
1208 1092 : subroutine xmpi_sum_master_c2dpc(xval,master,comm,ier)
1209 :
1210 : !Arguments-------------------------
1211 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:)
1212 : integer ,intent(in) :: master
1213 : integer ,intent(in) :: comm
1214 : integer ,intent(out) :: ier
1215 :
1216 : !Local variables-------------------
1217 : #if defined HAVE_MPI
1218 : integer :: my_dt,my_op,n1,n2
1219 : integer(kind=int64) :: ntot
1220 1092 : complex(dp) , allocatable :: xsum(:,:)
1221 : integer :: nproc_space_comm
1222 : #endif
1223 :
1224 : ! *************************************************************************
1225 :
1226 1092 : ier=0
1227 : #if defined HAVE_MPI
1228 1092 : if (comm /= MPI_COMM_NULL) then
1229 1092 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1230 1092 : if (nproc_space_comm /= 1) then
1231 0 : n1 = size(xval,dim=1)
1232 0 : n2 = size(xval,dim=2)
1233 :
1234 0 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
1235 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1236 0 : xsum = (0_dp,0_dp) ! See notes
1237 :
1238 : !This product of dimensions can be greater than a 32bit integer
1239 : !We use a INT64 to store it. If it is too large, we switch to an
1240 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1241 0 : ntot=int(n1,kind=int64)*n2
1242 :
1243 : ! Accumulate xval on all proc. in comm
1244 0 : if (ntot<=xmpi_maxint32_64) then
1245 0 : call MPI_reduce(xval,xsum,n1*n2,MPI_DOUBLE_COMPLEX,MPI_SUM,master,comm,ier)
1246 : else
1247 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
1248 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1249 0 : call xmpi_largetype_free(my_dt,my_op)
1250 : end if
1251 :
1252 0 : xval (:,:) = xsum(:,:)
1253 0 : ABI_FREE(xsum)
1254 : end if
1255 : end if
1256 : #endif
1257 :
1258 1092 : end subroutine xmpi_sum_master_c2dpc
1259 : !!***
1260 :
1261 : !!****f* ABINIT/xmpi_sum_master_c3dpc
1262 : !! NAME
1263 : !! xmpi_sum_master_c3dpc
1264 : !!
1265 : !! FUNCTION
1266 : !! Reduces values on all processes to a single value.
1267 : !! Target: three-dimensional double complex arrays.
1268 : !!
1269 : !! INPUTS
1270 : !! master= master MPI node
1271 : !! comm= MPI communicator
1272 : !!
1273 : !! OUTPUT
1274 : !! ier= exit status, a non-zero value meaning there is an error
1275 : !!
1276 : !! SIDE EFFECTS
1277 : !! xval= buffer array
1278 : !!
1279 : !! SOURCE
1280 :
1281 54 : subroutine xmpi_sum_master_c3dpc(xval,master,comm,ier)
1282 :
1283 : !Arguments-------------------------
1284 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
1285 : integer,intent(in) :: master
1286 : integer,intent(in) :: comm
1287 : integer,intent(out) :: ier
1288 :
1289 : !Local variables-------------------
1290 : #if defined HAVE_MPI
1291 : integer :: my_dt,my_op,n1,n2,n3
1292 : integer(kind=int64) :: ntot
1293 54 : complex(dp) , allocatable :: xsum(:,:,:)
1294 : integer :: nproc_space_comm
1295 : #endif
1296 :
1297 : ! *************************************************************************
1298 :
1299 54 : ier=0
1300 : #if defined HAVE_MPI
1301 54 : if (comm /= MPI_COMM_NULL) then
1302 54 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1303 54 : if (nproc_space_comm /= 1) then
1304 0 : n1 = size(xval,dim=1)
1305 0 : n2 = size(xval,dim=2)
1306 0 : n3 = size(xval,dim=3)
1307 :
1308 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
1309 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1310 0 : xsum = (0_dp,0_dp) ! See notes
1311 :
1312 : !This product of dimensions can be greater than a 32bit integer
1313 : !We use a INT64 to store it. If it is too large, we switch to an
1314 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1315 0 : ntot=int(n1,kind=int64)*n2*n3
1316 :
1317 : ! Accumulate xval on all proc. in comm
1318 0 : if (ntot<=xmpi_maxint32_64) then
1319 0 : call MPI_reduce(xval,xsum,n1*n2*n3,MPI_DOUBLE_COMPLEX,MPI_SUM,master,comm,ier)
1320 : else
1321 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
1322 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1323 0 : call xmpi_largetype_free(my_dt,my_op)
1324 : end if
1325 :
1326 0 : xval (:,:,:) = xsum(:,:,:)
1327 0 : ABI_FREE(xsum)
1328 : end if
1329 : end if
1330 : #endif
1331 54 : end subroutine xmpi_sum_master_c3dpc
1332 : !!***
1333 :
1334 : !!****f* ABINIT/xmpi_sum_master_c4dpc
1335 : !! NAME
1336 : !! xmpi_sum_master_c4dpc
1337 : !!
1338 : !! FUNCTION
1339 : !! Reduces values on all processes to a single value.
1340 : !! Target: four-dimensional double complex arrays.
1341 : !!
1342 : !! INPUTS
1343 : !! master= master MPI node
1344 : !! comm= MPI communicator
1345 : !!
1346 : !! OUTPUT
1347 : !! ier= exit status, a non-zero value meaning there is an error
1348 : !!
1349 : !! SIDE EFFECTS
1350 : !! xval= buffer array
1351 : !!
1352 : !! SOURCE
1353 :
1354 0 : subroutine xmpi_sum_master_c4dpc(xval,master,comm,ier)
1355 :
1356 : !Arguments-------------------------
1357 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
1358 : integer,intent(in) :: master
1359 : integer,intent(in) :: comm
1360 : integer,intent(out) :: ier
1361 :
1362 : !Local variables-------------------
1363 : #if defined HAVE_MPI
1364 : integer :: my_dt,my_op,n1,n2,n3,n4
1365 : integer(kind=int64) :: ntot
1366 0 : complex(dp) , allocatable :: xsum(:,:,:,:)
1367 : integer :: nproc_space_comm
1368 : #endif
1369 :
1370 : ! *************************************************************************
1371 :
1372 0 : ier=0
1373 : #if defined HAVE_MPI
1374 0 : if (comm /= MPI_COMM_NULL) then
1375 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1376 0 : if (nproc_space_comm /= 1) then
1377 0 : n1 = size(xval,dim=1)
1378 0 : n2 = size(xval,dim=2)
1379 0 : n3 = size(xval,dim=3)
1380 0 : n4 = size(xval,dim=4)
1381 :
1382 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
1383 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1384 0 : xsum = (0_dp,0_dp) ! See notes
1385 :
1386 : !This product of dimensions can be greater than a 32bit integer
1387 : !We use a INT64 to store it. If it is too large, we switch to an
1388 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1389 0 : ntot=int(n1,kind=int64)*n2*n3*n4
1390 :
1391 : ! Accumulate xval on all proc. in comm
1392 0 : if (ntot<=xmpi_maxint32_64) then
1393 0 : call MPI_reduce(xval,xsum,n1*n2*n3*n4,MPI_DOUBLE_COMPLEX,MPI_SUM,master,comm,ier)
1394 : else
1395 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
1396 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1397 0 : call xmpi_largetype_free(my_dt,my_op)
1398 : end if
1399 :
1400 0 : xval (:,:,:,:) = xsum(:,:,:,:)
1401 0 : ABI_FREE(xsum)
1402 : end if
1403 : end if
1404 : #endif
1405 0 : end subroutine xmpi_sum_master_c4dpc
1406 : !!***
1407 :
1408 : !!****f* ABINIT/xmpi_sum_master_c5dpc
1409 : !! NAME
1410 : !! xmpi_sum_master_c5dpc
1411 : !!
1412 : !! FUNCTION
1413 : !! Reduces values on all processes to a single value.
1414 : !! Target: five-dimensional double complex arrays.
1415 : !!
1416 : !! INPUTS
1417 : !! master= master MPI node
1418 : !! comm= MPI communicator
1419 : !!
1420 : !! OUTPUT
1421 : !! ier= exit status, a non-zero value meaning there is an error
1422 : !!
1423 : !! SIDE EFFECTS
1424 : !! xval= buffer array
1425 : !!
1426 : !! SOURCE
1427 :
1428 0 : subroutine xmpi_sum_master_c5dpc(xval,master,comm,ier)
1429 :
1430 : !Arguments-------------------------
1431 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
1432 : integer,intent(in) :: master
1433 : integer,intent(in) :: comm
1434 : integer,intent(out) :: ier
1435 :
1436 : !Local variables-------------------
1437 : #if defined HAVE_MPI
1438 : integer :: my_dt,my_op,n1,n2,n3,n4,n5
1439 : integer(kind=int64) :: ntot
1440 0 : complex(dp),allocatable :: xsum(:,:,:,:,:)
1441 : integer :: nproc_space_comm
1442 : #endif
1443 :
1444 : ! *************************************************************************
1445 :
1446 0 : ier=0
1447 : #if defined HAVE_MPI
1448 0 : if (comm /= MPI_COMM_NULL) then
1449 0 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1450 0 : if (nproc_space_comm /= 1) then
1451 0 : n1 = size(xval,dim=1)
1452 0 : n2 = size(xval,dim=2)
1453 0 : n3 = size(xval,dim=3)
1454 0 : n4 = size(xval,dim=4)
1455 0 : n5 = size(xval,dim=5)
1456 :
1457 0 : ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5), ier)
1458 0 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1459 0 : xsum = (0_dp,0_dp) ! See notes
1460 :
1461 : !This product of dimensions can be greater than a 32bit integer
1462 : !We use a INT64 to store it. If it is too large, we switch to an
1463 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1464 0 : ntot=int(n1,kind=int64)*n2*n3*n4*n5
1465 :
1466 : ! Accumulate xval on all proc. in comm
1467 0 : if (ntot<=xmpi_maxint32_64) then
1468 0 : call MPI_reduce(xval,xsum,n1*n2*n3*n4*n5,MPI_DOUBLE_COMPLEX,MPI_SUM,master,comm,ier)
1469 : else
1470 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
1471 0 : call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1472 0 : call xmpi_largetype_free(my_dt,my_op)
1473 : end if
1474 :
1475 0 : xval (:,:,:,:,:) = xsum(:,:,:,:,:)
1476 0 : ABI_FREE(xsum)
1477 : end if
1478 : end if
1479 : #endif
1480 0 : end subroutine xmpi_sum_master_c5dpc
1481 : !!***
|
