      SUBROUTINE FRFREQ                                                 00095590
        IMPLICIT REAL*8 (A-H,O-Z)                                       00095600
        REAL DIR(3)                                                     00095610
        COMMON A(1)                                                     00095620
        COMMON /MISC/NBLOCK,NEQB,LL,NF,LB                               R0095630
        COMMON /ELPAR/ APAR(14),NUMNP,MBAND,NLTP,N1,MMM(4),MTOT,NEQ     00095640
     & ,RRELPA(24)                                                      R0095641
        DATA FIRST /8HSINE-RES/                                         00095650
        DATA DIR/1HX,1HY,1HZ/                                           00095660
        READ(5,999)TIT                                                  00095670
        READ(5,1000)NGM,IDIR,NFN,IPRINT,XREF,YREF,ZREF                  00095680
        NGMX=NGM                                                        00095690
        WRITE(6,1010)                                                   00095700
        IF(NGM.NE.2)WRITE(6,2000)DIR(IDIR),NFN                          00095710
        IF(NGM.EQ.2)WRITE(6,2001)DIR(IDIR),XREF,YREF,ZREF,NFN           00095720
        IF(IPRINT.EQ.1)WRITE(6,2010)                                    00095730
        NFN=NFN+NF                                                      00095740
        N2=N1+NUMNP*3                                                   00095750
        N3=N2+NEQB                                                      00095760
        CALL FEMID(A(N1),A(N2),NUMNP,NEQB)                              00095770
        N2=N1+NF                                                        00095780
        N3=N2+NF                                                        00095790
        N4=N3+NEQB*NF                                                   00095800
        N5=N4+NEQB                                                      00095810
        N6=N5+NEQB                                                      00095820
        CALL FRMPF(A(N1),A(N2),A(N3),A(N4),A(N5),IDIR                   00095830
     &  ,NEQB,NF,NBLOCK,NUMNP)                                          00095840
        N4=N3+NF                                                        00095850
        N5=N4+NFN*NF                                                    00095860
        N6=N5+NFN                                                       00095870
        N7=N6+NFN                                                       00095880
        CALL FRESP(A(N1),A(N2),A(N3),A(N4),A(N5),A(N6)                  00095890
     &  ,NF,NFN,IPRINT)                                                 00095900
        NSB=NEQB*NBLOCK                                                 00095910
        N2=N1+8*NF                                                      00095920
        N3=N2+NF*NFN                                                    00095930
        N4=N3+NFN                                                       00095940
        N5=N4+NUMNP                                                     00095950
        IF(N5.GT.MTOT)CALL ERROR(N5-MTOT)                               00095960
        CALL FRDSPR(A(N1),A(N1),A(N2),A(N2),A(N3)                       00095970
     &  ,NEQB,NF,NFN,NUMNP,NBLOCK,NSB,A(N4))                            00095980
        N2=N1+1                                                         00095990
        N3=N2+8*NF                                                      00096000
        N4=N3+NSB*NF                                                    00096010
        N5=N3+NF*NFN                                                    00096020
        N4=MAX0(N4,N5)                                                  00096030
        N5=N4+NFN                                                       00096040
        IF(N5.GT.MTOT)CALL ERROR(N5-MTOT)                               00096050
        CALL FRSTRS(A(N1),A(N2),A(N3),A(N3),A(N4),NF                    00096060
     &  ,NSB,NFN,NEQB,NBLOCK,A(1))                                      00096070
        RETURN                                                          00096080
