Skip to content
Snippets Groups Projects
rootls_sloan.f 3.77 KiB
Newer Older
  • Learn to ignore specific revisions
  • Douglas Guptill's avatar
    Douglas Guptill committed
          SUBROUTINE ROOTLS_SLOAN(N,ROOT,MAXWID,E2,ADJ,XADJ,MASK,LS,XLS,
         +DEPTH,WIDTH)
    ************************************************************************
    *
    *     PURPOSE:
    *     --------
    *
    *     Generate rooted level structure using a FORTRAN 77 implementation
    *     of the algorithm given by George and Liu
    *
    *     INPUT:
    *     ------
    *
    *     N      - Number of nodes
    *     ROOT   - Root node for level structure
    *     MAXWID - Max permissible width of rooted level structure
    *            - Abort assembly of level structure if width is ge MAXWID
    *            - Assembly ensured by setting MAXWID = N+1
    *     E2     - Twice the number of edges in the graph = XADJ(N+1)-1
    *     ADJ    - Adjacency list for all nodes in graph
    *            - List of length 2E where E is the number of edges in 
    *              the graph and 2E = XADJ(N+1)-1
    *     XADJ   - Index vector for ADJ
    *            - Nodes adjacent to node I are found in ADJ(J), where
    *              J = XADJ(I), XADJ(I)+1, ..., XADJ(I+1)-1
    *            - Degree of node I is XADJ(I+1)-XADJ(I)
    *     MASK   - Masking vector for graph
    *            - Visible nodes have MASK = 0
    *     LS     - Undefined
    *     XLS    - Undefined
    *     DEPTH  - Undefined
    *     WIDTH  - Undefined
    *
    *     OUTPUT:
    *     -------
    *
    *     N      - Unchanged
    *     ROOT   - Unchanged
    *     MAXWID - unchanged
    *     E2     - Unchanged
    *     ADJ    - Unchanged
    *     XADJ   - Unchanged
    *     MASK   - Unchanged
    *     LS     - List containing a rooted level structure
    *            - List of length NC
    *     XLS    - Index vector for LS
    *            - Nodes in level I are found in LS(J), where
    *              J = XLS(I), XLS(I)+1, ..., XLS(I+1)-1
    *            - List of max length NC+1
    *     DEPTH  - Number of levels in rooted level structure
    *     WIDTH  - Width of rooted level structure
    *
    *     NOTE:  If WIDTH ge MAXWID then assembly has been aborted
    *     -----
    *
    *     PROGRAMMER:             Scott Sloan
    *     -----------
    *
    *     LAST MODIFIED:          1 March 1991      Scott Sloan
    *     --------------
    *
    *     COPYRIGHT 1989:         Scott Sloan
    *     ---------------         Department of Civil Engineering
    *                             University of Newcastle
    *                             NSW 2308
    *
    ************************************************************************
          INTEGER I,J,N
          INTEGER E2,NC
          INTEGER NBR
          INTEGER NODE,ROOT
          INTEGER DEPTH,JSTOP,JSTRT,LSTOP,LSTRT,LWDTH,WIDTH
          INTEGER MAXWID
          INTEGER LS(N)
          INTEGER ADJ(E2),XLS(N+1)
          INTEGER MASK(N),XADJ(N+1)
    *
    *     Initialisation
    *
          MASK(ROOT)=1
          LS(1)=ROOT
          NC   =1
          WIDTH=1
          DEPTH=0
          LSTOP=0
          LWDTH=1
       10 IF(LWDTH.GT.0)THEN
    *
    *       LWDTH is the width of the current level
    *       LSTRT points to start of current level
    *       LSTOP points to end of current level
    *       NC counts the nodes in component
    *
            LSTRT=LSTOP+1
            LSTOP=NC
            DEPTH=DEPTH+1
            XLS(DEPTH)=LSTRT
    *
    *       Generate next level by finding all visible neighbours
    *       of nodes in current level
    *
            DO 30 I=LSTRT,LSTOP
              NODE=LS(I)
              JSTRT=XADJ(NODE)
              JSTOP=XADJ(NODE+1)-1
              DO 20 J=JSTRT,JSTOP
                NBR=ADJ(J)
                IF(MASK(NBR).EQ.0)THEN
                  NC=NC+1
                  LS(NC)=NBR
                  MASK(NBR)=1
                END IF
       20     CONTINUE
       30   CONTINUE
    *
    *       Compute width of level just assembled and the width of the
    *       level structure so far
    *
            LWDTH=NC-LSTOP
            WIDTH=MAX(LWDTH,WIDTH)
    *
    *       Abort assembly if level structure is too wide
    *
            IF(WIDTH.GE.MAXWID)GOTO 35
            GOTO 10
          END IF
          XLS(DEPTH+1)=LSTOP+1
    *
    *     Reset MASK=0 for nodes in the level structure
    *
       35 CONTINUE
          DO 40 I=1,NC
            MASK(LS(I))=0
       40 CONTINUE
          END