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]

Ich, der Urheber dieses Werkes, veröffentliche es unter der folgenden Lizenz:

Diese Datei wird unter der Creative-Commons-Lizenz CC0 1.0 Verzicht auf das Copyright zur Verfügung gestellt.

Die Person, die das Werk mit diesem Dokument verbunden hat, übergibt dieses weltweit der Gemeinfreiheit, indem sie alle Urheberrechte und damit verbundenen weiteren Rechte – im Rahmen der jeweils geltenden gesetzlichen Bestimmungen – aufgibt. Das Werk kann – selbst für kommerzielle Zwecke – kopiert, modifiziert und weiterverteilt werden, ohne hierfür um Erlaubnis bitten zu müssen. http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse

Diese Datei, die ursprünglich auf https://twitter.com/j_bertolotti/status/1030470604418428929 veröffentlicht wurde, wurde am 21. Dezember 2018 vom vertrauenswürdigen Benutzer Ronhjones geprüft, welcher bestätigt, dass die Datei am angegebenen Tag unter der genannten Lizenz verfügbar war.