OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_merge.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_merge (mgrby, smgrby, npby, lpby, slrbody, rby, nom_opt, ptr_nopt_rbmerge, igrnod, itab, itabm1, ibgr, igrv, lsubmodel)
recursive subroutine rbtag1down (tabrb, idrb, tag1, nbmerge)
recursive subroutine rbtag2down (idrb, tag2, rbmerge, flag_boucle, tabboucle, idboucle)
recursive subroutine rbleveldown (npby, rbmerge, idrb, level)
subroutine trirbmerge (rbmerge, npby, lpby, slrbody, rby, nom_opt, itab, ibgr, igrv)
recursive subroutine rb_explore (idrb, rbmerge, pile, idpile)
subroutine retrirby (npby, lpby, rby, nom_opt)

Function/Subroutine Documentation

◆ hm_read_merge()

subroutine hm_read_merge ( integer, dimension(nmgrby,smgrby) mgrby,
integer smgrby,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer slrbody,
rby,
integer, dimension(lnopt1,*) nom_opt,
integer ptr_nopt_rbmerge,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
integer, dimension(*) ibgr,
integer, dimension(nigrv,*) igrv,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 47 of file hm_read_merge.F.

51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE my_alloc_mod
55 USE message_mod
56 USE rbmerge_mod , ONLY : rbmerge_
57 USE groupdef_mod , ONLY : group_
58 USE submodel_mod , ONLY : nsubmod, submodel_data
59 USE hm_option_read_mod
60 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "scr17_c.inc"
69#include "com04_c.inc"
70#include "units_c.inc"
71#include "param_c.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 INTEGER :: SMGRBY
76 INTEGER MGRBY(NMGRBY,SMGRBY),NPBY(NNPBY,*),LPBY(*),SLRBODY,ITABM1(*),ITAB(*)
77 my_real rby(nrby,*)
78 INTEGER NOM_OPT(LNOPT1,*),PTR_NOPT_RBMERGE
79 INTEGER IGRV(NIGRV,*),IBGR(*)
80 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(NSUBMOD)
81C-----------------------------------------------
82 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER I,J,K,L,ID,IRBM,IRBS,NBMERGE,IGS,
87 . N,NOPT,UID, II, NOBJ
88 INTEGER IMAIN,ISECONDARY,FLAGG_OPT, FLAG_BOUCLE, FLAG_ERROR,
89 . FLAG_DOUBLON, FLAG_DOUBLEMAIN, M_TYPE, S_TYPE, ID_OPT,
90 . IDNODE, NN, PRT_OPT, IDBOUCLE, LEVEL
91 INTEGER, DIMENSION(:) , ALLOCATABLE :: INDEX
92 INTEGER, DIMENSION(:,:) , ALLOCATABLE :: INUM
93 INTEGER, DIMENSION(:) , ALLOCATABLE :: NB_MAIN
94 INTEGER, DIMENSION(:) , ALLOCATABLE :: NSECONDARY
95 INTEGER, DIMENSION(:) , ALLOCATABLE :: TAG1
96 INTEGER, DIMENSION(:) , ALLOCATABLE :: TAG2
97 INTEGER, DIMENSION(:) , ALLOCATABLE :: TABBOUCLE
98 INTEGER, DIMENSION(:,:) , ALLOCATABLE :: TABRB
99
100 CHARACTER MYSTRING*100,MYLOOP*200
101 CHARACTER MESS*40,MESS2*40
102 CHARACTER(LEN=nchartitle) :: TITR
103 CHARACTER(LEN=ncharkey) :: KEY2
104 TYPE(RBMERGE_), DIMENSION(:), ALLOCATABLE :: RBMERGE
105 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG, WORK
106 INTEGER IWORK(70000)
107 LOGICAL IS_AVAILABLE
108C-----------------------------------------------
109C E x t e r n a l F u n c t i o n s
110C-----------------------------------------------
111 INTEGER USR2SYS,NODGRNR5
112C-----------------------------------------------
113 DATA mess/'RIGID BODY MERGE DEFINITION '/
114C-----------------------------------------------
115 ALLOCATE(itag(numnod),work(numnod))
116 CALL my_alloc(tabrb,nrbykin,2)
117 CALL my_alloc(nb_main,nrbykin)
118 CALL my_alloc(nsecondary,nrbykin)
119 CALL my_alloc(tag1,nrbykin)
120 CALL my_alloc(tag2,nrbykin)
121 CALL my_alloc(tabboucle,nrbykin+1)
122 j = 0
123 n = 0
124 nopt = 0
125 nobj = 0
126C--------------------------------------------------
127C START BROWSING MODEL RBODY
128C--------------------------------------------------
129 is_available = .false.
130 CALL hm_option_start('/MERGE/RBODY')
131C--------------------------------------------------
132 DO i=1,nrbmerge
133C--------------------------------------------------
134C EXTRACT DATAS OF /RBODY/... LINE
135C--------------------------------------------------
136 CALL hm_option_read_key(lsubmodel, option_id = id, unit_id = uid, option_titr = titr, keyword2 = key2)
137C--------------------------------------------------
138C WRITE TITLE IN OUT FILE
139C--------------------------------------------------
140 nopt=nopt+1
141 nom_opt(1,ptr_nopt_rbmerge+nopt)=id
142 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,ptr_nopt_rbmerge+nopt),ltitr)
143C--------------------------------------------------
144C EXTRACT DATAS (INTEGER VALUES)
145C--------------------------------------------------
146 CALL hm_get_intv('NB_SUBOBJVE',nobj,is_available,lsubmodel)
147C
148 DO j=1,nobj
149 CALL hm_get_int_array_index('Main_ID',imain,j,is_available,lsubmodel)
150 CALL hm_get_int_array_index('M_type',m_type,j,is_available,lsubmodel)
151 CALL hm_get_int_array_index('Secon_ID',isecondary,j,is_available,lsubmodel)
152 CALL hm_get_int_array_index('S_type',s_type,j,is_available,lsubmodel)
153 CALL hm_get_int_array_index('Iflag',flagg_opt,j,is_available,lsubmodel)
154 IF (imain /= 0) THEN
155 n = n + 1
156 IF(m_type == 0) m_type=1
157 IF(s_type == 0) s_type=1
158 IF(flagg_opt == 0) flagg_opt=2
159 mgrby(1,n)=imain
160 mgrby(2,n)=m_type
161 mgrby(3,n)=isecondary
162 mgrby(4,n)=s_type
163 mgrby(5,n)=flagg_opt
164 mgrby(6,n)=id!NOPT
165 mgrby(7,n)=nopt
166 ENDIF ! IMAIN /= 0
167 ENDDO
168 ENDDO
169C
170 ALLOCATE (rbmerge(nrbykin))
171 DO i=1,nrbykin
172 ALLOCATE (rbmerge(i)%IDSECONDARY(nrbykin))
173 rbmerge(i)%NBSECONDARY=0
174 ALLOCATE (rbmerge(i)%NODE(nxtra_node))
175 ALLOCATE (rbmerge(i)%FLAG_NODE(nxtra_node))
176 rbmerge(i)%NNODE=0
177 rbmerge(i)%LEVEL=0
178 rbmerge(i)%FLAG_MAIN = 0
179 ENDDO
180
181c
182 nbmerge = 0
183 tabrb(:,:)=0
184 tag1(:)=0
185 tag2(:)=0
186 flag_error = 0
187 nb_main(:)=0
188 itag(1:numnod) = 0
189 flag_doublon=0
190c
191 WRITE(iout,1000)
192 prt_opt=0
193c
194 DO i=1,smgrby ! FIRST PASS FOR RBODY/RBODY MERGE
195 imain = mgrby(1,i)
196 m_type = mgrby(2,i)
197 isecondary = mgrby(3,i)
198 s_type = mgrby(4,i)
199 flagg_opt = mgrby(5,i)
200 id_opt = mgrby(6,i)
201 IF(s_type == 1) THEN ! SECONDARY IS A RBODY
202c
203 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,ptr_nopt_rbmerge+mgrby(7,i)),ltitr)
204c
205 IF(prt_opt /= mgrby(6,i)) THEN
206 WRITE(iout,1100) mgrby(6,i),trim(titr)
207 prt_opt = mgrby(6,i)
208 ENDIF
209C------------------------------------
210c EXISTENCE TESTS ON MAIN AND SECONDARIES
211C------------------------------------
212 irbm=0
213 DO k=1,nrbykin
214 IF (imain == npby(6,k)) THEN
215 irbm=k
216 EXIT
217 ENDIF
218 ENDDO
219 IF (irbm == 0)THEN ! l'ID du rbody n'existe pas
220 CALL ancmsg(msgid=1636,
221 . msgtype=msgerror,
222 . anmode=aninfo,
223 . i1=id_opt,
224 . c1=titr,
225 . i2=imain)
226 ENDIF
227
228 irbs=0
229 DO k=1,nrbykin
230 IF (isecondary == npby(6,k)) THEN
231 irbs=k
232 EXIT
233 ENDIF
234 ENDDO
235 IF (irbs == 0)THEN ! l'ID du rbody n'existe pas
236 CALL ancmsg(msgid=1636,
237 . msgtype=msgerror,
238 . anmode=aninfo,
239 . i1=id_opt,
240 . c1=titr,
241 . i2=isecondary)
242 ENDIF
243C------------------------------------
244c SORTING OF READ RELATIONS
245C------------------------------------
246 IF((irbm /= 0).AND.(irbs /= 0)) THEN
247
248 WRITE(iout,1200) imain, isecondary, flagg_opt
249 mess2 ='SECONDARY RIGID BODY '
250
251 flag_doublon=0
252 flag_doublemain = 0
253 IF(nb_main(irbs) >= 1) THEN
254 DO l=1,nbmerge
255 IF(tabrb(l,2) == irbs) THEN
256 IF(tabrb(l,1) /= irbm) THEN ! IF(TABRB(L,1) /= IRBM) THEN ! the SECONDARY is already SECONDARY of another
257 CALL ancmsg(msgid=1028,
258 . msgtype=msgerror,
259 . anmode=aninfo_blind_1,
260 . i1=id_opt,
261 . c1=titr,
262 . i2=isecondary)
263 flag_doublemain = 1
264 flag_error = 1
265 ELSE ! ELSE ! the merge relation is a duplicate
266 CALL ancmsg(msgid=1027,
267 . msgtype=msgwarning,
268 . anmode=aninfo_blind_1,
269 . i1=id_opt,
270 . c1=titr,
271 . i2=imain,
272 . c2=mess2,
273 . i3=isecondary,
274 . i4=flagg_opt)
275 flag_doublon = 1
276 ENDIF
277 ENDIF
278 ENDDO
279 ENDIF
280 IF((flag_doublon + flag_doublemain) == 0) THEN
281 nbmerge = nbmerge + 1
282 nb_main(irbs) = nb_main(irbs) + 1
283 nsecondary(irbm) = nsecondary(irbm) + 1
284 tabrb(nbmerge,1) = irbm ! MAIN
285 tabrb(nbmerge,2) = irbs ! SECONDARY
286c
287 rbmerge(irbs)%ID = isecondary
288 rbmerge(irbs)%IMAIN = irbm
289 rbmerge(irbs)%FLAG_MAIN = flagg_opt
290c
291 rbmerge(irbm)%ID = imain
292 rbmerge(irbm)%NBSECONDARY = rbmerge(irbm)%NBSECONDARY+1
293 rbmerge(irbm)%IDSECONDARY(rbmerge(irbm)%NBSECONDARY) = irbs
294 ELSEIF(flag_doublon == 1) THEN ! ELSEIF(FLAG_DOUBLON == 1) THEN ! The flag is the one read last
295 rbmerge(irbs)%FLAG_MAIN = flagg_opt
296 ENDIF
297 ENDIF ! IRBM /= 0 IRBS /= 0
298 ENDIF ! S_TYPE == 1
299 ENDDO
300C
301 DO i=1,smgrby ! 2ERE PASSE POUR LES MERGE RBODY/NODE & SET OF NODES
302 imain = mgrby(1,i)
303 m_type = mgrby(2,i)
304 isecondary = mgrby(3,i)
305 s_type = mgrby(4,i)
306 flagg_opt = mgrby(5,i)
307 id_opt = mgrby(6,i)
308 IF((s_type == 2).OR.(s_type == 3)) THEN
309c
310 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,ptr_nopt_rbmerge+mgrby(7,i)),ltitr)
311c
312 IF(prt_opt /= mgrby(6,i)) THEN
313 WRITE(iout,1100) mgrby(6,i),trim(titr)
314 prt_opt = mgrby(6,i)
315 ENDIF
316C------------------------------------
317c EXISTENCE TESTS ON MAIN AND SECONDARIES
318C------------------------------------
319 irbm=0
320 DO k=1,nrbykin
321 IF (imain == npby(6,k)) THEN
322 irbm=k
323 EXIT
324 ENDIF
325 ENDDO
326 IF (irbm == 0)THEN ! l'ID du rbody n'existe pas
327 CALL ancmsg(msgid=1636,
328 . msgtype=msgerror,
329 . anmode=aninfo,
330 . i1=id_opt,
331 . c1=titr,
332 . i2=imain)
333 ENDIF
334
335 idnode=0
336 nn=0
337 IF(s_type == 2) THEN ! SECONDARY IS A NODE
338 idnode = usr2sys(mgrby(3,i),itabm1,mess,id)
339 ELSEIF(s_type == 3) THEN ! SECONDARY IS A GRNOD
340 nn = nodgrnr5(mgrby(3,i),igs,work,igrnod,itabm1,mess)
341 ENDIF
342
343
344 IF((irbm /= 0).AND.(idnode /= 0)) THEN ! SECONDARY IS A NODE
345
346 WRITE(iout,1300) imain, isecondary, flagg_opt
347 mess2 ='SECONDARY NODE '
348
349 IF(itag(idnode) == 0) THEN
350 itag(idnode) = irbm
351 ELSEIF(itag(idnode) == irbm) THEN
352 flag_doublon = 1
353 CALL ancmsg(msgid=1027,
354 . msgtype=msgwarning,
355 . anmode=aninfo_blind_1,
356 . i1=id_opt,
357 . c1=titr,
358 . i2=imain,
359 . c2=mess2,
360 . i3=isecondary,
361 . i4=flagg_opt)
362 ENDIF
363
364 IF(flag_doublon == 0) THEN
365 rbmerge(irbm)%ID = imain
366 rbmerge(irbm)%NNODE = rbmerge(irbm)%NNODE+1
367 rbmerge(irbm)%NODE(rbmerge(irbm)%NNODE) = idnode
368 rbmerge(irbm)%FLAG_NODE(rbmerge(irbm)%NNODE) = flagg_opt
369 ELSE ! ELSE ! The flag is the one read last
370 DO ii=1,rbmerge(irbm)%NNODE
371 IF(rbmerge(irbm)%NODE(ii) == idnode) THEN
372 rbmerge(irbm)%FLAG_NODE(ii) = flagg_opt
373 ENDIF
374 ENDDO
375 ENDIF
376 ENDIF
377
378 IF((irbm /= 0).AND.(nn /= 0)) THEN ! SECONDARY IS A SET OF NODE
379
380 WRITE(iout,1400) imain, isecondary, flagg_opt
381 WRITE(iout,1410) (itab(work(j)),j=1,nn)
382 mess2 ='SECONDARY NODE '
383
384 rbmerge(irbm)%ID = imain
385 DO j=1,nn
386 flag_doublon = 0
387 flag_doublemain = 0
388 IF(itag(work(j)) == 0) THEN
389 itag(work(j)) = irbm
390 ELSEIF(itag(work(j)) == irbm) THEN
391 flag_doublon = 1
392 CALL ancmsg(msgid=1027,
393 . msgtype=msgwarning,
394 . anmode=aninfo_blind_1,
395 . i1=id_opt,
396 . c1=titr,
397 . i2=imain,
398 . c2=mess2,
399 . i3=itab(work(j)),
400 . i4=flagg_opt)
401 ENDIF
402
403 IF(flag_doublon == 0) THEN
404 rbmerge(irbm)%ID = imain
405 rbmerge(irbm)%NNODE = rbmerge(irbm)%NNODE+1
406 rbmerge(irbm)%NODE(rbmerge(irbm)%NNODE) = work(j)
407 rbmerge(irbm)%FLAG_NODE(rbmerge(irbm)%NNODE) = flagg_opt
408 ELSE ! ELSE ! The flag is the one read last
409 DO ii=1,rbmerge(irbm)%NNODE
410 IF(rbmerge(irbm)%NODE(ii) == work(j)) THEN
411 rbmerge(irbm)%FLAG_NODE(ii) = flagg_opt
412 ENDIF
413 ENDDO
414 ENDIF
415 ENDDO
416
417 ENDIF
418 ENDIF ! S_TYPE = 2 OR 3
419C-----
420 ENDDO
421C------------------------------------
422C SORTING OF XTRA_NODES BY INCREASING FLAGS
423C------------------------------------
424 DO i=1,nrbykin
425 IF(rbmerge(i)%NNODE > 0) THEN
426 ALLOCATE(index(2*rbmerge(i)%NNODE))
427 index(1:2*rbmerge(i)%NNODE) = 0
428 ALLOCATE(inum(rbmerge(i)%NNODE,2))
429 DO j=1,rbmerge(i)%NNODE
430 index(j) = j
431 inum(j,1) = rbmerge(i)%FLAG_NODE(j)
432 inum(j,2) = rbmerge(i)%NODE(j)
433 ENDDO
434 CALL my_orders(0,iwork,rbmerge(i)%FLAG_NODE,index,rbmerge(i)%NNODE,1)
435 DO j=1,rbmerge(i)%NNODE
436 rbmerge(i)%FLAG_NODE(j) = inum(index(j),1)
437 rbmerge(i)%NODE(j) = inum(index(j),2)
438 ENDDO
439 DEALLOCATE(index)
440 DEALLOCATE(inum)
441 ENDIF
442 ENDDO
443C------------------------------------
444C TOUTES LES RELATIONS ONT ETE TRIEES (RBODY, NODE, GRNOD)
445C------------------------------------
446 WRITE(iout,2000)
447C------------------------------------
448C TAGGING AND SEARCH FOR LOOPS
449C------------------------------------
450 DO i=1,nrbykin
451 IF(nb_main(i) == 0) THEN
452 CALL rbtag1down(tabrb,i,tag1,nbmerge)
453 ENDIF
454 ENDDO
455C
456 DO i=1,nrbykin
457 IF((tag1(i) == 0).AND.(tag2(i) == 0).AND.(rbmerge(i)%NBSECONDARY>0)) THEN
458 flag_boucle = 0
459 idboucle = 0
460 tabboucle(:) = 0
461 CALL rbtag2down(i,tag2,rbmerge,flag_boucle,tabboucle,idboucle)
462 IF (flag_boucle == 1) THEN
463 WRITE(myloop,*) tabboucle(1)
464 myloop = adjustl(myloop)
465 DO j=2,nrbykin+1
466 IF(tabboucle(j) == 0) EXIT
467 WRITE(mystring,*) tabboucle(j)
468 mystring = adjustl(mystring)
469 myloop = myloop(1:len(trim(myloop))) //' -> '// mystring
470 ENDDO
471 CALL ancmsg(msgid=1029,
472 . msgtype=msgerror,
473 . anmode=aninfo_blind_1,
474 . c1=myloop,
475 . prmod=msg_cumu)
476 flag_error = 1
477 ENDIF
478 ENDIF
479 ENDDO
480 IF(flag_error == 1) THEN
481 CALL ancmsg(msgid=1029,
482 . msgtype=msgerror,
483 . anmode=aninfo_blind_1,
484 . prmod=msg_print)
485 ENDIF
486C------------------------------------
487C IF NO LOOP, CONSTRUCTING HIERARCHIES
488C------------------------------------
489 IF(flag_error == 0) THEN
490 DO i=1,nrbykin ! RB level calculation
491 IF(nb_main(i) == 0) THEN
492 level = 0
493 CALL rbleveldown(npby,rbmerge,i,level)
494 ENDIF
495 ENDDO
496C------------------------------------
497C SCHEDULING OF NPBY, LPBY AND RBY, OUTPUTS OF HIERARCHIES
498C------------------------------------
499 CALL trirbmerge(rbmerge,npby ,lpby ,slrbody,
500 . rby ,nom_opt, itab,ibgr,igrv)
501 ENDIF
502c
503 DEALLOCATE(rbmerge,work,itag)
504 DEALLOCATE(tabrb)
505 DEALLOCATE(nb_main)
506 DEALLOCATE(nsecondary)
507 DEALLOCATE(tag1)
508 DEALLOCATE(tag2)
509 DEALLOCATE(tabboucle)
510cC-----------
511 RETURN
512C
5131000 FORMAT(/
514 . ' RIGID BODY MERGE DEFINITIONS '/
515 . ' ---------------------- '/)
5161100 FORMAT( /5x,'RIGID BODY MERGE ID ',i10,1x,a)
5171200 FORMAT(/10x,'MAIN RIGID BODY ID ',i10
518 . /10x,'SECONDARY RIGID BODY ID ',i10
519 . /10x,'IFLAG ',i10)
5201300 FORMAT(/10x,'MAIN RIGID BODY ID ',i10
521 . /10x,'SECONDARY NODE ID ',i10
522 . /10x,'IFLAG ',i10)
5231400 FORMAT(/10x,'MAIN RIGID BODY ID ',i10
524 . /10x,'SECONDARY SET OF NODE ID ',i10
525 . /10x,'IFLAG ',i10
526 . /10x,'SET OF NODES ')
5271410 FORMAT( 10x,10i10)
5282000 FORMAT(/
529 . ' RIGID BODY MERGE CONSTRUCTION '/
530 . ' ---------------------- '/)
531C
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
rbleveldown
recursive subroutine rbleveldown(npby, rbmerge, idrb, level)
Definition hm_read_merge.F:641
rbtag1down
recursive subroutine rbtag1down(tabrb, idrb, tag1, nbmerge)
Definition hm_read_merge.F:542
trirbmerge
subroutine trirbmerge(rbmerge, npby, lpby, slrbody, rby, nom_opt, itab, ibgr, igrv)
Definition hm_read_merge.F:703
rbtag2down
recursive subroutine rbtag2down(idrb, tag2, rbmerge, flag_boucle, tabboucle, idboucle)
Definition hm_read_merge.F:582
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
id
initmumps id
Definition multiplerhs_example.m:4
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
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:895
nodgrnr5
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:298
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:615
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146
groupdef_mod::group_
Definition groupdef_mod.F:706
submodel_mod::submodel_data
Definition submodel_mod.F:728

