      SUBROUTINE STHRED                                                 00269240
      IMPLICIT REAL*8(A-H,O-Z)                                          00269250
      REAL*8NS                                                          00269260
      REAL*8  IS1,IS2,IS3,IS4                                           00269270
      DIMENSION SPR(6)                                                  00269280
      DIMENSION EFS(2)                                                  00269290
      COMMON / JUNK / SIG(15), EXRA(185),MM,L,K,NTAG,NDYN,NRJUNK(49)    R0269300
      COMMON /OUT/NRES,NSTR,NDIS,NROUT(7)                               R0269310
      EQUIVALENCE (IS3,SIG(13)),(IS4,SIG(14)),(NS,SIG(15))              00269320
  100 CONTINUE                                                          00269330
      IF(NTAG.EQ.0) WRITE (6,140)                                       00269340
      NG=NS                                                             00269350
      IS1=IS3                                                           00269360
      IS2=IS4                                                           00269370
      IF(IS1.LT.1) IS1=IS1*100.+0.001                                   00269380
      IF(IS2.LT.1) IS2=IS2*100.+0.001                                   00269390
      NF1=IS1                                                           00269400
      NF2=IS2                                                           00269410
      IS1=NF1                                                           00269420
      IS2=NF2                                                           00269430
      IF(NF1.EQ.0)  NF1=7                                               00269440
      IF(NF2.EQ.0)  NF2=7                                               00269450
      NF=10*NF1+NF2                                                     00269460
      IF(NF.EQ.77) NF=71                                                00269470
      EFS(2)=0.0                                                        00269480
      SPR(4)=0.0                                                        00269490
      SPR(5)=0.0                                                        00269500
      CALL SPRIST(IS1,IS2,SIG,SPR,NS)                                   00269510
      II=NG/6                                                           00269520
      DO 120 J=1,II                                                     00269530
      M=6*J-6                                                           00269540
      EFS(J)=(SIG(M+1)-SIG(M+2))**2+(SIG(M+2)-SIG(M+3))**2+(SIG(M+3)-   00269550
     $SIG(M+1))**2                                                      00269560
      DO 110 I=4,6                                                      00269570
      MI=M+I                                                            00269580
  110 EFS(J)=EFS(J)+6.*SIG(MI)**2                                       00269590
  120 EFS(J)= DSQRT(EFS(J)/2.)                                          00269600
      WRITE (6,150) MM,L,IS1,(SIG(I),I=1,6),(SPR(I),I=1,3) ,EFS(1)      00269610
        LTYP=5                                                          00269620
        WRITE(35,170)MM,LTYP,L,(SIG(I),I=1,6),(SPR(I),I=1,3),EFS(1)     00269630
170     FORMAT(3I5,10E10.3)                                             00269640
      IF(NG.EQ.12) WRITE (6,160) IS2,(SIG(I),I=7,12),(SPR(I),I=4,6)    ,00269650
     $EFS(2)                                                            00269660
      II=6+NG                                                           00269670
      IF(NSTR.GT.0) WRITE(NSTR,1234) II,L,NF,SPR(1),SPR(2),EFS(1),SPR(4)00269680
     $,SPR(5),EFS(2),(SIG(I),I=1,NG)                                    00269690
 1234 FORMAT(I4,I2,I2,2H 5,7G10.4/(8G10.4))                             00269700
  130 FORMAT (I4,2I2,6F9.0)                                             00269710
      RETURN                                                            00269720
  140 FORMAT(36H1.....8-NODE SOLID ELEMENT STRESSES //                  00269730
     $118H ELEM. LOAD FACE    SIG-XX    SIG-YY    SIG-ZZ    SIG-XY    SI00269740
     $G-YZ    SIG-ZX    SIG-MAX   SIG-MIN   S2 OR     SIG-EF  / 16H   NO00269750
     $.  NO.  NO.,84X,5HANGLE/)                                         00269760
  150 FORMAT(I5,I4,F5.0,1X,10E10.3)                                     00269770
  160 FORMAT(9X   ,F5.0,1X,10E10.3)                                     00269780
      END                                                               00269790
      SUBROUTINE SBOUND(NORD,NADD)                                      00222790
      IMPLICIT REAL*8(A-H,O-Z)                                          00222800
      COMMON / JUNK / SIG(12), EXRA(188),MM,L,K,NTAG,NDYN,NRJUNK(49)    R0222810
      DIMENSION NORD(NADD)                                              00222820
  100 IF(NTAG.EQ.0) WRITE(6,110)                                        00222830
        IF(EXRA(138).LE.1.0) NN=EXRA(138)*10000.+.001                   00222840
        IF(EXRA(138).GT.1.0) NN=EXRA(139)*10000.D0+.001D0               00222850
        IF(NADD.GT.1.AND.NN.LE.NADD.AND.NN.GT.0) NN=NORD(NN)            00222860
        IF(NN.LE.0) NN=0                                                00222870
        WRITE(6,120) MM,NN,L,SIG(1),SIG(2)                              00222880
      RETURN                                                            00222890
110     FORMAT(1H1,39H   CONSTRAINT FORCE - BOUNDARY ELEMENTS //        00222900
     $77H   EL. NUMBER     NODE N     LOAD CASE          FORCE(    )   M00222910
     $OMENT(       ) /)                                                 00222920
120     FORMAT(1X,I10,I12,I11,4X,2F20.5)                                00222930
      END                                                               00222940
      SUBROUTINE SBEAM                                                  00221500
      IMPLICIT REAL*8(A-H,O-Z)                                          00221510
      COMMON /JUNK/SIG(26),EXTRA(174),MM,L,K,NTAG,NDYN,NRJUNK(49)       R0221520
      COMMON /OUT/NRES,NSTR,NDIS,NBMSTR,NROUT(6)                        R0221530
  100 IF(NTAG.EQ.0) WRITE (6,120)                                       00221540
      IF(NTAG.EQ.0 .AND. NBMSTR.EQ.1)WRITE(6,125)                       00221550
      IF(NTAG.EQ.0)WRITE(6,126)                                         00221560
      NS=EXTRA(174)                                                     00221570
      IF(NS.GT.12)                                                      00221580
     XWRITE(6,130)MM,L,(SIG(I1),I1=1,6),                                00221590
     X                 (SIG(I2),I2=13,19),                              00221600
     X                 (SIG(I3),I3=7,12),                               00221610
     X                 (SIG(I4),I4=20,26)                               00221620
      IF(NS.LE.12)                                                      00221630
     XWRITE(6,140)MM,L,(SIG(I1),I1= 1,12)                               00221640
      NTAG=1                                                            00221650
      IF(NSTR.GT.0) WRITE(NSTR,1234) NS,L,(SIG(I),I=1,NS)               00221660
 1234 FORMAT(I4,I2,2X,2H 2,7G10.4/(8G10.4))                             00221670
      RETURN                                                            00221680
  120 FORMAT(/59H1....BEAM FORCES,      MOMENTS,         AND STRESSES   00221690
     X      //                                                          00221700
     X1X,7HELEMENT,2X,4HLOAD,2X,7HSTATION,15X,5HAXIAL,2(6X,5HSHEAR),    00221710
     X4X,9HTORSION  ,3X,2(5X,13HB E N D I N G ,6X)/                     00221720
     X2X,6HNUMBER,2X,4HCASE,11X,5HFORCE,                                00221730
     X   11X,2HR1,9X,2HR2,9X,2HR3,9X,2HM1,23X,2HM2,24X,2HM3)            00221740
  125 FORMAT(                                                           00221750
     X25X,6HSTRESS,7X,5HR1/A1,3X,8HAT Q3/B3,4X,8HAT Q2/B2,5X,4H- - ,1X, 00221760
     X4X,9H   AT +C3,3X,9H   AT -C3,                                    00221770
     X3X,9H   AT +C2,3X,9H   AT -C2   )                                 00221780
  126 FORMAT(1X)                                                        00221790
  130 FORMAT(4X,I4,2X,I4,4X,                                            00221800
     X    5HEND-I, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/     00221810
     X23X,2X,6HSTRESS,2X,1P3E12.4,12X,1P4E12.4/                         00221820
     X18X,5HEND-J, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/     00221830
     X23X,2X,6HSTRESS,2X,1P3E12.4,12X,1P4E12.4)                         00221840
  140 FORMAT(4X,I4,2X,I4,4X,                                            00221850
     X    5HEND-I, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/     00221860
     X18X,5HEND-J, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4)     00221870
      END                                                               00221880
      SUBROUTINE SPLANE                                                 00251070
      IMPLICIT REAL*8(A-H,O-Z)                                          00251080
      COMMON /OUT/NRES,NSTR,NDIS,NROUT(7)                               R0251090
        COMMON /SIGO/MTYP                                               00251100
      COMMON/JUNK/SIG(12),EXTRA(188),MM,L,K,NTAG,NDYN,NRJUNK(49)        R0251110
  100 IF(NTAG.EQ.0) WRITE (6,120)                                       00251120
      CC=(SIG(1)+SIG(2))/2.0                                            00251130
      BB=(SIG(1)-SIG(2))/2.                                             00251140
      CR= DSQRT(BB**2+SIG(4)**2)                                        00251150
      SIG(5)=CC+CR                                                      00251160
      SIG(6)=CC-CR                                                      00251170
      SIG(7)=0.0                                                        00251180
      EF=(SIG(3)-SIG(5))**2+(SIG(5)-SIG(6))**2+(SIG(6)-SIG(3))**2       00251190
      EF= DSQRT(EF/2.)                                                  00251200
      IF ((BB.EQ.0.0).AND.(SIG(4).EQ.0.0)) GO TO 110                    00251210
      SIG(7)=28.648* DATAN2(SIG(4),BB)                                  00251220
  110 WRITE(6,130)MM,L,(SIG (I),I=1,7),EF                               00251230
        WRITE(35,210)MM,MTYP,L,(SIG(I),I=1,7),EF,EF,EF                  00251240
