xref: /petsc/src/mat/impls/sbaij/seq/sbaij.c (revision e37c518b3c178882b922d1d3faeb3ee252cb498a)
1 
2 /*
3     Defines the basic matrix operations for the SBAIJ (compressed row)
4   matrix storage format.
5 */
6 #include <../src/mat/impls/baij/seq/baij.h>         /*I "petscmat.h" I*/
7 #include <../src/mat/impls/sbaij/seq/sbaij.h>
8 #include <petscblaslapack.h>
9 
10 #include <../src/mat/impls/sbaij/seq/relax.h>
11 #define USESHORT
12 #include <../src/mat/impls/sbaij/seq/relax.h>
13 
14 extern PetscErrorCode MatSeqSBAIJSetNumericFactorization_inplace(Mat,PetscBool);
15 #if defined(PETSC_HAVE_ELEMENTAL)
16 PETSC_INTERN PetscErrorCode MatConvert_SeqSBAIJ_Elemental(Mat,MatType,MatReuse,Mat*);
17 #endif
18 
19 /*
20      Checks for missing diagonals
21 */
22 #undef __FUNCT__
23 #define __FUNCT__ "MatMissingDiagonal_SeqSBAIJ"
24 PetscErrorCode MatMissingDiagonal_SeqSBAIJ(Mat A,PetscBool  *missing,PetscInt *dd)
25 {
26   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data;
27   PetscErrorCode ierr;
28   PetscInt       *diag,*ii = a->i,i;
29 
30   PetscFunctionBegin;
31   ierr     = MatMarkDiagonal_SeqSBAIJ(A);CHKERRQ(ierr);
32   *missing = PETSC_FALSE;
33   if (A->rmap->n > 0 && !ii) {
34     *missing = PETSC_TRUE;
35     if (dd) *dd = 0;
36     ierr = PetscInfo(A,"Matrix has no entries therefore is missing diagonal\n");CHKERRQ(ierr);
37   } else {
38     diag = a->diag;
39     for (i=0; i<a->mbs; i++) {
40       if (diag[i] >= ii[i+1]) {
41         *missing = PETSC_TRUE;
42         if (dd) *dd = i;
43         break;
44       }
45     }
46   }
47   PetscFunctionReturn(0);
48 }
49 
50 #undef __FUNCT__
51 #define __FUNCT__ "MatMarkDiagonal_SeqSBAIJ"
52 PetscErrorCode MatMarkDiagonal_SeqSBAIJ(Mat A)
53 {
54   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data;
55   PetscErrorCode ierr;
56   PetscInt       i,j;
57 
58   PetscFunctionBegin;
59   if (!a->diag) {
60     ierr         = PetscMalloc1(a->mbs,&a->diag);CHKERRQ(ierr);
61     ierr         = PetscLogObjectMemory((PetscObject)A,a->mbs*sizeof(PetscInt));CHKERRQ(ierr);
62     a->free_diag = PETSC_TRUE;
63   }
64   for (i=0; i<a->mbs; i++) {
65     a->diag[i] = a->i[i+1];
66     for (j=a->i[i]; j<a->i[i+1]; j++) {
67       if (a->j[j] == i) {
68         a->diag[i] = j;
69         break;
70       }
71     }
72   }
73   PetscFunctionReturn(0);
74 }
75 
76 #undef __FUNCT__
77 #define __FUNCT__ "MatGetRowIJ_SeqSBAIJ"
78 static PetscErrorCode MatGetRowIJ_SeqSBAIJ(Mat A,PetscInt oshift,PetscBool symmetric,PetscBool blockcompressed,PetscInt *nn,const PetscInt *inia[],const PetscInt *inja[],PetscBool  *done)
79 {
80   Mat_SeqSBAIJ    *a = (Mat_SeqSBAIJ*)A->data;
81   PetscErrorCode ierr;
82   PetscInt       i,j,n = a->mbs,nz = a->i[n],*tia,*tja,bs = A->rmap->bs,k,l,cnt;
83   PetscInt       **ia = (PetscInt**)inia,**ja = (PetscInt**)inja;
84 
85   PetscFunctionBegin;
86   *nn = n;
87   if (!ia) PetscFunctionReturn(0);
88   if (symmetric) {
89     ierr = MatToSymmetricIJ_SeqAIJ(n,a->i,a->j,PETSC_FALSE,0,0,&tia,&tja);CHKERRQ(ierr);
90     nz   = tia[n];
91   } else {
92     tia = a->i; tja = a->j;
93   }
94 
95   if (!blockcompressed && bs > 1) {
96     (*nn) *= bs;
97     /* malloc & create the natural set of indices */
98     ierr = PetscMalloc1((n+1)*bs,ia);CHKERRQ(ierr);
99     if (n) {
100       (*ia)[0] = oshift;
101       for (j=1; j<bs; j++) {
102         (*ia)[j] = (tia[1]-tia[0])*bs+(*ia)[j-1];
103       }
104     }
105 
106     for (i=1; i<n; i++) {
107       (*ia)[i*bs] = (tia[i]-tia[i-1])*bs + (*ia)[i*bs-1];
108       for (j=1; j<bs; j++) {
109         (*ia)[i*bs+j] = (tia[i+1]-tia[i])*bs + (*ia)[i*bs+j-1];
110       }
111     }
112     if (n) {
113       (*ia)[n*bs] = (tia[n]-tia[n-1])*bs + (*ia)[n*bs-1];
114     }
115 
116     if (inja) {
117       ierr = PetscMalloc1(nz*bs*bs,ja);CHKERRQ(ierr);
118       cnt = 0;
119       for (i=0; i<n; i++) {
120         for (j=0; j<bs; j++) {
121           for (k=tia[i]; k<tia[i+1]; k++) {
122             for (l=0; l<bs; l++) {
123               (*ja)[cnt++] = bs*tja[k] + l;
124             }
125           }
126         }
127       }
128     }
129 
130     if (symmetric) { /* deallocate memory allocated in MatToSymmetricIJ_SeqAIJ() */
131       ierr = PetscFree(tia);CHKERRQ(ierr);
132       ierr = PetscFree(tja);CHKERRQ(ierr);
133     }
134   } else if (oshift == 1) {
135     if (symmetric) {
136       nz = tia[A->rmap->n/bs];
137       /*  add 1 to i and j indices */
138       for (i=0; i<A->rmap->n/bs+1; i++) tia[i] = tia[i] + 1;
139       *ia = tia;
140       if (ja) {
141         for (i=0; i<nz; i++) tja[i] = tja[i] + 1;
142         *ja = tja;
143       }
144     } else {
145       nz = a->i[A->rmap->n/bs];
146       /* malloc space and  add 1 to i and j indices */
147       ierr = PetscMalloc1(A->rmap->n/bs+1,ia);CHKERRQ(ierr);
148       for (i=0; i<A->rmap->n/bs+1; i++) (*ia)[i] = a->i[i] + 1;
149       if (ja) {
150         ierr = PetscMalloc1(nz,ja);CHKERRQ(ierr);
151         for (i=0; i<nz; i++) (*ja)[i] = a->j[i] + 1;
152       }
153     }
154   } else {
155     *ia = tia;
156     if (ja) *ja = tja;
157   }
158   PetscFunctionReturn(0);
159 }
160 
161 #undef __FUNCT__
162 #define __FUNCT__ "MatRestoreRowIJ_SeqSBAIJ"
163 static PetscErrorCode MatRestoreRowIJ_SeqSBAIJ(Mat A,PetscInt oshift,PetscBool symmetric,PetscBool blockcompressed,PetscInt *nn,const PetscInt *ia[],const PetscInt *ja[],PetscBool  *done)
164 {
165   PetscErrorCode ierr;
166 
167   PetscFunctionBegin;
168   if (!ia) PetscFunctionReturn(0);
169   if ((!blockcompressed && A->rmap->bs > 1) || (symmetric || oshift == 1)) {
170     ierr = PetscFree(*ia);CHKERRQ(ierr);
171     if (ja) {ierr = PetscFree(*ja);CHKERRQ(ierr);}
172   }
173   PetscFunctionReturn(0);
174 }
175 
176 #undef __FUNCT__
177 #define __FUNCT__ "MatDestroy_SeqSBAIJ"
178 PetscErrorCode MatDestroy_SeqSBAIJ(Mat A)
179 {
180   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data;
181   PetscErrorCode ierr;
182 
183   PetscFunctionBegin;
184 #if defined(PETSC_USE_LOG)
185   PetscLogObjectState((PetscObject)A,"Rows=%D, NZ=%D",A->rmap->N,a->nz);
186 #endif
187   ierr = MatSeqXAIJFreeAIJ(A,&a->a,&a->j,&a->i);CHKERRQ(ierr);
188   if (a->free_diag) {ierr = PetscFree(a->diag);CHKERRQ(ierr);}
189   ierr = ISDestroy(&a->row);CHKERRQ(ierr);
190   ierr = ISDestroy(&a->col);CHKERRQ(ierr);
191   ierr = ISDestroy(&a->icol);CHKERRQ(ierr);
192   ierr = PetscFree(a->idiag);CHKERRQ(ierr);
193   ierr = PetscFree(a->inode.size);CHKERRQ(ierr);
194   if (a->free_imax_ilen) {ierr = PetscFree2(a->imax,a->ilen);CHKERRQ(ierr);}
195   ierr = PetscFree(a->solve_work);CHKERRQ(ierr);
196   ierr = PetscFree(a->sor_work);CHKERRQ(ierr);
197   ierr = PetscFree(a->solves_work);CHKERRQ(ierr);
198   ierr = PetscFree(a->mult_work);CHKERRQ(ierr);
199   ierr = PetscFree(a->saved_values);CHKERRQ(ierr);
200   if (a->free_jshort) {ierr = PetscFree(a->jshort);CHKERRQ(ierr);}
201   ierr = PetscFree(a->inew);CHKERRQ(ierr);
202   ierr = MatDestroy(&a->parent);CHKERRQ(ierr);
203   ierr = PetscFree(A->data);CHKERRQ(ierr);
204 
205   ierr = PetscObjectChangeTypeName((PetscObject)A,0);CHKERRQ(ierr);
206   ierr = PetscObjectComposeFunction((PetscObject)A,"MatStoreValues_C",NULL);CHKERRQ(ierr);
207   ierr = PetscObjectComposeFunction((PetscObject)A,"MatRetrieveValues_C",NULL);CHKERRQ(ierr);
208   ierr = PetscObjectComposeFunction((PetscObject)A,"MatSeqSBAIJSetColumnIndices_C",NULL);CHKERRQ(ierr);
209   ierr = PetscObjectComposeFunction((PetscObject)A,"MatConvert_seqsbaij_seqaij_C",NULL);CHKERRQ(ierr);
210   ierr = PetscObjectComposeFunction((PetscObject)A,"MatConvert_seqsbaij_seqbaij_C",NULL);CHKERRQ(ierr);
211   ierr = PetscObjectComposeFunction((PetscObject)A,"MatSeqSBAIJSetPreallocation_C",NULL);CHKERRQ(ierr);
212   ierr = PetscObjectComposeFunction((PetscObject)A,"MatSeqSBAIJSetPreallocationCSR_C",NULL);CHKERRQ(ierr);
213   ierr = PetscObjectComposeFunction((PetscObject)A,"MatConvert_seqsbaij_seqsbstrm_C",NULL);CHKERRQ(ierr);
214 #if defined(PETSC_HAVE_ELEMENTAL)
215   ierr = PetscObjectComposeFunction((PetscObject)A,"MatConvert_seqsbaij_elemental_C",NULL);CHKERRQ(ierr);
216 #endif
217   PetscFunctionReturn(0);
218 }
219 
220 #undef __FUNCT__
221 #define __FUNCT__ "MatSetOption_SeqSBAIJ"
222 PetscErrorCode MatSetOption_SeqSBAIJ(Mat A,MatOption op,PetscBool flg)
223 {
224   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data;
225   PetscErrorCode ierr;
226 
227   PetscFunctionBegin;
228   switch (op) {
229   case MAT_ROW_ORIENTED:
230     a->roworiented = flg;
231     break;
232   case MAT_KEEP_NONZERO_PATTERN:
233     a->keepnonzeropattern = flg;
234     break;
235   case MAT_NEW_NONZERO_LOCATIONS:
236     a->nonew = (flg ? 0 : 1);
237     break;
238   case MAT_NEW_NONZERO_LOCATION_ERR:
239     a->nonew = (flg ? -1 : 0);
240     break;
241   case MAT_NEW_NONZERO_ALLOCATION_ERR:
242     a->nonew = (flg ? -2 : 0);
243     break;
244   case MAT_UNUSED_NONZERO_LOCATION_ERR:
245     a->nounused = (flg ? -1 : 0);
246     break;
247   case MAT_NEW_DIAGONALS:
248   case MAT_IGNORE_OFF_PROC_ENTRIES:
249   case MAT_USE_HASH_TABLE:
250     ierr = PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);CHKERRQ(ierr);
251     break;
252   case MAT_HERMITIAN:
253     if (!A->assembled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Must call MatAssemblyEnd() first");
254     if (A->cmap->n < 65536 && A->cmap->bs == 1) {
255       A->ops->mult = MatMult_SeqSBAIJ_1_Hermitian_ushort;
256     } else if (A->cmap->bs == 1) {
257       A->ops->mult = MatMult_SeqSBAIJ_1_Hermitian;
258     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for Hermitian with block size greater than 1");
259     break;
260   case MAT_SPD:
261     /* These options are handled directly by MatSetOption() */
262     break;
263   case MAT_SYMMETRIC:
264   case MAT_STRUCTURALLY_SYMMETRIC:
265   case MAT_SYMMETRY_ETERNAL:
266     /* These options are handled directly by MatSetOption() */
267     break;
268   case MAT_IGNORE_LOWER_TRIANGULAR:
269     a->ignore_ltriangular = flg;
270     break;
271   case MAT_ERROR_LOWER_TRIANGULAR:
272     a->ignore_ltriangular = flg;
273     break;
274   case MAT_GETROW_UPPERTRIANGULAR:
275     a->getrow_utriangular = flg;
276     break;
277   default:
278     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unknown option %d",op);
279   }
280   PetscFunctionReturn(0);
281 }
282 
283 #undef __FUNCT__
284 #define __FUNCT__ "MatGetRow_SeqSBAIJ"
285 PetscErrorCode MatGetRow_SeqSBAIJ(Mat A,PetscInt row,PetscInt *nz,PetscInt **idx,PetscScalar **v)
286 {
287   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data;
288   PetscErrorCode ierr;
289 
290   PetscFunctionBegin;
291   if (A && !a->getrow_utriangular) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"MatGetRow is not supported for SBAIJ matrix format. Getting the upper triangular part of row, run with -mat_getrow_uppertriangular, call MatSetOption(mat,MAT_GETROW_UPPERTRIANGULAR,PETSC_TRUE) or MatGetRowUpperTriangular()");
292 
293   /* Get the upper triangular part of the row */
294   ierr = MatGetRow_SeqBAIJ_private(A,row,nz,idx,v,a->i,a->j,a->a);CHKERRQ(ierr);
295   PetscFunctionReturn(0);
296 }
297 
298 #undef __FUNCT__
299 #define __FUNCT__ "MatRestoreRow_SeqSBAIJ"
300 PetscErrorCode MatRestoreRow_SeqSBAIJ(Mat A,PetscInt row,PetscInt *nz,PetscInt **idx,PetscScalar **v)
301 {
302   PetscErrorCode ierr;
303 
304   PetscFunctionBegin;
305   if (idx) {ierr = PetscFree(*idx);CHKERRQ(ierr);}
306   if (v)   {ierr = PetscFree(*v);CHKERRQ(ierr);}
307   PetscFunctionReturn(0);
308 }
309 
310 #undef __FUNCT__
311 #define __FUNCT__ "MatGetRowUpperTriangular_SeqSBAIJ"
312 PetscErrorCode MatGetRowUpperTriangular_SeqSBAIJ(Mat A)
313 {
314   Mat_SeqSBAIJ *a = (Mat_SeqSBAIJ*)A->data;
315 
316   PetscFunctionBegin;
317   a->getrow_utriangular = PETSC_TRUE;
318   PetscFunctionReturn(0);
319 }
320 #undef __FUNCT__
321 #define __FUNCT__ "MatRestoreRowUpperTriangular_SeqSBAIJ"
322 PetscErrorCode MatRestoreRowUpperTriangular_SeqSBAIJ(Mat A)
323 {
324   Mat_SeqSBAIJ *a = (Mat_SeqSBAIJ*)A->data;
325 
326   PetscFunctionBegin;
327   a->getrow_utriangular = PETSC_FALSE;
328   PetscFunctionReturn(0);
329 }
330 
331 #undef __FUNCT__
332 #define __FUNCT__ "MatTranspose_SeqSBAIJ"
333 PetscErrorCode MatTranspose_SeqSBAIJ(Mat A,MatReuse reuse,Mat *B)
334 {
335   PetscErrorCode ierr;
336 
337   PetscFunctionBegin;
338   if (reuse == MAT_INITIAL_MATRIX || *B != A) {
339     ierr = MatDuplicate(A,MAT_COPY_VALUES,B);CHKERRQ(ierr);
340   }
341   PetscFunctionReturn(0);
342 }
343 
344 #undef __FUNCT__
345 #define __FUNCT__ "MatView_SeqSBAIJ_ASCII"
346 PetscErrorCode MatView_SeqSBAIJ_ASCII(Mat A,PetscViewer viewer)
347 {
348   Mat_SeqSBAIJ      *a = (Mat_SeqSBAIJ*)A->data;
349   PetscErrorCode    ierr;
350   PetscInt          i,j,bs = A->rmap->bs,k,l,bs2=a->bs2;
351   PetscViewerFormat format;
352   PetscInt          *diag;
353 
354   PetscFunctionBegin;
355   ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
356   if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
357     ierr = PetscViewerASCIIPrintf(viewer,"  block size is %D\n",bs);CHKERRQ(ierr);
358   } else if (format == PETSC_VIEWER_ASCII_MATLAB) {
359     Mat        aij;
360     const char *matname;
361 
362     if (A->factortype && bs>1) {
363       ierr = PetscPrintf(PETSC_COMM_SELF,"Warning: matrix is factored with bs>1. MatView() with PETSC_VIEWER_ASCII_MATLAB is not supported and ignored!\n");CHKERRQ(ierr);
364       PetscFunctionReturn(0);
365     }
366     ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&aij);CHKERRQ(ierr);
367     ierr = PetscObjectGetName((PetscObject)A,&matname);CHKERRQ(ierr);
368     ierr = PetscObjectSetName((PetscObject)aij,matname);CHKERRQ(ierr);
369     ierr = MatView(aij,viewer);CHKERRQ(ierr);
370     ierr = MatDestroy(&aij);CHKERRQ(ierr);
371   } else if (format == PETSC_VIEWER_ASCII_COMMON) {
372     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
373     for (i=0; i<a->mbs; i++) {
374       for (j=0; j<bs; j++) {
375         ierr = PetscViewerASCIIPrintf(viewer,"row %D:",i*bs+j);CHKERRQ(ierr);
376         for (k=a->i[i]; k<a->i[i+1]; k++) {
377           for (l=0; l<bs; l++) {
378 #if defined(PETSC_USE_COMPLEX)
379             if (PetscImaginaryPart(a->a[bs2*k + l*bs + j]) > 0.0 && PetscRealPart(a->a[bs2*k + l*bs + j]) != 0.0) {
380               ierr = PetscViewerASCIIPrintf(viewer," (%D, %g + %g i) ",bs*a->j[k]+l,
381                                             (double)PetscRealPart(a->a[bs2*k + l*bs + j]),(double)PetscImaginaryPart(a->a[bs2*k + l*bs + j]));CHKERRQ(ierr);
382             } else if (PetscImaginaryPart(a->a[bs2*k + l*bs + j]) < 0.0 && PetscRealPart(a->a[bs2*k + l*bs + j]) != 0.0) {
383               ierr = PetscViewerASCIIPrintf(viewer," (%D, %g - %g i) ",bs*a->j[k]+l,
384                                             (double)PetscRealPart(a->a[bs2*k + l*bs + j]),-(double)PetscImaginaryPart(a->a[bs2*k + l*bs + j]));CHKERRQ(ierr);
385             } else if (PetscRealPart(a->a[bs2*k + l*bs + j]) != 0.0) {
386               ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",bs*a->j[k]+l,(double)PetscRealPart(a->a[bs2*k + l*bs + j]));CHKERRQ(ierr);
387             }
388 #else
389             if (a->a[bs2*k + l*bs + j] != 0.0) {
390               ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",bs*a->j[k]+l,(double)a->a[bs2*k + l*bs + j]);CHKERRQ(ierr);
391             }
392 #endif
393           }
394         }
395         ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
396       }
397     }
398     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
399   } else if (format == PETSC_VIEWER_ASCII_FACTOR_INFO) {
400     PetscFunctionReturn(0);
401   } else {
402     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
403     if (A->factortype) { /* for factored matrix */
404       if (bs>1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"matrix is factored with bs>1. Not implemented yet");
405 
406       diag=a->diag;
407       for (i=0; i<a->mbs; i++) { /* for row block i */
408         ierr = PetscViewerASCIIPrintf(viewer,"row %D:",i);CHKERRQ(ierr);
409         /* diagonal entry */
410 #if defined(PETSC_USE_COMPLEX)
411         if (PetscImaginaryPart(a->a[diag[i]]) > 0.0) {
412           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g + %g i) ",a->j[diag[i]],(double)PetscRealPart(1.0/a->a[diag[i]]),(double)PetscImaginaryPart(1.0/a->a[diag[i]]));CHKERRQ(ierr);
413         } else if (PetscImaginaryPart(a->a[diag[i]]) < 0.0) {
414           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g - %g i) ",a->j[diag[i]],(double)PetscRealPart(1.0/a->a[diag[i]]),-(double)PetscImaginaryPart(1.0/a->a[diag[i]]));CHKERRQ(ierr);
415         } else {
416           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[diag[i]],(double)PetscRealPart(1.0/a->a[diag[i]]));CHKERRQ(ierr);
417         }
418 #else
419         ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[diag[i]],(double)(1.0/a->a[diag[i]]));CHKERRQ(ierr);
420 #endif
421         /* off-diagonal entries */
422         for (k=a->i[i]; k<a->i[i+1]-1; k++) {
423 #if defined(PETSC_USE_COMPLEX)
424           if (PetscImaginaryPart(a->a[k]) > 0.0) {
425             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g + %g i) ",bs*a->j[k],(double)PetscRealPart(a->a[k]),(double)PetscImaginaryPart(a->a[k]));CHKERRQ(ierr);
426           } else if (PetscImaginaryPart(a->a[k]) < 0.0) {
427             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g - %g i) ",bs*a->j[k],(double)PetscRealPart(a->a[k]),-(double)PetscImaginaryPart(a->a[k]));CHKERRQ(ierr);
428           } else {
429             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",bs*a->j[k],(double)PetscRealPart(a->a[k]));CHKERRQ(ierr);
430           }
431 #else
432           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[k],(double)a->a[k]);CHKERRQ(ierr);
433 #endif
434         }
435         ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
436       }
437 
438     } else { /* for non-factored matrix */
439       for (i=0; i<a->mbs; i++) { /* for row block i */
440         for (j=0; j<bs; j++) {   /* for row bs*i + j */
441           ierr = PetscViewerASCIIPrintf(viewer,"row %D:",i*bs+j);CHKERRQ(ierr);
442           for (k=a->i[i]; k<a->i[i+1]; k++) { /* for column block */
443             for (l=0; l<bs; l++) {            /* for column */
444 #if defined(PETSC_USE_COMPLEX)
445               if (PetscImaginaryPart(a->a[bs2*k + l*bs + j]) > 0.0) {
446                 ierr = PetscViewerASCIIPrintf(viewer," (%D, %g + %g i) ",bs*a->j[k]+l,
447                                               (double)PetscRealPart(a->a[bs2*k + l*bs + j]),(double)PetscImaginaryPart(a->a[bs2*k + l*bs + j]));CHKERRQ(ierr);
448               } else if (PetscImaginaryPart(a->a[bs2*k + l*bs + j]) < 0.0) {
449                 ierr = PetscViewerASCIIPrintf(viewer," (%D, %g - %g i) ",bs*a->j[k]+l,
450                                               (double)PetscRealPart(a->a[bs2*k + l*bs + j]),-(double)PetscImaginaryPart(a->a[bs2*k + l*bs + j]));CHKERRQ(ierr);
451               } else {
452                 ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",bs*a->j[k]+l,(double)PetscRealPart(a->a[bs2*k + l*bs + j]));CHKERRQ(ierr);
453               }
454 #else
455               ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",bs*a->j[k]+l,(double)a->a[bs2*k + l*bs + j]);CHKERRQ(ierr);
456 #endif
457             }
458           }
459           ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
460         }
461       }
462     }
463     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
464   }
465   ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
466   PetscFunctionReturn(0);
467 }
468 
469 #include <petscdraw.h>
470 #undef __FUNCT__
471 #define __FUNCT__ "MatView_SeqSBAIJ_Draw_Zoom"
472 static PetscErrorCode MatView_SeqSBAIJ_Draw_Zoom(PetscDraw draw,void *Aa)
473 {
474   Mat            A = (Mat) Aa;
475   Mat_SeqSBAIJ   *a=(Mat_SeqSBAIJ*)A->data;
476   PetscErrorCode ierr;
477   PetscInt       row,i,j,k,l,mbs=a->mbs,color,bs=A->rmap->bs,bs2=a->bs2;
478   PetscReal      xl,yl,xr,yr,x_l,x_r,y_l,y_r;
479   MatScalar      *aa;
480   PetscViewer    viewer;
481 
482   PetscFunctionBegin;
483   ierr = PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);CHKERRQ(ierr);
484   ierr = PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);CHKERRQ(ierr);
485 
486   /* loop over matrix elements drawing boxes */
487 
488   ierr = PetscDrawCollectiveBegin(draw);CHKERRQ(ierr);
489   ierr = PetscDrawString(draw, .3*(xl+xr), .3*(yl+yr), PETSC_DRAW_BLACK, "symmetric");CHKERRQ(ierr);
490   /* Blue for negative, Cyan for zero and  Red for positive */
491   color = PETSC_DRAW_BLUE;
492   for (i=0,row=0; i<mbs; i++,row+=bs) {
493     for (j=a->i[i]; j<a->i[i+1]; j++) {
494       y_l = A->rmap->N - row - 1.0; y_r = y_l + 1.0;
495       x_l = a->j[j]*bs; x_r = x_l + 1.0;
496       aa  = a->a + j*bs2;
497       for (k=0; k<bs; k++) {
498         for (l=0; l<bs; l++) {
499           if (PetscRealPart(*aa++) >=  0.) continue;
500           ierr = PetscDrawRectangle(draw,x_l+k,y_l-l,x_r+k,y_r-l,color,color,color,color);CHKERRQ(ierr);
501         }
502       }
503     }
504   }
505   color = PETSC_DRAW_CYAN;
506   for (i=0,row=0; i<mbs; i++,row+=bs) {
507     for (j=a->i[i]; j<a->i[i+1]; j++) {
508       y_l = A->rmap->N - row - 1.0; y_r = y_l + 1.0;
509       x_l = a->j[j]*bs; x_r = x_l + 1.0;
510       aa = a->a + j*bs2;
511       for (k=0; k<bs; k++) {
512         for (l=0; l<bs; l++) {
513           if (PetscRealPart(*aa++) != 0.) continue;
514           ierr = PetscDrawRectangle(draw,x_l+k,y_l-l,x_r+k,y_r-l,color,color,color,color);CHKERRQ(ierr);
515         }
516       }
517     }
518   }
519   color = PETSC_DRAW_RED;
520   for (i=0,row=0; i<mbs; i++,row+=bs) {
521     for (j=a->i[i]; j<a->i[i+1]; j++) {
522       y_l = A->rmap->N - row - 1.0; y_r = y_l + 1.0;
523       x_l = a->j[j]*bs; x_r = x_l + 1.0;
524       aa = a->a + j*bs2;
525       for (k=0; k<bs; k++) {
526         for (l=0; l<bs; l++) {
527           if (PetscRealPart(*aa++) <= 0.) continue;
528           ierr = PetscDrawRectangle(draw,x_l+k,y_l-l,x_r+k,y_r-l,color,color,color,color);CHKERRQ(ierr);
529         }
530       }
531     }
532   }
533   ierr = PetscDrawCollectiveEnd(draw);CHKERRQ(ierr);
534   PetscFunctionReturn(0);
535 }
536 
537 #undef __FUNCT__
538 #define __FUNCT__ "MatView_SeqSBAIJ_Draw"
539 static PetscErrorCode MatView_SeqSBAIJ_Draw(Mat A,PetscViewer viewer)
540 {
541   PetscErrorCode ierr;
542   PetscReal      xl,yl,xr,yr,w,h;
543   PetscDraw      draw;
544   PetscBool      isnull;
545 
546   PetscFunctionBegin;
547   ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
548   ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr);
549   if (isnull) PetscFunctionReturn(0);
550 
551   xr   = A->rmap->N; yr = A->rmap->N; h = yr/10.0; w = xr/10.0;
552   xr  += w;          yr += h;        xl = -w;     yl = -h;
553   ierr = PetscDrawSetCoordinates(draw,xl,yl,xr,yr);CHKERRQ(ierr);
554   ierr = PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);CHKERRQ(ierr);
555   ierr = PetscDrawZoom(draw,MatView_SeqSBAIJ_Draw_Zoom,A);CHKERRQ(ierr);
556   ierr = PetscObjectCompose((PetscObject)A,"Zoomviewer",NULL);CHKERRQ(ierr);
557   ierr = PetscDrawSave(draw);CHKERRQ(ierr);
558   PetscFunctionReturn(0);
559 }
560 
561 #undef __FUNCT__
562 #define __FUNCT__ "MatView_SeqSBAIJ"
563 PetscErrorCode MatView_SeqSBAIJ(Mat A,PetscViewer viewer)
564 {
565   PetscErrorCode ierr;
566   PetscBool      iascii,isdraw;
567   FILE           *file = 0;
568 
569   PetscFunctionBegin;
570   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
571   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
572   if (iascii) {
573     ierr = MatView_SeqSBAIJ_ASCII(A,viewer);CHKERRQ(ierr);
574   } else if (isdraw) {
575     ierr = MatView_SeqSBAIJ_Draw(A,viewer);CHKERRQ(ierr);
576   } else {
577     Mat        B;
578     const char *matname;
579     ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
580     ierr = PetscObjectGetName((PetscObject)A,&matname);CHKERRQ(ierr);
581     ierr = PetscObjectSetName((PetscObject)B,matname);CHKERRQ(ierr);
582     ierr = MatView(B,viewer);CHKERRQ(ierr);
583     ierr = MatDestroy(&B);CHKERRQ(ierr);
584     ierr = PetscViewerBinaryGetInfoPointer(viewer,&file);CHKERRQ(ierr);
585     if (file) {
586       fprintf(file,"-matload_block_size %d\n",(int)A->rmap->bs);
587     }
588   }
589   PetscFunctionReturn(0);
590 }
591 
592 
593 #undef __FUNCT__
594 #define __FUNCT__ "MatGetValues_SeqSBAIJ"
595 PetscErrorCode MatGetValues_SeqSBAIJ(Mat A,PetscInt m,const PetscInt im[],PetscInt n,const PetscInt in[],PetscScalar v[])
596 {
597   Mat_SeqSBAIJ *a = (Mat_SeqSBAIJ*)A->data;
598   PetscInt     *rp,k,low,high,t,row,nrow,i,col,l,*aj = a->j;
599   PetscInt     *ai = a->i,*ailen = a->ilen;
600   PetscInt     brow,bcol,ridx,cidx,bs=A->rmap->bs,bs2=a->bs2;
601   MatScalar    *ap,*aa = a->a;
602 
603   PetscFunctionBegin;
604   for (k=0; k<m; k++) { /* loop over rows */
605     row = im[k]; brow = row/bs;
606     if (row < 0) {v += n; continue;} /* SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row: %D",row); */
607     if (row >= A->rmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",row,A->rmap->N-1);
608     rp   = aj + ai[brow]; ap = aa + bs2*ai[brow];
609     nrow = ailen[brow];
610     for (l=0; l<n; l++) { /* loop over columns */
611       if (in[l] < 0) {v++; continue;} /* SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative column: %D",in[l]); */
612       if (in[l] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",in[l],A->cmap->n-1);
613       col  = in[l];
614       bcol = col/bs;
615       cidx = col%bs;
616       ridx = row%bs;
617       high = nrow;
618       low  = 0; /* assume unsorted */
619       while (high-low > 5) {
620         t = (low+high)/2;
621         if (rp[t] > bcol) high = t;
622         else              low  = t;
623       }
624       for (i=low; i<high; i++) {
625         if (rp[i] > bcol) break;
626         if (rp[i] == bcol) {
627           *v++ = ap[bs2*i+bs*cidx+ridx];
628           goto finished;
629         }
630       }
631       *v++ = 0.0;
632 finished:;
633     }
634   }
635   PetscFunctionReturn(0);
636 }
637 
638 
639 #undef __FUNCT__
640 #define __FUNCT__ "MatSetValuesBlocked_SeqSBAIJ"
641 PetscErrorCode MatSetValuesBlocked_SeqSBAIJ(Mat A,PetscInt m,const PetscInt im[],PetscInt n,const PetscInt in[],const PetscScalar v[],InsertMode is)
642 {
643   Mat_SeqSBAIJ      *a = (Mat_SeqSBAIJ*)A->data;
644   PetscErrorCode    ierr;
645   PetscInt          *rp,k,low,high,t,ii,jj,row,nrow,i,col,l,rmax,N,lastcol = -1;
646   PetscInt          *imax      =a->imax,*ai=a->i,*ailen=a->ilen;
647   PetscInt          *aj        =a->j,nonew=a->nonew,bs2=a->bs2,bs=A->rmap->bs,stepval;
648   PetscBool         roworiented=a->roworiented;
649   const PetscScalar *value     = v;
650   MatScalar         *ap,*aa = a->a,*bap;
651 
652   PetscFunctionBegin;
653   if (roworiented) stepval = (n-1)*bs;
654   else stepval = (m-1)*bs;
655 
656   for (k=0; k<m; k++) { /* loop over added rows */
657     row = im[k];
658     if (row < 0) continue;
659 #if defined(PETSC_USE_DEBUG)
660     if (row >= a->mbs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Block index row too large %D max %D",row,a->mbs-1);
661 #endif
662     rp   = aj + ai[row];
663     ap   = aa + bs2*ai[row];
664     rmax = imax[row];
665     nrow = ailen[row];
666     low  = 0;
667     high = nrow;
668     for (l=0; l<n; l++) { /* loop over added columns */
669       if (in[l] < 0) continue;
670       col = in[l];
671 #if defined(PETSC_USE_DEBUG)
672       if (col >= a->nbs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Block index column too large %D max %D",col,a->nbs-1);
673 #endif
674       if (col < row) {
675         if (a->ignore_ltriangular) continue; /* ignore lower triangular block */
676         else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Lower triangular value cannot be set for sbaij format. Ignoring these values, run with -mat_ignore_lower_triangular or call MatSetOption(mat,MAT_IGNORE_LOWER_TRIANGULAR,PETSC_TRUE)");
677       }
678       if (roworiented) value = v + k*(stepval+bs)*bs + l*bs;
679       else value = v + l*(stepval+bs)*bs + k*bs;
680 
681       if (col <= lastcol) low = 0;
682       else high = nrow;
683 
684       lastcol = col;
685       while (high-low > 7) {
686         t = (low+high)/2;
687         if (rp[t] > col) high = t;
688         else             low  = t;
689       }
690       for (i=low; i<high; i++) {
691         if (rp[i] > col) break;
692         if (rp[i] == col) {
693           bap = ap +  bs2*i;
694           if (roworiented) {
695             if (is == ADD_VALUES) {
696               for (ii=0; ii<bs; ii++,value+=stepval) {
697                 for (jj=ii; jj<bs2; jj+=bs) {
698                   bap[jj] += *value++;
699                 }
700               }
701             } else {
702               for (ii=0; ii<bs; ii++,value+=stepval) {
703                 for (jj=ii; jj<bs2; jj+=bs) {
704                   bap[jj] = *value++;
705                 }
706                }
707             }
708           } else {
709             if (is == ADD_VALUES) {
710               for (ii=0; ii<bs; ii++,value+=stepval) {
711                 for (jj=0; jj<bs; jj++) {
712                   *bap++ += *value++;
713                 }
714               }
715             } else {
716               for (ii=0; ii<bs; ii++,value+=stepval) {
717                 for (jj=0; jj<bs; jj++) {
718                   *bap++  = *value++;
719                 }
720               }
721             }
722           }
723           goto noinsert2;
724         }
725       }
726       if (nonew == 1) goto noinsert2;
727       if (nonew == -1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Inserting a new block index nonzero block (%D, %D) in the matrix", row, col);
728       MatSeqXAIJReallocateAIJ(A,a->mbs,bs2,nrow,row,col,rmax,aa,ai,aj,rp,ap,imax,nonew,MatScalar);
729       N = nrow++ - 1; high++;
730       /* shift up all the later entries in this row */
731       for (ii=N; ii>=i; ii--) {
732         rp[ii+1] = rp[ii];
733         ierr     = PetscMemcpy(ap+bs2*(ii+1),ap+bs2*(ii),bs2*sizeof(MatScalar));CHKERRQ(ierr);
734       }
735       if (N >= i) {
736         ierr = PetscMemzero(ap+bs2*i,bs2*sizeof(MatScalar));CHKERRQ(ierr);
737       }
738       rp[i] = col;
739       bap   = ap +  bs2*i;
740       if (roworiented) {
741         for (ii=0; ii<bs; ii++,value+=stepval) {
742           for (jj=ii; jj<bs2; jj+=bs) {
743             bap[jj] = *value++;
744           }
745         }
746       } else {
747         for (ii=0; ii<bs; ii++,value+=stepval) {
748           for (jj=0; jj<bs; jj++) {
749             *bap++ = *value++;
750           }
751         }
752        }
753     noinsert2:;
754       low = i;
755     }
756     ailen[row] = nrow;
757   }
758   PetscFunctionReturn(0);
759 }
760 
761 /*
762     This is not yet used
763 */
764 #undef __FUNCT__
765 #define __FUNCT__ "MatAssemblyEnd_SeqSBAIJ_SeqAIJ_Inode"
766 PetscErrorCode MatAssemblyEnd_SeqSBAIJ_SeqAIJ_Inode(Mat A)
767 {
768   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data;
769   PetscErrorCode ierr;
770   const PetscInt *ai = a->i, *aj = a->j,*cols;
771   PetscInt       i   = 0,j,blk_size,m = A->rmap->n,node_count = 0,nzx,nzy,*ns,row,nz,cnt,cnt2,*counts;
772   PetscBool      flag;
773 
774   PetscFunctionBegin;
775   ierr = PetscMalloc1(m,&ns);CHKERRQ(ierr);
776   while (i < m) {
777     nzx = ai[i+1] - ai[i];       /* Number of nonzeros */
778     /* Limits the number of elements in a node to 'a->inode.limit' */
779     for (j=i+1,blk_size=1; j<m && blk_size <a->inode.limit; ++j,++blk_size) {
780       nzy = ai[j+1] - ai[j];
781       if (nzy != (nzx - j + i)) break;
782       ierr = PetscMemcmp(aj + ai[i] + j - i,aj + ai[j],nzy*sizeof(PetscInt),&flag);CHKERRQ(ierr);
783       if (!flag) break;
784     }
785     ns[node_count++] = blk_size;
786 
787     i = j;
788   }
789   if (!a->inode.size && m && node_count > .9*m) {
790     ierr = PetscFree(ns);CHKERRQ(ierr);
791     ierr = PetscInfo2(A,"Found %D nodes out of %D rows. Not using Inode routines\n",node_count,m);CHKERRQ(ierr);
792   } else {
793     a->inode.node_count = node_count;
794 
795     ierr = PetscMalloc1(node_count,&a->inode.size);CHKERRQ(ierr);
796     ierr = PetscLogObjectMemory((PetscObject)A,node_count*sizeof(PetscInt));CHKERRQ(ierr);
797     ierr = PetscMemcpy(a->inode.size,ns,node_count*sizeof(PetscInt));CHKERRQ(ierr);
798     ierr = PetscFree(ns);CHKERRQ(ierr);
799     ierr = PetscInfo3(A,"Found %D nodes of %D. Limit used: %D. Using Inode routines\n",node_count,m,a->inode.limit);CHKERRQ(ierr);
800 
801     /* count collections of adjacent columns in each inode */
802     row = 0;
803     cnt = 0;
804     for (i=0; i<node_count; i++) {
805       cols = aj + ai[row] + a->inode.size[i];
806       nz   = ai[row+1] - ai[row] - a->inode.size[i];
807       for (j=1; j<nz; j++) {
808         if (cols[j] != cols[j-1]+1) cnt++;
809       }
810       cnt++;
811       row += a->inode.size[i];
812     }
813     ierr = PetscMalloc1(2*cnt,&counts);CHKERRQ(ierr);
814     cnt  = 0;
815     row  = 0;
816     for (i=0; i<node_count; i++) {
817       cols = aj + ai[row] + a->inode.size[i];
818       counts[2*cnt] = cols[0];
819       nz   = ai[row+1] - ai[row] - a->inode.size[i];
820       cnt2 = 1;
821       for (j=1; j<nz; j++) {
822         if (cols[j] != cols[j-1]+1) {
823           counts[2*(cnt++)+1] = cnt2;
824           counts[2*cnt]       = cols[j];
825           cnt2 = 1;
826         } else cnt2++;
827       }
828       counts[2*(cnt++)+1] = cnt2;
829       row += a->inode.size[i];
830     }
831     ierr = PetscIntView(2*cnt,counts,0);CHKERRQ(ierr);
832   }
833   PetscFunctionReturn(0);
834 }
835 
836 #undef __FUNCT__
837 #define __FUNCT__ "MatAssemblyEnd_SeqSBAIJ"
838 PetscErrorCode MatAssemblyEnd_SeqSBAIJ(Mat A,MatAssemblyType mode)
839 {
840   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data;
841   PetscErrorCode ierr;
842   PetscInt       fshift = 0,i,j,*ai = a->i,*aj = a->j,*imax = a->imax;
843   PetscInt       m      = A->rmap->N,*ip,N,*ailen = a->ilen;
844   PetscInt       mbs    = a->mbs,bs2 = a->bs2,rmax = 0;
845   MatScalar      *aa    = a->a,*ap;
846 
847   PetscFunctionBegin;
848   if (mode == MAT_FLUSH_ASSEMBLY) PetscFunctionReturn(0);
849 
850   if (m) rmax = ailen[0];
851   for (i=1; i<mbs; i++) {
852     /* move each row back by the amount of empty slots (fshift) before it*/
853     fshift += imax[i-1] - ailen[i-1];
854     rmax    = PetscMax(rmax,ailen[i]);
855     if (fshift) {
856       ip = aj + ai[i]; ap = aa + bs2*ai[i];
857       N  = ailen[i];
858       for (j=0; j<N; j++) {
859         ip[j-fshift] = ip[j];
860         ierr         = PetscMemcpy(ap+(j-fshift)*bs2,ap+j*bs2,bs2*sizeof(MatScalar));CHKERRQ(ierr);
861       }
862     }
863     ai[i] = ai[i-1] + ailen[i-1];
864   }
865   if (mbs) {
866     fshift += imax[mbs-1] - ailen[mbs-1];
867     ai[mbs] = ai[mbs-1] + ailen[mbs-1];
868   }
869   /* reset ilen and imax for each row */
870   for (i=0; i<mbs; i++) {
871     ailen[i] = imax[i] = ai[i+1] - ai[i];
872   }
873   a->nz = ai[mbs];
874 
875   /* diagonals may have moved, reset it */
876   if (a->diag) {
877     ierr = PetscMemcpy(a->diag,ai,mbs*sizeof(PetscInt));CHKERRQ(ierr);
878   }
879   if (fshift && a->nounused == -1) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB, "Unused space detected in matrix: %D X %D block size %D, %D unneeded", m, A->cmap->n, A->rmap->bs, fshift*bs2);
880 
881   ierr = PetscInfo5(A,"Matrix size: %D X %D, block size %D; storage space: %D unneeded, %D used\n",m,A->rmap->N,A->rmap->bs,fshift*bs2,a->nz*bs2);CHKERRQ(ierr);
882   ierr = PetscInfo1(A,"Number of mallocs during MatSetValues is %D\n",a->reallocs);CHKERRQ(ierr);
883   ierr = PetscInfo1(A,"Most nonzeros blocks in any row is %D\n",rmax);CHKERRQ(ierr);
884 
885   A->info.mallocs    += a->reallocs;
886   a->reallocs         = 0;
887   A->info.nz_unneeded = (PetscReal)fshift*bs2;
888   a->idiagvalid       = PETSC_FALSE;
889   a->rmax             = rmax;
890 
891   if (A->cmap->n < 65536 && A->cmap->bs == 1) {
892     if (a->jshort && a->free_jshort) {
893       /* when matrix data structure is changed, previous jshort must be replaced */
894       ierr = PetscFree(a->jshort);CHKERRQ(ierr);
895     }
896     ierr = PetscMalloc1(a->i[A->rmap->n],&a->jshort);CHKERRQ(ierr);
897     ierr = PetscLogObjectMemory((PetscObject)A,a->i[A->rmap->n]*sizeof(unsigned short));CHKERRQ(ierr);
898     for (i=0; i<a->i[A->rmap->n]; i++) a->jshort[i] = a->j[i];
899     A->ops->mult   = MatMult_SeqSBAIJ_1_ushort;
900     A->ops->sor    = MatSOR_SeqSBAIJ_ushort;
901     a->free_jshort = PETSC_TRUE;
902   }
903   PetscFunctionReturn(0);
904 }
905 
906 /*
907    This function returns an array of flags which indicate the locations of contiguous
908    blocks that should be zeroed. for eg: if bs = 3  and is = [0,1,2,3,5,6,7,8,9]
909    then the resulting sizes = [3,1,1,3,1] correspondig to sets [(0,1,2),(3),(5),(6,7,8),(9)]
910    Assume: sizes should be long enough to hold all the values.
911 */
912 #undef __FUNCT__
913 #define __FUNCT__ "MatZeroRows_SeqSBAIJ_Check_Blocks"
914 PetscErrorCode MatZeroRows_SeqSBAIJ_Check_Blocks(PetscInt idx[],PetscInt n,PetscInt bs,PetscInt sizes[], PetscInt *bs_max)
915 {
916   PetscInt  i,j,k,row;
917   PetscBool flg;
918 
919   PetscFunctionBegin;
920   for (i=0,j=0; i<n; j++) {
921     row = idx[i];
922     if (row%bs!=0) { /* Not the begining of a block */
923       sizes[j] = 1;
924       i++;
925     } else if (i+bs > n) { /* Beginning of a block, but complete block doesn't exist (at idx end) */
926       sizes[j] = 1;         /* Also makes sure atleast 'bs' values exist for next else */
927       i++;
928     } else { /* Begining of the block, so check if the complete block exists */
929       flg = PETSC_TRUE;
930       for (k=1; k<bs; k++) {
931         if (row+k != idx[i+k]) { /* break in the block */
932           flg = PETSC_FALSE;
933           break;
934         }
935       }
936       if (flg) { /* No break in the bs */
937         sizes[j] = bs;
938         i       += bs;
939       } else {
940         sizes[j] = 1;
941         i++;
942       }
943     }
944   }
945   *bs_max = j;
946   PetscFunctionReturn(0);
947 }
948 
949 
950 /* Only add/insert a(i,j) with i<=j (blocks).
951    Any a(i,j) with i>j input by user is ingored.
952 */
953 
954 #undef __FUNCT__
955 #define __FUNCT__ "MatSetValues_SeqSBAIJ"
956 PetscErrorCode MatSetValues_SeqSBAIJ(Mat A,PetscInt m,const PetscInt im[],PetscInt n,const PetscInt in[],const PetscScalar v[],InsertMode is)
957 {
958   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data;
959   PetscErrorCode ierr;
960   PetscInt       *rp,k,low,high,t,ii,row,nrow,i,col,l,rmax,N,lastcol = -1;
961   PetscInt       *imax=a->imax,*ai=a->i,*ailen=a->ilen,roworiented=a->roworiented;
962   PetscInt       *aj  =a->j,nonew=a->nonew,bs=A->rmap->bs,brow,bcol;
963   PetscInt       ridx,cidx,bs2=a->bs2;
964   MatScalar      *ap,value,*aa=a->a,*bap;
965 
966   PetscFunctionBegin;
967   for (k=0; k<m; k++) { /* loop over added rows */
968     row  = im[k];       /* row number */
969     brow = row/bs;      /* block row number */
970     if (row < 0) continue;
971 #if defined(PETSC_USE_DEBUG)
972     if (row >= A->rmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",row,A->rmap->N-1);
973 #endif
974     rp   = aj + ai[brow]; /*ptr to beginning of column value of the row block*/
975     ap   = aa + bs2*ai[brow]; /*ptr to beginning of element value of the row block*/
976     rmax = imax[brow];  /* maximum space allocated for this row */
977     nrow = ailen[brow]; /* actual length of this row */
978     low  = 0;
979 
980     for (l=0; l<n; l++) { /* loop over added columns */
981       if (in[l] < 0) continue;
982 #if defined(PETSC_USE_DEBUG)
983       if (in[l] >= A->rmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",in[l],A->rmap->N-1);
984 #endif
985       col  = in[l];
986       bcol = col/bs;              /* block col number */
987 
988       if (brow > bcol) {
989         if (a->ignore_ltriangular) continue; /* ignore lower triangular values */
990         else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Lower triangular value cannot be set for sbaij format. Ignoring these values, run with -mat_ignore_lower_triangular or call MatSetOption(mat,MAT_IGNORE_LOWER_TRIANGULAR,PETSC_TRUE)");
991       }
992 
993       ridx = row % bs; cidx = col % bs; /*row and col index inside the block */
994       if ((brow==bcol && ridx<=cidx) || (brow<bcol)) {
995         /* element value a(k,l) */
996         if (roworiented) value = v[l + k*n];
997         else value = v[k + l*m];
998 
999         /* move pointer bap to a(k,l) quickly and add/insert value */
1000         if (col <= lastcol) low = 0;
1001         high = nrow;
1002         lastcol = col;
1003         while (high-low > 7) {
1004           t = (low+high)/2;
1005           if (rp[t] > bcol) high = t;
1006           else              low  = t;
1007         }
1008         for (i=low; i<high; i++) {
1009           if (rp[i] > bcol) break;
1010           if (rp[i] == bcol) {
1011             bap = ap +  bs2*i + bs*cidx + ridx;
1012             if (is == ADD_VALUES) *bap += value;
1013             else                  *bap  = value;
1014             /* for diag block, add/insert its symmetric element a(cidx,ridx) */
1015             if (brow == bcol && ridx < cidx) {
1016               bap = ap +  bs2*i + bs*ridx + cidx;
1017               if (is == ADD_VALUES) *bap += value;
1018               else                  *bap  = value;
1019             }
1020             goto noinsert1;
1021           }
1022         }
1023 
1024         if (nonew == 1) goto noinsert1;
1025         if (nonew == -1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Inserting a new nonzero (%D, %D) in the matrix", row, col);
1026         MatSeqXAIJReallocateAIJ(A,a->mbs,bs2,nrow,brow,bcol,rmax,aa,ai,aj,rp,ap,imax,nonew,MatScalar);
1027 
1028         N = nrow++ - 1; high++;
1029         /* shift up all the later entries in this row */
1030         for (ii=N; ii>=i; ii--) {
1031           rp[ii+1] = rp[ii];
1032           ierr     = PetscMemcpy(ap+bs2*(ii+1),ap+bs2*(ii),bs2*sizeof(MatScalar));CHKERRQ(ierr);
1033         }
1034         if (N>=i) {
1035           ierr = PetscMemzero(ap+bs2*i,bs2*sizeof(MatScalar));CHKERRQ(ierr);
1036         }
1037         rp[i]                      = bcol;
1038         ap[bs2*i + bs*cidx + ridx] = value;
1039         A->nonzerostate++;
1040 noinsert1:;
1041         low = i;
1042       }
1043     }   /* end of loop over added columns */
1044     ailen[brow] = nrow;
1045   }   /* end of loop over added rows */
1046   PetscFunctionReturn(0);
1047 }
1048 
1049 #undef __FUNCT__
1050 #define __FUNCT__ "MatICCFactor_SeqSBAIJ"
1051 PetscErrorCode MatICCFactor_SeqSBAIJ(Mat inA,IS row,const MatFactorInfo *info)
1052 {
1053   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)inA->data;
1054   Mat            outA;
1055   PetscErrorCode ierr;
1056   PetscBool      row_identity;
1057 
1058   PetscFunctionBegin;
1059   if (info->levels != 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only levels=0 is supported for in-place icc");
1060   ierr = ISIdentity(row,&row_identity);CHKERRQ(ierr);
1061   if (!row_identity) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Matrix reordering is not supported");
1062   if (inA->rmap->bs != 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Matrix block size %D is not supported",inA->rmap->bs); /* Need to replace MatCholeskyFactorSymbolic_SeqSBAIJ_MSR()! */
1063 
1064   outA            = inA;
1065   inA->factortype = MAT_FACTOR_ICC;
1066   ierr = PetscFree(inA->solvertype);CHKERRQ(ierr);
1067   ierr = PetscStrallocpy(MATSOLVERPETSC,&inA->solvertype);CHKERRQ(ierr);
1068 
1069   ierr = MatMarkDiagonal_SeqSBAIJ(inA);CHKERRQ(ierr);
1070   ierr = MatSeqSBAIJSetNumericFactorization_inplace(inA,row_identity);CHKERRQ(ierr);
1071 
1072   ierr   = PetscObjectReference((PetscObject)row);CHKERRQ(ierr);
1073   ierr   = ISDestroy(&a->row);CHKERRQ(ierr);
1074   a->row = row;
1075   ierr   = PetscObjectReference((PetscObject)row);CHKERRQ(ierr);
1076   ierr   = ISDestroy(&a->col);CHKERRQ(ierr);
1077   a->col = row;
1078 
1079   /* Create the invert permutation so that it can be used in MatCholeskyFactorNumeric() */
1080   if (a->icol) {ierr = ISInvertPermutation(row,PETSC_DECIDE, &a->icol);CHKERRQ(ierr);}
1081   ierr = PetscLogObjectParent((PetscObject)inA,(PetscObject)a->icol);CHKERRQ(ierr);
1082 
1083   if (!a->solve_work) {
1084     ierr = PetscMalloc1(inA->rmap->N+inA->rmap->bs,&a->solve_work);CHKERRQ(ierr);
1085     ierr = PetscLogObjectMemory((PetscObject)inA,(inA->rmap->N+inA->rmap->bs)*sizeof(PetscScalar));CHKERRQ(ierr);
1086   }
1087 
1088   ierr = MatCholeskyFactorNumeric(outA,inA,info);CHKERRQ(ierr);
1089   PetscFunctionReturn(0);
1090 }
1091 
1092 #undef __FUNCT__
1093 #define __FUNCT__ "MatSeqSBAIJSetColumnIndices_SeqSBAIJ"
1094 PetscErrorCode  MatSeqSBAIJSetColumnIndices_SeqSBAIJ(Mat mat,PetscInt *indices)
1095 {
1096   Mat_SeqSBAIJ   *baij = (Mat_SeqSBAIJ*)mat->data;
1097   PetscInt       i,nz,n;
1098   PetscErrorCode ierr;
1099 
1100   PetscFunctionBegin;
1101   nz = baij->maxnz;
1102   n  = mat->cmap->n;
1103   for (i=0; i<nz; i++) baij->j[i] = indices[i];
1104 
1105   baij->nz = nz;
1106   for (i=0; i<n; i++) baij->ilen[i] = baij->imax[i];
1107 
1108   ierr = MatSetOption(mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
1109   PetscFunctionReturn(0);
1110 }
1111 
1112 #undef __FUNCT__
1113 #define __FUNCT__ "MatSeqSBAIJSetColumnIndices"
1114 /*@
1115   MatSeqSBAIJSetColumnIndices - Set the column indices for all the rows
1116   in the matrix.
1117 
1118   Input Parameters:
1119   +  mat     - the SeqSBAIJ matrix
1120   -  indices - the column indices
1121 
1122   Level: advanced
1123 
1124   Notes:
1125   This can be called if you have precomputed the nonzero structure of the
1126   matrix and want to provide it to the matrix object to improve the performance
1127   of the MatSetValues() operation.
1128 
1129   You MUST have set the correct numbers of nonzeros per row in the call to
1130   MatCreateSeqSBAIJ(), and the columns indices MUST be sorted.
1131 
1132   MUST be called before any calls to MatSetValues()
1133 
1134   .seealso: MatCreateSeqSBAIJ
1135 @*/
1136 PetscErrorCode  MatSeqSBAIJSetColumnIndices(Mat mat,PetscInt *indices)
1137 {
1138   PetscErrorCode ierr;
1139 
1140   PetscFunctionBegin;
1141   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
1142   PetscValidPointer(indices,2);
1143   ierr = PetscUseMethod(mat,"MatSeqSBAIJSetColumnIndices_C",(Mat,PetscInt*),(mat,indices));CHKERRQ(ierr);
1144   PetscFunctionReturn(0);
1145 }
1146 
1147 #undef __FUNCT__
1148 #define __FUNCT__ "MatCopy_SeqSBAIJ"
1149 PetscErrorCode MatCopy_SeqSBAIJ(Mat A,Mat B,MatStructure str)
1150 {
1151   PetscErrorCode ierr;
1152 
1153   PetscFunctionBegin;
1154   /* If the two matrices have the same copy implementation, use fast copy. */
1155   if (str == SAME_NONZERO_PATTERN && (A->ops->copy == B->ops->copy)) {
1156     Mat_SeqSBAIJ *a = (Mat_SeqSBAIJ*)A->data;
1157     Mat_SeqSBAIJ *b = (Mat_SeqSBAIJ*)B->data;
1158 
1159     if (a->i[A->rmap->N] != b->i[B->rmap->N]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Number of nonzeros in two matrices are different");
1160     ierr = PetscMemcpy(b->a,a->a,(a->i[A->rmap->N])*sizeof(PetscScalar));CHKERRQ(ierr);
1161   } else {
1162     ierr = MatGetRowUpperTriangular(A);CHKERRQ(ierr);
1163     ierr = MatCopy_Basic(A,B,str);CHKERRQ(ierr);
1164     ierr = MatRestoreRowUpperTriangular(A);CHKERRQ(ierr);
1165   }
1166   PetscFunctionReturn(0);
1167 }
1168 
1169 #undef __FUNCT__
1170 #define __FUNCT__ "MatSetUp_SeqSBAIJ"
1171 PetscErrorCode MatSetUp_SeqSBAIJ(Mat A)
1172 {
1173   PetscErrorCode ierr;
1174 
1175   PetscFunctionBegin;
1176   ierr = MatSeqSBAIJSetPreallocation(A,A->rmap->bs,PETSC_DEFAULT,0);CHKERRQ(ierr);
1177   PetscFunctionReturn(0);
1178 }
1179 
1180 #undef __FUNCT__
1181 #define __FUNCT__ "MatSeqSBAIJGetArray_SeqSBAIJ"
1182 PetscErrorCode MatSeqSBAIJGetArray_SeqSBAIJ(Mat A,PetscScalar *array[])
1183 {
1184   Mat_SeqSBAIJ *a = (Mat_SeqSBAIJ*)A->data;
1185 
1186   PetscFunctionBegin;
1187   *array = a->a;
1188   PetscFunctionReturn(0);
1189 }
1190 
1191 #undef __FUNCT__
1192 #define __FUNCT__ "MatSeqSBAIJRestoreArray_SeqSBAIJ"
1193 PetscErrorCode MatSeqSBAIJRestoreArray_SeqSBAIJ(Mat A,PetscScalar *array[])
1194 {
1195   PetscFunctionBegin;
1196   PetscFunctionReturn(0);
1197 }
1198 
1199 #undef __FUNCT__
1200 #define __FUNCT__ "MatAXPYGetPreallocation_SeqSBAIJ"
1201 PetscErrorCode MatAXPYGetPreallocation_SeqSBAIJ(Mat Y,Mat X,PetscInt *nnz)
1202 {
1203   PetscInt       bs = Y->rmap->bs,mbs = Y->rmap->N/bs;
1204   Mat_SeqSBAIJ   *x = (Mat_SeqSBAIJ*)X->data;
1205   Mat_SeqSBAIJ   *y = (Mat_SeqSBAIJ*)Y->data;
1206   PetscErrorCode ierr;
1207 
1208   PetscFunctionBegin;
1209   /* Set the number of nonzeros in the new matrix */
1210   ierr = MatAXPYGetPreallocation_SeqX_private(mbs,x->i,x->j,y->i,y->j,nnz);CHKERRQ(ierr);
1211   PetscFunctionReturn(0);
1212 }
1213 
1214 #undef __FUNCT__
1215 #define __FUNCT__ "MatAXPY_SeqSBAIJ"
1216 PetscErrorCode MatAXPY_SeqSBAIJ(Mat Y,PetscScalar a,Mat X,MatStructure str)
1217 {
1218   Mat_SeqSBAIJ   *x=(Mat_SeqSBAIJ*)X->data, *y=(Mat_SeqSBAIJ*)Y->data;
1219   PetscErrorCode ierr;
1220   PetscInt       bs=Y->rmap->bs,bs2=bs*bs;
1221   PetscBLASInt   one = 1;
1222 
1223   PetscFunctionBegin;
1224   if (str == SAME_NONZERO_PATTERN) {
1225     PetscScalar  alpha = a;
1226     PetscBLASInt bnz;
1227     ierr = PetscBLASIntCast(x->nz*bs2,&bnz);CHKERRQ(ierr);
1228     PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&bnz,&alpha,x->a,&one,y->a,&one));
1229     ierr = PetscObjectStateIncrease((PetscObject)Y);CHKERRQ(ierr);
1230   } else if (str == SUBSET_NONZERO_PATTERN) { /* nonzeros of X is a subset of Y's */
1231     ierr = MatSetOption(X,MAT_GETROW_UPPERTRIANGULAR,PETSC_TRUE);CHKERRQ(ierr);
1232     ierr = MatAXPY_Basic(Y,a,X,str);CHKERRQ(ierr);
1233     ierr = MatSetOption(X,MAT_GETROW_UPPERTRIANGULAR,PETSC_FALSE);CHKERRQ(ierr);
1234   } else {
1235     Mat      B;
1236     PetscInt *nnz;
1237     if (bs != X->rmap->bs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Matrices must have same block size");
1238     ierr = MatGetRowUpperTriangular(X);CHKERRQ(ierr);
1239     ierr = MatGetRowUpperTriangular(Y);CHKERRQ(ierr);
1240     ierr = PetscMalloc1(Y->rmap->N,&nnz);CHKERRQ(ierr);
1241     ierr = MatCreate(PetscObjectComm((PetscObject)Y),&B);CHKERRQ(ierr);
1242     ierr = PetscObjectSetName((PetscObject)B,((PetscObject)Y)->name);CHKERRQ(ierr);
1243     ierr = MatSetSizes(B,Y->rmap->n,Y->cmap->n,Y->rmap->N,Y->cmap->N);CHKERRQ(ierr);
1244     ierr = MatSetBlockSizesFromMats(B,Y,Y);CHKERRQ(ierr);
1245     ierr = MatSetType(B,(MatType) ((PetscObject)Y)->type_name);CHKERRQ(ierr);
1246     ierr = MatAXPYGetPreallocation_SeqSBAIJ(Y,X,nnz);CHKERRQ(ierr);
1247     ierr = MatSeqSBAIJSetPreallocation(B,bs,0,nnz);CHKERRQ(ierr);
1248 
1249     ierr = MatAXPY_BasicWithPreallocation(B,Y,a,X,str);CHKERRQ(ierr);
1250 
1251     ierr = MatHeaderReplace(Y,&B);CHKERRQ(ierr);
1252     ierr = PetscFree(nnz);CHKERRQ(ierr);
1253     ierr = MatRestoreRowUpperTriangular(X);CHKERRQ(ierr);
1254     ierr = MatRestoreRowUpperTriangular(Y);CHKERRQ(ierr);
1255   }
1256   PetscFunctionReturn(0);
1257 }
1258 
1259 #undef __FUNCT__
1260 #define __FUNCT__ "MatIsSymmetric_SeqSBAIJ"
1261 PetscErrorCode MatIsSymmetric_SeqSBAIJ(Mat A,PetscReal tol,PetscBool  *flg)
1262 {
1263   PetscFunctionBegin;
1264   *flg = PETSC_TRUE;
1265   PetscFunctionReturn(0);
1266 }
1267 
1268 #undef __FUNCT__
1269 #define __FUNCT__ "MatIsStructurallySymmetric_SeqSBAIJ"
1270 PetscErrorCode MatIsStructurallySymmetric_SeqSBAIJ(Mat A,PetscBool  *flg)
1271 {
1272   PetscFunctionBegin;
1273   *flg = PETSC_TRUE;
1274   PetscFunctionReturn(0);
1275 }
1276 
1277 #undef __FUNCT__
1278 #define __FUNCT__ "MatIsHermitian_SeqSBAIJ"
1279 PetscErrorCode MatIsHermitian_SeqSBAIJ(Mat A,PetscReal tol,PetscBool  *flg)
1280 {
1281   PetscFunctionBegin;
1282   *flg = PETSC_FALSE;
1283   PetscFunctionReturn(0);
1284 }
1285 
1286 #undef __FUNCT__
1287 #define __FUNCT__ "MatRealPart_SeqSBAIJ"
1288 PetscErrorCode MatRealPart_SeqSBAIJ(Mat A)
1289 {
1290   Mat_SeqSBAIJ *a = (Mat_SeqSBAIJ*)A->data;
1291   PetscInt     i,nz = a->bs2*a->i[a->mbs];
1292   MatScalar    *aa = a->a;
1293 
1294   PetscFunctionBegin;
1295   for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
1296   PetscFunctionReturn(0);
1297 }
1298 
1299 #undef __FUNCT__
1300 #define __FUNCT__ "MatImaginaryPart_SeqSBAIJ"
1301 PetscErrorCode MatImaginaryPart_SeqSBAIJ(Mat A)
1302 {
1303   Mat_SeqSBAIJ *a = (Mat_SeqSBAIJ*)A->data;
1304   PetscInt     i,nz = a->bs2*a->i[a->mbs];
1305   MatScalar    *aa = a->a;
1306 
1307   PetscFunctionBegin;
1308   for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
1309   PetscFunctionReturn(0);
1310 }
1311 
1312 #undef __FUNCT__
1313 #define __FUNCT__ "MatZeroRowsColumns_SeqSBAIJ"
1314 PetscErrorCode MatZeroRowsColumns_SeqSBAIJ(Mat A,PetscInt is_n,const PetscInt is_idx[],PetscScalar diag,Vec x, Vec b)
1315 {
1316   Mat_SeqSBAIJ      *baij=(Mat_SeqSBAIJ*)A->data;
1317   PetscErrorCode    ierr;
1318   PetscInt          i,j,k,count;
1319   PetscInt          bs   =A->rmap->bs,bs2=baij->bs2,row,col;
1320   PetscScalar       zero = 0.0;
1321   MatScalar         *aa;
1322   const PetscScalar *xx;
1323   PetscScalar       *bb;
1324   PetscBool         *zeroed,vecs = PETSC_FALSE;
1325 
1326   PetscFunctionBegin;
1327   /* fix right hand side if needed */
1328   if (x && b) {
1329     ierr = VecGetArrayRead(x,&xx);CHKERRQ(ierr);
1330     ierr = VecGetArray(b,&bb);CHKERRQ(ierr);
1331     vecs = PETSC_TRUE;
1332   }
1333 
1334   /* zero the columns */
1335   ierr = PetscCalloc1(A->rmap->n,&zeroed);CHKERRQ(ierr);
1336   for (i=0; i<is_n; i++) {
1337     if (is_idx[i] < 0 || is_idx[i] >= A->rmap->N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"row %D out of range",is_idx[i]);
1338     zeroed[is_idx[i]] = PETSC_TRUE;
1339   }
1340   if (vecs) {
1341     for (i=0; i<A->rmap->N; i++) {
1342       row = i/bs;
1343       for (j=baij->i[row]; j<baij->i[row+1]; j++) {
1344         for (k=0; k<bs; k++) {
1345           col = bs*baij->j[j] + k;
1346           if (col <= i) continue;
1347           aa = ((MatScalar*)(baij->a)) + j*bs2 + (i%bs) + bs*k;
1348           if (!zeroed[i] && zeroed[col]) bb[i]   -= aa[0]*xx[col];
1349           if (zeroed[i] && !zeroed[col]) bb[col] -= aa[0]*xx[i];
1350         }
1351       }
1352     }
1353     for (i=0; i<is_n; i++) bb[is_idx[i]] = diag*xx[is_idx[i]];
1354   }
1355 
1356   for (i=0; i<A->rmap->N; i++) {
1357     if (!zeroed[i]) {
1358       row = i/bs;
1359       for (j=baij->i[row]; j<baij->i[row+1]; j++) {
1360         for (k=0; k<bs; k++) {
1361           col = bs*baij->j[j] + k;
1362           if (zeroed[col]) {
1363             aa = ((MatScalar*)(baij->a)) + j*bs2 + (i%bs) + bs*k;
1364             aa[0] = 0.0;
1365           }
1366         }
1367       }
1368     }
1369   }
1370   ierr = PetscFree(zeroed);CHKERRQ(ierr);
1371   if (vecs) {
1372     ierr = VecRestoreArrayRead(x,&xx);CHKERRQ(ierr);
1373     ierr = VecRestoreArray(b,&bb);CHKERRQ(ierr);
1374   }
1375 
1376   /* zero the rows */
1377   for (i=0; i<is_n; i++) {
1378     row   = is_idx[i];
1379     count = (baij->i[row/bs +1] - baij->i[row/bs])*bs;
1380     aa    = ((MatScalar*)(baij->a)) + baij->i[row/bs]*bs2 + (row%bs);
1381     for (k=0; k<count; k++) {
1382       aa[0] =  zero;
1383       aa   += bs;
1384     }
1385     if (diag != 0.0) {
1386       ierr = (*A->ops->setvalues)(A,1,&row,1,&row,&diag,INSERT_VALUES);CHKERRQ(ierr);
1387     }
1388   }
1389   ierr = MatAssemblyEnd_SeqSBAIJ(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1390   PetscFunctionReturn(0);
1391 }
1392 
1393 #undef __FUNCT__
1394 #define __FUNCT__ "MatShift_SeqSBAIJ"
1395 PetscErrorCode MatShift_SeqSBAIJ(Mat Y,PetscScalar a)
1396 {
1397   PetscErrorCode ierr;
1398   Mat_SeqSBAIJ    *aij = (Mat_SeqSBAIJ*)Y->data;
1399 
1400   PetscFunctionBegin;
1401   if (!Y->preallocated || !aij->nz) {
1402     ierr = MatSeqSBAIJSetPreallocation(Y,Y->rmap->bs,1,NULL);CHKERRQ(ierr);
1403   }
1404   ierr = MatShift_Basic(Y,a);CHKERRQ(ierr);
1405   PetscFunctionReturn(0);
1406 }
1407 
1408 /* -------------------------------------------------------------------*/
1409 static struct _MatOps MatOps_Values = {MatSetValues_SeqSBAIJ,
1410                                        MatGetRow_SeqSBAIJ,
1411                                        MatRestoreRow_SeqSBAIJ,
1412                                        MatMult_SeqSBAIJ_N,
1413                                /*  4*/ MatMultAdd_SeqSBAIJ_N,
1414                                        MatMult_SeqSBAIJ_N,       /* transpose versions are same as non-transpose versions */
1415                                        MatMultAdd_SeqSBAIJ_N,
1416                                        0,
1417                                        0,
1418                                        0,
1419                                /* 10*/ 0,
1420                                        0,
1421                                        MatCholeskyFactor_SeqSBAIJ,
1422                                        MatSOR_SeqSBAIJ,
1423                                        MatTranspose_SeqSBAIJ,
1424                                /* 15*/ MatGetInfo_SeqSBAIJ,
1425                                        MatEqual_SeqSBAIJ,
1426                                        MatGetDiagonal_SeqSBAIJ,
1427                                        MatDiagonalScale_SeqSBAIJ,
1428                                        MatNorm_SeqSBAIJ,
1429                                /* 20*/ 0,
1430                                        MatAssemblyEnd_SeqSBAIJ,
1431                                        MatSetOption_SeqSBAIJ,
1432                                        MatZeroEntries_SeqSBAIJ,
1433                                /* 24*/ 0,
1434                                        0,
1435                                        0,
1436                                        0,
1437                                        0,
1438                                /* 29*/ MatSetUp_SeqSBAIJ,
1439                                        0,
1440                                        0,
1441                                        0,
1442                                        0,
1443                                /* 34*/ MatDuplicate_SeqSBAIJ,
1444                                        0,
1445                                        0,
1446                                        0,
1447                                        MatICCFactor_SeqSBAIJ,
1448                                /* 39*/ MatAXPY_SeqSBAIJ,
1449                                        MatGetSubMatrices_SeqSBAIJ,
1450                                        MatIncreaseOverlap_SeqSBAIJ,
1451                                        MatGetValues_SeqSBAIJ,
1452                                        MatCopy_SeqSBAIJ,
1453                                /* 44*/ 0,
1454                                        MatScale_SeqSBAIJ,
1455                                        MatShift_SeqSBAIJ,
1456                                        0,
1457                                        MatZeroRowsColumns_SeqSBAIJ,
1458                                /* 49*/ 0,
1459                                        MatGetRowIJ_SeqSBAIJ,
1460                                        MatRestoreRowIJ_SeqSBAIJ,
1461                                        0,
1462                                        0,
1463                                /* 54*/ 0,
1464                                        0,
1465                                        0,
1466                                        0,
1467                                        MatSetValuesBlocked_SeqSBAIJ,
1468                                /* 59*/ MatGetSubMatrix_SeqSBAIJ,
1469                                        0,
1470                                        0,
1471                                        0,
1472                                        0,
1473                                /* 64*/ 0,
1474                                        0,
1475                                        0,
1476                                        0,
1477                                        0,
1478                                /* 69*/ MatGetRowMaxAbs_SeqSBAIJ,
1479                                        0,
1480                                        0,
1481                                        0,
1482                                        0,
1483                                /* 74*/ 0,
1484                                        0,
1485                                        0,
1486                                        0,
1487                                        0,
1488                                /* 79*/ 0,
1489                                        0,
1490                                        0,
1491                                        MatGetInertia_SeqSBAIJ,
1492                                        MatLoad_SeqSBAIJ,
1493                                /* 84*/ MatIsSymmetric_SeqSBAIJ,
1494                                        MatIsHermitian_SeqSBAIJ,
1495                                        MatIsStructurallySymmetric_SeqSBAIJ,
1496                                        0,
1497                                        0,
1498                                /* 89*/ 0,
1499                                        0,
1500                                        0,
1501                                        0,
1502                                        0,
1503                                /* 94*/ 0,
1504                                        0,
1505                                        0,
1506                                        0,
1507                                        0,
1508                                /* 99*/ 0,
1509                                        0,
1510                                        0,
1511                                        0,
1512                                        0,
1513                                /*104*/ 0,
1514                                        MatRealPart_SeqSBAIJ,
1515                                        MatImaginaryPart_SeqSBAIJ,
1516                                        MatGetRowUpperTriangular_SeqSBAIJ,
1517                                        MatRestoreRowUpperTriangular_SeqSBAIJ,
1518                                /*109*/ 0,
1519                                        0,
1520                                        0,
1521                                        0,
1522                                        MatMissingDiagonal_SeqSBAIJ,
1523                                /*114*/ 0,
1524                                        0,
1525                                        0,
1526                                        0,
1527                                        0,
1528                                /*119*/ 0,
1529                                        0,
1530                                        0,
1531                                        0,
1532                                        0,
1533                                /*124*/ 0,
1534                                        0,
1535                                        0,
1536                                        0,
1537                                        0,
1538                                /*129*/ 0,
1539                                        0,
1540                                        0,
1541                                        0,
1542                                        0,
1543                                /*134*/ 0,
1544                                        0,
1545                                        0,
1546                                        0,
1547                                        0,
1548                                /*139*/ 0,
1549                                        0,
1550                                        0,
1551                                        0,
1552                                        0,
1553                                 /*144*/MatCreateMPIMatConcatenateSeqMat_SeqSBAIJ
1554 };
1555 
1556 #undef __FUNCT__
1557 #define __FUNCT__ "MatStoreValues_SeqSBAIJ"
1558 PetscErrorCode  MatStoreValues_SeqSBAIJ(Mat mat)
1559 {
1560   Mat_SeqSBAIJ   *aij = (Mat_SeqSBAIJ*)mat->data;
1561   PetscInt       nz   = aij->i[mat->rmap->N]*mat->rmap->bs*aij->bs2;
1562   PetscErrorCode ierr;
1563 
1564   PetscFunctionBegin;
1565   if (aij->nonew != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Must call MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);first");
1566 
1567   /* allocate space for values if not already there */
1568   if (!aij->saved_values) {
1569     ierr = PetscMalloc1(nz+1,&aij->saved_values);CHKERRQ(ierr);
1570   }
1571 
1572   /* copy values over */
1573   ierr = PetscMemcpy(aij->saved_values,aij->a,nz*sizeof(PetscScalar));CHKERRQ(ierr);
1574   PetscFunctionReturn(0);
1575 }
1576 
1577 #undef __FUNCT__
1578 #define __FUNCT__ "MatRetrieveValues_SeqSBAIJ"
1579 PetscErrorCode  MatRetrieveValues_SeqSBAIJ(Mat mat)
1580 {
1581   Mat_SeqSBAIJ   *aij = (Mat_SeqSBAIJ*)mat->data;
1582   PetscErrorCode ierr;
1583   PetscInt       nz = aij->i[mat->rmap->N]*mat->rmap->bs*aij->bs2;
1584 
1585   PetscFunctionBegin;
1586   if (aij->nonew != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Must call MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);first");
1587   if (!aij->saved_values) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Must call MatStoreValues(A);first");
1588 
1589   /* copy values over */
1590   ierr = PetscMemcpy(aij->a,aij->saved_values,nz*sizeof(PetscScalar));CHKERRQ(ierr);
1591   PetscFunctionReturn(0);
1592 }
1593 
1594 #undef __FUNCT__
1595 #define __FUNCT__ "MatSeqSBAIJSetPreallocation_SeqSBAIJ"
1596 static PetscErrorCode  MatSeqSBAIJSetPreallocation_SeqSBAIJ(Mat B,PetscInt bs,PetscInt nz,PetscInt *nnz)
1597 {
1598   Mat_SeqSBAIJ   *b = (Mat_SeqSBAIJ*)B->data;
1599   PetscErrorCode ierr;
1600   PetscInt       i,mbs,nbs,bs2;
1601   PetscBool      skipallocation = PETSC_FALSE,flg = PETSC_FALSE,realalloc = PETSC_FALSE;
1602 
1603   PetscFunctionBegin;
1604   if (nz >= 0 || nnz) realalloc = PETSC_TRUE;
1605   B->preallocated = PETSC_TRUE;
1606 
1607   ierr = MatSetBlockSize(B,PetscAbs(bs));CHKERRQ(ierr);
1608   ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
1609   ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
1610   ierr = PetscLayoutGetBlockSize(B->rmap,&bs);CHKERRQ(ierr);
1611 
1612   mbs = B->rmap->N/bs;
1613   nbs = B->cmap->n/bs;
1614   bs2 = bs*bs;
1615 
1616   if (mbs*bs != B->rmap->N || nbs*bs!=B->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Number rows, cols must be divisible by blocksize");
1617 
1618   if (nz == MAT_SKIP_ALLOCATION) {
1619     skipallocation = PETSC_TRUE;
1620     nz             = 0;
1621   }
1622 
1623   if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 3;
1624   if (nz < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nz cannot be less than 0: value %D",nz);
1625   if (nnz) {
1626     for (i=0; i<mbs; i++) {
1627       if (nnz[i] < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nnz cannot be less than 0: local row %D value %D",i,nnz[i]);
1628       if (nnz[i] > nbs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nnz cannot be greater than block row length: local row %D value %D block rowlength %D",i,nnz[i],nbs);
1629     }
1630   }
1631 
1632   B->ops->mult             = MatMult_SeqSBAIJ_N;
1633   B->ops->multadd          = MatMultAdd_SeqSBAIJ_N;
1634   B->ops->multtranspose    = MatMult_SeqSBAIJ_N;
1635   B->ops->multtransposeadd = MatMultAdd_SeqSBAIJ_N;
1636 
1637   ierr  = PetscOptionsGetBool(((PetscObject)B)->options,((PetscObject)B)->prefix,"-mat_no_unroll",&flg,NULL);CHKERRQ(ierr);
1638   if (!flg) {
1639     switch (bs) {
1640     case 1:
1641       B->ops->mult             = MatMult_SeqSBAIJ_1;
1642       B->ops->multadd          = MatMultAdd_SeqSBAIJ_1;
1643       B->ops->multtranspose    = MatMult_SeqSBAIJ_1;
1644       B->ops->multtransposeadd = MatMultAdd_SeqSBAIJ_1;
1645       break;
1646     case 2:
1647       B->ops->mult             = MatMult_SeqSBAIJ_2;
1648       B->ops->multadd          = MatMultAdd_SeqSBAIJ_2;
1649       B->ops->multtranspose    = MatMult_SeqSBAIJ_2;
1650       B->ops->multtransposeadd = MatMultAdd_SeqSBAIJ_2;
1651       break;
1652     case 3:
1653       B->ops->mult             = MatMult_SeqSBAIJ_3;
1654       B->ops->multadd          = MatMultAdd_SeqSBAIJ_3;
1655       B->ops->multtranspose    = MatMult_SeqSBAIJ_3;
1656       B->ops->multtransposeadd = MatMultAdd_SeqSBAIJ_3;
1657       break;
1658     case 4:
1659       B->ops->mult             = MatMult_SeqSBAIJ_4;
1660       B->ops->multadd          = MatMultAdd_SeqSBAIJ_4;
1661       B->ops->multtranspose    = MatMult_SeqSBAIJ_4;
1662       B->ops->multtransposeadd = MatMultAdd_SeqSBAIJ_4;
1663       break;
1664     case 5:
1665       B->ops->mult             = MatMult_SeqSBAIJ_5;
1666       B->ops->multadd          = MatMultAdd_SeqSBAIJ_5;
1667       B->ops->multtranspose    = MatMult_SeqSBAIJ_5;
1668       B->ops->multtransposeadd = MatMultAdd_SeqSBAIJ_5;
1669       break;
1670     case 6:
1671       B->ops->mult             = MatMult_SeqSBAIJ_6;
1672       B->ops->multadd          = MatMultAdd_SeqSBAIJ_6;
1673       B->ops->multtranspose    = MatMult_SeqSBAIJ_6;
1674       B->ops->multtransposeadd = MatMultAdd_SeqSBAIJ_6;
1675       break;
1676     case 7:
1677       B->ops->mult             = MatMult_SeqSBAIJ_7;
1678       B->ops->multadd          = MatMultAdd_SeqSBAIJ_7;
1679       B->ops->multtranspose    = MatMult_SeqSBAIJ_7;
1680       B->ops->multtransposeadd = MatMultAdd_SeqSBAIJ_7;
1681       break;
1682     }
1683   }
1684 
1685   b->mbs = mbs;
1686   b->nbs = nbs;
1687   if (!skipallocation) {
1688     if (!b->imax) {
1689       ierr = PetscMalloc2(mbs,&b->imax,mbs,&b->ilen);CHKERRQ(ierr);
1690 
1691       b->free_imax_ilen = PETSC_TRUE;
1692 
1693       ierr = PetscLogObjectMemory((PetscObject)B,2*mbs*sizeof(PetscInt));CHKERRQ(ierr);
1694     }
1695     if (!nnz) {
1696       if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 5;
1697       else if (nz <= 0) nz = 1;
1698       for (i=0; i<mbs; i++) b->imax[i] = nz;
1699       nz = nz*mbs; /* total nz */
1700     } else {
1701       nz = 0;
1702       for (i=0; i<mbs; i++) {b->imax[i] = nnz[i]; nz += nnz[i];}
1703     }
1704     /* b->ilen will count nonzeros in each block row so far. */
1705     for (i=0; i<mbs; i++) b->ilen[i] = 0;
1706     /* nz=(nz+mbs)/2; */ /* total diagonal and superdiagonal nonzero blocks */
1707 
1708     /* allocate the matrix space */
1709     ierr = MatSeqXAIJFreeAIJ(B,&b->a,&b->j,&b->i);CHKERRQ(ierr);
1710     ierr = PetscMalloc3(bs2*nz,&b->a,nz,&b->j,B->rmap->N+1,&b->i);CHKERRQ(ierr);
1711     ierr = PetscLogObjectMemory((PetscObject)B,(B->rmap->N+1)*sizeof(PetscInt)+nz*(bs2*sizeof(PetscScalar)+sizeof(PetscInt)));CHKERRQ(ierr);
1712     ierr = PetscMemzero(b->a,nz*bs2*sizeof(MatScalar));CHKERRQ(ierr);
1713     ierr = PetscMemzero(b->j,nz*sizeof(PetscInt));CHKERRQ(ierr);
1714 
1715     b->singlemalloc = PETSC_TRUE;
1716 
1717     /* pointer to beginning of each row */
1718     b->i[0] = 0;
1719     for (i=1; i<mbs+1; i++) b->i[i] = b->i[i-1] + b->imax[i-1];
1720 
1721     b->free_a  = PETSC_TRUE;
1722     b->free_ij = PETSC_TRUE;
1723   } else {
1724     b->free_a  = PETSC_FALSE;
1725     b->free_ij = PETSC_FALSE;
1726   }
1727 
1728   B->rmap->bs = bs;
1729   b->bs2      = bs2;
1730   b->nz       = 0;
1731   b->maxnz    = nz;
1732 
1733   b->inew    = 0;
1734   b->jnew    = 0;
1735   b->anew    = 0;
1736   b->a2anew  = 0;
1737   b->permute = PETSC_FALSE;
1738   if (realalloc) {ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);}
1739   PetscFunctionReturn(0);
1740 }
1741 
1742 #undef __FUNCT__
1743 #define __FUNCT__ "MatSeqSBAIJSetPreallocationCSR_SeqSBAIJ"
1744 PetscErrorCode MatSeqSBAIJSetPreallocationCSR_SeqSBAIJ(Mat B,PetscInt bs,const PetscInt ii[],const PetscInt jj[], const PetscScalar V[])
1745 {
1746   PetscInt       i,j,m,nz,nz_max=0,*nnz;
1747   PetscScalar    *values=0;
1748   PetscBool      roworiented = ((Mat_SeqSBAIJ*)B->data)->roworiented;
1749   PetscErrorCode ierr;
1750   PetscFunctionBegin;
1751   if (bs < 1) SETERRQ1(PetscObjectComm((PetscObject)B),PETSC_ERR_ARG_OUTOFRANGE,"Invalid block size specified, must be positive but it is %D",bs);
1752   ierr   = PetscLayoutSetBlockSize(B->rmap,bs);CHKERRQ(ierr);
1753   ierr   = PetscLayoutSetBlockSize(B->cmap,bs);CHKERRQ(ierr);
1754   ierr   = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
1755   ierr   = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
1756   ierr   = PetscLayoutGetBlockSize(B->rmap,&bs);CHKERRQ(ierr);
1757   m      = B->rmap->n/bs;
1758 
1759   if (ii[0]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"ii[0] must be 0 but it is %D",ii[0]);
1760   ierr = PetscMalloc1(m+1,&nnz);CHKERRQ(ierr);
1761   for (i=0; i<m; i++) {
1762     nz = ii[i+1] - ii[i];
1763     if (nz < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D has a negative number of columns %D",i,nz);
1764     nz_max = PetscMax(nz_max,nz);
1765     nnz[i] = nz;
1766   }
1767   ierr = MatSeqSBAIJSetPreallocation(B,bs,0,nnz);CHKERRQ(ierr);
1768   ierr = PetscFree(nnz);CHKERRQ(ierr);
1769 
1770   values = (PetscScalar*)V;
1771   if (!values) {
1772     ierr = PetscCalloc1(bs*bs*nz_max,&values);CHKERRQ(ierr);
1773   }
1774   for (i=0; i<m; i++) {
1775     PetscInt          ncols  = ii[i+1] - ii[i];
1776     const PetscInt    *icols = jj + ii[i];
1777     if (!roworiented || bs == 1) {
1778       const PetscScalar *svals = values + (V ? (bs*bs*ii[i]) : 0);
1779       ierr = MatSetValuesBlocked_SeqSBAIJ(B,1,&i,ncols,icols,svals,INSERT_VALUES);CHKERRQ(ierr);
1780     } else {
1781       for (j=0; j<ncols; j++) {
1782         const PetscScalar *svals = values + (V ? (bs*bs*(ii[i]+j)) : 0);
1783         ierr = MatSetValuesBlocked_SeqSBAIJ(B,1,&i,1,&icols[j],svals,INSERT_VALUES);CHKERRQ(ierr);
1784       }
1785     }
1786   }
1787   if (!V) { ierr = PetscFree(values);CHKERRQ(ierr); }
1788   ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1789   ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1790   ierr = MatSetOption(B,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
1791   PetscFunctionReturn(0);
1792 }
1793 
1794 /*
1795    This is used to set the numeric factorization for both Cholesky and ICC symbolic factorization
1796 */
1797 #undef __FUNCT__
1798 #define __FUNCT__ "MatSeqSBAIJSetNumericFactorization_inplace"
1799 PetscErrorCode MatSeqSBAIJSetNumericFactorization_inplace(Mat B,PetscBool natural)
1800 {
1801   PetscErrorCode ierr;
1802   PetscBool      flg = PETSC_FALSE;
1803   PetscInt       bs  = B->rmap->bs;
1804 
1805   PetscFunctionBegin;
1806   ierr = PetscOptionsGetBool(((PetscObject)B)->options,((PetscObject)B)->prefix,"-mat_no_unroll",&flg,NULL);CHKERRQ(ierr);
1807   if (flg) bs = 8;
1808 
1809   if (!natural) {
1810     switch (bs) {
1811     case 1:
1812       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_1_inplace;
1813       break;
1814     case 2:
1815       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_2;
1816       break;
1817     case 3:
1818       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_3;
1819       break;
1820     case 4:
1821       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_4;
1822       break;
1823     case 5:
1824       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_5;
1825       break;
1826     case 6:
1827       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_6;
1828       break;
1829     case 7:
1830       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_7;
1831       break;
1832     default:
1833       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_N;
1834       break;
1835     }
1836   } else {
1837     switch (bs) {
1838     case 1:
1839       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_1_NaturalOrdering_inplace;
1840       break;
1841     case 2:
1842       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_2_NaturalOrdering;
1843       break;
1844     case 3:
1845       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_3_NaturalOrdering;
1846       break;
1847     case 4:
1848       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_4_NaturalOrdering;
1849       break;
1850     case 5:
1851       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_5_NaturalOrdering;
1852       break;
1853     case 6:
1854       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_6_NaturalOrdering;
1855       break;
1856     case 7:
1857       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_7_NaturalOrdering;
1858       break;
1859     default:
1860       B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_N_NaturalOrdering;
1861       break;
1862     }
1863   }
1864   PetscFunctionReturn(0);
1865 }
1866 
1867 PETSC_INTERN PetscErrorCode MatConvert_SeqSBAIJ_SeqAIJ(Mat, MatType,MatReuse,Mat*);
1868 PETSC_INTERN PetscErrorCode MatConvert_SeqSBAIJ_SeqBAIJ(Mat, MatType,MatReuse,Mat*);
1869 
1870 #undef __FUNCT__
1871 #define __FUNCT__ "MatGetFactor_seqsbaij_petsc"
1872 PETSC_INTERN PetscErrorCode MatGetFactor_seqsbaij_petsc(Mat A,MatFactorType ftype,Mat *B)
1873 {
1874   PetscInt       n = A->rmap->n;
1875   PetscErrorCode ierr;
1876 
1877   PetscFunctionBegin;
1878 #if defined(PETSC_USE_COMPLEX)
1879   if (A->hermitian) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Hermitian Factor is not supported");
1880 #endif
1881   ierr = MatCreate(PetscObjectComm((PetscObject)A),B);CHKERRQ(ierr);
1882   ierr = MatSetSizes(*B,n,n,n,n);CHKERRQ(ierr);
1883   if (ftype == MAT_FACTOR_CHOLESKY || ftype == MAT_FACTOR_ICC) {
1884     ierr = MatSetType(*B,MATSEQSBAIJ);CHKERRQ(ierr);
1885     ierr = MatSeqSBAIJSetPreallocation(*B,A->rmap->bs,MAT_SKIP_ALLOCATION,NULL);CHKERRQ(ierr);
1886 
1887     (*B)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqSBAIJ;
1888     (*B)->ops->iccfactorsymbolic      = MatICCFactorSymbolic_SeqSBAIJ;
1889   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Factor type not supported");
1890 
1891   (*B)->factortype = ftype;
1892   ierr = PetscFree((*B)->solvertype);CHKERRQ(ierr);
1893   ierr = PetscStrallocpy(MATSOLVERPETSC,&(*B)->solvertype);CHKERRQ(ierr);
1894   PetscFunctionReturn(0);
1895 }
1896 
1897 /*MC
1898   MATSEQSBAIJ - MATSEQSBAIJ = "seqsbaij" - A matrix type to be used for sequential symmetric block sparse matrices,
1899   based on block compressed sparse row format.  Only the upper triangular portion of the matrix is stored.
1900 
1901   For complex numbers by default this matrix is symmetric, NOT Hermitian symmetric. To make it Hermitian symmetric you
1902   can call MatSetOption(Mat, MAT_HERMITIAN); after MatAssemblyEnd()
1903 
1904   Options Database Keys:
1905   . -mat_type seqsbaij - sets the matrix type to "seqsbaij" during a call to MatSetFromOptions()
1906 
1907   Notes: By default if you insert values into the lower triangular part of the matrix they are simply ignored (since they are not
1908      stored and it is assumed they symmetric to the upper triangular). If you call MatSetOption(Mat,MAT_IGNORE_LOWER_TRIANGULAR,PETSC_FALSE) or use
1909      the options database -mat_ignore_lower_triangular false it will generate an error if you try to set a value in the lower triangular portion.
1910 
1911 
1912   Level: beginner
1913 
1914   .seealso: MatCreateSeqSBAIJ
1915 M*/
1916 
1917 PETSC_INTERN PetscErrorCode MatConvert_SeqSBAIJ_SeqSBSTRM(Mat, MatType,MatReuse,Mat*);
1918 
1919 #undef __FUNCT__
1920 #define __FUNCT__ "MatCreate_SeqSBAIJ"
1921 PETSC_EXTERN PetscErrorCode MatCreate_SeqSBAIJ(Mat B)
1922 {
1923   Mat_SeqSBAIJ   *b;
1924   PetscErrorCode ierr;
1925   PetscMPIInt    size;
1926   PetscBool      no_unroll = PETSC_FALSE,no_inode = PETSC_FALSE;
1927 
1928   PetscFunctionBegin;
1929   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)B),&size);CHKERRQ(ierr);
1930   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Comm must be of size 1");
1931 
1932   ierr    = PetscNewLog(B,&b);CHKERRQ(ierr);
1933   B->data = (void*)b;
1934   ierr    = PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
1935 
1936   B->ops->destroy    = MatDestroy_SeqSBAIJ;
1937   B->ops->view       = MatView_SeqSBAIJ;
1938   b->row             = 0;
1939   b->icol            = 0;
1940   b->reallocs        = 0;
1941   b->saved_values    = 0;
1942   b->inode.limit     = 5;
1943   b->inode.max_limit = 5;
1944 
1945   b->roworiented        = PETSC_TRUE;
1946   b->nonew              = 0;
1947   b->diag               = 0;
1948   b->solve_work         = 0;
1949   b->mult_work          = 0;
1950   B->spptr              = 0;
1951   B->info.nz_unneeded   = (PetscReal)b->maxnz*b->bs2;
1952   b->keepnonzeropattern = PETSC_FALSE;
1953 
1954   b->inew    = 0;
1955   b->jnew    = 0;
1956   b->anew    = 0;
1957   b->a2anew  = 0;
1958   b->permute = PETSC_FALSE;
1959 
1960   b->ignore_ltriangular = PETSC_TRUE;
1961 
1962   ierr = PetscOptionsGetBool(((PetscObject)B)->options,((PetscObject)B)->prefix,"-mat_ignore_lower_triangular",&b->ignore_ltriangular,NULL);CHKERRQ(ierr);
1963 
1964   b->getrow_utriangular = PETSC_FALSE;
1965 
1966   ierr = PetscOptionsGetBool(((PetscObject)B)->options,((PetscObject)B)->prefix,"-mat_getrow_uppertriangular",&b->getrow_utriangular,NULL);CHKERRQ(ierr);
1967 
1968   ierr = PetscObjectComposeFunction((PetscObject)B,"MatStoreValues_C",MatStoreValues_SeqSBAIJ);CHKERRQ(ierr);
1969   ierr = PetscObjectComposeFunction((PetscObject)B,"MatRetrieveValues_C",MatRetrieveValues_SeqSBAIJ);CHKERRQ(ierr);
1970   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqSBAIJSetColumnIndices_C",MatSeqSBAIJSetColumnIndices_SeqSBAIJ);CHKERRQ(ierr);
1971   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqsbaij_seqaij_C",MatConvert_SeqSBAIJ_SeqAIJ);CHKERRQ(ierr);
1972   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqsbaij_seqbaij_C",MatConvert_SeqSBAIJ_SeqBAIJ);CHKERRQ(ierr);
1973   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqSBAIJSetPreallocation_C",MatSeqSBAIJSetPreallocation_SeqSBAIJ);CHKERRQ(ierr);
1974   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqSBAIJSetPreallocationCSR_C",MatSeqSBAIJSetPreallocationCSR_SeqSBAIJ);CHKERRQ(ierr);
1975 #if defined(PETSC_HAVE_ELEMENTAL)
1976   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqsbaij_elemental_C",MatConvert_SeqSBAIJ_Elemental);CHKERRQ(ierr);
1977 #endif
1978 
1979   B->symmetric                  = PETSC_TRUE;
1980   B->structurally_symmetric     = PETSC_TRUE;
1981   B->symmetric_set              = PETSC_TRUE;
1982   B->structurally_symmetric_set = PETSC_TRUE;
1983 
1984   ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQSBAIJ);CHKERRQ(ierr);
1985 
1986   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)B),((PetscObject)B)->prefix,"Options for SEQSBAIJ matrix","Mat");CHKERRQ(ierr);
1987   ierr = PetscOptionsBool("-mat_no_unroll","Do not optimize for inodes (slower)",NULL,no_unroll,&no_unroll,NULL);CHKERRQ(ierr);
1988   if (no_unroll) {
1989     ierr = PetscInfo(B,"Not using Inode routines due to -mat_no_unroll\n");CHKERRQ(ierr);
1990   }
1991   ierr = PetscOptionsBool("-mat_no_inode","Do not optimize for inodes (slower)",NULL,no_inode,&no_inode,NULL);CHKERRQ(ierr);
1992   if (no_inode) {
1993     ierr = PetscInfo(B,"Not using Inode routines due to -mat_no_inode\n");CHKERRQ(ierr);
1994   }
1995   ierr = PetscOptionsInt("-mat_inode_limit","Do not use inodes larger then this value",NULL,b->inode.limit,&b->inode.limit,NULL);CHKERRQ(ierr);
1996   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1997   b->inode.use = (PetscBool)(!(no_unroll || no_inode));
1998   if (b->inode.limit > b->inode.max_limit) b->inode.limit = b->inode.max_limit;
1999   PetscFunctionReturn(0);
2000 }
2001 
2002 #undef __FUNCT__
2003 #define __FUNCT__ "MatSeqSBAIJSetPreallocation"
2004 /*@C
2005    MatSeqSBAIJSetPreallocation - Creates a sparse symmetric matrix in block AIJ (block
2006    compressed row) format.  For good matrix assembly performance the
2007    user should preallocate the matrix storage by setting the parameter nz
2008    (or the array nnz).  By setting these parameters accurately, performance
2009    during matrix assembly can be increased by more than a factor of 50.
2010 
2011    Collective on Mat
2012 
2013    Input Parameters:
2014 +  B - the symmetric matrix
2015 .  bs - size of block, the blocks are ALWAYS square. One can use MatSetBlockSizes() to set a different row and column blocksize but the row
2016           blocksize always defines the size of the blocks. The column blocksize sets the blocksize of the vectors obtained with MatCreateVecs()
2017 .  nz - number of block nonzeros per block row (same for all rows)
2018 -  nnz - array containing the number of block nonzeros in the upper triangular plus
2019          diagonal portion of each block (possibly different for each block row) or NULL
2020 
2021    Options Database Keys:
2022 .   -mat_no_unroll - uses code that does not unroll the loops in the
2023                      block calculations (much slower)
2024 .   -mat_block_size - size of the blocks to use (only works if a negative bs is passed in
2025 
2026    Level: intermediate
2027 
2028    Notes:
2029    Specify the preallocated storage with either nz or nnz (not both).
2030    Set nz=PETSC_DEFAULT and nnz=NULL for PETSc to control dynamic memory
2031    allocation.  See Users-Manual: ch_mat for details.
2032 
2033    You can call MatGetInfo() to get information on how effective the preallocation was;
2034    for example the fields mallocs,nz_allocated,nz_used,nz_unneeded;
2035    You can also run with the option -info and look for messages with the string
2036    malloc in them to see if additional memory allocation was needed.
2037 
2038    If the nnz parameter is given then the nz parameter is ignored
2039 
2040 
2041 .seealso: MatCreate(), MatCreateSeqAIJ(), MatSetValues(), MatCreateSBAIJ()
2042 @*/
2043 PetscErrorCode  MatSeqSBAIJSetPreallocation(Mat B,PetscInt bs,PetscInt nz,const PetscInt nnz[])
2044 {
2045   PetscErrorCode ierr;
2046 
2047   PetscFunctionBegin;
2048   PetscValidHeaderSpecific(B,MAT_CLASSID,1);
2049   PetscValidType(B,1);
2050   PetscValidLogicalCollectiveInt(B,bs,2);
2051   ierr = PetscTryMethod(B,"MatSeqSBAIJSetPreallocation_C",(Mat,PetscInt,PetscInt,const PetscInt[]),(B,bs,nz,nnz));CHKERRQ(ierr);
2052   PetscFunctionReturn(0);
2053 }
2054 
2055 #undef  __FUNCT__
2056 #define __FUNCT__ "MatSeqSBAIJSetPreallocationCSR"
2057 /*@C
2058    MatSeqSBAIJSetPreallocationCSR - Allocates memory for a sparse sequential matrix in symmetric block AIJ format.
2059 
2060    Input Parameters:
2061 +  B - the matrix
2062 .  bs - size of block, the blocks are ALWAYS square.
2063 .  i - the indices into j for the start of each local row (starts with zero)
2064 .  j - the column indices for each local row (starts with zero) these must be sorted for each row
2065 -  v - optional values in the matrix
2066 
2067    Level: developer
2068 
2069    Notes:
2070    The order of the entries in values is specified by the MatOption MAT_ROW_ORIENTED.  For example, C programs
2071    may want to use the default MAT_ROW_ORIENTED=PETSC_TRUE and use an array v[nnz][bs][bs] where the second index is
2072    over rows within a block and the last index is over columns within a block row.  Fortran programs will likely set
2073    MAT_ROW_ORIENTED=PETSC_FALSE and use a Fortran array v(bs,bs,nnz) in which the first index is over rows within a
2074    block column and the second index is over columns within a block.
2075 
2076 .keywords: matrix, block, aij, compressed row, sparse
2077 
2078 .seealso: MatCreate(), MatCreateSeqSBAIJ(), MatSetValuesBlocked(), MatSeqSBAIJSetPreallocation(), MATSEQSBAIJ
2079 @*/
2080 PetscErrorCode MatSeqSBAIJSetPreallocationCSR(Mat B,PetscInt bs,const PetscInt i[],const PetscInt j[], const PetscScalar v[])
2081 {
2082   PetscErrorCode ierr;
2083 
2084   PetscFunctionBegin;
2085   PetscValidHeaderSpecific(B,MAT_CLASSID,1);
2086   PetscValidType(B,1);
2087   PetscValidLogicalCollectiveInt(B,bs,2);
2088   ierr = PetscTryMethod(B,"MatSeqSBAIJSetPreallocationCSR_C",(Mat,PetscInt,const PetscInt[],const PetscInt[],const PetscScalar[]),(B,bs,i,j,v));CHKERRQ(ierr);
2089   PetscFunctionReturn(0);
2090 }
2091 
2092 #undef __FUNCT__
2093 #define __FUNCT__ "MatCreateSeqSBAIJ"
2094 /*@C
2095    MatCreateSeqSBAIJ - Creates a sparse symmetric matrix in block AIJ (block
2096    compressed row) format.  For good matrix assembly performance the
2097    user should preallocate the matrix storage by setting the parameter nz
2098    (or the array nnz).  By setting these parameters accurately, performance
2099    during matrix assembly can be increased by more than a factor of 50.
2100 
2101    Collective on MPI_Comm
2102 
2103    Input Parameters:
2104 +  comm - MPI communicator, set to PETSC_COMM_SELF
2105 .  bs - size of block, the blocks are ALWAYS square. One can use MatSetBlockSizes() to set a different row and column blocksize but the row
2106           blocksize always defines the size of the blocks. The column blocksize sets the blocksize of the vectors obtained with MatCreateVecs()
2107 .  m - number of rows, or number of columns
2108 .  nz - number of block nonzeros per block row (same for all rows)
2109 -  nnz - array containing the number of block nonzeros in the upper triangular plus
2110          diagonal portion of each block (possibly different for each block row) or NULL
2111 
2112    Output Parameter:
2113 .  A - the symmetric matrix
2114 
2115    Options Database Keys:
2116 .   -mat_no_unroll - uses code that does not unroll the loops in the
2117                      block calculations (much slower)
2118 .    -mat_block_size - size of the blocks to use
2119 
2120    Level: intermediate
2121 
2122    It is recommended that one use the MatCreate(), MatSetType() and/or MatSetFromOptions(),
2123    MatXXXXSetPreallocation() paradgm instead of this routine directly.
2124    [MatXXXXSetPreallocation() is, for example, MatSeqAIJSetPreallocation]
2125 
2126    Notes:
2127    The number of rows and columns must be divisible by blocksize.
2128    This matrix type does not support complex Hermitian operation.
2129 
2130    Specify the preallocated storage with either nz or nnz (not both).
2131    Set nz=PETSC_DEFAULT and nnz=NULL for PETSc to control dynamic memory
2132    allocation.  See Users-Manual: ch_mat for details.
2133 
2134    If the nnz parameter is given then the nz parameter is ignored
2135 
2136 .seealso: MatCreate(), MatCreateSeqAIJ(), MatSetValues(), MatCreateSBAIJ()
2137 @*/
2138 PetscErrorCode  MatCreateSeqSBAIJ(MPI_Comm comm,PetscInt bs,PetscInt m,PetscInt n,PetscInt nz,const PetscInt nnz[],Mat *A)
2139 {
2140   PetscErrorCode ierr;
2141 
2142   PetscFunctionBegin;
2143   ierr = MatCreate(comm,A);CHKERRQ(ierr);
2144   ierr = MatSetSizes(*A,m,n,m,n);CHKERRQ(ierr);
2145   ierr = MatSetType(*A,MATSEQSBAIJ);CHKERRQ(ierr);
2146   ierr = MatSeqSBAIJSetPreallocation(*A,bs,nz,(PetscInt*)nnz);CHKERRQ(ierr);
2147   PetscFunctionReturn(0);
2148 }
2149 
2150 #undef __FUNCT__
2151 #define __FUNCT__ "MatDuplicate_SeqSBAIJ"
2152 PetscErrorCode MatDuplicate_SeqSBAIJ(Mat A,MatDuplicateOption cpvalues,Mat *B)
2153 {
2154   Mat            C;
2155   Mat_SeqSBAIJ   *c,*a = (Mat_SeqSBAIJ*)A->data;
2156   PetscErrorCode ierr;
2157   PetscInt       i,mbs = a->mbs,nz = a->nz,bs2 =a->bs2;
2158 
2159   PetscFunctionBegin;
2160   if (a->i[mbs] != nz) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Corrupt matrix");
2161 
2162   *B   = 0;
2163   ierr = MatCreate(PetscObjectComm((PetscObject)A),&C);CHKERRQ(ierr);
2164   ierr = MatSetSizes(C,A->rmap->N,A->cmap->n,A->rmap->N,A->cmap->n);CHKERRQ(ierr);
2165   ierr = MatSetType(C,MATSEQSBAIJ);CHKERRQ(ierr);
2166   ierr = PetscMemcpy(C->ops,A->ops,sizeof(struct _MatOps));CHKERRQ(ierr);
2167   c    = (Mat_SeqSBAIJ*)C->data;
2168 
2169   C->preallocated       = PETSC_TRUE;
2170   C->factortype         = A->factortype;
2171   c->row                = 0;
2172   c->icol               = 0;
2173   c->saved_values       = 0;
2174   c->keepnonzeropattern = a->keepnonzeropattern;
2175   C->assembled          = PETSC_TRUE;
2176 
2177   ierr   = PetscLayoutReference(A->rmap,&C->rmap);CHKERRQ(ierr);
2178   ierr   = PetscLayoutReference(A->cmap,&C->cmap);CHKERRQ(ierr);
2179   c->bs2 = a->bs2;
2180   c->mbs = a->mbs;
2181   c->nbs = a->nbs;
2182 
2183   if  (cpvalues == MAT_SHARE_NONZERO_PATTERN) {
2184     c->imax           = a->imax;
2185     c->ilen           = a->ilen;
2186     c->free_imax_ilen = PETSC_FALSE;
2187   } else {
2188     ierr = PetscMalloc2((mbs+1),&c->imax,(mbs+1),&c->ilen);CHKERRQ(ierr);
2189     ierr = PetscLogObjectMemory((PetscObject)C,2*(mbs+1)*sizeof(PetscInt));CHKERRQ(ierr);
2190     for (i=0; i<mbs; i++) {
2191       c->imax[i] = a->imax[i];
2192       c->ilen[i] = a->ilen[i];
2193     }
2194     c->free_imax_ilen = PETSC_TRUE;
2195   }
2196 
2197   /* allocate the matrix space */
2198   if (cpvalues == MAT_SHARE_NONZERO_PATTERN) {
2199     ierr            = PetscMalloc1(bs2*nz,&c->a);CHKERRQ(ierr);
2200     ierr            = PetscLogObjectMemory((PetscObject)C,nz*bs2*sizeof(MatScalar));CHKERRQ(ierr);
2201     c->i            = a->i;
2202     c->j            = a->j;
2203     c->singlemalloc = PETSC_FALSE;
2204     c->free_a       = PETSC_TRUE;
2205     c->free_ij      = PETSC_FALSE;
2206     c->parent       = A;
2207     ierr            = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2208     ierr            = MatSetOption(A,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2209     ierr            = MatSetOption(C,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2210   } else {
2211     ierr            = PetscMalloc3(bs2*nz,&c->a,nz,&c->j,mbs+1,&c->i);CHKERRQ(ierr);
2212     ierr            = PetscMemcpy(c->i,a->i,(mbs+1)*sizeof(PetscInt));CHKERRQ(ierr);
2213     ierr            = PetscLogObjectMemory((PetscObject)C,(mbs+1)*sizeof(PetscInt) + nz*(bs2*sizeof(MatScalar) + sizeof(PetscInt)));CHKERRQ(ierr);
2214     c->singlemalloc = PETSC_TRUE;
2215     c->free_a       = PETSC_TRUE;
2216     c->free_ij      = PETSC_TRUE;
2217   }
2218   if (mbs > 0) {
2219     if (cpvalues != MAT_SHARE_NONZERO_PATTERN) {
2220       ierr = PetscMemcpy(c->j,a->j,nz*sizeof(PetscInt));CHKERRQ(ierr);
2221     }
2222     if (cpvalues == MAT_COPY_VALUES) {
2223       ierr = PetscMemcpy(c->a,a->a,bs2*nz*sizeof(MatScalar));CHKERRQ(ierr);
2224     } else {
2225       ierr = PetscMemzero(c->a,bs2*nz*sizeof(MatScalar));CHKERRQ(ierr);
2226     }
2227     if (a->jshort) {
2228       /* cannot share jshort, it is reallocated in MatAssemblyEnd_SeqSBAIJ() */
2229       /* if the parent matrix is reassembled, this child matrix will never notice */
2230       ierr = PetscMalloc1(nz,&c->jshort);CHKERRQ(ierr);
2231       ierr = PetscLogObjectMemory((PetscObject)C,nz*sizeof(unsigned short));CHKERRQ(ierr);
2232       ierr = PetscMemcpy(c->jshort,a->jshort,nz*sizeof(unsigned short));CHKERRQ(ierr);
2233 
2234       c->free_jshort = PETSC_TRUE;
2235     }
2236   }
2237 
2238   c->roworiented = a->roworiented;
2239   c->nonew       = a->nonew;
2240 
2241   if (a->diag) {
2242     if (cpvalues == MAT_SHARE_NONZERO_PATTERN) {
2243       c->diag      = a->diag;
2244       c->free_diag = PETSC_FALSE;
2245     } else {
2246       ierr = PetscMalloc1(mbs,&c->diag);CHKERRQ(ierr);
2247       ierr = PetscLogObjectMemory((PetscObject)C,mbs*sizeof(PetscInt));CHKERRQ(ierr);
2248       for (i=0; i<mbs; i++) c->diag[i] = a->diag[i];
2249       c->free_diag = PETSC_TRUE;
2250     }
2251   }
2252   c->nz         = a->nz;
2253   c->maxnz      = a->nz; /* Since we allocate exactly the right amount */
2254   c->solve_work = 0;
2255   c->mult_work  = 0;
2256 
2257   *B   = C;
2258   ierr = PetscFunctionListDuplicate(((PetscObject)A)->qlist,&((PetscObject)C)->qlist);CHKERRQ(ierr);
2259   PetscFunctionReturn(0);
2260 }
2261 
2262 #undef __FUNCT__
2263 #define __FUNCT__ "MatLoad_SeqSBAIJ"
2264 PetscErrorCode MatLoad_SeqSBAIJ(Mat newmat,PetscViewer viewer)
2265 {
2266   Mat_SeqSBAIJ   *a;
2267   PetscErrorCode ierr;
2268   int            fd;
2269   PetscMPIInt    size;
2270   PetscInt       i,nz,header[4],*rowlengths=0,M,N,bs = newmat->rmap->bs;
2271   PetscInt       *mask,mbs,*jj,j,rowcount,nzcount,k,*s_browlengths,maskcount;
2272   PetscInt       kmax,jcount,block,idx,point,nzcountb,extra_rows,rows,cols;
2273   PetscInt       *masked,nmask,tmp,bs2,ishift;
2274   PetscScalar    *aa;
2275   MPI_Comm       comm;
2276 
2277   PetscFunctionBegin;
2278   /* force binary viewer to load .info file if it has not yet done so */
2279   ierr = PetscViewerSetUp(viewer);CHKERRQ(ierr);
2280   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
2281   ierr = PetscOptionsGetInt(((PetscObject)newmat)->options,((PetscObject)newmat)->prefix,"-matload_block_size",&bs,NULL);CHKERRQ(ierr);
2282   if (bs < 0) bs = 1;
2283   bs2  = bs*bs;
2284 
2285   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
2286   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"view must have one processor");
2287   ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
2288   ierr = PetscBinaryRead(fd,header,4,PETSC_INT);CHKERRQ(ierr);
2289   if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"not Mat object");
2290   M = header[1]; N = header[2]; nz = header[3];
2291 
2292   if (header[3] < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Matrix stored in special format, cannot load as SeqSBAIJ");
2293 
2294   if (M != N) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can only do square matrices");
2295 
2296   /*
2297      This code adds extra rows to make sure the number of rows is
2298     divisible by the blocksize
2299   */
2300   mbs        = M/bs;
2301   extra_rows = bs - M + bs*(mbs);
2302   if (extra_rows == bs) extra_rows = 0;
2303   else                  mbs++;
2304   if (extra_rows) {
2305     ierr = PetscInfo(viewer,"Padding loaded matrix to match blocksize\n");CHKERRQ(ierr);
2306   }
2307 
2308   /* Set global sizes if not already set */
2309   if (newmat->rmap->n < 0 && newmat->rmap->N < 0 && newmat->cmap->n < 0 && newmat->cmap->N < 0) {
2310     ierr = MatSetSizes(newmat,PETSC_DECIDE,PETSC_DECIDE,M+extra_rows,N+extra_rows);CHKERRQ(ierr);
2311   } else { /* Check if the matrix global sizes are correct */
2312     ierr = MatGetSize(newmat,&rows,&cols);CHKERRQ(ierr);
2313     if (M != rows ||  N != cols) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Matrix in file of different length (%d, %d) than the input matrix (%d, %d)",M,N,rows,cols);
2314   }
2315 
2316   /* read in row lengths */
2317   ierr = PetscMalloc1(M+extra_rows,&rowlengths);CHKERRQ(ierr);
2318   ierr = PetscBinaryRead(fd,rowlengths,M,PETSC_INT);CHKERRQ(ierr);
2319   for (i=0; i<extra_rows; i++) rowlengths[M+i] = 1;
2320 
2321   /* read in column indices */
2322   ierr = PetscMalloc1(nz+extra_rows,&jj);CHKERRQ(ierr);
2323   ierr = PetscBinaryRead(fd,jj,nz,PETSC_INT);CHKERRQ(ierr);
2324   for (i=0; i<extra_rows; i++) jj[nz+i] = M+i;
2325 
2326   /* loop over row lengths determining block row lengths */
2327   ierr     = PetscCalloc1(mbs,&s_browlengths);CHKERRQ(ierr);
2328   ierr     = PetscMalloc2(mbs,&mask,mbs,&masked);CHKERRQ(ierr);
2329   ierr     = PetscMemzero(mask,mbs*sizeof(PetscInt));CHKERRQ(ierr);
2330   rowcount = 0;
2331   nzcount  = 0;
2332   for (i=0; i<mbs; i++) {
2333     nmask = 0;
2334     for (j=0; j<bs; j++) {
2335       kmax = rowlengths[rowcount];
2336       for (k=0; k<kmax; k++) {
2337         tmp = jj[nzcount++]/bs;   /* block col. index */
2338         if (!mask[tmp] && tmp >= i) {masked[nmask++] = tmp; mask[tmp] = 1;}
2339       }
2340       rowcount++;
2341     }
2342     s_browlengths[i] += nmask;
2343 
2344     /* zero out the mask elements we set */
2345     for (j=0; j<nmask; j++) mask[masked[j]] = 0;
2346   }
2347 
2348   /* Do preallocation */
2349   ierr = MatSeqSBAIJSetPreallocation(newmat,bs,0,s_browlengths);CHKERRQ(ierr);
2350   a    = (Mat_SeqSBAIJ*)newmat->data;
2351 
2352   /* set matrix "i" values */
2353   a->i[0] = 0;
2354   for (i=1; i<= mbs; i++) {
2355     a->i[i]      = a->i[i-1] + s_browlengths[i-1];
2356     a->ilen[i-1] = s_browlengths[i-1];
2357   }
2358   a->nz = a->i[mbs];
2359 
2360   /* read in nonzero values */
2361   ierr = PetscMalloc1(nz+extra_rows,&aa);CHKERRQ(ierr);
2362   ierr = PetscBinaryRead(fd,aa,nz,PETSC_SCALAR);CHKERRQ(ierr);
2363   for (i=0; i<extra_rows; i++) aa[nz+i] = 1.0;
2364 
2365   /* set "a" and "j" values into matrix */
2366   nzcount = 0; jcount = 0;
2367   for (i=0; i<mbs; i++) {
2368     nzcountb = nzcount;
2369     nmask    = 0;
2370     for (j=0; j<bs; j++) {
2371       kmax = rowlengths[i*bs+j];
2372       for (k=0; k<kmax; k++) {
2373         tmp = jj[nzcount++]/bs; /* block col. index */
2374         if (!mask[tmp] && tmp >= i) { masked[nmask++] = tmp; mask[tmp] = 1;}
2375       }
2376     }
2377     /* sort the masked values */
2378     ierr = PetscSortInt(nmask,masked);CHKERRQ(ierr);
2379 
2380     /* set "j" values into matrix */
2381     maskcount = 1;
2382     for (j=0; j<nmask; j++) {
2383       a->j[jcount++]  = masked[j];
2384       mask[masked[j]] = maskcount++;
2385     }
2386 
2387     /* set "a" values into matrix */
2388     ishift = bs2*a->i[i];
2389     for (j=0; j<bs; j++) {
2390       kmax = rowlengths[i*bs+j];
2391       for (k=0; k<kmax; k++) {
2392         tmp = jj[nzcountb]/bs;        /* block col. index */
2393         if (tmp >= i) {
2394           block     = mask[tmp] - 1;
2395           point     = jj[nzcountb] - bs*tmp;
2396           idx       = ishift + bs2*block + j + bs*point;
2397           a->a[idx] = aa[nzcountb];
2398         }
2399         nzcountb++;
2400       }
2401     }
2402     /* zero out the mask elements we set */
2403     for (j=0; j<nmask; j++) mask[masked[j]] = 0;
2404   }
2405   if (jcount != a->nz) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Bad binary matrix");
2406 
2407   ierr = PetscFree(rowlengths);CHKERRQ(ierr);
2408   ierr = PetscFree(s_browlengths);CHKERRQ(ierr);
2409   ierr = PetscFree(aa);CHKERRQ(ierr);
2410   ierr = PetscFree(jj);CHKERRQ(ierr);
2411   ierr = PetscFree2(mask,masked);CHKERRQ(ierr);
2412 
2413   ierr = MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2414   ierr = MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2415   PetscFunctionReturn(0);
2416 }
2417 
2418 #undef __FUNCT__
2419 #define __FUNCT__ "MatCreateSeqSBAIJWithArrays"
2420 /*@
2421      MatCreateSeqSBAIJWithArrays - Creates an sequential SBAIJ matrix using matrix elements
2422               (upper triangular entries in CSR format) provided by the user.
2423 
2424      Collective on MPI_Comm
2425 
2426    Input Parameters:
2427 +  comm - must be an MPI communicator of size 1
2428 .  bs - size of block
2429 .  m - number of rows
2430 .  n - number of columns
2431 .  i - row indices
2432 .  j - column indices
2433 -  a - matrix values
2434 
2435    Output Parameter:
2436 .  mat - the matrix
2437 
2438    Level: advanced
2439 
2440    Notes:
2441        The i, j, and a arrays are not copied by this routine, the user must free these arrays
2442     once the matrix is destroyed
2443 
2444        You cannot set new nonzero locations into this matrix, that will generate an error.
2445 
2446        The i and j indices are 0 based
2447 
2448        When block size is greater than 1 the matrix values must be stored using the SBAIJ storage format (see the SBAIJ code to determine this). For block size of 1
2449        it is the regular CSR format excluding the lower triangular elements.
2450 
2451 .seealso: MatCreate(), MatCreateSBAIJ(), MatCreateSeqSBAIJ()
2452 
2453 @*/
2454 PetscErrorCode  MatCreateSeqSBAIJWithArrays(MPI_Comm comm,PetscInt bs,PetscInt m,PetscInt n,PetscInt *i,PetscInt *j,PetscScalar *a,Mat *mat)
2455 {
2456   PetscErrorCode ierr;
2457   PetscInt       ii;
2458   Mat_SeqSBAIJ   *sbaij;
2459 
2460   PetscFunctionBegin;
2461   if (bs != 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"block size %D > 1 is not supported yet",bs);
2462   if (i[0]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"i (row indices) must start with 0");
2463 
2464   ierr  = MatCreate(comm,mat);CHKERRQ(ierr);
2465   ierr  = MatSetSizes(*mat,m,n,m,n);CHKERRQ(ierr);
2466   ierr  = MatSetType(*mat,MATSEQSBAIJ);CHKERRQ(ierr);
2467   ierr  = MatSeqSBAIJSetPreallocation(*mat,bs,MAT_SKIP_ALLOCATION,0);CHKERRQ(ierr);
2468   sbaij = (Mat_SeqSBAIJ*)(*mat)->data;
2469   ierr  = PetscMalloc2(m,&sbaij->imax,m,&sbaij->ilen);CHKERRQ(ierr);
2470   ierr  = PetscLogObjectMemory((PetscObject)*mat,2*m*sizeof(PetscInt));CHKERRQ(ierr);
2471 
2472   sbaij->i = i;
2473   sbaij->j = j;
2474   sbaij->a = a;
2475 
2476   sbaij->singlemalloc = PETSC_FALSE;
2477   sbaij->nonew        = -1;             /*this indicates that inserting a new value in the matrix that generates a new nonzero is an error*/
2478   sbaij->free_a       = PETSC_FALSE;
2479   sbaij->free_ij      = PETSC_FALSE;
2480 
2481   for (ii=0; ii<m; ii++) {
2482     sbaij->ilen[ii] = sbaij->imax[ii] = i[ii+1] - i[ii];
2483 #if defined(PETSC_USE_DEBUG)
2484     if (i[ii+1] - i[ii] < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row length in i (row indices) row = %d length = %d",ii,i[ii+1] - i[ii]);
2485 #endif
2486   }
2487 #if defined(PETSC_USE_DEBUG)
2488   for (ii=0; ii<sbaij->i[m]; ii++) {
2489     if (j[ii] < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative column index at location = %d index = %d",ii,j[ii]);
2490     if (j[ii] > n - 1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column index to large at location = %d index = %d",ii,j[ii]);
2491   }
2492 #endif
2493 
2494   ierr = MatAssemblyBegin(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2495   ierr = MatAssemblyEnd(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2496   PetscFunctionReturn(0);
2497 }
2498 
2499 #undef __FUNCT__
2500 #define __FUNCT__ "MatCreateMPIMatConcatenateSeqMat_SeqSBAIJ"
2501 PetscErrorCode MatCreateMPIMatConcatenateSeqMat_SeqSBAIJ(MPI_Comm comm,Mat inmat,PetscInt n,MatReuse scall,Mat *outmat)
2502 {
2503   PetscErrorCode ierr;
2504 
2505   PetscFunctionBegin;
2506   ierr = MatCreateMPIMatConcatenateSeqMat_MPISBAIJ(comm,inmat,n,scall,outmat);CHKERRQ(ierr);
2507   PetscFunctionReturn(0);
2508 }
2509 
2510 
2511 
2512 
2513