OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rbyonf.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "scr17_c.inc"
#include "com08_c.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine rbyonf (iparg, ipari, ms, in, ixs, ixq, ixc, ixt, ixp, ixr, skew, itab, itabm1, iskwn, npby, onof, nrbynf, itag, lpby, rby, x, v, vr, ixtg, igrv, ibgr, weight, fr_rby2, partsav, ipart, elbuf_tab, icfield, lcfield, tagslv_rby)
subroutine rbysens (iparg, ipari, ms, in, ixs, ixq, ixc, ixt, ixp, ixr, skew, itab, itabm1, iskwn, npby, itag, lpby, fsky, nsensor, rby, x, v, vr, ixtg, igrv, ibgr, sensor_tab, a, ar, fsav, stifn, stifr, fani, weight, dmast, dinert, bufsf, fr_rby2, partsav, ipart, elbuf_tab, icfield, lcfield, tagslv_rby)

Function/Subroutine Documentation

◆ rbyonf()

subroutine rbyonf ( integer, dimension(nparg,*) iparg,
integer, dimension(*) ipari,
ms,
in,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
skew,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
integer, dimension(liskn,*) iskwn,
integer, dimension(nnpby,*) npby,
integer onof,
integer nrbynf,
integer, dimension(*) itag,
integer, dimension(*) lpby,
rby,
x,
v,
vr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nigrv,*) igrv,
integer, dimension(*) ibgr,
integer, dimension(*) weight,
integer, dimension(*) fr_rby2,
partsav,
integer, dimension(*) ipart,
type(elbuf_struct_), dimension(ngroup) elbuf_tab,
integer, dimension(sizfield,*) icfield,
integer, dimension(*) lcfield,
integer, dimension(*) tagslv_rby )

