OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lag_rby.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_rby ../engine/source/tools/lagmul/lag_rby.F
25!||--- called by ------------------------------------------------------
26!|| lag_mult ../engine/source/tools/lagmul/lag_mult.F
27!||--- calls -----------------------------------------------------
28!|| lag_rby_cond ../engine/source/tools/lagmul/lag_rby_cond.F
29!||====================================================================
30 SUBROUTINE lag_rby(RBYL ,NPBYL ,LPBYL ,MASS ,INER ,
31 2 IADLL ,LLL ,JLL ,SLL ,XLL ,
32 3 COMNTAG,V ,VR ,A ,AR ,
33 4 X ,NC ,NCR )
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C C o m m o n B l o c k s
40C-----------------------------------------------
41#include "lagmult.inc"
42#include "param_c.inc"
43#include "com08_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER NC, NCR, LLL(*),JLL(*),SLL(*),IADLL(*),
48 . NPBYL(NNPBY,*), LPBYL(*), COMNTAG(*)
49C REAL
50 my_real
51 . rbyl(nrby,*),xll(*),x(3,*),v(3,*),vr(3,*),a(3,*),ar(3,*),
52 . mass(*),iner(*)
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER I,J,JF,N,NN,M,IK,IC,IAD,IFX,IFR,MSL,TNSL,NFIX,NFRE
57 my_real RX,RY,RZ,R1,R2,R3,MMAS,XG(3),VG(3)
58C-----------------------------------------------
59C NC : nombre de condition cinematique
60C IC : numero de la condition cinematique (1,NC)
61C IK :
62C I : numero global du noeud (1,NUMNOD)
63C J : direction 1,2,3,4,5,6
64C------
65C IADLL(NC) : IAD = IADLL(IC)
66C IK = IAD,IAD+1,IAD+2,...
67C LLL(LAG_NKF) : I = LLL(IK)
68C JLL(LAG_NKF) : J = JLL(IK)
69C======================================================================|
70 tnsl = 0
71 DO n = 1,nrbylag
72 CALL lag_rby_cond(
73 1 npbyl ,lpbyl(tnsl+1),rbyl ,mass ,iner ,
74 2 x ,v ,vr ,a ,ar ,
75 3 iadll ,lll ,comntag ,n ,nc )
76C
77 msl = npbyl(2,n)
78 nfix = npbyl(4,n)
79 nfre = npbyl(5,n)
80 IF (nfix==0) THEN
81C no condensation
82 m = npbyl(1,n)
83 DO i=1,msl-1
84 nn = lpbyl(tnsl+i)
85 vg(1)=vr(1,m)
86 vg(2)=vr(2,m)
87 vg(3)=vr(3,m)
88 r1 = x(1,nn) - x(1,m)
89 r2 = x(2,nn) - x(2,m)
90 r3 = x(3,nn) - x(3,m)
91 rx = r1 + half*dt2*(vg(2)*r3 - vg(3)*r2)
92 ry = r2 + half*dt2*(vg(3)*r1 - vg(1)*r3)
93 rz = r3 + half*dt2*(vg(1)*r2 - vg(2)*r1)
94C--- ROTATIONS
95 DO j=4,6
96 nc = nc + 1
97 iadll(nc+1)=iadll(nc) + 2
98 ik = iadll(nc)
99 lll(ik) = m
100 jll(ik) = j
101 sll(ik) = 0
102 xll(ik) = one
103 ik = ik+1
104 lll(ik) = nn
105 jll(ik) = j
106 sll(ik) = 0
107 xll(ik) =-one
108 ENDDO
109C--- Trans x
110 nc = nc + 1
111 iadll(nc+1)=iadll(nc) + 4
112 ik = iadll(nc)
113 lll(ik) = nn
114 jll(ik) = 1
115 sll(ik) = 0
116 xll(ik) =-one
117 ik = ik+1
118 lll(ik) = m
119 jll(ik) = 1
120 sll(ik) = 0
121 xll(ik) = one
122 ik = ik+1
123 lll(ik) = m
124 jll(ik) = 5
125 sll(ik) = 0
126 xll(ik) = rz
127 ik = ik+1
128 lll(ik) = m
129 jll(ik) = 6
130 sll(ik) = 0
131 xll(ik) =-ry
132C--- Trans y
133 nc = nc + 1
134 iadll(nc+1)=iadll(nc) + 4
135 ik = iadll(nc)
136 lll(ik) = nn
137 jll(ik) = 2
138 sll(ik) = 0
139 xll(ik) =-one
140 ik = ik+1
141 lll(ik) = m
142 jll(ik) = 2
143 sll(ik) = 0
144 xll(ik) = one
145 ik = ik+1
146 lll(ik) = m
147 jll(ik) = 4
148 sll(ik) = 0
149 xll(ik) =-rz
150 ik = ik+1
151 lll(ik) = m
152 jll(ik) = 6
153 sll(ik) = 0
154 xll(ik) = rx
155C--- Trans z
156 nc = nc + 1
157 iadll(nc+1)=iadll(nc) + 4
158 ik = iadll(nc)
159 lll(ik) = nn
160 jll(ik) = 3
161 sll(ik) = 0
162 xll(ik) =-one
163 ik = ik+1
164 lll(ik) = m
165 jll(ik) = 3
166 sll(ik) = 0
167 xll(ik) = one
168 ik = ik+1
169 lll(ik) = m
170 jll(ik) = 4
171 sll(ik) = 0
172 xll(ik) = ry
173 ik = ik+1
174 lll(ik) = m
175 jll(ik) = 5
176 sll(ik) = 0
177 xll(ik) =-rx
178 ENDDO
179 ELSEIF (nfre/=0) THEN
180C partial condensation: secnds = free nodes -1
181 jf = tnsl+2*msl
182 ifx = npbyl(7,n)
183 ifr = npbyl(8,n)
184 vg(1)=vr(1,ifr)
185 vg(2)=vr(2,ifr)
186 vg(3)=vr(3,ifr)
187 DO i=2,nfre
188 nn = lpbyl(jf+i)
189 r1 = x(1,nn) - x(1,ifr)
190 r2 = x(2,nn) - x(2,ifr)
191 r3 = x(3,nn) - x(3,ifr)
192 rx = r1 + half*dt2*(vg(2)*r3 - vg(3)*r2)
193 ry = r2 + half*dt2*(vg(3)*r1 - vg(1)*r3)
194 rz = r3 + half*dt2*(vg(1)*r2 - vg(2)*r1)
195C--- Rot x,y,z
196 DO j=4,6
197 nc = nc + 1
198 iadll(nc+1)=iadll(nc) + 2
199 ik = iadll(nc)
200 lll(ik) = ifr
201 jll(ik) = j
202 sll(ik) = 0
203 xll(ik) = one
204 ik = ik+1
205 lll(ik) = nn
206 jll(ik) = j
207 sll(ik) = 0
208 xll(ik) =-one
209 ENDDO
210C--- Trans x
211 nc = nc + 1
212 iadll(nc+1)=iadll(nc) + 4
213 ik = iadll(nc)
214 lll(ik) = nn
215 jll(ik) = 1
216 sll(ik) = 0
217 xll(ik) =-one
218 ik = ik+1
219 lll(ik) = ifr
220 jll(ik) = 1
221 sll(ik) = 0
222 xll(ik) = one
223 ik = ik+1
224 lll(ik) = ifr
225 jll(ik) = 5
226 sll(ik) = 0
227 xll(ik) = rz
228 ik = ik+1
229 lll(ik) = ifr
230 jll(ik) = 6
231 sll(ik) = 0
232 xll(ik) =-ry
233C--- Trans y
234 nc = nc + 1
235 iadll(nc+1)=iadll(nc) + 4
236 ik = iadll(nc)
237 lll(ik) = nn
238 jll(ik) = 2
239 sll(ik) = 0
240 xll(ik) =-one
241 ik = ik+1
242 lll(ik) = ifr
243 jll(ik) = 2
244 sll(ik) = 0
245 xll(ik) = one
246 ik = ik+1
247 lll(ik) = ifr
248 jll(ik) = 4
249 sll(ik) = 0
250 xll(ik) =-rz
251 ik = ik+1
252 lll(ik) = ifr
253 jll(ik) = 6
254 sll(ik) = 0
255 xll(ik) = rx
256C--- Trans z
257 nc = nc + 1
258 iadll(nc+1)=iadll(nc) + 4
259 ik = iadll(nc)
260 lll(ik) = nn
261 jll(ik) = 3
262 sll(ik) = 0
263 xll(ik) =-one
264 ik = ik+1
265 lll(ik) = ifr
266 jll(ik) = 3
267 sll(ik) = 0
268 xll(ik) = one
269 ik = ik+1
270 lll(ik) = ifr
271 jll(ik) = 4
272 sll(ik) = 0
273 xll(ik) = ry
274 ik = ik+1
275 lll(ik) = ifr
276 jll(ik) = 5
277 sll(ik) = 0
278 xll(ik) =-rx
279 ENDDO
280C secnd = condensed node
281 r1 = rbyl(11,n) - x(1,ifr)
282 r2 = rbyl(12,n) - x(2,ifr)
283 r3 = rbyl(13,n) - x(3,ifr)
284 rx = r1 - half*dt2*(vg(2)*r3 - vg(3)*r2)
285 ry = r2 - half*dt2*(vg(3)*r1 - vg(1)*r3)
286 rz = r3 - half*dt2*(vg(1)*r2 - vg(2)*r1)
287C--- Trans x
288 nc = nc + 1
289 iadll(nc+1)=iadll(nc) + 4
290 ik = iadll(nc)
291 lll(ik) = ifx
292 jll(ik) = 1
293 sll(ik) = 0
294 xll(ik) =-one
295 ik = ik+1
296 lll(ik) = ifr
297 jll(ik) = 1
298 sll(ik) = 0
299 xll(ik) = one
300 ik = ik+1
301 lll(ik) = ifr
302 jll(ik) = 5
303 sll(ik) = 0
304 xll(ik) = rz
305 ik = ik+1
306 lll(ik) = ifr
307 jll(ik) = 6
308 sll(ik) = 0
309 xll(ik) =-ry
310C--- Trans y
311 nc = nc + 1
312 iadll(nc+1)=iadll(nc) + 4
313 ik = iadll(nc)
314 lll(ik) = ifx
315 jll(ik) = 2
316 sll(ik) = 0
317 xll(ik) =-one
318 ik = ik+1
319 lll(ik) = ifr
320 jll(ik) = 2
321 sll(ik) = 0
322 xll(ik) = one
323 ik = ik+1
324 lll(ik) = ifr
325 jll(ik) = 4
326 sll(ik) = 0
327 xll(ik) =-rz
328 ik = ik+1
329 lll(ik) = ifr
330 jll(ik) = 6
331 sll(ik) = 0
332 xll(ik) = rx
333C--- Trans z
334 nc = nc + 1
335 iadll(nc+1)=iadll(nc) + 4
336 ik = iadll(nc)
337 lll(ik) = ifx
338 jll(ik) = 3
339 sll(ik) = 0
340 xll(ik) =-one
341 ik = ik+1
342 lll(ik) = ifr
343 jll(ik) = 3
344 sll(ik) = 0
345 xll(ik) = one
346 ik = ik+1
347 lll(ik) = ifr
348 jll(ik) = 4
349 sll(ik) = 0
350 xll(ik) = ry
351 ik = ik+1
352 lll(ik) = ifr
353 jll(ik) = 5
354 sll(ik) = 0
355 xll(ik) =-rx
356 ENDIF
357 tnsl = tnsl + 3*msl
358 ENDDO
359 ncr = nc
360C=======================================================================
361 DO n=1,nrbylag
362 nfix = npbyl(4,n)
363 nfre = npbyl(5,n)
364 IF (nfix>0.AND.nfre>0) THEN
365C Partially condensed RB
366 ifx = npbyl(7,n)
367 ifr = npbyl(8,n)
368C--- Rot x
369 nc = nc + 1
370 iadll(nc+1)=iadll(nc) + 4
371 ik = iadll(nc)
372 lll(ik) = ifr
373 jll(ik) = 4
374 sll(ik) = 0
375 xll(ik) =-one
376 ik = ik+1
377 lll(ik) = ifx
378 jll(ik) = 4
379 sll(ik) = 0
380 xll(ik) = one
381 ik = ik+1
382 lll(ik) = ifx
383 jll(ik) = 5
384 sll(ik) = 0
385 xll(ik) = zero
386 ik = ik+1
387 lll(ik) = ifx
388 jll(ik) = 6
389 sll(ik) = 0
390 xll(ik) = zero
391C--- Rot y
392 nc = nc + 1
393 iadll(nc+1)=iadll(nc) + 4
394 ik = iadll(nc)
395 lll(ik) = ifr
396 jll(ik) = 5
397 sll(ik) = 0
398 xll(ik) =-one
399 ik = ik+1
400 lll(ik) = ifx
401 jll(ik) = 4
402 sll(ik) = 0
403 xll(ik) = zero
404 ik = ik+1
405 lll(ik) = ifx
406 jll(ik) = 5
407 sll(ik) = 0
408 xll(ik) = one
409 ik = ik+1
410 lll(ik) = ifx
411 jll(ik) = 6
412 sll(ik) = 0
413 xll(ik) = zero
414C--- Rot z
415 nc = nc + 1
416 iadll(nc+1)=iadll(nc) + 4
417 ik = iadll(nc)
418 lll(ik) = ifr
419 jll(ik) = 6
420 sll(ik) = 0
421 xll(ik) =-one
422 ik = ik+1
423 lll(ik) = ifx
424 jll(ik) = 4
425 sll(ik) = 0
426 xll(ik) = zero
427 ik = ik+1
428 lll(ik) = ifx
429 jll(ik) = 5
430 sll(ik) = 0
431 xll(ik) = zero
432 ik = ik+1
433 lll(ik) = ifx
434 jll(ik) = 6
435 sll(ik) = 0
436 xll(ik) = one
437 ENDIF
438 ENDDO
439C---
440 RETURN
441 END
my_real
#define my_real
Definition cppsort.cpp:32
lag_rby
subroutine lag_rby(rbyl, npbyl, lpbyl, mass, iner, iadll, lll, jll, sll, xll, comntag, v, vr, a, ar, x, nc, ncr)
Definition lag_rby.F:34
lag_rby_cond
subroutine lag_rby_cond(npbyl, lpbyl, rbyl, mass, iner, x, v, vr, a, ar, iadll, lll, comntag, nn, nc)
Definition lag_rby_cond.F:31