7
Double-interface surface plasmons in symmetric guides

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. 22:
Fig22=GraphicsGrid[{
{FigSpectra[[1]],FigSpectra[[2]]},
{FigSpectra[[3]],FigSpectra[[4]]}},
Frame->True,
ImageSize->1.4gg,
Spacings->{-50,10}]
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}]

General Interface Wave

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[θ]))]

Reflectivity due to three and four interfaces

(Subscript[R, cms])=(((Subscript[r, cm])(θ)+(Subscript[r, ms])(θ)(e^(i 2k (Subscript[k, m])(θ) (Subscript[d, m]))) )/(1+(Subscript[r, cm])(θ) (Subscript[r, ms])(θ) (e^(i 2 k (Subscript[k, m])(θ) (Subscript[d, m]))) ))

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

(Subscript[R, pcms])=(((Subscript[r, pc])(θ)+(Subscript[R, cms])((Subscript[d, m]),θ)(e^(i 2 k (Subscript[k, c])(θ) (Subscript[d, c]))) )/(1+(Subscript[R, cms])((Subscript[d, m]),θ) (Subscript[r, pc])(θ)(e^(i 2 k (Subscript[k, c])(θ) (Subscript[d, c]))) ))

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[β],β]))

Double Interface Mode

Wave vectors

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

TM mode fields

Clear[Hy0]
Hy0[β_,x_]:=Which[
x≥0, (E^(-k δ[β] x)),
x<0&&x>-dm,Cos[k κ[β]x]-((ϵm)/(ϵc))((δ[ β])/(κ[β]))Sin[k κ[β]x],
x≤-dm,(Cos[k κ[β]dm]+((ϵm)/(ϵc))((δ[ β])/(κ[β]))Sin[k κ[ β]dm])(E^(k γ[β](x+dm)))]

Clear[Ex0]
Ex0[β_,x_]:=((k β)/(ω ϵ0))Which[
x≥0,(1/(ϵc)) (E^(-k δ[β] x)),
x<0&&x>-dm,(1/(ϵm))(Cos[k κ[β]x]-((ϵm)/(ϵc))((δ[ β])/(κ[β]))Sin[k κ[β]x]),
x≤-dm,(1/(ϵs))( Cos[k κ[β]dm]+((ϵm)/(ϵc))((δ[ β])/(κ[β]))Sin[k κ[ β]dm])(E^(k γ[β](x+dm)))]/.NSub

Clear[Ez0]
Ez0[β_,x_]:=((I k)/(ω ϵ0))Which[
x≥0,-((δ[β])/(ϵc)) (E^(-k δ[β] x)),
x<0&&x>-dm,-(( κ[β])/(ϵm))(Sin[k κ[β]x]+((ϵm)/(ϵc))((δ[ β])/(κ[β]))Cos[k κ[β]x]),
x≤-dm,((γ[β])/(ϵs))( Cos[k κ[β]dm]+((ϵm)/(ϵc))((δ[ β])/(κ[β]))Sin[k κ[ β]dm])(E^(k γ[β](x+dm)))]/.NSub

Normalization for TM mode

Clear[Scp]
Scp[β_]:=((k β)/(ω ϵ0 ϵc))NIntegrate[ (E^(-k δ[β] x)) Conjugate[(E^(-k δ[β] x))],{x,pico, milli}]/.NSub

Clear[Smp]
Smp[β_]:=((k β)/(ω ϵ0 ϵm))NIntegrate[(Cos[k κ[β]x]-((ϵm)/(ϵc))((δ[ β])/(κ[β]))Sin[k κ[β]x])Conjugate[ (Cos[k κ[β]x]-((ϵm)/(ϵc))((δ[ β])/(κ[β]))Sin[k κ[β]x])],{x,-dm,0}]/.NSub

Clear[Ssp]
Ssp[β_]:=((k β)/(ω ϵ0 ϵs))NIntegrate[( Cos[k κ[β]dm]+((ϵm)/(ϵc))((δ[ β])/(κ[β]))Sin[k κ[ β]dm])(E^(k γ[β](x+dm)))Conjugate[(Cos[k κ[β]dm]+((ϵm)/(ϵc))((δ[ β])/(κ[β]))Sin[k κ[ β]dm])(E^(k γ[β](x+dm)))],{x,-milli,-dm}]/.NSub

Clear[Scmsp]
Scmsp[β_]:=Scp[β]+Smp[β]+Ssp[β]

Clear[C1]
C1[β_]:=(1/(Sqrt[.5 Re[Scmsp[β]]]))

Clear[C2]
C2[β_]:=√Re[(((4ω ϵ0)/(k β))ϵm ((ϵc)^2) ((κ[ β])^2))/((((ϵc)^2) ((κ[β])^2)+((ϵm)^2)((δ[β])^2))(dm+((ϵm ϵs)/(k γ[β]))((((κ[β])^2)+((γ[β])^2))/(((ϵs)^2)((κ[β])^2)+((ϵm)^2)((γ[β])^2)))+((ϵm ϵc)/(k δ[β]))((((κ[β])^2)+((δ[β])^2))/(((ϵc)^2)((κ[β])^2)+((ϵm)^2)((δ[β])^2)))))]/.NSub

Clear[C0]
C0[β_]:=C2[β]

(Subscript[E, x])

Clear[Ex]
Ex[β_,x_]:=C0[β]Ex0[β,x]

(Subscript[E, y])

Clear[Ey]
Ey[β_,x_]:=A0[β]Ey0[β,x]

(Subscript[E, z])

Clear[Ez]
Ez[β_,x_]:=C0[β]Ez0[β,x]

(Subscript[H, x])

Clear[Hx]
Hx[β_,x_]:=A0[β]Hx0[β,x]

(Subscript[H, y])

Clear[Hy]
Hy[β_,x_]:=C0[β]Hy0[β,x]

(Subscript[H, z])

Clear[Hz]
Hz[β_,x_]:=A0[β]Hz0[β,x]

DPS/ENG/DPS double interface guide

Parameters

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

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},
{"Metal",ϵ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]]

TM contour plot: Lossless

θc=(180/π) ArcSin[nc/np];

βTM=((Sqrt[μc ϵc ((ϵm)^2)-μm ϵm ((ϵc)^2)])/(Sqrt[((ϵm)^2)-((ϵc)^2)]))

