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

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

2D Heat Equation Movies:   Figures 11.2, 11.7, 11.8, 11.9.

General 3D plotting routine — rectangular coordinates

plr[t_]:=Print[Plot3D[u[t,x,y],{x,(Subscript[x, 0]),(Subscript[x, 1]) },{y,(Subscript[y, 0]) , (Subscript[y, 1])},PlotPoints ->{pp,pp},PlotRange ->{(Subscript[u, 0]),(Subscript[u, 1])},BoxRatios-> br,Boxed -> False, Axes -> False,Mesh -> None,ViewPoint -> vp, PlotStyle->{Opacity[op],Specularity[White,10]}]];

General 3D plotting routine — polar coordinates

plp[t_]:=Print[ParametricPlot3D[{r Cos[θ],r Sin[θ],u[t,r,θ]},{r,0,(Subscript[r, 0])},{θ,-π,π},PlotPoints ->{pp,pp},PlotRange ->{{(Subscript[x, 0]),(Subscript[x, 1])},{(Subscript[y, 0]),(Subscript[y, 1])},{(Subscript[u, 0]),(Subscript[u, 1])}},BoxRatios-> br,Boxed -> False, Axes -> False,Mesh -> None,ViewPoint -> vp, PlotStyle->{Opacity[op],Specularity[White,10]}]];

Figure 11.2. Heat diffusion in a rectangle

Set initial data as a combination of two simple functions

f//ClearAll;g//ClearAll;d //ClearAll;

(Subscript[f, 1])[x_] := Which[x < .5,x,True,(2-x)/3]

(Subscript[g, 1])[y_] := Which[y < .3,y,True,(1-y)3/7]

(Subscript[f, 2])[x_] :=  Which[x <1.5,x,True,(2-x)3]

(Subscript[g, 2])[y_] :=Which[y < .7,y,True,(1-y)7/3]

(Subscript[d, 1])=1; (Subscript[d, 2]) =- .08; 
f[x_,y_] = (Subscript[d, 1])(Subscript[f, 1])[x]  (Subscript[g, 1])[y] + (Subscript[d, 2]) (Subscript[f, 2])[x]  (Subscript[g, 2])[y];

Determine Fourier coefficients

a //ClearAll;b //ClearAll;c //ClearAll;

cf //ClearAll;cg //ClearAll;

a = 2; b = 1;

(Subscript[cf, 1])[m_] := (Subscript[cf, 1])[m] =(2/a)NIntegrate[(Subscript[f, 1])[ξ] Sin[((m π ξ)/a)] ,{ξ,0,a}]; (Subscript[cg, 1])[m_] := (Subscript[cg, 1])[m] = (2/b)NIntegrate[(Subscript[g, 1])[η] Sin[((m π η)/b)] ,{η,0,b}]; (Subscript[c, 1])[m_,n_] := (Subscript[c, 1])[m,n] = (Subscript[cf, 1])[m]  (Subscript[cg, 1])[n];

(Subscript[cf, 2])[m_] := (Subscript[cf, 2])[m] =(2/a)NIntegrate[(Subscript[f, 2])[ξ] Sin[((m π ξ)/a)] ,{ξ,0,a}]; (Subscript[cg, 2])[m_] := (Subscript[cg, 2])[m] = (2/b)NIntegrate[(Subscript[g, 2])[η] Sin[((m π η)/b)] ,{η,0,b}]; (Subscript[c, 2])[m_,n_] := (Subscript[c, 2])[m,n] = (Subscript[cf, 2])[m]  (Subscript[cg, 2])[n];

c[m_,n_] := c[m,n] = (Subscript[d, 1])(Subscript[c, 1])[m,n]  + (Subscript[d, 2]) (Subscript[c, 2])[m,n];

Determine corresponding Fourier series solution

λ //ClearAll;u//ClearAll;

λ[m_,n_] :=(π^2) (((m^2)/(a^2)) + ((n^2)/(b^2)))

mm = nn = 10;

u[t_,x_,y_] = Sum[c[m,n] Exp[- λ[m,n] t] Sin[((m π x)/a)] Sin[((n π y)/b)],{m,mm},{n,nn} ];

u[0,x_,y_] =u[0.,x_,y_] = f[x,y];

Set plotting parameters

(Subscript[x, 0]) =0;(Subscript[x, 1])=a;(Subscript[y, 0]) =0; (Subscript[y, 1]) =b; (Subscript[u, 0]) =-.075; (Subscript[u, 1]) = .15; 
pp = 50;vp = {1.3,2.4,.6} ;op = 0.8;br = {2,1,1};

