3
Single-interface modes in the microwave regime

If the reader wishes to regenerate all of the graphs in this chapter or to selectively regenerate certain figures with perhaps different parameter ranges, the first step is to evaluate the notebook by selecting "Evaluate Notebook" under the "Evaluation" menu bar in Mathematica.  If Mathematica asks "Do you want to automatically evaluate all the initialization cells in the notebook?" it is sufficient to answer "No."  After the code has completed running all of the figures and tables in the text will have been regenerated.  To regraph a specific figure, the Code section should then be expanded by double clicking on the down arrow of the rightmost bracket.  This will display further subsections like "Mathematica Preparation."  These subsections should in turn be expanded in the same manner as necessary to locate the input code for the figure of interest.  Each table or figure is generated by a code input line such as this one for Fig. 12b:
Fig12b=FigℛfOttoTM2=GraphicsRow[
{FigℛfOttoTM2a,FigℛfOttoTM2b},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]
Once the code line has been located for the figure of interest, the specific parameters in the input line can be adjusted as desired, the line selected by clicking once on the right bracket, and the new figure generated by hitting "Shift-Return" or just "Enter" for an extended keyboard.
This notebook also contains three other sections with all of the tables in the text, all the figures in the text, and all the chapter exercises.  Each section can, as usual, be opened by double clicking on the down arrow of the right bracket.

Code

Mathematica Preparation

Clearing

ClearAll["Global`*"]
Off[General::"spell",General::"spell1"]

Packages

Needs["PlotLegends`"];

Units

yocto=(10.^(-24));
zepto=(10.^(-21));
atto=(10.^(-18));
femto=(10.^(-15));
pico=(10.^(-12));
nano=(10.^(-9));
micro=(10.^(-6));
milli=(10.^(-3));
kilo=(10.^3);
mega=(10.^6);
giga=(10.^9);
tera=(10.^12);
peta=(10.^15);
exa=(10.^18);
zetta=(10.^21);
yotta=(10.^24);

Physical constants

NSub={
c->2.99792458 (10^8) ,
e->1.6021773 (10^(-19)),
h->6.6260755 (10^(-34)),
ℏ->1.05457 (10^(-34)),
K->1.380658 (10^(-23)),
me->9.109389 (10^(-31)),
μ0->4 π (10^(-7)),
ϵ0->8.85419 (10^(-12))
};

Plotting

Graphics Styles

fs=12;(*FontSize for LabelStyle*)
fs1=1.1fs;(*FontSize for LabelStyle*)
fs2=1.2fs;(*FontSize for LabelStyle*)
is={350,200};(*ImageSize for one figure*)
gr={400,150};(*ImageSize for GraphicsRow*)
gr2={480,180};(*ImageSize for GraphicsRow*)
gg={400,300};(*ImageSize for GraphicsGrid*)
gs=-30; (*GrapicsSpacing for two figures*)
ggs={-20,20};(*GrapicsSpacing for four figures*)
thick=Thickness[0.007]; (*Thickness of lines*)

Graphics option: optX

optX={
GridLines -> Automatic,
Frame -> True,
ImageSize->is,
PlotRange->All,
LabelStyle -> {FontSize -> fs},
PlotStyle->{
{Black,thick},
{Black,thick,Dashing[{0.06,0.02}]},
{Black,thick,Dashing[{0.02,0.01}]},
{Black,thick,DotDashed},
{Black,thick, Dashing[{0.04, 0.01}]},
{Black,thick,Dashing[{0.04, 0.03}]}}};

ϵ-μ parameter space

fsx=.9 fs;
psx=1.4;
Clear[FigTypeB1,first,second,rs,rc,ϕs,ϕc]
FigTypeB1:=Function[{first,second,rs,rc,ϕs,ϕc},
{rr:=Max[rs,rc],
Show[Graphics[{
RGBColor[0,0,0],Opacity[0.2],Disk[{0,0},rr,{0,π/2}],
RGBColor[0,0,0],Opacity[0.3],Disk[{0,0},rr,{π/2,π}],
RGBColor[0,0,0],Opacity[0.4],Disk[{0,0},rr,{π,3π/2}],
RGBColor[0,0,0],Opacity[0.5],Disk[{0,0},rr,{3π/2,2π}],
Black,Arrow[{{0,0},{rs Cos[ϕs],rs Sin[ϕs]}}],
Black,Circle[{0,0},rs/2.2,{0,ϕs}],
Black,Circle[{0,0},rc/2,{0,ϕc}],
Black,Arrow[{{0,0},{rc Cos[ϕc],rc Sin[ϕc]}}]},
LabelStyle -> {FontSize -> fs},
FrameTicks->Automatic,
Frame->True,
PlotRange->{{-1.5 rr,1.5 rr},{-1.5 rr,1.5 rr}},
GridLines->None,
ImageSize->is],
FrameLabel->{"(Subscript[ϵ, r])'","(Subscript[μ, r])'",StringJoin["(Subscript[r, s]) = ",ToString[rs]," "],StringJoin["(Subscript[r, c]) = ",ToString[rc]," "]},
Epilog->{
{RGBColor[0,0,0],Text[
Style["DPS",fsx],psx{.9rr Cos[tt],1.15rr Sin[tt]}/.tt->π/4]},
{RGBColor[0,0,0],Text[
Style["ENG",fsx],psx{.9rr Cos[tt],1.15rr Sin[tt]}/.tt->π-π/4]},
{RGBColor[0,0,0],Text[
Style["DNG",fsx],psx{.9rr Cos[tt],1.15rr Sin[tt]}/.tt->π+π/4]},
{RGBColor[0,0,0],Text[
Style["MNG",fsx],psx{.9rr Cos[tt],1.15rr Sin[tt]}/.tt->2π-π/4]},
{RGBColor[0,0,0],Text[
Style[first,1.2fsx],1.2{rs Cos[ϕs],rs Sin[ϕs]}]},
{RGBColor[0,0,0],Text[
Style[second,1.2fsx],1.2{rc Cos[ϕc],rc Sin[ϕc]}]}},AspectRatio->1]}]

FigTypeB1["(Subscript[ϕ, s])","(Subscript[ϕ, c])",2,2,.25π,π-.25π][[2]]

Outline

TableAll=Grid[{
{"Item","Topic","Chapter 3", "Chapter 4","Chapter 5","Chapter 6","Chapter 7"},
{"1","Interfaces","1","1","2","1","2"},
{"2","Types","ENG,DNG","DPS,ENG,DNG,MNG","DPS,ENG,DNG,MNG","ENG","ENG"},
{"3","(Subscript[ϵ, r]),(Subscript[μ, r])","complex","real","real","complex","complex"},
{"4","Dispersion","yes","no","no","no","no"},
{"5","Free β","yes","yes","yes","yes","yes"},
{"6","Loaded β","yes","no","no","yes","yes"},
{"7","Configuration","O,K","free","free","O,K","G"},
{"8","ℛ","yes","no","no","yes","yes"},
{"9","G-H","yes","no","no","no","no"},
{"10","E and H","no","yes","yes","yes","yes"},
{"11","(Subscript[s, z])","no","yes","yes","yes","yes"},
{"12","(Subscript[s, x])","no","no","no","yes","yes"},
{"13","η","yes","no","no","yes","yes"},
{"14","(Subscript[v, ph]) and (Subscript[v, group])","yes","no","no","no","no"},
{"15","Charge density","no","no","no","yes","yes"}},
Dividers->All,
ItemStyle->.9{fs,fs}]

TableChapter3=Grid[{
{"Item","Topic","Chapter 3"},
{"1","Interfaces","1"},
{"2","Types","ENG,DNG"},
{"3","(Subscript[ϵ, r]),(Subscript[μ, r])","complex"},
{"4","Dispersion","yes"},
{"5","Free β","yes"},
{"6","Loaded β","yes"},
{"7","Configuration","O,K"},
{"8","ℛ","yes"},
{"9","G-H","yes"},
{"10","E and H","no"},
{"11","(Subscript[s, z])","no"},
{"12","(Subscript[s, x])","no"},
{"13","η","yes"},
{"14","(Subscript[v, ph]) and (Subscript[v, group])","yes"},
{"15","Charge density","no"}},
Dividers->All,
ItemStyle->{fs,fs}]

TableChapter4=Grid[{
{"Item","Topic", "Chapter 4"},
{"1","Interfaces","1"},
{"2","Types","DPS,ENG,DNG,MNG"},
{"3","(Subscript[ϵ, r]),(Subscript[μ, r])","real"},
{"4","Dispersion","no"},
{"5","Free β","yes"},
{"6","Loaded β","no"},
{"7","Configuration","free"},
{"8","ℛ","no"},
{"9","G-H","no"},
{"10","E and H","yes"},
{"11","(Subscript[s, z])","yes"},
{"12","(Subscript[s, x])","no"},
{"13","η","no"},
{"14","(Subscript[v, ph]) and (Subscript[v, group])","no"},
{"15","Charge density","no"}},
Dividers->All,
ItemStyle->{fs,fs}]

