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 one-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), optional :: 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 : logical :: l_use_omp_map
282 : integer(kind=int64) :: ntot
283 : #endif
284 :
285 : ! *************************************************************************
286 :
287 0 : ierr=0
288 : #if defined HAVE_MPI
289 0 : l_use_omp_map=.false.
290 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
291 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
292 0 : l_use_omp_map=.false.
293 0 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
294 0 : n1=size(xval,dim=1)
295 0 : n2=size(xval,dim=2)
296 0 : n3=size(xval,dim=3)
297 0 : my_tag=MOD(tag,xmpi_tag_ub)
298 :
299 : !This product of dimensions can be greater than a 32bit integer
300 : !We use a INT64 to store it. If it is too large, we switch to an
301 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
302 0 : ntot=int(n1,kind=int64)*n2*n3
303 :
304 0 : if (ntot<=xmpi_maxint32_64) then
305 0 : if(.not. l_use_omp_map) then
306 0 : call MPI_IRECV(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,source,my_tag,comm,request,ierr)
307 : else
308 : #ifdef HAVE_OPENMP_OFFLOAD
309 : #ifdef HAVE_GPU_MPI
310 : ! Proper GPU-aware call
311 : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
312 : call MPI_IRECV(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,source,my_tag,comm,request,ierr)
313 : !$OMP END TARGET DATA
314 : #else
315 : call MPI_IRECV(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,source,my_tag,comm,request,ierr)
316 : #endif
317 : #endif
318 : end if ! l_use_omp_map
319 : else
320 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
321 0 : if(.not. l_use_omp_map) then
322 0 : call MPI_IRECV(xval,1,my_dt,source,my_tag,comm,request,ierr)
323 : else
324 : #ifdef HAVE_OPENMP_OFFLOAD
325 : #ifdef HAVE_GPU_MPI
326 : ! Proper GPU-aware call
327 : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
328 : call MPI_IRECV(xval,1,my_dt,source,my_tag,comm,request,ierr)
329 : !$OMP END TARGET DATA
330 : #else
331 : call MPI_IRECV(xval,1,my_dt,source,my_tag,comm,request,ierr)
332 : #endif
333 : #endif
334 : end if ! l_use_omp_map
335 0 : call xmpi_largetype_free(my_dt,my_op)
336 : end if
337 :
338 0 : xmpi_count_requests = xmpi_count_requests + 1
339 : end if
340 : #endif
341 :
342 0 : end subroutine xmpi_irecv_dp3d
343 : !!***
344 :
|
