Actual source code: gennd.c
2: /* gennd.f -- translated by f2c (version 19931217).*/
4: #include <petscsys.h>
5: #include <petsc/private/matorderimpl.h>
7: PetscErrorCode SPARSEPACKrevrse(const PetscInt *n, PetscInt *perm)
8: {
9: /* System generated locals */
10: PetscInt i__1;
12: /* Local variables */
13: PetscInt swap, i, m, in;
15: PetscFunctionBegin;
16: /* Parameter adjustments */
17: --perm;
19: in = *n;
20: m = *n / 2;
21: i__1 = m;
22: for (i = 1; i <= i__1; ++i) {
23: swap = perm[i];
24: perm[i] = perm[in];
25: perm[in] = swap;
26: --in;
27: }
28: PetscFunctionReturn(PETSC_SUCCESS);
29: }
31: /*****************************************************************/
32: /********* GENND ..... GENERAL NESTED DISSECTION *********/
33: /*****************************************************************/
35: /* PURPOSE - SUBROUTINE GENND FINDS A NESTED DISSECTION*/
36: /* ORDERING FOR A GENERAL GRAPH.*/
38: /* INPUT PARAMETERS -*/
39: /* NEQNS - NUMBER OF EQUATIONS.*/
40: /* (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR.*/
42: /* OUTPUT PARAMETERS -*/
43: /* PERM - THE NESTED DISSECTION ORDERING.*/
45: /* WORKING PARAMETERS -*/
46: /* MASK - IS USED TO MASK OFF VARIABLES THAT HAVE*/
47: /* BEEN NUMBERED DURING THE ORDERNG PROCESS.*/
48: /* (XLS, LS) - THIS LEVEL STRUCTURE PAIR IS USED AS*/
49: /* TEMPORARY STORAGE BY FN../../...*/
51: /* PROGRAM SUBROUTINES -*/
52: /* FNDSEP, REVRSE.*/
53: /*****************************************************************/
55: PetscErrorCode SPARSEPACKgennd(const PetscInt *neqns, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *mask, PetscInt *perm, PetscInt *xls, PetscInt *ls)
56: {
57: /* System generated locals */
58: PetscInt i__1;
60: /* Local variables */
61: PetscInt nsep, root, i;
62: PetscInt num;
64: PetscFunctionBegin;
65: /* Parameter adjustments */
66: --ls;
67: --xls;
68: --perm;
69: --mask;
70: --adjncy;
71: --xadj;
73: i__1 = *neqns;
74: for (i = 1; i <= i__1; ++i) mask[i] = 1;
75: num = 0;
76: i__1 = *neqns;
77: for (i = 1; i <= i__1; ++i) {
78: /* FOR EACH MASKED COMPONENT ...*/
79: L200:
80: if (!mask[i]) goto L300;
81: root = i;
82: /* FIND A SEPARATOR AND NUMBER THE NODES NEXT.*/
83: PetscCall(SPARSEPACKfndsep(&root, &xadj[1], &adjncy[1], &mask[1], &nsep, &perm[num + 1], &xls[1], &ls[1]));
84: num += nsep;
85: if (num >= *neqns) goto L400;
86: goto L200;
87: L300:;
88: }
89: /* SINCE SEPARATORS FOUND FIRST SHOULD BE ORDERED*/
90: /* LAST, ROUTINE REVRSE IS CALLED TO ADJUST THE*/
91: /* ORDERING VECTOR.*/
92: L400:
93: PetscCall(SPARSEPACKrevrse(neqns, &perm[1]));
94: PetscFunctionReturn(PETSC_SUCCESS);
95: }