xref: /petsc/src/mat/impls/aij/seq/aijfact.c (revision 33a8263d2fdc82d6944056e76c023d5b91e5d5ea)
1 #ifndef lint
2 static char vcid[] = "$Id: aijfact.c,v 1.44 1995/11/01 23:17:58 bsmith Exp bsmith $";
3 #endif
4 
5 #include "aij.h"
6 #include "inline/spops.h"
7 /*
8     Factorization code for AIJ format.
9 */
10 
11 int MatLUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,double f,Mat *B)
12 {
13   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b;
14   IS         isicol;
15   int        *r,*ic, ierr, i, n = a->m, *ai = a->i, *aj = a->j;
16   int        *ainew,*ajnew, jmax,*fill, *ajtmp, nz,shift = a->indexshift;
17   int        *idnew, idx, row,m,fm, nnz, nzi,len, realloc = 0,nzbd,*im;
18 
19   if (n != a->n) SETERRQ(1,"MatLUFactorSymbolic_SeqAIJ:Must be square");
20   if (!isrow) SETERRQ(1,"MatLUFactorSymbolic_SeqAIJ:Must have row permutation");
21   if (!iscol) SETERRQ(1,"MatLUFactorSymbolic_SeqAIJ:Must have column permutation");
22 
23   ierr = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr);
24   ISGetIndices(isrow,&r); ISGetIndices(isicol,&ic);
25 
26   /* get new row pointers */
27   ainew = (int *) PetscMalloc( (n+1)*sizeof(int) ); CHKPTRQ(ainew);
28   ainew[0] = -shift;
29   /* don't know how many column pointers are needed so estimate */
30   jmax = (int) (f*ai[n]+(!shift));
31   ajnew = (int *) PetscMalloc( (jmax)*sizeof(int) ); CHKPTRQ(ajnew);
32   /* fill is a linked list of nonzeros in active row */
33   fill = (int *) PetscMalloc( (2*n+1)*sizeof(int)); CHKPTRQ(fill);
34   im = fill + n + 1;
35   /* idnew is location of diagonal in factor */
36   idnew = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(idnew);
37   idnew[0] = -shift;
38 
39   for ( i=0; i<n; i++ ) {
40     /* first copy previous fill into linked list */
41     nnz     = nz    = ai[r[i]+1] - ai[r[i]];
42     ajtmp   = aj + ai[r[i]] + shift;
43     fill[n] = n;
44     while (nz--) {
45       fm  = n;
46       idx = ic[*ajtmp++ + shift];
47       do {
48         m  = fm;
49         fm = fill[m];
50       } while (fm < idx);
51       fill[m]   = idx;
52       fill[idx] = fm;
53     }
54     row = fill[n];
55     while ( row < i ) {
56       ajtmp = ajnew + idnew[row] + (!shift);
57       nzbd  = 1 + idnew[row] - ainew[row];
58       nz    = im[row] - nzbd;
59       fm    = row;
60       while (nz-- > 0) {
61         idx = *ajtmp++ + shift;
62         nzbd++;
63         if (idx == i) im[row] = nzbd;
64         do {
65           m  = fm;
66           fm = fill[m];
67         } while (fm < idx);
68         if (fm != idx) {
69           fill[m]   = idx;
70           fill[idx] = fm;
71           fm        = idx;
72           nnz++;
73         }
74       }
75       row = fill[row];
76     }
77     /* copy new filled row into permanent storage */
78     ainew[i+1] = ainew[i] + nnz;
79     if (ainew[i+1] > jmax+1) {
80       /* allocate a longer ajnew */
81       int maxadd;
82       maxadd = (int) ((f*(ai[n]+(!shift))*(n-i+5))/n);
83       if (maxadd < nnz) maxadd = (n-i)*(nnz+1);
84       jmax += maxadd;
85       ajtmp = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(ajtmp);
86       PetscMemcpy(ajtmp,ajnew,(ainew[i]+shift)*sizeof(int));
87       PetscFree(ajnew);
88       ajnew = ajtmp;
89       realloc++; /* count how many times we realloc */
90     }
91     ajtmp = ajnew + ainew[i] + shift;
92     fm    = fill[n];
93     nzi   = 0;
94     im[i] = nnz;
95     while (nnz--) {
96       if (fm < i) nzi++;
97       *ajtmp++ = fm - shift;
98       fm       = fill[fm];
99     }
100     idnew[i] = ainew[i] + nzi;
101   }
102 
103   PLogInfo((PetscObject)A,
104     "Info:MatLUFactorSymbolic_SeqAIJ:Reallocs %d Fill ratio:given %g needed %g\n",
105                              realloc,f,((double)ainew[n])/((double)ai[i]));
106 
107   ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr);
108   ierr = ISRestoreIndices(isicol,&ic); CHKERRQ(ierr);
109 
110   PetscFree(fill);
111 
112   /* put together the new matrix */
113   ierr = MatCreateSeqAIJ(A->comm,n, n, 0, 0, B); CHKERRQ(ierr);
114   PLogObjectParent(*B,isicol);
115   ierr = ISDestroy(isicol); CHKERRQ(ierr);
116   b = (Mat_SeqAIJ *) (*B)->data;
117   PetscFree(b->imax);
118   b->singlemalloc = 0;
119   len             = (ainew[n] + shift)*sizeof(Scalar);
120   /* the next line frees the default space generated by the Create() */
121   PetscFree(b->a); PetscFree(b->ilen);
122   b->a          = (Scalar *) PetscMalloc( len ); CHKPTRQ(b->a);
123   b->j          = ajnew;
124   b->i          = ainew;
125   b->diag       = idnew;
126   b->ilen       = 0;
127   b->imax       = 0;
128   b->row        = isrow;
129   b->col        = iscol;
130   b->solve_work = (Scalar *) PetscMalloc( n*sizeof(Scalar));
131   CHKPTRQ(b->solve_work);
132   /* In b structure:  Free imax, ilen, old a, old j.
133      Allocate idnew, solve_work, new a, new j */
134   PLogObjectMemory(*B,(ainew[n]+shift-n)*(sizeof(int)+sizeof(Scalar)));
135   b->maxnz = b->nz = ainew[n] + shift;
136 
137   return 0;
138 }
139 /* ----------------------------------------------------------- */
140 int MatLUFactorNumeric_SeqAIJ(Mat A,Mat *B)
141 {
142   Mat        C = *B;
143   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b = (Mat_SeqAIJ *)C->data;
144   IS         iscol = b->col, isrow = b->row, isicol;
145   int        *r,*ic, ierr, i, j, n = a->m, *ai = b->i, *aj = b->j;
146   int        *ajtmpold, *ajtmp, nz, row, *ics, shift = a->indexshift;
147   int        *diag_offset = b->diag;
148   Scalar     *rtmp,*v, *pc, multiplier;
149   /* These declarations are for optimizations.  They reduce the number of
150      memory references that are made by locally storing information; the
151      word "register" used here with pointers can be viewed as "private" or
152      "known only to me"
153    */
154   register Scalar *pv, *rtmps;
155   register int    *pj;
156 
157   ierr  = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr);
158   PLogObjectParent(*B,isicol);
159   ierr  = ISGetIndices(isrow,&r); CHKERRQ(ierr);
160   ierr  = ISGetIndices(isicol,&ic); CHKERRQ(ierr);
161   rtmp  = (Scalar *) PetscMalloc( (n+1)*sizeof(Scalar) ); CHKPTRQ(rtmp);
162   rtmps = rtmp + shift; ics = ic + shift;
163 
164   for ( i=0; i<n; i++ ) {
165     nz    = ai[i+1] - ai[i];
166     ajtmp = aj + ai[i] + shift;
167     for  ( j=0; j<nz; j++ ) rtmps[ajtmp[j]] = 0.0;
168 
169     /* load in initial (unfactored row) */
170     nz       = a->i[r[i]+1] - a->i[r[i]];
171     ajtmpold = a->j + a->i[r[i]] + shift;
172     v        = a->a + a->i[r[i]] + shift;
173     for ( j=0; j<nz; j++ ) rtmp[ics[ajtmpold[j]]] =  v[j];
174 
175     row = *ajtmp++ + shift;
176     while (row < i) {
177       pc = rtmp + row;
178       if (*pc != 0.0) {
179         pv         = b->a + diag_offset[row] + shift;
180         pj         = b->j + diag_offset[row] + (!shift);
181         multiplier = *pc * *pv++;
182         *pc        = multiplier;
183         nz         = ai[row+1] - diag_offset[row] - 1;
184         PLogFlops(2*nz);
185 	/* The for-loop form can aid the compiler in overlapping
186 	   loads and stores */
187         /*while (nz-->0) rtmps[*pj++] -= multiplier* *pv++;  */
188 	{int __i;
189 	 for (__i=0; __i<nz; __i++) rtmps[pj[__i]] -= multiplier * pv[__i];
190 	}
191       }
192       row = *ajtmp++ + shift;
193     }
194     /* finished row so stick it into b->a */
195     pv = b->a + ai[i] + shift;
196     pj = b->j + ai[i] + shift;
197     nz = ai[i+1] - ai[i];
198     if (rtmp[i] == 0.0) {SETERRQ(1,"MatLUFactorNumeric_SeqAIJ:Zero pivot");}
199     rtmp[i] = 1.0/rtmp[i];
200     for ( j=0; j<nz; j++ ) {pv[j] = rtmps[pj[j]];}
201   }
202   PetscFree(rtmp);
203   ierr = ISRestoreIndices(isicol,&ic); CHKERRQ(ierr);
204   ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr);
205   ierr = ISDestroy(isicol); CHKERRQ(ierr);
206   C->factor      = FACTOR_LU;
207   b->assembled = 1;
208   PLogFlops(b->n);
209   return 0;
210 }
211 /* ----------------------------------------------------------- */
212 int MatLUFactor_SeqAIJ(Mat A,IS row,IS col,double f)
213 {
214   Mat_SeqAIJ *mat = (Mat_SeqAIJ *) A->data;
215   int        ierr;
216   Mat        C;
217 
218   ierr = MatLUFactorSymbolic_SeqAIJ(A,row,col,f,&C); CHKERRQ(ierr);
219   ierr = MatLUFactorNumeric_SeqAIJ(A,&C); CHKERRQ(ierr);
220 
221   /* free all the data structures from mat */
222   PetscFree(mat->a);
223   if (!mat->singlemalloc) {PetscFree(mat->i); PetscFree(mat->j);}
224   if (mat->diag) PetscFree(mat->diag);
225   if (mat->ilen) PetscFree(mat->ilen);
226   if (mat->imax) PetscFree(mat->imax);
227   if (mat->solve_work) PetscFree(mat->solve_work);
228   PetscFree(mat);
229 
230   PetscMemcpy(A,C,sizeof(struct _Mat));
231   PetscHeaderDestroy(C);
232   return 0;
233 }
234 /* ----------------------------------------------------------- */
235 int MatSolve_SeqAIJ(Mat A,Vec bb, Vec xx)
236 {
237   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
238   IS         iscol = a->col, isrow = a->row;
239   int        *r,*c, ierr, i,  n = a->m, *vi, *ai = a->i, *aj = a->j;
240   int        nz,shift = a->indexshift;
241   Scalar     *x,*b,*tmp, *tmps, *aa = a->a, sum, *v;
242 
243   if (A->factor != FACTOR_LU) SETERRQ(1,"MatSolve_SeqAIJ:Not for unfactored matrix");
244 
245   ierr = VecGetArray(bb,&b); CHKERRQ(ierr);
246   ierr = VecGetArray(xx,&x); CHKERRQ(ierr);
247   tmp  = a->solve_work;
248 
249   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
250   ierr = ISGetIndices(iscol,&c);CHKERRQ(ierr); c = c + (n-1);
251 
252   /* forward solve the lower triangular */
253   tmp[0] = b[*r++];
254   tmps   = tmp + shift;
255   for ( i=1; i<n; i++ ) {
256     v   = aa + ai[i] + shift;
257     vi  = aj + ai[i] + shift;
258     nz  = a->diag[i] - ai[i];
259     sum = b[*r++];
260     while (nz--) sum -= *v++ * tmps[*vi++];
261     tmp[i] = sum;
262   }
263 
264   /* backward solve the upper triangular */
265   for ( i=n-1; i>=0; i-- ){
266     v   = aa + a->diag[i] + (!shift);
267     vi  = aj + a->diag[i] + (!shift);
268     nz  = ai[i+1] - a->diag[i] - 1;
269     sum = tmp[i];
270     while (nz--) sum -= *v++ * tmps[*vi++];
271     x[*c--] = tmp[i] = sum*aa[a->diag[i]+shift];
272   }
273 
274   ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr);
275   ierr = ISRestoreIndices(iscol,&c); CHKERRQ(ierr);
276   PLogFlops(2*a->nz - a->n);
277   return 0;
278 }
279 int MatSolveAdd_SeqAIJ(Mat A,Vec bb, Vec yy, Vec xx)
280 {
281   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
282   IS         iscol = a->col, isrow = a->row;
283   int        *r,*c, ierr, i,  n = a->m, *vi, *ai = a->i, *aj = a->j;
284   int        nz, shift = a->indexshift;
285   Scalar     *x,*b,*tmp, *aa = a->a, sum, *v;
286 
287   if (A->factor != FACTOR_LU) SETERRQ(1,"MatSolveAdd_SeqAIJ:Not for unfactored matrix");
288   if (yy != xx) {ierr = VecCopy(yy,xx); CHKERRQ(ierr);}
289 
290   ierr = VecGetArray(bb,&b); CHKERRQ(ierr);
291   ierr = VecGetArray(xx,&x); CHKERRQ(ierr);
292   tmp  = a->solve_work;
293 
294   ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr);
295   ierr = ISGetIndices(iscol,&c); CHKERRQ(ierr); c = c + (n-1);
296 
297   /* forward solve the lower triangular */
298   tmp[0] = b[*r++];
299   for ( i=1; i<n; i++ ) {
300     v   = aa + ai[i] + shift;
301     vi  = aj + ai[i] + shift;
302     nz  = a->diag[i] - ai[i];
303     sum = b[*r++];
304     while (nz--) sum -= *v++ * tmp[*vi++ + shift];
305     tmp[i] = sum;
306   }
307 
308   /* backward solve the upper triangular */
309   for ( i=n-1; i>=0; i-- ){
310     v   = aa + a->diag[i] + (!shift);
311     vi  = aj + a->diag[i] + (!shift);
312     nz  = ai[i+1] - a->diag[i] - 1;
313     sum = tmp[i];
314     while (nz--) sum -= *v++ * tmp[*vi++ + shift];
315     tmp[i] = sum*aa[a->diag[i]+shift];
316     x[*c--] += tmp[i];
317   }
318 
319   ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr);
320   ierr = ISRestoreIndices(iscol,&c); CHKERRQ(ierr);
321   PLogFlops(2*a->nz);
322 
323   return 0;
324 }
325 /* -------------------------------------------------------------------*/
326 int MatSolveTrans_SeqAIJ(Mat A,Vec bb, Vec xx)
327 {
328   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
329   IS         iscol = a->col, isrow = a->row, invisrow,inviscol;
330   int        *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j;
331   int        nz,shift = a->indexshift;
332   Scalar     *x,*b,*tmp, *aa = a->a, *v;
333 
334   if (A->factor != FACTOR_LU)  SETERRQ(1,"MatSolveTrans_SeqAIJ:Not unfactored matrix");
335   ierr = VecGetArray(bb,&b); CHKERRQ(ierr);
336   ierr = VecGetArray(xx,&x); CHKERRQ(ierr);
337   tmp  = a->solve_work;
338 
339   /* invert the permutations */
340   ierr = ISInvertPermutation(isrow,&invisrow); CHKERRQ(ierr);
341   ierr = ISInvertPermutation(iscol,&inviscol); CHKERRQ(ierr);
342 
343   ierr = ISGetIndices(invisrow,&r); CHKERRQ(ierr);
344   ierr = ISGetIndices(inviscol,&c); CHKERRQ(ierr);
345 
346   /* copy the b into temp work space according to permutation */
347   for ( i=0; i<n; i++ ) tmp[c[i]] = b[i];
348 
349   /* forward solve the U^T */
350   for ( i=0; i<n; i++ ) {
351     v   = aa + a->diag[i] + shift;
352     vi  = aj + a->diag[i] + (!shift);
353     nz  = ai[i+1] - a->diag[i] - 1;
354     tmp[i] *= *v++;
355     while (nz--) {
356       tmp[*vi++ + shift] -= (*v++)*tmp[i];
357     }
358   }
359 
360   /* backward solve the L^T */
361   for ( i=n-1; i>=0; i-- ){
362     v   = aa + a->diag[i] - 1 + shift;
363     vi  = aj + a->diag[i] - 1 + shift;
364     nz  = a->diag[i] - ai[i];
365     while (nz--) {
366       tmp[*vi-- + shift] -= (*v--)*tmp[i];
367     }
368   }
369 
370   /* copy tmp into x according to permutation */
371   for ( i=0; i<n; i++ ) x[r[i]] = tmp[i];
372 
373   ierr = ISRestoreIndices(invisrow,&r); CHKERRQ(ierr);
374   ierr = ISRestoreIndices(inviscol,&c); CHKERRQ(ierr);
375   ierr = ISDestroy(invisrow); CHKERRQ(ierr);
376   ierr = ISDestroy(inviscol); CHKERRQ(ierr);
377 
378   PLogFlops(2*a->nz-a->n);
379   return 0;
380 }
381 
382 int MatSolveTransAdd_SeqAIJ(Mat A,Vec bb, Vec zz,Vec xx)
383 {
384   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
385   IS         iscol = a->col, isrow = a->row, invisrow,inviscol;
386   int        *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j;
387   int        nz,shift = a->indexshift;
388   Scalar     *x,*b,*tmp, *aa = a->a, *v;
389 
390   if (A->factor != FACTOR_LU)SETERRQ(1,"MatSolveTransAdd_SeqAIJ:Not unfactored matrix");
391   if (zz != xx) VecCopy(zz,xx);
392 
393   ierr = VecGetArray(bb,&b); CHKERRQ(ierr);
394   ierr = VecGetArray(xx,&x); CHKERRQ(ierr);
395   tmp = a->solve_work;
396 
397   /* invert the permutations */
398   ierr = ISInvertPermutation(isrow,&invisrow); CHKERRQ(ierr);
399   ierr = ISInvertPermutation(iscol,&inviscol); CHKERRQ(ierr);
400   ierr = ISGetIndices(invisrow,&r); CHKERRQ(ierr);
401   ierr = ISGetIndices(inviscol,&c); CHKERRQ(ierr);
402 
403   /* copy the b into temp work space according to permutation */
404   for ( i=0; i<n; i++ ) tmp[c[i]] = b[i];
405 
406   /* forward solve the U^T */
407   for ( i=0; i<n; i++ ) {
408     v   = aa + a->diag[i] + shift;
409     vi  = aj + a->diag[i] + (!shift);
410     nz  = ai[i+1] - a->diag[i] - 1;
411     tmp[i] *= *v++;
412     while (nz--) {
413       tmp[*vi++ + shift] -= (*v++)*tmp[i];
414     }
415   }
416 
417   /* backward solve the L^T */
418   for ( i=n-1; i>=0; i-- ){
419     v   = aa + a->diag[i] - 1 + shift;
420     vi  = aj + a->diag[i] - 1 + shift;
421     nz  = a->diag[i] - ai[i];
422     while (nz--) {
423       tmp[*vi-- + shift] -= (*v--)*tmp[i];
424     }
425   }
426 
427   /* copy tmp into x according to permutation */
428   for ( i=0; i<n; i++ ) x[r[i]] += tmp[i];
429 
430   ierr = ISRestoreIndices(invisrow,&r); CHKERRQ(ierr);
431   ierr = ISRestoreIndices(inviscol,&c); CHKERRQ(ierr);
432   ierr = ISDestroy(invisrow); CHKERRQ(ierr);
433   ierr = ISDestroy(inviscol); CHKERRQ(ierr);
434 
435   PLogFlops(2*a->nz);
436   return 0;
437 }
438 /* ----------------------------------------------------------------*/
439 
440 int MatILUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,double f,int levels,Mat *fact)
441 {
442   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b;
443   IS         isicol;
444   int        *r,*ic, ierr, prow, n = a->m, *ai = a->i, *aj = a->j;
445   int        *ainew,*ajnew, jmax,*fill, *xi, nz, *im,*ajfill,*flev;
446   int        *dloc, idx, row,m,fm, nzf, nzi,len,  realloc = 0;
447   int        incrlev,nnz,i,shift = a->indexshift;
448 
449   if (n != a->n) SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:Matrix must be square");
450   if (!isrow) SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:Must have row permutation");
451   if (!iscol) SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:Must have column permutation");
452 
453   /* special case that simply copies fill pattern */
454   if (levels == 0 && ISIsIdentity(isrow) && ISIsIdentity(iscol)) {
455     ierr = MatCopyPrivate_SeqAIJ(A,fact,DO_NOT_COPY_VALUES); CHKERRQ(ierr);
456     (*fact)->factor = FACTOR_LU;
457     b               = (Mat_SeqAIJ *) (*fact)->data;
458     if (!b->diag) {
459       ierr = MatMarkDiag_SeqAIJ(*fact); CHKERRQ(ierr);
460     }
461     b->row          = isrow;
462     b->col          = iscol;
463     b->solve_work = (Scalar *) PetscMalloc((b->m+1)*sizeof(Scalar));CHKPTRQ(b->solve_work);
464     return 0;
465   }
466 
467   ierr = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr);
468   ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr);
469   ierr = ISGetIndices(isicol,&ic); CHKERRQ(ierr);
470 
471   /* get new row pointers */
472   ainew = (int *) PetscMalloc( (n+1)*sizeof(int) ); CHKPTRQ(ainew);
473   ainew[0] = -shift;
474   /* don't know how many column pointers are needed so estimate */
475   jmax = (int) (f*(ai[n]+!shift));
476   ajnew = (int *) PetscMalloc( (jmax)*sizeof(int) ); CHKPTRQ(ajnew);
477   /* ajfill is level of fill for each fill entry */
478   ajfill = (int *) PetscMalloc( (jmax)*sizeof(int) ); CHKPTRQ(ajfill);
479   /* fill is a linked list of nonzeros in active row */
480   fill = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(fill);
481   /* im is level for each filled value */
482   im = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(im);
483   /* dloc is location of diagonal in factor */
484   dloc = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(dloc);
485   dloc[0]  = 0;
486 
487   for ( prow=0; prow<n; prow++ ) {
488     /* first copy previous fill into linked list */
489     nzf     = nz  = ai[r[prow]+1] - ai[r[prow]];
490     xi      = aj + ai[r[prow]] + shift;
491     fill[n] = n;
492     while (nz--) {
493       fm  = n;
494       idx = ic[*xi++ + shift];
495       do {
496         m  = fm;
497         fm = fill[m];
498       } while (fm < idx);
499       fill[m]   = idx;
500       fill[idx] = fm;
501       im[idx]   = 0;
502     }
503     nzi = 0;
504     row = fill[n];
505     while ( row < prow ) {
506       incrlev = im[row] + 1;
507       nz      = dloc[row];
508       xi      = ajnew  + ainew[row] + shift + nz;
509       flev    = ajfill + ainew[row] + shift + nz + 1;
510       nnz     = ainew[row+1] - ainew[row] - nz - 1;
511       if (*xi++ + shift != row) {
512         SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:zero pivot");
513       }
514       fm      = row;
515       while (nnz-- > 0) {
516         idx = *xi++ + shift;
517         if (*flev + incrlev > levels) {
518           flev++;
519           continue;
520         }
521         do {
522           m  = fm;
523           fm = fill[m];
524         } while (fm < idx);
525         if (fm != idx) {
526           im[idx]   = *flev + incrlev;
527           fill[m]   = idx;
528           fill[idx] = fm;
529           fm        = idx;
530           nzf++;
531         }
532         else {
533           if (im[idx] > *flev + incrlev) im[idx] = *flev+incrlev;
534         }
535         flev++;
536       }
537       row = fill[row];
538       nzi++;
539     }
540     /* copy new filled row into permanent storage */
541     ainew[prow+1] = ainew[prow] + nzf;
542     if (ainew[prow+1] > jmax+1) {
543       /* allocate a longer ajnew */
544       int maxadd;
545       maxadd = (int) ((f*(ai[n]+!shift)*(n-prow+5))/n);
546       if (maxadd < nzf) maxadd = (n-prow)*(nzf+1);
547       jmax += maxadd;
548       xi = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(xi);
549       PetscMemcpy(xi,ajnew,(ainew[prow]+shift)*sizeof(int));
550       PetscFree(ajnew);
551       ajnew = xi;
552       /* allocate a longer ajfill */
553       xi = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(xi);
554       PetscMemcpy(xi,ajfill,(ainew[prow]+shift)*sizeof(int));
555       PetscFree(ajfill);
556       ajfill = xi;
557       realloc++;
558     }
559     xi          = ajnew + ainew[prow] + shift;
560     flev        = ajfill + ainew[prow] + shift;
561     dloc[prow]  = nzi;
562     fm          = fill[n];
563     while (nzf--) {
564       *xi++   = fm - shift;
565       *flev++ = im[fm];
566       fm      = fill[fm];
567     }
568   }
569   PetscFree(ajfill);
570   ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr);
571   ierr = ISRestoreIndices(isicol,&ic); CHKERRQ(ierr);
572   ierr = ISDestroy(isicol); CHKERRQ(ierr);
573   PetscFree(fill); PetscFree(im);
574 
575   PLogInfo((PetscObject)A,
576     "Info:MatILUFactorSymbolic_SeqAIJ:Realloc %d Fill ratio:given %g needed %g\n",
577                              realloc,f,((double)ainew[n])/((double)ai[prow]));
578 
579   /* put together the new matrix */
580   ierr = MatCreateSeqAIJ(A->comm,n, n, 0, 0, fact); CHKERRQ(ierr);
581   b = (Mat_SeqAIJ *) (*fact)->data;
582   PetscFree(b->imax);
583   b->singlemalloc = 0;
584   len = (ainew[n] + shift)*sizeof(Scalar);
585   /* the next line frees the default space generated by the Create() */
586   PetscFree(b->a); PetscFree(b->ilen);
587   b->a          = (Scalar *) PetscMalloc( len ); CHKPTRQ(b->a);
588   b->j          = ajnew;
589   b->i          = ainew;
590   for ( i=0; i<n; i++ ) dloc[i] += ainew[i];
591   b->diag       = dloc;
592   b->ilen       = 0;
593   b->imax       = 0;
594   b->row        = isrow;
595   b->col        = iscol;
596   b->solve_work = (Scalar *) PetscMalloc( (n+1)*sizeof(Scalar));
597   CHKPTRQ(b->solve_work);
598   /* In b structure:  Free imax, ilen, old a, old j.
599      Allocate dloc, solve_work, new a, new j */
600   PLogObjectMemory(*fact,(ainew[n]+shift-n) * (sizeof(int)+sizeof(Scalar)));
601   b->maxnz          = b->nz = ainew[n] + shift;
602   (*fact)->factor   = FACTOR_LU;
603   return 0;
604 }
605 
606 
607 
608 
609