OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i22trivox.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i22trivox ../engine/source/interfaces/intsort/i22trivox.F
25!||--- called by ------------------------------------------------------
26!|| i22buce ../engine/source/interfaces/intsort/i22buce.F
27!||--- calls -----------------------------------------------------
28!|| i22sto ../engine/source/interfaces/intsort/i22sto.F
29!|| ireallocate ../engine/share/modules/realloc_mod.F
30!|| isonsh3n ../engine/source/interfaces/int22/i22intersect.F
31!|| my_barrier ../engine/source/system/machine.F
32!||--- uses -----------------------------------------------------
33!|| element_mod ../common_source/modules/elements/element_mod.F90
34!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
35!|| i22edge_mod ../common_source/modules/interfaces/cut-cell-buffer_mod.F
36!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
37!|| realloc_mod ../engine/share/modules/realloc_mod.F
38!||====================================================================
39 SUBROUTINE i22trivox(
40 1 NSN ,RENUM ,NSHELR_L,ISZNSNR ,I_MEM ,
41 2 IRECT ,X ,STF ,STFN ,BMINMA ,
42 3 NSV ,II_STOK,CAND_B ,ESHIFT ,CAND_E ,
43 4 MULNSN ,NOINT ,TZINF ,
44 5 VOXEL ,NBX ,NBY ,NBZ ,
45 6 CAND_P ,
46 7 NSHEL_T,
47 8 MARGE ,
48 9 NIN ,ITASK ,IXS ,BUFBRIC ,
49 A NBRIC ,ITAB ,NSHEL_L)
50C============================================================================
51C P r e c o n d i t i o n s
52C-----------------------------------------------
53C VOXEL(*) : initialise a 0
54C I_MEM : 0
55C-----------------------------------------------
56C M o d u l e s
57C-----------------------------------------------
58 USE i22tri_mod
59 USE i22edge_mod
60 USE realloc_mod
61 USE i22bufbric_mod
62 use element_mod , only : nixs
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67#include "comlock.inc"
68C-----------------------------------------------
69C G l o b a l P a r a m e t e r s
70C-----------------------------------------------
71#include "mvsiz_p.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "com01_c.inc"
76#include "param_c.inc"
77#include "task_c.inc"
78C-----------------------------------------------
79C role of the routine:
80C ===================
81C RECHERCHE DE CANDIDATES AU CALCULATION D'INTERSECTION : (BRIQUE, FACETTE)
82C
83C STEP DESCRIPTIONS
84C=======================================================================
85C 0 DATA PRE-TREATMENT
86C=======================================================================
87C=======================================================================
88C 1 VOXEL FILLING
89C=======================================================================
90C=======================================================================
91C 2 CANDIDATE SEARCHING
92C=======================================================================
93C=======================================================================
94C 3 ...
95C=======================================================================
96
97C-----------------------------------------------
98C D u m m y A r g u m e n t s
99C
100C NOM DESCRIPTION E/S
101C
102C IRECT(4,*) : ARRAY OF CONEC FACETTES E
103C X(3,*) : COORDONNEES NODALES E
104C NSV : NOS SYSTEMES DES NODES E
105C Xmax: larger abcisse existing e
106C YMAX: greater order.existing E
107C Zmax: larger existing side E
108C I_STOK : storage level of pairs
109C CANDIDATES impact E/S
110C CAND_B : boites resultats bricks
111C Cand_e: Addresses of the Facets result boxes
112C MULNSN = MULTIMP*NSN maximum size allowed now for the
113C COUPLES NODES,ELT CANDIDATES
114C NOINT : INTERFACE USER NUMBER
115C TZINF : TAILLE ZONE INFLUENCE
116C
117C VOXEL(ix,iy,iz): contains the address of the first link in the chain array for the concerned voxel.
118C LCHAIN_LAST : contains the address of the last link in the chain array for the concerned voxel.
119C LCHAIN_NEXT (*): (*, 1) ID ENTITE, (*, 2) Next address.
120C LCHAIN_ELEM(*) : storage of brick IDs for each voxel (requires start address via VOXEL(ix,iy,iz))
121C
122C-----------------------------------------------
123C D u m m y A r g u m e n t s
124C-----------------------------------------------
125 INTEGER I_MEM,ESHIFT,NSN,ISZNSNR,NSHEL_T,NIN,ITASK,
126 . MULNSN,NOINT,NSHELR_L,IGAP,NBX,NBY,NBZ,NBRIC,
127 . NSV(*),CAND_B(*),CAND_E(*),RENUM(*),
128 . IRECT(4,*), IXS(NIXS,*),
129 . BUFBRIC(NBRIC),
130 . VOXEL(NBX+2,NBY+2,NBZ+2),ITAB(*),NSHEL_L,II_STOK
131
132 my_real
133 . ,TARGET :: X(3,*)
134
135 my_real
136 . bminma(6),cand_p(*), stf(*),stfn(*),
137 . tzinf,marge
138
139 my_real, DIMENSION(SIZ_XREM, NSHEL_T+1: NSHEL_T+NSHELR_L) ::
140 . xrem
141
142C-----------------------------------------------
143C L o c a l V a r i a b l e s
144C-----------------------------------------------
145 INTEGER NB_NCN,NB_NCN1,NB_ECN,I,J,K,L,DIR,NB_NC,NB_EC,
146 . N1,N2,N3,N4,NN,NE,NS,NCAND_PROV,J_STOK,II,JJ,TT,
147 . OLDNUM(ISZNSNR), NSNF, NSNL,
148 . PROV_B(2*MVSIZ), PROV_E(2*MVSIZ), LAST_NE,
149 . voxbnd(2*mvsiz,0:1,1:3) !voxel bounds storage for shell: comp1=id, comp2=lbound/ubound, comp3=direction.
150
151 my_real
152 . dx,dy,dz,xs,ys,zs,sx,sy,sz,s2,
153 . xmin, xmax,ymin, ymax,zmin, zmax, tz, gapsmx, gapl,
154 . d1x,d1y,d1z,d2x,d2y,d2z,dd1,dd2,d2,a2,gs, point(3),
155 . on1(3),n1n2(3)
156
157 INTEGER IX,IY,IZ,NEXT,M1,M2,M3,M4,M5,M6,M7,M8,
158 . IX1,IY1,IZ1,IX2,IY2,IZ2,IBUG,IBUG2,I_LOC,
159 . BIX1(NBRIC),BIY1(NBRIC),BIZ1(NBRIC),
160 . BIX2(NBRIC),BIY2(NBRIC),BIZ2(NBRIC),
161 . first_add, prev_add, lchain_add, i_stok
162
163 INTEGER :: NC, I_STOK_BAK, IPA,IPB
164 my_real
165 . XMINB,YMINB,ZMINB,XMAXB,YMAXB,ZMAXB,
166 . DXB,DYB,DZB,
167 . aaa, daaa, dmax
168
169 LOGICAL, DIMENSION(NBRIC) :: TAGB
170! Logical, dimension (12*nbric) :: ledge
171 LOGICAL :: BOOL(NIRECT_L)
172 INTEGER NBCUT, DEJA, ISONSHELL, ISONSH3N
173 INTEGER :: COUNTER, NEDGE, NFACE, NODES8(8), COUNTER_BRICK(NBRIC)
174
175c INTEGER, DIMENSION(2,24) :: iEDGE !12 without diagonals, 24 with diagonals
176c INTEGER, DIMENSION(2,2,6) :: iFACE
177 INTEGER :: iN1, iN2, iN1a, iN2a, iN1b, iN2b , iN3, iN4
178 INTEGER :: POS, IAD, IB , NBF, NBL
179 INTEGER :: I_12bits, nbits, npqts, pqts(4), SUM, SECTION
180 INTEGER :: I_bits(12), MAX_ADD, IMIN_LOC, IMAX_LOC
181
182 my_real ::
183 . aeradiag,xx(8),yy(8),zz(8),diag(4)
184
185 CHARACTER*12 :: sectype
186 LOGICAL :: IsSecDouble, IsSTO
187
188 CHARACTER(LEN=1) filenum
189
190 INTEGER ::
191 . MIN_IX_LOC, MIN_IY_LOC, MIN_IZ_LOC, !indice voxel min utilise
192 . max_ix_loc, max_iy_loc, max_iz_loc !Voxel Max index uses
193
194 INTEGER, ALLOCATABLE, DIMENSION(:) :: order, VALUE
195
196 INTEGER R2,MIN2
197
198
199
200
201
202C-----------------------------------------------
203C=======================================================================
204C -1 INITIALIZATION
205C=======================================================================
206
207!-----------debug---------------
208 IF(ibug22_trivox==1 .AND. itask==0)THEN
209 print *, " i22trivox:entering routine"
210 print *, ""
211 print *, "------------------BRICKS DOMAIN--------------------"
212 print *, " BMINMAL_I22TRIVOX=", bminma(4:6),bminma(1:3)
213 print *, " NBX,NBY,NBZ=", nbx,nby,nbz
214 print *, "---------------------------------------------------"
215 print *, ""
216 print *, ""
217 print *, " |-----------i22trivox.F---------|"
218 print *, " | DOMAIN INFORMATION |"
219 print *, " |-------------------------------|"
220 print *, " MPI =",ispmd +1
221 print *, " NT =",itask+1
222 print *, " NCYCLE =", ncycle
223 print *, " ITASK =", itask
224 print *, " NIRECT_L =", nirect_l
225 print *, " local bricks :", nbric
226 print *, " tableau briques du domaine local :"
227 print *, ixs(11,bufbric(1:nbric))
228 print *, " local faces :",nshel_l
229 print *, " tableau facettes du domaine local :"
230 DO i=1, nirect_l-nshelr_l
231 print *, i,nint(irect_l(1:4, i))
232 END DO
233 print *, " +remotes:"
234 DO i=nirect_l-nshelr_l+1, nirect_l
235 print *, i,irect_l(1:4, i)
236 END DO
237 print *, " |-------------------------------|"
238 print *, ""
239 print *, " |-----i22trivox.F--------|"
240 print *, " | THREAD INFORMATION |"
241 print *, " |------------------------|"
242! print *, " THREAD/NTHREAD=",ITASK+1,NTHREAD
243 print *, " cple candidats max : ", mulnsn
244 print *, " ESHIFT=", eshift
245 print *, " |------------------------|"
246 print *, ""
247 end if
248 CALL my_barrier
249!-----------debug---------------
250
251C=======================================================================
252C 0 DATA PRE-TREATMENT
253C=======================================================================
254
255 max_add = mulnsn !12*NIRECT_L ! a optimiser eventuellmeent
256 aaa = zero
257
258 !---------------------------------------------------------!
259 ! Dynamic Allocations !
260 !---------------------------------------------------------!
261 !---------------------------------------------------------!
262 ! + Storing Min/Max for coordinates and voxel indexes !
263 !---------------------------------------------------------!
264 IF(itask == 0)THEN
265 !Possible reallocate for Lchain _*() ()
266 NULLIFY (lchain_last, lchain_next, lchain_elem)
267 ALLOCATE(lchain_elem(max_add))
268 ALLOCATE(lchain_next(max_add))
269 ALLOCATE(lchain_last(max_add))
270 min_ix = nbx+2
271 min_iy = nby+2
272 min_iz = nbz+2
273 max_ix = 0
274 max_iy = 0
275 max_iz = 0
276 current_add = 1 ! first address in the common chain array
277 END IF
278 IF(itask==nthread-1)THEN
279 ALLOCATE(eix1(nirect_l),eiy1(nirect_l),eiz1(nirect_l))
280 ALLOCATE(eix2(nirect_l),eiy2(nirect_l),eiz2(nirect_l))
281 eix1=nbx+2 !a initialiser car si pas de candidat et ftrapuv alors min/max globaux erratics
282 eiy1=nbx+2 !set to nthread -1
283 eiz1=nbx+2
284 eix2=0
285 eiy2=0
286 eiz2=0
287 END IF
288
289 CALL my_barrier ! All thread have to wait for common initialization.
290
291 !---------------------------------------------------------!
292 ! Domain bounds reading !
293 !---------------------------------------------------------!
294 !field terminal: intersection between
295 ! domaine fluide local
296 ! Global lag domain
297 xminb = bminma(4)
298 yminb = bminma(5)
299 zminb = bminma(6)
300 xmaxb = bminma(1)
301 ymaxb = bminma(2)
302 zmaxb = bminma(3)
303 aaa = tzinf !MARGE TO EXTEND SEARCH. MUST BE LARGE ENOUGH TO INCLUDE ADJACENT UNCUT CELLS
304 !already done in i22main_tri for lagrangian domains
305 xminb = xminb - aaa
306 yminb = yminb - aaa
307 zminb = zminb - aaa
308 xmaxb = xmaxb + aaa
309 ymaxb = ymaxb + aaa
310 zmaxb = zmaxb + aaa
311
312 dxb = xmaxb-xminb
313 dyb = ymaxb-yminb
314 dzb = zmaxb-zminb
315
316 !If AAA=0 then voxel domain can be degenerated. Example : 1shell in plane XY => DZB=0
317 daaa = ( (bminma(1)-bminma(4))+(bminma(2)-bminma(5))+
318 . (bminma(3)-bminma(6)) ) / three/hundred
319 dmax = max(max(dxb,dyb),dzb)
320
321 IF(dxb/dmax<em06)dxb=daaa
322 IF(dyb/dmax<em06)dyb=daaa
323 IF(dzb/dmax<em06)dzb=daaa
324
325 !we partition the sweep of the global shell node array (IRECT_L(1:NIRECT_L)) over different threads (multithreading)
326 nbf = 1+itask*nirect_l/nthread
327 nbl = (itask+1)*nirect_l/nthread
328
329c if(itask==0.and.ibug22_trivox==1)print *,
330c ."Voxel filling with the following Shell:"
331
332 DO ne=nbf,nbl
333 IF(irect_l(23,ne)==zero)cycle
334 IF(((xmaxe(ne)< xminb).OR.(xmine(ne)>xmaxb)).OR.
335 . ((ymaxe(ne)< yminb).OR.(ymine(ne)>ymaxb)).OR.
336 . ((zmaxe(ne)< zminb).OR.(zmine(ne)>zmaxb)))THEN
337 irect_l(23,ne)=zero
338 !print *, "skip shell=", NE
339 cycle
340 END IF
341 !-------------------------------------------!
342 ! VOXEL OCCUPIED BY THE BRICK !
343 !-------------------------------------------!
344 !Voxel_lower_left_bound for this element---+
345 ix1=int(nbx*(irect_l(17,ne)-aaa-xminb)/dxb)
346 iy1=int(nby*(irect_l(18,ne)-aaa-yminb)/dyb)
347 iz1=int(nbz*(irect_l(19,ne)-aaa-zminb)/dzb)
348 eix1(ne)=max(1,2+min(nbx,ix1))
349 eiy1(ne)=max(1,2+min(nby,iy1))
350 eiz1(ne)=max(1,2+min(nbz,iz1))
351 !Voxel_upper_right_bound for this element---+
352 ix2=int(nbx*(irect_l(20,ne)+aaa-xminb)/dxb)
353 iy2=int(nby*(irect_l(21,ne)+aaa-yminb)/dyb)
354 iz2=int(nbz*(irect_l(22,ne)+aaa-zminb)/dzb)
355 eix2(ne)=max(1,2+min(nbx,ix2))
356 eiy2(ne)=max(1,2+min(nby,iy2))
357 eiz2(ne)=max(1,2+min(nbz,iz2))
358 END DO
359 !-------------------------------------------!
360 ! VOXEL INDEX RANGE FOR VOXEL RESETTING !
361 !-------------------------------------------!
362 !for voxel reset
363 min_ix_loc = min(min_ix,minval(eix1(nbf:nbl)))
364 min_iy_loc = min(min_iy,minval(eiy1(nbf:nbl)))
365 min_iz_loc = min(min_iz,minval(eiz1(nbf:nbl)))
366 max_ix_loc = max(max_ix,maxval(eix2(nbf:nbl)))
367 max_iy_loc = max(max_iy,maxval(eiy2(nbf:nbl)))
368 max_iz_loc = max(max_iz,maxval(eiz2(nbf:nbl)))
369 !----------------------------------------------!
370 ! GLOBAL MIN/MAX VOXEL INDEX RANGE FOR RESET !
371 !----------------------------------------------!
372#include "lockon.inc"
373 min_ix = min(min_ix_loc,min_ix)
374 min_iy = min(min_iy_loc,min_iy)
375 min_iz = min(min_iz_loc,min_iz)
376 max_ix = max(max_ix_loc,max_ix)
377 max_iy = max(max_iy_loc,max_iy)
378 max_iz = max(max_iz_loc,max_iz)
379#include "lockoff.inc"
380 CALL my_barrier ! waiting for EIX1, ...,EIZ2
381
382 !optimization: if no candidate: the default values of min max voxel indices for this thread are constraining for reinitialization.
383
384C=======================================================================
385C 1 VOXEL FILLING with faces data below
386C=======================================================================
387 !----------------------------------------------!
388 ! SHELL STORAGE FOR EACH VOXEL (CHAINED ARRAY) !
389 !----------------------------------------------!
390C
391C VOXEL(*,*,*) LCHAIN_LAST(FIRST)
392C +-----------+------------+
393C | FIRST | LAST |
394C +--+--------+--+---------+
395C | |
396C | |
397C | |
398C | | LCHAIN_ELEM(*) LCHAIN_NEXT(*)
399C | | +------------+-----------+
400C +-------------->| elemid | iadd 3 | 1:FIRST --+
401C | +------------+-----------+ |
402C | | | | 2 |
403C | +------------+-----------+ |
404C | | elemid | iadd 4 | 3 <-------+
405C | +------------+-----------+ |
406C | | elemid | iadd 6 | 4 <-------+
407C | +------------+-----------+ |
408C | | | | 5 |
409C | +------------+-----------+ |
410C +-->| elemid | 0 | 6:LAST <--+
411C +------------+-----------+
412C | | | 7
413C +------------+-----------+
414
415
416 !----------------------------------------------!
417 ! VOXEL FILLING !
418 !----------------------------------------------!
419 IF(itask==0)THEN
420 DO ne=1,nirect_l
421 IF(irect_l(23,ne)==zero)cycle !stiffness
422!--------------debug
423 if(itask==0.and.ibug22_trivox==1)then
424 print *, " traitement shell",nint(irect_l((/1,3/),ne)),
425 . "indices",eix1(ne),eix2(ne), eiy1(ne),eiy2(ne),eiz1(ne),eiz2(ne)
426 print *, " xmin/xmax=", irect_l((/17,20/),ne)
427 print *, " ymin/ymax=", irect_l((/18,21/),ne)
428 print *, " zmin/zmax=", irect_l((/19,22/),ne)
429 end if
430!--------------debug
431 DO iz = eiz1(ne),eiz2(ne)
432 DO iy = eiy1(ne),eiy2(ne)
433 DO ix = eix1(ne),eix2(ne)
434 first_add = voxel(ix,iy,iz)
435 IF(first_add == 0)THEN
436 !Empty Cell
437 voxel(ix,iy,iz) = current_add ! address in the chain array
438 lchain_last(current_add) = current_add ! last = current
439 lchain_elem(current_add) = ne ! coque ID
440 lchain_next(current_add) = 0 ! no next because last in the list !
441 ELSE
442 !Box containing several elements, Jump to the Last Node of the Cell
443 prev_add = lchain_last(first_add)! becomes the penultimate
444 lchain_last(first_add) = current_add ! update of the last
445 lchain_elem(current_add) = ne ! coque ID
446 lchain_next(prev_add) = current_add ! maj du suivant 0 -> CURRENT_ADD
447 lchain_next(current_add) = 0 ! no next because last in the list
448 ENDIF
449 current_add = current_add+1
450 IF( current_add>=max_add)THEN
451 !Optimization: DEALLOCATE/GOTO DEBUT SUPRRESION.
452 !REALLOCATE SI PAS ASSEZ DE PLACE : inutile de recommencer de 1 a MAX_ADD-1, on poursuit de MAX_ADD a 2*MAX_ADD
453 max_add = 2 * max_add
454 if(ibug22_trivox==1)print *, "reallocate"
455 lchain_next => ireallocate(lchain_next, max_add)
456 lchain_elem => ireallocate(lchain_elem, max_add)
457 lchain_last => ireallocate(lchain_last, max_add)
458 ENDIF
459 ENDDO !IX
460 ENDDO !IY
461 ENDDO !IZ
462 END DO !I=1,NIRECT_L
463 END IF
464 CALL my_barrier
465
466!------ post ---- debug
467 IF(itask==0.and.ibug22_trivox==1)
468 .print *, " i22trivox:voxel filled"
469!------ post ---- debug
470
471C=======================================================================
472C 2 from the voxels occupied by a brick, we are able
473C to know all the shells in its neighborhood.
474C On creer alors les couples CANDIDATES.
475C=======================================================================
476 nc = 0
477 i_stok = 0
478 last_ne = 0
479 nbf = 1+itask*nbric/nthread
480 nbl = (itask+1)*nbric/nthread
481
482 DO i=nbf,nbl !1,NBRIC
483
484c if(ibug22_trivox==1)print *,
485c . " i22trivox : BOUCLE BRIQUE, I=",IXS(11,BUFBRIC(I))
486 !-------------------------------------------!
487 ! VOXEL OCCUPIED BY THE BRICK !
488 !-------------------------------------------!
489 !Voxel_lower_left_bound for this element---+
490 ix1=int(nbx*(xmins(i)-xminb)/dxb)
491 iy1=int(nby*(ymins(i)-yminb)/dyb)
492 iz1=int(nbz*(zmins(i)-zminb)/dzb)
493 bix1(i)=max(1,2+min(nbx,ix1))
494 biy1(i)=max(1,2+min(nby,iy1))
495 biz1(i)=max(1,2+min(nbz,iz1))
496 !Voxel_upper_right_bound for this element---+
497 ix2=int(nbx*(xmaxs(i)-xminb)/dxb)
498 iy2=int(nby*(ymaxs(i)-yminb)/dyb)
499 iz2=int(nbz*(zmaxs(i)-zminb)/dzb)
500 bix2(i)=max(1,2+min(nbx,ix2))
501 biy2(i)=max(1,2+min(nby,iy2))
502 biz2(i)=max(1,2+min(nbz,iz2))
503
504
505 !-------------------------------------------!
506 ! NEIGHBORS SEARCH !
507 !-------------------------------------------!
508 ! a brick can occupy several voxels, by looking in the voxels
509 ! Occupied we can therefore find the same facet several times.We avoid repeat
510 !with a BOOL(I) tag.
511 DO iz = biz1(i),biz2(i)
512 DO iy = biy1(i),biy2(i)
513 DO ix = bix1(i),bix2(i)
514 lchain_add = voxel(ix,iy,iz)
515 DO WHILE(lchain_add /= 0) ! loop on shells of current voxel
516 ne = lchain_elem(lchain_add) ! ID COQUE DU VOXEL COURANT
517 bool(ne)=.false.
518 lchain_add = lchain_next(lchain_add)
519 ENDDO ! WHILE(LCHAIN_ADD /= 0) ! BOOL(I)=true indique que l'id coque a deja ete traite pour la brique courante
520 ENDDO !nbz
521 ENDDO !nby
522 ENDDO !nbx
523
524 issto = .false. ! if I22sto is called then we switch to true. this is the signal to execute lockoff and allow processing of another brick on other threads
525
526 DO iz = biz1(i),biz2(i)
527 DO iy = biy1(i),biy2(i)
528 DO ix = bix1(i),bix2(i)
529 lchain_add = voxel(ix,iy,iz) ! address of the ID of the first brick in the voxel
530 DO WHILE(lchain_add /= 0) ! loop on bricks of current voxel
531 ne = lchain_elem(lchain_add) ! ID BRICK DU VOXEL COURANT
532 ! non-intersection criterion
533 ! the two cartesian bounding volumes are disjoint.
534 IF(bool(ne))THEN
535 lchain_add = lchain_next(lchain_add)
536 cycle
537 END IF
538 j = ne
539 ns = bufbric(i)
540 xx(1:8) = x(1,ixs(2:9,ns))
541 yy(1:8) = x(2,ixs(2:9,ns))
542 zz(1:8) = x(3,ixs(2:9,ns))
543 diag(1) = sqrt((xx(1)-xx(7))**2 + (yy(1)-yy(7))**2 + (zz(1)-zz(7))**2)
544 diag(2) = sqrt((xx(3)-xx(5))**2 + (yy(3)-yy(5))**2 + (zz(3)-zz(5))**2)
545 diag(3) = sqrt((xx(2)-xx(8))**2 + (yy(2)-yy(8))**2 + (zz(2)-zz(8))**2)
546 diag(4) = sqrt((xx(4)-xx(6))**2 + (yy(4)-yy(6))**2 + (zz(4)-zz(6))**2)
547 aaa = 1.2d00*maxval(diag(1:4),1)
548
549 ! we ignore the element if intersection with brick is null: margin ensures taking neighboring bricks for cut cell buffer extension
550 IF( (irect_l(17,ne)-aaa>xmaxs(i)).OR. !XMINE-AAA > XMAXS
551 . (irect_l(20,ne)+aaa<xmins(i)).OR. !XMAXE+AAA < XMINS
552 . (irect_l(18,ne)-aaa>ymaxs(i)).OR. !YMINE-AAA > YMAXS !Optimization : +/-AAA deja calculee, stoquer et reprendre (gain 6 operations par iteration)
553 . (irect_l(21,ne)+aaa<ymins(i)).OR. !YMAXE+AAA < YMINS
554 . (irect_l(19,ne)-aaa>zmaxs(i)).OR. !ZMINE-AAA > ZMAXS
555 . (irect_l(22,ne)+aaa<zmins(i)) ) THEN !ZMAXE+AAA < ZMINS
556 lchain_add = lchain_next(lchain_add)
557 cycle
558 END IF
559 bool(ne) =.true. ! from here we consider that the shell has already been processed with the current brick. if we find it in another voxel we will not consider the pair a second time.
560 i_stok = i_stok + 1
561 prov_b(i_stok) = i !brique
562 prov_e(i_stok) = ne !facette
563 lchain_add = lchain_next(lchain_add)
564 tagb(i) = .true.
565 !SI SANS MARGE, INTERSECTION NULLE, ALORS SKIP
566 IF( (irect_l(17,ne) >xmaxs(i)).OR.
567 . (irect_l(20,ne) <xmins(i)).OR.
568 . (irect_l(18,ne) >ymaxs(i)).OR.
569 . (irect_l(21,ne) <ymins(i)).OR.
570 . (irect_l(19,ne) >zmaxs(i)).OR.
571 . (irect_l(22,ne) <zmins(i)) ) prov_e(i_stok) = -prov_e(i_stok) !intersection nulle
572 !-------------------------------------------!
573 ! COUPLE STORAGE (siz=mvsiz) !
574 !-------------------------------------------!
575 IF(i_stok>=nvsiz)THEN
576c if(ibug22_trivox==1)print *,
577c . " i22trivox.F:purge des CANDIDATES prov",
578c . II_STOK+I_STOK, "CORE=",ITASK+1, "BRIQUE=",
579c . IXS(11,BUFBRIC(I))
580 CALL i22sto(
581 1 i_stok ,irect ,x , ii_stok, cand_b,
582 2 cand_e ,mulnsn ,noint , marge , i_mem ,
583 3 prov_b ,prov_e ,eshift , itask , nc ,
584 4 ixs ,bufbric ,nbric , issto )
585 i_stok = 0
586 IF(i_mem==2) THEN
587 if(ibug22_trivox==1)then
588 print *, " i22trivox.F:too much candidates on thread=",
589 . itask+1
590 print *, " i22trivox.F:II_STOK=", ii_stok,mulnsn
591 end if
592 GOTO 1000
593 END if!(I_MEM==2)
594 endif!(I_STOK>=NVSIZ)
595 !-------------------------------------------!
596 ENDDO ! WHILE(LCHAIN_ADD /= 0)
597 ENDDO !nbz
598 ENDDO !nby
599 ENDDO !nbz
600 !-------------------------------------------!
601 ! COUPLE STORAGE (siz<mvsiz) !
602 !-------------------------------------------!
603 IF(i_stok/=0)THEN
604c if(ibug22_trivox==1)print *, " i22trivox.F:purge<MVSIZ",
605c . II_STOK+I_STOK, "CORE=",ITASK+1, "BRIQUE=",I
606 CALL i22sto(
607 1 i_stok ,irect ,x , ii_stok ,cand_b,
608 2 cand_e ,mulnsn ,noint , marge ,i_mem ,
609 3 prov_b ,prov_e ,eshift , itask ,nc ,
610 4 ixs ,bufbric ,nbric , issto )
611 i_stok = 0
612 IF(i_mem==2) THEN
613c if(ibug22_trivox==1)then
614c print *, " i22trivox.F:too much candidates on thread=",
615c . ITASK+1
616c print *, " i22trivox.F:II_STOK=", II_STOK,MULNSN
617c end if
618 GOTO 1000
619 END if!(I_MEM==2)
620 END IF
621 !-------------------------------------------!
622 ! UNLOCK NEEDED IF CURRENT BRICK WAS USED !
623 ! FOR STORAGE COUPLE !
624 !-------------------------------------------!
625 IF(issto)THEN
626c if(ibug22_trivox==1)print *, " i22trivox.F:lockoff", ITASK,
627c . "bric:", I, "IsSTO=", IsSTO
628#include "lockoff.inc"
629 !this allows having connectivity in the array (/CAND_B(I),CAND_E(I)/) of pairs for a given brick. (for multi-threading of subsequent intersection calculations)
630 END IF
631 !-------------------------------------------!
632 END DO !next I (1,NBRIC)
633
634C-------------------------------------------------------------------------
635C end of search
636C-------------------------------------------------------------------------
637
638
639C=======================================================================
640C 3 VOXEL RESET
641C=======================================================================
642 1000 CONTINUE
643
644 CALL my_barrier ! All threads need to finish its work with common Voxel before resetting it.
645
646 if(itask==0.AND.ibug22_trivox==1) print *,
647 . " i22trivox.F:nb de candidats:" , ii_stok, itask
648
649 IF(itask==0)THEN
650 !RESET VOXEL WITHIN USED RANGE ONLY
651 DO k= min_iz , max_iz
652 DO j= min_iy,max_iy
653 DO i= min_ix,max_ix
654 voxel(i,j,k) = 0
655 END DO
656 END DO
657 END DO
658 ENDIF
659
660
661
662 !-------------------------------------------!
663 ! DEALLOCATE !
664 !-------------------------------------------!
665 IF(itask == 0)THEN
666 DEALLOCATE(lchain_last, lchain_next, lchain_elem )
667 DEALLOCATE(eix1, eiy1, eiz1, eix2, eiy2, eiz2)
668 NULLIFY (lchain_last, lchain_next, lchain_elem)
669 ENDIF
670
671!------ post ---- debug
672 if(ibug22_trivox==1)CALL my_barrier !(all threads must reinit before testing)
673 if(itask==0.AND.ibug22_trivox==1)then
674 DO ix=1,(nbx+2)
675 DO iy=1,(nby+2)
676 DO iz=1,(nbz+2)
677 if (voxel(ix,iy,iz)/=0) then
678 print *, " i22trivox.F:error raz voxel",voxel(ix,iy,iz)
679 print *, " i22trivox.F:ix,iy,iz=", ix,iy,iz
680 stop
681 end if
682 END DO
683 END DO
684 END DO
685 print *, " i22trivox.F:raz voxel ok."
686 end if
687 if(i_mem==2)then
688 if(itask==0.AND.ibug22_trivox==1)
689 . print *,
690 . " i22trivox.F:returning i22buce (too much candidate)"
691 GOTO 2000
692 end if
693 if(itask==0.AND.ibug22_trivox==1)
694 . print *, " i22trivox.F:fin recherche des candidats, nb=",
695 . ii_stok
696
697 if(itask==0.AND.ibug22_trivox==1)then
698 allocate(order(ii_stok) ,value(ii_stok))
699 min2 = minval(abs(cand_e(1:ii_stok)))
700 r2 = maxval(abs(cand_e(1:ii_stok))) - min2
701 DO i=1,ii_stok
702 value(i) = cand_b(i)*(r2+1)+abs(cand_e(i))-min2
703 ENDDO
704 order=0
705 !CALL QUICKSORT_I2 !(ORDER,II_STOK,VALUE)
706 !two column sorting (CAND_B,CAND_E) matrix by giving a vaue to each couple
707
708
709 print *, " II_STOK=", ii_stok
710 print *, " IXS(11,BUFBRIC(CAND_B)) ) =", ixs(11, bufbric(cand_b(order(1:ii_stok))))
711 print *, " BUFBRIC(CAND_B) =", bufbric(cand_b(order(1:ii_stok)))
712 print *, " CAND_B =", cand_b(order(1:ii_stok))
713 print *, " CAND_E =", cand_e(order(1:ii_stok))
714
715 deallocate(order,VALUE)
716 endif
717
718
719
720
721
722!------ post ---- debug
723 2000 CONTINUE
724 CALL my_barrier ! waiting vor voxel reset (and common deallocations)
725
726 RETURN
727 END SUBROUTINE
728
729
if
if(complex_arithmetic) id
i22sto
subroutine i22sto(j_stok, irect, x, ii_stok, cand_b, cand_e, mulnsn, noint, marge, i_mem, prov_b, prov_e, eshift, itask, nc, ixs, bufbric, nbric, issto)
Definition i22sto.F:36
i22trivox
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
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22edge_mod
Definition cut-cell-buffer_mod.F:48
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::lchain_next
integer, dimension(:), pointer lchain_next
Definition cut-cell-search_mod.F:474
i22tri_mod::max_iz
integer max_iz
Definition cut-cell-search_mod.F:437
i22tri_mod::lchain_elem
integer, dimension(:), pointer lchain_elem
Definition cut-cell-search_mod.F:474
i22tri_mod::eiz2
integer, dimension(:), allocatable eiz2
Definition cut-cell-search_mod.F:490
i22tri_mod::ibug22_trivox
integer ibug22_trivox
Definition cut-cell-search_mod.F:236
i22tri_mod::eiz1
integer, dimension(:), allocatable eiz1
Definition cut-cell-search_mod.F:490
i22tri_mod::min_iz
integer min_iz
Definition cut-cell-search_mod.F:437
i22tri_mod::lchain_last
integer, dimension(:), pointer lchain_last
Definition cut-cell-search_mod.F:474
i22tri_mod::eiy2
integer, dimension(:), allocatable eiy2
Definition cut-cell-search_mod.F:490
i22tri_mod::max_iy
integer max_iy
Definition cut-cell-search_mod.F:437
i22tri_mod::eix2
integer, dimension(:), allocatable eix2
Definition cut-cell-search_mod.F:490
i22tri_mod::min_iy
integer min_iy
Definition cut-cell-search_mod.F:437
i22tri_mod::current_add
integer current_add
Definition cut-cell-search_mod.F:441
i22tri_mod::max_ix
integer max_ix
Definition cut-cell-search_mod.F:437
i22tri_mod::eix1
integer, dimension(:), allocatable eix1
Definition cut-cell-search_mod.F:490
i22tri_mod::eiy1
integer, dimension(:), allocatable eiy1
Definition cut-cell-search_mod.F:490
i22tri_mod::min_ix
integer min_ix
Definition cut-cell-search_mod.F:437
realloc_mod
Definition realloc_mod.F:29
realloc_mod::ireallocate
integer function, dimension(:), pointer ireallocate(ptr, new_size)
Definition realloc_mod.F:39
my_barrier
subroutine my_barrier
Definition machine.F:31