      SUBROUTINE EIGEN                                                  00067990
      IMPLICIT REAL*8 (A-H,O-Z)                                         00068000
      COMMON A(1)                                                       00068010
      COMMON /ELPAR/ XP(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ  00068020
     & ,RRELPA(24)                                                      R0068021
      COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM,  00068030
     $NAT,NTTT,NOT,NRDYN2(9)                                            R0068040
      COMMON/DYN3/ NEIG,NAD,ANORM,NVV,NFQ                               00068050
      COMMON /DYN4/KDYN,NRESS,NCRD,NCWT,NRESS1                          00068060
      COMMON/SLVE/NSLAVE                                                00068070
       COMMON /TAPES/NSTIF,NRED,NL,NR,NT,NMASS                          00068080
      COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS                      R0068090
      COMMON / MISC / NBLOCK,NEQB,LL,NF,LB                              R0068100
      COMMON /QTSARG/ AT(400),RRQTSA(600)                               R0068110
      COMMON /EXTRA/ MODEX,NT8,NREXTR(24)                               R0068120
      COMMON /OUT/IDUMM(4),IOSIG,IODISP,NROUT(4)                        R0068130
      COMMON /HEADIN/TITLE1(20),TITLE2(5),TITLE3(10)                    00068140
      DIMENSION TT(3)                                                   00068150
        CALL FILES(13)                                                  00068160
      CALL SECOND (TT(1))                                               00068170
      WRITE (6,190)                                                     00068180
      IF(IABS(KDYN).EQ.11) WRITE(6,270)                                 00068190
  100 IF (MODEX.EQ.1) RETURN                                            00068200
      TPI=6.2831853E0                                                   00068210
      NFQ=NFO                                                           00068220
      IF (IFPR.GT.0) IFPR=1                                             00068230
      IF (IFSS.GT.0) IFSS=1                                             00068240
      IF (NITEM.EQ.0) NITEM=16                                          00068250
      IF (RTOL.EQ.0.E0) RTOL=1.E-05                                     00068260
      IF (COFQ.EQ.0.E0) COFQ=1.E08                                      00068270
      IF(NEIG.EQ.0) WRITE(6, 170)                                       00068280
      IF(NEIG.GT.0) WRITE(6, 180)                                       00068290
      CALL MODE4 (NEQ,MBAND,NBLOCK,NEQB,NF,MTOT,IFPR,IFSS,RTOL,NITEM,   00068300
     $COFQ)                                                             00068310
      IF(MODEX.EQ.1) RETURN                                             00068320
      IF(MODEFR.EQ.1) RETURN                                            00068330
      CALL SECOND (TT(2))                                               00068340
      NZ=NR                                                             00068350
      IF(NEIG.EQ.0)NZ=NT                                                00068360
      IF(NCWT.LE.0)GO TO 105                                            00068370
      IF(NRESS1.EQ.0)REWIND NCWT                                        00068380
      WRITE (NCWT) NEQ,NBLOCK,NEQB,MBAND,N1,NF,(AT(I),I=1,NF)           00068390
      REWIND NZ                                                         00068400
      NWW=NEQB*NF                                                       00068410
      READ(NZ) (A(I),I=1,NF)                                            00068420
      WRITE(NCWT) (A(I),I=1,NF)                                         00068430
      DO 103 I=1,NBLOCK                                                 00068440
      CALL RDWRT(NZ,A,NWW,14,I)                                         00068450
      CALL RDWRT(NCWT,A,NWW,13,I)                                       00068460
  103 CONTINUE                                                          00068470
      WRITE(6,104)NCWT,NF                                               00068480
  104 FORMAT(46H   THE CURRENT EIGENSOLUTIONS HAVE BEEN STORED/         00068490
     X       25H   ON TAPE, UNIT NUMBER =,I5/                           00068500
     X       25H   NUMBER OF FREQUENCIES=,I5//)                         00068510
  105 CONTINUE                                                          00068520
      REWIND NZ                                                         00068530
      READ (NZ) (A(I),I=1,NF)                                           00068540
      IF(IABS(KDYN).EQ.11) GO TO 1120                                   00068550
      K=NF+1                                                            00068560
      DO 110 I=1,NF                                                     00068570
      K=K-1                                                             00068580
      KK=(K-1)*3+1                                                      00068590
      A(KK)=A(K)                                                        00068600
      A(KK+1)=A(K)/TPI                                                  00068610
  110 A(KK+2)=TPI/A(K)                                                  00068620
      IF (NEIG.GT.0) GO TO 130                                          00068630
      WRITE (6,200)                                                     00068640
      DO 120 I=1,NF                                                     00068650
      K1=3*I-2                                                          00068660
      K2=3*I                                                            00068670
  120 WRITE (6,220) I,(A(J),J=K1,K2)                                    00068680
      GO TO 150                                                         00068690
  130 WRITE (6,210)                                                     00068700
      DO 140 I=1,NF                                                     00068710
      K1=3*I-2                                                          00068720
      K2=3*I                                                            00068730
  140 WRITE (6,220) I,(A(J),J=K1,K2),AT(NF+I)                           00068740
      GO TO 150                                                         00068750
 1120 WRITE(6,280)                                                      00068760
      DO 1130 I=1,NF                                                    00068770
 1130 WRITE(6,290) I,A(I),AT(NF+I)                                      00068780
  150 N2=N1+NUMNP*3                                                     00068790
      N3=N2+6*NF                                                        00068800
      N4=N3+NEQB*NF                                                     00068810
      N5=N4+NSLAVE*4                                                    00068820
      IF(N5.GT.MTOT) CALL ERROR(N5-MTOT)                                00068830
      NSLDM=NSLAVE                                                      00068840
      IF(NSLDM.LE.0) NSLDM=1                                            00068850
      IF(IODISP.EQ.1) CALL FCOPY(L5TP6,L6TP50)                          00068860
      IF(IODISP.EQ.1) TITHOL=TITLE3(3)                                  00068870
      WRITE (6,230)                                                     00068880
      CALL PRINT4 (A(N1),A(N2),A(N3),NEQB,NUMNP,NF,NBLOCK,NEQ,NZ,NF,A(1)00068890
     $,A(N4),NSLDM)                                                     00068900
      IF(IODISP.EQ.1) WRITE(6,260)                                      00068910
      IF(IODISP.EQ.1) WRITE(6,250)                                      00068920
      IF(IODISP.EQ.1) TITLE3(3)= TITHOL                                 00068930
      CALL SECOND (TT(3))                                               00068940
      DO 160 K=1,2                                                      00068950
  160 TT(K) = TT(K+1)-TT(K)                                             00068960
      WRITE (6,240) (TT(L),L=1,2)                                       00068970
      XP(1)=TT(1)+TT(2)                                                 00068980
  170 FORMAT (44H0DETERMINANT SEARCH SOLUTION IS CARRIED OUT  )         00068990
  180 FORMAT (44H0SUBSPACE ITERATION SOLUTION IS CARRIED OUT  )         00069000
  190 FORMAT (1X ,//41H E I G E N V A L U E   A N A L Y S I S   )       00069010
  200 FORMAT (1X ,20HPRINT OF FREQUENCIES  //                           00069020
     $            23H MODE       CIRCULAR     /                         00069030
     $            49H NUMBER     FREQUENCY    FREQUENCY    PERIOD      /00069040
     $            49H           (RAD/SEC)  (CYCLES/SEC)    (SEC)       )00069050
  210 FORMAT (1X ,20HPRINT OF FREQUENCIES  //                           00069060
     $            23H MODE       CIRCULAR    /                          00069070
     $            58H NUMBER     FREQUENCY    FREQUENCY    PERIOD    TOL00069080
     $ERANCE    /                                                       00069090
     $            49H           (RAD/SEC)  (CYCLES/SEC)    (SEC)       )00069100
  220 FORMAT (1H0,I4,6X,4(E10.4,2X))                                    00069110
  230 FORMAT (/// 22H PRINT OF EIGENVECTORS, // 1X)                     00069120
  240 FORMAT (//// 44H E I G E N S O L U T I O N   T I M E   L O G,     00069130
     $        //5X,15HEIGENSOLUTION =, F8.2 /                           00069140
     $          5X,15HPRINTING      =, F8.2 /)                          00069150
  250 FORMAT(///20X,32(1H')/20X,32HMODE SHAPES WILL NOT BE PRINTED./20X,00069160
     1 31(1H')//)                                                       00069170
260   FORMAT (/)                                                        00069180
  270 FORMAT(1H+,42X,39HF O R   B U C K L I N G   P R O B L E M//)      00069190
  280 FORMAT (1X ,22H PRINT OF EIGENVALUES //                           00069200
     $            39H MODE       EIGENVALUE        TOLERANCE)           00069210
  290 FORMAT (1H0,I4,6X,E10.4,8X,E10.4)                                 00069220
      RETURN                                                            00069230
      END                                                               00069240
      SUBROUTINE WRDIS4(NORD,A,B,NUMNP,LL,NDPBLK,NDIS,NBLK              00326130
     &  ,AD,XXK,ARE,NREL,ISL,NSLDM)                                     00326140
      IMPLICIT REAL*8(A-H,O-Z)                                          00326150
      DIMENSION NORD(NUMNP),A(6,LL),B(NDPBLK,6,LL)                      00326160
     &  ,AD(NUMNP,3),XXK(NREL,6,LL),ARE(51,NREL),DX(3),ISL(NSLDM,4)     00326170
      COMMON /OUT/ KDUMMY(9),KROT                                       00326180
      COMMON /BAND/ KOPT,NRBAND(7)                                      R0326190
      COMMON/SLVE/NSLAVE                                                00326200
        COMMON /RIGID/ IIA(20),NREX                                     00326210
      NT1=17                                                            00326220
      NT2=18                                                            00326230
      IF(NSLAVE.NE.0) REWIND 30                                         00326240
      IF(NSLAVE.NE.0) READ(30)((ISL(I,J),J=1,4),I=1,NSLAVE)             00326250
        NT40=40                                                         00326260
        REWIND 8                                                        00326270
        READ(8)AD                                                       00326280
      IF(KOPT.GT.0) READ (NT1) NORD                                     00326290
        IF(NREX.LE.0)GO TO 10                                           00326300
        REWIND NT40                                                     00326310
        READ(NT40)ARE                                                   00326320
        REWIND NT2                                                      00326330
        K=NUMNP+1                                                       00326340
        DO 8 JJ=1,NUMNP                                                 00326350
        K=K-1                                                           00326360
        KK=K                                                            00326370
        IF(KOPT.GT.0)KK=NORD(K)                                         00326380
        DO 7 J=1,NREX                                                   00326390
        NN=ARE(2,J)                                                     00326400
        IF(KK.NE.NN)GO TO 7                                             00326410
        READ(NT2)A                                                      00326420
        DO 5 M=1,6                                                      00326430
        DO 5 L=1,LL                                                     00326440
5       XXK(J,M,L)=A(M,L)                                               00326450
        GO TO 8                                                         00326460
7       CONTINUE                                                        00326470
        READ(NT2)                                                       00326480
8       CONTINUE                                                        00326490
10      CONTINUE                                                        00326500
      KSHF2=0                                                           00326510
      KSHF=1-NDPBLK                                                     00326520
      KNT=0                                                             00326530
      DO 140 I=1,NBLK                                                   00326540
      REWIND NT2                                                        00326550
      KOUNT=0                                                           00326560
      KK=NUMNP+1                                                        00326570
      KSHF=KSHF+NDPBLK                                                  00326580
      KSHF2=KSHF2+NDPBLK                                                00326590
      DO 110 JJ=1,NUMNP                                                 00326600
      KK=KK-1                                                           00326610
      READ (NT2) A                                                      00326620
      KCH= KK                                                           00326630
      IF(KOPT.GT.0) KCH=NORD(KK)                                        00326640
      IF(KCH.LT.KSHF.OR.KCH.GT.KSHF2)  GO TO 110                        00326650
      KNT=KNT+1                                                         00326660
      KOUNT=KOUNT+1                                                     00326670
      NSHFT=KCH-KSHF+1                                                  00326680
      DO 100 K=1,6                                                      00326690
      DO 100 M=1,LL                                                     00326700
  100 B(NSHFT,K,M)=A(K,M)                                               00326710
        IF(NREX.LE.0)GO TO 109                                          00326720
        DO 108 J=1,NREX                                                 00326730
        NN=ARE(1,J)+1                                                   00326740
        NK=ARE(2,J)                                                     00326750
        DO 107 K=3,NN                                                   00326760
        N=ARE(K,J)                                                      00326770
        IF(N.NE.NSHFT)GO TO 107                                         00326780
        DO 101 M=4,6                                                    00326790
        DO 101 L=1,LL                                                   00326800
101     B(NSHFT,M,L)=XXK(J,M,L)                                         00326810
        NQA=NSHFT                                                       00326820
        NQB=NK                                                          00326830
        IF(KOPT.LE.0)GO TO 1015                                         00326840
        DO 1010 L=1,NUMNP                                               00326850
        IF(NORD(L).NE.NSHFT)GO TO 1009                                  00326860
        NQA=L                                                           00326870
1009    IF(NORD(L).NE.NK)GO TO 1010                                     00326880
        NQB=L                                                           00326890
1010    CONTINUE                                                        00326900
1015    CONTINUE                                                        00326910
        DO 102 M=1,3                                                    00326920
        CALL UNPKID(AD,NUMNP,X,XJ,1,NQA,M)                              00326930
        CALL UNPKID(AD,NUMNP,X,XK,1,NQB,M)                              00326940
102     DX(M)=XK-XJ                                                     00326950
        DO 104 L=1,LL                                                   00326960
        B(NSHFT,1,L)=XXK(J,1,L)-XXK(J,5,L)*DX(3)+XXK(J,6,L)*DX(2)       00326970
        B(NSHFT,2,L)=XXK(J,2,L)+XXK(J,4,L)*DX(3)-XXK(J,6,L)*DX(1)       00326980
        B(NSHFT,3,L)=XXK(J,3,L)-XXK(J,4,L)*DX(2)+XXK(J,5,L)*DX(1)       00326990
104     CONTINUE                                                        00327000
        GO TO 109                                                       00327010
107     CONTINUE                                                        00327020
108     CONTINUE                                                        00327030
109     CONTINUE                                                        00327040
      IF(NSLAVE.EQ.0) GO TO 1200                                        00327050
      DO 1120 J=1,NSLAVE                                                00327060
      IF(KK.EQ.ISL(J,1)) GO TO 1130                                     00327070
 1120 CONTINUE                                                          00327080
      GO TO 1200                                                        00327090
 1130 CONTINUE                                                          00327100
      ISLRF=J                                                           00327110
      DO 1180 J=1,3                                                     00327120
      NMAST=MOD(ISL(ISLRF,J+1),10000)                                   00327130
      IF(NMAST.EQ.0) GO TO 1180                                         00327140
      DO 1160 M=1,3                                                     00327150
      CALL UNPKID(AD,NUMNP,X,XJ,1,NMAST,M)                              00327160
      CALL UNPKID(AD,NUMNP,X,XK,1,KK,M)                                 00327170
 1160 DX(M)=XK-XJ                                                       00327180
      DO 1170 L=1,LL                                                    00327190
      IF(J.EQ.1) B(NSHFT,1,L)=B(NSHFT,1,L)+DX(3)*B(NSHFT,5,L)           00327200
     1                                    -DX(2)*B(NSHFT,6,L)           00327210
      IF(J.EQ.2) B(NSHFT,2,L)=B(NSHFT,2,L)-DX(3)*B(NSHFT,4,L)           00327220
     1                                    +DX(1)*B(NSHFT,6,L)           00327230
      IF(J.EQ.3) B(NSHFT,3,L)=B(NSHFT,3,L)+DX(2)*B(NSHFT,4,L)           00327240
     1                                    -DX(1)*B(NSHFT,5,L)           00327250
 1170 CONTINUE                                                          00327260
 1180 CONTINUE                                                          00327270
 1200 CONTINUE                                                          00327280
      IF(KOUNT.EQ.NDPBLK.OR.KNT.EQ.NUMNP)  GO TO 120                    00327290
  110 CONTINUE                                                          00327300
  120 KNT1=(I-1)*NDPBLK                                                 00327310
      DO 130 J=1,NDPBLK                                                 00327320
      KNT1=KNT1+1                                                       00327330
      IF(KNT1.GT.NUMNP) GO TO 150                                       00327340
      WRITE(6,160)KNT1,(M,(B(J,K,M),K=1,6),M=1,LL)                      00327350
      IF(NDIS.GT.0) WRITE (NDIS,170) KNT1,(  (B(J,K,M),K=1,3),M=1,LL)   00327360
      IF(NDIS.GT.0.AND.KROT.EQ.2) WRITE (NDIS,170) KNT1,(  (B(J,K,M),K=400327370
     $,6),M=1,LL)                                                       00327380
        DO 125 M=1,LL                                                   00327390
125     WRITE(32,200)KNT1,M,(B(J,K,M),K=1,6)                            00327400
200     FORMAT(2I5,6F20.10)                                             00327410
  130 CONTINUE                                                          00327420
  140 CONTINUE                                                          00327430
  150 IF(KOPT.GT.0) WRITE(6,180)                                        00327440
  160 FORMAT(1H0,I4,I5,1P3E12.3,3E11.2/(I10,3E12.3,3E11.2))             00327450
  170 FORMAT(I10,7E10.4/(8E10.4))                                       00327460
  180 FORMAT(// 3X,46H*** NOTE *** NODE NUMBERS ARE ORIGINAL NUMBERS //)00327470
      RETURN                                                            00327480
      END                                                               00327490
      SUBROUTINE PRINT4(ID,D,B,NEQB,NUMNP,LL,NBLOCK,NEQ,NT,NF,DIS,ISL,  00175920
     1NSLDM)                                                            00175930
      IMPLICIT REAL*8(A-H,O-Z)                                          00175940
      REAL*8  ID                                                        00175950
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7)                       R0175960
      COMMON /OUT/NRES,NSTR,NDIS,NROUT(7)                               R0175970
      DIMENSION DIS(10,LL),ISL(NSLDM,4)                                 00175980
      COMMON /QTSARG/ NEQ3(10),RRQTSA(995)                              R0175990
      COMMON /GPS/ NEQ4(10),NRGPS(10)                                   R0176000
      COMMON/SLVE/NSLAVE                                                00176010
      COMMON /ELPAR/ XPAR(14),NDUM(8),MTOT                              00176020
     $,IZX(6),NUMEL,NUMEL2,NRELPA(41)                                   R0176030
        COMMON/RIGID/IIA(20),NREX                                       00176040
      COMMON A(1)                                                       00176050
      DIMENSION ID(NUMNP,3),B(NEQB,LL),D(6,LL)                          00176060
      IF(NDIS.LT.0) RETURN                                              00176070
      REWIND NT                                                         00176080
      IF(NF.GT.0) READ (NT)                                             00176090
      REWIND 8                                                          00176100
      READ (8) ID                                                       00176110
      IF(NSLAVE.NE.0) REWIND 30                                         00176120
      IF(NSLAVE.NE.0) READ(30)((ISL(I,J),J=1,4),I=1,NSLAVE)             00176130
      REWIND 17                                                         00176140
      REWIND 18                                                         00176150
        NREL=NREX                                                       00176160
        IF(NREL.LE.0)NREL=1                                             00176170
      NDPBLK=(MTOT-(16*LL)-4*NUMNP-(6*LL+51)*NREL-NSLDM*4)/(6*LL)       00176180
      NBLK= (NUMNP-1)/NDPBLK+1                                          00176190
      KK=1                                                              00176200
      NFIL=1                                                            00176210
      IF(NDIS.GT.0) WRITE(NDIS,7123)NFIL,LL,NDYN,NDIS,NSTR,NUMNP,NUMEL,N00176220
     $UMEL2                                                             00176230
7123  FORMAT(2I5,5X,7I5)                                                00176240
      M=NEQ                                                             00176250
      NN=NEQB*NBLOCK                                                    00176260
      IF(NF.EQ.0) WRITE (6,220)                                         00176270
      IF(NF.GT.0) WRITE (6,240)                                         00176280
      N=NUMNP                                                           00176290
      DO 100 I=1,10                                                     00176300
  100 NEQ3(I)=0                                                         00176310
      DO 210 KK=1,NUMNP                                                 00176320
      I=6                                                               00176330
      DO 190 II=1,6                                                     00176340
      DO 110 L=1,LL                                                     00176350
  110 D(I,L)=0.                                                         00176360
      IF(M.GT.NN) GO TO 120                                             00176370
      IF (M.EQ.0) GO TO 120                                             00176380
      READ (NT) B                                                       00176390
      NN=NN-NEQB                                                        00176400
      K=M-NN                                                            00176410
      ND=0                                                              00176420
  120 CALL UNPKID ( ID  ,NUMNP,W      ,WX      ,2,N,I)                  00176430
      NNN=W                                                             00176440
      IF(NNN.LT.1) GO TO 190                                            00176450
      K=M-NN                                                            00176460
      KI=0                                                              00176470
      DO 130 L=1,10                                                     00176480
      IF(NNN.EQ.NEQ4(L)) KI=L                                           00176490
  130 CONTINUE                                                          00176500
      IF(KI.EQ.0) GO TO 160                                             00176510
      IF(NEQ3(KI).GT.0) GO TO 140                                       00176520
      K=K-M+NNN                                                         00176530
      IF(K.LT.0) GO TO 140                                              00176540
         NEQ3(KI)=1                                                     00176550
      IF(NNN.EQ.M)  M=M-1                                               00176560
      GO TO 170                                                         00176570
  140 DO 150 L=1,LL                                                     00176580
  150 D(I,L)=DIS(KI,L)                                                  00176590
      IF(NNN.EQ.M)  M=M-1                                               00176600
      GO TO 190                                                         00176610
  160 CONTINUE                                                          00176620
      IF(NSLAVE.EQ.0) GO TO 168                                         00176630
      DO 163 J=1,NSLAVE                                                 00176640
      IF(N.EQ.ISL(J,1)) GO TO 164                                       00176650
  163 CONTINUE                                                          00176660
      GO TO 168                                                         00176670
  164 CONTINUE                                                          00176680
      IRK=I                                                             00176690
      IF(IRK.LE.3) NMAST=MOD(ISL(J,IRK+1),10000)                        00176700
      IF(IRK.GT.3) NMAST=ISL(J,IRK-2)/10000                             00176710
      IF(NMAST.EQ.0) GO TO 168                                          00176720
      NEND=NN+NEQB+1                                                    00176730
      IF(NNN.LE.NN) GO TO 1170                                          00176740
      IF(NNN.GE.NEND) GO TO 1195                                        00176750
      KI=NNN-NN                                                         00176760
      DO 165 L=1,LL                                                     00176770
  165 D(I,L)=B(KI,L)                                                    00176780
      GO TO 190                                                         00176790
 1170 NNRK=NN                                                           00176800
 1175 NNRK=NNRK-NEQB                                                    00176810
      NENDRK=NNRK+NEQB+1                                                00176820
      READ (NT) B                                                       00176830
      IF (NNN.LE.NNRK) GO TO 1175                                       00176840
      KI=NNN-NNRK                                                       00176850
      DO 1180 L=1,LL                                                    00176860
 1180 D(I,L)=B(KI,L)                                                    00176870
      IF(NN.EQ.NNRK) GO TO 190                                          00176880
      REWIND NT                                                         00176890
      NNRK=NEQB*NBLOCK                                                  00176891
      READ (NT)                                                         00176900
      GO TO 1230                                                        00176910
 1195 REWIND NT                                                         00176920
      READ (NT)                                                         00176930
      NNRK=NEQB*NBLOCK                                                  00176940
 1200 NNRK=NNRK-NEQB                                                    00176950
      READ(NT) B                                                        00176960
      IF(NNN.LE.NNRK) GO TO 1200                                        00176970
      KI=NNN-NNRK                                                       00176980
      DO 1220 L=1,LL                                                    00176990
 1220 D(I,L)=B(KI,L)                                                    00177000
      IF(NN.EQ.NNRK) GO TO 190                                          00177010
 1230 NNRK=NNRK-NEQB                                                    00177020
      NENDRK=NNRK+NEQB+1                                                00177030
      READ (NT)                                                         00177040
      IF(NN.EQ.NNRK) GO TO 190                                          00177050
      GO TO 1230                                                        00177060
  168 CONTINUE                                                          00177070
      M=M-1                                                             00177080
  170 KND=K-ND                                                          00177090
      DO 180 L=1,LL                                                     00177100
      IF(KI.EQ.0) GO TO 180                                             00177110
      DIS(KI,L)=B(KND,L)                                                00177120
  180 D(I,L)=B(KND,L)                                                   00177130
  190 I=I-1                                                             00177140
  200 FORMAT (2I5)                                                      00177150
      WRITE (18) D                                                      00177160
  210 N=N-1                                                             00177170
      K=1+10*LL                                                         00177180
      N2=K+NUMNP                                                        00177190
      N3=N2+6*LL                                                        00177200
      N4=N3+6*LL*NDPBLK                                                 00177210
        N5=N4+NUMNP*3                                                   00177220
        N6=N5+NREL*6*LL                                                 00177230
        N7=N6+51*NREL                                                   00177240
      N8=N7+NSLAVE*4                                                    00177250
      IF(N8.GT.MTOT) CALL ERROR(N8-MTOT)                                00177260
      CALL WRDIS4(A(K),A(N2),A(N3),NUMNP,LL,NDPBLK,NDIS,NBLK            00177270
     &  ,A(N4),A(N5),A(N6),NREL,A(N7),NSLDM)                            00177280
      RETURN                                                            00177290
  220 FORMAT (40H1.......NODE DISPLACEMENTS AND ROTATIONS//             00177300
     $  5H NODE, 5H LOAD ,11X, 1HX, 11X, 1HY, 11X ,1HZ ,9X, 2HXX,       00177310
     $  9X, 2HYY, 9X, 2HZZ)                                             00177320
  230 FORMAT (1H0,I4,I5,1P3E12.3,3E11.2/(I10,3E12.3,3E11.2))            00177330
  240 FORMAT (19H1.......MODE SHAPES  //                                00177340
     $  5H0NODE, 5H MODE, 11X, 1HX, 11X, 1HY, 11X, 1HZ, 9X ,2HXX,       00177350
     $   9X, 2HYY, 9X, 2HZZ)                                            00177360
  250 FORMAT (I10,7E10.4/(8E10.4))                                      00177370
      END                                                               00177380
      SUBROUTINE MODE4 (NEQ,MBAND,NBLOCK,NEQB,NF,MTOT,IFPR,IFSS,RTOL,   00137150
     $NITEM,COFQ)                                                       00137160
      IMPLICIT REAL*8 (A-H,O-Z)                                         00137170
      COMMON /EXTRA/ MODEX,NREXTR(25)                                   R0137180
      COMMON/DYN3/ NEIG,NAD,ANORM,NVV,NFO                               00137190
      COMMON /DYN4/KDYN,NRESS,NCRD,NCWT,NRESS1                          R0137200
      COMMON/MASS/LMASS                                                 00137210
       COMMON /TAPES/NSTIF,NRED,NL,NR,NT,NMASS                          00137220
      COMMON /SSIT/ NV                                                  00137230
CC    COMMON /AAA1/AAR(8000)                                            R0137231
       COMMON A(1)                                                      00137240
       IF (NEIG.GT.0) GO TO 120                                         00137250
      IF(NVV.GE.NF) GO TO 100                                           00137260
      WRITE (6,160) NF,NVV                                              00137270
      MODEX=1                                                           00137280
      RETURN                                                            00137290
  100 CONTINUE                                                          00137300
       NIM=3                                                            00137310
       NVM=6                                                            00137320
       NC=NF+NIM                                                        00137330
       NCA=NEQ*MAX0(MBAND,NC)                                           00137340
       N2=1 + NCA                                                       R0137350
       N3=N2+NEQ                                                        00137360
       IF(LMASS.EQ.1) N3=N2+NEQ*MBAND                                   00137370
       N4=N3+NEQ                                                        00137380
       N5=N4+NEQ                                                        00137390
       N6=N5+NEQ                                                        00137400
       N7=N6+NEQ*NVM                                                    00137410
       N8=N7+NEQ*NVM                                                    00137420
       N9=N8+NC                                                         00137430
       N10=N9+NC                                                        00137440
       N11=N10+NC                                                       00137450
       N12=N11+NC                                                       00137460
  110 CONTINUE                                                          00137470
       CALL SECANT  (A(1),A(N2),A(N3),A(N4),A(N5),A(N6),A(N7),A(N8),A(N900137480
     $),A(N10),A(N11),A(N12),NEQ,MBAND,NF,NC,IFPR,ANORM,COFQ)           00137490
      IF(MODEX.EQ.1) RETURN                                             00137500
       GO TO 150                                                        00137510
  120  NWA=NEQB*MBAND                                                   00137520
       NV=2*NF                                                          00137530
       IF (NF.GT.8) NV=NF+8                                             00137540
       IF (NAD.NE.0) NV=NAD                                             00137550
       IF(NV.GT.NVV.AND.IABS(KDYN).EQ.11) NV=NVV                        00137560
      IF(NF.EQ.1.AND.IABS(KDYN).EQ.11) NV=NF                            00137570
       IF (NVV.GE.NV) GO TO 130                                         00137580
       WRITE (6,160) NV,NVV                                             00137590
      MODEX=1                                                           00137600
      RETURN                                                            00137610
  130  NWV=NV*NEQB                                                      00137620
       NTB=(MBAND-2)/NEQB+1                                             00137630
       IF (NTB.GE.NBLOCK) NTB=NBLOCK-1                                  00137640
       NWVV=NWV*(NTB+1)                                                 00137650
      IF(NCRD.LE.0)GO TO 140                                            00137660
      IF(NRESS.EQ.0)REWIND NCRD                                         00137670
      READ (NCRD) NEQO,MBLOCK ,NEQBO,MBANDO,N1O,NFO                     00137680
      MMA=1                                                             00137690
      IF(LMASS.EQ.1) MMA=MBAND                                          00137700
      N2=1+NEQBO*NFO                                                    00137710
      N3=N2+NEQB*NV                                                     00137720
      N4=N3+NEQB*MMA                                                    00137730
      CALL SBLOCK(A(1),A(N2),A(N3),A(N4),NFO,NV,NEQBO,NEQB,MBLOCK,NBLOCK00137740
     $,MMA,NEQ,NEQO)                                                    00137750
  140  CONTINUE                                                         00137760
       CALL SSPACE  (NEQ,MBAND,NBLOCK,NEQB,NF,NV,NWA,NWV,NWVV,NTB,IFPR, 00137770
     $IFSS,NITEM,RTOL,ANORM,COFQ)                                       00137780
  150  RETURN                                                           00137790
  160 FORMAT (/// 32H0***ERROR   SOLUTION TERMINATED., /                00137800
     $        12X,40HNUMBER OF NON-ZERO MASSES REQUIRED     =, I5 /     00137810
     $        12X,40HNUMBER OF EXISTING MASSES IN THE MODEL =, I5 )     00137820
      END                                                               00137830
      DOUBLE PRECISION FUNCTION MODUE (T,M)                             00150250
      IMPLICIT REAL*8(A-H,O-Z)                                          00150260
      COMMON/MATL/MATLCO                                                00150270
      DATA NHIGH/4HHIGH/                                                R0150280
      IF(MATLCO.NE.NHIGH)GO TO 10                                       00150290
      CALL MODUE2 (T,M,X)                                               00150300
      MODUE=X*1.0D6                                                     00150310
      RETURN                                                            00150320
   10 CALL MODUE1 (T,M,X)                                               00150330
      MODUE=X*1.0D6                                                     00150340
      RETURN                                                            00150350
      END                                                               00150360
      SUBROUTINE BANDET (A,B,V,MAXA,NN,NWA,RA,NSCH,DET,ISCALE,KK)       0021770 
      IMPLICIT REAL*8 (A-H,O-Z)                                         00021780
      COMMON /EXTRA/ MODEX,NREXTR(25)                                   R0021790
      COMMON /MASS/ LMASS                                               00021800
      COMMON /TAPES/NSTIF,NRTAPE(5)                                     R0021810
       DIMENSION A(NWA),B(1),V(1),MAXA(1)                               00021820
       NR=NN-1                                                          00021830
       IF (KK-2) 100,360,400                                            00021840
  100  TOL=1.0E+07                                                      00021850
       RTOL=1.0E-10                                                     00021860
      IPOW=80                                                           00021870
      USCALE=2.D0**IPOW                                                 00021880
      BSCALE=2.D0**(-IPOW)                                              00021890
      DET=1.0D0                                                         00021900
      ISCALE=0                                                          00021910
       NTF=3                                                            00021920
       IS=1                                                             00021930
  110 CALL RDWRT(NSTIF,A,1,6,I)                                         00021940
CC    CALL EXPAND(A,NWA,NSTIF)                                          00021950
      READ (NSTIF) (A(IIR),IIR=1,NWA)                                   R0021951
      IF(LMASS.EQ.1) GO TO 120                                          00021960
      CALL QMR2(A(1),A(1),RA,B(1),NN,1,1,1)                             00021970
      GO TO 130                                                         00021980
  120 CALL QMR3(A(1),A(1),RA,B(1),NN,1,1,1,NWA)                         00021990
  130  IF (NWA.EQ.NN) GO TO 280                                         00022000
       DO 270 N=1,NR                                                    00022010
       IH=N+NWA-NN                                                      00022020
  140  IF (A(IH)) 160,150,160                                           00022030
  150  IH=IH-NN                                                         00022040
       GO TO 140                                                        00022050
  160  MAXA(N)=IH                                                       00022060
       PIV=A(N)                                                         00022070
      IF(PIV) 200,170,200                                               00022080
  170 IS = IS+1                                                         00022090
      IF(IS.LE.NTF) GO TO 190                                           00022100
  180 WRITE (6,450) NTF,RA                                              00022110
      MODEX=1                                                           00022120
      RETURN                                                            00022130
  190 RA = RA*(1.0E0-RTOL)                                              00022140
      GO TO 110                                                         00022150
  200  IL=N+NN                                                          00022160
       L=N                                                              00022170
       DO 260 I=IL,IH,NN                                                00022180
       L=L+1                                                            00022190
       C=A(I)                                                           00022200
       IF (C) 210,260,210                                               00022210
  210  C=C/PIV                                                          00022220
       IF ( DABS(C).LT.TOL) GO TO 240                                   00022230
  220  IS=IS+1                                                          00022240
       IF (IS.LE.NTF) GO TO 230                                         00022250
      GO TO 180                                                         00022260
  230  RA=RA*(1.0E0-RTOL)                                               00022270
       GO TO 110                                                        00022280
  240  J=L-I                                                            00022290
      CALL QMR2(A(L),A(L),C,A(I),(IH-I)/NN+1,NN,NN,NN)                  00022300
       A(I)=C                                                           00022310
  260  CONTINUE                                                         00022320
  270  CONTINUE                                                         00022330
  280  IF (A(NN).NE.0.0E0) GO TO 300                                    00022340
       AA= DABS(A(1))                                                   00022350
       DO 290 I=2,NR                                                    00022360
  290  AA=AA+ DABS(A(I))                                                00022370
       A(NN)=-(AA/NR)*1.0D-14                                           00022380
  300  NSCH=0                                                           00022390
       ISC=0                                                            00022400
       DET=1.0E0                                                        00022410
       DO 320 I=1,NN                                                    00022420
  310  DET=DET*A(I)                                                     00022430
      IF(DET.LT.USCALE.AND.DET.GE.BSCALE) GO TO 320                     00022440
      CALL RSC(DET,ISCALE)                                              00022450
  320  IF (A(I).LT.0.E0) NSCH=NSCH+1                                    00022460
      RETURN                                                            00022470
  360  IL=NN                                                            00022480
       DO 390 N=1,NR                                                    00022490
       C=V(N)                                                           00022500
       V(N)=C/A(N)                                                      00022510
       IF (NWA-NN) 370,390,370                                          00022520
  370  IL=IL+1                                                          00022530
       IH=MAXA(N)                                                       00022540
       K=N                                                              00022550
      NP1=N+1                                                           00022560
      CALL QMR2(V(NP1),V(NP1),C,A(IL),(IH-IL)/NN+1,1,1,NN)              00022570
  390  CONTINUE                                                         00022580
       V(NN)=V(NN)/A(NN)                                                00022590
  400  IF (NWA-NN) 410,440,410                                          00022600
  410  N=NN                                                             00022610
       DO 430 L=2,NN                                                    00022620
       N=N-1                                                            00022630
       IL=N+NN                                                          00022640
       IH=MAXA(N)                                                       00022650
       K=N                                                              00022660
       DO 420 I=IL,IH,NN                                                00022670
       K=K+1                                                            00022680
  420  V(N)=V(N)-A(I)*V(K)                                              00022690
  430  CONTINUE                                                         00022700
  440  RETURN                                                           00022710
  450 FORMAT (37H0***ERROR   SOLUTION STOP IN *BANDET*, / 12X,          00022720
     $        1H(,I3,37H) TRIANGULAR FACTORIZATIONS ATTEMPTED, / 12X,   00022730
     $        16HCURRENT SHIFT = ,E20.14 / 1X)                          00022740
      END                                                               00022750
      SUBROUTINE SBLOCK(VOLD,VNEW,XM,VR,NFO,NV,NEQBO,NEQB,MBLOCK,NBLOCK,00221890
     $MMA,NEQ,NEQO)                                                     00221900
      IMPLICIT REAL*8 (A-H,O-Z)                                         00221910
      COMMON /TAPES/ NSTIF,NRED,NL,NR,NT,NMASS                          00221920
      COMMON /DYN4/KDYN,NRESS,NCRD,NCWT,NRESS1                          R0221930
      COMMON/MASS/LMASS                                                 00221940
CC    COMMON /AAA1/ VOLD(200,40)                                        R0221941
      DIMENSION VOLD(NEQBO,NFO),VNEW(NEQB,NV),XM(NEQB,MMA)              R0221950
      DIMENSION VR(NEQB,NV)                                             00221960
      LRDS=NEQB*4*(MMA+1)                                               00221970
      LBKS=NEQB*4*MMA                                                   00221980
      LNCRDR=NEQBO*NFO*4                                                00221990
      NWDSV=NEQB*NV                                                     00222000
      NWDSV=NEQB*NV                                                     00222010
      NWMA=NEQB*MMA                                                     00222020
      IF(LMASS.NE.1) GO TO 50                                           00222030
      WRITE(6,998)                                                      00222040
  998 FORMAT(5X,14HVOLD IN SBLOCK)                                      00222050
      JJO=0                                                             00222060
      JJ=0                                                              00222070
      INO=0                                                             00222080
      NEQBLN=NEQ-NEQB*(NBLOCK-1)                                        00222090
      NEQBLO=NEQO-NEQBO*(MBLOCK-1)                                      00222100
 1120 RRSB = 0.0D0                                                      R0222101
      CALL MEMSET(RRSB ,VNEW(1,1),NWDS)                                 R0222110
      INN=NEQB                                                          00222120
 1150 IF(INO.EQ.0) GO TO 1180                                           00222130
      GO TO 1200                                                        00222140
 1180 CONTINUE                                                          00222150
 1190 CONTINUE                                                          00222160
      JJ0=JJ0+1                                                         00222170
      IF(JJO.GT.MBLOCK) GO TO 1300                                      00222180
      READ(NCRD) VOLD                                                   00222190
      INO=NEQBO                                                         00222200
      IF(JJO.NE.1) GO TO 1220                                           00222210
      NN1=INO-NEQBLO                                                    00222220
      NN2=INN-NEQBLN                                                    00222230
      INO=INO-NN1+NN2                                                   00222240
 1220 CONTINUE                                                          00222250
 1230 IF(INN.EQ.0) GO TO 1250                                           00222260
      IF(INO.GT.NEQBO) GO TO 1245                                       00222270
 1200 DO 1240 J=1,NFO                                                   00222280
      VNEW(INN,J)=VOLD(INO,J)                                           00222290
 1240 CONTINUE                                                          00222300
 1245 INN=INN-1                                                         00222310
      INO=INO-1                                                         00222320
      IF(INO.EQ.0.AND.INN.NE.0) GO TO 1190                              00222330
      GO TO 1230                                                        00222340
 1250 WRITE(NL)VNEW                                                     00222350
      JJ=JJ+1                                                           00222360
      GO TO 1120                                                        00222370
 1300 CONTINUE                                                          00222380
      CALL GDYNIN(VNEW,NV,NBLOCK,NEQB,18,NL)                            00222390
      CALL QMBAND(XM,VNEW,VR(1,1),VR(1,1),VR(1,1),NEQB,MMA,NV,NBLOCK,   00222400
     1NWMA,NEQ,NMASS,18,23,24,NT)                                       00222410
      RETURN                                                            00222420
   50 CONTINUE                                                          00222430
      DO 100 L=1,MBLOCK                                                 00222440
      READ (NCRD)                                                       00222450
  100 CONTINUE                                                          00222460
      KBLOCK=1                                                          00222470
      LBLOCK=0                                                          00222480
      I=0                                                               00222490
      K=0                                                               00222500
      REWIND NMASS                                                      00222510
      READ (NMASS) XM                                                   00222520
      REWIND NT                                                         00222530
      BACKSPACE NCRD                                                    00222540
      READ (NCRD) VOLD                                                  00222550
      BACKSPACE NCRD                                                    00222560
      GO TO 160                                                         00222570
  110 K=K+1                                                             00222580
      I=I+1                                                             00222590
      XMM=XM(I,1)                                                       00222600
      DO 120 J=1,NFO                                                    00222610
  120 VNEW(I,J)=VOLD(K,J)*XMM                                           00222620
      IF (K.LT.NEQBO) GO TO 140                                         00222630
      K=0                                                               00222640
      KBLOCK=1+KBLOCK                                                   00222650
      IF(KBLOCK -MBLOCK ) 130,130,150                                   00222660
  130 BACKSPACE NCRD                                                    00222670
      READ (NCRD) VOLD                                                  00222680
      BACKSPACE NCRD                                                    00222690
  140 IF (I.LT.NEQB) GO TO 110                                          00222700
      I=0                                                               00222710
      READ (NMASS) XM                                                   00222720
  150 LBLOCK=LBLOCK+1                                                   00222730
      WRITE (NT) VNEW                                                   00222740
      IF (LBLOCK.EQ.NBLOCK) RETURN                                      00222750
  160 RRSB = 0.0D0                                                      R0222751
      CALL MEMSET(RRSB ,VNEW(1,1),NWDSV)                                R0222760
      GO TO 110                                                         00222770
      END                                                               00222780
      SUBROUTINE GDYNIN(VL,NV,NBLOCK,NEQB,N18,NL)                       00104670
      IMPLICIT REAL*8 (A-H,O-Z)                                         00104680
      DIMENSION VL(NEQB,NV)                                             00104690
      LNLRC=NEQB*NV*4                                                   00104700
      REWIND NL                                                         00104710
      REWIND N18                                                        00104720
      DO 90 I=1,NBLOCK                                                  00104730
   90 READ (NL)                                                         00104740
      DO 100 I=1,NBLOCK                                                 00104750
      BACKSPACE NL                                                      00104760
      READ (NL) VL                                                      00104770
      BACKSPACE NL                                                      00104780
  100 WRITE (N18) VL                                                    00104790
      RETURN                                                            00104800
      END                                                               00104810
      SUBROUTINE QMBAND(B,V,A,C,D,NEQB,MBAND,NF,NBLOCK,NWMA,NEQ         00185790
     1,NMASS,NL,MM1,MM2,NT)                                             00185800
      IMPLICIT REAL*8(A-H,O-Z)                                          00185810
      DIMENSION B(NEQB,MBAND),V(NEQB,NF),A(NEQB,NF)                     00185820
     $,C(NEQB,NF),D(NEQB,NF)                                            00185830
      NUM=NWMA                                                          00185840
      N1=MM1                                                            00185850
      N2=MM2                                                            00185860
      CALL RDWRT(N1   ,A,1,6,I)                                         00185870
      CALL RDWRT(N2   ,A,1,6,I)                                         00185880
      CALL RDWRT(NMASS,A,1,6,I)                                         00185890
      REWIND NL                                                         00185900
      NEQBL=NEQ-(NBLOCK-1)*NEQB                                         00185910
      NTB=(MBAND-2)/NEQB+1                                              00185920
      IF (NTB.GE.NBLOCK) NTB=NBLOCK-1                                   00185930
      DO 1000 N=1,NBLOCK                                                00185940
      NEQBB=NEQB                                                        00185950
      DO 90 I=1,NEQBB                                                   00185960
      DO 90 J=1,NF                                                      00185970
      C(I,J)=0.0E0                                                      00185980
      D(I,J)=0.0E0                                                      00185990
   90 A(I,J)=0.0E0                                                      00186000
      IF(N.EQ.1) GO TO 500                                              00186010
  100 IF(NTB.LT.1) GO TO 300                                            00186020
      NMBEG=N-NTB                                                       00186030
      IF(NMBEG.LE.0) NMBEG=1                                            00186040
      NMEND=N-1                                                         00186050
      NTEMP=NMBEG-1                                                     00186060
      IF(NTEMP.EQ.0) GO TO 230                                          00186070
      DO 220 J=1,NTEMP                                                  00186080
      READ(NL) V                                                        00186090
  220 CONTINUE                                                          00186100
  230 CONTINUE                                                          00186110
      MM=NMEND-NMBEG+1                                                  00186120
      DO 260 NN=NMBEG,NMEND                                             00186130
      READ(NL)V                                                         00186140
      READ (N1) B                                                       00186150
      DO 250 I=1,NEQBB                                                  00186160
      DO 250 J=1,NF                                                     00186170
      M=MM*NEQBB+I                                                      00186180
      DO 240 K=1,NEQBB                                                  00186190
      IF(M.GT.MBAND) GO TO 240                                          00186200
      A(I,J)=A(I,J)+B(K,M)*V(K,J)                                       00186210
  240 M=M-1                                                             00186220
  250 CONTINUE                                                          00186230
      MM=MM-1                                                           00186240
      NTEMP=N-NN                                                        00186250
 1992 FORMAT(5X,10E12.5)                                                00186260
      IF(NTEMP.GE.NTB) GO TO 260                                        00186270
      WRITE (N2) B                                                      00186280
  260 CONTINUE                                                          00186290
  300 CONTINUE                                                          00186300
  500 CONTINUE                                                          00186310
      READ(NMASS) B                                                     00186320
      READ(NL) V                                                        00186330
      DO 570 I=1,NEQBB                                                  00186340
      DO 570 J=1,NF                                                     00186350
      DO 550 K=1,NEQBB                                                  00186360
      IF(K.GT.MBAND) GO TO 550                                          00186370
      KK=I+K-1                                                          00186380
      IF(KK.GT.NEQBB) GO TO 550                                         00186390
      C(I,J)=C(I,J)+B(I,K)*V(KK,J)                                      00186400
  550 CONTINUE                                                          00186410
      IF(I.EQ.1) GO TO 570                                              00186420
      IF(NEQBB.EQ.1) GO TO 570                                          00186430
      KK=I-1                                                            00186440
      L=I-NEQBB+1                                                       00186450
      IF(L.LT.1) L=1                                                    00186460
      M=I                                                               00186470
      DO 560 K=L,KK                                                     00186480
      IF(M.GT.MBAND) GO TO 560                                          00186490
      C(I,J)=C(I,J)+B(K,M)*V(K,J)                                       00186500
  560 M=M-1                                                             00186510
  570 CONTINUE                                                          00186520
      IF(NTB.LT.1) GO TO 900                                            00186530
      IF(N.EQ.NBLOCK) GO TO 930                                         00186540
      NTBB=NTB                                                          00186550
      NTEMP=NTB+N                                                       00186560
      IF(NTEMP.LE.NBLOCK) GO TO 580                                     00186570
      NTBB=NBLOCK-N                                                     00186580
  580 CONTINUE                                                          00186590
      DO 650 NN=1,NTBB                                                  00186600
      READ (NL) V                                                       00186610
      DO 600 I=1,NEQBB                                                  00186620
      DO 600 J=1,NF                                                     00186630
      DO 590 K=1,NEQBB                                                  00186640
      KK=NN*NEQBB+K-I+1                                                 00186650
      IF(KK.GT.MBAND) GO TO 590                                         00186660
      D(I,J)=D(I,J)+B(I,KK)*V(K,J)                                      00186670
  590 CONTINUE                                                          00186680
  600 CONTINUE                                                          00186690
  650 CONTINUE                                                          00186700
  900 CONTINUE                                                          00186710
      REWIND NL                                                         00186720
      WRITE (N2) B                                                      00186730
  930 CONTINUE                                                          00186740
      WRITE (NT) A                                                      00186750
      M=N2                                                              00186760
      N2=N1                                                             00186770
      N1=M                                                              00186780
      CALL RDWRT(N1,A,1,6,I)                                            00186790
      CALL RDWRT(N2,A,1,6,I)                                            00186800
 1000 CONTINUE                                                          00186810
      RETURN                                                            00186820
      END                                                               00186830
      SUBROUTINE SECANT  (A,B,V,MAXA,W,VV,WW,ROOT,TIM,ERRVL,ERRVR,      00229210
     $NITE,N,MA,NROOT,NC,IFPR,ANORM,COFQ)                               00229220
      IMPLICIT REAL*8 (A-H,O-Z)                                         00229230
      COMMON /EXTRA/ MODEX,NREXTR(25)                                   R0229240
      COMMON/DYN4/KDYN,NRESS,NCRD,NCWT,NRESS1                           R0229250
      COMMON /DYN5/ FRSHFT,RRDYN5(3)                                    R0229260
      COMMON/MASS/LMASS                                                 00229270
CC    COMMON /AAA1/ A(200,40)                                           R0229271
       COMMON /TAPES/NSTIF,NRED,NL,NR,NT,NMASS                          00229280
       DIMENSION A(N,NC),B(N,NC),V(N),W(N),VV(N,6),WW(N,6),ROOT(NC),    00229290
     $TIM(NC),ERRVL(NC),ERRVR(NC)                                       R0229300
       INTEGER NITE(200),MAXA(N)                                        R0229310
      COMMON /QTSARG/ AT(400),RRQTSA(600)                               R0229320
       IFPR = 1                                                         R0229321
       ACTOL=1.0D-04                                                    00229330
       RCBTOL=1.D-05                                                    00229340
       RTOL=1.0D-10                                                     00229350
      FACT=1.0D-3                                                       00229360
       RQTOL=1.0D-12                                                    00229370
      RITOL=1.0D-6                                                      00229380
      NC1=NC+1                                                          00229390
       NTF=5                                                            00229400
       IITEM=10                                                         00229410
       NITEM=20                                                         00229420
      NITEMM=59                                                         00229430
       NVM=6                                                            00229440
       REWIND NT                                                        00229450
       REWIND NMASS                                                     00229460
      IF(LMASS.EQ.1) GO TO 50                                           00229470
      READ (NMASS)(B(I,1),I=1,N)                                        00229480
      GO TO 60                                                          00229490
   50 READ (NMASS) ((B(I,J),I=1,N),J=1,MA)                              00229500
   60 CONTINUE                                                          00229510
       ETA=2.0E0                                                        00229520
       NOV=0                                                            00229530
       JR=1                                                             00229540
       NSK=0                                                            00229550
       NWA=N*MA                                                         00229560
       ISC=1000                                                         00229570
      MMA=1                                                             00229580
      IF(LMASS.EQ.1) MMA=MA                                             00229590
       NMWA=N*MMA                                                       00229600
       IF (N.GT.1) GO TO 110                                            00229610
      IF(B(1,1).GT.0.E0) GO TO 100                                      00229620
      WRITE(6,1000)                                                     00229630
      STOP                                                              00229640
  100 CALL RDWRT(NSTIF,A,1,6,I)                                         00229650
CC    CALL EXPAND(A,2  ,NSTIF)                                          00229660
      READ (NSTIF) (A(II,1),II=1,2)                                     R0229661
      ROOT(1)=A(1,1)/B(1,1)                                             00229670
      NSCH=1                                                            00229680
      IF(IABS(KDYN).EQ.11) A(1,1)=1.0D0/DSQRT(DABS(B(1,1)))             00229690
      IF(IABS(KDYN).EQ.11) GO TO 760                                    00229700
      A(1,1)= 1.E0/ DSQRT(B(1,1))                                       00229710
      GO TO 760                                                         00229720
  110 CALL SECOND(TIM1)                                                 00229730
       RA=0.0E0                                                         00229740
       RR=0.0E0                                                         00229750
      CALL RDWRT(NSTIF,A,1,6,I)                                         00229760
CC    CALL EXPAND(A,NWA,NSTIF)                                          00229770
      WRITE (6,1001) N,NC,NSTIF
 1001 FORMAT (5X,'*** N NC NSTIF IN SECANT ***',3I5/)
      READ (NSTIF) ((A(II,JJ),II=1,N),JJ=1,MA)                          R0229771
      DO 115 I=1,N                                                      00229780
      IF(A(I,1).NE.0.0) GO TO 115                                       00229790
      WRITE(6,114)I                                                     00229800
114   FORMAT(20X,8HEQUATION,I5,13H IS SINGULAR.//)                      00229810
      MODEX=1                                                           00229820
      A(I,1)=1.0                                                        00229830
115   V(I)=B(I,1)/A(I,1)                                                00229840
      IF(MODEX.EQ.1) RETURN                                             00229850
      DO 118 J=3,NC1                                                    00229860
      IMAX=0.0                                                          00229870
      RMAX=0.0                                                          00229880
      DO 117 I=1,N                                                      00229890
      IF(V(I).LT.RMAX) GO TO 117                                        00229900
      RMAX=V(I)                                                         00229910
      IMAX=I                                                            00229920
117   CONTINUE                                                          00229930
      NITE(J)=IMAX                                                      00229940
118   V(IMAX)=0.0                                                       00229950
      CALL BANDET(A,B,V,MAXA,N,NWA,RA,NSCH,DETA,IDETA,1)                00229960
      IF(MODEX.EQ.1) RETURN                                             00229970
       FA=DETA                                                          00229980
      IFA=IDETA                                                         00229990
      IFR=IFA                                                           00230000
      IDETR=IDETA                                                       00230010
       FR=FA                                                            00230020
       DETR=DETA                                                        00230030
      IF(A(N,1).GT.ANORM) GO TO 120                                     00230040
       WRITE (6,820)                                                    00230050
      MODEX=1                                                           00230060
      RETURN                                                            00230070
  120  IF (IFPR.EQ.1)                                                   00230080
     $ WRITE(6,830)                                                     00230090
      CALL QVCPY1(B,W,N)                                                00230100
       RT=0.0E0                                                         00230110
       IITE=0                                                           00230120
       KK=2                                                             00230130
  140  IITE=IITE+1                                                      00230140
      CALL QVCOPY(W,V,N)                                                00230150
       CALL BANDET (A,B,V,MAXA,N,NWA,RA,NSCH,DETA,IDETA,KK)             00230160
      IF(MODEX.EQ.1) RETURN                                             00230170
       KK=2                                                             00230180
      CALL QVDOT(RQT,W,V,N,1,1)                                         00230190
      CALL QVMPY2(W,B,V,N,MMA)                                          00230200
      CALL QVDOT(RQB,W,V,N,1,1)                                         00230210
       RQ=RQT/RQB                                                       00230220
       IF (IFPR.EQ.1)                                                   00230230
     $ WRITE (6,790) RQ                                                 00230240
       IF(IABS(KDYN).EQ.11) BS=DSQRT(DABS(RQB))                         00230250
       IF(IABS(KDYN).EQ.11) GO TO 1190                                  00230260
       BS= DSQRT(RQB)                                                   00230270
 1190 CONTINUE                                                          00230280
      BSI=1.0E0/BS                                                      00230290
       TOL= DABS(RQ-RT)/RQ                                              00230300
       IF (TOL.LT.RCBTOL) GO TO 200                                     00230310
      CALL QVMPY1(W,W,BSI,N,1,1,0)                                      00230320
       RT=RQ                                                            00230330
       IF (IITE.LT.IITEM) GO TO 140                                     00230340
  200 CALL QVMPY1(V,V,BSI,N,1,1,0)                                      00230350
      TOLI=100*TOL                                                      00230360
      RB=RQ*(1.0D0-DMIN1(0.1D0,TOLI))                                   00230370
       IS=0                                                             00230380
  220  CALL BANDET (A,B,V,MAXA,N,NWA,RB,NSCH,DETB,IDETB,1)              00230390
      IF(MODEX.EQ.1) RETURN                                             00230400
       IF (IFPR.EQ.1)                                                   00230410
     $ WRITE (6,850) RB,NSCH                                            00230420
       FB=DETB                                                          00230430
      IFB=IDETB                                                         00230440
       IF (NSCH.EQ.0) GO TO 240                                         00230450
       IS=IS+1                                                          00230460
       IF (IS.LE.NTF) GO TO 230                                         00230470
      WRITE (6,860) NTF                                                 00230480
      MODEX=1                                                           00230490
      RETURN                                                            00230500
  230  RB=RB/(NSCH+1)                                                   00230510
       GO TO 220                                                        00230520
  240  IF (IFPR.EQ.1)                                                   00230530
     $ WRITE (6,870)                                                    00230540
       NITE(JR)=-1                                                      00230550
       IF (IFPR.EQ.1)                                                   00230560
     $ WRITE (6,880) JR,NITE(JR),RA,DETA,FA,ETA,ISC                     00230570
       NITE(JR)=0                                                       00230580
       IF (IFPR.EQ.1)                                                   00230590
     $ WRITE (6,880) JR,NITE(JR),RB,DETB,FB,ETA,ISC                     00230600
      RX=-0.05E0*RB                                                     00230610
  250  IF (NSCH.GE.NROOT) GO TO 660                                     00230620
       IF (RB.GT.COFQ) GO TO 660                                        00230630
       DIF=FB-FA                                                        00230640
      SHIFT=0.0                                                         00230650
      I=IFA-IFB                                                         00230660
      FA=FA*2.0**I                                                      00230670
      IFA=IFB                                                           00230680
       IF (DIF.NE.0.0E0) GO TO 260                                      00230690
      WRITE (6,890)                                                     00230700
       GO TO 660                                                        00230710
  260  DEL=FB*(RB-RA)/DIF                                               00230720
      IP=MOD(NITE(JR),3)                                                00230730
      DEL=DEL*2.0**IP                                                   00230740
      IF(DEL.GT.RX) DEL=RX                                              00230750
       RC=RB-ETA*DEL                                                    00230760
       TOL=RCBTOL*RC                                                    00230770
       IF ( DABS(RC-RB).GT.TOL) GO TO 270                               00230780
       IF (IFPR.EQ.1)                                                   00230790
     $ WRITE (6,900)                                                    00230800
       ROOT(JR)=RB                                                      00230810
       GO TO 330                                                        00230820
  270  CALL BANDET (A,B,V,MAXA,N,NWA,RC,NSCH,DETC,IDETC,1)              00230830
      IF(MODEX.EQ.1) RETURN                                             00230840
       FC=DETC                                                          00230850
      IFC=IDETC                                                         00230860
       NITE(JR)=NITE(JR)+1                                              00230870
       IF (JR.EQ.1) GO TO 290                                           00230880
       JJ=JR-1                                                          00230890
       DO 280 K=1,JJ                                                    00230900
      FC=FC/(RC-ROOT(K))                                                00230910
280   CALL RSC(FC,IFC)                                                  00230920
  290  IF (IFPR.EQ.1)                                                   00230930
     $ WRITE (6,880) JR,NITE(JR),RC,DETC,FC,ETA,ISC                     00230940
       NES=0                                                            00230950
       IF (JR.EQ.1) GO TO 310                                           00230960
       DO 300 I=1,JJ                                                    00230970
  300  IF (ROOT(I).LT.RC) NES=NES+1                                     00230980
  310  NOV=NSCH-NES                                                     00230990
       IF (NOV.EQ.0) GO TO 320                                          00231000
       IF (IFPR.EQ.1)                                                   00231010
     $ WRITE (6,910) NOV                                                00231020
       ROOT(JR)=RC                                                      00231030
      RCORIG=RC                                                         00231040
       IF (NOV.GT.1) NSK=1                                              00231050
       GO TO 330                                                        00231060
  320  RR=RA                                                            00231070
       FR=FA                                                            00231080
       DETR=DETA                                                        00231090
       RA=RB                                                            00231100
       FA=FB                                                            00231110
       DETA=DETB                                                        00231120
       RB=RC                                                            00231130
       FB=FC                                                            00231140
       DETB=DETC                                                        00231150
      IFR=IFA                                                           00231160
      IDETR=IDETA                                                       00231170
      IFA=IFB                                                           00231180
      IDETA=IDETB                                                       00231190
      IFB=IFC                                                           00231200
      IDETB=IDETC                                                       00231210
       TOL=RB*ACTOL                                                     00231220
       IF ( DABS(RA-RB).LT.TOL) ETA=ETA*2                               00231230
       IF (NITE(JR).LE.NITEM) GO TO 250                                 00231240
      WRITE (6,840) JR,NITE(JR)                                         00231250
       GO TO 660                                                        00231260
  330  IF (JR.LE.NC) GO TO 340                                          00231270
       WRITE (6,920)                                                    00231280
       GO TO 660                                                        00231290
  340  NOR=JR-1                                                         00231300
      SHIFT=0.0                                                         00231310
       IF (NOR.GT.NVM) NOR=NVM                                          00231320
       CALL SECOND (TIM3)                                               00231330
       IF (IFPR.EQ.1)                                                   00231340
     $ WRITE (6,930) NOR                                                00231350
       IF (JR.EQ.1) GO TO 360                                           00231360
      RRCC = 1.0D0                                                      R0231361
      CALL QVSET(RRCC,V,N)                                              R0231370
       KK=2                                                             00231380
      IF(JR.EQ.NC) GO TO 360                                            00231390
      I=NITE(JR+1)                                                      00231400
      V(I)=-1.0D0                                                       00231410
  360 CONTINUE                                                          R0231411
      CALL QVMPY2(W,B,V,N,MMA)                                          00231420
       IS=0                                                             00231430
      RT=ROOT(JR)                                                       00231440
       GO TO 430                                                        00231450
  380  NITE(JR)=NITE(JR)+1                                              00231460
      CALL QVCOPY(W,V,N)                                                00231470
       CALL BANDET (A,B,V,MAXA,N,NWA,RC,NSCH,DETC,IDETC,KK)             00231480
       IF (IS.EQ.1) GO TO 490                                           00231490
      IF(MODEX.EQ.1) RETURN                                             00231500
      ERRT=RQB                                                          00231510
       KK=2                                                             00231520
      CALL QVDOT(RQT,W,V,N,1,1)                                         00231530
      CALL QVMPY2(W,B,V,N,MMA  )                                        00231540
      CALL QVDOT(RQB,W,V,N,1,1)                                         00231550
       RQ=RQT/RQB                                                       00231560
       RT=ROOT(JR)+RQ                                                   00231570
       IF (IFPR.EQ.1)                                                   00231580
     $ WRITE (6,940) JR,NITE(JR),RT,RQ                                  00231590
       TOL=RT*RQTOL                                                     00231600
       IF ( DABS(RT-RTA).GT.TOL) GO TO 430                              00231610
       IS=1                                                             00231620
       GO TO 490                                                        00231630
  430  RTA=RT                                                           00231640
      IF(IABS(KDYN).EQ.11) BS=DSQRT(DABS(RQB))                          00231650
      IF(IABS(KDYN).EQ.11) GO TO 1430                                   00231660
       BS= DSQRT(RQB)                                                   00231670
 1430 CONTINUE                                                          00231680
      BSI=1.0E0/BS                                                      00231690
      CALL QVMPY1(W,W,BSI,N,1,1,0)                                      00231700
       IF (NOR.EQ.0) GO TO 480                                          00231710
       DO 470 K=1,NOR                                                   00231720
      CALL QVDOT(AL,VV(1,K),W,N,1,1)                                    00231730
      CALL QMR2(W,W,AL,WW(1,K),N,1,1,1)                                 00231740
  470  CONTINUE                                                         00231750
480   IF(NITE(JR).EQ.0) GO TO 380                                       00231760
      IF(MOD(NITE(JR),NITEM).NE.0) GO TO 482                            00231770
      TOL=RT*RITOL                                                      00231780
      RT=RT+TOL                                                         00231790
      CALL BANDET(A,B,V,MAXA,N,NWA,RT,NSCHT,DETT,IDETT,1)               00231800
      SHIFT=RT                                                          00231810
      IF(IFPR.EQ.1) WRITE(6,483)SHIFT                                   00231820
483   FORMAT(10X,17HSHIFT APPLIED AT ,E22.14)                           00231830
      ROOT(JR)=RT                                                       00231840
482   IF(NITE(JR).LE.NITEMM) GO TO 380                                  00231850
      WRITE (6,840) JR,NITE(JR)                                         00231860
       GO TO 660                                                        00231870
  490  CONTINUE                                                         00231880
       ROOT(JR)=ROOT(JR)+RQ                                             00231890
       ERR= DSQRT(ERRT/RQB)                                             00231900
       ERRVL(JR)=ROOT(JR)-ERR                                           00231910
       ERRVR(JR)=ROOT(JR)+ERR                                           00231920
      IF(IABS(KDYN).EQ.11) BS=DSQRT(DABS(RQB))                          00231930
      IF(IABS(KDYN).EQ.11) GO TO 1490                                   00231940
       BS= DSQRT(RQB)                                                   00231950
 1490  CONTINUE                                                         00231960
      BSI=1.0E0/BS                                                      00231970
      CALL QVMPY1(V,V,BSI,N,1,1,0)                                      00231990
      CALL QVMPY1(W,W,BSI,N,1,1,0)                                      00231980
       JJ=JR                                                            00232000
       IF (JJ.LE.NVM) GO TO 550                                         00232010
       WRITE (NT) (VV(J,1),J=1,N)                                       00232020
       DO 540 K=1,N                                                     00232030
       DO 540 L=2,NVM                                                   00232040
       WW(K,L-1)=WW(K,L)                                                00232050
  540  VV(K,L-1)=VV(K,L)                                                00232060
       JJ=NVM                                                           00232070
  550 CALL QVCOPY(V,VV(1,JJ),N)                                         00232090
      CALL QVCOPY(W,WW(1,JJ),N)                                         00232080
       CALL SECOND (TIM2)                                               00232100
       TIM3=TIM2-TIM3                                                   00232110
       IF (IFPR.EQ.1)                                                   00232120
     $ WRITE (6,950) TIM3                                               00232130
       TIM(JR)=TIM2-TIM1                                                00232140
       TIM1=TIM2                                                        00232150
       TOL=RTOL*ROOT(JR)                                                00232160
       IF (NOV.GT.0) GO TO 580                                          00232170
       IF ( DABS(ROOT(JR)-RB).GT.TOL) GO TO 620                         00232180
       IF (RA.GT.0.0E0) GO TO 570                                       00232190
       RA=RB/2.E0                                                       00232200
       CALL BANDET (A,B,V,MAXA,N,NWA,RA,NSCH,DETA,IDETA,1)              00232210
      IF(MODEX.EQ.1) RETURN                                             00232220
       FA=DETA                                                          00232230
      IFA=IDETA                                                         00232240
  570  RB=RA                                                            00232250
       FB=FA                                                            00232260
       DETB=DETA                                                        00232270
       RA=RR                                                            00232280
       FA=FR                                                            00232290
       DETA=DETR                                                        00232300
      IFB=IFA                                                           00232310
      IDETB=IDETA                                                       00232320
      IFA=IFR                                                           00232330
      IDETA=IDETR                                                       00232340
       GO TO 620                                                        00232350
  580  IF (ROOT(JR).GT.RC) NSK=1                                        00232360
       IF (NSK.EQ.1) GO TO 630                                          00232370
       IF ( DABS(RC-ROOT(JR)).LT.TOL) GO TO 600                         00232380
       IF ( DABS(ROOT(JR)-RB).LT.TOL) GO TO 590                         00232390
       RA=RB                                                            00232400
       FA=FB                                                            00232410
       DETA=DETB                                                        00232420
       IFA=IFB                                                          00232430
       IDETA=IDETB                                                      00232440
  590  RB=RC                                                            00232450
       FB=FC                                                            00232460
       DETB=DETC                                                        00232470
      IFB=IFC                                                           00232480
      IDETB=IDETC                                                       00232490
       GO TO 620                                                        00232500
  600  IF ( DABS(ROOT(JR)-RB).GT.TOL) GO TO 620                         00232510
       IF (RA.GT.0.0E0) GO TO 610                                       00232520
       RA=RB/2.E0                                                       00232530
       CALL BANDET (A,B,V,MAXA,N,NWA,RA,NSCH,DETA,IDETA,1)              00232540
      IF(MODEX.EQ.1) RETURN                                             00232550
       FA=DETA                                                          00232560
      IFA=IDETA                                                         00232570
  610  RB=RA                                                            00232580
       FB=FA                                                            00232590
       DETB=DETA                                                        00232600
       RA=RR                                                            00232610
       FA=FR                                                            00232620
       DETA=DETR                                                        00232630
      IFB=IFA                                                           00232640
      IDETB=IDETA                                                       00232650
      IFA=IFR                                                           00232660
      IDETA=IDETR                                                       00232670
  620  FA=FA/(RA-ROOT(JR))                                              00232680
       FB=FB/(RB-ROOT(JR))                                              00232690
      CALL RSC(FA,IFA)                                                  00232700
      CALL RSC(FB,IFB)                                                  00232710
      NOV=0                                                             00232720
       JR=JR+1                                                          00232730
       ETA=2.0E0                                                        00232740
       GO TO 240                                                        00232750
  630  IF (RA.GT.0.0E0) GO TO 640                                       00232760
       RA=RB/2.E0                                                       00232770
       CALL BANDET (A,B,V,MAXA,N,NWA,RA,NSCH,DETA,IDETA,1)              00232780
      IF(MODEX.EQ.1) RETURN                                             00232790
       FA=DETA                                                          00232800
       IFA=IDETA                                                        00232810
640   IF(SHIFT.LT.ROOT(JR)) SHIFT=0.0                                   00232820
      IF(SHIFT.EQ.0.0) GO TO 645                                        00232830
      RC=SHIFT                                                          00232840
645   IF(DABS(ROOT(JR)-RB).GT.TOL) GO TO 650                            00232850
       RB=RA                                                            00232860
       FB=FA                                                            00232870
       DETB=DETA                                                        00232880
       RA=RR                                                            00232890
       FA=FR                                                            00232900
       DETA=DETR                                                        00232910
      IFB=IFA                                                           00232920
      IDETB=IDETA                                                       00232930
      IFA=IFR                                                           00232940
      IDETA=IDETR                                                       00232950
  650  FA=FA/(RA-ROOT(JR))                                              00232960
       FB=FB/(RB-ROOT(JR))                                              00232970
       FR=FR/(RR-ROOT(JR))                                              00232980
      CALL RSC(FA,IFA)                                                  00232990
      CALL RSC(FB,IFB)                                                  00233000
      CALL RSC(FR,IFR)                                                  00233010
      IF(ROOT(JR).LE.RCORIG) NOV=NOV-1                                  00233020
      IF(NOV.EQ.0) GO TO 655                                            00233030
      IF(SHIFT.NE.0.0) GO TO 655                                        00233040
      IF(JR.EQ.1) GO TO 653                                             00233050
      IF(DABS(ROOT(JR)-ROOT(JR-1)).LT.RITOL*ROOT(JR-1)) GO TO 655       00233060
653   CONTINUE                                                          00233070
      IF(DABS(RC-ROOT(JR)).LT.FACT*ROOT(JR)) GO TO 655                  00233080
      RC=FACT*(RC-ROOT(JR))+ROOT(JR)                                    00233090
      IF(IFPR.EQ.1) WRITE(6,1055)RC                                     00233100
1055  FORMAT(/10X,4HRC= ,E20.8/)                                        00233110
      CALL BANDET(A,B,V,MAXA,N,NWA,RC,NSCHT,DETT,IDETT,1)               00233120
 655   CONTINUE                                                         00233130
       JR=JR+1                                                          00233140
       NITE(JR)=0                                                       00233150
       ROOT(JR)=RC                                                      00233160
       IF (NOV.GT.0) GO TO 330                                          00233170
       NSK=0                                                            00233180
       ETA=2.0E0                                                        00233190
       GO TO 240                                                        00233200
660   IF((JR-1).LT.NROOT) NROOT=JR-1                                    00233210
      IF(NROOT.GT.0) GO TO 670                                          00233220
      WRITE (6,1000)                                                    00233230
      MODEX=1                                                           00233240
      RETURN                                                            00233250
  670 CONTINUE                                                          00233260
       IF (IFPR.EQ.0) GO TO 680                                         00233270
       WRITE (6,960)                                                    00233280
       WRITE (6,800) (NITE(J),J=1,NROOT)                                00233290
       WRITE (6,970)                                                    00233300
       WRITE (6,810) (TIM(J),J=1,NROOT)                                 00233310
       WRITE (6,980)                                                    00233320
       WRITE (6,790) (ERRVL(J),J=1,NROOT)                               00233330
       WRITE (6,790) (ERRVR(J),J=1,NROOT)                               00233340
  680  IF (JR-1 .LE.NVM) GO TO 700                                      00233350
       NDIF=JR-1  - NVM                                                 00233360
       REWIND NT                                                        00233370
       DO 690 L=1,NDIF                                                  00233380
       READ (NT) (A(I,L),I=1,N)                                         00233390
  690  CONTINUE                                                         00233400
       GO TO 710                                                        00233410
  700  NDIF=0                                                           00233420
  710  JJR=JR-1    - NDIF                                               00233430
       DO 720 L=1,JJR                                                   00233440
       LNDIF=L+NDIF                                                     00233450
  720 CALL QVCOPY(VV(1,L),A(1,LNDIF),N)                                 00233460
       IF (JR.EQ.2) GO TO 760                                           00233470
       JR=JR-2                                                          00233480
  730  IS=0                                                             00233490
       DO 750 I=1,JR                                                    00233500
      IF(IABS(KDYN).EQ.11) GO TO 1730                                   00233510
       IF (ROOT(I+1).GE.ROOT(I)) GO TO 750                              00233520
      GO TO 1740                                                        00233530
 1730 IF(DABS(ROOT(I+1)).GE.DABS(ROOT(I))) GO TO 750                    00233540
 1740 CONTINUE                                                          00233550
       IS=IS+1                                                          00233560
       RT=ROOT(I+1)                                                     00233570
       ROOT(I+1)=ROOT(I)                                                00233580
       ROOT(I)=RT                                                       00233590
       DO 740 K=1,N                                                     00233600
       RT=A(K,I+1)                                                      00233610
       A(K,I+1)=A(K,I)                                                  00233620
  740  A(K,I)=RT                                                        00233630
  750  CONTINUE                                                         00233640
       IF (IS.GT.0) GO TO 730                                           00233650
  760  WRITE (6,990)                                                    00233660
      IF(NSCH.LT.NROOT) NROOT=NSCH                                      00233670
        DO 765 J=1,NROOT                                                00233680
765     ROOT(J)=ROOT(J)+FRSHFT                                          00233690
       WRITE (6,790) (ROOT(J),J=1,NROOT)                                00233700
       REWIND NT                                                        00233710
      IF(IABS(KDYN).EQ.11) GO TO 1770                                   00233720
       DO 770 I=1,NROOT                                                 00233730
      IF(ROOT(I).GE.0) GO TO 770                                        00233740
      ROOT(I)=DABS(ROOT(I))                                             00233750
      WRITE(6,995)I                                                     00233760
  770  ROOT(I)= DSQRT(ROOT(I))                                          00233770
 1770 CONTINUE                                                          00233780
      CALL RDWRT(NT,ROOT,NROOT,13,J)                                    00233790
       NWA=N*NROOT                                                      00233800
      CALL RDWRT(NT,A,NWA,13,J)                                         00233810
       PI2=8.D0* DATAN(1.0D0)                                           00233820
       DO 780 I=1,NROOT                                                 00233830
  780  AT(I)=PI2/ROOT(I)                                                00233840
       RETURN                                                           00233850
  790  FORMAT (1H0,6E20.12)                                             00233860
  800  FORMAT (1H0,6I20)                                                00233870
  810  FORMAT (1H0,6F20.2)                                              00233880
  820 FORMAT (44H0***ERROR   SOLUTION TERMINATED IN *SECANT *, /        00233890
     $        12X,25HRIGID BODY MODE(S) FOUND., / 1X)                   00233900
  830 FORMAT (51H INVERSE ITERATION GIVES FOLLOWING APPROXIMATION TO,   00233910
     $        18H LOWEST EIGENVALUE, 1X)                                00233920
  840 FORMAT (42H0***ERROR   PRE-MATURE EXIT FROM *SECANT *, / 12X,     00233930
     $        37HITERATION ABANDONED FOR ROOT NUMBER =, I4 / 12X,       00233940
     $        37HNUMBER OF ITERATIONS PERFORMED      =, I4 / 1X)        00233950
  850  FORMAT (5H0RB =,E20.12,7H NSCH =,I4)                             00233960
  860 FORMAT (38H0***ERROR   SOLUTION STOP IN *SECANT *, / 12X, 1H(,    00233970
     $        I3,48H) FACTORIZATIONS PERFORMED IN AN ATTEMPT TO FIND,   00233980
     $        32H LOWER BOUND ON FIRST EIGENVALUE, / 12X,               00233990
     $        16HCHECK THE MODEL., / 1X)                                00234000
  870  FORMAT (1X ,4X,4HROOT,4X,4HNITE,18X,2HRC,15X,12HDET (A-RC*B),15X,00234010
     $2HFC,13X,3HETA,4X,3HISC)                                          00234020
  880  FORMAT (1H0,4X,I4,4X,I4,8X,3E22.14,F7.2,I6)                      00234030
  890  FORMAT (42H0THE DEFLATED POLYNOMIAL HAS NO MORE ROOTS  )         00234040
  900  FORMAT (29H0(RC-RB) IS SMALLER THAN TOL )                        00234050
  910  FORMAT (16H0WE JUMPED OVER ,I4,16H UNKNOWN ROOT(S)  )            00234060
  920 FORMAT (42H0***ERROR   PRE-MATURE EXIT FROM *SECANTD*,            00234070
     $        34H CAUSED BY EITHER OF THE FOLLOWING, / 12X,             00234080
     $        22H(1) BAD MODEL DATA, OR, / 12X,                         00234090
     $        52H(2) ROOT CLUSTER (I.E., NEAR EQUAL OR REPEATED EIGEN,  00234100
     $        36HVALUES) ENCOUNTERED AT CURRENT SHIFT, / 16X,           00234110
     $        25HCAUSING STORAGE OVER-FLOW, 1X)                         00234120
  930  FORMAT (1H0,34X,4HROOT,18X,2HRQ,18X,4HNOR=,I2)                   00234130
  940  FORMAT (1H0,4X,I4,4X,I4,8X,2E22.14)                              00234140
  950  FORMAT (20H0TIME FOR INV ITERN ,F5.2)                            00234150
  960  FORMAT (42H0NO OF ITERATIONS FOR EACH EIGENVALUE ARE   /)        00234160
  970  FORMAT (30H0TIME USED FOR EACH EIGENVALUE /)                     00234170
  980  FORMAT (43H0FOLLOWING ARE ERROR BOUNDS ON EIGENVALUES )          00234180
  990  FORMAT (///  40H WE SOLVED FOR THE FOLLOWING EIGENVALUES    )    00234190
  995  FORMAT(//5X,24H***NOTE: THE ROOT NUMBER,3X,I5,5X,8HIS NEGAT,     00234200
     158HIVE.  ITS ABSOLUTE VALUE IS TAKEN FOR FURTHER CALCULATIONS)    00234210
 1000 FORMAT (38H0***ERROR   SOLUTION STOP IN *SECANT *, / 12X,         00234220
     $        23HNO EIGENVALUES COMPUTED, / 1X)                         00234230
 1010 FORMAT (44H ***ERROR    NEG OR ZERO DIAGONAL ELEMENT A(,I4,4H) = ,00234240
     X       E11.4,21HBEFORE DECOMPOSITION            )                 00234250
      END                                                               00234260
