1 /* qmdrch.f -- translated by f2c (version 19931217).*/
2
3 #include <petscsys.h>
4 #include <petsc/private/matorderimpl.h>
5
6 /*****************************************************************/
7 /********** QMDRCH ..... QUOT MIN DEG REACH SET ***********/
8 /*****************************************************************/
9
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.*/
13
14 /* INPUT PARAMETERS -*/
15 /* ROOT - 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.*/
19
20 /* OUTPUT PARAMETERS -*/
21 /* (RCHSZE, RCHSET) - THE REACHABLE SET.*/
22 /* (NHDSZE, NBRHD) - THE NEIGHBORHOOD SET.*/
23
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 /*****************************************************************/
SPARSEPACKqmdrch(const PetscInt * root,const PetscInt * xadj,const PetscInt * adjncy,PetscInt * deg,PetscInt * marker,PetscInt * rchsze,PetscInt * rchset,PetscInt * nhdsze,PetscInt * nbrhd)30 PetscErrorCode SPARSEPACKqmdrch(const PetscInt *root, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *deg, PetscInt *marker, PetscInt *rchsze, PetscInt *rchset, PetscInt *nhdsze, PetscInt *nbrhd)
31 {
32 /* System generated locals */
33 PetscInt i__1, i__2;
34
35 /* Local variables */
36 PetscInt node, i, j, nabor, istop, jstop, istrt, jstrt;
37
38 /* LOOP THROUGH THE NEIGHBORS OF ROOT IN THE*/
39 /* QUOTIENT GRAPH.*/
40
41 PetscFunctionBegin;
42 /* Parameter adjustments */
43 --nbrhd;
44 --rchset;
45 --marker;
46 --deg;
47 --adjncy;
48 --xadj;
49
50 *nhdsze = 0;
51 *rchsze = 0;
52 istrt = xadj[*root];
53 istop = xadj[*root + 1] - 1;
54 if (istop < istrt) PetscFunctionReturn(PETSC_SUCCESS);
55 i__1 = istop;
56 for (i = istrt; i <= i__1; ++i) {
57 nabor = adjncy[i];
58 if (!nabor) PetscFunctionReturn(PETSC_SUCCESS);
59 if (marker[nabor] != 0) goto L600;
60 if (deg[nabor] < 0) goto L200;
61
62 /* INCLUDE NABOR INTO THE REACHABLE SET.*/
63 ++(*rchsze);
64 rchset[*rchsze] = nabor;
65 marker[nabor] = 1;
66 goto L600;
67 /* NABOR HAS BEEN ELIMINATED. FIND NODES*/
68 /* REACHABLE FROM IT.*/
69 L200:
70 marker[nabor] = -1;
71 ++(*nhdsze);
72 nbrhd[*nhdsze] = nabor;
73 L300:
74 jstrt = xadj[nabor];
75 jstop = xadj[nabor + 1] - 1;
76 i__2 = jstop;
77 for (j = jstrt; j <= i__2; ++j) {
78 node = adjncy[j];
79 nabor = -node;
80 if (node < 0) goto L300;
81 else if (!node) goto L600;
82 else goto L400;
83 L400:
84 if (marker[node] != 0) goto L500;
85 ++(*rchsze);
86 rchset[*rchsze] = node;
87 marker[node] = 1;
88 L500:;
89 }
90 L600:;
91 }
92 PetscFunctionReturn(PETSC_SUCCESS);
93 }
94