OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rbyact.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "param_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine rbyact (rby, m, lsn, nsl, ms, in, x, itab, skew, isph, iwa, npbyi, rbyi, lsni, pmain, icomm, weight, id)

Function/Subroutine Documentation

◆ rbyact()

subroutine rbyact ( rby,
integer m,
integer, dimension(*) lsn,
integer nsl,
ms,
in,
x,
integer, dimension(*) itab,
skew,
integer isph,
integer, dimension(*) iwa,
integer, dimension(nnpby,*) npbyi,
rbyi,
integer, dimension(*) lsni,
integer pmain,
integer, dimension(*) icomm,
integer, dimension(*) weight,
integer id )

Definition at line 37 of file rbyact.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE message_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "units_c.inc"
53#include "task_c.inc"
54#include "param_c.inc"
55#include "com01_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER M, NSL,ISPH, PMAIN, ICOMM(*), WEIGHT(*)
60 INTEGER LSN(*), ITAB(*),IWA(*),NPBYI(NNPBY,*) ,LSNI(*),ID
61C REAL
62 my_real
63 . rby(20), ms(*), in(*), x(3,*), skew(lskew,*),rbyi(nrby,*),
64 . f1(nsl), f2(nsl), f3(nsl), f4(nsl),
65 . f5(nsl), f6(nsl),f7(nsl), f8(nsl),f9(nsl)
66 DOUBLE PRECISION RBF6(5,6), RBFB6(9,6)
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER J, I, N, NONOD, NI, NSLI, K, II
71C REAL
72 my_real
73 . xg(3), xmg, xx, xy, xz, yy, yz, zz, xiin,masrb,inert,
74 . rby17,rby18,rby19,rby20,rby21,rby22,rby23,rby24,rby25,
75 . ii1,ii2,ii3,ii4,ii5,ii6,ii7,ii8,ii9, inmin, inmax
76C
77 rby(1)=in(m)
78 rby(2)=zero
79 rby(3)=zero
80 rby(4)=zero
81 rby(5)=in(m)
82 rby(6)=zero
83 rby(7)=zero
84 rby(8)=zero
85 rby(9)=in(m)
86C
87 xmg=ms(m)
88 masrb=ms(m)
89 nonod=itab(m)
90C
91c IF(NSPMD>1) THEN
92c RBY(1)=RBY(1)*WEIGHT(M)
93c RBY(5)=RBY(5)*WEIGHT(M)
94c RBY(9)=RBY(9)*WEIGHT(M)
95c MASRB=MASRB*WEIGHT(M)
96c XMG=XMG*WEIGHT(M)
97c ENDIF
98C---------------------------------
99C RECHERCHE DES NOEUDS SECONDS
100C DE SOUS RBY (NOEUD MAIN PARMI LES SECONDS)
101C---------------------------------
102 DO i=1,nsl
103 n=lsn(i)
104 IF(iwa(n)>0)THEN
105 k=0
106 DO ni=1,iwa(n)-1
107 nsli=npbyi(2,ni)
108 k = k + nsli
109 ENDDO
110 nsli=npbyi(2,iwa(n))
111 DO ii=1,nsli
112 ni=lsni(k+ii)
113 IF(iwa(ni)==0)iwa(ni)=-1
114 ENDDO
115 ENDIF
116 ENDDO
117C---------------------------------
118C CORRECTION DE LA MASSE ET DU
119C CENTRE DE GRAVITE DU MAIN
120C---------------------------------
121 DO j=1,3
122 xg(j)=x(j,m)
123 x(j,m)=x(j,m)*ms(m)
124 ENDDO
125 IF(n2d/=0) THEN
126C ANALYSE 2D
127 xg(1)= zero
128 x(1,m)= zero
129 ENDIF
130C
131 DO i=1,nsl
132 n=lsn(i)
133 IF(iwa(n)>=0.AND.weight(n)==1)THEN
134 f1(i) = x(1,n)*ms(n)
135 f2(i) = x(2,n)*ms(n)
136 f3(i) = x(3,n)*ms(n)
137 f4(i) = ms(n)
138 f5(i) = in(n)
139 ELSE
140 f1(i) = zero
141 f2(i) = zero
142 f3(i) = zero
143 f4(i) = zero
144C inertie meme si iwa(n)==0
145 f5(i) = in(n)*weight(n)
146 ENDIF
147 ENDDO
148C
149C Traitement Parith/ON avant echange
150C
151 DO k = 1, 6
152 rbf6(1,k) = zero
153 rbf6(2,k) = zero
154 rbf6(3,k) = zero
155 rbf6(4,k) = zero
156 rbf6(5,k) = zero
157 END DO
158C
159 CALL sum_6_float(1 ,nsl ,f1, rbf6(1,1), 5)
160 CALL sum_6_float(1 ,nsl ,f2, rbf6(2,1), 5)
161 CALL sum_6_float(1 ,nsl ,f3, rbf6(3,1), 5)
162 CALL sum_6_float(1 ,nsl ,f4, rbf6(4,1), 5)
163 CALL sum_6_float(1 ,nsl ,f5, rbf6(5,1), 5)
164
165
166 IF(nspmd>1) THEN
167 CALL spmd_exch_fr6(icomm,rbf6,5*6)
168 ENDIF
169
170 x(1,m) = x(1,m)+
171 + rbf6(1,1)+rbf6(1,2)+rbf6(1,3)+
172 + rbf6(1,4)+rbf6(1,5)+rbf6(1,6)
173 x(2,m) = x(2,m)+
174 + rbf6(2,1)+rbf6(2,2)+rbf6(2,3)+
175 + rbf6(2,4)+rbf6(2,5)+rbf6(2,6)
176 x(3,m) = x(3,m)+
177 + rbf6(3,1)+rbf6(3,2)+rbf6(3,3)+
178 + rbf6(3,4)+rbf6(3,5)+rbf6(3,6)
179 masrb = masrb+
180 + rbf6(4,1)+rbf6(4,2)+rbf6(4,3)+
181 + rbf6(4,4)+rbf6(4,5)+rbf6(4,6)
182 inert =rbf6(5,1)+rbf6(5,2)+rbf6(5,3)+
183 + rbf6(5,4)+rbf6(5,5)+rbf6(5,6)
184
185 IF(masrb<=zero)THEN
186 IF (ispmd+1==pmain) THEN
187 CALL ancmsg(msgid=109,anmode=aninfo,
188 . i1=nonod)
189 ENDIF
190 CALL arret(2)
191 ENDIF
192
193 DO j=1,3
194 x(j,m)=x(j,m)/masrb
195 ENDDO
196
197C--------------------------------------
198C CORRECTION DE L'INERTIE DU MAIN
199C--------------------------------------
200 rby(1)=rby(1)+inert
201 rby(5)=rby(5)+inert
202 rby(9)=rby(9)+inert
203C
204 IF(n2d==0) THEN
205C ANALYSE 3D
206 xx=(xg(1)-x(1,m))*(xg(1)-x(1,m))
207 xy=(xg(1)-x(1,m))*(xg(2)-x(2,m))
208 xz=(xg(1)-x(1,m))*(xg(3)-x(3,m))
209 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
210 yz=(xg(2)-x(2,m))*(xg(3)-x(3,m))
211 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
212 rby(1)=rby(1)+(yy+zz)*xmg
213 rby(2)=rby(2)-xy*xmg
214 rby(3)=rby(3)-xz*xmg
215 rby(4)=rby(4)-xy*xmg
216 rby(5)=rby(5)+(zz+xx)*xmg
217 rby(6)=rby(6)-yz*xmg
218 rby(7)=rby(7)-xz*xmg
219 rby(8)=rby(8)-yz*xmg
220 rby(9)=rby(9)+(xx+yy)*xmg
221C
222 DO i=1,nsl
223 n=lsn(i)
224 ni=iwa(n)
225 IF(ni==0.AND.weight(n)==1)THEN
226 xx=(x(1,n)-x(1,m))*(x(1,n)-x(1,m))
227 xy=(x(1,n)-x(1,m))*(x(2,n)-x(2,m))
228 xz=(x(1,n)-x(1,m))*(x(3,n)-x(3,m))
229 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
230 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
231 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
232 f1(i)=(yy+zz)*ms(n)
233 f2(i)=-xy*ms(n)
234 f3(i)=-xz*ms(n)
235 f4(i)=-xy*ms(n)
236 f5(i)=(zz+xx)*ms(n)
237 f6(i)=-yz*ms(n)
238 f7(i)=-xz*ms(n)
239 f8(i)=-yz*ms(n)
240 f9(i)=(xx+yy)*ms(n)
241 ELSEIF(ni>0.AND.weight(n)==1)THEN
242C main DE SOUS RBY
243 rby(1)=rby(1)-in(n)
244 rby(5)=rby(5)-in(n)
245 rby(9)=rby(9)-in(n)
246 xx=(x(1,n)-x(1,m))*(x(1,n)-x(1,m))
247 xy=(x(1,n)-x(1,m))*(x(2,n)-x(2,m))
248 xz=(x(1,n)-x(1,m))*(x(3,n)-x(3,m))
249 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
250 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
251 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
252C MATRICE d'inertie -> repere globale
253 ii1=rbyi(10,ni)*rbyi(1,ni)
254 ii2=rbyi(10,ni)*rbyi(2,ni)
255 ii3=rbyi(10,ni)*rbyi(3,ni)
256 ii4=rbyi(11,ni)*rbyi(4,ni)
257 ii5=rbyi(11,ni)*rbyi(5,ni)
258 ii6=rbyi(11,ni)*rbyi(6,ni)
259 ii7=rbyi(12,ni)*rbyi(7,ni)
260 ii8=rbyi(12,ni)*rbyi(8,ni)
261 ii9=rbyi(12,ni)*rbyi(9,ni)
262C
263 rby17=rbyi(1,ni)*ii1 + rbyi(4,ni)*ii4 + rbyi(7,ni)*ii7
264 rby18=rbyi(1,ni)*ii2 + rbyi(4,ni)*ii5 + rbyi(7,ni)*ii8
265 rby19=rbyi(1,ni)*ii3 + rbyi(4,ni)*ii6 + rbyi(7,ni)*ii9
266 rby20=rbyi(2,ni)*ii1 + rbyi(5,ni)*ii4 + rbyi(8,ni)*ii7
267 rby21=rbyi(2,ni)*ii2 + rbyi(5,ni)*ii5 + rbyi(8,ni)*ii8
268 rby22=rbyi(2,ni)*ii3 + rbyi(5,ni)*ii6 + rbyi(8,ni)*ii9
269 rby23=rbyi(3,ni)*ii1 + rbyi(6,ni)*ii4 + rbyi(9,ni)*ii7
270 rby24=rbyi(3,ni)*ii2 + rbyi(6,ni)*ii5 + rbyi(9,ni)*ii8
271 rby25=rbyi(3,ni)*ii3 + rbyi(6,ni)*ii6 + rbyi(9,ni)*ii9
272C
273 f1(i)=(yy+zz)*ms(n)+rby17
274 f2(i)=-xy*ms(n)+rby18
275 f3(i)=-xz*ms(n)+rby19
276 f4(i)=-xy*ms(n)+rby20
277 f5(i)=(zz+xx)*ms(n)+rby21
278 f6(i)=-yz*ms(n)+rby22
279 f7(i)=-xz*ms(n)+rby23
280 f8(i)=-yz*ms(n)+rby24
281 f9(i)=(xx+yy)*ms(n)+rby25
282 ELSE
283 f1(i) = zero
284 f2(i) = zero
285 f3(i) = zero
286 f4(i) = zero
287 f5(i) = zero
288 f6(i) = zero
289 f7(i) = zero
290 f8(i) = zero
291 f9(i) = zero
292 ENDIF
293 ENDDO
294 ELSEIF(n2d==1) THEN
295C ANALYSE 2D
296 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
297 yz=(xg(2)-x(2,m))*(xg(3)-x(3,m))
298 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
299 rby(1)=rby(1)+(yy+zz)*xmg
300 rby(2)=zero
301 rby(3)=zero
302 rby(4)=zero
303 rby(5)=rby(5)+zz*xmg
304 rby(6)=rby(6)-yz*xmg
305 rby(7)=zero
306 rby(8)=rby(8)-yz*xmg
307 rby(9)=rby(9)+yy*xmg
308C
309 DO i=1,nsl
310 n=lsn(i)
311 ni=iwa(n)
312 IF(ni==0.AND.weight(n)==1)THEN
313 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
314 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
315 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
316 f1(i)=(yy+zz)*ms(n)
317 f2(i)=zero
318 f3(i)=zero
319 f4(i)=zero
320 f5(i)=zz*ms(n)
321 f6(i)=-yz*ms(n)
322 f7(i)=zero
323 f8(i)=-yz*ms(n)
324 f9(i)=yy*ms(n)
325 ELSEIF(ni>0.AND.weight(n)==1)THEN
326C main DE SOUS RBY
327 rby(1)=rby(1)-in(n)
328 rby(5)=rby(5)-in(n)
329 rby(9)=rby(9)-in(n)
330 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
331 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
332 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
333C MATRICE d'inertie -> repere globale
334 ii1=rbyi(10,ni)*rbyi(1,ni)
335 ii5=rbyi(11,ni)*rbyi(5,ni)
336 ii6=rbyi(11,ni)*rbyi(6,ni)
337 ii8=rbyi(12,ni)*rbyi(8,ni)
338 ii9=rbyi(12,ni)*rbyi(9,ni)
339C
340 rby17=rbyi(1,ni)*ii1
341 rby18= zero
342 rby19= zero
343 rby20= zero
344 rby21= rbyi(5,ni)*ii5 + rbyi(8,ni)*ii8
345 rby22= rbyi(5,ni)*ii6 + rbyi(8,ni)*ii9
346 rby23= zero
347 rby24= rbyi(6,ni)*ii5 + rbyi(9,ni)*ii8
348 rby25= rbyi(6,ni)*ii6 + rbyi(9,ni)*ii9
349C
350 f1(i)=(yy+zz)*ms(n)+rby17
351 f2(i)=zero
352 f3(i)=zero
353 f4(i)=zero
354 f5(i)=zz*ms(n)+rby21
355 f6(i)=-yz*ms(n)+rby22
356 f7(i)=zero
357 f8(i)=-yz*ms(n)+rby24
358 f9(i)=yy*ms(n)+rby25
359 ELSE
360 f1(i) = zero
361 f2(i) = zero
362 f3(i) = zero
363 f4(i) = zero
364 f5(i) = zero
365 f6(i) = zero
366 f7(i) = zero
367 f8(i) = zero
368 f9(i) = zero
369 ENDIF
370 ENDDO
371 ENDIF
372C
373C Traitement Parith/ON avant echange
374C
375 DO k = 1, 6
376 rbfb6(1,k) = zero
377 rbfb6(2,k) = zero
378 rbfb6(3,k) = zero
379 rbfb6(4,k) = zero
380 rbfb6(5,k) = zero
381 rbfb6(6,k) = zero
382 rbfb6(7,k) = zero
383 rbfb6(8,k) = zero
384 rbfb6(9,k) = zero
385 END DO
386
387 CALL sum_6_float(1 ,nsl ,f1, rbfb6(1,1), 9)
388 CALL sum_6_float(1 ,nsl ,f2, rbfb6(2,1), 9)
389 CALL sum_6_float(1 ,nsl ,f3, rbfb6(3,1), 9)
390 CALL sum_6_float(1 ,nsl ,f4, rbfb6(4,1), 9)
391 CALL sum_6_float(1 ,nsl ,f5, rbfb6(5,1), 9)
392 CALL sum_6_float(1 ,nsl ,f6, rbfb6(6,1), 9)
393 CALL sum_6_float(1 ,nsl ,f7, rbfb6(7,1), 9)
394 CALL sum_6_float(1 ,nsl ,f8, rbfb6(8,1), 9)
395 CALL sum_6_float(1 ,nsl ,f9, rbfb6(9,1), 9)
396
397
398 IF(nspmd>1) THEN
399 CALL spmd_exch_fr6(icomm,rbfb6,9*6)
400 ENDIF
401
402 rby(1) = rby(1) + rbfb6(1,1)+rbfb6(1,2)+rbfb6(1,3)+
403 + rbfb6(1,4)+rbfb6(1,5)+rbfb6(1,6)
404 rby(2) = rby(2) + rbfb6(2,1)+rbfb6(2,2)+rbfb6(2,3)+
405 + rbfb6(2,4)+rbfb6(2,5)+rbfb6(2,6)
406 rby(3) = rby(3) + rbfb6(3,1)+rbfb6(3,2)+rbfb6(3,3)+
407 + rbfb6(3,4)+rbfb6(3,5)+rbfb6(3,6)
408 rby(4) = rby(4) + rbfb6(4,1)+rbfb6(4,2)+rbfb6(4,3)+
409 + rbfb6(4,4)+rbfb6(4,5)+rbfb6(4,6)
410 rby(5) = rby(5) + rbfb6(5,1)+rbfb6(5,2)+rbfb6(5,3)+
411 + rbfb6(5,4)+rbfb6(5,5)+rbfb6(5,6)
412 rby(6) = rby(6) + rbfb6(6,1)+rbfb6(6,2)+rbfb6(6,3)+
413 + rbfb6(6,4)+rbfb6(6,5)+rbfb6(6,6)
414 rby(7) = rby(7) + rbfb6(7,1)+rbfb6(7,2)+rbfb6(7,3)+
415 + rbfb6(7,4)+rbfb6(7,5)+rbfb6(7,6)
416 rby(8) = rby(8) + rbfb6(8,1)+rbfb6(8,2)+rbfb6(8,3)+
417 + rbfb6(8,4)+rbfb6(8,5)+rbfb6(8,6)
418 rby(9) = rby(9) + rbfb6(9,1)+rbfb6(9,2)+rbfb6(9,3)+
419 + rbfb6(9,4)+rbfb6(9,5)+rbfb6(9,6)
420C----------------------------------------------
421C MISE A ZERO DES MASSES ET INERTIES SECNDS voir up
422C----------------------------------------------
423 IF (ispmd+1==pmain) THEN
424 WRITE(iout,1000)
425 WRITE(iout,1100) nonod,x(1,m),x(2,m),x(3,m),
426 . masrb,rby(1),rby(5),rby(9),rby(2),rby(3),rby(6)
427 ENDIF
428C----------------------------------------------------------------
429C CALCUL DU REPERE D'INERTIE PRINCIPALE
430C----------------------------------------------------------------
431 IF(n2d == 1) THEN
432 rby(10) = rby(1)
433 rby(11) = rby(5)
434 rby(12) = rby(9)
435 rby(1) = one
436 rby(5) = one
437 rby(9) = one
438 ELSE
439 CALL inepri(rby(10),rby)
440 ENDIF
441 IF(isph==1)THEN
442 xiin = (rby(10) + rby(11) + rby(12)) * third
443 rby(10) = xiin
444 rby(11) = xiin
445 rby(12) = xiin
446 ELSEIF(isph==2) THEN
447 inmin = min(rby(10),rby(11),rby(12))
448 inmax = max(rby(10),rby(11),rby(12))
449 IF(inmin<=1.e-3*inmax)THEN
450 IF(rby(10)/inmax<em03) THEN
451 rby(10)=rby(10)+em01*inmax
452 ENDIF
453 IF (rby(11)/inmax<em03) THEN
454 rby(11)=rby(11)+em01*inmax
455 ENDIF
456 IF (rby(12)/inmax<em03) THEN
457 rby(12)=rby(12)+em01*inmax
458 ENDIF
459 CALL ancmsg(msgid=281,
460 . anmode=aninfo,
461 . i1=id)
462 ENDIF
463 ENDIF
464C
465 rby(13)=in(m)
466 rby(14)=masrb
467 rby(15)=ms(m)
468 ms(m) = masrb
469 in(m) = min(rby(10),rby(11),rby(12))
470C
471 RETURN
472C
4731000 FORMAT(
474 . 44h1 rigid body initialization /
475 . 44h ------------------------- /)
4761100 FORMAT(/5x,'RIGID BODY ',
477 . /10x,'PRIMARY NODE ',i8
478 . /10x,'NEW X,Y,Z ',3g10.3
479 . /10x,'NEW MASS ',1g10.3
480 . /10x,'NEW INERTIA ',6g10.3)
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
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:64
spmd_exch_fr6
subroutine spmd_exch_fr6(fr, fs6, len)
Definition spmd_exch_fr6.F:51
inepri
subroutine inepri(xi, bm)
Definition inepri.F:34
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