      SUBROUTINE SIXBY6(                                                00237090
     $ID,PROP1,PROP2,PROP3,PROP4,PROP5,PROP6,PROP7,LM,S,P,XM,SA,TT,TEMPD00237100
     $,KK1,KK2,KK3,KK4,KK5,KK6,KK7,IX,NEL,NUMNP,NDMX,NSMX,MXDF,PROP9,KK900237110
     $)                                                                 00237120
      IMPLICIT REAL*8(A-H,O-Z)                                          00237130
      REAL*8    LM,ID                                                   00237140
      DIMENSION LM(MXDF),S(MXDF,MXDF),SA(NSMX,MXDF),ID(NUMNP,1),PROP9(KK00237150
     $9,21),IX(1)                                                       00237160
      COMMON /PREP/ XZ(2),KSKIP,RRPREP(8)                               R0237170
      COMMON /QTSARG/ T(3,3),STIF(6,6),X(4,3),Y1,Y2,X1,X2,Z1,Z2,S1,S2,  R0237180
     $ XX,AX,AY,AZ,I,J,K,MA,MB,LA,LB,JM,IL,NRQTSA(1853)                 R0237190
      COMMON /ELPAR/ZPAR(14),NZP,MBAND,RRELPA(28)                       R0237200
      NS=6                                                              00237210
      ND=6                                                              00237220
      DO 100 I=1,4                                                      00237230
      IF(IX(I).GE.0.AND.IX(I).LE.NUMNP) GO TO 100                       00237240
      KSKIP=1                                                           00237250
      WRITE(6,110)IX(I)                                                 00237260
  100 CONTINUE                                                          00237270
  110 FORMAT (20X,6H NODE ,I6,17H IS OUT OF RANGE.)                     00237280
      IF(KSKIP.EQ.1) RETURN                                             00237290
      DO 120 I=1,4                                                      00237300
      NX=IX(I)                                                          00237310
      IF(NX.EQ.0) GO TO 120                                             00237320
      DO 115 J=1,3                                                      00237330
  115 CALL UNPKID(ID,NUMNP,WX,X(I,J),1,NX,J)                            00237340
  120 CONTINUE                                                          00237350
      MAT=IX(9)                                                         00237360
      IF(MAT.GT.0.AND.MAT.LE.KK9) GO TO 140                             00237370
      KSKIP=1                                                           00237380
      WRITE(6,130)NEL                                                   00237390
  130 FORMAT(///42H A MATRIX COULD NOT BE LOCATED FOR ELEMENT,I6//)     00237400
  140 KK=0                                                              00237410
      DO 150 I=1,6                                                      00237420
      DO 150 J=I,6                                                      00237430
      KK=KK+1                                                           00237440
      STIF(I,J)=PROP9(MAT,KK)                                           00237450
  150 STIF(J,I)=STIF(I,J)                                               00237460
      DO 160 I=1,6                                                      00237470
  160 CALL UNPKID(ID,NUMNP,LM(I),WX,2,IX(1),I)                          00237480
      DO 170 I=1,3                                                      00237490
      DO 170 J=1,3                                                      00237500
      T(I,J)=0.0                                                        00237510
  170 T(I,I)=1.0                                                        00237520
      IF(IX(2).EQ.0) GO TO 180                                          00237530
      X1=X(3,1)-X(2,1)                                                  00237540
      Y1=X(3,2)-X(2,2)                                                  00237550
      Z1=X(3,3)-X(2,3)                                                  00237560
      X2=X(4,1)-X(2,1)                                                  00237570
      Y2=X(4,2)-X(2,2)                                                  00237580
      Z2=X(4,3)-X(2,3)                                                  00237590
      S1=X1*X1+Y1*Y1+Z1*Z1                                              00237600
      S1= DSQRT(S1)                                                     00237610
      X1=X1/S1                                                          00237620
      Y1=Y1/S1                                                          00237630
      Z1=Z1/S1                                                          00237640
      T(1,1)=X1                                                         00237650
      T(1,2)=Y1                                                         00237660
      T(1,3)=Z1                                                         00237670
      AA=X1*X1+Y1*Y1+Z1*Z1                                              00237680
      AB=X1*X2+Y1*Y2+Z1*Z2                                              00237690
      U1=AA*X2-AB*X1                                                    00237700
      U2=AA*Y2-AB*Y1                                                    00237710
      U3=AA*Z2-AB*Z1                                                    00237720
      UU=U1*U1+U2*U2+U3*U3                                              00237730
      UU= DSQRT(UU)                                                     00237740
      T(2,1)=U1/UU                                                      00237750
      T(2,2)=U2/UU                                                      00237760
      T(2,3)=U3/UU                                                      00237770
      T(3,1)=T(1,2)*T(2,3)-T(1,3)*T(2,2)                                00237780
      T(3,2)=T(1,3)*T(2,1)-T(1,1)*T(2,3)                                00237790
      T(3,3)=T(1,1)*T(2,2)-T(1,2)*T(2,1)                                00237800
  180 CONTINUE                                                          00237810
      DO 200 LA=1,4,3                                                   00237820
      LB=LA+2                                                           00237830
      DO 200 MA=1,4,3                                                   00237840
      MB=MA-1                                                           00237850
      DO 200 I=LA,LB                                                    00237860
      DO 200 JM=1,3                                                     00237870
      J=JM+MB                                                           00237880
      XX=0.0                                                            00237890
      DO 190 K=1,3                                                      00237900
      KMB= K+MB                                                         00237910
      XXS=STIF(I,KMB)*T(K,JM)                                           00237920
  190 XX=XX+XXS                                                         00237930
  200 SA(I,J)=XX                                                        00237940
      DO 220 LA=1,4,3                                                   00237950
      LB=LA-1                                                           00237960
      DO 220 MA=1,4,3                                                   00237970
      MB=MA+2                                                           00237980
      DO 220 IL=1,3                                                     00237990
      I=IL+LB                                                           00238000
      DO 220 J=MA,MB                                                    00238010
      XX=0.0                                                            00238020
      DO 210 K=1,3                                                      00238030
      KLB=K+LB                                                          00238040
      XXS=T(K,IL)*SA(KLB,J)                                             00238050
  210 XX=XX+XXS                                                         00238060
  220 S(I,J)=XX                                                         00238070
      CALL WRITET(MBAND,NDIF,14,ND,NS,LM,SA)                            00238080
      RETURN                                                            00238090
      END                                                               00238100
      SUBROUTINE GESTEL(ID,LM,S,P                                       00104820
     &,XM,SA,TT,TEMPD,KK1,KK2,KK3,KK4,KK5,KK6,KK7,IX,IA,NEL             00104830
     &,NUMNP,NDMX,NSMX,MXDF,P10,KK10,KK10A)                             00104840
      IMPLICIT REAL*8 (A-H,O-Z)                                         00104850
      REAL*8 LM,ID                                                      00104860
      DIMENSION LM(MXDF),S(MXDF,MXDF),IX(9)                             00104870
     &,SA(NSMX,MXDF),ID(NUMNP,1),P10(1177,KK10A)                        00104880
      COMMON /PREP/ XZ(2),KSKIP,NDYN,I1,RRPREP(7)                       R0104890
      COMMON /ELPAR/ZPAR(14),NZP,MBAND,RRELPA(28)                       R0104900
      NODS=0                                                            00104910
      DO 10 I=1,8                                                       00104920
      IF(IX(I).GT.0)GO TO 9                                             00104930
      GO TO 11                                                          00104940
    9 IF(IX(I).LE.NUMNP)GO TO 10                                        00104950
      KSKIP=1                                                           00104960
      WRITE(6,1000)IX(I)                                                00104970
   10 NODS=NODS+1                                                       00104980
   11 CONTINUE                                                          00104990
      IF(NODS.EQ.0)WRITE(6,1002)IX(9)                                   00105000
      IF(NODS.EQ.0)KSKIP=1                                              00105010
      IF(KSKIP.EQ.1)RETURN                                              00105020
      MTYPE=IX(9)                                                       00105030
      IF(MTYPE.LE.KK10)GO TO 12                                         00105040
      KSKIP=1                                                           00105050
      WRITE(6,1001)NEL                                                  00105060
      RETURN                                                            00105070
   12 CONTINUE                                                          00105080
      ND=6*NODS                                                         00105090
      M1=0                                                              00105100
      DO 20 I=1,ND                                                      00105110
      DO 20 J=I,ND                                                      00105120
      M1=M1+1                                                           00105130
      S(I,J)=P10(M1,MTYPE)                                              00105140
      S(J,I)=S(I,J)                                                     00105150
   20 CONTINUE                                                          00105160
      MATYP=P10(1177,MTYPE)                                             00105170
      IF(MATYP.EQ.0)GO TO 200                                           00105180
  200 CONTINUE                                                          00105190
      DO 300 I=1,NSMX                                                   00105200
      DO 300 J=1,MXDF                                                   00105210
  300 SA(I,J)=0.                                                        00105220
        K=0                                                             00105230
        DO 310 J=1,NODS                                                 00105240
      DO 310 I=1,6                                                      00105250
        K=K+1                                                           00105260
      CALL UNPKID(ID,NUMNP,LM(K),DX,2,IX(J),I)                          00105270
  310 CONTINUE                                                          00105280
      NS=6                                                              00105290
      NELTYP=15                                                         00105300
      CALL WRITET(MBAND,NDIF,NELTYP,ND,NS,LM,SA)                        00105310
      RETURN                                                            00105320
 1000 FORMAT(20X,26H  ERROR IN ELEMENT TYPE 15/                         00105330
     &20X,5H NODE,I5,16H IS OUT OF RANGE)                               00105340
 1001 FORMAT(40H  FATAL ERROR.  THE STIFFNESS MATRIX FOR,               00105350
     &8H ELEMENT,I5,15H DOES NOT EXIST)                                 00105360
 1002 FORMAT(47H  FATAL ERROR. NO NODES HAVE BEEN SPECIFIED FOR,        00105370
     &8H ELEMENT,I5)                                                    00105380
      END                                                               00105390
      FUNCTION GETWRD(GET001)                                           00105400
      INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW           00105410
      LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD,IGET,RGET,ERR1             00105420
      COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,                       00105430
     1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,                            00105440
     2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT                      00105450
      GETWRD = .FALSE.                                                  00105460
      LENGTH = 0                                                        00105470
      IF (EOL) RETURN                                                   00105480
      DO 100 BEGIN = POINT,80                                           00105490
      IF (LINE(BEGIN).NE.BLANK) GO TO 110                               00105500
100   CONTINUE                                                          00105510
      EOL = .TRUE.                                                      00105520
      POINT = 80                                                        00105530
      RETURN                                                            00105540
110   DO 170 POINT = BEGIN,80                                           00105550
      IF (LINE(POINT).EQ.BLANK.OR.LINE(POINT).EQ.ICOMMA)                00105560
     1GO TO 180                                                         00105570
      LENGTH = POINT - BEGIN + 1                                        00105580
      MAXSTR = LENGTH                                                   00105590
170   CONTINUE                                                          00105600
      GETWRD = .TRUE.                                                   00105610
      EOL = .TRUE.                                                      00105620
      RETURN                                                            00105630
180   IP = POINT                                                        00105640
      DO 200 POINT = POINT,80                                           00105650
      IF (LINE(POINT).EQ.ICOMMA) GO TO 210                              00105660
      IF (LINE(POINT).NE.BLANK) GO TO 190                               00105670
200   CONTINUE                                                          00105680
      GETWRD = .TRUE.                                                   00105690
      EOL =.TRUE.                                                       00105700
      RETURN                                                            00105710
190   POINT = IP                                                        00105720
      GETWRD = .TRUE.                                                   00105730
      RETURN                                                            00105740
210   POINT = POINT + 1                                                 00105750
      GETWRD = .TRUE.                                                   00105760
      RETURN                                                            00105770
      END                                                               00105780
      SUBROUTINE CLAMP(                                                 00040000
     $ID,PROP1,PROP2,PROP3,PROP4,PROP5,PROP6,PROP7,LM,S,P,XM,SA,TT,TEMPD00040010
     $,KK1,KK2,KK3,KK4,KK5,KK6,KK7,IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF)      00040020
      IMPLICIT REAL*8(A-H,O-Z)                                          00040030
      REAL*8  LM                                                        00040040
      REAL*8  ID                                                        00040050
      REAL*8  NPAR                                                      00040060
      LOGICAL ELPRT,ELPCH,GENPRT,GENPCH                                 00040070
      COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH                              00040080
      COMMON /ELPAR/ NPAR(14),NUMNN,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00040090
     $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN                00040100
      DIMENSION LM(MXDF),S(MXDF,MXDF),P(MXDF,KK6), XM(MXDF)             00040110
      DIMENSION SA(NSMX,MXDF),TT(NSMX,KK6)                              00040120
      DIMENSION ID(NUMNP,1),PROP6(KK6,7)                                00040130
      COMMON / MISC / NBLOCK,NEQB,LL,NF,LB                              00040140
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7)                       R0040150
      COMMON/JUNK/R(6),X(5,3),N(5),I,Z(5),Y(3),RRJUNK(195)              R0040160
      NS=2                                                              00040170
      ND=6                                                              00040180
      DO 210 MMM=1,NUMEL2                                               00040190
      ZER=0.0D0                                                         00040200
      CALL MEMSET (ZER,LM(1),NEMN)                                      00040210
      READ (8) Z,SC,Y                                                   00040220
      DO 100 I=1,5                                                      00040230
  100 N(I)= Z(I)                                                        00040240
      IF(N(3).EQ.0) N(3)=N(1)                                           00040250
      SD=Y(1)                                                           00040260
      SR=Y(2)                                                           00040270
      TRACE= Y(3)                                                       00040280
      IF (TRACE.LT.0.1)TRACE=1.0E+10                                    00040290
      KD=0                                                              00040300
      KR=0                                                              00040310
      IF(SC.GE.10) KD=1                                                 00040320
      IF(SC.EQ.1.0.OR.SC.EQ.11.0) KR=1                                  00040330
      DO 115 I=1,5                                                      00040340
      NX=N(I)                                                           00040350
      IF(NX.EQ.0) GO TO 115                                             00040360
      DO 110 J=1,3                                                      00040370
      CALL UNPKID ( ID  ,NUMNP,W      ,X(I,J)  ,1,NX,J)                 00040380
  110 CONTINUE                                                          00040390
  115 CONTINUE                                                          00040400
      IF(N(4).EQ.0) GO TO 120                                           00040410
      X1=X(3,1)-X(2,1)                                                  00040420
      Y1=X(3,2)-X(2,2)                                                  00040430
      Z1=X(3,3)-X(2,3)                                                  00040440
      X2=X(5,1)-X(4,1)                                                  00040450
      Y2=X(5,2)-X(4,2)                                                  00040460
      Z2=X(5,3)-X(4,3)                                                  00040470
      T1=Y1*Z2-Y2*Z1                                                    00040480
      T2=Z1*X2-Z2*X1                                                    00040490
      T3=X1*Y2-X2*Y1                                                    00040500
      GO TO 130                                                         00040510
  120 T1=X(3,1)-X(2,1)                                                  00040520
      T2=X(3,2)-X(2,2)                                                  00040530
      T3=X(3,3)-X(2,3)                                                  00040540
  130 XL=T1*T1+T2*T2+T3*T3                                              00040550
      XL= DSQRT(XL)                                                     00040560
      T1=T1/XL                                                          00040570
      T2=T2/XL                                                          00040580
      T3=T3/XL                                                          00040590
      IF (KD.EQ.0) GO TO 140                                            00040600
      SA(1,1)=T1*TRACE                                                  00040610
      SA(1,2)=T2*TRACE                                                  00040620
      SA(1,3)=T3*TRACE                                                  00040630
      S(1,1)=T1*T1*TRACE                                                00040640
      S(1,2)=T1*T2*TRACE                                                00040650
      S(1,3)=T1*T3*TRACE                                                00040660
      S(2,2)=T2*T2*TRACE                                                00040670
      S(2,3)=T2*T3*TRACE                                                00040680
      S(3,3)=T3*T3*TRACE                                                00040690
      PP=TRACE*SD                                                       00040700
      R(1)=T1*PP                                                        00040710
      R(2)=T2*PP                                                        00040720
      R(3)=T3*PP                                                        00040730
        DO 135 J=1,LL                                                   00040740
