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
339 : CALL ERREUR(5)
340 :
341 : C-----------------------------------------------------------------------
342 : C----- FIN du sousprogramme --------------------------------------------
343 : C-----------------------------------------------------------------------
344 : 666 CONTINUE
345 : *W WRITE (*,*) 'Sortie du sousprogramme BBAR'
346 :
347 : RETURN
348 : END
349 :
350 :
© Cast3M 2003 - All rights reserved.
Disclaimer