OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rbody.F File Reference
#include "implicit_f.inc"
#include "analyse_name.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "scr17_c.inc"
#include "scr03_c.inc"
#include "param_c.inc"
#include "r2r_c.inc"
#include "sphcom.inc"
#include "sms_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_rbody (rby, npby, lpby, itab, itabm1, igrnod, igrsurf, ibfv, igrv, ibgr, sensors, imerge, unitab, iskn, nom_opt, numsl, knod2els, knod2elc, knod2eltg, knod2el1d, knod2elq, itagnd, icdns10, lsubmodel, icfield, lcfield)
subroutine setrbyon (ixs, ixc, ixtg, igrnod, igrnrby, isoloff, isheoff, itrioff, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, ixq, iquaoff, knod2elq, nod2elq, lsubmodel)
subroutine seteloff (ixs, ixc, ixt, ixp, ixr, ixtg, iparg, isoloff, isheoff, itruoff, ipouoff, iresoff, itrioff, igrnrby, igrnod, elbuf_str, iquaoff, ixq)

Function/Subroutine Documentation

◆ hm_read_rbody()

subroutine hm_read_rbody ( rby,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
type (group_), dimension(ngrnod) igrnod,
type (surf_), dimension(nsurf), target igrsurf,
integer, dimension(nifv,*) ibfv,
integer, dimension(nigrv,*) igrv,
integer, dimension(*) ibgr,
type (sensors_), intent(in) sensors,
integer, dimension(*) imerge,
type (unit_type_), intent(in) unitab,
integer, dimension(liskn,*) iskn,
integer, dimension(lnopt1,*) nom_opt,
integer numsl,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) knod2el1d,
integer, dimension(*) knod2elq,
integer, dimension(*) itagnd,
integer, dimension(*) icdns10,
type (submodel_data), dimension(*), intent(in) lsubmodel,
integer, dimension(sizfield,*) icfield,
integer, dimension(*) lcfield )

Definition at line 50 of file hm_read_rbody.F.

