OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i23buce.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!|| i23buce ../engine/source/interfaces/intsort/i23buce.F
25!||--- called by ------------------------------------------------------
26!|| i23main_tri ../engine/source/interfaces/intsort/i23main_tri.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| i23trivox ../engine/source/interfaces/intsort/i23trivox.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../engine/share/message_module/message_mod.f
33!|| tri7box ../engine/share/modules/tri7box.F
34!||====================================================================
35 SUBROUTINE i23buce(
36 1 X ,IRECT ,NSV ,INACTI ,
37 2 NRTM ,NSN ,CAND_E ,CAND_N ,GAP ,
38 3 NOINT ,II_STOK ,TZINF , MAXBOX ,MINBOX ,
39 4 NCONTACT,NB_N_B ,ESHIFT ,CAND_P ,NCONT ,
40 6 ILD ,WEIGHT ,STFN ,NIN ,
41 7 STF ,IGAP ,GAP_S ,GAPMIN ,GAPMAX ,
42 8 ICURV ,NUM_IMP ,ITASK ,
43 9 I_MEM ,MSR ,GAP_M ,NSNR ,CURV_MAX,
44 A RENUM ,NSNROLD ,IFPEN ,MWAG ,BMINMA ,
45 B NMN ,IRECTG ,BGAPSMX ,INTHEAT,IDT_THERM,NODADT_THERM)
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE tri7box
50 USE message_mod
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55#include "comlock.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com01_c.inc"
60#include "units_c.inc"
61#include "warn_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER NRTM, NSN, NOINT,IDT,INACTI,NIN,NSNR,NSNROLD,NMN,ITASK
66 INTEGER IRECT(4,*), NSV(*), NUM_IMP, IRECTG(4,*)
67 INTEGER CAND_E(*),CAND_N(*),MSR(*),MWAG(*),RENUM(*),IFPEN(*)
68 INTEGER NCONTACT,ESHIFT,ILD,NB_N_B, I_MEM,IGAP,ICURV,NCONT,
69 . WEIGHT(*),II_STOK
70 INTEGER, INTENT(IN) :: INTHEAT
71 INTEGER, INTENT(IN) :: IDT_THERM
72 INTEGER, INTENT(IN) :: NODADT_THERM
73C REAL
74 my_real
75 . gap,tzinf,maxbox,minbox,
76 . gapmin, gapmax, bminma(6),curv_max(nrtm), bgapsmx,
77 . lxm, lym, lzm
78 my_real
79 . x(3,*), stfn(*), stf(*), gap_s(*), gap_m(*),
80 . cand_p(*)
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER I_ADD_MAX
85 PARAMETER (I_ADD_MAX = 1001)
86c
87 INTEGER I, J, I_ADD, IP0, IP1, MAXSIZ,
88 . add(2,i_add_max), loc_proc, n, isznsnr,
89 . nsnfiold(nspmd)
90C REAL
91 my_real
92 . xyzm(6,i_add_max-1), marge, aaa
93C-----------------------------------------------
94C PROV
95C-----------------------------------------------
96cc INTEGER INIVOXEL, VOXEL(LVOXEL),NBX,NBY,NBZ
97c INTEGER INIVOXEL, VOXEL(1),NBX,NBY,NBZ
98cc SAVE INIVOXEL, VOXEL
99cc DATA INIVOXEL /1/
100 INTEGER NBX,NBY,NBZ
101 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
102
103C-----------------------------------------------
104C S o u r c e L i n e s
105C-----------------------------------------------
106C
107C----- TRI PAR BOITES DES ELEMENTS ET DES NOEUDS
108C
109C-----------------------------------------------
110C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
111C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
112C POINTEUR NOM TAILLE
113C P0........ NSN + 3 [+ NSNROLD dans le cas SPMD]
114C P1........Elt Bas Pile NRTM
115C P2........Elt PILE 2*NRTM
116C P21.......BPN NSN
117C P22.......PN NSN
118C P31.......ADDI 2*I_ADD_MAX
119 maxsiz = 3*(nrtm+100)
120C
121 ip0 = 1
122 ip1 = ip0 + nsn + nsnrold + 3
123C
124C-----INITIALISATION DES ADRESSES ET X,Y,Z
125C
126C ADDE ADDN X Y Z
127C 1 1 XMIN YMIN ZMIN
128C 1 1 XMAX YMAX ZMAX
129C
130 add(1,1) = 0
131 add(2,1) = 0
132 add(1,2) = 0
133 add(2,2) = 0
134 i_add = 1
135C
136C----- BORNES DU DOMAINE DEJA CALCULEES
137C
138 xyzm(1,i_add) = bminma(4)
139 xyzm(2,i_add) = bminma(5)
140 xyzm(3,i_add) = bminma(6)
141 xyzm(4,i_add) = bminma(1)
142 xyzm(5,i_add) = bminma(2)
143 xyzm(6,i_add) = bminma(3)
144 i_mem = 0
145C
146 isznsnr = nsnr
147C
148C-----DEBUT DE LA PHASE DE TRI
149C
150C SEPARER B ET N EN TWO
151C
152 marge = tzinf - sqrt(three)*gap
153c CALL I23TRI(
154c 1 ADD ,NSN ,IRECT ,X ,STF ,
155c 2 STFN ,XYZM ,I_ADD ,MAXSIZ ,II_STOK ,
156c 3 CAND_N ,CAND_E ,NCONTACT ,NOINT ,TZINF ,
157c 4 MAXBOX ,MINBOX ,I_MEM ,NB_N_B ,I_ADD_MAX,
158c 5 ESHIFT ,INACTI ,NRTM ,IGAP ,GAP ,
159c 6 GAP_S ,GAPMIN ,GAPMAX ,MARGE ,CURV_MAX ,
160c 7 DEPTH ,DRAD ,MSR ,GAP_M ,
161c 8 RENUM ,NSNR ,ISZNSNR ,NSNROLD ,MWAG(IP0),
162c 9 IFPEN ,CAND_P ,NSV ,ITAGP ,IRECTG )
163
164
165 aaa = sqrt(nmn /
166 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
167 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
168 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
169
170 aaa = 0.75*aaa
171
172 nbx = nint(aaa*(bminma(1)-bminma(4)))
173 nby = nint(aaa*(bminma(2)-bminma(5)))
174 nbz = nint(aaa*(bminma(3)-bminma(6)))
175 nbx = max(nbx,1)
176 nby = max(nby,1)
177 nbz = max(nbz,1)
178
179 nbx8=nbx
180 nby8=nby
181 nbz8=nbz
182 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
183 lvoxel8 = lvoxel
184
185 IF(res8 > lvoxel8) THEN
186 aaa = lvoxel
187 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
188 aaa = aaa**(third)
189 nbx = int((nbx+2)*aaa)-2
190 nby = int((nby+2)*aaa)-2
191 nbz = int((nbz+2)*aaa)-2
192 nbx = max(nbx,1)
193 nby = max(nby,1)
194 nbz = max(nbz,1)
195 ENDIF
196
197 nbx8=nbx
198 nby8=nby
199 nbz8=nbz
200 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
201
202 IF(res8 > lvoxel8) THEN
203 nbx = min(100,max(nbx8,1))
204 nby = min(100,max(nby8,1))
205 nbz = min(100,max(nbz8,1))
206 ENDIF
207
208C initialisation complete de VOXEL
209C (en // SMP il y a possibilite de redondance de traitement mais no pb)
210 DO i=inivoxel,(nbx+2)*(nby+2)*(nbz+2)
211 voxel1(i)=0
212 ENDDO
213 inivoxel = max(inivoxel,(nbx+2)*(nby+2)*(nbz+2)+1)
214
215 CALL i23trivox(
216 1 nsn ,renum ,nsnr ,isznsnr ,i_mem ,
217 2 irect ,x ,stf ,stfn ,xyzm ,
218 3 nsv ,ii_stok ,cand_n ,eshift ,cand_e ,
219 4 ncontact,noint ,tzinf ,msr ,
220 5 voxel1 ,nbx ,nby ,nbz ,
221 6 inacti ,mwag(ip0),cand_p ,ifpen ,
222 7 nrtm ,nsnrold ,igap ,gap ,gap_s ,
223 8 gap_m ,gapmin ,gapmax ,marge ,curv_max,
224 9 nin ,itask ,bgapsmx ,intheat,idt_therm,nodadt_therm)
225 234 continue
226
227C
228C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
229C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
230C I_MEM = 3 ==> TROP NIVEAUX PILE
231 IF (i_mem ==2) RETURN
232 IF(i_mem==1)THEN
233 nb_n_b = nb_n_b + 1
234 IF ( nb_n_b > nsn) THEN
235 IF (istamping == 1)THEN
236 CALL ancmsg(msgid=101,anmode=aninfo,
237 . i1=noint,i2=noint)
238 ELSE
239 CALL ancmsg(msgid=85,anmode=aninfo,
240 . i1=noint)
241 ENDIF
242 CALL arret(2)
243 ENDIF
244 ild = 1
245 ELSEIF(i_mem==2) THEN
246 IF(debug(1)>=1) THEN
247 iwarn = iwarn+1
248#include "lockon.inc"
249 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
250 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
251 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
252 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
253 WRITE(iout,*)' MULTIPLIED BY 0.75'
254#include "lockoff.inc"
255 ENDIF
256 RETURN
257 tzinf = three_over_4*tzinf
258C taille de boite non diminuee
259C MINBOX= THREE_OVER_4*MINBOX
260C MAXBOX= THREE_OVER_4*MAXBOX
261 IF( tzinf<=gap ) THEN
262 CALL ancmsg(msgid=98,anmode=aninfo,
263 . i1=noint,c1='(I23BUCE)')
264 CALL arret(2)
265 ENDIF
266 ild = 1
267 ELSEIF(i_mem==3)THEN
268 nb_n_b = nb_n_b + 1
269 IF ( nb_n_b > ncont) THEN
270 CALL ancmsg(msgid=100,anmode=aninfo,
271 . i1=noint)
272 CALL arret(2)
273 ENDIF
274 ild = 1
275 ENDIF
276C
277 RETURN
278 END
i23buce
subroutine i23buce(x, irect, nsv, inacti, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, tzinf, maxbox, minbox, ncontact, nb_n_b, eshift, cand_p, ncont, ild, weight, stfn, nin, stf, igap, gap_s, gapmin, gapmax, icurv, num_imp, itask, i_mem, msr, gap_m, nsnr, curv_max, renum, nsnrold, ifpen, mwag, bminma, nmn, irectg, bgapsmx, intheat, idt_therm, nodadt_therm)
Definition i23buce.F:46
i23trivox
subroutine i23trivox(nsn, renum, nsnr, isznsnr, i_mem, irect, x, stf, stfn, xyzm, nsv, ii_stok, cand_n, eshift, cand_e, mulnsn, noint, tzinf, msr, voxel, nbx, nby, nbz, inacti, cand_a, cand_p, ifpen, nrtm, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, marge, curv_max, nin, itask, bgapsmx, intheat, idt_therm, nodadt_therm)
Definition i23trivox.F:44
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
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
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