xref: /petsc/src/mat/utils/zerodiag.c (revision 48b355211ab63a0645fe8df47d4e4766e0805ed1)
1ad608de0SBarry Smith #ifndef lint
2*48b35521SBarry Smith static char vcid[] = "$Id: zerodiag.c,v 1.1 1995/07/04 20:25:42 bsmith Exp bsmith $";
3ad608de0SBarry Smith #endif
4ad608de0SBarry Smith 
5ad608de0SBarry Smith /*
6ad608de0SBarry Smith     This file contains routines to reorder a matrix so that the diagonal
7*48b35521SBarry Smith     elements are nonzero.
8ad608de0SBarry Smith  */
9ad608de0SBarry Smith 
10*48b35521SBarry Smith #include "matimpl.h"
11ad608de0SBarry Smith #include <math.h>
12ad608de0SBarry Smith 
13*48b35521SBarry Smith #define SWAP(a,b) {int _t; _t = a; a = b; b = _t; }
14*48b35521SBarry Smith 
15*48b35521SBarry Smith /* Given a current row and current permutation, find a column permutation
16*48b35521SBarry Smith    that removes a zero diagonal */
17*48b35521SBarry Smith int SpiZeroFindPre_Private(Mat mat,int prow,int* row,int* col,Scalar repla,
18*48b35521SBarry Smith                            double atol,int* rc,Scalar* rcv )
19*48b35521SBarry Smith {
20*48b35521SBarry Smith   int      k, nz, repl, *j, kk, nnz, *jj;
21*48b35521SBarry Smith   Scalar   *v, *vv;
22*48b35521SBarry Smith 
23*48b35521SBarry Smith   MatGetRow( mat, row[prow], &nz, &j, &v );
24*48b35521SBarry Smith   for (k=0; k<nz; k++) {
25*48b35521SBarry Smith     if (col[j[k]] < prow && fabs(v[k]) > repla) {
26*48b35521SBarry Smith       /* See if this one will work */
27*48b35521SBarry Smith       repl  = col[j[k]];
28*48b35521SBarry Smith       MatGetRow( mat, row[repl], &nnz, &jj, &vv );
29*48b35521SBarry Smith       for (kk=0; kk<nnz; kk++) {
30*48b35521SBarry Smith 	if (col[jj[kk]] == prow && fabs(vv[kk]) > atol) {
31*48b35521SBarry Smith 	  *rcv = fabs(v[k]);
32*48b35521SBarry Smith 	  *rc  = repl;
33*48b35521SBarry Smith           MatRestoreRow( mat, row[repl], &nnz, &jj, &vv );
34*48b35521SBarry Smith           MatRestoreRow( mat, row[prow], &nz, &j, &v );
35*48b35521SBarry Smith 	  return 1;
36*48b35521SBarry Smith 	}
37*48b35521SBarry Smith       }
38*48b35521SBarry Smith       MatRestoreRow( mat, row[repl], &nnz, &jj, &vv );
39*48b35521SBarry Smith     }
40*48b35521SBarry Smith   }
41*48b35521SBarry Smith   MatRestoreRow( mat, row[prow], &nz, &j, &v );
42*48b35521SBarry Smith   return 0;
43*48b35521SBarry Smith }
44ad608de0SBarry Smith 
45ad608de0SBarry Smith /*@
46*48b35521SBarry Smith     MatReorderForNonzeroDiagonal - Changes matrix ordering to remove
47*48b35521SBarry Smith         zeros from diagonal. This may help in the LU factorization to
48*48b35521SBarry Smith         prevent a zero pivot.
49ad608de0SBarry Smith 
50ad608de0SBarry Smith     Input Parameters:
51ad608de0SBarry Smith .   mat  - matrix to reorder
52*48b35521SBarry Smith .   rmap,cmap - row and column permutations.  Usually obtained from
53*48b35521SBarry Smith .               MatGetReordering().
54ad608de0SBarry Smith 
55ad608de0SBarry Smith     Notes:
56ad608de0SBarry Smith     This is not intended as a replacement for pivoting for matrices that
57*48b35521SBarry Smith     have ``bad'' structure. It is only a stop-gap measure.
58ad608de0SBarry Smith 
59ad608de0SBarry Smith     Algorithm:
60ad608de0SBarry Smith     Column pivoting is used.  Choice of column is made by looking at the
61ad608de0SBarry Smith     non-zero elements in the row.  This algorithm is simple and fast but
62ad608de0SBarry Smith     does NOT guarentee that a non-singular or well conditioned
63ad608de0SBarry Smith     principle submatrix will be produced.
64ad608de0SBarry Smith @*/
65*48b35521SBarry Smith int MatReorderForNonzeroDiagonal(Mat mat,double atol,IS ris,IS cis )
66ad608de0SBarry Smith {
67*48b35521SBarry Smith   int      ierr, prow, k, nz, n, repl, *j, *col, *row, m;
68*48b35521SBarry Smith   Scalar   *v, repla;
69ad608de0SBarry Smith 
70*48b35521SBarry Smith   ierr = ISGetIndices(ris,&row); CHKERRQ(ierr);
71*48b35521SBarry Smith   ierr = ISGetIndices(cis,&col); CHKERRQ(ierr);
72*48b35521SBarry Smith   ierr = MatGetSize(mat,&m,&n); CHKERRQ(ierr);
73ad608de0SBarry Smith 
74ad608de0SBarry Smith   for (prow=0; prow<n; prow++) {
75*48b35521SBarry Smith     MatGetRow( mat, row[prow], &nz, &j, &v );
76*48b35521SBarry Smith     for (k=0; k<nz; k++) {if (col[j[k]] == prow) break;}
77ad608de0SBarry Smith     if (k >= nz || fabs(v[k]) <= atol) {
78ad608de0SBarry Smith       /* Element too small or zero; find the best candidate */
79ad608de0SBarry Smith       repl  = prow;
80ad608de0SBarry Smith       repla = (k >= nz) ? 0.0 : fabs(v[k]);
81*48b35521SBarry Smith       for (k=0; k<nz; k++) {
82ad608de0SBarry Smith 	if (col[j[k]] > prow && fabs(v[k]) > repla) {
83ad608de0SBarry Smith 	  repl = col[j[k]];
84ad608de0SBarry Smith 	  repla = fabs(v[k]);
85ad608de0SBarry Smith         }
86*48b35521SBarry Smith       }
87ad608de0SBarry Smith       if (prow == repl) {
88ad608de0SBarry Smith 	    /* Now we need to look for an element that allows us
89ad608de0SBarry Smith 	       to pivot with a previous column.  To do this, we need
90ad608de0SBarry Smith 	       to be sure that we don't introduce a zero in a previous
91ad608de0SBarry Smith 	       diagonal */
92*48b35521SBarry Smith         if (!SpiZeroFindPre_Private(mat,prow,row,col,repla,atol,&repl,&repla)){
93*48b35521SBarry Smith 	  SETERRQ(1,"Can not reorder matrix");
94ad608de0SBarry Smith 	}
95ad608de0SBarry Smith       }
96ad608de0SBarry Smith       SWAP(col[prow],col[repl]);
97ad608de0SBarry Smith     }
98*48b35521SBarry Smith     MatRestoreRow( mat, row[prow], &nz, &j, &v );
99ad608de0SBarry Smith   }
100*48b35521SBarry Smith   ierr = ISRestoreIndices(ris,&row); CHKERRQ(ierr);
101*48b35521SBarry Smith   ierr = ISRestoreIndices(cis,&col); CHKERRQ(ierr);
102ad608de0SBarry Smith   return 0;
103ad608de0SBarry Smith }
104*48b35521SBarry Smith 
105*48b35521SBarry Smith 
106*48b35521SBarry Smith 
107