      SUBROUTINE THDFE(ID,PROP1,PROP2,PROP4,PROP5,PROP6,LM,             00301560
     $S,RF,XM,SA,SF,TEMPD,KK1,KK2,KK4,KK5,KK6,IX,IA,NEL,NUMNP,          00301570
     $NDMX,NSMX,MXDF,MMA)                                               00301580
      IMPLICIT REAL*8 (A-H,O-Z)                                         00301590
      REAL*8  ID,LM                                                     00301600
      REAL*8MODUE                                                       00301610
      COMMON A(1)                                                       00301620
      COMMON /JUNK/ IEL,NND9,NINT,NINTOP,ND,MEL,NOD9(12),RRJUNK(218)    R0301630
      COMMON /QTSARG/ D(6,6),P(3,20),YZ(60),H(20),TAU(3),               00301640
     $PROP(4),B(60   ),XJ(3,3),HP(60),UP(60),DE,DET,STR(6,60)           00301650
     &,FN(20,2),RRQTSA(226)                                             R0301660
      COMMON /ELTEMP/TAVG,RRELTE(102)                                   R0301670
      COMMON /CG/ SCG(4),RRCG(2)                                        R0301680
      COMMON /PREP/ XZ(2),KSKIP,NDYN,NRPREP(15)                         R0301690
      COMMON /AMB/ GRAV,REFT,JROT                                       00301710
      COMMON /ELPAR/ XPAR(14),NZQ,MBAND,NZD(8),N2P,N3P,NMRI,NTRI,N1P    00301720
     & ,NRELPA(43)                                                      R0301721
      COMMON/MASS/LMASS                                                 00301730
      COMMON /TRASH/ XX(7)                                              00301740
     $,ZQ(2),H8(8),LSW,KDM,STRS(6,60)                                   00301750
     $ ,W,I,J,L,II,I2,JJ,NC,NN,NR,NT,MAT,NDM,NPR,NRTRAS(209)            R0301770
      DIMENSION LM(MXDF),RF(MXDF,KK6),S(MXDF,MXDF),SA(NSMX,MXDF),       00301780
     $SF(NSMX,KK6),TEMPD(NDMX,KK6)                                      00301790
      DIMENSION PROP6(KK6,7),XM(MXDF,MMA),ITABLE(9)                     00301800
      DIMENSION PROP5(KK5,7)                                            00301810
      DIMENSION IX(13),ID(NUMNP,3),IA(20)                               00301820
      DIMENSION PRES(7)                                                 00301830
      DIMENSION EVAL( 9,3)                                              00301840
      DIMENSION TM(9,8)                                                 00301850
      DATA  EVAL / 1., 1.,-1.,-1., 1., 1.,-1.,-1., 0.,                  00301860
     $            -1., 1., 1.,-1.,-1., 1., 1.,-1., 0.,                  00301870
     $            -1.,-1.,-1.,-1., 1., 1., 1., 1., 0./                  00301880
      LL=KK6                                                            00301890
      MEL=NEL                                                           00301900
      DO 80 I=2,9                                                       00301910
   80 ITABLE(I)=I-1                                                     00301920
      ITABLE(1)=9                                                       00301930
      LSW=0                                                             00301940
      IF(IX(4).NE.IX(3).OR.IX(8).NE.IX(7)) GO TO 90                     00301950
      LSW=1                                                             00301960
      IA(11)=IX(3)                                                      00301970
      IA(15)=IX(7)                                                      00301980
      IA(20)=IA(19)                                                     00301990
      ITABLE(4)=5                                                       00302000
      ITABLE(5)=6                                                       00302010
   90 CONTINUE                                                          00302020
      II=0                                                              00302030
      DO 100 I=9,20                                                     00302040
      NN=IA(I)                                                          00302050
      IF(NN.EQ.0) GO TO 100                                             00302060
      II=II+1                                                           00302070
      NOD9(II)=I                                                        00302080
  100 CONTINUE                                                          00302090
      IEL=II+8                                                          00302100
      NND9=II                                                           00302110
  110 I2=0                                                              00302120
      DO 130 I=1,IEL                                                    00302130
      IF(I.LE.8) II=IX(I)                                               00302140
      IF(I.LE.8) GO TO 120                                              00302150
      JJ=NOD9(I-8)                                                      00302160
      II=IA(JJ)                                                         00302170
  120 I2=I2 + 3                                                         00302180
      CALL UNPKID(ID,NUMNP,LM(I2-2),W,2,II,1)                           00302190
      CALL UNPKID(ID,NUMNP,LM(I2-1),W,2,II,2)                           00302200
      CALL UNPKID(ID,NUMNP,LM(I2)  ,W,2,II,3)                           00302210
      CALL UNPKID(ID,NUMNP,W,YZ(I2-2),1,II,1)                           00302220
      CALL UNPKID(ID,NUMNP,W,YZ(I2-1),1,II,2)                           00302230
  130 CALL UNPKID(ID,NUMNP,W,YZ(I2)  ,1,II,3)                           00302240
        IF(JROT.EQ.0) GO TO 134                                         00302250
        I2=0                                                            00302260
        DO 132 I=1,IEL                                                  00302270
        I2=I2+3                                                         00302280
