1
$\begingroup$

I am working on a paper in which a pump mode is passing through SPDC(Spontaneous Parametric Down conversion) is converted into two photons called as signal and idler. In which laguerre-Gaussian mode formalism is used.

In it, i am trying to plot normalized coincident detection probability of signal and idler photons, but my plot is not getting normalized. This is the expression of normalized coincident detection probability.

Where phi 1 is the mode function of signal and phi 2 is of idler photon while phi o is the mode function of pump mode. Using Laguerre - Gaussian Formalism enter image description here

Following terms are evaluated

enter image description here enter image description here enter image description here

making normalized coincident detection probability equals to enter image description here

Then to plot it , i used following mathematica code

W = 0.4;
l0 = 0;
p0 = 0;
p1 = 0;
p2 = 0;
R1[r_, l0_, l1_] := ((p1 + Abs[l1])!/p1!)*
  Integrate[
   r^(Abs[l1] + Abs[l0])*Exp[-r (1 + W^2)]*LaguerreL[p1, Abs[l1], r]*
    LaguerreL[p0, Abs[l0], r*W^2], {r, 0, Infinity}]
R2[r_, l0_, l2_] := ((p2 + Abs[l2])!/p2!)*
  Integrate[
   r^(Abs[l2] + Abs[l0])*Exp[-r (1 + W^2)]*LaguerreL[p2, Abs[l2], r]*
    LaguerreL[p0, Abs[l0], r*W^2], {r, 0, Infinity}]
R12[r_, l0_, l1_, l2_] := 
 Integrate[
  r^((Abs[l1] + Abs[l2] + Abs[l0])/2)*Exp[-r (1 + W^2/2)]*
   LaguerreL[p1, Abs[l1], r]*LaguerreL[p2, Abs[l2], r]*
   LaguerreL[p0, Abs[l0], r*W^2], {r, 0, Infinity}]
Pn[r_, l0_, l1_, l2_] := 
 Sinc[(l1 + l2 - l0)*\[Pi]]^2*(R12[r, l0, l1, l2]/
    Sqrt[R1[r, l0, l1]*R2[r, l0, l2]])
Plot3D[Pn[r, l1, l2], {l1, -2, 2}, {l2, -2, 2}, PlotRange -> All, 
 ColorFunction -> GrayLevel, PlotLegends -> Automatic, 
 AxesStyle -> Directive[Black, 12], Exclusions -> None]

But it is showing following graph which is not normalized enter image description here

$\endgroup$

2 Answers 2

4
$\begingroup$

Carefully compare the variables in the formula you provided with the variables corresponding to the variables in the code, and the result is what you want.

W = 0.4;
l0 = 0;
p0 = 0;
p1 = 0;
p2 = 0;
R1[l1_, l2_] := ((p1 + Abs[l1])!/p1!)*
   NIntegrate[
    r^(Abs[l2] + Abs[l0])*Exp[-r (1 + W^2)]*
     LaguerreL[p1, Abs[l1], r]^2*LaguerreL[p0, Abs[l0], r*W]^2, {r, 0,
      Infinity}];
R2[l1_, l2_] := ((p2 + Abs[l2])!/p2!)*
   NIntegrate[
    r^(Abs[l1] + Abs[l0])*Exp[-r (1 + W^2)]*
     LaguerreL[p2, Abs[l2], r]^2*LaguerreL[p0, Abs[l0], r*W]^2, {r, 0,
      Infinity}];
R12[l1_, l2_] := 
  NIntegrate[
   r^((Abs[l1] + Abs[l2] + Abs[l0])/2)*Exp[-r (1 + W^2/2)]*
    LaguerreL[p1, Abs[l1], r]*LaguerreL[p2, Abs[l2], r]*
    LaguerreL[p0, Abs[l0], r*W^2], {r, 0, Infinity}];
Pn[l1_, l2_] := 
 Sinc[(l1 + l2 + l0)*\[Pi]]^2*(R12[l1, l2]^2/
    Sqrt[R1[l1, l2]*R2[l1, l2]])
Plot3D[Pn[l1, l2], {l1, -2, 2}, {l2, -2, 2}, PlotRange -> {0, 1}, 
 ColorFunction -> GrayLevel, PlotLegends -> Automatic, 
 AxesStyle -> Directive[Black, 12]]

enter image description here

