Angular and spectral response of thin film filters

From Optical Imaging and Spectroscopy (Wiley - OSA 2009)
By David J. Brady
www.opticalimaging.org
Figures 9.24, 9.25, 9.26, 9.28, 9.29, 9.30

n1=2.5;n2=1.5;
d1=1;d2=1;
k1z[theta_,nu_]:=2 Pi Sqrt[ n1^2-Sin[theta]^2] nu;
k2z[theta_,nu_]:=2 Pi Sqrt[ n2^2-Sin[theta]^2] nu;
M[theta_,nu_]:=0.25 Dot[{{(1+k2z[theta,nu]/k1z[theta,nu]) Exp[ I k2z[theta,nu] d2],(1-k2z[theta,nu]/k1z[theta,nu]) Exp[ -I k2z[theta,nu] d2]},
{(1-k2z[theta,nu]/k1z[theta,nu]) Exp[I k2z[theta,nu] d2],(1+k2z[theta,nu]/k1z[theta,nu]) Exp[- I k2z[theta,nu] d2]}},
{{(1+k1z[theta,nu]/k2z[theta,nu]) Exp[ I k1z[theta,nu] d1],(1-k1z[theta,nu]/k2z[theta,nu]) Exp[ -I k1z[theta,nu] d1]},
{(1-k1z[theta,nu]/k2z[theta,nu]) Exp[I k1z[theta,nu] d1],(1+k1z[theta,nu]/k2z[theta,nu]) Exp[- I k1z[theta,nu] d1]}}];
gam[theta_,nu_]:=Eigenvalues[M[theta,nu]];
g1[theta_,nu_]:=(M[theta,nu][[1,1]]+M[theta,nu][[2,2]])/2+Sqrt[(M[theta,nu][[1,1]]+M[theta,nu][[2,2]])^2/4-1];

Plot[Abs[gam[0,nu]],{nu,0,3},Axes->False,PlotRange->All,Frame->True,PlotPoints->200]

Plot[Abs[g1[0,nu]],{nu,.0,3},PlotRange->All,Axes->False,Frame->True,PlotPoints->200]

Plot[{Floor[Abs[Cos[k1z[0,nu] d1] Cos[k2z[0,nu] d2]-Sin[k1z[0,nu] d1] Sin[k2z[0,nu] d2](k1z[0,nu]/k2z[0,nu]+k2z[0,nu]/k1z[0,nu])/2]],Abs[g1[0,nu]]},{nu,0,3},Axes->False, Frame->True,PlotPoints->200]

Mp=0.25 Dot[{{(1+k2/k1) Exp[ I k2 d2],(1-k2/k1) Exp[-I k2 d2]},
{(1-k2/k1) Exp[ I k2 d2],(1+k2/k1) Exp[- I k2 d2]}},
{{(1+k1/k2) Exp[ I k1 d1],(1-k1/k2) Exp[- I k1 d1]},
{(1-k1/k2) Exp[ I k1 d1],(1+k1/k2) Exp[- I k1 d1]}}]

Plot of the normal incidence bandgap for a quarter wave stack

trM[rN_,lambda_]:=Sin[Pi/(2 lambda )] ^2(1+(rN+1/rN)/2)-2;
DensityPlot[Floor[trM[rn,l]],{l,.8,1.3},{rn,1,2},PlotPoints->100,FrameLabel->{λ/(Subscript[λ, o]),(Subscript[n, 2])/(Subscript[n, 1])}]

trM[rN_,lambda_]:=Abs[Sin[Pi/(2 lambda )] ^2(1+(rN+1/rN)/2)-1];
DensityPlot[Floor[trM[rn,l]],{l,.99,1.01},{rn,1,1.01},PlotPoints->100,FrameLabel->{λ/(Subscript[λ, o]),(Subscript[n, 2])/(Subscript[n, 1])}]

Plot of wavelength and angular detuning in a quarter wave stack

