Efficient numerical calculation of 2d data sets - wolfram-mathematica

Question

I'm trying to calculate the fourier transform of a gaussian beam. Later I want to ad some modifications to the following example code. With the required stepsize of 1e-6 the calculation with 8 kernel takes 1244s on my workstation. The most consuming part is obviously the generation of uaperture. Has anyone ideas to improve the performance? Why does mathematica not create a packed list from my expression, when I'm having both real and complex values in it?
uin[gx_, gy_, z_] := Module[{w0 = L1[[1]], z0 = L1[[3]], w, R, \[Zeta], k},
w = w0 Sqrt[1 + (z/z0)^2];
R = z (1 + (z0/z)^2);
\[Zeta] = ArcTan[z/z0];
k = 2*Pi/193*^-9;
Developer`ToPackedArray[
ParallelTable[
w0/w Exp[-(x^2 + y^2)/w^2] Exp[-I k/2/R (x^2 + y^2)/2] Exp[-I k z*0 +
I \[Zeta]*0], {x, gx}, {y, gy}]
]
]
AbsoluteTiming[
dx = 1*^-6;
gx = Range[-8*^-3, 8*^-3, dx];
gy = gx;
d = 15*^-3;
uaperture = uin[gx, gy, d];
ufft = dx*dx* Fourier[uaperture];
uout = RotateRight[
Abs[ufft]*dx^2, {Floor[Length[gx]/2], Floor[Length[gx]/2]}];
]
Thanks in advance,
Johannes

Answer 1

You can speed it up by first vectorizing it (uin2), then compiling it (uin3):
In[1]:= L1 = {0.1, 0.2, 0.3};
In[2]:= uin[gx_, gy_, z_] :=
Module[{w0 = L1[[1]], z0 = L1[[3]], w, R, \[Zeta], k},
w = w0 Sqrt[1 + (z/z0)^2];
R = z (1 + (z0/z)^2);
\[Zeta] = ArcTan[z/z0];
k = 2*Pi/193*^-9;
ParallelTable[
w0/w Exp[-(x^2 + y^2)/
w^2] Exp[-I k/2/R (x^2 + y^2)/2] Exp[-I k z*0 +
I \[Zeta]*0], {x, gx}, {y, gy}]
]
In[3]:= uin2[gx_, gy_, z_] :=
Module[{w0 = L1[[1]], z0 = L1[[3]], w, R, \[Zeta], k, x, y},
w = w0 Sqrt[1 + (z/z0)^2];
R = z (1 + (z0/z)^2);
\[Zeta] = ArcTan[z/z0];
k = 2*Pi/193*^-9;
{x, y} = Transpose[Outer[List, gx, gy], {3, 2, 1}];
w0/w Exp[-(x^2 + y^2)/
w^2] Exp[-I k/2/R (x^2 + y^2)/2] Exp[-I k z*0 + I \[Zeta]*0]
]
In[4]:= uin3 =
Compile[{{gx, _Real, 1}, {gy, _Real, 1}, z},
Module[{w0 = L1[[1]], z0 = L1[[3]], w, R, \[Zeta], k, x, y},
w = w0 Sqrt[1 + (z/z0)^2];
R = z (1 + (z0/z)^2);
\[Zeta] = ArcTan[z/z0];
k = 2*Pi/193*^-9;
{x, y} = Transpose[Outer[List, gx, gy], {3, 2, 1}];
w0/w Exp[-(x^2 + y^2)/
w^2] Exp[-I k/2/R (x^2 + y^2)/2] Exp[-I k z*0 + I \[Zeta]*0]
],
CompilationOptions -> {"InlineExternalDefinitions" -> True}
];
In[5]:= dx = 1*^-5;
gx = Range[-8*^-3, 8*^-3, dx];
gy = gx;
d = 15*^-3;
In[9]:= r1 = uin[gx, gy, d]; // AbsoluteTiming
Out[9]= {67.9448862, Null}
In[10]:= r2 = uin2[gx, gy, d]; // AbsoluteTiming
Out[10]= {28.3326206, Null}
In[11]:= r3 = uin3[gx, gy, d]; // AbsoluteTiming
Out[11]= {0.4190239, Null}
We got a ~160x speedup even though this is not running in parallel.
Results are the same:
In[12]:= r1 == r2
Out[12]= True
There's a tiny difference here due to numerical errors:
In[13]:= r2 == r3
Out[13]= False
In[14]:= Max#Abs[r2 - r3]
Out[14]= 5.63627*10^-14