Télécharger la plaquette Cast3M


fr en

Télécharger coq8ma.eso

Retour à la liste

Numérotation des lignes : 

coq8ma

  1. C COQ8MA    SOURCE    PV        20/03/26    21:15:11     10563          
  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 6 ou 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.  
  25. -INC  SMINTE
  26.       SEGMENT WRK7
  27. c       REAL*8 XJI(3,3),TXR(3,3,NBNO),FINT(3,LRE),XJ(3,3),B(3,3)
  28.       REAL*8 TXR(3,3,NBNO),XN(3,LRE),B(3,3)
  29.       REAL*8 TH(NBNO),EXC(NBNO),H(NBNO)
  30.       ENDSEGMENT
  31.       SEGMENT/WRK1/(REL(LRE,LRE)*D,XE(3,NBNO)*D)
  32.  
  33.       SEGACT MINTE
  34.       SEGACT WRK1*MOD
  35.       LRE=6*NBNO
  36.       SEGINI WRK7
  37.  
  38. C     EXCENTRICITE ET EPAISSEUR CONSTANTES EN ENTREE !?!
  39.       DO 5 I = 1,NBNO
  40.       EXC(I)=EXCEN
  41.       TH(I) = ESP
  42.     5 CONTINUE
  43. C
  44. C     INITIALISATION DE LA MATRICE MASSE M=[0]
  45.       DO 10 I = 1,6*NBNO
  46.       DO 11 J = 1,6*NBNO
  47.       REL(I,J) = 0.D0
  48.    11 CONTINUE
  49.    10 CONTINUE
  50. *
  51. C     CALCUL DU REPERE LOCAL AUX NOEUDS : 
  52. c     TXR(i,j,k) = [V1,V2,V3] calcules aux NBNO noeuds (x_k)
  53.       SEGACT MINTE2
  54.       CALL CQ8LOC(XE,NBNO,MINTE2.SHPTOT,TXR,IRR)
  55. *      SEGDES MINTE2
  56. *
  57. * 
  58. *===> BOUCLE SUR LES POINTS DE GAUSS xGauss
  59.       DO 80 LX = 1,NBPGAU
  60.  
  61. c     coordonnees hors plan \dze, poids w et fonctiond forme Ni(xGauss)
  62.       E3 = DZEGAU(LX)
  63.       WT = POIGAU (LX)
  64.       DO 20 I=1,NBNO
  65.       H(I)=SHPTOT(1,I,LX)
  66.    20 CONTINUE
  67.  
  68. c     calcul du Jacobien |J|
  69.       CALL CQ8JCE(LX,NBNO,E3,XE,TH,EXC,TXR,SHPTOT,B,DET,IRR)
  70.       FACT = WT*DET*RHOK
  71.  
  72. c                            UX UY UZ   RX  RY               RZ      
  73. c     remplissage de [N] = [ Ni 0  0  | 0  +Ni*ti*\dze*V3Z -Ni*ti*\dze*V3Y ] 
  74. c                          [ 0  Ni 0  | .   0              +Ni*ti*\dze*V3X ]
  75. c                          [ 0  0  Ni | antisym.            0.             ]
  76.       DO 30 I = 1,3
  77.       DO 31 J = 1,NBNO*6
  78.       XN(I,J) = 0.D0
  79.    31 CONTINUE
  80.    30 CONTINUE
  81.       DO 60 J = 1,NBNO
  82. c       DO 40 I = 1,3
  83. c       XJI(I,I) = 0.D0
  84. c    40 CONTINUE
  85. c       XJI(1,2) = TXR(1,1,J)*TXR(2,2,J) - TXR(2,1,J)*TXR(1,2,J)
  86. c       XJI(1,3) = TXR(1,1,J)*TXR(3,2,J) - TXR(1,2,J)*TXR(3,1,J)
  87. c       XJI(2,3) = TXR(2,1,J)*TXR(3,2,J) - TXR(2,2,J)*TXR(3,1,J)
  88. c       DO 50 IK = 1,3
  89. c       DO 51 JK = IK,3
  90. c       XJI(JK,IK) = -XJI(IK,JK)
  91. c    51 CONTINUE
  92. c    50 CONTINUE
  93. Cbp,2020 : on fait + simple car V3 deja calcule !
  94.       V3X=TXR(1,3,J)
  95.       V3Y=TXR(2,3,J)
  96.       V3Z=TXR(3,3,J)
  97.       J1 = (J-1)*6 + 1
  98.       J2 = J1 + 1
  99.       J3 = J2 + 1
  100.       J4 = J3 + 1
  101.       J5 = J4 + 1
  102.       J6 = J5 + 1
  103.       A1 = H(J)*(0.5*E3*ESP+EXCEN)
  104.       XN(1,J1) = H(J)
  105. cbp,2020       XN(1,J5) = A1*XJI(1,2)
  106. cbp,2020       XN(1,J6) = A1*XJI(1,3)
  107.       XN(1,J5) = A1*V3Z
  108.       XN(1,J6) = -1.*A1*V3Y
  109.       XN(2,J2) = XN(1,J1)
  110.       XN(2,J4) = -XN(1,J5)
  111. cbp,2020       XN(2,J6) = A1*XJI(2,3)
  112.       XN(2,J6) = A1*V3X
  113.       XN(3,J3) = XN(1,J1)
  114.       XN(3,J4) = -XN(1,J6)
  115.       XN(3,J5) = -XN(2,J6)
  116.    60 CONTINUE
  117.  
  118. c     calcul de M = \sum_ptdeGauss  N^T * N \rho |J| w
  119.       DO 70 I = 1,NBNO*6
  120.       DO 71 J = I,NBNO*6
  121.       DO 72 K = 1,3
  122.       REL(I,J) = REL(I,J) + XN(K,I)*XN(K,J)*FACT
  123.    72 CONTINUE
  124.       REL(J,I) = REL(I,J)
  125.    71 CONTINUE
  126.    70 CONTINUE
  127.  
  128.    80 CONTINUE
  129. *===> FIN DE BOUCLE SUR LES POINTS DE GAUSS
  130.  
  131. *      SEGDES MINTE
  132.       SEGSUP WRK7
  133.       RETURN
  134.       END
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales