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