xref: /petsc/src/mat/utils/zerodiag.c (revision 9c30b7d2697335155d7490a7e085415ee7b4a02a)
1 /*
2     This file contains routines to reorder a matrix so that the diagonal
3     elements are nonzero.
4  */
5 
6 #include "src/mat/matimpl.h"       /*I  "petscmat.h"  I*/
7 
8 #define SWAP(a,b) {int _t; _t = a; a = b; b = _t; }
9 
10 #undef __FUNCT__
11 #define __FUNCT__ "MatReorderForNonzeroDiagonal"
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.
16 
17     Collective on Mat
18 
19     Input Parameters:
20 +   mat  - matrix to reorder
21 -   rmap,cmap - row and column permutations.  Usually obtained from
22                MatGetOrdering().
23 
24     Level: intermediate
25 
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.
31 
32     Only works for SeqAIJ matrices
33 
34     Options Database Keys (When using KSP):
35 +      -pc_ilu_nonzeros_along_diagonal
36 -      -pc_lu_nonzeros_along_diagonal
37 
38     Algorithm Notes:
39     Column pivoting is used.
40 
41     1) Choice of column is made by looking at the
42        non-zero elements in the troublesome row for columns that are not yet
43        included (moving from left to right).
44 
45     2) If (1) fails we check all the columns to the left of the current row
46        and see if one of them has could be swapped. It can be swapped if
47        its corresponding row has a non-zero in the column it is being
48        swapped with; to make sure the previous nonzero diagonal remains
49        nonzero
50 
51 
52 @*/
53 int MatReorderForNonzeroDiagonal(Mat mat,PetscReal atol,IS ris,IS cis)
54 {
55   int ierr,(*f)(Mat,PetscReal,IS,IS);
56 
57   PetscFunctionBegin;
58   ierr = PetscObjectQueryFunction((PetscObject)mat,"MatReorderForNonzeroDiagonal_C",(void (**)(void))&f);CHKERRQ(ierr);
59   if (f) {
60     ierr = (*f)(mat,atol,ris,cis);CHKERRQ(ierr);
61   }
62   PetscFunctionReturn(0);
63 }
64 
65 EXTERN_C_BEGIN
66 #undef __FUNCT__
67 #define __FUNCT__ "MatReorderForNonzeroDiagonal_SeqAIJ"
68 int MatReorderForNonzeroDiagonal_SeqAIJ(Mat mat,PetscReal atol,IS ris,IS cis)
69 {
70   int         ierr,prow,k,nz,n,repl,*j,*col,*row,m,*icol,nnz,*jj,kk;
71   PetscScalar *v,*vv;
72   PetscReal   repla;
73   IS          icis;
74 
75   PetscFunctionBegin;
76   ierr = ISGetIndices(ris,&row);CHKERRQ(ierr);
77   ierr = ISGetIndices(cis,&col);CHKERRQ(ierr);
78   ierr = ISInvertPermutation(cis,PETSC_DECIDE,&icis);CHKERRQ(ierr);
79   ierr = ISGetIndices(icis,&icol);CHKERRQ(ierr);
80   ierr = MatGetSize(mat,&m,&n);CHKERRQ(ierr);
81 
82   for (prow=0; prow<n; prow++) {
83     ierr = MatGetRow(mat,row[prow],&nz,&j,&v);CHKERRQ(ierr);
84     for (k=0; k<nz; k++) {if (icol[j[k]] == prow) break;}
85     if (k >= nz || PetscAbsScalar(v[k]) <= atol) {
86       /* Element too small or zero; find the best candidate */
87       repla = (k >= nz) ? 0.0 : PetscAbsScalar(v[k]);
88       /*
89           Look for a later column we can swap with this one
90       */
91       for (k=0; k<nz; k++) {
92 	if (icol[j[k]] > prow && PetscAbsScalar(v[k]) > repla) {
93           /* found a suitable later column */
94 	  repl  = icol[j[k]];
95           SWAP(icol[col[prow]],icol[col[repl]]);
96           SWAP(col[prow],col[repl]);
97           goto found;
98         }
99       }
100       /*
101            Did not find a suitable later column so look for an earlier column
102 	   We need to be sure that we don't introduce a zero in a previous
103 	   diagonal
104       */
105       for (k=0; k<nz; k++) {
106         if (icol[j[k]] < prow && PetscAbsScalar(v[k]) > repla) {
107           /* See if this one will work */
108           repl  = icol[j[k]];
109           ierr = MatGetRow(mat,row[repl],&nnz,&jj,&vv);CHKERRQ(ierr);
110           for (kk=0; kk<nnz; kk++) {
111             if (icol[jj[kk]] == prow && PetscAbsScalar(vv[kk]) > atol) {
112               ierr = MatRestoreRow(mat,row[repl],&nnz,&jj,&vv);CHKERRQ(ierr);
113               SWAP(icol[col[prow]],icol[col[repl]]);
114               SWAP(col[prow],col[repl]);
115               goto found;
116 	    }
117           }
118           ierr = MatRestoreRow(mat,row[repl],&nnz,&jj,&vv);CHKERRQ(ierr);
119         }
120       }
121       /*
122           No column  suitable; instead check all future rows
123           Note: this will be very slow
124       */
125       for (k=prow+1; k<n; k++) {
126         ierr = MatGetRow(mat,row[k],&nnz,&jj,&vv);CHKERRQ(ierr);
127         for (kk=0; kk<nnz; kk++) {
128           if (icol[jj[kk]] == prow && PetscAbsScalar(vv[kk]) > atol) {
129             /* found a row */
130             SWAP(row[prow],row[k]);
131             goto found;
132           }
133         }
134         ierr = MatRestoreRow(mat,row[k],&nnz,&jj,&vv);CHKERRQ(ierr);
135       }
136 
137       found:;
138     }
139     ierr = MatRestoreRow(mat,row[prow],&nz,&j,&v);CHKERRQ(ierr);
140   }
141   ierr = ISRestoreIndices(ris,&row);CHKERRQ(ierr);
142   ierr = ISRestoreIndices(cis,&col);CHKERRQ(ierr);
143   ierr = ISRestoreIndices(icis,&icol);CHKERRQ(ierr);
144   ierr = ISDestroy(icis);CHKERRQ(ierr);
145   PetscFunctionReturn(0);
146 }
147 EXTERN_C_END
148 
149 
150