◆ rb_explore()

recursive subroutine rb_explore ( integer idrb,
type (rbmerge_), dimension(*) rbmerge,
integer, dimension(nrbykin) pile,
integer idpile )

Definition at line 993 of file hm_read_merge.F.

994C-----------------------------------------------
995C M o d u l e s
996C-----------------------------------------------
997 USE rbmerge_mod
998C-----------------------------------------------
999C I m p l i c i t T y p e s
1000C-----------------------------------------------
1001#include "implicit_f.inc"
1002C-----------------------------------------------
1003C C o m m o n B l o c k s
1004C-----------------------------------------------
1005#include "com04_c.inc"
1006C-----------------------------------------------
1007C D u m m y A r g u m e n t s
1008C-----------------------------------------------
1009 INTEGER PILE(NRBYKIN), IDPILE, IDRB
1010 TYPE (RBMERGE_) , DIMENSION(*) :: RBMERGE
1011C-----------------------------------------------
1012C L o c a l V a r i a b l e s
1013C-----------------------------------------------
1014 INTEGER ISECONDARY, NBSECONDARY
1015C-----------------------------------------------
1016! RBMERGE(IRBM)%ID :: Rigid body identifier
1017! RBMERGE(IRBM)%NBSECONDARY :: Number of SECONDARY rigid body
1018! RBMERGE(IRBM)%IMAIN :: 0 if this rigid body doesn't have a MAIN
1019! X : The Rigid body's MAIN
1020! RBMERGE(IRBM)%LEVEL :: Rigid body level
1021! RBMERGE(IRBM)%FLAG_MAIN :: Flag relating the rigid option merge to the MAIN
1022! RBMERGE(IRBM)%IDSECONDARY(J) :: SECONDARY rigid bodys attached to the MAIN
1023C-----------------------------------------------
1024 idpile = idpile + 1
1025 pile(idpile) = idrb
1026 nbsecondary = rbmerge(idrb)%NBSECONDARY
1027 isecondary = 0
1028c
1029 DO WHILE (isecondary < nbsecondary)
1030 isecondary = isecondary + 1
1031 CALL rb_explore(rbmerge(idrb)%IDSECONDARY(isecondary),rbmerge,pile,idpile)
1032 ENDDO
1033C
1034 RETURN
rb_explore
recursive subroutine rb_explore(idrb, rbmerge, pile, idpile)
Definition hm_read_merge.F:994

