Skip to content
Snippets Groups Projects
number_sloan.f 5.08 KiB
Newer Older
  • Learn to ignore specific revisions
  • Douglas Guptill's avatar
    Douglas Guptill committed
          SUBROUTINE NUMBER_SLOAN(N,NC,SNODE,LSTNUM,E2,ADJ,XADJ,S,Q,P)
    ************************************************************************
    *
    *     PURPOSE:
    *     --------
    *
    *     Number nodes in component of graph for small profile and rms
    *     wavefront
    *
    *     INPUT:
    *     ------
    *
    *     N      - Number of nodes in graph
    *     NC     - Number of nodes in component of graph
    *     SNODE  - Node at which numbering starts
    *     LSTNUM - Count of nodes which have already been numbered
    *     E2     - Twice tne 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
    *     S      - List giving the distance of each node in this
    *              component from the end node
    *     Q      - List of nodes which are in this component
    *            - Also used to store queue of active or preactive nodes
    *     P      - Undefined
    *
    *     OUTPUT:
    *     -------
    *
    *     N      - Unchanged
    *     NC     - Unchanged
    *     SNODE  - Unchanged
    *     LSTNUM - Count of numbered nodes (input value incremented by NC)
    *     E2     - Unchanged
    *     ADJ    - Unchanged
    *     XADJ   - Unchanged
    *     S      - List of new node numbers 
    *            - New number for node I is S(I)
    *     Q      - Not used
    *     P      - Not used
    *
    *     NOTES:
    *     ------
    *
    *     S also serves as a list giving the status of the nodes
    *     during the numbering process:
    *     S(I) gt 0 indicates node I is postactive
    *     S(I) =  0 indicates node I is active 
    *     S(I) = -1 indicates node I is preactive
    *     S(I) = -2 indicates node I is inactive
    *     P is used to hold the priorities for each node
    *
    *     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,NN,W1,W2
          INTEGER NBR
          INTEGER NEXT,NODE,PRTY
          INTEGER JSTOP,JSTRT,ISTOP,ISTRT,NABOR,SNODE
          INTEGER ADDRES,LSTNUM,MAXPRT
          INTEGER P(N),Q(NC),S(N)
          INTEGER ADJ(E2)
          INTEGER XADJ(N+1)
    *
          PARAMETER (W1=1, W2=2)
    *
    *     Initialise priorities and status for each node in this component
    *     Initial priority = W1*DIST - W2*DEGREE     where:
    *     W1     = a positive weight
    *     W2     = a positive weight
    *     DEGREE = initial current degree for node
    *     DIST   = distance of node from end node
    *
          DO 10 I=1,NC
            NODE=Q(I)
            P(NODE)=W1*S(NODE)-W2*(XADJ(NODE+1)-XADJ(NODE)+1)
            S(NODE)=-2
       10 CONTINUE
    *
    *     Insert starting node in queue and assign it a preactive status
    *     NN is the size of queue
    *
          NN=1
          Q(NN)=SNODE
          S(SNODE)=-1
    *
    *     Loop while queue is not empty
    *
       30 IF(NN.GT.0)THEN
    *
    *       Scan queue for node with max priority
    *
            ADDRES=1
            MAXPRT=P(Q(1))
            DO 35 I=2,NN
              PRTY=P(Q(I))
              IF(PRTY.GT.MAXPRT)THEN
                ADDRES=I
                MAXPRT=PRTY
              END IF
       35   CONTINUE
    *
    *       NEXT is the node to be numbered next
    *
            NEXT=Q(ADDRES)
    *
    *       Delete node NEXT from queue
    *       
            Q(ADDRES)=Q(NN)
            NN=NN-1
            ISTRT=XADJ(NEXT)
            ISTOP=XADJ(NEXT+1)-1
            IF(S(NEXT).EQ.-1)THEN
    *
    *         Node NEXT is preactive, examine its neighbours
    *
              DO 50 I=ISTRT,ISTOP
    *
    *           Decrease current degree of neighbour by -1
    *
                NBR=ADJ(I)
                P(NBR)=P(NBR)+W2
    *
    *           Add neighbour to queue if it is inactive
    *           assign it a preactive status
    *
                IF(S(NBR).EQ.-2)THEN
                  NN=NN+1
                  Q(NN)=NBR
                  S(NBR)=-1
                END IF
       50     CONTINUE
            END IF
    *
    *       Store new node number for node NEXT
    *       Status for node NEXT is now postactive
    *
            LSTNUM=LSTNUM+1
            S(NEXT)=LSTNUM
    *
    *       Search for preactive neighbours of node NEXT
    *
            DO 80 I=ISTRT,ISTOP
              NBR=ADJ(I)
              IF(S(NBR).EQ.-1)THEN
    *
    *           Decrease current degree of preactive neighbour by -1
    *           assign neighbour an active status
    *
                P(NBR)=P(NBR)+W2
                S(NBR)=0
    *
    *           Loop over nodes adjacent to preactive neighbour
    *
                JSTRT=XADJ(NBR)
                JSTOP=XADJ(NBR+1)-1
                DO 60 J=JSTRT,JSTOP
                  NABOR=ADJ(J)
    *
    *             Decrease current degree of adjacent node by -1
    *
                  P(NABOR)=P(NABOR)+W2
                  IF(S(NABOR).EQ.-2)THEN
    *
    *               Insert inactive node in queue with a preactive status
    *
                    NN=NN+1
                    Q(NN)=NABOR
                    S(NABOR)=-1
                   END IF
       60       CONTINUE
              END IF
       80   CONTINUE
            GOTO 30
          END IF
          END