(* Content-type: application/vnd.wolfram.mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 9.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       157,          7]
NotebookDataLength[      4917,        157]
NotebookOptionsPosition[      3959,        124]
NotebookOutlinePosition[      4684,        148]
CellTagsIndexPosition[      4641,        145]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["\<\
(* K atom Kimball, Ne-center, outer-sp-spheres 21.12.2011/05.07.12 *)
Clear[k1,k2,k3,k4,sig1,sig2,sig3,sig4,c,z,R1,R2,R3,R4,S2,S3];
c = {k1 -> 1.0, k2 -> 1.0, k3 -> 1.0, k4 -> 1.0, sig1 -> 0.3, sig2 -> 0.3, \
sig3 -> 0.3, sig4 -> 0.3}; z=19.0;

T = 2.25*k1/R1^2+9.0*k2/R2^2 /. c;
ad = Sqrt[3./8.]; 
Vee=3.0*sig1/R1+12.0*sig2/R2+16/(R1+R2)+24*ad/(R1+R2) /. c;
Vne=-3.0*z/R1-8.0*z/(R1+R2);
S2 = R2*4^(1/3);

T = T + 9.0*k3/R3^2 /. c;
Vee = Vee+12.0*sig3/R3+80.0/(S2+R3)+24.0*ad/(S2+R3) /. c;
Vne = Vne-8.35*z/(S2+R3);
S3 = R3*2^(2/3);

T = T + 1.125*k4/R4^2 /. c;
Vee = Vee+18.0/(S3+R4);
Vne = Vne - z/(S3+R4);
S4=R4;

func = T + Vee + Vne;

t = FindMinimum[func, {R1,0.0721379}, {R2,0.244894}, {R3,0.7469272}, \
{R4,3.8494901},{Method -> Automatic},
{MaxIterations -> 500}]

N[-(Vee+Vne)/T /. c /. t[[2]],10]
S2 /. t[[2]]
S3 /. t[[2]]
S4 /. t[[2]]\
\>", "Input"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"-", "598.6446119976679`"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"R1", "\[Rule]", "0.07213794430068379`"}], ",", 
     RowBox[{"R2", "\[Rule]", "0.24489401130511249`"}], ",", 
     RowBox[{"R3", "\[Rule]", "0.7469271995700661`"}], ",", 
     RowBox[{"R4", "\[Rule]", "3.8494900999998296`"}]}], "}"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{
  3.565672818629095*^9, 3.565672859079966*^9, 3.565672889422019*^9, 
   3.565672959793743*^9, 3.565673003037019*^9, {3.565673050492302*^9, 
   3.5656731075104027`*^9}}],

Cell[BoxData["1.9999999928347378`"], "Output",
 CellChangeTimes->{
  3.565672818629095*^9, 3.565672859079966*^9, 3.565672889422019*^9, 
   3.565672959793743*^9, 3.565673003037019*^9, {3.565673050492302*^9, 
   3.5656731075260024`*^9}}],

Cell[BoxData["0.38874501116644766`"], "Output",
 CellChangeTimes->{
  3.565672818629095*^9, 3.565672859079966*^9, 3.565672889422019*^9, 
   3.565672959793743*^9, 3.565673003037019*^9, {3.565673050492302*^9, 
   3.5656731075260024`*^9}}],

Cell[BoxData["1.1856730223411842`"], "Output",
 CellChangeTimes->{
  3.565672818629095*^9, 3.565672859079966*^9, 3.565672889422019*^9, 
   3.565672959793743*^9, 3.565673003037019*^9, {3.565673050492302*^9, 
   3.5656731075260024`*^9}}],

Cell[BoxData["3.8494900999998296`"], "Output",
 CellChangeTimes->{
  3.565672818629095*^9, 3.565672859079966*^9, 3.565672889422019*^9, 
   3.565672959793743*^9, 3.565673003037019*^9, {3.565673050492302*^9, 
   3.5656731075260024`*^9}}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
plot1=Graphics3D[{Opacity[0.5],{Sphere[{0,0,0},S2],Sphere[{0,0,0},S3],
     Sphere[{0,0,0},S4]},{Darker[Green,1],Sphere[{0,0,0},R1]}}] /. t[[2]];
     
Show[plot1,{AspectRatio \[Rule] Automatic,Axes -> True}]          \
\>", "Input",
 CellChangeTimes->{{3.5656727408473587`*^9, 3.565672875303994*^9}, {
  3.565672933804097*^9, 3.5656729981854105`*^9}, {3.565673037201079*^9, 
  3.5656731030799947`*^9}}],

Cell[BoxData[
 Graphics3DBox[
  {Opacity[
   0.5], {SphereBox[{0, 0, 0}, 0.38874501116644766`], 
    SphereBox[{0, 0, 0}, 1.1856730223411842`], 
    SphereBox[{0, 0, 0}, 3.8494900999998296`]}, 
   {RGBColor[0, 0, 0], SphereBox[{0, 0, 0}, 0.07213794430068379]}},
  AspectRatio->Automatic,
  Axes->True]], "Output",
 CellChangeTimes->{
  3.5656728189566956`*^9, 3.565672859126766*^9, 3.5656728894688196`*^9, 
   3.565672959871743*^9, 3.565673003083819*^9, {3.5656730505391026`*^9, 
   3.5656731075572023`*^9}}]
}, Open  ]]
},
PrintingStyleEnvironment->"Printout",
WindowSize->{775, 659},
WindowMargins->{{271, Automatic}, {Automatic, 24}},
PrintingCopies->1,
PrintingPageRange->{Automatic, Automatic},
PrintingOptions->{"PrintCellBrackets"->False,
"PrintMultipleHorizontalPages"->False,
"PrintRegistrationMarks"->False,
"PrintingMargins"->{{34, 14.125}, {56.6875, 56.6875}}},
PrivateNotebookOptions->{"VersionedStylesheet"->{"Default.nb"[8.] -> False}},
CellLabelAutoDelete->True,
FrontEndVersion->"9.0 for Microsoft Windows (64-bit) (November 20, 2012)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[579, 22, 871, 32, 507, "Input"],
Cell[1453, 56, 576, 14, 31, "Output"],
Cell[2032, 72, 235, 4, 31, "Output"],
Cell[2270, 78, 236, 4, 31, "Output"],
Cell[2509, 84, 235, 4, 31, "Output"],
Cell[2747, 90, 235, 4, 31, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[3019, 99, 413, 8, 82, "Input"],
Cell[3435, 109, 508, 12, 460, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)