Actual source code: rcm.c
1: /* rcm.f -- translated by f2c (version 19931217).*/
3: #include petsc.h
5: /*****************************************************************/
6: /********* RCM ..... REVERSE CUTHILL-MCKEE ORDERING *******/
7: /*****************************************************************/
8: /* PURPOSE - RCM NUMBERS A CONNECTED COMPONENT SPECIFIED BY */
9: /* MASK AND ../../.., USING THE RCM ALGORITHM. */
10: /* THE NUMBERING IS TO BE STARTED AT THE NODE ../../... */
11: /* */
12: /* INPUT PARAMETERS - */
13: /* ../../.. - IS THE NODE THAT DEFINES THE CONNECTED */
14: /* COMPONENT AND IT IS USED AS THE STARTING */
15: /* NODE FOR THE RCM ORDERING. */
16: /* (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR FOR */
17: /* THE GRAPH. */
18: /* */
19: /* UPDATED PARAMETERS - */
20: /* MASK - ONLY THOSE NODES WITH NONZERO INPUT MASK */
21: /* VALUES ARE CONSIDERED BY THE ROUTINE. THE */
22: /* NODES NUMBERED BY RCM WILL HAVE THEIR */
23: /* MASK VALUES SET TO ZERO. */
24: /* */
25: /* OUTPUT PARAMETERS - */
26: /* PERM - WILL CONTAIN THE RCM ORDERING. */
27: /* CCSIZE - IS THE SIZE OF THE CONNECTED COMPONENT */
28: /* THAT HAS BEEN NUMBERED BY RCM. */
29: /* */
30: /* WORKING PARAMETER - */
31: /* DEG - IS A TEMPORARY VECTOR USED TO HOLD THE DEGREE */
32: /* OF THE NODES IN THE SECTION GRAPH SPECIFIED */
33: /* BY MASK AND ../../... */
34: /* */
35: /* PROGRAM SUBROUTINES - */
36: /* DEGREE. */
37: /* */
38: /****************************************************************/
41: PetscErrorCode SPARSEPACKrcm(PetscInt *root, PetscInt *xadj, PetscInt *adjncy,
42: PetscInt *mask, PetscInt *perm, PetscInt *ccsize, PetscInt *deg)
43: {
44: /* System generated locals */
45: PetscInt i__1, i__2;
47: /* Local variables */
48: PetscInt node, fnbr, lnbr, i, j, k, l, lperm, jstop, jstrt;
49: EXTERN PetscErrorCode SPARSEPACKdegree(PetscInt*, PetscInt *, PetscInt *,
50: PetscInt *, PetscInt *, PetscInt *, PetscInt *);
51: PetscInt lbegin, lvlend, nbr;
53: /* FIND THE DEGREES OF THE NODES IN THE */
54: /* COMPONENT SPECIFIED BY MASK AND ../../... */
55: /* ------------------------------------- */
59: /* Parameter adjustments */
60: --deg;
61: --perm;
62: --mask;
63: --adjncy;
64: --xadj;
67: SPARSEPACKdegree(root, &xadj[1], &adjncy[1], &mask[1], °[1], ccsize, &perm[1]);
68: mask[*root] = 0;
69: if (*ccsize <= 1) {
70: return(0);
71: }
72: lvlend = 0;
73: lnbr = 1;
74: /* LBEGIN AND LVLEND POINT TO THE BEGINNING AND */
75: /* THE END OF THE CURRENT LEVEL RESPECTIVELY. */
76: L100:
77: lbegin = lvlend + 1;
78: lvlend = lnbr;
79: i__1 = lvlend;
80: for (i = lbegin; i <= i__1; ++i) {
81: /* FOR EACH NODE IN CURRENT LEVEL ... */
82: node = perm[i];
83: jstrt = xadj[node];
84: jstop = xadj[node + 1] - 1;
86: /* FIND THE UNNUMBERED NEIGHBORS OF NODE. */
87: /* FNBR AND LNBR POINT TO THE FIRST AND LAST */
88: /* UNNUMBERED NEIGHBORS RESPECTIVELY OF THE CURRENT */
89: /* NODE IN PERM. */
90: fnbr = lnbr + 1;
91: i__2 = jstop;
92: for (j = jstrt; j <= i__2; ++j) {
93: nbr = adjncy[j];
94: if (!mask[nbr]) {
95: goto L200;
96: }
97: ++lnbr;
98: mask[nbr] = 0;
99: perm[lnbr] = nbr;
100: L200:
101: ;
102: }
103: if (fnbr >= lnbr) {
104: goto L600;
105: }
106: /* SORT THE NEIGHBORS OF NODE IN INCREASING */
107: /* ORDER BY DEGREE. LINEAR INSERTION IS USED.*/
108: k = fnbr;
109: L300:
110: l = k;
111: ++k;
112: nbr = perm[k];
113: L400:
114: if (l < fnbr) {
115: goto L500;
116: }
117: lperm = perm[l];
118: if (deg[lperm] <= deg[nbr]) {
119: goto L500;
120: }
121: perm[l + 1] = lperm;
122: --l;
123: goto L400;
124: L500:
125: perm[l + 1] = nbr;
126: if (k < lnbr) {
127: goto L300;
128: }
129: L600:
130: ;
131: }
132: if (lnbr > lvlend) {
133: goto L100;
134: }
135: /* WE NOW HAVE THE CUTHILL MCKEE ORDERING.*/
136: /* REVERSE IT BELOW ...*/
137: k = *ccsize / 2;
138: l = *ccsize;
139: i__1 = k;
140: for (i = 1; i <= i__1; ++i) {
141: lperm = perm[l];
142: perm[l] = perm[i];
143: perm[i] = lperm;
144: --l;
145: }
146: return(0);
147: }