SUBROUTINE PROFIT(NR, NDSTK, NEW, NDEG, LVLS2, LVLST, LSTPT, PRO 10 * NXTNUM) C SUBROUTINE PROFIT NUMBERS LEVEL BY LEVEL WITH CONSECUTIVE INTEGERS C USING A MODIFIED VERSION OF KING*S ALGORITHM. C NR- ROW DIMENSION OF CONNECTION TABLE. C NDSTK- THE CONNECTION TABLE. C NEW- VECTOR TO STORE THE NEW NUMBERING. C NDEG(I)- THE DEGREE OF NODE I. C LVLS2- THE LEVEL STRUCTURE PRODUCED BY PIKLVL. C LVLS2(I) = J MEANS VERTEX I HAS BEEN C PLACED IN LEVEL J. C LVLST- ON OUTPUT, CONTAINS THE LEVEL STRUCTURE USED. C LVLST(LSTPT(I)),...,LVLST(LSTPT(I+1)-1) ARE C THE VERTICES IN LEVEL I. C LSTPT(I)- ON OUTPUT, INDEX INTO LVLST TO FIRST NODE IN LEVEL I. C LSTPT(I+1) - LSTPT(I) = NUMBER OF NODES IN I*TH LEVEL. C NXTNUM- ON INPUT AND OUTPUT, THE NEXT AVAILABLE NUMBER. C ON IBM 360 OR 370 USE INTEGER * 2 NDSTK. INTEGER NDSTK INTEGER NEW(1), NDEG(1), LVLS2(1), LVLST(1), LSTPT(1) DIMENSION NDSTK(NR,1) C COMMON AREA GRA HOLDS VITAL INFORMATION ABOUT THE GRAPH C N- THE NUMBER OF NODES C IDPTH- THE NUMBER OF LEVELS FOUND BY PIKLVL. C IDEG- MAXIMUM DEGREE OF GRAPH -- COLUMN DIMENSION OF NDSTK. COMMON /GRA/ N, IDPTH, IDEG C IT IS ASSUMED THAT NO LEVEL HAS MORE THAN 100 NODES. COMMON /LVLW/ S2(100), S3(100), Q(100) COMMON /CC/ CONECT(100) INTEGER S2, S3, Q, CONECT, S2SZE, S3SZE, QPTR, CONSZE C SET UP LVLST AND LSTPT FROM LVLS2. NSTPT = 1 DO 20 I=1,IDPTH LSTPT(I) = NSTPT DO 10 J=1,N IF (LVLS2(J).NE.I) GO TO 10 LVLST(NSTPT) = J NSTPT = NSTPT + 1 10 CONTINUE 20 CONTINUE LSTPT(IDPTH+1) = NSTPT C ****************** STEP P0 **************************************** C S2 IS THE FIRST LEVEL. LEVEL = 1 CALL FORMLV(S2, S2SZE, LSTPT, LVLST, LEVEL) C ****************** STEP P1 **************************************** C S3 IS THE LEVEL ADJACENT TO THE LEVEL S2. C Q IS A QUEUE USED TO RETAIN THE ORDER IN WHICH THE ELEMENTS OF S3 C ARE REMOVED. Q EVENTUALLY BECOMES THE NEW S2 AND IS ORDERED C ACCORDING TO KING*S CRITERA. 30 CALL FORMLV(S3, S3SZE, LSTPT, LVLST, LEVEL+1) QPTR = 0 C ****************** STEP P2 **************************************** C FIND THE NODE M IN S2 WHICH IS ADJACENT TO THE FEWEST NODES IN S3. 40 M = MINCON(S2,S2SZE,S3,S3SZE,CONECT,CONSZE,NDSTK,NR,NDEG) C ****************** STEP P3 **************************************** C NUMBER M AND REMOVE IT FROM S2. NEW(M) = NXTNUM NXTNUM = NXTNUM + 1 CALL DELETE(S2, S2SZE, M) IF (CONSZE.LE.0) GO TO 60 C THE ELEMENTS OF CONLST ARE TO BE REMOVED FROM S3 AND PLACED INTO C Q. DO 50 I=1,CONSZE QPTR = QPTR + 1 Q(QPTR) = CONECT(I) CALL DELETE(S3, S3SZE, CONECT(I)) 50 CONTINUE C ****************** STEP P4 **************************************** 60 IF (S2SZE.LE.0) GO TO 80 C ****************** STEP P5 **************************************** IF (S3SZE.GT.0) GO TO 40 C ****************** STEP P6 **************************************** C S3 IS EMPTY, BUT S2 IS NOT. RENUMBER THE NODES WHICH REMAIN IN S2. DO 70 I=1,S2SZE NS2 = S2(I) NEW(NS2) = NXTNUM NXTNUM = NXTNUM + 1 70 CONTINUE GO TO 100 C ****************** STEP P7 **************************************** 80 IF (S3SZE.LE.0) GO TO 100 C S2 IS EMPTY, BUT S3 IS NOT. MOVE S3*S REMAINING NODES INTO Q. DO 90 I=1,S3SZE QPTR = QPTR + 1 Q(QPTR) = S3(I) 90 CONTINUE C ****************** STEP P8 **************************************** 100 LEVEL = LEVEL + 1 IF (LEVEL.GE.IDPTH) GO TO 120 C S2 BECOMES THE OLD Q SINCE BOTH S2 AND S3 ARE EMPTY. DO 110 I=1,QPTR S2(I) = Q(I) 110 CONTINUE S2SZE = QPTR GO TO 30 C ****************** STEP P9 **************************************** C LAST LEVEL IS ORDERED IN Q, SO NUMBER IT BEFORE RETURNING. 120 DO 130 I=1,QPTR IQ = Q(I) NEW(IQ) = NXTNUM NXTNUM = NXTNUM + 1 130 CONTINUE RETURN END FUNCTION MINCON(X, XSZE, Y, YSZE, CONLST, CONSZE, NDSTK, NR, MIN 10 * NDEG) C FUNCTION MINCON RETURNS AS ITS FUNCTIONAL VALUE A VERTEX X(I) SUCH C THAT THE NUMBER OF CONNECTIONS FROM X(I) TO THE SET Y IS A MINIMUM. C THE VERTICES OF Y WHICH ARE ADJACENT TO X(I) ARE PLACED IN C CONLST(1), CONLST(2),...,CONLST(CONSZE). C USE INTEGER * 2 NDSTK ON IBM 360 OR 370. INTEGER NDSTK DIMENSION NDSTK(NR,1) INTEGER X(1), XSZE, Y(1), YSZE, CONLST(1), CONSZE, NDEG(1) C IT IS ASSUMED THAT NO LEVEL HAS MORE THAN 100 VERTICES. INTEGER SMLST(100) CONSZE = YSZE + 1 DO 50 I=1,XSZE LSTSZE = 0 IX = X(I) IROWDG = NDEG(IX) DO 20 J=1,YSZE DO 10 K=1,IROWDG IX = X(I) IF (NDSTK(IX,K).NE.Y(J)) GO TO 10 SMLST(LSTSZE+1) = Y(J) LSTSZE = LSTSZE + 1 IF (LSTSZE.GE.CONSZE) GO TO 50 GO TO 20 10 CONTINUE 20 CONTINUE IF (LSTSZE.GT.0) GO TO 30 C WE HAVE FOUND A VERTEX IN X WHICH IS NOT CONNECTED TO ANY VERTEX C IN Y MINCON = X(I) CONSZE = 0 RETURN C WE HAVE FOUND A VERTEX X(I) WITH FEWEST CONNECTIONS (NONZERO) TO Y C SO FAR. SAVE THE ELEMENTS OF Y WHICH CONNECT TO X(I) IN CONLST AND C SAVE X(I) AS THE FUNCTIONAL VALUE. 30 CONSZE = LSTSZE DO 40 J=1,LSTSZE CONLST(J) = SMLST(J) 40 CONTINUE MINCON = X(I) 50 CONTINUE RETURN END SUBROUTINE DELETE(SET, SETSZE, ELEMNT) DEL 10 C SUBROUTINE DELETE REMOVES ELEMNT FROM THE SET SET IF ELEMNT C IS IN SET. OTHERWISE, IT ISSUES A DIAGNOSTIC. INTEGER SET(1), SETSZE, ELEMNT IF (SETSZE.GT.1) GO TO 10 IF (SETSZE.EQ.1 .AND. SET(1).NE.ELEMNT) GO TO 30 SETSZE = 0 RETURN 10 DO 20 I=1,SETSZE IF (SET(I).EQ.ELEMNT) GO TO 40 20 CONTINUE 30 WRITE (6,99999) ELEMNT, (SET(I),I=1,SETSZE) RETURN 40 SETSZE = SETSZE - 1 DO 50 J=I,SETSZE SET(J) = SET(J+1) 50 CONTINUE RETURN 99999 FORMAT (10H0ERROR -- , I6, 8H NOT IN , (20I5)) END SUBROUTINE FORMLV(SET, SETSZE, LSTPT, LVLST, LEVEL) FOR 10 C FORMLVL COPIES LEVEL(LEVEL) INTO SET. INTEGER SET(1), SETSZE, LSTPT(1), LVLST(1), UPPER LOWER = LSTPT(LEVEL) UPPER = LSTPT(LEVEL+1) - 1 SETSZE = 1 DO 10 I=LOWER,UPPER SET(SETSZE) = LVLST(I) SETSZE = SETSZE + 1 10 CONTINUE SETSZE = SETSZE - 1 RETURN END SUBROUTINE CHECK(BESTBW, BESTPF, RENUM, NDSTK, NR, NDEG, IWK) CHE 10 C SUBROUTINE CHECK TESTS TO SEE IF REVERSED NUMBERING GIVES BETTER C PROFILE THAN PROFIT. IF IT DOES, THEN RENUM IS REVERSED AND BESTPF C IS SET TO THE SMALLEST OF RENUM AND REVERSED RENUM. C USE INTEGER * 2 NDSTK ON IBM 360 OR 370 INTEGER NDSTK DIMENSION NDSTK(NR,1) INTEGER BESTBW, BESTPF, RENUM(1), NDEG(1), IWK(1) COMMON /GRA/ N, IDPTH, IDEG DO 10 I=1,N IWK(I) = N - RENUM(I) + 1 10 CONTINUE CALL BAND(BESTBW, BESTPF, RENUM, NDSTK, NR, NDEG) CALL BAND(IBW, IPF, IWK, NDSTK, NR, NDEG) IF (IPF.GE.BESTPF) RETURN DO 20 I=1,N RENUM(I) = IWK(I) 20 CONTINUE BESTPF = IPF RETURN END SUBROUTINE BAND(IBW, IPF, NEW, NDSTK, NR, NDEG) BAN 10 C SUBROUTINE BAND COMPUTES THE BANDWIDTH IBW AND THE PROFILE C IPF OF THE GRAPH REPRESENTED BY NDSTK USING THE NUMBERING NEW. C ON IBM 360 OR 370 USE INTEGER * 2 NDSTK. INTEGER NDSTK DIMENSION NDSTK(NR,1), NEW(1), NDEG(1) COMMON /GRA/ N, IDPTH, IDEG IPF = 0 IBW = 0 DO 20 K=1,N IEND = NDEG(K) IF (IEND.EQ.0) GO TO 20 NBW = 0 DO 10 J=1,IEND IDUMMY = NDSTK(K,J) NTEST = NEW(K) - NEW(IDUMMY) IF (NTEST.LE.NBW) GO TO 10 NBW = NTEST 10 CONTINUE IPF = IPF + NBW IF (NBW.GT.IBW) IBW = NBW 20 CONTINUE RETURN END