1
$\begingroup$

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}}]
$\endgroup$
3
  • 3
    $\begingroup$ 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. $\endgroup$
    – JimB
    Commented Sep 9, 2023 at 22:48
  • 2
    $\begingroup$ Your question mentions the smallest 2 eigenvalues but your current code returns the smallest 4. Changing the 100 to 2 speeds things up more. $\endgroup$
    – JimB
    Commented Sep 9, 2023 at 22:55
  • $\begingroup$ @JimB, thanks! I have edited the code $\endgroup$
    – Mam Mam
    Commented Sep 9, 2023 at 23:07

1 Answer 1

3
$\begingroup$

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

enter image description here

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

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.