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