xref: /petsc/src/mat/impls/aij/seq/aijfact.c (revision 5bd2ddc7c7c8e1ad3684545ca96f51813108f71c)
1 /*$Id: aijfact.c,v 1.136 1999/12/16 23:35:48 bsmith Exp bsmith $*/
2 
3 #include "src/mat/impls/aij/seq/aij.h"
4 #include "src/vec/vecimpl.h"
5 #include "src/inline/dot.h"
6 
7 #undef __FUNC__
8 #define __FUNC__ "MatOrdering_Flow_SeqAIJ"
9 int MatOrdering_Flow_SeqAIJ(Mat mat,MatOrderingType type,IS *irow,IS *icol)
10 {
11   PetscFunctionBegin;
12 
13   SETERRQ(PETSC_ERR_SUP,0,"Code not written");
14 #if !defined(PETSC_USE_DEBUG)
15   PetscFunctionReturn(0);
16 #endif
17 }
18 
19 
20 extern int MatMarkDiagonal_SeqAIJ(Mat);
21 extern int Mat_AIJ_CheckInode(Mat);
22 
23 extern int SPARSEKIT2dperm(int*,Scalar*,int*,int*,Scalar*,int*,int*,int*,int*,int*);
24 extern int SPARSEKIT2ilutp(int*,Scalar*,int*,int*,int*,double*,double*,int*,Scalar*,int*,int*,int*,Scalar*,int*,int*,int*);
25 extern int SPARSEKIT2msrcsr(int*,Scalar*,int*,Scalar*,int*,int*,Scalar*,int*);
26 
27 #undef __FUNC__
28 #define __FUNC__ "MatILUDTFactor_SeqAIJ"
29   /* ------------------------------------------------------------
30 
31           This interface was contribed by Tony Caola
32 
33      This routine is an interface to the pivoting drop-tolerance
34      ILU routine written by Yousef Saad (saad@cs.umn.edu) as part of
35      SPARSEKIT2.
36 
37      The SPARSEKIT2 routines used here are covered by the GNU
38      copyright; see the file gnu in this directory.
39 
40      Thanks to Prof. Saad, Dr. Hysom, and Dr. Smith for their
41      help in getting this routine ironed out.
42 
43      The major drawback to this routine is that if info->fill is
44      not large enough it fails rather than allocating more space;
45      this can be fixed by hacking/improving the f2c version of
46      Yousef Saad's code.
47 
48      ishift = 0, for indices start at 1
49      ishift = 1, for indices starting at 0
50      ------------------------------------------------------------
51   */
52 
53 int MatILUDTFactor_SeqAIJ(Mat A,MatILUInfo *info,IS isrow,IS iscol,Mat *fact)
54 {
55   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b;
56   IS         iscolf, isicol, isirow;
57   PetscTruth reorder;
58   int        *c,*r,*ic,ierr, i, n = a->m;
59   int        *old_i = a->i, *old_j = a->j, *new_i, *old_i2, *old_j2,*new_j;
60   int        *ordcol, *iwk,*iperm, *jw;
61   int        ishift = !a->indexshift;
62   int        jmax,lfill,job,*o_i,*o_j;
63   Scalar     *old_a = a->a, *w, *new_a, *old_a2, *wk,*o_a;
64   double     permtol;
65 
66   PetscFunctionBegin;
67 
68   if (info->dt == PETSC_DEFAULT)      info->dt      = .005;
69   if (info->dtcount == PETSC_DEFAULT) info->dtcount = (int) (1.5*a->rmax);
70   if (info->dtcol == PETSC_DEFAULT)   info->dtcol   = .01;
71   if (info->fill == PETSC_DEFAULT)    info->fill    = (n*info->dtcount)/a->nz;
72   lfill   = info->dtcount/2;
73   jmax    = info->fill*a->nz;
74   permtol = info->dtcol;
75 
76 
77   /* ------------------------------------------------------------
78      If reorder=.TRUE., then the original matrix has to be
79      reordered to reflect the user selected ordering scheme, and
80      then de-reordered so it is in it's original format.
81      Because Saad's dperm() is NOT in place, we have to copy
82      the original matrix and allocate more storage. . .
83      ------------------------------------------------------------
84   */
85 
86   /* set reorder to true if either isrow or iscol is not identity */
87   ierr = ISIdentity(isrow,&reorder);CHKERRQ(ierr);
88   if (reorder) {ierr = ISIdentity(iscol,&reorder);CHKERRQ(ierr);}
89   reorder = PetscNot(reorder);
90 
91 
92   /* storage for ilu factor */
93   new_i = (int *)    PetscMalloc((n+1)*sizeof(int));   CHKPTRQ(new_i);
94   new_j = (int *)    PetscMalloc(jmax*sizeof(int));    CHKPTRQ(new_j);
95   new_a = (Scalar *) PetscMalloc(jmax*sizeof(Scalar)); CHKPTRQ(new_a);
96 
97   ordcol = (int *) PetscMalloc(n*sizeof(int)); CHKPTRQ(ordcol);
98 
99   /* ------------------------------------------------------------
100      Make sure that everything is Fortran formatted (1-Based)
101      ------------------------------------------------------------
102   */
103   if (ishift) {
104     for (i=old_i[0];i<old_i[n];i++) {
105       old_j[i]++;
106     }
107     for(i=0;i<n+1;i++) {
108       old_i[i]++;
109     };
110   };
111 
112   if (reorder) {
113     ierr = ISGetIndices(iscol,&c);           CHKERRQ(ierr);
114     ierr = ISGetIndices(isrow,&r);           CHKERRQ(ierr);
115     for(i=0;i<n;i++) {
116       r[i]  = r[i]+1;
117       c[i]  = c[i]+1;
118     }
119     old_i2 = (int *) PetscMalloc((n+1)*sizeof(int)); CHKPTRQ(old_i2);
120     old_j2 = (int *) PetscMalloc((old_i[n]-old_i[0]+1)*sizeof(int)); CHKPTRQ(old_j2);
121     old_a2 = (Scalar *) PetscMalloc((old_i[n]-old_i[0]+1)*sizeof(Scalar));CHKPTRQ(old_a2);
122     job = 3; SPARSEKIT2dperm(&n,old_a,old_j,old_i,old_a2,old_j2,old_i2,r,c,&job);
123     for (i=0;i<n;i++) {
124       r[i]  = r[i]-1;
125       c[i]  = c[i]-1;
126     }
127     ierr = ISRestoreIndices(iscol,&c); CHKERRQ(ierr);
128     ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr);
129     o_a = old_a2;
130     o_j = old_j2;
131     o_i = old_i2;
132   } else {
133     o_a = old_a;
134     o_j = old_j;
135     o_i = old_i;
136   }
137 
138   /* ------------------------------------------------------------
139      Call Saad's ilutp() routine to generate the factorization
140      ------------------------------------------------------------
141   */
142 
143   iperm   = (int *)    PetscMalloc(2*n*sizeof(int)); CHKPTRQ(iperm);
144   jw      = (int *)    PetscMalloc(2*n*sizeof(int)); CHKPTRQ(jw);
145   w       = (Scalar *) PetscMalloc(n*sizeof(Scalar)); CHKPTRQ(w);
146 
147   SPARSEKIT2ilutp(&n,o_a,o_j,o_i,&lfill,&info->dt,&permtol,&n,new_a,new_j,new_i,&jmax,w,jw,iperm,&ierr);
148   if (ierr) {
149     switch (ierr) {
150       case -3: SETERRQ1(1,1,"ilutp(), matrix U overflows, need larger info->fill value %d",jmax);
151       case -2: SETERRQ1(1,1,"ilutp(), matrix L overflows, need larger info->fill value %d",jmax);
152       case -5: SETERRQ(1,1,"ilutp(), zero row encountered");
153       case -1: SETERRQ(1,1,"ilutp(), input matrix may be wrong");
154       case -4: SETERRQ1(1,1,"ilutp(), illegal info->fill value %d",jmax);
155       default: SETERRQ1(1,1,"ilutp(), zero pivot detected on row %d",ierr);
156     }
157   }
158 
159   ierr = PetscFree(w);CHKERRQ(ierr);
160   ierr = PetscFree(jw);CHKERRQ(ierr);
161 
162   /* ------------------------------------------------------------
163      Saad's routine gives the result in Modified Sparse Row (msr)
164      Convert to Compressed Sparse Row format (csr)
165      ------------------------------------------------------------
166   */
167 
168   wk  = (Scalar *)    PetscMalloc(n*sizeof(Scalar)); CHKPTRQ(wk);
169   iwk = (int *) PetscMalloc((n+1)*sizeof(int)); CHKPTRQ(iwk);
170 
171   SPARSEKIT2msrcsr(&n,new_a,new_j,new_a,new_j,new_i,wk,iwk);
172 
173   ierr = PetscFree(iwk);CHKERRQ(ierr);
174   ierr = PetscFree(wk);CHKERRQ(ierr);
175 
176   if (reorder) {
177     ierr = PetscFree(old_a2);CHKERRQ(ierr);
178     ierr = PetscFree(old_j2);CHKERRQ(ierr);
179     ierr = PetscFree(old_i2);CHKERRQ(ierr);
180   } else {
181     /* fix permutation of old_j that the factorization introduced */
182     for (i=old_i[0]; i<=old_i[n]; i++) {
183       old_j[i-1] = iperm[old_j[i-1]-1];
184     }
185   }
186 
187   /* get rid of the shift to indices starting at 1 */
188   if (ishift) {
189     for (i=0; i<n+1; i++) {
190       old_i[i]--;
191     }
192     for (i=old_i[0];i<old_i[n];i++) {
193       old_j[i]--;
194     }
195   }
196 
197   /* Make the factored matrix 0-based */
198   if (ishift) {
199     for (i=0; i<n+1; i++) {
200       new_i[i]--;
201     }
202     for (i=new_i[0];i<new_i[n];i++) {
203       new_j[i]--;
204     }
205   }
206 
207   /*-- due to the pivoting, we need to reorder iscol to correctly --*/
208   /*-- permute the right-hand-side and solution vectors           --*/
209   ierr = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr);
210   ierr = ISInvertPermutation(isrow,&isirow); CHKERRQ(ierr);
211   ierr = ISGetIndices(isicol,&ic);          CHKERRQ(ierr);
212   for(i=0; i<n; i++) {
213     ordcol[i] = ic[iperm[i]-1];
214   };
215   ierr = ISRestoreIndices(isicol,&ic); CHKERRQ(ierr);
216   ierr = ISDestroy(isicol);CHKERRQ(ierr);
217 
218   ierr = PetscFree(iperm);CHKERRQ(ierr);
219 
220   ierr = ISCreateGeneral(PETSC_COMM_SELF, n, ordcol, &iscolf);
221   ierr = PetscFree(ordcol);CHKERRQ(ierr);
222 
223   /*----- put together the new matrix -----*/
224 
225   ierr = MatCreateSeqAIJ(A->comm,n,n,0,PETSC_NULL,fact); CHKERRQ(ierr);
226   (*fact)->factor    = FACTOR_LU;
227   (*fact)->assembled = PETSC_TRUE;
228 
229   b = (Mat_SeqAIJ *) (*fact)->data;
230   ierr = PetscFree(b->imax);CHKERRQ(ierr);
231   b->sorted        = PETSC_FALSE;
232   b->singlemalloc  = PETSC_FALSE;
233   /* the next line frees the default space generated by the MatCreate() */
234   ierr             = PetscFree(b->a);CHKERRQ(ierr);
235   ierr             = PetscFree(b->ilen);CHKERRQ(ierr);
236   b->a             = new_a;
237   b->j             = new_j;
238   b->i             = new_i;
239   b->ilen          = 0;
240   b->imax          = 0;
241   /*  I am not sure why these are the inverses of the row and column permutations; but the other way is NO GOOD */
242   b->row           = isirow;
243   b->col           = iscolf;
244   b->solve_work    =  (Scalar *) PetscMalloc( (n+1)*sizeof(Scalar));CHKPTRQ(b->solve_work);
245   b->maxnz = b->nz = new_i[n];
246   b->indexshift    = a->indexshift;
247   ierr = MatMarkDiagonal_SeqAIJ(*fact);CHKERRQ(ierr);
248   (*fact)->info.factor_mallocs = 0;
249 
250   ierr = MatMarkDiagonal_SeqAIJ(A);CHKERRQ(ierr);
251 
252   /* check out for identical nodes. If found, use inode functions */
253   ierr = Mat_AIJ_CheckInode(*fact);CHKERRQ(ierr);
254 
255   PetscFunctionReturn(0);
256 }
257 
258 /*
259     Factorization code for AIJ format.
260 */
261 #undef __FUNC__
262 #define __FUNC__ "MatLUFactorSymbolic_SeqAIJ"
263 int MatLUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,double f,Mat *B)
264 {
265   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b;
266   IS         isicol;
267   int        *r,*ic, ierr, i, n = a->m, *ai = a->i, *aj = a->j;
268   int        *ainew,*ajnew, jmax,*fill, *ajtmp, nz,shift = a->indexshift;
269   int        *idnew, idx, row,m,fm, nnz, nzi, realloc = 0,nzbd,*im;
270 
271   PetscFunctionBegin;
272   PetscValidHeaderSpecific(isrow,IS_COOKIE);
273   PetscValidHeaderSpecific(iscol,IS_COOKIE);
274   if (A->M != A->N) SETERRQ(PETSC_ERR_ARG_WRONG,0,"matrix must be square");
275 
276   ierr = ISInvertPermutation(iscol,&isicol);CHKERRQ(ierr);
277   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
278   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
279 
280   /* get new row pointers */
281   ainew    = (int *) PetscMalloc( (n+1)*sizeof(int) );CHKPTRQ(ainew);
282   ainew[0] = -shift;
283   /* don't know how many column pointers are needed so estimate */
284   jmax  = (int) (f*ai[n]+(!shift));
285   ajnew = (int *) PetscMalloc( (jmax)*sizeof(int) );CHKPTRQ(ajnew);
286   /* fill is a linked list of nonzeros in active row */
287   fill = (int *) PetscMalloc( (2*n+1)*sizeof(int));CHKPTRQ(fill);
288   im   = fill + n + 1;
289   /* idnew is location of diagonal in factor */
290   idnew    = (int *) PetscMalloc( (n+1)*sizeof(int));CHKPTRQ(idnew);
291   idnew[0] = -shift;
292 
293   for ( i=0; i<n; i++ ) {
294     /* first copy previous fill into linked list */
295     nnz     = nz    = ai[r[i]+1] - ai[r[i]];
296     if (!nz) SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,1,"Empty row in matrix");
297     ajtmp   = aj + ai[r[i]] + shift;
298     fill[n] = n;
299     while (nz--) {
300       fm  = n;
301       idx = ic[*ajtmp++ + shift];
302       do {
303         m  = fm;
304         fm = fill[m];
305       } while (fm < idx);
306       fill[m]   = idx;
307       fill[idx] = fm;
308     }
309     row = fill[n];
310     while ( row < i ) {
311       ajtmp = ajnew + idnew[row] + (!shift);
312       nzbd  = 1 + idnew[row] - ainew[row];
313       nz    = im[row] - nzbd;
314       fm    = row;
315       while (nz-- > 0) {
316         idx = *ajtmp++ + shift;
317         nzbd++;
318         if (idx == i) im[row] = nzbd;
319         do {
320           m  = fm;
321           fm = fill[m];
322         } while (fm < idx);
323         if (fm != idx) {
324           fill[m]   = idx;
325           fill[idx] = fm;
326           fm        = idx;
327           nnz++;
328         }
329       }
330       row = fill[row];
331     }
332     /* copy new filled row into permanent storage */
333     ainew[i+1] = ainew[i] + nnz;
334     if (ainew[i+1] > jmax) {
335 
336       /* estimate how much additional space we will need */
337       /* use the strategy suggested by David Hysom <hysom@perch-t.icase.edu> */
338       /* just double the memory each time */
339       int maxadd = jmax;
340       /* maxadd = (int) ((f*(ai[n]+(!shift))*(n-i+5))/n); */
341       if (maxadd < nnz) maxadd = (n-i)*(nnz+1);
342       jmax += maxadd;
343 
344       /* allocate a longer ajnew */
345       ajtmp = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(ajtmp);
346       ierr  = PetscMemcpy(ajtmp,ajnew,(ainew[i]+shift)*sizeof(int));CHKERRQ(ierr);
347       ierr  = PetscFree(ajnew);CHKERRQ(ierr);
348       ajnew = ajtmp;
349       realloc++; /* count how many times we realloc */
350     }
351     ajtmp = ajnew + ainew[i] + shift;
352     fm    = fill[n];
353     nzi   = 0;
354     im[i] = nnz;
355     while (nnz--) {
356       if (fm < i) nzi++;
357       *ajtmp++ = fm - shift;
358       fm       = fill[fm];
359     }
360     idnew[i] = ainew[i] + nzi;
361   }
362   if (ai[n] != 0) {
363     double af = ((double)ainew[n])/((double)ai[n]);
364     PLogInfo(A,"MatLUFactorSymbolic_SeqAIJ:Reallocs %d Fill ratio:given %g needed %g\n",realloc,f,af);
365     PLogInfo(A,"MatLUFactorSymbolic_SeqAIJ:Run with -pc_lu_fill %g or use \n",af);
366     PLogInfo(A,"MatLUFactorSymbolic_SeqAIJ:PCLUSetFill(pc,%g);\n",af);
367     PLogInfo(A,"MatLUFactorSymbolic_SeqAIJ:for best performance.\n");
368   } else {
369     PLogInfo(A,"MatLUFactorSymbolic_SeqAIJ: Empty matrix\n");
370   }
371 
372   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
373   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
374 
375   ierr = PetscFree(fill);CHKERRQ(ierr);
376 
377   /* put together the new matrix */
378   ierr = MatCreateSeqAIJ(A->comm,n,n,0,PETSC_NULL,B);CHKERRQ(ierr);
379   PLogObjectParent(*B,isicol);
380   b = (Mat_SeqAIJ *) (*B)->data;
381   ierr = PetscFree(b->imax);CHKERRQ(ierr);
382   b->singlemalloc = PETSC_FALSE;
383   /* the next line frees the default space generated by the Create() */
384   ierr = PetscFree(b->a);CHKERRQ(ierr);
385   ierr = PetscFree(b->ilen);CHKERRQ(ierr);
386   b->a          = (Scalar *) PetscMalloc((ainew[n]+shift+1)*sizeof(Scalar));CHKPTRQ(b->a);
387   b->j          = ajnew;
388   b->i          = ainew;
389   b->diag       = idnew;
390   b->ilen       = 0;
391   b->imax       = 0;
392   b->row        = isrow;
393   b->col        = iscol;
394   ierr          = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
395   ierr          = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
396   b->icol       = isicol;
397   b->solve_work = (Scalar *) PetscMalloc( (n+1)*sizeof(Scalar));CHKPTRQ(b->solve_work);
398   /* In b structure:  Free imax, ilen, old a, old j.
399      Allocate idnew, solve_work, new a, new j */
400   PLogObjectMemory(*B,(ainew[n]+shift-n)*(sizeof(int)+sizeof(Scalar)));
401   b->maxnz = b->nz = ainew[n] + shift;
402 
403   (*B)->factor                 =  FACTOR_LU;;
404   (*B)->info.factor_mallocs    = realloc;
405   (*B)->info.fill_ratio_given  = f;
406   (*B)->ops->lufactornumeric   =  A->ops->lufactornumeric; /* Use Inode variant if A has inodes */
407 
408   if (ai[n] != 0) {
409     (*B)->info.fill_ratio_needed = ((double)ainew[n])/((double)ai[n]);
410   } else {
411     (*B)->info.fill_ratio_needed = 0.0;
412   }
413   PetscFunctionReturn(0);
414 }
415 /* ----------------------------------------------------------- */
416 extern int Mat_AIJ_CheckInode(Mat);
417 
418 #undef __FUNC__
419 #define __FUNC__ "MatLUFactorNumeric_SeqAIJ"
420 int MatLUFactorNumeric_SeqAIJ(Mat A,Mat *B)
421 {
422   Mat        C = *B;
423   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b = (Mat_SeqAIJ *)C->data;
424   IS         isrow = b->row, isicol = b->icol;
425   int        *r,*ic, ierr, i, j, n = a->m, *ai = b->i, *aj = b->j;
426   int        *ajtmpold, *ajtmp, nz, row, *ics, shift = a->indexshift;
427   int        *diag_offset = b->diag,diag,k;
428   int        preserve_row_sums = (int) a->ilu_preserve_row_sums;
429   register   int    *pj;
430   Scalar     *rtmp,*v, *pc, multiplier,sum,inner_sum,*rowsums = 0;
431   double     ssum;
432   register   Scalar *pv, *rtmps,*u_values;
433 
434   PetscFunctionBegin;
435 
436   ierr  = ISGetIndices(isrow,&r);CHKERRQ(ierr);
437   ierr  = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
438   rtmp  = (Scalar *) PetscMalloc( (n+1)*sizeof(Scalar) );CHKPTRQ(rtmp);
439   ierr  = PetscMemzero(rtmp,(n+1)*sizeof(Scalar));CHKERRQ(ierr);
440   rtmps = rtmp + shift; ics = ic + shift;
441 
442   /* precalculate row sums */
443   if (preserve_row_sums) {
444     rowsums = (Scalar *) PetscMalloc( n*sizeof(Scalar) );CHKPTRQ(rowsums);
445     for ( i=0; i<n; i++ ) {
446       nz  = a->i[r[i]+1] - a->i[r[i]];
447       v   = a->a + a->i[r[i]] + shift;
448       sum = 0.0;
449       for ( j=0; j<nz; j++ ) sum += v[j];
450       rowsums[i] = sum;
451     }
452   }
453 
454   for ( i=0; i<n; i++ ) {
455     nz    = ai[i+1] - ai[i];
456     ajtmp = aj + ai[i] + shift;
457     for  ( j=0; j<nz; j++ ) rtmps[ajtmp[j]] = 0.0;
458 
459     /* load in initial (unfactored row) */
460     nz       = a->i[r[i]+1] - a->i[r[i]];
461     ajtmpold = a->j + a->i[r[i]] + shift;
462     v        = a->a + a->i[r[i]] + shift;
463     for ( j=0; j<nz; j++ ) rtmp[ics[ajtmpold[j]]] =  v[j];
464 
465     row = *ajtmp++ + shift;
466     while  (row < i ) {
467       pc = rtmp + row;
468       if (*pc != 0.0) {
469         pv         = b->a + diag_offset[row] + shift;
470         pj         = b->j + diag_offset[row] + (!shift);
471         multiplier = *pc / *pv++;
472         *pc        = multiplier;
473         nz         = ai[row+1] - diag_offset[row] - 1;
474         for (j=0; j<nz; j++) rtmps[pj[j]] -= multiplier * pv[j];
475         PLogFlops(2*nz);
476       }
477       row = *ajtmp++ + shift;
478     }
479     /* finished row so stick it into b->a */
480     pv = b->a + ai[i] + shift;
481     pj = b->j + ai[i] + shift;
482     nz = ai[i+1] - ai[i];
483     for ( j=0; j<nz; j++ ) {pv[j] = rtmps[pj[j]];}
484     diag = diag_offset[i] - ai[i];
485     /*
486           Possibly adjust diagonal entry on current row to force
487         LU matrix to have same row sum as initial matrix.
488     */
489     if (pv[diag] == 0.0) {
490       SETERRQ1(PETSC_ERR_MAT_LU_ZRPVT,0,"Zero pivot row %d",i);
491     }
492     if (preserve_row_sums) {
493       pj  = b->j + ai[i] + shift;
494       sum = rowsums[i];
495       for ( j=0; j<diag; j++ ) {
496         u_values  = b->a + diag_offset[pj[j]] + shift;
497         nz        = ai[pj[j]+1] - diag_offset[pj[j]];
498         inner_sum = 0.0;
499         for ( k=0; k<nz; k++ ) {
500           inner_sum += u_values[k];
501         }
502         sum -= pv[j]*inner_sum;
503 
504       }
505       nz       = ai[i+1] - diag_offset[i] - 1;
506       u_values = b->a + diag_offset[i] + 1 + shift;
507       for ( k=0; k<nz; k++ ) {
508         sum -= u_values[k];
509       }
510       ssum = PetscAbsScalar(sum/pv[diag]);
511       if (ssum < 1000. && ssum > .001) pv[diag] = sum;
512     }
513     /* check pivot entry for current row */
514   }
515 
516   /* invert diagonal entries for simplier triangular solves */
517   for ( i=0; i<n; i++ ) {
518     b->a[diag_offset[i]+shift] = 1.0/b->a[diag_offset[i]+shift];
519   }
520 
521   if (preserve_row_sums) {ierr = PetscFree(rowsums);CHKERRQ(ierr);}
522   ierr = PetscFree(rtmp);CHKERRQ(ierr);
523   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
524   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
525   C->factor = FACTOR_LU;
526   ierr = Mat_AIJ_CheckInode(C);CHKERRQ(ierr);
527   C->assembled = PETSC_TRUE;
528   PLogFlops(b->n);
529   PetscFunctionReturn(0);
530 }
531 /* ----------------------------------------------------------- */
532 #undef __FUNC__
533 #define __FUNC__ "MatLUFactor_SeqAIJ"
534 int MatLUFactor_SeqAIJ(Mat A,IS row,IS col,double f)
535 {
536   Mat_SeqAIJ     *mat = (Mat_SeqAIJ *) A->data;
537   int            ierr,refct;
538   Mat            C;
539   PetscOps       *Abops;
540   MatOps         Aops;
541 
542   PetscFunctionBegin;
543   ierr = MatLUFactorSymbolic(A,row,col,f,&C);CHKERRQ(ierr);
544   ierr = MatLUFactorNumeric(A,&C);CHKERRQ(ierr);
545 
546   /* free all the data structures from mat */
547   ierr = PetscFree(mat->a);CHKERRQ(ierr);
548   if (!mat->singlemalloc) {
549     ierr = PetscFree(mat->i);CHKERRQ(ierr);
550     ierr = PetscFree(mat->j);CHKERRQ(ierr);
551   }
552   if (mat->diag) {ierr = PetscFree(mat->diag);CHKERRQ(ierr);}
553   if (mat->ilen) {ierr = PetscFree(mat->ilen);CHKERRQ(ierr);}
554   if (mat->imax) {ierr = PetscFree(mat->imax);CHKERRQ(ierr);}
555   if (mat->solve_work) {ierr = PetscFree(mat->solve_work);CHKERRQ(ierr);}
556   if (mat->inode.size) {ierr = PetscFree(mat->inode.size);CHKERRQ(ierr);}
557   if (mat->icol) {ierr = ISDestroy(mat->icol);CHKERRQ(ierr);}
558   ierr = PetscFree(mat);CHKERRQ(ierr);
559 
560   ierr = MapDestroy(A->rmap);CHKERRQ(ierr);
561   ierr = MapDestroy(A->cmap);CHKERRQ(ierr);
562 
563   /*
564        This is horrible, horrible code. We need to keep the
565     A pointers for the bops and ops but copy everything
566     else from C.
567   */
568   Abops = A->bops;
569   Aops  = A->ops;
570   refct = A->refct;
571   ierr  = PetscMemcpy(A,C,sizeof(struct _p_Mat));CHKERRQ(ierr);
572   mat   = (Mat_SeqAIJ *) A->data;
573   PLogObjectParent(A,mat->icol);
574 
575   A->bops  = Abops;
576   A->ops   = Aops;
577   A->qlist = 0;
578   A->refct = refct;
579   /* copy over the type_name and name */
580   ierr     = PetscStrallocpy(C->type_name,&A->type_name);CHKERRQ(ierr);
581   ierr     = PetscStrallocpy(C->name,&A->name);CHKERRQ(ierr);
582 
583   PetscHeaderDestroy(C);
584 
585   PetscFunctionReturn(0);
586 }
587 /* ----------------------------------------------------------- */
588 #undef __FUNC__
589 #define __FUNC__ "MatSolve_SeqAIJ"
590 int MatSolve_SeqAIJ(Mat A,Vec bb, Vec xx)
591 {
592   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
593   IS         iscol = a->col, isrow = a->row;
594   int        *r,*c, ierr, i,  n = a->m, *vi, *ai = a->i, *aj = a->j;
595   int        nz,shift = a->indexshift,*rout,*cout;
596   Scalar     *x,*b,*tmp, *tmps, *aa = a->a, sum, *v;
597 
598   PetscFunctionBegin;
599   if (!n) PetscFunctionReturn(0);
600 
601   ierr = VecGetArray(bb,&b);CHKERRQ(ierr);
602   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
603   tmp  = a->solve_work;
604 
605   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
606   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout + (n-1);
607 
608   /* forward solve the lower triangular */
609   tmp[0] = b[*r++];
610   tmps   = tmp + shift;
611   for ( i=1; i<n; i++ ) {
612     v   = aa + ai[i] + shift;
613     vi  = aj + ai[i] + shift;
614     nz  = a->diag[i] - ai[i];
615     sum = b[*r++];
616     while (nz--) sum -= *v++ * tmps[*vi++];
617     tmp[i] = sum;
618   }
619 
620   /* backward solve the upper triangular */
621   for ( i=n-1; i>=0; i-- ){
622     v   = aa + a->diag[i] + (!shift);
623     vi  = aj + a->diag[i] + (!shift);
624     nz  = ai[i+1] - a->diag[i] - 1;
625     sum = tmp[i];
626     while (nz--) sum -= *v++ * tmps[*vi++];
627     x[*c--] = tmp[i] = sum*aa[a->diag[i]+shift];
628   }
629 
630   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
631   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
632   ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr);
633   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
634   PLogFlops(2*a->nz - a->n);
635   PetscFunctionReturn(0);
636 }
637 
638 /* ----------------------------------------------------------- */
639 #undef __FUNC__
640 #define __FUNC__ "MatSolve_SeqAIJ_NaturalOrdering"
641 int MatSolve_SeqAIJ_NaturalOrdering(Mat A,Vec bb, Vec xx)
642 {
643   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
644   int        n = a->m, *ai = a->i, *aj = a->j, *adiag = a->diag,ierr;
645   Scalar     *x,*b, *aa = a->a, sum;
646 #if !defined(PETSC_USE_FORTRAN_KERNEL_SOLVEAIJ)
647   int        adiag_i,i,*vi,nz,ai_i;
648   Scalar     *v;
649 #endif
650 
651   PetscFunctionBegin;
652   if (!n) PetscFunctionReturn(0);
653   if (a->indexshift) {
654      ierr = MatSolve_SeqAIJ(A,bb,xx);CHKERRQ(ierr);
655      PetscFunctionReturn(0);
656   }
657 
658   ierr = VecGetArray(bb,&b);CHKERRQ(ierr);
659   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
660 
661 #if defined(PETSC_USE_FORTRAN_KERNEL_SOLVEAIJ)
662   fortransolveaij_(&n,x,ai,aj,adiag,aa,b);
663 #else
664   /* forward solve the lower triangular */
665   x[0] = b[0];
666   for ( i=1; i<n; i++ ) {
667     ai_i = ai[i];
668     v    = aa + ai_i;
669     vi   = aj + ai_i;
670     nz   = adiag[i] - ai_i;
671     sum  = b[i];
672     while (nz--) sum -= *v++ * x[*vi++];
673     x[i] = sum;
674   }
675 
676   /* backward solve the upper triangular */
677   for ( i=n-1; i>=0; i-- ){
678     adiag_i = adiag[i];
679     v       = aa + adiag_i + 1;
680     vi      = aj + adiag_i + 1;
681     nz      = ai[i+1] - adiag_i - 1;
682     sum     = x[i];
683     while (nz--) sum -= *v++ * x[*vi++];
684     x[i]    = sum*aa[adiag_i];
685   }
686 #endif
687   PLogFlops(2*a->nz - a->n);
688   ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr);
689   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
690   PetscFunctionReturn(0);
691 }
692 
693 #undef __FUNC__
694 #define __FUNC__ "MatSolveAdd_SeqAIJ"
695 int MatSolveAdd_SeqAIJ(Mat A,Vec bb, Vec yy, Vec xx)
696 {
697   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
698   IS         iscol = a->col, isrow = a->row;
699   int        *r,*c, ierr, i,  n = a->m, *vi, *ai = a->i, *aj = a->j;
700   int        nz, shift = a->indexshift,*rout,*cout;
701   Scalar     *x,*b,*tmp, *aa = a->a, sum, *v;
702 
703   PetscFunctionBegin;
704   if (yy != xx) {ierr = VecCopy(yy,xx);CHKERRQ(ierr);}
705 
706   ierr = VecGetArray(bb,&b);CHKERRQ(ierr);
707   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
708   tmp  = a->solve_work;
709 
710   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
711   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout + (n-1);
712 
713   /* forward solve the lower triangular */
714   tmp[0] = b[*r++];
715   for ( i=1; i<n; i++ ) {
716     v   = aa + ai[i] + shift;
717     vi  = aj + ai[i] + shift;
718     nz  = a->diag[i] - ai[i];
719     sum = b[*r++];
720     while (nz--) sum -= *v++ * tmp[*vi++ + shift];
721     tmp[i] = sum;
722   }
723 
724   /* backward solve the upper triangular */
725   for ( i=n-1; i>=0; i-- ){
726     v   = aa + a->diag[i] + (!shift);
727     vi  = aj + a->diag[i] + (!shift);
728     nz  = ai[i+1] - a->diag[i] - 1;
729     sum = tmp[i];
730     while (nz--) sum -= *v++ * tmp[*vi++ + shift];
731     tmp[i] = sum*aa[a->diag[i]+shift];
732     x[*c--] += tmp[i];
733   }
734 
735   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
736   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
737   ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr);
738   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
739   PLogFlops(2*a->nz);
740 
741   PetscFunctionReturn(0);
742 }
743 /* -------------------------------------------------------------------*/
744 #undef __FUNC__
745 #define __FUNC__ "MatSolveTranspose_SeqAIJ"
746 int MatSolveTranspose_SeqAIJ(Mat A,Vec bb, Vec xx)
747 {
748   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
749   IS         iscol = a->col, isrow = a->row;
750   int        *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j;
751   int        nz,shift = a->indexshift,*rout,*cout, *diag = a->diag;
752   Scalar     *x,*b,*tmp, *aa = a->a, *v, s1;
753 
754   PetscFunctionBegin;
755   ierr = VecGetArray(bb,&b);CHKERRQ(ierr);
756   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
757   tmp  = a->solve_work;
758 
759   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
760   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout;
761 
762   /* copy the b into temp work space according to permutation */
763   for ( i=0; i<n; i++ ) tmp[i] = b[c[i]];
764 
765   /* forward solve the U^T */
766   for ( i=0; i<n; i++ ) {
767     v   = aa + diag[i] + shift;
768     vi  = aj + diag[i] + (!shift);
769     nz  = ai[i+1] - diag[i] - 1;
770     s1  = tmp[i];
771     s1 *= *(v++);  /* multiply by inverse of diagonal entry */
772     while (nz--) {
773       tmp[*vi++ + shift] -= (*v++)*s1;
774     }
775     tmp[i] = s1;
776   }
777 
778   /* backward solve the L^T */
779   for ( i=n-1; i>=0; i-- ){
780     v   = aa + diag[i] - 1 + shift;
781     vi  = aj + diag[i] - 1 + shift;
782     nz  = diag[i] - ai[i];
783     s1  = tmp[i];
784     while (nz--) {
785       tmp[*vi-- + shift] -= (*v--)*s1;
786     }
787   }
788 
789   /* copy tmp into x according to permutation */
790   for ( i=0; i<n; i++ ) x[r[i]] = tmp[i];
791 
792   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
793   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
794   ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr);
795   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
796 
797   PLogFlops(2*a->nz-a->n);
798   PetscFunctionReturn(0);
799 }
800 
801 #undef __FUNC__
802 #define __FUNC__ "MatSolveTransposeAdd_SeqAIJ"
803 int MatSolveTransposeAdd_SeqAIJ(Mat A,Vec bb, Vec zz,Vec xx)
804 {
805   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
806   IS         iscol = a->col, isrow = a->row;
807   int        *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j;
808   int        nz,shift = a->indexshift, *rout, *cout, *diag = a->diag;
809   Scalar     *x,*b,*tmp, *aa = a->a, *v;
810 
811   PetscFunctionBegin;
812   if (zz != xx) VecCopy(zz,xx);
813 
814   ierr = VecGetArray(bb,&b);CHKERRQ(ierr);
815   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
816   tmp = a->solve_work;
817 
818   ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout;
819   ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout;
820 
821   /* copy the b into temp work space according to permutation */
822   for ( i=0; i<n; i++ ) tmp[i] = b[c[i]];
823 
824   /* forward solve the U^T */
825   for ( i=0; i<n; i++ ) {
826     v   = aa + diag[i] + shift;
827     vi  = aj + diag[i] + (!shift);
828     nz  = ai[i+1] - diag[i] - 1;
829     tmp[i] *= *v++;
830     while (nz--) {
831       tmp[*vi++ + shift] -= (*v++)*tmp[i];
832     }
833   }
834 
835   /* backward solve the L^T */
836   for ( i=n-1; i>=0; i-- ){
837     v   = aa + diag[i] - 1 + shift;
838     vi  = aj + diag[i] - 1 + shift;
839     nz  = diag[i] - ai[i];
840     while (nz--) {
841       tmp[*vi-- + shift] -= (*v--)*tmp[i];
842     }
843   }
844 
845   /* copy tmp into x according to permutation */
846   for ( i=0; i<n; i++ ) x[r[i]] += tmp[i];
847 
848   ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr);
849   ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr);
850   ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr);
851   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
852 
853   PLogFlops(2*a->nz);
854   PetscFunctionReturn(0);
855 }
856 /* ----------------------------------------------------------------*/
857 extern int MatMissingDiagonal_SeqAIJ(Mat);
858 
859 #undef __FUNC__
860 #define __FUNC__ "MatILUFactorSymbolic_SeqAIJ"
861 int MatILUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,MatILUInfo *info,Mat *fact)
862 {
863   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b;
864   IS         isicol;
865   int        *r,*ic, ierr, prow, n = a->m, *ai = a->i, *aj = a->j;
866   int        *ainew,*ajnew, jmax,*fill, *xi, nz, *im,*ajfill,*flev;
867   int        *dloc, idx, row,m,fm, nzf, nzi,len,  realloc = 0, dcount = 0;
868   int        incrlev,nnz,i,shift = a->indexshift,levels,diagonal_fill;
869   PetscTruth col_identity, row_identity;
870   double     f;
871 
872   PetscFunctionBegin;
873   if (info) {
874     f             = info->fill;
875     levels        = (int) info->levels;
876     diagonal_fill = (int) info->diagonal_fill;
877   } else {
878     f             = 1.0;
879     levels        = 0;
880     diagonal_fill = 0;
881   }
882   ierr = ISInvertPermutation(iscol,&isicol);CHKERRQ(ierr);
883 
884   /* special case that simply copies fill pattern */
885   ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
886   ierr = ISIdentity(iscol,&col_identity);CHKERRQ(ierr);
887   if (!levels && row_identity && col_identity) {
888     ierr = MatDuplicate_SeqAIJ(A,MAT_DO_NOT_COPY_VALUES,fact);CHKERRQ(ierr);
889     (*fact)->factor = FACTOR_LU;
890     b               = (Mat_SeqAIJ *) (*fact)->data;
891     if (!b->diag) {
892       ierr = MatMarkDiagonal_SeqAIJ(*fact);CHKERRQ(ierr);
893     }
894     ierr = MatMissingDiagonal_SeqAIJ(*fact);CHKERRQ(ierr);
895     b->row              = isrow;
896     b->col              = iscol;
897     b->icol             = isicol;
898     b->solve_work       = (Scalar *) PetscMalloc((b->m+1)*sizeof(Scalar));CHKPTRQ(b->solve_work);
899     (*fact)->ops->solve = MatSolve_SeqAIJ_NaturalOrdering;
900     ierr                = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
901     ierr                = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
902     PetscFunctionReturn(0);
903   }
904 
905   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
906   ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
907 
908   /* get new row pointers */
909   ainew = (int *) PetscMalloc( (n+1)*sizeof(int) );CHKPTRQ(ainew);
910   ainew[0] = -shift;
911   /* don't know how many column pointers are needed so estimate */
912   jmax = (int) (f*(ai[n]+!shift));
913   ajnew = (int *) PetscMalloc( (jmax)*sizeof(int) );CHKPTRQ(ajnew);
914   /* ajfill is level of fill for each fill entry */
915   ajfill = (int *) PetscMalloc( (jmax)*sizeof(int) );CHKPTRQ(ajfill);
916   /* fill is a linked list of nonzeros in active row */
917   fill = (int *) PetscMalloc( (n+1)*sizeof(int));CHKPTRQ(fill);
918   /* im is level for each filled value */
919   im = (int *) PetscMalloc( (n+1)*sizeof(int));CHKPTRQ(im);
920   /* dloc is location of diagonal in factor */
921   dloc = (int *) PetscMalloc( (n+1)*sizeof(int));CHKPTRQ(dloc);
922   dloc[0]  = 0;
923   for ( prow=0; prow<n; prow++ ) {
924 
925     /* copy current row into linked list */
926     nzf     = nz  = ai[r[prow]+1] - ai[r[prow]];
927     if (!nz) SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,1,"Empty row in matrix");
928     xi      = aj + ai[r[prow]] + shift;
929     fill[n]    = n;
930     fill[prow] = -1; /* marker to indicate if diagonal exists */
931     while (nz--) {
932       fm  = n;
933       idx = ic[*xi++ + shift];
934       do {
935         m  = fm;
936         fm = fill[m];
937       } while (fm < idx);
938       fill[m]   = idx;
939       fill[idx] = fm;
940       im[idx]   = 0;
941     }
942 
943     /* make sure diagonal entry is included */
944     if (diagonal_fill && fill[prow] == -1) {
945       fm = n;
946       while (fill[fm] < prow) fm = fill[fm];
947       fill[prow] = fill[fm]; /* insert diagonal into linked list */
948       fill[fm]   = prow;
949       im[prow]   = 0;
950       nzf++;
951       dcount++;
952     }
953 
954     nzi = 0;
955     row = fill[n];
956     while ( row < prow ) {
957       incrlev = im[row] + 1;
958       nz      = dloc[row];
959       xi      = ajnew  + ainew[row] + shift + nz + 1;
960       flev    = ajfill + ainew[row] + shift + nz + 1;
961       nnz     = ainew[row+1] - ainew[row] - nz - 1;
962       fm      = row;
963       while (nnz-- > 0) {
964         idx = *xi++ + shift;
965         if (*flev + incrlev > levels) {
966           flev++;
967           continue;
968         }
969         do {
970           m  = fm;
971           fm = fill[m];
972         } while (fm < idx);
973         if (fm != idx) {
974           im[idx]   = *flev + incrlev;
975           fill[m]   = idx;
976           fill[idx] = fm;
977           fm        = idx;
978           nzf++;
979         } else {
980           if (im[idx] > *flev + incrlev) im[idx] = *flev+incrlev;
981         }
982         flev++;
983       }
984       row = fill[row];
985       nzi++;
986     }
987     /* copy new filled row into permanent storage */
988     ainew[prow+1] = ainew[prow] + nzf;
989     if (ainew[prow+1] > jmax-shift) {
990 
991       /* estimate how much additional space we will need */
992       /* use the strategy suggested by David Hysom <hysom@perch-t.icase.edu> */
993       /* just double the memory each time */
994       /*  maxadd = (int) ((f*(ai[n]+!shift)*(n-prow+5))/n); */
995       int maxadd = jmax;
996       if (maxadd < nzf) maxadd = (n-prow)*(nzf+1);
997       jmax += maxadd;
998 
999       /* allocate a longer ajnew and ajfill */
1000       xi     = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(xi);
1001       ierr   = PetscMemcpy(xi,ajnew,(ainew[prow]+shift)*sizeof(int));CHKERRQ(ierr);
1002       ierr = PetscFree(ajnew);CHKERRQ(ierr);
1003       ajnew  = xi;
1004       xi     = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(xi);
1005       ierr   = PetscMemcpy(xi,ajfill,(ainew[prow]+shift)*sizeof(int));CHKERRQ(ierr);
1006       ierr = PetscFree(ajfill);CHKERRQ(ierr);
1007       ajfill = xi;
1008       realloc++; /* count how many times we realloc */
1009     }
1010     xi          = ajnew + ainew[prow] + shift;
1011     flev        = ajfill + ainew[prow] + shift;
1012     dloc[prow]  = nzi;
1013     fm          = fill[n];
1014     while (nzf--) {
1015       *xi++   = fm - shift;
1016       *flev++ = im[fm];
1017       fm      = fill[fm];
1018     }
1019     /* make sure row has diagonal entry */
1020     if (ajnew[ainew[prow]+shift+dloc[prow]]+shift != prow) {
1021       SETERRQ1(PETSC_ERR_MAT_LU_ZRPVT,1,"Row %d has missing diagonal in factored matrix\n\
1022     try running with -pc_ilu_nonzeros_along_diagonal or -pc_ilu_diagonal_fill",prow);
1023     }
1024   }
1025   ierr = PetscFree(ajfill); CHKERRQ(ierr);
1026   ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
1027   ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
1028   ierr = PetscFree(fill);CHKERRQ(ierr);
1029   ierr = PetscFree(im);CHKERRQ(ierr);
1030 
1031   {
1032     double af = ((double)ainew[n])/((double)ai[n]);
1033     PLogInfo(A,"MatILUFactorSymbolic_SeqAIJ:Reallocs %d Fill ratio:given %g needed %g\n",realloc,f,af);
1034     PLogInfo(A,"MatILUFactorSymbolic_SeqAIJ:Run with -pc_ilu_fill %g or use \n",af);
1035     PLogInfo(A,"MatILUFactorSymbolic_SeqAIJ:PCILUSetFill(pc,%g);\n",af);
1036     PLogInfo(A,"MatILUFactorSymbolic_SeqAIJ:for best performance.\n");
1037     if (diagonal_fill) {
1038       PLogInfo(A,"MatILUFactorSymbolic_SeqAIJ:Detected and replace %d missing diagonals",dcount);
1039     }
1040   }
1041 
1042   /* put together the new matrix */
1043   ierr = MatCreateSeqAIJ(A->comm,n,n,0,PETSC_NULL,fact);CHKERRQ(ierr);
1044   PLogObjectParent(*fact,isicol);
1045   b = (Mat_SeqAIJ *) (*fact)->data;
1046   ierr = PetscFree(b->imax);CHKERRQ(ierr);
1047   b->singlemalloc = PETSC_FALSE;
1048   len = (ainew[n] + shift)*sizeof(Scalar);
1049   /* the next line frees the default space generated by the Create() */
1050   ierr = PetscFree(b->a);CHKERRQ(ierr);
1051   ierr = PetscFree(b->ilen);CHKERRQ(ierr);
1052   b->a          = (Scalar *) PetscMalloc( len+1 );CHKPTRQ(b->a);
1053   b->j          = ajnew;
1054   b->i          = ainew;
1055   for ( i=0; i<n; i++ ) dloc[i] += ainew[i];
1056   b->diag       = dloc;
1057   b->ilen       = 0;
1058   b->imax       = 0;
1059   b->row        = isrow;
1060   b->col        = iscol;
1061   ierr          = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
1062   ierr          = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
1063   b->icol       = isicol;
1064   b->solve_work = (Scalar *) PetscMalloc( (n+1)*sizeof(Scalar));CHKPTRQ(b->solve_work);
1065   /* In b structure:  Free imax, ilen, old a, old j.
1066      Allocate dloc, solve_work, new a, new j */
1067   PLogObjectMemory(*fact,(ainew[n]+shift-n) * (sizeof(int)+sizeof(Scalar)));
1068   b->maxnz          = b->nz = ainew[n] + shift;
1069   (*fact)->factor   = FACTOR_LU;
1070 
1071   (*fact)->info.factor_mallocs    = realloc;
1072   (*fact)->info.fill_ratio_given  = f;
1073   (*fact)->info.fill_ratio_needed = ((double)ainew[n])/((double)ai[prow]);
1074   (*fact)->factor                 =  FACTOR_LU;;
1075 
1076   PetscFunctionReturn(0);
1077 }
1078 
1079 
1080 
1081 
1082