Actual source code: subcomm.c


  2: /*
  3:      Provides utility routines for split MPI communicator.
  4: */
  5: #include <petscsys.h>
  6: #include <petscviewer.h>

  8: const char *const PetscSubcommTypes[] = {"GENERAL", "CONTIGUOUS", "INTERLACED", "PetscSubcommType", "PETSC_SUBCOMM_", NULL};

 10: static PetscErrorCode PetscSubcommCreate_contiguous(PetscSubcomm);
 11: static PetscErrorCode PetscSubcommCreate_interlaced(PetscSubcomm);

 13: /*@
 14:    PetscSubcommSetFromOptions - Allows setting options for a `PetscSubcomm`

 16:    Collective

 18:    Input Parameter:
 19: .  psubcomm - `PetscSubcomm` context

 21:    Level: beginner

 23: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`
 24: @*/
 25: PetscErrorCode PetscSubcommSetFromOptions(PetscSubcomm psubcomm)
 26: {
 27:   PetscSubcommType type;
 28:   PetscBool        flg;

 30:   PetscFunctionBegin;
 31:   PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "Must call PetscSubcommCreate first");

 33:   PetscOptionsBegin(psubcomm->parent, psubcomm->subcommprefix, "Options for PetscSubcomm", NULL);
 34:   PetscCall(PetscOptionsEnum("-psubcomm_type", NULL, NULL, PetscSubcommTypes, (PetscEnum)psubcomm->type, (PetscEnum *)&type, &flg));
 35:   if (flg && psubcomm->type != type) {
 36:     /* free old structures */
 37:     PetscCall(PetscCommDestroy(&(psubcomm)->dupparent));
 38:     PetscCall(PetscCommDestroy(&(psubcomm)->child));
 39:     PetscCall(PetscFree((psubcomm)->subsize));
 40:     switch (type) {
 41:     case PETSC_SUBCOMM_GENERAL:
 42:       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Runtime option PETSC_SUBCOMM_GENERAL is not supported, use PetscSubcommSetTypeGeneral()");
 43:     case PETSC_SUBCOMM_CONTIGUOUS:
 44:       PetscCall(PetscSubcommCreate_contiguous(psubcomm));
 45:       break;
 46:     case PETSC_SUBCOMM_INTERLACED:
 47:       PetscCall(PetscSubcommCreate_interlaced(psubcomm));
 48:       break;
 49:     default:
 50:       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "PetscSubcommType %s is not supported yet", PetscSubcommTypes[type]);
 51:     }
 52:   }

 54:   PetscCall(PetscOptionsName("-psubcomm_view", "Triggers display of PetscSubcomm context", "PetscSubcommView", &flg));
 55:   if (flg) PetscCall(PetscSubcommView(psubcomm, PETSC_VIEWER_STDOUT_(psubcomm->parent)));
 56:   PetscOptionsEnd();
 57:   PetscFunctionReturn(PETSC_SUCCESS);
 58: }

 60: /*@C
 61:   PetscSubcommSetOptionsPrefix - Sets the prefix used for searching for options in the options database for this object

 63:   Logically Collective

 65:   Level: Intermediate

 67:   Input Parameters:
 68: +   psubcomm - `PetscSubcomm` context
 69: -   prefix - the prefix to prepend all `PetscSubcomm` item names with.

 71: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`
 72: @*/
 73: PetscErrorCode PetscSubcommSetOptionsPrefix(PetscSubcomm psubcomm, const char pre[])
 74: {
 75:   PetscFunctionBegin;
 76:   if (!pre) {
 77:     PetscCall(PetscFree(psubcomm->subcommprefix));
 78:   } else {
 79:     PetscCheck(pre[0] != '-', PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Options prefix should not begin with a hyphen");
 80:     PetscCall(PetscFree(psubcomm->subcommprefix));
 81:     PetscCall(PetscStrallocpy(pre, &(psubcomm->subcommprefix)));
 82:   }
 83:   PetscFunctionReturn(PETSC_SUCCESS);
 84: }

 86: /*@C
 87:    PetscSubcommView - Views a `PetscSubcomm`

 89:    Collective

 91:    Input Parameters:
 92: +  psubcomm - `PetscSubcomm` context
 93: -  viewer - `PetscViewer` to display the information

 95:    Level: beginner

 97: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`, `PetscViewer`
 98: @*/
 99: PetscErrorCode PetscSubcommView(PetscSubcomm psubcomm, PetscViewer viewer)
100: {
101:   PetscBool         iascii;
102:   PetscViewerFormat format;

104:   PetscFunctionBegin;
105:   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii));
106:   if (iascii) {
107:     PetscCall(PetscViewerGetFormat(viewer, &format));
108:     if (format == PETSC_VIEWER_DEFAULT) {
109:       MPI_Comm    comm = psubcomm->parent;
110:       PetscMPIInt rank, size, subsize, subrank, duprank;

112:       PetscCallMPI(MPI_Comm_size(comm, &size));
113:       PetscCall(PetscViewerASCIIPrintf(viewer, "PetscSubcomm type %s with total %d MPI processes:\n", PetscSubcommTypes[psubcomm->type], size));
114:       PetscCallMPI(MPI_Comm_rank(comm, &rank));
115:       PetscCallMPI(MPI_Comm_size(psubcomm->child, &subsize));
116:       PetscCallMPI(MPI_Comm_rank(psubcomm->child, &subrank));
117:       PetscCallMPI(MPI_Comm_rank(psubcomm->dupparent, &duprank));
118:       PetscCall(PetscViewerASCIIPushSynchronized(viewer));
119:       PetscCall(PetscViewerASCIISynchronizedPrintf(viewer, "  [%d], color %d, sub-size %d, sub-rank %d, duprank %d\n", rank, psubcomm->color, subsize, subrank, duprank));
120:       PetscCall(PetscViewerFlush(viewer));
121:       PetscCall(PetscViewerASCIIPopSynchronized(viewer));
122:     }
123:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Not supported yet");
124:   PetscFunctionReturn(PETSC_SUCCESS);
125: }