General mode equation

Even mode

βmin=.999Min[ns,nc];
βmax=2Max[ns,nc];
Plot[{Abs[Tan[k κ[β]dm]],Abs[ϵm κ[β]((ϵc γ[β]+ϵs δ[β])/(ϵs ϵc ((κ[β])^2)-((ϵm)^2)γ[β] δ[β]))]},{β,βmin,βmax},PlotRange->{{.99,βmax},{-.01,1.21}},
LabelStyle->{FontSize -> fs},FrameLabel->{"β'","LHS and RHS","TM Mode",StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},Evaluate[optX]]

βeven=Chop[FindRoot[(Tan[k κ[β]dm])==(ϵm κ[β]((ϵc γ[β]+ϵs δ[β])/(ϵs ϵc ((κ[β])^2)-((ϵm)^2)γ[β] δ[β]))),{β,βmin}][[1,2]]]

β1=Chop[FindRoot[(Tan[k κ[β]dm/2])==(((ϵm δ[β])/(ϵc κ[β]))),{β,βmin}][[1,2]]]

Odd mode

βodd= Chop[FindRoot[(Tan[k κ[β]dm])==(ϵm κ[β]((ϵc γ[β]+ϵs δ[ β])/(ϵs ϵc ((κ[β])^2)-((ϵm)^2)γ[β] δ[β]))),{β,βmax}][[1,2]]]

β2=Chop[FindRoot[(Tan[k κ[β]dm/2])==(-((ϵc κ[β])/(ϵm δ[β]))),{β,βmax}][[1,2]]]

TM mode equation and chosen cases

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

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

Range of solutions

Clear[β1x,β,ϵ]
β1x[ϵ_]:=Chop[FindRoot[(Tan[k (Sqrt[ϵ μm-(β^2)])dm/2])==(-((ϵc (Sqrt[ϵ μm-(β^2)]))/(ϵ δ[β]))),{β,βmax}][[1,2]]]

Clear[β2x,β,ϵ]
β2x[ϵ_]:=Chop[FindRoot[(Tan[k (Sqrt[ϵ μm-(β^2)])dm/2])==(((ϵ δ[β])/(ϵc (Sqrt[ϵ μm-(β^2)])))),{β,βmin}][[1,2]]]

Clear[β3x,β,ϵ]
β3x[ϵ_]:=Chop[((Sqrt[μc ϵc (ϵ^2)-μm ϵ ((ϵc)^2)])/(Sqrt[(ϵ^2)-((ϵc)^2)]))]

lst1=Table[{ϵ,β1x[ϵ]},{ϵ,-20,-4,.1}];
lst2=Table[{ϵ,β2x[ϵ]},{ϵ,-20,-4,.1}];
lst3=Table[{ϵ,β3x[ϵ]},{ϵ,-20,-4,.1}];

Fig5=ListLinePlot[{lst1,lst2,lst3},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"(Subscript[ϵ, m])'","β'","",""},
PlotRange->{1.5,2.55},
ImageSize->1.1 is,
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],

Text[Style[
"SR",fs],{-12.5,2.3}],
Text[Style[
"MR",fs],{-10,1.8}],
Text[Style[
"LR",fs],{-8,1.6}]}]

Graphics of mode solution

βs=((Sqrt[μc ϵc ((ϵm)^2)-μm ϵm ((ϵc)^2)])/(Sqrt[((ϵm)^2)-((ϵc)^2)]))

Fig4=Plot[{Abs[Tan[k κ[β]dm]],(Abs[ϵm κ[β]((ϵc γ[β]+ϵs δ[β])/(ϵs ϵc ((κ[β])^2)-((ϵm)^2)γ[β] δ[β]))])},{β,βmin,βmax},
LabelStyle->{FontSize -> fs1},FrameLabel->{"β","Mode solutions","TM mode",StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},PlotRange->{{.99,βmax},{-.01,1.21}},
ImageSize->1.1 is,
Evaluate[optX],
Epilog->{

RGBColor[0,0,0],
Text[
"●",{Abs[βeven],Abs[Tan[k κ[βeven] dm]]}],
Text[
"●",{Abs[βs],Abs[ϵm κ[βs]((ϵc γ[βs]+ϵs δ[βs])/(ϵs ϵc ((κ[βs])^2)-((ϵm)^2)γ[βs] δ[βs]))]}],
RGBColor[0,0,0],
Text[Style[
"LR",fs],{Abs[βeven]-.2,Abs[Tan[k κ[βeven]dm]]}],
Text[Style[
"MR",fs],{Abs[βs],1.1}],
RGBColor[0,0,0],
Text[
"●",{Abs[βodd],Abs[Tan[k κ[βodd] dm]]}],
RGBColor[0,0,0],
Text[Style[
"SR",fs],{Abs[βodd],-.2+Abs[Tan[k κ[βodd] dm]]}]}]

βs

k-vectors

Table3=Grid[{
{"","Long-range mode","Short-range mode"},
{"β",βeven,βodd},
{"δ",δ[βeven],δ[βodd]},
{"κ",κ[βeven],κ[βodd]},
{"γ",γ[βeven],γ[βodd]}},Dividers->All,
ItemStyle->{fs,fs}]

Graphic solution of β' as a function of (Subscript[d, m]): Both modes

Clear[βx]
βx[d_,β0_]:=FindRoot[(Tan[k κ[β]d])==(ϵm κ[β]((ϵc γ[β]+ϵs δ[β])/(ϵs ϵc ((κ[β])^2)-((ϵm)^2)γ[β] δ[β]))),{β,β0}][[1,2]]

Fig6a=Plot[{Re[βx[x nano,nc+.1]],Re[βx[x nano,1.2nc]],Re[βs]},{x,10, 40},
LabelStyle->{FontSize -> fs1},FrameLabel->{"(Subscript[d, m]) (nm)","β'","",""},
ImageSize->.8 is,
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text[
"●",{dm /nano,Re[βeven]}],
Text[Style[
"LR",fs],{dm/nano,.2+Re[βeven]}],
Text[Style[
"MR",fs],{12,.1+Re[βs]}],
Text[
"●",{dm/nano,Re[βodd]}],
Text[Style[
"SR",fs],{dm/nano,.2+Re[βodd]}]}]

