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

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

(* CreatedBy='Mathematica 8.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       157,          7]
NotebookDataLength[      5424,        175]
NotebookOptionsPosition[      4491,        143]
NotebookOutlinePosition[      5107,        165]
CellTagsIndexPosition[      5064,        162]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["\<\
(* Xe atom Kimball, Ne,Ar,Ni,Kr,Pd-centers, 4 5sp-spheres tetrahedral \
23.12.2011 *)
Clear[k1,k2,k3,k4,k5,k6,k7,sig1,sig2,sig3,sig4,sig5,sig6,sig7,c,z,R1,R2,R3,R4,\
R5,R6,R7,S2,S3,S4,S5,S6,S7];
c = {k1 -> 1.0, k2 -> 1.0, k3 -> 1.0, k4 -> 1.0, k5 -> 1.0, k6 -> 1.0, k7 -> \
1.0, sig1 -> 0.3, sig2 -> 0.3, sig3 -> 0.3, sig4 -> 0.3, sig5 -> 0.3, sig6 -> \
0.3, sig7 -> 0.3}; z=54.;

(* He+Ne shell *)
T = (2.*9./8.)*k1/R1^2+(8.*9./8.)*k2/R2^2 /. c;
ad = Sqrt[3./8.]; 
Vee=3.0*sig1/R1+12.*sig2/R2+16/(R1+R2)+24*ad/(R1+R2) /. c;
Vne=-3.0*z/R1-8.147*z/(R1+R2);
S2 = R2*4^(1/3);

(* Ar shell *)
T = T + (8.*9./8.)*k3/R3^2 /. c;
Vee = Vee+12.*sig3/R3+80./(S2+R3)+24.*ad/(S2+R3) /. c;
Vne = Vne-8.5*z/(S2+R3);
S3 = R3*4^(1/3);

(* Ni shell trigbipyr, d10 with 5*2 charges; *)
T = T + (10.*9./8.)*k4/R4^2 /. c;
Vee = Vee+5.*3.*sig4/R4+(180.+25.898766)/(S3+R4) /. c; (* \
2+24/Sqrt[2]+12/Sqrt[3] *)
Vne = Vne - 10.75*z/(S3+R4);
S4 = R4*5^(1/3);

(* Kr shell *)
T = T + (8.*9./8.)*k5/R5^2 /. c;
Vee = Vee+12.*sig5/R5+224./(S4+R5)+24.*ad/(S4+R5) /. c;
Vne = Vne-8.5*z/(S4+R5);
S5 = R5*4^(1/3);

(* Pd shell trigbipyr, d10 with 5*2 charges *)
T = T + (10.*9./8)*k6/R6^2 /. c;
Vee = Vee+5.*3.*sig6/R6+(360.+25.898766)/(S5+R6) /. c;
Vne = Vne - 10.75*z/(S5+R6);
S6 = R6*5^(1/3);

(* Xe shell *)
T = T + (8.*9./8.)*k7/R7^2 /. c;
Vee = Vee+12.*sig7/R7+(432.+24.*ad)/(S6+R7) /. c;
Vne = Vne-8.5*z/(S6+R7);
S7 = R7*4^(1/3);

func = T + Vee + Vne;

t = FindMinimum[func, {R1,0.02374}, {R2,0.0665}, {R3,0.1153}, \
{R4,0.17898},{R5,0.2549},{R6,0.4608},{R7,0.9128},{Method -> Automatic}, \
{MaxIterations -> 500}]

N[Vne /. c /. t[[2]],10]
N[Vee /. c /. t[[2]],10]
N[-(Vee+Vne)/T /. c /. t[[2]],10]
N[(S2+R3) /. c /. t[[2]],10]
N[(S3+R4) /. c /. t[[2]],10]
N[(S4+R5) /. c /. t[[2]],10]
N[(S5+R6) /. c /. t[[2]],10]
N[(S6+R7) /. c /. t[[2]],10]
\
\>", "Input"],

Cell[BoxData[
 RowBox[{
  StyleBox[
   RowBox[{"FindMinimum", "::", "lstol"}], "MessageName"], 
  RowBox[{
  ":", " "}], "\<\"The line search decreased the step size to within the \
tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find \
a sufficient decrease in the function. You may need more than \
\[NoBreak]\\!\\(MachinePrecision\\)\[NoBreak] digits of working precision to \
meet these tolerances. \\!\\(\\*ButtonBox[\\\"\[RightSkeleton]\\\", \
ButtonStyle->\\\"Link\\\", ButtonFrame->None, \
ButtonData:>\\\"paclet:ref/FindMinimum\\\", ButtonNote -> \
\\\"FindMinimum::lstol\\\"]\\)\"\>"}]], "Message", "MSG",
 CellChangeTimes->{3.541079491362913*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"-", "7242.5608518103045`"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"R1", "\[Rule]", "0.02375046185733791`"}], ",", 
     RowBox[{"R2", "\[Rule]", "0.06645482572481193`"}], ",", 
     RowBox[{"R3", "\[Rule]", "0.11538138941574314`"}], ",", 
     RowBox[{"R4", "\[Rule]", "0.1795081152527134`"}], ",", 
     RowBox[{"R5", "\[Rule]", "0.2577419307639176`"}], ",", 
     RowBox[{"R6", "\[Rule]", "0.45403163686791354`"}], ",", 
     RowBox[{"R7", "\[Rule]", "3.7284395802570685`"}]}], "}"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{3.541079491362913*^9}],

