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