NotebookDirectory[]

Please be patient with the following command. Or, press  Alt+.   and re-execute the command.

There are a lot of calculations in the notebook, so if you evaluate the entire notebook it will take a minute or two to finish. Alternatively, you can evaluate the notebook cell by cell.

Clear[NaMoVS,NaMoVT,NaMoVTv,x,y,t,lL,lK,m,n];

NaMoVS[x_,y_,lK_,lL_,m_,n_]:=Sin[((m π)/lK)x]Sin[((n π)/lL)y];

NaMoVT[t_,lK_,lL_,m_,n_]:=Cos[t*π*(Sqrt[((((m/lK)))^2)+(((((n )/lL)))^2)])];

NaMoVTv[t_,lK_,lL_,m_,n_]:=(1/(π*(Sqrt[((((m/lK)))^2)+(((((n )/lL)))^2)])))Sin[t*π*√(((((m/lK)))^2)+(((((n )/lL)))^2))];
vp={2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}

Manipulate[Plot3D[Evaluate[NaMoVS[x,y,lK,lL,m,n]NaMoVT[t,lK,lL,m,n]],{x,0,lK},{y,0,lL},PlotPoints->75,PlotRange->{{-0.1,2+.1},{-0.1,2.1},{-1.1,1.1}},BoxRatios->{1,1,.25},ImageSize->600],
{t,0,4Pi,(Pi/64.),AnimationRate->2},{{m,1},Range[10],ControlType->Setter},{{n,1},Range[10],ControlType->Setter},{{lK,1},0.1,2,ControlType->VerticalSlider,ControlPlacement->Right},{{lL,1},0.1,2,ControlType->VerticalSlider,ControlPlacement->Left}]

The eigenfunctions are orthogonal.

FullSimplify[Integrate[NaMoVS[x,y,lK,lL,m1,n1]NaMoVS[x,y,lK,lL,m2,n2],{x,0,lK},{y,0,lL}],And[m1∈Integers,n1∈Integers,m2∈Integers,n2∈Integers]]

FullSimplify[Integrate[Integrate[NaMoVS[x,y,lK,lL,m1,n1]NaMoVS[x,y,lK,lL,m1,n1],{x,0,lK}],{y,0,lL}],And[m1∈Integers,n1∈Integers,m2∈Integers,n2∈Integers]]

Initial shape 0

Clear[ff0];ff0[x_,y_]=10x y(1-x)(1-y)

cfs0[m_,n_]=FullSimplify[Integrate[4 ff0[x,y] NaMoVS[x,y,1,1,m,n],{x,0,1},{y,0,1}],And[m∈Integers,n∈Integers]]

Clear[uu0];

uu0[x_,y_,t_]=N[Sum[cfs0[m,n] NaMoVS[x,y,1,1,m,n]NaMoVT[t,1,1,m,n],{m,1,20},{n,1,20}]];

uu0[.2,.3,.4]

ff0[.5,.5]

How good is our approximation of the initial shape? Here is the answer:

Plot3D[Evaluate[ff0[x,y]-uu0[x,y,0]],{x,0,1},{y,0,1},PlotPoints->60,PlotRange->All,BoxRatios->{1,1,.5},ImageSize->400,Mesh->None,ViewPoint-> Dynamic[vp]]

Plot3D[Evaluate[uu0[x,y,0]],{x,0,1},{y,0,1},PlotRange->All,PlotPoints->30,BoxRatios->{1,1,.5},ImageSize->400,Mesh->None,ViewPoint-> Dynamic[vp]]

Integrate[Exp[x] y,{x,0,1},{y,0,2}]

Manipulate[Plot3D[uu0[x,y,t],{x,0,1},{y,0,1},PlotRange->{-0.75,0.75},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.1],ViewPoint-> {2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}],{t,0,4.20,.02,AnimationRate->.2},ControlPlacement->Top]

