(* 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[     10853,        288]
NotebookOptionsPosition[      9858,        255]
NotebookOutlinePosition[     10559,        279]
CellTagsIndexPosition[     10516,        276]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["\<\
(* K atom nach Kimball, Aussen-sp-Kugeln 19.12.2011 *)
Clear[k1,k2,k3,k4,sig1,sig2,sig3,c,z,R1,R2,R3,R4,a];
k = {k1 -> 1.0, k2 -> 1.0, k3->1.0, k4->1.0, sig1 -> 0.4, sig2 -> 0.4, sig3 \
-> 0.4};

T = 2.25*k1/R1^2+9.0*k2/R2^2+9.0*k3/R3^2+1.125*k4/R4^2 /. k;
a = (R1+R2)/3+Sqrt[(R2+R3)^2-8*(R1+R2)^2/9];
b = a/3+Sqrt[(R3+R4)^2-8*a*a/9];
c = b+Sqrt[((R1+R2)/3)^2+8*(R1+R2)^2/9];
Vee = 3.0*sig1/R1+4.0*3.0*sig2/R2+4.0*3.0*sig3/R3+16/(R1+R2)+24/((R1+R2)*Sqrt[\
8/3])+
      16/a+48/(R2+R3)+16/(R1+R2+a)+24*Sqrt[3/8]/a+2/b+6/(R3+R4)+2/(a+b)+2/(b-\
R1-R2)+6/c /. k;
Vne = -3.0*z/R1-8*z/(R1+R2)-8*z/a-z/b;
Vir = (Vee+Vne)/T;
func = T+Vee+Vne;

t = Table[FindMinimum[func, {R1,0.066}, {R2,0.22}, {R3,0.6}, \
{R4,1.0},{MaxIterations -> 500}], {z,19,26}]

Table[N[Vne /. k /. t[[{z-18},2]],10], {z,19,26}]
Table[N[Vee /. k /. t[[{z-18},2]],10], {z,19,26}]
Table[N[-Vir /. k /. t[[{z-18},2]],10], {z,19,26}]
Table[N[a /. k /. t[[{z-18},2]],10], {z,19,26}]
\
\>", "Input",
 CellChangeTimes->{{3.541087573297765*^9, 3.5410876017366147`*^9}}],

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.5410874569527607`*^9, 3.541087608101426*^9}],

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.5410874569527607`*^9, 3.541087608101426*^9}],

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.5410874569527607`*^9, 3.541087608101426*^9}],

