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