Actual source code: zerodiag.c
1: /*$Id: zerodiag.c,v 1.44 2001/08/06 21:16:10 bsmith Exp $*/
3: /*
4: This file contains routines to reorder a matrix so that the diagonal
5: elements are nonzero.
6: */
8: #include src/mat/matimpl.h
10: #define SWAP(a,b) {int _t; _t = a; a = b; b = _t; }
12: /*@
13: MatReorderForNonzeroDiagonal - Changes matrix ordering to remove
14: zeros from diagonal. This may help in the LU factorization to
15: prevent a zero pivot.
17: Collective on Mat
19: Input Parameters:
20: + mat - matrix to reorder
21: - rmap,cmap - row and column permutations. Usually obtained from
22: MatGetOrdering().
24: Level: intermediate
26: Notes:
27: This is not intended as a replacement for pivoting for matrices that
28: have ``bad'' structure. It is only a stop-gap measure. Should be called
29: after a call to MatGetOrdering(), this routine changes the column
30: ordering defined in cis.
32: Options Database Keys (When using SLES):
33: + -pc_ilu_nonzeros_along_diagonal
34: - -pc_lu_nonzeros_along_diagonal
36: Algorithm Notes:
37: Column pivoting is used.
39: 1) Choice of column is made by looking at the
40: non-zero elements in the troublesome row for columns that are not yet
41: included (moving from left to right).
42:
43: 2) If (1) fails we check all the columns to the left of the current row
44: and see if one of them has could be swapped. It can be swapped if
45: its corresponding row has a non-zero in the column it is being
46: swapped with; to make sure the previous nonzero diagonal remains
47: nonzero
50: @*/
51: int MatReorderForNonzeroDiagonal(Mat mat,PetscReal atol,IS ris,IS cis)
52: {
53: int ierr,prow,k,nz,n,repl,*j,*col,*row,m,*icol,nnz,*jj,kk;
54: PetscScalar *v,*vv;
55: PetscReal repla;
56: IS icis;
62:
63: ISGetIndices(ris,&row);
64: ISGetIndices(cis,&col);
65: ISInvertPermutation(cis,PETSC_DECIDE,&icis);
66: ISGetIndices(icis,&icol);
67: MatGetSize(mat,&m,&n);
69: for (prow=0; prow<n; prow++) {
70: MatGetRow(mat,row[prow],&nz,&j,&v);
71: for (k=0; k<nz; k++) {if (icol[j[k]] == prow) break;}
72: if (k >= nz || PetscAbsScalar(v[k]) <= atol) {
73: /* Element too small or zero; find the best candidate */
74: repla = (k >= nz) ? 0.0 : PetscAbsScalar(v[k]);
75: /*
76: Look for a later column we can swap with this one
77: */
78: for (k=0; k<nz; k++) {
79: if (icol[j[k]] > prow && PetscAbsScalar(v[k]) > repla) {
80: /* found a suitable later column */
81: repl = icol[j[k]];
82: SWAP(icol[col[prow]],icol[col[repl]]);
83: SWAP(col[prow],col[repl]);
84: goto found;
85: }
86: }
87: /*
88: Did not find a suitable later column so look for an earlier column
89: We need to be sure that we don't introduce a zero in a previous
90: diagonal
91: */
92: for (k=0; k<nz; k++) {
93: if (icol[j[k]] < prow && PetscAbsScalar(v[k]) > repla) {
94: /* See if this one will work */
95: repl = icol[j[k]];
96: MatGetRow(mat,row[repl],&nnz,&jj,&vv);
97: for (kk=0; kk<nnz; kk++) {
98: if (icol[jj[kk]] == prow && PetscAbsScalar(vv[kk]) > atol) {
99: MatRestoreRow(mat,row[repl],&nnz,&jj,&vv);
100: SWAP(icol[col[prow]],icol[col[repl]]);
101: SWAP(col[prow],col[repl]);
102: goto found;
103: }
104: }
105: MatRestoreRow(mat,row[repl],&nnz,&jj,&vv);
106: }
107: }
108: /*
109: No column suitable; instead check all future rows
110: Note: this will be very slow
111: */
112: for (k=prow+1; k<n; k++) {
113: MatGetRow(mat,row[k],&nnz,&jj,&vv);
114: for (kk=0; kk<nnz; kk++) {
115: if (icol[jj[kk]] == prow && PetscAbsScalar(vv[kk]) > atol) {
116: /* found a row */
117: SWAP(row[prow],row[k]);
118: goto found;
119: }
120: }
121: MatRestoreRow(mat,row[k],&nnz,&jj,&vv);
122: }
124: found:;
125: }
126: MatRestoreRow(mat,row[prow],&nz,&j,&v);
127: }
128: ISRestoreIndices(ris,&row);
129: ISRestoreIndices(cis,&col);
130: ISRestoreIndices(icis,&icol);
131: ISDestroy(icis);
132: return(0);
133: }