Cell[BoxData[
 RowBox[{"-", "16964.012633607752`"}]], "Output",
 CellChangeTimes->{3.541079491362913*^9}],

Cell[BoxData["2478.89092985865`"], "Output",
 CellChangeTimes->{3.541079491362913*^9}],

Cell[BoxData["1.9999999999822582`"], "Output",
 CellChangeTimes->{3.541079491362913*^9}],

Cell[BoxData["0.22087184967967297`"], "Output",
 CellChangeTimes->{3.541079491362913*^9}],

Cell[BoxData["0.36266465418881655`"], "Output",
 CellChangeTimes->{3.541079491362913*^9}],

Cell[BoxData["0.5646964900793259`"], "Output",
 CellChangeTimes->{3.541079491362913*^9}],

Cell[BoxData["0.8631714488988712`"], "Output",
 CellChangeTimes->{3.5410794913785133`*^9}],

Cell[BoxData["4.504822758331449`"], "Output",
 CellChangeTimes->{3.5410794913785133`*^9}]
}, Open  ]]
},
PrintingStyleEnvironment->"Printout",
WindowSize->{874, 854},
WindowMargins->{{2, Automatic}, {Automatic, 10}},
PrintingCopies->1,
PrintingPageRange->{Automatic, Automatic},
PrintingOptions->{"PrintCellBrackets"->False,
"PrintMultipleHorizontalPages"->False,
"PrintRegistrationMarks"->False,
"PrintingMargins"->{{34, 14.125}, {56.6875, 56.6875}}},
FrontEndVersion->"8.0 for Microsoft Windows (64-bit) (October 6, 2011)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[579, 22, 1846, 62, 932, "Input"],
Cell[2428, 86, 681, 13, 56, "Message"],
Cell[3112, 101, 615, 14, 50, "Output"],
Cell[3730, 117, 105, 2, 30, "Output"],
Cell[3838, 121, 86, 1, 30, "Output"],
Cell[3927, 124, 88, 1, 30, "Output"],
Cell[4018, 127, 89, 1, 30, "Output"],
Cell[4110, 130, 89, 1, 30, "Output"],
Cell[4202, 133, 88, 1, 30, "Output"],
Cell[4293, 136, 90, 1, 30, "Output"],
Cell[4386, 139, 89, 1, 30, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)