Actual source code: mpits.c
1: #include <petsc/private/petscimpl.h>
3: PetscLogEvent PETSC_BuildTwoSided;
4: PetscLogEvent PETSC_BuildTwoSidedF;
6: const char *const PetscBuildTwoSidedTypes[] = {"ALLREDUCE", "IBARRIER", "REDSCATTER", "PetscBuildTwoSidedType", "PETSC_BUILDTWOSIDED_", NULL};
8: static PetscBuildTwoSidedType _twosided_type = PETSC_BUILDTWOSIDED_NOTSET;
10: /*@
11: PetscCommBuildTwoSidedSetType - set algorithm to use when building two-sided communication
13: Logically Collective
15: Input Parameters:
16: + comm - `PETSC_COMM_WORLD`
17: - twosided - algorithm to use in subsequent calls to `PetscCommBuildTwoSided()`
19: Level: developer
21: Note:
22: This option is currently global, but could be made per-communicator.
24: .seealso: `PetscCommBuildTwoSided()`, `PetscCommBuildTwoSidedGetType()`, `PetscBuildTwoSidedType`
25: @*/
26: PetscErrorCode PetscCommBuildTwoSidedSetType(MPI_Comm comm, PetscBuildTwoSidedType twosided)
27: {
28: PetscFunctionBegin;
30: PetscMPIInt b2[2];
31: b2[0] = -(PetscMPIInt)twosided;
32: b2[1] = (PetscMPIInt)twosided;
33: PetscCallMPI(MPIU_Allreduce(MPI_IN_PLACE, b2, 2, MPI_INT, MPI_MAX, comm));
34: PetscCheck(-b2[0] == b2[1], comm, PETSC_ERR_ARG_WRONG, "Enum value must be same on all processes");
35: }
36: _twosided_type = twosided;
37: PetscFunctionReturn(PETSC_SUCCESS);
38: }
40: /*@
41: PetscCommBuildTwoSidedGetType - get algorithm used when building two-sided communication
43: Logically Collective
45: Output Parameters:
46: + comm - communicator on which to query algorithm
47: - twosided - algorithm to use for `PetscCommBuildTwoSided()`
49: Level: developer
51: .seealso: `PetscCommBuildTwoSided()`, `PetscCommBuildTwoSidedSetType()`, `PetscBuildTwoSidedType`
52: @*/
53: PetscErrorCode PetscCommBuildTwoSidedGetType(MPI_Comm comm, PetscBuildTwoSidedType *twosided)
54: {
55: PetscMPIInt size;
57: PetscFunctionBegin;
58: *twosided = PETSC_BUILDTWOSIDED_NOTSET;
59: if (_twosided_type == PETSC_BUILDTWOSIDED_NOTSET) {
60: PetscCallMPI(MPI_Comm_size(comm, &size));
61: _twosided_type = PETSC_BUILDTWOSIDED_ALLREDUCE; /* default for small comms, see https://gitlab.com/petsc/petsc/-/merge_requests/2611 */
62: #if PetscDefined(HAVE_MPI_NONBLOCKING_COLLECTIVES)
63: if (size > 1024) _twosided_type = PETSC_BUILDTWOSIDED_IBARRIER;
64: #endif
65: PetscCall(PetscOptionsGetEnum(NULL, NULL, "-build_twosided", PetscBuildTwoSidedTypes, (PetscEnum *)&_twosided_type, NULL));
66: }
67: *twosided = _twosided_type;
68: PetscFunctionReturn(PETSC_SUCCESS);
69: }
71: #if PetscDefined(HAVE_MPI_NONBLOCKING_COLLECTIVES)
72: static PetscErrorCode PetscCommBuildTwoSided_Ibarrier(MPI_Comm comm, PetscMPIInt count, MPI_Datatype dtype, PetscMPIInt nto, const PetscMPIInt *toranks, const void *todata, PetscMPIInt *nfrom, PetscMPIInt **fromranks, void *fromdata)
73: {
74: PetscMPIInt nrecvs, tag, done, i;
75: MPI_Aint lb, unitbytes;
76: char *tdata;
77: MPI_Request *sendreqs, barrier;
78: PetscSegBuffer segrank, segdata;
79: PetscBool barrier_started;
81: PetscFunctionBegin;
82: PetscCall(PetscCommDuplicate(comm, &comm, &tag));
83: PetscCallMPI(MPI_Type_get_extent(dtype, &lb, &unitbytes));
84: PetscCheck(lb == 0, comm, PETSC_ERR_SUP, "Datatype with nonzero lower bound %ld", (long)lb);
85: tdata = (char *)todata;
86: PetscCall(PetscMalloc1(nto, &sendreqs));
87: for (i = 0; i < nto; i++) PetscCallMPI(MPI_Issend((void *)(tdata + count * unitbytes * i), count, dtype, toranks[i], tag, comm, sendreqs + i));
88: PetscCall(PetscSegBufferCreate(sizeof(PetscMPIInt), 4, &segrank));
89: PetscCall(PetscSegBufferCreate(unitbytes, 4 * count, &segdata));
91: nrecvs = 0;
92: barrier = MPI_REQUEST_NULL;
93: /* MPICH-3.2 sometimes does not create a request in some "optimized" cases. This is arguably a standard violation,
94: * but we need to work around it. */
95: barrier_started = PETSC_FALSE;
96: for (done = 0; !done;) {
97: PetscMPIInt flag;
98: MPI_Status status;
99: PetscCallMPI(MPI_Iprobe(MPI_ANY_SOURCE, tag, comm, &flag, &status));
100: if (flag) { /* incoming message */
101: PetscMPIInt *recvrank;
102: void *buf;
103: PetscCall(PetscSegBufferGet(segrank, 1, &recvrank));
104: PetscCall(PetscSegBufferGet(segdata, count, &buf));
105: *recvrank = status.MPI_SOURCE;
106: PetscCallMPI(MPI_Recv(buf, count, dtype, status.MPI_SOURCE, tag, comm, MPI_STATUS_IGNORE));
107: nrecvs++;
108: }
109: if (!barrier_started) {
110: PetscMPIInt sent, nsends;
111: PetscCall(PetscMPIIntCast(nto, &nsends));
112: PetscCallMPI(MPI_Testall(nsends, sendreqs, &sent, MPI_STATUSES_IGNORE));
113: if (sent) {
114: PetscCallMPI(MPI_Ibarrier(comm, &barrier));
115: barrier_started = PETSC_TRUE;
116: PetscCall(PetscFree(sendreqs));
117: }
118: } else {
119: PetscCallMPI(MPI_Test(&barrier, &done, MPI_STATUS_IGNORE));
120: }
121: }
122: *nfrom = nrecvs;
123: PetscCall(PetscSegBufferExtractAlloc(segrank, fromranks));
124: PetscCall(PetscSegBufferDestroy(&segrank));
125: PetscCall(PetscSegBufferExtractAlloc(segdata, fromdata));
126: PetscCall(PetscSegBufferDestroy(&segdata));
127: PetscCall(PetscCommDestroy(&comm));
128: PetscFunctionReturn(PETSC_SUCCESS);
129: }
130: #endif
132: static PetscErrorCode PetscCommBuildTwoSided_Allreduce(MPI_Comm comm, PetscMPIInt count, MPI_Datatype dtype, PetscMPIInt nto, const PetscMPIInt *toranks, const void *todata, PetscMPIInt *nfrom, PetscMPIInt **fromranks, void *fromdata)
133: {
134: PetscMPIInt size, rank, *iflags, nrecvs, tag, *franks, i, flg;
135: MPI_Aint lb, unitbytes;
136: char *tdata, *fdata;
137: MPI_Request *reqs, *sendreqs;
138: MPI_Status *statuses;
139: PetscCommCounter *counter;
141: PetscFunctionBegin;
142: PetscCallMPI(MPI_Comm_size(comm, &size));
143: PetscCallMPI(MPI_Comm_rank(comm, &rank));
144: PetscCall(PetscCommDuplicate(comm, &comm, &tag));
145: PetscCallMPI(MPI_Comm_get_attr(comm, Petsc_Counter_keyval, &counter, &flg));
146: PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Inner PETSc communicator does not have its tag/name counter attribute set");
147: if (!counter->iflags) {
148: PetscCall(PetscCalloc1(size, &counter->iflags));
149: iflags = counter->iflags;
150: } else {
151: iflags = counter->iflags;
152: PetscCall(PetscArrayzero(iflags, size));
153: }
154: for (i = 0; i < nto; i++) iflags[toranks[i]] = 1;
155: PetscCallMPI(MPIU_Allreduce(MPI_IN_PLACE, iflags, size, MPI_INT, MPI_SUM, comm));
156: nrecvs = iflags[rank];
157: PetscCallMPI(MPI_Type_get_extent(dtype, &lb, &unitbytes));
158: PetscCheck(lb == 0, comm, PETSC_ERR_SUP, "Datatype with nonzero lower bound %ld", (long)lb);
159: PetscCall(PetscMalloc(nrecvs * count * unitbytes, &fdata));
160: tdata = (char *)todata;
161: PetscCall(PetscMalloc2(nto + nrecvs, &reqs, nto + nrecvs, &statuses));
162: sendreqs = PetscSafePointerPlusOffset(reqs, nrecvs);
163: for (i = 0; i < nrecvs; i++) PetscCallMPI(MPIU_Irecv((void *)(fdata + count * unitbytes * i), count, dtype, MPI_ANY_SOURCE, tag, comm, reqs + i));
164: for (i = 0; i < nto; i++) PetscCallMPI(MPIU_Isend((void *)(tdata + count * unitbytes * i), count, dtype, toranks[i], tag, comm, sendreqs + i));
165: PetscCallMPI(MPI_Waitall(nto + nrecvs, reqs, statuses));
166: PetscCall(PetscMalloc1(nrecvs, &franks));
167: for (i = 0; i < nrecvs; i++) franks[i] = statuses[i].MPI_SOURCE;
168: PetscCall(PetscFree2(reqs, statuses));
169: PetscCall(PetscCommDestroy(&comm));
171: *nfrom = nrecvs;
172: *fromranks = franks;
173: *(void **)fromdata = fdata;
174: PetscFunctionReturn(PETSC_SUCCESS);
175: }
177: #if PetscDefined(HAVE_MPI_REDUCE_SCATTER_BLOCK)
178: static PetscErrorCode PetscCommBuildTwoSided_RedScatter(MPI_Comm comm, PetscMPIInt count, MPI_Datatype dtype, PetscMPIInt nto, const PetscMPIInt *toranks, const void *todata, PetscMPIInt *nfrom, PetscMPIInt **fromranks, void *fromdata)
179: {
180: PetscMPIInt size, *iflags, nrecvs, tag, *franks, i, flg;
181: MPI_Aint lb, unitbytes;
182: char *tdata, *fdata;
183: MPI_Request *reqs, *sendreqs;
184: MPI_Status *statuses;
185: PetscCommCounter *counter;
187: PetscFunctionBegin;
188: PetscCallMPI(MPI_Comm_size(comm, &size));
189: PetscCall(PetscCommDuplicate(comm, &comm, &tag));
190: PetscCallMPI(MPI_Comm_get_attr(comm, Petsc_Counter_keyval, &counter, &flg));
191: PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Inner PETSc communicator does not have its tag/name counter attribute set");
192: if (!counter->iflags) {
193: PetscCall(PetscCalloc1(size, &counter->iflags));
194: iflags = counter->iflags;
195: } else {
196: iflags = counter->iflags;
197: PetscCall(PetscArrayzero(iflags, size));
198: }
199: for (i = 0; i < nto; i++) iflags[toranks[i]] = 1;
200: PetscCallMPI(MPI_Reduce_scatter_block(iflags, &nrecvs, 1, MPI_INT, MPI_SUM, comm));
201: PetscCallMPI(MPI_Type_get_extent(dtype, &lb, &unitbytes));
202: PetscCheck(lb == 0, comm, PETSC_ERR_SUP, "Datatype with nonzero lower bound %ld", (long)lb);
203: PetscCall(PetscMalloc(nrecvs * count * unitbytes, &fdata));
204: tdata = (char *)todata;
205: PetscCall(PetscMalloc2(nto + nrecvs, &reqs, nto + nrecvs, &statuses));
206: sendreqs = reqs + nrecvs;
207: for (i = 0; i < nrecvs; i++) PetscCallMPI(MPIU_Irecv((void *)(fdata + count * unitbytes * i), count, dtype, MPI_ANY_SOURCE, tag, comm, reqs + i));
208: for (i = 0; i < nto; i++) PetscCallMPI(MPIU_Isend((void *)(tdata + count * unitbytes * i), count, dtype, toranks[i], tag, comm, sendreqs + i));
209: PetscCallMPI(MPI_Waitall(nto + nrecvs, reqs, statuses));
210: PetscCall(PetscMalloc1(nrecvs, &franks));
211: for (i = 0; i < nrecvs; i++) franks[i] = statuses[i].MPI_SOURCE;
212: PetscCall(PetscFree2(reqs, statuses));
213: PetscCall(PetscCommDestroy(&comm));
215: *nfrom = nrecvs;
216: *fromranks = franks;
217: *(void **)fromdata = fdata;
218: PetscFunctionReturn(PETSC_SUCCESS);
219: }
220: #endif
222: /*@
223: PetscCommBuildTwoSided - discovers communicating ranks given one-sided information, moving constant-sized data in the process (often message lengths)
225: Collective, No Fortran Support
227: Input Parameters:
228: + comm - communicator
229: . count - number of entries to send/receive (must match on all ranks)
230: . dtype - datatype to send/receive from each rank (must match on all ranks)
231: . nto - number of ranks to send data to
232: . toranks - ranks to send to (array of length `nto`)
233: - todata - data to send to each rank (packed)
235: Output Parameters:
236: + nfrom - number of ranks receiving messages from
237: . fromranks - ranks receiving messages from (length `nfrom`, caller should `PetscFree()`)
238: - fromdata - packed data from each rank, each with count entries of type dtype (length `nfrom`, caller responsible for `PetscFree()`)
240: Options Database Key:
241: . -build_twosided (allreduce|ibarrier|redscatter) - algorithm to set up two-sided communication. Default is allreduce for communicators with <= 1024 ranks,
242: otherwise ibarrier.
244: Level: developer
246: Notes:
247: This memory-scalable interface is an alternative to calling `PetscGatherNumberOfMessages()` and
248: `PetscGatherMessageLengths()`, possibly with a subsequent round of communication to send other constant-size data, see {cite}`hoeflersiebretlumsdaine10`.
250: Basic data types as well as contiguous types are supported, but non-contiguous (e.g., strided) types are not.
252: .seealso: `PetscGatherNumberOfMessages()`, `PetscGatherMessageLengths()`, `PetscCommBuildTwoSidedSetType()`, `PetscCommBuildTwoSidedType`
253: @*/
254: PetscErrorCode PetscCommBuildTwoSided(MPI_Comm comm, PetscMPIInt count, MPI_Datatype dtype, PetscMPIInt nto, const PetscMPIInt toranks[], const void *todata, PetscMPIInt *nfrom, PetscMPIInt *fromranks[], void *fromdata)
255: {
256: PetscBuildTwoSidedType buildtype = PETSC_BUILDTWOSIDED_NOTSET;
258: PetscFunctionBegin;
259: PetscCall(PetscSysInitializePackage());
260: PetscCall(PetscLogEventSync(PETSC_BuildTwoSided, comm));
261: PetscCall(PetscLogEventBegin(PETSC_BuildTwoSided, 0, 0, 0, 0));
262: PetscCall(PetscCommBuildTwoSidedGetType(comm, &buildtype));
263: switch (buildtype) {
264: case PETSC_BUILDTWOSIDED_IBARRIER:
265: #if PetscDefined(HAVE_MPI_NONBLOCKING_COLLECTIVES)
266: PetscCall(PetscCommBuildTwoSided_Ibarrier(comm, count, dtype, nto, toranks, todata, nfrom, fromranks, fromdata));
267: break;
268: #else
269: SETERRQ(comm, PETSC_ERR_PLIB, "MPI implementation does not provide MPI_Ibarrier (part of MPI-3)");
270: #endif
271: case PETSC_BUILDTWOSIDED_ALLREDUCE:
272: PetscCall(PetscCommBuildTwoSided_Allreduce(comm, count, dtype, nto, toranks, todata, nfrom, fromranks, fromdata));
273: break;
274: case PETSC_BUILDTWOSIDED_REDSCATTER:
275: #if PetscDefined(HAVE_MPI_REDUCE_SCATTER_BLOCK)
276: PetscCall(PetscCommBuildTwoSided_RedScatter(comm, count, dtype, nto, toranks, todata, nfrom, fromranks, fromdata));
277: break;
278: #else
279: SETERRQ(comm, PETSC_ERR_PLIB, "MPI implementation does not provide MPI_Reduce_scatter_block (part of MPI-2.2)");
280: #endif
281: default:
282: SETERRQ(comm, PETSC_ERR_PLIB, "Unknown method for building two-sided communication");
283: }
284: PetscCall(PetscLogEventEnd(PETSC_BuildTwoSided, 0, 0, 0, 0));
285: PetscFunctionReturn(PETSC_SUCCESS);
286: }
288: static PetscErrorCode PetscCommBuildTwoSidedFReq_Reference(MPI_Comm comm, PetscMPIInt count, MPI_Datatype dtype, PetscMPIInt nto, const PetscMPIInt *toranks, const void *todata, PetscMPIInt *nfrom, PetscMPIInt **fromranks, void *fromdata, PetscMPIInt ntags, MPI_Request **toreqs, MPI_Request **fromreqs, PetscErrorCode (*send)(MPI_Comm, const PetscMPIInt[], PetscMPIInt, PetscMPIInt, void *, MPI_Request[], void *), PetscErrorCode (*recv)(MPI_Comm, const PetscMPIInt[], PetscMPIInt, void *, MPI_Request[], void *), PetscCtx ctx)
289: {
290: PetscMPIInt i, *tag;
291: MPI_Aint lb, unitbytes;
292: MPI_Request *sendreq, *recvreq;
294: PetscFunctionBegin;
295: PetscCall(PetscMalloc1(ntags, &tag));
296: if (ntags > 0) PetscCall(PetscCommDuplicate(comm, &comm, &tag[0]));
297: for (i = 1; i < ntags; i++) PetscCall(PetscCommGetNewTag(comm, &tag[i]));
299: /* Perform complete initial rendezvous */
300: PetscCall(PetscCommBuildTwoSided(comm, count, dtype, nto, toranks, todata, nfrom, fromranks, fromdata));
302: PetscCall(PetscMalloc1(nto * ntags, &sendreq));
303: PetscCall(PetscMalloc1(*nfrom * ntags, &recvreq));
305: PetscCallMPI(MPI_Type_get_extent(dtype, &lb, &unitbytes));
306: PetscCheck(lb == 0, comm, PETSC_ERR_SUP, "Datatype with nonzero lower bound %ld", (long)lb);
307: for (i = 0; i < nto; i++) {
308: PetscMPIInt k;
309: for (k = 0; k < ntags; k++) sendreq[i * ntags + k] = MPI_REQUEST_NULL;
310: PetscCall((*send)(comm, tag, i, toranks[i], ((char *)todata) + count * unitbytes * i, sendreq + i * ntags, ctx));
311: }
312: for (i = 0; i < *nfrom; i++) {
313: void *header = (*(char **)fromdata) + count * unitbytes * i;
314: PetscMPIInt k;
315: for (k = 0; k < ntags; k++) recvreq[i * ntags + k] = MPI_REQUEST_NULL;
316: PetscCall((*recv)(comm, tag, (*fromranks)[i], header, recvreq + i * ntags, ctx));
317: }
318: PetscCall(PetscFree(tag));
319: PetscCall(PetscCommDestroy(&comm));
320: *toreqs = sendreq;
321: *fromreqs = recvreq;
322: PetscFunctionReturn(PETSC_SUCCESS);
323: }
325: #if PetscDefined(HAVE_MPI_NONBLOCKING_COLLECTIVES)
327: static PetscErrorCode PetscCommBuildTwoSidedFReq_Ibarrier(MPI_Comm comm, PetscMPIInt count, MPI_Datatype dtype, PetscMPIInt nto, const PetscMPIInt *toranks, const void *todata, PetscMPIInt *nfrom, PetscMPIInt **fromranks, void *fromdata, PetscMPIInt ntags, MPI_Request **toreqs, MPI_Request **fromreqs, PetscErrorCode (*send)(MPI_Comm, const PetscMPIInt[], PetscMPIInt, PetscMPIInt, void *, MPI_Request[], void *), PetscErrorCode (*recv)(MPI_Comm, const PetscMPIInt[], PetscMPIInt, void *, MPI_Request[], void *), PetscCtx ctx)
328: {
329: PetscMPIInt nrecvs, tag, *tags, done, i;
330: MPI_Aint lb, unitbytes;
331: char *tdata;
332: MPI_Request *sendreqs, *usendreqs, *req, barrier;
333: PetscSegBuffer segrank, segdata, segreq;
334: PetscBool barrier_started;
336: PetscFunctionBegin;
337: PetscCall(PetscCommDuplicate(comm, &comm, &tag));
338: PetscCall(PetscMalloc1(ntags, &tags));
339: for (i = 0; i < ntags; i++) PetscCall(PetscCommGetNewTag(comm, &tags[i]));
340: PetscCallMPI(MPI_Type_get_extent(dtype, &lb, &unitbytes));
341: PetscCheck(lb == 0, comm, PETSC_ERR_SUP, "Datatype with nonzero lower bound %ld", (long)lb);
342: tdata = (char *)todata;
343: PetscCall(PetscMalloc1(nto, &sendreqs));
344: PetscCall(PetscMalloc1(nto * ntags, &usendreqs));
345: /* Post synchronous sends */
346: for (i = 0; i < nto; i++) PetscCallMPI(MPI_Issend((void *)(tdata + count * unitbytes * i), count, dtype, toranks[i], tag, comm, sendreqs + i));
347: /* Post actual payloads. These are typically larger messages. Hopefully sending these later does not slow down the
348: * synchronous messages above. */
349: for (i = 0; i < nto; i++) {
350: PetscMPIInt k;
351: for (k = 0; k < ntags; k++) usendreqs[i * ntags + k] = MPI_REQUEST_NULL;
352: PetscCall((*send)(comm, tags, i, toranks[i], tdata + count * unitbytes * i, usendreqs + i * ntags, ctx));
353: }
355: PetscCall(PetscSegBufferCreate(sizeof(PetscMPIInt), 4, &segrank));
356: PetscCall(PetscSegBufferCreate(unitbytes, 4 * count, &segdata));
357: PetscCall(PetscSegBufferCreate(sizeof(MPI_Request), 4, &segreq));
359: nrecvs = 0;
360: barrier = MPI_REQUEST_NULL;
361: /* MPICH-3.2 sometimes does not create a request in some "optimized" cases. This is arguably a standard violation,
362: * but we need to work around it. */
363: barrier_started = PETSC_FALSE;
364: for (done = 0; !done;) {
365: PetscMPIInt flag;
366: MPI_Status status;
367: PetscCallMPI(MPI_Iprobe(MPI_ANY_SOURCE, tag, comm, &flag, &status));
368: if (flag) { /* incoming message */
369: PetscMPIInt *recvrank, k;
370: void *buf;
371: PetscCall(PetscSegBufferGet(segrank, 1, &recvrank));
372: PetscCall(PetscSegBufferGet(segdata, count, &buf));
373: *recvrank = status.MPI_SOURCE;
374: PetscCallMPI(MPI_Recv(buf, count, dtype, status.MPI_SOURCE, tag, comm, MPI_STATUS_IGNORE));
375: PetscCall(PetscSegBufferGet(segreq, ntags, &req));
376: for (k = 0; k < ntags; k++) req[k] = MPI_REQUEST_NULL;
377: PetscCall((*recv)(comm, tags, status.MPI_SOURCE, buf, req, ctx));
378: nrecvs++;
379: }
380: if (!barrier_started) {
381: PetscMPIInt sent, nsends;
382: PetscCall(PetscMPIIntCast(nto, &nsends));
383: PetscCallMPI(MPI_Testall(nsends, sendreqs, &sent, MPI_STATUSES_IGNORE));
384: if (sent) {
385: PetscCallMPI(MPI_Ibarrier(comm, &barrier));
386: barrier_started = PETSC_TRUE;
387: }
388: } else {
389: PetscCallMPI(MPI_Test(&barrier, &done, MPI_STATUS_IGNORE));
390: }
391: }
392: *nfrom = nrecvs;
393: PetscCall(PetscSegBufferExtractAlloc(segrank, fromranks));
394: PetscCall(PetscSegBufferDestroy(&segrank));
395: PetscCall(PetscSegBufferExtractAlloc(segdata, fromdata));
396: PetscCall(PetscSegBufferDestroy(&segdata));
397: *toreqs = usendreqs;
398: PetscCall(PetscSegBufferExtractAlloc(segreq, fromreqs));
399: PetscCall(PetscSegBufferDestroy(&segreq));
400: PetscCall(PetscFree(sendreqs));
401: PetscCall(PetscFree(tags));
402: PetscCall(PetscCommDestroy(&comm));
403: PetscFunctionReturn(PETSC_SUCCESS);
404: }
405: #endif
407: /*@
408: PetscCommBuildTwoSidedF - discovers communicating ranks given one-sided information, calling user-defined functions during rendezvous
410: Collective, No Fortran Support
412: Input Parameters:
413: + comm - communicator
414: . count - number of entries to send/receive in initial rendezvous (must match on all ranks)
415: . dtype - datatype to send/receive from each rank (must match on all ranks)
416: . nto - number of ranks to send data to
417: . toranks - ranks to send to (array of length nto)
418: . todata - data to send to each rank (packed)
419: . ntags - number of tags needed by send/recv callbacks
420: . send - callback invoked on sending process when ready to send primary payload
421: . recv - callback invoked on receiving process after delivery of rendezvous message
422: - ctx - context for callbacks
424: Output Parameters:
425: + nfrom - number of ranks receiving messages from
426: . fromranks - ranks receiving messages from (length nfrom; caller should `PetscFree()`)
427: - fromdata - packed data from each rank, each with count entries of type dtype (length nfrom, caller responsible for `PetscFree()`)
429: Level: developer
431: Notes:
432: This memory-scalable interface is an alternative to calling `PetscGatherNumberOfMessages()` and
433: `PetscGatherMessageLengths()`, possibly with a subsequent round of communication to send other data, {cite}`hoeflersiebretlumsdaine10`.
435: Basic data types as well as contiguous types are supported, but non-contiguous (e.g., strided) types are not.
437: .seealso: `PetscCommBuildTwoSided()`, `PetscCommBuildTwoSidedFReq()`, `PetscGatherNumberOfMessages()`, `PetscGatherMessageLengths()`
438: @*/
439: PetscErrorCode PetscCommBuildTwoSidedF(MPI_Comm comm, PetscMPIInt count, MPI_Datatype dtype, PetscMPIInt nto, const PetscMPIInt *toranks, const void *todata, PetscMPIInt *nfrom, PetscMPIInt **fromranks, void *fromdata, PetscMPIInt ntags, PetscErrorCode (*send)(MPI_Comm, const PetscMPIInt[], PetscMPIInt, PetscMPIInt, void *, MPI_Request[], void *), PetscErrorCode (*recv)(MPI_Comm, const PetscMPIInt[], PetscMPIInt, void *, MPI_Request[], void *), PetscCtx ctx)
440: {
441: MPI_Request *toreqs, *fromreqs;
443: PetscFunctionBegin;
444: PetscCall(PetscCommBuildTwoSidedFReq(comm, count, dtype, nto, toranks, todata, nfrom, fromranks, fromdata, ntags, &toreqs, &fromreqs, send, recv, ctx));
445: PetscCallMPI(MPI_Waitall(nto * ntags, toreqs, MPI_STATUSES_IGNORE));
446: PetscCallMPI(MPI_Waitall(*nfrom * ntags, fromreqs, MPI_STATUSES_IGNORE));
447: PetscCall(PetscFree(toreqs));
448: PetscCall(PetscFree(fromreqs));
449: PetscFunctionReturn(PETSC_SUCCESS);
450: }
452: /*@
453: PetscCommBuildTwoSidedFReq - discovers communicating ranks given one-sided information, calling user-defined functions during rendezvous, returns requests
455: Collective, No Fortran Support
457: Input Parameters:
458: + comm - communicator
459: . count - number of entries to send/receive in initial rendezvous (must match on all ranks)
460: . dtype - datatype to send/receive from each rank (must match on all ranks)
461: . nto - number of ranks to send data to
462: . toranks - ranks to send to (array of length nto)
463: . todata - data to send to each rank (packed)
464: . ntags - number of tags needed by send/recv callbacks
465: . send - callback invoked on sending process when ready to send primary payload
466: . recv - callback invoked on receiving process after delivery of rendezvous message
467: - ctx - context for callbacks
469: Output Parameters:
470: + nfrom - number of ranks receiving messages from
471: . fromranks - ranks receiving messages from (length nfrom; caller should `PetscFree()`)
472: . fromdata - packed data from each rank, each with count entries of type dtype (length nfrom, caller responsible for `PetscFree()`)
473: . toreqs - array of nto*ntags sender requests (caller must wait on these, then `PetscFree()`)
474: - fromreqs - array of nfrom*ntags receiver requests (caller must wait on these, then `PetscFree()`)
476: Level: developer
478: Notes:
479: This memory-scalable interface is an alternative to calling `PetscGatherNumberOfMessages()` and
480: `PetscGatherMessageLengths()`, possibly with a subsequent round of communication to send other data, {cite}`hoeflersiebretlumsdaine10`.
482: Basic data types as well as contiguous types are supported, but non-contiguous (e.g., strided) types are not.
484: .seealso: `PetscCommBuildTwoSided()`, `PetscCommBuildTwoSidedF()`, `PetscGatherNumberOfMessages()`, `PetscGatherMessageLengths()`
485: @*/
486: PetscErrorCode PetscCommBuildTwoSidedFReq(MPI_Comm comm, PetscMPIInt count, MPI_Datatype dtype, PetscMPIInt nto, const PetscMPIInt *toranks, const void *todata, PetscMPIInt *nfrom, PetscMPIInt **fromranks, void *fromdata, PetscMPIInt ntags, MPI_Request **toreqs, MPI_Request **fromreqs, PetscErrorCode (*send)(MPI_Comm, const PetscMPIInt[], PetscMPIInt, PetscMPIInt, void *, MPI_Request[], void *), PetscErrorCode (*recv)(MPI_Comm, const PetscMPIInt[], PetscMPIInt, void *, MPI_Request[], void *), PetscCtx ctx)
487: {
488: PetscErrorCode (*f)(MPI_Comm, PetscMPIInt, MPI_Datatype, PetscMPIInt, const PetscMPIInt[], const void *, PetscMPIInt *, PetscMPIInt **, void *, PetscMPIInt, MPI_Request **, MPI_Request **, PetscErrorCode (*send)(MPI_Comm, const PetscMPIInt[], PetscMPIInt, PetscMPIInt, void *, MPI_Request[], void *), PetscErrorCode (*recv)(MPI_Comm, const PetscMPIInt[], PetscMPIInt, void *, MPI_Request[], void *), PetscCtx ctx);
489: PetscBuildTwoSidedType buildtype = PETSC_BUILDTWOSIDED_NOTSET;
490: PetscMPIInt i, size;
492: PetscFunctionBegin;
493: PetscCall(PetscSysInitializePackage());
494: PetscCallMPI(MPI_Comm_size(comm, &size));
495: for (i = 0; i < nto; i++) PetscCheck(toranks[i] >= 0 && size > toranks[i], comm, PETSC_ERR_ARG_OUTOFRANGE, "toranks[%d] %d not in comm size %d", i, toranks[i], size);
496: PetscCall(PetscLogEventSync(PETSC_BuildTwoSidedF, comm));
497: PetscCall(PetscLogEventBegin(PETSC_BuildTwoSidedF, 0, 0, 0, 0));
498: PetscCall(PetscCommBuildTwoSidedGetType(comm, &buildtype));
499: switch (buildtype) {
500: case PETSC_BUILDTWOSIDED_IBARRIER:
501: #if PetscDefined(HAVE_MPI_NONBLOCKING_COLLECTIVES)
502: f = PetscCommBuildTwoSidedFReq_Ibarrier;
503: break;
504: #else
505: SETERRQ(comm, PETSC_ERR_PLIB, "MPI implementation does not provide MPI_Ibarrier (part of MPI-3)");
506: #endif
507: case PETSC_BUILDTWOSIDED_ALLREDUCE:
508: case PETSC_BUILDTWOSIDED_REDSCATTER:
509: f = PetscCommBuildTwoSidedFReq_Reference;
510: break;
511: default:
512: SETERRQ(comm, PETSC_ERR_PLIB, "Unknown method for building two-sided communication");
513: }
514: PetscCall((*f)(comm, count, dtype, nto, toranks, todata, nfrom, fromranks, fromdata, ntags, toreqs, fromreqs, send, recv, ctx));
515: PetscCall(PetscLogEventEnd(PETSC_BuildTwoSidedF, 0, 0, 0, 0));
516: PetscFunctionReturn(PETSC_SUCCESS);
517: }