OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21tri.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i21tri()

subroutine i21tri ( integer, dimension(2,*) add,
integer nsn,
integer, dimension(4,*) irect,
xloc,
stf,
stfn,
xyzm,
integer i_add,
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 nrtm,
integer igap,
gap,
gap_s,
gapmin,
gapmax,
marge,
curv_max,
xm0,
nod_normal,
depth,
intent(in) drad,
intent(in) dgapload )

Definition at line 33 of file i21tri.F.

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 DE LA ROUTINE:
63C ===================
64C CLASSE LES ELETS DE BPE ET LES NOEUDS DE BPN EN TWO ZONES
65C > OU < A UNE FRONTIERE ICI DETERMINEE ET SORT LE TOUT
66C DANS bpe,hpe, et 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 TABLEAU DES FACETTES A TRIER => Local
73C ET DU RESULTAT COTE MAX
74C PE TABLEAU DES FACETTES => Local
75C RESULTAT COTE MIN
76C BPN TABLEAU DES NOEUDS A TRIER => Local
77C ET DU RESULTAT COTE MAX
78C PN TABLEAU DES NOEUDS => Local
79C RESULTAT COTE MIN
80C ADD(2,*) TABLEAU DES ADRESSES E/S
81C 1.......ADRESSES NOEUDS
82C 2.......ADRESSES ELEMENTS
83C ZYZM(6,*) TABLEAU DES XYZMIN E/S
84C 1.......XMIN BOITE
85C 2.......YMIN BOITE
86C 3.......ZMIN BOITE
87C 4.......XMAX BOITE
88C 5.......YMAX BOITE
89C 6.......ZMAX BOITE
90C IRECT(4,*) TABLEAU DES CONEC FACETTES E
91C XLOC(3,*) COORDONNEES NODALES LOCALES E
92C NB_NC NOMBRE DE NOEUDS CANDIDATS => Local
93C NB_EC NOMBRE D'ELTS CANDIDATS => Local
94C I_ADD POSITION DANS LE TAB DES ADRESSES E/S
95C XMAX plus grande abcisse existante E
96C XMAX plus grande ordonn. existante E
97C XMAX plus grande cote existante E
98C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
99C I_STOK niveau de stockage des couples
100C candidats impact E/S
101C ADNSTK adresse courante dans la boite des noeuds
102C CAND_N boites resultats noeuds
103C ADESTK adresse courante dans la boite des elements
104C CAND_E adresses des boites resultat elements
105C MULNSN = MULTIMP*NSN TAILLE MAX ADMISE MAINTENANT POUR LES
106C COUPLES NOEUDS,ELT CANDIDATS
107C NOINT NUMERO USER DE L'INTERFACE
108C TZINF TAILLE ZONE INFLUENCE
109C MAXBOX TAILLE MAX BUCKET
110C MINBOX TAILLE MIN BUCKET
111C
112C PROV_N CAND_N provisoire (variable static dans i7tri)
113C PROV_E CAND_E provisoire (variable static dans i7tri)
114C-----------------------------------------------
115C D u m m y A r g u m e n t s
116C-----------------------------------------------
117 INTEGER I_ADD,MAXSIZ,I_MEM,ESHIFT,NSN,NRTM,
118 . MULNSN,NB_N_B,NOINT,I_ADD_MAX,INACTI,IGAP,
119 . ADD(2,*),IRECT(4,*),
120 . CAND_N(*),CAND_E(*),II_STOK
121C REAL
122 my_real
123 . xloc(3,*),xyzm(6,*),stf(*),stfn(*),gap_s(*),
124 . xm0(3,*), nod_normal(3,*),
125 . tzinf,maxbox,minbox,marge,gap,gapmin,gapmax,
126 . depth
127 my_real , INTENT(IN) :: dgapload,drad
128 my_real curv_max(*)
129C-----------------------------------------------
130C L o c a l V a r i a b l e s
131C-----------------------------------------------
132 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NB_NC,NB_EC,
133 . N1,N2,N3,N4,NN,NE,K,L,NCAND_PROV,J_STOK,II,JJ
134C REAL
135 my_real
136 . dx,dy,dz,dsup,seuil,seuils,seuili, xx1, xx2, xx3, xx4,
137 . xmin, xmax,ymin, ymax,zmin, zmax, tz, gapsmx, bgapsmx, gapl
138
139 INTEGER,DIMENSION(:),ALLOCATABLE :: PROV_N
140 INTEGER,DIMENSION(:),ALLOCATABLE :: PROV_E
141 INTEGER,DIMENSION(:),ALLOCATABLE :: TN1
142 INTEGER,DIMENSION(:),ALLOCATABLE :: TN2
143 INTEGER,DIMENSION(:),ALLOCATABLE :: TN3
144 INTEGER,DIMENSION(:),ALLOCATABLE :: TN4
145 INTEGER,DIMENSION(:),ALLOCATABLE :: BPE
146 INTEGER,DIMENSION(:),ALLOCATABLE :: PE
147 INTEGER,DIMENSION(:),ALLOCATABLE :: BPN
148 INTEGER,DIMENSION(:),ALLOCATABLE :: PN
149 !
150 my_real, DIMENSION(:,:),ALLOCATABLE :: txx1
151 my_real, DIMENSION(:,:),ALLOCATABLE :: txx2
152 my_real, DIMENSION(:,:),ALLOCATABLE :: txx3
153 my_real, DIMENSION(:,:),ALLOCATABLE :: txx4
154 my_real, DIMENSION(:),ALLOCATABLE :: txmax
155 my_real, DIMENSION(:),ALLOCATABLE :: txmin
156 my_real, DIMENSION(:),ALLOCATABLE :: tymax
157 my_real, DIMENSION(:),ALLOCATABLE :: tymin
158 my_real, DIMENSION(:),ALLOCATABLE :: tzmax
159 my_real, DIMENSION(:),ALLOCATABLE :: tzmin
160C-----------------------------------------------
161 CALL my_alloc(prov_n,2*mvsiz)
162 CALL my_alloc(prov_e,2*mvsiz)
163 CALL my_alloc(tn1,nvecsz)
164 CALL my_alloc(tn2,nvecsz)
165 CALL my_alloc(tn3,nvecsz)
166 CALL my_alloc(tn4,nvecsz)
167 CALL my_alloc(bpe,maxsiz/3) ! BPE : used over NRTM but not NRTM + 100 (MAXSIZ = NRTM + 100)
168 CALL my_alloc(pe,maxsiz)
169 CALL my_alloc(bpn,nsn)
170 CALL my_alloc(pn,nsn)
171 CALL my_alloc(txx1,3,nvecsz)
172 CALL my_alloc(txx2,3,nvecsz)
173 CALL my_alloc(txx3,3,nvecsz)
174 CALL my_alloc(txx4,3,nvecsz)
175 CALL my_alloc(txmax,nvecsz)
176 CALL my_alloc(txmin,nvecsz)
177 CALL my_alloc(tymax,nvecsz)
178 CALL my_alloc(tymin,nvecsz)
179 CALL my_alloc(tzmax,nvecsz)
180 CALL my_alloc(tzmin,nvecsz)
181C-----------------------------------------------
182C
183C Phase initiale de construction de BPE et BPN deplacee de I7BUCE => I7TRI
184C
185 xmin = xyzm(1,i_add)
186 ymin = xyzm(2,i_add)
187 zmin = xyzm(3,i_add)
188 xmax = xyzm(4,i_add)
189 ymax = xyzm(5,i_add)
190 zmax = xyzm(6,i_add)
191C
192C Copie des nos de segments et de noeuds dans BPE ET BPN
193C
194 nb_ec = 0
195 DO i=1,nrtm
196C on ne retient pas les facettes detruites
197 IF(stf(i)/=zero)THEN
198 nb_ec = nb_ec + 1
199 bpe(nb_ec) = i
200 ENDIF
201 ENDDO
202C
203C Optimisation // recherche les noeuds compris dans xmin xmax des
204C elements du processeur
205C
206 nb_nc = 0
207 DO i=1,nsn
208 IF(stfn(i)/=zero) THEN
209 IF(xloc(1,i)>=xmin.AND.xloc(1,i)<=xmax.AND.
210 . xloc(2,i)>=ymin.AND.xloc(2,i)<=ymax.AND.
211 . xloc(3,i)>=zmin.AND.xloc(3,i)<=zmax)THEN
212 nb_nc=nb_nc+1
213 bpn(nb_nc) = i
214 ENDIF
215 ENDIF
216 ENDDO
217C
218 j_stok = 0
219 GOTO 200
220C=======================================================================
221 100 CONTINUE
222C=======================================================================
223C-----------------------------------------------------------
224C
225C
226C 1- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
227C
228C
229C-----------------------------------------------------------
230C
231C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
232C
233 dir = 1
234 IF(dy==dsup) THEN
235 dir = 2
236 ELSE IF(dz==dsup) THEN
237 dir = 3
238 ENDIF
239 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))*0.5
240C
241C 2- DIVISER LES NOEUDS EN TWO ZONES
242C
243 nb_ncn= 0
244 nb_ncn1= 0
245 addnn= add(1,i_add)
246 IF(igap==0)THEN
247 DO i=1,nb_nc
248 IF(xloc(dir,bpn(i))<seuil) THEN
249C ON STOCKE DANS LE BAS DE LA PILE BP
250 nb_ncn1 = nb_ncn1 + 1
251 addnn = addnn + 1
252 pn(addnn) = bpn(i)
253 ENDIF
254 ENDDO
255C
256 DO i=1,nb_nc
257 IF(xloc(dir,bpn(i))>=seuil) THEN
258C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
259 nb_ncn = nb_ncn + 1
260 bpn(nb_ncn) = bpn(i)
261 ENDIF
262 ENDDO
263 ELSE
264 gapsmx = zero
265 DO i=1,nb_nc
266 IF(xloc(dir,bpn(i))<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) = bpn(i)
271 gapsmx = max(gapsmx,max(gap_s(bpn(i))+dgapload,depth,drad))
272 ENDIF
273 ENDDO
274C
275 bgapsmx = zero
276 DO i=1,nb_nc
277 IF(xloc(dir,bpn(i))>=seuil) THEN
278C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
279 nb_ncn = nb_ncn + 1
280 bpn(nb_ncn) = bpn(i)
281 bgapsmx = max(bgapsmx,max(gap_s(bpn(i))+dgapload,depth,drad))
282 ENDIF
283 ENDDO
284 ENDIF
285C
286C 3- DIVISER LES ELEMENTS
287C
288 IF(igap==0) THEN
289 nb_ecn= 0
290 addne= add(2,i_add)
291 IF(nb_ncn1==0) THEN
292 DO i=1,nb_ec
293 ne = bpe(i)
294 xx1=xm0(dir, irect(1,ne))
295 xx2=xm0(dir, irect(2,ne))
296 xx3=xm0(dir, irect(3,ne))
297 xx4=xm0(dir, irect(4,ne))
298 xmax=max(xx1,xx2,xx3,xx4)+tzinf
299 IF(xmax>=seuil) THEN
300C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
301 nb_ecn = nb_ecn + 1
302 bpe(nb_ecn) = ne
303 ENDIF
304 ENDDO
305 ELSEIF(nb_ncn==0) THEN
306 DO i=1,nb_ec
307 ne = bpe(i)
308 xx1=xm0(dir, irect(1,ne))
309 xx2=xm0(dir, irect(2,ne))
310 xx3=xm0(dir, irect(3,ne))
311 xx4=xm0(dir, irect(4,ne))
312 xmin=min(xx1,xx2,xx3,xx4)-tzinf
313 IF(xmin<seuil) THEN
314C ON STOCKE DANS LE BAS DE LA PILE BP
315 addne = addne + 1
316 pe(addne) = ne
317 ENDIF
318 ENDDO
319 ELSE
320 DO i=1,nb_ec
321 ne = bpe(i)
322 xx1=xm0(dir, irect(1,ne))
323 xx2=xm0(dir, irect(2,ne))
324 xx3=xm0(dir, irect(3,ne))
325 xx4=xm0(dir, irect(4,ne))
326 xmin=min(xx1,xx2,xx3,xx4)-tzinf
327 IF(xmin<seuil) THEN
328C ON STOCKE DANS LE BAS DE LA PILE BP
329 addne = addne + 1
330 pe(addne) = ne
331 ENDIF
332 ENDDO
333C
334 DO i=1,nb_ec
335 ne = bpe(i)
336 xx1=xm0(dir, irect(1,ne))
337 xx2=xm0(dir, irect(2,ne))
338 xx3=xm0(dir, irect(3,ne))
339 xx4=xm0(dir, irect(4,ne))
340 xmax=max(xx1,xx2,xx3,xx4)+tzinf
341 IF(xmax>=seuil) THEN
342C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
343 nb_ecn = nb_ecn + 1
344 bpe(nb_ecn) = ne
345 ENDIF
346 ENDDO
347 ENDIF
348C Optimisation gap variable
349 ELSE
350 nb_ecn= 0
351 addne= add(2,i_add)
352 IF(nb_ncn1==0) THEN
353 DO i=1,nb_ec
354 ne = bpe(i)
355 xx1=xm0(dir, irect(1,ne))
356 xx2=xm0(dir, irect(2,ne))
357 xx3=xm0(dir, irect(3,ne))
358 xx4=xm0(dir, irect(4,ne))
359 xmax=max(xx1,xx2,xx3,xx4)
360 + +max(min(max(bgapsmx,gapmin),gapmax)+dgapload,depth,drad)
361 + +marge
362 IF(xmax>=seuil) THEN
363C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
364 nb_ecn = nb_ecn + 1
365 bpe(nb_ecn) = ne
366 ENDIF
367 ENDDO
368 ELSEIF(nb_ncn==0) THEN
369 DO i=1,nb_ec
370 ne = bpe(i)
371 xx1=xm0(dir, irect(1,ne))
372 xx2=xm0(dir, irect(2,ne))
373 xx3=xm0(dir, irect(3,ne))
374 xx4=xm0(dir, irect(4,ne))
375 xmin=min(xx1,xx2,xx3,xx4)
376 - -max(min(max(gapsmx,gapmin),gapmax)+dgapload,depth,drad)
377 - -marge
378 IF(xmin<seuil) THEN
379C ON STOCKE DANS LE BAS DE LA PILE BP
380 addne = addne + 1
381 pe(addne) = ne
382 ENDIF
383 ENDDO
384 ELSE
385 DO i=1,nb_ec
386 ne = bpe(i)
387 xx1=xm0(dir, irect(1,ne))
388 xx2=xm0(dir, irect(2,ne))
389 xx3=xm0(dir, irect(3,ne))
390 xx4=xm0(dir, irect(4,ne))
391 xmin=min(xx1,xx2,xx3,xx4)
392 - -max(min(max(gapsmx,gapmin),gapmax)+dgapload,depth,drad)
393 - -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
400C
401 DO i=1,nb_ec
402 ne = bpe(i)
403 xx1=xm0(dir, irect(1,ne))
404 xx2=xm0(dir, irect(2,ne))
405 xx3=xm0(dir, irect(3,ne))
406 xx4=xm0(dir, irect(4,ne))
407 xmax=max(xx1,xx2,xx3,xx4)
408 + +max(min(max(bgapsmx,gapmin),gapmax)+dgapload,depth,drad)
409 + +marge
410 IF(xmax>=seuil) THEN
411C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
412 nb_ecn = nb_ecn + 1
413 bpe(nb_ecn) = ne
414 ENDIF
415 ENDDO
416 ENDIF
417 ENDIF
418C
419C 4- REMPLIR LES TABLEAUX D'ADRESSES
420C
421 add(1,i_add+1) = addnn
422 add(2,i_add+1) = addne
423C-----on remplit les min de la boite suivante et les max de la courante
424C (i.e. seuil est un max pour la courante)
425C on va redescendre et donc on definit une nouvelle boite
426C on remplit les max de la nouvelle boite
427C initialises dans i7buc1 a 1.E30 comme ca on recupere
428c soit XMAX soit le max de la boite
429 xyzm(1,i_add+1) = xyzm(1,i_add)
430 xyzm(2,i_add+1) = xyzm(2,i_add)
431 xyzm(3,i_add+1) = xyzm(3,i_add)
432 xyzm(4,i_add+1) = xyzm(4,i_add)
433 xyzm(5,i_add+1) = xyzm(5,i_add)
434 xyzm(6,i_add+1) = xyzm(6,i_add)
435 xyzm(dir,i_add+1) = seuil
436 xyzm(dir+3,i_add) = seuil
437C
438 nb_nc = nb_ncn
439 nb_ec = nb_ecn
440C on incremente le niveau de descente avant de sortir
441 i_add = i_add + 1
442 IF(i_add+1>=i_add_max) THEN
443 i_mem = 3
444 RETURN
445 ENDIF
446C=======================================================================
447 200 CONTINUE
448C=======================================================================
449C-----------------------------------------------------------
450C
451C
452C 2- TEST ARRET = BOITE VIDE
453C BOITE TROP PETITE
454C BOITE NE CONTENANT QU'ONE NOEUD
455C PLUS DE MEMOIRE DISPONIBLE
456C
457C-------------------TEST SUR MEMOIRE DEPASSEE------------
458C
459 IF(add(2,i_add)+nb_ec>maxsiz) THEN
460C PLUS DE PLACE DANS LA PILE DES ELEMENTS BOITES TROP PETITES
461 i_mem = 1
462 RETURN
463 ENDIF
464C
465C--------------------TEST SUR BOITE VIDES--------------
466C
467 IF(nb_ec/=0.AND.nb_nc/=0) THEN
468C
469 dx = xyzm(4,i_add) - xyzm(1,i_add)
470 dy = xyzm(5,i_add) - xyzm(2,i_add)
471 dz = xyzm(6,i_add) - xyzm(3,i_add)
472 dsup= max(dx,dy,dz)
473C
474C-------------------TEST SUR FIN DE BRANCHE ------------
475C 1- STOCKAGE DU OU DES NOEUD CANDIDAT ET DES ELTS CORRESP.
476C VIRER LES INUTILES
477C
478C NCAND_PROV=NB_EC*NB_NC
479C NCAND_PROV negatif qd NB_EC*NB_NC > 2e31
480C
481 IF(nb_ec+nb_nc<=nvecsz) THEN
482 ncand_prov = nb_ec*nb_nc
483 ELSE
484 ncand_prov = nvecsz+1
485 ENDIF
486C
487 IF(dsup<minbox.OR.(nb_nc<=nb_n_b)
488 & .OR.(ncand_prov<=nvecsz)) THEN
489C necessaire qd NB_NC<=NB_N_B ou DSUP<MINBOX et NB_EC+NB_NC>128
490 ncand_prov = nb_ec*nb_nc
491 IF(ivector==1.AND.ncand_prov<=nvecsz)THEN
492 IF(igap==0)THEN
493 DO i = 1, nb_ec
494 ne = bpe(i)
495 tn1(i)=irect(1,ne)
496 tn2(i)=irect(2,ne)
497 tn3(i)=irect(3,ne)
498 tn4(i)=irect(4,ne)
499 txx1(1,i)=xm0(1, tn1(i))
500 txx2(1,i)=xm0(1, tn2(i))
501 txx3(1,i)=xm0(1, tn3(i))
502 txx4(1,i)=xm0(1, tn4(i))
503 txmax(i)=max(txx1(1,i),txx2(1,i),txx3(1,i),txx4(1,i))
504 + +tzinf
505 txmin(i)=min(txx1(1,i),txx2(1,i),txx3(1,i),txx4(1,i))
506 - -tzinf
507 txx1(2,i)=xm0(2, tn1(i))
508 txx2(2,i)=xm0(2, tn2(i))
509 txx3(2,i)=xm0(2, tn3(i))
510 txx4(2,i)=xm0(2, tn4(i))
511 tymax(i)=max(txx1(2,i),txx2(2,i),txx3(2,i),txx4(2,i))
512 + +tzinf
513 tymin(i)=min(txx1(2,i),txx2(2,i),txx3(2,i),txx4(2,i))
514 - -tzinf
515 txx1(3,i)=xm0(3, tn1(i))
516 txx2(3,i)=xm0(3, tn2(i))
517 txx3(3,i)=xm0(3, tn3(i))
518 txx4(3,i)=xm0(3, tn4(i))
519 tzmax(i)=max(txx1(3,i),txx2(3,i),txx3(3,i),txx4(3,i))
520 + +tzinf
521 tzmin(i)=min(txx1(3,i),txx2(3,i),txx3(3,i),txx4(3,i))
522 - -tzinf
523 ENDDO
524 DO k=1,ncand_prov,nvsiz
525 DO l=k,min(k-1+nvsiz,ncand_prov)
526 i = 1+(l-1)/nb_nc
527 j = l-(i-1)*nb_nc
528 nn=bpn(j)
529 IF(xloc(1,nn)>txmin(i).AND.xloc(1,nn)<txmax(i).AND.
530 & xloc(2,nn)>tymin(i).AND.xloc(2,nn)<tymax(i).AND.
531 & xloc(3,nn)>tzmin(i).AND.xloc(3,nn)<tzmax(i) ) THEN
532 j_stok = j_stok + 1
533 prov_n(j_stok) = bpn(j)
534 prov_e(j_stok) = bpe(i)
535 ENDIF
536 ENDDO
537 IF(j_stok>=nvsiz)THEN
538 CALL i21sto(
539 1 nvsiz ,irect ,xloc ,ii_stok,cand_n,
540 2 cand_e ,mulnsn,noint ,marge ,i_mem ,
541 3 prov_n ,prov_e,eshift,inacti ,nsn ,
542 4 igap ,gap ,gap_s ,gapmin ,gapmax,
543 5 curv_max ,xm0 ,nod_normal,depth ,drad,
544 6 dgapload)
545 IF(i_mem==2)RETURN
546 j_stok = j_stok-nvsiz
547#include "vectorize.inc"
548 DO j=1,j_stok
549 prov_n(j) = prov_n(j+nvsiz)
550 prov_e(j) = prov_e(j+nvsiz)
551 ENDDO
552 ENDIF
553 ENDDO
554 ELSE
555 DO i = 1, nb_ec
556 ne = bpe(i)
557 tn1(i)=irect(1,ne)
558 tn2(i)=irect(2,ne)
559 tn3(i)=irect(3,ne)
560 tn4(i)=irect(4,ne)
561 txx1(1,i)=xm0(1, tn1(i))
562 txx2(1,i)=xm0(1, tn2(i))
563 txx3(1,i)=xm0(1, tn3(i))
564 txx4(1,i)=xm0(1, tn4(i))
565 txmax(i)=max(txx1(1,i),txx2(1,i),txx3(1,i),txx4(1,i))
566 + +marge
567 txmin(i)=min(txx1(1,i),txx2(1,i),txx3(1,i),txx4(1,i))
568 - -marge
569 txx1(2,i)=xm0(2, tn1(i))
570 txx2(2,i)=xm0(2, tn2(i))
571 txx3(2,i)=xm0(2, tn3(i))
572 txx4(2,i)=xm0(2, tn4(i))
573 tymax(i)=max(txx1(2,i),txx2(2,i),txx3(2,i),txx4(2,i))
574 + +marge
575 tymin(i)=min(txx1(2,i),txx2(2,i),txx3(2,i),txx4(2,i))
576 - -marge
577 txx1(3,i)=xm0(3, tn1(i))
578 txx2(3,i)=xm0(3, tn2(i))
579 txx3(3,i)=xm0(3, tn3(i))
580 txx4(3,i)=xm0(3, tn4(i))
581 tzmax(i)=max(txx1(3,i),txx2(3,i),txx3(3,i),txx4(3,i))
582 + +marge
583 tzmin(i)=min(txx1(3,i),txx2(3,i),txx3(3,i),txx4(3,i))
584 - -marge
585 ENDDO
586 DO k=1,ncand_prov,nvsiz
587 DO l=k,min(k-1+nvsiz,ncand_prov)
588 i = 1+(l-1)/nb_nc
589 j = l-(i-1)*nb_nc
590 nn=bpn(j)
591 gapl=max(max(min(gap_s(bpn(j)),gapmax),gapmin)+dgapload,depth,drad)
592 IF(xloc(1,nn)>txmin(i)-gapl.AND.
593 & xloc(1,nn)<txmax(i)+gapl.AND.
594 & xloc(2,nn)>tymin(i)-gapl.AND.
595 & xloc(2,nn)<tymax(i)+gapl.AND.
596 & xloc(3,nn)>tzmin(i)-gapl.AND.
597 & xloc(3,nn)<tzmax(i)+gapl ) THEN
598 j_stok = j_stok + 1
599 prov_n(j_stok) = bpn(j)
600 prov_e(j_stok) = bpe(i)
601 ENDIF
602 ENDDO
603 IF(j_stok>=nvsiz)THEN
604 CALL i21sto(
605 1 nvsiz ,irect ,xloc ,ii_stok,cand_n,
606 2 cand_e ,mulnsn,noint ,marge ,i_mem ,
607 3 prov_n ,prov_e,eshift,inacti ,nsn ,
608 4 igap ,gap ,gap_s ,gapmin ,gapmax,
609 5 curv_max ,xm0 ,nod_normal,depth,drad,
610 6 dgapload)
611 IF(i_mem==2)RETURN
612 j_stok = j_stok-nvsiz
613#include "vectorize.inc"
614 DO j=1,j_stok
615 prov_n(j) = prov_n(j+nvsiz)
616 prov_e(j) = prov_e(j+nvsiz)
617 ENDDO
618 ENDIF
619 ENDDO
620 END IF
621 ELSE
622 DO k=1,ncand_prov,nvsiz
623 IF(igap==0) THEN
624 DO l=k,min(k-1+nvsiz,ncand_prov)
625 i = 1+(l-1)/nb_nc
626 j = l-(i-1)*nb_nc
627 ne = bpe(i)
628 n1=irect(1,ne)
629 n2=irect(2,ne)
630 n3=irect(3,ne)
631 n4=irect(4,ne)
632 xx1=xm0(1, n1)
633 xx2=xm0(1, n2)
634 xx3=xm0(1, n3)
635 xx4=xm0(1, n4)
636 xmax=max(xx1,xx2,xx3,xx4)+tzinf
637 xmin=min(xx1,xx2,xx3,xx4)-tzinf
638 xx1=xm0(2, n1)
639 xx2=xm0(2, n2)
640 xx3=xm0(2, n3)
641 xx4=xm0(2, n4)
642 ymax=max(xx1,xx2,xx3,xx4)+tzinf
643 ymin=min(xx1,xx2,xx3,xx4)-tzinf
644 xx1=xm0(3, n1)
645 xx2=xm0(3, n2)
646 xx3=xm0(3, n3)
647 xx4=xm0(3, n4)
648 zmax=max(xx1,xx2,xx3,xx4)+tzinf
649 zmin=min(xx1,xx2,xx3,xx4)-tzinf
650
651 nn=bpn(j)
652 IF(xloc(1,nn)>xmin.AND.xloc(1,nn)<xmax.AND.
653 & xloc(2,nn)>ymin.AND.xloc(2,nn)<ymax.AND.
654 & xloc(3,nn)>zmin.AND.xloc(3,nn)<zmax ) THEN
655 j_stok = j_stok + 1
656 prov_n(j_stok) = bpn(j)
657 prov_e(j_stok) = ne
658 ENDIF
659 ENDDO
660 ELSE
661 DO l=k,min(k-1+nvsiz,ncand_prov)
662 i = 1+(l-1)/nb_nc
663 j = l-(i-1)*nb_nc
664 ne = bpe(i)
665 n1=irect(1,ne)
666 n2=irect(2,ne)
667 n3=irect(3,ne)
668 n4=irect(4,ne)
669 xx1=xm0(1, n1)
670 xx2=xm0(1, n2)
671 xx3=xm0(1, n3)
672 xx4=xm0(1, n4)
673 tz=max(max(min(gap_s(bpn(j)),gapmax),gapmin)+dgapload,depth,drad)
674 + +marge
675 xmax=max(xx1,xx2,xx3,xx4)+tz
676 xmin=min(xx1,xx2,xx3,xx4)-tz
677 xx1=xm0(2, n1)
678 xx2=xm0(2, n2)
679 xx3=xm0(2, n3)
680 xx4=xm0(2, n4)
681 ymax=max(xx1,xx2,xx3,xx4)+tz
682 ymin=min(xx1,xx2,xx3,xx4)-tz
683 xx1=xm0(3, n1)
684 xx2=xm0(3, n2)
685 xx3=xm0(3, n3)
686 xx4=xm0(3, n4)
687 zmax=max(xx1,xx2,xx3,xx4)+tz
688 zmin=min(xx1,xx2,xx3,xx4)-tz
689
690 nn=bpn(j)
691 IF(xloc(1,nn)>xmin.AND.xloc(1,nn)<xmax.AND.
692 & xloc(2,nn)>ymin.AND.xloc(2,nn)<ymax.AND.
693 & xloc(3,nn)>zmin.AND.xloc(3,nn)<zmax ) THEN
694 j_stok = j_stok + 1
695 prov_n(j_stok) = bpn(j)
696 prov_e(j_stok) = ne
697 ENDIF
698 ENDDO
699 END IF
700 IF(j_stok>=nvsiz)THEN
701 CALL i21sto(
702 1 nvsiz,irect ,xloc ,ii_stok,cand_n,
703 2 cand_e ,mulnsn,noint ,marge ,i_mem ,
704 3 prov_n ,prov_e,eshift,inacti ,nsn ,
705 4 igap ,gap ,gap_s ,gapmin ,gapmax ,
706 5 curv_max ,xm0 ,nod_normal,depth,drad ,
707 6 dgapload)
708 IF(i_mem==2)RETURN
709 j_stok = j_stok-nvsiz
710#include "vectorize.inc"
711 DO j=1,j_stok
712 prov_n(j) = prov_n(j+nvsiz)
713 prov_e(j) = prov_e(j+nvsiz)
714 ENDDO
715 ENDIF
716 ENDDO
717 ENDIF
718 ELSE
719C=======================================================================
720 GOTO 100
721C=======================================================================
722 ENDIF
723 ENDIF
724C-------------------------------------------------------------------------
725C BOITE VIDE OU
726C FIN DE BRANCHE
727C on decremente le niveau de descente avant de recommencer
728C-------------------------------------------------------------------------
729 i_add = i_add - 1
730 IF (i_add/=0) THEN
731C-------------------------------------------------------------------------
732C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
733C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
734C-------------------------------------------------------------------------
735 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
736C=======================================================================
737 GOTO 200
738C=======================================================================
739 ENDIF
740C-------------------------------------------------------------------------
741C FIN DU TRI
742C-------------------------------------------------------------------------
743 IF(j_stok/=0)CALL i21sto(
744 1 j_stok,irect ,xloc ,ii_stok,cand_n,
745 2 cand_e ,mulnsn,noint ,marge ,i_mem ,
746 3 prov_n ,prov_e,eshift,inacti ,nsn ,
747 4 igap ,gap ,gap_s ,gapmin ,gapmax,
748 5 curv_max ,xm0,nod_normal,depth,drad ,
749 6 dgapload)
750C-------------------------------------------------------------------------
751 DEALLOCATE(prov_n)
752 DEALLOCATE(prov_e)
753 DEALLOCATE(tn1)
754 DEALLOCATE(tn2)
755 DEALLOCATE(tn3)
756 DEALLOCATE(tn4)
757 DEALLOCATE(bpe)
758 DEALLOCATE(pe)
759 DEALLOCATE(bpn)
760 DEALLOCATE(pn)
761 DEALLOCATE(txx1)
762 DEALLOCATE(txx2)
763 DEALLOCATE(txx3)
764 DEALLOCATE(txx4)
765 DEALLOCATE(txmax)
766 DEALLOCATE(txmin)
767 DEALLOCATE(tymax)
768 DEALLOCATE(tymin)
769 DEALLOCATE(tzmax)
770 DEALLOCATE(tzmin)
771 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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:272
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:34