Branch data 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 : 99515 : 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 : 99515 : ier=0
34 : : #if defined HAVE_MPI
35 [ + - ]: 99515 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
36 : 99515 : arr_xval(1)=xval
37 : 99515 : call MPI_BCAST(arr_xval,1,MPI_INTEGER,master,comm,ier)
38 : 99515 : xval=arr_xval(1)
39 : : end if
40 : : #endif
41 : :
42 : 99515 : 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 [ - + ]: 30445 : 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 : 30445 : ier=0
78 : : #if defined HAVE_MPI
79 [ + + ]: 30445 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
80 : 29759 : n=size(xval)
81 [ - + ]: 29759 : call MPI_BCAST(xval,n,MPI_INTEGER,master,comm,ier)
82 : : end if
83 : : #endif
84 : 30445 : 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 [ - + ]: 9597 : 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 : 9597 : ier=0
123 : : #if defined HAVE_MPI
124 [ + + ]: 9597 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
125 : 9567 : n1=size(xval,dim=1)
126 : 9567 : 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 : 9567 : ntot=int(n1,kind=int64)*n2
132 : :
133 [ + - ]: 9567 : if (ntot<=xmpi_maxint32_64) then
134 [ - + ]: 9567 : 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 : 9597 : 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 : 18475 : 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 : 18475 : ier=0
307 : : #if defined HAVE_MPI
308 [ + + ]: 18475 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
309 : 5707 : arr_xval(1)=xval
310 : 5707 : call MPI_BCAST(arr_xval,1,MPI_DOUBLE_PRECISION,master,comm,ier)
311 : 5707 : xval=arr_xval(1)
312 : : end if
313 : : #endif
314 : :
315 : 18475 : 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 [ - + ]: 78684 : 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 : 78684 : ier=0
353 : : #if defined HAVE_MPI
354 [ + + ]: 78684 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
355 : 45333 : n=size(xval,dim=1)
356 [ + + ]: 45333 : call MPI_BCAST(xval,n,MPI_DOUBLE_PRECISION,master,comm,ier)
357 : : end if
358 : : #endif
359 : :
360 : 78684 : 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 [ - + ]: 43572882 : 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 : 43572882 : ier=0
399 : : #if defined HAVE_MPI
400 [ + + ]: 43572882 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
401 : 160636 : n1=size(xval,dim=1)
402 : 160636 : 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 : 160636 : ntot=int(n1,kind=int64)*n2
408 : :
409 [ + - ]: 160636 : if (ntot<=xmpi_maxint32_64) then
410 [ - + ]: 160636 : 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 : 43572882 : 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 : 16168 : 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 : 16168 : character,pointer :: arr_xval(:)
1528 : : type(c_ptr) :: cptr
1529 : : #endif
1530 : :
1531 : : !*************************************************************************
1532 : :
1533 : 16168 : ier=0
1534 : : #if defined HAVE_MPI
1535 : 16168 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1536 : 9312 : call MPI_COMM_RANK(comm,rank,ier)
1537 [ + + ]: 9312 : if (rank==master) nch(1)=len_trim(xval)
1538 : 9312 : call MPI_BCAST(nch,1,MPI_INTEGER,master,comm,ier)
1539 [ + + ]: 18624 : cptr=c_loc(xval) ; call c_f_pointer(cptr,arr_xval,[nch(1)])
1540 [ - + ]: 9312 : call MPI_BCAST(arr_xval,nch(1),MPI_CHARACTER,master,comm,ier)
1541 [ + + + + ]: 9312 : if (rank/=master) xval(nch(1)+1:)=''
1542 : : end if
1543 : : #endif
1544 : :
1545 [ + + ]: 16168 : 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 [ - + ]: 3617 : 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 : 3617 : ier=0
1583 : : #if defined HAVE_MPI
1584 [ + - ]: 3617 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1585 : 3617 : nch=0
1586 [ + + ]: 20534 : do ii=1,size(xval)
1587 : 20534 : nch=nch+len(xval(ii))
1588 : : end do
1589 [ - + ]: 3617 : call MPI_BCAST(xval,nch,MPI_CHARACTER,master,comm,ier)
1590 : : end if
1591 : : #endif
1592 : :
1593 : 3617 : 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 : 4430 : 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 : 4430 : ier=0
1629 : : #if defined HAVE_MPI
1630 [ + + ]: 4430 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
1631 : 3412 : arr_xval(1)=xval
1632 : 3412 : call MPI_BCAST(arr_xval,1,MPI_LOGICAL,master,comm,ier)
1633 : 3412 : xval=arr_xval(1)
1634 : : end if
1635 : : #endif
1636 : :
1637 : 4430 : 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 : :
|
