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