TableChapter5=Grid[{
{"Item","Topic","Chapter 5"},
{"1","Interfaces","2"},
{"2","Types","DPS,ENG,DNG,MNG"},
{"3","(Subscript[ϵ, r]),(Subscript[μ, r])","real"},
{"4","Dispersion","no"},
{"5","Free β","yes"},
{"6","Loaded β","no"},
{"7","Configuration","free"},
{"8","ℛ","no"},
{"9","G-H","no"},
{"10","E and H","yes"},
{"11","(Subscript[s, z])","yes"},
{"12","(Subscript[s, x])","no"},
{"13","η","no"},
{"14","(Subscript[v, ph]) and (Subscript[v, group])","no"},
{"15","Charge density","no"}},
Dividers->All,
ItemStyle->{fs,fs}]

TableChapter6=Grid[{
{"Item","Topic","Chapter 6"},
{"1","Interfaces","1"},
{"2","Types","ENG"},
{"3","(Subscript[ϵ, r]),(Subscript[μ, r])","complex"},
{"4","Dispersion","no"},
{"5","Free β","yes"},
{"6","Loaded β","yes"},
{"7","Configuration","O,K"},
{"8","ℛ","yes"},
{"9","G-H","no"},
{"10","E and H","yes"},
{"11","(Subscript[s, z])","yes"},
{"12","(Subscript[s, x])","yes"},
{"13","η","yes"},
{"14","(Subscript[v, ph]) and (Subscript[v, group])","no"},
{"15","Charge density","yes"}},
Dividers->All,
ItemStyle->{fs,fs}]

TableChapter7=Grid[{
{"Item","Topic","Chapter 7"},
{"1","Interfaces","2"},
{"2","Types","ENG"},
{"3","(Subscript[ϵ, r]),(Subscript[μ, r])","complex"},
{"4","Dispersion","no"},
{"5","Free β","yes"},
{"6","Loaded β","yes"},
{"7","Configuration","G"},
{"8","ℛ","yes",""},
{"9","G-H","no"},
{"10","E and H","yes"},
{"11","(Subscript[s, z])","yes"},
{"12","(Subscript[s, x])","yes"},
{"13","η","yes"},
{"14","(Subscript[v, ph]) and (Subscript[v, group])","no"},
{"15","Charge density","yes"}},
Dividers->All,
ItemStyle->{fs,fs}]

Dispersion of the constitutive parameters ϵ and μ: No loss

ϵ and μ of prism, cover and substrate

ϵp=3.;μp=1.;np=(Sqrt[ϵp])(Sqrt[μp]);
ϵc=1.;μc=1.;nc=(Sqrt[ϵc])(Sqrt[μc]);
ϵs=1.;μs=1.;ns=(Sqrt[ϵs])(Sqrt[μs]);

The constitutive functions (Subscript[ϵ, g]), (Subscript[μ, g]) and (Subscript[n, g])

(Subscript[ϵ, m])=1-(((Subscript[f, p])^2)/(f(f+iγ))),

(Subscript[μ, m])=1-F((f^2)/((f^2)-((Subscript[f, 0])^2)+iΓf))

(Subscript[n, m])=(Sqrt[(Subscript[ϵ, m])])(Sqrt[(Subscript[μ, m])]).

F=0.56;
fp=10 giga;
f0=4 giga;

Clear[ϵm1,μm1,nm1]
ϵm1[f_]:=1-((fp^2)/(f(f+I γ)))
μm1[f_]:=1-F((f^2)/((f^2)-(f0^2)+ I Γ f))
nm1[f_]:=(Sqrt[ϵm[f]])(Sqrt[μm[f]])

caseLossless={γ->0,Γ->0};

caseLossy={γ->0.01 fp,Γ->0.01 f0};

caseLossy1={γ->0.03 fp,Γ->0.03 f0};

Table3=Grid[{
{"case","Loss","γ/(Subscript[f, p])","Γ/(Subscript[f, 0])"},
{"(a)","Lossless",γ/fp,Γ/f0}/.caseLossless,
{"(b)","Moderately lossy",γ/fp,Γ/f0}/.caseLossy,
{"(c)","Highly lossy",γ/fp,Γ/f0}/.caseLossy1},
Dividers->All,
ItemStyle->{fs,fs}]

Clear[ϵm,μm,nm]
ϵm[f_]:=ϵm1[f]/.caseLossless
μm[f_]:=μm1[f]/.caseLossless
nm[f_]:=nm1[f]/.caseLossless

fμ=giga FindRoot[μm[f giga]==0,{f,5}][[1,2]];

fϵ=giga FindRoot[ϵm[f giga]==0,{f,15}][[1,2]];

Table2=Grid[{
{"F","(Subscript[f, 0]) (GHz)","(Subscript[f, μ]) (GHz)","(Subscript[f, p]) (GHz)"},
{F,f0/giga, fμ/giga,fp/giga}},
Dividers->All,
ItemStyle->{fs,fs}]

Plot of (Subscript[ϵ, m]), (Subscript[μ, m]) and (Subscript[n, m]) as a function of  f

Fig1=Plot[
{ϵm[f giga],μm[f giga]},
{f,0,20.01},
PlotRange->{-10.1,10.1},
LabelStyle->{FontSize -> fs},
FrameLabel->{"f (GHz)","Dispersion"},
Evaluate[optX],

Epilog->{
RGBColor[0,0,0],
Text["●",{f0/giga,0}],
Text[Style["(Subscript[f, 0])",fs1],{f0/giga-1.5,-1.5}],
Text["●",{fμ/giga,0}],
Text[Style["(Subscript[f, μ])",fs1],{fμ/giga,2.5}],
Text["●",{fp/giga,0}],
Text[Style["(Subscript[f, p])",fs1],{fp/giga,2.5}]}]

Clear[funENG]
funENG[f_]:=If[ϵm[f]<0&&μm[f]>0,Im[nm[f]],0]

Clear[funDNG]
funDNG[f_]:=If[ϵm[f]<0&&μm[f]<0,nm[f],0]

Fig2a=Plot[
funDNG[f giga],
{f,0,14},
Filling->Axis,
FillingStyle->Opacity[.4],
PlotRange->{-10,2},
LabelStyle->{FontSize -> fs},FrameLabel->{"f (GHz)","(Subscript[n, m])'","DNG",""},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{f0/giga,-.1}],
Text[Style["(Subscript[f, 0])",fs1],{f0/giga-.65,-1.6}],
Text["●",{fμ/giga,-.1}],
Text[Style["(Subscript[f, μ])",fs1],{fμ/giga+.65,-1.6}],
Text["●",{fp/giga,-.1}],
Text[Style["(Subscript[f, p])",fs1],{fp/giga,-1.6}]}]

Fig2b=Plot[
funENG[f giga],
{f,0,14},
Filling->Axis,
FillingStyle->Opacity[.3],
PlotRange->{-2,10},
LabelStyle->{FontSize -> fs},FrameLabel->{"f (GHz)","(Subscript[n, m])''","ENG",""},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{f0/giga,.15}],
Text[Style["(Subscript[f, 0])",fs1],{f0/giga+.75,1.5}],
Text["●",{fμ/giga,.15}],
Text[Style["(Subscript[f, μ])",fs1],{fμ/giga,1.5}],
Text["●",{fp/giga,.15}],
Text[Style["(Subscript[f, p])",fs1],{fp/giga,1.5}]}]

Fig2=GraphicsRow[
{Fig2a,Fig2b},
ImageSize->1.4gr,
Frame->True,
Spacings->-40]

fx=4.4 giga;
Fig3=Plot[
{ϵm[f giga],μm[f giga],nm[f giga]},
{f,4.2,4.6},
LabelStyle->{FontSize -> fs},FrameLabel->{"f (GHz)","Dispersion"},
Evaluate[optX],

Epilog->{
RGBColor[0,0,0],
Text["●",{fx/giga,ϵm[fx]}],
Text["●",{fx/giga,μm[fx]}],
Text["●",{fx/giga,nm[fx]}]}]

Clear[rm,ϕm]
rc:=(Sqrt[((ϵc)^2)+((μc)^2)])
ϕc:=ArcCos[ϵc/rc]
rm[f_]:=(Sqrt[((Abs[ϵm[f]])^2)+((Abs[μm[f]])^2)])
ϕm[f_]:=ArcCos[Abs[ϵm[f]/rm[f]]]

Table4=Grid[{
{"f (GHz)","(Subscript[ϵ, m])","(Subscript[μ, m])","(Subscript[n, m])","(Subscript[r, m])","(Subscript[ϕ, m]) (deg)"},
Chop[{f/giga,ϵm[f],μm[f],nm[f],rm[f],180/π (π+ϕm[f])}/.f->4.4 giga]},
Dividers->All,
ItemStyle->{fs,fs}]

