xref: /petsc/src/mat/impls/sbaij/seq/sbaijfact.c (revision 2475b7ca256cea2a4b7cbf2d8babcda14e5fa36e)
1 
2 #include <../src/mat/impls/baij/seq/baij.h>
3 #include <../src/mat/impls/sbaij/seq/sbaij.h>
4 #include <petsc/private/kernels/blockinvert.h>
5 #include <petscis.h>
6 
7 PetscErrorCode MatGetInertia_SeqSBAIJ(Mat F,PetscInt *nneg,PetscInt *nzero,PetscInt *npos)
8 {
9   Mat_SeqSBAIJ *fact=(Mat_SeqSBAIJ*)F->data;
10   MatScalar    *dd=fact->a;
11   PetscInt     mbs=fact->mbs,bs=F->rmap->bs,i,nneg_tmp,npos_tmp,*fi=fact->diag;
12 
13   PetscFunctionBegin;
14   if (bs != 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for bs: %D >1 yet",bs);
15   if (F->factorerrortype==MAT_FACTOR_NUMERIC_ZEROPIVOT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"MatFactor fails with numeric zeropivot");
16 
17   nneg_tmp = 0; npos_tmp = 0;
18   for (i=0; i<mbs; i++) {
19     if (PetscRealPart(dd[*fi]) > 0.0) npos_tmp++;
20     else if (PetscRealPart(dd[*fi]) < 0.0) nneg_tmp++;
21     fi++;
22   }
23   if (nneg)  *nneg  = nneg_tmp;
24   if (npos)  *npos  = npos_tmp;
25   if (nzero) *nzero = mbs - nneg_tmp - npos_tmp;
26   PetscFunctionReturn(0);
27 }
28 
29 /*
30   Symbolic U^T*D*U factorization for SBAIJ format. Modified from SSF of YSMP.
31   Use Modified Sparse Row (MSR) storage for u and ju. See page 85, "Iterative Methods ..." by Saad.
32 */
33 PetscErrorCode MatCholeskyFactorSymbolic_SeqSBAIJ_MSR(Mat F,Mat A,IS perm,const MatFactorInfo *info)
34 {
35   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data,*b;
36   PetscErrorCode ierr;
37   const PetscInt *rip,*ai,*aj;
38   PetscInt       i,mbs = a->mbs,*jutmp,bs = A->rmap->bs,bs2=a->bs2;
39   PetscInt       m,reallocs = 0,prow;
40   PetscInt       *jl,*q,jmin,jmax,juidx,nzk,qm,*iu,*ju,k,j,vj,umax,maxadd;
41   PetscReal      f = info->fill;
42   PetscBool      perm_identity;
43 
44   PetscFunctionBegin;
45   /* check whether perm is the identity mapping */
46   ierr = ISIdentity(perm,&perm_identity);CHKERRQ(ierr);
47   ierr = ISGetIndices(perm,&rip);CHKERRQ(ierr);
48 
49   if (perm_identity) { /* without permutation */
50     a->permute = PETSC_FALSE;
51 
52     ai = a->i; aj = a->j;
53   } else {            /* non-trivial permutation */
54     a->permute = PETSC_TRUE;
55 
56     ierr = MatReorderingSeqSBAIJ(A,perm);CHKERRQ(ierr);
57 
58     ai = a->inew; aj = a->jnew;
59   }
60 
61   /* initialization */
62   ierr  = PetscMalloc1(mbs+1,&iu);CHKERRQ(ierr);
63   umax  = (PetscInt)(f*ai[mbs] + 1); umax += mbs + 1;
64   ierr  = PetscMalloc1(umax,&ju);CHKERRQ(ierr);
65   iu[0] = mbs+1;
66   juidx = mbs + 1; /* index for ju */
67   /* jl linked list for pivot row -- linked list for col index */
68   ierr = PetscMalloc2(mbs,&jl,mbs,&q);CHKERRQ(ierr);
69   for (i=0; i<mbs; i++) {
70     jl[i] = mbs;
71     q[i]  = 0;
72   }
73 
74   /* for each row k */
75   for (k=0; k<mbs; k++) {
76     for (i=0; i<mbs; i++) q[i] = 0;  /* to be removed! */
77     nzk  = 0; /* num. of nz blocks in k-th block row with diagonal block excluded */
78     q[k] = mbs;
79     /* initialize nonzero structure of k-th row to row rip[k] of A */
80     jmin = ai[rip[k]] +1; /* exclude diag[k] */
81     jmax = ai[rip[k]+1];
82     for (j=jmin; j<jmax; j++) {
83       vj = rip[aj[j]]; /* col. value */
84       if (vj > k) {
85         qm = k;
86         do {
87           m = qm; qm = q[m];
88         } while (qm < vj);
89         if (qm == vj) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Duplicate entry in A\n");
90         nzk++;
91         q[m]  = vj;
92         q[vj] = qm;
93       } /* if (vj > k) */
94     } /* for (j=jmin; j<jmax; j++) */
95 
96     /* modify nonzero structure of k-th row by computing fill-in
97        for each row i to be merged in */
98     prow = k;
99     prow = jl[prow]; /* next pivot row (== mbs for symbolic factorization) */
100 
101     while (prow < k) {
102       /* merge row prow into k-th row */
103       jmin = iu[prow] + 1; jmax = iu[prow+1];
104       qm   = k;
105       for (j=jmin; j<jmax; j++) {
106         vj = ju[j];
107         do {
108           m = qm; qm = q[m];
109         } while (qm < vj);
110         if (qm != vj) {
111           nzk++; q[m] = vj; q[vj] = qm; qm = vj;
112         }
113       }
114       prow = jl[prow]; /* next pivot row */
115     }
116 
117     /* add k to row list for first nonzero element in k-th row */
118     if (nzk > 0) {
119       i     = q[k]; /* col value of first nonzero element in U(k, k+1:mbs-1) */
120       jl[k] = jl[i]; jl[i] = k;
121     }
122     iu[k+1] = iu[k] + nzk;
123 
124     /* allocate more space to ju if needed */
125     if (iu[k+1] > umax) {
126       /* estimate how much additional space we will need */
127       /* use the strategy suggested by David Hysom <hysom@perch-t.icase.edu> */
128       /* just double the memory each time */
129       maxadd = umax;
130       if (maxadd < nzk) maxadd = (mbs-k)*(nzk+1)/2;
131       umax += maxadd;
132 
133       /* allocate a longer ju */
134       ierr = PetscMalloc1(umax,&jutmp);CHKERRQ(ierr);
135       ierr = PetscArraycpy(jutmp,ju,iu[k]);CHKERRQ(ierr);
136       ierr = PetscFree(ju);CHKERRQ(ierr);
137       ju   = jutmp;
138       reallocs++; /* count how many times we realloc */
139     }
140 
141     /* save nonzero structure of k-th row in ju */
142     i=k;
143     while (nzk--) {
144       i           = q[i];
145       ju[juidx++] = i;
146     }
147   }
148 
149 #if defined(PETSC_USE_INFO)
150   if (ai[mbs] != 0) {
151     PetscReal af = ((PetscReal)iu[mbs])/((PetscReal)ai[mbs]);
152     ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %g needed %g\n",reallocs,(double)f,(double)af);CHKERRQ(ierr);
153     ierr = PetscInfo1(A,"Run with -pc_factor_fill %g or use \n",(double)af);CHKERRQ(ierr);
154     ierr = PetscInfo1(A,"PCFactorSetFill(pc,%g);\n",(double)af);CHKERRQ(ierr);
155     ierr = PetscInfo(A,"for best performance.\n");CHKERRQ(ierr);
156   } else {
157     ierr = PetscInfo(A,"Empty matrix.\n");CHKERRQ(ierr);
158   }
159 #endif
160 
161   ierr = ISRestoreIndices(perm,&rip);CHKERRQ(ierr);
162   ierr = PetscFree2(jl,q);CHKERRQ(ierr);
163 
164   /* put together the new matrix */
165   ierr = MatSeqSBAIJSetPreallocation(F,bs,MAT_SKIP_ALLOCATION,NULL);CHKERRQ(ierr);
166 
167   /* ierr = PetscLogObjectParent((PetscObject)B,(PetscObject)iperm);CHKERRQ(ierr); */
168   b                = (Mat_SeqSBAIJ*)(F)->data;
169   b->singlemalloc  = PETSC_FALSE;
170   b->free_a        = PETSC_TRUE;
171   b->free_ij       = PETSC_TRUE;
172 
173   ierr    = PetscMalloc1((iu[mbs]+1)*bs2,&b->a);CHKERRQ(ierr);
174   b->j    = ju;
175   b->i    = iu;
176   b->diag = 0;
177   b->ilen = 0;
178   b->imax = 0;
179   b->row  = perm;
180 
181   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */
182 
183   ierr    = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
184 
185   b->icol = perm;
186   ierr    = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
187   ierr    = PetscMalloc1(bs*mbs+bs,&b->solve_work);CHKERRQ(ierr);
188   /* In b structure:  Free imax, ilen, old a, old j.
189      Allocate idnew, solve_work, new a, new j */
190   ierr     = PetscLogObjectMemory((PetscObject)F,(iu[mbs]-mbs)*(sizeof(PetscInt)+sizeof(MatScalar)));CHKERRQ(ierr);
191   b->maxnz = b->nz = iu[mbs];
192 
193   (F)->info.factor_mallocs   = reallocs;
194   (F)->info.fill_ratio_given = f;
195   if (ai[mbs] != 0) {
196     (F)->info.fill_ratio_needed = ((PetscReal)iu[mbs])/((PetscReal)ai[mbs]);
197   } else {
198     (F)->info.fill_ratio_needed = 0.0;
199   }
200   ierr = MatSeqSBAIJSetNumericFactorization_inplace(F,perm_identity);CHKERRQ(ierr);
201   PetscFunctionReturn(0);
202 }
203 /*
204     Symbolic U^T*D*U factorization for SBAIJ format.
205     See MatICCFactorSymbolic_SeqAIJ() for description of its data structure.
206 */
207 #include <petscbt.h>
208 #include <../src/mat/utils/freespace.h>
209 PetscErrorCode MatCholeskyFactorSymbolic_SeqSBAIJ(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
210 {
211   Mat_SeqSBAIJ       *a = (Mat_SeqSBAIJ*)A->data;
212   Mat_SeqSBAIJ       *b;
213   PetscErrorCode     ierr;
214   PetscBool          perm_identity,missing;
215   PetscReal          fill = info->fill;
216   const PetscInt     *rip,*ai=a->i,*aj=a->j;
217   PetscInt           i,mbs=a->mbs,bs=A->rmap->bs,reallocs=0,prow;
218   PetscInt           *jl,jmin,jmax,nzk,*ui,k,j,*il,nextprow;
219   PetscInt           nlnk,*lnk,ncols,*cols,*uj,**ui_ptr,*uj_ptr,*udiag;
220   PetscFreeSpaceList free_space=NULL,current_space=NULL;
221   PetscBT            lnkbt;
222 
223   PetscFunctionBegin;
224   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
225   ierr = MatMissingDiagonal(A,&missing,&i);CHKERRQ(ierr);
226   if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",i);
227   if (bs > 1) {
228     ierr = MatCholeskyFactorSymbolic_SeqSBAIJ_inplace(fact,A,perm,info);CHKERRQ(ierr);
229     PetscFunctionReturn(0);
230   }
231 
232   /* check whether perm is the identity mapping */
233   ierr = ISIdentity(perm,&perm_identity);CHKERRQ(ierr);
234   if (!perm_identity) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Matrix reordering is not supported for sbaij matrix. Use aij format");
235   a->permute = PETSC_FALSE;
236   ierr       = ISGetIndices(perm,&rip);CHKERRQ(ierr);
237 
238   /* initialization */
239   ierr  = PetscMalloc1(mbs+1,&ui);CHKERRQ(ierr);
240   ierr  = PetscMalloc1(mbs+1,&udiag);CHKERRQ(ierr);
241   ui[0] = 0;
242 
243   /* jl: linked list for storing indices of the pivot rows
244      il: il[i] points to the 1st nonzero entry of U(i,k:mbs-1) */
245   ierr = PetscMalloc4(mbs,&ui_ptr,mbs,&il,mbs,&jl,mbs,&cols);CHKERRQ(ierr);
246   for (i=0; i<mbs; i++) {
247     jl[i] = mbs; il[i] = 0;
248   }
249 
250   /* create and initialize a linked list for storing column indices of the active row k */
251   nlnk = mbs + 1;
252   ierr = PetscLLCreate(mbs,mbs,nlnk,lnk,lnkbt);CHKERRQ(ierr);
253 
254   /* initial FreeSpace size is fill*(ai[mbs]+1) */
255   ierr          = PetscFreeSpaceGet(PetscRealIntMultTruncate(fill,ai[mbs]+1),&free_space);CHKERRQ(ierr);
256   current_space = free_space;
257 
258   for (k=0; k<mbs; k++) {  /* for each active row k */
259     /* initialize lnk by the column indices of row rip[k] of A */
260     nzk   = 0;
261     ncols = ai[k+1] - ai[k];
262     if (!ncols) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_CH_ZRPVT,"Empty row %D in matrix ",k);
263     for (j=0; j<ncols; j++) {
264       i       = *(aj + ai[k] + j);
265       cols[j] = i;
266     }
267     ierr = PetscLLAdd(ncols,cols,mbs,nlnk,lnk,lnkbt);CHKERRQ(ierr);
268     nzk += nlnk;
269 
270     /* update lnk by computing fill-in for each pivot row to be merged in */
271     prow = jl[k]; /* 1st pivot row */
272 
273     while (prow < k) {
274       nextprow = jl[prow];
275       /* merge prow into k-th row */
276       jmin   = il[prow] + 1; /* index of the 2nd nzero entry in U(prow,k:mbs-1) */
277       jmax   = ui[prow+1];
278       ncols  = jmax-jmin;
279       uj_ptr = ui_ptr[prow] + jmin - ui[prow]; /* points to the 2nd nzero entry in U(prow,k:mbs-1) */
280       ierr   = PetscLLAddSorted(ncols,uj_ptr,mbs,nlnk,lnk,lnkbt);CHKERRQ(ierr);
281       nzk   += nlnk;
282 
283       /* update il and jl for prow */
284       if (jmin < jmax) {
285         il[prow] = jmin;
286         j        = *uj_ptr; jl[prow] = jl[j]; jl[j] = prow;
287       }
288       prow = nextprow;
289     }
290 
291     /* if free space is not available, make more free space */
292     if (current_space->local_remaining<nzk) {
293       i    = mbs - k + 1; /* num of unfactored rows */
294       i    = PetscIntMultTruncate(i,PetscMin(nzk, i-1)); /* i*nzk, i*(i-1): estimated and max additional space needed */
295       ierr = PetscFreeSpaceGet(i,&current_space);CHKERRQ(ierr);
296       reallocs++;
297     }
298 
299     /* copy data into free space, then initialize lnk */
300     ierr = PetscLLClean(mbs,mbs,nzk,lnk,current_space->array,lnkbt);CHKERRQ(ierr);
301 
302     /* add the k-th row into il and jl */
303     if (nzk > 1) {
304       i     = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:mbs-1) */
305       jl[k] = jl[i]; jl[i] = k;
306       il[k] = ui[k] + 1;
307     }
308     ui_ptr[k] = current_space->array;
309 
310     current_space->array           += nzk;
311     current_space->local_used      += nzk;
312     current_space->local_remaining -= nzk;
313 
314     ui[k+1] = ui[k] + nzk;
315   }
316 
317   ierr = ISRestoreIndices(perm,&rip);CHKERRQ(ierr);
318   ierr = PetscFree4(ui_ptr,il,jl,cols);CHKERRQ(ierr);
319 
320   /* destroy list of free space and other temporary array(s) */
321   ierr = PetscMalloc1(ui[mbs]+1,&uj);CHKERRQ(ierr);
322   ierr = PetscFreeSpaceContiguous_Cholesky(&free_space,uj,mbs,ui,udiag);CHKERRQ(ierr); /* store matrix factor */
323   ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
324 
325   /* put together the new matrix in MATSEQSBAIJ format */
326   ierr = MatSeqSBAIJSetPreallocation(fact,bs,MAT_SKIP_ALLOCATION,NULL);CHKERRQ(ierr);
327 
328   b               = (Mat_SeqSBAIJ*)fact->data;
329   b->singlemalloc = PETSC_FALSE;
330   b->free_a       = PETSC_TRUE;
331   b->free_ij      = PETSC_TRUE;
332 
333   ierr = PetscMalloc1(ui[mbs]+1,&b->a);CHKERRQ(ierr);
334 
335   b->j         = uj;
336   b->i         = ui;
337   b->diag      = udiag;
338   b->free_diag = PETSC_TRUE;
339   b->ilen      = 0;
340   b->imax      = 0;
341   b->row       = perm;
342   b->icol      = perm;
343 
344   ierr = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
345   ierr = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
346 
347   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */
348 
349   ierr = PetscMalloc1(mbs+1,&b->solve_work);CHKERRQ(ierr);
350   ierr = PetscLogObjectMemory((PetscObject)fact,ui[mbs]*(sizeof(PetscInt)+sizeof(MatScalar)));CHKERRQ(ierr);
351 
352   b->maxnz = b->nz = ui[mbs];
353 
354   fact->info.factor_mallocs   = reallocs;
355   fact->info.fill_ratio_given = fill;
356   if (ai[mbs] != 0) {
357     fact->info.fill_ratio_needed = ((PetscReal)ui[mbs])/ai[mbs];
358   } else {
359     fact->info.fill_ratio_needed = 0.0;
360   }
361 #if defined(PETSC_USE_INFO)
362   if (ai[mbs] != 0) {
363     PetscReal af = fact->info.fill_ratio_needed;
364     ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %g needed %g\n",reallocs,(double)fill,(double)af);CHKERRQ(ierr);
365     ierr = PetscInfo1(A,"Run with -pc_factor_fill %g or use \n",(double)af);CHKERRQ(ierr);
366     ierr = PetscInfo1(A,"PCFactorSetFill(pc,%g) for best performance.\n",(double)af);CHKERRQ(ierr);
367   } else {
368     ierr = PetscInfo(A,"Empty matrix.\n");CHKERRQ(ierr);
369   }
370 #endif
371   fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqSBAIJ_1_NaturalOrdering;
372   PetscFunctionReturn(0);
373 }
374 
375 PetscErrorCode MatCholeskyFactorSymbolic_SeqSBAIJ_inplace(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
376 {
377   Mat_SeqSBAIJ       *a = (Mat_SeqSBAIJ*)A->data;
378   Mat_SeqSBAIJ       *b;
379   PetscErrorCode     ierr;
380   PetscBool          perm_identity,missing;
381   PetscReal          fill = info->fill;
382   const PetscInt     *rip,*ai,*aj;
383   PetscInt           i,mbs=a->mbs,bs=A->rmap->bs,reallocs=0,prow,d;
384   PetscInt           *jl,jmin,jmax,nzk,*ui,k,j,*il,nextprow;
385   PetscInt           nlnk,*lnk,ncols,*cols,*uj,**ui_ptr,*uj_ptr;
386   PetscFreeSpaceList free_space=NULL,current_space=NULL;
387   PetscBT            lnkbt;
388 
389   PetscFunctionBegin;
390   ierr = MatMissingDiagonal(A,&missing,&d);CHKERRQ(ierr);
391   if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",d);
392 
393   /*
394    This code originally uses Modified Sparse Row (MSR) storage
395    (see page 85, "Iterative Methods ..." by Saad) for the output matrix B - bad choise!
396    Then it is rewritten so the factor B takes seqsbaij format. However the associated
397    MatCholeskyFactorNumeric_() have not been modified for the cases of bs>1 or !perm_identity,
398    thus the original code in MSR format is still used for these cases.
399    The code below should replace MatCholeskyFactorSymbolic_SeqSBAIJ_MSR() whenever
400    MatCholeskyFactorNumeric_() is modified for using sbaij symbolic factor.
401   */
402   if (bs > 1) {
403     ierr = MatCholeskyFactorSymbolic_SeqSBAIJ_MSR(fact,A,perm,info);CHKERRQ(ierr);
404     PetscFunctionReturn(0);
405   }
406 
407   /* check whether perm is the identity mapping */
408   ierr = ISIdentity(perm,&perm_identity);CHKERRQ(ierr);
409 
410   if (perm_identity) {
411     a->permute = PETSC_FALSE;
412 
413     ai = a->i; aj = a->j;
414   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Matrix reordering is not supported for sbaij matrix. Use aij format");
415   ierr = ISGetIndices(perm,&rip);CHKERRQ(ierr);
416 
417   /* initialization */
418   ierr  = PetscMalloc1(mbs+1,&ui);CHKERRQ(ierr);
419   ui[0] = 0;
420 
421   /* jl: linked list for storing indices of the pivot rows
422      il: il[i] points to the 1st nonzero entry of U(i,k:mbs-1) */
423   ierr = PetscMalloc4(mbs,&ui_ptr,mbs,&il,mbs,&jl,mbs,&cols);CHKERRQ(ierr);
424   for (i=0; i<mbs; i++) {
425     jl[i] = mbs; il[i] = 0;
426   }
427 
428   /* create and initialize a linked list for storing column indices of the active row k */
429   nlnk = mbs + 1;
430   ierr = PetscLLCreate(mbs,mbs,nlnk,lnk,lnkbt);CHKERRQ(ierr);
431 
432   /* initial FreeSpace size is fill*(ai[mbs]+1) */
433   ierr          = PetscFreeSpaceGet(PetscRealIntMultTruncate(fill,ai[mbs]+1),&free_space);CHKERRQ(ierr);
434   current_space = free_space;
435 
436   for (k=0; k<mbs; k++) {  /* for each active row k */
437     /* initialize lnk by the column indices of row rip[k] of A */
438     nzk   = 0;
439     ncols = ai[rip[k]+1] - ai[rip[k]];
440     for (j=0; j<ncols; j++) {
441       i       = *(aj + ai[rip[k]] + j);
442       cols[j] = rip[i];
443     }
444     ierr = PetscLLAdd(ncols,cols,mbs,nlnk,lnk,lnkbt);CHKERRQ(ierr);
445     nzk += nlnk;
446 
447     /* update lnk by computing fill-in for each pivot row to be merged in */
448     prow = jl[k]; /* 1st pivot row */
449 
450     while (prow < k) {
451       nextprow = jl[prow];
452       /* merge prow into k-th row */
453       jmin   = il[prow] + 1; /* index of the 2nd nzero entry in U(prow,k:mbs-1) */
454       jmax   = ui[prow+1];
455       ncols  = jmax-jmin;
456       uj_ptr = ui_ptr[prow] + jmin - ui[prow]; /* points to the 2nd nzero entry in U(prow,k:mbs-1) */
457       ierr   = PetscLLAddSorted(ncols,uj_ptr,mbs,nlnk,lnk,lnkbt);CHKERRQ(ierr);
458       nzk   += nlnk;
459 
460       /* update il and jl for prow */
461       if (jmin < jmax) {
462         il[prow] = jmin;
463 
464         j = *uj_ptr; jl[prow] = jl[j]; jl[j] = prow;
465       }
466       prow = nextprow;
467     }
468 
469     /* if free space is not available, make more free space */
470     if (current_space->local_remaining<nzk) {
471       i    = mbs - k + 1; /* num of unfactored rows */
472       i    = PetscMin(PetscIntMultTruncate(i,nzk), PetscIntMultTruncate(i,i-1)); /* i*nzk, i*(i-1): estimated and max additional space needed */
473       ierr = PetscFreeSpaceGet(i,&current_space);CHKERRQ(ierr);
474       reallocs++;
475     }
476 
477     /* copy data into free space, then initialize lnk */
478     ierr = PetscLLClean(mbs,mbs,nzk,lnk,current_space->array,lnkbt);CHKERRQ(ierr);
479 
480     /* add the k-th row into il and jl */
481     if (nzk-1 > 0) {
482       i     = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:mbs-1) */
483       jl[k] = jl[i]; jl[i] = k;
484       il[k] = ui[k] + 1;
485     }
486     ui_ptr[k] = current_space->array;
487 
488     current_space->array           += nzk;
489     current_space->local_used      += nzk;
490     current_space->local_remaining -= nzk;
491 
492     ui[k+1] = ui[k] + nzk;
493   }
494 
495   ierr = ISRestoreIndices(perm,&rip);CHKERRQ(ierr);
496   ierr = PetscFree4(ui_ptr,il,jl,cols);CHKERRQ(ierr);
497 
498   /* destroy list of free space and other temporary array(s) */
499   ierr = PetscMalloc1(ui[mbs]+1,&uj);CHKERRQ(ierr);
500   ierr = PetscFreeSpaceContiguous(&free_space,uj);CHKERRQ(ierr);
501   ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
502 
503   /* put together the new matrix in MATSEQSBAIJ format */
504   ierr = MatSeqSBAIJSetPreallocation(fact,bs,MAT_SKIP_ALLOCATION,NULL);CHKERRQ(ierr);
505 
506   b               = (Mat_SeqSBAIJ*)fact->data;
507   b->singlemalloc = PETSC_FALSE;
508   b->free_a       = PETSC_TRUE;
509   b->free_ij      = PETSC_TRUE;
510 
511   ierr = PetscMalloc1(ui[mbs]+1,&b->a);CHKERRQ(ierr);
512 
513   b->j    = uj;
514   b->i    = ui;
515   b->diag = 0;
516   b->ilen = 0;
517   b->imax = 0;
518   b->row  = perm;
519 
520   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */
521 
522   ierr     = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
523   b->icol  = perm;
524   ierr     = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
525   ierr     = PetscMalloc1(mbs+1,&b->solve_work);CHKERRQ(ierr);
526   ierr     = PetscLogObjectMemory((PetscObject)fact,(ui[mbs]-mbs)*(sizeof(PetscInt)+sizeof(MatScalar)));CHKERRQ(ierr);
527   b->maxnz = b->nz = ui[mbs];
528 
529   fact->info.factor_mallocs   = reallocs;
530   fact->info.fill_ratio_given = fill;
531   if (ai[mbs] != 0) {
532     fact->info.fill_ratio_needed = ((PetscReal)ui[mbs])/ai[mbs];
533   } else {
534     fact->info.fill_ratio_needed = 0.0;
535   }
536 #if defined(PETSC_USE_INFO)
537   if (ai[mbs] != 0) {
538     PetscReal af = fact->info.fill_ratio_needed;
539     ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %g needed %g\n",reallocs,(double)fill,(double)af);CHKERRQ(ierr);
540     ierr = PetscInfo1(A,"Run with -pc_factor_fill %g or use \n",(double)af);CHKERRQ(ierr);
541     ierr = PetscInfo1(A,"PCFactorSetFill(pc,%g) for best performance.\n",(double)af);CHKERRQ(ierr);
542   } else {
543     ierr = PetscInfo(A,"Empty matrix.\n");CHKERRQ(ierr);
544   }
545 #endif
546   ierr = MatSeqSBAIJSetNumericFactorization_inplace(fact,perm_identity);CHKERRQ(ierr);
547   PetscFunctionReturn(0);
548 }
549 
550 PetscErrorCode MatCholeskyFactorNumeric_SeqSBAIJ_N(Mat C,Mat A,const MatFactorInfo *info)
551 {
552   Mat_SeqSBAIJ   *a   = (Mat_SeqSBAIJ*)A->data,*b = (Mat_SeqSBAIJ*)C->data;
553   IS             perm = b->row;
554   PetscErrorCode ierr;
555   const PetscInt *ai,*aj,*perm_ptr,mbs=a->mbs,*bi=b->i,*bj=b->j;
556   PetscInt       i,j;
557   PetscInt       *a2anew,k,k1,jmin,jmax,*jl,*il,vj,nexti,ili;
558   PetscInt       bs  =A->rmap->bs,bs2 = a->bs2;
559   MatScalar      *ba = b->a,*aa,*ap,*dk,*uik;
560   MatScalar      *u,*diag,*rtmp,*rtmp_ptr;
561   MatScalar      *work;
562   PetscInt       *pivots;
563   PetscBool      allowzeropivot,zeropivotdetected;
564 
565   PetscFunctionBegin;
566   /* initialization */
567   ierr = PetscCalloc1(bs2*mbs,&rtmp);CHKERRQ(ierr);
568   ierr = PetscMalloc2(mbs,&il,mbs,&jl);CHKERRQ(ierr);
569   allowzeropivot = PetscNot(A->erroriffailure);
570 
571   il[0] = 0;
572   for (i=0; i<mbs; i++) jl[i] = mbs;
573 
574   ierr = PetscMalloc3(bs2,&dk,bs2,&uik,bs,&work);CHKERRQ(ierr);
575   ierr = PetscMalloc1(bs,&pivots);CHKERRQ(ierr);
576 
577   ierr = ISGetIndices(perm,&perm_ptr);CHKERRQ(ierr);
578 
579   /* check permutation */
580   if (!a->permute) {
581     ai = a->i; aj = a->j; aa = a->a;
582   } else {
583     ai   = a->inew; aj = a->jnew;
584     ierr = PetscMalloc1(bs2*ai[mbs],&aa);CHKERRQ(ierr);
585     ierr = PetscArraycpy(aa,a->a,bs2*ai[mbs]);CHKERRQ(ierr);
586     ierr = PetscMalloc1(ai[mbs],&a2anew);CHKERRQ(ierr);
587     ierr = PetscArraycpy(a2anew,a->a2anew,ai[mbs]);CHKERRQ(ierr);
588 
589     for (i=0; i<mbs; i++) {
590       jmin = ai[i]; jmax = ai[i+1];
591       for (j=jmin; j<jmax; j++) {
592         while (a2anew[j] != j) {
593           k = a2anew[j]; a2anew[j] = a2anew[k]; a2anew[k] = k;
594           for (k1=0; k1<bs2; k1++) {
595             dk[k1]       = aa[k*bs2+k1];
596             aa[k*bs2+k1] = aa[j*bs2+k1];
597             aa[j*bs2+k1] = dk[k1];
598           }
599         }
600         /* transform columnoriented blocks that lie in the lower triangle to roworiented blocks */
601         if (i > aj[j]) {
602           /* printf("change orientation, row: %d, col: %d\n",i,aj[j]); */
603           ap = aa + j*bs2;                     /* ptr to the beginning of j-th block of aa */
604           for (k=0; k<bs2; k++) dk[k] = ap[k]; /* dk <- j-th block of aa */
605           for (k=0; k<bs; k++) {               /* j-th block of aa <- dk^T */
606             for (k1=0; k1<bs; k1++) *ap++ = dk[k + bs*k1];
607           }
608         }
609       }
610     }
611     ierr = PetscFree(a2anew);CHKERRQ(ierr);
612   }
613 
614   /* for each row k */
615   for (k = 0; k<mbs; k++) {
616 
617     /*initialize k-th row with elements nonzero in row perm(k) of A */
618     jmin = ai[perm_ptr[k]]; jmax = ai[perm_ptr[k]+1];
619 
620     ap = aa + jmin*bs2;
621     for (j = jmin; j < jmax; j++) {
622       vj       = perm_ptr[aj[j]];   /* block col. index */
623       rtmp_ptr = rtmp + vj*bs2;
624       for (i=0; i<bs2; i++) *rtmp_ptr++ = *ap++;
625     }
626 
627     /* modify k-th row by adding in those rows i with U(i,k) != 0 */
628     ierr = PetscArraycpy(dk,rtmp+k*bs2,bs2);CHKERRQ(ierr);
629     i    = jl[k]; /* first row to be added to k_th row  */
630 
631     while (i < k) {
632       nexti = jl[i]; /* next row to be added to k_th row */
633 
634       /* compute multiplier */
635       ili = il[i];  /* index of first nonzero element in U(i,k:bms-1) */
636 
637       /* uik = -inv(Di)*U_bar(i,k) */
638       diag = ba + i*bs2;
639       u    = ba + ili*bs2;
640       ierr = PetscArrayzero(uik,bs2);CHKERRQ(ierr);
641       PetscKernel_A_gets_A_minus_B_times_C(bs,uik,diag,u);
642 
643       /* update D(k) += -U(i,k)^T * U_bar(i,k) */
644       PetscKernel_A_gets_A_plus_Btranspose_times_C(bs,dk,uik,u);
645       ierr = PetscLogFlops(4.0*bs*bs2);CHKERRQ(ierr);
646 
647       /* update -U(i,k) */
648       ierr = PetscArraycpy(ba+ili*bs2,uik,bs2);CHKERRQ(ierr);
649 
650       /* add multiple of row i to k-th row ... */
651       jmin = ili + 1; jmax = bi[i+1];
652       if (jmin < jmax) {
653         for (j=jmin; j<jmax; j++) {
654           /* rtmp += -U(i,k)^T * U_bar(i,j) */
655           rtmp_ptr = rtmp + bj[j]*bs2;
656           u        = ba + j*bs2;
657           PetscKernel_A_gets_A_plus_Btranspose_times_C(bs,rtmp_ptr,uik,u);
658         }
659         ierr = PetscLogFlops(2.0*bs*bs2*(jmax-jmin));CHKERRQ(ierr);
660 
661         /* ... add i to row list for next nonzero entry */
662         il[i] = jmin;             /* update il(i) in column k+1, ... mbs-1 */
663         j     = bj[jmin];
664         jl[i] = jl[j]; jl[j] = i; /* update jl */
665       }
666       i = nexti;
667     }
668 
669     /* save nonzero entries in k-th row of U ... */
670 
671     /* invert diagonal block */
672     diag = ba+k*bs2;
673     ierr = PetscArraycpy(diag,dk,bs2);CHKERRQ(ierr);
674 
675     ierr = PetscKernel_A_gets_inverse_A(bs,diag,pivots,work,allowzeropivot,&zeropivotdetected);CHKERRQ(ierr);
676     if (zeropivotdetected) C->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
677 
678     jmin = bi[k]; jmax = bi[k+1];
679     if (jmin < jmax) {
680       for (j=jmin; j<jmax; j++) {
681         vj       = bj[j];      /* block col. index of U */
682         u        = ba + j*bs2;
683         rtmp_ptr = rtmp + vj*bs2;
684         for (k1=0; k1<bs2; k1++) {
685           *u++        = *rtmp_ptr;
686           *rtmp_ptr++ = 0.0;
687         }
688       }
689 
690       /* ... add k to row list for first nonzero entry in k-th row */
691       il[k] = jmin;
692       i     = bj[jmin];
693       jl[k] = jl[i]; jl[i] = k;
694     }
695   }
696 
697   ierr = PetscFree(rtmp);CHKERRQ(ierr);
698   ierr = PetscFree2(il,jl);CHKERRQ(ierr);
699   ierr = PetscFree3(dk,uik,work);CHKERRQ(ierr);
700   ierr = PetscFree(pivots);CHKERRQ(ierr);
701   if (a->permute) {
702     ierr = PetscFree(aa);CHKERRQ(ierr);
703   }
704 
705   ierr = ISRestoreIndices(perm,&perm_ptr);CHKERRQ(ierr);
706 
707   C->ops->solve          = MatSolve_SeqSBAIJ_N_inplace;
708   C->ops->solvetranspose = MatSolve_SeqSBAIJ_N_inplace;
709   C->ops->forwardsolve   = MatForwardSolve_SeqSBAIJ_N_inplace;
710   C->ops->backwardsolve  = MatBackwardSolve_SeqSBAIJ_N_inplace;
711 
712   C->assembled    = PETSC_TRUE;
713   C->preallocated = PETSC_TRUE;
714 
715   ierr = PetscLogFlops(1.3333*bs*bs2*b->mbs);CHKERRQ(ierr); /* from inverting diagonal blocks */
716   PetscFunctionReturn(0);
717 }
718 
719 PetscErrorCode MatCholeskyFactorNumeric_SeqSBAIJ_N_NaturalOrdering(Mat C,Mat A,const MatFactorInfo *info)
720 {
721   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data,*b = (Mat_SeqSBAIJ*)C->data;
722   PetscErrorCode ierr;
723   PetscInt       i,j,mbs=a->mbs,*bi=b->i,*bj=b->j;
724   PetscInt       *ai,*aj,k,k1,jmin,jmax,*jl,*il,vj,nexti,ili;
725   PetscInt       bs  =A->rmap->bs,bs2 = a->bs2;
726   MatScalar      *ba = b->a,*aa,*ap,*dk,*uik;
727   MatScalar      *u,*diag,*rtmp,*rtmp_ptr;
728   MatScalar      *work;
729   PetscInt       *pivots;
730   PetscBool      allowzeropivot,zeropivotdetected;
731 
732   PetscFunctionBegin;
733   ierr = PetscCalloc1(bs2*mbs,&rtmp);CHKERRQ(ierr);
734   ierr = PetscMalloc2(mbs,&il,mbs,&jl);CHKERRQ(ierr);
735   il[0] = 0;
736   for (i=0; i<mbs; i++) jl[i] = mbs;
737 
738   ierr = PetscMalloc3(bs2,&dk,bs2,&uik,bs,&work);CHKERRQ(ierr);
739   ierr = PetscMalloc1(bs,&pivots);CHKERRQ(ierr);
740   allowzeropivot = PetscNot(A->erroriffailure);
741 
742   ai = a->i; aj = a->j; aa = a->a;
743 
744   /* for each row k */
745   for (k = 0; k<mbs; k++) {
746 
747     /*initialize k-th row with elements nonzero in row k of A */
748     jmin = ai[k]; jmax = ai[k+1];
749     ap   = aa + jmin*bs2;
750     for (j = jmin; j < jmax; j++) {
751       vj       = aj[j];   /* block col. index */
752       rtmp_ptr = rtmp + vj*bs2;
753       for (i=0; i<bs2; i++) *rtmp_ptr++ = *ap++;
754     }
755 
756     /* modify k-th row by adding in those rows i with U(i,k) != 0 */
757     ierr = PetscArraycpy(dk,rtmp+k*bs2,bs2);CHKERRQ(ierr);
758     i    = jl[k]; /* first row to be added to k_th row  */
759 
760     while (i < k) {
761       nexti = jl[i]; /* next row to be added to k_th row */
762 
763       /* compute multiplier */
764       ili = il[i];  /* index of first nonzero element in U(i,k:bms-1) */
765 
766       /* uik = -inv(Di)*U_bar(i,k) */
767       diag = ba + i*bs2;
768       u    = ba + ili*bs2;
769       ierr = PetscArrayzero(uik,bs2);CHKERRQ(ierr);
770       PetscKernel_A_gets_A_minus_B_times_C(bs,uik,diag,u);
771 
772       /* update D(k) += -U(i,k)^T * U_bar(i,k) */
773       PetscKernel_A_gets_A_plus_Btranspose_times_C(bs,dk,uik,u);
774       ierr = PetscLogFlops(2.0*bs*bs2);CHKERRQ(ierr);
775 
776       /* update -U(i,k) */
777       ierr = PetscArraycpy(ba+ili*bs2,uik,bs2);CHKERRQ(ierr);
778 
779       /* add multiple of row i to k-th row ... */
780       jmin = ili + 1; jmax = bi[i+1];
781       if (jmin < jmax) {
782         for (j=jmin; j<jmax; j++) {
783           /* rtmp += -U(i,k)^T * U_bar(i,j) */
784           rtmp_ptr = rtmp + bj[j]*bs2;
785           u        = ba + j*bs2;
786           PetscKernel_A_gets_A_plus_Btranspose_times_C(bs,rtmp_ptr,uik,u);
787         }
788         ierr = PetscLogFlops(2.0*bs*bs2*(jmax-jmin));CHKERRQ(ierr);
789 
790         /* ... add i to row list for next nonzero entry */
791         il[i] = jmin;             /* update il(i) in column k+1, ... mbs-1 */
792         j     = bj[jmin];
793         jl[i] = jl[j]; jl[j] = i; /* update jl */
794       }
795       i = nexti;
796     }
797 
798     /* save nonzero entries in k-th row of U ... */
799 
800     /* invert diagonal block */
801     diag = ba+k*bs2;
802     ierr = PetscArraycpy(diag,dk,bs2);CHKERRQ(ierr);
803 
804     ierr = PetscKernel_A_gets_inverse_A(bs,diag,pivots,work,allowzeropivot,&zeropivotdetected);CHKERRQ(ierr);
805     if (zeropivotdetected) C->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
806 
807     jmin = bi[k]; jmax = bi[k+1];
808     if (jmin < jmax) {
809       for (j=jmin; j<jmax; j++) {
810         vj       = bj[j];      /* block col. index of U */
811         u        = ba + j*bs2;
812         rtmp_ptr = rtmp + vj*bs2;
813         for (k1=0; k1<bs2; k1++) {
814           *u++        = *rtmp_ptr;
815           *rtmp_ptr++ = 0.0;
816         }
817       }
818 
819       /* ... add k to row list for first nonzero entry in k-th row */
820       il[k] = jmin;
821       i     = bj[jmin];
822       jl[k] = jl[i]; jl[i] = k;
823     }
824   }
825 
826   ierr = PetscFree(rtmp);CHKERRQ(ierr);
827   ierr = PetscFree2(il,jl);CHKERRQ(ierr);
828   ierr = PetscFree3(dk,uik,work);CHKERRQ(ierr);
829   ierr = PetscFree(pivots);CHKERRQ(ierr);
830 
831   C->ops->solve          = MatSolve_SeqSBAIJ_N_NaturalOrdering_inplace;
832   C->ops->solvetranspose = MatSolve_SeqSBAIJ_N_NaturalOrdering_inplace;
833   C->ops->forwardsolve   = MatForwardSolve_SeqSBAIJ_N_NaturalOrdering_inplace;
834   C->ops->backwardsolve  = MatBackwardSolve_SeqSBAIJ_N_NaturalOrdering_inplace;
835   C->assembled           = PETSC_TRUE;
836   C->preallocated        = PETSC_TRUE;
837 
838   ierr = PetscLogFlops(1.3333*bs*bs2*b->mbs);CHKERRQ(ierr); /* from inverting diagonal blocks */
839   PetscFunctionReturn(0);
840 }
841 
842 /*
843     Numeric U^T*D*U factorization for SBAIJ format. Modified from SNF of YSMP.
844     Version for blocks 2 by 2.
845 */
846 PetscErrorCode MatCholeskyFactorNumeric_SeqSBAIJ_2(Mat C,Mat A,const MatFactorInfo *info)
847 {
848   Mat_SeqSBAIJ   *a   = (Mat_SeqSBAIJ*)A->data,*b = (Mat_SeqSBAIJ*)C->data;
849   IS             perm = b->row;
850   PetscErrorCode ierr;
851   const PetscInt *ai,*aj,*perm_ptr;
852   PetscInt       i,j,mbs=a->mbs,*bi=b->i,*bj=b->j;
853   PetscInt       *a2anew,k,k1,jmin,jmax,*jl,*il,vj,nexti,ili;
854   MatScalar      *ba = b->a,*aa,*ap;
855   MatScalar      *u,*diag,*rtmp,*rtmp_ptr,dk[4],uik[4];
856   PetscReal      shift = info->shiftamount;
857   PetscBool      allowzeropivot,zeropivotdetected;
858 
859   PetscFunctionBegin;
860   allowzeropivot = PetscNot(A->erroriffailure);
861 
862   /* initialization */
863   /* il and jl record the first nonzero element in each row of the accessing
864      window U(0:k, k:mbs-1).
865      jl:    list of rows to be added to uneliminated rows
866             i>= k: jl(i) is the first row to be added to row i
867             i<  k: jl(i) is the row following row i in some list of rows
868             jl(i) = mbs indicates the end of a list
869      il(i): points to the first nonzero element in columns k,...,mbs-1 of
870             row i of U */
871   ierr = PetscCalloc1(4*mbs,&rtmp);CHKERRQ(ierr);
872   ierr = PetscMalloc2(mbs,&il,mbs,&jl);CHKERRQ(ierr);
873   il[0] = 0;
874   for (i=0; i<mbs; i++) jl[i] = mbs;
875 
876   ierr = ISGetIndices(perm,&perm_ptr);CHKERRQ(ierr);
877 
878   /* check permutation */
879   if (!a->permute) {
880     ai = a->i; aj = a->j; aa = a->a;
881   } else {
882     ai   = a->inew; aj = a->jnew;
883     ierr = PetscMalloc1(4*ai[mbs],&aa);CHKERRQ(ierr);
884     ierr = PetscArraycpy(aa,a->a,4*ai[mbs]);CHKERRQ(ierr);
885     ierr = PetscMalloc1(ai[mbs],&a2anew);CHKERRQ(ierr);
886     ierr = PetscArraycpy(a2anew,a->a2anew,ai[mbs]);CHKERRQ(ierr);
887 
888     for (i=0; i<mbs; i++) {
889       jmin = ai[i]; jmax = ai[i+1];
890       for (j=jmin; j<jmax; j++) {
891         while (a2anew[j] != j) {
892           k = a2anew[j]; a2anew[j] = a2anew[k]; a2anew[k] = k;
893           for (k1=0; k1<4; k1++) {
894             dk[k1]     = aa[k*4+k1];
895             aa[k*4+k1] = aa[j*4+k1];
896             aa[j*4+k1] = dk[k1];
897           }
898         }
899         /* transform columnoriented blocks that lie in the lower triangle to roworiented blocks */
900         if (i > aj[j]) {
901           /* printf("change orientation, row: %d, col: %d\n",i,aj[j]); */
902           ap    = aa + j*4;  /* ptr to the beginning of the block */
903           dk[1] = ap[1];     /* swap ap[1] and ap[2] */
904           ap[1] = ap[2];
905           ap[2] = dk[1];
906         }
907       }
908     }
909     ierr = PetscFree(a2anew);CHKERRQ(ierr);
910   }
911 
912   /* for each row k */
913   for (k = 0; k<mbs; k++) {
914 
915     /*initialize k-th row with elements nonzero in row perm(k) of A */
916     jmin = ai[perm_ptr[k]]; jmax = ai[perm_ptr[k]+1];
917     ap   = aa + jmin*4;
918     for (j = jmin; j < jmax; j++) {
919       vj       = perm_ptr[aj[j]];   /* block col. index */
920       rtmp_ptr = rtmp + vj*4;
921       for (i=0; i<4; i++) *rtmp_ptr++ = *ap++;
922     }
923 
924     /* modify k-th row by adding in those rows i with U(i,k) != 0 */
925     ierr = PetscArraycpy(dk,rtmp+k*4,4);CHKERRQ(ierr);
926     i    = jl[k]; /* first row to be added to k_th row  */
927 
928     while (i < k) {
929       nexti = jl[i]; /* next row to be added to k_th row */
930 
931       /* compute multiplier */
932       ili = il[i];  /* index of first nonzero element in U(i,k:bms-1) */
933 
934       /* uik = -inv(Di)*U_bar(i,k): - ba[ili]*ba[i] */
935       diag   = ba + i*4;
936       u      = ba + ili*4;
937       uik[0] = -(diag[0]*u[0] + diag[2]*u[1]);
938       uik[1] = -(diag[1]*u[0] + diag[3]*u[1]);
939       uik[2] = -(diag[0]*u[2] + diag[2]*u[3]);
940       uik[3] = -(diag[1]*u[2] + diag[3]*u[3]);
941 
942       /* update D(k) += -U(i,k)^T * U_bar(i,k): dk += uik*ba[ili] */
943       dk[0] += uik[0]*u[0] + uik[1]*u[1];
944       dk[1] += uik[2]*u[0] + uik[3]*u[1];
945       dk[2] += uik[0]*u[2] + uik[1]*u[3];
946       dk[3] += uik[2]*u[2] + uik[3]*u[3];
947 
948       ierr = PetscLogFlops(16.0*2.0);CHKERRQ(ierr);
949 
950       /* update -U(i,k): ba[ili] = uik */
951       ierr = PetscArraycpy(ba+ili*4,uik,4);CHKERRQ(ierr);
952 
953       /* add multiple of row i to k-th row ... */
954       jmin = ili + 1; jmax = bi[i+1];
955       if (jmin < jmax) {
956         for (j=jmin; j<jmax; j++) {
957           /* rtmp += -U(i,k)^T * U_bar(i,j): rtmp[bj[j]] += uik*ba[j]; */
958           rtmp_ptr     = rtmp + bj[j]*4;
959           u            = ba + j*4;
960           rtmp_ptr[0] += uik[0]*u[0] + uik[1]*u[1];
961           rtmp_ptr[1] += uik[2]*u[0] + uik[3]*u[1];
962           rtmp_ptr[2] += uik[0]*u[2] + uik[1]*u[3];
963           rtmp_ptr[3] += uik[2]*u[2] + uik[3]*u[3];
964         }
965         ierr = PetscLogFlops(16.0*(jmax-jmin));CHKERRQ(ierr);
966 
967         /* ... add i to row list for next nonzero entry */
968         il[i] = jmin;             /* update il(i) in column k+1, ... mbs-1 */
969         j     = bj[jmin];
970         jl[i] = jl[j]; jl[j] = i; /* update jl */
971       }
972       i = nexti;
973     }
974 
975     /* save nonzero entries in k-th row of U ... */
976 
977     /* invert diagonal block */
978     diag = ba+k*4;
979     ierr = PetscArraycpy(diag,dk,4);CHKERRQ(ierr);
980     ierr = PetscKernel_A_gets_inverse_A_2(diag,shift,allowzeropivot,&zeropivotdetected);CHKERRQ(ierr);
981     if (zeropivotdetected) C->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
982 
983     jmin = bi[k]; jmax = bi[k+1];
984     if (jmin < jmax) {
985       for (j=jmin; j<jmax; j++) {
986         vj       = bj[j];      /* block col. index of U */
987         u        = ba + j*4;
988         rtmp_ptr = rtmp + vj*4;
989         for (k1=0; k1<4; k1++) {
990           *u++        = *rtmp_ptr;
991           *rtmp_ptr++ = 0.0;
992         }
993       }
994 
995       /* ... add k to row list for first nonzero entry in k-th row */
996       il[k] = jmin;
997       i     = bj[jmin];
998       jl[k] = jl[i]; jl[i] = k;
999     }
1000   }
1001 
1002   ierr = PetscFree(rtmp);CHKERRQ(ierr);
1003   ierr = PetscFree2(il,jl);CHKERRQ(ierr);
1004   if (a->permute) {
1005     ierr = PetscFree(aa);CHKERRQ(ierr);
1006   }
1007   ierr = ISRestoreIndices(perm,&perm_ptr);CHKERRQ(ierr);
1008 
1009   C->ops->solve          = MatSolve_SeqSBAIJ_2_inplace;
1010   C->ops->solvetranspose = MatSolve_SeqSBAIJ_2_inplace;
1011   C->assembled           = PETSC_TRUE;
1012   C->preallocated        = PETSC_TRUE;
1013 
1014   ierr = PetscLogFlops(1.3333*8*b->mbs);CHKERRQ(ierr); /* from inverting diagonal blocks */
1015   PetscFunctionReturn(0);
1016 }
1017 
1018 /*
1019       Version for when blocks are 2 by 2 Using natural ordering
1020 */
1021 PetscErrorCode MatCholeskyFactorNumeric_SeqSBAIJ_2_NaturalOrdering(Mat C,Mat A,const MatFactorInfo *info)
1022 {
1023   Mat_SeqSBAIJ   *a = (Mat_SeqSBAIJ*)A->data,*b = (Mat_SeqSBAIJ*)C->data;
1024   PetscErrorCode ierr;
1025   PetscInt       i,j,mbs=a->mbs,*bi=b->i,*bj=b->j;
1026   PetscInt       *ai,*aj,k,k1,jmin,jmax,*jl,*il,vj,nexti,ili;
1027   MatScalar      *ba = b->a,*aa,*ap,dk[8],uik[8];
1028   MatScalar      *u,*diag,*rtmp,*rtmp_ptr;
1029   PetscReal      shift = info->shiftamount;
1030   PetscBool      allowzeropivot,zeropivotdetected;
1031 
1032   PetscFunctionBegin;
1033   allowzeropivot = PetscNot(A->erroriffailure);
1034 
1035   /* initialization */
1036   /* il and jl record the first nonzero element in each row of the accessing
1037      window U(0:k, k:mbs-1).
1038      jl:    list of rows to be added to uneliminated rows
1039             i>= k: jl(i) is the first row to be added to row i
1040             i<  k: jl(i) is the row following row i in some list of rows
1041             jl(i) = mbs indicates the end of a list
1042      il(i): points to the first nonzero element in columns k,...,mbs-1 of
1043             row i of U */
1044   ierr = PetscCalloc1(4*mbs,&rtmp);CHKERRQ(ierr);
1045   ierr = PetscMalloc2(mbs,&il,mbs,&jl);CHKERRQ(ierr);
1046   il[0] = 0;
1047   for (i=0; i<mbs; i++) jl[i] = mbs;
1048 
1049   ai = a->i; aj = a->j; aa = a->a;
1050 
1051   /* for each row k */
1052   for (k = 0; k<mbs; k++) {
1053 
1054     /*initialize k-th row with elements nonzero in row k of A */
1055     jmin = ai[k]; jmax = ai[k+1];
1056     ap   = aa + jmin*4;
1057     for (j = jmin; j < jmax; j++) {
1058       vj       = aj[j];   /* block col. index */
1059       rtmp_ptr = rtmp + vj*4;
1060       for (i=0; i<4; i++) *rtmp_ptr++ = *ap++;
1061     }
1062 
1063     /* modify k-th row by adding in those rows i with U(i,k) != 0 */
1064     ierr = PetscArraycpy(dk,rtmp+k*4,4);CHKERRQ(ierr);
1065     i    = jl[k]; /* first row to be added to k_th row  */
1066 
1067     while (i < k) {
1068       nexti = jl[i]; /* next row to be added to k_th row */
1069 
1070       /* compute multiplier */
1071       ili = il[i];  /* index of first nonzero element in U(i,k:bms-1) */
1072 
1073       /* uik = -inv(Di)*U_bar(i,k): - ba[ili]*ba[i] */
1074       diag   = ba + i*4;
1075       u      = ba + ili*4;
1076       uik[0] = -(diag[0]*u[0] + diag[2]*u[1]);
1077       uik[1] = -(diag[1]*u[0] + diag[3]*u[1]);
1078       uik[2] = -(diag[0]*u[2] + diag[2]*u[3]);
1079       uik[3] = -(diag[1]*u[2] + diag[3]*u[3]);
1080 
1081       /* update D(k) += -U(i,k)^T * U_bar(i,k): dk += uik*ba[ili] */
1082       dk[0] += uik[0]*u[0] + uik[1]*u[1];
1083       dk[1] += uik[2]*u[0] + uik[3]*u[1];
1084       dk[2] += uik[0]*u[2] + uik[1]*u[3];
1085       dk[3] += uik[2]*u[2] + uik[3]*u[3];
1086 
1087       ierr = PetscLogFlops(16.0*2.0);CHKERRQ(ierr);
1088 
1089       /* update -U(i,k): ba[ili] = uik */
1090       ierr = PetscArraycpy(ba+ili*4,uik,4);CHKERRQ(ierr);
1091 
1092       /* add multiple of row i to k-th row ... */
1093       jmin = ili + 1; jmax = bi[i+1];
1094       if (jmin < jmax) {
1095         for (j=jmin; j<jmax; j++) {
1096           /* rtmp += -U(i,k)^T * U_bar(i,j): rtmp[bj[j]] += uik*ba[j]; */
1097           rtmp_ptr     = rtmp + bj[j]*4;
1098           u            = ba + j*4;
1099           rtmp_ptr[0] += uik[0]*u[0] + uik[1]*u[1];
1100           rtmp_ptr[1] += uik[2]*u[0] + uik[3]*u[1];
1101           rtmp_ptr[2] += uik[0]*u[2] + uik[1]*u[3];
1102           rtmp_ptr[3] += uik[2]*u[2] + uik[3]*u[3];
1103         }
1104         ierr = PetscLogFlops(16.0*(jmax-jmin));CHKERRQ(ierr);
1105 
1106         /* ... add i to row list for next nonzero entry */
1107         il[i] = jmin;             /* update il(i) in column k+1, ... mbs-1 */
1108         j     = bj[jmin];
1109         jl[i] = jl[j]; jl[j] = i; /* update jl */
1110       }
1111       i = nexti;
1112     }
1113 
1114     /* save nonzero entries in k-th row of U ... */
1115 
1116     /* invert diagonal block */
1117     diag = ba+k*4;
1118     ierr = PetscArraycpy(diag,dk,4);CHKERRQ(ierr);
1119     ierr = PetscKernel_A_gets_inverse_A_2(diag,shift,allowzeropivot,&zeropivotdetected);CHKERRQ(ierr);
1120     if (zeropivotdetected) C->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
1121 
1122     jmin = bi[k]; jmax = bi[k+1];
1123     if (jmin < jmax) {
1124       for (j=jmin; j<jmax; j++) {
1125         vj       = bj[j];      /* block col. index of U */
1126         u        = ba + j*4;
1127         rtmp_ptr = rtmp + vj*4;
1128         for (k1=0; k1<4; k1++) {
1129           *u++        = *rtmp_ptr;
1130           *rtmp_ptr++ = 0.0;
1131         }
1132       }
1133 
1134       /* ... add k to row list for first nonzero entry in k-th row */
1135       il[k] = jmin;
1136       i     = bj[jmin];
1137       jl[k] = jl[i]; jl[i] = k;
1138     }
1139   }
1140 
1141   ierr = PetscFree(rtmp);CHKERRQ(ierr);
1142   ierr = PetscFree2(il,jl);CHKERRQ(ierr);
1143 
1144   C->ops->solve          = MatSolve_SeqSBAIJ_2_NaturalOrdering_inplace;
1145   C->ops->solvetranspose = MatSolve_SeqSBAIJ_2_NaturalOrdering_inplace;
1146   C->ops->forwardsolve   = MatForwardSolve_SeqSBAIJ_2_NaturalOrdering_inplace;
1147   C->ops->backwardsolve  = MatBackwardSolve_SeqSBAIJ_2_NaturalOrdering_inplace;
1148   C->assembled           = PETSC_TRUE;
1149   C->preallocated        = PETSC_TRUE;
1150 
1151   ierr = PetscLogFlops(1.3333*8*b->mbs);CHKERRQ(ierr); /* from inverting diagonal blocks */
1152   PetscFunctionReturn(0);
1153 }
1154 
1155 /*
1156     Numeric U^T*D*U factorization for SBAIJ format.
1157     Version for blocks are 1 by 1.
1158 */
1159 PetscErrorCode MatCholeskyFactorNumeric_SeqSBAIJ_1_inplace(Mat C,Mat A,const MatFactorInfo *info)
1160 {
1161   Mat_SeqSBAIJ   *a=(Mat_SeqSBAIJ*)A->data,*b=(Mat_SeqSBAIJ*)C->data;
1162   IS             ip=b->row;
1163   PetscErrorCode ierr;
1164   const PetscInt *ai,*aj,*rip;
1165   PetscInt       *a2anew,i,j,mbs=a->mbs,*bi=b->i,*bj=b->j,*bcol;
1166   PetscInt       k,jmin,jmax,*jl,*il,col,nexti,ili,nz;
1167   MatScalar      *rtmp,*ba=b->a,*bval,*aa,dk,uikdi;
1168   PetscReal      rs;
1169   FactorShiftCtx sctx;
1170 
1171   PetscFunctionBegin;
1172   /* MatPivotSetUp(): initialize shift context sctx */
1173   ierr = PetscMemzero(&sctx,sizeof(FactorShiftCtx));CHKERRQ(ierr);
1174 
1175   ierr = ISGetIndices(ip,&rip);CHKERRQ(ierr);
1176   if (!a->permute) {
1177     ai = a->i; aj = a->j; aa = a->a;
1178   } else {
1179     ai     = a->inew; aj = a->jnew;
1180     nz     = ai[mbs];
1181     ierr   = PetscMalloc1(nz,&aa);CHKERRQ(ierr);
1182     a2anew = a->a2anew;
1183     bval   = a->a;
1184     for (j=0; j<nz; j++) {
1185       aa[a2anew[j]] = *(bval++);
1186     }
1187   }
1188 
1189   /* initialization */
1190   /* il and jl record the first nonzero element in each row of the accessing
1191      window U(0:k, k:mbs-1).
1192      jl:    list of rows to be added to uneliminated rows
1193             i>= k: jl(i) is the first row to be added to row i
1194             i<  k: jl(i) is the row following row i in some list of rows
1195             jl(i) = mbs indicates the end of a list
1196      il(i): points to the first nonzero element in columns k,...,mbs-1 of
1197             row i of U */
1198   ierr = PetscMalloc3(mbs,&rtmp,mbs,&il,mbs,&jl);CHKERRQ(ierr);
1199 
1200   do {
1201     sctx.newshift = PETSC_FALSE;
1202     il[0] = 0;
1203     for (i=0; i<mbs; i++) {
1204       rtmp[i] = 0.0; jl[i] = mbs;
1205     }
1206 
1207     for (k = 0; k<mbs; k++) {
1208       /*initialize k-th row by the perm[k]-th row of A */
1209       jmin = ai[rip[k]]; jmax = ai[rip[k]+1];
1210       bval = ba + bi[k];
1211       for (j = jmin; j < jmax; j++) {
1212         col       = rip[aj[j]];
1213         rtmp[col] = aa[j];
1214         *bval++   = 0.0; /* for in-place factorization */
1215       }
1216 
1217       /* shift the diagonal of the matrix */
1218       if (sctx.nshift) rtmp[k] += sctx.shift_amount;
1219 
1220       /* modify k-th row by adding in those rows i with U(i,k)!=0 */
1221       dk = rtmp[k];
1222       i  = jl[k]; /* first row to be added to k_th row  */
1223 
1224       while (i < k) {
1225         nexti = jl[i]; /* next row to be added to k_th row */
1226 
1227         /* compute multiplier, update diag(k) and U(i,k) */
1228         ili     = il[i]; /* index of first nonzero element in U(i,k:bms-1) */
1229         uikdi   = -ba[ili]*ba[bi[i]]; /* diagonal(k) */
1230         dk     += uikdi*ba[ili];
1231         ba[ili] = uikdi; /* -U(i,k) */
1232 
1233         /* add multiple of row i to k-th row */
1234         jmin = ili + 1; jmax = bi[i+1];
1235         if (jmin < jmax) {
1236           for (j=jmin; j<jmax; j++) rtmp[bj[j]] += uikdi*ba[j];
1237           ierr = PetscLogFlops(2.0*(jmax-jmin));CHKERRQ(ierr);
1238 
1239           /* update il and jl for row i */
1240           il[i] = jmin;
1241           j     = bj[jmin]; jl[i] = jl[j]; jl[j] = i;
1242         }
1243         i = nexti;
1244       }
1245 
1246       /* shift the diagonals when zero pivot is detected */
1247       /* compute rs=sum of abs(off-diagonal) */
1248       rs   = 0.0;
1249       jmin = bi[k]+1;
1250       nz   = bi[k+1] - jmin;
1251       if (nz) {
1252         bcol = bj + jmin;
1253         while (nz--) {
1254           rs += PetscAbsScalar(rtmp[*bcol]);
1255           bcol++;
1256         }
1257       }
1258 
1259       sctx.rs = rs;
1260       sctx.pv = dk;
1261       ierr    = MatPivotCheck(C,A,info,&sctx,k);CHKERRQ(ierr);
1262       if (sctx.newshift) break;    /* sctx.shift_amount is updated */
1263       dk = sctx.pv;
1264 
1265       /* copy data into U(k,:) */
1266       ba[bi[k]] = 1.0/dk; /* U(k,k) */
1267       jmin      = bi[k]+1; jmax = bi[k+1];
1268       if (jmin < jmax) {
1269         for (j=jmin; j<jmax; j++) {
1270           col = bj[j]; ba[j] = rtmp[col]; rtmp[col] = 0.0;
1271         }
1272         /* add the k-th row into il and jl */
1273         il[k] = jmin;
1274         i     = bj[jmin]; jl[k] = jl[i]; jl[i] = k;
1275       }
1276     }
1277   } while (sctx.newshift);
1278   ierr = PetscFree3(rtmp,il,jl);CHKERRQ(ierr);
1279   if (a->permute) {ierr = PetscFree(aa);CHKERRQ(ierr);}
1280 
1281   ierr = ISRestoreIndices(ip,&rip);CHKERRQ(ierr);
1282 
1283   C->ops->solve          = MatSolve_SeqSBAIJ_1_inplace;
1284   C->ops->solves         = MatSolves_SeqSBAIJ_1_inplace;
1285   C->ops->solvetranspose = MatSolve_SeqSBAIJ_1_inplace;
1286   C->ops->forwardsolve   = MatForwardSolve_SeqSBAIJ_1_inplace;
1287   C->ops->backwardsolve  = MatBackwardSolve_SeqSBAIJ_1_inplace;
1288   C->assembled           = PETSC_TRUE;
1289   C->preallocated        = PETSC_TRUE;
1290 
1291   ierr = PetscLogFlops(C->rmap->N);CHKERRQ(ierr);
1292   if (sctx.nshift) {
1293     if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
1294       ierr = PetscInfo2(A,"number of shiftnz tries %D, shift_amount %g\n",sctx.nshift,(double)sctx.shift_amount);CHKERRQ(ierr);
1295     } else if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
1296       ierr = PetscInfo2(A,"number of shiftpd tries %D, shift_amount %g\n",sctx.nshift,(double)sctx.shift_amount);CHKERRQ(ierr);
1297     }
1298   }
1299   PetscFunctionReturn(0);
1300 }
1301 
1302 /*
1303   Version for when blocks are 1 by 1 Using natural ordering under new datastructure
1304   Modified from MatCholeskyFactorNumeric_SeqAIJ()
1305 */
1306 PetscErrorCode MatCholeskyFactorNumeric_SeqSBAIJ_1_NaturalOrdering(Mat B,Mat A,const MatFactorInfo *info)
1307 {
1308   Mat_SeqSBAIJ   *a=(Mat_SeqSBAIJ*)A->data;
1309   Mat_SeqSBAIJ   *b=(Mat_SeqSBAIJ*)B->data;
1310   PetscErrorCode ierr;
1311   PetscInt       i,j,mbs=A->rmap->n,*bi=b->i,*bj=b->j,*bdiag=b->diag,*bjtmp;
1312   PetscInt       *ai=a->i,*aj=a->j,*ajtmp;
1313   PetscInt       k,jmin,jmax,*c2r,*il,col,nexti,ili,nz;
1314   MatScalar      *rtmp,*ba=b->a,*bval,*aa=a->a,dk,uikdi;
1315   FactorShiftCtx sctx;
1316   PetscReal      rs;
1317   MatScalar      d,*v;
1318 
1319   PetscFunctionBegin;
1320   ierr = PetscMalloc3(mbs,&rtmp,mbs,&il,mbs,&c2r);CHKERRQ(ierr);
1321 
1322   /* MatPivotSetUp(): initialize shift context sctx */
1323   ierr = PetscMemzero(&sctx,sizeof(FactorShiftCtx));CHKERRQ(ierr);
1324 
1325   if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) { /* set sctx.shift_top=max{rs} */
1326     sctx.shift_top = info->zeropivot;
1327 
1328     ierr = PetscArrayzero(rtmp,mbs);CHKERRQ(ierr);
1329 
1330     for (i=0; i<mbs; i++) {
1331       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
1332       d        = (aa)[a->diag[i]];
1333       rtmp[i] += -PetscRealPart(d);  /* diagonal entry */
1334       ajtmp    = aj + ai[i] + 1;     /* exclude diagonal */
1335       v        = aa + ai[i] + 1;
1336       nz       = ai[i+1] - ai[i] - 1;
1337       for (j=0; j<nz; j++) {
1338         rtmp[i]        += PetscAbsScalar(v[j]);
1339         rtmp[ajtmp[j]] += PetscAbsScalar(v[j]);
1340       }
1341       if (PetscRealPart(rtmp[i]) > sctx.shift_top) sctx.shift_top = PetscRealPart(rtmp[i]);
1342     }
1343     sctx.shift_top *= 1.1;
1344     sctx.nshift_max = 5;
1345     sctx.shift_lo   = 0.;
1346     sctx.shift_hi   = 1.;
1347   }
1348 
1349   /* allocate working arrays
1350      c2r: linked list, keep track of pivot rows for a given column. c2r[col]: head of the list for a given col
1351      il:  for active k row, il[i] gives the index of the 1st nonzero entry in U[i,k:n-1] in bj and ba arrays
1352   */
1353   do {
1354     sctx.newshift = PETSC_FALSE;
1355 
1356     for (i=0; i<mbs; i++) c2r[i] = mbs;
1357     if (mbs) il[0] = 0;
1358 
1359     for (k = 0; k<mbs; k++) {
1360       /* zero rtmp */
1361       nz    = bi[k+1] - bi[k];
1362       bjtmp = bj + bi[k];
1363       for (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;
1364 
1365       /* load in initial unfactored row */
1366       bval = ba + bi[k];
1367       jmin = ai[k]; jmax = ai[k+1];
1368       for (j = jmin; j < jmax; j++) {
1369         col       = aj[j];
1370         rtmp[col] = aa[j];
1371         *bval++   = 0.0; /* for in-place factorization */
1372       }
1373       /* shift the diagonal of the matrix: ZeropivotApply() */
1374       rtmp[k] += sctx.shift_amount;  /* shift the diagonal of the matrix */
1375 
1376       /* modify k-th row by adding in those rows i with U(i,k)!=0 */
1377       dk = rtmp[k];
1378       i  = c2r[k]; /* first row to be added to k_th row  */
1379 
1380       while (i < k) {
1381         nexti = c2r[i]; /* next row to be added to k_th row */
1382 
1383         /* compute multiplier, update diag(k) and U(i,k) */
1384         ili     = il[i]; /* index of first nonzero element in U(i,k:bms-1) */
1385         uikdi   = -ba[ili]*ba[bdiag[i]]; /* diagonal(k) */
1386         dk     += uikdi*ba[ili]; /* update diag[k] */
1387         ba[ili] = uikdi; /* -U(i,k) */
1388 
1389         /* add multiple of row i to k-th row */
1390         jmin = ili + 1; jmax = bi[i+1];
1391         if (jmin < jmax) {
1392           for (j=jmin; j<jmax; j++) rtmp[bj[j]] += uikdi*ba[j];
1393           /* update il and c2r for row i */
1394           il[i] = jmin;
1395           j     = bj[jmin]; c2r[i] = c2r[j]; c2r[j] = i;
1396         }
1397         i = nexti;
1398       }
1399 
1400       /* copy data into U(k,:) */
1401       rs   = 0.0;
1402       jmin = bi[k]; jmax = bi[k+1]-1;
1403       if (jmin < jmax) {
1404         for (j=jmin; j<jmax; j++) {
1405           col = bj[j]; ba[j] = rtmp[col]; rs += PetscAbsScalar(ba[j]);
1406         }
1407         /* add the k-th row into il and c2r */
1408         il[k] = jmin;
1409         i     = bj[jmin]; c2r[k] = c2r[i]; c2r[i] = k;
1410       }
1411 
1412       sctx.rs = rs;
1413       sctx.pv = dk;
1414       ierr    = MatPivotCheck(B,A,info,&sctx,k);CHKERRQ(ierr);
1415       if (sctx.newshift) break;
1416       dk = sctx.pv;
1417 
1418       ba[bdiag[k]] = 1.0/dk; /* U(k,k) */
1419     }
1420   } while (sctx.newshift);
1421 
1422   ierr = PetscFree3(rtmp,il,c2r);CHKERRQ(ierr);
1423 
1424   B->ops->solve          = MatSolve_SeqSBAIJ_1_NaturalOrdering;
1425   B->ops->solves         = MatSolves_SeqSBAIJ_1;
1426   B->ops->solvetranspose = MatSolve_SeqSBAIJ_1_NaturalOrdering;
1427   B->ops->forwardsolve   = MatForwardSolve_SeqSBAIJ_1_NaturalOrdering;
1428   B->ops->backwardsolve  = MatBackwardSolve_SeqSBAIJ_1_NaturalOrdering;
1429 
1430   B->assembled    = PETSC_TRUE;
1431   B->preallocated = PETSC_TRUE;
1432 
1433   ierr = PetscLogFlops(B->rmap->n);CHKERRQ(ierr);
1434 
1435   /* MatPivotView() */
1436   if (sctx.nshift) {
1437     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
1438       ierr = PetscInfo4(A,"number of shift_pd tries %D, shift_amount %g, diagonal shifted up by %e fraction top_value %e\n",sctx.nshift,(double)sctx.shift_amount,(double)sctx.shift_fraction,(double)sctx.shift_top);CHKERRQ(ierr);
1439     } else if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
1440       ierr = PetscInfo2(A,"number of shift_nz tries %D, shift_amount %g\n",sctx.nshift,(double)sctx.shift_amount);CHKERRQ(ierr);
1441     } else if (info->shifttype == (PetscReal)MAT_SHIFT_INBLOCKS) {
1442       ierr = PetscInfo2(A,"number of shift_inblocks applied %D, each shift_amount %g\n",sctx.nshift,(double)info->shiftamount);CHKERRQ(ierr);
1443     }
1444   }
1445   PetscFunctionReturn(0);
1446 }
1447 
1448 PetscErrorCode MatCholeskyFactorNumeric_SeqSBAIJ_1_NaturalOrdering_inplace(Mat C,Mat A,const MatFactorInfo *info)
1449 {
1450   Mat_SeqSBAIJ   *a=(Mat_SeqSBAIJ*)A->data,*b=(Mat_SeqSBAIJ*)C->data;
1451   PetscErrorCode ierr;
1452   PetscInt       i,j,mbs = a->mbs;
1453   PetscInt       *ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j;
1454   PetscInt       k,jmin,*jl,*il,nexti,ili,*acol,*bcol,nz;
1455   MatScalar      *rtmp,*ba=b->a,*aa=a->a,dk,uikdi,*aval,*bval;
1456   PetscReal      rs;
1457   FactorShiftCtx sctx;
1458 
1459   PetscFunctionBegin;
1460   /* MatPivotSetUp(): initialize shift context sctx */
1461   ierr = PetscMemzero(&sctx,sizeof(FactorShiftCtx));CHKERRQ(ierr);
1462 
1463   /* initialization */
1464   /* il and jl record the first nonzero element in each row of the accessing
1465      window U(0:k, k:mbs-1).
1466      jl:    list of rows to be added to uneliminated rows
1467             i>= k: jl(i) is the first row to be added to row i
1468             i<  k: jl(i) is the row following row i in some list of rows
1469             jl(i) = mbs indicates the end of a list
1470      il(i): points to the first nonzero element in U(i,k:mbs-1)
1471   */
1472   ierr = PetscMalloc1(mbs,&rtmp);CHKERRQ(ierr);
1473   ierr = PetscMalloc2(mbs,&il,mbs,&jl);CHKERRQ(ierr);
1474 
1475   do {
1476     sctx.newshift = PETSC_FALSE;
1477     il[0] = 0;
1478     for (i=0; i<mbs; i++) {
1479       rtmp[i] = 0.0; jl[i] = mbs;
1480     }
1481 
1482     for (k = 0; k<mbs; k++) {
1483       /*initialize k-th row with elements nonzero in row perm(k) of A */
1484       nz   = ai[k+1] - ai[k];
1485       acol = aj + ai[k];
1486       aval = aa + ai[k];
1487       bval = ba + bi[k];
1488       while (nz--) {
1489         rtmp[*acol++] = *aval++;
1490         *bval++       = 0.0; /* for in-place factorization */
1491       }
1492 
1493       /* shift the diagonal of the matrix */
1494       if (sctx.nshift) rtmp[k] += sctx.shift_amount;
1495 
1496       /* modify k-th row by adding in those rows i with U(i,k)!=0 */
1497       dk = rtmp[k];
1498       i  = jl[k]; /* first row to be added to k_th row  */
1499 
1500       while (i < k) {
1501         nexti = jl[i]; /* next row to be added to k_th row */
1502         /* compute multiplier, update D(k) and U(i,k) */
1503         ili     = il[i]; /* index of first nonzero element in U(i,k:bms-1) */
1504         uikdi   = -ba[ili]*ba[bi[i]];
1505         dk     += uikdi*ba[ili];
1506         ba[ili] = uikdi; /* -U(i,k) */
1507 
1508         /* add multiple of row i to k-th row ... */
1509         jmin = ili + 1;
1510         nz   = bi[i+1] - jmin;
1511         if (nz > 0) {
1512           bcol = bj + jmin;
1513           bval = ba + jmin;
1514           ierr = PetscLogFlops(2.0*nz);CHKERRQ(ierr);
1515           while (nz--) rtmp[*bcol++] += uikdi*(*bval++);
1516 
1517           /* update il and jl for i-th row */
1518           il[i] = jmin;
1519           j     = bj[jmin]; jl[i] = jl[j]; jl[j] = i;
1520         }
1521         i = nexti;
1522       }
1523 
1524       /* shift the diagonals when zero pivot is detected */
1525       /* compute rs=sum of abs(off-diagonal) */
1526       rs   = 0.0;
1527       jmin = bi[k]+1;
1528       nz   = bi[k+1] - jmin;
1529       if (nz) {
1530         bcol = bj + jmin;
1531         while (nz--) {
1532           rs += PetscAbsScalar(rtmp[*bcol]);
1533           bcol++;
1534         }
1535       }
1536 
1537       sctx.rs = rs;
1538       sctx.pv = dk;
1539       ierr    = MatPivotCheck(C,A,info,&sctx,k);CHKERRQ(ierr);
1540       if (sctx.newshift) break;    /* sctx.shift_amount is updated */
1541       dk = sctx.pv;
1542 
1543       /* copy data into U(k,:) */
1544       ba[bi[k]] = 1.0/dk;
1545       jmin      = bi[k]+1;
1546       nz        = bi[k+1] - jmin;
1547       if (nz) {
1548         bcol = bj + jmin;
1549         bval = ba + jmin;
1550         while (nz--) {
1551           *bval++       = rtmp[*bcol];
1552           rtmp[*bcol++] = 0.0;
1553         }
1554         /* add k-th row into il and jl */
1555         il[k] = jmin;
1556         i     = bj[jmin]; jl[k] = jl[i]; jl[i] = k;
1557       }
1558     } /* end of for (k = 0; k<mbs; k++) */
1559   } while (sctx.newshift);
1560   ierr = PetscFree(rtmp);CHKERRQ(ierr);
1561   ierr = PetscFree2(il,jl);CHKERRQ(ierr);
1562 
1563   C->ops->solve          = MatSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
1564   C->ops->solves         = MatSolves_SeqSBAIJ_1_inplace;
1565   C->ops->solvetranspose = MatSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
1566   C->ops->forwardsolve   = MatForwardSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
1567   C->ops->backwardsolve  = MatBackwardSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
1568 
1569   C->assembled    = PETSC_TRUE;
1570   C->preallocated = PETSC_TRUE;
1571 
1572   ierr = PetscLogFlops(C->rmap->N);CHKERRQ(ierr);
1573   if (sctx.nshift) {
1574     if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
1575       ierr = PetscInfo2(A,"number of shiftnz tries %D, shift_amount %g\n",sctx.nshift,(double)sctx.shift_amount);CHKERRQ(ierr);
1576     } else if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
1577       ierr = PetscInfo2(A,"number of shiftpd tries %D, shift_amount %g\n",sctx.nshift,(double)sctx.shift_amount);CHKERRQ(ierr);
1578     }
1579   }
1580   PetscFunctionReturn(0);
1581 }
1582 
1583 PetscErrorCode MatCholeskyFactor_SeqSBAIJ(Mat A,IS perm,const MatFactorInfo *info)
1584 {
1585   PetscErrorCode ierr;
1586   Mat            C;
1587 
1588   PetscFunctionBegin;
1589   ierr = MatGetFactor(A,"petsc",MAT_FACTOR_CHOLESKY,&C);CHKERRQ(ierr);
1590   ierr = MatCholeskyFactorSymbolic(C,A,perm,info);CHKERRQ(ierr);
1591   ierr = MatCholeskyFactorNumeric(C,A,info);CHKERRQ(ierr);
1592 
1593   A->ops->solve          = C->ops->solve;
1594   A->ops->solvetranspose = C->ops->solvetranspose;
1595 
1596   ierr = MatHeaderMerge(A,&C);CHKERRQ(ierr);
1597   PetscFunctionReturn(0);
1598 }
1599 
1600 
1601