Fig19=FigReθ=Plot[{(180/π)Re[ArcSin[βx[x nano,nc+.1]/((Sqrt[ϵp]))]],(180/π)Re[ArcSin[βx[x nano,1.2nc]/((Sqrt[ϵp]))]],(180/π)Re[ArcSin[((βs)/(Sqrt[ϵp]))]]},{x,10, 40},
LabelStyle->{FontSize -> fs1},FrameLabel->{"(Subscript[d, m]) (nm)","(Subscript[θ, p]) (deg)","",""},
ImageSize->1.1 is,
Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text[
"●",{dm/nano,(180/π)Re[ArcSin[((βeven)/(Sqrt[ϵp]))]]}],
Text[Style[
"LR",fs],{dm/nano,5+(180/π)Re[ArcSin[((βeven)/(Sqrt[ϵp]))]]}],
Text[Style[
"MR",fs],{12,2+(180/π)Re[ArcSin[((βs)/(Sqrt[ϵp]))]]}],
Text[
"●",{dm/nano,.01+(180/π)Re[ArcSin[((βodd)/(Sqrt[ϵp]))]]}],
Text[Style[
"SR",fs],{dm/nano,5+(180/π)Re[ArcSin[((βodd)/(Sqrt[ϵp]))]]}]}]

Graphics solution of β'' as a function of (Subscript[d, m]): Both modes

Fig6b=Plot[{Im[βx[x nano,nc+.1]],Im[βx[x nano,1.2 nc]],Im[βs]},{x,10, 100},FrameLabel->{"(Subscript[d, m]) (nm)","β''","",""},
LabelStyle->{FontSize -> fs1},
PlotRange->{0,0.06},
ImageSize->.8 is,
Evaluate[optX],

Epilog->{
RGBColor[0,0,0],
Text[
"●",{dm/nano,Im[βeven]}],
Text[Style[
"LR",fs],{dm/nano,.0075+Im[βeven]}],
Text[Style[
"MR",fs],{80,.005+Im[βs]}],
Text[
"●",{dm/nano,Im[βodd]}],
Text[Style[
"SR",fs],{dm/nano,.0075+Im[βodd]}]}]

Fig6=GraphicsRow[{Fig6a,Fig6b},
Frame->True,
ImageSize->1.2gr,
Spacings->{-40,10}]

Fig7a=Plot[{
milli Re[βx[x nano,nc+.1]]/Im[βx[x nano,nc+.1]]},{x,10, 50},
LabelStyle->{FontSize -> fs},FrameLabel->{"(Subscript[d, m]) (nm)","(10^3) β'/β''","LR",""},PlotRange->{-.1,30},
Evaluate[optX]]

Fig7b=Plot[{Re[βx[x nano,1.2 nc]/Im[βx[x nano,1.2 nc]]]},{x,10, 50},
LabelStyle->{FontSize -> fs},
FrameLabel->{"(Subscript[d, m]) (nm)","β'/β''","SR",""},
PlotRange->{-.1,200},
Evaluate[optX]]

Fig7=GraphicsRow[{Fig7a,Fig7b},
Frame->True,
ImageSize->1.2gr,

Spacings->{-50,20}]

Graphic solution of Γ as a function of (Subscript[d, m]): Both modes

Fig20=FigImθd=Plot[{
(180/π)Im[ArcSin[βx[x nano,nc+.1]/((Sqrt[ϵp]))]],(180/π)Im[ArcSin[βx[x nano,1.2nc]/((Sqrt[ϵp]))]],
(180/π)Im[ArcSin[((βs)/(Sqrt[ϵp]))]]},
{x,15, 40},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"(Subscript[d, m]) (nm)","(Subscript[Γ, p]) (deg)","",""},
ImageSize->1.1 is,
Evaluate[optX],

Epilog->{

RGBColor[0,0,0],
Text[
"●",{dm/nano,(180/π)Im[ArcSin[((βeven)/(Sqrt[ϵp]))]]}],
Text[Style[
"LR",fs],{dm/nano,.5+(180/π)Im[ArcSin[((βeven)/(Sqrt[ϵp]))]]}],
Text[Style[
"MR",fs],{36,1+(180/π)Im[ArcSin[((βeven)/(Sqrt[ϵp]))]]}],
RGBColor[0,0,0],
Text[
"●",{dm/nano,(180/π)Im[ArcSin[((βodd)/(Sqrt[ϵp]))]]}],
Text[Style[
"SR",fs],{dm/nano,.5+(180/π)Im[ArcSin[((βodd)/(Sqrt[ϵp]))]]}]}]

Fig21=Figenhancement=LogPlot[((
Im[ArcSin[((βx[x nano,1.2` nc])/(Sqrt[ϵp]))]])/(Im[ArcSin[((βx[x nano,nc+0.1`])/(Sqrt[ϵp]))]])),
{x,10,50},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"(Subscript[d, m]) (nm)","(Subscript[Γ, SR])/(Subscript[Γ, LR])","",""},
PlotRange->{1,20000},
ImageSize->1.2 is,
Evaluate[optX],Epilog->{RGBColor[0,0,0],Text["●",{(dm/nano),Log[((Im[ArcSin[((βodd)/(Sqrt[ϵp]))]])/(Im[ArcSin[((βeven)/(Sqrt[ϵp]))]]))]}]}]

Propagation length

ζa=mega/(k Im[nm]);Nζa=Re[nm]/Im[nm];τζa=Re[nm]/Im[nm]/ω/femto;

ζb=mega/(k Im[βodd]);Nζb=Re[βodd]/Im[βodd];τζb=Re[βodd]/Im[βodd]/ω/femto;

ζc=mega/(k Im[βs]);Nζc=Re[βs]/Im[βs];τζc=Re[βs]/Im[βs]/ω/femto;

ζd=mega/(k Im[βeven]);Nζd=Re[βeven]/Im[βeven];τζd=Re[βeven]/Im[βeven
]/ω/femto;

Table4=Grid[{
{"","System","ζ (μm)","(Subscript[N, ζ ])(cycles)","(Subscript[τ, ζ]) (fs)"},
{"(a) PW","silver",ζa,Nζa,τζa},
{"(b) SR","glass/silver/glass",ζb,Nζb,τζb},
{"(c) MR","glass/silver",ζc,Nζc,τζc},
{"(c) LR","glass/silver/glass",ζd,Nζd,τζd}},
Dividers->All,
ItemStyle->{fs,fs}]

