xref: /petsc/src/mat/impls/baij/mpi/baijov.c (revision 72a35d6d63ea98b60d8ef4c5aaefda5ff933c0fe)
1 
2 /*
3    Routines to compute overlapping regions of a parallel MPI matrix
4   and to find submatrices that were shared across processors.
5 */
6 #include <../src/mat/impls/baij/mpi/mpibaij.h>
7 #include <petscbt.h>
8 
9 static PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Local(Mat, PetscInt, char **, PetscInt *, PetscInt **);
10 static PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Receive(Mat, PetscInt, PetscInt **, PetscInt **, PetscInt *);
11 extern PetscErrorCode MatGetRow_MPIBAIJ(Mat, PetscInt, PetscInt *, PetscInt **, PetscScalar **);
12 extern PetscErrorCode MatRestoreRow_MPIBAIJ(Mat, PetscInt, PetscInt *, PetscInt **, PetscScalar **);
13 
14 PetscErrorCode MatIncreaseOverlap_MPIBAIJ(Mat C, PetscInt imax, IS is[], PetscInt ov)
15 {
16   PetscInt i, N = C->cmap->N, bs = C->rmap->bs;
17   IS      *is_new;
18 
19   PetscFunctionBegin;
20   PetscCall(PetscMalloc1(imax, &is_new));
21   /* Convert the indices into block format */
22   PetscCall(ISCompressIndicesGeneral(N, C->rmap->n, bs, imax, is, is_new));
23   PetscCheck(ov >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Negative overlap specified");
24   for (i = 0; i < ov; ++i) PetscCall(MatIncreaseOverlap_MPIBAIJ_Once(C, imax, is_new));
25   for (i = 0; i < imax; i++) PetscCall(ISDestroy(&is[i]));
26   PetscCall(ISExpandIndicesGeneral(N, N, bs, imax, is_new, is));
27   for (i = 0; i < imax; i++) PetscCall(ISDestroy(&is_new[i]));
28   PetscCall(PetscFree(is_new));
29   PetscFunctionReturn(PETSC_SUCCESS);
30 }
31 
32 /*
33   Sample message format:
34   If a processor A wants processor B to process some elements corresponding
35   to index sets is[1], is[5]
36   mesg [0] = 2   (no of index sets in the mesg)
37   -----------
38   mesg [1] = 1 => is[1]
39   mesg [2] = sizeof(is[1]);
40   -----------
41   mesg [5] = 5  => is[5]
42   mesg [6] = sizeof(is[5]);
43   -----------
44   mesg [7]
45   mesg [n]  data(is[1])
46   -----------
47   mesg[n+1]
48   mesg[m]  data(is[5])
49   -----------
50 
51   Notes:
52   nrqs - no of requests sent (or to be sent out)
53   nrqr - no of requests received (which have to be or which have been processed)
54 */
55 PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Once(Mat C, PetscInt imax, IS is[])
56 {
57   Mat_MPIBAIJ     *c = (Mat_MPIBAIJ *)C->data;
58   const PetscInt **idx, *idx_i;
59   PetscInt        *n, *w3, *w4, **data, len;
60   PetscMPIInt      size, rank, tag1, tag2, *w2, *w1, nrqr;
61   PetscInt         Mbs, i, j, k, **rbuf, row, nrqs, msz, **outdat, **ptr;
62   PetscInt        *ctr, *pa, *tmp, *isz, *isz1, **xdata, **rbuf2, *d_p;
63   PetscMPIInt     *onodes1, *olengths1, *onodes2, *olengths2, proc = -1;
64   PetscBT         *table;
65   MPI_Comm         comm, *iscomms;
66   MPI_Request     *s_waits1, *r_waits1, *s_waits2, *r_waits2;
67   char            *t_p;
68 
69   PetscFunctionBegin;
70   PetscCall(PetscObjectGetComm((PetscObject)C, &comm));
71   size = c->size;
72   rank = c->rank;
73   Mbs  = c->Mbs;
74 
75   PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag1));
76   PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag2));
77 
78   PetscCall(PetscMalloc2(imax + 1, (PetscInt ***)&idx, imax, &n));
79 
80   for (i = 0; i < imax; i++) {
81     PetscCall(ISGetIndices(is[i], &idx[i]));
82     PetscCall(ISGetLocalSize(is[i], &n[i]));
83   }
84 
85   /* evaluate communication - mesg to who,length of mesg, and buffer space
86      required. Based on this, buffers are allocated, and data copied into them*/
87   PetscCall(PetscCalloc4(size, &w1, size, &w2, size, &w3, size, &w4));
88   for (i = 0; i < imax; i++) {
89     PetscCall(PetscArrayzero(w4, size)); /* initialise work vector*/
90     idx_i = idx[i];
91     len   = n[i];
92     for (j = 0; j < len; j++) {
93       row = idx_i[j];
94       PetscCheck(row >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Index set cannot have negative entries");
95       PetscCall(PetscLayoutFindOwner(C->rmap, row * C->rmap->bs, &proc));
96       w4[proc]++;
97     }
98     for (j = 0; j < size; j++) {
99       if (w4[j]) {
100         w1[j] += w4[j];
101         w3[j]++;
102       }
103     }
104   }
105 
106   nrqs     = 0; /* no of outgoing messages */
107   msz      = 0; /* total mesg length (for all proc */
108   w1[rank] = 0; /* no mesg sent to itself */
109   w3[rank] = 0;
110   for (i = 0; i < size; i++) {
111     if (w1[i]) {
112       w2[i] = 1;
113       nrqs++;
114     } /* there exists a message to proc i */
115   }
116   /* pa - is list of processors to communicate with */
117   PetscCall(PetscMalloc1(nrqs, &pa));
118   for (i = 0, j = 0; i < size; i++) {
119     if (w1[i]) {
120       pa[j] = i;
121       j++;
122     }
123   }
124 
125   /* Each message would have a header = 1 + 2*(no of IS) + data */
126   for (i = 0; i < nrqs; i++) {
127     j = pa[i];
128     w1[j] += w2[j] + 2 * w3[j];
129     msz += w1[j];
130   }
131 
132   /* Determine the number of messages to expect, their lengths, from from-ids */
133   PetscCall(PetscGatherNumberOfMessages(comm, w2, w1, &nrqr));
134   PetscCall(PetscGatherMessageLengths(comm, nrqs, nrqr, w1, &onodes1, &olengths1));
135 
136   /* Now post the Irecvs corresponding to these messages */
137   PetscCall(PetscPostIrecvInt(comm, tag1, nrqr, onodes1, olengths1, &rbuf, &r_waits1));
138 
139   /* Allocate Memory for outgoing messages */
140   PetscCall(PetscMalloc4(size, &outdat, size, &ptr, msz, &tmp, size, &ctr));
141   PetscCall(PetscArrayzero(outdat, size));
142   PetscCall(PetscArrayzero(ptr, size));
143   {
144     PetscInt *iptr = tmp, ict = 0;
145     for (i = 0; i < nrqs; i++) {
146       j = pa[i];
147       iptr += ict;
148       outdat[j] = iptr;
149       ict       = w1[j];
150     }
151   }
152 
153   /* Form the outgoing messages */
154   /*plug in the headers*/
155   for (i = 0; i < nrqs; i++) {
156     j            = pa[i];
157     outdat[j][0] = 0;
158     PetscCall(PetscArrayzero(outdat[j] + 1, 2 * w3[j]));
159     ptr[j] = outdat[j] + 2 * w3[j] + 1;
160   }
161 
162   /* Memory for doing local proc's work*/
163   {
164     PetscCall(PetscCalloc5(imax, &table, imax, &data, imax, &isz, Mbs * imax, &d_p, (Mbs / PETSC_BITS_PER_BYTE + 1) * imax, &t_p));
165 
166     for (i = 0; i < imax; i++) {
167       table[i] = t_p + (Mbs / PETSC_BITS_PER_BYTE + 1) * i;
168       data[i]  = d_p + (Mbs)*i;
169     }
170   }
171 
172   /* Parse the IS and update local tables and the outgoing buf with the data*/
173   {
174     PetscInt n_i, *data_i, isz_i, *outdat_j, ctr_j;
175     PetscBT  table_i;
176 
177     for (i = 0; i < imax; i++) {
178       PetscCall(PetscArrayzero(ctr, size));
179       n_i     = n[i];
180       table_i = table[i];
181       idx_i   = idx[i];
182       data_i  = data[i];
183       isz_i   = isz[i];
184       for (j = 0; j < n_i; j++) { /* parse the indices of each IS */
185         row = idx_i[j];
186         PetscCall(PetscLayoutFindOwner(C->rmap, row * C->rmap->bs, &proc));
187         if (proc != rank) { /* copy to the outgoing buffer */
188           ctr[proc]++;
189           *ptr[proc] = row;
190           ptr[proc]++;
191         } else { /* Update the local table */
192           if (!PetscBTLookupSet(table_i, row)) data_i[isz_i++] = row;
193         }
194       }
195       /* Update the headers for the current IS */
196       for (j = 0; j < size; j++) { /* Can Optimise this loop by using pa[] */
197         if ((ctr_j = ctr[j])) {
198           outdat_j            = outdat[j];
199           k                   = ++outdat_j[0];
200           outdat_j[2 * k]     = ctr_j;
201           outdat_j[2 * k - 1] = i;
202         }
203       }
204       isz[i] = isz_i;
205     }
206   }
207 
208   /*  Now  post the sends */
209   PetscCall(PetscMalloc1(nrqs, &s_waits1));
210   for (i = 0; i < nrqs; ++i) {
211     j = pa[i];
212     PetscCallMPI(MPI_Isend(outdat[j], w1[j], MPIU_INT, j, tag1, comm, s_waits1 + i));
213   }
214 
215   /* No longer need the original indices*/
216   for (i = 0; i < imax; ++i) PetscCall(ISRestoreIndices(is[i], idx + i));
217   PetscCall(PetscFree2(*(PetscInt ***)&idx, n));
218 
219   PetscCall(PetscMalloc1(imax, &iscomms));
220   for (i = 0; i < imax; ++i) {
221     PetscCall(PetscCommDuplicate(PetscObjectComm((PetscObject)is[i]), &iscomms[i], NULL));
222     PetscCall(ISDestroy(&is[i]));
223   }
224 
225   /* Do Local work*/
226   PetscCall(MatIncreaseOverlap_MPIBAIJ_Local(C, imax, table, isz, data));
227 
228   /* Receive messages*/
229   PetscCallMPI(MPI_Waitall(nrqr, r_waits1, MPI_STATUSES_IGNORE));
230   PetscCallMPI(MPI_Waitall(nrqs, s_waits1, MPI_STATUSES_IGNORE));
231 
232   /* Phase 1 sends are complete - deallocate buffers */
233   PetscCall(PetscFree4(outdat, ptr, tmp, ctr));
234   PetscCall(PetscFree4(w1, w2, w3, w4));
235 
236   PetscCall(PetscMalloc1(nrqr, &xdata));
237   PetscCall(PetscMalloc1(nrqr, &isz1));
238   PetscCall(MatIncreaseOverlap_MPIBAIJ_Receive(C, nrqr, rbuf, xdata, isz1));
239   if (rbuf) {
240     PetscCall(PetscFree(rbuf[0]));
241     PetscCall(PetscFree(rbuf));
242   }
243 
244   /* Send the data back*/
245   /* Do a global reduction to know the buffer space req for incoming messages*/
246   {
247     PetscMPIInt *rw1;
248 
249     PetscCall(PetscCalloc1(size, &rw1));
250 
251     for (i = 0; i < nrqr; ++i) {
252       proc      = onodes1[i];
253       rw1[proc] = isz1[i];
254     }
255 
256     /* Determine the number of messages to expect, their lengths, from from-ids */
257     PetscCall(PetscGatherMessageLengths(comm, nrqr, nrqs, rw1, &onodes2, &olengths2));
258     PetscCall(PetscFree(rw1));
259   }
260   /* Now post the Irecvs corresponding to these messages */
261   PetscCall(PetscPostIrecvInt(comm, tag2, nrqs, onodes2, olengths2, &rbuf2, &r_waits2));
262 
263   /*  Now  post the sends */
264   PetscCall(PetscMalloc1(nrqr, &s_waits2));
265   for (i = 0; i < nrqr; ++i) {
266     j = onodes1[i];
267     PetscCallMPI(MPI_Isend(xdata[i], isz1[i], MPIU_INT, j, tag2, comm, s_waits2 + i));
268   }
269 
270   PetscCall(PetscFree(onodes1));
271   PetscCall(PetscFree(olengths1));
272 
273   /* receive work done on other processors*/
274   {
275     PetscMPIInt idex;
276     PetscInt    is_no, ct1, max, *rbuf2_i, isz_i, *data_i, jmax;
277     PetscBT     table_i;
278 
279     for (i = 0; i < nrqs; ++i) {
280       PetscCallMPI(MPI_Waitany(nrqs, r_waits2, &idex, MPI_STATUS_IGNORE));
281       /* Process the message*/
282       rbuf2_i = rbuf2[idex];
283       ct1     = 2 * rbuf2_i[0] + 1;
284       jmax    = rbuf2[idex][0];
285       for (j = 1; j <= jmax; j++) {
286         max     = rbuf2_i[2 * j];
287         is_no   = rbuf2_i[2 * j - 1];
288         isz_i   = isz[is_no];
289         data_i  = data[is_no];
290         table_i = table[is_no];
291         for (k = 0; k < max; k++, ct1++) {
292           row = rbuf2_i[ct1];
293           if (!PetscBTLookupSet(table_i, row)) data_i[isz_i++] = row;
294         }
295         isz[is_no] = isz_i;
296       }
297     }
298     PetscCallMPI(MPI_Waitall(nrqr, s_waits2, MPI_STATUSES_IGNORE));
299   }
300 
301   for (i = 0; i < imax; ++i) {
302     PetscCall(ISCreateGeneral(iscomms[i], isz[i], data[i], PETSC_COPY_VALUES, is + i));
303     PetscCall(PetscCommDestroy(&iscomms[i]));
304   }
305 
306   PetscCall(PetscFree(iscomms));
307   PetscCall(PetscFree(onodes2));
308   PetscCall(PetscFree(olengths2));
309 
310   PetscCall(PetscFree(pa));
311   if (rbuf2) {
312     PetscCall(PetscFree(rbuf2[0]));
313     PetscCall(PetscFree(rbuf2));
314   }
315   PetscCall(PetscFree(s_waits1));
316   PetscCall(PetscFree(r_waits1));
317   PetscCall(PetscFree(s_waits2));
318   PetscCall(PetscFree(r_waits2));
319   PetscCall(PetscFree5(table, data, isz, d_p, t_p));
320   if (xdata) {
321     PetscCall(PetscFree(xdata[0]));
322     PetscCall(PetscFree(xdata));
323   }
324   PetscCall(PetscFree(isz1));
325   PetscFunctionReturn(PETSC_SUCCESS);
326 }
327 
328 /*
329    MatIncreaseOverlap_MPIBAIJ_Local - Called by MatincreaseOverlap, to do
330        the work on the local processor.
331 
332      Inputs:
333       C      - MAT_MPIBAIJ;
334       imax - total no of index sets processed at a time;
335       table  - an array of char - size = Mbs bits.
336 
337      Output:
338       isz    - array containing the count of the solution elements corresponding
339                to each index set;
340       data   - pointer to the solutions
341 */
342 static PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Local(Mat C, PetscInt imax, PetscBT *table, PetscInt *isz, PetscInt **data)
343 {
344   Mat_MPIBAIJ *c = (Mat_MPIBAIJ *)C->data;
345   Mat          A = c->A, B = c->B;
346   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data, *b = (Mat_SeqBAIJ *)B->data;
347   PetscInt     start, end, val, max, rstart, cstart, *ai, *aj;
348   PetscInt    *bi, *bj, *garray, i, j, k, row, *data_i, isz_i;
349   PetscBT      table_i;
350 
351   PetscFunctionBegin;
352   rstart = c->rstartbs;
353   cstart = c->cstartbs;
354   ai     = a->i;
355   aj     = a->j;
356   bi     = b->i;
357   bj     = b->j;
358   garray = c->garray;
359 
360   for (i = 0; i < imax; i++) {
361     data_i  = data[i];
362     table_i = table[i];
363     isz_i   = isz[i];
364     for (j = 0, max = isz[i]; j < max; j++) {
365       row   = data_i[j] - rstart;
366       start = ai[row];
367       end   = ai[row + 1];
368       for (k = start; k < end; k++) { /* Amat */
369         val = aj[k] + cstart;
370         if (!PetscBTLookupSet(table_i, val)) data_i[isz_i++] = val;
371       }
372       start = bi[row];
373       end   = bi[row + 1];
374       for (k = start; k < end; k++) { /* Bmat */
375         val = garray[bj[k]];
376         if (!PetscBTLookupSet(table_i, val)) data_i[isz_i++] = val;
377       }
378     }
379     isz[i] = isz_i;
380   }
381   PetscFunctionReturn(PETSC_SUCCESS);
382 }
383 /*
384       MatIncreaseOverlap_MPIBAIJ_Receive - Process the received messages,
385          and return the output
386 
387          Input:
388            C    - the matrix
389            nrqr - no of messages being processed.
390            rbuf - an array of pointers to the received requests
391 
392          Output:
393            xdata - array of messages to be sent back
394            isz1  - size of each message
395 
396   For better efficiency perhaps we should malloc separately each xdata[i],
397 then if a remalloc is required we need only copy the data for that one row
398 rather than all previous rows as it is now where a single large chunk of
399 memory is used.
400 
401 */
402 static PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Receive(Mat C, PetscInt nrqr, PetscInt **rbuf, PetscInt **xdata, PetscInt *isz1)
403 {
404   Mat_MPIBAIJ *c = (Mat_MPIBAIJ *)C->data;
405   Mat          A = c->A, B = c->B;
406   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data, *b = (Mat_SeqBAIJ *)B->data;
407   PetscInt     rstart, cstart, *ai, *aj, *bi, *bj, *garray, i, j, k;
408   PetscInt     row, total_sz, ct, ct1, ct2, ct3, mem_estimate, oct2, l, start, end;
409   PetscInt     val, max1, max2, Mbs, no_malloc = 0, *tmp, new_estimate, ctr;
410   PetscInt    *rbuf_i, kmax, rbuf_0;
411   PetscBT      xtable;
412 
413   PetscFunctionBegin;
414   Mbs    = c->Mbs;
415   rstart = c->rstartbs;
416   cstart = c->cstartbs;
417   ai     = a->i;
418   aj     = a->j;
419   bi     = b->i;
420   bj     = b->j;
421   garray = c->garray;
422 
423   for (i = 0, ct = 0, total_sz = 0; i < nrqr; ++i) {
424     rbuf_i = rbuf[i];
425     rbuf_0 = rbuf_i[0];
426     ct += rbuf_0;
427     for (j = 1; j <= rbuf_0; j++) total_sz += rbuf_i[2 * j];
428   }
429 
430   if (c->Mbs) max1 = ct * (a->nz + b->nz) / c->Mbs;
431   else max1 = 1;
432   mem_estimate = 3 * ((total_sz > max1 ? total_sz : max1) + 1);
433   if (nrqr) {
434     PetscCall(PetscMalloc1(mem_estimate, &xdata[0]));
435     ++no_malloc;
436   }
437   PetscCall(PetscBTCreate(Mbs, &xtable));
438   PetscCall(PetscArrayzero(isz1, nrqr));
439 
440   ct3 = 0;
441   for (i = 0; i < nrqr; i++) { /* for easch mesg from proc i */
442     rbuf_i = rbuf[i];
443     rbuf_0 = rbuf_i[0];
444     ct1    = 2 * rbuf_0 + 1;
445     ct2    = ct1;
446     ct3 += ct1;
447     for (j = 1; j <= rbuf_0; j++) { /* for each IS from proc i*/
448       PetscCall(PetscBTMemzero(Mbs, xtable));
449       oct2 = ct2;
450       kmax = rbuf_i[2 * j];
451       for (k = 0; k < kmax; k++, ct1++) {
452         row = rbuf_i[ct1];
453         if (!PetscBTLookupSet(xtable, row)) {
454           if (!(ct3 < mem_estimate)) {
455             new_estimate = (PetscInt)(1.5 * mem_estimate) + 1;
456             PetscCall(PetscMalloc1(new_estimate, &tmp));
457             PetscCall(PetscArraycpy(tmp, xdata[0], mem_estimate));
458             PetscCall(PetscFree(xdata[0]));
459             xdata[0]     = tmp;
460             mem_estimate = new_estimate;
461             ++no_malloc;
462             for (ctr = 1; ctr <= i; ctr++) xdata[ctr] = xdata[ctr - 1] + isz1[ctr - 1];
463           }
464           xdata[i][ct2++] = row;
465           ct3++;
466         }
467       }
468       for (k = oct2, max2 = ct2; k < max2; k++) {
469         row   = xdata[i][k] - rstart;
470         start = ai[row];
471         end   = ai[row + 1];
472         for (l = start; l < end; l++) {
473           val = aj[l] + cstart;
474           if (!PetscBTLookupSet(xtable, val)) {
475             if (!(ct3 < mem_estimate)) {
476               new_estimate = (PetscInt)(1.5 * mem_estimate) + 1;
477               PetscCall(PetscMalloc1(new_estimate, &tmp));
478               PetscCall(PetscArraycpy(tmp, xdata[0], mem_estimate));
479               PetscCall(PetscFree(xdata[0]));
480               xdata[0]     = tmp;
481               mem_estimate = new_estimate;
482               ++no_malloc;
483               for (ctr = 1; ctr <= i; ctr++) xdata[ctr] = xdata[ctr - 1] + isz1[ctr - 1];
484             }
485             xdata[i][ct2++] = val;
486             ct3++;
487           }
488         }
489         start = bi[row];
490         end   = bi[row + 1];
491         for (l = start; l < end; l++) {
492           val = garray[bj[l]];
493           if (!PetscBTLookupSet(xtable, val)) {
494             if (!(ct3 < mem_estimate)) {
495               new_estimate = (PetscInt)(1.5 * mem_estimate) + 1;
496               PetscCall(PetscMalloc1(new_estimate, &tmp));
497               PetscCall(PetscArraycpy(tmp, xdata[0], mem_estimate));
498               PetscCall(PetscFree(xdata[0]));
499               xdata[0]     = tmp;
500               mem_estimate = new_estimate;
501               ++no_malloc;
502               for (ctr = 1; ctr <= i; ctr++) xdata[ctr] = xdata[ctr - 1] + isz1[ctr - 1];
503             }
504             xdata[i][ct2++] = val;
505             ct3++;
506           }
507         }
508       }
509       /* Update the header*/
510       xdata[i][2 * j]     = ct2 - oct2; /* Undo the vector isz1 and use only a var*/
511       xdata[i][2 * j - 1] = rbuf_i[2 * j - 1];
512     }
513     xdata[i][0] = rbuf_0;
514     if (i + 1 < nrqr) xdata[i + 1] = xdata[i] + ct2;
515     isz1[i] = ct2; /* size of each message */
516   }
517   PetscCall(PetscBTDestroy(&xtable));
518   PetscCall(PetscInfo(C, "Allocated %" PetscInt_FMT " bytes, required %" PetscInt_FMT ", no of mallocs = %" PetscInt_FMT "\n", mem_estimate, ct3, no_malloc));
519   PetscFunctionReturn(PETSC_SUCCESS);
520 }
521 
522 PetscErrorCode MatCreateSubMatrices_MPIBAIJ(Mat C, PetscInt ismax, const IS isrow[], const IS iscol[], MatReuse scall, Mat *submat[])
523 {
524   IS          *isrow_block, *iscol_block;
525   Mat_MPIBAIJ *c = (Mat_MPIBAIJ *)C->data;
526   PetscInt     nmax, nstages_local, nstages, i, pos, max_no, N = C->cmap->N, bs = C->rmap->bs;
527   Mat_SeqBAIJ *subc;
528   Mat_SubSppt *smat;
529 
530   PetscFunctionBegin;
531   /* The compression and expansion should be avoided. Doesn't point
532      out errors, might change the indices, hence buggey */
533   PetscCall(PetscMalloc2(ismax + 1, &isrow_block, ismax + 1, &iscol_block));
534   PetscCall(ISCompressIndicesGeneral(N, C->rmap->n, bs, ismax, isrow, isrow_block));
535   PetscCall(ISCompressIndicesGeneral(N, C->cmap->n, bs, ismax, iscol, iscol_block));
536 
537   /* Determine the number of stages through which submatrices are done */
538   if (!C->cmap->N) nmax = 20 * 1000000 / sizeof(PetscInt);
539   else nmax = 20 * 1000000 / (c->Nbs * sizeof(PetscInt));
540   if (!nmax) nmax = 1;
541 
542   if (scall == MAT_INITIAL_MATRIX) {
543     nstages_local = ismax / nmax + ((ismax % nmax) ? 1 : 0); /* local nstages */
544 
545     /* Make sure every processor loops through the nstages */
546     PetscCall(MPIU_Allreduce(&nstages_local, &nstages, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)C)));
547 
548     /* Allocate memory to hold all the submatrices and dummy submatrices */
549     PetscCall(PetscCalloc1(ismax + nstages, submat));
550   } else { /* MAT_REUSE_MATRIX */
551     if (ismax) {
552       subc = (Mat_SeqBAIJ *)((*submat)[0]->data);
553       smat = subc->submatis1;
554     } else { /* (*submat)[0] is a dummy matrix */
555       smat = (Mat_SubSppt *)(*submat)[0]->data;
556     }
557     PetscCheck(smat, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "MatCreateSubMatrices(...,MAT_REUSE_MATRIX,...) requires submat");
558     nstages = smat->nstages;
559   }
560 
561   for (i = 0, pos = 0; i < nstages; i++) {
562     if (pos + nmax <= ismax) max_no = nmax;
563     else if (pos >= ismax) max_no = 0;
564     else max_no = ismax - pos;
565 
566     PetscCall(MatCreateSubMatrices_MPIBAIJ_local(C, max_no, isrow_block + pos, iscol_block + pos, scall, *submat + pos));
567     if (!max_no) {
568       if (scall == MAT_INITIAL_MATRIX) { /* submat[pos] is a dummy matrix */
569         smat          = (Mat_SubSppt *)(*submat)[pos]->data;
570         smat->nstages = nstages;
571       }
572       pos++; /* advance to next dummy matrix if any */
573     } else pos += max_no;
574   }
575 
576   if (scall == MAT_INITIAL_MATRIX && ismax) {
577     /* save nstages for reuse */
578     subc          = (Mat_SeqBAIJ *)((*submat)[0]->data);
579     smat          = subc->submatis1;
580     smat->nstages = nstages;
581   }
582 
583   for (i = 0; i < ismax; i++) {
584     PetscCall(ISDestroy(&isrow_block[i]));
585     PetscCall(ISDestroy(&iscol_block[i]));
586   }
587   PetscCall(PetscFree2(isrow_block, iscol_block));
588   PetscFunctionReturn(PETSC_SUCCESS);
589 }
590 
591 #if defined(PETSC_USE_CTABLE)
592 PetscErrorCode PetscGetProc(const PetscInt row, const PetscMPIInt size, const PetscInt proc_gnode[], PetscMPIInt *rank)
593 {
594   PetscInt    nGlobalNd = proc_gnode[size];
595   PetscMPIInt fproc;
596 
597   PetscFunctionBegin;
598   PetscCall(PetscMPIIntCast((PetscInt)(((float)row * (float)size / (float)nGlobalNd + 0.5)), &fproc));
599   if (fproc > size) fproc = size;
600   while (row < proc_gnode[fproc] || row >= proc_gnode[fproc + 1]) {
601     if (row < proc_gnode[fproc]) fproc--;
602     else fproc++;
603   }
604   *rank = fproc;
605   PetscFunctionReturn(PETSC_SUCCESS);
606 }
607 #endif
608 
609 /* This code is used for BAIJ and SBAIJ matrices (unfortunate dependency) */
610 PetscErrorCode MatCreateSubMatrices_MPIBAIJ_local(Mat C, PetscInt ismax, const IS isrow[], const IS iscol[], MatReuse scall, Mat *submats)
611 {
612   Mat_MPIBAIJ     *c = (Mat_MPIBAIJ *)C->data;
613   Mat              A = c->A;
614   Mat_SeqBAIJ     *a = (Mat_SeqBAIJ *)A->data, *b = (Mat_SeqBAIJ *)c->B->data, *subc;
615   const PetscInt **icol, **irow;
616   PetscInt        *nrow, *ncol, start;
617   PetscMPIInt      rank, size, tag0, tag2, tag3, tag4, *w1, *w2, *w3, *w4, nrqr;
618   PetscInt       **sbuf1, **sbuf2, *sbuf2_i, i, j, k, l, ct1, ct2, **rbuf1, row, proc = -1;
619   PetscInt         nrqs = 0, msz, **ptr = NULL, *req_size = NULL, *ctr = NULL, *pa, *tmp = NULL, tcol;
620   PetscInt       **rbuf3 = NULL, *req_source1 = NULL, *req_source2, **sbuf_aj, **rbuf2 = NULL, max1, max2;
621   PetscInt       **lens, is_no, ncols, *cols, mat_i, *mat_j, tmp2, jmax;
622 #if defined(PETSC_USE_CTABLE)
623   PetscHMapI *cmap, cmap_i = NULL, *rmap, rmap_i;
624 #else
625   PetscInt **cmap, *cmap_i = NULL, **rmap, *rmap_i;
626 #endif
627   const PetscInt *irow_i, *icol_i;
628   PetscInt        ctr_j, *sbuf1_j, *sbuf_aj_i, *rbuf1_i, kmax, *lens_i;
629   MPI_Request    *s_waits1, *r_waits1, *s_waits2, *r_waits2, *r_waits3;
630   MPI_Request    *r_waits4, *s_waits3, *s_waits4;
631   MPI_Comm        comm;
632   PetscScalar   **rbuf4, *rbuf4_i = NULL, **sbuf_aa, *vals, *mat_a = NULL, *imat_a = NULL, *sbuf_aa_i;
633   PetscMPIInt    *onodes1, *olengths1, end;
634   PetscInt      **row2proc, *row2proc_i, *imat_ilen, *imat_j, *imat_i;
635   Mat_SubSppt    *smat_i;
636   PetscBool      *issorted, colflag, iscsorted = PETSC_TRUE;
637   PetscInt       *sbuf1_i, *rbuf2_i, *rbuf3_i, ilen;
638   PetscInt        bs = C->rmap->bs, bs2 = c->bs2, rstart = c->rstartbs;
639   PetscBool       ijonly = c->ijonly; /* private flag indicates only matrix data structures are requested */
640   PetscInt        nzA, nzB, *a_i = a->i, *b_i = b->i, *a_j = a->j, *b_j = b->j, ctmp, imark, *cworkA, *cworkB;
641   PetscScalar    *vworkA = NULL, *vworkB = NULL, *a_a = a->a, *b_a = b->a;
642   PetscInt        cstart = c->cstartbs, *bmap = c->garray;
643   PetscBool      *allrows, *allcolumns;
644 
645   PetscFunctionBegin;
646   PetscCall(PetscObjectGetComm((PetscObject)C, &comm));
647   size = c->size;
648   rank = c->rank;
649 
650   PetscCall(PetscMalloc5(ismax, &row2proc, ismax, &cmap, ismax, &rmap, ismax + 1, &allcolumns, ismax, &allrows));
651   PetscCall(PetscMalloc5(ismax, (PetscInt ***)&irow, ismax, (PetscInt ***)&icol, ismax, &nrow, ismax, &ncol, ismax, &issorted));
652 
653   for (i = 0; i < ismax; i++) {
654     PetscCall(ISSorted(iscol[i], &issorted[i]));
655     if (!issorted[i]) iscsorted = issorted[i]; /* columns are not sorted! */
656     PetscCall(ISSorted(isrow[i], &issorted[i]));
657 
658     /* Check for special case: allcolumns */
659     PetscCall(ISIdentity(iscol[i], &colflag));
660     PetscCall(ISGetLocalSize(iscol[i], &ncol[i]));
661 
662     if (colflag && ncol[i] == c->Nbs) {
663       allcolumns[i] = PETSC_TRUE;
664       icol[i]       = NULL;
665     } else {
666       allcolumns[i] = PETSC_FALSE;
667       PetscCall(ISGetIndices(iscol[i], &icol[i]));
668     }
669 
670     /* Check for special case: allrows */
671     PetscCall(ISIdentity(isrow[i], &colflag));
672     PetscCall(ISGetLocalSize(isrow[i], &nrow[i]));
673     if (colflag && nrow[i] == c->Mbs) {
674       allrows[i] = PETSC_TRUE;
675       irow[i]    = NULL;
676     } else {
677       allrows[i] = PETSC_FALSE;
678       PetscCall(ISGetIndices(isrow[i], &irow[i]));
679     }
680   }
681 
682   if (scall == MAT_REUSE_MATRIX) {
683     /* Assumes new rows are same length as the old rows */
684     for (i = 0; i < ismax; i++) {
685       subc = (Mat_SeqBAIJ *)(submats[i]->data);
686       PetscCheck(subc->mbs == nrow[i] && subc->nbs == ncol[i], PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Cannot reuse matrix. wrong size");
687 
688       /* Initial matrix as if empty */
689       PetscCall(PetscArrayzero(subc->ilen, subc->mbs));
690 
691       /* Initial matrix as if empty */
692       submats[i]->factortype = C->factortype;
693 
694       smat_i = subc->submatis1;
695 
696       nrqs        = smat_i->nrqs;
697       nrqr        = smat_i->nrqr;
698       rbuf1       = smat_i->rbuf1;
699       rbuf2       = smat_i->rbuf2;
700       rbuf3       = smat_i->rbuf3;
701       req_source2 = smat_i->req_source2;
702 
703       sbuf1 = smat_i->sbuf1;
704       sbuf2 = smat_i->sbuf2;
705       ptr   = smat_i->ptr;
706       tmp   = smat_i->tmp;
707       ctr   = smat_i->ctr;
708 
709       pa          = smat_i->pa;
710       req_size    = smat_i->req_size;
711       req_source1 = smat_i->req_source1;
712 
713       allcolumns[i] = smat_i->allcolumns;
714       allrows[i]    = smat_i->allrows;
715       row2proc[i]   = smat_i->row2proc;
716       rmap[i]       = smat_i->rmap;
717       cmap[i]       = smat_i->cmap;
718     }
719 
720     if (!ismax) { /* Get dummy submatrices and retrieve struct submatis1 */
721       PetscCheck(submats[0], PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "submats are null, cannot reuse");
722       smat_i = (Mat_SubSppt *)submats[0]->data;
723 
724       nrqs        = smat_i->nrqs;
725       nrqr        = smat_i->nrqr;
726       rbuf1       = smat_i->rbuf1;
727       rbuf2       = smat_i->rbuf2;
728       rbuf3       = smat_i->rbuf3;
729       req_source2 = smat_i->req_source2;
730 
731       sbuf1 = smat_i->sbuf1;
732       sbuf2 = smat_i->sbuf2;
733       ptr   = smat_i->ptr;
734       tmp   = smat_i->tmp;
735       ctr   = smat_i->ctr;
736 
737       pa          = smat_i->pa;
738       req_size    = smat_i->req_size;
739       req_source1 = smat_i->req_source1;
740 
741       allcolumns[0] = PETSC_FALSE;
742     }
743   } else { /* scall == MAT_INITIAL_MATRIX */
744     /* Get some new tags to keep the communication clean */
745     PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag2));
746     PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag3));
747 
748     /* evaluate communication - mesg to who, length of mesg, and buffer space
749      required. Based on this, buffers are allocated, and data copied into them*/
750     PetscCall(PetscCalloc4(size, &w1, size, &w2, size, &w3, size, &w4)); /* mesg size, initialize work vectors */
751 
752     for (i = 0; i < ismax; i++) {
753       jmax   = nrow[i];
754       irow_i = irow[i];
755 
756       PetscCall(PetscMalloc1(jmax, &row2proc_i));
757       row2proc[i] = row2proc_i;
758 
759       if (issorted[i]) proc = 0;
760       for (j = 0; j < jmax; j++) {
761         if (!issorted[i]) proc = 0;
762         if (allrows[i]) row = j;
763         else row = irow_i[j];
764 
765         while (row >= c->rangebs[proc + 1]) proc++;
766         w4[proc]++;
767         row2proc_i[j] = proc; /* map row index to proc */
768       }
769       for (j = 0; j < size; j++) {
770         if (w4[j]) {
771           w1[j] += w4[j];
772           w3[j]++;
773           w4[j] = 0;
774         }
775       }
776     }
777 
778     nrqs     = 0; /* no of outgoing messages */
779     msz      = 0; /* total mesg length (for all procs) */
780     w1[rank] = 0; /* no mesg sent to self */
781     w3[rank] = 0;
782     for (i = 0; i < size; i++) {
783       if (w1[i]) {
784         w2[i] = 1;
785         nrqs++;
786       } /* there exists a message to proc i */
787     }
788     PetscCall(PetscMalloc1(nrqs, &pa)); /*(proc -array)*/
789     for (i = 0, j = 0; i < size; i++) {
790       if (w1[i]) {
791         pa[j] = i;
792         j++;
793       }
794     }
795 
796     /* Each message would have a header = 1 + 2*(no of IS) + data */
797     for (i = 0; i < nrqs; i++) {
798       j = pa[i];
799       w1[j] += w2[j] + 2 * w3[j];
800       msz += w1[j];
801     }
802     PetscCall(PetscInfo(0, "Number of outgoing messages %" PetscInt_FMT " Total message length %" PetscInt_FMT "\n", nrqs, msz));
803 
804     /* Determine the number of messages to expect, their lengths, from from-ids */
805     PetscCall(PetscGatherNumberOfMessages(comm, w2, w1, &nrqr));
806     PetscCall(PetscGatherMessageLengths(comm, nrqs, nrqr, w1, &onodes1, &olengths1));
807 
808     /* Now post the Irecvs corresponding to these messages */
809     PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag0));
810     PetscCall(PetscPostIrecvInt(comm, tag0, nrqr, onodes1, olengths1, &rbuf1, &r_waits1));
811 
812     /* Allocate Memory for outgoing messages */
813     PetscCall(PetscMalloc4(size, &sbuf1, size, &ptr, 2 * msz, &tmp, size, &ctr));
814     PetscCall(PetscArrayzero(sbuf1, size));
815     PetscCall(PetscArrayzero(ptr, size));
816 
817     {
818       PetscInt *iptr = tmp;
819       k              = 0;
820       for (i = 0; i < nrqs; i++) {
821         j = pa[i];
822         iptr += k;
823         sbuf1[j] = iptr;
824         k        = w1[j];
825       }
826     }
827 
828     /* Form the outgoing messages. Initialize the header space */
829     for (i = 0; i < nrqs; i++) {
830       j           = pa[i];
831       sbuf1[j][0] = 0;
832       PetscCall(PetscArrayzero(sbuf1[j] + 1, 2 * w3[j]));
833       ptr[j] = sbuf1[j] + 2 * w3[j] + 1;
834     }
835 
836     /* Parse the isrow and copy data into outbuf */
837     for (i = 0; i < ismax; i++) {
838       row2proc_i = row2proc[i];
839       PetscCall(PetscArrayzero(ctr, size));
840       irow_i = irow[i];
841       jmax   = nrow[i];
842       for (j = 0; j < jmax; j++) { /* parse the indices of each IS */
843         proc = row2proc_i[j];
844         if (allrows[i]) row = j;
845         else row = irow_i[j];
846 
847         if (proc != rank) { /* copy to the outgoing buf*/
848           ctr[proc]++;
849           *ptr[proc] = row;
850           ptr[proc]++;
851         }
852       }
853       /* Update the headers for the current IS */
854       for (j = 0; j < size; j++) { /* Can Optimise this loop too */
855         if ((ctr_j = ctr[j])) {
856           sbuf1_j            = sbuf1[j];
857           k                  = ++sbuf1_j[0];
858           sbuf1_j[2 * k]     = ctr_j;
859           sbuf1_j[2 * k - 1] = i;
860         }
861       }
862     }
863 
864     /*  Now  post the sends */
865     PetscCall(PetscMalloc1(nrqs, &s_waits1));
866     for (i = 0; i < nrqs; ++i) {
867       j = pa[i];
868       PetscCallMPI(MPI_Isend(sbuf1[j], w1[j], MPIU_INT, j, tag0, comm, s_waits1 + i));
869     }
870 
871     /* Post Receives to capture the buffer size */
872     PetscCall(PetscMalloc1(nrqs, &r_waits2));
873     PetscCall(PetscMalloc3(nrqs, &req_source2, nrqs, &rbuf2, nrqs, &rbuf3));
874     if (nrqs) rbuf2[0] = tmp + msz;
875     for (i = 1; i < nrqs; ++i) rbuf2[i] = rbuf2[i - 1] + w1[pa[i - 1]];
876     for (i = 0; i < nrqs; ++i) {
877       j = pa[i];
878       PetscCallMPI(MPI_Irecv(rbuf2[i], w1[j], MPIU_INT, j, tag2, comm, r_waits2 + i));
879     }
880 
881     /* Send to other procs the buf size they should allocate */
882     /* Receive messages*/
883     PetscCall(PetscMalloc1(nrqr, &s_waits2));
884     PetscCall(PetscMalloc3(nrqr, &sbuf2, nrqr, &req_size, nrqr, &req_source1));
885 
886     PetscCallMPI(MPI_Waitall(nrqr, r_waits1, MPI_STATUSES_IGNORE));
887     for (i = 0; i < nrqr; ++i) {
888       req_size[i] = 0;
889       rbuf1_i     = rbuf1[i];
890       start       = 2 * rbuf1_i[0] + 1;
891       end         = olengths1[i];
892       PetscCall(PetscMalloc1(end, &sbuf2[i]));
893       sbuf2_i = sbuf2[i];
894       for (j = start; j < end; j++) {
895         row        = rbuf1_i[j] - rstart;
896         ncols      = a_i[row + 1] - a_i[row] + b_i[row + 1] - b_i[row];
897         sbuf2_i[j] = ncols;
898         req_size[i] += ncols;
899       }
900       req_source1[i] = onodes1[i];
901       /* form the header */
902       sbuf2_i[0] = req_size[i];
903       for (j = 1; j < start; j++) sbuf2_i[j] = rbuf1_i[j];
904 
905       PetscCallMPI(MPI_Isend(sbuf2_i, end, MPIU_INT, req_source1[i], tag2, comm, s_waits2 + i));
906     }
907 
908     PetscCall(PetscFree(onodes1));
909     PetscCall(PetscFree(olengths1));
910 
911     PetscCall(PetscFree(r_waits1));
912     PetscCall(PetscFree4(w1, w2, w3, w4));
913 
914     /* Receive messages*/
915     PetscCall(PetscMalloc1(nrqs, &r_waits3));
916 
917     PetscCallMPI(MPI_Waitall(nrqs, r_waits2, MPI_STATUSES_IGNORE));
918     for (i = 0; i < nrqs; ++i) {
919       PetscCall(PetscMalloc1(rbuf2[i][0], &rbuf3[i]));
920       req_source2[i] = pa[i];
921       PetscCallMPI(MPI_Irecv(rbuf3[i], rbuf2[i][0], MPIU_INT, req_source2[i], tag3, comm, r_waits3 + i));
922     }
923     PetscCall(PetscFree(r_waits2));
924 
925     /* Wait on sends1 and sends2 */
926     PetscCallMPI(MPI_Waitall(nrqs, s_waits1, MPI_STATUSES_IGNORE));
927     PetscCallMPI(MPI_Waitall(nrqr, s_waits2, MPI_STATUSES_IGNORE));
928     PetscCall(PetscFree(s_waits1));
929     PetscCall(PetscFree(s_waits2));
930 
931     /* Now allocate sending buffers for a->j, and send them off */
932     PetscCall(PetscMalloc1(nrqr, &sbuf_aj));
933     for (i = 0, j = 0; i < nrqr; i++) j += req_size[i];
934     if (nrqr) PetscCall(PetscMalloc1(j, &sbuf_aj[0]));
935     for (i = 1; i < nrqr; i++) sbuf_aj[i] = sbuf_aj[i - 1] + req_size[i - 1];
936 
937     PetscCall(PetscMalloc1(nrqr, &s_waits3));
938     {
939       for (i = 0; i < nrqr; i++) {
940         rbuf1_i   = rbuf1[i];
941         sbuf_aj_i = sbuf_aj[i];
942         ct1       = 2 * rbuf1_i[0] + 1;
943         ct2       = 0;
944         for (j = 1, max1 = rbuf1_i[0]; j <= max1; j++) {
945           kmax = rbuf1[i][2 * j];
946           for (k = 0; k < kmax; k++, ct1++) {
947             row    = rbuf1_i[ct1] - rstart;
948             nzA    = a_i[row + 1] - a_i[row];
949             nzB    = b_i[row + 1] - b_i[row];
950             ncols  = nzA + nzB;
951             cworkA = a_j + a_i[row];
952             cworkB = b_j + b_i[row];
953 
954             /* load the column indices for this row into cols */
955             cols = sbuf_aj_i + ct2;
956             for (l = 0; l < nzB; l++) {
957               if ((ctmp = bmap[cworkB[l]]) < cstart) cols[l] = ctmp;
958               else break;
959             }
960             imark = l;
961             for (l = 0; l < nzA; l++) cols[imark + l] = cstart + cworkA[l];
962             for (l = imark; l < nzB; l++) cols[nzA + l] = bmap[cworkB[l]];
963             ct2 += ncols;
964           }
965         }
966         PetscCallMPI(MPI_Isend(sbuf_aj_i, req_size[i], MPIU_INT, req_source1[i], tag3, comm, s_waits3 + i));
967       }
968     }
969 
970     /* create col map: global col of C -> local col of submatrices */
971 #if defined(PETSC_USE_CTABLE)
972     for (i = 0; i < ismax; i++) {
973       if (!allcolumns[i]) {
974         PetscCall(PetscHMapICreateWithSize(ncol[i], cmap + i));
975 
976         jmax   = ncol[i];
977         icol_i = icol[i];
978         cmap_i = cmap[i];
979         for (j = 0; j < jmax; j++) PetscCall(PetscHMapISet(cmap[i], icol_i[j] + 1, j + 1));
980       } else cmap[i] = NULL;
981     }
982 #else
983     for (i = 0; i < ismax; i++) {
984       if (!allcolumns[i]) {
985         PetscCall(PetscCalloc1(c->Nbs, &cmap[i]));
986         jmax   = ncol[i];
987         icol_i = icol[i];
988         cmap_i = cmap[i];
989         for (j = 0; j < jmax; j++) cmap_i[icol_i[j]] = j + 1;
990       } else cmap[i] = NULL;
991     }
992 #endif
993 
994     /* Create lens which is required for MatCreate... */
995     for (i = 0, j = 0; i < ismax; i++) j += nrow[i];
996     PetscCall(PetscMalloc1(ismax, &lens));
997 
998     if (ismax) PetscCall(PetscCalloc1(j, &lens[0]));
999     for (i = 1; i < ismax; i++) lens[i] = lens[i - 1] + nrow[i - 1];
1000 
1001     /* Update lens from local data */
1002     for (i = 0; i < ismax; i++) {
1003       row2proc_i = row2proc[i];
1004       jmax       = nrow[i];
1005       if (!allcolumns[i]) cmap_i = cmap[i];
1006       irow_i = irow[i];
1007       lens_i = lens[i];
1008       for (j = 0; j < jmax; j++) {
1009         if (allrows[i]) row = j;
1010         else row = irow_i[j]; /* global blocked row of C */
1011 
1012         proc = row2proc_i[j];
1013         if (proc == rank) {
1014           /* Get indices from matA and then from matB */
1015 #if defined(PETSC_USE_CTABLE)
1016           PetscInt tt;
1017 #endif
1018           row    = row - rstart;
1019           nzA    = a_i[row + 1] - a_i[row];
1020           nzB    = b_i[row + 1] - b_i[row];
1021           cworkA = a_j + a_i[row];
1022           cworkB = b_j + b_i[row];
1023 
1024           if (!allcolumns[i]) {
1025 #if defined(PETSC_USE_CTABLE)
1026             for (k = 0; k < nzA; k++) {
1027               PetscCall(PetscHMapIGetWithDefault(cmap_i, cstart + cworkA[k] + 1, 0, &tt));
1028               if (tt) lens_i[j]++;
1029             }
1030             for (k = 0; k < nzB; k++) {
1031               PetscCall(PetscHMapIGetWithDefault(cmap_i, bmap[cworkB[k]] + 1, 0, &tt));
1032               if (tt) lens_i[j]++;
1033             }
1034 
1035 #else
1036             for (k = 0; k < nzA; k++) {
1037               if (cmap_i[cstart + cworkA[k]]) lens_i[j]++;
1038             }
1039             for (k = 0; k < nzB; k++) {
1040               if (cmap_i[bmap[cworkB[k]]]) lens_i[j]++;
1041             }
1042 #endif
1043           } else { /* allcolumns */
1044             lens_i[j] = nzA + nzB;
1045           }
1046         }
1047       }
1048     }
1049 
1050     /* Create row map: global row of C -> local row of submatrices */
1051     for (i = 0; i < ismax; i++) {
1052       if (!allrows[i]) {
1053 #if defined(PETSC_USE_CTABLE)
1054         PetscCall(PetscHMapICreateWithSize(nrow[i], rmap + i));
1055         irow_i = irow[i];
1056         jmax   = nrow[i];
1057         for (j = 0; j < jmax; j++) {
1058           if (allrows[i]) {
1059             PetscCall(PetscHMapISet(rmap[i], j + 1, j + 1));
1060           } else {
1061             PetscCall(PetscHMapISet(rmap[i], irow_i[j] + 1, j + 1));
1062           }
1063         }
1064 #else
1065         PetscCall(PetscCalloc1(c->Mbs, &rmap[i]));
1066         rmap_i = rmap[i];
1067         irow_i = irow[i];
1068         jmax   = nrow[i];
1069         for (j = 0; j < jmax; j++) {
1070           if (allrows[i]) rmap_i[j] = j;
1071           else rmap_i[irow_i[j]] = j;
1072         }
1073 #endif
1074       } else rmap[i] = NULL;
1075     }
1076 
1077     /* Update lens from offproc data */
1078     {
1079       PetscInt *rbuf2_i, *rbuf3_i, *sbuf1_i;
1080 
1081       PetscCallMPI(MPI_Waitall(nrqs, r_waits3, MPI_STATUSES_IGNORE));
1082       for (tmp2 = 0; tmp2 < nrqs; tmp2++) {
1083         sbuf1_i = sbuf1[pa[tmp2]];
1084         jmax    = sbuf1_i[0];
1085         ct1     = 2 * jmax + 1;
1086         ct2     = 0;
1087         rbuf2_i = rbuf2[tmp2];
1088         rbuf3_i = rbuf3[tmp2];
1089         for (j = 1; j <= jmax; j++) {
1090           is_no  = sbuf1_i[2 * j - 1];
1091           max1   = sbuf1_i[2 * j];
1092           lens_i = lens[is_no];
1093           if (!allcolumns[is_no]) cmap_i = cmap[is_no];
1094           rmap_i = rmap[is_no];
1095           for (k = 0; k < max1; k++, ct1++) {
1096             if (allrows[is_no]) {
1097               row = sbuf1_i[ct1];
1098             } else {
1099 #if defined(PETSC_USE_CTABLE)
1100               PetscCall(PetscHMapIGetWithDefault(rmap_i, sbuf1_i[ct1] + 1, 0, &row));
1101               row--;
1102               PetscCheck(row >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "row not found in table");
1103 #else
1104               row = rmap_i[sbuf1_i[ct1]]; /* the val in the new matrix to be */
1105 #endif
1106             }
1107             max2 = rbuf2_i[ct1];
1108             for (l = 0; l < max2; l++, ct2++) {
1109               if (!allcolumns[is_no]) {
1110 #if defined(PETSC_USE_CTABLE)
1111                 PetscCall(PetscHMapIGetWithDefault(cmap_i, rbuf3_i[ct2] + 1, 0, &tcol));
1112 #else
1113                 tcol = cmap_i[rbuf3_i[ct2]];
1114 #endif
1115                 if (tcol) lens_i[row]++;
1116               } else {         /* allcolumns */
1117                 lens_i[row]++; /* lens_i[row] += max2 ? */
1118               }
1119             }
1120           }
1121         }
1122       }
1123     }
1124     PetscCall(PetscFree(r_waits3));
1125     PetscCallMPI(MPI_Waitall(nrqr, s_waits3, MPI_STATUSES_IGNORE));
1126     PetscCall(PetscFree(s_waits3));
1127 
1128     /* Create the submatrices */
1129     for (i = 0; i < ismax; i++) {
1130       PetscInt bs_tmp;
1131       if (ijonly) bs_tmp = 1;
1132       else bs_tmp = bs;
1133 
1134       PetscCall(MatCreate(PETSC_COMM_SELF, submats + i));
1135       PetscCall(MatSetSizes(submats[i], nrow[i] * bs_tmp, ncol[i] * bs_tmp, PETSC_DETERMINE, PETSC_DETERMINE));
1136 
1137       PetscCall(MatSetType(submats[i], ((PetscObject)A)->type_name));
1138       PetscCall(MatSeqBAIJSetPreallocation(submats[i], bs_tmp, 0, lens[i]));
1139       PetscCall(MatSeqSBAIJSetPreallocation(submats[i], bs_tmp, 0, lens[i])); /* this subroutine is used by SBAIJ routines */
1140 
1141       /* create struct Mat_SubSppt and attached it to submat */
1142       PetscCall(PetscNew(&smat_i));
1143       subc            = (Mat_SeqBAIJ *)submats[i]->data;
1144       subc->submatis1 = smat_i;
1145 
1146       smat_i->destroy          = submats[i]->ops->destroy;
1147       submats[i]->ops->destroy = MatDestroySubMatrix_SeqBAIJ;
1148       submats[i]->factortype   = C->factortype;
1149 
1150       smat_i->id          = i;
1151       smat_i->nrqs        = nrqs;
1152       smat_i->nrqr        = nrqr;
1153       smat_i->rbuf1       = rbuf1;
1154       smat_i->rbuf2       = rbuf2;
1155       smat_i->rbuf3       = rbuf3;
1156       smat_i->sbuf2       = sbuf2;
1157       smat_i->req_source2 = req_source2;
1158 
1159       smat_i->sbuf1 = sbuf1;
1160       smat_i->ptr   = ptr;
1161       smat_i->tmp   = tmp;
1162       smat_i->ctr   = ctr;
1163 
1164       smat_i->pa          = pa;
1165       smat_i->req_size    = req_size;
1166       smat_i->req_source1 = req_source1;
1167 
1168       smat_i->allcolumns = allcolumns[i];
1169       smat_i->allrows    = allrows[i];
1170       smat_i->singleis   = PETSC_FALSE;
1171       smat_i->row2proc   = row2proc[i];
1172       smat_i->rmap       = rmap[i];
1173       smat_i->cmap       = cmap[i];
1174     }
1175 
1176     if (!ismax) { /* Create dummy submats[0] for reuse struct subc */
1177       PetscCall(MatCreate(PETSC_COMM_SELF, &submats[0]));
1178       PetscCall(MatSetSizes(submats[0], 0, 0, PETSC_DETERMINE, PETSC_DETERMINE));
1179       PetscCall(MatSetType(submats[0], MATDUMMY));
1180 
1181       /* create struct Mat_SubSppt and attached it to submat */
1182       PetscCall(PetscNew(&smat_i));
1183       submats[0]->data = (void *)smat_i;
1184 
1185       smat_i->destroy          = submats[0]->ops->destroy;
1186       submats[0]->ops->destroy = MatDestroySubMatrix_Dummy;
1187       submats[0]->factortype   = C->factortype;
1188 
1189       smat_i->id          = 0;
1190       smat_i->nrqs        = nrqs;
1191       smat_i->nrqr        = nrqr;
1192       smat_i->rbuf1       = rbuf1;
1193       smat_i->rbuf2       = rbuf2;
1194       smat_i->rbuf3       = rbuf3;
1195       smat_i->sbuf2       = sbuf2;
1196       smat_i->req_source2 = req_source2;
1197 
1198       smat_i->sbuf1 = sbuf1;
1199       smat_i->ptr   = ptr;
1200       smat_i->tmp   = tmp;
1201       smat_i->ctr   = ctr;
1202 
1203       smat_i->pa          = pa;
1204       smat_i->req_size    = req_size;
1205       smat_i->req_source1 = req_source1;
1206 
1207       smat_i->allcolumns = PETSC_FALSE;
1208       smat_i->singleis   = PETSC_FALSE;
1209       smat_i->row2proc   = NULL;
1210       smat_i->rmap       = NULL;
1211       smat_i->cmap       = NULL;
1212     }
1213 
1214     if (ismax) PetscCall(PetscFree(lens[0]));
1215     PetscCall(PetscFree(lens));
1216     if (sbuf_aj) {
1217       PetscCall(PetscFree(sbuf_aj[0]));
1218       PetscCall(PetscFree(sbuf_aj));
1219     }
1220 
1221   } /* endof scall == MAT_INITIAL_MATRIX */
1222 
1223   /* Post recv matrix values */
1224   if (!ijonly) {
1225     PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag4));
1226     PetscCall(PetscMalloc1(nrqs, &rbuf4));
1227     PetscCall(PetscMalloc1(nrqs, &r_waits4));
1228     for (i = 0; i < nrqs; ++i) {
1229       PetscCall(PetscMalloc1(rbuf2[i][0] * bs2, &rbuf4[i]));
1230       PetscCallMPI(MPI_Irecv(rbuf4[i], rbuf2[i][0] * bs2, MPIU_SCALAR, req_source2[i], tag4, comm, r_waits4 + i));
1231     }
1232 
1233     /* Allocate sending buffers for a->a, and send them off */
1234     PetscCall(PetscMalloc1(nrqr, &sbuf_aa));
1235     for (i = 0, j = 0; i < nrqr; i++) j += req_size[i];
1236 
1237     if (nrqr) PetscCall(PetscMalloc1(j * bs2, &sbuf_aa[0]));
1238     for (i = 1; i < nrqr; i++) sbuf_aa[i] = sbuf_aa[i - 1] + req_size[i - 1] * bs2;
1239 
1240     PetscCall(PetscMalloc1(nrqr, &s_waits4));
1241 
1242     for (i = 0; i < nrqr; i++) {
1243       rbuf1_i   = rbuf1[i];
1244       sbuf_aa_i = sbuf_aa[i];
1245       ct1       = 2 * rbuf1_i[0] + 1;
1246       ct2       = 0;
1247       for (j = 1, max1 = rbuf1_i[0]; j <= max1; j++) {
1248         kmax = rbuf1_i[2 * j];
1249         for (k = 0; k < kmax; k++, ct1++) {
1250           row    = rbuf1_i[ct1] - rstart;
1251           nzA    = a_i[row + 1] - a_i[row];
1252           nzB    = b_i[row + 1] - b_i[row];
1253           ncols  = nzA + nzB;
1254           cworkB = b_j + b_i[row];
1255           vworkA = a_a + a_i[row] * bs2;
1256           vworkB = b_a + b_i[row] * bs2;
1257 
1258           /* load the column values for this row into vals*/
1259           vals = sbuf_aa_i + ct2 * bs2;
1260           for (l = 0; l < nzB; l++) {
1261             if ((bmap[cworkB[l]]) < cstart) {
1262               PetscCall(PetscArraycpy(vals + l * bs2, vworkB + l * bs2, bs2));
1263             } else break;
1264           }
1265           imark = l;
1266           for (l = 0; l < nzA; l++) PetscCall(PetscArraycpy(vals + (imark + l) * bs2, vworkA + l * bs2, bs2));
1267           for (l = imark; l < nzB; l++) PetscCall(PetscArraycpy(vals + (nzA + l) * bs2, vworkB + l * bs2, bs2));
1268 
1269           ct2 += ncols;
1270         }
1271       }
1272       PetscCallMPI(MPI_Isend(sbuf_aa_i, req_size[i] * bs2, MPIU_SCALAR, req_source1[i], tag4, comm, s_waits4 + i));
1273     }
1274   }
1275 
1276   /* Assemble the matrices */
1277   /* First assemble the local rows */
1278   for (i = 0; i < ismax; i++) {
1279     row2proc_i = row2proc[i];
1280     subc       = (Mat_SeqBAIJ *)submats[i]->data;
1281     imat_ilen  = subc->ilen;
1282     imat_j     = subc->j;
1283     imat_i     = subc->i;
1284     imat_a     = subc->a;
1285 
1286     if (!allcolumns[i]) cmap_i = cmap[i];
1287     rmap_i = rmap[i];
1288     irow_i = irow[i];
1289     jmax   = nrow[i];
1290     for (j = 0; j < jmax; j++) {
1291       if (allrows[i]) row = j;
1292       else row = irow_i[j];
1293       proc = row2proc_i[j];
1294 
1295       if (proc == rank) {
1296         row    = row - rstart;
1297         nzA    = a_i[row + 1] - a_i[row];
1298         nzB    = b_i[row + 1] - b_i[row];
1299         cworkA = a_j + a_i[row];
1300         cworkB = b_j + b_i[row];
1301         if (!ijonly) {
1302           vworkA = a_a + a_i[row] * bs2;
1303           vworkB = b_a + b_i[row] * bs2;
1304         }
1305 
1306         if (allrows[i]) {
1307           row = row + rstart;
1308         } else {
1309 #if defined(PETSC_USE_CTABLE)
1310           PetscCall(PetscHMapIGetWithDefault(rmap_i, row + rstart + 1, 0, &row));
1311           row--;
1312 
1313           PetscCheck(row >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "row not found in table");
1314 #else
1315           row = rmap_i[row + rstart];
1316 #endif
1317         }
1318         mat_i = imat_i[row];
1319         if (!ijonly) mat_a = imat_a + mat_i * bs2;
1320         mat_j = imat_j + mat_i;
1321         ilen  = imat_ilen[row];
1322 
1323         /* load the column indices for this row into cols*/
1324         if (!allcolumns[i]) {
1325           for (l = 0; l < nzB; l++) {
1326             if ((ctmp = bmap[cworkB[l]]) < cstart) {
1327 #if defined(PETSC_USE_CTABLE)
1328               PetscCall(PetscHMapIGetWithDefault(cmap_i, ctmp + 1, 0, &tcol));
1329               if (tcol) {
1330 #else
1331               if ((tcol = cmap_i[ctmp])) {
1332 #endif
1333                 *mat_j++ = tcol - 1;
1334                 PetscCall(PetscArraycpy(mat_a, vworkB + l * bs2, bs2));
1335                 mat_a += bs2;
1336                 ilen++;
1337               }
1338             } else break;
1339           }
1340           imark = l;
1341           for (l = 0; l < nzA; l++) {
1342 #if defined(PETSC_USE_CTABLE)
1343             PetscCall(PetscHMapIGetWithDefault(cmap_i, cstart + cworkA[l] + 1, 0, &tcol));
1344             if (tcol) {
1345 #else
1346             if ((tcol = cmap_i[cstart + cworkA[l]])) {
1347 #endif
1348               *mat_j++ = tcol - 1;
1349               if (!ijonly) {
1350                 PetscCall(PetscArraycpy(mat_a, vworkA + l * bs2, bs2));
1351                 mat_a += bs2;
1352               }
1353               ilen++;
1354             }
1355           }
1356           for (l = imark; l < nzB; l++) {
1357 #if defined(PETSC_USE_CTABLE)
1358             PetscCall(PetscHMapIGetWithDefault(cmap_i, bmap[cworkB[l]] + 1, 0, &tcol));
1359             if (tcol) {
1360 #else
1361             if ((tcol = cmap_i[bmap[cworkB[l]]])) {
1362 #endif
1363               *mat_j++ = tcol - 1;
1364               if (!ijonly) {
1365                 PetscCall(PetscArraycpy(mat_a, vworkB + l * bs2, bs2));
1366                 mat_a += bs2;
1367               }
1368               ilen++;
1369             }
1370           }
1371         } else { /* allcolumns */
1372           for (l = 0; l < nzB; l++) {
1373             if ((ctmp = bmap[cworkB[l]]) < cstart) {
1374               *mat_j++ = ctmp;
1375               PetscCall(PetscArraycpy(mat_a, vworkB + l * bs2, bs2));
1376               mat_a += bs2;
1377               ilen++;
1378             } else break;
1379           }
1380           imark = l;
1381           for (l = 0; l < nzA; l++) {
1382             *mat_j++ = cstart + cworkA[l];
1383             if (!ijonly) {
1384               PetscCall(PetscArraycpy(mat_a, vworkA + l * bs2, bs2));
1385               mat_a += bs2;
1386             }
1387             ilen++;
1388           }
1389           for (l = imark; l < nzB; l++) {
1390             *mat_j++ = bmap[cworkB[l]];
1391             if (!ijonly) {
1392               PetscCall(PetscArraycpy(mat_a, vworkB + l * bs2, bs2));
1393               mat_a += bs2;
1394             }
1395             ilen++;
1396           }
1397         }
1398         imat_ilen[row] = ilen;
1399       }
1400     }
1401   }
1402 
1403   /* Now assemble the off proc rows */
1404   if (!ijonly) PetscCallMPI(MPI_Waitall(nrqs, r_waits4, MPI_STATUSES_IGNORE));
1405   for (tmp2 = 0; tmp2 < nrqs; tmp2++) {
1406     sbuf1_i = sbuf1[pa[tmp2]];
1407     jmax    = sbuf1_i[0];
1408     ct1     = 2 * jmax + 1;
1409     ct2     = 0;
1410     rbuf2_i = rbuf2[tmp2];
1411     rbuf3_i = rbuf3[tmp2];
1412     if (!ijonly) rbuf4_i = rbuf4[tmp2];
1413     for (j = 1; j <= jmax; j++) {
1414       is_no  = sbuf1_i[2 * j - 1];
1415       rmap_i = rmap[is_no];
1416       if (!allcolumns[is_no]) cmap_i = cmap[is_no];
1417       subc      = (Mat_SeqBAIJ *)submats[is_no]->data;
1418       imat_ilen = subc->ilen;
1419       imat_j    = subc->j;
1420       imat_i    = subc->i;
1421       if (!ijonly) imat_a = subc->a;
1422       max1 = sbuf1_i[2 * j];
1423       for (k = 0; k < max1; k++, ct1++) { /* for each recved block row */
1424         row = sbuf1_i[ct1];
1425 
1426         if (allrows[is_no]) {
1427           row = sbuf1_i[ct1];
1428         } else {
1429 #if defined(PETSC_USE_CTABLE)
1430           PetscCall(PetscHMapIGetWithDefault(rmap_i, row + 1, 0, &row));
1431           row--;
1432           PetscCheck(row >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "row not found in table");
1433 #else
1434           row = rmap_i[row];
1435 #endif
1436         }
1437         ilen  = imat_ilen[row];
1438         mat_i = imat_i[row];
1439         if (!ijonly) mat_a = imat_a + mat_i * bs2;
1440         mat_j = imat_j + mat_i;
1441         max2  = rbuf2_i[ct1];
1442         if (!allcolumns[is_no]) {
1443           for (l = 0; l < max2; l++, ct2++) {
1444 #if defined(PETSC_USE_CTABLE)
1445             PetscCall(PetscHMapIGetWithDefault(cmap_i, rbuf3_i[ct2] + 1, 0, &tcol));
1446 #else
1447             tcol = cmap_i[rbuf3_i[ct2]];
1448 #endif
1449             if (tcol) {
1450               *mat_j++ = tcol - 1;
1451               if (!ijonly) {
1452                 PetscCall(PetscArraycpy(mat_a, rbuf4_i + ct2 * bs2, bs2));
1453                 mat_a += bs2;
1454               }
1455               ilen++;
1456             }
1457           }
1458         } else { /* allcolumns */
1459           for (l = 0; l < max2; l++, ct2++) {
1460             *mat_j++ = rbuf3_i[ct2]; /* same global column index of C */
1461             if (!ijonly) {
1462               PetscCall(PetscArraycpy(mat_a, rbuf4_i + ct2 * bs2, bs2));
1463               mat_a += bs2;
1464             }
1465             ilen++;
1466           }
1467         }
1468         imat_ilen[row] = ilen;
1469       }
1470     }
1471   }
1472 
1473   if (!iscsorted) { /* sort column indices of the rows */
1474     MatScalar *work;
1475 
1476     PetscCall(PetscMalloc1(bs2, &work));
1477     for (i = 0; i < ismax; i++) {
1478       subc      = (Mat_SeqBAIJ *)submats[i]->data;
1479       imat_ilen = subc->ilen;
1480       imat_j    = subc->j;
1481       imat_i    = subc->i;
1482       if (!ijonly) imat_a = subc->a;
1483       if (allcolumns[i]) continue;
1484 
1485       jmax = nrow[i];
1486       for (j = 0; j < jmax; j++) {
1487         mat_i = imat_i[j];
1488         mat_j = imat_j + mat_i;
1489         ilen  = imat_ilen[j];
1490         if (ijonly) {
1491           PetscCall(PetscSortInt(ilen, mat_j));
1492         } else {
1493           mat_a = imat_a + mat_i * bs2;
1494           PetscCall(PetscSortIntWithDataArray(ilen, mat_j, mat_a, bs2 * sizeof(MatScalar), work));
1495         }
1496       }
1497     }
1498     PetscCall(PetscFree(work));
1499   }
1500 
1501   if (!ijonly) {
1502     PetscCall(PetscFree(r_waits4));
1503     PetscCallMPI(MPI_Waitall(nrqr, s_waits4, MPI_STATUSES_IGNORE));
1504     PetscCall(PetscFree(s_waits4));
1505   }
1506 
1507   /* Restore the indices */
1508   for (i = 0; i < ismax; i++) {
1509     if (!allrows[i]) PetscCall(ISRestoreIndices(isrow[i], irow + i));
1510     if (!allcolumns[i]) PetscCall(ISRestoreIndices(iscol[i], icol + i));
1511   }
1512 
1513   for (i = 0; i < ismax; i++) {
1514     PetscCall(MatAssemblyBegin(submats[i], MAT_FINAL_ASSEMBLY));
1515     PetscCall(MatAssemblyEnd(submats[i], MAT_FINAL_ASSEMBLY));
1516   }
1517 
1518   PetscCall(PetscFree5(*(PetscInt ***)&irow, *(PetscInt ***)&icol, nrow, ncol, issorted));
1519   PetscCall(PetscFree5(row2proc, cmap, rmap, allcolumns, allrows));
1520 
1521   if (!ijonly) {
1522     if (sbuf_aa) {
1523       PetscCall(PetscFree(sbuf_aa[0]));
1524       PetscCall(PetscFree(sbuf_aa));
1525     }
1526 
1527     for (i = 0; i < nrqs; ++i) PetscCall(PetscFree(rbuf4[i]));
1528     PetscCall(PetscFree(rbuf4));
1529   }
1530   c->ijonly = PETSC_FALSE; /* set back to the default */
1531   PetscFunctionReturn(PETSC_SUCCESS);
1532 }
1533