(* 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[     31882,        966]
NotebookOptionsPosition[     29780,        895]
NotebookOutlinePosition[     30136,        911]
CellTagsIndexPosition[     30093,        908]
WindowFrame->Normal
ContainsDynamic->False*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["Solutions (13)", "Title",
 CellChangeTimes->{{3.450115868185364*^9, 3.450115869349557*^9}}],

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]]
}, Open  ]],

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[{"\"\<Potential Barrier = \>\"", "<>", 
     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[{"\"\<Particle Energy = \>\"", ",", " ", 
    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[{"\"\<V0 = \>\"", "<>", 
     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"],

Cell[CellGroupData[{

Cell["Solution", "Subsubsection"],

Cell[BoxData[{
 RowBox[{
  RowBox[{"v0", "=", 
   RowBox[{"+", "0.2"}]}], ";"}], "\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.50"}]}], ",", 
     RowBox[{"{", 
      RowBox[{"i", ",", "1", ",", "nGrid"}], "}"}]}], "]"}]}], ";"}], "\n", 
 RowBox[{"ListPlot", "[", 
  RowBox[{"v", ",", 
   RowBox[{"PlotLabel", "\[Rule]", 
    RowBox[{"\"\<Potential Barrier = \>\"", "<>", 
     RowBox[{"ToString", "[", "v0", "]"}]}]}], ",", 
   RowBox[{"Joined", "\[Rule]", "True"}]}], "]"}]}], "Input",
 CellChangeTimes->{{3.450115228098692*^9, 3.4501152410588417`*^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[{"\"\<V0 = \>\"", "<>", 
     RowBox[{"ToString", "[", "v0", "]"}], "<>", "\"\<; E0 = \>\"", "<>", 
     RowBox[{"ToString", "[", 
      FractionBox[
       SuperscriptBox["k0", "2"], "2"], "]"}]}]}]}], "]"}]}], "Input"],

Cell[BoxData[{
 RowBox[{
  RowBox[{"v0", "=", 
   RowBox[{"+", "0.1"}]}], ";"}], "\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[{"\"\<Potential Barrier = \>\"", "<>", 
     RowBox[{"ToString", "[", "v0", "]"}]}]}], ",", 
   RowBox[{"Joined", "\[Rule]", "True"}]}], "]"}]}], "Input",
 CellChangeTimes->{{3.450115261052722*^9, 3.4501152717410917`*^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[{"\"\<V0 = \>\"", "<>", 
     RowBox[{"ToString", "[", "v0", "]"}], "<>", "\"\<; E0 = \>\"", "<>", 
     RowBox[{"ToString", "[", 
      FractionBox[
       SuperscriptBox["k0", "2"], "2"], "]"}]}]}]}], "]"}]}], "Input"]
}, Closed]]
}, 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"],

Cell[CellGroupData[{

Cell["Solution", "Subsubsection"],

Cell[BoxData[{
 RowBox[{
  RowBox[{
   RowBox[{"leftProb", "[", "\[Psi]_", "]"}], " ", ":=", " ", 
   RowBox[{"Plus", " ", "@@", " ", 
    RowBox[{"(", 
     RowBox[{
      RowBox[{"Abs", "[", 
       RowBox[{"\[Psi]", "\[LeftDoubleBracket]", 
        RowBox[{"Range", "[", 
         RowBox[{"1", ",", "89"}], "]"}], "\[RightDoubleBracket]"}], "]"}], 
      "^", "2"}], ")"}]}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"rightProb", "[", "\[Psi]_", "]"}], " ", ":=", " ", 
   RowBox[{"Plus", " ", "@@", " ", 
    RowBox[{"(", 
     RowBox[{
      RowBox[{"Abs", "[", 
       RowBox[{"\[Psi]", "\[LeftDoubleBracket]", 
        RowBox[{"Range", "[", 
         RowBox[{"111", ",", "200"}], "]"}], "\[RightDoubleBracket]"}], "]"}],
       "^", "2"}], ")"}]}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"barrierProb", "[", "\[Psi]_", "]"}], " ", ":=", " ", 
  RowBox[{"Plus", " ", "@@", " ", 
   RowBox[{"(", 
    RowBox[{
     RowBox[{"Abs", "[", 
      RowBox[{"\[Psi]", "\[LeftDoubleBracket]", 
       RowBox[{"Range", "[", 
        RowBox[{"90", ",", "110"}], "]"}], "\[RightDoubleBracket]"}], "]"}], 
     "^", "2"}], ")"}]}]}]}], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"(", 
   RowBox[{
    RowBox[{"Needs", "[", "\"\<ErrorBarPlots`\>\"", "]"}], ";", 
    RowBox[{"Needs", "[", "\"\<PlotLegends`\>\"", "]"}]}], ")"}], 
  ";"}]], "Input"],

