Zum Inhalt springen

Datei:Wave guiding.gif

Seiteninhalte werden in anderen Sprachen nicht unterstützt.
Zur Beschreibungsseite auf Commons
aus Wikipedia, der freien Enzyklopädie

Wave_guiding.gif (300 × 300 Pixel, Dateigröße: 5 MB, MIME-Typ: image/gif, Endlosschleife, 68 Bilder, 6,8 s)

Diese Datei und die Informationen unter dem roten Trennstrich werden aus dem zentralen Medienarchiv Wikimedia Commons eingebunden.

Zur Beschreibungsseite auf Commons


Beschreibung

Beschreibung
English: You can guide light with a waveguide. You can also couple the waveguide with a ring resonator, where the light will circulate. And if you attach a second waveguide to the ring resonator you can effectively move the light from one waveguide to the other.
Datum
Quelle https://twitter.com/j_bertolotti/status/1448566344702730245
Urheber Jacopo Bertolotti
Genehmigung
(Weiternutzung dieser Datei)
https://twitter.com/j_bertolotti/status/1030470604418428929

Mathematica 12.0 code

\[Lambda]0 = 1.; k0 =  N[(2 \[Pi])/\[Lambda]0]; (*The wavelength in vacuum is set to 1, so all lengths are now in units of wavelengths*)
\[Delta] = \[Lambda]0/20; \[CapitalDelta] = 50*\[Lambda]0; (*Parameters for the grid*) \[Sigma] = 10 \[Lambda]0; (*width of the gaussian beam*)
sourcef[x_, y_] :=E^(-((x + \[CapitalDelta]/8)^2 + (y + \[CapitalDelta]/3)^2)/(2 (\[Lambda]0/5)^2));
\[Phi]in = Table[Chop[sourcef[x, y]], {x, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}, {y, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}]; (*Discretized source*)
d = \[Lambda]0/2; (*typical scale of the absorbing layer*)
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[\[Phi]in][[1]];
L = -1/\[Delta]^2*KirchhoffMatrix[GridGraph[{dim, dim}]]; (*Discretized Laplacian*)
ReMapC[x_] := RGBColor[(2 x - 1) UnitStep[x - 0.5], 0, (1 - 2 x) UnitStep[0.5 - x]];

frames1 = Table[
  ren = Clip[
    Table[If[-\[Lambda]0 - \[CapitalDelta]/8 < x < \[Lambda]0 - \[CapitalDelta]/8, \[Alpha], 1], {x, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}, {y, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}], {1, 2}];
  n = ren + I imn;
  b = -(Flatten[n]^2 - 1) k0^2 Flatten[\[Phi]in]; (*Right-hand side of the equation we want to solve*)
  M = L + DiagonalMatrix[
     SparseArray[Flatten[n]^2 k0^2]]; (*Operator on the left-
  hand side of the equation we want to solve*)
  \[Phi]s = Partition[LinearSolve[M, b], dim]; (*Solve the linear system*)
ImageAdd[
   MatrixPlot[Transpose[(Re[(\[Phi]in + \[Phi]s)]/Max[Abs@Re[\[Phi]in + \[Phi]s][[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]]])][[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]], ColorFunction -> ReMapC, DataReversed -> True, Frame -> False, PlotRange -> {-1, 1}]
   ,
   ArrayPlot[Transpose[Re[(n - 1)/5]] [[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]], DataReversed -> True , ColorFunctionScaling -> False, ColorFunction -> GrayLevel, Frame -> False]
   ]
  , {\[Alpha], 1, 2, 1/10}]

