Actual source code: genqmd.c
1: /*$Id: genqmd.c,v 1.17 2001/03/23 23:22:51 balay Exp $*/
2: /* genqmd.f -- translated by f2c (version 19931217).*/
4: #include petsc.h
6: /******************************************************************/
7: /*********** GENQMD ..... QUOT MIN DEGREE ORDERING **********/
8: /******************************************************************/
9: /* PURPOSE - THIS ROUTINE IMPLEMENTS THE MINIMUM DEGREE */
10: /* ALGORITHM. IT MAKES USE OF THE IMPLICIT REPRESENT- */
11: /* ATION OF THE ELIMINATION GRAPHS BY QUOTIENT GRAPHS, */
12: /* AND THE NOTION OF INDISTINGUISHABLE NODES. */
13: /* CAUTION - THE ADJACENCY VECTOR ADJNCY WILL BE */
14: /* DESTROYED. */
15: /* */
16: /* INPUT PARAMETERS - */
17: /* NEQNS - NUMBER OF EQUATIONS. */
18: /* (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE. */
19: /* */
20: /* OUTPUT PARAMETERS - */
21: /* PERM - THE MINIMUM DEGREE ORDERING. */
22: /* INVP - THE INVERSE OF PERM. */
23: /* */
24: /* WORKING PARAMETERS - */
25: /* DEG - THE DEGREE VECTOR. DEG(I) IS NEGATIVE MEANS */
26: /* NODE I HAS BEEN NUMBERED. */
27: /* MARKER - A MARKER VECTOR, WHERE MARKER(I) IS */
28: /* NEGATIVE MEANS NODE I HAS BEEN MERGED WITH */
29: /* ANOTHER NODE AND THUS CAN BE IGNORED. */
30: /* RCHSET - VECTOR USED FOR THE REACHABLE SET. */
31: /* NBRHD - VECTOR USED FOR THE NEIGHBORHOOD SET. */
32: /* QSIZE - VECTOR USED TO STORE THE SIZE OF */
33: /* INDISTINGUISHABLE SUPERNODES. */
34: /* QLINK - VECTOR TO STORE INDISTINGUISHABLE NODES, */
35: /* I, QLINK(I), QLINK(QLINK(I)) ... ARE THE */
36: /* MEMBERS OF THE SUPERNODE REPRESENTED BY I. */
37: /* */
38: /* PROGRAM SUBROUTINES - */
39: /* QMDRCH, QMDQT, QMDUPD. */
40: /* */
41: /******************************************************************/
42: /* */
43: /* */
44: int SPARSEPACKgenqmd(int *neqns, int *xadj, int *adjncy,
45: int *perm, int *invp, int *deg, int *marker, int *
46: rchset, int *nbrhd, int *qsize, int *qlink, int *nofsub)
47: {
48: /* System generated locals */
49: int i__1;
51: /* Local variables */
52: int ndeg, irch, node, nump1, j, inode;
53: EXTERN int SPARSEPACKqmdqt(int *, int *, int *, int *, int *, int *, int *);
54: int ip, np, mindeg, search;
55: EXTERN int SPARSEPACKqmdrch(int *, int *, int *,
56: int *, int *, int *, int *, int *, int *),
57: SPARSEPACKqmdupd(int *, int *, int *, int *, int *,
58: int *, int *, int *, int *, int *);
59: int nhdsze, nxnode, rchsze, thresh, num;
61: /* INITIALIZE DEGREE VECTOR AND OTHER WORKING VARIABLES. */
64: /* Parameter adjustments */
65: --qlink;
66: --qsize;
67: --nbrhd;
68: --rchset;
69: --marker;
70: --deg;
71: --invp;
72: --perm;
73: --adjncy;
74: --xadj;
76: mindeg = *neqns;
77: *nofsub = 0;
78: i__1 = *neqns;
79: for (node = 1; node <= i__1; ++node) {
80: perm[node] = node;
81: invp[node] = node;
82: marker[node] = 0;
83: qsize[node] = 1;
84: qlink[node] = 0;
85: ndeg = xadj[node + 1] - xadj[node];
86: deg[node] = ndeg;
87: if (ndeg < mindeg) {
88: mindeg = ndeg;
89: }
90: }
91: num = 0;
92: /* PERFORM THRESHOLD SEARCH TO GET A NODE OF MIN DEGREE. */
93: /* VARIABLE SEARCH POINTS TO WHERE SEARCH SHOULD START. */
94: L200:
95: search = 1;
96: thresh = mindeg;
97: mindeg = *neqns;
98: L300:
99: nump1 = num + 1;
100: if (nump1 > search) {
101: search = nump1;
102: }
103: i__1 = *neqns;
104: for (j = search; j <= i__1; ++j) {
105: node = perm[j];
106: if (marker[node] < 0) {
107: goto L400;
108: }
109: ndeg = deg[node];
110: if (ndeg <= thresh) {
111: goto L500;
112: }
113: if (ndeg < mindeg) {
114: mindeg = ndeg;
115: }
116: L400:
117: ;
118: }
119: goto L200;
120: /* NODE HAS MINIMUM DEGREE. FIND ITS REACHABLE SETS BY */
121: /* CALLING QMDRCH. */
122: L500:
123: search = j;
124: *nofsub += deg[node];
125: marker[node] = 1;
126: SPARSEPACKqmdrch(&node, &xadj[1], &adjncy[1], °[1], &marker[1], &rchsze, &
127: rchset[1], &nhdsze, &nbrhd[1]);
128: /* ELIMINATE ALL NODES INDISTINGUISHABLE FROM NODE. */
129: /* THEY ARE GIVEN BY NODE, QLINK(NODE), .... */
130: nxnode = node;
131: L600:
132: ++num;
133: np = invp[nxnode];
134: ip = perm[num];
135: perm[np] = ip;
136: invp[ip] = np;
137: perm[num] = nxnode;
138: invp[nxnode] = num;
139: deg[nxnode] = -1;
140: nxnode = qlink[nxnode];
141: if (nxnode > 0) {
142: goto L600;
143: }
144: if (rchsze <= 0) {
145: goto L800;
146: }
147: /* UPDATE THE DEGREES OF THE NODES IN THE REACHABLE */
148: /* SET AND IDENTIFY INDISTINGUISHABLE NODES. */
149: SPARSEPACKqmdupd(&xadj[1], &adjncy[1], &rchsze, &rchset[1], °[1], &qsize[1], &
150: qlink[1], &marker[1], &rchset[rchsze + 1], &nbrhd[nhdsze + 1]);
151: /* RESET MARKER VALUE OF NODES IN REACH SET. */
152: /* UPDATE THRESHOLD VALUE FOR CYCLIC SEARCH. */
153: /* ALSO CALL QMDQT TO FORM NEW QUOTIENT GRAPH. */
154: marker[node] = 0;
155: i__1 = rchsze;
156: for (irch = 1; irch <= i__1; ++irch) {
157: inode = rchset[irch];
158: if (marker[inode] < 0) {
159: goto L700;
160: }
161: marker[inode] = 0;
162: ndeg = deg[inode];
163: if (ndeg < mindeg) {
164: mindeg = ndeg;
165: }
166: if (ndeg > thresh) {
167: goto L700;
168: }
169: mindeg = thresh;
170: thresh = ndeg;
171: search = invp[inode];
172: L700:
173: ;
174: }
175: if (nhdsze > 0) {
176: SPARSEPACKqmdqt(&node, &xadj[1], &adjncy[1], &marker[1], &rchsze, &rchset[1], &
177: nbrhd[1]);
178: }
179: L800:
180: if (num < *neqns) {
181: goto L300;
182: }
183: return(0);
184: }