Movies for 
  Introduction to Partial Differential Equations
      by Peter J. Olver

Movies can be viewed at    
         http : // www.math.umn.edu/~olver/mov.html

Wave Equation Movies:
     Figures 2.24, 2.25, 2.27, (2.84), Example 2.19, 
       and Figures 4.3, 4.6.

General plotting routines

pl[t_] := Print[Plot[u[t,x],{x,(Subscript[x, 0]),(Subscript[x, 1])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[hu]}]]

plpq[t_] := (plp = Plot[p[t,x],{x,(Subscript[x, 0]),(Subscript[x, 1])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[hup]}];plq = Plot[q[t,x],{x,(Subscript[x, 0]),(Subscript[x, 1])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[huq]}]; 
Print[Show[plp,plq]])

plupq[t_] := (plu = Plot[u[t,x],{x,(Subscript[x, 0]),(Subscript[x, 1])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[hu]}];plp = Plot[p[t,x],{x,(Subscript[x, 0]),(Subscript[x, 1])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[hup]}];plq = Plot[q[t,x],{x,(Subscript[x, 0]),(Subscript[x, 1])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[huq]}]; 
 Print[Show[plu,plp,plq]])

pls[t_] := (pl1 = Plot[u[t,x],{x,(Subscript[x, 0]),(Subscript[x, 1])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[hu]}];pl2 = Plot[u[t,x],{x,(Subscript[x, i]),(Subscript[x, 0])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[hu1]}]; 
pl3 = Plot[u[t,x],{x,(Subscript[x, 1]),(Subscript[x, f])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},Ticks -> None,PlotStyle -> {Thickness[th],Hue[hu1]}]; 
Print[Show[pl1,pl2,pl3,ll,PlotRange -> {(Subscript[y, 0]),(Subscript[y, 1])}, AspectRatio -> asq, ImageSize -> 800]])

th = .004; hu = .6;

Figure 2.24. Splitting of waves

Set initial displacement

e[x_,a_] := (E^(-(x/a)^2))

f[x_] := e[x,1];

Determine corresponding solution

u//ClearAll;

u[t_,x_] := ((f[x + t] + f[x - t])/2)

Set plotting parameters

(Subscript[x, 0]) = -8;(Subscript[x, 1])=8;(Subscript[y, 0]) = -.1; (Subscript[y, 1]) = 1.; asp = .3;

Set time range

ti= 0;tf =6; δt = .05;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

pl /@ ts;

Figure 2.25. Interaction of waves

Set initial displacement

e[x_,a_] := (E^(-(x/a)^2))

f[x_] := e[x-.7,.05] + .3 e[x-1.37,.07]

Determine corresponding solution

u//ClearAll;

u[t_,x_] := ((f[x + t] + f[x - t])/2)

Set plotting parameters

(Subscript[x, 0]) = -.1;(Subscript[x, 1])=2.3;(Subscript[y, 0]) = -.1; (Subscript[y, 1]) = 1.03; asp = .4;

Set time range

ti= 0;tf =.65; δt = .01;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

pl /@ ts;

Equation (2.84): Particles and waves

Set initial wave profile

f[x_] := Sin[x];

Determine corresponding solution

u//ClearAll; p//ClearAll; q//ClearAll;

p[t_,x_] := ((f[x - t] )/2);q[t_,x_] := ((f[x + t])/2);u[t_,x_] := p[t,x]+q[t,x];

Set plotting parameters

(Subscript[x, 0]) = -10;(Subscript[x, 1])=10;(Subscript[y, 0]) = -1.2; (Subscript[y, 1]) = 1.2; asp = .45;

Set time range

ti= 0;tf =2π; δt = .05;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

Wave solution

hu = .95;pl /@ ts;

Constitutent traveling waves (particles)

hup = .6; huq = .35;plpq /@ ts;

Particles and waves

plupq /@ ts;

Figure 2.27. Error function solution to the wave equation

Set initial wave velocity

g//ClearAll; z=.;

e[x_,a_] := (E^(-(x/a)^2))

g[x_] = e[x,1];

Determine corresponding solution

u//ClearAll;

u[t_,x_] = (1/2)(∫_(x-t)^(x+t))g[z]\[DifferentialD]z;

Set plotting parameters

(Subscript[x, 0]) = -8;(Subscript[x, 1])=8;(Subscript[y, 0]) = -.1; (Subscript[y, 1]) = 1.03; asp = .4;

Set time range

ti= 0;tf =5; δt = .05;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

pl /@ ts;

Example 2.19. Forcing and resonance

Define non-resonant solution

u//ClearAll; ω = .;

u[t_,x_] := ((Sin[ω t] - ω Sin[t])/(1 - ω^2))Sin[x]

Set plotting parameters

(Subscript[x, 0]) = -π;(Subscript[x, 1])=π;(Subscript[y, 0]) = -25; (Subscript[y, 1]) = 25; asp = .5;

