Télécharger la plaquette Cast3M


fr en

Télécharger coq3m1.eso

Retour à la liste

Numérotation des lignes : 

coq3m1

  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