Actual source code: degree.c

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

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

  5: /*****************************************************************/
  6: /*********     DEGREE ..... DEGREE IN MASKED COMPONENT   *********/
  7: /*****************************************************************/

  9: /*    PURPOSE - THIS ROUTINE COMPUTES THE DEGREES OF THE NODES*/
 10: /*       IN THE CONNECTED COMPONENT SPECIFIED BY MASK AND ROOT*/
 11: /*       NODES FOR WHICH MASK IS ZERO ARE IGNORED.*/

 13: /*    INPUT PARAMETER -*/
 14: /*       ROOT - IS THE INPUT NODE THAT DEFINES THE COMPONENT.*/
 15: /*       (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR.*/
 16: /*       MASK - SPECIFIES A SECTION SUBGRAPH.*/

 18: /*    OUTPUT PARAMETERS -*/
 19: /*       DEG - ARRAY CONTAINING THE DEGREES OF THE NODES IN*/
 20: /*             THE COMPONENT.*/
 21: /*       CCSIZE-SIZE OF THE COMPONENT SPECIFIED BY MASK AND ROOT*/
 22: /*    WORKING PARAMETER -*/
 23: /*       LS - A TEMPORARY VECTOR USED TO STORE THE NODES OF THE*/
 24: /*              COMPONENT LEVEL BY LEVEL.*/
 25: /*****************************************************************/
 26: PetscErrorCode SPARSEPACKdegree(const PetscInt *root, const PetscInt *inxadj, const PetscInt *adjncy, PetscInt *mask, PetscInt *deg, PetscInt *ccsize, PetscInt *ls)
 27: {
 28:   PetscInt *xadj = (PetscInt *)inxadj; /* Used as temporary and reset within this function */
 29:   /* System generated locals */
 30:   PetscInt i__1, i__2;

 32:   /* Local variables */
 33:   PetscInt ideg, node, i, j, jstop, jstrt, lbegin, lvlend, lvsize, nbr;
 34:   /*       INITIALIZATION ...*/
 35:   /*       THE ARRAY XADJ IS USED AS A TEMPORARY MARKER TO*/
 36:   /*       INDICATE WHICH NODES HAVE BEEN CONSIDERED SO FAR.*/

 38:   PetscFunctionBegin;
 39:   /* Parameter adjustments */
 40:   --ls;
 41:   --deg;
 42:   --mask;
 43:   --adjncy;
 44:   --xadj;

 46:   ls[1]       = *root;
 47:   xadj[*root] = -xadj[*root];
 48:   lvlend      = 0;
 49:   *ccsize     = 1;
 50: /*       LBEGIN IS THE POINTER TO THE BEGINNING OF THE CURRENT*/
 51: /*       LEVEL, AND LVLEND POINTS TO THE END OF THIS LEVEL.*/
 52: L100:
 53:   lbegin = lvlend + 1;
 54:   lvlend = *ccsize;
 55:   /*       FIND THE DEGREES OF NODES IN THE CURRENT LEVEL,*/
 56:   /*       AND AT THE SAME TIME, GENERATE THE NEXT LEVEL.*/
 57:   i__1 = lvlend;
 58:   for (i = lbegin; i <= i__1; ++i) {
 59:     node  = ls[i];
 60:     jstrt = -xadj[node];
 61:     i__2  = xadj[node + 1];
 62:     jstop = (PetscInt)PetscAbsInt(i__2) - 1;
 63:     ideg  = 0;
 64:     if (jstop < jstrt) goto L300;
 65:     i__2 = jstop;
 66:     for (j = jstrt; j <= i__2; ++j) {
 67:       nbr = adjncy[j];
 68:       if (!mask[nbr]) goto L200;
 69:       ++ideg;
 70:       if (xadj[nbr] < 0) goto L200;
 71:       xadj[nbr] = -xadj[nbr];
 72:       ++(*ccsize);
 73:       ls[*ccsize] = nbr;
 74:     L200:;
 75:     }
 76:   L300:
 77:     deg[node] = ideg;
 78:   }
 79:   /*       COMPUTE THE CURRENT LEVEL WIDTH. */
 80:   /*       IF IT IS NONZERO, GENERATE ANOTHER LEVEL.*/
 81:   lvsize = *ccsize - lvlend;
 82:   if (lvsize > 0) goto L100;
 83:   /*       RESET XADJ TO ITS CORRECT SIGN AND RETURN. */
 84:   i__1 = *ccsize;
 85:   for (i = 1; i <= i__1; ++i) {
 86:     node       = ls[i];
 87:     xadj[node] = -xadj[node];
 88:   }
 89:   PetscFunctionReturn(PETSC_SUCCESS);
 90: }