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!|| icontact_mod ../engine/share/modules/icontact_mod.F
33!||====================================================================
34 SUBROUTINE i17buce_pena(
35 1 NELES ,IXS ,IXS16 ,IXS20 ,NELEM ,
36 2 NME ,LWAT ,NMES ,CAND_E ,CAND_N ,
37 3 NOINT ,I_STOK_GLOB,TZINF ,MINBOX ,EMINXM ,
38 4 XSAV ,ITASK ,X ,V ,A ,
39 5 MX_CAND ,EMINXS ,ESH_T ,FROTS ,KS ,
40 6 NIN ,NMESR ,NB_N_B ,BMINMA )
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE icontact_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49#include "comlock.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "task_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER NME, NMES, NOINT,IDT,ITASK,MX_CAND,
58 . ESH_T, I_STOK_GLOB, NIN, NMESR, NB_N_B
59 INTEGER CAND_E(*),CAND_N(*),IXS(NIXS,*),IXS16(8,*),
60 . LWAT,NELEM(*),NELES(*),IXS20(12,*)
61C REAL
62 my_real
63 . tzinf,minbox
64 my_real
65 . x(3,*),eminxm(6,*),eminxs(6,*),xsav(3,*),v(3,*) ,a(3,*),
66 . frots(7,*), ks(2,*),bminma(6)
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70C
71 INTEGER I_ADD_MAX
72 PARAMETER (I_ADD_MAX = 1001)
73 integer i, j, k, l, cont,i_stok ,
74 . ip0, ip1, ip2, ip21, ip22, ip31, maxsiz,
75 . nmes_f,nmes_l, maxsizs, i_add
76 INTEGER IERR1,IERR2
77 my_real
78 . xyzm(6,i_add_max-1)
79C-----------------------------------------------
80C S o u r c e L i n e s
81C-----------------------------------------------
82C
83C-----2- TRI PAR BOITES DES ELEMENTS ET DES NOEUDS
84C
85C-----------------------------------------------
86C nouvelle phase de tri
87C-----------------------------------------------
88 cont = 1
89C-----------------------------------------------
90C Boucle sur les retris
91C-----------------------------------------------
92 DO WHILE (cont/=0)
93C -------------------------------------------------------------
94C CALCUL DES BORNES DU DOMAINE
95C avant I17TRI pour detection candidats remote et allocation en SPMD
96C -------------------------------------------------------------
97C
98 i_add = 1
99 xyzm(1,i_add) = bminma(1)
100 xyzm(2,i_add) = bminma(2)
101 xyzm(3,i_add) = bminma(3)
102 xyzm(4,i_add) = bminma(4)
103 xyzm(5,i_add) = bminma(5)
104 xyzm(6,i_add) = bminma(6)
105C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
106C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
107C POINTEUR NOM TAILLE
108C P1........Elt Bas Pile NME+100
109C P2........Elt PILE 3*(NME+100)
110C P21.......BPN NMES+100
111C P22.......PN 3*(NMES+100)
112 maxsiz = 3*(nme+100)
113 maxsizs = 3*(nmes+nmesr+100)
114C Allocation directement dans i17tri pour tenir compte de NMESR
115C IP1 = 1
116C IP2 = IP1+NME+100
117C IP21= IP2+MAXSIZ
118C IP22= IP21+NMES+100
119C IP31= IP22+MAXSIZS
120C -------------------------------------------------------------
121C Allocation tableau chaine apres calculs SPMD elt remote
122C -------------------------------------------------------------
123 IF(itask == 0)THEN
124 ALLOCATE (adchaine(nmes+nmesr),stat=ierr1)
125 ALLOCATE (chaine(2,mx_cand),stat=ierr2)
126 IF(ierr1+ierr2 /= 0)THEN
127 CALL arret(2)
128 ENDIF
129 ENDIF
130C -------------------------------------------------------------
131 CALL my_barrier
132C -------------------------------------------------------------
133 nmes_f = 1 + itask*(nmes+nmesr) / nthread
134 nmes_l = (itask+1)*(nmes+nmesr) / nthread
135 adchaine(nmes_f:nmes_l) = 0
136C ADCHAINE(NMES_F:NMES_L+NMESR) = 0
137 chaine(1,1:mx_cand) = 0
138 chaine(2,1:mx_cand) = 0
139 mx_ad = 0
140C -------------------------------------------------------------
141 CALL my_barrier
142C -------------------------------------------------------------
143 CALL i17tri(
144 2 tzinf ,ixs ,ixs16 ,ixs20 ,nelem ,
145 3 neles ,maxsiz ,cand_n ,cand_e ,minbox ,
146 5 cont ,nb_n_b ,eminxm ,i_stok_glob,nme ,
147 6 itask ,noint ,x ,v ,a ,
148 7 mx_cand ,eminxs ,esh_t ,maxsizs ,i_add_max,
149 8 xyzm ,nmes ,nmesr ,nin )
150C -------------------------------------------------------------
151 CALL my_barrier
152 IF(itask == 0)THEN
153 DEALLOCATE (adchaine)
154 DEALLOCATE (chaine)
155 ENDIF
156C -------------------------------------------------------------
157 ENDDO
158C
159 RETURN
160 END
161C
162!||====================================================================
163!|| i17buce ../engine/source/interfaces/int17/i17buce.F
164!||--- called by ------------------------------------------------------
165!|| i17main ../engine/source/interfaces/int17/i17main.F
166!||--- calls -----------------------------------------------------
167!|| ancmsg ../engine/source/output/message/message.F
168!|| arret ../engine/source/system/arret.F
169!|| i17tri ../engine/source/interfaces/int17/i17tri.F
170!|| my_barrier ../engine/source/system/machine.F
171!|| spmd_tri17box ../engine/source/mpi/interfaces/spmd_tri17box.F
172!||--- uses -----------------------------------------------------
173!|| icontact_mod ../engine/share/modules/icontact_mod.F
174!|| message_mod ../engine/share/message_module/message_mod.F
175!||====================================================================
176 SUBROUTINE i17buce(
177 1 NELES ,IXS ,IXS16 ,IXS20 ,NELEM ,
178 2 NME ,LWAT ,NMES ,CAND_E ,CAND_N ,
179 3 NOINT ,I_STOK_GLOB,TZINF ,MINBOX ,EMINXM ,
180 4 XSAV ,ITASK ,X ,V ,A ,
181 5 MX_CAND ,EMINXS ,ESH_T ,FROTS ,KS ,
182 6 ISENDTO ,IRCVFROM ,WEIGHT ,NIN ,NMESR ,
183 7 VCOM )
184C-----------------------------------------------
185C M o d u l e s
186C-----------------------------------------------
187 USE icontact_mod
188 USE message_mod
189C-----------------------------------------------
190C I m p l i c i t T y p e s
191C-----------------------------------------------
192#include "implicit_f.inc"
193#include "comlock.inc"
194C-----------------------------------------------
195C C o m m o n B l o c k s
196C-----------------------------------------------
197#include "com01_c.inc"
198#include "com04_c.inc"
199#include "com08_c.inc"
200#include "task_c.inc"
201C-----------------------------------------------
202C D u m m y A r g u m e n t s
203C-----------------------------------------------
204 INTEGER NME, NMES, NOINT,IDT,ITASK,MX_CAND,
205 . ESH_T, I_STOK_GLOB, NIN, NMESR
206 INTEGER CAND_E(*),CAND_N(*),IXS(NIXS,*),IXS16(8,*),
207 . LWAT,NELEM(*),NELES(*),IXS20(12,*),
208 . ISENDTO(*), IRCVFROM(*), WEIGHT(*)
209C REAL
210 my_real
211 . TZINF,MINBOX
212 my_real
213 . X(3,*),EMINXM(6,*),EMINXS(6,*),XSAV(3,*),V(3,*) ,A(3,*),
214 . FROTS(7,*), KS(2,*), VCOM(3,*)
215C-----------------------------------------------
216C L o c a l V a r i a b l e s
217C-----------------------------------------------
218C
219 INTEGER I_ADD_MAX
220 PARAMETER (I_ADD_MAX = 1001)
221 integer i, j, k, l, cont,nb_n_b,i_stok ,
222 . ip0, ip1, ip2, ip21, ip22, ip31, maxsiz,
223 . nmes_f,nmes_l, maxsizs, i_add
224 INTEGER IERR1,IERR2
225 my_real
226 . xmin,ymin,zmin,xmax,ymax,zmax,
227 . xyzm(6,i_add_max-1)
228C-----------------------------------------------
229C S o u r c e L i n e s
230C-----------------------------------------------
231c fait dans ICOMCRIT
232c IF (DEBUG(3)>=1) THEN
233c#include "lockon.inc"
234c WRITE(ISTDO,*)'** NEW SORT FOR INTERFACE NUMBER ',NOINT,
235c . ' AT CYCLE ',NCYCLE
236c WRITE(IOUT,*)'** NEW SORT FOR INTERFACE NUMBER ',NOINT,
237c . ' AT CYCLE ',NCYCLE
238c#include "lockoff.inc"
239c ENDIF
240C-----------------------------------------------
241 nmes_f = 1 + itask*nmes / nthread
242 nmes_l = (itask+1)*nmes / nthread
243 DO k=1,8
244 DO i=1+esh_t,nme+esh_t
245 j=ixs(k+1,nelem(i))
246 xsav(1,j) = x(1,j)+dt2*(v(1,j)+dt12*a(1,j))
247 xsav(2,j) = x(2,j)+dt2*(v(2,j)+dt12*a(2,j))
248 xsav(3,j) = x(3,j)+dt2*(v(3,j)+dt12*a(3,j))
249 j=ixs16(k,nelem(i)-numels8-numels10-numels20)
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 ENDDO
254 DO i=nmes_f,nmes_l
255 j=ixs(k+1,neles(i))
256 xsav(1,j) = x(1,j)+dt2*(v(1,j)+dt12*a(1,j))
257 xsav(2,j) = x(2,j)+dt2*(v(2,j)+dt12*a(2,j))
258 xsav(3,j) = x(3,j)+dt2*(v(3,j)+dt12*a(3,j))
259 j=ixs16(k,neles(i)-numels8-numels10-numels20)
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 ENDDO
264 ENDDO
265C -------------------------------------------------------------
266 CALL my_barrier
267C -------------------------------------------------------------
268C-----------------------------------------------
269 nb_n_b = 1
270C Fin initialisation
271C-----------------------------------------------
272C
273C-----2- TRI PAR BOITES DES ELEMENTS ET DES NOEUDS
274C
275C-----------------------------------------------
276C nouvelle phase de tri
277C-----------------------------------------------
278 cont = 1
279C-----------------------------------------------
280C Boucle sur les retris
281C-----------------------------------------------
282 DO WHILE (cont/=0)
283C -------------------------------------------------------------
284C CALCUL DES BORNES DU DOMAINE
285C avant I17TRI pour detection candidats remote et allocation en SPMD
286C -------------------------------------------------------------
287 xmin = ep30
288 ymin = ep30
289 zmin = ep30
290 xmax = -ep30
291 ymax = -ep30
292 zmax = -ep30
293C
294 DO l=1,nme ! NME = NME_T en SMP
295 i = l + esh_t
296 xmin = min( xmin , eminxm(1,i) )
297 ymin = min( ymin , eminxm(2,i) )
298 zmin = min( zmin , eminxm(3,i) )
299 xmax = max( xmax , eminxm(4,i) )
300 ymax = max( ymax , eminxm(5,i) )
301 zmax = max( zmax , eminxm(6,i) )
302 ENDDO
303C
304 IF(abs(zmax-zmin)>2*ep30.OR.
305 + abs(ymax-ymin)>2*ep30.OR.
306 + abs(xmax-xmin)>2*ep30)THEN
307 CALL ancmsg(msgid=87,anmode=aninfo,
308 . i1=noint)
309 CALL arret(2)
310 END IF
311C
312 xmin = xmin - tzinf
313 ymin = ymin - tzinf
314 zmin = zmin - tzinf
315 xmax = xmax + tzinf
316 ymax = ymax + tzinf
317 zmax = zmax + tzinf
318 i_add = 1
319 xyzm(1,i_add) = xmin
320 xyzm(2,i_add) = ymin
321 xyzm(3,i_add) = zmin
322 xyzm(4,i_add) = xmax
323 xyzm(5,i_add) = ymax
324 xyzm(6,i_add) = zmax
325 nmesr = 0
326 IF(nspmd>1)THEN
327C
328C recuperation des noeuds remote NMESR stockes dans XREM
329C
330 CALL spmd_tri17box(neles ,nmes ,x ,vcom ,frots ,
331 2 ks ,xyzm ,weight ,nin ,isendto,
332 3 ircvfrom,nmesr ,ixs ,ixs16,eminxs )
333 END IF
334C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
335C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
336C POINTEUR NOM TAILLE
337C P1........Elt Bas Pile NME+100
338C P2........Elt PILE 3*(NME+100)
339C P21.......BPN NMES+100
340C P22.......PN 3*(NMES+100)
341 maxsiz = 3*(nme+100)
342 maxsizs = 3*(nmes+nmesr+100)
343C Allocation directement dans i17tri pour tenir compte de NMESR
344C IP1 = 1
345C IP2 = IP1+NME+100
346C IP21= IP2+MAXSIZ
347C IP22= IP21+NMES+100
348C IP31= IP22+MAXSIZS
349C -------------------------------------------------------------
350C Allocation tableau chaine apres calculs SPMD elt remote
351C -------------------------------------------------------------
352 IF(itask == 0)THEN
353 ALLOCATE (adchaine(nmes+nmesr),stat=ierr1)
354 ALLOCATE (chaine(2,mx_cand),stat=ierr2)
355 IF(ierr1+ierr2 /= 0)THEN
356 CALL arret(2)
357 ENDIF
358 ENDIF
359C -------------------------------------------------------------
360 CALL my_barrier
361C -------------------------------------------------------------
362 adchaine(nmes_f:nmes_l+nmesr) = 0
363 chaine(1,1:mx_cand) = 0
364 chaine(2,1:mx_cand) = 0
365 mx_ad = 0
366C -------------------------------------------------------------
367 CALL my_barrier
368C -------------------------------------------------------------
369 CALL i17tri(
370 2 tzinf ,ixs ,ixs16 ,ixs20 ,nelem ,
371 3 neles ,maxsiz ,cand_n ,cand_e ,minbox ,
372 5 cont ,nb_n_b ,eminxm ,i_stok_glob,nme ,
373 6 itask ,noint ,x ,v ,a ,
374 7 mx_cand ,eminxs ,esh_t ,maxsizs ,i_add_max,
375 8 xyzm ,nmes ,nmesr ,nin)
376C -------------------------------------------------------------
377 CALL my_barrier
378 IF(itask == 0)THEN
379 DEALLOCATE (adchaine)
380 DEALLOCATE (chaine)
381 ENDIF
382C -------------------------------------------------------------
383 ENDDO
384C
385 RETURN
386 END
387
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:184
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:41
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:43
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
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:1249
spmd_tri17box
subroutine spmd_tri17box(nelems, nmes, x, v, frots, ks, bminmal, weight, nin, isendto, ircvfrom, nmesr, ixs, ixs16, eminxs)
Definition spmd_tri17box.F:40
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
my_barrier
subroutine my_barrier
Definition machine.F:31