# Plotting Solution to Heat Equation

By hand, I've solved the heat equation and looking to 3D plot the solution. My function is $$2\sum_{n=1}^{\infty}\frac{(-1)^n}{n}\sin(nx)e^{-111n^2t}$$ The code I've been trying to use to far is

Plot3D[2*Sum[((-1)^n)/(n)Sin[n x]Exp[-111t*n^2],{n,1,Infinity}],
{x,-Pi,Pi},{t,0,100}]


It's been running for a while with no output. Any help would be fab :)

• We can approximate solution,put $\infty \approx 50$, or a bigger number. Mar 11, 2018 at 14:56
• you might also try NSum here. Mar 11, 2018 at 16:54

The Gaussian factor in your sum decays extremely quickly. We can thus truncate the sum safely; a naïve way to estimate the truncation limit goes like this:

Solve[Exp[-111 t n^2] == 2^-52 (* \$MachineEpsilon *) && n > 0, n, Reals] // Simplify
{{n -> ConditionalExpression[(2 Sqrt[(13 Log[2])/111])/Sqrt[t], t > 0]}}


and thus

Plot3D[2 Sum[(-1)^n/n Sin[n x] Exp[-111 t n^2],
{n, 1, Ceiling[2 Sqrt[13 Log[2]/(111 t)]]}],
{x, -π, π}, {t, 0, 100}]


• Very nice analysis of the truncation limit. Also limit t to much shorter times, to see where the solution is significant. Plot3D[2 Sum[(-1)^n/n Sin[n x] Exp[-111 t n^2], {n, 1, Ceiling[2 Sqrt[13 Log[2]/(111 t)]]}], {x, -π, π}, {t, 0, 1/10}, PlotPoints -> 100, PlotRange -> All, MaxRecursion -> 8, RegionFunction -> Function[{x, t, z}, Abs[z] > 10^-3]]  Mar 17, 2018 at 7:45

Mathematica is trying to evaluate the infinite sum, that's why it taking so long.

Why not try Partial sum?

Clear[n, t, x]

f[x_, t_, nn_] := 2*Sum[((-1)^n)/(n) Sin[n x] Exp[-111 t*n^2], {n, 1, nn}]

Plot3D[f[x, t, 100], {x, -Pi, Pi}, {t, 0, 1000}]


Now, try different values for nn (large ones).

If you are into animation, you can speed things with Compile.

Function to plot without the summation.

function = (2/n)*(-1)^n*Sin[n*x]*Exp[-111*n^2*t]


Get it into pure function form

un = Function[n, #] &@function;


Compile the function summed for n terms.

usum[n_] := Compile[{x, t}, #] &@Total@un@Range[1, n]


Pick a number of terms for plotting.

u = usum[50];

Animate[Plot[u[x, t], {x, -Pi, Pi}, PlotRange -> {-3, 3}, PlotLabel -> t*"t"], {t, 0, 0.05}]


The solution damps out quickly with that form of exponential term.