Normalization of fields

tblNormalization=TableForm[{
{"","(Subscript[C, 0,explicit])","(Subscript[C, 0,integral])"},
{"LR",C0[βeven],C1[βeven]},
{"SR",C0[βodd],C1[βodd]}},TableSpacing->1]

Table5=Grid[{
{"Mode","C"},
{"LR",C0[βeven]},
{"SR",C0[βodd]}},Dividers->All,
ItemStyle->{fs,fs}]

Long-range (Subscript[H, y])' and (Subscript[H, y])''

FigHyLRRe

dd=1;
dx=.4;
maxmin=Re[Hy[βeven,1 nano]]dd;
FigHyLRRe=Plot[Re[Hy[βeven,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[H, y])' (A/m)","LR",""},
PlotRange->1.1 maxmin,
Filling -> Axis,
FillingStyle ->Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,-75}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,-75/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,-75}]}]

FigHyLRIm

dd=1;
dx=.4;
maxmin=Im[Hy[βeven,200 nano]]dd;
FigHyLRIm=Plot[Im[Hy[βeven,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[H, y])'' (A/m)","LR",""},
PlotRange->All,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,.15}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,.15/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,.15}]}]

Short-range (Subscript[H, y])' and (Subscript[H, y])''

FigHySRRe

dd=1;
dx=.4;
maxmin=Re[Hy[βodd,1 nano]]dd;
FigHySRRe=Plot[Re[Hy[βodd,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[H, y])' (A/m)","SR",""},
PlotRange->1.1 maxmin,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Sty;e[
StringJoin["cover",ToString[""]],fs],{dx/2,-150}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,-150/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,-150}]}]

FigHySRIm

dd=1;
dx=.4;
maxmin=Im[Hy[βodd,200 nano]]dd;
FigHySRIm=Plot[Im[Hy[βodd,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[H, y])'' (A/m)","SR",""},
PlotRange->All,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,-1.5}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,-1.5/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,-1.5}]}]

Long- and short range (Subscript[H, y])' and (Subscript[H, y])''

FigHy

Fig8=GraphicsGrid[{
{FigHyLRRe,FigHyLRIm},
{FigHySRRe,FigHySRIm}},
Frame->True,
ImageSize->1.2gg,
Spacings->{-25,10}]

Long-range (Subscript[E, x])', (Subscript[E, x])'' and |(Subscript[E, x])|

FigExLRRe

dd=milli;
dx=.4;
maxmin=Re[Ex[βeven,1 nano]]dd;
FigExLRRe=Plot[Re[Ex[βeven,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[E, x])' ((10^3) V/m)","LR",""},
PlotRange->1.1 maxmin,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,-25}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,-25/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,-25}]}]

FigExLRIm

dd=milli;
dx=.4;
maxmin=Im[Ex[βeven,400 nano]]dd;
FigExLRIm=Plot[Im[Ex[βeven,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[E, x])'' ((10^3) V/m)","LR",""},
PlotRange->1.1 maxmin,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,.04}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,.03/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,.04}]}]

FigExLRAbs

dd=milli;
dx=.4;
maxmin=Abs[Ex[βeven,1 nano]]dd;
FigExLRAbs=Plot[Abs[Ex[βeven,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","|(Subscript[E, x])| ((10^3) V/m)","LR",""},
PlotRange->{0,1.1 maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,25}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,25/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,25}]}]

Short-range (Subscript[E, x])', (Subscript[E, x])'' and |(Subscript[E, x])|

FigExSRRe

dd=milli;
dx=.4;
maxmin=Re[Ex[βodd,1 nano]]dd;
FigExSRRe=Plot[Re[Ex[βodd,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[E, x])' ((10^3) V/m)","SR",""},
PlotRange->1.1 maxmin,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,-75}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,-75/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,-75}]}]

FigExSRIm

dd=milli;
dx=.4;
maxmin=Im[Ex[βodd,4 nano]]dd;
FigExSRIm=Plot[Im[Ex[βodd,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[E, x])'' ((10^3) V/m)","SR",""},
PlotRange->1.1 maxmin,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,-1.2}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,-.8}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,-1.2}]}]

FigExSRAbs

dd=milli;
dx=.4;
maxmin=Abs[Ex[βodd,1 nano]]dd;
FigExSRAbs=Plot[Abs[Ex[βodd,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","|(Subscript[E, x])| ((10^3) V/m)","SR",""},
PlotRange->{0,1.1 maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,75}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,75/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,75}]}]

Long- and short-range (Subscript[E, x])' and (Subscript[E, x])''

FigEx

Fig9=GraphicsGrid[{
{FigExLRRe,FigExLRIm},
{FigExSRRe,FigExSRIm}},
Frame->True,
ImageSize->1.2gg,
Spacings->{-25,10}]

Long-range (Subscript[E, z])', (Subscript[E, z])'' and |(Subscript[E, z])|

FigEzLRRe

dd=milli;
dx=.4;
maxmin=Re[Ez[βeven,1 nano]]dd;
FigEzLRRe=Plot[Re[Ez[βeven,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[E, z])' ((10^3) V/m)","LR",""},
PlotRange->1.1 maxmin,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,.015}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,.015/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,.015}]}]

FigEzLRIm

dd=milli;
dx=.4;
maxmin=-Im[Ez[βeven,nano]]dd;
FigEzLRIm=Plot[Im[Ez[βeven,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[E, z])'' ((10^3) V/m)","LR",""},
PlotRange->{-1.1 maxmin,1.1 maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,5}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,5/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,5}]}]

FigEzLRAbs

dd=milli;
dx=.4;
maxmin=Abs[Ez[βeven,1 nano]]dd;
FigEzLRAbs=Plot[Abs[Ez[βeven,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","|(Subscript[E, z])| ((10^3) V/m)","LR",""},
PlotRange->{0,1.1 maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,3.5}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,3.5/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,3.5}]}]

Short-range (Subscript[E, z])', (Subscript[E, z])'' and |(Subscript[E, z])|

FigEzSRRe

