Branch data 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 : 4188 : 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 : 4188 : ier=0
115 : : #if defined HAVE_MPI
116 [ + - ]: 4188 : if (comm /= MPI_COMM_NULL) then
117 : 4188 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
118 [ - + ]: 4188 : 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 : 4188 : 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 [ - + ]: 1018 : 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 : 1018 : integer, allocatable :: xsum(:,:)
160 : : integer :: nproc_space_comm
161 : : #endif
162 : :
163 : : ! *************************************************************************
164 : :
165 : 1018 : ier=0
166 : : #if defined HAVE_MPI
167 [ + - ]: 1018 : if (comm /= MPI_COMM_NULL) then
168 : 1018 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
169 [ + - ]: 1018 : if (nproc_space_comm /= 1) then
170 : 1018 : n1 = size(xval,dim=1)
171 : 1018 : n2 = size(xval,dim=2)
172 : :
173 [ - + + - : 4072 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
- + + - +
- + - + -
- + ]
174 [ + - ]: 1018 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
175 [ + + + + ]: 2348098 : 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 : 1018 : ntot=int(n1,kind=int64)*n2
181 : :
182 : : ! Accumulate xval on all proc. in comm
183 [ + - ]: 1018 : if (ntot<=xmpi_maxint32_64) then
184 [ - + ]: 1018 : 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 [ + + + + ]: 2348098 : xval = xsum
192 [ - + ]: 1018 : ABI_FREE(xsum)
193 : : end if
194 : : end if
195 : : #endif
196 : :
197 : 1018 : 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 [ - + ]: 240 : 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 : 240 : real(dp) , allocatable :: xsum(:)
232 : : integer :: nproc_space_comm
233 : : #endif
234 : :
235 : : ! *************************************************************************
236 : :
237 : 240 : ier=0
238 : : #if defined HAVE_MPI
239 [ + - ]: 240 : if (comm /= MPI_COMM_NULL) then
240 : 240 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
241 [ - + ]: 240 : 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 : 240 : 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 [ - + ]: 40664002 : 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 : 40664002 : real(dp) , allocatable :: xsum(:,:)
289 : : integer :: nproc_space_comm
290 : : #endif
291 : :
292 : : ! *************************************************************************
293 : :
294 : 40664002 : ier=0
295 : : #if defined HAVE_MPI
296 [ + - ]: 40664002 : if (comm /= MPI_COMM_NULL) then
297 : 40664002 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
298 [ + + ]: 40664002 : if (nproc_space_comm /= 1) then
299 : 83472 : n1 = size(xval,dim=1)
300 : 83472 : n2 = size(xval,dim=2)
301 : :
302 [ - + + - : 333888 : ABI_STAT_MALLOC(xsum,(n1,n2), ier)
- + + - +
- + - + -
- + ]
303 [ + - ]: 83472 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
304 [ + + + + ]: 902382208 : 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 : 83472 : ntot=int(n1,kind=int64)*n2
310 : :
311 : : ! Accumulate xval on all proc. in comm
312 [ + - ]: 83472 : if (ntot<=xmpi_maxint32_64) then
313 [ - + ]: 83472 : 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 [ + + + + ]: 902382208 : xval (:,:) = xsum(:,:)
321 [ - + ]: 83472 : ABI_FREE(xsum)
322 : : end if
323 : : end if
324 : : #endif
325 : 40664002 : 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 [ - + ]: 22421 : 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 : 22421 : real(dp) , allocatable :: xsum(:,:,:)
361 : : integer :: nproc_space_comm
362 : : #endif
363 : :
364 : : ! *************************************************************************
365 : :
366 : 22421 : ier=0
367 : : #if defined HAVE_MPI
368 [ + - ]: 22421 : if (comm /= MPI_COMM_NULL) then
369 : 22421 : call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
370 [ + + ]: 22421 : if (nproc_space_comm /= 1) then
371 : 5100 : n1 = size(xval,dim=1)
372 : 5100 : n2 = size(xval,dim=2)
373 : 5100 : n3 = size(xval,dim=3)
374 [ - + + - : 25500 : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
- + + - -
+ + - + -
+ - + - -
+ ]
375 [ + - ]: 5100 : if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
376 [ + + + + : 35756788 : 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 : 5100 : ntot=int(n1,kind=int64)*n2*n3
383 : :
384 : : ! Accumulate xval on all proc. in comm
385 [ + - ]: 5100 : if (ntot<=xmpi_maxint32_64) then
386 [ - + ]: 5100 : 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 [ + + + + : 35756788 : xval (:,:,:) = xsum(:,:,:)
+ + ]
394 [ - + ]: 5100 : ABI_FREE(xsum)
395 : : end if
396 : : end if
397 : : #endif
398 : :
399 : 22421 : 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 : : !!***
|
