OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i16tri.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com08_c.inc"
#include "com04_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i16tri (bpe, pe, bpn, pn, nsn, tzinf, ixs, ixs16, ixs20, nelem, nsv, maxsiz, cand_n, cand_e, minbox, cont, nb_n_b, eminx, i_stok_glob, nme, itask, noint, x, v, a, mx_cand, ixs10, esh_t)
subroutine i16cut (bpe, pe, bpn, pn, add, x, nb_nc, nb_ec, xyzm, i_add, nsv, maxsiz, cand_n, cand_e, minbox, cont, nb_n_b, i_add_max, eminx, nelem, i_stok, ixs, ixs16, ixs20, tzinf, i_stok_glob, prov_n, prov_e, v, a, mx_cand, ixs10)
subroutine i16sto (i_stok, i_stok_glob, prov_n, cand_n, prov_e, cand_e, cont, mx_cand)

Function/Subroutine Documentation

◆ i16cut()

subroutine i16cut ( integer, dimension(*) bpe,
integer, dimension(*) pe,
integer, dimension(*) bpn,
integer, dimension(*) pn,
integer, dimension(2,*) add,
x,
integer nb_nc,
integer nb_ec,
xyzm,
integer i_add,
integer, dimension(*) nsv,
integer maxsiz,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
minbox,
integer cont,
integer nb_n_b,
integer i_add_max,
eminx,
integer, dimension(*) nelem,
integer i_stok,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
tzinf,
integer i_stok_glob,
integer, dimension(*) prov_n,
integer, dimension(*) prov_e,
v,
a,
integer mx_cand,
integer, dimension(6,*) ixs10 )

Definition at line 207 of file i16tri.F.

