Este diagrama foi criado com o Mathematica por n

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

Eu, titular dos direitos de autor desta obra, publico-a com a seguinte licença:

A utilização deste ficheiro é regulada nos termos Creative Commons - CC0 1.0 Dedicação Universal ao Domínio Público.

A pessoa que associou uma obra a este documento dedicou-a ao domínio público, renunciando a todos os seus direitos sobre a obra em todo o mundo ao abrigo da legislação de direitos de autor, incluindo a todos os direitos legais conexos, na medida permitida por lei. Pode copiar, modificar, distribuir e executar a obra, até com fins comerciais, sem pedir autorização. http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse