Branch data Line data Source code
1 : : !{\src2tex{textfont=tt}}
2 : : !!****f* ABINIT/xmpi_exch_int1d
3 : : !! NAME
4 : : !! xmpi_exch_int1d
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_exch is the generic function.
10 : : !!
11 : : !! COPYRIGHT
12 : : !! Copyright (C) 2001-2026 ABINIT group (MB,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 : : !! NOTE
18 : : !! The tag conforms to the MPI request that the tag is lower than 32768,
19 : : !! by using a modulo call.
20 : : !!
21 : : !! SOURCE
22 : :
23 : : !--------------------------------------------------------------------
24 : :
25 [ # # # # ]: 0 : subroutine xmpi_exch_int1d(vsend,n1,sender,vrecv,recever,comm,mtag,ier)
26 : :
27 : : !Arguments----------------
28 : : integer,intent(in) :: mtag,n1
29 : : integer, DEV_CONTARRD intent(in) :: vsend(:)
30 : : integer, DEV_CONTARRD intent(inout) :: vrecv(:)
31 : : integer,intent(in) :: sender,recever,comm
32 : : integer,intent(out) :: ier
33 : :
34 : : !Local variables--------------
35 : : #if defined HAVE_MPI
36 : : integer :: statux(MPI_STATUS_SIZE)
37 : : integer :: tag,me
38 : : #endif
39 : :
40 : : ! *************************************************************************
41 : :
42 : 0 : ier=0
43 : : #if defined HAVE_MPI
44 [ # # # # : 0 : if (sender==recever.or.comm==MPI_COMM_NULL.or.n1==0) return
# # ]
45 : 0 : call MPI_COMM_RANK(comm,me,ier)
46 : 0 : tag = MOD(mtag,xmpi_tag_ub)
47 : :
48 [ # # ]: 0 : if (recever==me) then
49 [ # # ]: 0 : call MPI_RECV(vrecv,n1,MPI_INTEGER,sender,tag,comm,statux,ier)
50 : : end if
51 [ # # ]: 0 : if (sender==me) then
52 [ # # ]: 0 : call MPI_SEND(vsend,n1,MPI_INTEGER,recever,tag,comm,ier)
53 : : end if
54 : : #endif
55 : :
56 : : end subroutine xmpi_exch_int1d
57 : : !!***
58 : :
59 : : !--------------------------------------------------------------------
60 : :
61 : : !!****f* ABINIT/xmpi_exch_int2d
62 : : !! NAME
63 : : !! xmpi_exch_int2d
64 : : !!
65 : : !! FUNCTION
66 : : !! Sends and receives data.
67 : : !! Target: two-dimensional integer arrays.
68 : : !!
69 : : !! INPUTS
70 : : !! mtag= message tag
71 : : !! nt= vector length
72 : : !! vsend= send buffer
73 : : !! sender= node sending the data
74 : : !! recever= node receiving the data
75 : : !! comm= MPI communicator
76 : : !!
77 : : !! OUTPUT
78 : : !! ier= exit status, a non-zero value meaning there is an error
79 : : !!
80 : : !! SIDE EFFECTS
81 : : !! vrecv= receive buffer
82 : : !!
83 : : !! SOURCE
84 : :
85 [ - + - + ]: 140 : subroutine xmpi_exch_int2d(vsend,nt,sender,vrecv,recever,comm,mtag,ier)
86 : :
87 : : !Arguments----------------
88 : : integer,intent(in) :: mtag,nt
89 : : integer, DEV_CONTARRD intent(in) :: vsend(:,:)
90 : : integer, DEV_CONTARRD intent(inout) :: vrecv(:,:)
91 : : integer,intent(in) :: sender,recever,comm
92 : : integer,intent(out) :: ier
93 : :
94 : : !Local variables--------------
95 : : #if defined HAVE_MPI
96 : : integer :: statux(MPI_STATUS_SIZE)
97 : : integer :: tag,me
98 : : #endif
99 : :
100 : : ! *************************************************************************
101 : :
102 : 140 : ier=0
103 : : #if defined HAVE_MPI
104 [ + - + - : 140 : if (sender==recever.or.comm==MPI_COMM_NULL.or.nt==0) return
- + ]
105 : 140 : call MPI_COMM_RANK(comm,me,ier)
106 : 140 : tag = MOD(mtag, xmpi_tag_ub)
107 : :
108 [ + + ]: 140 : if (recever==me) then
109 [ - + ]: 70 : call MPI_RECV(vrecv,nt,MPI_INTEGER,sender,tag,comm,statux,ier)
110 : : end if
111 [ + + ]: 140 : if (sender==me) then
112 [ - + ]: 70 : call MPI_SEND(vsend,nt,MPI_INTEGER,recever,tag,comm,ier)
113 : : end if
114 : : #endif
115 : :
116 : : end subroutine xmpi_exch_int2d
117 : : !!***
118 : :
119 : : !--------------------------------------------------------------------
120 : :
121 : : !!****f* ABINIT/xmpi_exch_dp1d
122 : : !! NAME
123 : : !! xmpi_exch_dp1d
124 : : !!
125 : : !! FUNCTION
126 : : !! Sends and receives data.
127 : : !! Target: double precision one-dimensional arrays.
128 : : !!
129 : : !! INPUTS
130 : : !! mtag= message tag
131 : : !! nt= vector length
132 : : !! vsend= send buffer
133 : : !! sender= node sending the data
134 : : !! recever= node receiving the data
135 : : !! comm= MPI communicator
136 : : !!
137 : : !! OUTPUT
138 : : !! ier= exit status, a non-zero value meaning there is an error
139 : : !!
140 : : !! SIDE EFFECTS
141 : : !! vrecv= receive buffer
142 : : !!
143 : : !! SOURCE
144 : :
145 [ # # # # ]: 0 : subroutine xmpi_exch_dp1d(vsend,nt,sender,vrecv,recever,comm,mtag,ier)
146 : :
147 : : !Arguments----------------
148 : : integer,intent(in) :: mtag,nt
149 : : real(dp), DEV_CONTARRD intent(in) :: vsend(:)
150 : : real(dp), DEV_CONTARRD intent(inout) :: vrecv(:)
151 : : integer,intent(in) :: sender,recever,comm
152 : : integer,intent(out) :: ier
153 : :
154 : : !Local variables--------------
155 : : #if defined HAVE_MPI
156 : : integer :: statux(MPI_STATUS_SIZE)
157 : : integer :: me,my_dt,my_op,tag
158 : : integer(kind=int64) :: ntot
159 : : #endif
160 : :
161 : : ! *************************************************************************
162 : :
163 : 0 : ier=0
164 : : #if defined HAVE_MPI
165 [ # # # # : 0 : if (sender==recever.or.comm==MPI_COMM_NULL.or.nt==0) return
# # ]
166 : 0 : call MPI_COMM_RANK(comm,me,ier)
167 : 0 : tag = MOD(mtag, xmpi_tag_ub)
168 : :
169 : : !The dimension can be greater than a 32bit integer
170 : : !We use a INT64 to store it. If it is too large, we switch to an
171 : : !alternate routine because MPI<4 doesnt handle 64 bit counts.
172 : 0 : ntot=int(nt,kind=int64)
173 : :
174 [ # # ]: 0 : if (recever==me) then
175 : : if (ntot<=xmpi_maxint32_64) then
176 [ # # ]: 0 : call MPI_RECV(vrecv,nt,MPI_DOUBLE_PRECISION,sender,tag,comm,statux,ier)
177 : : else
178 : : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
179 : : call MPI_RECV(vrecv,1,my_dt,sender,tag,comm,statux,ier)
180 : : call xmpi_largetype_free(my_dt,my_op)
181 : : end if
182 : : end if
183 [ # # ]: 0 : if (sender==me) then
184 : : if (ntot<=xmpi_maxint32_64) then
185 [ # # ]: 0 : call MPI_SEND(vsend,nt,MPI_DOUBLE_PRECISION,recever,tag,comm,ier)
186 : : else
187 : : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
188 : : call MPI_SEND(vsend,1,my_dt,recever,tag,comm,ier)
189 : : call xmpi_largetype_free(my_dt,my_op)
190 : : end if
191 : : end if
192 : : #endif
193 : :
194 : : end subroutine xmpi_exch_dp1d
195 : : !!***
196 : :
197 : : !--------------------------------------------------------------------
198 : :
199 : : !!****f* ABINIT/xmpi_exch_dp2d
200 : : !! NAME
201 : : !! xmpi_exch_dp2d
202 : : !!
203 : : !! FUNCTION
204 : : !! Sends and receives data.
205 : : !! Target: double precision two-dimensional arrays.
206 : : !!
207 : : !! INPUTS
208 : : !! mtag= message tag
209 : : !! nt= vector length
210 : : !! vsend= send buffer
211 : : !! sender= node sending the data
212 : : !! recever= node receiving the data
213 : : !! comm= MPI communicator
214 : : !!
215 : : !! OUTPUT
216 : : !! ier= exit status, a non-zero value meaning there is an error
217 : : !!
218 : : !! SIDE EFFECTS
219 : : !! vrecv= receive buffer
220 : : !!
221 : : !! SOURCE
222 : :
223 [ - + - + ]: 148 : subroutine xmpi_exch_dp2d(vsend,nt,sender,vrecv,recever,comm,mtag,ier)
224 : :
225 : : !Arguments----------------
226 : : integer,intent(in) :: mtag,nt
227 : : real(dp), DEV_CONTARRD intent(in) :: vsend(:,:)
228 : : real(dp), DEV_CONTARRD intent(inout) :: vrecv(:,:)
229 : : integer,intent(in) :: sender,recever,comm
230 : : integer,intent(out) :: ier
231 : :
232 : : !Local variables--------------
233 : : #if defined HAVE_MPI
234 : : integer :: statux(MPI_STATUS_SIZE)
235 : : integer :: me,my_dt,my_op,tag
236 : : integer(kind=int64) :: ntot
237 : : #endif
238 : :
239 : : ! *************************************************************************
240 : :
241 : 148 : ier=0
242 : : #if defined HAVE_MPI
243 [ + - + - : 148 : if (sender==recever.or.comm==MPI_COMM_NULL.or.nt==0) return
- + ]
244 : 148 : call MPI_COMM_RANK(comm,me,ier)
245 : 148 : tag = MOD(mtag, xmpi_tag_ub)
246 : :
247 : : !The dimension can be greater than a 32bit integer
248 : : !We use a INT64 to store it. If it is too large, we switch to an
249 : : !alternate routine because MPI<4 doesnt handle 64 bit counts.
250 : 148 : ntot=int(nt,kind=int64)
251 : :
252 [ + + ]: 148 : if (recever==me) then
253 : : if (ntot<=xmpi_maxint32_64) then
254 [ - + ]: 74 : call MPI_RECV(vrecv,nt,MPI_DOUBLE_PRECISION,sender,tag,comm,statux,ier)
255 : : else
256 : : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
257 : : call MPI_RECV(vrecv,1,my_dt,sender,tag,comm,statux,ier)
258 : : call xmpi_largetype_free(my_dt,my_op)
259 : : end if
260 : : end if
261 [ + + ]: 148 : if (sender==me) then
262 : : if (ntot<=xmpi_maxint32_64) then
263 [ - + ]: 74 : call MPI_SEND(vsend,nt,MPI_DOUBLE_PRECISION,recever,tag,comm,ier)
264 : : else
265 : : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
266 : : call MPI_SEND(vsend,1,my_dt,recever,tag,comm,ier)
267 : : call xmpi_largetype_free(my_dt,my_op)
268 : : end if
269 : : end if
270 : : #endif
271 : :
272 : : end subroutine xmpi_exch_dp2d
273 : : !!***
274 : :
275 : : !--------------------------------------------------------------------
276 : :
277 : : !!****f* ABINIT/xmpi_exch_dp3d
278 : : !! NAME
279 : : !! xmpi_exch_dp3d
280 : : !!
281 : : !! FUNCTION
282 : : !! Sends and receives data.
283 : : !! Target: double precision three-dimensional arrays.
284 : : !!
285 : : !! INPUTS
286 : : !! mtag= message tag
287 : : !! nt= vector length
288 : : !! vsend= send buffer
289 : : !! sender= node sending the data
290 : : !! recever= node receiving the data
291 : : !! comm= MPI communicator
292 : : !!
293 : : !! OUTPUT
294 : : !! ier= exit status, a non-zero value meaning there is an error
295 : : !!
296 : : !! SIDE EFFECTS
297 : : !! vrecv= receive buffer
298 : : !!
299 : : !! SOURCE
300 : :
301 [ - + - + ]: 380 : subroutine xmpi_exch_dp3d(vsend,nt,sender,vrecv,recever,comm,mtag,ier)
302 : :
303 : : !Arguments----------------
304 : : integer,intent(in) :: mtag,nt
305 : : real(dp), DEV_CONTARRD intent(in) :: vsend(:,:,:)
306 : : real(dp), DEV_CONTARRD intent(inout) :: vrecv(:,:,:)
307 : : integer,intent(in) :: sender,recever,comm
308 : : integer,intent(out) :: ier
309 : :
310 : : !Local variables--------------
311 : : #if defined HAVE_MPI
312 : : integer :: statux(MPI_STATUS_SIZE)
313 : : integer :: me,my_dt,my_op,tag
314 : : integer(kind=int64) :: ntot
315 : : #endif
316 : :
317 : : ! *************************************************************************
318 : :
319 : 380 : ier=0
320 : : #if defined HAVE_MPI
321 [ + + + - : 380 : if (sender==recever.or.comm==MPI_COMM_NULL.or.nt==0) return
- + ]
322 : 320 : call MPI_COMM_RANK(comm,me,ier)
323 : 320 : tag = MOD(mtag, xmpi_tag_ub)
324 : :
325 : : !The dimension can be greater than a 32bit integer
326 : : !We use a INT64 to store it. If it is too large, we switch to an
327 : : !alternate routine because MPI<4 doesnt handle 64 bit counts.
328 : 320 : ntot=int(nt,kind=int64)
329 : :
330 [ + + ]: 320 : if (recever==me) then
331 : : if (ntot<=xmpi_maxint32_64) then
332 [ - + ]: 160 : call MPI_RECV(vrecv,nt,MPI_DOUBLE_PRECISION,sender,tag,comm,statux,ier)
333 : : else
334 : : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
335 : : call MPI_RECV(vrecv,1,my_dt,sender,tag,comm,statux,ier)
336 : : call xmpi_largetype_free(my_dt,my_op)
337 : : end if
338 : : end if
339 [ + + ]: 320 : if (sender==me) then
340 : : if (ntot<=xmpi_maxint32_64) then
341 [ - + ]: 160 : call MPI_SEND(vsend,nt,MPI_DOUBLE_PRECISION,recever,tag,comm,ier)
342 : : else
343 : : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
344 : : call MPI_SEND(vsend,1,my_dt,recever,tag,comm,ier)
345 : : call xmpi_largetype_free(my_dt,my_op)
346 : : end if
347 : : end if
348 : : #endif
349 : :
350 : : end subroutine xmpi_exch_dp3d
351 : : !!***
352 : :
353 : : !--------------------------------------------------------------------
354 : :
355 : : !!****f* ABINIT/xmpi_exch_dp4d_tag
356 : : !! NAME
357 : : !! xmpi_exch_dp4d_tag
358 : : !!
359 : : !! FUNCTION
360 : : !! Sends and receives data.
361 : : !! Target: double precision four-dimensional arrays.
362 : : !!
363 : : !! INPUTS
364 : : !! mtag= message tag
365 : : !! nt= vector length
366 : : !! vsend= send buffer
367 : : !! sender= node sending the data
368 : : !! recever= node receiving the data
369 : : !! comm= MPI communicator
370 : : !!
371 : : !! OUTPUT
372 : : !! ier= exit status, a non-zero value meaning there is an error
373 : : !!
374 : : !! SIDE EFFECTS
375 : : !! vrecv= receive buffer
376 : : !!
377 : : !! SOURCE
378 : :
379 [ # # # # ]: 0 : subroutine xmpi_exch_dp4d(vsend,nt,sender,vrecv,recever,comm,mtag,ier)
380 : :
381 : : !Arguments----------------
382 : : integer,intent(in) :: mtag,nt
383 : : real(dp), DEV_CONTARRD intent(in) :: vsend(:,:,:,:)
384 : : real(dp), DEV_CONTARRD intent(inout) :: vrecv(:,:,:,:)
385 : : integer,intent(in) :: sender,recever,comm
386 : : integer,intent(out) :: ier
387 : :
388 : : !Local variables--------------
389 : : #if defined HAVE_MPI
390 : : integer :: statux(MPI_STATUS_SIZE)
391 : : integer :: me,my_dt,my_op,tag
392 : : integer(kind=int64) :: ntot
393 : : #endif
394 : :
395 : : ! *************************************************************************
396 : :
397 : 0 : ier=0
398 : : #if defined HAVE_MPI
399 [ # # # # : 0 : if (sender==recever.or.comm==MPI_COMM_NULL.or.nt==0) return
# # ]
400 : 0 : call MPI_COMM_RANK(comm,me,ier)
401 : 0 : tag = MOD(mtag, xmpi_tag_ub)
402 : :
403 : : !The dimension can be greater than a 32bit integer
404 : : !We use a INT64 to store it. If it is too large, we switch to an
405 : : !alternate routine because MPI<4 doesnt handle 64 bit counts.
406 : 0 : ntot=int(nt,kind=int64)
407 : :
408 [ # # ]: 0 : if (recever==me) then
409 : : if (ntot<=xmpi_maxint32_64) then
410 [ # # ]: 0 : call MPI_RECV(vrecv,nt,MPI_DOUBLE_PRECISION,sender,tag,comm,statux,ier)
411 : : else
412 : : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
413 : : call MPI_RECV(vrecv,1,my_dt,sender,tag,comm,statux,ier)
414 : : call xmpi_largetype_free(my_dt,my_op)
415 : : end if
416 : : end if
417 [ # # ]: 0 : if (sender==me) then
418 : : if (ntot<=xmpi_maxint32_64) then
419 [ # # ]: 0 : call MPI_SEND(vsend,nt,MPI_DOUBLE_PRECISION,recever,tag,comm,ier)
420 : : else
421 : : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
422 : : call MPI_SEND(vsend,1,my_dt,recever,tag,comm,ier)
423 : : call xmpi_largetype_free(my_dt,my_op)
424 : : end if
425 : : end if
426 : : #endif
427 : :
428 : : end subroutine xmpi_exch_dp4d
429 : : !!***
430 : :
431 : : !--------------------------------------------------------------------
432 : :
433 : : !!****f* ABINIT/xmpi_exch_dp5d_tag
434 : : !! NAME
435 : : !! xmpi_exch_dp5d_tag
436 : : !!
437 : : !! FUNCTION
438 : : !! Sends and receives data.
439 : : !! Target: double precision five-dimensional arrays.
440 : : !!
441 : : !! INPUTS
442 : : !! mtag= message tag
443 : : !! nt= vector length
444 : : !! vsend= send buffer
445 : : !! sender= node sending the data
446 : : !! recever= node receiving the data
447 : : !! comm= MPI communicator
448 : : !!
449 : : !! OUTPUT
450 : : !! ier= exit status, a non-zero value meaning there is an error
451 : : !!
452 : : !! SIDE EFFECTS
453 : : !! vrecv= receive buffer
454 : : !!
455 : : !! SOURCE
456 : :
457 [ # # # # ]: 0 : subroutine xmpi_exch_dp5d(vsend,nt,sender,vrecv,recever,comm,mtag,ier)
458 : :
459 : : !Arguments----------------
460 : : integer,intent(in) :: mtag,nt
461 : : real(dp), DEV_CONTARRD intent(in) :: vsend(:,:,:,:,:)
462 : : real(dp), DEV_CONTARRD intent(inout) :: vrecv(:,:,:,:,:)
463 : : integer,intent(in) :: sender,recever,comm
464 : : integer,intent(out) :: ier
465 : :
466 : : !Local variables--------------
467 : : #if defined HAVE_MPI
468 : : integer :: statux(MPI_STATUS_SIZE)
469 : : integer :: me,my_dt,my_op,tag
470 : : integer(kind=int64) :: ntot
471 : : #endif
472 : :
473 : : ! *************************************************************************
474 : :
475 : 0 : ier=0
476 : : #if defined HAVE_MPI
477 [ # # # # : 0 : if (sender==recever.or.comm==MPI_COMM_NULL.or.nt==0) return
# # ]
478 : 0 : call MPI_COMM_RANK(comm,me,ier)
479 : 0 : tag = MOD(mtag,xmpi_tag_ub)
480 : :
481 : : !The dimension can be greater than a 32bit integer
482 : : !We use a INT64 to store it. If it is too large, we switch to an
483 : : !alternate routine because MPI<4 doesnt handle 64 bit counts.
484 : 0 : ntot=int(nt,kind=int64)
485 : :
486 [ # # ]: 0 : if (recever==me) then
487 : : if (ntot<=xmpi_maxint32_64) then
488 [ # # ]: 0 : call MPI_RECV(vrecv,nt,MPI_DOUBLE_PRECISION,sender,tag,comm,statux,ier)
489 : : else
490 : : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
491 : : call MPI_RECV(vrecv,1,my_dt,sender,tag,comm,statux,ier)
492 : : call xmpi_largetype_free(my_dt,my_op)
493 : : end if
494 : : end if
495 [ # # ]: 0 : if (sender==me) then
496 : : if (ntot<=xmpi_maxint32_64) then
497 [ # # ]: 0 : call MPI_SEND(vsend,nt,MPI_DOUBLE_PRECISION,recever,tag,comm,ier)
498 : : else
499 : : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
500 : : call MPI_SEND(vsend,1,my_dt,recever,tag,comm,ier)
501 : : call xmpi_largetype_free(my_dt,my_op)
502 : : end if
503 : : end if
504 : : #endif
505 : :
506 : : end subroutine xmpi_exch_dp5d
507 : : !!***
508 : :
509 : : !--------------------------------------------------------------------
510 : :
511 : : !!****f* ABINIT/xmpi_exch_spc1d
512 : : !! NAME
513 : : !! xmpi_exch_spc1d
514 : : !!
515 : : !! FUNCTION
516 : : !! Sends and receives data.
517 : : !! Target: one-dimensional single precision complex arrays.
518 : : !!
519 : : !! SOURCE
520 : :
521 [ # # # # ]: 0 : subroutine xmpi_exch_spc1d(vsend,n1,sender,vrecv,recever,comm,mtag,ier)
522 : :
523 : : !Arguments----------------
524 : : integer,intent(in) :: mtag,n1
525 : : complex(sp), DEV_CONTARRD intent(in) :: vsend(:)
526 : : complex(sp), DEV_CONTARRD intent(inout) :: vrecv(:)
527 : : integer,intent(in) :: sender,recever,comm
528 : : integer,intent(out) :: ier
529 : :
530 : : !Local variables--------------
531 : : #if defined HAVE_MPI
532 : : integer :: statux(MPI_STATUS_SIZE)
533 : : integer :: tag,me
534 : : #endif
535 : :
536 : : ! *************************************************************************
537 : :
538 : 0 : ier=0
539 : : #if defined HAVE_MPI
540 [ # # # # : 0 : if (sender==recever.or.comm==MPI_COMM_NULL.or.(n1==0)) return
# # ]
541 : 0 : call MPI_COMM_RANK(comm,me,ier)
542 : 0 : tag = MOD(mtag, xmpi_tag_ub)
543 : :
544 [ # # ]: 0 : if (recever==me) then
545 [ # # ]: 0 : call MPI_RECV(vrecv,n1,MPI_COMPLEX,sender, tag,comm,statux,ier)
546 : : end if
547 [ # # ]: 0 : if (sender==me) then
548 [ # # ]: 0 : call MPI_SEND(vsend,n1,MPI_COMPLEX,recever,tag,comm,ier)
549 : : end if
550 : : #endif
551 : :
552 : : end subroutine xmpi_exch_spc1d
553 : : !!***
554 : :
555 : : !--------------------------------------------------------------------
556 : :
557 : : !!****f* ABINIT/xmpi_exch_dpc1d
558 : : !! NAME
559 : : !! xmpi_exch_dpc1d
560 : : !!
561 : : !! FUNCTION
562 : : !! Sends and receives data.
563 : : !! Target: one-dimensional double precision complex arrays.
564 : : !!
565 : : !! SOURCE
566 : :
567 [ - + - + ]: 8 : subroutine xmpi_exch_dpc1d(vsend,n1,sender,vrecv,recever,comm,mtag,ier)
568 : :
569 : : !Arguments----------------
570 : : integer,intent(in) :: mtag,n1
571 : : complex(dp), DEV_CONTARRD intent(in) :: vsend(:)
572 : : complex(dp), DEV_CONTARRD intent(inout) :: vrecv(:)
573 : : integer,intent(in) :: sender,recever,comm
574 : : integer,intent(out) :: ier
575 : :
576 : : !Local variables--------------
577 : : #if defined HAVE_MPI
578 : : integer :: statux(MPI_STATUS_SIZE)
579 : : integer :: tag,me
580 : : #endif
581 : :
582 : : ! *************************************************************************
583 : :
584 : 8 : ier=0
585 : : #if defined HAVE_MPI
586 [ + - + - : 8 : if (sender==recever.or.comm==MPI_COMM_NULL.or.n1==0) return
- + ]
587 : 8 : call MPI_COMM_RANK(comm,me,ier)
588 : 8 : tag = MOD(mtag, xmpi_tag_ub)
589 : :
590 [ + + ]: 8 : if (recever==me) then
591 [ - + ]: 4 : call MPI_RECV(vrecv,n1,MPI_DOUBLE_COMPLEX,sender, tag,comm,statux,ier)
592 : : end if
593 [ + + ]: 8 : if (sender==me) then
594 [ - + ]: 4 : call MPI_SEND(vsend,n1,MPI_DOUBLE_COMPLEX,recever,tag,comm,ier)
595 : : end if
596 : : #endif
597 : :
598 : : end subroutine xmpi_exch_dpc1d
599 : : !!***
600 : :
601 : : !--------------------------------------------------------------------
602 : :
603 : : !!****f* ABINIT/xmpi_exch_dpc2d
604 : : !! NAME
605 : : !! xmpi_exch_dpc2d
606 : : !!
607 : : !! FUNCTION
608 : : !! Sends and receives data.
609 : : !! Target: two-dimensional double precision complex arrays.
610 : : !!
611 : : !! SOURCE
612 : :
613 [ # # # # ]: 0 : subroutine xmpi_exch_dpc2d(vsend,nt,sender,vrecv,recever,comm,mtag,ier)
614 : :
615 : : !Arguments----------------
616 : : integer,intent(in) :: mtag,nt
617 : : complex(dp), DEV_CONTARRD intent(in) :: vsend(:,:)
618 : : complex(dp), DEV_CONTARRD intent(inout) :: vrecv(:,:)
619 : : integer,intent(in) :: sender,recever,comm
620 : : integer,intent(out) :: ier
621 : :
622 : : !Local variables--------------
623 : : #if defined HAVE_MPI
624 : : integer :: statux(MPI_STATUS_SIZE)
625 : : integer :: tag,me
626 : : #endif
627 : : ! *************************************************************************
628 : :
629 : 0 : ier=0
630 : : #if defined HAVE_MPI
631 [ # # # # : 0 : if (sender==recever.or.comm==MPI_COMM_NULL.or.(nt==0)) return
# # ]
632 : 0 : call MPI_COMM_RANK(comm,me,ier)
633 : 0 : tag = MOD(mtag, xmpi_tag_ub)
634 : :
635 [ # # ]: 0 : if (recever==me) then
636 [ # # ]: 0 : call MPI_RECV(vrecv,nt,MPI_DOUBLE_COMPLEX,sender, tag,comm,statux,ier)
637 : : end if
638 [ # # ]: 0 : if (sender==me) then
639 [ # # ]: 0 : call MPI_SEND(vsend,nt,MPI_DOUBLE_COMPLEX,recever,tag,comm,ier)
640 : : end if
641 : : #endif
642 : :
643 : : end subroutine xmpi_exch_dpc2d
644 : : !!***
|
