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