1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
2 /*
3 * (C) 2010 by Argonne National Laboratory.
4 * See COPYRIGHT in top-level directory.
5 */
6
7 #include "mpiimpl.h"
8
9 /* -- Begin Profiling Symbol Block for routine MPIX_Iscatterv */
10 #if defined(HAVE_PRAGMA_WEAK)
11 #pragma weak MPIX_Iscatterv = PMPIX_Iscatterv
12 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
13 #pragma _HP_SECONDARY_DEF PMPIX_Iscatterv MPIX_Iscatterv
14 #elif defined(HAVE_PRAGMA_CRI_DUP)
15 #pragma _CRI duplicate MPIX_Iscatterv as PMPIX_Iscatterv
16 #endif
17 /* -- End Profiling Symbol Block */
18
19 /* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
20 the MPI routines */
21 #ifndef MPICH_MPI_FROM_PMPI
22 #undef MPIX_Iscatterv
23 #define MPIX_Iscatterv PMPIX_Iscatterv
24
25 /* any non-MPI functions go here, especially non-static ones */
26
27 /* This is the default implementation of scatterv. The algorithm is:
28
29 Algorithm: MPI_Scatterv
30
31 Since the array of sendcounts is valid only on the root, we cannot
32 do a tree algorithm without first communicating the sendcounts to
33 other processes. Therefore, we simply use a linear algorithm for the
34 scatter, which takes (p-1) steps versus lgp steps for the tree
35 algorithm. The bandwidth requirement is the same for both algorithms.
36
37 Cost = (p-1).alpha + n.((p-1)/p).beta
38
39 Possible improvements:
40
41 End Algorithm: MPI_Scatterv
42 */
43 /* this routine handles both intracomms and intercomms */
44 #undef FUNCNAME
45 #define FUNCNAME MPIR_Iscatterv
46 #undef FCNAME
47 #define FCNAME MPIU_QUOTE(FUNCNAME)
MPIR_Iscatterv(const void * sendbuf,const int * sendcounts,const int * displs,MPI_Datatype sendtype,void * recvbuf,int recvcount,MPI_Datatype recvtype,int root,MPID_Comm * comm_ptr,MPID_Sched_t s)48 int MPIR_Iscatterv(const void *sendbuf, const int *sendcounts, const int *displs, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPID_Comm *comm_ptr, MPID_Sched_t s)
49 {
50 int mpi_errno = MPI_SUCCESS;
51 int rank, comm_size;
52 MPI_Aint extent;
53 int i;
54
55 rank = comm_ptr->rank;
56
57 /* If I'm the root, then scatter */
58 if (((comm_ptr->comm_kind == MPID_INTRACOMM) && (root == rank)) ||
59 ((comm_ptr->comm_kind == MPID_INTERCOMM) && (root == MPI_ROOT)))
60 {
61 if (comm_ptr->comm_kind == MPID_INTRACOMM)
62 comm_size = comm_ptr->local_size;
63 else
64 comm_size = comm_ptr->remote_size;
65
66 MPID_Datatype_get_extent_macro(sendtype, extent);
67 /* We need a check to ensure extent will fit in a
68 * pointer. That needs extent * (max count) but we can't get
69 * that without looping over the input data. This is at least
70 * a minimal sanity check. Maybe add a global var since we do
71 * loop over sendcount[] in MPI_Scatterv before calling
72 * this? */
73 MPID_Ensure_Aint_fits_in_pointer(MPI_VOID_PTR_CAST_TO_MPI_AINT sendbuf + extent);
74
75 for (i = 0; i < comm_size; i++) {
76 if (sendcounts[i]) {
77 if ((comm_ptr->comm_kind == MPID_INTRACOMM) && (i == rank)) {
78 if (recvbuf != MPI_IN_PLACE) {
79 mpi_errno = MPID_Sched_copy(((char *)sendbuf+displs[rank]*extent),
80 sendcounts[rank], sendtype,
81 recvbuf, recvcount, recvtype, s);
82 if (mpi_errno) MPIU_ERR_POP(mpi_errno);
83 }
84 }
85 else {
86 mpi_errno = MPID_Sched_send(((char *)sendbuf+displs[i]*extent),
87 sendcounts[i], sendtype, i, comm_ptr, s);
88 if (mpi_errno) MPIU_ERR_POP(mpi_errno);
89 }
90 }
91 }
92 }
93
94 else if (root != MPI_PROC_NULL) {
95 /* non-root nodes, and in the intercomm. case, non-root nodes on remote side */
96 if (recvcount) {
97 mpi_errno = MPID_Sched_recv(recvbuf, recvcount, recvtype, root, comm_ptr, s);
98 if (mpi_errno) MPIU_ERR_POP(mpi_errno);
99 }
100 }
101
102 fn_exit:
103 return mpi_errno;
104 fn_fail:
105 goto fn_exit;
106 }
107
108 #undef FUNCNAME
109 #define FUNCNAME MPIR_Iscatterv_impl
110 #undef FCNAME
111 #define FCNAME MPIU_QUOTE(FUNCNAME)
MPIR_Iscatterv_impl(const void * sendbuf,const int * sendcounts,const int * displs,MPI_Datatype sendtype,void * recvbuf,int recvcount,MPI_Datatype recvtype,int root,MPID_Comm * comm_ptr,MPI_Request * request)112 int MPIR_Iscatterv_impl(const void *sendbuf, const int *sendcounts, const int *displs, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPID_Comm *comm_ptr, MPI_Request *request)
113 {
114 int mpi_errno = MPI_SUCCESS;
115 int tag = -1;
116 MPID_Request *reqp = NULL;
117 MPID_Sched_t s = MPID_SCHED_NULL;
118
119 *request = MPI_REQUEST_NULL;
120
121 mpi_errno = MPID_Sched_next_tag(comm_ptr, &tag);
122 if (mpi_errno) MPIU_ERR_POP(mpi_errno);
123 mpi_errno = MPID_Sched_create(&s);
124 if (mpi_errno) MPIU_ERR_POP(mpi_errno);
125
126 MPIU_Assert(comm_ptr->coll_fns != NULL);
127 MPIU_Assert(comm_ptr->coll_fns->Iscatterv != NULL);
128 mpi_errno = comm_ptr->coll_fns->Iscatterv(sendbuf, sendcounts, displs, sendtype, recvbuf, recvcount, recvtype, root, comm_ptr, s);
129 if (mpi_errno) MPIU_ERR_POP(mpi_errno);
130
131 mpi_errno = MPID_Sched_start(&s, comm_ptr, tag, &reqp);
132 if (reqp)
133 *request = reqp->handle;
134 if (mpi_errno) MPIU_ERR_POP(mpi_errno);
135
136 fn_exit:
137 return mpi_errno;
138 fn_fail:
139 goto fn_exit;
140 }
141
142 #endif /* MPICH_MPI_FROM_PMPI */
143
144 #undef FUNCNAME
145 #define FUNCNAME MPIX_Iscatterv
146 #undef FCNAME
147 #define FCNAME MPIU_QUOTE(FUNCNAME)
148 /*@
149 MPIX_Iscatterv - XXX description here
150
151 Input Parameters:
152 + sendbuf - address of send buffer (significant only at root) (choice)
153 . sendcounts - non-negative integer array (of length group size) specifying the number of elements to send to each processor (significant only at root)
154 . displs - integer array (of length group size). Entry i specifies the displacement (relative to sendbuf) from which to take the outgoing data to process i (significant only at root)
155 . sendtype - data type of send buffer elements (significant only at root) (handle)
156 . recvcount - number of elements in receive buffer (non-negative integer)
157 . recvtype - data type of receive buffer elements (handle)
158 . root - rank of sending process (integer)
159 - comm - communicator (handle)
160
161 Output Parameters:
162 + recvbuf - starting address of the receive buffer (choice)
163 - request - communication request (handle)
164
165 .N ThreadSafe
166
167 .N Fortran
168
169 .N Errors
170 @*/
MPIX_Iscatterv(const void * sendbuf,const int * sendcounts,const int * displs,MPI_Datatype sendtype,void * recvbuf,int recvcount,MPI_Datatype recvtype,int root,MPI_Comm comm,MPI_Request * request)171 int MPIX_Iscatterv(const void *sendbuf, const int *sendcounts, const int *displs, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request)
172 {
173 int mpi_errno = MPI_SUCCESS;
174 MPID_Comm *comm_ptr = NULL;
175 MPID_MPI_STATE_DECL(MPID_STATE_MPIX_ISCATTERV);
176
177 MPIU_THREAD_CS_ENTER(ALLFUNC,);
178 MPID_MPI_FUNC_ENTER(MPID_STATE_MPIX_ISCATTERV);
179
180 /* Validate parameters, especially handles needing to be converted */
181 # ifdef HAVE_ERROR_CHECKING
182 {
183 MPID_BEGIN_ERROR_CHECKS
184 {
185 MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
186 if (recvbuf != MPI_IN_PLACE)
187 MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
188 MPIR_ERRTEST_COMM(comm, mpi_errno);
189
190 /* TODO more checks may be appropriate */
191 }
192 MPID_END_ERROR_CHECKS
193 }
194 # endif /* HAVE_ERROR_CHECKING */
195
196 /* Convert MPI object handles to object pointers */
197 MPID_Comm_get_ptr(comm, comm_ptr);
198
199 /* Validate parameters and objects (post conversion) */
200 # ifdef HAVE_ERROR_CHECKING
201 {
202 MPID_BEGIN_ERROR_CHECKS
203 {
204 MPID_Datatype *sendtype_ptr=NULL, *recvtype_ptr=NULL;
205 int i, comm_size, rank;
206
207 MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
208 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
209
210 if (comm_ptr->comm_kind == MPID_INTRACOMM) {
211 MPIR_ERRTEST_INTRA_ROOT(comm_ptr, root, mpi_errno);
212 rank = comm_ptr->rank;
213 comm_size = comm_ptr->local_size;
214
215 if (rank == root) {
216 for (i=0; i<comm_size; i++) {
217 MPIR_ERRTEST_COUNT(sendcounts[i], mpi_errno);
218 MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
219 }
220 if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {
221 MPID_Datatype_get_ptr(sendtype, sendtype_ptr);
222 MPID_Datatype_valid_ptr( sendtype_ptr, mpi_errno );
223 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
224 MPID_Datatype_committed_ptr( sendtype_ptr, mpi_errno );
225 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
226 }
227 for (i=0; i<comm_size; i++) {
228 if (sendcounts[i] > 0) {
229 MPIR_ERRTEST_USERBUFFER(sendbuf,sendcounts[i],sendtype,mpi_errno);
230 break;
231 }
232 }
233 for (i=0; i<comm_size; i++) {
234 if (sendcounts[i] > 0) {
235 MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcounts[i], mpi_errno);
236 break;
237 }
238 }
239 }
240 else
241 MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcount, mpi_errno);
242
243 if (recvbuf != MPI_IN_PLACE) {
244 MPIR_ERRTEST_COUNT(recvcount, mpi_errno);
245 MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
246 if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {
247 MPID_Datatype_get_ptr(recvtype, recvtype_ptr);
248 MPID_Datatype_valid_ptr( recvtype_ptr, mpi_errno );
249 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
250 MPID_Datatype_committed_ptr( recvtype_ptr, mpi_errno );
251 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
252 }
253 MPIR_ERRTEST_USERBUFFER(recvbuf,recvcount,recvtype,mpi_errno);
254 }
255 }
256
257 if (comm_ptr->comm_kind == MPID_INTERCOMM) {
258 MPIR_ERRTEST_INTER_ROOT(comm_ptr, root, mpi_errno);
259 if (root == MPI_ROOT) {
260 comm_size = comm_ptr->remote_size;
261 for (i=0; i<comm_size; i++) {
262 MPIR_ERRTEST_COUNT(sendcounts[i], mpi_errno);
263 MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
264 }
265 if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {
266 MPID_Datatype_get_ptr(sendtype, sendtype_ptr);
267 MPID_Datatype_valid_ptr( sendtype_ptr, mpi_errno );
268 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
269 MPID_Datatype_committed_ptr( sendtype_ptr, mpi_errno );
270 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
271 }
272 for (i=0; i<comm_size; i++) {
273 if (sendcounts[i] > 0) {
274 MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcounts[i], mpi_errno);
275 MPIR_ERRTEST_USERBUFFER(sendbuf,sendcounts[i],sendtype,mpi_errno);
276 break;
277 }
278 }
279 }
280 else if (root != MPI_PROC_NULL) {
281 MPIR_ERRTEST_COUNT(recvcount, mpi_errno);
282 MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
283 if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {
284 MPID_Datatype_get_ptr(recvtype, recvtype_ptr);
285 MPID_Datatype_valid_ptr( recvtype_ptr, mpi_errno );
286 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
287 MPID_Datatype_committed_ptr( recvtype_ptr, mpi_errno );
288 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
289 }
290 MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcount, mpi_errno);
291 MPIR_ERRTEST_USERBUFFER(recvbuf,recvcount,recvtype,mpi_errno);
292 }
293 }
294
295 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
296 }
297 MPID_END_ERROR_CHECKS
298 }
299 # endif /* HAVE_ERROR_CHECKING */
300
301 /* ... body of routine ... */
302
303 mpi_errno = MPIR_Iscatterv_impl(sendbuf, sendcounts, displs, sendtype, recvbuf, recvcount, recvtype, root, comm_ptr, request);
304 if (mpi_errno) MPIU_ERR_POP(mpi_errno);
305
306 /* ... end of body of routine ... */
307
308 fn_exit:
309 MPID_MPI_FUNC_EXIT(MPID_STATE_MPIX_ISCATTERV);
310 MPIU_THREAD_CS_EXIT(ALLFUNC,);
311 return mpi_errno;
312
313 fn_fail:
314 /* --BEGIN ERROR HANDLING-- */
315 # ifdef HAVE_ERROR_CHECKING
316 {
317 mpi_errno = MPIR_Err_create_code(
318 mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
319 "**mpix_iscatterv", "**mpix_iscatterv %p %p %p %D %p %d %D %d %C %p", sendbuf, sendcounts, displs, sendtype, recvbuf, recvcount, recvtype, root, comm, request);
320 }
321 # endif
322 mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
323 goto fn_exit;
324 /* --END ERROR HANDLING-- */
325 goto fn_exit;
326 }
327