      SUBROUTINE DMOMNT
C
C           'DMOMNT' CALCULATES FLEXIBLE ELEMENT ROOT BENDING MOMENTS
C            AND ELEMENT ROOT TENSIONS
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON/CANTNA/ A(10,3),ADOT(10,3),B(10,3),BDOT(10,3),DIN(10,3),
     .               DINDOT(10,3),DOUT(10,3),DOUTDT(10,3)
C
      COMMON/COMALP/ SZ02(10),SZ03(10),SZ04(10),SZ12(3,10),SZ13(3,10),
     .               SZ14(3,10),SZ15(3,10),SZ16(3,10),SZ21(9,10),
     .               SZ22(9,10),SZ23(9,10),SZ25(9,10),
     .               SZ26(9,10),SZ27(9,10),SZ28(9,10),SZ31(27,10),
     .               SZ32(27,10),SZ33(27,10),SZ34(27,10),SZ35(27,10),
     .               SZ41(81,10),SZ42(81,10),SZ43(81,10)
C
      COMMON/CSOLAR/ SAO(10),SKA(9),SKB(9),SKOA(10,3),SKOB(10,3),
     .               STMK(10),SKAA(10,9),SKBB(10,9)
C
      COMMON/DEBUG2/ IOUT,JOUT,KLUGE
C
      COMMON/DMMNT1/ ZKBM(6),EMAK(10),EMBK(10),ARTETA(3),CMTORK(3),
     .               ITORK,IBENDM,ITENSE,ITNS1
C
      COMMON/IPOOL1/ IGRAV,IDAMP,IK,K1,ITIM,IAB,IAPS,IBB,IBPS,NK(10),
     .               LK(10),LLK(10)
C
      COMMON/MRANG/ ADDOT(10,3),BDDOT(10,3),DOUTDD(10,3),DINDD(10,3)
C
      COMMON/PRCOM/ STORE(10,30),ILINE,ICOL,ICNT,IHD
C
      COMMON/RPOOL1/ RHOK(10),TIME,SA(3,3),FM1(3,3),ZLK(10),OMEG(3),
     .               ZLKP(10),ZLKDP(10),CMAT(3,3),GBAR(3,3),YBCM(3),
     .               ZBZK(3,10),FCM(3,3),DTO,PHID,PHI
C
      COMMON/RPOOL3/ ZMS,YIZM(3,2)
C
      COMMON/RPOOL5/ CKMAT(3,3,10),FM2(3,3)
C
      COMMON/RPOOL8/ SZ01(10),SZ11(3,10),SZ24(9,10)
C
      COMMON/SPRESX/ SPRES(10,3)
C
      COMMON/VARBLS/ DEPEND(150),DERIV(150)
C
      COMMON/TENSON/TSSO(10)
C
      DIMENSION VECTS(3),VECTT(3),VDOT(3),OMGD(3),OMEGDT(3),W(3),
     .          XMOM(3,3),DUM(3,3),RES(3,3),WDOT(3),VECTD(3),FM1T(3,3),
     .          FM2T(3,3),AT(3,3),PRD(3,3),SAP(3),RES2(3,3),
     .          XI(3),XID(3),SAT(3,3)
C
      NAMELIST/OOWWD/OMGD,OMEGDT,W,WDOT/D2/VECTS,VECTD,TDZ,VECTT,
     .               YBCM,ARTETA
C
C
      IF(IOUT.NE.1) WRITE(6,570)
      DO 10 L=1,10
      EMAK(L)=0.0D0
   10 EMBK(L)=0.0D0
      DO 11 J2=1,3
      IF(IOUT.NE.1) WRITE(6,600) (GBAR(J2,J1),J1=1,3)
      VECTT(J2)=0.0D0
      VDOT(J2)=0.0D0
      OMGD(J2)=0.0D0
      OMEGDT(J2)=0.0D0
      W(J2)=0.0D0
   11 WDOT(J2)=0.0D0
      IF(IBENDM.EQ.0) GO TO 35
      DO 50 K=1,IK
      LX=(LLK(K)-1)*3
      N=NK(K)
      IF(N.EQ.0) GO TO 50
   15 EIA=0.5D0*SKAA(K,1)
      EIB=0.5D0*SKBB(K,1)
      FLK=ZLK(K)
      DO 30 I=1,N
      ANT1=FUNA(K,K1,I)
      BNT1=FUNB(K,K1,I)
