Date: 2013-07-02T14:39:12+00:00

Actual source code: mpits.c
petsc-3.4.2 2013-07-02

      1: #include <petscsys.h>        /*I  "petscsys.h"  I*/

      3: const char *const PetscBuildTwoSidedTypes[] = {
      4:   "ALLREDUCE",
      5:   "IBARRIER",
      6:   "PetscBuildTwoSidedType",
      7:   "PETSC_BUILDTWOSIDED_",
      8:   0
      9: };

     11: static PetscBuildTwoSidedType _twosided_type = PETSC_BUILDTWOSIDED_NOTSET;

     15: /*@
     16:    PetscCommBuildTwoSidedSetType - set algorithm to use when building two-sided communication

     18:    Logically Collective

     20:    Input Arguments:
     21: +  comm - PETSC_COMM_WORLD
     22: -  twosided - algorithm to use in subsequent calls to PetscCommBuildTwoSided()

     24:    Level: developer

     26:    Note:
     27:    This option is currently global, but could be made per-communicator.

     29: .seealso: PetscCommBuildTwoSided(), PetscCommBuildTwoSidedGetType()
     30: @*/
     31: PetscErrorCode PetscCommBuildTwoSidedSetType(MPI_Comm comm,PetscBuildTwoSidedType twosided)
     32: {
     34: #if defined(PETSC_USE_DEBUG)
     36:     PetscMPIInt ierr;
     37:     PetscMPIInt b1[2],b2[2];
     38:     b1[0] = -(PetscMPIInt)twosided;
     39:     b1[1] = (PetscMPIInt)twosided;
     40:     MPI_Allreduce(b1,b2,2,MPI_INT,MPI_MAX,comm);
     41:     if (-b2[0] != b2[1]) SETERRQ(comm,PETSC_ERR_ARG_WRONG,"Enum value must be same on all processes");
     42:   }
     43: #endif
     44:   _twosided_type = twosided;
     45:   return(0);
     46: }

     50: /*@
     51:    PetscCommBuildTwoSidedGetType - set algorithm to use when building two-sided communication

     53:    Logically Collective

     55:    Output Arguments:
     56: +  comm - communicator on which to query algorithm
     57: -  twosided - algorithm to use for PetscCommBuildTwoSided()

     59:    Level: developer

     61: .seealso: PetscCommBuildTwoSided(), PetscCommBuildTwoSidedSetType()
     62: @*/
     63: PetscErrorCode PetscCommBuildTwoSidedGetType(MPI_Comm comm,PetscBuildTwoSidedType *twosided)
     64: {

     68:   *twosided = PETSC_BUILDTWOSIDED_NOTSET;
     69:   if (_twosided_type == PETSC_BUILDTWOSIDED_NOTSET) {
     70: #if defined(PETSC_HAVE_MPI_IBARRIER)
     71: #  if defined(PETSC_HAVE_MPICH_CH3_SOCK) && !defined(PETSC_HAVE_MPICH_CH3_SOCK_FIXED_NBC_PROGRESS)
     72:     /* Deadlock in Ibarrier: http://trac.mpich.org/projects/mpich/ticket/1785 */
     73:     _twosided_type = PETSC_BUILDTWOSIDED_ALLREDUCE;
     74: #  else
     75:     _twosided_type = PETSC_BUILDTWOSIDED_IBARRIER;
     76: #  endif
     77: #else
     78:     _twosided_type = PETSC_BUILDTWOSIDED_ALLREDUCE;
     79: #endif
     80:     PetscOptionsGetEnum(NULL,"-build_twosided",PetscBuildTwoSidedTypes,(PetscEnum*)&_twosided_type,NULL);
     81:   }
     82:   *twosided = _twosided_type;
     83:   return(0);
     84: }

     86: #if defined(PETSC_HAVE_MPI_IBARRIER)

     90: static PetscErrorCode PetscCommBuildTwoSided_Ibarrier(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscInt nto,const PetscMPIInt *toranks,const void *todata,PetscInt *nfrom,PetscMPIInt **fromranks,void *fromdata)
     91: {
     93:   PetscMPIInt    nrecvs,tag,unitbytes,done;
     94:   PetscInt       i;
     95:   char           *tdata;
     96:   MPI_Request    *sendreqs,barrier;
     97:   PetscSegBuffer segrank,segdata;

    100:   PetscCommGetNewTag(comm,&tag);
    101:   MPI_Type_size(dtype,&unitbytes);
    102:   tdata = (char*)todata;
    103:   PetscMalloc(nto*sizeof(MPI_Request),&sendreqs);
    104:   for (i=0; i<nto; i++) {
    105:     MPI_Issend((void*)(tdata+count*unitbytes*i),count,dtype,toranks[i],tag,comm,sendreqs+i);
    106:   }
    107:   PetscSegBufferCreate(sizeof(PetscMPIInt),4,&segrank);
    108:   PetscSegBufferCreate(unitbytes,4*count,&segdata);

    110:   nrecvs  = 0;
    111:   barrier = MPI_REQUEST_NULL;
    112:   for (done=0; !done; ) {
    113:     PetscMPIInt flag;
    114:     MPI_Status  status;
    115:     MPI_Iprobe(MPI_ANY_SOURCE,tag,comm,&flag,&status);
    116:     if (flag) {                 /* incoming message */
    117:       PetscMPIInt *recvrank;
    118:       void        *buf;
    119:       PetscSegBufferGet(segrank,1,&recvrank);
    120:       PetscSegBufferGet(segdata,count,&buf);
    121:       *recvrank = status.MPI_SOURCE;
    122:       MPI_Recv(buf,count,dtype,status.MPI_SOURCE,tag,comm,MPI_STATUS_IGNORE);
    123:       nrecvs++;
    124:     }
    125:     if (barrier == MPI_REQUEST_NULL) {
    126:       PetscMPIInt sent,nsends;
    127:       PetscMPIIntCast(nto,&nsends);
    128:       MPI_Testall(nsends,sendreqs,&sent,MPI_STATUSES_IGNORE);
    129:       if (sent) {
    130:         MPI_Ibarrier(comm,&barrier);
    131:         PetscFree(sendreqs);
    132:       }
    133:     } else {
    134:       MPI_Test(&barrier,&done,MPI_STATUS_IGNORE);
    135:     }
    136:   }
    137:   *nfrom = nrecvs;
    138:   PetscSegBufferExtractAlloc(segrank,fromranks);
    139:   PetscSegBufferDestroy(&segrank);
    140:   PetscSegBufferExtractAlloc(segdata,fromdata);
    141:   PetscSegBufferDestroy(&segdata);
    142:   return(0);
    143: }
    144: #endif

    148: static PetscErrorCode PetscCommBuildTwoSided_Allreduce(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscInt nto,const PetscMPIInt *toranks,const void *todata,PetscInt *nfrom,PetscMPIInt **fromranks,void *fromdata)
    149: {
    151:   PetscMPIInt    size,*iflags,nrecvs,tag,unitbytes,*franks;
    152:   PetscInt       i;
    153:   char           *tdata,*fdata;
    154:   MPI_Request    *reqs,*sendreqs;
    155:   MPI_Status     *statuses;

    158:   MPI_Comm_size(comm,&size);
    159:   PetscMalloc(size*sizeof(*iflags),&iflags);
    160:   PetscMemzero(iflags,size*sizeof(*iflags));
    161:   for (i=0; i<nto; i++) iflags[toranks[i]] = 1;
    162:   PetscGatherNumberOfMessages(comm,iflags,NULL,&nrecvs);
    163:   PetscFree(iflags);

    165:   PetscCommGetNewTag(comm,&tag);
    166:   MPI_Type_size(dtype,&unitbytes);
    167:   PetscMalloc(nrecvs*count*unitbytes,&fdata);
    168:   tdata    = (char*)todata;
    169:   PetscMalloc2(nto+nrecvs,MPI_Request,&reqs,nto+nrecvs,MPI_Status,&statuses);
    170:   sendreqs = reqs + nrecvs;
    171:   for (i=0; i<nrecvs; i++) {
    172:     MPI_Irecv((void*)(fdata+count*unitbytes*i),count,dtype,MPI_ANY_SOURCE,tag,comm,reqs+i);
    173:   }
    174:   for (i=0; i<nto; i++) {
    175:     MPI_Isend((void*)(tdata+count*unitbytes*i),count,dtype,toranks[i],tag,comm,sendreqs+i);
    176:   }
    177:   MPI_Waitall(nto+nrecvs,reqs,statuses);
    178:   PetscMalloc(nrecvs*sizeof(PetscMPIInt),&franks);
    179:   for (i=0; i<nrecvs; i++) franks[i] = statuses[i].MPI_SOURCE;
    180:   PetscFree2(reqs,statuses);

    182:   *nfrom            = nrecvs;
    183:   *fromranks        = franks;
    184:   *(void**)fromdata = fdata;
    185:   return(0);
    186: }

    190: /*@C
    191:    PetscCommBuildTwoSided - discovers communicating ranks given one-sided information, moving constant-sized data in the process (often message lengths)

    193:    Collective on MPI_Comm

    195:    Input Arguments:
    196: +  comm - communicator
    197: .  count - number of entries to send/receive (must match on all ranks)
    198: .  dtype - datatype to send/receive from each rank (must match on all ranks)
    199: .  nto - number of ranks to send data to
    200: .  toranks - ranks to send to (array of length nto)
    201: -  todata - data to send to each rank (packed)

    203:    Output Arguments:
    204: +  nfrom - number of ranks receiving messages from
    205: .  fromranks - ranks receiving messages from (length nfrom; caller should PetscFree())
    206: -  fromdata - packed data from each rank, each with count entries of type dtype (length nfrom, caller responsible for PetscFree())

    208:    Level: developer

    210:    Notes:
    211:    This memory-scalable interface is an alternative to calling PetscGatherNumberOfMessages() and
    212:    PetscGatherMessageLengths(), possibly with a subsequent round of communication to send other constant-size data.

    214:    Basic data types as well as contiguous types are supported, but non-contiguous (e.g., strided) types are not.

    216:    References:
    217:    The MPI_Ibarrier implementation uses the algorithm in
    218:    Hoefler, Siebert and Lumsdaine, Scalable communication protocols for dynamic sparse data exchange, 2010.

    220: .seealso: PetscGatherNumberOfMessages(), PetscGatherMessageLengths()
    221: @*/
    222: PetscErrorCode PetscCommBuildTwoSided(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscInt nto,const PetscMPIInt *toranks,const void *todata,PetscInt *nfrom,PetscMPIInt **fromranks,void *fromdata)
    223: {
    224:   PetscErrorCode         ierr;
    225:   PetscBuildTwoSidedType buildtype = PETSC_BUILDTWOSIDED_NOTSET;

    228:   PetscCommBuildTwoSidedGetType(comm,&buildtype);
    229:   switch (buildtype) {
    230:   case PETSC_BUILDTWOSIDED_IBARRIER:
    231: #if defined(PETSC_HAVE_MPI_IBARRIER)
    232:     PetscCommBuildTwoSided_Ibarrier(comm,count,dtype,nto,toranks,todata,nfrom,fromranks,fromdata);
    233: #else
    234:     SETERRQ(comm,PETSC_ERR_PLIB,"MPI implementation does not provide MPI_Ibarrier (part of MPI-3)");
    235: #endif
    236:     break;
    237:   case PETSC_BUILDTWOSIDED_ALLREDUCE:
    238:     PetscCommBuildTwoSided_Allreduce(comm,count,dtype,nto,toranks,todata,nfrom,fromranks,fromdata);
    239:     break;
    240:   default: SETERRQ(comm,PETSC_ERR_PLIB,"Unknown method for building two-sided communication");
    241:   }
    242:   return(0);
    243: }