Range of solutions

Fig4=FigTypeB1["(Subscript[ϕ, m])","(Subscript[ϕ, c])", rm[4.4 giga],1, π+ϕm[4.4 giga],0][[2]]

Clear[h]
h[f_]:=If[f>f0 &&f<6 giga, (Sqrt[ϵm[f]  μm[f]]),0]

Clear[h1]
h1[f_]:=Chop[If[f>f0 &&f<6 giga, (Sqrt[ϵm[f]])(Sqrt[μm[f]]),0]]

Mode equations for lossless media

(Subscript[β, TE])=(Sqrt[(((Subscript[ϵ, m])(f) (Subscript[μ, m])(f) ((Subscript[μ, s])^2)-(Subscript[ϵ, s]) (Subscript[μ, s]) (((Subscript[μ, m])(f))^2))/(((Subscript[μ, s])^2)-(((Subscript[μ, m])(f))^2)))])

Clear[βTE]
βTE[f_]:=(Sqrt[((ϵm[f]μm[f] ((μs)^2)-ϵs μs ((μm[f])^2))/(((μs)^2)-((μm[f])^2)))])

(Subscript[β, TM])=(Sqrt[(((Subscript[μ, m])(f) (Subscript[ϵ, m])(f) ((Subscript[ϵ, s])^2)-(Subscript[μ, s]) (Subscript[ϵ, s]) (((Subscript[ϵ, m])(f))^2))/(((Subscript[ϵ, s])^2)-(((Subscript[ϵ, m])(f))^2)))])

Clear[βTM]
βTM[f_]:=(Sqrt[((μm[f] ϵm[f] ((ϵs)^2)-μs ϵs ((ϵm[f])^2))/(((ϵs)^2)-((ϵm[f])^2)))])

Specific frequencies

f1=giga FindRoot[μm[f giga]==-1,{f,1,8}][[1,2]];

f2=giga FindRoot[ϵm[f giga]==-1,{f,1,8}][[1,2]];

f3=giga FindRoot[βTE[f giga]==βTM[f giga],{f,5}][[1,2]];

Table5=Grid[{
{"","f [GHz]","Limits"},
{"(b)",f0/giga,"(Subscript[μ, m]) -> -∞"},
{"(c)",f1/giga,"(Subscript[μ, m]) -> -1"},
{"(d)",f3/giga,"\!\(\*SubscriptBox[\(β\), \(\(TE\)\(\\ \\ \)\)]\)-> (Subscript[β, TM])"},
{"(e)",f2/giga,"(Subscript[(Subscript[ϵ, m]),   ])-> -1"}},
Dividers->All,
ItemStyle->{fs,fs}]

Relative TE mode solution

Clear[xβTE]
xβTE[f_]:=If[f>f1&&f<f3,f/f0 βTE[f],-100]

Relative TM(1) mode solution

Clear[xβTM1]
xβTM1[f_]:=If[f>.1 giga&&f<f0,f/f0 βTM[f],100]

Relative TM(2) mode solution

Clear[xβTM2]
xβTM2[f_]:=If[f>f3&&f<f2,f/f0 βTM[f],-100]

TableForm[Table[{f,βTM2[f giga]},{f,0,8,.1}]];

ω = ω(k) for TE and TM mode solutions for (Subscript[n, c]) = (Subscript[n, s]) = 1 and (Subscript[θ, p]) = 45 deg

ffTE=giga FindRoot[ArcSin[((βTE[f giga])/((Sqrt[μp]) (Sqrt[ϵp])))]==45 π/180,{f,5}][[1,2]];

ffTM1=giga FindRoot[ArcSin[((βTM[f giga])/((Sqrt[μp]) (Sqrt[ϵp])))]==45 π/180,{f,3}][[1,2]];

ffTM2=giga FindRoot[ArcSin[((βTM[f giga])/((Sqrt[μp]) (Sqrt[ϵp])))]==45 π/180,{f,6}][[1,2]];

Fig6=FigModeSolutions=ParametricPlot[{
{f/f0 giga,f},
{f,f0/giga},
{f,f1/giga},
{f,f2/giga},
{xβTE[f giga],f},
{xβTM1[f giga],f},
{xβTM2[f giga],f},
},
{f,.1,8},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(f/(Subscript[f, 0]))β","f (GHz)","",""},
ImageSize->1.5is,
PlotRange->{{-0.01,2 4},{-.1,8}},
Evaluate[optX],
Epilog->{
Text["●",{ffTE/f0 βTE[ffTE], ffTE/giga}],
Text["●",{.1+ffTM1/f0 βTM[ffTM1], ffTM1/giga}],
Text["●",{.05+ffTM2/f0 βTM[ffTM2], ffTM2/giga}],
Text[Style["(a)",fs1],{.3+.1,2.5+.7}],
Text[Style["(b)",fs1],{6,3.5}],
Text[Style["(c)",fs1],{6,5.2}],
Text[Style["(d)",fs1],{.3+.15,5.6}],
Text[Style["(e)",fs1],{6,7.5}],
Text[Style["TE mode",fs1],{3.5,5.3}],
Text[Style["TM(1) mode",fs1],{3.5,3.5}],
Text[Style["TM(2) mode",fs1],{3.5+.5,7.-1}]}]

Table6=Grid[{

{"Mode","TM(1)","TE","TM(2)"},
{"Type","ENG","DNG","ENG"},
{"f(GHz)",ffTM1/giga,ffTE/giga,ffTM2/giga},
{"(Subscript[ϵ, m])",Re[ϵm[ffTM1]],Re[ϵm[ffTE]],Re[ϵm[ffTM2]]},
{"(Subscript[μ, m])",Re[μm[ffTM1]],Re[μm[ffTE]],Re[μm[ffTM2]]},
{"(Subscript[n, m])",Chop[(Sqrt[Re[ϵm[ffTM1]]])(Sqrt[Re[μm[ffTM1]]])],
Chop[(Sqrt[Re[ϵm[ffTE]]])(Sqrt[Re[μm[ffTE]]])],
Chop[(Sqrt[Re[ϵm[ffTM2]]])(Sqrt[Re[μm[ffTM2]]])]},
{"(Subscript[r, m])",rm[ffTM1],rm[ffTE],rm[ffTM2]},
{"(Subscript[ϕ, m])",(π-ϕm[ffTM1])180/π,(π+ϕm[ffTE])180/π,(π-ϕm[ffTM2])180/π}},
Dividers->All,
ItemStyle->{fs,fs}]

Figa1=FigTypeB1["(Subscript[ϕ, m])","(Subscript[ϕ, c])",rm[ffTM1],1,π - ϕm[ffTM1],0][[2]]

+

Figb1=FigTypeB1["(Subscript[ϕ, m])", "(Subscript[ϕ, c])",rm[ffTE],1,π + ϕm[ffTE],0][[2]]

Figc1=FigTypeB1["(Subscript[ϕ, m])","(Subscript[ϕ, c])",rm[ffTM2],1,π - ϕm[ffTM2],0][[2]]

Fig7=GraphicsRow[
{Figa1,Figb1,Figc1},
ImageSize->.9{600,200},
Frame->True,
Spacings->-135]

Phase and group velocities

Clear[kTE,kTM]
kTE[f_]:=2π f βTE[f]/c/.NSub
kTM[f_]:=2π f βTM[f]/c/.NSub

((Subscript[v, g])/c)=(1/((d/(df)) (f β)))=(1/(β+f (d/(df)) β ))

Table7=Grid[{
{"f (GHz)","Mode","Type","(Subscript[v, phase])/c","(Subscript[v, group])/c"},

{ffTM1/giga,"TM(1)","ENG",Re[1/βTM[f]],Re[1/(βTM[f]+f D[βTM[f],f])]}/.f->3.6 giga,

{ffTE/giga,"TE","DNG",Re[1/βTE[f]],Re[1/(βTE[f]+f D[βTE[f],f])]}/.f->5.2 giga,

{ffTM2/giga,"TM(2)","ENG",Re[1/βTM[f]],Re[1/(βTM[f]+f D[βTM[f],f])]}/.f->6 giga}/.NSub,Dividers->All,
ItemStyle->{fs,fs}]

Surface impedance for (Subscript[θ, p]) = 45 deg

Case (a) The cover is DPS with n  =1 and the substrate is DNG with ϵ<0 and μ<0

Case (b) The cover is DNG with ϵ < 0 and μ < 0 and the substrate is DPS with n  = 1

(Subscript[η, TE])=((ω (Subscript[μ, 0]) )/(k β(f)))(({{(Subscript[μ, c]), x>0}, {(Subscript[μ, g])(f), x<0}})).

Clear[ηTEc]
ηTEc[f_]:= ((c μ0 μc)/(βTE[f]))/.NSub

