Actual source code: gennd.c

  1: /* gennd.f -- translated by f2c (version 19931217).*/

  3: #include <petscsys.h>
  4: #include <petsc/private/matorderimpl.h>

  6: PetscErrorCode SPARSEPACKrevrse(const PetscInt *n, PetscInt *perm)
  7: {
  8:   /* System generated locals */
  9:   PetscInt i__1;

 11:   /* Local variables */
 12:   PetscInt swap, i, m, in;

 14:   PetscFunctionBegin;
 15:   /* Parameter adjustments */
 16:   --perm;

 18:   in   = *n;
 19:   m    = *n / 2;
 20:   i__1 = m;
 21:   for (i = 1; i <= i__1; ++i) {
 22:     swap     = perm[i];
 23:     perm[i]  = perm[in];
 24:     perm[in] = swap;
 25:     --in;
 26:   }
 27:   PetscFunctionReturn(PETSC_SUCCESS);
 28: }

 30: /*****************************************************************/
 31: /*********     GENND ..... GENERAL NESTED DISSECTION     *********/
 32: /*****************************************************************/

 34: /*    PURPOSE - SUBROUTINE GENND FINDS A NESTED DISSECTION*/
 35: /*       ORDERING FOR A GENERAL GRAPH.*/

 37: /*    INPUT PARAMETERS -*/
 38: /*       NEQNS - NUMBER OF EQUATIONS.*/
 39: /*       (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR.*/

 41: /*    OUTPUT PARAMETERS -*/
 42: /*       PERM - THE NESTED DISSECTION ORDERING.*/

 44: /*    WORKING PARAMETERS -*/
 45: /*       MASK - IS USED TO MASK OFF VARIABLES THAT HAVE*/
 46: /*              BEEN NUMBERED DURING THE ORDERNG PROCESS.*/
 47: /*       (XLS, LS) - THIS LEVEL STRUCTURE PAIR IS USED AS*/
 48: /*              TEMPORARY STORAGE BY FNROOT.*/

 50: /*    PROGRAM SUBROUTINES -*/
 51: /*       FNDSEP, REVRSE.*/
 52: /*****************************************************************/

 54: PetscErrorCode SPARSEPACKgennd(const PetscInt *neqns, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *mask, PetscInt *perm, PetscInt *xls, PetscInt *ls)
 55: {
 56:   /* System generated locals */
 57:   PetscInt i__1;

 59:   /* Local variables */
 60:   PetscInt nsep, root, i;
 61:   PetscInt num;

 63:   PetscFunctionBegin;
 64:   /* Parameter adjustments */
 65:   --ls;
 66:   --xls;
 67:   --perm;
 68:   --mask;
 69:   --adjncy;
 70:   --xadj;

 72:   i__1 = *neqns;
 73:   for (i = 1; i <= i__1; ++i) mask[i] = 1;
 74:   num  = 0;
 75:   i__1 = *neqns;
 76:   for (i = 1; i <= i__1; ++i) {
 77:   /*           FOR EACH MASKED COMPONENT ...*/
 78:   L200:
 79:     if (!mask[i]) goto L300;
 80:     root = i;
 81:     /*              FIND A SEPARATOR AND NUMBER THE NODES NEXT.*/
 82:     PetscCall(SPARSEPACKfndsep(&root, &xadj[1], &adjncy[1], &mask[1], &nsep, &perm[num + 1], &xls[1], &ls[1]));
 83:     num += nsep;
 84:     if (num >= *neqns) goto L400;
 85:     goto L200;
 86:   L300:;
 87:   }
 88: /*        SINCE SEPARATORS FOUND FIRST SHOULD BE ORDERED*/
 89: /*        LAST, ROUTINE REVRSE IS CALLED TO ADJUST THE*/
 90: /*        ORDERING VECTOR.*/
 91: L400:
 92:   PetscCall(SPARSEPACKrevrse(neqns, &perm[1]));
 93:   PetscFunctionReturn(PETSC_SUCCESS);
 94: }