(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 7.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 11006, 392] NotebookOptionsPosition[ 8750, 312] NotebookOutlinePosition[ 9784, 348] CellTagsIndexPosition[ 9660, 342] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Doing Spin Sums I", "Subtitle", TextAlignment->Center, TextJustification->0], Cell["\<\ In this notebook, we evaluate the spin sums for the lowest-order diagrams for \ a spin-independent delta function potential.\ \>", "Text"], Cell["\<\ Programmer: Dick Furnstahl furnstahl.1@osu.edu\tRevision history: \ 03-Nov-2009 --- new version for 880.05\ \>", "Text", CellChangeTimes->{{3.466292022634747*^9, 3.4662920414325647`*^9}}], Cell[CellGroupData[{ Cell["Load simplification package", "Subsection"], Cell["\<\ The package is assumed to be in the same directory as this notebook. Load it \ and check definitions:\ \>", "Text"], Cell[BoxData[ RowBox[{"<<", "deltasimplify.m"}]], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"?", "del"}]], "Input"], Cell[BoxData[ StyleBox["\<\"del[a,b] is a Kronecker delta function with indices a,b.\"\>", "MSG"]], "Print", "PrintUsage", CellChangeTimes->{3.4662921566796913`*^9}, CellTags->"Info3466274156-7704877"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"?", "DeltaSimplify"}]], "Input"], Cell[BoxData[ StyleBox["\<\"DeltaSimplify[e] simplifies a spin sum\"\>", "MSG"]], "Print", \ "PrintUsage", CellChangeTimes->{3.4662921570153513`*^9}, CellTags->"Info3466274156-6857340"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Example Spin Sums", "Subsection"], Cell["This first one is the \"bowtie\" diagram (leading order).", "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"spinsum1", " ", "=", " ", RowBox[{"DeltaSimplify", "[", RowBox[{ RowBox[{"del", "[", RowBox[{"a", ",", "g"}], "]"}], RowBox[{"del", "[", RowBox[{"b", ",", "d"}], "]"}], RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"del", "[", RowBox[{"a", ",", "g"}], "]"}], RowBox[{"del", "[", RowBox[{"b", ",", "d"}], "]"}]}], "+", RowBox[{ RowBox[{"del", "[", RowBox[{"a", ",", "d"}], "]"}], RowBox[{"del", "[", RowBox[{"b", ",", "g"}], "]"}]}]}], ")"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"-", "nu"}], "+", SuperscriptBox["nu", "2"]}]], "Output", CellChangeTimes->{3.46629205258854*^9, 3.466292157163254*^9, 3.4662929732229347`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Factor", "[", "spinsum1", "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "nu"}], ")"}], " ", "nu"}]], "Output", CellChangeTimes->{3.4662920526364717`*^9, 3.466292157212686*^9, 3.466292973360026*^9}] }, Open ]], Cell["This next one is the 2nd order bubble chain (anomalous).", "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"spinsum2", " ", "=", " ", RowBox[{"Factor", "[", RowBox[{"DeltaSimplify", "[", RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b1"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b3"}], "]"}], RowBox[{"del", "[", RowBox[{"a3", ",", "b2"}], "]"}], RowBox[{"del", "[", RowBox[{"a4", ",", "b4"}], "]"}], RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b1"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b2"}], "]"}]}], "+", RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b2"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b1"}], "]"}]}]}], ")"}], RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"del", "[", RowBox[{"a3", ",", "b3"}], "]"}], RowBox[{"del", "[", RowBox[{"a4", ",", "b4"}], "]"}]}], "+", RowBox[{ RowBox[{"del", "[", RowBox[{"a3", ",", "b4"}], "]"}], RowBox[{"del", "[", RowBox[{"a4", ",", "b3"}], "]"}]}]}], ")"}]}], "]"}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"-", SuperscriptBox[ RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "nu"}], ")"}], "2"]}], " ", "nu"}]], "Output", CellChangeTimes->{3.466292052691258*^9, 3.466292157278755*^9, 3.466292973438877*^9}] }, Open ]], Cell["This one is the \"beachball\" diagram.", "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"spinsum3", "=", RowBox[{"Factor", "[", RowBox[{"DeltaSimplify", "[", RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b1"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b2"}], "]"}], RowBox[{"del", "[", RowBox[{"a3", ",", "b3"}], "]"}], RowBox[{"del", "[", RowBox[{"a4", ",", "b4"}], "]"}], RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b3"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b4"}], "]"}]}], "+", RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b4"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b3"}], "]"}]}]}], ")"}], RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"del", "[", RowBox[{"a3", ",", "b1"}], "]"}], RowBox[{"del", "[", RowBox[{"a4", ",", "b2"}], "]"}]}], "+", RowBox[{ RowBox[{"del", "[", RowBox[{"a3", ",", "b2"}], "]"}], RowBox[{"del", "[", RowBox[{"a4", ",", "b1"}], "]"}]}]}], ")"}]}], "]"}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"2", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "nu"}], ")"}], " ", "nu"}]], "Output", CellChangeTimes->{3.466292052736059*^9, 3.466292157350669*^9, 3.466292973508047*^9}] }, Open ]], Cell["This one is the Hartree-Fock diagram with a 3NF vertex.", "Text", CellChangeTimes->{{3.466291596909522*^9, 3.466291606899918*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"spinsum4", "=", RowBox[{"Factor", "[", RowBox[{"DeltaSimplify", "[", RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b1"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b2"}], "]"}], RowBox[{"del", "[", RowBox[{"a3", ",", "b3"}], "]"}], RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b1"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b2"}], "]"}], RowBox[{"del", "[", RowBox[{"a3", ",", "b3"}], "]"}]}], "+", RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b1"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b3"}], "]"}], RowBox[{"del", "[", RowBox[{"a3", ",", "b2"}], "]"}]}], "+", RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b2"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b1"}], "]"}], RowBox[{"del", "[", RowBox[{"a3", ",", "b3"}], "]"}]}], "+", RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b3"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b2"}], "]"}], RowBox[{"del", "[", RowBox[{"a3", ",", "b1"}], "]"}]}], "+", RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b3"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b1"}], "]"}], RowBox[{"del", "[", RowBox[{"a3", ",", "b2"}], "]"}]}], "+", RowBox[{ RowBox[{"del", "[", RowBox[{"a1", ",", "b2"}], "]"}], RowBox[{"del", "[", RowBox[{"a2", ",", "b3"}], "]"}], RowBox[{"del", "[", RowBox[{"a3", ",", "b1"}], "]"}]}]}], ")"}]}], "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.466291637619644*^9, 3.466291757756631*^9}, { 3.466292226872363*^9, 3.4662922627667427`*^9}, {3.46629238369244*^9, 3.466292427446824*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"-", RowBox[{"(", RowBox[{ RowBox[{"-", "2"}], "+", "nu"}], ")"}]}], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "nu"}], ")"}], " ", "nu"}]], "Output", CellChangeTimes->{3.466292052771666*^9, 3.4662921574184837`*^9, 3.466292231405033*^9, 3.46629226413443*^9, 3.4662924307259207`*^9, 3.4662929735750504`*^9}] }, Open ]] }, Open ]] }, Open ]] }, WindowToolbars->"EditBar", WindowSize->{990, 800}, WindowMargins->{{Automatic, 135}, {Automatic, 0}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, PrintingOptions->{"Magnification"->1, "PaperOrientation"->"Portrait", "PaperSize"->{612, 792}, "PostScriptOutputFile":>FrontEnd`FileName[{$RootDirectory, "home", "furnstah", "Teaching", "880.05", "Mathematica"}, "spinsums1.nb.ps", CharacterEncoding -> "iso8859-1"]}, ShowSelection->True, Magnification->1.5, FrontEndVersion->"7.0 for Mac OS X x86 (32-bit) (February 18, 2009)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{ "Info3466274156-7704877"->{ Cell[1344, 54, 207, 4, 58, "Print", CellTags->"Info3466274156-7704877"]}, "Info3466274156-6857340"->{ Cell[1647, 66, 188, 4, 60, "Print", CellTags->"Info3466274156-6857340"]} } *) (*CellTagsIndex CellTagsIndex->{ {"Info3466274156-7704877", 9450, 333}, {"Info3466274156-6857340", 9558, 336} } *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[567, 22, 84, 2, 69, "Subtitle"], Cell[654, 26, 148, 3, 62, "Text"], Cell[805, 31, 200, 4, 39, "Text"], Cell[CellGroupData[{ Cell[1030, 39, 49, 0, 51, "Subsection"], Cell[1082, 41, 126, 3, 39, "Text"], Cell[1211, 46, 59, 1, 40, "Input"], Cell[CellGroupData[{ Cell[1295, 51, 46, 1, 40, "Input"], Cell[1344, 54, 207, 4, 58, "Print", CellTags->"Info3466274156-7704877"] }, Open ]], Cell[CellGroupData[{ Cell[1588, 63, 56, 1, 40, "Input"], Cell[1647, 66, 188, 4, 60, "Print", CellTags->"Info3466274156-6857340"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[1884, 76, 39, 0, 51, "Subsection"], Cell[1926, 78, 73, 0, 39, "Text"], Cell[CellGroupData[{ Cell[2024, 82, 597, 19, 64, "Input"], Cell[2624, 103, 184, 5, 44, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[2845, 113, 66, 1, 40, "Input"], Cell[2914, 116, 210, 6, 40, "Output"] }, Open ]], Cell[3139, 125, 72, 0, 39, "Text"], Cell[CellGroupData[{ Cell[3236, 129, 1174, 37, 110, "Input"], Cell[4413, 168, 257, 8, 44, "Output"] }, Open ]], Cell[4685, 179, 54, 0, 39, "Text"], Cell[CellGroupData[{ Cell[4764, 183, 1164, 37, 110, "Input"], Cell[5931, 222, 218, 6, 40, "Output"] }, Open ]], Cell[6164, 231, 137, 1, 39, "Text"], Cell[CellGroupData[{ Cell[6326, 236, 2000, 58, 156, "Input"], Cell[8329, 296, 381, 11, 40, "Output"] }, Open ]] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *)