OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgbcor.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!|| rgbcor ../engine/source/constraints/general/rbody/rgbcor.F
25!||--- called by ------------------------------------------------------
26!|| rbycor ../engine/source/constraints/general/rbody/rbycor.F
27!||--- uses -----------------------------------------------------
28!|| imp_dyna ../engine/share/modules/impbufdef_mod.F
29!||====================================================================
30 SUBROUTINE rgbcor(V ,VR ,X ,RBY,NOD ,
31 2 NBY,SKEW,ISKEW,FS ,ITAB,
32 3 WEIGHT,A,AR ,MS ,IN ,
33 3 ENROT_T,ENCIN_T,XMASS_T,
34 4 XMOMT_T,YMOMT_T,ZMOMT_T,ISENS,
35 4 WEIGHT_MD,ENCIN2_T,ENROT2_T,
36 5 MS_2D )
37C-----------------------------------------------
38 USE imp_dyna
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER NOD(*), NBY(*), ISKEW(*),ITAB(*), WEIGHT(*),
47 . WEIGHT_MD(*)
48C REAL
49 my_real
50 . V(3,*), VR(3,*), X(3,*), RBY(*), SKEW(LSKEW,*), FS(*),
51 . A(3,*),AR(3,*),IN(*),MS(*),ENROT_T,ENCIN_T,XMASS_T,
52 . xmomt_t,ymomt_t,zmomt_t,encin2_t,enrot2_t,ms_2d(*)
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com08_c.inc"
57#include "parit_c.inc"
58#include "impl1_c.inc"
59#include "param_c.inc"
60#include "com01_c.inc"
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER M, NSN, ICODR, ISK, I, N,ISENS
65C REAL
66 my_real
67 . VI(3),VG(3),DT05,MAS,WEWE2
68C to keep enough accuracy in single precision
69 DOUBLE PRECISION
70 . enrott,encint,xmasst,xmomtt,ymomtt,zmomtt,
71 . encin2t,enrot2t
72C-----------------------------------------------
73 m =nby(1)
74
75 enrott=zero
76 encint=zero
77 xmasst=zero
78 xmomtt=zero
79 ymomtt=zero
80 zmomtt=zero
81 encin2t=zero
82 enrot2t=zero
83
84
85C optimisation spmd
86 IF (m<0) RETURN
87 nsn =nby(2)
88C------------------------------------------------------------
89C CORRECTION DE L'ENERGIE CINETIQUE time = t
90C------------------------------------------------------------
91 IF(impl_s>0.AND.idyna==0)THEN
92 IF(isens==0)THEN
93 vg(1)=vr(1,m)
94 vg(2)=vr(2,m)
95 vg(3)=vr(3,m)
96 vi(1)=rby(1)*vg(1)+rby(2)*vg(2)+rby(3)*vg(3)
97 vi(2)=rby(4)*vg(1)+rby(5)*vg(2)+rby(6)*vg(3)
98 vi(3)=rby(7)*vg(1)+rby(8)*vg(2)+rby(9)*vg(3)
99C
100 enrott= - ( vg(1)*vg(1)
101 . + vg(2)*vg(2)
102 . + vg(3)*vg(3))*in(m)*weight_md(m)
103 . + ( rby(10)*vi(1)*vi(1)
104 . + rby(11)*vi(2)*vi(2)
105 . + rby(12)*vi(3)*vi(3))*weight_md(m)
106 encint=zero
107 xmasst=zero
108 xmomtt=zero
109 ymomtt=zero
110 zmomtt=zero
111 encin2t=zero
112 enrot2t=zero
113C
114 IF(n2d==0) THEN
115 IF (nsn>=10.OR.iparit>0) THEN
116 DO i=1,nsn
117 n = nod(i)
118 mas=ms(n)*weight_md(n)
119 wewe2 = (1-weight_md(n))*weight(n)
120 vg(1)=v(1,n)
121 vg(2)=v(2,n)
122 vg(3)=v(3,n)
123 encint=encint - ( vg(1)*vg(1)
124 . + vg(2)*vg(2)
125 . + vg(3)*vg(3))*mas
126 encin2t=encin2t - ( vg(1)*vg(1)
127 . + vg(2)*vg(2)
128 . + vg(3)*vg(3))*ms(n)*wewe2
129 xmomtt=xmomtt-vg(1)*mas
130 ymomtt=ymomtt-vg(2)*mas
131 zmomtt=zmomtt-vg(3)*mas
132 vg(1)=vr(1,n)
133 vg(2)=vr(2,n)
134 vg(3)=vr(3,n)
135 enrott=enrott - ( vg(1)*vg(1)
136 . + vg(2)*vg(2)
137 . + vg(3)*vg(3))*in(n)*weight_md(n)
138 enrot2t=enrot2t - ( vg(1)*vg(1)
139 . + vg(2)*vg(2)
140 . + vg(3)*vg(3))*in(n)*wewe2
141 xmasst=xmasst-mas
142 ENDDO
143 ELSE
144 DO i=1,nsn
145 n = nod(i)
146 mas=ms(n)*weight_md(n)
147 wewe2 = (1-weight_md(n))*weight(n)
148 vg(1)=v(1,n)
149 vg(2)=v(2,n)
150 vg(3)=v(3,n)
151 encint=encint - ( vg(1)*vg(1)
152 . + vg(2)*vg(2)
153 . + vg(3)*vg(3))*mas
154 encin2t=encin2t - ( vg(1)*vg(1)
155 . + vg(2)*vg(2)
156 . + vg(3)*vg(3))*ms(n)*wewe2
157 xmomtt=xmomtt-vg(1)*mas
158 ymomtt=ymomtt-vg(2)*mas
159 zmomtt=zmomtt-vg(3)*mas
160 vg(1)=vr(1,n)
161 vg(2)=vr(2,n)
162 vg(3)=vr(3,n)
163 enrott=enrott - ( vg(1)*vg(1)
164 . + vg(2)*vg(2)
165 . + vg(3)*vg(3))*in(n)*weight_md(n)
166 enrot2t=enrot2t - ( vg(1)*vg(1)
167 . + vg(2)*vg(2)
168 . + vg(3)*vg(3))*in(n)*wewe2
169 xmasst=xmasst-mas
170C
171 ENDDO
172 ENDIF
173C
174 ELSE ! n2d =/ 0
175C
176 IF (nsn>=10.OR.iparit>0) THEN
177 DO i=1,nsn
178 n = nod(i)
179 mas=ms_2d(n)*weight_md(n)
180 wewe2 = (1-weight_md(n))*weight(n)
181 vg(1)=v(1,n)
182 vg(2)=v(2,n)
183 vg(3)=v(3,n)
184 encint=encint - ( vg(1)*vg(1)
185 . + vg(2)*vg(2)
186 . + vg(3)*vg(3))*mas
187 encin2t=encin2t - ( vg(1)*vg(1)
188 . + vg(2)*vg(2)
189 . + vg(3)*vg(3))*ms_2d(n)*wewe2
190 xmomtt=xmomtt-vg(1)*mas
191 ymomtt=ymomtt-vg(2)*mas
192 zmomtt=zmomtt-vg(3)*mas
193 vg(1)=vr(1,n)
194 vg(2)=vr(2,n)
195 vg(3)=vr(3,n)
196 enrott=enrott - ( vg(1)*vg(1)
197 . + vg(2)*vg(2)
198 . + vg(3)*vg(3))*in(n)*weight_md(n)
199 enrot2t=enrot2t - ( vg(1)*vg(1)
200 . + vg(2)*vg(2)
201 . + vg(3)*vg(3))*in(n)*wewe2
202 xmasst=xmasst-mas
203 ENDDO
204 ELSE
205 DO i=1,nsn
206 n = nod(i)
207 mas=ms_2d(n)*weight_md(n)
208 wewe2 = (1-weight_md(n))*weight(n)
209 vg(1)=v(1,n)
210 vg(2)=v(2,n)
211 vg(3)=v(3,n)
212 encint=encint - ( vg(1)*vg(1)
213 . + vg(2)*vg(2)
214 . + vg(3)*vg(3))*mas
215 encin2t=encin2t - ( vg(1)*vg(1)
216 . + vg(2)*vg(2)
217 . + vg(3)*vg(3))*ms_2d(n)*wewe2
218 xmomtt=xmomtt-vg(1)*mas
219 ymomtt=ymomtt-vg(2)*mas
220 zmomtt=zmomtt-vg(3)*mas
221 vg(1)=vr(1,n)
222 vg(2)=vr(2,n)
223 vg(3)=vr(3,n)
224 enrott=enrott - ( vg(1)*vg(1)
225 . + vg(2)*vg(2)
226 . + vg(3)*vg(3))*in(n)*weight_md(n)
227 enrot2t=enrot2t - ( vg(1)*vg(1)
228 . + vg(2)*vg(2)
229 . + vg(3)*vg(3))*in(n)*wewe2
230 xmasst=xmasst-mas
231C
232 ENDDO
233 ENDIF
234C
235 ENDIF
236 ELSE
237C RBY AVEC SENSOR : PAS DE MASSES OU INERTIE AJOUTEE
238 IF(n2d==0) THEN
239 mas=ms(m)*weight_md(m)
240 ELSE
241 mas=ms_2d(m)*weight_md(m)
242 ENDIF
243 vg(1)=vr(1,m)
244 vg(2)=vr(2,m)
245 vg(3)=vr(3,m)
246C
247 enrott= - ( vg(1)*vg(1)
248 . + vg(2)*vg(2)
249 . + vg(3)*vg(3))*in(m)*weight_md(m)
250C
251
252 vg(1)=v(1,m)
253 vg(2)=v(2,m)
254 vg(3)=v(3,m)
255 encint= - ( vg(1)*vg(1)
256 . + vg(2)*vg(2)
257 . + vg(3)*vg(3))*mas
258 xmasst=-mas
259 xmomtt=-vg(1)*mas
260 ymomtt=-vg(2)*mas
261 zmomtt=-vg(3)*mas
262C
263 ENDIF
264 ELSE
265 IF(isens==0)THEN
266 dt05 = half*dt1
267 IF(idyna>0) dt05=(dy_g-one)*dt1
268 vg(1)=vr(1,m)+ar(1,m)*dt05
269 vg(2)=vr(2,m)+ar(2,m)*dt05
270 vg(3)=vr(3,m)+ar(3,m)*dt05
271 vi(1)=rby(1)*vg(1)+rby(2)*vg(2)+rby(3)*vg(3)
272 vi(2)=rby(4)*vg(1)+rby(5)*vg(2)+rby(6)*vg(3)
273 vi(3)=rby(7)*vg(1)+rby(8)*vg(2)+rby(9)*vg(3)
274C
275 enrott= - ( vg(1)*vg(1)
276 . + vg(2)*vg(2)
277 . + vg(3)*vg(3))*in(m)*weight_md(m)
278 . + ( rby(10)*vi(1)*vi(1)
279 . + rby(11)*vi(2)*vi(2)
280 . + rby(12)*vi(3)*vi(3))*weight_md(m)
281 encint=zero
282 xmasst=zero
283 xmomtt=zero
284 ymomtt=zero
285 zmomtt=zero
286 encin2t=zero
287 enrot2t=zero
288C
289C vectorisation si nsn>=10 ou si p/on active
290 IF(n2d==0) THEN
291 IF (nsn>=10.OR.iparit>0) THEN
292 DO i=1,nsn
293C
294 n = nod(i)
295C
296 mas=ms(n)*weight_md(n)
297 wewe2 = (1-weight_md(n))*weight(n)
298 vg(1)=v(1,n)+a(1,n)*dt05
299 vg(2)=v(2,n)+a(2,n)*dt05
300 vg(3)=v(3,n)+a(3,n)*dt05
301 encint=encint - ( vg(1)*vg(1)
302 . + vg(2)*vg(2)
303 . + vg(3)*vg(3))*mas
304 encin2t=encin2t - ( vg(1)*vg(1)
305 . + vg(2)*vg(2)
306 . + vg(3)*vg(3))*ms(n)*wewe2
307 xmomtt=xmomtt-vg(1)*mas
308 ymomtt=ymomtt-vg(2)*mas
309 zmomtt=zmomtt-vg(3)*mas
310 vg(1)=vr(1,n)+ar(1,n)*dt05
311 vg(2)=vr(2,n)+ar(2,n)*dt05
312 vg(3)=vr(3,n)+ar(3,n)*dt05
313 enrott=enrott - ( vg(1)*vg(1)
314 . + vg(2)*vg(2)
315 . + vg(3)*vg(3))*in(n)*weight_md(n)
316 enrot2t=enrot2t - ( vg(1)*vg(1)
317 . + vg(2)*vg(2)
318 . + vg(3)*vg(3))*in(n)*wewe2
319 xmasst=xmasst-mas
320C
321 ENDDO
322 ELSE
323 DO i=1,nsn
324C
325 n = nod(i)
326C
327 mas=ms(n)*weight_md(n)
328 wewe2 = (1-weight_md(n))*weight(n)
329 vg(1)=v(1,n)+a(1,n)*dt05
330 vg(2)=v(2,n)+a(2,n)*dt05
331 vg(3)=v(3,n)+a(3,n)*dt05
332 encint=encint - ( vg(1)*vg(1)
333 . + vg(2)*vg(2)
334 . + vg(3)*vg(3))*mas
335 encin2t=encin2t - ( vg(1)*vg(1)
336 . + vg(2)*vg(2)
337 . + vg(3)*vg(3))*ms(n)*wewe2
338 xmomtt=xmomtt-vg(1)*mas
339 ymomtt=ymomtt-vg(2)*mas
340 zmomtt=zmomtt-vg(3)*mas
341 vg(1)=vr(1,n)+ar(1,n)*dt05
342 vg(2)=vr(2,n)+ar(2,n)*dt05
343 vg(3)=vr(3,n)+ar(3,n)*dt05
344 enrott=enrott - ( vg(1)*vg(1)
345 . + vg(2)*vg(2)
346 . + vg(3)*vg(3))*in(n)*weight_md(n)
347 enrot2t=enrot2t - ( vg(1)*vg(1)
348 . + vg(2)*vg(2)
349 . + vg(3)*vg(3))*in(n)*wewe2
350 xmasst=xmasst-mas
351C
352 ENDDO
353 ENDIF
354C
355 ELSE ! N2D =/0
356C
357 IF (nsn>=10.OR.iparit>0) THEN
358 DO i=1,nsn
359C
360 n = nod(i)
361C
362 mas=ms_2d(n)*weight_md(n)
363 wewe2 = (1-weight_md(n))*weight(n)
364 vg(1)=v(1,n)+a(1,n)*dt05
365 vg(2)=v(2,n)+a(2,n)*dt05
366 vg(3)=v(3,n)+a(3,n)*dt05
367 encint=encint - ( vg(1)*vg(1)
368 . + vg(2)*vg(2)
369 . + vg(3)*vg(3))*mas
370 encin2t=encin2t - ( vg(1)*vg(1)
371 . + vg(2)*vg(2)
372 . + vg(3)*vg(3))*ms_2d(n)*wewe2
373 xmomtt=xmomtt-vg(1)*mas
374 ymomtt=ymomtt-vg(2)*mas
375 zmomtt=zmomtt-vg(3)*mas
376 vg(1)=vr(1,n)+ar(1,n)*dt05
377 vg(2)=vr(2,n)+ar(2,n)*dt05
378 vg(3)=vr(3,n)+ar(3,n)*dt05
379 enrott=enrott - ( vg(1)*vg(1)
380 . + vg(2)*vg(2)
381 . + vg(3)*vg(3))*in(n)*weight_md(n)
382 enrot2t=enrot2t - ( vg(1)*vg(1)
383 . + vg(2)*vg(2)
384 . + vg(3)*vg(3))*in(n)*wewe2
385 xmasst=xmasst-mas
386C
387 ENDDO
388 ELSE
389 DO i=1,nsn
390C
391 n = nod(i)
392C
393 mas=ms_2d(n)*weight_md(n)
394 wewe2 = (1-weight_md(n))*weight(n)
395 vg(1)=v(1,n)+a(1,n)*dt05
396 vg(2)=v(2,n)+a(2,n)*dt05
397 vg(3)=v(3,n)+a(3,n)*dt05
398 encint=encint - ( vg(1)*vg(1)
399 . + vg(2)*vg(2)
400 . + vg(3)*vg(3))*mas
401 encin2t=encin2t - ( vg(1)*vg(1)
402 . + vg(2)*vg(2)
403 . + vg(3)*vg(3))*ms_2d(n)*wewe2
404 xmomtt=xmomtt-vg(1)*mas
405 ymomtt=ymomtt-vg(2)*mas
406 zmomtt=zmomtt-vg(3)*mas
407 vg(1)=vr(1,n)+ar(1,n)*dt05
408 vg(2)=vr(2,n)+ar(2,n)*dt05
409 vg(3)=vr(3,n)+ar(3,n)*dt05
410 enrott=enrott - ( vg(1)*vg(1)
411 . + vg(2)*vg(2)
412 . + vg(3)*vg(3))*in(n)*weight_md(n)
413 enrot2t=enrot2t - ( vg(1)*vg(1)
414 . + vg(2)*vg(2)
415 . + vg(3)*vg(3))*in(n)*wewe2
416 xmasst=xmasst-mas
417C
418 ENDDO
419 ENDIF
420C
421 ENDIF
422 ELSE
423C RBY AVEC SENSOR : PAS DE MASSES OU INERTIE AJOUTEE
424 dt05 = half*dt1
425 IF(idyna>0) dt05=(dy_g-one)*dt1
426 vg(1)=vr(1,m)+ar(1,m)*dt05
427 vg(2)=vr(2,m)+ar(2,m)*dt05
428 vg(3)=vr(3,m)+ar(3,m)*dt05
429C
430 enrott= - ( vg(1)*vg(1)
431 . + vg(2)*vg(2)
432 . + vg(3)*vg(3))*in(m)*weight_md(m)
433C
434 IF(n2d==0) THEN
435 mas=ms(m)*weight_md(m)
436 ELSE
437 mas=ms_2d(m)*weight_md(m)
438 ENDIF
439 vg(1)=v(1,m)+a(1,m)*dt05
440 vg(2)=v(2,m)+a(2,m)*dt05
441 vg(3)=v(3,m)+a(3,m)*dt05
442 encint= - ( vg(1)*vg(1)
443 . + vg(2)*vg(2)
444 . + vg(3)*vg(3))*mas
445 xmasst=-mas
446 xmomtt=-vg(1)*mas
447 ymomtt=-vg(2)*mas
448 zmomtt=-vg(3)*mas
449 ENDIF
450 ENDIF
451C
452 enrot_t=enrot_t + enrott*half
453 encin_t=encin_t + encint*half
454 enrot2_t=enrot2_t + enrot2t*half
455 encin2_t=encin2_t + encin2t*half
456 xmass_t=xmass_t + xmasst
457 xmomt_t=xmomt_t + xmomtt
458 ymomt_t=ymomt_t + ymomtt
459 zmomt_t=zmomt_t + zmomtt
460C
461 RETURN
462 END
463!||====================================================================
464!|| rbe2cor ../engine/source/constraints/general/rbody/rgbcor.F
465!||--- called by ------------------------------------------------------
466!|| resol ../engine/source/engine/resol.F
467!||--- calls -----------------------------------------------------
468!|| prerbe2 ../engine/source/constraints/general/rbe2/rbe2f.F
469!|| rbe2cor0 ../engine/source/constraints/general/rbody/rgbcor.F
470!||--- uses -----------------------------------------------------
471!|| imp_dyna ../engine/share/modules/impbufdef_mod.F
472!||====================================================================
473 SUBROUTINE rbe2cor(IRBE2 ,LRBE2 ,X ,V ,VR ,
474 2 SKEW ,ISKEW ,ITAB ,WEIGHT,A ,
475 3 AR ,MS ,IN ,WEIGHT_MD)
476C-----------------------------------------------
477 USE imp_dyna
478C----6---------------------------------------------------------------7---------8
479C I m p l i c i t T y p e s
480C-----------------------------------------------
481#include "implicit_f.inc"
482#include "comlock.inc"
483C-----------------------------------------------
484C C o m m o n B l o c k s
485C-----------------------------------------------
486#include "com04_c.inc"
487#include "scr11_c.inc"
488#include "param_c.inc"
489C-----------------------------------------------------------------
490C D u m m y A r g u m e n t s
491C-----------------------------------------------
492 INTEGER IRBE2(NRBE2L,*),LRBE2(*)
493 INTEGER WEIGHT(*),ISKEW(*),ITAB(*),WEIGHT_MD(*)
494C REAL
495 my_real
496 . X(3,*) ,V(3,*) ,VR(3,*),SKEW(*),
497 . A(3,*),AR(3,*),IN(*),MS(*)
498C-----------------------------------------------
499C L o c a l V a r i a b l e s
500C-----------------------------------------------
501 INTEGER J,K,N,KK,IAD,M,
502 . JT(3,NRBE2),JR(3,NRBE2),NM,NN,ISK,NSN,IRAD
503C REAL
504 my_real
505 . enrot_t,encin_t,xmass_t,
506 . xmomt_t,ymomt_t,zmomt_t,encin2_t,enrot2_t
507C-----------------------------------------------
508 CALL prerbe2(irbe2 ,jt ,jr )
509 enrot_t =zero
510 encin_t =zero
511 xmass_t =zero
512 xmomt_t =zero
513 ymomt_t =zero
514 zmomt_t =zero
515 encin2_t=zero
516 enrot2_t=zero
517!$OMP DO SCHEDULE(DYNAMIC,1)
518 DO n=1,nrbe2
519 iad = irbe2(1,n)
520 m = irbe2(3,n)
521 nsn = irbe2(5,n)
522 isk = irbe2(7,n)
523 irad = irbe2(11,n)
524 CALL rbe2cor0(v ,vr ,x ,nsn ,lrbe2(iad+1),
525 2 jt(1,n),jr(1,n),m ,weight,a ,
526 3 ar ,ms ,in ,itab ,irad ,
527 4 enrot_t,encin_t,xmass_t,xmomt_t,ymomt_t,
528 5 zmomt_t,weight_md,encin2_t,enrot2_t)
529 ENDDO
530!$OMP END DO NOWAIT
531#include "lockon.inc"
532 enrot=enrot + enrot_t
533 encin=encin + encin_t
534 xmass=xmass + xmass_t
535 xmomt=xmomt + xmomt_t
536 ymomt=ymomt + ymomt_t
537 zmomt=zmomt + zmomt_t
538 encin2=encin2 + encin2_t
539 enrot2=enrot2 + enrot2_t
540#include "lockoff.inc"
541C
542 RETURN
543 END
544!||====================================================================
545!|| rbe2cor0 ../engine/source/constraints/general/rbody/rgbcor.F
546!||--- called by ------------------------------------------------------
547!|| rbe2cor ../engine/source/constraints/general/rbody/rgbcor.F
548!||--- uses -----------------------------------------------------
549!|| imp_dyna ../engine/share/modules/impbufdef_mod.f
550!||====================================================================
551 SUBROUTINE rbe2cor0(V ,VR ,X ,NSL ,ISL ,
552 2 JT ,JR ,M ,WEIGHT,A ,
553 3 AR ,MS ,IN ,ITAB ,IRAD ,
554 4 ENROT_T,ENCIN_T,XMASS_T,XMOMT_T,YMOMT_T,
555 5 ZMOMT_T,WEIGHT_MD,ENCIN2_T,ENROT2_T)
556C-----------------------------------------------
557 USE imp_dyna
558C-----------------------------------------------
559C I m p l i c i t T y p e s
560C-----------------------------------------------
561#include "implicit_f.inc"
562C-----------------------------------------------
563C D u m m y A r g u m e n t s
564C-----------------------------------------------
565 INTEGER NSL,ISL(*), ITAB(*), WEIGHT(*),
566 . WEIGHT_MD(*),JT(3),JR(3),M,IRAD
567C REAL
568 my_real
569 . v(3,*), vr(3,*), x(3,*),
570 . a(3,*),ar(3,*),in(*),ms(*),enrot_t,encin_t,xmass_t,
571 . xmomt_t,ymomt_t,zmomt_t,encin2_t,enrot2_t
572C-----------------------------------------------
573C C o m m o n B l o c k s
574C-----------------------------------------------
575#include "com08_c.inc"
576#include "parit_c.inc"
577#include "impl1_c.inc"
578#include "com01_c.inc"
579C-----------------------------------------------
580C L o c a l V a r i a b l e s
581C-----------------------------------------------
582 INTEGER I, J, N, NS,ITRA,IROT
583C REAL
584 my_real
585 . VI(3),VG(3),DT05,MAS,WEWE2,WROT,WROT2,WTRA2
586C to keep enough accuracy in single precision
587 DOUBLE PRECISION
588 . ENROTT,ENCINT,XMASST,XMOMTT,YMOMTT,ZMOMTT,
589 . ENCIN2T,ENROT2T
590C======================================================================|
591C-----for the moment RBE2 est spheric ---
592 IF ((JT(1)+JT(2)+JT(3)) > 0) THEN
593 ITRA = 1
594 ELSE
595 itra = 0
596 END IF
597C-----in case of JR=0 and IRAD=0, Inertia0 of Main is supposed << In_s
598 IF ((jr(1)+jr(2)+jr(3)) >0 .OR. irad==0) THEN
599 irot = 1
600 ELSE
601 irot = 0
602 END IF
603
604 encint=zero
605 xmasst=zero
606 xmomtt=zero
607 ymomtt=zero
608 zmomtt=zero
609 encin2t=zero
610 enrot2t=zero
611 enrott =zero
612 IF(impl_s>0.AND.idyna==0)THEN
613C
614 IF (iroddl/=0) THEN
615 vg(1)=vr(1,m)
616 vg(2)=vr(2,m)
617 vg(3)=vr(3,m)
618C
619 wrot = weight_md(m)*irot
620 enrott= - ( vg(1)*vg(1)
621 . + vg(2)*vg(2)
622 . + vg(3)*vg(3))*in(m)*wrot
623 END IF !(IRODDL/=0) THEN
624 IF (nsl>=10.OR.iparit>0) THEN
625 DO i=1,nsl
626 n = isl(i)
627 mas=ms(n)*weight_md(n)*itra
628 wewe2 = (1-weight_md(n))*weight(n)
629 wtra2 = wewe2*itra
630 vg(1)=v(1,n)
631 vg(2)=v(2,n)
632 vg(3)=v(3,n)
633 encint=encint - ( vg(1)*vg(1)
634 . + vg(2)*vg(2)
635 . + vg(3)*vg(3))*mas
636 encin2t=encin2t - ( vg(1)*vg(1)
637 . + vg(2)*vg(2)
638 . + vg(3)*vg(3))*ms(n)*wtra2
639 xmomtt=xmomtt-vg(1)*mas
640 ymomtt=ymomtt-vg(2)*mas
641 zmomtt=zmomtt-vg(3)*mas
642 xmasst=xmasst-mas
643 ENDDO
644 IF (iroddl/=0) THEN
645 DO i=1,nsl
646 n = isl(i)
647 wewe2 = (1-weight_md(n))*weight(n)
648 vg(1)=vr(1,n)
649 vg(2)=vr(2,n)
650 vg(3)=vr(3,n)
651 wrot = weight_md(n)*irot
652 wrot2 =wewe2*irot
653 enrott=enrott - ( vg(1)*vg(1)
654 . + vg(2)*vg(2)
655 . + vg(3)*vg(3))*in(n)*wrot
656 enrot2t=enrot2t - ( vg(1)*vg(1)
657 . + vg(2)*vg(2)
658 . + vg(3)*vg(3))*in(n)*wrot2
659 ENDDO
660 END IF !(IRODDL/=0) THEN
661 ELSE
662 DO i=1,nsl
663 n = isl(i)
664 mas=ms(n)*weight_md(n)*itra
665 wewe2 = (1-weight_md(n))*weight(n)
666 wtra2 = wewe2*itra
667 vg(1)=v(1,n)
668 vg(2)=v(2,n)
669 vg(3)=v(3,n)
670 encint=encint - ( vg(1)*vg(1)
671 . + vg(2)*vg(2)
672 . + vg(3)*vg(3))*mas
673 encin2t=encin2t - ( vg(1)*vg(1)
674 . + vg(2)*vg(2)
675 . + vg(3)*vg(3))*ms(n)*wtra2
676 xmomtt=xmomtt-vg(1)*mas
677 ymomtt=ymomtt-vg(2)*mas
678 zmomtt=zmomtt-vg(3)*mas
679 xmasst=xmasst-mas
680C
681 ENDDO
682 IF (iroddl/=0) THEN
683 DO i=1,nsl
684 n = isl(i)
685 wewe2 = (1-weight_md(n))*weight(n)
686 vg(1)=vr(1,n)
687 vg(2)=vr(2,n)
688 vg(3)=vr(3,n)
689 wrot = weight_md(n)*irot
690 wrot2 =wewe2*irot
691 enrott=enrott - ( vg(1)*vg(1)
692 . + vg(2)*vg(2)
693 . + vg(3)*vg(3))*in(n)*wrot
694 enrot2t=enrot2t - ( vg(1)*vg(1)
695 . + vg(2)*vg(2)
696 . + vg(3)*vg(3))*in(n)*wrot2
697 ENDDO
698 END IF !(IRODDL/=0) THEN
699 ENDIF
700 ELSE
701 dt05 = half*dt1
702C
703 IF(idyna>0) dt05=(dy_g-one)*dt1
704C
705 IF (iroddl/=0) THEN
706 vg(1)=vr(1,m)+ar(1,m)*dt05
707 vg(2)=vr(2,m)+ar(2,m)*dt05
708 vg(3)=vr(3,m)+ar(3,m)*dt05
709C
710 enrott= - ( vg(1)*vg(1)
711 . + vg(2)*vg(2)
712 . + vg(3)*vg(3))*in(m)*weight_md(m)*irot
713 END IF !(IRODDL/=0) THEN
714C vectorisation si nsn>=10 ou si p/on active
715 IF (nsl>=10.OR.iparit>0) THEN
716 DO i=1,nsl
717C
718 n = isl(i)
719C
720 mas=ms(n)*weight_md(n)*itra
721 wewe2 = (1-weight_md(n))*weight(n)
722 wtra2 = wewe2*itra
723 vg(1)=v(1,n)+a(1,n)*dt05
724 vg(2)=v(2,n)+a(2,n)*dt05
725 vg(3)=v(3,n)+a(3,n)*dt05
726 encint=encint - ( vg(1)*vg(1)
727 . + vg(2)*vg(2)
728 . + vg(3)*vg(3))*mas
729 encin2t=encin2t - ( vg(1)*vg(1)
730 . + vg(2)*vg(2)
731 . + vg(3)*vg(3))*ms(n)*wtra2
732 xmomtt=xmomtt-vg(1)*mas
733 ymomtt=ymomtt-vg(2)*mas
734 zmomtt=zmomtt-vg(3)*mas
735 xmasst=xmasst-mas
736C
737 ENDDO
738 IF (iroddl/=0) THEN
739 DO i=1,nsl
740C
741 n = isl(i)
742 wewe2 = (1-weight_md(n))*weight(n)
743 vg(1)=vr(1,n)+ar(1,n)*dt05
744 vg(2)=vr(2,n)+ar(2,n)*dt05
745 vg(3)=vr(3,n)+ar(3,n)*dt05
746 wrot = weight_md(n)*irot
747 wrot2 =wewe2*irot
748 enrott=enrott - ( vg(1)*vg(1)
749 . + vg(2)*vg(2)
750 . + vg(3)*vg(3))*in(n)*wrot
751 enrot2t=enrot2t - ( vg(1)*vg(1)
752 . + vg(2)*vg(2)
753 . + vg(3)*vg(3))*in(n)*wrot2
754 ENDDO
755 ENDIF !(IRODDL/=0) THEN
756 ELSE
757 DO i=1,nsl
758C
759 n = isl(i)
760C
761 mas=ms(n)*weight_md(n)*itra
762 wewe2 = (1-weight_md(n))*weight(n)
763 wtra2 = wewe2*itra
764 vg(1)=v(1,n)+a(1,n)*dt05
765 vg(2)=v(2,n)+a(2,n)*dt05
766 vg(3)=v(3,n)+a(3,n)*dt05
767 encint=encint - ( vg(1)*vg(1)
768 . + vg(2)*vg(2)
769 . + vg(3)*vg(3))*mas
770 encin2t=encin2t - ( vg(1)*vg(1)
771 . + vg(2)*vg(2)
772 . + vg(3)*vg(3))*ms(n)*wtra2
773 xmomtt=xmomtt-vg(1)*mas
774 ymomtt=ymomtt-vg(2)*mas
775 zmomtt=zmomtt-vg(3)*mas
776 xmasst=xmasst-mas
777C
778 ENDDO
779 IF (iroddl/=0) THEN
780 DO i=1,nsl
781C
782 n = isl(i)
783 wewe2 = (1-weight_md(n))*weight(n)
784 vg(1)=vr(1,n)+ar(1,n)*dt05
785 vg(2)=vr(2,n)+ar(2,n)*dt05
786 vg(3)=vr(3,n)+ar(3,n)*dt05
787 wrot = weight_md(n)*irot
788 wrot2 =wewe2*irot
789 enrott=enrott - ( vg(1)*vg(1)
790 . + vg(2)*vg(2)
791 . + vg(3)*vg(3))*in(n)*wrot
792 enrot2t=enrot2t - ( vg(1)*vg(1)
793 . + vg(2)*vg(2)
794 . + vg(3)*vg(3))*in(n)*wrot2
795 ENDDO
796 END IF !(IRODDL/=0) THEN
797 ENDIF
798 ENDIF
799C
800 enrot_t=enrot_t + enrott*half
801 encin_t=encin_t + encint*half
802 enrot2_t=enrot2_t + enrot2t*half
803 encin2_t=encin2_t + encin2t*half
804 xmass_t=xmass_t + xmasst
805 xmomt_t=xmomt_t + xmomtt
806 ymomt_t=ymomt_t + ymomtt
807 zmomt_t=zmomt_t + zmomtt
808C
809 RETURN
810 END
811
prerbe2
subroutine prerbe2(irbe2, jt, jr)
Definition kinchk.F:1974
imp_dyna
Definition impbufdef_mod.F:314
impbufdef_mod
Definition impbufdef_mod.F:36
rbe2cor
subroutine rbe2cor(irbe2, lrbe2, x, v, vr, skew, iskew, itab, weight, a, ar, ms, in, weight_md)
Definition rgbcor.F:476
rgbcor
subroutine rgbcor(v, vr, x, rby, nod, nby, skew, iskew, fs, itab, weight, a, ar, ms, in, enrot_t, encin_t, xmass_t, xmomt_t, ymomt_t, zmomt_t, isens, weight_md, encin2_t, enrot2_t, ms_2d)
Definition rgbcor.F:37
rbe2cor0
subroutine rbe2cor0(v, vr, x, nsl, isl, jt, jr, m, weight, a, ar, ms, in, itab, irad, enrot_t, encin_t, xmass_t, xmomt_t, ymomt_t, zmomt_t, weight_md, encin2_t, enrot2_t)
Definition rgbcor.F:556