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 cette routine est appelee par : I11BUC1(/inter3d1/i11buc1.F)
46C----------------------------------------------------------------------------
47C cette routine appelle : I11STO(/inter3d1/i11sto.F)
48C I7DSTK(/inter3d1/i7dstk.F)
49C ARRET(/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_BID, 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,dbuc,
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,IPOS,
79 . I,IP,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,xmx,xmn,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 DE LA ROUTINE:
94C ===================
95C CLASSE LES ELETS DE BPE ET LES NOEUDS DE BPN EN TWO ZONES
96C > OU < A UNE FRONTIERE ICI DETERMINEE ET SORT LE TOUT
97C DANS bpe,hpe, et 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 TABLEAU DES FACETTES A TRIER E/S
104C ET DU RESULTAT COTE MAX
105C PE TABLEAU DES FACETTES S
106C RESULTAT COTE MIN
107C BPN TABLEAU DES NOEUDS A TRIER E/S
108C ET DU RESULTAT COTE MAX
109C PN TABLEAU DES NOEUDS S
110C RESULTAT COTE MIN
111C ADD(2,*) TABLEAU DES ADRESSES E/S
112C 1.......ADRESSES NOEUDS
113C 2.......ADRESSES ELEMENTS
114C ZYZM(6,*) TABLEAU DES XYZMIN E/S
115C 1.......XMIN BOITE
116C 2.......YMIN BOITE
117C 3.......ZMIN BOITE
118C 4.......XMAX BOITE
119C 5.......YMAX BOITE
120C 6.......ZMAX BOITE
121C IRECT(4,*) TABLEAU DES CONEC FACETTES E
122C X(3,*) COORDONNEES NODALES E
123C NB_SC NOMBRE DE NOEUDS CANDIDATS E/S
124C NB_MC NOMBRE D'ELTS CANDIDATS E/S
125C I_ADD POSITION DANS LE TAB DES ADRESSES E/S
126C XMAX plus grande abcisse existante E
127C XMAX plus grande ordonn. existante E
128C XMAX plus grande cote existante E
129C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
130C I_STOK niveau de stockage des couples
131C candidats impact E/S
132C CAND_S boites resultats noeuds
133C CAND_M adresses des boites resultat elements
134C NSN 4*NSN TAILLE MAX ADMISE MAINTENANT POUR LES
135C COUPLES NOEUDS,ELT CANDIDATS
136C NOINT NUMERO USER DE L'INTERFACE
137C TZINF TAILLE ZONE INFLUENCE
138C MAXBOX TAILLE MAX BUCKET
139C MINBOX TAILLE MIN BUCKET
140C=======================================================================
141C
142C
143C 1- TEST ARRET = BOITE VIDE
144C BOITE TROP PETITE
145C BOITE NE CONTENANT QU'ONE NOEUD
146C PLUS DE MEMOIRE DISPONIBLE
147C
148C-----------------------------------------------------------
149C
150C IF(MEMX>ADD(2,1)+NB_MC)THEN
151C WRITE(ISTDO,*)' *******MEM MAX=',MEMX
152C MEMX=-1
153C ELSEIF(MEMX/=-1)THEN
154C MEMX=ADD(2,1)+NB_MC
155C ENDIF
156C--------------------TEST SUR BOITE VIDES--------------
157C
158 IF(nb_mc==0.OR.nb_sc==0) THEN
159C write(6,*)" BOITE VIDE"
160C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
161C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
162C 006 CALL I7DSTK(I_ADD,NB_SC,NB_MC,ADD,BPN,PN,BPE,PE)
163 CALL i7dstk(i_add,nb_sc,nb_mc,add(1,i_add-1),bpn,pn,bpe,pe)
164 RETURN
165 ENDIF
166C
167C-------------------TEST SUR FIN DE BRANCHE / MEMOIRE DEPASSEE------------
168C
169 dx = xyzm(4,i_add) - xyzm(1,i_add)
170 dy = xyzm(5,i_add) - xyzm(2,i_add)
171 dz = xyzm(6,i_add) - xyzm(3,i_add)
172 dsup= max(dx,dy,dz)
173C
174C 006 IF(ADD(1,I_ADD)+NB_SC>=MAXSIZ.OR.ADD(2,1)+NB_MC>=MAXSIZ) THEN
175 IF(add(1,i_add)+nb_sc>=maxsiz.OR.
176 . add(2,i_add)+nb_mc>=maxsiz) THEN
177C PLUS DE PLACE DANS LA PILE DES ELEMENTS BOITES TROP PETITES
178 IF ( nb_n_b == maxsiz/3) THEN
179C WRITE(IOUT,*)'***ERROR INFINITE LOOP DETECTED '
180C WRITE(ISTDO,*)'***ERROR INFINITE LOOP DETECTED '
181C CALL ARRET(2)
182 CALL ancmsg(msgid=685,
183 . msgtype=msgerror,
184 . anmode=aninfo,
185 . i1=id,
186 . c1=titr)
187 ENDIF
188 i_mem = 1
189 RETURN
190 ENDIF
191 ncand_prov=nb_mc*nb_sc
192 IF(dsup<minbox.OR.istop==1.OR.
193 . (nb_sc<=nb_n_b.AND.dsup<maxbox).OR.
194 . (nb_sc<=nb_n_b.AND.nb_mc==1).OR.
195 . (nb_mc<=nb_n_b.AND.dsup<maxbox).OR.
196 . (nb_mc<=nb_n_b.AND.nb_sc==1)) THEN
197 istop = 0
198C
199C write(6,*)" NOUVELLE BOITE "
200C 1- STOCKAGE DU OU DES NOEUD CANDIDAT ET DES ELTS CORRESP.
201C VIRER LES INUTILES
202 DO k=1,ncand_prov,nvsiz
203 DO l=k,min(k-1+nvsiz,ncand_prov)
204 i = 1+(l-1)/nb_sc
205 j = l-(i-1)*nb_sc
206 ne = bpe(i)
207 nn = bpn(j)
208CCctmp
209CC if(idb1==nn.and.idb2==ne)then
210CC idb3=-1
211CC endif
212 n1=irectm(1,ne)
213 n2=irectm(2,ne)
214 nn1=irects(1,nn)
215 nn2=irects(2,nn)
216 IF(nn1/=n1.AND.nn1/=n2.AND.
217 . nn2/=n1.AND.nn2/=n2) THEN
218 j_stok = j_stok + 1
219 prov_s(j_stok) = nn
220 prov_m(j_stok) = ne
221 ENDIF
222 ENDDO
223 IF(j_stok>=nvsiz)THEN
224 CALL i11sto(
225 1 nvsiz,irects,irectm,x ,ii_stok,
226 2 cand_s,cand_m,nsn ,noint ,tzinf ,
227 3 i_mem ,prov_s,prov_m,multimp,addcm,
228 4 chaine,iadfin)
229 IF(i_mem==2)RETURN
230 j_stok = j_stok-nvsiz
231 DO j=1,j_stok
232 prov_s(j) = prov_s(j+nvsiz)
233 prov_m(j) = prov_m(j+nvsiz)
234 ENDDO
235 ENDIF
236 ENDDO
237C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
238C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
239C 006 CALL I7DSTK(I_ADD,NB_SC,NB_MC,ADD,BPN,PN,BPE,PE)
240 CALL i7dstk(i_add,nb_sc,nb_mc,add(1,i_add-1),bpn,
241 . pn,bpe,pe)
242 RETURN
243 ENDIF
244C
245C-----------------------------------------------------------
246C
247C
248C 2- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
249C
250C
251C-----------------------------------------------------------
252C
253C
254C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
255C
256 dir = 1
257 IF(dy==dsup) THEN
258 dir = 2
259 ELSE IF(dz==dsup) THEN
260 dir = 3
261 ENDIF
262 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))/2
263C
264C 2- DIVISER LES SECONDS EN TWO ZONES
265C
266CC idb3=-1
267 nb_scn= 0
268 nb_scn1= 0
269C 006 ADDNN= ADD(1,1)
270 addnn= add(1,i_add)
271 inf = 0
272 sup = 0
273 DO 70 i=1,nb_sc
274 nn = bpn(i)
275CC if(nn==idb1)then
276CC idb3=0
277CC endif
278 xx1=x(dir, irects(1,nn))
279 xx2=x(dir, irects(2,nn))
280 xmax=max(xx1,xx2)+tzinf
281 xmin=min(xx1,xx2)-tzinf
282 IF(xmin<seuil) THEN
283C ON STOCKE DANS LE BAS DE LA PILE BP
284 nb_scn1 = nb_scn1 + 1
285 addnn = addnn + 1
286 pn(addnn) = bpn(i)
287 inf = 1
288CC if(BPN(I)==idb1)then
289CC idb4=-1
290CC endif
291 ENDIF
292 IF(xmax>=seuil) THEN
293 nb_scn = nb_scn + 1
294 bpn(nb_scn) = bpn(i)
295C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
296 sup = 1
297CC if(BPN(I)==idb1)then
298CC idb4=-1
299CC endif
300 ENDIF
301 70 CONTINUE
302CC
303CC 3- DIVISER LES ELEMENTS
304CC
305 nb_mcn= 0
306 nb_mcn1= 0
307C 006 ADDNE= ADD(2,1)
308 addne= add(2,i_add)
309 DO i=1,nb_mc
310 nn = bpe(i)
311 xx1=x(dir, irectm(1,nn))
312 xx2=x(dir, irectm(2,nn))
313 xmax=max(xx1,xx2)+tzinf
314 xmin=min(xx1,xx2)-tzinf
315CC if(nn==idb2)then
316CC if(idb3==0)then
317CC idb4=-1
318CC endif
319CC endif
320 IF(xmin<seuil.AND.inf==1) THEN
321C ON STOCKE DANS LE BAS DE LA PILE BP
322 nb_mcn1 = nb_mcn1 + 1
323 addne = addne + 1
324 pe(addne) = bpe(i)
325CC if(nn==idb2)then
326CC if(idb3==0)then
327CC idb4=-1
328CC endif
329CC endif
330 ENDIF
331 IF(xmax>=seuil.AND.sup==1) THEN
332C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
333 nb_mcn = nb_mcn + 1
334 bpe(nb_mcn) = bpe(i)
335CC if(nn==idb2)then
336CC if(idb3==0)then
337CC idb4=-1
338CC endif
339CC endif
340 ENDIF
341 ENDDO
342C
343C 4- REMPLIR LES TABLEAUX D'ADRESSES
344C
345C 006 ADD(1,2) = ADDNN
346C 006 ADD(2,2) = ADDNE
347 add(1,i_add+1) = addnn
348 add(2,i_add+1) = addne
349C-----on remplit les min de la boite suivante et les max de la courante
350C (i.e. seuil est un max pour la courante)
351C on va redescendre et donc on definit une nouvelle boite
352C on remplit les max de la nouvelle boite
353C initialises dans i7buc1 a 1.E30 comme ca on recupere
354C soit XMAX soit le max de la boite
355 xyzm(1,i_add+1) = xyzm(1,i_add)
356 xyzm(2,i_add+1) = xyzm(2,i_add)
357 xyzm(3,i_add+1) = xyzm(3,i_add)
358 xyzm(4,i_add+1) = xyzm(4,i_add)
359 xyzm(5,i_add+1) = xyzm(5,i_add)
360 xyzm(6,i_add+1) = xyzm(6,i_add)
361 xyzm(dir,i_add+1) = seuil
362 xyzm(dir+3,i_add) = seuil
363C
364 IF( ((nb_scn==nb_sc .AND. nb_mcn1==nb_mc) .OR.
365 . (nb_scn1==nb_sc .AND. nb_mcn==nb_mc)) .AND.
366 . min(nb_scn,nb_scn1)>0.AND.
367 . min(nb_mcn,nb_mcn1)>0) istop = istop + 1
368C
369 nb_sc = nb_scn
370 nb_mc = nb_mcn
371C on incremente le niveau de descente avant de sortir
372 i_add = i_add + 1
373 IF(i_add>=1000) THEN
374C TROP NIVEAUX PILE ON VAS LES PRENDRE PLUS GRANDES...
375 IF ( nb_n_b == maxsiz/3) THEN
376C WRITE(IOUT,*)'***COMPUTATION STOPPED WHILE INFINITELY LOOPING'
377C WRITE(ISTDO,*)'***COMPUTATION STOPPED WHILE INFINITELY LOOPING'
378C CALL ARRET(2)
379 CALL ancmsg(msgid=83,
380 . msgtype=msgerror,
381 . anmode=aninfo,
382 . i1=id,
383 . c1=titr)
384 ENDIF
385 i_mem = 1
386 RETURN
387 ENDIF
388C
389C ce return n'est atteint que dans le cas ok = 0
390 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: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
i7dstk
subroutine i7dstk(i_add, nb_nc, nb_ec, add, bpn, pn, bpe, pe)
Definition i7dstk.F:34
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