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]

Yo, el titular de los derechos de autor de esta obra, la publico en los términos de la siguiente licencia:

Este archivo está disponible bajo la licencia Creative Commons Dedicación de Dominio Público CC0 1.0 Universal.

La persona que ha asociado una obra a este documento lo dedica al dominio público mediante la cesión mundial de sus derechos bajo la ley de derechos de autor y todos los derechos legales adyacentes propios de dicha, en el ámbito permitido por ley. Puedes copiar, modificar, distribuir y reproducir el trabajo, incluso con objetivos comerciales, sin pedir aprobación del autor. http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse

Este archivo, el cual fue publicado originalmente en https://twitter.com/j_bertolotti/status/1030470604418428929, fue revisado el 21 December 2018 por el revisor Ronhjones, quien confirmó que en esa fecha estaba disponible bajo la licencia indicada.