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 )

Transport Equation

NotebookDirectory[]

Let  a be a real number. The PDE  

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

is called the transport equation.  This is 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 <a,1,0>.  Let us picture this field. Here we need to choose a specific constant a.

aa=2;ChVecFiTE={aa,1,0};

VP={1.3`,-2.4`,2.`}

VP={1.9316453228733674`,-2.5438719399482292`,1.1168983390467897`}

vecste=VectorPlot3D[ChVecFiTE,{x,-3,3},{t,0,6},{z,-0.2,1.5},
VectorColorFunction->(RGBColor[0,0.5,0.5]&),VectorColorFunctionScaling->False,VectorStyle->{Thickness[0.006]},VectorPoints->{6,8,6} ,VectorScale->{0.08,Scaled[0.6]},BoxRatios->{2,2,1},PlotRange->{{-3,3},{0,6},{-0.2,1.5}},ImageSize->500,ViewPoint-> Dynamic[VP]]

VP

Clear[solte];
solte[s_,ξ_]=FullSimplify[{x[s],t[s],z[s]}/.DSolve[{x'[s]==aa,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 the transport equation.  However, for the transport 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 simply straight lines with slope 1/a in the xt-plane.

ParametricPlot[Evaluate[Table[solte[s,ξ][[{1,2}]],{ξ,-9,3,.2}]],{s,0,6},PlotRange->{{-3,3},{0,3}},ImageSize->600]

To get the equation for the solution z=u(x,t) we need to express z in terms of  x and t. To accomplish that we want to express the coordinates  s  and  ξ in terms of  x and t .   Recall the equations of the characteristics: {2 s+ξ,s,(e^(-(ξ^2)))} and  solve the equations  x==2 s+ξ,t==s  for s  and  ξ .  We can do this by hand, but I want to show how to do that in Mathematica:

Simplify[Solve[{x==solte[s,ξ][[1]],t==solte[s,ξ][[2]]},{s,ξ}][[1]]]

The next figure shows the characteristic (the blue line) starting at the point {ξ,0,Exp[-(ξ^2)]} with ξ=-1 in the vector field of the transport equation. This figure attempts to illustrate how the blue characteristic is tangent to all the vectors in its path.  In this example the vectors of the vector field are on the characteristic since the vector field is the constant vector field.

Module[{ξ},ξ=-1; pabte=ParametricPlot3D[Evaluate[solte[s,ξ]],{s,0,10},PlotStyle->({Thickness[0.01],Blue})];
icste=ParametricPlot3D[{x0,0,Exp[-(x0^2)]},{x0,-4,4},PlotStyle->({Thickness[0.01],Green})];icte=Graphics3D[{PointSize[0.025],Green,Point[{ξ,0,Exp[-(ξ^2)]}]}];Show[icste,vecste,pabte,icte,BoxRatios->{2,2,1},PlotRange->{{-3,3},{0,6},{-0.2,1.5}},ViewPoint-> Dynamic[VP]]]

The next figure illustrates that the vectors of the vector field that have tails on the characteristic are “tangent” to it.

Module[{ξ},ξ=-1;ptste=Table[solte[s,ξ],{s,0,15,.2}];
 lvecste=Graphics3D[{Thickness[0.008],RGBColor[0,0.5,0.5],
Arrow[{#,#+(1/4)ChVecFiTE}]&/@ptste}];
pacte=ParametricPlot3D[Evaluate[solte[s,ξ]],{s,0,15},PlotStyle->({Thickness[0.005],Blue})];
icste=ParametricPlot3D[{x0,0,Exp[-(x0^2)]},{x0,-7,7},PlotStyle->({Thickness[0.01],Green})];icte=Graphics3D[{PointSize[0.025],Green,Point[{ξ,0,Exp[-(ξ^2)]}]}];Show[icste,lvecste,pacte,icte,BoxRatios->{2,2,1},PlotRange->{{-3,3},{0,3},{-0.1,1.5}},ImageSize->500,ViewPoint-> Dynamic[VP]]]

The next figure animates the previous one

Clear[ξ];
Manipulate[ ptste=Table[solte[s,ξ],{s,0,15,.2}];
 lvecste=Graphics3D[{Thickness[0.008],RGBColor[0,0.5,0.5],
Arrow[{#,#+(1/4)ChVecFiTE}]&/@ptste}];
pacte=ParametricPlot3D[Evaluate[solte[s,ξ]],{s,0,15},PlotStyle->({Thickness[0.005],Blue})];
icste=ParametricPlot3D[Evaluate[{x0,0,Exp[-(x0^2)]}],{x0,-7,7},PlotStyle->({Thickness[0.01],Green})];icte=Graphics3D[{PointSize[0.025],Green,Point[{ξ,0,Exp[-(ξ^2)]}]}];Show[icste,lvecste,pacte,icte,BoxRatios->{2,2,1},PlotRange->{{-3,3},{0,3},{-0.1,1.5}},ImageSize->400,ViewPoint-> Dynamic[VP]],{ξ,-3,3,.1,ControlPlacement->Top }]

In the next manipulation I tell Mathematica to remember all the previous characteristics.

Clear[ξ];
Manipulate[
pacmte=ParametricPlot3D[Evaluate[Table[solte[s,ξ1],{ξ1,-4,ξ,.1}]],{s,0,15},PlotStyle->{{Thickness[0.003],Blue}}];pacte=ParametricPlot3D[Evaluate[solte[s,ξ]],{s,0,15},PlotStyle->({Thickness[0.005],Blue})];
icste=ParametricPlot3D[Evaluate[{x0,0,Exp[-(x0^2)]}],{x0,-4,4},PlotStyle->({Thickness[0.01],Green})];icte=Graphics3D[{PointSize[0.025],Green,Point[{ξ,0,Exp[-(ξ^2)]}]}];Show[pacmte,pacte,icste,icte,BoxRatios->{2,2,1},PlotRange->{{-3,3},{0,3},{-0.1,1.5}},ImageSize->400,ViewPoint-> Dynamic[VP]],{ξ,-3,3,.1,ControlPlacement->Top }]

Clear[ξ];
Manipulate[
pacmste=ParametricPlot3D[solte[s,ξ1],{ξ1,-4,ξ},{s,0,15},Mesh->None];pacte=ParametricPlot3D[Evaluate[solte[s,ξ]],{s,0,15},PlotStyle->({Thickness[0.005],Blue})];
icste=ParametricPlot3D[Evaluate[{x0,0,Exp[-(x0^2)]}],{x0,-7,7},PlotStyle->({Thickness[0.01],Green})];icte=Graphics3D[{PointSize[0.025],Green,Point[{ξ,0,Exp[-(ξ^2)]}]}];Show[pacmste,pacte,icste,icte,BoxRatios->{2,2,1},PlotRange->{{-3,3},{0,3},{-0.1,1.5}},ImageSize->400,ViewPoint-> Dynamic[VP]],
{ξ,-3,3,.1,ControlPlacement->Top }]

Finally we get the formula for the solution

uute[x_,t_]:=FullSimplify[(solte[s,ξ][[3]])/.Solve[{x==solte[s,ξ][[1]],t==solte[s,ξ][[2]]},{s,ξ}]][[1]]

Verify:

Simplify[{D[uute[x,t],x],D[uute[x,t],t],-1}.{aa,1,0}]

grate=Plot3D[uute[x,t],{x,-3,3},{t,0,6},PlotPoints->{50,50},BoxRatios->{2,2,1},PlotRange->{{-3,3},{0,3},{-0.1,1.5}},ImageSize->500,ViewPoint-> Dynamic[VP]]

grateo=Plot3D[uute[x,t],{x,-3,3},{t,0,6},PlotPoints->{50,50},PlotStyle->{Opacity[0.5]},Mesh->False,BoxRatios->{2,2,1},PlotRange->{{-3,3},{0,3},{-0.1,1.5}},ImageSize->500,ViewPoint-> Dynamic[VP]]

Show[vecste,grateo,BoxRatios->{2,2,1},PlotRange->{{-3,3},{0,3},{-0.1,1.5}},ImageSize->500,ViewPoint-> Dynamic[VP]]

Clear[ξ];
Manipulate[ pacte=ParametricPlot3D[Evaluate[solte[s,ξ]],{s,0,15},PlotStyle->({Thickness[0.005],Blue})];
icste=ParametricPlot3D[Evaluate[{x0,0,Exp[-(x0^2)]}],{x0,-7,7},PlotStyle->({Thickness[0.01],Green})];icte=Graphics3D[{PointSize[0.025],Green,Point[{ξ,0,Exp[-(ξ^2)]}]}];Show[grateo,pacte,icste,icte,BoxRatios->{2,2,1},PlotRange->{{-3,3},{0,3},{-0.1,1.5}},ImageSize->400,ViewPoint-> Dynamic[VP]],{ξ,-3,3,.1,ControlPlacement->Top}]

Manipulate[Plot[uute[x,t],{x,-3,3},PlotRange-> {{-3,3},{-0.1,1.5}},ImageSize->500],{{t,0},-3,3,.1,ControlPlacement->Top}]

The discussion above illustrates the abstract reasoning that leads to characteristic equations associated with a linear first-order pdes.

However, Mathematica has powerful solving algorithms that can solve a general transport equation:

Clear[ff,u];DSolve[{a 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[{a D[u[x,t],x]+ D[u[x,t],t]==0,u[x,0]==Exp[-(x^2)]},u[x,t],{x,t}]

Mathematica solves it in one short line of code.