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