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!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
34!|| i22edge_mod ../common_source/modules/interfaces/cut-cell-buffer_mod.F
35!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
36!|| realloc_mod ../engine/share/modules/realloc_mod.F
37!||====================================================================
38 SUBROUTINE i22trivox(
39 1 NSN ,RENUM ,NSHELR_L,ISZNSNR ,I_MEM ,
40 2 IRECT ,X ,STF ,STFN ,BMINMA ,
41 3 NSV ,II_STOK,CAND_B ,ESHIFT ,CAND_E ,
42 4 MULNSN ,NOINT ,TZINF ,
43 5 VOXEL ,NBX ,NBY ,NBZ ,
44 6 CAND_P ,
45 7 NSHEL_T,
46 8 MARGE ,
47 9 NIN ,ITASK ,IXS ,BUFBRIC ,
48 A NBRIC ,ITAB ,NSHEL_L)
49C============================================================================
50C P r e c o n d i t i o n s
51C-----------------------------------------------
52C VOXEL(*) : initialise a 0
53C I_MEM : 0
54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE i22tri_mod
58 USE i22edge_mod
59 USE realloc_mod
60 USE i22bufbric_mod
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65#include "comlock.inc"
66C-----------------------------------------------
67C G l o b a l P a r a m e t e r s
68C-----------------------------------------------
69#include "mvsiz_p.inc"
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "com01_c.inc"
74#include "param_c.inc"
75#include "task_c.inc"
76C-----------------------------------------------
77C ROLE DE LA ROUTINE:
78C ===================
79C RECHERCHE DE CANDIDATS AU CALCUL D'INTERSECTION : (BRIQUE, FACETTE)
80C
81C STEP DESCRIPTIONS
82C=======================================================================
83C 0 DATA PRE-TREATMENT
84C=======================================================================
85C=======================================================================
86C 1 VOXEL FILLING
87C=======================================================================
88C=======================================================================
89C 2 CANDIDATE SEARCHING
90C=======================================================================
91C=======================================================================
92C 3 ...
93C=======================================================================
94
95C-----------------------------------------------
96C D u m m y A r g u m e n t s
97C
98C NOM DESCRIPTION E/S
99C
100C IRECT(4,*) : TABLEAU DES CONEC FACETTES E
101C X(3,*) : COORDONNEES NODALES E
102C NSV : NOS SYSTEMES DES NOEUDS E
103C XMAX : plus grande abcisse existante E
104C YMAX : plus grande ordonn. existante E
105C ZMAX : plus grande cote existante E
106C I_STOK : niveau de stockage des couples
107C candidats impact E/S
108C CAND_B : boites resultats bricks
109C CAND_E : adresses des boites resultat facettes
110C MULNSN = MULTIMP*NSN TAILLE MAX ADMISE MAINTENANT POUR LES
111C COUPLES NOEUDS,ELT CANDIDATS
112C NOINT : NUMERO USER DE L'INTERFACE
113C TZINF : TAILLE ZONE INFLUENCE
114C
115C VOXEL(ix,iy,iz): contient l'adresse du premier chainon dans le tableau chaine pour le voxel concerne.
116C LCHAIN_LAST : contient l'adresse du dernier chainon dans le tableau chaine pour le voxel concerne.
117C LCHAIN_NEXT(*) : (*,1) id entite, (*,2) adresse suivante.
118C LCHAIN_ELEM(*) : stockage des id des briques pour chaque voxel (necessite l'adresse de debut via VOXEL(ix,iy,iz) )
119C
120C-----------------------------------------------
121C D u m m y A r g u m e n t s
122C-----------------------------------------------
123 INTEGER I_MEM,ESHIFT,NSN,ISZNSNR,NSHEL_T,NIN,ITASK,
124 . MULNSN,NOINT,NSHELR_L,IGAP,NBX,NBY,NBZ,NBRIC,
125 . NSV(*),CAND_B(*),CAND_E(*),RENUM(*),
126 . IRECT(4,*), IXS(NIXS,*),
127 . BUFBRIC(NBRIC),
128 . VOXEL(NBX+2,NBY+2,NBZ+2),ITAB(*),NSHEL_L,II_STOK
129
130 my_real
131 . ,TARGET :: X(3,*)
132
133 my_real
134 . bminma(6),cand_p(*), stf(*),stfn(*),
135 . tzinf,marge
136
137 my_real, DIMENSION(SIZ_XREM, NSHEL_T+1: NSHEL_T+NSHELR_L) ::
138 . xrem
139
140C-----------------------------------------------
141C L o c a l V a r i a b l e s
142C-----------------------------------------------
143 INTEGER NB_NCN,NB_NCN1,NB_ECN,I,J,K,L,DIR,NB_NC,NB_EC,
144 . N1,N2,N3,N4,NN,NE,NS,NCAND_PROV,J_STOK,II,JJ,TT,
145 . OLDNUM(ISZNSNR), NSNF, NSNL,
146 . PROV_B(2*MVSIZ), PROV_E(2*MVSIZ), LAST_NE,
147 . voxbnd(2*mvsiz,0:1,1:3) !voxel bounds storage for shell: comp1=id, comp2=lbound/ubound, comp3=direction.
148
149 my_real
150 . dx,dy,dz,xs,ys,zs,sx,sy,sz,s2,
151 . xmin, xmax,ymin, ymax,zmin, zmax, tz, gapsmx, gapl,
152 . d1x,d1y,d1z,d2x,d2y,d2z,dd1,dd2,d2,a2,gs, point(3),
153 . on1(3),n1n2(3)
154
155 INTEGER IX,IY,IZ,NEXT,M1,M2,M3,M4,M5,M6,M7,M8,
156 . IX1,IY1,IZ1,IX2,IY2,IZ2,IBUG,IBUG2,I_LOC,
157 . BIX1(NBRIC),BIY1(NBRIC),BIZ1(NBRIC),
158 . BIX2(NBRIC),BIY2(NBRIC),BIZ2(NBRIC),
159 . first_add, prev_add, lchain_add, i_stok
160
161 INTEGER :: NC, I_STOK_BAK, IPA,IPB
162 my_real
163 . XMINB,YMINB,ZMINB,XMAXB,YMAXB,ZMAXB,
164 . DXB,DYB,DZB,
165 . aaa, daaa, dmax
166
167 LOGICAL, DIMENSION(NBRIC) :: TAGB
168! LOGICAL, DIMENSION(12*NBRIC) :: LEDGE
169 LOGICAL :: BOOL(NIRECT_L)
170 INTEGER NBCUT, DEJA, ISONSHELL, ISONSH3N
171 INTEGER :: COUNTER, NEDGE, NFACE, NODES8(8), COUNTER_BRICK(NBRIC)
172
173c INTEGER, DIMENSION(2,24) :: iEDGE !12 sans les diagonales, 24 avec les diagonales
174c INTEGER, DIMENSION(2,2,6) :: iFACE
175 INTEGER :: iN1, iN2, iN1a, iN2a, iN1b, iN2b , iN3, iN4
176 INTEGER :: POS, IAD, IB , NBF, NBL
177 INTEGER :: I_12bits, nbits, npqts, pqts(4), SUM, SECTION
178 INTEGER :: I_bits(12), MAX_ADD, IMIN_LOC, IMAX_LOC
179
180 my_real ::
181 . aeradiag,xx(8),yy(8),zz(8),diag(4)
182
183 CHARACTER*12 :: sectype
184 LOGICAL :: IsSecDouble, IsSTO
185
186 CHARACTER(LEN=1) filenum
187
188 INTEGER ::
189 . MIN_IX_LOC, MIN_IY_LOC, MIN_IZ_LOC, !indice voxel min utilise
190 . max_ix_loc, max_iy_loc, max_iz_loc !indice voxel max utilise
191
192 INTEGER, ALLOCATABLE, DIMENSION(:) :: order, VALUE
193
194 INTEGER R2,MIN2
195
196
197
198
199
200C-----------------------------------------------
201C=======================================================================
202C -1 INITIALIZATION
203C=======================================================================
204
205!-----------debug---------------
206 IF(ibug22_trivox==1 .AND. itask==0)THEN
207 print *, " i22trivox:entering routine"
208 print *, ""
209 print *, "------------------BRICKS DOMAIN--------------------"
210 print *, " BMINMAL_I22TRIVOX=", bminma(4:6),bminma(1:3)
211 print *, " NBX,NBY,NBZ=", nbx,nby,nbz
212 print *, "---------------------------------------------------"
213 print *, ""
214 print *, ""
215 print *, " |-----------i22trivox.F---------|"
216 print *, " | DOMAIN INFORMATION |"
217 print *, " |-------------------------------|"
218 print *, " MPI =",ispmd +1
219 print *, " NT =",itask+1
220 print *, " NCYCLE =", ncycle
221 print *, " ITASK =", itask
222 print *, " NIRECT_L =", nirect_l
223 print *, " local bricks :", nbric
224 print *, " tableau briques du domaine local :"
225 print *, ixs(11,bufbric(1:nbric))
226 print *, " local faces :",nshel_l
227 print *, " tableau facettes du domaine local :"
228 DO i=1, nirect_l-nshelr_l
229 print *, i,nint(irect_l(1:4, i))
230 END DO
231 print *, " +remotes:"
232 DO i=nirect_l-nshelr_l+1, nirect_l
233 print *, i,irect_l(1:4, i)
234 END DO
235 print *, " |-------------------------------|"
236 print *, ""
237 print *, " |-----i22trivox.F--------|"
238 print *, " | THREAD INFORMATION |"
239 print *, " |------------------------|"
240! print *, " THREAD/NTHREAD=",ITASK+1,NTHREAD
241 print *, " cple candidats max : ", mulnsn
242 print *, " ESHIFT=", eshift
243 print *, " |------------------------|"
244 print *, ""
245 end if
246 CALL my_barrier
247!-----------debug---------------
248
249C=======================================================================
250C 0 DATA PRE-TREATMENT
251C=======================================================================
252
253 max_add = mulnsn !12*NIRECT_L ! a optimiser eventuellmeent
254 aaa = zero
255
256 !---------------------------------------------------------!
257 ! Dynamic Allocations !
258 !---------------------------------------------------------!
259 !---------------------------------------------------------!
260 ! + Storing Min/Max for coordinates and voxel indexes !
261 !---------------------------------------------------------!
262 IF(itask == 0)THEN
263 !TS reallocate envisageable pour LCHAIN_*()
264 NULLIFY (lchain_last, lchain_next, lchain_elem)
265 ALLOCATE(lchain_elem(max_add))
266 ALLOCATE(lchain_next(max_add))
267 ALLOCATE(lchain_last(max_add))
268 min_ix = nbx+2
269 min_iy = nby+2
270 min_iz = nbz+2
271 max_ix = 0
272 max_iy = 0
273 max_iz = 0
274 current_add = 1 ! premiere adresse dans le tableau chaine commun
275 END IF
276 IF(itask==nthread-1)THEN
277 ALLOCATE(eix1(nirect_l),eiy1(nirect_l),eiz1(nirect_l))
278 ALLOCATE(eix2(nirect_l),eiy2(nirect_l),eiz2(nirect_l))
279 eix1=nbx+2 !a initialiser car si pas de candidat et ftrapuv alors min/max globaux erratics
280 eiy1=nbx+2 !mettre sur nthread -1
281 eiz1=nbx+2
282 eix2=0
283 eiy2=0
284 eiz2=0
285 END IF
286
287 CALL my_barrier ! All thread have to wait for common initialization.
288
289 !---------------------------------------------------------!
290 ! Domain bounds reading !
291 !---------------------------------------------------------!
292 !borne du domaine : intersection entre
293 ! domaine fluide local
294 ! domaine lag global
295 xminb = bminma(4)
296 yminb = bminma(5)
297 zminb = bminma(6)
298 xmaxb = bminma(1)
299 ymaxb = bminma(2)
300 zmaxb = bminma(3)
301 aaa = tzinf !MARGE TO EXTEND SEARCH. MUST BE LARGE ENOUGH TO INCLUDE ADJACENT UNCUT CELLS
302 !deja fait dans i22main_tri pour les domaines lagrangiens
303 xminb = xminb - aaa
304 yminb = yminb - aaa
305 zminb = zminb - aaa
306 xmaxb = xmaxb + aaa
307 ymaxb = ymaxb + aaa
308 zmaxb = zmaxb + aaa
309
310 dxb = xmaxb-xminb
311 dyb = ymaxb-yminb
312 dzb = zmaxb-zminb
313
314 !If AAA=0 then voxel domain can be degenerated. Example : 1shell in plane XY => DZB=0
315 daaa = ( (bminma(1)-bminma(4))+(bminma(2)-bminma(5))+
316 . (bminma(3)-bminma(6)) ) / three/hundred
317 dmax = max(max(dxb,dyb),dzb)
318
319 IF(dxb/dmax<em06)dxb=daaa
320 IF(dyb/dmax<em06)dyb=daaa
321 IF(dzb/dmax<em06)dzb=daaa
322
323 !On partitionne le balayage du tableau global des noeuds de coques (IRECT_L(1:NIRECT_L) sur les differents threads (multithreading)
324 nbf = 1+itask*nirect_l/nthread
325 nbl = (itask+1)*nirect_l/nthread
326
327c if(itask==0.and.ibug22_trivox==1)print *,
328c . " Remplissage Voxel avec shell suivantes :"
329
330 DO ne=nbf,nbl
331 IF(irect_l(23,ne)==zero)cycle
332 IF(((xmaxe(ne)< xminb).OR.(xmine(ne)>xmaxb)).OR.
333 . ((ymaxe(ne)< yminb).OR.(ymine(ne)>ymaxb)).OR.
334 . ((zmaxe(ne)< zminb).OR.(zmine(ne)>zmaxb)))THEN
335 irect_l(23,ne)=zero
336 !print *, "skip shell=", NE
337 cycle
338 END IF
339 !-------------------------------------------!
340 ! VOXEL OCCUPIED BY THE BRICK !
341 !-------------------------------------------!
342 !Voxel_lower_left_bound for this element---+
343 ix1=int(nbx*(irect_l(17,ne)-aaa-xminb)/dxb)
344 iy1=int(nby*(irect_l(18,ne)-aaa-yminb)/dyb)
345 iz1=int(nbz*(irect_l(19,ne)-aaa-zminb)/dzb)
346 eix1(ne)=max(1,2+min(nbx,ix1))
347 eiy1(ne)=max(1,2+min(nby,iy1))
348 eiz1(ne)=max(1,2+min(nbz,iz1))
349 !Voxel_upper_right_bound for this element---+
350 ix2=int(nbx*(irect_l(20,ne)+aaa-xminb)/dxb)
351 iy2=int(nby*(irect_l(21,ne)+aaa-yminb)/dyb)
352 iz2=int(nbz*(irect_l(22,ne)+aaa-zminb)/dzb)
353 eix2(ne)=max(1,2+min(nbx,ix2))
354 eiy2(ne)=max(1,2+min(nby,iy2))
355 eiz2(ne)=max(1,2+min(nbz,iz2))
356 END DO
357 !-------------------------------------------!
358 ! VOXEL INDEX RANGE FOR VOXEL RESETTING !
359 !-------------------------------------------!
360 !pour reset des voxel
361 min_ix_loc = min(min_ix,minval(eix1(nbf:nbl)))
362 min_iy_loc = min(min_iy,minval(eiy1(nbf:nbl)))
363 min_iz_loc = min(min_iz,minval(eiz1(nbf:nbl)))
364 max_ix_loc = max(max_ix,maxval(eix2(nbf:nbl)))
365 max_iy_loc = max(max_iy,maxval(eiy2(nbf:nbl)))
366 max_iz_loc = max(max_iz,maxval(eiz2(nbf:nbl)))
367 !----------------------------------------------!
368 ! GLOBAL MIN/MAX VOXEL INDEX RANGE FOR RESET !
369 !----------------------------------------------!
370#include "lockon.inc"
371 min_ix = min(min_ix_loc,min_ix)
372 min_iy = min (min_iy_loc,min_iy)
373 min_iz = min(min_iz_loc,min_iz)
374 max_ix = max(max_ix_loc,max_ix)
375 max_iy = max(max_iy_loc,max_iy)
376 max_iz = max(max_iz_loc,max_iz)
377#include "lockoff.inc"
378 CALL my_barrier ! waiting for EIX1, ...,EIZ2
379
380 !optim : si pas de candidat : les valeur par defauts des min max de sindices de voxels pour ce thread sont contraignante pour la reinitialisation.
381
382C=======================================================================
383C 1 VOXEL FILLING with faces data below
384C=======================================================================
385 !----------------------------------------------!
386 ! SHELL STORAGE FOR EACH VOXEL (CHAINED ARRAY) !
387 !----------------------------------------------!
388C
389C VOXEL(*,*,*) LCHAIN_LAST(FIRST)
390C +-----------+------------+
391C | FIRST | LAST |
392C +--+--------+--+---------+
393C | |
394C | |
395C | |
396C | | LCHAIN_ELEM(*) LCHAIN_NEXT(*)
397C | | +------------+-----------+
398C +-------------->| elemid | iadd 3 | 1:FIRST --+
399C | +------------+-----------+ |
400C | | | | 2 |
401C | +------------+-----------+ |
402C | | elemid | iadd 4 | 3 <-------+
403C | +------------+-----------+ |
404C | | elemid | iadd 6 | 4 <-------+
405C | +------------+-----------+ |
406C | | | | 5 |
407C | +------------+-----------+ |
408C +-->| elemid | 0 | 6:LAST <--+
409C +------------+-----------+
410C | | | 7
411C +------------+-----------+
412
413
414 !----------------------------------------------!
415 ! VOXEL FILLING !
416 !----------------------------------------------!
417 IF(itask==0)THEN
418 DO ne=1,nirect_l
419 IF(irect_l(23,ne)==zero)cycle !stiffness
420!--------------debug
421 if(itask==0.and.ibug22_trivox==1)then
422 print *, " traitement shell",nint(irect_l((/1,3/),ne)),
423 . "indices",eix1(ne),eix2(ne), eiy1(ne),eiy2(ne),eiz1(ne),eiz2(ne)
424 print *, " xmin/xmax=", irect_l((/17,20/),ne)
425 print *, " ymin/ymax=", irect_l((/18,21/),ne)
426 print *, " zmin/zmax=", irect_l((/19,22/),ne)
427 end if
428!--------------debug
429 DO iz = eiz1(ne),eiz2(ne)
430 DO iy = eiy1(ne),eiy2(ne)
431 DO ix = eix1(ne),eix2(ne)
432 first_add = voxel(ix,iy,iz)
433 IF(first_add == 0)THEN
434 !empty cell
435 voxel(ix,iy,iz) = current_add ! adresse dans le tableau chaine
436 lchain_last(current_add) = current_add ! dernier=courant
437 lchain_elem(current_add) = ne ! coque ID
438 lchain_next(current_add) = 0 ! pas de suivant car dernier de la liste !
439 ELSE
440 !boite contenant plusieurs elements, jump to the last node of the cell
441 prev_add = lchain_last(first_add)! devient l'avant-dernier
442 lchain_last(first_add) = current_add ! maj du dernier
443 lchain_elem(current_add) = ne ! coque ID
444 lchain_next(prev_add) = current_add ! maj du suivant 0 -> CURRENT_ADD
445 lchain_next(current_add) = 0 ! pas de suivant car dernier de la liste
446 ENDIF
447 current_add = current_add+1
448 IF( current_add>=max_add)THEN
449 !OPTIMISATION : suprresion du deallocate/GOTO debut.
450 !REALLOCATE SI PAS ASSEZ DE PLACE : inutile de recommencer de 1 a MAX_ADD-1, on poursuit de MAX_ADD a 2*MAX_ADD
451 max_add = 2 * max_add
452 if(ibug22_trivox==1)print *, "reallocate"
453 lchain_next => ireallocate(lchain_next, max_add)
454 lchain_elem => ireallocate(lchain_elem, max_add)
455 lchain_last => ireallocate(lchain_last, max_add)
456 ENDIF
457 ENDDO !IX
458 ENDDO !iy
459 ENDDO !IZ
460 END DO !I=1,NIRECT_L
461 END IF
462 CALL my_barrier
463
464!------post----debug
465 IF(itask==0.and.ibug22_trivox==1)
466 .print *, " i22trivox:voxel filled"
467!------post----debug
468
469C=======================================================================
470C 2 A partir des voxels occupes par une brique, on est en mesure
471C de connaitre toutes les coques dans son voisinage.
472C On creer alors les couples candidats.
473C=======================================================================
474 nc = 0
475 i_stok = 0
476 last_ne = 0
477 nbf = 1+itask*nbric/nthread
478 nbl = (itask+1)*nbric/nthread
479
480 DO i=nbf,nbl !1,NBRIC
481
482c if(ibug22_trivox==1)print *,
483c . " i22trivox : BOUCLE BRIQUE, I=",IXS(11,BUFBRIC(I))
484 !-------------------------------------------!
485 ! VOXEL OCCUPIED BY THE BRICK !
486 !-------------------------------------------!
487 !Voxel_lower_left_bound for this element---+
488 ix1=int(nbx*(xmins(i)-xminb)/dxb)
489 iy1=int(nby*(ymins(i)-yminb)/dyb)
490 iz1=int(nbz*(zmins(i)-zminb)/dzb)
491 bix1(i)=max(1,2+min(nbx,ix1))
492 biy1(i)=max(1,2+min(nby,iy1))
493 biz1(i)=max(1,2+min(nbz,iz1))
494 !Voxel_upper_right_bound for this element---+
495 ix2=int(nbx*(xmaxs(i)-xminb)/dxb)
496 iy2=int(nby*(ymaxs(i)-yminb)/dyb)
497 iz2=int(nbz*(zmaxs(i)-zminb)/dzb)
498 bix2(i)=max(1,2+min(nbx,ix2))
499 biy2(i)=max(1,2+min(nby,iy2))
500 biz2(i)=max(1,2+min(nbz,iz2))
501
502
503 !-------------------------------------------!
504 ! NEIGHBORS SEARCH !
505 !-------------------------------------------!
506 ! une brique peut occuper plusieurs voxel, en regardant dans les voxel
507 ! occupees on peut donc trouver plusieurs fois la meme facette. On evite les repetition
508 !avec un TAG BOOL(I).
509 DO iz = biz1(i),biz2(i)
510 DO iy = biy1(i),biy2(i)
511 DO ix = bix1(i),bix2(i)
512 lchain_add = voxel(ix,iy,iz)
513 DO WHILE(lchain_add /= 0) ! BOUCLE SUR LES COQUES DU VOXEL COURANT
514 ne = lchain_elem(lchain_add) ! ID COQUE DU VOXEL COURANT
515 bool(ne)=.false.
516 lchain_add = lchain_next(lchain_add)
517 ENDDO ! WHILE(LCHAIN_ADD /= 0) ! BOOL(I)=true indique que l'id coque a deja ete traite pour la brique courante
518 ENDDO !nbz
519 ENDDO !nby
520 ENDDO !nbx
521
522 issto = .false. ! Si I22sto est appelle alors on bascule sur true. C'est le signal pour executer le lockoff et autoriser le traitement d'une autre brique sur les autres threads
523
524 DO iz = biz1(i),biz2(i)
525 DO iy = biy1(i),biy2(i)
526 DO ix = bix1(i),bix2(i)
527 lchain_add = voxel(ix,iy,iz) ! ADRESSE DE L'ID DE LA PREMIERE BRICK DANS LE VOXEL
528 DO WHILE(lchain_add /= 0) ! BOUCLE SUR LES BRICKS DU VOXEL COURANT
529 ne = lchain_elem(lchain_add) ! ID BRICK DU VOXEL COURANT
530 ! CRITERE DE NON INTERSECTION
531 ! Les deux volumes englobants cartesiens sont disjoints.
532 IF(bool(ne))THEN
533 lchain_add = lchain_next(lchain_add)
534 cycle
535 END IF
536 j = ne
537 ns = bufbric(i)
538 xx(1:8) = x(1,ixs(2:9,ns))
539 yy(1:8) = x(2,ixs(2:9,ns))
540 zz(1:8) = x(3,ixs(2:9,ns))
541 diag(1) = sqrt((xx(1)-xx(7))**2 + (yy(1)-yy(7))**2 + (zz(1)-zz(7))**2)
542 diag(2) = sqrt((xx(3)-xx(5))**2 + (yy(3)-yy(5))**2 + (zz(3)-zz(5))**2)
543 diag(3) = sqrt((xx(2)-xx(8))**2 + (yy(2)-yy(8))**2 + (zz(2)-zz(8))**2)
544 diag(4) = sqrt((xx(4)-xx(6))**2 + (yy(4)-yy(6))**2 + (zz(4)-zz(6))**2)
545 aaa = 1.2d00*maxval(diag(1:4),1)
546
547 ! ON IGNORE L'ELEMENT SI L'INTERSECTION AVEC LA BRIQUE EST NULLE : MARGE ASSURE DE PRENDRE LES BRIQUES VOISINES POUR EXTENSION DU BUFFER CUT CELL
548 IF( (irect_l(17,ne)-aaa>xmaxs(i)).OR. !XMINE-AAA > XMAXS
549 . (irect_l(20,ne)+aaa<xmins(i)).OR. !XMAXE+AAA < XMINS
550 . (irect_l(18,ne)-aaa>ymaxs(i)).OR. !YMINE-AAA > YMAXS !Optimization : +/-AAA deja calculee, stoquer et reprendre (gain 6 operations par iteration)
551 . (irect_l(21,ne)+aaa<ymins(i)).OR. !YMAXE+AAA < YMINS
552 . (irect_l(19,ne)-aaa>zmaxs(i)).OR. !ZMINE-AAA > ZMAXS
553 . (irect_l(22,ne)+aaa<zmins(i)) ) THEN !ZMAXE+AAA < ZMINS
554 lchain_add = lchain_next(lchain_add)
555 cycle
556 END IF
557 bool(ne) =.true. ! a partir d'ici on considere que la coque a deja ete traitee avec la brique courante. Si on la retrouve dans un autre voxel on ne considerera pas le couple une deuxi me fois.
558 i_stok = i_stok + 1
559 prov_b(i_stok) = i !brique
560 prov_e(i_stok) = ne !facette
561 lchain_add = lchain_next(lchain_add)
562 tagb(i) = .true.
563 !SI SANS MARGE, INTERSECTION NULLE, ALORS SKIP
564 IF( (irect_l(17,ne) >xmaxs(i)).OR.
565 . (irect_l(20,ne) <xmins(i)).OR.
566 . (irect_l(18,ne) >ymaxs(i)).OR.
567 . (irect_l(21,ne) <ymins(i)).OR.
568 . (irect_l(19,ne) >zmaxs(i)).OR.
569 . (irect_l(22,ne) <zmins(i)) ) prov_e(i_stok) = -prov_e(i_stok) !intersection nulle
570 !-------------------------------------------!
571 ! COUPLE STORAGE (siz=mvsiz) !
572 !-------------------------------------------!
573 IF(i_stok>=nvsiz)THEN
574c if(ibug22_trivox==1)print *,
575c . " i22trivox.F:purge des candidats prov",
576c . II_STOK+I_STOK, "CORE=",ITASK+1, "BRIQUE=",
577c . IXS(11,BUFBRIC(I))
578 CALL i22sto(
579 1 i_stok ,irect ,x , ii_stok, cand_b,
580 2 cand_e ,mulnsn ,noint , marge , i_mem ,
581 3 prov_b ,prov_e ,eshift , itask , nc ,
582 4 ixs ,bufbric ,nbric , issto )
583 i_stok = 0
584 IF(i_mem==2) THEN
585 if(ibug22_trivox==1)then
586 print *, " i22trivox.F:too much candidates on thread=",
587 . itask+1
588 print *, " i22trivox.F:II_STOK=", ii_stok,mulnsn
589 end if
590 GOTO 1000
591 END if!(I_MEM==2)
592 endif!(I_STOK>=NVSIZ)
593 !-------------------------------------------!
594 ENDDO ! WHILE(LCHAIN_ADD /= 0)
595 ENDDO !nbz
596 ENDDO !nby
597 ENDDO !nbz
598 !-------------------------------------------!
599 ! COUPLE STORAGE (siz<mvsiz) !
600 !-------------------------------------------!
601 IF(i_stok/=0)THEN
602c if(ibug22_trivox==1)print *, " i22trivox.F:purge<MVSIZ",
603c . II_STOK+I_STOK, "CORE=",ITASK+1, "BRIQUE=",I
604 CALL i22sto(
605 1 i_stok ,irect ,x , ii_stok ,cand_b,
606 2 cand_e ,mulnsn ,noint , marge ,i_mem ,
607 3 prov_b ,prov_e ,eshift , itask ,nc ,
608 4 ixs ,bufbric ,nbric , issto )
609 i_stok = 0
610 IF(i_mem==2) THEN
611c if(ibug22_trivox==1)then
612c print *, " i22trivox.F:too much candidates on thread=",
613c . ITASK+1
614c print *, " i22trivox.F:II_STOK=", II_STOK,MULNSN
615c end if
616 GOTO 1000
617 END if!(I_MEM==2)
618 END IF
619 !-------------------------------------------!
620 ! UNLOCK NEEDED IF CURRENT BRICK WAS USED !
621 ! FOR STORAGE COUPLE !
622 !-------------------------------------------!
623 IF(issto)THEN
624c if(ibug22_trivox==1)print *, " i22trivox.F:lockoff", ITASK,
625c . "bric:", I, "IsSTO=", IsSTO
626#include "lockoff.inc"
627 !Cela permet davoir une connexite dans le tableau (/CAND_B(I),CAND_E(I)/) des couples pour une brique donnee. (pour le multi-threading des calcules dintersection ulterieur)
628 END IF
629 !-------------------------------------------!
630 END DO !next I (1,NBRIC)
631
632C-------------------------------------------------------------------------
633C FIN DE LA RECHERCHE
634C-------------------------------------------------------------------------
635
636
637C=======================================================================
638C 3 VOXEL RESET
639C=======================================================================
640 1000 CONTINUE
641
642 CALL my_barrier ! All threads need to finish its work with common Voxel before resetting it.
643
644 if(itask==0.AND.ibug22_trivox==1) print *,
645 . " i22trivox.F:nb de candidats:" , ii_stok, itask
646
647 IF(itask==0)THEN
648 !RESET VOXEL WITHIN USED RANGE ONLY
649 DO k= min_iz , max_iz
650 DO j= min_iy,max_iy
651 DO i= min_ix,max_ix
652 voxel(i,j,k) = 0
653 END DO
654 END DO
655 END DO
656 ENDIF
657
658
659
660 !-------------------------------------------!
661 ! DEALLOCATE !
662 !-------------------------------------------!
663 IF(itask == 0)THEN
664 DEALLOCATE(lchain_last, lchain_next, lchain_elem )
665 DEALLOCATE(eix1, eiy1, eiz1, eix2, eiy2, eiz2)
666 NULLIFY (lchain_last, lchain_next, lchain_elem)
667 ENDIF
668
669!------post----debug
670 if(ibug22_trivox==1)CALL my_barrier !(tous les threads doivent reinit avant de tester)
671 if(itask==0.AND.ibug22_trivox==1)then
672 DO ix=1,(nbx+2)
673 DO iy=1,(nby+2)
674 DO iz=1,(nbz+2)
675 if (voxel(ix,iy,iz)/=0) then
676 print *, " i22trivox.F:error raz voxel",voxel(ix,iy,iz)
677 print *, " i22trivox.F:ix,iy,iz=", ix,iy,iz
678 stop
679 end if
680 END DO
681 END DO
682 END DO
683 print *, " i22trivox.F:raz voxel ok."
684 end if
685 if(i_mem==2)then
686 if(itask==0.AND.ibug22_trivox==1)
687 . print *,
688 . " i22trivox.F:returning i22buce (too much candidate)"
689 GOTO 2000
690 end if
691 if(itask==0.AND.ibug22_trivox==1)
692 . print *, " i22trivox.F:fin recherche des candidats, nb=",
693 . ii_stok
694
695 if(itask==0.AND.ibug22_trivox==1)then
696 allocate(order(ii_stok) ,value(ii_stok))
697 min2 = minval(abs(cand_e(1:ii_stok)))
698 r2 = maxval(abs(cand_e(1:ii_stok))) - min2
699 DO i=1,ii_stok
700 value(i) = cand_b(i)*(r2+1)+abs(cand_e(i))-min2
701 ENDDO
702 order=0
703 !CALL QUICKSORT_I2 !(ORDER,II_STOK,VALUE)
704 !two column sorting (CAND_B,CAND_E) matrix by giving a vaue to each couple
705
706
707 print *, " II_STOK=", ii_stok
708 print *, " IXS(11,BUFBRIC(CAND_B)) ) =", ixs(11, bufbric(cand_b(order(1:ii_stok))))
709 print *, " BUFBRIC(CAND_B) =", bufbric(cand_b(order(1:ii_stok)))
710 print *, " CAND_B =", cand_b(order(1:ii_stok))
711 print *, " CAND_E =", cand_e(order(1:ii_stok))
712
713 deallocate(order,VALUE)
714 endif
715
716
717
718
719
720!------post----debug
721 2000 CONTINUE
722 CALL my_barrier ! waiting vor voxel reset (and common deallocations)
723
724 RETURN
725 END SUBROUTINE
726
727
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:35
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:49
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
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