6
Single-interface surface plasmons

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. 9:
Fig9=FigEAbs=GraphicsRow[
{FigExAbs,FigEzAbs},
  Frame -> True,
 Spacings -> -20,
 ImageSize ->1.1gr]
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}]

Wave-vectors, Fields, Poynting Vectors and Charges

Parameters

μp=1.;ϵp=(2.5^2);np=(Sqrt[μp]) (Sqrt[ϵp]);
μc=1.0;ϵc=(1.5^2);nc=(Sqrt[μc]) (Sqrt[ϵc]);
μm=1.;ϵm=-15.9958+.52I;nm=(Sqrt[μm]) (Sqrt[ϵm]);
μs=1.0;ϵs=(1.5^2);ns=(Sqrt[μs]) (Sqrt[ϵs]);
λ=.6328 micro;
k=2π/λ;ω=2π c/λ/.NSub;

β=((Sqrt[μc ϵc ((ϵm)^2)-μm ϵm ((ϵc)^2)])/(Sqrt[((ϵm)^2)-((ϵc)^2)]));
βair=((Sqrt[ ((ϵm)^2)-ϵm])/(Sqrt[((ϵm)^2)-1]));
θc= ArcSin[(((Sqrt[μc])(Sqrt[ϵc]))/((Sqrt[μp])(Sqrt[ϵp])))];

Solution in parameter space

rm:=(Sqrt[((Re[μm])^2)+((Re[ϵm])^2)])
rc:=(Sqrt[((Re[μc])^2)+((Re[ϵc])^2)])
ϕm:=ArcCos[Re[ϵm]/rm]
ϕc:=ArcCos[Re[ϵc]/rc]

Table2=Grid[{
{"","(Subscript[ϵ, i])","(Subscript[μ, i])","(Subscript[n, i])","(Subscript[r, i])","(Subscript[ϕ, i])"},
{"Prism",ϵp,μp,np,"",""},
{"Cover",ϵc,μc,nc,rc,ϕc},
{"Silver",ϵm,μm,nm,rm,ϕm},
{"Substrate",ϵs,μs,ns,rc,ϕc}},
Dividers->All,
ItemStyle->{fs,fs}]

Fig3=FigTypeB1["(Subscript[ϕ, m])","(Subscript[ϕ, c])",rm,rc,ϕm,ϕc][[2]]

Clear[βTMx]
βTMx[μmx_,ϵmx_]:=((Sqrt[μc ϵc ((ϵmx)^2)-μmx ϵmx ((ϵc)^2)])/(Sqrt[((ϵmx)^2)-((ϵc)^2)]))

Fig4a=FigϵTMa=Plot[{
Re[βTMx[μm, ϵ+.5 I ]],
Re[βTMx[μm, ϵ+1 I ]],
Re[βTMx[μm, ϵ+2I ]]},
{ϵ,-20,-1.15},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[ϵ, m])'","β'"},
ImageSize->.8is,
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],Text[
"●",{Re[ϵm],Re[βTMx[μm,ϵm]]}]}]

Fig4b=FigϵTMb=Plot[{
Im[βTMx[μm, ϵ+.5 I ]],
Im[βTMx[μm, ϵ+1 I ]],
Im[βTMx[μm, ϵ+2I ]]},
{ϵ,-20,-1.15},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[ϵ, m])'","β''"},
ImageSize->.8 is,
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],Text[
"●",{Re[ϵm],Im[βTMx[μm,ϵm]]}]}]

Fig4=GraphicsRow[
  {Fig4a, Fig4b},
  Frame -> True,
 Spacings -> -20,
 ImageSize ->1.1gr]

Clear[βTMx]
βTMx[μmx_,ϵmx_]:=Re[((Sqrt[μc ϵc ((ϵmx)^2)-μmx ϵmx ((ϵc)^2)])/(Sqrt[((ϵmx)^2)-((ϵc)^2)]))]

