OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i10tri.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!|| i10tri ../engine/source/interfaces/intsort/i10tri.F
25!||--- called by ------------------------------------------------------
26!|| i10buce ../engine/source/interfaces/intsort/i10buce.F
27!||--- calls -----------------------------------------------------
28!|| i10sto ../engine/source/interfaces/intsort/i10sto.F
29!|| i7dstk ../engine/source/interfaces/intsort/i7dstk.F
30!|| spmd_oldnumcd ../engine/source/mpi/interfaces/spmd_i7tool.F
31!||--- uses -----------------------------------------------------
32!|| tri7box ../engine/share/modules/tri7box.f
33!||====================================================================
34 SUBROUTINE i10tri(
35 1 ADD ,NSN ,RENUM ,NSNR ,NRTM ,
36 2 IRECT ,X ,XYZM ,IGAP ,GAP ,
37 3 I_ADD ,NSV ,MAXSIZ ,II_STOK ,CAND_N ,
38 4 CAND_E,NSN4 ,NOINT ,TZINF ,MAXBOX ,
39 5 MINBOX,I_MEM ,NB_N_B ,I_ADD_MAX,CAND_A ,
40 6 ESHIFT,NSNROLD,STF ,STFN ,GAP_S ,
41 7 GAP_M ,GAPMIN ,GAPMAX ,MARGE ,NIN ,
42 8 INTHEAT,IDT_THERM,NODADT_THERM)
43C============================================================================
44C cette routine est appelee par : I10BUCE(/int10/i10buce.F)
45C----------------------------------------------------------------------------
46C cette routine appelle : I10STO(/int10/i10sto.F)
47C I7DSTK(/int7/i7dstk.F)
48C============================================================================
49C M o d u l e s
50C-----------------------------------------------
51 USE tri7box
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C G l o b a l P a r a m e t e r s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
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 CAND_A adresse de N dans CAND_N trie
109C ADESTK adresse courante dans la boite des elements
110C CAND_E adresses des boites resultat elements
111C NSN4 4*NSN TAILLE MAX ADMISE MAINTENANT POUR LES
112C COUPLES NOEUDS,ELT CANDIDATS
113C NOINT NUMERO USER DE L'INTERFACE
114C TZINF TAILLE ZONE INFLUENCE
115C MAXBOX TAILLE MAX BUCKET
116C MINBOX TAILLE MIN BUCKET
117C PROV_N CAND_N provisoire (variable static dans i7tri)
118C PROV_E CAND_E provisoire (variable static dans i7tri)
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,NSNROLD,
123 . NSN4,NB_N_B,NOINT,I_ADD_MAX,NSNR,NRTM,IGAP,
124 . ADD(2,*),IRECT(4,*),II_STOK,
125 . NSV(*),CAND_N(*),CAND_E(*),CAND_A(*),RENUM(*)
126 INTEGER, INTENT(IN) :: INTHEAT
127 INTEGER, INTENT(IN) :: IDT_THERM
128 INTEGER, INTENT(IN) :: NODADT_THERM
129C REAL
130 my_real
131 . x(3,*),xyzm(6,*),stf(*),stfn(*),gap_s(*),gap_m(*),
132 . tzinf,maxbox,minbox,gap,gapmin,gapmax,marge
133C-----------------------------------------------
134C L o c a l V a r i a b l e s
135C-----------------------------------------------
136 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NB_NC,NB_EC,
137 . N1,N2,N3,N4,NN,NE,K,L,NCAND_PROV,J_STOK,II,JJ,NIN,
138 . prov_n(2*mvsiz),prov_e(2*mvsiz),oldnum(nsnr),
139C BPE : utilise sur NRTM et non NRTM + 100 en toute rigueur (ici MAXSIZ = NRTM + 100)
140 . bpe(maxsiz/3),pe(maxsiz),bpn(nsn+nsnr),pn(nsn+nsnr)
141C REAL
142 my_real
143 . dx,dy,dz,dsup,seuil,seuils,seuili, xx1, xx2, xx3, xx4,
144 . xmin,xmax,ymin,ymax,zmin,zmax, tz, gapsmx, bgapsmx
145C-----------------------------------------------
146C
147C Phase initiale de construction de BPE et BPN deplacee de I10BUCE => I10TRI
148C
149 xmin = xyzm(1,i_add)
150 ymin = xyzm(2,i_add)
151 zmin = xyzm(3,i_add)
152 xmax = xyzm(4,i_add)
153 ymax = xyzm(5,i_add)
154 zmax = xyzm(6,i_add)
155C
156C Copie des nos de segments et de noeuds dans BPE ET BPN
157C
158 nb_ec = 0
159 DO i=1,nrtm
160C on ne retient plus les facettes detruites
161 IF(stf(i)/=zero)THEN
162 nb_ec = nb_ec + 1
163 bpe(nb_ec) = i
164 END IF
165 ENDDO
166C
167C Optimisation // recherche les noeuds compris dans xmin xmax des
168C elements du processeur
169C
170 nb_nc = 0
171 DO i=1,nsn
172 j=nsv(i)
173 IF(stfn(i)/=zero) THEN
174 IF(x(1,j)>=xmin.AND.x(1,j)<=xmax.AND.
175 . x(2,j)>=ymin.AND.x(2,j)<=ymax.AND.
176 . x(3,j)>=zmin.AND.x(3,j)<=zmax)THEN
177 nb_nc = nb_nc + 1
178 bpn(nb_nc) = i
179 ENDIF
180 END IF
181 ENDDO
182C
183C Prise en compte candidats non locaux en SPMD
184C
185 DO i = nsn+1, nsn+nsnr
186 nb_nc = nb_nc + 1
187 bpn(nb_nc) = i
188 ENDDO
189C
190C En SPMD, retrouve ancienne numerotation des candidats non locaux
191C
192 IF(nspmd>1) THEN
193 CALL spmd_oldnumcd(renum,oldnum,nsnr,nsnrold,intheat,idt_therm,nodadt_therm)
194 END IF
195C
196 j_stok = 0
197 GOTO 200
198C=======================================================================
199 100 CONTINUE
200C=======================================================================
201C-----------------------------------------------------------
202C
203C
204C 1- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
205C
206C
207C-----------------------------------------------------------
208C
209C
210C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
211C
212 dir = 1
213 IF(dy==dsup) THEN
214 dir = 2
215 ELSE IF(dz==dsup) THEN
216 dir = 3
217 ENDIF
218 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))*0.5
219C
220C 2- DIVISER LES NOEUDS EN TWO ZONES
221C
222 nb_ncn= 0
223 nb_ncn1= 0
224 addnn= add(1,i_add)
225 IF(igap==0)THEN
226 DO i=1,nb_nc
227 j = bpn(i)
228 IF(j<=nsn) THEN
229 IF(x(dir,nsv(j))<seuil) THEN
230C ON STOCKE DANS LE BAS DE LA PILE BP
231 nb_ncn1 = nb_ncn1 + 1
232 addnn = addnn + 1
233 pn(addnn) = j
234 ENDIF
235 ELSE
236 IF(xrem(dir,j-nsn)<seuil) THEN
237C ON STOCKE DANS LE BAS DE LA PILE BP
238 nb_ncn1 = nb_ncn1 + 1
239 addnn = addnn + 1
240 pn(addnn) = j
241 ENDIF
242 ENDIF
243 ENDDO
244C
245 DO i=1,nb_nc
246 j = bpn(i)
247 IF(j<=nsn) THEN
248 IF(x(dir,nsv(j))>=seuil) THEN
249C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
250 nb_ncn = nb_ncn + 1
251 bpn(nb_ncn) = j
252 ENDIF
253 ELSE
254 IF(xrem(dir,j-nsn)>=seuil) THEN
255C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
256 nb_ncn = nb_ncn + 1
257 bpn(nb_ncn) = j
258 ENDIF
259 ENDIF
260 ENDDO
261 ELSE
262 gapsmx = zero
263 DO i=1,nb_nc
264 j = bpn(i)
265 IF(j<=nsn) THEN
266 IF(x(dir,nsv(j))<seuil) THEN
267C ON STOCKE DANS LE BAS DE LA PILE BP
268 nb_ncn1 = nb_ncn1 + 1
269 addnn = addnn + 1
270 pn(addnn) = j
271 gapsmx = max(gapsmx,gap_s(j))
272 ENDIF
273 ELSE
274 IF(xrem(dir,j-nsn)<seuil) THEN
275C ON STOCKE DANS LE BAS DE LA PILE BP
276 nb_ncn1 = nb_ncn1 + 1
277 addnn = addnn + 1
278 pn(addnn) = j
279 gapsmx = max(gapsmx,xrem(9,j-nsn))
280 ENDIF
281 ENDIF
282 ENDDO
283C
284 bgapsmx = zero
285 DO i=1,nb_nc
286 j = bpn(i)
287 IF(j<=nsn) THEN
288 IF(x(dir,nsv(j))>=seuil) THEN
289C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
290 nb_ncn = nb_ncn + 1
291 bpn(nb_ncn) = j
292 bgapsmx = max(bgapsmx,gap_s(j))
293 ENDIF
294 ELSE
295 IF(xrem(dir,j-nsn)>=seuil) THEN
296C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
297 nb_ncn = nb_ncn + 1
298 bpn(nb_ncn) = j
299 bgapsmx = max(bgapsmx,xrem(9,j-nsn))
300 ENDIF
301 ENDIF
302 ENDDO
303 END IF
304C
305C 3- DIVISER LES ELEMENTS
306C
307 IF(igap==0) THEN
308 nb_ecn= 0
309 addne= add(2,i_add)
310 IF(nb_ncn1==0) THEN
311 DO i=1,nb_ec
312 ne = bpe(i)
313 xx1=x(dir, irect(1,ne))
314 xx2=x(dir, irect(2,ne))
315 xx3=x(dir, irect(3,ne))
316 xx4=x(dir, irect(4,ne))
317 xmax=max(xx1,xx2,xx3,xx4)+tzinf
318 IF(xmax>=seuil) THEN
319C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
320 nb_ecn = nb_ecn + 1
321 bpe(nb_ecn) = ne
322 ENDIF
323 ENDDO
324 ELSEIF(nb_ncn==0) THEN
325 DO i=1,nb_ec
326 ne = bpe(i)
327 xx1=x(dir, irect(1,ne))
328 xx2=x(dir, irect(2,ne))
329 xx3=x(dir, irect(3,ne))
330 xx4=x(dir, irect(4,ne))
331 xmin=min(xx1,xx2,xx3,xx4)-tzinf
332 IF(xmin<seuil) THEN
333C ON STOCKE DANS LE BAS DE LA PILE BP
334 addne = addne + 1
335 pe(addne) = ne
336 ENDIF
337 ENDDO
338 ELSE
339 DO i=1,nb_ec
340 ne = bpe(i)
341 xx1=x(dir, irect(1,ne))
342 xx2=x(dir, irect(2,ne))
343 xx3=x(dir, irect(3,ne))
344 xx4=x(dir, irect(4,ne))
345 xmin=min(xx1,xx2,xx3,xx4)-tzinf
346 IF(xmin<seuil) THEN
347C ON STOCKE DANS LE BAS DE LA PILE BP
348 addne = addne + 1
349 pe(addne) = ne
350 ENDIF
351 ENDDO
352 DO i=1,nb_ec
353 ne = bpe(i)
354 xx1=x(dir, irect(1,ne))
355 xx2=x(dir, irect(2,ne))
356 xx3=x(dir, irect(3,ne))
357 xx4=x(dir, irect(4,ne))
358 xmax=max(xx1,xx2,xx3,xx4)+tzinf
359 IF(xmax>=seuil) THEN
360C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
361 nb_ecn = nb_ecn + 1
362 bpe(nb_ecn) = ne
363 ENDIF
364 ENDDO
365 ENDIF
366C Optimisation gap variable
367 ELSE
368 nb_ecn= 0
369 addne= add(2,i_add)
370 IF(nb_ncn1==0) THEN
371 DO i=1,nb_ec
372 ne = bpe(i)
373 xx1=x(dir, irect(1,ne))
374 xx2=x(dir, irect(2,ne))
375 xx3=x(dir, irect(3,ne))
376 xx4=x(dir, irect(4,ne))
377 xmax=max(xx1,xx2,xx3,xx4)
378 + +min(max(bgapsmx+gap_m(ne),gapmin),gapmax)+marge
379 IF(xmax>=seuil) THEN
380C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
381 nb_ecn = nb_ecn + 1
382 bpe(nb_ecn) = ne
383 ENDIF
384 ENDDO
385 ELSEIF(nb_ncn==0) THEN
386 DO i=1,nb_ec
387 ne = bpe(i)
388 xx1=x(dir, irect(1,ne))
389 xx2=x(dir, irect(2,ne))
390 xx3=x(dir, irect(3,ne))
391 xx4=x(dir, irect(4,ne))
392 xmin=min(xx1,xx2,xx3,xx4)
393 - -min(max(gapsmx+gap_m(ne),gapmin),gapmax)-marge
394 IF(xmin<seuil) THEN
395C ON STOCKE DANS LE BAS DE LA PILE BP
396 addne = addne + 1
397 pe(addne) = ne
398 ENDIF
399 ENDDO
400 ELSE
401 DO i=1,nb_ec
402 ne = bpe(i)
403 xx1=x(dir, irect(1,ne))
404 xx2=x(dir, irect(2,ne))
405 xx3=x(dir, irect(3,ne))
406 xx4=x(dir, irect(4,ne))
407 xmin=min(xx1,xx2,xx3,xx4)
408 - -min(max(gapsmx+gap_m(ne),gapmin),gapmax)-marge
409 IF(xmin<seuil) THEN
410C ON STOCKE DANS LE BAS DE LA PILE BP
411 addne = addne + 1
412 pe(addne) = ne
413 ENDIF
414 ENDDO
415 DO i=1,nb_ec
416 ne = bpe(i)
417 xx1=x(dir, irect(1,ne))
418 xx2=x(dir, irect(2,ne))
419 xx3=x(dir, irect(3,ne))
420 xx4=x(dir, irect(4,ne))
421 xmax=max(xx1,xx2,xx3,xx4)
422 + +min(max(bgapsmx+gap_m(ne),gapmin),gapmax)+marge
423 IF(xmax>=seuil) THEN
424C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
425 nb_ecn = nb_ecn + 1
426 bpe(nb_ecn) = ne
427 ENDIF
428 ENDDO
429 ENDIF
430 ENDIF
431C
432C 4- REMPLIR LES TABLEAUX D'ADRESSES
433C
434 add(1,i_add+1) = addnn
435 add(2,i_add+1) = addne
436C-----on remplit les min de la boite suivante et les max de la courante
437C (i.e. seuil est un max pour la courante)
438C on va redescendre et donc on definit une nouvelle boite
439C on remplit les max de la nouvelle boite
440C initialises dans i7buc1 a 1.E30 comme ca on recupere
441c soit XMAX soit le max de la boite
442 xyzm(1,i_add+1) = xyzm(1,i_add)
443 xyzm(2,i_add+1) = xyzm(2,i_add)
444 xyzm(3,i_add+1) = xyzm(3,i_add)
445 xyzm(4,i_add+1) = xyzm(4,i_add)
446 xyzm(5,i_add+1) = xyzm(5,i_add)
447 xyzm(6,i_add+1) = xyzm(6,i_add)
448 xyzm(dir,i_add+1) = seuil
449 xyzm(dir+3,i_add) = seuil
450C
451 nb_nc = nb_ncn
452 nb_ec = nb_ecn
453C on incremente le niveau de descente avant de sortir
454 i_add = i_add + 1
455 IF(i_add+1>=i_add_max) THEN
456 i_mem = 3
457 RETURN
458 ENDIF
459C=======================================================================
460 200 CONTINUE
461C=======================================================================
462C
463C=======================================================================
464C
465C
466C 2- TEST ARRET = BOITE VIDE
467C BOITE TROP PETITE
468C BOITE NE CONTENANT QU'ONE NOEUD
469C PLUS DE MEMOIRE DISPONIBLE
470C
471C-----------------------------------------------------------
472C
473C-------------------TEST SUR MEMOIRE DEPASSEE------------
474C
475 IF(add(2,i_add)+nb_ec>maxsiz) THEN
476C PLUS DE PLACE DANS LA PILE DES ELEMENTS BOITES TROP PETITES
477 i_mem = 1
478 RETURN
479 ENDIF
480C
481C--------------------TEST SUR BOITE VIDES--------------
482C
483 IF(nb_ec/=0.AND.nb_nc/=0) THEN
484C
485 dx = xyzm(4,i_add) - xyzm(1,i_add)
486 dy = xyzm(5,i_add) - xyzm(2,i_add)
487 dz = xyzm(6,i_add) - xyzm(3,i_add)
488 dsup= max(dx,dy,dz)
489C
490C-------------------TEST SUR FIN DE BRANCHE ------------
491C 1- STOCKAGE DU OU DES NOEUD CANDIDAT ET DES ELTS CORRESP.
492C VIRER LES INUTILES
493C
494 IF(nb_ec+nb_nc<=128) THEN
495 ncand_prov = nb_ec*nb_nc
496 ELSE
497 ncand_prov = 129
498 ENDIF
499 IF(dsup<minbox.OR.nb_nc<=nb_n_b.OR.ncand_prov<=128) THEN
500 ncand_prov = nb_ec*nb_nc
501 DO k=1,ncand_prov,nvsiz
502 IF(igap==0) THEN
503 DO l=k,min(k-1+nvsiz,ncand_prov)
504 i = 1+(l-1)/nb_nc
505 j = l-(i-1)*nb_nc
506C
507 ne = bpe(i)
508 n1=irect(1,ne)
509 n2=irect(2,ne)
510 n3=irect(3,ne)
511 n4=irect(4,ne)
512C
513 xx1=x(1, n1)
514 xx2=x(1, n2)
515 xx3=x(1, n3)
516 xx4=x(1, n4)
517 xmax=max(xx1,xx2,xx3,xx4)+tzinf
518 xmin=min(xx1,xx2,xx3,xx4)-tzinf
519 xx1=x(2, n1)
520 xx2=x(2, n2)
521 xx3=x(2, n3)
522 xx4=x(2, n4)
523 ymax=max(xx1,xx2,xx3,xx4)+tzinf
524 ymin=min(xx1,xx2,xx3,xx4)-tzinf
525 xx1=x(3, n1)
526 xx2=x(3, n2)
527 xx3=x(3, n3)
528 xx4=x(3, n4)
529 zmax=max(xx1,xx2,xx3,xx4)+tzinf
530 zmin=min(xx1,xx2,xx3,xx4)-tzinf
531C
532 jj = bpn(j)
533 IF(jj<=nsn) THEN
534 nn=nsv(jj)
535 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4.AND.
536 & x(1,nn)>xmin.AND.x(1,nn)<xmax.AND.
537 & x(2,nn)>ymin.AND.x(2,nn)<ymax.AND.
538 & x(3,nn)>zmin.AND.x(3,nn)<zmax ) THEN
539 j_stok = j_stok + 1
540 prov_n(j_stok) = jj
541 prov_e(j_stok) = ne
542 ENDIF
543 ELSE
544 ii = jj-nsn
545 IF(xrem(1,ii)>xmin.AND.
546 & xrem(1,ii)<xmax.AND.
547 & xrem(2,ii)>ymin.AND.
548 & xrem(2,ii)<ymax.AND.
549 & xrem(3,ii)>zmin.AND.
550 & xrem(3,ii)<zmax ) THEN
551 j_stok = j_stok + 1
552 prov_n(j_stok) = jj
553 prov_e(j_stok) = ne
554 ENDIF
555 ENDIF
556 ENDDO
557 ELSE
558 DO l=k,min(k-1+nvsiz,ncand_prov)
559 i = 1+(l-1)/nb_nc
560 j = l-(i-1)*nb_nc
561C
562 ne = bpe(i)
563 n1=irect(1,ne)
564 n2=irect(2,ne)
565 n3=irect(3,ne)
566 n4=irect(4,ne)
567C
568 jj = bpn(j)
569 IF(jj<=nsn) THEN
570 tz=max(min(gap_s(jj)+gap_m(ne),gapmax),gapmin)+marge
571 xx1=x(1, n1)
572 xx2=x(1, n2)
573 xx3=x(1, n3)
574 xx4=x(1, n4)
575 xmax=max(xx1,xx2,xx3,xx4)+tz
576 xmin=min(xx1,xx2,xx3,xx4)-tz
577 xx1=x(2, n1)
578 xx2=x(2, n2)
579 xx3=x(2, n3)
580 xx4=x(2, n4)
581 ymax=max(xx1,xx2,xx3,xx4)+tz
582 ymin=min(xx1,xx2,xx3,xx4)-tz
583 xx1=x(3, n1)
584 xx2=x(3, n2)
585 xx3=x(3, n3)
586 xx4=x(3, n4)
587 zmax=max(xx1,xx2,xx3,xx4)+tz
588 zmin=min(xx1,xx2,xx3,xx4)-tz
589 nn=nsv(jj)
590 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4.AND.
591 & x(1,nn)>xmin.AND.x(1,nn)<xmax.AND.
592 & x(2,nn)>ymin.AND.x(2,nn)<ymax.AND.
593 & x(3,nn)>zmin.AND.x(3,nn)<zmax ) THEN
594 j_stok = j_stok + 1
595 prov_n(j_stok) = jj
596 prov_e(j_stok) = ne
597 ENDIF
598 ELSE
599 ii = jj-nsn
600 tz=max(min(xrem(9,ii)+gap_m(ne),gapmax),gapmin)
601 + +marge
602 xx1=x(1, n1)
603 xx2=x(1, n2)
604 xx3=x(1, n3)
605 xx4=x(1, n4)
606 xmax=max(xx1,xx2,xx3,xx4)+tz
607 xmin=min(xx1,xx2,xx3,xx4)-tz
608 xx1=x(2, n1)
609 xx2=x(2, n2)
610 xx3=x(2, n3)
611 xx4=x(2, n4)
612 ymax=max(xx1,xx2,xx3,xx4)+tz
613 ymin=min(xx1,xx2,xx3,xx4)-tz
614 xx1=x(3, n1)
615 xx2=x(3, n2)
616 xx3=x(3, n3)
617 xx4=x(3, n4)
618 zmax=max(xx1,xx2,xx3,xx4)+tz
619 zmin=min(xx1,xx2,xx3,xx4)-tz
620 IF(xrem(1,ii)>xmin.AND.
621 & xrem(1,ii)<xmax.AND.
622 & xrem(2,ii)>ymin.AND.
623 & xrem(2,ii)<ymax.AND.
624 & xrem(3,ii)>zmin.AND.
625 & xrem(3,ii)<zmax ) THEN
626 j_stok = j_stok + 1
627 prov_n(j_stok) = jj
628 prov_e(j_stok) = ne
629 ENDIF
630 ENDIF
631 ENDDO
632 END IF
633 IF(j_stok>=nvsiz) THEN
634 CALL i10sto(
635 1 nvsiz ,irect ,x ,nsv ,ii_stok,
636 2 cand_n,cand_e,nsn4 ,noint ,marge ,
637 3 i_mem ,prov_n,prov_e ,cand_a,eshift ,
638 4 nsn ,oldnum,nsnrold,igap ,gap ,
639 6 gap_s ,gap_m ,gapmin ,gapmax,nin )
640 IF(i_mem==2)RETURN
641 j_stok = j_stok-nvsiz
642#include "vectorize.inc"
643 DO j=1,j_stok
644 prov_n(j) = prov_n(j+nvsiz)
645 prov_e(j) = prov_e(j+nvsiz)
646 ENDDO
647 ENDIF
648 ENDDO
649 ELSE
650C=======================================================================
651 GOTO 100
652C=======================================================================
653 ENDIF
654 ENDIF
655C-------------------------------------------------------------------------
656C BOITE VIDE OU
657C FIN DE BRANCHE
658C on decremente le niveau de descente avant de recommencer
659C-------------------------------------------------------------------------
660 i_add = i_add - 1
661 IF (i_add/=0) THEN
662C=======================================================================
663C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
664C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
665C=======================================================================
666 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
667C=======================================================================
668 GOTO 200
669C=======================================================================
670 ENDIF
671C=======================================================================
672C FIN DU TRI
673C=============================================
674 IF(j_stok/=0)CALL i10sto(
675 1 j_stok,irect ,x ,nsv ,ii_stok,
676 2 cand_n,cand_e,nsn4 ,noint ,marge ,
677 3 i_mem ,prov_n,prov_e ,cand_a,eshift ,
678 4 nsn ,oldnum,nsnrold,igap ,gap ,
679 6 gap_s ,gap_m ,gapmin ,gapmax,nin )
680C-------------------------------------------------------------------------
681 RETURN
682 END
my_real
#define my_real
Definition cppsort.cpp:32
i10sto
subroutine i10sto(j_stok, irect, x, nsv, ii_stok, cand_n, cand_e, nsn4, noint, marge, i_mem, prov_n, prov_e, cand_a, eshift, nsn, oldnum, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, nin)
Definition i10sto.F:37
i10tri
subroutine i10tri(add, nsn, renum, nsnr, nrtm, irect, x, xyzm, igap, gap, i_add, nsv, maxsiz, ii_stok, cand_n, cand_e, nsn4, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, cand_a, eshift, nsnrold, stf, stfn, gap_s, gap_m, gapmin, gapmax, marge, nin, intheat, idt_therm, nodadt_therm)
Definition i10tri.F:43
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