Clear[ηTEs]
ηTEm[f_]:= ((c μ0 μm[f])/(βTE[f]))/.NSub

(Subscript[η, TM])=(( k β(f))/(ω (Subscript[ϵ, 0])))(({{(( 1)/(Subscript[ϵ, c])), x>0}, {(1/((Subscript[ϵ, g])(f))), x<0}}))

Clear[ηTMc]
ηTMc[f_]:=((βTM[f])/(c ϵ0 ϵc))/.NSub

Clear[ηTMsm]
ηTMm[f_]:=((βTM[f])/(c ϵ0 ϵm[f]))/.NSub

η0=(Sqrt[μ0/ϵ0])/.NSub;

Table8=Grid[{
{"f (GHz)","Mode","Type","(Subscript[η, c])/(Subscript[η, 0])","(Subscript[η, m])/(Subscript[η, 0])"},
{ffTM1/giga,"TM(1)","ENG",ηTMc[f]/η0,ηTMm[f]/η0}/.f->3.6 giga,
{ffTE/giga,"TE","DNG",ηTEc[f]/η0,ηTEm[f]/η0}/.f->5.2 giga,
{ffTM2/giga,"TM(2)","ENG",ηTMc[f]/η0,ηTMm[f]/η0}/.f->6 giga}/.NSub,
Dividers->All,
ItemStyle->{fs,fs}]

Reflectivity from three-interface structures

k-vectors

(Subscript[k, p])=(Sqrt[(Subscript[μ, p])(Subscript[ϵ, p])-(Subscript[μ, p])(Subscript[ϵ, p]) (sin^2)(θ)])

(Subscript[k, c])=(Sqrt[(Subscript[μ, c])(Subscript[ϵ, c])-(Subscript[μ, p])(Subscript[ϵ, p]) (sin^2)(θ)])=-i δ

(Subscript[k, g])=(Sqrt[(Subscript[μ, g])(Subscript[ϵ, g])-(Subscript[μ, p])(Subscript[ϵ, p]) (sin^2)(θ)])=κ

(Subscript[k, s])=(Sqrt[(Subscript[μ, s])(Subscript[ϵ, s])-(Subscript[μ, p])(Subscript[ϵ, p]) (sin^2)(θ)])=-i γ

Clear[ϵp,μp,ϵc,μc,ϵs,μs,dc,dm,θ,f]

Clear[kp,kc,km,ks]
kp[θ_]:=(Sqrt[μp ϵp-μp ϵp ((Sin[θ])^2)])
kc[θ_]:=(Sqrt[μc ϵc-μp ϵp ((Sin[θ])^2)])
km[θ_,f_]:=(Sqrt[μm[f] ϵm[f]-μp ϵp ((Sin[θ])^2)])
ks[θ_]:=(Sqrt[μs ϵs-μp ϵp ((Sin[θ])^2)])

Reflectance due to one interface: Fresnel equations

Note: θ is (Subscript[θ, p])
s-polarization, TE mode, ⊥

(Subscript[r, pc])=(((Subscript[μ, c])(Subscript[k, p])(θ)-(Subscript[μ, p])(Subscript[k, c])(θ))/((Subscript[μ, c])(Subscript[k, p])(θ)+(Subscript[μ, p])(Subscript[k, c])(θ)))

(Subscript[r, cg])=(((Subscript[μ, g]) (Subscript[k, c])(θ)-(Subscript[μ, c])(Subscript[k, g])(θ))/((Subscript[μ, g]) (Subscript[k, c])(θ)+(Subscript[μ, c])(Subscript[k, g])(θ)))

(Subscript[r, gs])=(((Subscript[μ, s]) (Subscript[k, g])(θ)-(Subscript[μ, g])(Subscript[k, s])(θ))/((Subscript[μ, s])(Subscript[k, g])(θ)+(Subscript[μ, g])(Subscript[k, s])(θ)))

p-polarization, TM mode, ∥

(Subscript[r, pc])=(((Subscript[ϵ, c]) (Subscript[k, p])(θ)-(Subscript[ϵ, p])(Subscript[k, c])(θ))/((Subscript[ϵ, c]) (Subscript[k, p])(θ)+(Subscript[ϵ, p]) (Subscript[k, c])(θ)))

(Subscript[r, cg])=(((Subscript[ϵ, g]) (Subscript[k, c])(θ)-(Subscript[ϵ, c])(Subscript[k, g])(θ))/((Subscript[ϵ, g]) (Subscript[k, c])(θ)+(Subscript[ϵ, c]) (Subscript[k, g])(θ)))

(Subscript[r, gs])=(((Subscript[ϵ, s]) (Subscript[k, g])(θ)-(Subscript[ϵ, g])(Subscript[k, s])(θ))/((Subscript[ϵ, s]) (Subscript[k, g])(θ)+(Subscript[ϵ, g]) (Subscript[k, s])(θ)))

s=1.;p=2.;

Clear[rpc]
rpc[θ_,pol_]:=If[pol==1,((μc kp[θ]-μp kc[θ])/(μc kp[θ]+μp kc[θ])),(( ϵc kp[θ]-ϵp kc[θ])/( ϵc kp[θ]+ϵp kc[θ]))]
Clear[rcm]
rcm[θ_,f_,pol_]:=If[pol==1,((μm[f] kc[θ]-μc km[θ,f])/(μm[f] kc[θ]+μc km[θ,f])),((ϵm[f]kc[θ]-ϵc km[θ,f])/(ϵm[f] kc[θ]+ϵc  km[θ,f]))]
Clear[rms]
rms[θ_,f_,pol_]:=If[pol==1,((μs km[θ,f]- μm[f] ks[θ])/(μs km[θ,f]+μm[f] ks[θ])),((ϵs km[θ,f]-ϵm[f] ks[θ])/(ϵs km[θ,f]+ϵm[f] ks[θ]))]

Reflectance due to two interfaces

(Subscript[R, cgs])=(((Subscript[r, cg])(θ)+(Subscript[r, gs])(θ)(e^(i 2k (Subscript[k, g])(θ) (Subscript[d, g]))) )/(1+(Subscript[r, cg])(θ) (Subscript[r, gs])(θ) (e^(i 2 k (Subscript[k, g])(θ) (Subscript[d, g]))) ))

Clear[Rcms]
Rcms[dm_,θ_,f_,pol_]:=(rcm[θ,f,pol]+rms[θ,f,pol] (E^(I 2k[f] km[θ,f] dm)))/(1+rcm[θ,f,pol] rms[θ,f,pol] (E^(I 2k[f] km[θ,f] dm)))

Reflectance due to three interfaces

(Subscript[R, pcgs])=(((Subscript[r, pc])(θ)+(Subscript[R, cgs])((Subscript[d, g]),θ)(e^(i 2 k (Subscript[k, c])(θ) (Subscript[d, c]))) )/(1+(Subscript[R, cgs])((Subscript[d, g]),θ) (Subscript[r, pc])(θ)(e^(i 2 k (Subscript[k, c])(θ) (Subscript[d, c]))) ))

Clear[Rpcms]
Rpcms[dc_,dm_,θ_,f_,pol_]:=(rpc[θ,pol]+Rcms[dm,θ,f,pol] (E^(I 2k[f] kc[θ] dc)))/(1+rpc[θ,pol] Rcms[dm,θ,f,pol] (E^(I 2k[f] kc[θ] dc)))

Reflectivity due to three interfaces

Clear[ℛ]
ℛpcms[dc_,dm_,θ_,f_,pol_]:=((Abs[Rpcms[dc,dm,θ,f,pol]])^2)

Lorentzian angle and width in prism

(Subscript[θ, x])=Re[(sin^(-1))(β/(Subscript[n, p])) ]

Clear[θx]
θx[β_]:=Re[ArcSin[(β/((Sqrt[μp]) (Sqrt[ϵp])))]]

(Subscript[Γ, x])=Im[(sin^(-1))(β/(Subscript[n, p])) ]

Clear[Γx]
Γx[β_]:=Im[ArcSin[(β/((Sqrt[μp]) (Sqrt[ϵp])))]]

Lorentzian function

(Subscript[L, 0])=(1/π)(((Subscript[Γ, x])/2)/( (((θ-(Subscript[θ, x])))^2) +((((Subscript[Γ, x])/2))^2)))

Clear[L0]
L0[θ_,β_]:=(1/π)((Γx[β]/2)/((((θ-θx[β]))^2)+(((Γx[β]/2))^2)))

(Subscript[L, 1])=1-(((Subscript[L, 0])(θ))/((Subscript[L, 0])((Subscript[θ, x]))))

Clear[L1]
L1[θ_,β_]:=1-((L0[θ,β])/(L0[θx[β],β]))

Goos-Hänchen shift for prism-cover-guide-substrate structures

Goos-Hänchen shift for prism-cover structures for TE and TM modes

(Subscript[Δ, cg,TE])=(( tan((Subscript[θ, g])) )/(k (Sqrt[(β^2)-((Subscript[n, c])^2)]))).

