OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20tri.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "vectorize.inc"
#include "r4r8_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i20tri (add, nsn, renum, nsnr, isznsnr, irect, xa, stf, stfa, xyzm, i_add, nsv, maxsiz, ii_stok, cand_n, cand_e, mulnsn, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, eshift, inacti, ifq, cand_a, cand_p, ifpen, nrtm, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, marge, curv_max, nin, gap_sh, nbinflg, mbinflg, isym, intheat, idt_therm, nodadt_therm)
subroutine i20tri_edge (add, xa, nlg, ixlins, ixlinm, nlinma, nlinsr, xyzm, i_add, maxsiz, ii_stoke, cand_s, cand_m, nsn4, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, eshift, addcm, chaine, nlinsa, itab, nb_old, stfs, stfm, iauto, nin)

Function/Subroutine Documentation

◆ i20tri()

subroutine i20tri ( integer, dimension(2,*) add,
integer nsn,
integer, dimension(*) renum,
integer nsnr,
integer isznsnr,
integer, dimension(4,*) irect,
xa,
stf,
stfa,
xyzm,
integer i_add,
integer, dimension(*) nsv,
integer maxsiz,
integer ii_stok,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
integer mulnsn,
integer noint,
tzinf,
maxbox,
minbox,
integer i_mem,
integer nb_n_b,
integer i_add_max,
integer eshift,
integer inacti,
integer ifq,
integer, dimension(*) cand_a,
cand_p,
integer, dimension(*) ifpen,
integer nrtm,
integer nsnrold,
integer igap,
gap,
gap_s,
gap_m,
gapmin,
gapmax,
marge,
curv_max,
integer nin,
gap_sh,
integer, dimension(*) nbinflg,
integer, dimension(*) mbinflg,
integer isym,
integer, intent(in) intheat,
integer, intent(in) idt_therm,
integer, intent(in) nodadt_therm )

Definition at line 34 of file i20tri.F.

