Actual source code: gennd.c

petsc-3.10.5 2019-03-28
Report Typos and Errors

  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: }