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