PetscErrorCode SPARSEPACKfnroot(PetscInt *root,const PetscInt *xadj,const PetscInt *adjncy,PetscInt *mask, PetscInt *nlvl, PetscInt *xls, PetscInt *ls)
{
/* System generated locals */
PetscInt i__1, i__2;
/* Local variables */
PetscInt ndeg, node, j, k, nabor, kstop, jstrt, kstrt, mindeg, ccsize, nunlvl;
/* DETERMINE THE LEVEL STRUCTURE ROOTED AT ROOT. */
PetscFunctionBegin;
/* Parameter adjustments */
--ls;
--xls;
--mask;
--adjncy;
--xadj;
SPARSEPACKrootls(root, &xadj[1], &adjncy[1], &mask[1], nlvl, &xls[1], &ls[1]);
ccsize = xls[*nlvl + 1] - 1;
if (*nlvl == 1 || *nlvl == ccsize) PetscFunctionReturn(0);
/* PICK A NODE WITH MINIMUM DEGREE FROM THE LAST LEVEL.*/
L100:
jstrt = xls[*nlvl];
mindeg = ccsize;
*root = ls[jstrt];
if (ccsize == jstrt) goto L400;
i__1 = ccsize;
for (j = jstrt; j <= i__1; ++j) {
node = ls[j];
ndeg = 0;
kstrt = xadj[node];
kstop = xadj[node + 1] - 1;
i__2 = kstop;
for (k = kstrt; k <= i__2; ++k) {
nabor = adjncy[k];
if (mask[nabor] > 0) ++ndeg;
}
if (ndeg >= mindeg) goto L300;
*root = node;
mindeg = ndeg;
L300:
;
}
/* AND GENERATE ITS ROOTED LEVEL STRUCTURE.*/
L400:
SPARSEPACKrootls(root, &xadj[1], &adjncy[1], &mask[1], &nunlvl, &xls[1], &ls[1]);
if (nunlvl <= *nlvl) PetscFunctionReturn(0);
*nlvl = nunlvl;
if (*nlvl < ccsize) goto L100;
PetscFunctionReturn(0);
}
PetscErrorCode SPARSEPACKgen1wd(const PetscInt *neqns,const PetscInt *xadj,const PetscInt *adjncy,PetscInt *mask, PetscInt *nblks, PetscInt *xblk, PetscInt *perm, PetscInt *xls, PetscInt *ls)
{
/* System generated locals */
PetscInt i__1, i__2, i__3;
/* Local variables */
PetscInt node, nsep, lnum, nlvl, root;
PetscInt i, j, k, ccsize;
PetscInt num;
PetscFunctionBegin;
/* Parameter adjustments */
--ls;
--xls;
--perm;
--xblk;
--mask;
--xadj;
--adjncy;
i__1 = *neqns;
for (i = 1; i <= i__1; ++i) mask[i] = 1;
*nblks = 0;
num = 0;
i__1 = *neqns;
for (i = 1; i <= i__1; ++i) {
if (!mask[i]) goto L400;
/* FIND A ONE-WAY DISSECTOR FOR EACH COMPONENT.*/
root = i;
SPARSEPACKfn1wd(&root, &xadj[1], &adjncy[1], &mask[1], &nsep, &perm[num + 1], &nlvl, &xls[1], &ls[1]);
num += nsep;
++(*nblks);
xblk[*nblks] = *neqns - num + 1;
ccsize = xls[nlvl + 1] - 1;
/* NUMBER THE REMAINING NODES IN THE COMPONENT.*/
/* EACH COMPONENT IN THE REMAINING SUBGRAPH FORMS*/
/* A NEW BLOCK IN THE PARTITIONING.*/
i__2 = ccsize;
for (j = 1; j <= i__2; ++j) {
node = ls[j];
if (!mask[node]) goto L300;
SPARSEPACKrootls(&node, &xadj[1], &adjncy[1], &mask[1], &nlvl, &xls[1], &perm[num + 1]);
lnum = num + 1;
num = num + xls[nlvl + 1] - 1;
++(*nblks);
xblk[*nblks] = *neqns - num + 1;
i__3 = num;
for (k = lnum; k <= i__3; ++k) {
node = perm[k];
mask[node] = 0;
}
if (num > *neqns) goto L500;
L300:
;
}
L400:
;
}
/* SINCE DISSECTORS FOUND FIRST SHOULD BE ORDERED LAST,*/
/* ROUTINE REVRSE IS CALLED TO ADJUST THE ORDERING*/
/* VECTOR, AND THE BLOCK INDEX VECTOR.*/
L500:
SPARSEPACKrevrse(neqns, &perm[1]);
SPARSEPACKrevrse(nblks, &xblk[1]);
xblk[*nblks + 1] = *neqns + 1;
PetscFunctionReturn(0);
}