56C-------------------------------------
57C LECTURE STRUCTURE RIGIDES
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE my_alloc_mod
62 USE unitab_mod
63 USE r2r_mod
64 USE message_mod
65 USE groupdef_mod
66 USE submodel_mod
67 USE hm_option_read_mod
68 USE sensor_mod
69 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
70C-----------------------------------------------
71C I m p l i c i t T y p e s
72C-----------------------------------------------
73#include "implicit_f.inc"
74C-----------------------------------------------
75C A n a l y s e M o d u l e
76C-----------------------------------------------
77#include "analyse_name.inc"
78C-----------------------------------------------
79C C o m m o n B l o c k s
80C-----------------------------------------------
81#include "com04_c.inc"
82#include "units_c.inc"
83#include "scr17_c.inc"
84#include "scr03_c.inc"
85#include "param_c.inc"
86#include "r2r_c.inc"
87#include "sphcom.inc"
88#include "sms_c.inc"
89C-----------------------------------------------
90C D u m m y A r g u m e n t s
91C-----------------------------------------------
92 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
93 INTEGER NPBY(NNPBY,*), LPBY(*), ITAB(*), ITABM1(*)
94 INTEGER IBFV(NIFV,*)
95 INTEGER IGRV(NIGRV,*),IBGR(*),IMERGE(*),
96 . ISKN(LISKN,*),NUMSL,
97 . KNOD2ELS(*),KNOD2ELC(*),KNOD2ELTG(*),KNOD2EL1D(*),KNOD2ELQ(*),
98 . ITAGND(*),ICDNS10(*), ICFIELD(SIZFIELD,*), LCFIELD(*)
99 my_real rby(nrby,*)
100 INTEGER NOM_OPT(LNOPT1,*)
101C-----------------------------------------------
102 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
103 TYPE (SURF_) ,TARGET, DIMENSION(NSURF) :: IGRSURF
104 TYPE (SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
105 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
106C-----------------------------------------------
107C L o c a l V a r i a b l e s
108C-----------------------------------------------
109 INTEGER I, J, K, N, NSL, NSL0, NSKEW, IC,
110 . ISPHER, IGU,IGS,ISENS,ID,ICDG,
111 . JC,UID,IFLAGUNIT,SUB_INDEX,NRB,
112 . IFAIL,NRB_R2R
113 INTEGER IDSURF, ISU, NN, IAD, M, IOPT, IEXPAMS, NEL
114 CHARACTER MESS*40
115 CHARACTER(LEN=NCHARTITLE)::TITR,TITR1
116 CHARACTER(LEN=NCHARKEY)::KEY
117 my_real bid, mass, i1, i2, i3, i12, i23, i13, fn, ft, expn, expt
118 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
119 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TABSL
120 INTEGER, DIMENSION(:), POINTER :: INGR2USR
121 LOGICAL IS_AVAILABLE
122C-----------------------------------------------
123C E x t e r n a l F u n c t i o n s
124C-----------------------------------------------
125 INTEGER USR2SYS,NGR2USR,NODGRNR6
126C-----------------------------------------------
127C NPBY(NNPBY,NRBYKIN), NNPBY=17
128C 1 : main NODE
129C 2 : NUMBER OF SECONDARY NODES
130C 3 : ICOG
131C 4 : ISENS
132C 5 : FLAG SPHERICAL INERTIA
133C 6 : IDENTIFIER
134C 7 : 1 ON(1) OFF(0)
135C 8 : ISU
136C 9 : NSKEW
137C 10 : IEXPAMS (AMS - Hidden)
138C = 1 (default) : AMS expansion ; = 2 (Hidden) : No expansion
139C 11 : IAD => SECONDARY nodes LPBY(IAD+1:IAD+NSN)
140C 12 : RIGID BODY LEVEL (IN MERGE RELATIONS)
141C 13 : MERGING FLAG FOR THE main RIGID BODY
142C 14 : NUMBER OF SECONDARY NODES WITH MERGING FLAG = 1
143C 15 : NUMBER OF SECONDARY NODES WITH MERGING FLAG = 2
144C 16 : NUMBER OF SECONDARY NODES WITH MERGING FLAG = 3
145C 17 : IKREM
146C 18 : IFAIL
147C 19 : INITIAL NUMBER OF SECONDARY NODES (NSN_G)
148C-----------------------------------------------
149C RBY(NRBY,NRBYKIN), NRBY=25
150C LOADED DURING READING AFTER INITIALIZATION (including in RD ENGINE)
151C 1 : Added Mass 1..9 : Principal directions
152C 2..4: IXX, IYY, IZZ 10..12: Principal inertia I1, I2, I3
153C 5..7: IXY, IYZ, IXZ 13: Initial inertia of Main Node (cf deactivation of rbody)
154C 14: Rigid body mass
155C 15: Initial mass of main node (cf deactivation of rbody)
156C 17..25: Inertia matrix in global system
157C 26: FN : Normal force at failure (Ifail=1)
158C 27: FT : Shear force at failure (Ifail=1)
159C 28: EXPN (Ifail=1)
160C 29: EXPT (Ifail=1)
161C 30: CRIT (computed at each cycle in RD Engine)
162C=======================================================================
163 DATA mess/'RIGID BODY DEFINITION '/
164C=======================================================================
165 IF (numsl > 0) THEN
166 CALL my_alloc(tabsl,2,numsl)
167 tabsl=0
168 END IF
169
170 WRITE(iout,1000)
171C--------------------------------------------------
172C START BROWSING MODEL RBODY
173C--------------------------------------------------
174 is_available = .false.
175 CALL hm_option_start('/RBODY')
176C
177 CALL my_alloc(itag,numnod)
178 itag(1:numnod) = 0
179C
180 k=0
181 nrb=0
182 nrb_r2r=0
183C
184 DO n=1,nrbody
185C
186C--------------------------------------------------
187C EXTRACT DATAS OF /RBODY/... LINE
188C--------------------------------------------------
189C
190 nrb_r2r = nrb_r2r + 1
191 IF (nsubdom > 0) THEN
192 IF(tagrby(nrb_r2r) == 0) CALL hm_sz_r2r(tagrby,nrb_r2r,lsubmodel)
193 ENDIF
194C
195 key=''
196 CALL hm_option_read_key(lsubmodel,
197 . option_id = id,
198 . unit_id = uid,
199 . option_titr = titr,
200 . keyword2 = key,
201 . submodel_index = sub_index)
202 IF(key=='')THEN ! not a /RBODY/LAGMUL
203 nrb = nrb + 1
204C-------
205 iflagunit = 0
206 DO j=1,unitab%NUNITS
207 IF (unitab%UNIT_ID(j) == uid) THEN
208 iflagunit = 1
209 EXIT
210 ENDIF
211 ENDDO
212 IF (uid/=0.AND.iflagunit == 0) THEN
213 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
214 . i2=uid,i1=id,c1='rigid body',
215 . C2='rigid body',
216 . C3=TITR)
217 ENDIF
218C
219 NOM_OPT(1,NRB)=ID
220 CALL FRETITL(TITR,NOM_OPT(LNOPT1-LTITR+1,NRB),LTITR)
221C
222 CALL HM_GET_INTV('node_id',NPBY(1,NRB),IS_AVAILABLE,LSUBMODEL)
223 CALL HM_GET_INTV('sens_id',ISENS,IS_AVAILABLE,LSUBMODEL)
224 CALL HM_GET_INTV('skew_id',NSKEW,IS_AVAILABLE,LSUBMODEL)
225 CALL HM_GET_INTV('ispher',ISPHER,IS_AVAILABLE,LSUBMODEL)
226 CALL HM_GET_INTV('grnd_id',IGU,IS_AVAILABLE,LSUBMODEL)
227 CALL HM_GET_INTV('ikrem',ikrem,is_available,lsubmodel)
228 CALL hm_get_intv('ICoG',icdg,is_available,lsubmodel)
229 CALL hm_get_intv('surf_ID',idsurf,is_available,lsubmodel)
230 CALL hm_get_floatv('Mass',mass,is_available,lsubmodel,unitab)
231C
232 IF(ispher == 0) ispher=2
233 IF(icdg == 0)icdg=1
234c
235 IF(nskew == 0 .AND. sub_index /= 0 ) nskew = lsubmodel(sub_index)%SKEW
236 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
237 IF(nskew == iskn(4,j+1)) THEN
238 nskew=j+1
239 GO TO 100
240 ENDIF
241 ENDDO
242 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
243 . c1='RIGID BODY',
244 . c2='RIGID BODY',
245 . i2=nskew,i1=id,c3=titr)
246 100 CONTINUE
247C
248 rby(1,nrb) = mass
249C
250 isu=0
251 IF (idsurf/=0) THEN
252 ingr2usr => igrsurf(1:nsurf)%ID
253 isu=ngr2usr(idsurf,ingr2usr,nsurf)
254 IF (isu == 0) THEN
255 CALL ancmsg(msgid=158,anmode=aninfo,msgtype=msgerror,
256 . i2=idsurf,i1=id,c1=titr)
257 ELSEIF (igrsurf(isu)%TYPE/=101) THEN
258 titr1 = igrsurf(igs)%TITLE
259 CALL ancmsg(msgid=159,anmode=aninfo,msgtype=msgerror,
260 . i2=idsurf,c2=titr1,i1=id,c1=titr)
261 ENDIF
262 ENDIF
263 npby(8,nrb)=isu
264C
265 CALL hm_get_floatv('Jxx',i1,is_available,lsubmodel,unitab)
266 CALL hm_get_floatv('Jyy',i2,is_available,lsubmodel,unitab)
267 CALL hm_get_floatv('Jzz',i3,is_available,lsubmodel,unitab)
268 rby(2,nrb) = i1
269 rby(3,nrb) = i2
270 rby(4,nrb) = i3
271 CALL hm_get_floatv('Jxy',i12,is_available,lsubmodel,unitab)
272 CALL hm_get_floatv('Jyz',i23,is_available,lsubmodel,unitab)
273 CALL hm_get_floatv('Jxz',i13,is_available,lsubmodel,unitab)
274C
275 CALL hm_get_intv('Ioptoff',iopt,is_available,lsubmodel)
276 CALL hm_get_intv('Iexpams',iexpams,is_available,lsubmodel)
277C
278 CALL hm_get_intv('Ifail',ifail,is_available,lsubmodel)
279 npby(18,nrb)=ifail
280 IF(ifail==1)THEN
281 CALL hm_get_floatv('FN',fn,is_available,lsubmodel,unitab)
282 CALL hm_get_floatv('FT',ft,is_available,lsubmodel,unitab)
283 CALL hm_get_floatv('expN',expn,is_available,lsubmodel,unitab)
284 CALL hm_get_floatv('expT',expt,is_available,lsubmodel,unitab)
285 IF(fn==zero)fn=ep20
286 IF(ft==zero)ft=ep20
287 IF(expn==zero) expn=two
288 IF(expt==zero) expt=two
289 rby(26,nrb)=fn
290 rby(27,nrb)=ft
291 rby(28,nrb)=expn
292 rby(29,nrb)=expt
293 END IF
294C
295 rby(5,nrb) = i12
296 rby(6,nrb) = i23
297 rby(7,nrb) = i13
298 npby(1,nrb)= usr2sys(npby(1,nrb),itabm1,mess,id)
299!
300 DO jc=1,nmerged
301 IF (npby(1,nrb) == imerge(jc)) npby(1,nrb)=imerge(numcnod+jc)
302 ENDDO
303 CALL anodset(npby(1,nrb), check_rb_m)
304C
305 npby(11,nrb)=k
306 m = npby(1,nrb)
307 nsl = nodgrnr6(m,igu,igs,lpby(k+1),igrnod,itabm1,mess,id)
308c
309 DO i=1,nsl
310 itag(lpby(k+i)) = 1
311 ENDDO
312c
313 IF (ns10e > 0 ) THEN
314 CALL rigmodif_nd(nsl,lpby(k+1),itagnd,icdns10,id,titr,itab)
315 m = npby(1,nrb)
316 IF (itagnd(m)/=0) THEN
317 CALL ancmsg(msgid=1211,
318 . msgtype=msgerror,
319 . anmode=aninfo,
320 . i1=itab(m),
321 . c1='RBODY',
322 . i2=id,
323 . c2='RBODY')
324 END IF
325 END IF
326 npby(2,nrb)=nsl
327 npby(19,nrb)=nsl
328 DO j=1, nsl
329 CALL anodset(lpby(j+k), check_rb_s)
330 tabsl(1,j+k)=itab(lpby(j+k))
331 tabsl(2,j+k)=n
332 ENDDO
333C
334 IF(isens > 0)THEN
335 DO i=1,sensors%NSENSOR
336 IF (isens == sensors%SENSOR_TAB(i)%SENS_ID) npby(4,nrb)=i
337 ENDDO
338 IF(npby(4,nrb) == 0)THEN
339 titr1 = igrsurf(igs)%TITLE
340 CALL ancmsg(msgid=159,anmode=aninfo,msgtype=msgerror,
341 . i2=isens,c2=titr1,i1=id,c1=titr)
342 ENDIF
343 rby(1,nrb)=zero
344 rby(2,nrb)=zero
345 rby(3,nrb)=zero
346 rby(4,nrb)=zero
347 rby(5,nrb)=zero
348 rby(6,nrb)=zero
349 rby(7,nrb)=zero
350 nskew=0
351 icdg =0
352 ikrem=1
353 ENDIF
354 npby(5,nrb)=ispher
355 npby(6,nrb)=id
356 npby(17,nrb)=ikrem
357 IF(isens == 0)THEN
358 npby(7,nrb)=1
359 ELSE
360 npby(7,nrb)=0
361 ENDIF
362 npby(3,nrb) =icdg
363 npby(9,nrb) =nskew
364 IF(iexpams==0)THEN
365 iexpams=1
366 ELSEIF(iexpams==2)THEN
367 iexpams=0
368 END IF
369 npby(10,nrb)=iexpams
370 nsl0 = nsl
371 IF (nsubdom > 0) nsl0 = igrnod(igs)%R2R_ALL
372 IF (nsl0 == 0) THEN
373 CALL ancmsg(msgid=352,
374 . msgtype=msgwarning,
375 . anmode=aninfo_blind_2,
376 . i1=id,
377 . c1=titr)
378 ENDIF
379C
380 CALL spmdset(nrb,npby,nnpby,lpby,nsl,k)
381C
382 IF(isms==0)THEN
383 IF (isens/=0) THEN
384 WRITE(iout,1100) id,trim(titr),isens,itab(npby(1,nrb)),nsl,
385 . idsurf,ispher
386 ELSE
387 WRITE(iout,1111) id,trim(titr),itab(npby(1,nrb)),nsl,
388 . idsurf,iskn(4,nskew),ispher,ikrem,icdg,
389 . (rby(j,nrb),j=1,7)
390 ENDIF
391 ELSE
392 IF (isens/=0) THEN
393 WRITE(iout,1102) id,trim(titr),isens,itab(npby(1,nrb)),nsl,
394 . idsurf,ispher
395 ELSE
396 WRITE(iout,1112) id,trim(titr),itab(npby(1,nrb)),nsl,
397 . idsurf,iskn(4,nskew),ispher,ikrem,icdg,
398 . (rby(j,nrb),j=1,7)
399 ENDIF
400 WRITE(iout,1103)
401 END IF
402 IF(ifail==1)THEN
403 WRITE(iout,1151)
404 WRITE(iout,1152) fn, expn, ft, expt
405 END IF
406 WRITE(iout,1201)
407 WRITE(iout,1202) (itab(lpby(i+k)),i=1,nsl)
408 k=k+nsl
409C-------------------------------
410C VITESSE FIXE SUR main EN ROT
411C-------------------------------
412 DO j=1,nfxvel
413 IF(iabs(ibfv(1,j)) == npby(1,nrb).AND.
414 . ibfv(2,j)-10*(ibfv(2,j)/10)>=4)THEN
415 ibfv(6,j)=n
416 ENDIF
417 ENDDO
418C-------------------------------
419C main BELONGS TO MESH
420C-------------------------------
421 nel=knod2els(npby(1,nrb)+1) -knod2els(npby(1,nrb))
422 . +knod2elc(npby(1,nrb)+1) -knod2elc(npby(1,nrb))
423 . +knod2eltg(npby(1,nrb)+1)-knod2eltg(npby(1,nrb))
424 . +knod2el1d(npby(1,nrb)+1)-knod2el1d(npby(1,nrb))
425 . +knod2elq(npby(1,nrb)+1)-knod2elq(npby(1,nrb))
426 IF(nel/=0)THEN
427 IF(isms==0)THEN
428 id=nom_opt(1,nrb)
429 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,nrb),ltitr)
430 CALL ancmsg(msgid=448,
431 . msgtype=msgwarning,
432 . anmode=aninfo_blind_2,
433 . i1=itab(npby(1,nrb)),
434 . i2=id,
435 . c1=titr)
436 ELSE
437 id=nom_opt(1,nrb)
438 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,nrb),ltitr)
439 CALL ancmsg(msgid=1066,
440 . msgtype=msgerror,
441 . anmode=aninfo_blind_1,
442 . i1=itab(npby(1,nrb)),
443 . i2=id,
444 . c1=titr)
445 END IF
446 END IF
447 END IF ! IF(KEY=='')THEN
448 ENDDO
449C-------------------------------------
450C Recherche des Rigid Body ID doubles
451C-------------------------------------
452 CALL udouble(npby(6,1),nnpby,nrbykin,mess,0,bid)
453C-------------------------------------
454C Recherche des Main Node ID doubles
455C-------------------------------------
456 ic = 442
457 i = 0
458 CALL newdbl(npby(1,1),nnpby,nrbykin,itab,442,aninfo_blind_1,
459 . nom_opt)
460C------------------------------------
461C tag des noeuds SECONDARYs rby avec gravite ou load/centri
462C pour calcul du travail des forces externes
463C-------------------------------------
464 DO i=1,numnod
465 itag(i)=0
466 ENDDO
467 k=0
468 DO n=1,nrbykin
469 nsl=npby(2,n)
470 IF(npby(7,n)/=0)THEN
471 DO i=1,nsl
472 itag(lpby(i+k))=1
473 ENDDO
474 ENDIF
475 k=k+nsl
476 ENDDO
477C
478 DO k=1,ngrav
479 nn =igrv(1,k)
480 iad=igrv(4,k)
481 DO i=1,nn
482 n=ibgr(i+iad-1)
483 IF(itag(n) == 1)ibgr(i+iad-1) = -n
484 ENDDO
485 ENDDO
486C
487 DO k=1,nloadc
488 nn = icfield(1,k)
489 iad = icfield(4,k)
490 DO i=1,nn
491 n=lcfield(iad+i-1)
492 IF(itag(n) == 1)lcfield(iad+i-1) = -n
493 END DO
494 ENDDO
495C------------------------------------
496 IF(ALLOCATED(itag)) DEALLOCATE(itag)
497 IF(ALLOCATED(tabsl))DEALLOCATE(tabsl)
498C------------------------------------
499 RETURN
500C
5011000 FORMAT(/
502 . ' rigid body definitions '/
503 . ' ---------------------- '/)
5041100 FORMAT( /5X,'rigid body id ',i10,1x,a
505 . /10x,'SENSOR ',i10
506 . /10x,'PRIMARY NODE ',i10
507 . /10x,'NUMBER OF NODES ',i10
508 . /10x,'SURFACE LINKED TO BODY ',i10
509 . /10x,'SPHERICAL INERTIA FLAG ',i10)
5101102 FORMAT( /5x,'RIGID BODY ID ',i10,1x,a
511 . /10x,'SENSOR ',i10
512 . /10x,'PRIMARY NODE ',i10
513 . /10x,'NUMBER OF NODES ',i10
514 . /10x,'SURFACE LINKED TO BODY ',i10
515 . /10x,'SPHERICAL INERTIA FLAG ',i10)
5161103 FORMAT( /10x,'NO AMS EXPANSION OVERALL THE RBODY ')
5171111 FORMAT( /5x,'RIGID BODY ID ',i10,1x,a
518 . /10x,'PRIMARY NODE ',i10
519 . /10x,'NUMBER OF NODES ',i10
520 . /10x,'SURFACE LINKED TO BODY ',i10
521 . /10x,'SKEW NUMBER ',i10
522 . /10x,'SPHERICAL INERTIA FLAG ',i10
523 . /10x,'REMOVE SECONDARY NODES FROM RIGID WALL(IF=0)',i10
524 . /10x,'CENTER OF MASS FLAG ',i10
525 . /10x,'ADDED MASS ',1pg20.4
526 . /10x,'ADDED INERTIA ',1p6g20.4)
5271112 FORMAT( /5x,'RIGID BODY ID ',i10,1x,a
528 . /10x,'PRIMARY NODE ',i10
529 . /10x,'NUMBER OF NODES ',i10
530 . /10x,'SURFACE LINKED TO BODY ',i10
531 . /10x,'SKEW NUMBER ',i10
532 . /10x,'SPHERICAL INERTIA FLAG ',i10
533 . /10x,'REMOVE SECONDARY NODES FROM RIGID WALL(IF=0)',i10
534 . /10x,'CENTER OF MASS FLAG ',i10
535 . /10x,'ADDED MASS ',1pg20.4
536 . /10x,'ADDED INERTIA ',1p6g20.4)
5371151 FORMAT(/10x,'FAILURE CRITERIA : ')
5381152 FORMAT(/10x,'NORMAL FORCE AT FAILURE. . . . . . . . . . . . .',1pg20.4
539 . /10x,'FAILURE EXPONENT PARAMETER IN NORMAL DIRECTION ',1pg20.4
540 . /10x,'SHEAR FORCE AT FAILURE . . . . . . . . . . . . .',1pg20.4
541 . /10x,'FAILURE EXPONENT PARAMETER IN SHEAR DIRECTION ',1pg20.4)
5421201 FORMAT(/10x,'SECONDARY NODES ')
5431202 FORMAT( 10x,10i10)
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
rigmodif_nd
subroutine rigmodif_nd(nn, inn, itagnd, icnds10, iu, titr, itab)
Definition dim_s10edg.F:292
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
min
#define min(a, b)
Definition macros.h:20
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagrby
integer, dimension(:), allocatable tagrby
Definition r2r_mod.F:132
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
unitab_mod
Definition unitab_mod.F:513
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
hm_sz_r2r
subroutine hm_sz_r2r(tag, val, lsubmodel)
Definition routines_r2r.F:300
jc
subroutine jc(p, t, a, b, cm, cn, tref, tm, epsm, sigmam, jc_yield, tan_jc)
Definition sigeps106.F:339
spmdset
subroutine spmdset(n, npby, nnpby, lpby, nsl, k)
Definition spmdset.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
nodgrnr6
integer function nodgrnr6(m, igu, igs, ibuf, igrnod, itabm1, mess, id)
Definition freform.F:364
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
newdbl
subroutine newdbl(list, ilist, nlist, tab, errid, status, nom_opt)
Definition sysfus.F:758
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589

