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