◆ rbleveldown()

recursive subroutine rbleveldown ( integer, dimension(nnpby,*) npby,
type (rbmerge_), dimension(nrbykin) rbmerge,
integer idrb,
integer level )

Definition at line 640 of file hm_read_merge.F.

641C-----------------------------------------------
642C M o d u l e s
643C-----------------------------------------------
644 USE rbmerge_mod
645C-----------------------------------------------
646C I m p l i c i t T y p e s
647C-----------------------------------------------
648#include "implicit_f.inc"
649C-----------------------------------------------
650C C o m m o n B l o c k s
651C-----------------------------------------------
652#include "com04_c.inc"
653#include "param_c.inc"
654C-----------------------------------------------
655C D u m m y A r g u m e n t s
656C-----------------------------------------------
657 INTEGER NPBY(NNPBY,*),IDRB, LEVEL
658 TYPE (RBMERGE_), DIMENSION(NRBYKIN) :: RBMERGE
659C-----------------------------------------------
660C L o c a l V a r i a b l e s
661C-----------------------------------------------
662 INTEGER ISECONDARY, NBSECONDARY
663C-----------------------------------------------
664! RBMERGE(IRBM)%ID :: Rigid body identifier
665! RBMERGE(IRBM)%NBSECONDARY :: Number of SECONDARY rigid body
666! RBMERGE(IRBM)%IMAIN :: 0 if this rigid body doesn't have a MAIN
667! X : The Rigid body's MAIN
668! RBMERGE(IRBM)%LEVEL :: Rigid body level
669! RBMERGE(IRBM)%FLAG_MAIN :: Flag relating the rigid option merge to the MAIN
670! RBMERGE(IRBM)%IDSECONDARY(J) :: SECONDARY rigid bodys attached to the MAIN
671C-----------------------------------------------
672 nbsecondary = rbmerge(idrb)%NBSECONDARY
673 isecondary = 0
674 npby(12,idrb) = level
675 level = level - 1
676 npby(13,idrb) = rbmerge(idrb)%FLAG_MAIN
677c
678 DO WHILE (isecondary < nbsecondary)
679 isecondary = isecondary + 1
680 rbmerge(rbmerge(idrb)%IDSECONDARY(isecondary))%LEVEL=rbmerge(idrb)%LEVEL-1
681 CALL rbleveldown(npby,rbmerge,rbmerge(idrb)%IDSECONDARY(isecondary),level)
682 ENDDO
683C
684 level = level + 1
685
686 RETURN

