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