xref: /petsc/src/mat/utils/matstash.c (revision be29d3c6887e35e9e43a4f137c8657ac14f8b020)
1 #define PETSCMAT_DLL
2 
3 #include "src/mat/matimpl.h"
4 
5 /*
6        The input to the stash is ALWAYS in MatScalar precision, and the
7     internal storage and output is also in MatScalar.
8 */
9 #define DEFAULT_STASH_SIZE   10000
10 
11 /*
12   MatStashCreate_Private - Creates a stash,currently used for all the parallel
13   matrix implementations. The stash is where elements of a matrix destined
14   to be stored on other processors are kept until matrix assembly is done.
15 
16   This is a simple minded stash. Simply adds entries to end of stash.
17 
18   Input Parameters:
19   comm - communicator, required for scatters.
20   bs   - stash block size. used when stashing blocks of values
21 
22   Output Parameters:
23   stash    - the newly created stash
24 */
25 #undef __FUNCT__
26 #define __FUNCT__ "MatStashCreate_Private"
27 PetscErrorCode MatStashCreate_Private(MPI_Comm comm,PetscInt bs,MatStash *stash)
28 {
29   PetscErrorCode ierr;
30   PetscInt       max,*opt,nopt;
31   PetscTruth     flg;
32 
33   PetscFunctionBegin;
34   /* Require 2 tags,get the second using PetscCommGetNewTag() */
35   stash->comm = comm;
36   ierr = PetscCommGetNewTag(stash->comm,&stash->tag1);CHKERRQ(ierr);
37   ierr = PetscCommGetNewTag(stash->comm,&stash->tag2);CHKERRQ(ierr);
38   ierr = MPI_Comm_size(stash->comm,&stash->size);CHKERRQ(ierr);
39   ierr = MPI_Comm_rank(stash->comm,&stash->rank);CHKERRQ(ierr);
40 
41   nopt = stash->size;
42   ierr = PetscMalloc(nopt*sizeof(PetscInt),&opt);CHKERRQ(ierr);
43   ierr = PetscOptionsGetIntArray(PETSC_NULL,"-matstash_initial_size",opt,&nopt,&flg);CHKERRQ(ierr);
44   if (flg) {
45     if (nopt == 1)                max = opt[0];
46     else if (nopt == stash->size) max = opt[stash->rank];
47     else if (stash->rank < nopt)  max = opt[stash->rank];
48     else                          max = 0; /* Use default */
49     stash->umax = max;
50   } else {
51     stash->umax = 0;
52   }
53   ierr = PetscFree(opt);CHKERRQ(ierr);
54   if (bs <= 0) bs = 1;
55 
56   stash->bs       = bs;
57   stash->nmax     = 0;
58   stash->oldnmax  = 0;
59   stash->n        = 0;
60   stash->reallocs = -1;
61   stash->idx      = 0;
62   stash->idy      = 0;
63   stash->array    = 0;
64 
65   stash->send_waits  = 0;
66   stash->recv_waits  = 0;
67   stash->send_status = 0;
68   stash->nsends      = 0;
69   stash->nrecvs      = 0;
70   stash->svalues     = 0;
71   stash->rvalues     = 0;
72   stash->rindices    = 0;
73   stash->nprocs      = 0;
74   stash->nprocessed  = 0;
75   PetscFunctionReturn(0);
76 }
77 
78 /*
79    MatStashDestroy_Private - Destroy the stash
80 */
81 #undef __FUNCT__
82 #define __FUNCT__ "MatStashDestroy_Private"
83 PetscErrorCode MatStashDestroy_Private(MatStash *stash)
84 {
85   PetscErrorCode ierr;
86 
87   PetscFunctionBegin;
88   if (stash->array) {
89     ierr = PetscFree(stash->array);CHKERRQ(ierr);
90     stash->array = 0;
91   }
92   PetscFunctionReturn(0);
93 }
94 
95 /*
96    MatStashScatterEnd_Private - This is called as the fial stage of
97    scatter. The final stages of messagepassing is done here, and
98    all the memory used for messagepassing is cleanedu up. This
99    routine also resets the stash, and deallocates the memory used
100    for the stash. It also keeps track of the current memory usage
101    so that the same value can be used the next time through.
102 */
103 #undef __FUNCT__
104 #define __FUNCT__ "MatStashScatterEnd_Private"
105 PetscErrorCode MatStashScatterEnd_Private(MatStash *stash)
106 {
107   PetscErrorCode ierr;
108   int         nsends=stash->nsends,bs2,oldnmax;
109   MPI_Status  *send_status;
110 
111   PetscFunctionBegin;
112   /* wait on sends */
113   if (nsends) {
114     ierr = PetscMalloc(2*nsends*sizeof(MPI_Status),&send_status);CHKERRQ(ierr);
115     ierr = MPI_Waitall(2*nsends,stash->send_waits,send_status);CHKERRQ(ierr);
116     ierr = PetscFree(send_status);CHKERRQ(ierr);
117   }
118 
119   /* Now update nmaxold to be app 10% more than max n used, this way the
120      wastage of space is reduced the next time this stash is used.
121      Also update the oldmax, only if it increases */
122   if (stash->n) {
123     bs2      = stash->bs*stash->bs;
124     oldnmax  = ((int)(stash->n * 1.1) + 5)*bs2;
125     if (oldnmax > stash->oldnmax) stash->oldnmax = oldnmax;
126   }
127 
128   stash->nmax       = 0;
129   stash->n          = 0;
130   stash->reallocs   = -1;
131   stash->nprocessed = 0;
132 
133   if (stash->array) {
134     ierr         = PetscFree(stash->array);CHKERRQ(ierr);
135     stash->array = 0;
136     stash->idx   = 0;
137     stash->idy   = 0;
138   }
139   if (stash->send_waits) {
140     ierr = PetscFree(stash->send_waits);CHKERRQ(ierr);
141     stash->send_waits = 0;
142   }
143   if (stash->recv_waits) {
144     ierr = PetscFree(stash->recv_waits);CHKERRQ(ierr);
145     stash->recv_waits = 0;
146   }
147   if (stash->svalues) {
148     ierr = PetscFree(stash->svalues);CHKERRQ(ierr);
149     stash->svalues = 0;
150   }
151   if (stash->rvalues) {
152     ierr = PetscFree(stash->rvalues);CHKERRQ(ierr);
153     stash->rvalues = 0;
154   }
155   if (stash->rindices) {
156     ierr = PetscFree(stash->rindices);CHKERRQ(ierr);
157     stash->rindices = 0;
158   }
159   if (stash->nprocs) {
160     ierr = PetscFree(stash->nprocs);CHKERRQ(ierr);
161     stash->nprocs = 0;
162   }
163 
164   PetscFunctionReturn(0);
165 }
166 
167 /*
168    MatStashGetInfo_Private - Gets the relavant statistics of the stash
169 
170    Input Parameters:
171    stash    - the stash
172    nstash   - the size of the stash. Indicates the number of values stored.
173    reallocs - the number of additional mallocs incurred.
174 
175 */
176 #undef __FUNCT__
177 #define __FUNCT__ "MatStashGetInfo_Private"
178 PetscErrorCode MatStashGetInfo_Private(MatStash *stash,PetscInt *nstash,PetscInt *reallocs)
179 {
180   PetscInt bs2 = stash->bs*stash->bs;
181 
182   PetscFunctionBegin;
183   if (nstash) *nstash   = stash->n*bs2;
184   if (reallocs) {
185     if (stash->reallocs < 0) *reallocs = 0;
186     else                     *reallocs = stash->reallocs;
187   }
188   PetscFunctionReturn(0);
189 }
190 
191 
192 /*
193    MatStashSetInitialSize_Private - Sets the initial size of the stash
194 
195    Input Parameters:
196    stash  - the stash
197    max    - the value that is used as the max size of the stash.
198             this value is used while allocating memory.
199 */
200 #undef __FUNCT__
201 #define __FUNCT__ "MatStashSetInitialSize_Private"
202 PetscErrorCode MatStashSetInitialSize_Private(MatStash *stash,PetscInt max)
203 {
204   PetscFunctionBegin;
205   stash->umax = max;
206   PetscFunctionReturn(0);
207 }
208 
209 /* MatStashExpand_Private - Expand the stash. This function is called
210    when the space in the stash is not sufficient to add the new values
211    being inserted into the stash.
212 
213    Input Parameters:
214    stash - the stash
215    incr  - the minimum increase requested
216 
217    Notes:
218    This routine doubles the currently used memory.
219  */
220 #undef __FUNCT__
221 #define __FUNCT__ "MatStashExpand_Private"
222 static PetscErrorCode MatStashExpand_Private(MatStash *stash,PetscInt incr)
223 {
224   PetscErrorCode ierr;
225   PetscInt       *n_idx,*n_idy,newnmax,bs2;
226   MatScalar *n_array;
227 
228   PetscFunctionBegin;
229   /* allocate a larger stash */
230   bs2     = stash->bs*stash->bs;
231   if (!stash->oldnmax && !stash->nmax) { /* new stash */
232     if (stash->umax)                  newnmax = stash->umax/bs2;
233     else                              newnmax = DEFAULT_STASH_SIZE/bs2;
234   } else if (!stash->nmax) { /* resuing stash */
235     if (stash->umax > stash->oldnmax) newnmax = stash->umax/bs2;
236     else                              newnmax = stash->oldnmax/bs2;
237   } else                              newnmax = stash->nmax*2;
238   if (newnmax  < (stash->nmax + incr)) newnmax += 2*incr;
239 
240   ierr  = PetscMalloc((newnmax)*(2*sizeof(PetscInt)+bs2*sizeof(MatScalar)),&n_array);CHKERRQ(ierr);
241   n_idx = (PetscInt*)(n_array + bs2*newnmax);
242   n_idy = (PetscInt*)(n_idx + newnmax);
243   ierr  = PetscMemcpy(n_array,stash->array,bs2*stash->nmax*sizeof(MatScalar));CHKERRQ(ierr);
244   ierr  = PetscMemcpy(n_idx,stash->idx,stash->nmax*sizeof(PetscInt));CHKERRQ(ierr);
245   ierr  = PetscMemcpy(n_idy,stash->idy,stash->nmax*sizeof(PetscInt));CHKERRQ(ierr);
246   if (stash->array) {ierr = PetscFree(stash->array);CHKERRQ(ierr);}
247   stash->array   = n_array;
248   stash->idx     = n_idx;
249   stash->idy     = n_idy;
250   stash->nmax    = newnmax;
251   stash->reallocs++;
252   PetscFunctionReturn(0);
253 }
254 /*
255   MatStashValuesRow_Private - inserts values into the stash. This function
256   expects the values to be roworiented. Multiple columns belong to the same row
257   can be inserted with a single call to this function.
258 
259   Input Parameters:
260   stash  - the stash
261   row    - the global row correspoiding to the values
262   n      - the number of elements inserted. All elements belong to the above row.
263   idxn   - the global column indices corresponding to each of the values.
264   values - the values inserted
265 */
266 #undef __FUNCT__
267 #define __FUNCT__ "MatStashValuesRow_Private"
268 PetscErrorCode MatStashValuesRow_Private(MatStash *stash,PetscInt row,PetscInt n,const PetscInt idxn[],const MatScalar values[])
269 {
270   PetscErrorCode ierr;
271   PetscInt i;
272 
273   PetscFunctionBegin;
274   /* Check and see if we have sufficient memory */
275   if ((stash->n + n) > stash->nmax) {
276     ierr = MatStashExpand_Private(stash,n);CHKERRQ(ierr);
277   }
278   for (i=0; i<n; i++) {
279     stash->idx[stash->n]   = row;
280     stash->idy[stash->n]   = idxn[i];
281     stash->array[stash->n] = values[i];
282     stash->n++;
283   }
284   PetscFunctionReturn(0);
285 }
286 /*
287   MatStashValuesCol_Private - inserts values into the stash. This function
288   expects the values to be columnoriented. Multiple columns belong to the same row
289   can be inserted with a single call to this function.
290 
291   Input Parameters:
292   stash   - the stash
293   row     - the global row correspoiding to the values
294   n       - the number of elements inserted. All elements belong to the above row.
295   idxn    - the global column indices corresponding to each of the values.
296   values  - the values inserted
297   stepval - the consecutive values are sepated by a distance of stepval.
298             this happens because the input is columnoriented.
299 */
300 #undef __FUNCT__
301 #define __FUNCT__ "MatStashValuesCol_Private"
302 PetscErrorCode MatStashValuesCol_Private(MatStash *stash,PetscInt row,PetscInt n,const PetscInt idxn[],const MatScalar values[],PetscInt stepval)
303 {
304   PetscErrorCode ierr;
305   PetscInt i;
306 
307   PetscFunctionBegin;
308   /* Check and see if we have sufficient memory */
309   if ((stash->n + n) > stash->nmax) {
310     ierr = MatStashExpand_Private(stash,n);CHKERRQ(ierr);
311   }
312   for (i=0; i<n; i++) {
313     stash->idx[stash->n]   = row;
314     stash->idy[stash->n]   = idxn[i];
315     stash->array[stash->n] = values[i*stepval];
316     stash->n++;
317   }
318   PetscFunctionReturn(0);
319 }
320 
321 /*
322   MatStashValuesRowBlocked_Private - inserts blocks of values into the stash.
323   This function expects the values to be roworiented. Multiple columns belong
324   to the same block-row can be inserted with a single call to this function.
325   This function extracts the sub-block of values based on the dimensions of
326   the original input block, and the row,col values corresponding to the blocks.
327 
328   Input Parameters:
329   stash  - the stash
330   row    - the global block-row correspoiding to the values
331   n      - the number of elements inserted. All elements belong to the above row.
332   idxn   - the global block-column indices corresponding to each of the blocks of
333            values. Each block is of size bs*bs.
334   values - the values inserted
335   rmax   - the number of block-rows in the original block.
336   cmax   - the number of block-columsn on the original block.
337   idx    - the index of the current block-row in the original block.
338 */
339 #undef __FUNCT__
340 #define __FUNCT__ "MatStashValuesRowBlocked_Private"
341 PetscErrorCode MatStashValuesRowBlocked_Private(MatStash *stash,PetscInt row,PetscInt n,const PetscInt idxn[],const MatScalar values[],PetscInt rmax,PetscInt cmax,PetscInt idx)
342 {
343   PetscErrorCode ierr;
344   PetscInt i,j,k,bs2,bs=stash->bs;
345   const MatScalar *vals;
346   MatScalar       *array;
347 
348   PetscFunctionBegin;
349   bs2 = bs*bs;
350   if ((stash->n+n) > stash->nmax) {
351     ierr = MatStashExpand_Private(stash,n);CHKERRQ(ierr);
352   }
353   for (i=0; i<n; i++) {
354     stash->idx[stash->n]   = row;
355     stash->idy[stash->n] = idxn[i];
356     /* Now copy over the block of values. Store the values column oriented.
357        This enables inserting multiple blocks belonging to a row with a single
358        funtion call */
359     array = stash->array + bs2*stash->n;
360     vals  = values + idx*bs2*n + bs*i;
361     for (j=0; j<bs; j++) {
362       for (k=0; k<bs; k++) {array[k*bs] = vals[k];}
363       array += 1;
364       vals  += cmax*bs;
365     }
366     stash->n++;
367   }
368   PetscFunctionReturn(0);
369 }
370 
371 /*
372   MatStashValuesColBlocked_Private - inserts blocks of values into the stash.
373   This function expects the values to be roworiented. Multiple columns belong
374   to the same block-row can be inserted with a single call to this function.
375   This function extracts the sub-block of values based on the dimensions of
376   the original input block, and the row,col values corresponding to the blocks.
377 
378   Input Parameters:
379   stash  - the stash
380   row    - the global block-row correspoiding to the values
381   n      - the number of elements inserted. All elements belong to the above row.
382   idxn   - the global block-column indices corresponding to each of the blocks of
383            values. Each block is of size bs*bs.
384   values - the values inserted
385   rmax   - the number of block-rows in the original block.
386   cmax   - the number of block-columsn on the original block.
387   idx    - the index of the current block-row in the original block.
388 */
389 #undef __FUNCT__
390 #define __FUNCT__ "MatStashValuesColBlocked_Private"
391 PetscErrorCode MatStashValuesColBlocked_Private(MatStash *stash,PetscInt row,PetscInt n,const PetscInt idxn[],const MatScalar values[],PetscInt rmax,PetscInt cmax,PetscInt idx)
392 {
393   PetscErrorCode ierr;
394   PetscInt i,j,k,bs2,bs=stash->bs;
395   const MatScalar *vals;
396   MatScalar       *array;
397 
398   PetscFunctionBegin;
399   bs2 = bs*bs;
400   if ((stash->n+n) > stash->nmax) {
401     ierr = MatStashExpand_Private(stash,n);CHKERRQ(ierr);
402   }
403   for (i=0; i<n; i++) {
404     stash->idx[stash->n]   = row;
405     stash->idy[stash->n] = idxn[i];
406     /* Now copy over the block of values. Store the values column oriented.
407      This enables inserting multiple blocks belonging to a row with a single
408      funtion call */
409     array = stash->array + bs2*stash->n;
410     vals  = values + idx*bs + bs2*rmax*i;
411     for (j=0; j<bs; j++) {
412       for (k=0; k<bs; k++) {array[k] = vals[k];}
413       array += bs;
414       vals  += rmax*bs;
415     }
416     stash->n++;
417   }
418   PetscFunctionReturn(0);
419 }
420 /*
421   MatStashScatterBegin_Private - Initiates the transfer of values to the
422   correct owners. This function goes through the stash, and check the
423   owners of each stashed value, and sends the values off to the owner
424   processors.
425 
426   Input Parameters:
427   stash  - the stash
428   owners - an array of size 'no-of-procs' which gives the ownership range
429            for each node.
430 
431   Notes: The 'owners' array in the cased of the blocked-stash has the
432   ranges specified blocked global indices, and for the regular stash in
433   the proper global indices.
434 */
435 #undef __FUNCT__
436 #define __FUNCT__ "MatStashScatterBegin_Private"
437 PetscErrorCode MatStashScatterBegin_Private(MatStash *stash,PetscInt *owners)
438 {
439   PetscInt       *owner,*startv,*starti,tag1=stash->tag1,tag2=stash->tag2,bs2;
440   PetscInt       size=stash->size,*nprocs,*nlengths,nsends,nreceives;
441   PetscErrorCode ierr;
442   PetscInt       count,*sindices,**rindices,i,j,idx,lastidx;
443   MatScalar      **rvalues,*svalues;
444   MPI_Comm       comm = stash->comm;
445   MPI_Request    *send_waits,*recv_waits,*recv_waits1,*recv_waits2;
446 
447   PetscFunctionBegin;
448 
449   bs2   = stash->bs*stash->bs;
450   /*  first count number of contributors to each processor */
451   ierr  = PetscMalloc(2*size*sizeof(PetscInt),&nprocs);CHKERRQ(ierr);
452   ierr  = PetscMemzero(nprocs,2*size*sizeof(PetscInt));CHKERRQ(ierr);
453   ierr  = PetscMalloc((stash->n+1)*sizeof(PetscInt),&owner);CHKERRQ(ierr);
454 
455   nlengths = nprocs+size;
456   j        = 0;
457   lastidx  = -1;
458   for (i=0; i<stash->n; i++) {
459     /* if indices are NOT locally sorted, need to start search at the beginning */
460     if (lastidx > (idx = stash->idx[i])) j = 0;
461     lastidx = idx;
462     for (; j<size; j++) {
463       if (idx >= owners[j] && idx < owners[j+1]) {
464         nlengths[j]++; owner[i] = j; break;
465       }
466     }
467   }
468   /* Now check what procs get messages - and compute nsends. */
469   for (i=0, nsends=0 ; i<size; i++) {
470     if (nlengths[i]) { nprocs[i] = 1; nsends ++;}
471   }
472 
473   { int  *onodes,*olengths;
474   /* Determine the number of messages to expect, their lengths, from from-ids */
475   ierr = PetscGatherNumberOfMessages(comm,nprocs,nlengths,&nreceives);CHKERRQ(ierr);
476   ierr = PetscGatherMessageLengths(comm,nsends,nreceives,nlengths,&onodes,&olengths);CHKERRQ(ierr);
477   /* since clubbing row,col - lengths are multiplied by 2 */
478   for (i=0; i<nreceives; i++) olengths[i] *=2;
479   ierr = PetscPostIrecvInt(comm,tag1,nreceives,onodes,olengths,&rindices,&recv_waits1);CHKERRQ(ierr);
480   /* values are size 'bs2' lengths (and remove earlier factor 2 */
481   for (i=0; i<nreceives; i++) olengths[i] = olengths[i]*bs2/2;
482   ierr = PetscPostIrecvScalar(comm,tag2,nreceives,onodes,olengths,&rvalues,&recv_waits2);CHKERRQ(ierr);
483   ierr = PetscFree(onodes);CHKERRQ(ierr);
484   ierr = PetscFree(olengths);CHKERRQ(ierr);
485   }
486 
487   /* do sends:
488       1) starts[i] gives the starting index in svalues for stuff going to
489          the ith processor
490   */
491   ierr     = PetscMalloc((stash->n+1)*(bs2*sizeof(MatScalar)+2*sizeof(PetscInt)),&svalues);CHKERRQ(ierr);
492   sindices = (PetscInt*)(svalues + bs2*stash->n);
493   ierr     = PetscMalloc(2*(nsends+1)*sizeof(MPI_Request),&send_waits);CHKERRQ(ierr);
494   ierr     = PetscMalloc(2*size*sizeof(PetscInt),&startv);CHKERRQ(ierr);
495   starti   = startv + size;
496   /* use 2 sends the first with all_a, the next with all_i and all_j */
497   startv[0]  = 0; starti[0] = 0;
498   for (i=1; i<size; i++) {
499     startv[i] = startv[i-1] + nlengths[i-1];
500     starti[i] = starti[i-1] + nlengths[i-1]*2;
501   }
502   for (i=0; i<stash->n; i++) {
503     j = owner[i];
504     if (bs2 == 1) {
505       svalues[startv[j]]              = stash->array[i];
506     } else {
507       PetscInt       k;
508       MatScalar *buf1,*buf2;
509       buf1 = svalues+bs2*startv[j];
510       buf2 = stash->array+bs2*i;
511       for (k=0; k<bs2; k++){ buf1[k] = buf2[k]; }
512     }
513     sindices[starti[j]]               = stash->idx[i];
514     sindices[starti[j]+nlengths[j]]   = stash->idy[i];
515     startv[j]++;
516     starti[j]++;
517   }
518   startv[0] = 0;
519   for (i=1; i<size; i++) { startv[i] = startv[i-1] + nlengths[i-1];}
520 
521   for (i=0,count=0; i<size; i++) {
522     if (nprocs[i]) {
523       ierr = MPI_Isend(sindices+2*startv[i],2*nlengths[i],MPIU_INT,i,tag1,comm,send_waits+count++);CHKERRQ(ierr);
524       ierr = MPI_Isend(svalues+bs2*startv[i],bs2*nlengths[i],MPIU_MATSCALAR,i,tag2,comm,send_waits+count++);CHKERRQ(ierr);
525     }
526   }
527 #if defined(PETSC_USE_DEBUG)
528   ierr = PetscLogInfo((0,"MatStashScatterBegin_Private: No of messages: %d \n",nsends));CHKERRQ(ierr);
529   for (i=0; i<size; i++) {
530     if (nprocs[i]) {
531       ierr = PetscLogInfo((0,"MatStashScatterBegin_Private: Mesg_to: %d: size: %d \n",i,nlengths[i]*bs2*sizeof(MatScalar)+2*sizeof(PetscInt)));CHKERRQ(ierr);
532     }
533   }
534 #endif
535   ierr = PetscFree(owner);CHKERRQ(ierr);
536   ierr = PetscFree(startv);CHKERRQ(ierr);
537   /* This memory is reused in scatter end  for a different purpose*/
538   for (i=0; i<2*size; i++) nprocs[i] = -1;
539   stash->nprocs      = nprocs;
540 
541   /* recv_waits need to be contiguous for MatStashScatterGetMesg_Private() */
542   ierr  = PetscMalloc((nreceives+1)*2*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr);
543 
544   for (i=0; i<nreceives; i++) {
545     recv_waits[2*i]   = recv_waits1[i];
546     recv_waits[2*i+1] = recv_waits2[i];
547   }
548   stash->recv_waits = recv_waits;
549   ierr = PetscFree(recv_waits1);CHKERRQ(ierr);
550   ierr = PetscFree(recv_waits2);CHKERRQ(ierr);
551 
552   stash->svalues    = svalues;    stash->rvalues     = rvalues;
553   stash->rindices   = rindices;   stash->send_waits  = send_waits;
554   stash->nsends     = nsends;     stash->nrecvs      = nreceives;
555   PetscFunctionReturn(0);
556 }
557 
558 /*
559    MatStashScatterGetMesg_Private - This function waits on the receives posted
560    in the function MatStashScatterBegin_Private() and returns one message at
561    a time to the calling function. If no messages are left, it indicates this
562    by setting flg = 0, else it sets flg = 1.
563 
564    Input Parameters:
565    stash - the stash
566 
567    Output Parameters:
568    nvals - the number of entries in the current message.
569    rows  - an array of row indices (or blocked indices) corresponding to the values
570    cols  - an array of columnindices (or blocked indices) corresponding to the values
571    vals  - the values
572    flg   - 0 indicates no more message left, and the current call has no values associated.
573            1 indicates that the current call successfully received a message, and the
574              other output parameters nvals,rows,cols,vals are set appropriately.
575 */
576 #undef __FUNCT__
577 #define __FUNCT__ "MatStashScatterGetMesg_Private"
578 PetscErrorCode MatStashScatterGetMesg_Private(MatStash *stash,PetscMPIInt *nvals,PetscInt **rows,PetscInt** cols,MatScalar **vals,PetscInt *flg)
579 {
580   PetscErrorCode ierr;
581   PetscMPIInt    i;
582   PetscInt       *flg_v,i1,i2,bs2;
583   MPI_Status     recv_status;
584   PetscTruth     match_found = PETSC_FALSE;
585 
586   PetscFunctionBegin;
587 
588   *flg = 0; /* When a message is discovered this is reset to 1 */
589   /* Return if no more messages to process */
590   if (stash->nprocessed == stash->nrecvs) { PetscFunctionReturn(0); }
591 
592   flg_v = stash->nprocs;
593   bs2   = stash->bs*stash->bs;
594   /* If a matching pair of receieves are found, process them, and return the data to
595      the calling function. Until then keep receiving messages */
596   while (!match_found) {
597     ierr = MPI_Waitany(2*stash->nrecvs,stash->recv_waits,&i,&recv_status);CHKERRQ(ierr);
598     /* Now pack the received message into a structure which is useable by others */
599     if (i % 2) {
600       ierr = MPI_Get_count(&recv_status,MPIU_MATSCALAR,nvals);CHKERRQ(ierr);
601       flg_v[2*recv_status.MPI_SOURCE] = i/2;
602       *nvals = *nvals/bs2;
603     } else {
604       ierr = MPI_Get_count(&recv_status,MPIU_INT,nvals);CHKERRQ(ierr);
605       flg_v[2*recv_status.MPI_SOURCE+1] = i/2;
606       *nvals = *nvals/2; /* This message has both row indices and col indices */
607     }
608 
609     /* Check if we have both the messages from this proc */
610     i1 = flg_v[2*recv_status.MPI_SOURCE];
611     i2 = flg_v[2*recv_status.MPI_SOURCE+1];
612     if (i1 != -1 && i2 != -1) {
613       *rows       = stash->rindices[i2];
614       *cols       = *rows + *nvals;
615       *vals       = stash->rvalues[i1];
616       *flg        = 1;
617       stash->nprocessed ++;
618       match_found = PETSC_TRUE;
619     }
620   }
621   PetscFunctionReturn(0);
622 }
623