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