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