Message Boards Message Boards

Obtain the field intensity at a certain position of a maser interferometer?

GROUPS:

Hey guys, I would lik to know how normalizing these figures giving by this programm for obtaining the field intensity at an arbitrary off-center for exemple at x=0.5a in order to find the samme valeus as given in Resonant Modes in a Maser Interferometer by using equation 26:

Exp[I*0.25*Pi]/(2*Sqrt[d])*\[Integral](Exp[-I*k*Sqrt[b^2 + (x1 - x2)^2]]/ Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + b/Sqrt[b^2 + (x1 - x2)^2])

By A. G. FOX and TINGYE Ll (Manuscript received October 20, 1960) articl.

(==================================================================)

(* lam=d; a=25d;b=100d ; k=2[Pi]/d)-one Trip // 0 < x2 < 1 a)

(==================================================================)

d = 1; lam = d; a = 25*d; b = 100*d ; k = 2 [Pi]/d

x2 = Table[x2, {x2, 0, 1, 0.01}]*a

f1 = (Exp[-IkSqrt[b^2 + (x1 - x2)^2]]/ Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + b/Sqrt[b^2 + (x1 - x2)^2])

g1 = NIntegrate[f1, {x1, -a, a}]

fact = Exp[I*0.25Pi]/(2*Sqrt[d])

g2 = fact*g1

Abg = Abs[g2]

ListLinePlot[Abg]

Ag = Arg[g2]

ListLinePlot[Ag]

Please see my attachment for more details.

Thanks in advance.

POSTED BY: MOUMA MIRAL
Answer
2 months ago

for the first transit

d = 1; lam = d; a = 25 d; b = 100*d; k = 2*Pi/d;
fabs = Table[{x2, 
    Abs[Exp[I*Pi/4]/(2*Sqrt[d])*
      NIntegrate[(Exp[-I*k*Sqrt[b^2 + (x1 - x2)^2]]/
          Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + 
          b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -a, a}]]}, {x2, 0, a, 
    0.01*a}];
farg = Table[{x2, 
    Arg[Exp[I*Pi/4]/(2*Sqrt[d])*
      NIntegrate[(Exp[-I*k*Sqrt[b^2 + (x1 - x2)^2]]/
          Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + 
          b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -a, a}]]}, {x2, 0, a, 
    0.01*a}];
{ListLinePlot[fabs, Frame -> True, FrameLabel -> {"x", "Amplitude"}, 
  PlotLabel -> "First Transit" ], 
 ListLinePlot[farg, Frame -> True, FrameLabel -> {"x", "Phase"}, 
  Axes -> False]}

fig

POSTED BY: Alexander Trounev
Answer
2 months ago

I'm not ready to calculate all 300 transit, here is an option for 10 transit

d = 1; lam = d; a = 25*d; b = 100*d/a; k = 2*Pi/d; c = 
 Exp[I*Pi/4]*Sqrt[a]/(2*Sqrt[d]);
fabs = Table[{x2, 
    Abs[c*NIntegrate[(Exp[-I*k*a*Sqrt[b^2 + (x1 - x2)^2]]/
          Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + 
          b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -1, 1}]]}, {x2, 0, 1, 
    0.01}];
farg = Table[{x2, 
    Arg[c*NIntegrate[(Exp[-I*k*a*Sqrt[b^2 + (x1 - x2)^2]]/
          Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + 
          b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -1, 1}]]}, {x2, 0, 1, 
    0.01}];
{ListLinePlot[fabs, Frame -> True, FrameLabel -> {"x", "Amplitude"}, 
  PlotLabel -> "First Transit" ], 
 ListLinePlot[farg, Frame -> True, FrameLabel -> {"x", "Phase"}, 
  Axes -> False]}

fig 5

u[0][x_] := 1; v[0][x_] := 0;
Do[{u[q] = 
    Interpolation[
     Table[{x2, 
       Re[c*NIntegrate[(u[q - 1][x1] + 
             I*v[q - 1][x1])*(Exp[-I*k*a*Sqrt[b^2 + (x1 - x2)^2]]/
             Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + 
             b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -1, 1}]]}, {x2, -1, 1, 
       0.01}]], 
   v[q] = Interpolation[
     Table[{x2, 
       Im[c*NIntegrate[(u[q - 1][x1] + 
             I*v[q - 1][x1])*(Exp[-I*k*a*Sqrt[b^2 + (x1 - x2)^2]]/
             Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + 
             b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -1, 1}]]}, {x2, -1, 1, 
       0.01}]]}, {q, 1, 10}];
