      SUBROUTINE NUMBAR(SND,NUM,NDSTK,LVLS2,NDEG,RENUM,LVLST,LSTPT,NR,  MOD04653
     1NFLG,IBW2,IPF2,IPFA,ISDIR,STKA,STKB,STKC,STKD,IDIM)               MOD04654
      INTEGER NDSTK,LVLS2,NDEG,RENUM,LVLST,LSTPT,IPFA,STKA,STKB,        MOD04655
     1STKC,STKD                                                         MOD04656
      INTEGER SND,XA,XB,XC,XD,CX,END                                    MOD04657
      INTEGER TEST                                                      MOD04658
      COMMON/UNIT/II11,II22                                             MOD04659
      DIMENSION STKA(1),STKB(1),STKC(1),STKD(1)                         MOD04660
      COMMON /A/ MAXGRD,MAXDEG,N,IDPTH,IDEG                             MOD04661
      COMMON /PREP/XDZ(2),KSKIP                                         MOD04662
      COMMON /BITS/NBITIN                                               MOD04663
      DIMENSION IPFA(1)                                                 MOD04664
      DIMENSION NDSTK(NR,1),LVLS2(1),NDEG(1),RENUM(1),LVLST(1),LSTPT(1) MOD04665
      DO 3 I=1,N                                                        MOD04666
      IPFA(I)=0                                                         MOD04667
3     CONTINUE                                                          MOD04668
      NSTPT=1                                                           MOD04669
      DO 5 I=1,IDPTH                                                    MOD04670
      LSTPT(I)=NSTPT                                                    MOD04671
      DO 5 J=1,N                                                        MOD04672
      IF(LVLS2(J).NE.I) GO TO 5                                         MOD04673
      LVLST(NSTPT)=J                                                    MOD04674
      NSTPT=NSTPT+1                                                     MOD04675
5     CONTINUE                                                          MOD04676
      LSTPT(IDPTH+1)=NSTPT                                              MOD04677
      LVLN=0                                                            MOD04678
      IF(NFLG.LT.0) LVLN=IDPTH+1                                        MOD04679
      XC=1                                                              MOD04680
      STKC(XC)=SND                                                      MOD04681
10    CX=1                                                              MOD04682
      XD=0                                                              MOD04683
      LVLN=LVLN+NFLG                                                    MOD04684
      LST=LSTPT(LVLN)                                                   MOD04685
      LND=LSTPT(LVLN+1)-1                                               MOD04686
20    IPRO=STKC(CX)                                                     MOD04687
      RENUM(IPRO)=NUM                                                   MOD04688
      NUM=NUM+ISDIR                                                     MOD04689
      END=NDEG(IPRO)                                                    MOD04690
      XA=0                                                              MOD04691
      XB=0                                                              MOD04692
      DO 50 I=1,END                                                     MOD04693
      TEST=NDSTK(IPRO,I)                                                MOD04694
      INX=RENUM(TEST)                                                   MOD04695
      IF(INX.EQ.0) GO TO 30                                             MOD04696
      IF(INX.LT.0) GO TO 50                                             MOD04697
      NBW=(RENUM(IPRO)-INX)*ISDIR                                       MOD04698
      IF(ISDIR.GT.0) INX=RENUM(IPRO)                                    MOD04699
      IF(IPFA(INX).LT.NBW) IPFA(INX)=NBW                                MOD04700
      GO TO 50                                                          MOD04701
30    RENUM(TEST)=-1                                                    MOD04702
      IF(LVLS2(TEST).EQ.LVLS2(IPRO)) GO TO 40                           MOD04703
      XB=XB+1                                                           MOD04704
      NDXL=XB                                                           MOD04705
      IF(XB.GT.IDIM) GO TO 150                                          MOD04706
      STKB(XB)=TEST                                                     MOD04707
      GO TO 50                                                          MOD04708
40    XA=XA+1                                                           MOD04709
      NDXL=XA                                                           MOD04710
      IF(XA.GT.IDIM) GO TO 150                                          MOD04711
      STKA(XA)=TEST                                                     MOD04712
50    CONTINUE                                                          MOD04713
      IF(XA.EQ.0) GO TO 55                                              MOD04714
      IF(XA.EQ.1) GO TO 52                                              MOD04715
      CALL SORTDG(STKC,STKA,XC,XA,NDEG)                                 MOD04716
      GO TO 55                                                          MOD04717
52    XC=XC+1                                                           MOD04718
      NDXL=XC                                                           MOD04719
      IF(XC.GT.IDIM) GO TO 150                                          MOD04720
      STKC(XC)=STKA(XA)                                                 MOD04721
55    IF(XB.EQ.0) GO TO 65                                              MOD04722
      IF(XB.EQ.1) GO TO 62                                              MOD04723
      CALL SORTDG(STKD,STKB,XD,XB,NDEG)                                 MOD04724
      GO TO 65                                                          MOD04725
