xref: /petsc/src/mat/impls/baij/seq/baij.c (revision f13dfd9ea68e0ddeee984e65c377a1819eab8a8a)
1 /*
2     Defines the basic matrix operations for the BAIJ (compressed row)
3   matrix storage format.
4 */
5 #include <../src/mat/impls/baij/seq/baij.h> /*I   "petscmat.h"  I*/
6 #include <petscblaslapack.h>
7 #include <petsc/private/kernels/blockinvert.h>
8 #include <petsc/private/kernels/blockmatmult.h>
9 
10 /* defines MatSetValues_Seq_Hash(), MatAssemblyEnd_Seq_Hash(), MatSetUp_Seq_Hash() */
11 #define TYPE BAIJ
12 #define TYPE_BS
13 #include "../src/mat/impls/aij/seq/seqhashmatsetvalues.h"
14 #undef TYPE_BS
15 #define TYPE_BS _BS
16 #define TYPE_BS_ON
17 #include "../src/mat/impls/aij/seq/seqhashmatsetvalues.h"
18 #undef TYPE_BS
19 #include "../src/mat/impls/aij/seq/seqhashmat.h"
20 #undef TYPE
21 #undef TYPE_BS_ON
22 
23 #if defined(PETSC_HAVE_HYPRE)
24 PETSC_INTERN PetscErrorCode MatConvert_AIJ_HYPRE(Mat, MatType, MatReuse, Mat *);
25 #endif
26 
27 #if defined(PETSC_HAVE_MKL_SPARSE_OPTIMIZE)
28 PETSC_INTERN PetscErrorCode MatConvert_SeqBAIJ_SeqBAIJMKL(Mat, MatType, MatReuse, Mat *);
29 #endif
30 PETSC_INTERN PetscErrorCode MatConvert_XAIJ_IS(Mat, MatType, MatReuse, Mat *);
31 
32 static PetscErrorCode MatGetColumnReductions_SeqBAIJ(Mat A, PetscInt type, PetscReal *reductions)
33 {
34   Mat_SeqBAIJ *a_aij = (Mat_SeqBAIJ *)A->data;
35   PetscInt     m, n, ib, jb, bs = A->rmap->bs;
36   MatScalar   *a_val = a_aij->a;
37 
38   PetscFunctionBegin;
39   PetscCall(MatGetSize(A, &m, &n));
40   PetscCall(PetscArrayzero(reductions, n));
41   if (type == NORM_2) {
42     for (PetscInt i = a_aij->i[0]; i < a_aij->i[A->rmap->n / bs]; i++) {
43       for (jb = 0; jb < bs; jb++) {
44         for (ib = 0; ib < bs; ib++) {
45           reductions[A->cmap->rstart + a_aij->j[i] * bs + jb] += PetscAbsScalar(*a_val * *a_val);
46           a_val++;
47         }
48       }
49     }
50   } else if (type == NORM_1) {
51     for (PetscInt i = a_aij->i[0]; i < a_aij->i[A->rmap->n / bs]; i++) {
52       for (jb = 0; jb < bs; jb++) {
53         for (ib = 0; ib < bs; ib++) {
54           reductions[A->cmap->rstart + a_aij->j[i] * bs + jb] += PetscAbsScalar(*a_val);
55           a_val++;
56         }
57       }
58     }
59   } else if (type == NORM_INFINITY) {
60     for (PetscInt i = a_aij->i[0]; i < a_aij->i[A->rmap->n / bs]; i++) {
61       for (jb = 0; jb < bs; jb++) {
62         for (ib = 0; ib < bs; ib++) {
63           int col         = A->cmap->rstart + a_aij->j[i] * bs + jb;
64           reductions[col] = PetscMax(PetscAbsScalar(*a_val), reductions[col]);
65           a_val++;
66         }
67       }
68     }
69   } else if (type == REDUCTION_SUM_REALPART || type == REDUCTION_MEAN_REALPART) {
70     for (PetscInt i = a_aij->i[0]; i < a_aij->i[A->rmap->n / bs]; i++) {
71       for (jb = 0; jb < bs; jb++) {
72         for (ib = 0; ib < bs; ib++) {
73           reductions[A->cmap->rstart + a_aij->j[i] * bs + jb] += PetscRealPart(*a_val);
74           a_val++;
75         }
76       }
77     }
78   } else if (type == REDUCTION_SUM_IMAGINARYPART || type == REDUCTION_MEAN_IMAGINARYPART) {
79     for (PetscInt i = a_aij->i[0]; i < a_aij->i[A->rmap->n / bs]; i++) {
80       for (jb = 0; jb < bs; jb++) {
81         for (ib = 0; ib < bs; ib++) {
82           reductions[A->cmap->rstart + a_aij->j[i] * bs + jb] += PetscImaginaryPart(*a_val);
83           a_val++;
84         }
85       }
86     }
87   } else SETERRQ(PetscObjectComm((PetscObject)A), PETSC_ERR_ARG_WRONG, "Unknown reduction type");
88   if (type == NORM_2) {
89     for (PetscInt i = 0; i < n; i++) reductions[i] = PetscSqrtReal(reductions[i]);
90   } else if (type == REDUCTION_MEAN_REALPART || type == REDUCTION_MEAN_IMAGINARYPART) {
91     for (PetscInt i = 0; i < n; i++) reductions[i] /= m;
92   }
93   PetscFunctionReturn(PETSC_SUCCESS);
94 }
95 
96 static PetscErrorCode MatInvertBlockDiagonal_SeqBAIJ(Mat A, const PetscScalar **values)
97 {
98   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
99   PetscInt    *diag_offset, i, bs = A->rmap->bs, mbs = a->mbs, ipvt[5], bs2 = bs * bs, *v_pivots;
100   MatScalar   *v     = a->a, *odiag, *diag, work[25], *v_work;
101   PetscReal    shift = 0.0;
102   PetscBool    allowzeropivot, zeropivotdetected = PETSC_FALSE;
103 
104   PetscFunctionBegin;
105   allowzeropivot = PetscNot(A->erroriffailure);
106 
107   if (a->idiagvalid) {
108     if (values) *values = a->idiag;
109     PetscFunctionReturn(PETSC_SUCCESS);
110   }
111   PetscCall(MatMarkDiagonal_SeqBAIJ(A));
112   diag_offset = a->diag;
113   if (!a->idiag) { PetscCall(PetscMalloc1(bs2 * mbs, &a->idiag)); }
114   diag = a->idiag;
115   if (values) *values = a->idiag;
116   /* factor and invert each block */
117   switch (bs) {
118   case 1:
119     for (i = 0; i < mbs; i++) {
120       odiag   = v + 1 * diag_offset[i];
121       diag[0] = odiag[0];
122 
123       if (PetscAbsScalar(diag[0] + shift) < PETSC_MACHINE_EPSILON) {
124         if (allowzeropivot) {
125           A->factorerrortype             = MAT_FACTOR_NUMERIC_ZEROPIVOT;
126           A->factorerror_zeropivot_value = PetscAbsScalar(diag[0]);
127           A->factorerror_zeropivot_row   = i;
128           PetscCall(PetscInfo(A, "Zero pivot, row %" PetscInt_FMT "\n", i));
129         } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MAT_LU_ZRPVT, "Zero pivot, row %" PetscInt_FMT " pivot value %g tolerance %g", i, (double)PetscAbsScalar(diag[0]), (double)PETSC_MACHINE_EPSILON);
130       }
131 
132       diag[0] = (PetscScalar)1.0 / (diag[0] + shift);
133       diag += 1;
134     }
135     break;
136   case 2:
137     for (i = 0; i < mbs; i++) {
138       odiag   = v + 4 * diag_offset[i];
139       diag[0] = odiag[0];
140       diag[1] = odiag[1];
141       diag[2] = odiag[2];
142       diag[3] = odiag[3];
143       PetscCall(PetscKernel_A_gets_inverse_A_2(diag, shift, allowzeropivot, &zeropivotdetected));
144       if (zeropivotdetected) A->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
145       diag += 4;
146     }
147     break;
148   case 3:
149     for (i = 0; i < mbs; i++) {
150       odiag   = v + 9 * diag_offset[i];
151       diag[0] = odiag[0];
152       diag[1] = odiag[1];
153       diag[2] = odiag[2];
154       diag[3] = odiag[3];
155       diag[4] = odiag[4];
156       diag[5] = odiag[5];
157       diag[6] = odiag[6];
158       diag[7] = odiag[7];
159       diag[8] = odiag[8];
160       PetscCall(PetscKernel_A_gets_inverse_A_3(diag, shift, allowzeropivot, &zeropivotdetected));
161       if (zeropivotdetected) A->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
162       diag += 9;
163     }
164     break;
165   case 4:
166     for (i = 0; i < mbs; i++) {
167       odiag = v + 16 * diag_offset[i];
168       PetscCall(PetscArraycpy(diag, odiag, 16));
169       PetscCall(PetscKernel_A_gets_inverse_A_4(diag, shift, allowzeropivot, &zeropivotdetected));
170       if (zeropivotdetected) A->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
171       diag += 16;
172     }
173     break;
174   case 5:
175     for (i = 0; i < mbs; i++) {
176       odiag = v + 25 * diag_offset[i];
177       PetscCall(PetscArraycpy(diag, odiag, 25));
178       PetscCall(PetscKernel_A_gets_inverse_A_5(diag, ipvt, work, shift, allowzeropivot, &zeropivotdetected));
179       if (zeropivotdetected) A->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
180       diag += 25;
181     }
182     break;
183   case 6:
184     for (i = 0; i < mbs; i++) {
185       odiag = v + 36 * diag_offset[i];
186       PetscCall(PetscArraycpy(diag, odiag, 36));
187       PetscCall(PetscKernel_A_gets_inverse_A_6(diag, shift, allowzeropivot, &zeropivotdetected));
188       if (zeropivotdetected) A->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
189       diag += 36;
190     }
191     break;
192   case 7:
193     for (i = 0; i < mbs; i++) {
194       odiag = v + 49 * diag_offset[i];
195       PetscCall(PetscArraycpy(diag, odiag, 49));
196       PetscCall(PetscKernel_A_gets_inverse_A_7(diag, shift, allowzeropivot, &zeropivotdetected));
197       if (zeropivotdetected) A->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
198       diag += 49;
199     }
200     break;
201   default:
202     PetscCall(PetscMalloc2(bs, &v_work, bs, &v_pivots));
203     for (i = 0; i < mbs; i++) {
204       odiag = v + bs2 * diag_offset[i];
205       PetscCall(PetscArraycpy(diag, odiag, bs2));
206       PetscCall(PetscKernel_A_gets_inverse_A(bs, diag, v_pivots, v_work, allowzeropivot, &zeropivotdetected));
207       if (zeropivotdetected) A->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
208       diag += bs2;
209     }
210     PetscCall(PetscFree2(v_work, v_pivots));
211   }
212   a->idiagvalid = PETSC_TRUE;
213   PetscFunctionReturn(PETSC_SUCCESS);
214 }
215 
216 static PetscErrorCode MatSOR_SeqBAIJ(Mat A, Vec bb, PetscReal omega, MatSORType flag, PetscReal fshift, PetscInt its, PetscInt lits, Vec xx)
217 {
218   Mat_SeqBAIJ       *a = (Mat_SeqBAIJ *)A->data;
219   PetscScalar       *x, *work, *w, *workt, *t;
220   const MatScalar   *v, *aa = a->a, *idiag;
221   const PetscScalar *b, *xb;
222   PetscScalar        s[7], xw[7] = {0}; /* avoid some compilers thinking xw is uninitialized */
223   PetscInt           m = a->mbs, i, i2, nz, bs = A->rmap->bs, bs2 = bs * bs, k, j, idx, it;
224   const PetscInt    *diag, *ai = a->i, *aj = a->j, *vi;
225 
226   PetscFunctionBegin;
227   its = its * lits;
228   PetscCheck(!(flag & SOR_EISENSTAT), PETSC_COMM_SELF, PETSC_ERR_SUP, "No support yet for Eisenstat");
229   PetscCheck(its > 0, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Relaxation requires global its %" PetscInt_FMT " and local its %" PetscInt_FMT " both positive", its, lits);
230   PetscCheck(!fshift, PETSC_COMM_SELF, PETSC_ERR_SUP, "No support for diagonal shift");
231   PetscCheck(omega == 1.0, PETSC_COMM_SELF, PETSC_ERR_SUP, "No support for non-trivial relaxation factor");
232   PetscCheck(!(flag & SOR_APPLY_UPPER) && !(flag & SOR_APPLY_LOWER), PETSC_COMM_SELF, PETSC_ERR_SUP, "No support for applying upper or lower triangular parts");
233 
234   if (!a->idiagvalid) PetscCall(MatInvertBlockDiagonal(A, NULL));
235 
236   if (!m) PetscFunctionReturn(PETSC_SUCCESS);
237   diag  = a->diag;
238   idiag = a->idiag;
239   k     = PetscMax(A->rmap->n, A->cmap->n);
240   if (!a->mult_work) PetscCall(PetscMalloc1(k + 1, &a->mult_work));
241   if (!a->sor_workt) PetscCall(PetscMalloc1(k, &a->sor_workt));
242   if (!a->sor_work) PetscCall(PetscMalloc1(bs, &a->sor_work));
243   work = a->mult_work;
244   t    = a->sor_workt;
245   w    = a->sor_work;
246 
247   PetscCall(VecGetArray(xx, &x));
248   PetscCall(VecGetArrayRead(bb, &b));
249 
250   if (flag & SOR_ZERO_INITIAL_GUESS) {
251     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP) {
252       switch (bs) {
253       case 1:
254         PetscKernel_v_gets_A_times_w_1(x, idiag, b);
255         t[0] = b[0];
256         i2   = 1;
257         idiag += 1;
258         for (i = 1; i < m; i++) {
259           v    = aa + ai[i];
260           vi   = aj + ai[i];
261           nz   = diag[i] - ai[i];
262           s[0] = b[i2];
263           for (j = 0; j < nz; j++) {
264             xw[0] = x[vi[j]];
265             PetscKernel_v_gets_v_minus_A_times_w_1(s, (v + j), xw);
266           }
267           t[i2] = s[0];
268           PetscKernel_v_gets_A_times_w_1(xw, idiag, s);
269           x[i2] = xw[0];
270           idiag += 1;
271           i2 += 1;
272         }
273         break;
274       case 2:
275         PetscKernel_v_gets_A_times_w_2(x, idiag, b);
276         t[0] = b[0];
277         t[1] = b[1];
278         i2   = 2;
279         idiag += 4;
280         for (i = 1; i < m; i++) {
281           v    = aa + 4 * ai[i];
282           vi   = aj + ai[i];
283           nz   = diag[i] - ai[i];
284           s[0] = b[i2];
285           s[1] = b[i2 + 1];
286           for (j = 0; j < nz; j++) {
287             idx   = 2 * vi[j];
288             it    = 4 * j;
289             xw[0] = x[idx];
290             xw[1] = x[1 + idx];
291             PetscKernel_v_gets_v_minus_A_times_w_2(s, (v + it), xw);
292           }
293           t[i2]     = s[0];
294           t[i2 + 1] = s[1];
295           PetscKernel_v_gets_A_times_w_2(xw, idiag, s);
296           x[i2]     = xw[0];
297           x[i2 + 1] = xw[1];
298           idiag += 4;
299           i2 += 2;
300         }
301         break;
302       case 3:
303         PetscKernel_v_gets_A_times_w_3(x, idiag, b);
304         t[0] = b[0];
305         t[1] = b[1];
306         t[2] = b[2];
307         i2   = 3;
308         idiag += 9;
309         for (i = 1; i < m; i++) {
310           v    = aa + 9 * ai[i];
311           vi   = aj + ai[i];
312           nz   = diag[i] - ai[i];
313           s[0] = b[i2];
314           s[1] = b[i2 + 1];
315           s[2] = b[i2 + 2];
316           while (nz--) {
317             idx   = 3 * (*vi++);
318             xw[0] = x[idx];
319             xw[1] = x[1 + idx];
320             xw[2] = x[2 + idx];
321             PetscKernel_v_gets_v_minus_A_times_w_3(s, v, xw);
322             v += 9;
323           }
324           t[i2]     = s[0];
325           t[i2 + 1] = s[1];
326           t[i2 + 2] = s[2];
327           PetscKernel_v_gets_A_times_w_3(xw, idiag, s);
328           x[i2]     = xw[0];
329           x[i2 + 1] = xw[1];
330           x[i2 + 2] = xw[2];
331           idiag += 9;
332           i2 += 3;
333         }
334         break;
335       case 4:
336         PetscKernel_v_gets_A_times_w_4(x, idiag, b);
337         t[0] = b[0];
338         t[1] = b[1];
339         t[2] = b[2];
340         t[3] = b[3];
341         i2   = 4;
342         idiag += 16;
343         for (i = 1; i < m; i++) {
344           v    = aa + 16 * ai[i];
345           vi   = aj + ai[i];
346           nz   = diag[i] - ai[i];
347           s[0] = b[i2];
348           s[1] = b[i2 + 1];
349           s[2] = b[i2 + 2];
350           s[3] = b[i2 + 3];
351           while (nz--) {
352             idx   = 4 * (*vi++);
353             xw[0] = x[idx];
354             xw[1] = x[1 + idx];
355             xw[2] = x[2 + idx];
356             xw[3] = x[3 + idx];
357             PetscKernel_v_gets_v_minus_A_times_w_4(s, v, xw);
358             v += 16;
359           }
360           t[i2]     = s[0];
361           t[i2 + 1] = s[1];
362           t[i2 + 2] = s[2];
363           t[i2 + 3] = s[3];
364           PetscKernel_v_gets_A_times_w_4(xw, idiag, s);
365           x[i2]     = xw[0];
366           x[i2 + 1] = xw[1];
367           x[i2 + 2] = xw[2];
368           x[i2 + 3] = xw[3];
369           idiag += 16;
370           i2 += 4;
371         }
372         break;
373       case 5:
374         PetscKernel_v_gets_A_times_w_5(x, idiag, b);
375         t[0] = b[0];
376         t[1] = b[1];
377         t[2] = b[2];
378         t[3] = b[3];
379         t[4] = b[4];
380         i2   = 5;
381         idiag += 25;
382         for (i = 1; i < m; i++) {
383           v    = aa + 25 * ai[i];
384           vi   = aj + ai[i];
385           nz   = diag[i] - ai[i];
386           s[0] = b[i2];
387           s[1] = b[i2 + 1];
388           s[2] = b[i2 + 2];
389           s[3] = b[i2 + 3];
390           s[4] = b[i2 + 4];
391           while (nz--) {
392             idx   = 5 * (*vi++);
393             xw[0] = x[idx];
394             xw[1] = x[1 + idx];
395             xw[2] = x[2 + idx];
396             xw[3] = x[3 + idx];
397             xw[4] = x[4 + idx];
398             PetscKernel_v_gets_v_minus_A_times_w_5(s, v, xw);
399             v += 25;
400           }
401           t[i2]     = s[0];
402           t[i2 + 1] = s[1];
403           t[i2 + 2] = s[2];
404           t[i2 + 3] = s[3];
405           t[i2 + 4] = s[4];
406           PetscKernel_v_gets_A_times_w_5(xw, idiag, s);
407           x[i2]     = xw[0];
408           x[i2 + 1] = xw[1];
409           x[i2 + 2] = xw[2];
410           x[i2 + 3] = xw[3];
411           x[i2 + 4] = xw[4];
412           idiag += 25;
413           i2 += 5;
414         }
415         break;
416       case 6:
417         PetscKernel_v_gets_A_times_w_6(x, idiag, b);
418         t[0] = b[0];
419         t[1] = b[1];
420         t[2] = b[2];
421         t[3] = b[3];
422         t[4] = b[4];
423         t[5] = b[5];
424         i2   = 6;
425         idiag += 36;
426         for (i = 1; i < m; i++) {
427           v    = aa + 36 * ai[i];
428           vi   = aj + ai[i];
429           nz   = diag[i] - ai[i];
430           s[0] = b[i2];
431           s[1] = b[i2 + 1];
432           s[2] = b[i2 + 2];
433           s[3] = b[i2 + 3];
434           s[4] = b[i2 + 4];
435           s[5] = b[i2 + 5];
436           while (nz--) {
437             idx   = 6 * (*vi++);
438             xw[0] = x[idx];
439             xw[1] = x[1 + idx];
440             xw[2] = x[2 + idx];
441             xw[3] = x[3 + idx];
442             xw[4] = x[4 + idx];
443             xw[5] = x[5 + idx];
444             PetscKernel_v_gets_v_minus_A_times_w_6(s, v, xw);
445             v += 36;
446           }
447           t[i2]     = s[0];
448           t[i2 + 1] = s[1];
449           t[i2 + 2] = s[2];
450           t[i2 + 3] = s[3];
451           t[i2 + 4] = s[4];
452           t[i2 + 5] = s[5];
453           PetscKernel_v_gets_A_times_w_6(xw, idiag, s);
454           x[i2]     = xw[0];
455           x[i2 + 1] = xw[1];
456           x[i2 + 2] = xw[2];
457           x[i2 + 3] = xw[3];
458           x[i2 + 4] = xw[4];
459           x[i2 + 5] = xw[5];
460           idiag += 36;
461           i2 += 6;
462         }
463         break;
464       case 7:
465         PetscKernel_v_gets_A_times_w_7(x, idiag, b);
466         t[0] = b[0];
467         t[1] = b[1];
468         t[2] = b[2];
469         t[3] = b[3];
470         t[4] = b[4];
471         t[5] = b[5];
472         t[6] = b[6];
473         i2   = 7;
474         idiag += 49;
475         for (i = 1; i < m; i++) {
476           v    = aa + 49 * ai[i];
477           vi   = aj + ai[i];
478           nz   = diag[i] - ai[i];
479           s[0] = b[i2];
480           s[1] = b[i2 + 1];
481           s[2] = b[i2 + 2];
482           s[3] = b[i2 + 3];
483           s[4] = b[i2 + 4];
484           s[5] = b[i2 + 5];
485           s[6] = b[i2 + 6];
486           while (nz--) {
487             idx   = 7 * (*vi++);
488             xw[0] = x[idx];
489             xw[1] = x[1 + idx];
490             xw[2] = x[2 + idx];
491             xw[3] = x[3 + idx];
492             xw[4] = x[4 + idx];
493             xw[5] = x[5 + idx];
494             xw[6] = x[6 + idx];
495             PetscKernel_v_gets_v_minus_A_times_w_7(s, v, xw);
496             v += 49;
497           }
498           t[i2]     = s[0];
499           t[i2 + 1] = s[1];
500           t[i2 + 2] = s[2];
501           t[i2 + 3] = s[3];
502           t[i2 + 4] = s[4];
503           t[i2 + 5] = s[5];
504           t[i2 + 6] = s[6];
505           PetscKernel_v_gets_A_times_w_7(xw, idiag, s);
506           x[i2]     = xw[0];
507           x[i2 + 1] = xw[1];
508           x[i2 + 2] = xw[2];
509           x[i2 + 3] = xw[3];
510           x[i2 + 4] = xw[4];
511           x[i2 + 5] = xw[5];
512           x[i2 + 6] = xw[6];
513           idiag += 49;
514           i2 += 7;
515         }
516         break;
517       default:
518         PetscKernel_w_gets_Ar_times_v(bs, bs, b, idiag, x);
519         PetscCall(PetscArraycpy(t, b, bs));
520         i2 = bs;
521         idiag += bs2;
522         for (i = 1; i < m; i++) {
523           v  = aa + bs2 * ai[i];
524           vi = aj + ai[i];
525           nz = diag[i] - ai[i];
526 
527           PetscCall(PetscArraycpy(w, b + i2, bs));
528           /* copy all rows of x that are needed into contiguous space */
529           workt = work;
530           for (j = 0; j < nz; j++) {
531             PetscCall(PetscArraycpy(workt, x + bs * (*vi++), bs));
532             workt += bs;
533           }
534           PetscKernel_w_gets_w_minus_Ar_times_v(bs, bs * nz, w, v, work);
535           PetscCall(PetscArraycpy(t + i2, w, bs));
536           PetscKernel_w_gets_Ar_times_v(bs, bs, w, idiag, x + i2);
537 
538           idiag += bs2;
539           i2 += bs;
540         }
541         break;
542       }
543       /* for logging purposes assume number of nonzero in lower half is 1/2 of total */
544       PetscCall(PetscLogFlops(1.0 * bs2 * a->nz));
545       xb = t;
546     } else xb = b;
547     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP) {
548       idiag = a->idiag + bs2 * (a->mbs - 1);
549       i2    = bs * (m - 1);
550       switch (bs) {
551       case 1:
552         s[0] = xb[i2];
553         PetscKernel_v_gets_A_times_w_1(xw, idiag, s);
554         x[i2] = xw[0];
555         i2 -= 1;
556         for (i = m - 2; i >= 0; i--) {
557           v    = aa + (diag[i] + 1);
558           vi   = aj + diag[i] + 1;
559           nz   = ai[i + 1] - diag[i] - 1;
560           s[0] = xb[i2];
561           for (j = 0; j < nz; j++) {
562             xw[0] = x[vi[j]];
563             PetscKernel_v_gets_v_minus_A_times_w_1(s, (v + j), xw);
564           }
565           PetscKernel_v_gets_A_times_w_1(xw, idiag, s);
566           x[i2] = xw[0];
567           idiag -= 1;
568           i2 -= 1;
569         }
570         break;
571       case 2:
572         s[0] = xb[i2];
573         s[1] = xb[i2 + 1];
574         PetscKernel_v_gets_A_times_w_2(xw, idiag, s);
575         x[i2]     = xw[0];
576         x[i2 + 1] = xw[1];
577         i2 -= 2;
578         idiag -= 4;
579         for (i = m - 2; i >= 0; i--) {
580           v    = aa + 4 * (diag[i] + 1);
581           vi   = aj + diag[i] + 1;
582           nz   = ai[i + 1] - diag[i] - 1;
583           s[0] = xb[i2];
584           s[1] = xb[i2 + 1];
585           for (j = 0; j < nz; j++) {
586             idx   = 2 * vi[j];
587             it    = 4 * j;
588             xw[0] = x[idx];
589             xw[1] = x[1 + idx];
590             PetscKernel_v_gets_v_minus_A_times_w_2(s, (v + it), xw);
591           }
592           PetscKernel_v_gets_A_times_w_2(xw, idiag, s);
593           x[i2]     = xw[0];
594           x[i2 + 1] = xw[1];
595           idiag -= 4;
596           i2 -= 2;
597         }
598         break;
599       case 3:
600         s[0] = xb[i2];
601         s[1] = xb[i2 + 1];
602         s[2] = xb[i2 + 2];
603         PetscKernel_v_gets_A_times_w_3(xw, idiag, s);
604         x[i2]     = xw[0];
605         x[i2 + 1] = xw[1];
606         x[i2 + 2] = xw[2];
607         i2 -= 3;
608         idiag -= 9;
609         for (i = m - 2; i >= 0; i--) {
610           v    = aa + 9 * (diag[i] + 1);
611           vi   = aj + diag[i] + 1;
612           nz   = ai[i + 1] - diag[i] - 1;
613           s[0] = xb[i2];
614           s[1] = xb[i2 + 1];
615           s[2] = xb[i2 + 2];
616           while (nz--) {
617             idx   = 3 * (*vi++);
618             xw[0] = x[idx];
619             xw[1] = x[1 + idx];
620             xw[2] = x[2 + idx];
621             PetscKernel_v_gets_v_minus_A_times_w_3(s, v, xw);
622             v += 9;
623           }
624           PetscKernel_v_gets_A_times_w_3(xw, idiag, s);
625           x[i2]     = xw[0];
626           x[i2 + 1] = xw[1];
627           x[i2 + 2] = xw[2];
628           idiag -= 9;
629           i2 -= 3;
630         }
631         break;
632       case 4:
633         s[0] = xb[i2];
634         s[1] = xb[i2 + 1];
635         s[2] = xb[i2 + 2];
636         s[3] = xb[i2 + 3];
637         PetscKernel_v_gets_A_times_w_4(xw, idiag, s);
638         x[i2]     = xw[0];
639         x[i2 + 1] = xw[1];
640         x[i2 + 2] = xw[2];
641         x[i2 + 3] = xw[3];
642         i2 -= 4;
643         idiag -= 16;
644         for (i = m - 2; i >= 0; i--) {
645           v    = aa + 16 * (diag[i] + 1);
646           vi   = aj + diag[i] + 1;
647           nz   = ai[i + 1] - diag[i] - 1;
648           s[0] = xb[i2];
649           s[1] = xb[i2 + 1];
650           s[2] = xb[i2 + 2];
651           s[3] = xb[i2 + 3];
652           while (nz--) {
653             idx   = 4 * (*vi++);
654             xw[0] = x[idx];
655             xw[1] = x[1 + idx];
656             xw[2] = x[2 + idx];
657             xw[3] = x[3 + idx];
658             PetscKernel_v_gets_v_minus_A_times_w_4(s, v, xw);
659             v += 16;
660           }
661           PetscKernel_v_gets_A_times_w_4(xw, idiag, s);
662           x[i2]     = xw[0];
663           x[i2 + 1] = xw[1];
664           x[i2 + 2] = xw[2];
665           x[i2 + 3] = xw[3];
666           idiag -= 16;
667           i2 -= 4;
668         }
669         break;
670       case 5:
671         s[0] = xb[i2];
672         s[1] = xb[i2 + 1];
673         s[2] = xb[i2 + 2];
674         s[3] = xb[i2 + 3];
675         s[4] = xb[i2 + 4];
676         PetscKernel_v_gets_A_times_w_5(xw, idiag, s);
677         x[i2]     = xw[0];
678         x[i2 + 1] = xw[1];
679         x[i2 + 2] = xw[2];
680         x[i2 + 3] = xw[3];
681         x[i2 + 4] = xw[4];
682         i2 -= 5;
683         idiag -= 25;
684         for (i = m - 2; i >= 0; i--) {
685           v    = aa + 25 * (diag[i] + 1);
686           vi   = aj + diag[i] + 1;
687           nz   = ai[i + 1] - diag[i] - 1;
688           s[0] = xb[i2];
689           s[1] = xb[i2 + 1];
690           s[2] = xb[i2 + 2];
691           s[3] = xb[i2 + 3];
692           s[4] = xb[i2 + 4];
693           while (nz--) {
694             idx   = 5 * (*vi++);
695             xw[0] = x[idx];
696             xw[1] = x[1 + idx];
697             xw[2] = x[2 + idx];
698             xw[3] = x[3 + idx];
699             xw[4] = x[4 + idx];
700             PetscKernel_v_gets_v_minus_A_times_w_5(s, v, xw);
701             v += 25;
702           }
703           PetscKernel_v_gets_A_times_w_5(xw, idiag, s);
704           x[i2]     = xw[0];
705           x[i2 + 1] = xw[1];
706           x[i2 + 2] = xw[2];
707           x[i2 + 3] = xw[3];
708           x[i2 + 4] = xw[4];
709           idiag -= 25;
710           i2 -= 5;
711         }
712         break;
713       case 6:
714         s[0] = xb[i2];
715         s[1] = xb[i2 + 1];
716         s[2] = xb[i2 + 2];
717         s[3] = xb[i2 + 3];
718         s[4] = xb[i2 + 4];
719         s[5] = xb[i2 + 5];
720         PetscKernel_v_gets_A_times_w_6(xw, idiag, s);
721         x[i2]     = xw[0];
722         x[i2 + 1] = xw[1];
723         x[i2 + 2] = xw[2];
724         x[i2 + 3] = xw[3];
725         x[i2 + 4] = xw[4];
726         x[i2 + 5] = xw[5];
727         i2 -= 6;
728         idiag -= 36;
729         for (i = m - 2; i >= 0; i--) {
730           v    = aa + 36 * (diag[i] + 1);
731           vi   = aj + diag[i] + 1;
732           nz   = ai[i + 1] - diag[i] - 1;
733           s[0] = xb[i2];
734           s[1] = xb[i2 + 1];
735           s[2] = xb[i2 + 2];
736           s[3] = xb[i2 + 3];
737           s[4] = xb[i2 + 4];
738           s[5] = xb[i2 + 5];
739           while (nz--) {
740             idx   = 6 * (*vi++);
741             xw[0] = x[idx];
742             xw[1] = x[1 + idx];
743             xw[2] = x[2 + idx];
744             xw[3] = x[3 + idx];
745             xw[4] = x[4 + idx];
746             xw[5] = x[5 + idx];
747             PetscKernel_v_gets_v_minus_A_times_w_6(s, v, xw);
748             v += 36;
749           }
750           PetscKernel_v_gets_A_times_w_6(xw, idiag, s);
751           x[i2]     = xw[0];
752           x[i2 + 1] = xw[1];
753           x[i2 + 2] = xw[2];
754           x[i2 + 3] = xw[3];
755           x[i2 + 4] = xw[4];
756           x[i2 + 5] = xw[5];
757           idiag -= 36;
758           i2 -= 6;
759         }
760         break;
761       case 7:
762         s[0] = xb[i2];
763         s[1] = xb[i2 + 1];
764         s[2] = xb[i2 + 2];
765         s[3] = xb[i2 + 3];
766         s[4] = xb[i2 + 4];
767         s[5] = xb[i2 + 5];
768         s[6] = xb[i2 + 6];
769         PetscKernel_v_gets_A_times_w_7(x, idiag, b);
770         x[i2]     = xw[0];
771         x[i2 + 1] = xw[1];
772         x[i2 + 2] = xw[2];
773         x[i2 + 3] = xw[3];
774         x[i2 + 4] = xw[4];
775         x[i2 + 5] = xw[5];
776         x[i2 + 6] = xw[6];
777         i2 -= 7;
778         idiag -= 49;
779         for (i = m - 2; i >= 0; i--) {
780           v    = aa + 49 * (diag[i] + 1);
781           vi   = aj + diag[i] + 1;
782           nz   = ai[i + 1] - diag[i] - 1;
783           s[0] = xb[i2];
784           s[1] = xb[i2 + 1];
785           s[2] = xb[i2 + 2];
786           s[3] = xb[i2 + 3];
787           s[4] = xb[i2 + 4];
788           s[5] = xb[i2 + 5];
789           s[6] = xb[i2 + 6];
790           while (nz--) {
791             idx   = 7 * (*vi++);
792             xw[0] = x[idx];
793             xw[1] = x[1 + idx];
794             xw[2] = x[2 + idx];
795             xw[3] = x[3 + idx];
796             xw[4] = x[4 + idx];
797             xw[5] = x[5 + idx];
798             xw[6] = x[6 + idx];
799             PetscKernel_v_gets_v_minus_A_times_w_7(s, v, xw);
800             v += 49;
801           }
802           PetscKernel_v_gets_A_times_w_7(xw, idiag, s);
803           x[i2]     = xw[0];
804           x[i2 + 1] = xw[1];
805           x[i2 + 2] = xw[2];
806           x[i2 + 3] = xw[3];
807           x[i2 + 4] = xw[4];
808           x[i2 + 5] = xw[5];
809           x[i2 + 6] = xw[6];
810           idiag -= 49;
811           i2 -= 7;
812         }
813         break;
814       default:
815         PetscCall(PetscArraycpy(w, xb + i2, bs));
816         PetscKernel_w_gets_Ar_times_v(bs, bs, w, idiag, x + i2);
817         i2 -= bs;
818         idiag -= bs2;
819         for (i = m - 2; i >= 0; i--) {
820           v  = aa + bs2 * (diag[i] + 1);
821           vi = aj + diag[i] + 1;
822           nz = ai[i + 1] - diag[i] - 1;
823 
824           PetscCall(PetscArraycpy(w, xb + i2, bs));
825           /* copy all rows of x that are needed into contiguous space */
826           workt = work;
827           for (j = 0; j < nz; j++) {
828             PetscCall(PetscArraycpy(workt, x + bs * (*vi++), bs));
829             workt += bs;
830           }
831           PetscKernel_w_gets_w_minus_Ar_times_v(bs, bs * nz, w, v, work);
832           PetscKernel_w_gets_Ar_times_v(bs, bs, w, idiag, x + i2);
833 
834           idiag -= bs2;
835           i2 -= bs;
836         }
837         break;
838       }
839       PetscCall(PetscLogFlops(1.0 * bs2 * (a->nz)));
840     }
841     its--;
842   }
843   while (its--) {
844     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP) {
845       idiag = a->idiag;
846       i2    = 0;
847       switch (bs) {
848       case 1:
849         for (i = 0; i < m; i++) {
850           v    = aa + ai[i];
851           vi   = aj + ai[i];
852           nz   = ai[i + 1] - ai[i];
853           s[0] = b[i2];
854           for (j = 0; j < nz; j++) {
855             xw[0] = x[vi[j]];
856             PetscKernel_v_gets_v_minus_A_times_w_1(s, (v + j), xw);
857           }
858           PetscKernel_v_gets_A_times_w_1(xw, idiag, s);
859           x[i2] += xw[0];
860           idiag += 1;
861           i2 += 1;
862         }
863         break;
864       case 2:
865         for (i = 0; i < m; i++) {
866           v    = aa + 4 * ai[i];
867           vi   = aj + ai[i];
868           nz   = ai[i + 1] - ai[i];
869           s[0] = b[i2];
870           s[1] = b[i2 + 1];
871           for (j = 0; j < nz; j++) {
872             idx   = 2 * vi[j];
873             it    = 4 * j;
874             xw[0] = x[idx];
875             xw[1] = x[1 + idx];
876             PetscKernel_v_gets_v_minus_A_times_w_2(s, (v + it), xw);
877           }
878           PetscKernel_v_gets_A_times_w_2(xw, idiag, s);
879           x[i2] += xw[0];
880           x[i2 + 1] += xw[1];
881           idiag += 4;
882           i2 += 2;
883         }
884         break;
885       case 3:
886         for (i = 0; i < m; i++) {
887           v    = aa + 9 * ai[i];
888           vi   = aj + ai[i];
889           nz   = ai[i + 1] - ai[i];
890           s[0] = b[i2];
891           s[1] = b[i2 + 1];
892           s[2] = b[i2 + 2];
893           while (nz--) {
894             idx   = 3 * (*vi++);
895             xw[0] = x[idx];
896             xw[1] = x[1 + idx];
897             xw[2] = x[2 + idx];
898             PetscKernel_v_gets_v_minus_A_times_w_3(s, v, xw);
899             v += 9;
900           }
901           PetscKernel_v_gets_A_times_w_3(xw, idiag, s);
902           x[i2] += xw[0];
903           x[i2 + 1] += xw[1];
904           x[i2 + 2] += xw[2];
905           idiag += 9;
906           i2 += 3;
907         }
908         break;
909       case 4:
910         for (i = 0; i < m; i++) {
911           v    = aa + 16 * ai[i];
912           vi   = aj + ai[i];
913           nz   = ai[i + 1] - ai[i];
914           s[0] = b[i2];
915           s[1] = b[i2 + 1];
916           s[2] = b[i2 + 2];
917           s[3] = b[i2 + 3];
918           while (nz--) {
919             idx   = 4 * (*vi++);
920             xw[0] = x[idx];
921             xw[1] = x[1 + idx];
922             xw[2] = x[2 + idx];
923             xw[3] = x[3 + idx];
924             PetscKernel_v_gets_v_minus_A_times_w_4(s, v, xw);
925             v += 16;
926           }
927           PetscKernel_v_gets_A_times_w_4(xw, idiag, s);
928           x[i2] += xw[0];
929           x[i2 + 1] += xw[1];
930           x[i2 + 2] += xw[2];
931           x[i2 + 3] += xw[3];
932           idiag += 16;
933           i2 += 4;
934         }
935         break;
936       case 5:
937         for (i = 0; i < m; i++) {
938           v    = aa + 25 * ai[i];
939           vi   = aj + ai[i];
940           nz   = ai[i + 1] - ai[i];
941           s[0] = b[i2];
942           s[1] = b[i2 + 1];
943           s[2] = b[i2 + 2];
944           s[3] = b[i2 + 3];
945           s[4] = b[i2 + 4];
946           while (nz--) {
947             idx   = 5 * (*vi++);
948             xw[0] = x[idx];
949             xw[1] = x[1 + idx];
950             xw[2] = x[2 + idx];
951             xw[3] = x[3 + idx];
952             xw[4] = x[4 + idx];
953             PetscKernel_v_gets_v_minus_A_times_w_5(s, v, xw);
954             v += 25;
955           }
956           PetscKernel_v_gets_A_times_w_5(xw, idiag, s);
957           x[i2] += xw[0];
958           x[i2 + 1] += xw[1];
959           x[i2 + 2] += xw[2];
960           x[i2 + 3] += xw[3];
961           x[i2 + 4] += xw[4];
962           idiag += 25;
963           i2 += 5;
964         }
965         break;
966       case 6:
967         for (i = 0; i < m; i++) {
968           v    = aa + 36 * ai[i];
969           vi   = aj + ai[i];
970           nz   = ai[i + 1] - ai[i];
971           s[0] = b[i2];
972           s[1] = b[i2 + 1];
973           s[2] = b[i2 + 2];
974           s[3] = b[i2 + 3];
975           s[4] = b[i2 + 4];
976           s[5] = b[i2 + 5];
977           while (nz--) {
978             idx   = 6 * (*vi++);
979             xw[0] = x[idx];
980             xw[1] = x[1 + idx];
981             xw[2] = x[2 + idx];
982             xw[3] = x[3 + idx];
983             xw[4] = x[4 + idx];
984             xw[5] = x[5 + idx];
985             PetscKernel_v_gets_v_minus_A_times_w_6(s, v, xw);
986             v += 36;
987           }
988           PetscKernel_v_gets_A_times_w_6(xw, idiag, s);
989           x[i2] += xw[0];
990           x[i2 + 1] += xw[1];
991           x[i2 + 2] += xw[2];
992           x[i2 + 3] += xw[3];
993           x[i2 + 4] += xw[4];
994           x[i2 + 5] += xw[5];
995           idiag += 36;
996           i2 += 6;
997         }
998         break;
999       case 7:
1000         for (i = 0; i < m; i++) {
1001           v    = aa + 49 * ai[i];
1002           vi   = aj + ai[i];
1003           nz   = ai[i + 1] - ai[i];
1004           s[0] = b[i2];
1005           s[1] = b[i2 + 1];
1006           s[2] = b[i2 + 2];
1007           s[3] = b[i2 + 3];
1008           s[4] = b[i2 + 4];
1009           s[5] = b[i2 + 5];
1010           s[6] = b[i2 + 6];
1011           while (nz--) {
1012             idx   = 7 * (*vi++);
1013             xw[0] = x[idx];
1014             xw[1] = x[1 + idx];
1015             xw[2] = x[2 + idx];
1016             xw[3] = x[3 + idx];
1017             xw[4] = x[4 + idx];
1018             xw[5] = x[5 + idx];
1019             xw[6] = x[6 + idx];
1020             PetscKernel_v_gets_v_minus_A_times_w_7(s, v, xw);
1021             v += 49;
1022           }
1023           PetscKernel_v_gets_A_times_w_7(xw, idiag, s);
1024           x[i2] += xw[0];
1025           x[i2 + 1] += xw[1];
1026           x[i2 + 2] += xw[2];
1027           x[i2 + 3] += xw[3];
1028           x[i2 + 4] += xw[4];
1029           x[i2 + 5] += xw[5];
1030           x[i2 + 6] += xw[6];
1031           idiag += 49;
1032           i2 += 7;
1033         }
1034         break;
1035       default:
1036         for (i = 0; i < m; i++) {
1037           v  = aa + bs2 * ai[i];
1038           vi = aj + ai[i];
1039           nz = ai[i + 1] - ai[i];
1040 
1041           PetscCall(PetscArraycpy(w, b + i2, bs));
1042           /* copy all rows of x that are needed into contiguous space */
1043           workt = work;
1044           for (j = 0; j < nz; j++) {
1045             PetscCall(PetscArraycpy(workt, x + bs * (*vi++), bs));
1046             workt += bs;
1047           }
1048           PetscKernel_w_gets_w_minus_Ar_times_v(bs, bs * nz, w, v, work);
1049           PetscKernel_w_gets_w_plus_Ar_times_v(bs, bs, w, idiag, x + i2);
1050 
1051           idiag += bs2;
1052           i2 += bs;
1053         }
1054         break;
1055       }
1056       PetscCall(PetscLogFlops(2.0 * bs2 * a->nz));
1057     }
1058     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP) {
1059       idiag = a->idiag + bs2 * (a->mbs - 1);
1060       i2    = bs * (m - 1);
1061       switch (bs) {
1062       case 1:
1063         for (i = m - 1; i >= 0; i--) {
1064           v    = aa + ai[i];
1065           vi   = aj + ai[i];
1066           nz   = ai[i + 1] - ai[i];
1067           s[0] = b[i2];
1068           for (j = 0; j < nz; j++) {
1069             xw[0] = x[vi[j]];
1070             PetscKernel_v_gets_v_minus_A_times_w_1(s, (v + j), xw);
1071           }
1072           PetscKernel_v_gets_A_times_w_1(xw, idiag, s);
1073           x[i2] += xw[0];
1074           idiag -= 1;
1075           i2 -= 1;
1076         }
1077         break;
1078       case 2:
1079         for (i = m - 1; i >= 0; i--) {
1080           v    = aa + 4 * ai[i];
1081           vi   = aj + ai[i];
1082           nz   = ai[i + 1] - ai[i];
1083           s[0] = b[i2];
1084           s[1] = b[i2 + 1];
1085           for (j = 0; j < nz; j++) {
1086             idx   = 2 * vi[j];
1087             it    = 4 * j;
1088             xw[0] = x[idx];
1089             xw[1] = x[1 + idx];
1090             PetscKernel_v_gets_v_minus_A_times_w_2(s, (v + it), xw);
1091           }
1092           PetscKernel_v_gets_A_times_w_2(xw, idiag, s);
1093           x[i2] += xw[0];
1094           x[i2 + 1] += xw[1];
1095           idiag -= 4;
1096           i2 -= 2;
1097         }
1098         break;
1099       case 3:
1100         for (i = m - 1; i >= 0; i--) {
1101           v    = aa + 9 * ai[i];
1102           vi   = aj + ai[i];
1103           nz   = ai[i + 1] - ai[i];
1104           s[0] = b[i2];
1105           s[1] = b[i2 + 1];
1106           s[2] = b[i2 + 2];
1107           while (nz--) {
1108             idx   = 3 * (*vi++);
1109             xw[0] = x[idx];
1110             xw[1] = x[1 + idx];
1111             xw[2] = x[2 + idx];
1112             PetscKernel_v_gets_v_minus_A_times_w_3(s, v, xw);
1113             v += 9;
1114           }
1115           PetscKernel_v_gets_A_times_w_3(xw, idiag, s);
1116           x[i2] += xw[0];
1117           x[i2 + 1] += xw[1];
1118           x[i2 + 2] += xw[2];
1119           idiag -= 9;
1120           i2 -= 3;
1121         }
1122         break;
1123       case 4:
1124         for (i = m - 1; i >= 0; i--) {
1125           v    = aa + 16 * ai[i];
1126           vi   = aj + ai[i];
1127           nz   = ai[i + 1] - ai[i];
1128           s[0] = b[i2];
1129           s[1] = b[i2 + 1];
1130           s[2] = b[i2 + 2];
1131           s[3] = b[i2 + 3];
1132           while (nz--) {
1133             idx   = 4 * (*vi++);
1134             xw[0] = x[idx];
1135             xw[1] = x[1 + idx];
1136             xw[2] = x[2 + idx];
1137             xw[3] = x[3 + idx];
1138             PetscKernel_v_gets_v_minus_A_times_w_4(s, v, xw);
1139             v += 16;
1140           }
1141           PetscKernel_v_gets_A_times_w_4(xw, idiag, s);
1142           x[i2] += xw[0];
1143           x[i2 + 1] += xw[1];
1144           x[i2 + 2] += xw[2];
1145           x[i2 + 3] += xw[3];
1146           idiag -= 16;
1147           i2 -= 4;
1148         }
1149         break;
1150       case 5:
1151         for (i = m - 1; i >= 0; i--) {
1152           v    = aa + 25 * ai[i];
1153           vi   = aj + ai[i];
1154           nz   = ai[i + 1] - ai[i];
1155           s[0] = b[i2];
1156           s[1] = b[i2 + 1];
1157           s[2] = b[i2 + 2];
1158           s[3] = b[i2 + 3];
1159           s[4] = b[i2 + 4];
1160           while (nz--) {
1161             idx   = 5 * (*vi++);
1162             xw[0] = x[idx];
1163             xw[1] = x[1 + idx];
1164             xw[2] = x[2 + idx];
1165             xw[3] = x[3 + idx];
1166             xw[4] = x[4 + idx];
1167             PetscKernel_v_gets_v_minus_A_times_w_5(s, v, xw);
1168             v += 25;
1169           }
1170           PetscKernel_v_gets_A_times_w_5(xw, idiag, s);
1171           x[i2] += xw[0];
1172           x[i2 + 1] += xw[1];
1173           x[i2 + 2] += xw[2];
1174           x[i2 + 3] += xw[3];
1175           x[i2 + 4] += xw[4];
1176           idiag -= 25;
1177           i2 -= 5;
1178         }
1179         break;
1180       case 6:
1181         for (i = m - 1; i >= 0; i--) {
1182           v    = aa + 36 * ai[i];
1183           vi   = aj + ai[i];
1184           nz   = ai[i + 1] - ai[i];
1185           s[0] = b[i2];
1186           s[1] = b[i2 + 1];
1187           s[2] = b[i2 + 2];
1188           s[3] = b[i2 + 3];
1189           s[4] = b[i2 + 4];
1190           s[5] = b[i2 + 5];
1191           while (nz--) {
1192             idx   = 6 * (*vi++);
1193             xw[0] = x[idx];
1194             xw[1] = x[1 + idx];
1195             xw[2] = x[2 + idx];
1196             xw[3] = x[3 + idx];
1197             xw[4] = x[4 + idx];
1198             xw[5] = x[5 + idx];
1199             PetscKernel_v_gets_v_minus_A_times_w_6(s, v, xw);
1200             v += 36;
1201           }
1202           PetscKernel_v_gets_A_times_w_6(xw, idiag, s);
1203           x[i2] += xw[0];
1204           x[i2 + 1] += xw[1];
1205           x[i2 + 2] += xw[2];
1206           x[i2 + 3] += xw[3];
1207           x[i2 + 4] += xw[4];
1208           x[i2 + 5] += xw[5];
1209           idiag -= 36;
1210           i2 -= 6;
1211         }
1212         break;
1213       case 7:
1214         for (i = m - 1; i >= 0; i--) {
1215           v    = aa + 49 * ai[i];
1216           vi   = aj + ai[i];
1217           nz   = ai[i + 1] - ai[i];
1218           s[0] = b[i2];
1219           s[1] = b[i2 + 1];
1220           s[2] = b[i2 + 2];
1221           s[3] = b[i2 + 3];
1222           s[4] = b[i2 + 4];
1223           s[5] = b[i2 + 5];
1224           s[6] = b[i2 + 6];
1225           while (nz--) {
1226             idx   = 7 * (*vi++);
1227             xw[0] = x[idx];
1228             xw[1] = x[1 + idx];
1229             xw[2] = x[2 + idx];
1230             xw[3] = x[3 + idx];
1231             xw[4] = x[4 + idx];
1232             xw[5] = x[5 + idx];
1233             xw[6] = x[6 + idx];
1234             PetscKernel_v_gets_v_minus_A_times_w_7(s, v, xw);
1235             v += 49;
1236           }
1237           PetscKernel_v_gets_A_times_w_7(xw, idiag, s);
1238           x[i2] += xw[0];
1239           x[i2 + 1] += xw[1];
1240           x[i2 + 2] += xw[2];
1241           x[i2 + 3] += xw[3];
1242           x[i2 + 4] += xw[4];
1243           x[i2 + 5] += xw[5];
1244           x[i2 + 6] += xw[6];
1245           idiag -= 49;
1246           i2 -= 7;
1247         }
1248         break;
1249       default:
1250         for (i = m - 1; i >= 0; i--) {
1251           v  = aa + bs2 * ai[i];
1252           vi = aj + ai[i];
1253           nz = ai[i + 1] - ai[i];
1254 
1255           PetscCall(PetscArraycpy(w, b + i2, bs));
1256           /* copy all rows of x that are needed into contiguous space */
1257           workt = work;
1258           for (j = 0; j < nz; j++) {
1259             PetscCall(PetscArraycpy(workt, x + bs * (*vi++), bs));
1260             workt += bs;
1261           }
1262           PetscKernel_w_gets_w_minus_Ar_times_v(bs, bs * nz, w, v, work);
1263           PetscKernel_w_gets_w_plus_Ar_times_v(bs, bs, w, idiag, x + i2);
1264 
1265           idiag -= bs2;
1266           i2 -= bs;
1267         }
1268         break;
1269       }
1270       PetscCall(PetscLogFlops(2.0 * bs2 * (a->nz)));
1271     }
1272   }
1273   PetscCall(VecRestoreArray(xx, &x));
1274   PetscCall(VecRestoreArrayRead(bb, &b));
1275   PetscFunctionReturn(PETSC_SUCCESS);
1276 }
1277 
1278 /*
1279     Special version for direct calls from Fortran (Used in PETSc-fun3d)
1280 */
1281 #if defined(PETSC_HAVE_FORTRAN_CAPS)
1282   #define matsetvaluesblocked4_ MATSETVALUESBLOCKED4
1283 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
1284   #define matsetvaluesblocked4_ matsetvaluesblocked4
1285 #endif
1286 
1287 PETSC_EXTERN void matsetvaluesblocked4_(Mat *AA, PetscInt *mm, const PetscInt im[], PetscInt *nn, const PetscInt in[], const PetscScalar v[])
1288 {
1289   Mat                A = *AA;
1290   Mat_SeqBAIJ       *a = (Mat_SeqBAIJ *)A->data;
1291   PetscInt          *rp, k, low, high, t, ii, jj, row, nrow, i, col, l, N, m = *mm, n = *nn;
1292   PetscInt          *ai = a->i, *ailen = a->ilen;
1293   PetscInt          *aj = a->j, stepval, lastcol = -1;
1294   const PetscScalar *value = v;
1295   MatScalar         *ap, *aa = a->a, *bap;
1296 
1297   PetscFunctionBegin;
1298   if (A->rmap->bs != 4) SETERRABORT(PetscObjectComm((PetscObject)A), PETSC_ERR_ARG_WRONG, "Can only be called with a block size of 4");
1299   stepval = (n - 1) * 4;
1300   for (k = 0; k < m; k++) { /* loop over added rows */
1301     row  = im[k];
1302     rp   = aj + ai[row];
1303     ap   = aa + 16 * ai[row];
1304     nrow = ailen[row];
1305     low  = 0;
1306     high = nrow;
1307     for (l = 0; l < n; l++) { /* loop over added columns */
1308       col = in[l];
1309       if (col <= lastcol) low = 0;
1310       else high = nrow;
1311       lastcol = col;
1312       value   = v + k * (stepval + 4 + l) * 4;
1313       while (high - low > 7) {
1314         t = (low + high) / 2;
1315         if (rp[t] > col) high = t;
1316         else low = t;
1317       }
1318       for (i = low; i < high; i++) {
1319         if (rp[i] > col) break;
1320         if (rp[i] == col) {
1321           bap = ap + 16 * i;
1322           for (ii = 0; ii < 4; ii++, value += stepval) {
1323             for (jj = ii; jj < 16; jj += 4) bap[jj] += *value++;
1324           }
1325           goto noinsert2;
1326         }
1327       }
1328       N = nrow++ - 1;
1329       high++; /* added new column index thus must search to one higher than before */
1330       /* shift up all the later entries in this row */
1331       for (ii = N; ii >= i; ii--) {
1332         rp[ii + 1] = rp[ii];
1333         PetscCallVoid(PetscArraycpy(ap + 16 * (ii + 1), ap + 16 * (ii), 16));
1334       }
1335       if (N >= i) PetscCallVoid(PetscArrayzero(ap + 16 * i, 16));
1336       rp[i] = col;
1337       bap   = ap + 16 * i;
1338       for (ii = 0; ii < 4; ii++, value += stepval) {
1339         for (jj = ii; jj < 16; jj += 4) bap[jj] = *value++;
1340       }
1341     noinsert2:;
1342       low = i;
1343     }
1344     ailen[row] = nrow;
1345   }
1346   PetscFunctionReturnVoid();
1347 }
1348 
1349 #if defined(PETSC_HAVE_FORTRAN_CAPS)
1350   #define matsetvalues4_ MATSETVALUES4
1351 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
1352   #define matsetvalues4_ matsetvalues4
1353 #endif
1354 
1355 PETSC_EXTERN void matsetvalues4_(Mat *AA, PetscInt *mm, PetscInt *im, PetscInt *nn, PetscInt *in, PetscScalar *v)
1356 {
1357   Mat          A = *AA;
1358   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
1359   PetscInt    *rp, k, low, high, t, row, nrow, i, col, l, N, n = *nn, m = *mm;
1360   PetscInt    *ai = a->i, *ailen = a->ilen;
1361   PetscInt    *aj = a->j, brow, bcol;
1362   PetscInt     ridx, cidx, lastcol = -1;
1363   MatScalar   *ap, value, *aa      = a->a, *bap;
1364 
1365   PetscFunctionBegin;
1366   for (k = 0; k < m; k++) { /* loop over added rows */
1367     row  = im[k];
1368     brow = row / 4;
1369     rp   = aj + ai[brow];
1370     ap   = aa + 16 * ai[brow];
1371     nrow = ailen[brow];
1372     low  = 0;
1373     high = nrow;
1374     for (l = 0; l < n; l++) { /* loop over added columns */
1375       col   = in[l];
1376       bcol  = col / 4;
1377       ridx  = row % 4;
1378       cidx  = col % 4;
1379       value = v[l + k * n];
1380       if (col <= lastcol) low = 0;
1381       else high = nrow;
1382       lastcol = col;
1383       while (high - low > 7) {
1384         t = (low + high) / 2;
1385         if (rp[t] > bcol) high = t;
1386         else low = t;
1387       }
1388       for (i = low; i < high; i++) {
1389         if (rp[i] > bcol) break;
1390         if (rp[i] == bcol) {
1391           bap = ap + 16 * i + 4 * cidx + ridx;
1392           *bap += value;
1393           goto noinsert1;
1394         }
1395       }
1396       N = nrow++ - 1;
1397       high++; /* added new column thus must search to one higher than before */
1398       /* shift up all the later entries in this row */
1399       PetscCallVoid(PetscArraymove(rp + i + 1, rp + i, N - i + 1));
1400       PetscCallVoid(PetscArraymove(ap + 16 * i + 16, ap + 16 * i, 16 * (N - i + 1)));
1401       PetscCallVoid(PetscArrayzero(ap + 16 * i, 16));
1402       rp[i]                        = bcol;
1403       ap[16 * i + 4 * cidx + ridx] = value;
1404     noinsert1:;
1405       low = i;
1406     }
1407     ailen[brow] = nrow;
1408   }
1409   PetscFunctionReturnVoid();
1410 }
1411 
1412 /*
1413      Checks for missing diagonals
1414 */
1415 PetscErrorCode MatMissingDiagonal_SeqBAIJ(Mat A, PetscBool *missing, PetscInt *d)
1416 {
1417   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
1418   PetscInt    *diag, *ii = a->i, i;
1419 
1420   PetscFunctionBegin;
1421   PetscCall(MatMarkDiagonal_SeqBAIJ(A));
1422   *missing = PETSC_FALSE;
1423   if (A->rmap->n > 0 && !ii) {
1424     *missing = PETSC_TRUE;
1425     if (d) *d = 0;
1426     PetscCall(PetscInfo(A, "Matrix has no entries therefore is missing diagonal\n"));
1427   } else {
1428     PetscInt n;
1429     n    = PetscMin(a->mbs, a->nbs);
1430     diag = a->diag;
1431     for (i = 0; i < n; i++) {
1432       if (diag[i] >= ii[i + 1]) {
1433         *missing = PETSC_TRUE;
1434         if (d) *d = i;
1435         PetscCall(PetscInfo(A, "Matrix is missing block diagonal number %" PetscInt_FMT "\n", i));
1436         break;
1437       }
1438     }
1439   }
1440   PetscFunctionReturn(PETSC_SUCCESS);
1441 }
1442 
1443 PetscErrorCode MatMarkDiagonal_SeqBAIJ(Mat A)
1444 {
1445   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
1446   PetscInt     i, j, m = a->mbs;
1447 
1448   PetscFunctionBegin;
1449   if (!a->diag) {
1450     PetscCall(PetscMalloc1(m, &a->diag));
1451     a->free_diag = PETSC_TRUE;
1452   }
1453   for (i = 0; i < m; i++) {
1454     a->diag[i] = a->i[i + 1];
1455     for (j = a->i[i]; j < a->i[i + 1]; j++) {
1456       if (a->j[j] == i) {
1457         a->diag[i] = j;
1458         break;
1459       }
1460     }
1461   }
1462   PetscFunctionReturn(PETSC_SUCCESS);
1463 }
1464 
1465 static PetscErrorCode MatGetRowIJ_SeqBAIJ(Mat A, PetscInt oshift, PetscBool symmetric, PetscBool blockcompressed, PetscInt *nn, const PetscInt *inia[], const PetscInt *inja[], PetscBool *done)
1466 {
1467   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
1468   PetscInt     i, j, n = a->mbs, nz = a->i[n], *tia, *tja, bs = A->rmap->bs, k, l, cnt;
1469   PetscInt   **ia = (PetscInt **)inia, **ja = (PetscInt **)inja;
1470 
1471   PetscFunctionBegin;
1472   *nn = n;
1473   if (!ia) PetscFunctionReturn(PETSC_SUCCESS);
1474   if (symmetric) {
1475     PetscCall(MatToSymmetricIJ_SeqAIJ(n, a->i, a->j, PETSC_TRUE, 0, 0, &tia, &tja));
1476     nz = tia[n];
1477   } else {
1478     tia = a->i;
1479     tja = a->j;
1480   }
1481 
1482   if (!blockcompressed && bs > 1) {
1483     (*nn) *= bs;
1484     /* malloc & create the natural set of indices */
1485     PetscCall(PetscMalloc1((n + 1) * bs, ia));
1486     if (n) {
1487       (*ia)[0] = oshift;
1488       for (j = 1; j < bs; j++) (*ia)[j] = (tia[1] - tia[0]) * bs + (*ia)[j - 1];
1489     }
1490 
1491     for (i = 1; i < n; i++) {
1492       (*ia)[i * bs] = (tia[i] - tia[i - 1]) * bs + (*ia)[i * bs - 1];
1493       for (j = 1; j < bs; j++) (*ia)[i * bs + j] = (tia[i + 1] - tia[i]) * bs + (*ia)[i * bs + j - 1];
1494     }
1495     if (n) (*ia)[n * bs] = (tia[n] - tia[n - 1]) * bs + (*ia)[n * bs - 1];
1496 
1497     if (inja) {
1498       PetscCall(PetscMalloc1(nz * bs * bs, ja));
1499       cnt = 0;
1500       for (i = 0; i < n; i++) {
1501         for (j = 0; j < bs; j++) {
1502           for (k = tia[i]; k < tia[i + 1]; k++) {
1503             for (l = 0; l < bs; l++) (*ja)[cnt++] = bs * tja[k] + l;
1504           }
1505         }
1506       }
1507     }
1508 
1509     if (symmetric) { /* deallocate memory allocated in MatToSymmetricIJ_SeqAIJ() */
1510       PetscCall(PetscFree(tia));
1511       PetscCall(PetscFree(tja));
1512     }
1513   } else if (oshift == 1) {
1514     if (symmetric) {
1515       nz = tia[A->rmap->n / bs];
1516       /*  add 1 to i and j indices */
1517       for (i = 0; i < A->rmap->n / bs + 1; i++) tia[i] = tia[i] + 1;
1518       *ia = tia;
1519       if (ja) {
1520         for (i = 0; i < nz; i++) tja[i] = tja[i] + 1;
1521         *ja = tja;
1522       }
1523     } else {
1524       nz = a->i[A->rmap->n / bs];
1525       /* malloc space and  add 1 to i and j indices */
1526       PetscCall(PetscMalloc1(A->rmap->n / bs + 1, ia));
1527       for (i = 0; i < A->rmap->n / bs + 1; i++) (*ia)[i] = a->i[i] + 1;
1528       if (ja) {
1529         PetscCall(PetscMalloc1(nz, ja));
1530         for (i = 0; i < nz; i++) (*ja)[i] = a->j[i] + 1;
1531       }
1532     }
1533   } else {
1534     *ia = tia;
1535     if (ja) *ja = tja;
1536   }
1537   PetscFunctionReturn(PETSC_SUCCESS);
1538 }
1539 
1540 static PetscErrorCode MatRestoreRowIJ_SeqBAIJ(Mat A, PetscInt oshift, PetscBool symmetric, PetscBool blockcompressed, PetscInt *nn, const PetscInt *ia[], const PetscInt *ja[], PetscBool *done)
1541 {
1542   PetscFunctionBegin;
1543   if (!ia) PetscFunctionReturn(PETSC_SUCCESS);
1544   if ((!blockcompressed && A->rmap->bs > 1) || (symmetric || oshift == 1)) {
1545     PetscCall(PetscFree(*ia));
1546     if (ja) PetscCall(PetscFree(*ja));
1547   }
1548   PetscFunctionReturn(PETSC_SUCCESS);
1549 }
1550 
1551 PetscErrorCode MatDestroy_SeqBAIJ(Mat A)
1552 {
1553   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
1554 
1555   PetscFunctionBegin;
1556   if (A->hash_active) {
1557     PetscInt bs;
1558     A->ops[0] = a->cops;
1559     PetscCall(PetscHMapIJVDestroy(&a->ht));
1560     PetscCall(MatGetBlockSize(A, &bs));
1561     if (bs > 1) PetscCall(PetscHSetIJDestroy(&a->bht));
1562     PetscCall(PetscFree(a->dnz));
1563     PetscCall(PetscFree(a->bdnz));
1564     A->hash_active = PETSC_FALSE;
1565   }
1566   PetscCall(PetscLogObjectState((PetscObject)A, "Rows=%" PetscInt_FMT ", Cols=%" PetscInt_FMT ", NZ=%" PetscInt_FMT, A->rmap->N, A->cmap->n, a->nz));
1567   PetscCall(MatSeqXAIJFreeAIJ(A, &a->a, &a->j, &a->i));
1568   PetscCall(ISDestroy(&a->row));
1569   PetscCall(ISDestroy(&a->col));
1570   if (a->free_diag) PetscCall(PetscFree(a->diag));
1571   PetscCall(PetscFree(a->idiag));
1572   if (a->free_imax_ilen) PetscCall(PetscFree2(a->imax, a->ilen));
1573   PetscCall(PetscFree(a->solve_work));
1574   PetscCall(PetscFree(a->mult_work));
1575   PetscCall(PetscFree(a->sor_workt));
1576   PetscCall(PetscFree(a->sor_work));
1577   PetscCall(ISDestroy(&a->icol));
1578   PetscCall(PetscFree(a->saved_values));
1579   PetscCall(PetscFree2(a->compressedrow.i, a->compressedrow.rindex));
1580 
1581   PetscCall(MatDestroy(&a->sbaijMat));
1582   PetscCall(MatDestroy(&a->parent));
1583   PetscCall(PetscFree(A->data));
1584 
1585   PetscCall(PetscObjectChangeTypeName((PetscObject)A, NULL));
1586   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatSeqBAIJGetArray_C", NULL));
1587   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatSeqBAIJRestoreArray_C", NULL));
1588   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatStoreValues_C", NULL));
1589   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatRetrieveValues_C", NULL));
1590   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatSeqBAIJSetColumnIndices_C", NULL));
1591   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatConvert_seqbaij_seqaij_C", NULL));
1592   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatConvert_seqbaij_seqsbaij_C", NULL));
1593   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatSeqBAIJSetPreallocation_C", NULL));
1594   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatSeqBAIJSetPreallocationCSR_C", NULL));
1595   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatConvert_seqbaij_seqbstrm_C", NULL));
1596   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatIsTranspose_C", NULL));
1597 #if defined(PETSC_HAVE_HYPRE)
1598   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatConvert_seqbaij_hypre_C", NULL));
1599 #endif
1600   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatConvert_seqbaij_is_C", NULL));
1601   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatFactorGetSolverType_C", NULL));
1602   PetscFunctionReturn(PETSC_SUCCESS);
1603 }
1604 
1605 static PetscErrorCode MatSetOption_SeqBAIJ(Mat A, MatOption op, PetscBool flg)
1606 {
1607   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
1608 
1609   PetscFunctionBegin;
1610   switch (op) {
1611   case MAT_ROW_ORIENTED:
1612     a->roworiented = flg;
1613     break;
1614   case MAT_KEEP_NONZERO_PATTERN:
1615     a->keepnonzeropattern = flg;
1616     break;
1617   case MAT_NEW_NONZERO_LOCATIONS:
1618     a->nonew = (flg ? 0 : 1);
1619     break;
1620   case MAT_NEW_NONZERO_LOCATION_ERR:
1621     a->nonew = (flg ? -1 : 0);
1622     break;
1623   case MAT_NEW_NONZERO_ALLOCATION_ERR:
1624     a->nonew = (flg ? -2 : 0);
1625     break;
1626   case MAT_UNUSED_NONZERO_LOCATION_ERR:
1627     a->nounused = (flg ? -1 : 0);
1628     break;
1629   case MAT_FORCE_DIAGONAL_ENTRIES:
1630   case MAT_IGNORE_OFF_PROC_ENTRIES:
1631   case MAT_USE_HASH_TABLE:
1632   case MAT_SORTED_FULL:
1633     PetscCall(PetscInfo(A, "Option %s ignored\n", MatOptions[op]));
1634     break;
1635   case MAT_SPD:
1636   case MAT_SYMMETRIC:
1637   case MAT_STRUCTURALLY_SYMMETRIC:
1638   case MAT_HERMITIAN:
1639   case MAT_SYMMETRY_ETERNAL:
1640   case MAT_STRUCTURAL_SYMMETRY_ETERNAL:
1641   case MAT_SUBMAT_SINGLEIS:
1642   case MAT_STRUCTURE_ONLY:
1643   case MAT_SPD_ETERNAL:
1644     /* if the diagonal matrix is square it inherits some of the properties above */
1645     break;
1646   default:
1647     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "unknown option %d", op);
1648   }
1649   PetscFunctionReturn(PETSC_SUCCESS);
1650 }
1651 
1652 /* used for both SeqBAIJ and SeqSBAIJ matrices */
1653 PetscErrorCode MatGetRow_SeqBAIJ_private(Mat A, PetscInt row, PetscInt *nz, PetscInt **idx, PetscScalar **v, PetscInt *ai, PetscInt *aj, PetscScalar *aa)
1654 {
1655   PetscInt     itmp, i, j, k, M, bn, bp, *idx_i, bs, bs2;
1656   MatScalar   *aa_i;
1657   PetscScalar *v_i;
1658 
1659   PetscFunctionBegin;
1660   bs  = A->rmap->bs;
1661   bs2 = bs * bs;
1662   PetscCheck(row >= 0 && row < A->rmap->N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Row %" PetscInt_FMT " out of range", row);
1663 
1664   bn  = row / bs; /* Block number */
1665   bp  = row % bs; /* Block Position */
1666   M   = ai[bn + 1] - ai[bn];
1667   *nz = bs * M;
1668 
1669   if (v) {
1670     *v = NULL;
1671     if (*nz) {
1672       PetscCall(PetscMalloc1(*nz, v));
1673       for (i = 0; i < M; i++) { /* for each block in the block row */
1674         v_i  = *v + i * bs;
1675         aa_i = aa + bs2 * (ai[bn] + i);
1676         for (j = bp, k = 0; j < bs2; j += bs, k++) v_i[k] = aa_i[j];
1677       }
1678     }
1679   }
1680 
1681   if (idx) {
1682     *idx = NULL;
1683     if (*nz) {
1684       PetscCall(PetscMalloc1(*nz, idx));
1685       for (i = 0; i < M; i++) { /* for each block in the block row */
1686         idx_i = *idx + i * bs;
1687         itmp  = bs * aj[ai[bn] + i];
1688         for (j = 0; j < bs; j++) idx_i[j] = itmp++;
1689       }
1690     }
1691   }
1692   PetscFunctionReturn(PETSC_SUCCESS);
1693 }
1694 
1695 PetscErrorCode MatGetRow_SeqBAIJ(Mat A, PetscInt row, PetscInt *nz, PetscInt **idx, PetscScalar **v)
1696 {
1697   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
1698 
1699   PetscFunctionBegin;
1700   PetscCall(MatGetRow_SeqBAIJ_private(A, row, nz, idx, v, a->i, a->j, a->a));
1701   PetscFunctionReturn(PETSC_SUCCESS);
1702 }
1703 
1704 PetscErrorCode MatRestoreRow_SeqBAIJ(Mat A, PetscInt row, PetscInt *nz, PetscInt **idx, PetscScalar **v)
1705 {
1706   PetscFunctionBegin;
1707   if (idx) PetscCall(PetscFree(*idx));
1708   if (v) PetscCall(PetscFree(*v));
1709   PetscFunctionReturn(PETSC_SUCCESS);
1710 }
1711 
1712 static PetscErrorCode MatTranspose_SeqBAIJ(Mat A, MatReuse reuse, Mat *B)
1713 {
1714   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data, *at;
1715   Mat          C;
1716   PetscInt     i, j, k, *aj = a->j, *ai = a->i, bs = A->rmap->bs, mbs = a->mbs, nbs = a->nbs, *atfill;
1717   PetscInt     bs2 = a->bs2, *ati, *atj, anzj, kr;
1718   MatScalar   *ata, *aa = a->a;
1719 
1720   PetscFunctionBegin;
1721   if (reuse == MAT_REUSE_MATRIX) PetscCall(MatTransposeCheckNonzeroState_Private(A, *B));
1722   PetscCall(PetscCalloc1(1 + nbs, &atfill));
1723   if (reuse == MAT_INITIAL_MATRIX || reuse == MAT_INPLACE_MATRIX) {
1724     for (i = 0; i < ai[mbs]; i++) atfill[aj[i]] += 1; /* count num of non-zeros in row aj[i] */
1725 
1726     PetscCall(MatCreate(PetscObjectComm((PetscObject)A), &C));
1727     PetscCall(MatSetSizes(C, A->cmap->n, A->rmap->N, A->cmap->n, A->rmap->N));
1728     PetscCall(MatSetType(C, ((PetscObject)A)->type_name));
1729     PetscCall(MatSeqBAIJSetPreallocation(C, bs, 0, atfill));
1730 
1731     at  = (Mat_SeqBAIJ *)C->data;
1732     ati = at->i;
1733     for (i = 0; i < nbs; i++) at->ilen[i] = at->imax[i] = ati[i + 1] - ati[i];
1734   } else {
1735     C   = *B;
1736     at  = (Mat_SeqBAIJ *)C->data;
1737     ati = at->i;
1738   }
1739 
1740   atj = at->j;
1741   ata = at->a;
1742 
1743   /* Copy ati into atfill so we have locations of the next free space in atj */
1744   PetscCall(PetscArraycpy(atfill, ati, nbs));
1745 
1746   /* Walk through A row-wise and mark nonzero entries of A^T. */
1747   for (i = 0; i < mbs; i++) {
1748     anzj = ai[i + 1] - ai[i];
1749     for (j = 0; j < anzj; j++) {
1750       atj[atfill[*aj]] = i;
1751       for (kr = 0; kr < bs; kr++) {
1752         for (k = 0; k < bs; k++) ata[bs2 * atfill[*aj] + k * bs + kr] = *aa++;
1753       }
1754       atfill[*aj++] += 1;
1755     }
1756   }
1757   PetscCall(MatAssemblyBegin(C, MAT_FINAL_ASSEMBLY));
1758   PetscCall(MatAssemblyEnd(C, MAT_FINAL_ASSEMBLY));
1759 
1760   /* Clean up temporary space and complete requests. */
1761   PetscCall(PetscFree(atfill));
1762 
1763   if (reuse == MAT_INITIAL_MATRIX || reuse == MAT_REUSE_MATRIX) {
1764     PetscCall(MatSetBlockSizes(C, PetscAbs(A->cmap->bs), PetscAbs(A->rmap->bs)));
1765     *B = C;
1766   } else {
1767     PetscCall(MatHeaderMerge(A, &C));
1768   }
1769   PetscFunctionReturn(PETSC_SUCCESS);
1770 }
1771 
1772 static PetscErrorCode MatIsTranspose_SeqBAIJ(Mat A, Mat B, PetscReal tol, PetscBool *f)
1773 {
1774   Mat Btrans;
1775 
1776   PetscFunctionBegin;
1777   *f = PETSC_FALSE;
1778   PetscCall(MatTranspose(A, MAT_INITIAL_MATRIX, &Btrans));
1779   PetscCall(MatEqual_SeqBAIJ(B, Btrans, f));
1780   PetscCall(MatDestroy(&Btrans));
1781   PetscFunctionReturn(PETSC_SUCCESS);
1782 }
1783 
1784 /* Used for both SeqBAIJ and SeqSBAIJ matrices */
1785 PetscErrorCode MatView_SeqBAIJ_Binary(Mat mat, PetscViewer viewer)
1786 {
1787   Mat_SeqBAIJ *A = (Mat_SeqBAIJ *)mat->data;
1788   PetscInt     header[4], M, N, m, bs, nz, cnt, i, j, k, l;
1789   PetscInt    *rowlens, *colidxs;
1790   PetscScalar *matvals;
1791 
1792   PetscFunctionBegin;
1793   PetscCall(PetscViewerSetUp(viewer));
1794 
1795   M  = mat->rmap->N;
1796   N  = mat->cmap->N;
1797   m  = mat->rmap->n;
1798   bs = mat->rmap->bs;
1799   nz = bs * bs * A->nz;
1800 
1801   /* write matrix header */
1802   header[0] = MAT_FILE_CLASSID;
1803   header[1] = M;
1804   header[2] = N;
1805   header[3] = nz;
1806   PetscCall(PetscViewerBinaryWrite(viewer, header, 4, PETSC_INT));
1807 
1808   /* store row lengths */
1809   PetscCall(PetscMalloc1(m, &rowlens));
1810   for (cnt = 0, i = 0; i < A->mbs; i++)
1811     for (j = 0; j < bs; j++) rowlens[cnt++] = bs * (A->i[i + 1] - A->i[i]);
1812   PetscCall(PetscViewerBinaryWrite(viewer, rowlens, m, PETSC_INT));
1813   PetscCall(PetscFree(rowlens));
1814 
1815   /* store column indices  */
1816   PetscCall(PetscMalloc1(nz, &colidxs));
1817   for (cnt = 0, i = 0; i < A->mbs; i++)
1818     for (k = 0; k < bs; k++)
1819       for (j = A->i[i]; j < A->i[i + 1]; j++)
1820         for (l = 0; l < bs; l++) colidxs[cnt++] = bs * A->j[j] + l;
1821   PetscCheck(cnt == nz, PETSC_COMM_SELF, PETSC_ERR_LIB, "Internal PETSc error: cnt = %" PetscInt_FMT " nz = %" PetscInt_FMT, cnt, nz);
1822   PetscCall(PetscViewerBinaryWrite(viewer, colidxs, nz, PETSC_INT));
1823   PetscCall(PetscFree(colidxs));
1824 
1825   /* store nonzero values */
1826   PetscCall(PetscMalloc1(nz, &matvals));
1827   for (cnt = 0, i = 0; i < A->mbs; i++)
1828     for (k = 0; k < bs; k++)
1829       for (j = A->i[i]; j < A->i[i + 1]; j++)
1830         for (l = 0; l < bs; l++) matvals[cnt++] = A->a[bs * (bs * j + l) + k];
1831   PetscCheck(cnt == nz, PETSC_COMM_SELF, PETSC_ERR_LIB, "Internal PETSc error: cnt = %" PetscInt_FMT " nz = %" PetscInt_FMT, cnt, nz);
1832   PetscCall(PetscViewerBinaryWrite(viewer, matvals, nz, PETSC_SCALAR));
1833   PetscCall(PetscFree(matvals));
1834 
1835   /* write block size option to the viewer's .info file */
1836   PetscCall(MatView_Binary_BlockSizes(mat, viewer));
1837   PetscFunctionReturn(PETSC_SUCCESS);
1838 }
1839 
1840 static PetscErrorCode MatView_SeqBAIJ_ASCII_structonly(Mat A, PetscViewer viewer)
1841 {
1842   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
1843   PetscInt     i, bs = A->rmap->bs, k;
1844 
1845   PetscFunctionBegin;
1846   PetscCall(PetscViewerASCIIUseTabs(viewer, PETSC_FALSE));
1847   for (i = 0; i < a->mbs; i++) {
1848     PetscCall(PetscViewerASCIIPrintf(viewer, "row %" PetscInt_FMT "-%" PetscInt_FMT ":", i * bs, i * bs + bs - 1));
1849     for (k = a->i[i]; k < a->i[i + 1]; k++) PetscCall(PetscViewerASCIIPrintf(viewer, " (%" PetscInt_FMT "-%" PetscInt_FMT ") ", bs * a->j[k], bs * a->j[k] + bs - 1));
1850     PetscCall(PetscViewerASCIIPrintf(viewer, "\n"));
1851   }
1852   PetscCall(PetscViewerASCIIUseTabs(viewer, PETSC_TRUE));
1853   PetscFunctionReturn(PETSC_SUCCESS);
1854 }
1855 
1856 static PetscErrorCode MatView_SeqBAIJ_ASCII(Mat A, PetscViewer viewer)
1857 {
1858   Mat_SeqBAIJ      *a = (Mat_SeqBAIJ *)A->data;
1859   PetscInt          i, j, bs = A->rmap->bs, k, l, bs2 = a->bs2;
1860   PetscViewerFormat format;
1861 
1862   PetscFunctionBegin;
1863   if (A->structure_only) {
1864     PetscCall(MatView_SeqBAIJ_ASCII_structonly(A, viewer));
1865     PetscFunctionReturn(PETSC_SUCCESS);
1866   }
1867 
1868   PetscCall(PetscViewerGetFormat(viewer, &format));
1869   if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
1870     PetscCall(PetscViewerASCIIPrintf(viewer, "  block size is %" PetscInt_FMT "\n", bs));
1871   } else if (format == PETSC_VIEWER_ASCII_MATLAB) {
1872     const char *matname;
1873     Mat         aij;
1874     PetscCall(MatConvert(A, MATSEQAIJ, MAT_INITIAL_MATRIX, &aij));
1875     PetscCall(PetscObjectGetName((PetscObject)A, &matname));
1876     PetscCall(PetscObjectSetName((PetscObject)aij, matname));
1877     PetscCall(MatView(aij, viewer));
1878     PetscCall(MatDestroy(&aij));
1879   } else if (format == PETSC_VIEWER_ASCII_FACTOR_INFO) {
1880     PetscFunctionReturn(PETSC_SUCCESS);
1881   } else if (format == PETSC_VIEWER_ASCII_COMMON) {
1882     PetscCall(PetscViewerASCIIUseTabs(viewer, PETSC_FALSE));
1883     for (i = 0; i < a->mbs; i++) {
1884       for (j = 0; j < bs; j++) {
1885         PetscCall(PetscViewerASCIIPrintf(viewer, "row %" PetscInt_FMT ":", i * bs + j));
1886         for (k = a->i[i]; k < a->i[i + 1]; k++) {
1887           for (l = 0; l < bs; l++) {
1888 #if defined(PETSC_USE_COMPLEX)
1889             if (PetscImaginaryPart(a->a[bs2 * k + l * bs + j]) > 0.0 && PetscRealPart(a->a[bs2 * k + l * bs + j]) != 0.0) {
1890               PetscCall(PetscViewerASCIIPrintf(viewer, " (%" PetscInt_FMT ", %g + %gi) ", bs * a->j[k] + l, (double)PetscRealPart(a->a[bs2 * k + l * bs + j]), (double)PetscImaginaryPart(a->a[bs2 * k + l * bs + j])));
1891             } else if (PetscImaginaryPart(a->a[bs2 * k + l * bs + j]) < 0.0 && PetscRealPart(a->a[bs2 * k + l * bs + j]) != 0.0) {
1892               PetscCall(PetscViewerASCIIPrintf(viewer, " (%" PetscInt_FMT ", %g - %gi) ", bs * a->j[k] + l, (double)PetscRealPart(a->a[bs2 * k + l * bs + j]), -(double)PetscImaginaryPart(a->a[bs2 * k + l * bs + j])));
1893             } else if (PetscRealPart(a->a[bs2 * k + l * bs + j]) != 0.0) {
1894               PetscCall(PetscViewerASCIIPrintf(viewer, " (%" PetscInt_FMT ", %g) ", bs * a->j[k] + l, (double)PetscRealPart(a->a[bs2 * k + l * bs + j])));
1895             }
1896 #else
1897             if (a->a[bs2 * k + l * bs + j] != 0.0) PetscCall(PetscViewerASCIIPrintf(viewer, " (%" PetscInt_FMT ", %g) ", bs * a->j[k] + l, (double)a->a[bs2 * k + l * bs + j]));
1898 #endif
1899           }
1900         }
1901         PetscCall(PetscViewerASCIIPrintf(viewer, "\n"));
1902       }
1903     }
1904     PetscCall(PetscViewerASCIIUseTabs(viewer, PETSC_TRUE));
1905   } else {
1906     PetscCall(PetscViewerASCIIUseTabs(viewer, PETSC_FALSE));
1907     for (i = 0; i < a->mbs; i++) {
1908       for (j = 0; j < bs; j++) {
1909         PetscCall(PetscViewerASCIIPrintf(viewer, "row %" PetscInt_FMT ":", i * bs + j));
1910         for (k = a->i[i]; k < a->i[i + 1]; k++) {
1911           for (l = 0; l < bs; l++) {
1912 #if defined(PETSC_USE_COMPLEX)
1913             if (PetscImaginaryPart(a->a[bs2 * k + l * bs + j]) > 0.0) {
1914               PetscCall(PetscViewerASCIIPrintf(viewer, " (%" PetscInt_FMT ", %g + %g i) ", bs * a->j[k] + l, (double)PetscRealPart(a->a[bs2 * k + l * bs + j]), (double)PetscImaginaryPart(a->a[bs2 * k + l * bs + j])));
1915             } else if (PetscImaginaryPart(a->a[bs2 * k + l * bs + j]) < 0.0) {
1916               PetscCall(PetscViewerASCIIPrintf(viewer, " (%" PetscInt_FMT ", %g - %g i) ", bs * a->j[k] + l, (double)PetscRealPart(a->a[bs2 * k + l * bs + j]), -(double)PetscImaginaryPart(a->a[bs2 * k + l * bs + j])));
1917             } else {
1918               PetscCall(PetscViewerASCIIPrintf(viewer, " (%" PetscInt_FMT ", %g) ", bs * a->j[k] + l, (double)PetscRealPart(a->a[bs2 * k + l * bs + j])));
1919             }
1920 #else
1921             PetscCall(PetscViewerASCIIPrintf(viewer, " (%" PetscInt_FMT ", %g) ", bs * a->j[k] + l, (double)a->a[bs2 * k + l * bs + j]));
1922 #endif
1923           }
1924         }
1925         PetscCall(PetscViewerASCIIPrintf(viewer, "\n"));
1926       }
1927     }
1928     PetscCall(PetscViewerASCIIUseTabs(viewer, PETSC_TRUE));
1929   }
1930   PetscCall(PetscViewerFlush(viewer));
1931   PetscFunctionReturn(PETSC_SUCCESS);
1932 }
1933 
1934 #include <petscdraw.h>
1935 static PetscErrorCode MatView_SeqBAIJ_Draw_Zoom(PetscDraw draw, void *Aa)
1936 {
1937   Mat               A = (Mat)Aa;
1938   Mat_SeqBAIJ      *a = (Mat_SeqBAIJ *)A->data;
1939   PetscInt          row, i, j, k, l, mbs = a->mbs, color, bs = A->rmap->bs, bs2 = a->bs2;
1940   PetscReal         xl, yl, xr, yr, x_l, x_r, y_l, y_r;
1941   MatScalar        *aa;
1942   PetscViewer       viewer;
1943   PetscViewerFormat format;
1944 
1945   PetscFunctionBegin;
1946   PetscCall(PetscObjectQuery((PetscObject)A, "Zoomviewer", (PetscObject *)&viewer));
1947   PetscCall(PetscViewerGetFormat(viewer, &format));
1948   PetscCall(PetscDrawGetCoordinates(draw, &xl, &yl, &xr, &yr));
1949 
1950   /* loop over matrix elements drawing boxes */
1951 
1952   if (format != PETSC_VIEWER_DRAW_CONTOUR) {
1953     PetscDrawCollectiveBegin(draw);
1954     /* Blue for negative, Cyan for zero and  Red for positive */
1955     color = PETSC_DRAW_BLUE;
1956     for (i = 0, row = 0; i < mbs; i++, row += bs) {
1957       for (j = a->i[i]; j < a->i[i + 1]; j++) {
1958         y_l = A->rmap->N - row - 1.0;
1959         y_r = y_l + 1.0;
1960         x_l = a->j[j] * bs;
1961         x_r = x_l + 1.0;
1962         aa  = a->a + j * bs2;
1963         for (k = 0; k < bs; k++) {
1964           for (l = 0; l < bs; l++) {
1965             if (PetscRealPart(*aa++) >= 0.) continue;
1966             PetscCall(PetscDrawRectangle(draw, x_l + k, y_l - l, x_r + k, y_r - l, color, color, color, color));
1967           }
1968         }
1969       }
1970     }
1971     color = PETSC_DRAW_CYAN;
1972     for (i = 0, row = 0; i < mbs; i++, row += bs) {
1973       for (j = a->i[i]; j < a->i[i + 1]; j++) {
1974         y_l = A->rmap->N - row - 1.0;
1975         y_r = y_l + 1.0;
1976         x_l = a->j[j] * bs;
1977         x_r = x_l + 1.0;
1978         aa  = a->a + j * bs2;
1979         for (k = 0; k < bs; k++) {
1980           for (l = 0; l < bs; l++) {
1981             if (PetscRealPart(*aa++) != 0.) continue;
1982             PetscCall(PetscDrawRectangle(draw, x_l + k, y_l - l, x_r + k, y_r - l, color, color, color, color));
1983           }
1984         }
1985       }
1986     }
1987     color = PETSC_DRAW_RED;
1988     for (i = 0, row = 0; i < mbs; i++, row += bs) {
1989       for (j = a->i[i]; j < a->i[i + 1]; j++) {
1990         y_l = A->rmap->N - row - 1.0;
1991         y_r = y_l + 1.0;
1992         x_l = a->j[j] * bs;
1993         x_r = x_l + 1.0;
1994         aa  = a->a + j * bs2;
1995         for (k = 0; k < bs; k++) {
1996           for (l = 0; l < bs; l++) {
1997             if (PetscRealPart(*aa++) <= 0.) continue;
1998             PetscCall(PetscDrawRectangle(draw, x_l + k, y_l - l, x_r + k, y_r - l, color, color, color, color));
1999           }
2000         }
2001       }
2002     }
2003     PetscDrawCollectiveEnd(draw);
2004   } else {
2005     /* use contour shading to indicate magnitude of values */
2006     /* first determine max of all nonzero values */
2007     PetscReal minv = 0.0, maxv = 0.0;
2008     PetscDraw popup;
2009 
2010     for (i = 0; i < a->nz * a->bs2; i++) {
2011       if (PetscAbsScalar(a->a[i]) > maxv) maxv = PetscAbsScalar(a->a[i]);
2012     }
2013     if (minv >= maxv) maxv = minv + PETSC_SMALL;
2014     PetscCall(PetscDrawGetPopup(draw, &popup));
2015     PetscCall(PetscDrawScalePopup(popup, 0.0, maxv));
2016 
2017     PetscDrawCollectiveBegin(draw);
2018     for (i = 0, row = 0; i < mbs; i++, row += bs) {
2019       for (j = a->i[i]; j < a->i[i + 1]; j++) {
2020         y_l = A->rmap->N - row - 1.0;
2021         y_r = y_l + 1.0;
2022         x_l = a->j[j] * bs;
2023         x_r = x_l + 1.0;
2024         aa  = a->a + j * bs2;
2025         for (k = 0; k < bs; k++) {
2026           for (l = 0; l < bs; l++) {
2027             MatScalar v = *aa++;
2028             color       = PetscDrawRealToColor(PetscAbsScalar(v), minv, maxv);
2029             PetscCall(PetscDrawRectangle(draw, x_l + k, y_l - l, x_r + k, y_r - l, color, color, color, color));
2030           }
2031         }
2032       }
2033     }
2034     PetscDrawCollectiveEnd(draw);
2035   }
2036   PetscFunctionReturn(PETSC_SUCCESS);
2037 }
2038 
2039 static PetscErrorCode MatView_SeqBAIJ_Draw(Mat A, PetscViewer viewer)
2040 {
2041   PetscReal xl, yl, xr, yr, w, h;
2042   PetscDraw draw;
2043   PetscBool isnull;
2044 
2045   PetscFunctionBegin;
2046   PetscCall(PetscViewerDrawGetDraw(viewer, 0, &draw));
2047   PetscCall(PetscDrawIsNull(draw, &isnull));
2048   if (isnull) PetscFunctionReturn(PETSC_SUCCESS);
2049 
2050   xr = A->cmap->n;
2051   yr = A->rmap->N;
2052   h  = yr / 10.0;
2053   w  = xr / 10.0;
2054   xr += w;
2055   yr += h;
2056   xl = -w;
2057   yl = -h;
2058   PetscCall(PetscDrawSetCoordinates(draw, xl, yl, xr, yr));
2059   PetscCall(PetscObjectCompose((PetscObject)A, "Zoomviewer", (PetscObject)viewer));
2060   PetscCall(PetscDrawZoom(draw, MatView_SeqBAIJ_Draw_Zoom, A));
2061   PetscCall(PetscObjectCompose((PetscObject)A, "Zoomviewer", NULL));
2062   PetscCall(PetscDrawSave(draw));
2063   PetscFunctionReturn(PETSC_SUCCESS);
2064 }
2065 
2066 PetscErrorCode MatView_SeqBAIJ(Mat A, PetscViewer viewer)
2067 {
2068   PetscBool iascii, isbinary, isdraw;
2069 
2070   PetscFunctionBegin;
2071   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii));
2072   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERBINARY, &isbinary));
2073   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERDRAW, &isdraw));
2074   if (iascii) {
2075     PetscCall(MatView_SeqBAIJ_ASCII(A, viewer));
2076   } else if (isbinary) {
2077     PetscCall(MatView_SeqBAIJ_Binary(A, viewer));
2078   } else if (isdraw) {
2079     PetscCall(MatView_SeqBAIJ_Draw(A, viewer));
2080   } else {
2081     Mat B;
2082     PetscCall(MatConvert(A, MATSEQAIJ, MAT_INITIAL_MATRIX, &B));
2083     PetscCall(MatView(B, viewer));
2084     PetscCall(MatDestroy(&B));
2085   }
2086   PetscFunctionReturn(PETSC_SUCCESS);
2087 }
2088 
2089 PetscErrorCode MatGetValues_SeqBAIJ(Mat A, PetscInt m, const PetscInt im[], PetscInt n, const PetscInt in[], PetscScalar v[])
2090 {
2091   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
2092   PetscInt    *rp, k, low, high, t, row, nrow, i, col, l, *aj = a->j;
2093   PetscInt    *ai = a->i, *ailen = a->ilen;
2094   PetscInt     brow, bcol, ridx, cidx, bs = A->rmap->bs, bs2 = a->bs2;
2095   MatScalar   *ap, *aa = a->a;
2096 
2097   PetscFunctionBegin;
2098   for (k = 0; k < m; k++) { /* loop over rows */
2099     row  = im[k];
2100     brow = row / bs;
2101     if (row < 0) {
2102       v += n;
2103       continue;
2104     } /* negative row */
2105     PetscCheck(row < A->rmap->N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Row %" PetscInt_FMT " too large", row);
2106     rp   = PetscSafePointerPlusOffset(aj, ai[brow]);
2107     ap   = PetscSafePointerPlusOffset(aa, bs2 * ai[brow]);
2108     nrow = ailen[brow];
2109     for (l = 0; l < n; l++) { /* loop over columns */
2110       if (in[l] < 0) {
2111         v++;
2112         continue;
2113       } /* negative column */
2114       PetscCheck(in[l] < A->cmap->n, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Column %" PetscInt_FMT " too large", in[l]);
2115       col  = in[l];
2116       bcol = col / bs;
2117       cidx = col % bs;
2118       ridx = row % bs;
2119       high = nrow;
2120       low  = 0; /* assume unsorted */
2121       while (high - low > 5) {
2122         t = (low + high) / 2;
2123         if (rp[t] > bcol) high = t;
2124         else low = t;
2125       }
2126       for (i = low; i < high; i++) {
2127         if (rp[i] > bcol) break;
2128         if (rp[i] == bcol) {
2129           *v++ = ap[bs2 * i + bs * cidx + ridx];
2130           goto finished;
2131         }
2132       }
2133       *v++ = 0.0;
2134     finished:;
2135     }
2136   }
2137   PetscFunctionReturn(PETSC_SUCCESS);
2138 }
2139 
2140 PetscErrorCode MatSetValuesBlocked_SeqBAIJ(Mat A, PetscInt m, const PetscInt im[], PetscInt n, const PetscInt in[], const PetscScalar v[], InsertMode is)
2141 {
2142   Mat_SeqBAIJ       *a = (Mat_SeqBAIJ *)A->data;
2143   PetscInt          *rp, k, low, high, t, ii, jj, row, nrow, i, col, l, rmax, N, lastcol = -1;
2144   PetscInt          *imax = a->imax, *ai = a->i, *ailen = a->ilen;
2145   PetscInt          *aj = a->j, nonew = a->nonew, bs2 = a->bs2, bs = A->rmap->bs, stepval;
2146   PetscBool          roworiented = a->roworiented;
2147   const PetscScalar *value       = v;
2148   MatScalar         *ap = NULL, *aa = a->a, *bap;
2149 
2150   PetscFunctionBegin;
2151   if (roworiented) {
2152     stepval = (n - 1) * bs;
2153   } else {
2154     stepval = (m - 1) * bs;
2155   }
2156   for (k = 0; k < m; k++) { /* loop over added rows */
2157     row = im[k];
2158     if (row < 0) continue;
2159     PetscCheck(row < a->mbs, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Block row index too large %" PetscInt_FMT " max %" PetscInt_FMT, row, a->mbs - 1);
2160     rp = aj + ai[row];
2161     if (!A->structure_only) ap = aa + bs2 * ai[row];
2162     rmax = imax[row];
2163     nrow = ailen[row];
2164     low  = 0;
2165     high = nrow;
2166     for (l = 0; l < n; l++) { /* loop over added columns */
2167       if (in[l] < 0) continue;
2168       PetscCheck(in[l] < a->nbs, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Block column index too large %" PetscInt_FMT " max %" PetscInt_FMT, in[l], a->nbs - 1);
2169       col = in[l];
2170       if (!A->structure_only) {
2171         if (roworiented) {
2172           value = v + (k * (stepval + bs) + l) * bs;
2173         } else {
2174           value = v + (l * (stepval + bs) + k) * bs;
2175         }
2176       }
2177       if (col <= lastcol) low = 0;
2178       else high = nrow;
2179       lastcol = col;
2180       while (high - low > 7) {
2181         t = (low + high) / 2;
2182         if (rp[t] > col) high = t;
2183         else low = t;
2184       }
2185       for (i = low; i < high; i++) {
2186         if (rp[i] > col) break;
2187         if (rp[i] == col) {
2188           if (A->structure_only) goto noinsert2;
2189           bap = ap + bs2 * i;
2190           if (roworiented) {
2191             if (is == ADD_VALUES) {
2192               for (ii = 0; ii < bs; ii++, value += stepval) {
2193                 for (jj = ii; jj < bs2; jj += bs) bap[jj] += *value++;
2194               }
2195             } else {
2196               for (ii = 0; ii < bs; ii++, value += stepval) {
2197                 for (jj = ii; jj < bs2; jj += bs) bap[jj] = *value++;
2198               }
2199             }
2200           } else {
2201             if (is == ADD_VALUES) {
2202               for (ii = 0; ii < bs; ii++, value += bs + stepval) {
2203                 for (jj = 0; jj < bs; jj++) bap[jj] += value[jj];
2204                 bap += bs;
2205               }
2206             } else {
2207               for (ii = 0; ii < bs; ii++, value += bs + stepval) {
2208                 for (jj = 0; jj < bs; jj++) bap[jj] = value[jj];
2209                 bap += bs;
2210               }
2211             }
2212           }
2213           goto noinsert2;
2214         }
2215       }
2216       if (nonew == 1) goto noinsert2;
2217       PetscCheck(nonew != -1, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Inserting a new blocked index new nonzero block (%" PetscInt_FMT ", %" PetscInt_FMT ") in the matrix", row, col);
2218       if (A->structure_only) {
2219         MatSeqXAIJReallocateAIJ_structure_only(A, a->mbs, bs2, nrow, row, col, rmax, ai, aj, rp, imax, nonew, MatScalar);
2220       } else {
2221         MatSeqXAIJReallocateAIJ(A, a->mbs, bs2, nrow, row, col, rmax, aa, ai, aj, rp, ap, imax, nonew, MatScalar);
2222       }
2223       N = nrow++ - 1;
2224       high++;
2225       /* shift up all the later entries in this row */
2226       PetscCall(PetscArraymove(rp + i + 1, rp + i, N - i + 1));
2227       rp[i] = col;
2228       if (!A->structure_only) {
2229         PetscCall(PetscArraymove(ap + bs2 * (i + 1), ap + bs2 * i, bs2 * (N - i + 1)));
2230         bap = ap + bs2 * i;
2231         if (roworiented) {
2232           for (ii = 0; ii < bs; ii++, value += stepval) {
2233             for (jj = ii; jj < bs2; jj += bs) bap[jj] = *value++;
2234           }
2235         } else {
2236           for (ii = 0; ii < bs; ii++, value += stepval) {
2237             for (jj = 0; jj < bs; jj++) *bap++ = *value++;
2238           }
2239         }
2240       }
2241     noinsert2:;
2242       low = i;
2243     }
2244     ailen[row] = nrow;
2245   }
2246   PetscFunctionReturn(PETSC_SUCCESS);
2247 }
2248 
2249 PetscErrorCode MatAssemblyEnd_SeqBAIJ(Mat A, MatAssemblyType mode)
2250 {
2251   Mat_SeqBAIJ *a      = (Mat_SeqBAIJ *)A->data;
2252   PetscInt     fshift = 0, i, *ai = a->i, *aj = a->j, *imax = a->imax;
2253   PetscInt     m = A->rmap->N, *ip, N, *ailen = a->ilen;
2254   PetscInt     mbs = a->mbs, bs2 = a->bs2, rmax = 0;
2255   MatScalar   *aa    = a->a, *ap;
2256   PetscReal    ratio = 0.6;
2257 
2258   PetscFunctionBegin;
2259   if (mode == MAT_FLUSH_ASSEMBLY || (A->was_assembled && A->ass_nonzerostate == A->nonzerostate)) PetscFunctionReturn(PETSC_SUCCESS);
2260 
2261   if (m) rmax = ailen[0];
2262   for (i = 1; i < mbs; i++) {
2263     /* move each row back by the amount of empty slots (fshift) before it*/
2264     fshift += imax[i - 1] - ailen[i - 1];
2265     rmax = PetscMax(rmax, ailen[i]);
2266     if (fshift) {
2267       ip = aj + ai[i];
2268       ap = aa + bs2 * ai[i];
2269       N  = ailen[i];
2270       PetscCall(PetscArraymove(ip - fshift, ip, N));
2271       if (!A->structure_only) PetscCall(PetscArraymove(ap - bs2 * fshift, ap, bs2 * N));
2272     }
2273     ai[i] = ai[i - 1] + ailen[i - 1];
2274   }
2275   if (mbs) {
2276     fshift += imax[mbs - 1] - ailen[mbs - 1];
2277     ai[mbs] = ai[mbs - 1] + ailen[mbs - 1];
2278   }
2279 
2280   /* reset ilen and imax for each row */
2281   a->nonzerorowcnt = 0;
2282   if (A->structure_only) {
2283     PetscCall(PetscFree2(a->imax, a->ilen));
2284   } else { /* !A->structure_only */
2285     for (i = 0; i < mbs; i++) {
2286       ailen[i] = imax[i] = ai[i + 1] - ai[i];
2287       a->nonzerorowcnt += ((ai[i + 1] - ai[i]) > 0);
2288     }
2289   }
2290   a->nz = ai[mbs];
2291 
2292   /* diagonals may have moved, so kill the diagonal pointers */
2293   a->idiagvalid = PETSC_FALSE;
2294   if (fshift && a->diag) PetscCall(PetscFree(a->diag));
2295   if (fshift) PetscCheck(a->nounused != -1, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unused space detected in matrix: %" PetscInt_FMT " X %" PetscInt_FMT " block size %" PetscInt_FMT ", %" PetscInt_FMT " unneeded", m, A->cmap->n, A->rmap->bs, fshift * bs2);
2296   PetscCall(PetscInfo(A, "Matrix size: %" PetscInt_FMT " X %" PetscInt_FMT ", block size %" PetscInt_FMT "; storage space: %" PetscInt_FMT " unneeded, %" PetscInt_FMT " used\n", m, A->cmap->n, A->rmap->bs, fshift * bs2, a->nz * bs2));
2297   PetscCall(PetscInfo(A, "Number of mallocs during MatSetValues is %" PetscInt_FMT "\n", a->reallocs));
2298   PetscCall(PetscInfo(A, "Most nonzeros blocks in any row is %" PetscInt_FMT "\n", rmax));
2299 
2300   A->info.mallocs += a->reallocs;
2301   a->reallocs         = 0;
2302   A->info.nz_unneeded = (PetscReal)fshift * bs2;
2303   a->rmax             = rmax;
2304 
2305   if (!A->structure_only) PetscCall(MatCheckCompressedRow(A, a->nonzerorowcnt, &a->compressedrow, a->i, mbs, ratio));
2306   PetscFunctionReturn(PETSC_SUCCESS);
2307 }
2308 
2309 /*
2310    This function returns an array of flags which indicate the locations of contiguous
2311    blocks that should be zeroed. for eg: if bs = 3  and is = [0,1,2,3,5,6,7,8,9]
2312    then the resulting sizes = [3,1,1,3,1] corresponding to sets [(0,1,2),(3),(5),(6,7,8),(9)]
2313    Assume: sizes should be long enough to hold all the values.
2314 */
2315 static PetscErrorCode MatZeroRows_SeqBAIJ_Check_Blocks(PetscInt idx[], PetscInt n, PetscInt bs, PetscInt sizes[], PetscInt *bs_max)
2316 {
2317   PetscInt j = 0;
2318 
2319   PetscFunctionBegin;
2320   for (PetscInt i = 0; i < n; j++) {
2321     PetscInt row = idx[i];
2322     if (row % bs != 0) { /* Not the beginning of a block */
2323       sizes[j] = 1;
2324       i++;
2325     } else if (i + bs > n) { /* complete block doesn't exist (at idx end) */
2326       sizes[j] = 1;          /* Also makes sure at least 'bs' values exist for next else */
2327       i++;
2328     } else { /* Beginning of the block, so check if the complete block exists */
2329       PetscBool flg = PETSC_TRUE;
2330       for (PetscInt k = 1; k < bs; k++) {
2331         if (row + k != idx[i + k]) { /* break in the block */
2332           flg = PETSC_FALSE;
2333           break;
2334         }
2335       }
2336       if (flg) { /* No break in the bs */
2337         sizes[j] = bs;
2338         i += bs;
2339       } else {
2340         sizes[j] = 1;
2341         i++;
2342       }
2343     }
2344   }
2345   *bs_max = j;
2346   PetscFunctionReturn(PETSC_SUCCESS);
2347 }
2348 
2349 PetscErrorCode MatZeroRows_SeqBAIJ(Mat A, PetscInt is_n, const PetscInt is_idx[], PetscScalar diag, Vec x, Vec b)
2350 {
2351   Mat_SeqBAIJ       *baij = (Mat_SeqBAIJ *)A->data;
2352   PetscInt           i, j, k, count, *rows;
2353   PetscInt           bs = A->rmap->bs, bs2 = baij->bs2, *sizes, row, bs_max;
2354   PetscScalar        zero = 0.0;
2355   MatScalar         *aa;
2356   const PetscScalar *xx;
2357   PetscScalar       *bb;
2358 
2359   PetscFunctionBegin;
2360   /* fix right-hand side if needed */
2361   if (x && b) {
2362     PetscCall(VecGetArrayRead(x, &xx));
2363     PetscCall(VecGetArray(b, &bb));
2364     for (i = 0; i < is_n; i++) bb[is_idx[i]] = diag * xx[is_idx[i]];
2365     PetscCall(VecRestoreArrayRead(x, &xx));
2366     PetscCall(VecRestoreArray(b, &bb));
2367   }
2368 
2369   /* Make a copy of the IS and  sort it */
2370   /* allocate memory for rows,sizes */
2371   PetscCall(PetscMalloc2(is_n, &rows, 2 * is_n, &sizes));
2372 
2373   /* copy IS values to rows, and sort them */
2374   for (i = 0; i < is_n; i++) rows[i] = is_idx[i];
2375   PetscCall(PetscSortInt(is_n, rows));
2376 
2377   if (baij->keepnonzeropattern) {
2378     for (i = 0; i < is_n; i++) sizes[i] = 1;
2379     bs_max = is_n;
2380   } else {
2381     PetscCall(MatZeroRows_SeqBAIJ_Check_Blocks(rows, is_n, bs, sizes, &bs_max));
2382     A->nonzerostate++;
2383   }
2384 
2385   for (i = 0, j = 0; i < bs_max; j += sizes[i], i++) {
2386     row = rows[j];
2387     PetscCheck(row >= 0 && row <= A->rmap->N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "row %" PetscInt_FMT " out of range", row);
2388     count = (baij->i[row / bs + 1] - baij->i[row / bs]) * bs;
2389     aa    = ((MatScalar *)baij->a) + baij->i[row / bs] * bs2 + (row % bs);
2390     if (sizes[i] == bs && !baij->keepnonzeropattern) {
2391       if (diag != (PetscScalar)0.0) {
2392         if (baij->ilen[row / bs] > 0) {
2393           baij->ilen[row / bs]       = 1;
2394           baij->j[baij->i[row / bs]] = row / bs;
2395 
2396           PetscCall(PetscArrayzero(aa, count * bs));
2397         }
2398         /* Now insert all the diagonal values for this bs */
2399         for (k = 0; k < bs; k++) PetscUseTypeMethod(A, setvalues, 1, rows + j + k, 1, rows + j + k, &diag, INSERT_VALUES);
2400       } else { /* (diag == 0.0) */
2401         baij->ilen[row / bs] = 0;
2402       } /* end (diag == 0.0) */
2403     } else { /* (sizes[i] != bs) */
2404       PetscAssert(sizes[i] == 1, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Internal Error. Value should be 1");
2405       for (k = 0; k < count; k++) {
2406         aa[0] = zero;
2407         aa += bs;
2408       }
2409       if (diag != (PetscScalar)0.0) PetscUseTypeMethod(A, setvalues, 1, rows + j, 1, rows + j, &diag, INSERT_VALUES);
2410     }
2411   }
2412 
2413   PetscCall(PetscFree2(rows, sizes));
2414   PetscCall(MatAssemblyEnd_SeqBAIJ(A, MAT_FINAL_ASSEMBLY));
2415   PetscFunctionReturn(PETSC_SUCCESS);
2416 }
2417 
2418 static PetscErrorCode MatZeroRowsColumns_SeqBAIJ(Mat A, PetscInt is_n, const PetscInt is_idx[], PetscScalar diag, Vec x, Vec b)
2419 {
2420   Mat_SeqBAIJ       *baij = (Mat_SeqBAIJ *)A->data;
2421   PetscInt           i, j, k, count;
2422   PetscInt           bs = A->rmap->bs, bs2 = baij->bs2, row, col;
2423   PetscScalar        zero = 0.0;
2424   MatScalar         *aa;
2425   const PetscScalar *xx;
2426   PetscScalar       *bb;
2427   PetscBool         *zeroed, vecs = PETSC_FALSE;
2428 
2429   PetscFunctionBegin;
2430   /* fix right-hand side if needed */
2431   if (x && b) {
2432     PetscCall(VecGetArrayRead(x, &xx));
2433     PetscCall(VecGetArray(b, &bb));
2434     vecs = PETSC_TRUE;
2435   }
2436 
2437   /* zero the columns */
2438   PetscCall(PetscCalloc1(A->rmap->n, &zeroed));
2439   for (i = 0; i < is_n; i++) {
2440     PetscCheck(is_idx[i] >= 0 && is_idx[i] < A->rmap->N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "row %" PetscInt_FMT " out of range", is_idx[i]);
2441     zeroed[is_idx[i]] = PETSC_TRUE;
2442   }
2443   for (i = 0; i < A->rmap->N; i++) {
2444     if (!zeroed[i]) {
2445       row = i / bs;
2446       for (j = baij->i[row]; j < baij->i[row + 1]; j++) {
2447         for (k = 0; k < bs; k++) {
2448           col = bs * baij->j[j] + k;
2449           if (zeroed[col]) {
2450             aa = ((MatScalar *)baij->a) + j * bs2 + (i % bs) + bs * k;
2451             if (vecs) bb[i] -= aa[0] * xx[col];
2452             aa[0] = 0.0;
2453           }
2454         }
2455       }
2456     } else if (vecs) bb[i] = diag * xx[i];
2457   }
2458   PetscCall(PetscFree(zeroed));
2459   if (vecs) {
2460     PetscCall(VecRestoreArrayRead(x, &xx));
2461     PetscCall(VecRestoreArray(b, &bb));
2462   }
2463 
2464   /* zero the rows */
2465   for (i = 0; i < is_n; i++) {
2466     row   = is_idx[i];
2467     count = (baij->i[row / bs + 1] - baij->i[row / bs]) * bs;
2468     aa    = ((MatScalar *)baij->a) + baij->i[row / bs] * bs2 + (row % bs);
2469     for (k = 0; k < count; k++) {
2470       aa[0] = zero;
2471       aa += bs;
2472     }
2473     if (diag != (PetscScalar)0.0) PetscUseTypeMethod(A, setvalues, 1, &row, 1, &row, &diag, INSERT_VALUES);
2474   }
2475   PetscCall(MatAssemblyEnd_SeqBAIJ(A, MAT_FINAL_ASSEMBLY));
2476   PetscFunctionReturn(PETSC_SUCCESS);
2477 }
2478 
2479 PetscErrorCode MatSetValues_SeqBAIJ(Mat A, PetscInt m, const PetscInt im[], PetscInt n, const PetscInt in[], const PetscScalar v[], InsertMode is)
2480 {
2481   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
2482   PetscInt    *rp, k, low, high, t, ii, row, nrow, i, col, l, rmax, N, lastcol = -1;
2483   PetscInt    *imax = a->imax, *ai = a->i, *ailen = a->ilen;
2484   PetscInt    *aj = a->j, nonew = a->nonew, bs = A->rmap->bs, brow, bcol;
2485   PetscInt     ridx, cidx, bs2                 = a->bs2;
2486   PetscBool    roworiented = a->roworiented;
2487   MatScalar   *ap = NULL, value = 0.0, *aa = a->a, *bap;
2488 
2489   PetscFunctionBegin;
2490   for (k = 0; k < m; k++) { /* loop over added rows */
2491     row  = im[k];
2492     brow = row / bs;
2493     if (row < 0) continue;
2494     PetscCheck(row < A->rmap->N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Row too large: row %" PetscInt_FMT " max %" PetscInt_FMT, row, A->rmap->N - 1);
2495     rp = PetscSafePointerPlusOffset(aj, ai[brow]);
2496     if (!A->structure_only) ap = PetscSafePointerPlusOffset(aa, bs2 * ai[brow]);
2497     rmax = imax[brow];
2498     nrow = ailen[brow];
2499     low  = 0;
2500     high = nrow;
2501     for (l = 0; l < n; l++) { /* loop over added columns */
2502       if (in[l] < 0) continue;
2503       PetscCheck(in[l] < A->cmap->n, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Column too large: col %" PetscInt_FMT " max %" PetscInt_FMT, in[l], A->cmap->n - 1);
2504       col  = in[l];
2505       bcol = col / bs;
2506       ridx = row % bs;
2507       cidx = col % bs;
2508       if (!A->structure_only) {
2509         if (roworiented) {
2510           value = v[l + k * n];
2511         } else {
2512           value = v[k + l * m];
2513         }
2514       }
2515       if (col <= lastcol) low = 0;
2516       else high = nrow;
2517       lastcol = col;
2518       while (high - low > 7) {
2519         t = (low + high) / 2;
2520         if (rp[t] > bcol) high = t;
2521         else low = t;
2522       }
2523       for (i = low; i < high; i++) {
2524         if (rp[i] > bcol) break;
2525         if (rp[i] == bcol) {
2526           bap = PetscSafePointerPlusOffset(ap, bs2 * i + bs * cidx + ridx);
2527           if (!A->structure_only) {
2528             if (is == ADD_VALUES) *bap += value;
2529             else *bap = value;
2530           }
2531           goto noinsert1;
2532         }
2533       }
2534       if (nonew == 1) goto noinsert1;
2535       PetscCheck(nonew != -1, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Inserting a new nonzero (%" PetscInt_FMT ", %" PetscInt_FMT ") in the matrix", row, col);
2536       if (A->structure_only) {
2537         MatSeqXAIJReallocateAIJ_structure_only(A, a->mbs, bs2, nrow, brow, bcol, rmax, ai, aj, rp, imax, nonew, MatScalar);
2538       } else {
2539         MatSeqXAIJReallocateAIJ(A, a->mbs, bs2, nrow, brow, bcol, rmax, aa, ai, aj, rp, ap, imax, nonew, MatScalar);
2540       }
2541       N = nrow++ - 1;
2542       high++;
2543       /* shift up all the later entries in this row */
2544       PetscCall(PetscArraymove(rp + i + 1, rp + i, N - i + 1));
2545       rp[i] = bcol;
2546       if (!A->structure_only) {
2547         PetscCall(PetscArraymove(ap + bs2 * (i + 1), ap + bs2 * i, bs2 * (N - i + 1)));
2548         PetscCall(PetscArrayzero(ap + bs2 * i, bs2));
2549         ap[bs2 * i + bs * cidx + ridx] = value;
2550       }
2551       a->nz++;
2552     noinsert1:;
2553       low = i;
2554     }
2555     ailen[brow] = nrow;
2556   }
2557   PetscFunctionReturn(PETSC_SUCCESS);
2558 }
2559 
2560 static PetscErrorCode MatILUFactor_SeqBAIJ(Mat inA, IS row, IS col, const MatFactorInfo *info)
2561 {
2562   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)inA->data;
2563   Mat          outA;
2564   PetscBool    row_identity, col_identity;
2565 
2566   PetscFunctionBegin;
2567   PetscCheck(info->levels == 0, PETSC_COMM_SELF, PETSC_ERR_SUP, "Only levels = 0 supported for in-place ILU");
2568   PetscCall(ISIdentity(row, &row_identity));
2569   PetscCall(ISIdentity(col, &col_identity));
2570   PetscCheck(row_identity && col_identity, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Row and column permutations must be identity for in-place ILU");
2571 
2572   outA            = inA;
2573   inA->factortype = MAT_FACTOR_LU;
2574   PetscCall(PetscFree(inA->solvertype));
2575   PetscCall(PetscStrallocpy(MATSOLVERPETSC, &inA->solvertype));
2576 
2577   PetscCall(MatMarkDiagonal_SeqBAIJ(inA));
2578 
2579   PetscCall(PetscObjectReference((PetscObject)row));
2580   PetscCall(ISDestroy(&a->row));
2581   a->row = row;
2582   PetscCall(PetscObjectReference((PetscObject)col));
2583   PetscCall(ISDestroy(&a->col));
2584   a->col = col;
2585 
2586   /* Create the invert permutation so that it can be used in MatLUFactorNumeric() */
2587   PetscCall(ISDestroy(&a->icol));
2588   PetscCall(ISInvertPermutation(col, PETSC_DECIDE, &a->icol));
2589 
2590   PetscCall(MatSeqBAIJSetNumericFactorization_inplace(inA, (PetscBool)(row_identity && col_identity)));
2591   if (!a->solve_work) PetscCall(PetscMalloc1(inA->rmap->N + inA->rmap->bs, &a->solve_work));
2592   PetscCall(MatLUFactorNumeric(outA, inA, info));
2593   PetscFunctionReturn(PETSC_SUCCESS);
2594 }
2595 
2596 static PetscErrorCode MatSeqBAIJSetColumnIndices_SeqBAIJ(Mat mat, const PetscInt *indices)
2597 {
2598   Mat_SeqBAIJ *baij = (Mat_SeqBAIJ *)mat->data;
2599 
2600   PetscFunctionBegin;
2601   baij->nz = baij->maxnz;
2602   PetscCall(PetscArraycpy(baij->j, indices, baij->nz));
2603   PetscCall(PetscArraycpy(baij->ilen, baij->imax, baij->mbs));
2604   PetscFunctionReturn(PETSC_SUCCESS);
2605 }
2606 
2607 /*@
2608   MatSeqBAIJSetColumnIndices - Set the column indices for all the block rows in the matrix.
2609 
2610   Input Parameters:
2611 + mat     - the `MATSEQBAIJ` matrix
2612 - indices - the block column indices
2613 
2614   Level: advanced
2615 
2616   Notes:
2617   This can be called if you have precomputed the nonzero structure of the
2618   matrix and want to provide it to the matrix object to improve the performance
2619   of the `MatSetValues()` operation.
2620 
2621   You MUST have set the correct numbers of nonzeros per row in the call to
2622   `MatCreateSeqBAIJ()`, and the columns indices MUST be sorted.
2623 
2624   MUST be called before any calls to `MatSetValues()`
2625 
2626 .seealso: [](ch_matrices), `Mat`, `MATSEQBAIJ`, `MatSetValues()`
2627 @*/
2628 PetscErrorCode MatSeqBAIJSetColumnIndices(Mat mat, PetscInt *indices)
2629 {
2630   PetscFunctionBegin;
2631   PetscValidHeaderSpecific(mat, MAT_CLASSID, 1);
2632   PetscAssertPointer(indices, 2);
2633   PetscUseMethod(mat, "MatSeqBAIJSetColumnIndices_C", (Mat, const PetscInt *), (mat, (const PetscInt *)indices));
2634   PetscFunctionReturn(PETSC_SUCCESS);
2635 }
2636 
2637 static PetscErrorCode MatGetRowMaxAbs_SeqBAIJ(Mat A, Vec v, PetscInt idx[])
2638 {
2639   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
2640   PetscInt     i, j, n, row, bs, *ai, *aj, mbs;
2641   PetscReal    atmp;
2642   PetscScalar *x, zero = 0.0;
2643   MatScalar   *aa;
2644   PetscInt     ncols, brow, krow, kcol;
2645 
2646   PetscFunctionBegin;
2647   /* why is this not a macro???????????????????????????????????????????????????????????????? */
2648   PetscCheck(!A->factortype, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Not for factored matrix");
2649   bs  = A->rmap->bs;
2650   aa  = a->a;
2651   ai  = a->i;
2652   aj  = a->j;
2653   mbs = a->mbs;
2654 
2655   PetscCall(VecSet(v, zero));
2656   PetscCall(VecGetArray(v, &x));
2657   PetscCall(VecGetLocalSize(v, &n));
2658   PetscCheck(n == A->rmap->N, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Nonconforming matrix and vector");
2659   for (i = 0; i < mbs; i++) {
2660     ncols = ai[1] - ai[0];
2661     ai++;
2662     brow = bs * i;
2663     for (j = 0; j < ncols; j++) {
2664       for (kcol = 0; kcol < bs; kcol++) {
2665         for (krow = 0; krow < bs; krow++) {
2666           atmp = PetscAbsScalar(*aa);
2667           aa++;
2668           row = brow + krow; /* row index */
2669           if (PetscAbsScalar(x[row]) < atmp) {
2670             x[row] = atmp;
2671             if (idx) idx[row] = bs * (*aj) + kcol;
2672           }
2673         }
2674       }
2675       aj++;
2676     }
2677   }
2678   PetscCall(VecRestoreArray(v, &x));
2679   PetscFunctionReturn(PETSC_SUCCESS);
2680 }
2681 
2682 static PetscErrorCode MatGetRowSumAbs_SeqBAIJ(Mat A, Vec v)
2683 {
2684   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
2685   PetscInt     i, j, n, row, bs, *ai, mbs;
2686   PetscReal    atmp;
2687   PetscScalar *x, zero = 0.0;
2688   MatScalar   *aa;
2689   PetscInt     ncols, brow, krow, kcol;
2690 
2691   PetscFunctionBegin;
2692   PetscCheck(!A->factortype, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Not for factored matrix");
2693   bs  = A->rmap->bs;
2694   aa  = a->a;
2695   ai  = a->i;
2696   mbs = a->mbs;
2697 
2698   PetscCall(VecSet(v, zero));
2699   PetscCall(VecGetArrayWrite(v, &x));
2700   PetscCall(VecGetLocalSize(v, &n));
2701   PetscCheck(n == A->rmap->N, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Nonconforming matrix and vector");
2702   for (i = 0; i < mbs; i++) {
2703     ncols = ai[1] - ai[0];
2704     ai++;
2705     brow = bs * i;
2706     for (j = 0; j < ncols; j++) {
2707       for (kcol = 0; kcol < bs; kcol++) {
2708         for (krow = 0; krow < bs; krow++) {
2709           atmp = PetscAbsScalar(*aa);
2710           aa++;
2711           row = brow + krow; /* row index */
2712           x[row] += atmp;
2713         }
2714       }
2715     }
2716   }
2717   PetscCall(VecRestoreArrayWrite(v, &x));
2718   PetscFunctionReturn(PETSC_SUCCESS);
2719 }
2720 
2721 static PetscErrorCode MatCopy_SeqBAIJ(Mat A, Mat B, MatStructure str)
2722 {
2723   PetscFunctionBegin;
2724   /* If the two matrices have the same copy implementation, use fast copy. */
2725   if (str == SAME_NONZERO_PATTERN && (A->ops->copy == B->ops->copy)) {
2726     Mat_SeqBAIJ *a    = (Mat_SeqBAIJ *)A->data;
2727     Mat_SeqBAIJ *b    = (Mat_SeqBAIJ *)B->data;
2728     PetscInt     ambs = a->mbs, bmbs = b->mbs, abs = A->rmap->bs, bbs = B->rmap->bs, bs2 = abs * abs;
2729 
2730     PetscCheck(a->i[ambs] == b->i[bmbs], PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Number of nonzero blocks in matrices A %" PetscInt_FMT " and B %" PetscInt_FMT " are different", a->i[ambs], b->i[bmbs]);
2731     PetscCheck(abs == bbs, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Block size A %" PetscInt_FMT " and B %" PetscInt_FMT " are different", abs, bbs);
2732     PetscCall(PetscArraycpy(b->a, a->a, bs2 * a->i[ambs]));
2733     PetscCall(PetscObjectStateIncrease((PetscObject)B));
2734   } else {
2735     PetscCall(MatCopy_Basic(A, B, str));
2736   }
2737   PetscFunctionReturn(PETSC_SUCCESS);
2738 }
2739 
2740 static PetscErrorCode MatSeqBAIJGetArray_SeqBAIJ(Mat A, PetscScalar *array[])
2741 {
2742   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
2743 
2744   PetscFunctionBegin;
2745   *array = a->a;
2746   PetscFunctionReturn(PETSC_SUCCESS);
2747 }
2748 
2749 static PetscErrorCode MatSeqBAIJRestoreArray_SeqBAIJ(Mat A, PetscScalar *array[])
2750 {
2751   PetscFunctionBegin;
2752   *array = NULL;
2753   PetscFunctionReturn(PETSC_SUCCESS);
2754 }
2755 
2756 PetscErrorCode MatAXPYGetPreallocation_SeqBAIJ(Mat Y, Mat X, PetscInt *nnz)
2757 {
2758   PetscInt     bs = Y->rmap->bs, mbs = Y->rmap->N / bs;
2759   Mat_SeqBAIJ *x = (Mat_SeqBAIJ *)X->data;
2760   Mat_SeqBAIJ *y = (Mat_SeqBAIJ *)Y->data;
2761 
2762   PetscFunctionBegin;
2763   /* Set the number of nonzeros in the new matrix */
2764   PetscCall(MatAXPYGetPreallocation_SeqX_private(mbs, x->i, x->j, y->i, y->j, nnz));
2765   PetscFunctionReturn(PETSC_SUCCESS);
2766 }
2767 
2768 PetscErrorCode MatAXPY_SeqBAIJ(Mat Y, PetscScalar a, Mat X, MatStructure str)
2769 {
2770   Mat_SeqBAIJ *x = (Mat_SeqBAIJ *)X->data, *y = (Mat_SeqBAIJ *)Y->data;
2771   PetscInt     bs = Y->rmap->bs, bs2 = bs * bs;
2772   PetscBLASInt one = 1;
2773 
2774   PetscFunctionBegin;
2775   if (str == UNKNOWN_NONZERO_PATTERN || (PetscDefined(USE_DEBUG) && str == SAME_NONZERO_PATTERN)) {
2776     PetscBool e = x->nz == y->nz && x->mbs == y->mbs && bs == X->rmap->bs ? PETSC_TRUE : PETSC_FALSE;
2777     if (e) {
2778       PetscCall(PetscArraycmp(x->i, y->i, x->mbs + 1, &e));
2779       if (e) {
2780         PetscCall(PetscArraycmp(x->j, y->j, x->i[x->mbs], &e));
2781         if (e) str = SAME_NONZERO_PATTERN;
2782       }
2783     }
2784     if (!e) PetscCheck(str != SAME_NONZERO_PATTERN, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "MatStructure is not SAME_NONZERO_PATTERN");
2785   }
2786   if (str == SAME_NONZERO_PATTERN) {
2787     PetscScalar  alpha = a;
2788     PetscBLASInt bnz;
2789     PetscCall(PetscBLASIntCast(x->nz * bs2, &bnz));
2790     PetscCallBLAS("BLASaxpy", BLASaxpy_(&bnz, &alpha, x->a, &one, y->a, &one));
2791     PetscCall(PetscObjectStateIncrease((PetscObject)Y));
2792   } else if (str == SUBSET_NONZERO_PATTERN) { /* nonzeros of X is a subset of Y's */
2793     PetscCall(MatAXPY_Basic(Y, a, X, str));
2794   } else {
2795     Mat       B;
2796     PetscInt *nnz;
2797     PetscCheck(bs == X->rmap->bs, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Matrices must have same block size");
2798     PetscCall(PetscMalloc1(Y->rmap->N, &nnz));
2799     PetscCall(MatCreate(PetscObjectComm((PetscObject)Y), &B));
2800     PetscCall(PetscObjectSetName((PetscObject)B, ((PetscObject)Y)->name));
2801     PetscCall(MatSetSizes(B, Y->rmap->n, Y->cmap->n, Y->rmap->N, Y->cmap->N));
2802     PetscCall(MatSetBlockSizesFromMats(B, Y, Y));
2803     PetscCall(MatSetType(B, (MatType)((PetscObject)Y)->type_name));
2804     PetscCall(MatAXPYGetPreallocation_SeqBAIJ(Y, X, nnz));
2805     PetscCall(MatSeqBAIJSetPreallocation(B, bs, 0, nnz));
2806     PetscCall(MatAXPY_BasicWithPreallocation(B, Y, a, X, str));
2807     PetscCall(MatHeaderMerge(Y, &B));
2808     PetscCall(PetscFree(nnz));
2809   }
2810   PetscFunctionReturn(PETSC_SUCCESS);
2811 }
2812 
2813 PETSC_INTERN PetscErrorCode MatConjugate_SeqBAIJ(Mat A)
2814 {
2815 #if PetscDefined(USE_COMPLEX)
2816   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
2817   PetscInt     i, nz = a->bs2 * a->i[a->mbs];
2818   MatScalar   *aa = a->a;
2819 
2820   PetscFunctionBegin;
2821   for (i = 0; i < nz; i++) aa[i] = PetscConj(aa[i]);
2822   PetscFunctionReturn(PETSC_SUCCESS);
2823 #else
2824   (void)A;
2825   return PETSC_SUCCESS;
2826 #endif
2827 }
2828 
2829 static PetscErrorCode MatRealPart_SeqBAIJ(Mat A)
2830 {
2831 #if PetscDefined(USE_COMPLEX)
2832   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
2833   PetscInt     i, nz = a->bs2 * a->i[a->mbs];
2834   MatScalar   *aa = a->a;
2835 
2836   PetscFunctionBegin;
2837   for (i = 0; i < nz; i++) aa[i] = PetscRealPart(aa[i]);
2838   PetscFunctionReturn(PETSC_SUCCESS);
2839 #else
2840   (void)A;
2841   return PETSC_SUCCESS;
2842 #endif
2843 }
2844 
2845 static PetscErrorCode MatImaginaryPart_SeqBAIJ(Mat A)
2846 {
2847 #if PetscDefined(USE_COMPLEX)
2848   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
2849   PetscInt     i, nz = a->bs2 * a->i[a->mbs];
2850   MatScalar   *aa = a->a;
2851 
2852   PetscFunctionBegin;
2853   for (i = 0; i < nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
2854   PetscFunctionReturn(PETSC_SUCCESS);
2855 #else
2856   (void)A;
2857   return PETSC_SUCCESS;
2858 #endif
2859 }
2860 
2861 /*
2862     Code almost identical to MatGetColumnIJ_SeqAIJ() should share common code
2863 */
2864 static PetscErrorCode MatGetColumnIJ_SeqBAIJ(Mat A, PetscInt oshift, PetscBool symmetric, PetscBool inodecompressed, PetscInt *nn, const PetscInt *ia[], const PetscInt *ja[], PetscBool *done)
2865 {
2866   Mat_SeqBAIJ *a  = (Mat_SeqBAIJ *)A->data;
2867   PetscInt     bs = A->rmap->bs, i, *collengths, *cia, *cja, n = A->cmap->n / bs, m = A->rmap->n / bs;
2868   PetscInt     nz = a->i[m], row, *jj, mr, col;
2869 
2870   PetscFunctionBegin;
2871   *nn = n;
2872   if (!ia) PetscFunctionReturn(PETSC_SUCCESS);
2873   PetscCheck(!symmetric, PETSC_COMM_SELF, PETSC_ERR_SUP, "Not for BAIJ matrices");
2874   PetscCall(PetscCalloc1(n, &collengths));
2875   PetscCall(PetscMalloc1(n + 1, &cia));
2876   PetscCall(PetscMalloc1(nz, &cja));
2877   jj = a->j;
2878   for (i = 0; i < nz; i++) collengths[jj[i]]++;
2879   cia[0] = oshift;
2880   for (i = 0; i < n; i++) cia[i + 1] = cia[i] + collengths[i];
2881   PetscCall(PetscArrayzero(collengths, n));
2882   jj = a->j;
2883   for (row = 0; row < m; row++) {
2884     mr = a->i[row + 1] - a->i[row];
2885     for (i = 0; i < mr; i++) {
2886       col = *jj++;
2887 
2888       cja[cia[col] + collengths[col]++ - oshift] = row + oshift;
2889     }
2890   }
2891   PetscCall(PetscFree(collengths));
2892   *ia = cia;
2893   *ja = cja;
2894   PetscFunctionReturn(PETSC_SUCCESS);
2895 }
2896 
2897 static PetscErrorCode MatRestoreColumnIJ_SeqBAIJ(Mat A, PetscInt oshift, PetscBool symmetric, PetscBool inodecompressed, PetscInt *n, const PetscInt *ia[], const PetscInt *ja[], PetscBool *done)
2898 {
2899   PetscFunctionBegin;
2900   if (!ia) PetscFunctionReturn(PETSC_SUCCESS);
2901   PetscCall(PetscFree(*ia));
2902   PetscCall(PetscFree(*ja));
2903   PetscFunctionReturn(PETSC_SUCCESS);
2904 }
2905 
2906 /*
2907  MatGetColumnIJ_SeqBAIJ_Color() and MatRestoreColumnIJ_SeqBAIJ_Color() are customized from
2908  MatGetColumnIJ_SeqBAIJ() and MatRestoreColumnIJ_SeqBAIJ() by adding an output
2909  spidx[], index of a->a, to be used in MatTransposeColoringCreate() and MatFDColoringCreate()
2910  */
2911 PetscErrorCode MatGetColumnIJ_SeqBAIJ_Color(Mat A, PetscInt oshift, PetscBool symmetric, PetscBool inodecompressed, PetscInt *nn, const PetscInt *ia[], const PetscInt *ja[], PetscInt *spidx[], PetscBool *done)
2912 {
2913   Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data;
2914   PetscInt     i, *collengths, *cia, *cja, n = a->nbs, m = a->mbs;
2915   PetscInt     nz = a->i[m], row, *jj, mr, col;
2916   PetscInt    *cspidx;
2917 
2918   PetscFunctionBegin;
2919   *nn = n;
2920   if (!ia) PetscFunctionReturn(PETSC_SUCCESS);
2921 
2922   PetscCall(PetscCalloc1(n, &collengths));
2923   PetscCall(PetscMalloc1(n + 1, &cia));
2924   PetscCall(PetscMalloc1(nz, &cja));
2925   PetscCall(PetscMalloc1(nz, &cspidx));
2926   jj = a->j;
2927   for (i = 0; i < nz; i++) collengths[jj[i]]++;
2928   cia[0] = oshift;
2929   for (i = 0; i < n; i++) cia[i + 1] = cia[i] + collengths[i];
2930   PetscCall(PetscArrayzero(collengths, n));
2931   jj = a->j;
2932   for (row = 0; row < m; row++) {
2933     mr = a->i[row + 1] - a->i[row];
2934     for (i = 0; i < mr; i++) {
2935       col                                         = *jj++;
2936       cspidx[cia[col] + collengths[col] - oshift] = a->i[row] + i; /* index of a->j */
2937       cja[cia[col] + collengths[col]++ - oshift]  = row + oshift;
2938     }
2939   }
2940   PetscCall(PetscFree(collengths));
2941   *ia    = cia;
2942   *ja    = cja;
2943   *spidx = cspidx;
2944   PetscFunctionReturn(PETSC_SUCCESS);
2945 }
2946 
2947 PetscErrorCode MatRestoreColumnIJ_SeqBAIJ_Color(Mat A, PetscInt oshift, PetscBool symmetric, PetscBool inodecompressed, PetscInt *n, const PetscInt *ia[], const PetscInt *ja[], PetscInt *spidx[], PetscBool *done)
2948 {
2949   PetscFunctionBegin;
2950   PetscCall(MatRestoreColumnIJ_SeqBAIJ(A, oshift, symmetric, inodecompressed, n, ia, ja, done));
2951   PetscCall(PetscFree(*spidx));
2952   PetscFunctionReturn(PETSC_SUCCESS);
2953 }
2954 
2955 static PetscErrorCode MatShift_SeqBAIJ(Mat Y, PetscScalar a)
2956 {
2957   Mat_SeqBAIJ *aij = (Mat_SeqBAIJ *)Y->data;
2958 
2959   PetscFunctionBegin;
2960   if (!Y->preallocated || !aij->nz) PetscCall(MatSeqBAIJSetPreallocation(Y, Y->rmap->bs, 1, NULL));
2961   PetscCall(MatShift_Basic(Y, a));
2962   PetscFunctionReturn(PETSC_SUCCESS);
2963 }
2964 
2965 PetscErrorCode MatEliminateZeros_SeqBAIJ(Mat A, PetscBool keep)
2966 {
2967   Mat_SeqBAIJ *a      = (Mat_SeqBAIJ *)A->data;
2968   PetscInt     fshift = 0, fshift_prev = 0, i, *ai = a->i, *aj = a->j, *imax = a->imax, j, k;
2969   PetscInt     m = A->rmap->N, *ailen = a->ilen;
2970   PetscInt     mbs = a->mbs, bs2 = a->bs2, rmax = 0;
2971   MatScalar   *aa = a->a, *ap;
2972   PetscBool    zero;
2973 
2974   PetscFunctionBegin;
2975   PetscCheck(A->assembled, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Cannot eliminate zeros for unassembled matrix");
2976   if (m) rmax = ailen[0];
2977   for (i = 1; i <= mbs; i++) {
2978     for (k = ai[i - 1]; k < ai[i]; k++) {
2979       zero = PETSC_TRUE;
2980       ap   = aa + bs2 * k;
2981       for (j = 0; j < bs2 && zero; j++) {
2982         if (ap[j] != 0.0) zero = PETSC_FALSE;
2983       }
2984       if (zero && (aj[k] != i - 1 || !keep)) fshift++;
2985       else {
2986         if (zero && aj[k] == i - 1) PetscCall(PetscInfo(A, "Keep the diagonal block at row %" PetscInt_FMT "\n", i - 1));
2987         aj[k - fshift] = aj[k];
2988         PetscCall(PetscArraymove(ap - bs2 * fshift, ap, bs2));
2989       }
2990     }
2991     ai[i - 1] -= fshift_prev;
2992     fshift_prev  = fshift;
2993     ailen[i - 1] = imax[i - 1] = ai[i] - fshift - ai[i - 1];
2994     a->nonzerorowcnt += ((ai[i] - fshift - ai[i - 1]) > 0);
2995     rmax = PetscMax(rmax, ailen[i - 1]);
2996   }
2997   if (fshift) {
2998     if (mbs) {
2999       ai[mbs] -= fshift;
3000       a->nz = ai[mbs];
3001     }
3002     PetscCall(PetscInfo(A, "Matrix size: %" PetscInt_FMT " X %" PetscInt_FMT "; zeros eliminated: %" PetscInt_FMT "; nonzeros left: %" PetscInt_FMT "\n", m, A->cmap->n, fshift, a->nz));
3003     A->nonzerostate++;
3004     A->info.nz_unneeded += (PetscReal)fshift;
3005     a->rmax = rmax;
3006     PetscCall(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY));
3007     PetscCall(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY));
3008   }
3009   PetscFunctionReturn(PETSC_SUCCESS);
3010 }
3011 
3012 static struct _MatOps MatOps_Values = {MatSetValues_SeqBAIJ,
3013                                        MatGetRow_SeqBAIJ,
3014                                        MatRestoreRow_SeqBAIJ,
3015                                        MatMult_SeqBAIJ_N,
3016                                        /* 4*/ MatMultAdd_SeqBAIJ_N,
3017                                        MatMultTranspose_SeqBAIJ,
3018                                        MatMultTransposeAdd_SeqBAIJ,
3019                                        NULL,
3020                                        NULL,
3021                                        NULL,
3022                                        /* 10*/ NULL,
3023                                        MatLUFactor_SeqBAIJ,
3024                                        NULL,
3025                                        NULL,
3026                                        MatTranspose_SeqBAIJ,
3027                                        /* 15*/ MatGetInfo_SeqBAIJ,
3028                                        MatEqual_SeqBAIJ,
3029                                        MatGetDiagonal_SeqBAIJ,
3030                                        MatDiagonalScale_SeqBAIJ,
3031                                        MatNorm_SeqBAIJ,
3032                                        /* 20*/ NULL,
3033                                        MatAssemblyEnd_SeqBAIJ,
3034                                        MatSetOption_SeqBAIJ,
3035                                        MatZeroEntries_SeqBAIJ,
3036                                        /* 24*/ MatZeroRows_SeqBAIJ,
3037                                        NULL,
3038                                        NULL,
3039                                        NULL,
3040                                        NULL,
3041                                        /* 29*/ MatSetUp_Seq_Hash,
3042                                        NULL,
3043                                        NULL,
3044                                        NULL,
3045                                        NULL,
3046                                        /* 34*/ MatDuplicate_SeqBAIJ,
3047                                        NULL,
3048                                        NULL,
3049                                        MatILUFactor_SeqBAIJ,
3050                                        NULL,
3051                                        /* 39*/ MatAXPY_SeqBAIJ,
3052                                        MatCreateSubMatrices_SeqBAIJ,
3053                                        MatIncreaseOverlap_SeqBAIJ,
3054                                        MatGetValues_SeqBAIJ,
3055                                        MatCopy_SeqBAIJ,
3056                                        /* 44*/ NULL,
3057                                        MatScale_SeqBAIJ,
3058                                        MatShift_SeqBAIJ,
3059                                        NULL,
3060                                        MatZeroRowsColumns_SeqBAIJ,
3061                                        /* 49*/ NULL,
3062                                        MatGetRowIJ_SeqBAIJ,
3063                                        MatRestoreRowIJ_SeqBAIJ,
3064                                        MatGetColumnIJ_SeqBAIJ,
3065                                        MatRestoreColumnIJ_SeqBAIJ,
3066                                        /* 54*/ MatFDColoringCreate_SeqXAIJ,
3067                                        NULL,
3068                                        NULL,
3069                                        NULL,
3070                                        MatSetValuesBlocked_SeqBAIJ,
3071                                        /* 59*/ MatCreateSubMatrix_SeqBAIJ,
3072                                        MatDestroy_SeqBAIJ,
3073                                        MatView_SeqBAIJ,
3074                                        NULL,
3075                                        NULL,
3076                                        /* 64*/ NULL,
3077                                        NULL,
3078                                        NULL,
3079                                        NULL,
3080                                        NULL,
3081                                        /* 69*/ MatGetRowMaxAbs_SeqBAIJ,
3082                                        NULL,
3083                                        MatConvert_Basic,
3084                                        NULL,
3085                                        NULL,
3086                                        /* 74*/ NULL,
3087                                        MatFDColoringApply_BAIJ,
3088                                        NULL,
3089                                        NULL,
3090                                        NULL,
3091                                        /* 79*/ NULL,
3092                                        NULL,
3093                                        NULL,
3094                                        NULL,
3095                                        MatLoad_SeqBAIJ,
3096                                        /* 84*/ NULL,
3097                                        NULL,
3098                                        NULL,
3099                                        NULL,
3100                                        NULL,
3101                                        /* 89*/ NULL,
3102                                        NULL,
3103                                        NULL,
3104                                        NULL,
3105                                        NULL,
3106                                        /* 94*/ NULL,
3107                                        NULL,
3108                                        NULL,
3109                                        NULL,
3110                                        NULL,
3111                                        /* 99*/ NULL,
3112                                        NULL,
3113                                        NULL,
3114                                        MatConjugate_SeqBAIJ,
3115                                        NULL,
3116                                        /*104*/ NULL,
3117                                        MatRealPart_SeqBAIJ,
3118                                        MatImaginaryPart_SeqBAIJ,
3119                                        NULL,
3120                                        NULL,
3121                                        /*109*/ NULL,
3122                                        NULL,
3123                                        NULL,
3124                                        NULL,
3125                                        MatMissingDiagonal_SeqBAIJ,
3126                                        /*114*/ NULL,
3127                                        NULL,
3128                                        NULL,
3129                                        NULL,
3130                                        NULL,
3131                                        /*119*/ NULL,
3132                                        NULL,
3133                                        MatMultHermitianTranspose_SeqBAIJ,
3134                                        MatMultHermitianTransposeAdd_SeqBAIJ,
3135                                        NULL,
3136                                        /*124*/ NULL,
3137                                        MatGetColumnReductions_SeqBAIJ,
3138                                        MatInvertBlockDiagonal_SeqBAIJ,
3139                                        NULL,
3140                                        NULL,
3141                                        /*129*/ NULL,
3142                                        NULL,
3143                                        NULL,
3144                                        NULL,
3145                                        NULL,
3146                                        /*134*/ NULL,
3147                                        NULL,
3148                                        NULL,
3149                                        NULL,
3150                                        NULL,
3151                                        /*139*/ MatSetBlockSizes_Default,
3152                                        NULL,
3153                                        NULL,
3154                                        MatFDColoringSetUp_SeqXAIJ,
3155                                        NULL,
3156                                        /*144*/ MatCreateMPIMatConcatenateSeqMat_SeqBAIJ,
3157                                        MatDestroySubMatrices_SeqBAIJ,
3158                                        NULL,
3159                                        NULL,
3160                                        NULL,
3161                                        NULL,
3162                                        /*150*/ NULL,
3163                                        MatEliminateZeros_SeqBAIJ,
3164                                        MatGetRowSumAbs_SeqBAIJ};
3165 
3166 static PetscErrorCode MatStoreValues_SeqBAIJ(Mat mat)
3167 {
3168   Mat_SeqBAIJ *aij = (Mat_SeqBAIJ *)mat->data;
3169   PetscInt     nz  = aij->i[aij->mbs] * aij->bs2;
3170 
3171   PetscFunctionBegin;
3172   PetscCheck(aij->nonew == 1, PETSC_COMM_SELF, PETSC_ERR_ORDER, "Must call MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);first");
3173 
3174   /* allocate space for values if not already there */
3175   if (!aij->saved_values) PetscCall(PetscMalloc1(nz + 1, &aij->saved_values));
3176 
3177   /* copy values over */
3178   PetscCall(PetscArraycpy(aij->saved_values, aij->a, nz));
3179   PetscFunctionReturn(PETSC_SUCCESS);
3180 }
3181 
3182 static PetscErrorCode MatRetrieveValues_SeqBAIJ(Mat mat)
3183 {
3184   Mat_SeqBAIJ *aij = (Mat_SeqBAIJ *)mat->data;
3185   PetscInt     nz  = aij->i[aij->mbs] * aij->bs2;
3186 
3187   PetscFunctionBegin;
3188   PetscCheck(aij->nonew == 1, PETSC_COMM_SELF, PETSC_ERR_ORDER, "Must call MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);first");
3189   PetscCheck(aij->saved_values, PETSC_COMM_SELF, PETSC_ERR_ORDER, "Must call MatStoreValues(A);first");
3190 
3191   /* copy values over */
3192   PetscCall(PetscArraycpy(aij->a, aij->saved_values, nz));
3193   PetscFunctionReturn(PETSC_SUCCESS);
3194 }
3195 
3196 PETSC_INTERN PetscErrorCode MatConvert_SeqBAIJ_SeqAIJ(Mat, MatType, MatReuse, Mat *);
3197 PETSC_INTERN PetscErrorCode MatConvert_SeqBAIJ_SeqSBAIJ(Mat, MatType, MatReuse, Mat *);
3198 
3199 PetscErrorCode MatSeqBAIJSetPreallocation_SeqBAIJ(Mat B, PetscInt bs, PetscInt nz, const PetscInt nnz[])
3200 {
3201   Mat_SeqBAIJ *b = (Mat_SeqBAIJ *)B->data;
3202   PetscInt     i, mbs, nbs, bs2;
3203   PetscBool    flg = PETSC_FALSE, skipallocation = PETSC_FALSE, realalloc = PETSC_FALSE;
3204 
3205   PetscFunctionBegin;
3206   if (B->hash_active) {
3207     PetscInt bs;
3208     B->ops[0] = b->cops;
3209     PetscCall(PetscHMapIJVDestroy(&b->ht));
3210     PetscCall(MatGetBlockSize(B, &bs));
3211     if (bs > 1) PetscCall(PetscHSetIJDestroy(&b->bht));
3212     PetscCall(PetscFree(b->dnz));
3213     PetscCall(PetscFree(b->bdnz));
3214     B->hash_active = PETSC_FALSE;
3215   }
3216   if (nz >= 0 || nnz) realalloc = PETSC_TRUE;
3217   if (nz == MAT_SKIP_ALLOCATION) {
3218     skipallocation = PETSC_TRUE;
3219     nz             = 0;
3220   }
3221 
3222   PetscCall(MatSetBlockSize(B, PetscAbs(bs)));
3223   PetscCall(PetscLayoutSetUp(B->rmap));
3224   PetscCall(PetscLayoutSetUp(B->cmap));
3225   PetscCall(PetscLayoutGetBlockSize(B->rmap, &bs));
3226 
3227   B->preallocated = PETSC_TRUE;
3228 
3229   mbs = B->rmap->n / bs;
3230   nbs = B->cmap->n / bs;
3231   bs2 = bs * bs;
3232 
3233   PetscCheck(mbs * bs == B->rmap->n && nbs * bs == B->cmap->n, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Number rows %" PetscInt_FMT ", cols %" PetscInt_FMT " must be divisible by blocksize %" PetscInt_FMT, B->rmap->N, B->cmap->n, bs);
3234 
3235   if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 5;
3236   PetscCheck(nz >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "nz cannot be less than 0: value %" PetscInt_FMT, nz);
3237   if (nnz) {
3238     for (i = 0; i < mbs; i++) {
3239       PetscCheck(nnz[i] >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "nnz cannot be less than 0: local row %" PetscInt_FMT " value %" PetscInt_FMT, i, nnz[i]);
3240       PetscCheck(nnz[i] <= nbs, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "nnz cannot be greater than block row length: local row %" PetscInt_FMT " value %" PetscInt_FMT " rowlength %" PetscInt_FMT, i, nnz[i], nbs);
3241     }
3242   }
3243 
3244   PetscOptionsBegin(PetscObjectComm((PetscObject)B), NULL, "Optimize options for SEQBAIJ matrix 2 ", "Mat");
3245   PetscCall(PetscOptionsBool("-mat_no_unroll", "Do not optimize for block size (slow)", NULL, flg, &flg, NULL));
3246   PetscOptionsEnd();
3247 
3248   if (!flg) {
3249     switch (bs) {
3250     case 1:
3251       B->ops->mult    = MatMult_SeqBAIJ_1;
3252       B->ops->multadd = MatMultAdd_SeqBAIJ_1;
3253       break;
3254     case 2:
3255       B->ops->mult    = MatMult_SeqBAIJ_2;
3256       B->ops->multadd = MatMultAdd_SeqBAIJ_2;
3257       break;
3258     case 3:
3259       B->ops->mult    = MatMult_SeqBAIJ_3;
3260       B->ops->multadd = MatMultAdd_SeqBAIJ_3;
3261       break;
3262     case 4:
3263       B->ops->mult    = MatMult_SeqBAIJ_4;
3264       B->ops->multadd = MatMultAdd_SeqBAIJ_4;
3265       break;
3266     case 5:
3267       B->ops->mult    = MatMult_SeqBAIJ_5;
3268       B->ops->multadd = MatMultAdd_SeqBAIJ_5;
3269       break;
3270     case 6:
3271       B->ops->mult    = MatMult_SeqBAIJ_6;
3272       B->ops->multadd = MatMultAdd_SeqBAIJ_6;
3273       break;
3274     case 7:
3275       B->ops->mult    = MatMult_SeqBAIJ_7;
3276       B->ops->multadd = MatMultAdd_SeqBAIJ_7;
3277       break;
3278     case 9: {
3279       PetscInt version = 1;
3280       PetscCall(PetscOptionsGetInt(NULL, ((PetscObject)B)->prefix, "-mat_baij_mult_version", &version, NULL));
3281       switch (version) {
3282 #if defined(PETSC_HAVE_IMMINTRIN_H) && defined(__AVX2__) && defined(__FMA__) && defined(PETSC_USE_REAL_DOUBLE) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_64BIT_INDICES)
3283       case 1:
3284         B->ops->mult    = MatMult_SeqBAIJ_9_AVX2;
3285         B->ops->multadd = MatMultAdd_SeqBAIJ_9_AVX2;
3286         PetscCall(PetscInfo((PetscObject)B, "Using AVX2 for MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", bs));
3287         break;
3288 #endif
3289       default:
3290         B->ops->mult    = MatMult_SeqBAIJ_N;
3291         B->ops->multadd = MatMultAdd_SeqBAIJ_N;
3292         PetscCall(PetscInfo((PetscObject)B, "Using BLAS for MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", bs));
3293         break;
3294       }
3295       break;
3296     }
3297     case 11:
3298       B->ops->mult    = MatMult_SeqBAIJ_11;
3299       B->ops->multadd = MatMultAdd_SeqBAIJ_11;
3300       break;
3301     case 12: {
3302       PetscInt version = 1;
3303       PetscCall(PetscOptionsGetInt(NULL, ((PetscObject)B)->prefix, "-mat_baij_mult_version", &version, NULL));
3304       switch (version) {
3305       case 1:
3306         B->ops->mult    = MatMult_SeqBAIJ_12_ver1;
3307         B->ops->multadd = MatMultAdd_SeqBAIJ_12_ver1;
3308         PetscCall(PetscInfo((PetscObject)B, "Using version %" PetscInt_FMT " of MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", version, bs));
3309         break;
3310       case 2:
3311         B->ops->mult    = MatMult_SeqBAIJ_12_ver2;
3312         B->ops->multadd = MatMultAdd_SeqBAIJ_12_ver2;
3313         PetscCall(PetscInfo((PetscObject)B, "Using version %" PetscInt_FMT " of MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", version, bs));
3314         break;
3315 #if defined(PETSC_HAVE_IMMINTRIN_H) && defined(__AVX2__) && defined(__FMA__) && defined(PETSC_USE_REAL_DOUBLE) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_64BIT_INDICES)
3316       case 3:
3317         B->ops->mult    = MatMult_SeqBAIJ_12_AVX2;
3318         B->ops->multadd = MatMultAdd_SeqBAIJ_12_ver1;
3319         PetscCall(PetscInfo((PetscObject)B, "Using AVX2 for MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", bs));
3320         break;
3321 #endif
3322       default:
3323         B->ops->mult    = MatMult_SeqBAIJ_N;
3324         B->ops->multadd = MatMultAdd_SeqBAIJ_N;
3325         PetscCall(PetscInfo((PetscObject)B, "Using BLAS for MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", bs));
3326         break;
3327       }
3328       break;
3329     }
3330     case 15: {
3331       PetscInt version = 1;
3332       PetscCall(PetscOptionsGetInt(NULL, ((PetscObject)B)->prefix, "-mat_baij_mult_version", &version, NULL));
3333       switch (version) {
3334       case 1:
3335         B->ops->mult = MatMult_SeqBAIJ_15_ver1;
3336         PetscCall(PetscInfo((PetscObject)B, "Using version %" PetscInt_FMT " of MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", version, bs));
3337         break;
3338       case 2:
3339         B->ops->mult = MatMult_SeqBAIJ_15_ver2;
3340         PetscCall(PetscInfo((PetscObject)B, "Using version %" PetscInt_FMT " of MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", version, bs));
3341         break;
3342       case 3:
3343         B->ops->mult = MatMult_SeqBAIJ_15_ver3;
3344         PetscCall(PetscInfo((PetscObject)B, "Using version %" PetscInt_FMT " of MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", version, bs));
3345         break;
3346       case 4:
3347         B->ops->mult = MatMult_SeqBAIJ_15_ver4;
3348         PetscCall(PetscInfo((PetscObject)B, "Using version %" PetscInt_FMT " of MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", version, bs));
3349         break;
3350       default:
3351         B->ops->mult = MatMult_SeqBAIJ_N;
3352         PetscCall(PetscInfo((PetscObject)B, "Using BLAS for MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", bs));
3353         break;
3354       }
3355       B->ops->multadd = MatMultAdd_SeqBAIJ_N;
3356       break;
3357     }
3358     default:
3359       B->ops->mult    = MatMult_SeqBAIJ_N;
3360       B->ops->multadd = MatMultAdd_SeqBAIJ_N;
3361       PetscCall(PetscInfo((PetscObject)B, "Using BLAS for MatMult for BAIJ for blocksize %" PetscInt_FMT "\n", bs));
3362       break;
3363     }
3364   }
3365   B->ops->sor = MatSOR_SeqBAIJ;
3366   b->mbs      = mbs;
3367   b->nbs      = nbs;
3368   if (!skipallocation) {
3369     if (!b->imax) {
3370       PetscCall(PetscMalloc2(mbs, &b->imax, mbs, &b->ilen));
3371 
3372       b->free_imax_ilen = PETSC_TRUE;
3373     }
3374     /* b->ilen will count nonzeros in each block row so far. */
3375     for (i = 0; i < mbs; i++) b->ilen[i] = 0;
3376     if (!nnz) {
3377       if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 5;
3378       else if (nz < 0) nz = 1;
3379       nz = PetscMin(nz, nbs);
3380       for (i = 0; i < mbs; i++) b->imax[i] = nz;
3381       PetscCall(PetscIntMultError(nz, mbs, &nz));
3382     } else {
3383       PetscInt64 nz64 = 0;
3384       for (i = 0; i < mbs; i++) {
3385         b->imax[i] = nnz[i];
3386         nz64 += nnz[i];
3387       }
3388       PetscCall(PetscIntCast(nz64, &nz));
3389     }
3390 
3391     /* allocate the matrix space */
3392     PetscCall(MatSeqXAIJFreeAIJ(B, &b->a, &b->j, &b->i));
3393     if (B->structure_only) {
3394       PetscCall(PetscMalloc1(nz, &b->j));
3395       PetscCall(PetscMalloc1(B->rmap->N + 1, &b->i));
3396     } else {
3397       PetscInt nzbs2 = 0;
3398       PetscCall(PetscIntMultError(nz, bs2, &nzbs2));
3399       PetscCall(PetscMalloc3(nzbs2, &b->a, nz, &b->j, B->rmap->N + 1, &b->i));
3400       PetscCall(PetscArrayzero(b->a, nz * bs2));
3401     }
3402     PetscCall(PetscArrayzero(b->j, nz));
3403 
3404     if (B->structure_only) {
3405       b->singlemalloc = PETSC_FALSE;
3406       b->free_a       = PETSC_FALSE;
3407     } else {
3408       b->singlemalloc = PETSC_TRUE;
3409       b->free_a       = PETSC_TRUE;
3410     }
3411     b->free_ij = PETSC_TRUE;
3412 
3413     b->i[0] = 0;
3414     for (i = 1; i < mbs + 1; i++) b->i[i] = b->i[i - 1] + b->imax[i - 1];
3415 
3416   } else {
3417     b->free_a  = PETSC_FALSE;
3418     b->free_ij = PETSC_FALSE;
3419   }
3420 
3421   b->bs2              = bs2;
3422   b->mbs              = mbs;
3423   b->nz               = 0;
3424   b->maxnz            = nz;
3425   B->info.nz_unneeded = (PetscReal)b->maxnz * bs2;
3426   B->was_assembled    = PETSC_FALSE;
3427   B->assembled        = PETSC_FALSE;
3428   if (realalloc) PetscCall(MatSetOption(B, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_TRUE));
3429   PetscFunctionReturn(PETSC_SUCCESS);
3430 }
3431 
3432 static PetscErrorCode MatSeqBAIJSetPreallocationCSR_SeqBAIJ(Mat B, PetscInt bs, const PetscInt ii[], const PetscInt jj[], const PetscScalar V[])
3433 {
3434   PetscInt     i, m, nz, nz_max = 0, *nnz;
3435   PetscScalar *values      = NULL;
3436   PetscBool    roworiented = ((Mat_SeqBAIJ *)B->data)->roworiented;
3437 
3438   PetscFunctionBegin;
3439   PetscCheck(bs >= 1, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid block size specified, must be positive but it is %" PetscInt_FMT, bs);
3440   PetscCall(PetscLayoutSetBlockSize(B->rmap, bs));
3441   PetscCall(PetscLayoutSetBlockSize(B->cmap, bs));
3442   PetscCall(PetscLayoutSetUp(B->rmap));
3443   PetscCall(PetscLayoutSetUp(B->cmap));
3444   PetscCall(PetscLayoutGetBlockSize(B->rmap, &bs));
3445   m = B->rmap->n / bs;
3446 
3447   PetscCheck(ii[0] == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "ii[0] must be 0 but it is %" PetscInt_FMT, ii[0]);
3448   PetscCall(PetscMalloc1(m + 1, &nnz));
3449   for (i = 0; i < m; i++) {
3450     nz = ii[i + 1] - ii[i];
3451     PetscCheck(nz >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Local row %" PetscInt_FMT " has a negative number of columns %" PetscInt_FMT, i, nz);
3452     nz_max = PetscMax(nz_max, nz);
3453     nnz[i] = nz;
3454   }
3455   PetscCall(MatSeqBAIJSetPreallocation(B, bs, 0, nnz));
3456   PetscCall(PetscFree(nnz));
3457 
3458   values = (PetscScalar *)V;
3459   if (!values) PetscCall(PetscCalloc1(bs * bs * (nz_max + 1), &values));
3460   for (i = 0; i < m; i++) {
3461     PetscInt        ncols = ii[i + 1] - ii[i];
3462     const PetscInt *icols = jj + ii[i];
3463     if (bs == 1 || !roworiented) {
3464       const PetscScalar *svals = values + (V ? (bs * bs * ii[i]) : 0);
3465       PetscCall(MatSetValuesBlocked_SeqBAIJ(B, 1, &i, ncols, icols, svals, INSERT_VALUES));
3466     } else {
3467       PetscInt j;
3468       for (j = 0; j < ncols; j++) {
3469         const PetscScalar *svals = values + (V ? (bs * bs * (ii[i] + j)) : 0);
3470         PetscCall(MatSetValuesBlocked_SeqBAIJ(B, 1, &i, 1, &icols[j], svals, INSERT_VALUES));
3471       }
3472     }
3473   }
3474   if (!V) PetscCall(PetscFree(values));
3475   PetscCall(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY));
3476   PetscCall(MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY));
3477   PetscCall(MatSetOption(B, MAT_NEW_NONZERO_LOCATION_ERR, PETSC_TRUE));
3478   PetscFunctionReturn(PETSC_SUCCESS);
3479 }
3480 
3481 /*@C
3482   MatSeqBAIJGetArray - gives read/write access to the array where the data for a `MATSEQBAIJ` matrix is stored
3483 
3484   Not Collective
3485 
3486   Input Parameter:
3487 . A - a `MATSEQBAIJ` matrix
3488 
3489   Output Parameter:
3490 . array - pointer to the data
3491 
3492   Level: intermediate
3493 
3494 .seealso: [](ch_matrices), `Mat`, `MATSEQBAIJ`, `MatSeqBAIJRestoreArray()`, `MatSeqAIJGetArray()`, `MatSeqAIJRestoreArray()`
3495 @*/
3496 PetscErrorCode MatSeqBAIJGetArray(Mat A, PetscScalar **array)
3497 {
3498   PetscFunctionBegin;
3499   PetscUseMethod(A, "MatSeqBAIJGetArray_C", (Mat, PetscScalar **), (A, array));
3500   PetscFunctionReturn(PETSC_SUCCESS);
3501 }
3502 
3503 /*@C
3504   MatSeqBAIJRestoreArray - returns access to the array where the data for a `MATSEQBAIJ` matrix is stored obtained by `MatSeqBAIJGetArray()`
3505 
3506   Not Collective
3507 
3508   Input Parameters:
3509 + A     - a `MATSEQBAIJ` matrix
3510 - array - pointer to the data
3511 
3512   Level: intermediate
3513 
3514 .seealso: [](ch_matrices), `Mat`, `MatSeqBAIJGetArray()`, `MatSeqAIJGetArray()`, `MatSeqAIJRestoreArray()`
3515 @*/
3516 PetscErrorCode MatSeqBAIJRestoreArray(Mat A, PetscScalar **array)
3517 {
3518   PetscFunctionBegin;
3519   PetscUseMethod(A, "MatSeqBAIJRestoreArray_C", (Mat, PetscScalar **), (A, array));
3520   PetscFunctionReturn(PETSC_SUCCESS);
3521 }
3522 
3523 /*MC
3524    MATSEQBAIJ - MATSEQBAIJ = "seqbaij" - A matrix type to be used for sequential block sparse matrices, based on
3525    block sparse compressed row format.
3526 
3527    Options Database Keys:
3528 + -mat_type seqbaij - sets the matrix type to `MATSEQBAIJ` during a call to `MatSetFromOptions()`
3529 - -mat_baij_mult_version version - indicate the version of the matrix-vector product to use (0 often indicates using BLAS)
3530 
3531    Level: beginner
3532 
3533    Notes:
3534    `MatSetOptions`(,`MAT_STRUCTURE_ONLY`,`PETSC_TRUE`) may be called for this matrix type. In this no
3535    space is allocated for the nonzero entries and any entries passed with `MatSetValues()` are ignored
3536 
3537    Run with `-info` to see what version of the matrix-vector product is being used
3538 
3539 .seealso: [](ch_matrices), `Mat`, `MatCreateSeqBAIJ()`
3540 M*/
3541 
3542 PETSC_INTERN PetscErrorCode MatConvert_SeqBAIJ_SeqBSTRM(Mat, MatType, MatReuse, Mat *);
3543 
3544 PETSC_EXTERN PetscErrorCode MatCreate_SeqBAIJ(Mat B)
3545 {
3546   PetscMPIInt  size;
3547   Mat_SeqBAIJ *b;
3548 
3549   PetscFunctionBegin;
3550   PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)B), &size));
3551   PetscCheck(size == 1, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Comm must be of size 1");
3552 
3553   PetscCall(PetscNew(&b));
3554   B->data   = (void *)b;
3555   B->ops[0] = MatOps_Values;
3556 
3557   b->row          = NULL;
3558   b->col          = NULL;
3559   b->icol         = NULL;
3560   b->reallocs     = 0;
3561   b->saved_values = NULL;
3562 
3563   b->roworiented        = PETSC_TRUE;
3564   b->nonew              = 0;
3565   b->diag               = NULL;
3566   B->spptr              = NULL;
3567   B->info.nz_unneeded   = (PetscReal)b->maxnz * b->bs2;
3568   b->keepnonzeropattern = PETSC_FALSE;
3569 
3570   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatSeqBAIJGetArray_C", MatSeqBAIJGetArray_SeqBAIJ));
3571   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatSeqBAIJRestoreArray_C", MatSeqBAIJRestoreArray_SeqBAIJ));
3572   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatStoreValues_C", MatStoreValues_SeqBAIJ));
3573   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatRetrieveValues_C", MatRetrieveValues_SeqBAIJ));
3574   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatSeqBAIJSetColumnIndices_C", MatSeqBAIJSetColumnIndices_SeqBAIJ));
3575   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatConvert_seqbaij_seqaij_C", MatConvert_SeqBAIJ_SeqAIJ));
3576   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatConvert_seqbaij_seqsbaij_C", MatConvert_SeqBAIJ_SeqSBAIJ));
3577   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatSeqBAIJSetPreallocation_C", MatSeqBAIJSetPreallocation_SeqBAIJ));
3578   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatSeqBAIJSetPreallocationCSR_C", MatSeqBAIJSetPreallocationCSR_SeqBAIJ));
3579   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatIsTranspose_C", MatIsTranspose_SeqBAIJ));
3580 #if defined(PETSC_HAVE_HYPRE)
3581   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatConvert_seqbaij_hypre_C", MatConvert_AIJ_HYPRE));
3582 #endif
3583   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatConvert_seqbaij_is_C", MatConvert_XAIJ_IS));
3584   PetscCall(PetscObjectChangeTypeName((PetscObject)B, MATSEQBAIJ));
3585   PetscFunctionReturn(PETSC_SUCCESS);
3586 }
3587 
3588 PetscErrorCode MatDuplicateNoCreate_SeqBAIJ(Mat C, Mat A, MatDuplicateOption cpvalues, PetscBool mallocmatspace)
3589 {
3590   Mat_SeqBAIJ *c = (Mat_SeqBAIJ *)C->data, *a = (Mat_SeqBAIJ *)A->data;
3591   PetscInt     i, mbs = a->mbs, nz = a->nz, bs2 = a->bs2;
3592 
3593   PetscFunctionBegin;
3594   PetscCheck(A->assembled, PetscObjectComm((PetscObject)A), PETSC_ERR_ARG_WRONGSTATE, "Cannot duplicate unassembled matrix");
3595   PetscCheck(a->i[mbs] == nz, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Corrupt matrix");
3596 
3597   if (cpvalues == MAT_SHARE_NONZERO_PATTERN) {
3598     c->imax           = a->imax;
3599     c->ilen           = a->ilen;
3600     c->free_imax_ilen = PETSC_FALSE;
3601   } else {
3602     PetscCall(PetscMalloc2(mbs, &c->imax, mbs, &c->ilen));
3603     for (i = 0; i < mbs; i++) {
3604       c->imax[i] = a->imax[i];
3605       c->ilen[i] = a->ilen[i];
3606     }
3607     c->free_imax_ilen = PETSC_TRUE;
3608   }
3609 
3610   /* allocate the matrix space */
3611   if (mallocmatspace) {
3612     if (cpvalues == MAT_SHARE_NONZERO_PATTERN) {
3613       PetscCall(PetscCalloc1(bs2 * nz, &c->a));
3614 
3615       c->i            = a->i;
3616       c->j            = a->j;
3617       c->singlemalloc = PETSC_FALSE;
3618       c->free_a       = PETSC_TRUE;
3619       c->free_ij      = PETSC_FALSE;
3620       c->parent       = A;
3621       C->preallocated = PETSC_TRUE;
3622       C->assembled    = PETSC_TRUE;
3623 
3624       PetscCall(PetscObjectReference((PetscObject)A));
3625       PetscCall(MatSetOption(A, MAT_NEW_NONZERO_LOCATION_ERR, PETSC_TRUE));
3626       PetscCall(MatSetOption(C, MAT_NEW_NONZERO_LOCATION_ERR, PETSC_TRUE));
3627     } else {
3628       PetscCall(PetscMalloc3(bs2 * nz, &c->a, nz, &c->j, mbs + 1, &c->i));
3629 
3630       c->singlemalloc = PETSC_TRUE;
3631       c->free_a       = PETSC_TRUE;
3632       c->free_ij      = PETSC_TRUE;
3633 
3634       PetscCall(PetscArraycpy(c->i, a->i, mbs + 1));
3635       if (mbs > 0) {
3636         PetscCall(PetscArraycpy(c->j, a->j, nz));
3637         if (cpvalues == MAT_COPY_VALUES) {
3638           PetscCall(PetscArraycpy(c->a, a->a, bs2 * nz));
3639         } else {
3640           PetscCall(PetscArrayzero(c->a, bs2 * nz));
3641         }
3642       }
3643       C->preallocated = PETSC_TRUE;
3644       C->assembled    = PETSC_TRUE;
3645     }
3646   }
3647 
3648   c->roworiented = a->roworiented;
3649   c->nonew       = a->nonew;
3650 
3651   PetscCall(PetscLayoutReference(A->rmap, &C->rmap));
3652   PetscCall(PetscLayoutReference(A->cmap, &C->cmap));
3653 
3654   c->bs2 = a->bs2;
3655   c->mbs = a->mbs;
3656   c->nbs = a->nbs;
3657 
3658   if (a->diag) {
3659     if (cpvalues == MAT_SHARE_NONZERO_PATTERN) {
3660       c->diag      = a->diag;
3661       c->free_diag = PETSC_FALSE;
3662     } else {
3663       PetscCall(PetscMalloc1(mbs + 1, &c->diag));
3664       for (i = 0; i < mbs; i++) c->diag[i] = a->diag[i];
3665       c->free_diag = PETSC_TRUE;
3666     }
3667   } else c->diag = NULL;
3668 
3669   c->nz         = a->nz;
3670   c->maxnz      = a->nz; /* Since we allocate exactly the right amount */
3671   c->solve_work = NULL;
3672   c->mult_work  = NULL;
3673   c->sor_workt  = NULL;
3674   c->sor_work   = NULL;
3675 
3676   c->compressedrow.use   = a->compressedrow.use;
3677   c->compressedrow.nrows = a->compressedrow.nrows;
3678   if (a->compressedrow.use) {
3679     i = a->compressedrow.nrows;
3680     PetscCall(PetscMalloc2(i + 1, &c->compressedrow.i, i + 1, &c->compressedrow.rindex));
3681     PetscCall(PetscArraycpy(c->compressedrow.i, a->compressedrow.i, i + 1));
3682     PetscCall(PetscArraycpy(c->compressedrow.rindex, a->compressedrow.rindex, i));
3683   } else {
3684     c->compressedrow.use    = PETSC_FALSE;
3685     c->compressedrow.i      = NULL;
3686     c->compressedrow.rindex = NULL;
3687   }
3688   c->nonzerorowcnt = a->nonzerorowcnt;
3689   C->nonzerostate  = A->nonzerostate;
3690 
3691   PetscCall(PetscFunctionListDuplicate(((PetscObject)A)->qlist, &((PetscObject)C)->qlist));
3692   PetscFunctionReturn(PETSC_SUCCESS);
3693 }
3694 
3695 PetscErrorCode MatDuplicate_SeqBAIJ(Mat A, MatDuplicateOption cpvalues, Mat *B)
3696 {
3697   PetscFunctionBegin;
3698   PetscCall(MatCreate(PetscObjectComm((PetscObject)A), B));
3699   PetscCall(MatSetSizes(*B, A->rmap->N, A->cmap->n, A->rmap->N, A->cmap->n));
3700   PetscCall(MatSetType(*B, MATSEQBAIJ));
3701   PetscCall(MatDuplicateNoCreate_SeqBAIJ(*B, A, cpvalues, PETSC_TRUE));
3702   PetscFunctionReturn(PETSC_SUCCESS);
3703 }
3704 
3705 /* Used for both SeqBAIJ and SeqSBAIJ matrices */
3706 PetscErrorCode MatLoad_SeqBAIJ_Binary(Mat mat, PetscViewer viewer)
3707 {
3708   PetscInt     header[4], M, N, nz, bs, m, n, mbs, nbs, rows, cols, sum, i, j, k;
3709   PetscInt    *rowidxs, *colidxs;
3710   PetscScalar *matvals;
3711 
3712   PetscFunctionBegin;
3713   PetscCall(PetscViewerSetUp(viewer));
3714 
3715   /* read matrix header */
3716   PetscCall(PetscViewerBinaryRead(viewer, header, 4, NULL, PETSC_INT));
3717   PetscCheck(header[0] == MAT_FILE_CLASSID, PETSC_COMM_SELF, PETSC_ERR_FILE_UNEXPECTED, "Not a matrix object in file");
3718   M  = header[1];
3719   N  = header[2];
3720   nz = header[3];
3721   PetscCheck(M >= 0, PetscObjectComm((PetscObject)viewer), PETSC_ERR_FILE_UNEXPECTED, "Matrix row size (%" PetscInt_FMT ") in file is negative", M);
3722   PetscCheck(N >= 0, PetscObjectComm((PetscObject)viewer), PETSC_ERR_FILE_UNEXPECTED, "Matrix column size (%" PetscInt_FMT ") in file is negative", N);
3723   PetscCheck(nz >= 0, PETSC_COMM_SELF, PETSC_ERR_FILE_UNEXPECTED, "Matrix stored in special format on disk, cannot load as SeqBAIJ");
3724 
3725   /* set block sizes from the viewer's .info file */
3726   PetscCall(MatLoad_Binary_BlockSizes(mat, viewer));
3727   /* set local and global sizes if not set already */
3728   if (mat->rmap->n < 0) mat->rmap->n = M;
3729   if (mat->cmap->n < 0) mat->cmap->n = N;
3730   if (mat->rmap->N < 0) mat->rmap->N = M;
3731   if (mat->cmap->N < 0) mat->cmap->N = N;
3732   PetscCall(PetscLayoutSetUp(mat->rmap));
3733   PetscCall(PetscLayoutSetUp(mat->cmap));
3734 
3735   /* check if the matrix sizes are correct */
3736   PetscCall(MatGetSize(mat, &rows, &cols));
3737   PetscCheck(M == rows && N == cols, PETSC_COMM_SELF, PETSC_ERR_FILE_UNEXPECTED, "Matrix in file of different sizes (%" PetscInt_FMT ", %" PetscInt_FMT ") than the input matrix (%" PetscInt_FMT ", %" PetscInt_FMT ")", M, N, rows, cols);
3738   PetscCall(MatGetBlockSize(mat, &bs));
3739   PetscCall(MatGetLocalSize(mat, &m, &n));
3740   mbs = m / bs;
3741   nbs = n / bs;
3742 
3743   /* read in row lengths, column indices and nonzero values */
3744   PetscCall(PetscMalloc1(m + 1, &rowidxs));
3745   PetscCall(PetscViewerBinaryRead(viewer, rowidxs + 1, m, NULL, PETSC_INT));
3746   rowidxs[0] = 0;
3747   for (i = 0; i < m; i++) rowidxs[i + 1] += rowidxs[i];
3748   sum = rowidxs[m];
3749   PetscCheck(sum == nz, PETSC_COMM_SELF, PETSC_ERR_FILE_UNEXPECTED, "Inconsistent matrix data in file: nonzeros = %" PetscInt_FMT ", sum-row-lengths = %" PetscInt_FMT, nz, sum);
3750 
3751   /* read in column indices and nonzero values */
3752   PetscCall(PetscMalloc2(rowidxs[m], &colidxs, nz, &matvals));
3753   PetscCall(PetscViewerBinaryRead(viewer, colidxs, rowidxs[m], NULL, PETSC_INT));
3754   PetscCall(PetscViewerBinaryRead(viewer, matvals, rowidxs[m], NULL, PETSC_SCALAR));
3755 
3756   {               /* preallocate matrix storage */
3757     PetscBT   bt; /* helper bit set to count nonzeros */
3758     PetscInt *nnz;
3759     PetscBool sbaij;
3760 
3761     PetscCall(PetscBTCreate(nbs, &bt));
3762     PetscCall(PetscCalloc1(mbs, &nnz));
3763     PetscCall(PetscObjectTypeCompare((PetscObject)mat, MATSEQSBAIJ, &sbaij));
3764     for (i = 0; i < mbs; i++) {
3765       PetscCall(PetscBTMemzero(nbs, bt));
3766       for (k = 0; k < bs; k++) {
3767         PetscInt row = bs * i + k;
3768         for (j = rowidxs[row]; j < rowidxs[row + 1]; j++) {
3769           PetscInt col = colidxs[j];
3770           if (!sbaij || col >= row)
3771             if (!PetscBTLookupSet(bt, col / bs)) nnz[i]++;
3772         }
3773       }
3774     }
3775     PetscCall(PetscBTDestroy(&bt));
3776     PetscCall(MatSeqBAIJSetPreallocation(mat, bs, 0, nnz));
3777     PetscCall(MatSeqSBAIJSetPreallocation(mat, bs, 0, nnz));
3778     PetscCall(PetscFree(nnz));
3779   }
3780 
3781   /* store matrix values */
3782   for (i = 0; i < m; i++) {
3783     PetscInt row = i, s = rowidxs[i], e = rowidxs[i + 1];
3784     PetscUseTypeMethod(mat, setvalues, 1, &row, e - s, colidxs + s, matvals + s, INSERT_VALUES);
3785   }
3786 
3787   PetscCall(PetscFree(rowidxs));
3788   PetscCall(PetscFree2(colidxs, matvals));
3789   PetscCall(MatAssemblyBegin(mat, MAT_FINAL_ASSEMBLY));
3790   PetscCall(MatAssemblyEnd(mat, MAT_FINAL_ASSEMBLY));
3791   PetscFunctionReturn(PETSC_SUCCESS);
3792 }
3793 
3794 PetscErrorCode MatLoad_SeqBAIJ(Mat mat, PetscViewer viewer)
3795 {
3796   PetscBool isbinary;
3797 
3798   PetscFunctionBegin;
3799   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERBINARY, &isbinary));
3800   PetscCheck(isbinary, PetscObjectComm((PetscObject)viewer), PETSC_ERR_SUP, "Viewer type %s not yet supported for reading %s matrices", ((PetscObject)viewer)->type_name, ((PetscObject)mat)->type_name);
3801   PetscCall(MatLoad_SeqBAIJ_Binary(mat, viewer));
3802   PetscFunctionReturn(PETSC_SUCCESS);
3803 }
3804 
3805 /*@C
3806   MatCreateSeqBAIJ - Creates a sparse matrix in `MATSEQAIJ` (block
3807   compressed row) format.  For good matrix assembly performance the
3808   user should preallocate the matrix storage by setting the parameter `nz`
3809   (or the array `nnz`).
3810 
3811   Collective
3812 
3813   Input Parameters:
3814 + comm - MPI communicator, set to `PETSC_COMM_SELF`
3815 . bs   - size of block, the blocks are ALWAYS square. One can use `MatSetBlockSizes()` to set a different row and column blocksize but the row
3816          blocksize always defines the size of the blocks. The column blocksize sets the blocksize of the vectors obtained with `MatCreateVecs()`
3817 . m    - number of rows
3818 . n    - number of columns
3819 . nz   - number of nonzero blocks  per block row (same for all rows)
3820 - nnz  - array containing the number of nonzero blocks in the various block rows
3821          (possibly different for each block row) or `NULL`
3822 
3823   Output Parameter:
3824 . A - the matrix
3825 
3826   Options Database Keys:
3827 + -mat_no_unroll  - uses code that does not unroll the loops in the block calculations (much slower)
3828 - -mat_block_size - size of the blocks to use
3829 
3830   Level: intermediate
3831 
3832   Notes:
3833   It is recommended that one use `MatCreateFromOptions()` or the `MatCreate()`, `MatSetType()` and/or `MatSetFromOptions()`,
3834   MatXXXXSetPreallocation() paradigm instead of this routine directly.
3835   [MatXXXXSetPreallocation() is, for example, `MatSeqAIJSetPreallocation()`]
3836 
3837   The number of rows and columns must be divisible by blocksize.
3838 
3839   If the `nnz` parameter is given then the `nz` parameter is ignored
3840 
3841   A nonzero block is any block that as 1 or more nonzeros in it
3842 
3843   The `MATSEQBAIJ` format is fully compatible with standard Fortran
3844   storage.  That is, the stored row and column indices can begin at
3845   either one (as in Fortran) or zero.
3846 
3847   Specify the preallocated storage with either `nz` or `nnz` (not both).
3848   Set `nz` = `PETSC_DEFAULT` and `nnz` = `NULL` for PETSc to control dynamic memory
3849   allocation.  See [Sparse Matrices](sec_matsparse) for details.
3850   matrices.
3851 
3852 .seealso: [](ch_matrices), `Mat`, [Sparse Matrices](sec_matsparse), `MatCreate()`, `MatCreateSeqAIJ()`, `MatSetValues()`, `MatCreateBAIJ()`
3853 @*/
3854 PetscErrorCode MatCreateSeqBAIJ(MPI_Comm comm, PetscInt bs, PetscInt m, PetscInt n, PetscInt nz, const PetscInt nnz[], Mat *A)
3855 {
3856   PetscFunctionBegin;
3857   PetscCall(MatCreate(comm, A));
3858   PetscCall(MatSetSizes(*A, m, n, m, n));
3859   PetscCall(MatSetType(*A, MATSEQBAIJ));
3860   PetscCall(MatSeqBAIJSetPreallocation(*A, bs, nz, (PetscInt *)nnz));
3861   PetscFunctionReturn(PETSC_SUCCESS);
3862 }
3863 
3864 /*@C
3865   MatSeqBAIJSetPreallocation - Sets the block size and expected nonzeros
3866   per row in the matrix. For good matrix assembly performance the
3867   user should preallocate the matrix storage by setting the parameter `nz`
3868   (or the array `nnz`).
3869 
3870   Collective
3871 
3872   Input Parameters:
3873 + B   - the matrix
3874 . bs  - size of block, the blocks are ALWAYS square. One can use `MatSetBlockSizes()` to set a different row and column blocksize but the row
3875         blocksize always defines the size of the blocks. The column blocksize sets the blocksize of the vectors obtained with `MatCreateVecs()`
3876 . nz  - number of block nonzeros per block row (same for all rows)
3877 - nnz - array containing the number of block nonzeros in the various block rows
3878         (possibly different for each block row) or `NULL`
3879 
3880   Options Database Keys:
3881 + -mat_no_unroll  - uses code that does not unroll the loops in the block calculations (much slower)
3882 - -mat_block_size - size of the blocks to use
3883 
3884   Level: intermediate
3885 
3886   Notes:
3887   If the `nnz` parameter is given then the `nz` parameter is ignored
3888 
3889   You can call `MatGetInfo()` to get information on how effective the preallocation was;
3890   for example the fields mallocs,nz_allocated,nz_used,nz_unneeded;
3891   You can also run with the option `-info` and look for messages with the string
3892   malloc in them to see if additional memory allocation was needed.
3893 
3894   The `MATSEQBAIJ` format is fully compatible with standard Fortran
3895   storage.  That is, the stored row and column indices can begin at
3896   either one (as in Fortran) or zero.
3897 
3898   Specify the preallocated storage with either `nz` or `nnz` (not both).
3899   Set `nz` = `PETSC_DEFAULT` and `nnz` = `NULL` for PETSc to control dynamic memory
3900   allocation.  See [Sparse Matrices](sec_matsparse) for details.
3901 
3902 .seealso: [](ch_matrices), `Mat`, [Sparse Matrices](sec_matsparse), `MatCreate()`, `MatCreateSeqAIJ()`, `MatSetValues()`, `MatCreateBAIJ()`, `MatGetInfo()`
3903 @*/
3904 PetscErrorCode MatSeqBAIJSetPreallocation(Mat B, PetscInt bs, PetscInt nz, const PetscInt nnz[])
3905 {
3906   PetscFunctionBegin;
3907   PetscValidHeaderSpecific(B, MAT_CLASSID, 1);
3908   PetscValidType(B, 1);
3909   PetscValidLogicalCollectiveInt(B, bs, 2);
3910   PetscTryMethod(B, "MatSeqBAIJSetPreallocation_C", (Mat, PetscInt, PetscInt, const PetscInt[]), (B, bs, nz, nnz));
3911   PetscFunctionReturn(PETSC_SUCCESS);
3912 }
3913 
3914 /*@C
3915   MatSeqBAIJSetPreallocationCSR - Creates a sparse sequential matrix in `MATSEQBAIJ` format using the given nonzero structure and (optional) numerical values
3916 
3917   Collective
3918 
3919   Input Parameters:
3920 + B  - the matrix
3921 . bs - the blocksize
3922 . i  - the indices into `j` for the start of each local row (indices start with zero)
3923 . j  - the column indices for each local row (indices start with zero) these must be sorted for each row
3924 - v  - optional values in the matrix, use `NULL` if not provided
3925 
3926   Level: advanced
3927 
3928   Notes:
3929   The `i`,`j`,`v` values are COPIED with this routine; to avoid the copy use `MatCreateSeqBAIJWithArrays()`
3930 
3931   The order of the entries in values is specified by the `MatOption` `MAT_ROW_ORIENTED`.  For example, C programs
3932   may want to use the default `MAT_ROW_ORIENTED` of `PETSC_TRUE` and use an array v[nnz][bs][bs] where the second index is
3933   over rows within a block and the last index is over columns within a block row.  Fortran programs will likely set
3934   `MAT_ROW_ORIENTED` of `PETSC_FALSE` and use a Fortran array v(bs,bs,nnz) in which the first index is over rows within a
3935   block column and the second index is over columns within a block.
3936 
3937   Though this routine has Preallocation() in the name it also sets the exact nonzero locations of the matrix entries and usually the numerical values as well
3938 
3939 .seealso: [](ch_matrices), `Mat`, `MatCreate()`, `MatCreateSeqBAIJ()`, `MatSetValues()`, `MatSeqBAIJSetPreallocation()`, `MATSEQBAIJ`
3940 @*/
3941 PetscErrorCode MatSeqBAIJSetPreallocationCSR(Mat B, PetscInt bs, const PetscInt i[], const PetscInt j[], const PetscScalar v[])
3942 {
3943   PetscFunctionBegin;
3944   PetscValidHeaderSpecific(B, MAT_CLASSID, 1);
3945   PetscValidType(B, 1);
3946   PetscValidLogicalCollectiveInt(B, bs, 2);
3947   PetscTryMethod(B, "MatSeqBAIJSetPreallocationCSR_C", (Mat, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[]), (B, bs, i, j, v));
3948   PetscFunctionReturn(PETSC_SUCCESS);
3949 }
3950 
3951 /*@
3952   MatCreateSeqBAIJWithArrays - Creates a `MATSEQBAIJ` matrix using matrix elements provided by the user.
3953 
3954   Collective
3955 
3956   Input Parameters:
3957 + comm - must be an MPI communicator of size 1
3958 . bs   - size of block
3959 . m    - number of rows
3960 . n    - number of columns
3961 . i    - row indices; that is i[0] = 0, i[row] = i[row-1] + number of elements in that row block row of the matrix
3962 . j    - column indices
3963 - a    - matrix values
3964 
3965   Output Parameter:
3966 . mat - the matrix
3967 
3968   Level: advanced
3969 
3970   Notes:
3971   The `i`, `j`, and `a` arrays are not copied by this routine, the user must free these arrays
3972   once the matrix is destroyed
3973 
3974   You cannot set new nonzero locations into this matrix, that will generate an error.
3975 
3976   The `i` and `j` indices are 0 based
3977 
3978   When block size is greater than 1 the matrix values must be stored using the `MATSEQBAIJ` storage format
3979 
3980   The order of the entries in values is the same as the block compressed sparse row storage format; that is, it is
3981   the same as a three dimensional array in Fortran values(bs,bs,nnz) that contains the first column of the first
3982   block, followed by the second column of the first block etc etc.  That is, the blocks are contiguous in memory
3983   with column-major ordering within blocks.
3984 
3985 .seealso: [](ch_matrices), `Mat`, `MatCreate()`, `MatCreateBAIJ()`, `MatCreateSeqBAIJ()`
3986 @*/
3987 PetscErrorCode MatCreateSeqBAIJWithArrays(MPI_Comm comm, PetscInt bs, PetscInt m, PetscInt n, PetscInt i[], PetscInt j[], PetscScalar a[], Mat *mat)
3988 {
3989   Mat_SeqBAIJ *baij;
3990 
3991   PetscFunctionBegin;
3992   PetscCheck(bs == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "block size %" PetscInt_FMT " > 1 is not supported yet", bs);
3993   if (m > 0) PetscCheck(i[0] == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "i (row indices) must start with 0");
3994 
3995   PetscCall(MatCreate(comm, mat));
3996   PetscCall(MatSetSizes(*mat, m, n, m, n));
3997   PetscCall(MatSetType(*mat, MATSEQBAIJ));
3998   PetscCall(MatSeqBAIJSetPreallocation(*mat, bs, MAT_SKIP_ALLOCATION, NULL));
3999   baij = (Mat_SeqBAIJ *)(*mat)->data;
4000   PetscCall(PetscMalloc2(m, &baij->imax, m, &baij->ilen));
4001 
4002   baij->i = i;
4003   baij->j = j;
4004   baij->a = a;
4005 
4006   baij->singlemalloc   = PETSC_FALSE;
4007   baij->nonew          = -1; /*this indicates that inserting a new value in the matrix that generates a new nonzero is an error*/
4008   baij->free_a         = PETSC_FALSE;
4009   baij->free_ij        = PETSC_FALSE;
4010   baij->free_imax_ilen = PETSC_TRUE;
4011 
4012   for (PetscInt ii = 0; ii < m; ii++) {
4013     const PetscInt row_len = i[ii + 1] - i[ii];
4014 
4015     baij->ilen[ii] = baij->imax[ii] = row_len;
4016     PetscCheck(row_len >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Negative row length in i (row indices) row = %" PetscInt_FMT " length = %" PetscInt_FMT, ii, row_len);
4017   }
4018   if (PetscDefined(USE_DEBUG)) {
4019     for (PetscInt ii = 0; ii < baij->i[m]; ii++) {
4020       PetscCheck(j[ii] >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Negative column index at location = %" PetscInt_FMT " index = %" PetscInt_FMT, ii, j[ii]);
4021       PetscCheck(j[ii] <= n - 1, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Column index to large at location = %" PetscInt_FMT " index = %" PetscInt_FMT, ii, j[ii]);
4022     }
4023   }
4024 
4025   PetscCall(MatAssemblyBegin(*mat, MAT_FINAL_ASSEMBLY));
4026   PetscCall(MatAssemblyEnd(*mat, MAT_FINAL_ASSEMBLY));
4027   PetscFunctionReturn(PETSC_SUCCESS);
4028 }
4029 
4030 PetscErrorCode MatCreateMPIMatConcatenateSeqMat_SeqBAIJ(MPI_Comm comm, Mat inmat, PetscInt n, MatReuse scall, Mat *outmat)
4031 {
4032   PetscFunctionBegin;
4033   PetscCall(MatCreateMPIMatConcatenateSeqMat_MPIBAIJ(comm, inmat, n, scall, outmat));
4034   PetscFunctionReturn(PETSC_SUCCESS);
4035 }
4036