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