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

Go to the source code of this file.

Functions/Subroutines

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)
subroutine create_elt_list_g (clause, eltyp, map, mapsize, jclause, is_available, lsubmodel)
subroutine create_elt_list (clause, eltyp, map, mapsize, jclause, is_available, lsubmodel)
subroutine copy_list_in_cause (clause, eltyp, sorted_list, list_size)
subroutine get_elt_name (eltyp, element_name)

Function/Subroutine Documentation

◆ copy_list_in_cause()

subroutine copy_list_in_cause ( type (set_) clause,
integer, intent(in) eltyp,
integer, dimension(list_size), intent(in) sorted_list,
integer, intent(in) list_size )

Definition at line 403 of file create_element_clause.F.

404C-----------------------------------------------
405C ROUTINE DESCRIPTION :
406C ===================
407C Copy Element list in clause, allocates the element set,and copies the list in.
408C------------------------------------------------------------------
409C DUMMY ARGUMENTS DESCRIPTION:
410C ===================
411C
412C NAME DESCRIPTION
413C
414C CLAUSE (SET structure) Clause to be treated
415C ELTYP Id of Element as in radioss_maptable.inc
416C SORTED_LIST sorted list of elements
417C list_size sizeof list
418C============================================================================
419C-----------------------------------------------
420C M o d u l e s
421C-----------------------------------------------
422 USE setdef_mod
423C-----------------------------------------------
424C I m p l i c i t T y p e s
425C-----------------------------------------------
426#include "implicit_f.inc"
427C-----------------------------------------------
428C C o m m o n B l o c k s
429C-----------------------------------------------
430#include "radioss_maptable.inc"
431C-----------------------------------------------
432C D u m m y A r g u m e n t s
433C-----------------------------------------------
434 TYPE (SET_) :: CLAUSE
435 INTEGER, INTENT(IN) :: ELTYP,LIST_SIZE
436 INTEGER, INTENT(IN), DIMENSION(LIST_SIZE) :: SORTED_LIST
437C-----------------------------------------------
438C L o c a l V a r i a b l e s
439C-----------------------------------------------
440 INTEGER I
441C-----------------------------------------------
442
443
444 SELECT CASE (eltyp)
445
446 CASE ( elt_solid )
447
448 ! SOLID ELEM
449 !-----------------------
450 clause%NB_SOLID = list_size
451 ALLOCATE( clause%SOLID( list_size ) )
452c
453 DO i=1,list_size
454 clause%SOLID(i) = sorted_list(i)
455 ENDDO
456
457 CASE ( elt_quad )
458
459 ! QUAD ELEM
460 !-----------------------
461 clause%NB_QUAD = list_size
462 ALLOCATE( clause%QUAD( list_size ) )
463c
464 DO i=1,list_size
465 clause%QUAD(i) = sorted_list(i)
466 ENDDO
467
468 CASE ( elt_sh4n )
469
470 ! SHELL ELEM
471 !-----------------------
472 clause%NB_SH4N = list_size
473 ALLOCATE( clause%SH4N( list_size ) )
474c
475 DO i=1,list_size
476 clause%SH4N(i) = sorted_list(i)
477 ENDDO
478
479 CASE ( elt_sh3n )
480
481 ! SH3N ELEM
482 !-----------------------
483 clause%NB_SH3N = list_size
484 ALLOCATE( clause%SH3N( list_size ) )
485c
486 DO i=1,list_size
487 clause%SH3N(i) = sorted_list(i)
488 ENDDO
489
490 CASE ( elt_tria )
491
492 ! TRIA ELEM
493 !-----------------------
494 clause%NB_TRIA = list_size
495 ALLOCATE( clause%TRIA( list_size ) )
496c
497 DO i=1,list_size
498 clause%TRIA(i) = sorted_list(i)
499 ENDDO
500
501 CASE ( elt_truss )
502
503 ! TRUSS ELEM
504 !-----------------------
505 clause%NB_TRUSS = list_size
506 ALLOCATE( clause%TRUSS( list_size ) )
507c
508 DO i=1,list_size
509 clause%TRUSS(i) = sorted_list(i)
510 ENDDO
511
512 CASE ( elt_beam )
513
514 ! BEAM ELEM
515 !-----------------------
516 clause%NB_BEAM = list_size
517 ALLOCATE( clause%BEAM( list_size ) )
518c
519 DO i=1,list_size
520 clause%BEAM(i) = sorted_list(i)
521 ENDDO
522
523 CASE ( elt_spring )
524
525 ! SPRING ELEM
526 !-----------------------
527 clause%NB_SPRING = list_size
528 ALLOCATE( clause%SPRING( list_size ) )
529c
530 DO i=1,list_size
531 clause%SPRING(i) = sorted_list(i)
532 ENDDO
533
534 END SELECT
535!---
setdef_mod
Definition setdef_mod.F:107

