      SUBROUTINE GDCOMP (A,B,MAXA,NEQB,MA,NBLOCK,NWA,NTB,NSCH,NEQ,MI)   R0103040
      IMPLICIT REAL*8 (A-H,O-Z)                                         00103050
      REAL*8  MAXA                                                      00103060
      COMMON /EXTRA/ MODEX,NREXTR(25)                                   R0103070
      COMMON /SQZ/ ISQZ,NRSQZ(5)                                        R0103080
CC    COMMON /AAA1/ A(8000)                                             R0103081
       DIMENSION A(NWA),B(NWA),MAXA(MI)                                 R0103090
      DIMENSION ICOO(10),IFORM(4)                                       00103100
      DATA ICOO /3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097, 00103110
     $           3H109/                                                 00103120
      DATA IFORM(1),IFORM(3),IFORM(4) /4H(1H+,4HX,F7,4H.2) /            00103130
      NSTIF=4                                                           00103140
      NT=10                                                             00103150
      NL=22                                                             00103160
      NRED=15                                                           00103170
       MA2=MA - 2                                                       00103180
      IF(MA2.EQ.0) MA2=1                                                00103190
       INC=NEQB - 1                                                     00103200
       IF(INC.EQ.0)INC=1                                                00103210
       N1=NL                                                            00103220
      N2=NT                                                             00103230
      NWANM=NWA+MI                                                      00103240
      CALL RDWRT(NSTIF,A,1,6,I)                                         00103250
      CALL RDWRT(NRED ,A,1,6,I)                                         00103260
      CALL RDWRT(N1   ,A,1,6,I)                                         00103270
      CALL RDWRT(N2   ,A,1,6,I)                                         00103280
       NSCH=0                                                           00103290
      WRITE(6,90)                                                       00103300
   90 FORMAT(1X ,10X,48HTHE LAST NUMBER PRINTED IS THE PERCENT OF THE FO00103310
     $       ,40HRWARD REDUCTION THAT HAS BEEN COMPLETED.//)            00103320
      ICO=1                                                             00103330
       DO 420 NJ=1,NBLOCK                                               00103340
       IF (NJ.NE.1) GO TO 100                                           00103350
CC    CALL EXPAND(A,NWA,NSTIF)                                          00103360
      WRITE (6,1010) N1,N2,NSTIF
 1010 FORMAT (5X,'** N1 N2 NSTIF **',3I5/)
      READ (NSTIF) (A(II),II=1,NWA)                                     R0103361
       GO TO 110                                                        00103370
  100  IF (NTB.EQ.1) GO TO 110                                          00103380
      CALL RDWRT(N1   ,A,1,6,I)                                         00103390
      CALL RDWRT(N2   ,A,1,6,I)                                         00103400
      CALL EXPAND(A,NWA,N1)                                             00103410
  110  KU=1                                                             00103420
       KM=MIN0(MA,NEQB)                                                 00103430
       MAXA(1)=1                                                        00103440
       DO 170 N=2,MI                                                    00103450
       IF (N-MA) 120,120,130                                            00103460
  120  KU=KU + NEQB                                                     00103470
       KK=KU                                                            00103480
      MM=MIN0(N,KM)                                                     00103490
       GO TO 150                                                        00103500
  130  KU=KU + 1                                                        00103510
       KK=KU                                                            00103520
       IF (N-NEQB) 150,150,140                                          00103530
  140  MM=MM - 1                                                        00103540
  150  DO 160 K=1,MM                                                    00103550
       IF (A(KK)) 170,160,170                                           00103560
  160  KK=KK - INC                                                      00103570
  170  MAXA(N)=KK                                                       00103580
       IF (A(1)) 190,180,200                                            00103590
  180  KK=(NJ-1)*NEQB + 1                                               00103600
       IF (KK.GT.NEQ) GO TO 390                                         00103610
      WRITE (6,430) KK                                                  00103620
      MODEX=1                                                           00103630
      RETURN                                                            00103640
  190  NSCH=NSCH + 1                                                    00103650
  200  DO 280 N=2,NEQB                                                  00103660
       NH=MAXA(N)                                                       00103670
       IF (NH-N) 280,280,210                                            00103680
  210  KL=N + INC                                                       00103690
       KU=NH                                                            00103700
       K=N                                                              00103710
       D=0.E0                                                           00103720
       DO 220 KK=KL,KU,INC                                              00103730
       K=K - 1                                                          00103740
       C=A(KK)/A(K)                                                     00103750
       D=D + C*A(KK)                                                    00103760
  220  A(KK)=C                                                          00103770
       A(N)=A(N) - D                                                    00103780
       IF (A(N)) 240,230,250                                            00103790
  230  KK=(NJ-1)*NEQB + N                                               00103800
       IF (KK.GT.NEQ) GO TO 390                                         00103810
      WRITE (6,430) KK                                                  00103820
      MODEX=1                                                           00103830
      RETURN                                                            00103840
  240  NSCH=NSCH + 1                                                    00103850
  250  IC=NEQB                                                          00103860
       DO 270 J=1,MA2                                                   00103870
       MJ=MAXA(N+J) - IC                                                00103880
       IF (MJ-N) 270,270,260                                            00103890
  260  KU=MIN0(MJ,NH)                                                   00103900
       KN=N + IC                                                        00103910
       C=0.E0                                                           00103920
      CONST=C                                                           00103930
      CALL QVDOT(C,A(KL),A(KL+IC),       (KU-KL)/INC+1,INC,INC)         00103940
      C=CONST-C                                                         00103950
      A(KN)=A(KN)+C                                                     00103960
  270  IC=IC + NEQB                                                     00103970
  280  CONTINUE                                                         00103980
      IF(NJ.EQ.NBLOCK) CALL SQEEZE(A,NWANM,NRED,ISQZ)                   00103990
      IF(NJ.EQ.NBLOCK) GO TO 400                                        00104000
  290  DO 380 NK=1,NTB                                                  00104010
       IF ((NK+NJ).GT.NBLOCK) GO TO 380                                 00104020
       NI=N1                                                            00104030
       IF ((NJ.EQ.1).OR.(NK.EQ.NTB)) NI=NSTIF                           00104040
      CALL EXPAND(B,NWA,NI)                                             00104050
       ML=NK*NEQB + 1                                                   00104060
       MR=MIN0((NK+1)*NEQB,MI)                                          00104070
       MD=MI - ML                                                       00104080
       KL=NEQB + (NK-1)*NEQB*NEQB                                       00104090
       N=1                                                              00104100
       DO 360 M=ML,MR                                                   00104110
       NH=MAXA(M)                                                       00104120
       KL=KL + NEQB                                                     00104130
       IF (NH-KL) 350,300,300                                           00104140
  300  KU=NH                                                            00104150
       K=NEQB                                                           00104160
       D=0.E0                                                           00104170
       DO 310 KK=KL,KU,INC                                              00104180
       C=A(KK)/A(K)                                                     00104190
       D=D + C*A(KK)                                                    00104200
       A(KK)=C                                                          00104210
  310  K=K - 1                                                          00104220
       B(N)=B(N) - D                                                    00104230
       IF (MD) 360,360,320                                              00104240
  320  IC=NEQB                                                          00104250
       DO 340 J=1,MD                                                    00104260
       MJ=MAXA(M+J) - IC                                                00104270
       IF (MJ-KL) 340,330,330                                           00104280
  330  KU=MIN0(MJ,NH)                                                   00104290
       KN=N + IC                                                        00104300
       C=0.E0                                                           00104310
      CONST=C                                                           00104320
      CALL QVDOT(C,A(KL),A(KL+IC),       (KU-KL)/INC+1,INC,INC)         00104330
      C=CONST-C                                                         00104340
      B(KN)=B(KN)+C                                                     00104350
  340  IC=IC + NEQB                                                     00104360
  350  MD=MD - 1                                                        00104370
  360  N=N + 1                                                          00104380
       IF (NTB.NE.1) GO TO 370                                          00104390
      CALL SQEEZE(A,NWANM,NRED,ISQZ)                                    00104400
      CALL MEMOVE(B(1),A(1),NWA)                                        00104410
       GO TO 400                                                        00104420
  370 CALL SQEEZE(B,NWA,N2,ISQZ)                                        00104430
  380  CONTINUE                                                         00104440
       M=N1                                                             00104450
       N1=N2                                                            00104460
       N2=M                                                             00104470
  390 CALL SQEEZE(A,NWANM,NRED,ISQZ)                                    00104480
  400  CONTINUE                                                         00104490
      PER=NJ*100.0/NBLOCK                                               00104500
      IFORM(2)=ICOO(ICO)                                                00104510
      WRITE(6,1009) PER                                                 R0104520
      ICO=ICO+1                                                         00104530
      IF(ICO.LT.11) GO TO 420                                           00104540
      WRITE(6,410)                                                      00104550
  410 FORMAT(1X,1X)                                                     R0104560
      ICO=1                                                             00104570
  420 CONTINUE                                                          00104580
 1009 FORMAT (5X,F10.4/)                                                R0104581
  430 FORMAT (37H0***ERROR   SOLUTION STOP IN *DECOMP*, / 12X,          00104590
     $        37HZERO PIVOT FOUND DURING FACTORIZATION, / 12X,          00104600
     $        17HEQUATION NUMBER =, I5 / 1X)                            00104610
      WRITE(6,440)                                                      00104620
  440 FORMAT(////20X,37(1H*)/20X,37HFORWARD REDUCTION HAS BEEN COMPLETED00104630
     $./20X,37(1H*))                                                    00104640
       RETURN                                                           00104650
      END                                                               00104660
      SUBROUTINE GREDBK (A,VA,VV,MAXA,NEQB,NV,NWA,NWV,NWVV,NTB,NBLOCK,  0108380 
     $MI,MA)                                                            00108390
      IMPLICIT REAL*8 (A-H,O-Z)                                         00108400
      REAL*8  MAXA                                                      00108410
      COMMON /SQZ/ ISQZ,NRSQZ(5)                                        R0108420
       DIMENSION A(NWA),VA(NWV),VV(NWVV),MAXA(MI)                       00108430
       NR=3                                                             00108440
       NL=18                                                            00108450
       NT=10                                                            00108460
       NRED=15                                                          00108470
      NWANM=NWA+MI                                                      00108480
       INC=NEQB - 1                                                     00108490
      IF(INC.EQ.0) INC=1                                                00108500
       NEB=NTB*NEQB                                                     00108510
       NEBT=NEB+NEQB                                                    00108520
      CALL RDWRT(NRED ,A,1,6,I)                                         00108530
       REWIND NR                                                        00108540
       REWIND NL                                                        00108550
       REWIND NT                                                        00108560
      CALL EXPAND(A,NWANM,NRED)                                         00108570
       ISV=NTB+1                                                        00108580
       IF (NBLOCK.EQ.1) ISV=1                                           00108590
       LL=0                                                             00108600
       DO 120 L=1,ISV                                                   00108610
       READ (NR) VA                                                     00108620
       K=0                                                              00108630
       KK=LL                                                            00108640
       DO 110 J=1,NV                                                    00108650
       DO 100 I=1,NEQB                                                  00108660
       K=K+1                                                            00108670
       KK=KK+1                                                          00108680
  100  VV(KK)=VA(K)                                                     00108690
  110  KK=KK+NEB                                                        00108700
  120  LL=LL+NEQB                                                       00108710
       ISA=1                                                            00108720
  130  DO 160 N=2,NEQB                                                  00108730
       KL=N + INC                                                       00108740
       KU=MAXA(N)                                                       00108750
       IF (KU-KL) 160,140,140                                           00108760
  140  K=N                                                              00108770
       DO 150 L=1,NV                                                    00108780
      CONST=VV(K)                                                       00108790
      CALL QVDOT(VV(K  ),A(KL),VV(K-1),  (KU-KL)/INC+1,INC,-1)          00108800
      VV(K  )=CONST-VV(K  )                                             00108810
  150  K=K + NEBT                                                       00108820
  160  CONTINUE                                                         00108830
  170  KL=NEQB                                                          00108840
       ML=NEQB + 1                                                      00108850
       DO 200 N=ML,MI                                                   00108860
       KL=KL + NEQB                                                     00108870
       KU=MAXA(N)                                                       00108880
       IF (KU-KL) 200,180,180                                           00108890
  180  K=NEQB                                                           00108900
       KN=N                                                             00108910
       DO 190 L=1,NV                                                    00108920
      CONST=VV(KN)                                                      00108930
      CALL QVDOT(VV(KN ),A(KL),VV(K)    ,(KU-KL)/INC+1,INC,-1)          00108940
      VV(KN )=CONST-VV(KN )                                             00108950
       K=K + NEBT                                                       00108960
  190  KN=KN + NEBT                                                     00108970
  200  CONTINUE                                                         00108980
       DO 230 I=1,NEQB                                                  00108990
       C=A(I)                                                           00109000
       IF (C) 210,230,210                                               00109010
  210  KK=I                                                             00109020
       DO 220 L=1,NV                                                    00109030
       VV(KK)=VV(KK)/C                                                  00109040
  220  KK=KK+NEBT                                                       00109050
  230  CONTINUE                                                         00109060
       IF (ISA.EQ.NBLOCK) GO TO 300                                     00109070
      CALL EXPAND(A,NWANM,NRED)                                         00109080
       ISA=ISA+1                                                        00109090
       K=0                                                              00109100
       KK=0                                                             00109110
       DO 250 J=1,NV                                                    00109120
       DO 240 I=1,NEQB                                                  00109130
       K=K+1                                                            00109140
       KK=KK+1                                                          00109150
  240  VA(K)=VV(KK)                                                     00109160
  250  KK=KK+NEB                                                        00109170
       WRITE (NT) VA                                                    00109180
       K=1                                                              00109190
       DO 270 J=1,NV                                                    00109200
       DO 260 I=1,NEB                                                   00109210
       VV(K)=VV(K+NEQB)                                                 00109220
  260  K=K+1                                                            00109230
  270  K=K+NEQB                                                         00109240
       IF (ISV.EQ.NBLOCK) GO TO 130                                     00109250
       READ (NR) VA                                                     00109260
       ISV=ISV+1                                                        00109270
       KK=NEB                                                           00109280
       K=0                                                              00109290
       DO 290 J=1,NV                                                    00109300
       DO 280 I=1,NEQB                                                  00109310
       K=K+1                                                            00109320
       KK=KK+1                                                          00109330
  280  VV(KK)=VA(K)                                                     00109340
  290  KK=KK+NEB                                                        00109350
       GO TO 130                                                        00109360
  300 CALL RDWRT(NRED ,A,1,2,I)                                         00109370
       ISA=1                                                            00109380
  310  ML=NEQB+1                                                        00109390
       KL=NEQB                                                          00109400
       DO 340 M=ML,MI                                                   00109410
       KL=KL+NEQB                                                       00109420
       KU=MAXA(M)                                                       00109430
       IF (KU-KL) 340,320,320                                           00109440
  320  K=NEQB                                                           00109450
       KM=M                                                             00109460
       DO 330 L=1,NV                                                    00109470
      CALL QMR2(VV(K   ),VV(K   ),VV(KM),A(KL),(KU-KL)/INC+1,-1,-1,INC) 00109480
       KM=KM + NEBT                                                     00109490
  330  K=K + NEBT                                                       00109500
  340  CONTINUE                                                         00109510
       N=NEQB                                                           00109520
       DO 370 LJ=2,NEQB                                                 00109530
       KL=N + INC                                                       00109540
       KU=MAXA(N)                                                       00109550
       IF (KU-KL) 370,350,350                                           00109560
  350  K=N                                                              00109570
       DO 360 L=1,NV                                                    00109580
      CALL QMR2(VV(K-1 ),VV(K-1 ),VV(K ),A(KL),(KU-KL)/INC+1,-1,-1,INC) 00109590
  360  K=K + NEBT                                                       00109600
  370  N=N - 1                                                          00109610
  380  KK=0                                                             00109620
       K=0                                                              00109630
       DO 400 J=1,NV                                                    00109640
       DO 390 I=1,NEQB                                                  00109650
       K=K+1                                                            00109660
       KK=KK+1                                                          00109670
  390  VA(K)=VV(KK)                                                     00109680
  400  KK=KK+NEB                                                        00109690
       WRITE (NL) VA                                                    00109700
       IF (ISA.EQ.NBLOCK) GO TO 450                                     00109710
      CALL RDWRT(NRED ,A,1,2,I)                                         00109720
      CALL EXPAND(A,NWANM,NRED)                                         00109730
      CALL RDWRT(NRED ,A,1,2,I)                                         00109740
       ISA=ISA+1                                                        00109750
       BACKSPACE NT                                                     00109760
       READ (NT) VA                                                     00109770
       BACKSPACE NT                                                     00109780
       K=NEBT                                                           00109790
       DO 420 J=1,NV                                                    00109800
       DO 410 I=1,NEB                                                   00109810
       VV(K)=VV(K-NEQB)                                                 00109820
  410  K=K-1                                                            00109830
  420  K=K+NEBT+NEB                                                     00109840
       K=0                                                              00109850
       KK=0                                                             00109860
       DO 440 J=1,NV                                                    00109870
       DO 430 I=1,NEQB                                                  00109880
       K=K+1                                                            00109890
       KK=KK+1                                                          00109900
  430  VV(KK)=VA(K)                                                     00109910
  440  KK=KK+NEB                                                        00109920
       GO TO 310                                                        00109930
  450  RETURN                                                           00109940
      END                                                               00109950
      SUBROUTINE GSTATC(A,LL,NBLOCK,NEQB,NT18,NT2)                      00110360
      IMPLICIT REAL*8(A-H,O-Z)                                          00110370
      DIMENSION A(1)                                                    00110380
      BACKSPACE NT18                                                    00110390
      CALL RDWRT(NT2,A,1,6,J)                                           00110400
      LS=NEQB*LL                                                        00110410
      DO 100 I=1,NBLOCK                                                 00110420
      CALL RDWRT(NT18,A,LS,14,1)                                        00110430
      CALL RDWRT(NT2,A,LS,13,1)                                         00110440
      CALL RDWRT(NT18,A,LS,2,1)                                         00110450
  100 CONTINUE                                                          00110460
      RETURN                                                            00110470
      END                                                               00110480
      SUBROUTINE ADDGEO(A,B,TMASS,A2,B2,TMASS2,NUMEL,NBLOCK,NE2B,LL,    R0008380
     $MBAND,NEQB,NEMN,ANORM,NVV,MMA)                                    00008390
      IMPLICIT REAL*8(A-H,O-Z)                                                  
      LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,GEOST                           00008410
      COMMON STIF(1)                                                    00008420
      DIMENSION  A(NEQB,MBAND), B(NEQB,LL), TMASS(NEQB,MMA)             R0008430
      DIMENSION A2(NEQB,MBAND),B2(NEQB,LL),TMASS2(NEQB,MMA)             00008440
      DIMENSION ICOO(10),IFORM(4)                                       00008450
      COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH                              00008460
      COMMON/MASS/LMASS                                                 00008470
      COMMON /SQZ/ ISQZ,NRSQZ(5)                                        R0008480
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7)                       R0008490
      COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS                      R0008500
      COMMON /FORCE/ NLC,NELD                                           00008510
      COMMON/GEOSTF/GEOST,NELGEO                                        00008520
      COMMON/ELPAR/ XPAR(14),KDUM(9),KEQ,RRELPA(23)                     R0008530
      COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM,  00008540
     $NAT,NT,NOT,NRDYN2(9)                                              R0008550
