c = 3 10^8; (*speed of light*)
M[n_, k_, d_] := {{Cos[n k d], I c/n Sin[n k d]}, {I n/c Sin[n k d], Cos[n k d]}}; (*transfer matrix*)
Mi[n_, k_, d_] := {{Cos[d k n], -((I c Sin[d k n])/n)}, {-((I n Sin[d k n])/c), Cos[d k n]}}; (*Inverse of a transfer matrix*)
t[m_, n0_, n2_] := (2 n0/c)/(n2/c m[[1, 1]] - (n0 n2)/c^2 m[[1, 2]] - m[[2, 1]] + n0/c m[[2, 2]]); (*transmission coefficient*)
d = 1 10^-6; (*layer thickness in m*)
dim = 6; (*number of layers in the Bragg mirror*)
s = Join[Table[1., 50], Table[If[EvenQ[j], 1., 2.], {j, 1, dim}], {1, 1}, Table[If[EvenQ[j], 1., 2.], {j, 1, dim}], Table[1., 50]] ;(*Reflective indices of each layer (including some space to show the pulse arrive*)
dim = Dimensions[s][[1]];
source = E^(-(1/2) (w - w0)^2 \[Sigma]^2) /. {w0 -> 2.185 10^15, \[Sigma] -> (10 10^-6)/c, a -> 10^12};
nstep = 2000;
\[Omega]min = 1.9 10^15;
\[Omega]max = 2.8 10^15;
sourcel = Table[source, {w, \[Omega]min, \[Omega]max, (\[Omega]max - \[Omega]min)/nstep}];
trasm = Reap[ For[\[Omega] = \[Omega]min, \[Omega] <= \[Omega]max, \[Omega] = \[Omega] + (\[Omega]max - \[Omega]min)/nstep,
tm = Apply[Dot, Table[M[s[[j]], \[Omega]/c, d], {j, 1, dim}]];
      Sow[N[t[tm, 1, 1]] ];
      ];][[2, 1]];
field = trasm*sourcel; (*Field at the last interface*)
sexpand = 5; (*increase spatial resolution*)
s2 = Flatten@Table[Table[s[[j]], sexpand], {j, 1, dim}];
freq = Table[j, {j, \[Omega]min, \[Omega]max, (\[Omega]max - \[Omega]min)/nstep}];
fn = Transpose[{field, field/c}];
tmp0 = fn;
ssm = Reap[For[i = dim*sexpand, i > 0, i--,
      tmp = Table[((Mi[s2[[i]], freq/c, d/sexpand])[[All, All, j]].tmp0[[j]]), {j, 1, nstep}];
      Sow[tmp[[All, 1]]];
      tmp0 = tmp;
      ];][[2, 1]];
fssm = Map[Fourier, ssm]; 
p1 = Table[
   ListPlot[{Re@Reverse@fssm[[All, -j]], Abs@Reverse@fssm[[All, -j]], -Abs@Reverse@fssm[[All, -j]]}, PlotRange -> {-7, 7}, Joined -> True, Axes -> False, PlotStyle -> {Directive[Orange], Directive[Thick, Black], Directive[Thick, Black]}, Epilog -> {Dashed, Black, Thick, Line[{{50*sexpand, -3}, {50*sexpand, 3}}], Line[{{64*sexpand, -3}, {64*sexpand, 3}}], Text[Style["Microcavity", Medium, Bold], 57*sexpand,         5}]} ], {j, -15, 200, 1}];
ListAnimate[Drop[p1, {16}], 10]

我，本作品的著作權持有者，決定用以下授權條款發佈本作品：

	此檔案在創用CC CC0 1.0 通用公有領域貢獻宣告之下分發。
	在此宣告之下分發本作品者，已依據各國著作權法，在全世界放棄其對本作品所擁有的著作權及所有相關相似的法律權利，從而將本作品貢獻至公有領域。您可以複製、修改、分發和演示該作品，用於任何商業用途，所有這些都不需要請求授權。 http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse

圖片審查員Ronhjones，確認本圖片於2018年12月21日可在下列站點找到並符合所選許可證： https://twitter.com/j_bertolotti/status/1030470604418428929