Actual source code: subcomm.c
1: /*
2: Provides utility routines for split MPI communicator.
3: */
4: #include <petscsys.h>
5: #include <petscviewer.h>
7: const char *const PetscSubcommTypes[] = {"GENERAL", "CONTIGUOUS", "INTERLACED", "PetscSubcommType", "PETSC_SUBCOMM_", NULL};
9: static PetscErrorCode PetscSubcommCreate_contiguous(PetscSubcomm);
10: static PetscErrorCode PetscSubcommCreate_interlaced(PetscSubcomm);
12: /*@
13: PetscSubcommSetFromOptions - Allows setting options for a `PetscSubcomm`
15: Collective
17: Input Parameter:
18: . psubcomm - `PetscSubcomm` context
20: Level: beginner
22: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`
23: @*/
24: PetscErrorCode PetscSubcommSetFromOptions(PetscSubcomm psubcomm)
25: {
26: PetscSubcommType type;
27: PetscBool flg;
29: PetscFunctionBegin;
30: PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "Must call PetscSubcommCreate first");
32: PetscOptionsBegin(psubcomm->parent, psubcomm->subcommprefix, "Options for PetscSubcomm", NULL);
33: PetscCall(PetscOptionsEnum("-psubcomm_type", NULL, NULL, PetscSubcommTypes, (PetscEnum)psubcomm->type, (PetscEnum *)&type, &flg));
34: if (flg && psubcomm->type != type) {
35: /* free old structures */
36: PetscCall(PetscCommDestroy(&(psubcomm)->dupparent));
37: PetscCall(PetscCommDestroy(&(psubcomm)->child));
38: PetscCall(PetscFree((psubcomm)->subsize));
39: switch (type) {
40: case PETSC_SUBCOMM_GENERAL:
41: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Runtime option PETSC_SUBCOMM_GENERAL is not supported, use PetscSubcommSetTypeGeneral()");
42: case PETSC_SUBCOMM_CONTIGUOUS:
43: PetscCall(PetscSubcommCreate_contiguous(psubcomm));
44: break;
45: case PETSC_SUBCOMM_INTERLACED:
46: PetscCall(PetscSubcommCreate_interlaced(psubcomm));
47: break;
48: default:
49: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "PetscSubcommType %s is not supported yet", PetscSubcommTypes[type]);
50: }
51: }
53: PetscCall(PetscOptionsName("-psubcomm_view", "Triggers display of PetscSubcomm context", "PetscSubcommView", &flg));
54: if (flg) PetscCall(PetscSubcommView(psubcomm, PETSC_VIEWER_STDOUT_(psubcomm->parent)));
55: PetscOptionsEnd();
56: PetscFunctionReturn(PETSC_SUCCESS);
57: }
59: /*@
60: PetscSubcommSetOptionsPrefix - Sets the prefix used for searching for options in the options database for this object
62: Logically Collective
64: Level: intermediate
66: Input Parameters:
67: + psubcomm - `PetscSubcomm` context
68: - pre - the prefix to prepend all `PetscSubcomm` item names with.
70: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`
71: @*/
72: PetscErrorCode PetscSubcommSetOptionsPrefix(PetscSubcomm psubcomm, const char pre[])
73: {
74: PetscFunctionBegin;
75: if (!pre) {
76: PetscCall(PetscFree(psubcomm->subcommprefix));
77: } else {
78: PetscCheck(pre[0] != '-', PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Options prefix should not begin with a hyphen");
79: PetscCall(PetscFree(psubcomm->subcommprefix));
80: PetscCall(PetscStrallocpy(pre, &psubcomm->subcommprefix));
81: }
82: PetscFunctionReturn(PETSC_SUCCESS);
83: }
85: /*@
86: PetscSubcommView - Views a `PetscSubcomm`
88: Collective
90: Input Parameters:
91: + psubcomm - `PetscSubcomm` context
92: - viewer - `PetscViewer` to display the information
94: Level: beginner
96: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`, `PetscViewer`
97: @*/
98: PetscErrorCode PetscSubcommView(PetscSubcomm psubcomm, PetscViewer viewer)
99: {
100: PetscBool isascii;
101: PetscViewerFormat format;
103: PetscFunctionBegin;
104: PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii));
105: PetscCheck(isascii, PETSC_COMM_SELF, PETSC_ERR_SUP, "Not supported yet");
106: PetscCall(PetscViewerGetFormat(viewer, &format));
107: if (format == PETSC_VIEWER_DEFAULT) {
108: MPI_Comm comm = psubcomm->parent;
109: PetscMPIInt rank, size, subsize, subrank, duprank;
111: PetscCallMPI(MPI_Comm_size(comm, &size));
112: PetscCall(PetscViewerASCIIPrintf(viewer, "PetscSubcomm type %s with total %d MPI processes:\n", PetscSubcommTypes[psubcomm->type], size));
113: PetscCallMPI(MPI_Comm_rank(comm, &rank));
114: PetscCallMPI(MPI_Comm_size(psubcomm->child, &subsize));
115: PetscCallMPI(MPI_Comm_rank(psubcomm->child, &subrank));
116: PetscCallMPI(MPI_Comm_rank(psubcomm->dupparent, &duprank));
117: PetscCall(PetscViewerASCIIPushSynchronized(viewer));
118: PetscCall(PetscViewerASCIISynchronizedPrintf(viewer, " [%d], color %d, sub-size %d, sub-rank %d, duprank %d\n", rank, psubcomm->color, subsize, subrank, duprank));
119: PetscCall(PetscViewerFlush(viewer));
120: PetscCall(PetscViewerASCIIPopSynchronized(viewer));
121: }
122: PetscFunctionReturn(PETSC_SUCCESS);
123: }
125: /*@
126: PetscSubcommSetNumber - Set total number of subcommunicators desired in the given `PetscSubcomm`
128: Collective
130: Input Parameters:
131: + psubcomm - `PetscSubcomm` context
132: - nsubcomm - the total number of subcommunicators in psubcomm
134: Level: advanced
136: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`, `PetscSubcommDestroy()`, `PetscSubcommSetType()`, `PetscSubcommSetTypeGeneral()`
137: @*/
138: PetscErrorCode PetscSubcommSetNumber(PetscSubcomm psubcomm, PetscInt nsubcomm)
139: {
140: MPI_Comm comm = psubcomm->parent;
141: PetscMPIInt msub, size;
143: PetscFunctionBegin;
144: PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "PetscSubcomm is not created. Call PetscSubcommCreate() first");
145: PetscCallMPI(MPI_Comm_size(comm, &size));
146: PetscCall(PetscMPIIntCast(nsubcomm, &msub));
147: 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);
149: psubcomm->n = msub;
150: PetscFunctionReturn(PETSC_SUCCESS);
151: }
153: /*@
154: PetscSubcommSetType - Set the way the original MPI communicator is divided up in the `PetscSubcomm`
156: Collective
158: Input Parameters:
159: + psubcomm - `PetscSubcomm` context
160: - subcommtype - `PetscSubcommType` `PETSC_SUBCOMM_CONTIGUOUS` or `PETSC_SUBCOMM_INTERLACED`
162: Level: advanced
164: .seealso: `PetscSubcommType`, `PETSC_SUBCOMM_CONTIGUOUS`, `PETSC_SUBCOMM_INTERLACED`,
165: `PetscSubcommCreate()`, `PetscSubcommDestroy()`, `PetscSubcommSetNumber()`, `PetscSubcommSetTypeGeneral()`
166: @*/
167: PetscErrorCode PetscSubcommSetType(PetscSubcomm psubcomm, PetscSubcommType subcommtype)
168: {
169: PetscFunctionBegin;
170: PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "PetscSubcomm is not created. Call PetscSubcommCreate()");
171: PetscCheck(psubcomm->n >= 1, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()", psubcomm->n);
173: if (subcommtype == PETSC_SUBCOMM_CONTIGUOUS) {
174: PetscCall(PetscSubcommCreate_contiguous(psubcomm));
175: } else if (subcommtype == PETSC_SUBCOMM_INTERLACED) {
176: PetscCall(PetscSubcommCreate_interlaced(psubcomm));
177: } else SETERRQ(psubcomm->parent, PETSC_ERR_SUP, "PetscSubcommType %s is not supported yet", PetscSubcommTypes[subcommtype]);
178: PetscFunctionReturn(PETSC_SUCCESS);
179: }
181: /*@
182: PetscSubcommSetTypeGeneral - Divides up a communicator based on a specific user's specification
184: Collective
186: Input Parameters:
187: + psubcomm - `PetscSubcomm` context
188: . color - control of subset assignment (nonnegative integer). Processes with the same color are in the same subcommunicator.
189: - subrank - rank in the subcommunicator
191: Level: advanced
193: .seealso: `PetscSubcommType`, `PETSC_SUBCOMM_CONTIGUOUS`, `PETSC_SUBCOMM_INTERLACED`, `PetscSubcommCreate()`, `PetscSubcommDestroy()`, `PetscSubcommSetNumber()`, `PetscSubcommSetType()`
194: @*/
195: PetscErrorCode PetscSubcommSetTypeGeneral(PetscSubcomm psubcomm, PetscMPIInt color, PetscMPIInt subrank)
196: {
197: MPI_Comm subcomm = 0, dupcomm = 0, comm = psubcomm->parent;
198: PetscMPIInt size, icolor, duprank, *recvbuf, sendbuf[3], mysubsize, rank, *subsize;
199: PetscMPIInt i, nsubcomm = psubcomm->n;
201: PetscFunctionBegin;
202: PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "PetscSubcomm is not created. Call PetscSubcommCreate()");
203: PetscCheck(nsubcomm >= 1, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()", nsubcomm);
205: PetscCallMPI(MPI_Comm_split(comm, color, subrank, &subcomm));
207: /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
208: /* TODO: this can be done in an ostensibly scalale way (i.e., without allocating an array of size 'size') as is done in PetscObjectsCreateGlobalOrdering(). */
209: PetscCallMPI(MPI_Comm_size(comm, &size));
210: PetscCall(PetscMalloc1(2 * size, &recvbuf));
212: PetscCallMPI(MPI_Comm_rank(comm, &rank));
213: PetscCallMPI(MPI_Comm_size(subcomm, &mysubsize));
215: sendbuf[0] = color;
216: sendbuf[1] = mysubsize;
217: PetscCallMPI(MPI_Allgather(sendbuf, 2, MPI_INT, recvbuf, 2, MPI_INT, comm));
219: PetscCall(PetscCalloc1(nsubcomm, &subsize));
220: for (i = 0; i < 2 * size; i += 2) subsize[recvbuf[i]] = recvbuf[i + 1];
221: PetscCall(PetscFree(recvbuf));
223: duprank = 0;
224: for (icolor = 0; icolor < nsubcomm; icolor++) {
225: if (icolor != color) { /* not color of this process */
226: duprank += subsize[icolor];
227: } else {
228: duprank += subrank;
229: break;
230: }
231: }
232: PetscCallMPI(MPI_Comm_split(comm, 0, duprank, &dupcomm));
234: PetscCall(PetscCommDuplicate(dupcomm, &psubcomm->dupparent, NULL));
235: PetscCall(PetscCommDuplicate(subcomm, &psubcomm->child, NULL));
236: PetscCallMPI(MPI_Comm_free(&dupcomm));
237: PetscCallMPI(MPI_Comm_free(&subcomm));
239: psubcomm->color = color;
240: psubcomm->subsize = subsize;
241: psubcomm->type = PETSC_SUBCOMM_GENERAL;
242: PetscFunctionReturn(PETSC_SUCCESS);
243: }
245: /*@
246: PetscSubcommDestroy - Destroys a `PetscSubcomm` object
248: Collective
250: Input Parameter:
251: . psubcomm - the `PetscSubcomm` context
253: Level: advanced
255: .seealso: `PetscSubcommCreate()`, `PetscSubcommSetType()`
256: @*/
257: PetscErrorCode PetscSubcommDestroy(PetscSubcomm *psubcomm)
258: {
259: PetscFunctionBegin;
260: if (!*psubcomm) PetscFunctionReturn(PETSC_SUCCESS);
261: PetscCall(PetscCommDestroy(&(*psubcomm)->dupparent));
262: PetscCall(PetscCommDestroy(&(*psubcomm)->child));
263: PetscCall(PetscFree((*psubcomm)->subsize));
264: if ((*psubcomm)->subcommprefix) PetscCall(PetscFree((*psubcomm)->subcommprefix));
265: PetscCall(PetscFree(*psubcomm));
266: PetscFunctionReturn(PETSC_SUCCESS);
267: }
269: /*@
270: PetscSubcommCreate - Create a `PetscSubcomm` context. This object is used to manage the division of a `MPI_Comm` into subcommunicators
272: Collective
274: Input Parameter:
275: . comm - MPI communicator
277: Output Parameter:
278: . psubcomm - location to store the `PetscSubcomm` context
280: Level: advanced
282: .seealso: `PetscSubcomm`, `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
283: `PetscSubcommSetNumber()`
284: @*/
285: PetscErrorCode PetscSubcommCreate(MPI_Comm comm, PetscSubcomm *psubcomm)
286: {
287: PetscMPIInt rank, size;
289: PetscFunctionBegin;
290: PetscCall(PetscNew(psubcomm));
292: /* set defaults */
293: PetscCallMPI(MPI_Comm_rank(comm, &rank));
294: PetscCallMPI(MPI_Comm_size(comm, &size));
296: (*psubcomm)->parent = comm;
297: (*psubcomm)->dupparent = comm;
298: (*psubcomm)->child = PETSC_COMM_SELF;
299: (*psubcomm)->n = size;
300: (*psubcomm)->color = rank;
301: (*psubcomm)->subsize = NULL;
302: (*psubcomm)->type = PETSC_SUBCOMM_INTERLACED;
303: PetscFunctionReturn(PETSC_SUCCESS);
304: }
306: /*@C
307: PetscSubcommGetParent - Gets the communicator that was used to create the `PetscSubcomm`
309: Collective
311: Input Parameter:
312: . scomm - the `PetscSubcomm`
314: Output Parameter:
315: . pcomm - location to store the parent communicator
317: Level: intermediate
319: .seealso: `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
320: `PetscSubcommSetNumber()`, `PetscSubcommGetChild()`, `PetscSubcommContiguousParent()`
321: @*/
322: PetscErrorCode PetscSubcommGetParent(PetscSubcomm scomm, MPI_Comm *pcomm)
323: {
324: *pcomm = PetscSubcommParent(scomm);
325: return PETSC_SUCCESS;
326: }
328: /*@C
329: PetscSubcommGetContiguousParent - Gets a communicator that is a duplicate of the parent but has the ranks
330: reordered by the order they are in the children
332: Collective
334: Input Parameter:
335: . scomm - the `PetscSubcomm`
337: Output Parameter:
338: . pcomm - location to store the parent communicator
340: Level: intermediate
342: .seealso: `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
343: `PetscSubcommSetNumber()`, `PetscSubcommGetChild()`, `PetscSubcommContiguousParent()`
344: @*/
345: PetscErrorCode PetscSubcommGetContiguousParent(PetscSubcomm scomm, MPI_Comm *pcomm)
346: {
347: *pcomm = PetscSubcommContiguousParent(scomm);
348: return PETSC_SUCCESS;
349: }
351: /*@C
352: PetscSubcommGetChild - Gets the communicator created by the `PetscSubcomm`. This is part of one of the subcommunicators created by the `PetscSubcomm`
354: Collective
356: Input Parameter:
357: . scomm - the `PetscSubcomm`
359: Output Parameter:
360: . ccomm - location to store the child communicator
362: Level: intermediate
364: .seealso: `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
365: `PetscSubcommSetNumber()`, `PetscSubcommGetParent()`, `PetscSubcommContiguousParent()`
366: @*/
367: PetscErrorCode PetscSubcommGetChild(PetscSubcomm scomm, MPI_Comm *ccomm)
368: {
369: *ccomm = PetscSubcommChild(scomm);
370: return PETSC_SUCCESS;
371: }
373: static PetscErrorCode PetscSubcommCreate_contiguous(PetscSubcomm psubcomm)
374: {
375: PetscMPIInt rank, size, *subsize, duprank = -1, subrank = -1;
376: PetscMPIInt np_subcomm, nleftover, i, color = -1, rankstart, nsubcomm = psubcomm->n;
377: MPI_Comm subcomm = 0, dupcomm = 0, comm = psubcomm->parent;
379: PetscFunctionBegin;
380: PetscCallMPI(MPI_Comm_rank(comm, &rank));
381: PetscCallMPI(MPI_Comm_size(comm, &size));
383: /* get size of each subcommunicator */
384: PetscCall(PetscMalloc1(1 + nsubcomm, &subsize));
386: np_subcomm = size / nsubcomm;
387: nleftover = size - nsubcomm * np_subcomm;
388: for (i = 0; i < nsubcomm; i++) {
389: subsize[i] = np_subcomm;
390: if (i < nleftover) subsize[i]++;
391: }
393: /* get color and subrank of this proc */
394: rankstart = 0;
395: for (i = 0; i < nsubcomm; i++) {
396: if (rank >= rankstart && rank < rankstart + subsize[i]) {
397: color = i;
398: subrank = rank - rankstart;
399: duprank = rank;
400: break;
401: } else rankstart += subsize[i];
402: }
404: PetscCallMPI(MPI_Comm_split(comm, color, subrank, &subcomm));
406: /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
407: PetscCallMPI(MPI_Comm_split(comm, 0, duprank, &dupcomm));
408: PetscCall(PetscCommDuplicate(dupcomm, &psubcomm->dupparent, NULL));
409: PetscCall(PetscCommDuplicate(subcomm, &psubcomm->child, NULL));
410: PetscCallMPI(MPI_Comm_free(&dupcomm));
411: PetscCallMPI(MPI_Comm_free(&subcomm));
413: psubcomm->color = color;
414: psubcomm->subsize = subsize;
415: psubcomm->type = PETSC_SUBCOMM_CONTIGUOUS;
416: PetscFunctionReturn(PETSC_SUCCESS);
417: }
419: /*
420: Note:
421: In PCREDUNDANT, to avoid data scattering from subcomm back to original comm, we create subcommunicators
422: by iteratively taking a process into a subcommunicator.
423: Example: size=4, nsubcomm=(*psubcomm)->n=3
424: comm=(*psubcomm)->parent:
425: rank: [0] [1] [2] [3]
426: color: 0 1 2 0
428: subcomm=(*psubcomm)->comm:
429: subrank: [0] [0] [0] [1]
431: dupcomm=(*psubcomm)->dupparent:
432: duprank: [0] [2] [3] [1]
434: Here, subcomm[color = 0] has subsize=2, owns process [0] and [3]
435: subcomm[color = 1] has subsize=1, owns process [1]
436: subcomm[color = 2] has subsize=1, owns process [2]
437: dupcomm has same number of processes as comm, and its duprank maps
438: processes in subcomm contiguously into a 1d array:
439: duprank: [0] [1] [2] [3]
440: rank: [0] [3] [1] [2]
441: subcomm[0] subcomm[1] subcomm[2]
442: */
444: static PetscErrorCode PetscSubcommCreate_interlaced(PetscSubcomm psubcomm)
445: {
446: PetscMPIInt rank, size, *subsize, duprank, subrank;
447: PetscMPIInt np_subcomm, nleftover, i, j, color, nsubcomm = psubcomm->n;
448: MPI_Comm subcomm = 0, dupcomm = 0, comm = psubcomm->parent;
450: PetscFunctionBegin;
451: PetscCallMPI(MPI_Comm_rank(comm, &rank));
452: PetscCallMPI(MPI_Comm_size(comm, &size));
454: /* get size of each subcommunicator */
455: PetscCall(PetscMalloc1(1 + nsubcomm, &subsize));
457: np_subcomm = size / nsubcomm;
458: nleftover = size - nsubcomm * np_subcomm;
459: for (i = 0; i < nsubcomm; i++) {
460: subsize[i] = np_subcomm;
461: if (i < nleftover) subsize[i]++;
462: }
464: /* find color for this proc */
465: color = rank % nsubcomm;
466: subrank = rank / nsubcomm;
468: PetscCallMPI(MPI_Comm_split(comm, color, subrank, &subcomm));
470: j = 0;
471: duprank = 0;
472: for (i = 0; i < nsubcomm; i++) {
473: if (j == color) {
474: duprank += subrank;
475: break;
476: }
477: duprank += subsize[i];
478: j++;
479: }
481: /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
482: PetscCallMPI(MPI_Comm_split(comm, 0, duprank, &dupcomm));
483: PetscCall(PetscCommDuplicate(dupcomm, &psubcomm->dupparent, NULL));
484: PetscCall(PetscCommDuplicate(subcomm, &psubcomm->child, NULL));
485: PetscCallMPI(MPI_Comm_free(&dupcomm));
486: PetscCallMPI(MPI_Comm_free(&subcomm));
488: psubcomm->color = color;
489: psubcomm->subsize = subsize;
490: psubcomm->type = PETSC_SUBCOMM_INTERLACED;
491: PetscFunctionReturn(PETSC_SUCCESS);
492: }