210     FORMAT(3I5,10E10.3)                                             00251250
      NTAG=1                                                            00251260
      IF(NSTR.GT.0) WRITE(NSTR,1234) L,SIG(5),SIG(6),EF,(SIG(I),I=1,4)  00251270
 1234 FORMAT(3X,1H7,I2,4H12 3 ,7G10.4)                                  00251280
      RETURN                                                            00251290
  120 FORMAT(39H1  PLANE STRESS/STRAIN ELEMENT STRESSES //              00251300
     $          12H0EL.NO. LOAD,7X,8HR-STRESS,7X,8HZ-STRESS,7X,         00251310
     $ 8HT-STRESS,6X,9HRZ-STRESS,5X,10HMAX-STRESS,5X,10HMIN-STRESS,     00251320
     $3X,5HANGLE,5X,6HSIG-EF/)                                          00251330
  130 FORMAT(2I6,6E15.5,F8.3,E12.5)                                     00251340
  140 FORMAT (I4,I2,2H12,6F9.0)                                         00251350
      END                                                               00251360
      SUBROUTINE STFGPK(ND1,NDMX,STIF,S,KOUNT)                          00268270
      IMPLICIT REAL*8(A-H,O-Z)                                          00268280
      REAL*8  S(NDMX,NDMX),T                                            00268290
      REAL*8  STIF                                                      00268300
      LOGICAL ELPRT,ELPCH,GENPRT,GENPCH                                 00268310
      DIMENSION STIF(1)                                                 00268320
      COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH                              00268330
      COMMON /FORCE/ NLC,NELD                                           00268340
      COMMON/MASS/LMASS                                                 00268350
      IF(.NOT.ELPRT) GO TO 1100                                         00268360
      WRITE(6,160)(STIF(I),I=1,ND1)                                     00268370
      IF(ELPCH) WRITE(7,180)(STIF(I),I=1,ND1)                           00268380
      WRITE(6,170)                                                      00268390
      DO 1020 I=1,ND1                                                   00268400
      IF(ELPCH) WRITE(7,180)(S(I,J),J=1,ND1)                            00268410
 1020 WRITE(6,190)(S(I,J),J=1,ND1)                                      00268420
 1100 CONTINUE                                                          00268430
      IF(ND1.EQ.1) GO TO 8                                              00268440
      NDM=ND1-1                                                         00268450
      DO 7 J=1,NDM                                                      00268460
       IF(STIF(J).LE.0.) GO TO 7                                        00268470
      JP1=J+1                                                           00268480
      DO 6 I=JP1,ND1                                                    00268490
      IF(STIF(J).NE.STIF(I)) GO TO 6                                    00268500
      DO 1 K=1,J                                                        00268510
    1 S(J,K)=S(J,K)+S(I,K)                                              00268520
      IM1=I-1                                                           00268530
      DO 2 K=J,IM1                                                      00268540
    2 S(K,J)=S(K,J)+S(I,K)                                              00268550
      IP1=I+1                                                           00268560
      IF(IP1.GT.ND1) GO TO 4                                            00268570
      DO 3 K=IP1,ND1                                                    00268580
    3 S(K,J)=S(K,J)+S(K,I)                                              00268590
    4 STIF(I)=0.0                                                       00268600
      S(J,J)=S(J,J)+S(I,I)                                              00268610
    6 CONTINUE                                                          00268620
    7 CONTINUE                                                          00268630
    8 CONTINUE                                                          00268640
      I=ND1                                                             00268650
   10 EMAX=STIF(1)                                                      00268660
      J=1                                                               00268670
      DO 40  K=1,I                                                      00268680
      IF(STIF(K).GT.0.0) GO TO 30                                       00268690
      J=K                                                               00268700
      GO TO 50                                                          00268710
   30 IF(STIF(K).LT.EMAX) GO TO 40                                      00268720
      EMAX=STIF(K)                                                      00268730
      J=K                                                               00268740
   40 CONTINUE                                                          00268750
   50 IF(I.EQ.J)GO TO 90                                                00268760
      JM1=J-1                                                           00268770
      IF(JM1.LT.1) GO TO 60                                             00268780
      DO 55 K=1,JM1                                                     00268790
      T=S(I,K)                                                          00268800
      S(I,K)=S(J,K)                                                     00268810
   55 S(J,K)=T                                                          00268820
   60 JP1=J+1                                                           00268830
      IM1=I-1                                                           00268840
      IF(JP1.GT.IM1) GO TO 70                                           00268850
      DO 65 K=JP1,IM1                                                   00268860
      T=S(K,J)                                                          00268870
      S(K,J)=S(I,K)                                                     00268880
   65 S(I,K)=T                                                          00268890
   70 IP1=I+1                                                           00268900
      IF(IP1.GT.ND1) GO TO 78                                           00268910
      DO 75 K=IP1,ND1                                                   00268920
      T=S(K,I)                                                          00268930
      S(K,I)=S(K,J)                                                     00268940
   75 S(K,J)=T                                                          00268950
   78 T=S(I,I)                                                          00268960
      S(I,I)=S(J,J)                                                     00268970
      S(J,J)=T                                                          00268980
      T=STIF(I)                                                         00268990
      STIF(I)=STIF(J)                                                   00269000
      STIF(J)=T                                                         00269010
   90 IF(STIF(I).EQ.0.0) ND1=ND1-1                                      00269020
      I=I-1                                                             00269030
      IF(I.GT.0) GO TO 10                                               00269040
      IF(ND1.LE.0) ND1=1                                                00269050
      KOUNT=0                                                           00269060
      KST=0                                                             00269070
      DO 100 I=1,ND1                                                    00269080
      KST=KST+NDMX                                                      00269090
      KK=KST+I-1                                                        00269100
      DO 100 J=I,ND1                                                    00269110
      KK=KK+1                                                           00269120
      KOUNT=KOUNT+1                                                     00269130
  100 STIF(KOUNT)=STIF(KK)                                              00269140
      KOUNT=KOUNT+1                                                     00269150
      STIF(KOUNT)=ND1                                                   00269160
  160 FORMAT(/1X,22HELEMENT LOCATION MATRX,/,(1H ,10F13.0))             00269170
  170 FORMAT(/1X,34HELEMENT GEOMETRIC STIFFNESS MATRIX)                 00269180
  180 FORMAT((1P8E10.3))                                                00269190
  190 FORMAT(  (1H ,1P10E13.4))                                         00269200
  200 FORMAT(                            (1H ,1P8E13.4))                00269210
      RETURN                                                            00269220
      END                                                               00269230
      SUBROUTINE SSHELL                                                 00255910
      IMPLICIT REAL*8 (A-H,O-Z)                                         00255920
      COMMON/JUNK/SIG(200),MM,L,K,NTAG,NDYN,NRJUNK(49)                  R0255930
      COMMON /OUT/NRES,NSTR,NDIS,NROUT(7)                               R0255940
        COMMON/RLSE/KRLX                                                00255950
        COMMON /RIGID/IIA(20),NREX                                      00255960
      DIMENSION EFS(2)                                                  00255970
        IF(KRLX.GT.0)GO TO 200                                          00255980
  100 IF(NTAG.EQ.0)  WRITE(6,120)                                       00255990
      SIG( 7)=SIG(1)+SIG(4)                                             00256000
      SIG( 8)=SIG(2)+SIG(5)                                             00256010
      SIG( 9)=SIG(3)+SIG(6)                                             00256020
      CC=(SIG( 7)+SIG( 8))/2.                                           00256030
      BB=(SIG( 7)-SIG( 8))/2.                                           00256040
      CR= DSQRT(BB**2+SIG( 9)**2)                                       00256050
      SIG(10)=CC+CR                                                     00256060
      SIG(11)=CC-CR                                                     00256070
      SIG(12)=0.0                                                       00256080
      IF(BB.NE.0) SIG(12)=28.648* DATAN2(SIG( 9),BB)                    00256090
      SIG(13)=SIG(1)-SIG(4)                                             00256100
      SIG(14)=SIG(2)-SIG(5)                                             00256110
      SIG(15)=SIG(3)-SIG(6)                                             00256120
      CC=(SIG(13)+SIG(14))/2.                                           00256130
      BB=(SIG(13)-SIG(14))/2.                                           00256140
      CR= DSQRT(BB**2+SIG(15)**2)                                       00256150
      SIG(16)=CC+CR                                                     00256160
      SIG(17)=CC-CR                                                     00256170
      SIG(18)=0.0                                                       00256180
      IF(BB.NE.0) SIG(18)=28.648* DATAN2(SIG(15),BB)                    00256190
      EFS(1)=SIG(10)**2+SIG(11)**2-SIG(10)*SIG(11)                      00256200
      EFS(1)= DSQRT(EFS(1))                                             00256210
      EFS(2)=SIG(16)**2+SIG(17)**2-SIG(16)*SIG(17)                      00256220
      EFS(2)= DSQRT(EFS(2))                                             00256230
  110 WRITE(6,130)MM,L,(SIG(I),I=1,12),EFS(1),(SIG(I),I=13,18),EFS(2)   00256240
      IF(NSTR.GT.0) WRITE(NSTR,1234) L,SIG(10),SIG(11),EFS(1),SIG(16),  00256250
     $SIG(17),EFS(2),(SIG(I),I=7,9),SIG(12),(SIG(I),I=13,15),SIG(18)    00256260
 1234 FORMAT(4H  14,I2,4H12 6, 7G10.4/(8G10.4))                         00256270
      RETURN                                                            00256280
  120 FORMAT(24H1 SHELL ELEMENT STRESSES  //10X,                        00256290
     $10H   ELEMENT,6X,4HLOAD,10H     SIG-X,9X,5HSIG-Y,9X,6HSIG-XY,7X,  00256300
     $7HSIG-MAX,7X,7HSIG-MIN,8X,5HANGLE,9X,6HSIG-EF)                    00256310
  130 FORMAT(//9H MEMBRANE,1X,2I10,1X,1PE12.5,2X,1PE12.5,2X,1PE12.5/    00256320
     $9H  BENDING,21X,1X,1PE12.5,2X,1PE12.5,2X,1PE12.5/                 00256330
     $10H +T/2 SIDE,20X,1X,1PE12.5,2X,1PE12.5,2X,1PE12.5,2X,1PE12.5,2X, 00256340
     $1PE12.5,2X,1PE12.5,2X,1PE12.5/                                    00256350
     $10H -T/2 SIDE,20X,1X,1PE12.5,2X,1PE12.5,2X,1PE12.5,2X,1PE12.5,2X, 00256360
     $1PE12.5,2X,1PE12.5,2X,1PE12.5)                                    00256370
  140 FORMAT (I4,I2,2H12,6F9.0)                                         00256380
