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

Go to the source code of this file.

Functions/Subroutines

subroutine i2buc1 (x, irect, nsv, nseg, irtl, nmn, nrtm, mwa, nsn, xyzm, noint, msr, st, dmin, tzinf05, ignore, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, nint, ixc, ixtg, thk_part, ipartc, geo, ixs, ixs10, pm, ixs16, ixs20, iparttg, id, titr, igeo, 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

◆ i2buc1()

subroutine i2buc1 ( x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) nseg,
integer, dimension(*) irtl,
integer nmn,
integer nrtm,
integer, dimension(*) mwa,
integer nsn,
xyzm,
integer noint,
integer, dimension(*) msr,
st,
dmin,
tzinf05,
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(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
thk_part,
integer, dimension(*) ipartc,
geo,
integer, dimension(nixs,*) ixs,
integer, dimension(*) ixs10,
pm,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
integer, dimension(*) iparttg,
integer id,
character(len=nchartitle) titr,
integer, dimension(*) igeo,
type(stack_ply), intent(inout) 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(in) n11,
intent(in) n12,
intent(in) 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(in) x0,
intent(in) y0,
intent(in) z0,
intent(in) nx1,
intent(in) ny1,
intent(in) nz1,
intent(in) nx2,
intent(in) ny2,
intent(in) nz2,
intent(in) nx3,
intent(in) ny3,
intent(in) nz3,
intent(in) nx4,
intent(in) ny4,
intent(in) nz4,
intent(in) p1,
intent(in) p2,
intent(in) p3,
intent(in) p4,
intent(in) lb1,
intent(in) lb2,
intent(in) lb3,
intent(in) lb4,
intent(in) lc1,
intent(in) lc2,
intent(in) lc3,
intent(in) lc4,
intent(in) s,
intent(in) t,
integer ilev )
Parameters
[in,out]stackstack data structure

Definition at line 38 of file i2buc1.F.

60 USE message_mod
61 USE names_and_titles_mod , ONLY : nchartitle
62 use element_mod , only :nixs,nixc,nixtg
63 use stack_mod , only : stack_ply
64 use i2trivox_mod , only : i2trivox
65 use file_descriptor_mod , only : iout
66C============================================================================
67C this routine is called by: inint3(/inter3d1/inint3.f)
68C----------------------------------------------------------------------------
69C cette routine appelle : I2TRI(/inter3d1/i2tri.F)
70! I2DST3(/inter3d1/i2dst3.F)
71! ARRET(/sortie1/arret.F)
72C============================================================================
73C-----------------------------------------------
74C I m p l i c i t T y p e s
75C-----------------------------------------------
76#include "implicit_f.inc"
77C-----------------------------------------------
78C G l o b a l P a r a m e t e r s
79C-----------------------------------------------
80#include "mvsiz_p.inc"
81C-----------------------------------------------
82C C o m m o n B l o c k s
83C-----------------------------------------------
84#include "com04_c.inc"
85#include "param_c.inc"
86#include "scr08_c.inc"
87#include "vect07_c.inc"
88C-----------------------------------------------
89C D u m m y A r g u m e n t s
90C-----------------------------------------------
91 INTEGER NMN, NRTM, NSN, NOINT, IGNORE, NINT,ILEV
92 INTEGER IRECT(4,*),NSV(*),NSEG(*),MWA(*)
93 INTEGER MSR(*),IRTL(*),MAXSIZ,KNOD2ELS(*), KNOD2ELC(*),
94 . KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*), NOD2ELTG(*),
95 . IXC(NIXC,*),IXTG(NIXTG,*),IPARTC(*),
96 . IXS(NIXS,*),IXS10(*), IXS16(*), IXS20(*),IPARTTG(*),IGEO(*),
97 . IWORKSH(*)
98! REAL
99 my_real
100 . x(3,*),xyzm(6,*),st(*),dmin(*),tzinf05,thk(*),thk_part(*),
101 . geo(npropg,*),pm(*)
102 INTEGER ID
103 CHARACTER(LEN=NCHARTITLE) :: TITR
104 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: PROV_N,PROV_E,NSVG
105 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4
106 my_real, DIMENSION(MVSIZ), INTENT(IN) :: n11,n12,n13
107 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x1,x2,x3,x4
108 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
109 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
110 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xi,yi,zi
111 my_real, DIMENSION(MVSIZ), INTENT(IN) :: x0,y0,z0
112 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx1,ny1,nz1
113 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx2,ny2,nz2
114 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx3,ny3,nz3
115 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx4,ny4,nz4
116 my_real, DIMENSION(MVSIZ), INTENT(IN) :: p1,p2,p3,p4
117 my_real, DIMENSION(MVSIZ), INTENT(IN) :: lb1,lb2,lb3,lb4
118 my_real, DIMENSION(MVSIZ), INTENT(IN) :: lc1,lc2,lc3,lc4
119 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: stif
120 my_real, DIMENSION(MVSIZ), INTENT(IN) :: s,t
121 type(stack_ply), intent(inout) :: stack !< stack data structure
122C-----------------------------------------------
123C L o c a l V a r i a b l e s
124C-----------------------------------------------
125 INTEGER I, J, L, N1, N2, N3, N4, I_AMAX,I_MEM
126 INTEGER I_ADD, ADESTK, NB_NC, NB_EC, ADNSTK,IEL,N
127 INTEGER IP1, IP2, IP21, IP22, IP31,J_STOK,I_BID,NB_N_B,IS,IAD,
128 . MG,IP,NELS,NELC,NELTG,JJ,JJJ,IFLAG
129! REAL
130 my_real
131 . dx1,dy1,dz1,dx3,dy3,dz3,dx4,dy4,dz4,dx6,dy6,dz6,
132 . dd1,dd2,dd3,dd4,dd,xmin,ymin,zmin,maxbox,minbox,xmax,ymax,zmax,
133 . bid,tzinfmin,thksecnd,thkmain,area,vol,gapv(mvsiz),dsearch
134 my_real :: local_thkmain
135 integer, dimension(3) :: cell_nb
136 my_real, dimension(3) :: distance
137 my_real, dimension(6) :: bound
138 my_real :: cell_size,margin,gapmin,gapmax
139 my_real, dimension(:,:), allocatable :: segment_data
140C
141C=======================================================================
142! 1-CALCULATION TAILLE DES ZONES INFLUENCES
143c
144 allocate(segment_data(nrtm,2))
145 segment_data(1:nrtm,1:2) = zero
146 dd = zero
147 dsearch = tzinf05
148 iflag = 1
149 IF (ignore >= 2) THEN
150 thksecnd = zero
151 thkmain = zero
152 !dd is the maximum diagonal length
153 DO l=1,nrtm
154 ! CONNECTIVITES ELEMENT
155 n1=irect(1,l)
156 n2=irect(2,l)
157 n3=irect(3,l)
158 n4=irect(4,l)
159 ! LONGUEUR DIAG 1
160 dx1=(x(1,n1)-x(1,n3))
161 dy1=(x(2,n1)-x(2,n3))
162 dz1=(x(3,n1)-x(3,n3))
163 segment_data(l,1) = max(segment_data(l,1),sqrt(dx1**2+dy1**2+dz1**2))
164 dd=max(dd,sqrt(dx1**2+dy1**2+dz1**2))
165 ! LONGUEUR DIAG 2
166 dx3=(x(1,n2)-x(1,n4))
167 dy3=(x(2,n2)-x(2,n4))
168 dz3=(x(3,n2)-x(3,n4))
169 segment_data(l,1) = max(segment_data(l,1),sqrt(dx3**2+dy3**2+dz3**2))
170 dd=max(dd,sqrt(dx1**2+dy1**2+dz1**2))
171 ENDDO
172 DO i=1,nsn
173 is = nsv(i)
174C- 4n coats
175 DO iad = knod2elc(is)+1,knod2elc(is+1)
176 iel = nod2elc(iad)
177 mg=ixc(6,iel)
178 ip = ipartc(iel)
179 IF ( thk_part(ip) /= zero) THEN
180 thksecnd = max(thksecnd,thk_part(ip))
181 ELSEIF ( thk(iel) /= zero) THEN
182 thksecnd = max(thksecnd,thk(iel))
183 ELSE
184 thksecnd = max(thksecnd,geo(1,mg))
185 ENDIF
186 ENDDO
187C- 3N coats
188 DO iad = knod2eltg(is)+1,knod2eltg(is+1)
189 iel = nod2eltg(iad)
190 mg=ixtg(5,iel)
191 ip = iparttg(iel)
192 IF ( thk_part(ip) /= zero) THEN
193 thksecnd = max(thksecnd,thk_part(ip))
194 ELSEIF ( thk(iel) /= zero) THEN
195 thksecnd = max(thksecnd,thk(iel))
196 ELSE
197 thksecnd = max(thksecnd,geo(1,mg))
198 ENDIF
199 ENDDO
200 ENDDO
201 DO i=1,nrtm
202 nels = 0
203 nelc = 0
204 neltg = 0
205 CALL insol3(x,irect,ixs,nint,nels,i,
206 . area,noint,knod2els ,nod2els ,0 ,ixs10,
207 . ixs16,ixs20)
208 CALL incoq3(irect,ixc ,ixtg ,nint ,nelc ,
209 . neltg,i,geo ,pm ,knod2elc ,
210 . knod2eltg ,nod2elc ,nod2eltg,thk,2,igeo ,
211 . stack%pm , iworksh)
212 local_thkmain = zero
213 IF (nelc /= 0) THEN
214 mg=ixc(6,nelc)
215 ip = ipartc(nelc)
216 IF ( thk_part(ip) /= zero) THEN
217 local_thkmain = max(local_thkmain,thk_part(ip))
218 ELSEIF ( thk(nelc) /= zero) THEN
219 local_thkmain = max(local_thkmain,thk(nelc))
220 ELSE
221 local_thkmain = max(local_thkmain,geo(1,mg))
222 ENDIF
223 ELSEIF (neltg /= 0)THEN
224 mg=ixtg(5,neltg)
225 ip = iparttg(neltg)
226 IF ( thk_part(ip) /= zero) THEN
227 local_thkmain = max(local_thkmain,thk_part(ip))
228 ELSEIF ( thk(numelc+neltg) /= zero) THEN
229 local_thkmain = max(local_thkmain,thk(numelc+neltg))
230 ELSE
231 local_thkmain = max(local_thkmain,geo(1,mg))
232 ENDIF
233 ELSEIF(nels/=0 .AND. nels <= numels8 .AND. ignore == 2) THEN
234 DO jj=1,8
235 jjj=ixs(jj+1,nels)
236 xc(jj)=x(1,jjj)
237 yc(jj)=x(2,jjj)
238 zc(jj)=x(3,jjj)
239 END DO
240 CALL volint(vol)
241C
242 local_thkmain = max(local_thkmain,vol/area)
243 ENDIF
244 thkmain = max(thkmain,local_thkmain)
245 segment_data(i,2) = local_thkmain + thksecnd
246 ENDDO
247 if(dsearch==zero) then
248 do i=1,nrtm
249 segment_data(i,2) = max(zep05*segment_data(i,1),zep6*segment_data(i,2))
250 enddo
251 endif
252! TAILLE BUCKET MIN = TZINF05
253 IF(tzinf05==zero)
254 . tzinf05 = max(zep05*dd,0.6*(thkmain+thksecnd))
255 maxbox= two*tzinf05
256 minbox= half*maxbox
257 tzinfmin = tzinf05
258 ELSE
259 ! dd is the average length of the element
260 DO l=1,nrtm
261 ! CONNECTIVITES ELEMENT
262 n1=irect(1,l)
263 n2=irect(2,l)
264 n3=irect(3,l)
265 n4=irect(4,l)
266 ! LONGUEUR COTE 1
267 dx1=(x(1,n1)-x(1,n2))
268 dy1=(x(2,n1)-x(2,n2))
269 dz1=(x(3,n1)-x(3,n2))
270 dd1=(dx1**2+dy1**2+dz1**2)
271 ! LONGUEUR COTE 2
272 dx3=(x(1,n1)-x(1,n4))
273 dy3=(x(2,n1)-x(2,n4))
274 dz3=(x(3,n1)-x(3,n4))
275 dd2=(dx3**2+dy3**2+dz3**2)
276 ! LONGUEUR COTE 3
277 dx4=(x(1,n3)-x(1,n2))
278 dy4=(x(2,n3)-x(2,n2))
279 dz4=(x(3,n3)-x(3,n2))
280 dd3=(dx4**2+dy4**2+dz4**2)
281 ! LONGUEUR COTE 4
282 dx6=(x(1,n4)-x(1,n3))
283 dy6=(x(2,n4)-x(2,n3))
284 dz6=(x(3,n4)-x(3,n3))
285 dd4=(dx6**2+dy6**2+dz6**2)
286 segment_data(l,1) = (dd1+dd2+dd3+dd4) / four
287 dd=dd+ (dd1+dd2+dd3+dd4)
288 ENDDO
289 ! TAILLE BUCKET MIN = TZINF05
290 dd = sqrt(dd/nrtm/four)
291 IF(tzinf05==zero)tzinf05 = dd
292 maxbox= two*tzinf05
293 minbox= half*maxbox
294 tzinfmin = tzinf05*em01
295 ENDIF
296
297
298 ! -------------------
299 ! the gap is :
300 ! * equal to tzinf05 if ignore = 1 (computed here)
301 ! * equal to max(0.5*element_length,0.6*(thk_main+thk_second)) if ignore = 2 && dsearch = 0
302 ! * equal to tzinf05 if ignore = 2 || ignore = 3 && dsearch /= 0 (computed here)
303 ! * equalt to max(tzinf05,element_lenth) if ignore < 1 || ignore > 3
304 do l=1,nrtm
305 if(ignore==1) then
306 segment_data(l,2) = tzinf05
307 elseif(ignore==2.or.ignore==3) then
308 if(dsearch/=zero) segment_data(l,2) = tzinf05
309 else
310 segment_data(l,2) = max(tzinf05,segment_data(l,1))
311 endif
312 enddo
313 ! -------------------
314C--------------------------------
315! calculation of the domain bounds
316C--------------------------------
317 xmin=ep30
318 xmax=-ep30
319 ymin=ep30
320 ymax=-ep30
321 zmin=ep30
322 zmax=-ep30
323C
324 DO i=1,nmn
325 j=msr(i)
326 xmin= min(xmin,x(1,j))
327 ymin= min(ymin,x(2,j))
328 zmin= min(zmin,x(3,j))
329 xmax= max(xmax,x(1,j))
330 ymax= max(ymax,x(2,j))
331 zmax= max(zmax,x(3,j))
332 ENDDO
333 ! save the main domain bounds (without the secondary part of the interface)
334 margin = zero
335 do i=1,nrtm
336 margin = max(margin,segment_data(i,2))
337 enddo
338 margin = max(margin,tzinf05)
339 bound(1)=xmin - margin
340 bound(2)=ymin - margin
341 bound(3)=zmin - margin
342 bound(4)=xmax + margin
343 bound(5)=ymax + margin
344 bound(6)=zmax + margin
345
346
347 distance(1:3) = bound(4:6) - bound(1:3)
348
349 cell_size = four * dd
350 cell_nb(1:3) = int(distance(1:3)/cell_size)
351 cell_nb(1:3) = max(cell_nb(1:3),1)
352 gapmin = huge(gapmin)
353 gapmax = -huge(gapmax)
354 call i2trivox(nvsiz,numnod,numels,numels10,
355 . numels16,numels20,numelc,numeltg,
356 . nint,noint,
357 . ixs,ixs10,ixs16,ixs20,ixc,ixtg,
358 . iworksh,nsn,nrtm,
359 . ilev,npropgi,npropg,numgeo,npropm,nummat,npart,ignore,cell_nb,nsv,irtl,ipartc,iparttg,
360 . knod2els,knod2elc,knod2eltg,nod2els,nod2elc,nod2eltg,irect,
361 . igeo,dsearch,bound,tzinf05,segment_data,
362 . dmin,thk,thk_part,x,geo,st,pm,stack,gapmin,gapmax)
363
364 deallocate(segment_data)
365
366 if((ignore<=1).or.((ignore==2.or.ignore==3).and.dsearch/=zero)) then
367 write(iout,2001) tzinf05
368 elseif(ignore>=2) then
369 write(iout,2002) gapmin,gapmax
370 else
371 endif
372
373 2001 format(//,1x,'SEARCH DISTANCE . . . . . . . . . . . . . .',1pg20.13/)
374 2002 format(//,1x,'SEARCH DISTANCE . . . . . . . . . . . . . .BETWEEN',1pg20.13,' AND ',1pg20.13/)
375 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
incoq3
subroutine incoq3(irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, knod2elc, knod2eltg, nod2elc, nod2eltg, thk, nty, igeo, pm_stack, iworksh)
Definition incoq3.F:46
insol3
subroutine insol3(x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20)
Definition insol3.F:44
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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
stack_mod
Definition stack_mod.F:75
stack_mod::stack_ply
Definition stack_mod.F:85
volint
subroutine volint(vol)
Definition volint.F:38