Файл:Wave guiding.gif

Матеріал з Вікіпедії — вільної енциклопедії.
Перейти до навігації Перейти до пошуку

Wave_guiding.gif(300 × 300 пікселів, розмір файлу: 5 МБ, MIME-тип: image/gif, кільцеве, 68 кадрів, 6,8с)

Wikimedia Commons logo Відомості про цей файл містяться на Вікісховищі — централізованому сховищі вільних файлів мультимедіа для використання у проектах Фонду Вікімедіа.

Опис файлу

Опис
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.
Час створення
Джерело https://twitter.com/j_bertolotti/status/1448566344702730245
Автор Jacopo Bertolotti
Ліцензія
(Повторне використання цього файлу)
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]

Ліцензування

Я, власник авторських прав на цей твір, добровільно публікую його на умовах такої ліцензії:
Creative Commons CC-Zero Цей файл доступний на умовах Creative Commons CC0 1.0 Universal Public Domain Dedication.
Особа, що пов'язала роботу з даною дією, передала роботу у суспільне надбання шляхом відмови від усіх своїх прав на роботу по всьому світу по закону про авторське право, включаючи всі пов'язані і суміжні права, в тій мірі, що допускається законом.

Ви можете копіювати, змінювати, розповсюджувати і виконувати роботу, навіть на комерційній основі, не питаючи дозволу.

Підписи

Додайте однорядкове пояснення, що саме репрезентує цей файл
Visualization of how light from a point source can be guided though several guides.

Об'єкти, показані на цьому файлі

зображує

Історія файлу

Клацніть на дату/час, щоб переглянути, як тоді виглядав файл.

Дата/часМініатюраРозмір об'єктаКористувачКоментар
поточний14:42, 15 жовтня 2021Мініатюра для версії від 14:42, 15 жовтня 2021300 × 300 (5 МБ)BertoUploaded own work with UploadWizard

Така сторінка використовує цей файл:

Глобальне використання файлу

Цей файл використовують такі інші вікі:

Метадані