45C============================================================================
46C M o d u l e s
47C-----------------------------------------------
48 USE tri7box
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57c parameter setting the size for the vector (orig version is 128)
58 INTEGER NVECSZ
59 parameter(nvecsz = mvsiz)
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "com01_c.inc"
64#include "param_c.inc"
65C-----------------------------------------------
66C ROLE DE LA ROUTINE:
67C ===================
68C CLASSE LES ELETS DE BPE ET LES NOEUDS DE BPN EN TWO ZONES
69C > OU < A UNE FRONTIERE ICI DETERMINEE ET SORT LE TOUT
70C DANS bpe,hpe, et bpn,hpn
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C
74C NOM DESCRIPTION E/S
75C
76C BPE TABLEAU DES FACETTES A TRIER => Local
77C ET DU RESULTAT COTE MAX
78C PE TABLEAU DES FACETTES => Local
79C RESULTAT COTE MIN
80C BPN TABLEAU DES NOEUDS A TRIER => Local
81C ET DU RESULTAT COTE MAX
82C PN TABLEAU DES NOEUDS => Local
83C RESULTAT COTE MIN
84C ADD(2,*) TABLEAU DES ADRESSES E/S
85C 1.......ADRESSES NOEUDS
86C 2.......ADRESSES ELEMENTS
87C ZYZM(6,*) TABLEAU DES XYZMIN E/S
88C 1.......XMIN BOITE
89C 2.......YMIN BOITE
90C 3.......ZMIN BOITE
91C 4.......XMAX BOITE
92C 5.......YMAX BOITE
93C 6.......ZMAX BOITE
94C IRECT(4,*) TABLEAU DES CONEC FACETTES E
95C X(3,*) COORDONNEES NODALES E
96C NB_NC NOMBRE DE NOEUDS CANDIDATS => Local
97C NB_EC NOMBRE D'ELTS CANDIDATS => Local
98C I_ADD POSITION DANS LE TAB DES ADRESSES E/S
99C NSV NOS SYSTEMES DES NOEUDS E
100C XMAX plus grande abcisse existante E
101C XMAX plus grande ordonn. existante E
102C XMAX plus grande cote existante E
103C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
104C I_STOK niveau de stockage des couples
105C candidats impact E/S
106C ADNSTK adresse courante dans la boite des noeuds
107C CAND_N boites resultats noeuds
108C ADESTK adresse courante dans la boite des elements
109C CAND_E adresses des boites resultat elements
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 MAXBOX TAILLE MAX BUCKET
115C MINBOX TAILLE MIN BUCKET
116C
117C PROV_N CAND_N provisoire (variable static dans i20tri)
118C PROV_E CAND_E provisoire (variable static dans i20tri)
119C-----------------------------------------------
120C D u m m y A r g u m e n t s
121C-----------------------------------------------
122 INTEGER I_ADD,MAXSIZ,I_MEM,ESHIFT,NSN,ISZNSNR,NRTM,NSNROLD,
123 . MULNSN,NB_N_B,NOINT,I_ADD_MAX,INACTI,IFQ,NSNR,IGAP,
124 . ADD(2,*),IRECT(4,*), NIN,NBINFLG(*),MBINFLG(*),ISYM,
125 . NSV(*),CAND_N(*),CAND_E(*),CAND_A(*),IFPEN(*),RENUM(*),
126 . II_STOK
127 INTEGER, INTENT(IN) :: INTHEAT
128 INTEGER, INTENT(IN) :: IDT_THERM
129 INTEGER, INTENT(IN) :: NODADT_THERM
130C REAL
131 my_real
132 . xa(3,*),xyzm(6,*),cand_p(*),stf(*),stfa(*),gap_s(*),gap_m(*),
133 . tzinf,maxbox,minbox,marge,gap,gapmin,gapmax,
134 . curv_max(*), gap_sh(*)
135C-----------------------------------------------
136C L o c a l V a r i a b l e s
137C-----------------------------------------------
138 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NB_NC,NB_EC,
139 . N1,N2,N3,N4,NN,NE,K,L,NCAND_PROV,J_STOK,II,JJ,
140 . PROV_N(2*MVSIZ),PROV_E(2*MVSIZ),
141 . TN1(NVECSZ),TN2(NVECSZ),TN3(NVECSZ),TN4(NVECSZ),
142C BPE : utilise sur NRTM et non NRTM + 100 en toute rigueur (ici MAXSIZ = NRTM + 100)
143 . BPE(MAXSIZ/3),PE(MAXSIZ),BPN(NSN+NSNR),PN(NSN+NSNR),
144 . OLDNUM(ISZNSNR)
145C REAL
146 my_real
147 . dx,dy,dz,dsup,seuil,seuils,seuili, xx1, xx2, xx3, xx4,
148 . yy1, yy2, yy3, yy4, zz1, zz2, zz3, zz4,
149 . xmin, xmax,ymin, ymax,zmin, zmax, tz, gapsmx, bgapsmx, gapl,
150 . txx1(3,nvecsz), txx2(3,nvecsz), txx3(3,nvecsz), txx4(3,nvecsz),
151 . txmax(nvecsz),txmin(nvecsz),tymax(nvecsz),
152 . tymin(nvecsz),tzmax(nvecsz),tzmin(nvecsz),smoins,splus,xx
153C-----------------------------------------------
154C Phase initiale de construction de BPE et BPN deplacee de I7BUCE => I7TRI
155C
156 bgapsmx = zero
157 xmin = xyzm(1,i_add)
158 ymin = xyzm(2,i_add)
159 zmin = xyzm(3,i_add)
160 xmax = xyzm(4,i_add)
161 ymax = xyzm(5,i_add)
162 zmax = xyzm(6,i_add)
163C
164C Copie des nos de segments et de noeuds dans BPE ET BPN
165C
166 nb_ec = 0
167 DO i=1,nrtm
168C on ne retient pas les facettes detruites
169 IF(stf(i)/=zero)THEN
170 nb_ec = nb_ec + 1
171 bpe(nb_ec) = i
172 ENDIF
173 ENDDO
174C
175C Optimisation // recherche les noeuds compris dans xmin xmax des
176C elements du processeur
177C
178 nb_nc = 0
179 DO i=1,nsn
180 j=nsv(i)
181 IF(stfa(j)/=zero) THEN
182 IF(xa(1,j)>=xmin.AND.xa(1,j)<=xmax.AND.
183 . xa(2,j)>=ymin.AND.xa(2,j)<=ymax.AND.
184 . xa(3,j)>=zmin.AND.xa(3,j)<=zmax)THEN
185 nb_nc=nb_nc+1
186 bpn(nb_nc) = i
187 ENDIF
188 ENDIF
189 ENDDO
190C
191C Prise en compte candidats non locaux en SPMD
192C
193 DO i = nsn+1, nsn+nsnr
194 nb_nc = nb_nc + 1
195 bpn(nb_nc) = i
196 ENDDO
197C
198C En SPMD, pour inacti ou IFQ, retrouve ancienne numerotation des candidats non locaux
199C
200 IF(nspmd>1.AND.
201 + (inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0)) THEN
202 CALL spmd_oldnumcd(renum,oldnum,isznsnr,nsnrold,intheat,idt_therm,nodadt_therm)
203 END IF
204C
205 j_stok = 0
206 GOTO 200
207C=======================================================================
208 100 CONTINUE
209C=======================================================================
210C-----------------------------------------------------------
211C
212C
213C 1- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
214C
215C
216C-----------------------------------------------------------
217C
218C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
219C
220 dir = 1
221 IF(dy==dsup) THEN
222 dir = 2
223 ELSE IF(dz==dsup) THEN
224 dir = 3
225 ENDIF
226 smoins = xyzm(dir,i_add)
227 splus = xyzm(dir+3,i_add)
228 seuil =(smoins+splus)*half
229C
230C 2- DIVISER LES NOEUDS EN TWO ZONES
231C
232 nb_ncn= 0
233 nb_ncn1= 0
234 addnn= add(1,i_add)
235 IF(igap==0)THEN
236 DO i=1,nb_nc
237 j = bpn(i)
238 IF(j <= nsn) THEN
239 xx = xa(dir,nsv(j))
240 ELSE
241 xx = xrem(dir,j-nsn)
242 ENDIF
243 IF(xx < seuil) THEN
244C ON STOCKE DANS LE BAS DE LA PILE BP
245 nb_ncn1 = nb_ncn1 + 1
246 addnn = addnn + 1
247 pn(addnn) = j
248 smoins = max(smoins,xx)
249 ELSE
250C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
251 nb_ncn = nb_ncn + 1
252 bpn(nb_ncn) = j
253 splus = min(splus,xx)
254 ENDIF
255 ENDDO
256
257 ELSE !IF(IGAP == 0)
258
259 gapsmx = zero
260 DO i=1,nb_nc
261 j = bpn(i)
262 IF(j <= nsn) THEN
263 xx = xa(dir,nsv(j))
264 IF(xx < seuil) THEN
265C ON STOCKE DANS LE BAS DE LA PILE BP
266 nb_ncn1 = nb_ncn1 + 1
267 addnn = addnn + 1
268 pn(addnn) = j
269 gapsmx = max(gapsmx,gap_s(j))
270 smoins = max(smoins,xx)
271 ELSE
272C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
273 nb_ncn = nb_ncn + 1
274 bpn(nb_ncn) = j
275 bgapsmx = max(bgapsmx,gap_s(j))
276 splus = min(splus,xx)
277 ENDIF
278 ELSE
279 xx = xrem(dir,j-nsn)
280 IF(xx < seuil) THEN
281C ON STOCKE DANS LE BAS DE LA PILE BP
282 nb_ncn1 = nb_ncn1 + 1
283 addnn = addnn + 1
284 pn(addnn) = j
285 gapsmx = max(gapsmx,xrem(13,j-nsn))
286 smoins = max(smoins,xx)
287 ELSE
288C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
289 nb_ncn = nb_ncn + 1
290 bpn(nb_ncn) = j
291 bgapsmx = max(bgapsmx,xrem(13,j-nsn))
292 splus = min(splus,xx)
293 ENDIF
294 ENDIF
295 ENDDO
296
297 END IF
298C
299C 3- DIVISER LES ELEMENTS
300C
301 IF(igap==0) THEN
302 nb_ecn= 0
303 addne= add(2,i_add)
304 IF(nb_ncn1==0) THEN
305 DO i=1,nb_ec
306 ne = bpe(i)
307 xx1=xa(dir, irect(1,ne))
308 xx2=xa(dir, irect(2,ne))
309 xx3=xa(dir, irect(3,ne))
310 xx4=xa(dir, irect(4,ne))
311 xmax=max(xx1,xx2,xx3,xx4)+tzinf+curv_max(ne)
312 IF(xmax >= splus) THEN
313C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
314 nb_ecn = nb_ecn + 1
315 bpe(nb_ecn) = ne
316 ENDIF
317 ENDDO
318 ELSEIF(nb_ncn==0) THEN
319 DO i=1,nb_ec
320 ne = bpe(i)
321 xx1=xa(dir, irect(1,ne))
322 xx2=xa(dir, irect(2,ne))
323 xx3=xa(dir, irect(3,ne))
324 xx4=xa(dir, irect(4,ne))
325 xmin=min(xx1,xx2,xx3,xx4)-tzinf-curv_max(ne)
326 IF(xmin < smoins) THEN
327C ON STOCKE DANS LE BAS DE LA PILE BP
328 addne = addne + 1
329 pe(addne) = ne
330 ENDIF
331 ENDDO
332 ELSE
333 DO i=1,nb_ec
334 ne = bpe(i)
335 xx1=xa(dir, irect(1,ne))
336 xx2=xa(dir, irect(2,ne))
337 xx3=xa(dir, irect(3,ne))
338 xx4=xa(dir, irect(4,ne))
339 xmin=min(xx1,xx2,xx3,xx4)-tzinf-curv_max(ne)
340 IF(xmin < smoins) THEN
341C ON STOCKE DANS LE BAS DE LA PILE BP
342 addne = addne + 1
343 pe(addne) = ne
344 ENDIF
345 xmax=max(xx1,xx2,xx3,xx4)+tzinf+curv_max(ne)
346 IF(xmax >= splus) THEN
347C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
348 nb_ecn = nb_ecn + 1
349 bpe(nb_ecn) = ne
350 ENDIF
351 ENDDO
352 ENDIF
353C
354C Optimisation gap variable
355 ELSE
356 nb_ecn= 0
357 addne= add(2,i_add)
358 IF(nb_ncn1==0) THEN
359 DO i=1,nb_ec
360 ne = bpe(i)
361 xx1=xa(dir, irect(1,ne))
362 xx2=xa(dir, irect(2,ne))
363 xx3=xa(dir, irect(3,ne))
364 xx4=xa(dir, irect(4,ne))
365 xmax=max(xx1,xx2,xx3,xx4)
366 + +min(max(bgapsmx+gap_m(ne),gapmin),gapmax)
367 + +marge+curv_max(ne)+two*gap_sh(ne)
368 IF(xmax >= splus) THEN
369C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
370 nb_ecn = nb_ecn + 1
371 bpe(nb_ecn) = ne
372 ENDIF
373 ENDDO
374 ELSEIF(nb_ncn==0) THEN
375 DO i=1,nb_ec
376 ne = bpe(i)
377 xx1=xa(dir, irect(1,ne))
378 xx2=xa(dir, irect(2,ne))
379 xx3=xa(dir, irect(3,ne))
380 xx4=xa(dir, irect(4,ne))
381 xmin=min(xx1,xx2,xx3,xx4)
382 - -min(max(gapsmx+gap_m(ne),gapmin),gapmax)
383 - -marge-curv_max(ne)-two*gap_sh(ne)
384 IF(xmin < smoins) THEN
385C ON STOCKE DANS LE BAS DE LA PILE BP
386 addne = addne + 1
387 pe(addne) = ne
388 ENDIF
389 ENDDO
390 ELSE
391 DO i=1,nb_ec
392 ne = bpe(i)
393 xx1=xa(dir, irect(1,ne))
394 xx2=xa(dir, irect(2,ne))
395 xx3=xa(dir, irect(3,ne))
396 xx4=xa(dir, irect(4,ne))
397 xmin=min(xx1,xx2,xx3,xx4)
398 - -min(max(gapsmx+gap_m(ne),gapmin),gapmax)
399 - -marge-curv_max(ne)-two*gap_sh(ne)
400 IF(xmin < smoins) THEN
401C ON STOCKE DANS LE BAS DE LA PILE BP
402 addne = addne + 1
403 pe(addne) = ne
404 ENDIF
405 xmax=max(xx1,xx2,xx3,xx4)
406 + +min(max(bgapsmx+gap_m(ne),gapmin),gapmax)
407 + +marge+curv_max(ne)+two*gap_sh(ne)
408 IF(xmax >= splus) THEN
409C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
410 nb_ecn = nb_ecn + 1
411 bpe(nb_ecn) = ne
412 ENDIF
413 ENDDO
414C
415 ENDIF
416 ENDIF
417C
418C 4- REMPLIR LES TABLEAUX D'ADRESSES
419C
420 add(1,i_add+1) = addnn
421 add(2,i_add+1) = addne
422C-----on remplit les min de la boite suivante et les max de la courante
423C (i.e. seuil est un max pour la courante)
424C on va redescendre et donc on definit une nouvelle boite
425C on remplit les max de la nouvelle boite
426C initialises dans i7buc1 a 1.E30 comme ca on recupere
427c soit XMAX soit le max de la boite
428 xyzm(1,i_add+1) = xyzm(1,i_add)
429 xyzm(2,i_add+1) = xyzm(2,i_add)
430 xyzm(3,i_add+1) = xyzm(3,i_add)
431 xyzm(4,i_add+1) = xyzm(4,i_add)
432 xyzm(5,i_add+1) = xyzm(5,i_add)
433 xyzm(6,i_add+1) = xyzm(6,i_add)
434 xyzm(dir,i_add+1) = splus
435 xyzm(dir+3,i_add) = smoins
436C
437 nb_nc = nb_ncn
438 nb_ec = nb_ecn
439C on incremente le niveau de descente avant de sortir
440 i_add = i_add + 1
441 IF(i_add+1>=i_add_max) THEN
442 i_mem = 3
443 RETURN
444 ENDIF
445C=======================================================================
446 200 CONTINUE
447C=======================================================================
448C-----------------------------------------------------------
449C
450C
451C 2- TEST ARRET = BOITE VIDE
452C BOITE TROP PETITE
453C BOITE NE CONTENANT QU'ONE NOEUD
454C PLUS DE MEMOIRE DISPONIBLE
455C
456C-------------------TEST SUR MEMOIRE DEPASSEE------------
457C
458 IF(add(2,i_add)+nb_ec>maxsiz) THEN
459C PLUS DE PLACE DANS LA PILE DES ELEMENTS BOITES TROP PETITES
460 i_mem = 1
461 RETURN
462 ENDIF
463C
464C--------------------TEST SUR BOITE VIDES--------------
465C
466 IF(nb_ec/=0.AND.nb_nc/=0) THEN
467C
468 dx = xyzm(4,i_add) - xyzm(1,i_add)
469 dy = xyzm(5,i_add) - xyzm(2,i_add)
470 dz = xyzm(6,i_add) - xyzm(3,i_add)
471 dsup= max(dx,dy,dz)
472C
473C-------------------TEST SUR FIN DE BRANCHE ------------
474C 1- STOCKAGE DU OU DES NOEUD CANDIDAT ET DES ELTS CORRESP.
475C VIRER LES INUTILES
476C
477C NCAND_PROV=NB_EC*NB_NC
478C NCAND_PROV negatif qd NB_EC*NB_NC > 2e31
479C
480 IF(nb_ec+nb_nc<=nvecsz) THEN
481 ncand_prov = nb_ec*nb_nc
482 ELSE
483 ncand_prov = nvecsz+1
484 ENDIF
485
486 IF(dsup<minbox.OR.(nb_nc<=nb_n_b)
487 & .OR.(ncand_prov<=nvecsz)) THEN
488 ncand_prov = nb_ec*nb_nc
489 DO k=1,ncand_prov,nvsiz
490 IF(igap==0) THEN
491 DO l=k,min(k-1+nvsiz,ncand_prov)
492 i = 1+(l-1)/nb_nc
493 j = l-(i-1)*nb_nc
494 ne = bpe(i)
495 n1=irect(1,ne)
496 n2=irect(2,ne)
497 n3=irect(3,ne)
498 n4=irect(4,ne)
499 xx1=xa(1, n1)
500 xx2=xa(1, n2)
501 xx3=xa(1, n3)
502 xx4=xa(1, n4)
503 xmax=max(xx1,xx2,xx3,xx4)+tzinf+curv_max(ne)
504 xmin=min(xx1,xx2,xx3,xx4)-tzinf-curv_max(ne)
505 xx1=xa(2, n1)
506 xx2=xa(2, n2)
507 xx3=xa(2, n3)
508 xx4=xa(2, n4)
509 ymax=max(xx1,xx2,xx3,xx4)+tzinf+curv_max(ne)
510 ymin=min(xx1,xx2,xx3,xx4)-tzinf-curv_max(ne)
511 xx1=xa(3, n1)
512 xx2=xa(3, n2)
513 xx3=xa(3, n3)
514 xx4=xa(3, n4)
515 zmax=max(xx1,xx2,xx3,xx4)+tzinf+curv_max(ne)
516 zmin=min(xx1,xx2,xx3,xx4)-tzinf-curv_max(ne)
517 jj = bpn(j)
518 IF(jj<=nsn) THEN
519 nn=nsv(jj)
520 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4.AND.
521 & xa(1,nn)>xmin.AND.xa(1,nn)<xmax.AND.
522 & xa(2,nn)>ymin.AND.xa(2,nn)<ymax.AND.
523 & xa(3,nn)>zmin.AND.xa(3,nn)<zmax ) THEN
524
525 j_stok = j_stok + 1
526 prov_n(j_stok) = jj
527 prov_e(j_stok) = ne
528 ENDIF
529 ELSE
530 ii = jj-nsn
531 IF(xrem(1,ii)>xmin.AND.
532 & xrem(1,ii)<xmax.AND.
533 & xrem(2,ii)>ymin.AND.
534 & xrem(2,ii)<ymax.AND.
535 & xrem(3,ii)>zmin.AND.
536 & xrem(3,ii)<zmax ) THEN
537 j_stok = j_stok + 1
538 prov_n(j_stok) = jj
539 prov_e(j_stok) = ne
540 ENDIF
541 ENDIF
542 ENDDO
543 ELSE
544 DO l=k,min(k-1+nvsiz,ncand_prov)
545 i = 1+(l-1)/nb_nc
546 j = l-(i-1)*nb_nc
547 ne = bpe(i)
548 n1=irect(1,ne)
549 n2=irect(2,ne)
550 n3=irect(3,ne)
551 n4=irect(4,ne)
552 xx1=xa(1, n1)
553 xx2=xa(1, n2)
554 xx3=xa(1, n3)
555 xx4=xa(1, n4)
556 yy1=xa(2, n1)
557 yy2=xa(2, n2)
558 yy3=xa(2, n3)
559 yy4=xa(2, n4)
560 zz1=xa(3, n1)
561 zz2=xa(3, n2)
562 zz3=xa(3, n3)
563 zz4=xa(3, n4)
564 jj = bpn(j)
565 IF(jj<=nsn) THEN
566 tz=max(min(gap_s(jj)+gap_m(ne),gapmax),gapmin)
567 + +marge+curv_max(ne)+two*gap_sh(ne)
568 xmax=max(xx1,xx2,xx3,xx4)+tz
569 xmin=min(xx1,xx2,xx3,xx4)-tz
570 ymax=max(yy1,yy2,yy3,yy4)+tz
571 ymin=min(yy1,yy2,yy3,yy4)-tz
572 zmax=max(zz1,zz2,zz3,zz4)+tz
573 zmin=min(zz1,zz2,zz3,zz4)-tz
574 nn=nsv(jj)
575 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4.AND.
576 & xa(1,nn)>xmin.AND.xa(1,nn)<xmax.AND.
577 & xa(2,nn)>ymin.AND.xa(2,nn)<ymax.AND.
578 & xa(3,nn)>zmin.AND.xa(3,nn)<zmax ) THEN
579 j_stok = j_stok + 1
580 prov_n(j_stok) = jj
581 prov_e(j_stok) = ne
582 ENDIF
583 ELSE
584 ii = jj-nsn
585 tz=max(min(xrem(13,ii)+gap_m(ne),gapmax),gapmin)
586 + +marge+curv_max(ne)+two*gap_sh(ne)
587 xmax=max(xx1,xx2,xx3,xx4)+tz
588 xmin=min(xx1,xx2,xx3,xx4)-tz
589 ymax=max(yy1,yy2,yy3,yy4)+tz
590 ymin=min(yy1,yy2,yy3,yy4)-tz
591 zmax=max(zz1,zz2,zz3,zz4)+tz
592 zmin=min(zz1,zz2,zz3,zz4)-tz
593 IF(xrem(1,ii)>xmin.AND.
594 & xrem(1,ii)<xmax.AND.
595 & xrem(2,ii)>ymin.AND.
596 & xrem(2,ii)<ymax.AND.
597 & xrem(3,ii)>zmin.AND.
598 & xrem(3,ii)<zmax ) THEN
599 j_stok = j_stok + 1
600 prov_n(j_stok) = jj
601 prov_e(j_stok) = ne
602 ENDIF
603 ENDIF
604 ENDDO
605 END IF
606 IF(j_stok>=nvsiz)THEN
607 CALL i20sto(
608 1 nvsiz,irect ,xa ,nsv ,ii_stok,
609 2 cand_n,cand_e ,mulnsn,noint ,marge ,
610 3 i_mem ,prov_n ,prov_e,eshift,inacti ,
611 4 ifq ,cand_a ,cand_p,ifpen ,nsn ,
612 5 oldnum,nsnrold,igap ,gap ,gap_s ,
613 6 gap_m ,gapmin ,gapmax,curv_max,nin ,
614 7 gap_sh,nbinflg,mbinflg,isym )
615
616 IF(i_mem==2)RETURN
617 j_stok = j_stok-nvsiz
618#include "vectorize.inc"
619 DO j=1,j_stok
620 prov_n(j) = prov_n(j+nvsiz)
621 prov_e(j) = prov_e(j+nvsiz)
622 ENDDO
623 ENDIF
624 ENDDO
625 ELSE
626C=======================================================================
627 GOTO 100
628C=======================================================================
629 ENDIF
630 ENDIF
631C-------------------------------------------------------------------------
632C BOITE VIDE OU
633C FIN DE BRANCHE
634C on decremente le niveau de descente avant de recommencer
635C-------------------------------------------------------------------------
636 i_add = i_add - 1
637 IF (i_add/=0) THEN
638C-------------------------------------------------------------------------
639C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
640C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
641C-------------------------------------------------------------------------
642 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
643C=======================================================================
644 GOTO 200
645C=======================================================================
646 ENDIF
647C-------------------------------------------------------------------------
648C FIN DU TRI
649C-------------------------------------------------------------------------
650 IF(j_stok/=0)CALL i20sto(
651 1 j_stok,irect ,xa ,nsv ,ii_stok,
652 2 cand_n,cand_e ,mulnsn,noint ,marge ,
653 3 i_mem ,prov_n ,prov_e,eshift,inacti ,
654 4 ifq ,cand_a ,cand_p,ifpen ,nsn ,
655 5 oldnum,nsnrold,igap ,gap ,gap_s ,
656 6 gap_m ,gapmin ,gapmax,curv_max,nin ,
657 7 gap_sh,nbinflg,mbinflg,isym)
658C-------------------------------------------------------------------------
659 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i20sto
subroutine i20sto(j_stok, irect, xa, nsv, ii_stok, cand_n, cand_e, mulnsn, noint, marge, i_mem, prov_n, prov_e, eshift, inacti, ifq, cand_a, cand_p, ifpen, nsn, oldnum, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, curv_max, nin, gap_sh, nbinflg, mbinflg, isym)
Definition i20sto.F:42
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
spmd_oldnumcd
subroutine spmd_oldnumcd(renum, oldnum, nsnr, nsnrold, intheat, idt_therm, nodadt_therm)
Definition spmd_i7tool.F:38
i7dstk
subroutine i7dstk(i_add, nb_nc, nb_ec, add, bpn, pn, bpe, pe)
Definition i7dstk.F:34

