OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11buc1.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "scr06_c.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i11buc_vox1 (x, irects, irectm, nrts, nmn, nrtm, nsn, cand_m, cand_s, maxgap, noint, ii_stok, tzinf, maxbox, minbox, ncontact, multimp, msr, addcm, chaine, itab, nsv, iauto, i_mem, id, titr, iddlevel, bumult, drad, intercep, igap, gap_s, gap_m, gap_s_l, gap_m_l, gapmin, flagremnode, kremnode, remnode, dgapload)
subroutine i11buc1 (x, irectm, irects, bumult, nrts, nmn, nrtm, mwa, nsn, cand_m, cand_s, gap, xyzm, noint, i_stok, dist, tzinf, maxbox, minbox, msr, nsv, multimp, addcm, chaine, i_mem, id, titr, iddlevel, drad, it19)

Function/Subroutine Documentation

◆ i11buc1()

subroutine i11buc1 ( x,
integer, dimension(2,*) irectm,
integer, dimension(2,*) irects,
bumult,
integer nrts,
integer nmn,
integer nrtm,
integer, dimension(*) mwa,
integer nsn,
integer, dimension(*) cand_m,
integer, dimension(*) cand_s,
gap,
xyzm,
integer noint,
integer i_stok,
dist,
tzinf,
maxbox,
minbox,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer multimp,
integer, dimension(*) addcm,
integer, dimension(2,*) chaine,
integer i_mem,
integer id,
character(len=nchartitle) titr,
integer iddlevel,
drad,
integer it19 )

Definition at line 382 of file i11buc1.F.

