1 /* genrcm.f -- translated by f2c (version 19931217).*/
2
3 #include <petscsys.h>
4 #include <petsc/private/matorderimpl.h>
5
6 /*****************************************************************/
7 /*****************************************************************/
8 /********* GENRCM ..... GENERAL REVERSE CUTHILL MCKEE ********/
9 /*****************************************************************/
10
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.*/
15
16 /* INPUT PARAMETERS -*/
17 /* NEQNS - NUMBER OF EQUATIONS*/
18 /* (XADJ, ADJNCY) - ARRAY PAIR CONTAINING THE ADJACENCY*/
19 /* STRUCTURE OF THE GRAPH OF THE MATRIX.*/
20
21 /* OUTPUT PARAMETER -*/
22 /* PERM - VECTOR THAT CONTAINS THE RCM ORDERING.*/
23
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.*/
32
33 /* PROGRAM SUBROUTINES -*/
34 /* FNROOT, RCM.*/
35 /*****************************************************************/
SPARSEPACKgenrcm(const PetscInt * neqns,const PetscInt * xadj,const PetscInt * adjncy,PetscInt * perm,PetscInt * mask,PetscInt * xls)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;
40
41 /* Local variables */
42 PetscInt nlvl, root, i, ccsize;
43 PetscInt num;
44
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 }
53
54 /* Parameter adjustments */
55 --xls;
56 --mask;
57 --perm;
58 --adjncy;
59 --xadj;
60
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 }
82