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