δt = .5; tf = 200;ts = Range[0,tf,δt];

Plot movie  — evaluate Notebook to generate output

hu=.6;ω = 1.1; pl /@ ts;

hu=.75;ω = π/3; pl /@ ts;

Define resonant solution

u[t_,x_] := ((Sin[t] - t Cos[ t])/2)Sin[x]

Set plotting parameters

(Subscript[x, 0]) = -π;(Subscript[x, 1])=π;(Subscript[y, 0]) = -25; (Subscript[y, 1]) = 25; asp = .5;

Set time range

ti= 0;tf =80; δt = .5;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

hu=.95;  pl /@ ts;

Figure 4.3. Plucked string solution of the wave equation

Dirichlet boundary conditions

Set initial displacement

f[x_] :=(mx = Mod[x-1/2,2]; Which[ mx< 1,1 /2-mx,True,mx-3 /2 ]);

Determine corresponding solution

u//ClearAll;

u[t_,x_] := ((f[x + t] + f[x - t])/2)

Set plotting parameters

(Subscript[x, 0]) = 0;(Subscript[x, 1])=1;(Subscript[y, 0]) = -.6; (Subscript[y, 1]) = .6; asp = Automatic;

Set time range

ti= 0;tf =2; δt = .02;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

hu = .6; pl /@ ts;

Set initial displacement

f[x_] :=(mx = Mod[x-2/3,2]; Which[ mx<2/3,2(1/3-mx),True,mx-4/3 ]);

Determine corresponding solution

u//ClearAll;

u[t_,x_] := ((f[x + t] + f[x - t])/2)

Set plotting parameters

(Subscript[x, 0]) = 0;(Subscript[x, 1])=1;(Subscript[y, 0]) = -.7; (Subscript[y, 1]) = .7; asp = 1;

Plot movie  — evaluate Notebook to generate output

hu = .05; pl /@ ts;

Neumann boundary conditions

Set initial displacement

f[x_] :=(mx = Mod[x,1]; Which[ mx< 1/2,mx,True,1-mx ]);

Determine corresponding solution

u//ClearAll;

u[t_,x_] := ((f[x + t] + f[x - t])/2)

Set plotting parameters

(Subscript[x, 0]) = 0;(Subscript[x, 1])=1;(Subscript[y, 0]) = -.6; (Subscript[y, 1]) = .6; asp = Automatic;

Plot movie  — evaluate Notebook to generate output

hu = .6; pl /@ ts;

Set initial displacement

f[x_] :=(mx = Mod[x-2/3,2]; Which[ mx<2/3,Abs[2(1/3-mx)],True,Abs[mx-4/3 ]]);

Determine corresponding solution

u//ClearAll;

u[t_,x_] := ((f[x + t] + f[x - t])/2)

Set plotting parameters

(Subscript[x, 0]) = 0;(Subscript[x, 1])=1;(Subscript[y, 0]) = -.7; (Subscript[y, 1]) = .7; asp = 1;

Plot movie  — evaluate Notebook to generate output

hu = .05; pl /@ ts;

Figure 4.6. Solution to wave equation with fixed ends

Special plotting routine

pls[t_] := (pl1 = Plot[u[t,x],{x,(Subscript[x, 0]),(Subscript[x, 1])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[hu]}];pl2 = Plot[u[t,x],{x,(Subscript[x, i]),(Subscript[x, 0])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[hu1]}]; 
pl3 = Plot[u[t,x],{x,(Subscript[x, 1]),(Subscript[x, f])},PlotRange ->{(Subscript[y, 0]),(Subscript[y, 1])},Ticks -> None,PlotStyle -> {Thickness[th],Hue[hu1]}]; 
Print[Show[pl1,pl2,pl3,ll,PlotRange -> {(Subscript[y, 0]),(Subscript[y, 1])}, AspectRatio -> asq, ImageSize -> 800]])

Set initial displacement

e[x_,a_] := (E^(-(x/a)^2))

d = .375;
fa[x_] = Sum[ e[x-d-2 k,.05] + .37  e[x-d-2 k-.09,.055] ,{k,-3,4}];
f[x_] = fa[x] - fa[-x];

Determine corresponding solution

u//ClearAll;

u[t_,x_] := ((f[x + t] + f[x - t])/2)

Set plotting parameters

(Subscript[x, i]) = -4;(Subscript[x, 0]) = 0;(Subscript[x, 1])=1;(Subscript[x, f])=4;(Subscript[y, 0]) = -1.2; (Subscript[y, 1]) = 1.2; asp = .6; asq = .15;

Set time range

ti= 0;tf =2.2; δt = .025;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

hu = .95;pl /@ ts;

li[v_,w_] := Graphics[{ Thickness[th],Line[{v,w}]}];
th = .001;ll = {li[{(Subscript[x, 1]),(Subscript[y, 0])},{(Subscript[x, 1]),(Subscript[y, 1])}]};

hu = .95;hu1 = .6;pls /@ ts;