Heat equation on a circular disk

Code adapted from Peter Olver

Run the following to clear all variables:

Clear["Global`*"]

First, set some parameters and compute Bessel J zeros:

mMax = 3; nMax = 2; b = 3.5;
bzeros = Table[BesselJZero[m,n]//N,{m,0,mMax},{n,1,nMax}];
coeffs= {{1,.3},{1,.2},{-2,.5},{2,.4}};

Now define a solution to the heat equation on a circular disk:

u[t_,r_,θ_] :=  Sum[coeffs[[m+1,n]](E^(- bzeros[[m+1,n]]^2 t)) BesselJ[m, bzeros[[m+1,n]] r]Cos[m (θ+ b)],{m,0,mMax},{n,1,nMax}];

Animate the solution over time:

numPoints=50;
rMax=1;
Manipulate[
ParametricPlot3D[{r Cos[θ],r Sin[θ],u[t,r,θ]},{r,0,rMax},{θ,-π,π},PlotPoints ->{numPoints,numPoints},PlotRange ->{{-rMax,rMax},{-rMax,rMax},{-2,2}},ViewPoint -> {1.3,-2.4,2}, PlotStyle->{Opacity[0.8],Specularity[White,10]}],
{t,0,0.2,0.005}]

For a better quality movie, render all frames in advance. This might take a while:

frames=Table[
ParametricPlot3D[{r Cos[θ],r Sin[θ],u[t,r,θ]},{r,0,rMax},{θ,-π,π},PlotPoints ->{numPoints,numPoints},PlotRange ->{{-rMax,rMax},{-rMax,rMax},{-2,2}},ViewPoint -> {1.3,-2.4,2}, PlotStyle->{Opacity[0.8],Specularity[White,10]}],
{t,0,0.2,0.005}
];
rasterizedFrames=Map[Image,frames];

ListAnimate[rasterizedFrames]

Wave equation on a circular disk

Code adapted from Peter Olver

Run the following to clear all variables:

Clear["Global`*"]

First, set the initial displacement of the disk:

f[x_,y_] := Exp[-100((x-.5)^2 + y^2)]

Set some parameters and compute Bessel J zeros:

mMax = 20; nMax =4; 
bzeros = Table[BesselJZero[m,n]//N,{m,0,mMax},{n,1,nMax}];

Now determine Fourier-Bessel coefficients:

coeffs = Table[2NIntegrate[f[x,y] BesselJ[m, bzeros[[m+1,n]] (Sqrt[(x^2)+ (y^2)])]Cos[m  ArcTan[y/x]],{x,.3,.7},{y,-.2,.2}]/( π ((BesselJ[m+1,bzeros[[m+1,n]]])^2)),{m,0,mMax},{n,1,nMax}];
coeffs[[1]] = coeffs[[1]]/2;

Determine the solution as linear combination of Bessel eigenfunctions:

u[t_,r_,θ_] :=  Sum[coeffs[[m+1,n]]Cos[bzeros[[m+1,n]] t]  BesselJ[m, bzeros[[m+1,n]] r]Cos[m θ],{m,0,mMax},{n,1,nMax}];

Animate the solution over time:

rMax=1;
numPoints=20;
Manipulate[
ParametricPlot3D[{r Cos[θ],r Sin[θ],u[t,r,θ]},{r,0,rMax},{θ,-π,π},PlotPoints ->{numPoints,numPoints},PlotRange ->{{-rMax,rMax},{-rMax,rMax},{-0.25,1.1}},ViewPoint ->{1.3,-2.4,2}, PlotStyle->{Opacity[0.8],Specularity[White,10]}],
{t,0,12,0.1}]

For a better quality movie, render all frames in advance. This might take a while:

frames=Table[
ParametricPlot3D[{r Cos[θ],r Sin[θ],u[t,r,θ]},{r,0,rMax},{θ,-π,π},PlotPoints ->{numPoints,numPoints},PlotRange ->{{-rMax,rMax},{-rMax,rMax},{-0.25,1.1}},ViewPoint ->{1.3,-2.4,2}, PlotStyle->{Opacity[0.8],Specularity[White,10]}],
{t,0,12,0.1}
];
rasterizedFrames=Map[Image,frames];

ListAnimate[rasterizedFrames]