OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_rgwalp.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!|| sms_rgwalp_impact ../engine/source/ams/sms_rgwalp.F
25!||--- called by ------------------------------------------------------
26!|| sms_rgwal_0 ../engine/source/ams/sms_rgwal0.F
27!||====================================================================
28 SUBROUTINE sms_rgwalp_impact(X ,A ,V ,RWL ,NSW ,
29 1 NSN ,ITIED,MSR ,MS ,WEIGHT,
30 2 NIMPACT,IMPACT ,NSMS ,NRWL_SMS)
31C-----------------------------------------------
32C I m p l i c i t T y p e s
33C-----------------------------------------------
34#include "implicit_f.inc"
35#include "comlock.inc"
36C-----------------------------------------------
37C C o m m o n B l o c k s
38C-----------------------------------------------
39#include "com01_c.inc"
40#include "com08_c.inc"
41#include "scr05_c.inc"
42#include "sms_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
47 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
48 my_real x(*), a(*), v(*), rwl(*), ms(*)
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER I, N, N3, N2, N1, K, J, M1, M2, M3
53 my_real XWL, YWL, ZWL, VXW, VYW, VZW,
54 . xl1, yl1, zl1, xl2, yl2, zl2, sx12, sy12, sz12, s12,
55 . vx, vy, vz, ux, uy, uz, xc, yc, zc, dp, dn, xcp, ycp, zcp,
56 . sx1m, sy1m, sz1m, ps, sm1, sxm2, sym2, szm2, sm2, dv, da, dvt,
57 . ax,
58 . xwl0, ywl0, zwl0, dp0, xc0, yc0, zc0, tol, vn, vnold,
59 . dp0dt, dvx, dvy, dvz, prec, xprec
60C-----------------------------------------------
61 IF(iresp==1)THEN
62 prec=em07
63 END IF
64C
65 IF(msr==0)THEN
66 xwl=rwl(4)
67 ywl=rwl(5)
68 zwl=rwl(6)
69 vxw=zero
70 vyw=zero
71 vzw=zero
72 xwl0=xwl
73 ywl0=ywl
74 zwl0=zwl
75 vnold=zero
76 vn =zero
77 ELSE
78 m3=3*msr
79 m2=m3-1
80 m1=m2-1
81C changement formulation : plus d'impasse sur contribution force
82 vxw=v(m1)+a(m1)*dt12
83 vyw=v(m2)+a(m2)*dt12
84 vzw=v(m3)+a(m3)*dt12
85 xwl=x(m1)+vxw*dt2
86 ywl=x(m2)+vyw*dt2
87 zwl=x(m3)+vzw*dt2
88 xwl0=x(m1)
89 ywl0=x(m2)
90 zwl0=x(m3)
91 vnold =rwl(4)
92 vn =vxw*rwl(1)+vyw*rwl(2)+vzw*rwl(3)
93 rwl(4)=vn
94 ENDIF
95C
96 nimpact=0
97C
98 xl1=rwl(7)
99 yl1=rwl(8)
100 zl1=rwl(9)
101 xl2=rwl(10)
102 yl2=rwl(11)
103 zl2=rwl(12)
104 sx12=yl1*zl2-zl1*yl2
105 sy12=zl1*xl2-xl1*zl2
106 sz12=xl1*yl2-yl1*xl2
107 s12=sx12**2+sy12**2+sz12**2
108C
109 DO 20 j=1,nsms
110 i=nrwl_sms(j)
111 n=nsw(i)
112 n3=3*n
113 n2=n3-1
114 n1=n2-1
115 vx=v(n1)+a(n1)*dt12
116 vy=v(n2)+a(n2)*dt12
117 vz=v(n3)+a(n3)*dt12
118 ux=x(n1)+vx*dt2
119 uy=x(n2)+vy*dt2
120 uz=x(n3)+vz*dt2
121 IF(n2d==1)THEN
122 ax=x(n2)
123 ELSE
124 ax=one
125 ENDIF
126 xc=ux-xwl
127 yc=uy-ywl
128 zc=uz-zwl
129 dp=xc*rwl(1)+yc*rwl(2)+zc*rwl(3)
130 xc0=x(n1)-xwl0
131 yc0=x(n2)-ywl0
132 zc0=x(n3)-zwl0
133 dp0=xc0*rwl(1)+yc0*rwl(2)+zc0*rwl(3)
134 tol=two*dt1*max(
135 . abs( (vx-vxw)*rwl(1)+(vy-vyw)*rwl(2)+(vz-vzw)*rwl(3) ),
136 . abs(vn-vnold) )
137 IF(iresp==1)THEN
138 xprec=prec*max(abs(xwl),abs(ywl),abs(zwl),
139 . abs(x(n1)),abs(x(n2)),abs(x(n3)),
140 . abs(x(n1)-xwl),abs(x(n2)-ywl),abs(x(n3)-zwl))
141 tol=max(tol,xprec)
142 END IF
143 IF(dp>zero.OR.dp0<=-tol)GOTO 20
144C
145 xcp=xc-dp*rwl(1)
146 ycp=yc-dp*rwl(2)
147 zcp=zc-dp*rwl(3)
148C
149 sx1m=yl1*zcp-zl1*ycp
150 sy1m=zl1*xcp-xl1*zcp
151 sz1m=xl1*ycp-yl1*xcp
152 ps=sx12*sx1m+sy12*sy1m+sz12*sz1m
153C
154 IF(ps<zero) GOTO 20
155C
156 sm1=sx1m**2+sy1m**2+sz1m**2
157C
158 IF(sm1>s12) GOTO 20
159C
160 sxm2=ycp*zl2-zcp*yl2
161 sym2=zcp*xl2-xcp*zl2
162 szm2=xcp*yl2-ycp*xl2
163 ps=sx12*sxm2+sy12*sym2+sz12*szm2
164C
165 IF(ps<zero) GOTO 20
166C
167 sm2=sxm2**2+sym2**2+szm2**2
168C
169 IF(sm2>s12) GOTO 20
170C
171 IF((vx-vxw)*rwl(1)+(vy-vyw)*rwl(2)+(vz-vzw)*rwl(3)>zero
172 . .AND.dp0>zero)GOTO 20
173 nimpact = nimpact+1
174 impact(nimpact) = i
175 20 CONTINUE
176C
177 IF(nimpact/=0.AND.itied==2)ifricw=1
178C
179 RETURN
180 END
181!||====================================================================
182!|| sms_rgwalp_fric ../engine/source/ams/sms_rgwalp.F
183!||--- called by ------------------------------------------------------
184!|| sms_rgwal_0 ../engine/source/ams/sms_rgwal0.F
185!||====================================================================
186 SUBROUTINE sms_rgwalp_fric
187 1 (x ,a ,v ,rwl ,nsw ,
188 2 nsn ,itied ,msr ,ms ,weight ,
189 3 nimpact,impact ,nsms ,nrwl_sms,fsav,
190 4 fopt ,res ,r ,frea )
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 "com08_c.inc"
200C-----------------------------------------------
201C D u m m y A r g u m e n t s
202C-----------------------------------------------
203 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
204 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
205C REAL
206 my_real
207 . x(*), a(*), v(*), rwl(*), ms(*), fsav(*),
208 . fopt(*), res(*), frea(*), r(*)
209C-----------------------------------------------
210C L o c a l V a r i a b l e s
211C-----------------------------------------------
212 INTEGER I, N, N3, N2, N1, J, K, M1, M2, M3
213
214C REAL
215 my_real
216 . xwl, ywl, zwl, vxw, vyw, vzw,
217 . xwl0, ywl0, zwl0, xc0, yc0, zc0, dp0,
218 . dp0dt, dvx, dvy, dvz,
219 . dv, da, dvt, fn,
220 . fnxn, fnyn, fnzn, fnxt, fnyt, fnzt, fndfn, ftdft, fric, fric2,
221 . fcoe, fac, alpha, alphi,
222 . fxn, fyn, fzn, fxt, fyt, fzt
223C-----------------------------------------------
224C
225 IF(msr==0)THEN
226 xwl0=rwl(4)
227 ywl0=rwl(5)
228 zwl0=rwl(6)
229 xwl=rwl(4)
230 ywl=rwl(5)
231 zwl=rwl(6)
232 vxw=zero
233 vyw=zero
234 vzw=zero
235 ELSE
236 m3=3*msr
237 m2=m3-1
238 m1=m2-1
239 vxw=v(m1)+a(m1)*dt12
240 vyw=v(m2)+a(m2)*dt12
241 vzw=v(m3)+a(m3)*dt12
242 xwl0=x(m1)
243 ywl0=x(m2)
244 zwl0=x(m3)
245 xwl=x(m1)+vxw*dt2
246 ywl=x(m2)+vyw*dt2
247 zwl=x(m3)+vzw*dt2
248 ENDIF
249C
250 IF(itied == 2)THEN
251C
252C--- no friction filtering
253 fric=rwl(13)
254 fric2=fric**2
255 fac=one/dt12
256 DO j = 1,nimpact
257 i = impact(j)
258 n=nsw(i)
259 n3=3*n
260 n2=n3-1
261 n1=n2-1
262C---
263 fn=res(n1)*rwl(1)+res(n2)*rwl(2)+res(n3)*rwl(3)
264 fn=fn*dt12
265 fnxn=fn*rwl(1)
266 fnyn=fn*rwl(2)
267 fnzn=fn*rwl(3)
268 fnxt=res(n1)*dt12-fnxn
269 fnyt=res(n2)*dt12-fnyn
270 fnzt=res(n3)*dt12-fnzn
271C
272C---
273 fndfn=fnxn**2+fnyn**2+fnzn**2
274 ftdft=fnxt**2+fnyt**2+fnzt**2
275 IF(ftdft <= fric2*fndfn)THEN
276C adherence
277 ELSE
278C glissement
279 fcoe=fric*sqrt(fndfn/ftdft)
280 fnxt=fcoe*fnxt
281 fnyt=fcoe*fnyt
282 fnzt=fcoe*fnzt
283C
284C apply (estimated) Ft
285 fxt=fnxt*fac
286 fyt=fnyt*fac
287 fzt=fnzt*fac
288 r(n1)=r(n1)-fxt
289 r(n2)=r(n2)-fyt
290 r(n3)=r(n3)-fzt
291C
292 fxn=fnxn*fac
293 fyn=fnyn*fac
294 fzn=fnzn*fac
295 frea(n1) = fxt
296 frea(n2) = fyt
297 frea(n3) = fzt
298C
299 impact(j)=-impact(j)
300 END IF
301 ENDDO
302 ENDIF
303C
304 RETURN
305 END
306!||====================================================================
307!|| sms_rgwalp_bcs_0 ../engine/source/ams/sms_rgwalp.F
308!||--- called by ------------------------------------------------------
309!|| sms_rgwal_0 ../engine/source/ams/sms_rgwal0.F
310!||====================================================================
311 SUBROUTINE sms_rgwalp_bcs_0
312 1 (x ,a ,v ,rwl ,nsw ,
313 2 nsn ,itied ,msr ,ms ,weight ,
314 3 nimpact,impact ,nsms ,nrwl_sms)
315C-----------------------------------------------
316C I m p l i c i t T y p e s
317C-----------------------------------------------
318#include "implicit_f.inc"
319#include "comlock.inc"
320C-----------------------------------------------
321C C o m m o n B l o c k s
322C-----------------------------------------------
323#include "com08_c.inc"
324C-----------------------------------------------
325C D u m m y A r g u m e n t s
326C-----------------------------------------------
327 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
328 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
329C REAL
330 my_real
331 . x(*), a(*), v(*), rwl(*), ms(*)
332C-----------------------------------------------
333C L o c a l V a r i a b l e s
334C-----------------------------------------------
335 INTEGER I, N, N3, N2, N1, J, K, M1, M2, M3
336
337C REAL
338 my_real
339 . xwl, ywl, zwl, vxw, vyw, vzw,
340 . xwl0, ywl0, zwl0, xc0, yc0, zc0, dp0,
341 . dv, da, dvt, dp0dt, dvx, dvy, dvz
342C-----------------------------------------------
343C
344 IF(msr==0)THEN
345 xwl0=rwl(4)
346 ywl0=rwl(5)
347 zwl0=rwl(6)
348 xwl=rwl(4)
349 ywl=rwl(5)
350 zwl=rwl(6)
351 vxw=zero
352 vyw=zero
353 vzw=zero
354 ELSE
355 m3=3*msr
356 m2=m3-1
357 m1=m2-1
358 vxw=v(m1)+a(m1)*dt12
359 vyw=v(m2)+a(m2)*dt12
360 vzw=v(m3)+a(m3)*dt12
361 xwl0=x(m1)
362 ywl0=x(m2)
363 zwl0=x(m3)
364 xwl=x(m1)+vxw*dt2
365 ywl=x(m2)+vyw*dt2
366 zwl=x(m3)+vzw*dt2
367 ENDIF
368C
369 IF(itied==0)THEN
370C
371 DO 40 j = 1,nimpact
372 i = impact(j)
373 n=nsw(i)
374 n3=3*n
375 n2=n3-1
376 n1=n2-1
377C
378 xc0=x(n1)-xwl0
379 yc0=x(n2)-ywl0
380 zc0=x(n3)-zwl0
381 dp0 =xc0*rwl(1)+yc0*rwl(2)+zc0*rwl(3)
382 dp0dt=-min(dp0,zero)/dt2
383C
384 dv =(v(n1)-vxw)*rwl(1)+(v(n2)-vyw)*rwl(2)+(v(n3)-vzw)*rwl(3)
385 da =a(n1)*rwl(1)+a(n2)*rwl(2)+a(n3)*rwl(3)
386 da =(dv-dp0dt)/dt12+da
387C
388 a(n1)=a(n1)-da*rwl(1)
389 a(n2)=a(n2)-da*rwl(2)
390 a(n3)=a(n3)-da*rwl(3)
391 40 CONTINUE
392C
393 ELSEIF(itied==1)THEN
394C
395 DO 60 j = 1,nimpact
396 i = impact(j)
397 n=nsw(i)
398 n3=3*n
399 n2=n3-1
400 n1=n2-1
401C
402 xc0=x(n1)-xwl0
403 yc0=x(n2)-ywl0
404 zc0=x(n3)-zwl0
405 dp0 =xc0*rwl(1)+yc0*rwl(2)+zc0*rwl(3)
406 dp0dt=-min(dp0,zero)/dt2
407 dvx =dp0dt*rwl(1)
408 dvy =dp0dt*rwl(2)
409 dvz =dp0dt*rwl(3)
410C
411 a(n1)=(-(v(n1)-vxw)+dvx)/dt12
412 a(n2)=(-(v(n2)-vyw)+dvy)/dt12
413 a(n3)=(-(v(n3)-vzw)+dvz)/dt12
414 60 CONTINUE
415C
416 ELSE
417C
418C--- friction
419 DO j = 1,nimpact
420 i = abs(impact(j))
421 n=nsw(i)
422 n3=3*n
423 n2=n3-1
424 n1=n2-1
425C
426 xc0=x(n1)-xwl0
427 yc0=x(n2)-ywl0
428 zc0=x(n3)-zwl0
429 dp0 =xc0*rwl(1)+yc0*rwl(2)+zc0*rwl(3)
430 dp0dt=-min(dp0,zero)/dt2
431 dvx =dp0dt*rwl(1)
432 dvy =dp0dt*rwl(2)
433 dvz =dp0dt*rwl(3)
434C
435 dv=(v(n1)-vxw)*rwl(1)+(v(n2)-vyw)*rwl(2)+(v(n3)-vzw)*rwl(3)
436 da =a(n1)*rwl(1)+a(n2)*rwl(2)+a(n3)*rwl(3)
437 da =(dv-dp0dt)/dt12+da
438C---
439 IF(impact(j) > 0)THEN
440C adherence
441 a(n1)=(-(v(n1)-vxw)+dvx)/dt12
442 a(n2)=(-(v(n2)-vyw)+dvy)/dt12
443 a(n3)=(-(v(n3)-vzw)+dvz)/dt12
444 ELSE
445C glissement
446 a(n1)=a(n1)-da*rwl(1)
447 a(n2)=a(n2)-da*rwl(2)
448 a(n3)=a(n3)-da*rwl(3)
449 END IF
450 ENDDO
451 ENDIF
452C
453 RETURN
454 END
455!||====================================================================
456!|| sms_rgwalp_bcs_1 ../engine/source/ams/sms_rgwalp.F
457!||--- called by ------------------------------------------------------
458!|| sms_rgwal_0 ../engine/source/ams/sms_rgwal0.F
459!||====================================================================
460 SUBROUTINE sms_rgwalp_bcs_1
461 1 (x ,a ,v ,rwl ,nsw ,
462 2 nsn ,itied ,msr ,ms ,weight ,
463 3 nimpact,impact ,nsms ,nrwl_sms)
464C-----------------------------------------------
465C I m p l i c i t T y p e s
466C-----------------------------------------------
467#include "implicit_f.inc"
468#include "comlock.inc"
469C-----------------------------------------------
470C D u m m y A r g u m e n t s
471C-----------------------------------------------
472 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
473 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
474C REAL
475 my_real
476 . x(*), a(*), v(*), rwl(*), ms(*)
477C-----------------------------------------------
478C L o c a l V a r i a b l e s
479C-----------------------------------------------
480 INTEGER I, N, N3, N2, N1, J, M1, M2, M3
481
482C REAL
483 my_real
484 . da
485C-----------------------------------------------
486C
487C fixed wall only.
488C
489 IF(itied==0)THEN
490C
491 DO 40 j = 1,nimpact
492 i = impact(j)
493 n=nsw(i)
494 n3=3*n
495 n2=n3-1
496 n1=n2-1
497 da =a(n1)*rwl(1)+a(n2)*rwl(2)+a(n3)*rwl(3)
498C
499 a(n1)=a(n1)-da*rwl(1)
500 a(n2)=a(n2)-da*rwl(2)
501 a(n3)=a(n3)-da*rwl(3)
502 40 CONTINUE
503C
504 ELSEIF(itied==1)THEN
505C
506 DO 60 j = 1,nimpact
507 i = impact(j)
508 n=nsw(i)
509 n3=3*n
510 n2=n3-1
511 n1=n2-1
512 a(n1)=zero
513 a(n2)=zero
514 a(n3)=zero
515 60 CONTINUE
516C
517 ELSE
518C
519C--- friction
520 DO j = 1,nimpact
521 i = abs(impact(j))
522 n=nsw(i)
523 n3=3*n
524 n2=n3-1
525 n1=n2-1
526 da=a(n1)*rwl(1)+a(n2)*rwl(2)+a(n3)*rwl(3)
527C---
528 IF(impact(j) > 0)THEN
529C adherence
530 a(n1)=zero
531 a(n2)=zero
532 a(n3)=zero
533 ELSE
534C glissement
535 a(n1)=a(n1)-da*rwl(1)
536 a(n2)=a(n2)-da*rwl(2)
537 a(n3)=a(n3)-da*rwl(3)
538 END IF
539 ENDDO
540 ENDIF
541C
542 RETURN
543 END
544!||====================================================================
545!|| sms_rgwalp_bilan ../engine/source/ams/sms_rgwalp.F
546!||--- called by ------------------------------------------------------
547!|| sms_rgwal_0 ../engine/source/ams/sms_rgwal0.F
548!||--- calls -----------------------------------------------------
549!|| sum_6_float ../engine/source/system/parit.F
550!||====================================================================
551 SUBROUTINE sms_rgwalp_bilan
552 1 (x ,frea ,v ,rwl ,nsw ,
553 2 nsn ,itied ,msr ,ms ,weight ,
554 3 nimpact,impact ,nsms ,nrwl_sms,fsav ,
555 4 fopt ,frwl6 ,a ,wfext)
556C-----------------------------------------------
557C I m p l i c i t T y p e s
558C-----------------------------------------------
559#include "implicit_f.inc"
560#include "comlock.inc"
561C-----------------------------------------------
562C C o m m o n B l o c k s
563C-----------------------------------------------
564#include "com06_c.inc"
565#include "com08_c.inc"
566C-----------------------------------------------
567C D u m m y A r g u m e n t s
568C-----------------------------------------------
569 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
570 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
571 my_real
572 . x(*), v(*), rwl(*), ms(*), fsav(*), frea(3,*),
573 . fopt(*), a(*)
574 DOUBLE PRECISION FRWL6(7,6)
575 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
576C-----------------------------------------------
577C L o c a l V a r i a b l e s
578C-----------------------------------------------
579 INTEGER I, N, N3, N2, N1, J, K, M1, M2, M3
580 my_real
581 . vxw, vyw, vzw, vx, vy, vz,
582 . wfextt,
583 . fnxn, fnyn, fnzn, fnxt, fnyt, fnzt, fn,
584 . fxn, fyn, fzn, fxt, fyt, fzt,
585 . f1(nsn), f2(nsn), f3(nsn), f4(nsn), f5(nsn), f6(nsn), f7(nsn)
586C-----------------------------------------------
587C
588 IF(msr==0)THEN
589 vxw=zero
590 vyw=zero
591 vzw=zero
592 ELSE
593 m3=3*msr
594 m2=m3-1
595 m1=m2-1
596C WFEXT only <=> dt12/2.
597 vxw=v(m1)+half*a(m1)*dt12
598 vyw=v(m2)+half*a(m2)*dt12
599 vzw=v(m3)+half*a(m3)*dt12
600 ENDIF
601C
602 wfextt=zero
603C
604 IF(itied==0)THEN
605C
606 DO 40 j = 1,nimpact
607 i = impact(j)
608 n=nsw(i)
609C
610 fn=frea(1,n)*rwl(1)+frea(2,n)*rwl(2)+frea(3,n)*rwl(3)
611 fn=weight(n)*fn
612 fxn=fn*rwl(1)
613 fyn=fn*rwl(2)
614 fzn=fn*rwl(3)
615C
616 f1(j) = fxn
617 f2(j) = fyn
618 f3(j) = fzn
619 f4(j) = ms(n)
620 f5(j) = zero
621 f6(j) = zero
622 f7(j) = zero
623C
624C 1er impact (WFEXT avec decalage 1/2 cycle)
625c N3=3*N
626c N2=N3-1
627c N1=N2-1
628c VX=V(N1)+HALF*A(N1)*DT12
629c VY=V(N2)+HALF*A(N2)*DT12
630c VZ=V(N3)+HALF*A(N3)*DT12
631c WFEXTT = WFEXTT -DT12*((VX-VXW)*FXN+(VY-VYW)*FYN+(VZ-VZW)*FZN)
632 40 CONTINUE
633C
634 ELSE
635C
636 DO 60 j = 1,nimpact
637 i = abs(impact(j))
638 n=nsw(i)
639C
640 fn=frea(1,n)*rwl(1)+frea(2,n)*rwl(2)+frea(3,n)*rwl(3)
641 fn=weight(n)*fn
642 fxn=fn*rwl(1)
643 fyn=fn*rwl(2)
644 fzn=fn*rwl(3)
645C
646 f1(j) = fxn
647 f2(j) = fyn
648 f3(j) = fzn
649 f4(j) = ms(n)
650C
651 n3=3*n
652 n2=n3-1
653 n1=n2-1
654 vx=v(n1)+half*a(n1)*dt12
655 vy=v(n2)+half*a(n2)*dt12
656 vz=v(n3)+half*a(n3)*dt12
657C 1er impact (WFEXT avec decalage 1/2 cycle)
658c WFEXTT = WFEXTT -DT12*((VX-VXW)*FXN+(VY-VYW)*FYN+(VZ-VZW)*FZN)
659C
660 fxt=weight(n)*frea(1,n)-fxn
661 fyt=weight(n)*frea(2,n)-fyn
662 fzt=weight(n)*frea(3,n)-fzn
663 f5(j) = fxt
664 f6(j) = fyt
665 f7(j) = fzt
666 wfextt = wfextt -dt12*((vx-vxw)*fxt+(vy-vyw)*fyt+(vz-vzw)*fzt)
667 60 CONTINUE
668 ENDIF
669C
670#include "lockon.inc"
671 wfext=wfext+wfextt
672#include "lockoff.inc"
673C
674 CALL sum_6_float(1, nimpact, f1, frwl6(1,1), 7)
675 CALL sum_6_float(1, nimpact, f2, frwl6(2,1), 7)
676 CALL sum_6_float(1, nimpact, f3, frwl6(3,1), 7)
677 CALL sum_6_float(1, nimpact, f4, frwl6(4,1), 7)
678 CALL sum_6_float(1, nimpact, f5, frwl6(5,1), 7)
679 CALL sum_6_float(1, nimpact, f6, frwl6(6,1), 7)
680 CALL sum_6_float(1, nimpact, f7, frwl6(7,1), 7)
681C
682 RETURN
683 END
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:64
sms_rgwalp_fric
subroutine sms_rgwalp_fric(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, res, r, frea)
Definition sms_rgwalp.F:191
sms_rgwalp_bcs_0
subroutine sms_rgwalp_bcs_0(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwalp.F:315
sms_rgwalp_impact
subroutine sms_rgwalp_impact(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwalp.F:31
sms_rgwalp_bilan
subroutine sms_rgwalp_bilan(x, frea, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, frwl6, a, wfext)
Definition sms_rgwalp.F:556
sms_rgwalp_bcs_1
subroutine sms_rgwalp_bcs_1(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwalp.F:464