Date: 2015-10-02T22:12:40+00:00

Actual source code: gen1wd.c
petsc-3.6.2 2015-10-02
Report Typos and Errors

      2: /* gen1wd.f -- translated by f2c (version 19931217).*/

      4: #include <petscsys.h>
      5: #include <petsc/private/matorderimpl.h>

      7: /*****************************************************************/
      8: /***********     GEN1WD ..... GENERAL ONE-WAY DISSECTION  ********/
      9: /*****************************************************************/

     11: /*    PURPOSE - GEN1WD FINDS A ONE-WAY DISSECTION PARTITIONING*/
     12: /*       FOR A GENERAL GRAPH.  FN1WD IS USED FOR EACH CONNECTED*/
     13: /*       COMPONENT.*/

     15: /*    INPUT PARAMETERS -*/
     16: /*       NEQNS - NUMBER OF EQUATIONS.*/
     17: /*       (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE PAIR.*/

     19: /*    OUTPUT PARAMETERS -*/
     20: /*       (NBLKS, XBLK) - THE PARTITIONING FOUND.*/
     21: /*       PERM - THE ONE-WAY DISSECTION ORDERING.*/

     23: /*    WORKING VECTORS -*/
     24: /*       MASK - IS USED TO MARK VARIABLES THAT HAVE*/
     25: /*              BEEN NUMBERED DURING THE ORDERING PROCESS.*/
     26: /*       (XLS, LS) - LEVEL STRUCTURE USED BY ../../..LS.*/

     28: /*    PROGRAM SUBROUTINES -*/
     29: /*       FN1WD, REVRSE, ../../..LS.*/
     30: /****************************************************************/
     33: PetscErrorCode SPARSEPACKgen1wd(const PetscInt *neqns,const PetscInt *xadj,const PetscInt *adjncy,PetscInt *mask, PetscInt *nblks, PetscInt *xblk, PetscInt *perm, PetscInt *xls, PetscInt *ls)
     34: {
     35:   /* System generated locals */
     36:   PetscInt i__1, i__2, i__3;

     38:   /* Local variables */
     39:   PetscInt node, nsep, lnum, nlvl, root;
     40:   PetscInt i, j, k, ccsize;
     41:   PetscInt num;

     44:   /* Parameter adjustments */
     45:   --ls;
     46:   --xls;
     47:   --perm;
     48:   --xblk;
     49:   --mask;
     50:   --xadj;
     51:   --adjncy;

     53:   i__1 = *neqns;
     54:   for (i = 1; i <= i__1; ++i) mask[i] = 1;
     55:   *nblks = 0;
     56:   num    = 0;
     57:   i__1   = *neqns;
     58:   for (i = 1; i <= i__1; ++i) {
     59:     if (!mask[i]) goto L400;
     60: /*             FIND A ONE-WAY DISSECTOR FOR EACH COMPONENT.*/
     61:     root = i;
     62:     SPARSEPACKfn1wd(&root, &xadj[1], &adjncy[1], &mask[1], &nsep, &perm[num + 1], &nlvl, &xls[1], &ls[1]);
     63:     num += nsep;
     64:     ++(*nblks);
     65:     xblk[*nblks] = *neqns - num + 1;
     66:     ccsize       = xls[nlvl + 1] - 1;
     67: /*             NUMBER THE REMAINING NODES IN THE COMPONENT.*/
     68: /*             EACH COMPONENT IN THE REMAINING SUBGRAPH FORMS*/
     69: /*             A NEW BLOCK IN THE PARTITIONING.*/
     70:     i__2 = ccsize;
     71:     for (j = 1; j <= i__2; ++j) {
     72:       node = ls[j];
     73:       if (!mask[node]) goto L300;
     74:       SPARSEPACKrootls(&node, &xadj[1], &adjncy[1], &mask[1], &nlvl, &xls[1], &perm[num + 1]);
     75:       lnum = num + 1;
     76:       num  = num + xls[nlvl + 1] - 1;
     77:       ++(*nblks);
     78:       xblk[*nblks] = *neqns - num + 1;
     79:       i__3         = num;
     80:       for (k = lnum; k <= i__3; ++k) {
     81:         node       = perm[k];
     82:         mask[node] = 0;
     83:       }
     84:       if (num > *neqns) goto L500;
     85: L300:
     86:       ;
     87:     }
     88: L400:
     89:     ;
     90:   }
     91: /*       SINCE DISSECTORS FOUND FIRST SHOULD BE ORDERED LAST,*/
     92: /*       ROUTINE REVRSE IS CALLED TO ADJUST THE ORDERING*/
     93: /*       VECTOR, AND THE BLOCK INDEX VECTOR.*/
     94: L500:
     95:   SPARSEPACKrevrse(neqns, &perm[1]);
     96:   SPARSEPACKrevrse(nblks, &xblk[1]);
     97:   xblk[*nblks + 1] = *neqns + 1;
     98:   return(0);
     99: }