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"

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 736 of file i11tri.F.

738#include "implicit_f.inc"
739 my_real
740 . x1,x2,y1,y2,z1,z2,xmin,xmax,ymin,ymax,zmin,zmax
741 my_real
742 . aa,xx,yy,zz
743
744c
745c elimination segments externes a la boite
746c
747
748c
749c 1- conservation: at least one node in the box
750c
751c Xmin Xmax
752c | |
753c | |
754c Ymax -------+-----------+
755c | 0 N2|
756c | N1 / |
757c | O / |
758c | \ O N1 |
759c Ymin -------+---\-------+
760c \
761c \
762c \ N2
763c O
764
765 i11insid = .true.
766
767
768c test if n1 or n2 is in the box
769
770 IF(x1>=xmin.and.x1<=xmax.and.
771 . y1>=ymin.and.y1<=ymax.and.
772 . z1>=zmin.and.z1<=zmax) RETURN
773
774 IF(x2>=xmin.and.x2<=xmax.and.
775 . y2>=ymin.and.y2<=ymax.and.
776 . z2>=zmin.and.z2<=zmax) RETURN
777
778
779c
780c 2- Elimination: Segment does not cut the box
781c
782c Xmin Xmax
783c | |
784c | |
785c Ymax -------+-----------+
786c | |
787c N1 | |
788c O | |
789c \ | |
790c Ymin ----\--+-----------+
791c \ |
792c \|
793c \
794c |\ N2
795c | O
796
797 i11insid = .false.
798
799c projection of n1 onto xmin or xmax
800
801 xx = min(max(x1,xmin),xmax)
802
803 IF(xx /= x1)THEN
804 IF(x1==x2)RETURN
805 IF(y2>ymax)THEN
806 aa = (xx-x1)/(x2-x1)
807 IF( y1 + aa * (y2-y1) > ymax)RETURN
808 IF(z2>zmax)THEN
809 IF(z1 + aa * (z2-z1) > zmax)RETURN
810 ELSEIF(z2<zmin)THEN
811 IF(z1 + aa * (z2-z1) < zmin)RETURN
812 ENDIF
813 ELSEIF(y2<ymin)THEN
814 aa = (xx-x1)/(x2-x1)
815 IF( y1 + aa * (y2-y1) < ymin)RETURN
816 IF(z2>zmax)THEN
817 IF(z1 + aa * (z2-z1) > zmax)RETURN
818 ELSEIF(z2<zmin)THEN
819 IF(z1 + aa * (z2-z1) < zmin)RETURN
820 ENDIF
821 ELSE
822 IF(z2>zmax)THEN
823 aa = (xx-x1)/(x2-x1)
824 IF(z1 + aa * (z2-z1) > zmax)RETURN
825 ELSEIF(z2<zmin)THEN
826 aa = (xx-x1)/(x2-x1)
827 IF(z1 + aa * (z2-z1) < zmin)RETURN
828 ENDIF
829 ENDIF
830 ENDIF
831
832c projection of n1 onto ymin or ymax
833
834 yy = min(max(y1,ymin),ymax)
835
836 IF(yy /= y1)THEN
837 IF(y1==y2)RETURN
838 IF(z2>zmax)THEN
839 aa = (yy-y1)/(y2-y1)
840 IF( z1 + aa * (z2-z1) > zmax)RETURN
841 IF(x2>xmax)THEN
842 IF(x1 + aa * (x2-x1) > xmax)RETURN
843 ELSEIF(x2<xmin)THEN
844 IF(x1 + aa * (x2-x1) < xmin)RETURN
845 ENDIF
846 ELSEIF(z2<zmin)THEN
847 aa = (yy-y1)/(y2-y1)
848 IF( z1 + aa * (z2-z1) < zmin)RETURN
849 IF(x2>xmax)THEN
850 IF(x1 + aa * (x2-x1) > xmax)RETURN
851 ELSEIF(x2<xmin)THEN
852 IF(x1 + aa * (x2-x1) < xmin)RETURN
853 ENDIF
854 ELSE
855 IF(x2>xmax)THEN
856 aa = (yy-y1)/(y2-y1)
857 IF(x1 + aa * (x2-x1) > xmax)RETURN
858 ELSEIF(x2<xmin)THEN
859 aa = (yy-y1)/(y2-y1)
860 IF(x1 + aa * (x2-x1) < xmin)RETURN
861 ENDIF
862 ENDIF
863 ENDIF
864
865c projection of n1 onto zmin or zmax
866
867 zz = min(max(z1,zmin),zmax)
868
869 IF(zz /= z1)THEN
870 IF(z1==z2)RETURN
871 IF(x2>xmax)THEN
872 aa = (zz-z1)/(z2-z1)
873 IF( x1 + aa * (x2-x1) > xmax)RETURN
874 IF(y2>ymax)THEN
875 IF(y1 + aa * (y2-y1) > ymax)RETURN
876 ELSEIF(y2<ymin)THEN
877 IF(y1 + aa * (y2-y1) < ymin)RETURN
878 ENDIF
879 ELSEIF(x2<xmin)THEN
880 aa = (zz-z1)/(z2-z1)
881 IF( x1 + aa * (x2-x1) < xmin)RETURN
882 IF(y2>ymax)THEN
883 IF(y1 + aa * (y2-y1) > ymax)RETURN
884 ELSEIF(y2<ymin)THEN
885 IF(y1 + aa * (y2-y1) < ymin)RETURN
886 ENDIF
887 ELSE
888 IF(y2>ymax)THEN
889 aa = (zz-z1)/(z2-z1)
890 IF(y1 + aa * (y2-y1) > ymax)RETURN
891 ELSEIF(y2<ymin)THEN
892 aa = (zz-z1)/(z2-z1)
893 IF(y1 + aa * (y2-y1) < ymin)RETURN
894 ENDIF
895 ENDIF
896 ENDIF
897
898c
899c 3- Other cases: Segment cuts the box
900c
901c
902c Xmin Xmax
903c | |
904c | |
905c Ymax -------+-----------+
906c N1 0 | |
907c \| |
908c \ |
909c |\ |
910c Ymin -------+-\---------+
911c \
912c \ N2
913c O
914
915 i11insid = .true.
916
917 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:738
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ 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 of the routine:
59C ===================
60C sorts the elements of bpe and the nodes of bpn into two zones
61C > or < to a boundary here determined and sorts everything
62C in bpe, hpe, and 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 ARRAY OF FACETTES TO SORT => Local
69C and of the result on the max side
70C PE ARRAY OF FACETTES => Local
71C RESULTAT COTE MIN
72C BPN SORTED NODES ARRAY => Local
73C and of the result on the max side
74C PN NODES ARRAY => Local
75C RESULTAT COTE MIN
76C ADD(2,*) ARRAY OF ADRESSES E/S
77C 1.......ADRESSES NODES C 2.......ADRESSES ELEMENTS
78C ZYZM(6,*) ARRAY OF XYZMIN E/S
79C 1.......XMIN BOITE
80C 2.......YMIN BOITE
81C 3.......ZMIN BOITE
82C 4.......XMAX BOITE
83C 5.......YMAX BOITE
84C 6.......ZMAX BOITE
85C IRECTM(2,*) ARRAY OF CONEC E
86C IRECTS(2,*) ARRAY OF CONEC E
87C X(3,*) COORDONNEES NODALES E
88C NB_NC NUMBER OF CANDIDATE NODES => Local
89C NB_EC NUMBER OF CANDIDATE ELEMENTS => Local
90C i_add position in the input/output address table
91C Xmax larger abcisse existing e
92C XMAX largest order.existing E
93C Xmax larger existing side E
94C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
95C i_stok storage level of the pairs
96C CANDIDATES impact E/S
97C adnstk current address in the node box
98C CAND_S boites resultats nodes C adestk current address in the element box
99C CAND_M adresses des boites resultat elements
100C nsn4 4*nsn current maximum allowed size for
101C COUPLES NODES,ELT CANDIDATES
102C NOINT INTERFACE USER NUMBER
103C TZINF TAILLE ZONE INFLUENCE
104C MAXBOX TAILLE MAX BUCKET
105C MINBOX TAILLE MIN BUCKET
106C
107C Prov_s Provisional Cand_s (static variable in i7tri)
108C PROV_M CAND_M provisoire (variable static in i7tri)
109C-----------------------------------------------
110C D u m m y A r g u m e n t s
111C-----------------------------------------------
112 INTEGER NRTM,NRTSR,I_ADD,MAXSIZ,I_MEM,ESHIFT,NRTS,
113 . NSN4,NB_N_B,NOINT,I_ADD_MAX,IAUTO ,NIN,
114 . ADD(2,*),IRECTS(2,*),IRECTM(2,*),
115 . CAND_S(*),CAND_M(*),ADDCM(*),CHAINE(2,*),ITAB(*),
116 . NB_OLD(2,*),IFPEN(*),IFORM,II_STOK
117C REAL
118 my_real
119 . x(3,*),xyzm(6,*),stfs(*),stfm(*),
120 . tzinf,maxbox,minbox
121C-----------------------------------------------
122C L o c a l V a r i a b l e s
123C-----------------------------------------------
124 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NN1,NN2,
125 . N1,N2,NN,NE,K,L,NCAND_PROV,J_STOK,NI,
126 . ISTOP,NB_ECN1,PROV_S(2*MVSIZ),PROV_M(2*MVSIZ),
127 . NB_NC_OLD, NB_EC_OLD, NB_NC, NB_EC,JJ,KK,
128C bpe: used on nrtm and not nrtm + 100
129C bpn: used on nrts and not nrts + 100
130 . BPE(NRTM+100),PE(MAXSIZ),BPN(NRTS+NRTSR+100),PN(MAXSIZ)
131C REAL
132 my_real
133 . dx,dy,dz,dsup,seuil, xx1, xx2,
134 . xmin, xmax,ymin, ymax,zmin, zmax,
135 . xmins,ymins,zmins,xmaxs,ymaxs,zmaxs,
136 . yy1,yy2,zz1,zz2,dmx,dmy,dmz,
137 . xy1,xy2,xz1,xz2,ximin,ximax,xjmin,xjmax,xkmin,xkmax,
138 . timin,timax,tjmin,tjmax,tkmin,tkmax,tsmin,tsmax,
139 . txmin, txmax,tymin, tymax,tzmin, tzmax
140 EXTERNAL i11insid
141 LOGICAL I11INSID
142C-----------------------------------------------
143C
144C initial phase of construction of bpe and bpn moved from i11buce => i11tri
145C
146C retrieving the domain bounds
147C
148 xmin = xyzm(1,i_add)
149 ymin = xyzm(2,i_add)
150 zmin = xyzm(3,i_add)
151 xmax = xyzm(4,i_add)
152 ymax = xyzm(5,i_add)
153 zmax = xyzm(6,i_add)
154C copying the segment and node numbers into bpe and bpn
155C
156 nb_ec = 0
157 DO i=1,nrtm
158C We no longer retain the Destruit facets
159 IF(stfm(i)/=zero)THEN
160 nb_ec = nb_ec + 1
161 bpe(nb_ec) = i
162 END IF
163 ENDDO
164C
165C optimization // searches for nodes included in xmin xmax of
166C processor elements
167C
168 nb_nc = 0
169 DO i=1,nrts
170C We do not retain the Destruit facets
171 IF(stfs(i)/=zero)THEN
172 n1=irects(1,i)
173 n2=irects(2,i)
174 xmins = min(x(1,n1),x(1,n2))
175 ymins = min(x(2,n1),x(2,n2))
176 zmins = min(x(3,n1),x(3,n2))
177 xmaxs = max(x(1,n1),x(1,n2))
178 ymaxs = max(x(2,n1),x(2,n2))
179 zmaxs = max(x(3,n1),x(3,n2))
180 IF(xmaxs>=xmin.AND.xmins<=xmax.AND.
181 . ymaxs>=ymin.AND.ymins<=ymax.AND.
182 . zmaxs>=zmin.AND.zmins<=zmax)THEN
183 nb_nc = nb_nc + 1
184 bpn(nb_nc) = i
185 ENDIF
186 END IF
187 ENDDO
188C
189C Non -local candidate account in SPMD
190C
191 DO i = nrts+1, nrts+nrtsr
192 nb_nc = nb_nc + 1
193 bpn(nb_nc) = i
194 ENDDO
195C
196C GOTO 200:
197C INTERFACE WITH 1 SEGMENT ET 1 NODE + INITIALISATION DX DY DZ
198C
199 j_stok = 0
200 istop = 0
201 nb_nc_old = 0
202 nb_ec_old = 0
203C
204 nb_old(1,i_add) = 0
205 nb_old(2,i_add) = 0
206
207 dx = xyzm(4,i_add) - xyzm(1,i_add)
208 dy = xyzm(5,i_add) - xyzm(2,i_add)
209 dz = xyzm(6,i_add) - xyzm(3,i_add)
210 dsup= max(dx,dy,dz)
211 GOTO 200
212C=======================================================================
213 100 CONTINUE
214C=======================================================================
215C-----------------------------------------------------------
216C
217C
218C 1- sorting phase on the median according to the largest direction
219C
220C
221C-----------------------------------------------------------
222C
223C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
224C
225 xmin = 1.e30
226 xmax = -1.e30
227
228 ymin = 1.e30
229 ymax = -1.e30
230
231 zmin = 1.e30
232 zmax = -1.e30
233
234 DO i=1,nb_ec
235 ne = bpe(i)
236 xx1=x(1, irectm(1,ne))
237 xx2=x(1, irectm(2,ne))
238 xmin=min(xmin,xx1,xx2)
239 xmax=max(xmax,xx1,xx2)
240
241 yy1=x(2, irectm(1,ne))
242 yy2=x(2, irectm(2,ne))
243 ymin=min(ymin,yy1,yy2)
244 ymax=max(ymax,yy1,yy2)
245
246 zz1=x(3, irectm(1,ne))
247 zz2=x(3, irectm(2,ne))
248 zmin=min(zmin,zz1,zz2)
249 zmax=max(zmax,zz1,zz2)
250 ENDDO
251
252c reduction of the box size:
253c a margin of tzinf is kept when reducing the box size
254c to avoid missing the secondary
255c
256c | Tzinf Tzinf |Tzinf
257c | <-----x-----> |<---->
258c | .............................|............Tymax ^
259c | . | . |
260c | . #################|#####.## | Tzinf
261c | . #////////////////|/////./# |
262c -----+----------------------------------+---------Ymax= v
263c | . |\\\\\#/// espace //|/////./# Ymax_old
264c | . |\\\\\#/// occupe par//|/////./#
265c main
266c | . |\\\\\#////////////////|/////./#
267c | . |\\\\\#////////////////|/////./#
268c | . |\\\\\#################|#####.## ^
269c | . |\\\ espace retenu \\| . |
270c Secondary
271c |.| \\\ (new box) \\ |.|
272c | . +----------------------| ....Ymin x
273c | . | . |
274c | . (boite de recherche main) . | Tzinf
275c | . | . |
276c | .............................|.........Tymin v
277c | . . | .
278c | . . | .
279c |(old box) |.
280c | . . | .
281c | . . | .
282c -----+----------------------------------+---------Ymin_old
283c | . . | .
284c | . . Xmax= .
285c Xmin_old . . Xmax_old .
286c . Xmin Txmax
287c Txmin
288c
289c if the box is reduced on the xmin side, one could use:
290c Txmin = Xmin with Xmin = min(Xmain)-Tzinf > Xmin_old
291c
292c But using:
293c Txmin = Xmin-Tzinf (= min(Xmain) - 2*Tzinf)
294c on ne penalise pas I11INSIND
295c (there is no main in the overestimated area)
296c and the calculation of xmin, txmin ... is simpler
297
298
299 xmin = max(xmin - tzinf , xyzm(1,i_add))
300 ymin = max(ymin - tzinf , xyzm(2,i_add))
301 zmin = max(zmin - tzinf , xyzm(3,i_add))
302 xmax = min(xmax + tzinf , xyzm(4,i_add))
303 ymax = min(ymax + tzinf , xyzm(5,i_add))
304 zmax = min(zmax + tzinf , xyzm(6,i_add))
305
306 txmin = xmin - tzinf
307 tymin = ymin - tzinf
308 tzmin = zmin - tzinf
309 txmax = xmax + tzinf
310 tymax = ymax + tzinf
311 tzmax = zmax + tzinf
312
313 dmx = xmax-xmin
314 dmy = ymax-ymin
315 dmz = zmax-zmin
316
317 dsup = max(dmx,dmy,dmz)
318
319 IF(dmy==dsup) THEN
320 dir = 2
321 jj = 3
322 kk = 1
323 seuil = (ymin+ymax)*0.5
324 ximin = ymin
325 xjmin = zmin
326 xkmin = xmin
327 ximax = ymax
328 xjmax = zmax
329 xkmax = xmax
330 timin = tymin
331 tjmin = tzmin
332 tkmin = txmin
333 timax = tymax
334 tjmax = tzmax
335 tkmax = txmax
336 ELSE IF(dmz==dsup) THEN
337 dir = 3
338 jj = 1
339 kk = 2
340 seuil = (zmin+zmax)*0.5
341 ximin = zmin
342 xjmin = xmin
343 xkmin = ymin
344 ximax = zmax
345 xjmax = xmax
346 xkmax = ymax
347 timin = tzmin
348 tjmin = txmin
349 tkmin = tymin
350 timax = tzmax
351 tjmax = txmax
352 tkmax = tymax
353 ELSE
354 dir = 1
355 jj = 2
356 kk = 3
357 seuil = (xmin+xmax)*0.5
358 ximin = xmin
359 xjmin = ymin
360 xkmin = zmin
361 ximax = xmax
362 xjmax = ymax
363 xkmax = zmax
364 timin = txmin
365 tjmin = tymin
366 tkmin = tzmin
367 timax = txmax
368 tjmax = tymax
369 tkmax = tzmax
370 ENDIF
371
372 tsmin = seuil - tzinf
373 tsmax = seuil + tzinf
374
375C
376C 2- DIVISER LES SECONDS EN TWO ZONES
377C
378
379c +-----------+-----------+--Xjmax
380c | | |
381c | | |
382c | | |
383c | | |
384c +-----------+-----------+--Xjmin
385c | | |
386c Ximin Seuil Ximax
387c
388
389
390
391 nb_ncn= 0
392 nb_ncn1= 0
393 addnn= add(1,i_add)
394 DO i=1,nb_nc
395 nn = bpn(i)
396 IF(nn<=nrts) THEN
397 xx1=x(dir,irects(1,nn))
398 xx2=x(dir,irects(2,nn))
399 xy1=x(jj, irects(1,nn))
400 xy2=x(jj, irects(2,nn))
401 xz1=x(kk, irects(1,nn))
402 xz2=x(kk, irects(2,nn))
403 ELSE
404 ni = nn-nrts
405 xx1=xrem(dir,ni)
406 xx2=xrem(dir+7,ni)
407 xy1=xrem(jj ,ni)
408 xy2=xrem(jj+7 ,ni)
409 xz1=xrem(kk ,ni)
410 xz2=xrem(kk+7 ,ni)
411 END IF
412 xmax=max(xx1,xx2)
413 xmin=min(xx1,xx2)
414 IF(xmin<seuil.AND.xmax>=ximin) THEN
415 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
416 . ximin,seuil,xjmin,xjmax,xkmin,xkmax)) THEN
417C we store at the bottom of the bp stack
418 nb_ncn1 = nb_ncn1 + 1
419 addnn = addnn + 1
420 pn(addnn) = nn
421 END IF
422 END IF
423 ENDDO
424 DO i=1,nb_nc
425 nn = bpn(i)
426 IF(nn<=nrts) THEN
427 xx1=x(dir,irects(1,nn))
428 xx2=x(dir,irects(2,nn))
429 xy1=x(jj, irects(1,nn))
430 xy2=x(jj, irects(2,nn))
431 xz1=x(kk, irects(1,nn))
432 xz2=x(kk, irects(2,nn))
433 ELSE
434 ni = nn-nrts
435 xx1=xrem(dir,ni)
436 xx2=xrem(dir+7,ni)
437 xy1=xrem(jj ,ni)
438 xy2=xrem(jj+7 ,ni)
439 xz1=xrem(kk ,ni)
440 xz2=xrem(kk+7 ,ni)
441 END IF
442 xmax=max(xx1,xx2)
443 xmin=min(xx1,xx2)
444 IF(xmax>=seuil.AND.xmin<=ximax) THEN
445 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
446 . seuil,ximax,xjmin,xjmax,xkmin,xkmax)) THEN
447C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
448 nb_ncn = nb_ncn + 1
449 bpn(nb_ncn) = nn
450 ENDIF
451 ENDIF
452 ENDDO
453C
454C 3- divide the mains
455C
456
457c Tzinf Tzinf Tzinf Tzinf
458c <----> <----x----> <---->
459c ............,.,.,.,.,..,,,,,,,,,,,,--Tjmax ^
460c . , . , | Tzinf
461c . , . , |
462c . +------,----+----.------+ ,--Xjmax v
463c . | , | . | ,
464c . | , | . | ,
465c . | , | . | ,
466c . | , | . | ,
467c . +------,----+----.------+ ,--Xjmin ^
468c . , . , | Tzinf
469c . , . , |
470c ............,.,.,.,.,..,,,,,,,,,,,,--Tjmin v
471c | | | | | | |
472c | Ximin | Seuil | Ximax |
473c Timin Tsmin Tsmax Timax
474c
475c If the box has been reworked (see 1)
476c it is possible that timin = ximin ...
477
478
479 nb_ecn= 0
480 nb_ecn1= 0
481 addne= add(2,i_add)
482 IF(nb_ncn1==0) THEN
483 DO i=1,nb_ec
484 ne = bpe(i)
485 xx1=x(dir, irectm(1,ne))
486 xx2=x(dir, irectm(2,ne))
487 IF(max(xx1,xx2)>=tsmin) THEN
488 xy1=x(jj, irectm(1,ne))
489 xy2=x(jj, irectm(2,ne))
490 xz1=x(kk, irectm(1,ne))
491 xz2=x(kk, irectm(2,ne))
492 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
493 . tsmin,timax,tjmin,tjmax,tkmin,tkmax)) THEN
494C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
495 nb_ecn = nb_ecn + 1
496 bpe(nb_ecn) = ne
497 ENDIF
498 ENDIF
499 ENDDO
500 ELSEIF(nb_ncn==0) THEN
501 DO i=1,nb_ec
502 ne = bpe(i)
503 xx1=x(dir, irectm(1,ne))
504 xx2=x(dir, irectm(2,ne))
505 IF(min(xx1,xx2)<tsmax) THEN
506 xy1=x(jj, irectm(1,ne))
507 xy2=x(jj, irectm(2,ne))
508 xz1=x(kk, irectm(1,ne))
509 xz2=x(kk, irectm(2,ne))
510 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
511 . timin,tsmax,tjmin,tjmax,tkmin,tkmax)) THEN
512C we store at the bottom of the bp stack
513 addne = addne + 1
514 nb_ecn1= nb_ecn1 + 1
515 pe(addne) = ne
516 ENDIF
517 ENDIF
518 ENDDO
519 ELSE
520 DO i=1,nb_ec
521 ne = bpe(i)
522 xx1=x(dir, irectm(1,ne))
523 xx2=x(dir, irectm(2,ne))
524 IF(min(xx1,xx2)<tsmax) THEN
525 xy1=x(jj, irectm(1,ne))
526 xy2=x(jj, irectm(2,ne))
527 xz1=x(kk, irectm(1,ne))
528 xz2=x(kk, irectm(2,ne))
529 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
530 . timin,tsmax,tjmin,tjmax,tkmin,tkmax)) THEN
531C we store at the bottom of the bp stack
532 addne = addne + 1
533 nb_ecn1= nb_ecn1 + 1
534 pe(addne) = ne
535 ENDIF
536 ENDIF
537 ENDDO
538 DO i=1,nb_ec
539 ne = bpe(i)
540 xx1=x(dir, irectm(1,ne))
541 xx2=x(dir, irectm(2,ne))
542 IF(max(xx1,xx2)>=tsmin) THEN
543 xy1=x(jj, irectm(1,ne))
544 xy2=x(jj, irectm(2,ne))
545 xz1=x(kk, irectm(1,ne))
546 xz2=x(kk, irectm(2,ne))
547 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
548 . tsmin,timax,tjmin,tjmax,tkmin,tkmax)) THEN
549C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
550 nb_ecn = nb_ecn + 1
551 bpe(nb_ecn) = ne
552 ENDIF
553 ENDIF
554 ENDDO
555 ENDIF
556C
557C 4- REMPLIR LES TABLEAUX D'ADRESSES
558C
559 add(1,i_add+1) = addnn
560 add(2,i_add+1) = addne
561Cwe fill the min of the next box and the max of the current one
562C i.e. treshold is a max for the current
563C We're going to go down and so we define a new box
564C We fill the max in the new box
565C initialises in i7buc1 a 1.E30 comme ca on recupere
566c either xmax or the maximum of the box
567 xyzm(1,i_add+1) = xyzm(1,i_add)
568 xyzm(2,i_add+1) = xyzm(2,i_add)
569 xyzm(3,i_add+1) = xyzm(3,i_add)
570 xyzm(4,i_add+1) = xyzm(4,i_add)
571 xyzm(5,i_add+1) = xyzm(5,i_add)
572 xyzm(6,i_add+1) = xyzm(6,i_add)
573
574 xyzm(dir ,i_add) = ximin
575 xyzm(dir+3,i_add) = seuil
576 xyzm(dir ,i_add+1) = seuil
577 xyzm(dir+3,i_add+1) = ximax
578C
579 nb_old(1,i_add)=nb_nc
580 nb_old(2,i_add)=nb_ec
581 nb_old(1,i_add+1)=nb_nc
582 nb_old(2,i_add+1)=nb_ec
583C
584 nb_nc = nb_ncn
585 nb_ec = nb_ecn
586C increment the descent level before exiting
587 i_add = i_add + 1
588 IF(i_add+1>=i_add_max) THEN
589 i_mem = 3
590 RETURN
591 ENDIF
592C=======================================================================
593 200 CONTINUE
594C=======================================================================
595C-----------------------------------------------------------
596C
597C
598C 2- TEST ARRET = BOITE VIDE
599C BOITE TROP PETITE
600C BOITE NE CONTENANT QU'ONE NODE C No More Memory Available
601C splitting does not reduce the candidates
602C
603C-------------------test for exceeded memory------------
604C
605 IF(add(1,i_add)+nb_nc>maxsiz) THEN
606C no more space in the stack of secondary sides, boxes too small
607 i_mem = 1
608 RETURN
609 ENDIF
610 IF(add(2,i_add)+nb_ec>maxsiz) THEN
611C no more space in the stack of main sides, boxes too small
612 i_mem = 1
613 RETURN
614 ENDIF
615C
616C--------------------test for empty boxes--------------
617C
618 IF(nb_ec/=0.AND.nb_nc/=0) THEN
619C
620 dx = xyzm(4,i_add) - xyzm(1,i_add)
621 dy = xyzm(5,i_add) - xyzm(2,i_add)
622 dz = xyzm(6,i_add) - xyzm(3,i_add)
623 dsup= max(dx,dy,dz)
624C
625C-------------------test for end of branch ------------
626C 1- storage of the candidate node(s) and corresponding elements
627C remove the unnecessary ones
628C
629 IF(nb_ec+nb_nc<=128) THEN
630 ncand_prov = nb_ec*nb_nc
631 ELSE
632 ncand_prov = 129
633 ENDIF
634C
635 nb_nc_old = nb_old(1,i_add)
636 nb_ec_old = nb_old(2,i_add)
637
638 IF(dsup<minbox.OR.
639 . nb_nc<=nb_n_b.OR.nb_ec<=nb_n_b.OR.
640 . ncand_prov<=128.OR.(nb_ec==nb_ec_old
641 . .AND.nb_nc==nb_nc_old)) THEN
642C
643 ncand_prov = nb_ec*nb_nc
644 DO k=1,ncand_prov,nvsiz
645 DO l=k,min(k-1+nvsiz,ncand_prov)
646 i = 1+(l-1)/nb_nc
647 j = l-(i-1)*nb_nc
648 ne = bpe(i)
649 nn = bpn(j)
650 n1=irectm(1,ne)
651 n2=irectm(2,ne)
652 IF(nn<=nrts) THEN
653 nn1=irects(1,nn)
654 nn2=irects(2,nn)
655 IF(iauto==0 .OR. itab(n1)>itab(nn1) )THEN
656 IF(nn1/=n1.AND.nn1/=n2.AND.
657 . nn2/=n1.AND.nn2/=n2) THEN
658 j_stok = j_stok + 1
659 prov_s(j_stok) = nn
660 prov_m(j_stok) = ne
661 ENDIF
662 ENDIF
663 ELSE
664 ni = nn-nrts
665 nn1 = irem(2,ni)
666 nn2 = irem(3,ni)
667 n1 = itab(n1)
668 n2 = itab(n2)
669 IF(iauto==0 .OR. n1>nn1 )THEN
670 IF(nn1/=n1.AND.nn1/=n2.AND.
671 . nn2/=n1.AND.nn2/=n2) THEN
672 j_stok = j_stok + 1
673 prov_s(j_stok) = nn
674 prov_m(j_stok) = ne
675 ENDIF
676 ENDIF
677 END IF
678 ENDDO
679 IF(j_stok>=nvsiz)THEN
680 CALL i11sto(
681 1 nvsiz,irects,irectm,x ,ii_stok,
682 2 cand_s,cand_m,nsn4 ,noint ,tzinf ,
683 3 i_mem ,prov_s,prov_m,eshift,addcm ,
684 4 chaine,nrts ,itab ,ifpen ,iform )
685 IF(i_mem==2)RETURN
686 j_stok = j_stok-nvsiz
687#include "vectorize.inc"
688 DO j=1,j_stok
689 prov_s(j) = prov_s(j+nvsiz)
690 prov_m(j) = prov_m(j+nvsiz)
691 ENDDO
692 ENDIF
693 ENDDO
694 ELSE
695C=======================================================================
696 GOTO 100
697C=======================================================================
698 ENDIF
699 ENDIF
700C-------------------------------------------------------------------------
701C empty box or
702C end of branch
703C decrement the descent level before starting again
704C-------------------------------------------------------------------------
705 i_add = i_add - 1
706 IF (i_add/=0) THEN
707C-------------------------------------------------------------------------
708C the bottoms of the stacks must be copied into the corresponding bas_de_pile
709C before descending again into the neighboring branch
710C-------------------------------------------------------------------------
711 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
712C=======================================================================
713 GOTO 200
714C=======================================================================
715 ENDIF
716C-------------------------------------------------------------------------
717C end of sorting
718C-------------------------------------------------------------------------
719 IF(j_stok/=0)CALL i11sto(
720 1 j_stok,irects,irectm,x ,ii_stok,
721 2 cand_s,cand_m,nsn4 ,noint ,tzinf ,
722 3 i_mem ,prov_s,prov_m,eshift,addcm ,
723 4 chaine,nrts ,itab ,ifpen ,iform )
724C-------------------------------------------------------------------------
725 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:33