Actual source code: fnroot.c
1: /* fnroot.f -- translated by f2c (version 19931217).*/
3: #include <petscsys.h>
4: #include <petsc/private/matorderimpl.h>
6: /*****************************************************************/
7: /******** FNROOT ..... FIND PSEUDO-PERIPHERAL NODE ********/
8: /*****************************************************************/
9: /* PURPOSE - FNROOT 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 ROOT. */
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 FNROOT. */
17: /* UPDATED PARAMETER - */
18: /* ROOT - 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: /* ROOTED AT THE NODE ROOT. */
25: /* (XLS,LS) - THE LEVEL STRUCTURE ARRAY PAIR CONTAINING */
26: /* THE LEVEL STRUCTURE FOUND. */
27: /* */
28: /* PROGRAM SUBROUTINES - */
29: /* ROOTLS. */
30: /* */
31: /****************************************************************/
32: PetscErrorCode SPARSEPACKfnroot(PetscInt *root, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *mask, PetscInt *nlvl, PetscInt *xls, PetscInt *ls)
33: {
34: /* System generated locals */
35: PetscInt i__1, i__2;
37: /* Local variables */
38: PetscInt ndeg, node, j, k, nabor, kstop, jstrt, kstrt, mindeg, ccsize, nunlvl;
39: /* DETERMINE THE LEVEL STRUCTURE ROOTED AT ROOT. */
41: PetscFunctionBegin;
42: /* Parameter adjustments */
43: --ls;
44: --xls;
45: --mask;
46: --adjncy;
47: --xadj;
49: PetscCall(SPARSEPACKrootls(root, &xadj[1], &adjncy[1], &mask[1], nlvl, &xls[1], &ls[1]));
50: ccsize = xls[*nlvl + 1] - 1;
51: if (*nlvl == 1 || *nlvl == ccsize) PetscFunctionReturn(PETSC_SUCCESS);
53: /* PICK A NODE WITH MINIMUM DEGREE FROM THE LAST LEVEL.*/
54: L100:
55: jstrt = xls[*nlvl];
56: mindeg = ccsize;
57: *root = ls[jstrt];
58: if (ccsize == jstrt) goto L400;
59: i__1 = ccsize;
60: for (j = jstrt; j <= i__1; ++j) {
61: node = ls[j];
62: ndeg = 0;
63: kstrt = xadj[node];
64: kstop = xadj[node + 1] - 1;
65: i__2 = kstop;
66: for (k = kstrt; k <= i__2; ++k) {
67: nabor = adjncy[k];
68: if (mask[nabor] > 0) ++ndeg;
69: }
70: if (ndeg >= mindeg) goto L300;
71: *root = node;
72: mindeg = ndeg;
73: L300:;
74: }
75: /* AND GENERATE ITS ROOTED LEVEL STRUCTURE.*/
76: L400:
77: PetscCall(SPARSEPACKrootls(root, &xadj[1], &adjncy[1], &mask[1], &nunlvl, &xls[1], &ls[1]));
78: if (nunlvl <= *nlvl) PetscFunctionReturn(PETSC_SUCCESS);
79: *nlvl = nunlvl;
80: if (*nlvl < ccsize) goto L100;
81: PetscFunctionReturn(PETSC_SUCCESS);
82: }