OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inirby.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!|| inirby ../starter/source/constraints/general/rbody/inirby.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| chbas ../starter/source/constraints/general/rbody/chbas.F
30!|| inepri ../starter/source/materials/mat/mat019/inepri.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.F
33!|| r2r_mod ../starter/share/modules1/r2r_mod.F
34!||====================================================================
35 SUBROUTINE inirby(NRB ,RBY ,M ,LPBY ,
36 . MS ,IN ,X ,ITAB ,SKEW ,
37 . B1 ,B2 ,B3 ,B5 ,B6 ,
38 . B9 ,ISPH ,TOTMAS,XGT ,YGT ,
39 . ZGT ,STIFN ,STIFR ,NPBY ,RBYID ,
40 . V ,VR ,ID ,TITR ,ITAGND,
41 . RBY_INIAXIS)
42 USE message_mod
43C=======================================================================
44C RBY EN SORTIE DE INIRBY
45C 1 -> 9 : MATRICE ROTATION
46C 10 -> 12: INERTIES PRINCIPALES RBODY
47C 13: INERTIE MAIN INITIALE SPHERIQUE
48C 14: MASSE RBODY
49C 15: MASSE MAIN INITIALE
50C 16 -> 20: LIBRE
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE r2r_mod
55 USE names_and_titles_mod , ONLY : nchartitle
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C A n a l y s e M o d u l e
62C-----------------------------------------------
63#include "param_c.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "units_c.inc"
68#include "com04_c.inc"
69#include "r2r_c.inc"
70#include "com01_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER NPBY(NNPBY,*), M, ISPH, NRB
75 INTEGER ITAB(*), RBYID,ITAGND(*)
76 INTEGER, TARGET :: LPBY(*)
77 my_real
78 . RBY(NRBY,*), MS(*), IN(*), X(3,*), SKEW(LSKEW,*),
79 . B1, B2, B3, B5, B6, B9,TOTMAS ,XGT ,YGT ,
80 . zgt, stifn(*), stifr(*), v(3,*), vr(3,*),
81 . ii1,ii2,ii3,ii4,ii5,ii6,ii7,ii8,ii9,
82 . rby_r2r(9),rby_iniaxis(7,*)
83 INTEGER ID
84 CHARACTER(LEN=NCHARTITLE) :: TITR
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER NSL, J, NOSKEW, I, N, NONOD,ICDG, FLAG,NSL_XTRA
89 my_real
90 . xg(3), xm0(3), xmg, xx, xy, xz, yy, yz, zz, xiin, inmin,
91 . masrb,dd,tol,
92 . v1x2, v2x1, v2x3, v3x2, v3x1, v1x3,
93 . inmax,x_msn0(3),dist
94 INTEGER M_I, OPT_MERGE, RBLEVEL
95 INTEGER, DIMENSION(:), POINTER :: LSN, LSN_XTRA
96 my_real, DIMENSION(:), ALLOCATABLE :: MS_LOC,IN_LOC
97C
98 TOL=one+em04
99C
100 nsl = npby(2,nrb) ! Nombre total de noeuds SECONDARY
101 lsn => lpby(npby(11,nrb)+1:npby(11,nrb)+nsl) ! Liste des noeuds SECONDARY
102 rblevel = npby(12,nrb)
103 ALLOCATE (ms_loc(nsl))
104 ALLOCATE (in_loc(nsl))
105C
106C------------------------------------------------------------------------------------------------------
107 flag = 0
108 DO i=1,nsl
109 n=lsn(i)
110 ms_loc(i)=ms(n)
111 in_loc(i)=in(n)
112 ENDDO
113C-----------Multidomaines : on ne compte l'ajout de masse et d'inertie uniquement d'1 cote-------------
114 IF ((nsubdom>0).AND.(ipid==0)) THEN
115 IF (tagno(m+n_part)==3) THEN
116 flag = 1
117 DO j=1,9
118 rby(j,nrb) = zero
119 END DO
120C-----------Multidomaines : on evite de compter 2 fois la masse et l'inertie des noeuds communs--------
121 DO i=1,nsl
122 n=lsn(i)
123 IF (tagno(n+n_part)>3) ms_loc(i)= 0
124 IF (tagno(n+n_part)>3) in_loc(i)= 0
125 IF (tagno(n+n_part)==0) ms_loc(i)= 0
126 IF (tagno(n+n_part)==0) in_loc(i)= 0
127 ENDDO
128 ENDIF
129 ENDIF
130C------------------------------------------------------------------------------------------------------
131 IF (ns10e>0) THEN
132 DO i=1,nsl
133 n=lsn(i)
134 IF (itagnd(n)/=0) THEN
135 ms_loc(i)= zero
136 in_loc(i)= zero
137 END IF
138 ENDDO
139 END IF
140C
141 nsl_xtra = npby(14,nrb)+npby(15,nrb)+npby(16,nrb)
142 nsl = npby(2,nrb) - nsl_xtra
143 lsn => lpby(npby(11,nrb)+1:npby(11,nrb)+nsl) ! Liste des noeuds SECONDARY
144C------------------------------------------------------------------------------------------------------
145
146 ms(m)=ms(m)+rby(1,nrb)
147 IF(ms(m)==zero) ms(m)=em20
148
149C NUMERO EXTERNE DU NOEUD (DEPLACEE PAR JBM LE 30/9/96)
150 nonod=itab(m)
151C
152 icdg = npby(3,nrb)
153 noskew=npby(9,nrb)
154 rby(1,nrb)=rby(2,nrb)
155 rby(9,nrb)=rby(4,nrb)
156 rby(8,nrb)=rby(6,nrb)
157 rby(2,nrb)=rby(5,nrb)
158 rby(4,nrb)=rby(5,nrb)
159 rby(5,nrb)=rby(3,nrb)
160 rby(3,nrb)=rby(7,nrb)
161C CAS DU REPERE SKEW POUR LE RB
162 IF(noskew/=0) THEN
163 CALL chbas(skew(1,noskew),rby(1,nrb))
164 ENDIF
165C
166 rby(1,nrb)=rby(1,nrb)+in(m)
167 rby(5,nrb)=rby(5,nrb)+in(m)
168 rby(9,nrb)=rby(9,nrb)+in(m)
169 in(m) = (rby(1,nrb) + rby(5,nrb) + rby(9,nrb)) * third
170C
171C---------------------------------
172C CORRECTION DE LA MASSE ET DU
173C CENTRE DE GRAVITE DU MAIN
174C---------------------------------
175C
176 xmg=ms(m)
177C
178C-----INITIAL COORDINATES ARE STORED FOR INIVEL/AXIS correction
179 IF (rby_iniaxis(1,nrb) > 0) THEN
180 DO j=1,3
181 x_msn0(j)=x(j,m)
182 ENDDO
183 ENDIF
184
185C-----CDG DES NOEUDS SECONDS + MAIN
186 IF(icdg==1)THEN
187 masrb=ms(m)
188 DO j=1,3
189 xg(j)=x(j,m)
190 x(j,m)=x(j,m)*ms(m)
191 ENDDO
192 DO i=1,nsl
193 n=lsn(i)
194 DO j=1,3
195 x(j,m) = x(j,m)+x(j,n)*ms_loc(i)
196 ENDDO
197 masrb = masrb+ms_loc(i)
198 ENDDO
199C
200 IF(masrb<=1.e-30) THEN
201 CALL ancmsg(msgid=679,
202 . msgtype=msgerror,
203 . anmode=aninfo_blind_1,
204 . i1=id,
205 . c1=titr)
206 RETURN
207 ENDIF
208C
209 DO j=1,3
210 x(j,m)=x(j,m)/masrb
211 ENDDO
212C
213C-----CDG DES NOEUDS SECONDS
214 ELSEIF(icdg==2)THEN
215 masrb=zero
216 DO j=1,3
217 x(j,m)=zero
218 ENDDO
219 DO i=1,nsl
220 n=lsn(i)
221 DO j=1,3
222 x(j,m) = x(j,m)+x(j,n)*ms_loc(i)
223 ENDDO
224 masrb = masrb+ms_loc(i)
225 ENDDO
226 IF (flag==1) masrb = max(masrb,em20)
227C
228 IF(masrb<=em30) THEN
229 CALL ancmsg(msgid=679,
230 . msgtype=msgerror,
231 . anmode=aninfo_blind_1,
232 . i1=id,
233 . c1=titr,
234 . c2='ON SECONDARY NODES')
235 RETURN
236 ENDIF
237C
238 DO j=1,3
239 x(j,m)=x(j,m)/masrb
240 xg(j)=x(j,m)
241 ENDDO
242C
243 masrb=masrb+ms(m)
244C
245C-----CDG DU NOEUD MAIN
246 ELSEIF(icdg==3)THEN
247 DO j=1,3
248 xg(j)=x(j,m)
249 ENDDO
250 masrb=ms(m)
251 DO i=1,nsl
252 n=lsn(i)
253 masrb = masrb+ms_loc(i)
254 ENDDO
255C
256 IF(masrb<=em30) THEN
257 CALL ancmsg(msgid=679,
258 . msgtype=msgerror,
259 . anmode=aninfo_blind_1,
260 . i1=id,
261 . c1=titr)
262 RETURN
263 ENDIF
264C
265C-----CDG DU NOEUD MAIN (MASSE DES SECONDS IGNOREE)
266 ELSEIF(icdg==4)THEN
267 DO j=1,3
268 xg(j)=x(j,m)
269 ENDDO
270 masrb=ms(m)
271C
272 IF(masrb<=em30) THEN
273 CALL ancmsg(msgid=679,
274 . msgtype=msgerror,
275 . anmode=aninfo_blind_1,
276 . i1=id,
277 . c1=titr,
278 . c2='ON MAIN NODE')
279 RETURN
280 ENDIF
281C
282 ENDIF
283
284C--------------------------------------
285C ASSEMBLAGE DES XTRA NODES DANS LA MASSE ET COG
286C--------------------------------------
287 IF(npby(15,nrb) > 0) THEN ! MASS/INERTIA ADD, COG ACTUALIZED
288 lsn_xtra => lpby(npby(11,nrb)+nsl+npby(14,nrb)+1:
289 . npby(11,nrb)+nsl+npby(14,nrb)+npby(15,nrb))
290 DO j=1,3
291 xg(j)=x(j,m)
292 x(j,m)=x(j,m)*masrb
293 ENDDO
294 xmg=masrb
295C
296 DO i=1,npby(15,nrb)
297 n=lsn_xtra(i)
298 DO j=1,3
299 x(j,m) = x(j,m)+x(j,n)*ms_loc(nsl+i)
300 ENDDO
301 masrb = masrb+ms_loc(nsl+i)
302 ENDDO
303C
304 DO j=1,3
305 x(j,m)=x(j,m)/masrb
306 xg(j)=x(j,m)
307 ENDDO
308 ENDIF
309C
310 IF(npby(16,nrb) > 0) THEN ! MASS/INERTIA ADD, COG NOT ACTUALIZED
311 lsn_xtra => lpby(npby(11,nrb)+nsl+npby(14,nrb)+npby(15,nrb)+1:
312 . npby(11,nrb)+nsl+npby(14,nrb)+npby(15,nrb)+npby(16,nrb))
313 DO i=1,npby(16,nrb)
314 n=lsn_xtra(i)
315 masrb = masrb+ms_loc(nsl+i)
316 ENDDO
317 ENDIF
318C
319C--------------------------------------
320C CORRECTION DE L'INERTIE DU MAIN
321C--------------------------------------
322 IF(icdg<=3)THEN
323 IF(n2d==0)THEN
324C ANALYSE 3D
325 xx=(xg(1)-x(1,m))*(xg(1)-x(1,m))
326 xy=(xg(1)-x(1,m))*(xg(2)-x(2,m))
327 xz=(xg(1)-x(1,m))*(xg(3)-x(3,m))
328 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
329 yz=(xg(2)-x(2,m))*(xg(3)-x(3,m))
330 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
331 rby(1,nrb)=rby(1,nrb)+(yy+zz)*xmg
332 rby(2,nrb)=rby(2,nrb)-xy*xmg
333 rby(3,nrb)=rby(3,nrb)-xz*xmg
334 rby(4,nrb)=rby(4,nrb)-xy*xmg
335 rby(5,nrb)=rby(5,nrb)+(zz+xx)*xmg
336 rby(6,nrb)=rby(6,nrb)-yz*xmg
337 rby(7,nrb)=rby(7,nrb)-xz*xmg
338 rby(8,nrb)=rby(8,nrb)-yz*xmg
339 rby(9,nrb)=rby(9,nrb)+(xx+yy)*xmg
340
341 IF (nsl==1) THEN
342 rby(1,nrb)=rby(1,nrb)+em20
343 rby(5,nrb)=rby(5,nrb)+em20
344 rby(9,nrb)=rby(9,nrb)+em20
345 ENDIF
346C
347 DO i=1,nsl
348 n=lsn(i)
349 xx=(x(1,n)-x(1,m))*(x(1,n)-x(1,m))
350 xy=(x(1,n)-x(1,m))*(x(2,n)-x(2,m))
351 xz=(x(1,n)-x(1,m))*(x(3,n)-x(3,m))
352 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
353 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
354 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
355 rby(1,nrb)=rby(1,nrb)+in_loc(i)+(yy+zz)*ms_loc(i)
356 rby(2,nrb)=rby(2,nrb)-xy*ms_loc(i)
357 rby(3,nrb)=rby(3,nrb)-xz*ms_loc(i)
358 rby(4,nrb)=rby(4,nrb)-xy*ms_loc(i)
359 rby(5,nrb)=rby(5,nrb)+in_loc(i)+(zz+xx)*ms_loc(i)
360 rby(6,nrb)=rby(6,nrb)-yz*ms_loc(i)
361 rby(7,nrb)=rby(7,nrb)-xz*ms_loc(i)
362 rby(8,nrb)=rby(8,nrb)-yz*ms_loc(i)
363 rby(9,nrb)=rby(9,nrb)+in_loc(i)+(xx+yy)*ms_loc(i)
364 ENDDO
365
366 ELSEIF(n2d==1) THEN
367C ANALYSE 2D : Axisymmetry
368C I= A 0 0
369C 0 A 0
370C 0 0 B
371 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
372 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
373 rby(1,nrb)=rby(1,nrb)+(yy+zz)*xmg
374 rby(2,nrb)=zero
375 rby(3,nrb)=zero
376C
377 rby(4,nrb)=zero
378 rby(5,nrb)=rby(5,nrb)+zz*xmg
379 rby(6,nrb)=zero
380C
381 rby(7,nrb)=zero
382 rby(8,nrb)=zero
383 rby(9,nrb)=rby(9,nrb)+yy*xmg
384
385 IF (nsl==1) THEN
386 rby(1,nrb)=rby(1,nrb)+em20
387 rby(5,nrb)=rby(5,nrb)+em20
388 rby(9,nrb)=rby(9,nrb)+em20
389 ENDIF
390C
391 DO i=1,nsl
392 n=lsn(i)
393 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
394 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
395 rby(1,nrb)=rby(1,nrb)+in_loc(i)+(yy+zz)*ms_loc(i)
396 rby(5,nrb)=rby(5,nrb)+in_loc(i)+zz*ms_loc(i)
397 rby(9,nrb)=rby(9,nrb)+in_loc(i)+yy*ms_loc(i)
398 ENDDO
399 ELSEIF(n2d==2) THEN
400C ANALYSE 2D : Plane strain Inertia matrix
401C I= A 0 0
402C 0 B D
403C 0 D C
404 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
405 yz=(xg(2)-x(2,m))*(xg(3)-x(3,m))
406 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
407 rby(1,nrb)=rby(1,nrb)+(yy+zz)*xmg
408 rby(2,nrb)=zero
409 rby(3,nrb)=zero
410c
411 rby(4,nrb)=zero
412 rby(5,nrb)=rby(5,nrb)+zz*xmg
413 rby(6,nrb)=rby(6,nrb)-yz*xmg
414c
415 rby(7,nrb)=zero
416 rby(8,nrb)=rby(8,nrb)-yz*xmg
417 rby(9,nrb)=rby(9,nrb)+yy*xmg
418
419 IF (nsl==1) THEN
420 rby(1,nrb)=rby(1,nrb)+em20
421 rby(5,nrb)=rby(5,nrb)+em20
422 rby(9,nrb)=rby(9,nrb)+em20
423 ENDIF
424C
425 DO i=1,nsl
426 n=lsn(i)
427 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
428 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
429 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
430 rby(1,nrb)=rby(1,nrb)+in_loc(i)+(yy+zz)*ms_loc(i)
431c
432 rby(5,nrb)=rby(5,nrb)+in_loc(i)+zz*ms_loc(i)
433 rby(6,nrb)=rby(6,nrb)-yz*ms_loc(i)
434c
435 rby(8,nrb)=rby(8,nrb)-yz*ms_loc(i)
436 rby(9,nrb)=rby(9,nrb)+in_loc(i)+yy*ms_loc(i)
437 ENDDO
438 ENDIF !N2D
439 ENDIF
440c
441C--------------------------------------
442C AJOUT DE L'INERTIE DES XTRA NODES
443C--------------------------------------
444 IF((npby(15,nrb)+npby(16,nrb)) > 0) THEN
445
446 lsn_xtra => lpby(npby(11,nrb)+nsl+npby(14,nrb)+1:
447 . npby(11,nrb)+nsl+npby(14,nrb)+npby(15,nrb)+npby(16,nrb))
448
449 IF(n2d==0)THEN
450 DO i=1,npby(15,nrb)+npby(16,nrb)
451 n=lsn_xtra(i)
452 xx=(x(1,n)-x(1,m))*(x(1,n)-x(1,m))
453 xy=(x(1,n)-x(1,m))*(x(2,n)-x(2,m))
454 xz=(x(1,n)-x(1,m))*(x(3,n)-x(3,m))
455 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
456 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
457 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
458 rby(1,nrb)=rby(1,nrb)+in_loc(nsl+i)+(yy+zz)*ms_loc(nsl+i)
459 rby(2,nrb)=rby(2,nrb)-xy*ms_loc(nsl+i)
460 rby(3,nrb)=rby(3,nrb)-xz*ms_loc(nsl+i)
461 rby(4,nrb)=rby(4,nrb)-xy*ms_loc(nsl+i)
462 rby(5,nrb)=rby(5,nrb)+in_loc(nsl+i)+(zz+xx)*ms_loc(nsl+i)
463 rby(6,nrb)=rby(6,nrb)-yz*ms_loc(nsl+i)
464 rby(7,nrb)=rby(7,nrb)-xz*ms_loc(nsl+i)
465 rby(8,nrb)=rby(8,nrb)-yz*ms_loc(nsl+i)
466 rby(9,nrb)=rby(9,nrb)+in_loc(nsl+i)+(xx+yy)*ms_loc(nsl+i)
467 ENDDO
468 ELSEIF(n2d==1) THEN
469 DO i=1,npby(15,nrb)+npby(16,nrb)
470 n=lsn_xtra(i)
471 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
472 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
473 rby(1,nrb)=rby(1,nrb)+in_loc(nsl+i)+(yy+zz)*ms_loc(nsl+i)
474 rby(5,nrb)=rby(5,nrb)+in_loc(nsl+i)+zz*ms_loc(nsl+i)
475 rby(9,nrb)=rby(9,nrb)+in_loc(nsl+i)+yy*ms_loc(nsl+i)
476 ENDDO
477 ELSEIF(n2d==1) THEN
478 DO i=1,npby(15,nrb)+npby(16,nrb)
479 n=lsn_xtra(i)
480 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
481 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
482 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
483 rby(1,nrb)=rby(1,nrb)+in_loc(nsl+i)+(yy+zz)*ms_loc(nsl+i)
484 rby(5,nrb)=rby(5,nrb)+in_loc(nsl+i)+zz*ms_loc(nsl+i)
485 rby(6,nrb)=rby(6,nrb)-yz*ms_loc(nsl+i)
486 rby(8,nrb)=rby(8,nrb)-yz*ms_loc(nsl+i)
487 rby(9,nrb)=rby(9,nrb)+in_loc(nsl+i)+yy*ms_loc(nsl+i)
488 ENDDO
489 ENDIF !N2D
490 ENDIF
491C
492C--------------------------------------
493C ASSEMBLAGE DES MASSES DES RIGID BODY SECONDARYS ET MAJ POSITION DU COG
494C--------------------------------------
495 DO i=nrb-1,1,-1
496 IF((npby(12,i)) == rblevel-1) THEN ! Merge with Rb level n-1
497 DO j=1,3
498 xg(j)=x(j,m) ! centre de gravite du rb main avant modif
499 ENDDO
500 xmg=masrb ! masse du RB main avant modif
501c
502 opt_merge = npby(13,i)
503 npby(11,nrb) = npby(11,i)
504 npby(2,nrb) = npby(2,nrb)+npby(2,i)
505 m_i=npby(1,i)
506c
507 IF(opt_merge == 2) THEN ! MASSE ET INERTIE AJOUTEE, COG ACTUALISE
508 DO j=1,3
509 x(j,m)=x(j,m)*masrb+x(j,m_i)*rby(14,i)
510 ENDDO
511 masrb = masrb + rby(14,i)
512 DO j=1,3
513 x(j,m)=x(j,m)/masrb
514 ENDDO
515 ELSEIF(opt_merge == 3) THEN ! MASSE ET INERTIE AJOUTEE, COG NON ACTUALISE
516 masrb = masrb + rby(14,i)
517 ENDIF
518c
519C--------------------------------------
520C TRANSFERT DES INERTIES AU COG
521C--------------------------------------
522 IF(opt_merge == 2) THEN
523 IF(n2d==0)THEN
524 xx=(xg(1)-x(1,m))*(xg(1)-x(1,m))
525 xy=(xg(1)-x(1,m))*(xg(2)-x(2,m))
526 xz=(xg(1)-x(1,m))*(xg(3)-x(3,m))
527 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
528 yz=(xg(2)-x(2,m))*(xg(3)-x(3,m))
529 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
530 rby(1,nrb)=rby(1,nrb)+(yy+zz)*xmg
531 rby(2,nrb)=rby(2,nrb)-xy*xmg
532 rby(3,nrb)=rby(3,nrb)-xz*xmg
533 rby(4,nrb)=rby(4,nrb)-xy*xmg
534 rby(5,nrb)=rby(5,nrb)+(zz+xx)*xmg
535 rby(6,nrb)=rby(6,nrb)-yz*xmg
536 rby(7,nrb)=rby(7,nrb)-xz*xmg
537 rby(8,nrb)=rby(8,nrb)-yz*xmg
538 rby(9,nrb)=rby(9,nrb)+(xx+yy)*xmg
539 ELSEIF(n2d==1) THEN
540 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
541 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
542 rby(1,nrb)=rby(1,nrb)+(yy+zz)*xmg
543 rby(2,nrb)=zero
544 rby(3,nrb)=zero
545 rby(4,nrb)=zero
546 rby(5,nrb)=rby(5,nrb)+zz*xmg
547 rby(6,nrb)=zero
548 rby(7,nrb)=zero
549 rby(8,nrb)=zero
550 rby(9,nrb)=rby(9,nrb)+yy*xmg
551 ELSEIF(n2d==2) THEN
552 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
553 yz=(xg(2)-x(2,m))*(xg(3)-x(3,m))
554 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
555 rby(1,nrb)=rby(1,nrb)+(yy+zz)*xmg
556 rby(2,nrb)=zero
557 rby(3,nrb)=zero
558 rby(4,nrb)=zero
559 rby(5,nrb)=rby(5,nrb)+zz*xmg
560 rby(6,nrb)=rby(6,nrb)-yz*xmg
561 rby(7,nrb)=zero
562 rby(8,nrb)=rby(8,nrb)-yz*xmg
563 rby(9,nrb)=rby(9,nrb)+yy*xmg
564 ENDIF
565 ENDIF
566 IF(opt_merge > 1) THEN
567 IF(n2d==0)THEN
568 xx=(x(1,m_i)-x(1,m))*(x(1,m_i)-x(1,m))
569 xy=(x(1,m_i)-x(1,m))*(x(2,m_i)-x(2,m))
570 xz=(x(1,m_i)-x(1,m))*(x(3,m_i)-x(3,m))
571 yy=(x(2,m_i)-x(2,m))*(x(2,m_i)-x(2,m))
572 yz=(x(2,m_i)-x(2,m))*(x(3,m_i)-x(3,m))
573 zz=(x(3,m_i)-x(3,m))*(x(3,m_i)-x(3,m))
574 rby(1,nrb)=rby(1,nrb)+rby(1,i)+(yy+zz)*rby(14,i)
575 rby(2,nrb)=rby(2,nrb)+rby(2,i)-xy*rby(14,i)
576 rby(3,nrb)=rby(3,nrb)+rby(3,i)-xz*rby(14,i)
577 rby(4,nrb)=rby(4,nrb)+rby(4,i)-xy*rby(14,i)
578 rby(5,nrb)=rby(5,nrb)+rby(5,i)+(zz+xx)*rby(14,i)
579 rby(6,nrb)=rby(6,nrb)+rby(6,i)-yz*rby(14,i)
580 rby(7,nrb)=rby(7,nrb)+rby(7,i)-xz*rby(14,i)
581 rby(8,nrb)=rby(8,nrb)+rby(8,i)-yz*rby(14,i)
582 rby(9,nrb)=rby(9,nrb)+rby(9,i)+(xx+yy)*rby(14,i)
583 ELSEIF(n2d==1) THEN
584 yy=(x(2,m_i)-x(2,m))*(x(2,m_i)-x(2,m))
585 zz=(x(3,m_i)-x(3,m))*(x(3,m_i)-x(3,m))
586 rby(1,nrb)=rby(1,nrb)+rby(1,i)+(yy+zz)*rby(14,i)
587 rby(5,nrb)=rby(5,nrb)+rby(5,i)+zz*rby(14,i)
588 rby(9,nrb)=rby(9,nrb)+rby(9,i)+yy*rby(14,i)
589 ELSEIF(n2d==2) THEN
590 yy=(x(2,m_i)-x(2,m))*(x(2,m_i)-x(2,m))
591 yz=(x(2,m_i)-x(2,m))*(x(3,m_i)-x(3,m))
592 zz=(x(3,m_i)-x(3,m))*(x(3,m_i)-x(3,m))
593 rby(1,nrb)=rby(1,nrb)+rby(1,i)+(yy+zz)*rby(14,i)
594 rby(5,nrb)=rby(5,nrb)+rby(5,i)+zz*rby(14,i)
595 rby(6,nrb)=rby(6,nrb)-yz*rby(14,i)
596 rby(8,nrb)=rby(8,nrb)-yz*rby(14,i)
597 rby(9,nrb)=rby(9,nrb)+rby(9,i)+yy*rby(14,i)
598 ENDIF !N2D
599 ENDIF
600c mise a zero des donnees rb SECONDARY
601 rby(1:15,i)=zero
602 in(m_i)=zero
603 ms(m_i)=zero
604 ELSEIF(npby(12,i) == rblevel) THEN ! End of the RB branch
605 EXIT
606 ENDIF
607 ENDDO
608c
609C----------------------------------------------
610C NSL est complete par les noeuds SECONDARY des rigid body SECONDARYs
611C LSN est actualisee
612C----------------------------------------------
613 IF(rblevel == 0) THEN ! IF THIS RIGID BODY IS THE TOP MAIN
614 IF(nrbmerge > 0) THEN
615 DEALLOCATE(ms_loc)
616 DEALLOCATE(in_loc)
617 nsl = npby(2,nrb) ! Liste totale des noeuds SECONDARY
618 lsn => lpby(npby(11,nrb)+1:npby(11,nrb)+nsl)
619 ALLOCATE (ms_loc(nsl))
620 ALLOCATE (in_loc(nsl))
621C
622C-----------Multidomaines : on ne compte l'ajout de masse et d'inertie uniquement d'1 cote-------------
623 IF ((nsubdom>0).AND.(ipid==0)) THEN
624 IF (tagno(m+n_part)==3) THEN
625C-----------Multidomaines : on evite de compter 2 fois la masse et l'inertie des noeuds communs--------
626 DO i=1,nsl
627 n=lsn(i)
628 IF (tagno(n+n_part)>3) ms_loc(i)= 0
629 IF (tagno(n+n_part)>3) in_loc(i)= 0
630 IF (tagno(n+n_part)==0) ms_loc(i)= 0
631 IF (tagno(n+n_part)==0) in_loc(i)= 0
632 ENDDO
633 ENDIF
634 ENDIF
635C
636 IF (ns10e>0) THEN
637 DO i=1,nsl
638 n=lsn(i)
639 IF (itagnd(n)/=0) THEN
640 ms_loc(i)= zero
641 in_loc(i)= zero
642 ELSE
643 ms_loc(i)=ms(n)
644 in_loc(i)=in(n)
645 ENDIF
646 ENDDO
647 ELSE
648 DO i=1,nsl
649 n=lsn(i)
650 ms_loc(i)=ms(n)
651 in_loc(i)=in(n)
652 ENDDO
653 ENDIF
654 ENDIF
655C
656C-----------Multidomaines : on stoke la matrice assembl e--------------
657 IF(nsubdom>0)THEN
658 IF(tagno(m+n_part)==3)THEN
659 DO j=1,9
660 rby_r2r(j)=rby(j,nrb)
661 END DO
662 END IF
663 ENDIF
664
665C----------------------------------------------
666C MISE A ZERO DES MASSES ET INERTIES SECONDARYS
667C----------------------------------------------
668C DO I=1,NSL
669C N=LSN(I)
670C RBYM(I) = MS(N)
671C RBYI(I) = IN(N)
672C IN(N)=0.
673C MS(N)=0.
674C ENDDO
675C
676 WRITE(iout,1000)
677 DO i=1,nsl
678 n=lsn(i)
679 xx=(x(1,n))*(x(1,n))
680 xy=(x(1,n))*(x(2,n))
681 xz=(x(1,n))*(x(3,n))
682 yy=(x(2,n))*(x(2,n))
683 yz=(x(2,n))*(x(3,n))
684 zz=(x(3,n))*(x(3,n))
685 b1 = b1 - in_loc(i)-(yy+zz)*ms_loc(i)
686 b2 = b2 + xy*ms_loc(i)
687 b3 = b3 + xz*ms_loc(i)
688 b5 = b5 - in_loc(i)-(zz+xx)*ms_loc(i)
689 b6 = b6 + yz*ms_loc(i)
690 b9 = b9 - in_loc(i)-(xx+yy)*ms_loc(i)
691 xgt = xgt - ms_loc(i)*x(1,n)
692 ygt = ygt - ms_loc(i)*x(2,n)
693 zgt = zgt - ms_loc(i)*x(3,n)
694 totmas = totmas - ms_loc(i)
695 ENDDO
696 IF(isph/=1)THEN
697 b1 = b1 + rby(1,nrb)
698 b2 = b2 + rby(2,nrb)
699 b3 = b3 + rby(3,nrb)
700 b5 = b5 + rby(5,nrb)
701 b6 = b6 + rby(6,nrb)
702 b9 = b9 + rby(9,nrb)
703 IF(nsubdom>0)THEN
704 IF(tagno(m+n_part)==3) THEN
705 WRITE(iout,1300) rbyid
706 WRITE(iout,1400)
707 ELSE
708 WRITE(iout,1100) rbyid,nonod,x(1,m),x(2,m),x(3,m),
709 . masrb,rby(1,nrb),rby(5,nrb),rby(9,nrb),rby(2,nrb),rby(6,nrb),rby(3,nrb)
710 END IF
711 ELSE
712 WRITE(iout,1100) rbyid,nonod,x(1,m),x(2,m),x(3,m),
713 . masrb,rby(1,nrb),rby(5,nrb),rby(9,nrb),rby(2,nrb),rby(6,nrb),rby(3,nrb)
714 END IF
715 ENDIF
716
717C----------------------------------------------------------------
718C CALCUL DU REPERE D'INERTIE PRINCIPALE
719C----------------------------------------------------------------
720 IF(n2d == 1) THEN
721 rby(10,nrb) = rby(1,nrb)
722 rby(11,nrb) = rby(5,nrb)
723 rby(12,nrb) = rby(9,nrb)
724 rby(1,nrb) = one
725 rby(5,nrb) = one
726 rby(9,nrb) = one
727 ELSE
728 CALL inepri(rby(10,nrb),rby(1,nrb))
729 ENDIF
730C
731 IF(isph==1)THEN
732 xiin = (rby(10,nrb) + rby(11,nrb) + rby(12,nrb)) * third
733 rby(10,nrb) = xiin
734 rby(11,nrb) = xiin
735 rby(12,nrb) = xiin
736 inmin = xiin
737 b1 = b1 + xiin
738 b5 = b5 + xiin
739 b9 = b9 + xiin
740 IF(nsubdom>0)THEN
741 IF(tagno(m+n_part)==3)THEN
742 WRITE(iout,1300) rbyid
743 WRITE(iout,1400)
744 ELSE
745 WRITE(iout,1100) rbyid,nonod,x(1,m),x(2,m),x(3,m),
746 . masrb,xiin,xiin,xiin,zero,zero,zero
747 END IF
748 ELSE
749 WRITE(iout,1100) rbyid,nonod,x(1,m),x(2,m),x(3,m),
750 . masrb,xiin,xiin,xiin,zero,zero,zero
751 ENDIF
752 ELSEIF (isph==2) THEN
753 inmin = min(rby(10,nrb),rby(11,nrb),rby(12,nrb))
754 inmax = max(rby(10,nrb),rby(11,nrb),rby(12,nrb))
755 IF(inmin<=1.e-3*inmax)THEN
756 IF(rby(10,nrb)/inmax<em03) rby(10,nrb)=rby(10,nrb)+em01*inmax
757 IF(rby(11,nrb)/inmax<em03) rby(11,nrb)=rby(11,nrb)+em01*inmax
758 IF(rby(12,nrb)/inmax<em03) rby(12,nrb)=rby(12,nrb)+em01*inmax
759 IF(nsubdom>0)THEN
760 IF(tagno(m+n_part) /= 3) THEN
761 CALL ancmsg(msgid=275,
762 . msgtype=msgwarning,
763 . anmode=aninfo_blind_1,
764 . i1=id,
765 . c1=titr)
766 ENDIF
767 ELSE
768 CALL ancmsg(msgid=275,
769 . msgtype=msgwarning,
770 . anmode=aninfo_blind_1,
771 . i1=id,
772 . c1=titr)
773 ENDIF
774 ENDIF
775 ENDIF
776
777
778 IF(nsubdom>0)THEN
779 IF(tagno(m+n_part)==3)GOTO 350
780 END IF
781
782
783 inmin = min(rby(10,nrb),rby(11,nrb),rby(12,nrb))
784 WRITE(iout,1200) rby(10,nrb),rby(11,nrb),rby(12,nrb)
785 WRITE(iout,1101)
786 WRITE(iout,1102) (itab(lpby(i+npby(11,nrb))),i=1,nsl)
787
788 IF(rby(10,nrb)>=rby(11,nrb).AND.rby(10,nrb)>=rby(12,nrb))THEN
789 IF(rby(10,nrb)>(rby(11,nrb)+rby(12,nrb))*tol)THEN
790 CALL ancmsg(msgid=542,
791 . msgtype=msgwarning,
792 . anmode=aninfo_blind_1,
793 . i1=id,
794 . c1=titr,
795 . r1=rby(10,nrb),
796 . r2=rby(11,nrb),
797 . r3=rby(12,nrb))
798 ENDIF
799 ELSEIF(rby(11,nrb)>=rby(10,nrb).AND.rby(11,nrb)>=rby(12,nrb))THEN
800 IF(rby(11,nrb)>(rby(10,nrb)+rby(12,nrb))*tol)THEN
801 CALL ancmsg(msgid=542,
802 . msgtype=msgwarning,
803 . anmode=aninfo_blind_1,
804 . i1=id,
805 . c1=titr,
806 . r1=rby(11,nrb),
807 . r2=rby(10,nrb),
808 . r3=rby(12,nrb))
809 ENDIF
810 ELSEIF(rby(12,nrb)>=rby(10,nrb).AND.rby(12,nrb)>=rby(11,nrb))THEN
811 IF(rby(12,nrb)>(rby(10,nrb)+rby(11,nrb))*tol)THEN
812 CALL ancmsg(msgid=542,
813 . msgtype=msgwarning,
814 . anmode=aninfo_blind_1,
815 . i1=id,
816 . c1=titr,
817 . r1=rby(12,nrb),
818 . r2=rby(10,nrb),
819 . r3=rby(11,nrb))
820 ENDIF
821 ENDIF
822
823 IF(inmin<=0.0)THEN
824 CALL ancmsg(msgid=274,
825 . msgtype=msgerror,
826 . anmode=aninfo_blind_1,
827 . i1=id,
828 . c1=titr)
829 ENDIF
830 ENDIF ! (RBLEVEL == 0)
831C
832350 CONTINUE
833C
834 rby(13,nrb)=in(m)
835 rby(14,nrb)=masrb
836 rby(15,nrb)=ms(m)
837 ms(m) = masrb
838 in(m) = min(rby(10,nrb),rby(11,nrb),rby(12,nrb))
839C
840 DEALLOCATE(ms_loc)
841 DEALLOCATE(in_loc)
842c
843C----------------------------------------------------------------
844C TRAITEMENT DU RIGID BODY QUI N'A PAS DE MAIN
845C----------------------------------------------------------------
846c
847 IF(rblevel == 0) THEN ! IF THIS RIGID BODY IS THE TOP MAIN
848C
849 IF(n2d == 0) THEN
850 xx=(x(1,m))*(x(1,m))
851 xy=(x(1,m))*(x(2,m))
852 xz=(x(1,m))*(x(3,m))
853 yy=(x(2,m))*(x(2,m))
854 yz=(x(2,m))*(x(3,m))
855 zz=(x(3,m))*(x(3,m))
856 b1 = b1 - in(m)
857 b5 = b5 - in(m)
858 b9 = b9 - in(m)
859 totmas = totmas - ms(m) + masrb
860 xgt = xgt - ms(m)*x(1,m) + masrb*x(1,m)
861 ygt = ygt - ms(m)*x(2,m) + masrb*x(2,m)
862 zgt = zgt - ms(m)*x(3,m) + masrb*x(3,m)
863C
864C Rigidite au noeud main pour estimation DT.
865 IF (ns10e>0) THEN
866 DO i=1,nsl
867 n = lsn(i)
868 IF (itagnd(n)/=0) cycle
869 stifn(m)= stifn(m)+stifn(n)
870 dd = (x(1,n)-x(1,m))**2+(x(2,n)-x(2,m))**2+(x(3,n)-x(3,m))**2
871 stifr(m)= stifr(m)+(stifr(n)+dd*stifn(n))
872 stifr(n)= em20
873 stifn(n)= em20
874 END DO
875 ELSE
876 DO i=1,nsl
877 n = lsn(i)
878 stifn(m)= stifn(m)+stifn(n)
879 dd = (x(1,n)-x(1,m))**2+(x(2,n)-x(2,m))**2+(x(3,n)-x(3,m))**2
880 stifr(m)= stifr(m)+(stifr(n)+dd*stifn(n))
881 stifr(n)= em20
882 stifn(n)= em20
883 END DO
884 END IF !(NS10E>0) THEN
885
886C MATRICE d'inertie -> repere global
887 ii1=rby(10,nrb)*rby(1,nrb)
888 ii2=rby(10,nrb)*rby(2,nrb)
889 ii3=rby(10,nrb)*rby(3,nrb)
890 ii4=rby(11,nrb)*rby(4,nrb)
891 ii5=rby(11,nrb)*rby(5,nrb)
892 ii6=rby(11,nrb)*rby(6,nrb)
893 ii7=rby(12,nrb)*rby(7,nrb)
894 ii8=rby(12,nrb)*rby(8,nrb)
895 ii9=rby(12,nrb)*rby(9,nrb)
896C
897 rby(17,nrb)=rby(1,nrb)*ii1 + rby(4,nrb)*ii4 + rby(7,nrb)*ii7
898 rby(18,nrb)=rby(1,nrb)*ii2 + rby(4,nrb)*ii5 + rby(7,nrb)*ii8
899 rby(19,nrb)=rby(1,nrb)*ii3 + rby(4,nrb)*ii6 + rby(7,nrb)*ii9
900 rby(20,nrb)=rby(2,nrb)*ii1 + rby(5,nrb)*ii4 + rby(8,nrb)*ii7
901 rby(21,nrb)=rby(2,nrb)*ii2 + rby(5,nrb)*ii5 + rby(8,nrb)*ii8
902 rby(22,nrb)=rby(2,nrb)*ii3 + rby(5,nrb)*ii6 + rby(8,nrb)*ii9
903 rby(23,nrb)=rby(3,nrb)*ii1 + rby(6,nrb)*ii4 + rby(9,nrb)*ii7
904 rby(24,nrb)=rby(3,nrb)*ii2 + rby(6,nrb)*ii5 + rby(9,nrb)*ii8
905 rby(25,nrb)=rby(3,nrb)*ii3 + rby(6,nrb)*ii6 + rby(9,nrb)*ii9
906C
907 ELSEIF(n2d == 1) THEN
908C
909 b1 = b1 - in(m)
910 b5 = b5 - in(m)
911 b9 = b9 - in(m)
912 totmas = totmas - ms(m) + masrb
913 xgt = zero
914 ygt = ygt - ms(m)*x(2,m) + masrb*x(2,m)
915 zgt = zgt - ms(m)*x(3,m) + masrb*x(3,m)
916C
917C Rigidite au noeud main pour estimation DT.
918
919 IF (ns10e>0) THEN
920 DO i=1,nsl
921 n = lsn(i)
922 IF (itagnd(n)/=0) cycle
923 stifn(m)= stifn(m)+stifn(n)
924 dd =(x(1,n)-x(1,m))**2+(x(2,n)-x(2,m))**2+(x(3,n)-x(3,m))**2
925 stifr(m)= stifr(m)+(stifr(n)+dd*stifn(n))
926 stifr(n)= em20
927 stifn(n)= em20
928 END DO
929 ELSE
930 DO i=1,nsl
931 n = lsn(i)
932 stifn(m)= stifn(m)+stifn(n)
933 dd = (x(1,n)-x(1,m))**2+(x(2,n)-x(2,m))**2+(x(3,n)-x(3,m))**2
934 stifr(m)= stifr(m)+(stifr(n)+dd*stifn(n))
935 stifr(n)= em20
936 stifn(n)= em20
937 END DO
938 END IF !(NS10E>0) THEN
939
940C MATRICE d'inertie -> repere global
941 rby(17,nrb)=rby(10,nrb)
942 rby(18,nrb)=zero
943 rby(19,nrb)=zero
944 rby(20,nrb)=zero
945 rby(21,nrb)=rby(11,nrb)
946 rby(22,nrb)=zero
947 rby(23,nrb)=zero
948 rby(24,nrb)=zero
949 rby(25,nrb)=rby(12,nrb)
950
951 ELSEIF(n2d == 2) THEN
952 b1 = b1 - in(m)
953 b5 = b5 - in(m)
954 b9 = b9 - in(m)
955 totmas = totmas - ms(m) + masrb
956 xgt = zero
957 ygt = ygt - ms(m)*x(2,m) + masrb*x(2,m)
958 zgt = zgt - ms(m)*x(3,m) + masrb*x(3,m)
959C
960C Rigidite au noeud main pour estimation DT.
961 IF (ns10e>0) THEN
962 DO i=1,nsl
963 n = lsn(i)
964 IF (itagnd(n)/=0) cycle
965 stifn(m)= stifn(m)+stifn(n)
966 dd = (x(2,n)-x(2,m))**2+(x(3,n)-x(3,m))**2
967 stifr(m)= stifr(m)+(stifr(n)+dd*stifn(n))
968 stifr(n)= em20
969 stifn(n)= em20
970 END DO
971 ELSE
972 DO i=1,nsl
973 n = lsn(i)
974 stifn(m)= stifn(m)+stifn(n)
975 dd = (x(2,n)-x(2,m))**2+(x(3,n)-x(3,m))**2
976 stifr(m)= stifr(m)+(stifr(n)+dd*stifn(n))
977 stifr(n)= em20
978 stifn(n)= em20
979 END DO
980 END IF !(NS10E>0) THEN
981
982C MATRICE d'inertie -> repere global
983 ii1=rby(10,nrb)*rby(1,nrb)
984 ii2=zero
985 ii3=zero
986 ii4=rby(11,nrb)*rby(4,nrb)
987 ii5=rby(11,nrb)*rby(5,nrb)
988 ii6=rby(11,nrb)*rby(6,nrb)
989 ii7=zero
990 ii8=rby(12,nrb)*rby(8,nrb)
991 ii9=rby(12,nrb)*rby(9,nrb)
992C
993 rby(17,nrb)=rby(1,nrb)*ii1 + rby(4,nrb)*ii4
994 rby(18,nrb)=rby(4,nrb)*ii5 + rby(7,nrb)*ii8
995 rby(19,nrb)=rby(4,nrb)*ii6 + rby(7,nrb)*ii9
996 rby(20,nrb)=rby(2,nrb)*ii1 + rby(5,nrb)*ii4
997 rby(21,nrb)=rby(5,nrb)*ii5 + rby(8,nrb)*ii8
998 rby(22,nrb)=rby(5,nrb)*ii6 + rby(8,nrb)*ii9
999 rby(23,nrb)=rby(3,nrb)*ii1 + rby(6,nrb)*ii4
1000 rby(24,nrb)=rby(6,nrb)*ii5 + rby(9,nrb)*ii8
1001 rby(25,nrb)=rby(6,nrb)*ii6 + rby(9,nrb)*ii9
1002 ENDIF
1003C-----------Multidomaines : on ignore l'erreur generee par le calcul des val propres et le chgt de repere--------------
1004C------------------> on reinjecte les ancienne valeures de la matrice dans le repere global <--------------------------
1005 IF(nsubdom>0)THEN
1006 IF(tagno(m+n_part)==3)THEN
1007 DO j=1,9
1008 rby(16+j,nrb)=rby_r2r(j)
1009 END DO
1010 ENDIF
1011 END IF
1012C
1013C-------INIVEL/AXIS must be corrected to take into account move of main node
1014 IF (rby_iniaxis(1,nrb) > 0) THEN
1015 dist = sqrt((x(1,m)-x_msn0(1))**2+(x(2,m)-x_msn0(2))**2+(x(3,m)-x_msn0(3))**2)
1016 IF ((dist > zero).AND.
1017 . v(1,m)==rby_iniaxis(2,nrb).AND.
1018 . v(2,m)==rby_iniaxis(3,nrb).AND.
1019 . v(3,m)==rby_iniaxis(4,nrb)) THEN
1020C-- inivel is corrected only if not modified after read of inivel
1021 v1x2=rby_iniaxis(5,nrb)*(x(2,m)-x_msn0(2))
1022 v2x1=rby_iniaxis(6,nrb)*(x(1,m)-x_msn0(1))
1023 v2x3=rby_iniaxis(6,nrb)*(x(3,m)-x_msn0(3))
1024 v3x2=rby_iniaxis(7,nrb)*(x(2,m)-x_msn0(2))
1025 v3x1=rby_iniaxis(7,nrb)*(x(1,m)-x_msn0(1))
1026 v1x3=rby_iniaxis(5,nrb)*(x(3,m)-x_msn0(3))
1027 v(1,m)= v(1,m)+v2x3-v3x2
1028 v(2,m)= v(2,m)+v3x1-v1x3
1029 v(3,m)= v(3,m)+v1x2-v2x1
1030 ENDIF
1031 ENDIF
1032C
1033 IF(n2d == 0) THEN
1034 DO i=1,nsl
1035 n=lsn(i)
1036 v1x2=vr(1,m)*(x(2,n)-x(2,m))
1037 v2x1=vr(2,m)*(x(1,n)-x(1,m))
1038 v2x3=vr(2,m)*(x(3,n)-x(3,m))
1039 v3x2=vr(3,m)*(x(2,n)-x(2,m))
1040 v3x1=vr(3,m)*(x(1,n)-x(1,m))
1041 v1x3=vr(1,m)*(x(3,n)-x(3,m))
1042 v(1,n)= v(1,m)+v2x3-v3x2
1043 v(2,n)= v(2,m)+v3x1-v1x3
1044 v(3,n)= v(3,m)+v1x2-v2x1
1045 vr(1,n)= vr(1,m)
1046 vr(2,n)= vr(2,m)
1047 vr(3,n)= vr(3,m)
1048 ENDDO
1049 ELSEIF(n2d == 1) THEN
1050 v(1,m)= zero
1051 vr(1,m)= zero
1052 vr(2,m)= zero
1053 DO i=1,nsl
1054 n=lsn(i)
1055 v3x2=vr(3,m)*(x(2,n)-x(2,m))
1056 v3x1=vr(3,m)*(x(1,n)-x(1,m))
1057 v(1,n)= v(1,m)-v3x2
1058 v(2,n)= v(2,m)+v3x1
1059 v(3,n)= v(3,m)
1060 vr(1,n)= vr(1,m)
1061 vr(2,n)= vr(2,m)
1062 vr(3,n)= vr(3,m)
1063 ENDDO
1064 ELSEIF(n2d == 2) THEN
1065 v(1,m)= zero
1066 vr(2,m)= zero
1067 vr(3,m)= zero
1068 DO i=1,nsl
1069 n=lsn(i)
1070 v1x2=vr(1,m)*(x(2,n)-x(2,m))
1071 v1x3=vr(1,m)*(x(3,n)-x(3,m))
1072 v(1,n)= zero
1073 v(2,n)= v(2,m)-v1x3
1074 v(3,n)= v(3,m)+v1x2
1075 vr(1,n)= vr(1,m)
1076 vr(2,n)= zero
1077 vr(3,n)= zero
1078 ENDDO
1079 ENDIF
1080C
1081 ENDIF ! (RBLEVEL == 0)
1082c
1083 RETURN
1084C
10851000 FORMAT(//
1086 . ' RIGID BODY INITIALIZATION '/
1087 . ' ------------------------- ')
1088
10891100 FORMAT(/5x,'RIGID BODY ID',i10
1090 . /10x,'PRIMARY NODE ',i10
1091 . /10x,'NEW X,Y,Z ',3g14.7
1092 . /10x,'NEW MASS ',1g14.7
1093 . /10x,'NEW INERTIA xx yy zz ',3g14.7
1094 . /10x,'NEW INERTIA xy yz zx ',3g14.7)
10951101 FORMAT(10x,'SECONDARY NODES ')
10961102 FORMAT( 10x,10i10)
1097
10981200 FORMAT(10x,'PRINCIPAL INERTIA',1p3g20.13)
10991300 FORMAT(/5x,'RIGID BODY ID',i10)
11001400 FORMAT(
1101 & 5x,40hrigid body on multidomains INTERFACE ,/,
1102 & 5x,55h --> mass and inertia matrix are computed in the engine,/)
1103 END
1104
1105
1106!||====================================================================
1107!|| inirbys ../starter/source/constraints/general/rbody/inirby.F
1108!||--- called by ------------------------------------------------------
1109!|| initia ../starter/source/elements/initia/initia.F
1110!||--- calls -----------------------------------------------------
1111!|| ancmsg ../starter/source/output/message/message.F
1112!|| inepri ../starter/source/materials/mat/mat019/inepri.F
1113!||--- uses -----------------------------------------------------
1114!|| message_mod ../starter/share/message_module/message_mod.F
1115!||====================================================================
1116 SUBROUTINE inirbys(NRB ,RBY ,M ,LPBY ,
1117 . MS ,IN ,X ,ITAB,SKEW,
1118 . B1 ,B2 ,B3 ,B5 ,B6,
1119 . B9 ,ISPH ,TOTMAS,XGT ,YGT ,
1120 . ZGT ,NPBY ,IWA ,V ,VR,
1121 . RBYID,ID ,TITR ,ITAGND ,RBY_INIAXIS)
1122 USE message_mod
1123 USE names_and_titles_mod , ONLY : nchartitle
1124C=======================================================================
1125C RBY EN SORTIE DE INIRBY
1126C 1 -> 9 : MATRICE ROTATION
1127C 10 -> 12: INERTIES PRINCIPALES RBODY
1128C 13: INERTIE MAIN INITIALE SPHERIQUE
1129C 14: MASSE RBODY
1130C 15: MASSE MAIN INITIALE
1131C 16 -> 20: LIBRE
1132C-----------------------------------------------
1133C I m p l i c i t T y p e s
1134C-----------------------------------------------
1135#include "implicit_f.inc"
1136C-----------------------------------------------
1137C C o m m o n B l o c k s
1138C-----------------------------------------------
1139#include "units_c.inc"
1140#include "param_c.inc"
1141#include "com04_c.inc"
1142#include "com01_c.inc"
1143C-----------------------------------------------
1144C D u m m y A r g u m e n t s
1145C-----------------------------------------------
1146 INTEGER NRB, M, ISPH
1147 INTEGER ITAB(*),NPBY(NNPBY,*) ,IWA(*),
1148 . RBYID,ITAGND(*)
1149 INTEGER, TARGET :: LPBY(*)
1150C REAL
1151 my_real
1152 . RBY(NRBY,*), MS(*), IN(*), X(3,*), SKEW(LSKEW,*),
1153 . V(3,*), VR(3,*),
1154 . B1, B2, B3, B5, B6, B9,TOTMAS ,XGT ,YGT ,
1155 . ZGT,RBY_INIAXIS(7,*)
1156 INTEGER ID
1157 CHARACTER(LEN=NCHARTITLE) :: TITR
1158C-----------------------------------------------
1159C L o c a l V a r i a b l e s
1160C-----------------------------------------------
1161 INTEGER NSL, J, I, N, NONOD,II,NI,K, NSLI,
1162 . rblevel, opt_merge, m_i, nsl_xtra
1163C REAL
1164 my_real
1165 . xg(3), xm0(3), xx, xy, xz, yy, yz, zz, xiin, inmin,
1166 . v1x2, v2x1, v2x3, v3x2, v3x1, v1x3,
1167 . masrb,dd,inmax, xmg, x_msn0(3), dist
1168 INTEGER, DIMENSION(:), POINTER :: LSN, LSN_XTRA
1169C
1170 MS(M)=zero
1171 in(m) = zero
1172 nonod=itab(m)
1173C
1174 nsl_xtra = npby(14,nrb)+npby(15,nrb)+npby(16,nrb)
1175 nsl = npby(2,nrb) - nsl_xtra
1176 lsn => lpby(npby(11,nrb)+1:npby(11,nrb)+nsl) ! Liste des noeuds SECONDARY
1177 rblevel = npby(12,nrb)
1178C
1179 rby(1,nrb)=zero
1180 rby(2,nrb)=zero
1181 rby(3,nrb)=zero
1182 rby(4,nrb)=zero
1183 rby(5,nrb)=zero
1184 rby(8,nrb)=zero
1185 rby(9,nrb)=zero
1186C---------------------------------
1187C RECHERCHE DES NOEUDS SECONDS
1188C DE SOUS RBY (NOEUD MAIN PARMI LES SECONDS)
1189C---------------------------------
1190 DO i=1,nsl
1191 n=lsn(i)
1192 IF(iwa(n)>0)THEN
1193 k=0
1194 DO ni=1,iwa(n)-1
1195 nsli=npby(2,ni)
1196 k = k + nsli
1197 ENDDO
1198 nsli=npby(2,iwa(n))
1199 DO ii=1,nsli
1200 ni=lpby(k+ii)
1201 IF(iwa(ni)==0)iwa(ni)=-1
1202 ENDDO
1203 ENDIF
1204 ENDDO
1205C---------------------------------
1206C CORRECTION DE LA MASSE ET DU
1207C CENTRE DE GRAVITE DU MAIN
1208C---------------------------------
1209C
1210C---INITIAL COORDINATES ARE STORED FOR INIVEL/AXIS correction
1211 IF (rby_iniaxis(1,nrb) > 0) THEN
1212 DO j=1,3
1213 x_msn0(j)=x(j,m)
1214 ENDDO
1215 ENDIF
1216
1217C-----CDG DES NOEUDS SECONDS
1218 masrb=zero
1219 DO j=1,3
1220 x(j,m)=zero
1221 ENDDO
1222 IF (ns10e>0) THEN
1223 DO i=1,nsl
1224 n=lsn(i)
1225 IF(iwa(n)>=0.AND.itagnd(n)==0)THEN
1226 DO j=1,3
1227 x(j,m) = x(j,m)+x(j,n)*ms(n)
1228 ENDDO
1229 masrb = masrb+ms(n)
1230 ENDIF
1231 ENDDO
1232 ELSE
1233 DO i=1,nsl
1234 n=lsn(i)
1235 IF(iwa(n)>=0)THEN
1236 DO j=1,3
1237 x(j,m) = x(j,m)+x(j,n)*ms(n)
1238 ENDDO
1239 masrb = masrb+ms(n)
1240 ENDIF
1241 ENDDO
1242 END IF !(NS10E>0) THEN
1243C
1244 IF(masrb<=1.e-30) THEN
1245 CALL ancmsg(msgid=679,
1246 . msgtype=msgerror,
1247 . anmode=aninfo_blind_1,
1248 . i1=id,
1249 . c1=titr,
1250 . c2='ON SECONDARY NODES')
1251 RETURN
1252 ENDIF
1253C
1254 DO j=1,3
1255 x(j,m)=x(j,m)/masrb
1256 xg(j)=x(j,m)
1257 ENDDO
1258C
1259C--------------------------------------
1260C ASSEMBLAGE DES XTRA NODES DANS LA MASSE ET COG
1261C--------------------------------------
1262 IF(npby(15,nrb) > 0) THEN ! MASS/INERTIA ADD, COG ACTUALIZED
1263 lsn_xtra => lpby(npby(11,nrb)+nsl+npby(14,nrb)+1:
1264 . npby(11,nrb)+nsl+npby(14,nrb)+npby(15,nrb))
1265 DO j=1,3
1266 xg(j)=x(j,m)
1267 x(j,m)=x(j,m)*masrb
1268 ENDDO
1269 xmg=masrb
1270C
1271 DO i=1,npby(15,nrb)
1272 n=lsn_xtra(i)
1273 IF (itagnd(n)/=0) cycle
1274 DO j=1,3
1275 x(j,m) = x(j,m)+x(j,n)*ms(n)
1276 ENDDO
1277 masrb = masrb+ms(n)
1278 ENDDO
1279C
1280 DO j=1,3
1281 x(j,m)=x(j,m)/masrb
1282 xg(j)=x(j,m)
1283 ENDDO
1284 ENDIF
1285C
1286 IF(npby(16,nrb) > 0) THEN ! MASS/INERTIA ADD, COG NOT ACTUALIZED
1287 lsn_xtra => lpby(npby(11,nrb)+nsl+npby(14,nrb)+npby(15,nrb)+1:
1288 . npby(11,nrb)+nsl+npby(14,nrb)+npby(15,nrb)+npby(16,nrb))
1289 DO i=1,npby(16,nrb)
1290 n=lsn_xtra(i)
1291 IF (itagnd(n)/=0) cycle
1292 masrb = masrb+ms(n)
1293 ENDDO
1294 ENDIF
1295C
1296C--------------------------------------
1297C CORRECTION DE L'INERTIE DU MAIN
1298C--------------------------------------
1299 IF(n2d==0)THEN
1300C ANALYSE 3D
1301 DO i=1,nsl
1302 n=lsn(i)
1303 ni=iwa(n)
1304 IF(ni==0)THEN
1305 xx=(x(1,n)-x(1,m))*(x(1,n)-x(1,m))
1306 xy=(x(1,n)-x(1,m))*(x(2,n)-x(2,m))
1307 xz=(x(1,n)-x(1,m))*(x(3,n)-x(3,m))
1308 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
1309 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
1310 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
1311 rby(1,nrb)=rby(1,nrb)+in(n)+(yy+zz)*ms(n)
1312 rby(2,nrb)=rby(2,nrb)-xy*ms(n)
1313 rby(3,nrb)=rby(3,nrb)-xz*ms(n)
1314 rby(4,nrb)=rby(4,nrb)-xy*ms(n)
1315 rby(5,nrb)=rby(5,nrb)+in(n)+(zz+xx)*ms(n)
1316 rby(6,nrb)=rby(6,nrb)-yz*ms(n)
1317 rby(7,nrb)=rby(7,nrb)-xz*ms(n)
1318 rby(8,nrb)=rby(8,nrb)-yz*ms(n)
1319 rby(9,nrb)=rby(9,nrb)+in(n)+(xx+yy)*ms(n)
1320 ELSEIF(ni>0)THEN
1321C MAIN DE SOUS RBY
1322 xx=(x(1,n)-x(1,m))*(x(1,n)-x(1,m))
1323 xy=(x(1,n)-x(1,m))*(x(2,n)-x(2,m))
1324 xz=(x(1,n)-x(1,m))*(x(3,n)-x(3,m))
1325 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
1326 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
1327 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
1328 rby(1,nrb)=rby(1,nrb)+(yy+zz)*ms(n)+rby(17,ni)
1329 rby(2,nrb)=rby(2,nrb)-xy*ms(n)+rby(18,ni)
1330 rby(3,nrb)=rby(3,nrb)-xz*ms(n)+rby(19,ni)
1331 rby(4,nrb)=rby(4,nrb)-xy*ms(n)+rby(20,ni)
1332 rby(5,nrb)=rby(5,nrb)+(zz+xx)*ms(n)+rby(21,ni)
1333 rby(6,nrb)=rby(6,nrb)-yz*ms(n)+rby(22,ni)
1334 rby(7,nrb)=rby(7,nrb)-xz*ms(n)+rby(23,ni)
1335 rby(8,nrb)=rby(8,nrb)-yz*ms(n)+rby(24,ni)
1336 rby(9,nrb)=rby(9,nrb)+(xx+yy)*ms(n)+rby(25,ni)
1337 ENDIF
1338 ENDDO
1339C
1340 ELSEIF(n2d == 1) THEN
1341C ANALYSE 2D : Axisymetrie
1342 DO i=1,nsl
1343 n=lsn(i)
1344 ni=iwa(n)
1345 IF(ni==0)THEN
1346 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
1347 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
1348 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
1349 rby(1,nrb)=rby(1,nrb)+in(n)+(yy+zz)*ms(n)
1350 rby(2,nrb)=zero
1351 rby(3,nrb)=zero
1352 rby(4,nrb)=zero
1353 rby(5,nrb)=rby(5,nrb)+in(n)+zz*ms(n)
1354 rby(6,nrb)=zero
1355 rby(7,nrb)=zero
1356 rby(8,nrb)=zero
1357 rby(9,nrb)=rby(9,nrb)+in(n)+yy*ms(n)
1358 ELSEIF(ni>0)THEN
1359C MAIN DE SOUS RBY
1360 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
1361 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
1362 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
1363 rby(1,nrb)=rby(1,nrb)+(yy+zz)*ms(n)+rby(17,ni)
1364 rby(2,nrb)=zero
1365 rby(3,nrb)=zero
1366 rby(4,nrb)=zero
1367 rby(5,nrb)=rby(5,nrb)+zz*ms(n)+rby(21,ni)
1368 rby(6,nrb)=zero
1369 rby(7,nrb)=zero
1370 rby(8,nrb)=zero
1371 rby(9,nrb)=rby(9,nrb)+yy*ms(n)+rby(25,ni)
1372 ENDIF
1373 ENDDO
1374C
1375 ELSEIF(n2d == 2) THEN
1376C ANALYSE 2D : Strain Plane
1377 DO i=1,nsl
1378 n=lsn(i)
1379 ni=iwa(n)
1380 IF(ni==0)THEN
1381 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
1382 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
1383 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
1384 rby(1,nrb)=rby(1,nrb)+in(n)+(yy+zz)*ms(n)
1385 rby(2,nrb)=zero
1386 rby(3,nrb)=zero
1387 rby(4,nrb)=zero
1388 rby(5,nrb)=rby(5,nrb)+in(n)+zz*ms(n)
1389 rby(6,nrb)=rby(6,nrb)-yz*ms(n)
1390 rby(7,nrb)=zero
1391 rby(8,nrb)=rby(8,nrb)-yz*ms(n)
1392 rby(9,nrb)=rby(9,nrb)+in(n)+yy*ms(n)
1393 ELSEIF(ni>0)THEN
1394C MAIN DE SOUS RBY
1395 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
1396 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
1397 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
1398 rby(1,nrb)=rby(1,nrb)+(yy+zz)*ms(n)+rby(17,ni)
1399 rby(2,nrb)=zero
1400 rby(3,nrb)=zero
1401 rby(4,nrb)=zero
1402 rby(5,nrb)=rby(5,nrb)+zz*ms(n)+rby(21,ni)
1403 rby(6,nrb)=rby(6,nrb)-yz*ms(n)+rby(22,ni)
1404 rby(7,nrb)=zero
1405 rby(8,nrb)=rby(8,nrb)-yz*ms(n)+rby(24,ni)
1406 rby(9,nrb)=rby(9,nrb)+yy*ms(n)+rby(25,ni)
1407 ENDIF
1408 ENDDO
1409C
1410 ENDIF
1411C
1412C--------------------------------------
1413C AJOUT DE L'INERTIE DES XTRA NODES
1414C--------------------------------------
1415 IF((npby(15,nrb)+npby(16,nrb)) > 0) THEN
1416
1417 lsn_xtra => lpby(npby(11,nrb)+nsl+npby(14,nrb)+1:
1418 . npby(11,nrb)+nsl+npby(14,nrb)+npby(15,nrb)+npby(16,nrb))
1419
1420 IF(n2d==0)THEN
1421 DO i=1,npby(15,nrb)+npby(16,nrb)
1422 n=lsn_xtra(i)
1423 IF (itagnd(n)/=0) cycle
1424 xx=(x(1,n)-x(1,m))*(x(1,n)-x(1,m))
1425 xy=(x(1,n)-x(1,m))*(x(2,n)-x(2,m))
1426 xz=(x(1,n)-x(1,m))*(x(3,n)-x(3,m))
1427 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
1428 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
1429 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
1430 rby(1,nrb)=rby(1,nrb)+in(n)+(yy+zz)*ms(n)
1431 rby(2,nrb)=rby(2,nrb)-xy*ms(n)
1432 rby(3,nrb)=rby(3,nrb)-xz*ms(n)
1433 rby(4,nrb)=rby(4,nrb)-xy*ms(n)
1434 rby(5,nrb)=rby(5,nrb)+in(n)+(zz+xx)*ms(n)
1435 rby(6,nrb)=rby(6,nrb)-yz*ms(n)
1436 rby(7,nrb)=rby(7,nrb)-xz*ms(n)
1437 rby(8,nrb)=rby(8,nrb)-yz*ms(n)
1438 rby(9,nrb)=rby(9,nrb)+in(n)+(xx+yy)*ms(n)
1439 ENDDO
1440 ELSEIF(n2d==1) THEN
1441 DO i=1,npby(15,nrb)+npby(16,nrb)
1442 n=lsn_xtra(i)
1443 IF (itagnd(n)/=0) cycle
1444 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
1445 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
1446 rby(1,nrb)=rby(1,nrb)+in(n)+(yy+zz)*ms(n)
1447 rby(5,nrb)=rby(5,nrb)+in(n)+zz*ms(n)
1448 rby(9,nrb)=rby(9,nrb)+in(n)+yy*ms(n)
1449 ENDDO
1450 ELSEIF(n2d==1) THEN
1451 DO i=1,npby(15,nrb)+npby(16,nrb)
1452 n=lsn_xtra(i)
1453 IF (itagnd(n)/=0) cycle
1454 yy=(x(2,n)-x(2,m))*(x(2,n)-x(2,m))
1455 yz=(x(2,n)-x(2,m))*(x(3,n)-x(3,m))
1456 zz=(x(3,n)-x(3,m))*(x(3,n)-x(3,m))
1457 rby(1,nrb)=rby(1,nrb)+in(n)+(yy+zz)*ms(n)
1458 rby(5,nrb)=rby(5,nrb)+in(n)+zz*ms(n)
1459 rby(6,nrb)=rby(6,nrb)-yz*ms(n)
1460 rby(8,nrb)=rby(8,nrb)-yz*ms(n)
1461 rby(9,nrb)=rby(9,nrb)+in(n)+yy*ms(n)
1462 ENDDO
1463 ENDIF !N2D
1464 ENDIF
1465C
1466C--------------------------------------
1467C ASSEMBLAGE DES MASSES DES RIGID BODY SECONDARYS ET MAJ POSITION DU COG
1468C--------------------------------------
1469 DO i=nrb-1,1,-1
1470 IF((npby(12,i)) == rblevel-1) THEN
1471 DO j=1,3
1472 xg(j)=x(j,m) ! centre de gravite du rb main avant modif
1473 ENDDO
1474 xmg=masrb ! masse du RB main avant modif
1475c
1476 opt_merge = npby(13,i)
1477 npby(11,nrb) = npby(11,i)
1478 npby(2,nrb) = npby(2,nrb)+npby(2,i)
1479 m_i=npby(1,i)
1480c
1481 IF(opt_merge == 2) THEN ! MASSE AJOUTEE, COG ACTUALISE
1482 DO j=1,3
1483 x(j,m)=x(j,m)*masrb+x(j,m_i)*rby(14,i)
1484 ENDDO
1485 masrb = masrb + rby(14,i)
1486 DO j=1,3
1487 x(j,m)=x(j,m)/masrb
1488 ENDDO
1489 ELSEIF(opt_merge == 3) THEN ! MASSE AJOUTEE, COG NON ACTUALISE
1490 masrb = masrb + rby(14,i)
1491 ENDIF
1492c
1493C--------------------------------------
1494C TRANSFERT DES INERTIES AU COG
1495C--------------------------------------
1496 IF(opt_merge == 2) THEN ! COG ACTUALISE, TRANSFERT INERTIE MAIN
1497 IF(n2d==0)THEN
1498 xx=(xg(1)-x(1,m))*(xg(1)-x(1,m))
1499 xy=(xg(1)-x(1,m))*(xg(2)-x(2,m))
1500 xz=(xg(1)-x(1,m))*(xg(3)-x(3,m))
1501 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
1502 yz=(xg(2)-x(2,m))*(xg(3)-x(3,m))
1503 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
1504 rby(1,nrb)=rby(1,nrb)+(yy+zz)*xmg
1505 rby(2,nrb)=rby(2,nrb)-xy*xmg
1506 rby(3,nrb)=rby(3,nrb)-xz*xmg
1507 rby(4,nrb)=rby(4,nrb)-xy*xmg
1508 rby(5,nrb)=rby(5,nrb)+(zz+xx)*xmg
1509 rby(6,nrb)=rby(6,nrb)-yz*xmg
1510 rby(7,nrb)=rby(7,nrb)-xz*xmg
1511 rby(8,nrb)=rby(8,nrb)-yz*xmg
1512 rby(9,nrb)=rby(9,nrb)+(xx+yy)*xmg
1513 ELSEIF(n2d==1) THEN
1514 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
1515 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
1516 rby(1,nrb)=rby(1,nrb)+(yy+zz)*xmg
1517 rby(2,nrb)=zero
1518 rby(3,nrb)=zero
1519 rby(4,nrb)=zero
1520 rby(5,nrb)=rby(5,nrb)+zz*xmg
1521 rby(6,nrb)=zero
1522 rby(7,nrb)=zero
1523 rby(8,nrb)=zero
1524 rby(9,nrb)=rby(9,nrb)+yy*xmg
1525 ELSEIF(n2d==2) THEN
1526 yy=(xg(2)-x(2,m))*(xg(2)-x(2,m))
1527 yz=(xg(2)-x(2,m))*(xg(3)-x(3,m))
1528 zz=(xg(3)-x(3,m))*(xg(3)-x(3,m))
1529 rby(1,nrb)=rby(1,nrb)+(yy+zz)*xmg
1530 rby(2,nrb)=zero
1531 rby(3,nrb)=zero
1532 rby(4,nrb)=zero
1533 rby(5,nrb)=rby(5,nrb)+zz*xmg
1534 rby(6,nrb)=rby(6,nrb)-yz*xmg
1535 rby(7,nrb)=zero
1536 rby(8,nrb)=rby(8,nrb)-yz*xmg
1537 rby(9,nrb)=rby(9,nrb)+yy*xmg
1538 ENDIF
1539 ENDIF
1540 IF(opt_merge > 1) THEN ! TRANSFERT INERTIE SECONDARY
1541 IF(n2d==0)THEN
1542 xx=(x(1,m_i)-x(1,m))*(x(1,m_i)-x(1,m))
1543 xy=(x(1,m_i)-x(1,m))*(x(2,m_i)-x(2,m))
1544 xz=(x(1,m_i)-x(1,m))*(x(3,m_i)-x(3,m))
1545 yy=(x(2,m_i)-x(2,m))*(x(2,m_i)-x(2,m))
1546 yz=(x(2,m_i)-x(2,m))*(x(3,m_i)-x(3,m))
1547 zz=(x(3,m_i)-x(3,m))*(x(3,m_i)-x(3,m))
1548 rby(1,nrb)=rby(1,nrb)+rby(1,i)+(yy+zz)*rby(14,i)
1549 rby(2,nrb)=rby(2,nrb)+rby(2,i)-xy*rby(14,i)
1550 rby(3,nrb)=rby(3,nrb)+rby(3,i)-xz*rby(14,i)
1551 rby(4,nrb)=rby(4,nrb)+rby(4,i)-xy*rby(14,i)
1552 rby(5,nrb)=rby(5,nrb)+rby(5,i)+(zz+xx)*rby(14,i)
1553 rby(6,nrb)=rby(6,nrb)+rby(6,i)-yz*rby(14,i)
1554 rby(7,nrb)=rby(7,nrb)+rby(7,i)-xz*rby(14,i)
1555 rby(8,nrb)=rby(8,nrb)+rby(8,i)-yz*rby(14,i)
1556 rby(9,nrb)=rby(9,nrb)+rby(9,i)+(xx+yy)*rby(14,i)
1557 ELSEIF(n2d==1) THEN
1558 yy=(x(2,m_i)-x(2,m))*(x(2,m_i)-x(2,m))
1559 zz=(x(3,m_i)-x(3,m))*(x(3,m_i)-x(3,m))
1560 rby(1,nrb)=rby(1,nrb)+rby(1,i)+(yy+zz)*rby(14,i)
1561 rby(5,nrb)=rby(5,nrb)+rby(5,i)+zz*rby(14,i)
1562 rby(9,nrb)=rby(9,nrb)+rby(9,i)+yy*rby(14,i)
1563 ELSEIF(n2d==2) THEN
1564 yy=(x(2,m_i)-x(2,m))*(x(2,m_i)-x(2,m))
1565 yz=(x(2,m_i)-x(2,m))*(x(3,m_i)-x(3,m))
1566 zz=(x(3,m_i)-x(3,m))*(x(3,m_i)-x(3,m))
1567 rby(1,nrb)=rby(1,nrb)+rby(1,i)+(yy+zz)*rby(14,i)
1568 rby(5,nrb)=rby(5,nrb)+rby(5,i)+zz*rby(14,i)
1569 rby(6,nrb)=rby(6,nrb)-yz*rby(14,i)
1570 rby(8,nrb)=rby(8,nrb)-yz*rby(14,i)
1571 rby(9,nrb)=rby(9,nrb)+rby(9,i)+yy*rby(14,i)
1572 ENDIF !N2D
1573 ENDIF
1574c mise a zero des donnees rb SECONDARY
1575 rby(1:15,i)=zero
1576 in(m_i)=zero
1577 ms(m_i)=zero
1578 ELSEIF(npby(12,i) == rblevel) THEN
1579 EXIT
1580 ENDIF
1581 ENDDO
1582c
1583C----------------------------------------------
1584C NSL est complete par les noeuds SECONDARY des rigid body SECONDARYs
1585C LSN est actualisee
1586C----------------------------------------------
1587 IF(rblevel == 0) THEN ! IF THIS RIGID BODY IS THE TOP MAIN
1588 nsl = npby(2,nrb) ! Liste totale des noeuds SECONDARY
1589 lsn => lpby(npby(11,nrb)+1:npby(11,nrb)+nsl)
1590c
1591 WRITE(iout,1000)
1592
1593 IF(isph==1)THEN
1594 ELSE
1595
1596 WRITE(iout,1100) rbyid,nonod,x(1,m),x(2,m),x(3,m),
1597 . masrb,rby(1,nrb),rby(5,nrb),rby(9,nrb),
1598 . rby(2,nrb),rby(6,nrb),rby(3,nrb)
1599 ENDIF
1600C----------------------------------------------------------------
1601C CALCUL DU REPERE D'INERTIE PRINCIPALE
1602C
1603 IF(n2d == 1) THEN
1604 rby(11,nrb) = rby(5,nrb)
1605 rby(12,nrb) = rby(9,nrb)
1606 rby(1,nrb) = one
1607 rby(5,nrb) = one
1608 rby(9,nrb) = one
1609 ELSE
1610 CALL inepri(rby(10,nrb),rby(1,nrb))
1611 ENDIF
1612
1613 IF(isph==1)THEN
1614 xiin = (rby(10,nrb) + rby(11,nrb) + rby(12,nrb)) * third
1615 rby(10,nrb) = xiin
1616 rby(11,nrb) = xiin
1617 rby(12,nrb) = xiin
1618 inmin = xiin
1619
1620 WRITE(iout,1100) rbyid,nonod,x(1,m),x(2,m),x(3,m),
1621 . masrb,xiin,xiin,xiin,zero,zero,zero
1622 ELSEIF(isph==2) THEN
1623 inmin = min(rby(10,nrb),rby(11,nrb),rby(12,nrb))
1624 inmax = max(rby(10,nrb),rby(11,nrb),rby(12,nrb))
1625 IF(inmin<=1.e-3*inmax)THEN
1626 IF(rby(10,nrb)/inmax<em03) rby(10,nrb)=rby(10,nrb)+em01*inmax
1627 IF(rby(11,nrb)/inmax<em03) rby(11,nrb)=rby(11,nrb)+em01*inmax
1628 IF(rby(12,nrb)/inmax<em03) rby(12,nrb)=rby(12,nrb)+em01*inmax
1629 CALL ancmsg(msgid=275,
1630 . msgtype=msgwarning,
1631 . anmode=aninfo_blind_1,
1632 . i1=id,
1633 . c1=titr)
1634 ENDIF
1635 ENDIF
1636C
1637 inmin = min(rby(10,nrb),rby(11,nrb),rby(12,nrb))
1638 WRITE(iout,1200) rby(10,nrb),rby(11,nrb),rby(12,nrb)
1639 WRITE(iout,1101)
1640 WRITE(iout,1102) (itab(lpby(i+npby(11,nrb))),i=1,nsl)
1641
1642C
1643 IF(inmin<=0.0)THEN
1644 CALL ancmsg(msgid=274,
1645 . msgtype=msgerror,
1646 . anmode=aninfo_blind_1,
1647 . i1=id,
1648 . c1=titr)
1649 ENDIF
1650C
1651 rby(13,nrb)=zero
1652 rby(14,nrb)=masrb
1653C
1654 rby(15,nrb)=zero
1655 ms(m) = zero
1656 in(m) = zero
1657C
1658C-------INIVEL/AXIS must be corrected to take into account move of main node
1659 IF (rby_iniaxis(1,nrb) > 0) THEN
1660 dist = sqrt((x(1,m)-x_msn0(1))**2+(x(2,m)-x_msn0(2))**2+(x(3,m)-x_msn0(3))**2)
1661 IF ((dist > zero).AND.
1662 . v(1,m)==rby_iniaxis(2,nrb).AND.
1663 . v(2,m)==rby_iniaxis(3,nrb).AND.
1664 . v(3,m)==rby_iniaxis(4,nrb)) THEN
1665C-- inivel is corrected only if not modified after read of inivel
1666 v1x2=rby_iniaxis(5,nrb)*(x(2,m)-x_msn0(2))
1667 v2x1=rby_iniaxis(6,nrb)*(x(1,m)-x_msn0(1))
1668 v2x3=rby_iniaxis(6,nrb)*(x(3,m)-x_msn0(3))
1669 v3x2=rby_iniaxis(7,nrb)*(x(2,m)-x_msn0(2))
1670 v3x1=rby_iniaxis(7,nrb)*(x(1,m)-x_msn0(1))
1671 v1x3=rby_iniaxis(5,nrb)*(x(3,m)-x_msn0(3))
1672 v(1,m)= v(1,m)+v2x3-v3x2
1673 v(2,m)= v(2,m)+v3x1-v1x3
1674 v(3,m)= v(3,m)+v1x2-v2x1
1675 ENDIF
1676 ENDIF
1677C
1678 IF(n2d == 0) THEN
1679 DO i=1,nsl
1680 n=lsn(i)
1681 iwa(n)=max(iwa(n),0)
1682 v1x2=vr(1,m)*(x(2,n)-x(2,m))
1683 v2x1=vr(2,m)*(x(1,n)-x(1,m))
1684 v2x3=vr(2,m)*(x(3,n)-x(3,m))
1685 v3x2=vr(3,m)*(x(2,n)-x(2,m))
1686 v3x1=vr(3,m)*(x(1,n)-x(1,m))
1687 v1x3=vr(1,m)*(x(3,n)-x(3,m))
1688 v(1,n)= v(1,m)+v2x3-v3x2
1689 v(2,n)= v(2,m)+v3x1-v1x3
1690 v(3,n)= v(3,m)+v1x2-v2x1
1691 vr(1,n)= vr(1,m)
1692 vr(2,n)= vr(2,m)
1693 vr(3,n)= vr(3,m)
1694 ENDDO
1695 ELSEIF(n2d == 1) THEN
1696 DO i=1,nsl
1697 n=lsn(i)
1698 iwa(n)=max(iwa(n),0)
1699 v(1,m)= zero
1700c V(2,M)= ZERO
1701 vr(1,m)= zero
1702 vr(2,m)= zero
1703 v3x2=vr(3,m)*(x(2,n)-x(2,m))
1704 v(1,n)= v(1,m)-v3x2
1705 v(2,n)= v(2,m)
1706 v(3,n)= v(3,m)
1707 vr(1,n)= vr(1,m)
1708 vr(2,n)= vr(2,m)
1709 vr(3,n)= vr(3,m)
1710 ENDDO
1711 ELSEIF(n2d == 2) THEN
1712 DO i=1,nsl
1713 n=lsn(i)
1714 iwa(n)=max(iwa(n),0)
1715 v(1,m)= zero
1716 vr(2,m)= zero
1717 vr(3,m)= zero
1718 v1x2=vr(1,m)*(x(2,n)-x(2,m))
1719 v1x3=vr(1,m)*(x(3,n)-x(3,m))
1720 v(1,n)= v(1,m)
1721 v(2,n)= v(2,m)-v1x3
1722 v(3,n)= v(3,m)+v1x2
1723 vr(1,n)= vr(1,m)
1724 vr(2,n)= vr(2,m)
1725 vr(3,n)= vr(3,m)
1726 ENDDO
1727 ENDIF
1728C
1729 ENDIF ! (RBLEVEL == 0)
1730C
1731 RETURN
1732C
17331000 FORMAT(/
1734 . ' RIGID BODY INITIALIZATION (SENSOR ACTIVATED) '/
1735 . ' ------------------------- ')
1736
17371100 FORMAT(/5x,'RIGID BODY ID',i10
1738 . /10x,'PRIMARY NODE ',i10
1739 . /10x,'NEW X,Y,Z ',1p3g14.7
1740 . /10x,'NEW MASS ',1g14.7
1741 . /10x,'NEW INERTIA xx yy zz ',3g14.7
1742 . /10x,'NEW INERTIA xy yz zx ',3g14.7)
17431200 FORMAT(10x,'PRINCIPAL INERTIA',1p3g20.13)
17441101 FORMAT(10x,'SECONDARY NODES ')
17451102 FORMAT( 10x,10i10)
1746 END
chbas
subroutine chbas(a, m)
Definition chbas.F:30
the
end diagonal values have been computed in the(sparse) matrix id.SOL
inirbys
subroutine inirbys(nrb, rby, m, lpby, ms, in, x, itab, skew, b1, b2, b3, b5, b6, b9, isph, totmas, xgt, ygt, zgt, npby, iwa, v, vr, rbyid, id, titr, itagnd, rby_iniaxis)
Definition inirby.F:1122
inirby
subroutine inirby(nrb, rby, m, lpby, ms, in, x, itab, skew, b1, b2, b3, b5, b6, b9, isph, totmas, xgt, ygt, zgt, stifn, stifr, npby, rbyid, v, vr, id, titr, itagnd, rby_iniaxis)
Definition inirby.F:42
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
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