# What are some ways to speed up calculations

Below is the code for calculating the eigenfunctions and eigenvalues of the following system: $$HC[u(\rho,z)]=-\frac{1}{2}\Delta u(\rho,z)-\frac{1}{\sqrt{\rho^2+z^2}}u(\rho,z)+\frac{B^2}{8}\rho^2 u(\rho,z)$$, where $$B$$ is parameter, $$(\rho,\theta,z)$$ are the coordinates in cylindrical coordinate system. A series of density function plots are then calculated for the two smallest eigenvalues as the parameter $$B$$ changes.

What are some ways to speed up calculations? Could you please suggest options.

ClearAll["Global*"]

\[Rho]max = 21;

HC[\[Rho]_, z_] :=
Simplify[(-1/2 Laplacian[u[\[Rho], z], {\[Rho], \[Theta], z},
"Cylindrical"] - 1/Sqrt[\[Rho]^2 + z^2]*u[\[Rho], z]) +
B^2/8*\[Rho]^2*u[\[Rho], z]]

en[BB_] :=
Module[{}, {vals, funs} =
NDEigensystem[{HC[\[Rho], z] + u[\[Rho], z]} /. B -> BB,
u[\[Rho], z], {\[Rho], 0, \[Rho]max}, {z, -\[Rho]max, \[Rho]max},
2, Method -> {"SpatialDiscretization" -> {"FiniteElement", \
{"MeshOptions" -> {"MaxCellMeasure" -> 0.05}}},
"Eigensystem" -> {"Arnoldi", "MaxIterations" -> 10000}}];
ord = Ordering[vals];
{vals, funs} = {vals[[ord]], funs[[ord]]};
Return[{vals[[1 ;; 2]] - 1, funs[[1 ;; 2]]}]];

(*eigenfunction corresponding to the first minimum eigenvalue*)

Ps1[B_] := (en[B][[2, 1]])^2;

Table[DensityPlot[Evaluate@Ps1[B], {\[Rho], 0, 20}, {z, -10, 10},
FrameLabel -> {\[Rho], z}, PlotLabel -> StringForm["B = ", B],
ColorFunction -> "SunsetColors", PlotPoints -> 250,
PlotLegends -> Automatic], {B, {0, 0.5, 1, 2, 5, 7}}]

(*eigenfunction corresponding to the second minimum eigenvalue*)

Ps2[B_] := en[B][[2, 2]]^2;

Table[DensityPlot[Evaluate@Ps2[B], {\[Rho], 0, 20}, {z, -10, 10},
FrameLabel -> {\[Rho], z}, PlotLabel -> StringForm["B = ", B],
ColorFunction -> "SunsetColors", PlotPoints -> 250,
PlotLegends -> Automatic], {B, {0, 0.5, 1, 2, 5, 7}}]

• It appears that the slowest part is the evaluation of en which takes about 30 to 40 seconds per value. But because you seem to only want the smallest 4 values, changing the 100 to 4 in the call the NDEigensystem will take around 8 seconds per evaluation of en.
– JimB
Sep 9, 2023 at 22:48
• Your question mentions the smallest 2 eigenvalues but your current code returns the smallest 4. Changing the 100 to 2 speeds things up more.
– JimB
Sep 9, 2023 at 22:55
• @JimB, thanks! I have edited the code Sep 9, 2023 at 23:07

These can be calculated once:

Bs = {0, 0.5, 1, 2, 5, 7};
entable = Table[en[B], {B, Bs}];


Then using the pre-calculated table

Table[DensityPlot[
entable[[i]][[2, 1]]^2, {ρ, 0, 20}, {z, -10, 10},
FrameLabel -> {ρ, z},
PlotLabel -> StringForm["B = ", Bs[[i]]],
ColorFunction -> "SunsetColors", PlotPoints -> 250,
PlotLegends -> Automatic], {i, Length[entable]}]// AbsoluteTiming


30.5952

Table[DensityPlot[
entable[[i]][[2, 2]]^2, {ρ, 0, 20}, {z, -10, 10},
FrameLabel -> {ρ, z},
PlotLabel -> StringForm["B = ", Bs[[i]]],
ColorFunction -> "SunsetColors", PlotPoints -> 250,
PlotLegends -> Automatic], {i, Length[entable]}]//AbsoluteTiming
`

29.3622