OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20buce.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!|| i20buce ../engine/source/interfaces/intsort/i20buce.F
25!||--- called by ------------------------------------------------------
26!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| i20tri ../engine/source/interfaces/intsort/i20tri.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../engine/share/message_module/message_mod.F
33!||====================================================================
34 SUBROUTINE i20buce(
35 1 XA ,IRECT ,NSV ,INACTI ,CAND_P ,
36 2 NMN ,NRTM ,NSN ,CAND_E ,CAND_N ,
37 3 GAP ,NOINT ,II_STOK ,TZINF ,MAXBOX ,
38 4 MINBOX ,MWAG ,CURV_MAX,NCONTACT,BMINMA ,
39 5 NB_N_B ,ESHIFT ,ILD ,IFQ ,IFPEN ,
40 6 STFA ,NIN ,STF ,IGAP ,GAP_S ,
41 7 NSNR ,NCONT ,RENUM ,NSNROLD ,GAP_M ,
42 8 GAPMIN ,GAPMAX ,NUM_IMP ,NLN ,NLG ,
43 9 GAP_SH ,NBINFLG ,MBINFLG ,ISYM ,I_MEM ,
44 . INTHEAT ,IDT_THERM, NODADT_THERM)
45C============================================================================
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE message_mod
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54#include "comlock.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "units_c.inc"
59#include "warn_c.inc"
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,IDT,INACTI,IFQ, NIN, NSNR, NSNROLD
65 INTEGER IRECT(4,*),NSV(*),MWAG(*), RENUM(*),NUM_IMP,NLN,ISYM
66 INTEGER CAND_E(*),CAND_N(*),IFPEN(*),NLG(*)
67 INTEGER NCONTACT,ESHIFT,ILD,NB_N_B, IGAP, NCONT,
68 . NBINFLG(*), MBINFLG(*),I_MEM,II_STOK
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,
75 . gapmin, gapmax,
76 . bminma(6)
77 my_real
78 . xa(3,*), cand_p(*), stfa(*),
79 . stf(*), gap_s(*), gap_m(*), gap_sh(*)
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER I_ADD_MAX
84 PARAMETER (I_ADD_MAX = 1001)
85c
86 INTEGER I, J, I_ADD, IP0, IP1, MAXSIZ,
87 . add(2,i_add_max), loc_proc, n, isznsnr,
88 . nsnfiold(nspmd)
89C REAL
90 my_real
91 . xyzm(6,i_add_max-1), marge
92 my_real
93 . xxx,yyy,zzz,curv_max(nrtm)
94C-----------------------------------------------
95C S o u r c e L i n e s
96C-----------------------------------------------
97C
98C-----2- TRI PAR BOITES DES ELEMENTS ET DES NOEUDS
99C
100C-----------------------------------------------
101C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
102C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
103C POINTEUR NOM TAILLE
104C P0........ NSN + 3 [+ NSNROLD dans le cas SPMD]
105C P1........Elt Bas Pile NRTM
106C P2........Elt PILE 2*NRTM
107C P21.......BPN NSN
108C P22.......PN NSN
109C P31.......ADDI 2*I_ADD_MAX
110 maxsiz = 3*(nrtm+100)
111C
112 ip0 = 1
113 ip1 = ip0 + nsn + nsnrold + 3
114
115C
116C-----INITIALISATION DES ADRESSES ET X,Y,Z
117C
118C ADDE ADDN X Y Z
119C 1 1 XMIN YMIN ZMIN
120C 1 1 XMAX YMAX ZMAX
121C
122 add(1,1) = 0
123 add(2,1) = 0
124 add(1,2) = 0
125 add(2,2) = 0
126 i_add = 1
127 xyzm(1,i_add) = bminma(4)
128 xyzm(2,i_add) = bminma(5)
129 xyzm(3,i_add) = bminma(6)
130 xyzm(4,i_add) = bminma(1)
131 xyzm(5,i_add) = bminma(2)
132 xyzm(6,i_add) = bminma(3)
133 i_mem = 0
134C
135
136 IF((inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0 .OR.num_imp>0))THEN
137 isznsnr = nsnr
138 ELSE
139 isznsnr = 0
140 END IF
141C
142C-----DEBUT DE LA PHASE DE TRI
143C
144C SEPARER B ET N EN TWO
145C
146 marge = tzinf-gap ! il s agit bien de la marge
147 CALL i20tri(
148 1 add ,nsn ,renum ,nsnr ,isznsnr ,
149 2 irect ,xa ,stf ,stfa ,xyzm ,
150 3 i_add ,nsv ,maxsiz ,ii_stok ,cand_n ,
151 4 cand_e ,ncontact,noint ,tzinf ,maxbox ,
152 5 minbox ,i_mem ,nb_n_b ,i_add_max,eshift ,
153 6 inacti ,ifq ,mwag(ip0),cand_p ,ifpen ,
154 7 nrtm ,nsnrold ,igap ,gap ,gap_s ,
155 6 gap_m ,gapmin ,gapmax ,marge ,curv_max,
156 7 nin ,gap_sh ,nbinflg ,mbinflg ,isym ,
157 8 intheat, idt_therm, nodadt_therm)
158C
159C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
160C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
161C I_MEM = 3 ==> TROP NIVEAUX PILE
162 IF (i_mem == 2) RETURN
163 IF(i_mem==1)THEN
164 nb_n_b = nb_n_b + 1
165 IF ( nb_n_b > ncont) THEN
166 CALL ancmsg(msgid=85,anmode=aninfo,
167 . i1=noint)
168 CALL arret(2)
169 ENDIF
170 ild = 1
171 ELSEIF(i_mem==2) THEN
172 IF(debug(1)>=1) THEN
173 iwarn = iwarn+1
174#include "lockon.inc"
175 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
176 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
177 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
178 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
179 WRITE(iout,*)' MULTIPLIED BY 0.75'
180#include "lockoff.inc"
181 ENDIF
182 tzinf = three_over_4*tzinf
183C ne pas dimunuer la taille des boite
184C MINBOX= THREE_OVER_4*MINBOX
185C MAXBOX= THREE_OVER_4*MAXBOX
186 IF( tzinf<=gap ) THEN
187 CALL ancmsg(msgid=98,anmode=aninfo,
188 . i1=noint,c1='(I20BUCE)')
189 CALL arret(2)
190 ENDIF
191 ild = 1
192 ELSEIF(i_mem==3)THEN
193 nb_n_b = nb_n_b + 1
194
195 IF ( nb_n_b > ncont) THEN
196 CALL ancmsg(msgid=99,anmode=aninfo,
197 . i1=noint,c1='(I20BUCE)')
198 CALL arret(2)
199 ENDIF
200 ild = 1
201 ENDIF
202C
203 RETURN
204 END
205!||====================================================================
206!|| i20buc_edge ../engine/source/interfaces/intsort/i20buce.F
207!||--- called by ------------------------------------------------------
208!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
209!||--- calls -----------------------------------------------------
210!|| ancmsg ../engine/source/output/message/message.F
211!|| arret ../engine/source/system/arret.F
212!|| i20tri_edge ../engine/source/interfaces/intsort/i20tri.F
213!||--- uses -----------------------------------------------------
214!|| message_mod ../engine/share/message_module/message_mod.F
215!||====================================================================
216 SUBROUTINE i20buc_edge(
217 1 XA ,IXLINS ,IXLINM ,NLG ,
218 2 NLINSA ,NMNE ,NLINMA ,CAND_M ,CAND_S ,
219 3 GAP ,NOINT ,II_STOKE,BMINMA ,TZINF ,
220 4 MAXBOX ,MINBOX ,NB_N_B , ESHIFT ,ILD ,
221 6 NCONTACT,ADDCM ,CHAINE ,NIN ,ITAB ,
222 7 NLINSR ,NCONT ,GAP_S ,STIFS , PENIS ,
223 8 IGAP ,STIFM ,IAUTO , I_MEM)
224C============================================================================
225C-----------------------------------------------
226C M o d u l e s
227C-----------------------------------------------
228 USE message_mod
229C-----------------------------------------------
230C I m p l i c i t T y p e s
231C-----------------------------------------------
232#include "implicit_f.inc"
233#include "comlock.inc"
234C-----------------------------------------------
235C C o m m o n B l o c k s
236C-----------------------------------------------
237#include "units_c.inc"
238#include "warn_c.inc"
239C-----------------------------------------------
240C D u m m y A r g u m e n t s
241C-----------------------------------------------
242 INTEGER NMNE, NLINMA, NSNE, NOINT,IDT,NLINSA,NIN, NLINSR, INACTI,
243 . IGAP,IAUTO
244 INTEGER IXLINS(2,*),IXLINM(2,*),ADDCM(*),CHAINE(2,*)
245 INTEGER CAND_M(*),CAND_S(*),NLG(*)
246 INTEGER ESHIFT,ILD, NB_N_B, NCONTACT, NCONT,
247 . ITAB(*), I_MEM,II_STOKE
248C REAL
249 my_real
250 . GAP,TZINF,MAXBOX,MINBOX,
251 . BMINMA(6)
252 my_real
253 . XA(3,*),GAP_S(*),STIFS(*),PENIS(2,*),STIFM(*)
254C-----------------------------------------------
255C L o c a l V a r i a b l e s
256C-----------------------------------------------
257 INTEGER I_ADD_MAX
258 PARAMETER (I_ADD_MAX = 1001)
259C
260 INTEGER I, J, N1, N2, I_ADD, MAXSIZ,
261 . add(2,i_add_max), n
262C REAL
263 my_real
264 . xyzm(6,i_add_max-1)
265 INTEGER NB_OLD(2,I_ADD_MAX+1)
266C-----------------------------------------------
267C S o u r c e L i n e s
268C=======================================================================
269C
270C-----2- TRI PAR BOITES
271C
272C-----------------------------------------------
273C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
274C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
275C
276C POINTEUR NOM TAILLE
277C P1........Elt Bas Pile NLINM
278C P2........Elt PILE 3*NLINM
279C P21.......Elt Bas Pile NLINS
280C P22.......Elt PILE 3*NLINS
281 maxsiz = 3*(max(nlinma,nlinsa+nlinsr)+100)
282
283C-----INITIALISATION DES ADRESSES ET X,Y,Z
284C
285C ADDE ADDN X Y Z
286C 1 1 XMIN YMIN ZMIN
287C 1 1 XMAX YMAX ZMAX
288C
289 add(1,1) = 0
290 add(2,1) = 0
291 add(1,2) = 0
292 add(2,2) = 0
293 i_add = 1
294 xyzm(1,i_add) = bminma(4)
295 xyzm(2,i_add) = bminma(5)
296 xyzm(3,i_add) = bminma(6)
297 xyzm(4,i_add) = bminma(1)
298 xyzm(5,i_add) = bminma(2)
299 xyzm(6,i_add) = bminma(3)
300 i_mem = 0
301
302 DO i=1,nlinma
303 addcm(i)=0
304 ENDDO
305C
306C
307C-----DEBUT DE LA PHASE DE TRI
308C
309C SEPARER B ET N EN TWO
310 CALL i20tri_edge(
311 1 add ,xa ,nlg ,
312 2 ixlins ,ixlinm ,nlinma ,nlinsr ,
313 3 xyzm ,i_add ,maxsiz ,ii_stoke ,cand_s ,
314 4 cand_m ,ncontact,noint ,tzinf ,maxbox ,
315 5 minbox ,i_mem ,nb_n_b ,i_add_max,eshift ,
316 6 addcm ,chaine ,nlinsa ,itab ,nb_old ,
317 7 stifs ,stifm ,iauto ,nin )
318C
319C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
320C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
321C I_MEM = 3 ==> TROP NIVEAUX PILE
322 IF (i_mem == 1 .OR. i_mem==2)RETURN
323 IF(i_mem==1)THEN
324 nb_n_b = nb_n_b + 1
325 IF ( nb_n_b > max(nlinma,nlinsa)) THEN
326 CALL ancmsg(msgid=85,anmode=aninfo,
327 . i1=noint)
328 CALL arret(2)
329 ENDIF
330 ild = 1
331 ELSEIF(i_mem==2) THEN
332 IF(debug(1)>=1) THEN
333 iwarn = iwarn+1
334#include "lockon.inc"
335 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
336 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
337 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
338 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
339 WRITE(iout,*)' MULTIPLIED BY 0.75'
340#include "lockoff.inc"
341 ENDIF
342
343 tzinf = three_over_4*tzinf
344C ne pas dimunuer la taille des boite
345C MINBOX= THREE_OVER_4*MINBOX
346C MAXBOX= THREE_OVER_4*MAXBOX
347 IF( tzinf<=gap ) THEN
348 CALL ancmsg(msgid=98,anmode=aninfo,
349 . i1=noint,c1='(I20BUCE)')
350 CALL arret(2)
351 ENDIF
352 ild = 1
353 ELSEIF(i_mem==3)THEN
354 nb_n_b = nb_n_b + 1
355 IF ( nb_n_b > max(nlinma,nlinsa)) THEN
356 CALL ancmsg(msgid=99,anmode=aninfo,
357 . i1=noint,c1='(I20BUCE)')
358 CALL arret(2)
359 ENDIF
360 ild = 1
361 ENDIF
362C
363 RETURN
364 END
i20buc_edge
subroutine i20buc_edge(xa, ixlins, ixlinm, nlg, nlinsa, nmne, nlinma, cand_m, cand_s, gap, noint, ii_stoke, bminma, tzinf, maxbox, minbox, nb_n_b, eshift, ild, ncontact, addcm, chaine, nin, itab, nlinsr, ncont, gap_s, stifs, penis, igap, stifm, iauto, i_mem)
Definition i20buce.F:224
i20buce
subroutine i20buce(xa, irect, nsv, inacti, cand_p, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, tzinf, maxbox, minbox, mwag, curv_max, ncontact, bminma, nb_n_b, eshift, ild, ifq, ifpen, stfa, nin, stf, igap, gap_s, nsnr, ncont, renum, nsnrold, gap_m, gapmin, gapmax, num_imp, nln, nlg, gap_sh, nbinflg, mbinflg, isym, i_mem, intheat, idt_therm, nodadt_therm)
Definition i20buce.F:45
i20tri_edge
subroutine i20tri_edge(add, xa, nlg, ixlins, ixlinm, nlinma, nlinsr, xyzm, i_add, maxsiz, ii_stoke, cand_s, cand_m, nsn4, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, eshift, addcm, chaine, nlinsa, itab, nb_old, stfs, stfm, iauto, nin)
Definition i20tri.F:680
i20tri
subroutine i20tri(add, nsn, renum, nsnr, isznsnr, irect, xa, stf, stfa, xyzm, i_add, nsv, maxsiz, ii_stok, cand_n, cand_e, mulnsn, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, eshift, inacti, ifq, cand_a, cand_p, ifpen, nrtm, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, marge, curv_max, nin, gap_sh, nbinflg, mbinflg, isym, intheat, idt_therm, nodadt_therm)
Definition i20tri.F:45
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
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