ELASTIC SCATTERING ON A SPHERE
K.5.4:

Franz Michel, Bernhard Schnizer
Institut fuer Theoretische Physik
Technische Universitaet Graz
A-8010  Graz, Austria
Projekt Multimediale Lehre des
Zentralen Informatikdienstes der TU Graz
2001-12-01

Parameters

Needs["Graphics`Graphics`"]

External parameters

internal parameters

a  = 
        1;                                                                                                                             (* 
      radius of the sphere *) 
xl  =  - 
            3 a;                                                                                                                   (* left edge of image   *) 
xr  =   1.5  
          a;                                                                                                                (* right edge of image  *) 
bk  = 
        Graphics[{Thickness[ .009], 
            Circle[{0, 0},  a]}];          
bilder  = 
        20;                                                                                                          (* 
      number of pictures per particle scattered *)

Start Button for Animations

start = 
        ButtonBox[
          StyleBox["Run Animation", "Title", 
            FontFamily -> "Helvetica"], 
          ButtonFunction :> 
            FrontEndExecute[{SelectionMove[EvaluationNotebook[], Before, 
                    ButtonCell]
SelectionMove[
                    EvaluationNotebook[], Previous, 
                    CellGroup]
SelectionAnimate[
                    SelectedNotebook[], AnimationDisplayTime -> zeit]}], 
          ButtonEvaluator -> Automatic, 
          Active -> True];

Angle of incidence is equal to the angle of reflexion

s		Impact parameter (in units of the radius of the sphere, which is 1.),   
		Stossparameter (in Enheiten des Radius der Streukugel, der = 1 ist).
a		Radius of scattering shpere; Radius der Streukugel.
pa		Starting point of the particle, Startpunkt der Bahn.
pr		Reflexion point g on the sphere, Reflexionspunkt auf der Kugel.
pe		Endpoint of drawn trajectory, Endpunkt der Bahnzeichnung.
α		reflection angle, Reflexionswinkel.
θ		Scattering angle, Streuwinkel.
xlz		Left edge of the drawing, linkseitiges Ende der Skizze.
wr		Thickness of the circle, Dicke des Kreises.
The particle starts at pa and is scattered at the point pr on the sphere. The path is drawn as far as pe.

pr  =  {-Sqrt[a^2  -  s^2], s}  ;   
pa  =  {xl, s};
pe  =  {xl Cos[2  α], 
          s  -  xl  Sin[2  α] };
α    =   ArcSin[
          s/a] ;                                   
xlz  =  - 2 
          a  ;                                                     
wr  =   .35;
bk  = 
        Graphics[{Thickness[ .009], 
            Circle[{0, 0},  
              a]}];                                             
\(\(bt\  = 
        Graphics[{Hue[ .6], Text["θ", 1.3 {\(- .3\), 1}], 
            Thickness[ .007], 
            Circle[pr, 
              wr, {0, π - 
                  2  α\  - \  .15}], \ \ 
Line[{pa, 
                pr}], Line[{pr, pe}], \ 
Dashing[{ .02}], 
            Line[{{xl, 0}, pa}], Text["s", {xl + \  .2, s/2}], 
            Dashing[{}], 
\ \ \ Hue[0], 
            Line[{{0, 0}, 2  pr}], Text["α", 1.2 {\(-1.2\),  .9}], 
            Text["α", 
              1.2 {\(-0.8\), 
                  1.15}], 
\ \ \ Text["a", {\(- .45\),  .25}], Circle[pr, 
              wr, {π\  - \ 2\ α\  - 
                  0.15, π}], 
\ \ \ Dashing[{0.02}], 
            Line[{pr, { .5, s}}]}];\)\)
Show[bt, bk, AspectRatio  ->  Automatic, 
        Axes  ->  True,  Ticks  ->  False, 
        PlotRange  ->  {-1, 2.5}, 
        TextStyle  ->  {FontSize  -> 18}, 
        ImageSize ->  500];

Scattering angle

θ   = 
        If[ss/a  ≤  1,   π  - 2 ArcSin[ss/a], 
          0];
