OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11tri.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i11tri()

subroutine i11tri ( integer, dimension(*) bpe,
integer, dimension(*) pe,
integer, dimension(*) bpn,
integer, dimension(*) pn,
integer, dimension(2,0:*) add,
integer, dimension(2,*) irects,
x,
integer nb_sc,
integer nb_mc,
xyzm,
integer i_add,
integer, dimension(2,*) irectm,
integer i_amax,
integer istop,
integer maxsiz,
integer i_stok,
integer i_mem,
integer nb_n_b,
integer iadfin,
integer, dimension(*) cand_s,
integer, dimension(*) cand_m,
integer nsn,
integer noint,
tzinf,
maxbox,
minbox,
integer j_stok,
integer, dimension(*) addcm,
integer, dimension(*) chaine,
integer, dimension(2*mvsiz) prov_s,
integer, dimension(2*mvsiz) prov_m,
integer ii_stok,
integer multimp,
integer id,
character(len=nchartitle) titr )

Definition at line 34 of file i11tri.F.

42 USE message_mod
43 USE names_and_titles_mod , ONLY : nchartitle
44C============================================================================
45C this routine is called by : I11BUC1(/inter3d1/i11buc1.F)
46C----------------------------------------------------------------------------
47C cette routine appelle : I11STO(/inter3d1/i11sto.F)
48C I7DSTK(/inter3d1/i7dstk.F)
49C Stop (/Sortie1/arret.f)
50C============================================================================
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C G l o b a l P a r a m e t e r s
57C-----------------------------------------------
58#include "mvsiz_p.inc"
59#include "param_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER NB_SC,NB_MC,I_ADD,MAXSIZ,I_STOK,J_STOK,I_MEM
64 INTEGER I_AMAX,NB_N_B, NOINT, NSN,MULTIMP,ISTOP,
65 . IADFIN,II_STOK
66 INTEGER ADD(2,0:*),IRECTS(2,*),IRECTM(2,*),BPE(*),PE(*)
67 INTEGER CAND_S(*),CAND_M(*),BPN(*),PN(*)
68 INTEGER ADDCM(*),CHAINE(*)
69 INTEGER PROV_S(2*MVSIZ),PROV_M(2*MVSIZ)
70 my_real
71 . x(3,*),xyzm(6,*),tzinf,
72 . maxbox,minbox
73 INTEGER ID
74 CHARACTER(LEN=NCHARTITLE) :: TITR
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER NB_SCN1,NB_MCN1,NB_SCN,NB_MCN,ADDNN,ADDNE,
79 . I,J,K,L
80 INTEGER INF,SUP,DIR,N1,N2,NN1,NN2,NN,NE,MEMX,NCAND_PROV
81 my_real
82 . dx,dy,dz,dsup,seuil,xx1,xx2,xmin, xmax
83CC integer idb1,idb2,idb3,idb4
84CC save idb1,idb2,idb3,idb4
85C-----------------------------------------------
86 DATA memx/0/
87CCctmp
88CC data idb1/-1/
89CC data idb2/-1/
90CC data idb3/-1/
91CC data idb4/-1/
92C-----------------------------------------------
93C ROLE OF THE ROUTINE:
94C ===================
95C CLASSIFIES BPE ELEMENTS AND BPN NODES INTO TWO ZONES
96C > OR < TO A BORDER HERE DETERMINED AND OUTPUTS EVERYTHING
97C IN bpe,hpe, and bpn,hpn
98C-----------------------------------------------
99C D u m m y A r g u m e n t s
100C
101C NOM DESCRIPTION E/S
102C
103C BPE ARRAY OF FACETTES TO SORT E/S
104C AND OF THE RESULT ON THE MAX SIDE
105C PE ARRAY OF FACETTES S
106C RESULTAT COTE MIN
107C BPN SORTED NODES ARRAY E/S
108C AND OF THE RESULT ON THE MAX SIDE
109C PN NODES ARRAY S
110C RESULTAT COTE MIN
111C ADD(2,*) ARRAY OF ADRESSES E/S
112C 1.......ADRESSES NODES C 2.......ADRESSES ELEMENTS
113C ZYZM(6,*) ARRAY OF XYZMIN E/S
114C 1.......XMIN BOITE
115C 2.......YMIN BOITE
116C 3.......ZMIN BOITE
117C 4.......XMAX BOITE
118C 5.......YMAX BOITE
119C 6.......ZMAX BOITE
120C IRECT(4,*) ARRAY OF CONEC FACETTES E
121C X(3,*) COORDONNEES NODALES E
122C NB_SC NUMBER OF CANDIDATE NODES E/S
123C NB_MC NUMBER OF CANDIDATE ELEMENTS E/S
124C I_ADD POSITION IN THE E/S ADDRESS TAB
125C Xmax larger abcisse existing e
126C XMAX largest order.existing E
127C Xmax larger existing side E
128C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
129C I_STOK storage level of the couples
130C CANDIDATES impact E/S
131C CAND_S boites resultats nodes C CAND_M adresses des boites resultat elements
132C NSN 4*NSN MAX SIZE NOW ALLOWED FOR
133C COUPLES NODES,ELT CANDIDATES
134C NOINT INTERFACE USER NUMBER
135C TZINF TAILLE ZONE INFLUENCE
136C MAXBOX TAILLE MAX BUCKET
137C MINBOX TAILLE MIN BUCKET
138C=======================================================================
139C
140C
141C 1- TEST ARRET = BOITE VIDE
142C BOITE TROP PETITE
143C BOITE NE CONTENANT QU'ONE NODE C NOT ENOUGH MEMORY AVAILABLE
144C
145C-----------------------------------------------------------
146C
147C IF(MEMX>ADD(2,1)+NB_MC)THEN
148C WRITE(ISTDO,*)' *******MEM MAX=',MEMX
149C MEMX=-1
150C ELSEIF(MEMX/=-1)THEN
151C MEMX=ADD(2,1)+NB_MC
152C ENDIF
153C--------------------TEST ON EMPTY BOXES--------------
154C
155 IF(nb_mc==0.OR.nb_sc==0) THEN
156C write(6,*)" BOITE VIDE"
157C THE BASES OF THE STACKS MUST BE COPIED TO THE CORRESPONDING BAS_DE_PILE
158C BEFORE DESCENDING AGAIN INTO THE INTERMEDIATE BRANCH
159C 006 CALL I7DSTK(I_ADD,NB_SC,NB_MC,ADD,BPN,PN,BPE,PE)
160 CALL i7dstk(i_add,nb_sc,nb_mc,add(1,i_add-1),bpn,pn,bpe,pe)
161 RETURN
162 ENDIF
163C
164C-------------------TEST ON END OF BRANCH / EXCEEDED MEMORY------------
165C
166 dx = xyzm(4,i_add) - xyzm(1,i_add)
167 dy = xyzm(5,i_add) - xyzm(2,i_add)
168 dz = xyzm(6,i_add) - xyzm(3,i_add)
169 dsup= max(dx,dy,dz)
170C
171C 006 IF(ADD(1,I_ADD)+NB_SC>=MAXSIZ.OR.ADD(2,1)+NB_MC>=MAXSIZ) THEN
172 IF(add(1,i_add)+nb_sc>=maxsiz.OR.
173 . add(2,i_add)+nb_mc>=maxsiz) THEN
174C NO MORE SPACE IN THE STACK OF BOX ELEMENTS TOO SMALL
175 IF ( nb_n_b == maxsiz/3) THEN
176C WRITE(IOUT,*)'***ERROR INFINITE LOOP DETECTED '
177C WRITE(ISTDO,*)'***ERROR INFINITE LOOP DETECTED '
178C CALL ARRET(2)
179 CALL ancmsg(msgid=685,
180 . msgtype=msgerror,
181 . anmode=aninfo,
182 . i1=id,
183 . c1=titr)
184 ENDIF
185 i_mem = 1
186 RETURN
187 ENDIF
188 ncand_prov=nb_mc*nb_sc
189 IF(dsup<minbox.OR.istop==1.OR.
190 . (nb_sc<=nb_n_b.AND.dsup<maxbox).OR.
191 . (nb_sc<=nb_n_b.AND.nb_mc==1).OR.
192 . (nb_mc<=nb_n_b.AND.dsup<maxbox).OR.
193 . (nb_mc<=nb_n_b.AND.nb_sc==1)) THEN
194 istop = 0
195C
196C write(6,*)" NOUVELLE BOITE "
197C 1- STORAGE OF THE CANDIDATE NODE OR NODES AND CORRESPONDING ELEMENTS.
198C REMOVE THE USELESS ONES
199 DO k=1,ncand_prov,nvsiz
200 DO l=k,min(k-1+nvsiz,ncand_prov)
201 i = 1+(l-1)/nb_sc
202 j = l-(i-1)*nb_sc
203 ne = bpe(i)
204 nn = bpn(j)
205CCctmp
206CC if(idb1==nn.and.idb2==ne)then
207CC idb3=-1
208CC endif
209 n1=irectm(1,ne)
210 n2=irectm(2,ne)
211 nn1=irects(1,nn)
212 nn2=irects(2,nn)
213 IF(nn1/=n1.AND.nn1/=n2.AND.
214 . nn2/=n1.AND.nn2/=n2) THEN
215 j_stok = j_stok + 1
216 prov_s(j_stok) = nn
217 prov_m(j_stok) = ne
218 ENDIF
219 ENDDO
220 IF(j_stok>=nvsiz)THEN
221 CALL i11sto(
222 1 nvsiz,irects,irectm,x ,ii_stok,
223 2 cand_s,cand_m,nsn ,noint ,tzinf ,
224 3 i_mem ,prov_s,prov_m,multimp,addcm,
225 4 chaine,iadfin)
226 IF(i_mem==2)RETURN
227 j_stok = j_stok-nvsiz
228 DO j=1,j_stok
229 prov_s(j) = prov_s(j+nvsiz)
230 prov_m(j) = prov_m(j+nvsiz)
231 ENDDO
232 ENDIF
233 ENDDO
234C THE BASES OF THE STACKS MUST BE COPIED TO THE CORRESPONDING BAS_DE_PILE
235C BEFORE DESCENDING INTO THE ADJACENT BRANCH
236C 006 CALL I7DSTK(I_ADD,NB_SC,NB_MC,ADD,BPN,PN,BPE,PE)
237 CALL i7dstk(i_add,nb_sc,nb_mc,add(1,i_add-1),bpn,
238 . pn,bpe,pe)
239 RETURN
240 ENDIF
241C
242C-----------------------------------------------------------
243C
244C
245C 2- SORTING PHASE ON THE MEDIAN ACCORDING TO THE LARGEST DIRECTION
246C
247C
248C-----------------------------------------------------------
249C
250C
251C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
252C
253 dir = 1
254 IF(dy==dsup) THEN
255 dir = 2
256 ELSE IF(dz==dsup) THEN
257 dir = 3
258 ENDIF
259 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))/2
260C
261C 2- DIVISER LES SECONDS EN TWO ZONES
262C
263CC idb3=-1
264 nb_scn= 0
265 nb_scn1= 0
266C 006 ADDNN= ADD(1,1)
267 addnn= add(1,i_add)
268 inf = 0
269 sup = 0
270 DO 70 i=1,nb_sc
271 nn = bpn(i)
272CC if(nn==idb1)then
273CC idb3=0
274CC endif
275 xx1=x(dir, irects(1,nn))
276 xx2=x(dir, irects(2,nn))
277 xmax=max(xx1,xx2)+tzinf
278 xmin=min(xx1,xx2)-tzinf
279 IF(xmin<seuil) THEN
280C WE STORE AT THE BOTTOM OF THE BP STACK
281 nb_scn1 = nb_scn1 + 1
282 addnn = addnn + 1
283 pn(addnn) = bpn(i)
284 inf = 1
285CC if(BPN(I)==idb1)then
286CC idb4=-1
287CC endif
288 ENDIF
289 IF(xmax>=seuil) THEN
290 nb_scn = nb_scn + 1
291 bpn(nb_scn) = bpn(i)
292C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
293 sup = 1
294CC if(BPN(I)==idb1)then
295CC idb4=-1
296CC endif
297 ENDIF
298 70 CONTINUE
299CC
300CC 3- DIVISER LES ELEMENTS
301CC
302 nb_mcn= 0
303 nb_mcn1= 0
304C 006 ADDNE= ADD(2,1)
305 addne= add(2,i_add)
306 DO i=1,nb_mc
307 nn = bpe(i)
308 xx1=x(dir, irectm(1,nn))
309 xx2=x(dir, irectm(2,nn))
310 xmax=max(xx1,xx2)+tzinf
311 xmin=min(xx1,xx2)-tzinf
312CC if(nn==idb2)then
313CC if(idb3==0)then
314CC idb4=-1
315CC endif
316CC endif
317 IF(xmin<seuil.AND.inf==1) THEN
318C WE STORE AT THE BOTTOM OF THE BP STACK
319 nb_mcn1 = nb_mcn1 + 1
320 addne = addne + 1
321 pe(addne) = bpe(i)
322CC if(nn==idb2)then
323CC if(idb3==0)then
324CC idb4=-1
325CC endif
326CC endif
327 ENDIF
328 IF(xmax>=seuil.AND.sup==1) THEN
329C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
330 nb_mcn = nb_mcn + 1
331 bpe(nb_mcn) = bpe(i)
332CC if(nn==idb2)then
333CC if(idb3==0)then
334CC idb4=-1
335CC endif
336CC endif
337 ENDIF
338 ENDDO
339C
340C 4- REMPLIR LES TABLEAUX D'ADRESSES
341C
342C 006 ADD(1,2) = ADDNN
343C 006 ADD(2,2) = ADDNE
344 add(1,i_add+1) = addnn
345 add(2,i_add+1) = addne
346C-----we fill the mins of the next box and the maxs of the current one
347C (i.e. threshold is a max for the current one)
348C We're going to go down and so we define a new box
349C we fill the maxs of the new box
350C initialises in i7buc1 a 1.E30 comme ca on recupere
351C either XMAX or the max of the box
352 xyzm(1,i_add+1) = xyzm(1,i_add)
353 xyzm(2,i_add+1) = xyzm(2,i_add)
354 xyzm(3,i_add+1) = xyzm(3,i_add)
355 xyzm(4,i_add+1) = xyzm(4,i_add)
356 xyzm(5,i_add+1) = xyzm(5,i_add)
357 xyzm(6,i_add+1) = xyzm(6,i_add)
358 xyzm(dir,i_add+1) = seuil
359 xyzm(dir+3,i_add) = seuil
360C
361 IF( ((nb_scn==nb_sc .AND. nb_mcn1==nb_mc) .OR.
362 . (nb_scn1==nb_sc .AND. nb_mcn==nb_mc)) .AND.
363 . min(nb_scn,nb_scn1)>0.AND.
364 . min(nb_mcn,nb_mcn1)>0) istop = istop + 1
365C
366 nb_sc = nb_scn
367 nb_mc = nb_mcn
368C we increment the descent level before exiting
369 i_add = i_add + 1
370 IF(i_add>=1000) THEN
371C TROP NIVEAUX PILE ON VAS LES PRENDRE PLUS GRANDES...
372 IF ( nb_n_b == maxsiz/3) THEN
373C WRITE(IOUT,*)'***COMPUTATION STOPPED WHILE INFINITELY LOOPING'
374C WRITE(ISTDO,*)'***COMPUTATION STOPPED WHILE INFINITELY LOOPING'
375C CALL ARRET(2)
376 CALL ancmsg(msgid=83,
377 . msgtype=msgerror,
378 . anmode=aninfo,
379 . i1=id,
380 . c1=titr)
381 ENDIF
382 i_mem = 1
383 RETURN
384 ENDIF
385C
386C this return is only reached in the case ok = 0
387 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
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
i7dstk
subroutine i7dstk(i_add, nb_nc, nb_ec, add, bpn, pn, bpe, pe)
Definition i7dstk.F:33
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:895