999     FORMAT(A8)                                                      00096090
1000    FORMAT(I4,I1,2I5,3F10.0)                                        00096100
1010    FORMAT(39H1S I N U S O I D A L    R E S P O N S E,              00096110
     &  19H    A N A L Y S I S//)                                       00096120
2000    FORMAT(15H BASE MOTION IN,A1,10H DIRECTION/                     00096130
     &  31H NUMBER OF OUTPUT FREQUENCIES =,I5)                          00096140
2001    FORMAT(15H NOT IN SERVICE)                                      00096150
2010    FORMAT(46H ADDITIONAL PRINTING OUTPUT HAS BEEN REQUESTED)       00096160
        END                                                             00096170
      SUBROUTINE FEMID(ID,MASS,NUMNP,NEQB)                              00086470
      IMPLICIT REAL*8(A-H,O-Z)                                          00086480
      REAL*8  MASS                                                      00086490
      REAL*8  ID                                                        00086500
      COMMON/PREP/XMX,XAD,KSKIP,NDY ,I1,RRPREP(7)                       R0086510
      DIMENSION ID(NUMNP,3),MASS(NEQB)                                  00086520
      IWRITE=0                                                          00086530
      REWIND 3                                                          00086540
      REWIND 8                                                          00086550
      READ (8) ID                                                       00086560
      DO 100 L=1,NEQB                                                   00086570
  100 MASS(L)=0.0D0                                                     00086580
      NT=1                                                              00086590
      DO 140 N=1,NUMNP                                                  00086600
      DO 130 I=1,6                                                      00086610
      NEQBS=NEQB*(NT-1)                                                 00086620
      NEQBE=NEQB*NT                                                     00086630
      CALL UNPKID(ID,NUMNP,W,WX,2,N,I)                                  00086640
      NNN=W                                                             00086650
      IF(NNN.LE.0) GO TO 130                                            00086660
      IF(NNN.GT.NEQBS.AND.NNN.LE.NEQBE) GO TO 110                       00086670
      IF(NNN.LE.NEQBS) GO TO 130                                        00086680
      NT=NT+1                                                           00086690
      DO 105 M=1,NEQB                                                   00086700
  105 MASS(M)=0.0D0                                                     00086710
  110 IF(I.GT.3) GO TO 120                                              00086720
      L=NNN-(NT-1)*NEQB                                                 00086730
      MASS(L)=I                                                         00086740
  120 IF(NNN.EQ.NEQBE) WRITE(3) MASS                                    00086750
      IF(NNN.EQ.NEQBE) IWRITE=IWRITE+1                                  00086760
  130 CONTINUE                                                          00086770
  140 CONTINUE                                                          00086780
      IF(IWRITE.LT.NT) WRITE(3) MASS                                    00086790
      RETURN                                                            00086800
      END                                                               00086810
      SUBROUTINE FRMPF(GAM,FR,F,XM,MASS,IDIR,NEQB                       00096180
     &  ,NF,NBLOCK,NUMNP)                                               00096190
        IMPLICIT REAL*8 (A-H,O-Z)                                       00096200
        REAL*8 MASS                                                     00096210
        DIMENSION GAM(1),FR(NF),F(NEQB,NF),XM(NEQB),MASS(NEQB)          00096220
         L10RC=NEQB*NF*4                                                00096230
        DO 100 I=1,NF                                                   00096240
100     GAM(I)=0.                                                       00096250
        REWIND 9                                                        00096260
        REWIND 3                                                        00096270
        DO 130 N=1,NBLOCK                                               00096280
        BACKSPACE 10                                                    00096290
        READ (10) F                                                     00096300
        BACKSPACE 10                                                    00096310
        READ(3)MASS                                                     00096320
        READ(9)XM                                                       00096330
        DO 120 I=1,NEQB                                                 00096340
        J=MASS(I)                                                       00096350
        IF(J.NE.IDIR)GO TO 120                                          00096360
        IF(J.LE.0)GO TO 120                                             00096370
        DO 110 L=1,NF                                                   00096380
110     GAM(L)=GAM(L)+F(I,L)*XM(I)                                      00096390
120     CONTINUE                                                        00096400
130     CONTINUE                                                        00096410
        BACKSPACE 10                                                    00096420
        READ (10) FR                                                    00096430
        WRITE (6,2000)                                                  00096440
        TPI=6.2831853072D0                                              00096450
        DO 230 I=1,NF                                                   00096460
        FR(I)=FR(I)/TPI                                                 00096470
230     WRITE(6,2010)FR(I),GAM(I)                                       00096480
        RETURN                                                          00096490
2000    FORMAT(11H0 FREQ, HZ.,5X,26HMODAL PARTICIPATION FACTOR)         00096500
2003    FORMAT(36H  BASE TRANSLATION, DIRECTION CODE =,I2)              00096510
2010    FORMAT(1X,1PE10.3,5X,E10.3)                                     00096520
        END                                                             00096530
      SUBROUTINE FRESP(GAM,FR,PHI,Q,FF,DAMP,NF,NFN,IPRINT)              00093300
        IMPLICIT REAL*8(A-H,O-Z)                                        00093310
        REAL HED                                                        00093320
        COMMON /AMB/GRAV,REFT,JROT                                      R0093330
        COMMON /PREP/XMX,XAD,MODEX,RRPREP(8)                            R0093340
        DIMENSION GAM(NF),FR(NF),PHI(NF),Q(NF,NFN),HED(15),G(4)         00093350
     &  ,F(8),FF(NFN),DAMP(NFN)                                         00093360
        DO 10 I=1,NFN                                                   00093370
10      FF(I)=0.D0                                                      00093380
        IF(NFN.EQ.NF)GO TO 300                                          00093390
        READ(5,1000)ITYPE,HED                                           00093400
        WRITE(6,2000)HED                                                00093410
        GO TO (100,200),ITYPE                                           00093420
100     I=0                                                             00093430
        J=0                                                             00093440
        NF1=NFN-NF                                                      00093450
110     I=I+8                                                           00093460
        READ(5,1010)F                                                   00093470
        DO 120 N=1,8                                                    00093480
        J=J+1                                                           00093490
        IF(J.GT.NF1)GO TO 130                                           00093500
        FF(J)=F(N)                                                      00093510
120     CONTINUE                                                        00093520
        GO TO 110                                                       00093530
130     IF(MODEX.EQ.1)GO TO 250                                         00093540
        DO 140 N=1,NF                                                   00093550
        FF(J)=FR(N)                                                     00093560
        J=J+1                                                           00093570
140     CONTINUE                                                        00093580
        GO TO 250                                                       00093590
200     NF1=NFN-NF                                                      00093600
        READ(5,1010)F1,F2                                               00093610
        D=DLOG(F2/F1)/(NF1-1)                                           00093620
        DO 210 I=1,NF1                                                  00093630
        FF(I)=F1*DEXP(DBLE  (I-1)*D)                                    R0093640
210     CONTINUE                                                        00093650
        J=NF1                                                           00093660
        IF(MODEX.EQ.1)GO TO 250                                         00093670
        DO 220 I=1,NF                                                   00093680
        J=J+1                                                           00093690
        FF(J)=FR(I)                                                     00093700
220     CONTINUE                                                        00093710
250     N2=NFN-1                                                        00093720
        DO 270 I=1,N2                                                   00093730
        I1=I+1                                                          00093740
        DO 260 J=I1,NFN                                                 00093750
        IF(FF(J).GE.FF(I))GO TO 260                                     00093760
        SWAP=FF(J)                                                      00093770
        FF(J)=FF(I)                                                     00093780
        FF(I)=SWAP                                                      00093790
260     CONTINUE                                                        00093800
270     CONTINUE                                                        00093810
        GO TO 400                                                       00093820
300     IF(MODEX.EQ.1)GO TO 400                                         00093830
        DO 310 I=1,NFN                                                  00093840
310     FF(I)=FR(I)                                                     00093850
400     WRITE(6,2020)(I,FF(I),I=1,NFN)                                  00093860
        IF(MODEX.EQ.1)WRITE(6,2180)                                     00093870
        NRD=0                                                           00093880
405     READ(5,1000)NFMX,HED                                            00093890
        WRITE(6,2030)NFMX,HED                                           00093900
        IF(NFMX.LT.2)WRITE(6,2050)                                      00093910
        READ(5,1010)(F(L),G(L),L=1,4)                                   00093920
        WRITE(6,2040)(F(L),G(L),L=1,4)                                  00093930
        IF(MODEX.EQ.0)GO TO 408                                         00093940
        NRD=NRD+4                                                       00093950
        IF(NRD.LT.NFMX)GO TO 405                                        00093960
        GO TO 500                                                       00093970
408     FOLD=F(1)                                                       00093980
        GOLD=G(1)                                                       00093990
        I=1                                                             00094000
        J=0                                                             00094010
        K=4                                                             00094020
        NFMX3=NFMX*3                                                    00094030
410     J=J+1                                                           00094040
        GO TO 430                                                       00094050
420     I=I+1                                                           00094060
        FOLD=F(I)                                                       00094070
        GOLD=G(I)                                                       00094080
430     IF(FF(J).GE.FOLD)GO TO 440                                      00094090
        WRITE(6,2050)                                                   00094100
        STOP                                                            00094110
440     IF(I.LT.4)GO TO 460                                             00094120
        K=K+4                                                           00094130
        IF(K.LE.NFMX3)GO TO 450                                         00094140
        WRITE(6,2050)                                                   00094150
        STOP                                                            00094160
450     READ(5,1010)(F(L),G(L),L=1,4)                                   00094170
        WRITE(6,2040)(F(L),G(L),L=1,4)                                  00094180
        I=0                                                             00094190
460     IF(FF(J).GT.F(I+1))GO TO 420                                    00094200
        DF=DLOG(F(I+1))-DLOG(FOLD)                                      00094210
        DG=DLOG(G(I+1))-DLOG(GOLD)                                      00094220
        IF(DF)470,420,480                                               00094230
470     WRITE(6,2060)                                                   00094240
        STOP                                                            00094250
480     SLOPE=DG/DF                                                     00094260
        GO=GRAV*(SLOPE*(DLOG(FF(J))-DLOG(FOLD))+GOLD)                   00094270
        DO 485 L=1,NF                                                   00094280
485     Q(L,J)=GO                                                       00094290
        IF(J.LT.NFN)GO TO 410                                           00094300
        IF(IPRINT.EQ.1)                                                 00094310
     &  WRITE(6,2070)(L,FF(L),Q(1,L),L=1,NFN)                           00094320
490     IF(K.GE.NFMX)GO TO 500                                          00094330
        READ(5,1010)F                                                   00094340
        K=K+4                                                           00094350
        GO TO 490                                                       00094360
500     NRD=0                                                           00094370
505     READ(5,1000)NFMX,HED                                            00094380
        WRITE(6,2080)NFMX,HED                                           00094390
        IF(NFMX.LT.2)WRITE (6,2090)                                     00094400
        READ(5,1010)(F(L),G(L),L=1,4)                                   00094410
        WRITE(6,2040)(F(L),G(L),L=1,4)                                  00094420
        IF(MODEX.EQ.0)GO TO 508                                         00094430
        NRD=NRD+4                                                       00094440
        IF(NRD.LT.NFMX)GO TO 505                                        00094450
        GO TO 600                                                       00094460
508     FOLD=F(1)                                                       00094470
        DOLD=G(1)                                                       00094480
        I=1                                                             00094490
        J=0                                                             00094500
        K=4                                                             00094510
        NFMX3=NFMX+3                                                    00094520
510     J=J+1                                                           00094530
        GO TO 530                                                       00094540
520     I=I+1                                                           00094550
        FOLD=F(I)                                                       00094560
        DOLD=G(I)                                                       00094570
530     IF(FF(J).GE.FOLD)GO TO 540                                      00094580
        WRITE(6,2090)                                                   00094590
        STOP                                                            00094600
540     IF(I.LT.4)GO TO 560                                             00094610
        K=K+4                                                           00094620
        IF(K.LE.NFMX3)GO TO 550                                         00094630
        WRITE(6,2090)                                                   00094640
        STOP                                                            00094650
550     READ(5,1010)(F(L),G(L),L=1,4)                                   00094660
        WRITE(6,2040)(F(L),G(L),L=1,4)                                  00094670
        I=0                                                             00094680
560     IF(FF(J).GT.F(I+1))GO TO 520                                    00094690
        DF=F(I+1)-FOLD                                                  00094700
        DD=G(I+1)-DOLD                                                  00094710
        IF(DF)570,520,580                                               00094720
570     WRITE(6,2060)                                                   00094730
        STOP                                                            00094740
580     SLOPE=DD/DF                                                     00094750
        DAMP(J)=(FF(J)-FOLD)*SLOPE+DOLD                                 00094760
        IF(J.LT.NFN)GO TO 510                                           00094770
        IF(IPRINT.EQ.1)                                                 00094780
     &  WRITE(6,2110)(L,FF(L),DAMP(L),L=1,NFN)                          00094790
590     IF(K.GE.NFMX)GO TO 600                                          00094800
        READ(5,1010)F                                                   00094810
        K=K+4                                                           00094820
        GO TO 590                                                       00094830
600     IF(MODEX.EQ.1)RETURN                                            00094840
        IF(IPRINT.EQ.1)WRITE(6,2160)                                    00094850
        DO 630 N=1,NFN                                                  00094860
        F0=FF(N)                                                        00094870
        XS=0.D0                                                         00094880
        YS=0.D0                                                         00094890
        DO 610 I=1,NF                                                   00094900
        F1=FR(I)                                                        00094910
      RNUM=2.0*DAMP(I)*F1*F0                                            00094920
      RDEN=F1*F1-F0*F0                                                  00094930
      IF(DABS(RNUM).LT.1.0E-10.AND.DABS(RDEN).LT.1.0E-10) GO TO 605     00094940
        PHI(I)=DATAN2(2.*DAMP(I)*F1*F0,F1*F1-F0*F0)                     00094950
        DEN=DSQRT((F1*F1-F0*F0)**2+(2.*DAMP(I)*F1*F0)**2)               00094960
        Q(I,N)=Q(I,N)*GAM(I)/(DEN*39.4784176D0)                         00094970
      GO TO 606                                                         00094980
  605 WRITE(6,2190)                                                     00094990
      Q(I,N)=1.0E10                                                     00095000
      PHI(I)=0.0D0                                                      00095010
  606 CONTINUE                                                          00095020
        XS=XS+Q(I,N)*DCOS(PHI(I))                                       00095030
        YS=YS+Q(I,N)*DSIN(PHI(I))                                       00095040
610     CONTINUE                                                        00095050
        IF(IPRINT.EQ.1)                                                 00095060
     &  WRITE(6,2150)F0,(I,PHI(I),Q(I,N),I=1,NF)                        00095070
        PHI0=DATAN2(YS,XS)                                              00095080
        IF(IPRINT.EQ.1)WRITE(6,2170)PHI0                                00095090
        DO 620 I=1,NF                                                   00095100
620     Q(I,N)=Q(I,N)*DCOS(PHI(I)-PHI0)                                 00095110
630     CONTINUE                                                        00095120
        IF(IPRINT.EQ.0)GO TO 650                                        00095130
        WRITE(6,2120)                                                   00095140
        DO 640 N=1,NFN                                                  00095150
640     WRITE(6,2130)FF(N),(Q(I,N),I=1,NF)                              00095160
650     REWIND 4                                                        00095170
        WRITE(4)Q,FF                                                    00095180
1000    FORMAT(I5,5X,15A4)                                              00095190
1010    FORMAT(8F10.0)                                                  00095200
1020    FORMAT(2F10.0,I5)                                               00095210
2000    FORMAT(1X ,15A4)                                                00095220
2010    FORMAT(32H0FREQUENCY OUTPUT REQUESTED FROM,E10.4,7H HZ. TO      00095230
     &  ,E10.4,4H HZ./5H WITH,I5,15H LOG INCREMENTS)                    00095240
2020    FORMAT(33H0REQUESTED FREQUENCIES FOR OUTPUT/                    00095250
     &18H NO.    FREQ.(HZ.)/(I5,1PE12.4))                               R0095260
2030    FORMAT(34H0TABLE OF LOG(G) VS LOG(FREQ) WITH,I5,7H POINTS/      00095270
     &  1X,15A4/22H FREQ, HZ.      PEAK G)                              00095280
2040    FORMAT((1PE10.3,3X,E10.3))                                      00095290
2050    FORMAT(47H0***ERROR*** NOT ENOUGH DATA POINTS FOR G LEVEL,      00095300
     &  6H TABLE)                                                       00095310
2060    FORMAT(40H0***ERROR*** FREQUENCY DATA OUT OF ORDER)             00095320
2070    FORMAT(45H0FINAL ACCELERATION APPLIED AT EACH FREQUENCY/        00095330
     &  34H  NO.     FREQ(HZ)    ACCELERATION/(I5,1P2E13.3))            00095340
2080    FORMAT(30H0TABLE OF DAMPING VS FREQ WITH,I5,7H POINTS/          00095350
     &  1X,15A4/26H FREQ(HZ)    DAMPING RATIO)                          00095360
2090    FORMAT(47H0***ERROR*** NOT ENOUGH DATA POINTS FOR DAMPING,      00095370
     &  6H TABLE)                                                       00095380
2110    FORMAT(39H0FINAL DAMPING RATIO FOR EACH FREQUENCY/              00095390
     &  35H  NO.     FREQ(HZ)    DAMPING RATIO/(I5,1PE13.3,0PF13.5))    00095400
2120    FORMAT(43H0FINAL AMPLITUDE (WITH RESPECT TO REFERENCE,          00095410
     &  13H PHASE ANGLE),37H OF EACH MODE FOR EACH DESIRED OUTPUT,      00095420
     &  10H FREQUENCY//8H APPLIED,12X,27HAMPLITUDES FOR MODE NUMBERS/   00095430
     &  6H  FREQ,12X,1H1,12X,1H2,12X,1H3,12X,1H4,12X,6H5.....)          00095440
2130    FORMAT(1P10E13.4/(13X,9E13.4))                                  00095450
2140    FORMAT(36H0***ERROR*** IMPROPER OPTION, ITYPE=,I12)             00095460
2150    FORMAT(19H0APPLIED FREQUENCY=,E10.3,3HHZ./                      00095470
     &  (25H   MODE ANGLE   AMPLITUDE)/5(13H    NO  (RAD),12X)/         00095480
     &  (1X,5(I5,F7.3,E13.4)))                                          00095490
2160    FORMAT(43H1TABLE OF RESPONSE (PHASE AND AMPLITUDE) OF,          00095500
     &  10H EACH MODE,26H AT EACH APPLIED FREQUENCY)                    00095510
2170    FORMAT(23H0REFERENCE PHASE ANGLE=,F6.3,8H RADIANS)              00095520
2180    FORMAT(44H0DURING THE DATA CHECK,THE STRUCTURE NATURAL,         00095530
     &  29H FREQUENCIES ARE SET TO ZERO.)                               00095540
 2190 FORMAT(5X,39HRESONANCE IS ACHIEVED, DAMPING IS ZERO.,             00095550
     12X,       48HAMPLITUDE IS SET TO AN ARBITRARY VALUE OF 1.0E10)    00095560
        RETURN                                                          00095570
        END                                                             00095580
      SUBROUTINE FRDSPR(ID,F,FI,X,FF,NEQB,NF,NDS,NUMNP,NBLOCK,NSB,ISIR) 00092390
      IMPLICIT REAL*8(A-H,O-Z)                                          00092400
      REAL*8  ID                                                        00092410
      INTEGER*2 ISIR                                                    00092420
      DIMENSION ID(NUMNP,3),F(8,NF),FI(NSB ,NF),X(NF,NDS),FF(NDS),NUM(1)R0092430
      COMMON/JUNK/JJ, NP,IC(6),D(8),L,  II,MSB,NS,NE,N,DDT,TIME,        00092440
     $                M,J,K,MM,KD(3,8),DD,XUM,IEQ,NRD                   00092450
     $                ,DM(8),TM(8),NRJUNK(354)                          R0092460
      COMMON / DYN / NT,NOT,DAMP,DT,RRDYN(3)                            R0092470
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7)                       R0092480
      COMMON /BAND/ KOPT,NRBAND(7)                                      R0092490
      COMMON /SSIT/ NV                                                  00092500
      DIMENSION ISIR(NUMNP)                                             00092510
      LBKS=4*NEQB*NF                                                    00092520
      LRDS=4*NEQB*NV                                                    00092530
      DT=DT*NOT                                                         00092540
      READ (5,230) KKK,ISP                                              00092550
      IF(KKK.EQ.0) RETURN                                               00092560
      REWIND 9                                                          00092570
      REWIND 8                                                          00092580
      READ (8) ID                                                       00092590
      NT1=17                                                            00092600
      IF(KOPT.GT.0) REWIND NT1                                          00092610
      IF(KSKIP.EQ.1) GO TO 5                                            00092620
      IF(KOPT.GT.0) READ (NT1)                                          00092630
      IF(KOPT.GT.0) READ (NT1) ISIR                                     00092640
    5 CONTINUE                                                          00092650
      L=0                                                               00092660
      NUM(1) = 0                                                        R0092670
      WRITE (6,220)                                                     00092680
  100 READ (5,230) NP,IC                                                00092690
      IF(NP.GT.0) WRITE(6,240)NP,IC                                     00092700
      IF(NP.GT.0) GO TO 120                                             00092710
      IF(L.EQ.0) GO TO 160                                              00092720
      IF (KSKIP.EQ.1) GO TO 110                                         00092730
      WRITE (9) KD,L                                                    00092740
  110 CONTINUE                                                          00092750
      NUM(1) = NUM(1) + 1                                               R0092760
      GO TO 160                                                         00092770
  120 DO 150 I=1,6                                                      00092780
      II=IC(I)                                                          00092790
      IF(II.EQ.0) GO TO 100                                             00092800
  130 L=L+1                                                             00092810
      KD(1,L)=NP                                                        00092820
      N=NP                                                              00092830
      IF(KOPT.GT.0)   NP=ISIR(N)                                        00092840
      KD(2,L)=II                                                        00092850
      CALL UNPKID (   ID,NUMNP,W      ,WX      ,2,NP,II)                00092860
      NP=N                                                              00092870
      NNN=W                                                             00092880
      KD(3,L)=NNN                                                       00092890
      IF(NNN.LE.0) L=L-1                                                00092900
      IF(L.LT.8) GO TO 150                                              00092910
      IF (KSKIP.EQ.1) GO TO 140                                         00092920
      WRITE (9) KD,L                                                    00092930
  140 CONTINUE                                                          00092940
      NUM(1) = NUM(1) + 1                                               R0092950
      L=0                                                               00092960
  150 CONTINUE                                                          00092970
      GO TO 100                                                         00092980
  160 IF(NUM(1).EQ.0) RETURN                                            R0092990
      WRITE (6,250) KKK,ISP                                             00093000
      IF (KSKIP.EQ.1)RETURN                                             00093010
      REWIND 3                                                          00093020
      REWIND 9                                                          00093030
      REWIND 10                                                         00093040
      READ (10)                                                         00093050
      NE=NSB                                                            00093060
      NS=NE+1-NEQB                                                      00093070
      DO 170 I=1,NBLOCK                                                 00093080
      READ (10)((FI(J,K),J=NS,NE),K=1,NF)                               00093090
      NS=NS-NEQB                                                        00093100
  170 NE=NE-NEQB                                                        00093110
      NUMRR = NUM(1)                                                            
      DO 190 N=1,NUMRR                                                  R0093120
      READ (9) KD,L                                                     00093130
      DO 180 I=1,L                                                      00093140
      II=KD(3,I)                                                        00093150
      DO 180 J=1,NF                                                     00093160
  180 F(I,J)=FI(II,J)                                                   00093170
  190 WRITE (3) L,KD,F                                                  00093180
  200 CONTINUE                                                          00093190
      CALL FRDSPL (X,F,FF,NF,NDS,NUM,1,KKK,2,ISP)                       00093200
  210 RETURN                                                            00093210
  220 FORMAT (35H1DISPLACEMENT COMPONENTS FOR WHICH ,                   00093220
     $   19H OUTPUT IS REQUIRED  //                                     00093230
     $ 31H  NODE  DISPLACEMENT COMPONENTS  /)                           00093240
  230 FORMAT (7I5)                                                      00093250
  240 FORMAT (I5,4X,6I3)                                                00093260
  250 FORMAT (/16H OUTPUT TYPE....,I1/                                  00093270
     $         16H PLOT SPACING...,I1)                                  00093280
      END                                                               00093290
      SUBROUTINE FRDSPL (X,F,FF,NF,NDS,NUM,NN,KKK,ISD,ISP)              00091450
      IMPLICIT REAL*8(A-H,O-Z)                                          00091460
      REAL*8  NPAR                                                      00091470
      DIMENSION FF(NDS),X(NF,NDS),F(8,NF),NUM(NN)                       00091480
      COMMON / JUNK /TM(8),DM(8),D(8),KD(3,8),RRJUNK(191)               R0091490
      COMMON / DYN / NT,NOT,DAMP,DT,RRDYN(3)                            R0091500
      COMMON / ELPAR / NPAR(14),RRELPA(29)                              R0091510
      REWIND 3                                                          00091520
      REWIND 4                                                          00091530
      READ (4) X,FF                                                     00091540
      DO 320 N=1,NN                                                     00091550
      REWIND 2                                                          00091560
      REWIND 9                                                          00091570
      MM=NUM(N)                                                         00091580
  100 IF(MM.EQ.0) GO TO 320                                             00091590
      DO 270 M=1,MM                                                     00091600
      READ (3) L,KD,F                                                   00091610
      GO TO (110,160,140),KKK                                           00091620
  110 IF(ISD.EQ.1) GO TO 120                                            00091630
      WRITE (6,330) M                                                   00091640
      GO TO 130                                                         00091650
  120 WRITE (6,390) M                                                   00091660
  130 WRITE (6,400) (KD(1,I),KD(2,I),I=1,L)                             00091670
      GO TO 160                                                         00091680
  140 IF(M.GT.1) GO TO 160                                              00091690
      IF(ISD.EQ.1) GO TO 150                                            00091700
      WRITE (6,340)                                                     00091710
      WRITE (6,450)                                                     00091720
      GO TO 160                                                         00091730
  150 WRITE (6,410)                                                     00091740
      WRITE (6,430)                                                     00091750
  160 DO 170 I=1,L                                                      00091760
      TM(I)=0.                                                          00091770
  170 DM(I)=0.                                                          00091780
      DO 230 K=1,NDS                                                    00091790
      TIME=FF(K)                                                        00091800
      DO 200 I=1,L                                                      00091810
      DD=0.                                                             00091820
      DO 180 J=1,NF                                                     00091830
  180 DD = DD + F(I,J)*X(J,K)                                           00091840
      AD= DABS(DD)                                                      00091850
      IF(AD-DM(I)) 200,200,190                                          00091860
  190 DM(I)=AD                                                          00091870
      TM(I)=TIME                                                        00091880
  200 D(I)=DD                                                           00091890
      GO TO (210,220,230),KKK                                           00091900
  210 WRITE (6,350) TIME,(D(I),I=1,L)                                   00091910
      GO TO 230                                                         00091920
  220 WRITE (9) D                                                       00091930
  230 CONTINUE                                                          00091940
      GO TO (240,250,260),KKK                                           00091950
  240 WRITE (6,360) (DM(I),I=1,L)                                       00091960
      WRITE (6,370) (TM(I),I=1,L)                                       00091970
      GO TO 270                                                         00091980
  250 WRITE (2) KD,DM,TM,L                                              00091990
      GO TO 270                                                         00092000
  260 WRITE (6,380) (KD(1,I),KD(2,I),DM(I),TM(I),I=1,L)                 00092010
  270 CONTINUE                                                          00092020
      IF(KKK.NE.2) GO TO 320                                            00092030
      REWIND 2                                                          00092040
      REWIND 9                                                          00092050
      DO 310 M=1,MM                                                     00092060
      GO TO (280,290),ISD                                               00092070
  280 WRITE (6,420) M                                                   00092080
      WRITE (6,430)                                                     00092090
      GO TO 300                                                         00092100
  290 WRITE (6,440) M                                                   00092110
      WRITE (6,450)                                                     00092120
  300 CALL FPLOTD (2,9,NDS,ISP)                                         00092130
  310 CONTINUE                                                          00092140
  320 CONTINUE                                                          00092150
      RETURN                                                            00092160
  330 FORMAT (1X ,      43H NUMBER OF SELECTED DISPLACEMENT COMPONENTS, 00092170
     $ 5H..... ,I3//10X,40HNODE NUMBERS AND DISPLACEMENT COMPONENTS )   00092180
340     FORMAT(1X ,35H MAXIMUM DISPLACEMENT VALUES FROM A,              00092190
     &42H STEADY STATE SINUSOIDAL RESPONSE ANALYSIS//)                  00092200
  350 FORMAT (F8.3,2X,1P8E12.3)                                         00092210
  360 FORMAT ( /24H MAXIMUM ABSOLUTE VALUES //                          00092220
     $ 10H MAXIMUM   ,1P8E12.3)                                         00092230
  370 FORMAT (10H FREQ      ,1P8E12.3)                                  00092240
  380 FORMAT (I6,I13,1PE18.3,E12.3,5X,2HNA)                             00092250
  390 FORMAT (1X ,       37H NUMBER OF SELECTED STRESS COMPONENTS,      00092260
     $ 5H..... , I3//10X,37H ELEMENT AND STRESS COMPONENT NUMBERS )     00092270
  400 FORMAT (8H    FREQ , 2X, 8(I8,1H-,I2,1X))                         00092280
  410 FORMAT (                                                          00092290
     $1X ,58H MAXIMUM STRESS VALUES FROM SINUSOIDAL RESPONSE ANALYSIS//)00092300
  420 FORMAT (                                                          00092310
     $ 39H1NORMALISED PLOT OF STRESS HISTORIES...,I3/)                  00092320
  430 FORMAT(58H  ELEMENT      STRESS       MAXIMUM      FREQ AT     PLO00092330
     $T / 58H  NUMBER     COMPONENT       VALUE       MAXIMUM    SYMBOL)00092340
  440 FORMAT (46H1NORMALISED PLOT OF DISPLACEMENT HISTORIES....,I3/)    00092350
  450 FORMAT(58H   NODE     DISPLACEMENT    MAXIMUM      FREQ AT     PLO00092360
     $T / 58H  NUMBER     COMPONENT       VALUE       MAXIMUM    SYMBOL)00092370
      END                                                               00092380
      SUBROUTINE FPLOTD (IT,JT,NDS,ISP)                                 00090550
      IMPLICIT REAL*8 (A-H,O-Z)                                         00090560
      COMMON /QTSARG/ PP(101),KD(3,8),XM(8),TM(8),IP(8),X(8),RRQTSA(859)R0090570
      COMMON /DYN/    NT,NOT,DAMP,DT,RRDYN(3)                           R0090580
      DIMENSION SM(8)                                                   00090590
      DATA SM /1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8 /                        00090600
      DATA BL /1H /,V /1HX/,AST /1H*/                                   00090610
      LINE=53                                                           00090620
      READ (IT) KD,XM,TM,L                                              00090630
      WRITE (6,260) (KD(1,I),KD(2,I),XM(I),TM(I),I,I=1,L)               00090640
      DO 100 K=1,L                                                      00090650
      TT = XM(K)                                                        00090660
      IF(  DABS(TT).GT.1.0D-8 ) XM(K) = 50.0D0/ TT                      00090670
  100 CONTINUE                                                          00090680
      TT=0.E0                                                           00090690
      WRITE (6,220)                                                     00090700
  110 FORMAT(/4X,47HNOTE - AN * INDICATES MORE THAN ONE PLOT SYMBOL)    00090710
      WRITE (6,230)                                                     00090720
      WRITE (6,240) TT,(V,I=1,101),TT                                   00090730
      LLCT=9                                                            00090740
      K=1                                                               00090750
      DO 120 I=2,100                                                    00090760
  120 PP(I)=BL                                                          00090770
      DO 210 N=1,NDS                                                    00090780
      READ (JT) X                                                       00090790
      PP(1)=V                                                           00090800
      PP(51)=V                                                          00090810
      PP(101)=V                                                         00090820
  130 II=ISP                                                            00090830
  140 IF(II.LE.0) GO TO 150                                             00090840
      WRITE (6,250) PP                                                  00090850
      LLCT=LLCT+1                                                       00090860
      IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101)                         00090870
      IF(LLCT.EQ.LINE) WRITE(6,230)                                     00090880
      IF(LLCT.EQ.LINE) WRITE(6,110)                                     00090890
      IF(LLCT.EQ.LINE) WRITE(6,220)                                     00090900
      IF(LLCT.EQ.LINE) WRITE(6,230)                                     00090910
      IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101)                         00090920
      IF(LLCT.EQ.LINE) LLCT=9                                           00090930
      II=II-1                                                           00090940
      GO TO 140                                                         00090950
  150 TT=TT+DT                                                          00090960
      DO 170 I=1,L                                                      00090970
      XX=XM(I)*X(I)                                                     00090980
      M=XX                                                              00090990
      M=M+51                                                            00091000
      IP(I)=M                                                           00091010
      IF(PP(M).EQ.V .OR. PP(M).EQ.BL) GO TO 160                         00091020
      PP(M) = AST                                                       00091030
      GO TO 170                                                         00091040
  160 PP(M) = SM(I)                                                     00091050
  170 CONTINUE                                                          00091060
      IF(K.LT.10)  GO TO 180                                            00091070
      K=1                                                               00091080
      WRITE (6,240) TT,PP,TT                                            00091090
      LLCT=LLCT+1                                                       00091100
      IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101)                         00091110
      IF(LLCT.EQ.LINE) WRITE(6,230)                                     00091120
      IF(LLCT.EQ.LINE) WRITE(6,110)                                     00091130
      IF(LLCT.EQ.LINE) WRITE(6,220)                                     00091140
      IF(LLCT.EQ.LINE) WRITE(6,230)                                     00091150
      IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101)                         00091160
      IF(LLCT.EQ.LINE) LLCT=9                                           00091170
      GO TO 190                                                         00091180
  180 WRITE (6,250) PP                                                  00091190
      LLCT=LLCT+1                                                       00091200
      IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101)                         00091210
      IF(LLCT.EQ.LINE) WRITE(6,230)                                     00091220
      IF(LLCT.EQ.LINE) WRITE(6,110)                                     00091230
      IF(LLCT.EQ.LINE) WRITE(6,220)                                     00091240
      IF(LLCT.EQ.LINE) WRITE(6,230)                                     00091250
      IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101)                         00091260
      IF(LLCT.EQ.LINE) LLCT=9                                           00091270
      K=K+1                                                             00091280
  190 DO 200 I=1,L                                                      00091290
      M=IP(I)                                                           00091300
  200 PP(M)=BL                                                          00091310
  210 CONTINUE                                                          00091320
      TT=TT+DT                                                          00091330
      WRITE (6,240) TT,(V,I=1,101),TT                                   00091340
      WRITE (6,230)                                                     00091350
      WRITE(6,110)                                                      00091360
      RETURN                                                            00091370
  220 FORMAT (1X ,57X,15HO R D I N A T E )                              00091380
  230 FORMAT ( / 1H ,3X,7HT I M E,2X,4H-1.0,21X,4H-0.5,22X,3H0.0,22X,   00091390
     $        3H0.5,22X,3H1.0,4X,7HT I M E, 1X)                         00091400
  240 FORMAT (1H ,F10.4,4X,101A1,F12.4)                                 00091410
  250 FORMAT (1H ,14X,101A1)                                            00091420
  260 FORMAT (I8,12X,I3,1P2E14.4,3X,I6)                                 00091430
      END                                                               00091440
      SUBROUTINE FRSTRS (T  ,SF,FI,X,FF,NF,NSB,NDS,NEQB,NBLOCK,SA)      00096540
      IMPLICIT REAL*8(A-H,O-Z)                                          00096550
      REAL*8  NPAR                                                      00096560
      DIMENSION NUM(1),SF(8,NF),FI(NSB,NF),X(NF,NDS),FF(NDS)            R0096570
      DIMENSION SA(1)                                                   00096580
      COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00096590
     $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN                00096600
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7)                       R0096610
      COMMON / JUNK / N,NEL,IS(12),M,I,L,KS(3,8),II,K,J,SS,JJ           00096620
     $                ,NUME,NE,NRJUNK(405)                              R0096630
      NT1=1                                                             00096640
      READ (5,190) KKK,ISP                                              00096650
      IF(KKK.EQ.0) RETURN                                               00096660
      N=1                                                               00096670
      IF (KSKIP.EQ.1) GO TO 105                                         00096680
      REWIND 10                                                         00096690
      READ (10)                                                         00096700
      NE=NSB                                                            00096710
      NS1=NE+1-NEQB                                                     00096720
      DO 100 I=1,NBLOCK                                                 00096730
      READ (10)((FI(J,K),J=NS1,NE),K=1,NF)                              00096740
      NS1=NS1-NEQB                                                      00096750
  100 NE=NE-NEQB                                                        00096760
  105 CONTINUE                                                          00096770
      CALL RDWRT(NT1,SA,1,6,JK)                                         00096780
      REWIND 3                                                          00096790
      WRITE (6,210)                                                     00096800
      WRITE (6,220)                                                     00096810
      READ (5,190) NEL,IS                                               00096820
      WRITE (6,200) NEL,IS                                              00096830
      NUME=NUMEL+NUMEL2                                                 00096840
      L=0                                                               00096850
      NUM(N)=0                                                          00096860
      DO 170 M=1,NUME                                                   00096870
      IF (KSKIP.EQ.1) GO TO 110                                         00096880
      CALL RDWRT(NT1,SA,NEMN,0,KOUNT)                                   00096890
  110 CONTINUE                                                          00096900
      NS1=SA(KOUNT-1)                                                   00096910
      ND1=SA(KOUNT-2)                                                   00096920
      IF(NEL.NE.M) GO TO 170                                            00096930
      IF(KSKIP.EQ.1) GO TO 155                                          00096940
      DO 150 I=1,NS1                                                    00096950
      II=IS(I)                                                          00096960
      IF(II.EQ.0) GO TO 160                                             00096970
      NPN=ND1+II                                                        00096980
      L=L+1                                                             00096990
      KS(1,L)=NEL                                                       00097000
      KS(2,L)=II                                                        00097010
      DO 140 K=1,NF                                                     00097020
      SS=0.                                                             00097030
      DO 130 J=1,ND1                                                    00097040
      NELM=NPN+(J-1)*NS1                                                00097050
      JJ=SA(J)                                                          00097060
      IF(JJ) 130,130,120                                                00097070
  120 SS = SS + SA(NELM)*FI(JJ,K)                                       00097080
  130 CONTINUE                                                          00097090
  140 SF(L,K)=SS                                                        00097100
      IF(L.LT.8) GO TO 150                                              00097110
      WRITE (3) L,KS,SF                                                 00097120
      L=0                                                               00097130
      NUM(N)=NUM(N) + 1                                                 00097140
  150 CONTINUE                                                          00097150
  155 CONTINUE                                                          00097160
  160 READ  (5,190) NEL,IS                                              00097170
      IF(NEL.GT.0) WRITE(6,200)NEL,IS                                   00097180
  170 CONTINUE                                                          00097190
      IF(L.EQ.0) GO TO 180                                              00097200
      IF (KSKIP.EQ.1) GO TO 180                                         00097210
      WRITE (3) L,KS,SF                                                 00097220
      NUM(N)=NUM(N) + 1                                                 00097230
  180 CONTINUE                                                          00097240
      WRITE (6,230) KKK,ISP                                             00097250
      IF (KSKIP.EQ.1)RETURN                                             00097260
      NELTYP=1                                                          00097270
      CALL FRDSPL (X,SF,FF,NF,NDS,NUM,NELTYP,KKK,1,ISP)                 00097280
      RETURN                                                            00097290
  190 FORMAT (13I5)                                                     00097300
  200 FORMAT (I6,4X,12I3)                                               00097310
210     FORMAT(27H1STRESS COMPONENTS REQUIRED)                          00097320
  220 FORMAT (/16H ELEMENT TYPE .. ,F4.2//                              00097330
     $ 38H ELEMENT     DESIRED STRESS COMPONENTS )                      00097340
  230 FORMAT (/16H OUTPUT TYPE....,I1/                                  00097350
     $         16H PLOT SPACING...,I1)                                  00097360
      END                                                               00097370
