OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i17buce.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "task_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)
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)

Function/Subroutine Documentation

◆ i17buce()

subroutine i17buce ( integer, dimension(*) neles,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) nelem,
integer nme,
integer lwat,
integer nmes,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
integer noint,
integer i_stok_glob,
tzinf,
minbox,
eminxm,
xsav,
integer itask,
x,
v,
a,
integer mx_cand,
eminxs,
integer esh_t,
frots,
ks,
integer, dimension(*) isendto,
integer, dimension(*) ircvfrom,
integer, dimension(*) weight,
integer nin,
integer nmesr,
vcom )

Definition at line 179 of file i17buce.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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

◆ i17buce_pena()

subroutine i17buce_pena ( integer, dimension(*) neles,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) nelem,
integer nme,
integer lwat,
integer nmes,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
integer noint,
integer i_stok_glob,
tzinf,
minbox,
eminxm,
xsav,
integer itask,
x,
v,
a,
integer mx_cand,
eminxs,
integer esh_t,
frots,
ks,
integer nin,
integer nmesr,
integer nb_n_b,
bminma )

Definition at line 35 of file i17buce.F.

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