OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i3fri3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "parit_c.inc"
#include "scr18_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i3fri3 (lft, llt, nft, x, e, irect, msr, nsv, irtl, nty, cst, irtlo, fric0, fric, imast, fsav, fskyi, isky, fcont, h3d_data, n1, n2, n3, ix1, ix2, ix3, ix4, h1, h2, h3, h4, ssc, ttc, xface, stif, xp, yp, zp, fni)
subroutine i5fri3 (lft, llt, nft, ipari, x, e, irect, msr, nsv, irtl, nty, cst, irtlo, fric0, fric, imast, fsav, fskyi, isky, fcont, v, cf, frot_p, freq, ftsav, ftcont, h3d_data, n1, n2, n3, ix1, ix2, ix3, ix4, xp, yp, zp, ssc, ttc, xface, stif, h1, h2, h3, h4, area, fni)

Function/Subroutine Documentation

◆ i3fri3()

subroutine i3fri3 ( integer lft,
integer llt,
integer nft,
x,
e,
integer, dimension(4,*) irect,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
integer nty,
cst,
integer, dimension(*) irtlo,
fric0,
fric,
integer imast,
fsav,
fskyi,
integer, dimension(*) isky,
fcont,
type(h3d_database) h3d_data,
intent(in) n1,
intent(in) n2,
intent(in) n3,
integer, dimension(mvsiz), intent(in) ix1,
integer, dimension(mvsiz), intent(in) ix2,
integer, dimension(mvsiz), intent(in) ix3,
integer, dimension(mvsiz), intent(in) ix4,
intent(in) h1,
intent(in) h2,
intent(in) h3,
intent(in) h4,
intent(in) ssc,
intent(in) ttc,
intent(in) xface,
intent(in) stif,
intent(in) xp,
intent(in) yp,
intent(in) zp,
intent(in) fni )

Definition at line 31 of file i3fri3.F.

