OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i17main_pena.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "timeri_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i17main_crit_tri (ipari, intbuf_tab, x, nin, itask, igrbric, eminx, nme, nmes, xslv _l, xmsr_l, size_t, ixs, ixs16, ixs20)
subroutine i17main_tri (timers, ipari, intbuf_tab, x, nin, itask, igrbric, nme, nmes, eminx, ixs, ixs16, ixs20, weight, isendto, irecvfrom, retri, iad_elem, fr_elem, itab, v, nme_t, esh_t)
subroutine i17main_pena (output, nin, ipari, intbuf_tab, x, v, a, itask, igrbric, eminx, ms, ixs, ixs16, ixs20, stifn, fskyi, isky, fsav, fcont, niskyfi, h3d_data)
subroutine i17frot (itask, frotm, frots, nme, nse)

Function/Subroutine Documentation

◆ i17frot()

subroutine i17frot ( integer itask,
frotm,
frots,
integer nme,
integer nse )

Definition at line 489 of file i17main_pena.F.

490C-----------------------------------------------
491C I m p l i c i t T y p e s
492C-----------------------------------------------
493#include "implicit_f.inc"
494C-----------------------------------------------
495C C o m m o n B l o c k s
496C-----------------------------------------------
497#include "task_c.inc"
498C-----------------------------------------------
499C D u m m y A r g u m e n t s
500C-----------------------------------------------
501 INTEGER ITASK,NME,NSE
502C REAL
503 my_real
504 . frotm(7,*),frots(7,*)
505C-----------------------------------------------
506C L o c a l V a r i a b l e s
507C-----------------------------------------------
508 INTEGER I,NMEF,NMEL,NSEF,NSEL
509 my_real
510 . aa
511C-----------------------------------------------
512 nmef = 1 + itask*nme / nthread
513 nmel = (itask+1)*nme / nthread
514 nsef = 1 + itask*nse / nthread
515 nsel = (itask+1)*nse / nthread
516C-----------------------------------------------
517C Friction (old friction constraint)
518C-----------------------------------------------
519 DO i=nmef,nmel
520 aa = one/max(em20,frotm(4,i))
521 frotm(5,i)=aa*frotm(1,i)
522 frotm(6,i)=aa*frotm(2,i)
523 frotm(7,i)=aa*frotm(3,i)
524C
525 frotm(1,i)=zero
526 frotm(2,i)=zero
527 frotm(3,i)=zero
528 frotm(4,i)=zero
529 ENDDO
530C
531 DO i=nsef,nsel
532 aa = one/max(em20,frots(4,i))
533 frots(5,i)=aa*frots(1,i)
534 frots(6,i)=aa*frots(2,i)
535 frots(7,i)=aa*frots(3,i)
536C
537 frots(1,i)=zero
538 frots(2,i)=zero
539 frots(3,i)=zero
540 frots(4,i)=zero
541 ENDDO
542C
543 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21

◆ i17main_crit_tri()

subroutine i17main_crit_tri ( integer, dimension(npari,ninter) ipari,
type(intbuf_struct_) intbuf_tab,
x,
integer nin,
integer itask,
type (group_), dimension(ngrbric) igrbric,
eminx,
integer nme,
integer nmes,
xslv,
_l,
xmsr_l,
size_t,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20 )

