OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lag_rwall.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!|| lag_rwall ../engine/source/tools/lagmul/lag_rwall.F
25!||--- called by ------------------------------------------------------
26!|| lag_mult ../engine/source/tools/lagmul/lag_mult.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 lag_rwall(RWL ,NSW ,NSN ,ITIED ,MSR ,
34 2 INDEX ,X ,V ,A ,IADLL ,
35 3 LLL ,JLL ,SLL ,XLL ,COMNTAG ,
36 4 N_MUL_MX,NKMAX ,NC )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE message_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
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, NSN, ITIED, MSR, NDDIM, N_MUL_MX, NKMAX
53 INTEGER NSW(*),INDEX(*),LLL(*),JLL(*),SLL(*),IADLL(*),COMNTAG(*)
54 my_real
55 . x(*), v(*), a(*), rwl(*), xll(*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, IK, J, JJ, K, N, N1, N2, N3, M1, M2, M3, NINDEX,
60 . ICONT
61 my_real
62 . xwl, ywl, zwl, vxw, vyw, vzw, vnw,
63 . vx, vy, vz, ux, uy, uz, xc, yc, zc, dp0, dp, dv
64C-----------------------------------------------
65C NC : nombre de condition cinematique
66C IC : numero de la condition cinematique (1,NC)
67C IK :
68C I : numero global du noeud (1,NUMNOD)
69C J : direction 1,2,3,4,5,6
70C------
71C IADLL(NC) : IAD = IADLL(IC)
72C IK = IAD,IAD+1,IAD+2,...
73C LLL(LAG_NKF) : I = LLL(IK)
74C JLL(LAG_NKF) : J = JLL(IK)
75C======================================================================|
76 icont=0
77 nindex=0
78C
79 IF(msr==0)THEN
80 xwl=rwl(4)
81 ywl=rwl(5)
82 zwl=rwl(6)
83 vxw=zero
84 vyw=zero
85 vzw=zero
86 vnw=zero
87 ELSE
88 m3=3*msr
89 m2=m3-1
90 m1=m2-1
91 vxw=v(m1)
92 vyw=v(m2)
93 vzw=v(m3)
94 vnw = vxw*rwl(1)+vyw*rwl(2)+vzw*rwl(3)
95 xwl=x(m1)+vxw*dt2
96 ywl=x(m2)+vyw*dt2
97 zwl=x(m3)+vzw*dt2
98 ENDIF
99
100 DO 20 i=1,nsn
101 n =nsw(i)
102 n3=3*n
103 n2=n3-1
104 n1=n2-1
105ctmp VX=V(N1)+A(N1)*DT12
106ctmp VY=V(N2)+A(N2)*DT12
107ctmp VZ=V(N3)+A(N3)*DT12
108 vx=v(n1)
109 vy=v(n2)
110 vz=v(n3)
111 ux=x(n1)+vx*dt2
112 uy=x(n2)+vy*dt2
113 uz=x(n3)+vz*dt2
114 xc=ux-xwl
115 yc=uy-ywl
116 zc=uz-zwl
117 dp=xc*rwl(1)+yc*rwl(2)+zc*rwl(3)
118 IF(dp>zero) GOTO 20
119 icont=1
120C--- test pour noeuds penetres
121 xc=x(n1)-xwl
122 yc=x(n2)-ywl
123 zc=x(n3)-zwl
124 dp0=xc*rwl(1)+yc*rwl(2)+zc*rwl(3)
125 IF((vx-vxw)*rwl(1)+(vy-vyw)*rwl(2)+(vz-vzw)*rwl(3)>0.0
126 . .AND.dp0>0.0) GOTO 20
127ctmp IF((VX-VXW)*RWL(1)+(VY-VYW)*RWL(2)+(VZ-VZW)*RWL(3)>0.)
128ctmp . GOTO 20
129 nindex = nindex+1
130 index(nindex) = i
131 20 CONTINUE
132
133 IF(msr==0)THEN
134C---------------------------
135C Fixed rigid wall
136C---------------------------
137 IF(itied==0)THEN
138 DO j = 1,nindex
139 i = index(j)
140 n =nsw(i)
141 nc=nc+1
142 IF(nc>n_mul_mx)THEN
143 CALL ancmsg(msgid=118,anmode=aninfo,
144 . c1='NC')
145 CALL arret(2)
146 ENDIF
147 iadll(nc+1)=iadll(nc) + 3
148 IF(iadll(nc+1)-1>nkmax)THEN
149 CALL ancmsg(msgid=118,anmode=aninfo,
150 . c1='NK')
151 CALL arret(2)
152 ENDIF
153 ik = iadll(nc)
154 lll(ik) = n
155 jll(ik) = 1
156 sll(ik) = 0
157 xll(ik) = rwl(1)
158 ik = ik + 1
159 lll(ik) = n
160 jll(ik) = 2
161 sll(ik) = 0
162 xll(ik) = rwl(2)
163 ik = ik + 1
164 lll(ik) = n
165 jll(ik) = 3
166 sll(ik) = 0
167 xll(ik) = rwl(3)
168 comntag(n) = comntag(n) + 1
169 ENDDO
170C
171 ELSEIF(itied==1)THEN
172C
173 DO j = 1,nindex
174 i = index(j)
175 n = nsw(i)
176C--- x
177 nc=nc+1
178 IF(nc>n_mul_mx)THEN
179 CALL ancmsg(msgid=118,anmode=aninfo,
180 . c1='NC')
181 CALL arret(2)
182 ENDIF
183 iadll(nc+1)=iadll(nc) + 1
184 IF(iadll(nc+1)-1>nkmax)THEN
185 CALL ancmsg(msgid=118,anmode=aninfo,
186 . c1='NK')
187 CALL arret(2)
188 ENDIF
189 ik = iadll(nc)
190 lll(ik) = n
191 jll(ik) = 1
192 sll(ik) = 0
193 xll(ik) = one
194C--- y
195 nc=nc+1
196 IF(nc>n_mul_mx)THEN
197 CALL ancmsg(msgid=118,anmode=aninfo,
198 . c1='NC')
199 CALL arret(2)
200 ENDIF
201 iadll(nc+1)=iadll(nc) + 1
202 IF(iadll(nc+1)-1>nkmax)THEN
203 CALL ancmsg(msgid=118,anmode=aninfo,
204 . c1='NK')
205 CALL arret(2)
206 ENDIF
207 ik = iadll(nc)
208 lll(ik) = n
209 jll(ik) = 2
210 sll(ik) = 0
211 xll(ik) = one
212C--- z
213 nc=nc+1
214 IF(nc>n_mul_mx)THEN
215 CALL ancmsg(msgid=118,anmode=aninfo,
216 . c1='NC')
217 CALL arret(2)
218 ENDIF
219 iadll(nc+1)=iadll(nc) + 1
220 IF(iadll(nc+1)-1>nkmax)THEN
221 CALL ancmsg(msgid=118,anmode=aninfo,
222 . c1='NK')
223 CALL arret(2)
224 ENDIF
225 ik = iadll(nc)
226 lll(ik) = n
227 jll(ik) = 3
228 sll(ik) = 0
229 xll(ik) = one
230 comntag(n) = comntag(n) + 1
231 ENDDO
232 ELSE
233c--- add friction
234 ENDIF
235 ELSE
236C---------------------------
237C Moving rigid wall
238C---------------------------
239 IF(itied==0)THEN
240 DO j = 1,nindex
241 i = index(j)
242 n =nsw(i)
243 nc=nc+1
244 IF(nc>n_mul_mx)THEN
245 CALL ancmsg(msgid=118,anmode=aninfo,
246 . c1='NC')
247 CALL arret(2)
248 ENDIF
249 iadll(nc+1)=iadll(nc) + 6
250 IF(iadll(nc+1)-1>nkmax)THEN
251 CALL ancmsg(msgid=118,anmode=aninfo,
252 . c1='NK')
253 CALL arret(2)
254 ENDIF
255 ik = iadll(nc)
256 lll(ik) = n
257 jll(ik) = 1
258 sll(ik) = 0
259 xll(ik) = rwl(1)
260 ik = ik + 1
261 lll(ik) = n
262 jll(ik) = 2
263 sll(ik) = 0
264 xll(ik) = rwl(2)
265 ik = ik + 1
266 lll(ik) = n
267 jll(ik) = 3
268 sll(ik) = 0
269 xll(ik) = rwl(3)
270 ik = ik + 1
271 lll(ik) = msr
272 jll(ik) = 1
273 sll(ik) = 0
274 xll(ik) =-rwl(1)
275 ik = ik + 1
276 lll(ik) = msr
277 jll(ik) = 2
278 sll(ik) = 0
279 xll(ik) =-rwl(2)
280 ik = ik + 1
281 lll(ik) = msr
282 jll(ik) = 3
283 sll(ik) = 0
284 xll(ik) =-rwl(3)
285 comntag(n) = comntag(n) + 1
286 comntag(msr) = comntag(msr) + 1
287 ENDDO
288C
289 ELSEIF(itied==1)THEN
290 DO j = 1,nindex
291 i = index(j)
292 n = nsw(i)
293C--- x
294 nc=nc+1
295 IF(nc>n_mul_mx)THEN
296 CALL ancmsg(msgid=118,anmode=aninfo,
297 . c1='NC')
298 CALL arret(2)
299 ENDIF
300 iadll(nc+1)=iadll(nc) + 2
301 IF(iadll(nc+1)-1>nkmax)THEN
302 CALL ancmsg(msgid=118,anmode=aninfo,
303 . c1='NK')
304 CALL arret(2)
305 ENDIF
306 ik = iadll(nc)
307 lll(ik) = n
308 jll(ik) = 1
309 sll(ik) = 0
310 xll(ik) = one
311 ik = ik + 1
312 lll(ik) = msr
313 jll(ik) = 1
314 sll(ik) = 0
315 xll(ik) =-one
316C--- y
317 nc=nc+1
318 IF(nc>n_mul_mx)THEN
319 CALL ancmsg(msgid=118,anmode=aninfo,
320 . c1='NC')
321 CALL arret(2)
322 ENDIF
323 iadll(nc+1)=iadll(nc) + 2
324 IF(iadll(nc+1)-1>nkmax)THEN
325 CALL ancmsg(msgid=118,anmode=aninfo,
326 . c1='NK')
327 CALL arret(2)
328 ENDIF
329 ik = iadll(nc)
330 lll(ik) = n
331 jll(ik) = 2
332 sll(ik) = 0
333 xll(ik) = one
334 ik = ik + 1
335 lll(ik) = msr
336 jll(ik) = 2
337 sll(ik) = 0
338 xll(ik) =-one
339C--- z
340 nc=nc+1
341 IF(nc>n_mul_mx)THEN
342 CALL ancmsg(msgid=118,anmode=aninfo,
343 . c1='NC')
344 CALL arret(2)
345 ENDIF
346 iadll(nc+1)=iadll(nc) + 2
347 IF(iadll(nc+1)-1>nkmax)THEN
348 CALL ancmsg(msgid=118,anmode=aninfo,
349 . c1='NK')
350 CALL arret(2)
351 ENDIF
352 ik = iadll(nc)
353 lll(ik) = n
354 jll(ik) = 3
355 sll(ik) = 0
356 xll(ik) = one
357 ik = ik + 1
358 lll(ik) = msr
359 jll(ik) = 3
360 sll(ik) = 0
361 xll(ik) =-one
362 comntag(n) = comntag(n) + 1
363 comntag(msr) = comntag(msr) + 1
364 ENDDO
365 ELSE
366c--- add friction
367 ENDIF
368 ENDIF
369C---
370 RETURN
371 END
lag_rwall
subroutine lag_rwall(rwl, nsw, nsn, itied, msr, index, x, v, a, iadll, lll, jll, sll, xll, comntag, n_mul_mx, nkmax, nc)
Definition lag_rwall.F:37
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