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