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: }