Télécharger bbar.eso

Retour à la liste

Numérotation des lignes :

  1. C BBAR SOURCE FANDEUR 10/08/31 21:15:13 6735
  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 =
  14. C= ELEMENTS ICT4, IC10, ICP6, IC15 -> 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-----------------------------------------------------------------------
  66. GOTO ( 69, 70, 71, 72, 73, 74, 75, 76, 77, 78 ) , (MELE-68)
  67. GOTO 999
  68.  
  69. C-----------------------------------------------------------------------
  70. C----- Element massif bidimensionnel ICT3 ------------------------------
  71. C-----------------------------------------------------------------------
  72. 69 CONTINUE
  73. *W WRITE(*,*) 'Element ICT3',IFOU
  74. IFR = IFOU+4
  75. GOTO (666,691,691,693,666),IFR
  76. GOTO 999
  77. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  78. 691 CONTINUE
  79. K = 1
  80. DO i = 1,NBNO
  81. BGENE(2,K) = X1s2 * (BB(1,K)-BGENE(1,K))
  82. BGENE(1,K) = X1s2 * (BB(1,K)+BGENE(1,K))
  83. K = K+1
  84. BGENE(1,K) = X1s2 * (BB(2,K)-BGENE(2,K))
  85. BGENE(2,K) = X1s2 * (BB(2,K)+BGENE(2,K))
  86. K = K+1
  87. ENDDO
  88. GOTO 666
  89. *----- Axisymetrie (IFOU=0)
  90. 693 CONTINUE
  91. K = 1
  92. DO i = 1,NBNO
  93. r_z = X1s3 * (BB(1,K)-BGENE(1,K)+BB(3,K)-BGENE(3,K))
  94. BGENE(1,K) = BGENE(1,K) + r_z
  95. BGENE(2,K) = r_z
  96. BGENE(3,K) = BGENE(3,K) + r_z
  97. K = K + 1
  98. r_z = X1s3 * (BB(2,K)-BGENE(2,K))
  99. BGENE(1,K) = r_z
  100. BGENE(2,K) = BGENE(2,K) + r_z
  101. BGENE(3,K) = r_z
  102. K = K + 1
  103. ENDDO
  104. GOTO 666
  105.  
  106. C-----------------------------------------------------------------------
  107. C----- Element massif bidimensionnel ICQ4 ------------------------------
  108. C-----------------------------------------------------------------------
  109. 70 CONTINUE
  110. *W WRITE(*,*) 'Element ICQ4',IFOU
  111. IFR = IFOU+4
  112. GOTO (666,701,701,703,666),IFR
  113. GOTO 999
  114. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  115. 701 CONTINUE
  116. K = 1
  117. DO i = 1,NBNO
  118. BGENE(2,K) = X1s2 * (BB(1,K)-BGENE(1,K))
  119. BGENE(1,K) = X1s2 * (BB(1,K)+BGENE(1,K))
  120. K = K + 1
  121. BGENE(1,K) = X1s2 * (BB(2,K)-BGENE(2,K))
  122. BGENE(2,K) = X1s2 * (BB(2,K)+BGENE(2,K))
  123. K = K + 1
  124. ENDDO
  125. GOTO 666
  126. *----- Axisymetrie (IFOU=0)
  127. 703 CONTINUE
  128. K = 1
  129. DO i = 1,NBNO
  130. r_z = X1s3 * (BB(1,K)-BGENE(1,K)+BB(3,K)-BGENE(3,K))
  131. BGENE(1,K) = BGENE(1,K) + r_z
  132. BGENE(2,K) = r_z
  133. BGENE(3,K) = BGENE(3,K) + r_z
  134. K = K + 1
  135. r_z = X1s3 * (BB(2,K)-BGENE(2,K))
  136. BGENE(1,K) = r_z
  137. BGENE(2,K) = BGENE(2,K) + r_z
  138. BGENE(3,K) = r_z
  139. K = K + 1
  140. ENDDO
  141. GOTO 666
  142.  
  143. C-----------------------------------------------------------------------
  144. C----- Element massif bidimensionnel ICT6 ------------------------------
  145. C-----------------------------------------------------------------------
  146. 71 CONTINUE
  147. *W WRITE(*,*) 'Element ICT6',IFOU
  148. IFR = IFOU+4
  149. GOTO (666,711,711,713,666),IFR
  150. GOTO 999
  151. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  152. 711 CONTINUE
  153. K = 1
  154. DO i = 1,NBNO
  155. BGENE(2,K) = X1s2 * (BB(1,K)-BGENE(1,K))
  156. BGENE(1,K) = X1s2 * (BB(1,K)+BGENE(1,K))
  157. K = K + 1
  158. BGENE(1,K) = X1s2 * (BB(2,K)-BGENE(2,K))
  159. BGENE(2,K) = X1s2 * (BB(2,K)+BGENE(2,K))
  160. K = K + 1
  161. ENDDO
  162. GOTO 666
  163. *----- Axisymetrie (IFOU=0)
  164. 713 CONTINUE
  165. K = 1
  166. DO i = 1,NBNO
  167. r_z = X1s3 * (BB(1,K)-BGENE(1,K)+BB(3,K)-BGENE(3,K))
  168. BGENE(1,K) = BGENE(1,K) + r_z
  169. BGENE(2,K) = r_z
  170. BGENE(3,K) = BGENE(3,K) + r_z
  171. K = K + 1
  172. r_z = X1s3 * (BB(2,K)-BGENE(2,K))
  173. BGENE(1,K) = r_z
  174. BGENE(2,K) = BGENE(2,K) + r_z
  175. BGENE(3,K) = r_z
  176. K = K + 1
  177. ENDDO
  178. GOTO 666
  179.  
  180. C-----------------------------------------------------------------------
  181. C----- Element massif bidimensionnel ICQ8 ------------------------------
  182. C-----------------------------------------------------------------------
  183. 72 CONTINUE
  184. *W WRITE(*,*) 'Element ICQ8',IFOU
  185. QSI_z = QSIGAU(IGAU)
  186. ETA_z = ETAGAU(IGAU)
  187. IFR = IFOU+4
  188. GOTO (666,721,721,723,666),IFR
  189. GOTO 999
  190. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  191. 721 CONTINUE
  192. *----- Calculs des composantes de BB-DILATATION
  193. BB(1, 1) = A(1, 1) + A(2, 1)*QSI_z + A(3, 1)*ETA_z
  194. BB(2, 2) = A(1, 2) + A(2, 2)*QSI_z + A(3, 2)*ETA_z
  195. BB(1, 3) = A(1, 3) + A(2, 3)*QSI_z + A(3, 3)*ETA_z
  196. BB(2, 4) = A(1, 4) + A(2, 4)*QSI_z + A(3, 4)*ETA_z
  197. BB(1, 5) = A(1, 5) + A(2, 5)*QSI_z + A(3, 5)*ETA_z
  198. BB(2, 6) = A(1, 6) + A(2, 6)*QSI_z + A(3, 6)*ETA_z
  199. BB(1, 7) = A(1, 7) + A(2, 7)*QSI_z + A(3, 7)*ETA_z
  200. BB(2, 8) = A(1, 8) + A(2, 8)*QSI_z + A(3, 8)*ETA_z
  201. BB(1, 9) = A(1, 9) + A(2, 9)*QSI_z + A(3, 9)*ETA_z
  202. BB(2,10) = A(1,10) + A(2,10)*QSI_z + A(3,10)*ETA_z
  203. BB(1,11) = A(1,11) + A(2,11)*QSI_z + A(3,11)*ETA_z
  204. BB(2,12) = A(1,12) + A(2,12)*QSI_z + A(3,12)*ETA_z
  205. BB(1,13) = A(1,13) + A(2,13)*QSI_z + A(3,13)*ETA_z
  206. BB(2,14) = A(1,14) + A(2,14)*QSI_z + A(3,14)*ETA_z
  207. BB(1,15) = A(1,15) + A(2,15)*QSI_z + A(3,15)*ETA_z
  208. BB(2,16) = A(1,16) + A(2,16)*QSI_z + A(3,16)*ETA_z
  209. *W WRITE (*,*) 'Ecriture de la matrice BB[ ]'
  210. *W WRITE (*,4) (('BB(',I,',',J,')=',BB(I,J),I=1,3),J=1,16)
  211. *W 4 FORMAT (3(A,I1,A,I1,A,F8.4,2X))
  212. *----- Calcul des composantes de B-BARRE
  213. K = 1
  214. DO i = 1,NBNO
  215. BGENE(2,K) = X1s2 * (BB(1,K)-BGENE(1,K))
  216. BGENE(1,K) = X1s2 * (BB(1,K)+BGENE(1,K))
  217. K = K + 1
  218. BGENE(1,K) = X1s2 * (BB(2,K)-BGENE(2,K))
  219. BGENE(2,K) = X1s2 * (BB(2,K)+BGENE(2,K))
  220. K = K + 1
  221. ENDDO
  222. GOTO 666
  223. *----- Axisymetrie (IFOU=0)
  224. 723 CONTINUE
  225. *----- Calculs des composantes de BB-DILATATION
  226. BB(1, 1) = A(1, 1) + A(2, 1)*QSI_z + A(3, 1)*ETA_z
  227. BB(2, 2) = A(1, 2) + A(2, 2)*QSI_z + A(3, 2)*ETA_z
  228. BB(3, 1) = A(1, 3) + A(2, 3)*QSI_z + A(3, 3)*ETA_z
  229. BB(1, 3) = A(1, 4) + A(2, 4)*QSI_z + A(3, 4)*ETA_z
  230. BB(2, 4) = A(1, 5) + A(2, 5)*QSI_z + A(3, 5)*ETA_z
  231. BB(3, 3) = A(1, 6) + A(2, 6)*QSI_z + A(3, 6)*ETA_z
  232. BB(1, 5) = A(1, 7) + A(2, 7)*QSI_z + A(3, 7)*ETA_z
  233. BB(2, 6) = A(1, 8) + A(2, 8)*QSI_z + A(3, 8)*ETA_z
  234. BB(3, 5) = A(1, 9) + A(2, 9)*QSI_z + A(3, 9)*ETA_z
  235. BB(1, 7) = A(1,10) + A(2,10)*QSI_z + A(3,10)*ETA_z
  236. BB(2, 8) = A(1,11) + A(2,11)*QSI_z + A(3,11)*ETA_z
  237. BB(3, 7) = A(1,12) + A(2,12)*QSI_z + A(3,12)*ETA_z
  238. BB(1, 9) = A(1,13) + A(2,13)*QSI_z + A(3,13)*ETA_z
  239. BB(2,10) = A(1,14) + A(2,14)*QSI_z + A(3,14)*ETA_z
  240. BB(3, 9) = A(1,15) + A(2,15)*QSI_z + A(3,15)*ETA_z
  241. BB(1,11) = A(1,16) + A(2,16)*QSI_z + A(3,16)*ETA_z
  242. BB(2,12) = A(1,17) + A(2,17)*QSI_z + A(3,17)*ETA_z
  243. BB(3,11) = A(1,18) + A(2,18)*QSI_z + A(3,18)*ETA_z
  244. BB(1,13) = A(1,19) + A(2,19)*QSI_z + A(3,19)*ETA_z
  245. BB(2,14) = A(1,20) + A(2,20)*QSI_z + A(3,20)*ETA_z
  246. BB(3,13) = A(1,21) + A(2,21)*QSI_z + A(3,21)*ETA_z
  247. BB(1,15) = A(1,22) + A(2,22)*QSI_z + A(3,22)*ETA_z
  248. BB(2,16) = A(1,23) + A(2,23)*QSI_z + A(3,23)*ETA_z
  249. BB(3,15) = A(1,24) + A(2,24)*QSI_z + A(3,24)*ETA_z
  250. *W WRITE (*,*) 'Ecriture de la matrice BB[ ]'
  251. *W WRITE (*,4) (('BB(',I,',',J,')=',BB(I,J),I=1,3),J=1,16)
  252. *----- Calcul des composantes de B-BARRE
  253. K = 1
  254. DO i = 1,NBNO
  255. r_z = X1s3 * (BB(1,K)-BGENE(1,K)+BB(3,K)-BGENE(3,K))
  256. BGENE(1,K) = BGENE(1,K) + r_z
  257. BGENE(2,K) = r_z
  258. BGENE(3,K) = BGENE(3,K) + r_z
  259. K = K + 1
  260. r_z = X1s3 * (BB(2,K)-BGENE(2,K))
  261. BGENE(1,K) = r_z
  262. BGENE(2,K) = BGENE(2,K) + r_z
  263. BGENE(3,K) = r_z
  264. K = K + 1
  265. ENDDO
  266. GOTO 666
  267.  
  268. C-----------------------------------------------------------------------
  269. C----- Element massif tridimensionnel ICC8 -----------------------------
  270. C-----------------------------------------------------------------------
  271. 73 CONTINUE
  272. *W WRITE(*,*) 'Element ICC8',IFOU
  273. IF (IFOU.NE.2) GOTO 999
  274. QSI_z = QSIGAU(IGAU)
  275. ETA_z = ETAGAU(IGAU)
  276. DZE_z = DZEGAU(IGAU)
  277. GOTO 666
  278.  
  279. C-----------------------------------------------------------------------
  280. C----- Element massif tridimensionnel ICT4 -----------------------------
  281. C-----------------------------------------------------------------------
  282. 74 CONTINUE
  283. *W WRITE(*,*) 'Element ICT4',IFOU
  284. IF (IFOU.NE.2) GOTO 999
  285. QSI_z = QSIGAU(IGAU)
  286. ETA_z = ETAGAU(IGAU)
  287. DZE_z = DZEGAU(IGAU)
  288. GOTO 666
  289.  
  290. C-----------------------------------------------------------------------
  291. C----- Element massif tridimensionnel ICP6 -----------------------------
  292. C-----------------------------------------------------------------------
  293. 75 CONTINUE
  294. *W WRITE(*,*) 'Element ICP6',IFOU
  295. IF (IFOU.NE.2) GOTO 999
  296. QSI_z = QSIGAU(IGAU)
  297. ETA_z = ETAGAU(IGAU)
  298. DZE_z = DZEGAU(IGAU)
  299. GOTO 666
  300.  
  301. C-----------------------------------------------------------------------
  302. C----- Element massif tridimensionnel IC20 -----------------------------
  303. C-----------------------------------------------------------------------
  304. 76 CONTINUE
  305. *W WRITE(*,*) 'Element IC20',IFOU
  306. IF (IFOU.NE.2) GOTO 999
  307. QSI_z = QSIGAU(IGAU)
  308. ETA_z = ETAGAU(IGAU)
  309. DZE_z = DZEGAU(IGAU)
  310. GOTO 666
  311.  
  312. C-----------------------------------------------------------------------
  313. C----- Element massif tridimensionnel IC10 -----------------------------
  314. C-----------------------------------------------------------------------
  315. 77 CONTINUE
  316. *W WRITE(*,*) 'Element IC10',IFOU
  317. IF (IFOU.NE.2) GOTO 999
  318. QSI_z = QSIGAU(IGAU)
  319. ETA_z = ETAGAU(IGAU)
  320. DZE_z = DZEGAU(IGAU)
  321. GOTO 666
  322.  
  323. C-----------------------------------------------------------------------
  324. C----- Element massif tridimensionnel IC15 -----------------------------
  325. C-----------------------------------------------------------------------
  326. 78 CONTINUE
  327. *W WRITE(*,*) 'Element IC15',IFOU
  328. IF (IFOU.NE.2) GOTO 999
  329. QSI_z = QSIGAU(IGAU)
  330. ETA_z = ETAGAU(IGAU)
  331. DZE_z = DZEGAU(IGAU)
  332. GOTO 666
  333.  
  334. C-----------------------------------------------------------------------
  335. C----- ERREUR : Donnees incompatibles ----------------------------------
  336. C-----------------------------------------------------------------------
  337. 999 CONTINUE
  338. *W WRITE(*,*) 'Mode de calcul ',IFOU,' incompatible avec ',
  339. *W & 'element ',MELE
  340. CALL ERREUR(5)
  341.  
  342. C-----------------------------------------------------------------------
  343. C----- FIN du sousprogramme --------------------------------------------
  344. C-----------------------------------------------------------------------
  345. 666 CONTINUE
  346. *W WRITE (*,*) 'Sortie du sousprogramme BBAR'
  347.  
  348. RETURN
  349. END
  350.  
  351.  
  352.  

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