Actual source code: genrcm.c

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

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

      6: /*****************************************************************/
      7: /*****************************************************************/
      8: /*********   GENRCM ..... GENERAL REVERSE CUTHILL MCKEE   ********/
      9: /*****************************************************************/

     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.*/

     16: /*    INPUT PARAMETERS -*/
     17: /*       NEQNS - NUMBER OF EQUATIONS*/
     18: /*       (XADJ, ADJNCY) - ARRAY PAIR CONTAINING THE ADJACENCY*/
     19: /*              STRUCTURE OF THE GRAPH OF THE MATRIX.*/

     21: /*    OUTPUT PARAMETER -*/
     22: /*       PERM - VECTOR THAT CONTAINS THE RCM ORDERING.*/

     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.*/

     33: /*    PROGRAM SUBROUTINES -*/
     34: /*       FNROOT, RCM.*/
     35: /*****************************************************************/
     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;

     41:   /* Local variables */
     42:   PetscInt nlvl, root, i, ccsize;
     43:   PetscInt num;

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

     54:   /* Parameter adjustments */
     55:   --xls;
     56:   --mask;
     57:   --perm;
     58:   --adjncy;
     59:   --xadj;

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