(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.0' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 22485, 838]*) (*NotebookOutlinePosition[ 23369, 868]*) (* CellTagsIndexPosition[ 23325, 864]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Vibrating Drumhead", "Title", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "by\nH. Edward Donley\nMathematics Department\nIndiana University of PA\n\n\ Internet: hedonley", StyleBox["@", FontFamily->"Times"], "iup.edu" }], "Subtitle", ImageRegion->{{0, 1}, {0, 1}}, FontSize->12, FontWeight->"Plain"], Cell["\<\ Off[General::spell1]; Off[Plot::plnr]; Needs[\"Graphics`Colors`\"]\ \>", "Input", InitializationCell->True, ImageRegion->{{0, 1}, {0, 1}}] }, Closed]], Cell[CellGroupData[{ Cell["The Wave Equation", "Section", ImageRegion->{{0, 1}, {0, 1}}], Cell["Needs[\"Calculus`VectorAnalysis`\"]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "The wave equation without damping in Cartesian coordinates is\n\n", Cell[BoxData[ \(TraditionalForm\`u\_tt = Div[\(c\^2\) Grad[u]]\)]] }], "Text"], Cell[BoxData[{ \(\(SetCoordinates[Cartesian[x, y, z]];\)\), "\[IndentingNewLine]", \(waveCartesian := D[u[x, y, t], {t, 2}] \[Equal] Div[\(c\^2\) Grad[u[x, y, t]]]\), "\[IndentingNewLine]", \(waveCartesian\)}], "Input"], Cell[TextData[{ "The superscripts on ", StyleBox["u", FontSlant->"Italic"], " represent partial derivatives. For example, ", Cell[BoxData[ \(TraditionalForm\`u\^\((0, 0, 2)\)\)]], " is the second derivative with respect to ", StyleBox["t", FontSlant->"Italic"], "." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Conversion to Polar Coordinates", "Section", ImageRegion->{{0, 1}, {0, 1}}], Cell[" Converting to cylindrical coordinates,", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ CoordinatesFromCartesian[{x,y,z},Cylindrical] SetCoordinates[Cylindrical[r,\[Theta],z]];\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell["the wave equation becomes", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[{ \(waveCylindrical := D[u[r, \[Theta], t], {t, 2}] \[Equal] Div[c\^2\ Grad[u[r, \[Theta], t]]]\), "\[IndentingNewLine]", \(waveCylindrical\)}], "Input"], Cell["\<\ The vibrations of a drumhead satisfy the wave equation, where u is the \ displacement from the horizontal equilibrium position. If the initial \ conditions are independent of \[Theta], then the solution will also be \ indepenent of \[Theta]. This simplifies the wave equation.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[{ \(Clear[u]\), "\[IndentingNewLine]", \(wave := D[u[r, t], {t, 2}] \[Equal] Div[c\^2\ Grad[u[r, t]]]\), "\[IndentingNewLine]", \(wave\)}], "Input"], Cell[TextData[{ "For a drum of radius one, the boundar condition at the outer edge would be\ \n\n", StyleBox["u", FontSlant->"Italic"], "(1, ", StyleBox["t", FontSlant->"Italic"], ") = 0, ", StyleBox["t", FontSlant->"Italic"], " > 0\n\nsince the drumhead does not move at ", StyleBox["r", FontSlant->"Italic"], " = 1. We need another boundary condition, since the partial differential \ equation is second order in ", StyleBox["r", FontSlant->"Italic"], ". We will be able to determine an appropriate boundary condition as we \ solve the differential equation." }], "Text"], Cell[TextData[{ "We need to initial conditions, since the equation is second order in ", StyleBox["t", FontSlant->"Italic"], ". Let's assume the drumhead is initially displaced from equilibrium, but \ with no initial velocity.\n\n", StyleBox["u", FontSlant->"Italic"], "(", StyleBox["r", FontSlant->"Italic"], ", 0) = ", Cell[BoxData[ \(TraditionalForm\`u\_0\)]], "(", StyleBox["r", FontSlant->"Italic"], ")\n", Cell[BoxData[ \(TraditionalForm\`u\_t\)]], "(", StyleBox["r", FontSlant->"Italic"], ", 0) = 0." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Separation of Variables", "Section", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ Using the technique of separation of variables, let u(r,t) = v(r)w(t). \ Substituting into the wave equation,\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[{ \(Clear[v, w]\), "\[IndentingNewLine]", \(waveSeparable := D[v[r]\ w[t], {t, 2}] \[Equal] Div[c\^2\ Grad[v[r]]\ ] w[t]\), "\[IndentingNewLine]", \(waveSeparable\)}], "Input"], Cell["\<\ Notice that we can factor w[t] out of the right hand side and separate the \ functions of r from the functions of t.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(waveSeparable3 = waveSeparable[\([1]\)]\/\(c\^2\ v[r]\ \ w[t]\) \[Equal] Simplify[waveSeparable[\([2]\)]\/\(c\^2\ v[r]\ \ w[t]\)]\)], "Input"], Cell[TextData[{ "Since one side of the equation is a function of t and the other is a \ function of r, both must be a constant. Let's cheat and let that constant be \ -", Cell[BoxData[ \(TraditionalForm\`k\^2\)]], ". This will simplify the notation later." }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(timeDiffEqn = waveSeparable3[\([1]\)] \[Equal] \(-k\^2\)\)], "Input"], Cell[BoxData[ \(timeDiffEqn2 = timeDiffEqn[\([1]\)]*\((\(c\^2\) w[t])\) == timeDiffEqn[\([2]\)]*\((\(c\^2\) w[t])\)\)], "Input"], Cell[BoxData[ \(radiusDiffEqn = waveSeparable3[\([2]\)] \[Equal] \(-k\^2\)\)], "Input"], Cell["radiusDiffEqn = waveSeparable3[[2]] == -k^2", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(radiusDiffEqn2 = radiusDiffEqn[\([1]\)]*\((r\ v[r])\) == radiusDiffEqn[\([2]\)]*\((r\ v[r])\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Solution of the Ordinary Differential Equations", "Section", ImageRegion->{{0, 1}, {0, 1}}], Cell[CellGroupData[{ Cell["The Differential Equation in r", "Subsection", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ StyleBox[" Mathematica", FontSlant->"Italic"], " can solve the ordinary differential equation in r." }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["vSolution = DSolve[radiusDiffEqn2, v[r], r]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "This differential equation is called Bessel's equation and the solutions \ are the Bessel function of the first kind of order 0, ", Cell[BoxData[ \(TraditionalForm\`J\_0\)]], ", and the Bessel function of the second kind of order 0, ", Cell[BoxData[ \(TraditionalForm\`Y\_0\)]], " ." }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "Let's take a look at the graphs of the Bessel functions. The graph of ", Cell[BoxData[ \(TraditionalForm\`Y\_0\)]], " is" }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["Plot[BesselY[0,r], {r,0,1}];", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "It appears that ", Cell[BoxData[ \(TraditionalForm\`Y\_0\)]], " has a vertical asymptote at ", StyleBox["r", FontSlant->"Italic"], " = 0. In fact, ", Cell[BoxData[ \(TraditionalForm\`Y\_0\)]], " acts like Log[", StyleBox["r", FontSlant->"Italic"], "] as ", StyleBox["r", FontSlant->"Italic"], " \[LongRightArrow]", Cell[BoxData[ \(TraditionalForm\`\(0\^+\)\)]], "." }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ coefficient = \tLimit[BesselY[0,r]/Log[r], r -> 0, Direction -> -1]\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "Thus, near ", StyleBox["r", FontSlant->"Italic"], " = 0, ", Cell[BoxData[ \(TraditionalForm\`Y\_0\)]], " is approximately" }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["coefficient Log[r]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "Drumheads cannot have infinite displacements at their centers, so we must \ discard this solution; that is, we let C[1] = 0. (This gives us our second \ boundary condition in ", StyleBox["r", FontSlant->"Italic"], " -- ", StyleBox["v", FontSlant->"Italic"], "[", StyleBox["r", FontSlant->"Italic"], "] must be bounded at ", StyleBox["r", FontSlant->"Italic"], " = 0.)" }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["vSolution2 = vSolution /. {C[1] -> 0}", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "Our other boundary condition in r states that ", StyleBox["v", FontSlant->"Italic"], "[1] = 0; that is, the drumhead is stationary at the outer rim, ", StyleBox["r", FontSlant->"Italic"], " = 1. Substituting this condition, we get" }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ vBoundaryCondition = ((v[r] /. vSolution2[[1]]) /. {r -> 1}) == 0\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "Therefore, we need k to be a zero of ", Cell[BoxData[ \(TraditionalForm\`J\_0\)]], " . Let's plot ", Cell[BoxData[ \(TraditionalForm\`J\_0\)]], " get an idea of the locations of its zeroes." }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["Plot[BesselJ[0,k], {k,0,15}];", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "We can use Newton's method, FindRoot in ", StyleBox["Mathematica", FontSlant->"Italic"], ", to find the first few zeroes of ", Cell[BoxData[ \(TraditionalForm\`J\_0\)]], " . (To find the exact solution to our drumhead problem, we would have to \ find all of ", Cell[BoxData[ \(TraditionalForm\`J\_0\)]], " 's zeroes.) First we construct a list of initial guesses for the first \ four zeroes." }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["guesses = {2.5, 5.5, 9, 12}", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell["Now apply Newton's method to these initial guesses.", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(j0zeroes = Map[FindRoot[BesselJ[0, k] \[Equal] 0, {k, #}] &, guesses]\)], "Input"], Cell[TextData[{ " Using these values of k in ", Cell[BoxData[ \(TraditionalForm\`J\_0\)]], " , we have satisfied the differential equation in r and the boundary \ conditions. We now turn to the differential equation in ", StyleBox["t", FontSlant->"Italic"], " and the initial conditions." }], "Text", ImageRegion->{{0, 1}, {0, 1}}] }, Closed]], Cell[CellGroupData[{ Cell["The Differential Equation in t", "Subsection", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ The ordinary differential equation in time is an old friend.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ Clear[w] timeDiffEqn2\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell["Its solution is", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ Clear[wSolution,t] wSolution[t_] := c1 Sin[c k t] + c2 Cos[c k t]\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "We can satisfy the initial condition, ", Cell[BoxData[ \(TraditionalForm\`\[PartialD]\(u(r, \ 0)\)\/\[PartialD]t = \ 0\)]], " by setting" }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["initialVelocity = wSolution'[0] == 0", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "We know that neither the ", StyleBox["k", FontSlant->"Italic"], "'s nor ", StyleBox["c", FontSlant->"Italic"], " are zero, so we must set ", StyleBox["c", FontSlant->"Italic"], "1 = 0. So now" }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ Clear[wSolution,t] wSolution[t_] := c2 Cos[c k t]\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "Substituting the values of ", StyleBox["k", FontSlant->"Italic"], " we found in the previous section gives us a list of solutions to the wave \ equation, ", StyleBox["w", FontSlant->"Italic"], "[", StyleBox["t", FontSlant->"Italic"], "] ", StyleBox["v", FontSlant->"Italic"], "[", StyleBox["r", FontSlant->"Italic"], "]. ", "Since our differential equation is linear, any linear combination of the \ solutions in the list from the previous section is also a solution." }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(coefficients = Array[c, Length[j0zeroes]]\)], "Input"], Cell[BoxData[ \(solutions = wSolution[t]\/c2\ BesselJ[0, k\ r] /. j0zeroes\)], "Input"], Cell[BoxData[ \(solutionList = Thread[Times[coefficients, solutions]]\)], "Input"], Cell[BoxData[ \(solution = coefficients . solutions\)], "Input"], Cell[TextData[{ "This solution satisfies the boundary conditions ", StyleBox["u", FontSlant->"Italic"], "(0, t) bounded and ", StyleBox["u", FontSlant->"Italic"], "(1, t) = 0, and the initial condition ", Cell[BoxData[ \(TraditionalForm\`\[PartialD]\(u(r, \ 0)\)\/\[PartialD]t = \ 0\)]], "." }], "Text", ImageRegion->{{0, 1}, {0, 1}}] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Constructing a Series Solution", "Section", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "We have just one condition left: ", StyleBox["u", FontSlant->"Italic"], "(", StyleBox["r", FontSlant->"Italic"], ", 0) = ", Cell[BoxData[ \(TraditionalForm\`u\_0\)]], "(", StyleBox["r", FontSlant->"Italic"], "). ", "Suppose the initial displacement of the drum from equilibrium is" }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(u0[r_] := r\^2 - 1\)], "Input"], Cell["Then our initial condition becomes", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ initialDisplacement = \t(solution /. {t -> 0}) == u0[r]\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "The orthogonality relationship for the Bessel functions allows us to find \ the coefficients, ", StyleBox["c", FontSlant->"Italic"], "[", StyleBox["i", FontSlant->"Italic"], "], using the integral formula," }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(coef = Table[\(2\/BesselJ[1, j0zeroes[\([i, 1, 2]\)]]\^2\) \(\[Integral]\_0\%1 r\ u0[r]\ BesselJ[0, j0zeroes[\([i, 1, 2]\)]\ r]\ \[DifferentialD]r\), {i, Length[j0zeroes]}]\)], "Input"], Cell["Substituting these coefficients into our solution,", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(seriesTerms = Table[solutionList[\([i]\)] /. c[i] \[Rule] coef[\([i]\)], {i, Length[j0zeroes]}]\)], "Input"], Cell["\<\ These functions represent the fundamental tone and the first 3 overtones for \ the drum. Let's graph each of these for a radial slice of the drum.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(\(tonePlot = Table[Plot[ Evaluate[seriesTerms /. {c \[Rule] 1, t \[Rule] \[Tau]}], {r, 0, 1}, PlotRange \[Rule] {\(-1.2\), 1.2}, PlotStyle \[Rule] {Black, Red, Green, Blue}], {\[Tau], 0, 2.6, 0.2}];\)\)], "Input"], Cell[TextData[{ "Notice that the overtones are oscillating at a higher frequency than the \ fundamental tone. This is what causes the overtones to have a higher pitch. \ We can use ", StyleBox["Mathematica", FontSlant->"Italic"], " to play these tones as a function of t at r = 0. We need to change the \ value of c, say to c = 500, so that the frequencies will be within the \ audible range. Just double-click on the sound graphic to hear it play.\nHere \ is the fundamental tone," }], "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ tone1 = seriesTerms[[1]]/.{c -> 500, r -> 0}; Play[tone1, {t,0,0.5}];\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell["the first overtone,", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ tone2 = seriesTerms[[2]]/.{c -> 500, r -> 0}; Play[tone2, {t,0,0.5}];\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell["the second overtone,", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ tone3 = seriesTerms[[3]]/.{c -> 500, r -> 0}; Play[tone3, {t,0,0.5}];\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell["and the third overtone,", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ tone4 = seriesTerms[[4]]/.{c -> 500, r -> 0}; Play[tone4, {t,0,0.5}];\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[" We add these components to get the final solution.", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["seriesSolution = Apply[Plus,seriesTerms]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell["Here is a graph of the four tones together for c = 1", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["seriesSolution1 = seriesSolution/.{c -> 1}", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ drumPlot = Table[Plot[seriesSolution1, {r,0,1}, PlotRange -> {-1.3,1.3}], {t, 0, 2.6, 0.2}];\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}, AnimationDisplayTime->0.0833333], Cell["\<\ and here is the sound for the four tones added together, with c = 500.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ tone = seriesSolution/.{c -> 500, r -> 0}; Play[tone, {t,0,0.5}];\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ What! That doesn't sound like a drum! The problem is that drumheads are \ strongly damped and we did not include any damping in our model. The damped \ solution is shown below. Try playing this sound--feel free to stand up and \ march if you get the urge.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[{ \(\(solutionListDamped = Thread[Times[ Array[c, Length[j0zeroes]], \(\[ExponentialE]\^\(\(-a\)\ t\)\) Cos[\(\@\(c\^2\ k\^2 - a\^2\)\) t] BesselJ[0, k\ r] /. j0zeroes]];\)\), "\[IndentingNewLine]", \(\(solutionDamped = Apply[Plus, solutionListDamped];\)\), "\[IndentingNewLine]", \(\(seriesTermsDamped = Table[solutionListDamped[\([i]\)] /. {c[i] \[Rule] coef[\([i]\)]}, {i, Length[j0zeroes]}];\)\), "\[IndentingNewLine]", \(\(seriesSolutionDamped = Apply[Plus, seriesTermsDamped];\)\), "\[IndentingNewLine]", \(\(tone = seriesSolutionDamped /. {c \[Rule] 500, a \[Rule] 5, r \[Rule] 0};\)\), "\[IndentingNewLine]", \(\(Play[tone, {t, 0, 0.5}];\)\)}], "Input"], Cell["\<\ Of course, we cannot stop here. We are obliged to rotate this about the \ vertical axis and plot the actual drumhead.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["Needs[\"Graphics`ParametricPlot3D`\"]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(\(Table[ CylindricalPlot3D[ seriesSolution1, {r, 0, 1}, {\[Theta], 0, 2 \[Pi]}, PlotPoints \[Rule] {10, 10}, PlotRange \[Rule] {\(-1.2\), 1.2}], {t, 0, 2.6, .2}];\)\)], "Input"], Cell["\<\ The extra \"wobble\" that you see in the animation is due to the first \ overtone.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}] }, Closed]], Cell[CellGroupData[{ Cell["Exercises", "Section", ImageRegion->{{0, 1}, {0, 1}}], Cell[CellGroupData[{ Cell["Exercise 1", "Subsection", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "Construct a solution to the drumhead problem with zero initial \ displacement and initial velocity ", Cell[BoxData[ \(TraditionalForm\`\(u\_t\)(r, 0) = \(\(u\_1\)(r) = r\^2 - 1\)\)]], "." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Exercise 2", "Subsection", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ Does a square drumhead sound the same as a round drumhead? Prove your \ answer.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}] }, Closed]], Cell[CellGroupData[{ Cell["Exercise 3", "Subsection", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ Try to find an initial condition that would make the first overtone large \ compared to the fundamental tone. Hint: If you make the initial condition approximately equal to one of the \ terms in the solution, then the other terms in the solution will make small \ contributions. This is because the differential equation is linear.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}] }, Closed]], Cell[CellGroupData[{ Cell["Exercise 4", "Subsection", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "Solve the damped vibrating drumhead problem,\n\n", Cell[BoxData[ \(TraditionalForm\`u\_tt\)]], " + 2 ", StyleBox["a", FontSlant->"Italic"], " ", Cell[BoxData[ \(TraditionalForm\`u\_t\)]], " = Div[", Cell[BoxData[ \(TraditionalForm\`c\^2\ Grad[u]\)]], "]\n\n", StyleBox["u", FontSlant->"Italic"], "(0, ", StyleBox["t", FontSlant->"Italic"], ") is bounded, ", StyleBox["u", FontSlant->"Italic"], "(1, ", StyleBox["t", FontSlant->"Italic"], ") = 0\n", StyleBox["u", FontSlant->"Italic"], "(", StyleBox["r", FontSlant->"Italic"], ", 0) = ", Cell[BoxData[ \(TraditionalForm\`r\^2 - 1\)]], ", ", Cell[BoxData[ \(TraditionalForm\`\(u\_t\)(r, 0) = 0\)]] }], "Text"] }, Closed]] }, Closed]] }, FrontEndVersion->"5.0 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 695}}, AutoGeneratedPackage->None, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{803, 668}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False} ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1776, 53, 68, 1, 95, "Title"], Cell[1847, 56, 258, 9, 124, "Subtitle"], Cell[2108, 67, 152, 6, 66, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[2297, 78, 69, 1, 43, "Section"], Cell[2369, 81, 85, 1, 30, "Input"], Cell[2457, 84, 173, 4, 67, "Text"], Cell[2633, 90, 249, 5, 71, "Input"], Cell[2885, 97, 306, 11, 33, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[3228, 113, 83, 1, 43, "Section"], Cell[3314, 116, 90, 1, 33, "Text"], Cell[3407, 119, 146, 4, 48, "Input"], Cell[3556, 125, 74, 1, 33, "Text"], Cell[3633, 128, 191, 4, 51, "Input"], Cell[3827, 134, 335, 6, 52, "Text"], Cell[4165, 142, 191, 5, 71, "Input"], Cell[4359, 149, 617, 20, 128, "Text"], Cell[4979, 171, 582, 24, 109, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[5598, 200, 75, 1, 43, "Section"], Cell[5676, 203, 170, 4, 33, "Text"], Cell[5849, 209, 219, 5, 71, "Input"], Cell[6071, 216, 173, 4, 33, "Text"], Cell[6247, 222, 178, 3, 44, "Input"], Cell[6428, 227, 315, 8, 52, "Text"], Cell[6746, 237, 89, 1, 30, "Input"], Cell[6838, 240, 148, 3, 31, "Input"], Cell[6989, 245, 91, 1, 30, "Input"], Cell[7083, 248, 93, 1, 30, "Input"], Cell[7179, 251, 142, 3, 30, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[7358, 259, 99, 1, 43, "Section"], Cell[CellGroupData[{ Cell[7482, 264, 85, 1, 38, "Subsection"], Cell[7570, 267, 171, 5, 33, "Text"], Cell[7744, 274, 93, 1, 30, "Input"], Cell[7840, 277, 367, 10, 52, "Text"], Cell[8210, 289, 196, 6, 33, "Text"], Cell[8409, 297, 78, 1, 30, "Input"], Cell[8490, 300, 485, 21, 33, "Text"], Cell[8978, 323, 126, 4, 48, "Input"], Cell[9107, 329, 204, 9, 33, "Text"], Cell[9314, 340, 68, 1, 30, "Input"], Cell[9385, 343, 464, 17, 52, "Text"], Cell[9852, 362, 87, 1, 30, "Input"], Cell[9942, 365, 312, 9, 52, "Text"], Cell[10257, 376, 123, 3, 30, "Input"], Cell[10383, 381, 276, 9, 33, "Text"], Cell[10662, 392, 79, 1, 30, "Input"], Cell[10744, 395, 486, 14, 52, "Text"], Cell[11233, 411, 77, 1, 30, "Input"], Cell[11313, 414, 100, 1, 33, "Text"], Cell[11416, 417, 109, 2, 30, "Input"], Cell[11528, 421, 356, 10, 52, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[11921, 436, 85, 1, 30, "Subsection"], Cell[12009, 439, 120, 3, 33, "Text"], Cell[12132, 444, 79, 4, 48, "Input"], Cell[12214, 450, 64, 1, 33, "Text"], Cell[12281, 453, 123, 4, 48, "Input"], Cell[12407, 459, 211, 6, 36, "Text"], Cell[12621, 467, 86, 1, 30, "Input"], Cell[12710, 470, 282, 12, 33, "Text"], Cell[12995, 484, 107, 4, 48, "Input"], Cell[13105, 490, 575, 21, 52, "Text"], Cell[13683, 513, 74, 1, 30, "Input"], Cell[13760, 516, 91, 1, 42, "Input"], Cell[13854, 519, 86, 1, 30, "Input"], Cell[13943, 522, 68, 1, 30, "Input"], Cell[14014, 525, 364, 12, 36, "Text"] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell[14427, 543, 82, 1, 73, "Section"], Cell[14512, 546, 383, 16, 33, "Text"], Cell[14898, 564, 51, 1, 30, "Input"], Cell[14952, 567, 83, 1, 33, "Text"], Cell[15038, 570, 113, 4, 48, "Input"], Cell[15154, 576, 286, 10, 33, "Text"], Cell[15443, 588, 255, 5, 66, "Input"], Cell[15701, 595, 99, 1, 33, "Text"], Cell[15803, 598, 146, 3, 30, "Input"], Cell[15952, 603, 204, 4, 33, "Text"], Cell[16159, 609, 295, 6, 50, "Input"], Cell[16457, 617, 541, 11, 90, "Text"], Cell[17001, 630, 127, 4, 48, "Input"], Cell[17131, 636, 68, 1, 33, "Text"], Cell[17202, 639, 127, 4, 48, "Input"], Cell[17332, 645, 69, 1, 33, "Text"], Cell[17404, 648, 127, 4, 48, "Input"], Cell[17534, 654, 72, 1, 33, "Text"], Cell[17609, 657, 127, 4, 48, "Input"], Cell[17739, 663, 102, 1, 33, "Text"], Cell[17844, 666, 90, 1, 30, "Input"], Cell[17937, 669, 101, 1, 33, "Text"], Cell[18041, 672, 92, 1, 30, "Input"], Cell[18136, 675, 199, 7, 84, "Input"], Cell[18338, 684, 127, 3, 33, "Text"], Cell[18468, 689, 123, 4, 48, "Input"], Cell[18594, 695, 316, 6, 52, "Text"], Cell[18913, 703, 850, 18, 154, "Input"], Cell[19766, 723, 175, 4, 33, "Text"], Cell[19944, 729, 87, 1, 30, "Input"], Cell[20034, 732, 239, 5, 50, "Input"], Cell[20276, 739, 139, 4, 33, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[20452, 748, 61, 1, 43, "Section"], Cell[CellGroupData[{ Cell[20538, 753, 65, 1, 38, "Subsection"], Cell[20606, 756, 228, 6, 33, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[20871, 767, 65, 1, 30, "Subsection"], Cell[20939, 770, 137, 4, 33, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[21113, 779, 65, 1, 30, "Subsection"], Cell[21181, 782, 390, 7, 71, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[21608, 794, 65, 1, 30, "Subsection"], Cell[21676, 797, 781, 37, 128, "Text"] }, Closed]] }, Closed]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)