1 /* gen1wd.f -- translated by f2c (version 19931217).*/
2
3 #include <petscsys.h>
4 #include <petsc/private/matorderimpl.h>
5
6 /*****************************************************************/
7 /*********** GEN1WD ..... GENERAL ONE-WAY DISSECTION ********/
8 /*****************************************************************/
9
10 /* PURPOSE - GEN1WD FINDS A ONE-WAY DISSECTION PARTITIONING*/
11 /* FOR A GENERAL GRAPH. FN1WD IS USED FOR EACH CONNECTED*/
12 /* COMPONENT.*/
13
14 /* INPUT PARAMETERS -*/
15 /* NEQNS - NUMBER OF EQUATIONS.*/
16 /* (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE PAIR.*/
17
18 /* OUTPUT PARAMETERS -*/
19 /* (NBLKS, XBLK) - THE PARTITIONING FOUND.*/
20 /* PERM - THE ONE-WAY DISSECTION ORDERING.*/
21
22 /* WORKING VECTORS -*/
23 /* MASK - IS USED TO MARK VARIABLES THAT HAVE*/
24 /* BEEN NUMBERED DURING THE ORDERING PROCESS.*/
25 /* (XLS, LS) - LEVEL STRUCTURE USED BY ROOTLS.*/
26
27 /* PROGRAM SUBROUTINES -*/
28 /* FN1WD, REVRSE, ROOTLS.*/
29 /****************************************************************/
SPARSEPACKgen1wd(const PetscInt * neqns,const PetscInt * xadj,const PetscInt * adjncy,PetscInt * mask,PetscInt * nblks,PetscInt * xblk,PetscInt * perm,PetscInt * xls,PetscInt * ls)30 PetscErrorCode SPARSEPACKgen1wd(const PetscInt *neqns, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *mask, PetscInt *nblks, PetscInt *xblk, PetscInt *perm, PetscInt *xls, PetscInt *ls)
31 {
32 /* System generated locals */
33 PetscInt i__1, i__2, i__3;
34
35 /* Local variables */
36 PetscInt node, nsep, lnum, nlvl, root;
37 PetscInt i, j, k, ccsize;
38 PetscInt num;
39
40 PetscFunctionBegin;
41 /* Parameter adjustments */
42 --ls;
43 --xls;
44 --perm;
45 --xblk;
46 --mask;
47 --xadj;
48 --adjncy;
49
50 i__1 = *neqns;
51 for (i = 1; i <= i__1; ++i) mask[i] = 1;
52 *nblks = 0;
53 num = 0;
54 i__1 = *neqns;
55 for (i = 1; i <= i__1; ++i) {
56 if (!mask[i]) goto L400;
57 /* FIND A ONE-WAY DISSECTOR FOR EACH COMPONENT.*/
58 root = i;
59 PetscCall(SPARSEPACKfn1wd(&root, &xadj[1], &adjncy[1], &mask[1], &nsep, &perm[num + 1], &nlvl, &xls[1], &ls[1]));
60 num += nsep;
61 ++(*nblks);
62 xblk[*nblks] = *neqns - num + 1;
63 ccsize = xls[nlvl + 1] - 1;
64 /* NUMBER THE REMAINING NODES IN THE COMPONENT.*/
65 /* EACH COMPONENT IN THE REMAINING SUBGRAPH FORMS*/
66 /* A NEW BLOCK IN THE PARTITIONING.*/
67 i__2 = ccsize;
68 for (j = 1; j <= i__2; ++j) {
69 node = ls[j];
70 if (!mask[node]) goto L300;
71 PetscCall(SPARSEPACKrootls(&node, &xadj[1], &adjncy[1], &mask[1], &nlvl, &xls[1], &perm[num + 1]));
72 lnum = num + 1;
73 num = num + xls[nlvl + 1] - 1;
74 ++(*nblks);
75 xblk[*nblks] = *neqns - num + 1;
76 i__3 = num;
77 for (k = lnum; k <= i__3; ++k) {
78 node = perm[k];
79 mask[node] = 0;
80 }
81 if (num > *neqns) goto L500;
82 L300:;
83 }
84 L400:;
85 }
86 /* SINCE DISSECTORS FOUND FIRST SHOULD BE ORDERED LAST,*/
87 /* ROUTINE REVRSE IS CALLED TO ADJUST THE ORDERING*/
88 /* VECTOR, AND THE BLOCK INDEX VECTOR.*/
89 L500:
90 PetscCall(SPARSEPACKrevrse(neqns, &perm[1]));
91 PetscCall(SPARSEPACKrevrse(nblks, &xblk[1]));
92 xblk[*nblks + 1] = *neqns + 1;
93 PetscFunctionReturn(PETSC_SUCCESS);
94 }
95