xref: /petsc/src/mat/impls/aij/seq/aijfact.c (revision f5bbd44e5d40b17e867d4d2fa155be2795fff4c4)
1 #ifndef lint
2 static char vcid[] = "$Id: aijfact.c,v 1.50 1995/12/12 05:24:01 bsmith Exp curfman $";
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,PetscNull,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   if (mat->inode.size) PetscFree(mat->inode.size);
234   PetscFree(mat);
235 
236   PetscMemcpy(A,C,sizeof(struct _Mat));
237   PetscHeaderDestroy(C);
238   return 0;
239 }
240 /* ----------------------------------------------------------- */
241 int MatSolve_SeqAIJ(Mat A,Vec bb, Vec xx)
242 {
243   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
244   IS         iscol = a->col, isrow = a->row;
245   int        *r,*c, ierr, i,  n = a->m, *vi, *ai = a->i, *aj = a->j;
246   int        nz,shift = a->indexshift;
247   Scalar     *x,*b,*tmp, *tmps, *aa = a->a, sum, *v;
248 
249   if (A->factor != FACTOR_LU) SETERRQ(1,"MatSolve_SeqAIJ:Not for unfactored matrix");
250 
251   ierr = VecGetArray(bb,&b); CHKERRQ(ierr);
252   ierr = VecGetArray(xx,&x); CHKERRQ(ierr);
253   tmp  = a->solve_work;
254 
255   ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
256   ierr = ISGetIndices(iscol,&c);CHKERRQ(ierr); c = c + (n-1);
257 
258   /* forward solve the lower triangular */
259   tmp[0] = b[*r++];
260   tmps   = tmp + shift;
261   for ( i=1; i<n; i++ ) {
262     v   = aa + ai[i] + shift;
263     vi  = aj + ai[i] + shift;
264     nz  = a->diag[i] - ai[i];
265     sum = b[*r++];
266     while (nz--) sum -= *v++ * tmps[*vi++];
267     tmp[i] = sum;
268   }
269 
270   /* backward solve the upper triangular */
271   for ( i=n-1; i>=0; i-- ){
272     v   = aa + a->diag[i] + (!shift);
273     vi  = aj + a->diag[i] + (!shift);
274     nz  = ai[i+1] - a->diag[i] - 1;
275     sum = tmp[i];
276     while (nz--) sum -= *v++ * tmps[*vi++];
277     x[*c--] = tmp[i] = sum*aa[a->diag[i]+shift];
278   }
279 
280   ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr);
281   ierr = ISRestoreIndices(iscol,&c); CHKERRQ(ierr);
282   PLogFlops(2*a->nz - a->n);
283   return 0;
284 }
285 int MatSolveAdd_SeqAIJ(Mat A,Vec bb, Vec yy, Vec xx)
286 {
287   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
288   IS         iscol = a->col, isrow = a->row;
289   int        *r,*c, ierr, i,  n = a->m, *vi, *ai = a->i, *aj = a->j;
290   int        nz, shift = a->indexshift;
291   Scalar     *x,*b,*tmp, *aa = a->a, sum, *v;
292 
293   if (A->factor != FACTOR_LU) SETERRQ(1,"MatSolveAdd_SeqAIJ:Not for unfactored matrix");
294   if (yy != xx) {ierr = VecCopy(yy,xx); CHKERRQ(ierr);}
295 
296   ierr = VecGetArray(bb,&b); CHKERRQ(ierr);
297   ierr = VecGetArray(xx,&x); CHKERRQ(ierr);
298   tmp  = a->solve_work;
299 
300   ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr);
301   ierr = ISGetIndices(iscol,&c); CHKERRQ(ierr); c = c + (n-1);
302 
303   /* forward solve the lower triangular */
304   tmp[0] = b[*r++];
305   for ( i=1; i<n; i++ ) {
306     v   = aa + ai[i] + shift;
307     vi  = aj + ai[i] + shift;
308     nz  = a->diag[i] - ai[i];
309     sum = b[*r++];
310     while (nz--) sum -= *v++ * tmp[*vi++ + shift];
311     tmp[i] = sum;
312   }
313 
314   /* backward solve the upper triangular */
315   for ( i=n-1; i>=0; i-- ){
316     v   = aa + a->diag[i] + (!shift);
317     vi  = aj + a->diag[i] + (!shift);
318     nz  = ai[i+1] - a->diag[i] - 1;
319     sum = tmp[i];
320     while (nz--) sum -= *v++ * tmp[*vi++ + shift];
321     tmp[i] = sum*aa[a->diag[i]+shift];
322     x[*c--] += tmp[i];
323   }
324 
325   ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr);
326   ierr = ISRestoreIndices(iscol,&c); CHKERRQ(ierr);
327   PLogFlops(2*a->nz);
328 
329   return 0;
330 }
331 /* -------------------------------------------------------------------*/
332 int MatSolveTrans_SeqAIJ(Mat A,Vec bb, Vec xx)
333 {
334   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
335   IS         iscol = a->col, isrow = a->row, invisrow,inviscol;
336   int        *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j;
337   int        nz,shift = a->indexshift;
338   Scalar     *x,*b,*tmp, *aa = a->a, *v;
339 
340   if (A->factor != FACTOR_LU)  SETERRQ(1,"MatSolveTrans_SeqAIJ:Not unfactored matrix");
341   ierr = VecGetArray(bb,&b); CHKERRQ(ierr);
342   ierr = VecGetArray(xx,&x); CHKERRQ(ierr);
343   tmp  = a->solve_work;
344 
345   /* invert the permutations */
346   ierr = ISInvertPermutation(isrow,&invisrow); CHKERRQ(ierr);
347   ierr = ISInvertPermutation(iscol,&inviscol); CHKERRQ(ierr);
348 
349   ierr = ISGetIndices(invisrow,&r); CHKERRQ(ierr);
350   ierr = ISGetIndices(inviscol,&c); CHKERRQ(ierr);
351 
352   /* copy the b into temp work space according to permutation */
353   for ( i=0; i<n; i++ ) tmp[c[i]] = b[i];
354 
355   /* forward solve the U^T */
356   for ( i=0; i<n; i++ ) {
357     v   = aa + a->diag[i] + shift;
358     vi  = aj + a->diag[i] + (!shift);
359     nz  = ai[i+1] - a->diag[i] - 1;
360     tmp[i] *= *v++;
361     while (nz--) {
362       tmp[*vi++ + shift] -= (*v++)*tmp[i];
363     }
364   }
365 
366   /* backward solve the L^T */
367   for ( i=n-1; i>=0; i-- ){
368     v   = aa + a->diag[i] - 1 + shift;
369     vi  = aj + a->diag[i] - 1 + shift;
370     nz  = a->diag[i] - ai[i];
371     while (nz--) {
372       tmp[*vi-- + shift] -= (*v--)*tmp[i];
373     }
374   }
375 
376   /* copy tmp into x according to permutation */
377   for ( i=0; i<n; i++ ) x[r[i]] = tmp[i];
378 
379   ierr = ISRestoreIndices(invisrow,&r); CHKERRQ(ierr);
380   ierr = ISRestoreIndices(inviscol,&c); CHKERRQ(ierr);
381   ierr = ISDestroy(invisrow); CHKERRQ(ierr);
382   ierr = ISDestroy(inviscol); CHKERRQ(ierr);
383 
384   PLogFlops(2*a->nz-a->n);
385   return 0;
386 }
387 
388 int MatSolveTransAdd_SeqAIJ(Mat A,Vec bb, Vec zz,Vec xx)
389 {
390   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
391   IS         iscol = a->col, isrow = a->row, invisrow,inviscol;
392   int        *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j;
393   int        nz,shift = a->indexshift;
394   Scalar     *x,*b,*tmp, *aa = a->a, *v;
395 
396   if (A->factor != FACTOR_LU)SETERRQ(1,"MatSolveTransAdd_SeqAIJ:Not unfactored matrix");
397   if (zz != xx) VecCopy(zz,xx);
398 
399   ierr = VecGetArray(bb,&b); CHKERRQ(ierr);
400   ierr = VecGetArray(xx,&x); CHKERRQ(ierr);
401   tmp = a->solve_work;
402 
403   /* invert the permutations */
404   ierr = ISInvertPermutation(isrow,&invisrow); CHKERRQ(ierr);
405   ierr = ISInvertPermutation(iscol,&inviscol); CHKERRQ(ierr);
406   ierr = ISGetIndices(invisrow,&r); CHKERRQ(ierr);
407   ierr = ISGetIndices(inviscol,&c); CHKERRQ(ierr);
408 
409   /* copy the b into temp work space according to permutation */
410   for ( i=0; i<n; i++ ) tmp[c[i]] = b[i];
411 
412   /* forward solve the U^T */
413   for ( i=0; i<n; i++ ) {
414     v   = aa + a->diag[i] + shift;
415     vi  = aj + a->diag[i] + (!shift);
416     nz  = ai[i+1] - a->diag[i] - 1;
417     tmp[i] *= *v++;
418     while (nz--) {
419       tmp[*vi++ + shift] -= (*v++)*tmp[i];
420     }
421   }
422 
423   /* backward solve the L^T */
424   for ( i=n-1; i>=0; i-- ){
425     v   = aa + a->diag[i] - 1 + shift;
426     vi  = aj + a->diag[i] - 1 + shift;
427     nz  = a->diag[i] - ai[i];
428     while (nz--) {
429       tmp[*vi-- + shift] -= (*v--)*tmp[i];
430     }
431   }
432 
433   /* copy tmp into x according to permutation */
434   for ( i=0; i<n; i++ ) x[r[i]] += tmp[i];
435 
436   ierr = ISRestoreIndices(invisrow,&r); CHKERRQ(ierr);
437   ierr = ISRestoreIndices(inviscol,&c); CHKERRQ(ierr);
438   ierr = ISDestroy(invisrow); CHKERRQ(ierr);
439   ierr = ISDestroy(inviscol); CHKERRQ(ierr);
440 
441   PLogFlops(2*a->nz);
442   return 0;
443 }
444 /* ----------------------------------------------------------------*/
445 
446 int MatILUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,double f,int levels,Mat *fact)
447 {
448   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b;
449   IS         isicol;
450   int        *r,*ic, ierr, prow, n = a->m, *ai = a->i, *aj = a->j;
451   int        *ainew,*ajnew, jmax,*fill, *xi, nz, *im,*ajfill,*flev;
452   int        *dloc, idx, row,m,fm, nzf, nzi,len,  realloc = 0;
453   int        incrlev,nnz,i,shift = a->indexshift;
454 
455   if (n != a->n) SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:Matrix must be square");
456   if (!isrow) SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:Must have row permutation");
457   if (!iscol) SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:Must have column permutation");
458 
459   /* special case that simply copies fill pattern */
460   if (levels == 0 && ISIsIdentity(isrow) && ISIsIdentity(iscol)) {
461     ierr = MatCopyPrivate_SeqAIJ(A,fact,DO_NOT_COPY_VALUES); CHKERRQ(ierr);
462     (*fact)->factor = FACTOR_LU;
463     b               = (Mat_SeqAIJ *) (*fact)->data;
464     if (!b->diag) {
465       ierr = MatMarkDiag_SeqAIJ(*fact); CHKERRQ(ierr);
466     }
467     b->row          = isrow;
468     b->col          = iscol;
469     b->solve_work = (Scalar *) PetscMalloc((b->m+1)*sizeof(Scalar));CHKPTRQ(b->solve_work);
470     return 0;
471   }
472 
473   ierr = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr);
474   ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr);
475   ierr = ISGetIndices(isicol,&ic); CHKERRQ(ierr);
476 
477   /* get new row pointers */
478   ainew = (int *) PetscMalloc( (n+1)*sizeof(int) ); CHKPTRQ(ainew);
479   ainew[0] = -shift;
480   /* don't know how many column pointers are needed so estimate */
481   jmax = (int) (f*(ai[n]+!shift));
482   ajnew = (int *) PetscMalloc( (jmax)*sizeof(int) ); CHKPTRQ(ajnew);
483   /* ajfill is level of fill for each fill entry */
484   ajfill = (int *) PetscMalloc( (jmax)*sizeof(int) ); CHKPTRQ(ajfill);
485   /* fill is a linked list of nonzeros in active row */
486   fill = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(fill);
487   /* im is level for each filled value */
488   im = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(im);
489   /* dloc is location of diagonal in factor */
490   dloc = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(dloc);
491   dloc[0]  = 0;
492   for ( prow=0; prow<n; prow++ ) {
493     /* first copy previous fill into linked list */
494     nzf     = nz  = ai[r[prow]+1] - ai[r[prow]];
495     xi      = aj + ai[r[prow]] + shift;
496     fill[n] = n;
497     while (nz--) {
498       fm  = n;
499       idx = ic[*xi++ + shift];
500       do {
501         m  = fm;
502         fm = fill[m];
503       } while (fm < idx);
504       fill[m]   = idx;
505       fill[idx] = fm;
506       im[idx]   = 0;
507     }
508     nzi = 0;
509     row = fill[n];
510     while ( row < prow ) {
511       incrlev = im[row] + 1;
512       nz      = dloc[row];
513       xi      = ajnew  + ainew[row] + shift + nz;
514       flev    = ajfill + ainew[row] + shift + nz + 1;
515       nnz     = ainew[row+1] - ainew[row] - nz - 1;
516       if (*xi++ + shift != row) {
517         SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:zero pivot");
518       }
519       fm      = row;
520       while (nnz-- > 0) {
521         idx = *xi++ + shift;
522         if (*flev + incrlev > levels) {
523           flev++;
524           continue;
525         }
526         do {
527           m  = fm;
528           fm = fill[m];
529         } while (fm < idx);
530         if (fm != idx) {
531           im[idx]   = *flev + incrlev;
532           fill[m]   = idx;
533           fill[idx] = fm;
534           fm        = idx;
535           nzf++;
536         }
537         else {
538           if (im[idx] > *flev + incrlev) im[idx] = *flev+incrlev;
539         }
540         flev++;
541       }
542       row = fill[row];
543       nzi++;
544     }
545     /* copy new filled row into permanent storage */
546     ainew[prow+1] = ainew[prow] + nzf;
547     if (ainew[prow+1] > jmax-shift) {
548       /* allocate a longer ajnew */
549       int maxadd;
550       maxadd = (int) ((f*(ai[n]+!shift)*(n-prow+5))/n);
551       if (maxadd < nzf) maxadd = (n-prow)*(nzf+1);
552       jmax += maxadd;
553       xi = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(xi);
554       PetscMemcpy(xi,ajnew,(ainew[prow]+shift)*sizeof(int));
555       PetscFree(ajnew);
556       ajnew = xi;
557       /* allocate a longer ajfill */
558       xi = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(xi);
559       PetscMemcpy(xi,ajfill,(ainew[prow]+shift)*sizeof(int));
560       PetscFree(ajfill);
561       ajfill = xi;
562       realloc++;
563     }
564     xi          = ajnew + ainew[prow] + shift;
565     flev        = ajfill + ainew[prow] + shift;
566     dloc[prow]  = nzi;
567     fm          = fill[n];
568     while (nzf--) {
569       *xi++   = fm - shift;
570       *flev++ = im[fm];
571       fm      = fill[fm];
572     }
573   }
574   PetscFree(ajfill);
575   ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr);
576   ierr = ISRestoreIndices(isicol,&ic); CHKERRQ(ierr);
577   ierr = ISDestroy(isicol); CHKERRQ(ierr);
578   PetscFree(fill); PetscFree(im);
579 
580   PLogInfo((PetscObject)A,
581     "Info:MatILUFactorSymbolic_SeqAIJ:Realloc %d Fill ratio:given %g needed %g\n",
582                              realloc,f,((double)ainew[n])/((double)ai[prow]));
583 
584   /* put together the new matrix */
585   ierr = MatCreateSeqAIJ(A->comm,n,n,0,PetscNull,fact); CHKERRQ(ierr);
586   b = (Mat_SeqAIJ *) (*fact)->data;
587   PetscFree(b->imax);
588   b->singlemalloc = 0;
589   len = (ainew[n] + shift)*sizeof(Scalar);
590   /* the next line frees the default space generated by the Create() */
591   PetscFree(b->a); PetscFree(b->ilen);
592   b->a          = (Scalar *) PetscMalloc( len ); CHKPTRQ(b->a);
593   b->j          = ajnew;
594   b->i          = ainew;
595   for ( i=0; i<n; i++ ) dloc[i] += ainew[i];
596   b->diag       = dloc;
597   b->ilen       = 0;
598   b->imax       = 0;
599   b->row        = isrow;
600   b->col        = iscol;
601   b->solve_work = (Scalar *) PetscMalloc( (n+1)*sizeof(Scalar));
602   CHKPTRQ(b->solve_work);
603   /* In b structure:  Free imax, ilen, old a, old j.
604      Allocate dloc, solve_work, new a, new j */
605   PLogObjectMemory(*fact,(ainew[n]+shift-n) * (sizeof(int)+sizeof(Scalar)));
606   b->maxnz          = b->nz = ainew[n] + shift;
607   (*fact)->factor   = FACTOR_LU;
608   return 0;
609 }
610 
611 
612 
613 
614