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 from a PetscSubcomm

     16:    Collective on PetscSubcomm

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

     21:    Level: beginner

     23: @*/
     24: PetscErrorCode PetscSubcommSetFromOptions(PetscSubcomm psubcomm)
     25: {
     26:   PetscErrorCode   ierr;
     27:   PetscSubcommType type;
     28:   PetscBool        flg;

     31:   if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Must call PetscSubcommCreate firt");

     33:   PetscOptionsBegin(psubcomm->parent,psubcomm->subcommprefix,"Options for PetscSubcomm",NULL);
     34:   PetscOptionsEnum("-psubcomm_type",NULL,NULL,PetscSubcommTypes,(PetscEnum)psubcomm->type,(PetscEnum*)&type,&flg);
     35:   if (flg && psubcomm->type != type) {
     36:     /* free old structures */
     37:     PetscCommDestroy(&(psubcomm)->dupparent);
     38:     PetscCommDestroy(&(psubcomm)->child);
     39:     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:       PetscSubcommCreate_contiguous(psubcomm);
     45:       break;
     46:     case PETSC_SUBCOMM_INTERLACED:
     47:       PetscSubcommCreate_interlaced(psubcomm);
     48:       break;
     49:     default:
     50:       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"PetscSubcommType %s is not supported yet",PetscSubcommTypes[type]);
     51:     }
     52:   }

     54:   PetscOptionsName("-psubcomm_view","Triggers display of PetscSubcomm context","PetscSubcommView",&flg);
     55:   if (flg) {
     56:     PetscSubcommView(psubcomm,PETSC_VIEWER_STDOUT_(psubcomm->parent));
     57:   }
     58:   PetscOptionsEnd();
     59:   return(0);
     60: }

     62: /*@C
     63:   PetscSubcommSetOptionsPrefix - Sets the prefix used for searching for all
     64:   PetscSubcomm items in the options database.

     66:   Logically collective on PetscSubcomm.

     68:   Level: Intermediate

     70:   Input Parameters:
     71: +   psubcomm - PetscSubcomm context
     72: -   prefix - the prefix to prepend all PetscSubcomm item names with.

     74: @*/
     75: PetscErrorCode PetscSubcommSetOptionsPrefix(PetscSubcomm psubcomm,const char pre[])
     76: {
     77:   PetscErrorCode   ierr;

     80:    if (!pre) {
     81:     PetscFree(psubcomm->subcommprefix);
     82:   } else {
     83:     if (pre[0] == '-') SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Options prefix should not begin with a hypen");
     84:     PetscFree(psubcomm->subcommprefix);
     85:     PetscStrallocpy(pre,&(psubcomm->subcommprefix));
     86:   }
     87:   return(0);
     88: }

     90: /*@C
     91:    PetscSubcommView - Views a PetscSubcomm of values as either ASCII text or a binary file

     93:    Collective on PetscSubcomm

     95:    Input Parameter:
     96: +  psubcomm - PetscSubcomm context
     97: -  viewer - location to view the values

     99:    Level: beginner
    100: @*/
    101: PetscErrorCode PetscSubcommView(PetscSubcomm psubcomm,PetscViewer viewer)
    102: {
    103:   PetscErrorCode    ierr;
    104:   PetscBool         iascii;
    105:   PetscViewerFormat format;

    108:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
    109:   if (iascii) {
    110:     PetscViewerGetFormat(viewer,&format);
    111:     if (format == PETSC_VIEWER_DEFAULT) {
    112:       MPI_Comm    comm=psubcomm->parent;
    113:       PetscMPIInt rank,size,subsize,subrank,duprank;

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

    130: /*@
    131:   PetscSubcommSetNumber - Set total number of subcommunicators.

    133:    Collective

    135:    Input Parameter:
    136: +  psubcomm - PetscSubcomm context
    137: -  nsubcomm - the total number of subcommunicators in psubcomm

    139:    Level: advanced

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

    150:   if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"PetscSubcomm is not created. Call PetscSubcommCreate() first");
    151:   MPI_Comm_size(comm,&size);
    152:   PetscMPIIntCast(nsubcomm,&msub);
    153:   if (msub < 1 || msub > size) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE, "Num of subcommunicators %d cannot be < 1 or > input comm size %d",msub,size);

    155:   psubcomm->n = msub;
    156:   return(0);
    157: }

    159: /*@
    160:   PetscSubcommSetType - Set type of subcommunicators.

    162:    Collective

    164:    Input Parameter:
    165: +  psubcomm - PetscSubcomm context
    166: -  subcommtype - subcommunicator type, PETSC_SUBCOMM_CONTIGUOUS,PETSC_SUBCOMM_INTERLACED

    168:    Level: advanced

    170: .seealso: PetscSubcommCreate(),PetscSubcommDestroy(),PetscSubcommSetNumber(),PetscSubcommSetTypeGeneral(), PetscSubcommType
    171: @*/
    172: PetscErrorCode  PetscSubcommSetType(PetscSubcomm psubcomm,PetscSubcommType subcommtype)
    173: {

    177:   if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"PetscSubcomm is not created. Call PetscSubcommCreate()");
    178:   if (psubcomm->n < 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()",psubcomm->n);

    180:   if (subcommtype == PETSC_SUBCOMM_CONTIGUOUS) {
    181:     PetscSubcommCreate_contiguous(psubcomm);
    182:   } else if (subcommtype == PETSC_SUBCOMM_INTERLACED) {
    183:     PetscSubcommCreate_interlaced(psubcomm);
    184:   } else SETERRQ1(psubcomm->parent,PETSC_ERR_SUP,"PetscSubcommType %s is not supported yet",PetscSubcommTypes[subcommtype]);
    185:   return(0);
    186: }

    188: /*@
    189:   PetscSubcommSetTypeGeneral - Set a PetscSubcomm from user's specifications

    191:    Collective

    193:    Input Parameter:
    194: +  psubcomm - PetscSubcomm context
    195: .  color   - control of subset assignment (nonnegative integer). Processes with the same color are in the same subcommunicator.
    196: -  subrank - rank in the subcommunicator

    198:    Level: advanced

    200: .seealso: PetscSubcommCreate(),PetscSubcommDestroy(),PetscSubcommSetNumber(),PetscSubcommSetType()
    201: @*/
    202: PetscErrorCode PetscSubcommSetTypeGeneral(PetscSubcomm psubcomm,PetscMPIInt color,PetscMPIInt subrank)
    203: {
    205:   MPI_Comm       subcomm=0,dupcomm=0,comm=psubcomm->parent;
    206:   PetscMPIInt    size,icolor,duprank,*recvbuf,sendbuf[3],mysubsize,rank,*subsize;
    207:   PetscMPIInt    i,nsubcomm=psubcomm->n;

    210:   if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"PetscSubcomm is not created. Call PetscSubcommCreate()");
    211:   if (nsubcomm < 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()",nsubcomm);

    213:   MPI_Comm_split(comm,color,subrank,&subcomm);

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

    220:   MPI_Comm_rank(comm,&rank);
    221:   MPI_Comm_size(subcomm,&mysubsize);

    223:   sendbuf[0] = color;
    224:   sendbuf[1] = mysubsize;
    225:   MPI_Allgather(sendbuf,2,MPI_INT,recvbuf,2,MPI_INT,comm);

    227:   PetscCalloc1(nsubcomm,&subsize);
    228:   for (i=0; i<2*size; i+=2) {
    229:     subsize[recvbuf[i]] = recvbuf[i+1];
    230:   }
    231:   PetscFree(recvbuf);

    233:   duprank = 0;
    234:   for (icolor=0; icolor<nsubcomm; icolor++) {
    235:     if (icolor != color) { /* not color of this process */
    236:       duprank += subsize[icolor];
    237:     } else {
    238:       duprank += subrank;
    239:       break;
    240:     }
    241:   }
    242:   MPI_Comm_split(comm,0,duprank,&dupcomm);

    244:   PetscCommDuplicate(dupcomm,&psubcomm->dupparent,NULL);
    245:   PetscCommDuplicate(subcomm,&psubcomm->child,NULL);
    246:   MPI_Comm_free(&dupcomm);
    247:   MPI_Comm_free(&subcomm);

    249:   psubcomm->color   = color;
    250:   psubcomm->subsize = subsize;
    251:   psubcomm->type    = PETSC_SUBCOMM_GENERAL;
    252:   return(0);
    253: }

    255: /*@
    256:   PetscSubcommDestroy - Destroys a PetscSubcomm object

    258:    Collective on PetscSubcomm

    260:    Input Parameter:
    261:    .  psubcomm - the PetscSubcomm context

    263:    Level: advanced

    265: .seealso: PetscSubcommCreate(),PetscSubcommSetType()
    266: @*/
    267: PetscErrorCode  PetscSubcommDestroy(PetscSubcomm *psubcomm)
    268: {

    272:   if (!*psubcomm) return(0);
    273:   PetscCommDestroy(&(*psubcomm)->dupparent);
    274:   PetscCommDestroy(&(*psubcomm)->child);
    275:   PetscFree((*psubcomm)->subsize);
    276:   if ((*psubcomm)->subcommprefix) { PetscFree((*psubcomm)->subcommprefix); }
    277:   PetscFree((*psubcomm));
    278:   return(0);
    279: }

    281: /*@
    282:   PetscSubcommCreate - Create a PetscSubcomm context.

    284:    Collective

    286:    Input Parameter:
    287: .  comm - MPI communicator

    289:    Output Parameter:
    290: .  psubcomm - location to store the PetscSubcomm context

    292:    Level: advanced

    294: .seealso: PetscSubcommDestroy(), PetscSubcommSetTypeGeneral(), PetscSubcommSetFromOptions(), PetscSubcommSetType(),
    295:           PetscSubcommSetNumber()
    296: @*/
    297: PetscErrorCode  PetscSubcommCreate(MPI_Comm comm,PetscSubcomm *psubcomm)
    298: {
    300:   PetscMPIInt    rank,size;

    303:   PetscNew(psubcomm);

    305:   /* set defaults */
    306:   MPI_Comm_rank(comm,&rank);
    307:   MPI_Comm_size(comm,&size);

    309:   (*psubcomm)->parent    = comm;
    310:   (*psubcomm)->dupparent = comm;
    311:   (*psubcomm)->child     = PETSC_COMM_SELF;
    312:   (*psubcomm)->n         = size;
    313:   (*psubcomm)->color     = rank;
    314:   (*psubcomm)->subsize   = NULL;
    315:   (*psubcomm)->type      = PETSC_SUBCOMM_INTERLACED;
    316:   return(0);
    317: }

    319: /*@C
    320:   PetscSubcommGetParent - Gets the communicator that was used to create the PetscSubcomm

    322:    Collective

    324:    Input Parameter:
    325: .  scomm - the PetscSubcomm

    327:    Output Parameter:
    328: .  pcomm - location to store the parent communicator

    330:    Level: intermediate

    332: .seealso: PetscSubcommDestroy(), PetscSubcommSetTypeGeneral(), PetscSubcommSetFromOptions(), PetscSubcommSetType(),
    333:           PetscSubcommSetNumber(), PetscSubcommGetChild(), PetscSubcommContiguousParent()
    334: @*/
    335: PetscErrorCode  PetscSubcommGetParent(PetscSubcomm scomm,MPI_Comm *pcomm)
    336: {
    337:   *pcomm = PetscSubcommParent(scomm);
    338:   return 0;
    339: }

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

    345:    Collective

    347:    Input Parameter:
    348: .  scomm - the PetscSubcomm

    350:    Output Parameter:
    351: .  pcomm - location to store the parent communicator

    353:    Level: intermediate

    355: .seealso: PetscSubcommDestroy(), PetscSubcommSetTypeGeneral(), PetscSubcommSetFromOptions(), PetscSubcommSetType(),
    356:           PetscSubcommSetNumber(), PetscSubcommGetChild(), PetscSubcommContiguousParent()
    357: @*/
    358: PetscErrorCode  PetscSubcommGetContiguousParent(PetscSubcomm scomm,MPI_Comm *pcomm)
    359: {
    360:   *pcomm = PetscSubcommContiguousParent(scomm);
    361:   return 0;
    362: }

    364: /*@C
    365:   PetscSubcommGetChild - Gets the communicator created by the PetscSubcomm

    367:    Collective

    369:    Input Parameter:
    370: .  scomm - the PetscSubcomm

    372:    Output Parameter:
    373: .  ccomm - location to store the child communicator

    375:    Level: intermediate

    377: .seealso: PetscSubcommDestroy(), PetscSubcommSetTypeGeneral(), PetscSubcommSetFromOptions(), PetscSubcommSetType(),
    378:           PetscSubcommSetNumber(), PetscSubcommGetParent(), PetscSubcommContiguousParent()
    379: @*/
    380: PetscErrorCode  PetscSubcommGetChild(PetscSubcomm scomm,MPI_Comm *ccomm)
    381: {
    382:   *ccomm = PetscSubcommChild(scomm);
    383:   return 0;
    384: }

    386: static PetscErrorCode PetscSubcommCreate_contiguous(PetscSubcomm psubcomm)
    387: {
    389:   PetscMPIInt    rank,size,*subsize,duprank=-1,subrank=-1;
    390:   PetscMPIInt    np_subcomm,nleftover,i,color=-1,rankstart,nsubcomm=psubcomm->n;
    391:   MPI_Comm       subcomm=0,dupcomm=0,comm=psubcomm->parent;

    394:   MPI_Comm_rank(comm,&rank);
    395:   MPI_Comm_size(comm,&size);

    397:   /* get size of each subcommunicator */
    398:   PetscMalloc1(1+nsubcomm,&subsize);

    400:   np_subcomm = size/nsubcomm;
    401:   nleftover  = size - nsubcomm*np_subcomm;
    402:   for (i=0; i<nsubcomm; i++) {
    403:     subsize[i] = np_subcomm;
    404:     if (i<nleftover) subsize[i]++;
    405:   }

    407:   /* get color and subrank of this proc */
    408:   rankstart = 0;
    409:   for (i=0; i<nsubcomm; i++) {
    410:     if (rank >= rankstart && rank < rankstart+subsize[i]) {
    411:       color   = i;
    412:       subrank = rank - rankstart;
    413:       duprank = rank;
    414:       break;
    415:     } else rankstart += subsize[i];
    416:   }

    418:   MPI_Comm_split(comm,color,subrank,&subcomm);

    420:   /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
    421:   MPI_Comm_split(comm,0,duprank,&dupcomm);
    422:   PetscCommDuplicate(dupcomm,&psubcomm->dupparent,NULL);
    423:   PetscCommDuplicate(subcomm,&psubcomm->child,NULL);
    424:   MPI_Comm_free(&dupcomm);
    425:   MPI_Comm_free(&subcomm);

    427:   psubcomm->color   = color;
    428:   psubcomm->subsize = subsize;
    429:   psubcomm->type    = PETSC_SUBCOMM_CONTIGUOUS;
    430:   return(0);
    431: }

    433: /*
    434:    Note:
    435:    In PCREDUNDANT, to avoid data scattering from subcomm back to original comm, we create subcommunicators
    436:    by iteratively taking a process into a subcommunicator.
    437:    Example: size=4, nsubcomm=(*psubcomm)->n=3
    438:      comm=(*psubcomm)->parent:
    439:       rank:     [0]  [1]  [2]  [3]
    440:       color:     0    1    2    0

    442:      subcomm=(*psubcomm)->comm:
    443:       subrank:  [0]  [0]  [0]  [1]

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

    448:      Here, subcomm[color = 0] has subsize=2, owns process [0] and [3]
    449:            subcomm[color = 1] has subsize=1, owns process [1]
    450:            subcomm[color = 2] has subsize=1, owns process [2]
    451:            dupcomm has same number of processes as comm, and its duprank maps
    452:            processes in subcomm contiguously into a 1d array:
    453:             duprank: [0] [1]      [2]         [3]
    454:             rank:    [0] [3]      [1]         [2]
    455:                     subcomm[0] subcomm[1]  subcomm[2]
    456: */

    458: static PetscErrorCode PetscSubcommCreate_interlaced(PetscSubcomm psubcomm)
    459: {
    461:   PetscMPIInt    rank,size,*subsize,duprank,subrank;
    462:   PetscMPIInt    np_subcomm,nleftover,i,j,color,nsubcomm=psubcomm->n;
    463:   MPI_Comm       subcomm=0,dupcomm=0,comm=psubcomm->parent;

    466:   MPI_Comm_rank(comm,&rank);
    467:   MPI_Comm_size(comm,&size);

    469:   /* get size of each subcommunicator */
    470:   PetscMalloc1(1+nsubcomm,&subsize);

    472:   np_subcomm = size/nsubcomm;
    473:   nleftover  = size - nsubcomm*np_subcomm;
    474:   for (i=0; i<nsubcomm; i++) {
    475:     subsize[i] = np_subcomm;
    476:     if (i<nleftover) subsize[i]++;
    477:   }

    479:   /* find color for this proc */
    480:   color   = rank%nsubcomm;
    481:   subrank = rank/nsubcomm;

    483:   MPI_Comm_split(comm,color,subrank,&subcomm);

    485:   j = 0; duprank = 0;
    486:   for (i=0; i<nsubcomm; i++) {
    487:     if (j == color) {
    488:       duprank += subrank;
    489:       break;
    490:     }
    491:     duprank += subsize[i]; j++;
    492:   }

    494:   /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
    495:   MPI_Comm_split(comm,0,duprank,&dupcomm);
    496:   PetscCommDuplicate(dupcomm,&psubcomm->dupparent,NULL);
    497:   PetscCommDuplicate(subcomm,&psubcomm->child,NULL);
    498:   MPI_Comm_free(&dupcomm);
    499:   MPI_Comm_free(&subcomm);

    501:   psubcomm->color   = color;
    502:   psubcomm->subsize = subsize;
    503:   psubcomm->type    = PETSC_SUBCOMM_INTERLACED;
    504:   return(0);
    505: }