OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i22buce.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "units_c.inc"
#include "warn_c.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i22buce (x, irect, nsv, inacti, iskip, nmn, nshel_t, nsn, cand_e, cand_b, gap, noint, ii_stok, ncontact, bminma, tzinf, maxbox, minbox, mwag, curv_max, nb_n_b, eshift, ild, ifq, ifpen, stfn, nin, stf, igap, nshelr_l, ncont, renum, nsnrold, gapmin, gapmax, curv_max_max, num_imp, intth, itask, bgapsmx, i_mem, ixs, bufbric, nbric, itab, nshel_l, ale_connectivity, ipari)

Function/Subroutine Documentation

◆ i22buce()

subroutine i22buce ( x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer inacti,
integer iskip,
integer nmn,
integer nshel_t,
integer nsn,
integer, dimension(*) cand_e,
integer, dimension(*) cand_b,
gap,
integer noint,
integer ii_stok,
integer ncontact,
bminma,
tzinf,
maxbox,
minbox,
integer, dimension(*) mwag,
curv_max,
integer nb_n_b,
integer eshift,
integer ild,
integer ifq,
integer, dimension(*) ifpen,
stfn,
integer nin,
stf,
integer igap,
integer nshelr_l,
integer ncont,
integer, dimension(*) renum,
integer nsnrold,
gapmin,
gapmax,
curv_max_max,
integer num_imp,
integer intth,
integer itask,
bgapsmx,
integer i_mem,
integer, dimension(nixs,*) ixs,
integer, dimension(nbric) bufbric,
integer nbric,
integer, dimension(*) itab,
integer nshel_l,
type(t_ale_connectivity), intent(in) ale_connectivity,
integer, dimension(npari) ipari )

Definition at line 44 of file i22buce.F.

