Actual source code: fnroot.c
1: /*$Id: fnroot.c,v 1.16 2001/03/23 23:22:51 balay Exp $*/
2: /* fnroot.f -- translated by f2c (version 19931217).*/
4: #include petsc.h
6: /*****************************************************************/
7: /******** FN../../.. ..... FIND PSEUDO-PERIPHERAL NODE ********/
8: /*****************************************************************/
9: /* PURPOSE - FN../../.. IMPLEMENTS A MODIFIED VERSION OF THE */
10: /* SCHEME BY GIBBS, POOLE, AND STOCKMEYER TO FIND PSEUDO- */
11: /* PERIPHERAL NODES. IT DETERMINES SUCH A NODE FOR THE */
12: /* SECTION SUBGRAPH SPECIFIED BY MASK AND ../../... */
13: /* INPUT PARAMETERS - */
14: /* (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR FOR THE GRAPH. */
15: /* MASK - SPECIFIES A SECTION SUBGRAPH. NODES FOR WHICH */
16: /* MASK IS ZERO ARE IGNORED BY FN../../... */
17: /* UPDATED PARAMETER - */
18: /* ../../.. - ON INPUT, IT (ALONG WITH MASK) DEFINES THE */
19: /* COMPONENT FOR WHICH A PSEUDO-PERIPHERAL NODE IS */
20: /* TO BE FOUND. ON OUTPUT, IT IS THE NODE OBTAINED. */
21: /* */
22: /* OUTPUT PARAMETERS - */
23: /* NLVL - IS THE NUMBER OF LEVELS IN THE LEVEL STRUCTURE */
24: /* ../../..ED AT THE NODE ../../... */
25: /* (XLS,LS) - THE LEVEL STRUCTURE ARRAY PAIR CONTAINING */
26: /* THE LEVEL STRUCTURE FOUND. */
27: /* */
28: /* PROGRAM SUBROUTINES - */
29: /* ../../..LS. */
30: /* */
31: /****************************************************************/
32: int SPARSEPACKfnroot(int *root, int *xadj, int *adjncy,
33: int *mask, int *nlvl, int *xls, int *ls)
34: {
35: /* System generated locals */
36: int i__1, i__2;
38: /* Local variables */
39: int ndeg, node, j, k, nabor, kstop, jstrt, kstrt, mindeg,
40: ccsize, nunlvl;
41: EXTERN int SPARSEPACKrootls(int *, int *, int *,
42: int *, int *, int *, int *);
43: /* DETERMINE THE LEVEL STRUCTURE ../../..ED AT ../../... */
46: /* Parameter adjustments */
47: --ls;
48: --xls;
49: --mask;
50: --adjncy;
51: --xadj;
53: SPARSEPACKrootls(root, &xadj[1], &adjncy[1], &mask[1], nlvl, &xls[1], &ls[1]);
54: ccsize = xls[*nlvl + 1] - 1;
55: if (*nlvl == 1 || *nlvl == ccsize) {
56: return(0);
57: }
58: /* PICK A NODE WITH MINIMUM DEGREE FROM THE LAST LEVEL.*/
59: L100:
60: jstrt = xls[*nlvl];
61: mindeg = ccsize;
62: *root = ls[jstrt];
63: if (ccsize == jstrt) {
64: goto L400;
65: }
66: i__1 = ccsize;
67: for (j = jstrt; j <= i__1; ++j) {
68: node = ls[j];
69: ndeg = 0;
70: kstrt = xadj[node];
71: kstop = xadj[node + 1] - 1;
72: i__2 = kstop;
73: for (k = kstrt; k <= i__2; ++k) {
74: nabor = adjncy[k];
75: if (mask[nabor] > 0) {
76: ++ndeg;
77: }
78: }
79: if (ndeg >= mindeg) {
80: goto L300;
81: }
82: *root = node;
83: mindeg = ndeg;
84: L300:
85: ;
86: }
87: /* AND GENERATE ITS ../../..ED LEVEL STRUCTURE.*/
88: L400:
89: SPARSEPACKrootls(root, &xadj[1], &adjncy[1], &mask[1], &nunlvl, &xls[1], &ls[1]);
90: if (nunlvl <= *nlvl) {
91: return(0);
92: }
93: *nlvl = nunlvl;
94: if (*nlvl < ccsize) {
95: goto L100;
96: }
97: return(0);
98: }