Cell[BoxData[
 RowBox[{"ListPlot", "[", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{"leftProb", "/@", "sol"}], ",", 
     RowBox[{"rightProb", "/@", "sol"}], ",", 
     RowBox[{"barrierProb", "/@", "sol"}]}], "}"}], ",", 
   RowBox[{"Joined", "\[Rule]", "True"}], ",", 
   RowBox[{"PlotStyle", "\[Rule]", 
    RowBox[{"{", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{"RGBColor", "[", 
        RowBox[{"0", ",", "0", ",", "1"}], "]"}], "}"}], ",", 
      RowBox[{"{", 
       RowBox[{"RGBColor", "[", 
        RowBox[{"1", ",", "0", ",", "0"}], "]"}], "}"}], ",", 
      RowBox[{"{", 
       RowBox[{"RGBColor", "[", 
        RowBox[{"0", ",", "1", ",", "0"}], "]"}], "}"}]}], "}"}]}], ",", 
   RowBox[{
   "PlotLabel", "\[Rule]", 
    "\"\<Incident, Barrier, Transmitted Probabilities\>\""}], ",", 
   RowBox[{"AxesLabel", "\[Rule]", 
    RowBox[{"{", 
     RowBox[{"\"\<\[CapitalDelta]t\>\"", ",", "\"\<\>\""}], "}"}]}]}], 
  "]"}]], "Input",
 CellChangeTimes->{3.4501153013011923`*^9}],

Cell["Other examples:", "Text"],

Cell[BoxData[{
 RowBox[{
  RowBox[{"v0", "=", 
   RowBox[{"+", "0.2"}]}], ";"}], "\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"}], "}"}]}], "]"}]}], ";", 
  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[{"\"\<V0 = \>\"", "<>", 
     RowBox[{"ToString", "[", "v0", "]"}], "<>", "\"\<; E0 = \>\"", "<>", 
     RowBox[{"ToString", "[", 
      FractionBox[
       SuperscriptBox["k0", "2"], "2"], "]"}]}]}]}], "]"}]}], "Input",
 CellChangeTimes->{{3.450115320698018*^9, 3.450115330487975*^9}}],

Cell[BoxData[
 RowBox[{"ListPlot", "[", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{"leftProb", "/@", "sol"}], ",", 
     RowBox[{"rightProb", "/@", "sol"}], ",", 
     RowBox[{"barrierProb", "/@", "sol"}]}], "}"}], ",", 
   RowBox[{"Joined", "\[Rule]", "True"}], ",", 
   RowBox[{"PlotStyle", "\[Rule]", 
    RowBox[{"{", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{"RGBColor", "[", 
        RowBox[{"0", ",", "0", ",", "1"}], "]"}], "}"}], ",", 
      RowBox[{"{", 
       RowBox[{"RGBColor", "[", 
        RowBox[{"1", ",", "0", ",", "0"}], "]"}], "}"}], ",", 
      RowBox[{"{", 
       RowBox[{"RGBColor", "[", 
        RowBox[{"0", ",", "1", ",", "0"}], "]"}], "}"}]}], "}"}]}], ",", 
   RowBox[{
   "PlotLabel", "\[Rule]", 
    "\"\<Incident, Barrier, Transmitted Probabilities\>\""}]}], 
  "]"}]], "Input",
 CellChangeTimes->{3.450115336805253*^9}],

Cell[BoxData[
 RowBox[{
  RowBox[{
   RowBox[{"tunnelProb", "[", 
    StyleBox[
     RowBox[{
      StyleBox["v0",
       FontColor->RGBColor[1, 0, 1]], "_"}]], "]"}], " ", ":=", " ", 
   RowBox[{"Module", "[", 
    RowBox[{
     RowBox[{"{", "}"}], ",", "\[IndentingNewLine]", 
     RowBox[{
      RowBox[{"v", " ", "=", " ", 
       RowBox[{"Table", "[", 
        RowBox[{
         RowBox[{"If", "[", 
          RowBox[{
           RowBox[{
            RowBox[{"-", "10"}], " ", "\[LessEqual]", " ", "x", " ", 
            "\[LessEqual]", " ", "10"}], ",", 
           StyleBox["v0",
            FontColor->RGBColor[1, 0, 1]], ",", "0.0"}], "]"}], ",", " ", 
         RowBox[{"{", 
          RowBox[{"x", ",", " ", 
           RowBox[{
            RowBox[{
             RowBox[{"-", "nGrid"}], "/", "2"}], " ", "+", " ", "1"}], ",", 
           " ", 
           RowBox[{"nGrid", "/", "2"}]}], "}"}]}], "]"}]}], ";", 
      "\[IndentingNewLine]", 
      RowBox[{"a", " ", "=", " ", 
       RowBox[{"Table", "[", 
        RowBox[{
         RowBox[{
          RowBox[{"-", "I"}], " ", "0.25"}], ",", " ", 
         RowBox[{"{", 
          RowBox[{"i", ",", " ", "1", ",", " ", 
           RowBox[{"nGrid", "-", "1"}]}], "}"}]}], "]"}]}], ";", 
      "\[IndentingNewLine]", 
      RowBox[{"b", " ", "=", " ", 
       RowBox[{"Table", "[", 
        RowBox[{
         RowBox[{"1.0", " ", "+", " ", 
          RowBox[{"I", 
           RowBox[{"(", 
            RowBox[{"1.0", " ", "+", " ", 
             RowBox[{
             "v", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]}], 
            ")"}], " ", "0.5"}]}], ",", " ", 
         RowBox[{"{", 
          RowBox[{"i", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}]}], 
      ";", 
      RowBox[{"sol", " ", "=", " ", 
       RowBox[{"NestList", "[", 
        RowBox[{
         RowBox[{
          RowBox[{
           RowBox[{"cnStep", "[", 
            RowBox[{"a", ",", "b", ",", "v"}], "]"}], "[", "#", "]"}], "&"}], 
         ",", " ", "\[Psi]0", ",", " ", "200"}], "]"}]}], ";", 
      "\[IndentingNewLine]", 
      RowBox[{"Part", "[", 
       RowBox[{
        RowBox[{"rightProb", " ", "/@", " ", "sol"}], ",", 
        StyleBox["175",
         FontColor->RGBColor[1, 0, 0]]}], "]"}]}]}], "\[IndentingNewLine]", 
    "]"}]}], ";"}]], "Input"],

Cell["\<\
Compute a tunneling transmission plot\[Ellipsis]\
\>", "Text",
 CellChangeTimes->{{3.45011567900462*^9, 3.450115700828092*^9}}],

Cell[BoxData[
 RowBox[{"ListLogPlot", "[", 
  RowBox[{
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       FractionBox["v0", 
        FractionBox[
         SuperscriptBox["k0", "2"], "2"]], ",", 
       RowBox[{"tunnelProb", "[", "v0", "]"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"v0", ",", "0.05", ",", "0.30", ",", "0.01"}], "}"}]}], "]"}], 
   ",", 
   RowBox[{"PlotLabel", "\[Rule]", 
    RowBox[{"\"\<Transmission Probability for E0 = \>\"", "<>", 
     RowBox[{"ToString", "[", 
      FractionBox[
       SuperscriptBox["k0", "2"], "2"], "]"}]}]}], ",", 
   RowBox[{"AxesLabel", "\[Rule]", 
    RowBox[{"{", 
     RowBox[{"\"\<v0/E0\>\"", ",", "\"\<\>\""}], "}"}]}], ",", 
   RowBox[{"AxesOrigin", "\[Rule]", 
    RowBox[{"{", 
     RowBox[{
      FractionBox["0.05", 
       FractionBox[
        SuperscriptBox["k0", "2"], "2"]], ",", "0.0001"}], "}"}]}], ",", 
   RowBox[{"Joined", "\[Rule]", "True"}], ",", " ", 
   RowBox[{"GridLines", " ", "\[Rule]", " ", "Automatic"}]}], "]"}]], "Input",\

 CellChangeTimes->{{3.450115347207649*^9, 3.450115359532618*^9}, {
  3.450115540412715*^9, 3.450115540856866*^9}, {3.4501156389501953`*^9, 
  3.450115639044414*^9}, {3.450115706804826*^9, 3.4501158570815477`*^9}}],

Cell[TextData[{
 "When the barrier is higher than the energy of the particle, then the \
tunneling probabilty becomes ",
 StyleBox["exponentially small ",
  FontSlant->"Italic"],
 "as the barrier height get bigger."
}], "Text",
 CellChangeTimes->{{3.450115953191433*^9, 3.450116030433226*^9}}]
}, Closed]]
}, Closed]]
}, Open  ]]
}, Open  ]]
},
WindowSize->{953, 971},
WindowMargins->{{111, Automatic}, {Automatic, 0}},
Magnification->1.25,
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, 97, 1, 91, "Title"],
Cell[690, 26, 128, 4, 58, "Subsubtitle"],
Cell[CellGroupData[{
Cell[843, 34, 49, 0, 81, "Section"],
Cell[895, 36, 672, 17, 117, "Text"],
Cell[CellGroupData[{
Cell[1592, 57, 33, 0, 29, "Subsubsection"],
Cell[1628, 59, 2498, 63, 169, "Input"],
Cell[4129, 124, 2378, 61, 119, "Input"],
Cell[6510, 187, 1107, 33, 69, "Input"],
Cell[7620, 222, 725, 24, 34, "Input"],
Cell[8348, 248, 1830, 44, 170, "Input"]
}, Closed]]
}, Open  ]],
Cell[CellGroupData[{
Cell[10227, 298, 28, 0, 81, "Section"],
Cell[10258, 300, 470, 7, 97, "Text"],
Cell[CellGroupData[{
Cell[10753, 311, 71, 0, 41, "Subsection"],
Cell[10827, 313, 243, 4, 55, "Text"],
Cell[CellGroupData[{
Cell[11095, 321, 33, 0, 29, "Subsubsection"],
Cell[11131, 323, 1654, 50, 137, "Input"],
Cell[12788, 375, 928, 28, 83, "Input"],
Cell[13719, 405, 790, 21, 107, "Input"]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[14558, 432, 50, 0, 30, "Subsection"],
Cell[14611, 434, 400, 8, 76, "Text"],
Cell[CellGroupData[{
Cell[15036, 446, 33, 0, 29, "Subsubsection"],
Cell[15072, 448, 1573, 47, 122, "Input"],
Cell[16648, 497, 790, 21, 107, "Input"],
Cell[17441, 520, 1572, 47, 122, "Input"],
Cell[19016, 569, 790, 21, 107, "Input"]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[19855, 596, 52, 0, 30, "Subsection"],
Cell[19910, 598, 372, 6, 76, "Text"],
Cell[CellGroupData[{
Cell[20307, 608, 33, 0, 29, "Subsubsection"],
Cell[20343, 610, 1174, 32, 70, "Input"],
Cell[21520, 644, 202, 6, 33, "Input"],
Cell[21725, 652, 1004, 28, 67, "Input"],
Cell[22732, 682, 31, 0, 34, "Text"],
Cell[22766, 684, 2078, 61, 196, "Input"],
Cell[24847, 747, 873, 25, 67, "Input"],
Cell[25723, 774, 2311, 66, 132, "Input"],
Cell[28037, 842, 137, 3, 34, "Text"],
Cell[28177, 847, 1255, 33, 209, "Input"],
Cell[29435, 882, 293, 7, 55, "Text"]
}, Closed]]
}, Closed]]
}, Open  ]]
}, Open  ]]
}
]
*)

(* End of internal cache information *)