xref: /petsc/src/mat/impls/aij/seq/aijfact.c (revision b22b330c5ca615f114690330d6518ed7fe08adeb)
1 #define PETSCMAT_DLL
2 
3 
4 #include "../src/mat/impls/aij/seq/aij.h"
5 #include "../src/mat/impls/sbaij/seq/sbaij.h"
6 #include "petscbt.h"
7 #include "../src/mat/utils/freespace.h"
8 
9 EXTERN_C_BEGIN
10 #undef __FUNCT__
11 #define __FUNCT__ "MatOrdering_Flow_SeqAIJ"
12 /*
13       Computes an ordering to get most of the large numerical values in the lower triangular part of the matrix
14 */
15 PetscErrorCode MatOrdering_Flow_SeqAIJ(Mat mat,const MatOrderingType type,IS *irow,IS *icol)
16 {
17   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)mat->data;
18   PetscErrorCode    ierr;
19   PetscInt          i,j,jj,k, kk,n = mat->rmap->n, current = 0, newcurrent = 0,*order;
20   const PetscInt    *ai = a->i, *aj = a->j;
21   const PetscScalar *aa = a->a;
22   PetscTruth        *done;
23   PetscReal         best,past = 0,future;
24 
25   PetscFunctionBegin;
26   /* pick initial row */
27   best = -1;
28   for (i=0; i<n; i++) {
29     future = 0;
30     for (j=ai[i]; j<ai[i+1]; j++) {
31       if (aj[j] != i) future  += PetscAbsScalar(aa[j]); else past = PetscAbsScalar(aa[j]);
32     }
33     if (!future) future = 1.e-10; /* if there is zero in the upper diagonal part want to rank this row high */
34     if (past/future > best) {
35       best = past/future;
36       current = i;
37     }
38   }
39 
40   ierr = PetscMalloc(n*sizeof(PetscTruth),&done);CHKERRQ(ierr);
41   ierr = PetscMalloc(n*sizeof(PetscInt),&order);CHKERRQ(ierr);
42   ierr = PetscMemzero(done,n*sizeof(PetscTruth));CHKERRQ(ierr);
43   order[0] = current;
44   for (i=0; i<n-1; i++) {
45     done[current] = PETSC_TRUE;
46     best          = -1;
47     /* loop over all neighbors of current pivot */
48     for (j=ai[current]; j<ai[current+1]; j++) {
49       jj = aj[j];
50       if (done[jj]) continue;
51       /* loop over columns of potential next row computing weights for below and above diagonal */
52       past = future = 0.0;
53       for (k=ai[jj]; k<ai[jj+1]; k++) {
54         kk = aj[k];
55         if (done[kk]) past += PetscAbsScalar(aa[k]);
56         else if (kk != jj) future  += PetscAbsScalar(aa[k]);
57       }
58       if (!future) future = 1.e-10; /* if there is zero in the upper diagonal part want to rank this row high */
59       if (past/future > best) {
60         best = past/future;
61         newcurrent = jj;
62       }
63     }
64     if (best == -1) { /* no neighbors to select from so select best of all that remain */
65       best = -1;
66       for (k=0; k<n; k++) {
67         if (done[k]) continue;
68         future = 0;
69         past   = 0;
70         for (j=ai[k]; j<ai[k+1]; j++) {
71           kk = aj[j];
72           if (done[kk]) past += PetscAbsScalar(aa[j]);
73           else if (kk != k) future  += PetscAbsScalar(aa[j]);
74         }
75         if (!future) future = 1.e-10; /* if there is zero in the upper diagonal part want to rank this row high */
76         if (past/future > best) {
77           best = past/future;
78           newcurrent = k;
79         }
80       }
81     }
82     if (current == newcurrent) SETERRQ(PETSC_ERR_PLIB,"newcurrent cannot be current");
83     current = newcurrent;
84     order[i+1] = current;
85   }
86   ierr = ISCreateGeneral(PETSC_COMM_SELF,n,order,irow);CHKERRQ(ierr);
87   *icol = *irow;
88   ierr = PetscObjectReference((PetscObject)*irow);CHKERRQ(ierr);
89   ierr = PetscFree(done);CHKERRQ(ierr);
90   ierr = PetscFree(order);CHKERRQ(ierr);
91   PetscFunctionReturn(0);
92 }
93 EXTERN_C_END
94 
95 EXTERN_C_BEGIN
96 #undef __FUNCT__
97 #define __FUNCT__ "MatGetFactorAvailable_seqaij_petsc"
98 PetscErrorCode MatGetFactorAvailable_seqaij_petsc(Mat A,MatFactorType ftype,PetscTruth *flg)
99 {
100   PetscFunctionBegin;
101   *flg = PETSC_TRUE;
102   PetscFunctionReturn(0);
103 }
104 EXTERN_C_END
105 
106 EXTERN_C_BEGIN
107 #undef __FUNCT__
108 #define __FUNCT__ "MatGetFactor_seqaij_petsc"
109 PetscErrorCode MatGetFactor_seqaij_petsc(Mat A,MatFactorType ftype,Mat *B)
110 {
111   PetscInt           n = A->rmap->n;
112   PetscErrorCode     ierr;
113 
114   PetscFunctionBegin;
115   ierr = MatCreate(((PetscObject)A)->comm,B);CHKERRQ(ierr);
116   ierr = MatSetSizes(*B,n,n,n,n);CHKERRQ(ierr);
117   if (ftype == MAT_FACTOR_LU || ftype == MAT_FACTOR_ILU || ftype == MAT_FACTOR_ILUDT){
118     ierr = MatSetType(*B,MATSEQAIJ);CHKERRQ(ierr);
119     (*B)->ops->ilufactorsymbolic = MatILUFactorSymbolic_SeqAIJ;
120     (*B)->ops->lufactorsymbolic  = MatLUFactorSymbolic_SeqAIJ;
121     (*B)->ops->iludtfactor       = MatILUDTFactor_SeqAIJ;
122   } else if (ftype == MAT_FACTOR_CHOLESKY || ftype == MAT_FACTOR_ICC) {
123     ierr = MatSetType(*B,MATSEQSBAIJ);CHKERRQ(ierr);
124     ierr = MatSeqSBAIJSetPreallocation(*B,1,MAT_SKIP_ALLOCATION,PETSC_NULL);CHKERRQ(ierr);
125     (*B)->ops->iccfactorsymbolic      = MatICCFactorSymbolic_SeqAIJ;
126     (*B)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqAIJ;
127   } else SETERRQ(PETSC_ERR_SUP,"Factor type not supported");
128   (*B)->factor = ftype;
129   PetscFunctionReturn(0);
130 }
131 EXTERN_C_END
132 
133 #undef __FUNCT__
134 #define __FUNCT__ "MatLUFactorSymbolic_SeqAIJ"
135 PetscErrorCode MatLUFactorSymbolic_SeqAIJ(Mat B,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
136 {
137   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
138   IS                 isicol;
139   PetscErrorCode     ierr;
140   const PetscInt     *r,*ic;
141   PetscInt           i,n=A->rmap->n,*ai=a->i,*aj=a->j;
142   PetscInt           *bi,*bj,*ajtmp;
143   PetscInt           *bdiag,row,nnz,nzi,reallocs=0,nzbd,*im;
144   PetscReal          f;
145   PetscInt           nlnk,*lnk,k,**bi_ptr;
146   PetscFreeSpaceList free_space=PETSC_NULL,current_space=PETSC_NULL;
147   PetscBT            lnkbt;
148   PetscTruth         newdatastruct=PETSC_FALSE;
149 
150   PetscFunctionBegin;
151   ierr = PetscOptionsGetTruth(PETSC_NULL,"-lu_new",&newdatastruct,PETSC_NULL);CHKERRQ(ierr);
152   if(newdatastruct){
153     ierr = MatLUFactorSymbolic_SeqAIJ_newdatastruct(B,A,isrow,iscol,info);CHKERRQ(ierr);
154     PetscFunctionReturn(0);
155   }
156 
157   if (A->rmap->N != A->cmap->N) SETERRQ(PETSC_ERR_ARG_WRONG,"matrix must be square");
158   ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr);
159   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
160   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
161 
162   /* get new row pointers */
163   ierr = PetscMalloc((n+1)*sizeof(PetscInt),&bi);CHKERRQ(ierr);
164   bi[0] = 0;
165 
166   /* bdiag is location of diagonal in factor */
167   ierr = PetscMalloc((n+1)*sizeof(PetscInt),&bdiag);CHKERRQ(ierr);
168   bdiag[0] = 0;
169 
170   /* linked list for storing column indices of the active row */
171   nlnk = n + 1;
172   ierr = PetscLLCreate(n,n,nlnk,lnk,lnkbt);CHKERRQ(ierr);
173 
174   ierr = PetscMalloc2(n+1,PetscInt**,&bi_ptr,n+1,PetscInt,&im);CHKERRQ(ierr);
175 
176   /* initial FreeSpace size is f*(ai[n]+1) */
177   f = info->fill;
178   ierr = PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space);CHKERRQ(ierr);
179   current_space = free_space;
180 
181   for (i=0; i<n; i++) {
182     /* copy previous fill into linked list */
183     nzi = 0;
184     nnz = ai[r[i]+1] - ai[r[i]];
185     if (!nnz) SETERRQ2(PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
186     ajtmp = aj + ai[r[i]];
187     ierr = PetscLLAddPerm(nnz,ajtmp,ic,n,nlnk,lnk,lnkbt);CHKERRQ(ierr);
188     nzi += nlnk;
189 
190     /* add pivot rows into linked list */
191     row = lnk[n];
192     while (row < i) {
193       nzbd    = bdiag[row] - bi[row] + 1; /* num of entries in the row with column index <= row */
194       ajtmp   = bi_ptr[row] + nzbd; /* points to the entry next to the diagonal */
195       ierr = PetscLLAddSortedLU(ajtmp,row,nlnk,lnk,lnkbt,i,nzbd,im);CHKERRQ(ierr);
196       nzi += nlnk;
197       row  = lnk[row];
198     }
199     bi[i+1] = bi[i] + nzi;
200     im[i]   = nzi;
201 
202     /* mark bdiag */
203     nzbd = 0;
204     nnz  = nzi;
205     k    = lnk[n];
206     while (nnz-- && k < i){
207       nzbd++;
208       k = lnk[k];
209     }
210     bdiag[i] = bi[i] + nzbd;
211 
212     /* if free space is not available, make more free space */
213     if (current_space->local_remaining<nzi) {
214       nnz = (n - i)*nzi; /* estimated and max additional space needed */
215       ierr = PetscFreeSpaceGet(nnz,&current_space);CHKERRQ(ierr);
216       reallocs++;
217     }
218 
219     /* copy data into free space, then initialize lnk */
220     ierr = PetscLLClean(n,n,nzi,lnk,current_space->array,lnkbt);CHKERRQ(ierr);
221     bi_ptr[i] = current_space->array;
222     current_space->array           += nzi;
223     current_space->local_used      += nzi;
224     current_space->local_remaining -= nzi;
225   }
226 #if defined(PETSC_USE_INFO)
227   if (ai[n] != 0) {
228     PetscReal af = ((PetscReal)bi[n])/((PetscReal)ai[n]);
229     ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,f,af);CHKERRQ(ierr);
230     ierr = PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);CHKERRQ(ierr);
231     ierr = PetscInfo1(A,"PCFactorSetFill(pc,%G);\n",af);CHKERRQ(ierr);
232     ierr = PetscInfo(A,"for best performance.\n");CHKERRQ(ierr);
233   } else {
234     ierr = PetscInfo(A,"Empty matrix\n");CHKERRQ(ierr);
235   }
236 #endif
237 
238   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
239   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
240 
241   /* destroy list of free space and other temporary array(s) */
242   ierr = PetscMalloc((bi[n]+1)*sizeof(PetscInt),&bj);CHKERRQ(ierr);
243   ierr = PetscFreeSpaceContiguous(&free_space,bj);CHKERRQ(ierr);
244   ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
245   ierr = PetscFree2(bi_ptr,im);CHKERRQ(ierr);
246 
247   /* put together the new matrix */
248   ierr = MatSeqAIJSetPreallocation_SeqAIJ(B,MAT_SKIP_ALLOCATION,PETSC_NULL);CHKERRQ(ierr);
249   ierr = PetscLogObjectParent(B,isicol);CHKERRQ(ierr);
250   b    = (Mat_SeqAIJ*)(B)->data;
251   b->free_a       = PETSC_TRUE;
252   b->free_ij      = PETSC_TRUE;
253   b->singlemalloc = PETSC_FALSE;
254   ierr          = PetscMalloc((bi[n]+1)*sizeof(PetscScalar),&b->a);CHKERRQ(ierr);
255   b->j          = bj;
256   b->i          = bi;
257   b->diag       = bdiag;
258   b->ilen       = 0;
259   b->imax       = 0;
260   b->row        = isrow;
261   b->col        = iscol;
262   ierr          = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
263   ierr          = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
264   b->icol       = isicol;
265   ierr          = PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
266 
267   /* In b structure:  Free imax, ilen, old a, old j.  Allocate solve_work, new a, new j */
268   ierr = PetscLogObjectMemory(B,(bi[n]-n)*(sizeof(PetscInt)+sizeof(PetscScalar)));CHKERRQ(ierr);
269   b->maxnz = b->nz = bi[n] ;
270 
271   (B)->factor                = MAT_FACTOR_LU;
272   (B)->info.factor_mallocs   = reallocs;
273   (B)->info.fill_ratio_given = f;
274 
275   if (ai[n]) {
276     (B)->info.fill_ratio_needed = ((PetscReal)bi[n])/((PetscReal)ai[n]);
277   } else {
278     (B)->info.fill_ratio_needed = 0.0;
279   }
280   (B)->ops->lufactornumeric  = MatLUFactorNumeric_SeqAIJ;
281   (B)->ops->solve            = MatSolve_SeqAIJ;
282   (B)->ops->solvetranspose   = MatSolveTranspose_SeqAIJ;
283   /* switch to inodes if appropriate */
284   ierr = MatLUFactorSymbolic_Inode(B,A,isrow,iscol,info);CHKERRQ(ierr);
285   PetscFunctionReturn(0);
286 }
287 
288 #undef __FUNCT__
289 #define __FUNCT__ "MatLUFactorSymbolic_SeqAIJ_newdatastruct"
290 PetscErrorCode MatLUFactorSymbolic_SeqAIJ_newdatastruct(Mat B,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
291 {
292   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
293   IS                 isicol;
294   PetscErrorCode     ierr;
295   const PetscInt     *r,*ic;
296   PetscInt           i,n=A->rmap->n,*ai=a->i,*aj=a->j;
297   PetscInt           *bi,*bj,*ajtmp;
298   PetscInt           *bdiag,row,nnz,nzi,reallocs=0,nzbd,*im;
299   PetscReal          f;
300   PetscInt           nlnk,*lnk,k,**bi_ptr;
301   PetscFreeSpaceList free_space=PETSC_NULL,current_space=PETSC_NULL;
302   PetscBT            lnkbt;
303 
304   PetscFunctionBegin;
305   if (A->rmap->N != A->cmap->N) SETERRQ(PETSC_ERR_ARG_WRONG,"matrix must be square");
306   ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr);
307   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
308   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
309 
310   /* get new row pointers */
311   ierr = PetscMalloc((2*n+2)*sizeof(PetscInt),&bi);CHKERRQ(ierr);
312   bi[0] = 0;
313 
314   /* bdiag is location of diagonal in factor */
315   ierr = PetscMalloc((n+1)*sizeof(PetscInt),&bdiag);CHKERRQ(ierr);
316   bdiag[0] = 0;
317 
318   /* linked list for storing column indices of the active row */
319   nlnk = n + 1;
320   ierr = PetscLLCreate(n,n,nlnk,lnk,lnkbt);CHKERRQ(ierr);
321 
322   ierr = PetscMalloc2(n+1,PetscInt**,&bi_ptr,n+1,PetscInt,&im);CHKERRQ(ierr);
323 
324   /* initial FreeSpace size is f*(ai[n]+1) */
325   f = info->fill;
326   ierr = PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space);CHKERRQ(ierr);
327   current_space = free_space;
328 
329   for (i=0; i<n; i++) {
330     /* copy previous fill into linked list */
331     nzi = 0;
332     nnz = ai[r[i]+1] - ai[r[i]];
333     if (!nnz) SETERRQ2(PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
334     ajtmp = aj + ai[r[i]];
335     ierr = PetscLLAddPerm(nnz,ajtmp,ic,n,nlnk,lnk,lnkbt);CHKERRQ(ierr);
336     nzi += nlnk;
337 
338     /* add pivot rows into linked list */
339     row = lnk[n];
340     while (row < i){
341       nzbd  = bdiag[row] + 1; /* num of entries in the row with column index <= row */
342       ajtmp = bi_ptr[row] + nzbd; /* points to the entry next to the diagonal */
343       ierr  = PetscLLAddSortedLU(ajtmp,row,nlnk,lnk,lnkbt,i,nzbd,im);CHKERRQ(ierr);
344       nzi  += nlnk;
345       row   = lnk[row];
346     }
347     bi[i+1] = bi[i] + nzi;
348     im[i]   = nzi;
349 
350     /* mark bdiag */
351     nzbd = 0;
352     nnz  = nzi;
353     k    = lnk[n];
354     while (nnz-- && k < i){
355       nzbd++;
356       k = lnk[k];
357     }
358     bdiag[i] = nzbd; /* note: bdiag[i] = nnzL as input for PetscFreeSpaceContiguous_LU() */
359 
360     /* if free space is not available, make more free space */
361     if (current_space->local_remaining<nzi) {
362       nnz = 2*(n - i)*nzi; /* estimated and max additional space needed */
363       ierr = PetscFreeSpaceGet(nnz,&current_space);CHKERRQ(ierr);
364       reallocs++;
365     }
366 
367     /* copy data into free space, then initialize lnk */
368     ierr = PetscLLClean(n,n,nzi,lnk,current_space->array,lnkbt);CHKERRQ(ierr);
369     bi_ptr[i] = current_space->array;
370     current_space->array           += nzi;
371     current_space->local_used      += nzi;
372     current_space->local_remaining -= nzi;
373   }
374 #if defined(PETSC_USE_INFO)
375   if (ai[n] != 0) {
376     PetscReal af = ((PetscReal)bi[n])/((PetscReal)ai[n]);
377     ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,f,af);CHKERRQ(ierr);
378     ierr = PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);CHKERRQ(ierr);
379     ierr = PetscInfo1(A,"PCFactorSetFill(pc,%G);\n",af);CHKERRQ(ierr);
380     ierr = PetscInfo(A,"for best performance.\n");CHKERRQ(ierr);
381   } else {
382     ierr = PetscInfo(A,"Empty matrix\n");CHKERRQ(ierr);
383   }
384 #endif
385 
386   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
387   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
388 
389   /* destroy list of free space and other temporary array(s) */
390   ierr = PetscMalloc((bi[n]+1)*sizeof(PetscInt),&bj);CHKERRQ(ierr);
391   ierr = PetscFreeSpaceContiguous_LU(&free_space,bj,n,bi,bdiag);CHKERRQ(ierr);
392   ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
393   ierr = PetscFree2(bi_ptr,im);CHKERRQ(ierr);
394 
395   /* put together the new matrix */
396   ierr = MatSeqAIJSetPreallocation_SeqAIJ(B,MAT_SKIP_ALLOCATION,PETSC_NULL);CHKERRQ(ierr);
397   ierr = PetscLogObjectParent(B,isicol);CHKERRQ(ierr);
398   b    = (Mat_SeqAIJ*)(B)->data;
399   b->free_a       = PETSC_TRUE;
400   b->free_ij      = PETSC_TRUE;
401   b->singlemalloc = PETSC_FALSE;
402   ierr          = PetscMalloc((bi[2*n+1])*sizeof(PetscScalar),&b->a);CHKERRQ(ierr);
403   b->j          = bj;
404   b->i          = bi;
405   b->diag       = bdiag;
406   b->ilen       = 0;
407   b->imax       = 0;
408   b->row        = isrow;
409   b->col        = iscol;
410   ierr          = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
411   ierr          = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
412   b->icol       = isicol;
413   ierr          = PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
414 
415   /* In b structure:  Free imax, ilen, old a, old j.  Allocate solve_work, new a, new j */
416   ierr = PetscLogObjectMemory(B,bi[2*n+1]*(sizeof(PetscInt)+sizeof(PetscScalar)));CHKERRQ(ierr);
417   b->maxnz = b->nz = bi[2*n+1] ;
418 
419   (B)->factor                = MAT_FACTOR_LU;
420   (B)->info.factor_mallocs   = reallocs;
421   (B)->info.fill_ratio_given = f;
422 
423   if (ai[n]) {
424     (B)->info.fill_ratio_needed = ((PetscReal)bi[2*n+1])/((PetscReal)ai[n]);
425   } else {
426     (B)->info.fill_ratio_needed = 0.0;
427   }
428   (B)->ops->lufactornumeric  = MatLUFactorNumeric_SeqAIJ_newdatastruct;
429   PetscFunctionReturn(0);
430 }
431 
432 /*
433     Trouble in factorization, should we dump the original matrix?
434 */
435 #undef __FUNCT__
436 #define __FUNCT__ "MatFactorDumpMatrix"
437 PetscErrorCode MatFactorDumpMatrix(Mat A)
438 {
439   PetscErrorCode ierr;
440   PetscTruth     flg = PETSC_FALSE;
441 
442   PetscFunctionBegin;
443   ierr = PetscOptionsGetTruth(PETSC_NULL,"-mat_factor_dump_on_error",&flg,PETSC_NULL);CHKERRQ(ierr);
444   if (flg) {
445     PetscViewer viewer;
446     char        filename[PETSC_MAX_PATH_LEN];
447 
448     ierr = PetscSNPrintf(filename,PETSC_MAX_PATH_LEN,"matrix_factor_error.%d",PetscGlobalRank);CHKERRQ(ierr);
449     ierr = PetscViewerBinaryOpen(((PetscObject)A)->comm,filename,FILE_MODE_WRITE,&viewer);CHKERRQ(ierr);
450     ierr = MatView(A,viewer);CHKERRQ(ierr);
451     ierr = PetscViewerDestroy(viewer);CHKERRQ(ierr);
452   }
453   PetscFunctionReturn(0);
454 }
455 
456 extern PetscErrorCode MatSolve_Inode(Mat,Vec,Vec);
457 
458 /* ----------------------------------------------------------- */
459 extern PetscErrorCode MatSolve_SeqAIJ_NaturalOrdering_newdatastruct(Mat,Vec,Vec);
460 extern PetscErrorCode MatSolve_SeqAIJ_newdatastruct(Mat,Vec,Vec);
461 
462 #undef __FUNCT__
463 #define __FUNCT__ "MatLUFactorNumeric_SeqAIJ_newdatastruct"
464 PetscErrorCode MatLUFactorNumeric_SeqAIJ_newdatastruct(Mat B,Mat A,const MatFactorInfo *info)
465 {
466   Mat            C=B;
467   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data,*b=(Mat_SeqAIJ *)C->data;
468   IS             isrow = b->row,isicol = b->icol;
469   PetscErrorCode ierr;
470   const PetscInt *r,*ic,*ics;
471   PetscInt       i,j,k,n=A->rmap->n,*ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j;
472   PetscInt       *ajtmp,*bjtmp,nz,nzL,row,*bdiag=b->diag,*pj;
473   MatScalar      *rtmp,*pc,multiplier,*v,*pv,*aa=a->a;
474   PetscTruth     row_identity,col_identity;
475 
476   LUShift_Ctx    sctx;
477   PetscInt       *ddiag,newshift;
478   PetscReal      rs;
479   MatScalar      d;
480 
481   PetscFunctionBegin;
482   /* ZeropivotSetUp(): initialize shift context sctx */
483   sctx.nshift         = 0;
484   sctx.nshift_max     = 0;
485   sctx.shift_top      = 0.0;
486   sctx.shift_lo       = 0.0;
487   sctx.shift_hi       = 0.0;
488   sctx.shift_fraction = 0.0;
489   sctx.shift_amount   = 0.0;
490 
491   /* if both shift schemes are chosen by user, only use info->shiftpd */
492   if (info->shiftpd) { /* set sctx.shift_top=max{rs} */
493     ddiag          = a->diag;
494     sctx.shift_top = info->zeropivot;
495     for (i=0; i<n; i++) {
496       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
497       d  = (aa)[ddiag[i]];
498       rs = -PetscAbsScalar(d) - PetscRealPart(d);
499       v  = aa+ai[i];
500       nz = ai[i+1] - ai[i];
501       for (j=0; j<nz; j++)
502 	rs += PetscAbsScalar(v[j]);
503       if (rs>sctx.shift_top) sctx.shift_top = rs;
504     }
505     sctx.shift_top   *= 1.1;
506     sctx.nshift_max   = 5;
507     sctx.shift_lo     = 0.;
508     sctx.shift_hi     = 1.;
509   }
510 
511   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
512   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
513   ierr = PetscMalloc((n+1)*sizeof(MatScalar),&rtmp);CHKERRQ(ierr);
514   ics  = ic;
515 
516   do {
517     sctx.lushift = PETSC_FALSE;
518     for (i=0; i<n; i++){
519       /* zero rtmp */
520       /* L part */
521       nz    = bi[i+1] - bi[i];
522       bjtmp = bj + bi[i];
523       for  (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;
524 
525       /* U part */
526       nz = bi[2*n-i+1] - bi[2*n-i];
527       bjtmp = bj + bi[2*n-i];
528       for  (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;
529 
530       /* load in initial (unfactored row) */
531       nz    = ai[r[i]+1] - ai[r[i]];
532       ajtmp = aj + ai[r[i]];
533       v     = aa + ai[r[i]];
534       for (j=0; j<nz; j++) {
535         rtmp[ics[ajtmp[j]]] = v[j];
536       }
537       /* ZeropivotApply() */
538       rtmp[ics[r[i]]] += sctx.shift_amount;  /* shift the diagonal of the matrix */
539 
540       /* elimination */
541       bjtmp = bj + bi[i];
542       row   = *bjtmp++;
543       nzL   = bi[i+1] - bi[i];
544       k   = 0;
545       while  (k < nzL) {
546         pc = rtmp + row;
547         if (*pc != 0.0) {
548           pv         = b->a + bdiag[row];
549           multiplier = *pc * (*pv);
550           *pc        = multiplier;
551           pj         = b->j + bi[2*n-row]; /* begining of U(row,:) */
552           pv         = b->a + bi[2*n-row];
553           nz         = bi[2*n-row+1] - bi[2*n-row] - 1; /* num of entries in U(row,:), excluding diag */
554           for (j=0; j<nz; j++) rtmp[pj[j]] -= multiplier * pv[j];
555           ierr = PetscLogFlops(2.0*nz);CHKERRQ(ierr);
556         }
557         row = *bjtmp++; k++;
558       }
559 
560       /* finished row so stick it into b->a */
561       rs = 0.0;
562       /* L part */
563       pv   = b->a + bi[i] ;
564       pj   = b->j + bi[i] ;
565       nz   = bi[i+1] - bi[i];
566       for (j=0; j<nz; j++) {
567         pv[j] = rtmp[pj[j]]; rs += PetscAbsScalar(pv[j]);
568       }
569 
570       /* U part */
571       pv = b->a + bi[2*n-i];
572       pj = b->j + bi[2*n-i];
573       nz = bi[2*n-i+1] - bi[2*n-i] - 1;
574       for (j=0; j<nz; j++) {
575         pv[j] = rtmp[pj[j]]; rs += PetscAbsScalar(pv[j]);
576       }
577 
578       /* ZeropivotCheck() */
579       sctx.rs  = rs;
580       sctx.pv  = rtmp[i];
581       ierr = MatLUCheckShift_inline(info,sctx,i,newshift);CHKERRQ(ierr);
582       if (newshift == 1) break;
583 
584       /* Mark diagonal and invert diagonal for simplier triangular solves */
585       pv  = b->a + bdiag[i];
586       *pv = 1.0/rtmp[i];
587 
588     } /* endof for (i=0; i<n; i++){ */
589 
590     /* ZeropivotRefine() */
591     if (info->shiftpd && !sctx.lushift && sctx.shift_fraction>0 && sctx.nshift<sctx.nshift_max){
592       /*
593        * if no shift in this attempt & shifting & started shifting & can refine,
594        * then try lower shift
595        */
596       sctx.shift_hi       = sctx.shift_fraction;
597       sctx.shift_fraction = (sctx.shift_hi+sctx.shift_lo)/2.;
598       sctx.shift_amount   = sctx.shift_fraction * sctx.shift_top;
599       sctx.lushift        = PETSC_TRUE;
600       sctx.nshift++;
601     }
602   } while (sctx.lushift);
603 
604   ierr = PetscFree(rtmp);CHKERRQ(ierr);
605   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
606   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
607 
608   ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
609   ierr = ISIdentity(isicol,&col_identity);CHKERRQ(ierr);
610   if (row_identity && col_identity) {
611     C->ops->solve = MatSolve_SeqAIJ_NaturalOrdering_newdatastruct;
612   } else {
613     C->ops->solve = MatSolve_SeqAIJ_newdatastruct;
614   }
615 
616   C->ops->solveadd           = 0;
617   C->ops->solvetranspose     = 0;
618   C->ops->solvetransposeadd  = 0;
619   C->ops->matsolve           = 0;
620   C->assembled    = PETSC_TRUE;
621   C->preallocated = PETSC_TRUE;
622   ierr = PetscLogFlops(C->cmap->n);CHKERRQ(ierr);
623 
624   /* ZeropivotView() */
625   if (sctx.nshift){
626     if (info->shiftpd) {
627       ierr = PetscInfo4(A,"number of shift_pd tries %D, shift_amount %G, diagonal shifted up by %e fraction top_value %e\n",sctx.nshift,sctx.shift_amount,sctx.shift_fraction,sctx.shift_top);CHKERRQ(ierr);
628     } else if (info->shiftnz) {
629       ierr = PetscInfo2(A,"number of shift_nz tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);CHKERRQ(ierr);
630     }
631   }
632   PetscFunctionReturn(0);
633 }
634 
635 /* ----------------------------------------------------------- */
636 extern PetscErrorCode MatSolve_SeqAIJ_NaturalOrdering_newdatastruct_v2(Mat,Vec,Vec);
637 extern PetscErrorCode MatSolve_SeqAIJ_newdatastruct_v2(Mat,Vec,Vec);
638 
639 #undef __FUNCT__
640 #define __FUNCT__ "MatLUFactorNumeric_SeqAIJ_newdatastruct_v2"
641 PetscErrorCode MatLUFactorNumeric_SeqAIJ_newdatastruct_v2(Mat B,Mat A,const MatFactorInfo *info)
642 {
643   Mat            C=B;
644   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data,*b=(Mat_SeqAIJ *)C->data;
645   IS             isrow = b->row,isicol = b->icol;
646   PetscErrorCode ierr;
647   const PetscInt *r,*ic,*ics;
648   PetscInt       i,j,k,n=A->rmap->n,*ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j;
649   PetscInt       *ajtmp,*bjtmp,nz,nzL,row,*bdiag=b->diag,*pj;
650   MatScalar      *rtmp,*pc,multiplier,*v,*pv,*aa=a->a;
651   PetscTruth     row_identity,col_identity;
652 
653   LUShift_Ctx    sctx;
654   PetscInt       *ddiag,newshift;
655   PetscReal      rs;
656   MatScalar      d;
657 
658   PetscFunctionBegin;
659   /* ZeropivotSetUp(): initialize shift context sctx */
660   sctx.nshift         = 0;
661   sctx.nshift_max     = 0;
662   sctx.shift_top      = 0.0;
663   sctx.shift_lo       = 0.0;
664   sctx.shift_hi       = 0.0;
665   sctx.shift_fraction = 0.0;
666   sctx.shift_amount   = 0.0;
667 
668   /* if both shift schemes are chosen by user, only use info->shiftpd */
669   if (info->shiftpd) { /* set sctx.shift_top=max{rs} */
670     ddiag          = a->diag;
671     sctx.shift_top = info->zeropivot;
672     for (i=0; i<n; i++) {
673       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
674       d  = (aa)[ddiag[i]];
675       rs = -PetscAbsScalar(d) - PetscRealPart(d);
676       v  = aa+ai[i];
677       nz = ai[i+1] - ai[i];
678       for (j=0; j<nz; j++)
679 	rs += PetscAbsScalar(v[j]);
680       if (rs>sctx.shift_top) sctx.shift_top = rs;
681     }
682     sctx.shift_top   *= 1.1;
683     sctx.nshift_max   = 5;
684     sctx.shift_lo     = 0.;
685     sctx.shift_hi     = 1.;
686   }
687 
688   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
689   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
690   ierr = PetscMalloc((n+1)*sizeof(MatScalar),&rtmp);CHKERRQ(ierr);
691   ics  = ic;
692 
693   do {
694     sctx.lushift = PETSC_FALSE;
695     for (i=0; i<n; i++){
696       /* zero rtmp */
697       /* L part */
698       nz    = bi[i+1] - bi[i];
699       bjtmp = bj + bi[i];
700       for  (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;
701 
702       /* U part */
703       /*   nz = bi[2*n-i+1] - bi[2*n-i];
704 	   bjtmp = bj + bi[2*n-i];  */
705       nz = bdiag[i]-bdiag[i+1];
706       bjtmp = bj + bdiag[i+1]+1;
707       for  (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;
708 
709       /* load in initial (unfactored row) */
710       nz    = ai[r[i]+1] - ai[r[i]];
711       ajtmp = aj + ai[r[i]];
712       v     = aa + ai[r[i]];
713       for (j=0; j<nz; j++) {
714         rtmp[ics[ajtmp[j]]] = v[j];
715       }
716       /* ZeropivotApply() */
717       rtmp[ics[r[i]]] += sctx.shift_amount;  /* shift the diagonal of the matrix */
718 
719       /* elimination */
720       bjtmp = bj + bi[i];
721       row   = *bjtmp++;
722       nzL   = bi[i+1] - bi[i];
723       for(k=0; k < nzL;k++) {
724         pc = rtmp + row;
725         if (*pc != 0.0) {
726           pv         = b->a + bdiag[row];
727           multiplier = *pc * (*pv);
728           *pc        = multiplier;
729 	  /*   pj         = b->j + bi[2*n-row]; */ /* begining of U(row,:) */
730 	  /* pv         = b->a + bi[2*n-row];
731 	     nz         = bi[2*n-row+1] - bi[2*n-row] - 1; */ /* num of entries in U(row,:), excluding diag */
732           pj = b->j + bdiag[row+1]+1; /* beginning of U(row,:) */
733 	  pv = b->a + bdiag[row+1]+1;
734 	  nz = bdiag[row]-bdiag[row+1]-1; /* num of entries in U(row,:) excluding diag */
735           for (j=0; j<nz; j++) rtmp[pj[j]] -= multiplier * pv[j];
736           ierr = PetscLogFlops(2.0*nz);CHKERRQ(ierr);
737         }
738         row = *bjtmp++;
739       }
740 
741       /* finished row so stick it into b->a */
742       rs = 0.0;
743       /* L part */
744       pv   = b->a + bi[i] ;
745       pj   = b->j + bi[i] ;
746       nz   = bi[i+1] - bi[i];
747       for (j=0; j<nz; j++) {
748         pv[j] = rtmp[pj[j]]; rs += PetscAbsScalar(pv[j]);
749       }
750 
751       /* U part */
752       /*  pv = b->a + bi[2*n-i];
753       pj = b->j + bi[2*n-i];
754       nz = bi[2*n-i+1] - bi[2*n-i] - 1;
755       */
756       pv = b->a + bdiag[i+1]+1;
757       pj = b->j + bdiag[i+1]+1;
758       nz = bdiag[i] - bdiag[i+1]-1;
759       for (j=0; j<nz; j++) {
760         pv[j] = rtmp[pj[j]]; rs += PetscAbsScalar(pv[j]);
761       }
762 
763       /* ZeropivotCheck() */
764       sctx.rs  = rs;
765       sctx.pv  = rtmp[i];
766       ierr = MatLUCheckShift_inline(info,sctx,i,newshift);CHKERRQ(ierr);
767       if (newshift == 1) break;
768 
769       /* Mark diagonal and invert diagonal for simplier triangular solves */
770       pv  = b->a + bdiag[i];
771       *pv = 1.0/rtmp[i];
772 
773     } /* endof for (i=0; i<n; i++){ */
774 
775     /* ZeropivotRefine() */
776     if (info->shiftpd && !sctx.lushift && sctx.shift_fraction>0 && sctx.nshift<sctx.nshift_max){
777       /*
778        * if no shift in this attempt & shifting & started shifting & can refine,
779        * then try lower shift
780        */
781       sctx.shift_hi       = sctx.shift_fraction;
782       sctx.shift_fraction = (sctx.shift_hi+sctx.shift_lo)/2.;
783       sctx.shift_amount   = sctx.shift_fraction * sctx.shift_top;
784       sctx.lushift        = PETSC_TRUE;
785       sctx.nshift++;
786     }
787   } while (sctx.lushift);
788 
789   ierr = PetscFree(rtmp);CHKERRQ(ierr);
790   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
791   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
792 
793   ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
794   ierr = ISIdentity(isicol,&col_identity);CHKERRQ(ierr);
795   if (row_identity && col_identity) {
796     C->ops->solve = MatSolve_SeqAIJ_NaturalOrdering_newdatastruct_v2;
797   } else {
798     C->ops->solve = MatSolve_SeqAIJ_newdatastruct_v2;
799   }
800 
801   C->ops->solveadd           = 0;
802   C->ops->solvetranspose     = 0;
803   C->ops->solvetransposeadd  = 0;
804   C->ops->matsolve           = 0;
805   C->assembled    = PETSC_TRUE;
806   C->preallocated = PETSC_TRUE;
807   ierr = PetscLogFlops(C->cmap->n);CHKERRQ(ierr);
808 
809   /* ZeropivotView() */
810   if (sctx.nshift){
811     if (info->shiftpd) {
812       ierr = PetscInfo4(A,"number of shift_pd tries %D, shift_amount %G, diagonal shifted up by %e fraction top_value %e\n",sctx.nshift,sctx.shift_amount,sctx.shift_fraction,sctx.shift_top);CHKERRQ(ierr);
813     } else if (info->shiftnz) {
814       ierr = PetscInfo2(A,"number of shift_nz tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);CHKERRQ(ierr);
815     }
816   }
817   PetscFunctionReturn(0);
818 }
819 
820 #undef __FUNCT__
821 #define __FUNCT__ "MatLUFactorNumeric_SeqAIJ"
822 PetscErrorCode MatLUFactorNumeric_SeqAIJ(Mat B,Mat A,const MatFactorInfo *info)
823 {
824   Mat             C=B;
825   Mat_SeqAIJ      *a=(Mat_SeqAIJ*)A->data,*b=(Mat_SeqAIJ *)C->data;
826   IS              isrow = b->row,isicol = b->icol;
827   PetscErrorCode  ierr;
828   const PetscInt   *r,*ic,*ics;
829   PetscInt        nz,row,i,j,n=A->rmap->n,diag;
830   const PetscInt  *ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j;
831   const PetscInt  *ajtmp,*bjtmp,*diag_offset = b->diag,*pj;
832   MatScalar       *pv,*rtmp,*pc,multiplier,d;
833   const MatScalar *v,*aa=a->a;
834   PetscReal       rs=0.0;
835   LUShift_Ctx     sctx;
836   PetscInt        newshift,*ddiag;
837 
838   PetscFunctionBegin;
839   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
840   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
841   ierr = PetscMalloc((n+1)*sizeof(MatScalar),&rtmp);CHKERRQ(ierr);
842   ics  = ic;
843 
844   /* initialize shift context sctx */
845   sctx.nshift         = 0;
846   sctx.nshift_max     = 0;
847   sctx.shift_top      = 0.0;
848   sctx.shift_lo       = 0.0;
849   sctx.shift_hi       = 0.0;
850   sctx.shift_fraction = 0.0;
851   sctx.shift_amount   = 0.0;
852 
853   /* if both shift schemes are chosen by user, only use info->shiftpd */
854   if (info->shiftpd) { /* set sctx.shift_top=max{rs} */
855     ddiag          = a->diag;
856     sctx.shift_top = info->zeropivot;
857     for (i=0; i<n; i++) {
858       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
859       d  = (aa)[ddiag[i]];
860       rs = -PetscAbsScalar(d) - PetscRealPart(d);
861       v  = aa+ai[i];
862       nz = ai[i+1] - ai[i];
863       for (j=0; j<nz; j++)
864 	rs += PetscAbsScalar(v[j]);
865       if (rs>sctx.shift_top) sctx.shift_top = rs;
866     }
867     sctx.shift_top   *= 1.1;
868     sctx.nshift_max   = 5;
869     sctx.shift_lo     = 0.;
870     sctx.shift_hi     = 1.;
871   }
872 
873   do {
874     sctx.lushift = PETSC_FALSE;
875     for (i=0; i<n; i++){
876       nz    = bi[i+1] - bi[i];
877       bjtmp = bj + bi[i];
878       for  (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;
879 
880       /* load in initial (unfactored row) */
881       nz    = ai[r[i]+1] - ai[r[i]];
882       ajtmp = aj + ai[r[i]];
883       v     = aa + ai[r[i]];
884       for (j=0; j<nz; j++) {
885         rtmp[ics[ajtmp[j]]] = v[j];
886       }
887       rtmp[ics[r[i]]] += sctx.shift_amount; /* shift the diagonal of the matrix */
888       /* if (sctx.shift_amount > 0.0) printf("row %d, shift %g\n",i,sctx.shift_amount); */
889 
890       row = *bjtmp++;
891       while  (row < i) {
892         pc = rtmp + row;
893         if (*pc != 0.0) {
894           pv         = b->a + diag_offset[row];
895           pj         = b->j + diag_offset[row] + 1;
896           multiplier = *pc / *pv++;
897           *pc        = multiplier;
898           nz         = bi[row+1] - diag_offset[row] - 1;
899           for (j=0; j<nz; j++) rtmp[pj[j]] -= multiplier * pv[j];
900           ierr = PetscLogFlops(2.0*nz);CHKERRQ(ierr);
901         }
902         row = *bjtmp++;
903       }
904       /* finished row so stick it into b->a */
905       pv   = b->a + bi[i] ;
906       pj   = b->j + bi[i] ;
907       nz   = bi[i+1] - bi[i];
908       diag = diag_offset[i] - bi[i];
909       rs   = 0.0;
910       for (j=0; j<nz; j++) {
911         pv[j] = rtmp[pj[j]];
912         rs   += PetscAbsScalar(pv[j]);
913       }
914       rs   -= PetscAbsScalar(pv[diag]);
915 
916       /* 9/13/02 Victor Eijkhout suggested scaling zeropivot by rs for matrices with funny scalings */
917       sctx.rs  = rs;
918       sctx.pv  = pv[diag];
919       ierr = MatLUCheckShift_inline(info,sctx,i,newshift);CHKERRQ(ierr);
920       if (newshift == 1) break;
921     }
922 
923     if (info->shiftpd && !sctx.lushift && sctx.shift_fraction>0 && sctx.nshift<sctx.nshift_max) {
924       /*
925        * if no shift in this attempt & shifting & started shifting & can refine,
926        * then try lower shift
927        */
928       sctx.shift_hi       = sctx.shift_fraction;
929       sctx.shift_fraction = (sctx.shift_hi+sctx.shift_lo)/2.;
930       sctx.shift_amount   = sctx.shift_fraction * sctx.shift_top;
931       sctx.lushift        = PETSC_TRUE;
932       sctx.nshift++;
933     }
934   } while (sctx.lushift);
935 
936   /* invert diagonal entries for simplier triangular solves */
937   for (i=0; i<n; i++) {
938     b->a[diag_offset[i]] = 1.0/b->a[diag_offset[i]];
939   }
940   ierr = PetscFree(rtmp);CHKERRQ(ierr);
941   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
942   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
943   if (b->inode.use) {
944     C->ops->solve   = MatSolve_Inode;
945   } else {
946     PetscTruth row_identity, col_identity;
947     ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
948     ierr = ISIdentity(isicol,&col_identity);CHKERRQ(ierr);
949     if (row_identity && col_identity) {
950       C->ops->solve   = MatSolve_SeqAIJ_NaturalOrdering;
951     } else {
952       C->ops->solve   = MatSolve_SeqAIJ;
953     }
954   }
955   C->ops->solveadd           = MatSolveAdd_SeqAIJ;
956   C->ops->solvetranspose     = MatSolveTranspose_SeqAIJ;
957   C->ops->solvetransposeadd  = MatSolveTransposeAdd_SeqAIJ;
958   C->ops->matsolve           = MatMatSolve_SeqAIJ;
959   C->assembled    = PETSC_TRUE;
960   C->preallocated = PETSC_TRUE;
961   ierr = PetscLogFlops(C->cmap->n);CHKERRQ(ierr);
962   if (sctx.nshift){
963      if (info->shiftpd) {
964       ierr = PetscInfo4(A,"number of shift_pd tries %D, shift_amount %G, diagonal shifted up by %e fraction top_value %e\n",sctx.nshift,sctx.shift_amount,sctx.shift_fraction,sctx.shift_top);CHKERRQ(ierr);
965     } else if (info->shiftnz) {
966       ierr = PetscInfo2(A,"number of shift_nz tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);CHKERRQ(ierr);
967     }
968   }
969   PetscFunctionReturn(0);
970 }
971 
972 /*
973    This routine implements inplace ILU(0) with row or/and column permutations.
974    Input:
975      A - original matrix
976    Output;
977      A - a->i (rowptr) is same as original rowptr, but factored i-the row is stored in rowperm[i]
978          a->j (col index) is permuted by the inverse of colperm, then sorted
979          a->a reordered accordingly with a->j
980          a->diag (ptr to diagonal elements) is updated.
981 */
982 #undef __FUNCT__
983 #define __FUNCT__ "MatLUFactorNumeric_SeqAIJ_InplaceWithPerm"
984 PetscErrorCode MatLUFactorNumeric_SeqAIJ_InplaceWithPerm(Mat B,Mat A,const MatFactorInfo *info)
985 {
986   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data;
987   IS             isrow = a->row,isicol = a->icol;
988   PetscErrorCode ierr;
989   const PetscInt *r,*ic,*ics;
990   PetscInt       i,j,n=A->rmap->n,*ai=a->i,*aj=a->j;
991   PetscInt       *ajtmp,nz,row;
992   PetscInt       *diag = a->diag,nbdiag,*pj;
993   PetscScalar    *rtmp,*pc,multiplier,d;
994   MatScalar      *v,*pv;
995   PetscReal      rs;
996   LUShift_Ctx    sctx;
997   PetscInt       newshift;
998 
999   PetscFunctionBegin;
1000   if (A != B) SETERRQ(PETSC_ERR_ARG_INCOMP,"input and output matrix must have same address");
1001   ierr  = ISGetIndices(isrow,&r);CHKERRQ(ierr);
1002   ierr  = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
1003   ierr  = PetscMalloc((n+1)*sizeof(PetscScalar),&rtmp);CHKERRQ(ierr);
1004   ierr  = PetscMemzero(rtmp,(n+1)*sizeof(PetscScalar));CHKERRQ(ierr);
1005   ics = ic;
1006 
1007   sctx.shift_top      = 0;
1008   sctx.nshift_max     = 0;
1009   sctx.shift_lo       = 0;
1010   sctx.shift_hi       = 0;
1011   sctx.shift_fraction = 0;
1012 
1013   /* if both shift schemes are chosen by user, only use info->shiftpd */
1014   if (info->shiftpd) { /* set sctx.shift_top=max{rs} */
1015     sctx.shift_top = 0;
1016     for (i=0; i<n; i++) {
1017       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
1018       d  = (a->a)[diag[i]];
1019       rs = -PetscAbsScalar(d) - PetscRealPart(d);
1020       v  = a->a+ai[i];
1021       nz = ai[i+1] - ai[i];
1022       for (j=0; j<nz; j++)
1023 	rs += PetscAbsScalar(v[j]);
1024       if (rs>sctx.shift_top) sctx.shift_top = rs;
1025     }
1026     if (sctx.shift_top < info->zeropivot) sctx.shift_top = info->zeropivot;
1027     sctx.shift_top    *= 1.1;
1028     sctx.nshift_max   = 5;
1029     sctx.shift_lo     = 0.;
1030     sctx.shift_hi     = 1.;
1031   }
1032 
1033   sctx.shift_amount = 0;
1034   sctx.nshift       = 0;
1035   do {
1036     sctx.lushift = PETSC_FALSE;
1037     for (i=0; i<n; i++){
1038       /* load in initial unfactored row */
1039       nz    = ai[r[i]+1] - ai[r[i]];
1040       ajtmp = aj + ai[r[i]];
1041       v     = a->a + ai[r[i]];
1042       /* sort permuted ajtmp and values v accordingly */
1043       for (j=0; j<nz; j++) ajtmp[j] = ics[ajtmp[j]];
1044       ierr = PetscSortIntWithScalarArray(nz,ajtmp,v);CHKERRQ(ierr);
1045 
1046       diag[r[i]] = ai[r[i]];
1047       for (j=0; j<nz; j++) {
1048         rtmp[ajtmp[j]] = v[j];
1049         if (ajtmp[j] < i) diag[r[i]]++; /* update a->diag */
1050       }
1051       rtmp[r[i]] += sctx.shift_amount; /* shift the diagonal of the matrix */
1052 
1053       row = *ajtmp++;
1054       while  (row < i) {
1055         pc = rtmp + row;
1056         if (*pc != 0.0) {
1057           pv         = a->a + diag[r[row]];
1058           pj         = aj + diag[r[row]] + 1;
1059 
1060           multiplier = *pc / *pv++;
1061           *pc        = multiplier;
1062           nz         = ai[r[row]+1] - diag[r[row]] - 1;
1063           for (j=0; j<nz; j++) rtmp[pj[j]] -= multiplier * pv[j];
1064           ierr = PetscLogFlops(2.0*nz);CHKERRQ(ierr);
1065         }
1066         row = *ajtmp++;
1067       }
1068       /* finished row so overwrite it onto a->a */
1069       pv   = a->a + ai[r[i]] ;
1070       pj   = aj + ai[r[i]] ;
1071       nz   = ai[r[i]+1] - ai[r[i]];
1072       nbdiag = diag[r[i]] - ai[r[i]]; /* num of entries before the diagonal */
1073 
1074       rs   = 0.0;
1075       for (j=0; j<nz; j++) {
1076         pv[j] = rtmp[pj[j]];
1077         if (j != nbdiag) rs += PetscAbsScalar(pv[j]);
1078       }
1079 
1080       /* 9/13/02 Victor Eijkhout suggested scaling zeropivot by rs for matrices with funny scalings */
1081       sctx.rs  = rs;
1082       sctx.pv  = pv[nbdiag];
1083       ierr = MatLUCheckShift_inline(info,sctx,i,newshift);CHKERRQ(ierr);
1084       if (newshift == 1) break;
1085     }
1086 
1087     if (info->shiftpd && !sctx.lushift && sctx.shift_fraction>0 && sctx.nshift<sctx.nshift_max) {
1088       /*
1089        * if no shift in this attempt & shifting & started shifting & can refine,
1090        * then try lower shift
1091        */
1092       sctx.shift_hi        = sctx.shift_fraction;
1093       sctx.shift_fraction = (sctx.shift_hi+sctx.shift_lo)/2.;
1094       sctx.shift_amount    = sctx.shift_fraction * sctx.shift_top;
1095       sctx.lushift         = PETSC_TRUE;
1096       sctx.nshift++;
1097     }
1098   } while (sctx.lushift);
1099 
1100   /* invert diagonal entries for simplier triangular solves */
1101   for (i=0; i<n; i++) {
1102     a->a[diag[r[i]]] = 1.0/a->a[diag[r[i]]];
1103   }
1104 
1105   ierr = PetscFree(rtmp);CHKERRQ(ierr);
1106   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
1107   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
1108   A->ops->solve             = MatSolve_SeqAIJ_InplaceWithPerm;
1109   A->ops->solveadd          = MatSolveAdd_SeqAIJ;
1110   A->ops->solvetranspose    = MatSolveTranspose_SeqAIJ;
1111   A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqAIJ;
1112   A->assembled = PETSC_TRUE;
1113   A->preallocated = PETSC_TRUE;
1114   ierr = PetscLogFlops(A->cmap->n);CHKERRQ(ierr);
1115   if (sctx.nshift){
1116     if (info->shiftpd) {
1117       ierr = PetscInfo4(A,"number of shift_pd tries %D, shift_amount %G, diagonal shifted up by %e fraction top_value %e\n",sctx.nshift,sctx.shift_amount,sctx.shift_fraction,sctx.shift_top);CHKERRQ(ierr);
1118     } else if (info->shiftnz) {
1119       ierr = PetscInfo2(A,"number of shift_nz tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);CHKERRQ(ierr);
1120     }
1121   }
1122   PetscFunctionReturn(0);
1123 }
1124 
1125 /* ----------------------------------------------------------- */
1126 #undef __FUNCT__
1127 #define __FUNCT__ "MatLUFactor_SeqAIJ"
1128 PetscErrorCode MatLUFactor_SeqAIJ(Mat A,IS row,IS col,const MatFactorInfo *info)
1129 {
1130   PetscErrorCode ierr;
1131   Mat            C;
1132 
1133   PetscFunctionBegin;
1134   ierr = MatGetFactor(A,MAT_SOLVER_PETSC,MAT_FACTOR_LU,&C);CHKERRQ(ierr);
1135   ierr = MatLUFactorSymbolic(C,A,row,col,info);CHKERRQ(ierr);
1136   ierr = MatLUFactorNumeric(C,A,info);CHKERRQ(ierr);
1137   A->ops->solve            = C->ops->solve;
1138   A->ops->solvetranspose   = C->ops->solvetranspose;
1139   ierr = MatHeaderCopy(A,C);CHKERRQ(ierr);
1140   ierr = PetscLogObjectParent(A,((Mat_SeqAIJ*)(A->data))->icol);CHKERRQ(ierr);
1141   PetscFunctionReturn(0);
1142 }
1143 /* ----------------------------------------------------------- */
1144 
1145 
1146 #undef __FUNCT__
1147 #define __FUNCT__ "MatSolve_SeqAIJ"
1148 PetscErrorCode MatSolve_SeqAIJ(Mat A,Vec bb,Vec xx)
1149 {
1150   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1151   IS                iscol = a->col,isrow = a->row;
1152   PetscErrorCode    ierr;
1153   PetscInt          i, n = A->rmap->n,*vi,*ai = a->i,*aj = a->j;
1154   PetscInt          nz;
1155   const PetscInt    *rout,*cout,*r,*c;
1156   PetscScalar       *x,*tmp,*tmps,sum;
1157   const PetscScalar *b;
1158   const MatScalar   *aa = a->a,*v;
1159 
1160   PetscFunctionBegin;
1161   if (!n) PetscFunctionReturn(0);
1162 
1163   ierr = VecGetArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
1164   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
1165   tmp  = a->solve_work;
1166 
1167   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
1168   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout + (n-1);
1169 
1170   /* forward solve the lower triangular */
1171   tmp[0] = b[*r++];
1172   tmps   = tmp;
1173   for (i=1; i<n; i++) {
1174     v   = aa + ai[i] ;
1175     vi  = aj + ai[i] ;
1176     nz  = a->diag[i] - ai[i];
1177     sum = b[*r++];
1178     PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1179     tmp[i] = sum;
1180   }
1181 
1182   /* backward solve the upper triangular */
1183   for (i=n-1; i>=0; i--){
1184     v   = aa + a->diag[i] + 1;
1185     vi  = aj + a->diag[i] + 1;
1186     nz  = ai[i+1] - a->diag[i] - 1;
1187     sum = tmp[i];
1188     PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1189     x[*c--] = tmp[i] = sum*aa[a->diag[i]];
1190   }
1191 
1192   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
1193   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
1194   ierr = VecRestoreArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
1195   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
1196   ierr = PetscLogFlops(2.0*a->nz - A->cmap->n);CHKERRQ(ierr);
1197   PetscFunctionReturn(0);
1198 }
1199 
1200 #undef __FUNCT__
1201 #define __FUNCT__ "MatMatSolve_SeqAIJ"
1202 PetscErrorCode MatMatSolve_SeqAIJ(Mat A,Mat B,Mat X)
1203 {
1204   Mat_SeqAIJ      *a = (Mat_SeqAIJ*)A->data;
1205   IS              iscol = a->col,isrow = a->row;
1206   PetscErrorCode  ierr;
1207   PetscInt        i, n = A->rmap->n,*vi,*ai = a->i,*aj = a->j;
1208   PetscInt        nz,neq;
1209   const PetscInt  *rout,*cout,*r,*c;
1210   PetscScalar     *x,*b,*tmp,*tmps,sum;
1211   const MatScalar *aa = a->a,*v;
1212   PetscTruth      bisdense,xisdense;
1213 
1214   PetscFunctionBegin;
1215   if (!n) PetscFunctionReturn(0);
1216 
1217   ierr = PetscTypeCompare((PetscObject)B,MATSEQDENSE,&bisdense);CHKERRQ(ierr);
1218   if (!bisdense) SETERRQ(PETSC_ERR_ARG_INCOMP,"B matrix must be a SeqDense matrix");
1219   ierr = PetscTypeCompare((PetscObject)X,MATSEQDENSE,&xisdense);CHKERRQ(ierr);
1220   if (!xisdense) SETERRQ(PETSC_ERR_ARG_INCOMP,"X matrix must be a SeqDense matrix");
1221 
1222   ierr = MatGetArray(B,&b);CHKERRQ(ierr);
1223   ierr = MatGetArray(X,&x);CHKERRQ(ierr);
1224 
1225   tmp  = a->solve_work;
1226   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
1227   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout;
1228 
1229   for (neq=0; neq<B->cmap->n; neq++){
1230     /* forward solve the lower triangular */
1231     tmp[0] = b[r[0]];
1232     tmps   = tmp;
1233     for (i=1; i<n; i++) {
1234       v   = aa + ai[i] ;
1235       vi  = aj + ai[i] ;
1236       nz  = a->diag[i] - ai[i];
1237       sum = b[r[i]];
1238       PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1239       tmp[i] = sum;
1240     }
1241     /* backward solve the upper triangular */
1242     for (i=n-1; i>=0; i--){
1243       v   = aa + a->diag[i] + 1;
1244       vi  = aj + a->diag[i] + 1;
1245       nz  = ai[i+1] - a->diag[i] - 1;
1246       sum = tmp[i];
1247       PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1248       x[c[i]] = tmp[i] = sum*aa[a->diag[i]];
1249     }
1250 
1251     b += n;
1252     x += n;
1253   }
1254   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
1255   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
1256   ierr = MatRestoreArray(B,&b);CHKERRQ(ierr);
1257   ierr = MatRestoreArray(X,&x);CHKERRQ(ierr);
1258   ierr = PetscLogFlops(B->cmap->n*(2.0*a->nz - n));CHKERRQ(ierr);
1259   PetscFunctionReturn(0);
1260 }
1261 
1262 #undef __FUNCT__
1263 #define __FUNCT__ "MatSolve_SeqAIJ_InplaceWithPerm"
1264 PetscErrorCode MatSolve_SeqAIJ_InplaceWithPerm(Mat A,Vec bb,Vec xx)
1265 {
1266   Mat_SeqAIJ      *a = (Mat_SeqAIJ*)A->data;
1267   IS              iscol = a->col,isrow = a->row;
1268   PetscErrorCode  ierr;
1269   const PetscInt  *r,*c,*rout,*cout;
1270   PetscInt        i, n = A->rmap->n,*vi,*ai = a->i,*aj = a->j;
1271   PetscInt        nz,row;
1272   PetscScalar     *x,*b,*tmp,*tmps,sum;
1273   const MatScalar *aa = a->a,*v;
1274 
1275   PetscFunctionBegin;
1276   if (!n) PetscFunctionReturn(0);
1277 
1278   ierr = VecGetArray(bb,&b);CHKERRQ(ierr);
1279   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
1280   tmp  = a->solve_work;
1281 
1282   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
1283   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout + (n-1);
1284 
1285   /* forward solve the lower triangular */
1286   tmp[0] = b[*r++];
1287   tmps   = tmp;
1288   for (row=1; row<n; row++) {
1289     i   = rout[row]; /* permuted row */
1290     v   = aa + ai[i] ;
1291     vi  = aj + ai[i] ;
1292     nz  = a->diag[i] - ai[i];
1293     sum = b[*r++];
1294     PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1295     tmp[row] = sum;
1296   }
1297 
1298   /* backward solve the upper triangular */
1299   for (row=n-1; row>=0; row--){
1300     i   = rout[row]; /* permuted row */
1301     v   = aa + a->diag[i] + 1;
1302     vi  = aj + a->diag[i] + 1;
1303     nz  = ai[i+1] - a->diag[i] - 1;
1304     sum = tmp[row];
1305     PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1306     x[*c--] = tmp[row] = sum*aa[a->diag[i]];
1307   }
1308 
1309   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
1310   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
1311   ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr);
1312   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
1313   ierr = PetscLogFlops(2.0*a->nz - A->cmap->n);CHKERRQ(ierr);
1314   PetscFunctionReturn(0);
1315 }
1316 
1317 /* ----------------------------------------------------------- */
1318 #include "../src/mat/impls/aij/seq/ftn-kernels/fsolve.h"
1319 #undef __FUNCT__
1320 #define __FUNCT__ "MatSolve_SeqAIJ_NaturalOrdering"
1321 PetscErrorCode MatSolve_SeqAIJ_NaturalOrdering(Mat A,Vec bb,Vec xx)
1322 {
1323   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1324   PetscErrorCode    ierr;
1325   PetscInt          n = A->rmap->n;
1326   const PetscInt    *ai = a->i,*aj = a->j,*adiag = a->diag;
1327   PetscScalar       *x;
1328   const PetscScalar *b;
1329   const MatScalar   *aa = a->a;
1330 #if !defined(PETSC_USE_FORTRAN_KERNEL_SOLVEAIJ)
1331   PetscInt          adiag_i,i,nz,ai_i;
1332   const PetscInt    *vi;
1333   const MatScalar   *v;
1334   PetscScalar       sum;
1335 #endif
1336 
1337   PetscFunctionBegin;
1338   if (!n) PetscFunctionReturn(0);
1339 
1340   ierr = VecGetArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
1341   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
1342 
1343 #if defined(PETSC_USE_FORTRAN_KERNEL_SOLVEAIJ)
1344   fortransolveaij_(&n,x,ai,aj,adiag,aa,b);
1345 #else
1346   /* forward solve the lower triangular */
1347   x[0] = b[0];
1348   for (i=1; i<n; i++) {
1349     ai_i = ai[i];
1350     v    = aa + ai_i;
1351     vi   = aj + ai_i;
1352     nz   = adiag[i] - ai_i;
1353     sum  = b[i];
1354     PetscSparseDenseMinusDot(sum,x,v,vi,nz);
1355     x[i] = sum;
1356   }
1357 
1358   /* backward solve the upper triangular */
1359   for (i=n-1; i>=0; i--){
1360     adiag_i = adiag[i];
1361     v       = aa + adiag_i + 1;
1362     vi      = aj + adiag_i + 1;
1363     nz      = ai[i+1] - adiag_i - 1;
1364     sum     = x[i];
1365     PetscSparseDenseMinusDot(sum,x,v,vi,nz);
1366     x[i]    = sum*aa[adiag_i];
1367   }
1368 #endif
1369   ierr = PetscLogFlops(2.0*a->nz - A->cmap->n);CHKERRQ(ierr);
1370   ierr = VecRestoreArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
1371   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
1372   PetscFunctionReturn(0);
1373 }
1374 
1375 #undef __FUNCT__
1376 #define __FUNCT__ "MatSolveAdd_SeqAIJ"
1377 PetscErrorCode MatSolveAdd_SeqAIJ(Mat A,Vec bb,Vec yy,Vec xx)
1378 {
1379   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1380   IS                iscol = a->col,isrow = a->row;
1381   PetscErrorCode    ierr;
1382   PetscInt          i, n = A->rmap->n,j;
1383   PetscInt          nz;
1384   const PetscInt    *rout,*cout,*r,*c,*vi,*ai = a->i,*aj = a->j;
1385   PetscScalar       *x,*tmp,sum;
1386   const PetscScalar *b;
1387   const MatScalar   *aa = a->a,*v;
1388 
1389   PetscFunctionBegin;
1390   if (yy != xx) {ierr = VecCopy(yy,xx);CHKERRQ(ierr);}
1391 
1392   ierr = VecGetArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
1393   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
1394   tmp  = a->solve_work;
1395 
1396   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
1397   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout + (n-1);
1398 
1399   /* forward solve the lower triangular */
1400   tmp[0] = b[*r++];
1401   for (i=1; i<n; i++) {
1402     v   = aa + ai[i] ;
1403     vi  = aj + ai[i] ;
1404     nz  = a->diag[i] - ai[i];
1405     sum = b[*r++];
1406     for (j=0; j<nz; j++) sum -= v[j]*tmp[vi[j]];
1407     tmp[i] = sum;
1408   }
1409 
1410   /* backward solve the upper triangular */
1411   for (i=n-1; i>=0; i--){
1412     v   = aa + a->diag[i] + 1;
1413     vi  = aj + a->diag[i] + 1;
1414     nz  = ai[i+1] - a->diag[i] - 1;
1415     sum = tmp[i];
1416     for (j=0; j<nz; j++) sum -= v[j]*tmp[vi[j]];
1417     tmp[i] = sum*aa[a->diag[i]];
1418     x[*c--] += tmp[i];
1419   }
1420 
1421   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
1422   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
1423   ierr = VecRestoreArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
1424   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
1425   ierr = PetscLogFlops(2.0*a->nz);CHKERRQ(ierr);
1426 
1427   PetscFunctionReturn(0);
1428 }
1429 
1430 #undef __FUNCT__
1431 #define __FUNCT__ "MatSolveTranspose_SeqAIJ"
1432 PetscErrorCode MatSolveTranspose_SeqAIJ(Mat A,Vec bb,Vec xx)
1433 {
1434   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1435   IS                iscol = a->col,isrow = a->row;
1436   PetscErrorCode    ierr;
1437   const PetscInt    *rout,*cout,*r,*c,*diag = a->diag,*ai = a->i,*aj = a->j,*vi;
1438   PetscInt          i,n = A->rmap->n,j;
1439   PetscInt          nz;
1440   PetscScalar       *x,*tmp,s1;
1441   const MatScalar   *aa = a->a,*v;
1442   const PetscScalar *b;
1443 
1444   PetscFunctionBegin;
1445   ierr = VecGetArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
1446   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
1447   tmp  = a->solve_work;
1448 
1449   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
1450   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout;
1451 
1452   /* copy the b into temp work space according to permutation */
1453   for (i=0; i<n; i++) tmp[i] = b[c[i]];
1454 
1455   /* forward solve the U^T */
1456   for (i=0; i<n; i++) {
1457     v   = aa + diag[i] ;
1458     vi  = aj + diag[i] + 1;
1459     nz  = ai[i+1] - diag[i] - 1;
1460     s1  = tmp[i];
1461     s1 *= (*v++);  /* multiply by inverse of diagonal entry */
1462     for (j=0; j<nz; j++) tmp[vi[j]] -= s1*v[j];
1463     tmp[i] = s1;
1464   }
1465 
1466   /* backward solve the L^T */
1467   for (i=n-1; i>=0; i--){
1468     v   = aa + diag[i] - 1 ;
1469     vi  = aj + diag[i] - 1 ;
1470     nz  = diag[i] - ai[i];
1471     s1  = tmp[i];
1472     for (j=0; j>-nz; j--) tmp[vi[j]] -= s1*v[j];
1473   }
1474 
1475   /* copy tmp into x according to permutation */
1476   for (i=0; i<n; i++) x[r[i]] = tmp[i];
1477 
1478   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
1479   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
1480   ierr = VecRestoreArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
1481   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
1482 
1483   ierr = PetscLogFlops(2.0*a->nz-A->cmap->n);CHKERRQ(ierr);
1484   PetscFunctionReturn(0);
1485 }
1486 
1487 #undef __FUNCT__
1488 #define __FUNCT__ "MatSolveTransposeAdd_SeqAIJ"
1489 PetscErrorCode MatSolveTransposeAdd_SeqAIJ(Mat A,Vec bb,Vec zz,Vec xx)
1490 {
1491   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1492   IS                iscol = a->col,isrow = a->row;
1493   PetscErrorCode    ierr;
1494   const PetscInt    *rout,*cout,*r,*c,*diag = a->diag,*ai = a->i,*aj = a->j,*vi;
1495   PetscInt          i,n = A->rmap->n,j;
1496   PetscInt          nz;
1497   PetscScalar       *x,*tmp,s1;
1498   const MatScalar   *aa = a->a,*v;
1499   const PetscScalar *b;
1500 
1501   PetscFunctionBegin;
1502   if (zz != xx) {ierr = VecCopy(zz,xx);CHKERRQ(ierr);}
1503   ierr = VecGetArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
1504   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
1505   tmp  = a->solve_work;
1506 
1507   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
1508   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout;
1509 
1510   /* copy the b into temp work space according to permutation */
1511   for (i=0; i<n; i++) tmp[i] = b[c[i]];
1512 
1513   /* forward solve the U^T */
1514   for (i=0; i<n; i++) {
1515     v   = aa + diag[i] ;
1516     vi  = aj + diag[i] + 1;
1517     nz  = ai[i+1] - diag[i] - 1;
1518     s1  = tmp[i];
1519     s1 *= (*v++);  /* multiply by inverse of diagonal entry */
1520     for (j=0; j<nz; j++) tmp[vi[j]] -= s1*v[j];
1521     tmp[i] = s1;
1522   }
1523 
1524   /* backward solve the L^T */
1525   for (i=n-1; i>=0; i--){
1526     v   = aa + diag[i] - 1 ;
1527     vi  = aj + diag[i] - 1 ;
1528     nz  = diag[i] - ai[i];
1529     s1  = tmp[i];
1530     for (j=0; j>-nz; j--) tmp[vi[j]] -= s1*v[j];
1531   }
1532 
1533   /* copy tmp into x according to permutation */
1534   for (i=0; i<n; i++) x[r[i]] += tmp[i];
1535 
1536   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
1537   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
1538   ierr = VecRestoreArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
1539   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
1540 
1541   ierr = PetscLogFlops(2.0*a->nz-A->cmap->n);CHKERRQ(ierr);
1542   PetscFunctionReturn(0);
1543 }
1544 
1545 /* ----------------------------------------------------------------*/
1546 EXTERN PetscErrorCode Mat_CheckInode(Mat,PetscTruth);
1547 EXTERN PetscErrorCode MatDuplicateNoCreate_SeqAIJ(Mat,Mat,MatDuplicateOption,PetscTruth);
1548 
1549 /*
1550    ilu(0) with natural ordering under new data structure.
1551    Factored arrays bj and ba are stored as
1552      L(0,:), L(1,:), ...,L(n-1,:),  U(n-1,:),...,U(i,:),U(i-1,:),...,U(0,:)
1553 
1554    bi=fact->i is an array of size 2n+2, in which
1555    bi+
1556      bi[i]      ->  1st entry of L(i,:),i=0,...,i-1
1557      bi[n]      ->  points to L(n-1,:)+1
1558      bi[n+1]    ->  1st entry of U(n-1,:)
1559      bi[2n-i]   ->  1st entry of U(i,:)
1560      bi[2n-i+1] ->  end of U(i,:)+1, the 1st entry of U(i-1,:)
1561      bi[2n]     ->  1st entry of U(0,:)
1562      bi[2n+1]   ->  points to U(0,:)+1
1563 
1564    U(i,:) contains diag[i] as its last entry, i.e.,
1565     U(i,:) = (u[i,i+1],...,u[i,n-1],diag[i])
1566 */
1567 #undef __FUNCT__
1568 #define __FUNCT__ "MatILUFactorSymbolic_SeqAIJ_ilu0_newdatastruct"
1569 PetscErrorCode MatILUFactorSymbolic_SeqAIJ_ilu0_newdatastruct(Mat fact,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
1570 {
1571 
1572   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
1573   PetscErrorCode     ierr;
1574   PetscInt           n=A->rmap->n,*ai=a->i,*aj,*adiag=a->diag;
1575   PetscInt           i,j,nz,*bi,*bj,*bdiag;
1576 
1577   PetscFunctionBegin;
1578   ierr = MatDuplicateNoCreate_SeqAIJ(fact,A,MAT_DO_NOT_COPY_VALUES,PETSC_FALSE);CHKERRQ(ierr);
1579   b    = (Mat_SeqAIJ*)(fact)->data;
1580 
1581   /* allocate matrix arrays for new data structure */
1582   ierr = PetscMalloc3(ai[n]+1,PetscScalar,&b->a,ai[n]+1,PetscInt,&b->j,2*n+2,PetscInt,&b->i);CHKERRQ(ierr);
1583   ierr = PetscLogObjectMemory(fact,ai[n]*(sizeof(PetscScalar)+sizeof(PetscInt))+(2*n+2)*sizeof(PetscInt));CHKERRQ(ierr);
1584   b->singlemalloc = PETSC_TRUE;
1585   if (!b->diag){
1586     ierr = PetscMalloc((n+1)*sizeof(PetscInt),&b->diag);CHKERRQ(ierr);
1587   }
1588   bdiag = b->diag;
1589 
1590   if (n > 0) {
1591     ierr = PetscMemzero(b->a,(ai[n])*sizeof(MatScalar));CHKERRQ(ierr);
1592   }
1593 
1594   /* set bi and bj with new data structure */
1595   bi = b->i;
1596   bj = b->j;
1597 
1598   /* L part */
1599   bi[0] = 0;
1600   for (i=0; i<n; i++){
1601     nz = adiag[i] - ai[i];
1602     bi[i+1] = bi[i] + nz;
1603     aj = a->j + ai[i];
1604     for (j=0; j<nz; j++){
1605       *bj = aj[j]; bj++;
1606     }
1607   }
1608 
1609   /* U part */
1610   bi[n+1] = bi[n];
1611   for (i=n-1; i>=0; i--){
1612     nz = ai[i+1] - adiag[i] - 1;
1613     bi[2*n-i+1] = bi[2*n-i] + nz + 1;
1614     aj = a->j + adiag[i] + 1;
1615     for (j=0; j<nz; j++){
1616       *bj = aj[j]; bj++;
1617     }
1618     /* diag[i] */
1619     *bj = i; bj++;
1620     bdiag[i] = bi[2*n-i+1]-1;
1621   }
1622   PetscFunctionReturn(0);
1623 }
1624 
1625 #undef __FUNCT__
1626 #define __FUNCT__ "MatILUFactorSymbolic_SeqAIJ_newdatastruct"
1627 PetscErrorCode MatILUFactorSymbolic_SeqAIJ_newdatastruct(Mat fact,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
1628 {
1629   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
1630   IS                 isicol;
1631   PetscErrorCode     ierr;
1632   const PetscInt     *r,*ic;
1633   PetscInt           n=A->rmap->n,*ai=a->i,*aj=a->j,d;
1634   PetscInt           *bi,*cols,nnz,*cols_lvl;
1635   PetscInt           *bdiag,prow,fm,nzbd,reallocs=0,dcount=0;
1636   PetscInt           i,levels,diagonal_fill;
1637   PetscTruth         col_identity,row_identity;
1638   PetscReal          f;
1639   PetscInt           nlnk,*lnk,*lnk_lvl=PETSC_NULL;
1640   PetscBT            lnkbt;
1641   PetscInt           nzi,*bj,**bj_ptr,**bjlvl_ptr;
1642   PetscFreeSpaceList free_space=PETSC_NULL,current_space=PETSC_NULL;
1643   PetscFreeSpaceList free_space_lvl=PETSC_NULL,current_space_lvl=PETSC_NULL;
1644   PetscTruth         missing;
1645 
1646   PetscFunctionBegin;
1647   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
1648   f             = info->fill;
1649   levels        = (PetscInt)info->levels;
1650   diagonal_fill = (PetscInt)info->diagonal_fill;
1651   ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr);
1652 
1653   ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
1654   ierr = ISIdentity(iscol,&col_identity);CHKERRQ(ierr);
1655 
1656   if (!levels && row_identity && col_identity) {
1657     /* special case: ilu(0) with natural ordering */
1658     ierr = MatILUFactorSymbolic_SeqAIJ_ilu0_newdatastruct(fact,A,isrow,iscol,info);CHKERRQ(ierr);
1659     (fact)->ops->lufactornumeric =  MatLUFactorNumeric_SeqAIJ_newdatastruct;
1660 
1661     fact->factor = MAT_FACTOR_ILU;
1662     (fact)->info.factor_mallocs    = 0;
1663     (fact)->info.fill_ratio_given  = info->fill;
1664     (fact)->info.fill_ratio_needed = 1.0;
1665     b               = (Mat_SeqAIJ*)(fact)->data;
1666     ierr = MatMissingDiagonal(A,&missing,&d);CHKERRQ(ierr);
1667     if (missing) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",d);
1668     b->row              = isrow;
1669     b->col              = iscol;
1670     b->icol             = isicol;
1671     ierr                = PetscMalloc(((fact)->rmap->n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
1672     ierr                = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
1673     ierr                = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
1674     /* ierr = MatILUFactorSymbolic_Inode(fact,A,isrow,iscol,info);CHKERRQ(ierr); */
1675     PetscFunctionReturn(0);
1676   }
1677 
1678   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
1679   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
1680 
1681   /* get new row pointers */
1682   ierr = PetscMalloc((2*n+2)*sizeof(PetscInt),&bi);CHKERRQ(ierr);
1683   bi[0] = 0;
1684   /* bdiag is location of diagonal in factor */
1685   ierr = PetscMalloc((n+1)*sizeof(PetscInt),&bdiag);CHKERRQ(ierr);
1686   bdiag[0]  = 0;
1687 
1688   ierr = PetscMalloc((2*n+1)*sizeof(PetscInt**),&bj_ptr);CHKERRQ(ierr);
1689   bjlvl_ptr = (PetscInt**)(bj_ptr + n);
1690 
1691   /* create a linked list for storing column indices of the active row */
1692   nlnk = n + 1;
1693   ierr = PetscIncompleteLLCreate(n,n,nlnk,lnk,lnk_lvl,lnkbt);CHKERRQ(ierr);
1694 
1695   /* initial FreeSpace size is f*(ai[n]+1) */
1696   ierr = PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space);CHKERRQ(ierr);
1697   current_space = free_space;
1698   ierr = PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space_lvl);CHKERRQ(ierr);
1699   current_space_lvl = free_space_lvl;
1700 
1701   for (i=0; i<n; i++) {
1702     nzi = 0;
1703     /* copy current row into linked list */
1704     nnz  = ai[r[i]+1] - ai[r[i]];
1705     if (!nnz) SETERRQ2(PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
1706     cols = aj + ai[r[i]];
1707     lnk[i] = -1; /* marker to indicate if diagonal exists */
1708     ierr = PetscIncompleteLLInit(nnz,cols,n,ic,nlnk,lnk,lnk_lvl,lnkbt);CHKERRQ(ierr);
1709     nzi += nlnk;
1710 
1711     /* make sure diagonal entry is included */
1712     if (diagonal_fill && lnk[i] == -1) {
1713       fm = n;
1714       while (lnk[fm] < i) fm = lnk[fm];
1715       lnk[i]     = lnk[fm]; /* insert diagonal into linked list */
1716       lnk[fm]    = i;
1717       lnk_lvl[i] = 0;
1718       nzi++; dcount++;
1719     }
1720 
1721     /* add pivot rows into the active row */
1722     nzbd = 0;
1723     prow = lnk[n];
1724     while (prow < i) {
1725       nnz      = bdiag[prow];
1726       cols     = bj_ptr[prow] + nnz + 1;
1727       cols_lvl = bjlvl_ptr[prow] + nnz + 1;
1728       nnz      = bi[prow+1] - bi[prow] - nnz - 1;
1729       ierr = PetscILULLAddSorted(nnz,cols,levels,cols_lvl,prow,nlnk,lnk,lnk_lvl,lnkbt,prow);CHKERRQ(ierr);
1730       nzi += nlnk;
1731       prow = lnk[prow];
1732       nzbd++;
1733     }
1734     bdiag[i] = nzbd;
1735     bi[i+1]  = bi[i] + nzi;
1736 
1737     /* if free space is not available, make more free space */
1738     if (current_space->local_remaining<nzi) {
1739       nnz = 2*nzi*(n - i); /* estimated and max additional space needed */
1740       ierr = PetscFreeSpaceGet(nnz,&current_space);CHKERRQ(ierr);
1741       ierr = PetscFreeSpaceGet(nnz,&current_space_lvl);CHKERRQ(ierr);
1742       reallocs++;
1743     }
1744 
1745     /* copy data into free_space and free_space_lvl, then initialize lnk */
1746     ierr = PetscIncompleteLLClean(n,n,nzi,lnk,lnk_lvl,current_space->array,current_space_lvl->array,lnkbt);CHKERRQ(ierr);
1747     bj_ptr[i]    = current_space->array;
1748     bjlvl_ptr[i] = current_space_lvl->array;
1749 
1750     /* make sure the active row i has diagonal entry */
1751     if (*(bj_ptr[i]+bdiag[i]) != i) {
1752       SETERRQ1(PETSC_ERR_MAT_LU_ZRPVT,"Row %D has missing diagonal in factored matrix\n\
1753     try running with -pc_factor_nonzeros_along_diagonal or -pc_factor_diagonal_fill",i);
1754     }
1755 
1756     current_space->array           += nzi;
1757     current_space->local_used      += nzi;
1758     current_space->local_remaining -= nzi;
1759     current_space_lvl->array           += nzi;
1760     current_space_lvl->local_used      += nzi;
1761     current_space_lvl->local_remaining -= nzi;
1762   }
1763 
1764   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
1765   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
1766 
1767   /* destroy list of free space and other temporary arrays */
1768   ierr = PetscMalloc((bi[n]+1)*sizeof(PetscInt),&bj);CHKERRQ(ierr);
1769 
1770   /* copy free_space into bj and free free_space; set bi, bj, bdiag in new datastructure; */
1771   ierr = PetscFreeSpaceContiguous_LU(&free_space,bj,n,bi,bdiag);CHKERRQ(ierr);
1772 
1773   ierr = PetscIncompleteLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
1774   ierr = PetscFreeSpaceDestroy(free_space_lvl);CHKERRQ(ierr);
1775   ierr = PetscFree(bj_ptr);CHKERRQ(ierr);
1776 
1777 #if defined(PETSC_USE_INFO)
1778   {
1779     PetscReal af = ((PetscReal)bi[n])/((PetscReal)ai[n]);
1780     ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,f,af);CHKERRQ(ierr);
1781     ierr = PetscInfo1(A,"Run with -[sub_]pc_factor_fill %G or use \n",af);CHKERRQ(ierr);
1782     ierr = PetscInfo1(A,"PCFactorSetFill([sub]pc,%G);\n",af);CHKERRQ(ierr);
1783     ierr = PetscInfo(A,"for best performance.\n");CHKERRQ(ierr);
1784     if (diagonal_fill) {
1785       ierr = PetscInfo1(A,"Detected and replaced %D missing diagonals",dcount);CHKERRQ(ierr);
1786     }
1787   }
1788 #endif
1789 
1790   /* put together the new matrix */
1791   ierr = MatSeqAIJSetPreallocation_SeqAIJ(fact,MAT_SKIP_ALLOCATION,PETSC_NULL);CHKERRQ(ierr);
1792   ierr = PetscLogObjectParent(fact,isicol);CHKERRQ(ierr);
1793   b = (Mat_SeqAIJ*)(fact)->data;
1794   b->free_a       = PETSC_TRUE;
1795   b->free_ij      = PETSC_TRUE;
1796   b->singlemalloc = PETSC_FALSE;
1797   ierr = PetscMalloc( (bi[2*n+1] )*sizeof(PetscScalar),&b->a);CHKERRQ(ierr);
1798   b->j          = bj;
1799   b->i          = bi;
1800   b->diag       = bdiag;
1801   b->ilen       = 0;
1802   b->imax       = 0;
1803   b->row        = isrow;
1804   b->col        = iscol;
1805   ierr          = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
1806   ierr          = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
1807   b->icol       = isicol;
1808   ierr = PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
1809   /* In b structure:  Free imax, ilen, old a, old j.
1810      Allocate bdiag, solve_work, new a, new j */
1811   ierr = PetscLogObjectMemory(fact,bi[2*n+1] * (sizeof(PetscInt)+sizeof(PetscScalar)));CHKERRQ(ierr);
1812   b->maxnz = b->nz = bi[2*n+1] ;
1813   (fact)->info.factor_mallocs    = reallocs;
1814   (fact)->info.fill_ratio_given  = f;
1815   (fact)->info.fill_ratio_needed = ((PetscReal)bi[2*n+1])/((PetscReal)ai[n]);
1816   (fact)->ops->lufactornumeric   = MatLUFactorNumeric_SeqAIJ_newdatastruct;
1817   /* ierr = MatILUFactorSymbolic_Inode(fact,A,isrow,iscol,info);CHKERRQ(ierr); */
1818   PetscFunctionReturn(0);
1819 }
1820 
1821 
1822 /*
1823    ilu(0) with natural ordering under revised new data structure.
1824    Factored arrays bj and ba are stored as
1825      L(0,:), L(1,:), ...,L(n-1,:),  U(n-1,:),...,U(i,:),U(i-1,:),...,U(0,:)
1826 
1827    bi=fact->i is an array of size n+1, in which
1828    bi+
1829      bi[i]      ->  1st entry of L(i,:),i=0,...,i-1
1830      bi[n]      ->  points to L(n-1,:)+1
1831      bi[n+1]    ->  1st entry of U(n-1,:)
1832   bdiag=fact->diag is an array of size n+1,in which
1833      bdiag[0]   -> points to diagonal of U(n-1,:)
1834      bdiag[n-1] -> points to diagonal of U(0,:)
1835 
1836    U(i,:) contains bdiag[i] as its last entry, i.e.,
1837     U(i,:) = (u[i,i+1],...,u[i,n-1],diag[i])
1838 */
1839 #undef __FUNCT__
1840 #define __FUNCT__ "MatILUFactorSymbolic_SeqAIJ_ilu0_newdatastruct_v2"
1841 PetscErrorCode MatILUFactorSymbolic_SeqAIJ_ilu0_newdatastruct_v2(Mat fact,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
1842 {
1843 
1844   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
1845   PetscErrorCode     ierr;
1846   PetscInt           n=A->rmap->n,*ai=a->i,*aj,*adiag=a->diag;
1847   PetscInt           i,j,nz,*bi,*bj,*bdiag,bi_temp;
1848 
1849   PetscFunctionBegin;
1850   ierr = MatDuplicateNoCreate_SeqAIJ(fact,A,MAT_DO_NOT_COPY_VALUES,PETSC_FALSE);CHKERRQ(ierr);
1851   b    = (Mat_SeqAIJ*)(fact)->data;
1852 
1853   /* allocate matrix arrays for new data structure */
1854   ierr = PetscMalloc3(ai[n]+1,PetscScalar,&b->a,ai[n]+1,PetscInt,&b->j,n+1,PetscInt,&b->i);CHKERRQ(ierr);
1855   ierr = PetscLogObjectMemory(fact,ai[n]*(sizeof(PetscScalar)+sizeof(PetscInt))+(n+1)*sizeof(PetscInt));CHKERRQ(ierr);
1856   b->singlemalloc = PETSC_TRUE;
1857   if (!b->diag){
1858     ierr = PetscMalloc((n+1)*sizeof(PetscInt),&b->diag);CHKERRQ(ierr);
1859     ierr = PetscLogObjectMemory(fact,(n+1)*sizeof(PetscInt));CHKERRQ(ierr);
1860   }
1861   bdiag = b->diag;
1862 
1863   if (n > 0) {
1864     ierr = PetscMemzero(b->a,(ai[n])*sizeof(MatScalar));CHKERRQ(ierr);
1865   }
1866 
1867   /* set bi and bj with new data structure */
1868   bi = b->i;
1869   bj = b->j;
1870 
1871   /* L part */
1872   bi[0] = 0;
1873   for (i=0; i<n; i++){
1874     nz = adiag[i] - ai[i];
1875     bi[i+1] = bi[i] + nz;
1876     aj = a->j + ai[i];
1877     for (j=0; j<nz; j++){
1878       *bj = aj[j]; bj++;
1879     }
1880   }
1881 
1882   /* U part */
1883   /* bi[n+1] = bi[n]; */
1884   bi_temp = bi[n];
1885   bdiag[n] = bi[n]-1;
1886   for (i=n-1; i>=0; i--){
1887     nz = ai[i+1] - adiag[i] - 1;
1888     /*  bi[2*n-i+1] = bi[2*n-i] + nz + 1; */
1889     bi_temp = bi_temp + nz + 1;
1890     aj = a->j + adiag[i] + 1;
1891     for (j=0; j<nz; j++){
1892       *bj = aj[j]; bj++;
1893     }
1894     /* diag[i] */
1895     *bj = i; bj++;
1896     /*   bdiag[i] = bi[2*n-i+1]-1; */
1897     bdiag[i] = bi_temp - 1;
1898   }
1899   PetscFunctionReturn(0);
1900 }
1901 
1902 #undef __FUNCT__
1903 #define __FUNCT__ "MatILUFactorSymbolic_SeqAIJ_newdatastruct_v2"
1904 PetscErrorCode MatILUFactorSymbolic_SeqAIJ_newdatastruct_v2(Mat fact,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
1905 {
1906   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
1907   IS                 isicol;
1908   PetscErrorCode     ierr;
1909   const PetscInt     *r,*ic;
1910   PetscInt           n=A->rmap->n,*ai=a->i,*aj=a->j,d;
1911   PetscInt           *bi,*cols,nnz,*cols_lvl;
1912   PetscInt           *bdiag,prow,fm,nzbd,reallocs=0,dcount=0;
1913   PetscInt           i,levels,diagonal_fill;
1914   PetscTruth         col_identity,row_identity;
1915   PetscReal          f;
1916   PetscInt           nlnk,*lnk,*lnk_lvl=PETSC_NULL;
1917   PetscBT            lnkbt;
1918   PetscInt           nzi,*bj,**bj_ptr,**bjlvl_ptr;
1919   PetscFreeSpaceList free_space=PETSC_NULL,current_space=PETSC_NULL;
1920   PetscFreeSpaceList free_space_lvl=PETSC_NULL,current_space_lvl=PETSC_NULL;
1921   PetscTruth         missing;
1922 
1923   PetscFunctionBegin;
1924   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
1925   f             = info->fill;
1926   levels        = (PetscInt)info->levels;
1927   diagonal_fill = (PetscInt)info->diagonal_fill;
1928   ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr);
1929 
1930   ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
1931   ierr = ISIdentity(iscol,&col_identity);CHKERRQ(ierr);
1932 
1933   if (!levels && row_identity && col_identity) {
1934     /* special case: ilu(0) with natural ordering */
1935     ierr = MatILUFactorSymbolic_SeqAIJ_ilu0_newdatastruct_v2(fact,A,isrow,iscol,info);CHKERRQ(ierr);
1936     (fact)->ops->lufactornumeric =  MatLUFactorNumeric_SeqAIJ_newdatastruct_v2;
1937 
1938     fact->factor = MAT_FACTOR_ILU;
1939     (fact)->info.factor_mallocs    = 0;
1940     (fact)->info.fill_ratio_given  = info->fill;
1941     (fact)->info.fill_ratio_needed = 1.0;
1942     b               = (Mat_SeqAIJ*)(fact)->data;
1943     ierr = MatMissingDiagonal(A,&missing,&d);CHKERRQ(ierr);
1944     if (missing) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",d);
1945     b->row              = isrow;
1946     b->col              = iscol;
1947     b->icol             = isicol;
1948     ierr                = PetscMalloc(((fact)->rmap->n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
1949     ierr                = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
1950     ierr                = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
1951     /* ierr = MatILUFactorSymbolic_Inode(fact,A,isrow,iscol,info);CHKERRQ(ierr); */
1952     PetscFunctionReturn(0);
1953   }
1954 
1955   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
1956   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
1957 
1958   /* get new row pointers */
1959   /*  ierr = PetscMalloc((2*n+2)*sizeof(PetscInt),&bi);CHKERRQ(ierr); */
1960   ierr = PetscMalloc((n+1)*sizeof(PetscInt),&bi);CHKERRQ(ierr);
1961   bi[0] = 0;
1962   /* bdiag is location of diagonal in factor */
1963   ierr = PetscMalloc((n+1)*sizeof(PetscInt),&bdiag);CHKERRQ(ierr);
1964   bdiag[0]  = 0;
1965 
1966   ierr = PetscMalloc((2*n+1)*sizeof(PetscInt**),&bj_ptr);CHKERRQ(ierr);
1967   bjlvl_ptr = (PetscInt**)(bj_ptr + n);
1968 
1969   /* create a linked list for storing column indices of the active row */
1970   nlnk = n + 1;
1971   ierr = PetscIncompleteLLCreate(n,n,nlnk,lnk,lnk_lvl,lnkbt);CHKERRQ(ierr);
1972 
1973   /* initial FreeSpace size is f*(ai[n]+1) */
1974   ierr = PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space);CHKERRQ(ierr);
1975   current_space = free_space;
1976   ierr = PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space_lvl);CHKERRQ(ierr);
1977   current_space_lvl = free_space_lvl;
1978 
1979   for (i=0; i<n; i++) {
1980     nzi = 0;
1981     /* copy current row into linked list */
1982     nnz  = ai[r[i]+1] - ai[r[i]];
1983     if (!nnz) SETERRQ2(PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
1984     cols = aj + ai[r[i]];
1985     lnk[i] = -1; /* marker to indicate if diagonal exists */
1986     ierr = PetscIncompleteLLInit(nnz,cols,n,ic,nlnk,lnk,lnk_lvl,lnkbt);CHKERRQ(ierr);
1987     nzi += nlnk;
1988 
1989     /* make sure diagonal entry is included */
1990     if (diagonal_fill && lnk[i] == -1) {
1991       fm = n;
1992       while (lnk[fm] < i) fm = lnk[fm];
1993       lnk[i]     = lnk[fm]; /* insert diagonal into linked list */
1994       lnk[fm]    = i;
1995       lnk_lvl[i] = 0;
1996       nzi++; dcount++;
1997     }
1998 
1999     /* add pivot rows into the active row */
2000     nzbd = 0;
2001     prow = lnk[n];
2002     while (prow < i) {
2003       nnz      = bdiag[prow];
2004       cols     = bj_ptr[prow] + nnz + 1;
2005       cols_lvl = bjlvl_ptr[prow] + nnz + 1;
2006       nnz      = bi[prow+1] - bi[prow] - nnz - 1;
2007       ierr = PetscILULLAddSorted(nnz,cols,levels,cols_lvl,prow,nlnk,lnk,lnk_lvl,lnkbt,prow);CHKERRQ(ierr);
2008       nzi += nlnk;
2009       prow = lnk[prow];
2010       nzbd++;
2011     }
2012     bdiag[i] = nzbd;
2013     bi[i+1]  = bi[i] + nzi;
2014 
2015     /* if free space is not available, make more free space */
2016     if (current_space->local_remaining<nzi) {
2017       nnz = 2*nzi*(n - i); /* estimated and max additional space needed */
2018       ierr = PetscFreeSpaceGet(nnz,&current_space);CHKERRQ(ierr);
2019       ierr = PetscFreeSpaceGet(nnz,&current_space_lvl);CHKERRQ(ierr);
2020       reallocs++;
2021     }
2022 
2023     /* copy data into free_space and free_space_lvl, then initialize lnk */
2024     ierr = PetscIncompleteLLClean(n,n,nzi,lnk,lnk_lvl,current_space->array,current_space_lvl->array,lnkbt);CHKERRQ(ierr);
2025     bj_ptr[i]    = current_space->array;
2026     bjlvl_ptr[i] = current_space_lvl->array;
2027 
2028     /* make sure the active row i has diagonal entry */
2029     if (*(bj_ptr[i]+bdiag[i]) != i) {
2030       SETERRQ1(PETSC_ERR_MAT_LU_ZRPVT,"Row %D has missing diagonal in factored matrix\n\
2031     try running with -pc_factor_nonzeros_along_diagonal or -pc_factor_diagonal_fill",i);
2032     }
2033 
2034     current_space->array           += nzi;
2035     current_space->local_used      += nzi;
2036     current_space->local_remaining -= nzi;
2037     current_space_lvl->array           += nzi;
2038     current_space_lvl->local_used      += nzi;
2039     current_space_lvl->local_remaining -= nzi;
2040   }
2041 
2042   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
2043   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
2044 
2045   /* destroy list of free space and other temporary arrays */
2046   ierr = PetscMalloc((bi[n]+1)*sizeof(PetscInt),&bj);CHKERRQ(ierr);
2047 
2048   /* copy free_space into bj and free free_space; set bi, bj, bdiag in new datastructure; */
2049   /* ierr = PetscFreeSpaceContiguous_LU(&free_space,bj,n,bi,bdiag);CHKERRQ(ierr); */
2050   ierr = PetscFreeSpaceContiguous_LU_v2(&free_space,bj,n,bi,bdiag);CHKERRQ(ierr);
2051 
2052   ierr = PetscIncompleteLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
2053   ierr = PetscFreeSpaceDestroy(free_space_lvl);CHKERRQ(ierr);
2054   ierr = PetscFree(bj_ptr);CHKERRQ(ierr);
2055 
2056 #if defined(PETSC_USE_INFO)
2057   {
2058     PetscReal af = ((PetscReal)bi[n])/((PetscReal)ai[n]);
2059     ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,f,af);CHKERRQ(ierr);
2060     ierr = PetscInfo1(A,"Run with -[sub_]pc_factor_fill %G or use \n",af);CHKERRQ(ierr);
2061     ierr = PetscInfo1(A,"PCFactorSetFill([sub]pc,%G);\n",af);CHKERRQ(ierr);
2062     ierr = PetscInfo(A,"for best performance.\n");CHKERRQ(ierr);
2063     if (diagonal_fill) {
2064       ierr = PetscInfo1(A,"Detected and replaced %D missing diagonals",dcount);CHKERRQ(ierr);
2065     }
2066   }
2067 #endif
2068 
2069   /* put together the new matrix */
2070   ierr = MatSeqAIJSetPreallocation_SeqAIJ(fact,MAT_SKIP_ALLOCATION,PETSC_NULL);CHKERRQ(ierr);
2071   ierr = PetscLogObjectParent(fact,isicol);CHKERRQ(ierr);
2072   b = (Mat_SeqAIJ*)(fact)->data;
2073   b->free_a       = PETSC_TRUE;
2074   b->free_ij      = PETSC_TRUE;
2075   b->singlemalloc = PETSC_FALSE;
2076   /*  ierr = PetscMalloc( (bi[2*n+1] )*sizeof(PetscScalar),&b->a);CHKERRQ(ierr); */
2077   ierr = PetscMalloc((bdiag[0]+1)*sizeof(PetscScalar),&b->a);CHKERRQ(ierr);
2078   b->j          = bj;
2079   b->i          = bi;
2080   b->diag       = bdiag;
2081   b->ilen       = 0;
2082   b->imax       = 0;
2083   b->row        = isrow;
2084   b->col        = iscol;
2085   ierr          = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
2086   ierr          = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
2087   b->icol       = isicol;
2088   ierr = PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
2089   /* In b structure:  Free imax, ilen, old a, old j.
2090      Allocate bdiag, solve_work, new a, new j */
2091 
2092   /*  ierr = PetscLogObjectMemory(fact,bi[2*n+1] * (sizeof(PetscInt)+sizeof(PetscScalar)));CHKERRQ(ierr);
2093       b->maxnz = b->nz = bi[2*n+1] ; */
2094   ierr = PetscLogObjectMemory(fact,(bdiag[0]+1)*(sizeof(PetscInt)+sizeof(PetscScalar)));CHKERRQ(ierr);
2095   b->maxnz = b->nz = bdiag[0]+1;
2096   (fact)->info.factor_mallocs    = reallocs;
2097   (fact)->info.fill_ratio_given  = f;
2098   /*  (fact)->info.fill_ratio_needed = ((PetscReal)bi[2*n+1])/((PetscReal)ai[n]); */
2099   (fact)->info.fill_ratio_needed = ((PetscReal)(bdiag[0]+1))/((PetscReal)ai[n]);
2100   /*  (fact)->ops->lufactornumeric   = MatLUFactorNumeric_SeqAIJ_newdatastruct; */
2101   (fact)->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ_newdatastruct_v2;
2102   /* ierr = MatILUFactorSymbolic_Inode(fact,A,isrow,iscol,info);CHKERRQ(ierr); */
2103   PetscFunctionReturn(0);
2104 }
2105 
2106 #undef __FUNCT__
2107 #define __FUNCT__ "MatILUFactorSymbolic_SeqAIJ"
2108 PetscErrorCode MatILUFactorSymbolic_SeqAIJ(Mat fact,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
2109 {
2110   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
2111   IS                 isicol;
2112   PetscErrorCode     ierr;
2113   const PetscInt     *r,*ic;
2114   PetscInt           n=A->rmap->n,*ai=a->i,*aj=a->j,d;
2115   PetscInt           *bi,*cols,nnz,*cols_lvl;
2116   PetscInt           *bdiag,prow,fm,nzbd,reallocs=0,dcount=0;
2117   PetscInt           i,levels,diagonal_fill;
2118   PetscTruth         col_identity,row_identity;
2119   PetscReal          f;
2120   PetscInt           nlnk,*lnk,*lnk_lvl=PETSC_NULL;
2121   PetscBT            lnkbt;
2122   PetscInt           nzi,*bj,**bj_ptr,**bjlvl_ptr;
2123   PetscFreeSpaceList free_space=PETSC_NULL,current_space=PETSC_NULL;
2124   PetscFreeSpaceList free_space_lvl=PETSC_NULL,current_space_lvl=PETSC_NULL;
2125   PetscTruth         missing;
2126   PetscTruth         newdatastruct=PETSC_FALSE,newdatastruct_v2=PETSC_FALSE;
2127 
2128   PetscFunctionBegin;
2129   ierr = PetscOptionsGetTruth(PETSC_NULL,"-ilu_new",&newdatastruct,PETSC_NULL);CHKERRQ(ierr);
2130   if (newdatastruct){
2131     ierr = MatILUFactorSymbolic_SeqAIJ_newdatastruct(fact,A,isrow,iscol,info);CHKERRQ(ierr);
2132     PetscFunctionReturn(0);
2133   }
2134   ierr = PetscOptionsGetTruth(PETSC_NULL,"-ilu_new_v2",&newdatastruct_v2,PETSC_NULL);CHKERRQ(ierr);
2135   if(newdatastruct_v2){
2136     ierr = MatILUFactorSymbolic_SeqAIJ_newdatastruct_v2(fact,A,isrow,iscol,info);CHKERRQ(ierr);
2137     PetscFunctionReturn(0);
2138   }
2139 
2140   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
2141   f             = info->fill;
2142   levels        = (PetscInt)info->levels;
2143   diagonal_fill = (PetscInt)info->diagonal_fill;
2144   ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr);
2145 
2146   ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
2147   ierr = ISIdentity(iscol,&col_identity);CHKERRQ(ierr);
2148   if (!levels && row_identity && col_identity) { /* special case: ilu(0) with natural ordering */
2149     ierr = MatDuplicateNoCreate_SeqAIJ(fact,A,MAT_DO_NOT_COPY_VALUES,PETSC_TRUE);CHKERRQ(ierr);
2150     (fact)->ops->lufactornumeric =  MatLUFactorNumeric_SeqAIJ;
2151 
2152     fact->factor = MAT_FACTOR_ILU;
2153     (fact)->info.factor_mallocs    = 0;
2154     (fact)->info.fill_ratio_given  = info->fill;
2155     (fact)->info.fill_ratio_needed = 1.0;
2156     b               = (Mat_SeqAIJ*)(fact)->data;
2157     ierr = MatMissingDiagonal(A,&missing,&d);CHKERRQ(ierr);
2158     if (missing) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",d);
2159     b->row              = isrow;
2160     b->col              = iscol;
2161     b->icol             = isicol;
2162     ierr                = PetscMalloc(((fact)->rmap->n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
2163     ierr                = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
2164     ierr                = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
2165     ierr = MatILUFactorSymbolic_Inode(fact,A,isrow,iscol,info);CHKERRQ(ierr);
2166     PetscFunctionReturn(0);
2167   }
2168 
2169   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
2170   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
2171 
2172   /* get new row pointers */
2173   ierr = PetscMalloc((n+1)*sizeof(PetscInt),&bi);CHKERRQ(ierr);
2174   bi[0] = 0;
2175   /* bdiag is location of diagonal in factor */
2176   ierr = PetscMalloc((n+1)*sizeof(PetscInt),&bdiag);CHKERRQ(ierr);
2177   bdiag[0]  = 0;
2178 
2179   ierr = PetscMalloc((2*n+1)*sizeof(PetscInt**),&bj_ptr);CHKERRQ(ierr);
2180   bjlvl_ptr = (PetscInt**)(bj_ptr + n);
2181 
2182   /* create a linked list for storing column indices of the active row */
2183   nlnk = n + 1;
2184   ierr = PetscIncompleteLLCreate(n,n,nlnk,lnk,lnk_lvl,lnkbt);CHKERRQ(ierr);
2185 
2186   /* initial FreeSpace size is f*(ai[n]+1) */
2187   ierr = PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space);CHKERRQ(ierr);
2188   current_space = free_space;
2189   ierr = PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space_lvl);CHKERRQ(ierr);
2190   current_space_lvl = free_space_lvl;
2191 
2192   for (i=0; i<n; i++) {
2193     nzi = 0;
2194     /* copy current row into linked list */
2195     nnz  = ai[r[i]+1] - ai[r[i]];
2196     if (!nnz) SETERRQ2(PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
2197     cols = aj + ai[r[i]];
2198     lnk[i] = -1; /* marker to indicate if diagonal exists */
2199     ierr = PetscIncompleteLLInit(nnz,cols,n,ic,nlnk,lnk,lnk_lvl,lnkbt);CHKERRQ(ierr);
2200     nzi += nlnk;
2201 
2202     /* make sure diagonal entry is included */
2203     if (diagonal_fill && lnk[i] == -1) {
2204       fm = n;
2205       while (lnk[fm] < i) fm = lnk[fm];
2206       lnk[i]     = lnk[fm]; /* insert diagonal into linked list */
2207       lnk[fm]    = i;
2208       lnk_lvl[i] = 0;
2209       nzi++; dcount++;
2210     }
2211 
2212     /* add pivot rows into the active row */
2213     nzbd = 0;
2214     prow = lnk[n];
2215     while (prow < i) {
2216       nnz      = bdiag[prow];
2217       cols     = bj_ptr[prow] + nnz + 1;
2218       cols_lvl = bjlvl_ptr[prow] + nnz + 1;
2219       nnz      = bi[prow+1] - bi[prow] - nnz - 1;
2220       ierr = PetscILULLAddSorted(nnz,cols,levels,cols_lvl,prow,nlnk,lnk,lnk_lvl,lnkbt,prow);CHKERRQ(ierr);
2221       nzi += nlnk;
2222       prow = lnk[prow];
2223       nzbd++;
2224     }
2225     bdiag[i] = nzbd;
2226     bi[i+1]  = bi[i] + nzi;
2227 
2228     /* if free space is not available, make more free space */
2229     if (current_space->local_remaining<nzi) {
2230       nnz = nzi*(n - i); /* estimated and max additional space needed */
2231       ierr = PetscFreeSpaceGet(nnz,&current_space);CHKERRQ(ierr);
2232       ierr = PetscFreeSpaceGet(nnz,&current_space_lvl);CHKERRQ(ierr);
2233       reallocs++;
2234     }
2235 
2236     /* copy data into free_space and free_space_lvl, then initialize lnk */
2237     ierr = PetscIncompleteLLClean(n,n,nzi,lnk,lnk_lvl,current_space->array,current_space_lvl->array,lnkbt);CHKERRQ(ierr);
2238     bj_ptr[i]    = current_space->array;
2239     bjlvl_ptr[i] = current_space_lvl->array;
2240 
2241     /* make sure the active row i has diagonal entry */
2242     if (*(bj_ptr[i]+bdiag[i]) != i) {
2243       SETERRQ1(PETSC_ERR_MAT_LU_ZRPVT,"Row %D has missing diagonal in factored matrix\n\
2244     try running with -pc_factor_nonzeros_along_diagonal or -pc_factor_diagonal_fill",i);
2245     }
2246 
2247     current_space->array           += nzi;
2248     current_space->local_used      += nzi;
2249     current_space->local_remaining -= nzi;
2250     current_space_lvl->array           += nzi;
2251     current_space_lvl->local_used      += nzi;
2252     current_space_lvl->local_remaining -= nzi;
2253   }
2254 
2255   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
2256   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
2257 
2258   /* destroy list of free space and other temporary arrays */
2259   ierr = PetscMalloc((bi[n]+1)*sizeof(PetscInt),&bj);CHKERRQ(ierr);
2260   ierr = PetscFreeSpaceContiguous(&free_space,bj);CHKERRQ(ierr); /* copy free_space -> bj */
2261   ierr = PetscIncompleteLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
2262   ierr = PetscFreeSpaceDestroy(free_space_lvl);CHKERRQ(ierr);
2263   ierr = PetscFree(bj_ptr);CHKERRQ(ierr);
2264 
2265 #if defined(PETSC_USE_INFO)
2266   {
2267     PetscReal af = ((PetscReal)bi[n])/((PetscReal)ai[n]);
2268     ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,f,af);CHKERRQ(ierr);
2269     ierr = PetscInfo1(A,"Run with -[sub_]pc_factor_fill %G or use \n",af);CHKERRQ(ierr);
2270     ierr = PetscInfo1(A,"PCFactorSetFill([sub]pc,%G);\n",af);CHKERRQ(ierr);
2271     ierr = PetscInfo(A,"for best performance.\n");CHKERRQ(ierr);
2272     if (diagonal_fill) {
2273       ierr = PetscInfo1(A,"Detected and replaced %D missing diagonals",dcount);CHKERRQ(ierr);
2274     }
2275   }
2276 #endif
2277 
2278   /* put together the new matrix */
2279   ierr = MatSeqAIJSetPreallocation_SeqAIJ(fact,MAT_SKIP_ALLOCATION,PETSC_NULL);CHKERRQ(ierr);
2280   ierr = PetscLogObjectParent(fact,isicol);CHKERRQ(ierr);
2281   b = (Mat_SeqAIJ*)(fact)->data;
2282   b->free_a       = PETSC_TRUE;
2283   b->free_ij      = PETSC_TRUE;
2284   b->singlemalloc = PETSC_FALSE;
2285   ierr = PetscMalloc( (bi[n] )*sizeof(PetscScalar),&b->a);CHKERRQ(ierr);
2286   b->j          = bj;
2287   b->i          = bi;
2288   for (i=0; i<n; i++) bdiag[i] += bi[i];
2289   b->diag       = bdiag;
2290   b->ilen       = 0;
2291   b->imax       = 0;
2292   b->row        = isrow;
2293   b->col        = iscol;
2294   ierr          = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
2295   ierr          = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
2296   b->icol       = isicol;
2297   ierr = PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
2298   /* In b structure:  Free imax, ilen, old a, old j.
2299      Allocate bdiag, solve_work, new a, new j */
2300   ierr = PetscLogObjectMemory(fact,(bi[n]-n) * (sizeof(PetscInt)+sizeof(PetscScalar)));CHKERRQ(ierr);
2301   b->maxnz             = b->nz = bi[n] ;
2302   (fact)->info.factor_mallocs    = reallocs;
2303   (fact)->info.fill_ratio_given  = f;
2304   (fact)->info.fill_ratio_needed = ((PetscReal)bi[n])/((PetscReal)ai[n]);
2305   (fact)->ops->lufactornumeric =  MatLUFactorNumeric_SeqAIJ;
2306   ierr = MatILUFactorSymbolic_Inode(fact,A,isrow,iscol,info);CHKERRQ(ierr);
2307   PetscFunctionReturn(0);
2308 }
2309 
2310 #undef __FUNCT__
2311 #define __FUNCT__ "MatCholeskyFactorNumeric_SeqAIJ_newdatastruct"
2312 PetscErrorCode MatCholeskyFactorNumeric_SeqAIJ_newdatastruct(Mat B,Mat A,const MatFactorInfo *info)
2313 {
2314   Mat            C = B;
2315   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data;
2316   Mat_SeqSBAIJ   *b=(Mat_SeqSBAIJ*)C->data;
2317   IS             ip=b->row,iip = b->icol;
2318   PetscErrorCode ierr;
2319   const PetscInt *rip,*riip;
2320   PetscInt       i,j,mbs=A->rmap->n,*bi=b->i,*bj=b->j,*bdiag=b->diag,*bjtmp;
2321   PetscInt       *ai=a->i,*aj=a->j;
2322   PetscInt       k,jmin,jmax,*c2r,*il,col,nexti,ili,nz;
2323   MatScalar      *rtmp,*ba=b->a,*bval,*aa=a->a,dk,uikdi;
2324   PetscReal      zeropivot,shiftnz;
2325   PetscReal      shiftpd;
2326   PetscTruth     perm_identity;
2327 
2328   PetscFunctionBegin;
2329 
2330   shiftnz   = info->shiftnz;
2331   shiftpd   = info->shiftpd;
2332   zeropivot = info->zeropivot;
2333 
2334   ierr  = ISGetIndices(ip,&rip);CHKERRQ(ierr);
2335   ierr  = ISGetIndices(iip,&riip);CHKERRQ(ierr);
2336 
2337   /* allocate working arrays
2338      c2r: linked list, keep track of pivot rows for a given column. c2r[col]: head of the list for a given col
2339      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
2340   */
2341   nz   = (2*mbs+1)*sizeof(PetscInt)+mbs*sizeof(MatScalar);
2342   ierr = PetscMalloc(nz,&il);CHKERRQ(ierr);
2343   c2r  = il + mbs;
2344   rtmp = (MatScalar*)(c2r + mbs);
2345 
2346   for (i=0; i<mbs; i++) {
2347     c2r[i] = mbs;
2348   }
2349   il[0] = 0;
2350 
2351   for (k = 0; k<mbs; k++){
2352     /* zero rtmp */
2353     nz = bi[k+1] - bi[k];
2354     bjtmp = bj + bi[k];
2355     for (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;
2356 
2357     /* load in initial unfactored row */
2358     bval = ba + bi[k];
2359     jmin = ai[rip[k]]; jmax = ai[rip[k]+1];
2360     for (j = jmin; j < jmax; j++){
2361       col = riip[aj[j]];
2362       if (col >= k){ /* only take upper triangular entry */
2363         rtmp[col] = aa[j];
2364         *bval++   = 0.0; /* for in-place factorization */
2365       }
2366     }
2367     /* shift the diagonal of the matrix */
2368 
2369     /* modify k-th row by adding in those rows i with U(i,k)!=0 */
2370     dk = rtmp[k];
2371     i  = c2r[k]; /* first row to be added to k_th row  */
2372 
2373     while (i < k){
2374       nexti = c2r[i]; /* next row to be added to k_th row */
2375 
2376       /* compute multiplier, update diag(k) and U(i,k) */
2377       ili   = il[i];  /* index of first nonzero element in U(i,k:bms-1) */
2378       uikdi = - ba[ili]*ba[bdiag[i]];  /* diagonal(k) */
2379       dk   += uikdi*ba[ili]; /* update diag[k] */
2380       ba[ili] = uikdi; /* -U(i,k) */
2381 
2382       /* add multiple of row i to k-th row */
2383       jmin = ili + 1; jmax = bi[i+1];
2384       if (jmin < jmax){
2385         for (j=jmin; j<jmax; j++) rtmp[bj[j]] += uikdi*ba[j];
2386         /* update il and c2r for row i */
2387         il[i] = jmin;
2388         j = bj[jmin]; c2r[i] = c2r[j]; c2r[j] = i;
2389       }
2390       i = nexti;
2391     }
2392 
2393     /* copy data into U(k,:) */
2394     ba[bdiag[k]] = 1.0/dk; /* U(k,k) */
2395     jmin = bi[k]; jmax = bi[k+1]-1;
2396     if (jmin < jmax) {
2397       for (j=jmin; j<jmax; j++){
2398         col = bj[j]; ba[j] = rtmp[col];
2399       }
2400       /* add the k-th row into il and c2r */
2401       il[k] = jmin;
2402       i = bj[jmin]; c2r[k] = c2r[i]; c2r[i] = k;
2403     }
2404   }
2405 
2406   ierr = PetscFree(il);CHKERRQ(ierr);
2407   ierr = ISRestoreIndices(ip,&rip);CHKERRQ(ierr);
2408   ierr = ISRestoreIndices(iip,&riip);CHKERRQ(ierr);
2409 
2410   ierr = ISIdentity(ip,&perm_identity);CHKERRQ(ierr);
2411   if (perm_identity){
2412     (B)->ops->solve           = MatSolve_SeqSBAIJ_1_NaturalOrdering_newdatastruct;
2413     (B)->ops->solvetranspose  = 0;
2414     (B)->ops->forwardsolve    = 0;
2415     (B)->ops->backwardsolve   = 0;
2416   } else {
2417     (B)->ops->solve           = MatSolve_SeqSBAIJ_1_newdatastruct;
2418     (B)->ops->solvetranspose  = 0;
2419     (B)->ops->forwardsolve    = 0;
2420     (B)->ops->backwardsolve   = 0;
2421   }
2422 
2423   C->assembled    = PETSC_TRUE;
2424   C->preallocated = PETSC_TRUE;
2425   ierr = PetscLogFlops(C->rmap->n);CHKERRQ(ierr);
2426   PetscFunctionReturn(0);
2427 }
2428 
2429 #undef __FUNCT__
2430 #define __FUNCT__ "MatCholeskyFactorNumeric_SeqAIJ"
2431 PetscErrorCode MatCholeskyFactorNumeric_SeqAIJ(Mat B,Mat A,const MatFactorInfo *info)
2432 {
2433   Mat            C = B;
2434   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data;
2435   Mat_SeqSBAIJ   *b=(Mat_SeqSBAIJ*)C->data;
2436   IS             ip=b->row,iip = b->icol;
2437   PetscErrorCode ierr;
2438   const PetscInt *rip,*riip;
2439   PetscInt       i,j,mbs=A->rmap->n,*bi=b->i,*bj=b->j,*bcol;
2440   PetscInt       *ai=a->i,*aj=a->j;
2441   PetscInt       k,jmin,jmax,*jl,*il,col,nexti,ili,nz;
2442   MatScalar      *rtmp,*ba=b->a,*bval,*aa=a->a,dk,uikdi;
2443   PetscReal      zeropivot,rs,shiftnz;
2444   PetscReal      shiftpd;
2445   ChShift_Ctx    sctx;
2446   PetscInt       newshift;
2447   PetscTruth     perm_identity;
2448 
2449   PetscFunctionBegin;
2450   shiftnz   = info->shiftnz;
2451   shiftpd   = info->shiftpd;
2452   zeropivot = info->zeropivot;
2453 
2454   ierr  = ISGetIndices(ip,&rip);CHKERRQ(ierr);
2455   ierr  = ISGetIndices(iip,&riip);CHKERRQ(ierr);
2456 
2457   /* initialization */
2458   nz   = (2*mbs+1)*sizeof(PetscInt)+mbs*sizeof(MatScalar);
2459   ierr = PetscMalloc(nz,&il);CHKERRQ(ierr);
2460   jl   = il + mbs;
2461   rtmp = (MatScalar*)(jl + mbs);
2462 
2463   sctx.shift_amount = 0;
2464   sctx.nshift       = 0;
2465   do {
2466     sctx.chshift = PETSC_FALSE;
2467     for (i=0; i<mbs; i++) {
2468       rtmp[i] = 0.0; jl[i] = mbs; il[0] = 0;
2469     }
2470 
2471     for (k = 0; k<mbs; k++){
2472       bval = ba + bi[k];
2473       /* initialize k-th row by the perm[k]-th row of A */
2474       jmin = ai[rip[k]]; jmax = ai[rip[k]+1];
2475       for (j = jmin; j < jmax; j++){
2476         col = riip[aj[j]];
2477         if (col >= k){ /* only take upper triangular entry */
2478           rtmp[col] = aa[j];
2479           *bval++  = 0.0; /* for in-place factorization */
2480         }
2481       }
2482       /* shift the diagonal of the matrix */
2483       if (sctx.nshift) rtmp[k] += sctx.shift_amount;
2484 
2485       /* modify k-th row by adding in those rows i with U(i,k)!=0 */
2486       dk = rtmp[k];
2487       i = jl[k]; /* first row to be added to k_th row  */
2488 
2489       while (i < k){
2490         nexti = jl[i]; /* next row to be added to k_th row */
2491 
2492         /* compute multiplier, update diag(k) and U(i,k) */
2493         ili = il[i];  /* index of first nonzero element in U(i,k:bms-1) */
2494         uikdi = - ba[ili]*ba[bi[i]];  /* diagonal(k) */
2495         dk += uikdi*ba[ili];
2496         ba[ili] = uikdi; /* -U(i,k) */
2497 
2498         /* add multiple of row i to k-th row */
2499         jmin = ili + 1; jmax = bi[i+1];
2500         if (jmin < jmax){
2501           for (j=jmin; j<jmax; j++) rtmp[bj[j]] += uikdi*ba[j];
2502           /* update il and jl for row i */
2503           il[i] = jmin;
2504           j = bj[jmin]; jl[i] = jl[j]; jl[j] = i;
2505         }
2506         i = nexti;
2507       }
2508 
2509       /* shift the diagonals when zero pivot is detected */
2510       /* compute rs=sum of abs(off-diagonal) */
2511       rs   = 0.0;
2512       jmin = bi[k]+1;
2513       nz   = bi[k+1] - jmin;
2514       bcol = bj + jmin;
2515       for (j=0; j<nz; j++) {
2516         rs += PetscAbsScalar(rtmp[bcol[j]]);
2517       }
2518 
2519       sctx.rs = rs;
2520       sctx.pv = dk;
2521       ierr = MatCholeskyCheckShift_inline(info,sctx,k,newshift);CHKERRQ(ierr);
2522 
2523       if (newshift == 1) {
2524         if (!sctx.shift_amount) {
2525           sctx.shift_amount = 1e-5;
2526         }
2527         break;
2528       }
2529 
2530       /* copy data into U(k,:) */
2531       ba[bi[k]] = 1.0/dk; /* U(k,k) */
2532       jmin = bi[k]+1; jmax = bi[k+1];
2533       if (jmin < jmax) {
2534         for (j=jmin; j<jmax; j++){
2535           col = bj[j]; ba[j] = rtmp[col]; rtmp[col] = 0.0;
2536         }
2537         /* add the k-th row into il and jl */
2538         il[k] = jmin;
2539         i = bj[jmin]; jl[k] = jl[i]; jl[i] = k;
2540       }
2541     }
2542   } while (sctx.chshift);
2543   ierr = PetscFree(il);CHKERRQ(ierr);
2544 
2545   ierr = ISRestoreIndices(ip,&rip);CHKERRQ(ierr);
2546   ierr = ISRestoreIndices(iip,&riip);CHKERRQ(ierr);
2547 
2548   ierr = ISIdentity(ip,&perm_identity);CHKERRQ(ierr);
2549   if (perm_identity){
2550     (B)->ops->solve           = MatSolve_SeqSBAIJ_1_NaturalOrdering;
2551     (B)->ops->solvetranspose  = MatSolve_SeqSBAIJ_1_NaturalOrdering;
2552     (B)->ops->forwardsolve    = MatForwardSolve_SeqSBAIJ_1_NaturalOrdering;
2553     (B)->ops->backwardsolve   = MatBackwardSolve_SeqSBAIJ_1_NaturalOrdering;
2554   } else {
2555     (B)->ops->solve           = MatSolve_SeqSBAIJ_1;
2556     (B)->ops->solvetranspose  = MatSolve_SeqSBAIJ_1;
2557     (B)->ops->forwardsolve    = MatForwardSolve_SeqSBAIJ_1;
2558     (B)->ops->backwardsolve   = MatBackwardSolve_SeqSBAIJ_1;
2559   }
2560 
2561   C->assembled    = PETSC_TRUE;
2562   C->preallocated = PETSC_TRUE;
2563   ierr = PetscLogFlops(C->rmap->n);CHKERRQ(ierr);
2564   if (sctx.nshift){
2565     if (shiftnz) {
2566       ierr = PetscInfo2(A,"number of shiftnz tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);CHKERRQ(ierr);
2567     } else if (shiftpd) {
2568       ierr = PetscInfo2(A,"number of shiftpd tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);CHKERRQ(ierr);
2569     }
2570   }
2571   PetscFunctionReturn(0);
2572 }
2573 
2574 #undef __FUNCT__
2575 #define __FUNCT__ "MatICCFactorSymbolic_SeqAIJ_newdatastruct"
2576 PetscErrorCode MatICCFactorSymbolic_SeqAIJ_newdatastruct(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
2577 {
2578   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data;
2579   Mat_SeqSBAIJ       *b;
2580   PetscErrorCode     ierr;
2581   PetscTruth         perm_identity,missing;
2582   PetscInt           reallocs=0,i,*ai=a->i,*aj=a->j,am=A->rmap->n,*ui,*udiag;
2583   const PetscInt     *rip,*riip;
2584   PetscInt           jmin,jmax,nzk,k,j,*jl,prow,*il,nextprow;
2585   PetscInt           nlnk,*lnk,*lnk_lvl=PETSC_NULL,d;
2586   PetscInt           ncols,ncols_upper,*cols,*ajtmp,*uj,**uj_ptr,**uj_lvl_ptr;
2587   PetscReal          fill=info->fill,levels=info->levels;
2588   PetscFreeSpaceList free_space=PETSC_NULL,current_space=PETSC_NULL;
2589   PetscFreeSpaceList free_space_lvl=PETSC_NULL,current_space_lvl=PETSC_NULL;
2590   PetscBT            lnkbt;
2591   IS                 iperm;
2592 
2593   PetscFunctionBegin;
2594   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
2595   ierr = MatMissingDiagonal(A,&missing,&d);CHKERRQ(ierr);
2596   if (missing) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",d);
2597   ierr = ISIdentity(perm,&perm_identity);CHKERRQ(ierr);
2598   ierr = ISInvertPermutation(perm,PETSC_DECIDE,&iperm);CHKERRQ(ierr);
2599 
2600   ierr = PetscMalloc((am+1)*sizeof(PetscInt),&ui);CHKERRQ(ierr);
2601   ierr = PetscMalloc((am+1)*sizeof(PetscInt),&udiag);CHKERRQ(ierr);
2602   ui[0] = 0;
2603 
2604   /* ICC(0) without matrix ordering: simply copies fill pattern */
2605   if (!levels && perm_identity) {
2606 
2607     for (i=0; i<am; i++) {
2608       ui[i+1]  = ui[i] + ai[i+1] - a->diag[i];
2609       udiag[i] = ui[i+1] - 1; /* points to the last entry of U(i,:) */
2610     }
2611     ierr = PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);CHKERRQ(ierr);
2612     cols = uj;
2613     for (i=0; i<am; i++) {
2614       aj    = a->j + a->diag[i] + 1; /* 1st entry of U(i,:) without diagonal */
2615       ncols = ui[i+1] - ui[i] - 1;
2616       for (j=0; j<ncols; j++) *cols++ = aj[j];
2617       *cols++ = i; /* diagoanl is located as the last entry of U(i,:) */
2618     }
2619   } else { /* case: levels>0 || (levels=0 && !perm_identity) */
2620 
2621     ierr = ISGetIndices(iperm,&riip);CHKERRQ(ierr);
2622     ierr = ISGetIndices(perm,&rip);CHKERRQ(ierr);
2623 
2624     /* initialization */
2625     ierr  = PetscMalloc((am+1)*sizeof(PetscInt),&ajtmp);CHKERRQ(ierr);
2626 
2627     /* jl: linked list for storing indices of the pivot rows
2628        il: il[i] points to the 1st nonzero entry of U(i,k:am-1) */
2629     ierr = PetscMalloc((2*am+1)*sizeof(PetscInt)+2*am*sizeof(PetscInt**),&jl);CHKERRQ(ierr);
2630     il         = jl + am;
2631     uj_ptr     = (PetscInt**)(il + am);
2632     uj_lvl_ptr = (PetscInt**)(uj_ptr + am);
2633     for (i=0; i<am; i++){
2634       jl[i] = am; il[i] = 0;
2635     }
2636 
2637     /* create and initialize a linked list for storing column indices of the active row k */
2638     nlnk = am + 1;
2639     ierr = PetscIncompleteLLCreate(am,am,nlnk,lnk,lnk_lvl,lnkbt);CHKERRQ(ierr);
2640 
2641     /* initial FreeSpace size is fill*(ai[am]+1) */
2642     ierr = PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+1)),&free_space);CHKERRQ(ierr);
2643     current_space = free_space;
2644     ierr = PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+1)),&free_space_lvl);CHKERRQ(ierr);
2645     current_space_lvl = free_space_lvl;
2646 
2647     for (k=0; k<am; k++){  /* for each active row k */
2648       /* initialize lnk by the column indices of row rip[k] of A */
2649       nzk   = 0;
2650       ncols = ai[rip[k]+1] - ai[rip[k]];
2651       if (!ncols) SETERRQ2(PETSC_ERR_MAT_CH_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",rip[k],k);
2652       ncols_upper = 0;
2653       for (j=0; j<ncols; j++){
2654         i = *(aj + ai[rip[k]] + j); /* unpermuted column index */
2655         if (riip[i] >= k){ /* only take upper triangular entry */
2656           ajtmp[ncols_upper] = i;
2657           ncols_upper++;
2658         }
2659       }
2660       ierr = PetscIncompleteLLInit(ncols_upper,ajtmp,am,riip,nlnk,lnk,lnk_lvl,lnkbt);CHKERRQ(ierr);
2661       nzk += nlnk;
2662 
2663       /* update lnk by computing fill-in for each pivot row to be merged in */
2664       prow = jl[k]; /* 1st pivot row */
2665 
2666       while (prow < k){
2667         nextprow = jl[prow];
2668 
2669         /* merge prow into k-th row */
2670         jmin = il[prow] + 1;  /* index of the 2nd nzero entry in U(prow,k:am-1) */
2671         jmax = ui[prow+1];
2672         ncols = jmax-jmin;
2673         i     = jmin - ui[prow];
2674         cols  = uj_ptr[prow] + i; /* points to the 2nd nzero entry in U(prow,k:am-1) */
2675         uj    = uj_lvl_ptr[prow] + i; /* levels of cols */
2676         j     = *(uj - 1);
2677         ierr = PetscICCLLAddSorted(ncols,cols,levels,uj,am,nlnk,lnk,lnk_lvl,lnkbt,j);CHKERRQ(ierr);
2678         nzk += nlnk;
2679 
2680         /* update il and jl for prow */
2681         if (jmin < jmax){
2682           il[prow] = jmin;
2683           j = *cols; jl[prow] = jl[j]; jl[j] = prow;
2684         }
2685         prow = nextprow;
2686       }
2687 
2688       /* if free space is not available, make more free space */
2689       if (current_space->local_remaining<nzk) {
2690         i = am - k + 1; /* num of unfactored rows */
2691         i = PetscMin(i*nzk, i*(i-1)); /* i*nzk, i*(i-1): estimated and max additional space needed */
2692         ierr = PetscFreeSpaceGet(i,&current_space);CHKERRQ(ierr);
2693         ierr = PetscFreeSpaceGet(i,&current_space_lvl);CHKERRQ(ierr);
2694         reallocs++;
2695       }
2696 
2697       /* copy data into free_space and free_space_lvl, then initialize lnk */
2698       if (nzk == 0) SETERRQ1(PETSC_ERR_ARG_WRONG,"Empty row %D in ICC matrix factor",k);
2699       ierr = PetscIncompleteLLClean(am,am,nzk,lnk,lnk_lvl,current_space->array,current_space_lvl->array,lnkbt);CHKERRQ(ierr);
2700 
2701       /* add the k-th row into il and jl */
2702       if (nzk > 1){
2703         i = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:am-1) */
2704         jl[k] = jl[i]; jl[i] = k;
2705         il[k] = ui[k] + 1;
2706       }
2707       uj_ptr[k]     = current_space->array;
2708       uj_lvl_ptr[k] = current_space_lvl->array;
2709 
2710       current_space->array           += nzk;
2711       current_space->local_used      += nzk;
2712       current_space->local_remaining -= nzk;
2713 
2714       current_space_lvl->array           += nzk;
2715       current_space_lvl->local_used      += nzk;
2716       current_space_lvl->local_remaining -= nzk;
2717 
2718       ui[k+1] = ui[k] + nzk;
2719     }
2720 
2721 #if defined(PETSC_USE_INFO)
2722     if (ai[am] != 0) {
2723       PetscReal af = (PetscReal)ui[am]/((PetscReal)ai[am]);
2724       ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,fill,af);CHKERRQ(ierr);
2725       ierr = PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);CHKERRQ(ierr);
2726       ierr = PetscInfo1(A,"PCFactorSetFill(pc,%G) for best performance.\n",af);CHKERRQ(ierr);
2727     } else {
2728       ierr = PetscInfo(A,"Empty matrix.\n");CHKERRQ(ierr);
2729     }
2730 #endif
2731 
2732     ierr = ISRestoreIndices(perm,&rip);CHKERRQ(ierr);
2733     ierr = ISRestoreIndices(iperm,&riip);CHKERRQ(ierr);
2734     ierr = PetscFree(jl);CHKERRQ(ierr);
2735     ierr = PetscFree(ajtmp);CHKERRQ(ierr);
2736 
2737     /* destroy list of free space and other temporary array(s) */
2738     ierr = PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);CHKERRQ(ierr);
2739     ierr = PetscFreeSpaceContiguous_Cholesky(&free_space,uj,am,ui,udiag);CHKERRQ(ierr);
2740     ierr = PetscIncompleteLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
2741     ierr = PetscFreeSpaceDestroy(free_space_lvl);CHKERRQ(ierr);
2742 
2743   } /* end of case: levels>0 || (levels=0 && !perm_identity) */
2744 
2745   /* put together the new matrix in MATSEQSBAIJ format */
2746 
2747   b    = (Mat_SeqSBAIJ*)(fact)->data;
2748   b->singlemalloc = PETSC_FALSE;
2749   ierr = PetscMalloc((ui[am]+1)*sizeof(MatScalar),&b->a);CHKERRQ(ierr);
2750   b->j    = uj;
2751   b->i    = ui;
2752   b->diag = udiag;
2753   b->free_diag = PETSC_TRUE;
2754   b->ilen = 0;
2755   b->imax = 0;
2756   b->row  = perm;
2757   b->col  = perm;
2758   ierr    = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
2759   ierr    = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
2760   b->icol = iperm;
2761   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */
2762   ierr    = PetscMalloc((am+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
2763   ierr = PetscLogObjectMemory((fact),(ui[am]-am)*(sizeof(PetscInt)+sizeof(MatScalar)));CHKERRQ(ierr);
2764   b->maxnz   = b->nz = ui[am];
2765   b->free_a  = PETSC_TRUE;
2766   b->free_ij = PETSC_TRUE;
2767 
2768   (fact)->info.factor_mallocs    = reallocs;
2769   (fact)->info.fill_ratio_given  = fill;
2770   if (ai[am] != 0) {
2771     (fact)->info.fill_ratio_needed = ((PetscReal)ui[am])/((PetscReal)ai[am]);
2772   } else {
2773     (fact)->info.fill_ratio_needed = 0.0;
2774   }
2775   (fact)->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqAIJ_newdatastruct;
2776   PetscFunctionReturn(0);
2777 }
2778 
2779 #undef __FUNCT__
2780 #define __FUNCT__ "MatICCFactorSymbolic_SeqAIJ"
2781 PetscErrorCode MatICCFactorSymbolic_SeqAIJ(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
2782 {
2783   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data;
2784   Mat_SeqSBAIJ       *b;
2785   PetscErrorCode     ierr;
2786   PetscTruth         perm_identity,missing;
2787   PetscInt           reallocs=0,i,*ai=a->i,*aj=a->j,am=A->rmap->n,*ui,*udiag;
2788   const PetscInt     *rip,*riip;
2789   PetscInt           jmin,jmax,nzk,k,j,*jl,prow,*il,nextprow;
2790   PetscInt           nlnk,*lnk,*lnk_lvl=PETSC_NULL,d;
2791   PetscInt           ncols,ncols_upper,*cols,*ajtmp,*uj,**uj_ptr,**uj_lvl_ptr;
2792   PetscReal          fill=info->fill,levels=info->levels;
2793   PetscFreeSpaceList free_space=PETSC_NULL,current_space=PETSC_NULL;
2794   PetscFreeSpaceList free_space_lvl=PETSC_NULL,current_space_lvl=PETSC_NULL;
2795   PetscBT            lnkbt;
2796   IS                 iperm;
2797   PetscTruth         newdatastruct=PETSC_FALSE;
2798 
2799   PetscFunctionBegin;
2800   ierr = PetscOptionsGetTruth(PETSC_NULL,"-icc_new",&newdatastruct,PETSC_NULL);CHKERRQ(ierr);
2801   if(newdatastruct){
2802     ierr = MatICCFactorSymbolic_SeqAIJ_newdatastruct(fact,A,perm,info);CHKERRQ(ierr);
2803     PetscFunctionReturn(0);
2804   }
2805 
2806   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
2807   ierr = MatMissingDiagonal(A,&missing,&d);CHKERRQ(ierr);
2808   if (missing) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",d);
2809   ierr = ISIdentity(perm,&perm_identity);CHKERRQ(ierr);
2810   ierr = ISInvertPermutation(perm,PETSC_DECIDE,&iperm);CHKERRQ(ierr);
2811 
2812   ierr = PetscMalloc((am+1)*sizeof(PetscInt),&ui);CHKERRQ(ierr);
2813   ierr = PetscMalloc((am+1)*sizeof(PetscInt),&udiag);CHKERRQ(ierr);
2814   ui[0] = 0;
2815 
2816   /* ICC(0) without matrix ordering: simply copies fill pattern */
2817   if (!levels && perm_identity) {
2818 
2819     for (i=0; i<am; i++) {
2820       ui[i+1]  = ui[i] + ai[i+1] - a->diag[i];
2821       udiag[i] = ui[i];
2822     }
2823     ierr = PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);CHKERRQ(ierr);
2824     cols = uj;
2825     for (i=0; i<am; i++) {
2826       aj    = a->j + a->diag[i];
2827       ncols = ui[i+1] - ui[i];
2828       for (j=0; j<ncols; j++) *cols++ = *aj++;
2829     }
2830   } else { /* case: levels>0 || (levels=0 && !perm_identity) */
2831     ierr = ISGetIndices(iperm,&riip);CHKERRQ(ierr);
2832     ierr = ISGetIndices(perm,&rip);CHKERRQ(ierr);
2833 
2834     /* initialization */
2835     ierr  = PetscMalloc((am+1)*sizeof(PetscInt),&ajtmp);CHKERRQ(ierr);
2836 
2837     /* jl: linked list for storing indices of the pivot rows
2838        il: il[i] points to the 1st nonzero entry of U(i,k:am-1) */
2839     ierr = PetscMalloc((2*am+1)*sizeof(PetscInt)+2*am*sizeof(PetscInt**),&jl);CHKERRQ(ierr);
2840     il         = jl + am;
2841     uj_ptr     = (PetscInt**)(il + am);
2842     uj_lvl_ptr = (PetscInt**)(uj_ptr + am);
2843     for (i=0; i<am; i++){
2844       jl[i] = am; il[i] = 0;
2845     }
2846 
2847     /* create and initialize a linked list for storing column indices of the active row k */
2848     nlnk = am + 1;
2849     ierr = PetscIncompleteLLCreate(am,am,nlnk,lnk,lnk_lvl,lnkbt);CHKERRQ(ierr);
2850 
2851     /* initial FreeSpace size is fill*(ai[am]+1) */
2852     ierr = PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+1)),&free_space);CHKERRQ(ierr);
2853     current_space = free_space;
2854     ierr = PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+1)),&free_space_lvl);CHKERRQ(ierr);
2855     current_space_lvl = free_space_lvl;
2856 
2857     for (k=0; k<am; k++){  /* for each active row k */
2858       /* initialize lnk by the column indices of row rip[k] of A */
2859       nzk   = 0;
2860       ncols = ai[rip[k]+1] - ai[rip[k]];
2861       if (!ncols) SETERRQ2(PETSC_ERR_MAT_CH_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",rip[k],k);
2862       ncols_upper = 0;
2863       for (j=0; j<ncols; j++){
2864         i = *(aj + ai[rip[k]] + j); /* unpermuted column index */
2865         if (riip[i] >= k){ /* only take upper triangular entry */
2866           ajtmp[ncols_upper] = i;
2867           ncols_upper++;
2868         }
2869       }
2870       ierr = PetscIncompleteLLInit(ncols_upper,ajtmp,am,riip,nlnk,lnk,lnk_lvl,lnkbt);CHKERRQ(ierr);
2871       nzk += nlnk;
2872 
2873       /* update lnk by computing fill-in for each pivot row to be merged in */
2874       prow = jl[k]; /* 1st pivot row */
2875 
2876       while (prow < k){
2877         nextprow = jl[prow];
2878 
2879         /* merge prow into k-th row */
2880         jmin = il[prow] + 1;  /* index of the 2nd nzero entry in U(prow,k:am-1) */
2881         jmax = ui[prow+1];
2882         ncols = jmax-jmin;
2883         i     = jmin - ui[prow];
2884         cols  = uj_ptr[prow] + i; /* points to the 2nd nzero entry in U(prow,k:am-1) */
2885         uj    = uj_lvl_ptr[prow] + i; /* levels of cols */
2886         j     = *(uj - 1);
2887         ierr = PetscICCLLAddSorted(ncols,cols,levels,uj,am,nlnk,lnk,lnk_lvl,lnkbt,j);CHKERRQ(ierr);
2888         nzk += nlnk;
2889 
2890         /* update il and jl for prow */
2891         if (jmin < jmax){
2892           il[prow] = jmin;
2893           j = *cols; jl[prow] = jl[j]; jl[j] = prow;
2894         }
2895         prow = nextprow;
2896       }
2897 
2898       /* if free space is not available, make more free space */
2899       if (current_space->local_remaining<nzk) {
2900         i = am - k + 1; /* num of unfactored rows */
2901         i = PetscMin(i*nzk, i*(i-1)); /* i*nzk, i*(i-1): estimated and max additional space needed */
2902         ierr = PetscFreeSpaceGet(i,&current_space);CHKERRQ(ierr);
2903         ierr = PetscFreeSpaceGet(i,&current_space_lvl);CHKERRQ(ierr);
2904         reallocs++;
2905       }
2906 
2907       /* copy data into free_space and free_space_lvl, then initialize lnk */
2908       if (nzk == 0) SETERRQ1(PETSC_ERR_ARG_WRONG,"Empty row %D in ICC matrix factor",k);
2909       ierr = PetscIncompleteLLClean(am,am,nzk,lnk,lnk_lvl,current_space->array,current_space_lvl->array,lnkbt);CHKERRQ(ierr);
2910 
2911       /* add the k-th row into il and jl */
2912       if (nzk > 1){
2913         i = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:am-1) */
2914         jl[k] = jl[i]; jl[i] = k;
2915         il[k] = ui[k] + 1;
2916       }
2917       uj_ptr[k]     = current_space->array;
2918       uj_lvl_ptr[k] = current_space_lvl->array;
2919 
2920       current_space->array           += nzk;
2921       current_space->local_used      += nzk;
2922       current_space->local_remaining -= nzk;
2923 
2924       current_space_lvl->array           += nzk;
2925       current_space_lvl->local_used      += nzk;
2926       current_space_lvl->local_remaining -= nzk;
2927 
2928       ui[k+1] = ui[k] + nzk;
2929     }
2930 
2931 #if defined(PETSC_USE_INFO)
2932     if (ai[am] != 0) {
2933       PetscReal af = (PetscReal)ui[am]/((PetscReal)ai[am]);
2934       ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,fill,af);CHKERRQ(ierr);
2935       ierr = PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);CHKERRQ(ierr);
2936       ierr = PetscInfo1(A,"PCFactorSetFill(pc,%G) for best performance.\n",af);CHKERRQ(ierr);
2937     } else {
2938       ierr = PetscInfo(A,"Empty matrix.\n");CHKERRQ(ierr);
2939     }
2940 #endif
2941 
2942     ierr = ISRestoreIndices(perm,&rip);CHKERRQ(ierr);
2943     ierr = ISRestoreIndices(iperm,&riip);CHKERRQ(ierr);
2944     ierr = PetscFree(jl);CHKERRQ(ierr);
2945     ierr = PetscFree(ajtmp);CHKERRQ(ierr);
2946 
2947     /* destroy list of free space and other temporary array(s) */
2948     ierr = PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);CHKERRQ(ierr);
2949     ierr = PetscFreeSpaceContiguous(&free_space,uj);CHKERRQ(ierr);
2950     ierr = PetscIncompleteLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
2951     ierr = PetscFreeSpaceDestroy(free_space_lvl);CHKERRQ(ierr);
2952 
2953   } /* end of case: levels>0 || (levels=0 && !perm_identity) */
2954 
2955   /* put together the new matrix in MATSEQSBAIJ format */
2956 
2957   b    = (Mat_SeqSBAIJ*)(fact)->data;
2958   b->singlemalloc = PETSC_FALSE;
2959   ierr = PetscMalloc((ui[am]+1)*sizeof(MatScalar),&b->a);CHKERRQ(ierr);
2960   b->j    = uj;
2961   b->i    = ui;
2962   b->diag = udiag;
2963   b->free_diag = PETSC_TRUE;
2964   b->ilen = 0;
2965   b->imax = 0;
2966   b->row  = perm;
2967   b->col  = perm;
2968   ierr    = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
2969   ierr    = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
2970   b->icol = iperm;
2971   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */
2972   ierr    = PetscMalloc((am+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
2973   ierr = PetscLogObjectMemory((fact),(ui[am]-am)*(sizeof(PetscInt)+sizeof(MatScalar)));CHKERRQ(ierr);
2974   b->maxnz   = b->nz = ui[am];
2975   b->free_a  = PETSC_TRUE;
2976   b->free_ij = PETSC_TRUE;
2977 
2978   (fact)->info.factor_mallocs    = reallocs;
2979   (fact)->info.fill_ratio_given  = fill;
2980   if (ai[am] != 0) {
2981     (fact)->info.fill_ratio_needed = ((PetscReal)ui[am])/((PetscReal)ai[am]);
2982   } else {
2983     (fact)->info.fill_ratio_needed = 0.0;
2984   }
2985   (fact)->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqAIJ;
2986   PetscFunctionReturn(0);
2987 }
2988 
2989 #undef __FUNCT__
2990 #define __FUNCT__ "MatCholeskyFactorSymbolic_SeqAIJ"
2991 PetscErrorCode MatCholeskyFactorSymbolic_SeqAIJ(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
2992 {
2993   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data;
2994   Mat_SeqSBAIJ       *b;
2995   PetscErrorCode     ierr;
2996   PetscTruth         perm_identity;
2997   PetscReal          fill = info->fill;
2998   const PetscInt     *rip,*riip;
2999   PetscInt           i,am=A->rmap->n,*ai=a->i,*aj=a->j,reallocs=0,prow;
3000   PetscInt           *jl,jmin,jmax,nzk,*ui,k,j,*il,nextprow;
3001   PetscInt           nlnk,*lnk,ncols,ncols_upper,*cols,*uj,**ui_ptr,*uj_ptr;
3002   PetscFreeSpaceList free_space=PETSC_NULL,current_space=PETSC_NULL;
3003   PetscBT            lnkbt;
3004   IS                 iperm;
3005 
3006   PetscFunctionBegin;
3007   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
3008   /* check whether perm is the identity mapping */
3009   ierr = ISIdentity(perm,&perm_identity);CHKERRQ(ierr);
3010   ierr = ISInvertPermutation(perm,PETSC_DECIDE,&iperm);CHKERRQ(ierr);
3011   ierr = ISGetIndices(iperm,&riip);CHKERRQ(ierr);
3012   ierr = ISGetIndices(perm,&rip);CHKERRQ(ierr);
3013 
3014   /* initialization */
3015   ierr  = PetscMalloc((am+1)*sizeof(PetscInt),&ui);CHKERRQ(ierr);
3016   ui[0] = 0;
3017 
3018   /* jl: linked list for storing indices of the pivot rows
3019      il: il[i] points to the 1st nonzero entry of U(i,k:am-1) */
3020   ierr = PetscMalloc((3*am+1)*sizeof(PetscInt)+am*sizeof(PetscInt**),&jl);CHKERRQ(ierr);
3021   il     = jl + am;
3022   cols   = il + am;
3023   ui_ptr = (PetscInt**)(cols + am);
3024   for (i=0; i<am; i++){
3025     jl[i] = am; il[i] = 0;
3026   }
3027 
3028   /* create and initialize a linked list for storing column indices of the active row k */
3029   nlnk = am + 1;
3030   ierr = PetscLLCreate(am,am,nlnk,lnk,lnkbt);CHKERRQ(ierr);
3031 
3032   /* initial FreeSpace size is fill*(ai[am]+1) */
3033   ierr = PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+1)),&free_space);CHKERRQ(ierr);
3034   current_space = free_space;
3035 
3036   for (k=0; k<am; k++){  /* for each active row k */
3037     /* initialize lnk by the column indices of row rip[k] of A */
3038     nzk   = 0;
3039     ncols = ai[rip[k]+1] - ai[rip[k]];
3040     if (!ncols) SETERRQ2(PETSC_ERR_MAT_CH_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",rip[k],k);
3041     ncols_upper = 0;
3042     for (j=0; j<ncols; j++){
3043       i = riip[*(aj + ai[rip[k]] + j)];
3044       if (i >= k){ /* only take upper triangular entry */
3045         cols[ncols_upper] = i;
3046         ncols_upper++;
3047       }
3048     }
3049     ierr = PetscLLAdd(ncols_upper,cols,am,nlnk,lnk,lnkbt);CHKERRQ(ierr);
3050     nzk += nlnk;
3051 
3052     /* update lnk by computing fill-in for each pivot row to be merged in */
3053     prow = jl[k]; /* 1st pivot row */
3054 
3055     while (prow < k){
3056       nextprow = jl[prow];
3057       /* merge prow into k-th row */
3058       jmin = il[prow] + 1;  /* index of the 2nd nzero entry in U(prow,k:am-1) */
3059       jmax = ui[prow+1];
3060       ncols = jmax-jmin;
3061       uj_ptr = ui_ptr[prow] + jmin - ui[prow]; /* points to the 2nd nzero entry in U(prow,k:am-1) */
3062       ierr = PetscLLAddSorted(ncols,uj_ptr,am,nlnk,lnk,lnkbt);CHKERRQ(ierr);
3063       nzk += nlnk;
3064 
3065       /* update il and jl for prow */
3066       if (jmin < jmax){
3067         il[prow] = jmin;
3068         j = *uj_ptr; jl[prow] = jl[j]; jl[j] = prow;
3069       }
3070       prow = nextprow;
3071     }
3072 
3073     /* if free space is not available, make more free space */
3074     if (current_space->local_remaining<nzk) {
3075       i = am - k + 1; /* num of unfactored rows */
3076       i = PetscMin(i*nzk, i*(i-1)); /* i*nzk, i*(i-1): estimated and max additional space needed */
3077       ierr = PetscFreeSpaceGet(i,&current_space);CHKERRQ(ierr);
3078       reallocs++;
3079     }
3080 
3081     /* copy data into free space, then initialize lnk */
3082     ierr = PetscLLClean(am,am,nzk,lnk,current_space->array,lnkbt);CHKERRQ(ierr);
3083 
3084     /* add the k-th row into il and jl */
3085     if (nzk-1 > 0){
3086       i = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:am-1) */
3087       jl[k] = jl[i]; jl[i] = k;
3088       il[k] = ui[k] + 1;
3089     }
3090     ui_ptr[k] = current_space->array;
3091     current_space->array           += nzk;
3092     current_space->local_used      += nzk;
3093     current_space->local_remaining -= nzk;
3094 
3095     ui[k+1] = ui[k] + nzk;
3096   }
3097 
3098 #if defined(PETSC_USE_INFO)
3099   if (ai[am] != 0) {
3100     PetscReal af = (PetscReal)(ui[am])/((PetscReal)ai[am]);
3101     ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,fill,af);CHKERRQ(ierr);
3102     ierr = PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);CHKERRQ(ierr);
3103     ierr = PetscInfo1(A,"PCFactorSetFill(pc,%G) for best performance.\n",af);CHKERRQ(ierr);
3104   } else {
3105      ierr = PetscInfo(A,"Empty matrix.\n");CHKERRQ(ierr);
3106   }
3107 #endif
3108 
3109   ierr = ISRestoreIndices(perm,&rip);CHKERRQ(ierr);
3110   ierr = ISRestoreIndices(iperm,&riip);CHKERRQ(ierr);
3111   ierr = PetscFree(jl);CHKERRQ(ierr);
3112 
3113   /* destroy list of free space and other temporary array(s) */
3114   ierr = PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);CHKERRQ(ierr);
3115   ierr = PetscFreeSpaceContiguous(&free_space,uj);CHKERRQ(ierr);
3116   ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
3117 
3118   /* put together the new matrix in MATSEQSBAIJ format */
3119 
3120   b = (Mat_SeqSBAIJ*)(fact)->data;
3121   b->singlemalloc = PETSC_FALSE;
3122   b->free_a       = PETSC_TRUE;
3123   b->free_ij      = PETSC_TRUE;
3124   ierr = PetscMalloc((ui[am]+1)*sizeof(MatScalar),&b->a);CHKERRQ(ierr);
3125   b->j    = uj;
3126   b->i    = ui;
3127   b->diag = 0;
3128   b->ilen = 0;
3129   b->imax = 0;
3130   b->row  = perm;
3131   b->col  = perm;
3132   ierr    = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
3133   ierr    = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
3134   b->icol = iperm;
3135   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */
3136   ierr    = PetscMalloc((am+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
3137   ierr    = PetscLogObjectMemory(fact,(ui[am]-am)*(sizeof(PetscInt)+sizeof(MatScalar)));CHKERRQ(ierr);
3138   b->maxnz = b->nz = ui[am];
3139 
3140   (fact)->info.factor_mallocs    = reallocs;
3141   (fact)->info.fill_ratio_given  = fill;
3142   if (ai[am] != 0) {
3143     (fact)->info.fill_ratio_needed = ((PetscReal)ui[am])/((PetscReal)ai[am]);
3144   } else {
3145     (fact)->info.fill_ratio_needed = 0.0;
3146   }
3147   (fact)->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqAIJ;
3148   PetscFunctionReturn(0);
3149 }
3150 
3151 #undef __FUNCT__
3152 #define __FUNCT__ "MatSolve_SeqAIJ_NaturalOrdering_newdatastruct"
3153 PetscErrorCode MatSolve_SeqAIJ_NaturalOrdering_newdatastruct(Mat A,Vec bb,Vec xx)
3154 {
3155   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
3156   PetscErrorCode    ierr;
3157   PetscInt          n = A->rmap->n;
3158   const PetscInt    *ai = a->i,*aj = a->j,*vi;
3159   PetscScalar       *x,sum;
3160   const PetscScalar *b;
3161   const MatScalar   *aa = a->a,*v;
3162   PetscInt          i,nz;
3163 
3164   PetscFunctionBegin;
3165   if (!n) PetscFunctionReturn(0);
3166 
3167   ierr = VecGetArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
3168   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
3169 
3170   /* forward solve the lower triangular */
3171   x[0] = b[0];
3172   v    = aa;
3173   vi   = aj;
3174   for (i=1; i<n; i++) {
3175     nz  = ai[i+1] - ai[i];
3176     sum = b[i];
3177     PetscSparseDenseMinusDot(sum,x,v,vi,nz);
3178     v  += nz;
3179     vi += nz;
3180     x[i] = sum;
3181   }
3182 
3183   /* backward solve the upper triangular */
3184   v   = aa + ai[n+1];
3185   vi  = aj + ai[n+1];
3186   for (i=n-1; i>=0; i--){
3187     nz = ai[2*n-i +1] - ai[2*n-i]-1;
3188     sum = x[i];
3189     PetscSparseDenseMinusDot(sum,x,v,vi,nz);
3190     v   += nz;
3191     vi  += nz; vi++;
3192     x[i] = *v++ *sum; /* x[i]=aa[adiag[i]]*sum; v++; */
3193   }
3194 
3195   ierr = PetscLogFlops(2.0*a->nz - A->cmap->n);CHKERRQ(ierr);
3196   ierr = VecRestoreArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
3197   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
3198   PetscFunctionReturn(0);
3199 }
3200 
3201 #undef __FUNCT__
3202 #define __FUNCT__ "MatSolve_SeqAIJ_NaturalOrdering_newdatastruct_v2"
3203 PetscErrorCode MatSolve_SeqAIJ_NaturalOrdering_newdatastruct_v2(Mat A,Vec bb,Vec xx)
3204 {
3205   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
3206   PetscErrorCode    ierr;
3207   PetscInt          n = A->rmap->n;
3208   const PetscInt    *ai = a->i,*aj = a->j,*adiag = a->diag,*vi;
3209   PetscScalar       *x,sum;
3210   const PetscScalar *b;
3211   const MatScalar   *aa = a->a,*v;
3212   PetscInt          i,nz;
3213 
3214   PetscFunctionBegin;
3215   if (!n) PetscFunctionReturn(0);
3216 
3217   ierr = VecGetArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
3218   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
3219 
3220   /* forward solve the lower triangular */
3221   x[0] = b[0];
3222   v    = aa;
3223   vi   = aj;
3224   for (i=1; i<n; i++) {
3225     nz  = ai[i+1] - ai[i];
3226     sum = b[i];
3227     PetscSparseDenseMinusDot(sum,x,v,vi,nz);
3228     v  += nz;
3229     vi += nz;
3230     x[i] = sum;
3231   }
3232 
3233   /* backward solve the upper triangular */
3234   /*  v   = aa + ai[n+1];
3235       vi  = aj + ai[n+1]; */
3236   v  = aa + adiag[n-1];
3237   vi = aj + adiag[n-1];
3238   for (i=n-1; i>=0; i--){
3239     nz = adiag[i] - adiag[i+1]-1;
3240     sum = x[i];
3241     PetscSparseDenseMinusDot(sum,x,v,vi,nz);
3242     v   += nz;
3243     vi  += nz; vi++;
3244     x[i] = *v++ *sum; /* x[i]=aa[adiag[i]]*sum; v++; */
3245   }
3246 
3247   ierr = PetscLogFlops(2.0*a->nz - A->cmap->n);CHKERRQ(ierr);
3248   ierr = VecRestoreArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
3249   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
3250   PetscFunctionReturn(0);
3251 }
3252 
3253 #undef __FUNCT__
3254 #define __FUNCT__ "MatSolve_SeqAIJ_newdatastruct"
3255 PetscErrorCode MatSolve_SeqAIJ_newdatastruct(Mat A,Vec bb,Vec xx)
3256 {
3257   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
3258   IS                iscol = a->col,isrow = a->row;
3259   PetscErrorCode    ierr;
3260   PetscInt          i,n=A->rmap->n,*vi,*ai=a->i,*aj=a->j,nz,k;
3261   const PetscInt    *rout,*cout,*r,*c;
3262   PetscScalar       *x,*tmp,*tmps,sum;
3263   const PetscScalar *b;
3264   const MatScalar   *aa = a->a,*v;
3265 
3266   PetscFunctionBegin;
3267   if (!n) PetscFunctionReturn(0);
3268 
3269   ierr = VecGetArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
3270   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
3271   tmp  = a->solve_work;
3272 
3273   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
3274   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout;
3275 
3276   /* forward solve the lower triangular */
3277   tmp[0] = b[*r++];
3278   tmps   = tmp;
3279   v      = aa;
3280   vi     = aj;
3281   for (i=1; i<n; i++) {
3282     nz  = ai[i+1] - ai[i];
3283     sum = b[*r++];
3284     PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
3285     tmp[i] = sum;
3286     v += nz; vi += nz;
3287   }
3288 
3289   /* backward solve the upper triangular */
3290   k  = n+1;
3291   v  = aa + ai[k]; /* 1st entry of U(n-1,:) */
3292   vi = aj + ai[k];
3293   for (i=n-1; i>=0; i--){
3294     k  = 2*n-i;
3295     nz = ai[k +1] - ai[k] - 1;
3296     sum = tmp[i];
3297     PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
3298     x[c[i]] = tmp[i] = sum*v[nz]; /* v[nz] = aa[adiag[i]] */
3299     v += nz+1; vi += nz+1;
3300   }
3301 
3302   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
3303   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
3304   ierr = VecRestoreArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
3305   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
3306   ierr = PetscLogFlops(2*a->nz - A->cmap->n);CHKERRQ(ierr);
3307   PetscFunctionReturn(0);
3308 }
3309 
3310 #undef __FUNCT__
3311 #define __FUNCT__ "MatSolve_SeqAIJ_newdatastruct_v2"
3312 PetscErrorCode MatSolve_SeqAIJ_newdatastruct_v2(Mat A,Vec bb,Vec xx)
3313 {
3314   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
3315   IS                iscol = a->col,isrow = a->row;
3316   PetscErrorCode    ierr;
3317   PetscInt          i,n=A->rmap->n,*vi,*ai=a->i,*aj=a->j,*adiag = a->diag,nz;
3318   const PetscInt    *rout,*cout,*r,*c;
3319   PetscScalar       *x,*tmp,sum;
3320   const PetscScalar *b;
3321   const MatScalar   *aa = a->a,*v;
3322 
3323   PetscFunctionBegin;
3324   if (!n) PetscFunctionReturn(0);
3325 
3326   ierr = VecGetArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
3327   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
3328   tmp  = a->solve_work;
3329 
3330   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
3331   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout;
3332 
3333   /* forward solve the lower triangular */
3334   /*  tmp[0] = b[*r++]; */
3335   tmp[0] = b[r[0]];
3336   v      = aa;
3337   vi     = aj;
3338   for (i=1; i<n; i++) {
3339     nz  = ai[i+1] - ai[i];
3340     sum = b[r[i]];
3341     PetscSparseDenseMinusDot(sum,tmp,v,vi,nz);
3342     tmp[i] = sum;
3343     v += nz; vi += nz;
3344   }
3345 
3346   /* backward solve the upper triangular */
3347   /*  v  = aa + ai[k]; *//* 1st entry of U(n-1,:) */
3348   /* vi = aj + ai[k]; */
3349   v  = aa + adiag[n-1];
3350   vi = aj + adiag[n-1];
3351   for (i=n-1; i>=0; i--){
3352     /* nz = ai[k +1] - ai[k] - 1;*/
3353     nz = adiag[i]-adiag[i+1]-1;
3354     sum = tmp[i];
3355     PetscSparseDenseMinusDot(sum,tmp,v,vi,nz);
3356     x[c[i]] = tmp[i] = sum*v[nz]; /* v[nz] = aa[adiag[i]] */
3357     v += nz+1; vi += nz+1;
3358   }
3359 
3360   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
3361   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
3362   ierr = VecRestoreArray(bb,(PetscScalar**)&b);CHKERRQ(ierr);
3363   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
3364   ierr = PetscLogFlops(2*a->nz - A->cmap->n);CHKERRQ(ierr);
3365   PetscFunctionReturn(0);
3366 }
3367 
3368 #undef __FUNCT__
3369 #define __FUNCT__ "MatILUDTFactor_SeqAIJ"
3370 PetscErrorCode MatILUDTFactor_SeqAIJ(Mat A,IS isrow,IS iscol,const MatFactorInfo *info,Mat *fact)
3371 {
3372   Mat                B = *fact;
3373   Mat_SeqAIJ         *a=(Mat_SeqAIJ*)A->data,*b;
3374   IS                 isicol;
3375   PetscErrorCode     ierr;
3376   const PetscInt     *r,*ic;
3377   PetscInt           i,n=A->rmap->n,*ai=a->i,*aj=a->j,*ajtmp,*adiag;
3378   PetscInt           *bi,*bj,*bdiag,*bdiag_rev;
3379   PetscInt           row,nzi,nzi_bl,nzi_bu,*im,nzi_al,nzi_au;
3380   PetscInt           nlnk,*lnk;
3381   PetscBT            lnkbt;
3382   PetscTruth         row_identity,icol_identity,both_identity;
3383   MatScalar          *aatmp,*pv,*batmp,*ba,*rtmp,*pc,multiplier,*vtmp,diag_tmp;
3384   const PetscInt     *ics;
3385   PetscInt           j,nz,*pj,*bjtmp,k,ncut,*jtmp;
3386   PetscReal          dt=info->dt,dtcol=info->dtcol,shift=info->shiftinblocks;
3387   PetscInt           dtcount=(PetscInt)info->dtcount,nnz_max;
3388   PetscTruth         missing;
3389 
3390   PetscFunctionBegin;
3391 
3392   if (dt      == PETSC_DEFAULT) dt      = 0.005;
3393   if (dtcol   == PETSC_DEFAULT) dtcol   = 0.01; /* XXX unused! */
3394   if (dtcount == PETSC_DEFAULT) dtcount = (PetscInt)(1.5*a->rmax);
3395 
3396   /* ------- symbolic factorization, can be reused ---------*/
3397   ierr = MatMissingDiagonal(A,&missing,&i);CHKERRQ(ierr);
3398   if (missing) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",i);
3399   adiag=a->diag;
3400 
3401   ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr);
3402 
3403   /* bdiag is location of diagonal in factor */
3404   ierr = PetscMalloc((2*n+2)*sizeof(PetscInt),&bdiag);CHKERRQ(ierr);
3405   bdiag_rev = bdiag + n+1;
3406 
3407   /* allocate row pointers bi */
3408   ierr = PetscMalloc((2*n+2)*sizeof(PetscInt),&bi);CHKERRQ(ierr);
3409 
3410   /* allocate bj and ba; max num of nonzero entries is (ai[n]+2*n*dtcount+2) */
3411   if (dtcount > n-1) dtcount = n-1; /* diagonal is excluded */
3412   nnz_max  = ai[n]+2*n*dtcount+2;
3413 
3414   ierr = PetscMalloc((nnz_max+1)*sizeof(PetscInt),&bj);CHKERRQ(ierr);
3415   ierr = PetscMalloc((nnz_max+1)*sizeof(MatScalar),&ba);CHKERRQ(ierr);
3416 
3417   /* put together the new matrix */
3418   ierr = MatSeqAIJSetPreallocation_SeqAIJ(B,MAT_SKIP_ALLOCATION,PETSC_NULL);CHKERRQ(ierr);
3419   ierr = PetscLogObjectParent(B,isicol);CHKERRQ(ierr);
3420   b    = (Mat_SeqAIJ*)(B)->data;
3421   b->free_a       = PETSC_TRUE;
3422   b->free_ij      = PETSC_TRUE;
3423   b->singlemalloc = PETSC_FALSE;
3424   b->a          = ba;
3425   b->j          = bj;
3426   b->i          = bi;
3427   b->diag       = bdiag;
3428   b->ilen       = 0;
3429   b->imax       = 0;
3430   b->row        = isrow;
3431   b->col        = iscol;
3432   ierr          = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
3433   ierr          = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
3434   b->icol       = isicol;
3435   ierr = PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr);
3436 
3437   ierr = PetscLogObjectMemory(B,nnz_max*(sizeof(PetscInt)+sizeof(MatScalar)));CHKERRQ(ierr);
3438   b->maxnz = nnz_max;
3439 
3440   (B)->factor                = MAT_FACTOR_ILUDT;
3441   (B)->info.factor_mallocs   = 0;
3442   (B)->info.fill_ratio_given = ((PetscReal)nnz_max)/((PetscReal)ai[n]);
3443   CHKMEMQ;
3444   /* ------- end of symbolic factorization ---------*/
3445 
3446   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
3447   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
3448   ics  = ic;
3449 
3450   /* linked list for storing column indices of the active row */
3451   nlnk = n + 1;
3452   ierr = PetscLLCreate(n,n,nlnk,lnk,lnkbt);CHKERRQ(ierr);
3453 
3454   /* im: used by PetscLLAddSortedLU(); jtmp: working array for column indices of active row */
3455   ierr = PetscMalloc((2*n+1)*sizeof(PetscInt),&im);CHKERRQ(ierr);
3456   jtmp = im + n;
3457   /* rtmp, vtmp: working arrays for sparse and contiguous row entries of active row */
3458   ierr = PetscMalloc((2*n+1)*sizeof(MatScalar),&rtmp);CHKERRQ(ierr);
3459   ierr = PetscMemzero(rtmp,(n+1)*sizeof(PetscScalar));CHKERRQ(ierr);
3460   vtmp = rtmp + n;
3461 
3462   bi[0]    = 0;
3463   bdiag[0] = nnz_max-1; /* location of diag[0] in factor B */
3464   bdiag_rev[n] = bdiag[0];
3465   bi[2*n+1] = bdiag[0]+1; /* endof bj and ba array */
3466   for (i=0; i<n; i++) {
3467     /* copy initial fill into linked list */
3468     nzi = 0; /* nonzeros for active row i */
3469     nzi = ai[r[i]+1] - ai[r[i]];
3470     if (!nzi) SETERRQ2(PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
3471     nzi_al = adiag[r[i]] - ai[r[i]];
3472     nzi_au = ai[r[i]+1] - adiag[r[i]] -1;
3473     ajtmp = aj + ai[r[i]];
3474     ierr = PetscLLAddPerm(nzi,ajtmp,ic,n,nlnk,lnk,lnkbt);CHKERRQ(ierr);
3475 
3476     /* load in initial (unfactored row) */
3477     aatmp = a->a + ai[r[i]];
3478     for (j=0; j<nzi; j++) {
3479       rtmp[ics[*ajtmp++]] = *aatmp++;
3480     }
3481 
3482     /* add pivot rows into linked list */
3483     row = lnk[n];
3484     while (row < i ) {
3485       nzi_bl = bi[row+1] - bi[row] + 1;
3486       bjtmp = bj + bdiag[row+1]+1; /* points to 1st column next to the diagonal in U */
3487       ierr  = PetscLLAddSortedLU(bjtmp,row,nlnk,lnk,lnkbt,i,nzi_bl,im);CHKERRQ(ierr);
3488       nzi  += nlnk;
3489       row   = lnk[row];
3490     }
3491 
3492     /* copy data from lnk into jtmp, then initialize lnk */
3493     ierr = PetscLLClean(n,n,nzi,lnk,jtmp,lnkbt);CHKERRQ(ierr);
3494 
3495     /* numerical factorization */
3496     bjtmp = jtmp;
3497     row   = *bjtmp++; /* 1st pivot row */
3498     while  ( row < i ) {
3499       pc         = rtmp + row;
3500       pv         = ba + bdiag[row]; /* 1./(diag of the pivot row) */
3501       multiplier = (*pc) * (*pv);
3502       *pc        = multiplier;
3503       if (PetscAbsScalar(*pc) > dt){ /* apply tolerance dropping rule */
3504         pj         = bj + bdiag[row+1] + 1; /* point to 1st entry of U(row,:) */
3505         pv         = ba + bdiag[row+1] + 1;
3506         /* if (multiplier < -1.0 or multiplier >1.0) printf("row/prow %d, %d, multiplier %g\n",i,row,multiplier); */
3507         nz         = bdiag[row] - bdiag[row+1] - 1; /* num of entries in U(row,:), excluding diagonal */
3508         for (j=0; j<nz; j++) rtmp[*pj++] -= multiplier * (*pv++);
3509         ierr = PetscLogFlops(2.0*nz);CHKERRQ(ierr);
3510       }
3511       row = *bjtmp++;
3512     }
3513 
3514     /* copy sparse rtmp into contiguous vtmp; separate L and U part */
3515     diag_tmp = rtmp[i];  /* save diagonal value - may not needed?? */
3516     nzi_bl = 0; j = 0;
3517     while (jtmp[j] < i){ /* Note: jtmp is sorted */
3518       vtmp[j] = rtmp[jtmp[j]]; rtmp[jtmp[j]]=0.0;
3519       nzi_bl++; j++;
3520     }
3521     nzi_bu = nzi - nzi_bl -1;
3522     while (j < nzi){
3523       vtmp[j] = rtmp[jtmp[j]]; rtmp[jtmp[j]]=0.0;
3524       j++;
3525     }
3526 
3527     bjtmp = bj + bi[i];
3528     batmp = ba + bi[i];
3529     /* apply level dropping rule to L part */
3530     ncut = nzi_al + dtcount;
3531     if (ncut < nzi_bl){
3532       ierr = PetscSortSplit(ncut,nzi_bl,vtmp,jtmp);CHKERRQ(ierr);
3533       ierr = PetscSortIntWithScalarArray(ncut,jtmp,vtmp);CHKERRQ(ierr);
3534     } else {
3535       ncut = nzi_bl;
3536     }
3537     for (j=0; j<ncut; j++){
3538       bjtmp[j] = jtmp[j];
3539       batmp[j] = vtmp[j];
3540       /* printf(" (%d,%g),",bjtmp[j],batmp[j]); */
3541     }
3542     bi[i+1] = bi[i] + ncut;
3543     nzi = ncut + 1;
3544 
3545     /* apply level dropping rule to U part */
3546     ncut = nzi_au + dtcount;
3547     if (ncut < nzi_bu){
3548       ierr = PetscSortSplit(ncut,nzi_bu,vtmp+nzi_bl+1,jtmp+nzi_bl+1);CHKERRQ(ierr);
3549       ierr = PetscSortIntWithScalarArray(ncut,jtmp+nzi_bl+1,vtmp+nzi_bl+1);CHKERRQ(ierr);
3550     } else {
3551       ncut = nzi_bu;
3552     }
3553     nzi += ncut;
3554 
3555     /* mark bdiagonal */
3556     bdiag[i+1]       = bdiag[i] - (ncut + 1);
3557     bdiag_rev[n-i-1] = bdiag[i+1];
3558     bi[2*n - i]      = bi[2*n - i +1] - (ncut + 1);
3559     bjtmp = bj + bdiag[i];
3560     batmp = ba + bdiag[i];
3561     *bjtmp = i;
3562     *batmp = diag_tmp; /* rtmp[i]; */
3563     if (*batmp == 0.0) {
3564       *batmp = dt+shift;
3565       /* printf(" row %d add shift %g\n",i,shift); */
3566     }
3567     *batmp = 1.0/(*batmp); /* invert diagonal entries for simplier triangular solves */
3568     /* printf(" (%d,%g),",*bjtmp,*batmp); */
3569 
3570     bjtmp = bj + bdiag[i+1]+1;
3571     batmp = ba + bdiag[i+1]+1;
3572     for (k=0; k<ncut; k++){
3573       bjtmp[k] = jtmp[nzi_bl+1+k];
3574       batmp[k] = vtmp[nzi_bl+1+k];
3575       /* printf(" (%d,%g),",bjtmp[k],batmp[k]); */
3576     }
3577     /* printf("\n"); */
3578 
3579     im[i]   = nzi; /* used by PetscLLAddSortedLU() */
3580     /*
3581     printf("row %d: bi %d, bdiag %d\n",i,bi[i],bdiag[i]);
3582     printf(" ----------------------------\n");
3583     */
3584   } /* for (i=0; i<n; i++) */
3585   /* printf("end of L %d, beginning of U %d\n",bi[n],bdiag[n]); */
3586   if (bi[n] >= bdiag[n]) SETERRQ2(PETSC_ERR_ARG_SIZ,"end of L array %d cannot >= the beginning of U array %d",bi[n],bdiag[n]);
3587 
3588   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
3589   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
3590 
3591   ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
3592   ierr = PetscFree(im);CHKERRQ(ierr);
3593   ierr = PetscFree(rtmp);CHKERRQ(ierr);
3594 
3595   ierr = PetscLogFlops(B->cmap->n);CHKERRQ(ierr);
3596   b->maxnz = b->nz = bi[n] + bdiag[0] - bdiag[n];
3597 
3598   ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
3599   ierr = ISIdentity(isicol,&icol_identity);CHKERRQ(ierr);
3600   both_identity = (PetscTruth) (row_identity && icol_identity);
3601   if (row_identity && icol_identity) {
3602     B->ops->solve = MatSolve_SeqAIJ_NaturalOrdering_newdatastruct;
3603   } else {
3604     B->ops->solve = MatSolve_SeqAIJ_newdatastruct;
3605   }
3606 
3607   B->ops->lufactorsymbolic  = MatILUDTFactorSymbolic_SeqAIJ;
3608   B->ops->lufactornumeric   = MatILUDTFactorNumeric_SeqAIJ;
3609   B->ops->solveadd          = 0;
3610   B->ops->solvetranspose    = 0;
3611   B->ops->solvetransposeadd = 0;
3612   B->ops->matsolve          = 0;
3613   B->assembled              = PETSC_TRUE;
3614   B->preallocated           = PETSC_TRUE;
3615   PetscFunctionReturn(0);
3616 }
3617 
3618 /* a wraper of MatILUDTFactor_SeqAIJ() */
3619 #undef __FUNCT__
3620 #define __FUNCT__ "MatILUDTFactorSymbolic_SeqAIJ"
3621 PetscErrorCode PETSCMAT_DLLEXPORT MatILUDTFactorSymbolic_SeqAIJ(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info)
3622 {
3623   PetscErrorCode     ierr;
3624 
3625   PetscFunctionBegin;
3626   ierr = MatILUDTFactor_SeqAIJ(A,row,col,info,&fact);CHKERRQ(ierr);
3627 
3628   fact->ops->lufactornumeric = MatILUDTFactorNumeric_SeqAIJ;
3629   PetscFunctionReturn(0);
3630 }
3631 
3632 /*
3633    same as MatLUFactorNumeric_SeqAIJ(), except using contiguous array matrix factors
3634    - intend to replace existing MatLUFactorNumeric_SeqAIJ()
3635 */
3636 #undef __FUNCT__
3637 #define __FUNCT__ "MatILUDTFactorNumeric_SeqAIJ"
3638 PetscErrorCode PETSCMAT_DLLEXPORT MatILUDTFactorNumeric_SeqAIJ(Mat fact,Mat A,const MatFactorInfo *info)
3639 {
3640   Mat            C=fact;
3641   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data,*b=(Mat_SeqAIJ *)C->data;
3642   IS             isrow = b->row,isicol = b->icol;
3643   PetscErrorCode ierr;
3644   const PetscInt *r,*ic,*ics;
3645   PetscInt       i,j,k,n=A->rmap->n,*ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j;
3646   PetscInt       *ajtmp,*bjtmp,nz,nzl,nzu,row,*bdiag = b->diag,*pj;
3647   MatScalar      *rtmp,*pc,multiplier,*v,*pv,*aa=a->a;
3648   PetscReal      dt=info->dt,shift=info->shiftinblocks;
3649   PetscTruth     row_identity, col_identity;
3650 
3651   PetscFunctionBegin;
3652   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
3653   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
3654   ierr = PetscMalloc((n+1)*sizeof(MatScalar),&rtmp);CHKERRQ(ierr);
3655   ics  = ic;
3656 
3657   for (i=0; i<n; i++){
3658     /* initialize rtmp array */
3659     nzl   = bi[i+1] - bi[i];       /* num of nozeros in L(i,:) */
3660     bjtmp = bj + bi[i];
3661     for  (j=0; j<nzl; j++) rtmp[*bjtmp++] = 0.0;
3662     rtmp[i] = 0.0;
3663     nzu   = bdiag[i] - bdiag[i+1]; /* num of nozeros in U(i,:) */
3664     bjtmp = bj + bdiag[i+1] + 1;
3665     for  (j=0; j<nzu; j++) rtmp[*bjtmp++] = 0.0;
3666 
3667     /* load in initial unfactored row of A */
3668     /* printf("row %d\n",i); */
3669     nz    = ai[r[i]+1] - ai[r[i]];
3670     ajtmp = aj + ai[r[i]];
3671     v     = aa + ai[r[i]];
3672     for (j=0; j<nz; j++) {
3673       rtmp[ics[*ajtmp++]] = v[j];
3674       /* printf(" (%d,%g),",ics[ajtmp[j]],rtmp[ics[ajtmp[j]]]); */
3675     }
3676     /* printf("\n"); */
3677 
3678     /* numerical factorization */
3679     bjtmp = bj + bi[i]; /* point to 1st entry of L(i,:) */
3680     nzl   = bi[i+1] - bi[i]; /* num of entries in L(i,:) */
3681     k = 0;
3682     while (k < nzl){
3683       row   = *bjtmp++;
3684       /* printf("  prow %d\n",row); */
3685       pc         = rtmp + row;
3686       pv         = b->a + bdiag[row]; /* 1./(diag of the pivot row) */
3687       multiplier = (*pc) * (*pv);
3688       *pc        = multiplier;
3689       if (PetscAbsScalar(multiplier) > dt){
3690         pj         = bj + bdiag[row+1] + 1; /* point to 1st entry of U(row,:) */
3691         pv         = b->a + bdiag[row+1] + 1;
3692         nz         = bdiag[row] - bdiag[row+1] - 1; /* num of entries in U(row,:), excluding diagonal */
3693         for (j=0; j<nz; j++) rtmp[*pj++] -= multiplier * (*pv++);
3694         /* ierr = PetscLogFlops(2.0*nz);CHKERRQ(ierr); */
3695       }
3696       k++;
3697     }
3698 
3699     /* finished row so stick it into b->a */
3700     /* L-part */
3701     pv = b->a + bi[i] ;
3702     pj = bj + bi[i] ;
3703     nzl = bi[i+1] - bi[i];
3704     for (j=0; j<nzl; j++) {
3705       pv[j] = rtmp[pj[j]];
3706       /* printf(" (%d,%g),",pj[j],pv[j]); */
3707     }
3708 
3709     /* diagonal: invert diagonal entries for simplier triangular solves */
3710     if (rtmp[i] == 0.0) rtmp[i] = dt+shift;
3711     b->a[bdiag[i]] = 1.0/rtmp[i];
3712     /* printf(" (%d,%g),",i,b->a[bdiag[i]]); */
3713 
3714     /* U-part */
3715     pv = b->a + bdiag[i+1] + 1;
3716     pj = bj + bdiag[i+1] + 1;
3717     nzu = bdiag[i] - bdiag[i+1] - 1;
3718     for (j=0; j<nzu; j++) {
3719       pv[j] = rtmp[pj[j]];
3720       /* printf(" (%d,%g),",pj[j],pv[j]); */
3721     }
3722     /* printf("\n"); */
3723   }
3724 
3725   ierr = PetscFree(rtmp);CHKERRQ(ierr);
3726   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
3727   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
3728 
3729   ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
3730   ierr = ISIdentity(isicol,&col_identity);CHKERRQ(ierr);
3731   if (row_identity && col_identity) {
3732     C->ops->solve   = MatSolve_SeqAIJ_NaturalOrdering_newdatastruct;
3733   } else {
3734     C->ops->solve   = MatSolve_SeqAIJ_newdatastruct;
3735   }
3736   C->ops->solveadd           = 0;
3737   C->ops->solvetranspose     = 0;
3738   C->ops->solvetransposeadd  = 0;
3739   C->ops->matsolve           = 0;
3740   C->assembled    = PETSC_TRUE;
3741   C->preallocated = PETSC_TRUE;
3742   ierr = PetscLogFlops(C->cmap->n);CHKERRQ(ierr);
3743   PetscFunctionReturn(0);
3744 }
3745