(*Ne-Atom and homologues 1s(2)2s(2) 2p(6) , all p equal size (?),with exchange correction page 40; 8.12.2011/10.04.2013 *)
Clear[T,Vne, Vee,func,Vir,P,Q,R,t,z,sig,max]; sig=0.285; max=12;
T=0.992*9/(4*P^2)+0.999*9*4/(4*Q^2)+12/R^2;
Vne=-3*z/P-3*z/Q-6*z/R;
Vee=(2/Q)*(3-(6/10)*(P/Q)^2)-6*sig*P^2/Q^3 + 3*sig/P+3*sig/Q+12*(1-(3/20)*(P/R)^2+(1/32)*(P/R)^3)/R+4.5*sig/R+12*(1-(3/20)*(Q/R)^2+(1/32)*(Q/R)^3)/R+6.582336/R; (* 8.48528/R *)
func=T+Vne+Vee;
Vir = (Vne+Vee)/T;
(* Etot, P, Q *)
t = Table[FindMinimum[func,{P,0.07,0.16},{Q,0.3,1.6},{R,0.23,0.63},{MaxIterations->800},{Method->Automatic}],{z,10,21}]

(* Virial ratio *)
Table[N[Vir /. t[[{z-9},2]],10],{z ,10,9+max}]
Table[N[Vne /. t[[{z-9},2]],10],{z ,10,9+max}]
Table[N[Vee /. t[[{z-9},2]],10],{z ,10,9+max}]

(* Etot in eV *)

PA=Table[P /. t[[i,2]],{i,1,max}];
QA=Table[Q /. t[[i,2]],{i,1,max}];
RA=Table[R /. t[[i,2]],{i,1,max}];

Table[
Show[Graphics[{{Thickness[0.015],Circle[{0, 0}, PA[[i]]], Circle[{0, 0}, QA[[i]]]},{Thickness[0.01], 
      {RGBColor[1,0,0],Circle[{0, -RA[[i]]}, RA[[i]]], Circle[{0, RA[[i]]}, RA[[i]]]}, 
      {RGBColor[1,0,1],Circle[{-RA[[i]], 0}, RA[[i]]], Circle[{RA[[i]], 0}, 
       RA[[i]]]},{RGBColor[0,1,1], Circle[{0, 0}, RA[[i]]]}}}], 
      {AspectRatio -> Automatic, 
    Axes -> True, GridLines -> Automatic,ColorOutput-> Automatic, 
    PlotRange -> {{-1.6, 1.6}, {-1.6, 1.6}}, Frame -> True}],{i,1,max}]