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