Télécharger dbbst2.eso

Retour à la liste

Numérotation des lignes :

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

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