C
      AN0=SKOA(K,I)
      BN0=SKOB(K,I)
      IF(IOUT.NE.1) PRINT 25,AN0,BN0,ANT1,BNT1
   25 FORMAT(' AN0=',G20.12, ' BN0=',G20.12, ' ANT1=',G20.12,
     .  ' BNT1=',G20.12//)
C
      EMAK(K)=EMAK(K)+(ANT1-AN0)*ZKBM(LX+I)
      EMBK(K)=EMBK(K)+(BNT1-BN0)*ZKBM(LX+I)
   30 CONTINUE
      FLK2=FLK*FLK
      EMAK(K)=EIA/FLK2*EMAK(K)
      EMBK(K)=EIB/FLK2*EMBK(K)
   50 CONTINUE
   35 DO 150 K=1,IK
      IF(ITENSE.EQ.0) GO TO 533
      TDZ=RHOK(K)*ZLK(K)*2.0D0*SZ02(K)
C
      CALL XIMMT(K,XI,XID)
C
      DO 140 J3=1,3
      SAP(J3)=0.0D0
  140 CONTINUE
      DO 145 J2=1,3
      SAP(J2)=RHOK(K)*ZLK(K)*XI(J2)
      IF(IOUT.NE.1) PRINT 143,J2,SAP(J2)
  143 FORMAT(' VECTOR SAP ',I1, 2X, G20.12)
  145 CONTINUE
      SAPD=RHOK(K)*ZLK(K)*XID(1)
      IF(IDAMP.EQ.0.OR.K.GT.K1) GO TO 40
      IF(IDAMP.EQ.1.AND.K.LE.K1) GO TO 220
      PRINT 200,IDAMP,K,K1
  200 FORMAT ('0   DAMPER VALUE AND/OR MODES QUESTIONABLE, IDAMP = ',
     . I3, ' K = ', I3, ' K1 = ', I3)
      RETURN
  220 CONTINUE
      ICZ=1
      VECTS(1)=0.0D0
      VECTS(2)=DEPEND(11)
      VECTS(3)=0.0D0
      VECTD(1)=0.0D0
      VECTD(2)=DERIV(11)
      VECTD(3)=0.0D0
      DO 225 J4=1,3
      DO 225 J5=1,3
      FM1T(J4,J5)=FM1(J5,J4)
  225 CONTINUE
      GO TO 90
   40 CONTINUE
      ICZ=2
      DO 70 M1=1,3
      VECTS(M1)=0.0D0
   45 VECTD(M1)=0.0D0
      DO 70 L1=1,3
   70 FM1T(M1,L1)=FM2(L1,M1)
C
   90 CONTINUE
C
      DO 80 M1=1,3
      DO 80 L1=1,3
      XMOM(M1,L1)=CKMAT(L1,M1,K)
 80   CONTINUE
      CALL MPYMAT(XMOM,FM1T,DUM,1,1,RES,DUM)
C
      DO 250 M1=1,3
      DO 211 JX=1,3
      DO 211 JY=1,3
      RES2(JY,JX)=0.0D0
  211 CONTINUE
C
      OMGD(M1)=RES(M1,1)*DEPEND(7)+RES(M1,2)*DEPEND(8)
     .         +RES(M1,3)*DEPEND(9)
      OMEGDT(M1)=RES(M1,1)*DERIV(7)+RES(M1,2)*DERIV(8)
     .           +RES(M1,3)*DERIV(9)
C
      W(M1)=XMOM(M1,1)*VECTS(1)+XMOM(M1,2)*VECTS(2)
     .      +XMOM(M1,3)*VECTS(3)
      WDOT(M1)=XMOM(M1,1)*VECTD(1)+XMOM(M1,2)*VECTD(2)
     .         +XMOM(M1,3)*VECTD(3)
C
C          COMPUTE   1ST  TERM  -  ART
C
      VECTT(M1)=(RES(M1,1)*ARTETA(1)+RES(M1,2)*ARTETA(2)
     .          +RES(M1,3)*ARTETA(3))*TDZ
  250   CONTINUE
      SMULDT=2.0D0*RHOK(K)*ZLK(K)*((OMGD(2)+W(2))*XID(3)-(OMGD(3)
     .      +W(3))*XID(2))
       IF (IOUT .NE. 1) PRINT 147,SMULDT
  147  FORMAT(' SMULDT=', G20.12)
      DO  340  J2 =1, 3
  340 VECTS (J2) = 0.D0
       IF (IOUT .NE. 1) WRITE(6,OOWWD)
       T9=2.D0* SZ02 (K)
      DO  350   J2 = 1, 3
      VECTS(J2)=(XMOM(J2,1)*ZBZK(1,K)+XMOM(J2,2)*ZBZK(2,K)+XMOM(J2,3)*
     .          ZBZK(3,K))*T9+XI(J2)
  350  CONTINUE
      IF (IOUT .NE. 1) WRITE (6,D2)
      DO   300   J1 =  1, 3
      DO   300   J2 =  1, 3
C
       SAT (J1,J2) =SA (J2,J1)
  300 RES2  (J2, J1) =  0.D0
      DO 320 J1=1,3
      RES2(J1,1)=RES(J1,1)*YIZM(1,ICZ)+RES(J1,2)*YIZM(2,ICZ)+
     .           RES(J1,3)*YIZM(3,ICZ)
  320 CONTINUE
C
      SAPD1=TDZ*(-(OMGD(2)**2+OMGD(3)**2)*RES2(1,1)+(-OMEGDT(3)+
     .      OMGD(1)*OMGD(2))*RES2(2,1)+(OMEGDT(2)+OMGD(1)*OMGD(3))
     .      *RES2(3,1))
C
C
C
      SAP1=RHOK(K)*ZLK(K)*((-(OMGD(2)+W(2))**2-(OMGD(3)+W(3))**2)*
     .     VECTS(1)+(-OMEGDT(3)-WDOT(3)+OMGD(2)*(OMGD(1)+W(1))+(OMGD(2)
     .     +W(2))*W(1))*VECTS(2)+(OMEGDT(2)+WDOT(2)+OMGD(3)*(OMGD(1)
     .     +W(1))+(OMGD(3)+W(3))*W(1))*VECTS(3))
C
C
C
      TERMS=SAPD1+SAP1+SAPD+SMULDT+VECTT(1)+XID(1)
      IF(IOUT.NE.1)PRINT 999,TERMS
  999  FORMAT('0 INERTIA FORCES',G20.12)
       IF (IOUT .NE. 1) PRINT 610,SAPD1     ,SAP1     ,SAPD
  610  FORMAT(' SAPD1 ',G20.12, ' SAP1 ',G20.12,' SAPD ',G20.12)
C
C          GRAVITY   GRADIENT
C
      CALL  MPYMAT (RES, SAT,  DUM,  1, 1,  RES2, DUM)
      CALL MPYMAT (RES2, GBAR, DUM,  1, 1,  PRD, DUM)
      CALL MPYMAT (PRD,  SA,   DUM,  1, 1,  AT, DUM)
C
       IF (IOUT .EQ. 1)GO TO 407
       WRITE(6,403)
  403  FORMAT('0 AT'//)
       DO 406 I1=1, 3
       WRITE (6,405)(AT(I1,K2),K2=1,3)
  405  FORMAT('   ', 3G20.12)
  406  CONTINUE
  407  CONTINUE
      DO  410  J1 = 1, 3
      VECTS (J1) =  0.D0
      DO 410 J2 =1,3
      PRD (J1,J2) =  0.D0
      FM2T (J1,J2) =  FM1T(J2,J1)
  410 CONTINUE
C
C
C
      DO   420   J2 = 1, 3
      VECTS(J2)=((FM2T(J2,1)*ZBZK(1,K)+FM2T(J2,2)*ZBZK(2,K)+FM2T(J2,3)
     .          *ZBZK(3,K))+YIZM(J2,ICZ))*TDZ
  420 CONTINUE
C
C     COMBINE AT MATRIX X VECTS VECTOR
      DO  440  J1 =  1, 3
      PRD(J1,1)=AT(J1,1)*VECTS(1)+AT(J1,2)*VECTS(2)+AT(J1,3)*VECTS(3)
  440 CONTINUE
      IF (IOUT .EQ. 1) GO TO 450
       WRITE (6,445)
  445 FORMAT('0 PRD - 1ST EQUATION'//)
      DO 447 L7=1,3
       WRITE (6,405)(PRD(L7,L8),L8=1,3)
  447  CONTINUE
  450  CONTINUE
C
C       COMPUTE   2D  TERM  GRAVITY GRADIENT
C
      CALL  MPYMAT (AT, FM1T, DUM,  1, 2,  RES2, DUM)
      CALL  MPYMAT (RES2, XMOM, DUM, 1, 2, FM1T, DUM)
C
C   FINISH 2D LINE OF GRAVITY GRADIENT FORCES EQUATION
C
      DO   460   J1 =  1, 3
  460 FM2T(J1,1)=FM1T(J1,1)*SAP(1)+FM1T(J1,2)*SAP(2)+FM1T(J1,3)*SAP(3)
       IF (IOUT .EQ. 1) GO TO 470
       WRITE (6,471)
  471  FORMAT('0  FM2T - 2D EQUATION'//)
       DO 473 L7=1,3
  473  WRITE (6,405)(FM2T(L7,L8),L8=1,3)
  470  CONTINUE
      DO    490  J1 =  1, 3
  490 FM1T(J1,1)=(AT(J1,1)*YBCM(1)+AT(J1,2)*YBCM(2)+
     .           AT(J1,3)*YBCM(3))*(TDZ/ZMS)
       IF (IOUT .EQ. 1) GO TO 498
       WRITE (6, 492)
  492  FORMAT('0 FM1T - 3RD  EQUATION'//)
       DO 495 L7=1,3
       WRITE (6,405)(FM1T(L7,L8),L8=1,3)
  495  CONTINUE
  498  CONTINUE
C
C       GRAVITY   GRADIENT   FORMULA
C
      DO 510 J1=1,3
      RES2(J1,1)=PRD(J1,1)+FM2T(J1,1)-FM1T(J1,1)
  510 CONTINUE
       IF (IOUT .EQ. 1) GO TO 530
       WRITE (6,540)(RES2(J1,1), J1=1,3), SPRES(K,1)
  540  FORMAT(' GRAV ',3G20.12, ' SOLAR ',G20.12/)
  520  CONTINUE
  530 CONTINUE
C
       TSS1=-TERMS +RES2(1,1)+SPRES(K,1)
      TSSO(K)=TSS1
 533  CONTINUE
  150 CONTINUE
  570  FORMAT ('0  GBAR ARRAY'//)
  600  FORMAT('  ',3G20.12)
      RETURN
      END
