概要
(*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 |