(* 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[ 97954, 3021] NotebookOptionsPosition[ 89027, 2757] NotebookOutlinePosition[ 89963, 2793] CellTagsIndexPosition[ 89865, 2787] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell[TextData[{ "Introduction to ", StyleBox["Mathematica \[MathematicaIcon]", FontSlant->"Italic"] }], "Title"], Cell["3. Differential Equations", "Subtitle"], Cell["\<\ P. S. Cally, School of Mathematical Sciences, Monash University\ \>", "Author"], Cell["\<\ Our main tools for solving differential equations are DSolve and NDSolve. \ They are both very extensive and powerful programs, but neither can do \ everything. Nevertheless, they can do a lot \[Ellipsis]\ \>", "Text"], Cell[CellGroupData[{ Cell["Exact Solutions of ODEs", "Section"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " can find general solutions to many ODEs \[LongDash] most of those for \ which exact solutions are known" }], "Text", CellChangeTimes->{{3.401329410072427*^9, 3.40132941728229*^9}}], Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "+", RowBox[{"x", " ", RowBox[{ RowBox[{"y", "'"}], "[", "x", "]"}]}], "+", RowBox[{"y", "[", "x", "]"}]}], "\[Equal]", RowBox[{"Sin", "[", "x", "]"}]}], ",", RowBox[{"y", "[", "x", "]"}], ",", "x"}], "]"}]], "Input"], Cell["We can also specify boundary conditions", "Text"], Cell[BoxData[ RowBox[{"sol", "=", RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "+", RowBox[{"x", " ", RowBox[{ RowBox[{"y", "'"}], "[", "x", "]"}]}], "+", RowBox[{"y", "[", "x", "]"}]}], "\[Equal]", RowBox[{"Sin", "[", "x", "]"}]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"y", "[", "1", "]"}], "\[Equal]", "0"}]}], "}"}], ",", "y", ",", "x"}], "]"}]}]], "Input", CellChangeTimes->{{3.401329460455907*^9, 3.4013294737560863`*^9}}], Cell[TextData[{ StyleBox["Note: we have requested y and not y[x] as the solution.", FontWeight->"Bold"], " It is usually much more convenient to get back the pure function. Why?\n\ Check the solution:" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "+", RowBox[{"x", " ", RowBox[{ RowBox[{"y", "'"}], "[", "x", "]"}]}], "+", RowBox[{"y", "[", "x", "]"}]}], "/.", "sol"}], "//", "FullSimplify"}]], "Input", CellChangeTimes->{{3.4013294945654697`*^9, 3.401329501576779*^9}}], Cell["Correct! The boundary condition?", "Text", CellChangeTimes->{{3.401226928427938*^9, 3.401226930739009*^9}, { 3.401329512841917*^9, 3.401329520247531*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"y", "[", "0", "]"}], ",", RowBox[{"y", "[", "1", "]"}]}], "}"}], "/.", "sol"}]], "Input"], Cell["Again correct. Now Plot", "Text", CellChangeTimes->{{3.401226938212598*^9, 3.401226945465835*^9}}], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4013295612434483`*^9, 3.401329563528976*^9}, { 3.401329732684002*^9, 3.401329734032778*^9}}], Cell["\<\ The use of Evaluate here is not necessary. However, it does speed up the \ process by more than a factor of 2.\ \>", "Text", CellChangeTimes->{{3.401329747060026*^9, 3.4013297961276197`*^9}}], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{ RowBox[{"Plot", "[", RowBox[{ RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}]}], "]"}], ";"}], "]"}]], "Input", CellChangeTimes->{{3.401329799774979*^9, 3.40132983955339*^9}}], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}]}], "]"}], ";"}], "]"}]], "Input", CellChangeTimes->{{3.401329799774979*^9, 3.401329813793014*^9}}], Cell[BoxData[ RowBox[{"Clear", "[", "sol", "]"}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Numerical Solution of ODEs: IVPs", "Section"], Cell[TextData[{ "Not surprisingly, ", StyleBox["Mathematica", FontSlant->"Italic"], " cannot find an exact solution to this horrible nonlinear equation. (Give \ it a while to try.)" }], "Text", CellChangeTimes->{{3.401329907425015*^9, 3.401329919671575*^9}}], Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "+", RowBox[{"y", "[", "x", "]"}]}], "\[Equal]", RowBox[{"x", " ", RowBox[{"y", "[", "x", "]"}], " ", RowBox[{"Exp", "[", RowBox[{"-", SuperscriptBox[ RowBox[{"y", "[", "x", "]"}], "2"]}], "]"}]}]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "1"}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], ",", "y", ",", "x"}], "]"}]], "Input"], Cell["\<\ But numerical solution is easy! It returns an answer in the form of an \ interpolating function object, which may be evaluated wherever we wish (in \ its domain). Timing[\[Ellipsis]] is wrapped around the call to NDSolve in \ this case to show just how quickly the numerical integration can be done.\ \>", "Text"], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{ RowBox[{"sol", "=", RowBox[{"Flatten", "[", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "+", RowBox[{"y", "[", "x", "]"}]}], "\[Equal]", RowBox[{"x", " ", RowBox[{"y", "[", "x", "]"}], " ", RowBox[{"Exp", "[", RowBox[{"-", SuperscriptBox[ RowBox[{"y", "[", "x", "]"}], "2"]}], "]"}]}]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "1"}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "20"}], "}"}]}], "]"}], "]"}]}], ";"}], "]"}]], "Input"], Cell[TextData[{ "The Flatten is not crucial; try it without to see what happens. Here we see \ how to evaluate ", StyleBox["y", FontSlant->"Italic"], " (or its derivatives) at a particular value of ", StyleBox["x", FontSlant->"Italic"], " in the domain." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"y", "[", "5", "]"}], ",", RowBox[{ RowBox[{"y", "'"}], "[", "5", "]"}]}], "}"}], "/.", "sol"}]], "Input"], Cell["And this is how we can plot the solution. ", "Text"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "20"}], "}"}]}], "]"}]], "Input"], Cell[TextData[{ "You can plot ", StyleBox["y'", FontSlant->"Italic"], " just as easily." }], "Text"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{ SuperscriptBox["y", "\[Prime]", MultilineFunction->None], "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "20"}], "}"}]}], "]"}]], "Input"], Cell["\<\ Various (unnecessary) stylistic options are included here, just to show you \ what can be done.\ \>", "Text"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "20"}], "}"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"TraditionalForm", "/@", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}]}]}], ",", RowBox[{"BaseStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"FontFamily", "\[Rule]", "\"\\""}], ",", RowBox[{"FontSlant", "\[Rule]", "\"\\""}], ",", RowBox[{"FontSize", "\[Rule]", "14"}], ",", RowBox[{"FontWeight", "\[Rule]", "\"\\""}]}], "}"}]}], ",", RowBox[{"ImageSize", "\[Rule]", "400"}], ",", RowBox[{"AxesStyle", "\[Rule]", RowBox[{"{", RowBox[{"Blue", ",", RowBox[{"RGBColor", "[", RowBox[{"1", ",", "0", ",", ".4"}], "]"}]}], "}"}]}], ",", RowBox[{"Background", "\[Rule]", RowBox[{"RGBColor", "[", RowBox[{"0.9`", ",", "0.9`", ",", "0"}], "]"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"RGBColor", "[", RowBox[{"0", ",", "0.5`", ",", "0"}], "]"}], ",", RowBox[{"Dashing", "[", RowBox[{"{", RowBox[{"0.06`", ",", "0.02`", ",", "0.005`", ",", "0.02`"}], "}"}], "]"}], ",", RowBox[{"Thickness", "[", "0.007`", "]"}]}], "}"}], "}"}]}], ",", RowBox[{ "PlotLabel", "\[Rule]", "\"\<\[MathematicaIcon] Silly Graph in Mathematica \ \[MathematicaIcon]\>\""}]}], "]"}]], "Input", CellChangeTimes->{{3.401227057475902*^9, 3.401227069334731*^9}}], Cell["\<\ NDSolve has a vast number of options, allowing us to choose many different \ numerical methods and accuracies. See the help utility for details.\ \>", "Text"], Cell[BoxData[ RowBox[{"Clear", "[", "sol", "]"}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Numerical Solution of PDEs: Linear and Nonlinear BVPs", "Section"], Cell[TextData[{ "For linear Boundary Value Problems, ", StyleBox["Mathematica", FontSlant->"Italic"], " uses the Gel'fand\[Hyphen]Lokutsiyevskii chasing method." }], "Text"], Cell[BoxData[ RowBox[{"bvpsol", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "+", RowBox[{"25", RowBox[{"Cos", "[", "x", "]"}], RowBox[{"y", "[", "x", "]"}]}]}], "\[Equal]", "1"}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "1", "]"}], "\[Equal]", "0"}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", "bvpsol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}]], "Input"], Cell[TextData[{ StyleBox["As of V6, Mathematica", FontSlant->"Italic"], " has a built-in method to automatically solve nonlinear BVPs." }], "Text", CellChangeTimes->{{3.401227176360215*^9, 3.401227192290098*^9}}], Cell[BoxData[ RowBox[{"nlbvpsol", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "\[Equal]", SuperscriptBox[ RowBox[{"y", "[", "x", "]"}], "2"]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"y", "[", "1", "]"}], "\[Equal]", "2"}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.401227158188364*^9, 3.40122716291593*^9}, { 3.401227203020617*^9, 3.4012274292278147`*^9}, {3.401227467526832*^9, 3.401227512051807*^9}}], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "nlbvpsol"}], "\[InvisibleSpace]", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}]], "Input", CellChangeTimes->{{3.401227152877584*^9, 3.401227171627428*^9}, { 3.4012274369420567`*^9, 3.40122743744345*^9}, {3.401227517318016*^9, 3.4012275175710917`*^9}}], Cell["\<\ However, is the solution unique? To determine this, we can write our own \ shooting method (or relaxation method if you prefer). Here is a typical setup \ for shooting.\ \>", "Text", CellChangeTimes->{{3.401227528629487*^9, 3.4012275309381113`*^9}, { 3.4013300168519363`*^9, 3.40133005117605*^9}}], Cell[TextData[{ "We know that one boundary value at x=0 is y=0, so of course we adopt that. \ But we don't know what y'(0) should be. This utility ", StyleBox["score", FontWeight->"Bold"], " takes a guess at this, y'(0)=dy, and returns a measure of how well we have \ done in hitting our other BC at x=1." }], "Text", CellChangeTimes->{{3.4013300711520767`*^9, 3.401330074177209*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"score", "[", RowBox[{"dy_", "?", "NumberQ"}], "]"}], ":=", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"y", "[", "1", "]"}], "-", "2"}], ")"}], "/.", RowBox[{"Flatten", "[", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "\[Equal]", SuperscriptBox[ RowBox[{"y", "[", "x", "]"}], "2"]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], "\[Equal]", "dy"}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}]}], "]"}], "]"}]}]}]], "Input"], Cell[TextData[{ "The _?NumberQ is a cunning device to stop ", StyleBox["Mathematica", FontSlant->"Italic"], " tryng to evaluate score for general variable dy. Plot score against dy to \ see where is has a zero (or zeros)." }], "Text", CellChangeTimes->{{3.401330095584194*^9, 3.401330145224118*^9}}], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"score", "[", "dy", "]"}], ",", RowBox[{"{", RowBox[{"dy", ",", RowBox[{"-", "70"}], ",", "20"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.40133016364144*^9, 3.401330211036224*^9}}], Cell["\<\ Clearly, dy\[TildeTilde]2 and -39 are what we want. Since the equation is \ nonlinear, it is not surprising that there is more than one solution. Home in \ on them with FindRoot.\ \>", "Text"], Cell[BoxData[ RowBox[{"dy1", "=", RowBox[{"dy", "/.", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{ RowBox[{"score", "[", "dy", "]"}], "\[Equal]", "0"}], ",", RowBox[{"{", RowBox[{"dy", ",", RowBox[{"-", "39"}]}], "}"}]}], "]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{"dy2", "=", RowBox[{"dy", "/.", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{ RowBox[{"score", "[", "dy", "]"}], "\[Equal]", "0"}], ",", RowBox[{"{", RowBox[{"dy", ",", "2"}], "}"}]}], "]"}]}]}]], "Input"], Cell["\<\ Check to make sure that score vanishes (to high accuracy) at these values.\ \>", "Text"], Cell[BoxData[ RowBox[{"score", "/@", RowBox[{"{", RowBox[{"dy1", ",", "dy2"}], "}"}]}]], "Input"], Cell["Now shoot one more time, with the \"correct\" y'(0).", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"sol1", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "\[Equal]", SuperscriptBox[ RowBox[{"y", "[", "x", "]"}], "2"]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], "\[Equal]", "dy1"}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"sol2", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "\[Equal]", SuperscriptBox[ RowBox[{"y", "[", "x", "]"}], "2"]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], "\[Equal]", "dy2"}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell[TextData[{ "Plot the resulting solutions, together with the one that ", StyleBox["Mathematica", FontSlant->"Italic"], " automatically found (dashed)." }], "Text", CellChangeTimes->{{3.401227878282281*^9, 3.4012279083143044`*^9}}], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", RowBox[{"{", RowBox[{"sol1", ",", "sol2", ",", "nlbvpsol"}], "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "}"}], ",", RowBox[{"{", "Red", "}"}], ",", RowBox[{"{", RowBox[{"Black", ",", RowBox[{"Dashing", "[", RowBox[{"{", RowBox[{"0.03", ",", "0.03"}], "}"}], "]"}]}], "}"}]}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.40122762465518*^9, 3.401227652485972*^9}, { 3.401330318694035*^9, 3.401330324643155*^9}, {3.401330383094451*^9, 3.401330478778027*^9}}], Cell[TextData[{ "We see that ", StyleBox["Mathematica", FontSlant->"Italic"], " homed in on just one of them. So beware, you might actually need the \ other!" }], "Text", CellChangeTimes->{{3.4012278260485287`*^9, 3.4012278622981977`*^9}}], Cell["\<\ There are other methods, but shooting is usually quick and accurate.\ \>", "Text"], Cell[BoxData[ RowBox[{"Clear", "[", RowBox[{ "bvpsol", ",", "score", ",", "dy1", ",", "dy2", ",", "sol1", ",", "sol2", ",", "nlbvpsol"}], "]"}]], "Input", CellChangeTimes->{{3.401227662957246*^9, 3.4012276663544827`*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Exact Solution of PDEs", "Section"], Cell["\<\ Exact solutions of PDEs are not so common! However, first order PDEs can \ often be solved, primarily because they can be reduced to ODEs. Here are a \ few:\ \>", "Text"], Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", "x"], RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}]}], "+", RowBox[{"x", RowBox[{ SubscriptBox["\[PartialD]", "y"], RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}]}]}]}], "\[Equal]", RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}]}], ",", "u", ",", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", RowBox[{ SubscriptBox["\[PartialD]", "x"], RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}]}]}], "+", RowBox[{"x", RowBox[{ SubscriptBox["\[PartialD]", "y"], RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}]}]}]}], "\[Equal]", RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}]}], ",", "u", ",", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", RowBox[{ SubscriptBox["\[PartialD]", "x"], RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}]}]}], "+", RowBox[{"x", RowBox[{ SubscriptBox["\[PartialD]", "y"], RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}]}]}]}], "\[Equal]", SuperscriptBox[ RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}], "2"]}], ",", "u", ",", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}]}], "]"}]], "Input"], Cell[TextData[{ "Here, C[1] represents an ", StyleBox["arbitrary function", FontWeight->"Bold"], ". \nNow to higher order equations. Even the 2D Laplace equation has an \ exact solution (derivable by the method of characteristics, or a cunningly \ chosen change of variables)." }], "Text"], Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"x", ",", "x"}]], RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}]}], "+", RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"y", ",", "y"}]], RowBox[{"u", "[", RowBox[{"x", ",", "y"}], "]"}]}]}], "\[Equal]", "0"}], ",", "u", ",", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}]}], "]"}]], "Input"], Cell["\<\ Unfortunately, not very useful when boundary conditions are imposed. The wave equation\ \>", "Text"], Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"t", ",", "t"}]], RowBox[{"u", "[", RowBox[{"x", ",", "t"}], "]"}]}], "==", RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"x", ",", "x"}]], RowBox[{"u", "[", RowBox[{"x", ",", "t"}], "]"}]}]}], ",", "u", ",", RowBox[{"{", RowBox[{"x", ",", "t"}], "}"}]}], "]"}]], "Input"], Cell["\<\ This is the well-known D'Alembert solution. The diffusion equation\ \>", "Text"], Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", "t"], RowBox[{"u", "[", RowBox[{"x", ",", "t"}], "]"}]}], "==", RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"x", ",", "x"}]], RowBox[{"u", "[", RowBox[{"x", ",", "t"}], "]"}]}]}], "}"}], ",", "u", ",", RowBox[{"{", RowBox[{"x", ",", "t"}], "}"}]}], "]"}]], "Input"], Cell["Sorry, can't do it!", "Text"], Cell["\<\ Don't expect to find exact solutions of too many second or higher order PDEs! \ And even when you can, they may not be what you want.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Numerical Solution of PDEs", "Section"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], "'s numerical PDE scheme is the method of lines. It is therefore unsuitable \ for elliptic equations. It does a good job for wave and diffusion equations \ though." }], "Text"], Cell["\<\ Here is a straightforward application with Mathematica's default settings \ (4th order finite differences in x). It complains about accuracy/precision, \ but returns a solution.\ \>", "Text"], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{"sol4", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"t", ",", "t"}]], RowBox[{"u", "[", RowBox[{"x", ",", "t"}], "]"}]}], "==", RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"x", ",", "x"}]], RowBox[{"u", "[", RowBox[{"x", ",", "t"}], "]"}]}]}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"0", ",", "t"}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"1", ",", "t"}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"x", ",", "0"}], "]"}], "\[Equal]", RowBox[{ SuperscriptBox["x", "2"], RowBox[{"(", RowBox[{"1", "-", "x"}], ")"}]}]}], ",", RowBox[{ RowBox[{ RowBox[{ RowBox[{"Derivative", "[", RowBox[{"0", ",", "1"}], "]"}], "[", "u", "]"}], "[", RowBox[{"x", ",", "0"}], "]"}], "\[Equal]", "0"}]}], "}"}], ",", "u", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "5"}], "}"}]}], "]"}]}], "]"}]], "Input", CellChangeTimes->{{3.401330532693598*^9, 3.401330541179328*^9}}], Cell["\<\ We have wrapped it in Timing[] to see how long it takes. You may be content \ with a lower number of digits of accuracy requirement (say 3).\ \>", "Text", CellChangeTimes->{{3.401228872187572*^9, 3.401228887441978*^9}, { 3.401330551586136*^9, 3.401330578752488*^9}, {3.401330834508278*^9, 3.401330838576123*^9}, {3.401331202595902*^9, 3.401331265719529*^9}}], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{"sol4", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"t", ",", "t"}]], RowBox[{"u", "[", RowBox[{"x", ",", "t"}], "]"}]}], "==", RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"x", ",", "x"}]], RowBox[{"u", "[", RowBox[{"x", ",", "t"}], "]"}]}]}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"0", ",", "t"}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"1", ",", "t"}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"x", ",", "0"}], "]"}], "\[Equal]", RowBox[{ SuperscriptBox["x", "2"], RowBox[{"(", RowBox[{"1", "-", "x"}], ")"}]}]}], ",", RowBox[{ RowBox[{ RowBox[{ RowBox[{"Derivative", "[", RowBox[{"0", ",", "1"}], "]"}], "[", "u", "]"}], "[", RowBox[{"x", ",", "0"}], "]"}], "\[Equal]", "0"}]}], "}"}], ",", "u", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "5"}], "}"}], ",", RowBox[{"AccuracyGoal", "\[Rule]", "3"}]}], "]"}]}], "]"}]], "Input", CellChangeTimes->{{3.4012283003686647`*^9, 3.401228312365593*^9}, { 3.401228401096827*^9, 3.401228401389694*^9}, {3.401228558272897*^9, 3.40122857224562*^9}, {3.4012286544688787`*^9, 3.4012287226538563`*^9}, { 3.401228804289549*^9, 3.4012288577177343`*^9}, {3.4013305848527737`*^9, 3.401330637764163*^9}, {3.401330801568028*^9, 3.401330829772664*^9}, { 3.401330957976767*^9, 3.401330978044116*^9}, {3.401331061405415*^9, 3.4013310965493107`*^9}, {3.4013311281654053`*^9, 3.401331185044636*^9}}], Cell["Now let's set up a plotting procedure.", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"plt", "[", RowBox[{"t_", ",", "soln_", ",", "opts___"}], "]"}], ":=", RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"u", "[", RowBox[{"x", ",", "t"}], "]"}], "/.", "soln"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}], ",", "opts", ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"-", ".16"}], ",", ".16"}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"FrameLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"PlotLabel", "\[Rule]", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", "t", "]"}]}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.401225201960601*^9, 3.401225205812437*^9}, { 3.401228163622143*^9, 3.40122818251676*^9}}], Cell["Here is the solution at t=5.", "Text"], Cell[BoxData[ RowBox[{"plt", "[", RowBox[{"5", ",", "sol4"}], "]"}]], "Input", CellChangeTimes->{3.401224839334118*^9}], Cell["Now let's animate it.", "Text", CellChangeTimes->{{3.401228146889649*^9, 3.4012281534739237`*^9}}], Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"plt", "[", RowBox[{"t", ",", "sol4"}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "5"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4012280315185213`*^9, 3.401228065962983*^9}}], Cell[TextData[{ "Now let's do a 2D example, vibration of a driven square drum. In this \ example I set ", StyleBox["periodic", FontWeight->"Bold"], " boundary conditions on all four sides (can you see that?). Again, we use \ the default ", StyleBox["Mathematica", FontSlant->"Italic"], " settings, and check how long the integration takes (this is slow... go \ have a coffee)." }], "Text", CellChangeTimes->{{3.401331423729842*^9, 3.40133144276001*^9}}], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{"solwv", "=", RowBox[{"First", "[", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"t", ",", "t"}]], RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}]}], "==", RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"x", ",", "x"}]], RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}]}], "+", RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"y", ",", "y"}]], RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}]}], "-", RowBox[{"Sin", "[", RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}], "]"}]}]}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"0", ",", "x", ",", "y"}], "]"}], "==", SuperscriptBox["\[ExponentialE]", RowBox[{"-", RowBox[{"(", RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}], ")"}]}]]}], ",", RowBox[{ RowBox[{ SuperscriptBox["u", TagBox[ RowBox[{"(", RowBox[{"1", ",", "0", ",", "0"}], ")"}], Derivative], MultilineFunction->None], "[", RowBox[{"0", ",", "x", ",", "y"}], "]"}], "==", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", RowBox[{"-", "5"}], ",", "y"}], "]"}], "==", RowBox[{"u", "[", RowBox[{"t", ",", "5", ",", "y"}], "]"}]}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", RowBox[{"-", "5"}]}], "]"}], "==", RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "5"}], "]"}]}]}], "}"}], ",", "u", ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "15"}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "5"}], ",", "5"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "5"}], ",", "5"}], "}"}]}], "]"}], "]"}]}], "]"}]], "Input", CellTags->"NDSolve"], Cell["\<\ Pretty slow. Try again with pseudospectral (i.e., Fourier in this case) \ derivatives (which are ideally suited to periodic BCs),\ \>", "Text", CellChangeTimes->{{3.4013340877965612`*^9, 3.401334096328342*^9}}], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{"solwv", "=", RowBox[{"First", "[", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"t", ",", "t"}]], RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}]}], "\[Equal]", RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"x", ",", "x"}]], RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}]}], "+", RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"y", ",", "y"}]], RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}]}], "-", RowBox[{"Sin", "[", RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}], "]"}]}]}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"0", ",", "x", ",", "y"}], "]"}], "\[Equal]", SuperscriptBox["\[ExponentialE]", RowBox[{"-", RowBox[{"(", RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}], ")"}]}]]}], ",", RowBox[{ RowBox[{ SuperscriptBox["u", TagBox[ RowBox[{"(", RowBox[{"1", ",", "0", ",", "0"}], ")"}], Derivative], MultilineFunction->None], "[", RowBox[{"0", ",", "x", ",", "y"}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", RowBox[{"-", "5"}], ",", "y"}], "]"}], "\[Equal]", RowBox[{"u", "[", RowBox[{"t", ",", "5", ",", "y"}], "]"}]}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", RowBox[{"-", "5"}]}], "]"}], "\[Equal]", RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "5"}], "]"}]}]}], "}"}], ",", "u", ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "15"}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "5"}], ",", "5"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "5"}], ",", "5"}], "}"}], ",", RowBox[{"Method", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", " ", RowBox[{"\"\\"", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"(*", " ", RowBox[{ "Specify", " ", "use", " ", "of", " ", "a", " ", "tensor", " ", "product", " ", RowBox[{"grid", "."}]}], " ", "*)"}], " ", RowBox[{ "DifferenceOrder", "\[Rule]", "\"\\""}]}], " ", RowBox[{"(*", " ", RowBox[{ "Specify", " ", "use", " ", "of", " ", "pseudospectral", " ", "approximations", " ", "for", " ", "x", " ", "and", " ", RowBox[{"y", "."}]}], "*)"}], "}"}]}]}], "}"}]}]}], "]"}], "]"}]}], "]"}]], "Input", CellTags->"NDSolve"], Cell["\<\ Wow, what an improvement! The superior spatial smoothness must have allowed \ the temporal integration to use far fewer points. Get set to plot the \ solution.\ \>", "Text"], Cell[BoxData[ RowBox[{"Clear", "[", "pwv", "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"pwv", "[", RowBox[{"t_", ",", "opts___"}], "]"}], ":=", RowBox[{"Plot3D", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}], "/.", "solwv"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "5"}], ",", "5"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "5"}], ",", "5"}], "}"}], ",", "opts", ",", RowBox[{"PlotLabel", "\[Rule]", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", "t", "]"}]}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"-", ".5"}], ",", "1"}], "}"}]}], ",", RowBox[{"Mesh", "\[Rule]", "True"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.401331584375717*^9, 3.40133158778673*^9}}, CellTags->"NDSolve"], Cell["\<\ Make a movie, and collapse the frames again. Then play by double-clicking.\ \>", "Text"], Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"pwv", "[", RowBox[{"t", ",", RowBox[{"ColorFunctionScaling", "\[Rule]", "False"}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "15"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.401229050359742*^9, 3.401229078404064*^9}}], Cell["\<\ Isn't that pretty! Try pausing the animation and grabing the plot to rotate \ it. Then start the animation again. Here is the last frame drawn without a mesh (if you prefer):\ \>", "Text", CellChangeTimes->{{3.401229125470593*^9, 3.401229164003006*^9}}], Cell[BoxData[ RowBox[{"pwv", "[", RowBox[{"15", ",", RowBox[{"Mesh", "\[Rule]", "False"}], ",", RowBox[{"ColorFunctionScaling", "\[Rule]", "False"}]}], "]"}]], "Input", CellChangeTimes->{3.401229038966157*^9}], Cell[TextData[{ "Let' s redo this with ", StyleBox["rigid boundary conditions", FontWeight->"Bold"], " (and appropriately modified ICs). " }], "Text"], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{"sol0", "=", RowBox[{"First", "[", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"t", ",", "t"}]], RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}]}], "\[Equal]", RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"x", ",", "x"}]], RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}]}], "+", RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"y", ",", "y"}]], RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}]}], "-", RowBox[{"Sin", "[", RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}], "]"}]}]}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"0", ",", "x", ",", "y"}], "]"}], "\[Equal]", RowBox[{ RowBox[{"Cos", "[", RowBox[{ FractionBox["\[Pi]", "10"], "x"}], "]"}], RowBox[{"Cos", "[", RowBox[{ FractionBox["\[Pi]", "10"], "y"}], "]"}], SuperscriptBox["\[ExponentialE]", RowBox[{"-", RowBox[{"(", RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}], ")"}]}]]}]}], ",", RowBox[{ RowBox[{ SuperscriptBox["u", TagBox[ RowBox[{"(", RowBox[{"1", ",", "0", ",", "0"}], ")"}], Derivative], MultilineFunction->None], "[", RowBox[{"0", ",", "x", ",", "y"}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", RowBox[{"-", "5"}], ",", "y"}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", "5", ",", "y"}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", RowBox[{"-", "5"}]}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "5"}], "]"}], "\[Equal]", "0"}]}], "}"}], ",", "u", ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "15"}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "5"}], ",", "5"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "5"}], ",", "5"}], "}"}], ",", RowBox[{"AccuracyGoal", "\[Rule]", "3"}]}], "]"}], "]"}]}], "]"}]], "Input", CellChangeTimes->{{3.401332294240765*^9, 3.401332296790021*^9}, { 3.4013324546453333`*^9, 3.401332468535512*^9}, {3.401332613229927*^9, 3.401332613727771*^9}}], Cell["Now plot.", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"pwvr", "[", RowBox[{"t_", ",", "sol_"}], "]"}], ":=", RowBox[{"Plot3D", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", "x", ",", "y"}], "]"}], "/.", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "5"}], ",", "5"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "5"}], ",", "5"}], "}"}], ",", RowBox[{"PlotLabel", "\[Rule]", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", "t", "]"}]}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"-", ".5"}], ",", "1"}], "}"}]}], ",", RowBox[{"Mesh", "\[Rule]", "False"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.401332668757906*^9, 3.401332672882691*^9}, { 3.401332736212036*^9, 3.4013327469395247`*^9}, {3.401332779825039*^9, 3.401332781757057*^9}, {3.401333537906765*^9, 3.4013335463683434`*^9}, { 3.401333592254342*^9, 3.401333592710301*^9}, {3.401334281247409*^9, 3.401334286137538*^9}}, CellTags->"NDSolve"], Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"pwvr", "[", RowBox[{"t", ",", "sol0"}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "15"}], "}"}], ",", RowBox[{"AnimationRunning", "\[Rule]", "False"}]}], "]"}]], "Input", CellChangeTimes->{{3.401229348249172*^9, 3.401229356291518*^9}, { 3.401332753393268*^9, 3.40133276304114*^9}, {3.4013334398816977`*^9, 3.4013335127664547`*^9}, {3.4013336047276697`*^9, 3.401333605310422*^9}, { 3.401333699736746*^9, 3.401333734503798*^9}, {3.401333788536419*^9, 3.401333796025082*^9}, {3.401334207675905*^9, 3.401334254718976*^9}, { 3.401334303289163*^9, 3.401334303970656*^9}}], Cell[BoxData[ RowBox[{"Clear", "[", RowBox[{ "plt", ",", "pwv", ",", "pwv0", ",", "xygrid", ",", "sol0", ",", "solwv", ",", "pdesol"}], "]"}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Exercises", "Section", FontColor->RGBColor[0, 0, 1]], Cell["\<\ Do not look at the solution until you have completed the exercise!\ \>", "Text", TextAlignment->Center, FontFamily->"Helvetica", FontSize->18, FontWeight->"Bold", FontColor->RGBColor[1, 0, 0]], Cell[CellGroupData[{ Cell["Airy Equation", "Subsection"], Cell["\<\ The Airy equation y''=x y pops up in many contexts, from asymptotic matching \ to the propagation of wavefronts. Solve it and plot both solutions over \ (-15,5). Do you understand how Ai may arise in modelling wavefronts?\ \>", "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell["DSolve[y''[x] - x y[x] == 0, y, x]", "Input", CellTags->"S3.5.11"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"AiryAi", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "15"}], ",", "5"}], "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"AiryBi", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "15"}], ",", "5"}], "}"}]}], "]"}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Bessel Equation", "Subsection"], Cell[TextData[{ "Find the exact solutions of Bessel's equation of order", Cell[BoxData[ RowBox[{ StyleBox[" ", FontSlant->"Plain"], RowBox[{ StyleBox["n", FontSlant->"Italic"], ",", StyleBox[" ", FontSlant->"Italic"], RowBox[{ RowBox[{ RowBox[{ SuperscriptBox["x", "2"], RowBox[{"y", "''"}]}], "+", RowBox[{"x", " ", RowBox[{"y", "'"}]}], "+", RowBox[{ RowBox[{"(", RowBox[{ SuperscriptBox["x", "2"], "-", SuperscriptBox["n", "2"]}], ")"}], "y"}]}], "=", "0"}]}]}]]], ". Plot each of the solutions for ", StyleBox["n", FontSlant->"Italic"], "=0,1,2,3,4,5 on ", " 0False]}], SeriesData[x, 0, {1, 0, Rational[-1, 4], 0, Rational[1, 64], 0, Rational[-1, 2304], 0, Rational[1, 147456]}, 0, 10, 1], Editable->False]]], " to get started. Why?" }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell["\<\ We need to step away from the singularity at x=0 in order to start our \ numerical integration.\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"ys", "[", "x_", "]"}], "=", RowBox[{"Normal", "[", RowBox[{"Series", "[", RowBox[{ RowBox[{"BesselJ", "[", RowBox[{"0", ",", "x"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "9"}], "}"}]}], "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.4012301088117323`*^9, 3.4012301647984743`*^9}}], Cell["(What does Normal[] do?)", "Text", CellChangeTimes->{{3.4012301700400743`*^9, 3.4012301879382057`*^9}}], Cell[BoxData[ RowBox[{"With", "[", RowBox[{ RowBox[{"{", RowBox[{"\[Epsilon]", "=", "0.0001"}], "}"}], ",", RowBox[{"bess", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"x", " ", RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}]}], "+", " ", RowBox[{ RowBox[{"y", "'"}], "[", "x", "]"}], "+", RowBox[{"x", " ", RowBox[{"y", "[", "x", "]"}]}]}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"y", "[", "\[Epsilon]", "]"}], "\[Equal]", RowBox[{"ys", "[", "\[Epsilon]", "]"}]}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "\[Epsilon]", "]"}], "\[Equal]", RowBox[{ RowBox[{"ys", "'"}], "[", "\[Epsilon]", "]"}]}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "\[Epsilon]", ",", "15"}], "}"}]}], "]"}]}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", "bess"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0.0001`", ",", "15"}], "}"}]}], "]"}]], "Input"], Cell["Try it without the \[Epsilon].", "Text"], Cell["Plot the error:", "Text", CellChangeTimes->{{3.4012302389847927`*^9, 3.4012302452343407`*^9}}], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "bess"}], ")"}], "-", RowBox[{"BesselJ", "[", RowBox[{"0", ",", "x"}], "]"}]}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0.0001", ",", "15"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.401230256233797*^9, 3.401230306596178*^9}}], Cell["Pretty good! Try asking for more precision and accuracy.", "Text", CellChangeTimes->{{3.401230323481862*^9, 3.4012303268823833`*^9}, { 3.40123039006866*^9, 3.401230403010232*^9}}], Cell[BoxData[ RowBox[{"With", "[", RowBox[{ RowBox[{"{", RowBox[{"\[Epsilon]", "=", "0.0001"}], "}"}], ",", RowBox[{"bess", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"x", " ", RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}]}], "+", " ", RowBox[{ RowBox[{"y", "'"}], "[", "x", "]"}], "+", RowBox[{"x", " ", RowBox[{"y", "[", "x", "]"}]}]}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"y", "[", "\[Epsilon]", "]"}], "\[Equal]", RowBox[{"ys", "[", "\[Epsilon]", "]"}]}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "\[Epsilon]", "]"}], "\[Equal]", RowBox[{ RowBox[{"ys", "'"}], "[", "\[Epsilon]", "]"}]}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "\[Epsilon]", ",", "15"}], "}"}], ",", RowBox[{"PrecisionGoal", "\[Rule]", "12"}], ",", RowBox[{"AccuracyGoal", "\[Rule]", "12"}]}], "]"}]}]}], "]"}]], "Input",\ CellChangeTimes->{{3.401230352295793*^9, 3.401230369945863*^9}, { 3.401230414238002*^9, 3.4012304182531967`*^9}}], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "bess"}], ")"}], "-", RowBox[{"BesselJ", "[", RowBox[{"0", ",", "x"}], "]"}]}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0.0001", ",", "15"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.401230256233797*^9, 3.401230306596178*^9}}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Linear BVP", "Subsection"], Cell[TextData[{ "Numerically solve ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "+", RowBox[{ SuperscriptBox["\[ExponentialE]", "x"], "y"}]}], "=", "0"}], TraditionalForm]]], ", with BCs y(0)=0, y(1)+y'(1)=1. Plot The solution." }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ RowBox[{"lbvp", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "+", " ", RowBox[{ RowBox[{"Exp", "[", "x", "]"}], RowBox[{"y", "[", "x", "]"}]}]}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{ RowBox[{"y", "[", "1", "]"}], "+", RowBox[{ RowBox[{"y", "'"}], "[", "1", "]"}]}], "\[Equal]", "1"}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "5"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", "lbvp"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "5"}], "}"}]}], "]"}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Nonlinear BVP", "Subsection"], Cell[TextData[{ "Numerically solve ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "+", RowBox[{ SuperscriptBox["\[ExponentialE]", "x"], "y"}]}], "=", RowBox[{"sin", " ", "y"}]}], TraditionalForm]]], ", with BCs y(0)=0, y(5)+y'(5)=1. Plot The solution." }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[TextData[{ "Use the ", StyleBox["Mathematica", FontSlant->"Italic"], " built-in:" }], "Text", CellChangeTimes->{{3.40133450406059*^9, 3.401334514360018*^9}}], Cell[BoxData[ RowBox[{"solauto", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "+", " ", RowBox[{ RowBox[{"Exp", "[", "x", "]"}], RowBox[{"y", "[", "x", "]"}]}]}], "\[Equal]", RowBox[{"Sin", "[", RowBox[{"y", "[", "x", "]"}], "]"}]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{ RowBox[{"y", "[", "5", "]"}], "+", RowBox[{ RowBox[{"y", "'"}], "[", "5", "]"}]}], "\[Equal]", "1"}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "5"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4012305368473177`*^9, 3.40123056671672*^9}, { 3.4012306169753923`*^9, 3.401230617260923*^9}}], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", "solauto"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "5"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.401230584491238*^9, 3.4012305859878283`*^9}}], Cell["\<\ Try our own shooting method to see if the solution is unique.\ \>", "Text", CellChangeTimes->{{3.401334525289444*^9, 3.401334544663991*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"score", "[", RowBox[{"dy_", "?", "NumberQ"}], "]"}], ":=", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"y", "[", "5", "]"}], "+", RowBox[{ RowBox[{"y", "'"}], "[", "5", "]"}], "-", "1"}], ")"}], "/.", RowBox[{"Flatten", "[", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "+", " ", RowBox[{ RowBox[{"Exp", "[", "x", "]"}], RowBox[{"y", "[", "x", "]"}]}]}], "\[Equal]", RowBox[{"Sin", "[", RowBox[{"y", "[", "x", "]"}], "]"}]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], "\[Equal]", "dy"}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "5"}], "}"}]}], "]"}], "]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"score", "[", "dy", "]"}], ",", RowBox[{"{", RowBox[{"dy", ",", RowBox[{"-", "1"}], ",", "1"}], "}"}]}], "]"}]], "Input"], Cell[TextData[{ "It looks like there's only one solution. It should therefore be the one ", StyleBox["Mathematica", FontSlant->"Italic"], " found automatically." }], "Text", CellChangeTimes->{{3.40123067477913*^9, 3.4012307086263227`*^9}}], Cell[BoxData[ RowBox[{"dy1", "=", RowBox[{"dy", "/.", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{ RowBox[{"score", "[", "dy", "]"}], "\[Equal]", "0"}], ",", RowBox[{"{", RowBox[{"dy", ",", RowBox[{"-", ".3"}]}], "}"}]}], "]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"sol1", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "x", "]"}], "+", " ", RowBox[{ RowBox[{"Exp", "[", "x", "]"}], RowBox[{"y", "[", "x", "]"}]}]}], "\[Equal]", RowBox[{"Sin", "[", RowBox[{"y", "[", "x", "]"}], "]"}]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], "\[Equal]", "dy1"}]}], "}"}], ",", "y", ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "5"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"y", "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol1"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "5"}], "}"}]}], "]"}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Annular Drum", "Subsection"], Cell[TextData[{ "An annular drumhead, 0.3{ 3.401232251962728*^9, {3.401233338944416*^9, 3.401233414603712*^9}, { 3.4013502280431433`*^9, 3.401350308018447*^9}, {3.4013505066791563`*^9, 3.401350519850176*^9}}], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{"solp", "=", RowBox[{"First", "[", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"t", ",", "t"}]], RowBox[{"u", "[", RowBox[{"t", ",", "r", ",", "\[Theta]"}], "]"}]}], "\[Equal]", RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"r", ",", "r"}]], RowBox[{"u", "[", RowBox[{"t", ",", "r", ",", "\[Theta]"}], "]"}]}], "+", RowBox[{ FractionBox["1", "r"], RowBox[{ SubscriptBox["\[PartialD]", "r"], RowBox[{"u", "[", RowBox[{"t", ",", "r", ",", "\[Theta]"}], "]"}]}]}], "+", " ", RowBox[{ FractionBox["1", SuperscriptBox["r", "2"]], RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"\[Theta]", ",", "\[Theta]"}]], RowBox[{"u", "[", RowBox[{"t", ",", "r", ",", "\[Theta]"}], "]"}]}]}]}]}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"0", ",", "r", ",", "\[Theta]"}], "]"}], "\[Equal]", RowBox[{"20", RowBox[{"(", RowBox[{"r", "-", ".3"}], ")"}], RowBox[{"(", RowBox[{"1", "-", "r"}], ")"}], RowBox[{"Exp", "[", RowBox[{"Sin", "[", "\[Theta]", "]"}], "]"}]}]}], ",", RowBox[{ RowBox[{ SuperscriptBox["u", TagBox[ RowBox[{"(", RowBox[{"1", ",", "0", ",", "0"}], ")"}], Derivative], MultilineFunction->None], "[", RowBox[{"0", ",", "r", ",", "\[Theta]"}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", ".3", ",", "\[Theta]"}], "]"}], "\[Equal]", RowBox[{"u", "[", RowBox[{"t", ",", "1", ",", "\[Theta]"}], "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", "r", ",", "0"}], "]"}], "\[Equal]", RowBox[{"u", "[", RowBox[{"t", ",", "r", ",", RowBox[{"2", "\[Pi]"}]}], "]"}]}]}], "}"}], ",", "u", ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "5"}], "}"}], ",", RowBox[{"{", RowBox[{"r", ",", ".3", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"\[Theta]", ",", "0", ",", RowBox[{"2", "\[Pi]"}]}], "}"}], ",", RowBox[{"AccuracyGoal", "\[Rule]", "2"}], ",", RowBox[{"PrecisionGoal", "\[Rule]", "2"}]}], "]"}], "]"}]}], "]"}]], "Input", CellChangeTimes->{{3.401334622210969*^9, 3.401334627670597*^9}, { 3.401334798377358*^9, 3.4013348078065557`*^9}, {3.401334861225312*^9, 3.401334861798663*^9}, {3.4013354412106133`*^9, 3.401335442166812*^9}, { 3.401350154721456*^9, 3.401350160110128*^9}, {3.401350314327125*^9, 3.4013503206221323`*^9}, {3.401350366577693*^9, 3.401350366958425*^9}, { 3.401350420111128*^9, 3.401350460646206*^9}, {3.4013855836030273`*^9, 3.401385598370511*^9}}], Cell["Plotting utility:", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"p", "[", RowBox[{"sol_", ",", "t_"}], "]"}], ":=", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"r", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}], ",", RowBox[{"r", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], ",", RowBox[{"u", "[", RowBox[{"t", ",", "r", ",", "\[Theta]"}], "]"}]}], "}"}], "/.", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"r", ",", ".3", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"\[Theta]", ",", "0", ",", RowBox[{"2", "\[Pi]"}]}], "}"}], ",", RowBox[{"PlotPoints", "\[Rule]", RowBox[{"{", RowBox[{"15", ",", "30"}], "}"}]}], ",", RowBox[{"PlotLabel", "\[Rule]", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", "t", "]"}]}]}], ",", RowBox[{"Mesh", "\[Rule]", "False"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1.1"}], ",", "1.1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1.1"}], ",", "1.1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "12"}], ",", "12"}], "}"}]}], "}"}]}], ",", RowBox[{"Boxed", "\[Rule]", "True"}], ",", RowBox[{"Axes", "\[Rule]", "True"}], ",", RowBox[{"BoxRatios", "\[Rule]", RowBox[{"{", RowBox[{"1", ",", "1", ",", ".4"}], "}"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.401231200321116*^9, 3.40123125498562*^9}, { 3.401231387946158*^9, 3.401231414344509*^9}, {3.401231529049749*^9, 3.401231594678874*^9}, {3.401231657431905*^9, 3.4012316623350058`*^9}, { 3.401231719857271*^9, 3.401231751143229*^9}, {3.401232151250808*^9, 3.401232152247052*^9}, {3.401233448228957*^9, 3.401233453903387*^9}, 3.401334705355857*^9, {3.401350402764306*^9, 3.401350403297372*^9}}, CellTags->"NDSolve"], Cell["Make the animation:", "Text", CellChangeTimes->{3.4013347596345663`*^9}], Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"p", "[", RowBox[{"solp", ",", "t"}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "5"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4012308274550543`*^9, 3.4012308568596067`*^9}, { 3.401233461310134*^9, 3.40123346233998*^9}}], Cell[BoxData[ RowBox[{"Clear", "[", RowBox[{"p", ",", "solp"}], "]"}]], "Input", CellChangeTimes->{{3.401350194394014*^9, 3.401350209047414*^9}}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Heat Equation on a Torus and some Cool Graphics", "Subsection", CellChangeTimes->{{3.40134912857026*^9, 3.40134913389543*^9}, { 3.401350046163813*^9, 3.401350051626514*^9}, {3.401385104914667*^9, 3.4013851247377043`*^9}, {3.40139174461757*^9, 3.401391750535131*^9}}], Cell["Consider a toroidal shell", "Text", CellChangeTimes->{{3.401382433412648*^9, 3.401382451025268*^9}, { 3.401382853596489*^9, 3.4013828837293653`*^9}, {3.401383195876813*^9, 3.401383215305447*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"], "+", SuperscriptBox["z", "2"], "+", "1"}], "=", RowBox[{"2", SqrtBox[ RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}]], "coth", " ", "v"}]}]], "DisplayFormula", CellChangeTimes->{{3.401382968614575*^9, 3.401383024947093*^9}, { 3.401383131541396*^9, 3.401383132643293*^9}}], Cell[TextData[{ "centred on the ring ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}], "=", "1"}], TraditionalForm]]], ". This is best expressed in toroidal coordinates (u,v,\[Phi]), -\[Pi]"Italic"], " and \[Phi] represent angles around the axial ring and around the z-axis \ respectively :" }], "Text", CellChangeTimes->{{3.40138321972197*^9, 3.4013833499705153`*^9}, { 3.401383386074916*^9, 3.401383498865727*^9}, {3.401384208010445*^9, 3.4013842292019033`*^9}, {3.4013842612981052`*^9, 3.401384309554658*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}], "=", RowBox[{ RowBox[{"{", RowBox[{ FractionBox[ RowBox[{"cos", " ", "\[Phi]", " ", "sinh", " ", "v"}], RowBox[{ RowBox[{"cosh", " ", "v"}], "-", RowBox[{"cos", " ", "u"}]}]], ",", FractionBox[ RowBox[{"sin", " ", "\[Phi]", " ", "sinh", " ", "v"}], RowBox[{ RowBox[{"cosh", " ", "v"}], "-", RowBox[{"cos", " ", "u"}]}]], ",", FractionBox[ RowBox[{"sin", " ", "u"}], RowBox[{ RowBox[{"cosh", " ", "v"}], "-", RowBox[{"cos", " ", "u"}]}]]}], "}"}], "."}]}]], "DisplayFormula", CellChangeTimes->{{3.401383569886715*^9, 3.4013835757086143`*^9}, { 3.401383628959202*^9, 3.4013837113086767`*^9}}], Cell[TextData[{ "Assume the surface v=1 has initial temperature ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ SuperscriptBox["cos", "10"], "(", RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{"u", "-", FractionBox["\[Pi]", "4"]}], ")"}]}], ")"}], " ", RowBox[{ SuperscriptBox["cos", "10"], "(", RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{"\[Phi]", "+", FractionBox["\[Pi]", "2"]}], ")"}]}], ")"}]}], TraditionalForm]], CellChangeTimes->{{3.401383900543442*^9, 3.401383915138824*^9}}], ", corresponding to a single \"hot spot\" at ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"u", "=", FractionBox["\[Pi]", "4"]}], ",", " ", RowBox[{"\[Phi]", "=", RowBox[{"-", RowBox[{ FractionBox["\[Pi]", "2"], "."}]}]}]}], TraditionalForm]]] }], "Text", CellChangeTimes->{{3.401383793601514*^9, 3.401383833617258*^9}, { 3.4013839276804028`*^9, 3.401384030331354*^9}, {3.401384349451952*^9, 3.4013844010771837`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"col", "=", RowBox[{"ColorData", "[", "\"\\"", "]"}]}], ";", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"{", RowBox[{ FractionBox[ RowBox[{ RowBox[{"Cos", "[", "\[Phi]", "]"}], " ", RowBox[{"Sinh", "[", "v", "]"}]}], RowBox[{ RowBox[{"-", RowBox[{"Cos", "[", "u", "]"}]}], "+", RowBox[{"Cosh", "[", "v", "]"}]}]], ",", FractionBox[ RowBox[{ RowBox[{"Sin", "[", "\[Phi]", "]"}], " ", RowBox[{"Sinh", "[", "v", "]"}]}], RowBox[{ RowBox[{"-", RowBox[{"Cos", "[", "u", "]"}]}], "+", RowBox[{"Cosh", "[", "v", "]"}]}]], ",", FractionBox[ RowBox[{"Sin", "[", "u", "]"}], RowBox[{ RowBox[{"-", RowBox[{"Cos", "[", "u", "]"}]}], "+", RowBox[{"Cosh", "[", "v", "]"}]}]]}], "}"}], "/.", RowBox[{"v", "\[Rule]", "1"}]}], "]"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{"-", "\[Pi]"}], ",", "\[Pi]"}], "}"}], ",", RowBox[{"{", RowBox[{"\[Phi]", ",", RowBox[{"-", "\[Pi]"}], ",", "\[Pi]"}], "}"}], ",", RowBox[{"ColorFunctionScaling", "\[Rule]", "False"}], ",", RowBox[{"Axes", "\[Rule]", "False"}], ",", RowBox[{"Boxed", "\[Rule]", "False"}], ",", RowBox[{"ColorFunction", "\[Rule]", RowBox[{"Function", "[", RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y", ",", "z", ",", "u", ",", "\[Phi]"}], "}"}], ",", RowBox[{"col", "[", RowBox[{ SuperscriptBox[ RowBox[{"Cos", "[", RowBox[{ RowBox[{"(", RowBox[{"u", "-", RowBox[{"\[Pi]", "/", "4"}]}], ")"}], "/", "2"}], "]"}], "10"], SuperscriptBox[ RowBox[{"Cos", "[", RowBox[{ RowBox[{"(", RowBox[{"\[Phi]", "+", RowBox[{"\[Pi]", "/", "2"}]}], ")"}], "/", "2"}], "]"}], "10"]}], "]"}]}], "]"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4013845289597282`*^9, 3.401384610664365*^9}, { 3.401384647837391*^9, 3.401384649732069*^9}, {3.401386319370411*^9, 3.401386358839739*^9}, {3.401386688278818*^9, 3.4013866993061047`*^9}}], Cell["\<\ Grab and rotate it to take a better look. Notice that we have defined a \ colour function col[] to represent temperature.\ \>", "Text", CellChangeTimes->{{3.401384699248034*^9, 3.4013847518418083`*^9}, { 3.4013848153525877`*^9, 3.4013848825777273`*^9}, {3.401384993428256*^9, 3.4013850387386513`*^9}, {3.401385078172246*^9, 3.401385083250852*^9}, { 3.401385200267707*^9, 3.4013852123551817`*^9}, {3.4013864226154222`*^9, 3.4013864699140453`*^9}, {3.40139158037745*^9, 3.401391633597061*^9}}], Cell[BoxData["col"], "Input", CellChangeTimes->{{3.401391643945221*^9, 3.401391644347776*^9}}], Cell[TextData[{ "Solve the heat equation \[PartialD]", StyleBox["U", FontSlant->"Italic"], "/\[PartialD]t = ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["\[Del]", "2"], "U"}], TraditionalForm]]], " to find how the temperature ", StyleBox["U(u,\[Phi]", FontSlant->"Italic"], ",t) evolves in time, and plot your results. The 2D (toroidal shell ", StyleBox["v", FontSlant->"Italic"], ") Laplacian in toroidal coordinates is given by" }], "Text", CellChangeTimes->{{3.401384699248034*^9, 3.4013847518418083`*^9}, { 3.4013848153525877`*^9, 3.4013848825777273`*^9}, {3.401384993428256*^9, 3.4013850387386513`*^9}, {3.401385078172246*^9, 3.401385083250852*^9}, { 3.401385200267707*^9, 3.4013852123551817`*^9}, {3.4013864226154222`*^9, 3.4013864699140453`*^9}, {3.40139158037745*^9, 3.4013916411602983`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"lap", "[", RowBox[{"u_", ",", "v_", ",", "\[Phi]_", ",", "t_"}], "]"}], "=", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"Cos", "[", "u", "]"}], "-", RowBox[{"Cosh", "[", "v", "]"}]}], ")"}], " ", RowBox[{"Csch", "[", "v", "]"}], " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"Cos", "[", "u", "]"}], "-", RowBox[{"Cosh", "[", "v", "]"}]}], ")"}], " ", RowBox[{"Csch", "[", "v", "]"}], " ", RowBox[{ SuperscriptBox["U", TagBox[ RowBox[{"(", RowBox[{"0", ",", "2", ",", "0"}], ")"}], Derivative], MultilineFunction->None], "[", RowBox[{"u", ",", "\[Phi]", ",", "t"}], "]"}]}], "+", RowBox[{ RowBox[{"Sinh", "[", "v", "]"}], " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"Sin", "[", "u", "]"}], " ", RowBox[{ SuperscriptBox["U", TagBox[ RowBox[{"(", RowBox[{"1", ",", "0", ",", "0"}], ")"}], Derivative], MultilineFunction->None], "[", RowBox[{"u", ",", "\[Phi]", ",", "t"}], "]"}]}], "+", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"Cos", "[", "u", "]"}], "-", RowBox[{"Cosh", "[", "v", "]"}]}], ")"}], " ", RowBox[{ SuperscriptBox["U", TagBox[ RowBox[{"(", RowBox[{"2", ",", "0", ",", "0"}], ")"}], Derivative], MultilineFunction->None], "[", RowBox[{"u", ",", "\[Phi]", ",", "t"}], "]"}]}]}], ")"}]}]}], ")"}]}]}], ";"}]], "Input", CellChangeTimes->{ 3.401357096130391*^9, 3.401357167213584*^9, {3.4013572372275763`*^9, 3.4013572438964643`*^9}, {3.4013573032290382`*^9, 3.401357320813818*^9}, 3.4013849554197474`*^9, {3.401385047442429*^9, 3.401385065945249*^9}, { 3.401388195447504*^9, 3.4013881969652433`*^9}}], Cell[CellGroupData[{ Cell["Solution", "Subsubsection", CellChangeTimes->{{3.401349183101961*^9, 3.401349187312278*^9}}], Cell["Let's try it first using the default method.", "Text", CellChangeTimes->{{3.4013857824356537`*^9, 3.401385797745853*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Clear", "[", "solb", "]"}], ";", RowBox[{ RowBox[{"solb", "[", "v_", "]"}], ":=", RowBox[{ RowBox[{"solb", "[", "v", "]"}], "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", "t"], RowBox[{"U", "[", RowBox[{"u", ",", "\[Phi]", ",", "t"}], "]"}]}], "\[Equal]", RowBox[{"lap", "[", RowBox[{"u", ",", "v", ",", "\[Phi]", ",", "t"}], "]"}]}], ",", RowBox[{ RowBox[{"U", "[", RowBox[{"u", ",", "\[Phi]", ",", "0"}], "]"}], "\[Equal]", RowBox[{ SuperscriptBox[ RowBox[{"Cos", "[", RowBox[{ RowBox[{"(", RowBox[{"u", "-", RowBox[{"\[Pi]", "/", "4"}]}], ")"}], "/", "2"}], "]"}], "10"], SuperscriptBox[ RowBox[{"Cos", "[", RowBox[{ RowBox[{"(", RowBox[{"\[Phi]", "+", RowBox[{"\[Pi]", "/", "2"}]}], ")"}], "/", "2"}], "]"}], "10"]}]}], ",", RowBox[{ RowBox[{"U", "[", RowBox[{ RowBox[{"-", "\[Pi]"}], ",", "\[Phi]", ",", "t"}], "]"}], "\[Equal]", RowBox[{"U", "[", RowBox[{"\[Pi]", ",", "\[Phi]", ",", "t"}], "]"}]}], ",", RowBox[{ RowBox[{"U", "[", RowBox[{"u", ",", RowBox[{"-", "\[Pi]"}], ",", "t"}], "]"}], "\[Equal]", RowBox[{"U", "[", RowBox[{"u", ",", "\[Pi]", ",", "t"}], "]"}]}]}], "}"}], ",", "U", ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{"-", "\[Pi]"}], ",", "\[Pi]"}], "}"}], ",", RowBox[{"{", RowBox[{"\[Phi]", ",", RowBox[{"-", "\[Pi]"}], ",", "\[Pi]"}], "}"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "2"}], "}"}]}], "]"}]}]}]}]], "Input", CellChangeTimes->{{3.401351723400653*^9, 3.4013517276607933`*^9}, { 3.40135191215486*^9, 3.401351922648696*^9}, {3.4013519935217257`*^9, 3.401352029769239*^9}, {3.401352065507475*^9, 3.4013521097457943`*^9}, { 3.401352191273868*^9, 3.4013523012263193`*^9}, {3.401352342030623*^9, 3.401352374583476*^9}, {3.4013527722224903`*^9, 3.4013527956273108`*^9}, { 3.401355118945887*^9, 3.401355124300085*^9}, {3.401357938735834*^9, 3.401357946724695*^9}, {3.4013580595780354`*^9, 3.401358061229491*^9}, { 3.40135812988811*^9, 3.4013581314853687`*^9}, {3.401358206989441*^9, 3.4013582275238743`*^9}, {3.401358280570323*^9, 3.4013583142143373`*^9}, { 3.4013583578874483`*^9, 3.401358364004702*^9}, {3.4013583945159197`*^9, 3.401358400500671*^9}, {3.401358445393855*^9, 3.4013584470454206`*^9}, { 3.401358493569837*^9, 3.401358538117593*^9}, {3.401358574607664*^9, 3.401358578644869*^9}, {3.401358672624289*^9, 3.401358680267461*^9}, { 3.401358739946419*^9, 3.401358745261972*^9}, {3.401358878609209*^9, 3.4013588791737328`*^9}, {3.401385481568528*^9, 3.401385507964245*^9}, { 3.401385615344243*^9, 3.401385619723192*^9}, {3.401385704336039*^9, 3.401385729304027*^9}}], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{"solb", "[", "1", "]"}], "]"}]], "Input", CellChangeTimes->{{3.401385800776658*^9, 3.401385808394808*^9}}], Cell[TextData[{ "But maybe we can do better with pseudospectral derivatives in both \ directions, since the problem is periodic in ", StyleBox["u", FontSlant->"Italic"], " and \[Phi]. Notice, we have defined sol to remember the solution, so that \ we don't need to solve the PDE every time we want it." }], "Text", CellChangeTimes->{{3.401385836583633*^9, 3.4013858740738153`*^9}, { 3.401385958433844*^9, 3.40138599431386*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Clear", "[", "sol", "]"}], ";", RowBox[{ RowBox[{"sol", "[", "v_", "]"}], ":=", RowBox[{ RowBox[{"sol", "[", "v", "]"}], "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", "t"], RowBox[{"U", "[", RowBox[{"u", ",", "\[Phi]", ",", "t"}], "]"}]}], "\[Equal]", RowBox[{"lap", "[", RowBox[{"u", ",", "v", ",", "\[Phi]", ",", "t"}], "]"}]}], ",", RowBox[{ RowBox[{"U", "[", RowBox[{"u", ",", "\[Phi]", ",", "0"}], "]"}], "\[Equal]", RowBox[{ SuperscriptBox[ RowBox[{"Cos", "[", RowBox[{ RowBox[{"(", RowBox[{"u", "-", RowBox[{"\[Pi]", "/", "4"}]}], ")"}], "/", "2"}], "]"}], "4"], SuperscriptBox[ RowBox[{"Cos", "[", RowBox[{ RowBox[{"(", RowBox[{"\[Phi]", "+", RowBox[{"\[Pi]", "/", "2"}]}], ")"}], "/", "2"}], "]"}], "4"]}]}], ",", RowBox[{ RowBox[{"U", "[", RowBox[{ RowBox[{"-", "\[Pi]"}], ",", "\[Phi]", ",", "t"}], "]"}], "\[Equal]", RowBox[{"U", "[", RowBox[{"\[Pi]", ",", "\[Phi]", ",", "t"}], "]"}]}], ",", RowBox[{ RowBox[{"U", "[", RowBox[{"u", ",", RowBox[{"-", "\[Pi]"}], ",", "t"}], "]"}], "\[Equal]", RowBox[{"U", "[", RowBox[{"u", ",", "\[Pi]", ",", "t"}], "]"}]}]}], "}"}], ",", "U", ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{"-", "\[Pi]"}], ",", "\[Pi]"}], "}"}], ",", RowBox[{"{", RowBox[{"\[Phi]", ",", RowBox[{"-", "\[Pi]"}], ",", "\[Pi]"}], "}"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "2"}], "}"}], ",", RowBox[{"Method", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", " ", RowBox[{"\"\\"", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"(*", " ", RowBox[{ "Specify", " ", "use", " ", "of", " ", "a", " ", "tensor", " ", "product", " ", RowBox[{"grid", "."}]}], " ", "*)"}], " ", RowBox[{ "DifferenceOrder", "\[Rule]", "\"\\""}]}], " ", RowBox[{"(*", " ", RowBox[{ "Specify", " ", "use", " ", "of", " ", "pseudospectral", " ", "approximations", " ", "for", " ", "x", " ", "and", " ", RowBox[{"y", "."}]}], "*)"}], "}"}]}]}], "}"}]}]}], "]"}]}]}]}]], "Input", CellChangeTimes->{{3.401351723400653*^9, 3.4013517276607933`*^9}, { 3.40135191215486*^9, 3.401351922648696*^9}, {3.4013519935217257`*^9, 3.401352029769239*^9}, {3.401352065507475*^9, 3.4013521097457943`*^9}, { 3.401352191273868*^9, 3.4013523012263193`*^9}, {3.401352342030623*^9, 3.401352374583476*^9}, {3.4013527722224903`*^9, 3.4013527956273108`*^9}, { 3.401355118945887*^9, 3.401355124300085*^9}, {3.401357938735834*^9, 3.401357946724695*^9}, {3.4013580595780354`*^9, 3.401358061229491*^9}, { 3.40135812988811*^9, 3.4013581314853687`*^9}, {3.401358206989441*^9, 3.4013582275238743`*^9}, {3.401358280570323*^9, 3.4013583142143373`*^9}, { 3.4013583578874483`*^9, 3.401358364004702*^9}, {3.4013583945159197`*^9, 3.401358400500671*^9}, {3.401358445393855*^9, 3.4013584470454206`*^9}, { 3.401358493569837*^9, 3.401358538117593*^9}, {3.401358574607664*^9, 3.401358578644869*^9}, {3.401358672624289*^9, 3.401358680267461*^9}, { 3.401358739946419*^9, 3.401358745261972*^9}, {3.401358878609209*^9, 3.4013588791737328`*^9}, {3.401385481568528*^9, 3.401385507964245*^9}, { 3.401385615344243*^9, 3.401385619723192*^9}, {3.401386246773884*^9, 3.401386276232767*^9}, {3.401386503059164*^9, 3.401386519277026*^9}}], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{"sol", "[", "1", "]"}], "]"}]], "Input", CellChangeTimes->{{3.401385758790812*^9, 3.401385765905147*^9}}], Cell["Yes, much faster! Plot the temperature at the hotspot:", "Text", CellChangeTimes->{{3.4013858966594276`*^9, 3.401385946769717*^9}, { 3.401386835164834*^9, 3.401386860570002*^9}}], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"U", "[", RowBox[{ RowBox[{"\[Pi]", "/", "4"}], ",", RowBox[{ RowBox[{"-", "\[Pi]"}], "/", "2"}], ",", "t"}], "]"}], "/.", RowBox[{"sol", "[", "1", "]"}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "2"}], "}"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "1.02"}], "}"}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"FrameLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\<\!\(\* StyleBox[\"t\", FontSlant->\"Italic\"]\)\>\"", ",", "\"\<\!\(\* StyleBox[\"U\", FontSlant->\"Italic\"]\)\>\""}], "}"}]}], ",", RowBox[{"GridLines", "\[Rule]", "Automatic"}]}], "]"}]], "Input", CellChangeTimes->{{3.4013858966594276`*^9, 3.401385946769717*^9}, { 3.401386835164834*^9, 3.40138709108501*^9}}], Cell["\<\ Now set up a plotting utility for the whole torus using the colour function \ col[] we defined earlier.\ \>", "Text", CellChangeTimes->{{3.4013858966594276`*^9, 3.401385946769717*^9}, { 3.401386835164834*^9, 3.4013868798260317`*^9}, {3.401387119324563*^9, 3.401387124802389*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"pp", "[", RowBox[{"t_", ",", "v_"}], "]"}], ":=", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", RowBox[{ FractionBox[ RowBox[{ RowBox[{"Cos", "[", "\[Phi]", "]"}], " ", RowBox[{"Sinh", "[", "v", "]"}]}], RowBox[{ RowBox[{"-", RowBox[{"Cos", "[", "u", "]"}]}], "+", RowBox[{"Cosh", "[", "v", "]"}]}]], ",", FractionBox[ RowBox[{ RowBox[{"Sin", "[", "\[Phi]", "]"}], " ", RowBox[{"Sinh", "[", "v", "]"}]}], RowBox[{ RowBox[{"-", RowBox[{"Cos", "[", "u", "]"}]}], "+", RowBox[{"Cosh", "[", "v", "]"}]}]], ",", FractionBox[ RowBox[{"Sin", "[", "u", "]"}], RowBox[{ RowBox[{"-", RowBox[{"Cos", "[", "u", "]"}]}], "+", RowBox[{"Cosh", "[", "v", "]"}]}]]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{"-", "\[Pi]"}], ",", "\[Pi]"}], "}"}], ",", RowBox[{"{", RowBox[{"\[Phi]", ",", RowBox[{"-", "\[Pi]"}], ",", "\[Pi]"}], "}"}], ",", RowBox[{"ColorFunctionScaling", "\[Rule]", "False"}], ",", RowBox[{"Axes", "\[Rule]", "False"}], ",", RowBox[{"Boxed", "\[Rule]", "False"}], ",", RowBox[{"ColorFunction", "\[Rule]", RowBox[{"Function", "[", RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y", ",", "z", ",", "u", ",", "\[Phi]"}], "}"}], ",", RowBox[{"col", "[", RowBox[{"First", "[", RowBox[{ RowBox[{"U", "[", RowBox[{"u", ",", "\[Phi]", ",", "t"}], "]"}], "/.", RowBox[{"sol", "[", "v", "]"}]}], "]"}], "]"}]}], "]"}]}], ",", RowBox[{"PlotLabel", "\[Rule]", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", "t", "]"}]}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.401354127188188*^9, 3.401354149594195*^9}, { 3.4013546301341543`*^9, 3.4013546580127373`*^9}, {3.4013547203640127`*^9, 3.401354773106441*^9}, {3.4013548679651413`*^9, 3.401354984500347*^9}, { 3.4013550245743113`*^9, 3.40135504932511*^9}, {3.401355088167211*^9, 3.401355088523602*^9}, {3.40135517434304*^9, 3.401355226951707*^9}, { 3.401357367670475*^9, 3.401357405099382*^9}, {3.401357455869973*^9, 3.401357570310877*^9}, {3.401385412193519*^9, 3.401385449711544*^9}, { 3.401386533651662*^9, 3.401386539000082*^9}, {3.401386725495431*^9, 3.401386735424505*^9}, 3.401386774242914*^9}], Cell[BoxData[ RowBox[{"pp", "[", RowBox[{".1", ",", "1"}], "]"}]], "Input", CellChangeTimes->{{3.4013871385653152`*^9, 3.401387147693234*^9}}], Cell["\<\ Let us now animate, giving your computer time to render the torus in each \ frame. Depending how fast your machine is, you may want to adjust the \ AnimationRate.\ \>", "Text", CellChangeTimes->{{3.4013860141460648`*^9, 3.401386071457777*^9}}], Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"pp", "[", RowBox[{"t", ",", "1"}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "2", ",", ".05"}], "}"}], ",", RowBox[{"AnimationRate", "\[Rule]", ".025"}], ",", RowBox[{"DisplayAllSteps", "\[Rule]", "True"}]}], "]"}]], "Input", CellChangeTimes->{{3.40135759374862*^9, 3.401357627310506*^9}, { 3.4013576796604548`*^9, 3.401357682018015*^9}, {3.4013578527021847`*^9, 3.4013578675691013`*^9}, 3.401357900566958*^9, {3.401358806228949*^9, 3.4013588700021477`*^9}, {3.401358909780355*^9, 3.40135893656215*^9}, { 3.401358978449189*^9, 3.401359012476822*^9}, {3.4013860902026167`*^9, 3.4013860922328997`*^9}, {3.401387324651285*^9, 3.401387367245441*^9}}], Cell[BoxData[ RowBox[{"Clear", "[", RowBox[{"sol", ",", "pp"}], "]"}]], "Input", CellChangeTimes->{{3.4013853827050343`*^9, 3.401385392969946*^9}, { 3.401385433413471*^9, 3.401385434361622*^9}}] }, Closed]] }, Closed]] }, Closed]] }, Open ]] }, WindowSize->{970, 852}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, ShowSelection->True, Magnification->1., FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (June 19, 2007)", StyleDefinitions->FrontEnd`FileName[{"Creative"}, "NaturalColor.nb", CharacterEncoding -> "UTF-8"] ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{ "NDSolve"->{ Cell[29338, 972, 2320, 68, 107, "Input", CellTags->"NDSolve"], Cell[31885, 1048, 3189, 86, 178, "Input", CellTags->"NDSolve"], Cell[35326, 1145, 886, 26, 43, "Input", CellTags->"NDSolve"], Cell[40198, 1292, 1112, 29, 43, "Input", CellTags->"NDSolve"], Cell[63348, 2068, 2012, 52, 58, "Input", CellTags->"NDSolve"]}, "S3.5.11"->{ Cell[42823, 1373, 73, 1, 27, "Input", CellTags->"S3.5.11"]} } *) (*CellTagsIndex CellTagsIndex->{ {"NDSolve", 89421, 2770}, {"S3.5.11", 89776, 2781} } *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 118, 4, 66, "Title"], Cell[711, 29, 45, 0, 31, "Subtitle"], Cell[759, 31, 89, 2, 20, "Author"], Cell[851, 35, 228, 4, 41, "Text"], Cell[CellGroupData[{ Cell[1104, 43, 42, 0, 72, "Section"], Cell[1149, 45, 249, 6, 26, "Text"], Cell[1401, 53, 385, 12, 37, "Input"], Cell[1789, 67, 55, 0, 26, "Text"], Cell[1847, 69, 677, 20, 37, "Input"], Cell[2527, 91, 217, 5, 41, "Text"], Cell[2747, 98, 352, 11, 37, "Input"], Cell[3102, 111, 163, 2, 26, "Text"], Cell[3268, 115, 159, 5, 37, "Input"], Cell[3430, 122, 105, 1, 26, "Text"], Cell[3538, 125, 376, 10, 37, "Input"], Cell[3917, 137, 202, 4, 26, "Text"], Cell[4122, 143, 347, 10, 37, "Input"], Cell[4472, 155, 395, 12, 37, "Input"], Cell[4870, 169, 60, 1, 37, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[4967, 175, 51, 0, 42, "Section"], Cell[5021, 177, 264, 7, 22, "Text"], Cell[5288, 186, 655, 21, 50, "Input"], Cell[5946, 209, 323, 5, 36, "Text"], Cell[6272, 216, 923, 28, 50, "Input"], Cell[7198, 246, 275, 9, 22, "Text"], Cell[7476, 257, 180, 6, 44, "Input"], Cell[7659, 265, 58, 0, 22, "Text"], Cell[7720, 267, 260, 8, 44, "Input"], Cell[7983, 277, 105, 5, 22, "Text"], Cell[8091, 284, 329, 10, 45, "Input"], Cell[8423, 296, 119, 3, 22, "Text"], Cell[8545, 301, 1687, 44, 105, "Input"], Cell[10235, 347, 168, 3, 22, "Text"], Cell[10406, 352, 60, 1, 44, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[10503, 358, 72, 0, 42, "Section"], Cell[10578, 360, 178, 5, 22, "Text"], Cell[10759, 367, 631, 20, 44, "Input"], Cell[11393, 389, 313, 9, 44, "Input"], Cell[11709, 400, 217, 5, 22, "Text"], Cell[11929, 407, 705, 20, 50, "Input"], Cell[12637, 429, 482, 12, 44, "Input"], Cell[13122, 443, 310, 6, 22, "Text"], Cell[13435, 451, 390, 8, 36, "Text"], Cell[13828, 461, 796, 25, 50, "Input"], Cell[14627, 488, 305, 7, 22, "Text"], Cell[14935, 497, 262, 7, 44, "Input"], Cell[15200, 506, 202, 4, 22, "Text"], Cell[15405, 512, 285, 9, 44, "Input"], Cell[15693, 523, 261, 8, 44, "Input"], Cell[15957, 533, 98, 2, 22, "Text"], Cell[16058, 537, 105, 3, 44, "Input"], Cell[16166, 542, 68, 0, 22, "Text"], Cell[16237, 544, 597, 19, 50, "Input"], Cell[16837, 565, 597, 19, 50, "Input"], Cell[17437, 586, 240, 6, 22, "Text"], Cell[17680, 594, 821, 23, 44, "Input"], Cell[18504, 619, 245, 7, 22, "Text"], Cell[18752, 628, 92, 2, 22, "Text"], Cell[18847, 632, 232, 5, 44, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[19116, 642, 41, 0, 42, "Section"], Cell[19160, 644, 180, 4, 22, "Text"], Cell[19343, 650, 512, 17, 49, "Input"], Cell[19858, 669, 537, 18, 49, "Input"], Cell[20398, 689, 565, 19, 50, "Input"], Cell[20966, 710, 294, 7, 46, "Text"], Cell[21263, 719, 487, 16, 49, "Input"], Cell[21753, 737, 111, 3, 46, "Text"], Cell[21867, 742, 446, 15, 45, "Input"], Cell[22316, 759, 90, 3, 46, "Text"], Cell[22409, 764, 453, 15, 45, "Input"], Cell[22865, 781, 35, 0, 22, "Text"], Cell[22903, 783, 157, 3, 22, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[23097, 791, 45, 0, 42, "Section"], Cell[23145, 793, 242, 6, 20, "Text"], Cell[23390, 801, 201, 4, 20, "Text"], Cell[23594, 807, 1419, 42, 53, "Input"], Cell[25016, 851, 374, 6, 20, "Text"], Cell[25393, 859, 1917, 49, 53, "Input"], Cell[27313, 910, 54, 0, 20, "Text"], Cell[27370, 912, 945, 25, 43, "Input"], Cell[28318, 939, 44, 0, 20, "Text"], Cell[28365, 941, 124, 3, 27, "Input"], Cell[28492, 946, 105, 1, 20, "Text"], Cell[28600, 949, 269, 7, 27, "Input"], Cell[28872, 958, 463, 12, 35, "Text"], Cell[29338, 972, 2320, 68, 107, "Input", CellTags->"NDSolve"], Cell[31661, 1042, 221, 4, 20, "Text"], Cell[31885, 1048, 3189, 86, 178, "Input", CellTags->"NDSolve"], Cell[35077, 1136, 183, 4, 20, "Text"], Cell[35263, 1142, 60, 1, 27, "Input"], Cell[35326, 1145, 886, 26, 43, "Input", CellTags->"NDSolve"], Cell[36215, 1173, 98, 2, 20, "Text"], Cell[36316, 1177, 320, 8, 27, "Input"], Cell[36639, 1187, 264, 5, 35, "Text"], Cell[36906, 1194, 222, 5, 27, "Input"], Cell[37131, 1201, 155, 5, 20, "Text"], Cell[37289, 1208, 2878, 80, 138, "Input"], Cell[40170, 1290, 25, 0, 20, "Text"], Cell[40198, 1292, 1112, 29, 43, "Input", CellTags->"NDSolve"], Cell[41313, 1323, 670, 13, 27, "Input"], Cell[41986, 1338, 162, 4, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[42185, 1347, 59, 1, 42, "Section"], Cell[42247, 1350, 207, 7, 26, "Text"], Cell[CellGroupData[{ Cell[42479, 1361, 35, 0, 31, "Subsection"], Cell[42517, 1363, 245, 4, 35, "Text"], Cell[CellGroupData[{ Cell[42787, 1371, 33, 0, 18, "Subsubsection"], Cell[42823, 1373, 73, 1, 27, "Input", CellTags->"S3.5.11"], Cell[42899, 1376, 195, 6, 27, "Input"], Cell[43097, 1384, 195, 6, 27, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[43341, 1396, 37, 0, 25, "Subsection"], Cell[43381, 1398, 711, 28, 26, "Text"], Cell[CellGroupData[{ Cell[44117, 1430, 33, 0, 18, "Subsubsection"], Cell[44153, 1432, 62, 1, 27, "Input"], Cell[44218, 1435, 589, 20, 33, "Input"], Cell[44810, 1457, 1104, 32, 71, "Input"], Cell[45917, 1491, 1229, 36, 71, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[47195, 1533, 59, 0, 25, "Subsection"], Cell[47257, 1535, 873, 27, 49, "Text"], Cell[CellGroupData[{ Cell[48155, 1566, 33, 0, 18, "Subsubsection"], Cell[48191, 1568, 119, 3, 20, "Text"], Cell[48313, 1573, 368, 10, 27, "Input"], Cell[48684, 1585, 110, 1, 20, "Text"], Cell[48797, 1588, 1003, 30, 27, "Input"], Cell[49803, 1620, 267, 8, 27, "Input"], Cell[50073, 1630, 46, 0, 20, "Text"], Cell[50122, 1632, 101, 1, 20, "Text"], Cell[50226, 1635, 426, 12, 27, "Input"], Cell[50655, 1649, 188, 2, 20, "Text"], Cell[50846, 1653, 1230, 34, 58, "Input"], Cell[52079, 1689, 426, 12, 27, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[52554, 1707, 32, 0, 25, "Subsection"], Cell[52589, 1709, 293, 11, 20, "Text"], Cell[CellGroupData[{ Cell[52907, 1724, 33, 0, 18, "Subsubsection"], Cell[52943, 1726, 692, 22, 27, "Input"], Cell[53638, 1750, 260, 8, 27, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[53947, 1764, 35, 0, 25, "Subsection"], Cell[53985, 1766, 316, 11, 20, "Text"], Cell[CellGroupData[{ Cell[54326, 1781, 33, 0, 18, "Subsubsection"], Cell[54362, 1783, 168, 6, 20, "Text"], Cell[54533, 1791, 882, 26, 27, "Input"], Cell[55418, 1819, 332, 9, 27, "Input"], Cell[55753, 1830, 151, 3, 20, "Text"], Cell[55907, 1835, 1004, 31, 43, "Input"], Cell[56914, 1868, 195, 6, 27, "Input"], Cell[57112, 1876, 245, 6, 20, "Text"], Cell[57360, 1884, 285, 9, 27, "Input"], Cell[57648, 1895, 738, 23, 27, "Input"], Cell[58389, 1920, 260, 8, 27, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[58698, 1934, 34, 0, 25, "Subsection"], Cell[58735, 1936, 1324, 40, 50, "Text"], Cell[CellGroupData[{ Cell[60084, 1980, 33, 0, 18, "Subsubsection"], Cell[60120, 1982, 3189, 82, 142, "Input"], Cell[63312, 2066, 33, 0, 20, "Text"], Cell[63348, 2068, 2012, 52, 58, "Input", CellTags->"NDSolve"], Cell[65363, 2122, 79, 1, 20, "Text"], Cell[65445, 2125, 317, 8, 27, "Input"], Cell[65765, 2135, 150, 3, 27, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[65964, 2144, 278, 3, 25, "Subsection"], Cell[66245, 2149, 207, 3, 20, "Text"], Cell[66455, 2154, 419, 12, 31, "DisplayFormula"], Cell[66877, 2168, 775, 19, 38, "Text"], Cell[67655, 2189, 790, 23, 39, "DisplayFormula"], Cell[68448, 2214, 1070, 33, 32, "Text"], Cell[69521, 2249, 2396, 66, 107, "Input"], Cell[71920, 2317, 512, 8, 20, "Text"], Cell[72435, 2327, 95, 1, 27, "Input"], Cell[72533, 2330, 840, 21, 23, "Text"], Cell[73376, 2353, 2068, 59, 63, "Input"], Cell[CellGroupData[{ Cell[75469, 2416, 99, 1, 18, "Subsubsection"], Cell[75571, 2419, 128, 1, 22, "Text"], Cell[75702, 2422, 3175, 74, 115, "Input"], Cell[78880, 2498, 156, 3, 44, "Input"], Cell[79039, 2503, 435, 9, 37, "Text"], Cell[79477, 2514, 4059, 93, 196, "Input"], Cell[83539, 2609, 155, 3, 44, "Input"], Cell[83697, 2614, 187, 2, 22, "Text"], Cell[83887, 2618, 919, 26, 60, "Input"], Cell[84809, 2646, 296, 7, 45, "Text"], Cell[85108, 2655, 2492, 62, 122, "Input"], Cell[87603, 2719, 147, 3, 56, "Input"], Cell[87753, 2724, 254, 5, 37, "Text"], Cell[88010, 2731, 761, 14, 44, "Input"], Cell[88774, 2747, 201, 4, 56, "Input"] }, Closed]] }, Closed]] }, Closed]] }, Open ]] } ] *) (* End of internal cache information *)