Line data Source code
1 : !{\src2tex{textfont=tt}}
2 : !!****f* ABINIT/xmpi_scatterv
3 : !! NAME
4 : !! xmpi_scatterv
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_scatterv 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_scatterv_int
22 : !! NAME
23 : !! xmpi_scatterv_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 : !! recvcount= number of received elements
32 : !! displs= relative offsets for incoming data (array)
33 : !! sendcounts= number of sent elements (array)
34 : !! root= rank of receiving process
35 : !! comm= MPI communicator
36 : !!
37 : !! OUTPUT
38 : !! ier= exit status, a non-zero value meaning there is an error
39 : !!
40 : !! SIDE EFFECTS
41 : !! recvbuf= received buffer
42 : !!
43 : !!
44 : !! SOURCE
45 44 : subroutine xmpi_scatterv_int(xval,sendcounts,displs,recvbuf,recvcount,root,comm,ier)
46 :
47 : !Arguments-------------------------
48 : integer, DEV_CONTARRD intent(in) :: xval(:)
49 : integer, DEV_CONTARRD intent(inout) :: recvbuf(:)
50 : integer, DEV_CONTARRD intent(in) :: sendcounts(:),displs(:)
51 : integer,intent(in) :: recvcount,root,comm
52 : integer,intent(out) :: ier
53 :
54 : !Local variables-------------------
55 : integer :: dd
56 :
57 : ! *************************************************************************
58 :
59 44 : ier=0
60 : #if defined HAVE_MPI
61 44 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
62 : call MPI_SCATTERV(xval,sendcounts,displs,MPI_INTEGER,recvbuf,recvcount,&
63 44 : & MPI_INTEGER,root,comm,ier)
64 0 : else if (comm == MPI_COMM_SELF) then
65 : #endif
66 0 : dd=0;if (size(displs)>0) dd=displs(1)
67 0 : recvbuf(1:recvcount)=xval(dd+1:dd+recvcount)
68 : #if defined HAVE_MPI
69 : end if
70 : #endif
71 :
72 44 : end subroutine xmpi_scatterv_int
73 : !!***
74 :
75 : !!****f* ABINIT/xmpi_scatterv_int2d
76 : !! NAME
77 : !! xmpi_scatterv_int2d
78 : !!
79 : !! FUNCTION
80 : !! Gathers data from all tasks and delivers it to all.
81 : !! Target: two-dimensional integer arrays.
82 : !!
83 : !! INPUTS
84 : !! xval= buffer array
85 : !! recvcount= number of received elements
86 : !! displs= relative offsets for incoming data (array)
87 : !! sendcounts= number of sent elements (array)
88 : !! root= rank of receiving process
89 : !! comm= MPI communicator
90 : !!
91 : !! OUTPUT
92 : !! ier= exit status, a non-zero value meaning there is an error
93 : !!
94 : !! SIDE EFFECTS
95 : !! recvbuf= received buffer
96 : !!
97 : !! SOURCE
98 :
99 44 : subroutine xmpi_scatterv_int2d(xval,sendcounts,displs,recvbuf,recvcount,root,comm,ier)
100 :
101 : !Arguments-------------------------
102 : integer, DEV_CONTARRD intent(in) :: xval(:,:)
103 : integer, DEV_CONTARRD intent(inout) :: recvbuf(:,:)
104 : integer, DEV_CONTARRD intent(in) :: sendcounts(:),displs(:)
105 : integer,intent(in) :: recvcount,root,comm
106 : integer,intent(out) :: ier
107 :
108 : !Local variables-------------------
109 : integer :: cc,dd,sz1
110 :
111 : ! *************************************************************************
112 :
113 44 : ier=0
114 : #if defined HAVE_MPI
115 44 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
116 : call MPI_SCATTERV(xval,sendcounts,displs,MPI_INTEGER,recvbuf,recvcount,&
117 44 : & MPI_INTEGER,root,comm,ier)
118 0 : else if (comm == MPI_COMM_SELF) then
119 : #endif
120 0 : sz1=size(recvbuf,1);cc=recvcount/sz1
121 0 : dd=0;if (size(displs)>0) dd=displs(1)/sz1
122 0 : recvbuf(:,1:cc)=xval(:,dd+1:dd+cc)
123 : #if defined HAVE_MPI
124 : end if
125 : #endif
126 :
127 44 : end subroutine xmpi_scatterv_int2d
128 : !!***
129 :
130 : !!****f* ABINIT/xmpi_scatterv_dp
131 : !! NAME
132 : !! xmpi_scatterv_dp
133 : !!
134 : !! FUNCTION
135 : !! Gathers data from all tasks and delivers it to all.
136 : !! Target: one-dimensional real arrays.
137 : !!
138 : !! INPUTS
139 : !! xval= buffer array
140 : !! recvcount= number of received elements
141 : !! displs= relative offsets for incoming data (array)
142 : !! sendcounts= number of sent elements (array)
143 : !! root= rank of receiving process
144 : !! comm= MPI communicator
145 : !!
146 : !! OUTPUT
147 : !! ier= exit status, a non-zero value meaning there is an error
148 : !!
149 : !! SIDE EFFECTS
150 : !! recvbuf= received buffer
151 : !!
152 : !! SOURCE
153 :
154 0 : subroutine xmpi_scatterv_dp(xval,sendcounts,displs,recvbuf,recvcount,root,comm,ier)
155 :
156 : !Arguments-------------------------
157 : real(dp), DEV_CONTARRD intent(in) :: xval(:)
158 : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:)
159 : integer, DEV_CONTARRD intent(in) :: sendcounts(:),displs(:)
160 : integer,intent(in) :: recvcount,root,comm
161 : integer,intent(out) :: ier
162 :
163 : !Local variables-------------------
164 : integer :: dd
165 :
166 : ! *************************************************************************
167 :
168 0 : ier=0
169 : #if defined HAVE_MPI
170 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
171 : call MPI_SCATTERV(xval,sendcounts,displs,MPI_DOUBLE_PRECISION,recvbuf,recvcount,&
172 0 : & MPI_DOUBLE_PRECISION,root,comm,ier)
173 0 : else if (comm == MPI_COMM_SELF) then
174 : #endif
175 0 : dd=0;if (size(displs)>0) dd=displs(1)
176 0 : recvbuf(1:recvcount)=xval(dd+1:dd+recvcount)
177 : #if defined HAVE_MPI
178 : end if
179 : #endif
180 :
181 0 : end subroutine xmpi_scatterv_dp
182 : !!***
183 :
184 : !!****f* ABINIT/xmpi_scatterv_dp2d
185 : !! NAME
186 : !! xmpi_scatterv_dp2d
187 : !!
188 : !! FUNCTION
189 : !! Gathers data from all tasks and delivers it to all.
190 : !! Target: two-dimensional real arrays.
191 : !!
192 : !! INPUTS
193 : !! xval= buffer array
194 : !! recvcount= number of received elements
195 : !! displs= relative offsets for incoming data (array)
196 : !! sendcounts= number of sent elements (array)
197 : !! root= rank of receiving process
198 : !! comm= MPI communicator
199 : !!
200 : !! OUTPUT
201 : !! ier= exit status, a non-zero value meaning there is an error
202 : !!
203 : !! SIDE EFFECTS
204 : !! recvbuf= received buffer
205 : !!
206 : !! SOURCE
207 :
208 132 : subroutine xmpi_scatterv_dp2d(xval,sendcounts,displs,recvbuf,recvcount,root,comm,ier)
209 :
210 : !Arguments-------------------------
211 : real(dp), DEV_CONTARRD intent(in) :: xval(:,:)
212 : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:)
213 : integer, DEV_CONTARRD intent(in) :: sendcounts(:),displs(:)
214 : integer,intent(in) :: recvcount,root,comm
215 : integer,intent(out) :: ier
216 :
217 : !Local variables-------------------
218 : integer :: cc,dd,sz1
219 :
220 : ! *************************************************************************
221 :
222 132 : ier=0
223 : #if defined HAVE_MPI
224 132 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
225 : call MPI_SCATTERV(xval,sendcounts,displs,MPI_DOUBLE_PRECISION,recvbuf,recvcount,&
226 88 : & MPI_DOUBLE_PRECISION,root,comm,ier)
227 44 : else if (comm == MPI_COMM_SELF) then
228 : #endif
229 44 : sz1=size(recvbuf,1);cc=recvcount/sz1
230 44 : dd=0;if (size(displs)>0) dd=displs(1)/sz1
231 3212 : recvbuf(:,1:cc)=xval(:,dd+1:dd+cc)
232 : #if defined HAVE_MPI
233 : end if
234 : #endif
235 :
236 132 : end subroutine xmpi_scatterv_dp2d
237 : !!***
238 :
239 : !!****f* ABINIT/xmpi_scatterv_dp3d
240 : !! NAME
241 : !! xmpi_scatterv_dp3d
242 : !!
243 : !! FUNCTION
244 : !! Gathers data from all tasks and delivers it to all.
245 : !! Target: three-dimensional real arrays.
246 : !!
247 : !! INPUTS
248 : !! xval= buffer array
249 : !! recvcount= number of received elements
250 : !! displs= relative offsets for incoming data (array)
251 : !! sendcounts= number of sent elements (array)
252 : !! root= rank of receiving process
253 : !! comm= MPI communicator
254 : !!
255 : !! OUTPUT
256 : !! ier= exit status, a non-zero value meaning there is an error
257 : !!
258 : !! SIDE EFFECTS
259 : !! recvbuf= received buffer
260 : !!
261 : !! SOURCE
262 :
263 0 : subroutine xmpi_scatterv_dp3d(xval,sendcounts,displs,recvbuf,recvcount,root,comm,ier)
264 :
265 : !Arguments-------------------------
266 : real(dp), DEV_CONTARRD intent(in) :: xval(:,:,:)
267 : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:,:)
268 : integer, DEV_CONTARRD intent(in) :: sendcounts(:),displs(:)
269 : integer,intent(in) :: recvcount,root,comm
270 : integer,intent(out) :: ier
271 :
272 : !Local variables-------------------
273 : integer :: cc,dd,sz12
274 :
275 : ! *************************************************************************
276 :
277 0 : ier=0
278 : #if defined HAVE_MPI
279 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
280 : call MPI_SCATTERV(xval,sendcounts,displs,MPI_DOUBLE_PRECISION,recvbuf,recvcount,&
281 0 : & MPI_DOUBLE_PRECISION,root,comm,ier)
282 0 : else if (comm == MPI_COMM_SELF) then
283 : #endif
284 0 : sz12=size(recvbuf,1)*size(recvbuf,2);cc=recvcount/sz12
285 0 : dd=0;if (size(displs)>0) dd=displs(1)/sz12
286 0 : recvbuf(:,:,1:cc)=xval(:,:,dd+1:dd+cc)
287 : #if defined HAVE_MPI
288 : end if
289 : #endif
290 :
291 0 : end subroutine xmpi_scatterv_dp3d
292 : !!***
293 :
294 : !!****f* ABINIT/xmpi_scatterv_dp4d
295 : !! NAME
296 : !! xmpi_scatterv_dp4d
297 : !!
298 : !! FUNCTION
299 : !! Gathers data from all tasks and delivers it to all.
300 : !! Target: four-dimensional real arrays.
301 : !!
302 : !! INPUTS
303 : !! xval= buffer array
304 : !! recvcount= number of received elements
305 : !! displs= relative offsets for incoming data (array)
306 : !! sendcounts= number of sent elements (array)
307 : !! root= rank of receiving process
308 : !! comm= MPI communicator
309 : !!
310 : !! OUTPUT
311 : !! ier= exit status, a non-zero value meaning there is an error
312 : !!
313 : !! SIDE EFFECTS
314 : !! recvbuf= received buffer
315 : !!
316 : !! SOURCE
317 :
318 0 : subroutine xmpi_scatterv_dp4d(xval,sendcounts,displs,recvbuf,recvcount,root,comm,ier)
319 :
320 : !Arguments-------------------------
321 : real(dp), DEV_CONTARRD intent(in) :: xval(:,:,:,:)
322 : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:,:,:)
323 : integer, DEV_CONTARRD intent(in) :: sendcounts(:),displs(:)
324 : integer,intent(in) :: recvcount,root,comm
325 : integer,intent(out) :: ier
326 :
327 : !Local variables-------------------
328 : integer :: cc,dd,sz123
329 :
330 : ! *************************************************************************
331 :
332 0 : ier=0
333 : #if defined HAVE_MPI
334 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
335 : call MPI_SCATTERV(xval,sendcounts,displs,MPI_DOUBLE_PRECISION,recvbuf,recvcount,&
336 0 : & MPI_DOUBLE_PRECISION,root,comm,ier)
337 0 : else if (comm == MPI_COMM_SELF) then
338 : #endif
339 0 : sz123=size(recvbuf,1)*size(recvbuf,2)*size(recvbuf,2);cc=recvcount/sz123
340 0 : dd=0;if (size(displs)>0) dd=displs(1)/sz123
341 0 : recvbuf(:,:,:,1:cc)=xval(:,:,:,dd+1:dd+cc)
342 : #if defined HAVE_MPI
343 : end if
344 : #endif
345 :
346 0 : end subroutine xmpi_scatterv_dp4d
347 : !!***
|
