1 /* rootls.f -- translated by f2c (version 19931217).*/
2
3 #include <petscsys.h>
4 #include <petsc/private/matorderimpl.h>
5
6 /*****************************************************************/
7 /********* ROOTLS ..... ROOTED LEVEL STRUCTURE **********/
8 /*****************************************************************/
9 /* PURPOSE - ROOTLS GENERATES THE LEVEL STRUCTURE ROOTED */
10 /* AT THE INPUT NODE CALLED ROOT. ONLY THOSE NODES FOR*/
11 /* WHICH MASK IS NONZERO WILL BE CONSIDERED.*/
12 /* */
13 /* INPUT PARAMETERS - */
14 /* ROOT - THE NODE AT WHICH THE LEVEL STRUCTURE IS TO*/
15 /* BE ROOTED.*/
16 /* (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR FOR THE*/
17 /* GIVEN GRAPH.*/
18 /* MASK - IS USED TO SPECIFY A SECTION SUBGRAPH. NODES*/
19 /* WITH MASK(I)=0 ARE IGNORED.*/
20 /* OUTPUT PARAMETERS -*/
21 /* NLVL - IS THE NUMBER OF LEVELS IN THE LEVEL STRUCTURE.*/
22 /* (XLS, LS) - ARRAY PAIR FOR THE ROOTED LEVEL STRUCTURE.*/
23 /*****************************************************************/
SPARSEPACKrootls(const PetscInt * root,const PetscInt * xadj,const PetscInt * adjncy,PetscInt * mask,PetscInt * nlvl,PetscInt * xls,PetscInt * ls)24 PetscErrorCode SPARSEPACKrootls(const PetscInt *root, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *mask, PetscInt *nlvl, PetscInt *xls, PetscInt *ls)
25 {
26 /* System generated locals */
27 PetscInt i__1, i__2;
28
29 /* Local variables */
30 PetscInt node, i, j, jstop, jstrt, lbegin, ccsize, lvlend, lvsize, nbr;
31
32 /* INITIALIZATION ...*/
33
34 PetscFunctionBegin;
35 /* Parameter adjustments */
36 --ls;
37 --xls;
38 --mask;
39 --adjncy;
40 --xadj;
41
42 mask[*root] = 0;
43 ls[1] = *root;
44 *nlvl = 0;
45 lvlend = 0;
46 ccsize = 1;
47 /* LBEGIN IS THE POINTER TO THE BEGINNING OF THE CURRENT*/
48 /* LEVEL, AND LVLEND POINTS TO THE END OF THIS LEVEL.*/
49 L200:
50 lbegin = lvlend + 1;
51 lvlend = ccsize;
52 ++(*nlvl);
53 xls[*nlvl] = lbegin;
54 /* GENERATE THE NEXT LEVEL BY FINDING ALL THE MASKED */
55 /* NEIGHBORS OF NODES IN THE CURRENT LEVEL.*/
56 i__1 = lvlend;
57 for (i = lbegin; i <= i__1; ++i) {
58 node = ls[i];
59 jstrt = xadj[node];
60 jstop = xadj[node + 1] - 1;
61 if (jstop < jstrt) goto L400;
62 i__2 = jstop;
63 for (j = jstrt; j <= i__2; ++j) {
64 nbr = adjncy[j];
65 if (!mask[nbr]) goto L300;
66 ++ccsize;
67 ls[ccsize] = nbr;
68 mask[nbr] = 0;
69 L300:;
70 }
71 L400:;
72 }
73 /* COMPUTE THE CURRENT LEVEL WIDTH.*/
74 /* IF IT IS NONZERO, GENERATE THE NEXT LEVEL.*/
75 lvsize = ccsize - lvlend;
76 if (lvsize > 0) goto L200;
77 /* RESET MASK TO ONE FOR THE NODES IN THE LEVEL STRUCTURE.*/
78 xls[*nlvl + 1] = lvlend + 1;
79 i__1 = ccsize;
80 for (i = 1; i <= i__1; ++i) {
81 node = ls[i];
82 mask[node] = 1;
83 }
84 PetscFunctionReturn(PETSC_SUCCESS);
85 }
86