      SUBROUTINE SLOWR (                           BB,B,DIAG,JF,JFACTS,JR0242720
     1DIAG,JHIGH,RDELT,NLC,NBLKS,NEQ,MTB,MCB,MAXVT,MLT,NRESLT,NSTIF,N1,N00242730
     22,KFN,KSUM,JSUM,NEQB,NBLK2,DISP,BLDIS,GDISP)                      00242740
      IMPLICIT REAL*8(A-H,O-Z)                                          00242750
      REAL*8 KF,KFACTS,KDIAG,KHIGH,JF,JFACTS,JDIAG,JHIGH,JFACTR         R0242760
      DIMENSION                                           BB(JSUM), B(ML00242770
     1T), DIAG(1), JDIAG(1), JHIGH(1), RDELT(1), DISP(NEQ), BLDIS(NEQB,N00242780
     2LC)                                                               00242790
      DIMENSION FOLD(4),          JFACTS(4),        JF(KFN),JFACTR(4)   R0242800
      DIMENSION GDISP(10,NLC)                                           00242810
      COMMON/EQUILB/NEQIL,ITX2                                          00242820
      COMMON /GPS/ NEQ4(10),NRGPS(10)                                   R0242830
      COMMON /SUPEL/NSELEM,NEQL,NRSUPE(4)                               R0242840
      COMMON /PREP / XQ(2),KSKIP,RRPREP(8)                              R0242850
      COMMON /SQZ/ ISQZ,NRSQZ(5),NRC1                                   R0242860
      COMMON /AAA1/ A(8000)                                             R0242861
      COMMON /AAA2/ KFACTS(4),KDIAG(300),KHIGH(300)                     R0242862
      NRC2 = 0
      NRC3 = 1
        CALL FILES(4)                                                   00242870
      CALL SECOND(TIM1)                                                 00242880
      CALL RDWRT (NRESLT,A,1,6,INUM)                                    00242890
      CALL RDWRT (NSTIF,A,1,6,INUM)                                     00242900
      REWIND N1                                                         00242910
      REWIND N2                                                         00242920
      NGP=0                                                             00242930
      IF(ITX2.LE.0) KSKIP=1                                             00242940
      DO 100 I=1,10                                                     00242950
         IF (NEQ4(I).GT.0) NGP=I                                        00242960
100   CONTINUE                                                          00242970
      DIAGCK=1.0D-08                                                    00242980
      X=NBLKS                                                           00242990
      KINC=NBLKS*20/100                                                 00243000
      IF (KINC.LT.1) KINC=1                                             00243010
      ZER=0.0D0                                                         00243020
      KFIRST=1                                                          00243030
        IF(NEQIL.EQ.1) REWIND 41                                        00243040
      DO 320 N=1,NBLKS                                                  00243050
CC       CALL EXPAND (AA,KSUM,NSTIF)                                    00243060
       READ (4) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB)        R0243061
       READ (4) (A(IR),IR=1,MLT)                                        R0243062
        IF(NEQIL.EQ.1) WRITE(41)AA                                      00243070
            DO 101 I=1,4                                                00243071
 101        JFACTR(I)=KFACTS(I)                                         00243072
         KSTART = JFACTR(3)                                             R0243080
         KEND = JFACTR(4)                                               R0243090
         JFIRST=KFIRST                                                  00243100
         DO 280 NBOPR=JFIRST,N                                          00243110
            IF (N.EQ.1) GO TO 110                                       00243120
            READ (N1) JF,B                                              R0243131
            IF (NBOPR.NE.N) GO TO 130                                   00243140
110         DO 120 I=1,4                                                00243150
120         JFACTS(I)=KFACTS(I)                                         00243160
 130        IF (KFACTS(2).GT.JFACTS(4)) GO TO 260                       00243170
               JFCT3=JFACTS(3)                                          00243180
               JFCT4=JFACTS(4)                                          00243190
            DO 250 NCOL=KSTART,KEND                                     00243200
               KCOL=NCOL-KSTART+1                                       00243210
               DO 140 LC=1,NLC                                          00243220
140            RDELT(LC)=0.0D0                                          00243230
               RRNC1 = KHIGH(KCOL)                                      R0243240
               KHI = RRNC1                                              R0243241
               RRNC2 = KDIAG(KCOL)                                      R0243250
               KD = RRNC2                                               R0243251
               NSTART=NCOL-KHI+1                                        00243260
               IF (NSTART.GT.JFCT4) GO TO 250                           00243270
               JSTART=MAX0(JFCT3,NSTART)                                00243280
               JEND=MIN0(JFCT4,NCOL-1)                                  00243290
               IF (JSTART.GT.JEND.OR.KHI.EQ.1) GO TO 190                00243300
               MCHNG=KD-NCOL+JSTART                                     00243310
      IF(NBOPR.NE.N) GO TO 149                                          00243320
      DO 146 NOPER=JSTART,JEND                                          00243330
      JOPER=NOPER-JFACTS(3)+1                                           00243340
      RRNC3 = KDIAG(JOPER)                                              R0243350
      JD = RRNC3                                                        R0243351
      RRNC4 = KHIGH(JOPER)                                              R0243360
      JHJ = RRNC4                                                       R0243361
      NTERMS=MIN0(JHJ-1,NOPER-NSTART)                                   R0243370
      IF(NTERMS.EQ.0) GO TO 144                                         00243380
      MNRR = MCHNG - NTERMS                                             R0243381
      JNRR = JD - NTERMS                                                R0243382
      IF (JNRR .LE. MTB) GO TO 141                                      R0243384
      JN1 = JNRR - MTB                                                  R0243383
      CALL QVDOT1 (DELT,MNRR,           B(JN1)      ,NTERMS,1,1)        R0243390
      GO TO 143                                                         R0243391
 141  CONTINUE                                                          R0243392
      CALL QVDOT(DELT,A(MCHNG-NTERMS),A(JD-NTERMS),NTERMS,1,1)          R0243393
 143  CONTINUE                                                          R0243394
      A(MCHNG)=A(MCHNG)-DELT                                            00243400
  144 DO 145 LC=1,NLC                                                   00243410
  145 RDELT(LC)=RDELT(LC)+A(JD+LC)*A(MCHNG)                             00243420
  146 MCHNG=MCHNG+1                                                     00243430
      GO TO 210                                                         00243440
  149 DO 180 NOPER=JSTART,JEND                                          00243450
                  JOPER=NOPER-JFACTS(3)+1                               00243460
                  RRNC5 = JDIAG(JOPER)                                  R0243470
                  JD = RRNC5                                            R0243471
                  RRNC6 = JHIGH(JOPER)                                  R0243480
                  JHJ = RRNC6                                           R0243481
                  NTERMS=MIN0(JHJ-1,NOPER-NSTART)                       00243490
      MNRR = MCHNG - NTERMS                                             R0243491
      JNRR = JD - NTERMS                                                R0243492
      JN1 = JNRR - MTB                                                  R0243493
                  IF (NTERMS.EQ.0) GO TO 160                            00243500
      CALL QVDOT1(DELT,MNRR,           B(JN1)      ,NTERMS,1,1)         R0243510
                  A(MCHNG)=A(MCHNG)-DELT                                00243520
  160 CONTINUE                                                          00243530
                  DO 170 LC=1,NLC                                       00243540
       JLRR = JD + LC                                                   R0243541
       IF(JLRR .LE. MTB) RDELT(LC)=RDELT(LC)+A(JD+LC)*A(MCHNG)          R0243550
       IF(JLRR .LE. MTB) GO TO 170                                      R0243551
       JLRR = JLRR - MTB                                                R0243552
        RDELT(LC)=RDELT(LC)+B(JLRR)*A(MCHNG)                            R0243552
 170   CONTINUE                                                         R0243552
