home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 15.ddi / RNF.FOR < prev   
Encoding:
Text File  |  1987-04-11  |  21.5 KB  |  269 lines
  1.       SUBROUTINE RENUM1                                                 MOD05787
  2.       INTEGER AGET                                                      MOD05788
  3.       LOGICAL IGET,RGET                                                 MOD05789
  4.       COMMON/ELPAR/NPAR(14),NUMNP,II(7),MTOT,I2(6),NUMEL,NUMEL2         MOD05790
  5.       COMMON /BAND/ NRNM(3)                                             MOD05791
  6.      $,ICRIT                                                            MOD05792
  7.       COMMON/OUTS/IIN,IOUT,INPLT,IOPLT,IBON,II19,II57,II58              MOD05793
  8.       COMMON/UNIT/I7,I6,I14,I21,I20,I5,I19,I30,I57,I58,I60              MOD05794
  9.      1,I22,I26,I27                                                      MOD05795
  10.       COMMON/SIZE/NDMX,MXDF,NSMX,NTERM,NADND                            MOD05796
  11.       COMMON /TRASH/ X(30)                                              MOD05797
  12.       COMMON/STNOD/KCHNG,MT51                                           MOD05798
  13.       COMMON/ECHO/NOECHO,IUP                                            MOD05799
  14.       COMMON /SUPEL/ LDUM(4),NEADD                                      MOD05800
  15.       COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1                                 MOD05801
  16.       COMMON/FORCE/ NLC                                                 MOD05802
  17.       COMMON /A/ MAXGRD,MAXDEG                                          MOD05803
  18.       COMMON /S/NN,MM                                                   MOD05804
  19.       COMMON /BITS/ NBITIN                                              MOD05805
  20.       COMMON /ZERO/ KT                                                  MOD05806
  21.       COMMON/NONLIN/INON,ITHIS,INONTO                                   MOD05807
  22.       COMMON  A(25000)                                                  MOD05808
  23.       DATA BBLL/1H /                                                    MOD05809
  24.       II19=I19                                                          MOD05810
  25.       II57=I57                                                          MOD05811
  26.       MT51=51                                                           MOD05812
  27.       II58=I58                                                          MOD05813
  28.       KCHNG=0                                                           MOD05814
  29.       MTOT=25000                                                        MOD05815
  30.       IES=0                                                             MOD05816
  31.       IF(INON.NE.1)GO TO 8                                              MOD05817
  32.       J1=26                                                             MOD05818
  33.       J2=0                                                              MOD05819
  34.       J3=-INONTO                                                        MOD05820
  35.       J4=0                                                              MOD05821
  36.       GO TO 20                                                          MOD05822
  37. 8     DO 10 JJBB=3,8                                                    MOD05823
  38.       DOMDOM=AGET(JJBB)                                                 MOD05824
  39.       IF(DOMDOM.EQ.BBLL)GO TO 11                                        MOD05825
  40. 10    CONTINUE                                                          MOD05826
  41. 11    CONTINUE                                                          MOD05827
  42.       IF(IGET(J1))CALL PRTERR(0)                                        MOD05828
  43.       IF(IGET(J2))CALL PRTERR(0)                                        MOD05829
  44.       IF(IGET(J3))CALL PRTERR(0)                                        MOD05830
  45.       IF(IGET(J4))CALL PRTERR(0)                                        MOD05831
  46.       IF(IGET(J5))CALL PRTERR(0)                                        MOD05832
  47.       IF(IGET(IUP))CALL PRTERR(0)                                       MOD05833
  48.       IF(IUP.LT.0)IUP=0                                                 MOD05834
  49.       IF(J1.LE.0)J1=26                                                  MOD05835
  50.       IF(J2.LE.0)J2=0                                                   MOD05836
  51.       IF(J3.LE.0)J3=0                                                   MOD05837
  52.       IF(J4.LE.0)J4=0                                                   MOD05838
  53. 20    NADND=13                                                          MOD05839
  54.       NSELEM=0                                                          MOD05840
  55.       NRNM(1)=J1                                                        MOD05841
  56.       NRNM(2)=J2                                                        MOD05842
  57.       NRNM(3)=J3                                                        MOD05843
  58.       NW=NRNM(1)                                                        MOD05844
  59.       IIN=I20                                                           MOD05845
  60.       IOUT=I21                                                          MOD05846
  61.       INPLT=I14                                                         MOD05847
  62.       IOPLT=I22                                                         MOD05848
  63.       IBON=15                                                           MOD05849
  64.       IGPS=J4                                                           MOD05850
  65.       NOECHO=J5                                                         MOD05851
  66.       IF(IGPS.NE.1) CALL RENUM(NW,IES)                                  MOD05852
  67.       IF(IGPS.EQ.1) CALL RENUMC(NW,IES)                                 MOD05853
  68.       RETURN                                                            MOD05854
  69.       END                                                               MOD05855
  70.       SUBROUTINE RSETUP(LVL,LVLS1,LVLS2,NHIGH,NLOW,NACUM,IDIM)          MOD06221
  71.       COMMON /A/ MAXGRD,MAXDEG,N,IDPTH,IDEG                             MOD06222
  72.       COMMON /PREP/XDZ(2),KSKIP                                         MOD06223
  73.       COMMON/UNIT/II11,II22                                             MOD06224
  74.       DIMENSION NHIGH(IDIM),NLOW(IDIM),NACUM(IDIM)                      MOD06225
  75.       DIMENSION LVL(1),LVLS1(1),LVLS2(1)                                MOD06226
  76.       IF(IDPTH.LE.IDIM)  GO TO 20                                       MOD06227
  77.       NDXL=4*IDIM                                                       MOD06228
  78.       WRITE(II22,90)NDXL                                                MOD06229
  79. 90    FORMAT(//20X,31HAN INTERNAL DEFAULT DIMENSION (,I4,12H) IS SMALLERMOD06230
  80.      $/20X,50HTHAN YOUR PROBLEM REQUIRES. INCREASE IT BY PUTTING        MOD06231
  81.      $/20X,48HA LARGER NO. IN COL. 21-25 OF THE RENUMBER CARD.          MOD06232
  82.      $/20X,19HEXECUTION WILL END.//)                                    MOD06233
  83.       KSKIP=1                                                           MOD06234
  84.       RETURN                                                            MOD06235
  85. 20    CONTINUE                                                          MOD06236
  86.       DO 30 I=1,IDPTH                                                   MOD06237
  87.       NACUM(I)=0                                                        MOD06238
  88. 30    CONTINUE                                                          MOD06239
  89.       DO 140 I=1,N                                                      MOD06240
  90.       LVL(I)=1                                                          MOD06241
  91.       LVLS2(I)=IDPTH+1-LVLS2(I)                                         MOD06242
  92.       ITEMP=LVLS2(I)                                                    MOD06243
  93.       IF(ITEMP.GT.IDPTH) GO TO 140                                      MOD06244
  94.       IF(ITEMP.NE.LVLS1(I)) GO TO 100                                   MOD06245
  95.       NACUM(ITEMP)=NACUM(ITEMP)+1                                       MOD06246
  96.       GO TO 140                                                         MOD06247
  97. 100   LVL(I)=0                                                          MOD06248
  98. 140   CONTINUE                                                          MOD06249
  99.       RETURN                                                            MOD06250
  100.       END                                                               MOD06251
  101.       SUBROUTINE NODORD (ID,NUMNP,ISIR,KT,I1,XN)                        MOD04578
  102.       REAL*8 RX(3)                                                      MOD04579
  103.       INTEGER BLANK                                                     MOD04580
  104.       COMMON/BAND/NRNM(3)                                               MOD04581
  105.       COMMON/UNIT/II11,II22                                             MOD04582
  106.       COMMON/RIGID/IIA(20),NREX                                         MOD04583
  107.       COMMON/ELPAR/APAR(14),NPAR(15),NUMEL                              MOD04584
  108.       COMMON/OUTS/IIN,IOUT,INPLT,IOPLT,IBON,NT19,NT57,NT58              MOD04585
  109.       COMMON/STNOD/KCHNG,NT8                                            MOD04586
  110.       COMMON/SAP6/ISAP6                                                 MOD04587
  111.       COMMON/ECHO/NOECHO                                                MOD04588
  112.       DIMENSION X(3),ID(NUMNP,6),ISIR(NUMNP),XN(NUMNP,3),IDO(6),        MOD04589
  113.      1TITLE(20)                                                         MOD04590
  114.       DATA BLANK/1H /                                                   MOD04591
  115.       IZERO=0                                                           MOD04592
  116.       REWIND IBON                                                       MOD04593
  117.       REWIND INPLT                                                      MOD04594
  118.       REWIND IOUT                                                       MOD04595
  119.       REWIND IIN                                                        MOD04596
  120.       REWIND NT8                                                        MOD04597
  121.       IF(ISAP6.EQ.0) GO TO 80                                           MOD04598
  122.       REWIND NT19                                                       MOD04599
  123.       READ(NT19,260) TITLE,NNUMNP,NNUMEL,NNDMX                          MOD04600
  124. 80    CONTINUE                                                          MOD04601
  125.       DO 120 I=1,NUMNP                                                  MOD04602
  126.       IF(ISAP6.EQ.1) GO TO 90                                           MOD04603
  127.       READ(IIN,210)BLANK,N,BLANK,(IDO(K),K=1,6),(X(K),K=1,3)            MOD04604
  128.       IF(KCHNG.EQ.1)READ(NT8,210)BLANK,N,BLANK,(IDO(K),K=1,6),          MOD04605
  129.      $(X(K),K=1,3)                                                      MOD04606
  130.       GO TO 100                                                         MOD04607
  131. 90    READ(NT19,270)N,(IDO(K),K=1,6),(X(K),K=1,3)                       MOD04608
  132.       IF(KCHNG.EQ.1)READ(NT8,270)N,(IDO(K),K=1,6),(X(K),K=1,3)          MOD04609
  133. 100   CONTINUE                                                          MOD04610
  134.       KN=0                                                              MOD04611
  135.       M=ISIR(N)                                                         MOD04612
  136.       DO 110 J=1,3                                                      MOD04613
  137.       XN(M,J)=X(J)                                                      MOD04614
  138.       ID(M,J)=IDO(J)                                                    MOD04615
  139.       ID(M,J+3)=IDO(J+3)                                                MOD04616
  140. 110   CONTINUE                                                          MOD04617
  141. 120   CONTINUE                                                          MOD04618
  142.       READ(INPLT,240)TITLE                                              MOD04619
  143.       WRITE(IOPLT)TITLE                                                 MOD04620
  144.       READ(INPLT,250)K                                                  MOD04621
  145.       WRITE(IOPLT)K                                                     MOD04622
  146.       WRITE(IOPLT)NUMNP                                                 MOD04623
  147.       DO 130 I=1,NUMNP                                                  MOD04624
  148.       DO 125 K=1,3                                                      MOD04625
  149. 125   RX(K)=XN(I,K)                                                     MOD04626
  150.       IF(ISAP6.EQ.0)                                                    MOD04627
  151.      1WRITE(IOUT)BLANK,I,BLANK,(ID(I,K),K=1,6),(RX(K),K=1,3),KN         MOD04628
  152.       IF(ISAP6.EQ.1)                                                    MOD04629
  153.      1WRITE(IOUT)I,(ID(I,K),K=1,6),(RX(K),K=1,3),KN                     MOD04630
  154.       WRITE(IBON,280)I,(ID(I,K),K=1,6)                                  MOD04631
  155.       WRITE(IOPLT)I                                                     MOD04632
  156.       WRITE(IOPLT)(XN(I,K),K=1,3)                                       MOD04633
  157. 130   CONTINUE                                                          MOD04634
  158.       WRITE(IOPLT)IZERO                                                 MOD04635
  159.       IF(NOECHO.EQ.0) RETURN                                            MOD04636
  160.       WRITE(II22,220)                                                   MOD04637
  161.       WRITE(II22,230)(I,ISIR(I),I=1,NUMNP)                              MOD04638
  162.       RETURN                                                            MOD04639
  163. 210   FORMAT(A1,I4,A1,I4,5I5,3F10.4)                                    MOD04640
  164. 220   FORMAT(1H1,21X,66HTHIS IS A TABLE RELATING THE OLD NODES TO THE NEMOD04641
  165.      $W RENUMBERED NODES  //20X,5(10H  OLD  NEW ,5X)/20X,5(10H NODE NODEMOD04642
  166.      $,5X)/20X,5(10H  NO.  NO. ,5X)//)                                  MOD04643
  167. 230   FORMAT (20X,2I5,5X,2I5,5X,2I5,5X,2I5,5X,2I5)                      MOD04644
  168. 240   FORMAT(20A4)                                                      MOD04645
  169. 250   FORMAT(5X,I5)                                                     MOD04646
  170. 260   FORMAT(20A4/3I5)                                                  MOD04647
  171. 270   FORMAT(7I5,3F10.4)                                                MOD04648
  172. 280   FORMAT(7I5)                                                       MOD04649
  173. 300   FORMAT(3E12.5)                                                    MOD04650
  174. 310   FORMAT(1H )                                                       MOD04651
  175.       END                                                               MOD04652
  176.       FUNCTION MINDEG(NC,IC,IDEG,NN)                                    MOD04508
  177.       DIMENSION IC(1),IDEG(1)                                           MOD04509
  178.       M=10000                                                           MOD04510
  179.       DO 130 I=1,NN                                                     MOD04511
  180.       IF(NC)100,110,100                                                 MOD04512
  181. 100   IF(IC(I)-NC) 130,110,130                                          MOD04513
  182. 110   IF(M-IDEG(I)) 130,130,120                                         MOD04514
  183. 120   M=IDEG(I)                                                         MOD04515
  184. 130   CONTINUE                                                          MOD04516
  185.       MINDEG=M                                                          MOD04517
  186.       RETURN                                                            MOD04518
  187.       END                                                               MOD04519
  188.       FUNCTION MAXBND(NC,IG,II1,IC,IDEG,NEW,ILD,NN,IH)                  MOD04140
  189.       DIMENSION IG(II1,1),IC(1),IDEG(1),NEW(1),ILD(1)                   MOD04141
  190.       IH=0                                                              MOD04142
  191.       M=0                                                               MOD04143
  192.       DO 140 I=1,NN                                                     MOD04144
  193.       MX=0                                                              MOD04145
  194.       IA=NEW(I)                                                         MOD04146
  195.       IF(NC)100,110,100                                                 MOD04147
  196. 100   IF(IA.EQ.0)GO TO 140                                              MOD04148
  197.       IF(NC-IC(IA)) 140,110,140                                         MOD04149
  198. 110   N=IDEG(IA)                                                        MOD04150
  199.       IF(N)140,140,120                                                  MOD04151
  200. 120   DO 130 J=1,N                                                      MOD04152
  201.       II = IG(IA,J)                                                     MOD04153
  202.       IB=MAX0(0,I-ILD(II))                                              MOD04154
  203.       IF(IB.GT.MX) MX=IB                                                MOD04155
  204. 130   CONTINUE                                                          MOD04156
  205.       IF(MX.GT.M) M=MX                                                  MOD04157
  206.       IH=IH+MX                                                          MOD04158
  207. 140   CONTINUE                                                          MOD04159
  208.       MAXBND=M                                                          MOD04160
  209.       RETURN                                                            MOD04161
  210.       END                                                               MOD04162
  211.       FUNCTION MAXDGR(NC,IC,IDEG,NN)                                    MOD04163
  212.       DIMENSION IC(1),IDEG(1)                                           MOD04164
  213.       M=0                                                               MOD04165
  214.       DO 130 I=1,NN                                                     MOD04166
  215.       IF(NC)100,110,100                                                 MOD04167
  216. 100   IF(IC(I)-NC) 130,110,130                                          MOD04168
  217. 110   IF(IDEG(I)-M) 130,130,120                                         MOD04169
  218. 120   M=IDEG(I)                                                         MOD04170
  219. 130   CONTINUE                                                          MOD04171
  220.       MAXDGR=M                                                          MOD04172
  221.       RETURN                                                            MOD04173
  222.       END                                                               MOD04174
  223.       FUNCTION IDIST(NS,ML,MAXLEV,IG,II1,IC,IDEG,IDIS,IW,ICC,NN)        MOD03475
  224.       DIMENSION IG(II1,1),IC(1),IDEG(1),IDIS(1),IW(1),ICC(1)            MOD03476
  225.       ICN=IC(NS)                                                        MOD03477
  226.       NNC=ICC(ICN+1)-ICC(ICN)                                           MOD03478
  227.       DO 110 I=1,NN                                                     MOD03479
  228.       IF(IC(I)-IC(NS)) 110,100,110                                      MOD03480
  229. 100   IDIS(I)=0                                                         MOD03481
  230. 110   CONTINUE                                                          MOD03482
  231.       LL=1                                                              MOD03483
  232.       L=0                                                               MOD03484
  233.       KI=0                                                              MOD03485
  234.       KO=1                                                              MOD03486
  235.       ML=0                                                              MOD03487
  236.       IW(1)=NS                                                          MOD03488
  237.       IDIS(NS)=-1                                                       MOD03489
  238. 120   KI=KI+1                                                           MOD03490
  239.       IF(KI-LL)150,130,150                                              MOD03491
  240. 130   L=L+1                                                             MOD03492
  241.       LL=KO+1                                                           MOD03493
  242.       K=KO-KI+1                                                         MOD03494
  243.       IF(K-ML) 150,150,140                                              MOD03495
  244. 140   ML=K                                                              MOD03496
  245.       IF(ML-MAXLEV) 150,150,230                                         MOD03497
  246. 150   II=IW(KI)                                                         MOD03498
  247.       N=IDEG(II)                                                        MOD03499
  248.       IF(N)160,220,160                                                  MOD03500
  249. 160   DO 180 I=1,N                                                      MOD03501
  250.       IA = IG(II,I)                                                     MOD03502
  251.       IF(IDIS(IA))180,170,180                                           MOD03503
  252. 170   IDIS(IA)=L                                                        MOD03504
  253.       KO=KO+1                                                           MOD03505
  254.       IW(KO)=IA                                                         MOD03506
  255. 180   CONTINUE                                                          MOD03507
  256.       IF(KO-NNC)120,190,190                                             MOD03508
  257. 190   IDIST=L                                                           MOD03509
  258.       IDIS(NS)=0                                                        MOD03510
  259.       K=KO-LL+1                                                         MOD03511
  260.       IF(K-ML) 210,210,200                                              MOD03512
  261. 200   ML=K                                                              MOD03513
  262. 210   CONTINUE                                                          MOD03514
  263.       RETURN                                                            MOD03515
  264. 220   L=0                                                               MOD03516
  265.       GO TO 190                                                         MOD03517
  266. 230   IDIST=1                                                           MOD03518
  267.       RETURN                                                            MOD03519
  268.       END                                                               MOD03520
  269.