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