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 two-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), optional :: 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 : logical :: l_use_omp_map
222 : integer(kind=int64) :: ntot
223 : #endif
224 :
225 : ! *************************************************************************
226 :
227 0 : ierr=0
228 : #if defined HAVE_MPI
229 0 : l_use_omp_map=.false.
230 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
231 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
232 0 : l_use_omp_map=.false.
233 0 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
234 0 : n1=size(xval,dim=1)
235 0 : n2=size(xval,dim=2)
236 0 : n3=size(xval,dim=3)
237 0 : my_tag = MOD(tag,xmpi_tag_ub)
238 :
239 : !This product of dimensions can be greater than a 32bit integer
240 : !We use a INT64 to store it. If it is too large, we switch to an
241 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
242 0 : ntot=int(n1,kind=int64)*n2*n3
243 :
244 0 : if (ntot<=xmpi_maxint32_64) then
245 0 : if(.not. l_use_omp_map) then
246 0 : call MPI_ISEND(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,dest,my_tag,comm,request,ier)
247 : else
248 : #ifdef HAVE_OPENMP_OFFLOAD
249 : #ifdef HAVE_GPU_MPI
250 : ! Proper GPU-aware call
251 : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
252 : call MPI_ISEND(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,dest,my_tag,comm,request,ier)
253 : !$OMP END TARGET DATA
254 : #else
255 : !$OMP TARGET UPDATE FROM(xval)
256 : call MPI_ISEND(xval,n1*n2*n3,MPI_DOUBLE_PRECISION,dest,my_tag,comm,request,ier)
257 : #endif
258 : #endif
259 : end if ! l_use_omp_map
260 : else
261 0 : call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_OP_NULL)
262 0 : if(.not. l_use_omp_map) then
263 0 : call MPI_ISEND(xval,1,my_dt,dest,my_tag,comm,request,ier)
264 : else
265 : #ifdef HAVE_OPENMP_OFFLOAD
266 : #ifdef HAVE_GPU_MPI
267 : ! Proper GPU-aware call
268 : !$OMP TARGET DATA USE_DEVICE_ADDR(xval)
269 : call MPI_ISEND(xval,1,my_dt,dest,my_tag,comm,request,ier)
270 : !$OMP END TARGET DATA
271 : #else
272 : !$OMP TARGET UPDATE FROM(xval)
273 : call MPI_ISEND(xval,1,my_dt,dest,my_tag,comm,request,ier)
274 : #endif
275 : #endif
276 : end if ! l_use_omp_map
277 0 : call xmpi_largetype_free(my_dt,my_op)
278 : end if
279 :
280 0 : xmpi_count_requests = xmpi_count_requests + 1
281 0 : ierr=ier
282 : end if
283 : #endif
284 :
285 0 : end subroutine xmpi_isend_dp3d
286 : !!***
|
