      SUBROUTINE RENUMC(NX,IES)                                         00206710
      IMPLICIT REAL*8 (A-H,O-Z)                                         00206720
      REAL*8  NPAR                                                      00206730
      COMMON/ELPAR/NPAR(14),NUMNP,II(7),MTOT,I2(6),NUMEL,NUMEL2         00206740
     & ,NRELPA(41)                                                      R0206741
      COMMON /BAND/ NRNM(3),NRBAND(5)                                   R0206750
      COMMON/SIZE/NDMX,MXDF,NSMX,NTERM,NADND                            00206760
      COMMON /TRASH/ X(30),RRTRAS(460)                                  R0206770
      COMMON /SUPEL/ LDUM(4),NEADD,NRSUPE                               R0206780
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7)                       R0206790
      COMMON/FORCE/ NLC,NELD                                            R0206800
      COMMON /A/ MAXGRD,MAXDEG,NRMAXG(3)                                R0206810
      COMMON /BITS/ NBITIN                                              00206820
      COMMON /ZERO/ KT                                                  00206830
      COMMON A(1)                                                       00206840
      MULT=4                                                            00206850
      CALL SECOND(T1)                                                   00206860
      NC=IABS(NX)                                                       00206870
      M2=2*NC                                                           00206880
      MTEF= MTOT*MULT                                                   00206890
      NBITIN=15                                                         00206900
      NWORDS=M2+NUMNP*7+NC*MULT*(NUMNP+MULT)/4                          00206910
      IF(NRNM(2).EQ.2) NWORDS=MTEF                                      00206920
      N=NUMNP                                                           00206930
      II1=NUMNP                                                         00206940
      IF(N.LT.100) N=100                                                00206950
      N=N+3                                                             00206960
      N=N-MOD(N,4)                                                      00206970
      MAXGRD=N                                                          00206980
      IIR=N/MULT                                                        00206990
        IF(MULT.EQ.1)IIR=NUMNP                                          00207000
      MAXDEG=NC                                                         00207010
      IF(NWORDS.GT.MTEF) WRITE(6, 100)                                  00207020
      IF(NWORDS.GT.MTEF) KSKIP=1                                        00207030
      IF(NWORDS.GT.MTEF) RETURN                                         00207040
  100 FORMAT (/20X, 95HFOR THE GIVEN NO. OF NODES THERE IS NOT ENOUGH ST00207050
     $ORAGE ALLOCATED -- NO MINIMIZATION IS ALLOWED.//)                 00207060
      N2=1+NUMEL*13                                                     00207070
      NZ=NTERM                                                          00207080
      IF(NZ.EQ.0) NZ=1                                                  00207090
      CALL ELORD(A(1),NUMEL,NUMEL2,NZ,NADND,A(N2))                      00207100
      ND=(NUMNP+MULT)/MULT                                              00207110
      N1=1                                                              00207120
      N2=N1+ND                                                          00207130
      IF(NRNM(2).EQ.2) CALL RENRST(A(N1),NUMNP,KT)                      00207140
      IF(NRNM(2).EQ.2)     GO TO 106                                    00207150
      DO 105 I=1,MTOT                                                   00207160
  105 A(I)=0.0                                                          00207170
      CALL CONECT(A(N2),NUMNP,NUMEL,I1,KSKIP,NC,X(1),NZ,NADND,II1)      00207180
      IF(KSKIP.EQ.1) RETURN                                             00207190
      N3=N2+IIR*NC                                                      00207200
      N4=N3+ND                                                          00207210
      N5=N4+ND                                                          00207220
      N6=N5+ND                                                          00207230
      N7=N6+ND                                                          00207240
      N8=N7+ND                                                          00207250
      N9=N8+ND                                                          00207260
      IF(NRNM(3).GE.0.AND.NRNM(3).LT.9000) GO TO 9105                   00207270
      CALL SETNOD(A(N2),II1,A(N3),NUMNP,A(N1),KT,I1)                    00207280
      GO TO 106                                                         00207290
 9105 CONTINUE                                                          00207300
      CALL SCHEME(A(N2),II1,NUMNP,0,A(N1),A(N3),A(N4),A(N5),A(N6),A(N7),00207310
     $ A(N8),A(N9),NX,M2,KT)                                            00207320
  106 CONTINUE                                                          00207330
      CALL NODORD(A(N2),NUMNP,A(N1),KT,I1)                              00207340
      NUMEL=NUMEL-NEADD                                                 00207350
      N3=N2+NUMEL*5                                                     00207360
      N4=N3+NZ*NADND                                                    00207370
      N5=N4+NADND                                                       00207380
      IF(N5.GT.MTOT) CALL ERROR(N5-MTOT)                                00207390
      CALL ELRORD(A(N2),NUMEL,NUMEL2,A(N1),NUMNP,I1,A(N3),A(N4),NZ,NADND00207400
     $)                                                                 00207410
      IF(IES.NE.0)CALL FGNORD(NUMNP,A(N1),IES)                          00207420
      N3=N2+NLC*6                                                       00207430
      IF(NLC.GT.0) CALL LDRORD(A(N1),A(N2),A(N3),NUMNP,NLC)             00207440
      CALL RORD(A(N1),A(N2),NUMNP)                                      00207450
      NTERM=NTERM-NEADD                                                 00207460
      CALL SECOND(T2)                                                   00207470
      T2=T2-T1                                                          00207480
      WRITE(6, 110)T2                                                   00207490
  110 FORMAT(///20X,F8.2, 53H SECONDS WERE REQUIRED TO REDUCE THE MODELS00207500
     $ BANDWIDTH//)                                                     00207510
      RETURN                                                            00207520
      END                                                               00207530
      SUBROUTINE SCHEME (IG,II1,NN,IP,ILD,IC,IDEG,IDIS,IW,NEW,ICC,IPP,  00225390
     $MM,M2,KT)                                                         00225400
      IMPLICIT REAL*8(A-H,O-Z)                                          00225410
      INTEGER*2 IC, IDEG, IDIS, IW, NEW, ICC                            00225420
      INTEGER*2  IG, ILD,IPP                                            00225430
      DIMENSION IG(II1,1),IC(II1),IDEG(II1),IDIS(II1),IW(II1),          00225440
     $          NEW(II1),ICC(II1),IPP(M2),ILD(II1)                      00225450
      COMMON /BAND/  NRNM(3),NRBAND(5)                                  R0225460
      COMMON /TRASH/ ISTART(100),RRTRAS(440)                            R0225470
      DIMENSION NODESL(100)                                             00225480
      NSTN=NRNM(3)                                                      00225490
      LINE=60                                                           00225500
      ISTA=0                                                            00225510
      NT=80                                                             00225520
      NUM=1                                                             00225530
      NOM=2                                                             00225540
      IO=2                                                              00225550
      CALL DEGREE(IG,II1,IDEG,NN,MM)                                    00225560
      NCM=COMPNT(IG,II1,IC,IDEG,IW,ICC,NN)                              00225570
   50 FORMAT(//20X,47H--WARNING-- MODEL HAS A UNCONNECTED STRUCTURE^  ) 00225580
      MAXD=MAXDGR(0,IC,IDEG,NN)                                         00225590
      MM=MAXD                                                           00225600
      DO 100 I=1,NN                                                     00225610
      NEW(I)=I                                                          00225620
  100 ILD(I)=I                                                          00225630
      IS=MAXBND(0,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                         00225640
      KORIG=IS                                                          00225650
      IH0=IH                                                            00225660
      DO 110 I=1,NN                                                     00225670
      NEW(I)=0                                                          00225680
  110 ILD(I)=0                                                          00225690
      CALL DIST(IDEG,IPP,IP,MEDIAN,MODD,NN,MM)                          00225700
      IF(IP.EQ.0) GO TO 200                                             00225710
      DO 150 I=1,NN                                                     00225720
      IF(MOD(I,LINE).EQ.1)WRITE(6,120)                                  00225730
  120 FORMAT(37H1LABEL  COMP MDIST  DEGR  CONNECTIONS ,10X,             00225740
     $   18H(INTERNAL NUMBERS) )                                        00225750
      MDIST=0                                                           00225760
      DO 130 J=1,MAXD                                                   00225770
      IS1 = IG(I,J)                                                     00225780
      IF(IS1.EQ.0)GO TO 130                                             00225790
      MDIST=MAX0(MDIST,IABS(I-IS1))                                     00225800
  130 CONTINUE                                                          00225810
      IPP(1)=IC(I)                                                      00225820
      IPP(2)=IDEG(I)                                                    00225830
      DO 140 IP1=1,MAXD                                                 00225840
  140 IPP (IP1+2) = IG(I,IP1)                                           00225850
      IS1=MAXD+2                                                        00225860
  150 WRITE(6,160)I,IPP(1),MDIST,(IPP(J),J=2,IS1)                       00225870
  160 FORMAT(5I6,20I5/ 25(25X,21I5/))                                   00225880
      WRITE(6,170)                                                      00225890
  170 FORMAT(1X ,//,32X,31HPROGRAMMER INFORMATION MESSAGES /)           00225900
      WRITE(6,180) IS,IH                                                00225910
  180 FORMAT(19H ORIGINAL BANDWIDTH,I7,10H   PROFILE,I10)               00225920
      WRITE(6,190) MODD                                                 00225930
  190 FORMAT(30H MODE OF DEGREE DISTRIBUTION =,I5)                      00225940
  200 CONTINUE                                                          00225950
      IF(IO.EQ.3) IS=IH                                                 00225960
      DO 350 NC=1,NCM                                                   00225970
      MI=MINDEG(NC,IC,IDEG,NN)                                          00225980
      MAD=MI                                                            00225990
      IF(NOM) 210,220,210                                               00226000
  210 MA=MAXDGR(NC,IC,IDEG,NN)                                          00226010
      MAD=MI+((MA-MI)*NUM)/NOM                                          00226020
      MAD=MIN0(MAD,MEDIAN-1)                                            00226030
      MAD=MAX0(MAD,MI)                                                  00226040
  220 IF(IP.EQ.0) GO TO 260                                             00226050
      WRITE(6,230) NC                                                   00226060
  230 FORMAT(22H *******     COMPONENT,I5,12H     *******)              00226070
      IF(IO.EQ.2) WRITE(6,240)                                          00226080
  240 FORMAT(43H OPTION 2 SELECTED  (CRITERION - BANDWIDTH ,            00226090
     $  57HMINIMIZATION|   CONDITION - MINMAX NUMBER OF NODES/LEVEL) )  00226100
      IF(IO.EQ.3) WRITE(6,250)                                          00226110
  250 FORMAT(52H OPTION 3 SELECTED (CRITERION - MINIMIZATION OF SUM|,   00226120
     $  44H   CONDITION - MINMAX NUMBER OF NODES/LEVEL) )               00226130
  260 CALL DIAM(NC,MAD,NL,NODESL,MAXLEV,IG,II1,IC,IDEG,IDIS,IW,ICC,NN)  00226140
      IF(NSTN.GT.0.AND.NC.EQ.1) READ(5,261)(ISTART(J),J=1,NSTN)         00226150
  261 FORMAT(16I5)                                                      00226160
      IF(NSTN.LE.0)GO TO 269                                            00226170
      MF=0                                                              00226180
      DO 267 I=1,NSTN                                                   00226190
      J=ISTART(I)                                                       00226200
      IF(IC(J).NE.NC) GO TO 267                                         00226210
      MF=MF+1                                                           00226220
      NODESL(MF)=J                                                      00226230
  267 CONTINUE                                                          00226240
      IF(MF.GT.0) NL=MF                                                 00226250
      NL=MIN0(NL  ,100)                                                 00226260
      CALL FIXIT(NODESL,NL)                                             00226270
  269 CONTINUE                                                          00226280
      IF(IP.EQ.0) GO TO 270                                             00226290
      WRITE(6,280) NC,MAD                                               00226300
      WRITE(6,290) MAXLEV                                               00226310
      WRITE(6,300) (NODESL(J),J=1,NL)                                   00226320
  270 CONTINUE                                                          00226330
  280 FORMAT(10H COMPONENT,I5,19H    MAX DEGREE USED,I5)                00226340
  290 FORMAT(52H STARTING NODES FOR MINMAX NUMBER OF NODES PER LEVEL,I5)00226350
  300 FORMAT(4X,20I5)                                                   00226360
      JMAX=MIN0(NT,NL)                                                  00226370
      IM=900000000                                                      00226380
      IMM=IM                                                            00226390
      M=1                                                               00226400
      IF(NSTN.GT.0.AND.MF.GT.0)  M=NL                                   00226410
      IF(NSTN.GT.0.AND.MF.GT.0) JMAX=1                                  00226420
      DO 340 J=1,JMAX                                                   00226430
      CALL RELABL(M,NODESL(J ),IG,II1,IC,IDEG,IDIS,IW,NEW,ICC,ILD,NN)   00226440
      IB=MAXBND(NC,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                        00226450
      IF(IP.NE.0) WRITE(6,310) NODESL(J),IB,IH                          00226460
  310 FORMAT(14H STARTING NODE,I6,4X,9HBANDWIDTH,I6,3X,7HPROFILE,I8)    00226470
      IF(IO.EQ.3) IB=IH                                                 00226480
      IE=ICC(NC+1)-1                                                    00226490
      IF(IM-IB) 340,330,320                                             00226500
  320 IM=IB                                                             00226510
      IMM=IH                                                            00226520
      IJ=J                                                              00226530
      GO TO 340                                                         00226540
  330 IF(IMM.LE.IH) GO TO 340                                           00226550
      IMM=IH                                                            00226560
      IJ=J                                                              00226570
  340 CONTINUE                                                          00226580
      IF(NSTN.GT.0.AND.MF.GT.0) GO TO 350                               00226590
      CALL RELABL(1,NODESL(IJ),IG,II1,IC,IDEG,IDIS,IW,NEW,ICC,ILD,NN)   00226600
  350 CONTINUE                                                          00226610
      CALL STACK(IDEG,NEW,ILD,IW,NN,KT)                                 00226620
      IB=MAXBND(0,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                         00226630
      WRITE(6,360)                                                      00226640
  360 FORMAT(21H0 ORIGINAL LABELING -)                                  00226650
      WRITE (6,380)  KORIG                                              00226660
      WRITE(6,370)                                                      00226670
  370 FORMAT(21H  STD CM RELABELING -)                                  00226680
      WRITE (6,380)  IB                                                 00226690
  380 FORMAT (1H+,26X,9HBANDWIDTH,I7)                                   00226700
  390 FORMAT(21H  REV CM RELABELING -)                                  00226710
  400 IF(IO.EQ.3) IB=IH                                                 00226720
      IF(IB-IS) 450,410,420                                             00226730
  410 IF(IH.LT.IH0) GO TO 450                                           00226740
  420 DO 430 I=1,NN                                                     00226750
      ILD(I)=I                                                          00226760
  430 NEW(I)=I                                                          00226770
      CALL STACK(IDEG,NEW,ILD,IW,NN,KT)                                 00226780
      IB=IS                                                             00226790
      IH=IH0                                                            00226800
      WRITE(6,440)                                                      00226810
  440 FORMAT(21H ORIG CM RELABELING -)                                  00226820
      WRITE (6,380)  IB                                                 00226830
  450 IHE=IH                                                            00226840
      CALL REVERS(NEW,ILD,NN,KT)                                        00226850
      IB=MAXBND(0,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                         00226860
      WRITE(6,390)                                                      00226870
      WRITE (6,380)  IB                                                 00226880
  460 IF(IH.LT.IHE) GO TO 470                                           00226890
      CALL REVERS(NEW,ILD,NN,KT)                                        00226900
      IB=MAXBND(0,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                         00226910
  470 IHE=IH                                                            00226920
      KNEW=IB                                                           00226930
      WRITE(6,480)                                                      00226940
  480 FORMAT(21H  ** FINAL LABELING -)                                  00226950
      WRITE (6,380)  KNEW                                               00226960
  490 CONTINUE                                                          00226970
  500 IF((NCM-KT).GT.1) WRITE(6,50)                                     00226980
      RETURN                                                            00226990
      END                                                               00227000
      SUBROUTINE DEGREE(IG,II1,IDEG,NN,MM)                              00055800
      INTEGER*2  IDEG                                                   00055810
      INTEGER*2  IG                                                     00055820
      DIMENSION IG(II1,1),IDEG(1)                                       00055830
      DO 120 I=1,NN                                                     00055840
      IDEG(I)=0                                                         00055850
      DO 110 J=1,MM                                                     00055860
      IF(IG(I,J)) 120,120,100                                           00055870
  100 IDEG(I)=IDEG(I)+1                                                 00055880
  110 CONTINUE                                                          00055890
  120 CONTINUE                                                          00055900
      RETURN                                                            00055910
      END                                                               00055920
      SUBROUTINE DIST(IDEG,HIST,IP,MEDIAN,MODD,NN,MM)                   00061010
      IMPLICIT REAL*8(A-H,O-Z)                                          00061020
      DIMENSION IDEG(1),HIST(1)                                         00061030
      INTEGER*2 HIST,IDEG                                               00061040
      MM1=MM+1                                                          00061050
      DO 100 I=1,MM1                                                    00061060
  100 HIST(I)=0                                                         00061070
      DO 110 I=1,NN                                                     00061080
      K=IDEG(I)+1                                                       00061090
  110 HIST(K)=HIST(K)+1                                                 00061100
      MODD=0                                                            00061110
      MAX=0                                                             00061120
      DO 120 I=1,MM1                                                    00061130
      K=HIST(I)                                                         00061140
      IF(K.LE.MAX) GO TO 120                                            00061150
      MAX=K                                                             00061160
      MODD=I-1                                                          00061170
  120 CONTINUE                                                          00061180
      IF(IP.EQ.0) GO TO 160                                             00061190
      WRITE(6,130)                                                      00061200
  130 FORMAT(26H1NODAL DEGREE HISTOGRAM --//10X,                        00061210
     $      26HDEGREE  NUMBER  CUM. TOTAL)                              00061220
      ISUM=0                                                            00061230
      DO 140 I=1,MM1                                                    00061240
      ISUM=ISUM+HIST(I)                                                 00061250
      K=I-1                                                             00061260
  140 WRITE(6,150) K,HIST(I),ISUM                                       00061270
  150 FORMAT(8X,2I8,I12)                                                00061280
  160 DO 170 I=2,MM1                                                    00061290
  170 HIST(I)=HIST(I)+HIST(I-1)                                         00061300
      NN2=NN/2                                                          00061310
                                                                        00061320
       DO 180 I=1,MM1                                                   00061330
      IF(HIST(I).GT.NN2) GO TO 190                                      00061340
  180 CONTINUE                                                          00061350
  190 MEDIAN=I-1                                                        00061360
      IF(IP.NE.0) WRITE(6,200) MEDIAN,MODD                              00061370
  200 FORMAT(/10X,6HMEDIAN,I6/10X,6H  MODE,I6)                          00061380
      RETURN                                                            00061390
      END                                                               00061400
      SUBROUTINE DIAM(NC,MAXDEG,NL,NODESL,MAXLEV,                       00059400
     $ IG,II1,IC,IDEG,IDIS,IW,ICC,NN)                                   00059410
      INTEGER*2 IG                                                      00059420
      INTEGER*2  IC,IDEG,IDIS,IW,ICC                                    00059430
      DIMENSION IG(II1,1),IDIS(1),IW(1),ICC(1),IC(1),IDEG(1)            00059440
      DIMENSION NODESL(1)                                               00059450
      NL=0                                                              00059460
      MAXLEV=10000                                                      00059470
      DO 150 I=1,NN                                                     00059480
      IF(NC-IC(I)) 150,100,150                                          00059490
  100 IF(MAXDEG-IDEG(I)) 150,110,110                                    00059500
  110 MD=IDIST(I,ML,MAXLEV,IG,II1,IC,IDEG,IDIS,IW,ICC,NN)               00059510
      IF(MD) 170,170,120                                                00059520
  120 IF(ML-MAXLEV)130,140,150                                          00059530
  130 MAXLEV=ML                                                         00059540
      NL=1                                                              00059550
      NODESL(1)=I                                                       00059560
      GO TO 150                                                         00059570
  140 IF(NL.GE.100) GO TO 150                                           00059580
      NL=NL+1                                                           00059590
      NODESL(NL)=I                                                      00059600
  150 CONTINUE                                                          00059610
  160 RETURN                                                            00059620
  170 ML=1                                                              00059630
      NODESL(1)=I                                                       00059640
      MAXLEV=0                                                          00059650
      RETURN                                                            00059660
      END                                                               00059670
      SUBROUTINE FIXIT(LIST,NL)                                         00087450
      IMPLICIT REAL*8(A-H,O-Z)                                          00087460
      DIMENSION LIST(1)                                                 00087470
      IF(NL.LE.0) RETURN                                                00087480
      IF(NL.EQ.1) GO TO 180                                             00087490
      NL1=NL-1                                                          00087500
      DO 110 I=1,NL1                                                    00087510
      IF(LIST(I).EQ.0) GO TO 110                                        00087520
      I1=I+1                                                            00087530
      DO 100 J=I1,NL                                                    00087540
      IF(LIST(I).NE.LIST(J)) GO TO 100                                  00087550
      LIST(I)=0                                                         00087560
      GO TO 110                                                         00087570
  100 CONTINUE                                                          00087580
  110 CONTINUE                                                          00087590
      DO 140 I=1,NL1                                                    00087600
      K=0                                                               00087610
  120 IF(LIST(I).NE.0) GO TO 140                                        00087620
      K=K+1                                                             00087630
      DO 130 J=I,NL1                                                    00087640
  130 LIST(J)=LIST(J+1)                                                 00087650
      LIST(NL)=0                                                        00087660
      IF(K.GE.(NL-I+1)) GO TO 150                                       00087670
      GO TO 120                                                         00087680
  140 CONTINUE                                                          00087690
  150 DO 160 I=1,NL                                                     00087700
      J=NL-I+1                                                          00087710
      IF(LIST(J).NE.0) GO TO 170                                        00087720
  160 CONTINUE                                                          00087730
  170 NL=NL-I+1                                                         00087740
      RETURN                                                            00087750
  180 IF(LIST(1).EQ.0) NL=0                                             00087760
      RETURN                                                            00087770
      END                                                               00087780
      SUBROUTINE RELABL(NS,NODES,IG,II1,IC,IDEG,IDIS,IW,NEW,ICC,ILD,NN) 00203660
      IMPLICIT REAL*8(A-H,O-Z)                                          00203670
      INTEGER*2 IC, IDEG, IDIS, IW, NEW, ICC                            00203680
      DIMENSION IG(II1,1),IC(1),IDEG(1),IDIS(1),IW(1),NEW(1),ICC(1)     00203690
      DIMENSION ILD(1)                                                  00203700
      INTEGER X                                                         00203710
      DIMENSION NODES( 1),IAJ(50)                                       00203720
      I=NODES(1)                                                        00203730
      ICN=IC(I)                                                         00203740
      NT=ICC(ICN)-1                                                     00203750
      DO 110 I=1,NN                                                     00203760
      IF(IC(I)-ICN) 110,100,110                                         00203770
  100 IDIS(I)=0                                                         00203780
  110 CONTINUE                                                          00203790
      DO 120 J=1,NS                                                     00203800
      JJ=NODES(J)                                                       00203810
      IDIS(JJ)=-1                                                       00203820
      JT=J+NT                                                           00203830
      NEW(JT)=JJ                                                        00203840
  120 ILD(JJ)=JT                                                        00203850
      KI=NT                                                             00203860
      KO=NS+NT                                                          00203870
      LL=KO                                                             00203880
      L=1                                                               00203890
      J=KO                                                              00203900
      NNC=ICC(ICN+1)-1                                                  00203910
  130 KI=KI+1                                                           00203920
      IF(KI-LL)150,140,150                                              00203930
  140 L=L+1                                                             00203940
      LL=KO+1                                                           00203950
  150 II=NEW(KI)                                                        00203960
      N=IDEG(II)                                                        00203970
      IF(N)160,280,160                                                  00203980
  160 IJ=0                                                              00203990
      DO 180 I=1,N                                                      00204000
      IA = IG(II,I)                                                     00204010
      IF(IDIS(IA)) 180,170,180                                          00204020
  170 IJ=IJ+1                                                           00204030
      IDIS(IA)=L                                                        00204040
      KO=KO+1                                                           00204050
      IAJ(IJ)=IA                                                        00204060
      IW(IJ)=IDEG(IA)                                                   00204070
  180 CONTINUE                                                          00204080
      IF(IJ-1)270,190,200                                               00204090
  190 J=KO                                                              00204100
      IZ=IAJ(1)                                                         00204110
      NEW(KO)=IZ                                                        00204120
      ILD(IZ)=KO                                                        00204130
      GO TO 270                                                         00204140
  200 X=0                                                               00204150
  210 DO 240 I=2,IJ                                                     00204160
      IF(IW(I)-IW(I-1))220,240,240                                      00204170
  220 CONTINUE                                                          00204180
      X=IW(I)                                                           00204190
      IW(I)=IW(I-1)                                                     00204200
      IW(I-1)=X                                                         00204210
  230 X=IAJ(I)                                                          00204220
      IAJ(I)=IAJ(I-1)                                                   00204230
      IAJ(I-1)=X                                                        00204240
  240 CONTINUE                                                          00204250
      IF(X)250,250,200                                                  00204260
  250 DO 260 I=1,IJ                                                     00204270
      J=J+1                                                             00204280
      IZ=IAJ(I)                                                         00204290
      NEW(J)=IZ                                                         00204300
      ILD(IZ)=J                                                         00204310
  260 CONTINUE                                                          00204320
  270 IF(KO-NNC)130,280,280                                             00204330
  280 CONTINUE                                                          00204340
      RETURN                                                            00204350
      END                                                               00204360
      SUBROUTINE STACK(IDEG,NEW,ILD,IW,NN,KT)                           00265520
      INTEGER*2  IDEG,IW,NEW                                            00265530
      INTEGER*2 ILD                                                             
      DIMENSION IDEG(1),NEW(1),ILD(1),IW(1)                             00265550
      KT=0                                                              00265560
      NN1=NN-1                                                          00265570
      DO 100 I=1,NN                                                     00265580
      IF(IDEG(I).GT.0) GO TO 100                                        00265590
      KT=KT+1                                                           00265600
      IW(KT)=ILD(I)                                                     00265610
  100 CONTINUE                                                          00265620
      IF(KT.LE.0) GO TO 140                                             00265630
      CALL SORT(IW,KT)                                                  00265640
      DO 130 L=1,KT                                                     00265650
      I=IW(L)-L+1                                                       00265660
      K=NEW(I)                                                          00265670
      IF(I.GE.NN) GO TO 120                                             00265680
      DO 110 J=I,NN1                                                    00265690
  110 NEW(J)=NEW(J+1)                                                   00265700
  120 NEW(NN)=K                                                         00265710
  130 CONTINUE                                                          00265720
  140 DO 150 I=1,NN                                                     00265730
      K=NEW(I)                                                          00265740
  150 ILD(K)=I                                                          00265750
      RETURN                                                            00265760
      END                                                               00265770
      SUBROUTINE REVERS(NEW,ILD,NN,KT)                                  00210450
      INTEGER*2 NEW                                                     00210460
      INTEGER*2  ILD                                                    00210470
      DIMENSION NEW(1),ILD(1)                                           00210480
      J=(NN-KT)/2                                                       00210490
      LL=NN-KT+1                                                        00210500
      DO 100 I=1,J                                                      00210510
      L=LL-I                                                            00210520
      K=NEW(L)                                                          00210530
      NEW(L)=NEW(I)                                                     00210540
  100 NEW(I)=K                                                          00210550
      DO 110 I=1,NN                                                     00210560
      K=NEW(I)                                                          00210570
  110 ILD(K)=I                                                          00210580
      RETURN                                                            00210590
      END                                                               00210600
      FUNCTION COMPNT(IG,II1,IC,IDEG,IW,ICC,NN)                         00048210
      IMPLICIT REAL*8(A-H,O-Z)                                          00048220
      INTEGER*2  IC,IDEG,IW,ICC                                         00048230
      INTEGER*2  IG                                                     00048240
      DIMENSION IG(II1,1),IC(1),IDEG(1),IW(1),ICC(1)                    00048250
      DO 100 I=1,NN                                                     00048260
      ICC(I)=0                                                          00048270
      IC(I)=0                                                           00048280
  100 CONTINUE                                                          00048290
      NC=0                                                              00048300
      ICC(1)=1                                                          00048310
  110 DO 120 I=1,NN                                                     00048320
      IF(IC(I)) 120,130,120                                             00048330
  120 COMPNT=NC                                                         00048340
      RETURN                                                            00048350
  130 NC=NC+1                                                           00048360
      KI=0                                                              00048370
      KO=1                                                              00048380
      IW(1)=I                                                           00048390
      IC(I)=NC                                                          00048400
      IF(NC-1)150,140,140                                               00048410
  140 IS=ICC(NC)+1                                                      00048420
      ICC(NC+1)=IS                                                      00048430
  150 KI=KI+1                                                           00048440
      II=IW(KI)                                                         00048450
      N=IDEG(II)                                                        00048460
      IF(N)160,110,160                                                  00048470
  160 DO 180 I=1,N                                                      00048480
      IA = IG(II,I)                                                     00048490
      IF(IC(IA)) 180,170,180                                            00048500
  170 IC(IA)=NC                                                         00048510
      KO=KO+1                                                           00048520
      IW(KO)=IA                                                         00048530
      IS=ICC(NC+1)+1                                                    00048540
      ICC(NC+1)=IS                                                      00048550
  180 CONTINUE                                                          00048560
      IF(KO-KI)110,110,150                                              00048570
      END                                                               00048580
      SUBROUTINE RENRST(ISIR,NUMNP,KT)                                  00205520
      INTEGER*2 ISIR                                                    00205530
      DIMENSION ISIR(NUMNP)                                             00205540
      READ (5,100,END=110) NZ,KT,(ISIR(I),I=1,NZ)                       00205550
   90 CONTINUE                                                          00205560
      IF(NZ.EQ.NUMNP) RETURN                                            00205570
  100 FORMAT(16I5)                                                      00205580
  110 WRITE(6,120)                                                      00205590
  120 FORMAT(//53H THE NO. OF NODES IS NOT THE SAME AS THE PREVIOUS RUN)00205600
      STOP                                                              00205610
      END                                                               00205620
      SUBROUTINE SORT(LIST,NL)                                          00248280
      INTEGER*2 LIST                                                    00248290
      DIMENSION LIST(1)                                                 00248300
      IF(NL.LE.1) RETURN                                                00248310
      NL1=NL-1                                                          00248320
      DO 110 I=1,NL1                                                    00248330
      K=NL-I                                                            00248340
      KFLAG=0                                                           00248350
      DO 100 J=1,K                                                      00248360
      IF(LIST(J).LE.LIST(J+1)) GO TO 100                                00248370
      KFLAG=1                                                           00248380
      L=LIST(J)                                                         00248390
      LIST(J)=LIST(J+1)                                                 00248400
      LIST(J+1)=L                                                       00248410
  100 CONTINUE                                                          00248420
      IF(KFLAG.EQ.0) RETURN                                             00248430
  110 CONTINUE                                                          00248440
      RETURN                                                            00248450
      END                                                               00248460