180            MCHNG=MCHNG+1                                            00243560
190            IF (NBOPR.EQ.N) GO TO 210                                00243570
               IF (KHI.EQ.1) GO TO 250                                  00243580
               DO 200 LC=1,NLC                                          00243590
 200           A(KD+LC)=A(KD+LC)-RDELT(LC)                              00243600
               GO TO 250                                                00243610
210            DELT=0.0D0                                               00243620
               IF (KHI.EQ.1) GO TO 230                                  00243630
               II=KD-KHI+1                                              00243640
        III=KD-1                                                        00243650
               NSM=NSTART-II                                            00243660
               DO 220 I=II,III                                          00243670
                  RMULT=A(I)                                            00243680
      A(I)=RMULT*DIAG(NSM+I)                                            00243690
220            DELT=DELT+RMULT*A(I)                                     00243700
               A(KD)=A(KD)-DELT                                         00243710
 230    IF(A(KD).EQ.0.0)A(KD)=1.E-20                                    00243720
      DIAG(NCOL)=1.00D0/A(KD)                                           00243730
      IF(A(KD).LT.DIAGCK) WRITE(6,235)NCOL                              00243740
  235 FORMAT(/20X,8HEQUATION,I5,17H MAY BE SINGULAR.)                   00243750
      RMULT=DIAG(NCOL)                                                  00243760
               DO 240 LC=1,NLC                                          00243770
240            A(KD+LC)=(A(KD+LC)-RDELT(LC))*RMULT                      00243780
250         CONTINUE                                                    00243790
260         IF (JFACTS(4)+JFACTS(1).LE.KFACTS(4)) GO TO 270             00243800
            IF (N.EQ.NBLKS.OR.N.EQ.NBOPR) GO TO 280                     00243810
       WRITE (N2) JF,B                                                  R0243820
            GO TO 280                                                   00243830
270         KFIRST=KFIRST+1                                             00243840
280      CONTINUE                                                       00243850
      IF(N.EQ.NBLKS) GO TO 301                                          00243860
CC       CALL RDWRT (NRESLT,AA,KSUM,1,INUM)                             R0243870
       WRITE (23) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB)      R0243871
       WRITE (23) (A(IR),IR=1,MLT)                                      R0243872
      NRC2 = NRC2 + 1                                                   R0243873
      IF (NRC3 .EQ. 1) WRITE (6,1009) NRESLT,NRC2                       R0243874
 1009 FORMAT (5X,'****** NRESLT NRC2 ******',2I5/)                      R0243875
         DO 290 I=1,MCB                                                 00243880
290      KDIAG(I)=KDIAG(I)+MTB                                          00243890
      WRITE (N2) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR)                 R0243900
     $ ,IR=1,MCB),(A(IR),IR=1,MLT)                                      R0243901
        WRITE (N2) JF,B                                                 R0243910
         MOPER=N1                                                       00243920
         N1=N2                                                          00243930
         N2=MOPER                                                       00243940
300      REWIND N1                                                      00243950
         REWIND N2                                                      00243960
  301 PER=N*100.0D0/X                                                   00243970
         KPR=MOD(N,KINC)                                                00243980
         IF (KPR.EQ.0) WRITE(6,310) PER                                 00243990
310   FORMAT (20X,F7.2,39H PERCENT OF THE FWD. REDUCTION HAS BEEN,      00244000
     110HCOMPLETED.///)                                                 00244010
320   CONTINUE                                                          00244020
      CALL SECOND(TIM2)                                                 00244030
      NT1=15                                                            00244040
      REWIND NT1                                                        00244050
      NRIT=0                                                            00244060
      MLDB=0                                                            00244070
      NFLC=1                                                            00244080
      LLC=MAXVT                                                         00244090
      CALL RDWRT (NSTIF,A,1,6,INUM)                                     00244100
      IF(NEQL.LE.0) GO TO 325                                           00244110
      MLDB=1                                                            00244120
      NRIT=1                                                            00244130
CC    CALL RDWRT(NRESLT,AA,KSUM,1,ISUM)                                 00244140
       WRITE (23) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB)      R0244141
       WRITE (23) (A(IR),IR=1,MLT)                                      R0244142
      NDF=NEQ-NEQL                                                      00244150
      CALL RDWRT(NRESLT,AA,KSUM,2,INUM)                                 00244160
      CALL SETDIS(NRESLT,NSTIF,                           KSUM,MCB,MLT, R0244170
     1KFN,NEQ,B,NBLKS,NLC,KSKIP,NDF)                                    00244180
CC    CALL EXPAND(AA,KSUM,NSTIF)                                        00244190
       READ (4) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB)        R0244191
       READ (4) (A(IR),IR=1,MLT)                                        R0244192
      NRESLT=NSTIF                                                      00244200
      IF(KSKIP.EQ.1) RETURN                                             00244210
      GO TO 328                                                         00244220
  325 CONTINUE                                                          00244230
      IF (NBLKS.GT.1) CALL RDWRT (NRESLT,A,1,2,INUM)                    00244240
  328 CONTINUE                                                          00244250
      MTT=MAXVT*NEQ                                                     00244260
330   CALL QVSET (ZER,DIAG,MTT)                                         00244270
      DO 380 N=1,NBLKS                                                  00244280
         NCB=KFACTS(4)-KFACTS(3)+1                                      00244290
         DO 360 NC=1,NCB                                                00244300
            NCOL=KFACTS(4)-NC+1                                         00244310
            KCOL=NCB-NC+1                                               00244320
            RRNC7 = KHIGH(KCOL)                                         R0244331
            KHI = RRNC7 - 1                                             R0244330
            RRNC8 = KDIAG(KCOL)                                         R0244340
            KD = RRNC8                                                  R0244341
            LX=0                                                        00244350
            DO 340 LC=NFLC,LLC                                          00244360
               NX=LX*NEQ+NCOL                                           00244370
               DIAG(NX)=A(KD+LC)-DIAG(NX)                               00244380
340         LX=LX+1                                                     00244390
            IF (KHI.EQ.0) GO TO 360                                     00244400
            LX=0                                                        00244410
            KJ=KD-KHI-1                                                 00244420
            DO 350 LC=NFLC,LLC                                          00244430
               LX=LX+1                                                  00244440
               MEND=NCOL+(LX-1)*NEQ                                     00244450
      RMULT=-DIAG(MEND)                                                 00244460
               MCOL=MEND-KHI                                            00244470
      IF(NEQL.LE.0) GO TO 345                                           00244480
      IF(NCOL.LE.NEQL) GO TO 345                                        00244490
      MEND=MEND-NCOL+NEQL+1                                             00244500
      IF(MCOL.GT.MEND) GO TO 350                                        00244510
  345 CONTINUE                                                          00244520
      KJRR = KJ + 1                                                     R0244521
      CALL QMR2 (DIAG(MCOL),DIAG(MCOL),RMULT,A(KJ+1),MEND-MCOL,1,1,1)   R0244530
  350 CONTINUE                                                          00244540
360      CONTINUE                                                       00244550
         IF (LLC.EQ.NLC.OR.NRIT.EQ.1) GO TO 370                         00244560
CC       CALL SQEEZE (AA,KSUM,NSTIF,ISQZ)                               00244570
       WRITE (NSTIF) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB)   R0244571
       WRITE (NSTIF) (A(IR),IR=1,MLT)                                   R0244572
 370        IF (N.EQ.NBLKS) GO TO 380                                   00244580
CC       CALL EXPAND (AA,KSUM,NRESLT)                                   00244590
       READ (23) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB)       R0244591
       READ (23) (A(IR),IR=1,MLT)                                       R0244592
         IF (MLDB.EQ.1) GO TO 380                                       00244600
      IF(N+1.GE.NBLKS) GO TO 380                                        00244610
         CALL RDWRT (NRESLT,A,1,2,INUM)                                 00244620
         CALL RDWRT (NRESLT,A,1,2,INUM)                                 00244630
380   CONTINUE                                                          00244640
      ND=0                                                              00244650
      DO 390 I=NFLC,LLC                                                 00244660
         NS=ND+1                                                        00244670
         ND=NS+NEQ-1                                                    00244680
