Télécharger dbbst2.eso

Retour à la liste

Numérotation des lignes :

dbbst2
  1. C DBBST2 SOURCE OF166741 23/04/25 21:15:07 11608
  2. SUBROUTINE DBBST2(TRACE,NBPGAU,IFOUR,MELE,POIGAU,QSIGAU,
  3. & ETAGAU,DZEGAU,SHPTOT,NBNO,SHP,XE,PP)
  4. c
  5. c projection de la trace de epsi2 sur la base reduite des elements icq
  6. c
  7. c entree
  8. c trace : tableau contenant la valeur de trace de epsi2 en
  9. c chaque point de gauss
  10. c et la valeur du coefficient K (2,*) P=k. tr(epsilon)
  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. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. c
  27. DIMENSION TRACE(3,*),POIGAU(*),QSIGAU(*),ETAGAU(*),DZEGAU(*),
  28. & SHPTOT(6,NBNO,*),SHP(6,*),XE(3,*),PP(4,*)
  29. DIMENSION P(3,3),T(4)
  30.  
  31. c-----------------------------------------------------------
  32. c elements icq4 et ict3 et ict6 et lineaires 3D
  33. c-----------------------------------------------------------
  34. IF (MELE.EQ.69.OR.MELE.EQ.70.OR.MELE.EQ.71.or.
  35. & MELE.EQ.73.or.MELE.EQ.74.or.MELE.EQ.75.or.
  36. & MELE.EQ.273) THEN
  37. AIRE = 0.D0
  38. TRINTG = 0.D0
  39. DO I=1,NBPGAU
  40. DO J=1,NBNO
  41. DO K =1,4
  42. SHP(K,J)=SHPTOT(K,J,I)
  43. ENDDO
  44. ENDDO
  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. r_z = POIGAU(I)*DJAC
  51. AIRE = AIRE + r_z
  52. TRINTG = TRINTG + r_z*TRACE(1,I)
  53. ENDDO
  54. trintg = TRINTG / AIRE
  55. c
  56. DO I=1,NBPGAU
  57. TRACE(1,I) = (TRINTG - TRACE(1,I))*TRACE(2,I)
  58. ENDDO
  59.  
  60. c-------------------------------------------
  61. c Element 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 calculee analytiquement voir routine BBCALC
  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. 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. P(2,3) = 1.D0/3.D0*(XE(1,5)*(XE(2,6)-XE(2,4))
  132. 1 +XE(1,8)*(XE(2,7)+XE(2,1))+XE(1,7)*(XE(2,6)-XE(2,8))
  133. 1 -XE(1,2)*(XE(2,1)+XE(2,3))+XE(1,1)*(XE(2,2)-XE(2,8))
  134. 1 +XE(1,4)*(XE(2,5)+XE(2,3))-XE(1,6)*(XE(2,7)+XE(2,5))
  135. 1 +XE(1,3)*(XE(2,2)-XE(2,4)))
  136. 2 +4.D0/9.D0*(-XE(1,4)*(XE(2,2)+XE(2,6))
  137. 2 -XE(1,8)*(XE(2,6)+XE(2,2))+XE(1,2)*(XE(2,8)+XE(2,4))
  138. 2 +XE(1,6)*(XE(2,4)+XE(2,8)))
  139. 3 +1.D0/9.D0*(XE(1,7)*(XE(2,2)-XE(2,4))
  140. 3 +XE(1,8)*(XE(2,3)+XE(2,5))
  141. 3 +XE(1,5)*(XE(2,2)-XE(2,8))+XE(1,3)*(XE(2,6)-XE(2,8))
  142. 3 -XE(1,2)*(XE(2,5)+XE(2,7))+XE(1,1)*(XE(2,6)-XE(2,4))
  143. 3 +XE(1,4)*(XE(2,1)+XE(2,7))-XE(1,6)*(XE(2,1)+XE(2,3)))
  144.  
  145. P(3,1) = P(1,3)
  146.  
  147. P(3,2) = P(2,3)
  148.  
  149. P(3,3) = 14.D0/45.D0*(XE(1,6)*(XE(2,7)-XE(2,5))
  150. 1 +XE(2,6)*(XE(1,5)-XE(1,7))+XE(1,2)*(XE(2,3)-XE(2,1))
  151. 1 +XE(2,2)*(XE(1,1)-XE(1,3)))
  152. 2 +16.D0/45.D0*(XE(1,8)*(XE(2,1)-XE(2,7))
  153. 2 +XE(2,8)*(XE(1,7)-XE(1,1))+XE(1,4)*(XE(2,5)-XE(2,3))
  154. 2 +XE(2,4)*(XE(1,3)-XE(1,5)))
  155. 3 +8.D0/45.D0*(XE(1,4)*(XE(2,2)-XE(2,6))
  156. 3 +XE(1,8)*(XE(2,6)-XE(2,2))+XE(1,2)*(XE(2,8)-XE(2,4))
  157. 3 +XE(1,6)*(XE(2,4)-XE(2,8)))
  158. 4 +2.D0/45.D0*(XE(2,4)*(XE(1,7)-XE(1,1))
  159. 4 +XE(1,8)*(XE(2,5)-XE(2,3))+XE(2,8)*(-XE(1,5)+XE(1,3))
  160. 4 +XE(1,4)*(XE(2,1)-XE(2,7)))
  161. 5 +4.D0/45.D0*(XE(2,2)*(XE(1,7)-XE(1,5))
  162. 5 +XE(1,2)*(XE(2,5)-XE(2,7))+XE(1,6)*(XE(2,1)-XE(2,3))
  163. 5 +XE(2,6)*(XE(1,3)-XE(1,1)))
  164. 6 +1.D0/90.D0*(-XE(1,5)*XE(2,7)+XE(1,3)*XE(2,1)
  165. 6 +XE(1,7)*XE(2,5)-XE(1,1)*XE(2,3))
  166. 7 +17.D0/90.D0*(-XE(1,7)*XE(2,1)-XE(1,3)*XE(2,5)
  167. 7 +XE(1,5)*XE(2,3)+XE(1,1)*XE(2,7))
  168. c
  169. c calcul des produits <tr eII . 1 > , <tr eII . eta > , <tr eII . xsi >
  170. c
  171. T(1) = 0.D0
  172. T(2) = 0.D0
  173. T(3) = 0.D0
  174. T(4) = 0.D0
  175. DO I=1,NBPGAU
  176. DO J=1,NBNO
  177. DO K =1,4
  178. SHP(K,J)=SHPTOT(K,J,I)
  179. ENDDO
  180. ENDDO
  181. if(mele.ge.76) then
  182. CALL JACOBI(XE,SHP,3,NBNO,DJAC)
  183. else
  184. CALL JACOBI(XE,SHP,2,NBNO,DJAC)
  185. endif
  186. r_z = POIGAU(I)*TRACE(1,I)*DJAC
  187. T(1) = T(1) + r_z
  188. T(2) = T(2) + r_z*QSIGAU(I)
  189. T(3) = T(3) + r_z*ETAGAU(I)
  190. if(mele.ge.76)
  191. & T(4) = T(4) + r_z*DZEGAU(I)
  192. ENDDO
  193. c
  194. c resolution du systme P.X=T
  195. c calcul du terme correctif
  196. c
  197. if (mele.ge.76) then
  198. CALL GAUSSJ(PP,4,4,T,1,1)
  199. DO I=1,NBPGAU
  200. TRACE(1,I)=(T(1)+QSIGAU(I)*T(2)+ETAGAU(I)*T(3)+DZEGAU(I)*T(4)
  201. & -TRACE(1,I))*TRACE(2,I)
  202. ENDDO
  203. else
  204. CALL GAUSSJ(P,3,3,T,1,1)
  205. DO I=1,NBPGAU
  206. TRACE(1,I)=(T(1)+QSIGAU(I)*T(2)+ETAGAU(I)*T(3)-TRACE(1,I))
  207. & *TRACE(2,I)
  208. ENDDO
  209. endif
  210. c--------------------
  211. c pas de correction pour les autres elements
  212. c--------------------
  213. ELSE
  214. DO I=1,NBPGAU
  215. TRACE(1,I)=0.D0
  216. ENDDO
  217.  
  218. ENDIF
  219.  
  220. c RETURN
  221. END
  222.  
  223.  
  224.  

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