◆ i20tri_edge()

subroutine i20tri_edge ( integer, dimension(2,*) add,
xa,
integer, dimension(*) nlg,
integer, dimension(2,*) ixlins,
integer, dimension(2,*) ixlinm,
integer nlinma,
integer nlinsr,
xyzm,
integer i_add,
integer maxsiz,
integer ii_stoke,
integer, dimension(*) cand_s,
integer, dimension(*) cand_m,
integer nsn4,
integer noint,
tzinf,
maxbox,
minbox,
integer i_mem,
integer nb_n_b,
integer i_add_max,
integer eshift,
integer, dimension(*) addcm,
integer, dimension(2,*) chaine,
integer nlinsa,
integer, dimension(*) itab,
integer, dimension(2,*) nb_old,
stfs,
stfm,
integer iauto,
integer nin )

Definition at line 672 of file i20tri.F.

680C============================================================================
681C M o d u l e s
682C-----------------------------------------------
683 USE tri7box
684C-----------------------------------------------
685C I m p l i c i t T Y p e s
686C-----------------------------------------------
687#include "implicit_f.inc"
688#include "r4r8_p.inc"
689C-----------------------------------------------
690C G l o b a l P a r a m e t e r s
691C-----------------------------------------------
692#include "mvsiz_p.inc"
693C-----------------------------------------------
694C C o m m o n B l o c k s
695C-----------------------------------------------
696#include "param_c.inc"
697C-----------------------------------------------
698C ROLE DE LA ROUTINE:
699C ===================
700C CLASSE LES ELETS DE BPE ET LES NOEUDS DE BPN EN TWO ZONES
701C > OU < A UNE FRONTIERE ICI DETERMINEE ET SORT LE TOUT
702C DANS bpe,hpe, et bpn,hpn
703C-----------------------------------------------
704C D u m m Y A r g u m e n t s
705C
706C NOM DESCRIPTION E/S
707C
708C BPE TABLEAU DES FACETTES A TRIER => Local
709C ET DU RESULTAT COTE MAX
710C PE TABLEAU DES FACETTES => Local
711C RESULTAT COTE MIN
712C BPN TABLEAU DES NOEUDS A TRIER => Local
713C ET DU RESULTAT COTE MAX
714C PN TABLEAU DES NOEUDS => Local
715C RESULTAT COTE MIN
716C ADD(2,*) TABLEAU DES ADRESSES E/S
717C 1.......ADRESSES NOEUDS
718C 2.......ADRESSES ELEMENTS
719C ZYZM(6,*) TABLEAU DES XYZMIN E/S
720C 1.......XMIN BOITE
721C 2.......YMIN BOITE
722C 3.......ZMIN BOITE
723C 4.......XMAX BOITE
724C 5.......YMAX BOITE
725C 6.......ZMAX BOITE
726C IXLINM(2,*) TABLEAU DES CONEC E
727C IXLINS(2,*) TABLEAU DES CONEC E
728C X(3,*) COORDONNEES NODALES E
729C NB_NC NOMBRE DE NOEUDS CANDIDATS => Local
730C NB_EC NOMBRE D'ELTS CANDIDATS => Local
731C I_ADD POSITION DANS LE TAB DES ADRESSES E/S
732C XMAX plus grande abcisse existante E
733C XMAX plus grande ordonn. existante E
734C XMAX plus grande cote existante E
735C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
736C I_STOK niveau de stockage des couples
737C candidats impact E/S
738C ADNSTK adresse courante dans la boite des noeuds
739C CAND_S boites resultats noeuds
740C ADESTK adresse courante dans la boite des elements
741C CAND_M adresses des boites resultat elements
742C NSN4 4*NSN TAILLE MAX ADMISE MAINTENANT POUR LES
743C COUPLES NOEUDS,ELT CANDIDATS
744C NOINT NUMERO USER DE L'INTERFACE
745C TZINF TAILLE ZONE INFLUENCE
746C MAXBOX TAILLE MAX BUCKET
747C MINBOX TAILLE MIN BUCKET
748C
749C PROV_S CAND_S provisoire (variable static dans i7tri)
750C PROV_M CAND_M provisoire (variable static dans i7tri)
751C-----------------------------------------------
752C D u m m Y A r g u m e n t s
753C-----------------------------------------------
754 INTEGER NLINMA,NLINSR,I_ADD,MAXSIZ,I_MEM,ESHIFT,NLINSA,
755 . NSN4,NB_N_B,NOINT,I_ADD_MAX,IAUTO ,NIN,
756 . ADD(2,*),IXLINS(2,*),IXLINM(2,*),
757 . CAND_S(*),CAND_M(*),ADDCM(*),CHAINE(2,*),ITAB(*),
758 . NB_OLD(2,*),NLG(*),II_STOKE
759C REAL
760 my_real
761 . xa(3,*),xyzm(6,*),stfs(*),stfm(*),
762 . tzinf,maxbox,minbox
763C-----------------------------------------------
764C L o c a l V a r i a b l e s
765C-----------------------------------------------
766 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NN1,NN2,
767 . N1,N2,N3,N4,NN,NE,K_STOK,K,L,NCAND_PROV,J_STOK,NI,
768 . ISTOP,NB_ECN1,PROV_S(2*MVSIZ),PROV_M(2*MVSIZ),
769 . NB_NC_OLD, NB_EC_OLD, NB_NC, NB_EC,JJ,KK,
770C BPE : utilise sur NLINMA et non NLINMA + 100
771C BPN : utilise sur NLINSA et non NLINSA + 100
772 . BPE(NLINMA+100),PE(MAXSIZ),BPN(NLINSA+NLINSR+100),
773 . PN(MAXSIZ)
774C REAL
775 my_real
776 . dx,dy,dz,dsup,seuil,seuils,seuili, xx1, xx2, xx3, xx4,
777 . xmin, xmax,ymin, ymax,zmin, zmax, xx,yy,zz,
778 . xmins,ymins,zmins,xmaxs,ymaxs,zmaxs,
779 . yy1,yy2,zz1,zz2,dmx,dmy,dmz,
780 . xy1,xy2,xz1,xz2,ximin,ximax,xjmin,xjmax,xkmin,xkmax,
781 . timin,timax,tjmin,tjmax,tkmin,tkmax,tsmin,tsmax,
782 . txmin, txmax,tymin, tymax,tzmin, tzmax
783 EXTERNAL i11insid
784 LOGICAL I11INSID
785C-----------------------------------------------
786C
787C Phase initiale de construction de BPE et BPN deplacee de I11BUCE => I11TRI
788C
789C
790C recuperation des bornes du domaine
791C
792 xmin = xyzm(1,i_add)
793 ymin = xyzm(2,i_add)
794 zmin = xyzm(3,i_add)
795 xmax = xyzm(4,i_add)
796 ymax = xyzm(5,i_add)
797 zmax = xyzm(6,i_add)
798
799C Copie des nos de segments et de noeuds dans BPE et BPN
800
801 nb_ec = 0
802 DO i=1,nlinma
803C on ne retient plus les facettes detruites
804 IF(stfm(i)/=zero)THEN
805 nb_ec = nb_ec + 1
806 bpe(nb_ec) = i
807 END IF
808 ENDDO
809C
810C Optimisation // recherche les noeuds compris dans xmin xmax des
811C elements du processeur
812C
813 nb_nc = 0
814 DO i=1,nlinsa
815C on ne retient pas les facettes detruites
816 IF(stfs(i)/=zero)THEN
817 n1=ixlins(1,i)
818 n2=ixlins(2,i)
819 xmins = min(xa(1,n1),xa(1,n2))
820 ymins = min(xa(2,n1),xa(2,n2))
821 zmins = min(xa(3,n1),xa(3,n2))
822 xmaxs = max(xa(1,n1),xa(1,n2))
823 ymaxs = max(xa(2,n1),xa(2,n2))
824 zmaxs = max(xa(3,n1),xa(3,n2))
825 IF(xmaxs>=xmin.AND.xmins<=xmax.AND.
826 . ymaxs>=ymin.AND.ymins<=ymax.AND.
827 . zmaxs>=zmin.AND.zmins<=zmax)THEN
828 nb_nc = nb_nc + 1
829 bpn(nb_nc) = i
830 ENDIF
831 END IF
832 ENDDO
833C
834C Prise en compte candidats non locaux en SPMD
835C
836 DO i = nlinsa+1, nlinsa+nlinsr
837 nb_nc = nb_nc + 1
838 bpn(nb_nc) = i
839 ENDDO
840C
841C GOTO 200:
842C INTERFACE AVEC 1 SEGMENT ET 1 NOEUD + INITIALISATION DX DY DZ
843C
844 j_stok = 0
845 istop = 0
846 nb_nc_old = 0
847 nb_ec_old = 0
848C
849 nb_old(1,i_add) = 0
850 nb_old(2,i_add) = 0
851
852 dx = xyzm(4,i_add) - xyzm(1,i_add)
853 dy = xyzm(5,i_add) - xyzm(2,i_add)
854 dz = xyzm(6,i_add) - xyzm(3,i_add)
855 dsup= max(dx,dy,dz)
856 GOTO 200
857C=======================================================================
858 100 CONTINUE
859C=======================================================================
860C-----------------------------------------------------------
861C
862C
863C 1- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
864C
865C
866C-----------------------------------------------------------
867C
868C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
869C
870 xmin = 1.e30
871 xmax = -1.e30
872
873 ymin = 1.e30
874 ymax = -1.e30
875
876 zmin = 1.e30
877 zmax = -1.e30
878
879 DO i=1,nb_ec
880 ne = bpe(i)
881 xx1=xa(1, ixlinm(1,ne))
882 xx2=xa(1, ixlinm(2,ne))
883 xmin=min(xmin,xx1,xx2)
884 xmax=max(xmax,xx1,xx2)
885
886 yy1=xa(2, ixlinm(1,ne))
887 yy2=xa(2, ixlinm(2,ne))
888 ymin=min(ymin,yy1,yy2)
889 ymax=max(ymax,yy1,yy2)
890
891 zz1=xa(3, ixlinm(1,ne))
892 zz2=xa(3, ixlinm(2,ne))
893 zmin=min(zmin,zz1,zz2)
894 zmax=max(zmax,zz1,zz2)
895 ENDDO
896
897c reduction de la taille de boite:
898c on garde une marge de TZINF quand on reduit la taille de boite
899c pour eviter d'oublier des seconds
900c
901c | Tzinf Tzinf |Tzinf
902c | <-----x-----> |<---->
903c | .............................|............Tymax ^
904c | . | . |
905c | . #################|#####.## | Tzinf
906c | . #////////////////|/////./# |
907c -----+----------------------------------+---------Ymax= v
908c | . |\\\\\#/// espace //|/////./# Ymax_old
909c | . |\\\\\#/// occupe par//|/////./#
910c | . |\\\\\#///les mains//|/////./#
911c | . |\\\\\#////////////////|/////./#
912c | . |\\\\\#////////////////|/////./#
913c | . |\\\\\#################|#####.## ^
914c | . |\\\ espace retenu \\| . |
915c | . |\\\pour les seconds\\| . | Tzinf
916c | . |\\\‍(nouvelle boite) \\| . |
917c | . +----------------------| ....Ymin x
918c | . | . |
919c | . (boite de recherche main) . | Tzinf
920c | . | . |
921c | .............................|.........Tymin v
922c | . . | .
923c | . . | .
924c | (ancienne boite) | .
925c | . . | .
926c | . . | .
927c -----+----------------------------------+---------Ymin_old
928c | . . | .
929c | . . Xmax= .
930c Xmin_old . . Xmax_old .
931c . Xmin Txmax
932c Txmin
933c
934c si la boite est reduite du cote de Xmin on pourrait utiliser:
935c Txmin = Xmin avec Xmin = min(Xmain)-Tzinf > Xmin_old
936c
937c mais en utilisant:
938c Txmin = Xmin-Tzinf (= min(Xmain) - 2*Tzinf)
939c on ne penalise pas I11INSIND
940c (il n'y a pas de main dans la zone surestimee)
941c et le calcul de Xmin, Txmin ... est plus simple
942
943
944 xmin = max(xmin - tzinf , xyzm(1,i_add))
945 ymin = max(ymin - tzinf , xyzm(2,i_add))
946 zmin = max(zmin - tzinf , xyzm(3,i_add))
947 xmax = min(xmax + tzinf , xyzm(4,i_add))
948 ymax = min(ymax + tzinf , xyzm(5,i_add))
949 zmax = min(zmax + tzinf , xyzm(6,i_add))
950
951 txmin = xmin - tzinf
952 tymin = ymin - tzinf
953 tzmin = zmin - tzinf
954 txmax = xmax + tzinf
955 tymax = ymax + tzinf
956 tzmax = zmax + tzinf
957
958 dmx = xmax-xmin
959 dmy = ymax-ymin
960 dmz = zmax-zmin
961
962 dsup = max(dmx,dmy,dmz)
963
964 IF(dmy==dsup) THEN
965 dir = 2
966 jj = 3
967 kk = 1
968 seuil = (ymin+ymax)*0.5
969 ximin = ymin
970 xjmin = zmin
971 xkmin = xmin
972 ximax = ymax
973 xjmax = zmax
974 xkmax = xmax
975 timin = tymin
976 tjmin = tzmin
977 tkmin = txmin
978 timax = tymax
979 tjmax = tzmax
980 tkmax = txmax
981 ELSE IF(dmz==dsup) THEN
982 dir = 3
983 jj = 1
984 kk = 2
985 seuil = (zmin+zmax)*0.5
986 ximin = zmin
987 xjmin = xmin
988 xkmin = ymin
989 ximax = zmax
990 xjmax = xmax
991 xkmax = ymax
992 timin = tzmin
993 tjmin = txmin
994 tkmin = tymin
995 timax = tzmax
996 tjmax = txmax
997 tkmax = tymax
998 ELSE
999 dir = 1
1000 jj = 2
1001 kk = 3
1002 seuil = (xmin+xmax)*0.5
1003 ximin = xmin
1004 xjmin = ymin
1005 xkmin = zmin
1006 ximax = xmax
1007 xjmax = ymax
1008 xkmax = zmax
1009 timin = txmin
1010 tjmin = tymin
1011 tkmin = tzmin
1012 timax = txmax
1013 tjmax = tymax
1014 tkmax = tzmax
1015 ENDIF
1016
1017 tsmin = seuil - tzinf
1018 tsmax = seuil + tzinf
1019
1020C
1021C 2- DIVISER LES SECONDS EN TWO ZONES
1022C
1023
1024c +-----------+-----------+--Xjmax
1025c | | |
1026c | | |
1027c | | |
1028c | | |
1029c +-----------+-----------+--Xjmin
1030c | | |
1031c Ximin Seuil Ximax
1032c
1033
1034
1035
1036 nb_ncn= 0
1037 nb_ncn1= 0
1038 addnn= add(1,i_add)
1039 DO i=1,nb_nc
1040 nn = bpn(i)
1041 IF(nn<=nlinsa) THEN
1042 xx1=xa(dir,ixlins(1,nn))
1043 xx2=xa(dir,ixlins(2,nn))
1044 xy1=xa(jj, ixlins(1,nn))
1045 xy2=xa(jj, ixlins(2,nn))
1046 xz1=xa(kk, ixlins(1,nn))
1047 xz2=xa(kk, ixlins(2,nn))
1048 ELSE
1049 ni = nn-nlinsa
1050 xx1=xrem(dir+1,ni)
1051 xx2=xrem(dir+9,ni)
1052 xy1=xrem(jj+1 ,ni)
1053 xy2=xrem(jj+9 ,ni)
1054 xz1=xrem(kk+1 ,ni)
1055 xz2=xrem(kk+9 ,ni)
1056 END IF
1057 xmax=max(xx1,xx2)
1058 xmin=min(xx1,xx2)
1059 IF(xmin<seuil.AND.xmax>=ximin) THEN
1060 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1061 . ximin,seuil,xjmin,xjmax,xkmin,xkmax)) THEN
1062C ON STOCKE DANS LE BAS DE LA PILE BP
1063 nb_ncn1 = nb_ncn1 + 1
1064 addnn = addnn + 1
1065 pn(addnn) = nn
1066 END IF
1067 END IF
1068 IF(xmax>=seuil.AND.xmin<=ximax) THEN
1069 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1070 . seuil,ximax,xjmin,xjmax,xkmin,xkmax)) THEN
1071C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
1072 nb_ncn = nb_ncn + 1
1073 bpn(nb_ncn) = nn
1074 ENDIF
1075 ENDIF
1076 ENDDO
1077C
1078C 3- DIVISER LES MAINS
1079C
1080
1081c Tzinf Tzinf Tzinf Tzinf
1082c <----> <----x----> <---->
1083c ............,.,.,.,.,..,,,,,,,,,,,,--Tjmax ^
1084c . , . , | Tzinf
1085c . , . , |
1086c . +------,----+----.------+ ,--Xjmax v
1087c . | , | . | ,
1088c . | , | . | ,
1089c . | , | . | ,
1090c . | , | . | ,
1091c . +------,----+----.------+ ,--Xjmin ^
1092c . , . , | Tzinf
1093c . , . , |
1094c ............,.,.,.,.,..,,,,,,,,,,,,--Tjmin v
1095c | | | | | | |
1096c | Ximin | Seuil | Ximax |
1097c Timin Tsmin Tsmax Timax
1098c
1099c si la boite a ete reduite(Cf 1)
1100c il est possible que Timin=Ximin ...
1101
1102
1103 nb_ecn= 0
1104 nb_ecn1= 0
1105 addne= add(2,i_add)
1106 IF(nb_ncn1==0) THEN
1107 DO i=1,nb_ec
1108 ne = bpe(i)
1109 xx1=xa(dir, ixlinm(1,ne))
1110 xx2=xa(dir, ixlinm(2,ne))
1111 IF(max(xx1,xx2)>=tsmin) THEN
1112 xy1=xa(jj, ixlinm(1,ne))
1113 xy2=xa(jj, ixlinm(2,ne))
1114 xz1=xa(kk, ixlinm(1,ne))
1115 xz2=xa(kk, ixlinm(2,ne))
1116 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1117 . tsmin,timax,tjmin,tjmax,tkmin,tkmax)) THEN
1118C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
1119 nb_ecn = nb_ecn + 1
1120 bpe(nb_ecn) = ne
1121 ENDIF
1122 ENDIF
1123 ENDDO
1124 ELSEIF(nb_ncn==0) THEN
1125 DO i=1,nb_ec
1126 ne = bpe(i)
1127 xx1=xa(dir, ixlinm(1,ne))
1128 xx2=xa(dir, ixlinm(2,ne))
1129 IF(min(xx1,xx2)<tsmax) THEN
1130 xy1=xa(jj, ixlinm(1,ne))
1131 xy2=xa(jj, ixlinm(2,ne))
1132 xz1=xa(kk, ixlinm(1,ne))
1133 xz2=xa(kk, ixlinm(2,ne))
1134 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1135 . timin,tsmax,tjmin,tjmax,tkmin,tkmax)) THEN
1136C ON STOCKE DANS LE BAS DE LA PILE BP
1137 addne = addne + 1
1138 nb_ecn1= nb_ecn1 + 1
1139 pe(addne) = ne
1140 ENDIF
1141 ENDIF
1142 ENDDO
1143 ELSE
1144 DO i=1,nb_ec
1145 ne = bpe(i)
1146 xx1=xa(dir, ixlinm(1,ne))
1147 xx2=xa(dir, ixlinm(2,ne))
1148 xy1=xa(jj, ixlinm(1,ne))
1149 xy2=xa(jj, ixlinm(2,ne))
1150 xz1=xa(kk, ixlinm(1,ne))
1151 xz2=xa(kk, ixlinm(2,ne))
1152 IF(min(xx1,xx2)<tsmax) THEN
1153 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1154 . timin,tsmax,tjmin,tjmax,tkmin,tkmax)) THEN
1155C ON STOCKE DANS LE BAS DE LA PILE BP
1156 addne = addne + 1
1157 nb_ecn1= nb_ecn1 + 1
1158 pe(addne) = ne
1159 ENDIF
1160 ENDIF
1161 IF(max(xx1,xx2)>=tsmin) THEN
1162 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1163 . tsmin,timax,tjmin,tjmax,tkmin,tkmax)) THEN
1164C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
1165 nb_ecn = nb_ecn + 1
1166 bpe(nb_ecn) = ne
1167 ENDIF
1168 ENDIF
1169 ENDDO
1170 ENDIF
1171C
1172C 4- REMPLIR LES TABLEAUX D'ADRESSES
1173C
1174 add(1,i_add+1) = addnn
1175 add(2,i_add+1) = addne
1176C-----on remplit les min de la boite suivante et les max de la courante
1177C (i.e. seuil est un max pour la courante)
1178C on va redescendre et donc on definit une nouvelle boite
1179C on remplit les max de la nouvelle boite
1180C initialises dans i7buc1 a 1.E30 comme ca on recupere
1181c soit XMAX soit le max de la boite
1182 xyzm(1,i_add+1) = xyzm(1,i_add)
1183 xyzm(2,i_add+1) = xyzm(2,i_add)
1184 xyzm(3,i_add+1) = xyzm(3,i_add)
1185 xyzm(4,i_add+1) = xyzm(4,i_add)
1186 xyzm(5,i_add+1) = xyzm(5,i_add)
1187 xyzm(6,i_add+1) = xyzm(6,i_add)
1188 xyzm(dir ,i_add) = ximin
1189 xyzm(dir+3,i_add) = seuil
1190 xyzm(dir ,i_add+1) = seuil
1191 xyzm(dir+3,i_add+1) = ximax
1192C
1193 nb_old(1,i_add)=nb_nc
1194 nb_old(2,i_add)=nb_ec
1195 nb_old(1,i_add+1)=nb_nc
1196 nb_old(2,i_add+1)=nb_ec
1197C
1198 nb_nc = nb_ncn
1199 nb_ec = nb_ecn
1200C on incremente le niveau de descente avant de sortir
1201 i_add = i_add + 1
1202 IF(i_add+1>=i_add_max) THEN
1203 i_mem = 3
1204 RETURN
1205 ENDIF
1206C=======================================================================
1207 200 CONTINUE
1208C=======================================================================
1209C-----------------------------------------------------------
1210C
1211C
1212C 2- TEST ARRET = BOITE VIDE
1213C BOITE TROP PETITE
1214C BOITE NE CONTENANT QU'ONE NOEUD
1215C PLUS DE MEMOIRE DISPONIBLE
1216C LE DECOUPAGE NE REDUIT PAS LES CANDIDATS
1217C
1218C-------------------TEST SUR MEMOIRE DEPASSEE------------
1219C
1220 IF(add(1,i_add)+nb_nc>maxsiz) THEN
1221C PLUS DE PLACE DANS LA PILE DES COTES SECONDS BOITES TROP PETITES
1222 i_mem = 1
1223 RETURN
1224 ENDIF
1225 IF(add(2,i_add)+nb_ec>maxsiz) THEN
1226C PLUS DE PLACE DANS LA PILE DES COTES MAINS BOITES TROP PETITES
1227 i_mem = 1
1228 RETURN
1229 ENDIF
1230C
1231C--------------------TEST SUR BOITE VIDES--------------
1232C
1233 IF(nb_ec/=0.AND.nb_nc/=0) THEN
1234C
1235 dx = xyzm(4,i_add) - xyzm(1,i_add)
1236 dy = xyzm(5,i_add) - xyzm(2,i_add)
1237 dz = xyzm(6,i_add) - xyzm(3,i_add)
1238 dsup= max(dx,dy,dz)
1239C
1240C-------------------TEST SUR FIN DE BRANCHE ------------
1241C 1- STOCKAGE DU OU DES NOEUD CANDIDAT ET DES ELTS CORRESP.
1242C VIRER LES INUTILES
1243C
1244 IF(nb_ec+nb_nc<=128) THEN
1245 ncand_prov = nb_ec*nb_nc
1246 ELSE
1247 ncand_prov = 129
1248 ENDIF
1249C
1250 nb_nc_old = nb_old(1,i_add)
1251 nb_ec_old = nb_old(2,i_add)
1252
1253 IF(dsup<minbox.OR.
1254 . nb_nc<=nb_n_b.OR.nb_ec<=nb_n_b.OR.
1255 . ncand_prov<=128.OR.(nb_ec==nb_ec_old
1256 . .AND.nb_nc==nb_nc_old)) THEN
1257C
1258 ncand_prov = nb_ec*nb_nc
1259 DO k=1,ncand_prov,nvsiz
1260 DO l=k,min(k-1+nvsiz,ncand_prov)
1261 i = 1+(l-1)/nb_nc
1262 j = l-(i-1)*nb_nc
1263 ne = bpe(i)
1264 nn = bpn(j)
1265 n1=ixlinm(1,ne)
1266 n2=ixlinm(2,ne)
1267 IF(nn<=nlinsa) THEN
1268 nn1=ixlins(1,nn)
1269 nn2=ixlins(2,nn)
1270 IF(iauto==0 .OR. itab(nlg(n1))>itab(nlg(nn1)) )THEN
1271 IF(nn1/=n1.AND.nn1/=n2.AND.
1272 . nn2/=n1.AND.nn2/=n2) THEN
1273 j_stok = j_stok + 1
1274 prov_s(j_stok) = nn
1275 prov_m(j_stok) = ne
1276 ENDIF
1277 ENDIF
1278 ELSE
1279 ni = nn-nlinsa
1280 IF(ir4r8 == 2) THEN
1281 nn1 = nint(xrem(9,ni))
1282 nn2 = nint(xrem(17,ni))
1283 ELSE
1284 nn1 = irem(1,ni)
1285 nn2 = irem(2,ni)
1286 END IF
1287 n1 = itab(nlg(n1))
1288 n2 = itab(nlg(n2))
1289 IF(iauto==0 .OR. n1>nn1 )THEN
1290 IF(nn1/=n1.AND.nn1/=n2.AND.
1291 . nn2/=n1.AND.nn2/=n2) THEN
1292 j_stok = j_stok + 1
1293 prov_s(j_stok) = nn
1294 prov_m(j_stok) = ne
1295 ENDIF
1296 ENDIF
1297 END IF
1298 ENDDO
1299 IF(j_stok>=nvsiz)THEN
1300 CALL i20sto_edge(
1301 1 nvsiz,ixlins,ixlinm,xa ,ii_stoke,
1302 2 cand_s,cand_m,nsn4 ,noint ,tzinf ,
1303 3 i_mem ,prov_s,prov_m,eshift,addcm ,
1304 4 chaine,nlinsa ,nin )
1305 IF(i_mem==2)RETURN
1306 j_stok = j_stok-nvsiz
1307#include "vectorize.inc"
1308 DO j=1,j_stok
1309 prov_s(j) = prov_s(j+nvsiz)
1310 prov_m(j) = prov_m(j+nvsiz)
1311 ENDDO
1312 ENDIF
1313 ENDDO
1314 ELSE
1315C=======================================================================
1316 GOTO 100
1317C=======================================================================
1318 ENDIF
1319 ENDIF
1320C-------------------------------------------------------------------------
1321C BOITE VIDE OU
1322C FIN DE BRANCHE
1323C on decremente le niveau de descente avant de recommencer
1324C-------------------------------------------------------------------------
1325 i_add = i_add - 1
1326 IF (i_add/=0) THEN
1327C-------------------------------------------------------------------------
1328C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
1329C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
1330C-------------------------------------------------------------------------
1331 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
1332C=======================================================================
1333 GOTO 200
1334C=======================================================================
1335 ENDIF
1336C-------------------------------------------------------------------------
1337C FIN DU TRI
1338C-------------------------------------------------------------------------
1339 IF(j_stok/=0)CALL i20sto_edge(
1340 1 j_stok,ixlins,ixlinm,xa ,ii_stoke,
1341 2 cand_s,cand_m,nsn4 ,noint ,tzinf ,
1342 3 i_mem ,prov_s,prov_m,eshift,addcm ,
1343 4 chaine,nlinsa ,nin )
1344C-------------------------------------------------------------------------
1345 RETURN
i11insid
logical function i11insid(x1, x2, y1, y2, z1, z2, xmin, xmax, ymin, ymax, zmin, zmax)
Definition i11tri.F:741
i20sto_edge
subroutine i20sto_edge(j_stok, ixlins, ixlinm, xa, ii_stoke, cand_s, cand_m, nsn4, noint, tzinf, i_mem, prov_s, prov_m, eshift, addcm, chaine, nlinsa, nin)
Definition i20sto.F:213
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339