(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.1' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 25875, 717]*) (*NotebookOutlinePosition[ 26600, 742]*) (* CellTagsIndexPosition[ 26556, 738]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Scattering from Multiple Potential Barriers", "Title"], Cell["Student Projects in AP1603 investigating quantum mechanics.", \ "Subsubtitle"], Cell[TextData[ "All projects must have\[Ellipsis]\nName:____________\n\ 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[{\(Off[General::spell1];\), "\[IndentingNewLine]", StyleBox[\(nGrid\ = \ 200;\), FontColor->RGBColor[1, 0, 1]], "\[IndentingNewLine]", StyleBox[\(nGrid\ = \ 100;\), FontColor->RGBColor[1, 0, 1]], "\[IndentingNewLine]", \(xB1\ = \ Floor[0.6\ nGrid]; \ xB2\ = \ Floor[0.7\ nGrid]; \ dB\ = \ Floor[0.02\ nGrid];\), "\[IndentingNewLine]", \(v1\ = \ Table[Which[xB1\ \[LessEqual] \ x\ \[LessEqual] \ xB1\ + \ dB, 0.1, True, \ 0.0], \ {x, \ 1, \ nGrid}];\), "\[IndentingNewLine]", \(v2\ = \ Table[Which[xB1\ \[LessEqual] \ x\ \[LessEqual] \ xB1\ + \ dB, 0.1, xB2\ \[LessEqual] \ x\ \[LessEqual] \ xB2\ + \ dB, \ 0.2, \ True, \ 0.0], \ {x, \ 1, \ nGrid}];\), "\[IndentingNewLine]", \(ListPlot[v1, \ PlotLabel \[Rule] \ "\", \ PlotJoined \[Rule] \ True, \ PlotRange \[Rule] \ {0, 0.2}];\), "\[IndentingNewLine]", \(ListPlot[ v2, \ PlotLabel \[Rule] \ "\", \ PlotJoined \[Rule] \ True, \ PlotRange \[Rule] \ {0, 0.2}];\)}], "Input"], 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[ \(\(Needs["\"];\)\)], "Input"], Cell[BoxData[ \(\(Off[CompiledFunction::"\", CompiledFunction::"\"];\)\)], "Input"], Cell[BoxData[ \(cnStep[\[Psi]_List, \ v_List]\ := \ Module[{a, b, c, r, len}, \[IndentingNewLine]len\ = \ Length[\[Psi]]; \[IndentingNewLine]a\ = \ Table[\(-I\)\ 0.25, \ {i, \ 1, \ len - 1}]; \[IndentingNewLine]b\ = \ Table[1.0\ + \ I \((1.0\ + \ v\[LeftDoubleBracket] i\[RightDoubleBracket])\)\ 0.5, \ {i, \ 1, \ len}]; \[IndentingNewLine]c\ = \ a; \[IndentingNewLine]r\ = \ \ ListConvolve[{I\ 0.25, 1.0\ - \ I\ 0.5, \ I\ 0.25}, \[Psi], \ 2, \ 0.0]\ - \ I\ \[Psi]\ v\ 0.5; \[IndentingNewLine] (*\ fixed\ boundaries\ *) \[IndentingNewLine]sol\ = \ TridiagonalSolve[a, b, c, r]; \[IndentingNewLine]sol]\)], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", StyleBox[\(a\ faster, \ pre - defined, \ version\ of\ cnStep\), FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], "*)"}], \(\(cnStep[a_List, b_List, v_List]\)[\[Psi]_List]\ := \ \ Module[{r}, \[IndentingNewLine]r\ \ = \ \ ListConvolve[{I\ 0.25, 1.0\ - \ I\ 0.5, \ I\ 0.25}, \[Psi], \ 2, \ 0.0]\ - \ I\ \[Psi]\ v\ 0.5; \[IndentingNewLine]TridiagonalSolve[a, b, a, r]]\)}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", StyleBox[\(apply\ cnStep\ multiple\ times\), FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], "*)"}], \(\(\(cnStep[n_Integer]\)[\[Psi]_List, \ v_List]\ := \ Nest[cnStep[#, v] &, \ \[Psi], \ n];\)\[IndentingNewLine] \(\(cnStep[n_Integer, a_List, \ b_List, \ v_List]\)[\[Psi]_List]\ := \ Nest[\(cnStep[a, b, v]\)[#] &, \ \[Psi], \ n];\)\)}]], "Input"], Cell[BoxData[ \(\(\(initial[k_, x0_, s_]\)[x_]\ := \ Exp[I\ k\ x]\ Exp[\(-\((\((x - x0)\)/\((2\ s)\))\)^2\)]/ Sqrt[\ Sqrt[2\ \[Pi]\ s^2]];\)\)], "Input"], Cell[BoxData[ \(\(plot\[Psi][\[Psi]_List, options___]\ := \ Module[{p1, p2, p3, p4}, p1\ = \ ListPlot[Re[\[Psi]], \ PlotStyle \[Rule] \ RGBColor[0, 0, 1], \ PlotJoined\ \[Rule] \ True, \ DisplayFunction \[Rule] \ Identity]; \[IndentingNewLine]p2\ = \ ListPlot[Im[\[Psi]], \ PlotStyle \[Rule] \ RGBColor[1, 0, 0], \ PlotJoined\ \[Rule] \ True, \ DisplayFunction \[Rule] \ Identity]; \[IndentingNewLine]p3\ = \ ListPlot[Abs[\[Psi]], \ PlotJoined\ \[Rule] \ True, \ DisplayFunction \[Rule] \ Identity]; \[IndentingNewLine]p4\ = \ ListPlot[\(-Abs[\[Psi]]\), \ PlotJoined\ \[Rule] \ True, \ DisplayFunction \[Rule] \ Identity]; \[IndentingNewLine]Show[ p1, p2, p3, p4, \ 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[{ \(\(a\ = \ Table[\(-I\)\ 0.25, \ {i, \ 1, \ nGrid - 1}];\)\), "\[IndentingNewLine]", \(\(b1\ = \ Table[1.0\ + \ I \((1.0\ + \ v1\[LeftDoubleBracket] i\[RightDoubleBracket])\)\ 0.5, \ {i, \ 1, \ nGrid}];\)\), "\[IndentingNewLine]", \(\(b2\ = \ Table[1.0\ + \ I \((1.0\ + \ v2\[LeftDoubleBracket] i\[RightDoubleBracket])\)\ 0.5, \ {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[ \(\(\[Psi]0\ = \ Table[\(initial[0.325, nGrid/4, 14]\)[x], \ {x, \ 1, \ nGrid}];\)\)], "Input"], Cell[BoxData[{ \(\(sol1\ = \ NestList[\(cnStep[5, a, b1, v1]\)[#] &, \ \[Psi]0, \ 100];\)\), "\[IndentingNewLine]", \(\(ListDensityPlot[Abs[sol1], \ Mesh \[Rule] \ False, \ ColorFunction \[Rule] \ Hue, \ PlotRange \[Rule] \ All];\)\)}], "Input"], Cell[BoxData[{ \(\(sol2\ = \ NestList[\(cnStep[5, a, b2, v2]\)[#] &, \ \[Psi]0, \ 100];\)\), "\[IndentingNewLine]", \(\(ListDensityPlot[Abs[sol2], \ Mesh \[Rule] \ False, \ ColorFunction \[Rule] \ Hue, \ 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[ \(probLeft[\[Psi]_List]\ := \ Plus\ @@ \ Part[Chop[Conjugate[\[Psi]]\ \ \[Psi]], Range[xB1]]\)], "Input"], Cell[BoxData[ \(probLeft[\[Psi]_List]\ := \ Plus\ @@ \ Part[Abs[\[Psi]]^2, Range[xB1]]\)], "Input"], Cell[BoxData[{ \(\(p1\ = \ ListPlot[1 - \ \((probLeft\ /@ \ sol1)\), \ PlotRange \[Rule] \ {0, .4}, \ PlotStyle \[Rule] \ {RGBColor[1, 0, 0]}, \ DisplayFunction \[Rule] \ Identity];\)\), "\[IndentingNewLine]", \(\(p2 = \ ListPlot[1\ - \ \((probLeft\ /@ \ sol2)\), \ PlotRange \[Rule] \ {0, .4}, \ PlotStyle \[Rule] \ {RGBColor[0, 0, 1]}, \ DisplayFunction \[Rule] \ Identity];\)\), "\[IndentingNewLine]", \(\(Show[p1, p2, \ DisplayFunction \[Rule] \ $DisplayFunction, \ AxesLabel\ \[Rule] \ {"\", \ "\"}];\)\)}], "Input"] }, 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[ \(\(mMatrix\ = \ Table[Which[j\ == \ i, \ 1 + \ v[i], \ j\ == \ i + 1, \ \(-0.5\), \ j\ == \ i - 1, \ \(-0.5\), \ True, \ 0], \ {i, 1, nGrid}, \ {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[ \(vb[i_Integer]\ := \ v2\[LeftDoubleBracket]i\[RightDoubleBracket]; {values, \ vectors}\ = \ Eigensystem[ Evaluate[\((mMatrix\ /. \ v[i_]\ \[Rule] vb[i])\) // \ N]];\)], "Input"], Cell[BoxData[ \(\(ListPlot[values[\([Range[nGrid, \ nGrid - 30, \ \(-1\)]]\)], PlotStyle\ -> \ {PointSize[0.02]}, AxesLabel -> {"\", "\"}];\)\)], "Input"], Cell["\<\ The \"trapped\" modes of the multiple well can be seen by plotting \ the eigenvectors:\ \>", "Text"], Cell[BoxData[{ \(\(modes\ = \ Table[ListPlot[ Abs[vectors\[LeftDoubleBracket]i\[RightDoubleBracket]]\^2, \n\t\t\ \tPlotRange -> {{0, nGrid + 1}, {0, \ 0.15}}, \n\t\t\tPlotJoined -> \ True, \n\t\t\tPlotStyle -> {Hue[\((30 - i)\)/5], Thickness[0.02]}, \n\t\t\tFrame\ -> \ True, \n\t\t\tTicks\ -> \ None, \n\t\t\tFrameTicks\ -> \ None, \n\tDisplayFunction -> \ Identity], {i, nGrid, nGrid - 19, \(-1\)}];\)\), "\n", \(\(Show[ GraphicsArray[{modes\[LeftDoubleBracket]{1, 2, 3, \ 4, \ 5}\[RightDoubleBracket], modes\[LeftDoubleBracket]{6, \ 7, \ 8, \ 9, \ 10}\[RightDoubleBracket], \ modes\[LeftDoubleBracket]{11, \ 12, \ 13, \ 14, \ 15}\[RightDoubleBracket], \ modes\[LeftDoubleBracket]{16, \ 17, \ 18, \ 19, \ 20}\[RightDoubleBracket]}]];\)\)}], "Input"], Cell[BoxData[ RowBox[{\({values[\([nGrid\ - \ 9]\)], \ values[\([nGrid\ - \ 19]\)]}\), " ", RowBox[{"(*", " ", RowBox[{ RowBox[{ "the", " ", "energies", " ", "of", " ", "the", " ", "first", " ", "two", " ", "modes", " ", "of", " ", "the", " ", "multiple", " ", "well", " ", StyleBox["when", FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], StyleBox["nGrid", FontColor->RGBColor[1, 0, 1]]}], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], StyleBox["=", FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], StyleBox["200", FontColor->RGBColor[1, 0, 1]]}], " ", "*)"}]}]], "Input"], Cell[BoxData[ RowBox[{\(values[\([nGrid\ - \ 7]\)]\), RowBox[{"(*", " ", RowBox[{ RowBox[{ "the", " ", "energy", " ", "of", " ", "the", " ", "first", " ", \((ond\ only)\), " ", "mode", " ", "of", " ", "the", " ", "multiple", " ", "well", " ", StyleBox["when", FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], StyleBox["nGrid", FontColor->RGBColor[1, 0, 1]]}], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], StyleBox["=", FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], StyleBox["100", FontColor->RGBColor[1, 0, 1]]}], " ", "*)"}]}]], "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"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell["First, we need to understand how long to run our simulation.", "Text"], Cell[TextData[{ "We start the particle at ", StyleBox["nGrid/4", FontWeight->"Bold"], ", moving to the right. The time it takes to reach the first barrier is (", StyleBox["xB1 - nGrid/4)/v0", FontWeight->"Bold"], ", where ", StyleBox["v0 = k0", FontWeight->"Bold"], " is the initial velocity of the particle. We want to run the simulation so \ that (on average) the particle returns to ", StyleBox["xB1", FontWeight->"Bold"], ". Thus, the time required is ", StyleBox["2 (xB1 - nGrid/4)/k0 = 2 (0.6 - 0.25) nGrid / k0 = 0.7 nGrid/k0", FontWeight->"Bold"], ". Notice, ", StyleBox["we can save a lot of time by reducing the value of ", FontSlant->"Italic"], StyleBox["nGrid", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["! ", FontSlant->"Italic"], "When ", StyleBox["nGrid ", FontWeight->"Bold"], "doubles, the computational time increases by a factor of four!" }], "Text"], Cell["\<\ We make a list of energies corresponding to the initial particle's \ kinetic energy\[Ellipsis]\ \>", "Text"], Cell[BoxData[ RowBox[{ "energyList", " ", "=", " ", \(Sort[{0.005, \ 0.01, 0.015, \ 0.020, \ 0.03, \ 0.04, \ 0.05, \ 0.06, \ 0.08, \ 0.1, \ 0.12}\ ~\ Join\ ~\ {0.0136, \ 0.0528}]\), " ", StyleBox[\( (*\ when\ nGrid\ = \ 200\ *) \), FontColor->RGBColor[1, 0, 1]]}]], "Input"], Cell[BoxData[ RowBox[{ "energyList", " ", "=", " ", \(Sort[{0.005, \ 0.01, 0.015, \ 0.020, \ 0.03, \ 0.04, \ 0.05, \ 0.06, \ 0.08, \ 0.1, \ 0.12}\ ~\ Join\ ~\ {0.0383}]\), " ", StyleBox[\( (*\ when\ nGrid\ = \ 100\ *) \), FontColor->RGBColor[1, 0, 1]]}]], "Input"], Cell["\<\ These energies include the multiple barrier resonances and values \ greater than the first barrier height.\ \>", "Text"], Cell[TextData[{ "Next, we compute the probability ofpassing through the first barrier. This \ changes with time. So, we look at the ", StyleBox["largest", FontSlant->"Italic"], " transmission probability, and we record this." }], "Text"], Cell[BoxData[{ \(\(findMaxTransmission1[energy_]\ := \ Module[{sol, v0, \ tSteps, \ initial\[Psi]}, \[IndentingNewLine]v0\ = \ Sqrt[2\ energy]; \[IndentingNewLine]initial\[Psi]\ = \ Table[\(initial[v0, nGrid/4, 14]\)[x], \ {x, \ 1, \ nGrid}]; \[IndentingNewLine]tSteps\ = \ Ceiling[\((0.7\ nGrid/v0)\)/10]; \ \[IndentingNewLine]sol\ = \ NestList[\(cnStep[10, a, b1, v1]\)[#] &, \ initial\[Psi], \ tSteps]; \[IndentingNewLine]Max[ 1 - \ \((probLeft\ /@ \ sol)\)]];\)\), "\[IndentingNewLine]", \(\(findMaxTransmission2[energy_]\ := \ Module[{sol, v0, \ tSteps, \ initial\[Psi]}, \[IndentingNewLine]v0\ = \ Sqrt[2\ energy]; \[IndentingNewLine]initial\[Psi]\ = \ Table[\(initial[v0, nGrid/4, 14]\)[x], \ {x, \ 1, \ nGrid}]; \[IndentingNewLine]tSteps\ = \ Ceiling[\((0.7\ nGrid/v0)\)/10]; \ \[IndentingNewLine]sol\ = \ NestList[\(cnStep[10, a, b2, v2]\)[#] &, \ initial\[Psi], \ tSteps]; \[IndentingNewLine]Max[ 1 - \ \((probLeft\ /@ \ sol)\)]];\)\)}], "Input"], Cell[BoxData[ \(findMaxTransmission1[0.0383]\ // \ Timing\)], "Input"], Cell[BoxData[ \(findMaxTransmission2[0.0383]\ // \ Timing\)], "Input"], Cell[BoxData[ \(\((t1List\ = \ \((findMaxTransmission1\ /@ \ energyList)\); \[IndentingNewLine]t2List\ = \ \ \((findMaxTransmission2\ /@ \ energyList)\);\ )\) // \ Timing\)], "Input"], Cell[BoxData[{ \(\(p1\ = \ ListPlot[Transpose[{energyList, \ t1List}], \ PlotJoined \[Rule] \ True, PlotStyle \[Rule] \ {RGBColor[1, 0, 0], \ PointSize[0.02]}];\)\), "\[IndentingNewLine]", \(\(p2\ = \ ListPlot[ Transpose[{energyList, \ t2List}], \ \ PlotJoined \[Rule] \ True, PlotStyle \[Rule] \ {RGBColor[0, 0, 1], \ PointSize[0.02]}];\)\), "\[IndentingNewLine]", \(\(Show[p1, p2, \ Graphics[Line[{{0.0383, 0.02}, {0.0383, 0.5}}]], \ Graphics[Text["\", \ {0.0383, \ 0.5}, \ {0, \ \(-1\)}]], \ PlotLabel \[Rule] \ "\", \ AxesLabel \[Rule] \ {"\", \ "\<\>"}];\)\)}], "Input"], Cell[BoxData[{ \(\(p1\ = \ ListPlot[Transpose[{energyList, \ t1List}], \ PlotJoined \[Rule] \ True, PlotStyle \[Rule] \ {RGBColor[1, 0, 0], \ PointSize[0.02]}];\)\), "\[IndentingNewLine]", \(\(p2\ = \ ListPlot[ Transpose[{energyList, \ t2List}], \ \ PlotJoined \[Rule] \ True, PlotStyle \[Rule] \ {RGBColor[0, 0, 1], \ PointSize[0.02]}];\)\), "\[IndentingNewLine]", \(\(Show[p1, p2, \ Graphics[Line[{{0.0135964, 0.02}, {0.0135964, 0.5}}]], \ Graphics[ Text["\", \ {0.0135964, \ 0.5}, \ {0, \ \(-1\)}]], \ Graphics[Line[{{0.05277, 0.02}, {0.05277, 0.5}}]], Graphics[Text["\", \ {0.05277, \ 0.5}, \ {0, \ \(-1\)}]], \ PlotLabel \[Rule] \ "\", \ AxesLabel \[Rule] \ {"\", \ "\<\>"}];\)\)}], "Input"], Cell[BoxData[ \(\(Needs["\"];\)\)], "Input"], Cell[BoxData[{ \(\(pl1\ = \ LogLogListPlot[Transpose[{energyList, \ t1List}], \ PlotJoined \[Rule] \ True, PlotStyle \[Rule] \ {RGBColor[1, 0, 0], \ PointSize[0.02]}];\)\), "\[IndentingNewLine]", \(\(pl2\ = \ LogLogListPlot[Transpose[{energyList, \ t2List}], \ PlotJoined \[Rule] \ True, PlotStyle \[Rule] \ {RGBColor[0, 0, 1], \ PointSize[0.02]}];\)\)}], "Input"], Cell[BoxData[ \(\(Show[pl1, pl2];\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]] }, Open ]] }, FrontEndVersion->"5.1 for Macintosh", ScreenRectangle->{{0, 1600}, {0, 967}}, WindowSize->{746, 724}, WindowMargins->{{138, Automatic}, {Automatic, 0}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, StyleDefinitions -> "Classic.nb" ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1776, 53, 60, 0, 134, "Title"], Cell[1839, 55, 84, 1, 57, "Subsubtitle"], Cell[1926, 58, 114, 2, 91, "Subsubtitle"], Cell[CellGroupData[{ Cell[2065, 64, 31, 0, 58, "Section"], Cell[2099, 66, 1624, 31, 214, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[3760, 102, 62, 0, 32, "Section"], Cell[3825, 104, 91, 3, 28, "Text"], Cell[3919, 109, 120, 3, 28, "Text"], Cell[4042, 114, 1179, 19, 195, "Input"], Cell[5224, 135, 688, 12, 110, "Text"], Cell[5915, 149, 64, 0, 28, "Text"], Cell[CellGroupData[{ Cell[6004, 153, 52, 0, 30, "Subsection"], Cell[6059, 155, 536, 14, 78, "Text"], Cell[6598, 171, 77, 1, 35, "Input"], Cell[6678, 174, 110, 2, 35, "Input"], Cell[6791, 178, 820, 15, 163, "Input"], Cell[7614, 195, 568, 12, 99, "Input"], Cell[8185, 209, 505, 10, 83, "Input"], Cell[8693, 221, 179, 3, 51, "Input"], Cell[8875, 226, 988, 18, 163, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[9900, 249, 47, 0, 30, "Subsection"], Cell[9950, 251, 357, 10, 48, "Text"], Cell[CellGroupData[{ Cell[10332, 265, 44, 0, 30, "Subsubsection"], Cell[10379, 267, 570, 15, 67, "Input"], Cell[10952, 284, 188, 5, 30, "Text"], Cell[11143, 291, 136, 3, 35, "Input"], Cell[11282, 296, 293, 6, 67, "Input"], Cell[11578, 304, 293, 6, 67, "Input"], Cell[11874, 312, 193, 5, 30, "Text"], Cell[12070, 319, 143, 3, 35, "Input"], Cell[12216, 324, 112, 2, 35, "Input"], Cell[12331, 328, 671, 13, 115, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[13051, 347, 61, 0, 30, "Subsection"], Cell[13115, 349, 527, 15, 66, "Text"], Cell[13645, 366, 1331, 39, 138, "Text"], Cell[CellGroupData[{ Cell[15001, 409, 58, 0, 30, "Subsubsection"], Cell[15062, 411, 276, 9, 48, "Text"], Cell[15341, 422, 236, 4, 51, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[15614, 431, 52, 0, 30, "Subsubsection"], Cell[15669, 433, 236, 9, 30, "Text"], Cell[15908, 444, 235, 5, 51, "Input"], Cell[16146, 451, 193, 3, 51, "Input"], Cell[16342, 456, 110, 3, 30, "Text"], Cell[16455, 461, 975, 18, 188, "Input"], Cell[17433, 481, 874, 22, 67, "Input"], Cell[18310, 505, 835, 21, 67, "Input"], Cell[19148, 528, 93, 3, 30, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[19290, 537, 47, 0, 30, "Subsection"], Cell[19340, 539, 389, 13, 48, "Text"], Cell[CellGroupData[{ Cell[19754, 556, 33, 0, 30, "Subsubsection"], Cell[19790, 558, 76, 0, 30, "Text"], Cell[19869, 560, 952, 29, 84, "Text"], Cell[20824, 591, 118, 3, 30, "Text"], Cell[20945, 596, 325, 7, 67, "Input"], Cell[21273, 605, 308, 6, 67, "Input"], Cell[21584, 613, 130, 3, 30, "Text"], Cell[21717, 618, 247, 6, 48, "Text"], Cell[21967, 626, 1213, 20, 243, "Input"], Cell[23183, 648, 75, 1, 35, "Input"], Cell[23261, 651, 75, 1, 35, "Input"], Cell[23339, 654, 206, 3, 51, "Input"], Cell[23548, 659, 754, 14, 131, "Input"], Cell[24305, 675, 921, 18, 163, "Input"], Cell[25229, 695, 69, 1, 35, "Input"], Cell[25301, 698, 467, 10, 83, "Input"], Cell[25771, 710, 52, 1, 35, "Input"] }, Closed]] }, Closed]] }, Closed]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)