390   WRITE (NT1) (DIAG(NX),NX=NS,ND)                                   00244690
      IF (LLC.EQ.NLC) GO TO 400                                         00244700
      NRIT=1                                                            00244710
      MLDB=1                                                            00244720
      NFLC=NFLC+MAXVT                                                   00244730
      LLC=MIN0(LLC+MAXVT,NLC)                                           00244740
      CALL RDWRT (NSTIF,A,1,6,INUM)                                     00244750
CC    CALL EXPAND (AA,KSUM,NSTIF)                                       00244760
       READ (NSTIF) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB)    R0244761
       READ (NSTIF) (A(IR),IR=1,MLT)                                    R0244762
      NRESLT=NSTIF                                                      00244770
      GO TO 330                                                         00244780
400   CONTINUE                                                          00244790
        IF(NEQIL.LE.0)GO TO 910                                         00244800
        KOUT=4                                                          00244810
        REWIND NT1                                                      00244820
        DO 900 L=1,NLC                                                  00244830
        WRITE(6,9011)L                                                  00244840
        REWIND 41                                                       00244850
9011    FORMAT(1X ,27H   FORCE CHECK ON LOAD CASE,I5/                   00244860
     &  24X,12HFORCE/MOMENT/4(12H  DOF ACTUAL,7X,12HCALCULATED  ))      00244870
        READ(NT1)DISP                                                   00244880
        DO 890 N=1,NBLKS                                                00244890
        READ(41)AA                                                      00244900
        RRNC9 = KFACTS(3)                                               R0244910
        KSTART = RRNC9                                                  R0244911
        RRNC10 = KFACTS(4)                                              R0244920
        KEND = RRNC10                                                   R0244921
        DO 880 K=KSTART,KEND                                            00244930
        KCOL=K-KSTART+1                                                 00244940
        RRNC11 = KHIGH(KCOL)                                            R0244950
        KHI = RRNC11                                                    R0244951
        RRNC12 = KDIAG(KCOL)                                            R0244960
        KD = RRNC12                                                     R0244961
        II1=K-KHI+1                                                     00244970
        II2=K-1                                                         00244980
        IB=KD-KHI                                                       00244990
        B(K)=0.                                                         00245000
        IF(II2.LE.0)GO TO 875                                           00245010
        IF(II1.GE.K)GO TO 875                                           00245020
        DO 870 I=II1,II2                                                00245030
        IB=IB+1                                                         00245040
        B(I)=B(I)+A(IB)*DISP(K)                                         00245050
        B(K)=B(K)+A(IB)*DISP(I)                                         00245060
870     CONTINUE                                                        00245070
875     B(K)=B(K)+A(KD)*DISP(K)                                         00245080
880     CONTINUE                                                        00245090
890     CONTINUE                                                        00245100
        ENGY=0.                                                         00245110
        DO 894 I=1,NEQ                                                  00245120
894     ENGY=ENGY+DISP(I)*B(I)                                          00245130
        ENGY=ENGY/2.                                                    00245140
        KFOR=0                                                          00245150
        NK=0                                                            00245160
        DIFM=0.                                                         00245170
        DIFF2=0.                                                        00245180
        REWIND 41                                                       00245190
        DO 899 I=1,NBLKS                                                00245200
        READ(41)AA                                                      00245210
        RRNC13 = KFACTS(3)                                              R0245220
        KST = RRNC13                                                    R0245221
        RRNC14 = KFACTS(4)                                              R0245230
        KEND = RRNC14                                                   R0245231
        DO 898 K=KST,KEND                                               00245240
        KCOL=K-KST+1                                                    00245250
        RRNC15 = KDIAG(KCOL)                                            R0245260
        KD = RRNC15                                                     R0245261
        NK=NK+1                                                         00245270
        IB=KD+L                                                         00245280
        P1=A(IB)                                                        00245290
        DIFF=DABS(P1-B(NK))                                             00245300
        DIFF2=DIFF2+DIFF*DIFF                                           00245310
        DIFM=DMAX1(DIFM,DIFF)                                           00245320
        KFOR=KFOR+1                                                     00245330
        IF(KFOR.EQ.KOUT+1)KFOR=1                                        00245340
        FOLD(KFOR)=P1                                                   00245350
        IF(NK.EQ.NEQ)GO TO 895                                          00245360
        IF(KFOR.NE.KOUT)GO TO 896                                       00245370
895     KK1=NK-KFOR+1                                                   00245380
        WRITE(6,9012)(KKL,FOLD(KKL-KK1+1),B(KKL),KKL=KK1,NK)            00245390
896     CONTINUE                                                        00245400
9012    FORMAT(4(I5,1P2E13.5))                                          00245410
898     CONTINUE                                                        00245420
899     CONTINUE                                                        00245430
        DMSE=DIFF2/DBLE  (NEQ)                                          R0245440
        DMSE=DSQRT(DMSE)                                                00245450
        WRITE(6,9010)L,DIFM,DMSE,ENGY                                   00245460
9010    FORMAT(2H  ,80(1H*)/29H  EQUILIBRIUM CHECK LOAD CASE,           00245470
     &  I5/19H     MAXIMUM ERROR=,1PE10.3/21H     ROOT MEAN SQUARE,     00245480
     &  7H ERROR=,E10.3/25H     TOTAL STRAIN ENERGY=,1PE18.10)          00245490
900     CONTINUE                                                        00245500
910     CONTINUE                                                        00245510
      NT2 = 62                                                          R0245520
      REWIND NT2                                                        00245530
      NS=1-NEQB                                                         00245540
      ND=NEQB                                                           00245550
      DO 430 I=1,NBLK2                                                  00245560
         IF (I.EQ.NBLK2) ND=NEQ-NEQB*(NBLK2-1)                          00245570
         REWIND NT1                                                     00245580
         NS=NS+NEQB                                                     00245590
         DO 420 J=1,NLC                                                 00245600
            READ (NT1) DISP                                             00245610
            IF (I.GT.1) GO TO 420                                       00245620
            IF (NGP.EQ.0) GO TO 420                                     00245630
            DO 410 K=1,NGP                                              00245640
               MCOL=NEQ4(K)                                             00245650
410         GDISP(K,J)=DISP(MCOL)                                       00245660
420      CALL QVCOPY (DISP(NS),BLDIS(1,J),ND)                           00245670
      IF (NRC3 .EQ. 1) WRITE(6,2105) (DISP(IR),IR=1,11)
 2105 FORMAT (1X,'**DISP**',11E11.4/)
      IF (NRC3 .EQ. 1) WRITE(6,2107) (BLDIS(IR,1),IR=1,11)
 2107 FORMAT (1X,'**BLDIS**',11E11.4/)
430   WRITE (NT2) BLDIS                                                 00245680
      WRITE(6,440)                                                      00245690