CC    COMMON /AAA1/A(150,53)                                            R0008551
CC    COMMON /AAA2/ TMASS(200,1),B(200,3)                               R0008552
      DATA ICOO / 3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097,00008560
     $            3H109/                                                00008570
      DATA IFORM(1),IFORM(3),IFORM(4)/4H(1H+,4HX,F7,4H.2) /             00008580
      KX(I,J,ND1)=MIN0(I,J)*(2*ND1+1-MIN0(I,J))/2-ND1+MAX0(I,J)+ND1     00008590
      ZER=0.0D0                                                         00008600
      NWDS=NEQB*(MBAND+LL)                                              00008610
      NWA=MBAND*NEQB                                                    00008620
      IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS=NWA                              00008630
      IF(NDYN.EQ.11.OR.NELGEO.EQ.1) NWDS=NWA                            00008640
      NWB=   LL*NEQB                                                    00008650
      NTA=4                                                             00008660
      LLF=LL                                                            00008670
      IF(NELD.EQ.0) LLF=0                                               00008680
      NTD=25                                                            00008690
      NT1=41                                                            00008700
      NT2=10                                                            00008710
      K=NEQB+1                                                          00008720
      X=NBLOCK                                                          00008730
      NFLG=0                                                            00008740
CC    WRITE(6,100)                                                      00008750
CC100 FORMAT (1X )                                                      00008760
      MB= DSQRT(X)                                                      00008770
      MB=MB/2+1                                                         00008780
      NEBB=MB*NE2B                                                      00008790
      MM=1                                                              00008800
      NSHIFT=0                                                          00008810
      AMIN=1.0D30                                                       00008820
      AMAX=-AMIN                                                        00008830
      NTB=18                                                            00008840
      NWDSB=NWB+NEQB                                                    00008850
      CALL RDWRT(NTB,B,1,6,INUM)                                        00008860
      CALL RDWRT(NTA,A,1,6,INUM)                                        00008870
      ANORM=0.0                                                         00008880
      NDEG=0                                                            00008890
      NVV=0                                                             00008900
      IF(NDYN.NE.7) GO TO 110                                           00008910
      TETA=1.4                                                          00008920
      DT1=TETA*DT                                                       00008930
      DT2=DT1*DT1                                                       00008940
      A0=(6.+3*ALFA*DT1)/(DT2+3*BETA*DT1)                               00008950
  110 CONTINUE                                                          00008960
      REWIND NTD                                                        00008970
      WRITE(6,115)                                                      00008980
  115 FORMAT(//,10X,48HTHE LAST NUMBER PRINTED IS THE PERCENT OF THE MA,00008990
     $       55HSTER (CONVENTIONAL AND GEOMETRIC) STIFFNESS AND LOAD MA,00009000
     $        6HTRICES,/,10X,42X,24HTHAT HAS BEEN ASSEMBLED.,//)        00009010
      ICO = 1                                                           00009020
      DO 310 M=1,NBLOCK ,2                                              00009030
      CALL MEMSET (ZER,A2(1,1),NWA)                                     00009040
      CALL MEMSET (ZER, A(1,1),NWA)                                     00009050
      NMWA=NEQB*MMA                                                     00009060
      CALL MEMSET (ZER,TMASS2(1,1),NMWA)                                00009070
      CALL MEMSET (ZER,TMASS (1,1),NMWA)                                00009080
      CALL MEMSET (ZER,B2(1,1),NWB)                                     00009090
      CALL MEMSET (ZER, B(1,1),NWB)                                     00009100
      CALL RDWRT(NT1,STIF,1,6,N)                                        00009110
      CALL RDWRT(NT2,STIF,1,6,N)                                        00009120
      NA=NT2                                                            00009130
      NUME=NUM7                                                         00009140
      IF (MM.NE.1) GO TO 140                                            00009150
      NA=NT1                                                            00009160
      NUME=NUMEL                                                        00009170
      NUM7 =0                                                           00009180
  140 DO 240 N=1,NUME                                                   00009190
      CALL RDWRT(NA,STIF,NEMN,0,KOUNT)                                  00009200
      WRITE (6,1021) NUME,KOUNT,MM
 1021 FORMAT (5X,'** NUME KOUNT MM **',3I5/)
CC    WRITE(6,1001) (STIF(IIR),IIR=1,KOUNT)
C1001 FORMAT (1X,'**NA**',12E10.4/)
      ND1=STIF(KOUNT)                                                   00009210
      NTOT=(ND1*ND1-ND1)/2+ND1                                          00009220
      KSTXM=LLF*ND1+NTOT+ND1+ND1                                        00009230
      IF(LMASS.EQ.1) KSTXM=KSTXM+NTOT-ND1                               00009240
      DO 210 I=1,ND1                                                    00009250
      LMN=1-STIF(I)                                                     00009260
      II=STIF(I)-NSHIFT                                                 00009270
      IF (II.LE.0.OR.II.GT.NE2B) GO TO 210                              00009280
      IF(II.GT.NEQB)GO TO 180                                           00009290
      IF(NELD.EQ.0) GO TO 155                                           00009300
      KSTP=NTOT+I                                                       00009310
      DO 150 L=1,LL                                                     00009320
      KSTP=KSTP+ND1                                                     00009330
  150 B(II,L)=B(II,L)+STIF(KSTP)                                        00009340
  155 CONTINUE                                                          00009350
      DO 170 J=1,ND1                                                    00009360
      JJ=STIF(J)+LMN                                                    00009370
      IF(JJ) 170,170,160                                                00009380
  160 KSTS=KX(I,J,ND1)                                                  00009390
      A(II,JJ)=A(II,JJ)+STIF(KSTS)                                      00009400
      KSTM=KX(I,J,ND1)-ND1                                              00009410
      IF((KSTXM+KSTM).GE.KOUNT) GO TO 170                               00009420
      TMASS(II,JJ)=TMASS(II,JJ)-STIF(KSTXM+KSTM)                        00009430
      IF(NELGEO.EQ.1) A(II,JJ)=A(II,JJ)+STIF(KSTXM+KSTM)                00009440
  170 CONTINUE                                                          00009450
      GO TO 210                                                         00009460
  180 II=II-NEQB                                                        00009470
      IF(NELD.EQ.0) GO TO 195                                           00009480
      KSTP=NTOT+I                                                       00009490
      DO 190 L=1,LL                                                     00009500
      KSTP=KSTP+ND1                                                     00009510
  190 B2(II,L)=B2(II,L)+STIF(KSTP)                                      00009520
  195 CONTINUE                                                          00009530
      DO 200 J=1,ND1                                                    00009540
      JJ=STIF(J)+LMN                                                    00009550
      IF(JJ.LE.0) GO TO 200                                             00009560
      KSTS=KX(I,J,ND1)                                                  00009570
      A2(II,JJ)=A2(II,JJ)+STIF(KSTS)                                    00009580
      KSTM=KX(I,J,ND1)-ND1                                              00009590
      IF((KSTXM+KSTM).GE.KOUNT) GO TO 200                               00009600
      TMASS2(II,JJ)=TMASS2(II,JJ)-STIF(KSTXM+KSTM)                      00009610
      IF(NELGEO.EQ.1) A2(II,JJ)=A2(II,JJ)+STIF(KSTXM+KSTM)              00009620
  200 CONTINUE                                                          00009630
  210 CONTINUE                                                          00009640
      IF (MM.GT.1) GO TO 240                                            00009650
      DO 220 I=1,ND1                                                    00009660
      II=STIF(I)-NSHIFT                                                 00009670
      IF(II.GT.NE2B.AND.II.LE.NEBB) GO TO 230                           00009680
  220 CONTINUE                                                          00009690
      GO TO 240                                                         00009700
  230 CALL RDWRT(NT2,STIF,KOUNT,1,I)                                    00009710
      WRITE (6,1002) STIF
 1002 FORMAT (1X,'**NT2**',12E10.4/)
      NUM7=NUM7+1                                                       00009720
  240 CONTINUE                                                          00009730
      DO 250 I=1,NEQB                                                   00009740
      D=A(I,1)                                                          00009750
      ANORM=ANORM+D                                                     00009760
      IF(D.NE.0.0) NDEG=NDEG+1                                          00009770
      IF(D.NE.0.0D0.AND.D.LT.AMIN) AMIN=D                               00009780
      IF(D.GT.AMAX) AMAX=D                                              00009790
      IF(TMASS(I,1).NE.0) NVV=NVV+1                                     00009800
      IF(M.EQ.NBLOCK) GO TO 250                                         00009810
      D=A2(I,1)                                                         00009820
      ANORM=ANORM+D                                                     00009830
      IF(D.NE.0.0) NDEG=NDEG+1                                          00009840
      IF(D.NE.0.0D0.AND.D.LT.AMIN) AMIN=D                               00009850
      IF(D.GT.AMAX) AMAX=D                                              00009860
      IF(TMASS2(I,1).NE.0.0) NVV=NVV+1                                  00009870
  250 CONTINUE                                                          00009880
  260 CONTINUE                                                          00009890
      IF(.NOT.GENPRT) GO TO 1200                                        00009900
      WRITE(6,1500)M                                                    00009910
      DO 1020 I=1,NEQB                                                  00009920
      IF(GENPCH)WRITE(7,1510)(A(I,J),J=1,MBAND)                         00009930
 1020 WRITE(6,1520)(A(I,J),J=1,MBAND)                                   00009940
      WRITE(6,1530)                                                     00009950
      DO 1030 I=1,NEQB                                                  00009960
      IF(GENPCH) WRITE(7,1510)(B(I,J),J=1,LL)                           00009970
 1030 WRITE(6,1520)(B(I,J),J=1,LL)                                      00009980
      WRITE(6,1540)                                                     00009990
 2170 DO 2180 I=1,NEQB                                                  00010000
      IF(GENPCH) WRITE(7,1510)(TMASS(I,J),J=1,MBAND)                    00010010
 2180 WRITE(6,1520)(TMASS(I,J),J=1,MBAND)                               00010020
      IF(M.EQ.NBLOCK) GO TO 1200                                        00010030
      MP1=M+1                                                           00010040
      WRITE(6,1500)MP1                                                  00010050
      DO 1060 I=1,NEQB                                                  00010060
      IF(GENPCH)WRITE(7,1510)(A2(I,J),J=1,MBAND)                        00010070
 1060 WRITE(6,1520)(A2(I,J),J=1,MBAND)                                  00010080
      WRITE(6,1530)                                                     00010090
      DO 1070 I=1,NEQB                                                  00010100
      IF(GENPCH) WRITE(7,1510)(B2(I,J),J=1,LL)                          00010110
 1070 WRITE(6,1520)(B2(I,J),J=1,LL)                                     00010120
      WRITE(6,1540)                                                     00010130
 2200 DO 2210 I=1,NEQB                                                  00010140
      IF(GENPCH)WRITE(7,1510)(TMASS2(I,J),J=1,MBAND)                    00010150
 2210 WRITE(6,1520)(TMASS2(I,J),J=1,MBAND)                              00010160
 1200 CONTINUE                                                          00010170
      IF(MODEFR.GT.0) GO TO 247                                         00010180
      DO 246 I=1,NEQB                                                   00010190
      D=A(I,1)                                                          00010200
      IF(D.GT.0.0) GO TO 243                                            00010210
      NJ=NEQB*(M-1)+I                                                   00010220
      IF(NJ.GT.KEQ) GO TO 246                                           00010230
      NFLG=1                                                            00010240
      WRITE(6,242)NJ,D                                                  00010250
  242 FORMAT(/10X,9HEQUATION ,I5,26H HAS A SINGULAR DIAGONAL = ,E10.4)  00010260
      WRITE(6,115)                                                      00010270
      ICO=1                                                             00010280
  243 D=A2(I,1)                                                         00010290
      IF(D.GT.0.0) GO TO 246                                            00010300
      NJ=NEQB*M+I                                                       00010310
      IF(NJ.GT.KEQ) GO TO 246                                           00010320
      NFLG=1                                                            00010330
      WRITE(6,242)NJ,D                                                  00010340
  246 CONTINUE                                                          00010350
  247 CONTINUE                                                          00010360
      WRITE (NTD) TMASS,(A(I,1),I=1,NEQB)                               00010370
      IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS=MBAND*NEQB                       R0010371
      IF(NDYN.EQ.11.OR.NELGEO.EQ.1) NWDS=MBAND*NEQB                     R0010372
      WRITE (6,2020) NTA,NWDS,MBAND,NEQB,ISQZ,NTD,MMA
 2020 FORMAT (5X,'** NTA NWDS MBAND NEQB ISQZ NTD MMA **',7I5/)
CC    CALL SQEEZE(A ,NWDS,NTA,ISQZ)                                     R0010380
      WRITE (NTA) A                                                     R0010381
      IF(M.EQ.NBLOCK) GO TO 310                                         00010390
      WRITE (NTD) TMASS2,(A2(I,1),I=1,NEQB)                             00010400
      WRITE (NTA) A                                                     R0010401
CC    CALL SQEEZE(A2,NWDS,NTA,ISQZ)                                     R0010410
      IF (MM.EQ.MB) MM=0                                                00010420
      MM=MM+1                                                           00010430
      PER=(M+1)*100.0/X                                                 00010440
      IFORM(2) = ICOO(ICO)                                              00010450
      WRITE(6,IFORM) PER                                                00010460
      ICO = ICO + 1                                                     00010470
      IF ( ICO .LT. 11 ) GO TO 310                                      00010480
      WRITE(6,295)                                                      00010490
  295 FORMAT(1H )                                                       00010500
      ICO = 1                                                           00010510
  310 NSHIFT=NSHIFT+NE2B                                                00010520
      WRITE(6,320)                                                      00010530
  320 FORMAT(////20X,98(1H*)/20X,34HTHE MASTER STIFFNESS (CONVENTIONAL, 00010540
     148H AND GEOMETRIC) STIFFNESS AND LOAD MATRICES HAVE,              00010550
     216H BEEN ASSEMBLED./20X,98(1H*))                                  00010560
      IF(NFLG.EQ.1) KSKIP=1                                             00010570
      IF(NDEG.GT.0) GO TO 340                                           00010580
      WRITE(6,330)                                                      00010590
  330 FORMAT(51H0STRUCTURE WITH NO DEGREES OF FREEDOM CHECK DATA   )    00010600
      KSKIP =1                                                          00010610
      RETURN                                                            00010620
  340 CONTINUE                                                          00010630
      IF(NDEG.GT.0) ANORM= (ANORM/NDEG)*1.0E-08                         00010640
      IF(NDYN.EQ.11) WRITE(6,1550)                                      00010650
      IF(NDYN.NE.11) WRITE(6,1560)                                      00010660
      RATIO=1.0D30                                                      00010670
      IF(AMIN.NE.0.0D0) RATIO=AMAX/AMIN                                 00010680
      WRITE(6,1570)AMIN,AMAX,RATIO                                      00010690
      RETURN                                                            00010700
 1500 FORMAT(17H OVERALL MATRICES,1X,5HBLOCK,I3,//,                     00010710
     117H STIFFNESS MATRIX)                                             00010720
 1510 FORMAT((1P8E10.3))                                                00010730
 1520 FORMAT (  (1H ,1P10E13.4))                                        00010740
 1530 FORMAT(///,12H LOAD MATRIX)                                       00010750
 1540 FORMAT(///,23H GEOMETRIC MATRIX (-KG))                            00010760
 1550 FORMAT(5X,37HGEOMETRIC STIFFNESS MATRIX PARAMETERS)               00010770
 1560 FORMAT(15X,43HSTIFFNESS MATRIX PARAMETERS AFTER INCLUSION,        00010780
     1       1X,26HOF THE GEOMETRIX STIFFNESS)                          00010790
 1570 FORMAT(//,                                                        00010800
     1 15X,34HMINIMUM NON-ZERO DIAGONAL ELEMENT=,1PD10.3,/,             00010810
     2 15X,34HMAXIMUM DIAGONAL ELEMENT         =,  D10.3,/,             00010820
     3 15X,34HMAXIMUM/MINIMUM                  =,  D10.3)               00010830
      END                                                               00010840
      SUBROUTINE ST2D1(NORD,NADD)                                       00261030
      IMPLICIT REAL*8(A-H,O-Z)                                          00261040
      COMMON /JUNK/ SIG(200),MM,L,K,NTAG,RRJUNK(25)                     R0261050
      COMMON /BAND/KOPT,NRBAND(7)                                       R0261060
      COMMON /OUT/NRES,NSTR,NROUT(8)                                    R0261070
      COMMON/PREP/XMX,XAD,NRPREP(17)                                    R0261080
      DIMENSION NORD(NADD)                                              00261090
      COMMON /QTSARG/ SIGEX(100),X(2),RRQTSA(898)                       R0261100
      DIMENSION C(4),D(4),Q(3)                                          00261110
      DATA Q/4HNODE,4HC.G.,4HI.P./                                      00261120
      JJ=SIG(150)/4                                                     00261130
      MTYP=SIG(151)                                                     00261140
      KL=0                                                              00261150
      IF(NTAG.GT.0) GO TO 154                                           00261160
      IF(MTYP.EQ.11.AND.NTAG.EQ.0) WRITE(6,100)                         00261170
      IF(MTYP.EQ.12.AND.NTAG.EQ.0) WRITE(6,110)                         00261180
      IF(MTYP.EQ.13.AND.NTAG.EQ.0) WRITE(6,120)                         00261190
  100 FORMAT(1X , 32H .... AXISYMMETRIC ELEMENTS ..../)                 00261200
  110 FORMAT(1X , 32H .... PLANE STRESS ELEMENTS ..../)                 00261210
  120 FORMAT(1X , 32H .... PLANE STRAIN ELEMENTS ..../)                 00261220
      IF(NTAG.EQ.0.AND.MTYP .NE.11) WRITE(6,130)                        00261230
      IF(NTAG.EQ.0.AND.MTYP .EQ.11) WRITE(6,140)                        00261240
  130 FORMAT(12H0EL.NO. LOAD,12X,90HY-STRESS   Z-STRESS  YZ-STRESS   T-S00261250
     $TRESS MAX-STRESS MIN-STRESS  ANGLE   SIG-EF   LOCATION  /)        00261260
  140 FORMAT(12H0EL.NO. LOAD,12X,90HR-STRESS   Z-STRESS  RZ-STRESS   T-S00261270
     $TRESS MAX-STRESS MIN-STRESS  ANGLE   SIG-EF   LOCATION  /)        00261280
      IF(NTAG.EQ.0.AND.KOPT.GT.1.AND.NADD.EQ.1) WRITE(6,150)            00261290
  150 FORMAT( 5X,39HNOTE - NODES ARE NEW RENUMBERED NODES       /)      00261300
  154 KK=SIG(150)                                                       00261310
      NSCG=8                                                            00261320
      JL=1000                                                           00261330
      IF(JJ.GT.1) JL=(KK-16)/4                                          00261340
      DO 200 I=1,JJ                                                     00261350
      KK=KK+1                                                           00261360
      FACE=SIG(KK)*10000.+.001                                          00261370
      NF=FACE                                                           00261380
      LL=NF                                                             00261390
      A=Q(2)                                                            00261400
      IF(I.EQ.1) GO TO 155                                              00261410
      IF(NADD.GT.1.AND.I.LE.JL) NF=NORD(LL)                             00261420
      A=Q(1)                                                            00261430
      IF(I.EQ.1) A=Q(2)                                                 00261440
      IF(I.LE.JL) GO TO 155                                             00261450
      A=Q(3)                                                            00261460
      NF=I-JL                                                           00261470
      LL=SIG(KK)                                                        00261480
      IF(SIG(KK).LT.0.0) LL=LL-1                                        00261490
      X(1)=(SIG(KK)-LL-XAD)*XMX                                         00261500
      KK=KK+1                                                           00261510
      LL=SIG(KK)                                                        00261520
      IF(SIG(KK).LT.0.0) LL=LL-1                                        00261530
      X(2)=(SIG(KK)-LL-XAD)*XMX                                         00261540
  155 CONTINUE                                                          00261550
      LL=4*(I-1)                                                        00261560
      DO 160 J=1,4                                                      00261570
      LL=LL+1                                                           00261580
        D(J)=SIG(LL)                                                    00261590
160     CONTINUE                                                        00261600
      CALL MXMN1 (D,C(1),C(2),C(3),C(4))                                00261610
      DO 165 K=1,4                                                      00261620
      KL=KL+1                                                           00261630
  165 SIGEX(KL)=C(K)                                                    00261640
  170 FORMAT(I4,I2,2H12,6F9.0)                                          00261650
      IF(I.EQ.1) WRITE(6,180)MM,L,D,C,A                                 00261660
      IF(I.GT.1.AND.I.LE.JL) WRITE(6,190)D,C,A,NF                       00261670
      IF(I.GT.JL) SIGEX(KL-1)=X(1)                                      00261680
      IF(I.GT.JL) SIGEX(KL  )=X(2)                                      00261690
      IF(I.GT.JL) GO TO 200                                             00261700
      IF(I.GT.JL.AND.L.EQ.1) WRITE(6,175)X(1),X(2),D,C,A,NF             00261710
      IF(I.GT.JL.AND.L.GT.1) WRITE(6,190)D,C,A,NF                       00261720
  175 FORMAT(3H Y=,F8.2,3H Z=,F8.2,F10.0,5E11.4,F7.2,E11.4,2X,A4,I5)    00261730
  180 FORMAT(2I6,     9X,6E11.4,F7.2,E11.4,2X,A4,I5)                    00261740
  190 FORMAT(21X,    6E11.4,F7.2,E11.4,2X,A4,I5)                        00261750
        IF(I.EQ.1)WRITE(35,1235)MM,MTYP,L,D,C                           00261760
  200 CONTINUE                                                          00261770
      KK=SIG(150)                                                       00261780
      LL=JJ*4                                                           00261790
      NS=KK+LL                                                          00261800
      IF(NSTR.GT.0) WRITE(NSTR,1234) NS,L,MTYP,(SIGEX(I),I=1,LL),(SIG(I)00261810
     $,I=1,KK)                                                          00261820
 1234 FORMAT(I4,I2,2X,I2  ,7G10.4/(8G10.4))                             00261830
1235    FORMAT(3I5,10E10.3)                                             00261840
      RETURN                                                            00261850
      END                                                               00261860
      SUBROUTINE ST3D1(NORD,NADD)                                       00263600
      IMPLICIT REAL*8(A-H,O-Z)                                          00263610
      COMMON /JUNK/ SIG(200),MM,L,K,NTAG,RRJUNK(25)                     R0263620
      COMMON /BAND/ KOPT,NRBAND(7)                                      R0263630
      COMMON /OUT/NR,NSTR,NROUT(8)                                      R0263640
      COMMON/QTSARG/SIGEX(90),RRQTSA(910)                               R0263650
      DIMENSION C(6),D(12),Q(2)                                         00263660
      DIMENSION NORD(NADD)                                              00263670
      DATA Q/4HNODE,4HC.G./                                             00263680
      MTYP=10                                                           00263690
      JJ=SIG(150)/6.                                                    00263700
      IF(NTAG.GT.0) GO TO 125                                           00263710
      IF(NTAG.EQ.0) WRITE(6,100)                                        00263720
  100 FORMAT(1X , 39H .... 3-D SOLID ELEMENTS 8-20NODE .... /)          00263730
      IF(NTAG.EQ.0.AND.KOPT.GT.1.AND.NADD.EQ.1) WRITE(6,110)            00263740
  110 FORMAT(5X, 35H NODE NUMBERS ARE RENUMBERED NODES /)               00263750
      IF(NTAG.EQ.0) WRITE(6,120)                                        00263760
  120 FORMAT(                                                           00263770
     $61H ELEM. LOAD LOC.    SIG-XX    SIG-YY    SIG-ZZ    SIG-XY    S, 00263780
     $57HIG-YZ    SIG-ZX    SIG-MAX    SIG-MIN    SIG-MID   SIG-EF/)    00263790
  125 KK=SIG(150)                                                       00263800
      A=0.                                                              00263810
      B=0.                                                              00263820
      E=6.                                                              00263830
      KL=0                                                              00263840
      DO 180 I=1,JJ                                                     00263850
      KK=KK+1                                                           00263860
      FACE=SIG(KK)*10000.+.001                                          00263870
      NF=FACE                                                           00263880
      LL=NF                                                             00263890
      IF(NADD.GT.1.AND.I.GT.1)  NF=NORD(LL)                             00263900
      LL=6*(I-1)                                                        00263910
      DO 130 J=1,6                                                      00263920
      LL=LL+1                                                           00263930
  130 D(J)=SIG(LL)                                                      00263940
      CALL SPRIST(A,B,D,C,E)                                            00263950
      EFS=(C(1)-C(2))**2+(C(2)-C(3))**2+(C(3)-C(1))**2                  00263960
      EFS= DSQRT(EFS/2.)                                                00263970
      DO 135 K=1,3                                                      00263980
      KL=KL+1                                                           00263990
  135 SIGEX(KL)=C(K)                                                    00264000
      KL=KL+1                                                           00264010
      SIGEX(KL)=EFS                                                     00264020
      IF(I.GT.1) GO TO 160                                              00264030
  140 FORMAT(I4,I2,2H71,6F9.0)                                          00264040
      WRITE(6,150)MM,L,Q(2),(D(J),J=1,6),(C(J),J=1,3),EFS               00264050
      WRITE(35,1235)MM,MTYP,L,(D(J),J=1,6),(C(J),J=1,3),EFS             00264060
  150 FORMAT(I5,I4,1X,A4,1X,10E10.3)                                    00264070
      GO TO 180                                                         00264080
  160 WRITE(6,170)Q(1),NF,(D(J),J=1,6),(C(J),J=1,3),EFS                 00264090
  170 FORMAT (5X,A4,I5,1X,10E10.3)                                      00264100
  180 CONTINUE                                                          00264110
      KK=SIG(150)                                                       00264120
      LL=JJ*4                                                           00264130
      NS=KK+LL                                                          00264140
      IF(NSTR.GT.0) WRITE(NSTR,1234) NS,L,(SIGEX(I),I=1,LL),(SIG(I),I=1,00264150
     $KK)                                                               00264160
 1234 FORMAT(I4,I2,2X,2H10,7G10.4/(8G10.4))                             00264170
 1235 FORMAT(3I5,10E10.3)                                               00264180
      RETURN                                                            00264190
      END                                                               00264200
      SUBROUTINE MPRMAT(A,NR,NC,MAX,TITLE)                              00150800
      IMPLICIT REAL*8(A-H,O-Z)                                          00150810
      DIMENSION A(MAX,1) , TITLE(2)                                     00150820
      WRITE(6,150)TITLE                                                 00150830
      DO 120 J=1,NC,8                                                   00150840
      JH=J+7                                                            00150850
      IF (JH-NC) 110,110,100                                            00150860
  100 JH=NC                                                             00150870
  110 WRITE(6,130)(N,N=J,JH)                                            00150880
      DO 120 I=1,NR                                                     00150890
  120 WRITE(6,140)I,(A(I,K),K=J,JH)                                     00150900
      RETURN                                                            00150910
  130 FORMAT (///8X,8I14)                                               00150920
  140 FORMAT (I4,4X,8E14.7)                                             00150930
  150 FORMAT(1X ,8H MATRIX ,2A8)                                        00150940
      END                                                               00150950
      SUBROUTINE TUBE                                                   00316510
      DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,  00316520
     1    R3,EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,00316530
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE,   00316540
     3    PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,C,S76, 00316550
     4    FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00316560
     5    DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS,  00316570
     6    BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ,   00316580
     7    XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I,     00316590
     8    XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,            00316600
     9    XINER2,XINER3                                                 00316610
      COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3,   00316620
     1    EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,   00316630
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,        00316640
     3    TYPE,PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,  00316650
     4    C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,   00316660
     5    B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,    00316670
     6    BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,  00316680
     7    XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,   00316690
     8    COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,     00316700
     9    XINER2,XINER3,ICT,KATX,KATY                                   00316710
      RED=1.0D0                                                         00316720
      XINER=SM3*DP/2.0D0                                                00316730
      R3=DSQRT(XINER/A)                                                 00316740
      AF=BF*TF                                                          00316750
      AFC=(DP/2.0D0)-(TF/2.0D0)                                         00316760
      T1=(DP/2.0D0)-TF                                                  00316770
      AW=T1*TW*2.0D0                                                    00316780
      AWC=T1/2.0D0                                                      00316790
      C=((AF*AFC)+(AW*AWC))/(AF+AW)                                     00316800
      VQIB2=(A*C)/(4.0D0*XINER*TW)                                      00316810
      XINER=SM2*BF/2.0D0                                                00316820
      R2=DSQRT(XINER/A)                                                 00316830
      AF=DP*TW                                                          00316840
      AFC=(BF/2.0D0)-(TW/2.0D0)                                         00316850
      T1=(BF/2.0D0)-TW                                                  00316860
      AW=T1*TF*2.0D0                                                    00316870
      AWC=T1/2.0D0                                                      00316880
      C=((AF*AFC)+(AW*AWC))/(AF+AW)                                     00316890
      VQIB3=(A*C)/(4.0D0*XINER*TF)                                      00316900
      VQIB3=(A*C)/(4.0D0*XINER*TF)                                      00316910
      RTL=0.0D0                                                         00316920
      BT190=190.0D0/SQFY                                                00316930
      BT238=238.0D0/SQFY                                                00316940
      BTT=(BF-TW-TW)/TF                                                 00316950
      DTT=DP/TW                                                         00316960
      BTS=(DP-TF-TF)/TW                                                 00316970
      DTS=BF/TF                                                         00316980
      RETURN                                                            00316990
      END                                                               00317000
                                                                        00317010
                                                                        00317020
      SUBROUTINE FCOPY(ID,IF)                                           00086440
      RETURN                                                            00086450
      END                                                               00086460
      SUBROUTINE RATIO                                                  00194650
      DOUBLE PRECISION FATEN,FASHR,FACOM,FE2,FE3,FB2,FB3                00194660
      DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,  00194670
     1    R3,EBM,RED,FY,XK,YK,DL,ZATEN,ZASHR,ZACOM,ZB2,ZB3,PSI,SHR,COMB,00194680
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE,   00194690
     3    PI,XLR2,XLR3,XLR,CC,RTL,ZE2,ZE3,XINER,AWC,DT257,FY6,AF,C,S76, 00194700
     4    FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00194710
     5    DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS,  00194720
     6    BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ,   00194730
     7    XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I,     00194740
     8    XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,            00194750
     9    XINER2,XINER3                                                 00194760
      COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3,   00194770
     1    EBM,RED,FY,XK,YK,DL,ZATEN,ZASHR,ZACOM,ZB2,ZB3,PSI,SHR,COMB,   00194780
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,        00194790
     3    TYPE,PI,XLR2,XLR3,XLR,CC,RTL,ZE2,ZE3,XINER,AWC,DT257,FY6,AF,  00194800
     4    C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,   00194810
     5    B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,    00194820
     6    BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,  00194830
     7    XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,   00194840
     8    COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,     00194850
     9    XINER2,XINER3,ICT,KATX,KATY                                   00194860
      T2=0.0D0                                                          00194870
      T3=0.0D0                                                          00194880
      CM2=0.0D0                                                         00194890
      CM3=0.0D0                                                         00194900
      CM2T2=0.0D0                                                       00194910
      CM3T3=0.0D0                                                       00194920
      FATEN=XINC*ZATEN                                                  00194930
      FASHR=XINC*ZASHR                                                  00194940
      FACOM=XINC*ZACOM                                                  00194950
      FE2=XINC*ZE2                                                      00194960
      FE3=XINC*ZE3                                                      00194970
      SH2I=DABS(S2I)*VQIB2                                              00194980
      SH2J=DABS(S2J)*VQIB2                                              00194990
      SH3I=DABS(S3I)*VQIB3                                              00195000
      SH3J=DABS(S3J)*VQIB3                                              00195010
      IF(TYPE-1.0D0)100,100,101                                         00195020
  101 SH3I=0.0D0                                                        00195030
      SH3J=0.0D0                                                        00195040
      SH2I=DSQRT(S2I*S2I+S3I*S3I)*VQIB2                                 00195050
      SH2J=DSQRT(S2J*S2J+S3J*S3J)*VQIB2                                 00195060
  100 SHR=DMAX1(SH2I,SH2J,SH3I,SH3J)                                    00195070
      SHR=SHR/FASHR                                                     00195080
      XFB2I=12.0D0*DABS(XM2I)/SM2                                       00195090
      XFB3I=12.0D0*DABS(XM3I)/SM3                                       00195100
      XFB2J=12.0D0*DABS(XM2J)/SM2                                       00195110
      XFB3J=12.0D0*DABS(XM3J)/SM3                                       00195120
      XFA=DABS(P)/A                                                     00195130
      IF(TYPE.EQ.0.0D0)CALL WFFB                                        00195140
      IF(TYPE.EQ.1.0D0)CALL TUFB                                        00195150
      FB2=XINC*ZB2                                                      00195160
      FB3=XINC*ZB3                                                      00195170
      IF(TYPE-1.0D0)200,200,201                                         00195180
  201 TI=DSQRT(XFB2I*XFB2I+XFB3I*XFB3I)                                 00195190
      TJ=DSQRT(XFB2J*XFB2J+XFB3J*XFB3J)                                 00195200
      IF(TI.LE.0.0D0)TI=1.0D0                                           00195210
      IF(TJ.LE.0.0D0)TJ=1.0D0                                           00195220
      XFB2I=XFB2I*XFB2I/TI                                              00195230
      XFB2J=XFB2J*XFB2J/TJ                                              00195240
      XFB3I=XFB3I*XFB3I/TI                                              00195250
      XFB3J=XFB3J*XFB3J/TJ                                              00195260
  200 IF(ICT)300,300,301                                                00195270
  300 AXR=XFA/FATEN                                                     00195280
      COMB1I=(XFB2I/FB2)+(XFB3I/FB3)                                    00195290
      COMB2I=AXR+(XFB2I/FB2)+(XFB3I/FB3)                                00195300
      COMB1J=(XFB2J/FB2)+(XFB3J/FB3)                                    00195310
      COMB2J=AXR+(XFB2J/FB2)+(XFB3J/FB3)                                00195320
      COMB=DMAX1(COMB1I,COMB1J,COMB2I,COMB2J)                           00195330
      IF(COMB.EQ.COMB1I)GO TO 400                                       00195340
      IF(COMB.EQ.COMB2I)GO TO 401                                       00195350
      IF(COMB.EQ.COMB1J)GO TO 402                                       00195360
      IF(COMB.EQ.COMB2J)GO TO 403                                       00195370
      GO TO 9999                                                        00195380
  400 AXR=0.0D0                                                         00195390
      BEND2=XFB2I/FB2                                                   00195400
      BEND3=XFB3I/FB3                                                   00195410
      GO TO 9999                                                        00195420
  401 BEND2=XFB2I/FB2                                                   00195430
      BEND3=XFB3I/FB3                                                   00195440
      GO TO 9999                                                        00195450
  402 AXR=0.0D0                                                         00195460
      BEND2=XFB2J/FB2                                                   00195470
      BEND3=XFB3J/FB3                                                   00195480
      GO TO 9999                                                        00195490
  403 BEND2=XFB2J/FB2                                                   00195500
      BEND3=XFB3J/FB3                                                   00195510
      GO TO 9999                                                        00195520
  301 XFAFA=XFA/FACOM                                                   00195530
      XFB2IB=XFB2I/FB2                                                  00195540
      XFB3IB=XFB3I/FB3                                                  00195550
      XFB2JB=XFB2J/FB2                                                  00195560
      XFB3JB=XFB3J/FB3                                                  00195570
      IF(XFAFA-.15D0)600,600,601                                        00195580
  600 COMB1I=XFAFA+XFB2IB+XFB3IB                                        00195590
      COMB1J=XFAFA+XFB2JB+XFB3JB                                        00195600
      AXR=XFAFA                                                         00195610
      IF(COMB1I-COMB1J)650,650,651                                      00195620
  650 COMB=COMB1J                                                       00195630
      BEND2=XFB2JB                                                      00195640
      BEND3=XFB3JB                                                      00195650
      GO TO 9999                                                        00195660
  651 COMB=COMB1I                                                       00195670
      BEND2=XFB2IB                                                      00195680
      BEND3=XFB3IB                                                      00195690
      GO TO 9999                                                        00195700
  601 COMB1I=(XFA/FATEN)+XFB2IB+XFB3IB                                  00195710
      COMB1J=(XFA/FATEN)+XFB2JB+XFB3JB                                  00195720
      T2=1.0D0-(XFA/FE2)                                                00195730
      T3=1.0D0-(XFA/FE3)                                                00195740
      IF(T2.LE.0.0D0.OR.T3.LE.0.0D0)GO TO 700                           00195750
      GO TO 750                                                         00195760
  700 AXR=9.9999D0                                                      00195770
      BEND2=0.0D0                                                       00195780
      BEND3=0.0D0                                                       00195790
      COMB=9.9999D0                                                     00195800
      GO TO 9999                                                        00195810
  750 GO TO(901,902,1300,1310,903,1320,1330),KATX                       00195820
  901 CM2=1.0D0-(.18D0*XFA/FE2)                                         00195830
      GO TO 904                                                         00195840
  902 CM2=1.0                                                           00195850
      IF(DABS(XM2I).GT.DABS(XM2J))CM2=XM2J/XM2I                         00195860
      IF(DABS(XM2J).GT.DABS(XM2I))CM2=XM2I/XM2J                         00195870
      CM2=DSQRT(.3*CM2*CM2-.4*CM2+.3)                                   00195880
      GO TO 904                                                         00195890
 1300 CM2=1.0D0                                                         00195900
      GO TO 904                                                         00195910
 1310 CM2=1.0D0-(0.2D0*XFA/FE2)                                         00195920
      GO TO 904                                                         00195930
  903 CM2=1.0D0-(.3D0*XFA/FE2)                                          00195940
      GO TO 904                                                         00195950
 1320 CM2=1.0D0-(0.4*XFA/FE2)                                           00195960
      GO TO 904                                                         00195970
 1330 CM2=1.0D0-(0.6*XFA/FE2)                                           00195980
  904 GO TO(911,912,1370,1380,913,1390,1400),KATY                       00195990
  911 CM3=1.0D0-(.18D0*XFA/FE3)                                         00196000
      GO TO 914                                                         00196010
  912 CM3=1.0                                                           00196020
      IF(DABS(XM3I).GT.DABS(XM3J))CM3=XM3J/XM3I                         00196030
      IF(DABS(XM3J).GT.DABS(XM3I))CM3=XM3I/XM3J                         00196040
      CM3=DSQRT(.3*CM3*CM3-.4*CM3+.3)                                   00196050
      GO TO 914                                                         00196060
 1370 CM3=1.0D0                                                         00196070
      GO TO 914                                                         00196080
 1380 CM3=1.0D0-(0.2*XFA/FE3)                                           00196090
      GO TO 914                                                         00196100
  913 CM3=1.0D0-(.3D0*XFA/FE3)                                          00196110
      GO TO 914                                                         00196120
 1390 CM3=1.0D0-(0.4D0*XFA/FE3)                                         00196130
      GO TO 914                                                         00196140
 1400 CM3=1.0D0-(0.6D0*XFA/FE3)                                         00196150
  914 CM2T2=CM2/T2                                                      00196160
      CM3T3=CM3/T3                                                      00196170
      IF(CM2T2.LT.1.0) CM2T2=1.0                                        00196180
      IF(CM3T3.LT.1.0) CM3T3=1.0                                        00196190
      COMB2I=XFAFA+CM2T2*XFB2IB+CM3T3*XFB3IB                            00196200
      COMB2J=XFAFA+CM2T2*XFB2JB+CM3T3*XFB3JB                            00196210
      COMB=DMAX1(COMB1I,COMB1J,COMB2I,COMB2J)                           00196220
      IF(COMB.EQ.COMB1I)GO TO 800                                       00196230
      IF(COMB.EQ.COMB1J)GO TO 801                                       00196240
      IF(COMB.EQ.COMB2I)GO TO 802                                       00196250
      IF(COMB.EQ.COMB2J)GO TO 803                                       00196260
      GO TO 9999                                                        00196270
  800 AXR=XFA/FATEN                                                     00196280
      BEND2=XFB2IB                                                      00196290
      BEND3=XFB3IB                                                      00196300
      GO TO 9999                                                        00196310
  801 AXR=XFA/FATEN                                                     00196320
      BEND2=XFB2JB                                                      00196330
      BEND3=XFB3JB                                                      00196340
      GO TO 9999                                                        00196350
  802 AXR=XFAFA                                                         00196360
      BEND2=(CM2T2)*XFB2IB                                              00196370
      BEND3=(CM3T3)*XFB3IB                                              00196380
      GO TO 9999                                                        00196390
  803 AXR=XFAFA                                                         00196400
      BEND2=(CM2T2)*XFB2JB                                              00196410
      BEND3=(CM3T3)*XFB3JB                                              00196420
 9999 CONTINUE                                                          00196430
      RETURN                                                            00196440
      END                                                               00196450
      SUBROUTINE MHDIAG(H,N,IEGEN,U,NR,X,IQ)                            00135830
      IMPLICIT REAL*8(A-H,O-Z)                                          00135840
      REAL*8  IQ                                                        00135850
      DIMENSION H(N,N),U(N,N),X(N),IQ(N)                                00135860
      IF (IEGEN) 140,100,140                                            00135870
  100 DO 130 I=1,N                                                      00135880
      DO 130 J=1,N                                                      00135890
      IF(I-J) 120,110,120                                               00135900
  110 U(I,J)=1.0                                                        00135910
      GO TO 130                                                         00135920
  120 U(I,J)=0.                                                         00135930
  130 CONTINUE                                                          00135940
  140 NR = 0                                                            00135950
      IF (N-1) 540,540,150                                              00135960
  150 NMI1=N-1                                                          00135970
      DO 170 I=1,NMI1                                                   00135980
      X(I) = 0.                                                         00135990
      IPL1=I+1                                                          00136000
      DO 170 J=IPL1,N                                                   00136010
      IF ( X(I) - DABS( H(I,J))) 160,160,170                            00136020
  160 X(I)= DABS(H(I,J))                                                00136030
      IQ(I)=J                                                           00136040
  170 CONTINUE                                                          00136050
      RAP=7.450580596E-9                                                00136060
      HDTEST=1.0E38                                                     00136070
  180 DO  210  I=1,NMI1                                                 00136080
      IF (I-1) 200,200,190                                              00136090
  190 IF ( XMAX- X(I)) 200,210,210                                      00136100
  200 XMAX=X(I)                                                         00136110
      IPIV=I                                                            00136120
      JPIV=IQ(I)                                                        00136130
  210 CONTINUE                                                          00136140
      IF ( XMAX) 540,540,220                                            00136150
  220 IF (HDTEST) 240,240,230                                           00136160
  230 IF (XMAX - HDTEST) 240,240,270                                    00136170
  240 HDIMIN = DABS( H(1,1) )                                           00136180
      DO 260  I= 2,N                                                    00136190
      IF (HDIMIN- DABS( H(I,I))) 260,260,250                            00136200
  250 HDIMIN= DABS(H(I,I))                                              00136210
  260 CONTINUE                                                          00136220
      HDTEST=HDIMIN*RAP                                                 00136230
      IF (HDTEST- XMAX) 270,540,540                                     00136240
  270 NR = NR+1                                                         00136250
  280 TANG = DSIGN(2.D0,(H(IPIV,IPIV)-H(JPIV,JPIV)))*H(IPIV,JPIV)/(DABS(00136260
     $H(IPIV,IPIV)-H(JPIV,JPIV))+ DSQRT((H(IPIV,IPIV)-H(JPIV,JPIV))     00136270
     $**2+4.0*H(IPIV,JPIV)**2))                                         00136280
      COSINE=1.0/ DSQRT(1.0+TANG**2)                                    00136290
      SINE=TANG*COSINE                                                  00136300
      HII=H(IPIV,IPIV)                                                  00136310
      H(IPIV,IPIV)=COSINE**2*(HII+TANG*(2.*H(IPIV,JPIV)+TANG*H(JPIV,JPIV00136320
     $)))                                                               00136330
      H(JPIV,JPIV)=COSINE**2*(H(JPIV,JPIV)-TANG*(2.*H(IPIV,JPIV)-TANG*H 00136340
     $II))                                                              00136350
      H(IPIV,JPIV)=0.                                                   00136360
      IF ( H(IPIV,IPIV) -  H(JPIV,JPIV)) 290,300,300                    00136370
  290 HTEMP = H(IPIV,IPIV)                                              00136380
      H(IPIV,IPIV) = H(JPIV,JPIV)                                       00136390
      H(JPIV,JPIV) = HTEMP                                              00136400
      HTEMP=DSIGN (1.D0,-SINE)*COSINE                                   00136410
      COSINE = DABS (SINE)                                              00136420
      SINE = HTEMP                                                      00136430
  300 CONTINUE                                                          00136440
      DO 380 I=1,NMI1                                                   00136450
      IF(I-IPIV)320,380,310                                             00136460
  310 IF(I-JPIV)320,380,320                                             00136470
  320 IF(IQ(I)-IPIV)330,340,330                                         00136480
  330 IF(IQ(I)-JPIV)380,340,380                                         00136490
  340 K=IQ(I)                                                           00136500
  350 HTEMP=H(I,K)                                                      00136510
      H(I,K)=0.                                                         00136520
      IPL1=I+1                                                          00136530
      X(I) =0.                                                          00136540
      DO 370 J=IPL1,N                                                   00136550
      IF ( X(I)- DABS( H(I,J)) ) 360,360,370                            00136560
  360 X(I) = DABS(H(I,J))                                               00136570
      IQ(I)=J                                                           00136580
  370 CONTINUE                                                          00136590
      H(I,K)=HTEMP                                                      00136600
  380 CONTINUE                                                          00136610
      X(IPIV) =0.                                                       00136620
      X(JPIV) =0.                                                       00136630
      DO 510 I=1,N                                                      00136640
      IF(I-IPIV)390,510,430                                             00136650
  390 HTEMP = H(I,IPIV)                                                 00136660
      H(I,IPIV) = COSINE*HTEMP + SINE*H(I,JPIV)                         00136670
      IF ( X(I) -  DABS( H(I,IPIV)) )400,410,410                        00136680
  400 X(I) = DABS(H(I,IPIV))                                            00136690
      IQ(I) = IPIV                                                      00136700
  410 H(I,JPIV) = -SINE*HTEMP + COSINE*H(I,JPIV)                        00136710
      IF ( X(I) -  DABS( H(I,JPIV)) ) 420,510,510                       00136720
  420 X(I) = DABS(H(I,JPIV))                                            00136730
      IQ(I) = JPIV                                                      00136740
      GO TO 510                                                         00136750
  430 IF(I-JPIV)440,510,470                                             00136760
  440 HTEMP = H(IPIV,I)                                                 00136770
      H(IPIV,I) = COSINE*HTEMP + SINE*H(I,JPIV)                         00136780
      IF ( X(IPIV) -  DABS( H(IPIV,I)) ) 450,460,460                    00136790
  450 X(IPIV) = DABS(H(IPIV,I))                                         00136800
      IQ(IPIV) = I                                                      00136810
  460 H(I,JPIV) = -SINE*HTEMP + COSINE*H(I,JPIV)                        00136820
      IF ( X(I) -  DABS( H(I,JPIV)) ) 420,510,510                       00136830
  470 HTEMP = H(IPIV,I)                                                 00136840
      H(IPIV,I) = COSINE*HTEMP + SINE*H(JPIV,I)                         00136850
      IF ( X(IPIV) -  DABS( H(IPIV,I)) ) 480,490,490                    00136860
  480 X(IPIV) = DABS(H(IPIV,I))                                         00136870
      IQ(IPIV) = I                                                      00136880
  490 H(JPIV,I) = -SINE*HTEMP + COSINE*H(JPIV,I)                        00136890
      IF ( X(JPIV) -  DABS( H(JPIV,I)) ) 500,510,510                    00136900
  500 X(JPIV) = DABS(H(JPIV,I))                                         00136910
      IQ(JPIV) = I                                                      00136920
  510 CONTINUE                                                          00136930
      IF(IEGEN)180,520,180                                              00136940
  520 DO 530 I=1,N                                                      00136950
      HTEMP=U(I,IPIV)                                                   00136960
      U(I,IPIV)=COSINE*HTEMP+SINE*U(I,JPIV)                             00136970
  530 U(I,JPIV)=-SINE*HTEMP+COSINE*U(I,JPIV)                            00136980
      GO TO 180                                                         00136990
  540 RETURN                                                            00137000
      END                                                               00137010
      FUNCTION MINDEG(NC,IC,IDEG,NN)                                    00137020
      INTEGER*2  IC,IDEG                                                00137030
      DIMENSION IC(1),IDEG(1)                                           00137040
      M=10000                                                           00137050
      DO 130 I=1,NN                                                     00137060
      IF(NC)100,110,100                                                 00137070
  100 IF(IC(I)-NC) 130,110,130                                          00137080
  110 IF(M-IDEG(I)) 130,130,120                                         00137090
  120 M=IDEG(I)                                                         00137100
  130 CONTINUE                                                          00137110
      MINDEG=M                                                          00137120
      RETURN                                                            00137130
      END                                                               00137140
      SUBROUTINE PIPE                                                   00164640
      DOUBLE PRECISION FXE,FXC                                          00164650
      DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,  00164660
     1    R3,EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,00164670
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE,   00164680
     3    PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,C,S76, 00164690
     4    FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00164700
     5    DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS,  00164710
     6    BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ,   00164720
     7    XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I,     00164730
     8    XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,            00164740
     9    XINER2,XINER3                                                 00164750
      COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3,   00164760
     1    EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,   00164770
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,        00164780
     3    TYPE,PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,  00164790
     4    C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,   00164800
     5    B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,    00164810
     6    BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,  00164820
     7    XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,   00164830
     8    COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,     00164840
     9    XINER2,XINER3,ICT,KATX,KATY                                   00164850
      DTA=DIAM/WALL                                                     00164860
      FXE=0.6*EBM*WALL/DIAM                                             00164870
      FXC=FY*(1.64-0.23*DTA**0.25)                                      00164880
      IF(FXC.GT.FXE)FXC=FXE                                             00164890
      IF(FXC.GT.FY)FXC=FY                                               00164900
      RED=FXC/FY                                                        00164910
      FB2=.6666667D0*FY*RED                                             00164920
      FB3=FB2                                                           00164930
      XINER=SM2*DIAM/2.0D0                                              00164940
      R2=DSQRT(XINER/A)                                                 00164950
      R3=R2                                                             00164960
      ROD=DIAM/2.0D0                                                    00164970
      RID=ROD-WALL                                                      00164980
      AOD=1.570796D0*ROD*ROD                                            00164990
      AID=1.570796D0*RID*RID                                            00165000
      COD=.424413D0*ROD                                                 00165010
      CID=.424413D0*RID                                                 00165020
      C=((AOD*COD)-(AID*CID))/(AOD-AID)                                 00165030
      VQIB2=(A*C)/(4.0D0*XINER*WALL)                                    00165040
      VQIB3=VQIB2                                                       00165050
      RTL=0.0D0                                                         00165060
      RETURN                                                            00165070
      END                                                               00165080
                                                                        00165090
                                                                        00165100
      SUBROUTINE SIXST1                                                 00238110
      IMPLICIT REAL*8(A-H,O-Z)                                          00238120
      COMMON /OUT/NRES,NSTR,NROUT(8)                                    R0238130
      COMMON/JUNK/SIG(6),EXTRA(194),MM,L,K,NTAG,RRJUNK(25)              R0238140
      IF(NTAG.EQ.0) WRITE(6,300)                                        00238150
      WRITE(6,100)MM,L,SIG                                              00238160
      NTAG=1                                                            00238170
      IF(NSTR.GT.0) WRITE (NSTR,1234)   L,SIG                           00238180
 1234 FORMAT(3X,1H6,I2,2X,2H14,6G10.4)                                  00238190
      RETURN                                                            00238200
  100 FORMAT (2I6,6E15.8)                                               00238210
  200 FORMAT (I4,I2,2H12,6F9.0)                                         00238220
  300 FORMAT (//10X,48H SIX BY SIX STIFFNESS ELEMENT FORCES AND MOMENTS/00238230
     $20X,18H(LOCAL DIRECTIONS)/                                        00238240
     $12H0EL.NO. LOAD,5X,10HFORCE - XX,5X,10HFORCE - YY,5X,10HFORCE - ZZ00238250
     $,4X,11HMOMENT - XX,4X,11HMOMENT - YY,4X,11HMOMENT - ZZ)           00238260
      END                                                               00238270
      SUBROUTINE STRUSS                                                 00282440
      IMPLICIT REAL*8(A-H,O-Z)                                          00282450
      REAL*8 NPAR                                                               
      COMMON A(1)                                                       00282460
      COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00282470
     $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN                R0282480
      COMMON/JUNK/SIG(12),EXTRA(188),MM,L,K,NTAG,NDYN,NRJUNK(49)        R0282490
      COMMON /OUT/NRES,NSTR,NDIS,NROUT(7)                               R0282500
  100 IF (NTAG.EQ.0) WRITE (6,130)                                      00282510
  110 WRITE(6,140) MM,L,SIG(1),SIG(2)                                   00282520
      NTAG=1                                                            00282530
      IF(NSTR.GT.0) WRITE(NSTR,1234) L,SIG(1),SIG(2)                    00282540
 1234 FORMAT(3X,1H2,I2,2X,2H 1,6G10.4)                                  00282550
  120 FORMAT (I4,I2,2H12 )                                              00282560
      RETURN                                                            00282570
  130 FORMAT(23H1  TRUSS MEMBER ACTIONS //                              00282580
     $       46H0 MEMBER    LOAD         STRESS          FORCE/)        00282590
  140 FORMAT (2I8,E15.5,E15.5)                                          00282600
      END                                                               00282610
      SUBROUTINE SAXIS                                                  00221180
      IMPLICIT REAL*8(A-H,O-Z)                                          00221190
      REAL*8 NPAR                                                       RR221191
      COMMON/JUNK/SIG(200),MM,L,K,NTAG,NDYN,NRJUNK(49)                  R0221200
      COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00221210
     $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN                00221220
      COMMON /OUT/NRES,NSTR,NDIS,NROUT(7)                               R0221230
      MTYP=4                                                            00221240
  100 IF(NTAG.EQ.0) WRITE (6,130)                                       00221250
      CC=(SIG(1)+SIG(2))/2.0                                            00221260
      BB=(SIG(1)-SIG(2))/2.                                             00221270
      CR= DSQRT(BB**2+SIG(4)**2)                                        00221280
      SIG(5)=CC+CR                                                      00221290
      SIG(6)=CC-CR                                                      00221300
      SIG(7)=0.0                                                        00221310
      EF=(SIG(3)-SIG(5))**2+(SIG(5)-SIG(6))**2+(SIG(6)-SIG(3))**2       00221320
      EF= DSQRT(EF/2.)                                                  00221330
      IF ((BB.EQ.0.0).AND.(SIG(4).EQ.0.0)) GO TO 110                    00221340
      SIG(7)=28.648* DATAN2(SIG(4),BB)                                  00221350
  110 WRITE(6,140)MM,L,(SIG (I),I=1,7),EF                               00221360
      WRITE(35,1235)MM,MTYP,L,(SIG(I),I=1,7),EF                         00221370
      IF(NSTR.GT.0) WRITE(NSTR,1234) L,SIG(5),SIG(6),EF,(SIG(I),I=1,4)  00221380
 1234 FORMAT(3X,1H7,I2,4H12 4 ,7G10.4)                                  00221390
 1235 FORMAT(3I5,10E10.3)                                               00221400
  120 FORMAT (I4,I2,2H12,6F9.0)                                         00221410
      NTAG=1                                                            00221420
      RETURN                                                            00221430
  130 FORMAT(32H1  AXISYMMETRIC ELEMENT STRESSES //                     00221440
     $          12H0EL.NO. LOAD,7X,8HR-STRESS,7X,8HZ-STRESS,7X,         00221450
     $ 8HT-STRESS,6X,9HRZ-STRESS,5X,10HMAX-STRESS,5X,10HMIN-STRESS,     00221460
     $3X,5HANGLE,5X,6HSIG-EF/)                                          00221470
  140 FORMAT(2I6,6E15.5,F8.3,E12.5)                                     00221480
      END                                                               00221490
      SUBROUTINE ELBSTR                                                 00076740
      IMPLICIT REAL*8(A-H,O-Z)                                          00076750
      COMMON /JUNK/ SIG(39),EXR(161),MM,L,K,NTAG,RRJUNK(25)             R0076760
      COMMON / OUT / N,NSTR,NDIS,NBMSTR,NROUT(6)                        R0076770
      IF(NTAG.EQ.0) WRITE(6,100)                                        00076780
      IF(NTAG.EQ.0 .AND. NBMSTR.EQ.1)WRITE(6,125)                       00076790
      IF(NTAG.EQ.0)WRITE(6,126)                                         00076800
  126 FORMAT(1X)                                                        00076810
  100 FORMAT(85H1E L B O W - F O R C E S,      M O M E N T S,         A 00076820
     XN D  S T R E S S E S                         //                   00076830
     X1X,7HELEMENT,2X,4HLOAD,2X,7HSTATION,15X,5HAXIAL,2(6X,5HSHEAR),    00076840
     X4X,9HTORSION  ,2(5X,13HB E N D I N G ,4X)/                        00076850
     X2X,6HNUMBER,2X,4HCASE,11X,5HFORCE,                                00076860
     X   11X,2HRX,9X,2HRY,9X,2HRZ,9X,2HMX,20X,2HMY,20X,2HMZ)            00076870
  125 FORMAT(                                                           00076880
     X25X,6HSTRESS,7X,5HRX/A1,3X,8HAT Q3/B3,4X,8HAT Q2/B2,5X,4H- - ,1X, 00076890
     X2X,9H   AT +C3,2X,9H   AT -C3,                                    00076900
     X2X,9H   AT +C2,2X,9H   AT -C2   )                                 00076910
      NS=EXR(161)                                                       00076920
      IF(NS.GT.18)                                                      00076930
     XWRITE(6,120)MM,L,(SIG(I1),I1= 1, 6),                              00076940
     X               (SIG(I2),I2=19,25),                                00076950
     X               (SIG(I3),I3= 7,12),                                00076960
     X               (SIG(I4),I4=26,32),                                00076970
     X               (SIG(I5),I5=13,18),                                00076980
     X               (SIG(I6),I6=33,39)                                 00076990
      IF(NS.LE.18)                                                      00077000
     XWRITE(6,140)MM,L,(SIG(I1),I1= 1,18)                               00077010
      NTAG=1                                                            00077020
      IF(NSTR.GT.0) WRITE(NSTR,1234) NS,L,(SIG(I),I=1,NS)               00077030
 1234 FORMAT(I4,I2,2X,2H 9,7G10.4/(8G10.4))                             00077040
  120 FORMAT(4X,I4,2X,I4,4X,                                            00077050
     X    5HEND-I, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/     00077060
     X23X,2X,6HSTRESS,2X,1P3E12.4,12X,1P4E12.4/                         00077070
     X18X,6HCENTER,3X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/     00077080
     X23X,2X,6HSTRESS,2X,1P3E12.4,12X,1P4E12.4/                         00077090
     X18X,5HEND-J, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/     00077100
     X23X,2X,6HSTRESS,2X,1P3E12.4,12X,1P4E12.4)                         00077110
  140 FORMAT(4X,I4,2X,I4,4X,                                            00077120
     X    5HEND-I, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/     00077130
     X18X,6HCENTER,2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/     00077140
     X18X,5HEND-J, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4)     00077150
      RETURN                                                            00077160
      END                                                               00077170
      SUBROUTINE MXMN1(STRESS,P1,P2,AG,EF)                              00151810
      IMPLICIT REAL*8 (A-H,O-Z)                                         00151820
      DIMENSION STRESS(1)                                               00151830
      CC = (STRESS(1)+STRESS(2)) * 0.5E0                                00151840
      BB = (STRESS(1)-STRESS(2)) * 0.5E0                                00151850
      CR =   DSQRT(BB**2 + STRESS(3)**2)                                00151860
      P1 =  CC+CR                                                       00151870
      P2 =  CC-CR                                                       00151880
      AG=45.0E0                                                         00151890
      IF( DABS(BB).LT.1.0E-8) GO TO 100                                 00151900
      AG =  28.648E0*  DATAN2(STRESS(3),BB)                             00151910
  100 EF=(P1-P2)**2+(P2-STRESS(4))**2+(STRESS(4)-P1)**2                 00151920
      EF= DSQRT(EF/2.0)                                                 00151930
      RETURN                                                            00151940
      END                                                               00151950
