      PROGRAM SAP6P5                                                    R0001101
      IMPLICIT REAL*8(A-H,O-Z)                                          00001100
      LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,DEFPCH,GEOST                    00001110
      COMMON/BMDATA/IAISC,ILDTYP,ILDMUL,IBMSEC,NLWAVE,ILOCAL            00001120
      COMMON/EQUILB/NEQIL,NX43                                          00001130
      COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH                              00001140
      COMMON / JUNK / DUK(227)                                          00001150
      REAL*8  NPAR                                                      00001160
      COMMON /QTSARG/ QQQ(1000)                                         00001170
      COMMON/DYN3/ NEIG,NAD,ANORM,NVV,NFO                               00001180
      COMMON /DYN4/KDYN,NRESS,NCRD,NCWT,NRESS1                          00001190
      COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS                      00001200
       COMMON /TAPES/NSTIF,NRED,NL,NR,NT,NMASS                          00001210
      COMMON /EXTRA/MODEX,NT8,N10SV,NT10,KEQB,NY,T(10)                  00001220
      COMMON/GEOSTF/GEOST,NELGEO                                        00001230
      COMMON/MASS/LMASS                                                 00001240
      COMMON/MATL/MATLCO                                                R0001241
      COMMON/SIZE/NDMX,MXDF,NSMX,NTERM,NADND                            00001250
      COMMON/SLVE/NSLAVE                                                00001260
      COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00001270
     $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN                00001280
      COMMON / MISC / NBLOCK,NEQB,LL,NFREQ,LB                           00001290
      COMMON/AMB/ GRAV,REFT,JROT                                        00001300
      COMMON /PREP/ XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD                00001310
     $              ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC                   00001320
      COMMON /DYN/ IFIL1(11),IFIL2                                      00001330
      COMMON/ELARRY/NELAR(4,20)                                         00001340
      COMMON /ELTEMP/ SET1(103)                                         00001350
     $       /OUT/KSET2(6),KELRST,MAXDF,IFIL3(2)                        00001360
     $       /SQZ/    SET3,LIST,LISTC,LISTB,LISTA                       00001370
     $       /TRASH/  SET4(490)                                         00001380
     $       /GPS/    SET5(10)                                          00001390
     $       /CG/     SET6(4),RFIL1(2)                                  00001400
     $       /TAPES/ SET7(6)                                            00001410
     $       /DYN2/KSET8(3),NFVC,SET8(12)                               00001420
      COMMON /WORDS/ NWDS(30,2)                                         00001430
      COMMON /BAND/  NRNM(3),IRSK,IFIL4(4)                              00001440
      COMMON /HEADIN/TITLE1(20),TITLE2(5),TITLE3(10)                    00001450
      COMMON /SUPEL/ NSELEM,NEQL,NODESE                                 00001460
     $,KSET(3)                                                          00001470
      COMMON/FORCE/ NLC,NELD                                            00001480
        COMMON/DAPG/NQ1,NQX,DUMY(210)                                   00001490
      COMMON/VAXPLT/IVPLT,XVB(6),XVA(4),MINX,MINY,LEN                   00001500
      COMMON /ICM/ICOMP,MMRI,MTRI,M1P,M2P,M3P                           00001510
      COMMON/PLOTH/IPLT,IPLWRT                                          00001520
      COMMON/COMMT/NTYP,NNRRC,NNRRC1                                    R0001521
      COMMON/COMMT1/NDSSS,KDSSS,NTY,NSLDM,NBLANK,MDYN,NE2B,KRK1,MCB,MLT R0001522
      DIMENSION KZN(20),ZD(31)                                          00001530
      DIMENSION NEXPDT(2),NOWDTE(4)                                     00001540
      COMMON A(1)                                                       00001550
      DATA KZN/2,7,1,2,7,7,10,7,21,1177,6,51,10,21,9,7,8,5,0,0/         00001560
      DATA NEXPDT/78,222/                                               00001570
      WRITE (*,990)                                                     R0001611
  990 FORMAT (5X,'********** PROGRAM SAP6PC5 STARTING *********')       R0001612
      CALL SIZER5                                                       R0001612
      MTOTR = MTOT                                                      R0001613
      CALL COMMRW(1)                                                    R0001612
      MTOT  = MTOTR                                                     R0001613
      WRITE (6,1099) MTOT
 1099 FORMAT (5X,'**** MTOT IN SAP6PC5 ****',3X,I5/)
      IF (NNRRC .EQ. 330) GO TO 330                                     R0001613
      IF (NDYN .GT. 11) GO TO 330                                       R0001614
      IF (NDYN .EQ. 8)  GO TO 330                                       R0001617
      IF (MDYN .EQ. 5) GO TO 350                                        R0001621
      IF (MDYN .EQ. 6) GO TO 360                                        R0001622
      IF (MDYN .EQ. 7 .OR. MDYN .EQ. 13) GO TO 410                      R0001623
      IF (MDYN .EQ. 8) GO TO 460                                        R0001634
      IF (NDYN .LE.1 .AND. KSKIP .EQ. 1) GO TO 330                      R0001635
      IF (NDYN .NE. 11 .AND. NELGEO .NE. 1) GO TO 1410                  R0001636
      CALL ADDGEO(A(N1),A(NN2),A(NN3),A(NN4),A(NN5),A(NN6),NUMET,NBLOCK,00006140
     $NE2B,LL,MBAND,NEQB,NEMN,ANORM,NVV,MGA)                            00006150
      CALL SECOND(T(8))                                                 00006160
      TT1=T(5)                                                          00006170
      TT2=T(8)                                                          00006180
      DO 1340 I=5,7                                                     00006190
 1340 T(I)=T(I+1)-T(I)                                                  00006200
      T(8)=T(5)+T(6)+T(7)                                               00006210
      WRITE(6,560)(T(I),I=5,8)                                          00006220
      T(5)=TT1                                                          00006230
      T(6)=TT2                                                          00006240
      IF(NDYN.GT.3.AND.NDYN.LT.7) GO TO 1360                            00006250
      LMASS=1                                                           00006260
      NMASS=25                                                          00006270
      GO TO 355                                                         00006280
 1360 CONTINUE                                                          00006290
      IF(NDYN.EQ.4) GO TO 355                                           00006300
      IF(NDYN.EQ.5) GO TO 365                                           00006310
      IF(NDYN.EQ.6) GO TO 415                                           00006320
 1410 CONTINUE                                                          00006330
      IF(NDYN.EQ.2) CALL HISTRY                                         00006340
      IF(NDYN.EQ.3) CALL RESPEC                                         00006350
        IF(NDYN.EQ.10) CALL PASS                                        00006360
  330 CALL SECOND (T(7))                                                00006370
      DO 340 I=1,6                                                      00006380
  340 T(I)=T(I+1)-T(I)                                                  00006390
      T(7)=T(1)+T(2)+T(3)+T(4)+T(5)+T(6)                                00006400
      WRITE(6,520)(T(I),I=1,7)                                          00006410
      GO TO 500                                                         00006420
  350 T(6) = T(5)                                                       00006430
  355 CONTINUE                                                          00006440
        IF(KSKIP.EQ.0) CALL EIGEN                                       00006450
      CALL SECOND (T(7))                                                00006460
      T(8) = T(7)                                                       00006470
      T(9) = T(7)                                                       00006480
      T(10)= T(7)                                                       00006490
      GO TO 480                                                         00006500
  360 T(6) = T(5)                                                       00006510
  365 CONTINUE                                                          00006520
      IF(KDYN.LT.0) GO TO 370                                           00006530
      CALL EIGEN                                                        00006540
      CALL SECOND (T(7))                                                00006550
      KSKIP=MODEX                                                       00006560
      GO TO 400                                                         00006570
  370 DO 380 I=1,6                                                      00006580
  380 T(I+1)=T(I)                                                       00006590
      IF(NRESS.EQ.0) REWIND NCRD                                        00006600
      READ(NCRD)NEQ,NBLOCK,NEQB,MBAND,N1,NF,(QQQ(I),I=1,NF)             00006610
      NWW=NEQB*NF                                                       00006620
      CALL RDWRT(NCRD,A(N1),NF,14,I)                                    00006630
      CALL RDWRT(NT,A(N1),NF,6,I)                                       00006640
      CALL RDWRT(NT,A(N1),NF,13,I)                                      00006650
      DO 390 L=1,NBLOCK                                                 00006660
      CALL RDWRT(NCRD,A(N1),NWW,14,I)                                   00006670
      CALL RDWRT(NT,A(N1),NWW,13,I)                                     00006680
  390 CONTINUE                                                          00006690
      WRITE(6,395)NCRD,NF                                               00006700
  395 FORMAT(55H  A PREVIOUSLY GENERATED EIGEN-SOLUTIONS HAVE BEEN READ,00006710
     $8HOFF TAPE/                                                       00006720
     $       13H UNIT NUMBER=,I5/                                       00006730
     $       30H  NUMBER OF FREQUENCIES FOUND=,I5//)                    00006740
  400 CALL HISTRY                                                       00006750
      MODEX=KSKIP                                                       00006760
      CALL SECOND (T(8))                                                00006770
      T(9) = T(8)                                                       00006780
      T(10)= T(8)                                                       00006790
      GO TO 480                                                         00006800
  410 T(6) = T(5)                                                       00006810
  415 CONTINUE                                                          00006820
      IF(KDYN.LT.0) GO TO 420                                           00006830
        IF(KSKIP.EQ.0) CALL EIGEN                                       00006840
      CALL SECOND (T(7))                                                00006850
      T(8) = T(7)                                                       00006860
      KSKIP=MODEX                                                       00006870
      GO TO 450                                                         00006880
  420 DO 430 I=1,7                                                      00006890
  430 T(I+1)=T(I)                                                       00006900
      IF(NRESS.EQ.0) REWIND NCRD                                        00006910
      READ(NCRD)NEQ,NBLOCK,NEQB,MBAND,N1,NF,(QQQ(I),I=1,NF)             00006920
      NWW=NEQB*NF                                                       00006930
      CALL RDWRT(NCRD,A(N1),NF,14,I)                                    00006940
      CALL RDWRT(NT,A(N1),NF,6,I)                                       00006950
      CALL RDWRT(NT,A(N1),NF,13,I)                                      00006960
      DO 440 L=1,NBLOCK                                                 00006970
      CALL RDWRT(NCRD,A(N1),NWW,14,I)                                   00006980
      CALL RDWRT(NT,A(N1),NWW,13,I)                                     00006990
  440 CONTINUE                                                          00007000
      WRITE(6,395)NCRD,NF                                               00007010
450     CONTINUE                                                        00007020
        IF(NDSSS.EQ.6)CALL RESPEC                                       00007030
        IF(NDSSS.EQ.12)CALL FRFREQ                                      00007040
        MODEX=KSKIP                                                     00007050
      CALL SECOND (T(9))                                                00007060
      T(10)= T(9)                                                       00007070
      GO TO 480                                                         00007080
  460 DO 470 I=6,9                                                      00007090
  470 T(I) = T(5)                                                       00007100
      CALL STEP                                                         00007110
      CALL SECOND (T(10))                                               00007120
  480 TT = 0.0                                                          00007130
      DO 490 I=1,9                                                      00007140
      T(I) = T(I+1)-T(I)                                                00007150
      TT = TT + T(I)                                                    00007160
  490 CONTINUE                                                          00007170
        T(10)=0.                                                        00007180
        IF(NDSSS.EQ.12)T(10)=T(8)                                       00007190
        IF(NDSSS.EQ.12)T(8)=0.                                          00007200
      WRITE (6,530) (T(K),K=1,10),TT                                    00007210
      KSKIP=MODEX                                                       00007220
  500 CALL RDWRT(1,A(1),1,12,I)                                         00007230
      N1=1                                                              00007240
      NF=NFREQ                                                          00007250
      IF(NDYN.GT.0.AND.NDYN.LT.8) LL=NF                                 00007260
      N2=N1+NEQB*LL                                                     00007270
      N3=MAXDF*LL+MAXDF+2                                               00007280
      N4=N2+N3+10                                                       00007290
      LB=(MTOT-N4)/NEQ                                                  00007300
      IF(LB.GT.LL)  LB=LL                                               00007310
      N4=N2+NEQ*LB                                                      00007320
      N3=MTOT-N3-1+MAXDF+2                                              00007330
      IF(KELRST.EQ.1) GO TO 505                                         00007340
      CALL RECUVR (A(N1),A(N2),A(N4),A(N3),A(N1),LB,LL,NEQ,NEQB,NBLOCK, 00007350
     $MAXDF)                                                            00007360
  505 CONTINUE                                                          00007370
        KSKIP1=KSKIP                                                    00007380
      IF (KSKIP.EQ.0)KSKIP=10                                           00007390
CCR   IF(IPLT.NE.0) CALL SAPLOT(LL,NFREQ,MDYN,NEQB,NEQ,NBLOCK,IPLT      00007400
CCR  &,KSKIP1)                                                          00007410
      CALL COMMRW (0)                                                   R0007411
      WRITE (*,1095)                                                    R0007411
 1095 FORMAT (5X,'************ SAP6PC TOTILE FINISHED ***********')     R0007420
  520 FORMAT ( 12H1OVERALL LOG //                                       00007470
     $         33H  F.E. MODEL INPUT.............. ,F8.2//              00007480
     $         33H  FORM ELEMENT STIFFNESSES...... ,F8.2//              00007490
     $         33H  INPUT NODAL LOADS............. ,F8.2//              00007500
     $         33H  FORM TOTAL STIFFNESS.......... ,F8.2//              00007510
     $         33H  EQUATION SOLVING.............. ,F8.2//              00007520
     $         33H  PARTICULAR SOLUTION(ABOVE).... ,F8.2///             00007530
     $         33H  TOTAL SOLUTION TIME........... ,F8.2)               00007540
  530 FORMAT (1X ,31HO V E R A L L   T I M E   L O G, //                00007550
     $ 5X,30HF.E. MODEL INPUT             =, F8.2 /                     00007560
     $ 5X,30HELEMENT STIFFNESS FORMATION  =, F8.2 /                     00007570
     $ 5X,30HNODAL LOAD INPUT             =, F8.2 /                     00007580
     $ 5X,30HTOTAL STIFFNESS FORMATION    =, F8.2 /                     00007590
     $ 5X,30HSTATIC ANALYSIS              =, F8.2 /                     00007600
     $ 5X,30HEIGENVALUE EXTRACTION        =, F8.2 /                     00007610
     $ 5X,30HFORCED RESPONSE ANALYSIS     =, F8.2 /                     00007620
     $ 5X,30HRESPONSE SPECTRUM ANALYSIS   =, F8.2 /                     00007630
     $ 5X,30HSTEP-BY-STEP INTEGRATION     =, F8.2 /                     00007640
     &  5X,30HSINUSOIDAL FREQUENCY ANALYSIS=,F8.2//                     00007650
     $ 5X,30HTOTAL SOLUTION TIME          =, F8.2 /)                    00007660
  560 FORMAT( 25H1STATIC SOLUTION TIME LOG,//,                          00007730
     $ 5X,51HEQUATION SOLVING...................................,F8.2/, 00007740
     $ 5X,51HSTRESS AND ELEMENT GEOMETRIC MATRIX COMPUTATION....,F8.2/, 00007750
     $ 5X,51HFORM TOTAL GEOMETRIC STIFFNESS.....................,F8.2//,00007760
     $ 5X,51HTOTAL SOLUTION TIME (SUM OF THE ABOVE).............,F8.2//)00007770
      STOP                                                              R0007771
      END                                                               00007780
      SUBROUTINE SECOND(T)                                              00234270
      IMPLICIT REAL*8 (A-H,O-Z)                                         00234280
      CALL GETTIM(NA,NB,NC,ND)                                          R0234281
      AA = NA * 100.0                                                   R0234282
      CC = NC                                                           R0234283
      CC = CC / 100.0                                                   R0234284
      T  = AA + NB + CC                                                 R0234285
      RETURN                                                            00234300
      END                                                               R0234286
      SUBROUTINE ERROR(I)                                               00086230
      IMPLICIT REAL*8(A-H,O-Z)                                          00086240
      REAL*8  X                                                         00086250
      COMMON /EXTRA/ MODEX,NREXTR(25)                                   R0086260
      COMMON /PREP/ X(2),KSKIP,RRPREP(8)                                R0086270
      KSKIP=1                                                           00086280
      MODEX=1                                                           00086290
      WRITE(6,100)I                                                     00086300
  100 FORMAT (1H0//1X,30HALLOCATED STORAGE EXCEEDED BY   ,I7,6H WORDS)  00086310
      WRITE(6,110)                                                      00086320
  110 FORMAT(/1X, 29HNO EXECUTION WILL BE ALLOWED./)                    00086330
      RETURN                                                            00086340
      END                                                               00086350
      SUBROUTINE RDWRT(JT,A,NUM,N,J)                                    00199630
      IMPLICIT REAL*8(A-H,O-Z)                                          00199640
      REAL*8 A                                                          00199650
      COMMON /WORDS/ NWDS(30,2)                                         00199660
      DIMENSION A(NUM)                                                  00199670
      DIMENSION IUNIT(41)                                               00199680
      DATA                                                              00199690
     $    IUNIT/21,22,23,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,     00199700
     $20,1,62,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41/ R0199710
      NT=IUNIT(JT)                                                      00199720
      K=N+1                                                             00199730
      LNTRC=NUM*8                                                       00199740
      GO TO (100,110,120,130,230,140,150,                               00199750
     $230,230,230,230,                                                  00199760
     $160,180,210,220),K                                                00199770
  100 CONTINUE
CC    WRITE (6,109) NT,J,K,JT,N
C109  FORMAT (5X,'****** NT,J,K,JT,N  ******* =', 5I5)
      READ (NT) J                                                       R0199780
      CALL RDA(NT,A,J)                                                  00199790
      RETURN                                                            00199800
 110  CONTINUE                                                          R0199801
CC    WRITE (6,1009) NT,J,K,JT,N,NUM
C1009 FORMAT (5X,'****** WRITE (NT,J,K,JT,N) ******* =', 6I5)
      WRITE (NT) NUM                                                    R0199810
      WRITE (NT) A                                                      00199820
      NWDS(NT,1)=NWDS(NT,1)+NUM                                         00199830
      RETURN                                                            00199840
  120 CONTINUE                                                          R0199841
CC    WRITE (6,1008) NT,J,K,JT,N
C1008 FORMAT (5X,'****** BACKSPACE (NT,J,K,JT,N) ******* =', 5I5)
      BACKSPACE NT                                                      R0199850
      BACKSPACE NT                                                      00199860
      RETURN                                                            00199870
  130 READ (NT)                                                         00199880
      READ (NT)                                                         00199890
      RETURN                                                            00199900
  140 READ (NT) J,A                                                     00199910
      RETURN                                                            00199920
  150 REWIND NT                                                         00199930
      IF(NWDS(NT,1).GT.NWDS(NT,2)) NWDS(NT,2)=NWDS(NT,1)                00199940
         NWDS(NT,1)=0                                                   00199950
      RETURN                                                            00199960
  160 DO 170 I=1,20                                                     00199970
      DO 170 J=1,2                                                      00199980
  170 NWDS(I,J)=0                                                       00199990
      RETURN                                                            00200000
  180 DO 200 I=1,20                                                     00200010
      J=NWDS(I,1)                                                       00200020
      IF(NWDS(I,2).GT.J) J=NWDS(I,2)                                    00200030
      IF(J.GT.0) WRITE(6,190)I,J                                        00200040
  190 FORMAT(//20X,13HDISK FILE NO.,I3,25H  WAS REQUIRED TO STORE A,    00200050
     $12H  MAXIMUM OF,1X,I9,18H WORDS OF STORAGE./)                     00200060
  200 CONTINUE                                                          00200070
      RETURN                                                            00200080
  210 WRITE(NT) A                                                       00200090
      NWDS(NT,1)=NWDS(NT,1)+NUM                                         00200100
      RETURN                                                            00200110
 220  READ(NT)A                                                         00200120
  230 RETURN                                                            00200130
      END                                                               00200140
      SUBROUTINE  RDA(NT,A,NUM)                                         00196460
      REAL*8 A                                                          00196470
      DIMENSION A(NUM)                                                  00196480
      READ (NT) A                                                       00196490
      RETURN                                                            00196500
      END                                                               00196510
      SUBROUTINE FILES(NN)
      RETURN
      END
      BLOCKDATA                                                         00007790
      IMPLICIT REAL*8(A-H,O-Z)                                          00007800
        COMMON/HEADIN/TITLE1(20),TITLE2(5),TITLE3(10)                   00007810
      COMMON/ELARRY/NELAR(4,20)                                         00007820
      COMMON /GASS/ XK(4,4),WGT(4,4),IPERM(3)                           00007830
      COMMON/GASS2/A5(7,2),W5(7)                                        00007840
      COMMON /PREP/XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD                 00007850
     1,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC                                 00007860
      DATA XK /     0.D0,     0.D0,               0.D0,            0.D0,00007870
     $ -.5773502691896D0, .5773502691896D0,     0.D0,              0.D0,00007880
     $ -.7745966692415D0, .0000000000000D0, .7745966692415D0,      0.D0,00007890
     $ -.8611363115941D0,-.3399810435849D0, .3399810435849D0,           00007900
     $.8611363115941D0/                                                 00007910
      DATA WGT / 2.000D0,     0.D0,          0.D0,           0.D0,      00007920
     $ 1.0000000000000D0,1.0000000000000D0,  0.D0,           0.D0,      00007930
     $  .5555555555556D0, .8888888888889D0, .5555555555556D0,0.D0,      00007940
     $  .3478548451375D0, .6521451548625D0, .6521451548625D0,           00007950
     $  .3478548451375D0/                                               00007960
      DATA IPERM / 2,3,1 /                                              00007970
      DATA  A5(1,1)/-0.333333333333D0/,A5(2,1)/-0.88056825640D0/        00007980
      DATA  A5(3,1)/-0.05971587178D0/,A5(4,1)/-0.05971587178D0/         00007990
      DATA  A5(5,1)/ 0.59485397070D0/, A5(6,1)/-0.79742698530D0/        00008000
      DATA  A5(7,1)/-0.79742698530D0/, A5(1,2)/-0.333333333333D0/       00008010
      DATA  A5(2,2)/-0.05971587178D0/, A5(3,2)/-0.88076825640D0/        00008020
      DATA  A5(4,2)/-0.05971587178D0/ ,A5(5,2)/-0.79742698530D0/        00008030
      DATA  A5(6,2)/ 0.59485397070D0/ ,A5(7,2)/-0.79742698530D0/        00008040
      DATA    W5(1)/ 0.225        D0/,  W5(2)/ 0.13239415   D0/         00008050
      DATA    W5(3)/ 0.13239415   D0/,  W5(4)/ 0.13239415   D0/         00008060
      DATA    W5(5)/ 0.12593918   D0/,  W5(6)/ 0.12593918   D0/         00008070
      DATA    W5(7)/ 0.12593918   D0/                                   00008080
      DATA NELAR /                                                      00008090
     $   2,   2,   6,   2,                                              00008100
     $   3,   2,  12,  28,                                              00008110
     $   4,   4,  12,   8,                                              00008120
     $   4,   4,   8,   4,                                              00008130
     $   8,   8,  33,  54,                                              00008140
     $   4,   4,  42,  24,                                              00008150
     $   1,   1,   1,   1,                                              00008160
     $   4,   4,   8,   4,                                              00008170
     $   3,   2,  12,  39,                                              00008180
     $  20,  20,  60,  54,                                              00008190
     $   8,   8,  16,  52,                                              00008200
     $   8,   8,  16,  52,                                              00008210
     $   8,   8,  16,  52,                                              00008220
     $   4,   1,   6,   6,                                              00008230
     $   8,   8,  48,   6,                                              00008240
     $   20*0/                                                          00008250
      DATA TITLE2/4H    ,4HSAP6,4H    ,4HVER.,4H 2.0/                   00008260
      DATA TITLE3(3)/4H LPI/,TITLE3(4)/4HAUTO/,TITLE3(5)/54./           00008330
      DATA POS/3H   /,PRTCOD/3H   /                                     00008340
      DATA POSSAV/3H   /,PRTOFF/3HOFF/,PRTON/3HON-/,PRTDUM/3HDUM/       00008350
      DATA IDIRC/0/                                                     00008360
      END                                                               00008370
      SUBROUTINE RECUVR(B,D,SA,DISP,DISP2,LB,LL,NEQ,NEQB,NBLKS,MAXDF)   00200150
      IMPLICIT REAL*8(A-H,O-Z)                                          00200160
       DIMENSION D(NEQ,LB),B(NEQB,LL)                                   00200170
     &,SA(1),DISP(1),DISP2(1),IU(11)                                    00200180
      COMMON /PREP/XZ(2),KSKIP,NDYN,NRPREP(15)                          R0200190
      COMMON /ELPAR/ XP(14),IDUM(15),NUMEL,NUMEL2,NRELPA(41)            R0200200
      COMMON /SUPEL/NSELEM,NRSUPE(5)                                    R0200210
      DATA IU/15,10,-1, 2,10,-1, 2,-1,-1,15,2/                          00200220
        CALL FILES(6)                                                   00200230
      IF(KSKIP.EQ.1) RETURN                                             00200240
      IF(NSELEM.LE.0) RETURN                                            00200250
      NT=IU(NDYN+1)                                                     00200260
      IF(NT.LE.0) RETURN                                                00200270
      NUMET=NUMEL+NUMEL2                                                00200280
      NEMN=MAXDF+2                                                      00200290
      NT1=1                                                             00200300
      N18=18                                                            00200310
      N17=17                                                            00200320
      N27=27                                                            00200330
      N1=N18                                                            00200340
      N2=N17                                                            00200350
      LH=0                                                              00200360
      MT=(LL-1)/LB+1                                                    00200370
      REWIND N1                                                         00200380
      REWIND N2                                                         00200390
      REWIND NT                                                         00200400
      DO 190 II=1,MT                                                    00200410
      LT=LH+1                                                           00200420
      LLT=1-LT                                                          00200430
      LH=LT+LB-1                                                        00200440
      IF(LH.GT.LL) LH=LL                                                00200450
      IF(NT.EQ.15) GO TO 120                                            00200460
      REWIND NT                                                         00200470
      NQ=NEQB*NBLKS                                                     00200480
      NWRDS=LL*4                                                        00200490
      READ (NT)                                                         00200500
      DO 110 NN=1,NBLKS                                                 00200510
      READ (NT) B                                                       00200520
      N=NEQB                                                            00200530
      IF(NN.EQ.1) N=NEQ-NQ+NEQB                                         00200540
      NQ=NQ-NEQB                                                        00200550
      DO 110 J=1,N                                                      00200560
      I=NQ+J                                                            00200570
      DO 110 L=LT,LH                                                    00200580
      K=LLT+L                                                           00200590
  110 D(I,K)=B(J,L)                                                     00200600
      GO TO 140                                                         00200610
  120 DO 130 L=LT,LH                                                    00200620
      K=L+LLT                                                           00200630
  130 READ(NT) (D(I,K),I=1,NEQ)                                         00200640
  140 CALL RDWRT(NT1,SA,1,6,J)                                          00200650
      DO 150 I=1,NUMET                                                  00200660
  150 CALL RDWRT(NT1,SA,1,3,KOUNT)                                      00200670
      DO 180 I=1,NSELEM                                                 00200680
      IF(II.EQ.1) GO TO 160                                             00200690
      READ (N1)M,N,ND,LX                                                00200700
      NWD=ND*LX                                                         00200710
      READ (N1) (DISP(J),J=1,NWD)                                       00200720
  160 CONTINUE                                                          00200730
      CALL RDWRT(NT1,SA,NEMN,0,KOUNT)                                   00200740
      ND=SA(KOUNT)                                                      00200750
      M= SA(KOUNT-1)                                                    00200760
      DO 170 J=1,ND                                                     00200770
      JJ=SA(J)                                                          00200780
      DO 170 L=LT,LH                                                    00200790
      K=L+LLT                                                           00200800
      NWD=J+ND*(L-1)                                                    00200810
  170 DISP(NWD)=D(JJ,K)                                                 00200820
      WRITE (N2) M,I,ND,LL                                              00200830
      NWD=ND*LL                                                         00200840
      WRITE (N2)  (DISP(N),N=1,NWD)                                     00200850
  180 CONTINUE                                                          00200860
      IF(II.EQ.MT) GO TO 190                                            00200870
      REWIND N1                                                         00200880
      REWIND N2                                                         00200890
      LX=N1                                                             00200900
      N1=N2                                                             00200910
      N2=LX                                                             00200920
  190 CONTINUE                                                          00200930
      REWIND N27                                                        00200940
      NEL=0                                                             00200950
  200 READ (N27,END=220) M,N,ND,LX                                      00200960
  210 IF(M.LE.0) GO TO 220                                              00200970
      NEL=NEL+1                                                         00200980
      WRITE(N2) M,N,ND,LX                                               00200990
      NWD=ND*LX                                                         00201000
      READ (N27)  (DISP2(J),J=1,NWD)                                    00201010
      WRITE(N2)   (DISP2(J),J=1,NWD)                                    00201020
      GO TO 200                                                         00201030
  220 REWIND N27                                                        00201040
      REWIND N2                                                         00201050
      IF(NEL.EQ.0) GO TO 240                                            00201060
      DO 230 I=1,NEL                                                    00201070
      READ (N2) M,N,ND,LX                                               00201080
      WRITE(N27)M,N,ND,LX                                               00201090
      NWD=ND*LX                                                         00201100
      READ (N2)   (DISP2(J),J=1,NWD)                                    00201110
  230 WRITE(N27)  (DISP2(J),J=1,NWD)                                    00201120
  240 DO 250 I=1,NSELEM                                                 00201130
      READ (N2) M,N,ND,LX                                               00201140
      WRITE(N27)M,N,ND,LX                                               00201150
      NWD=ND*LX                                                         00201160
      READ (N2)   (DISP2(J),J=1,NWD)                                    00201170
  250 WRITE(N27)  (DISP2(J),J=1,NWD)                                    00201180
      RETURN                                                            00201190
      END                                                               00201200
      SUBROUTINE UNPKID(ID,NUMNP,X,COORD,MODE,N,IDOF)                   00317660
      IMPLICIT REAL*8 (A-H ,O-Z)                                        00317670
      REAL*8  ID                                                        00317680
      DIMENSION ID(NUMNP,3)                                             00317690
      COMMON /PREP/XMX,XAD,J1(2),I1,RRPREP(7)                           R0317700
      GO TO (100,110),MODE                                              00317710
  100 X=ID(N,IDOF)                                                      00317720
      K=X                                                               00317730
      IF(X.LT.0.0) K=K-1                                                00317740
      COORD=(X-K-XAD)*XMX                                               00317750
      RETURN                                                            00317760
  110 JJ=IDOF                                                           00317770
      IF(IDOF.GE.4) GO TO 120                                           00317780
      NNN=ID(N,JJ)                                                      00317790
      IF(NNN.LT.0) GO TO 115                                            00317800
      NNN= MOD(NNN,I1)                                                  00317810
      GO TO 117                                                         00317820
  115 CONTINUE                                                          00317830
      IF(IABS(NNN).GT.I1) GO TO 116                                     00317840
      NNN=MOD(NNN,I1)                                                   00317850
      IF(NNN.LT.0) NNN=0                                                00317860
      GO TO 117                                                         00317870
  116 NNN=1-NNN                                                         00317880
      NNN=MOD(NNN,I1)                                                   00317890
      GO TO 117                                                         00317900
  117 X=NNN                                                             00317910
      RETURN                                                            00317920
  120 JJ=JJ-3                                                           00317930
      NNN=ID(N,JJ)                                                      00317940
                                                                        00317950
      IF(NNN.GE.0) GO TO 130                                            00317960
      IF(IABS(NNN).LT.I1) GO TO 130                                     00317970
      NN2=NNN/I1                                                        00317980
      NNN=-NN2                                                          00317990
      GO TO 140                                                         00318000
  130 CONTINUE                                                          00318010
      NN2=MOD(NNN,I1)                                                   00318020
      NNN=NNN/I1                                                        00318030
      IF(NNN.GT.0) NNN=NNN+NN2                                          00318040
      IF(NN2.LT.0) NNN=1-NN2                                            00318050
  140 CONTINUE                                                          00318060
      X=NNN                                                             00318070
      RETURN                                                            00318080
      END                                                               00318090
      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 QMR2(C,D,FAC,B,N,JC,KC,JB)                             00186840
      IMPLICIT REAL*8(A-H,O-Z)                                          00186850
      DIMENSION B(1),C(1),D(1)                                          00186860
      IB=1                                                              00186870
      IC=1                                                              00186880
      DO 100 I=1,N                                                      00186890
      C(IC)=D(IC)-FAC*B(IB)                                             00186900
      IB=IB+JB                                                          00186910
  100 IC=IC+JC                                                          00186920
      RETURN                                                            00186930
      END                                                               00186940
      SUBROUTINE QVSET(C,AAB,N)                                         00194580
      IMPLICIT REAL*8 (A-H,O-Z)                                         R0194581
      REAL*8 C,AAB                                                      00194590
      DIMENSION AAB(N)                                                  00194600
      DO 100 I=1,N                                                      00194610
      AAB(I)=C                                                          00194620
  100 CONTINUE                                                          R0194621
      RETURN                                                            00194630
      END                                                               00194640
      SUBROUTINE SQEEZE(A,NUM,NT,KOD)                                   00254540
      IMPLICIT REAL*8(A-H,O-Z)                                          00254550
      REAL*8  A                                                         00254560
      DIMENSION A(1)                                                    00254570
      IF(KOD.GT.0) GO TO 100                                            00254580
      CALL  SQISH(A,NUM,N)                                              00254590
      CALL RDWRT(NT,A,N,1,K)                                            00254600
      RETURN                                                            00254610
  100 CALL RDWRT(NT,A,NUM,1,K)                                          00254620
      RETURN                                                            00254630
      END                                                               00254640
      SUBROUTINE EXPAND(A,NUM,NT)                                       00086360
      IMPLICIT REAL*8(A-H,O-Z)                                          00086370
      REAL*8  A                                                         00086380
      DIMENSION A(1)                                                    00086390
      CALL RDWRT(NT,A,NUM,0,J)                                          00086400
      IF(J.EQ.NUM) RETURN                                               00086410
      RETURN                                                            00086420
      END                                                               00086430
      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 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
      SUBROUTINE QVMPY1(A,B,C,N,INCA,INCB,INCC)                         00194240
      IMPLICIT REAL*8(A-H,O-Z)                                          00194250
      DIMENSION A(1),B(1)                                               00194260
      JA=1                                                              00194270
      JB=1                                                              00194280
      DO 100 I=1,N                                                      00194290
      A(JA)=B(JB)*C                                                     00194300
      JA=JA+INCA                                                        00194310
  100 JB=JB+INCB                                                        00194320
      RETURN                                                            00194330
      END                                                               00194340
      SUBROUTINE MEMOVE (IFROM,ITO,NWDS)                                00135690
      REAL*8 IFROM, ITO                                                 00135700
      DIMENSION IFROM(1),ITO(1)                                         00135710
      DO 100 I=1,NWDS                                                   00135720
  100 ITO(I)=IFROM(I)                                                   00135730
      RETURN                                                            00135740
      END                                                               00135750
      FUNCTION GETWRD(GET001)                                           00105400
      INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW           00105410
      LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD,IGET,RGET,ERR1             00105420
      COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,                       00105430
     1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,                            00105440
     2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT                      00105450
      GETWRD = .FALSE.                                                  00105460
      LENGTH = 0                                                        00105470
      IF (EOL) RETURN                                                   00105480
      DO 100 BEGIN = POINT,80                                           00105490
      IF (LINE(BEGIN).NE.BLANK) GO TO 110                               00105500
100   CONTINUE                                                          00105510
      EOL = .TRUE.                                                      00105520
      POINT = 80                                                        00105530
      RETURN                                                            00105540
110   DO 170 POINT = BEGIN,80                                           00105550
      IF (LINE(POINT).EQ.BLANK.OR.LINE(POINT).EQ.ICOMMA)                00105560
     1GO TO 180                                                         00105570
      LENGTH = POINT - BEGIN + 1                                        00105580
      MAXSTR = LENGTH                                                   00105590
170   CONTINUE                                                          00105600
      GETWRD = .TRUE.                                                   00105610
      EOL = .TRUE.                                                      00105620
      RETURN                                                            00105630
180   IP = POINT                                                        00105640
      DO 200 POINT = POINT,80                                           00105650
      IF (LINE(POINT).EQ.ICOMMA) GO TO 210                              00105660
      IF (LINE(POINT).NE.BLANK) GO TO 190                               00105670
200   CONTINUE                                                          00105680
      GETWRD = .TRUE.                                                   00105690
      EOL =.TRUE.                                                       00105700
      RETURN                                                            00105710
190   POINT = IP                                                        00105720
      GETWRD = .TRUE.                                                   00105730
      RETURN                                                            00105740
210   POINT = POINT + 1                                                 00105750
      GETWRD = .TRUE.                                                   00105760
      RETURN                                                            00105770
      END                                                               00105780
      SUBROUTINE ADDGEO(A,B,TMASS,A2,B2,TMASS2,NUMEL,NBLOCK,NE2B,LL,    00008380
     $MBAND,NEQB,NEMN,ANORM,NVV,MMA)                                    00008390
      IMPLICIT REAL*8(A-H,O-Z)                                                  
      LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,GEOST                           00008410
      COMMON STIF(1)                                                    00008420
      DIMENSION  A(NEQB,MBAND), B(NEQB,LL), TMASS(NEQB,MMA)             00008430
      DIMENSION A2(NEQB,MBAND),B2(NEQB,LL),TMASS2(NEQB,MMA)             00008440
      DIMENSION ICOO(10),IFORM(4)                                       00008450
      COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH                              00008460
      COMMON/MASS/LMASS                                                 00008470
      COMMON /SQZ/ ISQZ,NRSQZ(5)                                        R0008480
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7)                       R0008490
      COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS                      R0008500
      COMMON /FORCE/ NLC,NELD                                           00008510
      COMMON/GEOSTF/GEOST,NELGEO                                        00008520
      COMMON/ELPAR/ XPAR(14),KDUM(9),KEQ,RRELPA(24)                     R0008530
      COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM,  00008540
     $NAT,NT,NOT,NRDYN2(9)                                              R0008550
      DATA ICOO / 3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097,00008560
     $            3H109/                                                00008570
      DATA IFORM(1),IFORM(3),IFORM(4)/4H(1H+,4HX,F7,4H.2) /             00008580
      KX(I,J,ND1)=MIN0(I,J)*(2*ND1+1-MIN0(I,J))/2-ND1+MAX0(I,J)+ND1     00008590
      ZER=0.0D0                                                         00008600
      NWDS=NEQB*(MBAND+LL)                                              00008610
      NWA=MBAND*NEQB                                                    00008620
      IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS=NWA                              00008630
      IF(NDYN.EQ.11.OR.NELGEO.EQ.1) NWDS=NWA                            00008640
      NWB=   LL*NEQB                                                    00008650
      NTA=4                                                             00008660
      LLF=LL                                                            00008670
      IF(NELD.EQ.0) LLF=0                                               00008680
      NTD=25                                                            00008690
      NT1=41                                                            00008700
      NT2=10                                                            00008710
      K=NEQB+1                                                          00008720
      X=NBLOCK                                                          00008730
      NFLG=0                                                            00008740
CC    WRITE(6,100)                                                      00008750
CC100 FORMAT (1H1)                                                      00008760
      MB= DSQRT(X)                                                      00008770
      MB=MB/2+1                                                         00008780
      NEBB=MB*NE2B                                                      00008790
      MM=1                                                              00008800
      NSHIFT=0                                                          00008810
      AMIN=1.0D30                                                       00008820
      AMAX=-AMIN                                                        00008830
      NTB=18                                                            00008840
      NWDSB=NWB+NEQB                                                    00008850
      CALL RDWRT(NTB,B,1,6,INUM)                                        00008860
      CALL RDWRT(NTA,A,1,6,INUM)                                        00008870
      ANORM=0.0                                                         00008880
      NDEG=0                                                            00008890
      NVV=0                                                             00008900
      IF(NDYN.NE.7) GO TO 110                                           00008910
      TETA=1.4                                                          00008920
      DT1=TETA*DT                                                       00008930
      DT2=DT1*DT1                                                       00008940
      A0=(6.+3*ALFA*DT1)/(DT2+3*BETA*DT1)                               00008950
  110 CONTINUE                                                          00008960
      REWIND NTD                                                        00008970
      WRITE(6,115)                                                      00008980
  115 FORMAT(//,10X,48HTHE LAST NUMBER PRINTED IS THE PERCENT OF THE MA,00008990
     $       55HSTER (CONVENTIONAL AND GEOMETRIC) STIFFNESS AND LOAD MA,00009000
     $        6HTRICES,/,10X,42X,24HTHAT HAS BEEN ASSEMBLED.,//)        00009010
      ICO = 1                                                           00009020
      DO 310 M=1,NBLOCK ,2                                              00009030
      CALL MEMSET (ZER,A2(1,1),NWA)                                     00009040
      CALL MEMSET (ZER, A(1,1),NWA)                                     00009050
      NMWA=NEQB*MMA                                                     00009060
      CALL MEMSET (ZER,TMASS2(1,1),NMWA)                                00009070
      CALL MEMSET (ZER,TMASS (1,1),NMWA)                                00009080
      CALL MEMSET (ZER,B2(1,1),NWB)                                     00009090
      CALL MEMSET (ZER, B(1,1),NWB)                                     00009100
      CALL RDWRT(NT1,STIF,1,6,N)                                        00009110
      CALL RDWRT(NT2,STIF,1,6,N)                                        00009120
      NA=NT2                                                            00009130
      NUME=NUM7                                                         00009140
      IF (MM.NE.1) GO TO 140                                            00009150
      NA=NT1                                                            00009160
      NUME=NUMEL                                                        00009170
      NUM7 =0                                                           00009180
  140 DO 240 N=1,NUME                                                   00009190
      CALL RDWRT(NA,STIF,NEMN,0,KOUNT)                                  00009200
      ND1=STIF(KOUNT)                                                   00009210
      NTOT=(ND1*ND1-ND1)/2+ND1                                          00009220
      KSTXM=LLF*ND1+NTOT+ND1+ND1                                        00009230
      IF(LMASS.EQ.1) KSTXM=KSTXM+NTOT-ND1                               00009240
      DO 210 I=1,ND1                                                    00009250
      LMN=1-STIF(I)                                                     00009260
      II=STIF(I)-NSHIFT                                                 00009270
      IF (II.LE.0.OR.II.GT.NE2B) GO TO 210                              00009280
      IF(II.GT.NEQB)GO TO 180                                           00009290
      IF(NELD.EQ.0) GO TO 155                                           00009300
      KSTP=NTOT+I                                                       00009310
      DO 150 L=1,LL                                                     00009320
      KSTP=KSTP+ND1                                                     00009330
  150 B(II,L)=B(II,L)+STIF(KSTP)                                        00009340
  155 CONTINUE                                                          00009350
      DO 170 J=1,ND1                                                    00009360
      JJ=STIF(J)+LMN                                                    00009370
      IF(JJ) 170,170,160                                                00009380
  160 KSTS=KX(I,J,ND1)                                                  00009390
      A(II,JJ)=A(II,JJ)+STIF(KSTS)                                      00009400
      KSTM=KX(I,J,ND1)-ND1                                              00009410
      IF((KSTXM+KSTM).GE.KOUNT) GO TO 170                               00009420
      TMASS(II,JJ)=TMASS(II,JJ)-STIF(KSTXM+KSTM)                        00009430
      IF(NELGEO.EQ.1) A(II,JJ)=A(II,JJ)+STIF(KSTXM+KSTM)                00009440
  170 CONTINUE                                                          00009450
      GO TO 210                                                         00009460
  180 II=II-NEQB                                                        00009470
      IF(NELD.EQ.0) GO TO 195                                           00009480
      KSTP=NTOT+I                                                       00009490
      DO 190 L=1,LL                                                     00009500
      KSTP=KSTP+ND1                                                     00009510
  190 B2(II,L)=B2(II,L)+STIF(KSTP)                                      00009520
  195 CONTINUE                                                          00009530
      DO 200 J=1,ND1                                                    00009540
      JJ=STIF(J)+LMN                                                    00009550
      IF(JJ.LE.0) GO TO 200                                             00009560
      KSTS=KX(I,J,ND1)                                                  00009570
      A2(II,JJ)=A2(II,JJ)+STIF(KSTS)                                    00009580
      KSTM=KX(I,J,ND1)-ND1                                              00009590
      IF((KSTXM+KSTM).GE.KOUNT) GO TO 200                               00009600
      TMASS2(II,JJ)=TMASS2(II,JJ)-STIF(KSTXM+KSTM)                      00009610
      IF(NELGEO.EQ.1) A2(II,JJ)=A2(II,JJ)+STIF(KSTXM+KSTM)              00009620
  200 CONTINUE                                                          00009630
  210 CONTINUE                                                          00009640
      IF (MM.GT.1) GO TO 240                                            00009650
      DO 220 I=1,ND1                                                    00009660
      II=STIF(I)-NSHIFT                                                 00009670
      IF(II.GT.NE2B.AND.II.LE.NEBB) GO TO 230                           00009680
  220 CONTINUE                                                          00009690
      GO TO 240                                                         00009700
  230 CALL RDWRT(NT2,STIF,KOUNT,1,I)                                    00009710
      NUM7=NUM7+1                                                       00009720
  240 CONTINUE                                                          00009730
      DO 250 I=1,NEQB                                                   00009740
      D=A(I,1)                                                          00009750
      ANORM=ANORM+D                                                     00009760
      IF(D.NE.0.0) NDEG=NDEG+1                                          00009770
      IF(D.NE.0.0D0.AND.D.LT.AMIN) AMIN=D                               00009780
      IF(D.GT.AMAX) AMAX=D                                              00009790
      IF(TMASS(I,1).NE.0) NVV=NVV+1                                     00009800
      IF(M.EQ.NBLOCK) GO TO 250                                         00009810
      D=A2(I,1)                                                         00009820
      ANORM=ANORM+D                                                     00009830
      IF(D.NE.0.0) NDEG=NDEG+1                                          00009840
      IF(D.NE.0.0D0.AND.D.LT.AMIN) AMIN=D                               00009850
      IF(D.GT.AMAX) AMAX=D                                              00009860
      IF(TMASS2(I,1).NE.0.0) NVV=NVV+1                                  00009870
  250 CONTINUE                                                          00009880
  260 CONTINUE                                                          00009890
      IF(.NOT.GENPRT) GO TO 1200                                        00009900
      WRITE(6,1500)M                                                    00009910
      DO 1020 I=1,NEQB                                                  00009920
      IF(GENPCH)WRITE(7,1510)(A(I,J),J=1,MBAND)                         00009930
 1020 WRITE(6,1520)(A(I,J),J=1,MBAND)                                   00009940
      WRITE(6,1530)                                                     00009950
      DO 1030 I=1,NEQB                                                  00009960
      IF(GENPCH) WRITE(7,1510)(B(I,J),J=1,LL)                           00009970
 1030 WRITE(6,1520)(B(I,J),J=1,LL)                                      00009980
      WRITE(6,1540)                                                     00009990
 2170 DO 2180 I=1,NEQB                                                  00010000
      IF(GENPCH) WRITE(7,1510)(TMASS(I,J),J=1,MBAND)                    00010010
 2180 WRITE(6,1520)(TMASS(I,J),J=1,MBAND)                               00010020
      IF(M.EQ.NBLOCK) GO TO 1200                                        00010030
      MP1=M+1                                                           00010040
      WRITE(6,1500)MP1                                                  00010050
      DO 1060 I=1,NEQB                                                  00010060
      IF(GENPCH)WRITE(7,1510)(A2(I,J),J=1,MBAND)                        00010070
 1060 WRITE(6,1520)(A2(I,J),J=1,MBAND)                                  00010080
      WRITE(6,1530)                                                     00010090
      DO 1070 I=1,NEQB                                                  00010100
      IF(GENPCH) WRITE(7,1510)(B2(I,J),J=1,LL)                          00010110
 1070 WRITE(6,1520)(B2(I,J),J=1,LL)                                     00010120
      WRITE(6,1540)                                                     00010130
 2200 DO 2210 I=1,NEQB                                                  00010140
      IF(GENPCH)WRITE(7,1510)(TMASS2(I,J),J=1,MBAND)                    00010150
 2210 WRITE(6,1520)(TMASS2(I,J),J=1,MBAND)                              00010160
 1200 CONTINUE                                                          00010170
      IF(MODEFR.GT.0) GO TO 247                                         00010180
      DO 246 I=1,NEQB                                                   00010190
      D=A(I,1)                                                          00010200
      IF(D.GT.0.0) GO TO 243                                            00010210
      NJ=NEQB*(M-1)+I                                                   00010220
      IF(NJ.GT.KEQ) GO TO 246                                           00010230
      NFLG=1                                                            00010240
      WRITE(6,242)NJ,D                                                  00010250
  242 FORMAT(/10X,9HEQUATION ,I5,26H HAS A SINGULAR DIAGONAL = ,E10.4)  00010260
      WRITE(6,115)                                                      00010270
      ICO=1                                                             00010280
  243 D=A2(I,1)                                                         00010290
      IF(D.GT.0.0) GO TO 246                                            00010300
      NJ=NEQB*M+I                                                       00010310
      IF(NJ.GT.KEQ) GO TO 246                                           00010320
      NFLG=1                                                            00010330
      WRITE(6,242)NJ,D                                                  00010340
  246 CONTINUE                                                          00010350
  247 CONTINUE                                                          00010360
      WRITE (NTD) TMASS,(A(I,1),I=1,NEQB)                               00010370
      CALL SQEEZE(A ,NWDS,NTA,ISQZ)                                     00010380
      IF(M.EQ.NBLOCK) GO TO 310                                         00010390
      WRITE (NTD) TMASS2,(A2(I,1),I=1,NEQB)                             00010400
      CALL SQEEZE(A2,NWDS,NTA,ISQZ)                                     00010410
      IF (MM.EQ.MB) MM=0                                                00010420
      MM=MM+1                                                           00010430
      PER=(M+1)*100.0/X                                                 00010440
      IFORM(2) = ICOO(ICO)                                              00010450
      WRITE(6,IFORM) PER                                                00010460
      ICO = ICO + 1                                                     00010470
      IF ( ICO .LT. 11 ) GO TO 310                                      00010480
      WRITE(6,295)                                                      00010490
  295 FORMAT(1H )                                                       00010500
      ICO = 1                                                           00010510
  310 NSHIFT=NSHIFT+NE2B                                                00010520
      WRITE(6,320)                                                      00010530
  320 FORMAT(////20X,98(1H*)/20X,34HTHE MASTER STIFFNESS (CONVENTIONAL, 00010540
     148H AND GEOMETRIC) STIFFNESS AND LOAD MATRICES HAVE,              00010550
     216H BEEN ASSEMBLED./20X,98(1H*))                                  00010560
      IF(NFLG.EQ.1) KSKIP=1                                             00010570
      IF(NDEG.GT.0) GO TO 340                                           00010580
      WRITE(6,330)                                                      00010590
  330 FORMAT(51H0STRUCTURE WITH NO DEGREES OF FREEDOM CHECK DATA   )    00010600
      KSKIP =1                                                          00010610
      RETURN                                                            00010620
  340 CONTINUE                                                          00010630
      IF(NDEG.GT.0) ANORM= (ANORM/NDEG)*1.0E-08                         00010640
      IF(NDYN.EQ.11) WRITE(6,1550)                                      00010650
      IF(NDYN.NE.11) WRITE(6,1560)                                      00010660
      RATIO=1.0D30                                                      00010670
      IF(AMIN.NE.0.0D0) RATIO=AMAX/AMIN                                 00010680
      WRITE(6,1570)AMIN,AMAX,RATIO                                      00010690
      RETURN                                                            00010700
 1500 FORMAT(17H OVERALL MATRICES,1X,5HBLOCK,I3,//,                     00010710
     117H STIFFNESS MATRIX)                                             00010720
 1510 FORMAT((1P8E10.3))                                                00010730
 1520 FORMAT (  (1H ,1P10E13.4))                                        00010740
 1530 FORMAT(///,12H LOAD MATRIX)                                       00010750
 1540 FORMAT(///,23H GEOMETRIC MATRIX (-KG))                            00010760
 1550 FORMAT(5X,37HGEOMETRIC STIFFNESS MATRIX PARAMETERS)               00010770
 1560 FORMAT(15X,43HSTIFFNESS MATRIX PARAMETERS AFTER INCLUSION,        00010780
     1       1X,26HOF THE GEOMETRIX STIFFNESS)                          00010790
 1570 FORMAT(//,                                                        00010800
     1 15X,34HMINIMUM NON-ZERO DIAGONAL ELEMENT=,1PD10.3,/,             00010810
     2 15X,34HMAXIMUM DIAGONAL ELEMENT         =,  D10.3,/,             00010820
     3 15X,34HMAXIMUM/MINIMUM                  =,  D10.3)               00010830
      END                                                               00010840
      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 QVCPY1(FROM,TO,N)                                      00193920
      REAL*8 FROM,TO                                                    00193930
      DIMENSION FROM(N,1),TO(1)                                         00193940
      DO 100 I=1,N                                                      00193950
  100 TO(I)=FROM(I,1)                                                   00193960
      RETURN                                                            00193970
      END                                                               00193980
      SUBROUTINE DISPLY (X,F,NF,NDS,NUM,NN,KKK,ISD,ISP)                 00059680
      IMPLICIT REAL*8(A-H,O-Z)                                          00059690
      REAL*8  NPAR                                                      00059700
      DIMENSION NTAPE(4),X(NF,NDS,3),F(8,NF),NUM(NN)                    00059710
      COMMON / JUNK /TM(8),DM(8),D(8),KD(3,8),RRJUNK(191)               R0059720
      COMMON / DYN / NT,NOT,DAMP,DT,RRDYN(3)                            R0059730
      COMMON / ELPAR / NPAR(14),RRELPA(29)                              R0059740
        DATA NTAPE/48,45,46,47/                                         00059750
      REWIND 3                                                          00059760
      REWIND 4                                                          00059770
        NT45=NTAPE(ISD)                                                 00059780
        REWIND NT45                                                     00059790
      READ (4) X                                                        00059800
      DO 320 N=1,NN                                                     00059810
      REWIND 2                                                          00059820
      REWIND 9                                                          00059830
      MM=NUM(N)                                                         00059840
        MMM=3                                                           00059850
        IF(ISD.EQ.3)MMM=2                                               00059860
        IF(ISD.EQ.4)MMM=1                                               00059870
  100 IF(MM.EQ.0) GO TO 320                                             00059880
      DO 270 M=1,MM                                                     00059890
      READ (3) L,KD,F                                                   00059900
      GO TO (110,160,140),KKK                                           00059910
110     GO TO (120,111,112,114),ISD                                     00059920
111      WRITE (6,330) M                                                00059930
      GO TO 130                                                         00059940
112     WRITE(6,331)M                                                   00059950
        GO TO 130                                                       00059960
114     WRITE(6,332)M                                                   00059970
        GO TO 130                                                       00059980
  120 WRITE (6,390) M                                                   00059990
  130 WRITE (6,400) (KD(1,I),KD(2,I),I=1,L)                             00060000
      GO TO 160                                                         00060010
  140 IF(M.GT.1) GO TO 160                                              00060020
        GO TO (150,141,142,143),ISD                                     00060030
141      WRITE (6,340)                                                  00060040
      WRITE (6,450)                                                     00060050
      GO TO 160                                                         00060060
142     WRITE(6,341)                                                    00060070
        WRITE(6,451)                                                    00060080
        GO TO 160                                                       00060090
143     WRITE(6,342)                                                    00060100
        WRITE(6,452)                                                    00060110
        GO TO 160                                                       00060120
  150 WRITE (6,410)                                                     00060130
      WRITE (6,430)                                                     00060140
  160 DO 170 I=1,L                                                      00060150
      TM(I)=0.                                                          00060160
  170 DM(I)=0.                                                          00060170
      TIME=0.                                                           00060180
      DO 230 K=1,NDS                                                    00060190
      TIME=TIME + DT                                                    00060200
      DO 200 I=1,L                                                      00060210
      DD=0.                                                             00060220
      DO 180 J=1,NF                                                     00060230
  180 DD = DD + F(I,J)*X(J,K,MMM)                                       00060240
      AD= DABS(DD)                                                      00060250
      IF(AD-DM(I)) 200,200,190                                          00060260
  190 DM(I)=AD                                                          00060270
      TM(I)=TIME                                                        00060280
  200 D(I)=DD                                                           00060290
        WRITE(NT45,1000)TIME,M,(D(I),I=1,L)                             00060300
      GO TO (210,220,230),KKK                                           00060310
  210 WRITE (6,350) TIME,(D(I),I=1,L)                                   00060320
      GO TO 230                                                         00060330
  220 WRITE (9) D                                                       00060340
  230 CONTINUE                                                          00060350
      GO TO (240,250,260),KKK                                           00060360
  240 WRITE (6,360) (DM(I),I=1,L)                                       00060370
      WRITE (6,370) (TM(I),I=1,L)                                       00060380
      GO TO 270                                                         00060390
  250 WRITE (2) KD,DM,TM,L                                              00060400
      GO TO 270                                                         00060410
  260 WRITE (6,380) (KD(1,I),KD(2,I),DM(I),TM(I),I=1,L)                 00060420
  270 CONTINUE                                                          00060430
      IF(KKK.NE.2) GO TO 320                                            00060440
      REWIND 2                                                          00060450
      REWIND 9                                                          00060460
      DO 310 M=1,MM                                                     00060470
      GO TO (280,290,291,292),ISD                                       00060480
  280 WRITE (6,420) M                                                   00060490
      WRITE (6,430)                                                     00060500
      GO TO 300                                                         00060510
  290 WRITE (6,440) M                                                   00060520
      WRITE (6,450)                                                     00060530
        GO TO 300                                                       00060540
291     WRITE(6,441)M                                                   00060550
        WRITE(6,451)                                                    00060560
        GO TO 300                                                       00060570
292     WRITE(6,442)M                                                   00060580
        WRITE(6,452)                                                    00060590
  300 CALL PLOTDY (2,9,NDS,ISP)                                         00060600
  310 CONTINUE                                                          00060610
  320 CONTINUE                                                          00060620
      RETURN                                                            00060630
  330 FORMAT (50H1TIME HISTORY FOR SELECTED DISPLACEMENT COMPONENTS ,   00060640
     $ 5H..... ,I3//10X,40HNODE NUMBERS AND DISPLACEMENT COMPONENTS )   00060650
  340 FORMAT (59H1MAXIMUM DISPLACEMENT VALUES FROM DYNAMIC RESPONSE ANAL00060660
     $YSIS //)                                                          00060670
  350 FORMAT (F8.3,2X,1P8E12.3)                                         00060680
  360 FORMAT ( /24H MAXIMUM ABSOLUTE VALUES //                          00060690
     $ 10H MAXIMUM   ,1P8E12.3)                                         00060700
  370 FORMAT (10H TIME      ,1P8E12.3)                                  00060710
  380 FORMAT (I6,I13,1PE18.3,E12.3,5X,2HNA)                             00060720
  390 FORMAT (  44H1TIME HISTORY FOR SELECTED STRESS COMPONENTS ,       00060730
     $ 5H..... , I3//10X,37H ELEMENT AND STRESS COMPONENT NUMBERS )     00060740
  400 FORMAT (8H    TIME , 2X, 8(I8,1H-,I2,1X))                         00060750
  410 FORMAT (                                                          00060760
     $ 53H1MAXIMUM STRESS VALUES FROM DYNAMIC RESPONSE ANALYSIS //)     00060770
  420 FORMAT (                                                          00060780
     $ 39H1NORMALISED PLOT OF STRESS HISTORIES...,I3/)                  00060790
  430 FORMAT(58H  ELEMENT      STRESS       MAXIMUM      TIME AT     PLO00060800
     $T / 58H  NUMBER     COMPONENT       VALUE       MAXIMUM    SYMBOL)00060810
  440 FORMAT (46H1NORMALISED PLOT OF DISPLACEMENT HISTORIES....,I3/)    00060820
  450 FORMAT(58H   NODE     DISPLACEMENT    MAXIMUM      TIME AT     PLO00060830
     $T / 58H  NUMBER     COMPONENT       VALUE       MAXIMUM    SYMBOL)00060840
  331 FORMAT (50H1TIME HISTORY FOR SELECTED VELOCITY     COMPONENTS ,   00060850
     $ 5H..... ,I3//10X,40HNODE NUMBERS AND VELOCITY     COMPONENTS )   00060860
  332 FORMAT (50H1TIME HISTORY FOR SELECTED ACCELERATION COMPONENTS ,   00060870
     $ 5H..... ,I3//10X,40HNODE NUMBERS AND ACCELERATION COMPONENTS )   00060880
  341 FORMAT (59H1MAXIMUM VELOCITY     VALUES FROM DYNAMIC RESPONSE ANAL00060890
     $YSIS //)                                                          00060900
  342 FORMAT (59H1MAXIMUM ACCELERATION VALUES FROM DYNAMIC RESPONSE ANAL00060910
     $YSIS //)                                                          00060920
  451 FORMAT(58H   NODE     VELOCITY        MAXIMUM      TIME AT     PLO00060930
     $T / 58H  NUMBER     COMPONENT       VALUE       MAXIMUM    SYMBOL)00060940
  452 FORMAT(58H   NODE     ACCELERATION    MAXIMUM      TIME AT     PLO00060950
     $T / 58H  NUMBER     COMPONENT       VALUE       MAXIMUM    SYMBOL)00060960
  441 FORMAT (46H1NORMALISED PLOT OF VELOCITY     HISTORIES....,I3/)    00060970
  442 FORMAT (46H1NORMALISED PLOT OF ACCELERATION HISTORIES....,I3/)    00060980
1000    FORMAT(E13.5,I5,8E13.5)                                         00060990
        END                                                             00061000
      SUBROUTINE DSHELL                                                 00063280
      IMPLICIT REAL *8 (A-H,O-Z)                                        00063290
      COMMON /JUNK/ SIG(200),MM,L,K,NTAG,NDYN,NRJUNK(49)                R0063300
      COMMON /OUT/ NRES,NSTR,NDIS,NROUT(7)                              R0063310
      DIMENSION EFS(2)                                                  00063320
10    IF (NTAG.EQ.0) WRITE (6,30)                                       00063330
      SIG(7)=SIG(1)+SIG(4)                                              00063340
      SIG(8)=SIG(2)+SIG(5)                                              00063350
      SIG(9)=SIG(3)+SIG(6)                                              00063360
      CC=(SIG(7)+SIG(8))/2.                                             00063370
      BB=(SIG(7)-SIG(8))/2.                                             00063380
      CR=DSQRT(BB**2+SIG(9)**2)                                         00063390
      SIG(10)=CC+CR                                                     00063400
      SIG(11)=CC-CR                                                     00063410
      SIG(12)=0.0                                                       00063420
      IF (BB.NE.0) SIG(12)=28.648*DATAN2(SIG(9),BB)                     00063430
      SIG(13)=SIG(1)-SIG(4)                                             00063440
      SIG(14)=SIG(2)-SIG(5)                                             00063450
      SIG(15)=SIG(3)-SIG(6)                                             00063460
      CC=(SIG(13)+SIG(14))/2.                                           00063470
      BB=(SIG(13)-SIG(14))/2.                                           00063480
      CR=DSQRT(BB**2+SIG(15)**2)                                        00063490
      SIG(16)=CC+CR                                                     00063500
      SIG(17)=CC-CR                                                     00063510
      SIG(18)=0.0                                                       00063520
      IF (BB.NE.0) SIG(18)=28.648*DATAN2(SIG(15),BB)                    00063530
      EFS(1)=SIG(10)**2+SIG(11)**2-SIG(10)*SIG(11)                      00063540
      EFS(1)=DSQRT(EFS(1))                                              00063550
      EFS(2)=SIG(16)**2+SIG(17)**2-SIG(16)*SIG(17)                      00063560
      EFS(2)=DSQRT(EFS(2))                                              00063570
      WRITE (6,40) MM,L,(SIG(I),I=1,12),EFS(1),(SIG(I),I=13,18),EFS(2)  00063580
      IF (NSTR.GT.0) WRITE (NSTR,20) L,SIG(10),SIG(11),EFS(1),SIG(16),SI00063590
     1G(17),EFS(2),(SIG(I),I=7,9),SIG(12),(SIG(I),I=13,15),SIG(18)      00063600
20    FORMAT (4H  14,I2,4H12 6,7G10.4/(8G10.4))                         00063610
      RETURN                                                            00063620
30    FORMAT (  24H1 SHELL ELEMENT STRESSES//10X,19H  ELEMENT      LOAD,00063630
     138H  SIG-X     SIG-Y     SIG-XY   SIG-MAX,                        00063640
     230H   SIG-MIN    ANGLE     SIG-EF)                                00063650
40    FORMAT (//10H MEMBRANE ,2I10,3F10.2/9H  BENDING,21X,3F10.2/       00063660
     110H +T/2 SIDE,20X,7F10.2/10H -T/2 SIDE,20X,7F10.2)                00063670
      END                                                               00063680
      SUBROUTINE SDSPLY (TEMP,X,MMX,MAX,NCL,NUM,NN,KKK,ISD,ISP,NPT,KT)  00227660
      IMPLICIT REAL*8 (A-H,O-Z)                                         00227670
      COMMON /QTSARG/ SSA(8,60),KLM(8,60)                               00227680
     $,TM(8),DM(8),D(8),RRQTSA(256)                                     R0227690
      COMMON /JUNK/NDUM(6),NBL,LAST,KD(2,8),RRJUNK(215)                 R0227700
      COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM,  00227710
     $NAT,NT,NOT,NRDYN2(9)                                              R0227720
        COMMON /OUT/NRES,NSTR,NDIS,NROUT(7)                             R0227730
      DIMENSION      TEMP(MAX,NCL),X(MMX,NCL),NUM(NN)                   00227740
      IT = 3                                                            00227750
      REWIND KT                                                         00227760
      NT9 = 9                                                           00227770
      NT8 = 8                                                           00227780
      REWIND NT8                                                        00227790
      NT2 = 1                                                           00227800
      NT4 = 2                                                           00227810
        IU=0                                                            00227820
        IF(ISD.EQ.1.AND.NSTR.GT.0) IU=NSTR                              00227830
        IF(ISD.EQ.2.AND.NDIS.GT.0) IU=NDIS                              00227840
        IF(IU.GT.0) WRITE (IU,540) ISD,NUM(1),NPT                       00227850
      IF(MAX.NE.MMX)  GO TO 100                                         00227860
      IT=KT                                                             00227870
      NBLOCK = NBL                                                      00227880
      GO TO 130                                                         00227890
  100 K=0                                                               00227900
      REWIND IT                                                         00227910
      NBLOCK = 0                                                        00227920
      DO 120 NB=1,NBL                                                   00227930
      READ (KT) TEMP                                                    00227940
      DO 110 I=1,MAX                                                    00227950
      II=I+K                                                            00227960
      DO 110 J=1,NCL                                                    00227970
  110 X(II,J)=TEMP(I,J)                                                 00227980
      K=K+MAX                                                           00227990
      L = K+MAX                                                         00228000
      IF(L.LE.MMX) GO TO 120                                            00228010
      WRITE (IT) X                                                      00228020
      K=0                                                               00228030
      NBLOCK=NBLOCK+1                                                   00228040
 120     CONTINUE                                                       00228050
      IF(K.EQ.0) GO TO 130                                              00228060
      WRITE (IT) X                                                      00228070
      NBLOCK = NBLOCK +1                                                00228080
  130 IF=0                                                              00228090
      DO 410 N=1,NN                                                     00228100
      REWIND NT2                                                        00228110
      REWIND NT4                                                        00228120
      MM=NUM(N)                                                         00228130
  140 IF(MM.EQ.0) GO TO 410                                             00228140
      MTYPL=0                                                           00228150
      DO 360 M=1,MM                                                     00228160
      REWIND IT                                                         00228170
      IF(ISD.EQ.1) READ (NT8) ND,((SSA(I,J),I=1,8),J=1,ND),             00228180
     $                           ((KLM(I,J),I=1,8),J=1,ND),MTYPE        00228190
                   READ (NT9) KD,L                                      00228200
        IF(IU.GT.0) WRITE (IU,540) M,L                                  00228210
        IF(IU.GT.0) WRITE (IU,540) (KD(1,I),KD(2,I),I=1,L)              00228220
      GO TO (150,190,170),KKK                                           00228230
  150 IF(ISD.EQ.1) GO TO 160                                            00228240
      WRITE (6,420) M                                                   00228250
      WRITE (6,480) (KD(1,I),KD(2,I),I=1,L)                             00228260
      GO TO 190                                                         00228270
  160                                                                   00228280
     $CALL ELOUTS (KD,L,MTYPE,M,ND)                                     00228290
      GO TO 190                                                         00228300
  170 IF(ISD.EQ.1) GO TO 180                                            00228310
      IF(M.GT.1) GO TO 190                                              00228320
      WRITE (6,430)                                                     00228330
      WRITE (6,530)                                                     00228340
      GO TO 190                                                         00228350
  180 WRITE (6,490) MTYPE                                               00228360
      WRITE (6,510)                                                     00228370
  190 DO 200 I=1,L                                                      00228380
      TM(I)=0.E0                                                        00228390
  200 DM(I)=0.E0                                                        00228400
      TIME=0.E0                                                         00228410
      MTYPL=MTYPE                                                       00228420
      NR = MMX                                                          00228430
      DO 320 NB=1,NBLOCK                                                00228440
      READ (IT) X                                                       00228450
      IF(NB.LT.NBLOCK) GO TO 210                                        00228460
      NR = NPT - (NBLOCK-1)*MMX                                         00228470
  210 CONTINUE                                                          00228480
      DO 310 K=1,NR                                                     00228490
      TIME=TIME + DT                                                    00228500
      DO 280 I=1,L                                                      00228510
      GO TO (220,250),ISD                                               00228520
  220 DD=0.E0                                                           00228530
      DO 240 J=1,ND                                                     00228540
      JJ=KLM(I,J)                                                       00228550
      IF(JJ) 240,240,230                                                00228560
  230 DD=DD+SSA(I,J)*X(K,JJ)                                            00228570
  240 CONTINUE                                                          00228580
      GO TO 260                                                         00228590
  250 JJ = IF+I                                                         00228600
      DD = X(K,JJ)                                                      00228610
  260 AD= DABS(DD)                                                      00228620
      IF(AD-DM(I)) 280,280,270                                          00228630
  270 DM(I)=AD                                                          00228640
      TM(I)=TIME                                                        00228650
  280 D(I)=DD                                                           00228660
        IF(IU.GT.0) WRITE (IU,550) TIME,(D(I),I=1,L)                    00228670
      GO TO (290,300,310),KKK                                           00228680
  290 WRITE (6,440) TIME,(D(I),I=1,L)                                   00228690
      GO TO 310                                                         00228700
  300 WRITE (NT4) D                                                     00228710
  310 CONTINUE                                                          00228720
  320 CONTINUE                                                          00228730
      GO TO (330,340,350),KKK                                           00228740
  330 WRITE (6,450) (DM(I),I=1,L)                                       00228750
      WRITE (6,460) (TM(I),I=1,L)                                       00228760
      GO TO 360                                                         00228770
  340 WRITE (NT2) KD,DM,TM,L                                            00228780
      GO TO 360                                                         00228790
  350 WRITE (6,470) (KD(1,I),KD(2,I),DM(I),TM(I),I=1,L)                 00228800
  360 IF=IF+L                                                           00228810
      IF(KKK.NE.2) GO TO 410                                            00228820
      REWIND NT2                                                        00228830
      REWIND NT4                                                        00228840
      DO 400 M=1,MM                                                     00228850
      GO TO (370,380),ISD                                               00228860
  370 WRITE (6,500) MTYPE,M                                             00228870
      WRITE (6,510)                                                     00228880
      GO TO 390                                                         00228890
  380 WRITE (6,520) M                                                   00228900
      WRITE (6,530)                                                     00228910
  390 CALL SPLOT (NT2,NT4,NPT,ISP)                                      00228920
  400 CONTINUE                                                          00228930
  410 CONTINUE                                                          00228940
      RETURN                                                            00228950
  420 FORMAT (50H1D I S P L A C E M E N T   T I M E   H I S T O R Y, // 00228960
     $ 13H OUTPUT SET =,I4, // 14X,27H*NODE NUMBER* - (COMPONENT ,      00228970
     $  7HNUMBER), 1X)                                                  00228980
  430 FORMAT (38H1D I S P L A C E M E N T  M A X I M A, // 1X)          00228990
  440 FORMAT (F12.5,2X,1P8E12.3)                                        00229000
  450 FORMAT (/ 24H MAXIMUM ABSOLUTE VALUES, // 8H MAXIMUM,6X,1P8E12.3) 00229010
  460 FORMAT (5H TIME,9X,1P8E12.3)                                      00229020
  470 FORMAT (I8,12X,I3,1P2E14.4,7X,2HNA)                               00229030
  480 FORMAT (8X,4HTIME,2X, 8(3X,I4,2H-(,I2,1H)) / 1X)                  00229040
  490 FORMAT (46H1S T R E S S   C O M P O N E N T   M A X I M A, //     00229050
     $        22H ELEMENT TYPE NUMBER =, I3, // 1X)                     00229060
  500 FORMAT (51H N O R M A L I Z E D   S T R E S S    H I S T O R Y,3X,00229070
     $  7HP L O T, // 22H ELEMENT TYPE NUMBER =, I3 /                   00229080
     $                22H OUTPUT SET NUMBER   =, I3 // 1X)              00229090
  510 FORMAT (8H ELEMENT,9X,6HSTRESS,7X,7HMAXIMUM,7X,7HTIME AT,5X,      00229100
     $ 4HPLOT,/ 8H  NUMBER,6X,9HCOMPONENT,9X,5HVALUE,7X,7HMAXIMUM,3X,   00229110
     $ 6HSYMBOL, / 1X)                                                  00229120
  520 FORMAT (46H1N O R M A L I Z E D   D I S P L A C E M E N T,3X,     00229130
     $ 23HH I S T O R Y   P L O T, // 22H OUTPUT SET NUMBER   =, I3//1X)00229140
  530 FORMAT (4X,4HNODE,3X,12HDISPLACEMENT,7X,7HMAXIMUM,7X,7HTIME AT,   00229150
     $ 5X,4HPLOT, / 8H  NUMBER,6X,9HCOMPONENT,9X,5HVALUE,7X,7HMAXIMUM,  00229160
     $ 3X,6HSYMBOL, / 1X)                                               00229170
540     FORMAT(16I5)                                                    00229180
550     FORMAT(6G12.6,8X)                                               00229190
      END                                                               00229200
      SUBROUTINE SPHT2  (T,M,SPHT  )                                    00250720
      IMPLICIT REAL*8(A-H,O-Z)                                          00250730
      DIMENSION COEF(11,8)                                              00250740
      DATA COEF/                                                        00250750
     1 4.0,100.0,1500.0,1.017891E-1,1.046516E-4,-1.522855E-7,           00250760
     1 1.070093E-10,-2.562681E-14,0.0,0.0,0.0,                          00250770
     2 4.0,100.0,1500.0,1.017891E-1,1.046516E-4,-1.522855E-7,           00250780
     2 1.070093E-10,-2.562681E-14,0.0,0.0,0.0,                          00250790
     3 2.0,32.0,1650.0,3.4574E-1,-7.9226E-5,3.4086E-8,0.0,0.0,0.0,0.,0.,00250800
     4 7.0,75.0,1600.,1.014456E-1,4.378752E-5,-2.046138E-8,3.418111E-11,00250810
     4 -2.060318E-13,3.682836E-16,-2.458648E-19,5.597571E-23,           00250820
     5 4.0,100.0,800.0,1.154315E-1,-2.500197E-5,2.354774E-7,            00250830
     5 -3.738534E-10,2.230893E-13,0.0,0.0,0.0,                          00250840
     6 4.0,100.0,800.0,1.154315E-1,-2.500197E-5,2.354774E-7,            00250850
     6 -3.738534E-10,2.230893E-13,0.0,0.0,0.0,                          00250860
     7 4.0,100.0,800.0,9.374201E-2,1.659039E-4,-3.860357E-7,            00250870
     7 4.889573E-10,-2.067584E-13,0.0,0.0,0.0,                          00250880
     8 3.0,0.0,2500.0,2.397434E-1,-1.270842E-6,3.997813E-8,             00250890
     8 -1.522993E-11,0.0,0.0,0.0,0.0/                                   00250900
      ICODE=2                                                           00250910
      IF(M.LT.1.OR.M.GT.8)CALL RPZLVZ(M,T,ICODE,8)                      00250920
      N=COEF(1,M)                                                       00250930
      T1=COEF(2,M)                                                      00250940
      T2=COEF(3,M)                                                      00250950
      IF(T.LT.T1.OR.T.GT.T2)CALL RPZLVZ(M,T,ICODE,1)                    00250960
      IF(T.GT.208.OR.M.NE.3)GO TO 5                                     00250970
      SPHT=2.845E-1+3.647E-5*T+7.765E-7*T*T                             00250980
      RETURN                                                            00250990
    5 CONTINUE                                                          00251000
      SPHT  =COEF(N+4,M)                                                00251010
      IF(N.EQ.0)RETURN                                                  00251020
      DO 10 I=1,N                                                       00251030
   10 SPHT  =SPHT  *T+COEF(N-I+4,M)                                     00251040
      RETURN                                                            00251050
      END                                                               00251060
