OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21buce.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "units_c.inc"
#include "warn_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i21buce (x, irect, nsv, inacti, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, tzinf, maxbox, minbox, ncontact, xmin, xmax, ymin, ymax, zmin, zmax, nb_n_b, eshift, ild, init, weight, stfn, nin, stf, igap, gap_s, gapmin, gapmax, icurv, num_imp, xm0, nod_normal, depth, margeref, lxm, lym, lzm, nrtm_l, xloc, i_mem, drad, nmn, intth, mndd, msr_l, itask, irectt, iform, dgapload)

Function/Subroutine Documentation

◆ i21buce()

subroutine i21buce ( x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer inacti,
integer nrtm,
integer nsn,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
gap,
integer noint,
integer ii_stok,
tzinf,
maxbox,
minbox,
integer ncontact,
xmin,
xmax,
ymin,
ymax,
zmin,
zmax,
integer nb_n_b,
integer eshift,
integer ild,
integer init,
integer, dimension(*) weight,
stfn,
integer nin,
stf,
integer igap,
gap_s,
gapmin,
gapmax,
integer icurv,
integer num_imp,
xm0,
nod_normal,
depth,
margeref,
lxm,
lym,
lzm,
integer nrtm_l,
xloc,
integer i_mem,
intent(in) drad,
integer nmn,
integer intth,
integer, dimension(*) mndd,
integer, dimension(*) msr_l,
integer itask,
integer, dimension(4,*) irectt,
integer iform,
intent(in) dgapload )

Definition at line 36 of file i21buce.F.

