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