Cell[BoxData[
 RowBox[{
  StyleBox[
   RowBox[{"General", "::", "stop"}], "MessageName"], 
  RowBox[{
  ":", " "}], "\<\"Further output of \
\[NoBreak]\\!\\(\\*StyleBox[\\(FindMinimum :: lstol\\), \
\\\"MessageName\\\"]\\)\[NoBreak] will be suppressed during this calculation. \
\\!\\(\\*ButtonBox[\\\"\[RightSkeleton]\\\", ButtonStyle->\\\"Link\\\", \
ButtonFrame->None, ButtonData:>\\\"paclet:ref/message/General/stop\\\", \
ButtonNote -> \\\"General::stop\\\"]\\)\"\>"}]], "Message", "MSG",
 CellChangeTimes->{3.5410874569527607`*^9, 3.541087608226226*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{"-", "587.4042681765044`"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"R1", "\[Rule]", "0.07272739157268494`"}], ",", 
       RowBox[{"R2", "\[Rule]", "0.2510804521811898`"}], ",", 
       RowBox[{"R3", "\[Rule]", "0.6891220547223103`"}], ",", 
       RowBox[{"R4", "\[Rule]", "1.9367977396447957`"}]}], "}"}]}], "}"}], 
   ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"-", "664.3059745544427`"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"R1", "\[Rule]", "0.06880408110012189`"}], ",", 
       RowBox[{"R2", "\[Rule]", "0.2342937300429691`"}], ",", 
       RowBox[{"R3", "\[Rule]", "0.6075906349325837`"}], ",", 
       RowBox[{"R4", "\[Rule]", "1.2787143476069802`"}]}], "}"}]}], "}"}], 
   ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"-", "746.314052246089`"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"R1", "\[Rule]", "0.06527896877506362`"}], ",", 
       RowBox[{"R2", "\[Rule]", "0.21955764237708056`"}], ",", 
       RowBox[{"R3", "\[Rule]", "0.5436240181135834`"}], ",", 
       RowBox[{"R4", "\[Rule]", "0.9860459372570468`"}]}], "}"}]}], "}"}], 
   ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"-", "833.4111161291918`"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"R1", "\[Rule]", "0.062095070739002826`"}], ",", 
       RowBox[{"R2", "\[Rule]", "0.20653088613039203`"}], ",", 
       RowBox[{"R3", "\[Rule]", "0.49207652650962014`"}], ",", 
       RowBox[{"R4", "\[Rule]", "0.8110013229729566`"}]}], "}"}]}], "}"}], 
   ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"-", "925.5883149536209`"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"R1", "\[Rule]", "0.05920557862133302`"}], ",", 
       RowBox[{"R2", "\[Rule]", "0.19494013555023026`"}], ",", 
       RowBox[{"R3", "\[Rule]", "0.4496204134925098`"}], ",", 
       RowBox[{"R4", "\[Rule]", "0.6916090474794693`"}]}], "}"}]}], "}"}], 
   ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"-", "1022.8403690929915`"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"R1", "\[Rule]", "0.05657176895438177`"}], ",", 
       RowBox[{"R2", "\[Rule]", "0.1845654165652445`"}], ",", 
       RowBox[{"R3", "\[Rule]", "0.4140204982438384`"}], ",", 
       RowBox[{"R4", "\[Rule]", "0.6038485041815437`"}]}], "}"}]}], "}"}], 
   ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"-", "1125.1638969671003`"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"R1", "\[Rule]", "0.05416136142819667`"}], ",", 
       RowBox[{"R2", "\[Rule]", "0.17522835684399315`"}], ",", 
       RowBox[{"R3", "\[Rule]", "0.3837219686566703`"}], ",", 
       RowBox[{"R4", "\[Rule]", "0.5361226107971745`"}]}], "}"}]}], "}"}], 
   ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"-", "1232.5566579020683`"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"R1", "\[Rule]", "0.05194724913837128`"}], ",", 
       RowBox[{"R2", "\[Rule]", "0.1667831306765154`"}], ",", 
       RowBox[{"R3", "\[Rule]", "0.3576099247021583`"}], ",", 
       RowBox[{"R4", "\[Rule]", "0.4820289382509613`"}]}], "}"}]}], "}"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{3.5410874569683604`*^9, 3.5410876082574263`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{"-", "1412.4147881684366`"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{"-", "1589.1803741768224`"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{"-", "1775.6442528790972`"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{"-", "1972.0410077903832`"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{"-", "2178.4522234261817`"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{"-", "2394.917815263328`"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{"-", "2621.461166886574`"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{"-", "2858.0975496338024`"}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.5410874569683604`*^9, 3.5410876082574263`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", "237.60624940604976`", "}"}], ",", 
   RowBox[{"{", "260.56842558560993`", "}"}], ",", 
   RowBox[{"{", "283.0161477073057`", "}"}], ",", 
   RowBox[{"{", "305.21877751019605`", "}"}], ",", 
   RowBox[{"{", "327.27559410304815`", "}"}], ",", 
   RowBox[{"{", "349.2370747640971`", "}"}], ",", 
   RowBox[{"{", "371.13336740017644`", "}"}], ",", 
   RowBox[{"{", "392.9842337421037`", "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.5410874569683604`*^9, 3.5410876082574263`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", "1.9999999958982626`", "}"}], ",", 
   RowBox[{"{", "2.0000000007792695`", "}"}], ",", 
   RowBox[{"{", "1.9999999990893733`", "}"}], ",", 
   RowBox[{"{", "2.0000000023736137`", "}"}], ",", 
   RowBox[{"{", "2.0000000006310668`", "}"}], ",", 
   RowBox[{"{", "1.9999999977384073`", "}"}], ",", 
   RowBox[{"{", "1.9999999950654326`", "}"}], ",", 
   RowBox[{"{", "1.9999999999289582`", "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.5410874569683604`*^9, 3.5410876082574263`*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", "0.997193730095905`", "}"}], ",", 
   RowBox[{"{", "0.892934483926717`", "}"}], ",", 
   RowBox[{"{", "0.8093186936450103`", "}"}], ",", 
   RowBox[{"{", "0.7406258354312092`", "}"}], ",", 
   RowBox[{"{", "0.6830837941408029`", "}"}], ",", 
   RowBox[{"{", "0.6341107195494183`", "}"}], ",", 
   RowBox[{"{", "0.5918780728461571`", "}"}], ",", 
   RowBox[{"{", "0.5550522052881735`", "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.5410874569683604`*^9, 3.5410876082574263`*^9}]
}, Open  ]]
},
PrintingStyleEnvironment->"Printout",
WindowSize->{821, 776},
WindowMargins->{{99, Automatic}, {Automatic, 14}},
DockedCells->FEPrivate`FrontEndResource[
 "FEExpressions", "CompatibilityToolbar"],
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, 1037, 27, 371, "Input"],
Cell[1619, 51, 705, 13, 73, "Message"],
Cell[2327, 66, 705, 13, 73, "Message"],
Cell[3035, 81, 705, 13, 73, "Message"],
Cell[3743, 96, 559, 11, 21, "Message"],
Cell[4305, 109, 3224, 83, 164, "Output"],
Cell[7532, 194, 695, 19, 30, "Output"],
Cell[8230, 215, 534, 11, 30, "Output"],
Cell[8767, 228, 537, 11, 30, "Output"],
Cell[9307, 241, 535, 11, 30, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)