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

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

Nonlinear Transport Movies:
     Figures 2.11, 2.14, 2.15, 2.17, 2.20, 2.21, 2.22

General plotting routine

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]}]]

pp[t_] := Print[ParametricPlot[v[t,x],{x,(Subscript[x, s]),(Subscript[x, f])},PlotRange ->{{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]),(Subscript[y, 1])}},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[hu]}]]

ppp[t_] := (pv = ParametricPlot[v[t,x],{x,(Subscript[x, s]),(Subscript[x, f])},PlotRange ->{{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]),(Subscript[y, 1])}},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[huv]}];pw= ParametricPlot[w[t,x],{x,(Subscript[x, s]),(Subscript[x, f])},PlotRange ->{{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]),(Subscript[y, 1])}},AspectRatio -> asp,Ticks -> None,PlotStyle -> {Thickness[th],Hue[huw]}];Print[Show[pv,pw]];)

th = .004; hu = .6;

Figure 2.11.  Two solutions to   (Subscript[u, t]) + u (Subscript[u, x]) = 0

Define solution

a=.; b=.; u//ClearAll;

u[t_,x_] :=((a x+b)/(1+a t))

Set plotting parameters

(Subscript[x, 0]) = -2;(Subscript[x, 1])=2;(Subscript[y, 0]) = -1.1; (Subscript[y, 1]) = 1.1; asp = Automatic;

Set parameters and time range and then plot movies — evaluate Notebook to generate output

a = 1;b = .5;

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

hu = .6;pl /@ ts;

a = -.2;b = .1;

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

hu = .05;pl /@ ts;

Figure 2.14.  Rarefaction wave

Set initial wave profile

v//ClearAll;

(Subscript[u, 0])[x_] := ArcTan[3x] + π/2;

Define solution as parametric curve

v[t_,x_] := {x + t (Subscript[u, 0])[x],(Subscript[u, 0])[x]};

Set plotting parameters

(Subscript[x, s]) = (Subscript[x, 0]) = -3;(Subscript[x, f]) = (Subscript[x, 1])=10;(Subscript[y, 0]) = -.3; (Subscript[y, 1]) = 3.5; asp =Automatic;

Set time range

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

Plot movie  — evaluate Notebook to generate output

hu = .6;pp /@ ts;

Figure 2.15.  Multiply-valued compression wave

Set initial wave profile

v//ClearAll;w//ClearAll;

(Subscript[u, 0])[x_] := ArcTan[-x] + π/2;

Define solution as parametric curve

v[t_,x_] := {x + t (Subscript[u, 0])[x],(Subscript[u, 0])[x]};

Set plotting parameters

(Subscript[x, s]) = -25;(Subscript[x, 0]) = -7;(Subscript[x, f]) = (Subscript[x, 1])=10;(Subscript[y, 0]) = -.3; (Subscript[y, 1]) = 3.5; asp =Automatic;

Set time range

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

Plot movie  — evaluate Notebook to generate output

Multiply-valued solution

hu = .95;pp /@ ts;

Equal area rule

ws= Table[{x/ArcTan[x],x},{x,.001,10,.1}];

ww = Interpolation[ws];

sw[t_,x_] := Which[t<1.01,(Subscript[u, 0])[x],True,Which[Abs[x] > ww[t] ,(Subscript[u, 0])[x],True,- ((ArcTan[ww[t]])/(ww[t])) x + π/2]]; w[t_,x_] := {x + t sw[t,x],sw[t,x]};

huv = .95;huw = .6;p2 = ppp /@ ts;

Shock wave

ww = Table[{x/ArcTan[x],x},{x,.001,10,.1}];
w = Interpolation[ww];

sw[t_,x_] := Which[t<1.01,(Subscript[u, 0])[x],True,Which[Abs[x] > w[t] ,(Subscript[u, 0])[x],True,- ((ArcTan[w[t]])/(w[t])) x + π/2]];

v[t_,x_] := {x + t sw[t,x],sw[t,x]};

hu = .6;pp /@ ts;

Figure 2.17.  Multiply-valued step wave

Graph axes

li[v_,w_] := Graphics[Line[{v,w}]];

a=10;ax = {li[{-a,0},{a,0}],li[{0,-a},{0,a}]};

Set plotting parameters

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

Set time range

ti = 0; tf = 8;δt = .1;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

