Actual source code: genrcm.c
1: /* genrcm.f -- translated by f2c (version 19931217).*/
3: #include <petscsys.h>
4: #include <petsc/private/matorderimpl.h>
6: /*****************************************************************/
7: /*****************************************************************/
8: /********* GENRCM ..... GENERAL REVERSE CUTHILL MCKEE ********/
9: /*****************************************************************/
11: /* PURPOSE - GENRCM FINDS THE REVERSE CUTHILL-MCKEE*/
12: /* ORDERING FOR A GENERAL GRAPH. FOR EACH CONNECTED*/
13: /* COMPONENT IN THE GRAPH, GENRCM OBTAINS THE ORDERING*/
14: /* BY CALLING THE SUBROUTINE RCM.*/
16: /* INPUT PARAMETERS -*/
17: /* NEQNS - NUMBER OF EQUATIONS*/
18: /* (XADJ, ADJNCY) - ARRAY PAIR CONTAINING THE ADJACENCY*/
19: /* STRUCTURE OF THE GRAPH OF THE MATRIX.*/
21: /* OUTPUT PARAMETER -*/
22: /* PERM - VECTOR THAT CONTAINS THE RCM ORDERING.*/
24: /* WORKING PARAMETERS -*/
25: /* MASK - IS USED TO MARK VARIABLES THAT HAVE BEEN*/
26: /* NUMBERED DURING THE ORDERING PROCESS. IT IS*/
27: /* INITIALIZED TO 1, AND SET TO ZERO AS EACH NODE*/
28: /* IS NUMBERED.*/
29: /* XLS - THE INDEX VECTOR FOR A LEVEL STRUCTURE. THE*/
30: /* LEVEL STRUCTURE IS STORED IN THE CURRENTLY*/
31: /* UNUSED SPACES IN THE PERMUTATION VECTOR PERM.*/
33: /* PROGRAM SUBROUTINES -*/
34: /* FNROOT, RCM.*/
35: /*****************************************************************/
36: PetscErrorCode SPARSEPACKgenrcm(const PetscInt *neqns, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *perm, PetscInt *mask, PetscInt *xls)
37: {
38: /* System generated locals */
39: PetscInt i__1;
41: /* Local variables */
42: PetscInt nlvl, root, i, ccsize;
43: PetscInt num;
45: PetscFunctionBegin;
46: if (!*neqns) PetscFunctionReturn(PETSC_SUCCESS);
47: if (*neqns == 1) {
48: perm[0] = 1;
49: mask[0] = 1;
50: xls[0] = 1;
51: PetscFunctionReturn(PETSC_SUCCESS);
52: }
54: /* Parameter adjustments */
55: --xls;
56: --mask;
57: --perm;
58: --adjncy;
59: --xadj;
61: i__1 = *neqns;
62: for (i = 1; i <= i__1; ++i) mask[i] = 1;
63: num = 1;
64: i__1 = *neqns;
65: for (i = 1; i <= i__1; ++i) {
66: /* FOR EACH MASKED CONNECTED COMPONENT ...*/
67: if (!mask[i]) goto L200;
68: root = i;
69: /* FIRST FIND A PSEUDO-PERIPHERAL NODE ROOT.*/
70: /* NOTE THAT THE LEVEL STRUCTURE FOUND BY*/
71: /* FNROOT IS STORED STARTING AT PERM(NUM).*/
72: /* THEN RCM IS CALLED TO ORDER THE COMPONENT*/
73: /* USING ROOT AS THE STARTING NODE.*/
74: PetscCall(SPARSEPACKfnroot(&root, &xadj[1], &adjncy[1], &mask[1], &nlvl, &xls[1], &perm[num]));
75: PetscCall(SPARSEPACKrcm(&root, &xadj[1], &adjncy[1], &mask[1], &perm[num], &ccsize, &xls[1]));
76: num += ccsize;
77: if (num > *neqns) PetscFunctionReturn(PETSC_SUCCESS);
78: L200:;
79: }
80: PetscFunctionReturn(PETSC_SUCCESS);
81: }