◆ rbtag1down()

recursive subroutine rbtag1down ( integer, dimension(nrbykin,2) tabrb,
integer idrb,
integer, dimension(nrbykin) tag1,
integer nbmerge )

Definition at line 541 of file hm_read_merge.F.

542C-----------------------------------------------
543C I m p l i c i t T y p e s
544C-----------------------------------------------
545#include "implicit_f.inc"
546C-----------------------------------------------
547C C o m m o n B l o c k s
548C-----------------------------------------------
549#include "com04_c.inc"
550C-----------------------------------------------
551C D u m m y A r g u m e n t s
552C-----------------------------------------------
553 INTEGER IDRB,NBMERGE, TAG1(NRBYKIN),TABRB(NRBYKIN,2)
554C-----------------------------------------------
555C L o c a l V a r i a b l e s
556C-----------------------------------------------
557 INTEGER I, IDRBS
558C-----------------------------------------------
559 tag1(idrb) = 1
560c
561 DO i=1,nbmerge
562 IF(tabrb(i,1) == idrb) THEN
563 idrbs = tabrb(i,2)
564 CALL rbtag1down(tabrb,idrbs,tag1,nbmerge)
565 ENDIF
566 ENDDO
567C
568 RETURN

◆ rbtag2down()

recursive subroutine rbtag2down ( integer idrb,
integer, dimension(nrbykin) tag2,
type (rbmerge_), dimension(nrbykin) rbmerge,
integer flag_boucle,
integer, dimension(nrbykin+1) tabboucle,
integer idboucle )