◆ seteloff()

subroutine seteloff ( integer, dimension(nixs,*) ixs,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nparg,*) iparg,
integer, dimension(*) isoloff,
integer, dimension(*) isheoff,
integer, dimension(*) itruoff,
integer, dimension(*) ipouoff,
integer, dimension(*) iresoff,
integer, dimension(*) itrioff,
integer, dimension(*) igrnrby,
type (group_), dimension(ngrnod) igrnod,
type (elbuf_struct_), dimension(ngroup), target elbuf_str,
integer, dimension(*) iquaoff,
integer, dimension(nixq,*) ixq )

Definition at line 747 of file hm_read_rbody.F.

751C-----------------------------------------------
752C M o d u l e s
753C-----------------------------------------------
754 USE my_alloc_mod
755 USE message_mod
756 USE elbufdef_mod
757 USE groupdef_mod
758C-------------------------------------
759C PRE LECTURE STRUCTURE RIGIDES POUR OPTIMIZATION
760C-----------------------------------------------
761C I m p l i c i t T y p e s
762C-----------------------------------------------
763#include "implicit_f.inc"
764C-----------------------------------------------
765C C o m m o n B l o c k s
766C-----------------------------------------------
767#include "com01_c.inc"
768#include "com04_c.inc"
769#include "units_c.inc"
770#include "scr03_c.inc"
771#include "param_c.inc"
772C-----------------------------------------------
773C D u m m y A r g u m e n t s
774C-----------------------------------------------
775 INTEGER ISOLOFF(*), ISHEOFF(*), ITRIOFF(*),ITRUOFF(*),
776 . IPOUOFF(*), IRESOFF(*),
777 . IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*), IXT(NIXT,*),
778 . IXP(NIXP,*), IXR(NIXR,*),
779 . IPARG(NPARG,*),IGRNRBY(*),
780 . IQUAOFF(*),IXQ(NIXQ,*)
781 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_STR
782C-----------------------------------------------
783 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
784C-----------------------------------------------
785C L o c a l V a r i a b l e s
786C-----------------------------------------------
787 INTEGER NG, MLW, ITY, NEL, NFT, IAD, I, II, IGOF, NR, IG,
788 . NSN, NALL, ISHFT, IOK, IRBYON
789 TYPE(G_BUFEL_) ,POINTER :: GBUF
790 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
791C-----------------------
792C MISE DE OFF A -OFF
793C======================================================================|
794 IF(ipri>=5) THEN
795 WRITE(iout,*)' '
796
797 WRITE(iout,*)' LIST OF DEACTIVATED ELEMENTS FROM RIGID BODIES'
798 WRITE(iout,*)' ----------------------------------------------'
799 END IF
800C
801 irbyon = 1
802C
803 CALL my_alloc(itag,numnod)
804C init initiale sur numnod
805 DO i=1,numnod
806 itag(i)=0
807 ENDDO
808C
809 DO nr = 1, nrbody
810 ig = igrnrby(nr)
811 IF(ig > 0)THEN
812 nsn = igrnod(ig)%NENTITY
813 DO i=1,nsn
814 itag(igrnod(ig)%ENTITY(i))=1
815 END DO
816C
817 DO ii = 1, numelt
818 nall = itag(ixt(2,ii)) * itag(ixt(3,ii))
819 IF(nall/=0)THEN
820 itruoff(ii) = irbyon
821 END IF
822 END DO
823C
824 DO ii = 1, numelp
825 nall = itag(ixp(2,ii)) * itag(ixp(3,ii))
826 IF(nall/=0)THEN
827 ipouoff(ii) = irbyon
828 END IF
829 END DO
830C
831 DO ii = 1, numelr
832 nall = itag(ixr(2,ii)) * itag(ixr(3,ii))
833 IF(nall/=0)THEN
834 iresoff(ii) = irbyon
835 END IF
836 END DO
837C
838C reinit a 0 sur la partie concernee uniquement
839 DO i=1,nsn
840 itag(igrnod(ig)%ENTITY(i))=0
841 END DO
842 END IF
843 END DO
844C
845C IF COND
846 DO ng=1,ngroup
847 gbuf => elbuf_str(ng)%GBUF
848 mlw=iparg(1,ng)
849 ity=iparg(5,ng)
850 nel=iparg(2,ng)
851 nft=iparg(3,ng)
852 iad=iparg(4,ng) - 1
853C-----------------------
854C 1. ELEMENTS SOLIDES
855C-----------------------
856 IF(ity == 1.AND.mlw/=0)THEN ! loi0, pas de off
857 iok = 0
858 DO i=1,nel
859 ii=i+nft
860 IF(isoloff(ii)/=0)THEN
861 gbuf%OFF(i)= -abs(gbuf%OFF(i))
862 IF(ipri>=5) WRITE(iout,*)' BRICK DEACTIVATION:',
863 . ixs(11,ii)
864 iok = 1
865 ENDIF
866 ENDDO
867C----------------------------------------
868C TEST POUR L'ELIMINATION D'ONE GROUPE
869C----------------------------------------
870 IF(iok == 1)THEN
871 igof = 1
872 DO i = 1,nel
873 ii=i+nft
874 IF (gbuf%OFF(i) > zero) igof=0
875 ENDDO
876 iparg(8,ng) = igof
877 END IF
878C-----------------------
879C 2. ELEMENTS QUADS
880C-----------------------
881 ELSEIF(ity == 2.AND.mlw/=0)THEN ! loi0, pas de off
882 iok = 0
883 DO i=1,nel
884 ii=i+nft
885 IF(iquaoff(ii)/=0)THEN
886 gbuf%OFF(i)= -abs(gbuf%OFF(i))
887 IF(ipri>=5) WRITE(iout,*)' QUAD DEACTIVATION:',
888 . ixq(nixq,ii)
889 iok = 1
890 ENDIF
891 ENDDO
892C----------------------------------------
893C TEST POUR L'ELIMINATION D'ONE GROUPE
894C----------------------------------------
895 IF(iok == 1)THEN
896 igof = 1
897 DO i = 1,nel
898 ii=i+nft
899 IF (gbuf%OFF(i) > zero) igof=0
900 ENDDO
901 iparg(8,ng) = igof
902 END IF
903C-----------------------
904C 3. ELEMENTS COQUES
905C-----------------------
906 ELSEIF(ity == 3.AND.mlw/=0)THEN ! loi0, pas de off
907 iok = 0
908 DO i=1,nel
909 ii=i+nft
910 IF(isheoff(ii)/=0)THEN
911 IF (gbuf%OFF(i) > zero)THEN
912 gbuf%OFF(i) = -gbuf%OFF(i)
913 IF(ipri>=5) WRITE(iout,*)' SHELL DEACTIVATION:',
914 . ixc(7,ii)
915 iok = 1
916 ENDIF
917 ENDIF
918 ENDDO
919C----------------------------------------
920C TEST POUR L'ELIMINATION D'ONE GROUPE
921C----------------------------------------
922 IF(iok == 1)THEN
923 igof = 1
924 DO i = 1,nel
925 ii=i+nft
926 IF (gbuf%OFF(i) > zero) igof=0
927 ENDDO
928 iparg(8,ng) = igof
929 END IF
930C-----------------------
931C 4. ELEMENTS TRUSS
932C-----------------------
933 ELSEIF(ity == 4)THEN
934 iok = 0
935 DO i=1,nel
936 ii=i+nft
937 IF(itruoff(ii)/=0)THEN
938 gbuf%OFF(i)= -abs(gbuf%OFF(i))
939 IF(ipri>=5) WRITE(iout,*)' TRUSS DEACTIVATION:',
940 . ixt(5,ii)
941 iok = 1
942 ENDIF
943 ENDDO
944C----------------------------------------
945C TEST POUR L'ELIMINATION D'ONE GROUPE
946C----------------------------------------
947C Incompatible avec option de gap dans propriete de truss
948C IGOF = 1
949C DO I = 1,NEL
950C IF(ELBUF(IAD + I)/=ZERO) IGOF=0
951C ENDDO
952C IPARG(8,NG) = IGOF
953C-----------------------
954C 5. ELEMENTS POUTRES
955C-----------------------
956 ELSEIF(ity == 5)THEN
957 iok = 0
958 DO i=1,nel
959 ii=i+nft
960 IF(ipouoff(ii)/=0)THEN
961 gbuf%OFF(i)= -abs(gbuf%OFF(i))
962 IF(ipri>=5) WRITE(iout,*)' BEAM DEACTIVATION:',
963 . ixp(6,ii)
964 iok = 1
965 ENDIF
966 ENDDO
967C----------------------------------------
968C TEST POUR L'ELIMINATION D'ONE GROUPE
969C----------------------------------------
970 IF(iok == 1)THEN
971 igof = 1
972 DO i = 1,nel
973 IF(gbuf%OFF(i) > zero) igof=0
974 ENDDO
975 iparg(8,ng) = igof
976 END IF
977C-----------------------
978C 6. ELEMENTS RESSORTS
979C-----------------------
980 ELSEIF(ity == 6.AND.mlw/=3)THEN
981 iok = 0
982 DO i=1,nel
983 ii=i+nft
984 IF(iresoff(ii)/=0)THEN
985 IF (gbuf%OFF(i) /= -ten) gbuf%OFF(i) = -abs(gbuf%OFF(i))
986C spring is active
987 IF(ipri>=5) WRITE(iout,*)' SPRING DEACTIVATION:',
988 . ixr(6,ii)
989 iok = 1
990 ENDIF
991 ENDDO
992C----------------------------------------
993C TEST POUR L'ELIMINATION D'ONE GROUPE
994C----------------------------------------
995 IF(iok == 1)THEN
996 igof = 1
997 DO i = 1,nel
998 IF(gbuf%OFF(i)/=zero) igof=0
999 ENDDO
1000 iparg(8,ng) = igof
1001 END IF
1002C-----------------------
1003C 7. ELEMENTS COQUES 3N
1004C-----------------------
1005 ELSEIF(ity == 7.AND.mlw/=0)THEN ! loi0, pas de off
1006 ishft=16
1007 iok = 0
1008 DO i=1,nel
1009 ii=i+nft
1010 IF(itrioff(ii)/=0)THEN
1011 gbuf%OFF(i)= -abs(gbuf%OFF(i))
1012 IF(ipri>=5) WRITE(iout,*)' SH_3N DEACTIVATION:',
1013 . ixtg(6,ii)
1014 iok = 1
1015 ENDIF
1016 ENDDO
1017C----------------------------------------
1018C TEST POUR L'ELIMINATION D'ONE GROUPE
1019C----------------------------------------
1020 IF(iok == 1)THEN
1021 igof = 1
1022 DO i = 1,nel
1023 ii=i+nft
1024 IF (gbuf%OFF(i) > zero) igof=0
1025 ENDDO
1026 iparg(8,ng) = igof
1027 END IF
1028C----------------------------------------
1029 ENDIF
1030 ENDDO
1031C-----------
1032 IF(ALLOCATED(itag)) DEALLOCATE(itag)
1033C
1034 RETURN

