Actual source code: wbm.c
petsc-dev 2014-02-02
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: }