Actual source code: mpimesg.c
1: #define PETSC_DLL
3: #include petscsys.h
8: /*@C
9: PetscGatherNumberOfMessages - Computes the number of messages a node expects to receive
11: Collective on MPI_Comm
13: Input Parameters:
14: + comm - Communicator
15: . iflags - an array of integers of length sizeof(comm). A '1' in ilengths[i] represent a
16: message from current node to ith node. Optionally PETSC_NULL
17: - ilengths - Non zero ilengths[i] represent a message to i of length ilengths[i].
18: Optionally PETSC_NULL.
20: Output Parameters:
21: . nrecvs - number of messages received
23: Level: developer
25: Concepts: mpi utility
27: Notes:
28: With this info, the correct message lengths can be determined using
29: PetscGatherMessageLengths()
31: Either iflags or ilengths should be provided. If iflags is not
32: provided (PETSC_NULL) it can be computed from ilengths. If iflags is
33: provided, ilengths is not required.
35: .seealso: PetscGatherMessageLengths()
36: @*/
37: PetscErrorCode PetscGatherNumberOfMessages(MPI_Comm comm,const PetscMPIInt iflags[],const PetscMPIInt ilengths[],PetscMPIInt *nrecvs)
38: {
39: PetscMPIInt size,rank,*recv_buf,i,*iflags_local = PETSC_NULL,*iflags_localm = PETSC_NULL;
44: MPI_Comm_size(comm,&size);
45: MPI_Comm_rank(comm,&rank);
47: PetscMalloc2(size,PetscMPIInt,&recv_buf,size,PetscMPIInt,&iflags_localm);
49: /* If iflags not provided, compute iflags from ilengths */
50: if (!iflags) {
51: if (!ilengths) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Either iflags or ilengths should be provided");
52: iflags_local = iflags_localm;
53: for (i=0; i<size; i++) {
54: if (ilengths[i]) iflags_local[i] = 1;
55: else iflags_local[i] = 0;
56: }
57: } else {
58: iflags_local = (PetscMPIInt *) iflags;
59: }
61: /* Post an allreduce to determine the numer of messages the current node will receive */
62: MPI_Allreduce(iflags_local,recv_buf,size,MPI_INT,MPI_SUM,comm);
63: *nrecvs = recv_buf[rank];
65: PetscFree2(recv_buf,iflags_localm);
66: return(0);
67: }
72: /*@C
73: PetscGatherMessageLengths - Computes info about messages that a MPI-node will receive,
74: including (from-id,length) pairs for each message.
76: Collective on MPI_Comm
78: Input Parameters:
79: + comm - Communicator
80: . nsends - number of messages that are to be sent.
81: . nrecvs - number of messages being received
82: - ilengths - an array of integers of length sizeof(comm)
83: a non zero ilengths[i] represent a message to i of length ilengths[i]
86: Output Parameters:
87: + onodes - list of node-ids from which messages are expected
88: - olengths - corresponding message lengths
90: Level: developer
92: Concepts: mpi utility
94: Notes:
95: With this info, the correct MPI_Irecv() can be posted with the correct
96: from-id, with a buffer with the right amount of memory required.
98: The calling function deallocates the memory in onodes and olengths
100: To determine nrecevs, one can use PetscGatherNumberOfMessages()
102: .seealso: PetscGatherNumberOfMessages()
103: @*/
104: PetscErrorCode PetscGatherMessageLengths(MPI_Comm comm,PetscMPIInt nsends,PetscMPIInt nrecvs,const PetscMPIInt ilengths[],PetscMPIInt **onodes,PetscMPIInt **olengths)
105: {
107: PetscMPIInt size,tag,i,j;
108: MPI_Request *s_waits = PETSC_NULL,*r_waits = PETSC_NULL;
109: MPI_Status *w_status = PETSC_NULL;
112: MPI_Comm_size(comm,&size);
113: PetscCommGetNewTag(comm,&tag);
115: /* cannot use PetscMalloc3() here because in the call to MPI_Waitall() they MUST be contiguous */
116: PetscMalloc2(nrecvs+nsends,MPI_Request,&r_waits,nrecvs+nsends,MPI_Status,&w_status);
117: s_waits = r_waits+nrecvs;
119: /* Post the Irecv to get the message length-info */
120: PetscMalloc(nrecvs*sizeof(PetscMPIInt),olengths);
121: for (i=0; i<nrecvs; i++) {
122: MPI_Irecv((*olengths)+i,1,MPI_INT,MPI_ANY_SOURCE,tag,comm,r_waits+i);
123: }
125: /* Post the Isends with the message length-info */
126: for (i=0,j=0; i<size; ++i) {
127: if (ilengths[i]) {
128: MPI_Isend((void*)(ilengths+i),1,MPI_INT,i,tag,comm,s_waits+j);
129: j++;
130: }
131: }
133: /* Post waits on sends and receivs */
134: if (nrecvs+nsends) {MPI_Waitall(nrecvs+nsends,r_waits,w_status);}
135:
136: /* Pack up the received data */
137: PetscMalloc(nrecvs*sizeof(PetscMPIInt),onodes);
138: for (i=0; i<nrecvs; ++i) {
139: (*onodes)[i] = w_status[i].MPI_SOURCE;
140: }
141: PetscFree2(r_waits,w_status);
142: return(0);
143: }
147: /*@C
148: PetscGatherMessageLengths2 - Computes info about messages that a MPI-node will receive,
149: including (from-id,length) pairs for each message. Same functionality as PetscGatherMessageLengths()
150: except it takes TWO ilenths and output TWO olengths.
152: Collective on MPI_Comm
154: Input Parameters:
155: + comm - Communicator
156: . nsends - number of messages that are to be sent.
157: . nrecvs - number of messages being received
158: - ilengths1, ilengths2 - array of integers of length sizeof(comm)
159: a non zero ilengths[i] represent a message to i of length ilengths[i]
161: Output Parameters:
162: + onodes - list of node-ids from which messages are expected
163: - olengths1, olengths2 - corresponding message lengths
165: Level: developer
167: Concepts: mpi utility
169: Notes:
170: With this info, the correct MPI_Irecv() can be posted with the correct
171: from-id, with a buffer with the right amount of memory required.
173: The calling function deallocates the memory in onodes and olengths
175: To determine nrecevs, one can use PetscGatherNumberOfMessages()
177: .seealso: PetscGatherMessageLengths() and PetscGatherNumberOfMessages()
178: @*/
179: PetscErrorCode PetscGatherMessageLengths2(MPI_Comm comm,PetscMPIInt nsends,PetscMPIInt nrecvs,const PetscMPIInt ilengths1[],const PetscMPIInt ilengths2[],PetscMPIInt **onodes,PetscMPIInt **olengths1,PetscMPIInt **olengths2)
180: {
182: PetscMPIInt size,tag,i,j,*buf_s = PETSC_NULL,*buf_r = PETSC_NULL,*buf_j = PETSC_NULL;
183: MPI_Request *s_waits = PETSC_NULL,*r_waits = PETSC_NULL;
184: MPI_Status *w_status = PETSC_NULL;
187: MPI_Comm_size(comm,&size);
188: PetscCommGetNewTag(comm,&tag);
190: /* cannot use PetscMalloc5() because r_waits and s_waits must be contiquous for the call to MPI_Waitall() */
191: PetscMalloc4(nrecvs+nsends,MPI_Request,&r_waits,2*nrecvs,PetscMPIInt,&buf_r,2*nsends,PetscMPIInt,&buf_s,nrecvs+nsends,MPI_Status,&w_status);
192: s_waits = r_waits + nrecvs;
194: /* Post the Irecv to get the message length-info */
195: PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),olengths1);
196: PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),olengths2);
197: for (i=0; i<nrecvs; i++) {
198: buf_j = buf_r + (2*i);
199: MPI_Irecv(buf_j,2,MPI_INT,MPI_ANY_SOURCE,tag,comm,r_waits+i);
200: }
202: /* Post the Isends with the message length-info */
203: for (i=0,j=0; i<size; ++i) {
204: if (ilengths1[i]) {
205: buf_j = buf_s + (2*j);
206: buf_j[0] = *(ilengths1+i);
207: buf_j[1] = *(ilengths2+i);
208: MPI_Isend(buf_j,2,MPI_INT,i,tag,comm,s_waits+j);
209: j++;
210: }
211: }
212:
213: /* Post waits on sends and receivs */
214: if (nrecvs+nsends) {MPI_Waitall(nrecvs+nsends,r_waits,w_status);}
216:
217: /* Pack up the received data */
218: PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),onodes);
219: for (i=0; i<nrecvs; ++i) {
220: (*onodes)[i] = w_status[i].MPI_SOURCE;
221: buf_j = buf_r + (2*i);
222: (*olengths1)[i] = buf_j[0];
223: (*olengths2)[i] = buf_j[1];
224: }
226: PetscFree4(r_waits,buf_r,buf_s,w_status);
227: return(0);
228: }
230: /*
232: Allocate a bufffer sufficient to hold messages of size specified in olengths.
233: And post Irecvs on these buffers using node info from onodes
234:
235: */
238: PetscErrorCode PetscPostIrecvInt(MPI_Comm comm,PetscMPIInt tag,PetscMPIInt nrecvs,const PetscMPIInt onodes[],const PetscMPIInt olengths[],PetscInt ***rbuf,MPI_Request **r_waits)
239: {
241: PetscInt **rbuf_t,i,len = 0;
242: MPI_Request *r_waits_t;
245: /* compute memory required for recv buffers */
246: for (i=0; i<nrecvs; i++) len += olengths[i]; /* each message length */
248: /* allocate memory for recv buffers */
249: PetscMalloc((nrecvs+1)*sizeof(PetscInt*),&rbuf_t);
250: PetscMalloc(len*sizeof(PetscInt),&rbuf_t[0]);
251: for (i=1; i<nrecvs; ++i) rbuf_t[i] = rbuf_t[i-1] + olengths[i-1];
253: /* Post the receives */
254: PetscMalloc(nrecvs*sizeof(MPI_Request),&r_waits_t);
255: for (i=0; i<nrecvs; ++i) {
256: MPI_Irecv(rbuf_t[i],olengths[i],MPIU_INT,onodes[i],tag,comm,r_waits_t+i);
257: }
259: *rbuf = rbuf_t;
260: *r_waits = r_waits_t;
261: return(0);
262: }
266: PetscErrorCode PetscPostIrecvScalar(MPI_Comm comm,PetscMPIInt tag,PetscMPIInt nrecvs,const PetscMPIInt onodes[],const PetscMPIInt olengths[],PetscScalar ***rbuf,MPI_Request **r_waits)
267: {
269: PetscMPIInt i;
270: PetscScalar **rbuf_t;
271: MPI_Request *r_waits_t;
272: PetscInt len = 0;
275: /* compute memory required for recv buffers */
276: for (i=0; i<nrecvs; i++) len += olengths[i]; /* each message length */
278: /* allocate memory for recv buffers */
279: PetscMalloc((nrecvs+1)*sizeof(PetscScalar*),&rbuf_t);
280: PetscMalloc(len*sizeof(PetscScalar),&rbuf_t[0]);
281: for (i=1; i<nrecvs; ++i) rbuf_t[i] = rbuf_t[i-1] + olengths[i-1];
283: /* Post the receives */
284: PetscMalloc(nrecvs*sizeof(MPI_Request),&r_waits_t);
285: for (i=0; i<nrecvs; ++i) {
286: MPI_Irecv(rbuf_t[i],olengths[i],MPIU_SCALAR,onodes[i],tag,comm,r_waits_t+i);
287: }
289: *rbuf = rbuf_t;
290: *r_waits = r_waits_t;
291: return(0);
292: }