Actual source code: gen1wd.c
petsc-3.7.7 2017-09-25
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: }