Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1987-09-17 | 43.4 KB | 543 lines

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