Branch data 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 : : !!***
|
