29 1 NSN ,ITIED,MSR ,MS ,WEIGHT,
30 2 NIMPACT,IMPACT ,NSMS ,NRWL_SMS)
34#include "implicit_f.inc"
44 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
45 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
46 my_real x(*), a(*), v(*), rwl(*), ms(*)
50 INTEGER I, N, N3, N2, N1, K, J, M1, M2, M3
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,
107 IF(nimpact/=0.AND.itied==2)ifricw
117 1 (x ,a ,v ,rwl ,nsw ,
118 2 nsn ,itied ,msr ,ms ,weight ,
119 3 nimpact,impact ,nsms ,nrwl_sms ,fsav ,
120 4 fopt ,res ,r ,frea )
124#include "implicit_f.inc"
125#include "comlock.inc"
129#include "com08_c.inc"
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(*)
139 INTEGER I, N, N3, N2, N1, J, K, M1, M2, M3
140 my_real XWL, YWL, ZWL, VXW, VYW, VZW,
142 . xc, yc, zc, xx, xn, yn, zn,
144 . fnxn, fnyn, fnzn, fnxt, fnyt, fnzt, fndfn, ftdft, fric, fric2,
145 . fcoe, fac,
alpha, alphi, fxt, fyt, fzt
190 xx=sqrt(xc**2+yc**2+zc**2)
195 fn=res(n1)*xn+res(n2)*yn+res(n3)*zn
200 fnxt=res(n1)*dt12-fnxn
201 fnyt=res(n2)*dt12-fnyn
202 fnzt=res(n3)*dt12-fnzn
205 fndfn=fnxn**2+fnyn**2+fnzn**2
206 ftdft=fnxt**2+fnyt**2+fnzt**2
207 IF(ftdft <= fric2*fndfn)
THEN
211 fcoe=fric*sqrt(fndfn/ftdft)
242 1 (x ,a ,v ,rwl ,nsw ,
243 2 nsn ,itied ,msr ,ms ,weight ,
244 3 nimpact,impact ,nsms ,nrwl_sms)
248#include "implicit_f.inc"
249#include "comlock.inc"
253#include "com08_c.inc"
257 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
258 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
261 . x(*), a(*), v(*), rwl(*), ms(*)
265 INTEGER I, N, N3, N2, N1, J, , M1, M2, M3
269 . xwl, ywl, zwl, vxw, vyw, vzw,
271 . xc, yc, zc, xx, xn, yn, zn,
312 xx=sqrt(xc**2+yc**2+zc**2)
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
334 a(n1)=-(v(n1)-vxw)/dt12
335 a(n2)=-(v(n2)-vyw)/dt12
336 a(n3)=-(v(n3)-vzw)/dt12
352 xx=sqrt(xc**2+yc**2+zc**2)
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
360 IF(impact(j) > 0)
THEN
362 a(n1)=-(v(n1)-vxw)/dt12
363 a(n2)=-(v(n2)-vyw)/dt12
364 a(n3)=-(v(n3)-vzw)/dt12
382 1 (x ,a ,v ,rwl ,nsw ,
383 2 nsn ,itied ,msr ,ms ,weight ,
384 3 nimpact,impact ,nsms ,nrwl_sms)
388#include "implicit_f.inc"
389#include
"comlock.inc"
393#include "com08_c.inc"
397 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
398 INTEGER NSW(*), WEIGHT(*), IMPACT(*), NRWL_SMS(*)
401 . x(*), a(*), v(*), rwl(*), ms(*)
405 INTEGER I, N, N3, N2, N1, J, M1, M2
409 . xwl, ywl, zwl, vxw, vyw, vzw,
411 . xc, yc, zc, xx, xn, yn, zn,
452 xx=sqrt(xc**2+yc**2+zc**2)
456 da =a(n1)*xn+a(n2)*yn+a(n3)*zn
489 xx=sqrt(xc**2+yc**2+zc**2)
493 da =a(n1)*xn+a(n2)*yn+a(n3)*zn
495 IF(impact(j) > 0)
THEN
519 1 (x ,frea ,v ,rwl ,nsw ,
520 2 nsn ,itied ,msr ,ms ,weight ,
521 3 nimpact,impact ,nsms ,nrwl_sms,fsav ,
522 4 fopt ,frwl6 ,a ,wfext)
526#include "implicit_f.inc"
527#include "comlock.inc"
531#include "com06_c.inc"
532#include "com08_c.inc"
536 INTEGER NSN, ITIED, MSR, NIMPACT, NSMS
537 INTEGER (*), 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
544 INTEGER I, N, N3, N2, N1, J, K, M1, M2, M3
546 . vxw, vyw, vzw, vx, vy, vz, xwl0, ywl0, zwl0,
547 . xc, yc, zc, xx, xn, yn, zn,
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),
566 vxw=v(m1)+half*a(m1)*dt12
567 vyw=v(m2)+half*a(m2)*dt12
568 vzw=v(m3)+half*a(m3)*dt12
588 xx=sqrt(xc**2+yc**2+zc**2)
593 fn=frea(1,n)*xn+frea(2,n)*yn+frea(3,n)*zn
626 xx=sqrt(xc**2+yc**2+zc**2)
631 fn=frea(1,n)*xn+frea(2,n)*yn+frea(3,n)*zn
642 vx=v(n1)+half*a(n1)*dt12
643 vy=v(n2)+half*a(n2)*dt12
644 vz=v(n3)+half*a(n3)*dt12
648 fxt=weight(n)*frea(1,n)-fxn
649 fyt=weight(n)*frea(2,n)-fyn
650 fzt=weight(n)*frea(3,n)-fzn
654 wfextt = wfextt -dt12*((vx-vxw)*fxt+(vy-vyw)*fyt+(vz-vzw)*fzt)
660#include "lockoff.inc"
subroutine sms_rgwal_0(iflag, x, v, rwbuf, lprw, nprw, ms, fsav, fr_wall, fopt, rwsav, weight, irwl_work, nrwl_sms, frwl6, a, res, r, frea, wfext)
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_bilan(x, frea, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, frwl6, a, wfext)