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, 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_ADD, IP0, IP1, MAXSIZ,
87 . add(2,i_add_max), isznsnr
88C REAL
89 my_real
90 . xyzm(6,i_add_max-1), marge
91 my_real
92 . curv_max(nrtm)
93C-----------------------------------------------
94C S o u r c e L i n e s
95C-----------------------------------------------
96C
97C-----2- sorting of elements and nodes by boxes
98C
99C-----------------------------------------------
100C if there is not enough memory for the stacks, the sorting is restarted
101C by increasing nb_n_b (number of nodes per finished box)
102C POINTEUR NOM TAILLE
103C p0........ nsn + 3 [+ nsnrold in the case of spmd]
104C P1........Elt Bas Pile NRTM
105C P2........Elt PILE 2*NRTM
106C P21.......BPN NSN
107C P22.......PN NSN
108C P31.......ADDI 2*I_ADD_MAX
109 maxsiz = 3*(nrtm+100)
110C
111 ip0 = 1
112 ip1 = ip0 + nsn + nsnrold + 3
113
114C
115C-----initialization of addresses and x, y, z
116C
117C ADDE ADDN X Y Z
118C 1 1 XMIN YMIN ZMIN
119C 1 1 XMAX YMAX ZMAX
120C
121 add(1,1) = 0
122 add(2,1) = 0
123 add(1,2) = 0
124 add(2,2) = 0
125 i_add = 1
126 xyzm(1,i_add) = bminma(4)
127 xyzm(2,i_add) = bminma(5)
128 xyzm(3,i_add) = bminma(6)
129 xyzm(4,i_add) = bminma(1)
130 xyzm(5,i_add) = bminma(2)
131 xyzm(6,i_add) = bminma(3)
132 i_mem = 0
133C
134
135 IF((inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0 .OR.num_imp>0))THEN
136 isznsnr = nsnr
137 ELSE
138 isznsnr = 0
139 END IF
140C
141C-----start of the sorting phase
142C
143C SEPARER B ET N EN TWO
144C
145 marge = tzinf-gap ! it is indeed the margin
146 CALL i20tri(
147 1 add ,nsn ,renum ,nsnr ,isznsnr ,
148 2 irect ,xa ,stf ,stfa ,xyzm ,
149 3 i_add ,nsv ,maxsiz ,ii_stok ,cand_n ,
150 4 cand_e ,ncontact,noint ,tzinf ,maxbox ,
151 5 minbox ,i_mem ,nb_n_b ,i_add_max,eshift ,
152 6 inacti ,ifq ,mwag(ip0),cand_p ,ifpen ,
153 7 nrtm ,nsnrold ,igap ,gap ,gap_s ,
154 6 gap_m ,gapmin ,gapmax ,marge ,curv_max,
155 7 nin ,gap_sh ,nbinflg ,mbinflg ,isym ,
156 8 intheat, idt_therm, nodadt_therm)
157C
158C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
159C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATES
160C I_MEM = 3 ==> TROP NIVEAUX PILE
161 IF (i_mem == 2) RETURN
162 IF(i_mem==1)THEN
163 nb_n_b = nb_n_b + 1
164 IF ( nb_n_b > ncont) THEN
165 CALL ancmsg(msgid=85,anmode=aninfo,
166 . i1=noint)
167 CALL arret(2)
168 ENDIF
169 ild = 1
170 ELSEIF(i_mem==2) THEN
171 IF(debug(1)>=1) THEN
172 iwarn = iwarn+1
173#include "lockon.inc"
174 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
175 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
176 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
177 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
178 WRITE(iout,*)' MULTIPLIED BY 0.75'
179#include "lockoff.inc"
180 ENDIF
181 tzinf = three_over_4*tzinf
182C do not decrease the size of the boxes
183C MINBOX= THREE_OVER_4*MINBOX
184C MAXBOX= THREE_OVER_4*MAXBOX
185 IF( tzinf<=gap ) THEN
186 CALL ancmsg(msgid=98,anmode=aninfo,
187 . i1=noint,c1='(I20BUCE)')
188 CALL arret(2)
189 ENDIF
190 ild = 1
191 ELSEIF(i_mem==3)THEN
192 nb_n_b = nb_n_b + 1
193
194 IF ( nb_n_b > ncont) THEN
195 CALL ancmsg(msgid=99,anmode=aninfo,
196 . i1=noint,c1='(I20BUCE)')
197 CALL arret(2)
198 ENDIF
199 ild = 1
200 ENDIF
201C
202 RETURN
203 END
204!||====================================================================
205!|| i20buc_edge ../engine/source/interfaces/intsort/i20buce.F
206!||--- called by ------------------------------------------------------
207!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
208!||--- calls -----------------------------------------------------
209!|| ancmsg ../engine/source/output/message/message.F
210!|| arret ../engine/source/system/arret.F
211!|| i20tri_edge ../engine/source/interfaces/intsort/i20tri.F
212!||--- uses -----------------------------------------------------
213!|| message_mod ../engine/share/message_module/message_mod.F
214!||====================================================================
215 SUBROUTINE i20buc_edge(
216 1 XA ,IXLINS ,IXLINM ,NLG ,
217 2 NLINSA ,NMNE ,NLINMA ,CAND_M ,CAND_S ,
218 3 GAP ,NOINT ,II_STOKE,BMINMA ,TZINF ,
219 4 MAXBOX ,MINBOX ,NB_N_B , ESHIFT ,ILD ,
220 6 NCONTACT,ADDCM ,CHAINE ,NIN ,ITAB ,
221 7 NLINSR ,NCONT ,GAP_S ,STIFS , PENIS ,
222 8 IGAP ,STIFM ,IAUTO , I_MEM)
223C============================================================================
224C-----------------------------------------------
225C M o d u l e s
226C-----------------------------------------------
227 USE message_mod
228C-----------------------------------------------
229C I m p l i c i t T y p e s
230C-----------------------------------------------
231#include "implicit_f.inc"
232#include "comlock.inc"
233C-----------------------------------------------
234C C o m m o n B l o c k s
235C-----------------------------------------------
236#include "units_c.inc"
237#include "warn_c.inc"
238C-----------------------------------------------
239C D u m m y A r g u m e n t s
240C-----------------------------------------------
241 INTEGER NMNE, NLINMA, NOINT, NLINSA, NIN, NLINSR,
242 . IGAP,IAUTO
243 INTEGER IXLINS(2,*),IXLINM(2,*),ADDCM(*),CHAINE(2,*)
244 INTEGER CAND_M(*),CAND_S(*),NLG(*)
245 INTEGER ESHIFT,ILD, NB_N_B, NCONTACT, NCONT,
246 . ITAB(*), I_MEM,II_STOKE
247C REAL
248 my_real
249 . GAP,TZINF,MAXBOX,MINBOX,
250 . BMINMA(6)
251 my_real
252 . XA(3,*),GAP_S(*),STIFS(*),PENIS(2,*),STIFM(*)
253C-----------------------------------------------
254C L o c a l V a r i a b l e s
255C-----------------------------------------------
256 INTEGER I_ADD_MAX
257 PARAMETER (I_ADD_MAX = 1001)
258C
259 INTEGER I, I_ADD, MAXSIZ,
260 . add(2,i_add_max)
261C REAL
262 my_real
263 . xyzm(6,i_add_max-1)
264 INTEGER NB_OLD(2,I_ADD_MAX+1)
265C-----------------------------------------------
266C S o u r c e L i n e s
267C=======================================================================
268C
269C-----2- sorting by boxes
270C
271C-----------------------------------------------
272C if there is not enough memory for the stacks, the sorting is restarted
273C by increasing nb_n_b (number of nodes per finished box)
274C
275C POINTEUR NOM TAILLE
276C P1........Elt Bas Pile NLINM
277C P2........Elt PILE 3*NLINM
278C P21.......Elt Bas Pile NLINS
279C P22.......Elt PILE 3*NLINS
280 maxsiz = 3*(max(nlinma,nlinsa+nlinsr)+100)
281
282C-----initialization of addresses and x, y, z
283C
284C ADDE ADDN X Y Z
285C 1 1 XMIN YMIN ZMIN
286C 1 1 XMAX YMAX ZMAX
287C
288 add(1,1) = 0
289 add(2,1) = 0
290 add(1,2) = 0
291 add(2,2) = 0
292 i_add = 1
293 xyzm(1,i_add) = bminma(4)
294 xyzm(2,i_add) = bminma(5)
295 xyzm(3,i_add) = bminma(6)
296 xyzm(4,i_add) = bminma(1)
297 xyzm(5,i_add) = bminma(2)
298 xyzm(6,i_add) = bminma(3)
299 i_mem = 0
300
301 DO i=1,nlinma
302 addcm(i)=0
303 ENDDO
304C
305C
306C-----start of the sorting phase
307C
308C SEPARER B ET N EN TWO
309 CALL i20tri_edge(
310 1 add ,xa ,nlg ,
311 2 ixlins ,ixlinm ,nlinma ,nlinsr ,
312 3 xyzm ,i_add ,maxsiz ,ii_stoke ,cand_s ,
313 4 cand_m ,ncontact,noint ,tzinf ,maxbox ,
314 5 minbox ,i_mem ,nb_n_b ,i_add_max,eshift ,
315 6 addcm ,chaine ,nlinsa ,itab ,nb_old ,
316 7 stifs ,stifm ,iauto ,nin )
317C
318C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
319C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATES
320C I_MEM = 3 ==> TROP NIVEAUX PILE
321 IF (i_mem == 1 .OR. i_mem==2)RETURN
322 IF(i_mem==1)THEN
323 nb_n_b = nb_n_b + 1
324 IF ( nb_n_b > max(nlinma,nlinsa)) THEN
325 CALL ancmsg(msgid=85,anmode=aninfo,
326 . i1=noint)
327 CALL arret(2)
328 ENDIF
329 ild = 1
330 ELSEIF(i_mem==2) THEN
331 IF(debug(1)>=1) THEN
332 iwarn = iwarn+1
333#include "lockon.inc"
334 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
335 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
336 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
337 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
338 WRITE(iout,*)' MULTIPLIED BY 0.75'
339#include "lockoff.inc"
340 ENDIF
341
342 tzinf = three_over_4*tzinf
343C do not decrease the size of the boxes
344C MINBOX= THREE_OVER_4*MINBOX
345C MAXBOX= THREE_OVER_4*MAXBOX
346 IF( tzinf<=gap ) THEN
347 CALL ancmsg(msgid=98,anmode=aninfo,
348 . i1=noint,c1='(I20BUCE)')
349 CALL arret(2)
350 ENDIF
351 ild = 1
352 ELSEIF(i_mem==3)THEN
353 nb_n_b = nb_n_b + 1
354 IF ( nb_n_b > max(nlinma,nlinsa)) THEN
355 CALL ancmsg(msgid=99,anmode=aninfo,
356 . i1=noint,c1='(I20BUCE)')
357 CALL arret(2)
358 ENDIF
359 ild = 1
360 ENDIF
361C
362 RETURN
363 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:223
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:677
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:1257
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