◆ setrbyon()

subroutine setrbyon ( integer, dimension(nixs,*) ixs,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(*) igrnrby,
integer, dimension(*) isoloff,
integer, dimension(*) isheoff,
integer, dimension(*) itrioff,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
integer, dimension(nixq,*) ixq,
integer, dimension(*) iquaoff,
integer, dimension(*) knod2elq,
integer, dimension(*) nod2elq,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 561 of file hm_read_rbody.F.

565C-------------------------------------
566C PRE LECTURE STRUCTURE RIGIDES POUR OPTIMIZATION
567C-----------------------------------------------
568C M o d u l e s
569C-----------------------------------------------
570 USE my_alloc_mod
571 USE message_mod
572 USE r2r_mod
573 USE groupdef_mod
574 USE submodel_mod
575 USE hm_option_read_mod
576 USE names_and_titles_mod , ONLY : nchartitle
577C-----------------------------------------------
578C I m p l i c i t T y p e s
579C-----------------------------------------------
580#include "implicit_f.inc"
581C-----------------------------------------------
582C C o m m o n B l o c k s
583C-----------------------------------------------
584#include "com01_c.inc"
585#include "com04_c.inc"
586#include "r2r_c.inc"
587C-----------------------------------------------
588C D u m m y A r g u m e n t s
589C-----------------------------------------------
590 INTEGER IGRNRBY(*),ISOLOFF(*),ISHEOFF(*),ITRIOFF(*),
591 . IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*),
592 . KNOD2ELC(*), KNOD2ELTG(*), NOD2ELC(*), NOD2ELTG(*),
593 . KNOD2ELS(*), NOD2ELS(*),KNOD2ELQ(*),IQUAOFF(*),
594 . NOD2ELQ(*) ,IXQ(NIXQ,*)
595C-----------------------------------------------
596 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
597 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
598C-----------------------------------------------
599C L o c a l V a r i a b l e s
600C-----------------------------------------------
601 INTEGER I, ISENS, IG, NSN, II, NALL, IGU, N, ID, IRBYON, IOPT, NN, JJ, NRB
602 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
603 CHARACTER(LEN=NCHARTITLE) :: TITR
604 LOGICAL IS_AVAILABLE
605C-----------------------------------
606C
607 DO i = 1, numels
608 isoloff(i) = 0
609 END DO
610 DO i = 1, numelc
611 isheoff(i) = 0
612 END DO
613 DO i = 1, numeltg
614 itrioff(i) = 0
615 END DO
616 DO i = 1, numelq
617 iquaoff(i) = 0
618 END DO
619C
620C init a 0 de itag
621 CALL my_alloc(itag,numnod)
622 DO i=1,numnod
623 itag(i)=0
624 ENDDO
625C--------------------------------------------------
626C START BROWSING MODEL RBODY
627C--------------------------------------------------
628 is_available = .false.
629 CALL hm_option_start('/RBODY')
630C
631 nrb=0
632C
633 DO n=1,nrbykin
634 nrb = nrb + 1
635 IF (nsubdom > 0)THEN ! TAGRBY is allocated only if NSUBDOM>0
636 IF(tagrby(nrb) == 0) CALL hm_sz_r2r(tagrby,nrb,lsubmodel)
637 ENDIF
638C-----------------------------------------------------------------
639 igrnrby(n)=0
640C--------------------------------------------------
641C EXTRACT DATAS OF /RBODY/... LINE
642C--------------------------------------------------
643 CALL hm_option_read_key(lsubmodel,
644 . option_id = id,
645 . option_titr = titr)
646C
647 CALL hm_get_intv('sens_ID',isens,is_available,lsubmodel)
648 CALL hm_get_intv('grnd_ID',igu,is_available,lsubmodel)
649 CALL hm_get_intv('Ioptoff',iopt,is_available,lsubmodel)
650C
651 IF (iopt == 1) THEN
652 irbyon=2
653 ELSE
654C par defaut rbody desactive
655 irbyon=1
656 END IF
657C si sensor rbody active
658 IF(isens/=0) irbyon=0
659C si Imls utilisee rbody active temporairement
660 IF(ndsolv == 1) irbyon=0
661 IF(irbyon>=1)THEN
662C
663 IF(igu/=0)THEN
664 ig = 0
665 DO i=1,ngrnod
666 IF(igrnod(i)%ID == igu)THEN
667 ig=i
668 GOTO 100
669 END IF
670 END DO
671 100 CONTINUE
672C
673 IF(ig/=0) THEN
674 igrnrby(n)=ig
675 nsn = igrnod(ig)%NENTITY
676 DO i=1,nsn
677 itag(igrnod(ig)%ENTITY(i)) = 1
678 END DO
679C
680cc DO II = 1, NUMELS
681 DO i=1,nsn
682 nn = igrnod(ig)%ENTITY(i)
683 DO jj = knod2els(nn)+1,knod2els(nn+1)
684 ii = nod2els(jj)
685 nall = itag(ixs(2,ii)) * itag(ixs(3,ii)) *
686 + itag(ixs(4,ii)) * itag(ixs(5,ii)) *
687 + itag(ixs(6,ii)) * itag(ixs(7,ii)) *
688 + itag(ixs(8,ii)) * itag(ixs(9,ii))
689 IF(nall/=0)THEN
690 isoloff(ii) = irbyon
691 END IF
692 END DO
693C
694cc DO II = 1, NUMELC
695 DO jj = knod2elc(nn)+1,knod2elc(nn+1)
696 ii = nod2elc(jj)
697 nall = itag(ixc(2,ii)) * itag(ixc(3,ii)) *
698 + itag(ixc(4,ii)) * itag(ixc(5,ii))
699 IF(nall/=0)THEN
700 isheoff(ii) = irbyon
701 END IF
702 END DO
703C
704cc DO II = 1, NUMELTG
705 DO jj = knod2eltg(nn)+1,knod2eltg(nn+1)
706 ii = nod2eltg(jj)
707 nall = itag(ixtg(2,ii)) * itag(ixtg(3,ii)) *
708 + itag(ixtg(4,ii))
709 IF(nall/=0)THEN
710 itrioff(ii) = irbyon
711 END IF
712 END DO
713C
714 DO jj = knod2elq(nn)+1,knod2elq(nn+1)
715 ii = nod2elq(jj)
716 nall = itag(ixq(2,ii)) * itag(ixq(3,ii)) *
717 + itag(ixq(4,ii)) * itag(ixq(5,ii))
718 IF(nall/=0)THEN
719 iquaoff(ii) = irbyon
720 END IF
721 END DO
722C
723 END DO
724C reinit a 0 sur la partie concernee
725 DO i=1,nsn
726 itag(igrnod(ig)%ENTITY(i))=0
727 END DO
728 END IF
729 END IF
730 END IF
731C
732 END DO
733C
734 IF(ALLOCATED(itag)) DEALLOCATE(itag)
735C
736 RETURN