200     IF(NTAG.EQ.0) WRITE(6,1000)                                     00256390
1000    FORMAT(38H1.....SHELL ELEMENT FORCES AND MOMENTS//              00256400
     &  9H  ELEMENT,3X,4HLOAD,3X,4HNODE,3X,2HFX,13X,2HFY,13X,2HFZ       00256410
     &  ,13X,2HMX,13X,2HMY,13X,2HMZ)                                    00256420
        WRITE(6,1010)MM,L,IIA(1),(SIG(I),I=1,6),IIA(2)                  00256430
     &  ,(SIG(I),I=7,12),IIA(3),(SIG(I),I=13,18),IIA(4)                 00256440
     &  ,(SIG(I),I=19,24)                                               00256450
1010    FORMAT(/I5,5X,I3,I7,2X,1P6E15.5/13X,I7,2X,6E15.5/               00256460
     &  13X,I7,2X,6E15.5/13X,I7,2X,6E15.5)                              00256470
        RETURN                                                          00256480
        END                                                             00256490
      SUBROUTINE WIDEF                                                  00322320
      DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,  00322330
     1    R3,EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,00322340
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE,   00322350
     3    PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,C,S76, 00322360
     4    FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00322370
     5    DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS,  00322380
     6    BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ,   00322390
     7    XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I,     00322400
     8    XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,            00322410
     9    XINER2,XINER3                                                 00322420
      COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3,   00322430
     1    EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,   00322440
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,        00322450
     3    TYPE,PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,  00322460
     4    C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,   00322470
     5    B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,    00322480
     6    BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,  00322490
     7    XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,   00322500
     8    COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,     00322510
     9    XINER2,XINER3,ICT,KATX,KATY                                   00322520
      RED=1.0D0                                                         00322530
      XINER=SM3*DP/2.0D0                                                00322540
      R3=DSQRT(XINER/A)                                                 00322550
      AF=BF*TF                                                          00322560
      AFC=(DP/2.0D0)-(TF/2.0D0)                                         00322570
      T1=(DP/2.0D0)-TF                                                  00322580
      AW=T1*TW                                                          00322590
      AWC=T1/2.0D0                                                      00322600
      C=((AF*AFC)+(AW*AWC))/(AF+AW)                                     00322610
      VQIB2=(A*C)/(2.0D0*XINER*TW)                                      00322620
      T1=(DP-TF-TF)/3.0D0                                               00322630
      AW=T1*TW                                                          00322640
      RTL=DSQRT(((TF*BF**3)+(T1*TW**3))/(12.0D0*(AF+AW)))               00322650
      XINER=SM2*BF/2.0D0                                                00322660
      R2=DSQRT(XINER/A)                                                 00322670
      T1=(BF-TW)/2.0D0                                                  00322680
      AFC=(T1+TW)/2.0D0                                                 00322690
      VQIB3=T1*AFC/XINER                                                00322700
      BT65=65.0D0/SQFY                                                  00322710
      BT95=95.0D0/SQFY                                                  00322720
      S76=76.0D0*BF/SQFY                                                00322730
      S20=20000.0D0/((DP/(BF*TF))*FY)                                   00322740
      IF(S20.GT.S76)S20=S76                                             00322750
      C102=DSQRT(102000.0D0/FY)                                         00322760
      C510=DSQRT(510000.0D0/FY)                                         00322770
      BT=BF/(2.0D0*TF)                                                  00322780
      DT=DP/TW                                                          00322790
      RTL=FLG/RTL                                                       00322800
      FB2=1.0D0                                                         00322810
      IF(BT.LE.BT65)FB2=.75D0*FY                                        00322820
      IF(BT.GT.BT65.AND.BT.LE.BT95)FB2=(1.075D0-.005D0*BT*SQFY)*FY      00322830
      RETURN                                                            00322840
      END                                                               00322850
      SUBROUTINE WRDIS1(NORD,A,B,NUMNP,LL,NDPBLK,NDIS,NBLK              00322880
     &  ,AD,XXK,ARE,NREL,ISL,NSLDM)                                     00322890
      IMPLICIT REAL*8(A-H,O-Z)                                          00322900
      DIMENSION NORD(NUMNP),A(6,LL),B(NDPBLK,6,LL)                      00322910
     &  ,AD(NUMNP,3),XXK(NREL,6,LL),ARE(51,NREL),DX(3),ISL(NSLDM,4)     00322920
      COMMON /BAND/ KOPT,NRBAND(7)                                      R0322930
      COMMON/SLVE/NSLAVE                                                00322940
        COMMON /RIGID/ IIA(20),NREX                                     00322950
      COMMON /OUT/ KDUMMY(9),KROT                                       00322960
        COMMON /DYN4/ KDYN,NRDYN4(4)                                    R0322970
      COMMON/COMBLD/PCT(15,7),SINC(15),NCOMB,NB(15),LD(15,7)            00322980
      NT1=17                                                            00322990
      NT2=18                                                            00323000
      IF(NSLAVE.NE.0) REWIND 30                                         00323010
      IF(NSLAVE.NE.0) READ(30)((ISL(I,J),J=1,4),I=1,NSLAVE)             00323020
      IF(NCOMB.GT.0) NT2=1                                              00323030
        NT40=40                                                         00323040
        REWIND 8                                                        00323050
        READ(8)AD                                                       00323060
      IF(KOPT.GT.0) READ (NT1) NORD                                     00323070
        IF(NREX.LE.0)GO TO 10                                           00323080
        REWIND NT40                                                     00323090
        READ(NT40)ARE                                                   00323100
        REWIND NT2                                                      00323110
        DO 8 K=1,NUMNP                                                  00323120
        KK=K                                                            00323130
        IF(KOPT.GT.0)KK=NORD(K)                                         00323140
        DO 7 J=1,NREX                                                   00323150
        NN=ARE(2,J)                                                     00323160
        IF(KK.NE.NN)GO TO 7                                             00323170
        READ(NT2)A                                                      00323180
        DO 5 M=1,6                                                      00323190
        DO 5 L=1,LL                                                     00323200
