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

Go to the source code of this file.

Functions/Subroutines

subroutine i2tri (bpe, pe, bpn, pn, add, irect, x, nb_nc, nb_ec, xyzm, i_add, nsv, i_amax, xmax, ymax, zmax, maxsiz, i_mem, nb_n_b, nsn, noint, tzinf, maxbox, minbox, j_stok, irtl, st, dmin, ignore, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, nint, ixc, ixtg, thk_part, ipartc, geo, ixs, ixs10, pm, ixs16, ixs20, iparttg, id, titr, igeo, dsearch, pm_stack, iworksh, ix1, ix2, ix3, ix4, nsvg, prov_n, prov_e, n11, n12, n13, x1, x2, x3, x4, stif, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, s, t, ilev)

Function/Subroutine Documentation

◆ i2tri()

subroutine i2tri ( integer, dimension(*) bpe,
integer, dimension(*) pe,
integer, dimension(*) bpn,
integer, dimension(*) pn,
integer, dimension(2,0:*) add,
integer, dimension(4,*) irect,
x,
integer nb_nc,
integer nb_ec,
xyzm,
integer i_add,
integer, dimension(*) nsv,
integer i_amax,
xmax,
ymax,
zmax,
integer maxsiz,
integer i_mem,
integer nb_n_b,
integer nsn,
integer noint,
tzinf,
maxbox,
minbox,
integer j_stok,
integer, dimension(*) irtl,
st,
dmin,
integer ignore,
thk,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
integer nint,
integer, dimension(*) ixc,
integer, dimension(*) ixtg,
thk_part,
integer, dimension(*) ipartc,
geo,
integer, dimension(*) ixs,
integer, dimension(*) ixs10,
pm,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
integer, dimension(*) iparttg,
integer id,
character(len=nchartitle) titr,
integer, dimension(*) igeo,
dsearch,
pm_stack,
integer, dimension(*) iworksh,
integer, dimension(mvsiz), intent(inout) ix1,
integer, dimension(mvsiz), intent(inout) ix2,
integer, dimension(mvsiz), intent(inout) ix3,
integer, dimension(mvsiz), intent(inout) ix4,
integer, dimension(mvsiz), intent(inout) nsvg,
integer, dimension(mvsiz), intent(inout) prov_n,
integer, dimension(mvsiz), intent(inout) prov_e,
intent(inout) n11,
intent(inout) n12,
intent(inout) n13,
intent(inout) x1,
intent(inout) x2,
intent(inout) x3,
intent(inout) x4,
intent(inout) stif,
intent(inout) y1,
intent(inout) y2,
intent(inout) y3,
intent(inout) y4,
intent(inout) z1,
intent(inout) z2,
intent(inout) z3,
intent(inout) z4,
intent(inout) xi,
intent(inout) yi,
intent(inout) zi,
intent(inout) x0,
intent(inout) y0,
intent(inout) z0,
intent(inout) nx1,
intent(inout) ny1,
intent(inout) nz1,
intent(inout) nx2,
intent(inout) ny2,
intent(inout) nz2,
intent(inout) nx3,
intent(inout) ny3,
intent(inout) nz3,
intent(inout) nx4,
intent(inout) ny4,
intent(inout) nz4,
intent(inout) p1,
intent(inout) p2,
intent(inout) p3,
intent(inout) p4,
intent(inout) lb1,
intent(inout) lb2,
intent(inout) lb3,
intent(inout) lb4,
intent(inout) lc1,
intent(inout) lc2,
intent(inout) lc3,
intent(inout) lc4,
intent(inout) s,
intent(inout) t,
integer ilev )

Definition at line 36 of file i2tri.F.

