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