(Subscript[Δ, pcTE])=(( tan((Subscript[θ, p])) )/(k (Sqrt[(β^2)-((Subscript[n, c])^2)]))).

(Subscript[Δ, cg,TM])=(2/(((β^2)/((Subscript[n, c])^2))+((β^2)/((Subscript[n, g])^2))-1))(( tan((Subscript[θ, g])) )/(k (Sqrt[(β^2)-((Subscript[n, c])^2)]))).

(Subscript[Δ, pc,TM])=(2/(((β^2)/((Subscript[n, c])^2))+((β^2)/((Subscript[n, p])^2))-1))(( tan((Subscript[θ, p])) )/(k (Sqrt[(β^2)-((Subscript[n, c])^2)]))).

s = TE = 1

p = TM = 2

Clear[Δpc,pol]
Δpc[dc_,dm_,θ_ ,f_,pol_]:=((2c)/(2π f ))((Tan[θ])/(Sqrt[(np^2) ((Sin[θ])^2)-(nc^2)]))If[pol==1,1,(1/((((np^2)((Sin[θ])^2))/(nc^2))+(((np^2)((Sin[θ])^2))/((nm[f])^2))-1))]

Clear[Δpc,pol]
Δpc[dc_,dm_,θ_ ,f_,pol_]:=(c/(2π f ))((Tan[θ])/(Sqrt[(np^2) ((Sin[θ])^2)-(nc^2)]))If[pol==1,1,(2/((((np^2)((Sin[θ])^2))/(nc^2))+(((np^2)((Sin[θ])^2))/((nm[f])^2))-1))]

Goos-Hänchen shift for cover-guide structures for TE and TM modes

Clear[Δcms,m]
Δcms[dc_,dm_,θ_ ,f_,pol_]:=(c/(2π f np Cos[θ]))((Tan[ArcSin[((np Sin[θ])/(nm[f]))]])/(Sqrt[(np^2) ((Sin[θ])^2)-(nc^2)]))If[pol==1,1,(1/((((np^2)((Sin[θ])^2))/(nc^2))+(((np^2)((Sin[θ])^2))/((nm[f])^2))-1))]

Goos-Hänchen shift for prism-cover-guide-substrate structures for TE and TM modes

(Subscript[Φ, pcgs])=arg((Subscript[R, pcgs]))

(Subscript[R, pcgs])=|(Subscript[R, pcgs])| (e^(Subscript[iϕ, pcgs]))

(Subscript[Δ, pcgs])(θ)=-((dΦ(θ))/(dk β(θ)))

k β(θ)=k (Subscript[n, p])sinθ

dk β(θ)=k (Subscript[n, p])cosθ dθ

(Subscript[Δ, pcgs])=-(1/(k (Subscript[n, p]) cosθ))((d (Subscript[Φ, pcgs])(θ))/(dθ))

Clear[Δpcms,dc,dm,θ,f,pol]
δθ=1 micro;
Δpcms[dc_,dm_,θ_ ,f_,pol_]:=-(c/(2π f np Cos[θ]))(1/(δθ))(Arg[Rpcms[dc,dm,θ+δθ,f,pol]]-Arg[Rpcms[dc,dm,θ,f,pol]])/.NSub

Prism coupling in the Otto configurations: Low loss

Parameters

Clear[ϵm,μm,nm]
ϵm[f_]:=ϵm1[f]/.caseLossy
μm[f_]:=μm1[f]/.caseLossy
nm[f_]:=nm1[f]/.caseLossy

ϵp=3.;μp=1.;np=(Sqrt[ϵp])(Sqrt[μp]);
ϵc=1.;μc=1.;nc=(Sqrt[ϵc])(Sqrt[μc]);
ϵs=1.;μs=1.;ns=(Sqrt[ϵs ])(Sqrt[ μs]);
θp=45.;
θc=180/π ArcSin[1/np];

Clear[θTM1,θTM2,θTE]
θTM1:=ArcSin[βTM[ffTM1]/np]
θTM2:=ArcSin[βTM[ffTM2]/np]
θTE:=ArcSin[βTE[ffTE]/np]

Clear[k]
k[f_]:=2π f/c/.NSub
kTM[f_]:=c/βTM[f]

Otto reflectivity as a function of  f and (Subscript[d, c]): TE mode

dm=1.;
dxx=50;

data=Flatten[Table[{f,dc,1-ℛpcms[dc milli,dm,45 π/180,f giga,1]},
{dc,3,30,27/dxx},
{f,4.9,5.2,.3/dxx}],
1];
Fig10a=
ListPlot3D[data,
PlotRange->{-.01,1.01},
ColorFunction->RGBColor[0,0,0],
AxesLabel->{"f (GHz)","(Subscript[d, c]) (mm)","(Subscript[𝒜, O]): TE  "},
ImageSize->is]

Otto reflectivity as a function of  f: TE mode

dc=12 milli;
fmin=4.95;
fmax=5.18;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,1],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTE[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfOttoTEa=Plot[{L1[45 π/180,βTE[f giga]],ℛpcms[dc,dm,45 π/180,f giga,1]},
{f,fmin,fmax},
LabelStyle->{FontSize -> fs},
PlotRange->{0,1},
FrameLabel->{"f (GHz)","(Subscript[ℛ, O])","TE mode",
StringJoin["(Subscript[d, c]) = ",ToString[dc/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,Rmin1}],
Text["●",{fx2,.02+Rmin2}]}]

dc=30 milli;
fmin=4.95;
fmax=5.18;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,1],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTE[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfOttoTEb=Plot[{L1[45 π/180,βTE[f giga]],ℛpcms[dc,dm,45 π/180,f giga,1]},
{f,fmin,fmax},
LabelStyle->{FontSize -> fs},
PlotRange->{0,1},
FrameLabel->{"f (GHz)","(Subscript[ℛ, O])","TE mode",
StringJoin["(Subscript[d, c]) = ",ToString[dc/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,Rmin1}],
Text["●",{fx2,.02+Rmin2}]}]

Fig10b=GraphicsRow[
{FigℛfOttoTEa,FigℛfOttoTEb},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Otto reflectivity and Goos-Hänchen shift as a function of θ : TE mode

dcx=20 milli;
FigℛθOttoTE=Plot[{
ℛpcms[.9dcx,dm,θx π/180,ffTE,1],
ℛpcms[dcx,dm,θx π/180,ffTE,1],
ℛpcms[1.49dcx,dm,θx π/180,ffTE,1]},
{θx,θc,60},
PlotRange->{0,1},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[ℛ, O])","TE mode",
StringJoin["f = ",ToString[ffTE/giga],"   GHz"]},
Evaluate[optX]]

dcx=20 milli;
FigΔθOttoTE=Plot[{
kilo Δpcms[.9dcx,dm,θx π/180,ffTE,1],
kilo Δpcms[dcx,dm,θx π/180,ffTE,1],
kilo Δpcms[1.49dcx,dm,θx π/180,ffTE,1]},
{θx,θc,60},
PlotRange->{0,100},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[Δ, O]) (mm)","TE mode",
StringJoin["f = ",ToString[ffTE/giga]," GHz"]},
Evaluate[optX]]

Fig10c=FigℛΔθOttoTE=GraphicsRow[
{FigℛθOttoTE,FigΔθOttoTE},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Otto reflectivity as a function of  f and (Subscript[d, c]): TM(1) mode

data=Flatten[Table[{f,dc,1-ℛpcms[dc milli,dm,45 π/180,f giga,2]},
{dc,20,80,60/dxx},
{f,3.4,3.7,.3/dxx}],
1];
Fig11a=
ListPlot3D[data,
PlotRange->{-.01,1.01},
ColorFunction->RGBColor[0,0,0],
AxesLabel->{"f (GHz)","(Subscript[d, c]) (mm)","(Subscript[𝒜, O]): TM(1) "},
ImageSize->is]

Otto reflectivity as a function of  f: TM(1) mode

dc=40 milli;
fmin=3.4;
fmax=3.7;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTM[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfOttoTM1a=Plot[{
L1[45 π/180,βTM[f giga]],
ℛpcms[dc,dm,45 π/180,f giga,2]
},
{f,fmin,fmax},
PlotRange->{0,1},
LabelStyle->{FontSize -> fs},
PlotRange->{-.01,1.01},
FrameLabel->{"f (GHz)","(Subscript[ℛ, O])","TM(1) mode",
StringJoin["(Subscript[d, c]) = ",ToString[dc/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,.02+Rmin1}],
Text["●",{fx2,.02+Rmin2}]}]

dc=70 milli;
fmin=3.4;
fmax=3.7;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTM[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfOttoTM1b=Plot[{
L1[45 π/180,βTM[f giga]],
ℛpcms[dc,dm,45 π/180,f giga,2]
},
{f,fmin,fmax},
PlotRange->{0,1},
LabelStyle->{FontSize -> fs},
FrameLabel->{"f [GHz]","(Subscript[ℛ, O])","TM(1) mode",
StringJoin["(Subscript[d, c]) = ",ToString[dc/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,Rmin1}],
Text["●",{fx2,.02+Rmin2}]}]

Fig11b=FigℛfOttoTM1=GraphicsRow[
{FigℛfOttoTM1a,FigℛfOttoTM1b},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Otto reflectivity and Goos-Hänchen shift as a function of θ: TM(1) mode

dcx=20 milli;
FigℛθOttoTM1=Plot[{
ℛpcms[.9dcx,dm,θx π/180,ffTM1,2],
ℛpcms[dcx,dm,θx π/180,ffTM1,2],
ℛpcms[1.49dcx,dm,θx π/180,ffTM1,2]},
{θx,θc,60},
PlotRange->{0,1},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[ℛ, O])","TM(1) mode",
StringJoin["f = ",ToString[ffTM1/giga]," GHz"]},
Evaluate[optX]]

FigΔθOttoTM1=Plot[Evaluate[{
Δpcms[.9dcx,dm,θx π/180,ffTM1,2],
Δpcms[dcx,dm,θx π/180,ffTM1,2],
Δpcms[1.49 dcx,dm,θx π/180,ffTM1,2]}],
{θx,θc,60},
PlotRange->{0,1.5},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[Δ, O]) (m)","TM(1) mode",
StringJoin["f = ",ToString[ffTM1/giga]," GHz"]},
Evaluate[optX]]

