OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7lagm.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "units_c.inc"
#include "com08_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i7lagm()

subroutine i7lagm ( integer, dimension(*) lll,
integer, dimension(*) jll,
integer, dimension(*) sll,
xll,
integer, dimension(*) iadll,
integer n_mul_mx,
integer itask,
integer nint,
integer nkmax,
integer jlt,
a,
v,
integer, dimension(*) itag,
xtag,
gap,
integer noint,
stfn,
integer, dimension(*) itab,
integer, dimension(mvsiz) 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,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer, dimension(mvsiz) nsvg,
gapv,
integer newfront,
integer ibag,
integer, dimension(*) icontact,
stif,
integer, dimension(*) comntag,
integer iadm )

Definition at line 33 of file i7lagm.F.

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,ITIED,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,J,K,IK,IE,IS,IC,NK,III(MVSIZ,17),LLT,NFT,LE,FIRST,LAST,
91 . I16,IAD,LL
92 my_real
93 . aa,xmin,ymin,zmin,xmax,ymax,zmax
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 : nombre de contact
131C NK : nombre de noeud pour un contact (8+1,16+1,8+8,16+16)
132C
133C IC : numero du contact (1,N_MULT)
134C IK : numero de noeud local a un contact (1,NK)
135C I : numero global du noeud (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 de 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 IF(stif(i)/=zero.AND.pene(i)>zero.AND.vn(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 IF(ibag/=0.OR.iadm/=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
my_real
#define my_real
Definition cppsort.cpp:32
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
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