389C-----------------------------------------------
390C M o d u l e s
391C-----------------------------------------------
392 USE message_mod
393 USE names_and_titles_mod , ONLY : nchartitle
394C============================================================================
395C cette routine est appelee par : ININT3(/inter3d1/inint3.F)
396C----------------------------------------------------------------------------
397C cette routine appelle : I11TRI(/inter3d1/i11tri.F)
398C I11STO(/inter3d1/i1chk3.F)
399C ARRET(/sortie1/arret.F)
400C============================================================================
401C-----------------------------------------------
402C I m p l i c i t T y p e s
403C-----------------------------------------------
404#include "implicit_f.inc"
405C-----------------------------------------------
406C G l o b a l P a r a m e t e r s
407C-----------------------------------------------
408#include "mvsiz_p.inc"
409C-----------------------------------------------
410C C o m m o n B l o c k s
411C-----------------------------------------------
412#include "units_c.inc"
413#include "scr06_c.inc"
414C-----------------------------------------------
415C D u m m y A r g u m e n t s
416C-----------------------------------------------
417 INTEGER NMN, NRTM, NSN, NOINT,I_STOK,NRTS,MULTIMP,MAXSIZ,I_MEM
418 INTEGER IRECTS(2,*),IRECTM(2,*),MWA(*)
419 INTEGER CAND_M(*),CAND_S(*),MSR(*),NSV(*),ADDCM(*),CHAINE(2,*),
420 * II_STOK, IDDLEVEL, IT19
421 my_real
422 . x(3,*),xyzm(6,*),dist,
423 . bumult,gap,tzinf,maxbox,minbox,drad
424 INTEGER ID
425 CHARACTER(LEN=NCHARTITLE) :: TITR
426C-----------------------------------------------
427C L o c a l V a r i a b l e s
428C-----------------------------------------------
429 INTEGER I_ADD_MAX
430 parameter(i_add_max = 1001)
431C
432 INTEGER PROV_S(2*MVSIZ),PROV_M(2*MVSIZ)
433 INTEGER I, J, L, N1, N2, N3, N4, I_AMAX,IADFIN
434 INTEGER I_ADD, ADESTK, NB_NC, NB_EC, ADNSTK,ISTOP, IBID
435 INTEGER IP1, IP2, IP21, IP22, IP31,J_STOK,I_BID,NB_N_B,
436 . ADD(2,0:I_ADD_MAX)
437C REAL
438 my_real
439 . dx1,dy1,dz1,
440 . dx3,dy3,dz3,
441 . dx4,dy4,dz4,
442 . dx6,dy6,dz6,
443 . dd1,dd2,dd3,dd4,dd,xmin,ymin,zmin,
444 . xmax,ymax,zmax,tzinf0,minbox0,maxbox0,
445 . bid,marge,tzinf_st,marge_st
446C
447C
448C
449C 1-CALCUL TAILLE DES ZONES INFLUENCES
450C DD EST LA LONGEUR MOYENNE ELEMENT
451 dd=zero
452 DO l=1,nrts
453C CONNECIVITES ELEMENT
454 n1=irects(1,l)
455 n2=irects(2,l)
456C LONGUEUR COTE 1
457 dx1=(x(1,n1)-x(1,n2))
458 dy1=(x(2,n1)-x(2,n2))
459 dz1=(x(3,n1)-x(3,n2))
460 dd1=sqrt(dx1**2+dy1**2+dz1**2)
461 dd=dd+ dd1
462 ENDDO
463 DO l=1,nrtm
464C CONNECIVITES ELEMENT
465 n1=irectm(1,l)
466 n2=irectm(2,l)
467C LONGUEUR COTE 1
468 dx1=(x(1,n1)-x(1,n2))
469 dy1=(x(2,n1)-x(2,n2))
470 dz1=(x(3,n1)-x(3,n2))
471 dd1=sqrt(dx1**2+dy1**2+dz1**2)
472 dd=dd+ dd1
473 ENDDO
474C TAILLE ZINF = .1*TAILLE MOYENNE ELEMENT DE CHAQUE COTE
475C TAILLE BUCKET MIN = TZINF * BUMULT
476C DD = MAX(DD/(NRTS+NRTM),1.251*GAP)
477 dd = dd/(nrts+nrtm)
478C TZINF = BUMULT*DD
479 marge = bumult*dd
480 tzinf = marge + max(gap,drad)
481C MARGE_ST : marge independante du BUMULT en input pour trouver les memes pene initiales
482 marge_st = bmul0*dd
483C 1er passage avec marge x2 pour trouver plus de candidats (revient a prendre bmul0=0.4 au lieu de 0.2)
484C IF(IDDLEVEL==0) MARGE_ST = 2*MARGE_ST
485c WRITE(6,*) __FILE__,__LINE__,"IDDLEVEL=",IDDLEVEL
486c WRITE(6,*) __FILE__,__LINE__,MARGE
487c WRITE(6,*) __FILE__,__LINE__,MINBOX,MAXBOX,MULTIMP
488c WRITE(6,*) __FILE__,__LINE__,DRAD,GAP,BMUL0
489
490
491
492 IF(iddlevel==0) marge_st = marge
493 tzinf_st = marge_st + max(gap,drad)
494C
495 minbox= dd + tzinf
496 maxbox= two*minbox
497 tzinf0 = tzinf
498 minbox0 = minbox
499 maxbox0 = maxbox
500C MIS A ZERO POUR FAIRE SEARCH COMPLET CYCLE 0 ENGINE
501 dist = zero
502C--------------------------------
503C CALCUL DES BORNES DU DOMAINE
504C--------------------------------
505 xmin=ep30
506 xmax=-ep30
507 ymin=ep30
508 ymax=-ep30
509 zmin=ep30
510 zmax=-ep30
511C
512 DO 20 i=1,nmn
513 j=msr(i)
514 xmin= min(xmin,x(1,j))
515 ymin= min(ymin,x(2,j))
516 zmin= min(zmin,x(3,j))
517 xmax= max(xmax,x(1,j))
518 ymax= max(ymax,x(2,j))
519 zmax= max(zmax,x(3,j))
520 20 CONTINUE
521 xmin=xmin-tzinf_st
522 ymin=ymin-tzinf_st
523 zmin=zmin-tzinf_st
524 xmax=xmax+tzinf_st
525 ymax=ymax+tzinf_st
526 zmax=zmax+tzinf_st
527c DO 25 I=1,NSN
528c J=NSV(I)
529c XMIN= MIN(XMIN,X(1,J))
530c YMIN= MIN(YMIN,X(2,J))
531c ZMIN= MIN(ZMIN,X(3,J))
532c XMAX= MAX(XMAX,X(1,J))
533c YMAX= MAX(YMAX,X(2,J))
534c ZMAX= MAX(ZMAX,X(3,J))
535c25 CONTINUE
536c XMIN=XMIN-TZINF_ST
537c YMIN=YMIN-TZINF_ST
538c ZMIN=ZMIN-TZINF_ST
539c XMAX=XMAX+TZINF_ST
540c YMAX=YMAX+TZINF_ST
541c ZMAX=ZMAX+TZINF_ST
542
543c WRITE(6,*) "X",XMIN,XMAX
544c WRITE(6,*) "Y",YMIN,YMAX
545c WRITE(6,*) "Z",ZMIN,ZMAX
546
547C
548C
549C-----2- TRI PAR BOITES DES ELEMENTS ET DES NOEUDS
550C
551 nb_n_b = 1
552 i_mem = 0
553 ii_stok = 0
554C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
555C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
556 100 CONTINUE
557C POINTEUR NOM TAILLE
558C P1........Elt Bas Pile NRTM
559C P2........Elt PILE 3*NRTM
560C P21.......Elt Bas Pile NRTS
561C P22.......Elt PILE 3*NRTS
562C
563C
564 maxsiz = 3*(max(nrtm,nrts)+100)
565 ip1 = 1
566 ip2 = ip1+nrtm+100
567 ip21= ip2+maxsiz
568 ip22= ip21+nrts+100
569
570C-----INITIALISATION DES ADRESSES ET X,Y,Z
571C
572C ADDE ADDN X Y Z
573C 1 1 XMIN YMIN ZMIN
574C 1 1 XMAX YMAX ZMAX
575C
576 add(1,1) = 0
577 add(2,1) = 0
578 add(1,2) = 0
579 add(2,2) = 0
580 i_add = 1
581 i_amax = 1
582 xyzm(1,i_add) = xmin
583 xyzm(2,i_add) = ymin
584 xyzm(3,i_add) = zmin
585 xyzm(4,i_add) = xmax
586 xyzm(5,i_add) = ymax
587 xyzm(6,i_add) = zmax
588 i_stok = 0
589 ii_stok = 0
590 j_stok = 0
591 adnstk = 0
592 adestk = 0
593 nb_nc = nrts
594 nb_ec = nrtm
595 istop = 0
596 iadfin = 0
597C
598C-----COPIE DES NOS DE SEGMENTS ET DE NOEUDS DANS MWA(IP1) ET IP21
599C
600 DO 120 i=1,nb_ec
601 addcm(i)=0
602 mwa(ip1+i-1) = i
603 120 CONTINUE
604 DO 140 i=1,nb_nc
605 mwa(ip21+i-1) = i
606 140 CONTINUE
607C
608C-----DEBUT DE LA PHASE DE TRI
609C
610C TANT QUE IL RESTE UNE ADRESSE A TRIER
611C------------------
612 200 CONTINUE
613c WRITE(6,*) __FILE__,__LINE__
614C------------------
615C SEPARER B ET N EN TWO
616 CALL i11tri(
617 1 mwa(ip1),mwa(ip2),mwa(ip21),mwa(ip22),add,
618 2 irects ,x ,nb_nc ,nb_ec ,xyzm,
619 3 i_add ,irectm ,i_amax ,istop ,
620 4 maxsiz ,i_stok ,i_mem ,nb_n_b ,iadfin,
621 5 cand_s ,cand_m ,nsn ,noint ,tzinf_st,
622 6 maxbox ,minbox ,j_stok ,addcm ,chaine,
623 7 prov_s ,prov_m ,ii_stok ,multimp,id,titr)
624C------------------
625 IF (i_mem == 2) RETURN
626C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
627C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
628 IF(i_mem==1)THEN
629 nb_n_b = nb_n_b + 1
630 i_mem = 0
631 GO TO 100
632 ENDIF
633 IF(i_add/=0) GO TO 200
634C FIN BOUCLE TANT QUE
635C---------------------------------
636C-------------------------------------------------------------------------
637C FIN DU TRI
638C-------------------------------------------------------------------------
639 i_stok=ii_stok
640 IF(j_stok/=0)CALL i11sto(
641 1 j_stok,irects,irectm,x ,ii_stok,
642 2 cand_s,cand_m,nsn ,noint ,tzinf_st,
643 3 i_mem ,prov_s,prov_m,multimp,addcm,
644 4 chaine,iadfin)
645 IF (i_mem == 2) RETURN
646
647 i_stok=ii_stok
648 IF ((nsn/=0).AND.(it19==0)) THEN
649 WRITE(iout,*)' POSSIBLE IMPACT NUMBER:',i_stok,' (<=',
650 . 1+(i_stok-1)/nsn,'*NSN)'
651c DO I = 1, I_STOK
652c WRITE(700+IDDLEVEL,*) CAND_S(I),CAND_M(I)
653c ENDDO
654c CALL FLUSH(700+IDDLEVEL)
655
656 ELSEIF(nsn==0) THEN
657 CALL ancmsg(msgid=552,
658 . msgtype=msgwarning,
659 . anmode=aninfo_blind_2,
660 . i1=id,
661 . c1=titr)
662 ENDIF
663C
664 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
i11sto
subroutine i11sto(j_stok, irects, irectm, x, ii_stok, cand_n, cand_e, nsn, noint, tzinf, i_mem, prov_n, prov_e, multimp, addcm, chaine, iadfin)
Definition i11sto.F:137
i11tri
subroutine i11tri(bpe, pe, bpn, pn, add, irects, x, nb_sc, nb_mc, xyzm, i_add, irectm, i_amax, istop, maxsiz, i_stok, i_mem, nb_n_b, iadfin, cand_s, cand_m, nsn, noint, tzinf, maxbox, minbox, j_stok, addcm, chaine, prov_s, prov_m, ii_stok, multimp, id, titr)
Definition i11tri.F:42
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

