1 /* fndsep.f -- translated by f2c (version 19931217).
2 */
3
4 #include <petsc/private/matorderimpl.h>
5
6 /*****************************************************************/
7 /************* FNDSEP ..... FIND SEPARATOR *************/
8 /*****************************************************************/
9 /* PURPOSE - THIS ROUTINE IS USED TO FIND A SMALL */
10 /* SEPARATOR FOR A CONNECTED COMPONENT SPECIFIED */
11 /* BY MASK IN THE GIVEN GRAPH. */
12 /* */
13 /* INPUT PARAMETERS - */
14 /* ROOT - IS THE NODE THAT DETERMINES THE MASKED */
15 /* COMPONENT. */
16 /* (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE PAIR. */
17 /* */
18 /* OUTPUT PARAMETERS - */
19 /* NSEP - NUMBER OF VARIABLES IN THE SEPARATOR. */
20 /* SEP - VECTOR CONTAINING THE SEPARATOR NODES. */
21 /* */
22 /* UPDATED PARAMETER - */
23 /* MASK - NODES IN THE SEPARATOR HAVE THEIR MASK */
24 /* VALUES SET TO ZERO. */
25 /* */
26 /* WORKING PARAMETERS - */
27 /* (XLS, LS) - LEVEL STRUCTURE PAIR FOR LEVEL STRUCTURE */
28 /* FOUND BY FNROOT. */
29 /* */
30 /* PROGRAM SUBROUTINES - */
31 /* FNROOT. */
32 /* */
33 /*****************************************************************/
SPARSEPACKfndsep(PetscInt * root,const PetscInt * inxadj,const PetscInt * adjncy,PetscInt * mask,PetscInt * nsep,PetscInt * sep,PetscInt * xls,PetscInt * ls)34 PetscErrorCode SPARSEPACKfndsep(PetscInt *root, const PetscInt *inxadj, const PetscInt *adjncy, PetscInt *mask, PetscInt *nsep, PetscInt *sep, PetscInt *xls, PetscInt *ls)
35 {
36 PetscInt *xadj = (PetscInt *)inxadj; /* Used as temporary and reset within this function */
37
38 /* System generated locals */
39 PetscInt i__1, i__2;
40
41 /* Local variables */
42 PetscInt node, nlvl, i, j, jstop, jstrt, mp1beg, mp1end, midbeg, midend, midlvl;
43 PetscInt nbr;
44
45 PetscFunctionBegin;
46 /* Parameter adjustments */
47 --ls;
48 --xls;
49 --sep;
50 --mask;
51 --adjncy;
52 --xadj;
53
54 PetscCall(SPARSEPACKfnroot(root, &xadj[1], &adjncy[1], &mask[1], &nlvl, &xls[1], &ls[1]));
55 /* IF THE NUMBER OF LEVELS IS LESS THAN 3, RETURN */
56 /* THE WHOLE COMPONENT AS THE SEPARATOR.*/
57 if (nlvl >= 3) goto L200;
58 *nsep = xls[nlvl + 1] - 1;
59 i__1 = *nsep;
60 for (i = 1; i <= i__1; ++i) {
61 node = ls[i];
62 sep[i] = node;
63 mask[node] = 0;
64 }
65 PetscFunctionReturn(PETSC_SUCCESS);
66 /* FIND THE MIDDLE LEVEL OF THE ROOTED LEVEL STRUCTURE.*/
67 L200:
68 midlvl = (nlvl + 2) / 2;
69 midbeg = xls[midlvl];
70 mp1beg = xls[midlvl + 1];
71 midend = mp1beg - 1;
72 mp1end = xls[midlvl + 2] - 1;
73 /* THE SEPARATOR IS OBTAINED BY INCLUDING ONLY THOSE*/
74 /* MIDDLE-LEVEL NODES WITH NEIGHBORS IN THE MIDDLE+1*/
75 /* LEVEL. XADJ IS USED TEMPORARILY TO MARK THOSE*/
76 /* NODES IN THE MIDDLE+1 LEVEL.*/
77 i__1 = mp1end;
78 for (i = mp1beg; i <= i__1; ++i) {
79 node = ls[i];
80 xadj[node] = -xadj[node];
81 }
82 *nsep = 0;
83 i__1 = midend;
84 for (i = midbeg; i <= i__1; ++i) {
85 node = ls[i];
86 jstrt = xadj[node];
87 i__2 = xadj[node + 1];
88 jstop = PetscAbsInt(i__2) - 1;
89 i__2 = jstop;
90 for (j = jstrt; j <= i__2; ++j) {
91 nbr = adjncy[j];
92 if (xadj[nbr] > 0) goto L400;
93 ++(*nsep);
94 sep[*nsep] = node;
95 mask[node] = 0;
96 goto L500;
97 L400:;
98 }
99 L500:;
100 }
101 /* RESET XADJ TO ITS CORRECT SIGN.*/
102 i__1 = mp1end;
103 for (i = mp1beg; i <= i__1; ++i) {
104 node = ls[i];
105 xadj[node] = -xadj[node];
106 }
107 PetscFunctionReturn(PETSC_SUCCESS);
108 }
109