Liren Large Software Subsidy 9

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 15.ddi / RNC.FOR < prev next >

Wrap

Text File | 1987-04-11 | 49.6 KB | 620 lines

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