Branch data Line data Source code
1 : : !{\src2tex{textfont=tt}}
2 : : !!****f* ABINIT/xmpi_allgather
3 : : !! NAME
4 : : !! xmpi_allgather
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_allgather is the generic function.
10 : : !!
11 : : !! COPYRIGHT
12 : : !! Copyright (C) 2001-2026 ABINIT group (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 : : !!***
20 : :
21 : : !!****f* ABINIT/xmpi_allgather_int
22 : : !! NAME
23 : : !! xmpi_allgather_int
24 : : !!
25 : : !! FUNCTION
26 : : !! Gathers data from all tasks and distributes it to all.
27 : : !! Target: one-dimensional integer arrays.
28 : : !!
29 : : !! INPUTS
30 : : !! comm= MPI communicator
31 : : !!
32 : : !! OUTPUT
33 : : !! ier= exit status, a non-zero value meaning there is an error
34 : : !!
35 : : !! SIDE EFFECTS
36 : : !! xval= buffer array
37 : : !! recvbuf= received elements
38 : : !!
39 : : !! SOURCE
40 : :
41 [ - + ]: 218749 : subroutine xmpi_allgather_int(xval,recvbuf,comm,ier)
42 : :
43 : : !Arguments-------------------------
44 : : integer,intent(inout) :: xval
45 : : integer, DEV_CONTARRD intent(inout) :: recvbuf(:)
46 : : integer, intent(in) :: comm
47 : : integer,intent(out) :: ier
48 : : ! *************************************************************************
49 : : integer :: arr_xval(1)
50 : :
51 : 218749 : ier=0
52 : : #if defined HAVE_MPI
53 [ + + ]: 218749 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
54 : : ! allgather xval on all proc. in comm
55 : 205576 : arr_xval(1) = xval
56 [ - + ]: 205576 : call MPI_ALLGATHER(arr_xval,1,MPI_INTEGER,recvbuf,1,MPI_INTEGER,comm,ier)
57 [ + - ]: 13173 : else if (comm == MPI_COMM_SELF) then
58 : 13173 : recvbuf(1)=xval
59 : : end if
60 : : #else
61 : : recvbuf(1)=xval
62 : : #endif
63 : 218749 : end subroutine xmpi_allgather_int
64 : : !!***
65 : :
66 : :
67 : : !!****f* ABINIT/xmpi_allgather_char
68 : : !! NAME
69 : : !! xmpi_allgather_char
70 : : !!
71 : : !! FUNCTION
72 : : !! Gathers data from all tasks and distributes it to all.
73 : : !! Target: one-dimensional character(20) arrays.
74 : : !!
75 : : !! INPUTS
76 : : !! comm= MPI communicator
77 : : !! lenstr= Lenght of the string.
78 : : !!
79 : : !! OUTPUT
80 : : !! ier= exit status, a non-zero value meaning there is an error
81 : : !!
82 : : !! SIDE EFFECTS
83 : : !! charval= buffer array
84 : : !! recvbuf= received elements
85 : : !!
86 : : !! SOURCE
87 : :
88 [ # # ]: 0 : subroutine xmpi_allgather_char(charval, recvbuf, lenstr, comm, ier)
89 : :
90 : : !Arguments-------------------------
91 : : integer,intent(in) :: lenstr, comm
92 : : integer,intent(out) :: ier
93 : : character(len=lenstr),intent(inout) :: charval
94 : : character(len=lenstr), DEV_CONTARRD intent(inout) :: recvbuf(:)
95 : :
96 : : !Local variables-------------------
97 : : #if defined HAVE_MPI
98 : : integer :: ii
99 : 0 : character :: arr_charval(lenstr)
100 : : #endif
101 : :
102 : : ! *************************************************************************
103 : 0 : ier=0
104 : : #if defined HAVE_MPI
105 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
106 : : ! allgather xval on all proc. in comm
107 [ # # ]: 0 : do ii=1,lenstr; arr_charval(ii)=charval(ii:ii); enddo
108 [ # # ]: 0 : call MPI_ALLGATHER(arr_charval,lenstr,MPI_CHARACTER,recvbuf,lenstr,MPI_CHARACTER,comm,ier)
109 [ # # ]: 0 : else if (comm == MPI_COMM_SELF) then
110 [ # # # # ]: 0 : recvbuf=charval
111 : : end if
112 : : #else
113 : : recvbuf=charval
114 : : #endif
115 : :
116 : 0 : end subroutine xmpi_allgather_char
117 : : !!***
118 : :
119 : : !!****f* ABINIT/xmpi_allgather_int1d_1b
120 : : !! NAME
121 : : !! xmpi_allgather_int1d_1b
122 : : !!
123 : : !! FUNCTION
124 : : !! Gathers data from all tasks and distributes it to all.
125 : : !! Target: one-dimensional integer arrays.
126 : : !!
127 : : !! INPUTS
128 : : !! xval= buffer array
129 : : !! nelem= number of elements
130 : : !! comm= MPI communicator
131 : : !!
132 : : !! OUTPUT
133 : : !! ier= exit status, a non-zero value meaning there is an error
134 : : !!
135 : : !! SIDE EFFECTS
136 : : !! recvbuf= received elements
137 : : !!
138 : : !! SOURCE
139 : :
140 [ - + - + ]: 2491 : subroutine xmpi_allgather_int1d_1b(xval, nelem, recvbuf, comm, ier)
141 : :
142 : : !Arguments-------------------------
143 : : integer(c_int8_t), DEV_CONTARRD intent(in) :: xval(:)
144 : : integer(c_int8_t), DEV_CONTARRD intent(inout) :: recvbuf(:)
145 : : integer ,intent(in) :: nelem,comm
146 : : integer ,intent(out) :: ier
147 : :
148 : : ! *************************************************************************
149 : 2491 : ier=0
150 : : #if defined HAVE_MPI
151 [ + + ]: 2491 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
152 : : ! allgather xval on all proc. in comm
153 [ - + - + ]: 2471 : call MPI_ALLGATHER(xval,nelem,MPI_INTEGER1,recvbuf,nelem,MPI_INTEGER1,comm,ier)
154 [ + - ]: 20 : else if (comm == MPI_COMM_SELF) then
155 [ + + ]: 980 : recvbuf(1:nelem)=xval(1:nelem)
156 : : end if
157 : : #else
158 : : recvbuf(1:nelem)=xval(1:nelem)
159 : : #endif
160 : 2491 : end subroutine xmpi_allgather_int1d_1b
161 : : !!***
162 : :
163 : : !!****f* ABINIT/xmpi_allgather_int1d
164 : : !! NAME
165 : : !! xmpi_allgather_int1d
166 : : !!
167 : : !! FUNCTION
168 : : !! Gathers data from all tasks and distributes it to all.
169 : : !! Target: one-dimensional integer arrays.
170 : : !!
171 : : !! INPUTS
172 : : !! xval= buffer array
173 : : !! nelem= number of elements
174 : : !! comm= MPI communicator
175 : : !!
176 : : !! OUTPUT
177 : : !! ier= exit status, a non-zero value meaning there is an error
178 : : !!
179 : : !! SIDE EFFECTS
180 : : !! recvbuf= received elements
181 : : !!
182 : : !! SOURCE
183 : :
184 [ - + - + ]: 5940 : subroutine xmpi_allgather_int1d(xval,nelem,recvbuf,comm,ier)
185 : :
186 : : !Arguments-------------------------
187 : : integer, DEV_CONTARRD intent(in) :: xval(:)
188 : : integer, DEV_CONTARRD intent(inout) :: recvbuf(:)
189 : : integer ,intent(in) :: nelem,comm
190 : : integer ,intent(out) :: ier
191 : :
192 : : ! *************************************************************************
193 : 5940 : ier=0
194 : : #if defined HAVE_MPI
195 [ + - ]: 5940 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
196 : : ! allgather xval on all proc. in comm
197 [ - + - + ]: 5940 : call MPI_ALLGATHER(xval,nelem,MPI_INTEGER,recvbuf,nelem,MPI_INTEGER,comm,ier)
198 [ # # ]: 0 : else if (comm == MPI_COMM_SELF) then
199 [ # # ]: 0 : recvbuf(1:nelem)=xval(1:nelem)
200 : : end if
201 : : #else
202 : : recvbuf(1:nelem)=xval(1:nelem)
203 : : #endif
204 : 5940 : end subroutine xmpi_allgather_int1d
205 : : !!***
206 : :
207 : : !!****f* ABINIT/xmpi_allgather_int2d
208 : : !! NAME
209 : : !! xmpi_allgather_int2d
210 : : !!
211 : : !! FUNCTION
212 : : !! Gathers data from all tasks and distributes it to all.
213 : : !! Target: two-dimensional integer arrays.
214 : : !!
215 : : !! INPUTS
216 : : !! xval= buffer array
217 : : !! nelem= number of elements
218 : : !! comm= MPI communicator
219 : : !!
220 : : !! OUTPUT
221 : : !! ier= exit status, a non-zero value meaning there is an error
222 : : !!
223 : : !! SIDE EFFECTS
224 : : !! recvbuf= received elements
225 : : !!
226 : : !! SOURCE
227 : :
228 [ # # # # ]: 0 : subroutine xmpi_allgather_int2d(xval,nelem,recvbuf,comm,ier)
229 : :
230 : : !Arguments-------------------------
231 : : integer, DEV_CONTARRD intent(in) :: xval(:,:)
232 : : integer, DEV_CONTARRD intent(inout) :: recvbuf(:,:)
233 : : integer ,intent(in) :: nelem,comm
234 : : integer ,intent(out) :: ier
235 : :
236 : : ! *************************************************************************
237 : 0 : ier=0
238 : : #if defined HAVE_MPI
239 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
240 : : ! allgather xval on all proc. in comm
241 [ # # # # ]: 0 : call MPI_ALLGATHER(xval,nelem,MPI_INTEGER,recvbuf,nelem,MPI_INTEGER,comm,ier)
242 [ # # ]: 0 : else if (comm == MPI_COMM_SELF) then
243 [ # # # # ]: 0 : recvbuf(:,:)=xval(:,:)
244 : : end if
245 : : #else
246 : : recvbuf(:,:)=xval(:,:)
247 : : #endif
248 : 0 : end subroutine xmpi_allgather_int2d
249 : : !!***
250 : :
251 : :
252 : : !!****f* ABINIT/xmpi_allgather_dp1d
253 : : !! NAME
254 : : !! xmpi_allgather_dp1d
255 : : !!
256 : : !! FUNCTION
257 : : !! Gathers data from all tasks and distributes it to all.
258 : : !! Target: double precision one-dimensional arrays.
259 : : !!
260 : : !! INPUTS
261 : : !! xval= buffer array
262 : : !! nelem= number of elements
263 : : !! comm= MPI communicator
264 : : !!
265 : : !! OUTPUT
266 : : !! ier= exit status, a non-zero value meaning there is an error
267 : : !!
268 : : !! SIDE EFFECTS
269 : : !! recvbuf= received elements
270 : : !!
271 : : !! SOURCE
272 : :
273 [ - + - + ]: 108108 : subroutine xmpi_allgather_dp1d(xval,nelem,recvbuf,comm,ier)
274 : :
275 : : !Arguments-------------------------
276 : : real(dp), DEV_CONTARRD intent(in) :: xval(:)
277 : : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:)
278 : : integer ,intent(in) :: nelem,comm
279 : : integer ,intent(out) :: ier
280 : :
281 : : ! *************************************************************************
282 : 108108 : ier=0
283 : : #if defined HAVE_MPI
284 [ + + ]: 108108 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
285 : : ! allgather xval on all proc. in comm
286 [ - + - + ]: 107508 : call MPI_ALLGATHER(xval,nelem,MPI_DOUBLE_PRECISION,recvbuf,nelem,MPI_DOUBLE_PRECISION,comm,ier)
287 [ + - ]: 600 : else if (comm == MPI_COMM_SELF) then
288 [ + + ]: 120020 : recvbuf(1:nelem)=xval(1:nelem)
289 : : end if
290 : : #else
291 : : recvbuf(1:nelem)=xval(1:nelem)
292 : : #endif
293 : 108108 : end subroutine xmpi_allgather_dp1d
294 : : !!***
295 : :
296 : : !!****f* ABINIT/xmpi_allgather_dp2d
297 : : !! NAME
298 : : !! xmpi_allgather_dp2d
299 : : !!
300 : : !! FUNCTION
301 : : !! Gathers data from all tasks and distributes it to all.
302 : : !! Target: double precision two-dimensional arrays.
303 : : !!
304 : : !! INPUTS
305 : : !! xval= buffer array
306 : : !! nelem= number of elements
307 : : !! comm= MPI communicator
308 : : !!
309 : : !! OUTPUT
310 : : !! ier= exit status, a non-zero value meaning there is an error
311 : : !!
312 : : !! SIDE EFFECTS
313 : : !! recvbuf= received elements
314 : : !!
315 : : !! SOURCE
316 : :
317 [ - + - + ]: 144 : subroutine xmpi_allgather_dp2d(xval,nelem,recvbuf,comm,ier)
318 : :
319 : : !Arguments-------------------------
320 : : real(dp), DEV_CONTARRD intent(in) :: xval(:,:)
321 : : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:)
322 : : integer ,intent(in) :: nelem,comm
323 : : integer ,intent(out) :: ier
324 : :
325 : : ! *************************************************************************
326 : 144 : ier=0
327 : : #if defined HAVE_MPI
328 [ + + ]: 144 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
329 : : ! allgather xval on all proc. in comm
330 [ - + - + ]: 64 : call MPI_ALLGATHER(xval,nelem,MPI_DOUBLE_PRECISION,recvbuf,nelem,MPI_DOUBLE_PRECISION,comm,ier)
331 [ + - ]: 80 : else if (comm == MPI_COMM_SELF) then
332 [ + + + + ]: 21840 : recvbuf(:,:)=xval(:,:)
333 : : end if
334 : : #else
335 : : recvbuf(:,:)=xval(:,:)
336 : : #endif
337 : 144 : end subroutine xmpi_allgather_dp2d
338 : : !!***
339 : :
340 : : !!****f* ABINIT/xmpi_allgather_dp3d
341 : : !! NAME
342 : : !! xmpi_allgather_dp3d
343 : : !!
344 : : !! FUNCTION
345 : : !! Gathers data from all tasks and distributes it to all.
346 : : !! Target: double precision three-dimensional arrays.
347 : : !!
348 : : !! INPUTS
349 : : !! xval= buffer array
350 : : !! nelem= number of elements
351 : : !! comm= MPI communicator
352 : : !!
353 : : !! OUTPUT
354 : : !! ier= exit status, a non-zero value meaning there is an error
355 : : !!
356 : : !! SIDE EFFECTS
357 : : !! recvbuf= received elements
358 : : !!
359 : : !! SOURCE
360 : :
361 [ - + - + ]: 32425 : subroutine xmpi_allgather_dp3d(xval,nelem,recvbuf,comm,ier)
362 : :
363 : : !Arguments-------------------------
364 : : real(dp), DEV_CONTARRD intent(in) :: xval(:,:,:)
365 : : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:,:)
366 : : integer ,intent(in) :: nelem,comm
367 : : integer ,intent(out) :: ier
368 : :
369 : : ! *************************************************************************
370 : 32425 : ier=0
371 : : #if defined HAVE_MPI
372 [ + - ]: 32425 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
373 : : ! allgather xval on all proc. in comm
374 [ - + - + ]: 32425 : call MPI_ALLGATHER(xval,nelem,MPI_DOUBLE_PRECISION,recvbuf,nelem,MPI_DOUBLE_PRECISION,comm,ier)
375 [ # # ]: 0 : else if (comm == MPI_COMM_SELF) then
376 [ # # # # : 0 : recvbuf(:,:,:)=xval(:,:,:)
# # ]
377 : : end if
378 : : #else
379 : : recvbuf(:,:,:)=xval(:,:,:)
380 : : #endif
381 : 32425 : end subroutine xmpi_allgather_dp3d
382 : : !!***
383 : :
384 : : !!****f* ABINIT/xmpi_allgather_dp4d
385 : : !! NAME
386 : : !! xmpi_allgather_dp4d
387 : : !!
388 : : !! FUNCTION
389 : : !! Gathers data from all tasks and distributes it to all.
390 : : !! Target: double precision four-dimensional arrays.
391 : : !!
392 : : !! INPUTS
393 : : !! xval= buffer array
394 : : !! nelem= number of elements
395 : : !! comm= MPI communicator
396 : : !!
397 : : !! OUTPUT
398 : : !! ier= exit status, a non-zero value meaning there is an error
399 : : !!
400 : : !! SIDE EFFECTS
401 : : !! recvbuf= received elements
402 : : !!
403 : : !! SOURCE
404 : :
405 [ # # # # ]: 0 : subroutine xmpi_allgather_dp4d(xval,nelem,recvbuf,comm,ier)
406 : :
407 : : !Arguments-------------------------
408 : : real(dp), DEV_CONTARRD intent(in) :: xval(:,:,:,:)
409 : : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:,:,:)
410 : : integer ,intent(in) :: nelem,comm
411 : : integer ,intent(out) :: ier
412 : :
413 : : ! *************************************************************************
414 : 0 : ier=0
415 : : #if defined HAVE_MPI
416 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
417 : : ! allgather xval on all proc. in comm
418 [ # # # # ]: 0 : call MPI_ALLGATHER(xval,nelem,MPI_DOUBLE_PRECISION,recvbuf,nelem,MPI_DOUBLE_PRECISION,comm,ier)
419 [ # # ]: 0 : else if (comm == MPI_COMM_SELF) then
420 [ # # # # : 0 : recvbuf(:,:,:,:)=xval(:,:,:,:)
# # # # ]
421 : : end if
422 : : #else
423 : : recvbuf(:,:,:,:)=xval(:,:,:,:)
424 : : #endif
425 : 0 : end subroutine xmpi_allgather_dp4d
426 : : !!***
|
