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