(* 2 H atoms  20.10.2012/05.10.13 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}]
[Graphics:Images/H2statC11_gr_1.gif]
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}]
[Graphics:Images/H2statC11_gr_2.gif]
[Graphics:Images/H2statC11_gr_3.gif]
Do[Show[Graphics[{{RGBColor[1,0,0],Circle[{-d /. Q[[i]],0},R /. Q[[i]]]},{RGBColor[0,0,1],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],{RGBColor[1,0,1],Disk[{-d /. Q[[i]],10*(B[[i]]+1.0)-2},0.06],Disk[{d /. Q[[i]],10*(B[[i]]+1.0)-2},0.06]}}],{AspectRatio -> Automatic,PlotRange -> {{-3,3},{-4.2,1.5}}, Frame -> True}],{i,1,n}]

[Graphics:Images/H2statC11_gr_4.gif]

[Graphics:Images/H2statC11_gr_5.gif]

[Graphics:Images/H2statC11_gr_6.gif]

[Graphics:Images/H2statC11_gr_7.gif]

[Graphics:Images/H2statC11_gr_8.gif]

[Graphics:Images/H2statC11_gr_9.gif]

[Graphics:Images/H2statC11_gr_10.gif]

[Graphics:Images/H2statC11_gr_11.gif]

[Graphics:Images/H2statC11_gr_12.gif]

[Graphics:Images/H2statC11_gr_13.gif]

[Graphics:Images/H2statC11_gr_14.gif]

[Graphics:Images/H2statC11_gr_15.gif]

[Graphics:Images/H2statC11_gr_16.gif]

[Graphics:Images/H2statC11_gr_17.gif]

[Graphics:Images/H2statC11_gr_18.gif]

[Graphics:Images/H2statC11_gr_19.gif]

[Graphics:Images/H2statC11_gr_20.gif]

[Graphics:Images/H2statC11_gr_21.gif]

[Graphics:Images/H2statC11_gr_22.gif]

[Graphics:Images/H2statC11_gr_23.gif]

[Graphics:Images/H2statC11_gr_24.gif]

sig=0.4165; u=20; s=0.5;
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}]
[Graphics:Images/H2statC11_gr_25.gif]
Vir=Table[-(Vne+Vnn+Vee)/T /. t[[{i},2]],{i,1,u}]
[Graphics:Images/H2statC11_gr_26.gif]
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}]
[Graphics:Images/H2statC11_gr_27.gif]
Do[Show[Graphics[{{RGBColor[1,0,0],Circle[{-(s-0.025*i)*R /. Q[[i]],0},R /. Q[[i]]]},{RGBColor[0,0,1],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],{RGBColor[1,0,1],Disk[{(s-0.025*i)*R /. Q[[i]],10*(B[[i]]+1.0)-2},0.06],Disk[{-(s-0.025*i)*R /. Q[[i]],10*(B[[i]]+1.0)-2},0.06]}}],{AspectRatio -> Automatic,PlotRange -> {{-3,3},{-4.2,1.5}}, Frame -> True}],{i,1,u}]

[Graphics:Images/H2statC11_gr_28.gif]

[Graphics:Images/H2statC11_gr_29.gif]

[Graphics:Images/H2statC11_gr_30.gif]

[Graphics:Images/H2statC11_gr_31.gif]

[Graphics:Images/H2statC11_gr_32.gif]

[Graphics:Images/H2statC11_gr_33.gif]

[Graphics:Images/H2statC11_gr_34.gif]

[Graphics:Images/H2statC11_gr_35.gif]

[Graphics:Images/H2statC11_gr_36.gif]

[Graphics:Images/H2statC11_gr_37.gif]

[Graphics:Images/H2statC11_gr_38.gif]

[Graphics:Images/H2statC11_gr_39.gif]

[Graphics:Images/H2statC11_gr_40.gif]

[Graphics:Images/H2statC11_gr_41.gif]

[Graphics:Images/H2statC11_gr_42.gif]

[Graphics:Images/H2statC11_gr_43.gif]

[Graphics:Images/H2statC11_gr_44.gif]

[Graphics:Images/H2statC11_gr_45.gif]

[Graphics:Images/H2statC11_gr_46.gif]

[Graphics:Images/H2statC11_gr_47.gif]


Converted by Mathematica      October 5, 2013