\(\(Plot[θ // Evaluate, {ss, 0, π/2}, 
        Ticks\  -> {Append[ .1\ {2, 4, 6, 8, 10, 12, 14}, π/
                2], π {1/4, 1/2, 3/4, 1}}, 
        AspectRatio\  -> \ \ 1, 
\ \ AxesLabel\  -> {StyleForm["s/a", FontSize -> \ 16], 
            StyleForm["θ", FontSize -> \ 16]}, 
        PlotStyle\  -> \ Thickness[ .007], 
        Epilog\  -> {Text[
              StyleForm["scattering angle θ as a function 
 of the relative scattering parameter s/a", FontSize -> \ 14], {1, π}], \ 
            Line[{{0, π}, {π/2, 0}}]}\ , 
        ImageSize -> \ 500];\)\)

Path of a scattered particle

\(tr[sss_, 
        huei_]\  := \ \ Module[{pr, pa, α, 
          pe}, 
\ \ \ \ \ \ \ \ If[
          Abs[sss]\  >= \ 
            a, \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*\ 
            passing\ particle\ *) 
\ \ \ \ \ \ \ \ \ \ \ \ \ Return[ListPlot[{{xl, sss}, {\(-xl\), sss}}, 
              PlotJoined\  -> 
                True, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ PlotStyle\  -> \ {GrayLevel[0], 
                  AbsoluteThickness[
                    2]}]], 
\ \ \ \ \ \ \ \ \ \ \ \ \ pr\  = \ {\(-Sqrt[a^2\  - \ sss^2]\), sss}; 
          pa\  = \ {xl, sss}; \  (*\ 
            deflected\ particle\ *) 
		α\ \ \  = \ \ ArcSin[
              sss/a]; 
	\ \ \ \ \ \ \ \ \ \ pe\  = 
            pr + {xl\ Cos[2  α], \(-xl\)\ \ Sin[
                    2  α]\ }; 
	\ \ \ Return[
            ListPlot[{pa, pr, pe}, 
              PlotJoined\  -> 
                True, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ PlotStyle\  -> \ {Hue[Abs[huei]], AbsoluteThickness[2]}]]]]\)

SetOptions[ListPlot, 
        DisplayFunction  ->  Identity];

ltr  = Table[tr[i, i], {i, -1.5, 1.5, 0.1}];

bk  = 
        Graphics[{Thickness[ .005], 
            Circle[{0, 0},  a]}];

Show[ltr, bk,  AspectRatio  ->  Automatic, 
        Axes  -> 
          False, 
DisplayFunction  ->   $DisplayFunction, 
        Background   -> 
          GrayLevel[1], 
Epilog  -> {Hue[0], 
            AbsoluteThickness[3], Line[{{xl, 0}, {-a, 0}}], 
            Point[{0, 0}]}, ImageSize ->  600];

Distribution of scattered particle on a spherical screen.

bk  = 
        Graphics[{Thickness[ .009], 
            Circle[{0, 0},  a]}];  
vs  =   .89;
\(\(tp\  = 
        Prepend[{Point[{0, 0}], 
            Line[{a {Cos[vs], Sin[vs]}, \ {0, 0}, {a, 0}}], 
            Circle[{0, 0}, \  .2\ a, {0, 
                vs}], \ \ 
\ \ Text["θ",  .3\ a {Cos[vs/2], Sin[vs/2]}]}, 
          Table[{Hue[ss // Abs], 
              Point[a {Cos[θ], 
                    Sin[θ]}]}, {ss, \(- .9\),  .9,  .1}]];\)\)
Show[bk,  AspectRatio  ->  Automatic, Axes  ->  False, 
        Epilog  ->  tp, 
        Prolog -> 
          PointSize[ .025], 
       DisplayFunction  ->   $DisplayFunction];

Scattering of indivdual particles

trp[sss,t]	calculates and plots the path of the particle with the scattering parameter sss at time t

xl  =   - 
            3 a;                          
\(lges = \(-2\)\ xl\ \  - \ \ a\ \ \ ; \ \ \ \ \ \ \ \  (*howl\ length\ of\ the\ path*) 

    trp[sss_, t_]\  := \ \ Module[{pr, pa, α, pe, trpoint}, 
        pa\  = \ {xl, sss}; 
\ 
        If[Abs[sss]\  >= \ a, lges = \(-2\)\ xl\ \  - \ \ a\ ; \ 
          pe = {xl + lges, sss}; pr = pe; 
          trpoint = {xl + lges\ t\ /bilder, 
              sss}, 

\ \ \ \ \ \ \ \ \ pr\  = \ {\(-Sqrt[a^2\  - \ sss^2]\), 
              sss}; 
\ \ \ \ \ \ \ \ \ \ α\ \ \  = \ \ ArcSin[sss/a]; 
	
          lges = \(-2\)\ xl - 
              a\ Cos[α]; 
\ \ \ \ \ \ \ \ \ \ pe\  = 
            pr + {xl\ Cos[2  α], \(-xl\)\ \ Sin[
                    2  α]\ }; 
\ \ \ \ \ \ \ \ \ If[
            Abs[First[Thread[pr - pa]]] > \ \ lges\ t/bilder, ts = t; 
            trpoint = {xl + lges\ t\ /bilder, 
                sss}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ trpoint = pr + \((pe - pr)\)/
                    Sqrt[\((pe - pr)\) . \((pe - pr)\)]\ lges\ \ \((t - ts)\)/
                    bilder]]; {trpoint, pa, pr, 
          pe}
]\)

sss		table of randomly chosen scattering parameters

sss = 
        Table[Random[Real, {-1.5 a, 1.5 a}], {i, 1, 
            AnzahlStreu}];

anim = 
        Table[
Table[{PointSize[0.02], 
              GrayLevel[
                0], 
Point[trp[sss[[i]], 
                    t][[1]]], 
              Hue[0], 
Line[{trp[sss[[i]], 
                      t][[2]], trp[sss[[i]], 
                      t][[3]]}], 
Line[{trp[
                      sss[[i]], t][[3]], trp[sss[[i]], 
                      t][[4]]}]}, {t, 0, 
              bilder}], 
{i, 1, AnzahlStreu}];

Table[
{Table[
            Show[{Graphics[anim[[i, t]]], 
                bk}, 
AspectRatio ->  Automatic, 
              Axes ->  False, 
              PlotRange ->  {{xl - a, 4  a}, {-4 a, 4 a}}, 
              ImageSize ->  500], {t, 1, 
              bilder}], 
Table[
            Show[bk, AspectRatio ->  Automatic, Axes ->  False, 
              PlotRange ->  {{xl - a, 4  a}, {-4 a, 4 a}}, 
              ImageSize ->  500], {i, 1, 5}]}, 
{i, 
          1, AnzahlStreu}];
SelectionMove[EvaluationNotebook[], After, 
        EvaluationCell];
SelectionMove[EvaluationNotebook[], Next, CellGroup];
FrontEndTokenExecute["OpenCloseGroup"];
start /. zeit ->  0.05  // DisplayForm