Actual source code: qmdrch.c
1: /*$Id: qmdrch.c,v 1.15 2001/03/23 23:22:51 balay Exp $*/
2: /* qmdrch.f -- translated by f2c (version 19931217).*/
4: #include petsc.h
6: /*****************************************************************/
7: /********** QMDRCH ..... QUOT MIN DEG REACH SET ***********/
8: /*****************************************************************/
10: /* PURPOSE - THIS SUBROUTINE DETERMINES THE REACHABLE SET OF*/
11: /* A NODE THROUGH A GIVEN SUBSET. THE ADJACENCY STRUCTURE*/
12: /* IS ASSUMED TO BE STORED IN A QUOTIENT GRAPH FORMAT.*/
14: /* INPUT PARAMETERS -*/
15: /* ../../.. - THE GIVEN NODE NOT IN THE SUBSET.*/
16: /* (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE PAIR.*/
17: /* DEG - THE DEGREE VECTOR. DEG(I) LT 0 MEANS THE NODE*/
18: /* BELONGS TO THE GIVEN SUBSET.*/
20: /* OUTPUT PARAMETERS -*/
21: /* (RCHSZE, RCHSET) - THE REACHABLE SET.*/
22: /* (NHDSZE, NBRHD) - THE NEIGHBORHOOD SET.*/
24: /* UPDATED PARAMETERS -*/
25: /* MARKER - THE MARKER VECTOR FOR REACH AND NBRHD SETS.*/
26: /* GT 0 MEANS THE NODE IS IN REACH SET.*/
27: /* LT 0 MEANS THE NODE HAS BEEN MERGED WITH*/
28: /* OTHERS IN THE QUOTIENT OR IT IS IN NBRHD SET.*/
29: /*****************************************************************/
30: int SPARSEPACKqmdrch(int *root, int *xadj, int *adjncy,
31: int *deg, int *marker, int *rchsze, int *rchset,
32: int *nhdsze, int *nbrhd)
33: {
34: /* System generated locals */
35: int i__1, i__2;
37: /* Local variables */
38: int node, i, j, nabor, istop, jstop, istrt, jstrt;
40: /* LOOP THROUGH THE NEIGHBORS OF ../../.. IN THE*/
41: /* QUOTIENT GRAPH.*/
45: /* Parameter adjustments */
46: --nbrhd;
47: --rchset;
48: --marker;
49: --deg;
50: --adjncy;
51: --xadj;
53: *nhdsze = 0;
54: *rchsze = 0;
55: istrt = xadj[*root];
56: istop = xadj[*root + 1] - 1;
57: if (istop < istrt) {
58: return(0);
59: }
60: i__1 = istop;
61: for (i = istrt; i <= i__1; ++i) {
62: nabor = adjncy[i];
63: if (nabor == 0) {
64: return(0);
65: }
66: if (marker[nabor] != 0) {
67: goto L600;
68: }
69: if (deg[nabor] < 0) {
70: goto L200;
71: }
72: /* INCLUDE NABOR INTO THE REACHABLE SET.*/
73: ++(*rchsze);
74: rchset[*rchsze] = nabor;
75: marker[nabor] = 1;
76: goto L600;
77: /* NABOR HAS BEEN ELIMINATED. FIND NODES*/
78: /* REACHABLE FROM IT.*/
79: L200:
80: marker[nabor] = -1;
81: ++(*nhdsze);
82: nbrhd[*nhdsze] = nabor;
83: L300:
84: jstrt = xadj[nabor];
85: jstop = xadj[nabor + 1] - 1;
86: i__2 = jstop;
87: for (j = jstrt; j <= i__2; ++j) {
88: node = adjncy[j];
89: nabor = -node;
90: if (node < 0) {
91: goto L300;
92: } else if (node == 0) {
93: goto L600;
94: } else {
95: goto L400;
96: }
97: L400:
98: if (marker[node] != 0) {
99: goto L500;
100: }
101: ++(*rchsze);
102: rchset[*rchsze] = node;
103: marker[node] = 1;
104: L500:
105: ;
106: }
107: L600:
108: ;
109: }
110: return(0);
111: }