Fig11c=GraphicsRow[
{FigℛθOttoTM1,FigΔθOttoTM1},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Otto reflectivity as a function of  f: TM(2) mode

data=Flatten[Table[{f,dc,1-ℛpcms[dc milli,dm,45 π/180,f giga,2]},
{dc,15,50,35/dxx},
{f,5.8,6.3,.5/dxx}],
1];
Fig12a=
ListPlot3D[data,
PlotRange->{-.01,1.01},
ColorFunction->RGBColor[0,0,0],
AxesLabel->{"f (GHz)","(Subscript[d, c]) (mm)","(Subscript[𝒜, O]): TM(2) "},
ImageSize->is]

Otto reflectivity as a function of  f and (Subscript[d, c]): TM(2) mode

dc=25 milli;
fmin=5.8;
fmax=6.3;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTM[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

dc=25 milli;
FigℛfOttoTM2a=Plot[{
L1[45 π/180,βTM[f giga]],
ℛpcms[dc,dm,45 π/180,f giga,2]},
{f,5.8,6.3},
PlotRange->{0,1},
LabelStyle->{FontSize -> fs},
PlotRange->{-.01,1.01},
FrameLabel->{"f (GHz)","(Subscript[ℛ, O])","TM(2) mode",
StringJoin["(Subscript[d, c]) = ",ToString[dc/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,Rmin1}],
Text["●",{fx2,.02+Rmin2}]}]

dc=40 milli;
fmin=5.8;
fmax=6.3;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTM[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfOttoTM2b=Plot[{
L1[45 π/180,βTM[f giga]],
ℛpcms[dc,dm,45 π/180,f giga,2]},
{f,5.8,6.3},
LabelStyle->{FontSize -> fs},
PlotRange->{-.01,1.01},
FrameLabel->{"f (GHz)","(Subscript[ℛ, O])","TM(2) mode",
StringJoin["(Subscript[d, c]) = ",ToString[dc/milli]," mm"]},
Evaluate[optX],
ColorFunction->RGBColor[0,0,0],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,Rmin1}],
Text["●",{fx2,.02+Rmin2}]}]

Fig12b=FigℛfOttoTM2=GraphicsRow[
{FigℛfOttoTM2a,FigℛfOttoTM2b},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Otto reflectivity and Goos-Hänchen shift as a function of θ: TM(2) mode

dcx=20 milli;
FigℛθOttoTM2=Plot[{
ℛpcms[.9dcx,dm,θx π/180,ffTM2,2],
ℛpcms[dcx,dm,θx π/180,ffTM2,2],
ℛpcms[1.49dcx,dm,θx π/180,ffTM2,2]},
{θx,θc,60},
PlotRange->{0,1},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[ℛ, O])","TM(2) mode",
StringJoin["f = ",ToString[ffTM2/giga]," GHz"]},
Evaluate[optX]]

FigΔθOttoTM2=Plot[Evaluate[{
Δpcms[.9dcx,dm,θx π/180,ffTM2,2],
Δpcms[dcx,dm,θx π/180,ffTM2,2],
Δpcms[1.49 dcx,dm,θx π/180,ffTM2,2]}],
{θx,θc,60},
LabelStyle->{FontSize -> fs},
PlotRange->{-.5,2},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[Δ, O]) (m)","TM(2) mode",
StringJoin["f = ",ToString[ffTM2/giga]," GHz"]},
Evaluate[optX]]

