1 /* rcm.f -- translated by f2c (version 19931217).*/ 2 3 #include <petscsys.h> 4 #include <petsc/private/matorderimpl.h> 5 6 /********* RCM ..... REVERSE CUTHILL-MCKEE ORDERING *******/ 7 /* PURPOSE - RCM NUMBERS A CONNECTED COMPONENT SPECIFIED BY */ 8 /* MASK AND ROOT, USING THE RCM ALGORITHM. */ 9 /* THE NUMBERING IS TO BE STARTED AT THE NODE ROOT. */ 10 /* */ 11 /* INPUT PARAMETERS - */ 12 /* ROOT - IS THE NODE THAT DEFINES THE CONNECTED */ 13 /* COMPONENT AND IT IS USED AS THE STARTING */ 14 /* NODE FOR THE RCM ORDERING. */ 15 /* (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR FOR */ 16 /* THE GRAPH. */ 17 /* */ 18 /* UPDATED PARAMETERS - */ 19 /* MASK - ONLY THOSE NODES WITH NONZERO INPUT MASK */ 20 /* VALUES ARE CONSIDERED BY THE ROUTINE. THE */ 21 /* NODES NUMBERED BY RCM WILL HAVE THEIR */ 22 /* MASK VALUES SET TO ZERO. */ 23 /* */ 24 /* OUTPUT PARAMETERS - */ 25 /* PERM - WILL CONTAIN THE RCM ORDERING. */ 26 /* CCSIZE - IS THE SIZE OF THE CONNECTED COMPONENT */ 27 /* THAT HAS BEEN NUMBERED BY RCM. */ 28 /* */ 29 /* WORKING PARAMETER - */ 30 /* DEG - IS A TEMPORARY VECTOR USED TO HOLD THE DEGREE */ 31 /* OF THE NODES IN THE SECTION GRAPH SPECIFIED */ 32 /* BY MASK AND ROOT. */ 33 /* */ 34 /* PROGRAM SUBROUTINES - */ 35 /* DEGREE. */ 36 /* */ 37 PetscErrorCode SPARSEPACKrcm(const PetscInt *root, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *mask, PetscInt *perm, PetscInt *ccsize, PetscInt *deg) 38 { 39 /* System generated locals */ 40 PetscInt i__1, i__2; 41 42 /* Local variables */ 43 PetscInt node, fnbr, lnbr, i, j, k, l, lperm, jstop, jstrt; 44 PetscInt lbegin, lvlend, nbr; 45 46 /* FIND THE DEGREES OF THE NODES IN THE */ 47 /* COMPONENT SPECIFIED BY MASK AND ROOT. */ 48 49 PetscFunctionBegin; 50 /* Parameter adjustments */ 51 --deg; 52 --perm; 53 --mask; 54 --adjncy; 55 --xadj; 56 57 PetscCall(SPARSEPACKdegree(root, &xadj[1], &adjncy[1], &mask[1], °[1], ccsize, &perm[1])); 58 mask[*root] = 0; 59 if (*ccsize <= 1) PetscFunctionReturn(PETSC_SUCCESS); 60 lvlend = 0; 61 lnbr = 1; 62 /* LBEGIN AND LVLEND POINT TO THE BEGINNING AND */ 63 /* THE END OF THE CURRENT LEVEL RESPECTIVELY. */ 64 L100: 65 lbegin = lvlend + 1; 66 lvlend = lnbr; 67 i__1 = lvlend; 68 for (i = lbegin; i <= i__1; ++i) { 69 /* FOR EACH NODE IN CURRENT LEVEL ... */ 70 node = perm[i]; 71 jstrt = xadj[node]; 72 jstop = xadj[node + 1] - 1; 73 74 /* FIND THE UNNUMBERED NEIGHBORS OF NODE. */ 75 /* FNBR AND LNBR POINT TO THE FIRST AND LAST */ 76 /* UNNUMBERED NEIGHBORS RESPECTIVELY OF THE CURRENT */ 77 /* NODE IN PERM. */ 78 fnbr = lnbr + 1; 79 i__2 = jstop; 80 for (j = jstrt; j <= i__2; ++j) { 81 nbr = adjncy[j]; 82 if (!mask[nbr]) goto L200; 83 ++lnbr; 84 mask[nbr] = 0; 85 perm[lnbr] = nbr; 86 L200:; 87 } 88 if (fnbr >= lnbr) goto L600; 89 90 /* SORT THE NEIGHBORS OF NODE IN INCREASING */ 91 /* ORDER BY DEGREE. LINEAR INSERTION IS USED.*/ 92 k = fnbr; 93 L300: 94 l = k; 95 ++k; 96 nbr = perm[k]; 97 L400: 98 if (l < fnbr) goto L500; 99 lperm = perm[l]; 100 if (deg[lperm] <= deg[nbr]) goto L500; 101 perm[l + 1] = lperm; 102 --l; 103 goto L400; 104 L500: 105 perm[l + 1] = nbr; 106 if (k < lnbr) goto L300; 107 L600:; 108 } 109 if (lnbr > lvlend) goto L100; 110 111 /* WE NOW HAVE THE CUTHILL MCKEE ORDERING.*/ 112 /* REVERSE IT BELOW ...*/ 113 k = *ccsize / 2; 114 l = *ccsize; 115 i__1 = k; 116 for (i = 1; i <= i__1; ++i) { 117 lperm = perm[l]; 118 perm[l] = perm[i]; 119 perm[i] = lperm; 120 --l; 121 } 122 PetscFunctionReturn(PETSC_SUCCESS); 123 } 124