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 217711 : 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 217711 : ier=0
52 : #if defined HAVE_MPI
53 217711 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
54 : ! allgather xval on all proc. in comm
55 204538 : arr_xval(1) = xval
56 204538 : 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 217711 : 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 2460 : 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 2460 : ier=0
150 : #if defined HAVE_MPI
151 2460 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
152 : ! allgather xval on all proc. in comm
153 2440 : 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 2460 : 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 5908 : 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 5908 : ier=0
194 : #if defined HAVE_MPI
195 5908 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
196 : ! allgather xval on all proc. in comm
197 5908 : 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 5908 : 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 108100 : 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 108100 : ier=0
283 : #if defined HAVE_MPI
284 108100 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
285 : ! allgather xval on all proc. in comm
286 107500 : 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 108100 : 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 32409 : 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 32409 : ier=0
371 : #if defined HAVE_MPI
372 32409 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
373 : ! allgather xval on all proc. in comm
374 32409 : 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 32409 : 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 : !!***
|
