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: /* */
46: int SPARSEPACKgenqmd(int *neqns, int *xadj, int *adjncy,
47: int *perm, int *invp, int *deg, int *marker, int *
48: rchset, int *nbrhd, int *qsize, int *qlink, int *nofsub)
49: {
50: /* System generated locals */
51: int i__1;
53: /* Local variables */
54: int ndeg, irch, node, nump1, j, inode;
55: EXTERN int SPARSEPACKqmdqt(int *, int *, int *, int *, int *, int *, int *);
56: int ip, np, mindeg, search;
57: EXTERN int SPARSEPACKqmdrch(int *, int *, int *,
58: int *, int *, int *, int *, int *, int *),
59: SPARSEPACKqmdupd(int *, int *, int *, int *, int *,
60: int *, int *, int *, int *, int *);
61: int nhdsze, nxnode, rchsze, thresh, num;
63: /* INITIALIZE DEGREE VECTOR AND OTHER WORKING VARIABLES. */
66: /* Parameter adjustments */
67: --qlink;
68: --qsize;
69: --nbrhd;
70: --rchset;
71: --marker;
72: --deg;
73: --invp;
74: --perm;
75: --adjncy;
76: --xadj;
78: mindeg = *neqns;
79: *nofsub = 0;
80: i__1 = *neqns;
81: for (node = 1; node <= i__1; ++node) {
82: perm[node] = node;
83: invp[node] = node;
84: marker[node] = 0;
85: qsize[node] = 1;
86: qlink[node] = 0;
87: ndeg = xadj[node + 1] - xadj[node];
88: deg[node] = ndeg;
89: if (ndeg < mindeg) {
90: mindeg = ndeg;
91: }
92: }
93: num = 0;
94: /* PERFORM THRESHOLD SEARCH TO GET A NODE OF MIN DEGREE. */
95: /* VARIABLE SEARCH POINTS TO WHERE SEARCH SHOULD START. */
96: L200:
97: search = 1;
98: thresh = mindeg;
99: mindeg = *neqns;
100: L300:
101: nump1 = num + 1;
102: if (nump1 > search) {
103: search = nump1;
104: }
105: i__1 = *neqns;
106: for (j = search; j <= i__1; ++j) {
107: node = perm[j];
108: if (marker[node] < 0) {
109: goto L400;
110: }
111: ndeg = deg[node];
112: if (ndeg <= thresh) {
113: goto L500;
114: }
115: if (ndeg < mindeg) {
116: mindeg = ndeg;
117: }
118: L400:
119: ;
120: }
121: goto L200;
122: /* NODE HAS MINIMUM DEGREE. FIND ITS REACHABLE SETS BY */
123: /* CALLING QMDRCH. */
124: L500:
125: search = j;
126: *nofsub += deg[node];
127: marker[node] = 1;
128: SPARSEPACKqmdrch(&node, &xadj[1], &adjncy[1], °[1], &marker[1], &rchsze, &
129: rchset[1], &nhdsze, &nbrhd[1]);
130: /* ELIMINATE ALL NODES INDISTINGUISHABLE FROM NODE. */
131: /* THEY ARE GIVEN BY NODE, QLINK(NODE), .... */
132: nxnode = node;
133: L600:
134: ++num;
135: np = invp[nxnode];
136: ip = perm[num];
137: perm[np] = ip;
138: invp[ip] = np;
139: perm[num] = nxnode;
140: invp[nxnode] = num;
141: deg[nxnode] = -1;
142: nxnode = qlink[nxnode];
143: if (nxnode > 0) {
144: goto L600;
145: }
146: if (rchsze <= 0) {
147: goto L800;
148: }
149: /* UPDATE THE DEGREES OF THE NODES IN THE REACHABLE */
150: /* SET AND IDENTIFY INDISTINGUISHABLE NODES. */
151: SPARSEPACKqmdupd(&xadj[1], &adjncy[1], &rchsze, &rchset[1], °[1], &qsize[1], &
152: qlink[1], &marker[1], &rchset[rchsze + 1], &nbrhd[nhdsze + 1]);
153: /* RESET MARKER VALUE OF NODES IN REACH SET. */
154: /* UPDATE THRESHOLD VALUE FOR CYCLIC SEARCH. */
155: /* ALSO CALL QMDQT TO FORM NEW QUOTIENT GRAPH. */
156: marker[node] = 0;
157: i__1 = rchsze;
158: for (irch = 1; irch <= i__1; ++irch) {
159: inode = rchset[irch];
160: if (marker[inode] < 0) {
161: goto L700;
162: }
163: marker[inode] = 0;
164: ndeg = deg[inode];
165: if (ndeg < mindeg) {
166: mindeg = ndeg;
167: }
168: if (ndeg > thresh) {
169: goto L700;
170: }
171: mindeg = thresh;
172: thresh = ndeg;
173: search = invp[inode];
174: L700:
175: ;
176: }
177: if (nhdsze > 0) {
178: SPARSEPACKqmdqt(&node, &xadj[1], &adjncy[1], &marker[1], &rchsze, &rchset[1], &
179: nbrhd[1]);
180: }
181: L800:
182: if (num < *neqns) {
183: goto L300;
184: }
185: return(0);
186: }