OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2buc1.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!|| i2buc1 ../starter/source/interfaces/inter3d1/i2buc1.F
25!||--- called by ------------------------------------------------------
26!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
27!||--- calls -----------------------------------------------------
28!|| i2trivox ../starter/source/interfaces/inter3d1/i2trivox.F90
29!|| incoq3 ../starter/source/interfaces/inter3d1/incoq3.F
30!|| insol3 ../starter/source/interfaces/inter3d1/insol3.F
31!|| volint ../starter/source/interfaces/inter3d1/volint.F
32!||--- uses -----------------------------------------------------
33!|| file_descriptor_mod ../starter/source/modules/file_descriptor_mod.F90
34!|| i2trivox_mod ../starter/source/interfaces/inter3d1/i2trivox.F90
35!|| message_mod ../starter/share/message_module/message_mod.F
36!|| stack_mod ../starter/share/modules1/stack_mod.F
37!||====================================================================
38 SUBROUTINE i2buc1(
39 1 X ,IRECT,NSV ,NSEG ,IRTL,
40 2 NMN ,NRTM ,MWA ,NSN ,XYZM ,
41 3 NOINT ,MSR ,ST ,DMIN ,TZINF05,
42 4 IGNORE,THK ,KNOD2ELS,KNOD2ELC,KNOD2ELTG,
43 5 NOD2ELS,NOD2ELC,NOD2ELTG,
44 6 NINT ,IXC ,IXTG ,THK_PART,IPARTC ,
45 7 GEO ,IXS ,IXS10 ,PM ,IXS16 ,
46 8 IXS20 ,IPARTTG ,ID ,TITR ,IGEO ,
47 9 stack , IWORKSH,
48 1 IX1 ,IX2 ,IX3,IX4 ,NSVG ,
49 2 PROV_N ,PROV_E ,N11,N12 ,N13 ,
50 3 X1 ,X2 ,X3 ,X4 ,STIF ,
51 4 Y1 ,Y2 ,Y3 ,Y4 ,Z1 ,
52 5 Z2 ,Z3 ,Z4 ,XI ,YI ,
53 6 ZI ,X0 ,Y0 ,Z0 ,NX1 ,
54 7 NY1 ,NZ1 ,NX2,NY2 ,NZ2 ,
55 8 NX3 ,NY3 ,NZ3,NX4 ,NY4 ,
56 9 NZ4 ,P1 ,P2 ,P3 ,P4 ,
57 1 LB1 ,LB2 ,LB3,LB4 ,LC1 ,
58 2 LC2 ,LC3 ,LC4,S ,T ,
59 2 ILEV)
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
376 END
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
i2buc1
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)
Definition i2buc1.F:60
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