62    XD=XD+1                                                           MOD04726
      NDXL=XD                                                           MOD04727
      IF(XD.GT.IDIM) GO TO 150                                          MOD04728
      STKD(XD)=STKB(XB)                                                 MOD04729
65    CX=CX+1                                                           MOD04730
      IF(XC.GE.CX) GO TO 20                                             MOD04731
      MAX=IDEG+1                                                        MOD04732
      SND=N+1                                                           MOD04733
      DO 70 I=LST,LND                                                   MOD04734
      TEST=LVLST(I)                                                     MOD04735
      IF(RENUM(TEST).NE.0) GO TO 70                                     MOD04736
      IF(NDEG(TEST).GE.MAX) GO TO 70                                    MOD04737
      RENUM(SND)=0                                                      MOD04738
      RENUM(TEST)=-1                                                    MOD04739
      MAX=NDEG(TEST)                                                    MOD04740
      SND=TEST                                                          MOD04741
70    CONTINUE                                                          MOD04742
      IF(SND.EQ.N+1) GO TO 75                                           MOD04743
      XC=XC+1                                                           MOD04744
      NDXL=XC                                                           MOD04745
      IF(XC.GT.IDIM) GO TO 150                                          MOD04746
      STKC(XC)=SND                                                      MOD04747
      GO TO 20                                                          MOD04748
75    IF(XD.EQ.0) GO TO 100                                             MOD04749
      DO 80 I=1,XD                                                      MOD04750
      STKC(I)=STKD(I)                                                   MOD04751
80    CONTINUE                                                          MOD04752
      XC=XD                                                             MOD04753
      GO TO 10                                                          MOD04754
100   DO 120 I=1,N                                                      MOD04755
      IF(IPFA(I).GT.IBW2) IBW2=IPFA(I)                                  MOD04756
      IPF2=IPF2+IPFA(I)                                                 MOD04757
120   CONTINUE                                                          MOD04758
      RETURN                                                            MOD04759
150   NDXL=4*IDIM                                                       MOD04760
      WRITE(II22,90)NDXL                                                MOD04761
