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