OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i17buce.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!|| i17buce_pena ../engine/source/interfaces/int17/i17buce.F
25!||--- called by ------------------------------------------------------
26!|| i17main_tri ../engine/source/interfaces/int17/i17main_pena.F
27!||--- calls -----------------------------------------------------
28!|| arret ../engine/source/system/arret.F
29!|| i17tri ../engine/source/interfaces/int17/i17tri.f
30!|| my_barrier ../engine/source/system/machine.F
31!||--- uses -----------------------------------------------------
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!|| icontact_mod ../engine/share/modules/icontact_mod.F
34!||====================================================================
35 SUBROUTINE i17buce_pena(
36 1 NELES ,IXS ,IXS16 ,IXS20 ,NELEM ,
37 2 NME ,LWAT ,NMES ,CAND_E ,CAND_N ,
38 3 NOINT ,I_STOK_GLOB,TZINF ,MINBOX ,EMINXM ,
39 4 XSAV ,ITASK ,X ,V ,A ,
40 5 MX_CAND ,EMINXS ,ESH_T ,FROTS ,KS ,
41 6 NIN ,NMESR ,NB_N_B ,BMINMA )
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE icontact_mod
46 use element_mod , only : nixs
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51#include "comlock.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "task_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER NME, NMES, NOINT,ITASK,MX_CAND,
60 . ESH_T, I_STOK_GLOB, NIN, NMESR, NB_N_B
61 INTEGER CAND_E(*),CAND_N(*),IXS(NIXS,*),IXS16(8,*),
62 . LWAT,NELEM(*),NELES(*),IXS20(12,*)
63C REAL
64 my_real
65 . tzinf,minbox
66 my_real
67 . x(3,*),eminxm(6,*),eminxs(6,*),xsav(3,*),v(3,*) ,a(3,*),
68 . frots(7,*), ks(2,*),bminma(6)
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72C
73 INTEGER I_ADD_MAX
74 PARAMETER (I_ADD_MAX = 1001)
75 integer cont ,
76 . maxsiz,
77 . nmes_f,nmes_l, maxsizs, i_add
78 INTEGER IERR1,IERR2
79 my_real
80 . xyzm(6,i_add_max-1)
81C-----------------------------------------------
82C S o u r c e L i n e s
83C-----------------------------------------------
84C
85Csorting elements and nodes by boxes
86C
87C-----------------------------------------------
88C new sorting phase
89C-----------------------------------------------
90 cont = 1
91C-----------------------------------------------
92C loop over re-sorts
93C-----------------------------------------------
94 DO WHILE (cont/=0)
95C -------------------------------------------------------------
96C calculation of domain bounds
97C Before I17tri for Remote and SPMD Allowance Candidates Detection
98C -------------------------------------------------------------
99C
100 i_add = 1
101 xyzm(1,i_add) = bminma(1)
102 xyzm(2,i_add) = bminma(2)
103 xyzm(3,i_add) = bminma(3)
104 xyzm(4,i_add) = bminma(4)
105 xyzm(5,i_add) = bminma(5)
106 xyzm(6,i_add) = bminma(6)
107C if there is not enough memory for the stacks, restart the sorting
108C by incrementing NB_N_B (number of nodes per finished box)
109C POINTEUR NOM TAILLE
110C P1........Elt Bas Pile NME+100
111C P2........Elt PILE 3*(NME+100)
112C P21.......BPN NMES+100
113C P22.......PN 3*(NMES+100)
114 maxsiz = 3*(nme+100)
115 maxsizs = 3*(nmes+nmesr+100)
116C allocation directly in i17tri to account for NMESR
117C IP1 = 1
118C IP2 = IP1+NME+100
119C IP21= IP2+MAXSIZ
120C IP22= IP21+NMES+100
121C IP31= IP22+MAXSIZS
122C -------------------------------------------------------------
123C Table allowance chain after calculations SPMD ELT Remote
124C -------------------------------------------------------------
125 IF(itask == 0)THEN
126 ALLOCATE (adchaine(nmes+nmesr),stat=ierr1)
127 ALLOCATE (chaine(2,mx_cand),stat=ierr2)
128 IF(ierr1+ierr2 /= 0)THEN
129 CALL arret(2)
130 ENDIF
131 ENDIF
132C -------------------------------------------------------------
133 CALL my_barrier
134C -------------------------------------------------------------
135 nmes_f = 1 + itask*(nmes+nmesr) / nthread
136 nmes_l = (itask+1)*(nmes+nmesr) / nthread
137 adchaine(nmes_f:nmes_l) = 0
138C ADCHAINE(NMES_F:NMES_L+NMESR) = 0
139 chaine(1,1:mx_cand) = 0
140 chaine(2,1:mx_cand) = 0
141 mx_ad = 0
142C -------------------------------------------------------------
143 CALL my_barrier
144C -------------------------------------------------------------
145 CALL i17tri(
146 2 tzinf ,ixs ,ixs16 ,ixs20 ,nelem ,
147 3 neles ,maxsiz ,cand_n ,cand_e ,minbox ,
148 5 cont ,nb_n_b ,eminxm ,i_stok_glob,nme ,
149 6 itask ,noint ,x ,v ,a ,
150 7 mx_cand ,eminxs ,esh_t ,maxsizs ,i_add_max,
151 8 xyzm ,nmes ,nmesr ,nin )
152C -------------------------------------------------------------
153 CALL my_barrier
154 IF(itask == 0)THEN
155 DEALLOCATE (adchaine)
156 DEALLOCATE (chaine)
157 ENDIF
158C -------------------------------------------------------------
159 ENDDO
160C
161 RETURN
162 END
163C
164!||====================================================================
165!|| i17buce ../engine/source/interfaces/int17/i17buce.F
166!||--- called by ------------------------------------------------------
167!|| i17main ../engine/source/interfaces/int17/i17main.F
168!||--- calls -----------------------------------------------------
169!|| ancmsg ../engine/source/output/message/message.F
170!|| arret ../engine/source/system/arret.F
171!|| i17tri ../engine/source/interfaces/int17/i17tri.F
172!|| my_barrier ../engine/source/system/machine.F
173!|| spmd_tri17box ../engine/source/mpi/interfaces/spmd_tri17box.f
174!||--- uses -----------------------------------------------------
175!|| element_mod ../common_source/modules/elements/element_mod.F90
176!|| icontact_mod ../engine/share/modules/icontact_mod.F
177!|| message_mod ../engine/share/message_module/message_mod.F
178!||====================================================================
179 SUBROUTINE i17buce(
180 1 NELES ,IXS ,IXS16 ,IXS20 ,NELEM ,
181 2 NME ,LWAT ,NMES ,CAND_E ,CAND_N ,
182 3 NOINT ,I_STOK_GLOB,TZINF ,MINBOX ,EMINXM ,
183 4 XSAV ,ITASK ,X ,V ,A ,
184 5 MX_CAND ,EMINXS ,ESH_T ,FROTS ,KS ,
185 6 ISENDTO ,IRCVFROM ,WEIGHT ,NIN ,NMESR ,
186 7 VCOM )
187C-----------------------------------------------
188C M o d u l e s
189C-----------------------------------------------
190 USE icontact_mod
191 USE message_mod
192 use element_mod , only : nixs
193C-----------------------------------------------
194C I m p l i c i t T y p e s
195C-----------------------------------------------
196#include "implicit_f.inc"
197#include "comlock.inc"
198C-----------------------------------------------
199C C o m m o n B l o c k s
200C-----------------------------------------------
201#include "com01_c.inc"
202#include "com04_c.inc"
203#include "com08_c.inc"
204#include "task_c.inc"
205C-----------------------------------------------
206C D u m m y A r g u m e n t s
207C-----------------------------------------------
208 INTEGER NME, NMES, NOINT,ITASK,MX_CAND,
209 . ESH_T, I_STOK_GLOB, NIN, NMESR
210 INTEGER CAND_E(*),CAND_N(*),IXS(NIXS,*),IXS16(8,*),
211 . LWAT,NELEM(*),NELES(*),IXS20(12,*),
212 . ISENDTO(*), IRCVFROM(*), WEIGHT(*)
213C REAL
214 my_real
215 . TZINF,MINBOX
216 my_real
217 . X(3,*),EMINXM(6,*),EMINXS(6,*),XSAV(3,*),V(3,*) ,A(3,*),
218 . FROTS(7,*), KS(2,*), VCOM(3,*)
219C-----------------------------------------------
220C L o c a l V a r i a b l e s
221C-----------------------------------------------
222C
223 INTEGER I_ADD_MAX
224 PARAMETER (I_ADD_MAX = 1001)
225 integer i, j, k, l, cont,nb_n_b ,
226 . maxsiz,
227 . nmes_f,nmes_l, maxsizs, i_add
228 INTEGER IERR1,IERR2
229 my_real
230 . xmin,ymin,zmin,xmax,ymax,zmax,
231 . xyzm(6,i_add_max-1)
232C-----------------------------------------------
233C S o u r c e L i n e s
234C-----------------------------------------------
235c done in ICOMCRIT
236c IF (DEBUG(3)>=1) THEN
237c#include "lockon.inc"
238c WRITE(ISTDO,*)'** NEW SORT FOR INTERFACE NUMBER ',NOINT,
239c . ' AT CYCLE ',NCYCLE
240c WRITE(IOUT,*)'** NEW SORT FOR INTERFACE NUMBER ',NOINT,
241c . ' AT CYCLE ',NCYCLE
242c#include "lockoff.inc"
243c ENDIF
244C-----------------------------------------------
245 nmes_f = 1 + itask*nmes / nthread
246 nmes_l = (itask+1)*nmes / nthread
247 DO k=1,8
248 DO i=1+esh_t,nme+esh_t
249 j=ixs(k+1,nelem(i))
250 xsav(1,j) = x(1,j)+dt2*(v(1,j)+dt12*a(1,j))
251 xsav(2,j) = x(2,j)+dt2*(v(2,j)+dt12*a(2,j))
252 xsav(3,j) = x(3,j)+dt2*(v(3,j)+dt12*a(3,j))
253 j=ixs16(k,nelem(i)-numels8-numels10-numels20)
254 xsav(1,j) = x(1,j)+dt2*(v(1,j)+dt12*a(1,j))
255 xsav(2,j) = x(2,j)+dt2*(v(2,j)+dt12*a(2,j))
256 xsav(3,j) = x(3,j)+dt2*(v(3,j)+dt12*a(3,j))
257 ENDDO
258 DO i=nmes_f,nmes_l
259 j=ixs(k+1,neles(i))
260 xsav(1,j) = x(1,j)+dt2*(v(1,j)+dt12*a(1,j))
261 xsav(2,j) = x(2,j)+dt2*(v(2,j)+dt12*a(2,j))
262 xsav(3,j) = x(3,j)+dt2*(v(3,j)+dt12*a(3,j))
263 j=ixs16(k,neles(i)-numels8-numels10-numels20)
264 xsav(1,j) = x(1,j)+dt2*(v(1,j)+dt12*a(1,j))
265 xsav(2,j) = x(2,j)+dt2*(v(2,j)+dt12*a(2,j))
266 xsav(3,j) = x(3,j)+dt2*(v(3,j)+dt12*a(3,j))
267 ENDDO
268 ENDDO
269C -------------------------------------------------------------
270 CALL my_barrier
271C -------------------------------------------------------------
272C-----------------------------------------------
273 nb_n_b = 1
274C Fin initialisation
275C-----------------------------------------------
276C
277Csorting elements and nodes by boxes
278C
279C-----------------------------------------------
280C new sorting phase
281C-----------------------------------------------
282 cont = 1
283C-----------------------------------------------
284C loop over re-sorts
285C-----------------------------------------------
286 DO WHILE (cont/=0)
287C -------------------------------------------------------------
288C calculation of domain bounds
289C Before I17tri for Remote and SPMD Allowance Candidates Detection
290C -------------------------------------------------------------
291 xmin = ep30
292 ymin = ep30
293 zmin = ep30
294 xmax = -ep30
295 ymax = -ep30
296 zmax = -ep30
297C
298 DO l=1,nme ! NME = NME_T en SMP
299 i = l + esh_t
300 xmin = min( xmin , eminxm(1,i) )
301 ymin = min( ymin , eminxm(2,i) )
302 zmin = min( zmin , eminxm(3,i) )
303 xmax = max( xmax , eminxm(4,i) )
304 ymax = max( ymax , eminxm(5,i) )
305 zmax = max( zmax , eminxm(6,i) )
306 ENDDO
307C
308 IF(abs(zmax-zmin)>2*ep30.OR.
309 + abs(ymax-ymin)>2*ep30.OR.
310 + abs(xmax-xmin)>2*ep30)THEN
311 CALL ancmsg(msgid=87,anmode=aninfo,
312 . i1=noint)
313 CALL arret(2)
314 END IF
315C
316 xmin = xmin - tzinf
317 ymin = ymin - tzinf
318 zmin = zmin - tzinf
319 xmax = xmax + tzinf
320 ymax = ymax + tzinf
321 zmax = zmax + tzinf
322 i_add = 1
323 xyzm(1,i_add) = xmin
324 xyzm(2,i_add) = ymin
325 xyzm(3,i_add) = zmin
326 xyzm(4,i_add) = xmax
327 xyzm(5,i_add) = ymax
328 xyzm(6,i_add) = zmax
329 nmesr = 0
330 IF(nspmd>1)THEN
331C
332C retrieval of remote NMESR nodes stored in XREM
333C
334 CALL spmd_tri17box(neles ,nmes ,x ,vcom ,frots ,
335 2 ks ,xyzm ,weight ,nin ,isendto,
336 3 ircvfrom,nmesr ,ixs ,ixs16,eminxs )
337 END IF
338C if there is not enough memory for the stacks, restart the sorting
339C by incrementing NB_N_B (number of nodes per finished box)
340C POINTEUR NOM TAILLE
341C P1........Elt Bas Pile NME+100
342C P2........Elt PILE 3*(NME+100)
343C P21.......BPN NMES+100
344C P22.......PN 3*(NMES+100)
345 maxsiz = 3*(nme+100)
346 maxsizs = 3*(nmes+nmesr+100)
347C allocation directly in i17tri to account for NMESR
348C IP1 = 1
349C IP2 = IP1+NME+100
350C IP21= IP2+MAXSIZ
351C IP22= IP21+NMES+100
352C IP31= IP22+MAXSIZS
353C -------------------------------------------------------------
354C Table allowance chain after calculations SPMD ELT Remote
355C -------------------------------------------------------------
356 IF(itask == 0)THEN
357 ALLOCATE (adchaine(nmes+nmesr),stat=ierr1)
358 ALLOCATE (chaine(2,mx_cand),stat=ierr2)
359 IF(ierr1+ierr2 /= 0)THEN
360 CALL arret(2)
361 ENDIF
362 ENDIF
363C -------------------------------------------------------------
364 CALL my_barrier
365C -------------------------------------------------------------
366 adchaine(nmes_f:nmes_l+nmesr) = 0
367 chaine(1,1:mx_cand) = 0
368 chaine(2,1:mx_cand) = 0
369 mx_ad = 0
370C -------------------------------------------------------------
371 CALL my_barrier
372C -------------------------------------------------------------
373 CALL i17tri(
374 2 tzinf ,ixs ,ixs16 ,ixs20 ,nelem ,
375 3 neles ,maxsiz ,cand_n ,cand_e ,minbox ,
376 5 cont ,nb_n_b ,eminxm ,i_stok_glob,nme ,
377 6 itask ,noint ,x ,v ,a ,
378 7 mx_cand ,eminxs ,esh_t ,maxsizs ,i_add_max,
379 8 xyzm ,nmes ,nmesr ,nin)
380C -------------------------------------------------------------
381 CALL my_barrier
382 IF(itask == 0)THEN
383 DEALLOCATE (adchaine)
384 DEALLOCATE (chaine)
385 ENDIF
386C -------------------------------------------------------------
387 ENDDO
388C
389 RETURN
390 END
391
i17buce
subroutine i17buce(neles, ixs, ixs16, ixs20, nelem, nme, lwat, nmes, cand_e, cand_n, noint, i_stok_glob, tzinf, minbox, eminxm, xsav, itask, x, v, a, mx_cand, eminxs, esh_t, frots, ks, isendto, ircvfrom, weight, nin, nmesr, vcom)
Definition i17buce.F:187
i17buce_pena
subroutine i17buce_pena(neles, ixs, ixs16, ixs20, nelem, nme, lwat, nmes, cand_e, cand_n, noint, i_stok_glob, tzinf, minbox, eminxm, xsav, itask, x, v, a, mx_cand, eminxs, esh_t, frots, ks, nin, nmesr, nb_n_b, bminma)
Definition i17buce.F:42
i17tri
subroutine i17tri(tzinf, ixs, ixs16, ixs20, nelem, neles, maxsiz, cand_n, cand_e, minbox, cont, nb_n_b, eminx, i_stok_glob, nme, itask, noint, x, v, a, mx_cand, eminxs, esh_t, maxsizs, i_add_max, xyzm, nmes, nmesr, nin)
Definition i17tri.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
icontact_mod
Definition icontact_mod.F:34
icontact_mod::mx_ad
integer mx_ad
Definition icontact_mod.F:42
icontact_mod::chaine
integer, dimension(:,:), allocatable chaine
Definition icontact_mod.F:41
icontact_mod::adchaine
integer, dimension(:), allocatable adchaine
Definition icontact_mod.F:40
message_mod
Definition message_mod.F:1257
spmd_tri17box
subroutine spmd_tri17box(nelems, nmes, x, v, frots, ks, bminmal, weight, nin, isendto, ircvfrom, nmesr, ixs, ixs16, eminxs)
Definition spmd_tri17box.F:41
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
my_barrier
subroutine my_barrier
Definition machine.F:31