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

Go to the source code of this file.

Functions/Subroutines

subroutine simple_elt_box (ibox, x, skew, ib, elt_array, elt_size, nix, ix, nix1, iparte, ipart, eltree, klevtree, keltree, numel, itype)

Function/Subroutine Documentation

◆ simple_elt_box()

subroutine simple_elt_box ( type (box_), dimension(nbbox) ibox,
x,
skew,
integer ib,
integer, dimension(*) elt_array,
integer elt_size,
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 itype )

Definition at line 33 of file simpl_elt_box.F.

38C-----------------------------------------------
39C ROUTINE DESCRIPTION :
40C ===================
41C create node list from BOX
42C------------------------------------------------------------------
43C DUMMY ARGUMENTS DESCRIPTION:
44C ===================
45C
46C NAME DESCRIPTION
47C
48C IBOX BOX structure
49C X Node position
50C SKEW SKEW array
51C ELT_ARRAY Result list of elems
52C ELT_SIZE number of stacked elems
53C IB Box to treat
54C============================================================================
55C-----------------------------------------------
56C M o d u l e s
57C-----------------------------------------------
58 USE optiondef_mod
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "com04_c.inc"
67#include "scr17_c.inc"
68#include "param_c.inc"
69#include "remesh_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER ELT_ARRAY(*),IPARTE(*),IPART(LIPART1,*),IX(NIX,*),ELTREE(KELTREE,*)
74 INTEGER IB,ELT_SIZE,NIX,NIX1,KLEVTREE,KELTREE,NUMEL,ITYPE
75 my_real
76 . x(3,*),skew(lskew,*)
77C-----------------------------------------------
78 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER I,J,K,INSIDE,ISK,BOX_TYPE,NBOXBOX,IBX,COUNT,IP,
83 . NLEV,MY_LEV
84 my_real
85 . xp1,yp1,zp1,xp2,yp2,zp2,diam,nodinb(3)
86C-----------------------------------------------
87 elt_size = 0
88C------------
89! IBOX(IGS)%ISKBOX = ISK
90! IBOX(IGS)%NOD1 = J2(1)
91! IBOX(IGS)%NOD2 = J2(2)
92C IBOX(IGS)%NBOXBOX : NUMBER OF SUB BOXES (BOXES OF BOXES)
93! IF(KEY(1:5) == 'RECTA')IBOX(IGS)%TYPE = 1
94! IF(KEY(1:5) == 'CYLIN')IBOX(IGS)%TYPE = 2
95! IF(KEY(1:5) == 'SPHER')IBOX(IGS)%TYPE = 3
96! IBOX(IGS)%DIAM = DIAM
97! IBOX(IGS)%X1 = XP1
98! IBOX(IGS)%Y1 = YP1
99! IBOX(IGS)%Z1 = ZP1
100! IBOX(IGS)%X2 = XP2
101! IBOX(IGS)%Y2 = YP2
102! IBOX(IGS)%Z2 = ZP2
103C------------
104 ibx = abs(ib) ! a box can be have negative user_ID if within Box of Box
105 isk = ibox(ibx)%ISKBOX
106 box_type = ibox(ibx)%TYPE
107 xp1 = ibox(ibx)%X1
108 yp1 = ibox(ibx)%Y1
109 zp1 = ibox(ibx)%Z1
110 xp2 = ibox(ibx)%X2
111 yp2 = ibox(ibx)%Y2
112 zp2 = ibox(ibx)%Z2
113 diam = ibox(ibx)%DIAM
114!
115 IF (nadmesh == 0) THEN
116 !
117 ! RECTA
118 IF (box_type == 1) THEN
119 DO j=1,numel
120 count=0
121 DO k=2,nix1+1
122 inside = 0
123 i=ix(k,j)
124 nodinb(1) = x(1,i)
125 nodinb(2) = x(2,i)
126 nodinb(3) = x(3,i)
127 CALL checkpara(xp1,yp1,zp1,xp2,yp2,zp2,
128 . isk,nodinb,skew,inside)
129 IF (inside == 1) count = count + 1
130 ENDDO
131 IF ( itype == 1 ) THEN
132 !
133 ! all elt nodes inide box
134 IF (count == nix1) THEN
135 elt_size = elt_size + 1
136 elt_array(elt_size) = j ! add elt
137 ENDIF
138 ELSEIF ( itype == 2 ) THEN
139 !
140 ! at least one elt node inide box
141 IF (inside > 0 ) THEN
142 elt_size = elt_size + 1
143 elt_array(elt_size) = j ! add elt
144 ENDIF
145 ENDIF ! IF ( ITYPE == 1 )
146 ENDDO !DO J=1,NUMEL
147 !
148 ! CYLIN
149 ELSEIF (box_type == 2) THEN
150 DO j=1,numel
151 count=0
152 DO k=2,nix1+1
153 inside = 0
154 i=ix(k,j)
155 nodinb(1) = x(1,i)
156 nodinb(2) = x(2,i)
157 nodinb(3) = x(3,i)
158 CALL checkcyl(xp1, yp1, zp1 , xp2, yp2, zp2,
159 . nodinb , diam, inside )
160 IF (inside == 1) count = count + 1
161 ENDDO
162 IF ( itype == 1 ) THEN
163 !
164 ! all elt nodes inide box
165 IF (count == nix1) THEN
166 elt_size = elt_size + 1
167 elt_array(elt_size) = j ! add elt
168 ENDIF
169 ELSEIF ( itype == 2 ) THEN
170 !
171 ! at least one elt node inide box
172 IF (inside > 0 ) THEN
173 elt_size = elt_size + 1
174 elt_array(elt_size) = j ! add elt
175 ENDIF
176 ENDIF ! IF ( ITYPE == 1 )
177 ENDDO !DO J=1,NUMEL
178 !
179 ! SPHER
180 ELSEIF (box_type == 3) THEN
181 DO j=1,numel
182 count=0
183 DO k=2,nix1+1
184 inside = 0
185 i=ix(k,j)
186 nodinb(1) = x(1,i)
187 nodinb(2) = x(2,i)
188 nodinb(3) = x(3,i)
189 CALL checksphere(xp1, yp1, zp1, nodinb, diam, inside)
190 IF (inside == 1) count = count + 1
191 ENDDO
192 IF ( itype == 1 ) THEN
193 !
194 ! all elt nodes inide box
195 IF (count == nix1) THEN
196 elt_size = elt_size + 1
197 elt_array(elt_size) = j ! add elt
198 ENDIF
199 ELSEIF ( itype == 2 ) THEN
200 !
201 ! at least one elt node inide box
202 IF (inside > 0 ) THEN
203 elt_size = elt_size + 1
204 elt_array(elt_size) = j ! add elt
205 ENDIF
206 ENDIF ! IF ( ITYPE == 1 )
207 ENDDO ! DO J=1,NUMEL
208 ENDIF ! IF (BOX_TYPE == 1)
209!
210 ELSEIF (nadmesh /= 0) THEN
211!
212 !
213 ! RECTA
214 IF (box_type == 1) THEN
215 DO j=1,numel
216 count=0
217 DO k=2,nix1+1
218 inside = 0
219 i=ix(k,j)
220 nodinb(1) = x(1,i)
221 nodinb(2) = x(2,i)
222 nodinb(3) = x(3,i)
223 CALL checkpara(xp1,yp1,zp1,xp2,yp2,zp2,
224 . isk,nodinb,skew,inside)
225 IF (inside == 1) count = count + 1
226 ENDDO
227 IF ( itype == 1 ) THEN
228 !
229 ! all elt nodes inide box
230 IF (count == nix1) THEN
231 ip=iparte(j)
232 nlev =ipart(10,ip)
233 my_lev=eltree(klevtree,j)
234 IF (my_lev < 0) my_lev=-(my_lev+1)
235 IF (my_lev==nlev) THEN
236 elt_size = elt_size + 1
237 elt_array(elt_size) = j ! add elt
238 ENDIF
239 ENDIF
240 ELSEIF ( itype == 2 ) THEN
241 !
242 ! at least one elt node inide box
243 IF (inside > 0 ) THEN
244 ip=iparte(j)
245 nlev =ipart(10,ip)
246 my_lev=eltree(klevtree,j)
247 IF (my_lev < 0) my_lev=-(my_lev+1)
248 IF (my_lev==nlev) THEN
249 elt_size = elt_size + 1
250 elt_array(elt_size) = j ! add elt
251 ENDIF
252 ENDIF
253 ENDIF ! IF ( ITYPE == 1 )
254 ENDDO ! DO J=1,NUMEL
255 !
256 ! CYLIN
257 ELSEIF (box_type == 2) THEN
258 DO j=1,numel
259 count=0
260 DO k=2,nix1+1
261 inside = 0
262 i=ix(k,j)
263 nodinb(1) = x(1,i)
264 nodinb(2) = x(2,i)
265 nodinb(3) = x(3,i)
266 CALL checkcyl(xp1, yp1, zp1 , xp2, yp2, zp2,
267 . nodinb , diam, inside )
268 IF (inside == 1) count = count + 1
269 ENDDO
270 IF ( itype == 1 ) THEN
271 !
272 ! all elt nodes inide box
273 IF (count == nix1) THEN
274 ip=iparte(j)
275 nlev =ipart(10,ip)
276 my_lev=eltree(klevtree,j)
277 IF (my_lev < 0) my_lev=-(my_lev+1)
278 IF (my_lev==nlev) THEN
279 elt_size = elt_size + 1
280 elt_array(elt_size) = j ! add elt
281 ENDIF
282 ENDIF
283 ELSEIF ( itype == 2 ) THEN
284 !
285 ! at least one elt node inide box
286 IF (inside > 0 ) THEN
287 ip=iparte(j)
288 nlev =ipart(10,ip)
289 my_lev=eltree(klevtree,j)
290 IF (my_lev < 0) my_lev=-(my_lev+1)
291 IF (my_lev==nlev) THEN
292 elt_size = elt_size + 1
293 elt_array(elt_size) = j ! add elt
294 ENDIF
295 ENDIF
296 ENDIF ! IF ( ITYPE == 1 )
297 ENDDO ! DO J=1,NUMEL
298 !
299 ! SPHER
300 ELSEIF (box_type == 3) THEN
301 DO j=1,numel
302 count=0
303 DO k=2,nix1+1
304 inside = 0
305 i=ix(k,j)
306 nodinb(1) = x(1,i)
307 nodinb(2) = x(2,i)
308 nodinb(3) = x(3,i)
309 CALL checksphere(xp1, yp1, zp1, nodinb, diam, inside)
310 IF (inside == 1) count = count + 1
311 ENDDO
312 IF ( itype == 1 ) THEN
313 !
314 ! all elt nodes inide box
315 IF (count == nix1) THEN
316 ip=iparte(j)
317 nlev =ipart(10,ip)
318 my_lev=eltree(klevtree,j)
319 IF (my_lev < 0) my_lev=-(my_lev+1)
320 IF (my_lev==nlev) THEN
321 elt_size = elt_size + 1
322 elt_array(elt_size) = j ! add elt
323 ENDIF
324 ENDIF
325 ELSEIF ( itype == 2 ) THEN
326 !
327 ! at least one elt node inide box
328 IF (inside > 0 ) THEN
329 ip=iparte(j)
330 nlev =ipart(10,ip)
331 my_lev=eltree(klevtree,j)
332 IF (my_lev < 0) my_lev=-(my_lev+1)
333 IF (my_lev==nlev) THEN
334 elt_size = elt_size + 1
335 elt_array(elt_size) = j ! add elt
336 ENDIF
337 ENDIF
338 ENDIF ! IF ( ITYPE == 1 )
339 ENDDO ! DO J=1,NUMEL
340 ENDIF ! IF (BOX_TYPE == 1)
341 ENDIF ! IF (NADMESH == 0) THEN
342C---------------
343 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
optiondef_mod
Definition optiondef_mod.F:90
checkcyl
subroutine checkcyl(xp1, yp1, zp1, xp2, yp2, zp2, nodin, d, ok)
Definition rdbox.F:229
checkpara
subroutine checkpara(xp1, yp1, zp1, xp2, yp2, zp2, isk, nodin, skew, ok)
Definition rdbox.F:39
checksphere
subroutine checksphere(xp, yp, zp, nodin, d, ok)
Definition rdbox.F:347