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 = 20; (*number of layers in the Bragg mirror*)
s = Join[Table[1., 4*dim], Table[If[EvenQ[j], 1., 5.], {j, 1, dim}]] (*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) \[Sigma] /. {w0 -> 2.182 10^15, \[Sigma] -> (15 10^-6)/c};
nstep = 1500;
\[Omega]min = 1. 10^15;
\[Omega]max = 3. 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]; (*Fourier transform with respect of frequncy to get the time evolution*)
p1 = Table[
ListPlot[Re@Reverse@fssm[[All, -j]], PlotRange -> {-10 10^-14, 10 10^-14}, Joined -> True, Axes -> False, PlotStyle -> {Thick, Orange}, Epilog -> {Dashed, Black, Thick, Line[{{4/5 dim*sexpand, -10 10^-14}, {4/5 dim*sexpand, 10 10^-14}}], Text[Style["Bragg\n mirror", Medium, Bold], {4.5/5 dim*sexpand, 9 10^-14}]} ], {j, -50, 200, 1}];
ListAnimate[p1, 10]

Я, власник авторських прав на цей твір, добровільно публікую його на умовах такої ліцензії:

Цей файл доступний на умовах Creative Commons CC0 1.0 Universal Public Domain Dedication.

Особа, що пов'язала роботу з даною дією, передала роботу у суспільне надбання шляхом відмови від усіх своїх прав на роботу по всьому світу по закону про авторське право, включаючи всі пов'язані і суміжні права, в тій мірі, що допускається законом. Ви можете копіювати, змінювати, розповсюджувати і виконувати роботу, навіть на комерційній основі, не питаючи дозволу. http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse

Цей файл, був спочатку опублікований на зовнішньому сайті https://twitter.com/j_bertolotti/status/1030470604418428929, був перевірений 15 грудня 2018 перевіряючим Ronhjones, який підтвердив, що у ту дату файл був там доступний на умовах зазначеної ліцензії.