1 : C COQ8MA SOURCE CHAT 05/01/12 22:22:09 5004 2 : SUBROUTINE COQ8MA (NBNO,RHOK,NBPGAU,ESP,EXCEN,WRK1,MINTE,MINTE2) 3 : C 4 : C |--------------------------------------------------------------| 5 : C | NOUVELLE PROCEDURE DE CALCUL DE LA MATRICE DE MASSE | 6 : C | AVEC UN ELEMENT DE COQUE A 8 NOEUDS | 7 : C | | 8 : C | INSPIRE D'UNE ROUTINE PREEXISTANT DANS BILBO | 9 : C |--------------------------------------------------------------| 10 : C | ENTREES | 11 : C | NBPGAU : NOMBRE DE POINTS DE GAUSS. | 12 : C | MINTE : FONCTIONS DE FORME AUX POINTS DE GAUSS | 13 : C | MINTE2 : FONCTIONS DE FORME AUX NOEUDS | 14 : C | RHOK : MASSE VOLUMIQUE. | 15 : C | ESP : EPAISSEUR. | 16 : C | EXCEN : EXCENTREMENT. | 17 : C | NBNO : NOMBRE DE NOEUDS | 18 : C |--------------------------------------------------------------| 19 : C 20 : C 21 : C 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8 (A-H,O-Z) 24 : -INC SMINTE 25 : SEGMENT WRK7 26 : REAL*8 XJI(3,3),TXR(3,3,NBNO),FINT(3,LRE),XJ(3,3),B(3,3) 27 : REAL*8 TH(NBNO),EXC(NBNO),H(NBNO) 28 : ENDSEGMENT 29 : SEGMENT/WRK1/(REL(LRE,LRE)*D,XE(3,NBNO)*D) 30 : SEGACT MINTE 31 : SEGACT WRK1*MOD 32 : LRE=6*NBNO 33 : SEGINI WRK7 34 : DO 5 I = 1,NBNO 35 : EXC(I)=EXCEN 36 : 5 TH(I) = ESP 37 : C 38 : C INITIALISATION DE LA MATRICE MASSE 39 : C 40 : DO 10 I = 1,6*NBNO 41 : DO 10 J = 1,6*NBNO 42 : REL(I,J) = 0.D0 43 : 10 CONTINUE 44 : * 45 : * CORRECTION RNUR LE 12 / 9 / 90 46 : * 47 : SEGACT MINTE2 47 : CALL CQ8LOC(XE,NBNO,MINTE2.SHPTOT,TXR,IRR) 48 : SEGDES MINTE2 49 : * 50 : DO 80 LX = 1,NBPGAU 51 : E3 = DZEGAU(LX) 52 : WT = POIGAU (LX) 53 : DO 20 I=1,NBNO 54 : 20 H(I)=SHPTOT(1,I,LX) 54 : CALL CQ8JCE(LX,NBNO,E3,XE,TH,EXC,TXR,SHPTOT,B,DET,IRR) 55 : FACT = WT*DET*RHOK 56 : DO 30 I = 1,3 57 : DO 30 J = 1,NBNO*6 58 : 30 FINT(I,J) = 0.D0 59 : DO 60 J = 1,NBNO 60 : DO 40 I = 1,3 61 : 40 XJI(I,I) = 0.D0 62 : XJI(1,2) = TXR(1,1,J)*TXR(2,2,J) - TXR(2,1,J)*TXR(1,2,J) 63 : XJI(1,3) = TXR(1,1,J)*TXR(3,2,J) - TXR(1,2,J)*TXR(3,1,J) 64 : XJI(2,3) = TXR(2,1,J)*TXR(3,2,J) - TXR(2,2,J)*TXR(3,1,J) 65 : DO 50 IK = 1,3 66 : DO 50 JK = IK,3 67 : 50 XJI(JK,IK) = -XJI(IK,JK) 68 : J1 = (J-1)*6 + 1 69 : J2 = J1 + 1 70 : J3 = J2 + 1 71 : J4 = J3 + 1 72 : J5 = J4 + 1 73 : J6 = J5 + 1 74 : A1 = H(J)*(0.5*E3*ESP+EXCEN) 75 : FINT(1,J1) = H(J) 76 : FINT(1,J5) = A1*XJI(1,2) 77 : FINT(1,J6) = A1*XJI(1,3) 78 : FINT(2,J2) = FINT(1,J1) 79 : FINT(2,J4) = -FINT(1,J5) 80 : FINT(2,J6) = A1*XJI(2,3) 81 : FINT(3,J3) = FINT(1,J1) 82 : FINT(3,J4) = -FINT(1,J6) 83 : 60 FINT(3,J5) = -FINT(2,J6) 84 : DO 70 I = 1,NBNO*6 85 : DO 70 J = I,NBNO*6 86 : DO 70 K = 1,3 87 : 70 REL(I,J) = REL(I,J) + FINT(K,I)*FINT(K,J)*FACT 88 : 80 CONTINUE 89 : DO 90 I = 1,NBNO*6 90 : DO 90 J = I,NBNO*6 91 : 90 REL(J,I) = REL(I,J) 92 : SEGDES WRK1 93 : SEGDES MINTE 94 : SEGSUP WRK7 95 : RETURN 96 : END 97 : 98 :
© Cast3M 2003 - All rights reserved.
Disclaimer