OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
projecig3d.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/.
23!||====================================================================
24!|| projecig3d ../engine/source/elements/ige3d/projecig3d.F
25!||--- called by ------------------------------------------------------
26!|| animig3d ../engine/source/output/anim/generate/animig3d.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| ig3donebasis ../engine/source/elements/ige3d/ig3donebasis.F
31!|| ig3donederiv ../engine/source/elements/ige3d/ig3donederiv.F
32!||--- uses -----------------------------------------------------
33!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
34!|| message_mod ../engine/share/message_module/message_mod.F
35!||====================================================================
36 SUBROUTINE projecig3d(ELBUF_TAB, IPARG ,X , D, V, A, WIGE ,KXIG3D ,IXIG3D ,
37 . IG3DSOLID,NANIM3D_L, X_TEMP, D_TEMP, V_TEMP, A_TEMP, TABSTRESL,
38 . IGEO,KNOT, NG, NBG, NISOELCUT, NCTRL, NEL_P, ITAB, CONT, CONT_TEMP,
39 . FINT, FINT_TEMP, FEXT, FEXT_TEMP, FREAC, FREACT_TEMP,
40 . PX, PY, PZ,KNOTLOCPC,KNOTLOCEL)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE elbufdef_mod
45 USE message_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "vect01_c.inc"
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "param_c.inc"
61#include "tabsiz_c.inc"
62#include "scr14_c.inc"
63#include "ige3d_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER KXIG3D(NIXIG3D,*),IXIG3D(*),IGEO(NPROPGI,*),
68 . NANIM3D_L, IPARG(NPARG,*), NISOELCUT, NG, NBG, NCTRL, NEL_P, ITAB(*), ! DISCUTER DE COMMENT RENVOYER NANIM3D_L
69 . PX,PY,PZ
70 INTEGER IG3DSOLID(8,27,*)
71 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
72 my_real
73 . X(3,*),D(3,*),V(3,*),A(3,*),WIGE(*),KNOT(*),
74 . x_temp(3,*),d_temp(3,*),v_temp(3,*),a_temp(3,*),
75 . cont(3,*),cont_temp(3,*),
76 . fint(3,*),fint_temp(3,*),fext(3,*),fext_temp(3,*),
77 . freac(6,*),freact_temp(3,*),knotlocpc(deg_max,3,*),knotlocel(2,3,*)
78 my_real,
79 . DIMENSION(6,*) :: tabstresl
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER IDX(MVSIZ),IDY(MVSIZ),IDZ(MVSIZ),
84 . IDX2(MVSIZ),IDY2(MVSIZ),IDZ2(MVSIZ),
85 . N1, N2, N3,NKNOT1,NKNOT2,NKNOT3, I, J,K, JJ, L, M, N,
86 . O, P, Q, BID, COUNT, PROJEC,
87 . itens, idbrick, inctrl,ierror,
88 . iprop, nelig3d,iad_knot,
89 . ir, is, it, ing, decal, count2, count3, nel,
90 . idfrstlocknt,idpc
91 my_real
92 . xx(nctrl,mvsiz),yy(nctrl,mvsiz),zz(nctrl,mvsiz),
93 . dx(nctrl,mvsiz),dy(nctrl,mvsiz),dz(nctrl,mvsiz),
94 . ux(nctrl,mvsiz),uy(nctrl,mvsiz),uz(nctrl,mvsiz),
95 . vx(nctrl,mvsiz),vy(nctrl,mvsiz),vz(nctrl,mvsiz),
96 . ax(nctrl,mvsiz),ay(nctrl,mvsiz),az(nctrl,mvsiz),
97 . contx(nctrl,mvsiz),conty(nctrl,mvsiz),contz(nctrl,mvsiz),
98 . fintx(nctrl,mvsiz),finty(nctrl,mvsiz),fintz(nctrl,mvsiz),
99 . fextx(nctrl,mvsiz),fexty(nctrl,mvsiz),fextz(nctrl,mvsiz),
100 . freactx(nctrl,mvsiz),freacty(nctrl,mvsiz),freactz(nctrl,mvsiz),
101 . ww(nctrl,mvsiz),pasx, pasy, pasz, r(nctrl),
102 . xi(3), xxi(3), di(3), vi(3), ai(3),conti(3),
103 . finti(3),fexti(3),freacti(3),
104 . s(6), zr, zs, zt, detjac, pgauss,knotlocx(px+1,nctrl,mvsiz),
105 . knotlocy(py+1,nctrl,mvsiz),knotlocz(pz+1,nctrl,mvsiz),
106 . knotlocelx(2,mvsiz),
107 . knotlocely(2,mvsiz),knotlocelz(2,mvsiz)
108 TYPE(l_bufel_) ,POINTER :: LBUF
109 my_real,
110 . ALLOCATABLE, DIMENSION(:) :: MAB
111 my_real,
112 . ALLOCATABLE, DIMENSION(:,:) :: ri,fi
113 my_real
114 . rbid,tbid(nctrl,3)
115C----------------------------------------------------------
116 double precision
117 . w_gauss(9,9),a_gauss(9,9)
118 DATA w_gauss /
119 1 2.d0 ,0.d0 ,0.d0 ,
120 1 0.d0 ,0.d0 ,0.d0 ,
121 1 0.d0 ,0.d0 ,0.d0 ,
122 2 1.d0 ,1.d0 ,0.d0 ,
123 2 0.d0 ,0.d0 ,0.d0 ,
124 2 0.d0 ,0.d0 ,0.d0 ,
125 3 0.555555555555556d0,0.888888888888889d0,0.555555555555556d0,
126 3 0.d0 ,0.d0 ,0.d0 ,
127 3 0.d0 ,0.d0 ,0.d0 ,
128 4 0.347854845137454d0,0.652145154862546d0,0.652145154862546d0,
129 4 0.347854845137454d0,0.d0 ,0.d0 ,
130 4 0.d0 ,0.d0 ,0.d0 ,
131 5 0.236926885056189d0,0.478628670499366d0,0.568888888888889d0,
132 5 0.478628670499366d0,0.236926885056189d0,0.d0 ,
133 5 0.d0 ,0.d0 ,0.d0 ,
134 6 0.171324492379170d0,0.360761573048139d0,0.467913934572691d0,
135 6 0.467913934572691d0,0.360761573048139d0,0.171324492379170d0,
136 6 0.d0 ,0.d0 ,0.d0 ,
137 7 0.129484966168870d0,0.279705391489277d0,0.381830050505119d0,
138 7 0.417959183673469d0,0.381830050505119d0,0.279705391489277d0,
139 7 0.129484966168870d0,0.d0 ,0.d0 ,
140 8 0.101228536290376d0,0.222381034453374d0,0.313706645877887d0,
141 8 0.362683783378362d0,0.362683783378362d0,0.313706645877887d0,
142 8 0.222381034453374d0,0.101228536290376d0,0.d0 ,
143 9 0.081274388361574d0,0.180648160694857d0,0.260610696402935d0,
144 9 0.312347077040003d0,0.330239355001260d0,0.312347077040003d0,
145 9 0.260610696402935d0,0.180648160694857d0,0.081274388361574d0/
146 DATA a_gauss /
147 1 0.d0 ,0.d0 ,0.d0 ,
148 1 0.d0 ,0.d0 ,0.d0 ,
149 1 0.d0 ,0.d0 ,0.d0 ,
150 2 -.577350269189625d0,0.577350269189625d0,0.d0 ,
151 2 0.d0 ,0.d0 ,0.d0 ,
152 2 0.d0 ,0.d0 ,0.d0 ,
153 3 -.774596669241483d0,0.d0 ,0.774596669241483d0,
154 3 0.d0 ,0.d0 ,0.d0 ,
155 3 0.d0 ,0.d0 ,0.d0 ,
156 4 -.861136311594053d0,-.339981043584856d0,0.339981043584856d0,
157 4 0.861136311594053d0,0.d0 ,0.d0 ,
158 4 0.d0 ,0.d0 ,0.d0 ,
159 5 -.906179845938664d0,-.538469310105683d0,0.d0 ,
160 5 0.538469310105683d0,0.906179845938664d0,0.d0 ,
161 5 0.d0 ,0.d0 ,0.d0 ,
162 6 -.932469514203152d0,-.661209386466265d0,-.238619186083197d0,
163 6 0.238619186083197d0,0.661209386466265d0,0.932469514203152d0,
164 6 0.d0 ,0.d0 ,0.d0 ,
165 7 -.949107912342759d0,-.741531185599394d0,-.405845151377397d0,
166 7 0.d0 ,0.405845151377397d0,0.741531185599394d0,
167 7 0.949107912342759d0,0.d0 ,0.d0 ,
168 8 -.960289856497536d0,-.796666477413627d0,-.525532409916329d0,
169 8 -.183434642495650d0,0.183434642495650d0,0.525532409916329d0,
170 8 0.796666477413627d0,0.960289856497536d0,0.d0 ,
171 9 -.968160239507626d0,-.836031107326636d0,-.613371432700590d0,
172 9 -.324253423403809d0,0.d0 ,0.324253423403809d0,
173 9 0.613371432700590d0,0.836031107326636d0,0.968160239507626d0/
174C
175C-----------------------------------------------
176
177 ierror = 0
178 iprop=iparg(62,ng)
179 iad_knot = igeo(40,iprop)
180 n1 = igeo(44,iprop)
181 n2 = igeo(45,iprop)
182 n3 = igeo(46,iprop)
183 idfrstlocknt = igeo(47,iprop)
184 nknot1 = n1+px
185 nknot2 = n2+py
186 nknot3 = n3+pz
187 knotlocx = zero
188 knotlocy = zero
189 knotlocz = zero
190 knotlocelx = zero
191 knotlocely = zero
192 knotlocelz = zero
193
194 ALLOCATE(mab(sixig3d),ri(6,sixig3d),
195 . fi(6,sixig3d), stat=ierror)
196
197 IF(ierror/=0)THEN
198 CALL ancmsg(msgid=249,anmode=aninfo)
199 CALL arret(2)
200 END IF
201
202 mab(:) = zero
203 ri(:,:) = zero
204 decal = nisoelcut
205
206 count3 = 0
207
208 DO ing=ng,ng+nbg-1
209
210 nft=iparg(3,ing)
211 nel=iparg(2,ing)
212 llt=min(nvsiz,nel)
213
214 DO i=lft,llt
215 DO j=1,nctrl
216 IF( j <= kxig3d(3,i+nft) ) THEN
217 xx(j,i)=x(1,ixig3d(kxig3d(4,i+nft)+j-1))
218 yy(j,i)=x(2,ixig3d(kxig3d(4,i+nft)+j-1))
219 zz(j,i)=x(3,ixig3d(kxig3d(4,i+nft)+j-1))
220 IF(anim_v(1)==1) THEN
221 vx(j,i)=v(1,ixig3d(kxig3d(4,i+nft)+j-1))
222 vy(j,i)=v(2,ixig3d(kxig3d(4,i+nft)+j-1))
223 vz(j,i)=v(3,ixig3d(kxig3d(4,i+nft)+j-1))
224 ENDIF
225 IF(anim_v(2)==1) THEN
226 dx(j,i)=d(1,ixig3d(kxig3d(4,i+nft)+j-1))
227 dy(j,i)=d(2,ixig3d(kxig3d(4,i+nft)+j-1))
228 dz(j,i)=d(3,ixig3d(kxig3d(4,i+nft)+j-1))
229 ENDIF
230 IF(anim_v(3)==1) THEN
231 ax(j,i)=a(1,ixig3d(kxig3d(4,i+nft)+j-1))
232 ay(j,i)=a(2,ixig3d(kxig3d(4,i+nft)+j-1))
233 az(j,i)=a(3,ixig3d(kxig3d(4,i+nft)+j-1))
234 ENDIF
235 IF(anim_v(4)>0)THEN
236 contx(j,i)=cont(1,ixig3d(kxig3d(4,i+nft)+j-1))
237 conty(j,i)=cont(2,ixig3d(kxig3d(4,i+nft)+j-1))
238 contz(j,i)=cont(3,ixig3d(kxig3d(4,i+nft)+j-1))
239 ENDIF
240 IF(anim_v(5)==1) THEN
241 fintx(j,i)=fint(1,ixig3d(kxig3d(4,i+nft)+j-1))
242 finty(j,i)=fint(2,ixig3d(kxig3d(4,i+nft)+j-1))
243 fintz(j,i)=fint(3,ixig3d(kxig3d(4,i+nft)+j-1))
244 ENDIF
245 IF(anim_v(6)==1) THEN
246 fextx(j,i)=fext(1,ixig3d(kxig3d(4,i+nft)+j-1))
247 fexty(j,i)=fext(2,ixig3d(kxig3d(4,i+nft)+j-1))
248 fextz(j,i)=fext(3,ixig3d(kxig3d(4,i+nft)+j-1))
249 ENDIF
250 IF(anim_v(17)==1) THEN
251 freactx(j,i)=freac(1,ixig3d(kxig3d(4,i+nft)+j-1))
252 freacty(j,i)=freac(2,ixig3d(kxig3d(4,i+nft)+j-1))
253 freactz(j,i)=freac(3,ixig3d(kxig3d(4,i+nft)+j-1))
254 ENDIF
255 ww(j,i)=1!WIGE(IXIG3D(KXIG3D(4,I+NFT)+J-1))
256 DO k=1,px+1
257 knotlocx(k,j,i)=knotlocpc(k,1,(kxig3d(2,i+nft)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
258 ENDDO
259 DO k=1,py+1
260 knotlocy(k,j,i)=knotlocpc(k,2,(kxig3d(2,i+nft)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
261 ENDDO
262 DO k=1,pz+1
263 knotlocz(k,j,i)=knotlocpc(k,3,(kxig3d(2,i+nft)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
264 ENDDO
265 ENDIF
266 ENDDO
267 idx(i) = kxig3d(6,i+nft)
268 idy(i) = kxig3d(7,i+nft)
269 idz(i) = kxig3d(8,i+nft)
270 idx2(i) = kxig3d(9,i+nft)
271 idy2(i) = kxig3d(10,i+nft)
272 idz2(i) = kxig3d(11,i+nft)
273 knotlocelx(1,i) = knotlocel(1,1,i+nft)
274 knotlocely(1,i) = knotlocel(1,2,i+nft)
275 knotlocelz(1,i) = knotlocel(1,3,i+nft)
276 knotlocelx(2,i) = knotlocel(2,1,i+nft)
277 knotlocely(2,i) = knotlocel(2,2,i+nft)
278 knotlocelz(2,i) = knotlocel(2,3,i+nft)
279 ENDDO
280
281 count = 0
282
283 DO i=lft,llt
284
285 pasx = (knotlocelx(2,i) - knotlocelx(1,i)) / three
286 pasy = (knotlocely(2,i) - knotlocely(1,i)) / three
287 pasz = (knotlocelz(2,i) - knotlocelz(1,i)) / three
288c PASX = (KNOT(IAD_KNOT+IDX2(I)) - KNOT(IAD_KNOT+IDX(I))) / THREE
289c PASY = (KNOT(IAD_KNOT+NKNOT1+IDY2(I)) - KNOT(IAD_KNOT+NKNOT1+IDY(I))) / THREE
290c PASZ = (KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ2(I)) - KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ(I))) / THREE
291c PASX = (KNOT(IAD_KNOT+IDX(I)+1) - KNOT(IAD_KNOT+IDX(I))) / THREE
292c PASY = (KNOT(IAD_KNOT+NKNOT1+1+IDY(I)) - KNOT(IAD_KNOT+NKNOT1+IDY(I))) / THREE
293c PASZ = (KNOT(IAD_KNOT+NKNOT1+NKNOT2+1+IDZ(I)) - KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ(I))) / THREE
294
295 DO n=1,4
296 DO m=1,4
297 DO l=1,4
298
299 count = count+1
300 count3 = count3+1
301
302 DO itens=1,3
303 xxi(itens) = zero
304 IF(anim_v(1)==1) THEN
305 vi(itens) = zero
306 ENDIF
307 IF(anim_v(2)==1) THEN
308 di(itens) = zero
309 ENDIF
310 IF(anim_v(3)==1) THEN
311 ai(itens) = zero
312 ENDIF
313 IF(anim_v(4)>0)THEN
314 conti(itens) = zero
315 ENDIF
316 IF(anim_v(5)>0)THEN
317 finti(itens) = zero
318 ENDIF
319 IF(anim_v(6)>0)THEN
320 fexti(itens) = zero
321 ENDIF
322 IF(anim_v(17)>0)THEN
323 freacti(itens) = zero
324 ENDIF
325 ENDDO
326
327 xi(1) = knotlocelx(1,i) + (l-1)*pasx
328 xi(2) = knotlocely(1,i) + (m-1)*pasy
329 xi(3) = knotlocelz(1,i) + (n-1)*pasz
330c XI(1) = KNOT(IAD_KNOT+IDX(I)) + (L-1)*PASX
331c XI(2) = KNOT(IAD_KNOT+NKNOT1+IDY(I)) + (M-1)*PASY
332c XI(3) = KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ(I)) + (N-1)*PASZ
333
334c CALL IGE3DBASIS(
335c . I ,BID ,XX(:,I) ,YY(:,I) ,ZZ(:,I) ,WW(:,I) ,
336c . IDX(I) ,IDY(I) ,IDZ(I) ,R ,
337c . NCTRL ,XI(1) ,XI(2) ,XI(3) ,KNOT(IAD_KNOT+1), KNOT(IAD_KNOT+NKNOT1+1),
338c . KNOT(IAD_KNOT+NKNOT1+NKNOT2+1)
339
340 CALL ig3donebasis(
341 1 i ,bid ,xx(:,i) ,yy(:,i),
342 2 zz(:,i),ww(:,i) ,idx(i) ,idy(i) ,
343 3 idz(i) ,knotlocx(:,:,i) ,knotlocy(:,:,i),knotlocz(:,:,i),
344 4 r ,nctrl ,
345 5 xi(1) ,xi(2) ,xi(3) ,knot(iad_knot+1),
346 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
347 7 py-1 ,pz-1 ,0 ,
348 8 idx2(i),idy2(i) ,idz2(i) ,
349 9 knotlocelx(:,i),knotlocely(:,i),knotlocelz(:,i))
350
351 DO j=1,nctrl
352 xxi(1) = xxi(1) + r(j)*xx(j,i)
353 xxi(2) = xxi(2) + r(j)*yy(j,i)
354 xxi(3) = xxi(3) + r(j)*zz(j,i)
355 IF(anim_v(1)==1) THEN
356 vi(1) = vi(1) + r(j)*vx(j,i)
357 vi(2) = vi(2) + r(j)*vy(j,i)
358 vi(3) = vi(3) + r(j)*vz(j,i)
359 ENDIF
360 IF(anim_v(2)==1) THEN
361 di(1) = di(1) + r(j)*dx(j,i)
362 di(2) = di(2) + r(j)*dy(j,i)
363 di(3) = di(3) + r(j)*dz(j,i)
364 ENDIF
365 IF(anim_v(3)==1) THEN
366 ai(1) = ai(1) + r(j)*ax(j,i)
367 ai(2) = ai(2) + r(j)*ay(j,i)
368 ai(3) = ai(3) + r(j)*az(j,i)
369 ENDIF
370 IF(anim_v(4)>0)THEN
371 conti(1) = conti(1) + r(j)*contx(j,i)
372 conti(2) = conti(2) + r(j)*conty(j,i)
373 conti(3) = conti(3) + r(j)*contz(j,i)
374 ENDIF
375 IF(anim_v(5)>0)THEN
376 finti(1) = finti(1) + r(j)*fintx(j,i)
377 finti(2) = finti(2) + r(j)*finty(j,i)
378 finti(3) = finti(3) + r(j)*fintz(j,i)
379 ENDIF
380 IF(anim_v(6)>0)THEN
381 fexti(1) = fexti(1) + r(j)*fextx(j,i)
382 fexti(2) = fexti(2) + r(j)*fexty(j,i)
383 fexti(3) = fexti(3) + r(j)*fextz(j,i)
384 ENDIF
385 IF(anim_v(17)>0)THEN
386 freacti(1) = freacti(1) + r(j)*freactx(j,i)
387 freacti(2) = freacti(2) + r(j)*freacty(j,i)
388 freacti(3) = freacti(3) + r(j)*freactz(j,i)
389 ENDIF
390 ENDDO
391
392 DO itens=1,3
393 x_temp(itens,count + decal*64) = xxi(itens)
394 IF(anim_v(1)==1) THEN
395 v_temp(itens,count + decal*64) = vi(itens)
396 ENDIF
397 IF(anim_v(2)==1) THEN
398 d_temp(itens,count + decal*64) = di(itens)
399 ENDIF
400 IF(anim_v(3)==1) THEN
401 a_temp(itens,count + decal*64) = ai(itens)
402 ENDIF
403 IF(anim_v(4)>0)THEN
404 cont_temp(itens,count + decal*64) = conti(itens)
405 ENDIF
406 IF(anim_v(5)>0)THEN
407 fint_temp(itens,count + decal*64) = finti(itens)
408 ENDIF
409 IF(anim_v(6)>0)THEN
410 fext_temp(itens,count + decal*64) = fexti(itens)
411 ENDIF
412 IF(anim_v(17)>0)THEN
413 freact_temp(itens,count + decal*64) = freacti(itens)
414 ENDIF
415 ENDDO
416
417 ENDDO
418 ENDDO
419 ENDDO
420
421 idbrick=0
422 DO l=1,2+1
423 DO m=0,2
424 DO n=0,2
425 idbrick = idbrick+1
426 ig3dsolid(1,idbrick,i+nft) = numnod + 64*(i-1) + decal*64 - 1 + l +m *(2+2)+n *((2+2)*(2+2))
427 ig3dsolid(2,idbrick,i+nft) = numnod + 64*(i-1) + decal*64 - 1 + (l+1)+m *(2+2)+n *((2+2)*(2+2))
428 ig3dsolid(3,idbrick,i+nft) = numnod + 64*(i-1) + decal*64 - 1 + (l+1)+(m+1)*(2+2)+n *((2+2)*(2+2))
429 ig3dsolid(4,idbrick,i+nft) = numnod + 64*(i-1) + decal*64 - 1 + l +(m+1)*(2+2)+n *((2+2)*(2+2))
430 ig3dsolid(5,idbrick,i+nft) = numnod + 64*(i-1) + decal*64 - 1 + l +m *(2+2)+(n+1)*((2+2)*(2+2))
431 ig3dsolid(6,idbrick,i+nft) = numnod + 64*(i-1) + decal*64 - 1 + (l+1)+m *(2+2)+(n+1)*((2+2)*(2+2))
432 ig3dsolid(7,idbrick,i+nft) = numnod + 64*(i-1) + decal*64 - 1 + (l+1)+(m+1)*(2+2)+(n+1)*((2+2)*(2+2))
433 ig3dsolid(8,idbrick,i+nft) = numnod + 64*(i-1) + decal*64 - 1 + l +(m+1)*(2+2)+(n+1)*((2+2)*(2+2))
434 ENDDO
435 ENDDO
436 ENDDO
437
438 ENDDO
439
440c METHODE DE PROJECTION PAR LES MOINDRES CARRES SUR LE PATCH
441
442 count2 = 0
443
444 DO ir=1,px
445 DO is=1,py
446 DO it=1,pz
447
448 count2 = count2+1
449 lbuf => elbuf_tab(ing)%BUFLY(1)%LBUF(ir,is,it)
450
451 zr = a_gauss(ir,px)
452 zs = a_gauss(is,py)
453 zt = a_gauss(it,pz)
454 pgauss = w_gauss(ir,px)*w_gauss(is,py)*w_gauss(it,pz)
455
456 DO i=lft,llt
457 jj = 6*(i-1)
458
459c CALL IGE3DDERIV(
460c . I ,BID ,XX(:,I),YY(:,I),ZZ(:,I),WW(:,I),
461c . IDX(I), IDY(I), IDZ(I), TBID, R, DETJAC,
462c . NCTRL, ZR, ZS, ZT, KNOT(IAD_KNOT+1), KNOT(IAD_KNOT+NKNOT1+1),
463c . KNOT(IAD_KNOT+NKNOT1+NKNOT2+1), PX-1, PY-1, PZ-1, 1)
464
465 CALL ig3donederiv(
466 1 i ,bid ,xx(:,i),yy(:,i),
467 2 zz(:,i),ww(:,i),idx(i) ,idy(i) ,
468 3 idz(i) ,knotlocx(:,:,i) ,knotlocy(:,:,i),knotlocz(:,:,i) ,
469 4 tbid ,r ,detjac ,nctrl ,
470 5 zr ,zs ,zt ,knot(iad_knot+1),
471 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
472 7 py-1 ,pz-1 ,1 ,
473 8 idx2(i),idy2(i) ,idz2(i) ,
474 9 knotlocelx(:,i),knotlocely(:,i),knotlocelz(:,i))
475
476 DO j=1,nctrl
477 inctrl = ixig3d(kxig3d(4,i+nft)+j-1)
478 mab(inctrl) = mab(inctrl) + r(j)*detjac*pgauss
479 DO itens=1,6
480 ri(itens,inctrl) = ri(itens,inctrl) + r(j)*lbuf%SIG((itens-1)*nel+i)*detjac*pgauss
481 ENDDO
482 ENDDO
483 ENDDO
484
485 ENDDO
486 ENDDO
487 ENDDO
488
489 decal = decal + nel
490
491 ENDDO
492
493 DO ing=ng,ng+nbg-1
494
495 nft=iparg(3,ing)
496 nel=iparg(2,ing)
497 llt=min(nvsiz,nel)
498
499 DO i=lft,llt
500 DO j=1,nctrl
501 inctrl = ixig3d(kxig3d(4,i+nft)+j-1)
502 DO itens=1,6
503 fi(itens,inctrl) = ri(itens,inctrl)/mab(inctrl)
504 ENDDO
505 ENDDO
506 ENDDO
507
508 ENDDO
509
510 count3 = 0
511
512 DO ing=ng,ng+nbg-1
513
514 nft=iparg(3,ing)
515 nel=iparg(2,ing)
516 llt=min(nvsiz,nel)
517
518 DO i=lft,llt
519
520 pasx = (knotlocelx(2,i) - knotlocelx(1,i)) / three
521 pasy = (knotlocely(2,i) - knotlocely(1,i)) / three
522 pasz = (knotlocelz(2,i) - knotlocelz(1,i)) / three
523c PASX = (KNOT(IAD_KNOT+IDX2(I)) - KNOT(IAD_KNOT+IDX(I))) / THREE
524c PASY = (KNOT(IAD_KNOT+NKNOT1+IDY2(I)) - KNOT(IAD_KNOT+NKNOT1+IDY(I))) / THREE
525c PASZ = (KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ2(I)) - KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ(I))) / THREE
526c PASX = (KNOT(IAD_KNOT+IDX(I)+1) - KNOT(IAD_KNOT+IDX(I))) / THREE
527c PASY = (KNOT(IAD_KNOT+NKNOT1+1+IDY(I)) - KNOT(IAD_KNOT+NKNOT1+IDY(I))) / THREE
528c PASZ = (KNOT(IAD_KNOT+NKNOT1+NKNOT2+1+IDZ(I)) - KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ(I))) / THREE
529
530 DO n=1,4
531 DO m=1,4
532 DO l=1,4
533
534 xi(1) = knotlocelx(1,i) + (l-1)*pasx
535 xi(2) = knotlocely(1,i) + (m-1)*pasy
536 xi(3) = knotlocelz(1,i) + (n-1)*pasz
537c XI(1) = KNOT(IAD_KNOT+IDX(I)) + (L-1)*PASX
538c XI(2) = KNOT(IAD_KNOT+NKNOT1+IDY(I)) + (M-1)*PASY
539c XI(3) = KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ(I)) + (N-1)*PASZ
540
541c CALL IGE3DBASIS(
542c . I ,BID ,XX(:,I) ,YY(:,I) ,ZZ(:,I) ,WW(:,I) ,
543c . IDX(I) ,IDY(I) ,IDZ(I) ,R ,
544c . NCTRL ,XI(1) ,XI(2) ,XI(3) ,KNOT(IAD_KNOT+1), KNOT(IAD_KNOT+NKNOT1+1),
545c . KNOT(IAD_KNOT+NKNOT1+NKNOT2+1) ,PX-1 ,PY-1 ,PZ-1 ,0 )
546
547 CALL ig3donebasis(
548 1 i ,bid ,xx(:,i) ,yy(:,i),
549 2 zz(:,i),ww(:,i) ,idx(i) ,idy(i) ,
550 3 idz(i) ,knotlocx(:,:,i) ,knotlocy(:,:,i),knotlocz(:,:,i) ,
551 4 r ,nctrl ,
552 5 xi(1) ,xi(2) ,xi(3) ,knot(iad_knot+1),
553 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
554 7 py-1 ,pz-1 ,0 ,
555 8 idx2(i),idy2(i) ,idz2(i) ,
556 9 knotlocelx(:,i),knotlocely(:,i),knotlocelz(:,i))
557 count3 = count3+1
558
559 DO itens=1,6
560 s(itens) = zero
561 ENDDO
562
563 DO j=1,nctrl
564 inctrl = ixig3d(kxig3d(4,i+nft)+j-1)
565 DO itens=1,6
566 s(itens) = s(itens) + r(j)*fi(itens,inctrl)
567 ENDDO
568 ENDDO
569
570 DO itens=1,6
571 tabstresl(itens,count3 + nisoelcut*64) = s(itens)
572 ENDDO
573
574 ENDDO
575 ENDDO
576 ENDDO
577 ENDDO
578
579 ENDDO
580
581 DEALLOCATE(mab,ri,fi)
582
583 nisoelcut = decal
584C-----------
585 RETURN
586 END
587
count3
subroutine count3(irect, mnn, n, nrt, ntag)
Definition count3.F:33
min
#define min(a, b)
Definition macros.h:20
message_mod
Definition message_mod.F:1249
projecig3d
subroutine projecig3d(elbuf_tab, iparg, x, d, v, a, wige, kxig3d, ixig3d, ig3dsolid, nanim3d_l, x_temp, d_temp, v_temp, a_temp, tabstresl, igeo, knot, ng, nbg, nisoelcut, nctrl, nel_p, itab, cont, cont_temp, fint, fint_temp, fext, fext_temp, freac, freact_temp, px, py, pz, knotlocpc, knotlocel)
Definition projecig3d.F:41
ig3donebasis
subroutine ig3donebasis(itel, n, xxi, yyi, zzi, wwi, idx, idy, idz, knotlocx, knotlocy, knotlocz, r, nctrl, gaussx, gaussy, gaussz, kx, ky, kz, px, py, pz, boolg, idx2, idy2, idz2, knotlocelx, knotlocely, knotlocelz)
Definition ig3donebasis.F:42
ig3donederiv
subroutine ig3donederiv(itel, n, xxi, yyi, zzi, wwi, idx, idy, idz, knotlocx, knotlocy, knotlocz, drdx, r, detjac, nctrl, gaussx, gaussy, gaussz, kx, ky, kz, px, py, pz, boolg, idx2, idy2, idz2, knotlocelx, knotlocely, knotlocelz)
Definition ig3donederiv.F:43
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87