OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_set.F File Reference
#include "implicit_f.inc"
#include "radioss_maptable.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_set (set, lsubmodel, inv_group, map_tables, ipart, igrsurf, igrnod, igrslin, igrpart, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, ixs, ixs10, ixc, ixtg, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, ipartc, ipartg, iparts, sh4tree, sh3tree, ixq, knod2elq, nod2elq, x, ixt, ixp, ixr, ixx, kxx, kxsp, ixs20, ixs16, geo, itabm1, ibox, skew, ipartq, ipartt, ipartp, ipartr, subset, rby_msn, iskn, rtrans, unitab, bufsf, iad, siskwn, sskew, rootnam, rootlen, infile_name, infile_name_len)

Function/Subroutine Documentation

◆ hm_set()

subroutine hm_set ( type (set_), dimension(nsets), intent(inout) set,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type(invertgroup_struct_), intent(in) inv_group,
type(mapping_struct_) map_tables,
integer, dimension(lipart1,npart) ipart,
type (surf_), dimension(*), intent(inout) igrsurf,
type (group_), dimension(*), intent(inout) igrnod,
type (surf_), dimension(*), intent(inout) igrslin,
type (group_), dimension(*), intent(inout) igrpart,
type (group_), dimension(*), intent(inout) igrbric,
type (group_), dimension(*), intent(inout) igrquad,
type (group_), dimension(*), intent(inout) igrsh4n,
type (group_), dimension(*), intent(inout) igrsh3n,
type (group_), dimension(*), intent(inout) igrtruss,
type (group_), dimension(*), intent(inout) igrbeam,
type (group_), dimension(*), intent(inout) igrspring,
integer, dimension(nixs,*), intent(in) ixs,
integer, dimension(6,*), intent(in) ixs10,
integer, dimension(nixc,*), intent(in) ixc,
integer, dimension(nixtg,*), intent(in) ixtg,
integer, dimension(*), intent(in) knod2els,
integer, dimension(*), intent(in) nod2els,
integer, dimension(*), intent(in) knod2elc,
integer, dimension(*), intent(in) nod2elc,
integer, dimension(*), intent(in) knod2eltg,
integer, dimension(*), intent(in) nod2eltg,
integer, dimension(*), intent(in) ipartc,
integer, dimension(*), intent(in) ipartg,
integer, dimension(*), intent(in) iparts,
integer, dimension(*), intent(in) sh4tree,
integer, dimension(*), intent(in) sh3tree,
integer, dimension(nixq,*), intent(in) ixq,
integer, dimension(*), intent(in) knod2elq,
integer, dimension(*), intent(in) nod2elq,
x,
integer, dimension(nixt,*), intent(in) ixt,
integer, dimension(nixp,*), intent(in) ixp,
integer, dimension(nixr,*), intent(in) ixr,
integer, dimension(*), intent(in) ixx,
integer, dimension(*), intent(in) kxx,
integer, dimension(nisp,*), intent(in) kxsp,
integer, dimension(12,*), intent(in) ixs20,
integer, dimension(8,*), intent(in) ixs16,
geo,
integer, dimension(2*numnod), intent(in) itabm1,
type (box_), dimension(nbbox) ibox,
skew,
integer, dimension(*), intent(in) ipartq,
integer, dimension(*), intent(in) ipartt,
integer, dimension(*), intent(in) ipartp,
integer, dimension(*), intent(in) ipartr,
type (subset_), dimension(*), intent(inout) subset,
integer, dimension(2*nrbody), intent(in) rby_msn,
integer, dimension(liskn,siskwn/liskn), intent(in) iskn,
dimension(ntransf,nrtrans), intent(in) rtrans,
type (unit_type_), intent(in) unitab,
dimension(lisurf1*(nsurf+nsets)), intent(inout) bufsf,
integer, intent(inout) iad,
integer, intent(in) siskwn,
integer, intent(in) sskew,
character(len=rootlen), intent(in) rootnam,
integer, intent(in) rootlen,
character(len=infile_name_len), intent(in) infile_name,
integer, intent(in) infile_name_len )

Definition at line 75 of file hm_set.F.

