4515 Exam 1

Compute the eigenfunctions and eigenvalues for -Δϕ=λ ϕ  on the semi circular domain 0<θ<π and 0<r<1.

Homogeneous Dirichlet conditions all round the boundary.

Homogenous Dirichlet boundary conditions on the circular boundary and homogeneous Neumann conditions on the straight edge(s).

Homogeneous Neumann conditions on the circular boundary and homogeneous Dirichlet conditions on the straight edge(s).

Compute the eigenfunctions and eigenvalues of -Δϕ=λ ϕ with Dirichlet boundry conditions on the circular cylinder 0<r<(Subscript[r, max]), 0≤θ<2π, and 0<z<(Subscript[z, max]).   Do the pieces in the order θ, z, then r.

For each of the problems in Q1 plot the four eigenfunctions with the lowest eigenvalues.

Equations Q1 and Q3

TraditionalForm[Expand[ (r^2)(((Laplacian[ R[r] Θ[θ], {r, θ}, "Polar"])/(R[r] Θ[θ]))+λ)]
]

Separated Equations

For some constant μ we must have

((Θ''(θ))/(Θ(θ)))=-μ

λ (r^2)+(((r^2) R''(r))/(R(r)))+((r R'(r))/(R(r)))=μ

DSolve[ λ (r^2)R[r]+(r^2) R''[r]+r R'[r]==μ R[r],R[r],r]

1.1

{kMax,nMax}={3,4};
Rs= Table[ BesselJ[n,r],{n,1,nMax}];
Plot[ Rs,{r, 0, 23},
PlotLegends->Automatic,
PlotStyle->Table[Hue[n/nMax],{n,1,nMax}],
Epilog->Table[ 
{Hue[n/nMax],PointSize[0.025],
Table[ Point[{BesselJZero[n,k],0}],{k,1,kMax}]
},
{n,1,nMax}],
PlotLabel->"BesselZeros"
]

{λ1,λ2,λ3,λ4}={
BesselJZero[1,1],
BesselJZero[2,1],
BesselJZero[3,1],
BesselJZero[1,2]
}^2//N
{n,k,λ}={1,1,λ1};
SetOptions[ParametricPlot3D, PlotTheme->"Minimal"];
Pic1=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Sin[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}
];
{n,k,λ}={2,1,λ2};
Pic2=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Sin[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}
];
{n,k,λ}={3,1,λ3};
Pic3=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Sin[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}
];
{n,k,λ}={1,2,λ4};
Pic4=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Sin[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}];
GraphicsGrid[{{Pic1,Pic2},{Pic3,Pic4}},
Spacings->0,
Frame->All]

1.2

{kMax,nMax}={3,4};
Rs= Table[ BesselJ[n,r],{n,0,nMax}];
Plot[ Rs,{r, 0, 23},
PlotLegends->Range[0,nMax],
PlotStyle->Table[Hue[0.9(n/nMax)],{n,0,nMax}],
Epilog->Table[ 
{Hue[0.9(n/nMax)],PointSize[0.025],
Table[ Point[{BesselJZero[n,k],0}],{k,1,kMax}]
},
{n,0,nMax}],
PlotLabel->"BesselZeros"
]

{λ1,λ2,λ3,λ4}={
BesselJZero[0,1],
BesselJZero[1,1],
BesselJZero[2,1],
BesselJZero[0,2]
}^2//N
{n,k,λ}={1,1,λ1};
SetOptions[ParametricPlot3D, PlotTheme->"Minimal"];
Pic1=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Cos[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}
];
{n,k,λ}={2,1,λ2};
Pic2=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Cos[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}
];
{n,k,λ}={3,1,λ3};
Pic3=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Cos[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}
];
{n,k,λ}={1,2,λ4};
Pic4=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Cos[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}];
GraphicsGrid[{{Pic1,Pic2},{Pic3,Pic4}},
Spacings->0,
Frame->All]

1.3

Clear[n,λ,r,Rs]
D[BesselJ[n,r(Sqrt[λ])],r]
{kMax,nMax}={3,4};
RsDer=D[ Table[ BesselJ[n,r],{n,1,nMax}],r];
Plot[ RsDer,{r, 0, 17},
PlotLegends->Automatic,
PlotStyle->Table[Hue[n/nMax],{n,1,nMax}],
PlotLabel->"BesselJ'Zeros"
]

The lowest zeros are roughlt
n=1; k=1; λ~2
n=2; k=1; λ~3
n=3; k=1; λ~4
and a pretty close almost tie between
n=4; k=1; λ~5.2
and
n=1; k=2; λ~5.2
Accurate values are below

{
FindRoot[ RsDer[[1]]==0,{r,{2,5.2}}],
FindRoot[RsDer[[2]]==0,{r,3}],
FindRoot[ RsDer[[3]]==0,{r,4}],
FindRoot[ RsDer[[4]]==0,{r,5.2}]
}

Looks like the smallest are actualy the first zeros for n=1,2,3,4.  Pics are below.

{λ1,λ2,λ3,λ4}=(({1.8411837813406589`,3.0542369282271404`,4.201188941210528`,5.317553126083994`})^2);
{n,k,λ}={1,1,λ1};
SetOptions[ParametricPlot3D, PlotTheme->"Minimal"];
Pic1=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Sin[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}
];
{n,k,λ}={2,1,λ2};
Pic2=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Sin[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}
];
{n,k,λ}={3,1,λ3};
Pic3=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Sin[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}
];
{n,k,λ}={4,1,λ4};
Pic4=ParametricPlot3D[ {r Cos[θ],r Sin[θ],Sin[n θ] BesselJ[n, (Sqrt[λ]) r ]},
{θ,0, π},{r, 0, 1}];
GraphicsGrid[{{Pic1,Pic2},{Pic3,Pic4}},
Spacings->0,
Frame->All]

Equations Q2

TraditionalForm[Expand[ (r^2)(((Laplacian[ R[r] Θ[θ]Z[z], {r, θ,z}, "Cylindrical"])/(R[r] Θ[θ]Z[z]))+λ)]
]

Separated Equations

For some constant μ we must have

((Θ''(θ))/(Θ(θ)))=-μ1

((Z''(z))/(Z(z)))=-μ2

-μ1+λ (r^2)+(((r^2) R''(r))/(R(r)))-(r^2) μ2+((r R'(r))/(R(r)))=0

Clear[r,λ,n]
DSolve[ 
(-μ1+λ (r^2))R[r]+(r^2) R''[r]-(r^2) μ2 R[r]+r R'[r]==0,
R[r],r]

Details of sign argument for θ

Det[ (({{1-Cos[z], -Sin[z]}, {ω Sin[z], ω(1-Cos[z])}}))]
Plot[ 1- Cos[z], {z,0,24},
Ticks->{Range[4] 2π, Automatic}]

Det[ (({{1-Exp[z], 1-Exp[-z]}, {ω (1-Exp[z]), ω(-1+Exp[-z])}}))]
(* Divide by ω and 2 *)
Simplify[((Det[ (({{1-Exp[z], 1-Exp[-z]}, {ω (1-Exp[z]), ω(-1+Exp[-z])}}))])/(ω 2))]
Plot[-2 + (E^z)+(E^(-z)), {z,0,2},
Ticks->{Range[4] 2π, Automatic}]