135     TT(1,J)=-PP*PROP6(J,4)                                          00040750
      GO TO 150                                                         00040760
  140 S(1,1)=0.                                                         00040770
      S(1,2)=0.                                                         00040780
      S(1,3)=0.                                                         00040790
      S(2,2)=0.                                                         00040800
      S(2,3)=0.                                                         00040810
      S(3,3)=0.                                                         00040820
      SA(1,1)=0.                                                        00040830
      SA(1,2)=0.                                                        00040840
      SA(1,3)=0.                                                        00040850
      R(1)=0.                                                           00040860
      R(2)=0.                                                           00040870
      R(3)=0.                                                           00040880
  150 IF (KR.EQ.0) GO TO 160                                            00040890
      SA(2,4)=T1*TRACE                                                  00040900
      SA(2,5)=T2*TRACE                                                  00040910
      SA(2,6)=T3*TRACE                                                  00040920
      S(4,4)=T1*T1*TRACE                                                00040930
      S(4,5)=T1*T2*TRACE                                                00040940
      S(4,6)=T1*T3*TRACE                                                00040950
      S(5,5)=T2*T2*TRACE                                                00040960
      S(5,6)=T2*T3*TRACE                                                00040970
      S(6,6)=T3*T3*TRACE                                                00040980
      PP=TRACE*SR                                                       00040990
      R(4)=T1*PP                                                        00041000
      R(5)=T2*PP                                                        00041010
      R(6)=T3*PP                                                        00041020
        DO 155 J=1,LL                                                   00041030