◆ create_elt_clause()

subroutine create_elt_clause ( type (set_) clause,
integer eltyp,
integer, dimension(mapsize,2) map,
integer, intent(in) mapsize,
integer jclause,
integer opt_g,
logical is_available,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer opt_b,
integer opt_c,
type (box_), dimension(nbbox) ibox,
x,
skew,
character(len=nchartitle) set_title,
character(len=ncharfield) keyset,
integer nix,
integer, dimension(nix,*) ix,
integer nix1,
integer, dimension(*) iparte,
integer, dimension(lipart1,*) ipart,
integer klevtree,
integer, dimension(keltree,*) eltree,
integer keltree )

Definition at line 37 of file create_element_clause.F.

43C-----------------------------------------------
44C ROUTINE DESCRIPTION :
45C ===================
46C Treat the Elmeent Clause, read Elements from HM_READER & fill clause
47C Calls CREATE_ELT_LIST (simple list)
48C Calls CREATE_ELT_LIST_G (PART_G : All parts from a MIN to MAX with increment)
49C------------------------------------------------------------------
50C DUMMY ARGUMENTS DESCRIPTION:
51C ===================
52C
53C NAME DESCRIPTION
54C
55C CLAUSE (SET structure) Clause to be treated
56C IPARTM1 MAP Table UID -> LocalID
57C JCLAUSE parameter with HM_READER (current clause read)
58C Opt_G Opt_G operator 1 if PART_G is set, 0 else
59C IS_AVAILABLE Bool / Result of HM_interface
60C LSUBMODEL SUBMODEL Structure.
61C============================================================================
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE setdef_mod
66 USE submodel_mod
67 USE message_mod
68 USE hm_option_read_mod
69 USE optiondef_mod
70 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
71C-----------------------------------------------
72C I m p l i c i t T y p e s
73C-----------------------------------------------
74#include "implicit_f.inc"
75C-----------------------------------------------
76C C o m m o n B l o c k s
77C-----------------------------------------------
78#include "com04_c.inc"
79#include "param_c.inc"
80#include "scr17_c.inc"
81C-----------------------------------------------
82C D u m m y A r g u m e n t s
83C-----------------------------------------------
84 INTEGER IPARTE(*),IPART(LIPART1,*),IX(NIX,*),ELTREE(KELTREE,*)
85 INTEGER ELTYP,JCLAUSE,Opt_G,OPT_B,OPT_C,NIX,NIX1,KLEVTREE,
86 . KELTREE
87 INTEGER, INTENT(IN) :: MAPSIZE
88 INTEGER, DIMENSION(MAPSIZE,2) :: MAP
89 LOGICAL :: IS_AVAILABLE
90 my_real
91 . x(3,*),skew(lskew,*)
92 CHARACTER(LEN=NCHARFIELD) :: KEYSET
93 CHARACTER(LEN=NCHARTITLE) :: SET_TITLE
94C-----------------------------------------------
95 TYPE (SET_) :: CLAUSE
96 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
97 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
98C-----------------------------------------------
99C L o c a l V a r i a b l e s
100C-----------------------------------------------
101 INTEGER BOXTYPE
102 INTEGER GOT_ELEMENTS
103C-----------------------------------------------
104C L o c a l V a r i a b l e s
105C-----------------------------------------------
106!
107 CALL check_eltyp(eltyp,clause,got_elements)
108 IF(got_elements == 0) THEN
109 RETURN
110 ENDIF
111
112 IF (opt_g == 1 ) THEN
113
114 CALL create_elt_list_g(clause,eltyp, map, mapsize, jclause ,is_available ,lsubmodel)
115
116 ELSEIF( opt_g == 0 .AND. opt_b == 0 .AND. opt_c == 0 ) THEN
117
118 CALL create_elt_list (clause,eltyp, map, mapsize, jclause ,is_available ,lsubmodel)
119
120 ELSEIF ( opt_b == 1 .OR. opt_c == 1 ) THEN
121 IF (opt_b == 1) boxtype = 1
122 IF (opt_c == 1) boxtype = 2
123 CALL create_elt_box(
124 * clause ,iparte ,jclause ,is_available ,lsubmodel,
125 * ibox ,x ,skew ,set_title ,keyset ,
126 * boxtype ,mapsize ,nix ,ix ,nix1 ,
127 * ipart ,eltree ,klevtree,keltree ,eltyp )
128
129 ENDIF
130C-----------------------------------------------
check_eltyp
subroutine check_eltyp(eltyp, clause, ok)
Definition check_eltyp.F:35
my_real
#define my_real
Definition cppsort.cpp:32
create_elt_list_g
subroutine create_elt_list_g(clause, eltyp, map, mapsize, jclause, is_available, lsubmodel)
Definition create_element_clause.F:148
create_elt_list
subroutine create_elt_list(clause, eltyp, map, mapsize, jclause, is_available, lsubmodel)
Definition create_element_clause.F:272
create_elt_box
subroutine create_elt_box(clause, iparte, jclause, is_available, lsubmodel, ibox, x, skew, set_title, keyset, boxtype, numel, nix, ix, nix1, ipart, eltree, klevtree, keltree, eltyp)
Definition create_elt_box.F:43
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::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
optiondef_mod
Definition optiondef_mod.F:90
submodel_mod
Definition submodel_mod.F:712

