Télécharger bbar.eso

Retour à la liste

Numérotation des lignes :

  1. C BBAR SOURCE KICH 18/01/12 21:15:02 9691
  2.  
  3. SUBROUTINE BBAR(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  4. 1 MELE,NBNO,LRE,IFOU,NST,XE,DJAC,A,BB,BGENE)
  5.  
  6. C=======================================================================
  7. C= B B A R =
  8. C= ----------- =
  9. C= Fonction : =
  10. C= ---------- =
  11. C= CALCUL DE LA MATRICE B-BARRE - ELEMENTS INCOMPRESSIBLES 'IC--' =
  12. C= - EN 2D : ELEMENTS ICT3, ICT6, ICQ4, ICQ8 =
  13. C= - EN 3D : ELEMENTS ICC8, IC20, ICT4, ICY5 =
  14. C= ELEMENTS IC10, ICP6, IC15, IC13 -> A voir =
  15. C= =
  16. C= Calcul de la matrice B reliant les deformations en un point d'un =
  17. C= element fini aux ddls de deplacement aux noeuds de cet element =
  18. C= Le jacobien est egalement evalue au point de Gauss pour verifier =
  19. C= ulterieurement si l'element fini n'est pas trop distordu. =
  20. C= =
  21. C= Parametres : (E)=Entree (S)=Sortie =
  22. C= ------------ =
  23. C= IGAU (E) Numero du point de Gauss considere =
  24. C= NBPGAU (E) Nombre de points de Gauss de l'element fini =
  25. C= POIGAU,QSIGAU (E) | Poids et coordonnees de reference des =
  26. C= ETAGAU,DZEGAU (E) | differents points de Gauss de l'element =
  27. C= MELE (E) Type de l'element fini (cf. NOMTP dans bdata.eso) =
  28. C= NBNO (E) Nombre de noeuds de l'element fini =
  29. C= LRE (E) Nombre de DDL de l'element fini =
  30. C= IFOU (E) Mode de calcul utilise (cf. IFOUR dans CCOPTIO) =
  31. C= NST (E) Nombre de composantes de deformations =
  32. C= XE (E) Coordonnees des noeuds de l'element fini etudie =
  33. C= DJAC (S) Jacobien au point de Gauss etudie =
  34. C= BGENE (E/S) Matrice de gradients (B) calcule au point de Gauss =
  35. C= A,BB (S) Matrices utiles pour la methode BBar =
  36. C=======================================================================
  37. C LRE = NOMBRE DE COLONNES DE LA MATRICE B
  38. C A = COEFFICIENTS DE MODIFICATION
  39. C BB(3,LRE) = MATRICE B-BARRE DILATATION
  40. C BGENE(6,LRE) = MATRICE B
  41. C BGENE(6,LRE) = MATRICE B-BARRE
  42. C=======================================================================
  43.  
  44. IMPLICIT INTEGER(I-N)
  45. IMPLICIT REAL*8(A-H,O-Z)
  46.  
  47. PARAMETER (XZero=0., XUn=1., X1s2=0.5,
  48. & X1s3=0.333333333333333333333333333333333333333333)
  49.  
  50. DIMENSION XE(3,*),BGENE(NST,*),
  51. & POIGAU(*),QSIGAU(*),ETAGAU(*),DZEGAU(*),
  52. & A(4,*),BB(3,*)
  53.  
  54. *W WRITE(*,*) 'Entree dans le sousprogramme BBAR'
  55. *W WRITE(*,*) 'Element',MELE
  56. *W WRITE(*,*) 'Point Gauss: xsi=',QSIGAU(IGAU),'eta=',ETAGAU(IGAU),
  57. *W & 'dze=',DZEGAU(IGAU)
  58.  
  59. IF ( MELE.LT.69 .OR. MELE.GT.78 ) GOTO 666
  60. C-----------------------------------------------------------------------
  61. C---- Elements incompressibles (MFR = 31) ------------------------------
  62. C-----------------------------------------------------------------------
  63. C NOM : ICT3, ICQ4, ICT6, ICQ8, ICC8, ICT4, ICP6, IC20, IC10, IC15
  64. C MELE : 69 , 70 , 71 , 72 , 73 , 74 , 75 , 76 , 77 , 78
  65. C NOM : ICY5, IC13
  66. C MELE : 273 , 274 ,
  67. C-----------------------------------------------------------------------
  68. GOTO ( 69, 70, 71, 72, 73, 74, 75, 76, 77, 78 ) , (MELE-68)
  69. IF(MELE.EQ.273) GOTO 273
  70. IF(MELE.EQ.274) GOTO 274
  71. GOTO 999
  72.  
  73. C-----------------------------------------------------------------------
  74. C----- Element massif bidimensionnel ICT3 ------------------------------
  75. C-----------------------------------------------------------------------
  76. 69 CONTINUE
  77. *W WRITE(*,*) 'Element ICT3',IFOU
  78. IFR = IFOU+4
  79. GOTO (666,691,691,693,666),IFR
  80. GOTO 999
  81. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  82. 691 CONTINUE
  83. K = 1
  84. DO i = 1,NBNO
  85. BGENE(2,K) = X1s2 * (BB(1,K)-BGENE(1,K))
  86. BGENE(1,K) = X1s2 * (BB(1,K)+BGENE(1,K))
  87. K = K+1
  88. BGENE(1,K) = X1s2 * (BB(2,K)-BGENE(2,K))
  89. BGENE(2,K) = X1s2 * (BB(2,K)+BGENE(2,K))
  90. K = K+1
  91. ENDDO
  92. GOTO 666
  93. *----- Axisymetrie (IFOU=0)
  94. 693 CONTINUE
  95. K = 1
  96. DO i = 1,NBNO
  97. r_z = X1s3 * (BB(1,K)-BGENE(1,K)+BB(3,K)-BGENE(3,K))
  98. BGENE(1,K) = BGENE(1,K) + r_z
  99. BGENE(2,K) = r_z
  100. BGENE(3,K) = BGENE(3,K) + r_z
  101. K = K + 1
  102. r_z = X1s3 * (BB(2,K)-BGENE(2,K))
  103. BGENE(1,K) = r_z
  104. BGENE(2,K) = BGENE(2,K) + r_z
  105. BGENE(3,K) = r_z
  106. K = K + 1
  107. ENDDO
  108. GOTO 666
  109.  
  110. C-----------------------------------------------------------------------
  111. C----- Element massif bidimensionnel ICQ4 ------------------------------
  112. C-----------------------------------------------------------------------
  113. 70 CONTINUE
  114. *W WRITE(*,*) 'Element ICQ4',IFOU
  115. IFR = IFOU+4
  116. GOTO (666,701,701,703,666),IFR
  117. GOTO 999
  118. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  119. 701 CONTINUE
  120. K = 1
  121. DO i = 1,NBNO
  122. BGENE(2,K) = X1s2 * (BB(1,K)-BGENE(1,K))
  123. BGENE(1,K) = X1s2 * (BB(1,K)+BGENE(1,K))
  124. K = K + 1
  125. BGENE(1,K) = X1s2 * (BB(2,K)-BGENE(2,K))
  126. BGENE(2,K) = X1s2 * (BB(2,K)+BGENE(2,K))
  127. K = K + 1
  128. ENDDO
  129. GOTO 666
  130. *----- Axisymetrie (IFOU=0)
  131. 703 CONTINUE
  132. K = 1
  133. DO i = 1,NBNO
  134. r_z = X1s3 * (BB(1,K)-BGENE(1,K)+BB(3,K)-BGENE(3,K))
  135. BGENE(1,K) = BGENE(1,K) + r_z
  136. BGENE(2,K) = r_z
  137. BGENE(3,K) = BGENE(3,K) + r_z
  138. K = K + 1
  139. r_z = X1s3 * (BB(2,K)-BGENE(2,K))
  140. BGENE(1,K) = r_z
  141. BGENE(2,K) = BGENE(2,K) + r_z
  142. BGENE(3,K) = r_z
  143. K = K + 1
  144. ENDDO
  145. GOTO 666
  146.  
  147. C-----------------------------------------------------------------------
  148. C----- Element massif bidimensionnel ICT6 ------------------------------
  149. C-----------------------------------------------------------------------
  150. 71 CONTINUE
  151. *W WRITE(*,*) 'Element ICT6',IFOU
  152. IFR = IFOU+4
  153. GOTO (666,711,711,713,666),IFR
  154. GOTO 999
  155. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  156. 711 CONTINUE
  157. K = 1
  158. DO i = 1,NBNO
  159. BGENE(2,K) = X1s2 * (BB(1,K)-BGENE(1,K))
  160. BGENE(1,K) = X1s2 * (BB(1,K)+BGENE(1,K))
  161. K = K + 1
  162. BGENE(1,K) = X1s2 * (BB(2,K)-BGENE(2,K))
  163. BGENE(2,K) = X1s2 * (BB(2,K)+BGENE(2,K))
  164. K = K + 1
  165. ENDDO
  166. GOTO 666
  167. *----- Axisymetrie (IFOU=0)
  168. 713 CONTINUE
  169. K = 1
  170. DO i = 1,NBNO
  171. r_z = X1s3 * (BB(1,K)-BGENE(1,K)+BB(3,K)-BGENE(3,K))
  172. BGENE(1,K) = BGENE(1,K) + r_z
  173. BGENE(2,K) = r_z
  174. BGENE(3,K) = BGENE(3,K) + r_z
  175. K = K + 1
  176. r_z = X1s3 * (BB(2,K)-BGENE(2,K))
  177. BGENE(1,K) = r_z
  178. BGENE(2,K) = BGENE(2,K) + r_z
  179. BGENE(3,K) = r_z
  180. K = K + 1
  181. ENDDO
  182. GOTO 666
  183.  
  184. C-----------------------------------------------------------------------
  185. C----- Element massif bidimensionnel ICQ8 ------------------------------
  186. C-----------------------------------------------------------------------
  187. 72 CONTINUE
  188. *W WRITE(*,*) 'Element ICQ8',IFOU
  189. QSI_z = QSIGAU(IGAU)
  190. ETA_z = ETAGAU(IGAU)
  191. IFR = IFOU+4
  192. GOTO (666,721,721,723,666),IFR
  193. GOTO 999
  194. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  195. 721 CONTINUE
  196. *----- Calculs des composantes de BB-DILATATION
  197. BB(1, 1) = A(1, 1) + A(2, 1)*QSI_z + A(3, 1)*ETA_z
  198. BB(2, 2) = A(1, 2) + A(2, 2)*QSI_z + A(3, 2)*ETA_z
  199. BB(1, 3) = A(1, 3) + A(2, 3)*QSI_z + A(3, 3)*ETA_z
  200. BB(2, 4) = A(1, 4) + A(2, 4)*QSI_z + A(3, 4)*ETA_z
  201. BB(1, 5) = A(1, 5) + A(2, 5)*QSI_z + A(3, 5)*ETA_z
  202. BB(2, 6) = A(1, 6) + A(2, 6)*QSI_z + A(3, 6)*ETA_z
  203. BB(1, 7) = A(1, 7) + A(2, 7)*QSI_z + A(3, 7)*ETA_z
  204. BB(2, 8) = A(1, 8) + A(2, 8)*QSI_z + A(3, 8)*ETA_z
  205. BB(1, 9) = A(1, 9) + A(2, 9)*QSI_z + A(3, 9)*ETA_z
  206. BB(2,10) = A(1,10) + A(2,10)*QSI_z + A(3,10)*ETA_z
  207. BB(1,11) = A(1,11) + A(2,11)*QSI_z + A(3,11)*ETA_z
  208. BB(2,12) = A(1,12) + A(2,12)*QSI_z + A(3,12)*ETA_z
  209. BB(1,13) = A(1,13) + A(2,13)*QSI_z + A(3,13)*ETA_z
  210. BB(2,14) = A(1,14) + A(2,14)*QSI_z + A(3,14)*ETA_z
  211. BB(1,15) = A(1,15) + A(2,15)*QSI_z + A(3,15)*ETA_z
  212. BB(2,16) = A(1,16) + A(2,16)*QSI_z + A(3,16)*ETA_z
  213. *W WRITE (*,*) 'Ecriture de la matrice BB[ ]'
  214. *W WRITE (*,4) (('BB(',I,',',J,')=',BB(I,J),I=1,3),J=1,16)
  215. *W 4 FORMAT (3(A,I1,A,I1,A,F8.4,2X))
  216. *----- Calcul des composantes de B-BARRE
  217. K = 1
  218. DO i = 1,NBNO
  219. BGENE(2,K) = X1s2 * (BB(1,K)-BGENE(1,K))
  220. BGENE(1,K) = X1s2 * (BB(1,K)+BGENE(1,K))
  221. K = K + 1
  222. BGENE(1,K) = X1s2 * (BB(2,K)-BGENE(2,K))
  223. BGENE(2,K) = X1s2 * (BB(2,K)+BGENE(2,K))
  224. K = K + 1
  225. ENDDO
  226. GOTO 666
  227. *----- Axisymetrie (IFOU=0)
  228. 723 CONTINUE
  229. *----- Calculs des composantes de BB-DILATATION
  230. BB(1, 1) = A(1, 1) + A(2, 1)*QSI_z + A(3, 1)*ETA_z
  231. BB(2, 2) = A(1, 2) + A(2, 2)*QSI_z + A(3, 2)*ETA_z
  232. BB(3, 1) = A(1, 3) + A(2, 3)*QSI_z + A(3, 3)*ETA_z
  233. BB(1, 3) = A(1, 4) + A(2, 4)*QSI_z + A(3, 4)*ETA_z
  234. BB(2, 4) = A(1, 5) + A(2, 5)*QSI_z + A(3, 5)*ETA_z
  235. BB(3, 3) = A(1, 6) + A(2, 6)*QSI_z + A(3, 6)*ETA_z
  236. BB(1, 5) = A(1, 7) + A(2, 7)*QSI_z + A(3, 7)*ETA_z
  237. BB(2, 6) = A(1, 8) + A(2, 8)*QSI_z + A(3, 8)*ETA_z
  238. BB(3, 5) = A(1, 9) + A(2, 9)*QSI_z + A(3, 9)*ETA_z
  239. BB(1, 7) = A(1,10) + A(2,10)*QSI_z + A(3,10)*ETA_z
  240. BB(2, 8) = A(1,11) + A(2,11)*QSI_z + A(3,11)*ETA_z
  241. BB(3, 7) = A(1,12) + A(2,12)*QSI_z + A(3,12)*ETA_z
  242. BB(1, 9) = A(1,13) + A(2,13)*QSI_z + A(3,13)*ETA_z
  243. BB(2,10) = A(1,14) + A(2,14)*QSI_z + A(3,14)*ETA_z
  244. BB(3, 9) = A(1,15) + A(2,15)*QSI_z + A(3,15)*ETA_z
  245. BB(1,11) = A(1,16) + A(2,16)*QSI_z + A(3,16)*ETA_z
  246. BB(2,12) = A(1,17) + A(2,17)*QSI_z + A(3,17)*ETA_z
  247. BB(3,11) = A(1,18) + A(2,18)*QSI_z + A(3,18)*ETA_z
  248. BB(1,13) = A(1,19) + A(2,19)*QSI_z + A(3,19)*ETA_z
  249. BB(2,14) = A(1,20) + A(2,20)*QSI_z + A(3,20)*ETA_z
  250. BB(3,13) = A(1,21) + A(2,21)*QSI_z + A(3,21)*ETA_z
  251. BB(1,15) = A(1,22) + A(2,22)*QSI_z + A(3,22)*ETA_z
  252. BB(2,16) = A(1,23) + A(2,23)*QSI_z + A(3,23)*ETA_z
  253. BB(3,15) = A(1,24) + A(2,24)*QSI_z + A(3,24)*ETA_z
  254. *W WRITE (*,*) 'Ecriture de la matrice BB[ ]'
  255. *W WRITE (*,4) (('BB(',I,',',J,')=',BB(I,J),I=1,3),J=1,16)
  256. *----- Calcul des composantes de B-BARRE
  257. K = 1
  258. DO i = 1,NBNO
  259. r_z = X1s3 * (BB(1,K)-BGENE(1,K)+BB(3,K)-BGENE(3,K))
  260. BGENE(1,K) = BGENE(1,K) + r_z
  261. BGENE(2,K) = r_z
  262. BGENE(3,K) = BGENE(3,K) + r_z
  263. K = K + 1
  264. r_z = X1s3 * (BB(2,K)-BGENE(2,K))
  265. BGENE(1,K) = r_z
  266. BGENE(2,K) = BGENE(2,K) + r_z
  267. BGENE(3,K) = r_z
  268. K = K + 1
  269. ENDDO
  270. GOTO 666
  271.  
  272. C-----------------------------------------------------------------------
  273. C----- Element massif tridimensionnel ICC8,ICT4, ICP6 -----------------------------
  274. C-----------------------------------------------------------------------
  275. 73 CONTINUE
  276. *W WRITE(*,*) 'Element ICC8',IFOU
  277. 74 CONTINUE
  278. *W WRITE(*,*) 'Element ICT4',IFOU
  279. 75 CONTINUE
  280. *W WRITE(*,*) 'Element ICP6',IFOU
  281. 273 CONTINUE
  282. *W WRITE(*,*) 'Element ICY5',IFOU
  283. IF (IFOU.NE.2) GOTO 999
  284. QSI_z = QSIGAU(IGAU)
  285. ETA_z = ETAGAU(IGAU)
  286. DZE_z = DZEGAU(IGAU)
  287. K = 1
  288. DO i = 1,NBNO
  289. BGENE(3,K) = X1s3 * (BB(1,K)-BGENE(1,K))
  290. BGENE(2,K) = X1s3 * (BB(1,K)-BGENE(1,K))
  291. BGENE(1,K) = X1s3 * (BB(1,K) + 2.D0*BGENE(1,K))
  292. K = K+1
  293. BGENE(1,K) = X1s3 * (BB(2,K)-BGENE(2,K))
  294. BGENE(3,K) = X1s3 * (BB(2,K)-BGENE(2,K))
  295. BGENE(2,K) = X1s3 * (BB(2,K) + 2.D0*BGENE(2,K))
  296. K = K+1
  297. BGENE(1,K) = X1s3 * (BB(3,K)-BGENE(3,K))
  298. BGENE(2,K) = X1s3 * (BB(3,K)-BGENE(3,K))
  299. BGENE(3,K) = X1s3 * (BB(3,K) + 2.D0*BGENE(3,K))
  300. K = K+1
  301. ENDDO
  302. GOTO 666
  303.  
  304. C-----------------------------------------------------------------------
  305. C----- Element massif tridimensionnel IC20 IC10 IC15 -------------------
  306. C-----------------------------------------------------------------------
  307. 76 CONTINUE
  308. *W WRITE(*,*) 'Element IC20',IFOU
  309. 77 CONTINUE
  310. *W WRITE(*,*) 'Element IC10',IFOU
  311. 78 CONTINUE
  312. *W WRITE(*,*) 'Element IC15',IFOU
  313. 274 CONTINUE
  314. *W WRITE(*,*) 'Element IC13',IFOU
  315. IF (IFOU.NE.2) GOTO 999
  316. QSI_z = QSIGAU(IGAU)
  317. ETA_z = ETAGAU(IGAU)
  318. DZE_z = DZEGAU(IGAU)
  319.  
  320. *----- Calculs des composantes de BB-DILATATION
  321. K = 0
  322. DO IBN = 1,NBNO
  323.  
  324. BB(1,K+1) = A(1,K+1) + A(2,K+1)*QSI_z + A(3,K+1)*ETA_z +
  325. &A(4,K+1)*DZE_z
  326. BB(2,K+2) = A(1,K+2) + A(2,K+2)*QSI_z + A(3,K+2)*ETA_z +
  327. &A(4,K+2)*DZE_z
  328. BB(3,K+3) = A(1,K+3) + A(2,K+3)*QSI_z + A(3,K+3)*ETA_z +
  329. &A(4,K+3)*DZE_z
  330.  
  331. K = K+3
  332. ENDDO
  333.  
  334. *----- Calcul des composantes de B-BARRE
  335. K = 1
  336. DO i = 1,NBNO
  337. BGENE(3,K) = X1s3 * (BB(1,K)-BGENE(1,K))
  338. BGENE(2,K) = X1s3 * (BB(1,K)-BGENE(1,K))
  339. BGENE(1,K) = X1s3 * (BB(1,K) + 2.D0*BGENE(1,K))
  340. K = K+1
  341. BGENE(1,K) = X1s3 * (BB(2,K)-BGENE(2,K))
  342. BGENE(3,K) = X1s3 * (BB(2,K)-BGENE(2,K))
  343. BGENE(2,K) = X1s3 * (BB(2,K) + 2.D0*BGENE(2,K))
  344. K = K+1
  345. BGENE(1,K) = X1s3 * (BB(3,K)-BGENE(3,K))
  346. BGENE(2,K) = X1s3 * (BB(3,K)-BGENE(3,K))
  347. BGENE(3,K) = X1s3 * (BB(3,K) + 2.D0*BGENE(3,K))
  348. K = K+1
  349. ENDDO
  350. GOTO 666
  351.  
  352. C-----------------------------------------------------------------------
  353. C----- ERREUR : Donnees incompatibles ----------------------------------
  354. C-----------------------------------------------------------------------
  355. 999 CONTINUE
  356. *W WRITE(*,*) 'Mode de calcul ',IFOU,' incompatible avec ',
  357. *W & 'element ',MELE
  358. CALL ERREUR(5)
  359.  
  360. C-----------------------------------------------------------------------
  361. C----- FIN du sousprogramme --------------------------------------------
  362. C-----------------------------------------------------------------------
  363. 666 CONTINUE
  364. *W WRITE (*,*) 'Sortie du sousprogramme BBAR'
  365.  
  366. RETURN
  367. END
  368.  
  369.  
  370.  
  371.  
  372.  

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