Set time range

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

Plot movie  — evaluate Notebook to generate output

plr /@ ts;

Figure 11.7. Heat diffusion in a disk

Determine solution as linear combination of Bessel eigenfunctions

mm = 3; nn = 2; b = 3.5;
bzs = Table[BesselJZero[m,n]//N,{m,0,mm},{n,1,nn}];
cfs= {{1,.3},{1,.2},{-2,.5},{2,.4}};

u//ClearAll;

u[t_,r_,θ_] =  Sum[cfs[[m+1,n]](E^(- bzs[[m+1,n]]^2 t)) BesselJ[m, bzs[[m+1,n]] r]Cos[m (θ+ b)],{m,0,mm},{n,1,nn}];

Set plotting parameters

a=1;(Subscript[x, 0]) =-a;(Subscript[x, 1])=a;(Subscript[y, 0]) =-a; (Subscript[y, 1]) =a;(Subscript[r, 0]) = a; (Subscript[u, 0]) =-2; (Subscript[u, 1]) =2; 
pp = 50;vp = {1.3,-2.4,2};op = 0.8;br =Automatic;

Set time range

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

Plot movie  — evaluate Notebook to generate output

plp /@ ts;

Figure 11.8. Fundamental solution of the planar heat equation

Determine solution

u//ClearAll;

u[t_,x_,y_] =(( (E^(-((((x^2) + (y^2)))/(4t)) )))/(4π t))

Set plotting parameters

a=2;(Subscript[x, 0]) =-a;(Subscript[x, 1])=a;(Subscript[y, 0]) =-a; (Subscript[y, 1]) =a; (Subscript[u, 0]) =0; (Subscript[u, 1]) = 8; 
pp = 50;vp =  {1.3,-2.4,1} ;op = 0.8;br = {1,1,1};

Set time range

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

δt = .0025;ti =.01; tf = .25;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

plp /@ ts;

Figure 11.9. Diffusion of a disk

Determine solution

r//ClearAll; u//ClearAll; w//ClearAll;  v//ClearAll;

v[r_] := 
{r,(1/(4π s))NIntegrate[ Exp[-(r^2 + ρ^2 -2 r ρ Cos[φ]) /(4s)] ρ,{φ,0,2π},{ρ,0,1}]};

rmax = 2;dr = .1;

s = .1;w= Interpolation[ v /@  Range[0,rmax,dr]];

Set plotting parameters and routine

a=2;(Subscript[x, 0]) =-a;(Subscript[x, 1])=a;(Subscript[y, 0]) =-a; (Subscript[y, 1]) =a; (Subscript[u, 0]) =-.1; (Subscript[u, 1]) = 1.1; 
rmax = 3;dr = .1; ϵ = .01;
pp = 50;vp = {1.3,-2.4,.6};op = 0.8;br =Automatic;

plw[t_] := ( s = t;w= Interpolation[ v /@  Range[0,rmax,dr]];
          Print[Plot3D[w[(Sqrt[x^2+y^2])],{x,(Subscript[x, 0]),(Subscript[x, 1]) },{y,(Subscript[y, 0]) , (Subscript[y, 1])},Boxed->False,Axes->False,PlotPoints ->{pp,pp},PlotRange ->{(Subscript[u, 0]),(Subscript[u, 1])},BoxRatios-> br,Boxed -> False, Axes -> False,Mesh -> None,ViewPoint -> vp, PlotStyle->{Opacity[op],Specularity[White,10]}]]);

plw[0.] := 
( w0[r_] :=  Which[r < 1 - ϵ,1,r < 1,1 - (r-1+ϵ)/ϵ,True,0];
         Print[Plot3D[w0[(Sqrt[x^2+y^2])],{x,(Subscript[x, 0]),(Subscript[x, 1]) },{y,(Subscript[y, 0]) , (Subscript[y, 1])},Boxed->False,Axes->False,PlotPoints ->{pp,pp},PlotRange ->{(Subscript[u, 0]),(Subscript[u, 1])},BoxRatios-> br,Boxed -> False, Axes -> False,Mesh -> None,ViewPoint -> vp, PlotStyle->{Opacity[op],Specularity[White,10]}]]);

Set time range

ti= 0;tf =1.25; δt = .005;ts = Range[ti,tf,δt];

Plot movie  — evaluate Notebook to generate output

plw /@ ts;