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