amp = Interpolation[
  Table[{q, Abs[u[q][.5] + I*v[q][.5]]}, {q, 0, 10}]];
 {Show[{ListPlot[Table[{q, (Abs[u[q][.5] + I*v[q][.5]])}, {q, 0, 10}], 
   PlotRange -> All, Frame -> True, 
   FrameLabel -> {"Number of Transits", "Amplitude"}], 
  Plot[amp[q], {q, 0, 10}, PlotRange -> All]}], Plot[Table[Abs[u[q][x] + I*v[q][x]], {q, 1, 10, 1}], {x, -1, 1}, 
   ColorFunction -> Hue, Frame -> True, 
   FrameLabel -> {"x", "Amplitude"}, Axes -> False]}

fig. 6

POSTED BY: Alexander Trounev
Answer
2 months ago

I calculated the Hundred First Transits. It looks like the amplitude and phase coincides with what is shown in Figure 5 but the behavior of the amplitude at a fixed point $x=0.5$ depending on the number of transits has a different form than in Figure 6 100 transits

fig 6

POSTED BY: Alexander Trounev
Answer
2 months ago
qmax =100; d = 1; lam = d; a = 25*d; b = 100*d/a; k = 2*Pi/d; c = 
 Exp[I*Pi/4]*Sqrt[a]/(2*Sqrt[d]);
fabs = Table[{x2, 
    Abs[c*NIntegrate[(Exp[-I*k*a*Sqrt[b^2 + (x1 - x2)^2]]/
          Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + 
          b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -1, 1}]]}, {x2, 0, 1, 
    0.01}];

farg = Table[{x2, 
    Arg[c*NIntegrate[(Exp[-I*k*a*Sqrt[b^2 + (x1 - x2)^2]]/
          Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + 
          b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -1, 1}]]}, {x2, 0, 1, 
    0.01}];

{ListLinePlot[fabs, Frame -> True, FrameLabel -> {"x", "Amplitude"}, 
  PlotLabel -> "First Transit" ], 
 ListLinePlot[farg, Frame -> True, FrameLabel -> {"x", "Phase"}, 
  Axes -> False]}
