Branch data Line data Source code
1 : : !{\src2tex{textfont=tt}}
2 : : !!****f* ABINIT/xmpi_irecv
3 : : !! NAME
4 : : !! xmpi_irecv
5 : : !!
6 : : !! FUNCTION
7 : : !! This module contains functions that call MPI routine MPI_IRECV,
8 : : !! to receive data on one processor sent by another,
9 : : !! if we compile the code using the MPI CPP flags.
10 : : !! xmpi_irecv 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_irecv_intv
24 : : !! NAME
25 : : !! xmpi_irecv_intv
26 : : !!
27 : : !! FUNCTION
28 : : !! Receives data from one processor sent by another.
29 : : !! Target: single integer.
30 : : !!
31 : : !! INPUTS
32 : : !! source :: rank of source process
33 : : !! tag :: integer message tag
34 : : !! comm :: MPI communicator
35 : : !!
36 : : !! OUTPUT
37 : : !! ierr= 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_IRECV is explicitly ignored
44 : : !!
45 : : !! SOURCE
46 : :
47 : 0 : subroutine xmpi_irecv_intv(xval,source,tag,comm,request,ierr)
48 : :
49 : : !Arguments-------------------------
50 : : integer ABI_ASYNC, intent(inout), target :: xval
51 : : integer,intent(in) :: source,tag,comm
52 : : integer,intent(out) :: ierr
53 : : integer, intent(out) :: request
54 : :
55 : : !Local variables-------------------
56 : : #if defined HAVE_MPI
57 : : integer :: my_tag
58 : 0 : integer, pointer :: arr_xval(:)
59 : : type(c_ptr) :: cptr
60 : : #endif
61 : :
62 : : ! *************************************************************************
63 : :
64 : 0 : ierr=0
65 : : #if defined HAVE_MPI
66 : 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
67 : 0 : my_tag=MOD(tag,xmpi_tag_ub)
68 [ # # ]: 0 : cptr=c_loc(xval) ; call c_f_pointer(cptr,arr_xval,[1])
69 [ # # ]: 0 : call MPI_IRECV(arr_xval,1,MPI_INTEGER,source,my_tag,comm,request,ierr)
70 : 0 : xmpi_count_requests = xmpi_count_requests + 1
71 : : end if
72 : : #endif
73 : :
74 [ # # ]: 0 : end subroutine xmpi_irecv_intv
75 : : !!***
76 : :
77 : : !!****f* ABINIT/xmpi_irecv_int1d
78 : : !! NAME
79 : : !! xmpi_irecv_int1d
80 : : !!
81 : : !! FUNCTION
82 : : !! Sends data from one processor to another.
83 : : !! Target: integer one-dimensional arrays.
84 : : !!
85 : : !! INPUTS
86 : : !! dest :: rank of destination process
87 : : !! tag :: integer message tag
88 : : !! comm :: MPI communicator
89 : : !!
90 : : !! OUTPUT
91 : : !! ierr= exit status, a non-zero value meaning there is an error
92 : : !!
93 : : !! SIDE EFFECTS
94 : : !! xval= buffer array
95 : : !!
96 : : !! SOURCE
97 : :
98 [ - + ]: 64 : subroutine xmpi_irecv_int1d(xval,source,tag,comm,request,ierr)
99 : :
100 : : !Arguments-------------------------
101 : : integer ABI_ASYNC, intent(inout) :: xval(:)
102 : : integer,intent(in) :: source,tag,comm
103 : : integer, intent(out) :: request
104 : : integer,intent(out) :: ierr
105 : : !Local variables-------------------
106 : :
107 : : #if defined HAVE_MPI
108 : : integer :: n1,my_tag
109 : : #endif
110 : :
111 : : ! *************************************************************************
112 : :
113 : 64 : ierr=0
114 : : #if defined HAVE_MPI
115 [ + - ]: 64 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
116 : 64 : my_tag=MOD(tag,xmpi_tag_ub)
117 : 64 : n1=size(xval)
118 [ - + ]: 64 : call MPI_IRECV(xval,n1,MPI_INTEGER,source,my_tag,comm,request,ierr)
119 : 64 : xmpi_count_requests = xmpi_count_requests + 1
120 : : end if
121 : : #endif
122 : :
123 : 64 : end subroutine xmpi_irecv_int1d
124 : : !!***
125 : :
126 : : !!****f* ABINIT/xmpi_irecv_dp1d
127 : : !! NAME
128 : : !! xmpi_irecv_dp1d
129 : : !!
130 : : !! FUNCTION
131 : : !! Receives data from one proc sent by another.
132 : : !! Target: double precision 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 : : !! ierr= 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_IRECV is explicitly ignored
147 : : !!
148 : : !! SOURCE
149 : :
150 [ - + ]: 32 : subroutine xmpi_irecv_dp1d(xval,source,tag,comm,request,ierr)
151 : :
152 : : !Arguments-------------------------
153 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:)
154 : : integer, intent(in) :: source,tag,comm
155 : : integer, intent(out) :: ierr
156 : : integer, intent(out) :: request
157 : :
158 : : !Local variables-------------------
159 : : #if defined HAVE_MPI
160 : : integer :: my_tag,n1
161 : : #endif
162 : :
163 : : ! *************************************************************************
164 : :
165 : 32 : ierr=0
166 : : #if defined HAVE_MPI
167 [ + - ]: 32 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
168 : 32 : n1=size(xval,dim=1)
169 : 32 : my_tag=MOD(tag,xmpi_tag_ub)
170 [ - + ]: 32 : call MPI_IRECV(xval,n1,MPI_DOUBLE_PRECISION,source,my_tag,comm,request,ierr)
171 : 32 : xmpi_count_requests = xmpi_count_requests + 1
172 : : end if
173 : : #endif
174 : :
175 : 32 : end subroutine xmpi_irecv_dp1d
176 : : !!***
177 : :
178 : : !!****f* ABINIT/xmpi_irecv_dp2d
179 : : !! NAME
180 : : !! xmpi_irecv_dp2d
181 : : !!
182 : : !! FUNCTION
183 : : !! Receives data from one proc sent by another.
184 : : !! Target: double precision one-dimensional arrays.
185 : : !!
186 : : !! INPUTS
187 : : !! source :: rank of source process
188 : : !! tag :: integer message tag
189 : : !! comm :: MPI communicator
190 : : !!
191 : : !! OUTPUT
192 : : !! ierr= exit status, a non-zero value meaning there is an error
193 : : !!
194 : : !! SIDE EFFECTS
195 : : !! xval= buffer array
196 : : !!
197 : : !! NOTES
198 : : !! status of MPI_IRECV is explicitly ignored
199 : : !!
200 : : !! SOURCE
201 : :
202 [ - + ]: 259 : subroutine xmpi_irecv_dp2d(xval,source,tag,comm,request,ierr)
203 : :
204 : : !Arguments-------------------------
205 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:,:)
206 : : integer, intent(in) :: source,tag,comm
207 : : integer, intent(out) :: ierr
208 : : integer, intent(out) :: request
209 : :
210 : : !Local variables-------------------
211 : : #if defined HAVE_MPI
212 : : integer :: my_dt,my_op,my_tag,n1,n2
213 : : integer(kind=int64) :: ntot
214 : : #endif
215 : :
216 : : ! *************************************************************************
217 : :
218 : 259 : ierr=0
219 : : #if defined HAVE_MPI
220 [ + - ]: 259 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
221 : 259 : n1=size(xval,dim=1)
222 : 259 : n2=size(xval,dim=2)
223 : 259 : my_tag=MOD(tag,xmpi_tag_ub)
224 : :
225 : : !This product of dimensions can be greater than a 32bit integer
226 : : !We use a INT64 to store it. If it is too large, we switch to an
227 : : !alternate routine because MPI<4 doesnt handle 64 bit counts.
228 : 259 : ntot=int(n1,kind=int64)*n2
229 : :
230 [ + - ]: 259 : if (ntot<=xmpi_maxint32_64) then
231 [ - + ]: 259 : call MPI_IRECV(xval,n1*n2,MPI_DOUBLE_PRECISION,source,my_tag,comm,request,ierr)
232 : : else
233 : 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
234 [ # # ]: 0 : call MPI_IRECV(xval,1,my_dt,source,my_tag,comm,request,ierr)
235 : 0 : call xmpi_largetype_free(my_dt,my_op)
236 : : end if
237 : :
238 : 259 : xmpi_count_requests = xmpi_count_requests + 1
239 : : end if
240 : : #endif
241 : :
242 : 259 : end subroutine xmpi_irecv_dp2d
243 : : !!***
244 : :
245 : : !!****f* ABINIT/xmpi_irecv_dp3d
246 : : !! NAME
247 : : !! xmpi_irecv_dp3d
248 : : !!
249 : : !! FUNCTION
250 : : !! Receives data from one proc sent by another.
251 : : !! Target: double precision three-dimensional arrays.
252 : : !!
253 : : !! INPUTS
254 : : !! source :: rank of source process
255 : : !! tag :: integer message tag
256 : : !! comm :: MPI communicator
257 : : !!
258 : : !! OUTPUT
259 : : !! ierr= exit status, a non-zero value meaning there is an error
260 : : !!
261 : : !! SIDE EFFECTS
262 : : !! xval= buffer array
263 : : !!
264 : : !! NOTES
265 : : !! status of MPI_IRECV is explicitly ignored
266 : : !!
267 : : !! SOURCE
268 : :
269 [ # # ]: 0 : subroutine xmpi_irecv_dp3d(xval,source,tag,comm,request,ierr,use_omp_map)
270 : :
271 : : !Arguments-------------------------
272 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:,:,:)
273 : : integer, intent(in) :: source,tag,comm
274 : : logical ,intent(in) :: use_omp_map
275 : : integer, intent(out) :: ierr
276 : : integer, intent(out) :: request
277 : :
278 : : !Local variables-------------------
279 : : #if defined HAVE_MPI
280 : : integer :: my_dt,my_op,my_tag,n1,n2,n3
281 : : integer(kind=int64) :: ntot
282 : : #endif
283 : :
284 : : ! *************************************************************************
285 : :
286 : 0 : ierr=0
287 : : #if defined HAVE_MPI
288 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
289 : 0 : n1=size(xval,dim=1)
290 : 0 : n2=size(xval,dim=2)
291 : 0 : n3=size(xval,dim=3)
292 : 0 : my_tag=MOD(tag,xmpi_tag_ub)
293 : :
294 : : !This product of dimensions can be greater than a 32bit integer
295 : : !We use a INT64 to store it. If it is too large, we switch to an
296 : : !alternate routine because MPI<4 doesnt handle 64 bit counts.
297 : 0 : ntot=int(n1,kind=int64)*n2*n3
298 : :
299 [ # # ]: 0 : if (ntot<=xmpi_maxint32_64) then
300 [ # # ]: 0 : if(.not. use_omp_map) then
301 [ # # ]: 0 : call MPI_IRECV(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,source,my_tag,comm,request,ierr)
302 : : else
303 : : #ifdef HAVE_OPENMP_OFFLOAD
304 : : #ifdef HAVE_GPU_MPI
305 : : ! Proper GPU-aware call
306 : : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
307 : : call MPI_IRECV(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,source,my_tag,comm,request,ierr)
308 : : !$OMP END TARGET DATA
309 : : #else
310 : : call MPI_IRECV(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,source,my_tag,comm,request,ierr)
311 : : #endif
312 : : #endif
313 : : end if ! use_omp_map
314 : : else
315 : 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
316 [ # # ]: 0 : if(.not. use_omp_map) then
317 [ # # ]: 0 : call MPI_IRECV(xval,1,my_dt,source,my_tag,comm,request,ierr)
318 : : else
319 : : #ifdef HAVE_OPENMP_OFFLOAD
320 : : #ifdef HAVE_GPU_MPI
321 : : ! Proper GPU-aware call
322 : : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
323 : : call MPI_IRECV(xval,1,my_dt,source,my_tag,comm,request,ierr)
324 : : !$OMP END TARGET DATA
325 : : #else
326 : : call MPI_IRECV(xval,1,my_dt,source,my_tag,comm,request,ierr)
327 : : #endif
328 : : #endif
329 : : end if ! use_omp_map
330 : 0 : call xmpi_largetype_free(my_dt,my_op)
331 : : end if
332 : :
333 : 0 : xmpi_count_requests = xmpi_count_requests + 1
334 : : end if
335 : : #endif
336 : :
337 : 0 : end subroutine xmpi_irecv_dp3d
338 : : !!***
339 : :
340 : :
341 : : !!****f* ABINIT/xmpi_irecv_dp3d_cpu_only
342 : : !! NAME
343 : : !! xmpi_irecv_dp3d_cpu_only
344 : : !!
345 : : !! FUNCTION
346 : : !! Receives data from one proc sent by another.
347 : : !! Target: double precision three-dimensional arrays.
348 : : !!
349 : : !! Exclusive to CPU, previous implementation used a single routine
350 : : !! for CPU and GPU with an optional... but it caused issues with a
351 : : !! compiler (NVHPC), so we have a second wrapper routine to adress
352 : : !! regular calls that always receive CPU buffers that calls the GPU/CPU routine.
353 : : !!
354 : : !! INPUTS
355 : : !! source :: rank of source process
356 : : !! tag :: integer message tag
357 : : !! comm :: MPI communicator
358 : : !!
359 : : !! OUTPUT
360 : : !! ierr= exit status, a non-zero value meaning there is an error
361 : : !!
362 : : !! SIDE EFFECTS
363 : : !! xval= buffer array
364 : : !!
365 : : !! NOTES
366 : : !! status of MPI_IRECV is explicitly ignored
367 : : !!
368 : : !! SOURCE
369 : :
370 [ # # ]: 0 : subroutine xmpi_irecv_dp3d_cpu_only(xval,source,tag,comm,request,ierr)
371 : :
372 : : !Arguments-------------------------
373 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:,:,:)
374 : : integer, intent(in) :: source,tag,comm
375 : : integer, intent(out) :: ierr
376 : : integer, intent(out) :: request
377 : :
378 : : ! *************************************************************************
379 : :
380 : 0 : call xmpi_irecv_dp3d(xval,source,tag,comm,request,ierr,.false.)
381 : :
382 : 0 : end subroutine xmpi_irecv_dp3d_cpu_only
383 : : !!***
|