n1=1.7;n2=1.65;
d1=0.25/n1;d2=0.25/n2;
k1z[theta_,nu_]:=2 Pi Sqrt[ n1^2-Sin[theta]^2] nu;
k2z[theta_,nu_]:=2 Pi Sqrt[ n2^2-Sin[theta]^2] nu;
M[theta_,nu_]:=0.25 Dot[{{(1+k2z[theta,nu]/k1z[theta,nu]) Exp[ I k2z[theta,nu] d2],(1-k2z[theta,nu]/k1z[theta,nu]) Exp[ -I k2z[theta,nu] d2]},
{(1-k2z[theta,nu]/k1z[theta,nu]) Exp[I k2z[theta,nu] d2],(1+k2z[theta,nu]/k1z[theta,nu]) Exp[- I k2z[theta,nu] d2]}},
{{(1+k1z[theta,nu]/k2z[theta,nu]) Exp[ I k1z[theta,nu] d1],(1-k1z[theta,nu]/k2z[theta,nu]) Exp[ -I k1z[theta,nu] d1]},
{(1-k1z[theta,nu]/k2z[theta,nu]) Exp[I k1z[theta,nu] d1],(1+k1z[theta,nu]/k2z[theta,nu]) Exp[- I k1z[theta,nu] d1]}}];
gam[theta_,nu_]:=Eigenvalues[M[theta,nu]];
g1p[theta_,nu_]:=(M[theta,nu][[1,1]]+M[theta,nu][[2,2]])/2+Sqrt[(M[theta,nu][[1,1]]+M[theta,nu][[2,2]])^2/4-1];
g1m[theta_,nu_]:=(M[theta,nu][[1,1]]+M[theta,nu][[2,2]])/2-Sqrt[(M[theta,nu][[1,1]]+M[theta,nu][[2,2]])^2/4-1];
r[theta_,nu_,L_]:=((g1m[theta,nu]-M[theta,nu][[1,1]])/M[theta,nu][[1,2]])(1-(g1m[theta,nu]/g1p[theta,nu])^L)/(1-(g1m[theta,nu]/g1p[theta,nu])^L(g1m[theta,nu]-M[theta,nu][[1,1]])/(g1p[theta,nu]-M[theta,nu][[1,1]]+10^(-10)));

Plot[Abs[gam[0,nu]],{nu,0,6},Axes->False,PlotRange->All,Frame->True,PlotPoints->200]

DensityPlot[Abs[g1[Pi dT/180,1/(1+dL)]],{dT,-30,30},{dL,-0.1,0.05},FrameLabel->{Δθ,Δλ},PlotRange->All,PlotPoints->150]

Plot[Abs[r[0,1/(1+dL),30]],{dL,-.3,.3},Axes->False,Frame->True,PlotRange->All,FrameLabel->{Δλ},PlotStyle->{Black}]

DensityPlot[Abs[r[Pi dT/180,1/(1+dL),30]],{dT,-30,30},{dL,-0.1,0.05},FrameLabel->{Δθ,Δλ},PlotRange->All,ColorFunction->Function[{dt,tl,z},GrayLevel[z]],PlotPoints->50]

n1=1.7;n2=2.2;
d1=0.25/n1;d2=0.25/n2;
k1z[theta_,nu_]:=2 Pi Sqrt[ n1^2-Sin[theta]^2] nu;
k2z[theta_,nu_]:=2 Pi Sqrt[ n2^2-Sin[theta]^2] nu;
M[theta_,nu_]:=0.25 Dot[{{(1+k2z[theta,nu]/k1z[theta,nu]) Exp[ I k2z[theta,nu] d2],(1-k2z[theta,nu]/k1z[theta,nu]) Exp[ -I k2z[theta,nu] d2]},
{(1-k2z[theta,nu]/k1z[theta,nu]) Exp[I k2z[theta,nu] d2],(1+k2z[theta,nu]/k1z[theta,nu]) Exp[- I k2z[theta,nu] d2]}},
{{(1+k1z[theta,nu]/k2z[theta,nu]) Exp[ I k1z[theta,nu] d1],(1-k1z[theta,nu]/k2z[theta,nu]) Exp[ -I k1z[theta,nu] d1]},
{(1-k1z[theta,nu]/k2z[theta,nu]) Exp[I k1z[theta,nu] d1],(1+k1z[theta,nu]/k2z[theta,nu]) Exp[- I k1z[theta,nu] d1]}}];
gam[theta_,nu_]:=Eigenvalues[M[theta,nu]];
g1p[theta_,nu_]:=(M[theta,nu][[1,1]]+M[theta,nu][[2,2]])/2+Sqrt[(M[theta,nu][[1,1]]+M[theta,nu][[2,2]])^2/4-1];
g1m[theta_,nu_]:=(M[theta,nu][[1,1]]+M[theta,nu][[2,2]])/2-Sqrt[(M[theta,nu][[1,1]]+M[theta,nu][[2,2]])^2/4-1];
r[theta_,nu_,L_]:=((g1m[theta,nu]-M[theta,nu][[1,1]])/M[theta,nu][[1,2]])(1-(g1m[theta,nu]/g1p[theta,nu])^L)/(1-(g1m[theta,nu]/g1p[theta,nu])^L(g1m[theta,nu]-M[theta,nu][[1,1]])/(g1p[theta,nu]-M[theta,nu][[1,1]]));
t[theta_,nu_,L_]:=g1m[theta,nu]^L(g1p[theta,nu]-g1m[theta,nu])/(g1p[theta,nu]-M[theta,nu][[1,1]]-(g1m[theta,nu]/g1p[theta,nu])^L(g1m[theta,nu]-M[theta,nu][[1,1]]));