frames2 = 
 Table[ren = Clip[Table[If[-\[Lambda]0 - \[CapitalDelta]/8 < x < \[Lambda]0 - \[CapitalDelta]/8, 2, 1], {x, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}, {y, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}] + Table[If[\[CapitalDelta]/2 - 6*\[Lambda]0 < (x - \[CapitalDelta]/8 - \[Lambda]0/4 + \[CapitalDelta]/8 + (-(\[CapitalDelta]/1.7) (t - 1)^4))^2 + (y)^2 < \[CapitalDelta]/2 + 6*\[Lambda]0, 1, 0], {x, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}, {y, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}], {1, 2}];
  n = ren + I imn;
  b = -(Flatten[n]^2 - 1) k0^2 Flatten[\[Phi]in]; (*Right-hand side of the equation we want to solve*)
  M = L + DiagonalMatrix[SparseArray[Flatten[n]^2 k0^2]]; (*Operator on the left-hand side of the equation we want to solve*)
  \[Phi]s = Partition[LinearSolve[M, b], dim]; (*Solve the linear system*)
  ImageAdd[
   MatrixPlot[Transpose[(Re[(\[Phi]in + \[Phi]s)]/Max[Abs@Re[\[Phi]in + \[Phi]s][[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]]])][[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]], ColorFunction -> ReMapC, DataReversed -> True, Frame -> False, PlotRange -> {-1, 1}]
   ,
   ArrayPlot[Transpose[Re[(n - 1)/5]] [[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]], DataReversed -> True , ColorFunctionScaling -> False, ColorFunction -> GrayLevel, Frame -> False]
   ]
  , {t, 0, 1, 1/10}]

frames3 = 
 Table[ren = Clip[Table[If[-\[Lambda]0 - \[CapitalDelta]/8 < x < \[Lambda]0 - \[CapitalDelta]/8, 2, 1], {x, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}, {y, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}] + Table[If[\[CapitalDelta]/2 - 6*\[Lambda]0 < (x - \[CapitalDelta]/8 - \[Lambda]0/4 + \[CapitalDelta]/8)^2 + (y)^2 < \[CapitalDelta]/2 + 6*\[Lambda]0, 1, 0], {x, -\[CapitalDelta]/2, \[CapitalDelta]/       2, \[Delta]}, {y, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}] + Table[If[-\[Lambda]0 + \[CapitalDelta]/4 + \[Lambda]0/2 - \[CapitalDelta]/8 + (\[CapitalDelta]/1.7 (t - 1)^4) < x < \[Lambda]0 + \[CapitalDelta]/4 + \[Lambda]0/2 - \[CapitalDelta]/8 + (\[CapitalDelta]/1.7 (t - 1)^4), 1, 0], {x, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}, {y, -\[CapitalDelta]/2, \[CapitalDelta]/2, \[Delta]}], {1, 2}];
  n = ren + I imn;
  b = -(Flatten[n]^2 - 1) k0^2 Flatten[\[Phi]in]; (*Right-hand side of the equation we want to solve*)
  M = L + DiagonalMatrix[SparseArray[Flatten[n]^2 k0^2]]; (*Operator on the left-hand side of the equation we want to solve*)
  \[Phi]s = Partition[LinearSolve[M, b], dim]; (*Solve the linear system*)
  ImageAdd[
   MatrixPlot[Transpose[(Re[(\[Phi]in + \[Phi]s)]/Max[Abs@Re[\[Phi]in + \[Phi]s][[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]]])][[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]], ColorFunction -> ReMapC, DataReversed -> True, Frame -> False, PlotRange -> {-1, 1}]
   ,
   ArrayPlot[Transpose[Re[(n - 1)/5]] [[(4 d)/\[Delta] ;; (-4 d)/\[Delta], (4 d)/\[Delta] ;; (-4 d)/\[Delta]]], DataReversed -> True , ColorFunctionScaling -> False, ColorFunction -> GrayLevel, Frame -> False]
   ]
  , {t, 0, 1, 1/10}]

ListAnimate[Join[
  Table[frames1[[1]], {5}], frames1,
  Table[frames2[[1]], {5}], frames2,
  Table[frames3[[1]], {5}], frames3, Table[frames3[[-1]], {20}]
  ], ImageSize -> Medium]

Lizenz

Ich, der Urheber dieses Werkes, veröffentliche es unter der folgenden Lizenz:
Creative Commons CC-Zero 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.

Kurzbeschreibungen

Ergänze eine einzeilige Erklärung, was diese Datei darstellt.
Visualization of how light from a point source can be guided though several guides.

In dieser Datei abgebildete Objekte

Motiv

image/gif

Dateiversionen

Klicke auf einen Zeitpunkt, um diese Version zu laden.

Version vomVorschaubildMaßeBenutzerKommentar
aktuell16:42, 15. Okt. 2021Vorschaubild der Version vom 16:42, 15. Okt. 2021300 × 300 (5 MB)BertoUploaded own work with UploadWizard

Keine Seiten verwenden diese Datei.

Globale Dateiverwendung

Die nachfolgenden anderen Wikis verwenden diese Datei:

Metadaten