40! 1 FX2 ,FX3 ,FX4 ,FY1 ,FY2 ,
41! 2 FY3 ,FY4 ,FZ1 ,FZ2 ,FZ3 ,
42! 3 FZ4 )
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE h3d_mod
47 USE anim_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52#include "comlock.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "scr07_c.inc"
61#include "scr14_c.inc"
62#include "scr16_c.inc"
63#include "com06_c.inc"
64#include "com08_c.inc"
65#include "parit_c.inc"
66#include "scr18_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER NTY, IMAST,LFT, LLT, NFT
71 my_real
72 . fric
73 INTEGER IRECT(4,*), MSR(*), NSV(*), IRTL(*), IRTLO(*), ISKY(*)
74 my_real
75 . x(3,*), e(*), cst(2,*), fric0(3,*), fsav(*),
76 . fskyi(lskyi,nfskyi),fcont(3,*)
77 TYPE(H3D_DATABASE) :: H3D_DATA
78 my_real, DIMENSION(MVSIZ), INTENT(IN) :: n1,n2,n3
79 INTEGER, DIMENSION(MVSIZ), INTENT(IN):: IX1,IX2,IX3,IX4
80 my_real, DIMENSION(MVSIZ), INTENT(IN) :: h1,h2,h3,h4
81 my_real, DIMENSION(MVSIZ), INTENT(IN) :: ssc,ttc,xface,stif
82 my_real, DIMENSION(MVSIZ), INTENT(IN) :: xp,yp,zp,fni
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER I, IL, LOLD, JJ, NN, J3,
87 . J2, J1, IG, I3, I2, I1
88 INTEGER NISKYL
89 my_real
90 . h(4), xx1(4), xx2(4), xx3(4),ss0, tt0, xc,
91 . yc, zc, xc0, yc0, zc0, sp, sm, tp, tm, ansx, ansy, ansz, fmax,
92 . stf, fti, fn, tn1, tn2, tn3, tn, dtm, econvt
93 my_real, DIMENSION(MVSIZ) :: fxi,fyi,fzi
94 my_real, DIMENSION(MVSIZ) :: fx1,fx2,fx3,fx4
95 my_real, DIMENSION(MVSIZ) :: fy1,fy2,fy3,fy4
96 my_real, DIMENSION(MVSIZ) :: fz1,fz2,fz3,fz4
97C-----------------------------------------------
98C Source Lines
99C-----------------------------------------------
100 DO 300 i=lft,llt
101 fxi(i)=zero
102 fyi(i)=zero
103 fzi(i)=zero
104 il=i+nft
105 econvt = zero
106 IF(xface(i)==zero) THEN
107C-------------------------------
108C POINT NON IMPACTE
109C-------------------------------
110 irtlo(il)=0
111 fric0(1,il)=zero
112 fric0(2,il)=zero
113 fric0(3,il)=zero
114 ELSE
115C
116 lold=iabs(irtlo(il))
117 IF(lold==0)THEN
118C-------------------------------
119C POINT NON IMPACTE PRECEDEMENT
120C-------------------------------
121 irtlo(il)=irtl(il)*xface(i)
122 cst(1,il)=ssc(i)
123 cst(2,il)=ttc(i)
124 ELSE
125C-------------------------------
126C POINT IMPACTE PRECEDEMENT
127C-------------------------------
128 ss0=cst(1,il)
129 tt0=cst(2,il)
130 fxi(i)=fric0(1,il)
131 fyi(i)=fric0(2,il)
132 fzi(i)=fric0(3,il)
133C
134 xc=xp(i)
135 yc=yp(i)
136 zc=zp(i)
137 DO jj=1,4
138 nn=msr(irect(jj,lold))
139 xx1(jj)=x(1,nn)
140 xx2(jj)=x(2,nn)
141 xx3(jj)=x(3,nn)
142 ENDDO
143 xc0=zero
144 yc0=zero
145 zc0=zero
146 sp=one+ss0
147 sm=one-ss0
148 tp= fourth*(one+tt0)
149 tm= fourth*(one-tt0)
150 h(1)=tm*sm
151 h(2)=tm*sp
152 h(3)=tp*sp
153 h(4)=tp*sm
154 DO jj=1,4
155 xc0=xc0+h(jj)*xx1(jj)
156 yc0=yc0+h(jj)*xx2(jj)
157 zc0=zc0+h(jj)*xx3(jj)
158 ENDDO
159 ansx= (xc-xc0)
160 ansy= (yc-yc0)
161 ansz= (zc-zc0)
162 econvt = econvt + half*(fxi(i)*ansx+fyi(i)*ansy+fzi(i)*ansz)
163C
164 fmax= -min(fric*fni(i),zero)
165C
166 stf=em01*stif(i)
167 fxi(i)=fxi(i) + ansx*stf
168 fyi(i)=fyi(i) + ansy*stf
169 fzi(i)=fzi(i) + ansz*stf
170 fti=sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))
171C
172 fn=fxi(i)*n1(i)+fyi(i)*n2(i)+fzi(i)*n3(i)
173 tn1=fxi(i)-n1(i)*fn
174 tn2=fyi(i)-n2(i)*fn
175 tn3=fzi(i)-n3(i)*fn
176 tn=sqrt(tn1*tn1+tn2*tn2+tn3*tn3)
177 IF(tn/=zero)THEN
178 tn1=tn1/tn
179 tn2=tn2/tn
180 tn3=tn3/tn
181 ELSE
182 tn3=zero
183 tn=sqrt(n1(i)*n1(i)+n2(i)*n2(i))
184 IF(tn/=zero)THEN
185 tn2=-n1(i)/tn
186 tn1=n2(i)/tn
187 ELSE
188 tn2=zero
189 tn1=one
190 ENDIF
191 ENDIF
192C
193 IF(fti>fmax)THEN
194C-------------------------------
195C POINT GLISSANT
196C-------------------------------
197 fxi(i)=tn1*fmax
198 fyi(i)=tn2*fmax
199 fzi(i)=tn3*fmax
200 fric0(1,il)=fxi(i)
201 fric0(2,il)=fyi(i)
202 fric0(3,il)=fzi(i)
203 irtlo(il)=irtl(il)*xface(i)
204 cst(1,il)=ssc(i)
205 cst(2,il)=ttc(i)
206 ELSE
207C-------------------------------
208C POINT NON GLISSANT
209C-------------------------------
210 fxi(i)=tn1*fti
211 fyi(i)=tn2*fti
212 fzi(i)=tn3*fti
213 ENDIF
214 econvt = econvt + half*(fxi(i)*ansx+fyi(i)*ansy+fzi(i)*ansz)
215 ENDIF
216 ENDIF
217C
218 300 CONTINUE
219C
220C
221!$OMP ATOMIC
222 econtv = econtv + econvt ! Frictional contact energy
223!$OMP ATOMIC
224 fsav(27) = fsav(27) + econvt
225C---------------------------------
226C SAUVEGARDE DE L'IMPULSION TOTALE
227C---------------------------------
228 dtm=imast*dt12
229 DO 350 i=lft,llt
230 fsav(4)=fsav(4)+fxi(i)*dtm
231 fsav(5)=fsav(5)+fyi(i)*dtm
232 fsav(6)=fsav(6)+fzi(i)*dtm
233 350 CONTINUE
234C
235C
236 DO 400 i=lft,llt
237 fx1(i)=fxi(i)*h1(i)
238 fy1(i)=fyi(i)*h1(i)
239 fz1(i)=fzi(i)*h1(i)
240C
241 fx2(i)=fxi(i)*h2(i)
242 fy2(i)=fyi(i)*h2(i)
243 fz2(i)=fzi(i)*h2(i)
244C
245 fx3(i)=fxi(i)*h3(i)
246 fy3(i)=fyi(i)*h3(i)
247 fz3(i)=fzi(i)*h3(i)
248C
249 fx4(i)=fxi(i)*h4(i)
250 fy4(i)=fyi(i)*h4(i)
251 fz4(i)=fzi(i)*h4(i)
252 400 CONTINUE
253C
254 IF(iparit==0)THEN
255C---------------------------------
256C FRICTION MAIN
257C---------------------------------
258 DO i=lft,llt
259 il=i+nft
260 j3=3*ix1(i)
261 j2=j3-1
262 j1=j2-1
263 e(j1)=e(j1)+fx1(i)
264 e(j2)=e(j2)+fy1(i)
265 e(j3)=e(j3)+fz1(i)
266C
267 j3=3*ix2(i)
268 j2=j3-1
269 j1=j2-1
270 e(j1)=e(j1)+fx2(i)
271 e(j2)=e(j2)+fy2(i)
272 e(j3)=e(j3)+fz2(i)
273C
274 j3=3*ix3(i)
275 j2=j3-1
276 j1=j2-1
277 e(j1)=e(j1)+fx3(i)
278 e(j2)=e(j2)+fy3(i)
279 e(j3)=e(j3)+fz3(i)
280C
281 j3=3*ix4(i)
282 j2=j3-1
283 j1=j2-1
284 e(j1)=e(j1)+fx4(i)
285 e(j2)=e(j2)+fy4(i)
286 e(j3)=e(j3)+fz4(i)
287C---------------------------------
288C FRICTION SECND
289C---------------------------------
290 ig=nsv(il)
291 i3=3*ig
292 i2=i3-1
293 i1=i2-1
294 e(i1)=e(i1)-fxi(i)
295 e(i2)=e(i2)-fyi(i)
296 e(i3)=e(i3)-fzi(i)
297C
298 ENDDO
299C
300 ELSE
301C
302#include "lockon.inc"
303 niskyl = nisky
304 nisky = nisky + 5 * llt
305#include "lockoff.inc"
306C
307 IF(kdtint==0)THEN
308 DO i=lft,llt
309 niskyl = niskyl + 1
310 fskyi(niskyl,1)=fx1(i)
311 fskyi(niskyl,2)=fy1(i)
312 fskyi(niskyl,3)=fz1(i)
313 fskyi(niskyl,4)=zero
314 isky(niskyl) = ix1(i)
315 niskyl = niskyl + 1
316 fskyi(niskyl,1)=fx2(i)
317 fskyi(niskyl,2)=fy2(i)
318 fskyi(niskyl,3)=fz2(i)
319 fskyi(niskyl,4)=zero
320 isky(niskyl) = ix2(i)
321 niskyl = niskyl + 1
322 fskyi(niskyl,1)=fx3(i)
323 fskyi(niskyl,2)=fy3(i)
324 fskyi(niskyl,3)=fz3(i)
325 fskyi(niskyl,4)=zero
326 isky(niskyl) = ix3(i)
327 niskyl = niskyl + 1
328 fskyi(niskyl,1)=fx4(i)
329 fskyi(niskyl,2)=fy4(i)
330 fskyi(niskyl,3)=fz4(i)
331 fskyi(niskyl,4)=zero
332 isky(niskyl) = ix4(i)
333 niskyl = niskyl + 1
334 fskyi(niskyl,1)=-fxi(i)
335 fskyi(niskyl,2)=-fyi(i)
336 fskyi(niskyl,3)=-fzi(i)
337 fskyi(niskyl,4)=zero
338 il=i+nft
339 isky(niskyl) = nsv(il)
340 ENDDO
341 ELSE
342 DO i=lft,llt
343 niskyl = niskyl + 1
344 fskyi(niskyl,1)=fx1(i)
345 fskyi(niskyl,2)=fy1(i)
346 fskyi(niskyl,3)=fz1(i)
347 fskyi(niskyl,4)=zero
348 fskyi(niskyl,5)=zero
349 isky(niskyl) = ix1(i)
350 niskyl = niskyl + 1
351 fskyi(niskyl,1)=fx2(i)
352 fskyi(niskyl,2)=fy2(i)
353 fskyi(niskyl,3)=fz2(i)
354 fskyi(niskyl,4)=zero
355 fskyi(niskyl,5)=zero
356 isky(niskyl) = ix2(i)
357 niskyl = niskyl + 1
358 fskyi(niskyl,1)=fx3(i)
359 fskyi(niskyl,2)=fy3(i)
360 fskyi(niskyl,3)=fz3(i)
361 fskyi(niskyl,4)=zero
362 fskyi(niskyl,5)=zero
363 isky(niskyl) = ix3(i)
364 niskyl = niskyl + 1
365 fskyi(niskyl,1)=fx4(i)
366 fskyi(niskyl,2)=fy4(i)
367 fskyi(niskyl,3)=fz4(i)
368 fskyi(niskyl,4)=zero
369 fskyi(niskyl,5)=zero
370 isky(niskyl) = ix4(i)
371 niskyl = niskyl + 1
372 fskyi(niskyl,1)=-fxi(i)
373 fskyi(niskyl,2)=-fyi(i)
374 fskyi(niskyl,3)=-fzi(i)
375 fskyi(niskyl,4)=zero
376 fskyi(niskyl,5)=zero
377 il=i+nft
378 isky(niskyl) = nsv(il)
379 ENDDO
380 ENDIF
381 ENDIF
382C
383 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0.AND.
384 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
385 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
386#include "lockon.inc"
387 DO i=1,llt
388 fcont(1,ix1(i)) =fcont(1,ix1(i)) + fx1(i)
389 fcont(2,ix1(i)) =fcont(2,ix1(i)) + fy1(i)
390 fcont(3,ix1(i)) =fcont(3,ix1(i)) + fz1(i)
391 fcont(1,ix2(i)) =fcont(1,ix2(i)) + fx2(i)
392 fcont(2,ix2(i)) =fcont(2,ix2(i)) + fy2(i)
393 fcont(3,ix2(i)) =fcont(3,ix2(i)) + fz2(i)
394 fcont(1,ix3(i)) =fcont(1,ix3(i)) + fx3(i)
395 fcont(2,ix3(i)) =fcont(2,ix3(i)) + fy3(i)
396 fcont(3,ix3(i)) =fcont(3,ix3(i)) + fz3(i)
397 fcont(1,ix4(i)) =fcont(1,ix4(i)) + fx4(i)
398 fcont(2,ix4(i)) =fcont(2,ix4(i)) + fy4(i)
399 fcont(3,ix4(i)) =fcont(3,ix4(i)) + fz4(i)
400 fcont(1,nsv(i+nft))=fcont(1,nsv(i+nft))- fxi(i)
401 fcont(2,nsv(i+nft))=fcont(2,nsv(i+nft))- fyi(i)
402 fcont(3,nsv(i+nft))=fcont(3,nsv(i+nft))- fzi(i)
403 ENDDO
404#include "lockoff.inc"
405 ENDIF
406C
407 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
anim_mod
Definition anim_mod.F:96
h3d_mod
Definition h3d_mod.F:308