$\endgroup$
1
  • $\begingroup$ I was just missing that square part, Thank You very much for taking your time highlighting it. $\endgroup$
    – Qubit
    Nov 30, 2023 at 16:37
2
$\begingroup$
$Version

(* "13.3.1 for Mac OS X ARM (64-bit) (July 24, 2023)" *)

Clear["Global`*"]

l0 = 0;
p0 = 0;
p1 = 0;
p2 = 0;

R1[l1_, l2_, W_] = Assuming[W ∈ Reals, ((p1 + Abs[l1])!/p1!)*
   Integrate[r^(Abs[l2] + Abs[l0])*Exp[-r (1 + W^2)]*
     LaguerreL[p1, Abs[l1], r]^2*
     LaguerreL[p0, Abs[l0], r*W]^2, {r, 0, Infinity}]]

(1 + W^2)^(-1 - Abs[l2]) Abs[l1]! Gamma[1 + Abs[l2]]

R2[l1_, l2_, W_] = Assuming[W ∈ Reals,
  ((p2 + Abs[l2])!/p2!)*
   Integrate[r^(Abs[l1] + Abs[l0])*Exp[-r (1 + W^2)]*
     LaguerreL[p2, Abs[l2], r]^2*
     LaguerreL[p0, Abs[l0], r*W]^2, {r, 0, Infinity}]]

(1 + W^2)^(-1 - Abs[l1]) Abs[l2]! Gamma[1 + Abs[l1]]

Note that

R2[l1, l2, W] === R1[l2, l1, W]

(* True *)

Consequently, you need only do the integration once and use

Clear[R2]

R2[l1_, l2_, W_] = R1[l2, l1, W];

R12[l1_, l2_, W_] = Assuming[W ∈ Reals,
  Integrate[
   r^((Abs[l1] + Abs[l2] + Abs[l0])/2)*Exp[-r (1 + W^2/2)]*
    LaguerreL[p1, Abs[l1], r]*LaguerreL[p2, Abs[l2], r]*
    LaguerreL[p0, Abs[l0], r*W^2], {r, 0, Infinity}]]

(* (1 + W^2/2)^(-1 - Abs[l1]/2 - Abs[l2]/2) Gamma[1 + Abs[l1]/2 + Abs[l2]/2] *)

Pn[l1_, l2_, W_] = Sinc[(l1 + l2 + l0)*π]^2*
   (R12[l1, l2, W]^2/Sqrt[R1[l1, l2, W]*R2[l1, l2, W]]) //
  FullSimplify

(* (2^(2 + Abs[l1] + Abs[l2]) (2 + W^2)^(-2 - Abs[l1] - Abs[l2])
    Gamma[1/2 (2 + Abs[l1] + Abs[l2])]^2 Sinc[(l1 + l2) π]^2)/(Sqrt[(1 + 
     W^2)^(-2 - Abs[l1] - Abs[l2])] Gamma[1 + Abs[l1]] Gamma[1 + Abs[l2]]) *)

With[{W = 2/5},
 Plot3D[Pn[l1, l2, W], {l1, -2, 2}, {l2, -2, 2}, 
  ColorFunction -> "TemperatureMap",
  PlotLegends -> Automatic, AxesStyle -> Directive[Black, 12],
  AxesLabel -> (Style[#, 14] & /@ {l1, l2})]]

enter image description here

$\endgroup$
5
  • $\begingroup$ Thank You very Much, your response helped it very much in reducing computational time on my system. $\endgroup$
    – Qubit
    Nov 30, 2023 at 16:39
  • $\begingroup$ Hi Bob, hope you are doing well. I am also trying to workout these expressions of R1, R2, R12, and Pn12 but always get stuck after some steps, with some extra steps. Do you have any insights on it? $\endgroup$
    – Qubit
    Dec 13, 2023 at 21:59
  • $\begingroup$ Post a question that explains what you are trying to do, what you have tried (give code in InputForm), and what problems you are having. $\endgroup$
    – Bob Hanlon
    Dec 13, 2023 at 22:07
  • $\begingroup$ Sure, i will. Thank You $\endgroup$
    – Qubit
    Dec 13, 2023 at 22:09
  • $\begingroup$ Hi Bob! I have posted the question. Kindly see if you do anything. Thank You $\endgroup$
    – Qubit
    Dec 19, 2023 at 12:59

Your Answer

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

Not the answer you're looking for? Browse other questions tagged or ask your own question.