Clear[ani0]; 
ani0=Table[Plot3D[Evaluate[uu0[x,y,t]],{x,0,1},{y,0,1},PlotPoints->30,PlotRange->{-0.73,0.73},BoxRatios->{1,1,.5},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.1],ImageSize->800,Mesh->None,ViewPoint->{2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}],{t,0,7,0.05}];

(* Show[ani0[[#]],ImageSize->400]&/@Range[Length[ani0]] *) Show[ani0[[20]],ImageSize->400]

(* SetDirectory["C:\\Dropbox\\Work\\myweb\\Courses\\Math_pages\\Math_430"]; 

Export["Membrane0s1.gif",ani0[[1]],"GIF",{"ImageSize"->800}];

Export["Membrane0Ani.gif",ani0,"GIF","AnimationRepetitions"->0,"ImageSize"->800,"DisplayDurations"->0.3] 
*)

Initial shape 1

Clear[ff1];ff1[x_,y_]=10x y(1-x)(((1-y))^2)

cfs1[m_,n_]=FullSimplify[Integrate[4 ff1[x,y] NaMoVS[x,y,1,1,m,n],{x,0,1},{y,0,1}],And[m∈Integers,n∈Integers]]

Clear[uu1];

uu1[x_,y_,t_]=N[Sum[cfs1[m,n] NaMoVS[x,y,1,1,m,n]NaMoVT[t,1,1,m,n],{m,1,20},{n,1,20}]];

uu1[.2,.3,.4]

ff1[x,y]

How good is our approximation of the initial shape? Here is the answer:

Plot3D[Evaluate[ff1[x,y]-uu1[x,y,0]],{x,0,1},{y,0,1},PlotPoints->60,PlotRange->All,BoxRatios->{1,1,.5},ImageSize->400,Mesh->None,ViewPoint-> Dynamic[vp]]

Plot3D[Evaluate[uu1[x,y,0]],{x,0,1},{y,0,1},PlotRange->All,PlotPoints->30,BoxRatios->{1,1,.5},ImageSize->400,Mesh->None,ViewPoint-> Dynamic[vp]]

Manipulate[Plot3D[uu1[x,y,t],{x,0,1},{y,0,1},PlotRange->{-0.42,0.42},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.2],ViewPoint-> {2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}],{t,0,4.20,.05,AnimationRate->.2},ControlPlacement->Top]

AbsoluteTiming[Map[Plot3D[Evaluate[uu1[x,y,.4]],{x,0,1},{y,0,1},PlotPoints->30,PlotRange->{-0.42,0.42},BoxRatios->{1,1,.5},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.2],ImageSize->800,Mesh->None,ViewPoint->{2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}]&,Range[10]]][[1]]

Clear[ani1]; 
ani1=Table[Plot3D[Evaluate[uu1[x,y,t]],{x,0,1},{y,0,1},PlotPoints->30,PlotRange->{-0.42,0.42},BoxRatios->{1,1,.5},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.2],ImageSize->800,Mesh->None,ViewPoint->{2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}],{t,0,7,0.05}];

(*  SetDirectory["C:\\Dropbox\\Work\\myweb\\Courses\\Math_pages\\Math_430"]; 

Export["Membrane1s1.gif",ani1[[1]],"GIF",{"ImageSize"->800}];

Export["Membrane1Ani.gif",ani1,"GIF","AnimationRepetitions"->0,"ImageSize"->800,"DisplayDurations"->0.3] 

*)

Initial shape 2

Clear[ff2];ff2[x_,y_]=10x y(((1-x))^2)(((1-y))^2)

Plot3D[ff2[x,y],{x,0,1},{y,0,1},PlotRange->All]

Clear[cfs2]; 
cfs2[m_,n_]=FullSimplify[Integrate[4 ff2[x,y] NaMoVS[x,y,1,1,m,n],{x,0,1},{y,0,1}],And[m∈Integers,n∈Integers]]

Clear[uu2];
uu2[x_,y_,t_]=N[Sum[cfs2[m,n] NaMoVS[x,y,1,1,m,n]NaMoVT[t,1,1,m,n],{m,1,12},{n,1,12}]];

uu2[.2,.3,.4]

How good is our approximation of the initial shape? Here is the answer:

Plot3D[Evaluate[ff2[x,y]-uu2[x,y,0]],{x,0,1},{y,0,1},PlotPoints->60,PlotRange->All,BoxRatios->{1,1,.5},ImageSize->400,Mesh->None,ViewPoint-> Dynamic[vp]]

Plot3D[Evaluate[uu2[x,y,0]],{x,0,1},{y,0,1},PlotRange->All,PlotPoints->30,BoxRatios->{1,1,.5},ImageSize->400,Mesh->None,ViewPoint-> Dynamic[vp]]

Manipulate[Plot3D[Evaluate[uu2[x,y,t]],{x,0,1},{y,0,1},PlotRange->{-.26,.26},BoxRatios->{1,1,.5},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.2],ViewPoint-> {2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}],{t,0,7.1,.1,AnimationRate->.2},ControlPlacement->Top]

