(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 6.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 60079, 1894] NotebookOptionsPosition[ 55127, 1747] NotebookOutlinePosition[ 55542, 1765] CellTagsIndexPosition[ 55499, 1762] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Quantum Modes", "Title"], Cell["AP1601", "Subsubtitle"], Cell[CellGroupData[{ Cell["Introduction", "Section"], Cell[TextData[{ "One of the well-known consequences of quantum mechanics is the \"energy \ level.\" Within potential wells (or fixed domains), oscillations of the \ wave-function can be expressed as a collection of discrete \"modes\" of the \ system. These are called ", StyleBox["Eigensystems", FontSlant->"Italic"], ", and ", StyleBox["Mathematica", FontSlant->"Italic"], " has built-in commands to find these normal modes and frequencies. " }], "Text"], Cell[TextData[{ "For our quantum ball confined to a box, Schrodinger's equations can be \ approximated on a grid. The matrix form of these coupled equations are:\n\t", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ StyleBox["I", FontSlant->"Plain"], " ", SubscriptBox["\[PartialD]", "t"]}], " "}], TraditionalForm]]], StyleBox["\[Psi]", FontWeight->"Bold"], " = ", StyleBox["M", FontWeight->"Bold"], " ", StyleBox[".", FontWeight->"Bold"], " ", StyleBox["\[Psi]", FontWeight->"Bold"], "\nwhere we have again assigned \[HBar] = ", StyleBox["m", FontSlant->"Italic"], " = 1 for simplicty.This equation appears remarkably simple, but, remember \ that Schrodinger's wavefunction, \[Psi], is complex. \nThe time dependence \ of an eigenmode of fixed frequency (", StyleBox["i.e.", FontSlant->"Italic"], " energy) varies as\n\t\[Psi](", StyleBox["x", FontSlant->"Italic"], ", ", StyleBox["t", FontSlant->"Italic"], ") \[Proportional] Exp[- I \[Omega] ", StyleBox["t", FontSlant->"Italic"], "] ", StyleBox["g", FontSlant->"Italic"], "(", StyleBox["x", FontSlant->"Italic"], "),\nwhere ", StyleBox["g", FontSlant->"Italic"], "(", StyleBox["x", FontSlant->"Italic"], ") is the time-independent spatial struncture of the normal mode.The quantum \ fluctuations of the wavefunction are ", StyleBox["faster", FontSlant->"Italic"], " at higher energy and ", StyleBox["slower", FontSlant->"Italic"], " at lower energy. Substituting this expression into our matrix version of \ Schrodinger's equation gives\n\t", Cell[BoxData[ FormBox[ RowBox[{"\[Omega]", " "}], TraditionalForm]]], StyleBox["\[Psi]", FontWeight->"Bold"], " = ", StyleBox["M", FontWeight->"Bold"], " ", StyleBox[".", FontWeight->"Bold"], " ", StyleBox["\[Psi]\n", FontWeight->"Bold"], "The eigenvalues of Schrodinger's equation are proportional to the frequency \ of the oscillations of the wavefunction and to the energy of the eigenmode." }], "Text"], Cell[CellGroupData[{ Cell["Our Quantum Model (on a grid)", "Subsection"], Cell[TextData[{ "Last week, we introduced Schrodinger's equation on a grid. Computers can \ not represent a continuous range of numbers (", StyleBox["i.e. x", FontSlant->"Italic"], ") unless they deal with a symbolic or algebraic solution to the quantum \ problem. The approach we have taken is to replace the ", StyleBox["x", FontSlant->"Italic"], "-axis with a ", StyleBox["grid", FontSlant->"Italic"], " with the wavefunction represented by complex numbers at each grid point. \ Spatial derivatives, ", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["\[PartialD]", "x"], " ", RowBox[{ SubscriptBox["\[PartialD]", "x"], " ", "\[Psi]"}]}], TraditionalForm]]], ", are replaced with ", StyleBox["differences", FontSlant->"Italic"], " of \[Psi] evaluated on neighboring grid points. (This creates an equation \ having the same form as the equation for the acceleration of balls on a \ string.) The equations for the wavefunction at the grid points are:\n\tI ", Cell[BoxData[ FormBox[ RowBox[{ FormBox[ RowBox[{ SubscriptBox["\[PartialD]", "t"], " ", RowBox[{ RowBox[{"\[Psi]", StyleBox["[", FontSlant->"Plain"], "1", "]"}], "[", "t", "]"}]}], TraditionalForm], " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"-", " ", RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}]}], " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"-", " ", "2"}], StyleBox[" ", FontSlant->"Italic"], RowBox[{ RowBox[{"\[Psi]", "[", "1", "]"}], "[", "t", "]"}]}], " ", "+", " ", RowBox[{ RowBox[{"\[Psi]", "[", "2", "]"}], "[", "t", "]"}]}], ")"}]}], " ", "+", " ", RowBox[{ RowBox[{"V", "[", "2", "]"}], " ", RowBox[{ RowBox[{"\[Psi]", "[", "2", "]"}], "[", "t", "]"}]}]}]}], TextForm]]], "\n\t", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"I", " ", FormBox[ RowBox[{ SubscriptBox["\[PartialD]", "t"], " ", RowBox[{ RowBox[{"\[Psi]", StyleBox["[", FontSlant->"Plain"], "i", "]"}], "[", "t", "]"}]}], TraditionalForm]}], " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"-", " ", RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}]}], " ", RowBox[{"(", " ", RowBox[{ RowBox[{ RowBox[{"\[Psi]", "[", RowBox[{"i", "-", "1"}], "]"}], "[", "t", "]"}], " ", "-", " ", RowBox[{"2", " ", RowBox[{ RowBox[{"\[Psi]", "[", "i", "]"}], "[", "t", "]"}]}], " ", "+", " ", RowBox[{ RowBox[{"\[Psi]", "[", RowBox[{"i", "+", "1"}], "]"}], "[", "t", "]"}]}], ")"}]}], " ", "+", RowBox[{ RowBox[{"V", "[", "i", "]"}], " ", RowBox[{ RowBox[{"\[Psi]", "[", "i", "]"}], "[", "t", "]"}]}]}]}], TextForm]]], "\n\tI ", Cell[BoxData[ FormBox[ RowBox[{ FormBox[ RowBox[{ SubscriptBox["\[PartialD]", "t"], " ", RowBox[{ RowBox[{"\[Psi]", "[", "N", "]"}], "[", "t", "]"}]}], TraditionalForm], " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"-", " ", RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}]}], " ", RowBox[{"(", " ", RowBox[{ RowBox[{ RowBox[{"\[Psi]", "[", RowBox[{"N", "-", "1"}], "]"}], "[", "t", "]"}], " ", "-", " ", RowBox[{"2", " ", RowBox[{ RowBox[{"\[Psi]", "[", "N", "]"}], "[", "t", "]"}]}]}], " ", ")"}]}], " ", "+", " ", RowBox[{ RowBox[{"V", "[", "N", "]"}], " ", RowBox[{ RowBox[{"\[Psi]", "[", "N", "]"}], "[", "t", "]"}]}]}]}], TextForm]]], "\nNotice the equations at the two ends of the grid, ", StyleBox["i", FontSlant->"Italic"], " = 1 and ", StyleBox["i", FontSlant->"Italic"], " = ", StyleBox["N, ", FontSlant->"Italic"], "differ from the equations for quantum oscillations located at points \ separated from the ends.\n", StyleBox["Important:", FontWeight->"Bold"], " Remember, when we solve Schrodinger's equation on a grid, this is only an \ ", StyleBox["approximation. ", FontSlant->"Italic"], "In reality, space is continuous. The grid approximation is valid ", StyleBox["only when the quantum oscillations have a wavelength much longer \ than the spacing between grids. ", FontSlant->"Italic"], "As the energy and momentum of the quantum ball increases, the wavelength of \ its wavefunction decreases. Therefore, at some level as the energy increases, \ our computer solution becomes invalid. The finer grid spacing we can use \ (limited by the speed of our computer and the amount of available computer \ memory), the more accurate our computer-generated wavefunctions become!" }], "Text"], Cell["The matrix form of these equations are:", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"Off", "[", RowBox[{"General", "::", "spell1"}], "]"}], ";"}]], "Input", CellLabel->"In[1]:="], Cell[BoxData[ RowBox[{ RowBox[{"nGrid", " ", "=", " ", "50"}], ";"}]], "Input", CellLabel->"In[2]:="], Cell[BoxData[ RowBox[{ RowBox[{"mMatrix", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"Which", "[", RowBox[{ RowBox[{"j", " ", "==", " ", "i"}], ",", " ", RowBox[{"1", "+", " ", RowBox[{"v", "[", "i", "]"}]}], ",", " ", RowBox[{"j", " ", "==", " ", RowBox[{"i", "+", "1"}]}], ",", " ", RowBox[{"-", "0.5"}], ",", " ", RowBox[{"j", " ", "==", " ", RowBox[{"i", "-", "1"}]}], ",", " ", RowBox[{"-", "0.5"}], ",", " ", "True", ",", " ", "0"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", "1", ",", "nGrid"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"j", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}]}], ";"}]], "Input", CellLabel->"In[3]:="], Cell[BoxData[ RowBox[{"Shallow", "[", RowBox[{"mMatrix", ",", RowBox[{"{", RowBox[{"6", ",", "10"}], "}"}]}], "]"}]], "Input", CellLabel->"In[4]:="], Cell[TextData[{ "This is a \"matrix representation\" of Schrodinger's equation expressed on \ a grid. If the potential is zero everywhere, this matrix has identical \ eigenmodes as the matrix used to represent a string. \nAs mentioned above, \ the eigenvalues must be interpreted differently for quantum oscillations. The \ eigenvalues are proportional to the energy, ", StyleBox["e ", FontSlant->"Italic"], "= \[Omega]; whereas, for the string modes, the eigenvalues where \ proportional to ", Cell[BoxData[ FormBox[ SuperscriptBox["\[Omega]", "2"], TraditionalForm]]], "." }], "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Energy Levels", "Section"], Cell["\<\ Since we are solving quantum mechanics on a grid, the number of normal modes \ (and, therefore, the number of energy eigenvalues) are are equal to the \ number of grid points.\ \>", "Text"], Cell["\<\ When the potential vanishes everywhere within the quantum box, \ \>", "Text"], Cell[BoxData[ RowBox[{"?", "Eigensystem"}]], "Input", CellLabel->"In[5]:="], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"values", ",", " ", "vectors"}], "}"}], " ", "=", " ", RowBox[{"Eigensystem", "[", RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"mMatrix", " ", "/.", " ", RowBox[{ RowBox[{"v", "[", "_", "]"}], " ", "->", " ", "0"}]}], "//", " ", "N"}], "]"}], "]"}]}], ";"}]], "Input", CellLabel->"In[6]:="], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " orders the modes from the most complex (or rapidly varying) mode to the \ mode having the slowest spatial variations:" }], "Text"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"values", ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"PointSize", "[", "0.02`", "]"}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]], "Input", CellLabel->"In[7]:="], Cell[BoxData[ RowBox[{"Show", "[", RowBox[{"%", ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"30", ",", "50"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0.7`"}], "}"}]}], "}"}]}]}], "]"}]], "Input", CellLabel->"In[8]:="], Cell[TextData[{ "The lowest energy (frequency) mode corresponds to the longest wavelength. \n\ Notice also, the lowest energy possible for a ball is ", StyleBox["not", FontSlant->"Italic"], " equal to zero!" }], "Text"], Cell[BoxData[ RowBox[{"values", "\[LeftDoubleBracket]", RowBox[{"nGrid", "-", "5"}], "\[RightDoubleBracket]"}]], "Input", CellLabel->"In[9]:="], Cell["If there is a ball in the box, it can not have zero energy.", "Text"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"vectors", "\[LeftDoubleBracket]", RowBox[{"nGrid", "-", "5"}], "\[RightDoubleBracket]"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"nGrid", "+", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.4"}], ",", "0.4"}], "}"}]}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"PointSize", "[", "0.02", "]"}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"Ticks", "\[Rule]", "None"}], ",", RowBox[{"FrameTicks", "\[Rule]", "None"}]}], "]"}]], "Input", CellChangeTimes->{{3.450097834990251*^9, 3.450097837380227*^9}}, CellLabel->"In[10]:="], Cell["The first six modes are", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"modes", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{ "vectors", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"nGrid", "+", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.4"}], ",", "0.4"}], "}"}]}], "}"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", FractionBox[ RowBox[{"30", "-", "i"}], "5"], "]"}], ",", RowBox[{"Thickness", "[", "0.01", "]"}]}], "}"}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"Ticks", "\[Rule]", "None"}], ",", RowBox[{"FrameTicks", "\[Rule]", "None"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "nGrid", ",", RowBox[{"nGrid", "-", "5"}], ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.450097838723483*^9, 3.450097842924918*^9}}, CellLabel->"In[11]:="], Cell[BoxData[ RowBox[{"Show", "[", RowBox[{"modes", ",", RowBox[{"DisplayFunction", "\[Rule]", "$DisplayFunction"}]}], "]"}]], "Input", CellLabel->"In[12]:="], Cell["\<\ The probabilities for finding the quantum ball at any given position within \ the box are:\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"allModes", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{ SuperscriptBox[ RowBox[{"Abs", "[", RowBox[{ "vectors", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}], "2"], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"nGrid", "+", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0.05"}], "}"}]}], "}"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", FractionBox[ RowBox[{"30", "-", "i"}], "5"], "]"}], ",", RowBox[{"Thickness", "[", "0.01", "]"}]}], "}"}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"Ticks", "\[Rule]", "None"}], ",", RowBox[{"FrameTicks", "\[Rule]", "None"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}], ",", " ", RowBox[{"FrameLabel", " ", "\[Rule]", " ", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", RowBox[{"nGrid", "-", "i", "+", "1"}], "]"}], "<>", "\"\< Energy = \>\"", "<>", RowBox[{"ToString", "[", RowBox[{ "values", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}]}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "nGrid", ",", RowBox[{"nGrid", "-", "30"}], ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.450095474753572*^9, 3.45009556036967*^9}, { 3.4500957169917097`*^9, 3.4500958148254023`*^9}, {3.450095864884145*^9, 3.450095899828175*^9}}, CellLabel->"In[13]:="], Cell[BoxData[ RowBox[{ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{ "allModes", "\[LeftDoubleBracket]", "n", "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", "1", ",", "30", ",", "1"}], "}"}]}], "]"}], " "}]], "Input", CellChangeTimes->{{3.450095565663723*^9, 3.45009556972668*^9}, { 3.45009561540212*^9, 3.450095632632852*^9}, {3.450095665576356*^9, 3.450095724499103*^9}}, CellLabel->"In[14]:="], Cell[CellGroupData[{ Cell["Momentum representation", "Subsection"], Cell[TextData[{ "As explained during last week's class...\nThe momentum may be positive or \ negative depending upon whether the ball is moving to the right or to the \ left. The function ", StyleBox["momentum\[Psi]", FontWeight->"Bold"], " re-arranges the output from ", StyleBox["Fourier", FontWeight->"Bold"], " so that negative momentum is followed by the positive momentum values." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"rearrangeFourier", "[", "p_List", "]"}], " ", ":=", " ", RowBox[{"Reverse", "[", RowBox[{ RowBox[{"p", "[", RowBox[{"[", RowBox[{"Range", "[", RowBox[{ RowBox[{ RowBox[{"nGrid", "/", "2"}], " ", "+", " ", "1"}], ",", " ", "nGrid"}], "]"}], "]"}], "]"}], " ", StyleBox["~", FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], StyleBox["Join", FontColor->RGBColor[1, 0, 1]], StyleBox["~", FontColor->RGBColor[1, 0, 1]], " ", RowBox[{"p", "[", RowBox[{"[", RowBox[{"Range", "[", RowBox[{"1", ",", RowBox[{"nGrid", "/", "2"}]}], "]"}], "]"}], "]"}]}], "]"}]}]], "Input", CellLabel->"In[15]:="], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"momentum\[Psi]", "[", "\[Psi]_List", "]"}], " ", ":=", " ", RowBox[{"rearrangeFourier", "[", RowBox[{"Fourier", "[", "\[Psi]", "]"}], "]"}]}], ";"}]], "Input", CellLabel->"In[16]:="], Cell[TextData[{ "The corresponding values of momentum (or ", StyleBox["k", FontSlant->"Italic"], ") are given by the list below:" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"klist", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"2", RowBox[{"\[Pi]", "/", "nGrid"}]}], ")"}], "i"}], " ", "//", " ", "N"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", RowBox[{ RowBox[{ RowBox[{"-", "nGrid"}], "/", "2"}], "+", "1"}], ",", RowBox[{"nGrid", "/", "2"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellLabel->"In[17]:="], Cell[BoxData[ RowBox[{ RowBox[{"plotMomentum", "[", RowBox[{"\[Psi]_List", ",", "options___"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", "mlist", "}"}], ",", RowBox[{ RowBox[{"mlist", "=", RowBox[{"momentum\[Psi]", "[", "\[Psi]", "]"}]}], ";", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ "klist", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], ",", SuperscriptBox[ RowBox[{"Abs", "[", RowBox[{ "mlist", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}], "2"]}], "}"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", "nGrid"}], "}"}]}], "]"}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"Ticks", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "\[Pi]"}], ",", "0", ",", "\[Pi]"}], "}"}], ",", "None"}], "}"}]}], ",", "options"}], "]"}]}]}], "]"}]}]], "Input", CellChangeTimes->{3.4500963740934973`*^9}, CellLabel->"In[18]:="], Cell[BoxData[ RowBox[{"plotMomentum", "[", RowBox[{ RowBox[{"vectors", "\[LeftDoubleBracket]", RowBox[{"nGrid", "-", "2"}], "\[RightDoubleBracket]"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}], ",", RowBox[{"Frame", " ", "\[Rule]", " ", "True"}], ",", RowBox[{"PlotRange", " ", "\[Rule]", " ", "All"}], ",", RowBox[{"FrameLabel", " ", "\[Rule]", " ", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", RowBox[{"nGrid", "-", RowBox[{"(", RowBox[{"nGrid", "-", "2"}], ")"}], "+", "1"}], "]"}], "<>", "\"\< Energy = \>\"", "<>", RowBox[{"ToString", "[", RowBox[{"values", "\[LeftDoubleBracket]", RowBox[{"nGrid", "-", "2"}], "\[RightDoubleBracket]"}], "]"}]}]}]}], "]"}]], "Input", CellChangeTimes->{{3.450096158272197*^9, 3.450096191537237*^9}, { 3.450096234049645*^9, 3.450096248408017*^9}, {3.4500963841090307`*^9, 3.450096399901559*^9}}, CellLabel->"In[19]:="], Cell["As the energy increases, so does the momentum...", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"kModes", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"plotMomentum", "[", RowBox[{ RowBox[{ "vectors", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}], ",", RowBox[{"PlotRange", " ", "\[Rule]", " ", RowBox[{"{", RowBox[{"0", ",", "0.4"}], "}"}]}], ",", RowBox[{"Frame", " ", "\[Rule]", " ", "True"}], ",", RowBox[{"FrameLabel", " ", "\[Rule]", " ", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", RowBox[{"nGrid", "-", "i", "+", "1"}], "]"}], "<>", "\"\< Energy = \>\"", "<>", RowBox[{"ToString", "[", RowBox[{ "values", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}]}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "nGrid", ",", RowBox[{"nGrid", "-", "30"}], ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.4500959582044373`*^9, 3.4500959784838257`*^9}, 3.450096036012018*^9, {3.4500960695916*^9, 3.450096072910646*^9}, 3.450096285964199*^9, {3.450096318948236*^9, 3.450096326746567*^9}}, CellLabel->"In[20]:="], Cell[BoxData[ RowBox[{ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{"kModes", "\[LeftDoubleBracket]", "n", "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", "1", ",", "30", ",", "1"}], "}"}]}], "]"}], " "}]], "Input", CellChangeTimes->{{3.450095565663723*^9, 3.45009556972668*^9}, { 3.45009561540212*^9, 3.450095632632852*^9}, {3.450095665576356*^9, 3.450095724499103*^9}, 3.450095975596414*^9, {3.4500960139905233`*^9, 3.4500960308058033`*^9}}, CellLabel->"In[21]:="] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Combination of Two Modes", "Section"], Cell[TextData[{ "Recall that in quantum mechanics we are trying to compute the probabilities \ for values of our measurements of the particle's position, momentum, and \ energy. If the ball were arranged so that it would be likely to be located \ within a particular eigenmode, then the ball is considered to be within a \ particular ", StyleBox["energy", FontSlant->"Italic"], " ", StyleBox["state.\n", FontSlant->"Italic"], "The time dependence of the wavefunction of a single energy state is \n\t\ \[Psi](", StyleBox["x", FontSlant->"Italic"], ", ", StyleBox["t", FontSlant->"Italic"], ") \[Proportional] Exp[- I \[Omega] ", StyleBox["t", FontSlant->"Italic"], "] ", StyleBox["g", FontSlant->"Italic"], "(", StyleBox["x", FontSlant->"Italic"], "),\nwhere ", StyleBox["g", FontSlant->"Italic"], "(", StyleBox["x", FontSlant->"Italic"], ") is the time-independent spatial struncture of the normal mode." }], "Text"], Cell["Remember the identities", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"Exp", "[", RowBox[{ RowBox[{"-", "I"}], " ", "\[Omega]", " ", "t"}], "]"}], " ", "//", " ", "ExpToTrig"}]], "Input", CellLabel->"In[22]:="], Cell[BoxData[ SuperscriptBox[ RowBox[{"Abs", "[", RowBox[{"Exp", "[", RowBox[{"-", " ", "I"}], "]"}], "]"}], "2"]], "Input", CellLabel->"In[23]:="], Cell[TextData[{ "When a ball is likely to be within a single eigenmode, the probabilities \ for making any particular measurement of the ball ", StyleBox["will not change in time", FontSlant->"Italic"], "." }], "Text"], Cell["\<\ What about a ball that is equally likely to be within two eigenmodes? In this case,\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"two\[Psi]", "[", "t_", "]"}], " ", ":=", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{ RowBox[{ "vectors", "\[LeftDoubleBracket]", "nGrid", "\[RightDoubleBracket]"}], " ", RowBox[{"Exp", "[", RowBox[{ RowBox[{"-", "I"}], " ", RowBox[{ "values", "\[LeftDoubleBracket]", "nGrid", "\[RightDoubleBracket]"}], " ", "t"}], "]"}]}], " ", "+", " ", RowBox[{ RowBox[{"vectors", "\[LeftDoubleBracket]", RowBox[{"nGrid", "-", "1"}], "\[RightDoubleBracket]"}], " ", RowBox[{"Exp", "[", RowBox[{ RowBox[{"-", "I"}], " ", RowBox[{"values", "\[LeftDoubleBracket]", RowBox[{"nGrid", "-", "1"}], "\[RightDoubleBracket]"}], " ", "t"}], "]"}]}]}], ")"}], "/", RowBox[{"Sqrt", "[", "2", "]"}]}]}]], "Input", CellLabel->"In[24]:="], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ SuperscriptBox[ RowBox[{"Abs", "[", RowBox[{"two\[Psi]", "[", "0.0", "]"}], "]"}], "2"], ",", RowBox[{"Joined", "\[Rule]", "True"}]}], "]"}]], "Input", CellChangeTimes->{{3.450097070122093*^9, 3.450097070971054*^9}}, CellLabel->"In[25]:="], Cell[CellGroupData[{ Cell["Animation of Probability", "Subsubsection"], Cell[BoxData[ RowBox[{"ListAnimate", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{ SuperscriptBox[ RowBox[{"Abs", "[", RowBox[{"two\[Psi]", "[", "t", "]"}], "]"}], "2"], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"nGrid", "+", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0.1"}], "}"}]}], "}"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"Ticks", "\[Rule]", "None"}], ",", RowBox[{"FrameTicks", "\[Rule]", "None"}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "1000", ",", "25"}], "}"}]}], "]"}], "]"}]], "Input", CellChangeTimes->{ 3.4500970671596947`*^9, {3.45009709790187*^9, 3.450097134692058*^9}}, CellLabel->"In[26]:="] }, Closed]], Cell[CellGroupData[{ Cell["Animation of WaveFunction", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"plot\[Psi]", "[", RowBox[{"\[Psi]_List", ",", "options___"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"p1", ",", "p2", ",", "p3", ",", "p4"}], "}"}], ",", RowBox[{ RowBox[{"p1", "=", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Re", "[", "\[Psi]", "]"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"RGBColor", "[", RowBox[{"0", ",", "0", ",", "1"}], "]"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], ";", RowBox[{"p2", "=", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Im", "[", "\[Psi]", "]"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"RGBColor", "[", RowBox[{"1", ",", "0", ",", "0"}], "]"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], ";", RowBox[{"p3", "=", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Abs", "[", "\[Psi]", "]"}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], ";", RowBox[{"p4", "=", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"-", RowBox[{"Abs", "[", "\[Psi]", "]"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], ";", RowBox[{"Show", "[", RowBox[{"p1", ",", "p2", ",", "p3", ",", "p4", ",", RowBox[{"DisplayFunction", "\[Rule]", "$DisplayFunction"}], ",", "options"}], "]"}]}]}], "]"}]}], ";"}]], "Input", CellLabel->"In[27]:="], Cell[BoxData[ RowBox[{"ListAnimate", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{"plot\[Psi]", "[", RowBox[{ RowBox[{"two\[Psi]", "[", "t", "]"}], ",", " ", RowBox[{"PlotRange", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"-", "0.3"}], ",", " ", "0.3"}], "}"}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "1000", ",", "25"}], "}"}]}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.450097160342856*^9, 3.450097165547619*^9}}, CellLabel->"In[28]:="] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["A Potential Barrier", "Section"], Cell[TextData[{ "For your second ", StyleBox["Mathematica", FontSlant->"Italic"], " project, some of you may examine the influence of nonuniform potentials on \ quantum oscillations. \nUsing ", StyleBox["Eigensystem", FontWeight->"Bold"], ", the energy levels are relatively easy to find.\nFirst, we define a \ potential barrier, and then use ", StyleBox["Eigensystem", FontWeight->"Bold"], " to determine the energy levels and the spatial structures of the \ corresponding wavefunctions." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"vBarrier", "[", "i_Integer", "]"}], " ", ":=", " ", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"i", " ", ">", " ", RowBox[{ RowBox[{"nGrid", "/", "2"}], " ", "-", "3"}]}], " ", "&&", " ", RowBox[{"i", " ", "<", " ", RowBox[{ RowBox[{"nGrid", "/", "2"}], " ", "+", "3"}]}]}], ",", " ", "0.2", ",", " ", "0.0"}], "]"}]}]], "Input", CellLabel->"In[29]:="], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{"vBarrier", "[", "i", "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", "nGrid"}], "}"}]}], "]"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"PointSize", "[", "0.02", "]"}]}]}], "]"}]], "Input", CellChangeTimes->{3.450097186915636*^9}, CellLabel->"In[30]:="], Cell["\<\ When the potential vanishes everywhere within the quantum box, \ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"values", ",", " ", "vectors"}], "}"}], " ", "=", " ", RowBox[{"Eigensystem", "[", RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"mMatrix", " ", "/.", " ", RowBox[{ RowBox[{"v", "[", "i_", "]"}], " ", "->", RowBox[{"vBarrier", "[", "i", "]"}]}]}], "//", " ", "N"}], "]"}], "]"}]}], ";"}]], "Input", CellLabel->"In[31]:="], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " orders the modes from the highest frequency (", StyleBox["i.e.", FontSlant->"Italic"], " highest energy) to the lowest:" }], "Text"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"values", ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"PointSize", "[", "0.02`", "]"}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]], "Input", CellLabel->"In[32]:="], Cell["\<\ Notice the barrier creates energy levels having nearly identical eigenvalues.\ \ \>", "Text"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"values", ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"PointSize", "[", "0.02`", "]"}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"30", ",", "50"}], "}"}], ",", RowBox[{"{", RowBox[{"0.`", ",", "0.5`"}], "}"}]}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]], "Input", CellLabel->"In[33]:="], Cell[BoxData[ RowBox[{ RowBox[{"allModes", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{ SuperscriptBox[ RowBox[{"Abs", "[", RowBox[{ "vectors", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}], "2"], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"nGrid", "+", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0.1"}], "}"}]}], "}"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", FractionBox[ RowBox[{"30", "-", "i"}], "5"], "]"}], ",", RowBox[{"Thickness", "[", "0.01", "]"}]}], "}"}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"Ticks", "\[Rule]", "None"}], ",", RowBox[{"FrameTicks", "\[Rule]", "None"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}], ",", " ", RowBox[{"FrameLabel", " ", "\[Rule]", " ", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", RowBox[{"nGrid", "-", "i", "+", "1"}], "]"}], "<>", "\"\< Energy = \>\"", "<>", RowBox[{"ToString", "[", RowBox[{ "values", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}]}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "nGrid", ",", RowBox[{"nGrid", "-", "30"}], ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.450095474753572*^9, 3.45009556036967*^9}, { 3.4500957169917097`*^9, 3.4500958148254023`*^9}, {3.450095864884145*^9, 3.450095899828175*^9}, 3.4500972930451717`*^9}, CellLabel->"In[34]:="], Cell[BoxData[ RowBox[{ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{ "allModes", "\[LeftDoubleBracket]", "n", "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", "1", ",", "30", ",", "1"}], "}"}]}], "]"}], " "}]], "Input", CellChangeTimes->{{3.450095565663723*^9, 3.45009556972668*^9}, { 3.45009561540212*^9, 3.450095632632852*^9}, {3.450095665576356*^9, 3.450095724499103*^9}}, CellLabel->"In[35]:="] }, Closed]], Cell[CellGroupData[{ Cell["A Potential Well", "Section"], Cell["Start with a potential square well with a depth of -0.2.", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"vBarrier", "[", "i_Integer", "]"}], " ", ":=", " ", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"i", " ", ">", " ", RowBox[{ RowBox[{"nGrid", "/", "2"}], " ", "-", " ", "5"}]}], " ", "&&", " ", RowBox[{"i", " ", "<", " ", RowBox[{ RowBox[{"nGrid", "/", "2"}], " ", "+", "5"}]}]}], ",", " ", RowBox[{"-", "0.2"}], ",", " ", "0.0"}], "]"}]}]], "Input", CellLabel->"In[36]:="], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{"vBarrier", "[", "i", "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", "nGrid"}], "}"}]}], "]"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"PointSize", "[", "0.02", "]"}]}]}], "]"}]], "Input", CellChangeTimes->{3.4500971991485977`*^9}, CellLabel->"In[37]:="], Cell["\<\ When the potential vanishes everywhere within the quantum box, \ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"values", ",", " ", "vectors"}], "}"}], " ", "=", " ", RowBox[{"Eigensystem", "[", RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"mMatrix", " ", "/.", " ", RowBox[{ RowBox[{"v", "[", "i_", "]"}], " ", "\[Rule]", " ", RowBox[{"vBarrier", "[", "i", "]"}]}]}], "//", " ", "N"}], "]"}], "]"}]}], ";"}]], "Input", CellLabel->"In[38]:="], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " orders the modes from the highest frequency (", StyleBox["i.e.", FontSlant->"Italic"], " highest energy) to the lowest:" }], "Text"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"values", ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"PointSize", "[", "0.02`", "]"}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]], "Input", CellLabel->"In[39]:="], Cell[BoxData[ RowBox[{ RowBox[{"allModes", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{ SuperscriptBox[ RowBox[{"Abs", "[", RowBox[{ "vectors", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}], "2"], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"nGrid", "+", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0.2"}], "}"}]}], "}"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", FractionBox[ RowBox[{"30", "-", "i"}], "5"], "]"}], ",", RowBox[{"Thickness", "[", "0.01", "]"}]}], "}"}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"Ticks", "\[Rule]", "None"}], ",", RowBox[{"FrameTicks", "\[Rule]", "None"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}], ",", " ", RowBox[{"FrameLabel", " ", "\[Rule]", " ", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", RowBox[{"nGrid", "-", "i", "+", "1"}], "]"}], "<>", "\"\< Energy = \>\"", "<>", RowBox[{"ToString", "[", RowBox[{ "values", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}]}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "nGrid", ",", RowBox[{"nGrid", "-", "30"}], ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.450095474753572*^9, 3.45009556036967*^9}, { 3.4500957169917097`*^9, 3.4500958148254023`*^9}, {3.450095864884145*^9, 3.450095899828175*^9}, 3.4500972930451717`*^9, {3.450097394469263*^9, 3.45009739993467*^9}}, CellLabel->"In[40]:="], Cell[BoxData[ RowBox[{ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{ "allModes", "\[LeftDoubleBracket]", "n", "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", "1", ",", "30", ",", "1"}], "}"}]}], "]"}], " "}]], "Input", CellChangeTimes->{{3.450095565663723*^9, 3.45009556972668*^9}, { 3.45009561540212*^9, 3.450095632632852*^9}, {3.450095665576356*^9, 3.450095724499103*^9}}, CellLabel->"In[41]:="], Cell[TextData[{ "Notice the potential well creates two \"negative energy\" levels. As the \ potential well becomes deeper (", StyleBox["i.e. ", FontSlant->"Italic"], " more negative), additional modes can become ", StyleBox["trapped", FontSlant->"Italic"], " within the potential well." }], "Text"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"values", ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"PointSize", "[", "0.02`", "]"}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"30", ",", "50"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.4"}], ",", "0.4"}], "}"}]}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.4500972049496603`*^9, 3.4500972060446863`*^9}}, CellLabel->"In[42]:="], Cell[BoxData[ RowBox[{ RowBox[{"kModes", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"plotMomentum", "[", RowBox[{ RowBox[{ "vectors", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}], ",", RowBox[{"PlotRange", " ", "\[Rule]", " ", RowBox[{"{", RowBox[{"0", ",", "0.4"}], "}"}]}], ",", RowBox[{"Frame", " ", "\[Rule]", " ", "True"}], ",", RowBox[{"FrameLabel", " ", "\[Rule]", " ", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", RowBox[{"nGrid", "-", "i", "+", "1"}], "]"}], "<>", "\"\< Energy = \>\"", "<>", RowBox[{"ToString", "[", RowBox[{ "values", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}]}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "nGrid", ",", RowBox[{"nGrid", "-", "30"}], ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.4500959582044373`*^9, 3.4500959784838257`*^9}, 3.450096036012018*^9, {3.4500960695916*^9, 3.450096072910646*^9}, 3.450096285964199*^9, {3.450096318948236*^9, 3.450096326746567*^9}}, CellLabel->"In[43]:="], Cell[BoxData[ RowBox[{ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{"kModes", "\[LeftDoubleBracket]", "n", "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", "1", ",", "30", ",", "1"}], "}"}]}], "]"}], " "}]], "Input", CellChangeTimes->{{3.450095565663723*^9, 3.45009556972668*^9}, { 3.45009561540212*^9, 3.450095632632852*^9}, {3.450095665576356*^9, 3.450095724499103*^9}, 3.450095975596414*^9, {3.4500960139905233`*^9, 3.4500960308058033`*^9}}, CellLabel->"In[44]:="], Cell[TextData[{ "What happens as the potential well depth decreases? Try ", StyleBox["V", FontSlant->"Italic"], " = -0.05 and -0.02." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["A Parabolic Well (A Quantum Harmonic Oscillator)", "Section"], Cell[TextData[{ "The shape of the potential, ", StyleBox["V", FontSlant->"Italic"], "(", StyleBox["x", FontSlant->"Italic"], "), has a profound effect on the structure and energy of the quantum \ eigenstates.\nIn this section, we examine the quantum equivalent of a \ parabolic potential well, ", StyleBox["V", FontSlant->"Italic"], "(", StyleBox["x", FontSlant->"Italic"], ") = ", Cell[BoxData[ FormBox[ SubscriptBox["V", "0"], TraditionalForm]]], Cell[BoxData[ FormBox[ SuperscriptBox["x", "2"], TraditionalForm]]], ". We will center the potential well at the average grid location in our \ simulation." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"vBarrier", "[", "i_Integer", "]"}], " ", ":=", " ", RowBox[{"0.025", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"i", " ", "-", " ", RowBox[{ RowBox[{"(", RowBox[{"nGrid", "+", "1"}], ")"}], "/", "2"}]}], ")"}], "2"]}]}]], "Input", CellLabel->"In[45]:="], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{"vBarrier", "[", "i", "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", "nGrid"}], "}"}]}], "]"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"PointSize", "[", "0.02`", "]"}]}]}], "]"}]], "Input", CellLabel->"In[46]:="], Cell["\<\ When the potential vanishes everywhere within the quantum box, \ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"values", ",", " ", "vectors"}], "}"}], " ", "=", " ", RowBox[{"Eigensystem", "[", RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"mMatrix", " ", "/.", " ", RowBox[{ RowBox[{"v", "[", "i_", "]"}], " ", "\[Rule]", " ", RowBox[{"vBarrier", "[", "i", "]"}]}]}], "//", " ", "N"}], "]"}], "]"}]}], ";"}]], "Input", CellLabel->"In[47]:="], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"values", ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"PointSize", "[", "0.02", "]"}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{3.4500974967018347`*^9}, CellLabel->"In[48]:="], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " orders the modes from the highest frequency (", StyleBox["i.e.", FontSlant->"Italic"], " highest energy) to the lowest:" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"allModes", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{ SuperscriptBox[ RowBox[{"Abs", "[", RowBox[{ "vectors", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}], "2"], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"nGrid", "+", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0.25"}], "}"}]}], "}"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", FractionBox[ RowBox[{"30", "-", "i"}], "5"], "]"}], ",", RowBox[{"Thickness", "[", "0.01", "]"}]}], "}"}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"Ticks", "\[Rule]", "None"}], ",", RowBox[{"FrameTicks", "\[Rule]", "None"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}], ",", " ", RowBox[{"FrameLabel", " ", "\[Rule]", " ", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", RowBox[{"nGrid", "-", "i", "+", "1"}], "]"}], "<>", "\"\< Energy = \>\"", "<>", RowBox[{"ToString", "[", RowBox[{ "values", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}]}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "nGrid", ",", RowBox[{"nGrid", "-", "30"}], ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.450095474753572*^9, 3.45009556036967*^9}, { 3.4500957169917097`*^9, 3.4500958148254023`*^9}, {3.450095864884145*^9, 3.450095899828175*^9}, 3.4500972930451717`*^9, {3.450097394469263*^9, 3.45009739993467*^9}, 3.450097538593994*^9}, CellLabel->"In[49]:="], Cell[BoxData[ RowBox[{ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{ "allModes", "\[LeftDoubleBracket]", "n", "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", "1", ",", "30", ",", "1"}], "}"}]}], "]"}], " "}]], "Input", CellChangeTimes->{{3.450095565663723*^9, 3.45009556972668*^9}, { 3.45009561540212*^9, 3.450095632632852*^9}, {3.450095665576356*^9, 3.450095724499103*^9}}, CellLabel->"In[50]:="], Cell[TextData[{ "(These are Hermite polynomials, and ", StyleBox["Mathematica", FontSlant->"Italic"], " is able to find these solutions exactly.)" }], "Text"], Cell[BoxData[ RowBox[{"Table", "[", RowBox[{ RowBox[{"plot\[Psi]", "[", RowBox[{ RowBox[{ "vectors", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], ",", RowBox[{"PlotRange", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"-", "0.7"}], ",", "0.7"}], "}"}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "nGrid", ",", RowBox[{"nGrid", "-", "5"}], ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{3.4500976837187157`*^9}, CellLabel->"In[51]:="], Cell[TextData[{ "The parabolic potential well confines the quantum ball more or less to the \ center of the box.\nThe energy levels are approximately ", StyleBox["linearly", FontSlant->"Italic"], " dependent upon the mode index, ", StyleBox["provided", FontSlant->"Italic"], " that the grid spacing is sufficient to accurate represent the mode. \ (Compare this to the uniform box. In this case, the energy levels increase as \ the ", StyleBox["square", FontSlant->"Italic"], " of the mode index.)" }], "Text", CellChangeTimes->{{3.450097626296646*^9, 3.450097645806175*^9}}], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"values", ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"PointSize", "[", "0.02`", "]"}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"30", ",", "50"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "4"}], "}"}]}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]], "Input", CellLabel->"In[52]:="], Cell[BoxData[ RowBox[{ RowBox[{"kModes", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"plotMomentum", "[", RowBox[{ RowBox[{ "vectors", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}], ",", RowBox[{"PlotRange", " ", "\[Rule]", " ", RowBox[{"{", RowBox[{"0", ",", "0.15"}], "}"}]}], ",", RowBox[{"Frame", " ", "\[Rule]", " ", "True"}], ",", RowBox[{"FrameLabel", " ", "\[Rule]", " ", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", RowBox[{"nGrid", "-", "i", "+", "1"}], "]"}], "<>", "\"\< Energy = \>\"", "<>", RowBox[{"ToString", "[", RowBox[{ "values", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "]"}]}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "nGrid", ",", RowBox[{"nGrid", "-", "30"}], ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.4500959582044373`*^9, 3.4500959784838257`*^9}, 3.450096036012018*^9, {3.4500960695916*^9, 3.450096072910646*^9}, 3.450096285964199*^9, {3.450096318948236*^9, 3.450096326746567*^9}, { 3.4500977177722683`*^9, 3.450097724355651*^9}}, CellLabel->"In[53]:="], Cell[BoxData[ RowBox[{ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{"kModes", "\[LeftDoubleBracket]", "n", "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", "1", ",", "30", ",", "1"}], "}"}]}], "]"}], " "}]], "Input", CellChangeTimes->{{3.450095565663723*^9, 3.45009556972668*^9}, { 3.45009561540212*^9, 3.450095632632852*^9}, {3.450095665576356*^9, 3.450095724499103*^9}, 3.450095975596414*^9, {3.4500960139905233`*^9, 3.4500960308058033`*^9}}, CellLabel->"In[54]:="], Cell[CellGroupData[{ Cell["Multiple Modes", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{"two\[Psi]", "[", "t_", "]"}], " ", ":=", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"vectors", "\[LeftDoubleBracket]", RowBox[{"nGrid", "-", "5"}], "\[RightDoubleBracket]"}], " ", RowBox[{"Exp", "[", RowBox[{ RowBox[{"-", "I"}], " ", RowBox[{"values", "\[LeftDoubleBracket]", RowBox[{"nGrid", "-", "5"}], "\[RightDoubleBracket]"}], " ", "t"}], "]"}]}], " ", "+", " ", RowBox[{ RowBox[{"vectors", "\[LeftDoubleBracket]", RowBox[{"nGrid", "-", "6"}], "\[RightDoubleBracket]"}], " ", RowBox[{"Exp", "[", RowBox[{ RowBox[{"-", "I"}], " ", RowBox[{"values", "\[LeftDoubleBracket]", RowBox[{"nGrid", "-", "6"}], "\[RightDoubleBracket]"}], " ", "t"}], "]"}]}]}], ")"}], "/", RowBox[{"Sqrt", "[", "2", "]"}]}]}]], "Input", CellLabel->"In[55]:="], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ SuperscriptBox[ RowBox[{"Abs", "[", RowBox[{"two\[Psi]", "[", "0.0", "]"}], "]"}], "2"], ",", RowBox[{"Joined", "\[Rule]", "True"}]}], "]"}]], "Input", CellChangeTimes->{{3.4500977398679457`*^9, 3.4500977401290894`*^9}}, CellLabel->"In[56]:="], Cell[BoxData[ RowBox[{"ListAnimate", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{ SuperscriptBox[ RowBox[{"Abs", "[", RowBox[{"two\[Psi]", "[", "t", "]"}], "]"}], "2"], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"nGrid", "+", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0.2"}], "}"}]}], "}"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"Ticks", "\[Rule]", "None"}], ",", RowBox[{"FrameTicks", "\[Rule]", "None"}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "100", ",", "5"}], "}"}]}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.450097751220028*^9, 3.450097776445239*^9}}, CellLabel->"In[57]:="], Cell[BoxData[ RowBox[{"ListAnimate", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{"plot\[Psi]", "[", RowBox[{ RowBox[{"two\[Psi]", "[", "t", "]"}], ",", " ", RowBox[{"PlotRange", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5"}], ",", " ", "0.5"}], "}"}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "100", ",", "5"}], "}"}]}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.450097781701543*^9, 3.45009778917857*^9}}, CellLabel->"In[58]:="] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Summary", "Section"], Cell[TextData[{ "We have used ", StyleBox["Mathematica's ", FontSlant->"Italic"], "built-in ", StyleBox["Eigensystem[\[Ellipsis]]", FontWeight->"Bold"], " command to analyze the normal modes of the quantum wavefunction. For a \ \"particle in a box,\" the normal modes are the sine and cosine functions. \ For parabolic potential wells, they are Hermite polynomials. For potential \ wells, trapped particle modes appear, provided that the potential well is \ sufficiently deep. " }], "Text"] }, Closed]] }, Open ]] }, WindowSize->{793, 788}, WindowMargins->{{26, Automatic}, {Automatic, 10}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, ShowSelection->True, FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (May 21, 2008)", StyleDefinitions->"TutorialBook.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 30, 0, 51, "Title"], Cell[623, 25, 29, 0, 27, "Subsubtitle"], Cell[CellGroupData[{ Cell[677, 29, 31, 0, 86, "Section"], Cell[711, 31, 464, 11, 59, "Text"], Cell[1178, 44, 2010, 75, 308, "Text"], Cell[CellGroupData[{ Cell[3213, 123, 51, 0, 34, "Subsection"], Cell[3267, 125, 4836, 147, 360, "Text"], Cell[8106, 274, 55, 0, 23, "Text"], Cell[8164, 276, 133, 4, 24, "Input"], Cell[8300, 282, 105, 3, 26, "Input"], Cell[8408, 287, 789, 22, 63, "Input"], Cell[9200, 311, 162, 5, 26, "Input"], Cell[9365, 318, 598, 14, 90, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[10012, 338, 32, 0, 54, "Section"], Cell[10047, 340, 199, 4, 41, "Text"], Cell[10249, 346, 87, 2, 23, "Text"], Cell[10339, 350, 77, 2, 26, "Input"], Cell[10419, 354, 397, 12, 28, "Input"], Cell[10819, 368, 198, 5, 23, "Text"], Cell[11020, 375, 344, 10, 44, "Input"], Cell[11367, 387, 307, 10, 26, "Input"], Cell[11677, 399, 224, 6, 53, "Text"], Cell[11904, 407, 148, 3, 26, "Input"], Cell[12055, 412, 75, 0, 23, "Text"], Cell[12133, 414, 772, 20, 63, "Input"], Cell[12908, 436, 39, 0, 23, "Text"], Cell[12950, 438, 1341, 36, 156, "Input"], Cell[14294, 476, 170, 5, 26, "Input"], Cell[14467, 483, 114, 3, 23, "Text"], Cell[14584, 488, 1880, 48, 192, "Input"], Cell[16467, 538, 493, 14, 26, "Input"], Cell[CellGroupData[{ Cell[16985, 556, 45, 0, 34, "Subsection"], Cell[17033, 558, 407, 10, 72, "Text"], Cell[17443, 570, 786, 26, 64, "Input"], Cell[18232, 598, 239, 6, 28, "Input"], Cell[18474, 606, 146, 5, 23, "Text"], Cell[18623, 613, 510, 17, 26, "Input"], Cell[19136, 632, 1233, 35, 106, "Input"], Cell[20372, 669, 982, 22, 80, "Input"], Cell[21357, 693, 64, 0, 23, "Text"], Cell[21424, 695, 1288, 31, 80, "Input"], Cell[22715, 728, 563, 14, 26, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[23327, 748, 43, 0, 54, "Section"], Cell[23373, 750, 953, 34, 150, "Text"], Cell[24329, 786, 39, 0, 23, "Text"], Cell[24371, 788, 186, 6, 26, "Input"], Cell[24560, 796, 160, 5, 29, "Input"], Cell[24723, 803, 224, 6, 41, "Text"], Cell[24950, 811, 107, 3, 53, "Text"], Cell[25060, 816, 903, 26, 64, "Input"], Cell[25966, 844, 310, 8, 34, "Input"], Cell[CellGroupData[{ Cell[26301, 856, 49, 0, 33, "Subsubsection"], Cell[26353, 858, 946, 26, 112, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[27336, 889, 50, 0, 33, "Subsubsection"], Cell[27389, 891, 1854, 45, 171, "Input"], Cell[29246, 938, 535, 15, 44, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[29830, 959, 38, 0, 54, "Section"], Cell[29871, 961, 514, 14, 101, "Text"], Cell[30388, 977, 445, 13, 28, "Input"], Cell[30836, 992, 392, 11, 26, "Input"], Cell[31231, 1005, 87, 2, 23, "Text"], Cell[31321, 1009, 433, 13, 44, "Input"], Cell[31757, 1024, 204, 7, 23, "Text"], Cell[31964, 1033, 345, 10, 44, "Input"], Cell[32312, 1045, 103, 3, 23, "Text"], Cell[32418, 1050, 561, 17, 45, "Input"], Cell[32982, 1069, 1905, 48, 192, "Input"], Cell[34890, 1119, 493, 14, 26, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[35420, 1138, 35, 0, 54, "Section"], Cell[35458, 1140, 72, 0, 23, "Text"], Cell[35533, 1142, 465, 13, 46, "Input"], Cell[36001, 1157, 394, 11, 26, "Input"], Cell[36398, 1170, 87, 2, 23, "Text"], Cell[36488, 1174, 443, 13, 44, "Input"], Cell[36934, 1189, 204, 7, 23, "Text"], Cell[37141, 1198, 345, 10, 44, "Input"], Cell[37489, 1210, 1954, 49, 192, "Input"], Cell[39446, 1261, 493, 14, 26, "Input"], Cell[39942, 1277, 307, 9, 41, "Text"], Cell[40252, 1288, 654, 19, 44, "Input"], Cell[40909, 1309, 1288, 31, 80, "Input"], Cell[42200, 1342, 563, 14, 26, "Input"], Cell[42766, 1358, 150, 5, 23, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[42953, 1368, 67, 0, 54, "Section"], Cell[43023, 1370, 647, 24, 73, "Text"], Cell[43673, 1396, 333, 11, 31, "Input"], Cell[44009, 1409, 351, 10, 26, "Input"], Cell[44363, 1421, 87, 2, 23, "Text"], Cell[44453, 1425, 443, 13, 44, "Input"], Cell[44899, 1440, 388, 11, 44, "Input"], Cell[45290, 1453, 204, 7, 23, "Text"], Cell[45497, 1462, 1977, 49, 192, "Input"], Cell[47477, 1513, 493, 14, 26, "Input"], Cell[47973, 1529, 163, 5, 23, "Text"], Cell[48139, 1536, 546, 16, 45, "Input"], Cell[48688, 1554, 588, 15, 89, "Text"], Cell[49279, 1571, 556, 17, 44, "Input"], Cell[49838, 1590, 1341, 32, 80, "Input"], Cell[51182, 1624, 563, 14, 26, "Input"], Cell[CellGroupData[{ Cell[51770, 1642, 39, 0, 33, "Subsubsection"], Cell[51812, 1644, 937, 25, 64, "Input"], Cell[52752, 1671, 314, 8, 34, "Input"], Cell[53069, 1681, 918, 25, 112, "Input"], Cell[53990, 1708, 532, 15, 44, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[54571, 1729, 26, 0, 54, "Section"], Cell[54600, 1731, 499, 12, 60, "Text"] }, Closed]] }, Open ]] } ] *) (* End of internal cache information *)