Line data Source code
1 : !{\src2tex{textfont=tt}}
2 : !!****f* ABINIT/xmpi_gather
3 : !! NAME
4 : !! xmpi_gather
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_gather is the generic function.
10 : !!
11 : !! COPYRIGHT
12 : !! Copyright (C) 2001-2026 ABINIT group (MT)
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_gather_int
22 : !! NAME
23 : !! xmpi_gather_int
24 : !!
25 : !! FUNCTION
26 : !! Gathers data from all tasks and delivers it to all.
27 : !! Target: one-dimensional integer arrays.
28 : !!
29 : !! INPUTS
30 : !! xval= buffer array
31 : !! sendcont= number of sent elements
32 : !! recvcount= number of received elements
33 : !! root= rank of receiving process
34 : !! comm= MPI communicator
35 : !!
36 : !! OUTPUT
37 : !! ier= exit status, a non-zero value meaning there is an error
38 : !!
39 : !! SIDE EFFECTS
40 : !! recvbuf= received buffer
41 : !!
42 : !! SOURCE
43 :
44 0 : subroutine xmpi_gather_int(xval,sendcount,recvbuf,recvcount,root,comm,ier)
45 :
46 : !Arguments-------------------------
47 : integer,intent(in) :: sendcount,recvcount
48 : integer, DEV_CONTARRD intent(in) :: xval(:)
49 : integer, DEV_CONTARRD intent(inout) :: recvbuf(:)
50 : integer,intent(in) :: root,comm
51 : integer,intent(out) :: ier
52 :
53 : ! *************************************************************************
54 :
55 0 : ier=0
56 : #if defined HAVE_MPI
57 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
58 0 : call MPI_gather(xval,sendcount,MPI_INTEGER,recvbuf,recvcount,MPI_INTEGER,root,comm,ier)
59 0 : else if (comm == MPI_COMM_SELF) then
60 0 : recvbuf=xval
61 : end if
62 : #else
63 : recvbuf=xval
64 : #endif
65 0 : end subroutine xmpi_gather_int
66 : !!***
67 :
68 : !!****f* ABINIT/xmpi_gather_int2d
69 : !! NAME
70 : !! xmpi_gather_int2d
71 : !!
72 : !! FUNCTION
73 : !! Gathers data from all tasks and delivers it to all.
74 : !! Target: two-dimensional integer arrays.
75 : !!
76 : !! INPUTS
77 : !! xval= buffer array
78 : !! sendcont= number of sent elements
79 : !! recvcount= number of received elements
80 : !! root= rank of receiving process
81 : !! comm= MPI communicator
82 : !!
83 : !! OUTPUT
84 : !! ier= exit status, a non-zero value meaning there is an error
85 : !!
86 : !! SIDE EFFECTS
87 : !! recvbuf= received buffer
88 : !!
89 : !! SOURCE
90 :
91 0 : subroutine xmpi_gather_int2d(xval,sendcount,recvbuf,recvcount,root,comm,ier)
92 :
93 : !Arguments-------------------------
94 : integer,intent(in) :: sendcount,recvcount
95 : integer, DEV_CONTARRD intent(in) :: xval(:,:)
96 : integer, DEV_CONTARRD intent(inout) :: recvbuf(:,:)
97 : integer,intent(in) :: root,comm
98 : integer,intent(out) :: ier
99 :
100 : ! *************************************************************************
101 :
102 0 : ier=0
103 : #if defined HAVE_MPI
104 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
105 0 : call MPI_gather(xval,sendcount,MPI_INTEGER,recvbuf,recvcount,MPI_INTEGER,root,comm,ier)
106 0 : else if (comm == MPI_COMM_SELF) then
107 0 : recvbuf=xval
108 : end if
109 : #else
110 : recvbuf=xval
111 : #endif
112 0 : end subroutine xmpi_gather_int2d
113 : !!***
114 :
115 : !!****f* ABINIT/xmpi_gather_dp
116 : !! NAME
117 : !! xmpi_gather_dp
118 : !!
119 : !! FUNCTION
120 : !! Gathers data from all tasks and delivers it to all.
121 : !! Target: one-dimensional real arrays.
122 : !!
123 : !! INPUTS
124 : !! xval= buffer array
125 : !! sendcont= number of sent elements
126 : !! recvcount= number of received elements
127 : !! root= rank of receiving process
128 : !! comm= MPI communicator
129 : !!
130 : !! OUTPUT
131 : !! ier= exit status, a non-zero value meaning there is an error
132 : !!
133 : !! SIDE EFFECTS
134 : !! recvbuf= received buffer
135 : !!
136 : !! SOURCE
137 :
138 0 : subroutine xmpi_gather_dp(xval,sendcount,recvbuf,recvcount,root,comm,ier)
139 :
140 : !Arguments-------------------------
141 : integer,intent(in) :: sendcount,recvcount
142 : real(dp), DEV_CONTARRD intent(in) :: xval(:)
143 : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:)
144 : integer,intent(in) :: root,comm
145 : integer,intent(out) :: ier
146 :
147 : ! *************************************************************************
148 :
149 0 : ier=0
150 : #if defined HAVE_MPI
151 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
152 : call MPI_gather(xval,sendcount,MPI_DOUBLE_PRECISION,recvbuf,recvcount,MPI_DOUBLE_PRECISION,&
153 0 : & root,comm,ier)
154 0 : else if (comm == MPI_COMM_SELF) then
155 0 : recvbuf=xval
156 : end if
157 : #else
158 : recvbuf=xval
159 : #endif
160 0 : end subroutine xmpi_gather_dp
161 : !!***
162 :
163 : !!****f* ABINIT/xmpi_gather_dp2d
164 : !! NAME
165 : !! xmpi_gather_dp2d
166 : !!
167 : !! FUNCTION
168 : !! Gathers data from all tasks and delivers it to all.
169 : !! Target: two-dimensional real arrays.
170 : !!
171 : !! INPUTS
172 : !! xval= buffer array
173 : !! sendcont= number of sent elements
174 : !! recvcount= number of received elements
175 : !! root= rank of receiving process
176 : !! comm= MPI communicator
177 : !!
178 : !! OUTPUT
179 : !! ier= exit status, a non-zero value meaning there is an error
180 : !!
181 : !! SIDE EFFECTS
182 : !! recvbuf= received buffer
183 : !!
184 : !! SOURCE
185 :
186 120 : subroutine xmpi_gather_dp2d(xval,sendcount,recvbuf,recvcount,root,comm,ier)
187 :
188 : !Arguments-------------------------
189 : integer,intent(in) :: sendcount,recvcount
190 : real(dp), DEV_CONTARRD intent(in) :: xval(:,:)
191 : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:)
192 : integer,intent(in) :: root,comm
193 : integer,intent(out) :: ier
194 :
195 : ! *************************************************************************
196 :
197 120 : ier=0
198 : #if defined HAVE_MPI
199 120 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
200 : call MPI_gather(xval,sendcount,MPI_DOUBLE_PRECISION,recvbuf,recvcount,MPI_DOUBLE_PRECISION,&
201 80 : & root,comm,ier)
202 40 : else if (comm == MPI_COMM_SELF) then
203 2920 : recvbuf=xval
204 : end if
205 : #else
206 : recvbuf=xval
207 : #endif
208 120 : end subroutine xmpi_gather_dp2d
209 : !!***
210 :
211 : !!****f* ABINIT/xmpi_gather_dp3d
212 : !! NAME
213 : !! xmpi_gather_dp3d
214 : !!
215 : !! FUNCTION
216 : !! Gathers data from all tasks and delivers it to all.
217 : !! Target: three-dimensional real arrays.
218 : !!
219 : !! INPUTS
220 : !! xval= buffer array
221 : !! sendcont= number of sent elements
222 : !! recvcount= number of received elements
223 : !! root= rank of receiving process
224 : !! comm= MPI communicator
225 : !!
226 : !! OUTPUT
227 : !! ier= exit status, a non-zero value meaning there is an error
228 : !!
229 : !! SIDE EFFECTS
230 : !! recvbuf= received buffer
231 : !!
232 : !! SOURCE
233 :
234 0 : subroutine xmpi_gather_dp3d(xval,sendcount,recvbuf,recvcount,root,comm,ier)
235 :
236 : !Arguments-------------------------
237 : integer,intent(in) :: sendcount,recvcount
238 : real(dp), DEV_CONTARRD intent(in) :: xval(:,:,:)
239 : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:,:)
240 : integer,intent(in) :: root,comm
241 : integer,intent(out) :: ier
242 :
243 : ! *************************************************************************
244 :
245 0 : ier=0
246 : #if defined HAVE_MPI
247 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
248 : call MPI_gather(xval,sendcount,MPI_DOUBLE_PRECISION,recvbuf,recvcount,MPI_DOUBLE_PRECISION,&
249 0 : & root,comm,ier)
250 0 : else if (comm == MPI_COMM_SELF) then
251 0 : recvbuf=xval
252 : end if
253 : #else
254 : recvbuf=xval
255 : #endif
256 :
257 0 : end subroutine xmpi_gather_dp3d
258 : !!***
259 :
260 : !!****f* ABINIT/xmpi_gather_dp4d
261 : !! NAME
262 : !! xmpi_gather_dp4d
263 : !!
264 : !! FUNCTION
265 : !! Gathers data from all tasks and delivers it to all.
266 : !! Target: four-dimensional real arrays.
267 : !!
268 : !! INPUTS
269 : !! xval= buffer array
270 : !! sendcont= number of sent elements
271 : !! recvcount= number of received elements
272 : !! root= rank of receiving process
273 : !! comm= MPI communicator
274 : !!
275 : !! OUTPUT
276 : !! ier= exit status, a non-zero value meaning there is an error
277 : !!
278 : !! SIDE EFFECTS
279 : !! recvbuf= received buffer
280 : !!
281 : !! SOURCE
282 :
283 0 : subroutine xmpi_gather_dp4d(xval,sendcount,recvbuf,recvcount,root,comm,ier)
284 :
285 : !Arguments-------------------------
286 : integer,intent(in) :: sendcount,recvcount
287 : real(dp), DEV_CONTARRD intent(in) :: xval(:,:,:,:)
288 : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:,:,:)
289 : integer,intent(in) :: root,comm
290 : integer,intent(out) :: ier
291 :
292 : ! *************************************************************************
293 :
294 0 : ier=0
295 : #if defined HAVE_MPI
296 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
297 : call MPI_gather(xval,sendcount,MPI_DOUBLE_PRECISION,recvbuf,recvcount,MPI_DOUBLE_PRECISION,&
298 0 : & root,comm,ier)
299 0 : else if (comm == MPI_COMM_SELF) then
300 0 : recvbuf=xval
301 : end if
302 : #else
303 : recvbuf=xval
304 : #endif
305 :
306 0 : end subroutine xmpi_gather_dp4d
307 : !!***
|
