Actual source code: rcm.c

  1: #define PETSCMAT_DLL

  3: /* rcm.f -- translated by f2c (version 19931217).*/

 5:  #include petsc.h

  7: /*****************************************************************/
  8: /*********     RCM ..... REVERSE CUTHILL-MCKEE ORDERING   *******/
  9: /*****************************************************************/
 10: /*    PURPOSE - RCM NUMBERS A CONNECTED COMPONENT SPECIFIED BY    */
 11: /*       MASK AND ../../.., USING THE RCM ALGORITHM.                  */
 12: /*       THE NUMBERING IS TO BE STARTED AT THE NODE ../../...         */
 13: /*                                                               */
 14: /*    INPUT PARAMETERS -                                         */
 15: /*       ../../.. - IS THE NODE THAT DEFINES THE CONNECTED           */
 16: /*              COMPONENT AND IT IS USED AS THE STARTING         */
 17: /*              NODE FOR THE RCM ORDERING.                       */
 18: /*       (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR FOR           */
 19: /*              THE GRAPH.                                       */
 20: /*                                                               */
 21: /*    UPDATED PARAMETERS -                                       */
 22: /*       MASK - ONLY THOSE NODES WITH NONZERO INPUT MASK         */
 23: /*              VALUES ARE CONSIDERED BY THE ROUTINE.  THE       */
 24: /*              NODES NUMBERED BY RCM WILL HAVE THEIR            */
 25: /*              MASK VALUES SET TO ZERO.                         */
 26: /*                                                               */
 27: /*    OUTPUT PARAMETERS -                                        */
 28: /*       PERM - WILL CONTAIN THE RCM ORDERING.                   */
 29: /*       CCSIZE - IS THE SIZE OF THE CONNECTED COMPONENT         */
 30: /*              THAT HAS BEEN NUMBERED BY RCM.                  */
 31: /*                                                              */
 32: /*    WORKING PARAMETER -                                       */
 33: /*       DEG - IS A TEMPORARY VECTOR USED TO HOLD THE DEGREE    */
 34: /*              OF THE NODES IN THE SECTION GRAPH SPECIFIED     */
 35: /*              BY MASK AND ../../...                               */
 36: /*                                                              */
 37: /*    PROGRAM SUBROUTINES -                                     */
 38: /*       DEGREE.                                                */
 39: /*                                                              */
 40: /****************************************************************/
 43: PetscErrorCode SPARSEPACKrcm(PetscInt *root, PetscInt *xadj, PetscInt *adjncy, 
 44:         PetscInt *mask, PetscInt *perm, PetscInt *ccsize, PetscInt *deg)
 45: {
 46:     /* System generated locals */
 47:     PetscInt i__1, i__2;

 49:     /* Local variables */
 50:     PetscInt node, fnbr, lnbr, i, j, k, l, lperm, jstop, jstrt;
 51:     EXTERN PetscErrorCode SPARSEPACKdegree(PetscInt*, PetscInt *, PetscInt *,
 52:             PetscInt *, PetscInt *, PetscInt *, PetscInt *);
 53:     PetscInt lbegin, lvlend, nbr;

 55: /*       FIND THE DEGREES OF THE NODES IN THE                  */
 56: /*       COMPONENT SPECIFIED BY MASK AND ../../...                 */
 57: /*       -------------------------------------                 */


 61:     /* Parameter adjustments */
 62:     --deg;
 63:     --perm;
 64:     --mask;
 65:     --adjncy;
 66:     --xadj;


 69:     SPARSEPACKdegree(root, &xadj[1], &adjncy[1], &mask[1], &deg[1], ccsize, &perm[1]);
 70:     mask[*root] = 0;
 71:     if (*ccsize <= 1) {
 72:         return(0);
 73:     }
 74:     lvlend = 0;
 75:     lnbr = 1;
 76: /*       LBEGIN AND LVLEND POINT TO THE BEGINNING AND */
 77: /*       THE END OF THE CURRENT LEVEL RESPECTIVELY.  */
 78: L100:
 79:     lbegin = lvlend + 1;
 80:     lvlend = lnbr;
 81:     i__1 = lvlend;
 82:     for (i = lbegin; i <= i__1; ++i) {
 83: /*          FOR EACH NODE IN CURRENT LEVEL ...     */
 84:         node = perm[i];
 85:         jstrt = xadj[node];
 86:         jstop = xadj[node + 1] - 1;

 88: /*          FIND THE UNNUMBERED NEIGHBORS OF NODE.   */
 89: /*          FNBR AND LNBR POINT TO THE FIRST AND LAST  */
 90: /*          UNNUMBERED NEIGHBORS RESPECTIVELY OF THE CURRENT  */
 91: /*          NODE IN PERM. */
 92:         fnbr = lnbr + 1;
 93:         i__2 = jstop;
 94:         for (j = jstrt; j <= i__2; ++j) {
 95:             nbr = adjncy[j];
 96:             if (!mask[nbr]) {
 97:                 goto L200;
 98:             }
 99:             ++lnbr;
100:             mask[nbr] = 0;
101:             perm[lnbr] = nbr;
102: L200:
103:             ;
104:         }
105:         if (fnbr >= lnbr) {
106:             goto L600;
107:         }
108: /*             SORT THE NEIGHBORS OF NODE IN INCREASING    */
109: /*             ORDER BY DEGREE. LINEAR INSERTION IS USED.*/
110:         k = fnbr;
111: L300:
112:         l = k;
113:         ++k;
114:         nbr = perm[k];
115: L400:
116:         if (l < fnbr) {
117:             goto L500;
118:         }
119:         lperm = perm[l];
120:         if (deg[lperm] <= deg[nbr]) {
121:             goto L500;
122:         }
123:         perm[l + 1] = lperm;
124:         --l;
125:         goto L400;
126: L500:
127:         perm[l + 1] = nbr;
128:         if (k < lnbr) {
129:             goto L300;
130:         }
131: L600:
132:         ;
133:     }
134:     if (lnbr > lvlend) {
135:         goto L100;
136:     }
137: /*       WE NOW HAVE THE CUTHILL MCKEE ORDERING.*/
138: /*       REVERSE IT BELOW ...*/
139:     k = *ccsize / 2;
140:     l = *ccsize;
141:     i__1 = k;
142:     for (i = 1; i <= i__1; ++i) {
143:         lperm = perm[l];
144:         perm[l] = perm[i];
145:         perm[i] = lperm;
146:         --l;
147:     }
148:     return(0);
149: }