(* 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[      6496,        187]
NotebookOptionsPosition[      5692,        156]
NotebookOutlinePosition[      6117,        172]
CellTagsIndexPosition[      6074,        169]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell["(* Al atom Kimball, Ne-tbp core 15.09.2012 *)", "Input",
 PageWidth->WindowWidth],

Cell[CellGroupData[{

Cell["\<\
Clear[k1,k2,k3,k4, sig1,sig2,c,z,R1,R2,R3,R4,a,b,f,g,d];
c = {k1 -> 1.0, k2 -> 1.0, k3 -> 1.0, k4 -> 1.0, sig1 -> 0.28, sig2 -> 0.3, \
sig3 -> 0.3};
z=13.0; 
ad = Sqrt[3]/2;
T = 2.25*k1/R1^2+6.75*k2/R2^2+3.375*k3/R3^2+2.25*k4/R4^2 /. c;  
b = (R1+R2)/2+Sqrt[(R2+R3)^2-3*(R1+R2)^2/4];
a = (R1+R2)*Sqrt[3];d = b*Sqrt[3];
f = Sqrt[(R1+R4)^2+(R1+R2)^2];g=Sqrt[b^2+(R1+R4)^2];Vee=3.0*sig1/R1+3.0*3.0*\
sig2/R2 /. c;
Vee = Vee + \
12/(R1+R2)+6/b+12/a+4/(R1+R4)+12/f+3/d+12/(R2+R3)+6/(b+R1+R2)+6/g+0.5/(R1+R4);
Vne=-3.0*z/R1-6*z/(R1+R2)-2*z/(R1+R4)-3*z/b;

func = T + Vee + Vne /. c;

t = FindMinimum[func, {R1,0.109}, {R2,0.4198}, \
{R3,1.668},{R4,0.416},{MaxIterations -> 500},{Method-> \"Newton\"}]\
\>", "Input",
 PageWidth->WindowWidth,
 CellChangeTimes->{
  3.565087777574009*^9, {3.5650878706125727`*^9, 3.565087885728999*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"-", "241.5006007013421`"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"R1", "\[Rule]", "0.1091130118246442`"}], ",", 
     RowBox[{"R2", "\[Rule]", "0.41981752153157376`"}], ",", 
     RowBox[{"R3", "\[Rule]", "1.6681677324825779`"}], ",", 
     RowBox[{"R4", "\[Rule]", "0.4159724167065372`"}]}], "}"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{3.5650878555273457`*^9, 3.565087890689808*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["-(Vne+Vee)/T /. t[[2]]", "Input",
 PageWidth->WindowWidth,
 CellChangeTimes->{{3.565087777574009*^9, 3.565087788384828*^9}}],

Cell[BoxData["1.9999999999505236`"], "Output",
 CellChangeTimes->{3.5650878555273457`*^9, 3.5650878907054076`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
plot1=Graphics[{{GrayLevel[0.6],Disk[{R1+R2,0},R2],Disk[{-(R1+R2)/2,ad*(R1+R2)\
},R2],Disk[{-(R1+R2)/2,-ad*(R1+R2)},R2]},Circle[{R1+R2,0},R2],Circle[{-(R1+R2)\
/2,ad*(R1+R2)},R2],Circle[{-(R1+R2)/2,-ad*(R1+R2)},R2],Circle[{0,0},R1],Disk[{\
0,0},0.06],Circle[{0,0},R4],Circle[{-b,0},R3],Circle[{b/2,ad*b},R3], \
Circle[{b/2,-ad*b},R3]}] /. t[[2]];

Show[plot1,{AspectRatio -> Automatic, Axes -> True, GridLines -> Automatic, \
PlotRange -> {{-4,4},{-4,4}}, Frame -> True}]\
\>", "Input",
 PageWidth->WindowWidth,
 CellChangeTimes->{{3.565087777574009*^9, 3.565087795872841*^9}}],

Cell[BoxData[
 GraphicsBox[{
   {GrayLevel[0.6], DiskBox[{0.528930533356218, 0}, 0.41981752153157376`], 
    DiskBox[{-0.264465266678109, 0.45806727872373715`}, 0.41981752153157376`],
     DiskBox[{-0.264465266678109, -0.45806727872373715`}, 
     0.41981752153157376`]}, 
   CircleBox[{0.528930533356218, 0}, 0.41981752153157376`], 
   CircleBox[{-0.264465266678109, 0.45806727872373715`}, 
    0.41981752153157376`], 
   CircleBox[{-0.264465266678109, -0.45806727872373715`}, 
    0.41981752153157376`], CircleBox[{0, 0}, 0.1091130118246442], 
   DiskBox[{0, 0}, 0.06], CircleBox[{0, 0}, 0.4159724167065372], 
   CircleBox[{-2.301584995398827, 0}, 1.6681677324825779`], 
   CircleBox[{1.1507924976994135`, 1.9932310749844744`}, 1.6681677324825779`],
    CircleBox[{1.1507924976994135`, -1.9932310749844744`}, 
    1.6681677324825779`]},
  AspectRatio->Automatic,
  Axes->True,
  Frame->True,
  GridLines->Automatic,
  PlotRange->{{-4, 4}, {-4, 4}}]], "Output",
 CellChangeTimes->{3.565087855558546*^9, 3.5650878907210073`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
plot2=Graphics[{{GrayLevel[0.6],Disk[{R1+R2,0},R2],Disk[{-(R1+R2)/2,0},R2],\
Disk[{-(R1+R2)/2,0},R2]},Circle[{R1+R2,0},R2],Circle[{-(R1+R2)/2,0},R2],\
Circle[{-(R1+R2)/2,0},R2],Circle[{0,0},R1],Disk[{0,0},0.06],Circle[{0,R1+R4},\
R4],Circle[{0,-(R1+R4)},R4],Circle[{-b,0},R3],Circle[{b/2,0},R3], \
Circle[{b/2,0},R3]}] /. t[[2]];

Show[plot2,{AspectRatio -> Automatic, Axes -> True, GridLines -> Automatic, \
PlotRange -> {{-4,4},{-4,4}}, Frame -> True}]\
\>", "Input",
 PageWidth->WindowWidth,
 CellChangeTimes->{{3.565087777574009*^9, 3.5650878034232545`*^9}, {
  3.565087934182684*^9, 3.5650879365538883`*^9}}],

Cell[BoxData[
 GraphicsBox[{
   {GrayLevel[0.6], DiskBox[{0.528930533356218, 0}, 0.41981752153157376`], 
    DiskBox[{-0.264465266678109, 0}, 0.41981752153157376`], 
    DiskBox[{-0.264465266678109, 0}, 0.41981752153157376`]}, 
   CircleBox[{0.528930533356218, 0}, 0.41981752153157376`], 
   CircleBox[{-0.264465266678109, 0}, 0.41981752153157376`], 
   CircleBox[{-0.264465266678109, 0}, 0.41981752153157376`], 
   CircleBox[{0, 0}, 0.1091130118246442], DiskBox[{0, 0}, 0.06], 
   CircleBox[{0, 0.5250854285311813}, 0.4159724167065372], 
   CircleBox[{0, -0.5250854285311813}, 0.4159724167065372], 
   CircleBox[{-2.301584995398827, 0}, 1.6681677324825779`], 
   CircleBox[{1.1507924976994135`, 0}, 1.6681677324825779`], 
   CircleBox[{1.1507924976994135`, 0}, 1.6681677324825779`]},
  AspectRatio->Automatic,
  Axes->True,
  Frame->True,
  GridLines->Automatic,
  PlotRange->{{-4, 4}, {-4, 4}}]], "Output",
 CellChangeTimes->{3.5650878555741463`*^9, 3.5650878907366076`*^9}],

Cell[BoxData[
 TagBox[
  RowBox[{"\[SkeletonIndicator]", "Graphics", "\[SkeletonIndicator]"}],
  False,
  Editable->False]], "Output"]
}, Open  ]]
},
WindowSize->{1010, 740},
WindowMargins->{{233, Automatic}, {Automatic, -1}},
PrivateNotebookOptions->{"VersionedStylesheet"->{"Default.nb"[8.] -> False}},
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[557, 20, 87, 1, 31, "Input"],
Cell[CellGroupData[{
Cell[669, 25, 837, 22, 252, "Input"],
Cell[1509, 49, 452, 11, 31, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[1998, 65, 130, 2, 31, "Input"],
Cell[2131, 69, 114, 1, 31, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[2282, 75, 587, 11, 133, "Input"],
Cell[2872, 88, 1028, 21, 379, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[3937, 114, 623, 12, 133, "Input"],
Cell[4563, 128, 976, 19, 379, "Output"],
Cell[5542, 149, 134, 4, 31, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)