Line data Source code
1 : !{\src2tex{textfont=tt}}
2 : !!****f* ABINIT/xmpi_bcast_intv
3 : !! NAME
4 : !! xmpi_bcast_intv
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_bcast is the generic function.
10 : !!
11 : !! COPYRIGHT
12 : !! Copyright (C) 2001-2026 ABINIT group (Rshaltaf,AR,XG)
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 : !! SOURCE
18 :
19 98758 : subroutine xmpi_bcast_intv(xval,master,comm,ier)
20 :
21 : !Arguments-------------------------
22 : integer,intent(inout) :: xval
23 : integer,intent(in) :: comm,master
24 : integer,intent(out) :: ier
25 :
26 : !Local variables-------------------
27 : #if defined HAVE_MPI
28 : integer :: arr_xval(1)
29 : #endif
30 :
31 : ! *************************************************************************
32 :
33 98758 : ier=0
34 : #if defined HAVE_MPI
35 98758 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
36 98758 : arr_xval(1)=xval
37 98758 : call MPI_BCAST(arr_xval,1,MPI_INTEGER,master,comm,ier)
38 98758 : xval=arr_xval(1)
39 : end if
40 : #endif
41 :
42 98758 : end subroutine xmpi_bcast_intv
43 : !!***
44 :
45 : !!****f* ABINIT/xmpi_bcast_int1d
46 : !! NAME
47 : !! xmpi_bcast_int1d
48 : !!
49 : !! FUNCTION
50 : !! Broadcasts data from master to slaves.
51 : !! Target: one-dimensional integer arrays.
52 : !!
53 : !! INPUTS
54 : !! comm= MPI communicator
55 : !! master= master MPI node
56 : !!
57 : !! OUTPUT
58 : !! ier= exit status, a non-zero value meaning there is an error
59 : !!
60 : !! SIDE EFFECTS
61 : !! xval= buffer array
62 : !!
63 : !! SOURCE
64 :
65 30350 : subroutine xmpi_bcast_int1d(xval,master,comm,ier)
66 :
67 : !Arguments ------------------------------------
68 : integer, DEV_CONTARRD intent(inout) :: xval(:)
69 : integer,intent(in) :: comm,master
70 : integer,intent(out) :: ier
71 :
72 : !Local variables-------------------------------
73 : integer :: n
74 :
75 : ! *************************************************************************
76 :
77 30350 : ier=0
78 : #if defined HAVE_MPI
79 30350 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
80 29680 : n=size(xval)
81 29680 : call MPI_BCAST(xval,n,MPI_INTEGER,master,comm,ier)
82 : end if
83 : #endif
84 30350 : end subroutine xmpi_bcast_int1d
85 : !!***
86 :
87 : !!****f* ABINIT/xmpi_bcast_int2d
88 : !! NAME
89 : !! xmpi_bcast_int2d
90 : !!
91 : !! FUNCTION
92 : !! Broadcasts data from master to slaves.
93 : !! Target: two-dimensional integer arrays.
94 : !!
95 : !! INPUTS
96 : !! comm= MPI communicator
97 : !! master= master MPI node
98 : !!
99 : !! OUTPUT
100 : !! ier= exit status, a non-zero value meaning there is an error
101 : !!
102 : !! SIDE EFFECTS
103 : !! xval= buffer array
104 : !!
105 : !! SOURCE
106 :
107 9502 : subroutine xmpi_bcast_int2d(xval,master,comm,ier)
108 :
109 : !Arguments-------------------------
110 : integer, DEV_CONTARRD intent(inout) :: xval(:,:)
111 : integer,intent(in) :: comm,master
112 : integer,intent(out) :: ier
113 :
114 : !Local variables-------------------
115 : #if defined HAVE_MPI
116 : integer :: my_dt,my_op,n1,n2
117 : integer(kind=int64) :: ntot
118 : #endif
119 :
120 : ! *************************************************************************
121 :
122 9502 : ier=0
123 : #if defined HAVE_MPI
124 9502 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
125 9472 : n1=size(xval,dim=1)
126 9472 : n2=size(xval,dim=2)
127 :
128 : !This product of dimensions can be greater than a 32bit integer
129 : !We use a INT64 to store it. If it is too large, we switch to an
130 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
131 9472 : ntot=int(n1,kind=int64)*n2
132 :
133 9472 : if (ntot<=xmpi_maxint32_64) then
134 9472 : call MPI_BCAST(xval,n1*n2,MPI_INTEGER,master,comm,ier)
135 : else
136 0 : call xmpi_largetype_create(ntot,MPI_INTEGER,my_dt,my_op,MPI_OP_NULL)
137 0 : call MPI_BCAST(xval,1,my_dt,master,comm,ier)
138 0 : call xmpi_largetype_free(my_dt,my_op)
139 : end if
140 :
141 : end if
142 : #endif
143 :
144 9502 : end subroutine xmpi_bcast_int2d
145 : !!***
146 :
147 : !!****f* ABINIT/xmpi_bcast_int3d
148 : !! NAME
149 : !! xmpi_bcast_int3d
150 : !!
151 : !! FUNCTION
152 : !! Broadcasts data from master to slaves.
153 : !! Target: three-dimensional integer arrays.
154 : !!
155 : !! INPUTS
156 : !! comm= MPI communicator
157 : !! master= master MPI node
158 : !!
159 : !! OUTPUT
160 : !! ier= exit status, a non-zero value meaning there is an error
161 : !!
162 : !! SIDE EFFECTS
163 : !! xval= buffer array
164 : !!
165 : !! SOURCE
166 :
167 5032 : subroutine xmpi_bcast_int3d(xval,master,comm,ier)
168 :
169 : !Arguments-------------------------
170 : integer, DEV_CONTARRD intent(inout) :: xval(:,:,:)
171 : integer,intent(in) :: comm,master
172 : integer,intent(out) :: ier
173 :
174 : !Local variables-------------------------------
175 : #if defined HAVE_MPI
176 : integer :: my_dt,my_op,n1,n2,n3
177 : integer(kind=int64) :: nn,ntot
178 : #endif
179 :
180 : ! *************************************************************************
181 :
182 5032 : ier=0
183 : #if defined HAVE_MPI
184 5032 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
185 5032 : n1=size(xval,dim=1)
186 5032 : n2=size(xval,dim=2)
187 5032 : n3=size(xval,dim=3)
188 :
189 : !This product of dimensions can be greater than a 32bit integer
190 : !We use a INT64 to store it. If it is too large, we switch to an
191 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
192 5032 : ntot=int(n1,kind=int64)*n2*n3
193 :
194 5032 : if (ntot<=xmpi_maxint32_64) then
195 5032 : call MPI_BCAST(xval,n1*n2*n3,MPI_INTEGER,master,comm,ier)
196 : else
197 0 : nn=int(n1*n2,kind=int64);if (nn>huge(0_int32)) nn=int(n1,kind=int64)
198 0 : call xmpi_largetype_create(ntot/nn,MPI_INTEGER,my_dt,my_op,MPI_OP_NULL)
199 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
200 0 : call xmpi_largetype_free(my_dt,my_op)
201 : end if
202 : end if
203 : #endif
204 :
205 5032 : end subroutine xmpi_bcast_int3d
206 : !!***
207 :
208 : !!****f* ABINIT/xmpi_bcast_int4d
209 : !! NAME
210 : !! xmpi_bcast_int4d
211 : !!
212 : !! FUNCTION
213 : !! Broadcasts data from master to slaves.
214 : !! Target: three-dimensional integer arrays.
215 : !!
216 : !! INPUTS
217 : !! comm= MPI communicator
218 : !! master= master MPI node
219 : !!
220 : !! OUTPUT
221 : !! ier= exit status, a non-zero value meaning there is an error
222 : !!
223 : !! SIDE EFFECTS
224 : !! xval= buffer array
225 : !!
226 : !! SOURCE
227 :
228 0 : subroutine xmpi_bcast_int4d(xval,master,comm,ier)
229 :
230 : !Arguments-------------------------
231 : integer, DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
232 : integer,intent(in) :: comm,master
233 : integer,intent(out) :: ier
234 :
235 : !Local variables-------------------------------
236 : #if defined HAVE_MPI
237 : integer :: my_dt,my_op,n1,n2,n3,n4
238 : integer(kind=int64) :: nn,ntot
239 : #endif
240 :
241 : ! *************************************************************************
242 :
243 0 : ier=0
244 : #if defined HAVE_MPI
245 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
246 0 : n1=size(xval,dim=1)
247 0 : n2=size(xval,dim=2)
248 0 : n3=size(xval,dim=3)
249 0 : n4=size(xval,dim=4)
250 :
251 : !This product of dimensions can be greater than a 32bit integer
252 : !We use a INT64 to store it. If it is too large, we switch to an
253 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
254 0 : ntot=int(n1,kind=int64)*n2*n3*n4
255 :
256 0 : if (ntot<=xmpi_maxint32_64) then
257 0 : call MPI_BCAST(xval,n1*n2*n3*n4,MPI_INTEGER,master,comm,ier)
258 : else
259 0 : nn=int(n1*n2*n3,kind=int64)
260 : if (nn>huge(0_int32)) nn=int(n1*n2,kind=int64)
261 : if (nn>huge(0_int32)) nn=int(n1,kind=int64)
262 0 : call xmpi_largetype_create(ntot/nn,MPI_INTEGER,my_dt,my_op,MPI_OP_NULL)
263 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
264 0 : call xmpi_largetype_free(my_dt,my_op)
265 : end if
266 : end if
267 : #endif
268 :
269 0 : end subroutine xmpi_bcast_int4d
270 : !!***
271 :
272 : !!****f* ABINIT/xmpi_bcast_dpv
273 : !! NAME
274 : !! xmpi_bcast_dpv
275 : !!
276 : !! FUNCTION
277 : !! Broadcasts data from master to slaves.
278 : !! Target: scalar double precisions.
279 : !!
280 : !! INPUTS
281 : !! comm= MPI communicator
282 : !! master= master MPI node
283 : !!
284 : !! OUTPUT
285 : !! ier= exit status, a non-zero value meaning there is an error
286 : !!
287 : !! SIDE EFFECTS
288 : !! xval= buffer array
289 : !!
290 : !! SOURCE
291 :
292 5719 : subroutine xmpi_bcast_dpv(xval,master,comm,ier)
293 :
294 : !Arguments ------------------------------------
295 : real(dp),intent(inout) :: xval
296 : integer ,intent(in) :: comm,master
297 : integer ,intent(out) :: ier
298 :
299 : !Local variables-------------------
300 : #if defined HAVE_MPI
301 : real(dp) :: arr_xval(1)
302 : #endif
303 :
304 : ! *************************************************************************
305 :
306 5719 : ier=0
307 : #if defined HAVE_MPI
308 5719 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
309 5659 : arr_xval(1)=xval
310 5659 : call MPI_BCAST(arr_xval,1,MPI_DOUBLE_PRECISION,master,comm,ier)
311 5659 : xval=arr_xval(1)
312 : end if
313 : #endif
314 :
315 5719 : end subroutine xmpi_bcast_dpv
316 : !!***
317 :
318 : !!****f* ABINIT/xmpi_bcast_dp1d
319 : !! NAME
320 : !! xmpi_bcast_dp1d
321 : !!
322 : !! FUNCTION
323 : !! Broadcasts data from master to slaves.
324 : !! Target: double precision one-dimensional arrays.
325 : !!
326 : !! INPUTS
327 : !! comm= MPI communicator
328 : !! master= master MPI node
329 : !!
330 : !! OUTPUT
331 : !! ier= exit status, a non-zero value meaning there is an error
332 : !!
333 : !! SIDE EFFECTS
334 : !! xval= buffer array
335 : !!
336 : !! SOURCE
337 :
338 78478 : subroutine xmpi_bcast_dp1d(xval,master,comm,ier)
339 :
340 : !Arguments-------------------------
341 : real(dp), DEV_CONTARRD intent(inout) :: xval(:)
342 : integer ,intent(in) :: comm,master
343 : integer ,intent(out) :: ier
344 :
345 : !Local variables-------------------
346 : #if defined HAVE_MPI
347 : integer :: n
348 : #endif
349 :
350 : ! *************************************************************************
351 :
352 78478 : ier=0
353 : #if defined HAVE_MPI
354 78478 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
355 45191 : n=size(xval,dim=1)
356 45191 : call MPI_BCAST(xval,n,MPI_DOUBLE_PRECISION,master,comm,ier)
357 : end if
358 : #endif
359 :
360 78478 : end subroutine xmpi_bcast_dp1d
361 : !!***
362 :
363 : !!****f* ABINIT/xmpi_bcast_dp2d
364 : !! NAME
365 : !! xmpi_bcast_dp2d
366 : !!
367 : !! FUNCTION
368 : !! Broadcasts data from master to slaves.
369 : !! Target: double precision two-dimensional arrays.
370 : !!
371 : !! INPUTS
372 : !! comm= MPI communicator
373 : !! master= master MPI node
374 : !!
375 : !! OUTPUT
376 : !! ier= exit status, a non-zero value meaning there is an error
377 : !!
378 : !! SIDE EFFECTS
379 : !! xval= buffer array
380 : !!
381 : !! SOURCE
382 :
383 43381107 : subroutine xmpi_bcast_dp2d(xval,master,comm,ier)
384 :
385 : !Arguments-------------------------
386 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:)
387 : integer ,intent(in) :: comm,master
388 : integer ,intent(out) :: ier
389 :
390 : !Local variables-------------------
391 : #if defined HAVE_MPI
392 : integer :: my_dt,my_op,n1,n2
393 : integer(kind=int64) :: ntot
394 : #endif
395 :
396 : ! *************************************************************************
397 :
398 43381107 : ier=0
399 : #if defined HAVE_MPI
400 43381107 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
401 157037 : n1=size(xval,dim=1)
402 157037 : n2=size(xval,dim=2)
403 :
404 : !This product of dimensions can be greater than a 32bit integer
405 : !We use a INT64 to store it. If it is too large, we switch to an
406 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
407 157037 : ntot=int(n1,kind=int64)*n2
408 :
409 157037 : if (ntot<=xmpi_maxint32_64) then
410 157037 : call MPI_BCAST(xval,n1*n2,MPI_DOUBLE_PRECISION,master,comm,ier)
411 : else
412 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
413 0 : call MPI_BCAST(xval,1,my_dt,master,comm,ier)
414 0 : call xmpi_largetype_free(my_dt,my_op)
415 : end if
416 : end if
417 : #endif
418 :
419 43381107 : end subroutine xmpi_bcast_dp2d
420 : !!***
421 :
422 : !!****f* ABINIT/xmpi_bcast_dp3d
423 : !! NAME
424 : !! xmpi_bcast_dp3d
425 : !!
426 : !! FUNCTION
427 : !! Broadcasts data from master to slaves.
428 : !! Target: double precision three-dimensional arrays.
429 : !!
430 : !! INPUTS
431 : !! comm= MPI communicator
432 : !! master= master MPI node
433 : !!
434 : !! OUTPUT
435 : !! ier= exit status, a non-zero value meaning there is an error
436 : !!
437 : !! SIDE EFFECTS
438 : !! xval= buffer array
439 : !!
440 : !! SOURCE
441 :
442 130813 : subroutine xmpi_bcast_dp3d(xval,master,comm,ier)
443 :
444 : !Arguments-------------------------
445 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
446 : integer ,intent(in) :: comm,master
447 : integer ,intent(out) :: ier
448 :
449 : !Local variables-------------------
450 : #if defined HAVE_MPI
451 : integer :: my_dt,my_op,n1,n2,n3
452 : integer(kind=int64) :: nn,ntot
453 : #endif
454 :
455 : ! *************************************************************************
456 :
457 130813 : ier=0
458 : #if defined HAVE_MPI
459 130813 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
460 15838 : n1=size(xval,dim=1)
461 15838 : n2=size(xval,dim=2)
462 15838 : n3=size(xval,dim=3)
463 :
464 : !This product of dimensions can be greater than a 32bit integer
465 : !We use a INT64 to store it. If it is too large, we switch to an
466 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
467 15838 : ntot=int(n1,kind=int64)*n2*n3
468 :
469 15838 : if (ntot<=xmpi_maxint32_64) then
470 15838 : call MPI_BCAST(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,master,comm,ier)
471 : else
472 0 : nn=int(n1*n2,kind=int64);if (nn>huge(0_int32)) nn=int(n1,kind=int64)
473 0 : call xmpi_largetype_create(ntot/nn,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
474 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
475 0 : call xmpi_largetype_free(my_dt,my_op)
476 : end if
477 : end if
478 : #endif
479 :
480 130813 : end subroutine xmpi_bcast_dp3d
481 : !!***
482 :
483 : !!****f* ABINIT/xmpi_bcast_dp4d
484 : !! NAME
485 : !! xmpi_bcast_dp4d
486 : !!
487 : !! FUNCTION
488 : !! Broadcasts data from master to slaves.
489 : !! Target: double precision four-dimensional arrays.
490 : !!
491 : !! INPUTS
492 : !! comm= MPI communicator
493 : !! master= master MPI node
494 : !!
495 : !! OUTPUT
496 : !! ier= exit status, a non-zero value meaning there is an error
497 : !!
498 : !! SIDE EFFECTS
499 : !! xval= buffer array
500 : !!
501 : !! SOURCE
502 :
503 92 : subroutine xmpi_bcast_dp4d(xval,master,comm,ier)
504 :
505 : !Arguments-------------------------
506 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
507 : integer ,intent(in) :: comm,master
508 : integer ,intent(out) :: ier
509 :
510 : !Local variables-------------------
511 : #if defined HAVE_MPI
512 : integer :: my_dt,my_op,n1,n2,n3,n4
513 : integer(kind=int64) :: nn,ntot
514 : #endif
515 :
516 : ! *************************************************************************
517 :
518 92 : ier=0
519 : #if defined HAVE_MPI
520 92 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
521 77 : n1=size(xval,dim=1)
522 77 : n2=size(xval,dim=2)
523 77 : n3=size(xval,dim=3)
524 77 : n4=size(xval,dim=4)
525 :
526 : !This product of dimensions can be greater than a 32bit integer
527 : !We use a INT64 to store it. If it is too large, we switch to an
528 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
529 77 : ntot=int(n1,kind=int64)*n2*n3*n4
530 :
531 77 : if (ntot<=xmpi_maxint32_64) then
532 77 : call MPI_BCAST(xval,n1*n2*n3*n4,MPI_DOUBLE_PRECISION,master,comm,ier)
533 : else
534 0 : nn=int(n1*n2*n3,kind=int64)
535 : if (nn>huge(0_int32)) nn=int(n1*n2,kind=int64)
536 : if (nn>huge(0_int32)) nn=int(n1,kind=int64)
537 0 : call xmpi_largetype_create(ntot/nn,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
538 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
539 0 : call xmpi_largetype_free(my_dt,my_op)
540 : end if
541 : end if
542 : #endif
543 :
544 92 : end subroutine xmpi_bcast_dp4d
545 : !!***
546 :
547 : !!****f* ABINIT/xmpi_bcast_dp5d
548 : !! NAME
549 : !! xmpi_bcast_dp5d
550 : !!
551 : !! FUNCTION
552 : !! Broadcasts data from master to slaves.
553 : !! Target: double precision five-dimensional arrays.
554 : !!
555 : !! INPUTS
556 : !! comm= MPI communicator
557 : !! master= master MPI node
558 : !!
559 : !! OUTPUT
560 : !! ier= exit status, a non-zero value meaning there is an error
561 : !!
562 : !! SIDE EFFECTS
563 : !! xval= buffer array
564 : !!
565 : !! SOURCE
566 :
567 440 : subroutine xmpi_bcast_dp5d(xval,master,comm,ier)
568 :
569 : !Arguments-------------------------
570 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
571 : integer ,intent(in) :: comm,master
572 : integer ,intent(out) :: ier
573 :
574 : !Local variables-------------------
575 : #if defined HAVE_MPI
576 : integer :: my_dt,my_op,n1,n2,n3,n4,n5
577 : integer(kind=int64) :: nn,ntot
578 : #endif
579 :
580 : ! *************************************************************************
581 :
582 440 : ier=0
583 : #if defined HAVE_MPI
584 440 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
585 425 : n1=size(xval,dim=1)
586 425 : n2=size(xval,dim=2)
587 425 : n3=size(xval,dim=3)
588 425 : n4=size(xval,dim=4)
589 425 : n5=size(xval,dim=5)
590 :
591 : !This product of dimensions can be greater than a 32bit integer
592 : !We use a INT64 to store it. If it is too large, we switch to an
593 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
594 425 : ntot=int(n1,kind=int64)*n2*n3*n4*n5
595 :
596 425 : if (ntot<=xmpi_maxint32_64) then
597 425 : call MPI_BCAST(xval,n1*n2*n3*n4*n5,MPI_DOUBLE_PRECISION,master,comm,ier)
598 : else
599 0 : nn=int(n1*n2*n3*n4,kind=int64)
600 : if (nn>huge(0_int32)) nn=int(n1*n2*n3,kind=int64)
601 : if (nn>huge(0_int32)) nn=int(n1*n2,kind=int64)
602 : if (nn>huge(0_int32)) nn=int(n1,kind=int64)
603 0 : call xmpi_largetype_create(ntot/nn,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
604 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
605 0 : call xmpi_largetype_free(my_dt,my_op)
606 : end if
607 : end if
608 : #endif
609 :
610 440 : end subroutine xmpi_bcast_dp5d
611 : !!***
612 :
613 : !!****f* ABINIT/xmpi_bcast_dp6d
614 : !! NAME
615 : !! xmpi_bcast_dp6d
616 : !!
617 : !! FUNCTION
618 : !! Broadcasts data from master to slaves.
619 : !! Target: double precision six-dimensional arrays.
620 : !!
621 : !! INPUTS
622 : !! comm= MPI communicator
623 : !! master= master MPI node
624 : !!
625 : !! OUTPUT
626 : !! ier= exit status, a non-zero value meaning there is an error
627 : !!
628 : !! SIDE EFFECTS
629 : !! xval= buffer array
630 : !!
631 : !! SOURCE
632 :
633 38 : subroutine xmpi_bcast_dp6d(xval,master,comm,ier)
634 :
635 : !Arguments-------------------------
636 : real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:)
637 : integer ,intent(in) :: comm,master
638 : integer ,intent(out) :: ier
639 :
640 : !Local variables-------------------
641 : #if defined HAVE_MPI
642 : integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6
643 : integer(kind=int64) :: nn,ntot
644 : #endif
645 :
646 : ! *************************************************************************
647 :
648 38 : ier=0
649 : #if defined HAVE_MPI
650 38 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
651 38 : n1=size(xval,dim=1)
652 38 : n2=size(xval,dim=2)
653 38 : n3=size(xval,dim=3)
654 38 : n4=size(xval,dim=4)
655 38 : n5=size(xval,dim=5)
656 38 : n6=size(xval,dim=6)
657 :
658 : !This product of dimensions can be greater than a 32bit integer
659 : !We use a INT64 to store it. If it is too large, we switch to an
660 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
661 38 : ntot=int(n1,kind=int64)*n2*n3*n4*n5*n6
662 :
663 38 : if (ntot<=xmpi_maxint32_64) then
664 38 : call MPI_BCAST(xval,n1*n2*n3*n4*n5*n6,MPI_DOUBLE_PRECISION,master,comm,ier)
665 : else
666 0 : nn=int(n1*n2*n3*n4*n5,kind=int64)
667 : if (nn>huge(0_int32)) nn=int(n1*n2*n3*n4,kind=int64)
668 : if (nn>huge(0_int32)) nn=int(n1*n2*n3,kind=int64)
669 : if (nn>huge(0_int32)) nn=int(n1*n2,kind=int64)
670 : if (nn>huge(0_int32)) nn=int(n1,kind=int64)
671 0 : call xmpi_largetype_create(ntot/nn,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
672 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
673 0 : call xmpi_largetype_free(my_dt,my_op)
674 : end if
675 : end if
676 : #endif
677 :
678 38 : end subroutine xmpi_bcast_dp6d
679 : !!***
680 :
681 : !!****f* ABINIT/xmpi_bcast_spv
682 : !! NAME
683 : !! xmpi_bcast_spv
684 : !!
685 : !! FUNCTION
686 : !! Broadcasts data from master to slaves.
687 : !! Target: scalar single precisions.
688 : !!
689 : !! INPUTS
690 : !! comm= MPI communicator
691 : !! master= master MPI node
692 : !!
693 : !! OUTPUT
694 : !! ier= exit status, a non-zero value meaning there is an error
695 : !!
696 : !! SIDE EFFECTS
697 : !! xval= buffer array
698 : !!
699 : !! SOURCE
700 :
701 0 : subroutine xmpi_bcast_spv(xval,master,comm,ier)
702 :
703 : !Arguments-------------------------
704 : real(sp),intent(inout) :: xval
705 : integer,intent(in) :: comm,master
706 : integer,intent(out) :: ier
707 :
708 : !Local variables-------------------
709 : #if defined HAVE_MPI
710 : real(sp) :: arr_xval(1)
711 : #endif
712 :
713 : ! *************************************************************************
714 :
715 0 : ier=0
716 : #if defined HAVE_MPI
717 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
718 0 : arr_xval(1)=xval
719 0 : call MPI_BCAST(arr_xval,1,MPI_REAL,master,comm,ier)
720 0 : xval=arr_xval(1)
721 : end if
722 : #endif
723 :
724 0 : end subroutine xmpi_bcast_spv
725 : !!***
726 :
727 : !!****f* ABINIT/xmpi_bcast_sp1d
728 : !! NAME
729 : !! xmpi_bcast_sp1d
730 : !!
731 : !! FUNCTION
732 : !! Broadcasts data from master to slaves.
733 : !! Target: one-dimensional single precision arrays.
734 : !!
735 : !! INPUTS
736 : !! comm= MPI communicator
737 : !! master= master MPI node
738 : !!
739 : !! OUTPUT
740 : !! ier= exit status, a non-zero value meaning there is an error
741 : !!
742 : !! SIDE EFFECTS
743 : !! xval= buffer array
744 : !!
745 : !! SOURCE
746 :
747 0 : subroutine xmpi_bcast_sp1d(xval,master,comm,ier)
748 :
749 : !Arguments-------------------------
750 : real(sp), DEV_CONTARRD intent(inout) :: xval(:)
751 : integer ,intent(in) :: comm,master
752 : integer ,intent(out) :: ier
753 :
754 : !Local variables-------------------
755 : #if defined HAVE_MPI
756 : integer :: n
757 : #endif
758 :
759 : ! *************************************************************************
760 :
761 0 : ier=0
762 : #if defined HAVE_MPI
763 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
764 0 : n=size(xval,dim=1)
765 0 : call MPI_BCAST(xval,n,MPI_REAL,master,comm,ier)
766 : end if
767 : #endif
768 :
769 0 : end subroutine xmpi_bcast_sp1d
770 : !!***
771 :
772 : !!****f* ABINIT/xmpi_bcast_sp2d
773 : !! NAME
774 : !! xmpi_bcast_sp2d
775 : !!
776 : !! FUNCTION
777 : !! Broadcasts data from master to slaves.
778 : !! Target: two-dimensional single precision arrays.
779 : !!
780 : !! INPUTS
781 : !! comm= MPI communicator
782 : !! master= master MPI node
783 : !!
784 : !! OUTPUT
785 : !! ier= exit status, a non-zero value meaning there is an error
786 : !!
787 : !! SIDE EFFECTS
788 : !! xval= buffer array
789 : !!
790 : !! SOURCE
791 :
792 0 : subroutine xmpi_bcast_sp2d(xval,master,comm,ier)
793 :
794 : !Arguments-------------------------
795 : real(sp), DEV_CONTARRD intent(inout) :: xval(:,:)
796 : integer ,intent(in) :: comm,master
797 : integer ,intent(out) :: ier
798 :
799 : !Local variables-------------------
800 : #if defined HAVE_MPI
801 : integer :: my_dt,my_op,n1,n2
802 : integer(kind=int64) :: ntot
803 : #endif
804 :
805 : ! *************************************************************************
806 :
807 0 : ier=0
808 : #if defined HAVE_MPI
809 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
810 0 : n1=size(xval,dim=1)
811 0 : n2=size(xval,dim=2)
812 :
813 : !This product of dimensions can be greater than a 32bit integer
814 : !We use a INT64 to store it. If it is too large, we switch to an
815 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
816 0 : ntot=int(n1,kind=int64)*n2
817 :
818 0 : if (ntot<=xmpi_maxint32_64) then
819 0 : call MPI_BCAST(xval,n1*n2,MPI_REAL,master,comm,ier)
820 : else
821 0 : call xmpi_largetype_create(ntot,MPI_REAL,my_dt,my_op,MPI_OP_NULL)
822 0 : call MPI_BCAST(xval,1,my_dt,master,comm,ier)
823 0 : call xmpi_largetype_free(my_dt,my_op)
824 : end if
825 : end if
826 : #endif
827 :
828 0 : end subroutine xmpi_bcast_sp2d
829 : !!***
830 :
831 : !!****f* ABINIT/xmpi_bcast_sp3d
832 : !! NAME
833 : !! xmpi_bcast_sp3d
834 : !!
835 : !! FUNCTION
836 : !! Broadcasts data from master to slaves.
837 : !! Target: three-dimensional single precision arrays.
838 : !!
839 : !! INPUTS
840 : !! comm= MPI communicator
841 : !! master= master MPI node
842 : !!
843 : !! OUTPUT
844 : !! ier= exit status, a non-zero value meaning there is an error
845 : !!
846 : !! SIDE EFFECTS
847 : !! xval= buffer array
848 : !!
849 : !! SOURCE
850 :
851 0 : subroutine xmpi_bcast_sp3d(xval,master,comm,ier)
852 :
853 : !Arguments-------------------------
854 : real(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
855 : integer ,intent(in) :: comm,master
856 : integer ,intent(out) :: ier
857 :
858 : !Local variables-------------------
859 : #if defined HAVE_MPI
860 : integer :: my_dt,my_op,n1,n2,n3
861 : integer(kind=int64) :: nn,ntot
862 : #endif
863 :
864 : ! *************************************************************************
865 :
866 0 : ier=0
867 : #if defined HAVE_MPI
868 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
869 0 : n1=size(xval,dim=1)
870 0 : n2=size(xval,dim=2)
871 0 : n3=size(xval,dim=3)
872 :
873 : !This product of dimensions can be greater than a 32bit integer
874 : !We use a INT64 to store it. If it is too large, we switch to an
875 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
876 0 : ntot=int(n1,kind=int64)*n2*n3
877 :
878 0 : if (ntot<=xmpi_maxint32_64) then
879 : else
880 0 : nn=int(n1*n2,kind=int64);if (nn>huge(0_int32)) nn=int(n1,kind=int64)
881 0 : call xmpi_largetype_create(ntot/nn,MPI_REAL,my_dt,my_op,MPI_OP_NULL)
882 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
883 0 : call xmpi_largetype_free(my_dt,my_op)
884 : end if
885 : end if
886 : #endif
887 :
888 0 : end subroutine xmpi_bcast_sp3d
889 : !!***
890 :
891 : !!****f* ABINIT/xmpi_bcast_sp4d
892 : !! NAME
893 : !! xmpi_bcast_sp4d
894 : !!
895 : !! FUNCTION
896 : !! Broadcasts data from master to slaves.
897 : !! Target: four-dimensional single precision arrays.
898 : !!
899 : !! INPUTS
900 : !! comm= MPI communicator
901 : !! master= master MPI node
902 : !!
903 : !! OUTPUT
904 : !! ier= exit status, a non-zero value meaning there is an error
905 : !!
906 : !! SIDE EFFECTS
907 : !! xval= buffer array
908 : !!
909 : !! SOURCE
910 :
911 0 : subroutine xmpi_bcast_sp4d(xval,master,comm,ier)
912 :
913 : !Arguments-------------------------
914 : real(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
915 : integer ,intent(in) :: comm,master
916 : integer ,intent(out) :: ier
917 :
918 : !Local variables-------------------
919 : #if defined HAVE_MPI
920 : integer :: my_dt,my_op,n1,n2,n3,n4
921 : integer(kind=int64) :: nn,ntot
922 : #endif
923 :
924 : ! *************************************************************************
925 :
926 0 : ier=0
927 : #if defined HAVE_MPI
928 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
929 0 : n1=size(xval,dim=1)
930 0 : n2=size(xval,dim=2)
931 0 : n3=size(xval,dim=3)
932 0 : n4=size(xval,dim=4)
933 :
934 : !This product of dimensions can be greater than a 32bit integer
935 : !We use a INT64 to store it. If it is too large, we switch to an
936 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
937 0 : ntot=int(n1,kind=int64)*n2*n3*n4
938 :
939 0 : if (ntot<=xmpi_maxint32_64) then
940 : else
941 0 : nn=int(n1*n2*n3,kind=int64)
942 : if (nn>huge(0_int32)) nn=int(n1*n2,kind=int64)
943 : if (nn>huge(0_int32)) nn=int(n1,kind=int64)
944 0 : call xmpi_largetype_create(ntot/nn,MPI_REAL,my_dt,my_op,MPI_OP_NULL)
945 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
946 0 : call xmpi_largetype_free(my_dt,my_op)
947 : end if
948 : end if
949 : #endif
950 :
951 0 : end subroutine xmpi_bcast_sp4d
952 : !!***
953 :
954 : !!****f* ABINIT/xmpi_bcast_cplxv
955 : !! NAME
956 : !! xmpi_bcast_cplxv
957 : !!
958 : !! FUNCTION
959 : !! Broadcasts data from master to slaves.
960 : !! Target: scalar complexs.
961 : !!
962 : !! INPUTS
963 : !! comm= MPI communicator
964 : !! master= master MPI node
965 : !!
966 : !! OUTPUT
967 : !! ier= exit status, a non-zero value meaning there is an error
968 : !!
969 : !! SIDE EFFECTS
970 : !! xval= buffer array
971 : !!
972 : !! SOURCE
973 :
974 0 : subroutine xmpi_bcast_cplxv(xval,master,comm,ier)
975 :
976 : !Arguments-------------------------
977 : complex(sp),intent(inout) :: xval
978 : integer ,intent(in) :: comm,master
979 : integer ,intent(out) :: ier
980 :
981 : !Local variables-------------------
982 : #if defined HAVE_MPI
983 : complex(sp) :: arr_xval(1)
984 : #endif
985 : ! *************************************************************************
986 :
987 0 : ier=0
988 : #if defined HAVE_MPI
989 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
990 0 : arr_xval(1)=xval
991 0 : call MPI_BCAST(arr_xval,1,MPI_COMPLEX,master,comm,ier)
992 0 : xval=arr_xval(1)
993 : end if
994 : #endif
995 :
996 0 : end subroutine xmpi_bcast_cplxv
997 : !!***
998 :
999 : !!****f* ABINIT/xmpi_bcast_cplx1d
1000 : !! NAME
1001 : !! xmpi_bcast_cplx1d
1002 : !!
1003 : !! FUNCTION
1004 : !! Broadcasts data from master to slaves.
1005 : !! Target: one-dimensional complex arrays.
1006 : !!
1007 : !! INPUTS
1008 : !! comm= MPI communicator
1009 : !! master= master MPI node
1010 : !!
1011 : !! OUTPUT
1012 : !! ier= exit status, a non-zero value meaning there is an error
1013 : !!
1014 : !! SIDE EFFECTS
1015 : !! xval= buffer array
1016 : !!
1017 : !! SOURCE
1018 :
1019 0 : subroutine xmpi_bcast_cplx1d(xval,master,comm,ier)
1020 :
1021 : !Arguments-------------------------
1022 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:)
1023 : integer ,intent(in) :: comm,master
1024 : integer ,intent(out) :: ier
1025 :
1026 : !Local variables-------------------
1027 : #if defined HAVE_MPI
1028 : integer :: n
1029 : #endif
1030 : ! *************************************************************************
1031 :
1032 0 : ier=0
1033 : #if defined HAVE_MPI
1034 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1035 0 : n=size(xval(:))
1036 0 : call MPI_BCAST(xval,n,MPI_COMPLEX,master,comm,ier)
1037 : end if
1038 : #endif
1039 :
1040 0 : end subroutine xmpi_bcast_cplx1d
1041 : !!***
1042 :
1043 : !!****f* ABINIT/xmpi_bcast_cplx2d
1044 : !! NAME
1045 : !! xmpi_bcast_cplx2d
1046 : !!
1047 : !! FUNCTION
1048 : !! Broadcasts data from master to slaves.
1049 : !! Target: two-dimensional complex arrays.
1050 : !!
1051 : !! INPUTS
1052 : !! comm= MPI communicator
1053 : !! master= master MPI node
1054 : !!
1055 : !! OUTPUT
1056 : !! ier= exit status, a non-zero value meaning there is an error
1057 : !!
1058 : !! SIDE EFFECTS
1059 : !! xval= buffer array
1060 : !!
1061 : !! SOURCE
1062 :
1063 0 : subroutine xmpi_bcast_cplx2d(xval,master,comm,ier)
1064 :
1065 : !Arguments-------------------------
1066 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:)
1067 : integer ,intent(in) :: comm,master
1068 : integer ,intent(out) :: ier
1069 :
1070 : !Local variables-------------------
1071 : #if defined HAVE_MPI
1072 : integer :: my_dt,my_op,n1,n2
1073 : integer(kind=int64) :: ntot
1074 : #endif
1075 :
1076 : ! *************************************************************************
1077 :
1078 0 : ier=0
1079 : #if defined HAVE_MPI
1080 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1081 0 : n1=size(xval,dim=1)
1082 0 : n2=size(xval,dim=2)
1083 :
1084 : !This product of dimensions can be greater than a 32bit integer
1085 : !We use a INT64 to store it. If it is too large, we switch to an
1086 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1087 0 : ntot=int(n1,kind=int64)*n2
1088 :
1089 0 : if (ntot<=xmpi_maxint32_64) then
1090 0 : call MPI_BCAST(xval,n1*n2,MPI_COMPLEX,master,comm,ier)
1091 : else
1092 0 : call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_OP_NULL)
1093 0 : call MPI_BCAST(xval,1,my_dt,master,comm,ier)
1094 0 : call xmpi_largetype_free(my_dt,my_op)
1095 : end if
1096 : end if
1097 : #endif
1098 :
1099 0 : end subroutine xmpi_bcast_cplx2d
1100 : !!***
1101 :
1102 : !!****f* ABINIT/xmpi_bcast_cplx3d
1103 : !! NAME
1104 : !! xmpi_bcast_cplx3d
1105 : !!
1106 : !! FUNCTION
1107 : !! Broadcasts data from master to slaves.
1108 : !! Target: three-dimensional complex arrays.
1109 : !!
1110 : !! INPUTS
1111 : !! comm= MPI communicator
1112 : !! master= master MPI node
1113 : !!
1114 : !! OUTPUT
1115 : !! ier= exit status, a non-zero value meaning there is an error
1116 : !!
1117 : !! SIDE EFFECTS
1118 : !! xval= buffer array
1119 : !!
1120 : !! SOURCE
1121 :
1122 0 : subroutine xmpi_bcast_cplx3d(xval,master,comm,ier)
1123 :
1124 : !Arguments-------------------------
1125 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
1126 : integer ,intent(in) :: comm,master
1127 : integer ,intent(out) :: ier
1128 :
1129 : !Local variables-------------------
1130 : #if defined HAVE_MPI
1131 : integer :: my_dt,my_op,n1,n2,n3
1132 : integer(kind=int64) :: nn,ntot
1133 : #endif
1134 : ! *************************************************************************
1135 :
1136 0 : ier=0
1137 : #if defined HAVE_MPI
1138 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1139 0 : n1=size(xval,dim=1)
1140 0 : n2=size(xval,dim=2)
1141 0 : n3=size(xval,dim=3)
1142 :
1143 : !This product of dimensions can be greater than a 32bit integer
1144 : !We use a INT64 to store it. If it is too large, we switch to an
1145 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1146 0 : ntot=int(n1,kind=int64)*n2*n3
1147 :
1148 0 : if (ntot<=xmpi_maxint32_64) then
1149 : else
1150 0 : nn=int(n1*n2,kind=int64);if (nn>huge(0_int32)) nn=int(n1,kind=int64)
1151 0 : call xmpi_largetype_create(ntot/nn,MPI_COMPLEX,my_dt,my_op,MPI_OP_NULL)
1152 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
1153 0 : call xmpi_largetype_free(my_dt,my_op)
1154 : end if
1155 : end if
1156 : #endif
1157 :
1158 0 : end subroutine xmpi_bcast_cplx3d
1159 : !!***
1160 :
1161 : !!****f* ABINIT/xmpi_bcast_cplx4d
1162 : !! NAME
1163 : !! xmpi_bcast_cplx4d
1164 : !!
1165 : !! FUNCTION
1166 : !! Broadcasts data from master to slaves.
1167 : !! Target: four-dimensional complex arrays.
1168 : !!
1169 : !! INPUTS
1170 : !! comm= MPI communicator
1171 : !! master= master MPI node
1172 : !!
1173 : !! OUTPUT
1174 : !! ier= exit status, a non-zero value meaning there is an error
1175 : !!
1176 : !! SIDE EFFECTS
1177 : !! xval= buffer array
1178 : !!
1179 : !! SOURCE
1180 :
1181 0 : subroutine xmpi_bcast_cplx4d(xval,master,comm,ier)
1182 :
1183 : !Arguments-------------------------
1184 : complex(sp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
1185 : integer ,intent(in) :: comm,master
1186 : integer ,intent(out) :: ier
1187 :
1188 : !Local variables-------------------
1189 : #if defined HAVE_MPI
1190 : integer :: my_dt,my_op,n1,n2,n3,n4
1191 : integer(kind=int64) :: nn,ntot
1192 : #endif
1193 : ! *************************************************************************
1194 :
1195 0 : ier=0
1196 : #if defined HAVE_MPI
1197 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1198 0 : n1=size(xval,dim=1)
1199 0 : n2=size(xval,dim=2)
1200 0 : n3=size(xval,dim=3)
1201 0 : n4=size(xval,dim=4)
1202 :
1203 : !This product of dimensions can be greater than a 32bit integer
1204 : !We use a INT64 to store it. If it is too large, we switch to an
1205 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1206 0 : ntot=int(n1,kind=int64)*n2*n3*n4
1207 :
1208 0 : if (ntot<=xmpi_maxint32_64) then
1209 0 : call MPI_BCAST(xval,n1*n2*n3*n4,MPI_COMPLEX,master,comm,ier)
1210 : else
1211 0 : nn=int(n1*n2*n3,kind=int64)
1212 : if (nn>huge(0_int32)) nn=int(n1*n2,kind=int64)
1213 : if (nn>huge(0_int32)) nn=int(n1,kind=int64)
1214 0 : call xmpi_largetype_create(ntot/nn,MPI_COMPLEX,my_dt,my_op,MPI_OP_NULL)
1215 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
1216 0 : call xmpi_largetype_free(my_dt,my_op)
1217 : end if
1218 : end if
1219 : #endif
1220 :
1221 0 : end subroutine xmpi_bcast_cplx4d
1222 : !!***
1223 :
1224 : !!****f* ABINIT/xmpi_bcast_dcv
1225 : !! NAME
1226 : !! xmpi_bcast_dcv
1227 : !!
1228 : !! FUNCTION
1229 : !! Broadcasts data from master to slaves.
1230 : !! Target: scalar double complexs.
1231 : !!
1232 : !! INPUTS
1233 : !! comm= MPI communicator
1234 : !! master= master MPI node
1235 : !!
1236 : !! OUTPUT
1237 : !! ier= exit status, a non-zero value meaning there is an error
1238 : !!
1239 : !! SIDE EFFECTS
1240 : !! xval= buffer array
1241 : !!
1242 : !! SOURCE
1243 :
1244 0 : subroutine xmpi_bcast_dcv(xval,master,comm,ier)
1245 :
1246 : !Arguments-------------------------
1247 : complex(dp),intent(inout) :: xval
1248 : integer ,intent(in) :: comm,master
1249 : integer ,intent(out) :: ier
1250 :
1251 : !Local variables-------------------
1252 : #if defined HAVE_MPI
1253 : complex(dp) :: arr_xval(1)
1254 : #endif
1255 :
1256 : ! *************************************************************************
1257 :
1258 0 : ier=0
1259 : #if defined HAVE_MPI
1260 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1261 0 : arr_xval(1)=xval
1262 0 : call MPI_BCAST(arr_xval,1,MPI_DOUBLE_COMPLEX,master,comm,ier)
1263 0 : xval=arr_xval(1)
1264 : end if
1265 : #endif
1266 :
1267 0 : end subroutine xmpi_bcast_dcv
1268 : !!***
1269 :
1270 : !!****f* ABINIT/xmpi_bcast_dc1d
1271 : !! NAME
1272 : !! xmpi_bcast_dc1d
1273 : !!
1274 : !! FUNCTION
1275 : !! Broadcasts data from master to slaves.
1276 : !! Target: one-dimensional double complex arrays.
1277 : !!
1278 : !! INPUTS
1279 : !! comm= MPI communicator
1280 : !! master= master MPI node
1281 : !!
1282 : !! OUTPUT
1283 : !! ier= exit status, a non-zero value meaning there is an error
1284 : !!
1285 : !! SIDE EFFECTS
1286 : !! xval= buffer array
1287 : !!
1288 : !! SOURCE
1289 :
1290 138 : subroutine xmpi_bcast_dc1d(xval,master,comm,ier)
1291 :
1292 : !Arguments-------------------------
1293 : complex(dp), DEV_CONTARRD intent(inout):: xval(:)
1294 : integer ,intent(in) :: comm,master
1295 : integer ,intent(out) :: ier
1296 :
1297 : !Local variables-------------------
1298 : #if defined HAVE_MPI
1299 : integer :: n
1300 : #endif
1301 :
1302 : ! *************************************************************************
1303 :
1304 138 : ier=0
1305 : #if defined HAVE_MPI
1306 138 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1307 138 : n=size(xval(:))
1308 138 : call MPI_BCAST(xval,n,MPI_DOUBLE_COMPLEX,master,comm,ier)
1309 : end if
1310 : #endif
1311 :
1312 138 : end subroutine xmpi_bcast_dc1d
1313 : !!***
1314 :
1315 : !!****f* ABINIT/xmpi_bcast_dc2d
1316 : !! NAME
1317 : !! xmpi_bcast_dc2d
1318 : !!
1319 : !! FUNCTION
1320 : !! Broadcasts data from master to slaves.
1321 : !! Target: two-dimensional double complex arrays.
1322 : !!
1323 : !! INPUTS
1324 : !! comm= MPI communicator
1325 : !! master= master MPI node
1326 : !!
1327 : !! OUTPUT
1328 : !! ier= exit status, a non-zero value meaning there is an error
1329 : !!
1330 : !! SIDE EFFECTS
1331 : !! xval= buffer array
1332 : !!
1333 : !!
1334 : !! SOURCE
1335 :
1336 0 : subroutine xmpi_bcast_dc2d(xval,master,comm,ier)
1337 :
1338 : !Arguments-------------------------
1339 : complex(dp), DEV_CONTARRD intent(inout):: xval(:,:)
1340 : integer ,intent(in) :: comm,master
1341 : integer ,intent(out) :: ier
1342 :
1343 : !Local variables-------------------
1344 : #if defined HAVE_MPI
1345 : integer :: my_dt,my_op,n1,n2
1346 : integer(kind=int64) :: ntot
1347 : #endif
1348 : ! *************************************************************************
1349 :
1350 0 : ier=0
1351 : #if defined HAVE_MPI
1352 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1353 0 : n1=size(xval,dim=1)
1354 0 : n2=size(xval,dim=2)
1355 :
1356 : !This product of dimensions can be greater than a 32bit integer
1357 : !We use a INT64 to store it. If it is too large, we switch to an
1358 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1359 0 : ntot=int(n1,kind=int64)*n2
1360 :
1361 0 : if (ntot<=xmpi_maxint32_64) then
1362 0 : call MPI_BCAST(xval,n1*n2,MPI_DOUBLE_COMPLEX,master,comm,ier)
1363 : else
1364 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_OP_NULL)
1365 0 : call MPI_BCAST(xval,1,my_dt,master,comm,ier)
1366 0 : call xmpi_largetype_free(my_dt,my_op)
1367 : end if
1368 : end if
1369 : #endif
1370 :
1371 0 : end subroutine xmpi_bcast_dc2d
1372 : !!***
1373 :
1374 : !!****f* ABINIT/xmpi_bcast_dc3d
1375 : !! NAME
1376 : !! xmpi_bcast_dc3d
1377 : !!
1378 : !! FUNCTION
1379 : !! Broadcasts data from master to slaves.
1380 : !! Target: three-dimensional double complex arrays.
1381 : !!
1382 : !! INPUTS
1383 : !! comm= MPI communicator
1384 : !! master= master MPI node
1385 : !!
1386 : !! OUTPUT
1387 : !! ier= exit status, a non-zero value meaning there is an error
1388 : !!
1389 : !! SIDE EFFECTS
1390 : !! xval= buffer array
1391 : !!
1392 : !! SOURCE
1393 :
1394 2 : subroutine xmpi_bcast_dc3d(xval,master,comm,ier)
1395 :
1396 : !Arguments-------------------------
1397 : complex(dp), DEV_CONTARRD intent(inout):: xval(:,:,:)
1398 : integer ,intent(in) :: comm,master
1399 : integer ,intent(out) :: ier
1400 :
1401 : !Local variables-------------------
1402 : #if defined HAVE_MPI
1403 : integer :: my_dt,my_op,n1,n2,n3
1404 : integer(kind=int64) :: nn,ntot
1405 : #endif
1406 : ! *************************************************************************
1407 :
1408 2 : ier=0
1409 : #if defined HAVE_MPI
1410 2 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1411 2 : n1=size(xval,dim=1)
1412 2 : n2=size(xval,dim=2)
1413 2 : n3=size(xval,dim=3)
1414 :
1415 : !This product of dimensions can be greater than a 32bit integer
1416 : !We use a INT64 to store it. If it is too large, we switch to an
1417 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1418 2 : ntot=int(n1,kind=int64)*n2*n3
1419 :
1420 2 : if (ntot<=xmpi_maxint32_64) then
1421 2 : call MPI_BCAST(xval,n1*n2*n3,MPI_DOUBLE_COMPLEX,master,comm,ier)
1422 : else
1423 0 : nn=int(n1*n2,kind=int64);if (nn>huge(0_int32)) nn=int(n1,kind=int64)
1424 0 : call xmpi_largetype_create(ntot/nn,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_OP_NULL)
1425 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
1426 0 : call xmpi_largetype_free(my_dt,my_op)
1427 : end if
1428 : end if
1429 : #endif
1430 :
1431 2 : end subroutine xmpi_bcast_dc3d
1432 : !!***
1433 :
1434 : !!****f* ABINIT/xmpi_bcast_dc4d
1435 : !! NAME
1436 : !! xmpi_bcast_dc4d
1437 : !!
1438 : !! FUNCTION
1439 : !! Broadcasts data from master to slaves.
1440 : !! Target: four-dimensional complex arrays in double precision.
1441 : !!
1442 : !! INPUTS
1443 : !! comm= MPI communicator
1444 : !! master= master MPI node
1445 : !!
1446 : !! OUTPUT
1447 : !! ier= exit status, a non-zero value meaning there is an error
1448 : !!
1449 : !! SIDE EFFECTS
1450 : !! xval= buffer array
1451 : !!
1452 : !! SOURCE
1453 :
1454 1 : subroutine xmpi_bcast_dc4d(xval,master,comm,ier)
1455 :
1456 : !Arguments-------------------------
1457 : complex(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
1458 : integer,intent(in) :: comm,master
1459 : integer,intent(out) :: ier
1460 :
1461 : !Local variables-------------------
1462 : #if defined HAVE_MPI
1463 : integer :: my_dt,my_op,n1,n2,n3,n4
1464 : integer(kind=int64) :: nn,ntot
1465 : #endif
1466 : ! *************************************************************************
1467 :
1468 1 : ier=0
1469 : #if defined HAVE_MPI
1470 1 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1471 1 : n1=size(xval,dim=1)
1472 1 : n2=size(xval,dim=2)
1473 1 : n3=size(xval,dim=3)
1474 1 : n4=size(xval,dim=4)
1475 :
1476 : !This product of dimensions can be greater than a 32bit integer
1477 : !We use a INT64 to store it. If it is too large, we switch to an
1478 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
1479 1 : ntot=int(n1,kind=int64)*n2*n3*n4
1480 :
1481 1 : if (ntot<=xmpi_maxint32_64) then
1482 1 : call MPI_BCAST(xval,n1*n2*n3*n4,MPI_DOUBLE_COMPLEX,master,comm,ier)
1483 : else
1484 0 : nn=int(n1*n2*n3,kind=int64)
1485 : if (nn>huge(0_int32)) nn=int(n1*n2,kind=int64)
1486 : if (nn>huge(0_int32)) nn=int(n1,kind=int64)
1487 0 : call xmpi_largetype_create(ntot/nn,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_OP_NULL)
1488 0 : call MPI_BCAST(xval,int(nn,kind=int32),my_dt,master,comm,ier)
1489 0 : call xmpi_largetype_free(my_dt,my_op)
1490 : end if
1491 : end if
1492 : #endif
1493 :
1494 1 : end subroutine xmpi_bcast_dc4d
1495 : !!***
1496 :
1497 : !!****f* ABINIT/xmpi_bcast_ch0d
1498 : !! NAME
1499 : !! xmpi_bcast_ch0d
1500 : !!
1501 : !! FUNCTION
1502 : !! Broadcasts data from master to slaves.
1503 : !! Target: character strings.
1504 : !!
1505 : !! INPUTS
1506 : !! comm= MPI communicator
1507 : !! master= master MPI node
1508 : !!
1509 : !! OUTPUT
1510 : !! ier= exit status, a non-zero value meaning there is an error
1511 : !!
1512 : !! SIDE EFFECTS
1513 : !! xval= buffer array
1514 : !!
1515 : !! SOURCE
1516 :
1517 16056 : subroutine xmpi_bcast_ch0d(xval, master, comm, ier)
1518 :
1519 : !Arguments-------------------------
1520 : character(len=*),intent(inout),target :: xval
1521 : integer,intent(in) :: comm,master
1522 : integer,intent(out) :: ier
1523 :
1524 : !Local variables-------------------------------
1525 : #if defined HAVE_MPI
1526 : integer :: nch(1),rank
1527 16056 : character,pointer :: arr_xval(:)
1528 : type(c_ptr) :: cptr
1529 : #endif
1530 :
1531 : !*************************************************************************
1532 :
1533 16056 : ier=0
1534 : #if defined HAVE_MPI
1535 16056 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1536 9263 : call MPI_COMM_RANK(comm,rank,ier)
1537 9263 : if (rank==master) nch(1)=len_trim(xval)
1538 9263 : call MPI_BCAST(nch,1,MPI_INTEGER,master,comm,ier)
1539 18526 : cptr=c_loc(xval) ; call c_f_pointer(cptr,arr_xval,[nch(1)])
1540 9263 : call MPI_BCAST(arr_xval,nch(1),MPI_CHARACTER,master,comm,ier)
1541 9263 : if (rank/=master) xval(nch(1)+1:)=''
1542 : end if
1543 : #endif
1544 :
1545 16056 : end subroutine xmpi_bcast_ch0d
1546 : !!***
1547 :
1548 : !!****f* ABINIT/xmpi_bcast_ch1d
1549 : !! NAME
1550 : !! xmpi_bcast_ch1d
1551 : !!
1552 : !! FUNCTION
1553 : !! Broadcasts data from master to slaves.
1554 : !! Target: one-dimensional array of character stringss.
1555 : !!
1556 : !! INPUTS
1557 : !! comm= MPI communicator
1558 : !! master= master MPI node
1559 : !!
1560 : !! OUTPUT
1561 : !! ier= exit status, a non-zero value meaning there is an error
1562 : !!
1563 : !! SIDE EFFECTS
1564 : !! xval= buffer array
1565 : !!
1566 : !! SOURCE
1567 :
1568 3591 : subroutine xmpi_bcast_ch1d(xval,master,comm,ier)
1569 :
1570 : !Arguments-------------------------
1571 : Character(len=*), DEV_CONTARRD intent(inout) :: xval(:)
1572 : integer,intent(in) :: comm,master
1573 : integer,intent(out) :: ier
1574 :
1575 : !Local variables-------------------------------
1576 : #if defined HAVE_MPI
1577 : integer :: ii,nch
1578 : #endif
1579 :
1580 : !*************************************************************************
1581 :
1582 3591 : ier=0
1583 : #if defined HAVE_MPI
1584 3591 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1585 3591 : nch=0
1586 20389 : do ii=1,size(xval)
1587 20389 : nch=nch+len(xval(ii))
1588 : end do
1589 3591 : call MPI_BCAST(xval,nch,MPI_CHARACTER,master,comm,ier)
1590 : end if
1591 : #endif
1592 :
1593 3591 : end subroutine xmpi_bcast_ch1d
1594 : !!***
1595 :
1596 :
1597 : !!****f* ABINIT/xmpi_bcast_log0d
1598 : !! NAME
1599 : !! xmpi_bcast_log0d
1600 : !!
1601 : !! FUNCTION
1602 : !! Broadcasts data from master to slaves.
1603 : !! Target: logical scalar
1604 : !!
1605 : !! INPUTS
1606 : !! comm= MPI communicator
1607 : !! master= master MPI node
1608 : !!
1609 : !! OUTPUT
1610 : !! ier= exit status, a non-zero value meaning there is an error
1611 : !!
1612 : !! SOURCE
1613 :
1614 4417 : subroutine xmpi_bcast_log0d(xval,master,comm,ier)
1615 :
1616 : !Arguments-------------------------
1617 : logical,intent(inout) :: xval
1618 : integer,intent(in) :: comm,master
1619 : integer,intent(out) :: ier
1620 :
1621 : !Local variables-------------------
1622 : #if defined HAVE_MPI
1623 : logical :: arr_xval(1)
1624 : #endif
1625 :
1626 : ! *************************************************************************
1627 :
1628 4417 : ier=0
1629 : #if defined HAVE_MPI
1630 4417 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1631 3399 : arr_xval(1)=xval
1632 3399 : call MPI_BCAST(arr_xval,1,MPI_LOGICAL,master,comm,ier)
1633 3399 : xval=arr_xval(1)
1634 : end if
1635 : #endif
1636 :
1637 4417 : end subroutine xmpi_bcast_log0d
1638 : !!***
1639 :
1640 : !!****f* ABINIT/xmpi_bcast_coeffi2_1d
1641 : !! NAME
1642 : !! xmpi_bcast_coeffi2_1d
1643 : !!
1644 : !! FUNCTION
1645 : !! Broadcasts data from master to slaves.
1646 : !! Target: type(coeffi2) 1D-arrays.
1647 : !!
1648 : !! INPUTS
1649 : !! comm= MPI communicator
1650 : !! master= master MPI node
1651 : !!
1652 : !! OUTPUT
1653 : !! ier= exit status, a non-zero value meaning there is an error
1654 : !!
1655 : !! SIDE EFFECTS
1656 : !! xval= buffer array
1657 : !!
1658 : !! SOURCE
1659 :
1660 0 : subroutine xmpi_bcast_coeffi2_1d(xval,master,comm,ier)
1661 :
1662 : !Arguments-------------------------
1663 : type(coeffi2_type), intent(inout) :: xval(:)
1664 : integer ,intent(in) :: comm,master
1665 : integer ,intent(out) :: ier
1666 :
1667 : !Local variables-------------------
1668 : #if defined HAVE_MPI
1669 : integer :: ii,jj,kk,me,n0,n1,n2,siztot
1670 0 : integer,allocatable :: mpibuf(:),siz(:,:)
1671 : #endif
1672 :
1673 : ! *************************************************************************
1674 :
1675 0 : ier=0
1676 : #if defined HAVE_MPI
1677 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1678 0 : me=xmpi_comm_rank(comm)
1679 :
1680 : ! Broadcast xval%value sizes
1681 0 : n0=size(xval)
1682 0 : ABI_STAT_MALLOC(siz,(2,n0), ier)
1683 0 : if (ier/= 0) call xmpi_abort(msg='error allocating siz in xmpi_bcast')
1684 0 : if (me==master) then
1685 0 : do ii=1,n0
1686 0 : siz(1,ii)=size(xval(ii)%value,1)
1687 0 : siz(2,ii)=size(xval(ii)%value,2)
1688 : end do
1689 : end if
1690 0 : call MPI_BCAST(siz,2*n0,MPI_INTEGER,master,comm,ier)
1691 0 : siztot=0
1692 0 : do ii=1,n0
1693 0 : siztot=siztot+siz(1,ii)*siz(2,ii)
1694 : end do
1695 :
1696 : ! Fill in the buffer
1697 0 : ABI_STAT_MALLOC(mpibuf,(siztot), ier)
1698 0 : if (ier/= 0) call xmpi_abort(msg='error allocating mpibuf in xmpi_bcast')
1699 0 : if (me==master) then
1700 : jj=0
1701 0 : do ii=1,n0
1702 0 : n1=siz(1,ii);n2=siz(2,ii)
1703 0 : do kk=1,n2
1704 0 : mpibuf(jj+1:jj+n1)=xval(ii)%value(1:n1,kk)
1705 0 : jj=jj+n1
1706 : end do
1707 : end do
1708 : end if
1709 :
1710 : ! Broadcast the data
1711 0 : call MPI_BCAST(mpibuf,siztot,MPI_INTEGER,master,comm,ier)
1712 :
1713 : ! Retrieve the buffer
1714 0 : jj=0
1715 0 : do ii=1,n0
1716 0 : n1=siz(1,ii);n2=siz(2,ii)
1717 0 : if (.not.allocated(xval(ii)%value)) then
1718 0 : ABI_STAT_MALLOC(xval(ii)%value,(n1,n2), ier)
1719 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xval%value in xmpi_bcast')
1720 : end if
1721 0 : do kk=1,n2
1722 0 : xval(ii)%value(1:n1,kk)=mpibuf(jj+1:jj+n1)
1723 0 : jj=jj+n1
1724 : end do
1725 : end do
1726 0 : ABI_FREE(siz)
1727 0 : ABI_FREE(mpibuf)
1728 :
1729 : end if
1730 : #endif
1731 :
1732 0 : end subroutine xmpi_bcast_coeffi2_1d
1733 : !!***
1734 :
1735 : !!****f* ABINIT/xmpi_bcast_coeff2_1d
1736 : !! NAME
1737 : !! xmpi_bcast_coeff2_1d
1738 : !!
1739 : !! FUNCTION
1740 : !! Broadcasts data from master to slaves.
1741 : !! Target: type(coeff2) 1D-arrays.
1742 : !!
1743 : !! INPUTS
1744 : !! comm= MPI communicator
1745 : !! master= master MPI node
1746 : !!
1747 : !! OUTPUT
1748 : !! ier= exit status, a non-zero value meaning there is an error
1749 : !!
1750 : !! SIDE EFFECTS
1751 : !! xval= buffer array
1752 : !!
1753 : !! SOURCE
1754 :
1755 0 : subroutine xmpi_bcast_coeff2_1d(xval,master,comm,ier)
1756 :
1757 : !Arguments-------------------------
1758 : type(coeff2_type), intent(inout) :: xval(:)
1759 : integer ,intent(in) :: comm,master
1760 : integer ,intent(out) :: ier
1761 :
1762 : !Local variables-------------------
1763 : #if defined HAVE_MPI
1764 : integer :: ii,jj,kk,me,n0,n1,n2,siztot
1765 0 : integer,allocatable :: siz(:,:)
1766 0 : real(dp),allocatable :: mpibuf(:)
1767 : #endif
1768 :
1769 : ! *************************************************************************
1770 :
1771 0 : ier=0
1772 : #if defined HAVE_MPI
1773 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1774 0 : me=xmpi_comm_rank(comm)
1775 :
1776 : ! Broadcast xval%value sizes
1777 0 : n0=size(xval)
1778 0 : ABI_STAT_MALLOC(siz,(2,n0), ier)
1779 0 : if (ier/= 0) call xmpi_abort(msg='error allocating siz in xmpi_bcast')
1780 0 : if (me==master) then
1781 0 : do ii=1,n0
1782 0 : siz(1,ii)=size(xval(ii)%value,1)
1783 0 : siz(2,ii)=size(xval(ii)%value,2)
1784 : end do
1785 : end if
1786 0 : call MPI_BCAST(siz,2*n0,MPI_INTEGER,master,comm,ier)
1787 0 : siztot=0
1788 0 : do ii=1,n0
1789 0 : siztot=siztot+siz(1,ii)*siz(2,ii)
1790 : end do
1791 :
1792 : ! Fill in the buffer
1793 0 : ABI_STAT_MALLOC(mpibuf,(siztot), ier)
1794 0 : if (ier/= 0) call xmpi_abort(msg='error allocating mpibuf in xmpi_bcast')
1795 0 : if (me==master) then
1796 : jj=0
1797 0 : do ii=1,n0
1798 0 : n1=siz(1,ii);n2=siz(2,ii)
1799 0 : do kk=1,n2
1800 0 : mpibuf(jj+1:jj+n1)=xval(ii)%value(1:n1,kk)
1801 0 : jj=jj+n1
1802 : end do
1803 : end do
1804 : end if
1805 :
1806 : ! Broadcast the data
1807 0 : call MPI_BCAST(mpibuf,siztot,MPI_DOUBLE_PRECISION,master,comm,ier)
1808 :
1809 : ! Retrieve the buffer
1810 0 : jj=0
1811 0 : do ii=1,n0
1812 0 : n1=siz(1,ii);n2=siz(2,ii)
1813 0 : if (.not.allocated(xval(ii)%value)) then
1814 0 : ABI_STAT_MALLOC(xval(ii)%value,(n1,n2), ier)
1815 0 : if (ier/= 0) call xmpi_abort(msg='error allocating xval%value in xmpi_bcast')
1816 : end if
1817 0 : do kk=1,n2
1818 0 : xval(ii)%value(1:n1,kk)=mpibuf(jj+1:jj+n1)
1819 0 : jj=jj+n1
1820 : end do
1821 : end do
1822 0 : ABI_FREE(siz)
1823 0 : ABI_FREE(mpibuf)
1824 :
1825 : end if
1826 : #endif
1827 :
1828 0 : end subroutine xmpi_bcast_coeff2_1d
1829 : !!***
1830 :
|
