1 : C COQ8KC SOURCE CHAT 05/01/12 22:22:01 5004 2 : SUBROUTINE COQ8KC(NBNO,RHOK,NBPGAU,ESP,EXCEN,WRK1,MINTE,MINTE2, 3 : . VROT) 4 : C 5 : C |--------------------------------------------------------------| 6 : C | NOUVELLE PROCEDURE DE CALCUL DE LA MATRICE DE RIGIDITE | 7 : C | CENTRIFUGE AVEC UN ELEMENT DE COQUE A 6 OU 8 NOEUDS | 8 : C | | 9 : C | INSPIRE DU CALCUL DE LA MATRICE DE MASSE | 10 : C |--------------------------------------------------------------| 11 : C | ENTREES | 12 : C | NBPGAU : NOMBRE DE POINTS DE GAUSS. | 13 : C | MINTE : FONCTIONS DE FORME AUX POINTS DE GAUSS | 14 : C | MINTE2 : FONCTIONS DE FORME AUX NOEUDS | 15 : C | RHOK : MASSE VOLUMIQUE. | 16 : C | ESP : EPAISSEUR. | 17 : C | EXCEN : EXCENTREMENT. | 18 : C | NBNO : NOMBRE DE NOEUDS | 19 : C | VROT : VECTEUR VITESSE ROTATION | 20 : C | Didier COMBESCURE mars 2003 | 21 : C |--------------------------------------------------------------| 22 : C 23 : C 24 : C 25 : IMPLICIT INTEGER(I-N) 26 : IMPLICIT REAL*8 (A-H,O-Z) 27 : -INC SMINTE 28 : SEGMENT WRK7 29 : REAL*8 XJI(3,3),TXR(3,3,NBNO),FINT(3,LRE),XJ(3,3),B(3,3) 30 : REAL*8 TH(NBNO),EXC(NBNO),H(NBNO) 31 : ENDSEGMENT 32 : SEGMENT/WRK1/(REL(LRE,LRE)*D,XE(3,NBNO)*D) 33 : DIMENSION ROME(6,6),VROT(*) 34 : SEGACT MINTE 35 : SEGACT WRK1*MOD 36 : LRE=6*NBNO 37 : SEGINI WRK7 38 : DO 5 I = 1,NBNO 39 : EXC(I)=EXCEN 40 : 5 TH(I) = ESP 41 : C 42 : C 43 : C 44 : DO 9 IN=1,6 45 : DO 9 IM=1,6 46 : 9 ROME(IN,IM) = 0.D0 47 : C 48 : ROME(1,1) = (-1.)*((VROT(2)**2) + (VROT(3)**2)) 49 : ROME(2,2) = (-1.)*((VROT(1)**2) + (VROT(3)**2)) 50 : ROME(3,3) = (-1.)*((VROT(1)**2) + (VROT(2)**2)) 51 : ROME(1,2) = VROT(1)*VROT(2) 52 : ROME(1,3) = VROT(1)*VROT(3) 53 : ROME(2,3) = VROT(2)*VROT(3) 54 : ROME(2,1) = ROME(1,2) 55 : ROME(3,1) = ROME(1,3) 56 : ROME(3,2) = ROME(2,3) 57 : C 58 : C INITIALISATION DE LA MATRICE MASSE 59 : C 60 : DO 10 I = 1,6*NBNO 61 : DO 10 J = 1,6*NBNO 62 : REL(I,J) = 0.D0 63 : 10 CONTINUE 64 : * 65 : * CORRECTION RNUR LE 12 / 9 / 90 66 : * 67 : SEGACT MINTE2 67 : CALL CQ8LOC(XE,NBNO,MINTE2.SHPTOT,TXR,IRR) 68 : SEGDES MINTE2 69 : * 70 : DO 80 LX = 1,NBPGAU 71 : E3 = DZEGAU(LX) 72 : WT = POIGAU (LX) 73 : DO 20 I=1,NBNO 74 : 20 H(I)=SHPTOT(1,I,LX) 74 : CALL CQ8JCE(LX,NBNO,E3,XE,TH,EXC,TXR,SHPTOT,B,DET,IRR) 75 : FACT = WT*DET*RHOK 76 : DO 30 I = 1,3 77 : DO 30 J = 1,NBNO*6 78 : 30 FINT(I,J) = 0.D0 79 : DO 60 J = 1,NBNO 80 : DO 40 I = 1,3 81 : 40 XJI(I,I) = 0.D0 82 : XJI(1,2) = TXR(1,1,J)*TXR(2,2,J) - TXR(2,1,J)*TXR(1,2,J) 83 : XJI(1,3) = TXR(1,1,J)*TXR(3,2,J) - TXR(1,2,J)*TXR(3,1,J) 84 : XJI(2,3) = TXR(2,1,J)*TXR(3,2,J) - TXR(2,2,J)*TXR(3,1,J) 85 : DO 50 IK = 1,3 86 : DO 50 JK = IK,3 87 : 50 XJI(JK,IK) = -XJI(IK,JK) 88 : J1 = (J-1)*6 + 1 89 : J2 = J1 + 1 90 : J3 = J2 + 1 91 : J4 = J3 + 1 92 : J5 = J4 + 1 93 : J6 = J5 + 1 94 : A1 = H(J)*(0.5*E3*ESP+EXCEN) 95 : FINT(1,J1) = H(J) 96 : FINT(1,J5) = A1*XJI(1,2) 97 : FINT(1,J6) = A1*XJI(1,3) 98 : FINT(2,J2) = FINT(1,J1) 99 : FINT(2,J4) = -FINT(1,J5) 100 : FINT(2,J6) = A1*XJI(2,3) 101 : FINT(3,J3) = FINT(1,J1) 102 : FINT(3,J4) = -FINT(1,J6) 103 : 60 FINT(3,J5) = -FINT(2,J6) 104 : DO 70 I = 1,NBNO*6 105 : DO 70 J = I,NBNO*6 106 : DO 70 K = 1,3 107 : REL(I,J) = REL(I,J) + FINT(K,I)*FINT(K,J)*FACT 108 : REL(J,I) = REL(I,J) 109 : 70 CONTINUE 110 : 80 CONTINUE 111 : DO 90 I = 1,NBNO 112 : DO 90 J = 1,NBNO 113 : DO 90 IN = 1,3 114 : DO 90 IM = 1,3 115 : REL((6*I)-6+IN,(6*J)-6+IM)=REL((6*I)-6+IN,(6*J)-6+IM) 116 : . *ROME(IN,IM) 117 : REL((6*I)-6+IN,(6*J)-3+IM)=REL((6*I)-6+IN,(6*J)-3+IM) 118 : . *ROME(IN,IM) 119 : REL((6*I)-3+IN,(6*J)-6+IM)=REL((6*I)-3+IN,(6*J)-6+IM) 120 : . *ROME(IN,IM) 121 : REL((6*I)-3+IN,(6*J)-3+IM)=REL((6*I)-3+IN,(6*J)-3+IM) 122 : . *ROME(IN,IM) 123 : 90 CONTINUE 124 : SEGDES WRK1 125 : SEGDES MINTE 126 : SEGSUP WRK7 127 : RETURN 128 : END 129 : 130 : 131 :
© Cast3M 2003 - All rights reserved.
Disclaimer