Solitons from the Korteweg-de Vries Equation 

Som Phene

Introduction
The Korteweg-de Vries Equation (KdV equation) describes the theory of water waves in
shallow channels, such as a canal. It is a non-linear equation which exhibits special
solutions, known as solitons, which are stable and do not disperse with time. Furthermore
there as solutions with more than one soliton which can move towards each other,
interact and then emerge at the same speed with no change in shape (but with a time
"lag" or "speed up").

uexact[x_,t_]=-2 Sech[x-4 t]^2
D[uexact[x,t],t]== 6 uexact[x,t] D[uexact[x,t],x]-D[uexact[x,t],{x,3}]//Simplify

xmin=-8;xmax=8;
sol=NDSolve[{D[u[x,t],t]== 6  u[x,t] D[u[x,t],x]-D[u[x,t],{x,3}],
u[x,0]==-2 Sech[x]^2,u[xmin,t]==u[xmax,t]},u,{x,xmin,xmax},{t,-1,1}]

Plot3D[u[x,t]/.Flatten[sol],{x,-7,7},{t,-1,1},PlotPoints-> 50,PlotRange -> All,AxesLabel -> {"x","t","u"}]

ContourPlot[u[x,t]/.Flatten[sol],{t,-1,1},{x,-7,7},
ColorFunction-> (Hue[0.7 #1]&),PlotPoints -> 50,PlotRange -> All,FrameLabel -> {"t","x"}]

Plot[{u[x,0.5]/.Flatten[sol],-2 Sech[x-2]^2},
{x,-2,6},PlotStyle-> {{Hue[0],AbsoluteThickness[1]},
{Hue[0.75],Dashing[{0.01,0.03}],AbsoluteThickness[3]}},AxesLabel ->  {"x","u"}]

uexact[x_,t_]=-12(3+4 Cosh[2 x-8 t]+Cosh[4 x-64 t])/(3 Cosh[x-28 t]+Cosh[3 x-36 t])^2

Plot[uexact[x,1],{x,-5,20}, PlotRange ->  All,PlotLabel-> "t=1",AxesLabel -> {"x","u"}]

Plot3D[uexact[x,t],{t,-0.3,0.3},{x,-6,6},PlotPoints ->  50,
PlotRange-> {-10,0},AxesLabel-> {"t","x","u"},ViewPoint->{-1.78,-2.06,2.5}]

ContourPlot[uexact[x,t],{t,-1,1},{x,-12,12},
PlotPoints->  100,FrameLabel ->  {"t","x"},ColorFunction->  (Hue[0.7 #1]&),
PlotRange ->  All,Contours->  {-0.1,-0.6,-1.1,-1.6,-2.6,-4.,-5.6}]

Animate[Plot[uexact[x,t],{x,-20,20},PlotRange-> {-9,0}],{t,-1,1,0.02}]

xmin=-12;xmax=12;
sol=NDSolve[{D[u[x,t],t] == 6 u[x,t] D[u[x,t],x]-D[u[x,t],{x,3}],
u[x,0] ==-4 Sech[x]^2,u[xmin,t]== u[xmax,t]},u,{x,xmin,xmax},{t,0,1}]

Plot3D[u[x,t]/.Flatten[sol],{x,-10,10},{t,0,1},
PlotPoints-> 50,PlotRange-> All,AxesLabel-> {"x","t","u"}]

Animate[Plot[u[x,t] /. Flatten[sol],{x,-5,10},PlotRange->  {-6,0}],{t,0,0.8,0.01}]