Actual source code: qmdmrg.c
1: /*$Id: qmdmrg.c,v 1.15 2001/03/23 23:22:51 balay Exp $*/
2: /* qmdmrg.f -- translated by f2c (version 19931217).*/
4: #include petsc.h
6: /******************************************************************/
7: /*********** QMDMRG ..... QUOT MIN DEG MERGE ************/
8: /******************************************************************/
9: /* PURPOSE - THIS ROUTINE MERGES INDISTINGUISHABLE NODES IN */
10: /* THE MINIMUM DEGREE ORDERING ALGORITHM. */
11: /* IT ALSO COMPUTES THE NEW DEGREES OF THESE */
12: /* NEW SUPERNODES. */
13: /* */
14: /* INPUT PARAMETERS - */
15: /* (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE. */
16: /* DEG0 - THE NUMBER OF NODES IN THE GIVEN SET. */
17: /* (NHDSZE, NBRHD) - THE SET OF ELIMINATED SUPERNODES */
18: /* ADJACENT TO SOME NODES IN THE SET. */
19: /* */
20: /* UPDATED PARAMETERS - */
21: /* DEG - THE DEGREE VECTOR. */
22: /* QSIZE - SIZE OF INDISTINGUISHABLE NODES. */
23: /* QLINK - LINKED LIST FOR INDISTINGUISHABLE NODES. */
24: /* MARKER - THE GIVEN SET IS GIVEN BY THOSE NODES WITH */
25: /* MARKER VALUE SET TO 1. THOSE NODES WITH DEGREE */
26: /* UPDATED WILL HAVE MARKER VALUE SET TO 2. */
27: /* */
28: /* WORKING PARAMETERS - */
29: /* RCHSET - THE REACHABLE SET. */
30: /* OVRLP - TEMP VECTOR TO STORE THE INTERSECTION OF TWO */
31: /* REACHABLE SETS. */
32: /* */
33: /*****************************************************************/
34: int SPARSEPACKqmdmrg(int *xadj, int *adjncy, int *deg,
35: int *qsize, int *qlink, int *marker, int *deg0,
36: int *nhdsze, int *nbrhd, int *rchset, int *ovrlp)
37: {
38: /* System generated locals */
39: int i__1, i__2, i__3;
41: /* Local variables */
42: int head, inhd, irch, node, mark, link, root, j, lnode, nabor,
43: jstop, jstrt, rchsze, mrgsze, novrlp, iov, deg1;
46: /* Parameter adjustments */
47: --ovrlp;
48: --rchset;
49: --nbrhd;
50: --marker;
51: --qlink;
52: --qsize;
53: --deg;
54: --adjncy;
55: --xadj;
57: if (*nhdsze <= 0) {
58: return(0);
59: }
60: i__1 = *nhdsze;
61: for (inhd = 1; inhd <= i__1; ++inhd) {
62: root = nbrhd[inhd];
63: marker[root] = 0;
64: }
65: /* LOOP THROUGH EACH ELIMINATED SUPERNODE IN THE SET */
66: /* (NHDSZE, NBRHD). */
67: i__1 = *nhdsze;
68: for (inhd = 1; inhd <= i__1; ++inhd) {
69: root = nbrhd[inhd];
70: marker[root] = -1;
71: rchsze = 0;
72: novrlp = 0;
73: deg1 = 0;
74: L200:
75: jstrt = xadj[root];
76: jstop = xadj[root + 1] - 1;
77: /* DETERMINE THE REACHABLE SET AND ITS INTERSECT- */
78: /* ION WITH THE INPUT REACHABLE SET. */
79: i__2 = jstop;
80: for (j = jstrt; j <= i__2; ++j) {
81: nabor = adjncy[j];
82: root = -nabor;
83: if (nabor < 0) {
84: goto L200;
85: } else if (nabor == 0) {
86: goto L700;
87: } else {
88: goto L300;
89: }
90: L300:
91: mark = marker[nabor];
92: if (mark < 0) {
93: goto L600;
94: } else if (mark == 0) {
95: goto L400;
96: } else {
97: goto L500;
98: }
99: L400:
100: ++rchsze;
101: rchset[rchsze] = nabor;
102: deg1 += qsize[nabor];
103: marker[nabor] = 1;
104: goto L600;
105: L500:
106: if (mark > 1) {
107: goto L600;
108: }
109: ++novrlp;
110: ovrlp[novrlp] = nabor;
111: marker[nabor] = 2;
112: L600:
113: ;
114: }
115: /* FROM THE OVERLAPPED SET, DETERMINE THE NODES */
116: /* THAT CAN BE MERGED TOGETHER. */
117: L700:
118: head = 0;
119: mrgsze = 0;
120: i__2 = novrlp;
121: for (iov = 1; iov <= i__2; ++iov) {
122: node = ovrlp[iov];
123: jstrt = xadj[node];
124: jstop = xadj[node + 1] - 1;
125: i__3 = jstop;
126: for (j = jstrt; j <= i__3; ++j) {
127: nabor = adjncy[j];
128: if (marker[nabor] != 0) {
129: goto L800;
130: }
131: marker[node] = 1;
132: goto L1100;
133: L800:
134: ;
135: }
136: /* NODE BELONGS TO THE NEW MERGED SUPERNODE. */
137: /* UPDATE THE VECTORS QLINK AND QSIZE. */
138: mrgsze += qsize[node];
139: marker[node] = -1;
140: lnode = node;
141: L900:
142: link = qlink[lnode];
143: if (link <= 0) {
144: goto L1000;
145: }
146: lnode = link;
147: goto L900;
148: L1000:
149: qlink[lnode] = head;
150: head = node;
151: L1100:
152: ;
153: }
154: if (head <= 0) {
155: goto L1200;
156: }
157: qsize[head] = mrgsze;
158: deg[head] = *deg0 + deg1 - 1;
159: marker[head] = 2;
160: /* RESET MARKER VALUES. */
161: L1200:
162: root = nbrhd[inhd];
163: marker[root] = 0;
164: if (rchsze <= 0) {
165: goto L1400;
166: }
167: i__2 = rchsze;
168: for (irch = 1; irch <= i__2; ++irch) {
169: node = rchset[irch];
170: marker[node] = 0;
171: }
172: L1400:
173: ;
174: }
175: return(0);
176: }