127: /*@
128:   PetscSubcommSetNumber - Set total number of subcommunicators desired in the given `PetscSubcomm`

130:    Collective

132:    Input Parameters:
133: +  psubcomm - `PetscSubcomm` context
134: -  nsubcomm - the total number of subcommunicators in psubcomm

136:    Level: advanced

138: .seealso: `PetscSubcomm`, `PetscSubcommCreate()`, `PetscSubcommDestroy()`, `PetscSubcommSetType()`, `PetscSubcommSetTypeGeneral()`
139: @*/
140: PetscErrorCode PetscSubcommSetNumber(PetscSubcomm psubcomm, PetscInt nsubcomm)
141: {
142:   MPI_Comm    comm = psubcomm->parent;
143:   PetscMPIInt msub, size;

145:   PetscFunctionBegin;
146:   PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "PetscSubcomm is not created. Call PetscSubcommCreate() first");
147:   PetscCallMPI(MPI_Comm_size(comm, &size));
148:   PetscCall(PetscMPIIntCast(nsubcomm, &msub));
149:   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);

151:   psubcomm->n = msub;
152:   PetscFunctionReturn(PETSC_SUCCESS);
153: }

155: /*@
156:   PetscSubcommSetType - Set the way the original MPI communicator is divided up in the `PetscSubcomm`

158:    Collective

160:    Input Parameters:
161: +  psubcomm - `PetscSubcomm` context
162: -  subcommtype - `PetscSubcommType` `PETSC_SUBCOMM_CONTIGUOUS` or `PETSC_SUBCOMM_INTERLACED`

164:    Level: advanced

166: .seealso: `PetscSubcommType`, `PETSC_SUBCOMM_CONTIGUOUS`, `PETSC_SUBCOMM_INTERLACED`,
167:           `PetscSubcommCreate()`, `PetscSubcommDestroy()`, `PetscSubcommSetNumber()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommType`
168: @*/
169: PetscErrorCode PetscSubcommSetType(PetscSubcomm psubcomm, PetscSubcommType subcommtype)
170: {
171:   PetscFunctionBegin;
172:   PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "PetscSubcomm is not created. Call PetscSubcommCreate()");
173:   PetscCheck(psubcomm->n >= 1, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()", psubcomm->n);

175:   if (subcommtype == PETSC_SUBCOMM_CONTIGUOUS) {
176:     PetscCall(PetscSubcommCreate_contiguous(psubcomm));
177:   } else if (subcommtype == PETSC_SUBCOMM_INTERLACED) {
178:     PetscCall(PetscSubcommCreate_interlaced(psubcomm));
179:   } else SETERRQ(psubcomm->parent, PETSC_ERR_SUP, "PetscSubcommType %s is not supported yet", PetscSubcommTypes[subcommtype]);
180:   PetscFunctionReturn(PETSC_SUCCESS);
181: }

