Simulating the Conduction of Heat on a Metal Rod

Question

Consider the one-dimensional heat equation $$ \frac{\partial u(x,t)}{\partial t}=\alpha\frac{\partial^2 u(x,t)}{\partial x^2}, \quad (x,t)\in (0,L)\times (0,\infty), $$ subject to the Dirichlet boundary conditions $$ u(0,t)=u(L,t)=0, \quad t\in (0,\infty), $$ and initial condition $$ u(x,0)=f(x), \quad x\in (0,L). $$ A solution of the above problem is given by $$ u(x,t)=\sum_{n=1}^\infty A_n\sin\left(\frac{n\pi}{L}x\right)e^{-\alpha n^2\pi^2t/L^2} $$ I am hoping to simulate the above solution to this problem on a rod and export this as a gif, that is, we can visually see the heat propogating along the rod. I have sketched below an illustration of the simulation. Is this possible to do using Mathematica?

Edit

As per my conversation with Nasser, the animation is of a thin 2D rod where the heat only flows along the bar in the horizontal direction (i.e. along the length of the bar).

Answer 1

This is basic animation using Manipulate. This can be solved analytically by Mathematica. Once you obtain the analytical solution then Manipulate is used to replace $f(x),L,k$ by any other values without having to solve the PDE again.

Manipulate is used for just changing the time and length and thermal conductivity. In this $f(x)=\sin(x)$ is used for initial conditions. You can change that as needed. Number of terms used in $20$ in the series. The more the more accurate it will be, but $20$ is more than enough. To save to animation gif file, there are many questions and answers on this site how to save Manipulate to gif file.

Code

ClearAll["Global`*"];
pde=D[u[x,t],t]==k*D[u[x,t],{x,2}];
bc={u[0,t]==0,u[L,t]==0};
ic=u[x,0]==f[x];
sol=DSolveValue[{pde,ic,bc},u[x,t],{x,t}];
sol=sol/. {K[1]->n,Infinity->20};

Manipulate[
 Module[{sol2, g},
  sol2 = Activate[sol /. {f[x] -> Sin[x], L -> L0, k -> k0}];
  g = Grid[{{Row[{"time = ", t0}]},
     {Quiet@
       Plot[ sol2 /. t -> t0, {x, 0, L0}, 
        PlotRange -> {Automatic, {-1.2, 1.2}}, ImageSize -> 300, 
        GridLines -> Automatic, GridLinesStyle -> LightGray, 
        PlotStyle -> Red]}}];
  g
  ],
 {{L0, 3, "Length?"}, 1, 10, .1, Appearance -> "Labeled"},
 {{k0, .01, "Thermal conductivity?"}, 0.01, .1, .01, 
  Appearance -> "Labeled"},
 {{t0, 0.01, "time?"}, 0.01, 100, .1, Appearance -> "Labeled"},
 TrackedSymbols :> {L0, k0, t0}
 ]

Update

Here is a possibility, using DensityPlot. I am sure this can be improved more.

Code

ClearAll["Global`*"];
pde = D[u[x, t], t] == k*D[u[x, t], {x, 2}];
bc = {u[0, t] == 0, u[L, t] == 0};
ic = u[x, 0] == f[x];
sol = DSolveValue[{pde, ic, bc}, u[x, t], {x, t}];
sol = sol /. {K[1] -> n, Infinity -> 20};

Manipulate[
 Module[{currentSol, g},
  currentSol = Activate[sol /. {f[x] -> Sin[x], L -> L0, k -> k0}];
  g = Grid[{{Row[{"time = ", t0}]},
     {Quiet[
       DensityPlot[
        Evaluate[currentSol /. t -> t0], {x, 0, L0}, {y, 0, 1},
        ColorFunction -> Function[{x}, Hue[x]],
        ColorFunctionScaling -> False, AspectRatio -> 1/10, 
        ImageSize -> 300]]}}
    ];
  g
  ],
 {{L0, 3, "Length?"}, 1, 10, .1, Appearance -> "Labeled"},
 {{k0, .1, "Thermal conductivity?"}, 0.01, .1, .01, 
  Appearance -> "Labeled"},
 {{t0, 0.01, "time?"}, 0.01, 100, .1, Appearance -> "Labeled"},
 TrackedSymbols :> {L0, k0, t0}
 ]