OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21tri.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!|| i21tri ../engine/source/interfaces/intsort/i21tri.F
25!||--- called by ------------------------------------------------------
26!|| i21buce ../engine/source/interfaces/intsort/i21buce.F
27!||--- calls -----------------------------------------------------
28!|| i21sto ../engine/source/interfaces/int21/i21sto.F
29!|| i7dstk ../engine/source/interfaces/intsort/i7dstk.f
30!||--- uses -----------------------------------------------------
31!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
32!||====================================================================
33 SUBROUTINE i21tri(
34 1 ADD ,NSN ,IRECT ,XLOC ,STF ,
35 2 STFN ,XYZM ,I_ADD ,MAXSIZ ,II_STOK ,
36 3 CAND_N ,CAND_E ,MULNSN ,NOINT ,TZINF ,
37 4 MAXBOX ,MINBOX ,I_MEM ,NB_N_B ,I_ADD_MAX,
38 5 ESHIFT ,INACTI ,NRTM ,IGAP ,GAP ,
39 7 GAP_S ,GAPMIN ,GAPMAX ,MARGE ,CURV_MAX ,
40 8 XM0 ,NOD_NORMAL,DEPTH ,DRAD ,DGAPLOAD )
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE my_alloc_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "mvsiz_p.inc"
53c parameter setting the size for the vector (orig version is 128)
54 INTEGER NVECSZ
55 PARAMETER (NVECSZ = mvsiz)
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "param_c.inc"
60#include "parit_c.inc"
61C-----------------------------------------------
62C role of the routine:
63C ===================
64C classifies the elements of BPE and the nodes of BPN in two zones
65C > or < to a boundary here determined and outputs everything
66C in bpe, hpe, and bpn, hpn
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C
70C NOM DESCRIPTION E/S
71C
72C BPE ARRAY OF FACETTES TO SORT => Local
73C and of the result max side
74C PE ARRAY OF FACETTES => Local
75C RESULTAT COTE MIN
76C BPN SORTED NODES ARRAY => Local
77C and of the result max side
78C PN NODES ARRAY => Local
79C RESULTAT COTE MIN
80C ADD(2,*) ARRAY OF ADRESSES E/S
81C 1.......ADRESSES NODES C 2.......ADRESSES ELEMENTS
82C ZYZM(6,*) ARRAY OF XYZMIN E/S
83C 1.......XMIN BOITE
84C 2.......YMIN BOITE
85C 3.......ZMIN BOITE
86C 4.......XMAX BOITE
87C 5.......YMAX BOITE
88C 6.......ZMAX BOITE
89C IRECT(4,*) ARRAY OF CONEC FACETTES E
90C XLOC(3,*) COORDONNEES NODALES LOCALES E
91C NB_NC NUMBER OF CANDIDATE NODES => Local
92C NB_EC NUMBER OF CANDIDATE ELEMENTS => Local
93C I_ADD position in the i/o address table
94C Xmax larger abcisse existing e
95C XMAX largest order.existing E
96C Xmax larger existing side E
97C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
98C I_STOK storage level of pairs
99C CANDIDATES impact E/S
100C ADNSTK current address in the node box
101C CAND_N boites resultats nodes C ADESTK current address in the element box
102C CAND_E adresses des boites resultat elements
103C MULNSN = MULTIMP*NSN max size allowed now for the
104C COUPLES NODES,ELT CANDIDATES
105C NOINT INTERFACE USER NUMBER
106C TZINF TAILLE ZONE INFLUENCE
107C MAXBOX TAILLE MAX BUCKET
108C MINBOX TAILLE MIN BUCKET
109C
110C Prov_n Provisional Cand_n (static variable in i7tri)
111C PROV_E CAND_E provisoire (variable static in i7tri)
112C-----------------------------------------------
113C D u m m y A r g u m e n t s
114C-----------------------------------------------
115 INTEGER I_ADD,MAXSIZ,I_MEM,ESHIFT,NSN,NRTM,
116 . MULNSN,NB_N_B,NOINT,I_ADD_MAX,INACTI,IGAP,
117 . ADD(2,*),IRECT(4,*),
118 . CAND_N(*),CAND_E(*),II_STOK
119C REAL
120 my_real
121 . XLOC(3,*),XYZM(6,*),STF(*),STFN(*),GAP_S(*),
122 . xm0(3,*), nod_normal(3,*),
123 . tzinf,maxbox,minbox,marge,gap,gapmin,gapmax,
124 . depth
125 my_real , INTENT(IN) :: dgapload,drad
126 my_real curv_max(*)
127C-----------------------------------------------
128C L o c a l V a r i a b l e s
129C-----------------------------------------------
130 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NB_NC,NB_EC,
131 . N1,N2,N3,N4,NN,NE,K,L,NCAND_PROV,J_STOK
132C REAL
133 my_real
134 . dx,dy,dz,dsup,seuil, xx1, xx2, xx3, xx4,
135 . xmin, xmax,ymin, ymax,zmin, zmax, tz, gapsmx, bgapsmx, gapl
136
137 INTEGER,DIMENSION(:),ALLOCATABLE :: PROV_N
138 INTEGER,DIMENSION(:),ALLOCATABLE :: PROV_E
139 INTEGER,DIMENSION(:),ALLOCATABLE :: TN1
140 INTEGER,DIMENSION(:),ALLOCATABLE :: TN2
141 INTEGER,DIMENSION(:),ALLOCATABLE :: TN3
142 INTEGER,DIMENSION(:),ALLOCATABLE :: TN4
143 INTEGER,DIMENSION(:),ALLOCATABLE :: BPE
144 INTEGER,DIMENSION(:),ALLOCATABLE :: PE
145 INTEGER,DIMENSION(:),ALLOCATABLE :: BPN
146 INTEGER,DIMENSION(:),ALLOCATABLE :: PN
147 !
148 my_real, DIMENSION(:,:),ALLOCATABLE :: txx1
149 my_real, DIMENSION(:,:),ALLOCATABLE :: txx2
150 my_real, DIMENSION(:,:),ALLOCATABLE :: txx3
151 my_real, DIMENSION(:,:),ALLOCATABLE :: txx4
152 my_real, DIMENSION(:),ALLOCATABLE :: txmax
153 my_real, DIMENSION(:),ALLOCATABLE :: txmin
154 my_real, DIMENSION(:),ALLOCATABLE :: tymax
155 my_real, DIMENSION(:),ALLOCATABLE :: tymin
156 my_real, DIMENSION(:),ALLOCATABLE :: tzmax
157 my_real, DIMENSION(:),ALLOCATABLE :: tzmin
158C-----------------------------------------------
159 CALL my_alloc(prov_n,2*mvsiz)
160 CALL my_alloc(prov_e,2*mvsiz)
161 CALL my_alloc(tn1,nvecsz)
162 CALL my_alloc(tn2,nvecsz)
163 CALL my_alloc(tn3,nvecsz)
164 CALL my_alloc(tn4,nvecsz)
165 CALL my_alloc(bpe,maxsiz/3) ! BPE : used over NRTM but not NRTM + 100 (MAXSIZ = NRTM + 100)
166 CALL my_alloc(pe,maxsiz)
167 CALL my_alloc(bpn,nsn)
168 CALL my_alloc(pn,nsn)
169 CALL my_alloc(txx1,3,nvecsz)
170 CALL my_alloc(txx2,3,nvecsz)
171 CALL my_alloc(txx3,3,nvecsz)
172 CALL my_alloc(txx4,3,nvecsz)
173 CALL my_alloc(txmax,nvecsz)
174 CALL my_alloc(txmin,nvecsz)
175 CALL my_alloc(tymax,nvecsz)
176 CALL my_alloc(tymin,nvecsz)
177 CALL my_alloc(tzmax,nvecsz)
178 CALL my_alloc(tzmin,nvecsz)
179C-----------------------------------------------
180C
181C initial construction phase of BPE and BPN moved from I7BUCE => I7TRI
182C
183 xmin = xyzm(1,i_add)
184 ymin = xyzm(2,i_add)
185 zmin = xyzm(3,i_add)
186 xmax = xyzm(4,i_add)
187 ymax = xyzm(5,i_add)
188 zmax = xyzm(6,i_add)
189C
190C copy of segment and node numbers in BPE and BPN
191C
192 nb_ec = 0
193 DO i=1,nrtm
194C We do not retain the Destruit facets
195 IF(stf(i)/=zero)THEN
196 nb_ec = nb_ec + 1
197 bpe(nb_ec) = i
198 ENDIF
199 ENDDO
200C
201C optimization // search for nodes within xmin xmax of
202C processor elements
203C
204 nb_nc = 0
205 DO i=1,nsn
206 IF(stfn(i)/=zero) THEN
207 IF(xloc(1,i)>=xmin.AND.xloc(1,i)<=xmax.AND.
208 . xloc(2,i)>=ymin.AND.xloc(2,i)<=ymax.AND.
209 . xloc(3,i)>=zmin.AND.xloc(3,i)<=zmax)THEN
210 nb_nc=nb_nc+1
211 bpn(nb_nc) = i
212 ENDIF
213 ENDIF
214 ENDDO
215C
216 j_stok = 0
217 GOTO 200
218C=======================================================================
219 100 CONTINUE
220C=======================================================================
221C-----------------------------------------------------------
222C
223C
224C 1- sorting phase on the median along the largest direction
225C
226C
227C-----------------------------------------------------------
228C
229C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
230C
231 dir = 1
232 IF(dy==dsup) THEN
233 dir = 2
234 ELSE IF(dz==dsup) THEN
235 dir = 3
236 ENDIF
237 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))*0.5
238C
239C 2- DIVISER LES NODES EN TWO ZONES
240C
241 nb_ncn= 0
242 nb_ncn1= 0
243 addnn= add(1,i_add)
244 IF(igap==0)THEN
245 DO i=1,nb_nc
246 IF(xloc(dir,bpn(i))<seuil) THEN
247C store at the bottom of the BP stack
248 nb_ncn1 = nb_ncn1 + 1
249 addnn = addnn + 1
250 pn(addnn) = bpn(i)
251 ENDIF
252 ENDDO
253C
254 DO i=1,nb_nc
255 IF(xloc(dir,bpn(i))>=seuil) THEN
256C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
257 nb_ncn = nb_ncn + 1
258 bpn(nb_ncn) = bpn(i)
259 ENDIF
260 ENDDO
261 ELSE
262 gapsmx = zero
263 DO i=1,nb_nc
264 IF(xloc(dir,bpn(i))<seuil) THEN
265C store at the bottom of the BP stack
266 nb_ncn1 = nb_ncn1 + 1
267 addnn = addnn + 1
268 pn(addnn) = bpn(i)
269 gapsmx = max(gapsmx,max(gap_s(bpn(i))+dgapload,depth,drad))
270 ENDIF
271 ENDDO
272C
273 bgapsmx = zero
274 DO i=1,nb_nc
275 IF(xloc(dir,bpn(i))>=seuil) THEN
276C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
277 nb_ncn = nb_ncn + 1
278 bpn(nb_ncn) = bpn(i)
279 bgapsmx = max(bgapsmx,max(gap_s(bpn(i))+dgapload,depth,drad))
280 ENDIF
281 ENDDO
282 ENDIF
283C
284C 3- divide the elements
285C
286 IF(igap==0) THEN
287 nb_ecn= 0
288 addne= add(2,i_add)
289 IF(nb_ncn1==0) THEN
290 DO i=1,nb_ec
291 ne = bpe(i)
292 xx1=xm0(dir, irect(1,ne))
293 xx2=xm0(dir, irect(2,ne))
294 xx3=xm0(dir, irect(3,ne))
295 xx4=xm0(dir, irect(4,ne))
296 xmax=max(xx1,xx2,xx3,xx4)+tzinf
297 IF(xmax>=seuil) THEN
298C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
299 nb_ecn = nb_ecn + 1
300 bpe(nb_ecn) = ne
301 ENDIF
302 ENDDO
303 ELSEIF(nb_ncn==0) THEN
304 DO i=1,nb_ec
305 ne = bpe(i)
306 xx1=xm0(dir, irect(1,ne))
307 xx2=xm0(dir, irect(2,ne))
308 xx3=xm0(dir, irect(3,ne))
309 xx4=xm0(dir, irect(4,ne))
310 xmin=min(xx1,xx2,xx3,xx4)-tzinf
311 IF(xmin<seuil) THEN
312C store at the bottom of the BP stack
313 addne = addne + 1
314 pe(addne) = ne
315 ENDIF
316 ENDDO
317 ELSE
318 DO i=1,nb_ec
319 ne = bpe(i)
320 xx1=xm0(dir, irect(1,ne))
321 xx2=xm0(dir, irect(2,ne))
322 xx3=xm0(dir, irect(3,ne))
323 xx4=xm0(dir, irect(4,ne))
324 xmin=min(xx1,xx2,xx3,xx4)-tzinf
325 IF(xmin<seuil) THEN
326C store at the bottom of the BP stack
327 addne = addne + 1
328 pe(addne) = ne
329 ENDIF
330 ENDDO
331C
332 DO i=1,nb_ec
333 ne = bpe(i)
334 xx1=xm0(dir, irect(1,ne))
335 xx2=xm0(dir, irect(2,ne))
336 xx3=xm0(dir, irect(3,ne))
337 xx4=xm0(dir, irect(4,ne))
338 xmax=max(xx1,xx2,xx3,xx4)+tzinf
339 IF(xmax>=seuil) THEN
340C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
341 nb_ecn = nb_ecn + 1
342 bpe(nb_ecn) = ne
343 ENDIF
344 ENDDO
345 ENDIF
346C Optimisation gap variable
347 ELSE
348 nb_ecn= 0
349 addne= add(2,i_add)
350 IF(nb_ncn1==0) THEN
351 DO i=1,nb_ec
352 ne = bpe(i)
353 xx1=xm0(dir, irect(1,ne))
354 xx2=xm0(dir, irect(2,ne))
355 xx3=xm0(dir, irect(3,ne))
356 xx4=xm0(dir, irect(4,ne))
357 xmax=max(xx1,xx2,xx3,xx4)
358 + +max(min(max(bgapsmx,gapmin),gapmax)+dgapload,depth,drad)
359 + +marge
360 IF(xmax>=seuil) THEN
361C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
362 nb_ecn = nb_ecn + 1
363 bpe(nb_ecn) = ne
364 ENDIF
365 ENDDO
366 ELSEIF(nb_ncn==0) THEN
367 DO i=1,nb_ec
368 ne = bpe(i)
369 xx1=xm0(dir, irect(1,ne))
370 xx2=xm0(dir, irect(2,ne))
371 xx3=xm0(dir, irect(3,ne))
372 xx4=xm0(dir, irect(4,ne))
373 xmin=min(xx1,xx2,xx3,xx4)
374 - -max(min(max(gapsmx,gapmin),gapmax)+dgapload,depth,drad)
375 - -marge
376 IF(xmin<seuil) THEN
377C store at the bottom of the BP stack
378 addne = addne + 1
379 pe(addne) = ne
380 ENDIF
381 ENDDO
382 ELSE
383 DO i=1,nb_ec
384 ne = bpe(i)
385 xx1=xm0(dir, irect(1,ne))
386 xx2=xm0(dir, irect(2,ne))
387 xx3=xm0(dir, irect(3,ne))
388 xx4=xm0(dir, irect(4,ne))
389 xmin=min(xx1,xx2,xx3,xx4)
390 - -max(min(max(gapsmx,gapmin),gapmax)+dgapload,depth,drad)
391 - -marge
392 IF(xmin<seuil) THEN
393C store at the bottom of the BP stack
394 addne = addne + 1
395 pe(addne) = ne
396 ENDIF
397 ENDDO
398C
399 DO i=1,nb_ec
400 ne = bpe(i)
401 xx1=xm0(dir, irect(1,ne))
402 xx2=xm0(dir, irect(2,ne))
403 xx3=xm0(dir, irect(3,ne))
404 xx4=xm0(dir, irect(4,ne))
405 xmax=max(xx1,xx2,xx3,xx4)
406 + +max(min(max(bgapsmx,gapmin),gapmax)+dgapload,depth,drad)
407 + +marge
408 IF(xmax>=seuil) THEN
409C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
410 nb_ecn = nb_ecn + 1
411 bpe(nb_ecn) = ne
412 ENDIF
413 ENDDO
414 ENDIF
415 ENDIF
416C
417C 4- REMPLIR LES TABLEAUX D'ADRESSES
418C
419 add(1,i_add+1) = addnn
420 add(2,i_add+1) = addne
421C-----fill the min of the next box and the max of the current one
422C (i.e. threshold is a max for the current one)
423C We're going to go down and so we define a new box
424C fill the max of the new box
425C initialises in i7buc1 a 1.E30 comme ca on recupere
426c either XMAX or the max of the box
427 xyzm(1,i_add+1) = xyzm(1,i_add)
428 xyzm(2,i_add+1) = xyzm(2,i_add)
429 xyzm(3,i_add+1) = xyzm(3,i_add)
430 xyzm(4,i_add+1) = xyzm(4,i_add)
431 xyzm(5,i_add+1) = xyzm(5,i_add)
432 xyzm(6,i_add+1) = xyzm(6,i_add)
433 xyzm(dir,i_add+1) = seuil
434 xyzm(dir+3,i_add) = seuil
435C
436 nb_nc = nb_ncn
437 nb_ec = nb_ecn
438C increment the descent level before exiting
439 i_add = i_add + 1
440 IF(i_add+1>=i_add_max) THEN
441 i_mem = 3
442 RETURN
443 ENDIF
444C=======================================================================
445 200 CONTINUE
446C=======================================================================
447C-----------------------------------------------------------
448C
449C
450C 2- TEST ARRET = BOITE VIDE
451C BOITE TROP PETITE
452C BOITE NE CONTENANT QU'ONE NODE C No More Memory Available
453C
454C-------------------test on exceeded memory------------
455C
456 IF(add(2,i_add)+nb_ec>maxsiz) THEN
457C no more space in the element stack boxes too small
458 i_mem = 1
459 RETURN
460 ENDIF
461C
462C--------------------test on empty boxes--------------
463C
464 IF(nb_ec/=0.AND.nb_nc/=0) THEN
465C
466 dx = xyzm(4,i_add) - xyzm(1,i_add)
467 dy = xyzm(5,i_add) - xyzm(2,i_add)
468 dz = xyzm(6,i_add) - xyzm(3,i_add)
469 dsup= max(dx,dy,dz)
470C
471C-------------------test on end of branch ------------
472C 1- storage of candidate node(s) and corresponding elements
473C remove the unnecessary ones
474C
475C NCAND_PROV=NB_EC*NB_NC
476C NCAND_PROV negatif qd NB_EC*NB_NC > 2e31
477C
478 IF(nb_ec+nb_nc<=nvecsz) THEN
479 ncand_prov = nb_ec*nb_nc
480 ELSE
481 ncand_prov = nvecsz+1
482 ENDIF
483C
484 IF(dsup<minbox.OR.(nb_nc<=nb_n_b)
485 & .OR.(ncand_prov<=nvecsz)) THEN
486C necessary qd nb_nc <= nb_n_b or dsup <minbox and nb_ec+nb_nc> 128
487 ncand_prov = nb_ec*nb_nc
488 IF(ivector==1.AND.ncand_prov<=nvecsz)THEN
489 IF(igap==0)THEN
490 DO i = 1, nb_ec
491 ne = bpe(i)
492 tn1(i)=irect(1,ne)
493 tn2(i)=irect(2,ne)
494 tn3(i)=irect(3,ne)
495 tn4(i)=irect(4,ne)
496 txx1(1,i)=xm0(1, tn1(i))
497 txx2(1,i)=xm0(1, tn2(i))
498 txx3(1,i)=xm0(1, tn3(i))
499 txx4(1,i)=xm0(1, tn4(i))
500 txmax(i)=max(txx1(1,i),txx2(1,i),txx3(1,i),txx4(1,i))
501 + +tzinf
502 txmin(i)=min(txx1(1,i),txx2(1,i),txx3(1,i),txx4(1,i))
503 - -tzinf
504 txx1(2,i)=xm0(2, tn1(i))
505 txx2(2,i)=xm0(2, tn2(i))
506 txx3(2,i)=xm0(2, tn3(i))
507 txx4(2,i)=xm0(2, tn4(i))
508 tymax(i)=max(txx1(2,i),txx2(2,i),txx3(2,i),txx4(2,i))
509 + +tzinf
510 tymin(i)=min(txx1(2,i),txx2(2,i),txx3(2,i),txx4(2,i))
511 - -tzinf
512 txx1(3,i)=xm0(3, tn1(i))
513 txx2(3,i)=xm0(3, tn2(i))
514 txx3(3,i)=xm0(3, tn3(i))
515 txx4(3,i)=xm0(3, tn4(i))
516 tzmax(i)=max(txx1(3,i),txx2(3,i),txx3(3,i),txx4(3,i))
517 + +tzinf
518 tzmin(i)=min(txx1(3,i),txx2(3,i),txx3(3,i),txx4(3,i))
519 - -tzinf
520 ENDDO
521 DO k=1,ncand_prov,nvsiz
522 DO l=k,min(k-1+nvsiz,ncand_prov)
523 i = 1+(l-1)/nb_nc
524 j = l-(i-1)*nb_nc
525 nn=bpn(j)
526 IF(xloc(1,nn)>txmin(i).AND.xloc(1,nn)<txmax(i).AND.
527 & xloc(2,nn)>tymin(i).AND.xloc(2,nn)<tymax(i).AND.
528 & xloc(3,nn)>tzmin(i).AND.xloc(3,nn)<tzmax(i) ) THEN
529 j_stok = j_stok + 1
530 prov_n(j_stok) = bpn(j)
531 prov_e(j_stok) = bpe(i)
532 ENDIF
533 ENDDO
534 IF(j_stok>=nvsiz)THEN
535 CALL i21sto(
536 1 nvsiz ,irect ,xloc ,ii_stok,cand_n,
537 2 cand_e ,mulnsn,noint ,marge ,i_mem ,
538 3 prov_n ,prov_e,eshift,inacti ,nsn ,
539 4 igap ,gap ,gap_s ,gapmin ,gapmax,
540 5 curv_max ,xm0 ,nod_normal,depth ,drad,
541 6 dgapload)
542 IF(i_mem==2)RETURN
543 j_stok = j_stok-nvsiz
544#include "vectorize.inc"
545 DO j=1,j_stok
546 prov_n(j) = prov_n(j+nvsiz)
547 prov_e(j) = prov_e(j+nvsiz)
548 ENDDO
549 ENDIF
550 ENDDO
551 ELSE
552 DO i = 1, nb_ec
553 ne = bpe(i)
554 tn1(i)=irect(1,ne)
555 tn2(i)=irect(2,ne)
556 tn3(i)=irect(3,ne)
557 tn4(i)=irect(4,ne)
558 txx1(1,i)=xm0(1, tn1(i))
559 txx2(1,i)=xm0(1, tn2(i))
560 txx3(1,i)=xm0(1, tn3(i))
561 txx4(1,i)=xm0(1, tn4(i))
562 txmax(i)=max(txx1(1,i),txx2(1,i),txx3(1,i),txx4(1,i))
563 + +marge
564 txmin(i)=min(txx1(1,i),txx2(1,i),txx3(1,i),txx4(1,i))
565 - -marge
566 txx1(2,i)=xm0(2, tn1(i))
567 txx2(2,i)=xm0(2, tn2(i))
568 txx3(2,i)=xm0(2, tn3(i))
569 txx4(2,i)=xm0(2, tn4(i))
570 tymax(i)=max(txx1(2,i),txx2(2,i),txx3(2,i),txx4(2,i))
571 + +marge
572 tymin(i)=min(txx1(2,i),txx2(2,i),txx3(2,i),txx4(2,i))
573 - -marge
574 txx1(3,i)=xm0(3, tn1(i))
575 txx2(3,i)=xm0(3, tn2(i))
576 txx3(3,i)=xm0(3, tn3(i))
577 txx4(3,i)=xm0(3, tn4(i))
578 tzmax(i)=max(txx1(3,i),txx2(3,i),txx3(3,i),txx4(3,i))
579 + +marge
580 tzmin(i)=min(txx1(3,i),txx2(3,i),txx3(3,i),txx4(3,i))
581 - -marge
582 ENDDO
583 DO k=1,ncand_prov,nvsiz
584 DO l=k,min(k-1+nvsiz,ncand_prov)
585 i = 1+(l-1)/nb_nc
586 j = l-(i-1)*nb_nc
587 nn=bpn(j)
588 gapl=max(max(min(gap_s(bpn(j)),gapmax),gapmin)+dgapload,depth,drad)
589 IF(xloc(1,nn)>txmin(i)-gapl.AND.
590 & xloc(1,nn)<txmax(i)+gapl.AND.
591 & xloc(2,nn)>tymin(i)-gapl.AND.
592 & xloc(2,nn)<tymax(i)+gapl.AND.
593 & xloc(3,nn)>tzmin(i)-gapl.AND.
594 & xloc(3,nn)<tzmax(i)+gapl ) THEN
595 j_stok = j_stok + 1
596 prov_n(j_stok) = bpn(j)
597 prov_e(j_stok) = bpe(i)
598 ENDIF
599 ENDDO
600 IF(j_stok>=nvsiz)THEN
601 CALL i21sto(
602 1 nvsiz ,irect ,xloc ,ii_stok,cand_n,
603 2 cand_e ,mulnsn,noint ,marge ,i_mem ,
604 3 prov_n ,prov_e,eshift,inacti ,nsn ,
605 4 igap ,gap ,gap_s ,gapmin ,gapmax,
606 5 curv_max ,xm0 ,nod_normal,depth,drad,
607 6 dgapload)
608 IF(i_mem==2)RETURN
609 j_stok = j_stok-nvsiz
610#include "vectorize.inc"
611 DO j=1,j_stok
612 prov_n(j) = prov_n(j+nvsiz)
613 prov_e(j) = prov_e(j+nvsiz)
614 ENDDO
615 ENDIF
616 ENDDO
617 END IF
618 ELSE
619 DO k=1,ncand_prov,nvsiz
620 IF(igap==0) THEN
621 DO l=k,min(k-1+nvsiz,ncand_prov)
622 i = 1+(l-1)/nb_nc
623 j = l-(i-1)*nb_nc
624 ne = bpe(i)
625 n1=irect(1,ne)
626 n2=irect(2,ne)
627 n3=irect(3,ne)
628 n4=irect(4,ne)
629 xx1=xm0(1, n1)
630 xx2=xm0(1, n2)
631 xx3=xm0(1, n3)
632 xx4=xm0(1, n4)
633 xmax=max(xx1,xx2,xx3,xx4)+tzinf
634 xmin=min(xx1,xx2,xx3,xx4)-tzinf
635 xx1=xm0(2, n1)
636 xx2=xm0(2, n2)
637 xx3=xm0(2, n3)
638 xx4=xm0(2, n4)
639 ymax=max(xx1,xx2,xx3,xx4)+tzinf
640 ymin=min(xx1,xx2,xx3,xx4)-tzinf
641 xx1=xm0(3, n1)
642 xx2=xm0(3, n2)
643 xx3=xm0(3, n3)
644 xx4=xm0(3, n4)
645 zmax=max(xx1,xx2,xx3,xx4)+tzinf
646 zmin=min(xx1,xx2,xx3,xx4)-tzinf
647
648 nn=bpn(j)
649 IF(xloc(1,nn)>xmin.AND.xloc(1,nn)<xmax.AND.
650 & xloc(2,nn)>ymin.AND.xloc(2,nn)<ymax.AND.
651 & xloc(3,nn)>zmin.AND.xloc(3,nn)<zmax ) THEN
652 j_stok = j_stok + 1
653 prov_n(j_stok) = bpn(j)
654 prov_e(j_stok) = ne
655 ENDIF
656 ENDDO
657 ELSE
658 DO l=k,min(k-1+nvsiz,ncand_prov)
659 i = 1+(l-1)/nb_nc
660 j = l-(i-1)*nb_nc
661 ne = bpe(i)
662 n1=irect(1,ne)
663 n2=irect(2,ne)
664 n3=irect(3,ne)
665 n4=irect(4,ne)
666 xx1=xm0(1, n1)
667 xx2=xm0(1, n2)
668 xx3=xm0(1, n3)
669 xx4=xm0(1, n4)
670 tz=max(max(min(gap_s(bpn(j)),gapmax),gapmin)+dgapload,depth,drad)
671 + +marge
672 xmax=max(xx1,xx2,xx3,xx4)+tz
673 xmin=min(xx1,xx2,xx3,xx4)-tz
674 xx1=xm0(2, n1)
675 xx2=xm0(2, n2)
676 xx3=xm0(2, n3)
677 xx4=xm0(2, n4)
678 ymax=max(xx1,xx2,xx3,xx4)+tz
679 ymin=min(xx1,xx2,xx3,xx4)-tz
680 xx1=xm0(3, n1)
681 xx2=xm0(3, n2)
682 xx3=xm0(3, n3)
683 xx4=xm0(3, n4)
684 zmax=max(xx1,xx2,xx3,xx4)+tz
685 zmin=min(xx1,xx2,xx3,xx4)-tz
686
687 nn=bpn(j)
688 IF(xloc(1,nn)>xmin.AND.xloc(1,nn)<xmax.AND.
689 & xloc(2,nn)>ymin.AND.xloc(2,nn)<ymax.AND.
690 & xloc(3,nn)>zmin.AND.xloc(3,nn)<zmax ) THEN
691 j_stok = j_stok + 1
692 prov_n(j_stok) = bpn(j)
693 prov_e(j_stok) = ne
694 ENDIF
695 ENDDO
696 END IF
697 IF(j_stok>=nvsiz)THEN
698 CALL i21sto(
699 1 nvsiz,irect ,xloc ,ii_stok,cand_n,
700 2 cand_e ,mulnsn,noint ,marge ,i_mem ,
701 3 prov_n ,prov_e,eshift,inacti ,nsn ,
702 4 igap ,gap ,gap_s ,gapmin ,gapmax ,
703 5 curv_max ,xm0 ,nod_normal,depth,drad ,
704 6 dgapload)
705 IF(i_mem==2)RETURN
706 j_stok = j_stok-nvsiz
707#include "vectorize.inc"
708 DO j=1,j_stok
709 prov_n(j) = prov_n(j+nvsiz)
710 prov_e(j) = prov_e(j+nvsiz)
711 ENDDO
712 ENDIF
713 ENDDO
714 ENDIF
715 ELSE
716C=======================================================================
717 GOTO 100
718C=======================================================================
719 ENDIF
720 ENDIF
721C-------------------------------------------------------------------------
722C empty box or
723C end of branch
724C decrement the descent level before restarting
725C-------------------------------------------------------------------------
726 i_add = i_add - 1
727 IF (i_add/=0) THEN
728C-------------------------------------------------------------------------
729C must copy the stack bottoms into corresponding stack_bottoms
730C before going back down into the adjacent branch
731C-------------------------------------------------------------------------
732 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
733C=======================================================================
734 GOTO 200
735C=======================================================================
736 ENDIF
737C-------------------------------------------------------------------------
738C end of sorting
739C-------------------------------------------------------------------------
740 IF(j_stok/=0)CALL i21sto(
741 1 j_stok,irect ,xloc ,ii_stok,cand_n,
742 2 cand_e ,mulnsn,noint ,marge ,i_mem ,
743 3 prov_n ,prov_e,eshift,inacti ,nsn ,
744 4 igap ,gap ,gap_s ,gapmin ,gapmax,
745 5 curv_max ,xm0,nod_normal,depth,drad ,
746 6 dgapload)
747C-------------------------------------------------------------------------
748 DEALLOCATE(prov_n)
749 DEALLOCATE(prov_e)
750 DEALLOCATE(tn1)
751 DEALLOCATE(tn2)
752 DEALLOCATE(tn3)
753 DEALLOCATE(tn4)
754 DEALLOCATE(bpe)
755 DEALLOCATE(pe)
756 DEALLOCATE(bpn)
757 DEALLOCATE(pn)
758 DEALLOCATE(txx1)
759 DEALLOCATE(txx2)
760 DEALLOCATE(txx3)
761 DEALLOCATE(txx4)
762 DEALLOCATE(txmax)
763 DEALLOCATE(txmin)
764 DEALLOCATE(tymax)
765 DEALLOCATE(tymin)
766 DEALLOCATE(tzmax)
767 DEALLOCATE(tzmin)
768 RETURN
769 END
i21tri
subroutine i21tri(add, nsn, irect, xloc, stf, stfn, xyzm, i_add, maxsiz, ii_stok, cand_n, cand_e, mulnsn, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, eshift, inacti, nrtm, igap, gap, gap_s, gapmin, gapmax, marge, curv_max, xm0, nod_normal, depth, drad, dgapload)
Definition i21tri.F:41
i21sto
subroutine i21sto(j_stok, irect, xloc, ii_stok, cand_n, cand_e, mulnsn, noint, marge, i_mem, prov_n, prov_e, eshift, inacti, nsn, igap, gap, gap_s, gapmin, gapmax, curv_max, xm0, nod_normal, depth, drad, dgapload)
Definition i21sto.F:38
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
i7dstk
subroutine i7dstk(i_add, nb_nc, nb_ec, add, bpn, pn, bpe, pe)
Definition i7dstk.F:33