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

Go to the source code of this file.

Functions/Subroutines

subroutine i11tri (add, irects, irectm, x, nrtm, nrtsr, xyzm, i_add, maxsiz, ii_stok, cand_s, cand_m, nsn4, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, eshift, addcm, chaine, nrts, itab, nb_old, stfs, stfm, iauto, nin, ifpen, iform)
logical function i11insid (x1, x2, y1, y2, z1, z2, xmin, xmax, ymin, ymax, zmin, zmax)

Function/Subroutine Documentation

◆ i11insid()

logical function i11insid ( x1,
x2,
y1,
y2,
z1,
z2,
xmin,
xmax,
ymin,
ymax,
zmin,
zmax )

Definition at line 739 of file i11tri.F.

741#include "implicit_f.inc"
742 INTEGER N1,N2
743 my_real
744 . x1,x2,y1,y2,z1,z2,xmin,xmax,ymin,ymax,zmin,zmax
745 INTEGER K
746 my_real
747 . aa,xx,yy,zz
748
749c
750c elimination segments externes a la boite
751c
752
753c
754c 1- conservation: au moins un noeud dans la boite
755c
756c Xmin Xmax
757c | |
758c | |
759c Ymax -------+-----------+
760c | 0 N2|
761c | N1 / |
762c | O / |
763c | \ O N1 |
764c Ymin -------+---\-------+
765c \
766c \
767c \ N2
768c O
769
770 i11insid = .true.
771
772
773c test si N1 ou N2 dans la boite
774
775 IF(x1>=xmin.and.x1<=xmax.and.
776 . y1>=ymin.and.y1<=ymax.and.
777 . z1>=zmin.and.z1<=zmax) RETURN
778
779 IF(x2>=xmin.and.x2<=xmax.and.
780 . y2>=ymin.and.y2<=ymax.and.
781 . z2>=zmin.and.z2<=zmax) RETURN
782
783
784c
785c 2- elimination: segment ne coupe pas la boite
786c
787c Xmin Xmax
788c | |
789c | |
790c Ymax -------+-----------+
791c | |
792c N1 | |
793c O | |
794c \ | |
795c Ymin ----\--+-----------+
796c \ |
797c \|
798c \
799c |\ N2
800c | O
801
802 i11insid = .false.
803
804c projection de N1 sur XMIN ou XMAX
805
806 xx = min(max(x1,xmin),xmax)
807
808 IF(xx /= x1)THEN
809 IF(x1==x2)RETURN
810 IF(y2>ymax)THEN
811 aa = (xx-x1)/(x2-x1)
812 IF( y1 + aa * (y2-y1) > ymax)RETURN
813 IF(z2>zmax)THEN
814 IF(z1 + aa * (z2-z1) > zmax)RETURN
815 ELSEIF(z2<zmin)THEN
816 IF(z1 + aa * (z2-z1) < zmin)RETURN
817 ENDIF
818 ELSEIF(y2<ymin)THEN
819 aa = (xx-x1)/(x2-x1)
820 IF( y1 + aa * (y2-y1) < ymin)RETURN
821 IF(z2>zmax)THEN
822 IF(z1 + aa * (z2-z1) > zmax)RETURN
823 ELSEIF(z2<zmin)THEN
824 IF(z1 + aa * (z2-z1) < zmin)RETURN
825 ENDIF
826 ELSE
827 IF(z2>zmax)THEN
828 aa = (xx-x1)/(x2-x1)
829 IF(z1 + aa * (z2-z1) > zmax)RETURN
830 ELSEIF(z2<zmin)THEN
831 aa = (xx-x1)/(x2-x1)
832 IF(z1 + aa * (z2-z1) < zmin)RETURN
833 ENDIF
834 ENDIF
835 ENDIF
836
837c projection de N1 sur YMIN ou YMAX
838
839 yy = min(max(y1,ymin),ymax)
840
841 IF(yy /= y1)THEN
842 IF(y1==y2)RETURN
843 IF(z2>zmax)THEN
844 aa = (yy-y1)/(y2-y1)
845 IF( z1 + aa * (z2-z1) > zmax)RETURN
846 IF(x2>xmax)THEN
847 IF(x1 + aa * (x2-x1) > xmax)RETURN
848 ELSEIF(x2<xmin)THEN
849 IF(x1 + aa * (x2-x1) < xmin)RETURN
850 ENDIF
851 ELSEIF(z2<zmin)THEN
852 aa = (yy-y1)/(y2-y1)
853 IF( z1 + aa * (z2-z1) < zmin)RETURN
854 IF(x2>xmax)THEN
855 IF(x1 + aa * (x2-x1) > xmax)RETURN
856 ELSEIF(x2<xmin)THEN
857 IF(x1 + aa * (x2-x1) < xmin)RETURN
858 ENDIF
859 ELSE
860 IF(x2>xmax)THEN
861 aa = (yy-y1)/(y2-y1)
862 IF(x1 + aa * (x2-x1) > xmax)RETURN
863 ELSEIF(x2<xmin)THEN
864 aa = (yy-y1)/(y2-y1)
865 IF(x1 + aa * (x2-x1) < xmin)RETURN
866 ENDIF
867 ENDIF
868 ENDIF
869
870c projection de N1 sur ZMIN ou ZMAX
871
872 zz = min(max(z1,zmin),zmax)
873
874 IF(zz /= z1)THEN
875 IF(z1==z2)RETURN
876 IF(x2>xmax)THEN
877 aa = (zz-z1)/(z2-z1)
878 IF( x1 + aa * (x2-x1) > xmax)RETURN
879 IF(y2>ymax)THEN
880 IF(y1 + aa * (y2-y1) > ymax)RETURN
881 ELSEIF(y2<ymin)THEN
882 IF(y1 + aa * (y2-y1) < ymin)RETURN
883 ENDIF
884 ELSEIF(x2<xmin)THEN
885 aa = (zz-z1)/(z2-z1)
886 IF( x1 + aa * (x2-x1) < xmin)RETURN
887 IF(y2>ymax)THEN
888 IF(y1 + aa * (y2-y1) > ymax)RETURN
889 ELSEIF(y2<ymin)THEN
890 IF(y1 + aa * (y2-y1) < ymin)RETURN
891 ENDIF
892 ELSE
893 IF(y2>ymax)THEN
894 aa = (zz-z1)/(z2-z1)
895 IF(y1 + aa * (y2-y1) > ymax)RETURN
896 ELSEIF(y2<ymin)THEN
897 aa = (zz-z1)/(z2-z1)
898 IF(y1 + aa * (y2-y1) < ymin)RETURN
899 ENDIF
900 ENDIF
901 ENDIF
902
903c
904c 3- autres cas: segment coupe la boite
905c
906c
907c Xmin Xmax
908c | |
909c | |
910c Ymax -------+-----------+
911c N1 0 | |
912c \| |
913c \ |
914c |\ |
915c Ymin -------+-\---------+
916c \
917c \ N2
918c O
919
920 i11insid = .true.
921
922 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i11insid
logical function i11insid(x1, x2, y1, y2, z1, z2, xmin, xmax, ymin, ymax, zmin, zmax)
Definition i11tri.F:741
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