a=.85;b=.2; s = ((a+b)/2);xs = 2;

Multiply-valued solution

sm[t_] :=Graphics[{Hue[hum],Thickness[th],Line[{{(Subscript[x, 0]),a},{xs + a t,a},{xs + b t,b},{(Subscript[x, 1]),b}}]}];

plm[t_] :=Print[Show[ax,sm[t],AspectRatio ->asp,PlotRange -> {{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]) , (Subscript[y, 1])}}]];

hum = .95;plm/@ ts;

Equal area rule

sm[t_] :=Graphics[{Hue[hum],Thickness[th],Line[{{(Subscript[x, 0]),a},{xs + a t,a},{xs + b t,b},{(Subscript[x, 1]),b}}]}];

sh[t_] :=Graphics[{Hue[huh],Thickness[th],Line[{{(Subscript[x, 0]),a},{xs + s t,a},{xs + s t,b},{(Subscript[x, 1]),b}}]}];

plmh[t_] :=Print[Show[ax,sm[t],sh[t],AspectRatio ->asp,PlotRange -> {{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]) , (Subscript[y, 1])}}]];

hum = .95;huh = .6;plmh/@ ts;

Shock wave

sh[t_] :=Graphics[{Hue[huh],Thickness[th],Line[{{(Subscript[x, 0]),a},{xs + s t,a},{xs + s t,b},{(Subscript[x, 1]),b}}]}];

plh[t_] :=Print[Show[ax,sh[t],AspectRatio ->asp,PlotRange -> {{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]) , (Subscript[y, 1])}}]];

huh = .6;plh/@ ts;

Figure 2.20.  Rarefaction wave

Graph axes

li[v_,w_] := Graphics[Line[{v,w}]];

a=10;ax = {li[{-a,0},{a,0}],li[{0,-a},{0,a}]};

Set plotting parameters

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

Set time range

ti = 0; tf = 8;δt = .1;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

a=.2;b=.85; s = ((a+b)/2);xs = 2;

sr[t_] :=Graphics[{Hue[hur],Thickness[th],Line[{{(Subscript[x, 0]),a},{xs + a t,a},{xs + b t,b},{(Subscript[x, 1]),b}}]}];

plr[t_] :=Print[Show[ax,sr[t],AspectRatio ->asp,PlotRange -> {{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]) , (Subscript[y, 1])}}]];

hur= .6;plr/@ ts;

Figures 2.21, 2.22.  Triangular-wave solution

Set plotting parameters

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

Draw axes

li[v_,w_] := Graphics[Line[{v,w}]];

ax = {li[{(Subscript[x, 0]),0},{(Subscript[x, 1]),0}],li[{0,(Subscript[y, 0])},{0,(Subscript[y, 1])}]};

Set time range

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

Plot movie  — evaluate Notebook to generate output

Multiply-valued solution

sm[t_] :=Graphics[{Hue[hum],Thickness[th],Line[{{(Subscript[x, 0]),0},{0,0},{1 +t,1},{1,0},{(Subscript[x, 1]),0}}]}];

plm[t_] :=Print[Show[ax,sm[t],AspectRatio ->asp,PlotRange -> {{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]) , (Subscript[y, 1])}}]];

hum = .95;plm/@ ts;

Equal area rule

sm[t_] :=Graphics[{Hue[hum],Thickness[th],Line[{{(Subscript[x, 0]),0},{0,0},{1 +t,1},{1,0},{(Subscript[x, 1]),0}}]}];

st[t_] :=(s = (Sqrt[1 +  t]); Graphics[{Hue[hut],Thickness[th],Line[{{(Subscript[x, 0]),0},{0,0},{s,1/s},{s,0},{(Subscript[x, 1]),0}}]}]);

plmt[t_] :=Print[Show[ax,sm[t],st[t],AspectRatio ->asp,PlotRange -> {{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]) , (Subscript[y, 1])}}]];

Triangular wave

st[t_] :=(s = (Sqrt[1 +  t]); Graphics[{Hue[hut],Thickness[th],Line[{{(Subscript[x, 0]),0},{0,0},{s,1/s},{s,0},{(Subscript[x, 1]),0}}]}]);

plt[t_] :=Print[Show[ax,st[t],AspectRatio ->asp,PlotRange -> {{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]) , (Subscript[y, 1])}}]];

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

hut = .6;plt/@ ts;