OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7tri.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "ige3d_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i7tri (add, nsn, renum, nsnr, isznsnr, irect, x, stf, stfn, 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_s_l, gap_m_l, intth, drad, itied, cand_f, kremnod, remnod, flagremnode, dgapload, intheat, idt_therm, nodadt_therm)

Function/Subroutine Documentation

◆ i7tri()

subroutine i7tri ( integer, dimension(2,*) add,
integer nsn,
integer, dimension(*) renum,
integer nsnr,
integer isznsnr,
integer, dimension(4,*) irect,
x,
stf,
stfn,
xyzm,
integer i_add,
integer, dimension(*) nsv,
integer maxsiz,
integer ii_stok,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
integer mulnsn,
integer noint,
tzinf,
maxbox,
minbox,
integer i_mem,
integer nb_n_b,
integer i_add_max,
integer eshift,
integer inacti,
integer ifq,
integer, dimension(*) cand_a,
cand_p,
integer, dimension(*) ifpen,
integer nrtm,
integer nsnrold,
integer igap,
gap,
gap_s,
gap_m,
gapmin,
gapmax,
marge,
curv_max,
integer nin,
gap_s_l,
gap_m_l,
integer intth,
intent(in) drad,
integer itied,
cand_f,
integer, dimension(*) kremnod,
integer, dimension(*) remnod,
integer flagremnode,
intent(in) dgapload,
integer, intent(in) intheat,
integer, intent(in) idt_therm,
integer, intent(in) nodadt_therm )

Definition at line 34 of file i7tri.F.