◆ create_elt_list()

subroutine create_elt_list ( type (set_) clause,
integer eltyp,
integer, dimension(mapsize,2), intent(in) map,
integer, intent(in) mapsize,
integer jclause,
logical is_available,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 270 of file create_element_clause.F.

272C-----------------------------------------------
273C ROUTINE DESCRIPTION :
274C ===================
275C Create ELEMENT Clause from LIST
276C------------------------------------------------------------------
277C DUMMY ARGUMENTS DESCRIPTION:
278C ===================
279C
280C NAME DESCRIPTION
281C
282C CLAUSE (SET structure) Clause to be treated
283C ELTYP Id of Element as in radioss_hashtable.inc
284C JCLAUSE parameter with HM_READER (current clause read)
285C IS_AVAILABLE Bool / Result of HM_interface
286C LSUBMODEL SUBMODEL Structure.
287C============================================================================
288C-----------------------------------------------
289C M o d u l e s
290C-----------------------------------------------
291 USE setdef_mod
292 USE submodel_mod
293 USE message_mod
294 USE hm_option_read_mod
295C-----------------------------------------------
296C I m p l i c i t T y p e s
297C-----------------------------------------------
298#include "implicit_f.inc"
299C-----------------------------------------------
300C C o m m o n B l o c k s
301C-----------------------------------------------
302#include "radioss_maptable.inc"
303C-----------------------------------------------
304C D u m m y A r g u m e n t s
305C-----------------------------------------------
306 INTEGER JCLAUSE,ELTYP
307 INTEGER, INTENT(IN) :: MAPSIZE
308 INTEGER, DIMENSION(MAPSIZE,2), INTENT(IN) :: MAP
309
310 LOGICAL :: IS_AVAILABLE
311!
312 TYPE (SET_) :: CLAUSE
313 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
314C-----------------------------------------------
315C L o c a l V a r i a b l e s
316C-----------------------------------------------
317 CHARACTER (LEN=20) :: ELEMENT_NAME
318 INTEGER I,IDS,SYSID,NINDX,LIST_SIZE,IDS_MAX,ELTP,ELT
319 INTEGER IWORK(70000)
320!
321 INTEGER, ALLOCATABLE, DIMENSION(:) :: ELT_READ_TMP,SORTED_LIST,IDX
322C
323 INTEGER SET_USRTOS
324 EXTERNAL set_usrtos
325C
326C=======================================================================
327
328 CALL hm_get_int_array_index('idsmax' ,ids_max ,jclause,is_available,lsubmodel)
329
330 ALLOCATE(elt_read_tmp(ids_max))
331 ALLOCATE(sorted_list(ids_max))
332
333 elt_read_tmp(1:ids_max) = 0
334
335 ALLOCATE(idx(2*ids_max))
336 idx = 0
337
338 nindx = 0
339 list_size = 0
340
341 ! Read & convert Parts
342 ! ---------------------
343 DO i=1,ids_max
344 CALL hm_get_int_array_2indexes('ids',ids,jclause,i,is_available,lsubmodel)
345
346 eltp = set_usrtos(ids,map,mapsize)
347 IF(eltp == 0)THEN
348 ! Element was not found. Issue a Warning & Skip.
349 CALL get_elt_name(eltyp, element_name)
350 CALL ancmsg(msgid=1902,anmode=aninfo,
351 . msgtype=msgwarning,
352 . i1 = clause%SET_ID,
353 . i2=ids,
354 . c1=trim(clause%TITLE),
355 . c2=trim(element_name) )
356 ELSE
357
358 elt=map(eltp,2)
359
360 nindx=nindx+1 ! nb of CLAUSE parts
361 elt_read_tmp(nindx) = elt
362 ENDIF
363! print*,'Read IDS',IDS,' SYSID: ',ELT,'verif:',IX(NIX,ELT)
364
365 ENDDO ! DO K=1,IDS_MAX
366
367 ! Sort the Readed PARTs and remove eventual duplicates
368 ! ----------------------------------------------------
369 DO i=1,nindx
370 idx(i) = i
371 ENDDO
372 CALL my_orders(0,iwork,elt_read_tmp,idx,nindx,1)
373
374 DO i=1,nindx
375 sorted_list(i) = elt_read_tmp(idx(i))
376 ENDDO
377
378
379 CALL remove_duplicates(sorted_list,nindx,list_size)
380
381 ! Copy in final SET
382 ! ------------------
383 CALL copy_list_in_cause(clause,eltyp,sorted_list,list_size)
384!---
385
386C-------------------------
387 DEALLOCATE(elt_read_tmp)
388 DEALLOCATE(idx)
389 DEALLOCATE(sorted_list)
390C-------------------------
391 RETURN
copy_list_in_cause
subroutine copy_list_in_cause(clause, eltyp, sorted_list, list_size)
Definition create_element_clause.F:404
get_elt_name
subroutine get_elt_name(eltyp, element_name)
Definition create_element_clause.F:544
hm_get_int_array_2indexes
subroutine hm_get_int_array_2indexes(name, ival, index1, index2, is_available, lsubmodel)
Definition hm_get_int_array_2indexes.F:57
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
set_usrtos
integer function set_usrtos(iu, ipartm1, npart)
Definition ipartm1.F:128
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
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

◆ create_elt_list_g()

subroutine create_elt_list_g ( type (set_) clause,
integer eltyp,
integer, dimension(mapsize,2), intent(in) map,
integer, intent(in) mapsize,
integer jclause,
logical is_available,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 146 of file create_element_clause.F.

148C-----------------------------------------------
149C ROUTINE DESCRIPTION :
150C ===================
151C Create PART Clause from Generation All parts from Min to Max with Increment (Opt_G)
152C--------------------------------------------------------------------------------------
153C DUMMY ARGUMENTS DESCRIPTION:
154C ===================
155C
156C NAME DESCRIPTION
157C
158C CLAUSE (SET structure) Clause to be treated
159C JCLAUSE parameter with HM_READER (current clause read)
160C IS_AVAILABLE Bool / Result of HM_interface
161C LSUBMODEL SUBMODEL Structure.
162C============================================================================
163C-----------------------------------------------
164C M o d u l e s
165C-----------------------------------------------
166 USE setdef_mod
167 USE submodel_mod
168 USE message_mod
169 USE hm_option_read_mod
170C-----------------------------------------------
171C I m p l i c i t T y p e s
172C-----------------------------------------------
173#include "implicit_f.inc"
174C-----------------------------------------------
175C C o m m o n B l o c k s
176C-----------------------------------------------
177#include "radioss_maptable.inc"
178C-----------------------------------------------
179C D u m m y A r g u m e n t s
180C-----------------------------------------------
181 INTEGER JCLAUSE,ELTYP
182 INTEGER, INTENT(IN) :: MAPSIZE
183 INTEGER, DIMENSION(MAPSIZE,2), INTENT(IN) :: MAP
184
185 LOGICAL :: IS_AVAILABLE
186!
187 TYPE (SET_) :: CLAUSE
188 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
189C-----------------------------------------------
190C L o c a l V a r i a b l e s
191C-----------------------------------------------
192 INTEGER IDS,IDS_MAX,GENE_MAX,K,E,E1
193 INTEGER START_GENE,END_GENE,INCR_GENE,ESTART,ESTOP,STACK,STACK_ONE,NB_RESULT
194!-
195 INTEGER, ALLOCATABLE, DIMENSION(:) :: ELT_READ_TMP,
196 . ELT_READ_ONE,RESULT
197C
198 INTEGER SET_USRTOS_NEAREST
199 EXTERNAL set_usrtos_nearest
200C=======================================================================
201 CALL hm_get_int_array_index('genemax' ,gene_max ,jclause,is_available,lsubmodel)
202
203 ALLOCATE(elt_read_tmp(mapsize))
204 ALLOCATE(elt_read_one(mapsize))
205
206 IF (gene_max > 1) THEN
207 ALLOCATE(result(mapsize))
208 ENDIF
209
210 stack=0
211
212 DO k=1,gene_max
213 CALL hm_get_int_array_2indexes('start' ,start_gene,jclause,k,is_available,lsubmodel)
214 CALL hm_get_int_array_2indexes('end' ,end_gene ,jclause,k,is_available,lsubmodel)
215 CALL hm_get_int_array_2indexes('by' ,incr_gene ,jclause,k,is_available,lsubmodel)
216
217 ! set value by default for increment to 1
218 IF (incr_gene == 0) incr_gene = 1
219
220 estart = set_usrtos_nearest(start_gene,map,mapsize,1)
221 estop = set_usrtos_nearest(end_gene,map,mapsize,2)
222
223 stack_one = 0
224 DO e=estart, estop
225 e1 = map(e,1)
226 IF ( mod( e1-start_gene , incr_gene) == 0)THEN
227 stack_one = stack_one+1
228 elt_read_one(stack_one) = map(e,2)
229 ENDIF
230 ENDDO
231
232 IF (stack==0) THEN
233 elt_read_tmp(1:stack_one) = elt_read_one(1:stack_one)
234 stack = stack_one
235 ELSE
236 ! This code will not go if GENE_MAX == 1 / Result does not need to be allocated
237 CALL union_2_sorted_sets( elt_read_tmp, stack ,
238 * elt_read_one, stack_one ,
239 * result, nb_result )
240
241 elt_read_tmp(1:nb_result) = result(1:nb_result)
242 stack = nb_result
243 ENDIF
244 ENDDO
245
246 CALL copy_list_in_cause(clause,eltyp,elt_read_tmp,stack)
247
248C-------------------------
249 DEALLOCATE (elt_read_tmp)
250 DEALLOCATE (elt_read_one)
251 IF (ALLOCATED(result)) DEALLOCATE (result)
252C-------------------------
set_usrtos_nearest
integer function set_usrtos_nearest(ui, map, sz, uplow)
Definition ipartm1.F:197

◆ get_elt_name()

subroutine get_elt_name ( integer eltyp,
character (len=20) element_name )

Definition at line 543 of file create_element_clause.F.

544C-----------------------------------------------
545C ROUTINE DESCRIPTION :
546C ===================
547C Get Element type NAME from ELTYP
548C------------------------------------------------------------------
549C DUMMY ARGUMENTS DESCRIPTION:
550C ===================
551C
552C NAME DESCRIPTION
553C
554C ELTYP Id of Element as in radioss_maptable.inc
555C ELEMENT_NAME Element name
556C============================================================================
557C-----------------------------------------------
558C I m p l i c i t T y p e s
559C-----------------------------------------------
560#include "implicit_f.inc"
561C-----------------------------------------------
562C C o m m o n B l o c k s
563C-----------------------------------------------
564#include "radioss_maptable.inc"
565C-----------------------------------------------
566C D u m m y A r g u m e n t s
567C-----------------------------------------------
568 INTEGER ELTYP
569 CHARACTER (LEN=20) :: ELEMENT_NAME
570C-----------------------------------------------
571 SELECT CASE (eltyp)
572
573 CASE ( elt_solid )
574
575 ! SOLID ELEM
576 !-----------------------
577 element_name='SOLID ELEMENT'
578
579 CASE ( elt_quad )
580
581 ! QUAD ELEM
582 !-----------------------
583 element_name='QUAD ELEMENT'
584
585 CASE ( elt_sh4n )
586
587 ! SHELL ELEM
588 !-----------------------
589 element_name='SHELL ELEMENT'
590
591 CASE ( elt_sh3n )
592
593 ! SH3N ELEM
594 !-----------------------
595 element_name='TRIANGLE ELEMENT'
596
597 CASE ( elt_tria )
598
599 ! TRIA ELEM
600 !-----------------------
601 element_name='TRIANGLE ELEMENT'
602
603 CASE ( elt_truss )
604
605 ! SPRING ELEM
606 !-----------------------
607 element_name='TRUSS ELEMENT'
608
609 CASE ( elt_beam )
610
611 ! BEAM ELEM
612 !-----------------------
613 element_name='BEAM ELEMENT'
614
615 CASE ( elt_spring )
616
617 ! SPRING ELEM
618 !-----------------------
619 element_name='SPRING ELEMENT'
620
621
622 END SELECT