H2stat.nb

(* 2 H atoms  20.10.2012 ES *)
Clear[R,d,i,T,Vne,Vnn,Vee,r,r1,r2,func];
sig=0.4165;  n=21;
d = (1.025-0.025*i)*R;
T = (9/4)/R^2;
Vne = -2*(1.5-0.5*((d-r)/R)^2)/R-2/(r+d);
If[d+r < R, Vne = -2*(1.5-0.5*((d-r)/R)^2)/R-2*(1.5-0.5*((d+r)/R)^2)/R];
Vnn=1/(2*r);
Vee=(1.2-0.5*(2*d/R)^2+(3/16)*(2*d/R)^3-(1/160)*(2*d/R)^5)/R;
(* If[d > R, Vner = -2/d]; *)
func = T + Vne + Vnn + Vee; 
t=Table[FindMinimum[func, {R, 1.0}, {r,0.1}, {MaxIterations -> 500}],{i,1,n}]

Q=Table[t[[{i},2,1]],{i,1,n}];
P=Table[t[[{i},2,2]],{i,1,n}];
B=Table[t[[i,1]],{i,1,n}]
Vir=Table[-(Vne+Vnn+Vee)/T /. t[[{i},2]],{i,1,n}]

Do[Show[Graphics[{Circle[{-d /. Q[[i]],0},R /. Q[[i]]],Circle[{d /. Q[[i]],0},R  /. Q[[i]]],Circle[{-d /. Q[[i]],0},0.06],Circle[{d /. Q[[i]],0},0.06], Disk[{-r /. P[[i]],0},0.06],Disk[{r /. P[[i]],0},0.06],Disk[{-d /. Q[[i]],10*(B[[i]]+1.0)-1.21},0.06],Disk[{d /. Q[[i]],10*(B[[i]]+1.0)-1.21},0.06]}],{AspectRatio -> Automatic,PlotRange -> {{-3,3},{-3.5,2}}, Frame -> True}],{i,1,n}]

[Graphics:Images/H2stat_gr_4.gif]

[Graphics:Images/H2stat_gr_5.gif]

[Graphics:Images/H2stat_gr_6.gif]

[Graphics:Images/H2stat_gr_7.gif]

[Graphics:Images/H2stat_gr_8.gif]

[Graphics:Images/H2stat_gr_9.gif]

[Graphics:Images/H2stat_gr_10.gif]

[Graphics:Images/H2stat_gr_11.gif]

[Graphics:Images/H2stat_gr_12.gif]

[Graphics:Images/H2stat_gr_13.gif]

[Graphics:Images/H2stat_gr_14.gif]

[Graphics:Images/H2stat_gr_15.gif]

[Graphics:Images/H2stat_gr_16.gif]

[Graphics:Images/H2stat_gr_17.gif]

[Graphics:Images/H2stat_gr_18.gif]

[Graphics:Images/H2stat_gr_19.gif]

[Graphics:Images/H2stat_gr_20.gif]

[Graphics:Images/H2stat_gr_21.gif]

[Graphics:Images/H2stat_gr_22.gif]

[Graphics:Images/H2stat_gr_23.gif]

[Graphics:Images/H2stat_gr_24.gif]

sig=0.4165; u=21; s=0.525;
d = (s-0.025*i)*R;
T = (9/4)/R^2;
Vnn=1/(2*r);
Vee=1.0*(1.2-0.5*(2*d/R)^2+(3/16)*(2*d/R)^3-(1/160)*(2*d/R)^5)/R;
Vne = 2*(-(1.5-0.5*((d-r)/R)^2)/R-(1.5-0.5*((d+r)/R)^2)/R);

func = T + Vne + Vnn + Vee; 
t=Table[FindMinimum[func, {R,1.44}, {r,0.72}, {MaxIterations -> 500}], {i,1,u}]

Vir=Table[-(Vne+Vnn+Vee)/T /. t[[{i},2]],{i,1,u}]

Q=Table[t[[{i},2,1]],{i,1,u}];
P=Table[t[[{i},2,2]],{i,1,u}];
B=Table[t[[i,1]],{i,1,u}]

Do[Show[Graphics[{Circle[{-(s-0.025*i)*R /. Q[[i]],0},R /. Q[[i]]],Circle[{(s-0.025*i)*R /. Q[[i]],0},R /. Q[[i]]],Circle[{-(s-0.025*i)*R /. Q[[i]],0},0.06],Circle[{(s-0.025*i)*R /. Q[[i]],0},0.06], Disk[{r /. P[[i]],0},0.06],Disk[{-r /. P[[i]],0},0.06],Disk[{(s-0.025*i)*R /. Q[[i]],10*(B[[i]]+1.0)-1.21},0.06],Disk[{-(s-0.025*i)*R /. Q[[i]],10*(B[[i]]+1.0)-1.21},0.06]}],{AspectRatio -> Automatic,PlotRange -> {{-3,3},{-3.5,2}}, Frame -> True}],{i,1,u}]

[Graphics:Images/H2stat_gr_28.gif]