NotebookFileName[]

NotebookDirectory[]

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

Burgers’ equation

ChVecFiBE[{x_,t_,z_}]={z,1,0}

VPbe={0.8937514594363056`,-2.8253081061674683`,1.6336592159871852`}

f(x) = Exp[-(x^2)]

Clear[solbe];
solbe[s_,ξ_]=FullSimplify[{x[s],t[s],z[s]}/.DSolve[{x'[s]==z[s],t'[s]==1,z'[s]==0,x[0]==ξ,t[0]==0,z[0]==Exp[-(ξ^2)]},{x[s],t[s],z[s]},s][[1]]]

solbe[s,ξ][[{1,2}]]

BurgersPrChar=ParametricPlot[Evaluate[Table[solbe[s,ξ][[{1,2}]],{ξ,-2,3,.05}]],{s,0,6},PlotStyle->{Thickness[0.002]},AxesLabel->{x,t},PlotRange->{{-2,3},{0,2}},ImageSize->600,AspectRatio->Automatic]

(* Export["BurgersPrChar.png",BurgersPrChar,"PNG",ImageResolution->1200] *)

BurgersPrCharHL=ParametricPlot[Evaluate[Table[solbe[s,ξ][[{1,2}]],{ξ,-2,3,.05}]],{s,0,6},PlotStyle->{Thickness[0.002]},Epilog->{{Red,Line[{{-3,1},{5,1}}]}},AxesLabel->{x,t},PlotRange->{{-2,3},{0,2}},ImageSize->600,AspectRatio->Automatic]

(* Export["BurgersPrCharHL.png",BurgersPrCharHL,"PNG",ImageResolution->1200] *)

ParametricPlot[Evaluate[Table[solbe[s,ξ][[{1,2}]],{ξ,-9,3,.05}]],{s,0,6},PlotStyle->{Thickness[0.002]},Epilog->{{Red,Line[{{-3,1},{5,1}}]}},AxesLabel->{x,t},PlotRange->{{-2,3},{0,2}},ImageSize->600]

From this plot it is clear that (Subscript[t, m])>1.  Next we will try to find the exact value of (Subscript[t, m]).

First look at the surface that we found.

solbe[s,ξ]

This is a parametric equation of a surface in xtz-space.

BurgersSur=Show[ParametricPlot3D[{x,0,Exp[-x^2]},{x,-2,3},PlotStyle->{Thickness[0.01],RGBColor[0,0.6,0]}],ParametricPlot3D[solbe[s,ξ],{ξ,-2,3},{s,0,2},PlotPoints->{140,60},Mesh->{50,35}],Ticks->{
Range[-2,3,1],
Range[0,2,0.5],
Range[0,1,0.5]
},PlotRange->{{-2,3},{0,2},{0,1.1}},PlotRangePadding->{0,0},ImageSize->600,AxesLabel->{"x","t","z"},AxesEdge->{{-1,-1},{-1,1},{1,1}}]

(* Export["BurgersSur.png",BurgersSur,"PNG",ImageResolution->1200]  *)

BurgersFun=Show[ParametricPlot3D[{x,0,Exp[-x^2]},{x,-2,3},PlotStyle->{Thickness[0.01],RGBColor[0,0.6,0]}],ParametricPlot3D[solbe[s,ξ],{ξ,-2,3},{s,0,(Sqrt[(E/2)])},PlotPoints->{140,60},Mesh->{50,35}],Ticks->{
Range[-2,3,1],
{0,(1/2),(3/4),(Sqrt[(E/2)])},
Range[0,1,0.5]
},PlotRange->{{-2,3},{0,(Sqrt[(E/2)])},{0,1.1}},PlotRangePadding->{0,0},ImageSize->600,AxesLabel->{"x","t","z"},AxesEdge->{{-1,-1},{-1,1},{1,1}}]

(* Export["BurgersFun.png",BurgersFun,"PNG",ImageResolution->1200]  *)

solbe[s0,ξ][[{1,3}]]

Manipulate[ParametricPlot[{(E^(-(ξ^2))) s0+ξ,(E^(-(ξ^2)))},{ξ,-2,3},PlotPoints->150,PlotStyle->{Thickness[0.005],RGBColor[0,0,0.6]},
PlotLabel->TableForm[{"t=",NumberForm[s0,{3,2}]},TableDirections->Row,TableSpacing->0.1],Ticks->{Range[-2,3,1],{0,0.5,1}},GridLines->{Range[-2,3,0.2],Range[0,1.2,0.2]},PlotRange->{{-2,3},{-0.05,1.2}},ImageSize->800,AspectRatio->Automatic],{s0,0.,2.33},ControlPlacement->Top]

BurgersEvoAniS1=ParametricPlot[{(E^(-(ξ^2))) 0+ξ,(E^(-(ξ^2)))},{ξ,-2,3},PlotPoints->150,PlotStyle->{Thickness[0.005],RGBColor[0,0.6,0]},
PlotLabel->TableForm[{"t=",NumberForm[0.,{4,3}]},TableDirections->Row,TableSpacing->0.1],Ticks->{Range[-2,3,1],{0,0.5,1}},PlotRange->{{-2,3},{-0.05,1.2}},ImageSize->800,AspectRatio->Automatic]

N[2(Sqrt[(E/2)])]

N[((2(Sqrt[(E/2)]))/100)]

BurgersEvoAni=Table[ParametricPlot[{(E^(-(ξ^2))) s0+ξ,(E^(-(ξ^2)))},{ξ,-2,3},PlotPoints->150,PlotStyle->{Thickness[0.005],RGBColor[0,0,0.6]},
PlotLabel->TableForm[{"t=",NumberForm[s0,{4,3}]},TableDirections->Row,TableSpacing->0.1],Ticks->{Range[-2,3,1],{0,0.5,1}},PlotRange->{{-2,3},{-0.05,1.2}},ImageSize->800,AspectRatio->Automatic],{s0,0.,2(Sqrt[(E/2)]),((2(Sqrt[(E/2)]))/200)}];

FullSimplify[Range[0,2(Sqrt[(E/2)]),((2(Sqrt[(E/2)]))/200)][[101]]]

N[(Sqrt[(E/2)])]

Length[BurgersEvoAni]

BurgersEvoAni[[101]]

200*0.15

Join[{a},{b},{c}]

Range[21]

dds=Join[0.15&/@Range[99],{0.5,2,0.5},0.15&/@Range[99]];

(* Export["BurgersEvoAniS1.png",BurgersEvoAniS1,"ImageSize"->800] *)

(* Export["BurgersEvoAni.png",BurgersEvoAni,"AnimationRepetitions"->Infinity,"ImageSize"->800,"DisplayDurations"->dds] *)

D[solbe[t,ξ][[{1,3}]],ξ]

{(1/t)-2 (E^(-(ξ^2))) ξ,0}

Solve[D[2 (E^(-(ξ^2))) ξ,ξ]==0,ξ]

{(1/t)-2 (E^(-(ξ^2))) ξ,0}/.{ξ->(1/(Sqrt[2]))}

Solve[-(Sqrt[(2/E)])+(1/t)==0,t]

N[(Sqrt[(E/2)])]

Manipulate[ParametricPlot[solbe[t,ξ][[{1,3}]],{ξ,-2,3},PlotPoints->150,PlotRange->{{-2,3},{0,1.5}},ImageSize->600],{{t,0},-1,3},ControlPlacement->Top]

Manipulate[ParametricPlot[solbe[t,ξ][[{1,3}]],{ξ,-2,3},PlotPoints->150,
Epilog->{{Arrow[{{(E^(-((ξ0)^2))) t+ξ0,(E^(-((ξ0)^2)))},{(E^(-((ξ0)^2))) t+ξ0,(E^(-((ξ0)^2)))}+{1-2 (E^(-((ξ0)^2))) t ξ0,-2 (E^(-((ξ0)^2))) ξ0}}]}},
PlotRange->{{-2,3},{-1,1.5}},ImageSize->600],{{t,0},-1,3},{{ξ0,0},-2,3},ControlPlacement->Top]

D[solbe[t,ξ][[{1,3}]],ξ]

D[solbe[t,ξ][[{1,3}]],ξ][[1]]

Solve[1-2 (E^(-(ξ^2))) t ξ==0,t]

Manipulate[Plot[1-2 (E^(-(ξ^2))) t ξ,{ξ,-1,3},PlotRange->{-0.2,1.5}],{t,0,2}]

FullSimplify[D[1-2 (E^(-(ξ^2))) t ξ,ξ]]

Solve[-2 (E^(-(ξ^2))) t+4 (E^(-(ξ^2))) t (ξ^2)==0,ξ]

FullSimplify[D[1-2 (E^(-(ξ^2))) t ξ,{ξ,2}]/.{ξ->(1/(Sqrt[2]))}]

Which is positive.

(1-2 (E^(-(ξ^2))) t ξ)/.{ξ->(1/(Sqrt[2]))}

Solve[1-(Sqrt[(2/E)]) t==0,t]

-D[(E^(-(ξ^2))),ξ]

Plot[2 (E^(-(ξ^2))) ξ,{ξ,-5,5}]

FullSimplify[D[-D[(E^(-(ξ^2))),ξ],ξ]]

Solve[(E^(-(ξ^2))) (2-4 (ξ^2))==0,ξ]

(-D[(E^(-(ξ^2))),ξ])/.{ξ->(1/(Sqrt[2]))}

(1/(Sqrt[(2/E)]))

BurgersPrChar1=ParametricPlot[Evaluate[Table[solbe[s,ξ][[{1,2}]],{ξ,-2,3,.05}]],{s,0,6},PlotStyle->{Thickness[0.002]},AxesLabel->{x,t},PlotRange->{{-2,3},{0,2.5}},ImageSize->600,AspectRatio->Automatic]

(* Export["BurgersPrChar1.png",BurgersPrChar1,"PNG",ImageResolution->1200] *)

solbe[s,ξ][[{1,2}]]

FullSimplify[D[{((1+2 (ξ^2))/(2 ξ)),((E^(ξ^2))/(2 ξ))},ξ]]

N[(1/(Sqrt[2]))]

{1-(1/(2 (ξ^2))),(1/2) (E^(ξ^2)) (2-(1/(ξ^2)))}/.{ξ->(1/(Sqrt[2]))}

{((1+2 (ξ^2))/(2 ξ)),((E^(ξ^2))/(2 ξ))}/.{ξ->(1/(Sqrt[2]))}

{(E^(-(ξ^2))) s+ξ,s}/.{s->(Sqrt[(E/2)])}

{((1+2 (ξ^2))/(2 ξ)),((E^(ξ^2))/(2 ξ))}

{(E^(-(ξ^2))) s+ξ,s}/.{s->((E^(t^2))/(2 t))}

{((1+2 (ξ^2))/(2 ξ)),((E^(ξ^2))/(2 ξ))}/.{ξ->t}

Solve[{((E^((t^2)-(ξ^2)))/(2 t))+ξ==((1+2 (t^2))/(2 t))},ξ]

{(Sqrt[2]),(Sqrt[(E/2)])}

{(E^(-(ξ^2))) s+ξ,s}

{(E^(-(ξ^2))) s+ξ,s}/.{s-> (Sqrt[(E/2)])}

FindRoot[((E^((1/2)-(ξ^2)))/(Sqrt[2]))+ξ==(Sqrt[2]),{ξ,1}]

((1+2 (ξ^2))/(2 ξ)),((E^(ξ^2))/(2 ξ))

Solve[x==((1+2 (ξ^2))/(2 ξ)),ξ]

FullSimplify[((E^(ξ^2))/(2 ξ))/.{ξ->(1/2) (x+(Sqrt[-2+(x^2)]))}]

FullSimplify[((E^(ξ^2))/(2 ξ))/.{ξ->(1/2) (x-(Sqrt[-2+(x^2)]))}]

BurgersPrCharEnv=Show[ParametricPlot[Evaluate[Table[solbe[s,ξ][[{1,2}]],{ξ,-2,3,.05}]],{s,0,6},PlotStyle->{Thickness[0.002]}],ParametricPlot[Evaluate[{((1+2 (ξ^2))/(2 ξ)),((E^(ξ^2))/(2 ξ))}],{ξ,0.15,3(1/(Sqrt[2]))},PlotPoints->200,PlotStyle->{RGBColor[0,0,0.6],Thickness[0.004]}],Prolog->{{Red,Line[{{-3,(Sqrt[(E/2)])},{5,(Sqrt[(E/2)])}}]}},PlotRange->{{-2,3},{0,2.5}},PlotRangePadding->{0,0}, AspectRatio->Automatic,AxesLabel->{x,t},ImageSize->600]

(* Export["BurgersPrCharEnv.png",BurgersPrCharEnv,"PNG",ImageResolution->1200] *)

solbe[s,ξ]

{((1+2 (ξ^2))/(2 ξ)),((E^(ξ^2))/(2 ξ))}

{(E^(-(ξ^2))) s+ξ,s,(E^(-(ξ^2)))}/.{s-> ((E^(ξ^2))/(2 ξ))}

{(E^(-(ξ^2))) s+ξ,s,(E^(-(ξ^2)))}

{((1+2 (ξ^2))/(2 ξ)),((E^(ξ^2))/(2 ξ))}/.{ξ->t}

{(E^(-(ξ^2))) s+ξ,s,(E^(-(ξ^2)))}

{(E^(-(ξ^2))) ((E^(t^2))/(2 t))+ξ,((E^(t^2))/(2 t)),(E^(-(ξ^2)))}

Solve[(E^(-(ξ^2))) ((E^(t^2))/(2 t))+ξ==((1+2 (t^2))/(2 t)),t]

Solve[(E^((t^2)-(ξ^2)))+2 t ξ==1+2 (t^2),t]

Solve[(E^((t^2)-(ξ^2)))+2 t (ξ-t)==1,ξ]

Show[ContourPlot[(E^((t^2)-(ξ^2)))+2 t (ξ-t)==1,{ξ,-1,5},{t,0,5}],Plot[If[x<0,1.2-0.7x,(1.2/(x+1))],{x,-1,5},PlotStyle->{Green}],PlotRange->{{-1,5},{0,5}}]

7

{#,(((E^(t^2))/(2 t)))/.FindRoot[(E^((t^2)-((#)^2)))+2 t (#-t)==1,{t,(1.2/(#+1))}]}&[3]

({(E^(-((#)^2))) (((E^(t^2))/(2 t)))+#,(((E^(t^2))/(2 t))),(E^(-((#)^2)))}/.FindRoot[(E^((t^2)-((#)^2)))+2 t (#-t)==1,{t,If[#<0,1.2-0.7#,(1.2/(#+1))]}])&[6]

Table[{ξ,(((E^(t^2))/(2 t)))/.FindRoot[(E^((t^2)-(ξ^2)))+2 t (ξ-t)==1,{t,(1.2/(ξ+1))}]},{ξ,0,3,(1/10)}]

ft=Interpolation[Table[{ξ,(((E^(t^2))/(2 t)))/.FindRoot[(E^((t^2)-(ξ^2)))+2 t (ξ-t)==1,{t,(1.2/(ξ+1))}]},{ξ,0,3,.001}]]

ft[1]

{(E^(-(ξ^2))) ft[ξ]+ξ,ft[ξ],(E^(-(ξ^2)))}

BurgersFunMax0=Show[ParametricPlot3D[{x,0,Exp[-x^2]},{x,-2,3},PlotStyle->{Thickness[0.005],RGBColor[0,0.6,0]}],ParametricPlot3D[solbe[s,ξ],{ξ,-2,3},{s,0,2.5},PlotPoints->{140,60},Mesh->{50,35}],ParametricPlot3D[{(1/(2 ξ))+ξ,((E^(ξ^2))/(2 ξ)),(E^(-(ξ^2)))},{ξ,0.1,5},PlotStyle->{Thickness[0.005],RGBColor[0,0,0.6]}],ParametricPlot3D[Re[{(E^((1/2) ProductLog[-(1/(2 (s^2)))])) s+((-I (Sqrt[ProductLog[-(1/(2 (s^2)))]]))/(Sqrt[2])),s,(E^((1/2) ProductLog[-(1/(2 (s^2)))]))}],{s,(Sqrt[(E/2)]),5},PlotStyle->{Thickness[0.005],RGBColor[0,0,0.6]}],ParametricPlot3D[({(E^(-((#)^2))) (((E^(t^2))/(2 t)))+#,(((E^(t^2))/(2 t))),(E^(-((#)^2)))}/.FindRoot[(E^((t^2)-((#)^2)))+2 t (#-t)==1,{t,If[#<0,1.2-0.7#,(1.2/(#+1))]}])&[ξ],{ξ,-0.6,3},PlotPoints->2000,PlotStyle->{Thickness[0.005],RGBColor[0.7,0,0]}],Ticks->{
Range[-2,3,1],
Range[0,3,0.5],
Range[0,1,0.5]
},PlotRange->{{-2,3},{0,2.5},{0,1.1}},PlotRangePadding->{0,0},ImageSize->600,AxesLabel->{"x","t","z"},AxesEdge->{{-1,-1},{-1,1},{1,1}}]

(* Export["BurgersFunMax0.png",BurgersFunMax0,"PNG",ImageResolution->1200] *)

BurgersFunMax0//AbsoluteOptions

(* Export["BurgersFunMax0.png",BurgersFunMax0,"PNG",ImageResolution->1200] *)

RegionFunction->Function[{x,y,z},1<x^2+y^2<9],

{((1+2 (ξ^2))/(2 ξ)),((E^(ξ^2))/(2 ξ))}

{(E^(-(ξ^2))) ft[ξ]+ξ,ft[ξ],(E^(-(ξ^2)))}/.{ξ->0}

BurgersFunMaxEnv=Show[ParametricPlot3D[{x,0,Exp[-x^2]},{x,-2,3},PlotStyle->{Thickness[0.005],RGBColor[0,0.6,0]}],ParametricPlot3D[solbe[s,ξ],{ξ,-2,3},{s,0,3},PlotPoints->{140,60},Mesh->{50,35},RegionFunction->Function[{x,y,z},Not[And[x>(Sqrt[2]),(1/2) (E^((1/4) (((x-(Sqrt[-2+(x^2)])))^2))) (x+(Sqrt[-2+(x^2)]))<y,y<((E^((1/4) (((x+(Sqrt[-2+(x^2)])))^2)))/(x+(Sqrt[-2+(x^2)])))]]]],
ParametricPlot3D[{(1/(2 ξ))+ξ,((E^(ξ^2))/(2 ξ)),0},{ξ,0.1,5},PlotStyle->{Thickness[0.005],RGBColor[0,0,0.6]}],
ParametricPlot3D[({(E^(-((#)^2))) (((E^(t^2))/(2 t)))+#,(((E^(t^2))/(2 t))),(E^(-((#)^2)))}/.FindRoot[(E^((t^2)-((#)^2)))+2 t (#-t)==1,{t,If[#<0,1.2-0.7#,(1.2/(#+1))]}])&[ξ],{ξ,-0.505,3},PlotPoints->2000,PlotStyle->{Thickness[0.005],RGBColor[0.6,0,0]}],Ticks->{
Range[-2,3,1],
Range[0,2,0.5],
Range[0,1,0.5]
},PlotRange->{{-2,3},{0,3},{0,1.1}},PlotRangePadding->{0,0},ImageSize->600,AxesLabel->{"x","t","z"},AxesEdge->{{-1,-1},{-1,1},{1,1}}]

(* Export["BurgersFunMax1.png",,"PNG",ImageResolution->1200] *)

BurgersFunMax=Show[ParametricPlot3D[{x,0,Exp[-x^2]},{x,-2,3},PlotStyle->{Thickness[0.005],RGBColor[0,0.6,0]}],ParametricPlot3D[solbe[s,ξ],{ξ,-2,3},{s,0,3},PlotPoints->{140,60},Mesh->{50,35},RegionFunction->Function[{x,y,z},Not[And[x>(Sqrt[2]),(1/2) (E^((1/4) (((x-(Sqrt[-2+(x^2)])))^2))) (x+(Sqrt[-2+(x^2)]))<y,y<((E^((1/4) (((x+(Sqrt[-2+(x^2)])))^2)))/(x+(Sqrt[-2+(x^2)])))]]]],
ParametricPlot3D[({(E^(-((#)^2))) (((E^(t^2))/(2 t)))+#,(((E^(t^2))/(2 t))),(E^(-((#)^2)))}/.FindRoot[(E^((t^2)-((#)^2)))+2 t (#-t)==1,{t,If[#<0,1.2-0.7#,(1.2/(#+1))]}])&[ξ],{ξ,-0.505,3},PlotPoints->2000,PlotStyle->{Thickness[0.005],RGBColor[0.6,0,0]}],Ticks->{
Range[-2,3,1],
Range[0,2,0.5],
Range[0,1,0.5]
},PlotRange->{{-2,3},{0,3},{0,1.1}},PlotRangePadding->{0,0},ImageSize->600,AxesLabel->{"x","t","z"},AxesEdge->{{-1,-1},{-1,1},{1,1}}]

f(x) = ArcTan[x]

Clear[solbe1];
solbe1[s_,ξ_]=FullSimplify[{x[s],t[s],z[s]}/.DSolve[{x'[s]==z[s],t'[s]==1,z'[s]==0,x[0]==ξ,t[0]==0,z[0]==ArcTan[ξ]},{x[s],t[s],z[s]},s][[1]]]

ParametricPlot[Evaluate[Table[solbe1[s,ξ][[{1,2}]],{ξ,-9,3,.05}]],{s,0,6},PlotStyle->{Thickness[0.002]},PlotRange->{{-2,3},{0,2}},ImageSize->600]

ParametricPlot[Evaluate[Table[solbe1[s,ξ][[{1,2}]],{ξ,-9,9,.05}]],{s,-6,6},PlotStyle->{Thickness[0.002]},Epilog->{{Red,Line[{{-3,1},{5,1}}]}},PlotRange->{{-2,3},{-2,2}},ImageSize->600]

First look at the surface that we found.

solbe1[s,ξ]

Solve[{x==ξ+s ArcTan[ξ],y==s,z==ArcTan[ξ]},{ξ,s,z}]

Manipulate[Plot[Tan[z]+y z,{z,-Pi/2,Pi/2},PlotRange->{-2,2}],{y,0,2}]

This is a parametric equation of a surface in xtz-space.

ParametricPlot3D[solbe1[s,ξ],{ξ,-2,3},{s,0,2},PlotPoints->{70,30},PlotRange->{{-2,3},{0,2}},ImageSize->600,AxesLabel->{"x","t","z"}]

Manipulate[ParametricPlot[solbe[s0,ξ][[{1,3}]],{ξ,-2,3},PlotPoints->150,PlotRange->{{-2,3},{-1.5,1.5}},ImageSize->600],{s0,0,3},ControlPlacement->Top]

Manipulate[ParametricPlot[solbe[t,ξ][[{1,3}]],{ξ,-2,3},PlotPoints->150,PlotRange->{{-2,3},{0,1.5}},ImageSize->600],{{t,0},-1,3},ControlPlacement->Top]

Manipulate[ParametricPlot[solbe[t,ξ][[{1,3}]],{ξ,-2,3},PlotPoints->150,
Epilog->{{Arrow[{{(E^(-((ξ0)^2))) t+ξ0,(E^(-((ξ0)^2)))},{(E^(-((ξ0)^2))) t+ξ0,(E^(-((ξ0)^2)))}+{1-2 (E^(-((ξ0)^2))) t ξ0,-2 (E^(-((ξ0)^2))) ξ0}}]}},
PlotRange->{{-2,3},{-1,1.5}},ImageSize->600],{{t,0},-1,3},{{ξ0,0},-2,3},ControlPlacement->Top]

D[solbe[t,ξ][[{1,3}]],ξ]

D[solbe[t,ξ][[{1,3}]],ξ][[1]]

Solve[1-2 (E^(-(ξ^2))) t ξ==0,t]

Manipulate[Plot[1-2 (E^(-(ξ^2))) t ξ,{ξ,-1,3},PlotRange->{-0.2,1.5}],{t,0,2}]

FullSimplify[D[1-2 (E^(-(ξ^2))) t ξ,ξ]]

Solve[-2 (E^(-(ξ^2))) t+4 (E^(-(ξ^2))) t (ξ^2)==0,ξ]

FullSimplify[D[1-2 (E^(-(ξ^2))) t ξ,{ξ,2}]/.{ξ->(1/(Sqrt[2]))}]

Which is positive.

(1-2 (E^(-(ξ^2))) t ξ)/.{ξ->(1/(Sqrt[2]))}

Solve[1-(Sqrt[(2/E)]) t==0,t]