C COQ8KC SOURCE CHAT 05/01/12 22:22:01 5004 SUBROUTINE COQ8KC(NBNO,RHOK,NBPGAU,ESP,EXCEN,WRK1,MINTE,MINTE2, . VROT) C C |--------------------------------------------------------------| C | NOUVELLE PROCEDURE DE CALCUL DE LA MATRICE DE RIGIDITE | C | CENTRIFUGE AVEC UN ELEMENT DE COQUE A 6 OU 8 NOEUDS | C | | C | INSPIRE DU CALCUL DE LA MATRICE DE MASSE | C |--------------------------------------------------------------| C | ENTREES | C | NBPGAU : NOMBRE DE POINTS DE GAUSS. | C | MINTE : FONCTIONS DE FORME AUX POINTS DE GAUSS | C | MINTE2 : FONCTIONS DE FORME AUX NOEUDS | C | RHOK : MASSE VOLUMIQUE. | C | ESP : EPAISSEUR. | C | EXCEN : EXCENTREMENT. | C | NBNO : NOMBRE DE NOEUDS | C | VROT : VECTEUR VITESSE ROTATION | C | Didier COMBESCURE mars 2003 | C |--------------------------------------------------------------| C C C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC SMINTE SEGMENT WRK7 REAL*8 XJI(3,3),TXR(3,3,NBNO),FINT(3,LRE),XJ(3,3),B(3,3) REAL*8 TH(NBNO),EXC(NBNO),H(NBNO) ENDSEGMENT SEGMENT/WRK1/(REL(LRE,LRE)*D,XE(3,NBNO)*D) DIMENSION ROME(6,6),VROT(*) SEGACT MINTE SEGACT WRK1*MOD LRE=6*NBNO SEGINI WRK7 DO 5 I = 1,NBNO EXC(I)=EXCEN 5 TH(I) = ESP C C C DO 9 IN=1,6 DO 9 IM=1,6 9 ROME(IN,IM) = 0.D0 C ROME(1,1) = (-1.)*((VROT(2)**2) + (VROT(3)**2)) ROME(2,2) = (-1.)*((VROT(1)**2) + (VROT(3)**2)) ROME(3,3) = (-1.)*((VROT(1)**2) + (VROT(2)**2)) ROME(1,2) = VROT(1)*VROT(2) ROME(1,3) = VROT(1)*VROT(3) ROME(2,3) = VROT(2)*VROT(3) ROME(2,1) = ROME(1,2) ROME(3,1) = ROME(1,3) ROME(3,2) = ROME(2,3) C C INITIALISATION DE LA MATRICE MASSE C DO 10 I = 1,6*NBNO DO 10 J = 1,6*NBNO REL(I,J) = 0.D0 10 CONTINUE * * CORRECTION RNUR LE 12 / 9 / 90 * SEGACT MINTE2 CALL CQ8LOC(XE,NBNO,MINTE2.SHPTOT,TXR,IRR) SEGDES MINTE2 * DO 80 LX = 1,NBPGAU E3 = DZEGAU(LX) WT = POIGAU (LX) DO 20 I=1,NBNO 20 H(I)=SHPTOT(1,I,LX) CALL CQ8JCE(LX,NBNO,E3,XE,TH,EXC,TXR,SHPTOT,B,DET,IRR) FACT = WT*DET*RHOK DO 30 I = 1,3 DO 30 J = 1,NBNO*6 30 FINT(I,J) = 0.D0 DO 60 J = 1,NBNO DO 40 I = 1,3 40 XJI(I,I) = 0.D0 XJI(1,2) = TXR(1,1,J)*TXR(2,2,J) - TXR(2,1,J)*TXR(1,2,J) XJI(1,3) = TXR(1,1,J)*TXR(3,2,J) - TXR(1,2,J)*TXR(3,1,J) XJI(2,3) = TXR(2,1,J)*TXR(3,2,J) - TXR(2,2,J)*TXR(3,1,J) DO 50 IK = 1,3 DO 50 JK = IK,3 50 XJI(JK,IK) = -XJI(IK,JK) J1 = (J-1)*6 + 1 J2 = J1 + 1 J3 = J2 + 1 J4 = J3 + 1 J5 = J4 + 1 J6 = J5 + 1 A1 = H(J)*(0.5*E3*ESP+EXCEN) FINT(1,J1) = H(J) FINT(1,J5) = A1*XJI(1,2) FINT(1,J6) = A1*XJI(1,3) FINT(2,J2) = FINT(1,J1) FINT(2,J4) = -FINT(1,J5) FINT(2,J6) = A1*XJI(2,3) FINT(3,J3) = FINT(1,J1) FINT(3,J4) = -FINT(1,J6) 60 FINT(3,J5) = -FINT(2,J6) DO 70 I = 1,NBNO*6 DO 70 J = I,NBNO*6 DO 70 K = 1,3 REL(I,J) = REL(I,J) + FINT(K,I)*FINT(K,J)*FACT REL(J,I) = REL(I,J) 70 CONTINUE 80 CONTINUE DO 90 I = 1,NBNO DO 90 J = 1,NBNO DO 90 IN = 1,3 DO 90 IM = 1,3 REL((6*I)-6+IN,(6*J)-6+IM)=REL((6*I)-6+IN,(6*J)-6+IM) . *ROME(IN,IM) REL((6*I)-6+IN,(6*J)-3+IM)=REL((6*I)-6+IN,(6*J)-3+IM) . *ROME(IN,IM) REL((6*I)-3+IN,(6*J)-6+IM)=REL((6*I)-3+IN,(6*J)-6+IM) . *ROME(IN,IM) REL((6*I)-3+IN,(6*J)-3+IM)=REL((6*I)-3+IN,(6*J)-3+IM) . *ROME(IN,IM) 90 CONTINUE SEGDES WRK1 SEGDES MINTE SEGSUP WRK7 RETURN END