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