OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rby_impd.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "impl1_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine rby_impd (nrbyac, irbyac, x, rby, lpby, npby, skew, iskew, itab, weight, ms, in, ndof, d, dr, ixr)
subroutine rby_imp2 (x, rby, nod, nby, skew, iskew, itab, weight, ms, in, ndof, d, dr)
subroutine rby_imp3 (x, m, n, d, dr, a, ar)
subroutine rby_imrd (nrbyac, irbyac, x, rby, lpby, npby, skew, iskew, itab, weight, ms, in, ndof, d, dr, ixr)
subroutine rby_imp4 (x, n1, n2, m, d, dr)
subroutine rby_imp5 (x, rby, nod, itrmax, nby, skew, iskew, itab, weight, ms, in, ndof, d, dr)
subroutine rby_imp7 (x, rby, nod, nby, skew, iskew, itab, weight, ms, in, ndof, d, dr)

Function/Subroutine Documentation

◆ rby_imp2()

subroutine rby_imp2 ( x,
rby,
integer, dimension(*) nod,
integer, dimension(*) nby,
skew,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(*) weight,
ms,
in,
integer, dimension(*) ndof,
d,
dr )

Definition at line 103 of file rby_impd.F.

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
my_real
#define my_real
Definition cppsort.cpp:32

◆ rby_imp3()

subroutine rby_imp3 ( x,
integer m,
integer n,
d,
dr,
a,
ar )

Definition at line 154 of file rby_impd.F.

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

◆ rby_imp4()

subroutine rby_imp4 ( x,
integer n1,
integer n2,
integer m,
d,
dr )

Definition at line 258 of file rby_impd.F.

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

◆ rby_imp5()

subroutine rby_imp5 ( x,
rby,
integer, dimension(*) nod,
integer itrmax,
integer, dimension(*) nby,
skew,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(*) weight,
ms,
in,
integer, dimension(*) ndof,
d,
dr )

Definition at line 340 of file rby_impd.F.

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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ rby_imp7()

subroutine rby_imp7 ( x,
rby,
integer, dimension(*) nod,
integer, dimension(*) nby,
skew,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(*) weight,
ms,
in,
integer, dimension(*) ndof,
d,
dr )

Definition at line 459 of file rby_impd.F.

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
velrot
subroutine velrot(vrm, lsm, vs)
Definition rbe2v.F:1119

◆ rby_impd()

subroutine rby_impd ( integer nrbyac,
integer, dimension(*) irbyac,
x,
rby,
integer, dimension(*) lpby,
integer, dimension(nnpby,*) npby,
skew,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(*) weight,
ms,
in,
integer, dimension(*) ndof,
d,
dr,
integer, dimension(*) ixr )

Definition at line 33 of file rby_impd.F.

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
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_imp5
subroutine rby_imp5(x, rby, nod, itrmax, nby, skew, iskew, itab, weight, ms, in, ndof, d, dr)
Definition rby_impd.F:344

◆ rby_imrd()

subroutine rby_imrd ( integer nrbyac,
integer, dimension(*) irbyac,
x,
rby,
integer, dimension(*) lpby,
integer, dimension(nnpby,*) npby,
skew,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(*) weight,
ms,
in,
integer, dimension(*) ndof,
d,
dr,
integer, dimension(nixr,*) ixr )

Definition at line 199 of file rby_impd.F.

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
rby_imp4
subroutine rby_imp4(x, n1, n2, m, d, dr)
Definition rby_impd.F:259