Fil:Multiple Scattering.gif
Sidans innehåll stöds inte på andra språk.
Från Wikipedia
Multiple_Scattering.gif (609 × 336 pixlar, filstorlek: 4,21 Mbyte, MIME-typ: image/gif, upprepad, 131 bildrutor, 13 s)
Denna fil tillhandahålls av Wikimedia Commons. Informationen nedan är kopierad från dess filbeskrivningssida. |
Sammanfattning
BeskrivningMultiple Scattering.gif |
English: A pulse of light scrambled by a random collection of scatterers. |
Datum | |
Källa | https://twitter.com/j_bertolotti/status/1460637298035503109 |
Skapare | Jacopo Bertolotti |
Tillstånd (Återanvändning av denna fil) |
https://twitter.com/j_bertolotti/status/1030470604418428929 |
Mathematica 12.0 code
c = 1; (*speed of light*)
\[Omega]min = 1.; \[Omega]max = 5.;
\[Omega]0 = Mean[{\[Omega]min, \[Omega]max}]; \[Sigma]0 = (\[Omega]max - \[Omega]min)/10;
amplitude[w_] := E^(-(1/(2 \[Sigma]0^2)) ((w - \[Omega]0)^2) );
k0 = N[\[Omega]0/c]; \[Lambda]0 = N[(2 \[Pi])/k0]; d = \[Lambda]0/2; (*typical scale of the absorbing layer*)
\[Delta] = \[Lambda]0/10; \[CapitalDelta] = 30*\[Lambda]0; (*Parameters for the grid*)
ReMapC[x_] := RGBColor[(2 x - 1) UnitStep[x - 0.5], 0, (1 - 2 x) UnitStep[0.5 - x]];
imn = Table[
Chop[5 (E^-((x + \[CapitalDelta]/2)/d) + E^((x - \[CapitalDelta]/2)/d) + E^-((y + \[CapitalDelta]/2)/d) + E^((y - \[CapitalDelta]/2)/d))], {x, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}, {y, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}]; (*Imaginary part of the refractive index (used to emulate absorbing boundaries)*)
dim = Dimensions[imn][[1]];
L = -1/\[Delta]^2*KirchhoffMatrix[GridGraph[{dim, dim}]]; (*Discretized Laplacian*)
ren0 = 1.5 - 1;
ren = ren0*Clip[ Total[ Table[ RotateRight[ DiskMatrix[3, dim], {RandomInteger[{0, dim}], RandomInteger[{Round[dim/8], Round[dim/2] - 5}]}], {150}] ], {0, 1}] + 1;
n = ren + I imn;
\[Sigma] = 2 \[Lambda]0;
sourcef[x_, y_, w_] := Sqrt[w/c] E^(-(x^2/(2 \[Sigma]^2))) E^(-((y + \[CapitalDelta]/2)^2/(2 (\[Lambda]0/2)^2))) E^(I w/c y);
\[Delta]\[Omega] = (\[Omega]max - \[Omega]min)/200;
\[Phi] = Table[
\[Phi]in = Table[amplitude[\[Omega]]*sourcef[x, y, \[Omega]] , {x, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}, {y, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}];
b = -(Flatten[n]^2 - 1) (\[Omega]/c)^2 Flatten[\[Phi]in]; (*Right-hand side of the equation we want to solve*)
M = L + DiagonalMatrix[ SparseArray[Flatten[n]^2 (\[Omega]/c)^2]]; (*Operator on the left-hand side of the equation we want to solve*)
Partition[LinearSolve[M, b], dim], {\[Omega], \[Omega]min, \[Omega]max, 1*\[Delta]\[Omega]}];
\[Phi]dim = Dimensions[\[Phi]][[1]];
frames = Table[
Grid[{{Style["Re(E)", White, Bold, Large], Style["|E\!\(\*SuperscriptBox[\(|\), \(2\)]\)", White, Bold, Large]}, {
ImageAdd[
ArrayPlot[
Transpose[(Re@Total[Table[\[Phi][[j]] E^(I (\[Omega]min + \[Delta]\[Omega] (j - 1) ) t), {j, 1, \[Phi]dim}] ][[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]])/3], DataReversed -> True, Frame -> False, PlotRange -> {-1, 1}, LabelStyle -> {Black, Bold}, ColorFunctionScaling -> True, ColorFunction -> ReMapC, ClippingStyle -> {Blue, Red}, ImageSize -> 300, Background -> Black]
,
ArrayPlot[Transpose[(ren - 1)/5] , DataReversed -> True , ColorFunctionScaling -> False, ColorFunction -> GrayLevel, Frame -> False]
]
,
ImageAdd[
ArrayPlot[ Transpose[((Abs@Total[Table[\[Phi][[j]] E^(I (\[Omega]min + \[Delta]\[Omega] (j - 1) ) t), {j, 1, \[Phi]dim}] ][[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]])/3)^2], DataReversed -> True, Frame -> False, PlotRange -> {0, 1}, LabelStyle -> {Black, Bold}, ColorFunctionScaling -> True, ColorFunction -> "AvocadoColors", ClippingStyle -> White, Background -> Black, ImageSize -> 300]
,
ArrayPlot[Transpose[(ren - 1)/5] , DataReversed -> True , ColorFunctionScaling -> False, ColorFunction -> GrayLevel, Frame -> False]
]
}}, Background -> Black]
, {t, 50, -80, -1}];
ListAnimate[frames]
Licensiering
Jag, upphovsrättsinnehavaren av detta verk, publicerar härmed det under följande licens:
Denna fil har gjorts tillgänglig under licensen Creative Commons CC0 1.0 Universal Public Domain Dedication. | |
Personen som kopplade ett verk till detta dokument har tillägnat arbetet till Allmänheten genom att, i den utsträckning som tillåts i lag, avstå från alla sina rättigheter till verket i hela världen som han eller hon skulle haft för verket enligt upphovsrätten och alla relaterade eller närliggande juridiska rättigheter. Du kan kopiera, modifiera, sprida och visa upp verket, även för kommersiella ändamål, utan att fråga efter godkännande från upphovsmannen.
http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse |
Objekt som porträtteras i den här filen
motiv
Denna egenskap har ett värde, men det är okänt
16 november 2021
image/gif
Filhistorik
Klicka på ett datum/klockslag för att se filen som den såg ut då.
Datum/Tid | Miniatyrbild | Dimensioner | Användare | Kommentar | |
---|---|---|---|---|---|
nuvarande | 17 november 2021 kl. 11.07 | 609 × 336 (4,21 Mbyte) | Berto | Uploaded own work with UploadWizard |
Filanvändning
Följande sida använder den här filen:
Global filanvändning
Följande andra wikier använder denna fil:
- Användande på en.wikipedia.org
- Användande på www.wikidata.org
Metadata
Den här filen innehåller extrainformation som troligen lades till av en digitalkamera eller skanner när filen skapades. Om filen har modifierats kan det hända att vissa detaljer inte överensstämmer med den modifierade filen.
GIF-filkommentar | Created with the Wolfram Language : www.wolfram.com |
---|