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!||--- uses -----------------------------------------------------
199!|| element_mod ../common_source/modules/elements/element_mod.F90
200!||====================================================================
201 SUBROUTINE rby_imrd(NRBYAC,IRBYAC,X ,RBY,LPBY,
202 1 NPBY,SKEW,ISKEW,ITAB,WEIGHT,
203 2 MS ,IN ,NDOF ,D ,
204 3 DR ,IXR )
205 use element_mod , only : nixr
206C-----------------------------------------------
207C I m p l i c i t T y p e s
208C-----------------------------------------------
209#include "implicit_f.inc"
210C-----------------------------------------------
211C C o m m o n B l o c k s
212C-----------------------------------------------
213#include "com04_c.inc"
214#include "param_c.inc"
215C-----------------------------------------------
216C D u m m y A r g u m e n t s
217C-----------------------------------------------
218 INTEGER WEIGHT(*),LPBY(*),NPBY(NNPBY,*),ISKEW(*),ITAB(*)
219 INTEGER NDOF(*),NRBYAC,IRBYAC(*),IXR(NIXR,*)
220C REAL
221 my_real
222 . X(3,*), RBY(NRBY,*), SKEW(LSKEW,*),
223 . IN(*),MS(*),D(3,*), DR(3,*)
224C-----------------------------------------------
225C L o c a l V a r i a b l e s
226C-----------------------------------------------
227 INTEGER I,J,M, N,NSN,NS,K,ITAG(NUMNOD),N1,N2
228C-----------------------------------------------
229 DO i =1,numnod
230 itag(i) =0
231 ENDDO
232C
233 DO i=1,nrbyac
234 n=irbyac(i)
235 k=irbyac(i+nrbykin)
236 m=npby(1,n)
237 nsn=npby(2,n)
238 IF (m>0) THEN
239 DO j=1,nsn
240 ns=lpby(k+j)
241 itag(ns) =m
242 ENDDO
243 ENDIF
244 ENDDO
245C
246 DO i=1,numelr
247 n1= ixr(2,i)
248 n2= ixr(3,i)
249 IF (itag(n1)>0.AND.itag(n1)==itag(n2)) THEN
250 CALL rby_imp4( x ,n1 ,n2 ,itag(n1),d ,dr )
251 ENDIF
252 ENDDO
253C
254 RETURN
255 END
256!||====================================================================
257!|| rby_imp4 ../engine/source/constraints/general/rbody/rby_impd.F
258!||--- called by ------------------------------------------------------
259!|| rby_imrd ../engine/source/constraints/general/rbody/rby_impd.F
260!||====================================================================
261 SUBROUTINE rby_imp4(X ,N1 ,N2 ,M ,D ,DR )
262C-----------------------------------------------
263C I m p l i c i t T y p e s
264C-----------------------------------------------
265#include "implicit_f.inc"
266C-----------------------------------------------
267C D u m m y A r g u m e n t s
268C-----------------------------------------------
269 INTEGER N1,N2,M
270 my_real X(3,*),D(3,*),DR(3,*)
271C-----------------------------------------------
272C L o c a l V a r i a b l e s
273C-----------------------------------------------
274 INTEGER K,IT,NP
275 my_real
276 . XS,YS,ZS,X1(3),X2(3),DRX,DRY,DRZ,L0,L1,S
277C-----------------------------------------------
278 NP =10
279 drx = dr(1,m)/np
280 dry = dr(2,m)/np
281 drz = dr(3,m)/np
282 x1(1)=x(1,n1)
283 x1(2)=x(2,n1)
284 x1(3)=x(3,n1)
285 x2(1)=x(1,n2)
286 x2(2)=x(2,n2)
287 x2(3)=x(3,n2)
288 DO it = 1,np
289 xs=x1(1)-x(1,m)
290 ys=x1(2)-x(2,m)
291 zs=x1(3)-x(3,m)
292 x1(1)=x1(1)+dry*zs-drz*ys
293 x1(2)=x1(2)-drx*zs+drz*xs
294 x1(3)=x1(3)+drx*ys-dry*xs
295 xs=x2(1)-x(1,m)
296 ys=x2(2)-x(2,m)
297 zs=x2(3)-x(3,m)
298 x2(1)=x2(1)+dry*zs-drz*ys
299 x2(2)=x2(2)-drx*zs+drz*xs
300 x2(3)=x2(3)+drx*ys-dry*xs
301 ENDDO
302C
303 xs=x1(1)-x(1,n1)
304 ys=x1(2)-x(2,n1)
305 zs=x1(3)-x(3,n1)
306 d(1,n1)=d(1,m)+xs
307 d(2,n1)=d(2,m)+ys
308 d(3,n1)=d(3,m)+zs
309 xs=x2(1)-x(1,n2)
310 ys=x2(2)-x(2,n2)
311 zs=x2(3)-x(3,n2)
312 d(1,n2)=d(1,m)+xs
313 d(2,n2)=d(2,m)+ys
314 d(3,n2)=d(3,m)+zs
315C
316 xs=x(1,n2)-x(1,n1)
317 ys=x(2,n2)-x(2,n1)
318 zs=x(3,n2)-x(3,n1)
319 l0 = sqrt(xs*xs+ys*ys+zs*zs)
320 IF (l0<em10) THEN
321 d(1,n2)=d(1,n1)
322 d(2,n2)=d(2,n1)
323 d(3,n2)=d(3,n1)
324 ELSE
325 xs=xs+d(1,n2)-d(1,n1)
326 ys=ys+d(2,n2)-d(2,n1)
327 zs=zs+d(3,n2)-d(3,n1)
328 l1 = sqrt(xs*xs+ys*ys+zs*zs)
329 s = l0/l1
330 DO k =1,3
331 d(k,n1)=s*(x(k,n1)+d(k,n1))-x(k,n1)
332 d(k,n2)=s*(x(k,n2)+d(k,n2))-x(k,n2)
333 ENDDO
334 ENDIF
335C
336 RETURN
337 END
338!||====================================================================
339!|| rby_imp5 ../engine/source/constraints/general/rbody/rby_impd.F
340!||--- called by ------------------------------------------------------
341!|| rby_impd ../engine/source/constraints/general/rbody/rby_impd.F
342!||====================================================================
343 SUBROUTINE rby_imp5(
344 1 X ,RBY ,NOD ,ITRMAX,
345 1 NBY,SKEW,ISKEW,ITAB,WEIGHT,
346 2 MS ,IN ,NDOF ,D ,DR )
347C-----------------------------------------------
348C I m p l i c i t T y p e s
349C-----------------------------------------------
350#include "implicit_f.inc"
351C-----------------------------------------------
352C D u m m y A r g u m e n t s
353C-----------------------------------------------
354 INTEGER NOD(*), NBY(*), ISKEW(*),ITAB(*), WEIGHT(*)
355 INTEGER NDOF(*),ITRMAX
356 my_real x(3,*), rby(*),skew(lskew,*),in(*),ms(*),d(3,*),dr(3,*)
357C-----------------------------------------------
358C C o m m o n B l o c k s
359C-----------------------------------------------
360#include "param_c.inc"
361C-----------------------------------------------
362C L o c a l V a r i a b l e s
363C-----------------------------------------------
364 INTEGER M, NSN, I, N,NP,J
365 my_real XS,YS,ZS,LMAX,RMAX,LSM1,DRX,DRY,DRZ,A
366 my_real,DIMENSION(:),ALLOCATABLE :: LSM
367C-----------------------------------------------
368 m =nby(1)
369C optimisation spmd
370 IF (m<0) RETURN
371 nsn =nby(2)
372C---determine iteration num.
373 lmax = zero
374 rmax = max(abs(dr(1,m)),abs(dr(2,m)),abs(dr(3,m)))
375 ALLOCATE(lsm(nsn))
376 DO i=1,nsn
377 n = nod(i)
378 xs=x(1,n)-x(1,m)
379 ys=x(2,n)-x(2,m)
380 zs=x(3,n)-x(3,m)
381 lsm(i) = xs*xs+ys*ys+zs*zs
382 lmax = max(lmax,lsm(i))
383 ENDDO
384 np = rmax*sqrt(lmax)*fifty
385 np = min(itrmax,np)
386 IF (np<=1) THEN
387 DO i=1,nsn
388 n = nod(i)
389 xs=x(1,n)-x(1,m)
390 ys=x(2,n)-x(2,m)
391 zs=x(3,n)-x(3,m)
392 d(1,n)=d(1,m)+dr(2,m)*zs-dr(3,m)*ys
393 d(2,n)=d(2,m)-dr(1,m)*zs+dr(3,m)*xs
394 d(3,n)=d(3,m)+dr(1,m)*ys-dr(2,m)*xs
395 IF (ndof(n)>3) THEN
396 dr(1,n)= dr(1,m)
397 dr(2,n)= dr(2,m)
398 dr(3,n)= dr(3,m)
399 ENDIF
400 xs=x(1,n)-x(1,m)+d(1,n)-d(1,m)
401 ys=x(2,n)-x(2,m)+d(2,n)-d(2,m)
402 zs=x(3,n)-x(3,m)+d(3,n)-d(3,m)
403 ENDDO
404 ELSE
405 DO i=1,nsn
406 n = nod(i)
407 d(1,n)=x(1,n)
408 d(2,n)=x(2,n)
409 d(3,n)=x(3,n)
410 ENDDO
411 drx= dr(1,m)/np
412 dry= dr(2,m)/np
413 drz= dr(3,m)/np
414 DO j=1,np
415 DO i=1,nsn
416 n = nod(i)
417 xs=d(1,n)-x(1,m)
418 ys=d(2,n)-x(2,m)
419 zs=d(3,n)-x(3,m)
420 d(1,n)=d(1,n)+dry*zs-drz*ys
421 d(2,n)=d(2,n)-drx*zs+drz*xs
422 d(3,n)=d(3,n)+drx*ys-dry*xs
423 ENDDO
424 ENDDO
425 DO i=1,nsn
426 n = nod(i)
427 d(1,n)=d(1,m)+d(1,n)-x(1,n)
428 d(2,n)=d(2,m)+d(2,n)-x(2,n)
429 d(3,n)=d(3,m)+d(3,n)-x(3,n)
430 IF (ndof(n)>3) THEN
431 dr(1,n)= dr(1,m)
432 dr(2,n)= dr(2,m)
433 dr(3,n)= dr(3,m)
434 ENDIF
435 ENDDO
436 END IF !(NP<=1) THEN
437C
438 DO i=1,nsn
439 IF (lsm(i)>em10) THEN
440 n = nod(i)
441 xs=x(1,n)-x(1,m)+d(1,n)-d(1,m)
442 ys=x(2,n)-x(2,m)+d(2,n)-d(2,m)
443 zs=x(3,n)-x(3,m)+d(3,n)-d(3,m)
444 lsm1 =xs*xs+ys*ys+zs*zs
445 a = sqrt(lsm(i)/lsm1)-one
446 d(1,n)=d(1,n)+a*xs
447 d(2,n)=d(2,n)+a*ys
448 d(3,n)=d(3,n)+a*zs
449 ENDIF
450 ENDDO
451 DEALLOCATE(lsm)
452C
453 RETURN
454 END
455!||====================================================================
456!|| rby_imp7 ../engine/source/constraints/general/rbody/rby_impd.F
457!||--- called by ------------------------------------------------------
458!|| rby_impd ../engine/source/constraints/general/rbody/rby_impd.F
459!||--- calls -----------------------------------------------------
460!|| velrot ../engine/source/constraints/general/rbe2/rbe2v.f
461!||====================================================================
462 SUBROUTINE rby_imp7(
463 1 X ,RBY ,NOD ,
464 1 NBY,SKEW,ISKEW,ITAB,WEIGHT,
465 2 MS ,IN ,NDOF ,D ,DR )
466C-----------------------------------------------
467C I m p l i c i t T y p e s
468C-----------------------------------------------
469#include "implicit_f.inc"
470C-----------------------------------------------
471C D u m m y A r g u m e n t s
472C-----------------------------------------------
473 INTEGER NOD(*), NBY(*), ISKEW(*),ITAB(*), WEIGHT(*)
474 INTEGER NDOF(*)
475C REAL
476 my_real
477 . X(3,*), RBY(*),SKEW(LSKEW,*),IN(*),MS(*),D(3,*),DR(3,*)
478C-----------------------------------------------
479C C o m m o n B l o c k s
480C-----------------------------------------------
481#include "param_c.inc"
482C-----------------------------------------------
483C PURPOSE: calculate displacement increment of secnd node by displacement increment of main node.
484C
485C-----------------------------------------------
486C L o c a l V a r i a b l e s
487C-----------------------------------------------
488 INTEGER M, NSN, I, N,J
489C REAL
490 double precision
491 . xs(3), ds(3), vrm(3)
492C-----------------------------------------------
493
494 m = nby(1)
495C optimisation spmd
496 IF (m<0) RETURN
497
498 DO i = 1, 3
499 vrm(i) = dr(i,m)
500 END DO
501
502 nsn =nby(2)
503 DO i=1,nsn
504 n = nod(i)
505 DO j = 1 , 3
506 xs(j) = x(j,n) - x(j,m)
507 END DO
508 CALL velrot(vrm,xs,ds)
509 DO j = 1 , 3
510 d(j,n) = d(j,m) + ds(j)
511 END DO
512
513 IF (ndof(n)>3) THEN
514 dr(1,n)= dr(1,m)
515 dr(2,n)= dr(2,m)
516 dr(3,n)= dr(3,m)
517 ENDIF
518
519 END DO ! I=1,NSN
520
521 RETURN
522
523 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
rbe2v
subroutine rbe2v(irbe2, lrbe2, x, a, ar, v, vr, skew)
Definition rbe2v.F:34
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:466
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:205
rby_imp4
subroutine rby_imp4(x, n1, n2, m, d, dr)
Definition rby_impd.F:262
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:347
rby_imp3
subroutine rby_imp3(x, m, n, d, dr, a, ar)
Definition rby_impd.F:156