OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21buce.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i21buce ../engine/source/interfaces/intsort/i21buce.F
25!||--- called by ------------------------------------------------------
26!|| i21main_tri ../engine/source/interfaces/intsort/i21main_tri.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| i21tri ../engine/source/interfaces/intsort/i21tri.F
31!||--- uses -----------------------------------------------------
32!|| intstamp_glob_mod ../engine/share/modules/intstamp_glob_mod.F
33!|| message_mod ../engine/share/message_module/message_mod.F
34!|| tri7box ../engine/share/modules/tri7box.F
35!||====================================================================
36 SUBROUTINE i21buce(
37 1 X ,IRECT ,NSV ,INACTI ,
38 2 NRTM ,NSN ,CAND_E ,CAND_N ,GAP ,
39 3 NOINT ,II_STOK ,TZINF , MAXBOX ,MINBOX ,
40 4 NCONTACT ,XMIN ,XMAX ,YMIN ,
41 5 YMAX ,ZMIN ,ZMAX ,NB_N_B ,ESHIFT ,
42 6 ILD ,INIT ,WEIGHT ,STFN ,NIN ,
43 7 STF ,IGAP ,GAP_S ,GAPMIN ,GAPMAX ,
44 8 ICURV ,NUM_IMP ,XM0 ,NOD_NORMAL,
45 9 DEPTH ,MARGEREF,LXM ,LYM ,LZM ,
46 A NRTM_L ,XLOC ,I_MEM ,DRAD ,NMN ,
47 B INTTH ,MNDD ,MSR_L ,ITASK ,IRECTT ,
48 C IFORM ,DGAPLOAD)
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
328 END
i21buce
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)
Definition i21buce.F:49
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