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