概要

 

この 図式はMathematicaで作成されました。

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