49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE message_mod
53 USE intstamp_glob_mod
54 USE tri7box
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59#include "comlock.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "com01_c.inc"
64#include "units_c.inc"
65#include "warn_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER NRTM, NSN, NOINT,IDT,INACTI,NIN,NRTM_L,NMN, IFORM
70 INTEGER IRECT(4,*), NSV(*), NUM_IMP,MSR_L(*),MNDD(*)
71 INTEGER CAND_E(*),CAND_N(*)
72 INTEGER NCONTACT,ESHIFT,ILD,INIT,NB_N_B, IGAP,ICURV,
73 . WEIGHT(*),II_STOK,INTTH,ITASK,IRECTT(4,*)
74C REAL
75 my_real
76 . gap,tzinf,maxbox,minbox,
77 . xmax, ymax, zmax, xmin, ymin, zmin, gapmin, gapmax, depth,
78 . margeref, lxm, lym, lzm
79C REAL
80 my_real , INTENT(IN) :: dgapload , drad
81 my_real
82 . x(3,*), stfn(*), stf(*), gap_s(*),
83 . xm0(3,*), nod_normal(3,*), xloc(3,*)
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER I_ADD_MAX
88 parameter(i_add_max = 1001)
89C
90 INTEGER I, J, I_MEM, I_ADD, IP0, IP1, MAXSIZ,II,
91 . ADD(2,I_ADD_MAX), N,L,PP,J_STOK,IAD(NSPMD),
92 . TAG(NMN),NM(4), IERROR1,NODFI,PTR, IERROR2, IERROR3,
93 . IERROR4,LSKYFI
94C REAL
95 my_real
96 . xyzm(6,i_add_max-1)
97 my_real
98 . stf_l(nrtm)
99 my_real
100 . xxx,yyy,zzz,curv_max(nrtm),curv_max_max, marge
101C-----------------------------------------------
102C S o u r c e L i n e s
103C-----------------------------------------------
104C a revoir :
105 curv_max_max = zero
106 IF(icurv==3)THEN
107 DO i=1,nrtm
108 xxx=max(xm0(1,irect(1,i)),xm0(1,irect(2,i)),
109 . xm0(1,irect(3,i)),xm0(1,irect(4,i)))
110 . -min(xm0(1,irect(1,i)),xm0(1,irect(2,i)),
111 . xm0(1,irect(3,i)),xm0(1,irect(4,i)))
112 yyy=max(xm0(2,irect(1,i)),xm0(2,irect(2,i)),
113 . xm0(2,irect(3,i)),xm0(2,irect(4,i)))
114 . -min(xm0(2,irect(1,i)),xm0(2,irect(2,i)),
115 . xm0(2,irect(3,i)),xm0(2,irect(4,i)))
116 zzz=max(xm0(3,irect(1,i)),xm0(3,irect(2,i)),
117 . xm0(3,irect(3,i)),xm0(3,irect(4,i)))
118 . -min(xm0(3,irect(1,i)),xm0(3,irect(2,i)),
119 . xm0(3,irect(3,i)),xm0(3,irect(4,i)))
120 curv_max(i) = half * max(xxx,yyy,zzz)
121 curv_max_max = max(curv_max_max,curv_max(i))
122 ENDDO
123 ELSE
124 DO i=1,nrtm
125 curv_max(i)=zero
126 ENDDO
127 ENDIF
128C--------------------------------------------------
129 IF (init==1) THEN
130C premier appel a i21buce
131C--------------------------------------------------
132C CAS RECALCUL DU TRI PAR BUCKETS
133C--------------------------------------------------
134 IF (debug(3)>=1) THEN
135#include "lockon.inc"
136 WRITE(istdo,*)'** NEW SORT FOR INTERFACE NUMBER ',noint,
137 . ' AT CYCLE ',ncycle
138 WRITE(iout,*)'** NEW SORT FOR INTERFACE NUMBER ',noint,
139 . ' AT CYCLE ',ncycle
140#include "lockoff.inc"
141 ENDIF
142C
143C--------------------------------
144C CALCUL DES BORNES DU DOMAINE
145C--------------------------------
146 xmin=ep30
147 xmax=-ep30
148 ymin=ep30
149 ymax=-ep30
150 zmin=ep30
151 zmax=-ep30
152C
153 DO i=1,nsn
154 j=nsv(i)
155C stfn = 0 <=> shooting nodes
156 IF(stfn(i)/=zero) THEN
157 xmin= min(xmin,xloc(1,i))
158 ymin= min(ymin,xloc(2,i))
159 zmin= min(zmin,xloc(3,i))
160 xmax= max(xmax,xloc(1,i))
161 ymax= max(ymax,xloc(2,i))
162 zmax= max(zmax,xloc(3,i))
163 ENDIF
164 ENDDO
165C
166 xmin=xmin-lxm
167 ymin=ymin-lym
168 zmin=zmin-lzm
169 xmax=xmax+lxm
170 ymax=ymax+lym
171 zmax=zmax+lzm
172C
173 IF(abs(zmax-zmin)>2*ep30.OR.
174 + abs(ymax-ymin)>2*ep30.OR.
175 + abs(xmax-xmin)>2*ep30)THEN
176 IF (istamping == 1)THEN
177 CALL ancmsg(msgid=101,anmode=aninfo,
178 . i1=noint,i2=noint)
179 ELSE
180 CALL ancmsg(msgid=87,anmode=aninfo,
181 . i1=noint,c1='(I21BUCE)')
182 ENDIF
183 CALL arret(2)
184 END IF
185 xmin=xmin-tzinf
186 ymin=ymin-tzinf
187 zmin=zmin-tzinf
188 xmax=xmax+tzinf
189 ymax=ymax+tzinf
190 zmax=zmax+tzinf
191C-----------------------------------------------
192 nrtm_l=0
193 DO i=1,nrtm
194 stf_l(i)=zero
195 IF(stf(i)/=zero)THEN
196 DO j=1,4
197 xxx=xm0(1,irect(j,i))
198 yyy=xm0(2,irect(j,i))
199 zzz=xm0(3,irect(j,i))
200 IF(xmin <= xxx .AND. xxx <= xmax .AND.
201 . ymin <= yyy .AND. yyy <= ymax .AND.
202 . zmin <= zzz .AND. zzz <= zmax)THEN
203
204 nrtm_l=nrtm_l+1
205 stf_l(i)=one
206 EXIT
207
208 END IF
209 END DO
210 END IF
211 ENDDO
212C
213 nb_n_b = 1
214 ENDIF
215C Fin initialisation
216C-----------------------------------------------
217C
218C-----2- TRI PAR BOITES DES ELEMENTS ET DES NOEUDS
219C
220C-----------------------------------------------
221C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
222C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
223C POINTEUR NOM TAILLE
224C P0........ NSN + 3
225C P1........Elt Bas Pile NRTM
226C P2........Elt PILE 2*NRTM
227C P21.......BPN NSN
228C P22.......PN NSN
229C P31.......ADDI 2*I_ADD_MAX
230 maxsiz = 3*(nrtm_l+100)
231C
232 ip0 = 1
233 ip1 = ip0 + nsn + 3
234C
235C-----INITIALISATION DES ADRESSES ET X,Y,Z
236C
237C ADDE ADDN X Y Z
238C 1 1 XMIN YMIN ZMIN
239C 1 1 XMAX YMAX ZMAX
240C
241 add(1,1) = 0
242 add(2,1) = 0
243 add(1,2) = 0
244 add(2,2) = 0
245 i_add = 1
246 xyzm(1,i_add) = xmin
247 xyzm(2,i_add) = ymin
248 xyzm(3,i_add) = zmin
249 xyzm(4,i_add) = xmax
250 xyzm(5,i_add) = ymax
251 xyzm(6,i_add) = zmax
252 i_mem = 0
253C
254C-----DEBUT DE LA PHASE DE TRI
255C
256C SEPARER B ET N EN TWO
257C
258C MARGE plus importante que dans le critere de tri.
259 marge = tzinf - max(depth,gap + dgapload,drad)
260 CALL i21tri(
261 1 add ,nsn ,irect ,xloc ,stf_l ,
262 2 stfn ,xyzm ,i_add ,maxsiz ,ii_stok ,
263 3 cand_n ,cand_e ,ncontact ,noint ,tzinf ,
264 4 maxbox ,minbox ,i_mem ,nb_n_b ,i_add_max,
265 5 eshift ,inacti ,nrtm ,igap ,gap ,
266 6 gap_s ,gapmin ,gapmax ,marge ,curv_max ,
267 7 xm0 ,nod_normal,depth ,drad ,dgapload )
268
269 IF (i_mem == 2) RETURN
270C
271C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
272C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
273C I_MEM = 3 ==> TROP NIVEAUX PILE
274 IF(i_mem==1)THEN
275 nb_n_b = nb_n_b + 1
276 IF ( nb_n_b > nsn) THEN
277 IF (istamping == 1)THEN
278 CALL ancmsg(msgid=101,anmode=aninfo,
279 . i1=noint,i2=noint)
280 ELSE
281 CALL ancmsg(msgid=85,anmode=aninfo,
282 . i1=noint)
283 ENDIF
284 CALL arret(2)
285 ENDIF
286 ild = 1
287 ELSEIF(i_mem==2) THEN
288 IF(debug(1)>=1) THEN
289 iwarn = iwarn+1
290#include "lockon.inc"
291 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
292 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
293 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
294 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
295 WRITE(iout,*)' MULTIPLIED BY 0.75'
296#include "lockoff.inc"
297 ENDIF
298 tzinf = three_over_4*tzinf
299 minbox= three_over_4*minbox
300 maxbox= three_over_4*maxbox
301 IF( tzinf<=max(depth,gap+ dgapload,drad) ) THEN
302 IF (istamping == 1)THEN
303 CALL ancmsg(msgid=101,anmode=aninfo,
304 . i1=noint,i2=noint)
305 ELSE
306 CALL ancmsg(msgid=98,anmode=aninfo,
307 . i1=noint,c1='(I21BUCE)')
308 ENDIF
309 CALL arret(2)
310 ENDIF
311 ild = 1
312 ELSEIF(i_mem==3)THEN
313 nb_n_b = nb_n_b + 1
314 IF ( nb_n_b > nsn) THEN
315 IF (istamping == 1)THEN
316 CALL ancmsg(msgid=101,anmode=aninfo,
317 . i1=noint,i2=noint)
318 ELSE
319 CALL ancmsg(msgid=99,anmode=aninfo,
320 . i1=noint)
321 ENDIF
322 CALL arret(2)
323 ENDIF
324 ild = 1
325 ENDIF
326C
327 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
intstamp_glob_mod
Definition intstamp_glob_mod.F:30
message_mod
Definition message_mod.F:1249
i21tri
subroutine i21tri(bpe, pe, bpn, pn, add, irect, x, nb_nc, nb_ec, xyzm, i_add, nsv, i_amax, xmax, ymax, zmax, maxsiz, i_stok, i_mem, nb_n_b, cand_n, cand_e, nsn, noint, tzinf, maxbox, minbox, j_stok, msr, xm0, multimp, itab, gap, gap_s, igap, gapmin, gapmax, marge, depth, drad, id, titr, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, stif, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, pene, prov_n, prov_e, n11, n21, n31, dgapload)
Definition i21tri.F:58
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