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

Go to the source code of this file.

Functions/Subroutines

subroutine fill_clause_elt_box (ibox, x, skew, set_title, keyset, boxlist, boxlist_size, boxelts, sz_boxelts, boxtype, nix, ix, nix1, iparte, ipart, eltree, klevtree, keltree, numel)
recursive subroutine elt_box (ib, ibox, x, skew, set_title, keyset, boxelts, sz_boxelts, nix, ix, nix1, iparte, ipart, eltree, klevtree, keltree, numel, boxtype)

Function/Subroutine Documentation

◆ elt_box()

recursive subroutine elt_box ( integer ib,
type (box_), dimension(nbbox) ibox,
x,
skew,
character(len=nchartitle) set_title,
character(len=ncharfield) keyset,
integer, dimension(*) boxelts,
integer sz_boxelts,
integer nix,
integer, dimension(nix,*) ix,
integer nix1,
integer, dimension(*) iparte,
integer, dimension(lipart1,*) ipart,
integer, dimension(keltree,*) eltree,
integer klevtree,
integer keltree,
integer numel,
integer boxtype )

Definition at line 124 of file fill_clause_elt_box.F.

129C-----------------------------------------------
130C ROUTINE DESCRIPTION :
131C ===================
132C Recursive routine - Go through tree and fill the Node Box array
133C
134C------------------------------------------------------------------
135C DUMMY ARGUMENTS DESCRIPTION:
136C ===================
137C
138C NAME DESCRIPTION
139C
140C IB Recursive indice / Current Box to treat
141C IBOX IBOX Structure
142C SKEW Skew Structure
143C SET_TITLE Title for Error message
144C KEYSET KEYSET for Error message
145C BOXELTS merged node array
146C SZ_BOXELTS number of stacked nodes in BOXELTS
147C============================================================================
148C-----------------------------------------------
149C M o d u l e s
150C-----------------------------------------------
151 USE optiondef_mod
152 USE message_mod
153 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
154 USE set_mod , ONLY : set_add,set_delete
155C-----------------------------------------------
156C I m p l i c i t T y p e s
157C-----------------------------------------------
158#include "implicit_f.inc"
159C-----------------------------------------------
160C C o m m o n B l o c k s
161C-----------------------------------------------
162#include "com04_c.inc"
163#include "scr17_c.inc"
164#include "param_c.inc"
165C-----------------------------------------------
166C D u m m y A r g u m e n t s
167C-----------------------------------------------
168 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
169
170 INTEGER BOXELTS(*),IX(NIX,*),IPARTE(*),IPART(LIPART1,*),
171 . ELTREE(KELTREE,*)
172 INTEGER IB,SZ_BOXELTS,NIX,NIX1,KLEVTREE,KELTREE,NUMEL,BOXTYPE
173
174 my_real
175 . x(3,*),skew(lskew,*)
176
177 CHARACTER(LEN=NCHARFIELD) :: KEYSET
178 CHARACTER(LEN=NCHARTITLE)::SET_TITLE
179C-----------------------------------------------
180C L o c a l V a r i a b l e s
181C-----------------------------------------------
182 INTEGER I,B_ELTS_SIZE,NB_RESULT,
183 . NB_BOX_OF_BOX,J,NEW_BOX,CLAUSE_OPERATOR
184 LOGICAL BOOL
185 INTEGER, DIMENSION(:) , ALLOCATABLE :: B_ELTS,RESULT
186
187C-----------------------------------------------
188
189
190 nb_box_of_box = ibox(ib)%NBOXBOX
191
192 IF ( nb_box_of_box == 0 ) THEN
193
194 ! Fill SIMPLE Boxes
195 ! ---------------------
196 sz_boxelts = 0
197 CALL simple_elt_box(
198 . ibox ,x ,skew ,ib ,boxelts ,
199 . sz_boxelts ,nix ,ix ,nix1 ,iparte ,
200 . ipart ,eltree ,klevtree ,keltree ,numel ,
201 . boxtype )
202
203 ELSE
204 ALLOCATE(b_elts(numel))
205 ALLOCATE(result(numel))
206
207
208 DO i=1,nb_box_of_box
209
210 j = ibox(ib)%IBOXBOX(i) ! could be negative
211 new_box = abs(j)
212
213 b_elts_size=0
214
215 CALL elt_box (new_box ,
216 * ibox ,x ,skew ,set_title ,keyset,
217 * b_elts ,b_elts_size,nix ,ix ,nix1 ,
218 * iparte ,ipart ,eltree ,klevtree ,keltree,
219 * numel ,boxtype )
220
221 IF (j < 0)THEN
222 clause_operator = set_delete
223 ELSE
224 clause_operator = set_add
225 ENDIF
226
227 CALL set_merge_simple( boxelts, sz_boxelts ,
228 * b_elts, b_elts_size ,
229 * result, nb_result ,
230 * clause_operator)
231
232 boxelts(1:nb_result) = result(1:nb_result)
233 sz_boxelts = nb_result
234 ENDDO
235
236 ENDIF
237
238C-------
239 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
elt_box
recursive subroutine elt_box(ib, ibox, x, skew, set_title, keyset, boxelts, sz_boxelts, nix, ix, nix1, iparte, ipart, eltree, klevtree, keltree, numel, boxtype)
Definition fill_clause_elt_box.F:129
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
set_mod
Definition set_mod.F:43
set_mod::set_add
integer, parameter set_add
add operator
Definition set_mod.F:47
set_mod::set_delete
integer, parameter set_delete
delete operator
Definition set_mod.F:48
set_merge_simple
subroutine set_merge_simple(set_entity, nb_set_entity, clause_entity, nb_clause_entity, result, nb_result, clause_operator)
Definition set_merge_simple.F:42
simple_elt_box
subroutine simple_elt_box(ibox, x, skew, ib, elt_array, elt_size, nix, ix, nix1, iparte, ipart, eltree, klevtree, keltree, numel, itype)
Definition simpl_elt_box.F:38