Definition at line 35 of file rbyonf.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE elbufdef_mod
46 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com01_c.inc"
55#include "com04_c.inc"
56#include "param_c.inc"
57#include "units_c.inc"
58#include "task_c.inc"
59#include "scr17_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER IPARG(NPARG,*), IPARI(*), IXS(NIXS,*), IXQ(NIXQ,*),
64 . IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*),
65 . ITAB(*), ITABM1(*),IGRV(NIGRV,*),IBGR(*),IPART(*),
66 . ISKWN(LISKN,*), NPBY(NNPBY,*),ITAG(*),LPBY(*), IXTG(NIXTG,*),
67 . WEIGHT(*), FR_RBY2(*), ICFIELD(SIZFIELD,*), LCFIELD(*), TAGSLV_RBY(*)
68 INTEGER ONOF,NRBYNF,PRI_OFF
69C REAL
70 my_real
71 . skew(lskew,*),ms(*),in(*),rby(nrby,*),x(3,*),
72 . v(3,*),vr(3,*),partsav(*)
73 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I, J ,ITEMP(10),K, N,NSL,NN,IAD,ONOF1,ISENS,IACTI,
78 . ONFELT,K1,K2,K3,K4,K5,K6,K7
79C======================================================================|
80C modification of the rigid bodies
81C-------------------------------------------
82 k1=1+lipart1*npart+2*9*npart
83 k2=k1+numels
84 k3=k2+numelq
85 k4=k3+numelc
86 k5=k4+numelt
87 k6=k5+numelp
88 k7=k6+numelr
89C
90 DO i=1,numnod
91 itag(i)=0
92 ENDDO
93C
94 DO i=1,numnod
95 itag(i+numnod)=0
96 ENDDO
97C
98 DO n=1,nrbykin
99 isens=npby(4,n)
100 iacti=npby(7,n)
101 IF(isens==0.AND.iacti==1.AND.npby(1,n)>0)
102 . itag(npby(1,n)+numnod)=n
103 ENDDO
104C
105 DO i=1,(nrbynf+9)/10
106 READ(iin,'(10I10)')(itemp(j),j=1,10)
107 DO 120 j=1,10
108 IF(itemp(j)==0) GOTO 120
109 k = 1
110 DO n=1,nrbykin
111 IF(npby(1,n)>0) THEN
112 IF(itemp(j)==itab(npby(1,n))) GOTO 110
113 ENDIF
114 k=k+npby(2,n)
115 ENDDO
116 n = 0
117 110 CONTINUE
118C in spmd, the concerned rigid body must be communicated if n<>0 on a processor
119C si rigid body present sur le proc N = rb trouve
120 IF(n/=0) n = n*weight(npby(1,n))
121C reduction to find the value of n (n = 0 everywhere except on the main processor)
122 IF(nspmd > 1) THEN
123 CALL spmd_glob_isum9(n,1)
124C broadcast of n to all processors
125 CALL spmd_ibcast(n,n,1,1,0,2)
126 ENDIF
127C if N = 0, then the rby had not been found on any proc
128 IF(n==0) GOTO 120
129C
130 IF(onof==0)THEN
131 IF(ispmd==0)
132 . WRITE(iout,'(/A,I9,A)')' rigid body:',ITEMP(J),' set off'
133 ELSE
134 IF(ISPMD==0)
135 . WRITE(IOUT,'(/a,i9,a)')' rigid body:',ITEMP(J),' set on'
136 ENDIF
137C
138 ISENS=NPBY(4,N)
139 IACTI=NPBY(7,N)
140 IF(ISENS/=0)THEN
141 IF(IACTI>1)THEN
142C body waiting for deactivation, override sensor request.
143 IACTI=1
144 NPBY(7,N)=IACTI
145 ELSEIF(IACTI<0)THEN
146C body waiting for activation, override sensor request.
147 IACTI=0
148 NPBY(7,N)=IACTI
149 ENDIF
150 ENDIF
151C
152 ONFELT= 1-ONOF
153 ! ONFELT= 0 : deactivation of elements
154 ! ONFELT= 1 : activation of elements
155 ONOF1 = ONOF
156 PRI_OFF = 0 ! full printout
157.AND. IF(ONOF==1NPBY(7,N)/=0) ONOF1 = -1
158 ! ONOF1 = -1 nothing against rbody (rbody was already active)
159 ! = 0 ! deactivate rbody
160 ! = 1 ! activate rbody
161 CALL RBYPID(
162 1 IPARG ,IPARI ,MS ,IN ,
163 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
164 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
165 4 NPBY(1,N),ONOF1 ,ITAG ,LPBY(K) ,
166 5 X ,V ,VR ,RBY(1,N),
167 6 IXTG ,NPBY ,RBY ,LPBY ,0 ,
168 7 FR_RBY2 ,N ,ONFELT ,WEIGHT ,PARTSAV ,
169 8 IPART(K3),NPBY(2,N) ,ELBUF_TAB,PRI_OFF)
170 NPBY(7,N)=ONOF
171 120 CONTINUE
172 ENDDO
173C------------------------------------
174C tag of the secondary rby nodes with gravity or load/centrifugal
175C for calculation of the work of external forces
176C-------------------------------------
177 TAGSLV_RBY(1:NUMNOD)=0
178C
179 K=0
180 DO N=1,NRBYKIN
181 ONOF1=NPBY(7,N)
182 NSL=NPBY(2,N)
183 IF(ONOF1>=1)THEN
184 DO I=1,NSL
185 TAGSLV_RBY(LPBY(I+K))=N
186 ENDDO
187 ENDIF
188 K=K+NSL
189 ENDDO
190C
191 DO K=1,NGRAV
192 NN =IGRV(1,K)
193 IAD=IGRV(4,K)
194 DO I=IAD,IAD+NN-1
195 N=IABS(IBGR(I))
196 IF(TAGSLV_RBY(N) /= 0)THEN
197 IBGR(I) = -N
198 ELSE
199 IBGR(I) = N
200 ENDIF
201 ENDDO
202 ENDDO
203C
204 DO K=1,NLOADC
205 NN = ICFIELD(1,K)
206 IAD = ICFIELD(4,K)
207 DO I=1,NN
208 N=LCFIELD(IAD+I-1)
209 IF(TAGSLV_RBY(N) /= 0)LCFIELD(IAD+I-1) = -N
210 END DO
211 ENDDO
212C-----------
213 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:520

