(* 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[ 16804, 509] NotebookOptionsPosition[ 15449, 459] NotebookOutlinePosition[ 15784, 474] CellTagsIndexPosition[ 15741, 471] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Exercises (13)", "Title"], Cell["\<\ Assigned: April 23 Due: April 30\ \>", "Subsubtitle", CellChangeTimes->{{3.449479067737587*^9, 3.44947907193198*^9}}], Cell[CellGroupData[{ Cell["Setup your Notebook (in-Class)", "Section"], Cell[TextData[{ "Copy the Crank-Nicholson formula from the class notebook, 13", StyleBox["-QuantumPotentials.nb", FontSlant->"Italic"], ", that advances the wavefunction in unit time steps. \n\nAlso, copy the \ initial condition function that creates an initial wave-packet of a given \ size and momentum. These functions are called ", StyleBox["cnStep[\[Ellipsis]]", FontWeight->"Bold"], " and ", StyleBox["initial[\[Ellipsis]][x]. ", FontWeight->"Bold"], "(If you wish, you may also want to copy the function ", StyleBox["plot\[Psi][\[Ellipsis]]", FontWeight->"Bold"], ".)" }], "Text", CellChangeTimes->{{3.4494789966277857`*^9, 3.449479018528023*^9}}], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], 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[{"\[ImaginaryI]", " ", 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[{"-", " ", "\[ImaginaryI]"}], " ", "0.25"}]}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"len", ",", " ", "len"}], "}"}], ",", " ", "0.0"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"r", " ", "=", " ", RowBox[{ RowBox[{"ListConvolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"\[ImaginaryI]", " ", "0.25"}], ",", RowBox[{"1.0", " ", "-", " ", RowBox[{"\[ImaginaryI]", " ", "0.5"}]}], ",", " ", RowBox[{"\[ImaginaryI]", " ", "0.25"}]}], "}"}], ",", "\[Psi]", ",", " ", "2", ",", " ", "0.0"}], "]"}], " ", "-", " ", RowBox[{"\[ImaginaryI]", " ", "\[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}, { 3.449478273711421*^9, 3.449478295887082*^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[{"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[{"r", " ", "=", " ", RowBox[{ RowBox[{"ListConvolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"\[ImaginaryI]", " ", "0.25"}], ",", RowBox[{"1.0", " ", "-", " ", RowBox[{"\[ImaginaryI]", " ", "0.5"}]}], ",", " ", RowBox[{"I", " ", "0.25"}]}], "}"}], ",", "\[Psi]", ",", " ", "2", ",", " ", "0.0"}], "]"}], " ", "-", " ", RowBox[{"\[ImaginaryI]", " ", "\[Psi]", " ", "v", " ", "0.5"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"LinearSolve", "[", RowBox[{"sparseA", ",", "r"}], "]"}]}]}], "]"}], " "}]], "Input", CellChangeTimes->{{3.4489021244255466`*^9, 3.448902183356975*^9}, 3.4489023691355457`*^9, {3.4489024046764393`*^9, 3.448902412767555*^9}, { 3.449478006305419*^9, 3.449478006727973*^9}, {3.4494782999429407`*^9, 3.4494783177403603`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", StyleBox[ RowBox[{"apply", " ", "cnStep", " ", "multiple", " ", "times"}], FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], "*)"}], RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"cnStep", "[", "n_Integer", "]"}], "[", RowBox[{"\[Psi]_List", ",", " ", "v_List"}], "]"}], " ", ":=", " ", RowBox[{"Nest", "[", RowBox[{ RowBox[{ RowBox[{"cnStep", "[", RowBox[{"#", ",", "v"}], "]"}], "&"}], ",", " ", "\[Psi]", ",", " ", "n"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ 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"], 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]] }, Closed]], Cell[CellGroupData[{ Cell["Tunneling", "Section"], Cell["\<\ In this problem, you are to compute the reflection and transmission \ coefficient through a potential barrier. When the barrier than the kinetic \ energy of the incident particle, the particle \"tunnels\" through the \ barrier! Of course, this is impossible for a classical particle. Tunneling is \ a quantum mechanical process that is important to many phenomena, from \ practical semiconductor devices to understanding natural radioactivity. \ \>", "Text"], Cell[CellGroupData[{ Cell["Part 1: Defining the Potential Barrier (In Class)", "Subsection"], Cell["\<\ Define your potential barrier as used in the Section entitled \"Potential \ Barriers (2)\". Demonstrate that your notebook properly computes the \ evolution of the quantum wavefunction as it interacts with the barrier. \ \>", "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[{ RowBox[{ RowBox[{"nGrid", "=", "200"}], ";"}], "\n", RowBox[{ RowBox[{"v0", "=", RowBox[{"+", "1.0"}]}], ";"}], "\n", RowBox[{ RowBox[{"v", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"-", "10"}], "\[LessEqual]", "x", "\[LessEqual]", "10"}], ",", "v0", ",", "0.0"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{ RowBox[{"-", FractionBox["nGrid", "2"]}], "+", "1"}], ",", FractionBox["nGrid", "2"]}], "}"}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{"a", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"-", "\[ImaginaryI]"}], " ", "0.25"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"nGrid", "-", "1"}]}], "}"}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{"b", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"1.0", "\[InvisibleSpace]", "+", RowBox[{"\[ImaginaryI]", " ", RowBox[{"(", RowBox[{"1.0", "\[InvisibleSpace]", "+", RowBox[{ "v", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]}], ")"}], " ", "0.5"}]}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", "nGrid"}], "}"}]}], "]"}]}], ";"}], "\n", RowBox[{"ListPlot", "[", RowBox[{"v", ",", RowBox[{"PlotLabel", "\[Rule]", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", "v0", "]"}]}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}]}], "]"}]}], "Input", CellChangeTimes->{{3.449479035185669*^9, 3.44947904954681*^9}, 3.4494790939098883`*^9}], Cell[BoxData[{ RowBox[{ StyleBox[ RowBox[{"k0", " ", "=", " ", "0.6"}], FontColor->RGBColor[1, 0, 1]], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Print", "[", RowBox[{"\"\\"", ",", " ", RowBox[{ RowBox[{ StyleBox["k0", FontColor->RGBColor[1, 0, 1]], "^", "2"}], "/", "2"}]}], "]"}], ";", RowBox[{"\[Psi]0", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"initial", "[", RowBox[{ StyleBox["k0", FontColor->RGBColor[1, 0, 1]], ",", RowBox[{"nGrid", "/", "4"}], ",", "8"}], "]"}], "[", "x", "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}]}], ";", RowBox[{"plot\[Psi]", "[", RowBox[{"\[Psi]0", ",", " ", RowBox[{"PlotRange", "\[Rule]", " ", "All"}]}], "]"}]}]}], "Input", CellChangeTimes->{3.449479054601989*^9}], Cell[BoxData[{ RowBox[{ RowBox[{"sol", "=", RowBox[{"NestList", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"cnStep", "[", RowBox[{"a", ",", "b", ",", "v"}], "]"}], "[", "#1", "]"}], "&"}], ",", "\[Psi]0", ",", "200"}], "]"}]}], ";"}], "\n", RowBox[{"ListDensityPlot", "[", RowBox[{ RowBox[{"Abs", "[", "sol", "]"}], ",", RowBox[{"Mesh", "\[Rule]", "False"}], ",", RowBox[{"ColorFunction", "\[Rule]", "Hue"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", RowBox[{"PlotLabel", "\[Rule]", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", "v0", "]"}], "<>", "\"\<; E0 = \>\"", "<>", RowBox[{"ToString", "[", FractionBox[ SuperscriptBox["k0", "2"], "2"], "]"}]}]}]}], "]"}]}], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Part 2: Observing Tunnelling", "Subsection"], Cell[TextData[{ "Change the height of the potential barrier, and observe how the changes in \ the wavefunction solution. Can you observe the conditions when quantum \ tunneling is significant? Can you see changes in the reflected wavefunction? \ What happens when the potential barrier height is ", StyleBox["lower", FontSlant->"Italic"], " than the incident energy of the particle?" }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Part 3: Quantifying Tunnelling", "Subsection"], Cell["\<\ Integrate the probability of finding the particle within each of the three \ regions as a function of time: (1) to the left of the barrier, (2) within the \ barrier, and (3) to the right of the barrier. (Of course, the sum of all \ three must equal to unity!) Examine the variation of these probabilities for \ several values of the barrier height.\ \>", "Text"] }, Closed]] }, Closed]] }, Open ]] }, WindowSize->{868, 861}, WindowMargins->{{111, Automatic}, {Automatic, 0}}, FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (May 21, 2008)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 31, 0, 73, "Title"], Cell[624, 25, 128, 4, 45, "Subsubtitle"], Cell[CellGroupData[{ Cell[777, 33, 49, 0, 69, "Section"], Cell[829, 35, 672, 17, 75, "Text"], Cell[CellGroupData[{ Cell[1526, 56, 33, 0, 24, "Subsubsection"], Cell[1562, 58, 2498, 63, 148, "Input"], Cell[4063, 123, 2378, 61, 114, "Input"], Cell[6444, 186, 1107, 33, 46, "Input"], Cell[7554, 221, 725, 24, 28, "Input"], Cell[8282, 247, 1830, 44, 131, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[10161, 297, 28, 0, 39, "Section"], Cell[10192, 299, 470, 7, 59, "Text"], Cell[CellGroupData[{ Cell[10687, 310, 71, 0, 33, "Subsection"], Cell[10761, 312, 243, 4, 43, "Text"], Cell[CellGroupData[{ Cell[11029, 320, 33, 0, 24, "Subsubsection"], Cell[11065, 322, 1654, 50, 130, "Input"], Cell[12722, 374, 928, 28, 63, "Input"], Cell[13653, 404, 790, 21, 89, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[14492, 431, 50, 0, 33, "Subsection"], Cell[14545, 433, 400, 8, 59, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[14982, 446, 52, 0, 33, "Subsection"], Cell[15037, 448, 372, 6, 59, "Text"] }, Closed]] }, Closed]] }, Open ]] } ] *) (* End of internal cache information *)