Definition at line 580 of file hm_read_merge.F.

582C-----------------------------------------------
583C M o d u l e s
584C-----------------------------------------------
585 USE rbmerge_mod
586C-----------------------------------------------
587C I m p l i c i t T y p e s
588C-----------------------------------------------
589#include "implicit_f.inc"
590C-----------------------------------------------
591C C o m m o n B l o c k s
592C-----------------------------------------------
593#include "com04_c.inc"
594C-----------------------------------------------
595C D u m m y A r g u m e n t s
596C-----------------------------------------------
597 INTEGER IDRB,NBMERGE, TAG2(NRBYKIN),FLAG_BOUCLE
598 INTEGER TABBOUCLE(NRBYKIN+1), IDBOUCLE
599 TYPE (RBMERGE_) , DIMENSION(NRBYKIN) :: RBMERGE
600C-----------------------------------------------
601C L o c a l V a r i a b l e s
602C-----------------------------------------------
603 INTEGER I, IDRBS
604C-----------------------------------------------
605 tag2(idrb) = 1
606c
607 DO i=1,rbmerge(idrb)%NBSECONDARY
608 IF(tag2(rbmerge(idrb)%IDSECONDARY(i)) == 0) THEN
609 idrbs = rbmerge(idrb)%IDSECONDARY(i)
610 CALL rbtag2down(idrbs,tag2,rbmerge,flag_boucle,
611 . tabboucle,idboucle)
612 ELSE ! on a trouve la boucle
613 flag_boucle = 1
614 idrbs = rbmerge(idrb)%IDSECONDARY(i)
615 idboucle = idboucle+1
616 tabboucle(idboucle)=rbmerge(idrbs)%ID
617 EXIT
618 ENDIF
619 ENDDO
620
621 IF(flag_boucle == 1) THEN
622 idboucle = idboucle+1
623 tabboucle(idboucle)=rbmerge(idrb)%ID
624 ELSE
625 tag2(idrb) = 0
626 ENDIF
627C
628 RETURN

