Branch data Line data Source code
1 : : !{\src2tex{textfont=tt}}
2 : : !!****f* ABINIT/xmpi_isend
3 : : !! NAME
4 : : !! xmpi_isend
5 : : !!
6 : : !! FUNCTION
7 : : !! This module contains functions that calls MPI routine MPI_ISEND,
8 : : !! to send data from one processor to another,
9 : : !! if we compile the code using the MPI CPP flags.
10 : : !! xmpi_isend 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_isend_int1d
24 : : !! NAME
25 : : !! xmpi_isend_int1d
26 : : !!
27 : : !! FUNCTION
28 : : !! Sends data from one processor to another.
29 : : !! Target: integer one-dimensional arrays.
30 : : !!
31 : : !! INPUTS
32 : : !! dest :: rank of destination 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 : : !! SOURCE
43 : :
44 [ - + ]: 64 : subroutine xmpi_isend_int1d(xval,dest,tag,comm,request,ierr)
45 : :
46 : : !Arguments-------------------------
47 : : integer ABI_ASYNC, intent(inout) :: xval(:)
48 : : integer, intent(in) :: dest,tag,comm
49 : : integer, intent(out) :: ierr
50 : : integer, intent(out) :: request
51 : :
52 : : !Local variables-------------------
53 : : #if defined HAVE_MPI
54 : : integer :: ier,my_tag,n1
55 : : #endif
56 : :
57 : : ! *************************************************************************
58 : :
59 : 64 : ierr=0
60 : : #if defined HAVE_MPI
61 [ + - ]: 64 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
62 : 64 : n1=size(xval,dim=1)
63 : 64 : my_tag = MOD(tag,xmpi_tag_ub)
64 [ - + ]: 64 : call MPI_ISEND(xval,n1,MPI_INTEGER,dest,my_tag,comm,request,ier)
65 : 64 : xmpi_count_requests = xmpi_count_requests + 1
66 : 64 : ierr=ier
67 : : end if
68 : : #endif
69 : :
70 : 64 : end subroutine xmpi_isend_int1d
71 : : !!***
72 : :
73 : : !!****f* ABINIT/xmpi_isend_dp1d
74 : : !! NAME
75 : : !! xmpi_isend_dp1d
76 : : !!
77 : : !! FUNCTION
78 : : !! Sends data from one proc to another.
79 : : !! Target: double precision two-dimensional arrays.
80 : : !!
81 : : !! INPUTS
82 : : !! dest :: rank of destination process
83 : : !! tag :: integer message tag
84 : : !! comm :: MPI communicator
85 : : !!
86 : : !! OUTPUT
87 : : !! ierr= exit status, a non-zero value meaning there is an error
88 : : !!
89 : : !! SIDE EFFECTS
90 : : !! xval= buffer array
91 : : !!
92 : : !! SOURCE
93 : :
94 [ - + ]: 32 : subroutine xmpi_isend_dp1d(xval,dest,tag,comm,request,ierr)
95 : :
96 : : !Arguments-------------------------
97 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:)
98 : : integer, intent(in) :: dest,tag,comm
99 : : integer, intent(out) :: ierr
100 : : integer, intent(out) :: request
101 : :
102 : : !Local variables-------------------
103 : : #if defined HAVE_MPI
104 : : integer :: ier,my_tag,n1
105 : : #endif
106 : :
107 : : ! *************************************************************************
108 : :
109 : 32 : ierr=0
110 : : #if defined HAVE_MPI
111 [ + - ]: 32 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
112 : 32 : n1=size(xval)
113 : 32 : my_tag = MOD(tag,xmpi_tag_ub)
114 [ - + ]: 32 : call MPI_ISEND(xval,n1,MPI_DOUBLE_PRECISION,dest,my_tag,comm,request,ier)
115 : 32 : xmpi_count_requests = xmpi_count_requests + 1
116 : 32 : ierr=ier
117 : : end if
118 : : #endif
119 : :
120 : 32 : end subroutine xmpi_isend_dp1d
121 : : !!***
122 : :
123 : : !!****f* ABINIT/xmpi_isend_dp2d
124 : : !! NAME
125 : : !! xmpi_isend_dp2d
126 : : !!
127 : : !! FUNCTION
128 : : !! Sends data from one proc to another.
129 : : !! Target: double precision two-dimensional arrays.
130 : : !!
131 : : !! INPUTS
132 : : !! dest :: rank of destination process
133 : : !! tag :: integer message tag
134 : : !! comm :: MPI communicator
135 : : !!
136 : : !! OUTPUT
137 : : !! ierr= exit status, a non-zero value meaning there is an error
138 : : !!
139 : : !! SIDE EFFECTS
140 : : !! xval= buffer array
141 : : !!
142 : : !! SOURCE
143 : :
144 [ - + ]: 1567897 : subroutine xmpi_isend_dp2d(xval,dest,tag,comm,request,ierr)
145 : :
146 : : !Arguments-------------------------
147 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:,:)
148 : : integer, intent(in) :: dest,tag,comm
149 : : integer, intent(out) :: ierr
150 : : integer, intent(out) :: request
151 : :
152 : : !Local variables-------------------
153 : : #if defined HAVE_MPI
154 : : integer :: ier,my_dt,my_op,my_tag,n1,n2
155 : : integer(kind=int64) :: ntot
156 : : #endif
157 : :
158 : : ! *************************************************************************
159 : :
160 : 1567897 : ierr=0
161 : : #if defined HAVE_MPI
162 [ + - ]: 1567897 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
163 : 1567897 : n1=size(xval,dim=1)
164 : 1567897 : n2=size(xval,dim=2)
165 : 1567897 : my_tag = MOD(tag,xmpi_tag_ub)
166 : :
167 : : !This product of dimensions can be greater than a 32bit integer
168 : : !We use a INT64 to store it. If it is too large, we switch to an
169 : : !alternate routine because MPI<4 doesnt handle 64 bit counts.
170 : 1567897 : ntot=int(n1,kind=int64)*n2
171 : :
172 [ + - ]: 1567897 : if (ntot<=xmpi_maxint32_64) then
173 [ - + ]: 1567897 : call MPI_ISEND(xval,n1*n2,MPI_DOUBLE_PRECISION,dest,my_tag,comm,request,ier)
174 : : else
175 : 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
176 [ # # ]: 0 : call MPI_ISEND(xval,1,my_dt,dest,my_tag,comm,request,ier)
177 : 0 : call xmpi_largetype_free(my_dt,my_op)
178 : : end if
179 : :
180 : 1567897 : xmpi_count_requests = xmpi_count_requests + 1
181 : 1567897 : ierr=ier
182 : : end if
183 : : #endif
184 : :
185 : 1567897 : end subroutine xmpi_isend_dp2d
186 : : !!***
187 : :
188 : : !!****f* ABINIT/xmpi_isend_dp3d
189 : : !! NAME
190 : : !! xmpi_isend_dp3d
191 : : !!
192 : : !! FUNCTION
193 : : !! Sends data from one proc to another.
194 : : !! Target: double precision three-dimensional arrays.
195 : : !!
196 : : !! INPUTS
197 : : !! dest :: rank of destination process
198 : : !! tag :: integer message tag
199 : : !! comm :: MPI communicator
200 : : !!
201 : : !! OUTPUT
202 : : !! ierr= exit status, a non-zero value meaning there is an error
203 : : !!
204 : : !! SIDE EFFECTS
205 : : !! xval= buffer array
206 : : !!
207 : : !! SOURCE
208 : :
209 [ # # ]: 0 : subroutine xmpi_isend_dp3d(xval,dest,tag,comm,request,ierr,use_omp_map)
210 : :
211 : : !Arguments-------------------------
212 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:,:,:)
213 : : integer, intent(in) :: dest,tag,comm
214 : : logical ,intent(in) :: use_omp_map
215 : : integer, intent(out) :: ierr
216 : : integer, intent(out) :: request
217 : :
218 : : !Local variables-------------------
219 : : #if defined HAVE_MPI
220 : : integer :: ier,my_dt,my_op,my_tag,n1,n2,n3
221 : : integer(kind=int64) :: ntot
222 : : #endif
223 : :
224 : : ! *************************************************************************
225 : :
226 : 0 : ierr=0
227 : : #if defined HAVE_MPI
228 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
229 : 0 : n1=size(xval,dim=1)
230 : 0 : n2=size(xval,dim=2)
231 : 0 : n3=size(xval,dim=3)
232 : 0 : my_tag = MOD(tag,xmpi_tag_ub)
233 : :
234 : : !This product of dimensions can be greater than a 32bit integer
235 : : !We use a INT64 to store it. If it is too large, we switch to an
236 : : !alternate routine because MPI<4 doesnt handle 64 bit counts.
237 : 0 : ntot=int(n1,kind=int64)*n2*n3
238 : :
239 [ # # ]: 0 : if (ntot<=xmpi_maxint32_64) then
240 [ # # ]: 0 : if(.not. use_omp_map) then
241 [ # # ]: 0 : call MPI_ISEND(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,dest,my_tag,comm,request,ier)
242 : : else
243 : : #ifdef HAVE_OPENMP_OFFLOAD
244 : : #ifdef HAVE_GPU_MPI
245 : : ! Proper GPU-aware call
246 : : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
247 : : call MPI_ISEND(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,dest,my_tag,comm,request,ier)
248 : : !$OMP END TARGET DATA
249 : : #else
250 : : !$OMP TARGET UPDATE FROM(xval)
251 : : call MPI_ISEND(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,dest,my_tag,comm,request,ier)
252 : : #endif
253 : : #endif
254 : : end if ! use_omp_map
255 : : else
256 : 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
257 [ # # ]: 0 : if(.not. use_omp_map) then
258 [ # # ]: 0 : call MPI_ISEND(xval,1,my_dt,dest,my_tag,comm,request,ier)
259 : : else
260 : : #ifdef HAVE_OPENMP_OFFLOAD
261 : : #ifdef HAVE_GPU_MPI
262 : : ! Proper GPU-aware call
263 : : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
264 : : call MPI_ISEND(xval,1,my_dt,dest,my_tag,comm,request,ier)
265 : : !$OMP END TARGET DATA
266 : : #else
267 : : !$OMP TARGET UPDATE FROM(xval)
268 : : call MPI_ISEND(xval,1,my_dt,dest,my_tag,comm,request,ier)
269 : : #endif
270 : : #endif
271 : : end if ! use_omp_map
272 : 0 : call xmpi_largetype_free(my_dt,my_op)
273 : : end if
274 : :
275 : 0 : xmpi_count_requests = xmpi_count_requests + 1
276 : 0 : ierr=ier
277 : : end if
278 : : #endif
279 : :
280 : 0 : end subroutine xmpi_isend_dp3d
281 : : !!***
282 : :
283 : :
284 : : !!****f* ABINIT/xmpi_isend_dp3d_cpu_only
285 : : !! NAME
286 : : !! xmpi_isend_dp3d_cpu_only
287 : : !!
288 : : !! FUNCTION
289 : : !! Sends data from one proc to another.
290 : : !! Target: double precision three-dimensional arrays.
291 : : !!
292 : : !! Exclusive to CPU, previous implementation used a single routine
293 : : !! for CPU and GPU with an optional... but it caused issues with a
294 : : !! compiler (NVHPC), so we have a second wrapper routine to adress
295 : : !! regular calls that always receive CPU buffers that calls the GPU/CPU routine.
296 : : !!
297 : : !! INPUTS
298 : : !! dest :: rank of destination process
299 : : !! tag :: integer message tag
300 : : !! comm :: MPI communicator
301 : : !!
302 : : !! OUTPUT
303 : : !! ierr= exit status, a non-zero value meaning there is an error
304 : : !!
305 : : !! SIDE EFFECTS
306 : : !! xval= buffer array
307 : : !!
308 : : !! SOURCE
309 : :
310 [ # # ]: 0 : subroutine xmpi_isend_dp3d_cpu_only(xval,dest,tag,comm,request,ierr)
311 : :
312 : : !Arguments-------------------------
313 : : real(dp) ABI_ASYNC, intent(inout) :: xval(:,:,:)
314 : : integer, intent(in) :: dest,tag,comm
315 : : integer, intent(out) :: ierr
316 : : integer, intent(out) :: request
317 : :
318 : : ! *************************************************************************
319 : :
320 : 0 : call xmpi_isend_dp3d(xval,dest,tag,comm,request,ierr,.false.)
321 : :
322 : 0 : end subroutine xmpi_isend_dp3d_cpu_only
323 : : !!***
|
