Parametric Plot 3D error in heat equation in polar coordinates

Questions
, ,
1

As I posted in Parametric Plot 3D error in heat equation in polar coordinates They tried to explain me but I have confused worst now.

So the problem is the following

\begin{align} u_t&=v*(u_{rr}+r^{-1}u_r), \quad 0\leq r <a , t>0\\ u(r,0)&=f(r)\\ u(a,t)&=0 ,\quad t \geq0 \end{align}

We know that f(r)=J_0(x_{01}r), where x_{01} is the first positive root of the Bessel Function and a=v=1

Solution

Now we solve the problem with the method separation of variables.
Let

u(r)=R(r)T(t).

Then,

R(r)T'(t)=R''(r)T(t)+r^{-1} R'(r)T(t)

We divide both sides with R(r)T(t).
Thus,

\frac{T'(t)}{T(t)}=\frac{R''(r)}{R(r)}+r^{-1}\frac{R'(r)}{R(r)}=-\lambda

So we have the following two equations

r\cdot R''(r)+R'(r)+\lambda\cdot r R(r)=0, \quad 0<r<1 \tag 1

It is Sturm Liouville problem, from which we can conclude
the weight function is w=r. We change variables x=k \cdot r then we obtain

x\bar{R''}+\bar{R'}+x\bar{R}=0 \tag2

The equation (2) has as solution the Bessel function \bar{R}=J_0(x)=J_0(kr).

The boundary condition u(a,t)=0, t \geq 0 become R(a)=0, so J_0(ka)=0. That means k \cdot a must be the root of the Bessel function with zero order.

k_m \cdot a= x_{0m}, \quad m=1,2,...

Now W'(t)+\lambda W(t)=0 has general solution

W(t)=c_1 e^{-\lambda \cdot t} \tag3

Then we have

W(t)=c_1 e^{-k_n^2 \cdot t}

Now from superposition, the general solution to the problem will be

u(r,t)=\sum_{n=1}^{\infty} d_m \cdot e^{-k_n^2 \cdot t} \cdot J_0(k_m r)

and the coefficient will be

d_m=\frac{2 \int_{0}^{a} r \cdot f(r) \cdot J_0(k_m r) dr}{a^2 J_1^2(x_m )}, where \quad k_m=\frac{x_{0m}}{a}

Now I am trying to write the Mathematica code

a = 1;
x0[m_] := N[BesselJZero[0, m]]
(*d definition of the function f(r)*)

f[r_] := BesselJ[0, x0[1]*r]
k[m_] := x0[m]/a
(* Computation of the Fourier coefficients*)
d[m_] := (2 \!\(
\*SubsuperscriptBox[\(\[Integral]\), \(0\), \(a\)]\(r*
    BesselJ[0, k[m]*r]\ *f[r] \[DifferentialD]r\)\))/(
 a^2*BesselJ[1, x0[m]]^2)
(*Construction of the exact solution*)

u[r_, t_, m_] := d[m]*E^(-k[m]^2*t)*BesselJ[0, k[m]*r]
uapprox[r_, t_] = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = 1\), \(10\)]\(u[r, t, n]\)\);
(*Graph of the exact solution*)
Manipulate[
 ParametricPlot3D[{r*Cos[\[Theta]], r*Sin[\[Theta]], 
   uapprox[r, t]}, {r, 0, 1}, {\[Theta], 0, 2 Pi}, 
  PlotRange -> {-1.2, 1.2}, BoundaryStyle -> Directive[Red, Thick], 
  ColorFunction -> "SolarColors", Mesh -> True], {t, 0, 10, 0.0001}]

graphs = 
 Table[ParametricPlot3D[{r*Cos[\[Theta]], r*Sin[\[Theta]], 
    uapprox[r, t]}, {r, 0, 1}, {\[Theta], 0, 2 Pi}, 
   PlotRange -> {-1.2, 1.2}, BoundaryStyle -> Directive[Red, Thick], 
   ColorFunction -> "SolarColors"], {t, 0, 2.5, 2.5/8}]

Animate[ParametricPlot3D[{r*Cos[\[Theta]], r*Sin[\[Theta]], 
   uapprox[r, t]}, {r, 0, 1}, {\[Theta], 0, 2 Pi}, 
  PlotRange -> {-1.2, 1.2}, BoundaryStyle -> Directive[Red, Thick], 
  ColorFunction -> "SolarColors", Mesh -> True], {t, 0, 10, 0.0001}]

When I try to run ParametricPlot3D gives me. Could anyone explain to me, please, why I received that answer?

BsnIT.jpg
BsnIT.jpg2826×1468 154 KB

2

I think I found the solution as the notebook shows. Could anyone verify my solution, please?

Open in Wolfram Cloud ↗