dd=milli;
dx=.4;
maxmin=Re[Ez[βodd,1 nano]]dd;
FigEzSRRe=Plot[Re[Ez[βodd,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[E, z])' ((10^3) V/m)","SR",""},
PlotRange->1.1 maxmin,
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,-1.5}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,-1.5/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,-1.5}]}]

FigEzSRIm

dd=milli;
dx=.4;
maxmin=-Im[Ez[βodd,nano]]dd;
FigEzSRIm=Plot[Im[Ez[βodd,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[E, z])'' ((10^3) V/m)","SR",""},
PlotRange->{-1.1 maxmin,1.1 maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,30}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,30/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,30}]}]

FigEzSRAbs

dd=milli;
dx=.4;
maxmin=Abs[Ez[βodd,1 nano]]dd;
FigEzSRAbs=Plot[Abs[Ez[βodd,x micro]]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","|(Subscript[E, z])| ((10^3) V/m)","SR",""},
PlotRange->{0,1.1 maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,50}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,50/2}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,50}]}]

Long- and short-range (Subscript[E, z])' and (Subscript[E, z])''

FigEz

Fig10=GraphicsGrid[{
{FigEzLRRe,FigEzLRIm},
{FigEzSRRe,FigEzSRIm}},
Frame->True,
ImageSize->1.2gg,
Spacings->{-25,10}]

Long- and short-range |(Subscript[E, x])| and |(Subscript[E, z])|

FigExEzAbs

Fig11=GraphicsGrid[{
{FigExLRAbs,FigEzLRAbs},
{FigExSRAbs,FigEzSRAbs}},
Frame->True,
ImageSize->1.2gg,
Spacings->{-50,10}]

Impedence (Subscript[Z, TM])

fs2=.9fs;
η0=(Sqrt[μ0/ϵ0])/.NSub;
ηTMceven=k βeven/(ω ϵ0 ϵc)/.NSub;
ηTMmeven=k βeven/(ω ϵ0 ϵm)/.NSub;
ηTMseven=k βeven/(ω ϵ0 ϵs)/.NSub;
ηTMcodd=k βodd/(ω ϵ0 ϵc)/.NSub;
ηTMmodd=k βodd/(ω ϵ0 ϵm)/.NSub;
ηTMsodd=k βodd/(ω ϵ0 ϵs)/.NSub;
ηc=k nc/(ω ϵ0 ϵc)/.NSub;
ηm=k nm/(ω ϵ0 ϵm)/.NSub;
ηs=k nc/(ω ϵ0 ϵs)/.NSub;
Table6=Grid[{
{"","(Subscript[η, i])/(Subscript[η, 0])","(Subscript[η, LR])/(Subscript[η, 0])","(Subscript[η, SR/])(Subscript[η, 0])"},
{"Cover",ηc/η0,ηTMceven/η0,ηTMcodd/η0},
{"Metal",ηm/η0,ηTMmeven/η0,ηTMmodd/η0},
{"Substrate",ηs/η0,ηTMseven/η0,ηTMsodd/η0}},Dividers->All,
ItemStyle->{fs2,fs2}]

Fields as phasors

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

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

Fields

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

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

tblEzzxeven=Table[Evaluate[milli Abs[Ez[β,x micro]](1+ Cos[θEz[β,x micro]+k Re[β] z micro])/.β->βeven],{x,-.5-dm/micro,.5,.01},{z,0,1,.02}];
FigEzzxeven=ListContourPlot[tblEzzxeven,LabelStyle->{FontSize -> fs},FrameLabel->{"z (20 nm)","x (20 nm)","(Subscript[E, z]) @ LR",""},ImageSize->is]

tblEzzxodd=Table[Evaluate[milli Abs[Ez[β,x micro]](1+ Cos[θEz[β,x micro]+k Re[β] z micro])/.β->βodd],{x,-.5-dm/micro,.5,.01},{z,0,1,.02}];
FigEzzxodd=ListContourPlot[tblEzzxodd,LabelStyle->{FontSize -> fs},FrameLabel->{"z (20 nm)","x (20 nm)","(Subscript[E, x]) @ SR",""},ImageSize->is]

Fig15=GraphicsGrid[{
{FigExzxeven,FigExzxodd},
{FigEzzxeven,FigEzzxodd}},
Frame->True,
ImageSize->1.2gg,
Spacings->{-125,10}]

The fields as phasors: x = 0+

FigExEzeven1=Plot[Evaluate[{
milli Abs[Ex[β,x]] Cos[θEx[β,x]+k Re[β] z micro]/.β->βeven/.x->pico,
milli Abs[Ez[β,x] ]Cos[θEz[β,x]+k Re[β] z micro]/.β->βeven/.x->pico}],{z,0,1},Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)","LR @ x = (SuperPlus[0])",StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},Evaluate[optX]]

FigExEzodd1=Plot[Evaluate[{
milli Abs[Ex[β,x]] Cos[θEx[β,x]+k Re[β] z micro]/.β->βodd/.x->pico,
milli Abs[Ez[β,x] ]Cos[θEz[β,x]+k Re[β] z micro]/.β->βodd/.x->pico}],{z,0,1},Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)","SR @ x = (SuperPlus[0])",StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},Evaluate[optX]]

FigExEz1=GraphicsRow[{FigExEzeven1,FigExEzodd1},
Frame->False,
ImageSize->.95gr,
Spacings->-20]

The fields as phasors: x = 0-

FigExEzeven2=Plot[Evaluate[{
milli Abs[Ex[β,x]] Cos[θEx[β,x]+k Re[β] z micro]/.β->βeven/.x->-pico,
milli Abs[Ez[β,x] ]Cos[θEz[β,x]+k Re[β] z micro]/.β->βeven/.x->-pico}],{z,0,1},Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)","LR @ x = (SuperMinus[0])",StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},Evaluate[optX]]

FigExEzodd2=Plot[Evaluate[{
milli Abs[Ex[β,x]] Cos[θEx[β,x]+k Re[β] z micro]/.β->βodd/.x->-pico,
milli Abs[Ez[β,x] ]Cos[θEz[β,x]+k Re[β] z micro]/.β->βodd/.x->-pico}],{z,0,1},Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)","SR @ x = (SuperMinus[0])",StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},Evaluate[optX]]