90    FORMAT(//20X,31HAN INTERNAL DEFAULT DIMENSION (,I4,12H) IS SMALLERMOD04762
     $/20X,46HTHAN YOUR PROBLEM REQUIRES. THE VALUE IS BEING,           MOD04763
     $/20X,41HINTERNALLY INCREASED AND THE RESEQUENCING,                MOD04764
     $/20X,14H IS CONTINUED.//)                                         MOD04765
      KSKIP=10                                                          MOD04766
      RETURN                                                            MOD04767
      END                                                               MOD04768
      SUBROUTINE FNDIAM(SND1,SND2,NDSTK,NR,NDEG,LVL,LVLS1,LVLS2,        MOD02839
     1IWK,IDFLT,NDLST,IDIM)                                             MOD02840
      INTEGER FLAG,SND,SND1,SND2                                        MOD02841
      COMMON /A/ MAXGRD,MAXDEG,N,IDPTH,IDEG                             MOD02842
      COMMON /PREP/XDZ(2),KSKIP                                         MOD02843
      COMMON/UNIT/II11,II22                                             MOD02844
      DIMENSION NDSTK(NR,1),NDEG(1),LVL(1),LVLS1(1),LVLS2(1),IWK(1)     MOD02845
      DIMENSION  NDLST(IDIM)                                            MOD02846
      FLAG=0                                                            MOD02847
      MTW2=N                                                            MOD02848
      SND=SND1                                                          MOD02849
20    DO 25 I=1,N                                                       MOD02850
      LVL(I)=0                                                          MOD02851
25    CONTINUE                                                          MOD02852
      LVLN=1                                                            MOD02853
      CALL TREE(SND,NDSTK,NR,LVL,IWK,NDEG,LVLWTH,LVLBOT,LVLN,MAXLW,MTW2)MOD02854
      IF(FLAG.GE.1) GO TO 110                                           MOD02855
      FLAG=1                                                            MOD02856
70    IDPTH=LVLN-1                                                      MOD02857
      MTW1=MAXLW                                                        MOD02858
      DO 75 I=1,N                                                       MOD02859
      LVLS1(I)=LVL(I)                                                   MOD02860
75    CONTINUE                                                          MOD02861
      NDXN=1                                                            MOD02862
      NDXL=0                                                            MOD02863
      MTW2=N                                                            MOD02864
      CALL SORTDG(NDLST,IWK(LVLBOT),NDXL,LVLWTH,NDEG)                   MOD02865
      IF(NDXL.LE.IDIM) GO TO 100                                        MOD02866
      NDXL=4*IDIM                                                       MOD02867
      WRITE(II22,90)NDXL                                                MOD02868
90    FORMAT(//20X,31HAN INTERNAL DEFAULT DIMENSION (,I4,12H) IS SMALLERMOD02869
     $/20X,50HTHAN YOUR PROBLEM REQUIRES. INCREASE IT BY PUTTING        MOD02870
     $/20X,48HA LARGER NO. IN COL. 21-25 OF THE RENUMBER CARD.          MOD02871
     $/20X,19HEXECUTION WILL END.//)                                    MOD02872
      KSKIP=1                                                           MOD02873
      RETURN                                                            MOD02874
100   CONTINUE                                                          MOD02875
      SND=NDLST(1)                                                      MOD02876
      GO TO 20                                                          MOD02877
110   IF(IDPTH.GE.LVLN-1) GO TO 120                                     MOD02878
      SND1=SND                                                          MOD02879
      GO TO 70                                                          MOD02880
120   IF(MAXLW.GE.MTW2) GO TO 130                                       MOD02881
      MTW2=MAXLW                                                        MOD02882
      SND2=SND                                                          MOD02883
      DO 125 I=1,N                                                      MOD02884
      LVLS2(I)=LVL(I)                                                   MOD02885
125   CONTINUE                                                          MOD02886
130   IF(NDXN.EQ.NDXL) GO TO 140                                        MOD02887
      NDXN=NDXN+1                                                       MOD02888
      SND=NDLST(NDXN)                                                   MOD02889
      GO TO 20                                                          MOD02890
140   IDFLT=1                                                           MOD02891
      IF(MTW2.LE.MTW1) IDFLT=2                                          MOD02892
      RETURN                                                            MOD02893
      END                                                               MOD02894
      SUBROUTINE SCHEME (IG,II1,NN,IP,ILD,IC,IDEG,IDIS,IW,NEW,ICC,IPP,  MOD06303
     $MM,M2,KT)                                                         MOD06304
      COMMON/UNIT/II11,II22,IPPP,INPPP,INPFFF,ITER                      MOD06305
      DIMENSION IG(II1,1),IC(II1),IDEG(II1),IDIS(II1),IW(II1),          MOD06306
     $NEW(II1),ICC(II1),IPP(M2),ILD(II1)                                MOD06307
      COMMON /BAND/  NRNM(3)                                            MOD06308
      COMMON /TRASH/ ISTART(100)                                        MOD06309
      DIMENSION NODESL(100)                                             MOD06310
      NSTN=NRNM(3)                                                      MOD06311
      LINE=60                                                           MOD06312
      ISTA=0                                                            MOD06313
      NT=80                                                             MOD06314
      NUM=1                                                             MOD06315
      NOM=2                                                             MOD06316
      IO=2                                                              MOD06317
      CALL DEGREE(IG,II1,IDEG,NN,MM)                                    MOD06318
      NCM=COMPNT(IG,II1,IC,IDEG,IW,ICC,NN)                              MOD06319
50    FORMAT(//20X,47H--WARNING-- MODEL HAS A UNCONNECTED STRUCTURE^  ) MOD06320
      MAXD=MAXDGR(0,IC,IDEG,NN)                                         MOD06321
      MM=MAXD                                                           MOD06322
      DO 100 I=1,NN                                                     MOD06323
      NEW(I)=I                                                          MOD06324
100   ILD(I)=I                                                          MOD06325
      IS=MAXBND(0,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                         MOD06326
      KORIG=IS                                                          MOD06327
      IH0=IH                                                            MOD06328
      DO 110 I=1,NN                                                     MOD06329
      NEW(I)=0                                                          MOD06330
110   ILD(I)=0                                                          MOD06331
      CALL DIST(IDEG,IPP,IP,MEDIAN,MODD,NN,MM)                          MOD06332
      IF(IP.EQ.0) GO TO 200                                             MOD06333
      DO 150 I=1,NN                                                     MOD06334
      IF(MOD(I,LINE).EQ.1)WRITE(II22,120)                               MOD06335
120   FORMAT(37H1LABEL  COMP MDIST  DEGR  CONNECTIONS ,10X,             MOD06336
     $18H(INTERNAL NUMBERS) )                                           MOD06337
      MDIST=0                                                           MOD06338
      DO 130 J=1,MAXD                                                   MOD06339
      IS1 = IG(I,J)                                                     MOD06340
      IF(IS1.EQ.0)GO TO 130                                             MOD06341
      MDIST=MAX0(MDIST,IABS(I-IS1))                                     MOD06342
130   CONTINUE                                                          MOD06343
      IPP(1)=IC(I)                                                      MOD06344
      IPP(2)=IDEG(I)                                                    MOD06345
      DO 140 IP1=1,MAXD                                                 MOD06346
140   IPP (IP1+2) = IG(I,IP1)                                           MOD06347
      IS1=MAXD+2                                                        MOD06348
150   WRITE(II22,160)I,IPP(1),MDIST,(IPP(J),J=2,IS1)                    MOD06349
160   FORMAT(5I6,20I5/ 25(25X,21I5/))                                   MOD06350
      WRITE(II22,170)                                                   MOD06351
170   FORMAT(1H1,//,32X,31HPROGRAMMER INFORMATION MESSAGES /)           MOD06352
      WRITE(II22,180) IS,IH                                             MOD06353
180   FORMAT(19H ORIGINAL BANDWIDTH,I7,10H   PROFILE,I10)               MOD06354
      WRITE(II22,190) MODD                                              MOD06355
190   FORMAT(30H MODE OF DEGREE DISTRIBUTION =,I5)                      MOD06356
200   CONTINUE                                                          MOD06357
      IF(IO.EQ.3) IS=IH                                                 MOD06358
      DO 350 NC=1,NCM                                                   MOD06359
      MI=MINDEG(NC,IC,IDEG,NN)                                          MOD06360
      MAD=MI                                                            MOD06361
      IF(NOM) 210,220,210                                               MOD06362
210   MA=MAXDGR(NC,IC,IDEG,NN)                                          MOD06363
      MAD=MI+((MA-MI)*NUM)/NOM                                          MOD06364
      MAD=MIN0(MAD,MEDIAN-1)                                            MOD06365
      MAD=MAX0(MAD,MI)                                                  MOD06366
220   IF(IP.EQ.0) GO TO 260                                             MOD06367
      WRITE(II22,230) NC                                                MOD06368
230   FORMAT(22H *******     COMPONENT,I5,12H     *******)              MOD06369
      IF(IO.EQ.2) WRITE(II22,240)                                       MOD06370
240   FORMAT(43H OPTION 2 SELECTED  (CRITERION - BANDWIDTH ,            MOD06371
     $57HMINIMIZATION|   CONDITION - MINMAX NUMBER OF NODES/LEVEL) )    MOD06372
      IF(IO.EQ.3) WRITE(II22,250)                                       MOD06373
250   FORMAT(52H OPTION 3 SELECTED (CRITERION - MINIMIZATION OF SUM|,   MOD06374
     $44H   CONDITION - MINMAX NUMBER OF NODES/LEVEL) )                 MOD06375
260   CALL DIAM(NC,MAD,NL,NODESL,MAXLEV,IG,II1,IC,IDEG,IDIS,IW,ICC,NN)  MOD06376
      IF(NSTN.GT.0.AND.NC.EQ.1) READ(ITER,261)(ISTART(J),J=1,NSTN)      MOD06377
261   FORMAT(16I5)                                                      MOD06378
      IF(NSTN.LE.0)GO TO 269                                            MOD06379
      MF=0                                                              MOD06380
      DO 267 I=1,NSTN                                                   MOD06381
      J=ISTART(I)                                                       MOD06382
      IF(IC(J).NE.NC) GO TO 267                                         MOD06383
      MF=MF+1                                                           MOD06384
      NODESL(MF)=J                                                      MOD06385
267   CONTINUE                                                          MOD06386
      IF(MF.GT.0) NL=MF                                                 MOD06387
      NL=MIN0(NL  ,100)                                                 MOD06388
      CALL FIXIT(NODESL,NL)                                             MOD06389
269   CONTINUE                                                          MOD06390
      IF(IP.EQ.0) GO TO 270                                             MOD06391
      WRITE(II22,280) NC,MAD                                            MOD06392
      WRITE(II22,290) MAXLEV                                            MOD06393
      WRITE(II22,300) (NODESL(J),J=1,NL)                                MOD06394
270   CONTINUE                                                          MOD06395
280   FORMAT(10H COMPONENT,I5,19H    MAX DEGREE USED,I5)                MOD06396
290   FORMAT(52H STARTING NODES FOR MINMAX NUMBER OF NODES PER LEVEL,I5)MOD06397
300   FORMAT(4X,20I5)                                                   MOD06398
      JMAX=MIN0(NT,NL)                                                  MOD06399
      IM=900000000                                                      MOD06400
      IMM=IM                                                            MOD06401
      M=1                                                               MOD06402
      IF(NSTN.GT.0.AND.MF.GT.0)  M=NL                                   MOD06403
      IF(NSTN.GT.0.AND.MF.GT.0) JMAX=1                                  MOD06404
      DO 340 J=1,JMAX                                                   MOD06405
      CALL RELABL(M,NODESL(J ),IG,II1,IC,IDEG,IDIS,IW,NEW,ICC,ILD,NN)   MOD06406
      IB=MAXBND(NC,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                        MOD06407
      IF(IP.NE.0) WRITE(II22,310) NODESL(J),IB,IH                       MOD06408
310   FORMAT(14H STARTING NODE,I6,4X,9HBANDWIDTH,I6,3X,7HPROFILE,I8)    MOD06409
      IF(IO.EQ.3) IB=IH                                                 MOD06410
      IE=ICC(NC+1)-1                                                    MOD06411
      IF(IM-IB) 340,330,320                                             MOD06412
320   IM=IB                                                             MOD06413
      IMM=IH                                                            MOD06414
      IJ=J                                                              MOD06415
      GO TO 340                                                         MOD06416
330   IF(IMM.LE.IH) GO TO 340                                           MOD06417
      IMM=IH                                                            MOD06418
      IJ=J                                                              MOD06419
340   CONTINUE                                                          MOD06420
      IF(NSTN.GT.0.AND.MF.GT.0) GO TO 350                               MOD06421
      CALL RELABL(1,NODESL(IJ),IG,II1,IC,IDEG,IDIS,IW,NEW,ICC,ILD,NN)   MOD06422
350   CONTINUE                                                          MOD06423
      CALL STACK(IDEG,NEW,ILD,IW,NN,KT)                                 MOD06424
      IB=MAXBND(0,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                         MOD06425
      WRITE(II22,360)                                                   MOD06426
360   FORMAT(21H0 ORIGINAL LABELING -)                                  MOD06427
      WRITE (6,380)  KORIG                                              MOD06428
      WRITE(II22,370)                                                   MOD06429
370   FORMAT(21H  STD CM RELABELING -)                                  MOD06430
      WRITE (6,380)  IB                                                 MOD06431
380   FORMAT (1H+,26X,9HBANDWIDTH,I7)                                   MOD06432
390   FORMAT(21H  REV CM RELABELING -)                                  MOD06433
400   IF(IO.EQ.3) IB=IH                                                 MOD06434
      IF(IB-IS) 450,410,420                                             MOD06435
410   IF(IH.LT.IH0) GO TO 450                                           MOD06436
420   DO 430 I=1,NN                                                     MOD06437
      ILD(I)=I                                                          MOD06438
430   NEW(I)=I                                                          MOD06439
      CALL STACK(IDEG,NEW,ILD,IW,NN,KT)                                 MOD06440
      IB=IS                                                             MOD06441
      IH=IH0                                                            MOD06442
      WRITE(II22,440)                                                   MOD06443
440   FORMAT(21H ORIG CM RELABELING -)                                  MOD06444
      WRITE (6,380)  IB                                                 MOD06445
450   IHE=IH                                                            MOD06446
      CALL REVERS(NEW,ILD,NN,KT)                                        MOD06447
      IB=MAXBND(0,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                         MOD06448
      WRITE(II22,390)                                                   MOD06449
      WRITE (6,380)  IB                                                 MOD06450
460   IF(IH.LT.IHE) GO TO 470                                           MOD06451
      CALL REVERS(NEW,ILD,NN,KT)                                        MOD06452
      IB=MAXBND(0,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                         MOD06453
470   IHE=IH                                                            MOD06454
      KNEW=IB                                                           MOD06455
      WRITE(II22,480)                                                   MOD06456
480   FORMAT(21H  ** FINAL LABELING -)                                  MOD06457
      WRITE (6,380)  KNEW                                               MOD06458
490   CONTINUE                                                          MOD06459
500   IF((NCM-KT).GT.1) WRITE(II22,50)                                  MOD06460
      RETURN                                                            MOD06461
      END                                                               MOD06462
      SUBROUTINE DEGREE(IG,II1,IDEG,NN,MM)                              MOD01257
      DIMENSION IG(II1,1),IDEG(1)                                       MOD01258
      DO 120 I=1,NN                                                     MOD01259
      IDEG(I)=0                                                         MOD01260
      DO 110 J=1,MM                                                     MOD01261
      IF(IG(I,J)) 120,120,100                                           MOD01262
100   IDEG(I)=IDEG(I)+1                                                 MOD01263
110   CONTINUE                                                          MOD01264
120   CONTINUE                                                          MOD01265
      RETURN                                                            MOD01266
      END                                                               MOD01267
      SUBROUTINE DIST(IDEG,HIST,IP,MEDIAN,MODD,NN,MM)                   MOD01966
      COMMON/UNIT/II11,II22                                             MOD01967
      DIMENSION IDEG(1),HIST(1)                                         MOD01968
      INTEGER HIST,IDEG                                                 MOD01969
      MM1=MM+1                                                          MOD01970
      DO 100 I=1,MM1                                                    MOD01971
100   HIST(I)=0                                                         MOD01972
      DO 110 I=1,NN                                                     MOD01973
      K=IDEG(I)+1                                                       MOD01974
110   HIST(K)=HIST(K)+1                                                 MOD01975
      MODD=0                                                            MOD01976
      MAX=0                                                             MOD01977
      DO 120 I=1,MM1                                                    MOD01978
      K=HIST(I)                                                         MOD01979
      IF(K.LE.MAX) GO TO 120                                            MOD01980
      MAX=K                                                             MOD01981
      MODD=I-1                                                          MOD01982
120   CONTINUE                                                          MOD01983
      IF(IP.EQ.0) GO TO 160                                             MOD01984
      WRITE(II22,130)                                                   MOD01985
130   FORMAT(26H1NODAL DEGREE HISTOGRAM --//10X,                        MOD01986
     $26HDEGREE  NUMBER  CUM. TOTAL)                                    MOD01987
      ISUM=0                                                            MOD01988
      DO 140 I=1,MM1                                                    MOD01989
      ISUM=ISUM+HIST(I)                                                 MOD01990
      K=I-1                                                             MOD01991
140   WRITE(II22,150) K,HIST(I),ISUM                                    MOD01992
150   FORMAT(8X,2I8,I12)                                                MOD01993
160   DO 170 I=2,MM1                                                    MOD01994
170   HIST(I)=HIST(I)+HIST(I-1)                                         MOD01995
      NN2=NN/2                                                          MOD01996
                                                                        MOD01997
      DO 180 I=1,MM1                                                    MOD01998
      IF(HIST(I).GT.NN2) GO TO 190                                      MOD01999
180   CONTINUE                                                          MOD02000
190   MEDIAN=I-1                                                        MOD02001
      IF(IP.NE.0) WRITE(II22,200) MEDIAN,MODD                           MOD02002
200   FORMAT(/10X,6HMEDIAN,I6/10X,6H  MODE,I6)                          MOD02003
      RETURN                                                            MOD02004
      END                                                               MOD02005
      SUBROUTINE DIAM(NC,MAXDEG,NL,NODESL,MAXLEV,                       MOD01296
     $IG,II1,IC,IDEG,IDIS,IW,ICC,NN)                                    MOD01297
      DIMENSION IG(II1,1),IDIS(1),IW(1),ICC(1),IC(1),IDEG(1)            MOD01298
      DIMENSION NODESL(1)                                               MOD01299
      NL=0                                                              MOD01300
      MAXLEV=10000                                                      MOD01301
      DO 150 I=1,NN                                                     MOD01302
      IF(NC-IC(I)) 150,100,150                                          MOD01303
100   IF(MAXDEG-IDEG(I)) 150,110,110                                    MOD01304
110   MD=IDIST(I,ML,MAXLEV,IG,II1,IC,IDEG,IDIS,IW,ICC,NN)               MOD01305
      IF(MD) 170,170,120                                                MOD01306
120   IF(ML-MAXLEV)130,140,150                                          MOD01307
130   MAXLEV=ML                                                         MOD01308
      NL=1                                                              MOD01309
      NODESL(1)=I                                                       MOD01310
      GO TO 150                                                         MOD01311
140   IF(NL.GE.100) GO TO 150                                           MOD01312
      NL=NL+1                                                           MOD01313
      NODESL(NL)=I                                                      MOD01314
150   CONTINUE                                                          MOD01315
160   RETURN                                                            MOD01316
170   ML=1                                                              MOD01317
      NODESL(1)=I                                                       MOD01318
      MAXLEV=0                                                          MOD01319
      RETURN                                                            MOD01320
      END                                                               MOD01321
      SUBROUTINE FIXIT(LIST,NL)                                         MOD02616
      DIMENSION LIST(1)                                                 MOD02617
      IF(NL.LE.0) RETURN                                                MOD02618
      IF(NL.EQ.1) GO TO 180                                             MOD02619
      NL1=NL-1                                                          MOD02620
      DO 110 I=1,NL1                                                    MOD02621
      IF(LIST(I).EQ.0) GO TO 110                                        MOD02622
      I1=I+1                                                            MOD02623
      DO 100 J=I1,NL                                                    MOD02624
      IF(LIST(I).NE.LIST(J)) GO TO 100                                  MOD02625
      LIST(I)=0                                                         MOD02626
      GO TO 110                                                         MOD02627
100   CONTINUE                                                          MOD02628
110   CONTINUE                                                          MOD02629
      DO 140 I=1,NL1                                                    MOD02630
      K=0                                                               MOD02631
120   IF(LIST(I).NE.0) GO TO 140                                        MOD02632
      K=K+1                                                             MOD02633
      DO 130 J=I,NL1                                                    MOD02634
130   LIST(J)=LIST(J+1)                                                 MOD02635
      LIST(NL)=0                                                        MOD02636
      IF(K.GE.(NL-I+1)) GO TO 150                                       MOD02637
      GO TO 120                                                         MOD02638
140   CONTINUE                                                          MOD02639
150   DO 160 I=1,NL                                                     MOD02640
      J=NL-I+1                                                          MOD02641
      IF(LIST(J).NE.0) GO TO 170                                        MOD02642
160   CONTINUE                                                          MOD02643
170   NL=NL-I+1                                                         MOD02644
      RETURN                                                            MOD02645
180   IF(LIST(1).EQ.0) NL=0                                             MOD02646
      RETURN                                                            MOD02647
      END                                                               MOD02648
      SUBROUTINE RELABL(NS,NODES,IG,II1,IC,IDEG,IDIS,IW,NEW,ICC,ILD,NN) MOD05569
      DIMENSION IG(II1,1),IC(1),IDEG(1),IDIS(1),IW(1),NEW(1),ICC(1)     MOD05570
      DIMENSION ILD(1)                                                  MOD05571
      INTEGER X                                                         MOD05572
      DIMENSION NODES( 1),IAJ(50)                                       MOD05573
      I=NODES(1)                                                        MOD05574
      ICN=IC(I)                                                         MOD05575
      NT=ICC(ICN)-1                                                     MOD05576
      DO 110 I=1,NN                                                     MOD05577
      IF(IC(I)-ICN) 110,100,110                                         MOD05578
100   IDIS(I)=0                                                         MOD05579
110   CONTINUE                                                          MOD05580
      DO 120 J=1,NS                                                     MOD05581
      JJ=NODES(J)                                                       MOD05582
      IDIS(JJ)=-1                                                       MOD05583
      JT=J+NT                                                           MOD05584
      NEW(JT)=JJ                                                        MOD05585
120   ILD(JJ)=JT                                                        MOD05586
      KI=NT                                                             MOD05587
      KO=NS+NT                                                          MOD05588
      LL=KO                                                             MOD05589
      L=1                                                               MOD05590
      J=KO                                                              MOD05591
      NNC=ICC(ICN+1)-1                                                  MOD05592
130   KI=KI+1                                                           MOD05593
      IF(KI-LL)150,140,150                                              MOD05594
140   L=L+1                                                             MOD05595
      LL=KO+1                                                           MOD05596
150   II=NEW(KI)                                                        MOD05597
      N=IDEG(II)                                                        MOD05598
      IF(N)160,280,160                                                  MOD05599
160   IJ=0                                                              MOD05600
      DO 180 I=1,N                                                      MOD05601
      IA = IG(II,I)                                                     MOD05602
      IF(IDIS(IA)) 180,170,180                                          MOD05603
170   IJ=IJ+1                                                           MOD05604
      IDIS(IA)=L                                                        MOD05605
      KO=KO+1                                                           MOD05606
      IAJ(IJ)=IA                                                        MOD05607
      IW(IJ)=IDEG(IA)                                                   MOD05608
180   CONTINUE                                                          MOD05609
      IF(IJ-1)270,190,200                                               MOD05610
190   J=KO                                                              MOD05611
      IZ=IAJ(1)                                                         MOD05612
      NEW(KO)=IZ                                                        MOD05613
      ILD(IZ)=KO                                                        MOD05614
      GO TO 270                                                         MOD05615
200   X=0                                                               MOD05616
210   DO 240 I=2,IJ                                                     MOD05617
      IF(IW(I)-IW(I-1))220,240,240                                      MOD05618
220   CONTINUE                                                          MOD05619
      X=IW(I)                                                           MOD05620
      IW(I)=IW(I-1)                                                     MOD05621
      IW(I-1)=X                                                         MOD05622
230   X=IAJ(I)                                                          MOD05623
      IAJ(I)=IAJ(I-1)                                                   MOD05624
      IAJ(I-1)=X                                                        MOD05625
240   CONTINUE                                                          MOD05626
      IF(X)250,250,200                                                  MOD05627
250   DO 260 I=1,IJ                                                     MOD05628
      J=J+1                                                             MOD05629
      IZ=IAJ(I)                                                         MOD05630
      NEW(J)=IZ                                                         MOD05631
      ILD(IZ)=J                                                         MOD05632
260   CONTINUE                                                          MOD05633
270   IF(KO-NNC)130,280,280                                             MOD05634
280   CONTINUE                                                          MOD05635
      RETURN                                                            MOD05636
      END                                                               MOD05637
      SUBROUTINE STACK(IDEG,NEW,ILD,IW,NN,KT)                           MOD06842
      INTEGER  IDEG,IW,NEW                                              MOD06843
      INTEGER ILD                                                       MOD06844
      DIMENSION IDEG(1),NEW(1),ILD(1),IW(1)                             MOD06845
      KT=0                                                              MOD06846
      NN1=NN-1                                                          MOD06847
      DO 100 I=1,NN                                                     MOD06848
      IF(IDEG(I).GT.0) GO TO 100                                        MOD06849
      KT=KT+1                                                           MOD06850
      IW(KT)=ILD(I)                                                     MOD06851
100   CONTINUE                                                          MOD06852
      IF(KT.LE.0) GO TO 140                                             MOD06853
      CALL SORT(IW,KT)                                                  MOD06854
      DO 130 L=1,KT                                                     MOD06855
      I=IW(L)-L+1                                                       MOD06856
      K=NEW(I)                                                          MOD06857
      IF(I.GE.NN) GO TO 120                                             MOD06858
      DO 110 J=I,NN1                                                    MOD06859
110   NEW(J)=NEW(J+1)                                                   MOD06860
120   NEW(NN)=K                                                         MOD06861
130   CONTINUE                                                          MOD06862
140   DO 150 I=1,NN                                                     MOD06863
      K=NEW(I)                                                          MOD06864
150   ILD(K)=I                                                          MOD06865
      RETURN                                                            MOD06866
      END                                                               MOD06867
      SUBROUTINE SORT(LIST,NL)                                          MOD06641
      DIMENSION LIST(1)                                                 MOD06642
      IF(NL.LE.1) RETURN                                                MOD06643
      NL1=NL-1                                                          MOD06644
      DO 110 I=1,NL1                                                    MOD06645
      K=NL-I                                                            MOD06646
      KFLAG=0                                                           MOD06647
      DO 100 J=1,K                                                      MOD06648
      IF(LIST(J).LE.LIST(J+1)) GO TO 100                                MOD06649
      KFLAG=1                                                           MOD06650
      L=LIST(J)                                                         MOD06651
      LIST(J)=LIST(J+1)                                                 MOD06652
      LIST(J+1)=L                                                       MOD06653
100   CONTINUE                                                          MOD06654
      IF(KFLAG.EQ.0) RETURN                                             MOD06655
110   CONTINUE                                                          MOD06656
      RETURN                                                            MOD06657
      END                                                               MOD06658
      INTEGER FUNCTION SORT2(XC,SIZE,STPT)                              MOD06659
      INTEGER SIZE,STPT                                                 MOD06660
      INTEGER TEMP,XC                                                   MOD06661
      DIMENSION SIZE(1),STPT(1)                                         MOD06662
      SORT2=0                                                           MOD06663
      IF(XC.EQ.0) RETURN                                                MOD06664
      SORT2=1                                                           MOD06665
      IND=XC                                                            MOD06666
10    ITEST=0                                                           MOD06667
      IND=IND-1                                                         MOD06668
      IF(IND.LT.1) RETURN                                               MOD06669
      DO 17 I=1,IND                                                     MOD06670
      J=I+1                                                             MOD06671
      IF(SIZE(I).GE.SIZE(J)) GO TO 17                                   MOD06672
      ITEST=1                                                           MOD06673
      TEMP=SIZE(I)                                                      MOD06674
      SIZE(I)=SIZE(J)                                                   MOD06675
      SIZE(J)=TEMP                                                      MOD06676
      TEMP=STPT(I)                                                      MOD06677
      STPT(I)=STPT(J)                                                   MOD06678
      STPT(J)=TEMP                                                      MOD06679
17    CONTINUE                                                          MOD06680
      IF(ITEST.EQ.1) GO TO 10                                           MOD06681
      RETURN                                                            MOD06682
      END                                                               MOD06683
      SUBROUTINE REVERS(NEW,ILD,NN,KT)                                  MOD06068
      DIMENSION NEW(1),ILD(1)                                           MOD06069
      J=(NN-KT)/2                                                       MOD06070
      LL=NN-KT+1                                                        MOD06071
      DO 100 I=1,J                                                      MOD06072
      L=LL-I                                                            MOD06073
      K=NEW(L)                                                          MOD06074
      NEW(L)=NEW(I)                                                     MOD06075
100   NEW(I)=K                                                          MOD06076
      DO 110 I=1,NN                                                     MOD06077
      K=NEW(I)                                                          MOD06078
110   ILD(K)=I                                                          MOD06079
      RETURN                                                            MOD06080
      END                                                               MOD06081
      SUBROUTINE SORTDG(STK1,STK2,X1,X2,NDEG)                           MOD06684
      INTEGER NDEG,STK1,STK2                                            MOD06685
      INTEGER X1,X2,TEMP                                                MOD06686
      DIMENSION NDEG(1),STK1(1),STK2(1)                                 MOD06687
      IND=X2                                                            MOD06688
10    ITEST=0                                                           MOD06689
      IND=IND-1                                                         MOD06690
      IF(IND.LT.1) GO TO 40                                             MOD06691
      DO 30 I=1,IND                                                     MOD06692
      J=I+1                                                             MOD06693
      ISTK2=STK2(I)                                                     MOD06694
      JSTK2=STK2(J)                                                     MOD06695
      IF(NDEG(ISTK2).LE.NDEG(JSTK2)) GO TO 30                           MOD06696
      ITEST=1                                                           MOD06697
      TEMP=STK2(I)                                                      MOD06698
      STK2(I)=STK2(J)                                                   MOD06699
      STK2(J)=TEMP                                                      MOD06700
30    CONTINUE                                                          MOD06701
      IF(ITEST.EQ.1) GO TO 10                                           MOD06702
40    DO 50 I=1,X2                                                      MOD06703
      X1=X1+1                                                           MOD06704
      STK1(X1)=STK2(I)                                                  MOD06705
50    CONTINUE                                                          MOD06706
      RETURN                                                            MOD06707
      END                                                               MOD06708
