Date: 2022-03-31T04:47:24+00:00

Actual source code: genrcm.c

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

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

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

     12: /*    PURPOSE - GENRCM FINDS THE REVERSE CUTHILL-MCKEE*/
     13: /*       ORDERING FOR A GENERAL GRAPH. FOR EACH CONNECTED*/
     14: /*       COMPONENT IN THE GRAPH, GENRCM OBTAINS THE ORDERING*/
     15: /*       BY CALLING THE SUBROUTINE RCM.*/

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

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

     25: /*    WORKING PARAMETERS -*/
     26: /*       MASK - IS USED TO MARK VARIABLES THAT HAVE BEEN*/
     27: /*              NUMBERED DURING THE ORDERING PROCESS. IT IS*/
     28: /*              INITIALIZED TO 1, AND SET TO ZERO AS EACH NODE*/
     29: /*              IS NUMBERED.*/
     30: /*       XLS - THE INDEX VECTOR FOR A LEVEL STRUCTURE.  THE*/
     31: /*              LEVEL STRUCTURE IS STORED IN THE CURRENTLY*/
     32: /*              UNUSED SPACES IN THE PERMUTATION VECTOR PERM.*/

     34: /*    PROGRAM SUBROUTINES -*/
     35: /*       FN../../.., RCM.*/
     36: /*****************************************************************/
     37: PetscErrorCode SPARSEPACKgenrcm(const PetscInt *neqns,const PetscInt *xadj,const PetscInt *adjncy,PetscInt *perm,PetscInt *mask,PetscInt *xls)
     38: {
     39:   /* System generated locals */
     40:   PetscInt i__1;

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

     46:   /* Parameter adjustments */
     47:   --xls;
     48:   --mask;
     49:   --perm;
     50:   --adjncy;
     51:   --xadj;

     53:   i__1 = *neqns;
     54:   for (i = 1; i <= i__1; ++i) mask[i] = 1;
     55:   num  = 1;
     56:   i__1 = *neqns;
     57:   for (i = 1; i <= i__1; ++i) {
     58: /*          FOR EACH MASKED CONNECTED COMPONENT ...*/
     59:     if (!mask[i]) goto L200;
     60:     root = i;
     61: /*             FIRST FIND A PSEUDO-PERIPHERAL NODE ../../...*/
     62: /*             NOTE THAT THE LEVEL STRUCTURE FOUND BY*/
     63: /*             FN../../.. IS STORED STARTING AT PERM(NUM).*/
     64: /*             THEN RCM IS CALLED TO ORDER THE COMPONENT*/
     65: /*             USING ../../.. AS THE STARTING NODE.*/
     66:     SPARSEPACKfnroot(&root,&xadj[1],&adjncy[1],&mask[1],&nlvl,&xls[1],&perm[num]);
     67:     SPARSEPACKrcm(&root,&xadj[1],&adjncy[1],&mask[1],&perm[num],&ccsize,&xls[1]);
     68:     num += ccsize;
     69:     if (num > *neqns) return 0;
     70: L200:
     71:     ;
     72:   }
     73:   return 0;
     74: }