Actual source code: wbm.c

petsc-dev 2014-02-02
Report Typos and Errors
  1: #include <petscmat.h>
  2: #include <petsc-private/matorderimpl.h>

  4: #if defined(PETSC_HAVE_SUPERLU_DIST)

  6: #  if defined(PETSC_HAVE_FORTRAN_CAPS)
  7: #    define mc64id_    MC64ID
  8: #    define mc64ad_    MC64AD
  9: #  elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 10: #    define mc64id_    mc64id
 11: #    define mc64ad_    mc64ad
 12: #  endif

 14: /* SuperLU_DIST bundles f2ced mc64ad_() from HSL */
 15: PETSC_EXTERN PetscInt mc64id_(PetscInt *icntl);
 16: PETSC_EXTERN PetscInt mc64ad_(const PetscInt *job, PetscInt *n, PetscInt *ne, const PetscInt *ip, const PetscInt *irn, PetscScalar *a, PetscInt *num,
 17:                               PetscInt *perm, PetscInt *liw, PetscInt *iw, PetscInt *ldw, PetscScalar *dw, PetscInt *icntl, PetscInt *info);
 18: #endif

 20: /*
 21:   MatGetOrdering_WBM - Find the nonsymmetric reordering of the graph which maximizes the product of diagonal entries,
 22:     using weighted bipartite graph matching. This is MC64 in the Harwell-Boeing library.
 23: */
 26: PETSC_EXTERN PetscErrorCode MatGetOrdering_WBM(Mat mat, MatOrderingType type, IS *row, IS *col)
 27: {
 28:   PetscScalar    *a, *dw;
 29:   const PetscInt *ia, *ja;
 30:   const PetscInt  job = 5;
 31:   PetscInt       *perm, nrow, ncol, nnz, liw, *iw, ldw, i;
 32:   PetscBool       done;
 33:   PetscErrorCode  ierr;

 36:   MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);
 37:   ncol = nrow;
 38:   nnz  = ia[nrow];
 39:   if (!done) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot get rows for matrix");
 40:   MatSeqAIJGetArray(mat, &a);
 41:   switch (job) {
 42:   case 1: liw = 4*nrow +   ncol; ldw = 0;break;
 43:   case 2: liw = 2*nrow + 2*ncol; ldw = ncol;break;
 44:   case 3: liw = 8*nrow + 2*ncol + nnz; ldw = nnz;break;
 45:   case 4: liw = 3*nrow + 2*ncol; ldw = 2*ncol + nnz;break;
 46:   case 5: liw = 3*nrow + 2*ncol; ldw = nrow + 2*ncol + nnz;break;
 47:   }

 49:   PetscMalloc3(liw,&iw,ldw,&dw,nrow,&perm);
 50: #if defined(PETSC_HAVE_SUPERLU_DIST)
 51:   {
 52:     PetscInt        num, info[10], icntl[10];

 54:     mc64id_(icntl);
 55:     if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"HSL mc64id_ returned %d\n",ierr);
 56:     icntl[0] = 0;              /* allow printing error messages (f2c'd code uses if non-negative, ignores value otherwise) */
 57:     icntl[1] = -1;             /* suppress warnings */
 58:     icntl[2] = -1;             /* ignore diagnostic output [default] */
 59:     icntl[3] = 0;              /* perform consistency checks [default] */
 60:     mc64ad_(&job, &nrow, &nnz, ia, ja, a, &num, perm, &liw, iw, &ldw, dw, icntl, info);
 61:     if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"HSL mc64ad_ returned %d\n",ierr);
 62:   }
 63: #else
 64:   SETERRQ(PetscObjectComm((PetscObject) mat), PETSC_ERR_SUP, "WBM using MC64 does not support complex numbers");
 65: #endif
 66:   MatRestoreRowIJ(mat, 1, PETSC_TRUE, PETSC_TRUE, NULL, &ia, &ja, &done);
 67:   for (i = 0; i < nrow; ++i) perm[i]--;
 68:   /* If job == 5, dw[0..ncols] contains the column scaling and dw[ncols..ncols+nrows] contains the row scaling */
 69:   ISCreateStride(PETSC_COMM_SELF, nrow, 0, 1, row);
 70:   ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,col);
 71:   PetscFree3(iw,dw,perm);
 72:   return(0);
 73: }