xref: /petsc/src/mat/utils/zerodiag.c (revision 5615d1e584023db9367fb782d85b1b4ebbb8df18)
1ad608de0SBarry Smith #ifndef lint
2*5615d1e5SSatish Balay static char vcid[] = "$Id: zerodiag.c,v 1.12 1997/01/01 03:38:57 bsmith Exp balay $";
3ad608de0SBarry Smith #endif
4ad608de0SBarry Smith 
5ad608de0SBarry Smith /*
6ad608de0SBarry Smith     This file contains routines to reorder a matrix so that the diagonal
748b35521SBarry Smith     elements are nonzero.
8ad608de0SBarry Smith  */
9ad608de0SBarry Smith 
1070f55243SBarry Smith #include "src/mat/matimpl.h"       /*I  "mat.h"  I*/
11ad608de0SBarry Smith #include <math.h>
12ad608de0SBarry Smith 
1348b35521SBarry Smith #define SWAP(a,b) {int _t; _t = a; a = b; b = _t; }
1448b35521SBarry Smith 
15*5615d1e5SSatish Balay #undef __FUNC__
16*5615d1e5SSatish Balay #define __FUNC__ "MatZeroFindPre_Private"
1748b35521SBarry Smith /* Given a current row and current permutation, find a column permutation
1848b35521SBarry Smith    that removes a zero diagonal */
19d5d45c9bSBarry Smith int MatZeroFindPre_Private(Mat mat,int prow,int* row,int* col,double repla,
20d93a2b8dSBarry Smith                            double atol,int* rc,double* rcv )
2148b35521SBarry Smith {
2290f02eecSBarry Smith   int      k, nz, repl, *j, kk, nnz, *jj,ierr;
2348b35521SBarry Smith   Scalar   *v, *vv;
2448b35521SBarry Smith 
2590f02eecSBarry Smith   ierr = MatGetRow( mat, row[prow], &nz, &j, &v ); CHKERRQ(ierr);
2648b35521SBarry Smith   for (k=0; k<nz; k++) {
27cddf8d76SBarry Smith     if (col[j[k]] < prow && PetscAbsScalar(v[k]) > repla) {
2848b35521SBarry Smith       /* See if this one will work */
2948b35521SBarry Smith       repl  = col[j[k]];
3090f02eecSBarry Smith       ierr = MatGetRow( mat, row[repl], &nnz, &jj, &vv ); CHKERRQ(ierr);
3148b35521SBarry Smith       for (kk=0; kk<nnz; kk++) {
32cddf8d76SBarry Smith 	if (col[jj[kk]] == prow && PetscAbsScalar(vv[kk]) > atol) {
33cddf8d76SBarry Smith 	  *rcv = PetscAbsScalar(v[k]);
3448b35521SBarry Smith 	  *rc  = repl;
3590f02eecSBarry Smith           ierr = MatRestoreRow( mat, row[repl], &nnz, &jj, &vv ); CHKERRQ(ierr);
3690f02eecSBarry Smith           ierr = MatRestoreRow( mat, row[prow], &nz, &j, &v ); CHKERRQ(ierr);
3748b35521SBarry Smith 	  return 1;
3848b35521SBarry Smith 	}
3948b35521SBarry Smith       }
4090f02eecSBarry Smith       ierr = MatRestoreRow( mat, row[repl], &nnz, &jj, &vv ); CHKERRQ(ierr);
4148b35521SBarry Smith     }
4248b35521SBarry Smith   }
4390f02eecSBarry Smith   ierr = MatRestoreRow( mat, row[prow], &nz, &j, &v ); CHKERRQ(ierr);
4448b35521SBarry Smith   return 0;
4548b35521SBarry Smith }
46ad608de0SBarry Smith 
47*5615d1e5SSatish Balay #undef __FUNC__
48*5615d1e5SSatish Balay #define __FUNC__ "MatReorderForNonzeroDiagonal"
49ad608de0SBarry Smith /*@
5048b35521SBarry Smith     MatReorderForNonzeroDiagonal - Changes matrix ordering to remove
5148b35521SBarry Smith         zeros from diagonal. This may help in the LU factorization to
5248b35521SBarry Smith         prevent a zero pivot.
53ad608de0SBarry Smith 
54ad608de0SBarry Smith     Input Parameters:
55ad608de0SBarry Smith .   mat  - matrix to reorder
5648b35521SBarry Smith .   rmap,cmap - row and column permutations.  Usually obtained from
5748b35521SBarry Smith .               MatGetReordering().
58ad608de0SBarry Smith 
59ad608de0SBarry Smith     Notes:
60ad608de0SBarry Smith     This is not intended as a replacement for pivoting for matrices that
6148b35521SBarry Smith     have ``bad'' structure. It is only a stop-gap measure.
62ad608de0SBarry Smith 
63ad608de0SBarry Smith     Algorithm:
64ad608de0SBarry Smith     Column pivoting is used.  Choice of column is made by looking at the
65ad608de0SBarry Smith     non-zero elements in the row.  This algorithm is simple and fast but
66ad608de0SBarry Smith     does NOT guarentee that a non-singular or well conditioned
67ad608de0SBarry Smith     principle submatrix will be produced.
68ad608de0SBarry Smith @*/
6948b35521SBarry Smith int MatReorderForNonzeroDiagonal(Mat mat,double atol,IS ris,IS cis )
70ad608de0SBarry Smith {
7148b35521SBarry Smith   int      ierr, prow, k, nz, n, repl, *j, *col, *row, m;
72d93a2b8dSBarry Smith   Scalar   *v;
73d93a2b8dSBarry Smith   double   repla;
74ad608de0SBarry Smith 
7590f02eecSBarry Smith   PetscValidHeaderSpecific(mat,MAT_COOKIE);
7690f02eecSBarry Smith   PetscValidHeaderSpecific(ris,IS_COOKIE);
7790f02eecSBarry Smith   PetscValidHeaderSpecific(cis,IS_COOKIE);
7890f02eecSBarry Smith 
7948b35521SBarry Smith   ierr = ISGetIndices(ris,&row); CHKERRQ(ierr);
8048b35521SBarry Smith   ierr = ISGetIndices(cis,&col); CHKERRQ(ierr);
8148b35521SBarry Smith   ierr = MatGetSize(mat,&m,&n); CHKERRQ(ierr);
82ad608de0SBarry Smith 
83ad608de0SBarry Smith   for (prow=0; prow<n; prow++) {
8490f02eecSBarry Smith     ierr = MatGetRow( mat, row[prow], &nz, &j, &v ); CHKERRQ(ierr);
8548b35521SBarry Smith     for (k=0; k<nz; k++) {if (col[j[k]] == prow) break;}
86cddf8d76SBarry Smith     if (k >= nz || PetscAbsScalar(v[k]) <= atol) {
87ad608de0SBarry Smith       /* Element too small or zero; find the best candidate */
88ad608de0SBarry Smith       repl  = prow;
89cddf8d76SBarry Smith       repla = (k >= nz) ? 0.0 : PetscAbsScalar(v[k]);
9048b35521SBarry Smith       for (k=0; k<nz; k++) {
91cddf8d76SBarry Smith 	if (col[j[k]] > prow && PetscAbsScalar(v[k]) > repla) {
92ad608de0SBarry Smith 	  repl = col[j[k]];
93cddf8d76SBarry Smith 	  repla = PetscAbsScalar(v[k]);
94ad608de0SBarry Smith         }
9548b35521SBarry Smith       }
96ad608de0SBarry Smith       if (prow == repl) {
97ad608de0SBarry Smith 	    /* Now we need to look for an element that allows us
98ad608de0SBarry Smith 	       to pivot with a previous column.  To do this, we need
99ad608de0SBarry Smith 	       to be sure that we don't introduce a zero in a previous
100ad608de0SBarry Smith 	       diagonal */
101d5d45c9bSBarry Smith         if (!MatZeroFindPre_Private(mat,prow,row,col,repla,atol,&repl,&repla)){
102e3372554SBarry Smith 	  SETERRQ(1,0,"Can not reorder matrix");
103ad608de0SBarry Smith 	}
104ad608de0SBarry Smith       }
105ad608de0SBarry Smith       SWAP(col[prow],col[repl]);
106ad608de0SBarry Smith     }
10790f02eecSBarry Smith     ierr = MatRestoreRow( mat, row[prow], &nz, &j, &v ); CHKERRQ(ierr);
108ad608de0SBarry Smith   }
10948b35521SBarry Smith   ierr = ISRestoreIndices(ris,&row); CHKERRQ(ierr);
11048b35521SBarry Smith   ierr = ISRestoreIndices(cis,&col); CHKERRQ(ierr);
111ad608de0SBarry Smith   return 0;
112ad608de0SBarry Smith }
11348b35521SBarry Smith 
11448b35521SBarry Smith 
11548b35521SBarry Smith 
116