Clear[ani2]; 
ani2=Table[Plot3D[Evaluate[uu2[x,y,t]],{x,0,1},{y,0,1},PlotPoints->30,PlotRange->{-0.24,0.24},BoxRatios->{1,1,.5},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.2],ImageSize->800,Mesh->None,ViewPoint->{2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}],{t,0,7.1,0.05}];

Show[ani2[[1]],ImageSize->400]

(* SetDirectory["C:\\Dropbox\\Work\\myweb\\Courses\\Math_pages\\Math_430"]; 

Export["Membrane2s1.gif",ani2[[1]],"GIF",{"ImageSize"->800}];

Export["Membrane2Ani.gif",ani2,"GIF","AnimationRepetitions"->0,"ImageSize"->800,"DisplayDurations"->0.3] 

*)

Initial shape 2a

Clear[ff2a];ff2a[x_,y_]=(((16x y(1-x)(1-y)))^10)

Plot3D[ff2a[x,y],{x,0,1},{y,0,1},PlotRange->All]

Clear[cfs2a]; 

cfs2a[m_,n_]=FullSimplify[Integrate[4 ff2a[x,y] NaMoVS[x,y,1,1,m,n],{x,0,1},{y,0,1}],And[m∈Integers,n∈Integers]]

Clear[uu2a];

uu2a[x_,y_,t_]=N[Sum[cfs2a[m,n] NaMoVS[x,y,1,1,m,n]NaMoVT[t,1,1,m,n],{m,1,20},{n,1,20}]];

uu2a[.2,.3,.4]

How good is our approximation of the initial shape? Here is the answer:

Plot3D[Evaluate[ff2a[x,y]-uu2a[x,y,0]],{x,0,1},{y,0,1},PlotPoints->60,PlotRange->All,BoxRatios->{1,1,.5},ImageSize->400,Mesh->None,ViewPoint-> Dynamic[vp]]

Plot3D[Evaluate[uu2a[x,y,0]],{x,0,1},{y,0,1},PlotRange->All,PlotPoints->30,BoxRatios->{1,1,.5},ImageSize->400,Mesh->None,ViewPoint-> Dynamic[vp]]

Manipulate[Plot3D[Evaluate[uu2a[x,y,t]],{x,0,1},{y,0,1},PlotRange->{-1.1,1.1},BoxRatios->{1,1,.75},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.2],ViewPoint-> {2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}],{t,0,7.1,.1,AnimationRate->.2},ControlPlacement->Top]

Clear[ani2a]; 

ani2a=Table[Plot3D[Evaluate[uu2a[x,y,t]],{x,0,1},{y,0,1},PlotPoints->40,PlotRange->{-1.1,1.1},BoxRatios->{1,1,.75},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.2],ImageSize->800,Mesh->None,ViewPoint->{2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}],{t,0,7.1,0.05}];