215C-----------------------------------------------
216C I m p l i c i t T y p e s
217C-----------------------------------------------
218#include "implicit_f.inc"
219C-----------------------------------------------
220C G l o b a l P a r a m e t e r s
221C-----------------------------------------------
222#include "mvsiz_p.inc"
223C-----------------------------------------------
224C C o m m o n B l o c k s
225C-----------------------------------------------
226#include "com04_c.inc"
227#include "com08_c.inc"
228C-----------------------------------------------
229C ROLE DE LA ROUTINE:
230C ===================
231C CLASSE LES ELETS DE BPE ET LES NOEUDS DE BPN EN TWO ZONES
232C > OU < A UNE FRONTIERE ICI DETERMINEE ET SORT LE TOUT
233C DANS bpe,hpe, et bpn,hpn
234C-----------------------------------------------
235C D u m m y A r g u m e n t s
236C
237C NOM DESCRIPTION E/S
238C
239C BPE TABLEAU DES FACETTES A TRIER E/S
240C ET DU RESULTAT COTE MAX
241C PE TABLEAU DES FACETTES S
242C RESULTAT COTE MIN
243C BPN TABLEAU DES NOEUDS A TRIER E/S
244C ET DU RESULTAT COTE MAX
245C PN TABLEAU DES NOEUDS S
246C RESULTAT COTE MIN
247C ADD(2,*) TABLEAU DES ADRESSES E/S
248C 1.......ADRESSES NOEUDS
249C 2.......ADRESSES ELEMENTS
250C ZYZM(6,*) TABLEAU DES XYZMIN E/S
251C 1.......XMIN BOITE
252C 2.......YMIN BOITE
253C 3.......ZMIN BOITE
254C 4.......XMAX BOITE
255C 5.......YMAX BOITE
256C 6.......ZMAX BOITE
257C EMINX(6,*) TABLEAU DES COORD ELEM MIN/MAX E
258C X(3,*) COORDONNEES NODALES E
259C NB_NC NOMBRE DE NOEUDS CANDIDATS E/S
260C NB_EC NOMBRE D'ELTS CANDIDATS E/S
261C I_ADD POSITION DANS LE TAB DES ADRESSES E/S
262C NSV NOS SYSTEMES DES NOEUDS E
263C XMAX plus grande abcisse existante E
264C XMAX plus grande ordonn. existante E
265C XMAX plus grande cote existante E
266C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
267C I_STOK niveau de stockage des couples
268C candidats impact E/S
269C CAND_N boites resultats noeuds
270C CAND_E adresses des boites resultat elements
271C COUPLES NOEUDS,ELT CANDIDATS
272C MINBOX TAILLE MIN BUCKET
273C
274C-----------------------------------------------
275C D u m m y A r g u m e n t s
276C-----------------------------------------------
277 INTEGER NB_NC,NB_EC,I_ADD,MAXSIZ,I_STOK_GLOB,I_STOK,MX_CAND,
278 . NB_N_B,I_ADD_MAX,CONT ,IXS(NIXS,*),IXS16(8,*),
279 . ADD(2,*),BPE(*),PE(*),BPN(*),PN(*),
280 . NSV(*),CAND_N(*),CAND_E(*),NELEM(*),
281 . PROV_N(*) ,PROV_E(*) ,IXS20(12,*), IXS10(6,*)
282C REAL
283 my_real
284 . x(3,*),v(3,*),a(3,*),xyzm(6,*),eminx(6,*),
285 . minbox,tzinf,dist
286C-----------------------------------------------
287C L o c a l V a r i a b l e s
288C-----------------------------------------------
289 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,
290 . NN,NE,LE,K,L,NCAND_PROV,N16,N20,N8,N10
291C REAL
292 my_real
293 . dx,dy,dz,dsup,seuil,xx,yy,zz
294C
295C-----------------------------------------------------------
296C
297C
298C 1- TEST ARRET = BOITE VIDE
299C BOITE TROP PETITE
300C BOITE NE CONTENANT QU'ONE NOEUD
301C PLUS DE MEMOIRE DISPONIBLE
302C
303C-------------------TEST SUR MEMOIRE DEPASSEE------------
304C
305 IF(add(2,i_add)+nb_ec>maxsiz) THEN
306C PLUS DE PLACE DANS LA PILE DES ELEMENTS BOITES TROP PETITES
307 cont = -1
308ctmp+++
309c WRITE(istdo,*)'MAXSIZ = ',MAXSIZ
310c WRITE(istdo,*)'ADD(2,I_ADD) = ',ADD(2,I_ADD)
311c WRITE(istdo,*)'NB_EC = ',NB_EC
312ctmp---
313 RETURN
314 ENDIF
315C
316C--------------------TEST SUR BOITE VIDES--------------
317C
318 IF(nb_ec/=0.AND.nb_nc/=0) THEN
319C
320 dx = xyzm(4,i_add) - xyzm(1,i_add)
321 dy = xyzm(5,i_add) - xyzm(2,i_add)
322 dz = xyzm(6,i_add) - xyzm(3,i_add)
323 dsup= max(dx,dy,dz)
324C
325C-------------------TEST SUR FIN DE BRANCHE ------------
326C 1.1- STOCKAGE DU OU DES NOEUD CANDIDAT ET DES ELTS CORRESP.
327C VIRER LES INUTILES
328C
329C NCAND_PROV=NB_EC*NB_NC
330C NCAND_PROV negatif qd NB_EC*NB_NC > 2e31
331C
332 IF(nb_ec+nb_nc<=128) THEN
333 ncand_prov = nb_ec*nb_nc
334 ELSE
335 ncand_prov = 129
336 ENDIF
337C
338 IF(dsup<minbox.OR.nb_nc<=nb_n_b.OR.ncand_prov<=128)THEN
339C necessaire qd NB_NC<=NB_N_B ou DSUP<MINBOX et NB_EC+NB_NC>128
340 ncand_prov = nb_ec*nb_nc
341 DO l=1,ncand_prov
342 i = 1+(l-1)/nb_nc
343 j = l-(i-1)*nb_nc
344 le = bpe(i)
345 ne = nelem(le)
346 n8 = ne
347 n10 = n8-numels8
348 n20 = n10-numels10
349 n16 = n20-numels20
350 nn = nsv(bpn(j))
351 xx = x(1,nn)+dt2*(v(1,nn)+dt12*a(1,nn))
352 yy = x(2,nn)+dt2*(v(2,nn)+dt12*a(2,nn))
353 zz = x(3,nn)+dt2*(v(3,nn)+dt12*a(3,nn))
354 dist = 0.
355 dist = max(eminx(1,le)-xx,xx-eminx(4,le),dist)
356 dist = max(eminx(2,le)-yy,yy-eminx(5,le),dist)
357 dist = max(eminx(3,le)-zz,zz-eminx(6,le),dist)
358 IF(dist<tzinf)THEN
359 IF(n8>=1.AND.n8<=numels8)THEN
360 IF(nn/=ixs(2,ne).AND.nn/=ixs(3,ne).AND.
361 & nn/=ixs(4,ne).AND.nn/=ixs(5,ne).AND.
362 & nn/=ixs(6,ne).AND.nn/=ixs(7,ne).AND.
363 & nn/=ixs(8,ne).AND.nn/=ixs(9,ne))THEN
364 i_stok = i_stok + 1
365 prov_n(i_stok) = bpn(j)
366 prov_e(i_stok) = le
367 IF(i_stok==mvsiz-1)CALL i16sto(
368 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
369 2 cont ,mx_cand )
370 IF(cont==-2)RETURN
371 ENDIF
372 ELSEIF(n10>=1.AND.n10<=numels8)THEN
373 IF(nn/=ixs(2,ne).AND.nn/=ixs(4,ne).AND.
374 & nn/=ixs(7,ne).AND.nn/=ixs(6,ne).AND.
375 & nn/=ixs10(1,n10).AND.nn/=ixs10(2,n10).AND.
376 & nn/=ixs10(3,n10).AND.nn/=ixs10(4,n10).AND.
377 & nn/=ixs10(5,n10).AND.nn/=ixs10(6,n10))THEN
378 i_stok = i_stok + 1
379 prov_n(i_stok) = bpn(j)
380 prov_e(i_stok) = le
381 IF(i_stok==mvsiz-1)CALL i16sto(
382 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
383 2 cont ,mx_cand )
384 IF(cont==-2)RETURN
385 ENDIF
386 ELSEIF(n16>=1.AND.n16<=numels16)THEN
387 IF(nn/=ixs(2,ne).AND.nn/=ixs(3,ne).AND.
388 & nn/=ixs(4,ne).AND.nn/=ixs(5,ne).AND.
389 & nn/=ixs(6,ne).AND.nn/=ixs(7,ne).AND.
390 & nn/=ixs(8,ne).AND.nn/=ixs(9,ne).AND.
391 & nn/=ixs16(1,n16).AND.nn/=ixs16(2,n16).AND.
392 & nn/=ixs16(3,n16).AND.nn/=ixs16(4,n16).AND.
393 & nn/=ixs16(5,n16).AND.nn/=ixs16(6,n16).AND.
394 & nn/=ixs16(7,n16).AND.nn/=ixs16(8,n16))THEN
395 i_stok = i_stok + 1
396 prov_n(i_stok) = bpn(j)
397 prov_e(i_stok) = le
398 IF(i_stok==mvsiz-1)CALL i16sto(
399 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
400 2 cont ,mx_cand )
401 IF(cont==-2)RETURN
402 ENDIF
403 ELSEIF(n20>=1.AND.n20<=numels20)THEN
404 IF(nn/=ixs(2,ne).AND.nn/=ixs(3,ne).AND.
405 & nn/=ixs(4,ne).AND.nn/=ixs(5,ne).AND.
406 & nn/=ixs(6,ne).AND.nn/=ixs(7,ne).AND.
407 & nn/=ixs(8,ne).AND.nn/=ixs(9,ne).AND.
408 & nn/=ixs20(1,n20) .AND.nn/=ixs20(2,n20) .AND.
409 & nn/=ixs20(3,n20) .AND.nn/=ixs20(4,n20) .AND.
410 & nn/=ixs20(5,n20) .AND.nn/=ixs20(6,n20) .AND.
411 & nn/=ixs20(7,n20) .AND.nn/=ixs20(8,n20) .AND.
412 & nn/=ixs20(9,n20) .AND.nn/=ixs20(10,n20).AND.
413 & nn/=ixs20(11,n20).AND.nn/=ixs20(12,n20))THEN
414 i_stok = i_stok + 1
415 prov_n(i_stok) = bpn(j)
416 prov_e(i_stok) = le
417 IF(i_stok==mvsiz-1)CALL i16sto(
418 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
419 2 cont ,mx_cand )
420 IF(cont==-2)RETURN
421 ENDIF
422 ENDIF
423 ENDIF
424 ENDDO
425C-----------------------------------------------------------
426 ELSE
427C-----------------------------------------------------------
428C
429C
430C 2- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
431C
432C
433C-----------------------------------------------------------
434C
435C 2.1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
436C
437 dir = 1
438 IF(dy==dsup) THEN
439 dir = 2
440 ELSE IF(dz==dsup) THEN
441 dir = 3
442 ENDIF
443 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))*0.5
444C
445C 2.2- DIVISER LES NOEUDS EN TWO ZONES
446C
447 nb_ncn= 0
448 nb_ncn1= 0
449 addnn= add(1,i_add)
450#include "vectorize.inc"
451 DO i=1,nb_nc
452 IF(x(dir,nsv(bpn(i)))<seuil) THEN
453C ON STOCKE DANS LE BAS DE LA PILE BP
454 nb_ncn1 = nb_ncn1 + 1
455 addnn = addnn + 1
456 pn(addnn) = bpn(i)
457 ENDIF
458 ENDDO
459#include "vectorize.inc"
460 DO i=1,nb_nc
461 IF(x(dir,nsv(bpn(i)))>=seuil) THEN
462 nb_ncn = nb_ncn + 1
463 bpn(nb_ncn) = bpn(i)
464C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
465 ENDIF
466 ENDDO
467C
468C 2.3- DIVISER LES ELEMENTS
469C
470 nb_ecn= 0
471 addne= add(2,i_add)
472 IF(nb_ncn1==0) THEN
473C pas de noeuds dans la deuxieme boite
474#include "vectorize.inc"
475 DO i=1,nb_ec
476 le = bpe(i)
477 IF(eminx(dir+3,le)+tzinf>=seuil) THEN
478C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
479 nb_ecn = nb_ecn + 1
480 bpe(nb_ecn) = le
481 ENDIF
482 ENDDO
483 ELSEIF(nb_ncn==0) THEN
484C pas de noeuds dans la premiere boite
485#include "vectorize.inc"
486 DO i=1,nb_ec
487 le = bpe(i)
488 IF(eminx(dir,le)-tzinf<seuil) THEN
489C ON STOCKE DANS LA PILE PE
490 addne = addne + 1
491 pe(addne) = le
492 ENDIF
493 ENDDO
494 ELSE
495#include "vectorize.inc"
496 DO i=1,nb_ec
497 le = bpe(i)
498 IF(eminx(dir,le)-tzinf<seuil) THEN
499C ON STOCKE DANS LA PILE PE
500 addne = addne + 1
501 pe(addne) = le
502 ENDIF
503 IF(eminx(dir+3,le)+tzinf>=seuil) THEN
504C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
505 nb_ecn = nb_ecn + 1
506 bpe(nb_ecn) = le
507 ENDIF
508 ENDDO
509 ENDIF
510C
511C 2.4- REMPLIR LES TABLEAUX D'ADRESSES
512C
513 add(1,i_add+1) = addnn
514 add(2,i_add+1) = addne
515C-----on remplit les min de la boite suivante et les max de la courante
516 xyzm(1,i_add+1) = xyzm(1,i_add)
517 xyzm(2,i_add+1) = xyzm(2,i_add)
518 xyzm(3,i_add+1) = xyzm(3,i_add)
519 xyzm(4,i_add+1) = xyzm(4,i_add)
520 xyzm(5,i_add+1) = xyzm(5,i_add)
521 xyzm(6,i_add+1) = xyzm(6,i_add)
522 xyzm(dir,i_add+1) = seuil
523 xyzm(dir+3,i_add) = seuil
524C
525 nb_nc = nb_ncn
526 nb_ec = nb_ecn
527C on incremente le niveau de descente avant de sortir
528 i_add = i_add + 1
529 IF(i_add+1>=i_add_max) THEN
530 cont = -3
531 RETURN
532 ENDIF
533C=======================================================================
534 cont=1
535ctmp+++
536c WRITE(istdo,*)'CONT = ',CONT
537c WRITE(istdo,*)'I_ADD = ',I_ADD
538c WRITE(istdo,*)'ADD(2,I_ADD) = ',ADD(2,I_ADD)
539c WRITE(istdo,*)'NB_EC = ',NB_EC
540c WRITE(istdo,*)'NB_NC = ',NB_NC
541c WRITE(istdo,*)'dir seuil = ',dir, seuil
542c WRITE(istdo,*)'Xmin = ',XYZM(1,I_ADD)
543c WRITE(istdo,*)'Ymin = ',XYZM(2,I_ADD)
544c WRITE(istdo,*)'Zmin = ',XYZM(3,I_ADD)
545c WRITE(istdo,*)'Xmax = ',XYZM(4,I_ADD)
546c WRITE(istdo,*)'Ymax = ',XYZM(5,I_ADD)
547c WRITE(istdo,*)'Zmax = ',XYZM(6,I_ADD)
548ctmp---
549 RETURN
550C=======================================================================
551 ENDIF
552 ENDIF
553C-------------------------------------------------------------------------
554C TEST FIN DU TRI
555C-------------------------------------------------------------------------
556 IF (i_add==1) THEN
557 cont = 0
558 RETURN
559 ENDIF
560C-----------------------------------------------------------
561C
562C 3- FIN DE BRANCHE ou BOITE VIDE
563C
564C-----------------------------------------------------------
565C-------------------------------------------------------------------------
566C on decremente le niveau de descente avant de recommencer
567C-------------------------------------------------------------------------
568 i_add = i_add - 1
569C-------------------------------------------------------------------------
570C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
571C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
572C-------------------------------------------------------------------------
573C 3.1- PILE DES NOEUDS
574C
575 nb_nc = add(1,i_add+1) - add(1,i_add)
576 DO i=1,nb_nc
577 bpn(i) = pn(add(1,i_add)+i)
578 ENDDO
579C
580C 3.2- PILE DES ELEMENTS
581C
582 nb_ec = add(2,i_add+1) - add(2,i_add)
583 DO i=1,nb_ec
584 bpe(i) = pe(add(2,i_add)+i)
585 ENDDO
586C=======================================================================
587 cont=1
588 RETURN
589C=======================================================================
my_real
#define my_real
Definition cppsort.cpp:32
i16sto
subroutine i16sto(i_stok, i_stok_glob, prov_n, cand_n, prov_e, cand_e, cont, mx_cand)
Definition i16tri.F:600
max
#define max(a, b)
Definition macros.h:21

