OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_rgwals.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com08_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sms_rgwals_impact (x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
subroutine sms_rgwals_fric (x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, res, r, frea)
subroutine sms_rgwals_bcs_0 (x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
subroutine sms_rgwals_bcs_1 (x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
subroutine sms_rgwals_bilan (x, frea, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, frwl6, a, wfext)

Function/Subroutine Documentation

◆ sms_rgwals_bcs_0()

subroutine sms_rgwals_bcs_0 ( x,
a,
v,
rwl,
integer, dimension(*) nsw,
integer nsn,
integer itied,
integer msr,
ms,
integer, dimension(*) weight,
integer nimpact,
integer, dimension(*) impact,
integer nsms,
integer, dimension(*) nrwl_sms )

Definition at line 241 of file sms_rgwals.F.

245C-----------------------------------------------
246C I m p l i c i t T y p e s
247C-----------------------------------------------
248#include "implicit_f.inc"
249#include "comlock.inc"
250C-----------------------------------------------
251C C o m m o n B l o c k s
252C-----------------------------------------------
253#include "com08_c.inc"
254C-----------------------------------------------
255C D u m m y A r g u m e n t s
256C-----------------------------------------------
257 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
258 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
259C REAL
260 my_real
261 . x(*), a(*), v(*), rwl(*), ms(*)
262C-----------------------------------------------
263C L o c a l V a r i a b l e s
264C-----------------------------------------------
265 INTEGER I, N, N3, N2, N1, J, K, M1, M2, M3
266
267C REAL
268 my_real
269 . xwl, ywl, zwl, vxw, vyw, vzw,
270 . xwl0, ywl0, zwl0,
271 . xc, yc, zc, xx, xn, yn, zn,
272 . dv, da, dvt
273C-----------------------------------------------
274C
275 IF(msr==0)THEN
276 xwl0=rwl(4)
277 ywl0=rwl(5)
278 zwl0=rwl(6)
279 xwl=rwl(4)
280 ywl=rwl(5)
281 zwl=rwl(6)
282 vxw=zero
283 vyw=zero
284 vzw=zero
285 ELSE
286 m3=3*msr
287 m2=m3-1
288 m1=m2-1
289 vxw=v(m1)+a(m1)*dt12
290 vyw=v(m2)+a(m2)*dt12
291 vzw=v(m3)+a(m3)*dt12
292 xwl0=x(m1)
293 ywl0=x(m2)
294 zwl0=x(m3)
295 xwl=x(m1)+vxw*dt2
296 ywl=x(m2)+vyw*dt2
297 zwl=x(m3)+vzw*dt2
298 ENDIF
299C
300 IF(itied==0)THEN
301C
302 DO 40 j = 1,nimpact
303 i = impact(j)
304 n=nsw(i)
305 n3=3*n
306 n2=n3-1
307 n1=n2-1
308C
309 xc=x(n1)-xwl0
310 yc=x(n2)-ywl0
311 zc=x(n3)-zwl0
312 xx=sqrt(xc**2+yc**2+zc**2)
313 xn=xc/xx
314 yn=yc/xx
315 zn=zc/xx
316 dv=(v(n1)-vxw)*xn+(v(n2)-vyw)*yn+(v(n3)-vzw)*zn
317 da=a(n1)*xn+a(n2)*yn+a(n3)*zn
318 da=dv/dt12+da
319C
320 a(n1)=a(n1)-da*xn
321 a(n2)=a(n2)-da*yn
322 a(n3)=a(n3)-da*zn
323 40 CONTINUE
324C
325 ELSEIF(itied==1)THEN
326C
327 DO 60 j = 1,nimpact
328 i = impact(j)
329 n=nsw(i)
330 n3=3*n
331 n2=n3-1
332 n1=n2-1
333C
334 a(n1)=-(v(n1)-vxw)/dt12
335 a(n2)=-(v(n2)-vyw)/dt12
336 a(n3)=-(v(n3)-vzw)/dt12
337 60 CONTINUE
338C
339 ELSE
340C
341C--- friction
342 DO j = 1,nimpact
343 i = abs(impact(j))
344 n=nsw(i)
345 n3=3*n
346 n2=n3-1
347 n1=n2-1
348C
349 xc=x(n1)-xwl0
350 yc=x(n2)-ywl0
351 zc=x(n3)-zwl0
352 xx=sqrt(xc**2+yc**2+zc**2)
353 xn=xc/xx
354 yn=yc/xx
355 zn=zc/xx
356 dv=(v(n1)-vxw)*xn+(v(n2)-vyw)*yn+(v(n3)-vzw)*zn
357 da=a(n1)*xn+a(n2)*yn+a(n3)*zn
358 da=dv/dt12+da
359C---
360 IF(impact(j) > 0)THEN
361C adherence
362 a(n1)=-(v(n1)-vxw)/dt12
363 a(n2)=-(v(n2)-vyw)/dt12
364 a(n3)=-(v(n3)-vzw)/dt12
365 ELSE
366C glissement
367 a(n1)=a(n1)-da*xn
368 a(n2)=a(n2)-da*yn
369 a(n3)=a(n3)-da*zn
370 END IF
371 ENDDO
372 ENDIF
373C
374 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ sms_rgwals_bcs_1()

subroutine sms_rgwals_bcs_1 ( x,
a,
v,
rwl,
integer, dimension(*) nsw,
integer nsn,
integer itied,
integer msr,
ms,
integer, dimension(*) weight,
integer nimpact,
integer, dimension(*) impact,
integer nsms,
integer, dimension(*) nrwl_sms )

Definition at line 381 of file sms_rgwals.F.

385C-----------------------------------------------
386C I m p l i c i t T y p e s
387C-----------------------------------------------
388#include "implicit_f.inc"
389#include "comlock.inc"
390C-----------------------------------------------
391C C o m m o n B l o c k s
392C-----------------------------------------------
393#include "com08_c.inc"
394C-----------------------------------------------
395C D u m m y A r g u m e n t s
396C-----------------------------------------------
397 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
398 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
399C REAL
400 my_real
401 . x(*), a(*), v(*), rwl(*), ms(*)
402C-----------------------------------------------
403C L o c a l V a r i a b l e s
404C-----------------------------------------------
405 INTEGER I, N, N3, N2, N1, J, M1, M2, M3
406
407C REAL
408 my_real
409 . xwl, ywl, zwl, vxw, vyw, vzw,
410 . xwl0, ywl0, zwl0,
411 . xc, yc, zc, xx, xn, yn, zn,
412 . da
413C-----------------------------------------------
414C
415 IF(msr==0)THEN
416 xwl0=rwl(4)
417 ywl0=rwl(5)
418 zwl0=rwl(6)
419 xwl=rwl(4)
420 ywl=rwl(5)
421 zwl=rwl(6)
422 vxw=zero
423 vyw=zero
424 vzw=zero
425 ELSE
426 m3=3*msr
427 m2=m3-1
428 m1=m2-1
429 vxw=v(m1)+a(m1)*dt12
430 vyw=v(m2)+a(m2)*dt12
431 vzw=v(m3)+a(m3)*dt12
432 xwl0=x(m1)
433 ywl0=x(m2)
434 zwl0=x(m3)
435 xwl=x(m1)+vxw*dt2
436 ywl=x(m2)+vyw*dt2
437 zwl=x(m3)+vzw*dt2
438 ENDIF
439C
440 IF(itied==0)THEN
441C
442 DO 40 j = 1,nimpact
443 i = impact(j)
444 n=nsw(i)
445 n3=3*n
446 n2=n3-1
447 n1=n2-1
448C
449 xc=x(n1)-xwl0
450 yc=x(n2)-ywl0
451 zc=x(n3)-zwl0
452 xx=sqrt(xc**2+yc**2+zc**2)
453 xn=xc/xx
454 yn=yc/xx
455 zn=zc/xx
456 da =a(n1)*xn+a(n2)*yn+a(n3)*zn
457C
458 a(n1)=a(n1)-da*xn
459 a(n2)=a(n2)-da*yn
460 a(n3)=a(n3)-da*zn
461 40 CONTINUE
462C
463 ELSEIF(itied==1)THEN
464C
465 DO 60 j = 1,nimpact
466 i = impact(j)
467 n=nsw(i)
468 n3=3*n
469 n2=n3-1
470 n1=n2-1
471 a(n1)=zero
472 a(n2)=zero
473 a(n3)=zero
474 60 CONTINUE
475C
476 ELSE
477C
478C--- friction
479 DO j = 1,nimpact
480 i = abs(impact(j))
481 n=nsw(i)
482 n3=3*n
483 n2=n3-1
484 n1=n2-1
485C
486 xc=x(n1)-xwl0
487 yc=x(n2)-ywl0
488 zc=x(n3)-zwl0
489 xx=sqrt(xc**2+yc**2+zc**2)
490 xn=xc/xx
491 yn=yc/xx
492 zn=zc/xx
493 da =a(n1)*xn+a(n2)*yn+a(n3)*zn
494C---
495 IF(impact(j) > 0)THEN
496C adherence
497 a(n1)=zero
498 a(n2)=zero
499 a(n3)=zero
500 ELSE
501C glissement
502 a(n1)=a(n1)-da*xn
503 a(n2)=a(n2)-da*yn
504 a(n3)=a(n3)-da*zn
505 END IF
506 ENDDO
507 ENDIF
508C
509 RETURN

◆ sms_rgwals_bilan()

subroutine sms_rgwals_bilan ( x,
frea,
v,
rwl,
integer, dimension(*) nsw,
integer nsn,
integer itied,
integer msr,
ms,
integer, dimension(*) weight,
integer nimpact,
integer, dimension(*) impact,
integer nsms,
integer, dimension(*) nrwl_sms,
fsav,
fopt,
double precision, dimension(7,6) frwl6,
a,
double precision, intent(inout) wfext )

Definition at line 518 of file sms_rgwals.F.

523C-----------------------------------------------
524C I m p l i c i t T y p e s
525C-----------------------------------------------
526#include "implicit_f.inc"
527#include "comlock.inc"
528C-----------------------------------------------
529C C o m m o n B l o c k s
530C-----------------------------------------------
531#include "com06_c.inc"
532#include "com08_c.inc"
533C-----------------------------------------------
534C D u m m y A r g u m e n t s
535C-----------------------------------------------
536 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
537 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
538 my_real x(*), v(*), rwl(*), ms(*), fsav(*), frea(3,*), fopt(*), a(*)
539 DOUBLE PRECISION FRWL6(7,6)
540 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
541C-----------------------------------------------
542C L o c a l V a r i a b l e s
543C-----------------------------------------------
544 INTEGER I, N, N3, N2, N1, J, K, M1, M2, M3
545 my_real
546 . vxw, vyw, vzw, vx, vy, vz, xwl0, ywl0, zwl0,
547 . xc, yc, zc, xx, xn, yn, zn,
548 . wfextt,
549 . fnxn, fnyn, fnzn, fnxt, fnyt, fnzt, fn,
550 . fxn, fyn, fzn, fxt, fyt, fzt,
551 . f1(nsn), f2(nsn), f3(nsn), f4(nsn), f5(nsn), f6(nsn), f7(nsn)
552C-----------------------------------------------
553C
554 IF(msr==0)THEN
555 xwl0=rwl(4)
556 ywl0=rwl(5)
557 zwl0=rwl(6)
558 vxw=zero
559 vyw=zero
560 vzw=zero
561 ELSE
562 m3=3*msr
563 m2=m3-1
564 m1=m2-1
565C WFEXT only <=> dt12/2.
566 vxw=v(m1)+half*a(m1)*dt12
567 vyw=v(m2)+half*a(m2)*dt12
568 vzw=v(m3)+half*a(m3)*dt12
569 xwl0=x(m1)
570 ywl0=x(m2)
571 zwl0=x(m3)
572 ENDIF
573C
574 wfextt=zero
575C
576 IF(itied==0)THEN
577C
578 DO 40 j = 1,nimpact
579 i = impact(j)
580 n=nsw(i)
581C
582 n3=3*n
583 n2=n3-1
584 n1=n2-1
585 xc=x(n1)-xwl0
586 yc=x(n2)-ywl0
587 zc=x(n3)-zwl0
588 xx=sqrt(xc**2+yc**2+zc**2)
589 xn=xc/xx
590 yn=yc/xx
591 zn=zc/xx
592C
593 fn=frea(1,n)*xn+frea(2,n)*yn+frea(3,n)*zn
594 fn=weight(n)*fn
595 fxn=fn*xn
596 fyn=fn*yn
597 fzn=fn*zn
598C
599 f1(j) = fxn
600 f2(j) = fyn
601 f3(j) = fzn
602 f4(j) = ms(n)
603 f5(j) = zero
604 f6(j) = zero
605 f7(j) = zero
606C
607C 1er impact (WFEXT avec decalage 1/2 cycle)
608c VX=V(N1)+HALF*A(N1)*DT12
609c VY=V(N2)+HALF*A(N2)*DT12
610c VZ=V(N3)+HALF*A(N3)*DT12
611c WFEXTT = WFEXTT -DT12*((VX-VXW)*FXN+(VY-VYW)*FYN+(VZ-VZW)*FZN)
612 40 CONTINUE
613C
614 ELSE
615C
616 DO 60 j = 1,nimpact
617 i = abs(impact(j))
618 n=nsw(i)
619C
620 n3=3*n
621 n2=n3-1
622 n1=n2-1
623 xc=x(n1)-xwl0
624 yc=x(n2)-ywl0
625 zc=x(n3)-zwl0
626 xx=sqrt(xc**2+yc**2+zc**2)
627 xn=xc/xx
628 yn=yc/xx
629 zn=zc/xx
630C
631 fn=frea(1,n)*xn+frea(2,n)*yn+frea(3,n)*zn
632 fn=weight(n)*fn
633 fxn=fn*xn
634 fyn=fn*yn
635 fzn=fn*zn
636C
637 f1(j) = fxn
638 f2(j) = fyn
639 f3(j) = fzn
640 f4(j) = ms(n)
641C
642 vx=v(n1)+half*a(n1)*dt12
643 vy=v(n2)+half*a(n2)*dt12
644 vz=v(n3)+half*a(n3)*dt12
645C 1er impact (WFEXT avec decalage 1/2 cycle)
646c WFEXTT = WFEXTT -DT12*((VX-VXW)*FXN+(VY-VYW)*FYN+(VZ-VZW)*FZN)
647C
648 fxt=weight(n)*frea(1,n)-fxn
649 fyt=weight(n)*frea(2,n)-fyn
650 fzt=weight(n)*frea(3,n)-fzn
651 f5(j) = fxt
652 f6(j) = fyt
653 f7(j) = fzt
654 wfextt = wfextt -dt12*((vx-vxw)*fxt+(vy-vyw)*fyt+(vz-vzw)*fzt)
655 60 CONTINUE
656 ENDIF
657C
658#include "lockon.inc"
659 wfext=wfext+wfextt
660#include "lockoff.inc"
661C
662 CALL sum_6_float(1, nimpact, f1, frwl6(1,1), 7)
663 CALL sum_6_float(1, nimpact, f2, frwl6(2,1), 7)
664 CALL sum_6_float(1, nimpact, f3, frwl6(3,1), 7)
665 CALL sum_6_float(1, nimpact, f4, frwl6(4,1), 7)
666 CALL sum_6_float(1, nimpact, f5, frwl6(5,1), 7)
667 CALL sum_6_float(1, nimpact, f6, frwl6(6,1), 7)
668 CALL sum_6_float(1, nimpact, f7, frwl6(7,1), 7)
669C
670 RETURN
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:64

◆ sms_rgwals_fric()

subroutine sms_rgwals_fric ( x,
a,
v,
rwl,
integer, dimension(*) nsw,
integer nsn,
integer itied,
integer msr,
ms,
integer, dimension(*) weight,
integer nimpact,
integer, dimension(*) impact,
integer nsms,
integer, dimension(*) nrwl_sms,
fsav,
fopt,
res,
r,
frea )

Definition at line 116 of file sms_rgwals.F.

121C-----------------------------------------------
122C I m p l i c i t T y p e s
123C-----------------------------------------------
124#include "implicit_f.inc"
125#include "comlock.inc"
126C-----------------------------------------------
127C C o m m o n B l o c k s
128C-----------------------------------------------
129#include "com08_c.inc"
130C-----------------------------------------------
131C D u m m y A r g u m e n t s
132C-----------------------------------------------
133 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
134 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
135 my_real x(*), a(*), v(*), rwl(*), ms(*), fsav(*), fopt(*), res(*), frea(*), r(*)
136C-----------------------------------------------
137C L o c a l V a r i a b l e s
138C-----------------------------------------------
139 INTEGER I, N, N3, N2, N1, J, K, M1, M2, M3
140 my_real xwl, ywl, zwl, vxw, vyw, vzw,
141 . xwl0, ywl0, zwl0,
142 . xc, yc, zc, xx, xn, yn, zn,
143 . dv, da, dvt, fn,
144 . fnxn, fnyn, fnzn, fnxt, fnyt, fnzt, fndfn, ftdft, fric, fric2,
145 . fcoe, fac, alpha, alphi, fxt, fyt, fzt
146C-----------------------------------------------
147C
148 IF(msr==0)THEN
149 xwl0=rwl(4)
150 ywl0=rwl(5)
151 zwl0=rwl(6)
152 xwl=rwl(4)
153 ywl=rwl(5)
154 zwl=rwl(6)
155 vxw=zero
156 vyw=zero
157 vzw=zero
158 ELSE
159 m3=3*msr
160 m2=m3-1
161 m1=m2-1
162C changement formulation : plus d'impasse sur contribution force
163 vxw=v(m1)+a(m1)*dt12
164 vyw=v(m2)+a(m2)*dt12
165 vzw=v(m3)+a(m3)*dt12
166 xwl0=x(m1)
167 ywl0=x(m2)
168 zwl0=x(m3)
169 xwl=x(m1)+vxw*dt2
170 ywl=x(m2)+vyw*dt2
171 zwl=x(m3)+vzw*dt2
172 ENDIF
173
174 IF(itied == 2)THEN
175C
176C--- no friction filtering
177 fric=rwl(13)
178 fric2=fric**2
179 fac=one/dt12
180 DO j = 1,nimpact
181 i = impact(j)
182 n=nsw(i)
183 n3=3*n
184 n2=n3-1
185 n1=n2-1
186C---
187 xc=x(n1)-xwl0
188 yc=x(n2)-ywl0
189 zc=x(n3)-zwl0
190 xx=sqrt(xc**2+yc**2+zc**2)
191 xn=xc/xx
192 yn=yc/xx
193 zn=zc/xx
194C---
195 fn=res(n1)*xn+res(n2)*yn+res(n3)*zn
196 fn=fn*dt12
197 fnxn=fn*xn
198 fnyn=fn*yn
199 fnzn=fn*zn
200 fnxt=res(n1)*dt12-fnxn
201 fnyt=res(n2)*dt12-fnyn
202 fnzt=res(n3)*dt12-fnzn
203C
204C---
205 fndfn=fnxn**2+fnyn**2+fnzn**2
206 ftdft=fnxt**2+fnyt**2+fnzt**2
207 IF(ftdft <= fric2*fndfn)THEN
208C adherence
209 ELSE
210C glissement
211 fcoe=fric*sqrt(fndfn/ftdft)
212 fnxt=fcoe*fnxt
213 fnyt=fcoe*fnyt
214 fnzt=fcoe*fnzt
215C
216C apply (estimated) Ft
217 fxt=fnxt*fac
218 fyt=fnyt*fac
219 fzt=fnzt*fac
220C
221 r(n1)=r(n1)-fxt
222 r(n2)=r(n2)-fyt
223 r(n3)=r(n3)-fzt
224C
225 frea(n1) = fxt
226 frea(n2) = fyt
227 frea(n3) = fzt
228C
229 impact(j)=-impact(j)
230 END IF
231 ENDDO
232 ENDIF
233C
234 RETURN
alpha
#define alpha
Definition eval.h:35

◆ sms_rgwals_impact()

subroutine sms_rgwals_impact ( x,
a,
v,
rwl,
integer, dimension(*) nsw,
integer nsn,
integer itied,
integer msr,
ms,
integer, dimension(*) weight,
integer nimpact,
integer, dimension(*) impact,
integer nsms,
integer, dimension(*) nrwl_sms )

Definition at line 28 of file sms_rgwals.F.

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(*)
46 my_real x(*), a(*), v(*), rwl(*), ms(*)
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50 INTEGER I, N, N3, N2, N1, K, J, M1, M2, M3
51 my_real
52 . ra2, xwl, ywl, zwl, vxw, vyw, vzw,
53 . vx, vy, vz, ux, uy, uz, xc, yc, zc, dp,
54 . xx, xn, yn, zn, dv, da, dvt,
55 . xwl0, ywl0, zwl0
56C-----------------------------------------------
57 ra2=(half*rwl(7))**2
58C
59 IF(msr==0)THEN
60 xwl0=rwl(4)
61 ywl0=rwl(5)
62 zwl0=rwl(6)
63 xwl=rwl(4)
64 ywl=rwl(5)
65 zwl=rwl(6)
66 vxw=zero
67 vyw=zero
68 vzw=zero
69 ELSE
70 m3=3*msr
71 m2=m3-1
72 m1=m2-1
73 vxw=v(m1)+a(m1)*dt12
74 vyw=v(m2)+a(m2)*dt12
75 vzw=v(m3)+a(m3)*dt12
76 xwl0=x(m1)
77 ywl0=x(m2)
78 zwl0=x(m3)
79 xwl=x(m1)+vxw*dt2
80 ywl=x(m2)+vyw*dt2
81 zwl=x(m3)+vzw*dt2
82 ENDIF
83C
84 nimpact=0
85C
86 DO 20 j=1,nsms
87 i=nrwl_sms(j)
88 n=nsw(i)
89 n3=3*n
90 n2=n3-1
91 n1=n2-1
92 vx=v(n1)+a(n1)*dt12
93 vy=v(n2)+a(n2)*dt12
94 vz=v(n3)+a(n3)*dt12
95 ux=x(n1)+vx*dt2
96 uy=x(n2)+vy*dt2
97 uz=x(n3)+vz*dt2
98 xc=ux-xwl
99 yc=uy-ywl
100 zc=uz-zwl
101 dp=xc**2+yc**2+zc**2
102 IF(dp>ra2)GOTO 20
103 nimpact = nimpact+1
104 impact(nimpact) = i
105 20 CONTINUE
106C
107 IF(nimpact/=0.AND.itied==2)ifricw=1
108C
109 RETURN