Definition at line 36 of file i17main_pena.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE intbufdef_mod
45 USE groupdef_mod
46 USE output_mod
47 use element_mod , only : nixs
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C
51C-------------------------------------------------------------------------------
52C NOM DIMENSION DESCRIPTION E/S
53C-------------------------------------------------------------------------------
54C
55C NIN 1 INTERFACE NUMBER E
56C
57C IPARI NPARI,NINTER PARAMETRES D'INTERFACE E
58C
59C X 3,NUMNOD COORDONNEES E
60C
61C V 3,NUMNOD VELOCITIES E
62C
63C EMINX 6*(NME+NMES) MIN MAX DE CHAQUE ELEMENT TMP_GLOBAL
64C
65C WAT 4*(NME+100)+4*(NMES+100) TABLEAUX DE TRI TMP_TASK
66C
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "com04_c.inc"
75#include "com08_c.inc"
76#include "param_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 INTEGER NIN,ITASK , NME, NMES
81 INTEGER IPARI(NPARI,NINTER),
82 . IXS(NIXS,*) ,IXS16(8,*) ,IXS20(12,*)
83C REAL
84 my_real
85 . x(3,*), eminx(6,*), size_t(*),
86 . xslv_l(*), xmsr_l(*)
87
88 TYPE(INTBUF_STRUCT_) INTBUF_TAB
89C-----------------------------------------------
90 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94 INTEGER
95 . IGN,IGE,MULTIMP,I,MX_CAND
96C REAL
97 my_real
98 . startt, stopt,
99 . azero(3,numnod)
100C-----------------------------------------------
101C S o u r c e L i n e s
102C-----------------------------------------------
103 DO i=1,numnod
104 azero(1,i) = zero
105 azero(2,i) = zero
106 azero(3,i) = zero
107 ENDDO
108 multimp = ipari(23,nin)
109 ign = ipari(36,nin)
110 ige = ipari(34,nin)
111 mx_cand=multimp*ipari(18,nin)
112 startt = intbuf_tab%VARIABLES(3)
113 stopt = intbuf_tab%VARIABLES(11)
114 IF(startt>tt) RETURN
115 IF(tt>stopt) RETURN
116C -------------------------------------------------------------
117C=======================================================================
118C Test to know whether to retriate + initialization
119C=======================================================================
120C SIZE_T(NIN)=ZERO init in inttri
121 CALL i17crit(
122 1 x ,azero ,azero ,igrbric(ige)%ENTITY ,eminx ,
123 2 nme ,itask ,intbuf_tab%XSAV,ixs ,ixs16 ,
124 3 ixs20 ,xmsr_l ,size_t(nin))
125C -------------------------------------------------------------
126C CALL MY_BARRIER inutile
127C -------------------------------------------------------------
128 CALL i17crit(
129 1 x ,azero ,azero ,igrbric(ign)%ENTITY,eminx(1,nme+1),
130 2 nmes ,itask ,intbuf_tab%XSAV,ixs ,ixs16 ,
131 3 ixs20 ,xslv_l ,size_t(nin) )
132C
133 RETURN
i17crit
subroutine i17crit(x, v, a, nelem, eminx, nme, itask, xsav, ixs, ixs16, ixs20, xmsr_g, size_t_g)
Definition i17crit.F:39
groupdef_mod
Definition groupdef_mod.F:668

◆ i17main_pena()

subroutine i17main_pena ( type(output_), intent(inout) output,
integer nin,
integer, dimension(npari,ninter) ipari,
type(intbuf_struct_) intbuf_tab,
x,
v,
a,
integer itask,
type (group_), dimension(ngrbric) igrbric,
eminx,
ms,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
stifn,
fskyi,
integer, dimension(*) isky,
fsav,
fcont,
integer niskyfi,
type(h3d_database) h3d_data )

Definition at line 376 of file i17main_pena.F.

