Actual source code: rootls.c

petsc-3.11.4 2019-09-28
Report Typos and Errors

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

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

  7: /*****************************************************************/
  8: /*********     ../../..LS ..... ../../..ED LEVEL STRUCTURE      **********/
  9: /*****************************************************************/
 10: /*    PURPOSE - ../../..LS GENERATES THE LEVEL STRUCTURE ../../..ED */
 11: /*       AT THE INPUT NODE CALLED ../../... ONLY THOSE NODES FOR*/
 12: /*       WHICH MASK IS NONZERO WILL BE CONSIDERED.*/
 13: /*                                                */
 14: /*    INPUT PARAMETERS -                          */
 15: /*       ../../.. - THE NODE AT WHICH THE LEVEL STRUCTURE IS TO*/
 16: /*              BE ../../..ED.*/
 17: /*       (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR FOR THE*/
 18: /*              GIVEN GRAPH.*/
 19: /*       MASK - IS USED TO SPECIFY A SECTION SUBGRAPH. NODES*/
 20: /*              WITH MASK(I)=0 ARE IGNORED.*/
 21: /*    OUTPUT PARAMETERS -*/
 22: /*       NLVL - IS THE NUMBER OF LEVELS IN THE LEVEL STRUCTURE.*/
 23: /*       (XLS, LS) - ARRAY PAIR FOR THE ../../..ED LEVEL STRUCTURE.*/
 24: /*****************************************************************/
 25: PetscErrorCode SPARSEPACKrootls(const PetscInt *root,const PetscInt *xadj,const PetscInt *adjncy,PetscInt *mask, PetscInt *nlvl, PetscInt *xls, PetscInt *ls)
 26: {
 27:   /* System generated locals */
 28:   PetscInt i__1, i__2;

 30:   /* Local variables */
 31:   PetscInt node, i, j, jstop, jstrt, lbegin, ccsize, lvlend, lvsize, nbr;

 33: /*       INITIALIZATION ...*/


 37:   /* Parameter adjustments */
 38:   --ls;
 39:   --xls;
 40:   --mask;
 41:   --adjncy;
 42:   --xadj;

 44:   mask[*root] = 0;
 45:   ls[1]       = *root;
 46:   *nlvl       = 0;
 47:   lvlend      = 0;
 48:   ccsize      = 1;
 49: /*       LBEGIN IS THE POINTER TO THE BEGINNING OF THE CURRENT*/
 50: /*       LEVEL, AND LVLEND POINTS TO THE END OF THIS LEVEL.*/
 51: L200:
 52:   lbegin = lvlend + 1;
 53:   lvlend = ccsize;
 54:   ++(*nlvl);
 55:   xls[*nlvl] = lbegin;
 56: /*       GENERATE THE NEXT LEVEL BY FINDING ALL THE MASKED */
 57: /*       NEIGHBORS OF NODES IN THE CURRENT LEVEL.*/
 58:   i__1 = lvlend;
 59:   for (i = lbegin; i <= i__1; ++i) {
 60:     node  = ls[i];
 61:     jstrt = xadj[node];
 62:     jstop = xadj[node + 1] - 1;
 63:     if (jstop < jstrt) goto L400;
 64:     i__2 = jstop;
 65:     for (j = jstrt; j <= i__2; ++j) {
 66:       nbr = adjncy[j];
 67:       if (!mask[nbr]) goto L300;
 68:       ++ccsize;
 69:       ls[ccsize] = nbr;
 70:       mask[nbr]  = 0;
 71: L300:
 72:       ;
 73:     }
 74: L400:
 75:     ;
 76:   }
 77: /*       COMPUTE THE CURRENT LEVEL WIDTH.*/
 78: /*       IF IT IS NONZERO, GENERATE THE NEXT LEVEL.*/
 79:   lvsize = ccsize - lvlend;
 80:   if (lvsize > 0) goto L200;
 81: /*       RESET MASK TO ONE FOR THE NODES IN THE LEVEL STRUCTURE.*/
 82:   xls[*nlvl + 1] = lvlend + 1;
 83:   i__1           = ccsize;
 84:   for (i = 1; i <= i__1; ++i) {
 85:     node       = ls[i];
 86:     mask[node] = 1;
 87:   }
 88:   return(0);
 89: }