OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rby_impd.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!|| rby_impd ../engine/source/constraints/general/rbody/rby_impd.F
25!||--- called by ------------------------------------------------------
26!|| recukin ../engine/source/implicit/recudis.F
27!||--- calls -----------------------------------------------------
28!|| rby_imp2 ../engine/source/constraints/general/rbody/rby_impd.F
29!|| rby_imp5 ../engine/source/constraints/general/rbody/rby_impd.F
30!|| rby_imp7 ../engine/source/constraints/general/rbody/rby_impd.f
31!|| rby_imrd ../engine/source/constraints/general/rbody/rby_impd.F
32!||====================================================================
33 SUBROUTINE rby_impd(NRBYAC,IRBYAC,X ,RBY,LPBY,
34 1 NPBY,SKEW,ISKEW,ITAB,WEIGHT,
35 2 MS ,IN ,NDOF ,D ,
36 3 DR ,IXR )
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45#include "param_c.inc"
46#include "impl1_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER WEIGHT(*),LPBY(*),NPBY(NNPBY,*),ISKEW(*),ITAB(*)
51 INTEGER NDOF(*),NRBYAC,IRBYAC(*),IXR(*)
52C REAL
53 my_real
54 . x(3,*), rby(nrby,*), skew(lskew,*),
55 . in(*),ms(*),d(3,*), dr(3,*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, N,K
60C-----------------------------------------------
61 IF( IMP_LR > 0 ) THEN
62 DO i=1,nrbyac
63 n=irbyac(i)
64 k=irbyac(i+nrbykin)+1
65 CALL rby_imp7(x ,rby(1,n),lpby(k),
66 1 npby(1,n),skew,iskew,itab,weight,
67 2 ms ,in ,ndof ,d ,dr )
68 END DO
69 ELSE
70 IF (itrmax==0) THEN
71 DO i=1,nrbyac
72 n=irbyac(i)
73 k=irbyac(i+nrbykin)+1
74 CALL rby_imp2(x ,rby(1,n),lpby(k),
75 1 npby(1,n),skew,iskew,itab,weight,
76 2 ms ,in ,ndof ,d ,dr )
77 ENDDO
78 ELSE
79 DO i=1,nrbyac
80 n=irbyac(i)
81 k=irbyac(i+nrbykin)+1
82 CALL rby_imp5(x ,rby(1,n),lpby(k),itrmax ,
83 1 npby(1,n),skew,iskew,itab,weight,
84 2 ms ,in ,ndof ,d ,dr )
85 ENDDO
86 END IF
87 END IF
88
89 IF (numelr>0) THEN
90 CALL rby_imrd(nrbyac,irbyac,x ,rby,lpby,
91 1 npby,skew,iskew,itab,weight,
92 2 ms ,in ,ndof ,d ,
93 3 dr ,ixr )
94 ENDIF
95
96 RETURN
97 END
98!||====================================================================
99!|| rby_imp2 ../engine/source/constraints/general/rbody/rby_impd.F
100!||--- called by ------------------------------------------------------
101!|| rby_impd ../engine/source/constraints/general/rbody/rby_impd.F
102!||====================================================================
103 SUBROUTINE rby_imp2(
104 1 X ,RBY ,NOD ,
105 1 NBY,SKEW,ISKEW,ITAB,WEIGHT,
106 2 MS ,IN ,NDOF ,D ,DR )
107C-----------------------------------------------
108C I m p l i c i t T y p e s
109C-----------------------------------------------
110#include "implicit_f.inc"
111C-----------------------------------------------
112C D u m m y A r g u m e n t s
113C-----------------------------------------------
114 INTEGER NOD(*), NBY(*), ISKEW(*),ITAB(*), WEIGHT(*)
115 INTEGER NDOF(*)
116 my_real X(3,*), RBY(*),SKEW(LSKEW,*),IN(*),MS(*),D(3,*),DR(3,*)
117C-----------------------------------------------
118C C o m m o n B l o c k s
119C-----------------------------------------------
120#include "param_c.inc"
121C-----------------------------------------------
122C L o c a l V a r i a b l e s
123C-----------------------------------------------
124 INTEGER M, NSN, I, N
125 my_real XS,YS,ZS
126C-----------------------------------------------
127 M =nby(1)
128C optimisation spmd
129 IF (m<0) RETURN
130 nsn =nby(2)
131C IF (NDOF(M)<6) WRITE(*,*)'WARNING'
132 DO i=1,nsn
133 n = nod(i)
134 xs=x(1,n)-x(1,m)
135 ys=x(2,n)-x(2,m)
136 zs=x(3,n)-x(3,m)
137 d(1,n)=d(1,m)+dr(2,m)*zs-dr(3,m)*ys
138 d(2,n)=d(2,m)-dr(1,m)*zs+dr(3,m)*xs
139 d(3,n)=d(3,m)+dr(1,m)*ys-dr(2,m)*xs
140 IF (ndof(n)>3) THEN
141 dr(1,n)= dr(1,m)
142 dr(2,n)= dr(2,m)
143 dr(3,n)= dr(3,m)
144 ENDIF
145 ENDDO
146C
147 RETURN
148 END
149!||====================================================================
150!|| rby_imp3 ../engine/source/constraints/general/rbody/rby_impd.F
151!||--- called by ------------------------------------------------------
152!|| fr_u2dd ../engine/source/mpi/implicit/imp_fri.F
153!||====================================================================
154 SUBROUTINE rby_imp3(X ,M ,N ,D ,DR ,
155 . A ,AR )
156C-----------------------------------------------
157C I m p l i c i t T y p e s
158C-----------------------------------------------
159#include "implicit_f.inc"
160C-----------------------------------------------
161C D u m m y A r g u m e n t s
162C-----------------------------------------------
163 INTEGER M,N
164 my_real
165 . X(3,*), D(3,*),DR(3,*), A(3,*), AR(3,*)
166C-----------------------------------------------
167C L o c a l V a r i a b l e s
168C-----------------------------------------------
169C REAL
170 my_real
171 . xs,ys,zs
172C-----------------------------------------------
173 IF (m<0) RETURN
174 xs=x(1,n)-x(1,m)
175 ys=x(2,n)-x(2,m)
176 zs=x(3,n)-x(3,m)
177 d(1,n)=d(1,m)+dr(2,m)*zs-dr(3,m)*ys
178 d(2,n)=d(2,m)-dr(1,m)*zs+dr(3,m)*xs
179 d(3,n)=d(3,m)+dr(1,m)*ys-dr(2,m)*xs
180 a(1,m)=zero
181 a(2,m)=zero
182 a(3,m)=zero
183 a(1,n)=zero
184 a(2,n)=zero
185 a(3,n)=zero
186 ar(1,m)=zero
187 ar(2,m)=zero
188 ar(3,m)=zero
189C
190 RETURN
191 END
192!||====================================================================
193!|| rby_imrd ../engine/source/constraints/general/rbody/rby_impd.f
194!||--- called by ------------------------------------------------------
195!|| rby_impd ../engine/source/constraints/general/rbody/rby_impd.F
196!||--- calls -----------------------------------------------------
197!|| rby_imp4 ../engine/source/constraints/general/rbody/rby_impd.F
198!||====================================================================
199 SUBROUTINE rby_imrd(NRBYAC,IRBYAC,X ,RBY,LPBY,
200 1 NPBY,SKEW,ISKEW,ITAB,WEIGHT,
201 2 MS ,IN ,NDOF ,D ,
202 3 DR ,IXR )
203C-----------------------------------------------
204C I m p l i c i t T y p e s
205C-----------------------------------------------
206#include "implicit_f.inc"
207C-----------------------------------------------
208C C o m m o n B l o c k s
209C-----------------------------------------------
210#include "com04_c.inc"
211#include "param_c.inc"
212C-----------------------------------------------
213C D u m m y A r g u m e n t s
214C-----------------------------------------------
215 INTEGER WEIGHT(*),LPBY(*),NPBY(NNPBY,*),ISKEW(*),ITAB(*)
216 INTEGER NDOF(*),NRBYAC,IRBYAC(*),IXR(NIXR,*)
217C REAL
218 my_real
219 . X(3,*), RBY(NRBY,*), SKEW(LSKEW,*),
220 . IN(*),MS(*),D(3,*), DR(3,*)
221C-----------------------------------------------
222C L o c a l V a r i a b l e s
223C-----------------------------------------------
224 INTEGER I,J,M, N,NSN,NS,K,ITAG(NUMNOD),N1,N2
225C-----------------------------------------------
226 DO i =1,numnod
227 itag(i) =0
228 ENDDO
229C
230 DO i=1,nrbyac
231 n=irbyac(i)
232 k=irbyac(i+nrbykin)
233 m=npby(1,n)
234 nsn=npby(2,n)
235 IF (m>0) THEN
236 DO j=1,nsn
237 ns=lpby(k+j)
238 itag(ns) =m
239 ENDDO
240 ENDIF
241 ENDDO
242C
243 DO i=1,numelr
244 n1= ixr(2,i)
245 n2= ixr(3,i)
246 IF (itag(n1)>0.AND.itag(n1)==itag(n2)) THEN
247 CALL rby_imp4( x ,n1 ,n2 ,itag(n1),d ,dr )
248 ENDIF
249 ENDDO
250C
251 RETURN
252 END
253!||====================================================================
254!|| rby_imp4 ../engine/source/constraints/general/rbody/rby_impd.F
255!||--- called by ------------------------------------------------------
256!|| rby_imrd ../engine/source/constraints/general/rbody/rby_impd.F
257!||====================================================================
258 SUBROUTINE rby_imp4(X ,N1 ,N2 ,M ,D ,DR )
259C-----------------------------------------------
260C I m p l i c i t T y p e s
261C-----------------------------------------------
262#include "implicit_f.inc"
263C-----------------------------------------------
264C D u m m y A r g u m e n t s
265C-----------------------------------------------
266 INTEGER N1,N2,M
267 my_real X(3,*),D(3,*),DR(3,*)
268C-----------------------------------------------
269C L o c a l V a r i a b l e s
270C-----------------------------------------------
271 INTEGER I, N ,K,IT,NP
272 my_real
273 . XS,YS,ZS,X1(3),X2(3),DRX,DRY,DRZ,L0,L1,S
274C-----------------------------------------------
275 NP =10
276 drx = dr(1,m)/np
277 dry = dr(2,m)/np
278 drz = dr(3,m)/np
279 x1(1)=x(1,n1)
280 x1(2)=x(2,n1)
281 x1(3)=x(3,n1)
282 x2(1)=x(1,n2)
283 x2(2)=x(2,n2)
284 x2(3)=x(3,n2)
285 DO it = 1,np
286 xs=x1(1)-x(1,m)
287 ys=x1(2)-x(2,m)
288 zs=x1(3)-x(3,m)
289 x1(1)=x1(1)+dry*zs-drz*ys
290 x1(2)=x1(2)-drx*zs+drz*xs
291 x1(3)=x1(3)+drx*ys-dry*xs
292 xs=x2(1)-x(1,m)
293 ys=x2(2)-x(2,m)
294 zs=x2(3)-x(3,m)
295 x2(1)=x2(1)+dry*zs-drz*ys
296 x2(2)=x2(2)-drx*zs+drz*xs
297 x2(3)=x2(3)+drx*ys-dry*xs
298 ENDDO
299C
300 xs=x1(1)-x(1,n1)
301 ys=x1(2)-x(2,n1)
302 zs=x1(3)-x(3,n1)
303 d(1,n1)=d(1,m)+xs
304 d(2,n1)=d(2,m)+ys
305 d(3,n1)=d(3,m)+zs
306 xs=x2(1)-x(1,n2)
307 ys=x2(2)-x(2,n2)
308 zs=x2(3)-x(3,n2)
309 d(1,n2)=d(1,m)+xs
310 d(2,n2)=d(2,m)+ys
311 d(3,n2)=d(3,m)+zs
312C
313 xs=x(1,n2)-x(1,n1)
314 ys=x(2,n2)-x(2,n1)
315 zs=x(3,n2)-x(3,n1)
316 l0 = sqrt(xs*xs+ys*ys+zs*zs)
317 IF (l0<em10) THEN
318 d(1,n2)=d(1,n1)
319 d(2,n2)=d(2,n1)
320 d(3,n2)=d(3,n1)
321 ELSE
322 xs=xs+d(1,n2)-d(1,n1)
323 ys=ys+d(2,n2)-d(2,n1)
324 zs=zs+d(3,n2)-d(3,n1)
325 l1 = sqrt(xs*xs+ys*ys+zs*zs)
326 s = l0/l1
327 DO k =1,3
328 d(k,n1)=s*(x(k,n1)+d(k,n1))-x(k,n1)
329 d(k,n2)=s*(x(k,n2)+d(k,n2))-x(k,n2)
330 ENDDO
331 ENDIF
332C
333 RETURN
334 END
335!||====================================================================
336!|| rby_imp5 ../engine/source/constraints/general/rbody/rby_impd.F
337!||--- called by ------------------------------------------------------
338!|| rby_impd ../engine/source/constraints/general/rbody/rby_impd.F
339!||====================================================================
340 SUBROUTINE rby_imp5(
341 1 X ,RBY ,NOD ,ITRMAX,
342 1 NBY,SKEW,ISKEW,ITAB,WEIGHT,
343 2 MS ,IN ,NDOF ,D ,DR )
344C-----------------------------------------------
345C I m p l i c i t T y p e s
346C-----------------------------------------------
347#include "implicit_f.inc"
348C-----------------------------------------------
349C D u m m y A r g u m e n t s
350C-----------------------------------------------
351 INTEGER NOD(*), NBY(*), ISKEW(*),ITAB(*), WEIGHT(*)
352 INTEGER NDOF(*),ITRMAX
353 my_real x(3,*), rby(*),skew(lskew,*),in(*),ms(*),d(3,*),dr(3,*)
354C-----------------------------------------------
355C C o m m o n B l o c k s
356C-----------------------------------------------
357#include "param_c.inc"
358C-----------------------------------------------
359C L o c a l V a r i a b l e s
360C-----------------------------------------------
361 INTEGER M, NSN, I, N,NP,J
362 my_real XS,YS,ZS,LMAX,RMAX,LSM1,DRX,DRY,DRZ,A,B
363 my_real,DIMENSION(:),ALLOCATABLE :: LSM
364C-----------------------------------------------
365 m =nby(1)
366C optimisation spmd
367 IF (m<0) RETURN
368 nsn =nby(2)
369C---determine iteration num.
370 lmax = zero
371 rmax = max(abs(dr(1,m)),abs(dr(2,m)),abs(dr(3,m)))
372 ALLOCATE(lsm(nsn))
373 DO i=1,nsn
374 n = nod(i)
375 xs=x(1,n)-x(1,m)
376 ys=x(2,n)-x(2,m)
377 zs=x(3,n)-x(3,m)
378 lsm(i) = xs*xs+ys*ys+zs*zs
379 lmax = max(lmax,lsm(i))
380 ENDDO
381 np = rmax*sqrt(lmax)*fifty
382 np = min(itrmax,np)
383 IF (np<=1) THEN
384 DO i=1,nsn
385 n = nod(i)
386 xs=x(1,n)-x(1,m)
387 ys=x(2,n)-x(2,m)
388 zs=x(3,n)-x(3,m)
389 d(1,n)=d(1,m)+dr(2,m)*zs-dr(3,m)*ys
390 d(2,n)=d(2,m)-dr(1,m)*zs+dr(3,m)*xs
391 d(3,n)=d(3,m)+dr(1,m)*ys-dr(2,m)*xs
392 IF (ndof(n)>3) THEN
393 dr(1,n)= dr(1,m)
394 dr(2,n)= dr(2,m)
395 dr(3,n)= dr(3,m)
396 ENDIF
397 xs=x(1,n)-x(1,m)+d(1,n)-d(1,m)
398 ys=x(2,n)-x(2,m)+d(2,n)-d(2,m)
399 zs=x(3,n)-x(3,m)+d(3,n)-d(3,m)
400 ENDDO
401 ELSE
402 DO i=1,nsn
403 n = nod(i)
404 d(1,n)=x(1,n)
405 d(2,n)=x(2,n)
406 d(3,n)=x(3,n)
407 ENDDO
408 drx= dr(1,m)/np
409 dry= dr(2,m)/np
410 drz= dr(3,m)/np
411 DO j=1,np
412 DO i=1,nsn
413 n = nod(i)
414 xs=d(1,n)-x(1,m)
415 ys=d(2,n)-x(2,m)
416 zs=d(3,n)-x(3,m)
417 d(1,n)=d(1,n)+dry*zs-drz*ys
418 d(2,n)=d(2,n)-drx*zs+drz*xs
419 d(3,n)=d(3,n)+drx*ys-dry*xs
420 ENDDO
421 ENDDO
422 DO i=1,nsn
423 n = nod(i)
424 d(1,n)=d(1,m)+d(1,n)-x(1,n)
425 d(2,n)=d(2,m)+d(2,n)-x(2,n)
426 d(3,n)=d(3,m)+d(3,n)-x(3,n)
427 IF (ndof(n)>3) THEN
428 dr(1,n)= dr(1,m)
429 dr(2,n)= dr(2,m)
430 dr(3,n)= dr(3,m)
431 ENDIF
432 ENDDO
433 END IF !(NP<=1) THEN
434C
435 DO i=1,nsn
436 IF (lsm(i)>em10) THEN
437 n = nod(i)
438 xs=x(1,n)-x(1,m)+d(1,n)-d(1,m)
439 ys=x(2,n)-x(2,m)+d(2,n)-d(2,m)
440 zs=x(3,n)-x(3,m)+d(3,n)-d(3,m)
441 lsm1 =xs*xs+ys*ys+zs*zs
442 a = sqrt(lsm(i)/lsm1)-one
443 d(1,n)=d(1,n)+a*xs
444 d(2,n)=d(2,n)+a*ys
445 d(3,n)=d(3,n)+a*zs
446 ENDIF
447 ENDDO
448 DEALLOCATE(lsm)
449C
450 RETURN
451 END
452!||====================================================================
453!|| rby_imp7 ../engine/source/constraints/general/rbody/rby_impd.F
454!||--- called by ------------------------------------------------------
455!|| rby_impd ../engine/source/constraints/general/rbody/rby_impd.F
456!||--- calls -----------------------------------------------------
457!|| velrot ../engine/source/constraints/general/rbe2/rbe2v.F
458!||====================================================================
459 SUBROUTINE rby_imp7(
460 1 X ,RBY ,NOD ,
461 1 NBY,SKEW,ISKEW,ITAB,WEIGHT,
462 2 MS ,IN ,NDOF ,D ,DR )
463C-----------------------------------------------
464C I m p l i c i t T y p e s
465C-----------------------------------------------
466#include "implicit_f.inc"
467C-----------------------------------------------
468C D u m m y A r g u m e n t s
469C-----------------------------------------------
470 INTEGER NOD(*), NBY(*), ISKEW(*),ITAB(*), WEIGHT(*)
471 INTEGER NDOF(*),ITRMAX
472C REAL
473 my_real
474 . X(3,*), RBY(*),SKEW(LSKEW,*),IN(*),MS(*),D(3,*),DR(3,*)
475C-----------------------------------------------
476C C o m m o n B l o c k s
477C-----------------------------------------------
478#include "param_c.inc"
479C-----------------------------------------------
480C PURPOSE: calculate displacement increment of secnd node by displacement increment of main node.
481C
482C-----------------------------------------------
483C L o c a l V a r i a b l e s
484C-----------------------------------------------
485 INTEGER M, NSN, I, N,NP,J,K
486C REAL
487 double precision
488 . xs(3), ds(3), vrm(3)
489C-----------------------------------------------
490
491 m = nby(1)
492C optimisation spmd
493 IF (m<0) RETURN
494
495 DO i = 1, 3
496 vrm(i) = dr(i,m)
497 END DO
498
499 nsn =nby(2)
500 DO i=1,nsn
501 n = nod(i)
502 DO j = 1 , 3
503 xs(j) = x(j,n) - x(j,m)
504 END DO
505 CALL velrot(vrm,xs,ds)
506 DO j = 1 , 3
507 d(j,n) = d(j,m) + ds(j)
508 END DO
509
510 IF (ndof(n)>3) THEN
511 dr(1,n)= dr(1,m)
512 dr(2,n)= dr(2,m)
513 dr(3,n)= dr(3,m)
514 ENDIF
515
516 END DO ! I=1,NSN
517
518 RETURN
519
520 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
velrot
subroutine velrot(vrm, lsm, vs)
Definition rbe2v.F:1119
rby_imp2
subroutine rby_imp2(x, rby, nod, nby, skew, iskew, itab, weight, ms, in, ndof, d, dr)
Definition rby_impd.F:107
rby_imp7
subroutine rby_imp7(x, rby, nod, nby, skew, iskew, itab, weight, ms, in, ndof, d, dr)
Definition rby_impd.F:463
rby_imrd
subroutine rby_imrd(nrbyac, irbyac, x, rby, lpby, npby, skew, iskew, itab, weight, ms, in, ndof, d, dr, ixr)
Definition rby_impd.F:203
rby_imp4
subroutine rby_imp4(x, n1, n2, m, d, dr)
Definition rby_impd.F:259
rby_impd
subroutine rby_impd(nrbyac, irbyac, x, rby, lpby, npby, skew, iskew, itab, weight, ms, in, ndof, d, dr, ixr)
Definition rby_impd.F:37
rby_imp5
subroutine rby_imp5(x, rby, nod, itrmax, nby, skew, iskew, itab, weight, ms, in, ndof, d, dr)
Definition rby_impd.F:344
rby_imp3
subroutine rby_imp3(x, m, n, d, dr, a, ar)
Definition rby_impd.F:156