◆ rbysens()

subroutine rbysens ( integer, dimension(nparg,*) iparg,
integer, dimension(*) ipari,
ms,
in,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
skew,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
integer, dimension(liskn,*) iskwn,
integer, dimension(nnpby,*) npby,
integer, dimension(*) itag,
integer, dimension(*) lpby,
fsky,
integer, intent(in) nsensor,
rby,
x,
v,
vr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nigrv,*) igrv,
integer, dimension(*) ibgr,
type(sensor_str_), dimension(nsensor), intent(in) sensor_tab,
a,
ar,
fsav,
stifn,
stifr,
fani,
integer, dimension(*) weight,
dmast,
dinert,
bufsf,
integer, dimension(3,*) fr_rby2,
partsav,
integer, dimension(*) ipart,
type(elbuf_struct_), dimension(ngroup) elbuf_tab,
integer, dimension(sizfield,*) icfield,
integer, dimension(*) lcfield,
integer, dimension(*) tagslv_rby )

Definition at line 226 of file rbyonf.F.

235C-----------------------------------------------
236C M o d u l e s
237C-----------------------------------------------
238 USE elbufdef_mod
239 USE sensor_mod
240 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
241C-----------------------------------------------
242C I m p l i c i t T y p e s
243C-----------------------------------------------
244#include "implicit_f.inc"
245C-----------------------------------------------
246C C o m m o n B l o c k s
247C-----------------------------------------------
248#include "com01_c.inc"
249#include "com04_c.inc"
250#include "com08_c.inc"
251#include "param_c.inc"
252#include "units_c.inc"
253#include "task_c.inc"
254#include "parit_c.inc"
255#include "scr17_c.inc"
256C-----------------------------------------------
257C D u m m y A r g u m e n t s
258C-----------------------------------------------
259 INTEGER ,INTENT(IN) :: NSENSOR
260 INTEGER IPARG(NPARG,*), IPARI(*), IXS(NIXS,*), IXQ(NIXQ,*),
261 . IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*),
262 . ITAB(*), ITABM1(*),IGRV(NIGRV,*),IBGR(*),
263 . ISKWN(LISKN,*), NPBY(NNPBY,*),ITAG(*),LPBY(*), IXTG(NIXTG,*),
264 . WEIGHT(*), IPART(*), FR_RBY2(3,*), ICFIELD(SIZFIELD,*), LCFIELD(*), TAGSLV_RBY(*)
265C REAL
266 my_real
267 . skew(lskew,*),ms(*),in(*),rby(nrby,*),x(3,*),
268 . v(3,*),vr(3,*),fsky(*), a(3,*) ,ar(3,*),
269 . fsav(nthvki,*), stifn(*),stifr(*),fani(3,*),
270 . dmast, dinert, bufsf(*),partsav(*)
271 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
272 TYPE(SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
273C-----------------------------------------------
274C L o c a l V a r i a b l e s
275C-----------------------------------------------
276 INTEGER I ,K, N,NSL,NN,IAD,ONOF,ONOF1,ISENS,IACTI,
277 .
278 .
279 . ONFELT,K1,K2,K3,K4,K5,K6,K7,IFAIL,ELT_ACTIV,PRI_OFF
280 my_real
281 . crit
282C======================================================================|
283C ACIVATION/DEACTIVATION DES RIGID BODY
284C Deactivation ::
285C Elements are activated first
286C Rbody is deactivated at the end (after 2 cycles)
287C Activation ::
288C Rbody is activated at the same time as the elements are deactivated
289C-------------------------------------------
290 k1=1+lipart1*npart+2*9*npart
291 k2=k1+numels
292 k3=k2+numelq
293 k4=k3+numelc
294 k5=k4+numelt
295 k6=k5+numelp
296 k7=k6+numelr
297C-------------------------------------------
298C ITAG :: Main node of active rbody w/o sensor => Rbody number
299C is used for initialization of mass & inertia if the rbody is included into the rbody being activated
300C i.e. mass and inertia of the "sub-rbody" secnd nodes must not be counted twice
301C-------------------------------------------
302 DO i=1,numnod
303 itag(i)=0
304 ENDDO
305C
306 DO i=1,numnod
307 itag(i+numnod)=0
308 ENDDO
309C
310 DO n=1,nrbykin
311 isens = npby(4,n)
312 iacti = npby(7,n)
313 IF(isens==0 .AND. iacti==1 .AND. npby(1,n)>0)
314 . itag(npby(1,n)+numnod)=n
315 ENDDO
316C-------------------------------------------
317C 1. Looking for sensor deactivation & rbody activation
318C-------------------------------------------
319 k = 1
320 onfelt=1
321 onof1 =0
322 elt_activ =0
323 DO n=1,nrbykin
324 isens = npby(4,n)
325 iacti = npby(7,n)
326 ifail = npby(18,n)
327 crit = rby(30,n)
328 IF(isens/=0 .AND. (ifail/=1 .OR. crit < one))THEN
329 IF (iacti==0 .AND. tt <= sensor_tab(isens)%TSTART) THEN
330C
331C - rbody is activated and elements are deactivated at the same time
332C - unless failure criteria has been reached already
333C
334 IF (ispmd==0) THEN
335 WRITE(iout,'(/a,i9,a)')' rigid body:',
336 . NPBY(6,N),' set on'
337 WRITE(ISTDO,'(/a,i9,a)')' rigid body:',
338 . NPBY(6,N),' on'
339 ENDIF
340C
341 ONOF = 1 ! activate rbody
342 ONFELT= 0 ! deactivation of elements
343 PRI_OFF = 0 ! full printout
344 CALL RBYPID( IPARG ,IPARI ,MS ,IN ,
345 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
346 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
347 4 NPBY(1,N),ONOF ,ITAG ,LPBY(K) ,
348 5 X ,V ,VR ,RBY(1,N),
349 6 IXTG ,NPBY ,RBY ,LPBY ,1 ,
350 7 FR_RBY2 ,N ,ONFELT,WEIGHT ,PARTSAV ,
351 8 IPART(K3),NPBY(2,N) ,ELBUF_TAB,PRI_OFF)
352 ONOF1 = 1 ! at least 1 rbody is activated or deactivated
353 NPBY(7,N)=1
354.AND. ELSEIF (IACTI>1 TT <= SENSOR_TAB(ISENS)%TSTART) THEN
355C
356C - rbody is waiting for deactivation :
357C Sensor status changes again => override previous request unless failure criteria was already reached.
358C
359 ONOF = -1 ! nothing against rbody (rbody was not yet deactivated)
360 ONFELT= 0 ! deactivation of elements
361 PRI_OFF = 0 ! full printout
362 CALL RBYPID( IPARG ,IPARI ,MS ,IN ,
363 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
364 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
365 4 NPBY(1,N),ONOF ,ITAG ,LPBY(K) ,
366 5 X ,V ,VR ,RBY(1,N),
367 6 IXTG ,NPBY ,RBY ,LPBY ,1 ,
368 7 FR_RBY2 ,N ,ONFELT,WEIGHT ,PARTSAV ,
369 8 IPART(K3),NPBY(2,N) ,ELBUF_TAB,PRI_OFF)
370 NPBY(7,N)=1
371 ENDIF
372 ENDIF
373 K=K+NPBY(2,N)
374 ENDDO
375.AND. IF(ONFELT==0IPARIT/=0)THEN ! reset forces of deactivated elements.
376 DO I=1,8*LSKY
377 FSKY(I)=0.0
378 ENDDO
379 ENDIF
380C-------------------------------------------
381C 2. Looking for sensors activation & deactivation of the rby
382C - elements will be activated yet, but rbody will be activated 2 cycles after
383C-------------------------------------------
384 K = 1
385 DO N=1,NRBYKIN
386 IACTI=NPBY(7,N)
387 ISENS=NPBY(4,N)
388 IFAIL = NPBY(18,N)
389 CRIT = RBY(30,N)
390.AND..OR. IF(ISENS/=0 (IFAIL/=1 CRIT < ONE) )THEN
391.AND. IF (IACTI == 1 TT > SENSOR_TAB(ISENS)%TSTART) THEN
392 IF( TT> ZERO)THEN
393 IACTI=4
394 NPBY(7,N)=IACTI
395 IF (ISPMD==0) THEN
396 WRITE(IOUT,'(/a,i9,a)')' rigid body:',
397 . NPBY(6,N),' will be set off within 2 cycles'
398 WRITE(ISTDO,'(/a,i9,a)')' rigid body:',
399 . NPBY(6,N),' will be set off within 2 cycles'
400 ENDIF
401C
402 ONOF = -1 ! nothing against rbody
403 ONFELT= 1 ! activation of elements
404 PRI_OFF = 0 ! full printout
405 CALL RBYPID( IPARG ,IPARI ,MS ,IN ,
406 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
407 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
408 4 NPBY(1,N),ONOF ,ITAG ,LPBY(K) ,
409 5 X ,V ,VR ,RBY(1,N),
410 6 IXTG ,NPBY ,RBY ,LPBY ,1 ,
411 7 FR_RBY2 ,N ,ONFELT,WEIGHT ,PARTSAV ,
412 8 IPART(K3),NPBY(2,N) ,ELBUF_TAB, PRI_OFF)
413 ELT_ACTIV = 1 ! elts of at least 1 rby are activated
414 ELSE ! IF(TT>0.)THEN
415 IF (ISPMD==0) THEN
416 WRITE(IOUT,'(/a,i9,a)')' rigid body:',
417 . npby(6,n),' SET OFF'
418 WRITE(istdo,'(/A,I9,A)')' RIGID BODY:',
419 . npby(6,n),' OFF'
420 ENDIF
421C
422 onof = 0 ! deactivate rbody
423 onfelt= 1 ! activation of elements
424 pri_off = 0 ! full printout
425 CALL rbypid( iparg ,ipari ,ms ,in ,
426 2 ixs ,ixq ,ixc ,ixt ,ixp ,
427 3 ixr ,skew ,itab ,itabm1 ,iskwn ,
428 4 npby(1,n),onof ,itag ,lpby(k) ,
429 5 x ,v ,vr ,rby(1,n),
430 6 ixtg ,npby ,rby ,lpby ,1 ,
431 7 fr_rby2 ,n ,onfelt,weight ,partsav ,
432 8 ipart(k3),npby(2,n) ,elbuf_tab, pri_off)
433 npby(7,n)=0
434 onof1 = 1 ! at least 1 rbody is activated or deactivated
435 elt_activ = 1 ! elts of at least 1 rby are activated
436 ENDIF
437 ELSEIF(iacti==2)THEN
438C
439C Sensor has activated or Failure criteria has been reached ::
440C Last cycle wrt rbody deactivation <=> the rbody is deactivated (nothing wrt elements)
441C
442 IF (ispmd==0) THEN
443 WRITE(iout,'(/A,I9,A)')' RIGID BODY:',
444 . npby(6,n),' SET OFF'
445 WRITE(istdo,'(/a,i9,a)')' rigid body:',
446 . NPBY(6,N),' off'
447 ENDIF
448C
449 ONOF = 0 ! deactivate rbody
450 ONFELT= -1 ! nothing against elements
451 PRI_OFF = 0 ! full printout
452 CALL RBYPID( IPARG ,IPARI ,MS ,IN ,
453 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
454 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
455 4 NPBY(1,N),ONOF ,ITAG ,LPBY(K) ,
456 5 X ,V ,VR ,RBY(1,N),
457 6 IXTG ,NPBY ,RBY ,LPBY ,1 ,
458 7 FR_RBY2 ,N ,ONFELT,WEIGHT ,PARTSAV ,
459 8 IPART(K3),NPBY(2,N) ,ELBUF_TAB, PRI_OFF)
460 NPBY(7,N)=0
461 ONOF1 = 1 ! at least 1 rbody is activated or deactivated
462 ENDIF
463 ENDIF
464 K=K+NPBY(2,N)
465 ENDDO
466C-------------------------------------------
467C 3. Looking for failure criteria
468C - failure criteria will deactivate the rby
469C - elements will be activated yet, but rbody will be activated 2 cycles after
470C-------------------------------------------
471 K = 1
472 DO N=1,NRBYKIN
473 IACTI=NPBY(7,N)
474 ISENS=NPBY(4,N)
475 IFAIL = NPBY(18,N)
476 CRIT = RBY(30,N)
477.AND..AND. IF(IACTI >= 1IFAIL == 1CRIT >= ONE)THEN ! If rbody is active
478 IF(IACTI==1)THEN ! and failure is detected
479 IF(TT>0.)THEN
480 IACTI=4
481 NPBY(7,N)=IACTI
482 IF (ISPMD==0) THEN
483 WRITE(IOUT,'(/a,i9,a)')' rigid body failure : rigid body:',
484 . NPBY(6,N),' will be set off within 2 cycles'
485 WRITE(ISTDO,'(/a,i9,a)')' rigid body failure : rigid body:',
486 . NPBY(6,N),' will be set off within 2 cycles'
487 ENDIF
488C
489 ONOF = -1 ! nothing against rbody
490 ONFELT= 1 ! activation of elements
491 PRI_OFF = 0 ! full printout
492 CALL RBYPID( IPARG ,IPARI ,MS ,IN ,
493 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
494 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
495 4 NPBY(1,N),ONOF ,ITAG ,LPBY(K) ,
496 5 X ,V ,VR ,RBY(1,N),
497 6 IXTG ,NPBY ,RBY ,LPBY ,1 ,
498 7 FR_RBY2 ,N ,ONFELT,WEIGHT ,PARTSAV ,
499 8 IPART(K3),NPBY(2,N) ,ELBUF_TAB, PRI_OFF)
500 ELT_ACTIV = 1 ! elts of at least 1 rby are activated
501 ELSE ! IF(TT>0.)THEN (Failure most probably does not occur at time zero)
502 IF (ISPMD==0) THEN
503 WRITE(IOUT,'(/a,i9,a)')' rigid body failure : rigid body:',
504 . NPBY(6,N),' set off'
505 WRITE(ISTDO,'(/a,i9,a)')' rigid body failure : rigid body:',
506 . NPBY(6,N),' off'
507 ENDIF
508C
509 ONOF = 0 ! deactivate rbody
510 ONFELT= 1 ! activation of elements
511 PRI_OFF = 0 ! full printout
512 CALL RBYPID( IPARG ,IPARI ,MS ,IN ,
513 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
514 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
515 4 NPBY(1,N),ONOF ,ITAG ,LPBY(K) ,
516 5 X ,V ,VR ,RBY(1,N),
517 6 IXTG ,NPBY ,RBY ,LPBY ,1 ,
518 7 FR_RBY2 ,N ,ONFELT,WEIGHT ,PARTSAV ,
519 8 IPART(K3),NPBY(2,N) ,ELBUF_TAB, PRI_OFF)
520 NPBY(7,N)=0
521 ONOF1 = 1 ! at least 1 rbody is activated or deactivated
522 ENDIF
523 ELSEIF(IACTI==2)THEN
524C
525C Sensor has activated or Failure criteria has been reached ::
526C Last cycle wrt rbody deactivation <=> the rbody is deactivated (nothing wrt elements)
527C
528 IF (ISPMD==0) THEN
529 WRITE(IOUT,'(/a,i9,a)')' rigid body failure : rigid body:',
530 . NPBY(6,N),' set off'
531 WRITE(ISTDO,'(/a,i9,a)')' rigid body failure : rigid body:',
532 . NPBY(6,N),' off'
533 ENDIF
534C
535 ONOF = 0 ! deactivate rbody
536 ONFELT= -1 ! nothing against elements
537 PRI_OFF = 0 ! full printout
538 CALL RBYPID( IPARG ,IPARI ,MS ,IN ,
539 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
540 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
541 4 NPBY(1,N),ONOF ,ITAG ,LPBY(K) ,
542 5 X ,V ,VR ,RBY(1,N),
543 6 IXTG ,NPBY ,RBY ,LPBY ,1 ,
544 7 FR_RBY2 ,N ,ONFELT,WEIGHT ,PARTSAV ,
545 8 IPART(K3),NPBY(2,N) ,ELBUF_TAB, PRI_OFF)
546 NPBY(7,N)=0
547 ONOF1 = 1 ! at least 1 rbody is activated or deactivated
548 ENDIF
549 ENDIF
550 K=K+NPBY(2,N)
551 ENDDO
552C-------------------------------------------
553C 4. Loop over other rby in case of elts activation
554C - in case of hierarchy of rby elt is activated only
555C - if all rbys are deactivated
556C-------------------------------------------
557 IF(ELT_ACTIV == 1)THEN
558 K = 1
559 DO N=1,NRBYKIN
560 IACTI=NPBY(7,N)
561.EQ. IF(IACTI1)THEN
562 ONOF = -1 ! nothing against rbody
563 ONFELT= 0 ! deactivation of elements
564 PRI_OFF = 1 ! printout for changed elements only
565 CALL RBYPID( IPARG ,IPARI ,MS ,IN ,
566 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
567 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
568 4 NPBY(1,N),ONOF ,ITAG ,LPBY(K) ,
569 5 X ,V ,VR ,RBY(1,N),
570 6 IXTG ,NPBY ,RBY ,LPBY ,1 ,
571 7 FR_RBY2 ,N ,ONFELT,WEIGHT ,PARTSAV ,
572 8 IPART(K3),NPBY(2,N) ,ELBUF_TAB,PRI_OFF)
573 ENDIF
574 K=K+NPBY(2,N)
575 ENDDO
576 ENDIF
577C-------------------------------------------
578 DO N=1,NRBYKIN
579 IACTI=NPBY(7,N)
580 IF(IACTI>1)THEN
581 IACTI=IACTI-1
582 ENDIF
583 NPBY(7,N)=IACTI
584 ENDDO
585C-------------------------------------
586C tag of the secondary rby nodes with gravity or load/centrifugal
587C for calculation of the work of external forces
588C-------------------------------------
589 IF(ONOF1==0) GOTO 200
590C
591 TAGSLV_RBY(1:NUMNOD)=0
592C
593 K=0
594 DO N=1,NRBYKIN
595 ONOF1=NPBY(7,N)
596 NSL=NPBY(2,N)
597 IF(ONOF1>=1)THEN
598 DO I=1,NSL
599 TAGSLV_RBY(LPBY(I+K))=N
600 ENDDO
601 ENDIF
602 K=K+NSL
603 ENDDO
604C
605 DO K=1,NGRAV
606 NN =IGRV(1,K)
607 IAD=IGRV(4,K)
608 DO I=IAD,IAD+NN-1
609 N=IABS(IBGR(I))
610 IF(TAGSLV_RBY(N) /= 0)THEN
611 IBGR(I) = -N
612 ELSE
613 IBGR(I) = N
614 ENDIF
615 ENDDO
616 ENDDO
617C
618 DO K=1,NLOADC
619 NN = ICFIELD(1,K)
620 IAD = ICFIELD(4,K)
621 DO I=1,NN
622 N=LCFIELD(IAD+I-1)
623 IF(TAGSLV_RBY(N) /= 0)LCFIELD(IAD+I-1) = -N
624 END DO
625 ENDDO
626C
627 200 CONTINUE
628 RETURN
629C
rbypid
subroutine rbypid(iparg, ipari, ms, in, ixs, ixq, ixc, ixt, ixp, ixr, skew, itab, itabm1, iskwn, npby, onof, itag, lpby, x, v, vr, rby, ixtg, npbyi, rbyi, lpbyi, iacts, fr_rby2, nrb, onfelt, weight, partsav, ipartc, nsn, elbuf_tab, pri_off)
Definition rbypid.F:49