Télécharger coq3m1.eso

Retour à la liste

Numérotation des lignes :

  1. C COQ3M1 SOURCE CHAT 05/01/12 22:21:24 5004
  2. SUBROUTINE COQ3M1(XE,RHO,XEL,BPSS,BB,REWO,ILUMP)
  3. c=======================================================================
  4. c
  5. c calcule la matrice de masse de l element coq3
  6. c
  7. c entree
  8. c xe(3,3)=coodonnees de l element
  9. c rho =masse volumique * epaisseur
  10. c ilump = 1 si l'opérateur LUMP est appelé , 0 sinon
  11. c travail
  12. c xel(3,3) =coordonnees locales de l element
  13. c bpss(3,3) =matrice de passage
  14. c bb(9) =stocke les fonctions de formes de flexion
  15. c sorties
  16. c rewo(18,18)=matrice de masse repere local puis global
  17. c
  18. c code fevrier 85 ebersolt
  19. c
  20. c=======================================================================
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. DIMENSION XE(3,*),XEL(3,*),BPSS(3,*),REWO(18,*),BB(*)
  24. DIMENSION REWOLP(18,18)
  25. DIMENSION XX(3),YY(3)
  26. DATA XX/0.5D0,0.5D0,0.0D0/
  27. DATA YY/0.0D0,0.5D0,0.5D0/
  28. DATA UNSIX,UN12/.166666666666666666D0,.833333333333333333D-1/
  29. DATA UNTIER/.33333333333333333D0/
  30. DATA IZERO/0/
  31. c
  32. c matrice de passage
  33. c
  34. CALL VPAST(XE,BPSS)
  35. c
  36. c coordonnees locales
  37. c
  38. CALL VCORLC(XE,XEL,BPSS)
  39. c
  40. c mise a 0 de la matrice de masse
  41. c
  42. CALL ZERO(REWO,18,18)
  43. X21=XEL(1,2)-XEL(1,1)
  44. Y31=XEL(2,3)-XEL(2,1)
  45. SURF=X21*Y31*.5D0*RHO
  46. c
  47. c termes diagonaux de la membrane
  48. c
  49. DO 100 IA=1,13,6
  50. REWO(IA ,IA )=UNSIX
  51. REWO(IA+1,IA+1)=UNSIX
  52. DO 110 IB=1,13,6
  53. IF(IB.EQ.IA) GOTO 110
  54. REWO(IA ,IB )=UN12
  55. REWO(IA+1,IB+1)=UN12
  56. 110 CONTINUE
  57. 100 CONTINUE
  58. c
  59. c partie flexion integration numerique
  60. c
  61. c ia numero du point de gauss
  62. c ib numero d un noeud
  63. c ic numero d un noeud
  64. c
  65. DO 200 IA=1,3
  66. CALL MFDKT(XX(IA),YY(IA),XEL,BB)
  67. DO 210 IB=1,3
  68. IBDERI=(IB-1)*6+2
  69. IBDEBB=(IB-1)*3
  70. DO 210 IC=1,3
  71. ICDERI=(IC-1)*6+2
  72. ICDEBB=(IC-1)*3
  73. DO 220 ID=1,3
  74. DO 220 IE=1,3
  75. REWO(IBDERI+ID,ICDERI+IE)=REWO(IBDERI+ID,ICDERI+IE)
  76. 1 +BB(IBDEBB+ID)*BB(ICDEBB+IE)*UNTIER
  77. 220 CONTINUE
  78. 210 CONTINUE
  79. 200 CONTINUE
  80. c
  81. c multiplication par rho*surf
  82. c
  83. DO 300 IA=1,18
  84. DO 300 IB=1,18
  85. REWO(IA,IB)=REWO(IA,IB)*SURF
  86. 300 CONTINUE
  87. c
  88. c diagonalisation dans le cas de l'opérateur LUMP
  89. c
  90. c REWO est rangé dans l'ordre i noeud x(UX UY UZ RX RY RZ) ....
  91. c
  92. IF ( ILUMP .EQ. 1 ) THEN
  93. CALL LUMP3(REWO)
  94. ENDIF
  95. c
  96. c
  97. c changement de repere
  98. c
  99. CALL TRANSK(REWO,BPSS,18,3,IZERO)
  100. c
  101. RETURN
  102. END
  103.  
  104.  
  105.  

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