(*N-Atom and homologues 1s(2)2s(2) 2p(3) concentric spherical,with exchange correction page 40; 6.12.2011 *)

Clear[z,sig]; sig=0.205;
T=9/(4*P^2)+9*4/(4*Q^2)+6/R^2;
Vne=-3*z/P-3*z/Q-3*z/R;
Vee=(2/Q)*(3-(6/10)*(P/Q)^2)-6*sig*P^2/Q^3 + 3*sig/P+3*sig/Q+6*(1-(3/20)*(P/R)^2+(1/32)*(P/R)^3)/R+6*(1-(3/20)*(Q/R)^2+(1/32)*(Q/R)^3)/R+1.645584/R;
func=T+Vne+Vee; Vir = (Vne+Vee)/T;
(* Etot, P, Q *)
t = Table[FindMinimum[func,{P,0.22},{Q,1.41},{R,1.20},{MaxIterations->800, Method ->"Newton"}],{z,7,18}]

(* Virial ratio *)
Table[N[Vir /. t[[{z-6},2]],10],{z ,7,18}]
Table[N[Vne /. t[[{z-6},2]],10],{z ,7,18}]
Table[N[Vee /. t[[{z-6},2]],10],{z ,7,18}]
(* Etot in eV *)
Table[N[t[[{z-6},1]]*27.21138,10],{z,7,18}]
PA=Table[P /. t[[i,2]],{i,1,12}];
QA=Table[Q /. t[[i,2]],{i,1,12}];
RA=Table[R /. t[[i,2]],{i,1,12}];

Table[
Show[Graphics[{{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]]]}},{Thickness[0.015],{RGBColor[0,0,0],Circle[{0, 0}, PA[[i]]], Circle[{0, 0}, QA[[i]]]}}}], 
      {AspectRatio -> Automatic, 
    Axes -> True, GridLines -> Automatic,ColorOutput-> Automatic, 
    PlotRange -> {{-2.4,2.4}, {-2.4, 2.4}}, Frame -> True}],{i,1,12}]