概要
(*Source code written in Mathematica 6.0 by Steve Byrnes, March 2011. This source code is public domain.*)
(*Shows schematic electron wavefunctions for 1s orbital of hydrogen atom, and 1s bonding and
antibonding orbitals of hydrogen molecule. Plotted as a 1D slice of a 3D system.
All graphs are schematic: I'm not actually solving the Schrodinger equation, but hopefully it looks like I did. *)
ClearAll["Global`*"]
(***Oscillation frequencies, in units of oscillations per cycle of the animated gif***)
sfreq = 4;
bondfreq = 3;
antibondfreq = 5;
(***Wavefunction normalization coefficients***)
scoef = 0.893;
bondcoef = 0.618;
antibondcoef = 0.646;
(***Define wavefunctions***)
s[x_, t_] := scoef * Exp[-(x - 1.25)^2]*Exp[-2*Pi*I*sfreq*t];
bond[x_, t_] := bondcoef * (Exp[-x^2] + Exp[-(x - 2.5)^2]) * Exp[-2*Pi*I*bondfreq*t];
antibond[x_, t_] := antibondcoef * (Exp[-x^2] - Exp[-(x - 2.5)^2]) * Exp[-2*Pi*I*antibondfreq*t];
(***Make individual graphs***)
SetOptions[Plot, {Ticks -> None, PlotStyle -> {Directive[Thick, Blue], Directive[Thick, Pink]},
Axes -> {True, False}, PlotRange -> {{-2.5, 5}, {-1, 1}},
AspectRatio -> 1.1}, Frame -> True, FrameTicks -> None];
SetOptions[ListPlot, {Ticks -> None, PlotStyle -> Directive[Red, AbsolutePointSize[10]]}, Axes -> {True, False}];
OneProton = ListPlot[{{1.25, 0}}];
TwoProtons = ListPlot[{{0, 0}, {2.5, 0}}];
SWaves[t_] := Plot[{Re[s[x, t]], Im[s[x, t]]}, {x, -2.5, 5}];
BondWaves[t_] := Plot[{Re[bond[x, t]], Im[bond[x, t]]}, {x, -2.5, 5}];
AntibondWaves[t_] := Plot[{Re[antibond[x, t]], Im[antibond[x, t]]}, {x, -2.5, 5}];
SPlot[t_] := Show[SWaves[t], OneProton];
BondPlot[t_] := Show[BondWaves[t], TwoProtons];
AntibondPlot[t_] := Show[AntibondWaves[t], TwoProtons];
(***Draw all graphs together, arranged in the shape of a molecular orbital diagram***)
TotalPlot[t_] :=
Graphics[{White, Rectangle[{0, 0}, {1.5, 1}],
Inset[SPlot[t], ImageScaled[{0, 0.5}], ImageScaled[{0, 0.5}], .45],
Inset[SPlot[t], ImageScaled[{1, 0.5}], ImageScaled[{1, 0.5}], .45],
Inset[BondPlot[t], ImageScaled[{0.5, 0}], ImageScaled[{0.5, 0}], .45],
Inset[AntibondPlot[t], ImageScaled[{0.5, 1}], ImageScaled[{0.5, 1}], .45]}, ImageSize -> 300]
(***Export animation***)
output = Table[TotalPlot[t], {t, 0, 90/91, 1/91}];
SetDirectory["C:\\Users\\Steve\\Desktop"]
Export["test.gif", output]
ライセンス
この作品の著作権者である私は、この作品を以下のライセンスで提供します。
|
このファイルはクリエイティブ・コモンズ CC0 1.0 全世界 パブリック・ドメイン提供のもとで利用可能にされています。
|
ある作品に本コモンズ証を関連づけた者は、その作品について世界全地域において著作権法上認められる、その者が持つすべての権利(その作品に関する権利や隣接する権利を含む。)を、法令上認められる最大限の範囲で放棄して、パブリック・ドメインに提供しています。
この作品は、たとえ営利目的であっても、許可を得ずに複製、改変・翻案、配布、上演・演奏することが出来ます。
http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse
|