OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7buce.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!|| i7buce ../engine/source/interfaces/intsort/i7buce.F
25!||--- called by ------------------------------------------------------
26!|| i7main_tri ../engine/source/interfaces/intsort/i7main_tri.F
27!|| inter_sort_07 ../engine/source/interfaces/int07/inter_sort_07.F
28!||--- calls -----------------------------------------------------
29!|| i7tri ../engine/source/interfaces/intsort/i7tri.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../engine/share/message_module/message_mod.F
32!|| tri7box ../engine/share/modules/tri7box.F
33!||====================================================================
34 SUBROUTINE i7buce(
35 1 X ,IRECT ,NSV ,INACTI ,CAND_P ,
36 2 NMN ,NRTM ,NSN ,CAND_E ,CAND_N ,
37 3 GAP ,NOINT ,II_STOK ,NCONTACT ,BMINMA ,
38 4 TZINF ,MAXBOX ,MINBOX ,CAND_A ,CURV_MAX,
39 5 NB_N_B ,ESHIFT ,ILD ,IFQ ,IFPEN ,
40 8 STFN ,NIN ,STF ,IGAP ,GAP_S ,
41 A NSNR ,NCONT ,RENUM ,NSNROLD ,GAP_M ,
42 B GAPMIN ,GAPMAX ,CURV_MAX_MAX ,NUM_IMP ,GAP_S_L ,
43 C GAP_M_L ,INTTH ,ITASK ,BGAPSMX ,I_MEM ,
44 D KREMNOD ,REMNOD ,ITAB ,FLAGREMNODE ,DRAD ,
45 E ITIED ,CAND_F ,DGAPLOAD ,INTHEAT ,IDT_THERM,
46 F NODADT_THERM)
47C============================================================================
48C M o d u l e s
49C-----------------------------------------------
50 USE tri7box
51 USE message_mod
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56#include "comlock.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com01_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER NMN, NRTM, NSN, NOINT, INACTI, IFQ, NIN, NSNR, NSNROLD
65 INTEGER IRECT(4,*),NSV(*),CAND_A(*), RENUM(*),NUM_IMP, ITASK
66 INTEGER CAND_E(*),CAND_N(*),IFPEN(*),KREMNOD(*),REMNOD(*),ITAB(*)
67 INTEGER NCONTACT,ESHIFT,ILD,NB_N_B, IGAP, NCONT,INTTH,I_MEM,
68 * II_STOK, FLAGREMNODE, ITIED
69 INTEGER, INTENT(IN) :: INTHEAT
70 INTEGER, INTENT(IN) :: IDT_THERM
71 INTEGER, INTENT(IN) :: NODADT_THERM
72C REAL
73 my_real
74 . GAP,TZINF,MAXBOX,MINBOX,CURV_MAX_MAX,
75 . GAPMIN, GAPMAX, BMINMA(12),CURV_MAX(NRTM),BGAPSMX
76 my_real , INTENT(IN) :: drad,dgapload
77 my_real
78 . x(3,*), cand_p(*), stfn(*),
79 . stf(*), gap_s(*), gap_m(*),
80 . gap_s_l(*), gap_m_l(*), cand_f(*)
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER I_ADD_MAX,I_ADD
85 parameter(i_add_max = 1001)
86 INTEGER ADD(2,I_ADD_MAX)
87 INTEGER ISZNSNR
88C REAL
89 my_real
90 . xyzm(6,i_add_max-1), marge
91C-----------------------------------------------
92C PROV
93C-----------------------------------------------
94cc INTEGER INIVOXEL, VOXEL(LVOXEL),NBX,NBY,NBZ
95c INTEGER INIVOXEL, VOXEL(1),NBX,NBY,NBZ
96cc SAVE INIVOXEL, VOXEL
97cc DATA INIVOXEL /1/
98
99
100 INTEGER MAXSIZ
101
102
103 maxsiz = 10 * (nrtm+100)
104
105 add(1,1) = 0
106 add(1,2) = 0
107 add(2,1) = 0
108 add(2,2) = 0
109
110
111C-----------------------------------------------
112C S o u r c e L i n e s
113C-----------------------------------------------
114C
115C----- sorting of elements and nodes by boxes
116C
117C-----------------------------------------------
118C if there is not enough memory for the stacks, the sorting is restarted
119C by increasing nb_n_b (number of nodes per finished box)
120C POINTEUR NOM TAILLE
121C p0........ nsn + 3 [+ nsnrold in the case of spmd]
122C P1........Elt Bas Pile NRTM
123C P2........Elt PILE 2*NRTM
124
125C
126C
127C-----INITIALISATION
128
129C----- BORNES DU DOMAINE DEJA CALCULEES
130C
131 i_add = 1
132 xyzm(1,i_add) = bminma(4)
133 xyzm(2,i_add) = bminma(5)
134 xyzm(3,i_add) = bminma(6)
135 xyzm(4,i_add) = bminma(1)
136 xyzm(5,i_add) = bminma(2)
137 xyzm(6,i_add) = bminma(3)
138C sorting box
139 i_mem = 0
140C
141 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.
142 . ifq>0.OR.num_imp>0.OR.itied/=0) THEN
143 isznsnr = nsnr
144 ELSE
145 isznsnr = 0
146 END IF
147
148 marge = tzinf - (gap+dgapload)
149 CALL i7tri(
150 1 add ,nsn ,renum ,nsnr ,isznsnr ,
151 2 irect ,x ,stf ,stfn ,xyzm ,
152 3 i_add ,nsv ,maxsiz ,ii_stok ,cand_n ,
153 4 cand_e,ncontact,noint ,tzinf ,maxbox ,
154 5 minbox,i_mem ,nb_n_b ,i_add_max,eshift ,
155 6 inacti,ifq ,cand_a, cand_p ,ifpen ,
156 7 nrtm ,nsnrold,igap ,gap ,gap_s ,
157 8 gap_m ,gapmin ,gapmax ,marge ,curv_max ,
158 9 nin ,gap_s_l,gap_m_l,intth, drad ,itied ,
159 a cand_f ,kremnod ,remnod ,flagremnode,dgapload,
160 b intheat, idt_therm, nodadt_therm)
161
162
163
164c WRITE(6,*) "IMEM=",I_MEM
165C
166C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
167C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATES
168C I_MEM = 3 ==> TROP NIVEAUX PILE
169 IF (i_mem /= 0) RETURN
170
171C
172 RETURN
173 END
174
175!||====================================================================
176!|| i7buce_vox ../engine/source/interfaces/intsort/i7buce.F
177!||--- called by ------------------------------------------------------
178!|| i7main_tri ../engine/source/interfaces/intsort/i7main_tri.F
179!|| inter_sort_07 ../engine/source/interfaces/int07/inter_sort_07.F
180!||--- calls -----------------------------------------------------
181!|| ancmsg ../engine/source/output/message/message.F
182!|| arret ../engine/source/system/arret.F
183!|| i7trivox ../engine/source/interfaces/intsort/i7trivox.F
184!||--- uses -----------------------------------------------------
185!|| message_mod ../engine/share/message_module/message_mod.F
186!|| tri7box ../engine/share/modules/tri7box.F
187!||====================================================================
188 SUBROUTINE i7buce_vox(
189 1 X ,IRECT ,NSV ,INACTI ,CAND_P ,
190 2 NMN ,NRTM ,NSN ,CAND_E ,CAND_N ,
191 3 GAP ,NOINT ,II_STOK ,NCONTACT ,BMINMA ,
192 4 TZINF ,MAXBOX ,MINBOX ,CAND_A ,CURV_MAX,
193 5 NB_N_B ,ESHIFT ,ILD ,IFQ ,IFPEN ,
194 8 STFN ,NIN ,STF ,IGAP ,GAP_S ,
195 A NSNR ,NCONT ,RENUM ,NSNROLD ,GAP_M ,
196 B GAPMIN ,GAPMAX ,CURV_MAX_MAX,NUM_IMP,GAP_S_L ,
197 C GAP_M_L ,INTTH ,ITASK ,BGAPSMX ,I_MEM ,
198 D KREMNOD ,REMNOD ,ITAB ,FLAGREMNODE, DRAD ,
199 E ITIED ,CAND_F ,DGAPLOAD,REMOTE_S_NODE,LIST_REMOTE_S_NODE,
200 F TOTAL_NB_NRTM,INTHEAT,IDT_THERM,NODADT_THERM)
201C============================================================================
202C M o d u l e s
203C-----------------------------------------------
204 USE tri7box
205 USE message_mod
206C-----------------------------------------------
207C I m p l i c i t T y p e s
208C-----------------------------------------------
209#include "implicit_f.inc"
210#include "comlock.inc"
211C-----------------------------------------------
212C C o m m o n B l o c k s
213C-----------------------------------------------
214#include "units_c.inc"
215#include "warn_c.inc"
216#include "com01_c.inc"
217C-----------------------------------------------
218C D u m m y A r g u m e n t s
219C-----------------------------------------------
220 INTEGER NMN, NSN, NOINT, INACTI, IFQ, NIN, NSNR, NSNROLD
221 INTEGER, INTENT(in) :: NRTM !< number of segments per threads
222 INTEGER, INTENT(in) :: TOTAL_NB_NRTM !< total number of segments
223 INTEGER IRECT(4,*),NSV(*),CAND_A(*), RENUM(*),NUM_IMP, ITASK
224 INTEGER CAND_E(*),CAND_N(*),IFPEN(*),KREMNOD(*),REMNOD(*),ITAB(*)
225 INTEGER NCONTACT,ESHIFT,ILD,NB_N_B, IGAP, NCONT,INTTH,I_MEM,
226 * II_STOK, FLAGREMNODE, ITIED
227 INTEGER, INTENT(inout) :: REMOTE_S_NODE
228 INTEGER, INTENT(in) :: INTHEAT
229 INTEGER, INTENT(in) :: IDT_THERM
230 INTEGER, INTENT(in) :: NODADT_THERM
231 INTEGER, DIMENSION(NSNR), INTENT(inout) :: LIST_REMOTE_S_NODE
232C REAL
233 my_real
234 . GAP,TZINF,MAXBOX,MINBOX,CURV_MAX_MAX,
235 . GAPMIN, GAPMAX, BMINMA(12),CURV_MAX(NRTM),BGAPSMX
236 my_real , INTENT(IN) :: DRAD,DGAPLOAD
237 my_real
238 . X(3,*), CAND_P(*), STFN(*),
239 . STF(*), GAP_S(*), GAP_M(*),
240 . GAP_S_L(*), GAP_M_L(*), CAND_F(*)
241C-----------------------------------------------
242C L o c a l V a r i a b l e s
243C-----------------------------------------------
244 INTEGER I,
245 . isznsnr
246C REAL
247 my_real
248 . xyzm(6,2), marge, aaa
249C-----------------------------------------------
250C PROV
251C-----------------------------------------------
252cc INTEGER INIVOXEL, VOXEL(LVOXEL),NBX,NBY,NBZ
253c INTEGER INIVOXEL, VOXEL(1),NBX,NBY,NBZ
254cc SAVE INIVOXEL, VOXEL
255cc DATA INIVOXEL /1/
256 INTEGER NBX,NBY,NBZ
257 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
258
259C-----------------------------------------------
260C S o u r c e L i n e s
261C-----------------------------------------------
262C
263C----- sorting of elements and nodes by boxes
264C
265C-----------------------------------------------
266C if there is not enough memory for the stacks, the sorting is restarted
267C by increasing nb_n_b (number of nodes per finished box)
268C POINTEUR NOM TAILLE
269C p0........ nsn + 3 [+ nsnrold in the case of spmd]
270C P1........Elt Bas Pile NRTM
271C P2........Elt PILE 2*NRTM
272
273C
274C
275C-----INITIALISATION
276
277C----- BORNES DU DOMAINE DEJA CALCULEES
278C
279 xyzm(1,1) = bminma(4)
280 xyzm(2,1) = bminma(5)
281 xyzm(3,1) = bminma(6)
282 xyzm(4,1) = bminma(1)
283 xyzm(5,1) = bminma(2)
284 xyzm(6,1) = bminma(3)
285C sorting box
286 xyzm(1,2) = bminma(10)
287 xyzm(2,2) = bminma(11)
288 xyzm(3,2) = bminma(12)
289 xyzm(4,2) = bminma(7)
290 xyzm(5,2) = bminma(8)
291 xyzm(6,2) = bminma(9)
292 i_mem = 0
293C
294 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.
295 . ifq>0.OR.num_imp>0.OR.itied/=0) THEN
296 isznsnr = nsnr
297 ELSE
298 isznsnr = 0
299 END IF
300C
301C start of the sorting phase
302C
303 marge = tzinf-max(gap+dgapload,drad) ! it is indeed the margin
304
305c AAA = SQRT(NMN /
306c . ((BMINMA(1)-BMINMA(4))*(BMINMA(2)-BMINMA(5))
307c . +(BMINMA(2)-BMINMA(5))*(BMINMA(3)-BMINMA(6))
308c . +(BMINMA(3)-BMINMA(6))*(BMINMA(1)-BMINMA(4))))
309c
310c AAA = 0.75*AAA
311c
312c NBX = NINT(AAA*(BMINMA(1)-BMINMA(4)))
313c NBY = NINT(AAA*(BMINMA(2)-BMINMA(5)))
314c NBZ = NINT(AAA*(BMINMA(3)-BMINMA(6)))
315C
316C Work on the reduce box
317
318 IF( nmn /= 0 ) THEN
319 aaa = sqrt(nmn /
320 . ((bminma(7)-bminma(10))*(bminma(8)-bminma(11))
321 . +(bminma(8)-bminma(11))*(bminma(9)-bminma(12))
322 . +(bminma(9)-bminma(12))*(bminma(7)-bminma(10))))
323 ELSE
324 aaa = 0
325 ENDIF
326
327 aaa = 0.75*aaa
328
329 nbx = nint(aaa*(bminma(7)-bminma(10)))
330 nby = nint(aaa*(bminma(8)-bminma(11)))
331 nbz = nint(aaa*(bminma(9)-bminma(12)))
332C
333 nbx = max(nbx,1)
334 nby = max(nby,1)
335 nbz = max(nbz,1)
336
337 nbx8=nbx
338 nby8=nby
339 nbz8=nbz
340 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
341 lvoxel8 = lvoxel
342
343 IF(res8 > lvoxel8) THEN
344 aaa = lvoxel
345 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
346 aaa = aaa**(third)
347 nbx = int((nbx+2)*aaa)-2
348 nby = int((nby+2)*aaa)-2
349 nbz = int((nbz+2)*aaa)-2
350 nbx = max(nbx,1)
351 nby = max(nby,1)
352 nbz = max(nbz,1)
353 ENDIF
354
355 nbx8=nbx
356 nby8=nby
357 nbz8=nbz
358 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
359
360 IF(res8 > lvoxel8) THEN
361 nbx = min(100,max(nbx8,1))
362 nby = min(100,max(nby8,1))
363 nbz = min(100,max(nbz8,1))
364 ENDIF
365
366C complete initialization of VOXEL
367C (in // SMP there is possibility of processing redundancy but no pb)
368 DO i=inivoxel,(nbx+2)*(nby+2)*(nbz+2)
369 voxel1(i)=0
370 ENDDO
371 inivoxel = max(inivoxel,(nbx+2)*(nby+2)*(nbz+2)+1)
372 CALL i7trivox(
373 1 nsn ,renum ,nsnr ,isznsnr ,i_mem ,
374 2 irect ,x ,stf ,stfn ,xyzm ,
375 3 nsv ,ii_stok ,cand_n ,eshift ,cand_e ,
376 4 ncontact,noint ,tzinf ,gap_s_l ,gap_m_l ,
377 5 voxel1 ,nbx ,nby ,nbz ,intth ,
378 6 inacti ,ifq ,cand_a,cand_p ,ifpen ,
379 7 nrtm ,nsnrold ,igap ,gap ,gap_s ,
380 8 gap_m ,gapmin ,gapmax ,marge ,curv_max,
381 9 nin ,itask ,bgapsmx ,kremnod ,remnod ,
382 a itab ,flagremnode,drad ,itied ,cand_f ,
383 b dgapload,remote_s_node,list_remote_s_node,
384 c total_nb_nrtm,intheat,idt_therm,nodadt_therm)
385
386
387C
388C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
389C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATES
390C I_MEM = 3 ==> TROP NIVEAUX PILE
391 IF (i_mem ==2) RETURN
392 IF(i_mem==1)THEN
393 nb_n_b = nb_n_b + 1
394 IF ( nb_n_b > ncont) THEN
395 CALL ancmsg(msgid=85,anmode=aninfo,
396 . i1=noint)
397 CALL arret(2)
398 ENDIF
399 ild = 1
400 ELSEIF(i_mem==2) THEN
401 IF(debug(1)>=1) THEN
402 iwarn = iwarn+1
403#include "lockon.inc"
404 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
405 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
406 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
407 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
408 WRITE(iout,*)' MULTIPLIED BY 0.75'
409#include "lockoff.inc"
410 ENDIF
411 RETURN
412 tzinf = three_over_4*tzinf
413C unconassed gearbox size
414C MINBOX= THREE_OVER_4*MINBOX
415C MAXBOX= THREE_OVER_4*MAXBOX
416 IF( tzinf<=max(gap+dgapload,drad) ) THEN
417 CALL ancmsg(msgid=98,anmode=aninfo,
418 . i1=noint,c1='(I7BUCE)')
419 CALL arret(2)
420 ENDIF
421 ild = 1
422 ELSEIF(i_mem==3)THEN
423 nb_n_b = nb_n_b + 1
424 IF ( nb_n_b > ncont) THEN
425 CALL ancmsg(msgid=100,anmode=aninfo,
426 . i1=noint)
427 CALL arret(2)
428 ENDIF
429 ild = 1
430 ENDIF
431C
432 RETURN
433 END
i7buce
subroutine i7buce(x, irect, nsv, inacti, cand_p, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, ncontact, bminma, tzinf, maxbox, minbox, cand_a, curv_max, nb_n_b, eshift, ild, ifq, ifpen, stfn, nin, stf, igap, gap_s, nsnr, ncont, renum, nsnrold, gap_m, gapmin, gapmax, curv_max_max, num_imp, gap_s_l, gap_m_l, intth, itask, bgapsmx, i_mem, kremnod, remnod, itab, flagremnode, drad, itied, cand_f, dgapload, intheat, idt_therm, nodadt_therm)
Definition i7buce.F:47
i7buce_vox
subroutine i7buce_vox(x, irect, nsv, inacti, cand_p, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, ncontact, bminma, tzinf, maxbox, minbox, cand_a, curv_max, nb_n_b, eshift, ild, ifq, ifpen, stfn, nin, stf, igap, gap_s, nsnr, ncont, renum, nsnrold, gap_m, gapmin, gapmax, curv_max_max, num_imp, gap_s_l, gap_m_l, intth, itask, bgapsmx, i_mem, kremnod, remnod, itab, flagremnode, drad, itied, cand_f, dgapload, remote_s_node, list_remote_s_node, total_nb_nrtm, intheat, idt_therm, nodadt_therm)
Definition i7buce.F:201
i7trivox
subroutine i7trivox(nsn, renum, nsnr, isznsnr, i_mem, irect, x, stf, stfn, xyzm, nsv, ii_stok, cand_n, eshift, cand_e, mulnsn, noint, tzinf, gap_s_l, gap_m_l, voxel, nbx, nby, nbz, intth, inacti, ifq, cand_a, cand_p, ifpen, nrtm, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, marge, curv_max, nin, itask, bgapsmx, kremnod, remnod, itab, flagremnode, drad, itied, cand_f, dgapload, remote_s_node, list_remote_s_node, total_nb_nrtm, intheat, idt_therm, nodadt_therm)
Definition i7trivox.F:50
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
tri7box::voxel1
integer, dimension(lvoxel) voxel1
Definition tri7box.F:53
tri7box::inivoxel
integer inivoxel
Definition tri7box.F:53
tri7box::lvoxel
integer lvoxel
Definition tri7box.F:51
i7tri
subroutine i7tri(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, stf, stfn, j_stok, multimp, istf, itab, gap, gap_s, gap_m, igap, gapmin, gapmax, marge, gap_s_l, gap_m_l, id, titr, ix1, ix2, ix3, ix4, nsvg, prov_n, prov_e, n11, n12, n13, pene, 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, stif)
Definition i7tri.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:895
arret
subroutine arret(nn)
Definition arret.F:86