◆ i16sto()

subroutine i16sto ( integer i_stok,
integer i_stok_glob,
integer, dimension(*) prov_n,
integer, dimension(*) cand_n,
integer, dimension(*) prov_e,
integer, dimension(*) cand_e,
integer cont,
integer mx_cand )

Definition at line 597 of file i16tri.F.

600C-----------------------------------------------
601C I m p l i c i t T y p e s
602C-----------------------------------------------
603#include "implicit_f.inc"
604#include "comlock.inc"
605C-----------------------------------------------
606C D u m m y A r g u m e n t s
607C-----------------------------------------------
608 INTEGER I_STOK,I_STOK_GLOB,CONT ,MX_CAND,
609 . PROV_N(*),CAND_N(*),PROV_E(*),CAND_E(*)
610C-----------------------------------------------
611C L o c a l V a r i a b l e s
612C-----------------------------------------------
613 INTEGER I,J_STOK_GLOB
614C-----------------------------------------------
615#include "lockon.inc"
616 j_stok_glob = i_stok_glob
617 IF(i_stok_glob + i_stok<=mx_cand)THEN
618 i_stok_glob = i_stok_glob + i_stok
619 ELSE
620 cont = -2
621 ENDIF
622#include "lockoff.inc"
623 IF(cont==-2)RETURN
624C
625 DO i=1,i_stok
626 cand_n(i+j_stok_glob)=prov_n(i)
627 cand_e(i+j_stok_glob)=prov_e(i)
628 ENDDO
629C
630 i_stok = 0
631C-----------------------------------------------
632 RETURN