Fig5=ContourPlot[Evaluate[If[
Re[βTMx[μmx,ϵmx]]>(Sqrt[μc ϵc])&&
Abs[ϵmx]>2(Sqrt[μc ϵc])&&
Re[βTMx[μmx,ϵmx]]<(Sqrt[μp ϵp]),1,0],
{ϵmx,-20,20},
{μmx,-20,20},
ColorFunction->(Opacity[.2-#]&),
ImageSize->1.1is,
PlotPoints->2 30,
LabelStyle->{FontSize -> fs},FrameLabel->{"(Subscript[ϵ, m])'","(Subscript[μ, m])'","",""}],
Epilog->{
RGBColor[0,0,0],
Text[
"●",{Re[ϵm],Re[μm]}],
Text[
Style[StringJoin["β'=",ToString[Re[β]],""],fs1],{0,12}]},
Contours->10]

Wave vectors

Otto geometry, δ is in the cover and γ is in the metal

Clear[δ,γ]
δ[β_]:=(Sqrt[(β^2)-μc ϵc])
γ[β_]:=(Sqrt[(β^2)-μm ϵm])

Table3=Grid[{
{"β",β},
{"δ",δ[β]},
{"γ",γ[β]}},
Dividers->All,
ItemStyle->{fs,fs}]

1/e propagation distance

F=(e^(i k β'z))(e^(-k β''z))

ζ=(1/(k β''))

(Subscript[n, ζ])=(Γ/(λ/β'))=((β')/(k β''))

(Subscript[v, ζ])=(ω/(k β'))

(Subscript[τ, ξ])=(Γ/(Subscript[v, ξ]))=(1/(k β''))/(ω/(k β'))=(1/ω)((β')/(β''))

ζpw:=(1/(k Im[nm]))
npw:=((ζpw)/(λ/Re[nm]))
vpw:=(ω/(k Re[nm]))
τpw:=((ζpw)/vpw)
ζsp:=(1/(k Im[β]))
nsp:=((ζsp)/(λ/Re[β]))
vsp:=(ω/(k Re[β]))
τsp:=((ζsp)/vsp)
ζspair:=(1/(k Im[βair]))
nspair:=((ζspair)/(λ/Re[βair]))
vspair:=(ω/(k Re[β]))
τspair:=((ζspair)/vspair)

Table4=Grid[{
{"","System","ζ (μm)","(Subscript[N, ζ ])(cycles)","(Subscript[τ, ζ]) (fs)"},
{"(a) PW","silver",mega ζpw,npw,τpw/femto},
{"(b) SP","glass/silver",mega ζsp,nsp,τsp/femto},
{"(c) SP","air/silver",mega ζspair,nspair,τspair/femto}},Dividers->All,
ItemStyle->{fs,fs}]

Fields: Not normalized

Hy0

Clear[Hy0]
Hy0[x_]:=Which[
x≥0,(E^( -k δ[β] x)),
x<0,(E^(k γ[β]x))]

Ex0

Clear[Ex0]
Ex0[x_]:=(( k β)/(ω ϵ0))Which[
x≥0,(1/(ϵc))(E^(-k δ[β] x)),
x<0,(1/(ϵm))(E^(k γ[β]x))]/.NSub

Ez0

Clear[Ez0]
Ez0[x_]:=(( I k)/(ω ϵ0))Which[
x≥0,-((δ[β])/(ϵc))(E^(- k δ[β] x)),
x<0,((γ[β])/(ϵm))(E^(k γ[β] x))]/.NSub

Normalization

Poynting vector normalization

B0=1/(Sqrt[Re[(∫_(-milli)^milli).5Ex0[x]Conjugate[Hy0[x]]\[DifferentialD]x]])/.NSub

Fields: Normalized

Hy0

Clear[Hy,Hy]
Hy[x_]:=B0 Hy0[x]

Ex0

Clear[Ex,Exup]
Ex[x_]:=B0 Ex0[x]

Ez0

Clear[Ez]
Ez[x_]:=B0 Ez0[x]

Hy

FigHyRe

dd=milli;
xmin=-200;xmax=600;
maxmin=Re[Hy[1 nano]]dd;
FigHyRe=Plot[Re[Hy[x nano]]dd ,
{x,xmin,xmax},
LabelStyle->{FontSize -> fs},
FrameLabel->{"x (nm)","(Subscript[H, y])' ((10^3) A/m)","",""},
PlotRange->1.2 maxmin,
Filling -> Axis,
FillingStyle ->  Opacity[0.2],
ImageSize->.8 is,
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[
StringJoin["cover",ToString[""]],{xmax/2,-.150}],
Text[
StringJoin["metal",ToString[""]],{xmin/2,-.150}]}]

FigHyIm

dd=1;
xmin=-200;xmax=600;
maxmin=Im[Hy[200 nano]]dd;
FigHyIm=Plot[Im[Hy[x nano]]dd ,
{x,xmin,xmax},
LabelStyle->{FontSize -> fs},
FrameLabel->{"x (nm)","(Subscript[H, y])'' (A/m)","",""},
PlotRange->{-1.1maxmin,1.1maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
ImageSize->.8 is,
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[
StringJoin["cover",ToString[""]],{xmax/2,-1.5}],
Text[
StringJoin["metal",ToString[""]],{xmin/2,-1.5}]}]

FigHy

Fig6=GraphicsRow[
  {FigHyRe, FigHyIm},
  Frame -> True,
 Spacings -> -20,
 ImageSize ->1.1gr]

Ex

FigExRe

dd=milli;
xmin=-200;xmax=600;
maxmin=Re[Ex[1 nano]]dd;
FigExRe=Plot[Re[Ex[x nano]]dd ,{x,xmin,xmax},
LabelStyle->{FontSize -> fs},
FrameLabel->{"x (nm)","(Subscript[E, x])' ((10^3) V/m)","",""},
PlotRange->{-1.1maxmin,1.1maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
ImageSize->.8 is,
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[
StringJoin["cover",ToString[""]],{xmax/2,-25}],
Text[
StringJoin["metal",ToString[""]],{xmin/2,-25}]}]

FigExIm

dd=milli;
xmin=-200;xmax=600;

maxmin=Im[Ex[200 nano]]dd;
FigExIm=Plot[Im[Ex[x nano]]dd ,{x,xmin,xmax},
LabelStyle->{FontSize -> fs},
FrameLabel->{"x (nm)","(Subscript[E, x])'' ((10^3) V/m)","",""},
PlotRange->1.1maxmin,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
ImageSize->.8 is,
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[
StringJoin["cover",ToString[""]],{xmax/2,.25}],
Text[
StringJoin["metal",ToString[""]],{xmin/2,.25}]}]

FigEx

Fig7=FigEx=GraphicsRow[
{FigExRe,FigExIm},
Frame->True,
Spacings ->-20,
ImageSize->1.1gr]

Ez

FigEzRe

dd=milli;
xmin=-200;xmax=600;
maxmin=Re[Ez[0 nano]]dd;
FigEzRe=Plot[Re[Ez[x nano]]dd ,
{x,xmin,xmax},
LabelStyle->{FontSize -> fs},
FrameLabel->{"x (nm)","(Subscript[E, z])' ((10^3) V/m)","",""},ImageSize->is,
PlotRange->{-1.1maxmin,1.1maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
ImageSize->.8 is,
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[
StringJoin["cover",ToString[""]],{xmax/2,-.3}],
Text[
StringJoin["metal",ToString[""]],{xmin/2,-.3}]}]

FigEzIm

dd=milli;
xmin=-200;xmax=600;
maxmin=-Im[Ez[0 nano]]dd;
FigEzIm=Plot[Im[Ez[x nano]]dd ,
{x,xmin,xmax},
LabelStyle->{FontSize -> fs},
FrameLabel->{"x (nm)","(Subscript[E, z])'' ((10^3) V/m)","",""},ImageSize->is,
PlotRange->{-1.1maxmin,1.1maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
ImageSize->.8 is,
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[
StringJoin["cover",ToString[""]],{xmax/2,5}],
Text[
StringJoin["metal",ToString[""]],{xmin/2,5}]}]

FigEz

Fig8=FigEz=GraphicsRow[
{FigEzRe,FigEzIm},
Frame ->True,
 Spacings ->-20,
 ImageSize ->1.1gr]

|Ex|, |Ez|

FigExAbs

dd=milli;
xmin=-200;xmax=600;
maxmin=Abs[Ex[1 nano]]dd;
FigExAbs=Plot[Abs[Ex[x nano]]dd ,
{x,xmin,xmax},
LabelStyle->{FontSize -> fs},
FrameLabel->{"x (nm)","|(Subscript[E, x])| ((10^3) V/m)","",""},
PlotRange->{0,100},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
ImageSize-> is,
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[
StringJoin["cover",ToString[""]],{xmax/2,50}],
Text[
StringJoin["metal",ToString[""]],{xmin/2,50}]}]

FigEzAbs

dd=milli;
xmin=-200;xmax=600;
maxmin=Abs[Ez[0 nano]]dd;
FigEzAbs=Plot[Abs[Ez[x nano]]dd ,
{x,xmin,xmax},
LabelStyle->{FontSize -> fs},
FrameLabel->{"x (nm)","|(Subscript[E, z])| ((10^3) V/m)","",""},ImageSize->is,PlotRange->{0,100},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
ImageSize->is,
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[
StringJoin["cover",ToString[""]],{xmax/2,50}],
Text[
StringJoin["metal",ToString[""]],{xmin/2,50}]}]

FigEAbs

Fig9=FigEAbs=GraphicsRow[
{FigExAbs,FigEzAbs},
  Frame -> True,
 Spacings -> -20,
 ImageSize ->1.1gr]

Impedence (Subscript[η, TM])

ηc=k β/(ω ϵ0 ϵc)/.NSub;
ηm=k β/(ω ϵ0 ϵm)/.NSub;
ηc0=k nc/(ω ϵ0 ϵc)/.NSub;
ηm0=k nm/(ω ϵ0 ϵm)/.NSub;
η0=(Sqrt[μ0/ϵ0])/.NSub;
Table5=Grid[{
{"","(Subscript[η, i])/(Subscript[η, 0])","(Subscript[η, SP,i])/(Subscript[η, 0])"},
{"Cover",ηc0/η0,ηc/η0},
{"Metal",ηm0/η0,ηm/η0}},
Dividers->All,
ItemStyle->{fs,fs}]

Poynting vector fields

sz

Clear[sz]
sz[x_]:=(1/2)Re[Ex[x] Conjugate[Hy[x]]]

sx

Clear[sx]
sx[x_]:=-(1/2)Re[Ez[x] Conjugate[Hy[x]]]

dd=micro;
xmin=-300;xmax=100;
maxmin=sz[0 nano]dd;
Figsz1=Plot[Re[sz[-x nano]]dd ,
{x,xmin,xmax},
LabelStyle->{FontSize -> fs},
FrameLabel->{"x (nm)","(Subscript[s, z]) ((10^6) V/A)","",""},PlotRange->{-1.1maxmin,1.1maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[
StringJoin["cover",ToString[""]],{xmin/2,-2.5}],
Text[
StringJoin["metal",ToString[""]],{xmax/2,-2.5}]}]

dd=micro;
xmin=-100;xmax=300;
maxmin=sz[0 nano]dd;
Figsz2=Plot[Re[sz[x nano]]dd ,
{x,xmin,xmax},
LabelStyle->{FontSize -> fs},
FrameLabel->{"x (nm)","(Subscript[s, z]) ((10^6) V/A)","",""},PlotRange->{-1.1maxmin,1.1maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[
StringJoin["substrate",ToString[""]],{xmax/2,-2.5}],
Text[
StringJoin["metal",ToString[""]],{xmin/2,-2.5}]}]

Fig11=GraphicsRow[
{Figsz1,Figsz2},
 Frame -> True,
 Spacings ->-20,
 ImageSize ->1.1gr]

Integrated Poynting vectors

Scz

Scz:=NIntegrate[sz[x],{x,0,micro}]

Smz

Smz:=NIntegrate[sz[x],{x,-micro,0}]

Sz

Sz:=Round[NIntegrate[sz[x],{x,-micro,micro}]]

Table6=Grid[{
{"(Subscript[P, m,z])","(Subscript[P, c,z])","(Subscript[P, z])"}/.NSub,
{Smz,Scz,Sz}}/.NSub,
Dividers->All,
ItemStyle->{fs,fs}]

Scx

Scx=sx[0](1/(2k Im[β]));

The fields as phasors

tblθE

Table7=Grid[{
{"","E ((10^3) V/m)","|E| ((10^3) V/m)","(Subscript[θ, E]) (deg)"},
{"(Subscript[E, x])",milli Ex[x],milli Abs[Ex[x]],180/π ArcTan[Re[Ex[x]],Im[Ex[x]]]},
{"(Subscript[E, z])",milli Ez[x],milli Abs[Ez[x]],180/π ArcTan[Re[Ez[x]],Im[Ez[x]]]}},
Dividers->All,
ItemStyle->{fs,fs}]/.x->-pico//Chop

The phases

Clear[θEx]
θEx[x_]:=Re[ArcTan[Im[Ex[x]]/Re[Ex[x]]]]

Clear[θEx]
θEx[x_]:=Re[ArcTan[Re[Ex[x]],Im[Ex[x]]]]

Clear[θEz]
θEz[x_]:=Re[ArcTan[Im[Ez[x]]/Re[Ez[x]]]]

Clear[θEz]
θEz[x_]:=Re[ArcTan[Re[Ez[x]],Im[Ez[x]]]]

The phasors at x = 0+

tblExzx=Table[milli Abs[Ex[x micro]](1+ Cos[θEx[x micro]+k Re[β] z micro]),{x,0,.5,.01},{z,0,1,.02}];
FigExzx=ListContourPlot[
tblExzx,
LabelStyle->{FontSize -> fs},FrameLabel->{"z (20 nm)","x (20 nm)","(Subscript[E, x])",""},ImageSize->is]

tblEzzx=Table[milli Abs[Ez[x micro]] (1+Cos[θEz[x micro]+k Re[β] z micro]),{x,0,0.5`,0.01`},{z,0,1,0.02`}];
FigEzzx=ListContourPlot[
tblEzzx,
LabelStyle->{FontSize -> fs},FrameLabel->{"z (20 nm)","x (20 nm)","(Subscript[E, z])",""},ImageSize->is]

Fig12=FigExEzzx=GraphicsRow[
{FigExzx,FigEzzx},
Frame -> True,
 Spacings -> -100, 
ImageSize ->1.1gr]

Vector field

xmin=-.1;xmax=.2;
zmin=0;zmax=.4;
Fig13=FigVectorField=VectorPlot[{
3 Abs[Ez[x micro]] Cos[θEz[x micro]+k Re[β] z micro],
Abs[Ex[x micro]] Cos[θEx[x micro]+k Re[β] z micro]},
{z, zmin, zmax}, {x, xmin, xmax},
VectorPoints->20,
ImageSize->1.2is,
VectorStyle->Arrowheads[.02],
VectorScale->.03,
VectorColorFunction->Hue,
PlotRange->All,
LabelStyle->{FontSize -> fs},
FrameLabel->{"z (μm)","x (μm)",""},
Epilog->{
RGBColor[1,0,0],Text["●",{0,0}],
RGBColor[0,0,0],Text["●",{.192,0}],
RGBColor[1,0,0],Text["●",{2 .192,0}],
RGBColor[0,0,0],Text["Cover",{.192,.05}],
RGBColor[0,0,0],Text["Metal",{.192,-.05}]}]

Charge density in metal

The number of charges

The field is given in V/m, (Subscript[ϵ, 0]) is in F/m and e is in C, so (Subscript[n, e]) [V F/C (m^2) = 1/(m^2)]

ne:=
Abs[(1/e) ϵ0 (Ex[pico]-Ex[-pico])]/.NSub

Charge density wave

max=pico ne;
Fig14=Plot[Evaluate[
pico ne Cos[z k Re[β] micro]],
{z,0,2},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","(Subscript[n, e]) (1/((μm)^2))","",""},PlotRange->{-1.2 max,1.2 max},
ImageSize-> is,
Evaluate[optX]]

The oscillating fields and charge density wave

FigExEz1=Plot[Evaluate[{
milli Abs[Ex[x]] Cos[θEx[x]+k Re[β] z micro]/.x->-10 nano,
milli Abs[Ez[x] ]Cos[θEz[x]+k Re[β] z micro]/.x->-10 nano,
pico ne Cos[z micro k Re[β]]}],{z,0,1},
PlotRange->All,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)","x = -10 nm","(Subscript[n, e]) (1/((μm)^2))"},
ImageSize->is,
Evaluate[optX]]

FigExEz2=Plot[Evaluate[{
milli Abs[Ex[x]] Cos[θEx[x]+k Re[β] z micro]/.x->pico,
milli Abs[Ez[x] ]Cos[θEz[x]+k Re[β] z micro]/.x->pico,
10.pico ne Cos[z micro k Re[β]]}],{z,0,1},PlotRange->All,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},
FrameLabel->{"z (μm)","E ((10^3) V/m)","x = (SuperPlus[0]) nm","(Subscript[n, e]) (1/((μm)^2))"},
ImageSize->is,
Evaluate[optX]]

FigExEz3=Plot[Evaluate[{
milli Abs[Ex[x]] Cos[θEx[x]+k Re[β] z micro]/.x->-pico,
milli Abs[Ez[x] ]Cos[θEz[x]+k Re[β] z micro]/.x->-pico,
10pico ne Cos[z micro k Re[β]]}],{z,0,1},
PlotRange->All,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)",
"x = (SuperMinus[0]) nm","(Subscript[n, e]) (1/((μm)^2))"},
ImageSize-> is,
Evaluate[optX]]

FigExEz4=Plot[Evaluate[{
milli Abs[Ex[x]] Cos[θEx[x]+k Re[β] z micro]/.x->50 nano,
milli Abs[Ez[x] ]Cos[θEz[x]+k Re[β] z micro]/.x->50 nano,
10.pico ne Cos[z micro k Re[β]]}],{z,0,1},
PlotRange->All,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)","x = 50 nm","(Subscript[n, e]) (1/((μm)^2))"},
ImageSize-> is,Evaluate[optX]]

Fig15=GraphicsGrid[{
{FigExEz3,FigExEz2},
{FigExEz1,FigExEz4}},
Frame->True,
ImageSize->1.1gg,
Spacings -> {-20,10}]

k-vectors, Fresnel Equations, Reflectivity, Angle and Width

k-vectors

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

Fresnel equations

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[θ_,pol_]:=If[pol==1,((μm kc[θ]-μc km[θ])/(μm kc[θ]+μc km[θ])),((ϵm kc[θ]-ϵc km[θ])/(ϵm kc[θ]+ϵc  km[θ]))]
Clear[rms]
rms[θ_,pol_]:=If[pol==1,((μs km[θ]- μm ks[θ])/(μs km[θ]+μm ks[θ])),((ϵs km[θ]-ϵm ks[θ])/(ϵs km[θ]+ϵm ks[θ]))]

Two presentations of Fresnel equations

ηp=(Sqrt[μp])/(Sqrt[ϵp]);ηc=(Sqrt[μc])/(Sqrt[ϵc]);

θp=45 π/180;
θcx=ArcSin[((np )/nc)Sin[θp]];
TableForm[{
{"","(Subscript[r, pc])[s]","(Subscript[r, pc])[p]"},
{"k-representation",rpc[θp,s],rpc[θp,p]},
{"η-representation",((ηc Cos[θp]-ηp Cos[θcx])/(ηc Cos[θp]+ηp Cos[θcx])),((ηp Cos[θp]-ηc Cos[θcx])/(ηp Cos[θp]+ηc Cos[θcx]))}},TableSpacing->1]

Reflectivity due to three and four interfaces

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

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

Angle and width in prism

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

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

Lorentzian function

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

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

TableForm[{
{"(Subscript[θ, c]) [deg]","(Subscript[θ, p]) [deg]","(Subscript[Γ, p]) [deg]"},
{180/π θc,180/π θx[β],180/π Γx[β]}},TableSpacing->1]

Prism Coupling into DPS/ENG single interface modes

Angle and width in prism

Table8=Grid[{
{"β","(Subscript[θ, p]) (deg)","(Subscript[Γ, p]) (deg)"},
{β,θx[β]180/π,Γx[β]180/π}},
Dividers->All,
ItemStyle->{fs,fs}]

Otto spectra

dm=20 micro;
dcmin=300;
dcmax=600;
θmin=Max[θc,(θx[β]-16Γx[β])180/π];
θmax=(θx[β]+16Γx[β])180/π;
FigOtto1=Table[Plot[{
((Abs[Rpcms[dc nano,dm,θ π/180,p]])^2),L1[θ π/180,β]},{θ,θmin,θmax},
PlotRange->{-.001,1.001},
LabelStyle->{FontSize -> fs},
FrameLabel->{"θ (deg)","(Subscript[ℛ, O])","",StringJoin["(Subscript[d, c]) = ",ToString[dc]," nm"]},
ImageSize->is,
Evaluate[optX]],{dc,dcmin,dcmax,(dcmax-dcmin)/3.0}];

Fig17=FigSpectraOtto=GraphicsGrid[{
{FigOtto1[[1]],FigOtto1[[2]]},
{FigOtto1[[3]],FigOtto1[[4]]}},
ImageSize->1.1gg,
Frame->True,
 Spacings -> {-30,10}]

dcx=600;
ymin=1-Min[Table[((Abs[Rpcms[dcx nano,dm,θ π/180,p]])^2),{θ,38,42,.01}]];
dm=20 micro;
dcmin=300;
dcmax=600;
θmin=Max[θc,(θx[β]-16Γx[β])180/π];
θmax=(θx[β]+16Γx[β])180/π;
Fig18=FigOtto2=Plot[{
1-(1-((Abs[Rpcms[dcx nano,dm,θ π/180,p]])^2))/ymin,1-(1-L1[θ π/180,β])},{θ,θmin,θmax},
PlotRange->{-.001,1.001},
LabelStyle->{FontSize -> fs},
FrameLabel->{"θ (deg)","(Subscript[ℛ, O])","",StringJoin["(Subscript[d, c]) = ",ToString[dcx]," nm"]},
ImageSize->1.1is,
Evaluate[optX]]

Kretchmann spectra

dc=0 nano;
dmmin=30;
dmmin=40;
dmmax=60;
dmmax=100;
θmin=Max[θc,(θx[β]-16Γx[β])180/π];
θmax=(θx[β]+16Γx[β])180/π;
FigKretschmann1=Table[Plot[{
((Abs[Rpcms[dc,dm nano,θ π/180 ,p]])^2),L1[θ π/180,β]},{θ,θmin,θmax},PlotRange->{-.001,1.001},
LabelStyle->{FontSize -> fs},FrameLabel->{"θ (deg)","(Subscript[ℛ, K])","",StringJoin["(Subscript[d, m]) = ",ToString[dm]," nm"]},
ImageSize-> is,Evaluate[optX]],{dm,dmmin,dmmax,(dmmax-dmmin)/3.0}];

Fig20=FigSpectraKretschmann=GraphicsGrid[{
{FigKretschmann1[[1]],FigKretschmann1[[2]]},
{FigKretschmann1[[3]],FigKretschmann1[[4]]}},ImageSize->1.1gg,
Frame->True,
 Spacings -> {-30,10}]

dm=20 micro;
dmx=100;
dc=0;
ymin1=((Abs[Rpcms[dc nano,dmx nano,38 π/180,p]])^2);
ymin=ymin1-Min[Table[((Abs[Rpcms[dc nano,dmx nano,θ π/180,p]])^2),{θ,39,41,.01}]];
dcmin=300;
dcmax=600;
θmin=Max[θc,(θx[β]-16Γx[β])180/π];
θmax=(θx[β]+16Γx[β])180/π;
Fig21=FigKretscmann2=Plot[{
1-(ymin1-((Abs[Rpcms[dc nano,dmx nano,θ π/180,p]])^2))/ymin,1-(1-L1[θ π/180,β])},{θ,θmin,θmax},
PlotRange->{-.001,1.001},
LabelStyle->{FontSize -> fs},
FrameLabel->{"θ (deg)","(Subscript[ℛ, K])","",StringJoin["(Subscript[d, m]) = ",ToString[dmx]," nm"]},
ImageSize->1.1is,
Evaluate[optX]]

Tables

TableAll

Table1=TableChapter6

Table2

Table3

Table4

Table5

Table6

Table7

Table8

Figures

Fig3

Fig4

Fig5

Fig6

Fig7

Fig8

Fig9

Fig11

Fig12

Fig13

Fig14

Fig15

Fig17

Fig18

Fig20

Fig21

Exercises

(1) Complete the missing items in Table 6.1 by developing the code, generating figures and discuss them. 
(2) Compare the advantages and disadvantages of using the Otto and Kretschmann configuraitons.

References

[1] H. Raether.  Excitation of Plasmons and Interband Transitions by Electrons (Springer Tracts in Modern Physics, Vol. 88, Berlin Heidelberg New York, Springer-Verlag, 1980).
[2] V. M. Agranovich and D. L. Mills, Eds.  Surface Polaritons, Electromagnetic Waves at Surfaces and Interfaces (New York, North Holland, 1982).
[3] A. D. Boardman, Ed.  Electromagnetic Surface Modes (New York, John Wiley & Sons, 1982).
[4] H. Raether.  Surface Plasmons on Smooth and Rough Surfaces and on Gratings (Springer Tracts in Modern Physics, Vol. 111, New York, Springer-Verlag, 1988).
[5] J. Pendry.  Manipulating the near field with metamaterials.  OPN 15 (2004) 32.
[6] W. Ebbesen, C. Genet and S. I. Bozhevolnyi.  Surface-plasmon circuitry.   Phys. Today 61 (2008) 44.