Télécharger coq8kc.eso

Retour à la liste

Numérotation des lignes :

  1. C COQ8KC SOURCE CHAT 05/01/12 22:22:01 5004
  2. SUBROUTINE COQ8KC(NBNO,RHOK,NBPGAU,ESP,EXCEN,WRK1,MINTE,MINTE2,
  3. . VROT)
  4. C
  5. C |--------------------------------------------------------------|
  6. C | NOUVELLE PROCEDURE DE CALCUL DE LA MATRICE DE RIGIDITE |
  7. C | CENTRIFUGE AVEC UN ELEMENT DE COQUE A 6 OU 8 NOEUDS |
  8. C | |
  9. C | INSPIRE DU CALCUL DE LA MATRICE DE MASSE |
  10. C |--------------------------------------------------------------|
  11. C | ENTREES |
  12. C | NBPGAU : NOMBRE DE POINTS DE GAUSS. |
  13. C | MINTE : FONCTIONS DE FORME AUX POINTS DE GAUSS |
  14. C | MINTE2 : FONCTIONS DE FORME AUX NOEUDS |
  15. C | RHOK : MASSE VOLUMIQUE. |
  16. C | ESP : EPAISSEUR. |
  17. C | EXCEN : EXCENTREMENT. |
  18. C | NBNO : NOMBRE DE NOEUDS |
  19. C | VROT : VECTEUR VITESSE ROTATION |
  20. C | Didier COMBESCURE mars 2003 |
  21. C |--------------------------------------------------------------|
  22. C
  23. C
  24. C
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8 (A-H,O-Z)
  27. -INC SMINTE
  28. SEGMENT WRK7
  29. REAL*8 XJI(3,3),TXR(3,3,NBNO),FINT(3,LRE),XJ(3,3),B(3,3)
  30. REAL*8 TH(NBNO),EXC(NBNO),H(NBNO)
  31. ENDSEGMENT
  32. SEGMENT/WRK1/(REL(LRE,LRE)*D,XE(3,NBNO)*D)
  33. DIMENSION ROME(6,6),VROT(*)
  34. SEGACT MINTE
  35. SEGACT WRK1*MOD
  36. LRE=6*NBNO
  37. SEGINI WRK7
  38. DO 5 I = 1,NBNO
  39. EXC(I)=EXCEN
  40. 5 TH(I) = ESP
  41. C
  42. C
  43. C
  44. DO 9 IN=1,6
  45. DO 9 IM=1,6
  46. 9 ROME(IN,IM) = 0.D0
  47. C
  48. ROME(1,1) = (-1.)*((VROT(2)**2) + (VROT(3)**2))
  49. ROME(2,2) = (-1.)*((VROT(1)**2) + (VROT(3)**2))
  50. ROME(3,3) = (-1.)*((VROT(1)**2) + (VROT(2)**2))
  51. ROME(1,2) = VROT(1)*VROT(2)
  52. ROME(1,3) = VROT(1)*VROT(3)
  53. ROME(2,3) = VROT(2)*VROT(3)
  54. ROME(2,1) = ROME(1,2)
  55. ROME(3,1) = ROME(1,3)
  56. ROME(3,2) = ROME(2,3)
  57. C
  58. C INITIALISATION DE LA MATRICE MASSE
  59. C
  60. DO 10 I = 1,6*NBNO
  61. DO 10 J = 1,6*NBNO
  62. REL(I,J) = 0.D0
  63. 10 CONTINUE
  64. *
  65. * CORRECTION RNUR LE 12 / 9 / 90
  66. *
  67. SEGACT MINTE2
  68. CALL CQ8LOC(XE,NBNO,MINTE2.SHPTOT,TXR,IRR)
  69. SEGDES MINTE2
  70. *
  71. DO 80 LX = 1,NBPGAU
  72. E3 = DZEGAU(LX)
  73. WT = POIGAU (LX)
  74. DO 20 I=1,NBNO
  75. 20 H(I)=SHPTOT(1,I,LX)
  76. CALL CQ8JCE(LX,NBNO,E3,XE,TH,EXC,TXR,SHPTOT,B,DET,IRR)
  77. FACT = WT*DET*RHOK
  78. DO 30 I = 1,3
  79. DO 30 J = 1,NBNO*6
  80. 30 FINT(I,J) = 0.D0
  81. DO 60 J = 1,NBNO
  82. DO 40 I = 1,3
  83. 40 XJI(I,I) = 0.D0
  84. XJI(1,2) = TXR(1,1,J)*TXR(2,2,J) - TXR(2,1,J)*TXR(1,2,J)
  85. XJI(1,3) = TXR(1,1,J)*TXR(3,2,J) - TXR(1,2,J)*TXR(3,1,J)
  86. XJI(2,3) = TXR(2,1,J)*TXR(3,2,J) - TXR(2,2,J)*TXR(3,1,J)
  87. DO 50 IK = 1,3
  88. DO 50 JK = IK,3
  89. 50 XJI(JK,IK) = -XJI(IK,JK)
  90. J1 = (J-1)*6 + 1
  91. J2 = J1 + 1
  92. J3 = J2 + 1
  93. J4 = J3 + 1
  94. J5 = J4 + 1
  95. J6 = J5 + 1
  96. A1 = H(J)*(0.5*E3*ESP+EXCEN)
  97. FINT(1,J1) = H(J)
  98. FINT(1,J5) = A1*XJI(1,2)
  99. FINT(1,J6) = A1*XJI(1,3)
  100. FINT(2,J2) = FINT(1,J1)
  101. FINT(2,J4) = -FINT(1,J5)
  102. FINT(2,J6) = A1*XJI(2,3)
  103. FINT(3,J3) = FINT(1,J1)
  104. FINT(3,J4) = -FINT(1,J6)
  105. 60 FINT(3,J5) = -FINT(2,J6)
  106. DO 70 I = 1,NBNO*6
  107. DO 70 J = I,NBNO*6
  108. DO 70 K = 1,3
  109. REL(I,J) = REL(I,J) + FINT(K,I)*FINT(K,J)*FACT
  110. REL(J,I) = REL(I,J)
  111. 70 CONTINUE
  112. 80 CONTINUE
  113. DO 90 I = 1,NBNO
  114. DO 90 J = 1,NBNO
  115. DO 90 IN = 1,3
  116. DO 90 IM = 1,3
  117. REL((6*I)-6+IN,(6*J)-6+IM)=REL((6*I)-6+IN,(6*J)-6+IM)
  118. . *ROME(IN,IM)
  119. REL((6*I)-6+IN,(6*J)-3+IM)=REL((6*I)-6+IN,(6*J)-3+IM)
  120. . *ROME(IN,IM)
  121. REL((6*I)-3+IN,(6*J)-6+IM)=REL((6*I)-3+IN,(6*J)-6+IM)
  122. . *ROME(IN,IM)
  123. REL((6*I)-3+IN,(6*J)-3+IM)=REL((6*I)-3+IN,(6*J)-3+IM)
  124. . *ROME(IN,IM)
  125. 90 CONTINUE
  126. SEGDES WRK1
  127. SEGDES MINTE
  128. SEGSUP WRK7
  129. RETURN
  130. END
  131.  
  132.  
  133.  
  134.  

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