88C-----------------------------------------------
89C ROUTINE DESCRIPTION :
90C ===================
91C Main Routine for SET read & treatments
92C-----------------------------------------------
93C DUMMY ARGUMENTS DESCRIPTION:
94C ===================
95C
96C NAME DESCRIPTION
97C
98C SET Set Structure
99C LSUBMODEL Submodel Structure
100C IPARTM1 PART Map table UID -> Internal ID
101C IGRxxx Radioss Structures Groups of Nodes, Parts, Elements, Surfaces and lines
102C===========================================================================================
103C-----------------------------------------------
104C M o d u l e s
105C-----------------------------------------------
106 USE hm_option_read_mod
107 USE setdef_mod
108 USE submodel_mod
109 USE inverted_group_mod
110 USE mapping_option_mod
111 USE groupdef_mod
112 USE optiondef_mod
113 USE message_mod
114 USE set_scratch_mod
115 USE unitab_mod
116 USE create_plane_clause_mod
117 USE create_nodens_clause_mod
118 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
119C-----------------------------------------------
120C I m p l i c i t T y p e s
121C-----------------------------------------------
122#include "implicit_f.inc"
123C-----------------------------------------------
124C C o m m o n B l o c k s
125C-----------------------------------------------
126#include "radioss_maptable.inc"
127#include "com04_c.inc"
128#include "scr17_c.inc"
129#include "param_c.inc"
130#include "sphcom.inc"
131C-----------------------------------------------
132C D u m m y A r g u m e n t s
133C-----------------------------------------------
134 TYPE (SET_), DIMENSION(NSETS),INTENT(INOUT) :: SET
135 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
136 TYPE(INVERTGROUP_STRUCT_),INTENT(IN) :: INV_GROUP
137 TYPE(MAPPING_STRUCT_) :: MAP_TABLES
138 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
139 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
140
141 TYPE (GROUP_) , INTENT(INOUT):: IGRNOD(*)
142 TYPE (SURF_) , INTENT(INOUT):: IGRSURF(*)
143 TYPE (SURF_) , INTENT(INOUT):: IGRSLIN(*)
144 TYPE (GROUP_) , INTENT(INOUT):: IGRPART(*)
145 TYPE (GROUP_) , INTENT(INOUT):: IGRBRIC(*)
146 TYPE (GROUP_) , INTENT(INOUT):: IGRQUAD(*)
147 TYPE (GROUP_) , INTENT(INOUT):: IGRSH4N(*)
148 TYPE (GROUP_) , INTENT(INOUT):: IGRSH3N(*)
149 TYPE (GROUP_) , INTENT(INOUT):: IGRTRUSS(*)
150 TYPE (GROUP_) , INTENT(INOUT):: IGRBEAM(*)
151 TYPE (GROUP_) , INTENT(INOUT):: IGRSPRING(*)
152 TYPE (SUBSET_) , INTENT(INOUT) :: SUBSET(*)
153
154 INTEGER, INTENT(INOUT) :: IAD
155 my_real, INTENT(INOUT) :: bufsf(lisurf1*(nsurf+nsets))
156 INTEGER, DIMENSION(2*NUMNOD), INTENT(IN) :: ITABM1
157 INTEGER, DIMENSION(2*NRBODY), INTENT(IN) :: RBY_MSN
158
159 INTEGER IPART(LIPART1,NPART)
160 INTEGER, INTENT(IN) :: IXS(NIXS,*),IXS10(6,*),IXS16(8,*),IXS20(12,*),
161 . IXC(NIXC,*),IXTG(NIXTG,*),KNOD2ELS(*),KNOD2ELC(*),KNOD2ELTG(*),
162 . NOD2ELS(*),NOD2ELC(*),NOD2ELTG(*),IPARTC(*),IPARTG(*),IPARTS(*),
163 . SH4TREE(*),SH3TREE(*),KNOD2ELQ(*),NOD2ELQ(*),IXQ(NIXQ,*),
164 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IXX(*),KXX(*),KXSP(NISP,*),
165 . IPARTQ(*),IPARTT(*),IPARTP(*),IPARTR(*)
166 INTEGER, INTENT(IN) :: SISKWN,SSKEW
167 my_real
168 . x(3,*),geo(npropg,*),skew(lskew,*)
169 INTEGER, INTENT(IN) :: ISKN(LISKN,SISKWN/LISKN)
170 my_real, INTENT(IN) :: rtrans(ntransf,nrtrans)
171
172 INTEGER, INTENT(IN) :: ROOTLEN,INFILE_NAME_LEN
173 CHARACTER(LEN=ROOTLEN), INTENT(IN) :: ROOTNAM
174 CHARACTER(LEN=INFILE_NAME_LEN), INTENT(IN) :: INFILE_NAME
175C-----------------------------------------------
176C L o c a l V a r i a b l e s
177C-----------------------------------------------
178 INTEGER IGS,I,J,ELTYP_SEG,ELTYP_ALL,SUB_ID
179 INTEGER SET_ID,ISET_TYPE,CLAUSES_MAX,ITMP,ICODE,SETL_SIZE
180 INTEGER OPT_D,OPT_O,OPT_G,OPT_B,OPT_A,OPT_E,OPT_I,OPT_C
181 INTEGER , DIMENSION(:), ALLOCATABLE :: SET_LIST,SETL
182 INTEGER IDEBUG
183 LOGICAL IS_AVAILABLE
184 TYPE (SET_) :: CLAUSE
185 INTEGER CLAUSE_OPERATOR
186 INTEGER ADMBID
187 INTEGER DUMMY_ARRAY(10),DSZ
188 DATA admbid/0/
189 TYPE (SET_SCRATCH) :: DELBUF
190C-----------------CREATE_SET_ARRAY------------------------------
191C Characters
192 CHARACTER MESS*40
193 CHARACTER(LEN=NCHARFIELD) :: KEYSET,SET_TYPE,KEY_TYPE
194 CHARACTER(LEN=NCHARKEY) :: KEY,KEYPART
195 CHARACTER(LEN=NCHARTITLE) :: TITLE,SET_TITLE,TITLE2
196
197C-----------------------------------------------
198C Initialization / SET Dependency build
199C-----------------------------------------------
200
201 idebug = 0
202 IF (idebug == 1) THEN
203 print*,'------------- SET NG -------------'
204 ENDIF
205
206
207C-------------------------------------------
208C Reorder Sets to take care of dependencies
209C-------------------------------------------
210 ALLOCATE(set_list(nsets))
211 CALL sort_set(lsubmodel ,map_tables, set_list,set,clause)
212
213C-----------------------------------------------
214C SET MAIN LOOP
215C-----------------------------------------------
216 CALL hm_option_start_list('/SET')
217
218 ! ------------------------
219 ! Initial CLAUSE init
220 ! ------------------------
221
222
223 DO i = 1,nsets
224 igs = set_list(i)
225
226 set_type = ' '
227 keyset = ' '
228 key = ' '
229
230 CALL hm_option_read_key (lsubmodel,
231 . option_id = set_id,
232 . option_titr = set_title,
233 . keyword2 = key,
234 . opt_pos = igs,
235 . submodel_id = sub_id)
236 CALL hm_get_string('set_Type' , set_type ,ncharfield, is_available)
237 CALL hm_get_intv ('iset_Type', iset_type,is_available,lsubmodel)
238
239 ! --------------------
240 ! Current SET_INIT
241 ! --------------------
242 CALL set_init(set ,igs ,set_id, set_title, iset_type)
243
244
245 CALL hm_get_intv('clausesmax',clauses_max,is_available,lsubmodel)
246
247 IF (idebug == 1)THEN
248 print*,'--------------------------------------------'
249 print*,'IGS =',igs
250 print*,'MY_SET_ID =',set_id
251 print*,'SET_TITLE =',trim(set_title)
252 print*,' KEY =',key(1:len_trim(key))
253 print*,'SET_TYPE =',set_type(1:len_trim(set_type))
254 print*,'CLAUSE_MAX=',clauses_max
255 print*,'SET_ACTIVE=',set(igs)%SET_ACTIV
256 print*,' '
257 ENDIF
258
259 DO j=1,clauses_max ! max KEY's of the current /SET
260
261 CALL clause_init(clause)
262
263 CALL hm_get_string_index('KEY_type', keyset, j, ncharline, is_available)
264
265 CALL hm_get_int_array_index('opt_D',opt_d,j,is_available,lsubmodel)
266 CALL hm_get_int_array_index('opt_O',opt_o,j,is_available,lsubmodel)
267 CALL hm_get_int_array_index('opt_G',opt_g,j,is_available,lsubmodel)
268 CALL hm_get_int_array_index('opt_B',opt_b,j,is_available,lsubmodel)
269 CALL hm_get_int_array_index('opt_A',opt_a,j,is_available,lsubmodel)
270 CALL hm_get_int_array_index('opt_E',opt_e,j,is_available,lsubmodel)
271 CALL hm_get_int_array_index('opt_I',opt_i,j,is_available,lsubmodel)
272 CALL hm_get_int_array_index('opt_C',opt_c,j,is_available,lsubmodel)
273
274 !-----------------------
275 ! issue 'KEY' ---> read one more character than the KEY
276 ! ===> workaround
277
278 itmp = len(trim(keyset))
279 icode = iachar(keyset(itmp:itmp))
280 IF (icode == 0) THEN
281 keyset(itmp:itmp)=' '
282 ENDIF
283
284 !---------------------
285 ! Clause Operator
286 !---------------------
287 CALL set_operator( opt_d,opt_o,opt_g, ! CLAUSE_OPERATOR = SET_ADD (1)
288 * opt_b,opt_a,opt_e, ! SET_DELETE (2)
289 * opt_i,opt_c, ! SET_INTERSECT (3)
290 * clause_operator )
291
292 ! -----------------------------------------------------
293 IF (idebug == 1)THEN
294 WRITE(6,'(A,I6,A)' ) ' ',j,' --------'
295 WRITE(6,'(A,A)') ' ',trim(keyset)
296 WRITE(6,'(A,I2)') ' OP :',clause_operator
297 ENDIF
298 ! -----------------------------------------------------
299 ! To issue error & Warnings, initialize Clause ID & Title with SET_ID + TITLE
300 clause%SET_ID = set(igs)%SET_ID
301 clause%TITLE = trim(set(igs)%TITLE)
302
303 ! Clause Treatment
304 !------------------------
305
306 SELECT CASE (trim(keyset))
307
308 CASE ( 'PART' )
309
310 ! PART LIST FROM CLAUSE
311 !-----------------------
312 CALL create_part_clause(
313 . clause ,map_tables%IPARTM ,j ,opt_g ,is_available ,
314 . lsubmodel)
315
316 ! Element from PART
317 !-------------------
318 CALL create_element_from_part(clause ,inv_group,numsph)
319
320 ! Surface from ELEMENT
321 !-------------------
322 CALL create_surface_from_element(
323 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
324 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
325 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
326 . ipart ,clause ,opt_a ,opt_o ,ixq ,
327 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
328 . .false. )
329
330
331 ! Line from 1D_ELEMENT
332 !-------------------
333 CALL create_line_from_element(ixt ,ixp ,ixr ,clause,delbuf ,
334 . .false.)
335
336 ! Line from SURFACE
337 CALL create_line_from_surface(clause,keyset,opt_a,opt_e,delbuf ,
338 . .false.)
339
340 ! Node from ELEMENT
341 CALL create_node_from_element(
342 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
343 . ixc ,ixtg ,ixt ,ixp ,ixr ,
344 . ixx ,kxx ,kxsp ,clause ,geo,
345 . dummy_array ,dsz ,.false. )
346
347
348 CASE ( 'NODE' )
349
350 ! NODE LIST FROM CLAUSE
351 !-----------------------
352 CALL create_node_clause(
353 . clause ,itabm1 ,j ,opt_g ,is_available ,
354 . lsubmodel,opt_b ,ibox ,x ,skew ,
355 . set_title,keyset )
356
357
358 CASE ( 'SOLID' )
359
360 ! SOLID LIST FROM CLAUSE
361 !-----------------------
362 CALL create_elt_clause(
363 . clause, elt_solid,
364 . map_tables%ISOLM, numels,
365 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
366 . opt_c ,ibox ,x ,skew ,set_title,
367 . keyset ,nixs ,ixs ,8 ,iparts ,
368 . ipart ,admbid ,admbid ,admbid )
369
370 ! Surface from ELEMENT
371 !-------------------
372 CALL create_surface_from_element(
373 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
374 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
375 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
376 . ipart ,clause ,opt_a ,opt_o ,ixq ,
377 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
378 . .false. )
379
380 ! Line from SURFACE
381 CALL create_line_from_surface(clause,keyset,opt_a,opt_e,delbuf ,
382 . .false.)
383
384 ! Node from ELEMENT
385 CALL create_node_from_element(
386 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
387 . ixc ,ixtg ,ixt ,ixp ,ixr ,
388 . ixx ,kxx ,kxsp ,clause ,geo ,
389 . dummy_array ,dsz ,.false. )
390
391
392
393 CASE ( 'QUAD' )
394
395 ! QUAD LIST FROM CLAUSE
396 !-----------------------
397 CALL create_elt_clause(
398 . clause, elt_quad,
399 . map_tables%IQUADM, numelq,
400 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
401 . opt_c ,ibox ,x ,skew ,set_title,
402 . keyset ,nixq ,ixq ,4 ,ipartq ,
403 . ipart ,admbid ,admbid ,admbid )
404
405 ! Surface from ELEMENT
406 !-------------------
407 CALL create_surface_from_element(
408 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
409 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
410 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
411 . ipart ,clause ,opt_a ,opt_o ,ixq ,
412 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
413 . .false. )
414
415 ! Line from SURFACE
416 CALL create_line_from_surface(clause,keyset,opt_a,opt_e,delbuf ,
417 . .false.)
418
419 ! Node from ELEMENT
420 CALL create_node_from_element(
421 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
422 . ixc ,ixtg ,ixt ,ixp ,ixr ,
423 . ixx ,kxx ,kxsp ,clause ,geo ,
424 . dummy_array ,dsz ,.false. )
425
426
427
428 CASE ( 'SHELL' )
429
430 ! SHELL LIST FROM CLAUSE
431 !-----------------------
432 CALL create_elt_clause(
433 . clause, elt_sh4n,
434 . map_tables%ISH4NM, numelc,
435 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
436 . opt_c ,ibox ,x ,skew ,set_title,
437 . keyset ,nixc ,ixc ,4 ,ipartc ,
438 . ipart ,3 ,sh4tree ,ksh4tree )
439
440
441 ! Surface from ELEMENT
442 !-------------------
443 CALL create_surface_from_element(
444 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
445 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
446 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
447 . ipart ,clause ,opt_a ,opt_o ,ixq ,
448 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
449 . .false. )
450
451 ! Line from SURFACE
452 CALL create_line_from_surface(clause,keyset,opt_a,opt_e,delbuf ,
453 . .false.)
454
455 ! Node from ELEMENT
456 CALL create_node_from_element(
457 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
458 . ixc ,ixtg ,ixt ,ixp ,ixr ,
459 . ixx ,kxx ,kxsp ,clause ,geo ,
460 . dummy_array ,dsz ,.false. )
461
462
463
464 CASE ( 'SH3N' )
465
466 ! SH3N LIST FROM CLAUSE
467 !-----------------------
468 CALL create_elt_clause(
469 . clause, elt_sh3n,
470 . map_tables%ISH3NM, numeltg,
471 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
472 . opt_c ,ibox ,x ,skew ,set_title,
473 . keyset ,nixtg ,ixtg ,3 ,ipartg ,
474 . ipart ,3 ,sh3tree ,ksh3tree )
475
476 ! Surface from ELEMENT
477 !-------------------
478 CALL create_surface_from_element(
479 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
480 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
481 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
482 . ipart ,clause ,opt_a ,opt_o ,ixq ,
483 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
484 . .false. )
485
486 ! Line from SURFACE
487 CALL create_line_from_surface(clause,keyset,opt_a,opt_e,delbuf ,
488 . .false.)
489
490 ! Node from ELEMENT
491 CALL create_node_from_element(
492 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
493 . ixc ,ixtg ,ixt ,ixp ,ixr ,
494 . ixx ,kxx ,kxsp ,clause ,geo ,
495 . dummy_array ,dsz ,.false. )
496
497
498
499 CASE ( 'TRIA' )
500
501 ! SH3N LIST FROM CLAUSE
502 !-----------------------
503 CALL create_elt_clause(
504 . clause, elt_tria,
505 . map_tables%ITRIAM, numeltria,
506 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
507 . opt_c ,ibox ,x ,skew ,set_title,
508 . keyset ,nixtg ,ixtg ,3 ,ipartg ,
509 . ipart ,admbid ,admbid ,admbid )
510
511 ! No surfaces, no lines
512
513 ! Node from ELEMENT
514 CALL create_node_from_element(
515 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
516 . ixc ,ixtg ,ixt ,ixp ,ixr ,
517 . ixx ,kxx ,kxsp ,clause ,geo ,
518 . dummy_array ,dsz ,.false. )
519
520
521 CASE ( 'TRUSS' )
522
523 ! TRUSS LIST FROM CLAUSE
524 !-----------------------
525 CALL create_elt_clause(
526 . clause, elt_truss,
527 . map_tables%ITRUSSM, numelt,
528 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
529 . opt_c ,ibox ,x ,skew ,set_title,
530 . keyset ,nixt ,ixt ,2 ,ipartt ,
531 . ipart ,admbid ,admbid ,admbid )
532
533 ! Line from 1D_ELEMENT
534 !-------------------
535 CALL create_line_from_element(ixt ,ixp ,ixr ,clause,delbuf ,
536 . .false.)
537
538 ! Node from ELEMENT
539 CALL create_node_from_element(
540 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
541 . ixc ,ixtg ,ixt ,ixp ,ixr ,
542 . ixx ,kxx ,kxsp ,clause ,geo ,
543 . dummy_array ,dsz ,.false. )
544
545
546 CASE ( 'BEAM' )
547
548 ! BEAM LIST FROM CLAUSE
549 !-----------------------
550 CALL create_elt_clause(
551 . clause, elt_beam,
552 . map_tables%IBEAMM, numelp,
553 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
554 . opt_c ,ibox ,x ,skew ,set_title,
555 . keyset ,nixp ,ixp ,2 ,ipartp ,
556 . ipart ,admbid ,admbid ,admbid )
557
558 ! Line from 1D_ELEMENT
559 !-------------------
560 CALL create_line_from_element(ixt ,ixp ,ixr ,clause,delbuf ,
561 . .false.)
562
563 ! Node from ELEMENT
564 CALL create_node_from_element(
565 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
566 . ixc ,ixtg ,ixt ,ixp ,ixr ,
567 . ixx ,kxx ,kxsp ,clause ,geo ,
568 . dummy_array ,dsz ,.false. )
569
570 CASE ( 'SPRING' )
571
572 ! SPRING LIST FROM CLAUSE
573 !-----------------------
574 CALL create_elt_clause(
575 . clause, elt_spring,
576 . map_tables%ISPRINGM, numelr,
577 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
578 . opt_c ,ibox ,x ,skew ,set_title,
579 . keyset ,nixr ,ixr ,2 ,ipartr ,
580 . ipart ,admbid ,admbid ,admbid )
581
582 ! Line from 1D_ELEMENT
583 !-------------------
584 CALL create_line_from_element(ixt ,ixp ,ixr ,clause,delbuf ,
585 . .false.)
586
587 ! Node from ELEMENT
588 CALL create_node_from_element(
589 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
590 . ixc ,ixtg ,ixt ,ixp ,ixr ,
591 . ixx ,kxx ,kxsp ,clause ,geo ,
592 . dummy_array ,dsz ,.false. )
593
594
595 CASE ('SET')
596
597 ALLOCATE(setl(nsets))
598 setl_size=0
599
600 CALL create_set_array(setl ,setl_size, ! Read the clause & compute the list of SETs
601 . map_tables%ISETM , map_tables%NSET_GENERAL,
602 . j ,opt_g ,is_available ,
603 . lsubmodel,clause,1)
604
605 CALL create_set_clause( set,
606 * setl ,setl_size,
607 * clause,
608 * ixs ,ixs10 , ixq ,
609 * ixc ,ixtg ,ixt ,ixp ,ixr ,
610 * sh4tree,
611 * sh3tree ,knod2els ,nod2els ,knod2elc ,nod2elc,
612 * knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
613 * ipart ,opt_a ,opt_o ,knod2elq ,nod2elq,
614 * x ,keyset ,opt_e ,delbuf )
615
616 DEALLOCATE(setl)
617
618 CASE ('SETCOL')
619
620 ALLOCATE(setl(nsets))
621 setl_size=0
622
623 CALL create_setcol_array(set,setl, setl_size ,
624 * map_tables%ISETCOLM,map_tables%NSET_COLLECT,
625 * j,opt_g ,is_available ,
626 * lsubmodel)
627
628 ! At this stage we have list of SETs with internal IDs
629 ! The merge is same for SETs
630 ! -----------------------------------------------------
631 CALL create_set_clause( set,
632 * setl ,setl_size,
633 * clause,
634 * ixs ,ixs10 , ixq ,
635 * ixc ,ixtg ,ixt ,ixp ,ixr ,
636 * sh4tree,
637 * sh3tree ,knod2els ,nod2els ,knod2elc ,nod2elc,
638 * knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
639 * ipart ,opt_a ,opt_o ,knod2elq ,nod2elq,
640 * x ,keyset ,opt_e ,delbuf )
641
642 CASE ( 'SEG' )
643
644 ! Surfaces and lines LIST FROM CLAUSE
645 !-----------------------
646 CALL create_seg_clause(clause, itabm1, j, is_available, lsubmodel)
647
648 ! Line from SURFACE
649 ! ELTYP_SEG = 0
650 IF (clause%NB_SURF_SEG > 0)CALL create_line_from_surface(clause,keyset,opt_a,opt_e,delbuf,.false.)
651
652 ! Node from SEG (SURF or LINE)
653 CALL create_node_from_seg( clause )
654
655
656 CASE ( 'ALL' )
657
658 !-----------------------
659 ! ALL model
660 !-----------------------
661
662 ! part list from clause
663 !-----------------------
664 CALL create_part_all_clause( clause )
665
666 ! Element from PART
667 !-------------------
668 CALL create_elem_all_clause( clause )
669
670 ! Surface from ELEMENT
671 !-------------------
672 CALL create_surface_from_element(
673 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
674 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
675 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
676 . ipart ,clause ,opt_a ,opt_o ,ixq ,
677 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
678 . .false. )
679
680
681 ! Line from 1D_ELEMENT
682 !-------------------
683 CALL create_line_from_element(ixt ,ixp ,ixr ,clause,delbuf ,
684 . .false.)
685
686 ! Line from SURFACE
687!! ELTYP_ALL = 0
688 CALL create_line_from_surface(clause,keyset,opt_a,opt_e,delbuf ,
689 . .false.)
690
691 ! Node ( 1 ... NUMNOD )
692 CALL create_node_all_clause( clause )
693
694
695 !IF (idebug == 1)THEN
696 ! print*,'Check_ALL_model'
697 ! print*,'---------------'
698 ! print*,'NUMNOD = ' ,NUMNOD, 'CLAUSE%NB_NODE = ' ,CLAUSE%NB_NODE
699 ! print*,'NPART = ' ,NPART, 'CLAUSE%NB_PART = ' ,CLAUSE%NB_PART
700 ! print*,'SOLID = ' ,NUMELS, 'CLAUSE%NB_SOLID = ' ,CLAUSE%NB_SOLID
701 ! print*,'QUAD = ' ,NUMELQ, 'CLAUSE%NB_QUAD = ' ,CLAUSE%NB_QUAD
702 ! print*,'SHELL = ' ,NUMELC, 'CLAUSE%NB_SH4N = ' ,CLAUSE%NB_SH4N
703 ! print*,'SH3N = ' ,NUMELTG, 'CLAUSE%NB_SH3N = ' ,CLAUSE%NB_SH3N
704 ! print*,'TRIA = ' ,NUMELTRIA, 'CLAUSE%NB_TRIA = ' ,CLAUSE%NB_TRIA
705 ! print*,'TRUSS = ' ,NUMELT, 'CLAUSE%NB_TRUSS = ' ,CLAUSE%NB_TRUSS
706 ! print*,'BEAM = ' ,NUMELP, 'CLAUSE%NB_BEAM = ' ,CLAUSE%NB_BEAM
707 ! print*,'SPRING = ',NUMELR, 'CLAUSE%NB_SPRING = ',CLAUSE%NB_SPRING
708 !ENDIF
709
710 CASE ( 'BOX', 'BOX2' )
711
712 CALL create_box_clause(
713 * clause ,j ,is_available,lsubmodel ,keyset ,
714 * itabm1 ,ibox ,x ,skew ,ixs10 ,
715 * set_title,ipart ,sh4tree ,sh3tree ,iparts ,
716 * ipartq ,ipartc ,ipartg ,ipartt ,ipartp ,
717 * ipartr ,ixs ,ixq ,ixc ,ixtg ,
718 * ixt ,ixp ,ixr ,knod2els ,nod2els ,
719 * knod2elc ,nod2elc ,knod2eltg ,nod2eltg ,knod2elq ,
720 * nod2elq ,opt_a ,opt_o ,opt_e ,delbuf ,
721 * rby_msn ,map_tables%IRBODYM)
722
723
724 CASE ( 'subs' )
725
726 ! PART LIST FROM CLAUSE
727 !-----------------------
728 CALL CREATE_SUBS_CLAUSE(
729 . CLAUSE ,MAP_TABLES%ISUBSM ,J ,OPT_G ,IS_AVAILABLE ,
730 . LSUBMODEL,SUBSET )
731
732 ! Element from PART
733 !-------------------
734 CALL CREATE_ELEMENT_FROM_PART(CLAUSE ,INV_GROUP,NUMSPH)
735
736 ! Surface from ELEMENT
737 !-------------------
738 CALL CREATE_SURFACE_FROM_ELEMENT(
739 . IXS ,IXS10 ,SH4TREE ,SH3TREE ,IXC ,
740 . IXTG ,KNOD2ELS ,NOD2ELS ,KNOD2ELC ,NOD2ELC ,
741 . KNOD2ELTG ,NOD2ELTG ,IPARTC ,IPARTG ,IPARTS ,
742 . IPART ,CLAUSE ,OPT_A ,OPT_O ,IXQ ,
743 . KNOD2ELQ ,NOD2ELQ ,X ,KEYSET ,DELBUF ,
744 . .FALSE. )
745
746
747 ! Line from 1D_ELEMENT
748 !-------------------
749 CALL CREATE_LINE_FROM_ELEMENT(IXT ,IXP ,IXR ,CLAUSE,DELBUF ,
750 . .FALSE.)
751
752 ! Line from SURFACE
753 CALL CREATE_LINE_FROM_SURFACE(CLAUSE,KEYSET,OPT_A,OPT_E,DELBUF ,
754 . .FALSE.)
755
756 ! Node from ELEMENT
757 CALL CREATE_NODE_FROM_ELEMENT(
758 . IXS ,IXS10 ,IXS20 ,IXS16 ,IXQ ,
759 . IXC ,IXTG ,IXT ,IXP ,IXR ,
760 . IXX ,KXX ,KXSP ,CLAUSE ,GEO ,
761 . DUMMY_ARRAY ,DSZ ,.FALSE. )
762
763
764 CASE ( 'subm' )
765
766
767 ! PART LIST FROM CLAUSE
768 !-----------------------
769 CALL CREATE_SUBM_CLAUSE(
770 . CLAUSE ,MAP_TABLES%ISUBMM ,J ,OPT_G ,IS_AVAILABLE ,
771 . LSUBMODEL,IPART )
772
773 ! Element from PART
774 !-------------------
775 CALL CREATE_ELEMENT_FROM_PART(CLAUSE ,INV_GROUP,NUMSPH)
776
777 ! Surface from ELEMENT
778 !-------------------
779 CALL CREATE_SURFACE_FROM_ELEMENT(
780 . IXS ,IXS10 ,SH4TREE ,SH3TREE ,IXC ,
781 . IXTG ,KNOD2ELS ,NOD2ELS ,KNOD2ELC ,NOD2ELC ,
782 . KNOD2ELTG ,NOD2ELTG ,IPARTC ,IPARTG ,IPARTS ,
783 . IPART ,CLAUSE ,OPT_A ,OPT_O ,IXQ ,
784 . KNOD2ELQ ,NOD2ELQ ,X ,KEYSET ,DELBUF ,
785 . .FALSE. )
786
787
788 ! Line from 1D_ELEMENT
789 !-------------------
790 CALL CREATE_LINE_FROM_ELEMENT(IXT ,IXP ,IXR ,CLAUSE,DELBUF ,
791 . .FALSE.)
792
793 ! Line from SURFACE
794 CALL CREATE_LINE_FROM_SURFACE(CLAUSE,KEYSET,OPT_A,OPT_E,DELBUF ,
795 . .FALSE.)
796
797
798
799 CASE ( 'rbody' )
800
801 ! RBODY LIST FROM CLAUSE
802 CALL CREATE_RBODY_CLAUSE(
803 . CLAUSE ,MAP_TABLES%IRBODYM ,J ,OPT_G ,IS_AVAILABLE ,
804 . LSUBMODEL,OPT_B ,IBOX,X ,SKEW ,
805 . SET_TITLE,KEYSET ,RBY_MSN )
806
807 ! Main node from RBODY
808 CALL CREATE_NODE_FROM_RBODY(RBY_MSN,CLAUSE)
809
810
811 CASE ( 'ellips' )
812
813 ! Hyper-ellipsoid surface definition
814 !-----------------------
815 SET(IGS)%NB_ELLIPSE = 1
816 CALL CREATE_ELLIPSE_CLAUSE(CLAUSE%SET_ID,CLAUSE%TITLE ,SUB_ID ,SKEW ,RTRANS,
817 . CLAUSE ,NRTRANS ,LSUBMODEL,UNITAB ,ISKN ,
818 . IAD ,NTRANSF ,NUMSKW ,LISKN ,LSKEW ,
819 . SSKEW ,SISKWN ,NSPCOND ,NUMSPH )
820
821 CASE ( 'plane' )
822
823 ! PLANE surface definition
824 !-----------------------
825 SET(IGS)%NB_PLANE = 1
826 CALL CREATE_PLANE_CLAUSE(CLAUSE%SET_ID ,CLAUSE%TITLE ,SUB_ID ,CLAUSE ,LSUBMODEL,
827 . UNITAB ,IAD ,NRTRANS ,NTRANSF,RTRANS )
828
829 CASE ( 'nodens' )
830
831 ! NODENS -> unsortable node list
832 !-----------------------
833 CALL CREATE_NODENS_CLAUSE(CLAUSE ,ITABM1 ,J ,IS_AVAILABLE ,LSUBMODEL ,NUMNOD)
834
835 CASE DEFAULT
836
837 CALL ANCMSG(MSGID=1906,ANMODE=ANSTOP,
838 . MSGTYPE=MSGERROR,
839 . I1 = CLAUSE%SET_ID,
840 . C1=TRIM(CLAUSE%TITLE),
841 . C2=TRIM(KEYSET) )
842
843
844 END SELECT
845
846C -----------------------------------------------------
847 CALL INSERT_CLAUSE_IN_SET(SET(IGS) ,CLAUSE ,CLAUSE_OPERATOR,
848 . IXS ,IXS10 , IXQ ,
849 . IXC ,IXTG ,IXT ,IXP ,IXR ,
850 . SH4TREE,
851 . SH3TREE ,KNOD2ELS ,NOD2ELS ,KNOD2ELC ,NOD2ELC,
852 . KNOD2ELTG ,NOD2ELTG ,IPARTC ,IPARTG ,IPARTS ,
853 . IPART ,OPT_A ,OPT_O ,KNOD2ELQ ,NOD2ELQ,
854 . X ,KEYSET ,OPT_E ,DELBUF )
855C -----------------------------------------------------
856!
857 ENDDO ! DO J=1,CLAUSES_MAX
858
859 IF( TRIM(KEY) == 'collect' ) THEN
860
861 IF (SET(IGS)%SET_ACTIV == 1)THEN ! Merge the Collect SETs only if Active
862
863 CALL CREATE_SET_COLLECT(SET ,SET_ID ,IGS ,MAP_TABLES%ISETCOLM ,MAP_TABLES%NSET_COLLECT,
864 * IXS ,IXS10 , IXQ ,
865 * IXC ,IXTG ,IXT ,IXP ,IXR ,
866 * SH4TREE,
867 . SH3TREE ,KNOD2ELS ,NOD2ELS ,KNOD2ELC ,NOD2ELC,
868 . KNOD2ELTG ,NOD2ELTG ,IPARTC ,IPARTG ,IPARTS ,
869 . IPART ,OPT_A ,OPT_O ,KNOD2ELQ ,NOD2ELQ,
870 . X ,KEYSET ,OPT_E ,DELBUF )
871
872 ENDIF
873
874 ENDIF
875
876 ENDDO ! DO IGS=1,NSETS
877
878 CALL CLAUSE_INIT(CLAUSE)
879
880
881
882 ! -----------------------------------------------------
883 !IF (IDEBUG == 1)THEN
884 ! DO IGS=1,NSETS
885 ! print*,'-----------'
886 ! print*,IGS
887 ! print*,'nb_part=',SET(IGS)%NB_PART
888 ! IF(SET(IGS)%NB_PART > 0)THEN
889 ! DO I=1,SET(IGS)%NB_PART
890 ! print*,'parts:',SET(IGS)%PART(I),IPART(4,SET(IGS)%PART(I))
891 ! ENDDO
892 ! ENDIF
893 ! ENDDO
894 ! print*,'-----------'
895 ! print*,' '
896 !ENDIF
897 ! -----------------------------------------------------
898
899 ! Fill Radioss group, lines surfaces
900 ! -----------------------------------------------------
901 CALL FILL_IGR(SET,
902 . IGRSURF ,IGRNOD ,IGRSLIN ,IGRPART ,IGRBRIC, IGRQUAD ,
903 . IGRSH4N ,IGRSH3N ,IGRTRUSS ,IGRBEAM ,IGRSPRING,BUFSF ,
904 . LISURF1 ,ROOTNAM ,ROOTLEN ,INFILE_NAME ,INFILE_NAME_LEN)
905
906
clause_init
subroutine clause_init(clause)
Definition clause_init.F:31
collect
subroutine collect(a, itab, weight, nodglob)
Definition collect.F:31
my_real
#define my_real
Definition cppsort.cpp:32
create_box_clause
subroutine create_box_clause(clause, jclause, is_available, lsubmodel, keyset, itabm1, ibox, x, skew, ixs10, set_title, ipart, sh4tree, sh3tree, iparts, ipartq, ipartc, ipartg, ipartt, ipartp, ipartr, ixs, ixq, ixc, ixtg, ixt, ixp, ixr, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, knod2elq, nod2elq, opt_a, opt_o, opt_e, delbuf, rby_msn, irbodym)
Definition create_box_clause.F:49
create_elem_all_clause
subroutine create_elem_all_clause(clause)
Definition create_elem_all_clause.F:31
create_elt_clause
subroutine create_elt_clause(clause, eltyp, map, mapsize, jclause, opt_g, is_available, lsubmodel, opt_b, opt_c, ibox, x, skew, set_title, keyset, nix, ix, nix1, iparte, ipart, klevtree, eltree, keltree)
Definition create_element_clause.F:43
create_element_from_part
subroutine create_element_from_part(clause, inv_group, numsph)
Definition create_element_from_part.F:33
create_line_from_element
subroutine create_line_from_element(ixt, ixp, ixr, clause, delbuf, go_in_array)
Definition create_line_from_element.F:36
create_line_from_surface
subroutine create_line_from_surface(clause, keyset, opt_a, opt_e, delbuf, go_in_array)
Definition create_line_from_surface.F:35
create_node_all_clause
subroutine create_node_all_clause(clause)
Definition create_node_all_clause.F:30
create_node_clause
subroutine create_node_clause(clause, itabm1, jclause, opt_g, is_available, lsubmodel, opt_b, ibox, x, skew, set_title, keyset)
Definition create_node_clause.F:40
create_node_from_element
subroutine create_node_from_element(ixs, ixs10, ixs20, ixs16, ixq, ixc, ixtg, ixt, ixp, ixr, ixx, kxx, kxsp, clause, geo, array, sz, go_in_array)
Definition create_node_from_element.F:41
create_node_from_seg
subroutine create_node_from_seg(clause)
Definition create_node_from_seg.F:34
create_part_all_clause
subroutine create_part_all_clause(clause)
Definition create_part_all_clause.F:30
create_part_clause
subroutine create_part_clause(clause, ipartm1, jclause, opt_g, is_available, lsubmodel)
Definition create_part_clause.F:39
create_seg_clause
subroutine create_seg_clause(clause, itabm1, jclause, is_available, lsubmodel)
Definition create_seg_clause.F:38
create_set_array
subroutine create_set_array(set_array, array_size, isetm, nset_general, jclause, opt_g, is_available, lsubmodel, clause, flag)
Definition create_set_clause.F:40
create_set_clause
subroutine create_set_clause(set, setl, setl_size, clause, ixs, ixs10, ixq, ixc, ixtg, ixt, ixp, ixr, sh4tree, sh3tree, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, ipartc, ipartg, iparts, ipart, opt_a, opt_o, knod2elq, nod2elq, x, keyset, opt_e, delbuf)
Definition create_set_clause.F:356
create_setcol_array
subroutine create_setcol_array(set, setcol_array, array_size, isetcolm, nset_collect, jclause, opt_g, is_available, lsubmodel)
Definition create_setcol_clause.F:40
create_surface_from_element
subroutine create_surface_from_element(ixs, ixs10, sh4tree, sh3tree, ixc, ixtg, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, ipartc, ipartg, iparts, ipart, clause, opt_a, opt_o, ixq, knod2elq, nod2elq, x, keyset, delbuf, go_in_array)
Definition create_surface_from_element.F:42
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:523
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:76
hm_get_string_index
subroutine hm_get_string_index(name, sval, index, size, is_available)
Definition hm_get_string_index.F:53
hm_option_start_list
subroutine hm_option_start_list(entity_type)
Definition hm_option_start.F:312
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
inverted_group_mod
Definition inverted_group_mod.F:35
mapping_option_mod
Definition dichotomy_mod.F:36
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
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
optiondef_mod
Definition optiondef_mod.F:90
set_scratch_mod
Definition setdef_mod.F:247
setdef_mod
Definition setdef_mod.F:107
setdef_mod::nsets
integer nsets
Definition setdef_mod.F:120
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
set_init
subroutine set_init(set, igs, set_id, set_title, iset_type)
Definition set_init.F:32
set_operator
subroutine set_operator(opt_d, opt_o, opt_g, opt_b, opt_a, opt_e, opt_i, opt_c, clause_operator)
Definition set_operator.F:34
sort_set
subroutine sort_set(lsubmodel, map_tables, set_list, set, clause)
Definition sort_sets.F:45