◆ retrirby()

subroutine retrirby ( integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
rby,
integer, dimension(lnopt1,*) nom_opt )

Definition at line 1046 of file hm_read_merge.F.

1047C-----------------------------------------------
1048C M o d u l e s
1049C-----------------------------------------------
1050 USE my_alloc_mod
1051 USE message_mod
1052 USE rbmerge_mod
1053C-----------------------------------------------
1054C I m p l i c i t T y p e s
1055C-----------------------------------------------
1056#include "implicit_f.inc"
1057C-----------------------------------------------
1058C C o m m o n B l o c k s
1059C-----------------------------------------------
1060#include "scr17_c.inc"
1061#include "com04_c.inc"
1062#include "param_c.inc"
1063#include "lagmult.inc"
1064C-----------------------------------------------
1065C D u m m y A r g u m e n t s
1066C-----------------------------------------------
1067 INTEGER NPBY(NNPBY,*),LPBY(*)
1068 my_real rby(nrby,*)
1069 INTEGER NOM_OPT(LNOPT1,*)
1070C-----------------------------------------------
1071C L o c a l V a r i a b l e s
1072C-----------------------------------------------
1073 INTEGER I,J,K,OFFSET,OFFSETEND,NRBYKINM,
1074 . NEW_SIZE,CPT_RBY,CPT_RBY_SECONDARY
1075 INTEGER,DIMENSION(:,:),ALLOCATABLE :: NPBY_TMP
1076 INTEGER,DIMENSION(:),ALLOCATABLE :: INDEX
1077 INTEGER,DIMENSION(:,:),ALLOCATABLE :: NOM_OPT_TMP
1078 my_real,DIMENSION(:,:),ALLOCATABLE :: rby_tmp
1079C-----------------------------------------------
1080 CALL my_alloc(npby_tmp,nnpby,nrbykin+nrbylag)
1081 CALL my_alloc(nom_opt_tmp,lnopt1,nrbykin+nrbylag)
1082 CALL my_alloc(index,nrbykin+nrbylag)
1083 CALL my_alloc(rby_tmp,nrby,nrbykin+nrbylag)
1084C
1085 new_size = 0
1086 DO i=1,nrbykin+nrbylag
1087 nom_opt_tmp(1:lnopt1,i)=nom_opt(1:lnopt1,i)
1088 DO j=1,nnpby
1089 npby_tmp(j,i)=npby(j,i)
1090 ENDDO
1091 DO j=1,nrby
1092 rby_tmp(j,i)=rby(j,i)
1093 ENDDO
1094 IF (npby(12,i)==0) new_size = new_size+1
1095 ENDDO
1096C
1097 cpt_rby = new_size
1098 cpt_rby_secondary = nrbykin+nrbylag
1099 DO i=nrbykin+nrbylag,1,-1
1100 IF (npby_tmp(12,i)==0) THEN
1101 nom_opt(1:lnopt1,cpt_rby)=nom_opt_tmp(1:lnopt1,i)
1102 npby(1:nnpby,cpt_rby)=npby_tmp(1:nnpby,i)
1103 rby(1:nrby,cpt_rby)=rby_tmp(1:nrby,i)
1104 cpt_rby = cpt_rby-1
1105 ELSE
1106C-- SECONDARY RBODY - put at the end of the list
1107 nom_opt(1:lnopt1,cpt_rby_secondary)=nom_opt_tmp(1:lnopt1,i)
1108 npby(1:nnpby,cpt_rby_secondary)=0!NPBY_TMP(1:NNPBY,I)
1109 rby(1:nrby,cpt_rby_secondary)=0!RBY_TMP(1:NRBY,I)
1110 npby(6,cpt_rby_secondary) = npby_tmp(6,i)
1111 npby(12,cpt_rby_secondary) = npby_tmp(12,i)
1112 npby(13,cpt_rby_secondary) = cpt_rby+1
1113 cpt_rby_secondary = cpt_rby_secondary-1
1114 ENDIF
1115 ENDDO
1116C
1117 nrbykin=new_size-nrbylag
1118 DEALLOCATE(npby_tmp)
1119 DEALLOCATE(nom_opt_tmp)
1120 DEALLOCATE(index)
1121 DEALLOCATE(rby_tmp)
1122
1123C
1124 RETURN

◆ trirbmerge()

subroutine trirbmerge ( type (rbmerge_), dimension(nrbykin) rbmerge,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer slrbody,
rby,
integer, dimension(lnopt1,*) nom_opt,
integer, dimension(*) itab,
integer, dimension(*) ibgr,
integer, dimension(nigrv,*) igrv )

Definition at line 701 of file hm_read_merge.F.

