OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21lagm.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!|| i21lagm ../engine/source/interfaces/int17/i21lagm.F
25!||--- called by ------------------------------------------------------
26!|| i17main ../engine/source/interfaces/int17/i17main.F
27!||--- calls -----------------------------------------------------
28!|| i21lll ../engine/source/interfaces/int17/i21lagm.F
29!||====================================================================
30 SUBROUTINE i21lagm(X ,V ,LLL ,JLL ,SLL ,
31 2 XLL ,CANDN ,CANDE ,I_STOK,IXS ,
32 3 IXS20 ,IADLL ,EMINX ,NSV ,NELEM ,
33 4 NC ,N_MUL_MX,ITASK ,A ,ITIED ,
34 5 NINT ,NKMAX ,EMINXS ,COMNTAG)
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C G l o b a l P a r a m e t e r s
41C-----------------------------------------------
42#include "mvsiz_p.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "task_c.inc"
47#include "com04_c.inc"
48#include "com08_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER NC,I_STOK,N_MUL_MX,ITASK,ITIED,NINT,NKMAX ,
53 . LLL(*),JLL(*),SLL(*),CANDN(*),CANDE(*),COMNTAG(*),
54 . IXS(NIXS,*),IXS20(12,*),IADLL(*),NSV(*) ,NELEM(*)
55C REAL
57 . x(3,*),v(3,*),xll(*),
58 . eminx(6,*),eminxs(6,*),a(3,*)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I,J,K,IK,IE,IS,IC,NK,III(MVSIZ,21),LLT,NFT,LE,FIRST,LAST,
63 . I20
64 my_real
65 . XX(MVSIZ,21),YY(MVSIZ,21),ZZ(MVSIZ,21),
66 . aa,xmin,ymin,zmin,xmax,ymax,zmax,dist
67C-----------------------------------------------
68C
69C
70C | M | Lt| | a | M ao
71C |---+---| | = |
72C | L | 0 | | la | bo
73C
74C [M] a + [L]t la = [M] ao
75C [L] a = bo
76C
77C a = -[M]-1[L]t la + ao
78C [L][M]-1[L]t la = [L] ao - bo
79C
80C on pose:
81C [H] = [L][M]-1[L]t
82C b = [L] ao - bo
83C
84C [H] la = b
85C
86C a = ao - [M]-1[L]t la
87C-----------------------------------------------
88C
89C la : LAMBDA(NC)
90C ao : A(NUMNOD)
91C L : XLL(NK,NC)
92C M : MAS(NUMNOD)
93C [L][M]-1[L]t la : HLA(NC)
94C [L] ao - b : B(NC)
95C [M]-1[L]t la : LTLA(NUMNOD)
96C
97C NC : nombre de contact
98C NK : nombre de noeud pour un contact (8+1,16+1,8+8,16+16)
99C
100C IC : numero du contact (1,NC)
101C IK : numero de noeud local a un contact (1,NK)
102C I : numero global du noeud (1,NUMNOD)
103C
104C IADLL(NC) : IAD = IADLL(IC)
105C LLL(NC*(21,63)) : I = LLL(IAD+1,2...IADNEXT-1)
106C-----------------------------------------------
107C evaluation de b:
108C
109C Vs = Somme(Ni Vi)
110C Vs_ + dt As = Somme(Ni Vi_) + Somme(dt Ni Ai)
111C Somme(dt Ni Ai) - dt As = Vs_ -Somme(Ni Vi_)
112C [L] = dt {N1,N2,..,N15,-1}
113C bo = [L] a = -[L]/dt v_
114C b = [L] ao - bo
115C b = [L] ao + [L]/dt v_ = [L] (v_ + ao dt)/dt
116C-----------------------------------------------
117C b = [L] vo+/dt + vout
118C-----------------------------------------------
119C-----------------------------------------------------------------------
120C boucle sur les candidats au contact
121C-----------------------------------------------------------------------
122 first = 1 + i_stok * itask / nthread
123 last = i_stok*(itask+1) / nthread
124 llt = 0
125 nft=llt+1
126 DO ic=first,last
127 le = cande(ic)
128 ie = nelem(le)
129 i20 = ie - numels8 - numels10
130C-----------------------------------------------------------------------
131C test si brick 20
132C-----------------------------------------------------------------------
133 IF(i20.ge .1.AND.i20.le .numels20)THEN
134 is = nsv(candn(ic))
135 dist = -1.e30
136 dist = max(eminx(1,le)-x(1,is)-dt2*(v(1,is)+dt12*a(1,is)),
137 . x(1,is)+dt2*(v(1,is)+dt12*a(1,is))-eminx(4,le),dist)
138 dist = max(eminx(2,le)-x(2,is)-dt2*(v(2,is)+dt12*a(2,is)),
139 . x(2,is)+dt2*(v(2,is)+dt12*a(2,is))-eminx(5,le),dist)
140 dist = max(eminx(3,le)-x(3,is)-dt2*(v(3,is)+dt12*a(3,is)),
141 . x(3,is)+dt2*(v(3,is)+dt12*a(3,is))-eminx(6,le),dist)
142c IF (DIST<0.) CANDN(I) = -CANDN(I)
143C-----------------------------------------------------------------------
144C test si dans la boite
145C-----------------------------------------------------------------------
146 IF(dist.le .0.)THEN
147c
148c print *, "dans la boite",XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX
149c
150 llt = llt+1
151 iii(llt,21)=is
152 xx(llt,21)=x(1,is)
153 yy(llt,21)=x(2,is)
154 zz(llt,21)=x(3,is)
155 DO k=1,8
156 iii(llt,k)=ixs(k+1,ie)
157 ENDDO
158 DO k=1,12
159 iii(llt,k+8)=ixs20(k,i20)
160 ENDDO
161 DO k=1,20
162 i = iii(llt,k)
163 xx(llt,k)=x(1,i)
164 yy(llt,k)=x(2,i)
165 zz(llt,k)=x(3,i)
166 ENDDO
167C-----------------------------------------------------------------------
168C calcul de [L] par paquet de mvsiz
169C-----------------------------------------------------------------------
170 IF(llt==mvsiz-1)THEN
171 CALL i21lll(
172 1 llt ,lll ,jll ,sll ,xll ,v ,
173 2 xx ,yy ,zz ,iii ,nc ,iadll ,
174 3 n_mul_mx ,a ,x ,itied ,nint ,nkmax ,
175 4 comntag)
176 nft=llt+1
177 llt = 0
178 ENDIF
179 ELSE
180c debug
181 k=0
182 ENDIF
183 ENDIF
184 ENDDO
185C-----------------------------------------------------------------------
186C calcul de [L] pour dernier paquet
187C-----------------------------------------------------------------------
188 IF(llt/=0) CALL i21lll(
189 1 llt ,lll ,jll ,sll ,xll ,v ,
190 2 xx ,yy ,zz ,iii ,nc ,iadll ,
191 3 n_mul_mx ,a ,x ,itied ,nint ,nkmax ,
192 4 comntag)
193C
194C-----------------------------------------------
195 RETURN
196 END
197!||====================================================================
198!|| i21lll ../engine/source/interfaces/int17/i21lagm.F
199!||--- called by ------------------------------------------------------
200!|| i21lagm ../engine/source/interfaces/int17/i21lagm.F
201!||--- calls -----------------------------------------------------
202!|| ancmsg ../engine/source/output/message/message.F
203!|| arret ../engine/source/system/arret.F
204!|| i20rst ../engine/source/interfaces/int16/i20lagm.F
205!||--- uses -----------------------------------------------------
206!|| message_mod ../engine/share/message_module/message_mod.F
207!||====================================================================
208 SUBROUTINE i21lll(LLT ,LLL ,JLL ,SLL ,XLL ,V ,
209 2 XX ,YY ,ZZ ,III ,NC ,IADLL ,
210 3 N_MUL_MX,A ,X ,ITIED,NINT ,NKMAX ,
211 4 COMNTAG)
212C-----------------------------------------------
213C M o d u l e s
214C-----------------------------------------------
215 USE message_mod
216C-----------------------------------------------
217C I m p l i c i t T y p e s
218C-----------------------------------------------
219#include "implicit_f.inc"
220#include "comlock.inc"
221C-----------------------------------------------
222C G l o b a l P a r a m e t e r s
223C-----------------------------------------------
224#include "mvsiz_p.inc"
225C-----------------------------------------------
226C C o m m o n B l o c k s
227C-----------------------------------------------
228#include "com08_c.inc"
229C-----------------------------------------------
230C D u m m y A r g u m e n t s
231C-----------------------------------------------
232 INTEGER LLT,NC,N_MUL_MX,ITIED,NINT ,NKMAX
233 INTEGER LLL(*),JLL(*),SLL(*),COMNTAG(*),
234 . III(MVSIZ,21),IADLL(*)
235C REAL
236 my_real
237 . XLL(*),V(3,*),A(3,*)
238 my_real
239 . xx(mvsiz,21),yy(mvsiz,21),zz(mvsiz,21),x(3,*)
240C-----------------------------------------------
241C L o c a l V a r i a b l e s
242C-----------------------------------------------
243 INTEGER I,J,IK,NK,I1,I2,I3,I4,IAD,NN
244 my_real
245 . vx,vy,vz,vn,aa
246 my_real
247 . r(mvsiz),s(mvsiz),t(mvsiz),
248 . nsx(mvsiz), nsy(mvsiz), nsz(mvsiz),
249 . nx(mvsiz), ny(mvsiz), nz(mvsiz),
250 . ni(mvsiz,21)
251C-----------------------------------------------
252C calcul de r,s,t
253C-----------------------------------------------
254c
255c print *, "XX(1,1),XX(1,9)",XX(1,1),XX(1,9)
256c
257 CALL i20rst(llt ,r ,s ,t ,ni ,
258 2 nsx ,nsy ,nsz ,nx ,ny ,nz ,
259 3 xx ,yy ,zz )
260C-----------------------------------------------
261C calcul de [L]
262C-----------------------------------------------
263 IF(itied==0)THEN
264 DO i=1,llt
265C-----------------------------------------------
266C test si contact
267C-----------------------------------------------
268 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
269 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
270C
271 nk = 21
272 vx = zero
273 vy = zero
274 vz = zero
275 DO ik=1,nk
276 vx = vx - (v(1,iii(i,ik))+dt12*a(1,iii(i,ik)))*ni(i,ik)
277 vy = vy - (v(2,iii(i,ik))+dt12*a(2,iii(i,ik)))*ni(i,ik)
278 vz = vz - (v(3,iii(i,ik))+dt12*a(3,iii(i,ik)))*ni(i,ik)
279 ENDDO
280c
281c print *, "vx,vy,vz s-m",vx,vy,vz
282c print *, "nx,ny,nz ", NX(I),NY(I),NZ(I)
283c
284 vn = nsx(i)*vx + nsy(i)*vy + nsz(i)*vz
285C-----------------------------------------------
286C test si vitesse entrante en s
287C-----------------------------------------------
288 IF(s(i)*vn<=zero)THEN
289c
290c print *, "vitesse entrante",vn
291 print *, "s = ",s(i)
292c
293c AA = DT12/SQRT(NX(I)*NX(I)+NY(I)*NY(I)+NZ(I)*NZ(I))
294 aa = one/sqrt(nsx(i)*nsx(i)+nsy(i)*nsy(i)+nsz(i)*nsz(i))
295 nsx(i) = nsx(i)*aa
296 nsy(i) = nsy(i)*aa
297 nsz(i) = nsz(i)*aa
298#include "lockon.inc"
299 nc=nc+1
300 IF(nc>n_mul_mx)THEN
301#include "lockoff.inc"
302 CALL ancmsg(msgid=84,anmode=aninfo)
303 CALL arret(2)
304 ENDIF
305 iadll(nc+1)=iadll(nc) + 63
306 IF(iadll(nc+1)-1>nkmax)THEN
307#include "lockoff.inc"
308 CALL ancmsg(msgid=84,anmode=aninfo)
309 CALL arret(2)
310 ENDIF
311 iad = iadll(nc) - 1
312 DO ik=1,21
313 lll(iad+ik) = iii(i,ik)
314 jll(iad+ik) = 1
315 sll(iad+ik) = 0
316 xll(iad+ik) = nsx(i)*ni(i,ik)
317 lll(iad+ik+21) = iii(i,ik)
318 jll(iad+ik+21) = 2
319 sll(iad+ik+21) = 0
320 xll(iad+ik+21) = nsy(i)*ni(i,ik)
321 lll(iad+ik+42) = iii(i,ik)
322 jll(iad+ik+42) = 3
323 sll(iad+ik+42) = 0
324 xll(iad+ik+42) = nsz(i)*ni(i,ik)
325 nn = lll(iad+ik)
326 comntag(nn) = comntag(nn) + 1
327 ENDDO
328 sll(iad+21) = nint
329 sll(iad+42) = nint
330 sll(iad+63) = nint
331#include "lockoff.inc"
332 ENDIF
333 ENDIF
334 ENDDO
335 ELSEIF(itied==1)THEN
336C-----------------------------------------------
337C ITIED = 1
338C-----------------------------------------------
339 DO i=1,llt
340C-----------------------------------------------
341C test si contact
342C-----------------------------------------------
343 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
344 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
345C
346 nk = 21
347 vx = zero
348 vy = zero
349 vz = zero
350 DO ik=1,nk
351 vx = vx - (v(1,iii(i,ik))+dt12*a(1,iii(i,ik)))*ni(i,ik)
352 vy = vy - (v(2,iii(i,ik))+dt12*a(2,iii(i,ik)))*ni(i,ik)
353 vz = vz - (v(3,iii(i,ik))+dt12*a(3,iii(i,ik)))*ni(i,ik)
354 ENDDO
355c
356c print *, "vx,vy,vz s-m",vx,vy,vz
357c print *, "nx,ny,nz ", NX(I),NY(I),NZ(I)
358c
359 vn = nx(i)*vx + ny(i)*vy + nz(i)*vz
360C-----------------------------------------------
361C test si vitesse entrante en r,s ou t
362C-----------------------------------------------
363 IF(vn<=zero)THEN
364c
365c print *, "vitesse entrante",vn
366 print *, "s = ",s(i)
367c
368#include "lockon.inc"
369 IF(nc+3>n_mul_mx)THEN
370#include "lockoff.inc"
371 CALL ancmsg(msgid=84,anmode=aninfo)
372 CALL arret(2)
373 ENDIF
374 IF(iadll(nc+1)-1+21*3>nkmax)THEN
375#include "lockoff.inc"
376 CALL ancmsg(msgid=84,anmode=aninfo)
377 CALL arret(2)
378 ENDIF
379C
380 nc=nc+1
381 iadll(nc+1)=iadll(nc) + 21
382 iad = iadll(nc) - 1
383 DO ik=1,21
384 lll(iad+ik) = iii(i,ik)
385 jll(iad+ik) = 1
386 sll(iad+ik) = 0
387 xll(iad+ik) = ni(i,ik)
388 nn = lll(iad+ik)
389 comntag(nn) = comntag(nn) + 1
390 ENDDO
391 sll(iad+21) = nint
392C
393 nc=nc+1
394 iadll(nc+1)=iadll(nc) + 21
395 iad = iadll(nc) - 1
396 DO ik=1,21
397 lll(iad+ik) = iii(i,ik)
398 jll(iad+ik) = 2
399 sll(iad+ik) = 0
400 xll(iad+ik) = ni(i,ik)
401 nn = lll(iad+ik)
402 comntag(nn) = comntag(nn) + 1
403 ENDDO
404 sll(iad+21) = nint
405C
406 nc=nc+1
407 iadll(nc+1)=iadll(nc) + 21
408 iad = iadll(nc) - 1
409 DO ik=1,21
410 lll(iad+ik) = iii(i,ik)
411 jll(iad+ik) = 3
412 sll(iad+ik) = 0
413 xll(iad+ik) = ni(i,ik)
414 nn = lll(iad+ik)
415 comntag(nn) = comntag(nn) + 1
416 ENDDO
417 sll(iad+21) = nint
418#include "lockoff.inc"
419 ENDIF
420 ENDIF
421 ENDDO
422 ELSE
423C-----------------------------------------------
424C ITIED = 2
425C-----------------------------------------------
426 DO i=1,llt
427C-----------------------------------------------
428C test si contact
429C-----------------------------------------------
430 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
431 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
432C
433 nk = 21
434C-----------------------------------------------
435 print *, "s = ",s(i)
436c
437#include "lockon.inc"
438 IF(nc+3>n_mul_mx)THEN
439#include "lockoff.inc"
440 CALL ancmsg(msgid=84,anmode=aninfo)
441 CALL arret(2)
442 ENDIF
443 IF(iadll(nc+1)-1+21*3>nkmax)THEN
444#include "lockoff.inc"
445 CALL ancmsg(msgid=84,anmode=aninfo)
446 CALL arret(2)
447 ENDIF
448 nc=nc+1
449 iadll(nc+1)=iadll(nc) + 21
450 iad = iadll(nc) - 1
451 DO ik=1,21
452 lll(iad+ik) = iii(i,ik)
453 jll(iad+ik) = 1
454 sll(iad+ik) = 0
455 xll(iad+ik) = ni(i,ik)
456 nn = lll(iad+ik)
457 comntag(nn) = comntag(nn) + 1
458 ENDDO
459 sll(iad+21) = nint
460C
461 nc=nc+1
462 iadll(nc+1)=iadll(nc) + 21
463 iad = iadll(nc) - 1
464 DO ik=1,21
465 lll(iad+ik) = iii(i,ik)
466 jll(iad+ik) = 2
467 sll(iad+ik) = 0
468 xll(iad+ik) = ni(i,ik)
469 nn = lll(iad+ik)
470 comntag(nn) = comntag(nn) + 1
471 ENDDO
472 sll(iad+21) = nint
473C
474 nc=nc+1
475 iadll(nc+1)=iadll(nc) + 21
476 iad = iadll(nc) - 1
477 DO ik=1,21
478 lll(iad+ik) = iii(i,ik)
479 jll(iad+ik) = 3
480 sll(iad+ik) = 0
481 xll(iad+ik) = ni(i,ik)
482 nn = lll(iad+ik)
483 comntag(nn) = comntag(nn) + 1
484 ENDDO
485 sll(iad+21) = nint
486C
487#include "lockoff.inc"
488 ENDIF
489 ENDDO
490 ENDIF
491c
492c print *, "r,s,t",r(1),s(1),t(1)
493C
494 RETURN
495 END
#define my_real
Definition cppsort.cpp:32
subroutine i20rst(llt, r, s, t, ni, nsx, nsy, nsz, nx, ny, nz, xx, yy, zz)
Definition i20lagm.F:676
subroutine i21lagm(x, v, lll, jll, sll, xll, candn, cande, i_stok, ixs, ixs20, iadll, eminx, nsv, nelem, nc, n_mul_mx, itask, a, itied, nint, nkmax, eminxs, comntag)
Definition i21lagm.F:35
subroutine i21lll(llt, lll, jll, sll, xll, v, xx, yy, zz, iii, nc, iadll, n_mul_mx, a, x, itied, nint, nkmax, comntag)
Definition i21lagm.F:212
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
#define max(a, b)
Definition macros.h:21
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
subroutine arret(nn)
Definition arret.F:87