56C============================================================================
57C this routine is called by: I22MAINCT(/int7/i22mainct.F)
58C----------------------------------------------------------------------------
59C cette routine appelle : I22TRI(/int7/i22trivox.F)
60C Stop (/Sortie/arret.f)
61C============================================================================
62C M o d u l e s
63C-----------------------------------------------
64 USE tri7box
65 USE i22tri_mod
66 USE message_mod
67 USE i22edge_mod
70 use element_mod , only : nixs
71C-----------------------------------------------
72C I m p l i c i t T y p e s
73C-----------------------------------------------
74#include "implicit_f.inc"
75#include "comlock.inc"
76C-----------------------------------------------
77C C o m m o n B l o c k s
78C-----------------------------------------------
79#include "units_c.inc"
80#include "warn_c.inc"
81#include "com01_c.inc"
82#include "param_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 INTEGER IPARI(NPARI), ISKIP
87 INTEGER NMN, NSN, NOINT,IDT,INACTI,IFQ, NIN, NSNR,NSNROLD
88 INTEGER N_CAND_B
89 INTEGER IRECT(4,*),NSV(*),MWAG(*), RENUM(*),NUM_IMP, ITASK
90 INTEGER CAND_E(*),CAND_B(*),IFPEN(*), IXS(NIXS,*), BUFBRIC(NBRIC)
91 INTEGER NCONTACT,ESHIFT,ILD,NB_N_B,IGAP,NCONT,INTTH,I_MEM,NBRIC
92 INTEGER ITAB(*),NSHEL_T,NSHEL_L, NSHELR_L, II_STOK
94 . gap,tzinf,maxbox,minbox,curv_max_max,
95 . gapmin, gapmax, bminma(6),curv_max(nshel_t),bgapsmx
97 . x(3,*), stfn(*),
98 . stf(*)
99 INTEGER :: CANDB, CANDE, NB_SHORT, IPOS_, IREF,ILEN,IVAL
100 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
101C-----------------------------------------------
102C L o c a l V a r i a b l e s
103C-----------------------------------------------
104 TYPE(BRICK_ENTITY), DIMENSION(:),ALLOCATABLE :: BRICK_GRID
105 TYPE(EDGE_ENTITY), DIMENSION(:),ALLOCATABLE :: EDGE_GRID
106
107 INTEGER I_ADD_MAX,ICUR
108 parameter(i_add_max = 1001)
109
110 INTEGER I, J, I_ADD, IP0, IP1, MAXSIZ,
111 . ADD(2,I_ADD_MAX), LOC_PROC, N, ISZNSNR,
112 . NSNFIOLD(NSPMD)
113
114 my_real marge, aaa, bid
115
116 CHARACTER*8 KEY
117
118 INTEGER :: NCAND, NBF, NBL, SOMB, SOME, IPA
119 INTEGER :: TMP1, TMP2, IPOS
120 INTEGER, ALLOCATABLE, DIMENSION(:) :: IFIRST, ILAST
121 CHARACTER*12 ::filename
122
123 INTEGER, ALLOCATABLE, DIMENSION(:) :: order, VALUE
124
125 INTEGER R2,MIN2
126
127C-----------------------------------------------
128C PROV
129C-----------------------------------------------
130 INTEGER NBX,NBY,NBZ
131 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
132C-----------------------------------------------
133C S o u r c e L i n e s
134C-----------------------------------------------
135 ip0 = 1
136 isznsnr = 0
137 i_mem = 0
138 marge = 1.1 * tzinf-gap
139
140 aaa = sqrt(nmn /
141 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
142 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
143 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
144
145 aaa = 0.75*aaa
146
147 nbx = nint(aaa*(bminma(1)-bminma(4)))
148 nby = nint(aaa*(bminma(2)-bminma(5)))
149 nbz = nint(aaa*(bminma(3)-bminma(6)))
150 nbx = max(nbx,1)+2
151 nby = max(nby,1)+2
152 nbz = max(nbz,1)+2
153
154 nbx8=nbx
155 nby8=nby
156 nbz8=nbz
157 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
158 lvoxel8 = lvoxel
159
160 IF(res8 > lvoxel8) THEN
161 if(itask==0.and.ibug22_tri==1)print *, "redim Voxel"
162 aaa = lvoxel
163 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
164 aaa = aaa**(third)
165 nbx = int((nbx+2)*aaa)-2
166 nby = int((nby+2)*aaa)-2
167 nbz = int((nbz+2)*aaa)-2
168 nbx = max(nbx,1)
169 nby = max(nby,1)
170 nbz = max(nbz,1)
171 ENDIF
172
173 nbx8=nbx
174 nby8=nby
175 nbz8=nbz
176 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
177
178 IF(res8 > lvoxel8) THEN
179 nbx = min(100,max(nbx8,1))
180 nby = min(100,max(nby8,1))
181 nbz = min(100,max(nbz8,1))
182 print *, "stop 678"
183c stop 678
184 end if
185
186 ! complete initialization of VOXEL
187 ! (in // SMP there is possibility of processing redundancy but no pb)
188 DO i=inivoxel,(nbx+2)*(nby+2)*(nbz+2)
189 voxel1(i)=0 !---reset voxel brick---!
190 ENDDO
191
192 inivoxel = max(inivoxel,(nbx+2)*(nby+2)*(nbz+2)+1)
193
194 if(itask==0.and.ibug22_tri==1)print *, "call i22trivox"
195
196 CALL i22trivox(
197 1 nsn ,renum ,nshelr_l ,isznsnr ,i_mem ,
198 2 irect ,x ,stf ,stfn ,bminma ,
199 3 nsv ,ii_stok ,cand_b ,eshift ,cand_e ,
200 4 ncontact,noint ,tzinf ,
201 5 voxel1 ,nbx ,nby ,nbz ,
202 6 bid ,
203 7 nshel_t ,
204 8 marge ,
205 9 nin ,itask ,ixs ,bufbric ,
206 a nbric ,itab ,nshel_l )
207
208C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
209C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATES
210C I_MEM = 3 ==> TROP NIVEAUX PILE
211 IF(i_mem==1)THEN
212 nb_n_b = nb_n_b + 1
213 IF ( nb_n_b > ncont) THEN
214 CALL ancmsg(msgid=85,anmode=aninfo,
215 . i1=noint)
216 CALL arret(2)
217 ENDIF
218 ild = 1
219 iskip=1
220 ELSEIF(i_mem==2) THEN
221 IF(debug(1)>=1) THEN
222 iwarn = iwarn+1
223#include "lockon.inc"
224 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
225 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
226 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
227 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
228 WRITE(iout,*)' EXAPNDED'
229#include "lockoff.inc"
230 ENDIF
231C Tzinf = three_over_4*tzinf! No otherwise we lose neighboring candidates
232 ild = 1
233 iskip=1
234 ELSEIF(i_mem==3)THEN
235 nb_n_b = nb_n_b + 1
236 IF ( nb_n_b > ncont) THEN
237 CALL ancmsg(msgid=100,anmode=aninfo,
238 . i1=noint)
239 CALL arret(2)
240 ENDIF
241 ild = 1
242 iskip=1
243 ENDIF
244
245
246!-----------------debug
247 if(itask==0.and.ibug22_tri==1)then
248 print *, " |------------i22buce.F----------|"
249 print *, " | LISTE DES CANDIDATS |"
250 print *, " |-------------------------------|"
251 allocate(order(ii_stok) ,value(ii_stok))
252 min2 = minval(abs(cand_e(1:ii_stok)))
253 r2 = maxval(abs(cand_e(1:ii_stok)))-min2
254 DO i=1,ii_stok
255 value(i) = cand_b(i)*(r2+1)+abs(cand_e(i))-min2
256 ENDDO
257 order=0
258 !CALL QUICKSORT_I2 !(ORDER,II_STOK,VALUE)
259 DO i=1,ii_stok
260 if(cand_e(order(i))>0)then
261 print *,i,ixs(11,bufbric(cand_b(order(i)))),
262 . "avec+",nint(irect_l(1:4,iabs(cand_e(order(i))))) !negative value means that there is no intersection at all for this couple.
263 else
264 print *,i,ixs(11,bufbric(cand_b(order(i)))),
265 . "avec-",nint(irect_l(1:4,iabs(cand_e(order(i))))) !negative value means that there is no intersection at all for this couple.
266 endif
267 END DO
268 deallocate(order,value)
269 end if
270!-----------------debug
271
272!example of candidate list
273! II_STOK IXS(11,bufbric(CAND_B(I))) ) CAND_B(I) NINT(IRECT_L(1:4,IABS(CAND_E(I))) CAND_E(I) occurrence BRIQUE
274! 01 39 (3) with- 1176806 1176814 1176859 1176876 (12) <- IFIRST = 01
275! 02 39 (3) with- 1176941 1176789 1176791 1176934 (11) <- Ilast = 02
276! 03 40 (5) with- 211 210 1176779 1176777 (02) <- IFIRST = 01
277! 04 40 (5) with+ 1176874 1176777 1176779 1176841 (06) .
278! 05 40 (5) with+ 1176874 1176841 1176814 1176806 (14) .
279! 06 40 (5) with+ 1176806 1176814 1176859 1176876 (12) .
280! 07 40 (5) with+ 1176876 1176859 207 206 (03) .
281! 08 40 (5) with- 209 1176772 1176774 208 (01) <- Ilast = 08
282 !
283! NCAND = 8 (II_STOK)
284! LIST_B = {3,5} , NCANDB = 2
285! LIST_E = {1,2,3,6,11,12,14} , NCANDE = 7
286!
287!
288 CALL my_barrier
289
290 IF(iskip==1)THEN
291 nb=ncandb
292 RETURN
293 ENDIF
294
295 ! ##########################################
296 ! # CREATING BRICK LIST IDs #
297 ! # fill LIST_B #
298 ! # fill IADF,IADL #
299 ! ##########################################
300 ! II_STOK is the number of candidate pairs, including non-intersecting facets in the neighborhood
301 ! these are necessary to load the appropriate contact forces
302 IF(itask==0)THEN
303 ALLOCATE(itagb(1:nbric))
304 ALLOCATE(ifirst(1:nbric)) !first occurrence of the brick in the candidate list
305 ALLOCATE(ilast(1:nbric)) !last occurrence of the brick in the candidate list
306 itagb(:) = 0
307 ifirst(:) = 0
308 ilast(:) = 0
309 !loop over the candidate list and tag present bricks
310 DO i=1,ii_stok
311 !pas encore marque
312 IF(itagb(cand_b(i)) == 0)THEN
313 ifirst(cand_b(i)) = i
314 ilast(cand_b(i)) = i !first and last if no other occurrence
315 itagb(cand_b(i)) = 1
316 !deja marque
317 ELSE
318 ilast(cand_b(i)) = i
319 ENDIF
320 enddo!next I
321 ncandb = sum(itagb(:)) !all intersected or non-intersected bricks without multiple occurrences
322 ALLOCATE(list_b(ncandb))
323 ALLOCATE(iadf(ncandb)) !start address in CAND_B
324 ALLOCATE(iadl(ncandb)) !end address in CAND_B
325 ipos = 0
326 DO i=1,nbric
327 IF(itagb(i) == 0)cycle
328 ipos = ipos + 1
329 list_b(ipos) = i
330 iadf(ipos) = ifirst(i)
331 iadl(ipos) = ilast(i)
332 ENDDO
333 endif!(ITASK==0)THEN
334
335 ! ##########################################
336 ! # CREATING FACE LIST IDs #
337 ! # fill LIST_E #
338 ! ##########################################
339 ! II_STOK is the number of candidate pairs, including non-intersecting facets in the neighborhood
340 ! these are necessary to load the appropriate contact forces
341 ! negative facet ids designate non-intersecting facets for the concerned brick
342 IF(itask==0)THEN
343 ALLOCATE(itage(1:nirect_l))
344 itage(:) = 0
345 !loop over the candidate list and tag present bricks
346 DO i=1,ii_stok
347 itage(iabs(cand_e(i))) = 1
348 ENDDO
349 ncande = sum(itage(:)) !all intersected or non-intersected bricks without multiple occurrences
350 ALLOCATE(list_e(ncande))
351 ipos = 0
352 DO i=1,nirect_l
353 IF(itage(i) == 0)cycle
354 ipos = ipos + 1
355 list_e(ipos) = i
356 itage(i) = ipos !the processed tag becomes the position in LIST_E
357 ENDDO
358 endif!(ITASK==0)THEN
359
360
361! the candidate list (CAND_B,CAND_E) contains multiple and disordered occurrences of CAND_E
362! the LIST_E list is the ordered list without repetition
363! for a given candidate pair (input index IDX1), associate the corresponding position in LIST_E (result index IDX2)
364!
365! II_STOK GET_LIST_E_POS_FROM_CAND_E_POS CAND_E(I)
366! 01 pos 6 IN LIST_E(:) <--- (12)
367! 02 pos 5 IN LIST_E(:) <--- (11)
368! 03 pos 2 IN LIST_E(:) <--- (02)
369! 04 pos 4 IN LIST_E(:) <--- (06)
370! 05 pos 7 IN LIST_E(:) <--- (14)
371! 06 pos 6 IN LIST_E(:) <--- (12)
372! 07 pos 3 IN LIST_E(:) <--- (03)
373! 08 pos 1 IN LIST_E(:) <--- (01)
374
375! CAND_E 12 11 02 06 12 14 03 01
376! ITAG_E 01 02 03 04 05 06 07 08 09 10 11 12 13 14
377! x x x x x x x
378! LIST_E 01 02 03 06 11 12 14
379!
380!GET_LIST_E_POS_FROM_CAND_E_POS 06 05 02 04 07 06 03 01
381
382
383 ! ##########################################
384 ! # SURJECTIVE APP IDX1 |-> IDX2 #
385 ! # LINK CAND_E(IDX1) TO LIST_E(IDX2) #
386 ! ##########################################
387 IF(itask==0)THEN
388 ALLOCATE(get_list_e_pos_from_cand_e_pos(ii_stok))
389 DO i=1,ii_stok
390 get_list_e_pos_from_cand_e_pos(i) = itage(iabs(cand_e(i)))
391 ENDDO
392 endif!(ITASK==0)THEN
393
394 CALL my_barrier
395
396 ncand = ii_stok
397
398 if(itask==0.AND.ibug22_tri==1)then
399
400 allocate(order(ncandb) ,value(ncandb))
401 order = 0
402 !CALL QUICKSORT_I2 !(ORDER,NCANDB,list_b)
403
404 print *, ""
405 print *, " |------------i22buce.F----------|"
406 print *, " | SYNTHESE DES CANDIDATS |"
407 print *, " |-------------------------------|"
408 print *, ncand , "couples candidats avec :"
409 print *, ncandb , "briques differentes, et"
410 print *, ncande , "facettes differentes."
411 print *, ""
412 print *, " |------------i22buce.F----------|"
413 print *, " | BRIQUES RETENUES |"
414 print *, " | FOR CUT CELL BUFFER |"
415 print *, " |-------------------------------|"
416 print *, (ixs(11,bufbric(list_b(order(j)))),j=1,ncandb)
417 print *, ""
418 !print *, " |------------i22buce.F----------|"
419 !print *, " | ADDRESSES IN CAND_B |"
420 !print *, " |-------------------------------|"
421 !print *, " IADF=", IADF
422 !print *, " IADL=", IADL
423 !print *, ""
424 deallocate(order,VALUE)
425
426 end if
427
428 !NCANDB is now the number of bricks in CAND_B(1:NCAND)
429 !LIST_B is now the list of these bricks
430 !IADF(I)- IADL(I) is index spectra of a given brick from list_b inside candidate list 1:II_STOK
431 ! from IADF(J) to IADL(J) CAND_B(:) is the same one (see lock on/off in i22sto)
432
433
434C -------------------------------------------------------------
435C recovery of cut cell data from the previous cycle
436C essential to have a history for the calculation of
437C certain evolutions or topological tracking for example
438C -------------------------------------------------------------
439
440 CALL i22get_prev_data(
441 1 x ,ii_stok ,cand_b ,cand_e ,itask ,
442 2 nbric ,itab ,bufbric ,ncand ,
443 3 ixs ,nin)
444
445 !This block must be after I22GET_PREV_DATA OTHERWISE OLD BUFFER IS ERASED
446
447 !ensure this is done in i22intersect
448! IF(ITASK==0)THEN
449! DO I=1,NCANDB_ADD
450! BRICK_LIST(NIN,NCANDB+I)%ID = BUFBRIC(LIST_B_ADD(I))
451! BRICK_LIST(NIN,NCANDB+I)%ICODE = 0
452! BRICK_LIST(NIN,NCANDB+I)%IDBLE = 0
453! BRICK_LIST(NIN,NCANDB+I)%NBCUT = 0
454! DO J=1,12
455! BRICK_LIST(NIN,NCANDB+I)%EDGE(J)%NBCUT = 0
456! ENDDO
457! ENDDO
458! ENDIF
459
460 CALL my_barrier
461
462
463C -------------------------------------------------------------
464C CALCULATION DES POINTS D'INTERSECTION
465C We can take the list of candidates II_Stok as it is
466C and process it in multi-threading
467C -------------------------------------------------------------
468 ! ##########################################
469 ! # POINTS INTERSECTIONS #
470 ! ##########################################
471 CALL i22intersect(
472 1 x ,ii_stok ,cand_b ,cand_e ,itask ,
473 2 nbric ,itab ,bufbric ,ncand ,
474 3 ixs ,nin)
475
476 CALL my_barrier
477
478 ! ##########################################
479 ! # partitioning interpretations #
480 ! ##########################################
481 CALL i22ident(
482 1 ixs ,x ,itask, nin, bufbric)
483
484 nb = ncandb
485 CALL my_barrier
486
487
488 ! ##########################################
489 ! # DECHARGEMENT MEMOIRE #
490 ! ##########################################
491 IF(itask==0)THEN
492 DEALLOCATE(itagb)
493 DEALLOCATE(itage)
494 DEALLOCATE(ifirst)
495 DEALLOCATE(ilast)
496 DEALLOCATE(iadf)
497 DEALLOCATE(iadl)
498 DEALLOCATE(list_b)
499 DEALLOCATE(list_e)
501 ENDIF
502
503
504
505 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine i22get_prev_data(x, ii_stok, cand_b, cand_e, itask, nbric, itab, bufbric, ncand, ixs, nin)
subroutine i22ident(ixs, x, itask, nin, bufbric)
Definition i22ident.F:39
subroutine i22intersect(x, ii_stok, cand_b, cand_e, itask, nbric, itab, bufbric, ncand, ixs, nin)
subroutine i22trivox(nsn, renum, nshelr_l, isznsnr, i_mem, irect, x, stf, stfn, bminma, nsv, ii_stok, cand_b, eshift, cand_e, mulnsn, noint, tzinf, voxel, nbx, nby, nbz, cand_p, nshel_t, marge, nin, itask, ixs, bufbric, nbric, itab, nshel_l)
Definition i22trivox.F:50
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
integer, dimension(:), allocatable list_e
integer, dimension(:), allocatable iadf
integer, dimension(:), allocatable get_list_e_pos_from_cand_e_pos
integer, dimension(:), allocatable itage
integer, dimension(:), allocatable iadl
integer, dimension(:), allocatable itagb
integer, dimension(:), allocatable list_b
integer, dimension(lvoxel) voxel1
Definition tri7box.F:53
integer inivoxel
Definition tri7box.F:53
integer lvoxel
Definition tri7box.F:51
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
subroutine arret(nn)
Definition arret.F:86
subroutine my_barrier
Definition machine.F:31