381C-----------------------------------------------
382C M o d u l e s
383C-----------------------------------------------
384 USE intbufdef_mod
385 USE h3d_mod
386 USE groupdef_mod
387 USE output_mod
388 use element_mod , only : nixs
389C-----------------------------------------------
390C D u m m y A r g u m e n t s
391C
392C-------------------------------------------------------------------------------
393C NOM DIMENSION DESCRIPTION E/S
394C-------------------------------------------------------------------------------
395C
396C NIN 1 INTERFACE NUMBER E
397C
398C IPARI NPARI,NINTER PARAMETRES D'INTERFACE E
399C
400C X 3,NUMNOD COORDONNEES E
401C
402C V 3,NUMNOD VELOCITIES E
403C
404C EMINX 6*NME<6*NUMELS MIN MAX DE CHAQUE ELEMENT TMP_GLOBAL
405C
406C
407C-----------------------------------------------
408C I m p l i c i t T y p e s
409C-----------------------------------------------
410#include "implicit_f.inc"
411C-----------------------------------------------
412C C o m m o n B l o c k s
413C-----------------------------------------------
414#include "com04_c.inc"
415#include "com08_c.inc"
416#include "param_c.inc"
417#include "parit_c.inc"
418C-----------------------------------------------
419C D u m m y A r g u m e n t s
420C-----------------------------------------------
421 type(output_), intent(inout) :: output
422 INTEGER NIN,ITASK,NISKYFI
423 INTEGER IPARI(NPARI,NINTER),
424 . IXS(NIXS,*) ,IXS16(8,*) ,IXS20(12,*) ,ISKY(*)
425C REAL
426 my_real
427 . x(3,*), v(3,*), a(3,*), ms(*),eminx(6,*),stifn(*),
428 . fskyi(*), fsav(*),fcont(3,*)
429
430 TYPE(INTBUF_STRUCT_) INTBUF_TAB
431 TYPE(H3D_DATABASE) :: H3D_DATA
432C-----------------------------------------------
433 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
434C-----------------------------------------------
435C L o c a l V a r i a b l e s
436C-----------------------------------------------
437 INTEGER NME,
438 . IGN,IGE,MULTIMP,NOINT,MX_CAND,NMES,LSKYI17
439C REAL
440 my_real
441 . startt, stopt
442C-----------------------------------------------
443C S o u r c e L i n e s
444C-----------------------------------------------
445 noint = ipari(15,nin)
446 multimp = ipari(23,nin)
447 ign = ipari(36,nin)
448 ige = ipari(34,nin)
449 nmes =igrbric(ign)%NENTITY
450 nme =igrbric(ige)%NENTITY
451 mx_cand=multimp*ipari(18,nin)
452 IF(iparit/=0)THEN
453C LSKYI17=MX_CAND
454C Lskyi17 Imaximp function: number of Max Defini impacts in Starter/Lecint
455 lskyi17=max(mx_cand,multimp*ipari(5,nin)*8)
456 ELSE
457 lskyi17=0
458 END IF
459 startt = intbuf_tab%VARIABLES(3)
460 stopt = intbuf_tab%VARIABLES(11)
461 IF(startt>tt) RETURN
462 IF(tt>stopt) RETURN
463C -------------------------------------------------------------
464C -------------------------------------------------------------
465 CALL my_barrier
466C=======================================================================
467C CONTACT
468C=======================================================================
469 CALL i17for3(output,
470 1 x ,v ,intbuf_tab%CAND_N,intbuf_tab%CAND_E,ipari(35,nin) ,
471 2 ixs ,ixs16 ,eminx ,igrbric(ign)%ENTITY,igrbric(ige)%ENTITY,
472 3 itask ,a ,ipari(30,nin),nin ,eminx(1,nme+1),
473 4 stifn ,fskyi ,isky ,nme ,nmes ,
474 5 intbuf_tab%FROTM,intbuf_tab%FROTS,intbuf_tab%KM,intbuf_tab%KS,
475 5 intbuf_tab%VARIABLES(1) ,
476 6 fsav ,fcont ,ms ,niskyfi ,lskyi17 ,
477 7 noint ,h3d_data)
478C -------------------------------------------------------------
479 CALL my_barrier
480C -------------------------------------------------------------
481 RETURN
i17for3
subroutine i17for3(output, x, v, candn, cande, i_stok, ixs, ixs16, eminxm, neles, nelem, itask, a, itied, nint, eminxs, stifn, fskyi, isky, nme, nse, frotm, frots, km, ks, fric, fsav, fcont, ms, niskyfi, lskyi17, noint, h3d_data)
Definition i17for3.F:50
h3d_mod
Definition h3d_mod.F:311
my_barrier
subroutine my_barrier
Definition machine.F:31

◆ i17main_tri()

subroutine i17main_tri ( type(timer_), intent(inout) timers,
integer, dimension(npari,ninter) ipari,
type(intbuf_struct_) intbuf_tab,
x,
integer nin,
integer itask,
type (group_), dimension(ngrbric) igrbric,
integer nme,
integer nmes,
eminx,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) weight,
integer, dimension(*) isendto,
integer, dimension(*) irecvfrom,
integer retri,
integer, dimension(*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) itab,
v,
integer nme_t,
integer esh_t )

Definition at line 158 of file i17main_pena.F.

