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