◆ i5fri3()

subroutine i5fri3 ( integer lft,
integer llt,
integer nft,
integer, dimension(*) ipari,
x,
e,
integer, dimension(4,*) irect,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
integer nty,
cst,
integer, dimension(*) irtlo,
fric0,
fric,
integer imast,
fsav,
fskyi,
integer, dimension(*) isky,
fcont,
v,
cf,
frot_p,
freq,
ftsav,
ftcont,
type(h3d_database) h3d_data,
intent(in) n1,
intent(in) n2,
intent(in) n3,
integer, dimension(mvsiz), intent(in) ix1,
integer, dimension(mvsiz), intent(in) ix2,
integer, dimension(mvsiz), intent(in) ix3,
integer, dimension(mvsiz), intent(in) ix4,
intent(in) xp,
intent(in) yp,
intent(in) zp,
intent(in) ssc,
intent(in) ttc,
intent(in) xface,
intent(in) stif,
intent(in) h1,
intent(in) h2,
intent(in) h3,
intent(in) h4,
intent(in) area,
intent(in) fni )

Definition at line 418 of file i3fri3.F.

428C-----------------------------------------------
429C M o d u l e s
430C-----------------------------------------------
431 USE h3d_mod
432 USE anim_mod
433C-----------------------------------------------
434C I m p l i c i t T y p e s
435C-----------------------------------------------
436#include "implicit_f.inc"
437#include "comlock.inc"
438C-----------------------------------------------
439C G l o b a l P a r a m e t e r s
440C-----------------------------------------------
441#include "mvsiz_p.inc"
442C-----------------------------------------------
443C C o m m o n B l o c k s
444C-----------------------------------------------
445#include "scr03_c.inc"
446#include "scr07_c.inc"
447#include "scr14_c.inc"
448#include "scr16_c.inc"
449#include "com06_c.inc"
450#include "com08_c.inc"
451#include "parit_c.inc"
452#include "scr18_c.inc"
453#include "impl1_c.inc"
454C-----------------------------------------------
455C D u m m y A r g u m e n t s
456C-----------------------------------------------
457 INTEGER IPARI(*), NTY, IMAST, LFT, LLT, NFT
458 my_real fric
459 INTEGER IRECT(4,*), MSR(*), NSV(*), IRTL(*), IRTLO(*), ISKY(*)
460 my_real x(3,*), e(*), cst(2,*), fric0(3,*), fsav(*),
461 . fskyi(lskyi,nfskyi),
462 . v(3,*), fcont(3,*),cf(*), freq, frot_p(*),ftsav(*),
463 . ftcont(3,*)
464 TYPE(H3D_DATABASE) :: H3D_DATA
465 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX1,IX2,IX3,IX4
466 my_real, DIMENSION(MVSIZ), INTENT(IN) :: n1,n2,n3
467 my_real, DIMENSION(MVSIZ), INTENT(IN) :: xp,yp,zp
468 my_real, DIMENSION(MVSIZ), INTENT(IN) :: ssc,ttc,xface,stif
469 my_real, DIMENSION(MVSIZ), INTENT(IN) :: h1,h2,h3,h4,area,fni
470C-----------------------------------------------
471C L o c a l V a r i a b l e s
472C-----------------------------------------------
473 INTEGER I, IL, LOLD, JJ, NN, J3,J2, J1, IG, I3, I2, I1, K, IFQ, MFROT, NISKYL
474 my_real
475 . h(4), xx1(4), xx2(4), xx3(4),
476 . fxi(mvsiz), fyi(mvsiz),
477 . fzi(mvsiz), fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz), fy1(mvsiz), fy2(mvsiz),
478 . fy3(mvsiz), fy4(mvsiz), fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
479 . ss0, tt0, xc, econvt, alpha, alphi,
480 . yc, zc, xc0, yc0, zc0, sp, sm, tp, tm, ansx, ansy, ansz, fmax,
481 . stf, fti, fn, tn1, tn2, tn3, tn, dtm, xmu, vx,vy,vz,vv,v2,p,
482 . vv1,vv2,v21,dmu,aa
483 INTEGER IRTLO_I(MVSIZ)
484 my_real fric0_i(3,mvsiz)
485C-----------------------------------------------
486C S o u r c e L i n e s
487C-----------------------------------------------
488C------for implicit run---save previous values-
489 IF (inconv/=1) THEN
490 DO i=lft,llt
491 il=i+nft
492 irtlo_i(i)=irtlo(il)
493 fric0_i(1,i)=fric0(1,il)
494 fric0_i(2,i)=fric0(2,il)
495 fric0_i(3,i)=fric0(3,il)
496 ENDDO
497 ENDIF
498 DO 300 i=lft,llt
499 fxi(i)=zero
500 fyi(i)=zero
501 fzi(i)=zero
502 il=i+nft
503 econvt = zero
504 IF(xface(i)==zero) THEN
505C-------------------------------
506C Point without Impact
507C-------------------------------
508 irtlo(il)=0
509 fric0(1,il)=zero
510 fric0(2,il)=zero
511 fric0(3,il)=zero
512 ELSE
513C
514 lold=iabs(irtlo(il))
515 IF(lold==0)THEN
516C-------------------------------
517C Point not impacted previously
518C-------------------------------
519 irtlo(il)=irtl(il)*xface(i)
520 cst(1,il)=ssc(i)
521 cst(2,il)=ttc(i)
522 ELSE
523C-------------------------------
524C Point previously impacted
525C-------------------------------
526 ss0=cst(1,il)
527 tt0=cst(2,il)
528 fxi(i)=fric0(1,il)
529 fyi(i)=fric0(2,il)
530 fzi(i)=fric0(3,il)
531C
532 xc=xp(i)
533 yc=yp(i)
534 zc=zp(i)
535 DO jj=1,4
536 nn=msr(irect(jj,lold))
537 xx1(jj)=x(1,nn)
538 xx2(jj)=x(2,nn)
539 xx3(jj)=x(3,nn)
540 ENDDO
541 xc0=zero
542 yc0=zero
543 zc0=zero
544 sp=one+ss0
545 sm=one-ss0
546 tp=fourth*(one + tt0)
547 tm=fourth*(one - tt0)
548 h(1)=tm*sm
549 h(2)=tm*sp
550 h(3)=tp*sp
551 h(4)=tp*sm
552 DO jj=1,4
553 xc0=xc0+h(jj)*xx1(jj)
554 yc0=yc0+h(jj)*xx2(jj)
555 zc0=zc0+h(jj)*xx3(jj)
556 ENDDO
557 ansx= (xc-xc0)
558 ansy= (yc-yc0)
559 ansz= (zc-zc0)
560 econvt = econvt + half*(fxi(i)*ansx+fyi(i)*ansy+fzi(i)*ansz)
561 stf=em01*stif(i)
562 fxi(i)=fxi(i) + ansx*stf
563 fyi(i)=fyi(i) + ansy*stf
564 fzi(i)=fzi(i) + ansz*stf
565C---- Filtrage du frottement
566 IF (codvers>=44) THEN
567 ifq = ipari(31)
568 IF (ifq>0) THEN
569 IF (ifq==3) freq = max(one,freq*dt12)
570 alpha = freq
571 alphi = one - alpha
572 k = 3*(il-1)
573 IF (fni(i)==0) THEN
574 ftsav(k+1) = zero
575 ftsav(k+2) = zero
576 ftsav(k+3) = zero
577 ELSE
578 fxi(i)= alpha*fxi(i) + alphi*ftsav(k+1)
579 fyi(i)= alpha*fyi(i) + alphi*ftsav(k+2)
580 fzi(i)= alpha*fzi(i) + alphi*ftsav(k+3)
581 IF (inconv==1) THEN
582 ftsav(k+1) = fxi(i)
583 ftsav(k+2) = fyi(i)
584 ftsav(k+3) = fzi(i)
585 ENDIF
586 ENDIF
587 ENDIF
588 ENDIF
589 fti=sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))
590C
591 fn =fxi(i)*n1(i)+fyi(i)*n2(i)+fzi(i)*n3(i)
592 tn1=fxi(i)-n1(i)*fn
593 tn2=fyi(i)-n2(i)*fn
594 tn3=fzi(i)-n3(i)*fn
595 tn =sqrt(tn1*tn1+tn2*tn2+tn3*tn3)
596 IF(tn/=zero)THEN
597 tn1=tn1/tn
598 tn2=tn2/tn
599 tn3=tn3/tn
600 ELSE
601 tn3=zero
602 tn=sqrt(n1(i)*n1(i)+n2(i)*n2(i))
603 IF(tn/=zero)THEN
604 tn2=-n1(i)/tn
605 tn1= n2(i)/tn
606 ELSE
607 tn2=zero
608 tn1=one
609 ENDIF
610 ENDIF
611C
612 p = -fni(i)/area(i)
613 xmu = fric
614 IF(codvers>=44) THEN
615C---------------------------------
616C NEW FRICTION MODELS
617C---------------------------------
618 mfrot = ipari(30)
619 IF(mfrot>=1) THEN
620 ig=nsv(il)
621 vx = v(1,ig) - h(1)*v(1,ix1(i)) - h(2)*v(1,ix2(i))
622 . - h(3)*v(1,ix3(i)) - h(4)*v(1,ix4(i))
623 vy = v(2,ig) - h(1)*v(2,ix1(i)) - h(2)*v(2,ix2(i))
624 . - h(3)*v(2,ix3(i)) - h(4)*v(2,ix4(i))
625 vz = v(3,ig) - h(1)*v(3,ix1(i)) - h(2)*v(3,ix2(i))
626 . - h(3)*v(3,ix3(i)) - h(4)*v(3,ix4(i))
627C--- tangantial velocities
628 aa = n1(i)*vx + n2(i)*vy + n3(i)*vz
629 vx = vx - n1(i)*aa
630 vy = vy - n2(i)*aa
631 vz = vz - n3(i)*aa
632 v2 = vx*vx + vy*vy + vz*vz
633 vv = sqrt(max(em30, v2))
634 ENDIF
635 IF(mfrot==1)THEN
636 xmu = fric + (frot_p(1) + frot_p(4)*p ) * p
637 . +(frot_p(2) + frot_p(3)*p) * vv + frot_p(5)*v2
638 ELSEIF(mfrot==2)THEN
639C--- Darmstad's law
640 xmu = fric
641 . + frot_p(1)*exp(frot_p(2)*vv)*p**2
642 . + frot_p(3)*exp(frot_p(4)*vv)*p
643 . + frot_p(5)*exp(frot_p(6)*vv)
644 ELSEIF(mfrot==3)THEN
645C--- Renard's law
646 IF(vv>=0.AND.vv<=frot_p(5)) THEN
647 dmu = frot_p(3)-frot_p(1)
648 vv1 = vv / frot_p(5)
649 xmu = frot_p(1)+ dmu*vv1*(two-vv1)
650 ELSEIF(vv>frot_p(5).AND.vv<frot_p(6)) THEN
651 dmu = frot_p(4)-frot_p(3)
652 vv1 = (vv - frot_p(5))/(frot_p(6)-frot_p(5))
653 xmu = frot_p(3)+ dmu * (three-two*vv1)*vv1**2
654 ELSE
655 dmu = frot_p(2)-frot_p(4)
656 vv2 = (vv - frot_p(6))**2
657 xmu = frot_p(2) - dmu / (one + dmu*vv2)
658 ENDIF
659 ENDIF
660 fmax = -min(xmu*fni(i),zero)
661 IF(fti>fmax)THEN
662C--- sliding
663 fxi(i)=tn1*fmax
664 fyi(i)=tn2*fmax
665 fzi(i)=tn3*fmax
666 fric0(1,il)=fxi(i)
667 fric0(2,il)=fyi(i)
668 fric0(3,il)=fzi(i)
669 irtlo(il)=irtl(il)*xface(i)
670 cst(1,il)=ssc(i)
671 cst(2,il)=ttc(i)
672 ELSE
673C--- tied
674 fxi(i)=tn1*fti
675 fyi(i)=tn2*fti
676 fzi(i)=tn3*fti
677 ENDIF
678 ELSE
679C-----------------------------------------------------
680C CODVERS < 44
681C-----------------------------------------------------
682 ig=nsv(il)
683 vx = v(1,ig) - h(1)*v(1,ix1(i)) - h(2)*v(1,ix2(i))
684 . - h(3)*v(1,ix3(i)) - h(4)*v(1,ix4(i))
685 vy = v(2,ig) - h(1)*v(2,ix1(i)) - h(2)*v(2,ix2(i))
686 . - h(3)*v(2,ix3(i)) - h(4)*v(2,ix4(i))
687 vz = v(3,ig) - h(1)*v(3,ix1(i)) - h(2)*v(3,ix2(i))
688 . - h(3)*v(3,ix3(i)) - h(4)*v(3,ix4(i))
689 vv = vx*vx + vy*vy + vz*vz
690 xmu = fric + ( cf(1) + cf(4)*p ) * p
691 . + ( cf(2) + cf(3)*p ) * sqrt(vv) + cf(5)*vv
692 fmax= -min(xmu*fni(i),zero)
693 IF(fti>fmax)THEN
694C------------------------------------------------
695C SLIDING POINT
696C-------------------------------
697 fxi(i)=tn1*fmax
698 fyi(i)=tn2*fmax
699 fzi(i)=tn3*fmax
700 fric0(1,il)=fxi(i)
701 fric0(2,il)=fyi(i)
702 fric0(3,il)=fzi(i)
703 irtlo(il)=irtl(il)*xface(i)
704 cst(1,il)=ssc(i)
705 cst(2,il)=ttc(i)
706 ELSE
707C-------------------------------
708C NON SLIDING POINTS
709C-------------------------------
710 fxi(i)=tn1*fti
711 fyi(i)=tn2*fti
712 fzi(i)=tn3*fti
713 ENDIF
714 ENDIF
715 econvt = econvt + half*(fxi(i)*ansx+fyi(i)*ansy+fzi(i)*ansz)
716 ENDIF
717 ENDIF
718C
719 300 CONTINUE
720C
721 IF (inconv==1) THEN
722!$OMP ATOMIC
723 econtv = econtv + econvt ! Frictional contact energy
724!$OMP ATOMIC
725 fsav(27) = fsav(27) + econvt
726C---------------------------------
727C TOTAL IMPULSE BACKUP
728C---------------------------------
729 dtm=imast*dt12
730 DO i=lft,llt
731 fsav(4)=fsav(4)+fxi(i)*dtm
732 fsav(5)=fsav(5)+fyi(i)*dtm
733 fsav(6)=fsav(6)+fzi(i)*dtm
734 ENDDO
735 END IF !(INCONV==1) THEN
736C
737 DO i=lft,llt
738 fx1(i)=fxi(i)*h1(i)
739 fy1(i)=fyi(i)*h1(i)
740 fz1(i)=fzi(i)*h1(i)
741C
742 fx2(i)=fxi(i)*h2(i)
743 fy2(i)=fyi(i)*h2(i)
744 fz2(i)=fzi(i)*h2(i)
745C
746 fx3(i)=fxi(i)*h3(i)
747 fy3(i)=fyi(i)*h3(i)
748 fz3(i)=fzi(i)*h3(i)
749C
750 fx4(i)=fxi(i)*h4(i)
751 fy4(i)=fyi(i)*h4(i)
752 fz4(i)=fzi(i)*h4(i)
753 ENDDO
754C
755 IF(iparit==0)THEN
756C---------------------------------
757C FRICTION MAIN
758C---------------------------------
759 DO i=lft,llt
760 il=i+nft
761 j3=3*ix1(i)
762 j2=j3-1
763 j1=j2-1
764 e(j1)=e(j1)+fx1(i)
765 e(j2)=e(j2)+fy1(i)
766 e(j3)=e(j3)+fz1(i)
767C
768 j3=3*ix2(i)
769 j2=j3-1
770 j1=j2-1
771 e(j1)=e(j1)+fx2(i)
772 e(j2)=e(j2)+fy2(i)
773 e(j3)=e(j3)+fz2(i)
774C
775 j3=3*ix3(i)
776 j2=j3-1
777 j1=j2-1
778 e(j1)=e(j1)+fx3(i)
779 e(j2)=e(j2)+fy3(i)
780 e(j3)=e(j3)+fz3(i)
781C
782 j3=3*ix4(i)
783 j2=j3-1
784 j1=j2-1
785 e(j1)=e(j1)+fx4(i)
786 e(j2)=e(j2)+fy4(i)
787 e(j3)=e(j3)+fz4(i)
788C---------------------------------
789C FRICTION SECND
790C---------------------------------
791 ig=nsv(il)
792 i3=3*ig
793 i2=i3-1
794 i1=i2-1
795 e(i1)=e(i1)-fxi(i)
796 e(i2)=e(i2)-fyi(i)
797 e(i3)=e(i3)-fzi(i)
798C
799 ENDDO
800C
801 ELSE
802C
803#include "lockon.inc"
804 niskyl = nisky
805 nisky = nisky + 5 * llt
806#include "lockoff.inc"
807C
808 IF(kdtint==0)THEN
809 DO 440 i=lft,llt
810 niskyl = niskyl + 1
811 fskyi(niskyl,1)=fx1(i)
812 fskyi(niskyl,2)=fy1(i)
813 fskyi(niskyl,3)=fz1(i)
814 fskyi(niskyl,4)=zero
815 isky(niskyl) = ix1(i)
816 niskyl = niskyl + 1
817 fskyi(niskyl,1)=fx2(i)
818 fskyi(niskyl,2)=fy2(i)
819 fskyi(niskyl,3)=fz2(i)
820 fskyi(niskyl,4)=zero
821 isky(niskyl) = ix2(i)
822 niskyl = niskyl + 1
823 fskyi(niskyl,1)=fx3(i)
824 fskyi(niskyl,2)=fy3(i)
825 fskyi(niskyl,3)=fz3(i)
826 fskyi(niskyl,4)=zero
827 isky(niskyl) = ix3(i)
828 niskyl = niskyl + 1
829 fskyi(niskyl,1)=fx4(i)
830 fskyi(niskyl,2)=fy4(i)
831 fskyi(niskyl,3)=fz4(i)
832 fskyi(niskyl,4)=zero
833 isky(niskyl) = ix4(i)
834 niskyl = niskyl + 1
835 fskyi(niskyl,1)=-fxi(i)
836 fskyi(niskyl,2)=-fyi(i)
837 fskyi(niskyl,3)=-fzi(i)
838 fskyi(niskyl,4)=zero
839 il=i+nft
840 isky(niskyl) = nsv(il)
841 440 CONTINUE
842 ELSE
843 DO i=lft,llt
844 niskyl = niskyl + 1
845 fskyi(niskyl,1)=fx1(i)
846 fskyi(niskyl,2)=fy1(i)
847 fskyi(niskyl,3)=fz1(i)
848 fskyi(niskyl,4)=zero
849 fskyi(niskyl,5)=zero
850 isky(niskyl) = ix1(i)
851 niskyl = niskyl + 1
852 fskyi(niskyl,1)=fx2(i)
853 fskyi(niskyl,2)=fy2(i)
854 fskyi(niskyl,3)=fz2(i)
855 fskyi(niskyl,4)=zero
856 fskyi(niskyl,5)=zero
857 isky(niskyl) = ix2(i)
858 niskyl = niskyl + 1
859 fskyi(niskyl,1)=fx3(i)
860 fskyi(niskyl,2)=fy3(i)
861 fskyi(niskyl,3)=fz3(i)
862 fskyi(niskyl,4)=zero
863 fskyi(niskyl,5)=zero
864 isky(niskyl) = ix3(i)
865 niskyl = niskyl + 1
866 fskyi(niskyl,1)=fx4(i)
867 fskyi(niskyl,2)=fy4(i)
868 fskyi(niskyl,3)=fz4(i)
869 fskyi(niskyl,4)=zero
870 fskyi(niskyl,5)=zero
871 isky(niskyl) = ix4(i)
872 niskyl = niskyl + 1
873 fskyi(niskyl,1)=-fxi(i)
874 fskyi(niskyl,2)=-fyi(i)
875 fskyi(niskyl,3)=-fzi(i)
876 fskyi(niskyl,4)=zero
877 fskyi(niskyl,5)=zero
878 il=i+nft
879 isky(niskyl) = nsv(il)
880 ENDDO
881 ENDIF
882 ENDIF
883C------for implicit run---restore previous values-
884 IF (inconv/=1) THEN
885 DO i=lft,llt
886 il=i+nft
887 irtlo(il)=irtlo_i(i)
888 fric0(1,il)=fric0_i(1,i)
889 fric0(2,il)=fric0_i(2,i)
890 fric0(3,il)=fric0_i(3,i)
891 ENDDO
892 RETURN
893 ENDIF
894C
895 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0 .AND.
896 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
897 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
898#include "lockon.inc"
899 DO i=1,llt
900 fcont(1,ix1(i)) =fcont(1,ix1(i)) + fx1(i)
901 fcont(2,ix1(i)) =fcont(2,ix1(i)) + fy1(i)
902 fcont(3,ix1(i)) =fcont(3,ix1(i)) + fz1(i)
903 fcont(1,ix2(i)) =fcont(1,ix2(i)) + fx2(i)
904 fcont(2,ix2(i)) =fcont(2,ix2(i)) + fy2(i)
905 fcont(3,ix2(i)) =fcont(3,ix2(i)) + fz2(i)
906 fcont(1,ix3(i)) =fcont(1,ix3(i)) + fx3(i)
907 fcont(2,ix3(i)) =fcont(2,ix3(i)) + fy3(i)
908 fcont(3,ix3(i)) =fcont(3,ix3(i)) + fz3(i)
909 fcont(1,ix4(i)) =fcont(1,ix4(i)) + fx4(i)
910 fcont(2,ix4(i)) =fcont(2,ix4(i)) + fy4(i)
911 fcont(3,ix4(i)) =fcont(3,ix4(i)) + fz4(i)
912 fcont(1,nsv(i+nft))=fcont(1,nsv(i+nft))- fxi(i)
913 fcont(2,nsv(i+nft))=fcont(2,nsv(i+nft))- fyi(i)
914 fcont(3,nsv(i+nft))=fcont(3,nsv(i+nft))- fzi(i)
915 ENDDO
916#include "lockoff.inc"
917 ENDIF
918C
919 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0.AND.
920 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP) .OR.
921 . (manim>=4.AND.manim<=15).OR.h3d_data%MH3D/=0))THEN
922#include "lockon.inc"
923 DO i=1,llt
924 ftcont(1,ix1(i)) =ftcont(1,ix1(i)) + fx1(i)
925 ftcont(2,ix1(i)) =ftcont(2,ix1(i)) + fy1(i)
926 ftcont(3,ix1(i)) =ftcont(3,ix1(i)) + fz1(i)
927 ftcont(1,ix2(i)) =ftcont(1,ix2(i)) + fx2(i)
928 ftcont(2,ix2(i)) =ftcont(2,ix2(i)) + fy2(i)
929 ftcont(3,ix2(i)) =ftcont(3,ix2(i)) + fz2(i)
930 ftcont(1,ix3(i)) =ftcont(1,ix3(i)) + fx3(i)
931 ftcont(2,ix3(i)) =ftcont(2,ix3(i)) + fy3(i)
932 ftcont(3,ix3(i)) =ftcont(3,ix3(i)) + fz3(i)
933 ftcont(1,ix4(i)) =ftcont(1,ix4(i)) + fx4(i)
934 ftcont(2,ix4(i)) =ftcont(2,ix4(i)) + fy4(i)
935 ftcont(3,ix4(i)) =ftcont(3,ix4(i)) + fz4(i)
936 ftcont(1,nsv(i+nft))=ftcont(1,nsv(i+nft))- fxi(i)
937 ftcont(2,nsv(i+nft))=ftcont(2,nsv(i+nft))- fyi(i)
938 ftcont(3,nsv(i+nft))=ftcont(3,nsv(i+nft))- fzi(i)
939 ENDDO
940#include "lockoff.inc"
941 ENDIF
942C
943 RETURN
alpha
#define alpha
Definition eval.h:35
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21