(* 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[ 30392, 931] NotebookOptionsPosition[ 27923, 850] NotebookOutlinePosition[ 28314, 867] CellTagsIndexPosition[ 28271, 864] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Scattering from Multiple Potential Barriers", "Title"], Cell["Student Projects in AP1603 investigating quantum mechanics.", \ "Subsubtitle"], Cell["\<\ All projects must have\[Ellipsis] Name:____________ Email:_____@columbia.edu\ \>", "Subsubtitle"], Cell[CellGroupData[{ Cell["Introduction", "Section"], Cell[TextData[{ "The second general theme of our ", StyleBox["Mathematica", FontSlant->"Italic"], " investigations is oscillations. We have seen that simple models of \ classical oscilations, such as those found on strings, leads naturally to ", StyleBox["partial differential equations. ", FontSlant->"Italic"], "These equations require careful solution on a computer to avoid numerical \ instability or inaccuracy.", " In this project, you are to go \"atomic\" and use ", StyleBox["Mathematica", FontSlant->"Italic"], " to continue your investigations of the numerical solutions to the \ time-dependent Schr\[ODoubleDot]dinger's equation.\n\nI suggest you perform \ numerical experiments similar to those I presented in our classroom \ notebooks. Like last quarter, your goal is to produce a complete ", StyleBox["Mathematica", FontSlant->"Italic"], " notebook containing a summary of your investigations. I have prepared a \ general outline as a suggested guide to a notebook on quantum oscillations. \ If you wish, you can investigate other related topics (but I recommend that \ you speak with me before you begin programming.) Your notebook should contain \ ", StyleBox["Mathematica", FontSlant->"Italic"], " expressions and graphics which illustrate your solution. Try not to \ include a large number of repeated expressions. Instead, generate a table or \ graphic of your results. In all cases, format your notebook and include \ texual comments and descriptions. Your notebook need not be long. It should \ be interesting and arrive at a definite conclusion." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Scattering from Multiple Potential Barriers", "Section"], Cell["\<\ How does a quantum ball reflect from multiple potential barriers?\ \>", "Text"], Cell["\<\ For example, consider the following two potential barriers, one with multiple \ potential hills:\ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{"Off", "[", RowBox[{"General", "::", "\"\\""}], "]"}], ";"}], "\n", RowBox[{ RowBox[{"nGrid", "=", "200"}], ";"}], "\n", RowBox[{ RowBox[{"xB1", "=", RowBox[{"Floor", "[", RowBox[{"0.6", " ", "nGrid"}], "]"}]}], ";", RowBox[{"xB2", "=", RowBox[{"Floor", "[", RowBox[{"0.7", " ", "nGrid"}], "]"}]}], ";", RowBox[{"dB", "=", RowBox[{"Floor", "[", RowBox[{"0.02", " ", "nGrid"}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{"v1", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"Which", "[", RowBox[{ RowBox[{"xB1", "\[LessEqual]", "x", "\[LessEqual]", RowBox[{"xB1", "+", "dB"}]}], ",", "0.1", ",", "True", ",", "0."}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "1", ",", "nGrid"}], "}"}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{"v2", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"Which", "[", RowBox[{ RowBox[{"xB1", "\[LessEqual]", "x", "\[LessEqual]", RowBox[{"xB1", "+", "dB"}]}], ",", "0.1", ",", RowBox[{"xB2", "\[LessEqual]", "x", "\[LessEqual]", RowBox[{"xB2", "+", "dB"}]}], ",", "0.2", ",", "True", ",", "0."}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "1", ",", "nGrid"}], "}"}]}], "]"}]}], ";"}], "\n", RowBox[{"ListPlot", "[", RowBox[{"v1", ",", RowBox[{"PlotLabel", "\[Rule]", "\"\\""}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "0.2"}], "}"}]}]}], "]"}], "\n", RowBox[{"ListPlot", "[", RowBox[{"v2", ",", RowBox[{"PlotLabel", "\[Rule]", "\"\\""}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "0.2"}], "}"}]}]}], "]"}]}], "Input", CellChangeTimes->{{3.4489018570653057`*^9, 3.448901888826962*^9}, 3.448901925951317*^9}], Cell[TextData[{ "For particles moving to the right with initial momentum less than about \ 0.45, the first barrier height is larger than the kinetic energy of the \ particle. The particle can tunnel through the barrier, but classically, it is \ reflected. \nWhen the second barrier is added, normal modes can exist. The \ presense of these modes influence significantly the coupling of quantum \ particles through the first barrier. \n", StyleBox["Question: ", FontWeight->"Bold"], " As a function of initial momentum (or energy), what is the reflection \ coeffiecient from a single barrier and a multiple barrier? Can you suggestion \ a reason for the difference?" }], "Text"], Cell["To proceed, I suggest the following three steps.", "Text"], Cell[CellGroupData[{ Cell["Step 1: Preparing the Notebook", "Subsection"], Cell[TextData[{ "First, you must prepare your notebook so that you are able to compute \ solutions to Schrodinger's equations on a grid, including a variable \ potential, ", StyleBox["V", FontSlant->"Italic"], "(", StyleBox["x", FontSlant->"Italic"], ")", ". \nOf course, we must use the Crank-Nicolson method to solve the \ finite-difference approximation to the continuous partial differential \ equation with good accuracy. We set the grid-spacing to unity in both the \ time and spatial directions. " }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"cnStep", "[", RowBox[{"\[Psi]_List", ",", " ", "v_List"}], "]"}], " ", ":=", " ", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"sparseA", ",", "r", ",", "len"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"len", " ", "=", " ", RowBox[{"Length", "[", "\[Psi]", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"sparseA", " ", "=", " ", RowBox[{"SparseArray", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i_", ",", "i_"}], "}"}], " ", ":>", " ", RowBox[{"1", " ", "+", " ", RowBox[{"I", " ", RowBox[{"(", RowBox[{"1.0", " ", "+", " ", RowBox[{ "v", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]}], ")"}], " ", "0.5"}]}]}], ",", " ", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i_", ",", "j_"}], "}"}], "/;", " ", RowBox[{ RowBox[{"Abs", "[", RowBox[{"i", "-", "j"}], "]"}], " ", "\[Equal]", " ", "1"}]}], " ", "\[Rule]", " ", RowBox[{ RowBox[{"-", " ", "I"}], " ", "0.25"}]}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"len", ",", " ", "len"}], "}"}], ",", " ", "0.0"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"r", " ", "=", " ", RowBox[{ RowBox[{"ListConvolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"I", " ", "0.25"}], ",", RowBox[{"1.0", " ", "-", " ", RowBox[{"I", " ", "0.5"}]}], ",", " ", RowBox[{"I", " ", "0.25"}]}], "}"}], ",", "\[Psi]", ",", " ", "2", ",", " ", "0.0"}], "]"}], " ", "-", " ", RowBox[{"I", " ", "\[Psi]", " ", "v", " ", "0.5"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"(*", " ", StyleBox[ RowBox[{"fixed", " ", "boundaries"}], FontColor->RGBColor[0, 1, 0]], " ", "*)"}], "\[IndentingNewLine]", RowBox[{"sol", " ", "=", " ", RowBox[{"LinearSolve", "[", RowBox[{"sparseA", ",", "r"}], "]"}]}], ";", "\[IndentingNewLine]", "sol"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.448901019266375*^9, 3.448901090956354*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"cnStep", "[", RowBox[{"a_List", ",", "b_List", ",", "v_List"}], "]"}], "[", "\[Psi]_List", "]"}], " ", ":=", " ", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"sparseA", ",", "r", ",", "len"}], "}"}], ",", RowBox[{"(*", " ", StyleBox[ RowBox[{ RowBox[{"a", " ", "faster"}], ",", " ", RowBox[{"pre", "-", RowBox[{"defined", " ", "version", " ", "of", " ", "cnStep"}]}]}], FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"len", " ", "=", " ", RowBox[{"Length", "[", "\[Psi]", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"r", " ", "=", " ", RowBox[{ RowBox[{"ListConvolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"I", " ", "0.25"}], ",", RowBox[{"1.0", " ", "-", " ", RowBox[{"I", " ", "0.5"}]}], ",", " ", RowBox[{"I", " ", "0.25"}]}], "}"}], ",", "\[Psi]", ",", " ", "2", ",", " ", "0.0"}], "]"}], " ", "-", " ", RowBox[{"I", " ", "\[Psi]", " ", "v", " ", "0.5"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"sparseA", " ", "=", " ", RowBox[{"SparseArray", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"Band", "[", RowBox[{"{", RowBox[{"1", ",", "2"}], "}"}], "]"}], " ", "\[Rule]", " ", "a"}], ",", " ", RowBox[{ RowBox[{"Band", "[", RowBox[{"{", RowBox[{"1", ",", "1"}], "}"}], "]"}], " ", "\[Rule]", " ", "b"}], ",", " ", RowBox[{ RowBox[{"Band", "[", RowBox[{"{", RowBox[{"2", ",", "1"}], "}"}], "]"}], " ", "\[Rule]", " ", "a"}]}], "}"}], ",", "len"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"LinearSolve", "[", RowBox[{"sparseA", ",", "r"}], "]"}]}]}], "]"}], " "}]], "Input", CellChangeTimes->{{3.4489021244255466`*^9, 3.448902183356975*^9}, 3.4489023691355457`*^9, {3.4489024046764393`*^9, 3.448902412767555*^9}, { 3.4494779987853527`*^9, 3.449477999255464*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ RowBox[{"cnStep", "[", "n_Integer", "]"}], "[", RowBox[{"\[Psi]_List", ",", " ", "v_List"}], "]"}], " ", ":=", " ", RowBox[{"Nest", "[", RowBox[{ RowBox[{ RowBox[{"cnStep", "[", RowBox[{"#", ",", "v"}], "]"}], "&"}], ",", " ", "\[Psi]", ",", " ", "n"}], "]"}]}], ";", " ", RowBox[{"(*", " ", StyleBox[ RowBox[{"apply", " ", "cnStep", " ", "multiple", " ", "times"}], FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"cnStep", "[", RowBox[{ "n_Integer", ",", "a_List", ",", " ", "b_List", ",", " ", "v_List"}], "]"}], "[", "\[Psi]_List", "]"}], " ", ":=", " ", RowBox[{"Nest", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"cnStep", "[", RowBox[{"a", ",", "b", ",", "v"}], "]"}], "[", "#", "]"}], "&"}], ",", " ", "\[Psi]", ",", " ", "n"}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.448902200300271*^9, 3.448902205129674*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ RowBox[{"initial", "[", RowBox[{"k_", ",", "x0_", ",", "s_"}], "]"}], "[", "x_", "]"}], " ", ":=", " ", RowBox[{ RowBox[{"Exp", "[", RowBox[{"I", " ", "k", " ", "x"}], "]"}], " ", RowBox[{ RowBox[{"Exp", "[", RowBox[{"-", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"(", RowBox[{"x", "-", "x0"}], ")"}], "/", RowBox[{"(", RowBox[{"2", " ", "s"}], ")"}]}], ")"}], "^", "2"}]}], "]"}], "/", RowBox[{"Sqrt", "[", " ", RowBox[{"Sqrt", "[", RowBox[{"2", " ", "\[Pi]", " ", RowBox[{"s", "^", "2"}]}], "]"}], "]"}]}]}]}], ";"}]], "Input"], 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"] }, Closed]], Cell[CellGroupData[{ Cell["Step 2: Example Solutions", "Subsection"], Cell[TextData[{ "Use ", StyleBox["cnStep[\[Ellipsis]]", FontWeight->"Bold"], " to simulate quantum particles bouncing from the barriers as a function of \ the initial momentum. Remember, you are trying to determine ", StyleBox["what is the probability that an object will reflect from the \ barrier", FontSlant->"Italic"], ". " }], "Text"], Cell[CellGroupData[{ Cell["A v1 and v2 example", "Subsubsection"], Cell[BoxData[{ RowBox[{ RowBox[{"a", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"-", "I"}], " ", "0.25"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "1", ",", " ", RowBox[{"nGrid", "-", "1"}]}], "}"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"b1", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"1.0", " ", "+", " ", RowBox[{"I", RowBox[{"(", RowBox[{"1.0", " ", "+", " ", RowBox[{ "v1", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]}], ")"}], " ", "0.5"}]}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"b2", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"1.0", " ", "+", " ", RowBox[{"I", RowBox[{"(", RowBox[{"1.0", " ", "+", " ", RowBox[{ "v2", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]}], ")"}], " ", "0.5"}]}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}]}], ";"}]}], "Input"], Cell[TextData[{ "Below, we set the initial momentum to be ", StyleBox["p0", FontSlant->"Italic"], " = 0.325, corresponding to an initial energy of 0.325^2/2 = 0.053." }], "Text"], Cell[BoxData[{ RowBox[{ RowBox[{"\[Psi]0", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"initial", "[", RowBox[{"0.325", ",", RowBox[{"nGrid", "/", "4"}], ",", "14"}], "]"}], "[", "x", "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"plot\[Psi]", "[", "\[Psi]0", "]"}]}], "Input", CellChangeTimes->{{3.4489023145441523`*^9, 3.448902324007703*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"\[Psi]1", " ", "=", " ", RowBox[{ RowBox[{"cnStep", "[", RowBox[{"a", ",", "b1", ",", "v1"}], "]"}], "[", "\[Psi]0", "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"plot\[Psi]", "[", "\[Psi]1", "]"}]}], "Input", CellChangeTimes->{{3.448902342363236*^9, 3.4489023866589127`*^9}, { 3.448902426663518*^9, 3.44890243014815*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"sol1", "=", RowBox[{"NestList", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"cnStep", "[", RowBox[{"5", ",", "a", ",", "b1", ",", "v1"}], "]"}], "[", "#1", "]"}], "&"}], ",", "\[Psi]0", ",", "100"}], "]"}]}], ";"}], "\n", RowBox[{"ListDensityPlot", "[", RowBox[{ RowBox[{"Abs", "[", "sol1", "]"}], ",", RowBox[{"Mesh", "\[Rule]", "False"}], ",", RowBox[{"ColorFunction", "\[Rule]", "Hue"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{"sol2", "=", RowBox[{"NestList", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"cnStep", "[", RowBox[{"5", ",", "a", ",", "b2", ",", "v2"}], "]"}], "[", "#1", "]"}], "&"}], ",", "\[Psi]0", ",", "100"}], "]"}]}], ";"}], "\n", RowBox[{"ListDensityPlot", "[", RowBox[{ RowBox[{"Abs", "[", "sol2", "]"}], ",", RowBox[{"Mesh", "\[Rule]", "False"}], ",", RowBox[{"ColorFunction", "\[Rule]", "Hue"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}]}], "Input"], Cell[TextData[{ "The probability of finding the particle to the left of the barrier, ", StyleBox["x \[LessEqual] xB1", FontSlant->"Italic"], ", is given by the following." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"probLeft", "[", "\[Psi]_List", "]"}], " ", ":=", " ", RowBox[{"Plus", " ", "@@", " ", RowBox[{"Part", "[", RowBox[{ RowBox[{"Chop", "[", RowBox[{ RowBox[{"Conjugate", "[", "\[Psi]", "]"}], " ", "\[Psi]"}], "]"}], ",", RowBox[{"Range", "[", "xB1", "]"}]}], "]"}]}]}]], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{"p1", "=", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"1", "-", RowBox[{"probLeft", "/@", "sol1"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "0.4"}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"RGBColor", "[", RowBox[{"1", ",", "0", ",", "0"}], "]"}], "}"}]}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{"p2", "=", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"1", "-", RowBox[{"probLeft", "/@", "sol2"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "0.4"}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"RGBColor", "[", RowBox[{"0", ",", "0", ",", "1"}], "]"}], "}"}]}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], ";"}], "\n", RowBox[{"Show", "[", RowBox[{"p1", ",", "p2", ",", RowBox[{"DisplayFunction", "\[Rule]", "$DisplayFunction"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]}], "Input", CellChangeTimes->{{3.448902460304442*^9, 3.4489024615094357`*^9}}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Step 3: Eigensystem Analysis (Optional)", "Subsection"], Cell[TextData[{ "Use ", StyleBox["Eigensystem", FontWeight->"Bold"], " to investigate how the energy levels (frequencies) and spatial structures \ of the normal modes of the box change for the two potential wells. What are \ the normal modes of ", StyleBox["v1", FontWeight->"Bold"], " and ", StyleBox["v2", FontWeight->"Bold"], "? Does the presence of a normal mode influence the reflection coefficient \ when the particle's kinetic energy equals the normal modes of the multiple \ well?" }], "Text"], Cell[TextData[{ StyleBox["Hint", FontWeight->"Bold"], ": We know that the normal modes of a square potential well (with steep \ barriers) are sine and cosine functions. For the multiple well case, v2, the \ width of the well is ", StyleBox["xB2", FontSlant->"Italic"], " - ", StyleBox["xB1", FontSlant->"Italic"], " - ", StyleBox["dB", FontSlant->"Italic"], " = 0.08 ", StyleBox["nGrid", FontSlant->"Italic"], ". The lowest energy mode occurs with a momentum, ", StyleBox["k", FontSlant->"Italic"], " = \[Pi]/(0.08 ", StyleBox["nGrid", FontSlant->"Italic"], ") = 39.27/", StyleBox["nGrid", FontSlant->"Italic"], ". For ", StyleBox["nGrid", FontSlant->"Italic"], " = 200, this gives ", StyleBox["k", FontSlant->"Italic"], " = 0.19 and an energy of 0.019. Higher energy levels increase as squares of \ the integers, 4, 9, 16, \[Ellipsis], or 0.076, 0.171, 0.304, \[Ellipsis]. \ Clearly, only the lowest two modes are true modes of the multiple well. \ (Higher energies can not be trapped by a barrier with a height of only 0.1!) \ When the incident wave function is near a resonance, there will be greater \ tunneling. The eigenvalue analysis allows us to determine the precise energy \ corresponding to the modes of the multiple barriers." }], "Text"], Cell[CellGroupData[{ Cell["Defining the Eigenvalue Matricies", "Subsubsection"], Cell[TextData[{ "From the optional class notebook, ", StyleBox["8-QuantumModes.nb", FontSlant->"Italic"], ", we define the matrix ", StyleBox["mMatrix", FontWeight->"Bold"], " expressing Schr\[ODoubleDot]dinger's equation in matrix form. ", " " }], "Text"], 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"] }, Closed]], Cell[CellGroupData[{ Cell["Example Eigenvalue Analysis", "Subsubsection"], Cell[TextData[{ "Once ", StyleBox["mMatrix", FontWeight->"Bold"], " is defined, we can find the \"normal\" modes using the built-in command ", StyleBox["Eigensystem[\[Ellipsis]]", FontWeight->"Bold"], "." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"vb", "[", "i_Integer", "]"}], " ", ":=", " ", RowBox[{"v2", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]}], ";", RowBox[{ RowBox[{"{", RowBox[{"values", ",", " ", "vectors"}], "}"}], " ", "=", " ", RowBox[{"Eigensystem", "[", RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"(", RowBox[{"mMatrix", " ", "/.", " ", RowBox[{ RowBox[{"v", "[", "i_", "]"}], " ", "\[Rule]", RowBox[{"vb", "[", "i", "]"}]}]}], ")"}], "//", " ", "N"}], "]"}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"values", "\[LeftDoubleBracket]", RowBox[{"Range", "[", RowBox[{"nGrid", ",", RowBox[{"nGrid", "-", "30"}], ",", RowBox[{"-", "1"}]}], "]"}], "\[RightDoubleBracket]"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"PointSize", "[", "0.02`", "]"}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]], "Input"], Cell["\<\ The \"trapped\" modes of the multiple well can be seen by plotting the \ eigenvectors:\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"modes", "=", 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.10"}], "}"}]}], "}"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", FractionBox[ RowBox[{"30", "-", "i"}], "5"], "]"}], ",", RowBox[{"Thickness", "[", "0.02", "]"}]}], "}"}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"Ticks", "\[Rule]", "None"}], ",", RowBox[{"FrameTicks", "\[Rule]", "None"}], ",", " ", RowBox[{"PlotLabel", " ", "\[Rule]", " ", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", RowBox[{"nGrid", "-", "i", "+", "1"}], "]"}]}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "nGrid", ",", RowBox[{"nGrid", "-", "19"}], ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.448902728592314*^9, 3.448902799848104*^9}}], Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"modes", "\[LeftDoubleBracket]", "n", "\[RightDoubleBracket]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", " ", "1", ",", " ", "19", ",", "1"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4489025879790163`*^9, 3.4489026389019403`*^9}, { 3.4489026848420897`*^9, 3.448902684960926*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"values", "[", RowBox[{"[", RowBox[{"nGrid", " ", "-", " ", "9"}], "]"}], "]"}], ",", " ", RowBox[{"values", "[", RowBox[{"[", RowBox[{"nGrid", " ", "-", " ", "19"}], "]"}], "]"}]}], "}"}], " ", RowBox[{"(*", " ", RowBox[{ "the", " ", "energies", " ", "of", " ", "the", " ", "first", " ", "two", " ", "modes", " ", "of", " ", "the", " ", "multiple", " ", "well"}], " ", "*)"}]}]], "Input"], Cell["\<\ The actual energy values are close to (but less than) expectations.\ \>", "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Step 4: Plot your results", "Subsection"], Cell[TextData[{ "Finally, summarize your results by plotting the transmission (or \ reflection) coefficient as a function of ", StyleBox["p0", FontSlant->"Italic"], ". Remember to look only after the first reflection. If you can, compare the \ two potential wells ", StyleBox["v1", FontWeight->"Bold"], " and ", Cell[BoxData["v2"], "Input"], ". " }], "Text"] }, Closed]] }, Closed]] }, Open ]] }, WindowSize->{939, 848}, WindowMargins->{{Automatic, 201}, {Automatic, 104}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (May 21, 2008)", StyleDefinitions->"Classic.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 60, 0, 58, "Title"], Cell[653, 25, 84, 1, 53, "Subsubtitle"], Cell[740, 28, 107, 4, 81, "Subsubtitle"], Cell[CellGroupData[{ Cell[872, 36, 31, 0, 46, "Section"], Cell[906, 38, 1602, 31, 155, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[2545, 74, 62, 0, 20, "Section"], Cell[2610, 76, 89, 2, 25, "Text"], Cell[2702, 80, 120, 3, 25, "Text"], Cell[2825, 85, 2019, 57, 136, "Input"], Cell[4847, 144, 683, 12, 107, "Text"], Cell[5533, 158, 64, 0, 25, "Text"], Cell[CellGroupData[{ Cell[5622, 162, 52, 0, 27, "Subsection"], Cell[5677, 164, 526, 14, 58, "Text"], Cell[6206, 180, 2368, 61, 153, "Input"], Cell[8577, 243, 2290, 60, 119, "Input"], Cell[10870, 305, 1091, 31, 51, "Input"], Cell[11964, 338, 725, 24, 33, "Input"], Cell[12692, 364, 1830, 44, 136, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[14559, 413, 47, 0, 27, "Subsection"], Cell[14609, 415, 348, 10, 42, "Text"], Cell[CellGroupData[{ Cell[14982, 429, 44, 0, 27, "Subsubsection"], Cell[15029, 431, 1215, 38, 68, "Input"], Cell[16247, 471, 183, 5, 25, "Text"], Cell[16433, 478, 517, 14, 51, "Input"], Cell[16953, 494, 382, 9, 51, "Input"], Cell[17338, 505, 552, 15, 51, "Input"], Cell[17893, 522, 552, 15, 51, "Input"], Cell[18448, 539, 188, 5, 25, "Text"], Cell[18639, 546, 355, 10, 33, "Input"], Cell[18997, 558, 1360, 38, 102, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[20406, 602, 61, 0, 27, "Subsection"], Cell[20470, 604, 514, 15, 58, "Text"], Cell[20987, 621, 1291, 39, 90, "Text"], Cell[CellGroupData[{ Cell[22303, 664, 58, 0, 27, "Subsubsection"], Cell[22364, 666, 266, 9, 25, "Text"], Cell[22633, 677, 766, 21, 51, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[23436, 703, 52, 0, 27, "Subsubsection"], Cell[23491, 705, 225, 8, 25, "Text"], Cell[23719, 715, 593, 17, 33, "Input"], Cell[24315, 734, 517, 14, 33, "Input"], Cell[24835, 750, 110, 3, 25, "Text"], Cell[24948, 755, 1493, 39, 103, "Input"], Cell[26444, 796, 371, 9, 33, "Input"], Cell[26818, 807, 503, 14, 51, "Input"], Cell[27324, 823, 91, 2, 25, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[27464, 831, 47, 0, 27, "Subsection"], Cell[27514, 833, 369, 12, 42, "Text"] }, Closed]] }, Closed]] }, Open ]] } ] *) (* End of internal cache information *)