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