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

Posted 7 months ago
1061 Views
|
17 Replies
|
7 Total Likes
|
 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. Attachments:
17 Replies
Sort By:
Posted 7 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]} 
Posted 7 months 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 7 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]}  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]} 
Posted 7 months ago
 Hye, but the results do not coincide with the results of expectedCordially
Posted 7 months ago
 We can't compare, since in Fig. 6: $q \ge 80$, and in my code: $q\le 10$
Posted 7 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
Posted 6 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 6 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 6 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 6 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 6 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"}]} 
Posted 6 months ago
 I optimized the numerical model and calculated the data for figure 7 using equation (27). Ðžn my laptop it takes half an hour.
Posted 6 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}}]} 
Posted 6 months 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
 In the interval $0 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}}]}  Answer Posted 6 months 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}}]} `