Fig12c=FigℛΔθOttoTM2=GraphicsRow[
{FigℛθOttoTM2,FigΔθOttoTM2},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Prism coupling in the Kretschmann configuration: Low loss

Kretschmann reflectivity as a function of  f and (Subscript[d, m]): TE mode

dc=1 micro;

data=Flatten[Table[{f,dm,1-ℛpcms[dc,dm milli,45 π/180,f giga,1]},
{dm,20,50,30/dxx},
{f,5,5.2,.2/dxx}],
1];
Fig16a=
ListPlot3D[data,
PlotRange->{-.01,1.01},
ColorFunction->RGBColor[0,0,0],
AxesLabel->{"f (GHz)","(Subscript[d, m]) (mm)","(Subscript[𝒜, K]): TE "},
ImageSize->is]

Kretschmann reflectivity as a function of  f: TE mode

dm=25 milli;
fmin=5.;
fmax=5.2;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,1],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTE[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfKretschmannTEa=Plot[{
L1[45 π/180,βTE[f giga]],
ℛpcms[dc,dm,45 π/180,f giga,1]},
{f,5,5.2},
LabelStyle->{FontSize -> fs},
PlotRange->{0,1},
FrameLabel->{"f (GHz)","(Subscript[ℛ, K])","TE mode",
StringJoin["(Subscript[d, m]) = ",ToString[dm/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,.02+Rmin1}],
Text["●",{fx2,.02+Rmin2}]}]

dm=45 milli;
fmin=5.;
fmax=5.2;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,1],
{f,5.05,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=5.05+pos1 Δf;

TB2=Table[L1[45 π/180,βTE[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfKretschmannTEb=Plot[{
L1[45 π/180,βTE[f giga]],
ℛpcms[dc,dm,45 π/180,f giga,1]},
{f,fmin,fmax},
LabelStyle->{FontSize -> fs},
PlotRange->{-.01,1.01},
FrameLabel->{"f (GHz)","(Subscript[ℛ, K])","TE mode",
StringJoin["(Subscript[d, m]) = ",ToString[dm/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,.0+Rmin1}],
Text["●",{fx2,.02+Rmin2}]}]

Fig16b=FigℛfKretschmannTE=GraphicsRow[
{FigℛfKretschmannTEa,FigℛfKretschmannTEb},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Kretschmann reflectivity and Goos-Hänchen shift as a function of θ : TE mode

dm=27 milli;
FigℛθKretschmannTE=Plot[{
ℛpcms[dc,.9dm,θx π/180,ffTE,1],
ℛpcms[dc,dm,θx π/180,ffTE,1],
ℛpcms[dc,1.49dm,θx π/180,ffTE,1]},
{θx,θc,60},
PlotRange->{0,1},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[ℛ, K])","TE mode",
StringJoin["f = ",ToString[ffTE/giga]," GHz"]},
Evaluate[optX]]

dm=27 milli;
FigΔθKretschmannTE=Plot[Evaluate[{
Δpcms[dc,.9dm,θx π/180,ffTE,1],
Δpcms[dc,1.0dm,θx π/180,ffTE,1],
Δpcms[dc,1.49dm,θx π/180,ffTE,1]}],
{θx,1.01θc,60},
PlotRange->{-.2,.8},
LabelStyle->{FontSize -> fs},
PlotRange->All,
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[Δ, K]) (m)","TE mode",
StringJoin["f = ",ToString[ffTE/giga]," GHz"]},
Evaluate[optX]]

Fig16c=FigℛΔθKretschmannTE=GraphicsRow[
{FigℛθKretschmannTE,FigΔθKretschmannTE},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Kretschmann reflectivity as a function of  f and (Subscript[d, g]): TM(1) mode

data=Flatten[Table[{f,dm,1-ℛpcms[dc,dm milli,45 π/180,f giga,2]},
{dm,4,11,7/dxx},
{f,3.4,3.7,.3/dxx}],
1];
Fig17a=
ListPlot3D[data,
PlotRange->{-.01,1.01},
ColorFunction->RGBColor[0,0,0],
AxesLabel->{"f (GHz)","(Subscript[d, m]) (mm)","(Subscript[𝒜, K]): TM(1) "},
ImageSize->is]

Kretschmann reflectivity as a function of  f: TM(1) mode

dm=6 milli;
fmin=3.4;
fmax=3.7;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTM[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfKretschmannTM1a=Plot[{
L1[45 π/180,βTM[f giga]],
ℛpcms[dc,dm,45 π/180,f giga,2]},
{f,fmin,fmax},
LabelStyle->{FontSize -> fs},
PlotRange->{-.01,1.01},
FrameLabel->{"f (GHz)","(Subscript[ℛ, K])","TM(1) mode",
StringJoin["(Subscript[d, m]) = ",ToString[dm/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,.01+Rmin1}],
Text["●",{fx2,.01+Rmin2}]}]

dm=11 milli;
fmin=3.4;
fmax=3.7;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTM[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfKretschmannTM1b=Plot[{
L1[45 π/180,βTM[f giga]],
ℛpcms[dc,dm,45 π/180,f giga,2]},
{f,fmin,fmax},
LabelStyle->{FontSize -> fs},
PlotRange->{-.01,1.01},
FrameLabel->{"f (GHz)","(Subscript[ℛ, K])","TM(1) mode",
StringJoin["(Subscript[d, g]) = ",ToString[dm/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,.02+Rmin1}],
Text["●",{fx2,.02+Rmin2}]}]

Fig17b=FigℛfKretschmannTM1=GraphicsRow[
{FigℛfKretschmannTM1a,FigℛfKretschmannTM1b},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Kretschmann reflectivity and Goos-Hänchen shift as a function of θ : TM(1) mode

dm=5 milli;
FigℛθKretschmannTM1=Plot[{
ℛpcms[dc,.9dm,θx π/180,ffTM1,2],
ℛpcms[dc,dm,θx π/180,ffTM1,2],
ℛpcms[dc,1.49dm,θx π/180,ffTM1,2]},
{θx,θc,60},
LabelStyle->{FontSize -> fs},
PlotRange->{0,1},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[ℛ, K])","TM(1) mode",
StringJoin["f = ",ToString[ffTM1/giga]," GHz"]},
Evaluate[optX]]

dm=5 milli;
FigΔθKretschmannTM1=Plot[{
Δpcms[dc,.9dm,θx π/180,ffTM1,2],
Δpcms[dc,dm,θx π/180,ffTM1,2],
Δpcms[dc,1.49dm,θx π/180,ffTM1,2]},
{θx,1.01θc,60},
PlotRange->{-1,3},
PlotRange->All,
LabelStyle->{FontSize -> fs},FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[Δ, K]) (m)","TM(1) mode",
StringJoin["f = ",ToString[ffTM1/giga]," GHz"]},
Evaluate[optX]]

Fig17c=FigℛΔθKretschmannTM1=GraphicsRow[
{FigℛθKretschmannTM1,FigΔθKretschmannTM1},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Kretschmann reflectivity as a function of  f and (Subscript[d, g]): TM(2) mode

data=Flatten[Table[{f,dm,1-ℛpcms[dc,dm milli,45 π/180,f giga,2]},
{dm,10,30,20/dxx},
{f,5.8,6.3,.5/dxx}],
1];
Fig18a=
ListPlot3D[data,
PlotRange->{-.01,1.01},
ColorFunction->RGBColor[0,0,0],
AxesLabel->{"f (GHz)","(Subscript[d, m]) (mm)","(Subscript[𝒜, K]): TM(2) "},
ImageSize->is]

Kretschmann reflectivity as a function of  f: TM(2) mode

dm=15 milli;
fmin=5.8;
fmax=6.3;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTM[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

dm=15 milli;
FigℛfKretschmannTM2a=Plot[{
L1[45 π/180,βTM[f giga]],
ℛpcms[micro,dm,45 π/180,f giga,2]},
{f,fmin,fmax},
LabelStyle->{FontSize -> fs},
PlotRange->{-.01,1.01},
FrameLabel->{"f (GHz)","(Subscript[ℛ, K])","TM(2) mode",
StringJoin["(Subscript[d, m]) = ",ToString[dm/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,.02+Rmin1}],
Text["●",{fx2,.02+Rmin2}]}]

dm=25 milli;
fmin=5.8;
fmax=6.3;
Δf=0.001;

TB1=Table[ℛpcms[dc,dm,45 π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

TB2=Table[L1[45 π/180,βTM[f giga]],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfKretschmannTM2b=Plot[{
L1[45 π/180,βTM[f giga]],
ℛpcms[micro,dm,45 π/180,f giga,2]},
{f,fmin,fmax},
PlotRange->{-.01,1.01},
LabelStyle->{FontSize -> fs},
FrameLabel->{"f [GHz]","(Subscript[ℛ, K])","TM(2) mode",
StringJoin["(Subscript[d, m]) = ",ToString[dm/milli]," mm"]},
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text["●",{fx1,.01+Rmin1}],
Text["●",{fx2,.01+Rmin2}]}]

Fig18b=FigℛfKretschmannTM2=GraphicsRow[
{FigℛfKretschmannTM2a,FigℛfKretschmannTM2b},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Kretschmann reflectivity and Goos-Hänchen shift as a function of θ : TM(2) mode

dm=10 milli;
FigℛθKretschmannTM2=Plot[{
ℛpcms[dc,.9dm,θx π/180,ffTM2,2],
ℛpcms[dc,dm,θx π/180,ffTM2,2],
ℛpcms[dc,1.49dm,θx π/180,ffTM2,2]},
{θx,θc,60},
PlotRange->{0,1},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[ℛ, K])","TM(2) mode",
StringJoin["f = ",ToString[ffTM2/giga]," GHz"]},
Evaluate[optX]]

dm=10 milli;
FigΔθKretschmannTM2=Plot[{
Δpcms[dc,.9dm,θx π/180,ffTM2,2],
Δpcms[dc,dm,θx π/180,ffTM2,2],
Δpcms[dc,1.49dm,θx π/180,ffTM2,2]},
{θx,1.1θc,60},
PlotRange->{-.7,.7},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[Δ, K]) (m)","TM(2) mode",
StringJoin["f = ",ToString[ffTM2/giga]," GHz"]},
Evaluate[optX]]

Fig18c=FigℛΔθKretschmannTM2=GraphicsRow[
{FigℛθKretschmannTM2,FigΔθKretschmannTM2},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Prism coupling in the Otto configuration: High loss

Parameters

Clear[ϵm,μm,nm]
ϵm[f_]:=ϵm1[f]/.caseLossy1
μm[f_]:=μm1[f]/.caseLossy1
nm[f_]:=nm1[f]/.caseLossy1

Clear[k]
k[f_]:=2π f/c/.NSub

Otto reflectivity as a function of f: Ruppin's example for the TE mode

θp=60;
dc=0.01;
dm=1;

fmin=4.5;
fmax=5.5;
TB1=Table[ℛpcms[dc,dm,θp π/180,f giga,1],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

fmin=4;
fmax=4.5;
TB2=Table[ℛpcms[dc,dm,θp π/180,f giga,1],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfOttoRuppinTE=Plot[{
ℛpcms[dc,dm,θp π/180,f giga,1]},
{f,2,8},
PlotRange->{-.01,1.01},
LabelStyle->{FontSize -> fs},
FrameLabel->{"f (GHz)","(Subscript[ℛ, O])","s-polarization",
StringJoin["(Subscript[d, c]) = ",ToString[dc/milli]," mm"]},
Evaluate[optX],
Epilog->{RGBColor[0,0,0],
Text[Style[
StringJoin["(Subscript[θ, p]) = ",ToString[θp]," deg"],fs],{6.5,0.1}],
Text["●",{fx1,Rmin1}],
Text[Style["TE",fs],{fx1+.5,Rmin1}],
Text["●",{fx2,Rmin2}],
Text[Style["Bulk",fs],{fx2,Rmin2-.1}]}]

Otto reflectivity as a function of f: Ruppin example for the TM modes

θp=45;
dc=0.03;
dm=1;

fmin=3;
fmax=4;
TB1=Table[ℛpcms[dc,dm,θp π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

fmin=5;
fmax=7;
TB2=Table[ℛpcms[dc,dm,θp π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfOttoRuppinTM=Plot[{
ℛpcms[dc,dm,θp π/180,f giga,2]},
{f,2,8},
LabelStyle->{FontSize -> fs},
PlotRange->{-.01,1.01},
FrameLabel->{"f (GHz)","(Subscript[ℛ, O])","TM mode",
StringJoin["(Subscript[d, c]) = ",ToString[dc/milli]," mm"]},
Evaluate[optX],
Epilog->{RGBColor[0,0,0],
Text[Style[
StringJoin["(Subscript[θ, p]) = ",ToString[θp]," deg"],fs],{6.5,0.1}],
Text["●",{.0+fx1,Rmin1}],
Text[Style["TM(1)",fs],{fx1-.9,Rmin1+.05}],
Text["●",{.0+fx2,Rmin2}],
Text[Style["TM(2)",fs],{fx2,Rmin2-.1}]}]

Otto reflectivity as a function of f: Ruppin example for the TE, and TM modes

Fig13=FigℛfθOttoRuppinTETM=GraphicsRow[
{FigℛfOttoRuppinTE,FigℛfOttoRuppinTM},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Prism coupling in the Kretschmann configuration: High loss

Parameters

Clear[ϵm,μm,nm]
ϵm[f_]:=ϵm1[f]/.caseLossy1
μm[f_]:=μm1[f]/.caseLossy1
nm[f_]:=nm1[f]/.caseLossy1

Clear[k]
k[f_]:=2π f/c/.NSub

Kretschmann reflectivity as a function of f: Ruppin's example for the TE mode

θp=60;
dc=micro;
dm=5 milli;

fmin=4.5;
fmax=5.5;
TB1=Table[ℛpcms[dc,dm,θp π/180,f giga,1],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

fmin=4;
fmax=4.5;
TB2=Table[ℛpcms[dc,dm,θp π/180,f giga,1],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

FigℛfKRuppinTE=Plot[{
ℛpcms[dc,dm,θp π/180,f giga,1]},
{f,2,8},
PlotRange->{-.01,1.01},
LabelStyle->{FontSize -> fs},
FrameLabel->{"f (GHz)","(Subscript[ℛ, K])","TE mode",
StringJoin["(Subscript[d, m]) = ",ToString[dm/milli]," mm"]},
Evaluate[optX],
Epilog->{RGBColor[0,0,0],
Text[
Style[StringJoin["(Subscript[θ, p]) = ",ToString[θp]," deg"],fs],{5,0.9}],
Text["●",{fx1+.05,Rmin1}],
Text[Style["TE",fs],{fx1+1,Rmin1+.05}],
Text["●",{fx2+.075,Rmin2}],
Text[Style["Bulk",fs],{fx2-1,Rmin2}]}]

Kretschmann reflectivity as a function of f: Ruppin example for the TM modes

θp=45;
dc=micro;
dm=5 milli;

fmin=3;
fmax=4;
TB1=Table[ℛpcms[dc,dm,θp π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin1=Min[TB1];
pos1=Position[TB1,Rmin1][[1,1]];
fx1=fmin+pos1 Δf;

fmin=5;
fmax=7;
TB2=Table[ℛpcms[dc,dm,θp π/180,f giga,2],
{f,fmin,fmax,Δf}];
Rmin2=Min[TB2];
pos2=Position[TB2,Rmin2][[1,1]];
fx2=fmin+pos2 Δf;

fmin=4;
fmax=4.5;
TB3=Table[ℛpcms[dc,dm,θp π/180,f giga,1],
{f,fmin,fmax,Δf}];
Rmin3=Min[TB3];
pos3=Position[TB3,Rmin3][[1,1]];
fx3=fmin+pos3 Δf;

FigℛfKRuppinTM=Plot[{
ℛpcms[dc,dm,θp π/180,f giga,2]},
{f,2,8},
LabelStyle->{FontSize -> fs},
PlotRange->{-.01,1.01},
FrameLabel->{"f (GHz)","(Subscript[ℛ, K])","TM mode",
StringJoin["(Subscript[d, m]) = ",ToString[dm/milli]," mm"]},
Evaluate[optX],
Epilog->{RGBColor[0,0,0],
Text[
Style[StringJoin["(Subscript[θ, p]) = ",ToString[θp]," deg"],fs],{5,0.9}],
Text["●",{.01+fx1,Rmin1}],
Text[Style["TM(1)",fs],{fx1-.9,.03+Rmin1}],
Text["●",{.0+fx2,Rmin2}],
Text[Style["TM(2)",fs],{fx2,Rmin2-.12}],
Text["●",{-.01+fx3,Rmin3}],
Text[Style["Bulk",fs],{fx3+.6,Rmin3+.01}]}]

Kretschmann reflectivity as a function of f: Ruppin example for the TE, and TM modes

Fig19=FigℛfKRuppinTETM=GraphicsRow[
{FigℛfKRuppinTE,FigℛfKRuppinTM},
ImageSize->1.2gr,
Frame->True,
Spacings->-50]

Analysis of Goos Hanchen shift

Clear[ϵm,μm,nm]
ϵm[f_]:=ϵm1[f]/.caseLossy
μm[f_]:=μm1[f]/.caseLossy
nm[f_]:=nm1[f]/.caseLossy

Fig14=FigΔθOttoTE1=Plot[{

 Δpcms[5 milli,1000,θx π/180,ffTE,1],
Δpcms[10 milli,1000,θx π/180,ffTE,1],
 Δpcms[1000,1000,θx π/180,ffTE,1]},
{θx,θc+1,60},
PlotRange->All,
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[Δ, O]) (m)","TE mode",
StringJoin["f = ",ToString[ffTE/giga]," GHz"]},
Evaluate[optX]]

Fig20=FigΔθOttoTE2=Plot[{
Δpcms[micro,20 milli,θx π/180,ffTE,1],
Δpcms[micro,30 milli,θx π/180,ffTE,1],
Δpcms[micro,1000,θx π/180,ffTE,1]},
{θx,θc+1,60},
PlotRange->All,
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[θ, p]) (deg)","(Subscript[Δ, K]) (m)","TE mode",
StringJoin["f = ",ToString[ffTE/giga]," GHz"]},
Evaluate[optX]]

Tables

TableAll

Table1=TableChapter3

Table2

Table3

Table4

Table5

Table6

Table7

Table8

Figures

Fig1

Fig2

Fig3

Fig4

Fig6

Fig7

Fig10a

Fig10b

Fig10c

Fig11a

Fig11b

Fig11c

Fig12a

Fig12b

Fig12c

Fig13

Fig14

Fig16a

Fig16b

Fig16c

Fig17a

Fig17b

Fig17c

Fig18a

Fig18b

Fig18c

Fig19

Fig20

Exercises

(1) Table 3.1 includes only a partial list of the topics included in Table 2.2. Try addressing all the rest of the topics using the model metamaterial of this chapter. 
(2) Discuss the meaning of charge density waves in a DNG-type medium.
(3) Compare the advantages and disadvantages of using the Otto and Kretschmann configurations.

References

[1] V. Veselago, L. Braginsky, V. Shklover and C. Hafner.  Negative refractive index materials. J. Comput. Theor. Nanosci. 3 (2006) 2.
[2] J. B. Pendry and D. R. Smith.  Reversing light with negative refraction.  Phys. Today 57 June (2004).
[3] V. M. Agranovich, Y. R. Shen, R. H. Baughman and A. a. Zakhidov.  Linear and nonlinear wave propagation in negative refraction metamaterials. Phys. Rev. B 69 (2004) 165112.
[4] G. Dolling, C. Enkrich, M. Wegener, C. M. Soukoulis and S. Linden.  Simultaneous negative phase and group velocity of light in a metamaterial.  Science 312 (2006) 892.
[5] H. Raether.  Surface Plasmons on Smooth and Rough Surfaces and on Gratings (Springer Tracts in Modern Physics, Vol. 111, New York, Springer-Verlag, 1988).
[6] R. Ruppin.  Surface polaritons of a left-handed medium.  Phys. Lett. 277 (2000) 61.
[7] H. –F. Zhang, Q. Wang, N. –H. Shen, R. Li, J. Chen, J. Ding and H. –T. Wang.  Surface plasmon polaritons at interfaces associated with artificial composite materials.  J. Opt. Soc. Am. B 22 (2005) 12.
[8] T. Tamir Ed.  Integrated Optics (Topics in Applied Physics) (Springer-Verlag, 1975).
[9] I. V. Shadrivov, A. A. Zharov and Y. S. Kivshar.  Giant Goos-Hänchen effect at the reflection from left-handed metamaterials.  Appl. Phys. Lett. 83 (2003) 13.
[10] M. Merano, A. Aiello, G. W. ‘t Hooft, M. P. van Exter, E. R. Eliel and J. P. Woerdman.  Observation of Goos- Hänchen shifts in metallic reflection.  Opt. Exp. 15 (2007) 24.
[11] I. V. Lindell, S. A. Tretyakov, K. I. Nikoskinen and S. Ilvonen.  BW media – media with negative parameters, capable of supporting backward waves.  Micr. and Opt. Tech. Lett. 31 (2001) 2.
[12] D. F. Nelson.  Generalizing the poynting vector.  Phys. Rev. Lett. 76 (1996) 25.
[13] J. Wuenschell and H. K. Kim.  Surface plasmon dynamics in an isolated metallic nanoslit.  Optics Express 14 (2006) 1000.