OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i10tri.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i10tri ../engine/source/interfaces/intsort/i10tri.F
25!||--- called by ------------------------------------------------------
26!|| i10buce ../engine/source/interfaces/intsort/i10buce.F
27!||--- calls -----------------------------------------------------
28!|| i10sto ../engine/source/interfaces/intsort/i10sto.F
29!|| i7dstk ../engine/source/interfaces/intsort/i7dstk.F
30!|| spmd_oldnumcd ../engine/source/mpi/interfaces/spmd_i7tool.F
31!||--- uses -----------------------------------------------------
32!|| tri7box ../engine/share/modules/tri7box.F
33!||====================================================================
34 SUBROUTINE i10tri(
35 1 ADD ,NSN ,RENUM ,NSNR ,NRTM ,
36 2 IRECT ,X ,XYZM ,IGAP ,GAP ,
37 3 I_ADD ,NSV ,MAXSIZ ,II_STOK ,CAND_N ,
38 4 CAND_E,NSN4 ,NOINT ,TZINF ,MAXBOX ,
39 5 MINBOX,I_MEM ,NB_N_B ,I_ADD_MAX,CAND_A ,
40 6 ESHIFT,NSNROLD,STF ,STFN ,GAP_S ,
41 7 GAP_M ,GAPMIN ,GAPMAX ,MARGE ,NIN ,
42 8 INTHEAT,IDT_THERM,NODADT_THERM)
43C============================================================================
44C this routine is called by: I10BUCE(/int10/i10buce.F)
45C----------------------------------------------------------------------------
46C cette routine appelle : I10STO(/int10/i10sto.F)
47C I7DSTK(/int7/i7dstk.F)
48C============================================================================
49C M o d u l e s
50C-----------------------------------------------
51 USE tri7box
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C G l o b a l P a r a m e t e r s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "com01_c.inc"
64#include "param_c.inc"
65C-----------------------------------------------
66C role of the routine:
67C ===================
68C classifies BPE elements and BPN nodes 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 on max side
78C PE ARRAY OF FACETTES => Local
79C RESULTAT COTE MIN
80C BPN SORTED NODES ARRAY => Local
81C and of the result on 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 CAND_A address of N in sorted CAND_N
107C ADESTK current address in the element box
108C CAND_E adresses des boites resultat elements
109C NSN4 4*NSN maximum size now allowed for
110C COUPLES NODES,ELT CANDIDATES
111C NOINT INTERFACE USER NUMBER
112C TZINF TAILLE ZONE INFLUENCE
113C MAXBOX TAILLE MAX BUCKET
114C MINBOX TAILLE MIN BUCKET
115C Prov_n Provisional Cand_n (static variable in i7tri)
116C PROV_E CAND_E provisoire (variable static in i7tri)
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,NSNROLD,
121 . NSN4,NB_N_B,NOINT,I_ADD_MAX,NSNR,NRTM,IGAP,
122 . ADD(2,*),IRECT(4,*),II_STOK,
123 . NSV(*),CAND_N(*),CAND_E(*),CAND_A(*),RENUM(*)
124 INTEGER, INTENT(IN) :: INTHEAT
125 INTEGER, INTENT(IN) :: IDT_THERM
126 INTEGER, INTENT(IN) :: NODADT_THERM
127C REAL
128 my_real
129 . x(3,*),xyzm(6,*),stf(*),stfn(*),gap_s(*),gap_m(*),
130 . tzinf,maxbox,minbox,gap,gapmin,gapmax,marge
131C-----------------------------------------------
132C L o c a l V a r i a b l e s
133C-----------------------------------------------
134 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NB_NC,NB_EC,
135 . N1,N2,N3,N4,NN,NE,K,L,NCAND_PROV,J_STOK,II,JJ,NIN,
136 . prov_n(2*mvsiz),prov_e(2*mvsiz),oldnum(nsnr),
137C BPE: Use on nrtm and not nrtm + 100 rigorously (here maxsiz = nrtm + 100)
138 . bpe(maxsiz/3),pe(maxsiz),bpn(nsn+nsnr),pn(nsn+nsnr)
139C REAL
140 my_real
141 . dx,dy,dz,dsup,seuil, xx1, xx2, xx3, xx4,
142 . xmin,xmax,ymin,ymax,zmin,zmax, tz, gapsmx, bgapsmx
143C-----------------------------------------------
144C
145C initial construction phase of BPE and BPN moved from I10BUCE => I10TRI
146C
147 xmin = xyzm(1,i_add)
148 ymin = xyzm(2,i_add)
149 zmin = xyzm(3,i_add)
150 xmax = xyzm(4,i_add)
151 ymax = xyzm(5,i_add)
152 zmax = xyzm(6,i_add)
153C
154C copy 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(stf(i)/=zero)THEN
160 nb_ec = nb_ec + 1
161 bpe(nb_ec) = i
162 END IF
163 ENDDO
164C
165C optimization // search for nodes within xmin xmax of
166C processor elements
167C
168 nb_nc = 0
169 DO i=1,nsn
170 j=nsv(i)
171 IF(stfn(i)/=zero) THEN
172 IF(x(1,j)>=xmin.AND.x(1,j)<=xmax.AND.
173 . x(2,j)>=ymin.AND.x(2,j)<=ymax.AND.
174 . x(3,j)>=zmin.AND.x(3,j)<=zmax)THEN
175 nb_nc = nb_nc + 1
176 bpn(nb_nc) = i
177 ENDIF
178 END IF
179 ENDDO
180C
181C Non -local candidate account in SPMD
182C
183 DO i = nsn+1, nsn+nsnr
184 nb_nc = nb_nc + 1
185 bpn(nb_nc) = i
186 ENDDO
187C
188C In SPMD, finds former number of non -local candidates
189C
190 IF(nspmd>1) THEN
191 CALL spmd_oldnumcd(renum,oldnum,nsnr,nsnrold,intheat,idt_therm,nodadt_therm)
192 END IF
193C
194 j_stok = 0
195 GOTO 200
196C=======================================================================
197 100 CONTINUE
198C=======================================================================
199C-----------------------------------------------------------
200C
201C
202C 1- sorting phase on the median along the largest direction
203C
204C
205C-----------------------------------------------------------
206C
207C
208C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
209C
210 dir = 1
211 IF(dy==dsup) THEN
212 dir = 2
213 ELSE IF(dz==dsup) THEN
214 dir = 3
215 ENDIF
216 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))*0.5
217C
218C 2- DIVISER LES NODES EN TWO ZONES
219C
220 nb_ncn= 0
221 nb_ncn1= 0
222 addnn= add(1,i_add)
223 IF(igap==0)THEN
224 DO i=1,nb_nc
225 j = bpn(i)
226 IF(j<=nsn) THEN
227 IF(x(dir,nsv(j))<seuil) THEN
228C store at the bottom of the bp stack
229 nb_ncn1 = nb_ncn1 + 1
230 addnn = addnn + 1
231 pn(addnn) = j
232 ENDIF
233 ELSE
234 IF(xrem(dir,j-nsn)<seuil) THEN
235C store at the bottom of the bp stack
236 nb_ncn1 = nb_ncn1 + 1
237 addnn = addnn + 1
238 pn(addnn) = j
239 ENDIF
240 ENDIF
241 ENDDO
242C
243 DO i=1,nb_nc
244 j = bpn(i)
245 IF(j<=nsn) THEN
246 IF(x(dir,nsv(j))>=seuil) THEN
247C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
248 nb_ncn = nb_ncn + 1
249 bpn(nb_ncn) = j
250 ENDIF
251 ELSE
252 IF(xrem(dir,j-nsn)>=seuil) THEN
253C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
254 nb_ncn = nb_ncn + 1
255 bpn(nb_ncn) = j
256 ENDIF
257 ENDIF
258 ENDDO
259 ELSE
260 gapsmx = zero
261 DO i=1,nb_nc
262 j = bpn(i)
263 IF(j<=nsn) THEN
264 IF(x(dir,nsv(j))<seuil) THEN
265C store at the bottom of the bp stack
266 nb_ncn1 = nb_ncn1 + 1
267 addnn = addnn + 1
268 pn(addnn) = j
269 gapsmx = max(gapsmx,gap_s(j))
270 ENDIF
271 ELSE
272 IF(xrem(dir,j-nsn)<seuil) THEN
273C store at the bottom of the bp stack
274 nb_ncn1 = nb_ncn1 + 1
275 addnn = addnn + 1
276 pn(addnn) = j
277 gapsmx = max(gapsmx,xrem(9,j-nsn))
278 ENDIF
279 ENDIF
280 ENDDO
281C
282 bgapsmx = zero
283 DO i=1,nb_nc
284 j = bpn(i)
285 IF(j<=nsn) THEN
286 IF(x(dir,nsv(j))>=seuil) THEN
287C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
288 nb_ncn = nb_ncn + 1
289 bpn(nb_ncn) = j
290 bgapsmx = max(bgapsmx,gap_s(j))
291 ENDIF
292 ELSE
293 IF(xrem(dir,j-nsn)>=seuil) THEN
294C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
295 nb_ncn = nb_ncn + 1
296 bpn(nb_ncn) = j
297 bgapsmx = max(bgapsmx,xrem(9,j-nsn))
298 ENDIF
299 ENDIF
300 ENDDO
301 END IF
302C
303C 3- divide the elements
304C
305 IF(igap==0) THEN
306 nb_ecn= 0
307 addne= add(2,i_add)
308 IF(nb_ncn1==0) THEN
309 DO i=1,nb_ec
310 ne = bpe(i)
311 xx1=x(dir, irect(1,ne))
312 xx2=x(dir, irect(2,ne))
313 xx3=x(dir, irect(3,ne))
314 xx4=x(dir, irect(4,ne))
315 xmax=max(xx1,xx2,xx3,xx4)+tzinf
316 IF(xmax>=seuil) THEN
317C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
318 nb_ecn = nb_ecn + 1
319 bpe(nb_ecn) = ne
320 ENDIF
321 ENDDO
322 ELSEIF(nb_ncn==0) THEN
323 DO i=1,nb_ec
324 ne = bpe(i)
325 xx1=x(dir, irect(1,ne))
326 xx2=x(dir, irect(2,ne))
327 xx3=x(dir, irect(3,ne))
328 xx4=x(dir, irect(4,ne))
329 xmin=min(xx1,xx2,xx3,xx4)-tzinf
330 IF(xmin<seuil) THEN
331C store at the bottom of the bp stack
332 addne = addne + 1
333 pe(addne) = ne
334 ENDIF
335 ENDDO
336 ELSE
337 DO i=1,nb_ec
338 ne = bpe(i)
339 xx1=x(dir, irect(1,ne))
340 xx2=x(dir, irect(2,ne))
341 xx3=x(dir, irect(3,ne))
342 xx4=x(dir, irect(4,ne))
343 xmin=min(xx1,xx2,xx3,xx4)-tzinf
344 IF(xmin<seuil) THEN
345C store at the bottom of the bp stack
346 addne = addne + 1
347 pe(addne) = ne
348 ENDIF
349 ENDDO
350 DO i=1,nb_ec
351 ne = bpe(i)
352 xx1=x(dir, irect(1,ne))
353 xx2=x(dir, irect(2,ne))
354 xx3=x(dir, irect(3,ne))
355 xx4=x(dir, irect(4,ne))
356 xmax=max(xx1,xx2,xx3,xx4)+tzinf
357 IF(xmax>=seuil) THEN
358C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
359 nb_ecn = nb_ecn + 1
360 bpe(nb_ecn) = ne
361 ENDIF
362 ENDDO
363 ENDIF
364C Optimisation gap variable
365 ELSE
366 nb_ecn= 0
367 addne= add(2,i_add)
368 IF(nb_ncn1==0) THEN
369 DO i=1,nb_ec
370 ne = bpe(i)
371 xx1=x(dir, irect(1,ne))
372 xx2=x(dir, irect(2,ne))
373 xx3=x(dir, irect(3,ne))
374 xx4=x(dir, irect(4,ne))
375 xmax=max(xx1,xx2,xx3,xx4)
376 + +min(max(bgapsmx+gap_m(ne),gapmin),gapmax)+marge
377 IF(xmax>=seuil) THEN
378C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
379 nb_ecn = nb_ecn + 1
380 bpe(nb_ecn) = ne
381 ENDIF
382 ENDDO
383 ELSEIF(nb_ncn==0) THEN
384 DO i=1,nb_ec
385 ne = bpe(i)
386 xx1=x(dir, irect(1,ne))
387 xx2=x(dir, irect(2,ne))
388 xx3=x(dir, irect(3,ne))
389 xx4=x(dir, irect(4,ne))
390 xmin=min(xx1,xx2,xx3,xx4)
391 - -min(max(gapsmx+gap_m(ne),gapmin),gapmax)-marge
392 IF(xmin<seuil) THEN
393C store at the bottom of the bp stack
394 addne = addne + 1
395 pe(addne) = ne
396 ENDIF
397 ENDDO
398 ELSE
399 DO i=1,nb_ec
400 ne = bpe(i)
401 xx1=x(dir, irect(1,ne))
402 xx2=x(dir, irect(2,ne))
403 xx3=x(dir, irect(3,ne))
404 xx4=x(dir, irect(4,ne))
405 xmin=min(xx1,xx2,xx3,xx4)
406 - -min(max(gapsmx+gap_m(ne),gapmin),gapmax)-marge
407 IF(xmin<seuil) THEN
408C store at the bottom of the bp stack
409 addne = addne + 1
410 pe(addne) = ne
411 ENDIF
412 ENDDO
413 DO i=1,nb_ec
414 ne = bpe(i)
415 xx1=x(dir, irect(1,ne))
416 xx2=x(dir, irect(2,ne))
417 xx3=x(dir, irect(3,ne))
418 xx4=x(dir, irect(4,ne))
419 xmax=max(xx1,xx2,xx3,xx4)
420 + +min(max(bgapsmx+gap_m(ne),gapmin),gapmax)+marge
421 IF(xmax>=seuil) THEN
422C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
423 nb_ecn = nb_ecn + 1
424 bpe(nb_ecn) = ne
425 ENDIF
426 ENDDO
427 ENDIF
428 ENDIF
429C
430C 4- REMPLIR LES TABLEAUX D'ADRESSES
431C
432 add(1,i_add+1) = addnn
433 add(2,i_add+1) = addne
434C-----fill the min of the next box and the max of the current one
435C (i.e. threshold is a max for the current one)
436C We're going to go down and so we define a new box
437C fill the max of the new box
438C initialises in i7buc1 a 1.E30 comme ca on recupere
439c either xmax or the max of the box
440 xyzm(1,i_add+1) = xyzm(1,i_add)
441 xyzm(2,i_add+1) = xyzm(2,i_add)
442 xyzm(3,i_add+1) = xyzm(3,i_add)
443 xyzm(4,i_add+1) = xyzm(4,i_add)
444 xyzm(5,i_add+1) = xyzm(5,i_add)
445 xyzm(6,i_add+1) = xyzm(6,i_add)
446 xyzm(dir,i_add+1) = seuil
447 xyzm(dir+3,i_add) = seuil
448C
449 nb_nc = nb_ncn
450 nb_ec = nb_ecn
451C increment the descent level before exiting
452 i_add = i_add + 1
453 IF(i_add+1>=i_add_max) THEN
454 i_mem = 3
455 RETURN
456 ENDIF
457C=======================================================================
458 200 CONTINUE
459C=======================================================================
460C
461C=======================================================================
462C
463C
464C 2- TEST ARRET = BOITE VIDE
465C BOITE TROP PETITE
466C BOITE NE CONTENANT QU'ONE NODE C No More Memory Available
467C
468C-----------------------------------------------------------
469C
470C-------------------test for exceeded memory------------
471C
472 IF(add(2,i_add)+nb_ec>maxsiz) THEN
473C no more space in the stack of elements boxes too small
474 i_mem = 1
475 RETURN
476 ENDIF
477C
478C--------------------test for empty boxes--------------
479C
480 IF(nb_ec/=0.AND.nb_nc/=0) THEN
481C
482 dx = xyzm(4,i_add) - xyzm(1,i_add)
483 dy = xyzm(5,i_add) - xyzm(2,i_add)
484 dz = xyzm(6,i_add) - xyzm(3,i_add)
485 dsup= max(dx,dy,dz)
486C
487C-------------------test for end of branch ------------
488C 1- storage of candidate node(s) and corresponding elements
489C remove the useless ones
490C
491 IF(nb_ec+nb_nc<=128) THEN
492 ncand_prov = nb_ec*nb_nc
493 ELSE
494 ncand_prov = 129
495 ENDIF
496 IF(dsup<minbox.OR.nb_nc<=nb_n_b.OR.ncand_prov<=128) THEN
497 ncand_prov = nb_ec*nb_nc
498 DO k=1,ncand_prov,nvsiz
499 IF(igap==0) THEN
500 DO l=k,min(k-1+nvsiz,ncand_prov)
501 i = 1+(l-1)/nb_nc
502 j = l-(i-1)*nb_nc
503C
504 ne = bpe(i)
505 n1=irect(1,ne)
506 n2=irect(2,ne)
507 n3=irect(3,ne)
508 n4=irect(4,ne)
509C
510 xx1=x(1, n1)
511 xx2=x(1, n2)
512 xx3=x(1, n3)
513 xx4=x(1, n4)
514 xmax=max(xx1,xx2,xx3,xx4)+tzinf
515 xmin=min(xx1,xx2,xx3,xx4)-tzinf
516 xx1=x(2, n1)
517 xx2=x(2, n2)
518 xx3=x(2, n3)
519 xx4=x(2, n4)
520 ymax=max(xx1,xx2,xx3,xx4)+tzinf
521 ymin=min(xx1,xx2,xx3,xx4)-tzinf
522 xx1=x(3, n1)
523 xx2=x(3, n2)
524 xx3=x(3, n3)
525 xx4=x(3, n4)
526 zmax=max(xx1,xx2,xx3,xx4)+tzinf
527 zmin=min(xx1,xx2,xx3,xx4)-tzinf
528C
529 jj = bpn(j)
530 IF(jj<=nsn) THEN
531 nn=nsv(jj)
532 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4.AND.
533 & x(1,nn)>xmin.AND.x(1,nn)<xmax.AND.
534 & x(2,nn)>ymin.AND.x(2,nn)<ymax.AND.
535 & x(3,nn)>zmin.AND.x(3,nn)<zmax ) THEN
536 j_stok = j_stok + 1
537 prov_n(j_stok) = jj
538 prov_e(j_stok) = ne
539 ENDIF
540 ELSE
541 ii = jj-nsn
542 IF(xrem(1,ii)>xmin.AND.
543 & xrem(1,ii)<xmax.AND.
544 & xrem(2,ii)>ymin.AND.
545 & xrem(2,ii)<ymax.AND.
546 & xrem(3,ii)>zmin.AND.
547 & xrem(3,ii)<zmax ) THEN
548 j_stok = j_stok + 1
549 prov_n(j_stok) = jj
550 prov_e(j_stok) = ne
551 ENDIF
552 ENDIF
553 ENDDO
554 ELSE
555 DO l=k,min(k-1+nvsiz,ncand_prov)
556 i = 1+(l-1)/nb_nc
557 j = l-(i-1)*nb_nc
558C
559 ne = bpe(i)
560 n1=irect(1,ne)
561 n2=irect(2,ne)
562 n3=irect(3,ne)
563 n4=irect(4,ne)
564C
565 jj = bpn(j)
566 IF(jj<=nsn) THEN
567 tz=max(min(gap_s(jj)+gap_m(ne),gapmax),gapmin)+marge
568 xx1=x(1, n1)
569 xx2=x(1, n2)
570 xx3=x(1, n3)
571 xx4=x(1, n4)
572 xmax=max(xx1,xx2,xx3,xx4)+tz
573 xmin=min(xx1,xx2,xx3,xx4)-tz
574 xx1=x(2, n1)
575 xx2=x(2, n2)
576 xx3=x(2, n3)
577 xx4=x(2, n4)
578 ymax=max(xx1,xx2,xx3,xx4)+tz
579 ymin=min(xx1,xx2,xx3,xx4)-tz
580 xx1=x(3, n1)
581 xx2=x(3, n2)
582 xx3=x(3, n3)
583 xx4=x(3, n4)
584 zmax=max(xx1,xx2,xx3,xx4)+tz
585 zmin=min(xx1,xx2,xx3,xx4)-tz
586 nn=nsv(jj)
587 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4.AND.
588 & x(1,nn)>xmin.AND.x(1,nn)<xmax.AND.
589 & x(2,nn)>ymin.AND.x(2,nn)<ymax.AND.
590 & x(3,nn)>zmin.AND.x(3,nn)<zmax ) THEN
591 j_stok = j_stok + 1
592 prov_n(j_stok) = jj
593 prov_e(j_stok) = ne
594 ENDIF
595 ELSE
596 ii = jj-nsn
597 tz=max(min(xrem(9,ii)+gap_m(ne),gapmax),gapmin)
598 + +marge
599 xx1=x(1, n1)
600 xx2=x(1, n2)
601 xx3=x(1, n3)
602 xx4=x(1, n4)
603 xmax=max(xx1,xx2,xx3,xx4)+tz
604 xmin=min(xx1,xx2,xx3,xx4)-tz
605 xx1=x(2, n1)
606 xx2=x(2, n2)
607 xx3=x(2, n3)
608 xx4=x(2, n4)
609 ymax=max(xx1,xx2,xx3,xx4)+tz
610 ymin=min(xx1,xx2,xx3,xx4)-tz
611 xx1=x(3, n1)
612 xx2=x(3, n2)
613 xx3=x(3, n3)
614 xx4=x(3, n4)
615 zmax=max(xx1,xx2,xx3,xx4)+tz
616 zmin=min(xx1,xx2,xx3,xx4)-tz
617 IF(xrem(1,ii)>xmin.AND.
618 & xrem(1,ii)<xmax.AND.
619 & xrem(2,ii)>ymin.AND.
620 & xrem(2,ii)<ymax.AND.
621 & xrem(3,ii)>zmin.AND.
622 & xrem(3,ii)<zmax ) THEN
623 j_stok = j_stok + 1
624 prov_n(j_stok) = jj
625 prov_e(j_stok) = ne
626 ENDIF
627 ENDIF
628 ENDDO
629 END IF
630 IF(j_stok>=nvsiz) THEN
631 CALL i10sto(
632 1 nvsiz ,irect ,x ,nsv ,ii_stok,
633 2 cand_n,cand_e,nsn4 ,noint ,marge ,
634 3 i_mem ,prov_n,prov_e ,cand_a,eshift ,
635 4 nsn ,oldnum,nsnrold,igap ,gap ,
636 6 gap_s ,gap_m ,gapmin ,gapmax,nin )
637 IF(i_mem==2)RETURN
638 j_stok = j_stok-nvsiz
639#include "vectorize.inc"
640 DO j=1,j_stok
641 prov_n(j) = prov_n(j+nvsiz)
642 prov_e(j) = prov_e(j+nvsiz)
643 ENDDO
644 ENDIF
645 ENDDO
646 ELSE
647C=======================================================================
648 GOTO 100
649C=======================================================================
650 ENDIF
651 ENDIF
652C-------------------------------------------------------------------------
653C empty box or
654C end of branch
655C decrement the descent level before restarting
656C-------------------------------------------------------------------------
657 i_add = i_add - 1
658 IF (i_add/=0) THEN
659C=======================================================================
660C need to copy the stack bottoms into corresponding stack_bottom
661C before going back down into the adjacent branch
662C=======================================================================
663 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
664C=======================================================================
665 GOTO 200
666C=======================================================================
667 ENDIF
668C=======================================================================
669C end of sorting
670C=============================================
671 IF(j_stok/=0)CALL i10sto(
672 1 j_stok,irect ,x ,nsv ,ii_stok,
673 2 cand_n,cand_e,nsn4 ,noint ,marge ,
674 3 i_mem ,prov_n,prov_e ,cand_a,eshift ,
675 4 nsn ,oldnum,nsnrold,igap ,gap ,
676 6 gap_s ,gap_m ,gapmin ,gapmax,nin )
677C-------------------------------------------------------------------------
678 RETURN
679 END
my_real
#define my_real
Definition cppsort.cpp:32
i10sto
subroutine i10sto(j_stok, irect, x, nsv, ii_stok, cand_n, cand_e, nsn4, noint, marge, i_mem, prov_n, prov_e, cand_a, eshift, nsn, oldnum, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, nin)
Definition i10sto.F:37
i10tri
subroutine i10tri(add, nsn, renum, nsnr, nrtm, irect, x, xyzm, igap, gap, i_add, nsv, maxsiz, ii_stok, cand_n, cand_e, nsn4, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, cand_a, eshift, nsnrold, stf, stfn, gap_s, gap_m, gapmin, gapmax, marge, nin, intheat, idt_therm, nodadt_therm)
Definition i10tri.F:43
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
spmd_oldnumcd
subroutine spmd_oldnumcd(renum, oldnum, nsnr, nsnrold, intheat, idt_therm, nodadt_therm)
Definition spmd_i7tool.F:38
i7dstk
subroutine i7dstk(i_add, nb_nc, nb_ec, add, bpn, pn, bpe, pe)
Definition i7dstk.F:33