FigExEz2=GraphicsRow[{FigExEzeven2,FigExEzodd2},
Frame->True,
ImageSize->1.2gr,
Spacings->-20]

The fields as phasors: x = -(Subscript[d, m])+

FigExEzeven3=Plot[Evaluate[{
milli Abs[Ex[β,x]] Cos[θEx[β,x]+k Re[β] z micro]/.β->βeven/.x->-dm+pico,
milli Abs[Ez[β,x] ]Cos[θEz[β,x]+k Re[β] z micro]/.β->βeven/.x->-dm+pico}],{z,0,1},Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)","LR @ x = -(SuperPlus[(Subscript[d, m])])",StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},Evaluate[optX]]

FigExEzodd3=Plot[Evaluate[{
milli Abs[Ex[β,x]] Cos[θEx[β,x]+k Re[β] z micro]/.β->βodd/.x->-dm+pico,
milli Abs[Ez[β,x] ]Cos[θEz[β,x]+k Re[β] z micro]/.β->βodd/.x->-dm+pico}],{z,0,1},Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)","SR @ x = -(SuperPlus[(Subscript[d, m])])",StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},Evaluate[optX]]

FigExEz3=GraphicsRow[{FigExEzeven3,FigExEzodd3},
Frame->True,
ImageSize->1.2gr,
Spacings->-20]

The fields as phasors: x = -(SuperMinus[(Subscript[d, m])])

FigExEzeven4=Plot[Evaluate[{
milli Abs[Ex[β,x]] Cos[θEx[β,x]+k Re[β] z micro]/.β->βeven/.x->-dm-pico,
milli Abs[Ez[β,x] ]Cos[θEz[β,x]+k Re[β] z micro]/.β->βeven/.x->-dm-pico}],
{z,0,1},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)","LR @ x = -(SuperMinus[(Subscript[d, m])])",StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},
Evaluate[optX]]

FigExEzodd4=Plot[Evaluate[{
milli Abs[Ex[β,x]] Cos[θEx[β,x]+k Re[β] z micro]/.β->βodd/.x->-dm-pico,
milli Abs[Ez[β,x] ]Cos[θEz[β,x]+k Re[β] z micro]/.β->βodd/.x->-dm-pico}],{z,0,1},Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs},FrameLabel->{"z (μm)","E ((10^3) V/m)","SR @ x = -(SuperMinus[(Subscript[d, m])])",StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},
Evaluate[optX]]

FigExEz4=GraphicsRow[{FigExEzeven4,FigExEzodd4},
Frame->True,
ImageSize->1.2gr,
Spacings->-20]

All the fields as phasors

Fig16=GraphicsGrid[{
{FigExEzeven1,FigExEzodd1},
{FigExEzeven2,FigExEzodd2},
{FigExEzeven3,FigExEzodd3},
{FigExEzeven4,FigExEzodd4}},
ImageSize->{500,600},
Spacings->{-30,10},
Frame->True]

|H(x=0)|: Both modes

FigHabs=Plot[{
milli Abs[Hy[βx[x nano,nc+.1],0]],
milli Abs[Hy[βx[x nano,1.2nc],0]],
milli Abs[Hy[βs,0]]},
{x,10, 40},
LabelStyle->{FontSize -> fs1},FrameLabel->{"(Subscript[d, m]) (nm)","|(Subscript[H, y])| (H/m)","x = 0 & x = -(Subscript[d, m])",""},Evaluate[optX],

Epilog->{
RGBColor[0,0,0],
Text[
"●",{dm/nano,milli Abs[Hy[βeven,0]]}],
Text[
"■",{dm/nano,milli Abs[Hy[βodd,0]]}]}]

|E(x=0)|: Both modes

FigEabs=Plot[{
milli Abs[Ex[βx[x nano,nc+.1],0]+Ez[βx[x nano,nc+.1],0]],
milli Abs[Ex[βx[x nano,1.2nc],0]+Ez[βx[x nano,1.2nc],0]],
milli Abs[Ex[βs,0]+Ez[βs,0]]},
{x,10, 40},
LabelStyle->{FontSize -> fs1},FrameLabel->{"(Subscript[d, m]) (nm)","|(Subscript[E, x])| (V/m)","x = 0 & x = -(Subscript[d, m])",""},Evaluate[optX],
Epilog->{
RGBColor[0,0,0],
Text[
"●",{dm/nano,milli Abs[Ex[βeven,0]+Ez[βeven,0]]}],
Text[
"■",{dm/nano,milli Abs[Ex[βodd,0]+Ez[βodd,0]]}]}]

|E(x=0)| and |H(x=0) | : Both modes

Fig12=GraphicsRow[{FigEabs,FigHabs},
Frame->True,
ImageSize->1.2gr,
Spacings->-40]

Local Poynting vectors

Clear[sz]
sz[β_,x_,pol_]:=If[pol==1,-(1/2)Re[Ey[β,x] Conjugate[Hx[β,x]]],(1/2)Re[Ex[β,x] Conjugate[Hy[β,x]]]]

Clear[sx]
sx[β_,x_,pol_]:=If[pol==1,(1/2)Re[Ey[β,x] Conjugate[Hz[β,x]]],-(1/2)Re[Ez[β,x] Conjugate[Hy[β,x]]]]

Integrated Poynting vectors

Clear[Scz]
Scz[β_,pol_]:=Chop[NIntegrate[sz[β,x,pol],{x,0,milli}]]

Clear[Smz]
Smz[β_,pol_]:=Chop[NIntegrate[sz[β,x,pol],{x,-dm,0}]]

Clear[Ssz]
Ssz[β_,pol_]:=Chop[NIntegrate[sz[β,x,pol],{x,-milli,-dm}]]

Clear[Scx]
Scx[β_,pol_]:=sx[β,0,pol](1/(2k Im[β]))

Clear[Ssx]
Ssx[β_,pol_]:=sx[β,-dm,pol](1/(2k Im[β]))

