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

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

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

      7: /*@C
      8:   PetscGatherNumberOfMessages -  Computes the number of messages a node expects to receive

     10:   Collective on MPI_Comm

     12:   Input Parameters:
     13: + comm     - Communicator
     14: . iflags   - an array of integers of length sizeof(comm). A '1' in ilengths[i] represent a
     15:              message from current node to ith node. Optionally NULL
     16: - ilengths - Non zero ilengths[i] represent a message to i of length ilengths[i].
     17:              Optionally NULL.

     19:   Output Parameters:
     20: . nrecvs    - number of messages received

     22:   Level: developer

     24:   Concepts: mpi utility

     26:   Notes:
     27:   With this info, the correct message lengths can be determined using
     28:   PetscGatherMessageLengths()

     30:   Either iflags or ilengths should be provided.  If iflags is not
     31:   provided (NULL) it can be computed from ilengths. If iflags is
     32:   provided, ilengths is not required.

     34: .seealso: PetscGatherMessageLengths()
     35: @*/
     36: PetscErrorCode  PetscGatherNumberOfMessages(MPI_Comm comm,const PetscMPIInt iflags[],const PetscMPIInt ilengths[],PetscMPIInt *nrecvs)
     37: {
     38:   PetscMPIInt    size,rank,*recv_buf,i,*iflags_local = NULL,*iflags_localm = NULL;

     42:   MPI_Comm_size(comm,&size);
     43:   MPI_Comm_rank(comm,&rank);

     45:   PetscMalloc2(size,PetscMPIInt,&recv_buf,size,PetscMPIInt,&iflags_localm);

     47:   /* If iflags not provided, compute iflags from ilengths */
     48:   if (!iflags) {
     49:     if (!ilengths) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Either iflags or ilengths should be provided");
     50:     iflags_local = iflags_localm;
     51:     for (i=0; i<size; i++) {
     52:       if (ilengths[i]) iflags_local[i] = 1;
     53:       else iflags_local[i] = 0;
     54:     }
     55:   } else iflags_local = (PetscMPIInt*) iflags;

     57:   /* Post an allreduce to determine the numer of messages the current node will receive */
     58:   MPI_Allreduce(iflags_local,recv_buf,size,MPI_INT,MPI_SUM,comm);
     59:   *nrecvs = recv_buf[rank];

     61:   PetscFree2(recv_buf,iflags_localm);
     62:   return(0);
     63: }

     68: /*@C
     69:   PetscGatherMessageLengths - Computes info about messages that a MPI-node will receive,
     70:   including (from-id,length) pairs for each message.

     72:   Collective on MPI_Comm

     74:   Input Parameters:
     75: + comm      - Communicator
     76: . nsends    - number of messages that are to be sent.
     77: . nrecvs    - number of messages being received
     78: - ilengths  - an array of integers of length sizeof(comm)
     79:               a non zero ilengths[i] represent a message to i of length ilengths[i]

     82:   Output Parameters:
     83: + onodes    - list of node-ids from which messages are expected
     84: - olengths  - corresponding message lengths

     86:   Level: developer

     88:   Concepts: mpi utility

     90:   Notes:
     91:   With this info, the correct MPI_Irecv() can be posted with the correct
     92:   from-id, with a buffer with the right amount of memory required.

     94:   The calling function deallocates the memory in onodes and olengths

     96:   To determine nrecevs, one can use PetscGatherNumberOfMessages()

     98: .seealso: PetscGatherNumberOfMessages()
     99: @*/
    100: PetscErrorCode  PetscGatherMessageLengths(MPI_Comm comm,PetscMPIInt nsends,PetscMPIInt nrecvs,const PetscMPIInt ilengths[],PetscMPIInt **onodes,PetscMPIInt **olengths)
    101: {
    103:   PetscMPIInt    size,tag,i,j;
    104:   MPI_Request    *s_waits  = NULL,*r_waits = NULL;
    105:   MPI_Status     *w_status = NULL;

    108:   MPI_Comm_size(comm,&size);
    109:   PetscCommGetNewTag(comm,&tag);

    111:   /* cannot use PetscMalloc3() here because in the call to MPI_Waitall() they MUST be contiguous */
    112:   PetscMalloc2(nrecvs+nsends,MPI_Request,&r_waits,nrecvs+nsends,MPI_Status,&w_status);
    113:   s_waits = r_waits+nrecvs;

    115:   /* Post the Irecv to get the message length-info */
    116:   PetscMalloc(nrecvs*sizeof(PetscMPIInt),olengths);
    117:   for (i=0; i<nrecvs; i++) {
    118:     MPI_Irecv((*olengths)+i,1,MPI_INT,MPI_ANY_SOURCE,tag,comm,r_waits+i);
    119:   }

    121:   /* Post the Isends with the message length-info */
    122:   for (i=0,j=0; i<size; ++i) {
    123:     if (ilengths[i]) {
    124:       MPI_Isend((void*)(ilengths+i),1,MPI_INT,i,tag,comm,s_waits+j);
    125:       j++;
    126:     }
    127:   }

    129:   /* Post waits on sends and receivs */
    130:   if (nrecvs+nsends) {MPI_Waitall(nrecvs+nsends,r_waits,w_status);}

    132:   /* Pack up the received data */
    133:   PetscMalloc(nrecvs*sizeof(PetscMPIInt),onodes);
    134:   for (i=0; i<nrecvs; ++i) (*onodes)[i] = w_status[i].MPI_SOURCE;
    135:   PetscFree2(r_waits,w_status);
    136:   return(0);
    137: }

    141: /*@C
    142:   PetscGatherMessageLengths2 - Computes info about messages that a MPI-node will receive,
    143:   including (from-id,length) pairs for each message. Same functionality as PetscGatherMessageLengths()
    144:   except it takes TWO ilenths and output TWO olengths.

    146:   Collective on MPI_Comm

    148:   Input Parameters:
    149: + comm      - Communicator
    150: . nsends    - number of messages that are to be sent.
    151: . nrecvs    - number of messages being received
    152: - ilengths1, ilengths2 - array of integers of length sizeof(comm)
    153:               a non zero ilengths[i] represent a message to i of length ilengths[i]

    155:   Output Parameters:
    156: + onodes    - list of node-ids from which messages are expected
    157: - olengths1, olengths2 - corresponding message lengths

    159:   Level: developer

    161:   Concepts: mpi utility

    163:   Notes:
    164:   With this info, the correct MPI_Irecv() can be posted with the correct
    165:   from-id, with a buffer with the right amount of memory required.

    167:   The calling function deallocates the memory in onodes and olengths

    169:   To determine nrecevs, one can use PetscGatherNumberOfMessages()

    171: .seealso: PetscGatherMessageLengths() and PetscGatherNumberOfMessages()
    172: @*/
    173: PetscErrorCode  PetscGatherMessageLengths2(MPI_Comm comm,PetscMPIInt nsends,PetscMPIInt nrecvs,const PetscMPIInt ilengths1[],const PetscMPIInt ilengths2[],PetscMPIInt **onodes,PetscMPIInt **olengths1,PetscMPIInt **olengths2)
    174: {
    176:   PetscMPIInt    size,tag,i,j,*buf_s = NULL,*buf_r = NULL,*buf_j = NULL;
    177:   MPI_Request    *s_waits  = NULL,*r_waits = NULL;
    178:   MPI_Status     *w_status = NULL;

    181:   MPI_Comm_size(comm,&size);
    182:   PetscCommGetNewTag(comm,&tag);

    184:   /* cannot use PetscMalloc5() because r_waits and s_waits must be contiquous for the call to MPI_Waitall() */
    185:   PetscMalloc4(nrecvs+nsends,MPI_Request,&r_waits,2*nrecvs,PetscMPIInt,&buf_r,2*nsends,PetscMPIInt,&buf_s,nrecvs+nsends,MPI_Status,&w_status);
    186:   s_waits = r_waits + nrecvs;

    188:   /* Post the Irecv to get the message length-info */
    189:   PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),olengths1);
    190:   PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),olengths2);
    191:   for (i=0; i<nrecvs; i++) {
    192:     buf_j = buf_r + (2*i);
    193:     MPI_Irecv(buf_j,2,MPI_INT,MPI_ANY_SOURCE,tag,comm,r_waits+i);
    194:   }

    196:   /* Post the Isends with the message length-info */
    197:   for (i=0,j=0; i<size; ++i) {
    198:     if (ilengths1[i]) {
    199:       buf_j    = buf_s + (2*j);
    200:       buf_j[0] = *(ilengths1+i);
    201:       buf_j[1] = *(ilengths2+i);
    202:       MPI_Isend(buf_j,2,MPI_INT,i,tag,comm,s_waits+j);
    203:       j++;
    204:     }
    205:   }

    207:   /* Post waits on sends and receivs */
    208:   if (nrecvs+nsends) {MPI_Waitall(nrecvs+nsends,r_waits,w_status);}

    211:   /* Pack up the received data */
    212:   PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),onodes);
    213:   for (i=0; i<nrecvs; ++i) {
    214:     (*onodes)[i]    = w_status[i].MPI_SOURCE;
    215:     buf_j           = buf_r + (2*i);
    216:     (*olengths1)[i] = buf_j[0];
    217:     (*olengths2)[i] = buf_j[1];
    218:   }

    220:   PetscFree4(r_waits,buf_r,buf_s,w_status);
    221:   return(0);
    222: }

    224: /*

    226:   Allocate a bufffer sufficient to hold messages of size specified in olengths.
    227:   And post Irecvs on these buffers using node info from onodes

    229:  */
    232: PetscErrorCode  PetscPostIrecvInt(MPI_Comm comm,PetscMPIInt tag,PetscMPIInt nrecvs,const PetscMPIInt onodes[],const PetscMPIInt olengths[],PetscInt ***rbuf,MPI_Request **r_waits)
    233: {
    235:   PetscInt       **rbuf_t,i,len = 0;
    236:   MPI_Request    *r_waits_t;

    239:   /* compute memory required for recv buffers */
    240:   for (i=0; i<nrecvs; i++) len += olengths[i];  /* each message length */

    242:   /* allocate memory for recv buffers */
    243:   PetscMalloc((nrecvs+1)*sizeof(PetscInt*),&rbuf_t);
    244:   PetscMalloc(len*sizeof(PetscInt),&rbuf_t[0]);
    245:   for (i=1; i<nrecvs; ++i) rbuf_t[i] = rbuf_t[i-1] + olengths[i-1];

    247:   /* Post the receives */
    248:   PetscMalloc(nrecvs*sizeof(MPI_Request),&r_waits_t);
    249:   for (i=0; i<nrecvs; ++i) {
    250:     MPI_Irecv(rbuf_t[i],olengths[i],MPIU_INT,onodes[i],tag,comm,r_waits_t+i);
    251:   }

    253:   *rbuf    = rbuf_t;
    254:   *r_waits = r_waits_t;
    255:   return(0);
    256: }

    260: PetscErrorCode  PetscPostIrecvScalar(MPI_Comm comm,PetscMPIInt tag,PetscMPIInt nrecvs,const PetscMPIInt onodes[],const PetscMPIInt olengths[],PetscScalar ***rbuf,MPI_Request **r_waits)
    261: {
    263:   PetscMPIInt    i;
    264:   PetscScalar    **rbuf_t;
    265:   MPI_Request    *r_waits_t;
    266:   PetscInt       len = 0;

    269:   /* compute memory required for recv buffers */
    270:   for (i=0; i<nrecvs; i++) len += olengths[i];  /* each message length */

    272:   /* allocate memory for recv buffers */
    273:   PetscMalloc((nrecvs+1)*sizeof(PetscScalar*),&rbuf_t);
    274:   PetscMalloc(len*sizeof(PetscScalar),&rbuf_t[0]);
    275:   for (i=1; i<nrecvs; ++i) rbuf_t[i] = rbuf_t[i-1] + olengths[i-1];

    277:   /* Post the receives */
    278:   PetscMalloc(nrecvs*sizeof(MPI_Request),&r_waits_t);
    279:   for (i=0; i<nrecvs; ++i) {
    280:     MPI_Irecv(rbuf_t[i],olengths[i],MPIU_SCALAR,onodes[i],tag,comm,r_waits_t+i);
    281:   }

    283:   *rbuf    = rbuf_t;
    284:   *r_waits = r_waits_t;
    285:   return(0);
    286: }