164C-----------------------------------------------
165C M o d u l e s
166C-----------------------------------------------
167 USE timer_mod
168 USE message_mod
169 USE intbufdef_mod
170 USE groupdef_mod
171 use element_mod , only : nixs
172C-----------------------------------------------
173C D u m m y A r g u m e n t s
174C
175C-------------------------------------------------------------------------------
176C NOM DIMENSION DESCRIPTION E/S
177C-------------------------------------------------------------------------------
178C
179C NIN 1 INTERFACE NUMBER E
180C
181C IPARI NPARI,NINTER PARAMETRES D'INTERFACE E
182C
183C X 3,NUMNOD COORDONNEES E
184C
185C V 3,NUMNOD VELOCITIES E
186C
187C EMINX 6*NME<6*NUMELS MIN MAX DE CHAQUE ELEMENT TMP_GLOBAL
188C
189C WAT 4*(NME+100)+4*(NMES+100) TABLEAUX DE TRI TMP_TASK
190C
191C-----------------------------------------------
192C I m p l i c i t T y p e s
193C-----------------------------------------------
194#include "implicit_f.inc"
195#include "comlock.inc"
196C-----------------------------------------------
197C C o m m o n B l o c k s
198C-----------------------------------------------
199#include "com01_c.inc"
200#include "com04_c.inc"
201#include "com08_c.inc"
202#include "param_c.inc"
203#include "timeri_c.inc"
204 COMMON /i17mainc/bminma,nmesr
205 INTEGER NMESR
206 my_real
207 . bminma(6)
208C-----------------------------------------------
209C D u m m y A r g u m e n t s
210C-----------------------------------------------
211 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
212 INTEGER NIN,ITASK , NME, NMES, RETRI, NME_T, ESH_T
213 INTEGER IPARI(NPARI,NINTER),
214 . IXS(NIXS,*) ,IXS16(8,*) ,IXS20(12,*),WEIGHT(*),
215 . ISENDTO(*),IRECVFROM(*),IAD_ELEM(*),FR_ELEM(*),
216 . ITAB(*)
217C REAL
218 my_real
219 . x(3,*), v(3,*), eminx(6,*)
220
221 TYPE(INTBUF_STRUCT_) INTBUF_TAB
222C-----------------------------------------------
223 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
224C-----------------------------------------------
225C L o c a l V a r i a b l e s
226C-----------------------------------------------
227 INTEGER LWAT,RESULT,
228 . IGN,IGE,MULTIMP,NOINT,I,MX_CAND, NB_N_B
229C REAL
230 my_real
231 . startt, stopt,tzinf,minbox,dist,
232 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl,
233 . azero(3,numnod)
234C-----------------------------------------------
235C S o u r c e L i n e s
236C-----------------------------------------------
237 DO i=1,numnod
238 azero(1,i) = zero
239 azero(2,i) = zero
240 azero(3,i) = zero
241 ENDDO
242 noint = ipari(15,nin)
243 multimp = ipari(23,nin)
244 ign = ipari(36,nin)
245 ige = ipari(34,nin)
246 lwat = 4*(nme+100)+4*(nmes+100)
247C
248 mx_cand=multimp*ipari(18,nin)
249 startt = intbuf_tab%VARIABLES(3)
250 stopt = intbuf_tab%VARIABLES(11)
251 IF(startt>tt) RETURN
252 IF(tt>stopt) RETURN
253C -------------------------------------------------------------
254C -------------------------------------------------------------
255C-----------------------------------------------
256C Fat (Deplace de I7for3 A here for Maje before SPMD Exchange)
257C-----------------------------------------------
258 CALL i17frot(
259 1 itask,intbuf_tab%FROTM,intbuf_tab%FROTS,nme,nmes)
260C=======================================================================
261C Test to know whether to retriate + initialization
262C=======================================================================
263 dist = intbuf_tab%VARIABLES(5)
264 CALL my_barrier
265C -------------------------------------------------------------
266 IF(dist<zero) THEN
267 retri=1
268 tzinf = intbuf_tab%VARIABLES(8)
269 minbox = intbuf_tab%VARIABLES(12)
270 intbuf_tab%VARIABLES(5) = abs(intbuf_tab%VARIABLES(5))
271C bminma reversed compared to other contact interfaces
272 bminma(1)=ep30
273 bminma(2)=ep30
274 bminma(3)=ep30
275 bminma(4)=-ep30
276 bminma(5)=-ep30
277 bminma(6)=-ep30
278C=======================================================================
279C TRI
280C=======================================================================
281 ipari(35,nin) = 0
282C BARRIER INIT BMINMA
283 CALL my_barrier
284C -------------------------------------------------------------
285C CALCULATION BORNE DOMAINE REMONTE IN I17XSAVE
286C -------------------------------------------------------------
287 CALL i17xsave(
288 1 x ,v ,azero ,ixs ,ixs16,
289 2 nmes ,nme_t ,esh_t ,igrbric(ige)%ENTITY,igrbric(ign)%ENTITY,
290 3 eminx ,itask ,intbuf_tab%XSAV,xminl ,yminl ,
291 3 zminl ,xmaxl ,ymaxl ,zmaxl )
292#include "lockon.inc"
293 bminma(1) = min(bminma(1),xminl)
294 bminma(2) = min(bminma(2),yminl)
295 bminma(3) = min(bminma(3),zminl)
296 bminma(4) = max(bminma(4),xmaxl)
297 bminma(5) = max(bminma(5),ymaxl)
298 bminma(6) = max(bminma(6),zmaxl)
299#include "lockoff.inc"
300C BARRIER BMINMA
301 CALL my_barrier
302 IF(itask==0)THEN
303 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
304 + abs(bminma(5)-bminma(2))>2*ep30.OR.
305 + abs(bminma(4)-bminma(1))>2*ep30)THEN
306 CALL ancmsg(msgid=87,anmode=aninfo,
307 . i1=noint)
308 CALL arret(2)
309 END IF
310 bminma(1) = bminma(1) - tzinf
311 bminma(2) = bminma(2) - tzinf
312 bminma(3) = bminma(3) - tzinf
313 bminma(4) = bminma(4) + tzinf
314 bminma(5) = bminma(5) + tzinf
315 bminma(6) = bminma(6) + tzinf
316 nmesr = 0
317 IF(nspmd>1)THEN
318C -------------------------------------------------------------
319C retrieval of remote nodes nmesr stored in xrem
320C -------------------------------------------------------------
321 CALL spmd_tri17box(
322 1 igrbric(ign)%ENTITY ,nmes ,x ,v ,intbuf_tab%FROTS ,
323 2 intbuf_tab%KS,bminma ,weight,nin ,isendto ,
324 3 irecvfrom ,nmesr ,ixs ,ixs16,eminx(1,nme+1))
325 END IF
326 END IF
327 nb_n_b = 1
328C -------------------------------------------------------------
329 CALL my_barrier
330C -------------------------------------------------------------
331 CALL i17buce_pena(
332 1 igrbric(ign)%ENTITY,ixs ,ixs16 ,ixs20 ,igrbric(ige)%ENTITY,
333 2 nme_t ,lwat ,nmes ,intbuf_tab%CAND_E,
334 . intbuf_tab%CAND_N,
335 3 noint ,ipari(35,nin) ,tzinf ,minbox ,eminx ,
336 4 intbuf_tab%XSAV,itask ,x ,azero ,azero ,
337 5 mx_cand ,eminx(1,nme+1),esh_t ,intbuf_tab%FROTS,intbuf_tab%KS,
338 6 nin ,nmesr ,nb_n_b ,bminma )
339C -------------------------------------------------------------
340 CALL my_barrier
341C -------------------------------------------------------------
342 IF(nspmd>1)THEN
343!$OMP SINGLE
344 IF (imonm > 0) CALL startime(timers,26)
345 intbuf_tab%VARIABLES(5) = -intbuf_tab%VARIABLES(5)
346 result = 0
347C Comm spmd after sorting (compacting)
348 CALL spmd_tri17gat(
349 1 result ,nmes ,intbuf_tab%CAND_N,ipari(35,nin),nin,
350 2 nmesr )
351C saving of additional candidates in ipari(24), not needed as there is no inacti
352c IPARI(24,NIN) = NMESR
353 IF (imonm > 0) CALL stoptime(timers,26)
354!$OMP END SINGLE
355
356 END IF
357 ENDIF
358C
359 RETURN
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
i17frot
subroutine i17frot(itask, frotm, frots, nme, nse)
Definition i17main_pena.F:490
i17xsave
subroutine i17xsave(x, v, a, ixs, ixs16, nmes, nme_t, esh_t, nelem, neles, eminxm, itask, xsav, xmin, ymin, zmin, xmax, ymax, zmax)
Definition i17xsave.F:36
min
#define min(a, b)
Definition macros.h:20
message_mod
Definition message_mod.F:1257
spmd_tri17gat
subroutine spmd_tri17gat(result, nmes, cand_n, i_stok, nin, nmesr)
Definition spmd_i7crit.F:2700
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
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135