Plot[Abs[r[0,1/(1+dL),30]],{dL,-.3,.3},Axes->False,Frame->True,PlotRange->All,FrameLabel->{Δλ}]

Plot[Arg[r[0,1/(1+dL),30]],{dL,-.1,.1},Axes->False,Frame->True,PlotRange->All,FrameLabel->{Δλ},PlotStyle->{Black}]

Plot[Abs[t[0,1/(1+dL),30]],{dL,-.3,.3},Axes->False,Frame->True,PlotRange->All,FrameLabel->{Δλ}]

pa=Plot[Abs[t[0,1/(1+dL),20]^2/(1-r[0,1/(1+dL),20]^2)],{dL,-.3,.3},Axes->False,Frame->True,PlotRange->All,FrameLabel->{Δλ},PlotLabel->"(a)",PlotStyle->{Black}]

pb=Plot[Abs[t[0,1/(1+dL),20]^2/(1-r[0,1/(1+dL),20]^2)],{dL,-.0001,.0001},Axes->False,Frame->True,PlotRange->All,FrameLabel->{Δλ},PlotLabel->"(b)",PlotStyle->{Black}]

Show[GraphicsArray[{{pa},{pb}}]]

Plot[Abs[t[0,1/(1+dL),20]^2/(1-r[0,1/(1+dL),20]^2)],{dL,-.0001,.0001},Axes->False,Frame->True,PlotRange->All,FrameLabel->{Δλ}]

DensityPlot[Abs[t[Pi dT/180,1/(1+dL),20]^2/(1-r[Pi dT/180,1/(1+dL),20]^2)],{dT,-2,2},{dL,-0.0001,0.00005},FrameLabel->{Δθ,Δλ},PlotRange->All,ColorFunction->Function[{dt,tl,z},GrayLevel[z]],PlotPoints->110]

Plot[Mod[Arg[((g1m[0,1/(1+dL)]-M[0,1/(1+dL)][[1,1]])/M[0,1/(1+dL)][[1,2]])],2Pi]-Pi,{nu,.9,1.1},Axes->False,Frame->True,PlotStyle->{Black},FrameLabel->{Δλ}]

Plot[Abs[((g1m[0,nu]-M[0,nu][[1,1]])/M[0,nu][[1,2]])],{nu,.9,1.1},Frame->True,Axes->False]

Addition of a bit of phase to but system near band edgge

DensityPlot[Abs[t[Pi dT/180,1/(1+dL),20]^2/(1-r[Pi dT/180,1/(1+dL),20]^2 E^(4 Pi I k1z[Pi dT/180]/8))],{dT,-2,2},{dL,-0.0001,0.00005},FrameLabel->{Δθ,Δλ},PlotRange->All,ColorFunction->Function[{dt,tl,z},GrayLevel[z]],PlotPoints->110]

pa=Plot[Abs[t[0,1/(1+dL),20]^2/(1-r[0,1/(1+dL),20]^2 E^(4 Pi I k1z[0,1/(1+dL)]/5))],{dL,-.1,.1},Axes->False,Frame->True,PlotRange->All,FrameLabel->{Δλ},PlotLabel->"(a)"]