46C=======================================================================
47C M o d u l e s
48C-----------------------------------------------
49 USE tri7box
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C G l o b a l P a r a m e t e r s
56C-----------------------------------------------
57#include "mvsiz_p.inc"
58c parameter setting the size for the vector (orig version is 128)
59 INTEGER NVECSZ
60 parameter(nvecsz = mvsiz)
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com01_c.inc"
65#include "com04_c.inc"
66#include "param_c.inc"
67#include "ige3d_c.inc"
68C-----------------------------------------------
69C ROLE DE LA ROUTINE:
70C ===================
71C CLASSE LES ELETS DE BPE ET LES NOEUDS DE BPN EN TWO ZONES
72C > OU < A UNE FRONTIERE ICI DETERMINEE ET SORT LE TOUT
73C DANS bpe,hpe, et bpn,hpn
74C-----------------------------------------------
75C D u m m y A r g u m e n t s
76C
77C NOM DESCRIPTION E/S
78C
79C BPE TABLEAU DES FACETTES A TRIER => Local
80C ET DU RESULTAT COTE MAX
81C PE TABLEAU DES FACETTES => Local
82C RESULTAT COTE MIN
83C BPN TABLEAU DES NOEUDS A TRIER => Local
84C ET DU RESULTAT COTE MAX
85C PN TABLEAU DES NOEUDS => Local
86C RESULTAT COTE MIN
87C ADD(2,*) TABLEAU DES ADRESSES E/S
88C 1.......ADRESSES NOEUDS
89C 2.......ADRESSES ELEMENTS
90C ZYZM(6,*) TABLEAU DES XYZMIN E/S
91C 1.......XMIN BOITE
92C 2.......YMIN BOITE
93C 3.......ZMIN BOITE
94C 4.......XMAX BOITE
95C 5.......YMAX BOITE
96C 6.......ZMAX BOITE
97C IRECT(4,*) TABLEAU DES CONEC FACETTES E
98C X(3,*) COORDONNEES NODALES E
99C NB_NC NOMBRE DE NOEUDS CANDIDATS => Local
100C NB_EC NOMBRE D'ELTS CANDIDATS => Local
101C I_ADD POSITION DANS LE TAB DES ADRESSES E/S
102C NSV NOS SYSTEMES DES NOEUDS E
103C XMAX plus grande abcisse existante E
104C XMAX plus grande ordonn. existante E
105C XMAX plus grande cote existante E
106C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
107C I_STOK niveau de stockage des couples
108C candidats impact E/S
109C ADNSTK adresse courante dans la boite des noeuds
110C CAND_N boites resultats noeuds
111C ADESTK adresse courante dans la boite des elements
112C CAND_E adresses des boites resultat elements
113C MULNSN = MULTIMP*NSN TAILLE MAX ADMISE MAINTENANT POUR LES
114C COUPLES NOEUDS,ELT CANDIDATS
115C NOINT NUMERO USER DE L'INTERFACE
116C TZINF TAILLE ZONE INFLUENCE
117C MAXBOX TAILLE MAX BUCKET
118C MINBOX TAILLE MIN BUCKET
119C
120C PROV_N CAND_N provisoire (variable static dans i7tri)
121C PROV_E CAND_E provisoire (variable static dans i7tri)
122C-----------------------------------------------
123C D u m m y A r g u m e n t s
124C-----------------------------------------------
125 INTEGER I_ADD,MAXSIZ,I_MEM,ESHIFT,NSN,ISZNSNR,NRTM,NSNROLD,
126 . MULNSN,NB_N_B,NOINT,I_ADD_MAX,INACTI,IFQ,NSNR,IGAP,NIN,
127 . ADD(2,*),IRECT(4,*),
128 . NSV(*),CAND_N(*),CAND_E(*),CAND_A(*),IFPEN(*),RENUM(*),
129 . INTTH,II_STOK,ITIED
130 INTEGER KREMNOD(*),REMNOD(*),FLAGREMNODE
131 INTEGER, INTENT(IN) :: INTHEAT
132 INTEGER, INTENT(IN) :: IDT_THERM
133 INTEGER, INTENT(IN) :: NODADT_THERM
134C REAL
135 my_real
136 . x(3,*),xyzm(6,*),cand_p(*),stf(*),stfn(*),gap_s(*),gap_m(*),
137 . tzinf,maxbox,minbox,marge,gap,gapmin,gapmax,
138 . curv_max(*),gap_s_l(*),gap_m_l(*),cand_f(*)
139 my_real , INTENT(IN) :: drad,dgapload
140C-----------------------------------------------
141C L o c a l V a r i a b l e s
142C-----------------------------------------------
143 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,NB_NC,NB_EC,
144 . N1,N2,N3,N4,NN,NE,K,L,NCAND_PROV,J_STOK,II,JJ,
145 . PROV_N(2*MVSIZ),PROV_E(2*MVSIZ),
146 . TN1(NVECSZ),TN2(NVECSZ),TN3(NVECSZ),TN4(NVECSZ),
147C BPE : utilise sur NRTM et non NRTM + 100 en toute rigueur (ici MAXSIZ = NRTM + 100)
148 . BPE(MAXSIZ/3),PE(MAXSIZ),BPN(NSN+NSNR),PN(NSN+NSNR),
149 . OLDNUM(ISZNSNR),IADD
150C REAL
151 my_real
152 . aaa,
153 . dx,dy,dz,dsup,trhreshold, xx1, xx2, xx3, xx4,
154 . xmin, xmax,ymin, ymax,zmin, zmax, tz, gapsmx, bgapsmx, gapl,
155 . txx1(3,nvecsz), txx2(3,nvecsz), txx3(3,nvecsz), txx4(3,nvecsz),
156 . txmax(nvecsz),txmin(nvecsz),tymax(nvecsz),
157 . tymin(nvecsz),tzmax(nvecsz),tzmin(nvecsz),smoins,splus,xx
158C REMNODE
159 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGREMNODE
160 INTEGER DELNOD,M
161
162C-----------------------------------------------
163C Phase initiale de construction de BPE et BPN deplacee de I7BUCE => I7TRI
164C
165
166 IF(flagremnode == 2) ALLOCATE(tagremnode(numnod+numfakenodigeo))
167
168 xmin = xyzm(1,i_add)
169 ymin = xyzm(2,i_add)
170 zmin = xyzm(3,i_add)
171 xmax = xyzm(4,i_add)
172 ymax = xyzm(5,i_add)
173 zmax = xyzm(6,i_add)
174C
175C DRAD = ZERO
176C
177C Copie des nos de segments et de noeuds dans BPE ET BPN
178C
179 nb_ec = 0
180 DO i=1,nrtm
181C on ne retient pas les facettes detruites
182 IF(stf(i)/=zero)THEN
183 nb_ec = nb_ec + 1
184 bpe(nb_ec) = i
185 ENDIF
186 ENDDO
187
188 IF(igap==3) THEN
189 iadd = 10
190 ENDIF
191C
192C Optimisation // recherche les noeuds compris dans xmin xmax des
193C elements du processeur
194C
195 nb_nc = 0
196 DO i=1,nsn
197 j=nsv(i)
198 IF(stfn(i)/=zero) THEN
199
200 IF(x(1,j)>=xmin.AND.x(1,j)<=xmax.AND.
201 . x(2,j)>=ymin.AND.x(2,j)<=ymax.AND.
202 . x(3,j)>=zmin.AND.x(3,j)<=zmax)THEN
203
204 nb_nc=nb_nc+1
205 bpn(nb_nc) = i
206 ENDIF
207 ENDIF
208 ENDDO
209C
210C Prise en compte candidats non locaux en SPMD
211C
212 DO i = nsn+1, nsn+nsnr
213 IF( xrem(1,i-nsn)<xmin) cycle
214 IF( xrem(1,i-nsn)>xmax) cycle
215 IF( xrem(2,i-nsn)<ymin) cycle
216 IF( xrem(2,i-nsn)>ymax) cycle
217 IF( xrem(3,i-nsn)<zmin) cycle
218 IF( xrem(3,i-nsn)>zmax) cycle
219 nb_nc = nb_nc + 1
220 bpn(nb_nc) = i
221 ENDDO
222C
223C En SPMD, pour inacti ou IFQ, retrouve ancienne numerotation des candidats non locaux
224C
225 IF(nspmd>1.AND.
226 + (inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
227 + itied/=0)) THEN
228 CALL spmd_oldnumcd(renum,oldnum,isznsnr,nsnrold,intheat,idt_therm,nodadt_therm)
229 END IF
230C
231 j_stok = 0
232 GOTO 200
233C=======================================================================
234 100 CONTINUE
235C=======================================================================
236C-----------------------------------------------------------
237C
238C
239C 1- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
240C
241C
242C-----------------------------------------------------------
243C
244C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
245C
246 dir = 1
247 IF(dy==dsup) THEN
248 dir = 2
249 ELSE IF(dz==dsup) THEN
250 dir = 3
251 ENDIF
252 smoins = xyzm(dir,i_add)
253 splus = xyzm(dir+3,i_add)
254 trhreshold =(smoins+splus)*half
255C
256C 2- DIVISER LES NOEUDS EN TWO ZONES
257C
258 nb_ncn= 0
259 nb_ncn1= 0
260 addnn= add(1,i_add)
261C
262 gapsmx = zero
263 DO i=1,nb_nc
264 j = bpn(i)
265 IF(j <= nsn) THEN
266 xx = x(dir,nsv(j))
267 IF(xx < trhreshold) THEN
268C ON STOCKE DANS LE BAS DE LA PILE BP
269 nb_ncn1 = nb_ncn1 + 1
270 addnn = addnn + 1
271 pn(addnn) = j
272 IF(igap /=0) gapsmx = max(gapsmx,gap_s(j))
273 smoins = max(smoins,xx)
274 ENDIF
275 ENDIF
276 ENDDO
277 DO i=1,nb_nc
278 j = bpn(i)
279 IF(j > nsn) THEN
280 xx = xrem(dir,j-nsn)
281 IF(xx < trhreshold) THEN
282C ON STOCKE DANS LE BAS DE LA PILE BP
283 nb_ncn1 = nb_ncn1 + 1
284 addnn = addnn + 1
285 pn(addnn) = j
286 IF(igap/=0) gapsmx = max(gapsmx,xrem(9,j-nsn))
287 smoins = max(smoins,xx)
288 ENDIF
289 ENDIF
290 ENDDO
291 bgapsmx = zero
292 DO i=1,nb_nc
293 j = bpn(i)
294 IF(j <= nsn) THEN
295 xx = x(dir,nsv(j))
296 IF(xx >= trhreshold) THEN
297C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
298 nb_ncn = nb_ncn + 1
299 bpn(nb_ncn) = j
300 IF(igap/=0) bgapsmx = max(bgapsmx,gap_s(j))
301 splus = min(splus,xx)
302 ENDIF
303 ENDIF
304 ENDDO
305 DO i=1,nb_nc
306 j = bpn(i)
307 IF(j > nsn) THEN
308 xx = xrem(dir,j-nsn)
309 IF(xx >= trhreshold) THEN
310C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
311 nb_ncn = nb_ncn + 1
312 bpn(nb_ncn) = j
313 IF(igap /= 0) bgapsmx = max(bgapsmx,xrem(9,j-nsn))
314 splus = min(splus,xx)
315 ENDIF
316 ENDIF
317 ENDDO
318C
319C 3- DIVISER LES ELEMENTS
320C
321 nb_ecn= 0
322 addne= add(2,i_add)
323 IF(nb_ncn1==0) THEN
324 DO i=1,nb_ec
325 ne = bpe(i)
326 xx1=x(dir, irect(1,ne))
327 xx2=x(dir, irect(2,ne))
328 xx3=x(dir, irect(3,ne))
329 xx4=x(dir, irect(4,ne))
330 IF(igap == 0) THEN
331 aaa = tzinf+curv_max(ne)
332 ELSEIF(igap == 3) THEN
333 aaa = max(drad,dgapload+min(max(bgapsmx+max(gap_m(ne),gap_m_l(ne)),gapmin),gapmax))
334 + +marge+curv_max(ne)
335 ELSE
336 aaa = max(drad,dgapload+min(max(bgapsmx+gap_m(ne),gapmin),gapmax))
337 + +marge+curv_max(ne)
338 ENDIF
339 xmax = max(xx1,xx2,xx3,xx4) + aaa
340 IF(xmax >= splus) THEN
341C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
342 nb_ecn = nb_ecn + 1
343 bpe(nb_ecn) = ne
344 ENDIF
345 ENDDO
346 ELSEIF(nb_ncn == 0) THEN
347#include "vectorize.inc"
348 DO i=1,nb_ec
349 ne = bpe(i)
350 xx1=x(dir, irect(1,ne))
351 xx2=x(dir, irect(2,ne))
352 xx3=x(dir, irect(3,ne))
353 xx4=x(dir, irect(4,ne))
354 IF( igap == 0 ) THEN
355 aaa = -tzinf-curv_max(ne)
356 ELSEIF(igap == 3) THEN
357 aaa = -max(drad,dgapload+min(max(gapsmx+max(gap_m(ne),gap_m_l(ne)),gapmin),gapmax))
358 + -marge-curv_max(ne)
359 ELSE
360 aaa = -max(drad,dgapload+min(max(gapsmx+gap_m(ne),gapmin),gapmax))
361 - -marge-curv_max(ne)
362 ENDIF
363 xmin = min(xx1,xx2,xx3,xx4) + aaa
364
365 IF(xmin < smoins) THEN
366C ON STOCKE DANS LE BAS DE LA PILE BP
367 addne = addne + 1
368 pe(addne) = ne
369 ENDIF
370 ENDDO
371 ELSE
372 DO i=1,nb_ec
373 ne = bpe(i)
374 xx1=x(dir, irect(1,ne))
375 xx2=x(dir, irect(2,ne))
376 xx3=x(dir, irect(3,ne))
377 xx4=x(dir, irect(4,ne))
378 IF( igap == 0 ) THEN
379 aaa=-tzinf-curv_max(ne)
380 ELSEIF(igap == 3) THEN
381 aaa= - max(drad,dgapload+min(max(gapsmx+max(gap_m(ne),gap_m_l(ne)),gapmin),gapmax))
382 + -marge-curv_max(ne)
383 ELSE
384 aaa= -max(drad,dgapload+min(max(gapsmx+gap_m(ne),gapmin),gapmax))
385 - -marge-curv_max(ne)
386 ENDIF
387 xmin = min(xx1,xx2,xx3,xx4) + aaa
388 IF(xmin < smoins) THEN
389C ON STOCKE DANS LE BAS DE LA PILE BP
390 addne = addne + 1
391 pe(addne) = ne
392 ENDIF
393 ENDDO
394C
395 DO i=1,nb_ec
396 ne = bpe(i)
397 xx1=x(dir, irect(1,ne))
398 xx2=x(dir, irect(2,ne))
399 xx3=x(dir, irect(3,ne))
400 xx4=x(dir, irect(4,ne))
401 IF( igap == 0) THEN
402 aaa =tzinf+curv_max(ne)
403 ELSEIF( igap==3 ) THEN
404 aaa= max(drad,dgapload+min(max(bgapsmx+max(gap_m(ne),gap_m_l(ne)),gapmin),gapmax))
405 + +marge+curv_max(ne)
406 ELSE
407 aaa = max(drad,dgapload+min(max(bgapsmx+gap_m(ne),gapmin),gapmax))
408 + +marge+curv_max(ne)
409 ENDIF
410 xmax = max(xx1,xx2,xx3,xx4) + aaa
411
412 IF(xmax >= splus) THEN
413C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
414 nb_ecn = nb_ecn + 1
415 bpe(nb_ecn) = ne
416 ENDIF
417 ENDDO
418 ENDIF !NBNC1
419C
420C 4- REMPLIR LES TABLEAUX D'ADRESSES
421C
422 add(1,i_add+1) = addnn
423 add(2,i_add+1) = addne
424C-----on remplit les min de la boite suivante et les max de la courante
425C (i.e. TRHRESHOLD est un max pour la courante)
426C on va redescendre et donc on definit une nouvelle boite
427C on remplit les max de la nouvelle boite
428C initialises dans i7buc1 a 1.E30 comme ca on recupere
429C soit XMAX soit le max de la boite
430 xyzm(1,i_add+1) = xyzm(1,i_add)
431 xyzm(2,i_add+1) = xyzm(2,i_add)
432 xyzm(3,i_add+1) = xyzm(3,i_add)
433 xyzm(4,i_add+1) = xyzm(4,i_add)
434 xyzm(5,i_add+1) = xyzm(5,i_add)
435 xyzm(6,i_add+1) = xyzm(6,i_add)
436 xyzm(dir,i_add+1) = splus
437 xyzm(dir+3,i_add) = smoins
438C
439 nb_nc = nb_ncn
440 nb_ec = nb_ecn
441C on incremente le niveau de descente avant de sortir
442 i_add = i_add + 1
443 IF(i_add+1>=i_add_max) THEN
444c WRITE(6,*) __LINE__,__LINE__
445 i_mem = 3
446 RETURN
447 ENDIF
448C=======================================================================
449 200 CONTINUE
450C=======================================================================
451C-----------------------------------------------------------
452C
453C
454C 2- TEST ARRET = BOITE VIDE
455C BOITE TROP PETITE
456C BOITE NE CONTENANT QU'ONE NOEUD
457C PLUS DE MEMOIRE DISPONIBLE
458C
459C-------------------TEST SUR MEMOIRE DEPASSEE------------
460C
461 IF(add(2,i_add)+nb_ec>maxsiz) THEN
462C PLUS DE PLACE DANS LA PILE DES ELEMENTS BOITES TROP PETITES
463 WRITE(6,*) __line__,__line__
464
465 i_mem = 1
466 RETURN
467 ENDIF
468C
469C--------------------TEST SUR BOITE VIDES--------------
470C
471 IF(nb_ec/=0.AND.nb_nc/=0) THEN
472C
473 dx = xyzm(4,i_add) - xyzm(1,i_add)
474 dy = xyzm(5,i_add) - xyzm(2,i_add)
475 dz = xyzm(6,i_add) - xyzm(3,i_add)
476 dsup= max(dx,dy,dz)
477C
478C-------------------TEST SUR FIN DE BRANCHE ------------
479C 1- STOCKAGE DU OU DES NOEUD CANDIDAT ET DES ELTS CORRESP.
480C VIRER LES INUTILES
481C
482C NCAND_PROV=NB_EC*NB_NC
483C NCAND_PROV negatif qd NB_EC*NB_NC > 2e31
484C
485 IF(nb_ec+nb_nc<=nvecsz) THEN
486 ncand_prov = nb_ec*nb_nc
487 ELSE
488 ncand_prov = nvecsz+1
489 ENDIF
490 IF(dsup<minbox.OR.(nb_nc<=nb_n_b)
491 & .OR.(ncand_prov<=nvecsz)) THEN
492 ncand_prov = nb_ec*nb_nc
493
494 IF(flagremnode==2) THEN
495 DO i=1,numnod+numfakenodigeo
496 tagremnode(i) = 0
497 ENDDO
498 ENDIF
499
500 DO k=1,ncand_prov,nvsiz
501 DO l=k,min(k-1+nvsiz,ncand_prov)
502 i = 1+(l-1)/nb_nc
503 j = l-(i-1)*nb_nc
504 ne = bpe(i)
505 n1=irect(1,ne)
506 n2=irect(2,ne)
507 n3=irect(3,ne)
508 n4=irect(4,ne)
509
510 IF(flagremnode==2) THEN
511 DO m= kremnod(2*(ne-1)+1)+1, kremnod(2*(ne-1)+2)
512 tagremnode(remnod(m)) = 1
513 ENDDO
514 ENDIF
515 jj = bpn(j)
516 IF( jj<=nsn ) THEN
517 IF( igap == 0 ) THEN
518 tz = tzinf+curv_max(ne)
519 ELSEIF( igap == 3 ) THEN
520 tz = max(drad,dgapload+max(min(gap_s_l(jj)+gap_m_l(ne),gapmax),gapmin)
521 . +marge+curv_max(ne))
522 ELSE
523 tz=max(drad,dgapload+max(min(gap_s(jj)+gap_m(ne),gapmax),gapmin)
524 + +marge+curv_max(ne))
525 ENDIF
526 ELSE
527 ii = jj-nsn
528 IF( igap == 0 ) THEN
529 tz = tzinf+curv_max(ne)
530 ELSEIF( igap == 3 ) THEN
531 tz = max(drad,dgapload+max(min(xrem(iadd,ii)+gap_m_l(ne)
532 . ,gapmax),gapmin))+marge+curv_max(ne)
533 ELSE
534 tz = max(drad,dgapload+max(min(xrem(9,ii)+gap_m(ne),gapmax),gapmin))
535 + +marge+curv_max(ne)
536 ENDIF
537 ENDIF
538 xx1=x(1, n1)
539 xx2=x(1, n2)
540 xx3=x(1, n3)
541 xx4=x(1, n4)
542 xmax=max(xx1,xx2,xx3,xx4)+tz
543 xmin=min(xx1,xx2,xx3,xx4)-tz
544 xx1=x(2, n1)
545 xx2=x(2, n2)
546 xx3=x(2, n3)
547 xx4=x(2, n4)
548 ymax=max(xx1,xx2,xx3,xx4)+tz
549 ymin=min(xx1,xx2,xx3,xx4)-tz
550 xx1=x(3, n1)
551 xx2=x(3, n2)
552 xx3=x(3, n3)
553 xx4=x(3, n4)
554 zmax=max(xx1,xx2,xx3,xx4)+tz
555 zmin=min(xx1,xx2,xx3,xx4)-tz
556 IF(jj<=nsn) THEN
557
558 IF(flagremnode==2) THEN
559 IF(tagremnode(nsv(jj)) == 1) cycle
560 ENDIF
561 nn=nsv(jj)
562 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4.AND.
563 & x(1,nn)>xmin.AND.x(1,nn)<xmax.AND.
564 & x(2,nn)>ymin.AND.x(2,nn)<ymax.AND.
565 & x(3,nn)>zmin.AND.x(3,nn)<zmax ) THEN
566 j_stok = j_stok + 1
567 prov_n(j_stok) = jj
568 prov_e(j_stok) = ne
569 ENDIF
570 ELSE
571 ii = jj-nsn
572 IF(flagremnode==2) THEN
573 DO m= kremnod(2*(ne-1)+2) + 1, kremnod(2*(ne-1)+3)
574 IF(remnod(m) == -irem(2,ii) ) THEN
575 delnod = delnod + 1
576 EXIT
577 ENDIF
578 ENDDO
579 IF(delnod /= 0) cycle
580 ENDIF
581 IF(xrem(1,ii)>xmin.AND.
582 & xrem(1,ii)<xmax.AND.
583 & xrem(2,ii)>ymin.AND.
584 & xrem(2,ii)<ymax.AND.
585 & xrem(3,ii)>zmin.AND.
586 & xrem(3,ii)<zmax ) THEN
587 j_stok = j_stok + 1
588 prov_n(j_stok) = jj
589 prov_e(j_stok) = ne
590 ENDIF
591 ENDIF
592 ENDDO ! L=K,MIN(K-1+NVSIZ,NCAND_PROV)
593
594 IF(j_stok>=nvsiz)THEN
595 CALL i7sto(
596 1 nvsiz,irect ,x ,nsv ,ii_stok,
597 2 cand_n,cand_e ,mulnsn,noint ,marge ,
598 3 i_mem ,prov_n ,prov_e,eshift,inacti ,
599 4 ifq ,cand_a ,cand_p,ifpen ,nsn ,
600 5 oldnum,nsnrold,igap ,gap ,gap_s ,
601 6 gap_m ,gapmin ,gapmax,curv_max,nin ,
602 7 gap_s_l,gap_m_l,intth,drad,itied ,
603 8 cand_f,dgapload)
604 IF(i_mem==2) THEN
605 RETURN
606 ENDIF
607 j_stok = j_stok-nvsiz
608#include "vectorize.inc"
609 DO j=1,j_stok
610 prov_n(j) = prov_n(j+nvsiz)
611 prov_e(j) = prov_e(j+nvsiz)
612 ENDDO
613 ENDIF ! J_STOK >= NVSIZ
614
615 ENDDO ! LOOP OVER POSSIBLE CANDIDATES
616 ELSE
617C=======================================================================
618 GOTO 100
619C=======================================================================
620 ENDIF
621 ENDIF
622C-------------------------------------------------------------------------
623C BOITE VIDE OU
624C FIN DE BRANCHE
625C on decremente le niveau de descente avant de recommencer
626C-------------------------------------------------------------------------
627 i_add = i_add - 1
628 IF (i_add/=0) THEN
629C-------------------------------------------------------------------------
630C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
631C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
632C-------------------------------------------------------------------------
633 CALL i7dstk(nb_nc,nb_ec,add(1,i_add),bpn,pn,bpe,pe)
634C=======================================================================
635 GOTO 200
636C=======================================================================
637 ENDIF
638C-------------------------------------------------------------------------
639C FIN DU TRI
640C-------------------------------------------------------------------------
641 IF(j_stok/=0)CALL i7sto(
642 1 j_stok,irect ,x ,nsv ,ii_stok,
643 2 cand_n,cand_e ,mulnsn,noint ,marge ,
644 3 i_mem ,prov_n ,prov_e,eshift,inacti ,
645 4 ifq ,cand_a ,cand_p,ifpen ,nsn ,
646 5 oldnum,nsnrold,igap ,gap ,gap_s ,
647 6 gap_m ,gapmin ,gapmax,curv_max,nin ,
648 7 gap_s_l,gap_m_l,intth,drad,itied ,
649 8 cand_f ,dgapload)
650C-------------------------------------------------------------------------
651 IF(flagremnode==2) THEN
652 DEALLOCATE(tagremnode)
653 ENDIF
654 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i7sto
subroutine i7sto(j_stok, irect, x, 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_s_l, gap_m_l, intth, drad, itied, cand_f, dgapload)
Definition i7sto.F:41
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
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:34