u[0][x_] := 1; v[0][x_] := 0;
Do[{u[q] = 
    Interpolation[
     Table[{x2, 
       Re[c*NIntegrate[(u[q - 1][x1] + 
             I*v[q - 1][x1])*(Exp[-I*k*a*Sqrt[b^2 + (x1 - x2)^2]]/
             Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + 
             b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -1, 1}]]}, {x2, -1, 1, 
       0.01}]], 
   v[q] = Interpolation[
     Table[{x2, 
       Im[c*NIntegrate[(u[q - 1][x1] + 
             I*v[q - 1][x1])*(Exp[-I*k*a*Sqrt[b^2 + (x1 - x2)^2]]/
             Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*(1 + 
             b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -1, 1}]]}, {x2, -1, 1, 
       0.01}]]}, {q, 1, qmax}];
amp1 = Interpolation[
  Table[{q, Abs[u[q][.5] + I*v[q][.5]]}, {q, 0, 100}]]
{Show[{ListPlot[Table[{q, (Abs[u[q][.5] + I*v[q][.5]])}, {q, 0, 100}],
     PlotRange -> All, Frame -> True, 
    FrameLabel -> {"Number of Transits", "Amplitude"}], 
   Plot[amp1[q], {q, 0, 100}, PlotRange -> All]}], 
 Plot[Abs[u[100][x] + I*v[100][x]], {x, -1, 1}, Frame -> True, 
  FrameLabel -> {"x", "Amplitude"}, PlotLabel -> "100 Transit" ]}
{Plot[{Interpolation[fabs][x]/Interpolation[fabs][0], 
   Abs[u[100][x] + I*v[100][x]]/Abs[u[100][0] + I*v[100][0]]}, {x, .0,
    1}, Frame -> True, FrameLabel -> {"x", "Amplitude"}, 
  PlotLegends -> {"First Transit" , "After 100 Transits"}], 
 Plot[{Interpolation[farg][x] - Interpolation[farg][0], 
   Arg[u[100][x] + I*v[100][x]] - 
    Arg[u[100][0] + I*v[100][0]]}, {x, .0, 1}, Frame -> True, 
  FrameLabel -> {"x", "Phase"}, Axes -> False, 
  PlotLegends -> {"First Transit" , "After 100 Transits"}]}
POSTED BY: Alexander Trounev
Answer
2 months ago

This code to calculate phase in degrees

qmax = 101; h = .05; d = 1; lam = d; a = 25*d; k = (2*Pi/d);
(*Fresnel number N=6.25*)
k1 = 19.635; b = (k*a^2)/(2*k1); c = a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
u[0][x_] := 1; v[0][x_] := 0;
Do[{u[q] = 
   Interpolation[
    Table[{x2, 
      Re[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, h}]], 
  v[q] = Interpolation[
    Table[{x2, 
      Im[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, 
      h}]]}, {q, 1, qmax}]

p1 = Plot[
   Abs[u[qmax][x] + I*v[qmax][x]]/Abs[u[qmax][0] + I*v[qmax][0]], {x, 
    0, 1}, Frame -> True, FrameLabel -> {"x", "Relative Amplitude"}, 
   PlotRange -> All, PlotStyle -> Blue];

f1 = Plot[
   180*(Arg[u[qmax][x] + I*v[qmax][x]] - 
       Arg[u[qmax][0] + I*v[qmax][0]])/Pi, {x, 0, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Phase in Degrees"} , 
   PlotRange -> All, PlotStyle -> Blue];

(**Fresnel number N=2.5**)

k1 = 7.85398; b = (k*a^2)/(2*k1); c = 
 a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
u[0][x_] := 1; v[0][x_] := 0;
Do[{u[q] = 
   Interpolation[
    Table[{x2, 
      Re[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, h}]], 
  v[q] = Interpolation[
    Table[{x2, 
      Im[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, 
      h}]]}, {q, 1, qmax}]

p2 = Plot[
   Abs[u[qmax][x] + I*v[qmax][x]]/Abs[u[qmax][0] + I*v[qmax][0]], {x, 
    0, 1}, Frame -> True, FrameLabel -> {"x", "Relative Amplitude"} , 
   PlotRange -> All, PlotStyle -> Orange];

f2 = Plot[
   180*(Arg[u[qmax][x] + I*v[qmax][x]] - 
       Arg[u[qmax][0] + I*v[qmax][0]])/Pi, {x, 0, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Phase"} , PlotRange -> All, 
   PlotStyle -> Orange];

(***Fresnel number N=0.5***)

k1 = 1.5708; b = (k*a^2)/(2*k1); c = a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
u[0][x_] := 1; v[0][x_] := 0;
Do[{u[q] = 
   Interpolation[
    Table[{x2, 
      Re[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, h}]], 
  v[q] = Interpolation[
    Table[{x2, 
      Im[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, 
      h}]]}, {q, 1, qmax}]

p3 = Plot[
   Abs[u[qmax][x] + I*v[qmax][x]]/Abs[u[qmax][0] + I*v[qmax][0]], {x, 
    0, 1}, Frame -> True, FrameLabel -> {"x", "Relative Amplitude"} , 
   PlotRange -> All, PlotStyle -> Green];

f3 = Plot[
   180*(Arg[u[qmax][x] + I*v[qmax][x]] - 
       Arg[u[qmax][0] + I*v[qmax][0]])/Pi, {x, 0, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Phase"} , PlotRange -> All, 
   PlotStyle -> Green];

{Show[{p1, p2, p3}], Show[{f1, f2, f3}], 
 Grid[{{"", 
    "N"}, {Graphics[{Blue, Line[{{0, 7}, {10, 7}}]}, 
     ImageSize -> {20, 10}], 
    6.25}, {Graphics[{Orange, Line[{{0, 6}, {10, 6}}]}, 
     ImageSize -> {20, 10}], 
    2.5}, {Graphics[{Green, Line[{{0, 5}, {10, 5}}]}, 
     ImageSize -> {20, 10}], 0.5}}]}

fig. 7

POSTED BY: Alexander Trounev
Answer
1 month ago

I would like how find the Feild Amplitude after 300 transit

d = 1; lam = d; a = 25 d; b = 100*d; k = 2*Pi/d;
U[q + 1] = 
  Table[{x2, (Abs[
       Exp[I*Pi/4]/(2*Sqrt[d])*
        NIntegrate[(Exp[-I*k*Sqrt[b^2 + (x1 - x2)^2]]/
            Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*
          U[q]*(1 + b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -a, a}]])^2}];
Do[
 q = 0, 320, 20
   U[0] = 1
    U[1] = 
   Table[{x2, (Abs[
        Exp[I*Pi/4]/(2*Sqrt[d])*
         NIntegrate[(Exp[-I*k*Sqrt[b^2 + (x1 - x2)^2]]/
             Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*
           U[0]*(1 + b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -a, a}]])^2},
    U[q + 1] = 
     Table[{x2, (Abs[
          Exp[I*Pi/4]/(2*Sqrt[d])*
           NIntegrate[(Exp[-I*k*Sqrt[b^2 + (x1 - x2)^2]]/
               Sqrt[Sqrt[b^2 + (x1 - x2)^2]])*
             U[q]*(1 + b/Sqrt[b^2 + (x1 - x2)^2]), {x1, -a, 
             a}]])^2}, {x2, 0, a, 0.01*a}];
    Print[U[q + 1]], {0, 320, 20}]
 ]
{ListLinePlot[U[q + 1], Frame -> True, 
  FrameLabel -> {"x", "Relative Amplitide"}, 
  PlotLabel -> "After 300 Transit"]}
POSTED BY: MOUMA MIRAL
Answer
2 months ago

Hye, but the results do not coincide with the results of expected

enter image description here

Cordially

POSTED BY: MOUMA MIRAL
Answer
2 months ago

We can't compare, since in Fig. 6: $q \ge 80$, and in my code: $q\le 10$

POSTED BY: Alexander Trounev
Answer
2 months ago

hye, I would like to thank you for this results but when I try to solve this equasion I can not find it; if there will be no problem, can you write me this program. cordially

POSTED BY: MOUMA MIRAL
Answer
2 months ago

First of all; I wanted to thank you for these results but I had some questions that I did not understand for example why you use interpolation to solve this equation and why you multiply the constant before the formula of the integral time and you have declared = 100 * d / a or the function is written as follows:

cordially

POSTED BY: MOUMA MIRAL
Answer
2 months ago

Constant normalization and interpolation are used to integrate and display data in an interval $-1\le x \le 1$. Interpolation makes it possible to reduce the problem to the calculation of 40,000 integrals at $qmax = 100$.

POSTED BY: Alexander Trounev
Answer
2 months ago

hye, I wanted to know what is the result of this calculation in your calculator, does it wedge with the next figure or not; because when I started this calculation with equation 27 by changing a and b on my calculator; it delayed, it is not yet converged;

cordially,

d = 1; lam = d; a = 25*d; b = 100*d; k = 2*Pi/d
x2 = Table[x2, {x2, 0, 1, 0.01}]*a
c4 = Exp[I*(0.25*Pi - k*b)]/Sqrt[d*b]
u4[0][x_] := 1; v4[0][x_] := 0
Do[{u4[q] = 
   Interpolation[
    Table[{x2, 
      Re[c4*NIntegrate[(u4[q - 1][x1] + 
            I*v4[q - 1][x1])*(Exp[-I*k*(x1 - x2)^2/(2*b)]), {x1, -a, 
          a}]]}, {x2, -1, 1, 0.01}]], 
  v4[q] = Interpolation[
    Table[{x2, 
      Im[c4*NIntegrate[(u4[q - 1][x1] + 
            I*v4[q - 1][x1])*(Exp[-I*k*(x1 - x2)^2/(2*b)]), {x1, -a, 
          a}]]}, {x2, -1, 1, 0.01}]]}, {q, 1, qmax}]

d = 1; lam = d; a = 30*d;   b = 1800*d; k = 2*Pi/d
c5 = Exp[I*(0.25*Pi - k*b)]/Sqrt[d*b]
x2 = Table[x2, {x2, 0, 1, 0.01}]*a
u5[0][x_] := 1; v5[0][x_] := 0
Do[{u5[q] = 
   Interpolation[
    Table[{x2, 
      Re[c5*NIntegrate[(u5[q - 1][x1] + 
            I*v5[q - 1][x1])*(Exp[-I*k*(x1 - x2)^2/(2*b)]), {x1, -a, 
          a}]]}, {x2, -1, 1, 0.01}]], 
  v5[q] = Interpolation[
    Table[{x2, 
      Im[c5*NIntegrate[(u5[q - 1][x1] + 
            I*v5[q - 1][x1])*(Exp[-I*k*(x1 - x2)^2/(2*b)]), {x1, -a, 
          a}]]}, {x2, -1, 1, 0.01}]]}, {q, 1, qmax}]

d = 1; lam = d; a = 500*d; b = 1000*d; k = 2*Pi/d
c6 = Exp[I*(0.25*Pi - k*b)]/Sqrt[d*b]
x2 = Table[x2, {x2, 0, 1, 0.01}]*a
u6[0][x_] := 1; v6[0][x_] := 0
Do[{u6[q] = 
   Interpolation[
    Table[{x2, 
      Re[c6*NIntegrate[(u6[q - 1][x1] + 
            I*v6[q - 1][x1])*(Exp[-I*k*(x1 - x2)^2/(2*b)]), {x1, -a, 
          a}]]}, {x2, -1, 1, 0.01}]], 
  v6[q] = Interpolation[
    Table[{x2, 
      Im[c6*NIntegrate[(u6[q - 1][x1] + 
            I*v6[q - 1][x1])*(Exp[-I*k*(x1 - x2)^2/(2*b)]), {x1, -a, 
          a}]]}, {x2, -1, 1, 0.01}]]}, {q, 1, qmax}]

{Plot[{Abs[u4[300][x] + I*v4[300][x]]/Abs[u4[300][0] + I*v4[300][0]], 
   Abs[u5[300][x] + I*v5[300][x]]/Abs[u5[300][0] + I*v5[300][0]], 
   Abs[u6[300][x] + I*v6[300][x]]/
    Abs[u6[300][0] + I*v6[300][0]]}, {x, .0, 1}, Frame -> True, 
  FrameLabel -> {"x", "Relative Amplitude"}, 
  PlotLegends -> {"N=a^2/b*d=6.25", "N=a^2/b*d=0.5", 
    "N=a^2/b*d=2.5"}], 
 Plot[{Arg[u4[300][x] + I*v4[300][x]] - 
    Arg[u4[300][0] + I*v4[300][0]], 
   Arg[u5[300][x] + I*v5[300][x]] - Arg[u5[300][0] + I*v5[300][0]], 
   Arg[u6[300][x] + I*v6[300][x]] - 
    Arg[u6[300][0] + I*v6[300][0]]}, {x, .0, 1}, Frame -> True, 
  FrameLabel -> {"x", "Relative Phase in Degrees"}, Axes -> False, 
  PlotLegends -> {"N=a^2/b*d=6.25", "N=a^2/b*d=0.5", "N=a^2/b*d=2.5"}]}

enter image description here

enter image description here

POSTED BY: MOUMA MIRAL
Answer
1 month ago

I optimized the numerical model and calculated the data for figure 7 using equation (27). –ěn my laptop it takes half an hour. 100 transits

POSTED BY: Alexander Trounev
Answer
1 month ago

really thank you for this results , but when keept to calculate this results for one transit in one iteration i find the somme deficult to plot my results shown in this code

d = 1; lam = d; h = .05; a = 25*d; k = (2*Pi/d);
(*Fresnel number M1=6.25*)
M1 = 19.635; b = (k*a^2)/(2*M1); c = a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
fabs1 = Table[{x2, 
   Abs[c*NIntegrate[Exp[-I*M1*(x1 - x2)^2], {x1, -1, 1}]], {x2, -1, 1,
     h}}]
farg1 = Table[{x2, 
   Arg[c*NIntegrate[Exp[-I*M1*(x1 - x2)^2], {x1, -1, 1}]], {x2, -1, 1,
     h}}]
(**Fresnel number M2=2.5**)

M2 = 7.85398; b = (k*a^2)/(2*M2); c = 
 a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
fabs2 = Table[{x2, 
   Abs[c*NIntegrate[Exp[-I*M2*(x1 - x2)^2], {x1, -1, 1}]], {x2, -1, 1,
     h}}]
farg2 = Table[{x2, 
   Arg[c*NIntegrate[Exp[-I*M2*(x1 - x2)^2], {x1, -1, 1}]], {x2, -1, 1,
     h}}]
(***Fresnel number M3=0.5***)

M3 = 1.5708; b = (k*a^2)/(2*M3); c = a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
fabs3 = Table[{x2, 
   Abs[c*NIntegrate[Exp[-I*M3*(x1 - x2)^2], {x1, -1, 1}]], {x2, -1, 1,
     h}}]
farg3 = Table[{x2, 
   Arg[c*NIntegrate[Exp[-I*M3*(x1 - x2)^2], {x1, -1, 1}]], {x2, -1, 1,
     h}}]
{Show[{fabs1, fabs2, fabs3}], Show[{farg1, farg2, farg3}]
  Grid[{{"", 
     "N=a^2/b\[Lambda]"}, {Graphics[{Blue, Line[{{0, 7}, {10, 7}}]}, 
      ImageSize -> {20, 10}], 
     6.25}, {Graphics[{Orange, Line[{{0, 6}, {10, 6}}]}, 
      ImageSize -> {20, 10}], 
     2.5}, {Graphics[{Green, Line[{{0, 5}, {10, 5}}]}, 
      ImageSize -> {20, 10}], 0.5}}]}

my sincere thanks

POSTED BY: MOUMA MIRAL
Answer
1 month ago

Direct integration in the case $qmax=1$

d = 1; lam = d; h = .05; a = 25*d; k = (2*Pi/d);
(*Fresnel number M1=6.25*)
M1 = 19.635; b = (k*a^2)/(2*M1); c = a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
fabs1 = Interpolation[
   Table[{x2, 
     Abs[c*NIntegrate[Exp[-I*M1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1,
      1, h}]];
p1 = Plot[fabs1[x]/fabs1[0], {x, -1, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Amplitude"}, PlotRange -> All, 
   PlotStyle -> Blue];
farg1 = Interpolation[
   Table[{x2, 
     Arg[c*NIntegrate[Exp[-I*M1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1,
      1, h}]];
f1 = Plot[180*(farg1[x] - farg1[0])/Pi, {x, -1, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Phase in Degrees"}, PlotRange -> All,
    PlotStyle -> Blue];
(*Fresnel number M2=2.5*)
M2 = 7.85398; b = (k*a^2)/(2*M2); c = 
 a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
fabs2 = Interpolation[
   Table[{x2, 
     Abs[c*NIntegrate[Exp[-I*M2*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1,
      1, h}]];
p2 = Plot[fabs2[x]/fabs2[0], {x, -1, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Amplitude"}, PlotRange -> All, 
   PlotStyle -> Orange];
farg2 = Interpolation[
   Table[{x2, 
     Arg[c*NIntegrate[Exp[-I*M2*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1,
      1, h}]];
f2 = Plot[180*(farg2[x] - farg2[0])/Pi, {x, -1, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Phase in Degrees"}, PlotRange -> All,
    PlotStyle -> Orange];

(***Fresnel number M3=0.5***)

M3 = 1.5708; b = (k*a^2)/(2*M3); c = a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
fabs3 = Interpolation[
   Table[{x2, 
     Abs[c*NIntegrate[Exp[-I*M3*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1,
      1, h}]];
p3 = Plot[fabs3[x]/fabs3[0], {x, -1, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Amplitude"}, PlotRange -> All, 
   PlotStyle -> Green];
farg3 = Interpolation[
   Table[{x2, 
     Arg[c*NIntegrate[Exp[-I*M3*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1,
      1, h}]];
f3 = Plot[180*(farg3[x] - farg3[0])/Pi, {x, -1, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Phase in Degrees"}, PlotRange -> All,
    PlotStyle -> Green];

{Show[{p1, p2, p3}], Show[{f1, f2, f3}] , 
 Grid[{{"", 
    "N=\!\(\*FractionBox[SuperscriptBox[\(a\), \(2\)], \
\(b\[Lambda]\)]\)"}, {Graphics[{Blue, Line[{{0, 7}, {10, 7}}]}, 
     ImageSize -> {20, 10}], 
    6.25}, {Graphics[{Orange, Line[{{0, 6}, {10, 6}}]}, 
     ImageSize -> {20, 10}], 
    2.5}, {Graphics[{Green, Line[{{0, 5}, {10, 5}}]}, 
     ImageSize -> {20, 10}], 0.5}}]}

fig8

POSTED BY: Alexander Trounev
Answer
1 month ago

I would like to know why you took x2 between -1 and 1, because when i had tested the program for x2 between 0 and 1 it was not well worked?!

POSTED BY: MOUMA MIRAL
Answer
1 month ago

In the interval $0<x2<1$, the code that I mentioned above works well, here I will repeat this code for $qmax=1$

qmax = 1; h = .05; d = 1; lam = d; a = 25*d; k = (2*Pi/d);
(*Fresnel number N=6.25*)
k1 = 19.635; b = (k*a^2)/(2*k1); c = a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
u[0][x_] := 1; v[0][x_] := 0;
Do[{u[q] = 
   Interpolation[
    Table[{x2, 
      Re[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, h}]], 
  v[q] = Interpolation[
    Table[{x2, 
      Im[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, 
      h}]]}, {q, 1, qmax}]

p1 = Plot[
   Abs[u[qmax][x] + I*v[qmax][x]]/Abs[u[qmax][0] + I*v[qmax][0]], {x, 
    0, 1}, Frame -> True, FrameLabel -> {"x", "Relative Amplitude"}, 
   PlotRange -> All, PlotStyle -> Blue];

f1 = Plot[
   180*(Arg[u[qmax][x] + I*v[qmax][x]] - 
       Arg[u[qmax][0] + I*v[qmax][0]])/Pi, {x, 0, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Phase in Degrees"} , 
   PlotRange -> All, PlotStyle -> Blue];

(**Fresnel number N=2.5**)

k1 = 7.85398; b = (k*a^2)/(2*k1); c = 
 a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
u[0][x_] := 1; v[0][x_] := 0;
Do[{u[q] = 
   Interpolation[
    Table[{x2, 
      Re[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, h}]], 
  v[q] = Interpolation[
    Table[{x2, 
      Im[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, 
      h}]]}, {q, 1, qmax}]

p2 = Plot[
   Abs[u[qmax][x] + I*v[qmax][x]]/Abs[u[qmax][0] + I*v[qmax][0]], {x, 
    0, 1}, Frame -> True, FrameLabel -> {"x", "Relative Amplitude"} , 
   PlotRange -> All, PlotStyle -> Orange];

f2 = Plot[
   180*(Arg[u[qmax][x] + I*v[qmax][x]] - 
       Arg[u[qmax][0] + I*v[qmax][0]])/Pi, {x, 0, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Phase"} , PlotRange -> All, 
   PlotStyle -> Orange];

(***Fresnel number N=0.5***)

k1 = 1.5708; b = (k*a^2)/(2*k1); c = a*Exp[I*(Pi/4 - k*b)]/Sqrt[lam*b];
u[0][x_] := 1; v[0][x_] := 0;
Do[{u[q] = 
   Interpolation[
    Table[{x2, 
      Re[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, h}]], 
  v[q] = Interpolation[
    Table[{x2, 
      Im[c*NIntegrate[(u[q - 1][x1] + I*v[q - 1][x1])*
          Exp[-I*k1*(x1 - x2)^2], {x1, -1, 1}]]}, {x2, -1, 1, 
      h}]]}, {q, 1, qmax}]

p3 = Plot[
   Abs[u[qmax][x] + I*v[qmax][x]]/Abs[u[qmax][0] + I*v[qmax][0]], {x, 
    0, 1}, Frame -> True, FrameLabel -> {"x", "Relative Amplitude"} , 
   PlotRange -> All, PlotStyle -> Green];

f3 = Plot[
   180*(Arg[u[qmax][x] + I*v[qmax][x]] - 
       Arg[u[qmax][0] + I*v[qmax][0]])/Pi, {x, 0, 1}, Frame -> True, 
   FrameLabel -> {"x", "Relative Phase"} , PlotRange -> All, 
   PlotStyle -> Green];

{Show[{p1, p2, p3}], Show[{f1, f2, f3}], 
 Grid[{{"", 
    "N"}, {Graphics[{Blue, Line[{{0, 7}, {10, 7}}]}, 
     ImageSize -> {20, 10}], 
    6.25}, {Graphics[{Orange, Line[{{0, 6}, {10, 6}}]}, 
     ImageSize -> {20, 10}], 
    2.5}, {Graphics[{Green, Line[{{0, 5}, {10, 5}}]}, 
     ImageSize -> {20, 10}], 0.5}}]}

fig1_3

POSTED BY: Alexander Trounev
Answer
1 month ago

Group Abstract Group Abstract