xref: /petsc/src/mat/utils/zerodiag.c (revision 5f051944de4795f161c253b7ab3f164b83f799d9)
1 #ifdef PETSC_RCS_HEADER
2 static char vcid[] = "$Id: zerodiag.c,v 1.24 1998/11/04 16:18:38 bsmith Exp bsmith $";
3 #endif
4 
5 /*
6     This file contains routines to reorder a matrix so that the diagonal
7     elements are nonzero.
8  */
9 
10 #include "src/mat/matimpl.h"       /*I  "mat.h"  I*/
11 #include <math.h>
12 
13 #define SWAP(a,b) {int _t; _t = a; a = b; b = _t; }
14 
15 #undef __FUNC__
16 #define __FUNC__ "MatZeroFindPre_Private"
17 /*
18    Given a current row and current permutation, find a column permutation
19    that removes a zero diagonal.
20 */
21 int MatZeroFindPre_Private(Mat mat,int prow,int* row,int* col,double repla,
22                            double atol,int* rc,double* rcv,int nz, int *j, Scalar *v)
23 {
24   int      k, repl, kk, nnz, *jj,ierr;
25   Scalar   *vv;
26 
27   PetscFunctionBegin;
28    /*
29       Here one could sort the col[j[k]] to try to select the column closest
30      to the diagonal (in the new ordering) that satisfies the criteria
31   */
32   for (k=0; k<nz; k++) {
33     if (col[j[k]] < prow && PetscAbsScalar(v[k]) > repla) {
34       /* See if this one will work */
35       repl  = col[j[k]];
36       ierr = MatGetRow( mat, row[repl], &nnz, &jj, &vv ); CHKERRQ(ierr);
37       for (kk=0; kk<nnz; kk++) {
38 	if (col[jj[kk]] == prow && PetscAbsScalar(vv[kk]) > atol) {
39 	  *rcv = PetscAbsScalar(v[k]);
40 	  *rc  = repl;
41           ierr = MatRestoreRow( mat, row[repl], &nnz, &jj, &vv ); CHKERRQ(ierr);
42 	  PetscFunctionReturn(1);
43 	}
44       }
45       ierr = MatRestoreRow( mat, row[repl], &nnz, &jj, &vv ); CHKERRQ(ierr);
46     }
47   }
48   PetscFunctionReturn(0);
49 }
50 
51 #undef __FUNC__
52 #define __FUNC__ "MatReorderForNonzeroDiagonal"
53 /*@
54     MatReorderForNonzeroDiagonal - Changes matrix ordering to remove
55     zeros from diagonal. This may help in the LU factorization to
56     prevent a zero pivot.
57 
58     Collective on Mat
59 
60     Input Parameters:
61 +   mat  - matrix to reorder
62 -   rmap,cmap - row and column permutations.  Usually obtained from
63                MatGetReordering().
64 
65     Notes:
66     This is not intended as a replacement for pivoting for matrices that
67     have ``bad'' structure. It is only a stop-gap measure. Should be called
68     after a call to MatGetReordering(), this routine changes the column
69     ordering defined in cis.
70 
71     Options Database Keys (When using SLES):
72 +      -pc_ilu_nonzeros_along_diagonal
73 -      -pc_lu_nonzeros_along_diagonal
74 
75     Algorithm:
76     Column pivoting is used.  Choice of column is made by looking at the
77     non-zero elements in the row.  This algorithm is simple and fast but
78     does NOT guarantee that a non-singular or well conditioned
79     principle submatrix will be produced.
80 
81 @*/
82 int MatReorderForNonzeroDiagonal(Mat mat,double atol,IS ris,IS cis )
83 {
84   int      ierr, prow, k, nz, n, repl, *j, *col, *row, m;
85   Scalar   *v;
86   double   repla;
87 
88   PetscFunctionBegin;
89   PetscValidHeaderSpecific(mat,MAT_COOKIE);
90   PetscValidHeaderSpecific(ris,IS_COOKIE);
91   PetscValidHeaderSpecific(cis,IS_COOKIE);
92 
93   ierr = ISGetIndices(ris,&row); CHKERRQ(ierr);
94   ierr = ISGetIndices(cis,&col); CHKERRQ(ierr);
95   ierr = MatGetSize(mat,&m,&n); CHKERRQ(ierr);
96 
97   for (prow=0; prow<n; prow++) {
98     ierr = MatGetRow( mat, row[prow], &nz, &j, &v ); CHKERRQ(ierr);
99     for (k=0; k<nz; k++) {if (col[j[k]] == prow) break;}
100     if (k >= nz || PetscAbsScalar(v[k]) <= atol) {
101       /* Element too small or zero; find the best candidate */
102       repl  = prow;
103       repla = (k >= nz) ? 0.0 : PetscAbsScalar(v[k]);
104       /*
105         Here one could sort the col[j[k]] list to try to select the
106         column closest to the diagonal in the new ordering. (Note have
107         to permute the v[k] values as well, and use a fixed bound on the
108         quality of repla rather then looking for the absolute largest.
109       */
110       for (k=0; k<nz; k++) {
111 	if (col[j[k]] > prow && PetscAbsScalar(v[k]) > repla) {
112 	  repl  = col[j[k]];
113 	  repla = PetscAbsScalar(v[k]);
114         }
115       }
116       if (prow == repl) {
117 	/*
118            Look for an element that allows us
119 	   to pivot with a previous column.  To do this, we need
120 	   to be sure that we don't introduce a zero in a previous
121 	   diagonal
122         */
123         if (!MatZeroFindPre_Private(mat,prow,row,col,repla,atol,&repl,&repla,nz,j,v)){
124           (*PetscErrorPrintf)("Permuted row number %d\n",prow);
125 	  SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,0,"Cannot reorder matrix to eliminate zero diagonal entry");
126 	}
127       }
128       SWAP(col[prow],col[repl]);
129     }
130     ierr = MatRestoreRow( mat, row[prow], &nz, &j, &v ); CHKERRQ(ierr);
131   }
132   ierr = ISRestoreIndices(ris,&row); CHKERRQ(ierr);
133   ierr = ISRestoreIndices(cis,&col); CHKERRQ(ierr);
134   PetscFunctionReturn(0);
135 }
136 
137 
138 
139