183: /*@
184:   PetscSubcommSetTypeGeneral - Divides up a communicator based on a specific user's specification

186:    Collective

188:    Input Parameters:
189: +  psubcomm - `PetscSubcomm` context
190: .  color   - control of subset assignment (nonnegative integer). Processes with the same color are in the same subcommunicator.
191: -  subrank - rank in the subcommunicator

193:    Level: advanced

195: .seealso: `PetscSubcommType`, `PETSC_SUBCOMM_CONTIGUOUS`, `PETSC_SUBCOMM_INTERLACED`, `PetscSubcommCreate()`, `PetscSubcommDestroy()`, `PetscSubcommSetNumber()`, `PetscSubcommSetType()`
196: @*/
197: PetscErrorCode PetscSubcommSetTypeGeneral(PetscSubcomm psubcomm, PetscMPIInt color, PetscMPIInt subrank)
198: {
199:   MPI_Comm    subcomm = 0, dupcomm = 0, comm = psubcomm->parent;
200:   PetscMPIInt size, icolor, duprank, *recvbuf, sendbuf[3], mysubsize, rank, *subsize;
201:   PetscMPIInt i, nsubcomm = psubcomm->n;

203:   PetscFunctionBegin;
204:   PetscCheck(psubcomm, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "PetscSubcomm is not created. Call PetscSubcommCreate()");
205:   PetscCheck(nsubcomm >= 1, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()", nsubcomm);

207:   PetscCallMPI(MPI_Comm_split(comm, color, subrank, &subcomm));

209:   /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
210:   /* TODO: this can be done in an ostensibly scalale way (i.e., without allocating an array of size 'size') as is done in PetscObjectsCreateGlobalOrdering(). */
211:   PetscCallMPI(MPI_Comm_size(comm, &size));
212:   PetscCall(PetscMalloc1(2 * size, &recvbuf));

214:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
215:   PetscCallMPI(MPI_Comm_size(subcomm, &mysubsize));

217:   sendbuf[0] = color;
218:   sendbuf[1] = mysubsize;
219:   PetscCallMPI(MPI_Allgather(sendbuf, 2, MPI_INT, recvbuf, 2, MPI_INT, comm));

221:   PetscCall(PetscCalloc1(nsubcomm, &subsize));
222:   for (i = 0; i < 2 * size; i += 2) subsize[recvbuf[i]] = recvbuf[i + 1];
223:   PetscCall(PetscFree(recvbuf));

225:   duprank = 0;
226:   for (icolor = 0; icolor < nsubcomm; icolor++) {
227:     if (icolor != color) { /* not color of this process */
228:       duprank += subsize[icolor];
229:     } else {
230:       duprank += subrank;
231:       break;
232:     }
233:   }
234:   PetscCallMPI(MPI_Comm_split(comm, 0, duprank, &dupcomm));

236:   PetscCall(PetscCommDuplicate(dupcomm, &psubcomm->dupparent, NULL));
237:   PetscCall(PetscCommDuplicate(subcomm, &psubcomm->child, NULL));
238:   PetscCallMPI(MPI_Comm_free(&dupcomm));
239:   PetscCallMPI(MPI_Comm_free(&subcomm));

241:   psubcomm->color   = color;
242:   psubcomm->subsize = subsize;
243:   psubcomm->type    = PETSC_SUBCOMM_GENERAL;
244:   PetscFunctionReturn(PETSC_SUCCESS);
245: }

247: /*@
248:   PetscSubcommDestroy - Destroys a `PetscSubcomm` object

250:    Collective

252:    Input Parameter:
253:    .  psubcomm - the `PetscSubcomm` context

255:    Level: advanced

257: .seealso: `PetscSubcommCreate()`, `PetscSubcommSetType()`
258: @*/
259: PetscErrorCode PetscSubcommDestroy(PetscSubcomm *psubcomm)
260: {
261:   PetscFunctionBegin;
262:   if (!*psubcomm) PetscFunctionReturn(PETSC_SUCCESS);
263:   PetscCall(PetscCommDestroy(&(*psubcomm)->dupparent));
264:   PetscCall(PetscCommDestroy(&(*psubcomm)->child));
265:   PetscCall(PetscFree((*psubcomm)->subsize));
266:   if ((*psubcomm)->subcommprefix) PetscCall(PetscFree((*psubcomm)->subcommprefix));
267:   PetscCall(PetscFree((*psubcomm)));
268:   PetscFunctionReturn(PETSC_SUCCESS);
269: }

271: /*@
272:   PetscSubcommCreate - Create a `PetscSubcomm` context. This object is used to manage the division of a `MPI_Comm` into subcommunicators

274:    Collective

276:    Input Parameter:
277: .  comm - MPI communicator

279:    Output Parameter:
280: .  psubcomm - location to store the `PetscSubcomm` context

282:    Level: advanced

284: .seealso: `PetscSubcomm`, `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
285:           `PetscSubcommSetNumber()`
286: @*/
287: PetscErrorCode PetscSubcommCreate(MPI_Comm comm, PetscSubcomm *psubcomm)
288: {
289:   PetscMPIInt rank, size;

291:   PetscFunctionBegin;
292:   PetscCall(PetscNew(psubcomm));

294:   /* set defaults */
295:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
296:   PetscCallMPI(MPI_Comm_size(comm, &size));

298:   (*psubcomm)->parent    = comm;
299:   (*psubcomm)->dupparent = comm;
300:   (*psubcomm)->child     = PETSC_COMM_SELF;
301:   (*psubcomm)->n         = size;
302:   (*psubcomm)->color     = rank;
303:   (*psubcomm)->subsize   = NULL;
304:   (*psubcomm)->type      = PETSC_SUBCOMM_INTERLACED;
305:   PetscFunctionReturn(PETSC_SUCCESS);
306: }

308: /*@C
309:   PetscSubcommGetParent - Gets the communicator that was used to create the `PetscSubcomm`

311:    Collective

313:    Input Parameter:
314: .  scomm - the `PetscSubcomm`

316:    Output Parameter:
317: .  pcomm - location to store the parent communicator

319:    Level: intermediate

321: .seealso: `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
322:           `PetscSubcommSetNumber()`, `PetscSubcommGetChild()`, `PetscSubcommContiguousParent()`
323: @*/
324: PetscErrorCode PetscSubcommGetParent(PetscSubcomm scomm, MPI_Comm *pcomm)
325: {
326:   *pcomm = PetscSubcommParent(scomm);
327:   return PETSC_SUCCESS;
328: }

330: /*@C
331:   PetscSubcommGetContiguousParent - Gets a communicator that that is a duplicate of the parent but has the ranks
332:                                     reordered by the order they are in the children

334:    Collective

336:    Input Parameter:
337: .  scomm - the `PetscSubcomm`

339:    Output Parameter:
340: .  pcomm - location to store the parent communicator

342:    Level: intermediate

344: .seealso: `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
345:           `PetscSubcommSetNumber()`, `PetscSubcommGetChild()`, `PetscSubcommContiguousParent()`
346: @*/
347: PetscErrorCode PetscSubcommGetContiguousParent(PetscSubcomm scomm, MPI_Comm *pcomm)
348: {
349:   *pcomm = PetscSubcommContiguousParent(scomm);
350:   return PETSC_SUCCESS;
351: }

353: /*@C
354:   PetscSubcommGetChild - Gets the communicator created by the `PetscSubcomm`. This is part of one of the subcommunicators created by the `PetscSubcomm`

356:    Collective

358:    Input Parameter:
359: .  scomm - the `PetscSubcomm`

361:    Output Parameter:
362: .  ccomm - location to store the child communicator

364:    Level: intermediate

366: .seealso: `PetscSubcommDestroy()`, `PetscSubcommSetTypeGeneral()`, `PetscSubcommSetFromOptions()`, `PetscSubcommSetType()`,
367:           `PetscSubcommSetNumber()`, `PetscSubcommGetParent()`, `PetscSubcommContiguousParent()`
368: @*/
369: PetscErrorCode PetscSubcommGetChild(PetscSubcomm scomm, MPI_Comm *ccomm)
370: {
371:   *ccomm = PetscSubcommChild(scomm);
372:   return PETSC_SUCCESS;
373: }

375: static PetscErrorCode PetscSubcommCreate_contiguous(PetscSubcomm psubcomm)
376: {
377:   PetscMPIInt rank, size, *subsize, duprank = -1, subrank = -1;
378:   PetscMPIInt np_subcomm, nleftover, i, color = -1, rankstart, nsubcomm = psubcomm->n;
379:   MPI_Comm    subcomm = 0, dupcomm = 0, comm = psubcomm->parent;

381:   PetscFunctionBegin;
382:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
383:   PetscCallMPI(MPI_Comm_size(comm, &size));

385:   /* get size of each subcommunicator */
386:   PetscCall(PetscMalloc1(1 + nsubcomm, &subsize));

388:   np_subcomm = size / nsubcomm;
389:   nleftover  = size - nsubcomm * np_subcomm;
390:   for (i = 0; i < nsubcomm; i++) {
391:     subsize[i] = np_subcomm;
392:     if (i < nleftover) subsize[i]++;
393:   }

395:   /* get color and subrank of this proc */
396:   rankstart = 0;
397:   for (i = 0; i < nsubcomm; i++) {
398:     if (rank >= rankstart && rank < rankstart + subsize[i]) {
399:       color   = i;
400:       subrank = rank - rankstart;
401:       duprank = rank;
402:       break;
403:     } else rankstart += subsize[i];
404:   }

406:   PetscCallMPI(MPI_Comm_split(comm, color, subrank, &subcomm));

408:   /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
409:   PetscCallMPI(MPI_Comm_split(comm, 0, duprank, &dupcomm));
410:   PetscCall(PetscCommDuplicate(dupcomm, &psubcomm->dupparent, NULL));
411:   PetscCall(PetscCommDuplicate(subcomm, &psubcomm->child, NULL));
412:   PetscCallMPI(MPI_Comm_free(&dupcomm));
413:   PetscCallMPI(MPI_Comm_free(&subcomm));

415:   psubcomm->color   = color;
416:   psubcomm->subsize = subsize;
417:   psubcomm->type    = PETSC_SUBCOMM_CONTIGUOUS;
418:   PetscFunctionReturn(PETSC_SUCCESS);
419: }

421: /*
422:    Note:
423:    In PCREDUNDANT, to avoid data scattering from subcomm back to original comm, we create subcommunicators
424:    by iteratively taking a process into a subcommunicator.
425:    Example: size=4, nsubcomm=(*psubcomm)->n=3
426:      comm=(*psubcomm)->parent:
427:       rank:     [0]  [1]  [2]  [3]
428:       color:     0    1    2    0

430:      subcomm=(*psubcomm)->comm:
431:       subrank:  [0]  [0]  [0]  [1]

433:      dupcomm=(*psubcomm)->dupparent:
434:       duprank:  [0]  [2]  [3]  [1]

436:      Here, subcomm[color = 0] has subsize=2, owns process [0] and [3]
437:            subcomm[color = 1] has subsize=1, owns process [1]
438:            subcomm[color = 2] has subsize=1, owns process [2]
439:            dupcomm has same number of processes as comm, and its duprank maps
440:            processes in subcomm contiguously into a 1d array:
441:             duprank: [0] [1]      [2]         [3]
442:             rank:    [0] [3]      [1]         [2]
443:                     subcomm[0] subcomm[1]  subcomm[2]
444: */

446: static PetscErrorCode PetscSubcommCreate_interlaced(PetscSubcomm psubcomm)
447: {
448:   PetscMPIInt rank, size, *subsize, duprank, subrank;
449:   PetscMPIInt np_subcomm, nleftover, i, j, color, nsubcomm = psubcomm->n;
450:   MPI_Comm    subcomm = 0, dupcomm = 0, comm = psubcomm->parent;

452:   PetscFunctionBegin;
453:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
454:   PetscCallMPI(MPI_Comm_size(comm, &size));

456:   /* get size of each subcommunicator */
457:   PetscCall(PetscMalloc1(1 + nsubcomm, &subsize));

459:   np_subcomm = size / nsubcomm;
460:   nleftover  = size - nsubcomm * np_subcomm;
461:   for (i = 0; i < nsubcomm; i++) {
462:     subsize[i] = np_subcomm;
463:     if (i < nleftover) subsize[i]++;
464:   }

466:   /* find color for this proc */
467:   color   = rank % nsubcomm;
468:   subrank = rank / nsubcomm;

470:   PetscCallMPI(MPI_Comm_split(comm, color, subrank, &subcomm));

472:   j       = 0;
473:   duprank = 0;
474:   for (i = 0; i < nsubcomm; i++) {
475:     if (j == color) {
476:       duprank += subrank;
477:       break;
478:     }
479:     duprank += subsize[i];
480:     j++;
481:   }

483:   /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
484:   PetscCallMPI(MPI_Comm_split(comm, 0, duprank, &dupcomm));
485:   PetscCall(PetscCommDuplicate(dupcomm, &psubcomm->dupparent, NULL));
486:   PetscCall(PetscCommDuplicate(subcomm, &psubcomm->child, NULL));
487:   PetscCallMPI(MPI_Comm_free(&dupcomm));
488:   PetscCallMPI(MPI_Comm_free(&subcomm));

490:   psubcomm->color   = color;
491:   psubcomm->subsize = subsize;
492:   psubcomm->type    = PETSC_SUBCOMM_INTERLACED;
493:   PetscFunctionReturn(PETSC_SUCCESS);
494: }