Table7=Grid[{
{"Mode","(Subscript[P, c,z])","(Subscript[P, m,z])","(Subscript[P, s,z])","(Subscript[P, z])"},
{"LR",Scz[βeven,p],Smz[βeven,p],Ssz[βeven,p],Round[Scz[βeven,p]+Smz[βeven,p]+Ssz[βeven,p]]}/.NSub,
{"SR",Scz[βodd,p],Smz[βodd,p],Ssz[βodd,p],Round[Scz[βodd,p]+Smz[βodd,p]+Ssz[βodd,p]]}/.NSub},Dividers->All,
ItemStyle->{fs,fs}]

Table8=Chop[Grid[{
{"Mode","(Subscript[P, c,x])","(Subscript[P, s,x])","(Subscript[P, x])"},
{"LR",Scx[βeven,p],Ssx[βeven,p],Scx[βeven,p]+Ssx[βeven,p]}/.NSub,
{"SR",Scx[βodd,p],Ssx[βodd,p],Scx[βodd,p]+Ssx[βodd,p]}/.NSub},Dividers->All,
ItemStyle->{fs,fs}]]

Poynting vectors

dd=micro;
dx=.4;
maxmin=Abs[sz[βeven,1 nano,2]]dd;
FigszLR=Plot[sz[βeven,x micro,2]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[s, z]) ((10^6) V/A)","LR",""},
PlotRange->{-1.1 maxmin,1.1 maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,-1.75}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,-1.}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,-1.75}]}]

dd=micro;
dx=.4;
maxmin=Abs[sz[βodd,1 nano,2]]dd;
FigszSR=Plot[sz[βodd,x micro,2]dd ,
{x,-dx,dx},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"x (μm)","(Subscript[s, z]) ((10^6) V/A)","SR",""},
PlotRange->{-1.1 maxmin,1.1 maxmin},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
Evaluate[optX],
Epilog->
{RGBColor[0,0,0],
Text[Style[
StringJoin["cover",ToString[""]],fs],{dx/2,-9}],
Text[Style[
StringJoin["metal",ToString[""]],fs],{0,-5}],
Text[Style[
StringJoin["substrate",ToString[""]],fs],{-dx/2,-9}]}]

Fig14=GraphicsRow[{FigszLR,FigszSR},
Frame->True,
ImageSize->1.2gr,
Spacings->-50]

Charge density in metal

Clear[netop]
netop[β_]:=
Re[(pico/e) ϵ0 (Ex[β,-pico]-Ex[β,pico])]/.NSub

Clear[nebottom,β]
nebottom[β_]:=Re[(pico/e)ϵ0(Ex[β,-dm-pico]-Ex[β,-dm+pico])]/.NSub

Table9=Grid[{
{"(Subscript[n, e]) (1/((μm)^2))","x = 0","x = -d"},
{"LR",netop[β],nebottom[β]}/.β->βeven,
{"MR",netop[β],""}/.β->βs,
{"SR",netop[β],nebottom[β]}/.β->βodd},Dividers->All,
ItemStyle->{fs,fs}]/.NSub

Charge density wave : Even mode

Clear[sin]
sin[z_,β_]:=Sin[z k Re[β] micro]

Figneeven=Plot[Evaluate[
{netop[βeven]sin[z,βeven],
(-dm/nano+nebottom[βeven]sin[z ,βeven])}],
{z,0,2},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs1},
FrameLabel->{"z (μm)","(Subscript[n, e]) (((μm)^2))"," LR",StringJoin["(Subscript[n, e]) = ",ToString[Abs[netop[βeven]]]]},PlotRange->{-30,10},
Evaluate[optX],
Epilog->{AbsoluteThickness[1.5],Line[{
{0,-dm/nano},
{2,-dm/nano},{2,0},
{0,0},{0,-dm/nano}}]}]

Charge density wave: Odd mode

Figneodd=Plot[Evaluate[
{ netop[βodd]sin[z ,βodd],
(-dm/nano+nebottom[β]sin[z ,β])}/.β->βodd],
{z,0,2},
Filling -> Axis,
FillingStyle -> Opacity[0.2],
LabelStyle->{FontSize -> fs1},FrameLabel->{"z (μm)","(Subscript[n, e]) (((μm)^2))","SR",StringJoin["(Subscript[n, e]) = ",ToString[Abs[netop[βodd]]]]},PlotRange->{-30,10},
Evaluate[optX],
Epilog->{AbsoluteThickness[1.5],Line[{
{0,-dm/nano},
{2,-dm/nano},{2,0},
{0,0},{0,-dm/nano}}]}]

Charge density wave: Both modes

Fig17=GraphicsRow[{Figneeven,Figneodd},
Frame->True,
ImageSize->1.2gr,
Spacings->-30]

Prism Coupling to DPS/ENG/DPS double interface guide

Angle and width in prism

Table10=Grid[{
{"Mode","β","(Subscript[θ, p]) (deg)","(Subscript[Γ, p]) (deg)"},
{"LR",β1,θx[β1]180/π,Γx[β1]180/π},
{"SR",β2,θx[β2]180/π,Γx[β2]180/π}},Dividers->All,
ItemStyle->{fs,fs}]

Spectrum

θmin=Max[θc,(θx[βeven]-20Γx[βeven])180/π];
θmax=(θx[βeven]+20Γx[βeven])180/π;

dcmin=500;
dcmax=1200;
dcmin=800;
dcmax=1600;
FigSpectra=Table[Plot[{
((Abs[Rpcms[dc nano,dm,θ π/180 ,p]])^2),L1[θ π/180,βeven]},{θ,θmin,θmax},
LabelStyle->{FontSize ->fs1},
PlotRange->{-.001,1.001},
FrameLabel->{"θ (deg)","ℛ",StringJoin["(Subscript[d, c]) = ",ToString[dc]," nm"],StringJoin["(Subscript[d, m]) = ",ToString[dm/nano]," nm"]},ImageSize->is,
Evaluate[optX],
Epilog->{RGBColor[0,0,0],
Text[Style[
"LR",fs],{θx[β1]180/π-.07,.5}]}],{dc,dcmin,dcmax,(dcmax-dcmin)/3.0}]

Fig22=GraphicsGrid[{
{FigSpectra[[1]],FigSpectra[[2]]},
{FigSpectra[[3]],FigSpectra[[4]]}},
Frame->True,
ImageSize->1.4gg,
Spacings->{-50,10}]

Mode solutions for β((Subscript[d, g]))