5       XXK(J,M,L)=A(M,L)                                               00323210
        GO TO 8                                                         00323220
7       CONTINUE                                                        00323230
        READ(NT2)                                                       00323240
8       CONTINUE                                                        00323250
10      CONTINUE                                                        00323260
      KSHF2=0                                                           00323270
      KSHF=1-NDPBLK                                                     00323280
      KNT=0                                                             00323290
      DO 140 I=1,NBLK                                                   00323300
      REWIND NT2                                                        00323310
      KOUNT=0                                                           00323320
      KK=NUMNP+1                                                        00323330
      KSHF=KSHF+NDPBLK                                                  00323340
      KSHF2=KSHF2+NDPBLK                                                00323350
      DO 110 KK=1,NUMNP                                                 00323360
      READ (NT2) A                                                      00323370
      KCH= KK                                                           00323380
      IF(KOPT.GT.0) KCH=NORD(KK)                                        00323390
      IF(KCH.LT.KSHF.OR.KCH.GT.KSHF2)  GO TO 110                        00323400
      KNT=KNT+1                                                         00323410
      KOUNT=KOUNT+1                                                     00323420
      NSHFT=KCH-KSHF+1                                                  00323430
      DO 100 K=1,6                                                      00323440
      DO 100 M=1,LL                                                     00323450
  100 B(NSHFT,K,M)=A(K,M)                                               00323460
        IF(NREX.LE.0)GO TO 109                                          00323470
        DO 108 J=1,NREX                                                 00323480
        NN=ARE(1,J)+1                                                   00323490
        NK=ARE(2,J)                                                     00323500
        DO 107 K=3,NN                                                   00323510
        N=ARE(K,J)                                                      00323520
        IF(N.NE.NSHFT)GO TO 107                                         00323530
        DO 101 M=4,6                                                    00323540
        DO 101 L=1,LL                                                   00323550
101     B(NSHFT,M,L)=XXK(J,M,L)                                         00323560
        NQA=NSHFT                                                       00323570
        NQB=NK                                                          00323580
        IF(KOPT.LE.0)GO TO 1015                                         00323590
        DO 1010 L=1,NUMNP                                               00323600
        IF(NORD(L).NE.NSHFT)GO TO 1009                                  00323610
        NQA=L                                                           00323620
1009    IF(NORD(L).NE.NK)GO TO 1010                                     00323630
        NQB=L                                                           00323640
1010    CONTINUE                                                        00323650
1015    CONTINUE                                                        00323660
        DO 102 M=1,3                                                    00323670
        CALL UNPKID(AD,NUMNP,X,XJ,1,NQA,M)                              00323680
        CALL UNPKID(AD,NUMNP,X,XK,1,NQB,M)                              00323690
102     DX(M)=XK-XJ                                                     00323700
        DO 104 L=1,LL                                                   00323710
        B(NSHFT,1,L)=XXK(J,1,L)-XXK(J,5,L)*DX(3)+XXK(J,6,L)*DX(2)       00323720
        B(NSHFT,2,L)=XXK(J,2,L)+XXK(J,4,L)*DX(3)-XXK(J,6,L)*DX(1)       00323730
        B(NSHFT,3,L)=XXK(J,3,L)-XXK(J,4,L)*DX(2)+XXK(J,5,L)*DX(1)       00323740
104     CONTINUE                                                        00323750
        GO TO 109                                                       00323760
107     CONTINUE                                                        00323770
108     CONTINUE                                                        00323780
109     CONTINUE                                                        00323790
      IF(NSLAVE.EQ.0) GO TO 1200                                        00323800
      DO 1120 J=1,NSLAVE                                                00323810
      IF(KK.EQ.ISL(J,1)) GO TO 1130                                     00323820
 1120 CONTINUE                                                          00323830
      GO TO 1200                                                        00323840
 1130 CONTINUE                                                          00323850
      ISLRF=J                                                           00323860
      DO 1180 J=1,3                                                     00323870
      NMAST=MOD(ISL(ISLRF,J+1),10000)                                   00323880
      IF(NMAST.EQ.0) GO TO 1180                                         00323890
      DO 1160 M=1,3                                                     00323900
      CALL UNPKID(AD,NUMNP,X,XJ,1,NMAST,M)                              00323910
      CALL UNPKID(AD,NUMNP,X,XK,1,KK,M)                                 00323920
 1160 DX(M)=XK-XJ                                                       00323930
      DO 1170 L=1,LL                                                    00323940
      IF(J.EQ.1) B(NSHFT,1,L)=B(NSHFT,1,L)+DX(3)*B(NSHFT,5,L)           00323950
     1                                    -DX(2)*B(NSHFT,6,L)           00323960
      IF(J.EQ.2) B(NSHFT,2,L)=B(NSHFT,2,L)-DX(3)*B(NSHFT,4,L)           00323970
     1                                    +DX(1)*B(NSHFT,6,L)           00323980
      IF(J.EQ.3) B(NSHFT,3,L)=B(NSHFT,3,L)+DX(2)*B(NSHFT,4,L)           00323990
     1                                    -DX(1)*B(NSHFT,5,L)           00324000
 1170 CONTINUE                                                          00324010
 1180 CONTINUE                                                          00324020
 1200 CONTINUE                                                          00324030
      IF(KOUNT.EQ.NDPBLK.OR.KNT.EQ.NUMNP)  GO TO 120                    00324040
  110 CONTINUE                                                          00324050
  120 KNT1=(I-1)*NDPBLK                                                 00324060
      DO 130 J=1,NDPBLK                                                 00324070
      KNT1=KNT1+1                                                       00324080
      IF(KNT1.GT.NUMNP) GO TO 150                                       00324090
      WRITE(6,160)KNT1,(M,(B(J,K,M),K=1,6),M=1,LL)                      00324100
        IF(IABS(KDYN).EQ.11)GO TO 130                                   00324110
      IF(NDIS.GT.0) WRITE (NDIS,170) KNT1,(  (B(J,K,M),K=1,3),M=1,LL)   00324120
        DO 125 M=1,LL                                                   00324130