440   FORMAT (/20X,37HBACK-SUBSTITUTION HAS BEEN COMPLETED.///)         00245700
      TIM1=TIM2-TIM1                                                    00245710
      WRITE(6,450)TIM1                                                  00245720
  450 FORMAT(1H+,20X,30HTIME FOR FORWARD REDUCTION WAS,F9.3,8H MINUTS /)R0245730
      CALL SECOND(TIM1)                                                 00245740
      TIM1=TIM1-TIM2                                                    00245750
      WRITE(6,460)TIM1                                                  00245760
  460 FORMAT(1H0,20X,30HTIME FOR BACK SUBSTITUTION WAS,F9.3,8H MINUTS /)R0245770
      RETURN                                                            00245780
      END                                                               00245790
      SUBROUTINE SETDIS(N1,N2,                           KSUM,MCB,MLT,  R0235070
     $KFN,NEQ,B,NBLKS,NLC,KSKIP,NDF)                                    00235080
      IMPLICIT REAL*8(A-H,O-Z)                                          00235090
      REAL*8 KFACTS,KF,KDIAG,KHIGH,A                                    R0235100
      DIMENSION B(NDF,NLC)                                              00235110
      COMMON /SUPEL/ NSELEM,LEQN,NODESE,MATNO,NEADD,NSEL                00235120
      COMMON /AAA1/ A(8000)                                             R0235121
      COMMON /AAA2/ KFACTS(4),KDIAG(300),KHIGH(300)                     R0235122
      NT=27                                                             00235130
      REWIND NT                                                         00235140
  100 READ (NT,END=150) M,N,ND,LL                                       00235150
  110 CONTINUE                                                          00235160
      IF(M.NE.MATNO) GO TO 140                                          00235170
      IF(NSEL.GT.0.AND.N.NE.NSEL) GO TO 140                             00235180
      IF(ND.NE.NDF.OR.LL.NE.NLC) GO TO 120                              00235190
      GO TO 170                                                         00235200
  120 WRITE(6,130)M                                                     00235210
  130 FORMAT(///20X,20HSUPER ELEMENT MATRIX,I4,18H WAS FOUND BUT DID,   00235220
     $52H NOT HAVE THE CORRECT NO. OF DISPLACEMENTS OR LOADS.///)       00235230
  135 KSKIP=1                                                           00235240
      RETURN                                                            00235250
  140 READ (NT,END=150)                                                 00235260
      GO TO 100                                                         00235270
  150 WRITE(6,160)MATNO                                                 00235280
  160 FORMAT (//20X,6HMATRIX,I4,30H COULD NOT BE FOUND ON TAPE27.///)   00235290
      GO TO 135                                                         00235300
  170 READ (NT) B                                                       00235310
      DO 210 N=1,NBLKS                                                  00235320
CC    CALL EXPAND(AA,KSUM,N1)                                           00235330
       READ (4) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB)
       READ (4) (A(IR),IR=1,MLT)
      KS=KFACTS(3)                                                      00235340
      KE=KFACTS(4)                                                      00235350
      IF(KE.LE.LEQN) GO TO 200                                          00235360
      KSTART=LEQN+1                                                     00235370
      I=1                                                               00235380
      IF(KSTART.LT.KS) I=KS-LEQN                                        00235390
      IF(KSTART.LT.KS) KSTART=KS                                        00235400
      DO 190 K=KSTART,KE                                                00235410
      IF(I.GT.ND) GO TO 120                                             00235420
      KCOL=K-KS+1                                                       00235430
      KD=KDIAG(KCOL)                                                    00235440
      DO 180 LC=1,NLC                                                   00235450
  180 A(KD+LC)=B(I,LC)                                                  00235460
  190 I=I+1                                                             00235470
  200 CALL RDWRT(N2,AA,KSUM,1,INUM)                                     00235480
      IF(N.EQ.NBLKS) GO TO 210                                          00235490
      CALL RDWRT(N1,AA,KSUM,2,INUM)                                     00235500
      CALL RDWRT(N1,AA,KSUM,2,INUM)                                     00235510
  210 CONTINUE                                                          00235520
      CALL RDWRT(N2,AA,KSUM,6,INUM)                                     00235530
      RETURN                                                            00235540
      END                                                               00235550
      SUBROUTINE QVCOPY(FROM,TO,N)                                      00193850
      REAL*8 FROM,TO                                                    00193860
      DIMENSION FROM(1),TO(1)                                           00193870
      DO 100 I=1,N                                                      00193880
  100 TO(I)=FROM(I)                                                     00193890
      RETURN                                                            00193900
      END                                                               00193910
      SUBROUTINE INL(ID,B,TR,TMASS,NUMNP,NEQB,LL,MMA,ISL,NSLDM)         R0114820
      IMPLICIT REAL*8(A-H,O-Z)                                          00114830
      REAL*8  ID                                                        00114840
      LOGICAL ISLAVE                                                    00114850
      COMMON/FORCE/ NLC,NELD                                            R0114860
      COMMON /CG/ SCG(4),RRCG(2)                                        R0114870
      COMMON /AMB/ GRAV,REFT,JROT                                       R0114880
      DIMENSION ID(NUMNP,3),B(NEQB,LL),TR(6,LL),TMASS(NEQB,MMA)         R0114890
     1,ISL(NSLDM,4),XMAST(3),XSLAVE(3)                                  00114900
      COMMON / JUNK / R(6),TXM(6),RRJUNK(215)                           R0114910
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7)                       R0114920
      COMMON/SLVE/NSLAVE                                                00114930
CC    COMMON /AAA1/ TMASS(200,40)                                       R0114931
        CALL FILES(9)                                                   00114940
  100 FORMAT (10X,I5)                                                   00114950
      IF(NSLAVE.EQ.0) GO TO 105                                         00114960
      REWIND 30                                                         00114970
      READ(30)((ISL(I,J),J=1,4),I=1,NSLAVE)                             00114980
105   CONTINUE                                                          00114990
      NMWA=NEQB*MMA                                                     00115000
      ZER=0.0D0                                                         00115010
      NWDS=LL*NEQB                                                      00115020
      M=15                                                              00115030
      IF(NLC.LE.0)  GO TO 240                                           00115040
      NT=3                                                              00115050
      NWDSB=NWDS+NEQB*MMA                                               00115060
      CALL RDWRT(NT,B,1,6,INUM)                                         00115070
      REWIND 15                                                         00115080
      KSHF=0                                                            00115090
      CALL MEMSET (ZER,TMASS (1,1),NMWA)                                00115100
      CALL MEMSET (ZER, B(1,1),NWDS)                                    00115110
      NLAST=0                                                           00115120
      DO 230 NN=1,NUMNP                                                 00115130
      DO 110 I=1,6                                                      00115140
      TXM(I)=0.                                                         00115150
      DO 110 J=1,LL                                                     00115160
  110 TR(I,J)=0.0                                                       00115170
      IF(NN.EQ.1) GO TO 160                                             00115180
  120 IF(N.NE.NN) GO TO 180                                             00115190
      DO 150 I=1,6                                                      00115200
      IF(L.GT.0) GO TO 140                                              00115210
      IF(R(2).LE.0) R(2)=R(1)                                           00115220
      IF(R(3).LE.0) R(3)=R(1)                                           00115230
  130 TXM(I)=R(I)                                                       00115240
      IF(I.GT.3) GO TO 150                                              00115250
      CALL UNPKID(ID,NUMNP,W,CORD,1,N   ,I)                             00115260
      XMCG=TXM(I)                                                       00115270
      SCG(I)=SCG(I)+XMCG*CORD                                           00115280
      IF(I.EQ.1) SCG(4)=SCG(4)+XMCG                                     00115290
      GO TO 150                                                         00115300
  140 TR(I,L)=R(I)                                                      00115310
  150 CONTINUE                                                          00115320
  160 READ (M) N,L,R                                                    00115330
      IF (N.EQ.0) GO TO 120                                             00115340
      IF(N.LT.NLAST) WRITE(6,170)N                                      00115350
      IF(N.LT.NLAST) KSKIP=1                                            00115360
  170 FORMAT (/20X,  4HNODE,I5, 36HIS LESS THAN THE PREVIOUS NODE-ERROR/00115370
     $/)                                                                00115380
      NLAST=N                                                           00115390
      GO TO 120                                                         00115400
  180 CONTINUE                                                          00115410
      ISLAVE=.FALSE.                                                    00115420
      IF(NSLAVE.EQ.0)GO TO 1310                                         00115430
      DO 1300 I=1,6                                                     00115440
      IF(ISLAVE) GO TO 1195                                             00115450
      DO 1100 J=1,NSLAVE                                                00115460
      IF(NB.EQ.ISL(J,1)) ISLAVE=.TRUE.                                  00115470
      IF(ISLAVE) GO TO 1190                                             00115480
 1100 CONTINUE                                                          00115490
 1190 ISLV=J                                                            00115500
 1195 CONTINUE                                                          00115510
      IF(.NOT.ISLAVE) GO TO 1230                                        00115520
      K=I                                                               00115530
      IF(K.GT.3) K=K-3                                                  00115540
      ISLN=ISL(ISLV,K+1)                                                00115550
      IF(I.LE.3) ISLN=MOD(ISLN,10000)                                   00115560
      IF(I.GT.3) ISLN=ISLN/10000                                        00115570
      IF(ISLN.EQ.0) GO TO 1230                                          00115580
      DO 1200 J=1,3                                                     00115590
      CALL UNPKID(ID,NUMNP,W,XSLAVE(J),1,NB,J)                          00115600
      CALL UNPKID(ID,NUMNP,W,XMAST(J),1,ISLN,J)                         00115610
 1200 CONTINUE                                                          00115620
      XDIFF=XSLAVE(1)-XMAST(1)                                          00115630
      YDIFF=XSLAVE(2)-XMAST(2)                                          00115640
      ZDIFF=XSLAVE(3)-XMAST(3)                                          00115650
      DO 1220 J=1,LL                                                    00115660
      IF(I.EQ.4) TR(4,J)=TR(4,J)-TR(2,J)*ZDIFF+TR(3,J)*ZDIFF            00115670
      IF(I.EQ.5) TR(5,J)=TR(5,J)+TR(1,J)*ZDIFF-TR(3,J)*XDIFF            00115680
      IF(I.EQ.6) TR(6,J)=TR(6,J)-TR(1,J)*YDIFF+TR(2,J)*XDIFF            00115690
      IF(I.EQ.4) TXM(4)=TXM(2)*ZDIFF*ZDIFF+TXM(3)*YDIFF*YDIFF           00115700
      IF(I.EQ.5) TXM(5)=TXM(1)*ZDIFF*ZDIFF+TXM(3)*XDIFF*XDIFF           00115710
      IF(I.EQ.6) TXM(6)=TXM(1)*YDIFF*YDIFF+TXM(2)*XDIFF*XDIFF           00115720
 1220 CONTINUE                                                          00115730
 1230 CONTINUE                                                          00115740
 1300 CONTINUE                                                          00115750
 1310 CONTINUE                                                          00115760
      DO 220 J=1,6                                                      00115770
      IF (KSKIP.EQ.1) GO TO  230                                        00115780
      CALL UNPKID ( ID  ,NUMNP,W      ,WX      ,2,NN,J)                 00115790
      NNN=W                                                             00115800
      II=NNN-KSHF                                                       00115810
      IF(NNN.LE.0) GO TO 220                                            00115820
      IF(II.LE.0) GO TO 220                                             00115830
  190 DO 200  K=1,LL                                                    00115840
  200 B(II,K)=TR(J,K) +B(II,K)                                          00115850
      TMASS(II,1)=TMASS(II,1)+TXM(J)                                    00115860
  210 IF(II.NE.NEQB) GO TO 220                                          00115870
      CALL RDWRT(NT,B,NWDSB,1,INUM)                                     00115880
      KSHF=KSHF+NEQB                                                    00115890
      CALL MEMSET (ZER,TMASS (1,1),NMWA)                                00115900
      CALL MEMSET (ZER, B(1,1),NWDS)                                    00115910
  220 CONTINUE                                                          00115920
  230 CONTINUE                                                          00115930
  240 IF(SCG(4).LE.0.0) GO TO 270                                       00115940
      DO 250 I=1,3                                                      00115950
  250 SCG(I)=SCG(I)/SCG(4)                                              00115960
      SCG(4)=SCG(4)*GRAV                                                00115970
      IF(SCG(4).GT.0.0) WRITE(6,260)SCG                                 00115980
  260 FORMAT(1X ,19X, 49HTHE CENTER OF GRAVITY OF THE FINITE ELEMENT MOD00115990
     $EL,  7H IS AT,//30X,  4HX = ,F12.4,  8H  UNITS,                   00116000
     $                   /30X,  4HY = ,F12.4,  8H  UNITS,               00116010
     $                       /30X,  4HZ = ,F12.4,  8H  UNITS.           00116020
     $                //20X, 26HTHE TOTAL MODEL WEIGHT IS ,F25.5,  8H  U00116030
     $NITS.////)                                                        00116040
  270 IF(NLC.EQ.0) RETURN                                               00116050
      IF (KSKIP.EQ.1) GO TO  280                                        00116060
      CALL RDWRT(NT,B,NWDSB,1,INUM)                                     00116070
  280 RETURN                                                            00116080
  290 FORMAT (2I5,7F10.4)                                               00116090
  300 FORMAT (2I5,7F10.3)                                               00116100
  310 FORMAT (23H1.....NODAL POINT LOADS // 10H NODE LOAD,23X,          00116110
     $ 14HAPPLIED LOADS             / 10H  NO. CASE ,6X, 2HFX,8X,       00116120
     $  2HFY,8X,2HFZ,8X,2HMX,8X,2HMY,8X,2HMZ )                          00116130
      END                                                               00116140
      SUBROUTINE MEMSET (KONST,IARRAY,NWDS)                             00135760
      REAL*8 IARRAY, KONST                                              00135770
      DIMENSION IARRAY(1)                                               00135780
      DO 100 I=1,NWDS                                                   00135790
  100 IARRAY(I)=KONST                                                   00135800
      RETURN                                                            00135810
      END                                                               00135820
      SUBROUTINE ADDSTF(          A2,          NUMEL,NBLOCK,NE2B,LL,    R0011060
     $MBAND,NEQB,NEMN,ANORM,NVV,MMA)                                    00011070
      IMPLICIT REAL*8(A-H,O-Z)                                          00011080
      LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,GEOST                           00011090
      COMMON STIF(1)                                                    00011100
CC    DIMENSION A(NEQB,MBAND),  B(NEQB,LL), TMASS(NEQB,MMA)             R0011110
      DIMENSION A2(NEQB,MBAND)                                          R0011120
      DIMENSION ICOO(10),IFORM(4)                                       00011130
      COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH                              00011140
      COMMON/GEOSTF/GEOST,NELGEO                                        00011150
      COMMON/MASS/LMASS                                                 00011160
      COMMON /SQZ/ ISQZ,NRSQZ(5)                                        R0011170
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7)                       R0011180
      COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS                      R0011190
      COMMON /FORCE/ NLC,NELD                                           00011200
      COMMON/ELPAR/ XPAR(14),KDUM(9),KEQ,RRELPA(24)                     R0011210
      COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM,  00011220
     $NAT,NT,NOT,NRDYN2(9)                                              R0011230
      COMMON /AAA1/ A(150,53)                                           R0011231
      COMMON /AAA2/ TMASS(200,1),B(200,3),TMASS2(200,1),B2(200,3)       R0011232
      DATA ICOO / 3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097,00011240
     $            3H109/                                                00011250
      DATA IFORM(1),IFORM(3),IFORM(4)/4H(1H+,4HX,F7,4H.2) /             00011260
      KX(I,J,ND1)=MIN0(I,J)*(2*ND1+1-MIN0(I,J))/2-ND1+MAX0(I,J)+ND1     00011270
      ZER=0.0D0                                                         00011280
      NWDS=NEQB*(MBAND+LL)                                              00011290
      NWA=MBAND*NEQB                                                    00011300
      IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS=NWA                              00011310
      IF(NDYN.EQ.11.OR.NELGEO.EQ.1) NWDS=NWA                            00011320
      NWB=   LL*NEQB                                                    00011330
      NTA=4                                                             00011340
      REWIND 3                                                          00011350
      LLF=LL                                                            00011360
      IF(NELD.EQ.0) LLF=0                                               00011370
      NTD=9                                                             00011380
      NT1=2                                                             00011390
      NT2=10                                                            00011400
      K=NEQB+1                                                          00011410
      X=NBLOCK                                                          00011420
      NFLG=0                                                            00011430
      MB= DSQRT(X)                                                      00011460
      MB=MB/2+1                                                         00011470
      NEBB=MB*NE2B                                                      00011480
      MM=1                                                              00011490
      NSHIFT=0                                                          00011500
      NTB=3                                                             00011510
      NWDSB=NWB+NEQB*MMA                                                00011520
      CALL RDWRT(NTB,B,1,6,INUM)                                        00011530
      CALL RDWRT(NTA,A,1,6,INUM)                                        00011540
      ANORM=0.0                                                         00011550
      NDEG=0                                                            00011560
      AMIN=1.0D30                                                       00011570
      AMAX=-AMIN                                                        00011580
      NNZTRM=0                                                          00011590
      NVV=0                                                             00011600
      IF(NDYN.NE.7) GO TO 110                                           00011610
      TETA=1.4                                                          00011620
      DT1=TETA*DT                                                       00011630
      DT2=DT1*DT1                                                       00011640
      A0=(6.+3*ALFA*DT1)/(DT2+3*BETA*DT1)                               00011650
  110 CONTINUE                                                          00011660
      REWIND NTD                                                        00011670
      WRITE(6,115)                                                      00011680
  115 FORMAT(//,10X,48HTHE LAST NUMBER PRINTED IS THE PERCENT OF THE MA,00011690
     $       55HSTER STIFFNESS AND LOAD MATRICES THAT HAS BEEN ASSEMBLE,00011700
     $        2HD.,//)                                                  00011710
      ICO = 1                                                           00011720
CC    DO 117 IIR=1,NEQB
CC117 TMASS(IIR,1) = TMASS2(IIR,1)
      WRITE (6,2002) NLC,(TMASS(II,1),II=1,8)
 2002 FORMAT (5X,'*** NLC TMASS ***',I5,8E11.4/)
      DO 310 M=1,NBLOCK ,2                                              00011730
      NWA1 = 150*53                                                     R0011731
      CALL MEMSET (ZER,A2(1,1),NWA)                                     00011740
      CALL MEMSET (ZER, A(1,1),NWA1)                                    R0011750
      IF(NLC.GT.0) GO TO 120                                            00011760
      NMWA=NEQB*MMA                                                     00011770
      NMWA1=200                                                         R0011771
      NWB1=1200                                                         R0011772
      CALL MEMSET (ZER,TMASS2(1,1),NMWA)                                00011780
      CALL MEMSET (ZER,TMASS (1,1),NMWA1)                               R0011790
      CALL MEMSET (ZER,B2(1,1),NWB)                                     00011800
      CALL MEMSET (ZER, B(1,1),NWB1)                                    R0011810
      GO TO 130                                                         00011820
  120 CONTINUE                                                          00011830
      CALL RDWRT(NTB,B ,NWDSB,0,N)                                      00011840
      IF (M.EQ.NBLOCK) GO TO 130                                        00011850
      CALL RDWRT(NTB,B2,NWDSB,0,N)                                      00011860
  130 CONTINUE                                                          00011870
      CALL RDWRT(NT1,STIF,1,6,N)                                        00011880
      CALL RDWRT(NT2,STIF,1,6,N)                                        00011890
      NA=NT2                                                            00011900
      NUME=NUM7                                                         00011910
      IF (MM.NE.1) GO TO 140                                            00011920
      NA=NT1                                                            00011930
      NUME=NUMEL                                                        00011940
      NUM7 =0                                                           00011950
  140 DO 240 N=1,NUME                                                   00011960
      CALL RDWRT(NA,STIF,NEMN,0,KOUNT)                                  00011970
      ND1=STIF(KOUNT)                                                   00011980
      NTOT=(ND1*ND1-ND1)/2+ND1                                          00011990
      KSTXM=LLF*ND1+NTOT+ND1                                            00012000
      DO 210 I=1,ND1                                                    00012010
      LMN=1-STIF(I)                                                     00012020
      II=STIF(I)-NSHIFT                                                 00012030
      IF (II.LE.0.OR.II.GT.NE2B) GO TO 210                              00012040
      IF(II.GT.NEQB)GO TO 180                                           00012050
      IF(LMASS.EQ.1) GO TO 2120                                         00012060
      TMASS(II,1)=TMASS(II,1)+STIF(KSTXM+I)                             00012070
 2120 CONTINUE                                                          00012080
      IF(NELD.EQ.0) GO TO 155                                           00012090
      KSTP=NTOT+I                                                       00012100
      DO 150 L=1,LL                                                     00012110
      KSTP=KSTP+ND1                                                     00012120
  150 B(II,L)=B(II,L)+STIF(KSTP)                                        00012130
  155 CONTINUE                                                          00012140
      DO 170 J=1,ND1                                                    00012150
      JJ=STIF(J)+LMN                                                    00012160
      IF(JJ) 170,170,160                                                00012170
  160 KSTS=KX(I,J,ND1)                                                  00012180
      A(II,JJ)=A(II,JJ)+STIF(KSTS)                                      00012190
      IF(LMASS.NE.1) GO TO 170                                          00012200
      KSTM=KX(I,J,ND1)-ND1                                              00012210
      TMASS(II,JJ)=TMASS(II,JJ)+STIF(KSTXM+KSTM)                        00012220
  170 CONTINUE                                                          00012230
      GO TO 210                                                         00012240
  180 II=II-NEQB                                                        00012250
      IF(LMASS.EQ.1) GO TO 2130                                         00012260
      TMASS2(II,1)=TMASS2(II,1)+STIF(KSTXM+I)                           00012270
 2130 CONTINUE                                                          00012280
      IF(NELD.EQ.0) GO TO 195                                           00012290
      KSTP=NTOT+I                                                       00012300
      DO 190 L=1,LL                                                     00012310
      KSTP=KSTP+ND1                                                     00012320
  190 B2(II,L)=B2(II,L)+STIF(KSTP)                                      00012330
  195 CONTINUE                                                          00012340
      DO 200 J=1,ND1                                                    00012350
      JJ=STIF(J)+LMN                                                    00012360
      IF(JJ.LE.0) GO TO 200                                             00012370
      KSTS=KX(I,J,ND1)                                                  00012380
      A2(II,JJ)=A2(II,JJ)+STIF(KSTS)                                    00012390
      IF(LMASS.NE.1) GO TO 200                                          00012400
      KSTM=KX(I,J,ND1)-ND1                                              00012410
      TMASS2(II,JJ)=TMASS2(II,JJ)+STIF(KSTXM+KSTM)                      00012420
  200 CONTINUE                                                          00012430
  210 CONTINUE                                                          00012440
      IF (MM.GT.1) GO TO 240                                            00012450
      DO 220 I=1,ND1                                                    00012460
      II=STIF(I)-NSHIFT                                                 00012470
      IF(II.GT.NE2B.AND.II.LE.NEBB) GO TO 230                           00012480
  220 CONTINUE                                                          00012490
      GO TO 240                                                         00012500
  230 CALL RDWRT(NT2,STIF,KOUNT,1,I)                                    00012510
      NUM7=NUM7+1                                                       00012520
  240 CONTINUE                                                          00012530
      IF(NDYN.LT.4.OR.NDYN.GT.6) GO TO 260                              00012540
        IF(FRSHFT.EQ.0.)FRSHFT=-1.0                                     00012550
      IF(LMASS.EQ.1) GO TO 2150                                         00012560
       CALL QMR22(   FRSHFT,      NEQB,1,1,1)                           R0012570
      IF(M.NE.NBLOCK)CALL QMR2(A2,A2,FRSHFT,TMASS2,NEQB,                00012580
     11,1,1)                                                            00012590
      GO TO 2160                                                        00012600
 2150  CALL QMR3(A,A,FRSHFT,TMASS,NEQB,1,1,1,NWA)                       00012610
      IF(M.NE.NBLOCK)CALL QMR3(A2,A2,FRSHFT,TMASS2,NEQB,                00012620
     11,1,1,NWA)                                                        00012630
 2160 CONTINUE                                                          00012640
      DO 250 I=1,NEQB                                                   00012650
      D=A(I,1)                                                          00012660
      ANORM=ANORM+D                                                     00012670
      IF(D.NE.0.0) NDEG=NDEG+1                                          00012680
      IF(D.NE.0.0D0.AND.D.LT.AMIN)AMIN=D                                00012690
      IF(D.GT.AMAX) AMAX=D                                              00012700
      IF(D.EQ.0.0) A(I,1)=1.0E+20                                       00012710
      IF(TMASS(I,1).NE.0.) NVV=NVV+1                                    00012720
      DO 2162 KAPG=1,MBAND                                              00012730
      IF(A(I,KAPG).NE.0.0D0)NNZTRM=NNZTRM+1                             00012740
 2162 CONTINUE                                                          00012750
      IF(M.EQ.NBLOCK) GO TO 250                                         00012760
      D=A2(I,1)                                                         00012770
      ANORM=ANORM+D                                                     00012780
      IF(D.NE.0.0) NDEG=NDEG+1                                          00012790
      IF(D.NE.0.0D0.AND.D.LT.AMIN)AMIN=D                                00012800
      IF(D.GT.AMAX) AMAX=D                                              00012810
      IF(D.EQ.0.0)    A2(I,1)=1.0E+20                                   00012820
      IF(TMASS2(I,1).NE.0.0) NVV=NVV+1                                  00012830
      DO 2165 KAPG=1,MBAND                                              00012840
      IF(A2(I,KAPG).NE.0.0D0)NNZTRM=NNZTRM+1                            00012850
 2165 CONTINUE                                                          00012860
  250 CONTINUE                                                          00012870
  260 CONTINUE                                                          00012880
      IF(NDYN.NE.7) GO TO 290                                           00012890
      DO 270 I=1,NEQB                                                   00012900
  270 A(I,1)=A(I,1)+A0*TMASS(I,1)                                       00012910
      IF(M.EQ.NBLOCK) GO TO 290                                         00012920
      DO 280 I=1,NEQB                                                   00012930
  280 A2(I,1)=A2(I,1)+A0*TMASS2(I,1)                                    00012940
  290 CONTINUE                                                          00012950
      IF(.NOT.GENPRT) GO TO 1200                                        00012960
      WRITE(6,1500)M                                                    00012970
      DO 1020 I=1,NEQB                                                  00012980
      IF(GENPCH)WRITE(7,1510)(A(I,J),J=1,MBAND)                         00012990
 1020 WRITE(6,1520)(A(I,J),J=1,MBAND)                                   00013000
      WRITE(6,1530)                                                     00013010
      DO 1030 I=1,NEQB                                                  00013020
      IF(GENPCH) WRITE(7,1510)(B(I,J),J=1,LL)                           00013030
 1030 WRITE(6,1520)(B(I,J),J=1,LL)                                      00013040
      WRITE(6,1540)                                                     00013050
      IF(LMASS.EQ.1) GO TO 2170                                         00013060
      IF(GENPCH) WRITE(7,1510)(TMASS(I,1),I=1,NEQB)                     00013070
      WRITE(6,1520)(TMASS(I,1),I=1,NEQB)                                00013080
      GO TO 2190                                                        00013090
 2170 DO 2180 I=1,NEQB                                                  00013100
      IF(GENPCH) WRITE(7,1510)(TMASS(I,J),J=1,MBAND)                    00013110
 2180 WRITE(6,1520)(TMASS(I,J),J=1,MBAND)                               00013120
 2190 CONTINUE                                                          00013130
      IF(M.EQ.NBLOCK) GO TO 1200                                        00013140
      MP1=M+1                                                           00013150
      WRITE(6,1500)MP1                                                  00013160
      DO 1060 I=1,NEQB                                                  00013170
      IF(GENPCH)WRITE(7,1510)(A2(I,J),J=1,MBAND)                        00013180
 1060 WRITE(6,1520)(A2(I,J),J=1,MBAND)                                  00013190
      WRITE(6,1530)                                                     00013200
      DO 1070 I=1,NEQB                                                  00013210
      IF(GENPCH) WRITE(7,1510)(B2(I,J),J=1,LL)                          00013220
 1070 WRITE(6,1520)(B2(I,J),J=1,LL)                                     00013230
      WRITE(6,1540)                                                     00013240
      IF(LMASS.EQ.1) GO TO 2200                                         00013250
      IF(GENPCH) WRITE(7,1510)(TMASS2(I,1),I=1,NEQB)                    00013260
      WRITE(6,1520)(TMASS2(I,1),I=1,NEQB)                               00013270
      GO TO 1200                                                        00013280
 2200 DO 2210 I=1,NEQB                                                  00013290
      IF(GENPCH)WRITE(7,1510)(TMASS2(I,J),J=1,MBAND)                    00013300
 2210 WRITE(6,1520)(TMASS2(I,J),J=1,MBAND)                              00013310
 1200 CONTINUE                                                          00013320
      IF(MODEFR.GT.0) GO TO 247                                         00013330
      DO 246 I=1,NEQB                                                   00013340
      D=A(I,1)                                                          00013350
      IF(D.GT.0.0) GO TO 243                                            00013360
      NJ=NEQB*(M-1)+I                                                   00013370
      IF(NJ.GT.KEQ) GO TO 246                                           00013380
      NFLG=1                                                            00013390
      WRITE(6,242)NJ,D                                                  00013400
  242 FORMAT(/10X,9HEQUATION ,I5,26H HAS A SINGULAR DIAGONAL = ,E10.4)  00013410
      WRITE(6,115)                                                      00013420
      ICO=1                                                             00013430
  243 D=A2(I,1)                                                         00013440
      IF(D.GT.0.0) GO TO 246                                            00013450
      NJ=NEQB*M+I                                                       00013460
      IF(NJ.GT.KEQ) GO TO 246                                           00013470
      NFLG=1                                                            00013480
      WRITE(6,242)NJ,D                                                  00013490
  246 CONTINUE                                                          00013500
  247 CONTINUE                                                          00013510
      IF(NDYN.GT.0.AND.NDYN.LE.3) WRITE (NTD) ((TMASS(II,JJ),II=1,NEQB),R0013520
     $ JJ=1,MMA),((B(II,JJ),II=1,NEQB),JJ=1,LL)                         R0013521
      IF(NDYN.GT.3.AND.NDYN.LT.7) WRITE (NTD) ((TMASS(II,JJ),II=1,NEQB),R0013530
     $ JJ=1,MMA),(A(I,1),I=1,NEQB)                                      R0013531
      WRITE (6,8087) ((TMASS(II,JJ),II=1,NEQB),JJ=1,MMA)
 8087 FORMAT (1X,'**TMASS*',12E10.4/)
      IF(NDYN.EQ.7)WRITE (NTD) ((TMASS(II,JJ),II=1,NEQB),JJ=1,MMA)      R0013540
      IF(NDYN.EQ.11) WRITE(NTD) ((TMASS(II,JJ),II=1,NEQB),JJ=1,MMA),(A(IR0013550
     $ ,1),I=1,NEQB)                                                    R0013551
      IF(NDYN.EQ.11.OR.NELGEO.EQ.1) WRITE(3) ((B(I,J),I=1,NEQB),J=1,LL) R0013561
      IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS = MBAND * NEQB                   R0013561
      IF(NDYN.EQ.11.OR.NELGEO.EQ.1) NWDS = MBAND * NEQB                 R0013562
      WRITE (4) ((A(II,JJ),II=1,NEQB),JJ=1,MBAND)                       R0013570
CC    CALL SQEEZE(A ,NWDS,NTA,ISQZ)                                     00013570
      WRITE (6,3333) NEQB,MBAND,NWDS,ISQZ,NTA
 3333 FORMAT (1X,'*** NEQB MBAND NWDS ISQZ NTA ***',3X,5I5/)
      IF(M.EQ.NBLOCK) GO TO 310                                         00013580
      IF(NDYN.GT.0.AND.NDYN.LE.3) WRITE (NTD)((TMASS2(II,JJ),II=1,NEQB),R0013590
     $ JJ=1,MMA),((B2(II,JJ),II=1,NEQB),JJ=1,LL)                        R0013591
      IF(NDYN.GT.3.AND.NDYN.LT.7) WRITE (NTD)((TMASS2(II,JJ),II=1,NEQB),R0013600
     $ JJ=1,MMA),(A2(I,1),I=1,NEQB)                                     R0013601
      IF(NDYN.EQ.7)WRITE (NTD) ((TMASS2(II,JJ),II=1,NEQB),JJ=1,MMA)     R0013610
      IF(NDYN.EQ.11)WRITE(NTD) ((TMASS(II,JJ),II=1,NEQB),JJ=1,MMA),(A2(IR0013620
     $ ,1),I=1,NEQB)                                                    R0013621
      IF(NDYN.EQ.11.OR.NELGEO.EQ.1) WRITE(3) ((B2(I,J),I=1,NEQB),J=1,LL)R0013631
      IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS = MBAND * NEQB                   R0013631
      WRITE (4) ((A2(II,JJ),II=1,NEQB),JJ=1,MBAND)                      R0013640
CC    CALL SQEEZE(A2,NWDS,NTA,ISQZ)                                     00013640
      IF (MM.EQ.MB) MM=0                                                00013650
      MM=MM+1                                                           00013660
      PER=(M+1)*100.0/X                                                 00013670
      IFORM(2) = ICOO(ICO)                                              00013680
      WRITE(6,2003) PER                                                 R0013690
 2003 FORMAT (5X,F10.4/)                                                R0013691
      ICO = ICO + 1                                                     00013700
      IF ( ICO .LT. 11 ) GO TO 310                                      00013710
      WRITE(6,295)                                                      00013720
  295 FORMAT(1H )                                                       00013730
      ICO = 1                                                           00013740
  310 NSHIFT=NSHIFT+NE2B                                                00013750
      WRITE(6,320)                                                      00013760
  320 FORMAT(////20X,59(1H*)/20X,59HTHE MASTER STIFFNESS AND LOAD MATRIC00013770
     $ES HAVE BEEN ASSEMBLED./20X,59(1H*))                              00013780
      IF(NFLG.EQ.1) KSKIP=1                                             00013790
      IF(NDYN.LT.4.OR.NDYN.GT.6) RETURN                                 00013800
      IF(NDEG.GT.0) GO TO 340                                           00013810
      WRITE(6,330)                                                      00013820
  330 FORMAT (51H0STRUCTURE WITH NO DEGREES OF FREEDOM CHECK DATA     ) 00013830
      KSKIP=1                                                           00013840
      RETURN                                                            00013850
  340 IF(NDEG.GT.0) ANORM= (ANORM/NDEG)*1.0E-08                         00013860
      NTERM=NEQB*NBLOCK*MBAND                                           00013870
      PCT=100.0D0*DBLE  (NNZTRM)/DBLE  (NTERM)                          R0013880
      RATIO=1.0D30                                                      00013890
      IF(AMIN.NE.0D0) RATIO=AMAX/AMIN                                   00013900
      AAVG=ANORM*1.0D8                                                  00013910
      WRITE(6,1550)AMIN,AMAX,RATIO,AAVG,PCT                             00013920
      RETURN                                                            00013930
 1500 FORMAT(17H OVERALL MATRICES,1X,5HBLOCK,I3,//,                     00013940
     117H STIFFNESS MATRIX)                                             00013950
 1510 FORMAT((1P8E10.3))                                                00013960
 1520 FORMAT (  (1H ,1P10E13.4))                                        00013970
 1530 FORMAT(///,12H LOAD MATRIX)                                       00013980
 1540 FORMAT(///,12H MASS MATRIX)                                       00013990
 1550 FORMAT(5X,27HSTIFFNESS MATRIX PARAMETERS,//,                      00014000
     1 15X,34HMINIMUM NON-ZERO DIAGONAL ELEMENT=,1PD10.3,/,             00014010
     2 15X,34HMAXIMUM DIAGONAL ELEMENT         =,  D10.3,/,             00014020
     3 15X,34HMAXIMUM/MINIMUM                  =,  D10.3,/,             00014030
     4 15X,34HAVERAGE DIAGONAL ELEMENT         =,  D10.3,/,             00014040
     5 15X,34HDENSITY OF THE MATRIX            =,  D10.3)               00014050
      END                                                               00014060
      FUNCTION AGET(IIPOS)                                              00014070
      INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW           00014080
      DOUBLE PRECISION RGET,XX                                          00014090
      LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD                            00014100
      COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,                       00014110
     1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,                            00014120
     2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT                      00014130
      AGET = BLANK                                                      00014140
      IPOSIT = IIPOS                                                    00014150
      GO TO 500                                                         00014160
      ENTRY AGETW(AGE001)                                               00014170
      AGETW = BLANK                                                     00014180
      IPOSIT = 1                                                        00014190
      IF (.NOT.GETWRD(GET001).OR.LENGTH.EQ.0) RETURN                    00014200
      DO 450 ILOOP=BEGIN,80                                             00014210
      IF (LINE(ILOOP).EQ.ICOMMA) GO TO 460                              00014220
450   CONTINUE                                                          00014230
460   MAXSTR = ILOOP - BEGIN                                            00014240
500   IF (IPOSIT.GT.MAXSTR.OR.IPOSIT.LE.0) RETURN                       00014250
      IF ((BEGIN+IPOSIT-1).LE.80) AGET = LINE (BEGIN+IPOSIT-1)          00014260
      AGETW = AGET                                                      00014270
      RETURN                                                            00014280
      END                                                               00014290
      SUBROUTINE QMR3(C,D,FAC,B,N,JC,KC,JB,NWA)                         00186950
      IMPLICIT REAL*8(A-H,O-Z)                                          00186960
      DIMENSION B(1),C(1),D(1)                                          00186970
      MBAND=NWA/N                                                       00186980
      IB=1                                                              00186990
      IC=1                                                              00187000
      DO 100 I=1,N                                                      00187010
      DO 90 J=1,MBAND                                                   00187020
      KB=N*(J-1)+IB                                                     00187030
      KCC=N*(J-1)+IC                                                    00187040
      C(KCC)=D(KCC)-FAC*B(KB)                                           00187050
  90  CONTINUE                                                          00187060
      IB=IB+JB                                                          00187070
  100 IC=IC+JC                                                          00187080
  210 FORMAT(5X,10E10.3)                                                00187090
      RETURN                                                            00187100
      END                                                               00187110
      SUBROUTINE QVDOT1 (C,N1,B,N,JA,JB)                                R0193990
      REAL*8 A,B,C                                                      00194000
      COMMON /AAA1/ A(8000)                                             R0194001
      DIMENSION      B(1)                                               R0194010
      IA = N1                                                           R0194020
      IB=1                                                              00194030
      C=0.0                                                             00194040
      DO 100 I=1,N                                                      00194050
      C=C+A(IA)*B(IB)                                                   00194060
      IA=IA+JA                                                          00194070
  100 IB=IB+JB                                                          00194080
      RETURN                                                            00194090
      END                                                               00194100
      SUBROUTINE QVDOT(C,A,B,N,JA,JB)                                   00193990
      REAL*8 A,B,C                                                      00194000
      DIMENSION A(1),B(1)                                               00194010
      IA=1                                                              00194020
      IB=1                                                              00194030
      C=0.0                                                             00194040
      DO 100 I=1,N                                                      00194050
      C=C+A(IA)*B(IB)                                                   00194060
      IA=IA+JA                                                          00194070
  100 IB=IB+JB                                                          00194080
      RETURN                                                            00194090
      END                                                               00194100
