Actual source code: gennd.c
petsc-3.10.5 2019-03-28
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;
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: return(0);
29: }
32: /*****************************************************************/
33: /********* GENND ..... GENERAL NESTED DISSECTION *********/
34: /*****************************************************************/
36: /* PURPOSE - SUBROUTINE GENND FINDS A NESTED DISSECTION*/
37: /* ORDERING FOR A GENERAL GRAPH.*/
39: /* INPUT PARAMETERS -*/
40: /* NEQNS - NUMBER OF EQUATIONS.*/
41: /* (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR.*/
43: /* OUTPUT PARAMETERS -*/
44: /* PERM - THE NESTED DISSECTION ORDERING.*/
46: /* WORKING PARAMETERS -*/
47: /* MASK - IS USED TO MASK OFF VARIABLES THAT HAVE*/
48: /* BEEN NUMBERED DURING THE ORDERNG PROCESS.*/
49: /* (XLS, LS) - THIS LEVEL STRUCTURE PAIR IS USED AS*/
50: /* TEMPORARY STORAGE BY FN../../...*/
52: /* PROGRAM SUBROUTINES -*/
53: /* FNDSEP, REVRSE.*/
54: /*****************************************************************/
56: PetscErrorCode SPARSEPACKgennd(const PetscInt *neqns,const PetscInt *xadj,const PetscInt *adjncy,PetscInt *mask,PetscInt *perm,PetscInt *xls,PetscInt *ls)
57: {
58: /* System generated locals */
59: PetscInt i__1;
61: /* Local variables */
62: PetscInt nsep,root,i;
63: PetscInt num;
66: /* Parameter adjustments */
67: --ls;
68: --xls;
69: --perm;
70: --mask;
71: --adjncy;
72: --xadj;
74: i__1 = *neqns;
75: for (i = 1; i <= i__1; ++i) mask[i] = 1;
76: num = 0;
77: i__1 = *neqns;
78: for (i = 1; i <= i__1; ++i) {
79: /* FOR EACH MASKED COMPONENT ...*/
80: L200:
81: if (!mask[i]) goto L300;
82: root = i;
83: /* FIND A SEPARATOR AND NUMBER THE NODES NEXT.*/
84: SPARSEPACKfndsep(&root,&xadj[1],&adjncy[1],&mask[1],&nsep,&perm[num + 1],&xls[1],&ls[1]);
85: num += nsep;
86: if (num >= *neqns) goto L400;
87: goto L200;
88: L300:
89: ;
90: }
91: /* SINCE SEPARATORS FOUND FIRST SHOULD BE ORDERED*/
92: /* LAST, ROUTINE REVRSE IS CALLED TO ADJUST THE*/
93: /* ORDERING VECTOR.*/
94: L400:
95: SPARSEPACKrevrse(neqns,&perm[1]);
96: return(0);
97: }