(* Content-type: application/vnd.wolfram.mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 8.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 157, 7] NotebookDataLength[ 46227, 1170] NotebookOptionsPosition[ 44078, 1097] NotebookOutlinePosition[ 44532, 1115] CellTagsIndexPosition[ 44489, 1112] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell[TextData[{ "Time Dependent Schr\[ODoubleDot]dinger Equation\n", StyleBox["T J Atherton, Tufts University", "Subtitle"] }], "Title", CellChangeTimes->{{3.578413429626005*^9, 3.5784134443244257`*^9}, { 3.578413501413418*^9, 3.578413504482254*^9}, {3.578856553982141*^9, 3.578856596597741*^9}}], Cell["\<\ How to use this notebook: 1) Run the whole notebook by choosing Edit>Select All and then Shift-Enter. 2) Choose a potential in the \[OpenCurlyDoubleQuote]Prepare a potential\ \[CloseCurlyDoubleQuote] section of the notebook. 3) Construct a wavepacket in the \[OpenCurlyDoubleQuote]Prepare a wavepacket\ \[CloseCurlyDoubleQuote] section of the notebook. 4) Go to the interactive video at the bottom and click \ \[OpenCurlyDoubleQuote]Go\[CloseCurlyDoubleQuote] to start the video. 5) Modify the potential or wavepacket as you like and click \ \[OpenCurlyDoubleQuote]Update\[CloseCurlyDoubleQuote] to refresh the display.\ \ \>", "Text", CellChangeTimes->{{3.578417543306035*^9, 3.578417546656147*^9}, { 3.578856388263681*^9, 3.57885648848377*^9}, {3.578856526227887*^9, 3.578856549032695*^9}, {3.578856771673234*^9, 3.578856827890452*^9}}], Cell[CellGroupData[{ Cell["Select region of space and discretization ", "Section", CellChangeTimes->{{3.538670781052516*^9, 3.538670798242166*^9}, { 3.563226067826391*^9, 3.563226076457741*^9}}], Cell["Region of space to solve over", "Text", CellChangeTimes->{{3.538670860175478*^9, 3.538670867170377*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"xsolveDomain", "=", RowBox[{"N", "[", RowBox[{"{", RowBox[{ RowBox[{"-", "40"}], ",", "40"}], "}"}], "]"}]}], ";"}]], "Input", CellChangeTimes->CompressedData[" 1:eJxTTMoPSmViYGAQB2IQ/WS95XTj2FeOd9S5ZoHoC+w8+iZAOoTXD0xvjuV7 BKKDv4uAaVndclFTIJ1u1gKmp/Lc0wLRcQtZtUH0zhlLjEC0r9IDCxCtPKls pRuQdntbDaYf7H/62x1Ia6R+B9NH3ofPqgLS3+aILwTRd0JTO2uAtM+592D6 /sG0Qqa4V45WlsfA9Hzm1EYQvSZ4BZjOC1pwh7HmlWPN3xNgelmD4DMmIM0n GA+mF2VlJr7vBsozLgbTWXHs6SD6RNwWML3kSYSg+spXjutSXoPpM79zdEC0 3ObTYHqrhJwhiNY6oQKmfy1NNgXReTNzwHTrr/PJIFpj6WcwfdZHo04LSIf1 h4HpzXl8r12BdPJKFzANADKOslM= "]], Cell["Region of space to visualize solution over", "Text", CellChangeTimes->{{3.538670869179405*^9, 3.538670881377282*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"domainWidth", "=", RowBox[{"N", "[", RowBox[{"(", RowBox[{ RowBox[{ "xsolveDomain", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}], "-", RowBox[{ "xsolveDomain", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}], ")"}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.578345716227234*^9, 3.5783457234108963`*^9}, { 3.5783458339417553`*^9, 3.578345844285372*^9}, {3.578346273695725*^9, 3.5783462767909517`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"domainCenter", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{ "xsolveDomain", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}], "+", RowBox[{ "xsolveDomain", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}], ")"}], "/", "2"}]}], ";"}]], "Input", CellChangeTimes->{{3.578408869177953*^9, 3.578408884038004*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"xvisDomain", "=", RowBox[{"N", "[", RowBox[{"{", RowBox[{ RowBox[{"domainCenter", "-", RowBox[{"domainWidth", "/", "8"}]}], ",", RowBox[{"domainCenter", "+", RowBox[{"domainWidth", "/", "8"}]}]}], "}"}], "]"}]}]], "Input", CellChangeTimes->{{3.538525369802721*^9, 3.5385253923173656`*^9}, { 3.5385265843759537`*^9, 3.538526586439127*^9}, {3.538528016448938*^9, 3.538528016655191*^9}, {3.538528427724257*^9, 3.538528428131641*^9}, { 3.538528598939036*^9, 3.538528600175948*^9}, {3.538528661143643*^9, 3.538528711004187*^9}, {3.538564427705339*^9, 3.538564427872714*^9}, { 3.5385671351796722`*^9, 3.538567135731098*^9}, {3.5386708027480183`*^9, 3.53867085740976*^9}, {3.5388478351145353`*^9, 3.538847836218357*^9}, { 3.5389491359883223`*^9, 3.5389491376038513`*^9}, {3.548537999367119*^9, 3.548538003111064*^9}, {3.5546561061843*^9, 3.5546561074132767`*^9}, { 3.5546758220186663`*^9, 3.5546758225948153`*^9}, {3.5546764584815893`*^9, 3.554676460401232*^9}, {3.5546765991959352`*^9, 3.554676603465665*^9}, { 3.554676799247734*^9, 3.554676800920031*^9}, {3.554677024086759*^9, 3.55467702468484*^9}, {3.5546785722110863`*^9, 3.5546785727797413`*^9}, { 3.578345625930317*^9, 3.5783456960729427`*^9}, {3.578345848652722*^9, 3.578345892818524*^9}, {3.578345951586113*^9, 3.578345952043941*^9}, { 3.578346279151237*^9, 3.578346282982723*^9}, 3.578352649999503*^9, { 3.578408797026002*^9, 3.578408820319323*^9}, {3.5784088903795*^9, 3.578408905068264*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"-", "10.`"}], ",", "10.`"}], "}"}]], "Output", CellChangeTimes->{{3.5783458494272127`*^9, 3.5783459072704973`*^9}, 3.5783459525152607`*^9, 3.57834628354668*^9, 3.578347747772109*^9, { 3.578352629341284*^9, 3.57835265064137*^9}, 3.578393464396319*^9, 3.5784043041066113`*^9, 3.5784069024301243`*^9, 3.578407037270358*^9, 3.578407118487212*^9, 3.578407194757846*^9, 3.578407406907631*^9, 3.578407464546206*^9, 3.578408289231943*^9, {3.57840880398872*^9, 3.5784088206804743`*^9}, {3.5784089003935127`*^9, 3.578408905496126*^9}, 3.5787668462588*^9, 3.578856498668586*^9}] }, Open ]], Cell["Discretization choices ", "Text", CellChangeTimes->{{3.53867088746032*^9, 3.538670898294959*^9}, { 3.538671438158629*^9, 3.538671439735449*^9}, {3.563027215077989*^9, 3.5630272156274757`*^9}, {3.563226064850542*^9, 3.563226066016284*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"\[Delta]x", "=", RowBox[{"N", "[", RowBox[{"domainWidth", "/", "1000"}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.538525369802721*^9, 3.5385253923173656`*^9}, { 3.5385265843759537`*^9, 3.538526586439127*^9}, {3.538528016448938*^9, 3.538528016655191*^9}, {3.538528427724257*^9, 3.538528428131641*^9}, { 3.538528598939036*^9, 3.538528600175948*^9}, {3.538528661143643*^9, 3.538528711004187*^9}, {3.538564427705339*^9, 3.538564427872714*^9}, { 3.5385671351796722`*^9, 3.538567135731098*^9}, {3.5386708027480183`*^9, 3.53867085740976*^9}, {3.538673144325654*^9, 3.5386731454678392`*^9}, 3.53869894519805*^9, {3.538699780313232*^9, 3.5386997809281197`*^9}, 3.5386998820254927`*^9, 3.5386999622311974`*^9, {3.5546561331882687`*^9, 3.554656141523931*^9}, {3.554656191956753*^9, 3.5546561924806623`*^9}, { 3.5546759382058287`*^9, 3.5546759389398823`*^9}, {3.554676463506706*^9, 3.554676468081904*^9}, {3.554678628719861*^9, 3.554678629136448*^9}, { 3.563026960494875*^9, 3.563026960874096*^9}, {3.563027048360198*^9, 3.563027049165872*^9}, {3.563027204102749*^9, 3.56302720424585*^9}, 3.578345256554125*^9, {3.578345298502915*^9, 3.578345301270761*^9}, { 3.578345913919711*^9, 3.578345915360911*^9}, {3.578346263091106*^9, 3.578346264663336*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"\[Delta]t", " ", "=", " ", RowBox[{"N", "[", "\[Delta]x", "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.5386714328664618`*^9, 3.538671433305867*^9}, { 3.5386730397632513`*^9, 3.538673040050729*^9}, {3.5386733123009777`*^9, 3.53867331314002*^9}, {3.538674474966786*^9, 3.538674477054553*^9}, { 3.5386754684489717`*^9, 3.538675468759856*^9}, {3.538699749714959*^9, 3.5386997846311417`*^9}, {3.5386998860350733`*^9, 3.538699886185586*^9}, { 3.538699965375082*^9, 3.538699965958535*^9}, {3.554656131125908*^9, 3.5546561430285387`*^9}, {3.554656194922262*^9, 3.554656195065752*^9}, { 3.55467580022158*^9, 3.554675801660035*^9}, {3.554678630791128*^9, 3.554678631054184*^9}, {3.563026962474674*^9, 3.563026963058126*^9}, { 3.563027050942039*^9, 3.563027051076426*^9}, {3.563027206022274*^9, 3.563027206092031*^9}, 3.578345258346354*^9, {3.578345928135462*^9, 3.578345938455632*^9}, {3.57834626699129*^9, 3.57834626810353*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"tmax", "=", " ", RowBox[{"100000", " ", "\[Delta]t"}]}], ";"}]], "Input", CellChangeTimes->{{3.538672726433219*^9, 3.538672746462133*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"pause", " ", "=", " ", "0.02"}], ";"}]], "Input", CellChangeTimes->{{3.57839487573167*^9, 3.5783948883452387`*^9}, { 3.578766840801298*^9, 3.578766842679558*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Prepare solver", "Section", CellChangeTimes->{{3.538671068221723*^9, 3.5386710809948263`*^9}, { 3.538672981358663*^9, 3.5386729864360943`*^9}}], Cell[BoxData[ RowBox[{"(*", RowBox[{ RowBox[{"PPinfwell", "=", RowBox[{ RowBox[{ RowBox[{"-", "1"}], "/", "2"}], " ", RowBox[{ RowBox[{"SparseArray", "[", RowBox[{"Join", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i", ",", "i"}], "}"}], "\[Rule]", " ", RowBox[{"-", "2"}]}], ",", RowBox[{"{", RowBox[{"i", ",", "NN"}], "}"}]}], "]"}], ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Wrap", "[", RowBox[{"i", "-", "1"}], "]"}], ",", "i"}], "}"}], "\[Rule]", " ", "1"}], ",", RowBox[{"{", RowBox[{"i", ",", "2", ",", "NN"}], "}"}]}], "]"}], ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Wrap", "[", RowBox[{"i", "+", "1"}], "]"}], ",", "i"}], "}"}], "\[Rule]", " ", "1"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"NN", "-", "1"}]}], "}"}]}], "]"}]}], "]"}], "]"}], "/", RowBox[{"\[Delta]x", "^", "2"}]}]}]}], ";"}], "*)"}]], "Input", CellChangeTimes->{{3.5385233519330797`*^9, 3.5385233734494123`*^9}, { 3.538526117864401*^9, 3.538526121545298*^9}, {3.5385263571480293`*^9, 3.538526358070479*^9}, {3.5386743202170153`*^9, 3.5386743235846252`*^9}, { 3.578393175602468*^9, 3.57839317806179*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"joinCoordinates", "[", RowBox[{"xx_", ",", "f_"}], "]"}], ":=", " ", RowBox[{"Transpose", "[", RowBox[{"{", RowBox[{"xx", ",", "f"}], "}"}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.538672791564975*^9, 3.5386728239510803`*^9}, { 3.5783937453904333`*^9, 3.5783937535867577`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"Wrap", "[", RowBox[{"i_", ",", "NN_"}], "]"}], ":=", RowBox[{"Which", "[", RowBox[{ RowBox[{"i", "<", "1"}], ",", "NN", ",", RowBox[{"i", ">", "NN"}], ",", "1", ",", "True", ",", "i"}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.578393706169138*^9, 3.578393707376773*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"prepareSolver", "[", RowBox[{ "V_", ",", "\[Psi]0_", ",", "domain_", ",", "\[Delta]x_", ",", "\[Delta]t_"}], "]"}], ":=", " ", RowBox[{"Block", "[", RowBox[{ RowBox[{"{", RowBox[{ "xx", ",", "NN", ",", "vv", ",", "ps0", ",", "VVx", ",", "II", ",", "PPperiodic", ",", "HH", ",", "h1", ",", "h2", ",", "Lh2"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"xx", "=", RowBox[{"Table", "[", RowBox[{"x", ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{ "domain", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], ",", RowBox[{ "domain", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}], ",", "\[Delta]x"}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"NN", "=", RowBox[{"Length", "[", "xx", "]"}]}], ";", "\n", " ", RowBox[{"vv", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"V", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{ "domain", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], ",", RowBox[{ "domain", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}], ",", "\[Delta]x"}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"ps0", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"\[Psi]0", "[", RowBox[{"x", ",", "x0", ",", "k0", ",", "\[Sigma]k"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{ "domain", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], ",", RowBox[{ "domain", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}], ",", "\[Delta]x"}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"(*", RowBox[{ RowBox[{"ps0", "=", RowBox[{"ps0", "/", RowBox[{"Sqrt", "[", RowBox[{"ps0", ".", RowBox[{"Conjugate", "[", "ps0", "]"}]}], "]"}]}]}], ";"}], "*)"}], "\n", " ", RowBox[{"VVx", "=", RowBox[{"SparseArray", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i", ",", "i"}], "}"}], "\[Rule]", " ", RowBox[{ "vv", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]}], ",", RowBox[{"{", RowBox[{"i", ",", "NN"}], "}"}]}], "]"}], "]"}]}], ";", "\n", " ", RowBox[{"II", "=", RowBox[{"SparseArray", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i", ",", "i"}], "}"}], "\[Rule]", " ", "1"}], ",", RowBox[{"{", RowBox[{"i", ",", "NN"}], "}"}]}], "]"}], "]"}]}], ";", "\n", " ", "\[IndentingNewLine]", RowBox[{"PPperiodic", "=", RowBox[{ RowBox[{ RowBox[{"-", "1"}], "/", "2"}], " ", RowBox[{ RowBox[{"SparseArray", "[", RowBox[{"Join", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i", ",", "i"}], "}"}], "\[Rule]", " ", RowBox[{"-", "2"}]}], ",", RowBox[{"{", RowBox[{"i", ",", "NN"}], "}"}]}], "]"}], ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Wrap", "[", RowBox[{ RowBox[{"i", "-", "1"}], ",", "NN"}], "]"}], ",", "i"}], "}"}], "\[Rule]", " ", "1"}], ",", RowBox[{"{", RowBox[{"i", ",", "NN"}], "}"}]}], "]"}], ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Wrap", "[", RowBox[{ RowBox[{"i", "+", "1"}], ",", "NN"}], "]"}], ",", "i"}], "}"}], "\[Rule]", " ", "1"}], ",", RowBox[{"{", RowBox[{"i", ",", "NN"}], "}"}]}], "]"}]}], "]"}], "]"}], "/", RowBox[{"\[Delta]x", "^", "2"}]}]}]}], ";", "\[IndentingNewLine]", RowBox[{"HH", "=", RowBox[{"PPperiodic", "+", "VVx"}]}], ";", "\n", " ", RowBox[{"h1", "=", RowBox[{"(", RowBox[{"II", "-", " ", RowBox[{"I", " ", RowBox[{"HH", "/", "2"}], " ", "\[Delta]t"}]}], ")"}]}], ";", "\n", " ", RowBox[{"h2", "=", RowBox[{"(", RowBox[{"II", "+", " ", RowBox[{"I", " ", RowBox[{"HH", "/", "2"}], " ", "\[Delta]t"}]}], ")"}]}], ";", "\n", " ", RowBox[{"Lh2", "=", RowBox[{"LinearSolve", "[", "h2", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Return", "[", RowBox[{"{", RowBox[{"h1", ",", "Lh2", ",", "xx", ",", "ps0", ",", "vv"}], "}"}], "]"}], ";"}]}], "\[IndentingNewLine]", "]"}]}]], "Input", CellChangeTimes->{{3.5784083890895853`*^9, 3.578408451820457*^9}, { 3.578408623997768*^9, 3.5784086253321*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Prepare a potential", "Section", CellChangeTimes->{{3.538670714335421*^9, 3.5386707178416157`*^9}}], Cell[TextData[{ "Use the GUI below to choose a potential function A ", Cell[BoxData[ FormBox[ RowBox[{"V", "(", RowBox[{"B", "(", RowBox[{"x", "-", SubscriptBox["x", "0"]}], ")"}]}], TraditionalForm]], FormatType->"TraditionalForm"], "); you can adjust the constants A, B and ", Cell[BoxData[ FormBox[ SubscriptBox["x", "0"], TraditionalForm]], FormatType->"TraditionalForm"], " to scale and translate the function as you like. You can also define an \ arbitrary potential by modifying these functions\[LongDash]the ", Cell[BoxData[ FormBox[ SubscriptBox["V", "custom"], TraditionalForm]], FormatType->"TraditionalForm"], " potential is provided specifically for this purpose. " }], "Text", CellChangeTimes->{{3.578417296532672*^9, 3.578417317840705*^9}, { 3.5784173503827353`*^9, 3.578417388885088*^9}, {3.578417433259878*^9, 3.578417504251376*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Vfree", "[", "x_", "]"}], ":=", "0"}]], "Input", CellChangeTimes->{{3.578406021973761*^9, 3.578406024021575*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Vho", "[", "x_", "]"}], ":=", RowBox[{"x", "^", "2"}]}]], "Input", CellChangeTimes->{{3.538699352577579*^9, 3.538699392612566*^9}, 3.538699663822577*^9, {3.538761503132842*^9, 3.5387615042923098`*^9}, { 3.563226093603071*^9, 3.563226127167877*^9}, {3.5783453814804697`*^9, 3.5783454060506163`*^9}, {3.578404860915399*^9, 3.578404861280574*^9}, { 3.578405911141995*^9, 3.578405930946455*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Vstep", "[", "x_", "]"}], ":=", " ", RowBox[{"If", "[", RowBox[{ RowBox[{"x", "<", "0"}], ",", "0", ",", "1"}], "]"}]}]], "Input", CellChangeTimes->{{3.5784059900314417`*^9, 3.578406002189324*^9}, { 3.578406071739608*^9, 3.578406076267071*^9}, {3.578406409955723*^9, 3.578406410650187*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"Vbarrier", "[", "x_", "]"}], ":=", RowBox[{"Which", "[", RowBox[{ RowBox[{"0", "<", "x", "<", "1"}], ",", "1", ",", "True", ",", "0"}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.578406412378461*^9, 3.578406425615924*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"Vcrystal", "[", "x_", "]"}], ":=", " ", RowBox[{"-", RowBox[{"Which", "[", RowBox[{ RowBox[{ RowBox[{"x", ">", "0"}], " ", "&&", " ", RowBox[{"EvenQ", "[", RowBox[{"IntegerPart", "[", " ", "x", "]"}], "]"}]}], ",", "1", ",", "True", ",", "0"}], "]"}]}]}], ";"}]], "Input", CellChangeTimes->{{3.5784064694065104`*^9, 3.578406488711576*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Vcustom", "[", "x_", "]"}], ":=", " ", "0"}]], "Input", CellChangeTimes->{{3.578417325188312*^9, 3.578417330441781*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{ RowBox[{"V", "=", RowBox[{ RowBox[{"A", " ", RowBox[{"VV", "[", RowBox[{"B", RowBox[{"(", RowBox[{"#", "-", "xv0"}], ")"}]}], "]"}]}], "&"}]}], ";", RowBox[{"Plot", "[", RowBox[{ RowBox[{"A", " ", RowBox[{"VV", "[", RowBox[{"B", RowBox[{"(", RowBox[{"x", "-", "xv0"}], ")"}]}], "]"}]}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{ "xvisDomain", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], ",", RowBox[{ "xvisDomain", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}]}], "}"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"-", "10"}], ",", "10"}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", " ", RowBox[{"{", RowBox[{"Thick", ",", "Black"}], "}"}]}], ",", RowBox[{"PlotPoints", "\[Rule]", " ", "200"}]}], "]"}]}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"VV", ",", "Vstep"}], "}"}], ",", RowBox[{"{", RowBox[{ "Vfree", ",", "Vstep", ",", "Vbarrier", ",", "Vcrystal", ",", "Vho", ",", "Vcustom"}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"A", ",", "1"}], "}"}], ",", RowBox[{"-", "10"}], ",", "10"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"B", ",", "1"}], "}"}], ",", "0", ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"xv0", ",", "0"}], "}"}], ",", RowBox[{ "xvisDomain", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], ",", RowBox[{ "xvisDomain", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}]}], "}"}], ",", RowBox[{"LocalizeVariables", "\[Rule]", "False"}], ",", RowBox[{"SaveDefinitions", "\[Rule]", " ", "True"}]}], "]"}]], "Input", CellChangeTimes->{{3.538526159668229*^9, 3.538526187708547*^9}, { 3.538652574384169*^9, 3.53865259294312*^9}, {3.5386526504931173`*^9, 3.53865265126038*^9}, {3.53867099443736*^9, 3.538671009546708*^9}, { 3.57840587447819*^9, 3.57840594506161*^9}, {3.5784060071616783`*^9, 3.57840611967282*^9}, {3.57840615610455*^9, 3.5784062846045227`*^9}, { 3.578406342248226*^9, 3.578406361927052*^9}, {3.578406447483941*^9, 3.578406448320695*^9}, {3.5784065890325127`*^9, 3.5784067043657923`*^9}, { 3.57840710651611*^9, 3.5784071481039877`*^9}, {3.578409402214068*^9, 3.578409415572988*^9}, {3.578409508623332*^9, 3.578409513647752*^9}, { 3.578417335183013*^9, 3.5784173371005487`*^9}}], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{{ Hold[$CellContext`VV], $CellContext`Vstep}, {$CellContext`Vfree, \ $CellContext`Vstep, $CellContext`Vbarrier, $CellContext`Vcrystal, \ $CellContext`Vho, $CellContext`Vcustom}}, {{ Hold[$CellContext`A], 1}, -10, 10}, {{ Hold[$CellContext`B], 1}, 0, 2}, {{ Hold[$CellContext`xv0], 0}, -10., 10.}}, Typeset`size$$ = { 360., {114., 118.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = False, $CellContext`VV$751$$ = 0, $CellContext`A$752$$ = 0, $CellContext`B$753$$ = 0, $CellContext`xv0$754$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`A = 1, $CellContext`B = 1, $CellContext`VV = $CellContext`Vstep, $CellContext`xv0 = 0}, "ControllerVariables" :> { Hold[$CellContext`VV, $CellContext`VV$751$$, 0], Hold[$CellContext`A, $CellContext`A$752$$, 0], Hold[$CellContext`B, $CellContext`B$753$$, 0], Hold[$CellContext`xv0, $CellContext`xv0$754$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> ($CellContext`V = $CellContext`A \ $CellContext`VV[$CellContext`B (# - $CellContext`xv0)]& ; Plot[$CellContext`A $CellContext`VV[$CellContext`B ($CellContext`x - \ $CellContext`xv0)], {$CellContext`x, Part[$CellContext`xvisDomain, 1], Part[$CellContext`xvisDomain, 2]}, PlotRange -> {-10, 10}, PlotStyle -> {Thick, Black}, PlotPoints -> 200]), "Specifications" :> {{{$CellContext`VV, $CellContext`Vstep}, \ {$CellContext`Vfree, $CellContext`Vstep, $CellContext`Vbarrier, \ $CellContext`Vcrystal, $CellContext`Vho, $CellContext`Vcustom}}, \ {{$CellContext`A, 1}, -10, 10}, {{$CellContext`B, 1}, 0, 2}, {{$CellContext`xv0, 0}, -10., 10.}}, "Options" :> {LocalizeVariables -> False}, "DefaultOptions" :> {}], ImageSizeCache->{405., {199., 204.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, Initialization:>({$CellContext`V = $CellContext`A \ $CellContext`VV[$CellContext`B (# - $CellContext`xv0)]& , $CellContext`A = 0.40000000000000036`, $CellContext`VV = $CellContext`Vho, \ $CellContext`Vho[ Pattern[$CellContext`x, Blank[]]] := $CellContext`x^2, $CellContext`B = 1, $CellContext`xv0 = 0, $CellContext`xvisDomain = {-10., 10.}, $CellContext`Vstep[ Pattern[$CellContext`x, Blank[]]] := If[$CellContext`x < 0, 0, 1], $CellContext`Vfree[ Pattern[$CellContext`x, Blank[]]] := 0, $CellContext`Vbarrier[ Pattern[$CellContext`x, Blank[]]] := Which[0 < $CellContext`x < 1, 1, True, 0], $CellContext`Vcrystal[ Pattern[$CellContext`x, Blank[]]] := -Which[ And[$CellContext`x > 0, EvenQ[ IntegerPart[$CellContext`x]]], 1, True, 0], $CellContext`Vcustom[ Pattern[$CellContext`x, Blank[]]] := 0}; Typeset`initDone$$ = True), SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellChangeTimes->{ 3.578405904659938*^9, 3.57840594557432*^9, 3.5784060039868937`*^9, { 3.578406053737151*^9, 3.578406085098514*^9}, 3.578406120198915*^9, { 3.578406171725539*^9, 3.578406200168009*^9}, {3.5784062424717617`*^9, 3.578406285097418*^9}, {3.578406365847765*^9, 3.578406375562997*^9}, 3.5784064496276197`*^9, {3.5784066035383177`*^9, 3.578406709508093*^9}, 3.578406908535643*^9, {3.578407113489151*^9, 3.578407149012559*^9}, 3.578407225353992*^9, 3.578407419586879*^9, 3.578407473380406*^9, 3.578408340542267*^9, 3.5784094160679626`*^9, 3.5784095209283857`*^9, { 3.57841733768161*^9, 3.578417343124405*^9}, 3.578856500035739*^9}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Prepare a wavepacket", "Section", CellChangeTimes->{{3.538670714335421*^9, 3.538670738229377*^9}}], Cell["\<\ Prepare a starting wavefunction \[LongDash]\[NonBreakingSpace]a normalized \ Gaussian wavepacket with center x0 and momentum k0 with width in momentum \ space k0\ \>", "Text", CellChangeTimes->{{3.5386716855678062`*^9, 3.5386717385954657`*^9}, { 3.538673874406385*^9, 3.538673877900166*^9}, {3.57841751803176*^9, 3.578417527157892*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"\[Psi]0", "[", RowBox[{"x_", ",", "x0_", ",", "k0_", ",", "\[Sigma]_"}], "]"}], ":=", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{ FractionBox["1", "4"], " ", RowBox[{"(", RowBox[{"x", "-", "x0"}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{"4", " ", "\[ImaginaryI]", " ", "k0"}], "+", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"-", "x"}], "+", "x0"}], ")"}], " ", SuperscriptBox["\[Sigma]", "2"]}]}], ")"}]}]], " ", SqrtBox["\[Pi]"], " ", RowBox[{"\[Sigma]", "/", RowBox[{"Sqrt", "[", RowBox[{ SqrtBox["2"], " ", SuperscriptBox["\[Pi]", RowBox[{"3", "/", "2"}]], " ", "\[Sigma]"}], "]"}]}]}]}], ";"}]], "Input", CellChangeTimes->{{3.538671633284664*^9, 3.5386716831679296`*^9}, { 3.5386717171354837`*^9, 3.5386717424139633`*^9}, {3.5386720485510883`*^9, 3.538672050998355*^9}, 3.538672103433729*^9, 3.538672198559079*^9, { 3.538672231392939*^9, 3.538672263766954*^9}, {3.538672341024955*^9, 3.5386723451664953`*^9}, {3.538672381112124*^9, 3.53867242971556*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Plot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Re", "[", RowBox[{"\[Psi]0", "[", RowBox[{"x", ",", "x0", ",", "k0", ",", "\[Sigma]k"}], "]"}], "]"}], ",", RowBox[{"Im", "[", RowBox[{"\[Psi]0", "[", RowBox[{"x", ",", "x0", ",", "k0", ",", "\[Sigma]k"}], "]"}], "]"}], ",", RowBox[{"Abs", "[", RowBox[{"\[Psi]0", "[", RowBox[{"x", ",", "x0", ",", "k0", ",", "\[Sigma]k"}], "]"}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{ "xsolveRange", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], ",", RowBox[{ "xsolveRange", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}]}], "}"}], ",", RowBox[{"PlotRange", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", " ", RowBox[{"{", RowBox[{"Cyan", ",", "Pink", ",", "Black"}], "}"}]}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x0", ",", "0"}], "}"}], ",", RowBox[{ "xvisDomain", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], ",", RowBox[{ "xvisDomain", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"k0", ",", "0"}], "}"}], ",", "0", ",", "5"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"\[Sigma]k", ",", "0.05"}], "}"}], ",", "1*^-4", ",", "5"}], "}"}], ",", RowBox[{"LocalizeVariables", "\[Rule]", " ", "False"}], ",", RowBox[{"SaveDefinitions", "\[Rule]", " ", "True"}]}], "]"}]], "Input", CellChangeTimes->{{3.538671761415573*^9, 3.5386718070793943`*^9}, { 3.538671853840369*^9, 3.538671973992011*^9}, {3.5386720061406937`*^9, 3.538672026301049*^9}, {3.538672218458996*^9, 3.538672249423745*^9}, { 3.538672462224186*^9, 3.538672502636578*^9}, {3.538673069952857*^9, 3.538673103923751*^9}, {3.538673508517736*^9, 3.538673532242487*^9}, { 3.538674380352272*^9, 3.538674387799094*^9}, {3.578345220019123*^9, 3.5783452321175756`*^9}, 3.5783454403360233`*^9, {3.5783934815825987`*^9, 3.578393482618712*^9}, {3.578407248346187*^9, 3.578407248818618*^9}, { 3.578407659328228*^9, 3.578407714682893*^9}}], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{{ Hold[$CellContext`x0], 0}, -10., 10.}, {{ Hold[$CellContext`k0], 0}, 0, 5}, {{ Hold[$CellContext`\[Sigma]k], 0.05}, Rational[1, 10000], 5}}, Typeset`size$$ = {360., {114., 118.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = False, $CellContext`x0$804$$ = 0, $CellContext`k0$805$$ = 0, $CellContext`\[Sigma]k$806$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`k0 = 0, $CellContext`x0 = 0, $CellContext`\[Sigma]k = 0.05}, "ControllerVariables" :> { Hold[$CellContext`x0, $CellContext`x0$804$$, 0], Hold[$CellContext`k0, $CellContext`k0$805$$, 0], Hold[$CellContext`\[Sigma]k, $CellContext`\[Sigma]k$806$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> Plot[{ Re[ $CellContext`\[Psi]0[$CellContext`x, $CellContext`x0, \ $CellContext`k0, $CellContext`\[Sigma]k]], Im[ $CellContext`\[Psi]0[$CellContext`x, $CellContext`x0, \ $CellContext`k0, $CellContext`\[Sigma]k]], Abs[ $CellContext`\[Psi]0[$CellContext`x, $CellContext`x0, \ $CellContext`k0, $CellContext`\[Sigma]k]]}, {$CellContext`x, Part[$CellContext`xsolveRange, 1], Part[$CellContext`xsolveRange, 2]}, PlotRange -> {-1, 1}, PlotStyle -> {Cyan, Pink, Black}], "Specifications" :> {{{$CellContext`x0, 0}, -10., 10.}, {{$CellContext`k0, 0}, 0, 5}, {{$CellContext`\[Sigma]k, 0.05}, Rational[1, 10000], 5}}, "Options" :> {LocalizeVariables -> False}, "DefaultOptions" :> {}], ImageSizeCache->{405., {199., 204.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, Initialization:>({$CellContext`\[Psi]0[ Pattern[$CellContext`x, Blank[]], Pattern[$CellContext`x0, Blank[]], Pattern[$CellContext`k0, Blank[]], Pattern[$CellContext`\[Sigma], Blank[]]] := E^((1/4) ($CellContext`x - $CellContext`x0) ( 4 I $CellContext`k0 + (-$CellContext`x + $CellContext`x0) \ $CellContext`\[Sigma]^2)) Sqrt[Pi] ($CellContext`\[Sigma]/Sqrt[ Sqrt[2] Pi^(3/2) $CellContext`\[Sigma]]), $CellContext`x0 = 0.10000000000000142`, $CellContext`k0 = 0.48, $CellContext`\[Sigma]k = 1.250075, $CellContext`xsolveRange = {-10, 10}}; Typeset`initDone$$ = True), SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellChangeTimes->{ 3.578406924550447*^9, 3.578407156561908*^9, {3.5784072319700127`*^9, 3.578407249255822*^9}, 3.578407492133093*^9, {3.578407688065414*^9, 3.5784077151092033`*^9}, 3.5784083443759604`*^9, 3.578856500679208*^9}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["See the Movie!", "Section", CellChangeTimes->{{3.538670750822497*^9, 3.538670756556752*^9}, { 3.554218047515006*^9, 3.55421804843919*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"h1", ",", "Lh2", ",", "xx", ",", "psi0", ",", "vv"}], "}"}], "=", RowBox[{"prepareSolver", "[", RowBox[{ "V", ",", "\[Psi]0", ",", "xsolveDomain", ",", "\[Delta]x", ",", "\[Delta]t"}], "]"}]}], ";", RowBox[{"psi2", "=", "psi0"}], ";", RowBox[{"n", "=", "0"}], ";", RowBox[{"go", "=", "False"}], ";", RowBox[{"Grid", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"Grid", "[", RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"Button", "[", RowBox[{"\"\\"", ",", RowBox[{ RowBox[{"go", "=", "True"}], ";", RowBox[{"While", "[", RowBox[{"go", ",", RowBox[{ RowBox[{"psi2", "=", RowBox[{"Lh2", "[", RowBox[{"h1", " ", ".", " ", "psi2"}], "]"}]}], ";", RowBox[{"Pause", "[", "pause", "]"}], ";", " ", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"Abs", "[", RowBox[{"First", "[", "psi2", "]"}], "]"}], ">", "10*^-3"}], ",", RowBox[{"Break", "[", "]"}]}], "]"}], ";", RowBox[{"n", "+=", "1"}]}]}], "]"}]}], ",", RowBox[{"Method", "\[Rule]", "\"\\""}]}], "]"}], ",", RowBox[{"Button", "[", RowBox[{"\"\\"", ",", RowBox[{"go", "=", "False"}], ",", RowBox[{"Method", "\[Rule]", "\"\\""}]}], "]"}], ",", RowBox[{"Button", "[", RowBox[{"\"\\"", ",", RowBox[{ RowBox[{"psi2", "=", "psi0"}], ";", RowBox[{"n", "=", "0"}], ";", RowBox[{"go", "=", "False"}], ";"}]}], "]"}], ",", RowBox[{"Button", "[", RowBox[{"\"\\"", ",", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"h1", ",", "Lh2", ",", "xx", ",", "psi0", ",", "vv"}], "}"}], "=", RowBox[{"prepareSolver", "[", RowBox[{ "V", ",", "\[Psi]0", ",", "xsolveDomain", ",", "\[Delta]x", ",", "\[Delta]t"}], "]"}]}], ";", RowBox[{"psi2", "=", "psi0"}], ";", RowBox[{"go", "=", "False"}], ";", RowBox[{"n", "=", "0"}], ";"}]}], "]"}]}], "}"}], "}"}], "]"}], "}"}], ",", RowBox[{"{", RowBox[{"Dynamic", "[", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"ListQ", "[", "psi2", "]"}], ",", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"joinCoordinates", "[", RowBox[{"xx", ",", "vv"}], "]"}], ",", RowBox[{"joinCoordinates", "[", RowBox[{"xx", ",", RowBox[{"Re", "[", "psi2", "]"}]}], "]"}], ",", RowBox[{"joinCoordinates", "[", RowBox[{"xx", ",", RowBox[{"Im", "[", "psi2", "]"}]}], "]"}], ",", RowBox[{"joinCoordinates", "[", RowBox[{"xx", ",", RowBox[{"Abs", "[", "psi2", "]"}]}], "]"}]}], "}"}], ",", RowBox[{"Joined", "\[Rule]", " ", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"Thick", ",", "Gray"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"Thickness", "[", "0.001", "]"}], ",", "Cyan"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"Thickness", "[", "0.001", "]"}], ",", "Pink"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"Thickness", "[", "0.002", "]"}], ",", "White"}], "}"}]}], "}"}]}], ",", RowBox[{"Background", "\[Rule]", " ", "Black"}], ",", RowBox[{"Axes", "\[Rule]", " ", "False"}], ",", RowBox[{"PlotRange", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ "xvisDomain", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], ",", RowBox[{ "xvisDomain", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "2"}], "}"}]}], "}"}]}], ",", RowBox[{"AspectRatio", "\[Rule]", " ", RowBox[{"3", "/", "4"}]}], ",", RowBox[{"ImageSize", "\[Rule]", " ", "800"}]}], "]"}], ",", RowBox[{"Graphics", "[", "]"}]}], "]"}], ",", RowBox[{"UpdateInterval", "\[Rule]", " ", "pause"}]}], "]"}], "}"}]}], "}"}], "]"}]}]], "Input", CellChangeTimes->{{3.5783505722600718`*^9, 3.578350582947089*^9}, { 3.578350615987466*^9, 3.578350627969174*^9}, {3.5783512342826633`*^9, 3.5783512684734983`*^9}, {3.578351347798074*^9, 3.578351383115425*^9}, { 3.5783522460616617`*^9, 3.5783523761364727`*^9}, {3.578352407993905*^9, 3.5783524173254843`*^9}, 3.578352571618761*^9, {3.5783527001316147`*^9, 3.5783527284039288`*^9}, 3.578392622588125*^9, {3.5783927008700953`*^9, 3.578392738843791*^9}, {3.578393538023501*^9, 3.578393554858719*^9}, { 3.578393788706502*^9, 3.578393802996372*^9}, {3.578393850070485*^9, 3.578393870360643*^9}, 3.57839410075483*^9, 3.578394183402639*^9, { 3.5783945426543016`*^9, 3.578394563149001*^9}, {3.578394863016803*^9, 3.578394868802392*^9}, {3.578404191177808*^9, 3.5784042643595057`*^9}, { 3.578406747684526*^9, 3.5784067897984056`*^9}, 3.5784085102169733`*^9, 3.5784085497497797`*^9, {3.5784086356588993`*^9, 3.5784086580407143`*^9}, 3.578408715485318*^9, {3.5784095038710546`*^9, 3.578409535598261*^9}}], Cell[BoxData[ TagBox[GridBox[{ { TagBox[GridBox[{ { ButtonBox["\<\"Go\"\>", Appearance->Automatic, ButtonFunction:>($CellContext`go = True; While[$CellContext`go, $CellContext`psi2 = $CellContext`Lh2[ Dot[$CellContext`h1, $CellContext`psi2]]; Pause[$CellContext`pause]; If[Abs[ First[$CellContext`psi2]] > Rational[1, 100], Break[]]; AddTo[$CellContext`n, 1]]), Evaluator->Automatic, Method->"Queued"], ButtonBox["\<\"Stop\"\>", Appearance->Automatic, ButtonFunction:>($CellContext`go = False), Evaluator->Automatic, Method->"Preemptive"], ButtonBox["\<\"Reset\"\>", Appearance->Automatic, ButtonFunction:>($CellContext`psi2 = $CellContext`psi0; \ $CellContext`n = 0; $CellContext`go = False; Null), Evaluator->Automatic, Method->"Preemptive"], ButtonBox["\<\"Update\"\>", Appearance->Automatic, ButtonFunction:>({$CellContext`h1, $CellContext`Lh2, \ $CellContext`xx, $CellContext`psi0, $CellContext`vv} = \ $CellContext`prepareSolver[$CellContext`V, $CellContext`\[Psi]0, \ $CellContext`xsolveDomain, $CellContext`\[Delta]x, $CellContext`\[Delta]t]; \ $CellContext`psi2 = $CellContext`psi0; $CellContext`go = False; $CellContext`n = 0; Null), Evaluator->Automatic, Method->"Preemptive"]} }, AutoDelete->False, GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}], "Grid"]}, { DynamicBox[ToBoxes[ If[ ListQ[$CellContext`psi2], ListPlot[{ $CellContext`joinCoordinates[$CellContext`xx, $CellContext`vv], $CellContext`joinCoordinates[$CellContext`xx, Re[$CellContext`psi2]], $CellContext`joinCoordinates[$CellContext`xx, Im[$CellContext`psi2]], $CellContext`joinCoordinates[$CellContext`xx, Abs[$CellContext`psi2]]}, Joined -> True, PlotStyle -> {{Thick, Gray}, { Thickness[0.001], Cyan}, { Thickness[0.001], Pink}, { Thickness[0.002], White}}, Background -> Black, Axes -> False, PlotRange -> {{ Part[$CellContext`xvisDomain, 1], Part[$CellContext`xvisDomain, 2]}, {-1, 2}}, AspectRatio -> 3/4, ImageSize -> 800], Graphics[]], StandardForm], ImageSizeCache->{800., {298., 302.}}, UpdateInterval:>0.02]} }, AutoDelete->False, GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}], "Grid"]], "Output", CellChangeTimes->{ 3.5783938038359423`*^9, 3.578394103904574*^9, 3.578394188829091*^9, 3.5783945638062057`*^9, 3.578394869635913*^9, {3.5784042186393633`*^9, 3.57840426869484*^9}, 3.578404323728733*^9, 3.578406779803421*^9, 3.578408482817462*^9, 3.578408514928235*^9, 3.578408551389777*^9, { 3.578408637214569*^9, 3.578408658574648*^9}, 3.578408716436599*^9, { 3.578409529626381*^9, 3.5784095363116407`*^9}, 3.578856501005084*^9}] }, Open ]] }, Open ]] }, Open ]] }, WindowSize->{1280, 694}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, PrivateNotebookOptions->{"VersionedStylesheet"->{"Default.nb"[8.] -> False}}, ShowSelection->True, FrontEndVersion->"9.0 for Mac OS X x86 (32-bit, 64-bit Kernel) (January 25, \ 2013)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[579, 22, 304, 6, 125, "Title"], Cell[886, 30, 855, 15, 125, "Text"], Cell[CellGroupData[{ Cell[1766, 49, 176, 2, 80, "Section"], Cell[1945, 53, 111, 1, 30, "Text"], Cell[2059, 56, 620, 15, 28, "Input"], Cell[2682, 73, 124, 1, 30, "Text"], Cell[2809, 76, 520, 14, 28, "Input"], Cell[3332, 92, 422, 12, 28, "Input"], Cell[CellGroupData[{ Cell[3779, 108, 1567, 26, 28, "Input"], Cell[5349, 136, 647, 11, 70, "Output"] }, Open ]], Cell[6011, 150, 250, 3, 30, "Text"], Cell[6264, 155, 1347, 21, 28, "Input"], Cell[7614, 178, 1000, 15, 28, "Input"], Cell[8617, 195, 178, 4, 28, "Input"], Cell[8798, 201, 200, 4, 28, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[9035, 210, 152, 2, 50, "Section"], Cell[9190, 214, 1631, 45, 28, "Input"], Cell[10824, 261, 354, 9, 28, "Input"], Cell[11181, 272, 352, 10, 28, "Input"], Cell[11536, 284, 5248, 142, 301, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[16821, 431, 106, 1, 50, "Section"], Cell[16930, 434, 902, 24, 53, "Text"], Cell[17835, 460, 149, 3, 28, "Input"], Cell[17987, 465, 444, 8, 28, "Input"], Cell[18434, 475, 342, 8, 28, "Input"], Cell[18779, 485, 293, 8, 28, "Input"], Cell[19075, 495, 439, 12, 28, "Input"], Cell[19517, 509, 156, 3, 28, "Input"], Cell[CellGroupData[{ Cell[19698, 516, 2728, 72, 63, "Input"], Cell[22429, 590, 4382, 83, 420, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[26860, 679, 105, 1, 80, "Section"], Cell[26968, 682, 352, 7, 30, "Text"], Cell[27323, 691, 1191, 31, 45, "Input"], Cell[CellGroupData[{ Cell[28539, 726, 2480, 63, 63, "Input"], Cell[31022, 791, 3428, 72, 420, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[34499, 869, 147, 2, 80, "Section"], Cell[CellGroupData[{ Cell[34671, 875, 6178, 139, 182, "Input"], Cell[40852, 1016, 3186, 76, 651, "Output"] }, Open ]] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *)