This notebook is saved with all output deleted. To recreate all the calculations and the pictures go to the menu item 
     Evaluation-> Evaluate notebook ( the shortcut is Alt v + o )

To evaluate an individual cells use Shift+Enter

When you are done, before saving the notebook, delete all output by menu item Cell->Delete all output ( shortcut  Alt c + l )

NotebookDirectory[]

NotebookFileName[]

Burgers’ Equation

The PDE  

u(x,t)((∂u)/(∂x))(x,t)+((∂u)/(∂t))(x,t)=0

is called Burgers’ equation.  This is NOT a linear equation.  In this equation instead of the independent variable y we write t since it is convenient to think of it as time.

We will consider this equation subject to the initial condition 

u(x,0) = f(x)   where  x ∈ℝ.  (To make illustrations in Mathematica we will choose  f(x) = Exp[-(x^2)].

The vector field that we need for the characteristic equations of this equation is <z,1,0>.

VPbe={1.3`,-2.4`,2.`} (* Here we are setting the ViewPoint for the 3D plot below. It is a technical thing in Mathematica. This is the default ViewPoint which I will change below, trying to improve the image. *)

ChVecFiBE[{x_,t_,z_}]={z,1,0} (* Here we are naming the vector field that we are studing. *)

VPbe={0.8937514594363056`,-2.8253081061674683`,1.6336592159871852`} (* Here we are resetting the ViewPoint for the 3D plot below. *)

vecsbe=VectorPlot3D[ChVecFiBE[{x,t,z}],{x,-2,3},{t,0,2},{z,-0,1.5},
VectorColorFunction->(RGBColor[0,0.5,0.5]&),VectorColorFunctionScaling->False,VectorStyle->{Opacity[0.75],Thickness[0.006]},VectorPoints->{8,12,8} ,VectorScale->{0.07,Scaled[0.6]},BoxRatios->{2,2,1},PlotRange->{{-2,2},{0,2},{0,1.5}},ImageSize->500,ViewPoint-> Dynamic[VPbe]]

VPbe

Now we need to solve the initial value problem for the characteristic equations. For that we will specify the initial condition for the Burgers’ equation. We choose u[x,0] = 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]]]

The above triple, for a fixed ξ and for a varying  s  gives a curve in xtz-space.  For many ξ-s we get many curves. These curves are the characteristics of Burgers’ equation.  However, for Burgers’ equation the projected characteristics are more important.  (Projected characteristics are the projections of the characteristics onto xt-plane.)  Below we plot the projected characteristics. They are straight lines with slope Exp[-(ξ^2)] in the xt-plane.

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

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

Recall that the value of z along a fixed projected characteristic is constant. Thus at the points were projected characteristics intersect the function u(x,t) should be having two different values. That is clearly impossible.  Next we will try to answer the following question: What is the maximum time (Subscript[t, m]) for which no projected characteristics intersect below the line t=(Subscript[t, m]).  I will first guess that value, say (Subscript[t, m])=1.

ParametricPlot[Evaluate[Table[solbe[s,ξ][[{1,2}]],{ξ,-9,3,.05}]],{s,0,6},PlotStyle->{Thickness[0.002]},Epilog->{{Red,Line[{{-3,1},{5,1}}]}},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.

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

Think of a fixed time in the above plot, say t=(Subscript[t, 0]), and consider the curve z=u(x,(Subscript[t, 0])). From the graph we can see that for small values of (Subscript[t, 0]) we have that  z=u(x,(Subscript[t, 0])) is a function. But for some larger values of (Subscript[t, 0]), say close to 2, we have that  z=u(x,(Subscript[t, 0])) is NOT a function.

Recall the equation of this surface:

solbe[s,ξ]

A lucky aspect of this equation is that the time is the second coordinate, that is the time equals s.  Next I will explore the parametric curves with fixed s=(Subscript[s, 0])

solbe[s0,ξ]

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

Since the parameter s is in fact the time, I will change the variable name to t.  It does not make any difference mathematically but it might be easier to think about what is going on.  I will also add some negative time to get the idea how this process evolves.

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

As I pointed out earlier from the above graphs we can see that for small values of t we have that  z=u(x,t) is a function. But for some larger values of t, say close to 2, we have that  z=u(z,t) is NOT a function. The point is to find the exact value of the cut-off t.  To find that t I will add the tangent vector to the above parametric curve. Recall that t is fixed and ξ is the variable, so the tangent vector is

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

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

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]

Based on this manipulation, can you calculate the the value of t for which  z=u(z,t) becomes multivalued?

Here is the calculation:

Calculate the tangent vector to the curve

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

for a fixed  t

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

The first component of the tangent vector is

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

Plot this function for a fixed t and then manipulate t:

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

Find the derivative of the first component of the tangent vector.

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

Find for which ξ the function 1-2 (e^(-(ξ^2))) t ξ takes a minimum.

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

Calculate the second derivative of the first component to prove that it reaches the minimum at the above value of ξ:

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

Since t is positive, the last quantity is positive. Thus, the first component of the tangent vector has the minimum at ξ=(1/(Sqrt[2]))

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

Hence: at ξ=1/(Sqrt[2]) the derivative of the first component of the tangent vector takes the minimum value 1-(Sqrt[(2/e)]) t. Finally, for which t is this minimum equal to 0:

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

N[(Sqrt[E/2])]

Thus, the parametric equations

solbe[t,ξ]

represent a function for all (t,ξ) such that t∈[0,(Sqrt[e/2])]  and ξ∈ℝ. Although we can not find an explicit formula for the function u(x,t).  For that formula we would need to solve

Solve[Exp[-(ξ^2)] t+ξ==x,ξ]

ParametricPlot3D[solbe[t,ξ],{ξ,-2,3},{t,0,(Sqrt[(E/2)])},PlotPoints->{70,30},PlotRange->{{-2,3},{0,(Sqrt[(E/2)])}},ImageSize->600,AxesLabel->{"x","t","z"}]

Mathematica algorithms can not solve this equation:

Clear[ff,u];DSolve[{u[x,t] D[u[x,t],x]+ D[u[x,t],t]==0,u[x,0]==ff[x]},u[x,t],{x,t}]

Or, with the specific initial condition that we used:

DSolve[{u[x,t] D[u[x,t],x]+ D[u[x,t],t]==0,u[x,0]==Exp[-(x^2)]},u[x,t],{x,t}]