◆ i16tri()

subroutine i16tri ( integer, dimension(*) bpe,
integer, dimension(*) pe,
integer, dimension(*) bpn,
integer, dimension(*) pn,
integer nsn,
tzinf,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) nelem,
integer, dimension(*) nsv,
integer maxsiz,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
minbox,
integer cont,
integer nb_n_b,
eminx,
integer i_stok_glob,
integer nme,
integer itask,
integer noint,
x,
v,
a,
integer mx_cand,
integer, dimension(6,*) ixs10,
integer esh_t )

Definition at line 35 of file i16tri.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE message_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50#include "comlock.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com08_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER MAXSIZ,NB_N_B,I_STOK_GLOB,NME,NSN ,ITASK,NOINT ,MX_CAND,
63 . BPE(*),PE(*),BPN(*),PN(*),IXS(NIXS,*),IXS16(8,*),
64 . NSV(*),CAND_N(*),CAND_E(*),NELEM(*),IXS20(12,*),
65 . ESH_T, IXS10(6,*)
66C REAL
67 my_real
68 . x(3,*),v(3,*),a(3,*),eminx(6,*),
69 . minbox,tzinf,xmin,ymin,zmin,xmax,ymax,zmax
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I_ADD_MAX
74 parameter(i_add_max = 1001)
75 INTEGER I,J,I_ADD,I_STOK,L,NB_NC,NB_EC,CONT,NE
76 INTEGER ADD(2,I_ADD_MAX) ,PROV_N(MVSIZ),PROV_E(MVSIZ)
77 my_real
78 . xyzm(6,i_add_max-1)
79C
80C------------------------------------
81C---------------------------------
82C CALCUL DES BORNES DU DOMAINE
83C---------------------------------
84 xmin = ep30
85 ymin = ep30
86 zmin = ep30
87 xmax = -ep30
88 ymax = -ep30
89 zmax = -ep30
90C
91 nb_ec = nme
92 DO l=1,nb_ec
93 i = l + esh_t
94 bpe(l) = i
95C
96 xmin = min( xmin , eminx(1,i) )
97 ymin = min( ymin , eminx(2,i) )
98 zmin = min( zmin , eminx(3,i) )
99 xmax = max( xmax , eminx(4,i) )
100 ymax = max( ymax , eminx(5,i) )
101 zmax = max( zmax , eminx(6,i) )
102C
103 ENDDO
104C
105 xmin = xmin - tzinf
106 ymin = ymin - tzinf
107 zmin = zmin - tzinf
108 xmax = xmax + tzinf
109 ymax = ymax + tzinf
110 zmax = zmax + tzinf
111C
112C-----INITIALISATION DES ADRESSES ET X,Y,Z
113C
114C ADDE ADDN X Y Z
115C 1 1 XMIN YMIN ZMIN
116C 1 1 XMAX YMAX ZMAX
117 i_stok = 0
118 add(1,1) = 0
119 add(2,1) = 0
120 add(1,2) = 0
121 add(2,2) = 0
122 i_add = 1
123 xyzm(1,i_add) = xmin
124 xyzm(2,i_add) = ymin
125 xyzm(3,i_add) = zmin
126 xyzm(4,i_add) = xmax
127 xyzm(5,i_add) = ymax
128 xyzm(6,i_add) = zmax
129 nb_nc = 0
130 DO i=1,nsn
131 j=nsv(i)
132 IF(x(1,j)+dt2*(v(1,j)+dt12*a(1,j))>=xmin.AND.
133 . x(1,j)+dt2*(v(1,j)+dt12*a(1,j))<=xmax.AND.
134 . x(2,j)+dt2*(v(2,j)+dt12*a(2,j))>=ymin.AND.
135 . x(2,j)+dt2*(v(2,j)+dt12*a(2,j))<=ymax.AND.
136 . x(3,j)+dt2*(v(3,j)+dt12*a(3,j))>=zmin.AND.
137 . x(3,j)+dt2*(v(3,j)+dt12*a(3,j))<=zmax)THEN
138 nb_nc=nb_nc+1
139 bpn(nb_nc) = i
140 ENDIF
141 ENDDO
142ctmp+++
143c WRITE(istdo,*)'CONT = ',CONT
144c WRITE(istdo,*)'I_ADD = ',I_ADD
145c WRITE(istdo,*)'ADD(2,I_ADD) = ',ADD(2,I_ADD)
146c WRITE(istdo,*)'NB_EC = ',NB_EC
147c WRITE(istdo,*)'NB_NC = ',NB_NC
148c WRITE(istdo,*)'XYZM(1,I_ADD) = ',XYZM(1,I_ADD)
149c WRITE(istdo,*)'XYZM(2,I_ADD) = ',XYZM(2,I_ADD)
150c WRITE(istdo,*)'XYZM(3,I_ADD) = ',XYZM(3,I_ADD)
151c WRITE(istdo,*)'XYZM(4,I_ADD) = ',XYZM(4,I_ADD)
152c WRITE(istdo,*)'XYZM(5,I_ADD) = ',XYZM(5,I_ADD)
153c WRITE(istdo,*)'XYZM(6,I_ADD) = ',XYZM(6,I_ADD)
154c WRITE(istdo,*)'tzinf = ',tzinf
155c WRITE(istdo,*)'eminx(4,i) = ',(eminx(4,i),i=1,NB_EC)
156ctmp---
157C-----------------------------------------------
158C Boucle sur les boites
159C-----------------------------------------------
160 DO WHILE (cont==1)
161C-----------------------------------------------
162C Decoupage de l'espace en 2 suivant X Y ou Z
163C-----------------------------------------------
164 CALL i16cut(
165 1 bpe ,pe ,bpn ,pn ,add ,
166 2 x ,nb_nc ,nb_ec ,xyzm ,i_add ,
167 3 nsv ,maxsiz ,cand_n ,cand_e ,minbox ,
168 4 cont ,nb_n_b ,i_add_max,eminx ,nelem ,
169 5 i_stok ,ixs ,ixs16 ,ixs20 ,tzinf ,
170 6 i_stok_glob,prov_n ,prov_e ,v ,a ,
171 7 mx_cand ,ixs10 )
172 ENDDO
173C-----------------------------------------------
174C test de fin ou d'erreur
175C-----------------------------------------------
176C CONT = 0 ==> FIN
177C CONT = -1 ==> PAS ASSEZ DE MEMOIRE PILE
178C CONT = -2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
179C CONT = -3 ==> TROP NIVEAUX PILE
180 IF(cont==0)THEN
181 IF(i_stok/=0)CALL i16sto(
182 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
183 2 cont ,mx_cand )
184 RETURN
185 ENDIF
186 IF(cont==-1)THEN
187 CALL ancmsg(msgid=85,anmode=aninfo,i1=noint)
188 CALL arret(2)
189 ELSEIF(cont==-2) THEN
190 CALL ancmsg(msgid=86,anmode=aninfo,i1=noint)
191 CALL arret(2)
192 ELSEIF(cont==-3)THEN
193 CALL ancmsg(msgid=90,anmode=aninfo,i1=noint)
194 CALL arret(2)
195 ENDIF
196C
197C
198 RETURN
i16cut
subroutine i16cut(bpe, pe, bpn, pn, add, x, nb_nc, nb_ec, xyzm, i_add, nsv, maxsiz, cand_n, cand_e, minbox, cont, nb_n_b, i_add_max, eminx, nelem, i_stok, ixs, ixs16, ixs20, tzinf, i_stok_glob, prov_n, prov_e, v, a, mx_cand, ixs10)
Definition i16tri.F:215
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
message_mod
Definition message_mod.F:1249
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87