Date: 2022-03-31T04:47:24+00:00

Actual source code: wbm.c

      1: #include <petscmat.h>
      2: #include <petsc/private/matorderimpl.h>

      4: #if defined(PETSC_HAVE_SUPERLU_DIST)

      6: /* SuperLU_DIST bundles f2ced mc64ad_() from HSL */

      8: /*
      9:    SuperLU_dist uses a common flag for both Fortran mangling and BLAS/LAPACK mangling which
     10:    corresponds to the PETSc BLAS/LAPACK mangling flag (we pass this flag to configure SuperLU_dist)
     11: */

     13: /* Why not include superlu_dist inludes? */
     14: #  if defined(PETSC_BLASLAPACK_CAPS)
     15: #    define mc64id_dist     MC64ID_DIST
     16: #    define mc64ad_dist     MC64AD_DIST

     18: #  elif !defined(PETSC_BLASLAPACK_UNDERSCORE)
     19: #    define mc64id_dist     mc64id_dist
     20: #    define mc64ad_dist     mc64ad_dist

     22: #  endif

     24: PETSC_EXTERN PetscInt mc64id_dist(PetscInt*);
     25: PETSC_EXTERN PetscInt mc64ad_dist(const PetscInt*, PetscInt*, PetscInt*, const PetscInt*, const PetscInt*n, PetscScalar*, PetscInt*,
     26:                               PetscInt*, PetscInt*, PetscInt*, PetscInt*, PetscScalar*, PetscInt*, PetscInt*);
     27: #endif

     29: /*
     30:   MatGetOrdering_WBM - Find the nonsymmetric reordering of the graph which maximizes the product of diagonal entries,
     31:     using weighted bipartite graph matching. This is MC64 in the Harwell-Boeing library.
     32: */
     33: PETSC_INTERN PetscErrorCode MatGetOrdering_WBM(Mat mat, MatOrderingType type, IS *row, IS *col)
     34: {
     35:   PetscScalar    *a, *dw;
     36:   const PetscInt *ia, *ja;
     37:   PetscInt       job = 5;
     38:   PetscInt       *perm, nrow, ncol, nnz, liw, *iw, ldw;
     39:   PetscBool      done;
     40: #if defined(PETSC_HAVE_SUPERLU_DIST)
     41:   PetscInt       num, info[10], icntl[10], i;
     42: #endif

     44:   MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);
     45:   ncol = nrow;
     46:   nnz  = ia[nrow];
     48:   MatSeqAIJGetArray(mat, &a);
     49:   switch (job) {
     50:   case 1: liw = 4*nrow +   ncol; ldw = 0;break;
     51:   case 2: liw = 2*nrow + 2*ncol; ldw = ncol;break;
     52:   case 3: liw = 8*nrow + 2*ncol + nnz; ldw = nnz;break;
     53:   case 4: liw = 3*nrow + 2*ncol; ldw = 2*ncol + nnz;break;
     54:   case 5: liw = 3*nrow + 2*ncol; ldw = nrow + 2*ncol + nnz;break;
     55:   }

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