155     TT(2,J)=-PP*PROP6(J,4)                                          00041040
      GO TO 170                                                         00041050
  160 S(4,4)=0.                                                         00041060
      S(4,5)=0.                                                         00041070
      S(4,6)=0.                                                         00041080
      S(5,5)=0.                                                         00041090
      S(5,6)=0.                                                         00041100
      S(6,6)=0.                                                         00041110
      SA(2,4)=0.                                                        00041120
      SA(2,5)=0.                                                        00041130
      SA(2,6)=0.                                                        00041140
      R(4)=0.                                                           00041150
      R(5)=0.                                                           00041160
      R(6)=0.                                                           00041170
  170 DO 180 I=2,6                                                      00041180
      IM1=I-1                                                           00041190
      DO 180 J=1,IM1                                                    00041200
  180 S(I,J)=S(J,I)                                                     00041210
      DO 190 I=1,6                                                      00041220
      DO 190 J=1,LL                                                     00041230
  190 P(I,J)=R(I)*PROP6(J,4)                                            00041240
      NN=N(1)                                                           00041250
      DO 200 I=1,6                                                      00041260
  200 CALL UNPKID ( ID  ,NUMNP,LM(I)  ,WX     ,2,NN,I)                  00041270
        TT(1,1)=TT(1,1)+N(1)/10000.                                     00041280
        TT(2,1)=TT(2,1)+N(1)/10000.                                     00041290
      IF(.NOT.ELPRT)  GO TO 1150                                        00041300
      IRAM=MMM+NUMEL                                                    00041310
      WRITE(6,1400)IRAM                                                 00041320
      IF(ELPCH) WRITE(7,1400) IRAM                                      00041330
 1150 CONTINUE                                                          00041340
      CALL WRITET(MBAND,NDIF,7,ND,NS,LM,SA)                             00041350
  210 CONTINUE                                                          00041360
      RETURN                                                            00041370
 1400 FORMAT(5X,17HELEMENT NUMBER = ,I5)                                00041380
      END                                                               00041390