125     WRITE(32,200)KNT1,M,(B(J,K,M),K=1,3)                            00324140
200     FORMAT(2I5,3F20.10)                                             00324150
      IF(NDIS.GT.0.AND.KROT.EQ.2) WRITE (NDIS,170) KNT1,(  (B(J,K,M),K=400324160
     $,6),M=1,LL)                                                       00324170
  130 CONTINUE                                                          00324180
  140 CONTINUE                                                          00324190
  150 IF(KOPT.GT.0) WRITE(6,180)                                        00324200
  160 FORMAT(1H0,I4,I5,1P6E20.10/(I10,6E20.10))                         00324210
  170 FORMAT(I10,7E10.4/(8E10.4))                                       00324220
  180 FORMAT(// 3X,46H*** NOTE *** NODE NUMBERS ARE ORIGINAL NUMBERS //)00324230
      RETURN                                                            00324240
      END                                                               00324250
      SUBROUTINE WRDIS2(NORD,A,B,NUMNP,LL,NDPBLK,NDIS,NBLK)             00324260
      IMPLICIT REAL*8(A-H,O-Z)                                          00324270
      DIMENSION NORD(NUMNP),A(6,LL),B(NDPBLK,6,LL)                      00324280
      COMMON /OUT/ KDUMMY(9),KROT                                       00324290
      COMMON /BAND/ KOPT,NRBAND(7)                                      R0324300
      NT1=17                                                            00324310
      NT2=18                                                            00324320
      IF(KOPT.GT.0) READ (NT1) NORD                                     00324330
      KSHF2=0                                                           00324340
      KSHF=1-NDPBLK                                                     00324350
      KNT=0                                                             00324360
      DO 140 I=1,NBLK                                                   00324370
      REWIND NT2                                                        00324380
      KOUNT=0                                                           00324390
      KK=NUMNP+1                                                        00324400
      KSHF=KSHF+NDPBLK                                                  00324410
      KSHF2=KSHF2+NDPBLK                                                00324420
      DO 110 J=1,NUMNP                                                  00324430
      KK=KK-1                                                           00324440
      READ (NT2) A                                                      00324450
      KCH= KK                                                           00324460
      IF(KOPT.GT.0) KCH=NORD(KK)                                        00324470
      IF(KCH.LT.KSHF.OR.KCH.GT.KSHF2)  GO TO 110                        00324480
      KNT=KNT+1                                                         00324490
      KOUNT=KOUNT+1                                                     00324500
      NSHFT=KCH-KSHF+1                                                  00324510
      DO 100 K=1,6                                                      00324520
      DO 100 M=1,LL                                                     00324530
  100 B(NSHFT,K,M)=A(K,M)                                               00324540
      IF(KOUNT.EQ.NDPBLK.OR.KNT.EQ.NUMNP)  GO TO 120                    00324550
  110 CONTINUE                                                          00324560
  120 KNT1=(I-1)*NDPBLK                                                 00324570
      DO 130 J=1,NDPBLK                                                 00324580
      KNT1=KNT1+1                                                       00324590
      IF(KNT1.GT.NUMNP) GO TO 150                                       00324600
      WRITE(6,160)KNT1,(M,(B(J,K,M),K=1,6),M=1,LL)                      00324610
      IF(NDIS.GT.0) WRITE (NDIS,170) KNT1,(  (B(J,K,M),K=1,3),M=1,LL)   00324620
      IF(NDIS.GT.0.AND.KROT.EQ.2) WRITE (NDIS,170) KNT1,(  (B(J,K,M),K=400324630
     $,6),M=1,LL)                                                       00324640
        DO 125 M=1,LL                                                   00324650
125     WRITE(32,200)KNT1,M,(B(J,K,M),K=1,3)                            00324660
200     FORMAT(2I5,3F20.10)                                             00324670
  130 CONTINUE                                                          00324680
  140 CONTINUE                                                          00324690
  150 IF(KOPT.GT.0) WRITE(6,180)                                        00324700
  160 FORMAT(1H0,I4,I5,1P3E12.3,3E11.2/(I10,3E12.3,3E11.2))             00324710
  170 FORMAT(I10,7E10.4/(8E10.4))                                       00324720
  180 FORMAT(// 3X,46H*** NOTE *** NODE NUMBERS ARE ORIGINAL NUMBERS //)00324730
      RETURN                                                            00324740
      END                                                               00324750
      SUBROUTINE ALLFA                                                  00016620
      DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,  00016630
     1    R3,EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,00016640
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE,   00016650
     3    PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,C,S76, 00016660
     4    FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00016670
     5    DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS,  00016680
     6    BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ,   00016690
     7    XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I,     00016700
     8    XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,            00016710
     9    XINER2,XINER3                                                 00016720
      COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3,   00016730
     1    EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,   00016740
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,        00016750
     3    TYPE,PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,  00016760
     4    C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,   00016770
     5    B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,    00016780
     6    BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,  00016790
     7    XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,   00016800
     8    COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,     00016810
     9    XINER2,XINER3,ICT,KATX,KATY                                   00016820
      FATEN=.6D0*FY                                                     00016830
      FASHR=.4D0*FY                                                     00016840
      T1=(12.0D0*PI*PI*EBM)/23.0D0                                      00016850
      XLR2=XK*DL/R2                                                     00016860
      XLR3=YK*DL/R3                                                     00016870
      FE2=T1/(XLR2*XLR2)                                                00016880
      FE3=T1/(XLR3*XLR3)                                                00016890
      XLR=XLR2                                                          00016900
      IF(XLR3.GT.XLR2)XLR=XLR3                                          00016910
      IF(XLR.GT.200.0D0)GO TO 100                                       00016920
      CC=DSQRT(2.0D0*PI*PI*EBM/(RED*FY))                                00016930
      FS=(5.0D0/3.0D0)+(3.0D0*XLR)/(8.0D0*CC)-(XLR**3)/(8.0D0*CC**3)    00016940
      FACOM=(1.0D0-((XLR*XLR)/(2.0D0*CC*CC)))*FY*RED/FS                 00016950
      IF(XLR.GT.CC)FACOM=T1/(XLR*XLR)                                   00016960
      GO TO 150                                                         00016970
  100 FACOM=1.0D0                                                       00016980
  150 RETURN                                                            00016990
      END                                                               00017000
                                                                        00017010
                                                                        00017020
      SUBROUTINE COMBDS(D,DNEW,LL,NT18,NCOMB1,NUMNP)                    00045700
      IMPLICIT REAL*8(A-H,O-Z)                                          00045710
      DIMENSION D(6,LL),DNEW(6,NCOMB1)                                  00045720
      COMMON/COMBLD/PCT(15,7),SINC(15),NCOMB,NB(15),LD(15,7)            00045730
      ITAPE1=1                                                          00045740
      REWIND ITAPE1                                                     00045750
      REWIND NT18                                                       00045760
      DO 500 MM=1,NUMNP                                                 00045770
      READ(NT18)D                                                       00045780
      DO 300 N=1,NCOMB                                                  00045790
      DO 270 I=1,6                                                      00045800
  270 DNEW(I,N)=0.0D0                                                   00045810
      NB1=NB(N)                                                         00045820
      DO 290 M=1,NB1                                                    00045830
      LCASE=LD(N,M)                                                     00045840
      IF(LCASE.EQ.0) GO TO 290                                          00045850
      DO 280 I=1,6                                                      00045860
  280 DNEW(I,N)=DNEW(I,N)+D(I,LCASE)*PCT(N,M)                           00045870
  290 CONTINUE                                                          00045880
  300 CONTINUE                                                          00045890
      WRITE(ITAPE1)DNEW                                                 00045900
  500 CONTINUE                                                          00045910
      RETURN                                                            00045920
      END                                                               00045930
      SUBROUTINE SPRIST   (IS1,IS2,SIG,SPR,NS)                          00252280
      IMPLICIT REAL*8(A-H,O-Z)                                          00252290
      REAL*8  IS1,IS2,NS                                                00252300
      DIMENSION SIG(12),SPR(6),IS(2),SG(6)                              00252310
      IS(1)=IS1                                                         00252320
      IS(2)=IS2                                                         00252330
      NNS=1                                                             00252340
      IF (NS.EQ.12) NNS=2                                               00252350
      DO 150 N=1,NNS                                                    00252360
      IN=3*N-3                                                          00252370
      II=IN*2                                                           00252380
      IF (IS(N).EQ.0) GO TO 100                                         00252390
      CC=(SIG(II+1)+SIG(II+2))/2.                                       00252400
      BB=(SIG(II+1)-SIG(II+2))/2.                                       00252410
      CR=                                                               00252420
     $   DSQRT(BB**2+SIG(II+4)**2)                                      00252430
      SPR(IN+1)=CC+CR                                                   00252440
      SPR(IN+2)=CC-CR                                                   00252450
      SPR(IN+3)=0.                                                      00252460
      IF (BB.NE.0.)SPR(IN+3)=28.648*                                    00252470
     $                              DATAN2(SIG(II+4),BB)                00252480
      GO TO 150                                                         00252490
  100 CC=(SIG(II+1)+SIG(II+2)+SIG(II+3))/3.                             00252500
      DO 110 I=1,3                                                      00252510
      SG(I)=SIG(II+I)-CC                                                00252520
  110 SG(I+3)=SIG(II+I+3)                                               00252530
      C2=(SG(1)**2+SG(2)**2+SG(3)**2)*.5+SG(4)**2+SG(5)**2+SG(6)**2     00252540
      C3=SG(1)*(SG(2)*SG(3)-SG(5)*SG(5))+SG(4)*(SG(5)*SG(6)-SG(4)*SG(3))00252550
     $+SG(6)*(SG(4)*SG(5)-SG(2)*SG(6))                                  00252560
      IF(C2.EQ.0.0D0) C2=1.0D-08                                        00252570
      T= DSQRT(C2/1.5)                                                  00252580
      A=C3*1.414214/T**3                                                00252590
      AXQ=A+1.0                                                         00252600
      IF(AXQ.GT.0.0.AND.AXQ.LT.2.0) A=DARCOS(A)/3.0                     00252610
      IF(AXQ.GE.2.0) A=0.0                                              00252620
      IF(AXQ.LE.0.0) A=1.0471976                                        00252630
      T=T*1.414214                                                      00252640
      SPR(IN+1)=T* DCOS(A)                                              00252650
      SPR(IN+2)=T* DCOS(A+2.0944)                                       00252660
      SPR(IN+3)=T* DCOS(A-2.0944)                                       00252670
      DO 120 I=2,3                                                      00252680
      IF (SPR(IN+1).GT.SPR(IN+I)) GO TO 120                             00252690
      C3=SPR(IN+1)                                                      00252700
      SPR(IN+1)=SPR(IN+I)                                               00252710
      SPR(IN+I)=C3                                                      00252720
  120 CONTINUE                                                          00252730
      IF (SPR(IN+2).LE.SPR(IN+3)) GO TO 130                             00252740
      C3=SPR(IN+2)                                                      00252750
      SPR(IN+2)=SPR(IN+3)                                               00252760
      SPR(IN+3)=C3                                                      00252770
  130 DO 140 I=1,3                                                      00252780
  140 SPR(IN+I)=SPR(IN+I)+CC                                            00252790
  150 CONTINUE                                                          00252800
      RETURN                                                            00252810
      END                                                               00252820
      SUBROUTINE WFFB                                                   00321880
      DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,  00321890
     1    R3,EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,00321900
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE,   00321910
     3    PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,C,S76, 00321920
     4    FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00321930
     5    DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS,  00321940
     6    BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ,   00321950
     7    XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I,     00321960
     8    XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,            00321970
     9    XINER2,XINER3                                                 00321980
      COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3,   00321990
     1    EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,   00322000
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,        00322010
     3    TYPE,PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,  00322020
     4    C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,   00322030
     5    B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,    00322040
     6    BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,  00322050
     7    XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,   00322060
     8    COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,     00322070
     9    XINER2,XINER3,ICT,KATX,KATY                                   00322080
      IF(ICT)10,10,20                                                   00322090
   10 DT257=640.0D0/SQFY                                                00322100
      GO TO 30                                                          00322110
   20 TEMP=XFA/FY                                                       00322120
      DT257=257.0D0/SQFY                                                00322130
      IF(TEMP.LE..16D0)DT257=640.0D0*(1.0D0-3.74D0*TEMP)/SQFY           00322140
   30 FB3=FY6                                                           00322150
      FB4=FY6                                                           00322160
      IF(BT.LE.BT65.AND.DT.LE.DT257.AND.FLG.LE.S20)FB3=.6666667D0*FY    00322170
      IF(BT.GT.BT65.AND.BT.LE.BT95.AND.DT.LE.DT257.AND.FLG.LE.S20)      00322180
     1    FB3=(.79D0-.002D0*BT*SQFY)*FY                                 00322190
      IF(RTL.GT.C102.AND.RTL.LE.C510)                                   00322200
     1    FB4=((2.0D0/3.0D0)-((FY*RTL*RTL)/1530000.0D0))*FY             00322210
      IF(RTL.GT.C510)FB4=(170000.0D0/(RTL*RTL))                         00322220
      FB5=12000.0D0/((FLG*DP)/(BF*TF))                                  00322230
      IF(FB4.LT.FB5)FB4=FB5                                             00322240
      IF(FB4.GT.FY6)FB4=FY6                                             00322250
      IF(FB4.LT.FY6)FB3=FB4                                             00322260
      IF(BT.GT.BT95)FB3=1.0D0                                           00322270
      RETURN                                                            00322280
      END                                                               00322290
                                                                        00322300
                                                                        00322310
      SUBROUTINE TUFB                                                   00317030
      DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,  00317040
     1    R3,EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,00317050
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE,   00317060
     3    PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,C,S76, 00317070
     4    FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00317080
     5    DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS,  00317090
     6    BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ,   00317100
     7    XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I,     00317110
     8    XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,            00317120
     9    XINER2,XINER3                                                 00317130
      COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3,   00317140
     1    EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,   00317150
     2    AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,        00317160
     3    TYPE,PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,  00317170
     4    C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,   00317180
     5    B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,    00317190
     6    BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,  00317200
     7    XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,   00317210
     8    COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC,     00317220
     9    XINER2,XINER3,ICT,KATX,KATY                                   00317230
      IF(ICT)10,10,20                                                   00317240
   10 DT257=640.0D0/SQFY                                                00317250
      GO TO 30                                                          00317260
   20 TEMP=XFA/FY                                                       00317270
      DT257=257.0D0/SQFY                                                00317280
      IF(TEMP.LE..16D0)DT257=640.0D0*(1.0D0-3.74D0*TEMP)/SQFY           00317290
   30 IF((DABS(XM3I).LE.DABS(XM3J)).AND.XM3J.NE.0.0D0)TEMP=XM3I/XM3J    00317300
      IF(DABS(XM3I).GT.DABS(XM3J))TEMP=XM3J/XM3I                        00317310
      IF(XM3I.EQ.0.0D0.OR.XM3J.EQ.0.0D0)TEMP=0.0D0                      00317320
      TEMP=1950.0D0+1200.0D0*TEMP                                       00317330
      IF(TEMP.LT.1200.0D0)TEMP=1200.0D0                                 00317340
      ST=TEMP*BF/FY                                                     00317350
      IF((DABS(XM2I).LE.DABS(XM2J)).AND.XM2J.NE.0.0D0)TEMP=XM2I/XM2J    00317360
      IF(DABS(XM2I).GT.DABS(XM2J))TEMP=XM2J/XM2I                        00317370
      IF(XM2I.EQ.0.0D0.OR.XM2J.EQ.0.0D0)TEMP=0.0D0                      00317380
      TEMP=1950.0D0+1200.0D0*TEMP                                       00317390
      IF(TEMP.LT.1200.0D0)TEMP=1200.0D0                                 00317400
      SS=TEMP*DP/FY                                                     00317410
      FB2=FY6                                                           00317420
      FB3=FY6                                                           00317430
      IF(BTT.LE.BT190.AND.DTT.LE.DT257.AND.FLG.LE.ST)FB3=.6666667D0*FY  00317440
      IF(BTS.LE.BT190.AND.DTS.LE.DT257.AND.FLG.LE.SS)FB2=.6666667D0*FY  00317450
      IF(BTT.GT.BT238)FB3=1.0D0                                         00317460
      IF(BTS.GT.BT238)FB2=1.0D0                                         00317470
      RETURN                                                            00317480
      END                                                               00317490
                                                                        00317500
                                                                        00317510
        FUNCTION DARCOS(X)                                              00051930
        IMPLICIT REAL*8(A-H,O-Z)                                        00051940
        IF(X.EQ.0.0)DARCOS=3.141592653589793/2.                         00051950
        IF(X.EQ.0.0)RETURN                                              00051960
        Y=DSQRT(1.-X*X)                                                 00051970
        Z=Y/X                                                           00051980
        DARCOS=DATAN(Z)                                                 00051990
        RETURN                                                          00052000
        END                                                             00052010
      SUBROUTINE USOL (A,B,MAXB,NEQB,MB,LL,NBLOCK,NSB,NORG,NBKS,NT1,    00318100
     $NT2,NRST,DIS)                                                     00318110
      IMPLICIT REAL*8(A-H,O-Z)                                          00318120
      REAL*8  MAXB                                                      00318130
      DIMENSION A(NSB),B(NSB),MAXB(NEQB)                                00318140
      DIMENSION ICOO(10),IFORM(4)                                       00318150
      COMMON /SQZ/ ISQZ,NRSQZ(5)                                        R0318160
      COMMON /GPS/ NEQ4(10),NRGPS(10)                                   R0318170
      DIMENSION DIS(10,LL)                                              00318180
      DATA ICOO /3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097, 00318190
     $           3H109/                                                 00318200
      DATA IFORM(1),IFORM(3),IFORM(4)/4H(1H+,4HX,F7,4H.2) /             00318210
        CALL FILES(11)                                                  00318220
      NSBE=NEQB+NSB                                                     00318230
      NC=MB+LL                                                          00318240
      NBR=(MB-1)/NEQB+1                                                 00318250
      INC=NEQB-1                                                        00318260
      NMB=NEQB*MB                                                       00318270
      NMB2=NMB*2/10                                                     00318280
      ZER=0.0D0                                                         00318290
      NGP=0                                                             00318300
      DO 100 I=1,10                                                     00318310
      IF(NEQ4(I).GT.0) NGP=I                                            00318320
  100 CONTINUE                                                          00318330
      N2=NT2                                                            00318340
      N1=NT1                                                            00318350
      CALL RDWRT(NORG,A,1,6,INUM)                                       00318360
      CALL RDWRT(NBKS,A,1,6,INUM)                                       00318370
      WRITE(6,105)                                                      00318380
  105 FORMAT(1H1)                                                       00318390
      WRITE(6,106)                                                      00318400
  106 FORMAT(//10X,49HTHE LAST NUMBER PRINTED IS THE PERCENT OF THE FOR,00318410
     $             39HWARD REDUCTION THAT HAS BEEN COMPLETED.//)        00318420
      ICO=1                                                             00318430
      DO 290 N=1,NBLOCK                                                 00318440
      KOD=0                                                             00318450
      NSUM=0                                                            00318460
      IF (N.GT.1.AND.NBR.EQ.1) GO TO 120                                00318470
      IF (NBR.EQ.1) GO TO 110                                           00318480
      CALL RDWRT(N1  ,A,1,6,INUM)                                       00318490
      CALL RDWRT(N2  ,A,1,6,INUM)                                       00318500
  110 NI=N1                                                             00318510
      IF(N.EQ.1) NI=NORG                                                00318520
      CALL EXPAND(A,NSB ,NI)                                            00318530
  120 DO 210 I=1,NEQB                                                   00318540
      MAXB(I)=0                                                         00318550
      D=A(I)                                                            00318560
      IF(D) 130,210,150                                                 00318570
  130 M=NEQB*(N-1)+I                                                    00318580
      WRITE (6,140) M,D                                                 00318590
  140 FORMAT (33H0SET OF EQUATIONS MAY BE SINGULAR   /                  00318600
     $  26H DIAGONAL TERM OF EQUATION,  I8, 8H  EQUALS,  1PE12.4)       00318610
      WRITE(6,106)                                                      00318620
      ICO=1                                                             00318630
  150 II=I                                                              00318640
      D=1.0/D                                                           00318650
      NCM1=NC-1                                                         00318660
      CALL QVMPY1(A(I+NEQB),A(I+NEQB),D,NCM1,NEQB,NEQB,0)               00318670
      K=NMB+I                                                           00318680
      DO 170 J=1,MB                                                     00318690
      NJ=J                                                              00318700
      K=K-NEQB                                                          00318710
      IF(A(K).NE.0.0) GO TO 180                                         00318720
  170 CONTINUE                                                          00318730
  180 MAXB(I)=K                                                         00318740
      NSUM=NSUM+NJ                                                      00318750
      IF(I.EQ.NEQB.AND.NSUM.LT.NMB2) KOD=1                              00318760
      JL=I+1                                                            00318770
      IF (JL.GT.NEQB) GO TO 210                                         00318780
      II=I                                                              00318790
      DO 200 J=JL,NEQB                                                  00318800
      II=II+NEQB                                                        00318810
      IF(II.GT.NMB) GO TO 200                                           00318820
      C=A(II)                                                           00318830
      IF (C.EQ.0.0) GO TO 200                                           00318840
      C=C*A(I)                                                          00318850
      KK=J-II                                                           00318860
      MAX=MAXB(I)                                                       00318870
      CALL QMR2(A(J),A(J),C,A(II),(MAX-II)/NEQB+1,NEQB,NEQB,NEQB)       00318880
      KK=J +NMB                                                         00318890
      JJ=I+NMB                                                          00318900
      DO 190 L=1,LL                                                     00318910
      A(KK)=A(KK)-C*A(JJ)                                               00318920
      KK=KK+NEQB                                                        00318930
  190 JJ=JJ+NEQB                                                        00318940
  200 CONTINUE                                                          00318950
  210 CONTINUE                                                          00318960
      IF(N.EQ.NBLOCK) CALL SQEEZE(A,NSBE,NBKS,KOD)                      00318970
      IF(N.EQ.NBLOCK) GO TO 270                                         00318980
      DO 260 NN=1,NBR                                                   00318990
      IF(N+NN.GT.NBLOCK) GO TO 260                                      00319000
      NI=N1                                                             00319010
      IF(N.EQ.1) NI=NORG                                                00319020
      IF(NN.EQ.NBR) NI=NORG                                             00319030
      CALL EXPAND(B,NSB,NI)                                             00319040
      IL=1+NN*NEQB*NEQB                                                 00319050
      DO 240 I=1,NEQB                                                   00319060
      II=IL                                                             00319070
      DO 230 K=1,NEQB                                                   00319080
      IF (II.GT.NMB) GO TO 230                                          00319090
      C=A(II)                                                           00319100
      IF (C.EQ.0.0) GO TO 230                                           00319110
      C=C*A(K)                                                          00319120
      MAX=MAXB(K)                                                       00319130
      KK=I-II                                                           00319140
      CALL QMR2(B(I),B(I),C,A(II),(MAX-II)/NEQB+1,NEQB,NEQB,NEQB)       00319150
      KK=I+NMB                                                          00319160
      JJ=K+NMB                                                          00319170
      DO 220 L=1,LL                                                     00319180
      B(KK)=B(KK)-C*A(JJ)                                               00319190
      KK=KK+NEQB                                                        00319200
  220 JJ=JJ+NEQB                                                        00319210
  230 II=II-INC                                                         00319220
  240 IL=IL+NEQB                                                        00319230
      IF(NBR.NE.1) GO TO 250                                            00319240
      CALL SQEEZE(A,NSBE,NBKS,KOD)                                      00319250
      CALL MEMOVE (B(1),A(1),NSB)                                       00319260
      GO TO 260                                                         00319270
  250 CALL SQEEZE(B,NSB,N2,ISQZ)                                        00319280
  260 CONTINUE                                                          00319290
      IF(NBR.NE.1.OR.NBLOCK.EQ.1) CALL SQEEZE(A,NSBE,NBKS,KOD)          00319300
  270 CONTINUE                                                          00319310
      PER=N*100.0/NBLOCK                                                00319320
      IFORM(2) = ICOO(ICO)                                              00319330
      WRITE (6,IFORM) PER                                               00319340
      ICO=ICO+1                                                         00319350
      IF(ICO.LT.11) GO TO 285                                           00319360
      WRITE(6,284)                                                      00319370
  284 FORMAT(1H )                                                       00319380
      ICO=1                                                             00319390
  285 CONTINUE                                                          00319400
      M=N1                                                              00319410
      N1=N2                                                             00319420
  290 N2=M                                                              00319430
      LS=LL*NEQB                                                        00319440
      NEB=NEQB*(NBR+1)                                                  00319450
      NUM=NBR*NEQB                                                      00319460
      MAX=NEB*LL                                                        00319470
      CALL MEMSET (ZER,B(1),MAX)                                        00319480
      CALL RDWRT(NRST,A,1,6,INUM)                                       00319490
      WRITE(6,105)                                                      00319500
      WRITE(6,295)                                                      00319510
  295 FORMAT(//10X,49HTHE LAST NUMBER PRINTED IS THE PERCENT OF THE BAC,00319520
     $             39HK SUBSTITUTION THAT HAS BEEN COMPLETED.//)        00319530
      ICO=1                                                             00319540
      DO 380 N=1,NBLOCK                                                 00319550
      NEQT=(NBLOCK-N  )*NEQB                                            00319560
      CALL RDWRT(NBKS,A,1,2,INUM)                                       00319570
      CALL EXPAND(A,NSBE,NBKS)                                          00319580
      CALL RDWRT(NBKS,A,1,2,INUM)                                       00319590
      DO 300 L=1,LL                                                     00319600
      K=L*NEB                                                           00319610
      DO 300 J=1,NUM                                                    00319620
      I=K-NEQB                                                          00319630
      B(K)=B(I)                                                         00319640
  300 K=K-1                                                             00319650
      I=NMB+1                                                           00319660
      DO 310 L=1,LL                                                     00319670
      K=(L-1)*NEB+1                                                     00319680
      CALL MEMOVE (A(I),B(K),NEQB)                                      00319690
  310 I=I+NEQB                                                          00319700
      DO 350 I=1,NEQB                                                   00319710
      J=NEQB+1-I                                                        00319720
      MAX=MAXB(J)                                                       00319730
      IF (A(J).EQ.0.) GO TO 350                                         00319740
      KGP=0                                                             00319750
      IF(NGP.EQ.0) GO TO 330                                            00319760
      NEN=NEQT+J                                                        00319770
      DO 320 IG=1,NGP                                                   00319780
      IF(NEN.EQ.NEQ4(IG)) KGP=IG                                        00319790
  320 CONTINUE                                                          00319800
  330 CONTINUE                                                          00319810
      DO 340 L=1,LL                                                     00319820
      KK=J+(L-1)*NEB                                                    00319830
      JJ=KK+1                                                           00319840
      IL=J+NEQB                                                         00319850
      C=B(KK)                                                           00319860
      NTER=(MAX-IL)/NEQB+1                                              00319870
      IF( NTER.LE.0) GO TO 340                                          00319880
      CONST=C                                                           00319890
      CALL QVDOT(C,A(IL),B(JJ),NTER,NEQB,1)                             00319900
      C=CONST-C                                                         00319910
      B(KK)=C                                                           00319920
      IF(KGP.GT.0) DIS(KGP,L)=C                                         00319930
  340 CONTINUE                                                          00319940
  350 CONTINUE                                                          00319950
      I=1                                                               00319960
      DO 360 L=1,LL                                                     00319970
      K=(L-1)*NEB+1                                                     00319980
      CALL MEMOVE (B(K),A(I),NEQB)                                      00319990
  360 I=I+NEQB                                                          00320000
      CALL RDWRT(NRST,A,LS,13,K)                                        00320010
      PER=N*100.0/NBLOCK                                                00320020
      IFORM(2) = ICOO(ICO)                                              00320030
      WRITE (6,IFORM) PER                                               00320040
      ICO=ICO+1                                                         00320050
      IF(ICO.LT.11) GO TO 380                                           00320060
      WRITE(6,284)                                                      00320070
      ICO=1                                                             00320080
  380 CONTINUE                                                          00320090
      WRITE(6,390)                                                      00320100
  390 FORMAT(////20X,40(1H*)/20X,40HGAUSSIAN ELIMINATION HAS BEEN COMPLE00320110
     $TED./20X,40(1H*))                                                 00320120
      RETURN                                                            00320130
      END                                                               00320140
      SUBROUTINE QVMPY1(A,B,C,N,INCA,INCB,INCC)                         00194240
      IMPLICIT REAL*8(A-H,O-Z)                                          00194250
      DIMENSION A(1),B(1)                                               00194260
      JA=1                                                              00194270
      JB=1                                                              00194280
      DO 100 I=1,N                                                      00194290
      A(JA)=B(JB)*C                                                     00194300
      JA=JA+INCA                                                        00194310
  100 JB=JB+INCB                                                        00194320
      RETURN                                                            00194330
      END                                                               00194340
      SUBROUTINE MEMOVE (IFROM,ITO,NWDS)                                00135690
      REAL*8 IFROM, ITO                                                 00135700
      DIMENSION IFROM(1),ITO(1)                                         00135710
      DO 100 I=1,NWDS                                                   00135720
  100 ITO(I)=IFROM(I)                                                   00135730
      RETURN                                                            00135740
      END                                                               00135750
      FUNCTION GETWRD(GET001)                                           00105400
      INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW           00105410
      LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD,IGET,RGET,ERR1             00105420
      COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,                       00105430
     1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,                            00105440
     2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT                      00105450
      GETWRD = .FALSE.                                                  00105460
      LENGTH = 0                                                        00105470
      IF (EOL) RETURN                                                   00105480
      DO 100 BEGIN = POINT,80                                           00105490
      IF (LINE(BEGIN).NE.BLANK) GO TO 110                               00105500
100   CONTINUE                                                          00105510
      EOL = .TRUE.                                                      00105520
      POINT = 80                                                        00105530
      RETURN                                                            00105540
110   DO 170 POINT = BEGIN,80                                           00105550
      IF (LINE(POINT).EQ.BLANK.OR.LINE(POINT).EQ.ICOMMA)                00105560
     1GO TO 180                                                         00105570
      LENGTH = POINT - BEGIN + 1                                        00105580
      MAXSTR = LENGTH                                                   00105590
170   CONTINUE                                                          00105600
      GETWRD = .TRUE.                                                   00105610
      EOL = .TRUE.                                                      00105620
      RETURN                                                            00105630
180   IP = POINT                                                        00105640
      DO 200 POINT = POINT,80                                           00105650
      IF (LINE(POINT).EQ.ICOMMA) GO TO 210                              00105660
      IF (LINE(POINT).NE.BLANK) GO TO 190                               00105670
200   CONTINUE                                                          00105680
      GETWRD = .TRUE.                                                   00105690
      EOL =.TRUE.                                                       00105700
      RETURN                                                            00105710
190   POINT = IP                                                        00105720
      GETWRD = .TRUE.                                                   00105730
      RETURN                                                            00105740
210   POINT = POINT + 1                                                 00105750
      GETWRD = .TRUE.                                                   00105760
      RETURN                                                            00105770
      END                                                               00105780