Show[ani2a[[118]] ,ImageSize->400]

(* SetDirectory["C:\\Dropbox\\Work\\myweb\\Courses\\Math_pages\\Math_430"]; 

Export["Membrane2cs1.gif",ani2a[[1]],"GIF",{"ImageSize"->800}];

Export["Membrane2cAni.gif",ani2a,"GIF","AnimationRepetitions"->0,"ImageSize"->800,"DisplayDurations"->0.3] 

*)

Initial velocity

Plot[Exp[-(((4x))^2)],{x,-1,1},PlotRange->{0,1}]

Clear[gg];gg[x_,y_]=100x y(1-x)(1-y)Exp[-(((9x-2))^2)-(((8y-3))^2)]

vp={2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}

Plot3D[gg[x,y],{x,0,1},{y,0,1},PlotRange->All]

(* slow coeffs=Table[4 NIntegrate[gg[x,y] NaMoVS[x,y,1,1,m,n],{x,0,1},{y,0,1},MaxRecursion->300,AccuracyGoal->10,PrecisionGoal->6,WorkingPrecision->$MachinePrecision,Method->{"MultidimensionalRule","Generators"->9}],{m,1,6},{n,1,6}] slow *)

Clear[coeffs3];
coeffs3=Quiet[Table[4NIntegrate[gg[x,y] NaMoVS[x,y,1,1,m,n],{x,0,1},{y,0,1},Method->{Automatic,"SymbolicProcessing"->0}],{m,1,10},{n,1,10}]]

Clear[uu3];

uu3[x_,y_,t_]=N[Sum[coeffs3[[m,n]] NaMoVS[x,y,1,1,m,n]NaMoVTv[t,1,1,m,n],{m,1,Length[coeffs3]},{n,1,Length[coeffs3]}]];

uu3[.2,.3,.3]

How good is our approximation of the initial shape? Here is the answer:

Plot3D[Evaluate[gg[x,y]-D[uu3[x,y,t],t]/.{t->0}],{x,0,1},{y,0,1},PlotPoints->30,PlotRange->All,BoxRatios->{1,1,.5},ImageSize->400,Mesh->None,ViewPoint-> Dynamic[vp]]

Plot3D[Evaluate[D[uu3[x,y,t],t]/.{t->0}],{x,0,1},{y,0,1},PlotRange->All,PlotPoints->30,BoxRatios->{1,1,.5},ImageSize->400,Mesh->None,ViewPoint-> Dynamic[vp]]

Manipulate[Plot3D[Evaluate[uu3[x,y,t]],{x,0,1},{y,0,1},PlotRange->{-0.23,0.27},BoxRatios->{1,1,.5},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.2],ViewPoint-> {2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}],{t,0,7,.05},ControlPlacement->Top]

(* ani3=Table[Plot3D[Evaluate[uu3[x,y,t]],{x,0,1},{y,0,1},PlotPoints->Automatic,PlotRange->{-0.23,0.27},BoxRatios->{1,1,.5},Boxed->False,Axes->False,PlotLabel->TableForm[{"t=",NumberForm[t,{3,2}]},TableDirections->Row,TableSpacing->0.2],ImageSize->800,Mesh->None,ViewPoint->{2.3790458212203394`,-1.9562027351402624`,1.4012179843135848`}],{t,0,7,0.05}]; *)

(* SetDirectory["C:\\Dropbox\\Work\\myweb\\Courses\\Math_pages\\Math_430"] ;

Export["Membrane3s1.gif",ani3[[1]],"GIF",{"ImageSize"->800}];

Export["Membrane3Ani.gif",ani3,"GIF","AnimationRepetitions"->0,"ImageSize"->800,"DisplayDurations"->0.3] 
 *)