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 34 of file rbyonf.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE elbufdef_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "param_c.inc"
55#include "units_c.inc"
56#include "task_c.inc"
57#include "scr17_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER IPARG(NPARG,*), IPARI(*), IXS(NIXS,*), IXQ(NIXQ,*),
62 . IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*),
63 . ITAB(*), ITABM1(*),IGRV(NIGRV,*),IBGR(*),IPART(*),
64 . ISKWN(LISKN,*), NPBY(NNPBY,*),ITAG(*),LPBY(*), IXTG(NIXTG,*),
65 . WEIGHT(*), FR_RBY2(*), ICFIELD(SIZFIELD,*), LCFIELD(*), TAGSLV_RBY(*)
66 INTEGER ONOF,NRBYNF,PRI_OFF
67C REAL
68 my_real
69 . skew(lskew,*),ms(*),in(*),rby(nrby,*),x(3,*),
70 . v(3,*),vr(3,*),partsav(*)
71 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I, J ,ITEMP(10),K, K0, N,NSL,NN,IAD,ONOF1,ISENS,IACTI,
76 . ONFELT,K1,K2,K3,K4,K5,K6,K7,K8,K9
77C======================================================================|
78C MODIFICATION DES RIGID BODY
79C-------------------------------------------
80 k1=1+lipart1*npart+2*9*npart
81 k2=k1+numels
82 k3=k2+numelq
83 k4=k3+numelc
84 k5=k4+numelt
85 k6=k5+numelp
86 k7=k6+numelr
87C
88 DO i=1,numnod
89 itag(i)=0
90 ENDDO
91C
92 DO i=1,numnod
93 itag(i+numnod)=0
94 ENDDO
95C
96 DO n=1,nrbykin
97 isens=npby(4,n)
98 iacti=npby(7,n)
99 IF(isens==0.AND.iacti==1.AND.npby(1,n)>0)
100 . itag(npby(1,n)+numnod)=n
101 ENDDO
102C
103 DO i=1,(nrbynf+9)/10
104 READ(iin,'(10I10)')(itemp(j),j=1,10)
105 DO 120 j=1,10
106 IF(itemp(j)==0) GOTO 120
107 k = 1
108 DO n=1,nrbykin
109 IF(npby(1,n)>0) THEN
110 IF(itemp(j)==itab(npby(1,n))) GOTO 110
111 ENDIF
112 k=k+npby(2,n)
113 ENDDO
114 n = 0
115 110 CONTINUE
116C En SPMD, il faut communiquer le RB concerne si N<>0 sur un proc
117C si rigid body present sur le proc N = rb trouve
118 IF(n/=0) n = n*weight(npby(1,n))
119C reduction pour retrouver la valeur de N (N = 0 partout sauf sur le proc main)
120 IF(nspmd > 1) THEN
121 CALL spmd_glob_isum9(n,1)
122C broadcast de N sur tous les procs
123 CALL spmd_ibcast(n,n,1,1,0,2)
124 ENDIF
125C si N = 0, alors le rby n avait ete trouve sur aucun proc
126 IF(n==0) GOTO 120
127C
128 IF(onof==0)THEN
129 IF(ispmd==0)
130 . WRITE(iout,'(/A,I9,A)')' RIGID BODY:',itemp(j),' SET OFF'
131 ELSE
132 IF(ispmd==0)
133 . WRITE(iout,'(/A,I9,A)')' RIGID BODY:',itemp(j),' SET ON'
134 ENDIF
135C
136 isens=npby(4,n)
137 iacti=npby(7,n)
138 IF(isens/=0)THEN
139 IF(iacti>1)THEN
140C body waiting for deactivation, override sensor request.
141 iacti=1
142 npby(7,n)=iacti
143 ELSEIF(iacti<0)THEN
144C body waiting for activation, override sensor request.
145 iacti=0
146 npby(7,n)=iacti
147 ENDIF
148 ENDIF
149C
150 onfelt= 1-onof
151 ! ONFELT= 0 : deactivation of elements
152 ! ONFELT= 1 : activation of elements
153 onof1 = onof
154 pri_off = 0 ! full printout
155 IF(onof==1.AND.npby(7,n)/=0) onof1 = -1
156 ! ONOF1 = -1 nothing against rbody (rbody was already active)
157 ! = 0 ! deactivate rbody
158 ! = 1 ! activate rbody
159 CALL rbypid(
160 1 iparg ,ipari ,ms ,in ,
161 2 ixs ,ixq ,ixc ,ixt ,ixp ,
162 3 ixr ,skew ,itab ,itabm1 ,iskwn ,
163 4 npby(1,n),onof1 ,itag ,lpby(k) ,
164 5 x ,v ,vr ,rby(1,n),
165 6 ixtg ,npby ,rby ,lpby ,0 ,
166 7 fr_rby2 ,n ,onfelt ,weight ,partsav ,
167 8 ipart(k3),npby(2,n) ,elbuf_tab,pri_off)
168 npby(7,n)=onof
169 120 CONTINUE
170 ENDDO
171C------------------------------------
172C tag des noeuds secnds rby avec gravite ou load/centri
173C pour calcul du travail des forces externes
174C-------------------------------------
175 tagslv_rby(1:numnod)=0
176C
177 k=0
178 DO n=1,nrbykin
179 onof1=npby(7,n)
180 nsl=npby(2,n)
181 IF(onof1>=1)THEN
182 DO i=1,nsl
183 tagslv_rby(lpby(i+k))=n
184 ENDDO
185 ENDIF
186 k=k+nsl
187 ENDDO
188C
189 DO k=1,ngrav
190 nn =igrv(1,k)
191 iad=igrv(4,k)
192 DO i=iad,iad+nn-1
193 n=iabs(ibgr(i))
194 IF(tagslv_rby(n) /= 0)THEN
195 ibgr(i) = -n
196 ELSE
197 ibgr(i) = n
198 ENDIF
199 ENDDO
200 ENDDO
201C
202 DO k=1,nloadc
203 nn = icfield(1,k)
204 iad = icfield(4,k)
205 DO i=1,nn
206 n=lcfield(iad+i-1)
207 IF(tagslv_rby(n) /= 0)lcfield(iad+i-1) = -n
208 END DO
209 ENDDO
210C-----------
211 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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:48
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:523

◆ 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 223 of file rbyonf.F.

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