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