61 USE message_mod
62 USE names_and_titles_mod , ONLY : nchartitle
63C============================================================================
64C cette routine est appelee par : I2BUC1(/inter3d1/i2buc1.F)
65C----------------------------------------------------------------------------
66C cette routine appelle : I7DSTK(/inter3d1/i7dstk.F)
67C I2DST3(/inter3d1/i2dst3.F)
68C ARRET(/sortie1/arret.F)
69C============================================================================
70C-----------------------------------------------
71C I m p l i c i t T y p e s
72C-----------------------------------------------
73#include "implicit_f.inc"
74C-----------------------------------------------
75C G l o b a l P a r a m e t e r s
76C-----------------------------------------------
77#include "mvsiz_p.inc"
78#include "param_c.inc"
79C-----------------------------------------------
80C C o m m o n B l o c k s
81C-----------------------------------------------
82#include "com04_c.inc"
83#include "vect07_c.inc"
84C-----------------------------------------------
85C D u m m y A r g u m e n t s
86C-----------------------------------------------
87 INTEGER NB_NC,NB_EC,I_ADD,MAXSIZ,J_STOK,I_MEM,ILEV
88 INTEGER I_BID, I_AMAX,NB_N_B, NOINT, NSN, IGNORE,NINT
89 INTEGER ADD(2,0:*),IRECT(4,*),BPE(*),PE(*),BPN(*),PN(*)
90 INTEGER NSV(*),IRTL(*),KNOD2ELS(*), KNOD2ELC(*),
91 . KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*), NOD2ELTG(*),
92 . IXC(*),IXTG(*),IPARTC(*),IXS(*),
93 . IXS10(*), IXS16(*), IXS20(*),IPARTTG(*),IGEO(*),
94 . IWORKSH(*)
95C REAL
96 my_real
97 . x(3,*),xyzm(6,*),st(*),dmin(*),tzinf,
98 . maxbox,minbox, xmax, ymax, zmax,thk(*),thk_part(*),geo(*),
99 . pm(*),dsearch,pm_stack(*)
100 INTEGER ID
101 CHARACTER(LEN=NCHARTITLE) :: TITR
102 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: PROV_N,PROV_E,NSVG
103 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4
104 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: n11,n12,n13
105 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x1,x2,x3,x4
106 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
107 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
108 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xi,yi,zi
109 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x0,y0,z0
110 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx1,ny1,nz1
111 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx2,ny2,nz2
112 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx3,ny3,nz3
113 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx4,ny4,nz4
114 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: p1,p2,p3,p4
115 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lb1,lb2,lb3,lb4
116 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lc1,lc2,lc3,lc4,stif
117 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: s,t
118C-----------------------------------------------
119C L o c a l V a r i a b l e s
120C-----------------------------------------------
121 INTEGER NB_NCN,NB_ECN,ADDNN,ADDNE,IPOS,I,IP,J
122 INTEGER INF,SUP,DIR,N1,N2,N3,N4,NN,NE,MEMX,IFLAG
123 my_real
124 . bid,dx,dy,dz,dsup,seuil,xmx,xmn,gapv(mvsiz)
125C-----------------------------------------------
126 DATA memx/0/
127C-----------------------------------------------
128C ROLE DE LA ROUTINE:
129C ===================
130C CLASSE LES ELETS DE BPE ET LES NOEUDS DE BPN EN TWO ZONES
131C > OU < A UNE FRONTIERE ICI DETERMINEE ET SORT LE TOUT
132C DANS bpe,hpe, et bpn,hpn
133C-----------------------------------------------
134C D u m m y A r g u m e n t s
135C
136C NOM DESCRIPTION E/S
137C
138C BPE TABLEAU DES FACETTES A TRIER E/S
139C ET DU RESULTAT COTE MAX
140C PE TABLEAU DES FACETTES S
141C RESULTAT COTE MIN
142C BPN TABLEAU DES NOEUDS A TRIER E/S
143C ET DU RESULTAT COTE MAX
144C PN TABLEAU DES NOEUDS S
145C RESULTAT COTE MIN
146C ADD(2,*) TABLEAU DES ADRESSES E/S
147C 1.......ADRESSES NOEUDS
148C 2.......ADRESSES ELEMENTS
149C ZYZM(6,*) TABLEAU DES XYZMIN E/S
150C 1.......XMIN BOITE
151C 2.......YMIN BOITE
152C 3.......ZMIN BOITE
153C 4.......XMAX BOITE
154C 5.......YMAX BOITE
155C 6.......ZMAX BOITE
156C IRECT(4,*) TABLEAU DES CONEC FACETTES E
157C X(3,*) COORDONNEES NODALES E
158C NB_NC NOMBRE DE NOEUDS CANDIDATS E/S
159C NB_EC NOMBRE D'ELTS CANDIDATS E/S
160C I_ADD POSITION DANS LE TAB DES ADRESSES E/S
161C NSV NOS SYSTEMES DES NOEUDS E
162C XMAX plus grande abcisse existante E
163C XMAX plus grande ordonn. existante E
164C XMAX plus grande cote existante E
165C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
166C NOINT NUMERO USER DE L'INTERFACE
167C TZINF TAILLE ZONE INFLUENCE
168C MAXBOX TAILLE MAX BUCKET
169C MINBOX TAILLE MIN BUCKET
170C=======================================================================
171C
172C
173C 1- TEST ARRET = BOITE VIDE
174C BOITE TROP PETITE
175C BOITE NE CONTENANT QU'ONE NOEUD
176C PLUS DE MEMOIRE DISPONIBLE
177C
178C-----------------------------------------------------------
179C
180C IF(MEMX>ADD(2,1)+NB_EC)THEN
181C WRITE(ISTDO,*)' *******MEM MAX=',MEMX
182C MEMX=-1
183C ELSEIF(MEMX/=-1)THEN
184C MEMX=ADD(2,1)+NB_EC
185C ENDIF
186C--------------------TEST SUR BOITE VIDES--------------
187C
188 IF(nb_ec==0.OR.nb_nc==0) THEN
189C write(6,*)" BOITE VIDE"
190C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
191C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
192 CALL i7dstk(i_add,nb_nc,nb_ec,add,bpn,pn,bpe,pe)
193 RETURN
194 ENDIF
195C
196C-------------------TEST SUR FIN DE BRANCHE / MEMOIRE DEPASSEE------------
197C
198 dx = xyzm(4,i_add) - xyzm(1,i_add)
199 dy = xyzm(5,i_add) - xyzm(2,i_add)
200 dz = xyzm(6,i_add) - xyzm(3,i_add)
201 dsup= max(dx,dy,dz)
202C
203 IF(add(2,1)+nb_ec>=maxsiz) THEN
204C PLUS DE PLACE DANS LA PILE DES ELEMENTS BOITES TROP PETITES
205 IF ( nb_n_b == numnod) THEN
206 CALL ancmsg(msgid=83,
207 . msgtype=msgerror,
208 . anmode=aninfo,
209 . i1=id,
210 . c1=titr)
211 ENDIF
212 i_mem = 1
213 RETURN
214 ENDIF
215 IF(dsup<minbox.OR.
216 . nb_nc<=nb_n_b.AND.dsup<maxbox.OR.
217 . nb_nc<=nb_n_b.AND.nb_ec==1) THEN
218C
219C write(6,*)" NOUVELLE BOITE "
220C 1- STOCKAGE DU OU DES NOEUD CANDIDAT ET DES ELTS CORRESP.
221C VIRER LES INUTILES
222 DO 20 i=1,nb_ec
223 ne = bpe(i)
224 n1=irect(1,ne)
225 n2=irect(2,ne)
226 n3=irect(3,ne)
227 n4=irect(4,ne)
228 DO 20 j=1,nb_nc
229 nn=nsv(bpn(j))
230 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4) THEN
231 j_stok = j_stok + 1
232 prov_n(j_stok) = bpn(j)
233 prov_e(j_stok) = ne
234 IF(j_stok==nvsiz) THEN
235 lft = 1
236 llt = nvsiz
237 nft = 0
238 j_stok = 0
239 iflag = 0
240 CALL i2cor3(x ,irect ,nsv ,prov_e ,prov_n,
241 1 bid ,bid ,gapv ,0 ,tzinf,
242 2 bid ,bid ,0 ,nint ,ixc ,
243 4 ixtg ,thk_part,ipartc,geo , noint,
244 5 ixs ,ixs10 ,pm ,thk ,knod2els,
245 6 knod2elc,knod2eltg,nod2els,nod2elc,nod2eltg,
246 7 ignore,ixs16 ,ixs20 ,iparttg,igeo,dsearch ,
247 8 pm_stack , iworksh ,ix1 ,ix2 ,
248 5 ix3 ,ix4 ,nsvg,x1 ,x2 ,
249 6 x3 ,x4 ,y1 ,y2 ,y3 ,
250 7 y4 ,z1 ,z2 ,z3 ,z4 ,
251 8 xi ,yi ,zi ,stif ,iflag )
252 IF (ilev == 27) THEN
253C-- Improved projections on triangles for spotflag27
254 CALL i2dst3_27(gapv,prov_e ,prov_n,tzinf,irtl,st,dmin,
255 . ignore,thk ,knod2els,knod2elc,knod2eltg,
256 . nod2els,nod2elc,nod2eltg,x,irect,
257 . nint,ixc ,ixtg,thk_part,ipartc,geo,
258 . noint,ixs,ixs10,pm,ix3,
259 1 ix4,x1 ,x2 ,x3 ,x4 ,
260 1 y1 ,y2 ,y3 ,y4 ,z1 ,
261 2 z2 ,z3 ,z4 ,xi ,yi ,
262 3 zi ,x0 ,y0 ,z0 ,nx1,
263 4 ny1,nz1,nx2,ny2,nz2,
264 5 nx3,ny3,nz3,nx4,ny4,
265 6 nz4,p1 ,p2 ,p3 ,p4 ,
266 7 lb1,lb2,lb3,lb4,lc1,
267 8 lc2,lc3,lc4,s ,t )
268 ELSE
269 CALL i2dst3(gapv,prov_e ,prov_n,tzinf,irtl,st,dmin,
270 . ignore,thk ,knod2els,knod2elc,knod2eltg,
271 . nod2els,nod2elc,nod2eltg,x,irect,
272 . nint,ixc ,ixtg,thk_part,ipartc,geo,
273 . noint,ixs,ixs10,pm,ix3,
274 1 ix4,x1 ,x2 ,x3 ,x4 ,
275 1 y1 ,y2 ,y3 ,y4 ,z1 ,
276 2 z2 ,z3 ,z4 ,xi ,yi ,
277 3 zi ,x0 ,y0 ,z0 ,nx1,
278 4 ny1,nz1,nx2,ny2,nz2,
279 5 nx3,ny3,nz3,nx4,ny4,
280 6 nz4,p1 ,p2 ,p3 ,p4 ,
281 7 lb1,lb2,lb3,lb4,lc1,
282 8 lc2,lc3,lc4,s ,t )
283 ENDIF
284 ENDIF
285C write(6,*)"Noeud candidat",BPN(J)
286C write(6,*)"Element candidat",NE
287 ENDIF
288 20 CONTINUE
289C IL FAUT COPIER LES BAS DES PILES DANS BAS_DE_PILE CORRESPONDANTS
290C AVANT DE REDESCENDRE DANS LA BRANCHE MITOYENNE
291 CALL i7dstk(i_add,nb_nc,nb_ec,add,bpn,pn,bpe,pe)
292 RETURN
293 ENDIF
294C
295C-----------------------------------------------------------
296C
297C
298C 2- PHASE DE TRI SUR LA MEDIANE SELON LA + GDE DIRECTION
299C
300C
301C-----------------------------------------------------------
302C
303C
304C 1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
305C
306 dir = 1
307 IF(dy==dsup) THEN
308 dir = 2
309 ELSE IF(dz==dsup) THEN
310 dir = 3
311 ENDIF
312 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))/2
313C
314C 2- DIVISER LES NOEUDS EN TWO ZONES
315C
316 nb_ncn= 0
317 addnn= add(1,1)
318 inf = 0
319 sup = 0
320 DO 70 i=1,nb_nc
321 IF(x(dir,nsv(bpn(i)))<seuil) THEN
322C ON STOCKE DANS LE BAS DE LA PILE BP
323 addnn = addnn + 1
324 pn(addnn) = bpn(i)
325 inf = 1
326 ELSE
327 nb_ncn = nb_ncn + 1
328 bpn(nb_ncn) = bpn(i)
329C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
330 sup = 1
331 ENDIF
332 70 CONTINUE
333CC
334CC 3- DIVISER LES ELEMENTS
335CC
336C
337C 2 LIGNES PROV POUR TEST
338C INF = 1
339C SUP = 1
340C
341 nb_ecn= 0
342 addne= add(2,1)
343 DO i=1,nb_ec
344 xmx = max(x(dir,irect(1,bpe(i))),x(dir,irect(2,bpe(i))),
345 . x(dir,irect(3,bpe(i))),x(dir,irect(4,bpe(i))))
346 . + tzinf
347 xmn = min(x(dir,irect(1,bpe(i))),x(dir,irect(2,bpe(i))),
348 . x(dir,irect(3,bpe(i))),x(dir,irect(4,bpe(i))))
349 . - tzinf
350 IF(xmn<seuil.AND.inf==1) THEN
351C ON STOCKE DANS LE BAS DE LA PILE BP
352 addne = addne + 1
353 pe(addne) = bpe(i)
354 ENDIF
355 IF(xmx>=seuil.AND.sup==1) THEN
356C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
357 nb_ecn = nb_ecn + 1
358 bpe(nb_ecn) = bpe(i)
359 ENDIF
360 ENDDO
361C
362C 4- REMPLIR LES TABLEAUX D'ADRESSES
363C
364 add(1,2) = addnn
365 add(2,2) = addne
366C-----on remplit les min de la boite suivante et les max de la courante
367C (i.e. seuil est un max pour la courante)
368C on va redescendre et donc on definit une nouvelle boite
369C on remplit les max de la nouvelle boite
370C initialises dans i7buc1 a 1.E30 comme ca on recupere
371C soit XMAX soit le max de la boite
372 xyzm(1,i_add+1) = xyzm(1,i_add)
373 xyzm(2,i_add+1) = xyzm(2,i_add)
374 xyzm(3,i_add+1) = xyzm(3,i_add)
375 xyzm(4,i_add+1) = xyzm(4,i_add)
376 xyzm(5,i_add+1) = xyzm(5,i_add)
377 xyzm(6,i_add+1) = xyzm(6,i_add)
378 xyzm(dir,i_add+1) = seuil
379 xyzm(dir+3,i_add) = seuil
380C
381 nb_nc = nb_ncn
382 nb_ec = nb_ecn
383C on incremente le niveau de descente avant de sortir
384 i_add = i_add + 1
385 IF(i_add>=1000) THEN
386C TROP NIVEAUX PILE ON VAS LES PRENDRE PLUS GRANDES...
387 IF ( nb_n_b == numnod) THEN
388 CALL ancmsg(msgid=83,
389 . msgtype=msgerror,
390 . anmode=aninfo,
391 . i1=id,
392 . c1=titr)
393 ENDIF
394 i_mem = 1
395 RETURN
396 ENDIF
397C
398C ce return n'est atteint que dans le cas ok = 0
399 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i2cor3
subroutine i2cor3(x, irect, nsv, cand_e, cand_n, stf, stfn, gapv, igap, gap, gap_s, gap_m, istf, nint, ixc, ixtg, thk_part, ipartc, geo, noint, ixs, ixs10, pm, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, ignore, ixs16, ixs20, iparttg, igeo, dsearch, pm_stack, iworksh, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, iflag)
Definition i2cor3.F:45
i2dst3
subroutine i2dst3(gapv, cand_e, cand_n, tzinf, irtl, st, dmin, ignore, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, x, irect, nint, ixc, ixtg, thk_part, ipartc, geo, noint, ixs, ixs10, pm, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, s, t)
Definition i2dst3.F:45
i2dst3_27
subroutine i2dst3_27(gapv, cand_e, cand_n, tzinf, irtl, st, dmin, ignore, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, x, irect, nint, ixc, ixtg, thk_part, ipartc, geo, noint, ixs, ixs10, pm, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, s, t)
Definition i2dst3_27.F:46
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
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