Clear[βevenx]
βevenx[dm_]:=FindRoot[(Tan[k κ[β]dm/2])==(((μm ϵm γ[β])/(μs ϵs κ[β]))),{β,nc+.1}][[1,2]]

Clear[βevenx]
βevenx[dm_]:= Chop[FindRoot[(Tan[k κ[β]dm])==(μm ϵm κ[β]((μc ϵc γ[β]+μs ϵs δ[ β])/(μs ϵs μc ϵc ((κ[β])^2)-((μm)^2)((ϵm)^2)γ[β] δ[β]))),{β,nc+.1}][[1,2]]]

Clear[βoddx]
βoddx[dm_]:=FindRoot[(Tan[k κ[β]dm/2])==(-((μs ϵs κ[β])/(μm ϵm γ[β]))),{β,2nc}][[1,2]]

Clear[βoddx]
βoddx[dm_]:= Chop[FindRoot[(Tan[k κ[β]dm])==(ϵm κ[β]((μc ϵc γ[β]+μs ϵs δ[ β])/(μs ϵs μc ϵc ((κ[β])^2)-((μm)^2)((ϵm)^2)γ[β] δ[β]))),{β,2nc}][[1,2]]]

Lorentzians for β((Subscript[d, m]))

Clear[θeveni]
θeveni[dm_]:=ArcSin[((βevenx[dm])/((Sqrt[μp]) (Sqrt[ϵp])))](180/π)

Clear[θevenx]
θevenx[dm_]:=Re[ArcSin[((βevenx[dm])/((Sqrt[μp]) (Sqrt[ϵp])))](180/π)]

Clear[θoddi]
θoddi[dm_]:=ArcSin[((βoddx[dm])/((Sqrt[μp])(Sqrt[ ϵp])))](180/π)

Clear[θoddx]
θoddx[dm_]:=Re[ArcSin[((βoddx[dm])/((Sqrt[μp]) (Sqrt[ϵp])))](180/π)]

Clear[Γevenx]
Γevenx[dm_]:=2Im[ArcSin[((βevenx[dm])/((Sqrt[μp]) (Sqrt[ϵp])))](180/π)]

Clear[Γoddx]
Γoddx[dm_]:=2Im[ArcSin[((βoddx[dm])/((Sqrt[μp]) (Sqrt[ϵp])))](180/π)]

Clear[g0evenx]
g0evenx[θ_,dm_]:=(1/π)((Γevenx[dm]/2)/((((θ-θevenx[dm]))^2)+(((Γevenx[dm]/2))^2)))

Clear[g0oddx]
g0oddx[θ_,dm_]:=(1/π)((Γoddx[dm]/2)/((((θ-θoddx[dm]))^2)+(((Γoddx[dm]/2))^2)))

Inverted, scaled Lorentzians for β((Subscript[d, m]))

Clear[g1evenx]
g1evenx[θ_,dm_]:=(1-((g0evenx[θ,dm])/(g0evenx[θevenx[dm],dm])))

Clear[g1oddx]
g1oddx[θ_,dm_]:=(1-((g0oddx[θ,dm])/(g0oddx[θoddx[dm],dm])))

Spectra for β((Subscript[d, m]))

dmx= 50 nano;
Clear[θmax,dcx]
θmax[dmx_]:=Min[90,Ceiling[θoddx[dmx]+4Γoddx[dmx]]]
FigSpectraAll2=Table[Plot[Evaluate[{
((Abs[Rpcms[dcx nano,dmx,θ π/180,p]])^2),
g1evenx[θ,dmx],
g1oddx[θ,dmx]}],
{θ,Floor[θc],θmax[dmx]},
PlotRange->{-.001,1.001},
LabelStyle->{FontSize -> fs1},
FrameLabel->{"(Subscript[θ, p]) (deg)","ℛ",
StringJoin["(Subscript[d, c]) = ",ToString[dcx]," nm"],StringJoin["(Subscript[d, m]) = ",ToString[dmx/nano]," nm"]},
Evaluate[optX],
Epilog->{RGBColor[0,0,0],
Text[Style[
"LR",fs],{θevenx[dmx]-.75,.5}],
Text[Style[
"SR",fs],{θoddx[dmx]-1.3,.5}]},DisplayFunction->Identity],{dcx,200,500,100}]

Fig23=GraphicsGrid[{
{FigSpectraAll2[[1]],FigSpectraAll2[[2]]},
{FigSpectraAll2[[3]],FigSpectraAll2[[4]]}},
Frame->True,
ImageSize->1.2gg,
Spacings->{-50,10}]

Tables

TableAll

Table1=TableChapter7

Table2

Table3

Table4

Table5

Table6

Table7

Table8

Table9

Table10

Figures

Fig3

Fig4

Fig5

Fig6

Fig7

Fig8

Fig9

Fig10

Fig11

Fig12

Fig14

Fig15

Fig16

Fig17

Fig19

Fig20

Fig21

Fig22

Fig23

Exercises

(1) Complete the missing items in Table 7.1 by developing the code, generating figures and discussing them. 
(2) Compare the advantages and disadvantages of using the general prism coupling configuration relative to the Otto and the Kretschmann configurations.

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] M. Fukui, V. C. Y. So and R. Normandin.  Lifetimes of surface plasmons in thin silver films.  Phys. Stat. Sol. (b) 91 (1979) K61.

[6] D. Sarid.  Long-range surface-plasma waves on very thin metal films.  Phys. Rev. Lett. 47 (1981) 1927.
[7] A. E. Craig, G. A. Olson and D. Sarid.  Experimental observation of the long-range surface-plasmon polariton.  Opt. Lett. 8 (1983) 380.
[8] P. Berini, R. Charbonneau and N. Laboud.  Long-Range surface plasmons on ultrathin membranes.  Nano Lett. 7 (2007) 1376.
[9] M. Mansuripur, A. R. Zakharian and J. V. Moloney.  Surface plasmon polaritons on metallic surfaces.  OPN 18 (2007) 44.
[10] R. Charbonneau, E. Lisicka-Shrzek and P. Berini.  Broadside coupling to long-range surface plasmons using an angle-cleaved optical fiber.  Appl. Phys. Lett. 92 (2008) 101102.
[11] A. Degiron, P. Berini and D. R. Smith.  Guiding light with long-range plasmons.  OPN 19 (2008) 29.