OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11trivox.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!|| i11trivox ../engine/source/interfaces/intsort/i11trivox.F
25!||--- called by ------------------------------------------------------
26!|| i11buce_vox ../engine/source/interfaces/intsort/i11buce.F
27!||--- calls -----------------------------------------------------
28!|| i11sto_vox ../engine/source/interfaces/intsort/i11sto.F
29!|| ireallocate ../engine/share/modules/realloc_mod.F
30!|| my_barrier ../engine/source/system/machine.F
31!||--- uses -----------------------------------------------------
32!|| realloc_mod ../engine/share/modules/realloc_mod.F
33!|| tri11 ../engine/share/modules/tri11_mod.F
34!|| tri7box ../engine/share/modules/tri7box.F
35!||====================================================================
36 SUBROUTINE i11trivox(
37 1 IRECTS, IRECTM , X , NRTM ,NRTSR ,
38 2 XYZM , II_STOK, CAND_S , CAND_M ,NSN4 ,
39 3 NOINT , TZINF , I_MEM , ESHIFT ,ADDCM ,
40 5 CHAINE, NRTS , ITAB , STFS ,STFM ,
41 6 IAUTO , VOXEL , NBX , NBY ,NBZ ,
42 7 ITASK , IFPEN , IFORM , GAPMIN ,DRAD ,
43 8 MARGE ,GAP_S , GAP_M , GAP_S_L ,GAP_M_L,
44 9 BGAPSMX, IGAP ,GAP ,FLAGREMNODE,KREMNODE,
45 1 REMNODE,DGAPLOAD)
46C============================================================================
47C M o d u l e s
48C-----------------------------------------------
49 USE realloc_mod
50 USE tri7box
51 USE tri11
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56#include "comlock.inc"
57C-----------------------------------------------
58C G l o b a l P a r a m e t e r s
59C-----------------------------------------------
60#include "mvsiz_p.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "param_c.inc"
65C-----------------------------------------------
66C M e s s a g e P a s s i n g
67C-----------------------------------------------
68#ifdef MPI
69#endif
70!-----------------------------------------------
71! SUBROUTINE AIM
72! ==============
73! VOXEL SEARCH to find couple (edge,edge) with penetration among all possible couples defined by second and main side.
74! Temporary found candidate are written in Temporary array PROV_S and PROV_M in order to optimise OpenMP performances.
75! There is no order.
76! PROV_S(i),PROV_M(i) : is a potential candidate couple because edges are geometrically near each other.
77! I11STO subroutine will compute if penetration is positive and if couple was not already stoked, in this case, candidate is stoked in CAND(S(i), CAND_M(i)
78!
79C-----------------------------------------------
80C D u m m y A r g u m e n t s
81C
82C NOM DESCRIPTION E/S
83C
84C ADD(2,*) ARRAY OF ADRESSES E/S
85C 1.........ADRESSES NODES C 2.........ADRESSES ELEMENTS
86C ZYZM(6,*) ARRAY OF XYZMIN E/S
87C 1.........XMIN BOITE
88C 2.........YMIN BOITE
89C 3.........ZMIN BOITE
90C 4.........XMAX BOITE
91C 5.........YMAX BOITE
92C 6.........ZMAX BOITE
93C IRECTM(2,*) ARRAY OF CONEC E
94C 1.........NODE 1 main EDGE
95C 2.........NODE 2 main EDGE
96C IRECTS(2,*) ARRAY OF CONEC E
97C 1.........NODE 1 SECOND EDGE
98C 2.........NODE 2 SECOND EDGE
99C X(3,*) COORDONNEES NODALES E
100C II_STOK contact pairs storage level
101C CANDIDATES impact E/S
102C CAND_S boites resultats nodes C CAND_M adresses des boites resultat elements
103C NOINT INTERFACE USER NUMBER
104C TZINF TAILLE ZONE INFLUENCE
105C VOXEL(*,*,*) VOXEL PARTIONNEMENT DE l'ESPACE (NBX+2,NBY+2,NBZ+2)
106C stores secondary edges in each voxel
107C In practice designe the first stop on a chain list
108C MAX_ADD maximum address for chain arrays
109C NSN4 4*NSN maximum size now allowed for the
110C COUPLES NODES,ELT CANDIDATES
111C-----------------------------------------------
112C D u m m y A r g u m e n t s
113C-----------------------------------------------
114 INTEGER ::
115 . NRTM,NRTSR,ESHIFT,NRTS,IGAP,
116 . NSN4,NOINT,ITAB(*),NBX,NBY,NBZ,IAUTO,
117 . IRECTS(2,NRTS),IRECTM(2,NRTM)
118 INTEGER ITASK,IFORM
119 INTEGER, INTENT(INOUT) ::
120 . CAND_S(*),CAND_M(*),ADDCM(*),CHAINE(2,*),
121 . VOXEL(1:NBX+2,1:NBY+2,1:NBZ+2), I_MEM,IFPEN(*),II_STOK,
122 . FLAGREMNODE,KREMNODE(*),REMNODE(*)
123 my_real
124 . ,INTENT(IN) ::
125 . x(3,*),xyzm(6,*),
126 . stfs(nrts),stfm(nrtm), tzinf, gap
127 my_real , INTENT(IN) :: dgapload,drad
128 my_real
129 . gapmin,marge,bgapsmx,
130 . gap_s(*),gap_m(*), gap_s_l(*), gap_m_l(*)
131C-----------------------------------------------
132C L o c a l V a r i a b l e s
133C-----------------------------------------------
134 INTEGER
135 . I,J,SS1,SS2,
136 . n1,n2,mm1,mm2, k,l,
137 . prov_s(2*mvsiz),prov_m(2*mvsiz), !Provisional table of candidates sent to i11stok
138 . ix1,iy1,iz1,ix2,iy2,iz2,
139 . ix,iy,iz, first_add,
140 . i_stok, i_stok_bak, iedg,
141 . prev_add, chain_add, current_add, !for scanning chain arrays
142 . nedg, deja , max_add , m,remove_remote
143 INTEGER, DIMENSION(3) :: TMIN,TMAX
144 my_real
145 . XX1, XX2,
146 . XMIN, XMAX,YMIN, YMAX,ZMIN, ZMAX,
147 . YY1,YY2,ZZ1,ZZ2,
148 . AAA,
149 . XMAX_EDGS(NRTS+NRTSR), XMIN_EDGS(NRTS+NRTSR), !min/max coordinates of secondary and main edges
150 . YMAX_EDGS(NRTS+NRTSR), YMIN_EDGS(NRTS+NRTSR),
151 . ZMAX_EDGS(NRTS+NRTSR), ZMIN_EDGS(NRTS+NRTSR),
152 . xmax_edgm(nrtm), xmin_edgm(nrtm),
153 . ymax_edgm(nrtm), ymin_edgm(nrtm),
154 . zmax_edgm(nrtm), zmin_edgm(nrtm),
155 . xminb,yminb,zminb,xmaxb,ymaxb,zmaxb
156C-----------------------------------------------
157 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGREMLINE
158C-----------------------------------------------
159C
160 IF(FLAGREMNODE==2) then
161 ALLOCATE(tagremline(nrts))
162 tagremline(1:nrts) = 0
163 ENDIF
164C
165 aaa = zero
166 !ATTENTION A POPTIONMISER FOR NE PAS TO PERFORM ONE RAZ COMPLETE SI NRTS ==0
167 min_ix=nbx+2
168 min_iy=nby+2
169 min_iz=nbz+2
170 max_ix=1
171 max_iy=1
172 max_iz=1
173
174 !---------------------------------------------------------!
175 ! allocation of chain arrays
176 !---------------------------------------------------------!
177 IF(itask == 0)THEN
178 max_add = max(1,4*(nrts+nrtsr))
179 ALLOCATE(lchain_elem(1:max_add))
180 ALLOCATE(lchain_next(1:max_add))
181 ALLOCATE(lchain_last(1:max_add))
182 END IF
183
184 CALL my_barrier !all threads wait for allocation
185
186 IF(nrtm==0.OR.nrts==0)THEN
187 !Do not reinitize all the Voxel if there is no candidate
188 min_ix=1
189 min_iy=1
190 min_iz=1
191 END IF
192
193 !---------------------------------------------------------!
194 ! retrieval of domain boundaries
195 !---------------------------------------------------------!
196 xmin = xyzm(1,1)
197 ymin = xyzm(2,1)
198 zmin = xyzm(3,1)
199 xmax = xyzm(4,1)
200 ymax = xyzm(5,1)
201 zmax = xyzm(6,1)
202c Dev Future: xminb larger than Xmin ...
203 xminb = xmin
204 yminb = ymin
205 zminb = zmin
206 xmaxb = xmax
207 ymaxb = ymax
208 zmaxb = zmax
209C=======================================================================
210C 1 for each edge, mark occupied voxels
211C the number of edges in a voxel being variable, we
212C use a chain array
213C these voxels represent the edge neighborhood
214C We then look for all the entities interfaces
215C in this neighborhood
216C=======================================================================
217 IF(itask == 0)THEN
218
219 current_add=1 ! first address
220
221 DO i = 1,nrts !si besoin on peut inverser Main/Secnd
222
223 IF(stfs(i)==zero)cycle !We do not retain the Destruit facets
224
225 !-------------------------------------------!
226 ! Nodes ID for edge (N1,N2) !
227 !-------------------------------------------!
228 n1=irects(1,i)
229 n2=irects(2,i)
230 !-------------------------------------------!
231 ! Coordinates of the two nodes !
232 ! +optimization // search for nodes
233 !within xmin xmax of processor elements
234 !-------------------------------------------!
235 xx1=x(1,n1)
236 xx2=x(1,n2)
237 xmax_edgs(i)=max(xx1,xx2); IF(xmax_edgs(i) < xmin) cycle
238 xmin_edgs(i)=min(xx1,xx2); IF(xmin_edgs(i) > xmax) cycle
239 yy1=x(2,n1)
240 yy2=x(2,n2)
241 ymax_edgs(i)=max(yy1,yy2); IF(ymax_edgs(i) < ymin) cycle
242 ymin_edgs(i)=min(yy1,yy2); IF(ymin_edgs(i) > ymax) cycle
243 zz1=x(3,n1)
244 zz2=x(3,n2)
245 zmax_edgs(i)=max(zz1,zz2); IF(zmax_edgs(i) < zmin) cycle
246 zmin_edgs(i)=min(zz1,zz2); IF(zmin_edgs(i) > zmax) cycle
247
248 !-------------------------------------------!
249 ! VOXEL OCCUPIED BY THE EDGE !
250 !-------------------------------------------!
251 !Voxel_lower_left_bound for this edge
252 ix1=int(nbx*(xmin_edgs(i)-xminb)/(xmaxb-xminb))
253 iy1=int(nby*(ymin_edgs(i)-yminb)/(ymaxb-yminb))
254 iz1=int(nbz*(zmin_edgs(i)-zminb)/(zmaxb-zminb))
255 ix1=max(1,2+min(nbx,ix1))
256 iy1=max(1,2+min(nby,iy1))
257 iz1=max(1,2+min(nbz,iz1))
258 !Voxel_upper_right_bound for this edge
259 ix2=int(nbx*(xmax_edgs(i)-xminb)/(xmaxb-xminb))
260 iy2=int(nby*(ymax_edgs(i)-yminb)/(ymaxb-yminb))
261 iz2=int(nbz*(zmax_edgs(i)-zminb)/(zmaxb-zminb))
262 ix2=max(1,2+min(nbx,ix2))
263 iy2=max(1,2+min(nby,iy2))
264 iz2=max(1,2+min(nbz,iz2))
265
266 !for voxel reset
267 min_ix = min(min_ix,ix1)
268 min_iy = min(min_iy,iy1)
269 min_iz = min(min_iz,iz1)
270 max_ix = max(max_ix,ix2)
271 max_iy = max(max_iy,iy2)
272 max_iz = max(max_iz,iz2)
273
274 !----------------------------------------------!
275 ! EDGE STORAGE FOR EACH VOXEL (CHAINED ARRAY) !
276 !----------------------------------------------!
277C
278C VOXEL(i,j,k) LCHAIN_LAST(FIRST)
279C +-----------+------------+
280C | =>FIRST | =>LAST |
281C +--+--------+--+---------+
282C | |
283C | |
284C | |
285C | | LCHAIN_ELEM(*) LCHAIN_NEXT(*)
286C | | +------------+-----------+
287C +-------------->| edge_id | iadd 3 | 1:FIRST --+
288C | +------------+-----------+ |
289C | | | | 2 |
290C | +------------+-----------+ |
291C | | edge_id | iadd 4 | 3 <-------+
292C | +------------+-----------+ |
293C | | edge_id | iadd 6 | 4 <-------+
294C | +------------+-----------+ |
295C | | | | 5 |
296C | +------------+-----------+ |
297C +-->| edge_id | 0 | 6:LAST <--+
298C +------------+-----------+
299C | | | MAX_ADD
300C +------------+-----------+
301C
302 !for all voxels occupied by the brick
303 DO iz = iz1,iz2
304 DO iy = iy1,iy2
305 DO ix = ix1,ix2
306
307 first_add = voxel(ix,iy,iz)
308
309 IF(first_add == 0)THEN
310 !voxel encore vide
311 voxel(ix,iy,iz) = current_add ! address in chain array of first edge found occupying the voxel
312 lchain_last(current_add) = current_add ! Last = Address for Current Edge
313 lchain_elem(current_add) = i ! edge ID
314 lchain_next(current_add) = 0 ! no next because last in the list
315 ELSE
316 !voxel contenant deja une edge
317 prev_add = lchain_last(first_add) ! becomes the penultimate
318 lchain_last(first_add) = current_add ! update of the last
319 lchain_elem(current_add) = i ! edge ID
320 lchain_next(prev_add) = current_add ! maj du suivant 0 -> CURRENT_ADD
321 lchain_next(current_add) = 0 ! no next because last in the list
322 ENDIF
323
324 current_add = current_add+1
325
326 IF( current_add>=max_add)THEN
327 !Optimization: DEALLOCATE/GOTO DEBUT SUPRRESION.
328 !REALLOCATE SI PAS ASSEZ DE PLACE : inutile de recommencer de 1 a MAX_ADD-1, on poursuit de MAX_ADD a 2*MAX_ADD
329 max_add = 2 * max_add
330 !print *, "reallocate"
331 lchain_next => ireallocate(lchain_next, max_add)
332 lchain_elem => ireallocate(lchain_elem, max_add)
333 lchain_last => ireallocate(lchain_last, max_add)
334 ENDIF
335
336 ENDDO !IX
337 ENDDO !IY
338 ENDDO !IZ
339
340 ENDDO !DO I=1,NRTS
341
342C=======================================================================
343C 2 process remote edges. retrieve the 2 nodes of
344C remote edges that are in the same voxels
345C
346C a to perform C
347C=======================================================================
348 DO i = nrts+1,nrts+nrtsr !si besoin on peut inverser Main/Secnd
349c If (Stfs (i) == Zero) Cycle! We do not retain the destroyed facets, already done in SPMD_Mach :: SPMD_TRI11VOX
350 j=i-nrts
351 !-------------------------------------------!
352 ! Coordinates of the two nodes !
353 ! +optimization // search for nodes
354 !within xmin xmax of processor elements
355 !-------------------------------------------!
356 xx1=xrem(1,j)
357 xx2=xrem(8,j)
358 xmax_edgs(i)=max(xx1,xx2) ; IF(xmax_edgs(i) < xmin) cycle
359 xmin_edgs(i)=min(xx1,xx2) ; IF(xmin_edgs(i) > xmax) cycle
360 yy1=xrem(2,j)
361 yy2=xrem(9,j)
362 ymax_edgs(i)=max(yy1,yy2) ; IF(ymax_edgs(i) < ymin) cycle
363 ymin_edgs(i)=min(yy1,yy2) ; IF(ymin_edgs(i) > ymax) cycle
364 zz1=xrem(3,j)
365 zz2=xrem(10,j)
366 zmax_edgs(i)=max(zz1,zz2) ; IF(zmax_edgs(i) < zmin) cycle
367 zmin_edgs(i)=min(zz1,zz2) ; IF(zmin_edgs(i) > zmax) cycle
368
369 !-------------------------------------------!
370 ! VOXEL OCCUPIED BY THE EDGE !
371 !-------------------------------------------!
372 !Voxel_lower_left_bound for this edge
373 ix1=int(nbx*(xmin_edgs(i)-xminb)/(xmaxb-xminb))
374 iy1=int(nby*(ymin_edgs(i)-yminb)/(ymaxb-yminb))
375 iz1=int(nbz*(zmin_edgs(i)-zminb)/(zmaxb-zminb))
376 ix1=max(1,2+min(nbx,ix1))
377 iy1=max(1,2+min(nby,iy1))
378 iz1=max(1,2+min(nbz,iz1))
379 !Voxel_upper_right_bound for this edge
380 ix2=int(nbx*(xmax_edgs(i)-xminb)/(xmaxb-xminb))
381 iy2=int(nby*(ymax_edgs(i)-yminb)/(ymaxb-yminb))
382 iz2=int(nbz*(zmax_edgs(i)-zminb)/(zmaxb-zminb))
383 ix2=max(1,2+min(nbx,ix2))
384 iy2=max(1,2+min(nby,iy2))
385 iz2=max(1,2+min(nbz,iz2))
386
387 !for voxel reset
388 min_ix = min(min_ix,ix1)
389 min_iy = min(min_iy,iy1)
390 min_iz = min(min_iz,iz1)
391 max_ix = max(max_ix,ix2)
392 max_iy = max(max_iy,iy2)
393 max_iz = max(max_iz,iz2)
394
395 !----------------------------------------------!
396 ! EDGE STORAGE FOR EACH VOXEL (CHAINED ARRAY) !
397 !----------------------------------------------!
398C
399C VOXEL(i,j,k) LCHAIN_LAST(FIRST)
400C +-----------+------------+
401C | =>FIRST | =>LAST |
402C +--+--------+--+---------+
403C | |
404C | |
405C | |
406C | | LCHAIN_ELEM(*) LCHAIN_NEXT(*)
407C | | +------------+-----------+
408C +-------------->| edge_id | iadd 3 | 1:FIRST --+
409C | +------------+-----------+ |
410C | | | | 2 |
411C | +------------+-----------+ |
412C | | edge_id | iadd 4 | 3 <-------+
413C | +------------+-----------+ |
414C | | edge_id | iadd 6 | 4 <-------+
415C | +------------+-----------+ |
416C | | | | 5 |
417C | +------------+-----------+ |
418C +-->| edge_id | 0 | 6:LAST <--+
419C +------------+-----------+
420C | | | MAX_ADD
421C +------------+-----------+
422C
423 !for all voxels occupied by the brick
424 DO iz = iz1,iz2
425 DO iy = iy1,iy2
426 DO ix = ix1,ix2
427 first_add = voxel(ix,iy,iz)
428 IF(first_add == 0)THEN
429 !voxel encore vide
430 voxel(ix,iy,iz) = current_add ! address in chain array of first edge found occupying the voxel
431 lchain_last(current_add) = current_add ! Last = Address for Current Edge
432 lchain_elem(current_add) = i ! edge ID
433 lchain_next(current_add) = 0 ! no next because last in the list
434 ELSE
435 !voxel contenant deja une edge
436 prev_add = lchain_last(first_add) ! becomes the penultimate
437 lchain_last(first_add) = current_add ! update of the last
438 lchain_elem(current_add) = i ! edge ID
439 lchain_next(prev_add) = current_add ! maj du suivant 0 -> CURRENT_ADD
440 lchain_next(current_add) = 0 ! no next because last in the list
441 ENDIF
442 current_add = current_add+1
443 IF( current_add>=max_add)THEN
444 !Optimization: DEALLOCATE/GOTO DEBUT SUPRRESION.
445 !REALLOCATE SI PAS ASSEZ DE PLACE : inutile de recommencer de 1 a MAX_ADD-1, on poursuit de MAX_ADD a 2*MAX_ADD
446 max_add = 2 * max_add
447 !print *, "reallocate remote"
448 lchain_next => ireallocate(lchain_next, max_add)
449 lchain_elem => ireallocate(lchain_elem, max_add)
450 lchain_last => ireallocate(lchain_last, max_add)
451 ENDIF
452 ENDDO !IX
453 ENDDO !IY
454 ENDDO !IZ
455
456 ENDDO !DO NRTS+1,NRTS+NRTSR
457
458
459 END IF !(ITASK==0)
460
461 CALL my_barrier !The Voxel table must be filled before continuing
462 !max_add must be the same for everyone
463C=======================================================================
464C 3 from voxels occupied by a main edge, we are able
465C to know all secondary edges in this neighborhood
466C which allows creating candidate pairs for contact
467C if penetration is positive
468C=======================================================================
469 nedg = 0
470 i_stok = 0
471 marge = tzinf - max(gap+dgapload,drad)
472
473 DO iedg=1,nrtm
474
475 IF(stfm(iedg) == zero)cycle ! We do not retain the Destruit facets
476
477c AAA = ZERO !MARGE
478 aaa = tzinf
479 IF(igap == 0)THEN
480 aaa = tzinf
481 ELSE
482 aaa = marge+
483 . max(max(gapmin,bgapsmx+gap_m(iedg))+dgapload,drad)
484 ENDIF
485
486
487 !-------------------------------------------!
488 ! (N1,N2) is the current main edge !
489 !-------------------------------------------!
490 n1 = irectm(1,iedg)
491 n2 = irectm(2,iedg)
492 mm1 = itab(n1)
493 mm2 = itab(n2)
494
495 !-------------------------------------------!
496 ! X-coordinates of the four nodes !
497 !-------------------------------------------!
498 xx1=x(1,n1)
499 xx2=x(1,n2)
500 yy1=x(2,n1)
501 yy2=x(2,n2)
502 zz1=x(3,n1)
503 zz2=x(3,n2)
504
505 xmax_edgm(iedg)=max(xx1,xx2) ! +TZINF
506 xmin_edgm(iedg)=min(xx1,xx2) ! -TZINF
507 ymax_edgm(iedg)=max(yy1,yy2) ! +TZINF
508 ymin_edgm(iedg)=min(yy1,yy2) ! -TZINF
509 zmax_edgm(iedg)=max(zz1,zz2) ! +TZINF
510 zmin_edgm(iedg)=min(zz1,zz2) ! -TZINF
511
512 !-------------------------------------------!
513 ! VOXEL OCCUPIED BY THE BRICK !
514 !-------------------------------------------!
515 !Voxel_lower_left_bound for this element---+
516 ix1=int(nbx*(xmin_edgm(iedg)-aaa-xminb)/(xmaxb-xminb))
517 iy1=int(nby*(ymin_edgm(iedg)-aaa-yminb)/(ymaxb-yminb))
518 iz1=int(nbz*(zmin_edgm(iedg)-aaa-zminb)/(zmaxb-zminb))
519 ix1=max(1,2+min(nbx,ix1))
520 iy1=max(1,2+min(nby,iy1))
521 iz1=max(1,2+min(nbz,iz1))
522 !Voxel_upper_right_bound for this element---+
523 ix2=int(nbx*(xmax_edgm(iedg)+aaa-xminb)/(xmaxb-xminb))
524 iy2=int(nby*(ymax_edgm(iedg)+aaa-yminb)/(ymaxb-yminb))
525 iz2=int(nbz*(zmax_edgm(iedg)+aaa-zminb)/(zmaxb-zminb))
526 ix2=max(1,2+min(nbx,ix2))
527 iy2=max(1,2+min(nby,iy2))
528 iz2=max(1,2+min(nbz,iz2))
529
530 deja = 0 ! The Edge is not yet a candidate.
531 i_stok_bak = i_stok
532C
533C--- IREMGAP - tag of deactivated lines
534 IF(flagremnode==2)THEN
535 k = kremnode(2*(iedg-1)+1)
536 l = kremnode(2*(iedg-1)+2)-1
537 DO m=k,l
538 tagremline(remnode(m)) = 1
539 ENDDO
540 ENDIF
541C
542 !we browse again the secondary edges in the neighborhood of main edge IEDG
543 !ON CONSTITUE ICI ONE COUPLE
544
545 DO iz = iz1,iz2
546 DO iy = iy1,iy2
547 DO ix = ix1,ix2
548
549 chain_add = voxel(ix,iy,iz) ! address in chain array of first edge stored in the voxel
550 DO WHILE(chain_add /= 0) ! loop over edges of current voxel
551 i = lchain_elem(chain_add) ! numbers of edge_id scanned in current voxel
552
553 !Second Edge Nodes, exclude couples with common node
554 IF (i<=nrts)THEN
555 ss1=itab(irects(1,i))
556 ss2=itab(irects(2,i))
557 ELSE
558 ss1=irem(2,i-nrts)
559 ss2=irem(3,i-nrts)
560 END IF
561
562 IF( (ss1==mm1).OR.(ss1==mm2).OR.
563 . (ss2==mm1).OR.(ss2==mm2) )THEN
564 chain_add = lchain_next(chain_add)
565 cycle
566 END IF
567
568 !Uniqueness of Peirs
569 IF(iauto==1 .AND. mm1<ss1 )THEN
570 chain_add = lchain_next(chain_add)
571 cycle
572 END IF
573
574C IREMPGAP
575 IF (flagremnode == 2) THEN
576 IF (i <= nrts) THEN
577C- Local Taged lines are removed
578 IF(tagremline(i)==1) THEN
579 chain_add = lchain_next(chain_add)
580 cycle
581 ENDIF
582 ELSE
583C- Remote lines are identified by nodes
584 k = kremnode(2*(iedg-1)+2)
585 l = kremnode(2*(iedg-1)+3)-1
586 remove_remote = 0
587 DO m=k,l,2
588 IF ((ss1==remnode(m)).AND.(ss2==remnode(m+1))) remove_remote = 1
589 ENDDO
590 IF (remove_remote==1) THEN
591 chain_add = lchain_next(chain_add)
592 cycle
593 ENDIF
594 ENDIF
595 ENDIF
596
597 i_stok = i_stok + 1 !on dispose d'un candidat
598 prov_s(i_stok) = i !edge secnd
599 prov_m(i_stok) = iedg !edge main
600
601 !print *, "candidat:", IEDG, I
602 IF(deja==0) nedg = nedg + 1 !nombre d edges candidate au calcul de contact (debug)
603 deja=1 !The EDGE Main IEDG is the subject of a candidate writing.We count the main edges being the subject of a candidate couple: we must no longer include NEDG for the other EDGE SOLD TESTEES.
604 chain_add = lchain_next(chain_add)
605C-----------------------------------------------------
606 IF(i_stok>=nvsiz)THEN
607 CALL i11sto_vox(
608 1 nvsiz ,irects,irectm,x ,ii_stok,
609 2 cand_s,cand_m,nsn4 ,noint ,marge,
610 3 i_mem ,prov_s,prov_m,eshift,addcm ,
611 4 chaine,nrts ,itab ,ifpen ,iform,
612 5 gapmin,drad ,igap, gap_s, gap_m,
613 7 gap_s_l, gap_m_l ,dgapload)
614
615 IF(i_mem==2) THEN
616 !print *, "too much candidates"
617c IF (ITASK==0)II_STOK=ZERO
618 GOTO 1000
619 END if!(I_MEM==2)
620 i_stok = i_stok-nvsiz
621C !DIR$ ASSUME (I_STOK < NVSIZ)
622 DO j=1,i_stok
623 prov_s(j) = prov_s(j+nvsiz)
624 prov_m(j) = prov_m(j+nvsiz)
625 ENDDO
626 ENDIF
627C-----------------------------------------------------
628
629 ENDDO !NEXT WHILE(CHAIN_ADD /= 0)
630 ENDDO !NEXT IZ
631 ENDDO !NEXT IY
632 ENDDO !NEXT IZ
633
634C--- IREMGAP - clean of tagremline
635 IF(flagremnode==2)THEN
636 k = kremnode(2*(iedg-1)+1)
637 l = kremnode(2*(iedg-1)+2)-1
638 DO m=k,l
639 tagremline(remnode(m)) = 0
640 ENDDO
641 ENDIF
642
643 ENDDO !NEXT IEDG
644
645C-------------------------------------------------------------------------
646C end of sorting
647C-------------------------------------------------------------------------
648
649 IF(i_stok/=0)CALL i11sto_vox(
650 1 i_stok,irects,irectm,x ,ii_stok,
651 2 cand_s,cand_m,nsn4 ,noint ,marge ,
652 3 i_mem ,prov_s,prov_m,eshift,addcm ,
653 4 chaine,nrts ,itab ,ifpen ,iform ,
654 5 gapmin,drad ,igap, gap_s ,gap_m ,
655 7 gap_s_l, gap_m_l ,dgapload)
656
657
658C=======================================================================
659C 4 reset nodes in boxes to zero and deallocation
660C=======================================================================
661
662 1000 CONTINUE
663
664 CALL my_barrier !Do not be Desalloue as long as the other threads have not finished working
665
666
667 ! can be optimized: do not reset the whole table (several possible solutions)
668 !! VOXEL( MIN_IX:MAX_IX, MIN_IY:MAX_IY, MIN_IZ:MAX_IZ ) = 0
669 tmin(1) = min_ix
670 tmin(2) = min_iy
671 tmin(3) = min_iz
672
673 tmax(1) = max_ix
674 tmax(2) = max_iy
675 tmax(3) = max_iz
676
677 IF (itask==0)THEN
678 !RESET VOXEL WITHIN USED RANGE ONLY
679 DO k= tmin(3),tmax(3)
680 DO j= tmin(2),tmax(2)
681 DO i= tmin(1),tmax(1)
682 voxel(i,j,k) = 0
683 END DO
684 END DO
685 END DO
686 !CHAINED LIST DEALLOCATION
687 DEALLOCATE(lchain_next)
688 DEALLOCATE(lchain_elem)
689 DEALLOCATE(lchain_last)
690 IF(flagremnode==2) DEALLOCATE(tagremline)
691 END IF
692
693C___________________________________________________________________________________________________________
694
695 RETURN
696 END
697
698
699
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
i11sto_vox
subroutine i11sto_vox(j_stok, irects, irectm, x, ii_stok, cand_s, cand_m, nsn4, noint, marge, i_mem, prov_s, prov_m, eshift, addcm, chaine, nrts, itab, ifpen, iform, gapmin, drad, igap, gap_s, gap_m, gap_s_l, gap_m_l, dgapload)
Definition i11sto.F:39
i11trivox
subroutine i11trivox(irects, irectm, x, nrtm, nrtsr, xyzm, ii_stok, cand_s, cand_m, nsn4, noint, tzinf, i_mem, eshift, addcm, chaine, nrts, itab, stfs, stfm, iauto, voxel, nbx, nby, nbz, itask, ifpen, iform, gapmin, drad, marge, gap_s, gap_m, gap_s_l, gap_m_l, bgapsmx, igap, gap, flagremnode, kremnode, remnode, dgapload)
Definition i11trivox.F:46
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
realloc_mod
Definition realloc_mod.F:29
realloc_mod::ireallocate
integer function, dimension(:), pointer ireallocate(ptr, new_size)
Definition realloc_mod.F:39
tri11::lchain_elem
integer, dimension(:), pointer lchain_elem
Definition tri11_mod.F:37
tri11::max_iz
integer max_iz
Definition tri11_mod.F:33
tri11::min_ix
integer min_ix
Definition tri11_mod.F:33
tri11::lchain_last
integer, dimension(:), pointer lchain_last
Definition tri11_mod.F:39
tri11::min_iz
integer min_iz
Definition tri11_mod.F:33
tri11::min_iy
integer min_iy
Definition tri11_mod.F:33
tri11::lchain_next
integer, dimension(:), pointer lchain_next
Definition tri11_mod.F:38
tri11::max_iy
integer max_iy
Definition tri11_mod.F:33
tri11::max_ix
integer max_ix
Definition tri11_mod.F:33
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339
my_barrier
subroutine my_barrier
Definition machine.F:31