◆ i11tri()

subroutine i11tri ( integer, dimension(2,*) add,
integer, dimension(2,*) irects,
integer, dimension(2,*) irectm,
x,
integer nrtm,
integer nrtsr,
xyzm,
integer i_add,
integer maxsiz,
integer ii_stok,
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 nrts,
integer, dimension(*) itab,
integer, dimension(2,*) nb_old,
stfs,
stfm,
integer iauto,
integer nin,
integer, dimension(*) ifpen,
integer iform )

Definition at line 32 of file i11tri.F.

41C============================================================================
42C M o d u l e s
43C-----------------------------------------------
44 USE tri7box
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-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "param_c.inc"
57C-----------------------------------------------
58C ROLE DE LA ROUTINE:
59C ===================
60C CLASSE LES ELETS DE BPE ET LES NOEUDS DE BPN EN TWO ZONES
61C > OU < A UNE FRONTIERE ICI DETERMINEE ET SORT LE TOUT
62C DANS bpe,hpe, et bpn,hpn
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C
66C NOM DESCRIPTION E/S
67C
68C BPE TABLEAU DES FACETTES A TRIER => Local
69C ET DU RESULTAT COTE MAX
70C PE TABLEAU DES FACETTES => Local
71C RESULTAT COTE MIN
72C BPN TABLEAU DES NOEUDS A TRIER => Local
73C ET DU RESULTAT COTE MAX
74C PN TABLEAU DES NOEUDS => Local
75C RESULTAT COTE MIN
76C ADD(2,*) TABLEAU DES ADRESSES E/S
77C 1.......ADRESSES NOEUDS
78C 2.......ADRESSES ELEMENTS
79C ZYZM(6,*) TABLEAU DES XYZMIN E/S
80C 1.......XMIN BOITE
81C 2.......YMIN BOITE
82C 3.......ZMIN BOITE
83C 4.......XMAX BOITE
84C 5.......YMAX BOITE
85C 6.......ZMAX BOITE
86C IRECTM(2,*) TABLEAU DES CONEC E
87C IRECTS(2,*) TABLEAU DES CONEC E
88C X(3,*) COORDONNEES NODALES E
89C NB_NC NOMBRE DE NOEUDS CANDIDATS => Local
90C NB_EC NOMBRE D'ELTS CANDIDATS => Local
91C I_ADD POSITION DANS LE TAB DES ADRESSES E/S
92C XMAX plus grande abcisse existante E
93C XMAX plus grande ordonn. existante E
94C XMAX plus grande cote existante E
95C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
96C I_STOK niveau de stockage des couples
97C candidats impact E/S
98C ADNSTK adresse courante dans la boite des noeuds
99C CAND_S boites resultats noeuds
100C ADESTK adresse courante dans la boite des elements
101C CAND_M adresses des boites resultat elements
102C NSN4 4*NSN TAILLE MAX ADMISE MAINTENANT POUR LES
103C COUPLES NOEUDS,ELT CANDIDATS
104C NOINT NUMERO USER DE L'INTERFACE
105C TZINF TAILLE ZONE INFLUENCE
106C MAXBOX TAILLE MAX BUCKET
107C MINBOX TAILLE MIN BUCKET
108C
109C PROV_S CAND_S provisoire (variable static dans i7tri)
110C PROV_M CAND_M provisoire (variable static dans i7tri)
111C-----------------------------------------------
112C D u m m y A r g u m e n t s
113C-----------------------------------------------
114 INTEGER NRTM,NRTSR,I_ADD,MAXSIZ,I_MEM,ESHIFT,NRTS,
115 . NSN4,NB_N_B,NOINT,I_ADD_MAX,IAUTO ,NIN,
116 . ADD(2,*),IRECTS(2,*),IRECTM(2,*),
117 . CAND_S(*),CAND_M(*),ADDCM(*),CHAINE(2,*),ITAB(*),
118 . NB_OLD(2,*),IFPEN(*),IFORM,II_STOK
119C REAL
120 my_real
121 . x(3,*),xyzm(6,*),stfs(*),stfm(*),
122 . tzinf,maxbox,minbox
123C-----------------------------------------------
124C L o c a l V a r i a b l e s
125C-----------------------------------------------
126 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NN1,NN2,
127 . N1,N2,N3,N4,NN,NE,K_STOK,K,L,NCAND_PROV,J_STOK,NI,
128 . ISTOP,NB_ECN1,PROV_S(2*MVSIZ),PROV_M(2*MVSIZ),
129 . NB_NC_OLD, NB_EC_OLD, NB_NC, NB_EC,JJ,KK,
130C BPE : utilise sur NRTM et non NRTM + 100
131C BPN : utilise sur NRTS et non NRTS + 100
132 . BPE(NRTM+100),PE(MAXSIZ),BPN(NRTS+NRTSR+100),PN(MAXSIZ)
133C REAL
134 my_real
135 . dx,dy,dz,dsup,seuil,seuils,seuili, xx1, xx2, xx3, xx4,
136 . xmin, xmax,ymin, ymax,zmin, zmax, xx,yy,zz,
137 . xmins,ymins,zmins,xmaxs,ymaxs,zmaxs,
138 . yy1,yy2,zz1,zz2,dmx,dmy,dmz,
139 . xy1,xy2,xz1,xz2,ximin,ximax,xjmin,xjmax,xkmin,xkmax,
140 . timin,timax,tjmin,tjmax,tkmin,tkmax,tsmin,tsmax,
141 . txmin, txmax,tymin, tymax,tzmin, tzmax
142 EXTERNAL i11insid
143 LOGICAL I11INSID
144C-----------------------------------------------
145C
146C Phase initiale de construction de BPE et BPN deplacee de I11BUCE => I11TRI
147C
148C recuperation des bornes du domaine
149C
150 xmin = xyzm(1,i_add)
151 ymin = xyzm(2,i_add)
152 zmin = xyzm(3,i_add)
153 xmax = xyzm(4,i_add)
154 ymax = xyzm(5,i_add)
155 zmax = xyzm(6,i_add)
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(stfm(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,nrts
172C on ne retient pas les facettes detruites
173 IF(stfs(i)/=zero)THEN
174 n1=irects(1,i)
175 n2=irects(2,i)
176 xmins = min(x(1,n1),x(1,n2))
177 ymins = min(x(2,n1),x(2,n2))
178 zmins = min(x(3,n1),x(3,n2))
179 xmaxs = max(x(1,n1),x(1,n2))
180 ymaxs = max(x(2,n1),x(2,n2))
181 zmaxs = max(x(3,n1),x(3,n2))
182 IF(xmaxs>=xmin.AND.xmins<=xmax.AND.
183 . ymaxs>=ymin.AND.ymins<=ymax.AND.
184 . zmaxs>=zmin.AND.zmins<=zmax)THEN
185 nb_nc = nb_nc + 1
186 bpn(nb_nc) = i
187 ENDIF
188 END IF
189 ENDDO
190C
191C Prise en compte candidats non locaux en SPMD
192C
193 DO i = nrts+1, nrts+nrtsr
194 nb_nc = nb_nc + 1
195 bpn(nb_nc) = i
196 ENDDO
197C
198C GOTO 200:
199C INTERFACE AVEC 1 SEGMENT ET 1 NOEUD + INITIALISATION DX DY DZ
200C
201 j_stok = 0
202 istop = 0
203 nb_nc_old = 0
204 nb_ec_old = 0
205C
206 nb_old(1,i_add) = 0
207 nb_old(2,i_add) = 0
208
209 dx = xyzm(4,i_add) - xyzm(1,i_add)
210 dy = xyzm(5,i_add) - xyzm(2,i_add)
211 dz = xyzm(6,i_add) - xyzm(3,i_add)
212 dsup= max(dx,dy,dz)
213 GOTO 200
214C=======================================================================
215 100 CONTINUE
216C=======================================================================
217C-----------------------------------------------------------
218C
219C
220C 1- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
221C
222C
223C-----------------------------------------------------------
224C
225C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
226C
227 xmin = 1.e30
228 xmax = -1.e30
229
230 ymin = 1.e30
231 ymax = -1.e30
232
233 zmin = 1.e30
234 zmax = -1.e30
235
236 DO i=1,nb_ec
237 ne = bpe(i)
238 xx1=x(1, irectm(1,ne))
239 xx2=x(1, irectm(2,ne))
240 xmin=min(xmin,xx1,xx2)
241 xmax=max(xmax,xx1,xx2)
242
243 yy1=x(2, irectm(1,ne))
244 yy2=x(2, irectm(2,ne))
245 ymin=min(ymin,yy1,yy2)
246 ymax=max(ymax,yy1,yy2)
247
248 zz1=x(3, irectm(1,ne))
249 zz2=x(3, irectm(2,ne))
250 zmin=min(zmin,zz1,zz2)
251 zmax=max(zmax,zz1,zz2)
252 ENDDO
253
254c reduction de la taille de boite:
255c on garde une marge de TZINF quand on reduit la taille de boite
256c pour eviter d'oublier des seconds
257c
258c | Tzinf Tzinf |Tzinf
259c | <-----x-----> |<---->
260c | .............................|............Tymax ^
261c | . | . |
262c | . #################|#####.## | Tzinf
263c | . #////////////////|/////./# |
264c -----+----------------------------------+---------Ymax= v
265c | . |\\\\\#/// espace //|/////./# Ymax_old
266c | . |\\\\\#/// occupe par//|/////./#
267c | . |\\\\\#///les mains//|/////./#
268c | . |\\\\\#////////////////|/////./#
269c | . |\\\\\#////////////////|/////./#
270c | . |\\\\\#################|#####.## ^
271c | . |\\\ espace retenu \\| . |
272c | . |\\\pour les seconds\\| . | Tzinf
273c | . |\\\‍(nouvelle boite) \\| . |
274c | . +----------------------| ....Ymin x
275c | . | . |
276c | . (boite de recherche main) . | Tzinf
277c | . | . |
278c | .............................|.........Tymin v
279c | . . | .
280c | . . | .
281c | (ancienne boite) | .
282c | . . | .
283c | . . | .
284c -----+----------------------------------+---------Ymin_old
285c | . . | .
286c | . . Xmax= .
287c Xmin_old . . Xmax_old .
288c . Xmin Txmax
289c Txmin
290c
291c si la boite est reduite du cote de Xmin on pourrait utiliser:
292c Txmin = Xmin avec Xmin = min(Xmain)-Tzinf > Xmin_old
293c
294c mais en utilisant:
295c Txmin = Xmin-Tzinf (= min(Xmain) - 2*Tzinf)
296c on ne penalise pas I11INSIND
297c (il n'y a pas de main dans la zone surestimee)
298c et le calcul de Xmin, Txmin ... est plus simple
299
300
301 xmin = max(xmin - tzinf , xyzm(1,i_add))
302 ymin = max(ymin - tzinf , xyzm(2,i_add))
303 zmin = max(zmin - tzinf , xyzm(3,i_add))
304 xmax = min(xmax + tzinf , xyzm(4,i_add))
305 ymax = min(ymax + tzinf , xyzm(5,i_add))
306 zmax = min(zmax + tzinf , xyzm(6,i_add))
307
308 txmin = xmin - tzinf
309 tymin = ymin - tzinf
310 tzmin = zmin - tzinf
311 txmax = xmax + tzinf
312 tymax = ymax + tzinf
313 tzmax = zmax + tzinf
314
315 dmx = xmax-xmin
316 dmy = ymax-ymin
317 dmz = zmax-zmin
318
319 dsup = max(dmx,dmy,dmz)
320
321 IF(dmy==dsup) THEN
322 dir = 2
323 jj = 3
324 kk = 1
325 seuil = (ymin+ymax)*0.5
326 ximin = ymin
327 xjmin = zmin
328 xkmin = xmin
329 ximax = ymax
330 xjmax = zmax
331 xkmax = xmax
332 timin = tymin
333 tjmin = tzmin
334 tkmin = txmin
335 timax = tymax
336 tjmax = tzmax
337 tkmax = txmax
338 ELSE IF(dmz==dsup) THEN
339 dir = 3
340 jj = 1
341 kk = 2
342 seuil = (zmin+zmax)*0.5
343 ximin = zmin
344 xjmin = xmin
345 xkmin = ymin
346 ximax = zmax
347 xjmax = xmax
348 xkmax = ymax
349 timin = tzmin
350 tjmin = txmin
351 tkmin = tymin
352 timax = tzmax
353 tjmax = txmax
354 tkmax = tymax
355 ELSE
356 dir = 1
357 jj = 2
358 kk = 3
359 seuil = (xmin+xmax)*0.5
360 ximin = xmin
361 xjmin = ymin
362 xkmin = zmin
363 ximax = xmax
364 xjmax = ymax
365 xkmax = zmax
366 timin = txmin
367 tjmin = tymin
368 tkmin = tzmin
369 timax = txmax
370 tjmax = tymax
371 tkmax = tzmax
372 ENDIF
373
374 tsmin = seuil - tzinf
375 tsmax = seuil + tzinf
376
377C
378C 2- DIVISER LES SECONDS EN TWO ZONES
379C
380
381c +-----------+-----------+--Xjmax
382c | | |
383c | | |
384c | | |
385c | | |
386c +-----------+-----------+--Xjmin
387c | | |
388c Ximin Seuil Ximax
389c
390
391
392
393 nb_ncn= 0
394 nb_ncn1= 0
395 addnn= add(1,i_add)
396 DO i=1,nb_nc
397 nn = bpn(i)
398 IF(nn<=nrts) THEN
399 xx1=x(dir,irects(1,nn))
400 xx2=x(dir,irects(2,nn))
401 xy1=x(jj, irects(1,nn))
402 xy2=x(jj, irects(2,nn))
403 xz1=x(kk, irects(1,nn))
404 xz2=x(kk, irects(2,nn))
405 ELSE
406 ni = nn-nrts
407 xx1=xrem(dir,ni)
408 xx2=xrem(dir+7,ni)
409 xy1=xrem(jj ,ni)
410 xy2=xrem(jj+7 ,ni)
411 xz1=xrem(kk ,ni)
412 xz2=xrem(kk+7 ,ni)
413 END IF
414 xmax=max(xx1,xx2)
415 xmin=min(xx1,xx2)
416 IF(xmin<seuil.AND.xmax>=ximin) THEN
417 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
418 . ximin,seuil,xjmin,xjmax,xkmin,xkmax)) THEN
419C ON STOCKE DANS LE BAS DE LA PILE BP
420 nb_ncn1 = nb_ncn1 + 1
421 addnn = addnn + 1
422 pn(addnn) = nn
423 END IF
424 END IF
425 ENDDO
426 DO i=1,nb_nc
427 nn = bpn(i)
428 IF(nn<=nrts) THEN
429 xx1=x(dir,irects(1,nn))
430 xx2=x(dir,irects(2,nn))
431 xy1=x(jj, irects(1,nn))
432 xy2=x(jj, irects(2,nn))
433 xz1=x(kk, irects(1,nn))
434 xz2=x(kk, irects(2,nn))
435 ELSE
436 ni = nn-nrts
437 xx1=xrem(dir,ni)
438 xx2=xrem(dir+7,ni)
439 xy1=xrem(jj ,ni)
440 xy2=xrem(jj+7 ,ni)
441 xz1=xrem(kk ,ni)
442 xz2=xrem(kk+7 ,ni)
443 END IF
444 xmax=max(xx1,xx2)
445 xmin=min(xx1,xx2)
446 IF(xmax>=seuil.AND.xmin<=ximax) THEN
447 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
448 . seuil,ximax,xjmin,xjmax,xkmin,xkmax)) THEN
449C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
450 nb_ncn = nb_ncn + 1
451 bpn(nb_ncn) = nn
452 ENDIF
453 ENDIF
454 ENDDO
455C
456C 3- DIVISER LES MAINS
457C
458
459c Tzinf Tzinf Tzinf Tzinf
460c <----> <----x----> <---->
461c ............,.,.,.,.,..,,,,,,,,,,,,--Tjmax ^
462c . , . , | Tzinf
463c . , . , |
464c . +------,----+----.------+ ,--Xjmax v
465c . | , | . | ,
466c . | , | . | ,
467c . | , | . | ,
468c . | , | . | ,
469c . +------,----+----.------+ ,--Xjmin ^
470c . , . , | Tzinf
471c . , . , |
472c ............,.,.,.,.,..,,,,,,,,,,,,--Tjmin v
473c | | | | | | |
474c | Ximin | Seuil | Ximax |
475c Timin Tsmin Tsmax Timax
476c
477c si la boite a ete reduite(Cf 1)
478c il est possible que Timin=Ximin ...
479
480
481 nb_ecn= 0
482 nb_ecn1= 0
483 addne= add(2,i_add)
484 IF(nb_ncn1==0) THEN
485 DO i=1,nb_ec
486 ne = bpe(i)
487 xx1=x(dir, irectm(1,ne))
488 xx2=x(dir, irectm(2,ne))
489 IF(max(xx1,xx2)>=tsmin) THEN
490 xy1=x(jj, irectm(1,ne))
491 xy2=x(jj, irectm(2,ne))
492 xz1=x(kk, irectm(1,ne))
493 xz2=x(kk, irectm(2,ne))
494 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
495 . tsmin,timax,tjmin,tjmax,tkmin,tkmax)) THEN
496C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
497 nb_ecn = nb_ecn + 1
498 bpe(nb_ecn) = ne
499 ENDIF
500 ENDIF
501 ENDDO
502 ELSEIF(nb_ncn==0) THEN
503 DO i=1,nb_ec
504 ne = bpe(i)
505 xx1=x(dir, irectm(1,ne))
506 xx2=x(dir, irectm(2,ne))
507 IF(min(xx1,xx2)<tsmax) THEN
508 xy1=x(jj, irectm(1,ne))
509 xy2=x(jj, irectm(2,ne))
510 xz1=x(kk, irectm(1,ne))
511 xz2=x(kk, irectm(2,ne))
512 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
513 . timin,tsmax,tjmin,tjmax,tkmin,tkmax)) THEN
514C ON STOCKE DANS LE BAS DE LA PILE BP
515 addne = addne + 1
516 nb_ecn1= nb_ecn1 + 1
517 pe(addne) = ne
518 ENDIF
519 ENDIF
520 ENDDO
521 ELSE
522 DO i=1,nb_ec
523 ne = bpe(i)
524 xx1=x(dir, irectm(1,ne))
525 xx2=x(dir, irectm(2,ne))
526 IF(min(xx1,xx2)<tsmax) THEN
527 xy1=x(jj, irectm(1,ne))
528 xy2=x(jj, irectm(2,ne))
529 xz1=x(kk, irectm(1,ne))
530 xz2=x(kk, irectm(2,ne))
531 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
532 . timin,tsmax,tjmin,tjmax,tkmin,tkmax)) THEN
533C ON STOCKE DANS LE BAS DE LA PILE BP
534 addne = addne + 1
535 nb_ecn1= nb_ecn1 + 1
536 pe(addne) = ne
537 ENDIF
538 ENDIF
539 ENDDO
540 DO i=1,nb_ec
541 ne = bpe(i)
542 xx1=x(dir, irectm(1,ne))
543 xx2=x(dir, irectm(2,ne))
544 IF(max(xx1,xx2)>=tsmin) THEN
545 xy1=x(jj, irectm(1,ne))
546 xy2=x(jj, irectm(2,ne))
547 xz1=x(kk, irectm(1,ne))
548 xz2=x(kk, irectm(2,ne))
549 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
550 . tsmin,timax,tjmin,tjmax,tkmin,tkmax)) THEN
551C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
552 nb_ecn = nb_ecn + 1
553 bpe(nb_ecn) = ne
554 ENDIF
555 ENDIF
556 ENDDO
557 ENDIF
558C
559C 4- REMPLIR LES TABLEAUX D'ADRESSES
560C
561 add(1,i_add+1) = addnn
562 add(2,i_add+1) = addne
563C-----on remplit les min de la boite suivante et les max de la courante
564C (i.e. seuil est un max pour la courante)
565C on va redescendre et donc on definit une nouvelle boite
566C on remplit les max de la nouvelle boite
567C initialises dans i7buc1 a 1.E30 comme ca on recupere
568c soit XMAX soit le max de la boite
569 xyzm(1,i_add+1) = xyzm(1,i_add)
570 xyzm(2,i_add+1) = xyzm(2,i_add)
571 xyzm(3,i_add+1) = xyzm(3,i_add)
572 xyzm(4,i_add+1) = xyzm(4,i_add)
573 xyzm(5,i_add+1) = xyzm(5,i_add)
574 xyzm(6,i_add+1) = xyzm(6,i_add)
575
576 xyzm(dir ,i_add) = ximin
577 xyzm(dir+3,i_add) = seuil
578 xyzm(dir ,i_add+1) = seuil
579 xyzm(dir+3,i_add+1) = ximax
580C
581 nb_old(1,i_add)=nb_nc
582 nb_old(2,i_add)=nb_ec
583 nb_old(1,i_add+1)=nb_nc
584 nb_old(2,i_add+1)=nb_ec
585C
586 nb_nc = nb_ncn
587 nb_ec = nb_ecn
588C on incremente le niveau de descente avant de sortir
589 i_add = i_add + 1
590 IF(i_add+1>=i_add_max) THEN
591 i_mem = 3
592 RETURN
593 ENDIF
594C=======================================================================
595 200 CONTINUE
596C=======================================================================
597C-----------------------------------------------------------
598C
599C
600C 2- TEST ARRET = BOITE VIDE
601C BOITE TROP PETITE
602C BOITE NE CONTENANT QU'ONE NOEUD
603C PLUS DE MEMOIRE DISPONIBLE
604C LE DECOUPAGE NE REDUIT PAS LES CANDIDATS
605C
606C-------------------TEST SUR MEMOIRE DEPASSEE------------
607C
608 IF(add(1,i_add)+nb_nc>maxsiz) THEN
609C PLUS DE PLACE DANS LA PILE DES COTES SECONDS BOITES TROP PETITES
610 i_mem = 1
611 RETURN
612 ENDIF
613 IF(add(2,i_add)+nb_ec>maxsiz) THEN
614C PLUS DE PLACE DANS LA PILE DES COTES MAINS BOITES TROP PETITES
615 i_mem = 1
616 RETURN
617 ENDIF
618C
619C--------------------TEST SUR BOITE VIDES--------------
620C
621 IF(nb_ec/=0.AND.nb_nc/=0) THEN
622C
623 dx = xyzm(4,i_add) - xyzm(1,i_add)
624 dy = xyzm(5,i_add) - xyzm(2,i_add)
625 dz = xyzm(6,i_add) - xyzm(3,i_add)
626 dsup= max(dx,dy,dz)
627C
628C-------------------TEST SUR FIN DE BRANCHE ------------
629C 1- STOCKAGE DU OU DES NOEUD CANDIDAT ET DES ELTS CORRESP.
630C VIRER LES INUTILES
631C
632 IF(nb_ec+nb_nc<=128) THEN
633 ncand_prov = nb_ec*nb_nc
634 ELSE
635 ncand_prov = 129
636 ENDIF
637C
638 nb_nc_old = nb_old(1,i_add)
639 nb_ec_old = nb_old(2,i_add)
640
641 IF(dsup<minbox.OR.
642 . nb_nc<=nb_n_b.OR.nb_ec<=nb_n_b.OR.
643 . ncand_prov<=128.OR.(nb_ec==nb_ec_old
644 . .AND.nb_nc==nb_nc_old)) THEN
645C
646 ncand_prov = nb_ec*nb_nc
647 DO k=1,ncand_prov,nvsiz
648 DO l=k,min(k-1+nvsiz,ncand_prov)
649 i = 1+(l-1)/nb_nc
650 j = l-(i-1)*nb_nc
651 ne = bpe(i)
652 nn = bpn(j)
653 n1=irectm(1,ne)
654 n2=irectm(2,ne)
655 IF(nn<=nrts) THEN
656 nn1=irects(1,nn)
657 nn2=irects(2,nn)
658 IF(iauto==0 .OR. itab(n1)>itab(nn1) )THEN
659 IF(nn1/=n1.AND.nn1/=n2.AND.
660 . nn2/=n1.AND.nn2/=n2) THEN
661 j_stok = j_stok + 1
662 prov_s(j_stok) = nn
663 prov_m(j_stok) = ne
664 ENDIF
665 ENDIF
666 ELSE
667 ni = nn-nrts
668 nn1 = irem(2,ni)
669 nn2 = irem(3,ni)
670 n1 = itab(n1)
671 n2 = itab(n2)
672 IF(iauto==0 .OR. n1>nn1 )THEN
673 IF(nn1/=n1.AND.nn1/=n2.AND.
674 . nn2/=n1.AND.nn2/=n2) THEN
675 j_stok = j_stok + 1
676 prov_s(j_stok) = nn
677 prov_m(j_stok) = ne
678 ENDIF
679 ENDIF
680 END IF
681 ENDDO
682 IF(j_stok>=nvsiz)THEN
683 CALL i11sto(
684 1 nvsiz,irects,irectm,x ,ii_stok,
685 2 cand_s,cand_m,nsn4 ,noint ,tzinf ,
686 3 i_mem ,prov_s,prov_m,eshift,addcm ,
687 4 chaine,nrts ,itab ,ifpen ,iform )
688 IF(i_mem==2)RETURN
689 j_stok = j_stok-nvsiz
690#include "vectorize.inc"
691 DO j=1,j_stok
692 prov_s(j) = prov_s(j+nvsiz)
693 prov_m(j) = prov_m(j+nvsiz)
694 ENDDO
695 ENDIF
696 ENDDO
697 ELSE
698C=======================================================================
699 GOTO 100
700C=======================================================================
701 ENDIF
702 ENDIF
703C-------------------------------------------------------------------------
704C BOITE VIDE OU
705C FIN DE BRANCHE
706C on decremente le niveau de descente avant de recommencer
707C-------------------------------------------------------------------------
708 i_add = i_add - 1
709 IF (i_add/=0) THEN
710C-------------------------------------------------------------------------
711C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
712C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
713C-------------------------------------------------------------------------
714 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
715C=======================================================================
716 GOTO 200
717C=======================================================================
718 ENDIF
719C-------------------------------------------------------------------------
720C FIN DU TRI
721C-------------------------------------------------------------------------
722 IF(j_stok/=0)CALL i11sto(
723 1 j_stok,irects,irectm,x ,ii_stok,
724 2 cand_s,cand_m,nsn4 ,noint ,tzinf ,
725 3 i_mem ,prov_s,prov_m,eshift,addcm ,
726 4 chaine,nrts ,itab ,ifpen ,iform )
727C-------------------------------------------------------------------------
728 RETURN
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339
i11sto
subroutine i11sto(j_stok, irects, irectm, x, ii_stok, cand_n, cand_e, nsn, noint, tzinf, i_mem, prov_n, prov_e, multimp, addcm, chaine, iadfin)
Definition i11sto.F:137
i7dstk
subroutine i7dstk(i_add, nb_nc, nb_ec, add, bpn, pn, bpe, pe)
Definition i7dstk.F:34