◆ fill_clause_elt_box()

subroutine fill_clause_elt_box ( type (box_), dimension(nbbox) ibox,
x,
skew,
character(len=nchartitle) set_title,
character(len=ncharfield) keyset,
integer, dimension(*) boxlist,
integer boxlist_size,
integer, dimension(*) boxelts,
integer sz_boxelts,
integer boxtype,
integer nix,
integer, dimension(nix,*) ix,
integer nix1,
integer, dimension(*) iparte,
integer, dimension(lipart1,*) ipart,
integer, dimension(keltree,*) eltree,
integer klevtree,
integer keltree,
integer numel )

Definition at line 34 of file fill_clause_elt_box.F.

39
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE optiondef_mod
44 USE message_mod
45 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
46 USE set_mod , ONLY : set_add
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com04_c.inc"
55#include "scr17_c.inc"
56#include "param_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
61
62 INTEGER BOXELTS(*),BOXLIST(*),IPARTE(*),IPART(LIPART1,*),
63 . IX(NIX,*),ELTREE(KELTREE,*)
64 INTEGER SZ_BOXELTS, BOXLIST_SIZE,BOXTYPE,NIX,NIX1,KLEVTREE,
65 . KELTREE,NUMEL
66
67 my_real
68 . x(3,*),skew(lskew,*)
69
70 CHARACTER(LEN=NCHARFIELD):: KEYSET
71 CHARACTER(LEN=NCHARTITLE)::SET_TITLE
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I,B_ELTS_SIZE,NB_RESULT,
76 . ID,IB,NB_BOX_OF_BOX,J,CLAUSE_OPERATOR
77 LOGICAL BOOL
78 INTEGER, DIMENSION(:) , ALLOCATABLE :: B_ELTS,RESULT
79C-----------------------------------------------
80 ALLOCATE(b_elts(numel))
81 ALLOCATE(result(numel))
82
83!
84 ! Tag nodes from boxes
85 ! ---------------------
86 clause_operator = set_add
87 sz_boxelts = 0
88 DO i=1,boxlist_size
89 ib = boxlist(i)
90 b_elts_size = 0
91
92 CALL elt_box(ib ,
93 * ibox ,x ,skew ,set_title ,keyset,
94 * b_elts ,b_elts_size,nix ,ix ,nix1 ,
95 * iparte ,ipart ,eltree ,klevtree ,keltree,
96 * numel ,boxtype )
97
98
99 CALL set_merge_simple( boxelts, sz_boxelts ,
100 * b_elts, b_elts_size ,
101 * result, nb_result ,
102 * clause_operator)
103
104 boxelts(1:nb_result) = result(1:nb_result)
105 sz_boxelts = nb_result
106 ENDDO ! DO I=1,BOXLIST_SIZE
107
108C-------
109 RETURN