◆ i11buc_vox1()

subroutine i11buc_vox1 ( x,
integer, dimension(2,*) irects,
integer, dimension(2,*) irectm,
integer nrts,
integer nmn,
integer nrtm,
integer nsn,
integer, dimension(*) cand_m,
integer, dimension(*) cand_s,
maxgap,
integer noint,
integer ii_stok,
tzinf,
maxbox,
minbox,
integer ncontact,
integer multimp,
integer, dimension(*) msr,
integer, dimension(*) addcm,
integer, dimension(2,*) chaine,
integer, dimension(*) itab,
integer, dimension(*) nsv,
integer iauto,
integer i_mem,
integer id,
character(len=nchartitle) titr,
integer iddlevel,
bumult,
drad,
type(intersurfp), dimension(3,ninter) intercep,
integer igap,
gap_s,
gap_m,
gap_s_l,
gap_m_l,
gapmin,
integer flagremnode,
integer, dimension(*) kremnode,
integer, dimension(*) remnode,
intent(in) dgapload )

Definition at line 36 of file i11buc1.F.

46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE message_mod
50 USE tri7box
51 USE tri11
52 USE front_mod
53 USE names_and_titles_mod , ONLY : nchartitle
54C============================================================================
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "units_c.inc"
62#include "com04_c.inc"
63#include "scr06_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER NMN, NRTM, NSN, NOINT,IDT,NRTS,IDDLEVEL,
68 . IAUTO, I_MEM, IGAP
69 INTEGER IRECTS(2,*),IRECTM(2,*),ADDCM(*),CHAINE(2,*)
70 INTEGER CAND_M(*),CAND_S(*)
71 INTEGER NCONTACT, ITAB(*),MSR(*),NSV(*),
72 . II_STOK,MULTIMP,FLAGREMNODE,KREMNODE(*),REMNODE(*)
73C REAL
74 my_real
75 . bumult,maxgap,gapmin,tzinf,maxbox,minbox,drad
76 my_real , INTENT(IN) :: dgapload
77 my_real
78 . x(3,*),
79 . gap_s(*), gap_m(*), gap_s_l(*), gap_m_l(*)
80 INTEGER ID
81 CHARACTER(LEN=NCHARTITLE) :: TITR
82 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER I_ADD_MAX
87 parameter(i_add_max = 1001)
88C
89 INTEGER I, J, N1, N2, I_ADD, MAXSIZ,JJ,
90 . ADD(2,I_ADD_MAX), N
91 my_real
92 . xyzm(6,i_add_max-1), marge, aaa
93 INTEGER NB_OLD(2,I_ADD_MAX+1)
94 INTEGER NBX,NBY,NBZ
95 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
96 INTEGER (KIND=8) :: IONE,IHUNDRED
97 INTEGER NB_N_B
98 INTEGER IADFIN,II,L
99 my_real :: xmax,ymax,zmax
100 my_real :: xmin,ymin,zmin,xtmp
101 my_real :: bminma(6)
102 my_real :: dd,dx1,dy1,dz1,dd1,marge_st,tzinf_st
103C Initializing constant
104 ione=1
105 ihundred=100
106C-----------------------------------------------
107C definition from TRI7BOX module
108C-----------------------------------------------
109C
110C-----------------------------------------------
111C S o u r c e L i n e s
112C-----------------------------------------------
113C
114C----- TRI PAR BOITES
115C
116C-----------------------------------------------
117C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
118C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
119C
120C POINTEUR NOM TAILLE
121C P1........Elt Bas Pile NRTM
122C P2........Elt PILE 3*NRTM
123C P21.......Elt Bas Pile NRTS
124C P22.......Elt PILE 3*NRTS
125 maxsiz = 3*(max(nrtm,nrts)+100)
126C
127C-----INITIALISATION DES ADRESSES ET X,Y,Z
128C
129C ADDE ADDN X Y Z
130C 1 1 XMIN YMIN ZMIN
131C 1 1 XMAX YMAX ZMAX
132C
133 add(1,1) = 0
134 add(2,1) = 0
135 add(1,2) = 0
136 add(2,2) = 0
137 i_add = 1
138 iadfin = 0
139 nb_n_b = 1
140
141C
142C
143C CALCULER LES BMINMA ICI
144C
145C
146
147 bminma(1)=-ep30
148 bminma(2)=-ep30
149 bminma(3)=-ep30
150 bminma(4)=ep30
151 bminma(5)=ep30
152 bminma(6)=ep30
153
154
155
156 i_mem = 0
157 ii_stok = 0
158
159C
160c IF (IFORM /= 2) THEN
161 DO i=1,nrtm
162 addcm(i)=0
163 ENDDO
164c ELSE
165c ENDIF
166
167C-----DEBUT DE LA PHASE DE TRI
168
169 dd=zero
170 DO l=1,nrts
171C CONNECIVITES ELEMENT
172 n1=irects(1,l)
173 n2=irects(2,l)
174C LONGUEUR COTE 1
175 dx1=(x(1,n1)-x(1,n2))
176 dy1=(x(2,n1)-x(2,n2))
177 dz1=(x(3,n1)-x(3,n2))
178 dd1=sqrt(dx1**2+dy1**2+dz1**2)
179 dd=dd+ dd1
180 ENDDO
181 DO l=1,nrtm
182C CONNECIVITES ELEMENT
183 n1=irectm(1,l)
184 n2=irectm(2,l)
185C LONGUEUR COTE 1
186 dx1=(x(1,n1)-x(1,n2))
187 dy1=(x(2,n1)-x(2,n2))
188 dz1=(x(3,n1)-x(3,n2))
189 dd1=sqrt(dx1**2+dy1**2+dz1**2)
190 dd=dd+ dd1
191 ENDDO
192C TAILLE ZINF = .1*TAILLE MOYENNE ELEMENT DE CHAQUE COTE
193C TAILLE BUCKET MIN = TZINF * BUMULT
194C DD = MAX(DD/(NRTS+NRTM),1.251*MAXGAP)
195 dd = dd/(nrts+nrtm)
196C TZINF = BUMULT*DD
197 marge = bumult*dd
198 tzinf = marge + max(maxgap+dgapload,drad)
199C MARGE_ST : marge independante du BUMULT en input pour trouver les memes pene initiales
200 marge_st = bmul0*dd
201C 1er passage avec marge x2 pour trouver plus de candidats (revient a prendre bmul0=0.4 au lieu de 0.2)
202C IF(IDDLEVEL==0) MARGE_ST = 2*MARGE_ST
203c WRITE(6,*) __FILE__,__LINE__,MARGE
204 IF(iddlevel==0) marge_st = marge
205 tzinf_st = marge_st + max(maxgap+dgapload,drad)
206
207 xmin=ep30
208 xmax=-ep30
209 ymin=ep30
210 ymax=-ep30
211 zmin=ep30
212 zmax=-ep30
213C
214 DO i=1,nmn
215 j=msr(i)
216 IF(j>0) THEN
217 xmin= min(xmin,x(1,j))
218 ymin= min(ymin,x(2,j))
219 zmin= min(zmin,x(3,j))
220 xmax= max(xmax,x(1,j))
221 ymax= max(ymax,x(2,j))
222 zmax= max(zmax,x(3,j))
223 END IF
224 END DO
225
226 xmin=xmin-tzinf_st
227 ymin=ymin-tzinf_st
228 zmin=zmin-tzinf_st
229 xmax=xmax+tzinf_st
230 ymax=ymax+tzinf_st
231 zmax=zmax+tzinf_st
232C DO 25 I=1,NSN
233C J=NSV(I)
234C XMIN= MIN(XMIN,X(1,J))
235C YMIN= MIN(YMIN,X(2,J))
236C ZMIN= MIN(ZMIN,X(3,J))
237C XMAX= MAX(XMAX,X(1,J))
238C YMAX= MAX(YMAX,X(2,J))
239C ZMAX= MAX(ZMAX,X(3,J))
240C 25 CONTINUE
241C XMIN=XMIN-TZINF_ST
242C YMIN=YMIN-TZINF_ST
243C ZMIN=ZMIN-TZINF_ST
244C XMAX=XMAX+TZINF_ST
245C YMAX=YMAX+TZINF_ST
246C ZMAX=ZMAX+TZINF_ST
247
248 bminma(1) = max(bminma(1),xmax)
249 bminma(2) = max(bminma(2),ymax)
250 bminma(3) = max(bminma(3),zmax)
251 bminma(4) = min(bminma(4),xmin)
252 bminma(5) = min(bminma(5),ymin)
253 bminma(6) = min(bminma(6),zmin)
254
255c WRITE(6,*) "X",XMIN,XMAX
256c WRITE(6,*) "Y",YMIN,YMAX
257c WRITE(6,*) "Z",ZMIN,ZMAX
258
259
260 xyzm(1,i_add) = bminma(4)
261 xyzm(2,i_add) = bminma(5)
262 xyzm(3,i_add) = bminma(6)
263 xyzm(4,i_add) = bminma(1)
264 xyzm(5,i_add) = bminma(2)
265 xyzm(6,i_add) = bminma(3)
266C
267
268c MARGE = TZINF - MAX(MAXGAP,DRAD)
269
270 aaa = sqrt(1.0d0* nmn /
271 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
272 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
273 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
274
275 aaa = 0.75*aaa
276
277 nbx = nint(aaa*(bminma(1)-bminma(4)))
278 nby = nint(aaa*(bminma(2)-bminma(5)))
279 nbz = nint(aaa*(bminma(3)-bminma(6)))
280 nbx = max(nbx,1)
281 nby = max(nby,1)
282 nbz = max(nbz,1)
283
284 nbx8=nbx
285 nby8=nby
286 nbz8=nbz
287 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
288 lvoxel8 = lvoxel
289
290 IF(res8 > lvoxel8)THEN
291 aaa = lvoxel
292 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
293 aaa = aaa**(third)
294 nbx = int((nbx+2)*aaa)-2
295 nby = int((nby+2)*aaa)-2
296 nbz = int((nbz+2)*aaa)-2
297 nbx = max(nbx,1)
298 nby = max(nby,1)
299 nbz = max(nbz,1)
300 nbx8 = nbx
301 nby8 = nby
302 nbz8 = nbz
303 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
304 END IF
305
306 IF(res8 > lvoxel8) THEN
307 nbx = min(ihundred,max(nbx8,ione))
308 nby = min(ihundred,max(nby8,ione))
309 nbz = min(ihundred,max(nbz8,ione))
310 END IF
311
312 DO i=inivoxel,(nbx+2)*(nby+2)*(nbz+2)
313 voxel1(i)=0
314 ENDDO
315 inivoxel = max(inivoxel,(nbx+2)*(nby+2)*(nbz+2)+1)
316
317 !print *, "voxel search"
318
319 CALL i11trivox1(
320 1 irects ,irectm ,x ,nrtm ,
321 2 xyzm ,ii_stok ,cand_s ,cand_m , nsn,
322 3 noint ,tzinf_st,i_mem ,addcm , iadfin,
323 4 chaine ,nrts ,itab ,multimp,
324 5 iauto ,voxel1 ,nbx ,nby ,nbz ,
325 7 gapmin ,drad ,marge_st,gap_s ,gap_m ,
326 8 gap_s_l ,gap_m_l ,igap ,flagremnode,kremnode,
327 3 remnode ,dgapload)
328
329
330C
331C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
332
333 IF (i_mem == 2) RETURN
334 IF(i_mem ==1 .OR. i_mem == 3)THEN
335 nb_n_b = nb_n_b + 1
336 IF ( nb_n_b > max(nrtm,nrts)) THEN
337 CALL ancmsg(msgid=83,
338 . msgtype=msgerror,
339 . anmode=aninfo ,
340 . i1=id,
341 . c1=titr)
342
343 ENDIF
344 ENDIF
345
346 IF ((nsn/=0)) THEN
347 WRITE(iout,*)' POSSIBLE IMPACT NUMBER:',ii_stok,' (<=',
348 . 1+(ii_stok-1)/nsn,'*NSN)'
349 ELSEIF(nsn==0) THEN
350 CALL ancmsg(msgid=552,
351 . msgtype=msgwarning,
352 . anmode=aninfo_blind_2,
353 . i1=id,
354 . c1=titr)
355 ENDIF
356
357C DO I = 1, II_STOK
358C WRITE(800+IDDLEVEL,*) NOINT,ITAB(IRECTS(1,CAND_S(I)))
359C . ,ITAB(IRECTS(2,CAND_S(I))),ITAB(IRECTM(1,CAND_M(I))),ITAB(IRECTM(2,CAND_M(I)))
360C ENDDO
361C CALL FLUSH(800+IDDLEVEL)
362
363C
364 RETURN
i11trivox1
subroutine i11trivox1(irects, irectm, x, nrtm, xyzm, ii_stok, cand_s, cand_m, nsn, noint, tzinf, i_mem, addcm, iadfin, chaine, nrts, itab, multimp, iauto, voxel, nbx, nby, nbz, gapmin, drad, marge, gap_s, gap_m, gap_s_l, gap_m_l, igap, flagremnode, kremnode, remnode, dgapload)
Definition i11trivox1.F:45
front_mod
Definition front_mod.F:84
tri7box::voxel1
integer, dimension(lvoxel) voxel1
Definition tri7box.F:53
tri7box::inivoxel
integer inivoxel
Definition tri7box.F:53
tri7box::lvoxel
integer lvoxel
Definition tri7box.F:51