OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20tri.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!|| i20tri ../engine/source/interfaces/intsort/i20tri.F
25!||--- called by ------------------------------------------------------
26!|| i20buce ../engine/source/interfaces/intsort/i20buce.F
27!||--- calls -----------------------------------------------------
28!|| i20sto ../engine/source/interfaces/intsort/i20sto.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 i20tri(
35 1 ADD ,NSN ,RENUM ,NSNR ,ISZNSNR ,
36 2 IRECT ,XA ,STF ,STFA ,XYZM ,
37 3 I_ADD ,NSV ,MAXSIZ ,II_STOK ,CAND_N ,
38 4 CAND_E,MULNSN ,NOINT ,TZINF ,MAXBOX ,
39 5 MINBOX,I_MEM ,NB_N_B ,I_ADD_MAX,ESHIFT ,
40 6 INACTI,IFQ ,CAND_A ,CAND_P ,IFPEN ,
41 7 NRTM ,NSNROLD,IGAP ,GAP ,GAP_S ,
42 6 GAP_M ,GAPMIN ,GAPMAX ,MARGE ,CURV_MAX ,
43 7 NIN ,GAP_SH ,NBINFLG,MBINFLG ,ISYM ,
44 8 INTHEAT,IDT_THERM,NODADT_THERM)
45C============================================================================
46C M o d u l e s
47C-----------------------------------------------
48 USE tri7box
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57c parameter setting the size for the vector (orig version is 128)
58 INTEGER NVECSZ
59 PARAMETER (NVECSZ = mvsiz)
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "com01_c.inc"
64#include "param_c.inc"
65C-----------------------------------------------
66C Purpose routine:
67C ===================
68C classify the elements of BPE and the nodes of BPN into two zones
69C > or < to a boundary determined here and sorts everything
70C in bpe,hpe, and 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 ARRAY OF FACETTES TO SORT => Local
77C and of the result max side
78C PE ARRAY OF FACETTES => Local
79C RESULTAT COTE MIN
80C BPN SORTED NODES ARRAY => Local
81C and of the result max side
82C PN NODES ARRAY => Local
83C RESULTAT COTE MIN
84C ADD(2,*) ARRAY OF ADRESSES E/S
85C 1.......ADRESSES NODES C 2.......ADRESSES ELEMENTS
86C ZYZM(6,*) ARRAY OF XYZMIN E/S
87C 1.......XMIN BOITE
88C 2.......YMIN BOITE
89C 3.......ZMIN BOITE
90C 4.......XMAX BOITE
91C 5.......YMAX BOITE
92C 6.......ZMAX BOITE
93C IRECT(4,*) ARRAY OF CONEC FACETTES E
94C X(3,*) COORDONNEES NODALES E
95C NB_NC NUMBER OF CANDIDATE NODES => Local
96C NB_EC NUMBER OF CANDIDATE ELEMENTS => Local
97C I_ADD position in the i/o address table
98C NSV NOS SYSTEMES DES NODES E
99C Xmax larger abcisse existing e
100C XMAX largest order.existing E
101C Xmax larger existing side E
102C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
103C I_STOK storage level of pairs
104C CANDIDATES impact E/S
105C ADNSTK current address in the node box
106C CAND_N boites resultats nodes C ADESTK current address in the element box
107C CAND_E adresses des boites resultat elements
108C MULNSN = MULTIMP*NSN max size allowed now for the
109C COUPLES NODES,ELT CANDIDATES
110C NOINT INTERFACE USER NUMBER
111C TZINF TAILLE ZONE INFLUENCE
112C MAXBOX TAILLE MAX BUCKET
113C MINBOX TAILLE MIN BUCKET
114C
115C Prov_n Provisional Cand_n (static variable in i20tri)
116C PROV_E CAND_E provisoire (variable static in i20tri)
117C-----------------------------------------------
118C D u m m y A r g u m e n t s
119C-----------------------------------------------
120 INTEGER I_ADD,MAXSIZ,I_MEM,ESHIFT,NSN,ISZNSNR,NRTM,NSNROLD,
121 . MULNSN,NB_N_B,NOINT,I_ADD_MAX,INACTI,IFQ,NSNR,IGAP,
122 . ADD(2,*),IRECT(4,*), NIN,NBINFLG(*),MBINFLG(*),ISYM,
123 . NSV(*),CAND_N(*),CAND_E(*),CAND_A(*),IFPEN(*),RENUM(*),
124 . II_STOK
125 INTEGER, INTENT(IN) :: INTHEAT
126 INTEGER, INTENT(IN) :: IDT_THERM
127 INTEGER, INTENT(IN) :: NODADT_THERM
128C REAL
129 my_real
130 . xa(3,*),xyzm(6,*),cand_p(*),stf(*),stfa(*),gap_s(*),gap_m(*),
131 . tzinf,maxbox,minbox,marge,gap,gapmin,gapmax,
132 . curv_max(*), gap_sh(*)
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,
138 . prov_n(2*mvsiz),prov_e(2*mvsiz),
139 .
140C BPE: Use on nrtm and not nrtm + 100 rigorously (here maxsiz = nrtm + 100)
141 . bpe(maxsiz/3),pe(maxsiz),bpn(nsn+nsnr),pn(nsn+nsnr),
142 . oldnum(isznsnr)
143C REAL
144 my_real
145 . dx,dy,dz,dsup,seuil, xx1, xx2, xx3, xx4,
146 . yy1, yy2, yy3, yy4, zz1, zz2, zz3, zz4,
147 . xmin, xmax,ymin, ymax,zmin, zmax, tz, gapsmx, bgapsmx,
148 .
149 .
150 . smoins,splus,xx
151C-----------------------------------------------
152C initial construction phase of BPE and BPN moved from I7BUCE => I7TRI
153C
154 bgapsmx = zero
155 xmin = xyzm(1,i_add)
156 ymin = xyzm(2,i_add)
157 zmin = xyzm(3,i_add)
158 xmax = xyzm(4,i_add)
159 ymax = xyzm(5,i_add)
160 zmax = xyzm(6,i_add)
161C
162C copy of segment and node numbers in BPE and BPN
163C
164 nb_ec = 0
165 DO i=1,nrtm
166C We do not retain the Destruit facets
167 IF(stf(i)/=zero)THEN
168 nb_ec = nb_ec + 1
169 bpe(nb_ec) = i
170 ENDIF
171 ENDDO
172C
173C optimization // search for nodes within xmin xmax of
174C processor elements
175C
176 nb_nc = 0
177 DO i=1,nsn
178 j=nsv(i)
179 IF(stfa(j)/=zero) THEN
180 IF(xa(1,j)>=xmin.AND.xa(1,j)<=xmax.AND.
181 . xa(2,j)>=ymin.AND.xa(2,j)<=ymax.AND.
182 . xa(3,j)>=zmin.AND.xa(3,j)<=zmax)THEN
183 nb_nc=nb_nc+1
184 bpn(nb_nc) = i
185 ENDIF
186 ENDIF
187 ENDDO
188C
189C Non -local candidate account in SPMD
190C
191 DO i = nsn+1, nsn+nsnr
192 nb_nc = nb_nc + 1
193 bpn(nb_nc) = i
194 ENDDO
195C
196C in SPMD, for inacti or IFQ, retrieves old numbering of non-local candidates
197C
198 IF(nspmd>1.AND.
199 + (inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0)) THEN
200 CALL spmd_oldnumcd(renum,oldnum,isznsnr,nsnrold,intheat,idt_therm,nodadt_therm)
201 END IF
202C
203 j_stok = 0
204 GOTO 200
205C=======================================================================
206 100 CONTINUE
207C=======================================================================
208C-----------------------------------------------------------
209C
210C
211C 1- sorting phase on the median along the largest direction
212C
213C
214C-----------------------------------------------------------
215C
216C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
217C
218 dir = 1
219 IF(dy==dsup) THEN
220 dir = 2
221 ELSE IF(dz==dsup) THEN
222 dir = 3
223 ENDIF
224 smoins = xyzm(dir,i_add)
225 splus = xyzm(dir+3,i_add)
226 seuil =(smoins+splus)*half
227C
228C 2- DIVISER LES NODES EN TWO ZONES
229C
230 nb_ncn= 0
231 nb_ncn1= 0
232 addnn= add(1,i_add)
233 IF(igap==0)THEN
234 DO i=1,nb_nc
235 j = bpn(i)
236 IF(j <= nsn) THEN
237 xx = xa(dir,nsv(j))
238 ELSE
239 xx = xrem(dir,j-nsn)
240 ENDIF
241 IF(xx < seuil) THEN
242C store at the bottom of the BP stack
243 nb_ncn1 = nb_ncn1 + 1
244 addnn = addnn + 1
245 pn(addnn) = j
246 smoins = max(smoins,xx)
247 ELSE
248C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
249 nb_ncn = nb_ncn + 1
250 bpn(nb_ncn) = j
251 splus = min(splus,xx)
252 ENDIF
253 ENDDO
254
255 ELSE !IF(IGAP == 0)
256
257 gapsmx = zero
258 DO i=1,nb_nc
259 j = bpn(i)
260 IF(j <= nsn) THEN
261 xx = xa(dir,nsv(j))
262 IF(xx < seuil) THEN
263C store at the bottom of the BP stack
264 nb_ncn1 = nb_ncn1 + 1
265 addnn = addnn + 1
266 pn(addnn) = j
267 gapsmx = max(gapsmx,gap_s(j))
268 smoins = max(smoins,xx)
269 ELSE
270C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
271 nb_ncn = nb_ncn + 1
272 bpn(nb_ncn) = j
273 bgapsmx = max(bgapsmx,gap_s(j))
274 splus = min(splus,xx)
275 ENDIF
276 ELSE
277 xx = xrem(dir,j-nsn)
278 IF(xx < seuil) THEN
279C store at the bottom of the BP stack
280 nb_ncn1 = nb_ncn1 + 1
281 addnn = addnn + 1
282 pn(addnn) = j
283 gapsmx = max(gapsmx,xrem(13,j-nsn))
284 smoins = max(smoins,xx)
285 ELSE
286C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
287 nb_ncn = nb_ncn + 1
288 bpn(nb_ncn) = j
289 bgapsmx = max(bgapsmx,xrem(13,j-nsn))
290 splus = min(splus,xx)
291 ENDIF
292 ENDIF
293 ENDDO
294
295 END IF
296C
297C 3- divide the elements
298C
299 IF(igap==0) THEN
300 nb_ecn= 0
301 addne= add(2,i_add)
302 IF(nb_ncn1==0) THEN
303 DO i=1,nb_ec
304 ne = bpe(i)
305 xx1=xa(dir, irect(1,ne))
306 xx2=xa(dir, irect(2,ne))
307 xx3=xa(dir, irect(3,ne))
308 xx4=xa(dir, irect(4,ne))
309 xmax=max(xx1,xx2,xx3,xx4)+tzinf+curv_max(ne)
310 IF(xmax >= splus) THEN
311C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
312 nb_ecn = nb_ecn + 1
313 bpe(nb_ecn) = ne
314 ENDIF
315 ENDDO
316 ELSEIF(nb_ncn==0) THEN
317 DO i=1,nb_ec
318 ne = bpe(i)
319 xx1=xa(dir, irect(1,ne))
320 xx2=xa(dir, irect(2,ne))
321 xx3=xa(dir, irect(3,ne))
322 xx4=xa(dir, irect(4,ne))
323 xmin=min(xx1,xx2,xx3,xx4)-tzinf-curv_max(ne)
324 IF(xmin < smoins) THEN
325C store at the bottom of the BP stack
326 addne = addne + 1
327 pe(addne) = ne
328 ENDIF
329 ENDDO
330 ELSE
331 DO i=1,nb_ec
332 ne = bpe(i)
333 xx1=xa(dir, irect(1,ne))
334 xx2=xa(dir, irect(2,ne))
335 xx3=xa(dir, irect(3,ne))
336 xx4=xa(dir, irect(4,ne))
337 xmin=min(xx1,xx2,xx3,xx4)-tzinf-curv_max(ne)
338 IF(xmin < smoins) THEN
339C store at the bottom of the BP stack
340 addne = addne + 1
341 pe(addne) = ne
342 ENDIF
343 xmax=max(xx1,xx2,xx3,xx4)+tzinf+curv_max(ne)
344 IF(xmax >= splus) THEN
345C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
346 nb_ecn = nb_ecn + 1
347 bpe(nb_ecn) = ne
348 ENDIF
349 ENDDO
350 ENDIF
351C
352C Optimisation gap variable
353 ELSE
354 nb_ecn= 0
355 addne= add(2,i_add)
356 IF(nb_ncn1==0) THEN
357 DO i=1,nb_ec
358 ne = bpe(i)
359 xx1=xa(dir, irect(1,ne))
360 xx2=xa(dir, irect(2,ne))
361 xx3=xa(dir, irect(3,ne))
362 xx4=xa(dir, irect(4,ne))
363 xmax=max(xx1,xx2,xx3,xx4)
364 + +min(max(bgapsmx+gap_m(ne),gapmin),gapmax)
365 + +marge+curv_max(ne)+two*gap_sh(ne)
366 IF(xmax >= splus) THEN
367C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
368 nb_ecn = nb_ecn + 1
369 bpe(nb_ecn) = ne
370 ENDIF
371 ENDDO
372 ELSEIF(nb_ncn==0) THEN
373 DO i=1,nb_ec
374 ne = bpe(i)
375 xx1=xa(dir, irect(1,ne))
376 xx2=xa(dir, irect(2,ne))
377 xx3=xa(dir, irect(3,ne))
378 xx4=xa(dir, irect(4,ne))
379 xmin=min(xx1,xx2,xx3,xx4)
380 - -min(max(gapsmx+gap_m(ne),gapmin),gapmax)
381 - -marge-curv_max(ne)-two*gap_sh(ne)
382 IF(xmin < smoins) THEN
383C store at the bottom of the BP stack
384 addne = addne + 1
385 pe(addne) = ne
386 ENDIF
387 ENDDO
388 ELSE
389 DO i=1,nb_ec
390 ne = bpe(i)
391 xx1=xa(dir, irect(1,ne))
392 xx2=xa(dir, irect(2,ne))
393 xx3=xa(dir, irect(3,ne))
394 xx4=xa(dir, irect(4,ne))
395 xmin=min(xx1,xx2,xx3,xx4)
396 - -min(max(gapsmx+gap_m(ne),gapmin),gapmax)
397 - -marge-curv_max(ne)-two*gap_sh(ne)
398 IF(xmin < smoins) THEN
399C store at the bottom of the BP stack
400 addne = addne + 1
401 pe(addne) = ne
402 ENDIF
403 xmax=max(xx1,xx2,xx3,xx4)
404 + +min(max(bgapsmx+gap_m(ne),gapmin),gapmax)
405 + +marge+curv_max(ne)+two*gap_sh(ne)
406 IF(xmax >= splus) THEN
407C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
408 nb_ecn = nb_ecn + 1
409 bpe(nb_ecn) = ne
410 ENDIF
411 ENDDO
412C
413 ENDIF
414 ENDIF
415C
416C 4- REMPLIR LES TABLEAUX D'ADRESSES
417C
418 add(1,i_add+1) = addnn
419 add(2,i_add+1) = addne
420Cfill the min of the next box and the max of the current one
421C (i.e. threshold is a max for the current one)
422C We're going to go down and so we define a new box
423C fill the max of the new box
424C initialises in i7buc1 a 1.E30 comme ca on recupere
425c either XMAX or the max of the box
426 xyzm(1,i_add+1) = xyzm(1,i_add)
427 xyzm(2,i_add+1) = xyzm(2,i_add)
428 xyzm(3,i_add+1) = xyzm(3,i_add)
429 xyzm(4,i_add+1) = xyzm(4,i_add)
430 xyzm(5,i_add+1) = xyzm(5,i_add)
431 xyzm(6,i_add+1) = xyzm(6,i_add)
432 xyzm(dir,i_add+1) = splus
433 xyzm(dir+3,i_add) = smoins
434C
435 nb_nc = nb_ncn
436 nb_ec = nb_ecn
437C increment the descent level before exiting
438 i_add = i_add + 1
439 IF(i_add+1>=i_add_max) THEN
440 i_mem = 3
441 RETURN
442 ENDIF
443C=======================================================================
444 200 CONTINUE
445C=======================================================================
446C-----------------------------------------------------------
447C
448C
449C 2- TEST ARRET = BOITE VIDE
450C BOITE TROP PETITE
451C BOITE NE CONTENANT QU'ONE NODE C NO MORE MEMORY AVAILABLE
452C
453C-------------------TEST ON MEMORY EXCEEDED------------
454C
455 IF(add(2,i_add)+nb_ec>maxsiz) THEN
456C NO MORE SPACE IN THE STACK OF TOO SMALL BOX ELEMENTS
457 i_mem = 1
458 RETURN
459 ENDIF
460C
461C--------------------TEST ON EMPTY BOXES--------------
462C
463 IF(nb_ec/=0.AND.nb_nc/=0) THEN
464C
465 dx = xyzm(4,i_add) - xyzm(1,i_add)
466 dy = xyzm(5,i_add) - xyzm(2,i_add)
467 dz = xyzm(6,i_add) - xyzm(3,i_add)
468 dsup= max(dx,dy,dz)
469C
470C-------------------TEST ON END OF BRANCH ------------
471C 1- STORAGE OF THE CANDIDATE NODE(S) AND CORRESPONDING ELEMENTS
472C REMOVE THE UNNECESSARY ONES
473C
474C NCAND_PROV=NB_EC*NB_NC
475C NCAND_PROV negatif qd NB_EC*NB_NC > 2e31
476C
477 IF(nb_ec+nb_nc<=nvecsz) THEN
478 ncand_prov = nb_ec*nb_nc
479 ELSE
480 ncand_prov = nvecsz+1
481 ENDIF
482
483 IF(dsup<minbox.OR.(nb_nc<=nb_n_b)
484 & .OR.(ncand_prov<=nvecsz)) THEN
485 ncand_prov = nb_ec*nb_nc
486 DO k=1,ncand_prov,nvsiz
487 IF(igap==0) THEN
488 DO l=k,min(k-1+nvsiz,ncand_prov)
489 i = 1+(l-1)/nb_nc
490 j = l-(i-1)*nb_nc
491 ne = bpe(i)
492 n1=irect(1,ne)
493 n2=irect(2,ne)
494 n3=irect(3,ne)
495 n4=irect(4,ne)
496 xx1=xa(1, n1)
497 xx2=xa(1, n2)
498 xx3=xa(1, n3)
499 xx4=xa(1, n4)
500 xmax=max(xx1,xx2,xx3,xx4)+tzinf+curv_max(ne)
501 xmin=min(xx1,xx2,xx3,xx4)-tzinf-curv_max(ne)
502 xx1=xa(2, n1)
503 xx2=xa(2, n2)
504 xx3=xa(2, n3)
505 xx4=xa(2, n4)
506 ymax=max(xx1,xx2,xx3,xx4)+tzinf+curv_max(ne)
507 ymin=min(xx1,xx2,xx3,xx4)-tzinf-curv_max(ne)
508 xx1=xa(3, n1)
509 xx2=xa(3, n2)
510 xx3=xa(3, n3)
511 xx4=xa(3, n4)
512 zmax=max(xx1,xx2,xx3,xx4)+tzinf+curv_max(ne)
513 zmin=min(xx1,xx2,xx3,xx4)-tzinf-curv_max(ne)
514 jj = bpn(j)
515 IF(jj<=nsn) THEN
516 nn=nsv(jj)
517 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4.AND.
518 & xa(1,nn)>xmin.AND.xa(1,nn)<xmax.AND.
519 & xa(2,nn)>ymin.AND.xa(2,nn)<ymax.AND.
520 & xa(3,nn)>zmin.AND.xa(3,nn)<zmax ) THEN
521
522 j_stok = j_stok + 1
523 prov_n(j_stok) = jj
524 prov_e(j_stok) = ne
525 ENDIF
526 ELSE
527 ii = jj-nsn
528 IF(xrem(1,ii)>xmin.AND.
529 & xrem(1,ii)<xmax.AND.
530 & xrem(2,ii)>ymin.AND.
531 & xrem(2,ii)<ymax.AND.
532 & xrem(3,ii)>zmin.AND.
533 & xrem(3,ii)<zmax ) THEN
534 j_stok = j_stok + 1
535 prov_n(j_stok) = jj
536 prov_e(j_stok) = ne
537 ENDIF
538 ENDIF
539 ENDDO
540 ELSE
541 DO l=k,min(k-1+nvsiz,ncand_prov)
542 i = 1+(l-1)/nb_nc
543 j = l-(i-1)*nb_nc
544 ne = bpe(i)
545 n1=irect(1,ne)
546 n2=irect(2,ne)
547 n3=irect(3,ne)
548 n4=irect(4,ne)
549 xx1=xa(1, n1)
550 xx2=xa(1, n2)
551 xx3=xa(1, n3)
552 xx4=xa(1, n4)
553 yy1=xa(2, n1)
554 yy2=xa(2, n2)
555 yy3=xa(2, n3)
556 yy4=xa(2, n4)
557 zz1=xa(3, n1)
558 zz2=xa(3, n2)
559 zz3=xa(3, n3)
560 zz4=xa(3, n4)
561 jj = bpn(j)
562 IF(jj<=nsn) THEN
563 tz=max(min(gap_s(jj)+gap_m(ne),gapmax),gapmin)
564 + +marge+curv_max(ne)+two*gap_sh(ne)
565 xmax=max(xx1,xx2,xx3,xx4)+tz
566 xmin=min(xx1,xx2,xx3,xx4)-tz
567 ymax=max(yy1,yy2,yy3,yy4)+tz
568 ymin=min(yy1,yy2,yy3,yy4)-tz
569 zmax=max(zz1,zz2,zz3,zz4)+tz
570 zmin=min(zz1,zz2,zz3,zz4)-tz
571 nn=nsv(jj)
572 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4.AND.
573 & xa(1,nn)>xmin.AND.xa(1,nn)<xmax.AND.
574 & xa(2,nn)>ymin.AND.xa(2,nn)<ymax.AND.
575 & xa(3,nn)>zmin.AND.xa(3,nn)<zmax ) THEN
576 j_stok = j_stok + 1
577 prov_n(j_stok) = jj
578 prov_e(j_stok) = ne
579 ENDIF
580 ELSE
581 ii = jj-nsn
582 tz=max(min(xrem(13,ii)+gap_m(ne),gapmax),gapmin)
583 + +marge+curv_max(ne)+two*gap_sh(ne)
584 xmax=max(xx1,xx2,xx3,xx4)+tz
585 xmin=min(xx1,xx2,xx3,xx4)-tz
586 ymax=max(yy1,yy2,yy3,yy4)+tz
587 ymin=min(yy1,yy2,yy3,yy4)-tz
588 zmax=max(zz1,zz2,zz3,zz4)+tz
589 zmin=min(zz1,zz2,zz3,zz4)-tz
590 IF(xrem(1,ii)>xmin.AND.
591 & xrem(1,ii)<xmax.AND.
592 & xrem(2,ii)>ymin.AND.
593 & xrem(2,ii)<ymax.AND.
594 & xrem(3,ii)>zmin.AND.
595 & xrem(3,ii)<zmax ) THEN
596 j_stok = j_stok + 1
597 prov_n(j_stok) = jj
598 prov_e(j_stok) = ne
599 ENDIF
600 ENDIF
601 ENDDO
602 END IF
603 IF(j_stok>=nvsiz)THEN
604 CALL i20sto(
605 1 nvsiz,irect ,xa ,nsv ,ii_stok,
606 2 cand_n,cand_e ,mulnsn,noint ,marge ,
607 3 i_mem ,prov_n ,prov_e,eshift,inacti ,
608 4 ifq ,cand_a ,cand_p,ifpen ,nsn ,
609 5 oldnum,nsnrold,igap ,gap ,gap_s ,
610 6 gap_m ,gapmin ,gapmax,curv_max,nin ,
611 7 gap_sh,nbinflg,mbinflg,isym )
612
613 IF(i_mem==2)RETURN
614 j_stok = j_stok-nvsiz
615#include "vectorize.inc"
616 DO j=1,j_stok
617 prov_n(j) = prov_n(j+nvsiz)
618 prov_e(j) = prov_e(j+nvsiz)
619 ENDDO
620 ENDIF
621 ENDDO
622 ELSE
623C=======================================================================
624 GOTO 100
625C=======================================================================
626 ENDIF
627 ENDIF
628C-------------------------------------------------------------------------
629C EMPTY BOX OR
630C END OF BRANCH
631C decrement the descent level before restarting
632C-------------------------------------------------------------------------
633 i_add = i_add - 1
634 IF (i_add/=0) THEN
635C-------------------------------------------------------------------------
636C MUST COPY THE BOTTOM OF STACKS INTO CORRESPONDING STACK_BOTTOM
637C BEFORE DESCENDING INTO THE ADJACENT BRANCH
638C-------------------------------------------------------------------------
639 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
640C=======================================================================
641 GOTO 200
642C=======================================================================
643 ENDIF
644C-------------------------------------------------------------------------
645C END OF SORTING
646C-------------------------------------------------------------------------
647 IF(j_stok/=0)CALL i20sto(
648 1 j_stok,irect ,xa ,nsv ,ii_stok,
649 2 cand_n,cand_e ,mulnsn,noint ,marge ,
650 3 i_mem ,prov_n ,prov_e,eshift,inacti ,
651 4 ifq ,cand_a ,cand_p,ifpen ,nsn ,
652 5 oldnum,nsnrold,igap ,gap ,gap_s ,
653 6 gap_m ,gapmin ,gapmax,curv_max,nin ,
654 7 gap_sh,nbinflg,mbinflg,isym)
655C-------------------------------------------------------------------------
656 RETURN
657 END
658!||====================================================================
659!|| i20tri_edge ../engine/source/interfaces/intsort/i20tri.F
660!||--- called by ------------------------------------------------------
661!|| i20buc_edge ../engine/source/interfaces/intsort/i20buce.F
662!||--- calls -----------------------------------------------------
663!|| i11insid ../engine/source/interfaces/intsort/i11tri.F
664!|| i20sto_edge ../engine/source/interfaces/intsort/i20sto.F
665!|| i7dstk ../engine/source/interfaces/intsort/i7dstk.F
666!||--- uses -----------------------------------------------------
667!|| tri7box ../engine/share/modules/tri7box.F
668!||====================================================================
669 SUBROUTINE i20tri_edge(
670 1 ADD ,XA ,NLG ,
671 2 IXLINS,IXLINM,NLINMA,NLINSR,
672 3 XYZM ,I_ADD ,MAXSIZ,II_STOKE ,CAND_S,
673 4 CAND_M,NSN4 ,NOINT ,TZINF ,MAXBOX,
674 5 MINBOX,I_MEM ,NB_N_B,I_ADD_MAX,ESHIFT,
675 6 ADDCM ,CHAINE,NLINSA ,ITAB ,NB_OLD,
676 7 STFS ,STFM ,IAUTO ,NIN )
677C============================================================================
678C M o d u l e s
679C-----------------------------------------------
680 USE tri7box
681C-----------------------------------------------
682C I m p l i c i t T Y p e s
683C-----------------------------------------------
684#include "implicit_f.inc"
685#include "r4r8_p.inc"
686C-----------------------------------------------
687C G l o b a l P a r a m e t e r s
688C-----------------------------------------------
689#include "mvsiz_p.inc"
690C-----------------------------------------------
691C C o m m o n B l o c k s
692C-----------------------------------------------
693#include "param_c.inc"
694C-----------------------------------------------
695C ROLE OF THE ROUTINE:
696C ===================
697C CLASSIFIES THE ELEMENTS OF BPE AND THE NODES OF BPN IN TWO ZONES
698C > OR < TO A BOUNDARY DETERMINED HERE AND OUTPUTS EVERYTHING
699C IN bpe,hpe, and bpn,hpn
700C-----------------------------------------------
701C D u m m Y A r g u m e n t s
702C
703C NOM DESCRIPTION E/S
704C
705C BPE ARRAY OF FACETTES TO SORT => Local
706C AND OF THE RESULT ON MAX SIDE
707C PE ARRAY OF FACETTES => Local
708C RESULTAT COTE MIN
709C BPN SORTED NODES ARRAY => Local
710C AND OF THE RESULT ON MAX SIDE
711C PN NODES ARRAY => Local
712C RESULTAT COTE MIN
713C ADD(2,*) ARRAY OF ADRESSES E/S
714C 1.......ADRESSES NODES C 2.......ADRESSES ELEMENTS
715C ZYZM(6,*) ARRAY OF XYZMIN E/S
716C 1.......XMIN BOITE
717C 2.......YMIN BOITE
718C 3.......ZMIN BOITE
719C 4.......XMAX BOITE
720C 5.......YMAX BOITE
721C 6.......ZMAX BOITE
722C IXLINM(2,*) ARRAY OF CONEC E
723C IXLINS(2,*) ARRAY OF CONEC E
724C X(3,*) COORDONNEES NODALES E
725C NB_NC NUMBER OF CANDIDATE NODES => Local
726C NB_EC NUMBER OF CANDIDATE ELEMENTS => Local
727C I_ADD POSITION IN THE I/O ADDRESS TABLE
728C Xmax larger abcisse existing e
729C XMAX largest order.existing E
730C Xmax larger existing side E
731C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
732C I_STOK storage level for pairs
733C CANDIDATES impact E/S
734C ADNSTK current address in the node box
735C CAND_S boites resultats nodes C ADESTK current address in the element box
736C CAND_M adresses des boites resultat elements
737C NSN4 4*NSN MAX SIZE ALLOWED NOW FOR THE
738C COUPLES NODES,ELT CANDIDATES
739C NOINT INTERFACE USER NUMBER
740C TZINF TAILLE ZONE INFLUENCE
741C MAXBOX TAILLE MAX BUCKET
742C MINBOX TAILLE MIN BUCKET
743C
744C Prov_s Provisional Cand_s (static variable in i7tri)
745C PROV_M CAND_M provisoire (variable static in i7tri)
746C-----------------------------------------------
747C D u m m Y A r g u m e n t s
748C-----------------------------------------------
749 INTEGER NLINMA,NLINSR,I_ADD,MAXSIZ,I_MEM,ESHIFT,NLINSA,
750 . NSN4,NB_N_B,NOINT,I_ADD_MAX,IAUTO ,NIN,
751 . ADD(2,*),IXLINS(2,*),IXLINM(2,*),
752 . CAND_S(*),CAND_M(*),ADDCM(*),CHAINE(2,*),ITAB(*),
753 . NB_OLD(2,*),NLG(*),II_STOKE
754C REAL
755 my_real
756 . XA(3,*),XYZM(6,*),STFS(*),STFM(*),
757 . TZINF,MAXBOX,MINBOX
758C-----------------------------------------------
759C L o c a l V a r i a b l e s
760C-----------------------------------------------
761 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NN1,NN2,
762 . N1,N2,NN,NE,K,L,NCAND_PROV,J_STOK,NI,
763 . ISTOP,NB_ECN1,PROV_S(2*MVSIZ),PROV_M(2*MVSIZ),
764 . NB_NC_OLD, NB_EC_OLD, NB_NC, NB_EC,JJ,KK,
765C BPE : used on NLINMA and not NLINMA + 100
766C BPN : used on NLINSA and not NLINSA + 100
767 . bpe(nlinma+100),pe(maxsiz),bpn(nlinsa+nlinsr+100),
768 . pn(maxsiz)
769C REAL
770 my_real
771 . dx,dy,dz,dsup,seuil, xx1, xx2,
772 . xmin, xmax,ymin, ymax,zmin, zmax,
773 . xmins,ymins,zmins,xmaxs,ymaxs,zmaxs,
774 . yy1,yy2,zz1,zz2,dmx,dmy,dmz,
775 . xy1,xy2,xz1,xz2,ximin,ximax,xjmin,xjmax,xkmin,xkmax,
776 . timin,timax,tjmin,tjmax,tkmin,tkmax,tsmin,tsmax,
777 . txmin, txmax,tymin, tymax,tzmin, tzmax
778 EXTERNAL i11insid
779 LOGICAL I11INSID
780C-----------------------------------------------
781C
782C Initial construction phase of BPE and BPN moved from I11BUCE => I11TRI
783C
784C
785C retrieving domain boundaries
786C
787 xmin = xyzm(1,i_add)
788 ymin = xyzm(2,i_add)
789 zmin = xyzm(3,i_add)
790 xmax = xyzm(4,i_add)
791 ymax = xyzm(5,i_add)
792 zmax = xyzm(6,i_add)
793
794C Copy segment and node numbers into BPE and BPN
795
796 nb_ec = 0
797 DO i=1,nlinma
798C We no longer retain the Destruit facets
799 IF(stfm(i)/=zero)THEN
800 nb_ec = nb_ec + 1
801 bpe(nb_ec) = i
802 END IF
803 ENDDO
804C
805C Optimization // search for nodes included in xmin xmax of
806C processor elements
807C
808 nb_nc = 0
809 DO i=1,nlinsa
810C We do not retain the Destruit facets
811 IF(stfs(i)/=zero)THEN
812 n1=ixlins(1,i)
813 n2=ixlins(2,i)
814 xmins = min(xa(1,n1),xa(1,n2))
815 ymins = min(xa(2,n1),xa(2,n2))
816 zmins = min(xa(3,n1),xa(3,n2))
817 xmaxs = max(xa(1,n1),xa(1,n2))
818 ymaxs = max(xa(2,n1),xa(2,n2))
819 zmaxs = max(xa(3,n1),xa(3,n2))
820 IF(xmaxs>=xmin.AND.xmins<=xmax.AND.
821 . ymaxs>=ymin.AND.ymins<=ymax.AND.
822 . zmaxs>=zmin.AND.zmins<=zmax)THEN
823 nb_nc = nb_nc + 1
824 bpn(nb_nc) = i
825 ENDIF
826 END IF
827 ENDDO
828C
829C Non -local candidate account in SPMD
830C
831 DO i = nlinsa+1, nlinsa+nlinsr
832 nb_nc = nb_nc + 1
833 bpn(nb_nc) = i
834 ENDDO
835C
836C GOTO 200:
837C INTERFACE WITH 1 SEGMENT ET 1 NODE + INITIALISATION DX DY DZ
838C
839 j_stok = 0
840 istop = 0
841 nb_nc_old = 0
842 nb_ec_old = 0
843C
844 nb_old(1,i_add) = 0
845 nb_old(2,i_add) = 0
846
847 dx = xyzm(4,i_add) - xyzm(1,i_add)
848 dy = xyzm(5,i_add) - xyzm(2,i_add)
849 dz = xyzm(6,i_add) - xyzm(3,i_add)
850 dsup= max(dx,dy,dz)
851 GOTO 200
852C=======================================================================
853 100 CONTINUE
854C=======================================================================
855C-----------------------------------------------------------
856C
857C
858C 1- SORTING PHASE ON THE MEDIAN ALONG THE LARGEST DIRECTION
859C
860C
861C-----------------------------------------------------------
862C
863C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
864C
865 xmin = 1.e30
866 xmax = -1.e30
867
868 ymin = 1.e30
869 ymax = -1.e30
870
871 zmin = 1.e30
872 zmax = -1.e30
873
874 DO i=1,nb_ec
875 ne = bpe(i)
876 xx1=xa(1, ixlinm(1,ne))
877 xx2=xa(1, ixlinm(2,ne))
878 xmin=min(xmin,xx1,xx2)
879 xmax=max(xmax,xx1,xx2)
880
881 yy1=xa(2, ixlinm(1,ne))
882 yy2=xa(2, ixlinm(2,ne))
883 ymin=min(ymin,yy1,yy2)
884 ymax=max(ymax,yy1,yy2)
885
886 zz1=xa(3, ixlinm(1,ne))
887 zz2=xa(3, ixlinm(2,ne))
888 zmin=min(zmin,zz1,zz2)
889 zmax=max(zmax,zz1,zz2)
890 ENDDO
891
892c box size reduction:
893c keep a margin of TZINF when reducing box size
894c to avoid forgetting secondary elements
895c
896c | Tzinf Tzinf |Tzinf
897c | <-----x-----> |<---->
898c | .............................|............Tymax ^
899c | . | . |
900c | . #################|#####.## | Tzinf
901c | . #////////////////|/////./# |
902c -----+----------------------------------+---------Ymax= v
903c | . |\\\\\#/// espace //|/////./# Ymax_old
904c | . |\\\#/// occupied by//|/////./#
905c | . |\\\#///the mains//|/////./#
906c | . |\\\\\#////////////////|/////./#
907c | . |\\\\\#////////////////|/////./#
908c | . |\\\\\#################|#####.## ^
909c | . |\\\ espace retenu \\| . |
910c | . |\␌or the secondaries\| . | Tzinf
911c |.| \\\ (new box) \\ |.|
912c | . +----------------------| ....Ymin x
913c | . | . |
914c | . (boite de recherche main) . | Tzinf
915c | . | . |
916c | .............................|.........Tymin v
917c | . . | .
918c | . . | .
919c |(old box) |.
920c | . . | .
921c | . . | .
922c -----+----------------------------------+---------Ymin_old
923c | . . | .
924c | . . Xmax= .
925c Xmin_old . . Xmax_old .
926c . Xmin Txmax
927c Txmin
928c
929c if the box is reduced on the Xmin side we could use:
930c Txmin = Xmin with Xmin = min(Xmain)-Tzinf > Xmin_old
931c
932c But using:
933c Txmin = Xmin-Tzinf (= min(Xmain) - 2*Tzinf)
934c on ne penalise pas I11INSIND
935c (there is no main in the overestimated zone)
936c and the calculation of Xmin, Txmin ... is simpler
937
938
939 xmin = max(xmin - tzinf , xyzm(1,i_add))
940 ymin = max(ymin - tzinf , xyzm(2,i_add))
941 zmin = max(zmin - tzinf , xyzm(3,i_add))
942 xmax = min(xmax + tzinf , xyzm(4,i_add))
943 ymax = min(ymax + tzinf , xyzm(5,i_add))
944 zmax = min(zmax + tzinf , xyzm(6,i_add))
945
946 txmin = xmin - tzinf
947 tymin = ymin - tzinf
948 tzmin = zmin - tzinf
949 txmax = xmax + tzinf
950 tymax = ymax + tzinf
951 tzmax = zmax + tzinf
952
953 dmx = xmax-xmin
954 dmy = ymax-ymin
955 dmz = zmax-zmin
956
957 dsup = max(dmx,dmy,dmz)
958
959 IF(dmy==dsup) THEN
960 dir = 2
961 jj = 3
962 kk = 1
963 seuil = (ymin+ymax)*0.5
964 ximin = ymin
965 xjmin = zmin
966 xkmin = xmin
967 ximax = ymax
968 xjmax = zmax
969 xkmax = xmax
970 timin = tymin
971 tjmin = tzmin
972 tkmin = txmin
973 timax = tymax
974 tjmax = tzmax
975 tkmax = txmax
976 ELSE IF(dmz==dsup) THEN
977 dir = 3
978 jj = 1
979 kk = 2
980 seuil = (zmin+zmax)*0.5
981 ximin = zmin
982 xjmin = xmin
983 xkmin = ymin
984 ximax = zmax
985 xjmax = xmax
986 xkmax = ymax
987 timin = tzmin
988 tjmin = txmin
989 tkmin = tymin
990 timax = tzmax
991 tjmax = txmax
992 tkmax = tymax
993 ELSE
994 dir = 1
995 jj = 2
996 kk = 3
997 seuil = (xmin+xmax)*0.5
998 ximin = xmin
999 xjmin = ymin
1000 xkmin = zmin
1001 ximax = xmax
1002 xjmax = ymax
1003 xkmax = zmax
1004 timin = txmin
1005 tjmin = tymin
1006 tkmin = tzmin
1007 timax = txmax
1008 tjmax = tymax
1009 tkmax = tzmax
1010 ENDIF
1011
1012 tsmin = seuil - tzinf
1013 tsmax = seuil + tzinf
1014
1015C
1016C 2- DIVISER LES SECONDS EN TWO ZONES
1017C
1018
1019c +-----------+-----------+--Xjmax
1020c | | |
1021c | | |
1022c | | |
1023c | | |
1024c +-----------+-----------+--Xjmin
1025c | | |
1026c Ximin Seuil Ximax
1027c
1028
1029
1030
1031 nb_ncn= 0
1032 nb_ncn1= 0
1033 addnn= add(1,i_add)
1034 DO i=1,nb_nc
1035 nn = bpn(i)
1036 IF(nn<=nlinsa) THEN
1037 xx1=xa(dir,ixlins(1,nn))
1038 xx2=xa(dir,ixlins(2,nn))
1039 xy1=xa(jj, ixlins(1,nn))
1040 xy2=xa(jj, ixlins(2,nn))
1041 xz1=xa(kk, ixlins(1,nn))
1042 xz2=xa(kk, ixlins(2,nn))
1043 ELSE
1044 ni = nn-nlinsa
1045 xx1=xrem(dir+1,ni)
1046 xx2=xrem(dir+9,ni)
1047 xy1=xrem(jj+1 ,ni)
1048 xy2=xrem(jj+9 ,ni)
1049 xz1=xrem(kk+1 ,ni)
1050 xz2=xrem(kk+9 ,ni)
1051 END IF
1052 xmax=max(xx1,xx2)
1053 xmin=min(xx1,xx2)
1054 IF(xmin<seuil.AND.xmax>=ximin) THEN
1055 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1056 . ximin,seuil,xjmin,xjmax,xkmin,xkmax)) THEN
1057C STORE AT THE BOTTOM OF THE BP STACK
1058 nb_ncn1 = nb_ncn1 + 1
1059 addnn = addnn + 1
1060 pn(addnn) = nn
1061 END IF
1062 END IF
1063 IF(xmax>=seuil.AND.xmin<=ximax) THEN
1064 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1065 . seuil,ximax,xjmin,xjmax,xkmin,xkmax)) THEN
1066C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
1067 nb_ncn = nb_ncn + 1
1068 bpn(nb_ncn) = nn
1069 ENDIF
1070 ENDIF
1071 ENDDO
1072C
1073C 3- DIVIDE THE MAINS
1074C
1075
1076c Tzinf Tzinf Tzinf Tzinf
1077c <----> <----x----> <---->
1078c ............,.,.,.,.,..,,,,,,,,,,,,--Tjmax ^
1079c . , . , | Tzinf
1080c . , . , |
1081c . +------,----+----.------+ ,--Xjmax v
1082c . | , | . | ,
1083c . | , | . | ,
1084c . | , | . | ,
1085c . | , | . | ,
1086c . +------,----+----.------+ ,--Xjmin ^
1087c . , . , | Tzinf
1088c . , . , |
1089c ............,.,.,.,.,..,,,,,,,,,,,,--Tjmin v
1090c | | | | | | |
1091c | Ximin | Seuil | Ximax |
1092c Timin Tsmin Tsmax Timax
1093c
1094c If the box has been reworked (see 1)
1095c it is possible that Timin=Ximin ...
1096
1097
1098 nb_ecn= 0
1099 nb_ecn1= 0
1100 addne= add(2,i_add)
1101 IF(nb_ncn1==0) THEN
1102 DO i=1,nb_ec
1103 ne = bpe(i)
1104 xx1=xa(dir, ixlinm(1,ne))
1105 xx2=xa(dir, ixlinm(2,ne))
1106 IF(max(xx1,xx2)>=tsmin) THEN
1107 xy1=xa(jj, ixlinm(1,ne))
1108 xy2=xa(jj, ixlinm(2,ne))
1109 xz1=xa(kk, ixlinm(1,ne))
1110 xz2=xa(kk, ixlinm(2,ne))
1111 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1112 . tsmin,timax,tjmin,tjmax,tkmin,tkmax)) THEN
1113C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
1114 nb_ecn = nb_ecn + 1
1115 bpe(nb_ecn) = ne
1116 ENDIF
1117 ENDIF
1118 ENDDO
1119 ELSEIF(nb_ncn==0) THEN
1120 DO i=1,nb_ec
1121 ne = bpe(i)
1122 xx1=xa(dir, ixlinm(1,ne))
1123 xx2=xa(dir, ixlinm(2,ne))
1124 IF(min(xx1,xx2)<tsmax) THEN
1125 xy1=xa(jj, ixlinm(1,ne))
1126 xy2=xa(jj, ixlinm(2,ne))
1127 xz1=xa(kk, ixlinm(1,ne))
1128 xz2=xa(kk, ixlinm(2,ne))
1129 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1130 . timin,tsmax,tjmin,tjmax,tkmin,tkmax)) THEN
1131C STORE AT THE BOTTOM OF THE BP STACK
1132 addne = addne + 1
1133 nb_ecn1= nb_ecn1 + 1
1134 pe(addne) = ne
1135 ENDIF
1136 ENDIF
1137 ENDDO
1138 ELSE
1139 DO i=1,nb_ec
1140 ne = bpe(i)
1141 xx1=xa(dir, ixlinm(1,ne))
1142 xx2=xa(dir, ixlinm(2,ne))
1143 xy1=xa(jj, ixlinm(1,ne))
1144 xy2=xa(jj, ixlinm(2,ne))
1145 xz1=xa(kk, ixlinm(1,ne))
1146 xz2=xa(kk, ixlinm(2,ne))
1147 IF(min(xx1,xx2)<tsmax) THEN
1148 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1149 . timin,tsmax,tjmin,tjmax,tkmin,tkmax)) THEN
1150C STORE AT THE BOTTOM OF THE BP STACK
1151 addne = addne + 1
1152 nb_ecn1= nb_ecn1 + 1
1153 pe(addne) = ne
1154 ENDIF
1155 ENDIF
1156 IF(max(xx1,xx2)>=tsmin) THEN
1157 IF(i11insid(xx1,xx2,xy1,xy2,xz1,xz2,
1158 . tsmin,timax,tjmin,tjmax,tkmin,tkmax)) THEN
1159C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
1160 nb_ecn = nb_ecn + 1
1161 bpe(nb_ecn) = ne
1162 ENDIF
1163 ENDIF
1164 ENDDO
1165 ENDIF
1166C
1167C 4- REMPLIR LES TABLEAUX D'ADRESSES
1168C
1169 add(1,i_add+1) = addnn
1170 add(2,i_add+1) = addne
1171Cfill the min of the next box and the max of the current one
1172C (i.e. threshold is a max for the current one)
1173C We're going to go down and so we define a new box
1174C fill the max of the new box
1175C initialises in i7buc1 a 1.E30 comme ca on recupere
1176c either XMAX or the max of the box
1177 xyzm(1,i_add+1) = xyzm(1,i_add)
1178 xyzm(2,i_add+1) = xyzm(2,i_add)
1179 xyzm(3,i_add+1) = xyzm(3,i_add)
1180 xyzm(4,i_add+1) = xyzm(4,i_add)
1181 xyzm(5,i_add+1) = xyzm(5,i_add)
1182 xyzm(6,i_add+1) = xyzm(6,i_add)
1183 xyzm(dir ,i_add) = ximin
1184 xyzm(dir+3,i_add) = seuil
1185 xyzm(dir ,i_add+1) = seuil
1186 xyzm(dir+3,i_add+1) = ximax
1187C
1188 nb_old(1,i_add)=nb_nc
1189 nb_old(2,i_add)=nb_ec
1190 nb_old(1,i_add+1)=nb_nc
1191 nb_old(2,i_add+1)=nb_ec
1192C
1193 nb_nc = nb_ncn
1194 nb_ec = nb_ecn
1195C increment the descent level before exiting
1196 i_add = i_add + 1
1197 IF(i_add+1>=i_add_max) THEN
1198 i_mem = 3
1199 RETURN
1200 ENDIF
1201C=======================================================================
1202 200 CONTINUE
1203C=======================================================================
1204C-----------------------------------------------------------
1205C
1206C
1207C 2- TEST ARRET = BOITE VIDE
1208C BOITE TROP PETITE
1209C BOITE NE CONTENANT QU'ONE NODE C NO MORE MEMORY AVAILABLE
1210C THE PARTITIONING DOES NOT REDUCE THE CANDIDATES
1211C
1212C-------------------TEST ON MEMORY EXCEEDED------------
1213C
1214 IF(add(1,i_add)+nb_nc>maxsiz) THEN
1215C NO MORE SPACE IN THE STACK OF TOO SMALL SECONDARY BOX SIDES
1216 i_mem = 1
1217 RETURN
1218 ENDIF
1219 IF(add(2,i_add)+nb_ec>maxsiz) THEN
1220C NO MORE SPACE IN THE STACK OF TOO SMALL MAIN BOX SIDES
1221 i_mem = 1
1222 RETURN
1223 ENDIF
1224C
1225C--------------------TEST ON EMPTY BOXES--------------
1226C
1227 IF(nb_ec/=0.AND.nb_nc/=0) THEN
1228C
1229 dx = xyzm(4,i_add) - xyzm(1,i_add)
1230 dy = xyzm(5,i_add) - xyzm(2,i_add)
1231 dz = xyzm(6,i_add) - xyzm(3,i_add)
1232 dsup= max(dx,dy,dz)
1233C
1234C-------------------TEST ON END OF BRANCH ------------
1235C 1- storage of candidate node(s) and corresponding elements
1236C remove the useless ones
1237C
1238 IF(nb_ec+nb_nc<=128) THEN
1239 ncand_prov = nb_ec*nb_nc
1240 ELSE
1241 ncand_prov = 129
1242 ENDIF
1243C
1244 nb_nc_old = nb_old(1,i_add)
1245 nb_ec_old = nb_old(2,i_add)
1246
1247 IF(dsup<minbox.OR.
1248 . nb_nc<=nb_n_b.OR.nb_ec<=nb_n_b.OR.
1249 . ncand_prov<=128.OR.(nb_ec==nb_ec_old
1250 . .AND.nb_nc==nb_nc_old)) THEN
1251C
1252 ncand_prov = nb_ec*nb_nc
1253 DO k=1,ncand_prov,nvsiz
1254 DO l=k,min(k-1+nvsiz,ncand_prov)
1255 i = 1+(l-1)/nb_nc
1256 j = l-(i-1)*nb_nc
1257 ne = bpe(i)
1258 nn = bpn(j)
1259 n1=ixlinm(1,ne)
1260 n2=ixlinm(2,ne)
1261 IF(nn<=nlinsa) THEN
1262 nn1=ixlins(1,nn)
1263 nn2=ixlins(2,nn)
1264 IF(iauto==0 .OR. itab(nlg(n1))>itab(nlg(nn1)) )THEN
1265 IF(nn1/=n1.AND.nn1/=n2.AND.
1266 . nn2/=n1.AND.nn2/=n2) THEN
1267 j_stok = j_stok + 1
1268 prov_s(j_stok) = nn
1269 prov_m(j_stok) = ne
1270 ENDIF
1271 ENDIF
1272 ELSE
1273 ni = nn-nlinsa
1274 IF(ir4r8 == 2) THEN
1275 nn1 = nint(xrem(9,ni))
1276 nn2 = nint(xrem(17,ni))
1277 ELSE
1278 nn1 = irem(1,ni)
1279 nn2 = irem(2,ni)
1280 END IF
1281 n1 = itab(nlg(n1))
1282 n2 = itab(nlg(n2))
1283 IF(iauto==0 .OR. n1>nn1 )THEN
1284 IF(nn1/=n1.AND.nn1/=n2.AND.
1285 . nn2/=n1.AND.nn2/=n2) THEN
1286 j_stok = j_stok + 1
1287 prov_s(j_stok) = nn
1288 prov_m(j_stok) = ne
1289 ENDIF
1290 ENDIF
1291 END IF
1292 ENDDO
1293 IF(j_stok>=nvsiz)THEN
1294 CALL i20sto_edge(
1295 1 nvsiz,ixlins,ixlinm,xa ,ii_stoke,
1296 2 cand_s,cand_m,nsn4 ,noint ,tzinf ,
1297 3 i_mem ,prov_s,prov_m,eshift,addcm ,
1298 4 chaine,nlinsa ,nin )
1299 IF(i_mem==2)RETURN
1300 j_stok = j_stok-nvsiz
1301#include "vectorize.inc"
1302 DO j=1,j_stok
1303 prov_s(j) = prov_s(j+nvsiz)
1304 prov_m(j) = prov_m(j+nvsiz)
1305 ENDDO
1306 ENDIF
1307 ENDDO
1308 ELSE
1309C=======================================================================
1310 GOTO 100
1311C=======================================================================
1312 ENDIF
1313 ENDIF
1314C-------------------------------------------------------------------------
1315C empty box or
1316C end of branch
1317C decrement the descent level before restarting
1318C-------------------------------------------------------------------------
1319 i_add = i_add - 1
1320 IF (i_add/=0) THEN
1321C-------------------------------------------------------------------------
1322C need to copy the bottoms of stacks into corresponding bas_de_pile
1323C before going down into the adjacent branch
1324C-------------------------------------------------------------------------
1325 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
1326C=======================================================================
1327 GOTO 200
1328C=======================================================================
1329 ENDIF
1330C-------------------------------------------------------------------------
1331C end of sorting
1332C-------------------------------------------------------------------------
1333 IF(j_stok/=0)CALL i20sto_edge(
1334 1 j_stok,ixlins,ixlinm,xa ,ii_stoke,
1335 2 cand_s,cand_m,nsn4 ,noint ,tzinf ,
1336 3 i_mem ,prov_s,prov_m,eshift,addcm ,
1337 4 chaine,nlinsa ,nin )
1338C-------------------------------------------------------------------------
1339 RETURN
1340 END
1341
i11insid
logical function i11insid(x1, x2, y1, y2, z1, z2, xmin, xmax, ymin, ymax, zmin, zmax)
Definition i11tri.F:738
i20sto
subroutine i20sto(j_stok, irect, xa, nsv, ii_stok, cand_n, cand_e, mulnsn, noint, marge, i_mem, prov_n, prov_e, eshift, inacti, ifq, cand_a, cand_p, ifpen, nsn, oldnum, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, curv_max, nin, gap_sh, nbinflg, mbinflg, isym)
Definition i20sto.F:42
i20sto_edge
subroutine i20sto_edge(j_stok, ixlins, ixlinm, xa, ii_stoke, cand_s, cand_m, nsn4, noint, tzinf, i_mem, prov_s, prov_m, eshift, addcm, chaine, nlinsa, nin)
Definition i20sto.F:213
i20tri_edge
subroutine i20tri_edge(add, xa, nlg, ixlins, ixlinm, nlinma, nlinsr, xyzm, i_add, maxsiz, ii_stoke, cand_s, cand_m, nsn4, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, eshift, addcm, chaine, nlinsa, itab, nb_old, stfs, stfm, iauto, nin)
Definition i20tri.F:677
i20tri
subroutine i20tri(add, nsn, renum, nsnr, isznsnr, irect, xa, stf, stfa, xyzm, i_add, nsv, maxsiz, ii_stok, cand_n, cand_e, mulnsn, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, eshift, inacti, ifq, cand_a, cand_p, ifpen, nrtm, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, marge, curv_max, nin, gap_sh, nbinflg, mbinflg, isym, intheat, idt_therm, nodadt_therm)
Definition i20tri.F:45
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
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339
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:33