132     CALL CENT(YZ(I2-2),YZ(I2-1),FN(I,1),FN(I,2))                    00302290
134   CONTINUE                                                          00302300
      NS=54                                                             00302310
      IF(NND9.EQ.0) NS=6                                                00302320
      IF(LSW.LE.0) GO TO 135                                            00302330
      NS=30                                                             00302340
      LM(10)=0.                                                         00302350
      LM(11)=0.                                                         00302360
      LM(12)=0.                                                         00302370
      LM(22)=0.                                                         00302380
      LM(23)=0.                                                         00302390
      LM(24)=0.                                                         00302400
      LM(31)=0.                                                         00302410
      LM(32)=0.                                                         00302420
      LM(33)=0.                                                         00302430
      LM(43)=0.                                                         00302440
      LM(44)=0.                                                         00302450
      LM(45)=0.0                                                        00302460
      LM(58)=0.0                                                        00302470
      LM(59)=0.0                                                        00302480
      LM(60)=0.0                                                        00302490
  135 CONTINUE                                                          00302500
      MAT=IX(9)                                                         00302510
      IF(MAT.GT.18.AND.NTRI.EQ.0) WRITE(6,140)NEL                       00302520
      IF(MAT.GT.18.AND.NTRI.EQ.0) MAT=1                                 00302530
  140 FORMAT (//20X, 45HNO USER SUPPLIED MATERIALS ARE AVAIL. FOR EL.,I500302540
     $/)                                                                00302550
      IF(MAT.GT.18) GO TO 150                                           00302560
      PROP(1)= MODUE(TAVG,MAT)                                          00302570
      PROP(2)=PRATO (TAVG,MAT)                                          00302580
      PROP(3)=DENS(TAVG,MAT)/1728.0E0/GRAV                              00302590
      PROP(4)=ALPHZM(TAVG,MAT)                                          00302600
      GO TO 160                                                         00302610
  150 CALL MATEV(MAT,NMRI,NTRI,TAVG,PROP(1),PROP(2),PROP(4),PROP(3),    00302620
     $A(N1P),A(N2P),A(N3P),NEL)                                         00302630
      PROP(3)=PROP(3)/GRAV                                              00302640
  160 DE=PROP(3)                                                        00302650
      NINTOP=IX(12)                                                     00302660
      IF(NDYN.EQ.7) NINTOP=9                                            00302670
      NINT=3                                                            00302680
      IF(IEL.LE.8) NINT=2                                               00302690
      IF(NINTOP.GT.0.AND.NINTOP.LE.3) NINT=2                            00302700
      IF(NINTOP.GT.0.AND.NINTOP.LE.3) NINTOP=0                          00302710
      SQ3=1.0/SQRT(3.0)                                                 00302720
      IF(NINT.EQ.3) SQ3= SQRT(0.6)                                      00302730
      RS=1.0/SQ3                                                        00302740
      RSF=1.0                                                           00302750
      RSF2=0.0                                                          00302760
      IF(NINT.EQ.3) RSF=1.0/3.0                                         00302770
      IF(NINT.EQ.3) RSF2=4.0                                            00302780
      AS=(5.0+RSF2+(3.0+RSF2)*RS)*RSF*0.25                              00302790
      BS=-(RS+1.0)*RSF*0.25                                             00302800
      CS= (RS-1.0)*RSF*0.25                                             00302810
      DS=(5.0+RSF2-(3.0+RSF2)*RS)*RSF*0.25                              00302820
      DO 161 I=1,8                                                      00302830
      DO 161 J=1,8                                                      00302840
  161 TM(J,I)=BS                                                        00302850
      DO 162 I=1,8                                                      00302860
      J=9-I                                                             00302870
      TM(I,I)=AS                                                        00302880
  162 TM(J,I)=CS                                                        00302890
      DO 163 I=3,8                                                      00302900
      J=I-2                                                             00302910
      TM(I,J)=CS                                                        00302920
  163 TM(J,I)=CS                                                        00302930
      DO 164 I=1,3                                                      00302940
      J=I+5                                                             00302950
      TM(I,J)=CS                                                        00302960
      TM(J,I)=CS                                                        00302970
      K=I+1                                                             00302980
      J=K+3                                                             00302990
      TM(K,J)=CS                                                        00303000
  164 TM(J,K)=CS                                                        00303010
      DO 165 I=1,2                                                      00303020
      J=I+6                                                             00303030
      TM(I,J)=DS                                                        00303040
      TM(J,I)=DS                                                        00303050
      K=I+2                                                             00303060
      J=K+2                                                             00303070
      TM(J,K)=DS                                                        00303080
  165 TM(K,J)=DS                                                        00303090
      DO 166 K=1,8                                                      00303100
      I=10-K                                                            00303110
      L=I-1                                                             00303120
      DO 166 J=1,8                                                      00303130
  166 TM(I,J)=TM(L,J)                                                   00303140
      DO 167 I=1,8                                                      00303150
  167 TM(1,I)=0.125                                                     00303160
      IF(MAT.EQ.19.OR.MAT.EQ.20)  NINT=1                                00303170
      ND=3*IEL                                                          00303180
      CALL STIF60(S,RF,PROP6,LL,TEMPD,NDMX,MXDF,XM)                     00303190
      IF(KSKIP.EQ.1) RETURN                                             00303200
      IF(LMASS.NE.1) GO TO 1160                                         00303210
      DO 1140 I=1,ND                                                    00303220
 1140 XM(I,I)=XM(I,1)                                                   00303230
      DO 1150 I=1,ND                                                    00303240
      IRK=I+1                                                           00303250
      IF(IRK.GT.ND) GO TO 1150                                          00303260
      DO 1145 J=IRK,ND                                                  00303270
      XM(I,J)=0.0E0                                                     00303280
 1145 XM(J,I)=XM(I,J)                                                   00303290
 1150 CONTINUE                                                          00303300
 1160 CONTINUE                                                          00303310
      NT=(ND*ND-ND)/2+ND                                                00303320
      NDM=ND-1                                                          00303330
      DO 180 I=1,NDM                                                    00303340
      II=ND-I+1                                                         00303350
      L=ND+1                                                            00303360
      DO 180 J=II,ND                                                    00303370
      L=L-1                                                             00303380
      NR= MOD(NT,MXDF)                                                  00303390
      NC=NT/MXDF+1                                                      00303400
      IF(NR.GT.0) GO TO 170                                             00303410
      NR=MXDF                                                           00303420
      NC=NC-1                                                           00303430
  170 S(L,II)=S(NR,NC)                                                  00303440
  180 NT=NT-1                                                           00303450
      IF(NINT.EQ.1) NINT=3                                              00303460
      NPR=IX(11)                                                        00303470
        IF(IX(10).GT.1) NPR=IX(10)+99                                   00303480
      IF(NPR.LE.0) GO TO 240                                            00303490
      IF(NPR.LE.KK5) GO TO 200                                          00303500
      WRITE(6,190)NEL                                                   00303510
  190 FORMAT(//20X, 44HTHE PRESSURE TYPE DOES NOT EXIST FOR ELEMENT,I5/ 00303520
     $  20X, 21H EXECUTION WILL STOP.//)                                00303530
      KSKIP=1                                                           00303540
      RETURN                                                            00303550
  200 DO 210 I=1,7                                                      00303560
  210 PRES(I)=PROP5(NPR,I)                                              00303570
      CALL PLD60(PRES)                                                  00303580
      IF(KSKIP.EQ.1) RETURN                                             00303590
      DO 230 I=1,LL                                                     00303600
      PLF=PROP6(I,1)                                                    00303610
      PHF=1.0                                                           00303620
      IF(PLF.EQ.0.0) GO TO 230                                          00303630
      DO 220 J=1,ND                                                     00303640
  220 RF(J,I)=RF(J,I)+PLF*UP(J)+ PHF*HP(J)                              00303650
  230 CONTINUE                                                          00303660
  240 CONTINUE                                                          00303670
      KK=NS/6                                                           00303680
      DS=D(4,4)                                                         00303690
      DO 340 II=1,8                                                     00303700
      I6=6*II-3                                                         00303710
      I=ITABLE(II)                                                      00303720
      E1=EVAL(II,1)*SQ3                                                 00303730
      E2=EVAL(II,2)*SQ3                                                 00303740
      E3=EVAL(II,3)*SQ3                                                 00303750
      CALL DERIQ3(NEL,YZ,B,DET,E1,E2,E3,NOD9,1)                         00303760
      DO 250 I=1,ND                                                     00303770
      DO 250 J=1,6                                                      00303780
  250 STR(J,I)=0.0                                                      00303790
      DO 260 K=3,ND,3                                                   00303800
      K3=K                                                              00303810
      K2=K3-1                                                           00303820
      K1=K2-1                                                           00303830
      STR(1,K1)=B(K1)                                                   00303840
      STR(2,K2)=B(K2)                                                   00303850
      STR(3,K3)=B(K3)                                                   00303860
      STR(4,K1)=B(K2)                                                   00303870
      STR(4,K2)=B(K1)                                                   00303880
      STR(5,K2)=B(K3)                                                   00303890
      STR(5,K3)=B(K2)                                                   00303900
      STR(6,K1)=B(K3)                                                   00303910
  260 STR(6,K3)=B(K1)                                                   00303920
      DO 280 I=1,3                                                      00303930
      IM=I+3                                                            00303940
      DO 280 J=1,ND                                                     00303950
      SP=0.0                                                            00303960
      DO 270 L7=1,3                                                     00303970
  270 SP=SP+D(I,L7)*STR(L7,J)                                           00303980
      STRS(I,J)=SP                                                      00303990
  280 STRS(IM,J)=DS*STR(IM,J)                                           00304000
      DO 330 L=1,LL                                                     00304010
      TOPT=PROP6(L,2)                                                   00304020
      IF(TOPT.EQ.0) GO TO 330                                           00304030
      IF(TOPT.EQ.2) TEMP=PROP6(L,3)                                     00304040
      IF(TOPT.NE.1) GO TO 310                                           00304050
      TEMP=0.0                                                          00304060
      KL=8                                                              00304070
      DO 290 K=1,8                                                      00304080
  290 TEMP=TEMP+H(K)*TEMPD(K,L)                                         00304090
      DO 300 K=9,20                                                     00304100
      IF(IA(K).EQ.0) GO TO 300                                          00304110
      KL=KL+1                                                           00304120
      TEMP=TEMP+H(KL)*TEMPD(K,L)                                        00304130
  300 CONTINUE                                                          00304140
  310 TEMP=TEMP-REFT                                                    00304150
      DO 320 NK=1,3                                                     00304160
      IM=I6+NK                                                          00304170
  320 SF(IM,L)=-TAU(NK)*TEMP                                            00304180
  330 CONTINUE                                                          00304190
  331 DO 334 M=1,KK                                                     00304200
      J7=6*M-6                                                          00304210
      I=ITABLE(M)+1                                                     00304220
      IF(M.EQ.1) I=1                                                    00304230
      FACTOR=TM(I,II)                                                   00304240
      DO 332 J1=1,6                                                     00304250
      L33=J1+J7                                                         00304260
      DO 332 K1=1,ND                                                    00304270
  332 SA(L33,K1)=SA(L33,K1)+FACTOR*STRS(J1,K1)                          00304280
      DO 333 J1=1,3                                                     00304290
      L33=J1+J7                                                         00304300
      MO=I6+J1                                                          00304310
      DO 333 K1=1,LL                                                    00304320
  333 SF(L33,K1)=SF(L33,K1)+FACTOR*SF(MO,K1)                            00304330
  334 CONTINUE                                                          00304340
  340 CONTINUE                                                          00304350
      DO 345 I=1,KK                                                     00304360
      L3=6*I-6                                                          00304370
      DO 345 J1=4,6                                                     00304380
      J7=L3+J1                                                          00304390
      DO 345 K1=1,LL                                                    00304400
  345 SF(J7,K1)=0.0                                                     00304410
      LK=4                                                              00304420
      IF(NND9.EQ.0) GO TO 351                                           00304430
      DO 350 I=2,KK                                                     00304440
      LK=LK+6                                                           00304450
      J=ITABLE(I)                                                       00304460
  350 SF(LK,1)= IX(J)/10000.                                            00304470
  351 CONTINUE                                                          00304480
      IF(DE.EQ.0.0) GO TO 390                                           00304490
      IRK=1                                                             00304500
      IRK1=1                                                            00304510
      IRK2=1                                                            00304520
      DO 360 IM=3,ND,3                                                  00304530
      IM1=IM-1                                                          00304540
      IM2=IM-2                                                          00304550
      IF(LMASS.NE.1) GO TO 355                                          00304560
      IRK=IM                                                            00304570
      IRK1=IM1                                                          00304580
      IRK2=IM2                                                          00304590
  355 CONTINUE                                                          00304600
      SCG(1)=SCG(1)+XM(IM2,IRK2)*YZ(IM2)                                00304610
      SCG(2)=SCG(2)+XM(IM1,IRK1)*YZ(IM1)                                00304620
      SCG(3)=SCG(3)+XM(IM,IRK )*YZ(IM)                                  00304630
  360 SCG(4)=SCG(4)+XM(IM,IRK)                                          00304640
      DO 380 I=1,LL                                                     00304650
      AX=PROP6(I,5)*GRAV                                                00304660
        IF(JROT.EQ.0) GO TO 365                                         00304670
        AX=0.0                                                          00304680
        AY=0.0                                                          00304690
365     CONTINUE                                                        00304700
      AZ=PROP6(I,7)*GRAV                                                00304710
      IF(AX.EQ.0.0.AND.AY.EQ. 0.0.AND.AZ.EQ.0.0) GO TO 380              00304720
      IRK=1                                                             00304730
      IRK1=1                                                            00304740
      IRK2=1                                                            00304750
      DO 370 IM=3,ND,3                                                  00304760
      IM1=IM-1                                                          00304770
      IM2=IM-2                                                          00304780
      IF(LMASS.NE.1) GO TO 368                                          00304790
      IRK=IM                                                            00304800
      IRK1=IM1                                                          00304810
      IRK2=IM2                                                          00304820
  368 CONTINUE                                                          00304830
      RF(IM2,I)=RF(IM2,I)+XM(IM2,IRK2)*AX                               00304840
      RF(IM1,I)=RF(IM1,I)+XM(IM1,IRK1)*AY                               00304850
  370 RF(IM ,I)=RF(IM ,I)+XM(IM,IRK)*AZ                                 00304860
  380 CONTINUE                                                          00304870
  390 CONTINUE                                                          00304880
        IF(JROT.EQ.0) GO TO 410                                         00304890
        IM2=-2                                                          00304900
      IRK1=1                                                            00304910
      IRK2=1                                                            00304920
        DO 400 I=1,IEL                                                  00304930
        IM2=IM2+3                                                       00304940
        IM1=IM2+1                                                       00304950
      IF(LMASS.NE.1) GO TO 393                                          00304960
      IRK1=IM1                                                          00304970
      IRK2=IM2                                                          00304980
  393 CONTINUE                                                          00304990
        DO 400 J=1,LL                                                   00305000
        AX=PROP6(J,5)                                                   00305010
        AY=PROP6(J,6)                                                   00305020
        RF(IM2,J)=RF(IM2,J)+XM(IM2,IRK2)*(AX*FN(I,1)+AY*FN(I,2))        00305030
400     RF(IM1,J)=RF(IM1,J)+XM(IM1,IRK1)*(AX*FN(I,2)-AY*FN(I,1))        00305040
410     CONTINUE                                                        00305050
      CALL WRITET(MBAND,NDIF,IX(13),ND,NS,LM,SA)                        00305060
      RETURN                                                            00305070
      END                                                               00305080
      SUBROUTINE STIF60( S,RF,PROP6,LL,TEMPD,NDMX,MXDF,XM)              00269800
      IMPLICIT REAL*8 (A-H,O-Z)                                         00269810
      DIMENSION PROP6(LL,7),TEMPD(NDMX,LL),RF(MXDF,LL),XM(1)            00269820
      DIMENSION S(1)                                                    00269830
      COMMON /TRASH/BB(9)                                               00269840
     $      ,H8(8),RRTRAS(473)                                          R0269850
      COMMON /QTSARG/ D(6,6),P(3,20),YZ(60),H(20),TAU(3),               00269860
     $PROP( 4),B(60  ),XJ(3,3),HP(60),UP(60),DE,DET,RRQTSA(626)         R0269870
      COMMON /JUNK/ IEL,NND9,NINT,NINTOP,ND,NEL,NOD9(12),RRJUNK(218)    R0269880
      COMMON /GASS/ XG(4,4),WGT(4,4),IPERM(3)                           R0269890
      COMMON /PREP/ XZ(2),KSKIP,RRPREP(8)                               R0269900
      COMMON /AMB/ GRAV,REFT,JROT                                       R0269910
      D1=PROP(1)                                                        00269920
      D2=D1                                                             00269930
      D3=0.0                                                            00269940
      DO 70 I=1,6                                                       00269950
      DO 70 J=1,6                                                       00269960
   70 D(I,J)=0.0                                                        00269970
      DO 80 I=1,3                                                       00269980
      DO 80 J=1,3                                                       00269990
   80 D(I,J)=D1                                                         00270000
      IF(NINT.EQ.1) GO TO 90                                            00270010
      CALL STST3L(PROP,D,TAU)                                           00270020
      D1=D(1,1)                                                         00270030
      D2=D(1,2)                                                         00270040
      D3=D(4,4)                                                         00270050
   90 CONTINUE                                                          00270060
      FACT=PROP(1)/((1.-2.*PROP(2))*(1.+PROP(2)))                       00270070
      FACT=FACT*PROP(4)*(1.+PROP(2))                                    00270080
      WGH=0.0                                                           00270090
      NINTX=NINT                                                        00270100
      NINTY=NINT                                                        00270110
      NINTZ=NINT                                                        00270120
      IF(NINT.EQ.1) NINTX=3                                             00270130
      IF(NINT.EQ.1) NINTY=3                                             00270140
      IF(NINT.EQ.1) NINTZ=3                                             00270150
      IF(NINTOP.EQ.1) NINTX=NINT-1                                      00270160
      IF(NINTOP.EQ.2) NINTY=NINT-1                                      00270170
      IF(NINTOP.EQ.3) NINTZ=NINT-1                                      00270180
      DO 200 LX=1,NINTX                                                 00270190
      E1=XG(LX,NINTX)                                                   00270200
      DO 200 LY=1,NINTY                                                 00270210
      E2=XG(LY,NINTY)                                                   00270220
      DO 200 LZ=1,NINTZ                                                 00270230
      E3=XG(LZ,NINTZ)                                                   00270240
      WT=WGT(LX,NINTX)*WGT(LY,NINTY)*WGT(LZ,NINTZ)                      00270250
      CALL DERIQ3  (NEL, YZ,B,DET,E1,E2,E3,NOD9,0)                      00270260
      IF(KSKIP.EQ.1) RETURN                                             00270270
      FAC=WT*DET                                                        00270280
      IF(DE.EQ.0.0) GO TO 110                                           00270290
      GG=FAC*DE                                                         00270300
      IF(NINTOP.EQ.9) GO TO 101                                         00270310
      DO 100 I=1,IEL                                                    00270320
      II=3*I-2                                                          00270330
  100 XM(II)=XM(II)+H(I)*GG                                             00270340
      GO TO 110                                                         00270350
  101 IK=1                                                              00270360
      DO 105 I=1,ND,3                                                   00270370
      XM(I)=XM(I)+H(IK)*H(IK)*GG                                        00270380
  105 IK=IK+1                                                           00270390
      WGH=WGH+GG                                                        00270400
  110 CONTINUE                                                          00270410
      IF(PROP(4).EQ.0.0) GO TO 170                                      00270420
      DO 160 I=1,LL                                                     00270430
      TMR=0.0                                                           00270440
      TOPT=PROP6(I,2)                                                   00270450
      IF(TOPT.EQ.0) GO TO 160                                           00270460
      IF(TOPT.EQ.2)TMR=PROP6(I,3)                                       00270470
      IF(TOPT.NE.1) GO TO 140                                           00270480
      DO 120 II=1,8                                                     00270490
  120 TMR=TMR+TEMPD(II,I)*H(II)                                         00270500
      IF(NND9.EQ.0) GO TO 140                                           00270510
      IK=8                                                              00270520
      DO 130 II=1,NND9                                                  00270530
      J=NOD9(II)                                                        00270540
      IK=IK+1                                                           00270550
  130 TMR=TMR+TEMPD(J,I)*H(IK)                                          00270560
  140 TMR=TMR-REFT                                                      00270570
      TMR=TMR*FACT*FAC                                                  00270580
      DO 150 II=1,ND                                                    00270590
  150 RF(II,I)=RF(II,I)+TMR*B(II)                                       00270600
  160 CONTINUE                                                          00270610
  170 CONTINUE                                                          00270620
      FAC= DSQRT(FAC)                                                   00270630
      DO 180 I=1,ND                                                     00270640
  180 B(I)=FAC*B(I)                                                     00270650
      KL=0                                                              00270660
      DO 190 I=1,ND                                                     00270670
      DO 190 J=I,ND                                                     00270680
      KL=KL + 1                                                         00270690
  190 S(KL)=S(KL) + B(I)*B(J)                                           00270700
  200 CONTINUE                                                          00270710
      KL=1                                                              00270720
      DO 250 II=1,IEL                                                   00270730
      I0=3*(II-1)                                                       00270740
      DO 240 JJ=II,IEL                                                  00270750
      J0=3*(JJ-1)                                                       00270760
      KS=KL                                                             00270770
      IC=0                                                              00270780
      DO 220 I=1,3                                                      00270790
      DO 210 J=1,3                                                      00270800
      IC=IC + 1                                                         00270810
      BB(IC)=S(KS)                                                      00270820
  210 KS=KS + 1                                                         00270830
  220 KS=KS + ND - I0 - I - 3                                           00270840
      KS1=KL                                                            00270850
      KS2=KS1 + ND - I0 - 1                                             00270860
      KS3=KS2 + ND - I0 - 2                                             00270870
      S(KS1)=BB(1)*D1 + (BB(5) + BB(9))*D3                              00270880
      S(KS2+1)=BB(5)*D1 + (BB(1) + BB(9))*D3                            00270890
      S(KS3+2)=BB(9)*D1 + (BB(1) + BB(5))*D3                            00270900
      IF (II.EQ.JJ) GO TO 230                                           00270910
      S(KS1+1)=BB(2)*D2 + BB(4)*D3                                      00270920
      S(KS2)=BB(4)*D2 + BB(2)*D3                                        00270930
      S(KS1+2)=BB(3)*D2 + BB(7)*D3                                      00270940
      S(KS3)=BB(7)*D2 + BB(3)*D3                                        00270950
      S(KS2+2)=BB(6)*D2 + BB(8)*D3                                      00270960
      S(KS3+1)=BB(8)*D2 + BB(6)*D3                                      00270970
      GO TO 240                                                         00270980
  230 S(KS1+1)=BB(2)*(D2 + D3)                                          00270990
      S(KS1+2)=BB(3)*(D2 + D3)                                          00271000
      S(KS2+2)=BB(6)*(D2 + D3)                                          00271010
  240 KL=KL + 3                                                         00271020
  250 KL=KL + 2*(ND-I0) - 3                                             00271030
  260 CONTINUE                                                          00271040
      IF(DE.LE.0.0) RETURN                                              00271050
      TMR=0.0                                                           00271060
      DO 265 I=1,ND,3                                                   00271070
  265 TMR=TMR +XM(I)                                                    00271080
      WGH=WGH/TMR                                                       00271090
      IF(NINTOP.NE.9) WGH=1.0                                           00271100
      DO 270 I=1,ND,3                                                   00271110
      XM(I)=XM(I)*WGH                                                   00271120
      IK=I+1                                                            00271130
      KL=I+2                                                            00271140
      XM(IK)=XM(I)                                                      00271150
  270 XM(KL)=XM(I)                                                      00271160
      RETURN                                                            00271170
      END                                                               00271180
      SUBROUTINE STST3L(PROP,C,TAU)                                     00282620
      IMPLICIT REAL*8 (A-H,O-Z)                                         00282630
      COMMON/TRASH/YM,PV,A1,B1,C1,D1,RRTRAS(484)                        R0282640
      DIMENSION PROP(1),C(6,1),TAU(1)                                   00282650
  100 YM=PROP(1)                                                        00282660
      PV=PROP(2)                                                        00282670
      C1=1. - 2.*PV                                                     00282680
      B1=YM/(1. + PV)                                                   00282690
      A1=B1/C1                                                          00282700
      D1=1. - PV                                                        00282710
      D1=A1*D1                                                          00282720
      A1=A1*PV                                                          00282730
      B1=0.5*B1                                                         00282740
      DO 110 I=1,6                                                      00282750
      DO 110 J=1,6                                                      00282760
  110 C(I,J)=0.0                                                        00282770
      DO 120 I=1,3                                                      00282780
  120 C(I,I)=D1                                                         00282790
      DO 130 I=2,3                                                      00282800
  130 C(1,I)=A1                                                         00282810
      C(2,3)=A1                                                         00282820
      DO 140 I=4,6                                                      00282830
  140 C(I,I)=B1                                                         00282840
      DO 150 I=1,6                                                      00282850
      DO 150 J=1,6                                                      00282860
  150 C(J,I)=C(I,J)                                                     00282870
      DO 160 I=1,3                                                      00282880
      TAU(I)=0.0                                                        00282890
      DO 160 J=1,3                                                      00282900
  160 TAU(I)=TAU(I)+C(I,J)*PROP(4)                                      00282910
      RETURN                                                            00282920
      END                                                               00282930
      SUBROUTINE DERIQ3  (NEL,XX,B,DET,R,S,T,NOD9,KFL)                  00057600
      IMPLICIT REAL*8 (A-H,O-Z)                                         00057610
      COMMON /JUNK/ IEL,NRJUNK(453)                                     R0057620
      COMMON /QTSARG/ D(6,6),P(3,20),YZ(60),H(20),TAU(3),               00057630
     $PROP( 4),Y(60  ),XJ(3,3),RRQTSA(748)                              R0057640
      DIMENSION XX(3,1),B(1),NOD9(1)                                    00057650
      COMMON /TRASH/ XJI(3,3),RRTRAS(481)                               R0057660
      CALL FUNCT (R,S,T,H,P,NOD9,XJ,DET,XX,KFL)                         00057670
      IF(DET.LT.1.0E-20) DET=1.0E-20                                    00057680
      DUM=1.0/DET                                                       00057690
      XJI(1,1)=DUM*( XJ(2,2)*XJ(3,3) - XJ(2,3)*XJ(3,2))                 00057700
      XJI(2,1)=DUM*(-XJ(2,1)*XJ(3,3) + XJ(2,3)*XJ(3,1))                 00057710
      XJI(3,1)=DUM*( XJ(2,1)*XJ(3,2) - XJ(2,2)*XJ(3,1))                 00057720
      XJI(1,2)=DUM*(-XJ(1,2)*XJ(3,3) + XJ(1,3)*XJ(3,2))                 00057730
      XJI(2,2)=DUM*( XJ(1,1)*XJ(3,3) - XJ(1,3)*XJ(3,1))                 00057740
      XJI(3,2)=DUM*(-XJ(1,1)*XJ(3,2) + XJ(1,2)*XJ(3,1))                 00057750
      XJI(1,3)=DUM*( XJ(1,2)*XJ(2,3) - XJ(1,3)*XJ(2,2))                 00057760
      XJI(2,3)=DUM*(-XJ(1,1)*XJ(2,3) + XJ(1,3)*XJ(2,1))                 00057770
      XJI(3,3)=DUM*( XJ(1,1)*XJ(2,2) - XJ(1,2)*XJ(2,1))                 00057780
      DO 120 K=1,IEL                                                    00057790
      K2=K*3                                                            00057800
      K2P=K2+1                                                          00057810
      DO 100 I=1,3                                                      00057820
  100 B(K2P -I)=0.0                                                     00057830
      DO 110 I=1,3                                                      00057840
      B(K2-2)=B(K2-2) + XJI(1,I)*P(I,K)                                 00057850
      B(K2-1)=B(K2-1) + XJI(2,I)*P(I,K)                                 00057860
  110 B(K2)=B(K2) + XJI(3,I)*P(I,K)                                     00057870
  120 CONTINUE                                                          00057880
      RETURN                                                            00057890
      END                                                               00057900
      SUBROUTINE FUNCT (R1,S1,T1,H,P,NOD9,XJ,DET,XX,KFL)                00097380
      IMPLICIT REAL*8 (A-H,O-Z)                                         00097390
      COMMON /PREP/ XZ(2),KSKIP,RRPREP(8)                               R0097400
      COMMON/TRASH/RP,SP,TP,RM,SM,TM,RR,SS,TT                           00097410
     $,H8(8),LSW,NRTRAS(945)                                            R0097420
      COMMON /JUNK/ IEL,NND9,NINT,NINTOP,ND,NEL,RRJUNK(224)             R0097430
      DIMENSION H(20),P(3,20),NOD9(12),IPERM(8),XJ(3,3),XX(3,20)        00097440
      DIMENSION PDH1(3),PDH5(3)                                         00097450
      DATA IPERM / 2,3,4,1,6,7,8,5 /                                    00097460
      R=R1                                                              00097470
      S=S1                                                              00097480
      T=T1                                                              00097490
      IELX=IEL                                                          00097500
      RP=1.0 + R                                                        00097510
      SP=1.0 + S                                                        00097520
      TP=0.125*(1.0+T)                                                  00097530
      RM=1.0 - R                                                        00097540
      SM=1.0 - S                                                        00097550
      TM=0.125*(1.0-T)                                                  00097560
      RR=1.0 - R*R                                                      00097570
      SS=1.0 - S*S                                                      00097580
      TT=1.0 - T*T                                                      00097590
      H(1)=RP*SM*TM                                                     00097600
      H(2)=RP*SP*TM                                                     00097610
      H(3)=RM*SP*TM                                                     00097620
      H(4)=RM*SM*TM                                                     00097630
      H(5)=RP*SM*TP                                                     00097640
      H(6)=RP*SP*TP                                                     00097650
      H(7)=RM*SP*TP                                                     00097660
      H(8)=RM*SM*TP                                                     00097670
      DO 50 I=1,8                                                       00097680
   50 H8(I)=H(I)                                                        00097690
      P(1,1)=SM*TM                                                      00097700
      P(1,2)=SP*TM                                                      00097710
      P(1,3)=-P(1,2)                                                    00097720
      P(1,4)=-P(1,1)                                                    00097730
      P(1,5)=SM*TP                                                      00097740
      P(1,6)=SP*TP                                                      00097750
      P(1,7)=-P(1,6)                                                    00097760
      P(1,8)=-P(1,5)                                                    00097770
      P(2,2)=RP*TM                                                      00097780
      P(2,1)=-P(2,2)                                                    00097790
      P(2,3)=RM*TM                                                      00097800
      P(2,4)=-P(2,3)                                                    00097810
      P(2,6)=RP*TP                                                      00097820
      P(2,5)=-P(2,6)                                                    00097830
      P(2,7)=RM*TP                                                      00097840
      P(2,8)=-P(2,7)                                                    00097850
      P(3,5)= 0.125*RP*SM                                               00097860
      P(3,6)= 0.125*RP*SP                                               00097870
      P(3,7)= 0.125*RM*SP                                               00097880
      P(3,8)= 0.125*RM*SM                                               00097890
      P(3,1)=-P(3,5)                                                    00097900
      P(3,2)=-P(3,6)                                                    00097910
      P(3,3)=-P(3,7)                                                    00097920
      P(3,4)=-P(3,8)                                                    00097930
      IF (IEL.EQ.8) GO TO 290                                           00097940
      TM=TM+TM                                                          00097950
      TP=TP+TP                                                          00097960
      R=R+R                                                             00097970
      S=S+S                                                             00097980
      TT=0.25*TT                                                        00097990
      T=-0.50*T                                                         00098000
      I=0                                                               00098010
  100 I=I + 1                                                           00098020
      IF (I.GT.NND9) GO TO 230                                          00098030
      NN=NOD9(I) - 8                                                    00098040
      GO TO (110,120,130,140,150,160,170,180,190,200,210,220), NN       00098050
  110 H(9)=RP*SS*TM                                                     00098060
      P(1, 9)=SS*TM                                                     00098070
      P(2, 9)=-RP*S*TM                                                  00098080
      P(3, 9)=-0.25*RP*SS                                               00098090
      GO TO 100                                                         00098100
  120 H(10)=RR*SP*TM                                                    00098110
      P(1,10)=-R*SP*TM                                                  00098120
      P(2,10)=RR*TM                                                     00098130
      P(3,10)=-0.25*RR*SP                                               00098140
      GO TO 100                                                         00098150
  130 H(11)=RM*SS*TM                                                    00098160
      P(1,11)=-SS*TM                                                    00098170
      P(2,11)=-RM*S*TM                                                  00098180
      P(3,11)=-0.25*RM*SS                                               00098190
      GO TO 100                                                         00098200
  140 H(12)=RR*SM*TM                                                    00098210
      P(1,12)=-R*SM*TM                                                  00098220
      P(2,12)=-RR*TM                                                    00098230
      P(3,12)=-0.25*RR*SM                                               00098240
      GO TO 100                                                         00098250
  150 H(13)=RP*SS*TP                                                    00098260
      P(1,13)=SS*TP                                                     00098270
      P(2,13)=-RP*S*TP                                                  00098280
      P(3,13)= 0.25*RP*SS                                               00098290
      GO TO 100                                                         00098300
  160 H(14)=RR*SP*TP                                                    00098310
      P(1,14)=-R*SP*TP                                                  00098320
      P(2,14)=RR*TP                                                     00098330
      P(3,14)= 0.25*RR*SP                                               00098340
      GO TO 100                                                         00098350
  170 H(15)=RM*SS*TP                                                    00098360
      P(1,15)=-SS*TP                                                    00098370
      P(2,15)=-RM*S*TP                                                  00098380
      P(3,15)= 0.25*RM*SS                                               00098390
      GO TO 100                                                         00098400
  180 H(16)=RR*SM*TP                                                    00098410
      P(1,16)=-R*SM*TP                                                  00098420
      P(2,16)=-RR*TP                                                    00098430
      P(3,16)= 0.25*RR*SM                                               00098440
      GO TO 100                                                         00098450
  190 H(17)=RP*SM*TT                                                    00098460
      P(1,17)=SM*TT                                                     00098470
      P(2,17)=-RP*TT                                                    00098480
      P(3,17)=RP*SM*T                                                   00098490
      GO TO 100                                                         00098500
  200 H(18)=RP*SP*TT                                                    00098510
      P(1,18)=SP*TT                                                     00098520
      P(2,18)=RP*TT                                                     00098530
      P(3,18)=RP*SP*T                                                   00098540
      GO TO 100                                                         00098550
  210 H(19)=RM*SP*TT                                                    00098560
      P(1,19)=-SP*TT                                                    00098570
      P(2,19)= RM*TT                                                    00098580
      P(3,19)=RM*SP*T                                                   00098590
      GO TO 100                                                         00098600
  220 H(20)=RM*SM*TT                                                    00098610
      P(1,20)=-SM*TT                                                    00098620
      P(2,20)=-RM*TT                                                    00098630
      P(3,20)=RM*SM*T                                                   00098640
      GO TO 100                                                         00098650
  230 IH=0                                                              00098660
  240 IH=IH + 1                                                         00098670
      IF (IH.GT.NND9) GO TO 290                                         00098680
      II=IH + 7                                                         00098690
      IF (II.EQ.IELX) GO TO 300                                         00098700
  250 IN=NOD9(IH)                                                       00098710
      IF (IN.GT.16) GO TO 270                                           00098720
      I1=IN - 8                                                         00098730
      I2=IPERM(I1)                                                      00098740
      H(I1)=H(I1) - 0.5*H(IN)                                           00098750
      H(I2)=H(I2) - 0.5*H(IN)                                           00098760
      H(IH+8)=H(IN)                                                     00098770
      DO 260 J=1,3                                                      00098780
      P(J,I1)=P(J,I1) - 0.5*P(J,IN)                                     00098790
      P(J,I2)=P(J,I2) - 0.5*P(J,IN)                                     00098800
  260 P(J,IH+8)=P(J,IN)                                                 00098810
      GO TO 240                                                         00098820
  270 CONTINUE                                                          00098830
      I1=IN - 16                                                        00098840
      I2=I1 + 4                                                         00098850
      H(I1)=H(I1) - 0.5*H(IN)                                           00098860
      H(I2)=H(I2) - 0.5*H(IN)                                           00098870
      H(IH+8)=H(IN)                                                     00098880
      DO 280 J=1,3                                                      00098890
      P(J,I1)=P(J,I1) - 0.5*P(J,IN)                                     00098900
      P(J,I2)=P(J,I2) - 0.5*P(J,IN)                                     00098910
  280 P(J,IH+8)=P(J,IN)                                                 00098920
      GO TO 240                                                         00098930
  290 CONTINUE                                                          00098940
      IF(LSW.LE.0) GO TO 295                                            00098950
      DELTH1=0.25*RR*SS*TM                                              00098960
      DELTH5=0.25*RR*SS*TP                                              00098970
      H(1)=H(1)+DELTH1                                                  00098980
      H(2)=H(2)+DELTH1                                                  00098990
      H(3)=H(3)+H(4)+H(11)                                              00099000
      H(4)=0.0                                                          00099010
      H(5)=H(5)+DELTH5                                                  00099020
      H(6)=H(6)+DELTH5                                                  00099030
      H(7)=H(7)+H(8)+H(15)                                              00099040
      H(8)=0.0                                                          00099050
      H(9)=H(9)-2.0*DELTH1                                              00099060
      H(11)=0.0                                                         00099070
      H(13)=H(13)-2.*DELTH5                                             00099080
      H(15)=0.0                                                         00099090
      H(19)=H(19)+H(20)                                                 00099100
      H(20)=0.0                                                         00099110
      PDH1(1)=-0.25*R*SS*TM                                             00099120
      PDH1(2)=-0.25*S*RR*TM                                             00099130
      PDH1(3)=-0.0625*RR*SS                                             00099140
      PDH5(1)=-0.25*R*SS*TP                                             00099150
      PDH5(2)=-0.25*S*RR*TP                                             00099160
      PDH5(3)=-PDH1(3)                                                  00099170
      DO 292 I=1,3                                                      00099180
      P(I,1)=P(I,1)+PDH1(I)                                             00099190
      P(I,2)=P(I,2)+PDH1(I)                                             00099200
      P(I,3)=P(I,3)+P(I,4)+P(I,11)                                      00099210
      P(I,4)=0.0                                                        00099220
      P(I,5)=P(I,5)+PDH5(I)                                             00099230
      P(I,6)=P(I,6)+PDH5(I)                                             00099240
      P(I,7)=P(I,7)+P(I,8)+P(I,15)                                      00099250
      P(I,8)=0.0                                                        00099260
      P(I,9)=P(I,9)-2.0*PDH1(I)                                         00099270
      P(I,11)=0.0                                                       00099280
      P(I,13)=P(I,13)-2.0*PDH5(I)                                       00099290
      P(I,15)=0.0                                                       00099300
      P(I,19)=P(I,19)+P(I,20)                                           00099310
  292 P(I,20)=0.0                                                       00099320
  295 CONTINUE                                                          00099330
  300 DO 320 I=1,3                                                      00099340
      DO 320 J=1,3                                                      00099350
      DUM=0.0                                                           00099360
      DO 310 K=1,IELX                                                   00099370
  310 DUM=DUM + P(I,K)*XX(J,K)                                          00099380
  320 XJ(I,J)=DUM                                                       00099390
      DET = XJ(1,1)*XJ(2,2)*XJ(3,3)                                     00099400
     $    + XJ(1,2)*XJ(2,3)*XJ(3,1)                                     00099410
     $    + XJ(1,3)*XJ(2,1)*XJ(3,2)                                     00099420
     $    - XJ(1,3)*XJ(2,2)*XJ(3,1)                                     00099430
     $    - XJ(1,2)*XJ(2,1)*XJ(3,3)                                     00099440
     $    - XJ(1,1)*XJ(2,3)*XJ(3,2)                                     00099450
      IF(DET.GT.1.0E-08) GO TO 330                                      00099460
      IF(KFL.GT.0) GO TO 330                                            00099470
      WRITE (6,340) NEL                                                 00099480
      KSKIP=1                                                           00099490
  330 CONTINUE                                                          00099500
      RETURN                                                            00099510
  340 FORMAT (40H STOP  -  NEGATIVE OR ZERO DETERMINANT       /         00099520
     $1X,                                                               00099530
     $11HON ELEMENT ,I5,35HCHECK NUMBERING OR COORDINATES.      )       00099540
      END                                                               00099550
      SUBROUTINE PLD60(PRES)                                            00166400
      IMPLICIT REAL*8(A-H,O-Z)                                          00166410
      REAL*8  LM                                                        00166420
      DIMENSION KFACE(6,8)                                              00166430
      DIMENSION KCRD(6),FVAL(6)                                         00166440
      DIMENSION PRES(7)                                                 00166450
      COMMON /QTSARG/ D(6,6),P(3,20),YZ(60),H(20),TAU(3),               00166460
     $PROP(4),B(60), A(3,3),LM(60),XM(60),DE,DET,RRQTSA(626)            R0166470
      COMMON /JUNK/IEL,NND9,NINT,NINTOP,ND,NEL,NOD9(12),ETA(3),         R0166480
     & RRJUNK(215)                                                      R0166490
      COMMON /TRASH/ ZA(17),LSW,NRTRAS(945)                             R0166500
      COMMON /PREP/ ZB(2),KSKIP,RRPREP(8)                               R0166510
      COMMON /GASS/ XK(4,4),WGT(4,4),IPERM(3)                           00166520
      DATA KCRD / 1,1,2,2,3,3/                                          00166530
      DATA FVAL /1.,-1.,1.,-1.,1.,-1./                                  00166540
      DATA KFACE/ 1, 4, 2, 1, 6, 2,                                     00166550
     $            2, 3, 3, 4, 7, 3,                                     00166560
     $            6, 7, 7, 8, 8, 4,                                     00166570
     $            5, 8, 6, 5, 5, 1,                                     00166580
     $            9,11,10,12,14,10,                                     00166590
     $           18,19,19,20,15,11,                                     00166600
     $           13,15,14,16,16,12,                                     00166610
     $           17,20,18,17,13, 9/                                     00166620
      DO 100 I=1,ND                                                     00166630
      LM(I)=0.0                                                         00166640
  100 XM(I)=0.0                                                         00166650
      DO 210 KK=1,3                                                     00166660
      YREF=PRES(2)                                                      00166670
      KTYPE=1                                                           00166680
      IF(KK.EQ.1.AND.YREF.NE.0) KTYPE=2                                 00166690
      PR=PRES(1)                                                        00166700
      IF(KK.GE.2) PR=PRES(2*KK)                                         00166710
      KF=PRES(2*KK+1)                                                   00166720
      IF(LSW.LE.0.OR.KF.NE.2) GO TO 105                                 00166730
      KSKIP=1                                                           00166740
      WRITE(6,102)NEL                                                   00166750
  102 FORMAT(/20X,7HELEMENT,I5,34H IS A WEDGE AND PRESSURE CANNOT BE,   00166760
     $45H APPLIED TO FACE NO. 2, EXECUTION TERMINATED.//)               00166770
      RETURN                                                            00166780
  105 CONTINUE                                                          00166790
      IF(PR.EQ.0) GO TO 210                                             00166800
      IF(KF.EQ.0) GO TO 210                                             00166810
      IF(KF.EQ.1.OR.KF.EQ.3.OR.KF.EQ.5) PR=-PR                          00166820
      ML = KCRD(KF)                                                     00166830
      ETA(ML) = FVAL(KF)                                                00166840
      MM = IPERM(ML)                                                    00166850
      MN = IPERM(MM)                                                    00166860
      DO 180 LX=1,NINT                                                  00166870
      ETA(MM)=XK(LX,NINT)                                               00166880
      W1=WGT(LX,NINT)                                                   00166890
      DO 180 LY=1,NINT                                                  00166900
      ETA(MN)=XK(LY,NINT)                                               00166910
      W2=WGT(LY,NINT)                                                   00166920
      CALL FUNCT (ETA(1),ETA(2),ETA(3),H,P,NOD9, A,DET,YZ,1)            00166930
      A1 = (A(MM,2)*A(MN,3)-A(MM,3)*A(MN,2))                            00166940
      A2 = (A(MM,3)*A(MN,1)-A(MM,1)*A(MN,3))                            00166950
      A3 = (A(MM,1)*A(MN,2)-A(MM,2)*A(MN,1))                            00166960
      AA=                                                               00166970
     $   DSQRT(A1**2+A2**2+A3**2)                                       00166980
      A1 = A1/AA                                                        00166990
      A2 = A2/AA                                                        00167000
      A3 = A3/AA                                                        00167010
      AA = 0.                                                           00167020
      BB = 0.                                                           00167030
      CC = 0.                                                           00167040
      DO 110  I = 1,3                                                   00167050
      AA=AA+A(MM,I)**2                                                  00167060
      CC=CC+A(MN,I)**2                                                  00167070
  110 BB = BB + A(MM,I)*A(MN,I)                                         00167080
      C= DSQRT(AA*CC - BB*BB)                                           00167090
      IF (KTYPE.EQ.2) GO TO 120                                         00167100
      FORCE = PR                                                        00167110
      GO TO 140                                                         00167120
  120 YY = 0.                                                           00167130
      DO 130 I=1,IEL                                                    00167140
      K=3*I                                                             00167150
  130 YY=YY+H(I)*YZ(K)                                                  00167160
      YY = YY - YREF                                                    00167170
      FORCE = -PR*YY                                                    00167180
      IF(YY.GT.0.) FORCE = 0.                                           00167190
  140 CONTINUE                                                          00167200
      TS=FORCE*W1*W2*C                                                  00167210
      DO 170 I=1,8                                                      00167220
      N= KFACE(KF,I)                                                    00167230
      IF(I.LE.4) GO TO 160                                              00167240
      IF(NND9.EQ.0) GO TO 170                                           00167250
      IL=N                                                              00167260
      DO 150 IK=1,NND9                                                  00167270
      N=IK+8                                                            00167280
      IF(NOD9(IK).EQ.IL) GO TO 160                                      00167290
  150 CONTINUE                                                          00167300
      GO TO 170                                                         00167310
  160 QQ=TS*H(N)                                                        00167320
      K=3*N                                                             00167330
      XM(K-2)=XM(K-2)+QQ*A1                                             00167340
      XM(K-1)=XM(K-1)+QQ*A2                                             00167350
      XM(K  )=XM(K  )+QQ*A3                                             00167360
  170 CONTINUE                                                          00167370
  180 CONTINUE                                                          00167380
      IF(KTYPE.LT.2.OR. KK. GT.1)  GO TO 200                            00167390
      DO 190 I=1,ND                                                     00167400
      LM(I)=XM(I)                                                       00167410
  190 XM(I)=0.0                                                         00167420
  200 CONTINUE                                                          00167430
  210 CONTINUE                                                          00167440
      RETURN                                                            00167450
      END                                                               00167460
