PETSC_EXTERN PetscErrorCode MatGetOrdering_WBM(Mat mat, MatOrderingType type, IS *row, IS *col)
{
PetscScalar *a, *dw;
const PetscInt *ia, *ja;
const PetscInt job = 5;
PetscInt *perm, nrow, ncol, nnz, liw, *iw, ldw, i;
PetscBool done;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
ncol = nrow;
nnz = ia[nrow];
if (!done) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = MatSeqAIJGetArray(mat, &a);CHKERRQ(ierr);
switch (job) {
case 1: liw = 4*nrow + ncol; ldw = 0;break;
case 2: liw = 2*nrow + 2*ncol; ldw = ncol;break;
case 3: liw = 8*nrow + 2*ncol + nnz; ldw = nnz;break;
case 4: liw = 3*nrow + 2*ncol; ldw = 2*ncol + nnz;break;
case 5: liw = 3*nrow + 2*ncol; ldw = nrow + 2*ncol + nnz;break;
}
ierr = PetscMalloc3(liw,&iw,ldw,&dw,nrow,&perm);CHKERRQ(ierr);
#if defined(PETSC_HAVE_SUPERLU_DIST)
{
PetscInt num, info[10], icntl[10];
ierr = mc64id_dist(icntl);
if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"HSL mc64id_dist returned %d\n",ierr);
icntl[0] = 0; /* allow printing error messages (f2c'd code uses if non-negative, ignores value otherwise) */
icntl[1] = -1; /* suppress warnings */
icntl[2] = -1; /* ignore diagnostic output [default] */
icntl[3] = 0; /* perform consistency checks [default] */
ierr = mc64ad_dist(&job, &nrow, &nnz, ia, ja, a, &num, perm, &liw, iw, &ldw, dw, icntl, info);
if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"HSL mc64ad_dist returned %d\n",ierr);
}
#else
SETERRQ(PetscObjectComm((PetscObject) mat), PETSC_ERR_SUP, "WBM using MC64 does not support complex numbers");
#endif
ierr = MatRestoreRowIJ(mat, 1, PETSC_TRUE, PETSC_TRUE, NULL, &ia, &ja, &done);CHKERRQ(ierr);
for (i = 0; i < nrow; ++i) perm[i]--;
/* If job == 5, dw[0..ncols] contains the column scaling and dw[ncols..ncols+nrows] contains the row scaling */
ierr = ISCreateStride(PETSC_COMM_SELF, nrow, 0, 1, row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,col);CHKERRQ(ierr);
ierr = PetscFree3(iw,dw,perm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int
dldperm_dist(int_t job, int_t n, int_t nnz, int_t colptr[], int_t adjncy[],
double nzval[], int_t *perm, double u[], double v[])
{
int_t i, liw, ldw, num;
int_t *iw, icntl[10], info[10];
double *dw;
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(0, "Enter dldperm_dist()");
#endif
liw = 5*n;
if ( job == 3 ) liw = 10*n + nnz;
if ( !(iw = intMalloc_dist(liw)) ) ABORT("Malloc fails for iw[]");
ldw = 3*n + nnz;
if ( !(dw = doubleMalloc_dist(ldw)) ) ABORT("Malloc fails for dw[]");
/* Increment one to get 1-based indexing. */
for (i = 0; i <= n; ++i) ++colptr[i];
for (i = 0; i < nnz; ++i) ++adjncy[i];
#if ( DEBUGlevel>=2 )
printf("LDPERM(): n %d, nnz %d\n", n, nnz);
PrintInt10("colptr", n+1, colptr);
PrintInt10("adjncy", nnz, adjncy);
#endif
/*
* NOTE:
* =====
*
* MC64AD assumes that column permutation vector is defined as:
* perm(i) = j means column i of permuted A is in column j of original A.
*
* Since a symmetric permutation preserves the diagonal entries. Then
* by the following relation:
* P'(A*P')P = P'A
* we can apply inverse(perm) to rows of A to get large diagonal entries.
* But, since 'perm' defined in MC64AD happens to be the reverse of
* SuperLU's definition of permutation vector, therefore, it is already
* an inverse for our purpose. We will thus use it directly.
*
*/
mc64id_dist(icntl);
/* Suppress error and warning messages. */
icntl[0] = -1;
icntl[1] = -1;
mc64ad_dist(&job, &n, &nnz, colptr, adjncy, nzval, &num, perm,
&liw, iw, &ldw, dw, icntl, info);
#if ( DEBUGlevel>=2 )
PrintInt10("perm", n, perm);
printf(".. After MC64AD info %d\tsize of matching %d\n", info[0], num);
#endif
if ( info[0] == 1 ) { /* Structurally singular */
printf(".. The last " IFMT " permutations:\n", n-num);
PrintInt10("perm", n-num, &perm[num]);
}
/* Restore to 0-based indexing. */
for (i = 0; i <= n; ++i) --colptr[i];
for (i = 0; i < nnz; ++i) --adjncy[i];
for (i = 0; i < n; ++i) --perm[i];
if ( job == 5 )
for (i = 0; i < n; ++i) {
u[i] = dw[i];
v[i] = dw[n+i];
}
SUPERLU_FREE(iw);
SUPERLU_FREE(dw);
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(0, "Exit dldperm_dist()");
#endif
return (info[0]);
}
