Coherent mode decomposition

From Optical Imaging and Spectroscopy (Wiley - OSA 2009)
By David J. Brady
www.opticalimaging.org
Figure 6.24

Coherent Mode Examples

phi[x_]:=Exp[-Pi x^2];

DensityPlot[2 phi[(x-.5)/2]^2phi[y/2]^2+phi[(x+.5)/2]^2phi[y/2]^2,{x,-3,3},{y,-3,3}, Mesh->False,PlotPoints->100,PlotRange->All]

Plot[2 phi[(x-.5)/2]^2+phi[(x+.5)/2]^2,{x,-3,3},PlotPoints->50,PlotRange->All]

aa=Integrate[(phi[(x-.5)/2]+phi[(x+.5)/2])^2,{x,-Infinity,Infinity}]

bb=Integrate[(phi[(x-.5)/2]-phi[(x+.5)/2])^2,{x,-Infinity,Infinity}]

aa=N[2 Sqrt[2](1+Exp[-Pi/8])]

bb=N[2 Sqrt[2](1-Exp[-Pi/8])]

W={{3 aa, Sqrt[aa bb]},{Sqrt[aa bb],3bb}}/4;
{u,l,v}=SingularValueDecomposition[Transpose[W]]

W

phia[x_]:=(phi[(x-.5)/2]+phi[(x+.5)/2])/Sqrt[aa];
phib[x_]:=(phi[(x-.5)/2]-phi[(x+.5)/2])/Sqrt[bb];
phic1[x_]:= u[[1,1]] phia[x]+ u[[1,2]] phib[x];
phic2[x_]:= u[[2,1]] phia[x]+ u[[2,2]] phib[x];
Wn[x1_,y1_,x2_,y2_]:=(l[[1,1]]phic1[x1] phic1[x2]+l[[2,2]]phic2[x1]phic2[x2])phi[y1/2] phi[y2/2];
Wo[x1_,x2_]:=2 phi[(x1-.5)/2]phi[(x2-.5)/2]+ phi[(x1+.5)/2]phi[(x2+.5)/2];

pb=DensityPlot[-Wn[x1,0,x2,0],{x1,-3,3},{x2,-3,3},Mesh->False,PlotPoints->100,ColorFunction->GrayLevel, PlotLabel->"(b)"]

pa=DensityPlot[-Wn[x,y,0,0],{x,-3,3},{y,-3,3},Mesh->False,PlotPoints->100,ColorFunction->GrayLevel, PlotLabel->"(a)",PlotRange->All]

pe=Plot[{phic1[x],phic2[x]},{x,-3,3},Axes->False,PlotPoints->50,Frame->True,PlotLabel->"(e)",PlotStyle->{Black}]

Integrate[phic1[x] phic2[x],{x,-Infinity,Infinity}]

pc=DensityPlot[phic1[x] phi[y/2],{x,-3,3},{y,-3,3},PlotPoints->100,Mesh->False,ColorFunction->GrayLevel,PlotLabel->"(c)",PlotRange->All]

pd=DensityPlot[phic2[x] phi[y/2],{x,-3,3},{y,-3,3},Mesh->False,PlotPoints->100,ColorFunction->GrayLevel,PlotLabel->"(d)",PlotRange->All]

Show[GraphicsGrid[{{pa,pb},{pc,pd},{pe}}]]