Télécharger coq8ma.eso

Retour à la liste

Numérotation des lignes :

  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
  48. CALL CQ8LOC(XE,NBNO,MINTE2.SHPTOT,TXR,IRR)
  49. SEGDES MINTE2
  50. *
  51. DO 80 LX = 1,NBPGAU
  52. E3 = DZEGAU(LX)
  53. WT = POIGAU (LX)
  54. DO 20 I=1,NBNO
  55. 20 H(I)=SHPTOT(1,I,LX)
  56. CALL CQ8JCE(LX,NBNO,E3,XE,TH,EXC,TXR,SHPTOT,B,DET,IRR)
  57. FACT = WT*DET*RHOK
  58. DO 30 I = 1,3
  59. DO 30 J = 1,NBNO*6
  60. 30 FINT(I,J) = 0.D0
  61. DO 60 J = 1,NBNO
  62. DO 40 I = 1,3
  63. 40 XJI(I,I) = 0.D0
  64. XJI(1,2) = TXR(1,1,J)*TXR(2,2,J) - TXR(2,1,J)*TXR(1,2,J)
  65. XJI(1,3) = TXR(1,1,J)*TXR(3,2,J) - TXR(1,2,J)*TXR(3,1,J)
  66. XJI(2,3) = TXR(2,1,J)*TXR(3,2,J) - TXR(2,2,J)*TXR(3,1,J)
  67. DO 50 IK = 1,3
  68. DO 50 JK = IK,3
  69. 50 XJI(JK,IK) = -XJI(IK,JK)
  70. J1 = (J-1)*6 + 1
  71. J2 = J1 + 1
  72. J3 = J2 + 1
  73. J4 = J3 + 1
  74. J5 = J4 + 1
  75. J6 = J5 + 1
  76. A1 = H(J)*(0.5*E3*ESP+EXCEN)
  77. FINT(1,J1) = H(J)
  78. FINT(1,J5) = A1*XJI(1,2)
  79. FINT(1,J6) = A1*XJI(1,3)
  80. FINT(2,J2) = FINT(1,J1)
  81. FINT(2,J4) = -FINT(1,J5)
  82. FINT(2,J6) = A1*XJI(2,3)
  83. FINT(3,J3) = FINT(1,J1)
  84. FINT(3,J4) = -FINT(1,J6)
  85. 60 FINT(3,J5) = -FINT(2,J6)
  86. DO 70 I = 1,NBNO*6
  87. DO 70 J = I,NBNO*6
  88. DO 70 K = 1,3
  89. 70 REL(I,J) = REL(I,J) + FINT(K,I)*FINT(K,J)*FACT
  90. 80 CONTINUE
  91. DO 90 I = 1,NBNO*6
  92. DO 90 J = I,NBNO*6
  93. 90 REL(J,I) = REL(I,J)
  94. SEGDES WRK1
  95. SEGDES MINTE
  96. SEGSUP WRK7
  97. RETURN
  98. END
  99.  
  100.  
  101.  

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