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