PetscErrorCode SPARSEPACKgenrcm(const PetscInt *neqns,const PetscInt *xadj,const PetscInt *adjncy,PetscInt *perm,PetscInt *mask,PetscInt *xls)
{
/* System generated locals */
PetscInt i__1;
/* Local variables */
PetscInt nlvl,root,i,ccsize;
PetscInt num;
PetscFunctionBegin;
/* Parameter adjustments */
--xls;
--mask;
--perm;
--adjncy;
--xadj;
i__1 = *neqns;
for (i = 1; i <= i__1; ++i) mask[i] = 1;
num = 1;
i__1 = *neqns;
for (i = 1; i <= i__1; ++i) {
/* FOR EACH MASKED CONNECTED COMPONENT ...*/
if (!mask[i]) goto L200;
root = i;
/* FIRST FIND A PSEUDO-PERIPHERAL NODE ROOT.*/
/* NOTE THAT THE LEVEL STRUCTURE FOUND BY*/
/* FNROOT IS STORED STARTING AT PERM(NUM).*/
/* THEN RCM IS CALLED TO ORDER THE COMPONENT*/
/* USING ROOT AS THE STARTING NODE.*/
SPARSEPACKfnroot(&root,&xadj[1],&adjncy[1],&mask[1],&nlvl,&xls[1],&perm[num]);
SPARSEPACKrcm(&root,&xadj[1],&adjncy[1],&mask[1],&perm[num],&ccsize,&xls[1]);
num += ccsize;
if (num > *neqns) PetscFunctionReturn(0);
L200:
;
}
PetscFunctionReturn(0);
}
PetscErrorCode SPARSEPACKfndsep(PetscInt *root, PetscInt *xadj, PetscInt *adjncy,
PetscInt *mask, PetscInt *nsep, PetscInt *sep, PetscInt *xls, PetscInt *ls)
{
/* System generated locals */
PetscInt i__1, i__2;
/* Local variables */
PetscInt node, nlvl, i, j, jstop, jstrt, mp1beg, mp1end, midbeg, midend, midlvl;
PetscInt nbr;
PetscFunctionBegin;
/* Parameter adjustments */
--ls;
--xls;
--sep;
--mask;
--adjncy;
--xadj;
SPARSEPACKfnroot(root, &xadj[1], &adjncy[1], &mask[1], &nlvl, &xls[1], &ls[1]);
/* IF THE NUMBER OF LEVELS IS LESS THAN 3, RETURN */
/* THE WHOLE COMPONENT AS THE SEPARATOR.*/
if (nlvl >= 3) {
goto L200;
}
*nsep = xls[nlvl + 1] - 1;
i__1 = *nsep;
for (i = 1; i <= i__1; ++i) {
node = ls[i];
sep[i] = node;
mask[node] = 0;
}
PetscFunctionReturn(0);
/* FIND THE MIDDLE LEVEL OF THE ROOTED LEVEL STRUCTURE.*/
L200:
midlvl = (nlvl + 2) / 2;
midbeg = xls[midlvl];
mp1beg = xls[midlvl + 1];
midend = mp1beg - 1;
mp1end = xls[midlvl + 2] - 1;
/* THE SEPARATOR IS OBTAINED BY INCLUDING ONLY THOSE*/
/* MIDDLE-LEVEL NODES WITH NEIGHBORS IN THE MIDDLE+1*/
/* LEVEL. XADJ IS USED TEMPORARILY TO MARK THOSE*/
/* NODES IN THE MIDDLE+1 LEVEL.*/
i__1 = mp1end;
for (i = mp1beg; i <= i__1; ++i) {
node = ls[i];
xadj[node] = -xadj[node];
}
*nsep = 0;
i__1 = midend;
for (i = midbeg; i <= i__1; ++i) {
node = ls[i];
jstrt = xadj[node];
jstop = (i__2 = xadj[node + 1], (PetscInt)PetscAbsInt(i__2)) - 1;
i__2 = jstop;
for (j = jstrt; j <= i__2; ++j) {
nbr = adjncy[j];
if (xadj[nbr] > 0) {
goto L400;
}
++(*nsep);
sep[*nsep] = node;
mask[node] = 0;
goto L500;
L400:
;
}
L500:
;
}
/* RESET XADJ TO ITS CORRECT SIGN.*/
i__1 = mp1end;
for (i = mp1beg; i <= i__1; ++i) {
node = ls[i];
xadj[node] = -xadj[node];
}
PetscFunctionReturn(0);
}
