OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7lagm.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!|| i7lagm ../engine/source/interfaces/int07/i7lagm.F
25!||--- called by ------------------------------------------------------
26!|| i7main_lmult ../engine/source/interfaces/int07/i7main_lmult.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../engine/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE i7lagm(LLL ,JLL ,SLL ,XLL ,IADLL ,
34 2 N_MUL_MX,ITASK ,NINT ,NKMAX ,
35 3 JLT ,A ,V ,ITAG ,XTAG ,
36 4 GAP ,NOINT ,STFN ,ITAB ,CN_LOC ,
37 5 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
38 6 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
39 7 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
40 8 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
41 9 P1 ,P2 ,P3 ,P4 ,
42 A IX1 ,IX2 ,IX3 ,IX4 ,NSVG ,
43 B GAPV ,NEWFRONT,IBAG ,ICONTACT,STIF ,
44 C COMNTAG ,IADM )
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE message_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53#include "comlock.inc"
54C-----------------------------------------------
55C G l o b a l P a r a m e t e r s
56C-----------------------------------------------
57#include "mvsiz_p.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "units_c.inc"
62#include "com08_c.inc"
63 COMMON /lagglob/n_mult
64 INTEGER N_MULT
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER N_MUL_MX,ITASK,NINT,NKMAX ,
69 . LLL(*),JLL(*),SLL(*),IADLL(*),COMNTAG(*)
70C REAL
71 my_real
72 . V(3,*),XLL(*),A(3,*),XTAG(*)
73 INTEGER JLT, IBAG ,NOINT,NEWFRONT, IADM
74 INTEGER ITAB(*),ICONTACT(*),ITAG(*)
75 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
76 . NSVG(MVSIZ), CN_LOC(MVSIZ)
77 my_real
78 . GAP, STFN(*)
79 my_real
80 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
81 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
82 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
83 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
84 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
85 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz), stif(mvsiz),
86 . gapv(mvsiz)
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER I,
91 . IAD,LL
92 my_real
93 . AA
94 INTEGER IG
95 my_real
96 . NX(MVSIZ), NY(MVSIZ), NZ(MVSIZ), PENE(MVSIZ),
97 . H1(MVSIZ), H2(MVSIZ), H3(MVSIZ), H4(MVSIZ),
98 . VX(MVSIZ), VY(MVSIZ), VZ(MVSIZ), VN(MVSIZ),
99 . H0, LA1, LA2, LA3, LA4,D1,D2,D3,D4,A1,A2,A3,A4
100C-----------------------------------------------
101C
102C
103C | M | Lt| | a | M ao
104C |---+---| | = |
105C | L | 0 | | la | bo
106C
107C [M] a + [L]t la = [M] ao
108C [L] a = bo
109C
110C a = -[M]-1[L]t la + ao
111C [L][M]-1[L]t la = [L] ao - bo
112C
113C on pose:
114C [H] = [L][M]-1[L]t
115C b = [L] ao - bo
116C
117C [H] la = b
118C
119C a = ao - [M]-1[L]t la
120C-----------------------------------------------
121C
122C la : LAMBDA(N_MULT)
123C ao : A(NUMNOD)
124C L : XLL(NK,N_MULT)
125C M : MAS(NUMNOD)
126C [L][M]-1[L]t la : HLA(N_MULT)
127C [L] ao - b : B(N_MULT)
128C [M]-1[L]t la : LTLA(NUMNOD)
129C
130C N_MULT : number of contacts
131C NK: Number of node for contact (8+1.16+1.8+8.16+16)
132C
133C IC : contact number (1,N_MULT)
134C IK : local node number for a contact (1,NK)
135C I : global node number (1,NUMNOD)
136C
137C IADLL(N_MULT) : IAD = IADLL(IC)
138C LLL(N_MULT*(17,51)) : I = LLL(IAD+1,2...IADNEXT-1)
139C-----------------------------------------------
140C evaluation of b:
141C
142C Vs = Somme(Ni Vi)
143C Vs_ + dt As = Somme(Ni Vi_) + Somme(dt Ni Ai)
144C Somme(dt Ni Ai) - dt As = Vs_ -Somme(Ni Vi_)
145C [L] = dt {N1,N2,..,N15,-1}
146C bo = [L] a = -[L]/dt v_
147C b = [L] ao - bo
148C b = [L] ao + [L]/dt v_ = [L] (v_ + ao dt)/dt
149C-----------------------------------------------
150C b = [L] vo+/dt + vout
151C-----------------------------------------------
152
153C--------------------------------------------------------
154C SEUL CAS RESTANT : PAQUETS MIXTES
155C--------------------------------------------------------
156
157 DO i=1,jlt
158C
159 d1 = sqrt(p1(i))
160 p1(i) = max(zero, gapv(i) - d1)
161C
162 d2 = sqrt(p2(i))
163 p2(i) = max(zero, gapv(i) - d2)
164C
165 d3 = sqrt(p3(i))
166 p3(i) = max(zero, gapv(i) - d3)
167C
168 d4 = sqrt(p4(i))
169 p4(i) = max(zero, gapv(i) - d4)
170C
171 a1 = p1(i)/max(em20,d1)
172 a2 = p2(i)/max(em20,d2)
173 a3 = p3(i)/max(em20,d3)
174 a4 = p4(i)/max(em20,d4)
175 nx(i) = a1*nx1(i) + a2*nx2(i) + a3*nx3(i) + a4*nx4(i)
176 ny(i) = a1*ny1(i) + a2*ny2(i) + a3*ny3(i) + a4*ny4(i)
177 nz(i) = a1*nz1(i) + a2*nz2(i) + a3*nz3(i) + a4*nz4(i)
178 ENDDO
179C
180 DO i=1,jlt
181 IF(ix3(i)/=ix4(i))THEN
182 pene(i) = max(p1(i),p2(i),p3(i),p4(i))
183C
184 la1 = one - lb1(i) - lc1(i)
185 la2 = one - lb2(i) - lc2(i)
186 la3 = one - lb3(i) - lc3(i)
187 la4 = one - lb4(i) - lc4(i)
188C
189 h0 = fourth *
190 . (p1(i)*la1 + p2(i)*la2 + p3(i)*la3 + p4(i)*la4)
191 h1(i) = h0 + p1(i) * lb1(i) + p4(i) * lc4(i)
192 h2(i) = h0 + p2(i) * lb2(i) + p1(i) * lc1(i)
193 h3(i) = h0 + p3(i) * lb3(i) + p2(i) * lc2(i)
194 h4(i) = h0 + p4(i) * lb4(i) + p3(i) * lc3(i)
195 h0 = 1./max(em20,h1(i) + h2(i) + h3(i) + h4(i))
196 h1(i) = h1(i) * h0
197 h2(i) = h2(i) * h0
198 h3(i) = h3(i) * h0
199 h4(i) = h4(i) * h0
200C
201 ELSE
202 pene(i) = p1(i)
203 nx(i) = nx1(i)
204 ny(i) = ny1(i)
205 nz(i) = nz1(i)
206 h1(i) = lb1(i)
207 h2(i) = lc1(i)
208 h3(i) = one - lb1(i) - lc1(i)
209 h4(i) = zero
210 ENDIF
211 ENDDO
212
213C
214c DO I=1,JLT
215cC correction hourglass
216c H0 = -.25*(H1(I) - H2(I) + H3(I) - H4(I))
217c H0 = MIN(H0,H2(I),H4(I))
218c H0 = MAX(H0,-H1(I),-H3(I))
219c IF(IX3(I)==IX4(I))H0 = 0.0
220c H1(I) = H1(I) + H0
221c H2(I) = H2(I) - H0
222c H3(I) = H3(I) + H0
223c H4(I) = H4(I) - H0
224c ENDDO
225C
226C---------------------
227C
228 DO i=1,jlt
229 IF( (gapv(i)-pene(i))/gapv(i) <em10 .AND. stif(i)>zero) THEN
230 stif(i) = zero
231 newfront = -1
232#include "lockon.inc"
233 stfn(cn_loc(i)) = -abs(stfn(cn_loc(i)))
234
235 WRITE(istdo,'(A,I8)')' WARNING INTERFACE ',noint
236 WRITE(istdo,'(A,I8,A)')' NODE ',itab(nsvg(i)),
237 . ' DE-ACTIVATED FROM INTERFACE'
238 WRITE(iout ,'(a,i8)')' warning INTERFACE ',NOINT
239 WRITE(IOUT ,'(a,i8,a)')' node ',ITAB(NSVG(I)),
240 . ' de-activated from interface'
241#include "lockoff.inc"
242 ENDIF
243 ENDDO
244C
245 DO I=1,JLT
246 IG=NSVG(I)
247 VX(I) = V(1,IG)+DT12*A(1,IG)
248 . - H1(I)*(V(1,IX1(I))+DT12*A(1,IX1(I)))
249 . - H2(I)*(V(1,IX2(I))+DT12*A(1,IX2(I)))
250 . - H3(I)*(V(1,IX3(I))+DT12*A(1,IX3(I)))
251 . - H4(I)*(V(1,IX4(I))+DT12*A(1,IX4(I)))
252 VY(I) = V(2,IG)+DT12*A(2,IG)
253 . - H1(I)*(V(2,IX1(I))+DT12*A(2,IX1(I)))
254 . - H2(I)*(V(2,IX2(I))+DT12*A(2,IX2(I)))
255 . - H3(I)*(V(2,IX3(I))+DT12*A(2,IX3(I)))
256 . - H4(I)*(V(2,IX4(I))+DT12*A(2,IX4(I)))
257 VZ(I) = V(3,IG)+DT12*A(3,IG)
258 . - H1(I)*(V(3,IX1(I))+DT12*A(3,IX1(I)))
259 . - H2(I)*(V(3,IX2(I))+DT12*A(3,IX2(I)))
260 . - H3(I)*(V(3,IX3(I))+DT12*A(3,IX3(I)))
261 . - H4(I)*(V(3,IX4(I))+DT12*A(3,IX4(I)))
262 VN(I) = NX(I)*VX(I) + NY(I)*VY(I) + NZ(I)*VZ(I)
263#include "lockon.inc"
264.AND..AND. IF(STIF(I)/=ZEROPENE(I)>ZEROVN(I)<XTAG(IG))THEN
265 AA = ONE/SQRT(NX(I)*NX(I)+NY(I)*NY(I)+NZ(I)*NZ(I))
266 NX(I) = NX(I)*AA
267 NY(I) = NY(I)*AA
268 NZ(I) = NZ(I)*AA
269 IF(ITAG(NSVG(I))==0)then
270 N_MULT = N_MULT+1
271 ITAG(NSVG(I)) = N_MULT
272 XTAG(NSVG(I)) = VN(I)
273 IF(N_MULT > N_MUL_MX)THEN
274#include "lockoff.inc"
275 CALL ANCMSG(MSGID=95,ANMODE=ANINFO)
276 CALL ARRET(2)
277 ENDIF
278 IADLL(N_MULT+1)=IADLL(N_MULT) + 15
279 IF(IADLL(N_MULT+1)-1 > NKMAX)THEN
280#include "lockoff.inc"
281 CALL ANCMSG(MSGID=96,ANMODE=ANINFO,
282 . I1=IADLL(N_MULT+1)-1,
283 . I2=NKMAX)
284 CALL ARRET(2)
285 ENDIF
286 IAD = IADLL(N_MULT) - 1
287 else
288 xtag(NSVG(I)) = VN(I)
289 IAD = IADLL(itag(NSVG(I))) - 1
290 LL = LLL(IAD+1)
291 COMNTAG(LL)= COMNTAG(LL) - 1
292 LL = LLL(IAD+2)
293 COMNTAG(LL)= COMNTAG(LL) - 1
294 LL = LLL(IAD+3)
295 COMNTAG(LL)= COMNTAG(LL) - 1
296 LL = LLL(IAD+4)
297 COMNTAG(LL)= COMNTAG(LL) - 1
298 LL = LLL(IAD+5)
299 COMNTAG(LL)= COMNTAG(LL) - 1
300 ENDIF
301C
302 LLL(IAD+1) = IX1(I)
303 JLL(IAD+1) = 1
304 SLL(IAD+1) = 0
305 XLL(IAD+1) = NX(I)*H1(I)
306C---
307 LLL(IAD+2) = IX2(I)
308 JLL(IAD+2) = 1
309 SLL(IAD+2) = 0
310 XLL(IAD+2) = NX(I)*H2(I)
311C---
312 LLL(IAD+3) = IX3(I)
313 JLL(IAD+3) = 1
314 SLL(IAD+3) = 0
315 XLL(IAD+3) = NX(I)*H3(I)
316C---
317 LLL(IAD+4) = IX4(I)
318 JLL(IAD+4) = 1
319 SLL(IAD+4) = 0
320 XLL(IAD+4) = NX(I)*H4(I)
321C---
322 LLL(IAD+5) = NSVG(I)
323 JLL(IAD+5) = 1
324 SLL(IAD+5) = NINT
325 XLL(IAD+5) = -NX(I)
326C-----------------------------
327 LLL(IAD+6) = IX1(I)
328 JLL(IAD+6) = 2
329 SLL(IAD+6) = 0
330 XLL(IAD+6) = NY(I)*H1(I)
331C---
332 LLL(IAD+7) = IX2(I)
333 JLL(IAD+7) = 2
334 SLL(IAD+7) = 0
335 XLL(IAD+7) = NY(I)*H2(I)
336C---
337 LLL(IAD+8) = IX3(I)
338 JLL(IAD+8) = 2
339 SLL(IAD+8) = 0
340 XLL(IAD+8) = NY(I)*H3(I)
341C---
342 LLL(IAD+9) = IX4(I)
343 JLL(IAD+9) = 2
344 SLL(IAD+9) = 0
345 XLL(IAD+9) = NY(I)*H4(I)
346C---
347 LLL(IAD+10) = NSVG(I)
348 JLL(IAD+10) = 2
349 SLL(IAD+10) = NINT
350 XLL(IAD+10) = -NY(I)
351C------------------------------------
352 LLL(IAD+11) = IX1(I)
353 JLL(IAD+11) = 3
354 SLL(IAD+11) = 0
355 XLL(IAD+11) = NZ(I)*H1(I)
356C---
357 LLL(IAD+12) = IX2(I)
358 JLL(IAD+12) = 3
359 SLL(IAD+12) = 0
360 XLL(IAD+12) = NZ(I)*H2(I)
361C---
362 LLL(IAD+13) = IX3(I)
363 JLL(IAD+13) = 3
364 SLL(IAD+13) = 0
365 XLL(IAD+13) = NZ(I)*H3(I)
366C---
367 LLL(IAD+14) = IX4(I)
368 JLL(IAD+14) = 3
369 SLL(IAD+14) = 0
370 XLL(IAD+14) = NZ(I)*H4(I)
371C---
372 LLL(IAD+15) = NSVG(I)
373 JLL(IAD+15) = 3
374 SLL(IAD+15) = NINT
375 XLL(IAD+15) = -NZ(I)
376C--------------------------------------
377 LL = IX1(I)
378 COMNTAG(LL) = COMNTAG(LL) + 1
379 LL = IX2(I)
380 COMNTAG(LL) = COMNTAG(LL) + 1
381 LL = IX3(I)
382 COMNTAG(LL) = COMNTAG(LL) + 1
383 LL = IX4(I)
384 COMNTAG(LL) = COMNTAG(LL) + 1
385 LL = NSVG(I)
386 COMNTAG(LL) = COMNTAG(LL) + 1
387C
388 ENDIF
389#include "lockoff.inc"
390 ENDDO
391C
392.OR. IF(IBAG/=0IADM/=0)THEN
393 DO I=1,JLT
394 IF(PENE(I)/=ZERO)THEN
395 ICONTACT(NSVG(I))=1
396 ICONTACT(IX1(I))=1
397 ICONTACT(IX2(I))=1
398 ICONTACT(IX3(I))=1
399 ICONTACT(IX4(I))=1
400 ENDIF
401 ENDDO
402 ENDIF
403C
404C-----------------------------------------------
405 RETURN
406 END
i7lagm
subroutine i7lagm(lll, jll, sll, xll, iadll, n_mul_mx, itask, nint, nkmax, jlt, a, v, itag, xtag, gap, noint, stfn, itab, cn_loc, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, ix1, ix2, ix3, ix4, nsvg, gapv, newfront, ibag, icontact, stif, comntag, iadm)
Definition i7lagm.F:45
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257