703C-----------------------------------------------
704C M o d u l e s
705C-----------------------------------------------
706 USE my_alloc_mod
707 USE message_mod
708 USE rbmerge_mod
709 USE names_and_titles_mod , ONLY : nchartitle
710C-----------------------------------------------
711C I m p l i c i t T y p e s
712C-----------------------------------------------
713#include "implicit_f.inc"
714C-----------------------------------------------
715C C o m m o n B l o c k s
716C-----------------------------------------------
717#include "scr17_c.inc"
718#include "com04_c.inc"
719#include "units_c.inc"
720#include "param_c.inc"
721C-----------------------------------------------
722C D u m m y A r g u m e n t s
723C-----------------------------------------------
724 INTEGER NPBY(NNPBY,*),LPBY(*),SLRBODY,ITAB(*)
725 TYPE (RBMERGE_) , DIMENSION(NRBYKIN) :: RBMERGE
726 my_real rby(nrby,*)
727 INTEGER NOM_OPT(LNOPT1,*)
728 INTEGER IGRV(NIGRV,*),IBGR(*)
729C-----------------------------------------------
730C L o c a l V a r i a b l e s
731C-----------------------------------------------
732 INTEGER I,J,K,KK,M,N,ID,OFFSET,OFFSETID,FLAG_RB
733 INTEGER IDPILE,INODE, IKREM,ISPHER,
734 . ICDG,CNT,NN,IAD
735 INTEGER,DIMENSION(:),ALLOCATABLE :: PILE
736 INTEGER,DIMENSION(:),ALLOCATABLE :: INDEX
737 INTEGER,DIMENSION(:),ALLOCATABLE :: LPBY_TMP
738 INTEGER,DIMENSION(:,:),ALLOCATABLE :: NPBY_TMP
739 INTEGER,DIMENSION(:,:),ALLOCATABLE :: NOM_OPT_TMP
740 my_real,DIMENSION(:,:),ALLOCATABLE :: rby_tmp
741
742 my_real bid, dx, dy, dz, dmstr, delt, dtmp
743 INTEGER NBSECONDARY, IDIR, NSL, NSL_XTRA
744 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
745 INTEGER, DIMENSION(NXTRA_NODE) :: LIST_XTRA
746 CHARACTER MESS*40
747 CHARACTER(LEN=nchartitle) :: TITR
748C-----------------------------------------------
749! RBMERGE(IRBM)%ID :: Rigid body identifier
750! RBMERGE(IRBM)%NBSECONDARY :: Number of SECONDARY rigid body
751! RBMERGE(IRBM)%IMAIN :: 0 if this rigid body doesn't have a MAIN
752! X : The Rigid body's MAIN
753! RBMERGE(IRBM)%LEVEL :: Rigid body level
754! RBMERGE(IRBM)%FLAG_MAIN :: Flag relating the rigid option merge to the MAIN
755! RBMERGE(IRBM)%IDSECONDARY(J) :: SECONDARY rigid bodys attached to the MAIN
756C-----------------------------------------------
757 CALL my_alloc(pile,nrbykin)
758 CALL my_alloc(npby_tmp,nnpby,nrbykin)
759 CALL my_alloc(index,nrbykin)
760 CALL my_alloc(lpby_tmp,slrbody)
761 CALL my_alloc(nom_opt_tmp,lnopt1,nrbykin)
762 CALL my_alloc(rby_tmp,nrby,nrbykin)
763
764 ALLOCATE(itag(numnod))
765 index(1:nrbykin) = 0
766 offset = 0
767 offsetid = 0
768 itag(1:numnod) = 0
769 lpby_tmp(1:slrbody)=0
770 DO n=1,nrbykin
771 IF(rbmerge(n)%LEVEL == 0) THEN
772 IF(rbmerge(n)%NBSECONDARY > 0) THEN
773 pile(:)=0
774 idpile=0
775 CALL rb_explore(n,rbmerge,pile,idpile)
776 DO k=1,idpile
777 index(offsetid+k)=pile(idpile+1-k)
778 ENDDO
779 offsetid = offsetid+idpile
780 ELSE
781 index(nrbykin-offset)=n
782 offset = offset + 1
783 ENDIF
784 ENDIF
785 nom_opt_tmp(1:lnopt1,n)=nom_opt(1:lnopt1,n)
786 DO j=1,nnpby
787 npby_tmp(j,n)=npby(j,n)
788 ENDDO
789 DO j=1,nrby
790 rby_tmp(j,n)=rby(j,n)
791 ENDDO
792 k=npby(11,n)
793 DO j=1,npby(2,n)
794 lpby_tmp(k+j)=lpby(k+j)
795 ENDDO
796 ENDDO
797 lpby(1:slrbody)=0
798 k=0
799 DO n=1,nrbykin
800 nom_opt(1:lnopt1,n)=nom_opt_tmp(1:lnopt1,index(n))
801 DO j=1,nnpby
802 npby(j,n)=npby_tmp(j,index(n))
803 ENDDO
804 npby(11,n)=k
805 DO j=1,nrby
806 rby(j,n)=rby_tmp(j,index(n))
807 ENDDO
808 DO j=1,npby_tmp(2,index(n))
809 lpby(k+j)=lpby_tmp(npby_tmp(11,index(n))+j)
810 ENDDO
811 k=k+npby_tmp(2,index(n))
812 ENDDO
813c
814C------------------------------------
815c Addition of XTRA_NODES by sorting duplicates
816C between the RBs that will be merged and those
817C that will not be
818C------------------------------------
819 inode = 0
820 lpby_tmp(1:slrbody)=0
821 DO n=1,nrbykin
822 k=npby(11,n)
823 npby(11,n)=inode
824 DO j=1,npby(2,n)
825 IF(itag(lpby(k+j)) == 0) THEN
826 inode = inode+1
827 itag(lpby(k+j)) = 1
828 lpby_tmp(inode)=lpby(k+j)
829 ELSE
830 npby(2,n)=npby(2,n)-1
831 ENDIF
832 ENDDO
833 nsl_xtra = 0
834 DO j=1,rbmerge(index(n))%NNODE
835 IF(itag(rbmerge(index(n))%NODE(j)) <= 0) THEN
836 nsl_xtra = nsl_xtra+1
837 inode = inode+1
838 lpby_tmp(inode)=rbmerge(index(n))%NODE(j)
839 IF(rbmerge(index(n))%FLAG_NODE(j) == 1) npby(14,n)=npby(14,n)+1
840 IF(rbmerge(index(n))%FLAG_NODE(j) == 2) npby(15,n)=npby(15,n)+1
841 IF(rbmerge(index(n))%FLAG_NODE(j) == 3) npby(16,n)=npby(16,n)+1
842 IF(itag(rbmerge(index(n))%NODE(j)) == -1) THEN
843 CALL ancmsg(msgid=1644,
844 . msgtype=msgwarning,
845 . anmode=aninfo_blind_1,
846 . i1=itab(rbmerge(index(n))%NODE(j)),
847 . prmod=msg_cumu)
848 ENDIF
849 itag(rbmerge(index(n))%NODE(j)) = 1
850 ENDIF
851 ENDDO
852C
853 npby(2,n)=npby(2,n)+nsl_xtra
854 IF(npby(12,n) == 0) THEN
855 nsl_xtra=npby(14,n)+npby(15,n)+npby(16,n)
856 k=npby(11,n)
857 DO j=1,npby(2,n)-nsl_xtra
858 itag(lpby_tmp(k+j)) = 0
859 ENDDO
860 DO j=npby(2,n)-nsl_xtra+1,npby(2,n)
861 itag(lpby_tmp(k+j)) = -1
862 ENDDO
863 DO i=n-1,1,-1
864 IF((npby(12,i)) < 0) THEN
865 k=npby(11,i)
866 nsl_xtra=npby(14,i)+npby(15,i)+npby(16,i)
867 DO j=1,npby(2,i)-nsl_xtra
868 itag(lpby_tmp(k+j)) = 0
869 ENDDO
870 DO j=npby(2,i)-nsl_xtra+1,npby(2,i)
871 itag(lpby_tmp(k+j)) = -1
872 ENDDO
873 ELSE
874 EXIT
875 ENDIF
876 ENDDO
877 ENDIF
878 ENDDO
879 CALL ancmsg(msgid=1644,
880 . msgtype=msgwarning,
881 . anmode=aninfo_blind_1,
882 . prmod=msg_print)
883
884 lpby(1:slrbody)=0
885 DO n=1,nrbykin
886 k=npby(11,n)
887 DO j=1,npby(2,n)
888 lpby(k+j)=lpby_tmp(k+j)
889 ENDDO
890 ENDDO
891C
892 DO n=1,nrbykin
893 nsl_xtra = npby(14,n)+npby(15,n)+npby(16,n)
894 k = npby(11,n)+npby(2,n)-nsl_xtra
895C------------------------------------
896C SPMD TREATMENT ONLY FOR XTRA_NODES
897C------------------------------------
898 CALL spmdset(n,npby,nnpby,lpby,nsl_xtra,k)
899 ENDDO
900C------------------------------------
901C tag of extra secondary nodes rby with gravity
902C for calculating the work of external forces
903C-------------------------------------
904 DO i=1,numnod
905 itag(i)=0
906 ENDDO
907 k=0
908 DO n=1,nrbykin
909 nsl_xtra = npby(14,n)+npby(15,n)+npby(16,n)
910 k = npby(11,n)+npby(2,n)-nsl_xtra
911 IF(npby(7,n)/=0)THEN
912 DO i=1,nsl_xtra
913 itag(lpby(i+k))=1
914 ENDDO
915 ENDIF
916 ENDDO
917 DO k=1,ngrav
918 nn =igrv(1,k)
919 iad=igrv(4,k)
920 DO i=1,nn
921 n=ibgr(i+iad-1)
922 IF(n > 0)THEN
923 IF(itag(n) == 1)ibgr(i+iad-1) = -n
924 ENDIF
925 ENDDO
926 ENDDO
927C------------------------------------
928C Outputs in 0.out of the merger balances
929C for the top level MAIN
930C-------------------------------------
931 DO n=1,nrbykin
932 nbsecondary=0
933 list_xtra(:)=0
934 kk=0
935
936 IF(npby(12,n) == 0) THEN
937 nsl_xtra=npby(14,n)+npby(15,n)+npby(16,n)
938 k = npby(11,n) + npby(2,n) - nsl_xtra
939 DO j=1,nsl_xtra
940 list_xtra(kk+j) = lpby(k+j)
941 ENDDO
942 kk=kk+nsl_xtra
943
944 DO i=n-1,1,-1
945 IF(npby(12,i) == 0) EXIT
946 npby(4,i) = npby(4,n) ! Same ISENS for MAIN RB's SECONDARYs
947 nbsecondary=nbsecondary+1
948
949 nsl_xtra=npby(14,i)+npby(15,i)+npby(16,i)
950 k = npby(11,i) + npby(2,i) - nsl_xtra
951 DO j=1,nsl_xtra
952 list_xtra(kk+j) = lpby(k+j)
953 ENDDO
954 kk=kk+nsl_xtra
955
956 ENDDO
957 ENDIF
958
959 IF((nbsecondary + kk) > 0) THEN
960 WRITE(iout,1000) npby(6,n)
961 IF(nbsecondary > 0) THEN
962 WRITE(iout,1100) (npby(6,n-i),i=1,nbsecondary)
963 ENDIF
964 IF(kk > 0) THEN
965 WRITE(iout,1200) (itab(list_xtra(j)),j=1,nsl_xtra)
966 ENDIF
967 ENDIF
968
969 ENDDO
970C
971 DEALLOCATE(itag)
972 DEALLOCATE(pile)
973 DEALLOCATE(npby_tmp)
974 DEALLOCATE(index)
975 DEALLOCATE(lpby_tmp)
976 DEALLOCATE(nom_opt_tmp)
977 DEALLOCATE(rby_tmp)
978 RETURN
979C
9801000 FORMAT(/5x,'MAIN RIGID BODY ID ',i10)
9811100 FORMAT(5x,'SECONDARY RIGID BODIES ID',10i10)
9821200 FORMAT(5x,'SECONDARY EXTRA NODES ID ',10i10)
spmdset
subroutine spmdset(n, npby, nnpby, lpby, nsl, k)
Definition spmdset.F:34