OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cbabe3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23C |============================================================
24C | CBABE3 /coqueba/cbabe3.F
25C |------------------------------------------------------------
26C |-- appelee par -----------
27C | CBAKE3 /coqueba/cbake3.F
28C |============================================================
29!||====================================================================
30!|| cbabe3 ../engine/source/elements/shell/coqueba/cbabe3.F
31!||--- called by ------------------------------------------------------
32!|| cbake3 ../engine/source/elements/shell/coqueba/cbake3.F
33!||====================================================================
34 SUBROUTINE cbabe3(JFT,JLT,NG,VCORE,AREA,CDET,VQN,VQ,VJFI,
35 1 VNRM,VASTN,HX,HY,VETA,VKSI,
36 2 BM,BMF,BF,BC,TC,BZZ,NPLAT,IPLAT,
37 3 ISROT,BRZ )
38C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
39C CALCUL [B] AU POINT D'INTEGRATION Index changed*****EP-->I*****
40C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
41C-----------------------------------------------
42C I M P L I C I T T Y P E S
43C-----------------------------------------------
44#include "implicit_f.inc"
45#include "mvsiz_p.inc"
46C-----------------------------------------------
47C D U M M Y A R G U M E N T S
48C-----------------------------------------------
49 INTEGER NPG,NG,JFT,JLT,NPLAT,IPLAT(*),ISROT
50 PARAMETER (NPG = 4)
51 my_real
52 . vcore(mvsiz,12),vqn(mvsiz,9,4),vksi(4,4),veta(4,4),
53 . bm(mvsiz,36),bmf(mvsiz,36),bf(mvsiz,24),bc(mvsiz,40),hx(mvsiz,4),hy(mvsiz,4)
54 my_real
55 . vnrm(mvsiz,12),vastn(mvsiz,16),vjfi(mvsiz,3,2,4),
56 . vq(mvsiz,3,3,4),area(*)
57 my_real
58 . cdet(*),tc(mvsiz,2,2),bzz(mvsiz,8),brz(mvsiz,4,4)
59C-----------------------------------------------
60C L O C A L V A R I A B L E S
61C-----------------------------------------------
62 INTEGER PT,PT00,PT0,I,J,EP,NG1,K
63 MY_REAL
64 . VPG(2,NPG),THK(MVSIZ),DETJ,DET,
65 . tfn(3,2),bcx,bcy,v1(2),v2(2),c1,c2,bc1,bc2,vb1,
66 . vjf1(2,3),vjf(3,3),tbi(2,2),tbc(mvsiz,2,2),v11(4)
67 my_real
68 . a_1,c11,c12,c21,c22,cc,beta1,ksi1,ksiy1,beta2,ksi2,ksiy2,
69 . bmt(8),bct(12),bxy(3),byx(3)
70 my_real
71 . pg1,pg
72 parameter(pg=.577350269189626)
73 parameter(pg1=-.577350269189626)
74C--------------------------
75C INITIALISATION
76C--------------------------
77 DATA vpg/pg1,pg1,pg,pg1,pg,pg,pg1,pg/
78C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
79#include "vectorize.inc"
80 DO i=jft,nplat
81 ep=iplat(i)
82C-------VCORE(12):BX0(2),BY0(2),GAMA(2),MX23,MY23,MX34,MY34,MX13,MY13
83C-------BM(1-4)->BxI,BM(5-8)->ByI
84C------- (I=1:BMT(1)+BMT(3);I=2:BMT(2)+BMT(4);I=3:-BMT(1)+BMT(3);I=4:-BMT(2)+BMT(4))
85 bmt(1)=vcore(ep,1)+hx(ep,ng)*vcore(ep,5)
86 bmt(2)=vcore(ep,2)+hx(ep,ng)*vcore(ep,6)
87 bmt(3)=hx(ep,ng)*fourth
88 bmt(4)=-bmt(3)
89 bm(i,1)=bmt(1)+bmt(3)
90 bm(i,2)=bmt(2)+bmt(4)
91 bm(i,3)=-bmt(1)+bmt(3)
92 bm(i,4)=-bmt(2)+bmt(4)
93 bmt(5)=vcore(ep,3)+hy(ep,ng)*vcore(ep,5)
94 bmt(6)=vcore(ep,4)+hy(ep,ng)*vcore(ep,6)
95 bmt(7)=hy(ep,ng)*fourth
96 bmt(8)=-bmt(7)
97 bm(i,5)=bmt(5)+bmt(7)
98 bm(i,6)=bmt(6)+bmt(8)
99 bm(i,7)=-bmt(5)+bmt(7)
100 bm(i,8)=-bmt(6)+bmt(8)
101 ENDDO
102 DO i=jft,nplat
103 ep=iplat(i)
104 a_1 = one/max(cdet(ep),em20)
105 c11=(vcore(ep,10)+vcore(ep,12)*vpg(1,ng))*a_1
106 c12=-(vcore(ep,8)+vcore(ep,12)*vpg(2,ng))*a_1
107 c21=-(vcore(ep,9)+vcore(ep,11)*vpg(1,ng))*a_1
108 c22=( vcore(ep,7)+vcore(ep,11)*vpg(2,ng))*a_1
109 bzz(i,1)=c11*vksi(1,ng)+c12*veta(1,ng)
110 bzz(i,2)=c21*vksi(1,ng)+c22*veta(1,ng)
111 bzz(i,3)=c11*vksi(2,ng)+c12*veta(2,ng)
112 bzz(i,4)=c21*vksi(2,ng)+c22*veta(2,ng)
113 bzz(i,5)=c11*vksi(3,ng)+c12*veta(3,ng)
114 bzz(i,6)=c21*vksi(3,ng)+c22*veta(3,ng)
115 bzz(i,7)=c11*vksi(4,ng)+c12*veta(4,ng)
116 bzz(i,8)=c21*vksi(4,ng)+c22*veta(4,ng)
117 c11=fourth*c11
118 c12=fourth*c12
119 c21=fourth*c21
120 c22=fourth*c22
121C--------C.T-----
122C-----PARTIE SYM---------
123 beta1=vcore(ep,8)+vcore(ep,12)*vpg(2,ng)
124 ksi1=vcore(ep,10)+vcore(ep,12)*vpg(1,ng)
125 beta2=vcore(ep,7)+vcore(ep,11)*vpg(2,ng)
126 ksi2=vcore(ep,9)+vcore(ep,11)*vpg(1,ng)
127C-------NOEUD--- 3
128 bct(1)=c11*vpg(2,ng)+c12*vpg(1,ng)
129 bct(2)=c21*vpg(2,ng)+c22*vpg(1,ng)
130 bct(3)=-beta1*c11-ksi1*c12
131 bct(4)=-beta1*c21-ksi1*c22
132 bct(5)=c11*beta2+c12*ksi2
133 bct(6)=c21*beta2+c22*ksi2
134C-------NOEUD--- 4
135 bct(7)=-bct(1)
136 bct(8)=-bct(2)
137 bct(9)=bct(3)
138 bct(10)=bct(4)
139 bct(11)=bct(5)
140 bct(12)=bct(6)
141C
142 beta1=vcore(ep,12)+vcore(ep,8)*vpg(2,ng)
143 ksi1=vcore(ep,12)+vcore(ep,10)*vpg(1,ng)
144 beta2=vcore(ep,11)+vcore(ep,7)*vpg(2,ng)
145 ksi2=vcore(ep,11)+vcore(ep,9)*vpg(1,ng)
146C-------NOEUD--- 1
147 bc(i,1)=-c11-c12+bct(1)
148 bc(i,2)=-c21-c22+bct(2)
149 bc(i,3)= beta1*c11+ksi1*c12+bct(3)
150 bc(i,4)= beta1*c21+ksi1*c22+bct(4)
151 bc(i,5)= -beta2*c11-ksi2*c12+bct(5)
152 bc(i,6)= -beta2*c21-ksi2*c22+bct(6)
153C-------NOEUD--- 2
154 bc(i,7)= c11-c12+bct(7)
155 bc(i,8)= c21-c22+bct(8)
156 bc(i,9)= beta1*c11-ksi1*c12+bct(9)
157 bc(i,10)=beta1*c21-ksi1*c22+bct(10)
158 bc(i,11)=-beta2*c11+ksi2*c12+bct(11)
159 bc(i,12)=-beta2*c21+ksi2*c22+bct(12)
160C-------NOEUD--- 3
161 bc(i,13)=-bc(i,1)+bct(1)+bct(1)
162 bc(i,14)=-bc(i,2)+bct(2)+bct(2)
163 bc(i,15)=-bc(i,3)+bct(3)+bct(3)
164 bc(i,16)=-bc(i,4)+bct(4)+bct(4)
165 bc(i,17)=-bc(i,5)+bct(5)+bct(5)
166 bc(i,18)=-bc(i,6)+bct(6)+bct(6)
167C-------NOEUD--- 4
168 bc(i,19)=-bc(i,7)+bct(7)+bct(7)
169 bc(i,20)=-bc(i,8)+bct(8)+bct(8)
170 bc(i,21)=-bc(i,9)+bct(9)+bct(9)
171 bc(i,22)=-bc(i,10)+bct(10)+bct(10)
172 bc(i,23)=-bc(i,11)+bct(11)+bct(11)
173 bc(i,24)=-bc(i,12)+bct(12)+bct(12)
174 ENDDO
175C
176#include "vectorize.inc"
177 DO i=nplat+1,jlt
178 ep=iplat(i)
179C---------------------------------------------------
180C CALCUL DE [FN]
181C---------------------------------------------------
182 tfn(1,1)=vksi(1,ng)*vqn(ep,7,1)+vksi(2,ng)*vqn(ep,7,2)
183 1 +vksi(3,ng)*vqn(ep,7,3)+vksi(4,ng)*vqn(ep,7,4)
184 tfn(2,1)=vksi(1,ng)*vqn(ep,8,1)+vksi(2,ng)*vqn(ep,8,2)
185 1 +vksi(3,ng)*vqn(ep,8,3)+vksi(4,ng)*vqn(ep,8,4)
186 tfn(3,1)=vksi(1,ng)*vqn(ep,9,1)+vksi(2,ng)*vqn(ep,9,2)
187 1 +vksi(3,ng)*vqn(ep,9,3)+vksi(4,ng)*vqn(ep,9,4)
188 tfn(1,2)=veta(1,ng)*vqn(ep,7,1)+veta(2,ng)*vqn(ep,7,2)
189 1 +veta(3,ng)*vqn(ep,7,3)+veta(4,ng)*vqn(ep,7,4)
190 tfn(2,2)=veta(1,ng)*vqn(ep,8,1)+veta(2,ng)*vqn(ep,8,2)
191 1 +veta(3,ng)*vqn(ep,8,3)+veta(4,ng)*vqn(ep,8,4)
192 tfn(3,2)=veta(1,ng)*vqn(ep,9,1)+veta(2,ng)*vqn(ep,9,2)
193 1 +veta(3,ng)*vqn(ep,9,3)+veta(4,ng)*vqn(ep,9,4)
194C--------------------------------------------------------
195C CALCUL [BN]=[F]^-1 [FN]
196C--------------------------------------------------------
197 tbi(2,2)=vjfi(ep,1,1,ng)*tfn(1,1)+vjfi(ep,2,1,ng)*tfn(2,1)
198 1 + vjfi(ep,3,1,ng)*tfn(3,1)
199 tbi(2,1)=vjfi(ep,1,2,ng)*tfn(1,1)+vjfi(ep,2,2,ng)*tfn(2,1)
200 1 + vjfi(ep,3,2,ng)*tfn(3,1)
201 tbi(1,2)=vjfi(ep,1,1,ng)*tfn(1,2)+vjfi(ep,2,1,ng)*tfn(2,2)
202 1 + vjfi(ep,3,1,ng)*tfn(3,2)
203 tbi(1,1)=vjfi(ep,1,2,ng)*tfn(1,2)+vjfi(ep,2,2,ng)*tfn(2,2)
204 1 + vjfi(ep,3,2,ng)*tfn(3,2)
205C
206 thk(ep) =-(tbi(1,1)+tbi(2,2))
207 tbi(1,2)=-tbi(1,2)
208 tbi(2,1)=-tbi(2,1)
209C---------------------------
210C CALCUL DE TC=VJFI*VQ
211C---------------------------
212 tc(ep,1,1)=vjfi(ep,1,1,ng)*vq(ep,1,1,ng)+vjfi(ep,2,1,ng)
213 + *vq(ep,2,1,ng)+ vjfi(ep,3,1,ng)*vq(ep,3,1,ng)
214 tc(ep,2,1)=vjfi(ep,1,2,ng)*vq(ep,1,1,ng)+vjfi(ep,2,2,ng)
215 + *vq(ep,2,1,ng)+ vjfi(ep,3,2,ng)*vq(ep,3,1,ng)
216 tc(ep,1,2)=vjfi(ep,1,1,ng)*vq(ep,1,2,ng)+vjfi(ep,2,1,ng)
217 + *vq(ep,2,2,ng)+ vjfi(ep,3,1,ng)*vq(ep,3,2,ng)
218 tc(ep,2,2)=vjfi(ep,1,2,ng)*vq(ep,1,2,ng)+vjfi(ep,2,2,ng)
219 + *vq(ep,2,2,ng)+ vjfi(ep,3,2,ng)*vq(ep,3,2,ng)
220C------------------------------
221C CALCUL DE TBC=TBI*TC
222C------------------------------
223 tbc(ep,1,1)=tbi(1,1)*tc(ep,1,1)+tbi(1,2)*tc(ep,2,1)
224 tbc(ep,2,1)=tbi(2,1)*tc(ep,1,1)+tbi(2,2)*tc(ep,2,1)
225 tbc(ep,1,2)=tbi(1,1)*tc(ep,1,2)+tbi(1,2)*tc(ep,2,2)
226 tbc(ep,2,2)=tbi(2,1)*tc(ep,1,2)+tbi(2,2)*tc(ep,2,2)
227 ENDDO
228C
229C--------------------------
230C--------------------------
231C DEFORMATION IN-PLANE
232C--------------------------
233C [BM](3,3*NPG),[BMF](3,3*NPG),[BF](3,2*NPG)
234C--------------------------
235C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
236C---------- NOEUDS J=1 II =0 KK = 0
237#include "vectorize.inc"
238 DO i=nplat+1,jlt
239 ep=iplat(i)
240C--------TERMES DE [B0]=<T>CI-------
241 c1=vksi(1,ng)*tc(ep,1,1)+veta(1,ng)*tc(ep,2,1)
242 c2=vksi(1,ng)*tc(ep,1,2)+veta(1,ng)*tc(ep,2,2)
243C--------TERMES ASSOCIEES AUX U,V,W DE [B1]=<T>BCI-------
244 bc1=vksi(1,ng)*tbc(ep,1,1)+veta(1,ng)*tbc(ep,2,1)
245 bc2=vksi(1,ng)*tbc(ep,1,2)+veta(1,ng)*tbc(ep,2,2)
246C I = 1; JJ = 3*KK =0
247C---------CONTRIBUTION DU <T1> :EPS-X
248 IF (isrot>0) THEN
249 bxy(1)=vq(ep,1,1,ng)*c2
250 bxy(2)=vq(ep,2,1,ng)*c2
251 bxy(3)=vq(ep,3,1,ng)*c2
252 byx(1)=vq(ep,1,2,ng)*c1
253 byx(2)=vq(ep,2,2,ng)*c1
254 byx(3)=vq(ep,3,2,ng)*c1
255 brz(i,1,1)=-bxy(1)+byx(1)
256 brz(i,2,1)=-bxy(2)+byx(2)
257 brz(i,3,1)=-bxy(3)+byx(3)
258 bm(i,3)=bxy(1)+byx(1)
259 bm(i,6)=bxy(2)+byx(2)
260 bm(i,9)=bxy(3)+byx(3)
261 ELSE
262 bm(i,9)=zero
263 END IF
264 bm(i,1)=vq(ep,1,1,ng)*c1
265 bmf(i,1)=thk(ep)*bm(i,1)+vq(ep,1,1,ng)*bc1
266C---------CONTRIBUTION DU <T2> :EPS-Y
267 bm(i,2)=vq(ep,1,2,ng)*c2
268 bmf(i,2)=thk(ep)*bm(i,2)+vq(ep,1,2,ng)*bc2
269C---------CONTRIBUTION DU <T> :EPS-XY
270 bmf(i,3)=thk(ep)*bm(i,3)+vq(ep,1,1,ng)*bc2+vq(ep,1,2,ng)*bc1
271C I = 2; JJ = 3*(KK+1)=3
272C---------:EPS-X :EPS-Y :EPS-XY
273 bm(i,4)=vq(ep,2,1,ng)*c1
274 bmf(i,4)=thk(ep)*bm(i,4)+vq(ep,2,1,ng)*bc1
275 bm(i,5)=vq(ep,2,2,ng)*c2
276 bmf(i,5)=thk(ep)*bm(i,5)+vq(ep,2,2,ng)*bc2
277 bmf(i,6)=thk(ep)*bm(i,6)+vq(ep,2,1,ng)*bc2+vq(ep,2,2,ng)*bc1
278C I = 3; JJ = 3*(KK+2)=6
279C---------:EPS-X:EPS-Y:EPS-XY
280 bm(i,7)=vq(ep,3,1,ng)*c1
281 bmf(i,7)=thk(ep)*bm(i,7)+vq(ep,3,1,ng)*bc1
282 bm(i,8)=vq(ep,3,2,ng)*c2
283 bmf(i,8)=thk(ep)*bm(i,8)+vq(ep,3,2,ng)*bc2
284 bmf(i,9)=thk(ep)*bm(i,9)+vq(ep,3,1,ng)*bc2+vq(ep,3,2,ng)*bc1
285C---------- TERMES ASSOCIEES AU BETA ----------
286C---------PRODUIT SCALAIRE <T(PG)>*<-T^2 T^1>----------
287 v1(2)=vq(ep,1,1,ng)*vqn(ep,1,1)+vq(ep,2,1,ng)*vqn(ep,2,1)
288 1 +vq(ep,3,1,ng)*vqn(ep,3,1)
289 v1(1)=-(vq(ep,1,1,ng)*vqn(ep,4,1)+vq(ep,2,1,ng)*vqn(ep,5,1)
290 1 +vq(ep,3,1,ng)*vqn(ep,6,1))
291 v2(2)=vq(ep,1,2,ng)*vqn(ep,1,1)+vq(ep,2,2,ng)*vqn(ep,2,1)
292 1 +vq(ep,3,2,ng)*vqn(ep,3,1)
293 v2(1)=-(vq(ep,1,2,ng)*vqn(ep,4,1)+vq(ep,2,2,ng)*vqn(ep,5,1)
294 1 +vq(ep,3,2,ng)*vqn(ep,6,1))
295C----------TERMES ASSOCIEES AUX BETA DE [B01]--
296C JJ = 3*II =0
297 bf(i,1)=v1(1)*c1
298 bf(i,2)=v2(1)*c2
299 bf(i,3)=v1(1)*c2+v2(1)*c1
300 bf(i,4)=v1(2)*c1
301 bf(i,5)=v2(2)*c2
302 bf(i,6)=v1(2)*c2+v2(2)*c1
303 ENDDO
304C
305C--------J=2---II=(J-1)*2 =2 KK = 3*(J-1) =3
306#include "vectorize.inc"
307 DO i=nplat+1,jlt
308 ep=iplat(i)
309C--------- [B0], [B01]---------
310C--------TERMES DE [B0]=<T>CI-------
311 c1=vksi(2,ng)*tc(ep,1,1)+veta(2,ng)*tc(ep,2,1)
312 c2=vksi(2,ng)*tc(ep,1,2)+veta(2,ng)*tc(ep,2,2)
313C--------TERMES ASSOCIEES AUX U,V,W DE [B1]=<T>BCI-------
314 bc1=vksi(2,ng)*tbc(ep,1,1)+veta(2,ng)*tbc(ep,2,1)
315 bc2=vksi(2,ng)*tbc(ep,1,2)+veta(2,ng)*tbc(ep,2,2)
316C
317C I = 1; JJ = 3*KK =9
318C---------:EPS-X:EPS-Y:EPS-XY
319 IF (isrot>0) THEN
320 bxy(1)=vq(ep,1,1,ng)*c2
321 bxy(2)=vq(ep,2,1,ng)*c2
322 bxy(3)=vq(ep,3,1,ng)*c2
323 byx(1)=vq(ep,1,2,ng)*c1
324 byx(2)=vq(ep,2,2,ng)*c1
325 byx(3)=vq(ep,3,2,ng)*c1
326 brz(i,1,2)=-bxy(1)+byx(1)
327 brz(i,2,2)=-bxy(2)+byx(2)
328 brz(i,3,2)=-bxy(3)+byx(3)
329 bm(i,12)=bxy(1)+byx(1)
330 bm(i,15)=bxy(2)+byx(2)
331 bm(i,18)=bxy(3)+byx(3)
332 ELSE
333 bm(i,18)=zero
334 END IF
335 bm(i,10)=vq(ep,1,1,ng)*c1
336 bmf(i,10)=thk(ep)*bm(i,10)+vq(ep,1,1,ng)*bc1
337 bm(i,11)=vq(ep,1,2,ng)*c2
338 bmf(i,11)=thk(ep)*bm(i,11)+vq(ep,1,2,ng)*bc2
339 bmf(i,12)=thk(ep)*bm(i,12)+vq(ep,1,1,ng)*bc2+vq(ep,1,2,ng)*bc1
340C
341C I = 2; JJ = 3*(KK+1)=12
342C---------:EPS-X:EPS-Y:EPS-XY
343 bm(i,13)=vq(ep,2,1,ng)*c1
344 bmf(i,13)=thk(ep)*bm(i,13)+vq(ep,2,1,ng)*bc1
345 bm(i,14)=vq(ep,2,2,ng)*c2
346 bmf(i,14)=thk(ep)*bm(i,14)+vq(ep,2,2,ng)*bc2
347 bmf(i,15)=thk(ep)*bm(i,15)+vq(ep,2,1,ng)*bc2+vq(ep,2,2,ng)*bc1
348C
349C I = 3; JJ = 3*(KK+2)=15
350C---------:EPS-X:EPS-Y:EPS-XY
351 bm(i,16)=vq(ep,3,1,ng)*c1
352 bmf(i,16)=thk(ep)*bm(i,16)+vq(ep,3,1,ng)*bc1
353 bm(i,17)=vq(ep,3,2,ng)*c2
354 bmf(i,17)=thk(ep)*bm(i,17)+vq(ep,3,2,ng)*bc2
355 bmf(i,18)=thk(ep)*bm(i,18)+vq(ep,3,1,ng)*bc2+vq(ep,3,2,ng)*bc1
356C
357C---------- TERMES ASSOCIEES AU BETA ----------
358C---------PRODUIT SCALAIRE <T(PG)>*<-T^2 T^1>----------
359 v1(2)=vq(ep,1,1,ng)*vqn(ep,1,2)+vq(ep,2,1,ng)*vqn(ep,2,2)
360 1 +vq(ep,3,1,ng)*vqn(ep,3,2)
361 v1(1)=-(vq(ep,1,1,ng)*vqn(ep,4,2)+vq(ep,2,1,ng)*vqn(ep,5,2)
362 1 +vq(ep,3,1,ng)*vqn(ep,6,2))
363 v2(2)=vq(ep,1,2,ng)*vqn(ep,1,2)+vq(ep,2,2,ng)*vqn(ep,2,2)
364 1 +vq(ep,3,2,ng)*vqn(ep,3,2)
365 v2(1)=-(vq(ep,1,2,ng)*vqn(ep,4,2)+vq(ep,2,2,ng)*vqn(ep,5,2)
366 1 +vq(ep,3,2,ng)*vqn(ep,6,2))
367C----------TERMES ASSOCIEES AUX BETA DE [B01]--
368C JJ = 3*II=6
369 bf(i,7)=v1(1)*c1
370 bf(i,8)=v2(1)*c2
371 bf(i,9)=v1(1)*c2+v2(1)*c1
372 bf(i,10)=v1(2)*c1
373 bf(i,11)=v2(2)*c2
374 bf(i,12)=v1(2)*c2+v2(2)*c1
375 ENDDO
376C
377C--------J=3---II=(J-1)*2 =4 KK = 3*(J-1)=6
378#include "vectorize.inc"
379 DO i=nplat+1,jlt
380 ep=iplat(i)
381C--------- [B0], [B01]---------
382C--------TERMES DE [B0]=<T>CI-------
383 c1=vksi(3,ng)*tc(ep,1,1)+veta(3,ng)*tc(ep,2,1)
384 c2=vksi(3,ng)*tc(ep,1,2)+veta(3,ng)*tc(ep,2,2)
385C--------TERMES ASSOCIEES AUX U,V,W DE [B1]=<T>BCI-------
386 bc1=vksi(3,ng)*tbc(ep,1,1)+veta(3,ng)*tbc(ep,2,1)
387 bc2=vksi(3,ng)*tbc(ep,1,2)+veta(3,ng)*tbc(ep,2,2)
388C I = 1;JJ = 3*KK=18
389C---------:EPS-X:EPS-Y:EPS-XY
390 IF (isrot>0) THEN
391 bxy(1)=vq(ep,1,1,ng)*c2
392 bxy(2)=vq(ep,2,1,ng)*c2
393 bxy(3)=vq(ep,3,1,ng)*c2
394 byx(1)=vq(ep,1,2,ng)*c1
395 byx(2)=vq(ep,2,2,ng)*c1
396 byx(3)=vq(ep,3,2,ng)*c1
397 brz(i,1,3)=-bxy(1)+byx(1)
398 brz(i,2,3)=-bxy(2)+byx(2)
399 brz(i,3,3)=-bxy(3)+byx(3)
400 bm(i,21)=bxy(1)+byx(1)
401 bm(i,24)=bxy(2)+byx(2)
402 bm(i,27)=bxy(3)+byx(3)
403 ELSE
404 bm(i,27)=zero
405 END IF
406 bm(i,19)=vq(ep,1,1,ng)*c1
407 bmf(i,19)=thk(ep)*bm(i,19)+vq(ep,1,1,ng)*bc1
408 bm(i,20)=vq(ep,1,2,ng)*c2
409 bmf(i,20)=thk(ep)*bm(i,20)+vq(ep,1,2,ng)*bc2
410 bmf(i,21)=thk(ep)*bm(i,21)+vq(ep,1,1,ng)*bc2+vq(ep,1,2,ng)*bc1
411C I = 2; JJ = 3*(KK+1)=21
412 bm(i,22)=vq(ep,2,1,ng)*c1
413 bmf(i,22)=thk(ep)*bm(i,22)+vq(ep,2,1,ng)*bc1
414 bm(i,23)=vq(ep,2,2,ng)*c2
415 bmf(i,23)=thk(ep)*bm(i,23)+vq(ep,2,2,ng)*bc2
416 bmf(i,24)=thk(ep)*bm(i,24)+vq(ep,2,1,ng)*bc2+vq(ep,2,2,ng)*bc1
417C I = 3; JJ = 3*(KK+2)=24
418 bm(i,25)=vq(ep,3,1,ng)*c1
419 bmf(i,25)=thk(ep)*bm(i,25)+vq(ep,3,1,ng)*bc1
420 bm(i,26)=vq(ep,3,2,ng)*c2
421 bmf(i,26)=thk(ep)*bm(i,26)+vq(ep,3,2,ng)*bc2
422 bmf(i,27)=thk(ep)*bm(i,27)+vq(ep,3,1,ng)*bc2+vq(ep,3,2,ng)*bc1
423C
424C---------DEF DE FLEXION ASSOCIEE AUX U,V,W ([BMF]=2H[B0]+[B01])------
425C----------[B01]---------
426C---------- TERMES ASSOCIEES AU BETA ----------
427C---------PRODUIT SCALAIRE <T(PG)>*<-T^2 T^1>----------
428 v1(2)=vq(ep,1,1,ng)*vqn(ep,1,3)+vq(ep,2,1,ng)*vqn(ep,2,3)
429 1 +vq(ep,3,1,ng)*vqn(ep,3,3)
430 v1(1)=-(vq(ep,1,1,ng)*vqn(ep,4,3)+vq(ep,2,1,ng)*vqn(ep,5,3)
431 1 +vq(ep,3,1,ng)*vqn(ep,6,3))
432 v2(2)=vq(ep,1,2,ng)*vqn(ep,1,3)+vq(ep,2,2,ng)*vqn(ep,2,3)
433 1 +vq(ep,3,2,ng)*vqn(ep,3,3)
434 v2(1)=-(vq(ep,1,2,ng)*vqn(ep,4,3)+vq(ep,2,2,ng)*vqn(ep,5,3)
435 1 +vq(ep,3,2,ng)*vqn(ep,6,3))
436C----------TERMES ASSOCIEES AUX BETA DE [B01]--
437C JJ = 3*II =12
438 bf(i,13)=v1(1)*c1
439 bf(i,14)=v2(1)*c2
440 bf(i,15)=v1(1)*c2+v2(1)*c1
441 bf(i,16)=v1(2)*c1
442 bf(i,17)=v2(2)*c2
443 bf(i,18)=v1(2)*c2+v2(2)*c1
444 ENDDO
445C
446C--------J=4---II=(J-1)*2 =6 KK = 3*(J-1)=9
447#include "vectorize.inc"
448 DO i=nplat+1,jlt
449 ep=iplat(i)
450C--------- [B0], [B01]---------
451C--------TERMES DE [B0]=<T>CI-------
452 c1=vksi(4,ng)*tc(ep,1,1)+veta(4,ng)*tc(ep,2,1)
453 c2=vksi(4,ng)*tc(ep,1,2)+veta(4,ng)*tc(ep,2,2)
454C--------TERMES ASSOCIEES AUX U,V,W DE [B1]=<T>BCI-------
455 bc1=vksi(4,ng)*tbc(ep,1,1)+veta(4,ng)*tbc(ep,2,1)
456 bc2=vksi(4,ng)*tbc(ep,1,2)+veta(4,ng)*tbc(ep,2,2)
457C I = 1; JJ = 3*KK =27
458 bm(i,28)=vq(ep,1,1,ng)*c1
459 bmf(i,28)=thk(ep)*bm(i,28)+vq(ep,1,1,ng)*bc1
460 bm(i,29)=vq(ep,1,2,ng)*c2
461 bmf(i,29)=thk(ep)*bm(i,29)+vq(ep,1,2,ng)*bc2
462C---------CONTRIBUTION DU <T> :EPS-XY
463 IF (isrot>0) THEN
464 bxy(1)=vq(ep,1,1,ng)*c2
465 bxy(2)=vq(ep,2,1,ng)*c2
466 bxy(3)=vq(ep,3,1,ng)*c2
467 byx(1)=vq(ep,1,2,ng)*c1
468 byx(2)=vq(ep,2,2,ng)*c1
469 byx(3)=vq(ep,3,2,ng)*c1
470 brz(i,1,4)=-bxy(1)+byx(1)
471 brz(i,2,4)=-bxy(2)+byx(2)
472 brz(i,3,4)=-bxy(3)+byx(3)
473 bm(i,30)=bxy(1)+byx(1)
474 bm(i,33)=bxy(2)+byx(2)
475 bm(i,36)=bxy(3)+byx(3)
476 ELSE
477 bm(i,36)=zero
478 END IF
479 bmf(i,30)=thk(ep)*bm(i,30)+vq(ep,1,1,ng)*bc2+vq(ep,1,2,ng)*bc1
480C I = 2; JJ = 3*(KK+1)=30
481 bm(i,31)=vq(ep,2,1,ng)*c1
482 bmf(i,31)=thk(ep)*bm(i,31)+vq(ep,2,1,ng)*bc1
483 bm(i,32)=vq(ep,2,2,ng)*c2
484 bmf(i,32)=thk(ep)*bm(i,32)+vq(ep,2,2,ng)*bc2
485 bmf(i,33)=thk(ep)*bm(i,33)+vq(ep,2,1,ng)*bc2+vq(ep,2,2,ng)*bc1
486C I = 3; JJ = 3*(KK+2)=33
487 bm(i,34)=vq(ep,3,1,ng)*c1
488 bmf(i,34)=thk(ep)*bm(i,34)+vq(ep,3,1,ng)*bc1
489 bm(i,35)=vq(ep,3,2,ng)*c2
490 bmf(i,35)=thk(ep)*bm(i,35)+vq(ep,3,2,ng)*bc2
491 bmf(i,36)=thk(ep)*bm(i,36)+vq(ep,3,1,ng)*bc2+vq(ep,3,2,ng)*bc1
492C
493C---------- TERMES ASSOCIEES AU BETA ----------
494C---------PRODUIT SCALAIRE <T(PG)>*<-T^2 T^1>----------
495 v1(2)=vq(ep,1,1,ng)*vqn(ep,1,4)+vq(ep,2,1,ng)*vqn(ep,2,4)
496 1 +vq(ep,3,1,ng)*vqn(ep,3,4)
497 v1(1)=-(vq(ep,1,1,ng)*vqn(ep,4,4)+vq(ep,2,1,ng)*vqn(ep,5,4)
498 1 +vq(ep,3,1,ng)*vqn(ep,6,4))
499 v2(2)=vq(ep,1,2,ng)*vqn(ep,1,4)+vq(ep,2,2,ng)*vqn(ep,2,4)
500 1 +vq(ep,3,2,ng)*vqn(ep,3,4)
501 v2(1)=-(vq(ep,1,2,ng)*vqn(ep,4,4)+vq(ep,2,2,ng)*vqn(ep,5,4)
502 1 +vq(ep,3,2,ng)*vqn(ep,6,4))
503C----------TERMES ASSOCIEES AUX BETA DE [B01]--
504C JJ = 3*II=18
505 bf(i,19)=v1(1)*c1
506 bf(i,20)=v2(1)*c2
507 bf(i,21)=v1(1)*c2+v2(1)*c1
508 bf(i,22)=v1(2)*c1
509 bf(i,23)=v2(2)*c2
510 bf(i,24)=v1(2)*c2+v2(2)*c1
511C
512 ENDDO
513C--------------------------
514C DEFORMATION OUT-PLANE (C.T)
515C--------------------------
516C [BC](2,5*NPG),VDEF(4,5)
517C--------------------------
518#include "vectorize.inc"
519 DO i=nplat+1,jlt
520 ep=iplat(i)
521 v11(1)=vksi(2,ng)
522 v11(2)=vksi(3,ng)
523 v11(3)=veta(4,ng)
524 v11(4)=veta(3,ng)
525C--- J=1---------------------
526C-----------POINTEURS POUR BC(II,J1~J2)
527C J1=(KA1(1,J)-1)*5=0
528C J2=(KA1(2,J)-1)*5=5
529C II=KIND(J) =1
530C JJ = 3*(J-1) =0
531C--------TERMES <NAI>-------
532 c1=v11(1)*vnrm(ep,1)
533 bc(i,1)=-c1
534 bc(i,11)=c1
535C
536 c1=v11(1)*vnrm(ep,2)
537 bc(i,3)=-c1
538 bc(i,13)=c1
539C
540 c1=v11(1)*vnrm(ep,3)
541 bc(i,5)=-c1
542 bc(i,15)=c1
543C--------TERMES <ASI>-------
544 bc(i,7)=v11(1)*vastn(ep,1)
545 bc(i,9)=v11(1)*vastn(ep,2)
546 bc(i,17)=v11(1)*vastn(ep,3)
547 bc(i,19)=v11(1)*vastn(ep,4)
548C--- J=2---------------------
549C-----------POINTEURS POUR BC(II,J1~J2)
550C J1=(KA1(1,J)-1)*5 =15
551C J2=(KA1(2,J)-1)*5 =10
552C II=KIND(J) =1
553C JJ = 3*(J-1) =3
554C--------TERMES <NAI>-------
555 c1=v11(2)*vnrm(ep,4)
556 bc(i,31)=-c1
557 bc(i,21)=c1
558C
559 c1=v11(2)*vnrm(ep,5)
560 bc(i,33)=-c1
561 bc(i,23)=c1
562C
563 c1=v11(2)*vnrm(ep,6)
564 bc(i,35)=-c1
565 bc(i,25)=c1
566C--------TERMES <ASI>-------
567 bc(i,37)=v11(2)*vastn(ep,5)
568 bc(i,39)=v11(2)*vastn(ep,6)
569 bc(i,27)=v11(2)*vastn(ep,7)
570 bc(i,29)=v11(2)*vastn(ep,8)
571C--- J=3---------------------
572C-----------POINTEURS POUR BC(II,J1~J2)
573C J1=(KA1(1,J)-1)*5 =0
574C J2=(KA1(2,J)-1)*5 =15
575C II=KIND(J) =2
576C JJ = 3*(J-1) =6
577C--------TERMES <NAI>-------
578 c1=v11(3)*vnrm(ep,7)
579 bc(i,2)=-c1
580 bc(i,32)=c1
581C
582 c1=v11(3)*vnrm(ep,8)
583 bc(i,4)=-c1
584 bc(i,34)=c1
585C
586 c1=v11(3)*vnrm(ep,9)
587 bc(i,6)=-c1
588 bc(i,36)=c1
589C--------TERMES <ASI>-------
590 bc(i,8)=v11(3)*vastn(ep,9)
591 bc(i,10)=v11(3)*vastn(ep,10)
592 bc(i,38)=v11(3)*vastn(ep,11)
593 bc(i,40)=v11(3)*vastn(ep,12)
594C--- J=4---------------------
595C-----------POINTEURS POUR BC(II,J1~J2)
596C J1=(KA1(1,J)-1)*5 =5
597C J2=(KA1(2,J)-1)*5 =10
598C II=KIND(J) =2
599C JJ = 3*(J-1) =9
600C--------TERMES <NAI>-------
601 c1=v11(4)*vnrm(ep,10)
602 bc(i,12)=-c1
603 bc(i,22)=c1
604C
605 c1=v11(4)*vnrm(ep,11)
606 bc(i,14)=-c1
607 bc(i,24)=c1
608C
609 c1=v11(4)*vnrm(ep,12)
610 bc(i,16)=-c1
611 bc(i,26)=c1
612C--------TERMES <ASI>-------
613 bc(i,18)=v11(4)*vastn(ep,13)
614 bc(i,20)=v11(4)*vastn(ep,14)
615 bc(i,28)=v11(4)*vastn(ep,15)
616 bc(i,30)=v11(4)*vastn(ep,16)
617 ENDDO
618C--------pour rigidite en rzz-------
619 IF (isrot==0) THEN
620#include "vectorize.inc"
621 DO i=nplat+1,jlt
622 ep=iplat(i)
623 bzz(i,1)=tc(ep,1,1)*vksi(1,ng)+tc(ep,2,1)*veta(1,ng)
624 bzz(i,2)=tc(ep,1,2)*vksi(1,ng)+tc(ep,2,2)*veta(1,ng)
625 bzz(i,3)=tc(ep,1,1)*vksi(2,ng)+tc(ep,2,1)*veta(2,ng)
626 bzz(i,4)=tc(ep,1,2)*vksi(2,ng)+tc(ep,2,2)*veta(2,ng)
627 bzz(i,5)=tc(ep,1,1)*vksi(3,ng)+tc(ep,2,1)*veta(3,ng)
628 bzz(i,6)=tc(ep,1,2)*vksi(3,ng)+tc(ep,2,2)*veta(3,ng)
629 bzz(i,7)=tc(ep,1,1)*vksi(4,ng)+tc(ep,2,1)*veta(4,ng)
630 bzz(i,8)=tc(ep,1,2)*vksi(4,ng)+tc(ep,2,2)*veta(4,ng)
631 ENDDO
632 END IF !(ISROT==0) THEN
633 RETURN
634 END
635!||====================================================================
636!|| cbabec3 ../engine/source/elements/shell/coqueba/cbabe3.f
637!||--- called by ------------------------------------------------------
638!|| cbake3 ../engine/source/elements/shell/coqueba/cbake3.F
639!||====================================================================
640 SUBROUTINE cbabec3(JFT ,JLT ,X13 ,X24 ,Y13 ,Y24 ,
641 1 BM, NPLAT, IPLAT)
642C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
643C CALCUL 'membrane shear traitement' use only PARTIE CONSTANTE
644C-----------------------------------------------
645C I M P L I C I T T Y P E S
646C-----------------------------------------------
647#include "implicit_f.inc"
648#include "mvsiz_p.inc"
649C-----------------------------------------------
650C D U M M Y A R G U M E N T S
651C-----------------------------------------------
652 INTEGER JFT ,JLT,NPLAT,IPLAT(*)
653 my_real
654 . X13(*),X24(*),Y13(*),Y24(*),BM(MVSIZ,36)
655C-----------------------------------------------
656C L O C A L V A R I A B L E S
657C-----------------------------------------------
658 INTEGER I ,J,EP
659#include "vectorize.inc"
660 DO EP=nplat+1,jlt
661 i=iplat(ep)
662 bm(ep,3)=-x24(i)
663 bm(ep,6)=y24(i)
664 bm(ep,12)=x13(i)
665 bm(ep,15)=-y13(i)
666 bm(ep,21)=-bm(ep,3)
667 bm(ep,24)=-bm(ep,6)
668 bm(ep,30)=-bm(ep,12)
669 bm(ep,33)=-bm(ep,15)
670 bm(ep,9)=zero
671 bm(ep,18)=zero
672 bm(ep,27)=zero
673 bm(ep,36)=zero
674 ENDDO
675 RETURN
676 END
677!||====================================================================
678!|| cbaber3 ../engine/source/elements/shell/coqueba/cbabe3.F
679!||--- called by ------------------------------------------------------
680!|| cbake3 ../engine/source/elements/shell/coqueba/cbake3.F
681!||====================================================================
682 SUBROUTINE cbaber3(JFT ,JLT ,BM0RZ,BMKRZ,BMERZ ,
683 2 BMRZ ,BRZ ,BM ,NPLAT ,IPLAT,
684 3 NG )
685C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
686#include "implicit_f.inc"
687#include "mvsiz_p.inc"
688C-----------------------------------------------
689C D U M M Y A R G U M E N T S
690C-----------------------------------------------
691 INTEGER JFT,JLT,IPLAT(*),NPLAT,NG
692 my_real
693 . BM0RZ(MVSIZ,4,4),BMKRZ(MVSIZ,4,4),BMERZ(MVSIZ,4,4),
694 . BMRZ(MVSIZ,3,4),BM(MVSIZ,36),BRZ(MVSIZ,4,4)
695C-----------------------------------------------
696C L O C A L V A R I A B L E S
697C-----------------------------------------------
698 INTEGER I,J,EP,NPG
699 PARAMETER (NPG = 4)
700 my_real
701 . vpg(2,npg),pg,pg1
702 PARAMETER (pg=.577350269189626)
703 parameter(pg1=-.577350269189626)
704C--------------------------
705C INITIALISATION
706C--------------------------
707 DATA vpg/pg1,pg1,pg,pg1,pg,pg,pg1,pg/
708C---------------
709C--------pay attention QEPH: Bi*A--- RLZ: VRZ/A-- QBAT:Bi--RLZ:VRZ
710 DO j=1,4
711 DO i=jft,jlt
712 bmrz(i,1,j) = bm0rz(i,1,j)+bmkrz(i,1,j)*vpg(1,ng)+
713 . bmerz(i,1,j)*vpg(2,ng)
714 bmrz(i,2,j) = bm0rz(i,2,j)+bmkrz(i,2,j)*vpg(1,ng)+
715 . bmerz(i,2,j)*vpg(2,ng)
716 bmrz(i,3,j) = bm0rz(i,3,j)+bmkrz(i,3,j)*vpg(1,ng)+
717 . bmerz(i,3,j)*vpg(2,ng)
718C
719 brz(i,4,j) = bm0rz(i,4,j)+bmkrz(i,4,j)*vpg(1,ng)+
720 . bmerz(i,4,j)*vpg(2,ng)
721 ENDDO
722 ENDDO
723C
724 RETURN
725 END
subroutine cbabec3(jft, jlt, x13, x24, y13, y24, bm, nplat, iplat)
Definition cbabe3.F:642
subroutine cbaber3(jft, jlt, bm0rz, bmkrz, bmerz, bmrz, brz, bm, nplat, iplat, ng)
Definition cbabe3.F:685
subroutine cbabe3(jft, jlt, ng, vcore, area, cdet, vqn, vq, vjfi, vnrm, vastn, hx, hy, veta, vksi, bm, bmf, bf, bc, tc, bzz, nplat, iplat, isrot, brz)
Definition cbabe3.F:38
#define my_real
Definition cppsort.cpp:32
subroutine area(d1, x, x2, y, y2, eint, stif0)
#define max(a, b)
Definition macros.h:21