Actual source code: subcomm.c
1: /*
2: Provides utility routines for split MPI communicator.
3: */
4: #include <petsc/private/petscimpl.h>
6: const char *const PetscSubcommTypes[] = {"GENERAL", "CONTIGUOUS", "INTERLACED", "PetscSubcommType", "PETSC_SUBCOMM_", NULL};
8: static PetscErrorCode PetscSubcommCreate_contiguous(PetscSubcomm);
9: static PetscErrorCode PetscSubcommCreate_interlaced(PetscSubcomm);
11: /*@
12: PetscSubcommSetFromOptions - Allows setting options for a `PetscSubcomm`
14: Collective
16: Input Parameter:
17: . psubcomm - `PetscSubcomm` context
19: Level: beginner
21: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`
22: @*/
23: PetscErrorCode PetscSubcommSetFromOptions(PetscSubcomm psubcomm)
24: {
25: PetscSubcommType type;
26: PetscBool flg;
28: PetscFunctionBegin;
29: PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "Must call PetscSubcommCreate first");
31: PetscOptionsBegin(psubcomm->parent, psubcomm->subcommprefix, "Options for PetscSubcomm", NULL);
32: PetscCall(PetscOptionsEnum("-psubcomm_type", NULL, NULL, PetscSubcommTypes, (PetscEnum)psubcomm->type, (PetscEnum *)&type, &flg));
33: if (flg && psubcomm->type != type) {
34: /* free old structures */
35: PetscCall(PetscCommDestroy(&(psubcomm)->dupparent));
36: PetscCall(PetscCommDestroy(&(psubcomm)->child));
37: PetscCall(PetscFree((psubcomm)->subsize));
38: switch (type) {
39: case PETSC_SUBCOMM_GENERAL:
40: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Runtime option PETSC_SUBCOMM_GENERAL is not supported, use PetscSubcommSetTypeGeneral()");
41: case PETSC_SUBCOMM_CONTIGUOUS:
42: PetscCall(PetscSubcommCreate_contiguous(psubcomm));
43: break;
44: case PETSC_SUBCOMM_INTERLACED:
45: PetscCall(PetscSubcommCreate_interlaced(psubcomm));
46: break;
47: default:
48: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "PetscSubcommType %s is not supported yet", PetscSubcommTypes[type]);
49: }
50: }
52: PetscCall(PetscOptionsName("-psubcomm_view", "Triggers display of PetscSubcomm context", "PetscSubcommView", &flg));
53: if (flg) PetscCall(PetscSubcommView(psubcomm, PETSC_VIEWER_STDOUT_(psubcomm->parent)));
54: PetscOptionsEnd();
55: PetscFunctionReturn(PETSC_SUCCESS);
56: }
58: /*@
59: PetscSubcommSetOptionsPrefix - Sets the prefix used for searching for options in the options database for this object
61: Logically Collective
63: Level: intermediate
65: Input Parameters:
66: + psubcomm - `PetscSubcomm` context
67: - pre - the prefix to prepend all `PetscSubcomm` item names with.
69: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`
70: @*/
71: PetscErrorCode PetscSubcommSetOptionsPrefix(PetscSubcomm psubcomm, const char pre[])
72: {
73: PetscFunctionBegin;
74: if (!pre) {
75: PetscCall(PetscFree(psubcomm->subcommprefix));
76: } else {
77: PetscCheck(pre[0] != '-', PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Options prefix should not begin with a hyphen");
78: PetscCall(PetscFree(psubcomm->subcommprefix));
79: PetscCall(PetscStrallocpy(pre, &psubcomm->subcommprefix));
80: }
81: PetscFunctionReturn(PETSC_SUCCESS);
82: }
84: /*@
85: PetscSubcommView - Views a `PetscSubcomm`
87: Collective
89: Input Parameters:
90: + psubcomm - `PetscSubcomm` context
91: - viewer - `PetscViewer` to display the information
93: Level: beginner
95: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`, `PetscViewer`
96: @*/
97: PetscErrorCode PetscSubcommView(PetscSubcomm psubcomm, PetscViewer viewer)
98: {
99: PetscBool isascii;
100: PetscViewerFormat format;
102: PetscFunctionBegin;
103: PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii));
104: PetscCheck(isascii, PETSC_COMM_SELF, PETSC_ERR_SUP, "Not supported yet");
105: PetscCall(PetscViewerGetFormat(viewer, &format));
106: if (format == PETSC_VIEWER_DEFAULT) {
107: MPI_Comm comm = psubcomm->parent;
108: PetscMPIInt rank, size, subsize, subrank, duprank;
110: PetscCallMPI(MPI_Comm_size(comm, &size));
111: PetscCall(PetscViewerASCIIPrintf(viewer, "PetscSubcomm type %s with total %d MPI processes:\n", PetscSubcommTypes[psubcomm->type], size));
112: PetscCallMPI(MPI_Comm_rank(comm, &rank));
113: PetscCallMPI(MPI_Comm_size(psubcomm->child, &subsize));
114: PetscCallMPI(MPI_Comm_rank(psubcomm->child, &subrank));
115: PetscCallMPI(MPI_Comm_rank(psubcomm->dupparent, &duprank));
116: PetscCall(PetscViewerASCIIPushSynchronized(viewer));
117: PetscCall(PetscViewerASCIISynchronizedPrintf(viewer, " [%d], color %d, sub-size %d, sub-rank %d, duprank %d\n", rank, psubcomm->color, subsize, subrank, duprank));
118: PetscCall(PetscViewerFlush(viewer));
119: PetscCall(PetscViewerASCIIPopSynchronized(viewer));
120: }
121: PetscFunctionReturn(PETSC_SUCCESS);
122: }
124: /*@
125: PetscSubcommSetNumber - Set total number of subcommunicators desired in the given `PetscSubcomm`
127: Collective
129: Input Parameters:
130: + psubcomm - `PetscSubcomm` context
131: - nsubcomm - the total number of subcommunicators in psubcomm
133: Level: advanced
135: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`, `PetscSubcommDestroy()`, `PetscSubcommSetType()`, `PetscSubcommSetTypeGeneral()`
136: @*/
137: PetscErrorCode PetscSubcommSetNumber(PetscSubcomm psubcomm, PetscInt nsubcomm)
138: {
139: MPI_Comm comm = psubcomm->parent;
140: PetscMPIInt msub, size;
142: PetscFunctionBegin;
143: PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "PetscSubcomm is not created. Call PetscSubcommCreate() first");
144: PetscCallMPI(MPI_Comm_size(comm, &size));
145: PetscCall(PetscMPIIntCast(nsubcomm, &msub));
146: PetscCheck(msub >= 1 && msub <= size, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Num of subcommunicators %d cannot be < 1 or > input comm size %d", msub, size);
148: psubcomm->n = msub;
149: PetscFunctionReturn(PETSC_SUCCESS);
150: }
152: /*@
153: PetscSubcommSetType - Set the way the original MPI communicator is divided up in the `PetscSubcomm`
155: Collective
157: Input Parameters:
158: + psubcomm - `PetscSubcomm` context
159: - subcommtype - `PetscSubcommType` `PETSC_SUBCOMM_CONTIGUOUS` or `PETSC_SUBCOMM_INTERLACED`
161: Level: advanced
163: .seealso: `PetscSubcommType`, `PETSC_SUBCOMM_CONTIGUOUS`, `PETSC_SUBCOMM_INTERLACED`,
164: `PetscSubcommCreate()`, `PetscSubcommDestroy()`, `PetscSubcommSetNumber()`, `PetscSubcommSetTypeGeneral()`
165: @*/
166: PetscErrorCode PetscSubcommSetType(PetscSubcomm psubcomm, PetscSubcommType subcommtype)
167: {
168: PetscFunctionBegin;
169: PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "PetscSubcomm is not created. Call PetscSubcommCreate()");
170: PetscCheck(psubcomm->n >= 1, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()", psubcomm->n);
172: if (subcommtype == PETSC_SUBCOMM_CONTIGUOUS) {
173: PetscCall(PetscSubcommCreate_contiguous(psubcomm));
174: } else if (subcommtype == PETSC_SUBCOMM_INTERLACED) {
175: PetscCall(PetscSubcommCreate_interlaced(psubcomm));
176: } else SETERRQ(psubcomm->parent, PETSC_ERR_SUP, "PetscSubcommType %s is not supported yet", PetscSubcommTypes[subcommtype]);
177: PetscFunctionReturn(PETSC_SUCCESS);
178: }
180: /*@
181: PetscSubcommSetTypeGeneral - Divides up a communicator based on a specific user's specification
183: Collective
185: Input Parameters:
186: + psubcomm - `PetscSubcomm` context
187: . color - control of subset assignment (nonnegative integer). Processes with the same color are in the same subcommunicator.
188: - subrank - rank in the subcommunicator
190: Level: advanced
192: .seealso: `PetscSubcommType`, `PETSC_SUBCOMM_CONTIGUOUS`, `PETSC_SUBCOMM_INTERLACED`, `PetscSubcommCreate()`, `PetscSubcommDestroy()`, `PetscSubcommSetNumber()`, `PetscSubcommSetType()`
193: @*/
194: PetscErrorCode PetscSubcommSetTypeGeneral(PetscSubcomm psubcomm, PetscMPIInt color, PetscMPIInt subrank)
195: {
196: MPI_Comm subcomm = 0, dupcomm = 0, comm = psubcomm->parent;
197: PetscMPIInt size, icolor, duprank, *recvbuf, sendbuf[3], mysubsize, rank, *subsize;
198: PetscMPIInt i, nsubcomm = psubcomm->n;
200: PetscFunctionBegin;
201: PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "PetscSubcomm is not created. Call PetscSubcommCreate()");
202: PetscCheck(nsubcomm >= 1, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()", nsubcomm);
204: PetscCallMPI(MPI_Comm_split(comm, color, subrank, &subcomm));
206: /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
207: /* TODO: this can be done in an ostensibly scalale way (i.e., without allocating an array of size 'size') as is done in PetscObjectsCreateGlobalOrdering(). */
208: PetscCallMPI(MPI_Comm_size(comm, &size));
209: PetscCall(PetscMalloc1(2 * size, &recvbuf));
211: PetscCallMPI(MPI_Comm_rank(comm, &rank));
212: PetscCallMPI(MPI_Comm_size(subcomm, &mysubsize));
214: sendbuf[0] = color;
215: sendbuf[1] = mysubsize;
216: PetscCallMPI(MPI_Allgather(sendbuf, 2, MPI_INT, recvbuf, 2, MPI_INT, comm));
218: PetscCall(PetscCalloc1(nsubcomm, &subsize));
219: for (i = 0; i < 2 * size; i += 2) subsize[recvbuf[i]] = recvbuf[i + 1];
220: PetscCall(PetscFree(recvbuf));
222: duprank = 0;
223: for (icolor = 0; icolor < nsubcomm; icolor++) {
224: if (icolor != color) { /* not color of this process */
225: duprank += subsize[icolor];
226: } else {
227: duprank += subrank;
228: break;
229: }
230: }
231: PetscCallMPI(MPI_Comm_split(comm, 0, duprank, &dupcomm));
233: PetscCall(PetscCommDuplicate(dupcomm, &psubcomm->dupparent, NULL));
234: PetscCall(PetscCommDuplicate(subcomm, &psubcomm->child, NULL));
235: PetscCallMPI(MPI_Comm_free(&dupcomm));
236: PetscCallMPI(MPI_Comm_free(&subcomm));
238: psubcomm->color = color;
239: psubcomm->subsize = subsize;
240: psubcomm->type = PETSC_SUBCOMM_GENERAL;
241: PetscFunctionReturn(PETSC_SUCCESS);
242: }
244: /*@
245: PetscSubcommDestroy - Destroys a `PetscSubcomm` object
247: Collective
249: Input Parameter:
250: . psubcomm - the `PetscSubcomm` context
252: Level: advanced
254: .seealso: `PetscSubcommCreate()`, `PetscSubcommSetType()`
255: @*/
256: PetscErrorCode PetscSubcommDestroy(PetscSubcomm *psubcomm)
257: {
258: PetscFunctionBegin;
259: if (!*psubcomm) PetscFunctionReturn(PETSC_SUCCESS);
260: PetscCall(PetscCommDestroy(&(*psubcomm)->dupparent));
261: PetscCall(PetscCommDestroy(&(*psubcomm)->child));
262: PetscCall(PetscFree((*psubcomm)->subsize));
263: PetscCall(PetscFree((*psubcomm)->subcommprefix));
264: PetscCall(PetscFree(*psubcomm));
265: PetscFunctionReturn(PETSC_SUCCESS);
266: }
268: /*@
269: PetscSubcommCreate - Create a `PetscSubcomm` context. This object is used to manage the division of a `MPI_Comm` into subcommunicators
271: Collective
273: Input Parameter:
274: . comm - MPI communicator
276: Output Parameter:
277: . psubcomm - location to store the `PetscSubcomm` context
279: Level: advanced
281: .seealso: `PetscSubcomm`, `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
282: `PetscSubcommSetNumber()`
283: @*/
284: PetscErrorCode PetscSubcommCreate(MPI_Comm comm, PetscSubcomm *psubcomm)
285: {
286: PetscMPIInt rank, size;
288: PetscFunctionBegin;
289: PetscCall(PetscNew(psubcomm));
291: /* set defaults */
292: PetscCallMPI(MPI_Comm_rank(comm, &rank));
293: PetscCallMPI(MPI_Comm_size(comm, &size));
295: (*psubcomm)->parent = comm;
296: (*psubcomm)->dupparent = comm;
297: (*psubcomm)->child = PETSC_COMM_SELF;
298: (*psubcomm)->n = size;
299: (*psubcomm)->color = rank;
300: (*psubcomm)->subsize = NULL;
301: (*psubcomm)->type = PETSC_SUBCOMM_INTERLACED;
302: PetscFunctionReturn(PETSC_SUCCESS);
303: }
305: /*@
306: PetscSubcommGetParent - Gets the communicator that was used to create the `PetscSubcomm`
308: Collective
310: Input Parameter:
311: . scomm - the `PetscSubcomm`
313: Output Parameter:
314: . pcomm - location to store the parent communicator
316: Level: intermediate
318: .seealso: `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
319: `PetscSubcommSetNumber()`, `PetscSubcommGetChild()`, `PetscSubcommContiguousParent()`
320: @*/
321: PetscErrorCode PetscSubcommGetParent(PetscSubcomm scomm, MPI_Comm *pcomm)
322: {
323: *pcomm = PetscSubcommParent(scomm);
324: return PETSC_SUCCESS;
325: }
327: /*@
328: PetscSubcommGetContiguousParent - Gets a communicator that is a duplicate of the parent but has the ranks
329: reordered by the order they are in the children
331: Collective
333: Input Parameter:
334: . scomm - the `PetscSubcomm`
336: Output Parameter:
337: . pcomm - location to store the parent communicator
339: Level: intermediate
341: .seealso: `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
342: `PetscSubcommSetNumber()`, `PetscSubcommGetChild()`, `PetscSubcommContiguousParent()`
343: @*/
344: PetscErrorCode PetscSubcommGetContiguousParent(PetscSubcomm scomm, MPI_Comm *pcomm)
345: {
346: *pcomm = PetscSubcommContiguousParent(scomm);
347: return PETSC_SUCCESS;
348: }
350: /*@
351: PetscSubcommGetChild - Gets the communicator created by the `PetscSubcomm`. This is part of one of the subcommunicators created by the `PetscSubcomm`
353: Collective
355: Input Parameter:
356: . scomm - the `PetscSubcomm`
358: Output Parameter:
359: . ccomm - location to store the child communicator
361: Level: intermediate
363: .seealso: `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
364: `PetscSubcommSetNumber()`, `PetscSubcommGetParent()`, `PetscSubcommContiguousParent()`
365: @*/
366: PetscErrorCode PetscSubcommGetChild(PetscSubcomm scomm, MPI_Comm *ccomm)
367: {
368: *ccomm = PetscSubcommChild(scomm);
369: return PETSC_SUCCESS;
370: }
372: static PetscErrorCode PetscSubcommCreate_contiguous(PetscSubcomm psubcomm)
373: {
374: PetscMPIInt rank, size, *subsize, duprank = -1, subrank = -1;
375: PetscMPIInt np_subcomm, nleftover, i, color = -1, rankstart, nsubcomm = psubcomm->n;
376: MPI_Comm subcomm = 0, dupcomm = 0, comm = psubcomm->parent;
378: PetscFunctionBegin;
379: PetscCallMPI(MPI_Comm_rank(comm, &rank));
380: PetscCallMPI(MPI_Comm_size(comm, &size));
382: /* get size of each subcommunicator */
383: PetscCall(PetscMalloc1(nsubcomm, &subsize));
385: np_subcomm = size / nsubcomm;
386: nleftover = size - nsubcomm * np_subcomm;
387: for (i = 0; i < nsubcomm; i++) {
388: subsize[i] = np_subcomm;
389: if (i < nleftover) subsize[i]++;
390: }
392: /* get color and subrank of this proc */
393: rankstart = 0;
394: for (i = 0; i < nsubcomm; i++) {
395: if (rank >= rankstart && rank < rankstart + subsize[i]) {
396: color = i;
397: subrank = rank - rankstart;
398: duprank = rank;
399: break;
400: } else rankstart += subsize[i];
401: }
403: PetscCallMPI(MPI_Comm_split(comm, color, subrank, &subcomm));
405: /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
406: PetscCallMPI(MPI_Comm_split(comm, 0, duprank, &dupcomm));
407: PetscCall(PetscCommDuplicate(dupcomm, &psubcomm->dupparent, NULL));
408: PetscCall(PetscCommDuplicate(subcomm, &psubcomm->child, NULL));
409: PetscCallMPI(MPI_Comm_free(&dupcomm));
410: PetscCallMPI(MPI_Comm_free(&subcomm));
412: psubcomm->color = color;
413: psubcomm->subsize = subsize;
414: psubcomm->type = PETSC_SUBCOMM_CONTIGUOUS;
415: PetscFunctionReturn(PETSC_SUCCESS);
416: }
418: /*
419: Note:
420: In PCREDUNDANT, to avoid data scattering from subcomm back to original comm, we create subcommunicators
421: by iteratively taking a process into a subcommunicator.
422: Example: size=4, nsubcomm=(*psubcomm)->n=3
423: comm=(*psubcomm)->parent:
424: rank: [0] [1] [2] [3]
425: color: 0 1 2 0
427: subcomm=(*psubcomm)->comm:
428: subrank: [0] [0] [0] [1]
430: dupcomm=(*psubcomm)->dupparent:
431: duprank: [0] [2] [3] [1]
433: Here, subcomm[color = 0] has subsize=2, owns process [0] and [3]
434: subcomm[color = 1] has subsize=1, owns process [1]
435: subcomm[color = 2] has subsize=1, owns process [2]
436: dupcomm has same number of processes as comm, and its duprank maps
437: processes in subcomm contiguously into a 1d array:
438: duprank: [0] [1] [2] [3]
439: rank: [0] [3] [1] [2]
440: subcomm[0] subcomm[1] subcomm[2]
441: */
443: static PetscErrorCode PetscSubcommCreate_interlaced(PetscSubcomm psubcomm)
444: {
445: PetscMPIInt rank, size, *subsize, duprank, subrank;
446: PetscMPIInt np_subcomm, nleftover, i, j, color, nsubcomm = psubcomm->n;
447: MPI_Comm subcomm = 0, dupcomm = 0, comm = psubcomm->parent;
449: PetscFunctionBegin;
450: PetscCallMPI(MPI_Comm_rank(comm, &rank));
451: PetscCallMPI(MPI_Comm_size(comm, &size));
453: /* get size of each subcommunicator */
454: PetscCall(PetscMalloc1(nsubcomm, &subsize));
456: np_subcomm = size / nsubcomm;
457: nleftover = size - nsubcomm * np_subcomm;
458: for (i = 0; i < nsubcomm; i++) {
459: subsize[i] = np_subcomm;
460: if (i < nleftover) subsize[i]++;
461: }
463: /* find color for this proc */
464: color = rank % nsubcomm;
465: subrank = rank / nsubcomm;
467: PetscCallMPI(MPI_Comm_split(comm, color, subrank, &subcomm));
469: j = 0;
470: duprank = 0;
471: for (i = 0; i < nsubcomm; i++) {
472: if (j == color) {
473: duprank += subrank;
474: break;
475: }
476: duprank += subsize[i];
477: j++;
478: }
480: /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
481: PetscCallMPI(MPI_Comm_split(comm, 0, duprank, &dupcomm));
482: PetscCall(PetscCommDuplicate(dupcomm, &psubcomm->dupparent, NULL));
483: PetscCall(PetscCommDuplicate(subcomm, &psubcomm->child, NULL));
484: PetscCallMPI(MPI_Comm_free(&dupcomm));
485: PetscCallMPI(MPI_Comm_free(&subcomm));
487: psubcomm->color = color;
488: psubcomm->subsize = subsize;
489: psubcomm->type = PETSC_SUBCOMM_INTERLACED;
490: PetscFunctionReturn(PETSC_SUCCESS);
491: }
493: /*@
494: PetscCommCreateNonempty - Creates a sub-communicator of the processes of a communicator that own data
496: Collective
498: Input Parameters:
499: + comm - the communicator to split
500: - ranges - the offset of the first datum owned by each process, of length one more than the size of
501: `comm`, and the same on every process
503: Output Parameter:
504: . subcomm - `comm` itself when every process owns data, `MPI_COMM_NULL` on a process that owns none,
505: and otherwise a new communicator of the processes that do
507: Level: developer
509: Notes:
510: Graph partitioning and ordering libraries such as ParMETIS and PT-SCOTCH require every process of
511: the communicator they are given to own at least one vertex. Building the distributed graph on the
512: communicator returned here, and doing nothing where it is `MPI_COMM_NULL`, meets that requirement
513: without altering the graph itself.
515: Release `subcomm` with `PetscCommDestroyNonempty()`, which frees it only when it is a new
516: communicator.
518: Because `ranges` is already known to every process, whether a split is needed is decided without
519: communicating, and no communicator is created when every process owns data. The processes of a new
520: `subcomm` keep their relative order in `comm`, so a contiguous layout stays contiguous, and
521: ascending, over `subcomm`.
523: .seealso: `PetscCommDestroyNonempty()`, `PetscCommDuplicate()`, `PetscSubcommCreate()`
524: @*/
525: PetscErrorCode PetscCommCreateNonempty(MPI_Comm comm, const PetscInt ranges[], MPI_Comm *subcomm)
526: {
527: PetscMPIInt p, rank, size;
528: PetscBool hasempty = PETSC_FALSE;
530: PetscFunctionBegin;
531: PetscAssertPointer(ranges, 2);
532: PetscAssertPointer(subcomm, 3);
533: PetscCallMPI(MPI_Comm_rank(comm, &rank));
534: PetscCallMPI(MPI_Comm_size(comm, &size));
535: for (p = 0; p < size; ++p) {
536: if (ranges[p + 1] == ranges[p]) {
537: hasempty = PETSC_TRUE;
538: break;
539: }
540: }
541: if (!hasempty) {
542: *subcomm = comm;
543: PetscFunctionReturn(PETSC_SUCCESS);
544: }
545: PetscCallMPI(MPI_Comm_split(comm, ranges[rank + 1] == ranges[rank] ? MPI_UNDEFINED : 0, rank, subcomm));
546: /* The MPI standard returns MPI_COMM_NULL for the color MPI_UNDEFINED, but MPIUNI's
547: MPI_Comm_split() ignores the color, so release the communicator it hands back instead. */
548: if (ranges[rank + 1] == ranges[rank] && *subcomm != MPI_COMM_NULL) PetscCallMPI(MPI_Comm_free(subcomm));
549: PetscFunctionReturn(PETSC_SUCCESS);
550: }
552: /*@
553: PetscCommDestroyNonempty - Releases a communicator obtained from `PetscCommCreateNonempty()`
555: Collective
557: Input Parameter:
558: . comm - the communicator that was split
560: Input/Output Parameter:
561: . subcomm - the communicator to release, set to `MPI_COMM_NULL`
563: Level: developer
565: Notes:
566: `PetscCommCreateNonempty()` returns `comm` itself when every process owns data, so `subcomm` is
567: freed only when it is a different communicator.
569: The only communication this performs is the `MPI_Comm_free()` of `subcomm`, so it is collective
570: over `subcomm`; `comm` serves only to recognize the case where no new communicator was created.
571: Every process of `subcomm` must call this. On a process where `subcomm` is `MPI_COMM_NULL` the call
572: does nothing, so it may be omitted there.
574: .seealso: `PetscCommCreateNonempty()`, `PetscCommDestroy()`
575: @*/
576: PetscErrorCode PetscCommDestroyNonempty(MPI_Comm comm, MPI_Comm *subcomm)
577: {
578: PetscFunctionBegin;
579: PetscAssertPointer(subcomm, 2);
580: if (*subcomm != comm && *subcomm != MPI_COMM_NULL) PetscCallMPI(MPI_Comm_free(subcomm));
581: *subcomm = MPI_COMM_NULL;
582: PetscFunctionReturn(PETSC_SUCCESS);
583: }