(* 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[ 2803538, 46059] NotebookOptionsPosition[ 2801999, 46009] NotebookOutlinePosition[ 2802588, 46030] CellTagsIndexPosition[ 2802545, 46027] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[BoxData[{ RowBox[{ RowBox[{"xRange", "=", RowBox[{"{", RowBox[{"x", ",", "0", ",", "40"}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"tRange", "=", RowBox[{"{", RowBox[{"t", ",", "0", ",", "40"}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"f", "[", "c_", "]"}], ":=", " ", RowBox[{"c", " ", RowBox[{"(", RowBox[{"1", "-", "c"}], ")"}], " ", RowBox[{"(", RowBox[{"c", "-", "0.1"}], ")"}]}]}]}], "Input", CellChangeTimes->{{3.405075396121993*^9, 3.405075396284467*^9}, { 3.40513870534182*^9, 3.40513871140376*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"StepInputSize", "=", "0.5"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"InitialConditionProfile", "=", RowBox[{"StepInputSize", "*", RowBox[{"(", RowBox[{ RowBox[{"1", "/", "2"}], "+", RowBox[{ RowBox[{"1", "/", "2"}], "*", RowBox[{"Tanh", "[", RowBox[{"50", "*", RowBox[{"Sqrt", "[", RowBox[{"1", "/", "2"}], "]"}], "*", RowBox[{"(", RowBox[{"x", "-", "20"}], ")"}]}], "]"}]}], "-", RowBox[{"(", RowBox[{ RowBox[{"1", "/", "2"}], "+", RowBox[{ RowBox[{"1", "/", "2"}], "*", RowBox[{"Tanh", "[", RowBox[{"50", "*", RowBox[{"Sqrt", "[", RowBox[{"1", "/", "2"}], "]"}], "*", RowBox[{"(", RowBox[{"x", "-", "35"}], ")"}]}], "]"}]}]}], ")"}]}], ")"}]}]}], ";"}]}], "Input", CellChangeTimes->{{3.405075078890408*^9, 3.405075099571019*^9}, { 3.405075280201322*^9, 3.405075280380905*^9}, {3.405138720365396*^9, 3.405138769503144*^9}, {3.405138806641839*^9, 3.405138818255853*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{"InitialConditionProfile", ",", " ", RowBox[{"{", RowBox[{"x", ",", "0", ",", "40"}], "}"}], ",", " ", RowBox[{"PlotRange", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "40"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"0", ",", "1"}], "}"}]}], "}"}]}], ",", " ", RowBox[{"Filling", "\[Rule]", " ", "Bottom"}], ",", " ", RowBox[{"AxesLabel", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"StyleForm", "[", RowBox[{"\"\\"", ",", "Large", ",", " ", "Brown"}], "]"}], ",", RowBox[{"StyleForm", "[", RowBox[{"\"\\"", ",", " ", "Large", ",", "Brown"}], "]"}]}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.405138822275371*^9, 3.405138826903682*^9}, { 3.405139053394552*^9, 3.405139057448738*^9}, {3.405139100679759*^9, 3.405139118736527*^9}, {3.405139195063642*^9, 3.405139208101695*^9}, { 3.405139252027806*^9, 3.405139279406005*^9}}], Cell[BoxData[ GraphicsBox[GraphicsComplexBox[CompressedData[" 1:eJxNlgk8VFscx9V4Zas3LfLaLC1iaLLcEO6951rK1h6ixyvKTrSgIvOEynui 8oSeyFNSIiUZDY3dIEsqEzIilUq2pEXj3Tu4d+bz8fH5fs7//P6/+zvn3HtU XA7uODBTQkJiDP8j/qecdJmlvf8WIjH1u1qbGvBBqQ+d5pzcs+0+zO8ku6PN SR8P0cA0+/Wq9+TnSJMsoxKxRmBAJ/kcvY5xde8Ckl3adz2i1S8iOaAywuXg miUk5/nL7fzNcjnJV094v9eyVyY5PHV8++ePKiRLtHQBzvGVJKsecQvexVhN 8uvRS3ayxaokW/V6hV4IUCN5y+s4DUVFBsnvy11YNbc1SGbOe77c9I+11POh o/s6Rpgkb+p3HFthq0Uyv2z/DEdNbZLvn6lwVh6l2O2Xo10NDTokux46cV8u WVfErKJd8Dp3jQabfRBYdn8C/wnQxvmaskc3rJ+q70If5oRf1qTpkXxiBmNb /UuKZTqOW/jl65Pce10lPjXEgOR4tcWSbNsNJMclu1XvUzYk2THeqUHuLcVf za59Sy0xIrmn1yS47LQxyemw9tLH+2CSb0cenee+FiH5tK2rNW2U4vUdV7NO P0ZJTlS/fPuxNSA5jBuTaM2mePNS22u1qzCSMb/qPfPOYoBVKPHaQ90bTV3m sqp+dHpcQmJVeWbClj0mJMetLWM8KaHYbUSymccwJdklb1j5bCzFNbVSpzjj FJeMqH6bmKB4dnv3mn6lF+R5eG30tdYX0iXHeT4tpdk/dQFXvW+tPr0KneDc +rj3MUT6r9xr37LtCrWeb3yHFGUHqOetNjsn8ckOA8rFH0Xr71+5kOv3aPr5 Coy7ByKcYtSo5zEVKCDOQspfyw+P+EElHunvWlqB7ZUZlL+Eg5kPO+oINhC6 5VxAZO4M7eiAMTAxMbnf+Is/zQEZon4Gn7F5CIga4Wr+SvWbZRu3N+Yn1W9V 6wYAu1P6454T1SHrIHCrS6XmB64X8YKRM3EQA03ZmuuahAJUKsDoUEobtV4s z9Sl68Ty9YGP+o4psUn/s1rkL+u9o87LuP/5ws93Rf3Sim+PwHIVbfk3Egg9 IO1fWIL4N988FDKT8vs2tn5olZjfCOmkyGebKb8u3n0V8YsgYGrBOEIbFKCq sb+3BrpiYMQo7B6Rh/FStcWzHlN+XTLas6vE8tbyKy6peI3rab6TP8fWRjMO znBvzZus57q6whUZbd8zWNP98o0TPOTr9ltAwOtKj5DQ7175LeJMCAaOWfI9 5F+3o0+rttRB76h+qUzX6Eti+aRwY5R+Uc4i89HzqSwOb6fyuRMw6wHr+mS/ YJ0MWHXxdqmXsbgeK2NXcuhCVCooynrVOKW/+7ZX0aDYfs9Pt7ihglH5LPJx LleWgUCNB9vMUr0T/eI56q3jhOfTmPST8G/nf8XHsIrSe1J67OgFsXx6/HSK t/FxPbBCPka3GympCCqSvTVZH9/Jhj/D0cuHDlP9LD2jeYNGEMj3dnpJ6N8T nl9sFogBZl3M5p1tAvTT0kpFz1dUP7rNjJ2uYvlY+i8r8ngk0svy1DRFhv32 7zuSQtSzHh+b5Y7keh2pkloJgS5119AQXN82v9zkoScGquSig7/gvKIqr7K5 hdIP8bXgGgzpAlaI+cW5QhYaveSvBf8VTo3T58Dxshr83TFT/rtocLd7Wj1/ FwRmvvoiOk/zLfcO1odjwENNj/8jsABlzqssrRPzO1FVckpZOYlczwaD5Y1q z6j1lBkGBRvTJvW7BkLgfFM5naC/8f73Mj0LCwH61PKz/tevYnlw2Feei62n zcE0drUhla//x8SyNzR8PevSuxIErahzK6ZHdyT2+0WR355kh4SnZZRedFON Q7DYehoP+HAWPSH0GEeGFhQh1gM6r69lTtYrqPTCf8t0My/5Uv3S+ypqCtZD wIJ+GSH0l/l09qgcxsBc/mj05m8C9MRGlgWtk+pX47hN31Isn/RBOzaTLdJ7 dyB4KRKWpPTX3GSint5/oOECIvUhp7JhGQTQLMcelZ8CtESFPifJDQPOGya2 CvF+uYM+A95NlP7z/vBHwve4noMLxsrZjSqYb4Th+1PjJfqwJj+8Txg15Z/V bny8ILvoZhgGXBLXp/CCmtE3Sguv54n5sxuqe1CUPVl/R7seTvr0T6fJRVwP 7JQxU+hDOB9WVjjSIeBAVyiLyhSg58ZvXN21FwObSg8PE3nwzHtM0nhieX8a K47uxPW0fv91xF0a1U7mxAXkTI5vy46Ffw/QkbM+TuU7+G5rLcMEApcW1n8j 9KzOm291O4YBSTuWwv11AnRw4FVReqWovr+j3As5YJal35Ym0mtq1zJG7N5v qDZRh8CTzTsOvcPnf9wYFPzSBwNq0sNatcR56J9TemhMFxyplQBastfRnwON fVKcKb/cV8bjSEvV3YtTfu5owjfbF6gORGIg7kxcgWfSBTRwZuDLXrG8KlqU beyVz5L7fYkSr/VHM7Xf9XQ676unTOmd9IC/8/s2VkTj3/u2FFqYnS1qqKvB dBmj8vIxfRXHE9vvibY2Zcn6VD7/auqV8SQgEPb3SdsFnGaUoaV/S6WUmv/G ftDaW2x/e66T4XxrIOaHcNznX0cuRNC/DV+brLeb8QPmD8boe3lR+o3qLjVJ OhC44jVTn9hvTemSvLgADDxHg5lMfD+WtTs5besQu590B6kbi+XRqPW5cF6B SI+lAGYjVcyfqXsSifr8BSbSN5D1GjaVeYshcP0pX9EQPy+HdusNzz6AgXY3 yIpY7y+RVpLsBkqfxlR+9OotrldvDmn2m6HObSt3RN+bGrffAgeXMIebT037 rzZm9j9JXXwSA/LDnjTOvVbUJNMoMUPM3yltzwcpWZP1HzsewF2nDo/Enif0 Kl1TpSTQPo3ScngOBErHD8JftQWoiW5jVLkzBvgnbb4T/ujtXPv+aspfAfOf Yt92XI/7xlPlz1EkeF3ytZLsyfFEOAO+Yd+5UDGIyneZej9vDgqBhhL7IUJP WO0NPQvCwAuDIhtp/Dwt0woriiwj6lneVpl2SPaLKJs1qaL3vcMH2g4knNFa tVoVAqFs+d01+Py00BQnG28MNLYs2dOH89a1t7i2n3UBfUml8P3Vi6hZ5G2h bdH0/v5ibLE6rDEybvr9rgA7zzeUdY7AACS5PemT7DX0ydmURr5YXi/z/itw /W+yXuu387BvDnM54xyux5UTcpkM1DT7RxltNgSMar8bhX5tR//9JeTP0xVi 7+/cRo7uM2L+LPvExgZE0tG2cXeWaJy1+kwTHJi1htdiAAErc7UcIg+P9YXC u0cwcNffKmQJfn8JvMNmW3NE/Z+7GmohBpImgaWXifnKl/N9Q5GOm/OqPihB YOO9i2Y8/D4m86FvDcMDAx1PfH4S97Ws272Pln7Cv3emkV7VMr5oU66H2mDB lL/4FXDX0PMujejp9+OgcVVY1DOjPzHQoMIT3AirRNXzmIWtuaJx7ovMLniH QyFvNJ6YP3yefbUFib0VVRG0AAKngozGduDf87bKcE7vPgwIHRoExPM45TiW ZL7C56cFrHanKaLvJQUnVt2Z6l8TDNP/iqIFh1L7o/zG3dpN5hBomrFXdB9J cFTyGjuOAa48A6pQ6UTLc80ePqoh6pWlj6eGIYq5dSti0kV6/PNzVRH1m/9W /6EJgb6gTVLE99+Avv2inx8Guq1MV7KI85XtXxr7XRfUG75t/m3rA7TAcfjp w+Lp9ao3vrN7TYkgYcoPisFfMvoB6zR+f5d2GJ79IwxdcmLLh2Gx/fE/pqFS uA== "], {{{}, {Hue[0.67, 0.6, 0.6], Opacity[0.2], EdgeForm[None], GraphicsGroupBox[ PolygonBox[{{236, 176, 59, 244, 164, 210, 116, 227, 145, 191, 86, 235, 155, 201, 104, 219, 133, 179, 66, 240, 160, 206, 111, 223, 140, 186, 77, 231, 150, 196, 95, 215, 124, 171, 44, 246, 166, 212, 119, 229, 147, 193, 89, 238, 158, 204, 107, 221, 136, 182, 71, 242, 162, 208, 113, 225, 142, 188, 82, 233, 152, 198, 100, 129, 58, 65, 43, 57, 42, 41, 40, 39, 38, 37, 36, 35, 34, 33, 32, 31, 30, 29, 28, 56, 27, 55, 26, 118, 88, 237, 157, 203, 106, 220, 135, 181, 70, 241, 161, 207, 112, 224, 141, 187, 81, 232, 151, 197, 99, 216, 128, 175, 54, 243, 163, 209, 115, 226, 144, 190, 85, 234, 154, 200, 103, 218, 132, 178, 64, 239, 159, 205, 110, 222, 139, 185, 76, 230, 149, 195, 94, 214, 123, 170, 25, 245, 165, 211, 117, 228, 146, 192, 87}}, VertexColors->None]]}, {}, {}}, {{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[{1, 168, 121, 92, 74, 62, 52, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 169, 122, 93, 75, 63, 53, 174, 127, 98, 80, 69, 180, 134, 105, 202, 156, 236, 87, 192, 146, 228, 117, 211, 165, 245, 25, 170, 123, 214, 94, 195, 149, 230, 76, 185, 139, 222, 110, 205, 159, 239, 64, 178, 132, 218, 103, 200, 154, 234, 85, 190, 144, 226, 115, 209, 163, 243, 54, 175, 128, 216, 99, 197, 151, 232, 81, 187, 141, 224, 112, 207, 161, 241, 70, 181, 135, 220, 106, 203, 157, 237, 88, 118, 26, 55, 27, 56, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 57, 43, 65, 58, 129, 100, 198, 152, 233, 82, 188, 142, 225, 113, 208, 162, 242, 71, 182, 136, 221, 107, 204, 158, 238, 89, 193, 147, 229, 119, 212, 166, 246, 44, 171, 124, 215, 95, 196, 150, 231, 77, 186, 140, 223, 111, 206, 160, 240, 66, 179, 133, 219, 104, 201, 155, 235, 86, 191, 145, 227, 116, 210, 164, 244, 59, 176, 130, 217, 101, 199, 153, 83, 189, 143, 114, 72, 183, 137, 108, 90, 45, 172, 125, 96, 78, 67, 60, 46, 47, 48, 49, 50, 173, 126, 97, 79, 68, 61, 177, 131, 102, 84, 73, 184, 138, 109, 91, 194, 148, 120, 213, 167, 247, 51}]}}}], AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesLabel->{ FormBox[ TagBox[ StyleBox["\"x\"", Large, RGBColor[0.6, 0.4, 0.2]], StyleForm[#, Large, RGBColor[0.6, 0.4, 0.2]]& ], TraditionalForm], FormBox[ TagBox[ StyleBox["\"c(x,0)\"", Large, RGBColor[0.6, 0.4, 0.2]], StyleForm[#, Large, RGBColor[0.6, 0.4, 0.2]]& ], TraditionalForm]}, AxesOrigin->{0, 0}, Method->{"AxesInFront" -> True}, PlotRange->{{0, 40}, {0, 1}}, PlotRangeClipping->True, PlotRangePadding->{Automatic, Automatic}]], "Output", CellChangeTimes->{ 3.405075222522332*^9, 3.405075286659236*^9, 3.405075372959513*^9, 3.405138828475061*^9, 3.405139058067793*^9, 3.405139119714719*^9, 3.405139208950967*^9, {3.405139258301105*^9, 3.405139279949971*^9}}] }, Open ]], Cell[BoxData[ RowBox[{ RowBox[{"CoeffD", "=", "1.0"}], ";"}]], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"NDSol", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[PartialD]", "t"], RowBox[{"u", "[", RowBox[{"t", ",", "x"}], "]"}]}], "\[Equal]", RowBox[{ RowBox[{"CoeffD", "*", RowBox[{ SubscriptBox["\[PartialD]", RowBox[{"x", ",", "x"}]], RowBox[{"u", "[", RowBox[{"t", ",", "x"}], "]"}]}]}], "+", RowBox[{"f", "[", RowBox[{"u", "[", RowBox[{"t", ",", "x"}], "]"}], "]"}]}]}], ",", RowBox[{ RowBox[{"u", "[", RowBox[{"0", ",", "x"}], "]"}], "\[Equal]", "InitialConditionProfile"}], " ", RowBox[{"(*", " ", RowBox[{"initial", " ", "condition"}], " ", "*)"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", RowBox[{"xRange", "//", "Last"}]}], "]"}], "\[Equal]", RowBox[{"u", "[", RowBox[{"t", ",", "0"}], "]"}]}]}], " ", RowBox[{"(*", " ", RowBox[{"periodic", " ", "boundary", " ", "condition"}], " ", "*)"}], "}"}], ",", "u", ",", "\[IndentingNewLine]", "tRange", ",", "xRange", ",", RowBox[{"Method", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", " ", RowBox[{"\"\\"", "\[Rule]", RowBox[{"{", "\"\\"", "}"}]}]}], "}"}]}]}], " ", "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.40507523134622*^9, 3.405075255751947*^9}, 3.405075704849061*^9, {3.40513878566262*^9, 3.40513879283292*^9}, 3.405139288064379*^9, {3.405139328615452*^9, 3.405139330545434*^9}, { 3.405139418286599*^9, 3.405139445589445*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"NDSolve", "::", "\<\"mxsst\"\>"}], RowBox[{ ":", " "}], "\<\"Using maximum number of grid points \\!\\(10000\\) allowed \ by the MaxPoints or MinStepSize options for independent variable \\!\\(x\\). \ \\!\\(\\*ButtonBox[\\\"\[RightSkeleton]\\\", ButtonStyle->\\\"Link\\\", \ ButtonFrame->None, ButtonData:>\\\"paclet:ref/message/NDSolve/mxsst\\\", \ ButtonNote -> \\\"NDSolve::mxsst\\\"]\\)\"\>"}]], "Message", "MSG", CellChangeTimes->{{3.405075210543931*^9, 3.405075256739151*^9}, 3.405075289127013*^9, {3.405075376333307*^9, 3.405075399900179*^9}, 3.405075705625308*^9, 3.405076552293831*^9, 3.405076616357372*^9, 3.405076705003358*^9, 3.405076752220595*^9, 3.405077625120522*^9, { 3.405139288567943*^9, 3.405139297302409*^9}, 3.405139333839824*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot3D", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"u", "[", RowBox[{"t", ",", "x"}], "]"}], "/.", "NDSol"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{"tRange", "//", "Last"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", RowBox[{"xRange", "//", "Last"}]}], "}"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", " ", RowBox[{"PlotPoints", "\[Rule]", " ", "100"}], ",", " ", RowBox[{"AxesLabel", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"StyleForm", "[", RowBox[{"\"\