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