Télécharger bbst2.eso

Retour à la liste

Numérotation des lignes :

  1. C BBST2 SOURCE KICH 18/01/11 21:15:11 9690
  2. SUBROUTINE BBST2(TRACE,NBPGAU,IFOUR,MELE,POIGAU,QSIGAU,
  3. & ETAGAU,DZEGAU,SHPTOT,NBNO,SHP,XE,PP)
  4. c
  5. c
  6. c projection de la trace de epsi2 sur la base reduite des elements icq
  7. c
  8. c entree
  9. c trace : tableau contenant la valeur de trace de epsi2 en
  10. c chaque point de gauss
  11. c nbpgau : nombre de point de gauss
  12. c ifour : variable du ccoptio
  13. c mele : numero de l'element
  14. c poigau : poids d'integration
  15. c qsigau : 1ere composante sur l'element de reference
  16. c etagau : 2eme composante sur l'element de reference
  17. c dzegau : 3eme composante sur l'element de reference
  18. c shptot : valeurs des fonctions de forme
  19. c
  20. c sortie
  21. c trac : contient la correction à apporter à chaque composante diagonale de
  22. c la deformation
  23. c
  24. c
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27. c
  28. DIMENSION TRACE(*),POIGAU(*),QSIGAU(*),ETAGAU(*),DZEGAU(*)
  29. & ,SHPTOT(6,NBNO,*),SHP(6,*),XE(3,*)
  30. DIMENSION P(3,3),T(4),PP(4,4)
  31.  
  32. c
  33. c elements icq4 et ict3 et ict6 et lineaires 3D
  34. c
  35. IF (MELE.EQ.69.OR.MELE.EQ.70.OR.MELE.EQ.71.or.
  36. &MELE.EQ.73.or.MELE.EQ.74.or.MELE.EQ.75.or.MELE.EQ.273) THEN
  37. TRINTG = 0.D0
  38. aire = 0.d0
  39. DO 10 I=1,NBPGAU
  40. DO 5 J=1,NBNO
  41. DO 5 K =1,4
  42. SHP(K,J)=SHPTOT(K,J,I)
  43. 5 CONTINUE
  44. if(mele.ge.73) then
  45. CALL JACOBI(XE,SHP,3,NBNO,DJAC)
  46. else
  47. CALL JACOBI(XE,SHP,2,NBNO,DJAC)
  48. endif
  49. TRINTG = TRINTG + POIGAU(I)*TRACE(I)*DJAC
  50. AIRE = AIRE +POIGAU(I)*DJAC
  51. 10 CONTINUE
  52. trintg = TRINTG / AIRE
  53. c
  54. COEF = 2.D0
  55. IF (IFOUR .EQ. 0 ) COEF = 3.D0
  56. DO 20 I=1,NBPGAU
  57. TRACE(I) = (TRINTG - TRACE(I))/COEF
  58. 20 CONTINUE
  59. RETURN
  60. c
  61. c élement ICQ8 et quadratiques 3D
  62. c
  63. ELSE IF ( MELE.EQ.72.or.MELE.GE.76) THEN
  64. c
  65. c mele 72 ICQ8 matrice P calculée analytiquement voir routine BBCAL2
  66. c
  67. P(1,1) = 2.D0/3.D0*(XE(1,1)*(XE(2,2)-XE(2,8))
  68. 1 +XE(1,2)*(XE(2,3)-XE(2,1))
  69. 1 +XE(1,3)*(XE(2,4)-XE(2,2))+XE(1,4)*(XE(2,5)-XE(2,3))
  70. 2 +XE(1,5)*(XE(2,6)-XE(2,4))+XE(1,6)*(XE(2,7)-XE(2,5))
  71. 3 +XE(1,7)*(XE(2,8)-XE(2,6))+XE(1,8)*(XE(2,1)-XE(2,7)))
  72. 4 +1.D0/6.D0*((XE(1,1)-XE(1,5))*(XE(2,7)-XE(2,3))
  73. 5 +(XE(1,3)-XE(1,7))*(XE(2,1)-XE(2,5)))
  74.  
  75. P(1,2) = 5.D0/9.D0*(-XE(2,2)*(XE(1,1)+XE(1,3))
  76. 1 +XE(1,2)*(XE(2,1)+XE(2,3))+XE(1,6)*(-XE(2,5)-XE(2,7))
  77. 1 +XE(2,6)*(XE(1,5)+XE(1,7)))
  78. 2 +4.D0/9.D0*(XE(1,8)*(XE(2,7)+XE(2,2)-XE(2,6)-XE(2,1))
  79. 2 +XE(2,8)*(-XE(1,7)-XE(1,2)+XE(1,6)+XE(1,1))
  80. 2 +XE(1,4)*(XE(2,2)-XE(2,6)+XE(2,5)-XE(2,3))
  81. 2 +XE(2,4)*(-XE(1,2)+XE(1,6)-XE(1,5)+XE(1,3)))
  82. 3 +7.D0/45.D0*(XE(1,2)*(XE(2,5)+XE(2,7))
  83. 3 -XE(2,2)*(XE(1,5)+XE(1,7))-XE(1,6)*(XE(2,1)+XE(2,3))
  84. 3 +XE(2,6)*(XE(1,1)+XE(1,3)))
  85. 4 +8.D0/15.D0*(XE(1,6)*XE(2,2)-XE(1,2)*XE(2,6))
  86. 5 +7.D0/90.D0*(XE(1,7)*XE(2,1)-XE(1,3)*XE(2,5)
  87. 5 +XE(1,5)*XE(2,3)-XE(1,1)*XE(2,7))
  88. 6 +1.D0/30.D0*(-XE(1,7)*XE(2,3)+XE(1,3)*XE(2,7)
  89. 6 -XE(1,5)*XE(2,1)+XE(1,1)*XE(2,5))
  90.  
  91.  
  92. P(1,3) = 5.D0/9.D0*(-XE(1,8)*(XE(2,7)+XE(2,1))
  93. 1 +XE(2,8)*(XE(1,7)+XE(1,1))
  94. 1 +XE(1,4)*(XE(2,3)+XE(2,5))
  95. 1 -XE(2,4)*(XE(1,3)+XE(1,5)))
  96. 2 +4.D0/9.D0*((XE(1,8)-XE(1,4))*(XE(2,2)+XE(2,6))
  97. 2 +(-XE(2,8)+XE(2,4))*(XE(1,2)+XE(1,6))
  98. 2 +XE(1,2)*(XE(2,1)-XE(2,3))+XE(2,2)*(-XE(1,1)+XE(1,3))
  99. 2 +XE(1,6)*(XE(2,7)-XE(2,5))+XE(2,6)*(-XE(1,7)+XE(1,5)))
  100. 3 +7.D0/45.D0*(-XE(1,8)*(XE(2,3)+XE(2,5))
  101. 3 +XE(2,8)*(XE(1,3)+XE(1,5))
  102. 3 +XE(1,4)*(XE(2,1)+XE(2,7))
  103. 3 -XE(2,4)*(XE(1,1)+XE(1,7)))
  104. 4 +1.D0/30.D0*(-XE(1,7)*XE(2,3)+XE(1,3)*XE(2,7)
  105. 4 +XE(1,5)*XE(2,1)-XE(1,1)*XE(2,5))
  106. 5 +7.D0/90.D0*(XE(1,7)*XE(2,5)-XE(1,3)*XE(2,1)
  107. 5 -XE(1,5)*XE(2,7)+XE(1,1)*XE(2,3))
  108. 6 +8.D0/15.D0*(XE(1,8)*XE(2,4)-XE(1,4)*XE(2,8))
  109.  
  110. P(2,1) = P(1,2)
  111.  
  112. P(2,2) = 16.D0/45.D0*(XE(2,6)*(XE(1,5)-XE(1,7))
  113. 1 +XE(1,6)*(XE(2,7)-XE(2,5))+XE(1,2)*(XE(2,3)-XE(2,1))
  114. 1 +XE(2,2)*(XE(1,1)-XE(1,3)))
  115. 2 +14.D0/45.D0*(XE(2,4)*(XE(1,3)-XE(1,5))
  116. 2 +XE(1,4)*(XE(2,5)-XE(2,3))+XE(1,8)*(XE(2,1)-XE(2,7))
  117. 2 +XE(2,8)*(XE(1,7)-XE(1,1)))
  118. 3 +8.D0/45.D0*(XE(1,4)*(XE(2,2)-XE(2,6))
  119. 3 +XE(1,8)*(XE(2,6)-XE(2,2))+XE(1,2)*(XE(2,8)-XE(2,4))
  120. 3 +XE(1,6)*(XE(2,4)-XE(2,8)))
  121. 4 +2.D0/45.D0*(XE(2,2)*(XE(1,5)-XE(1,7))
  122. 4 +XE(1,2)*(XE(2,7)-XE(2,5)) +XE(1,6)*(XE(2,3)-XE(2,1))
  123. 4 +XE(2,6)*(XE(1,1)-XE(1,3)))
  124. 5 +4.D0/45.D0*(XE(2,4)*(XE(1,1)-XE(1,7))
  125. 5 +XE(1,4)*(XE(2,7)-XE(2,1)) +XE(1,8)*(XE(2,3)-XE(2,5))
  126. 5 +XE(2,8)*(XE(1,5)-XE(1,3)))
  127. 6 +17.D0/90.D0*(XE(1,7)*XE(2,5)+XE(1,3)*XE(2,1)
  128. 6 -XE(1,5)*XE(2,7)-XE(1,1)*XE(2,3))
  129. 7 +1.D0/90.D0*(-XE(1,7)*XE(2,1)-XE(1,3)*XE(2,5)
  130. 7 +XE(1,5)*XE(2,3)+XE(1,1)*XE(2,7))
  131.  
  132.  
  133. P(2,3) = 1.D0/3.D0*(XE(1,5)*(XE(2,6)-XE(2,4))
  134. 1 +XE(1,8)*(XE(2,7)+XE(2,1))+XE(1,7)*(XE(2,6)-XE(2,8))
  135. 1 -XE(1,2)*(XE(2,1)+XE(2,3))+XE(1,1)*(XE(2,2)-XE(2,8))
  136. 1 +XE(1,4)*(XE(2,5)+XE(2,3))-XE(1,6)*(XE(2,7)+XE(2,5))
  137. 1 +XE(1,3)*(XE(2,2)-XE(2,4)))
  138. 2 +4.D0/9.D0*(-XE(1,4)*(XE(2,2)+XE(2,6))
  139. 2 -XE(1,8)*(XE(2,6)+XE(2,2))+XE(1,2)*(XE(2,8)+XE(2,4))
  140. 2 +XE(1,6)*(XE(2,4)+XE(2,8)))
  141. 3 +1.D0/9.D0*(XE(1,7)*(XE(2,2)-XE(2,4))
  142. 3 +XE(1,8)*(XE(2,3)+XE(2,5))
  143. 3 +XE(1,5)*(XE(2,2)-XE(2,8))+XE(1,3)*(XE(2,6)-XE(2,8))
  144. 3 -XE(1,2)*(XE(2,5)+XE(2,7))+XE(1,1)*(XE(2,6)-XE(2,4))
  145. 3 +XE(1,4)*(XE(2,1)+XE(2,7))-XE(1,6)*(XE(2,1)+XE(2,3)))
  146.  
  147.  
  148. P(3,1) = P(1,3)
  149.  
  150. P(3,2) = P(2,3)
  151.  
  152. P(3,3) = 14.D0/45.D0*(XE(1,6)*(XE(2,7)-XE(2,5))
  153. 1 +XE(2,6)*(XE(1,5)-XE(1,7))+XE(1,2)*(XE(2,3)-XE(2,1))
  154. 1 +XE(2,2)*(XE(1,1)-XE(1,3)))
  155. 2 +16.D0/45.D0*(XE(1,8)*(XE(2,1)-XE(2,7))
  156. 2 +XE(2,8)*(XE(1,7)-XE(1,1))+XE(1,4)*(XE(2,5)-XE(2,3))
  157. 2 +XE(2,4)*(XE(1,3)-XE(1,5)))
  158. 3 +8.D0/45.D0*(XE(1,4)*(XE(2,2)-XE(2,6))
  159. 3 +XE(1,8)*(XE(2,6)-XE(2,2))+XE(1,2)*(XE(2,8)-XE(2,4))
  160. 3 +XE(1,6)*(XE(2,4)-XE(2,8)))
  161. 4 +2.D0/45.D0*(XE(2,4)*(XE(1,7)-XE(1,1))
  162. 4 +XE(1,8)*(XE(2,5)-XE(2,3))+XE(2,8)*(-XE(1,5)+XE(1,3))
  163. 4 +XE(1,4)*(XE(2,1)-XE(2,7)))
  164. 5 +4.D0/45.D0*(XE(2,2)*(XE(1,7)-XE(1,5))
  165. 5 +XE(1,2)*(XE(2,5)-XE(2,7))+XE(1,6)*(XE(2,1)-XE(2,3))
  166. 5 +XE(2,6)*(XE(1,3)-XE(1,1)))
  167. 6 +1.D0/90.D0*(-XE(1,5)*XE(2,7)+XE(1,3)*XE(2,1)
  168. 6 +XE(1,7)*XE(2,5)-XE(1,1)*XE(2,3))
  169. 7 +17.D0/90.D0*(-XE(1,7)*XE(2,1)-XE(1,3)*XE(2,5)
  170. 7 +XE(1,5)*XE(2,3)+XE(1,1)*XE(2,7))
  171.  
  172. c
  173. c calcul des produits <tr eII . 1 > , <tr eII . eta > , <tr eII . xsi >
  174. c
  175. T(1) = 0.D0
  176. T(2) = 0.D0
  177. T(3) = 0.D0
  178. T(4) = 0.D0
  179. DO 40 I=1,NBPGAU
  180. DO 30 J=1,NBNO
  181. DO 30 K =1,4
  182. SHP(K,J)=SHPTOT(K,J,I)
  183. 30 CONTINUE
  184. if(mele.ge.76) then
  185. CALL JACOBI(XE,SHP,3,NBNO,DJAC)
  186. else
  187. CALL JACOBI(XE,SHP,2,NBNO,DJAC)
  188. endif
  189. T(1) = T(1) + POIGAU(I)*TRACE(I)*DJAC
  190. T(2) = T(2) + POIGAU(I)*TRACE(I)*DJAC*QSIGAU(I)
  191. T(3) = T(3) + POIGAU(I)*TRACE(I)*DJAC*ETAGAU(I)
  192. if(mele.ge.76)
  193. & T(4) = T(4) + POIGAU(I)*TRACE(I)*DJAC*DZEGAU(I)
  194. 40 CONTINUE
  195. *
  196. c resolution du systme P.X=T
  197. c
  198. if(mele.ge.76) then
  199.  
  200. CALL GAUSSJ(PP,4,4,T,1,1)
  201. COEF = 3.D0
  202. DO 55 I=1,NBPGAU
  203. TRACE(I)=(T(1)+QSIGAU(I)*T(2)+ETAGAU(I)*T(3)+DZEGAU(I)*T(4)
  204. &-TRACE(I))/COEF
  205. 55 CONTINUE
  206. else
  207.  
  208. CALL GAUSSJ(P,3,3,T,1,1)
  209. *
  210. c calcul du terme correctif
  211. c
  212. COEF = 2.D0
  213. IF (IFOUR .EQ. 0 ) COEF = 3.D0
  214. DO 50 I=1,NBPGAU
  215. TRACE(I)=(T(1)+QSIGAU(I)*T(2)+ETAGAU(I)*T(3)-TRACE(I))/COEF
  216. 50 CONTINUE
  217. endif
  218. c
  219. RETURN
  220. c
  221. ENDIF
  222. c
  223. c pas de correction pour les autres éléments
  224. c
  225. DO 70 I=1,NBPGAU
  226. TRACE(I)=0.D0
  227. 70 CONTINUE
  228. c
  229. c
  230. RETURN
  231. END
  232.  
  233.  
  234.  
  235.  
  236.  

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