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