Suppose we have the following partial differential equation:
$$
0 = \frac{ \partial w }{ \partial \tau } + \left( w + \sqrt{ h + \beta } \right) \frac{ \partial h }{ \partial \chi }
$$
where $w$ = $w(\chi,\tau)$ and $h$ = $h(w)$ is implicitly given by:
$$
w = 2 \left( \sqrt{ h + \beta } - \sqrt{ 1 + \beta } \right) + \sqrt{ \beta } \left( \ln \lvert \frac{ \sqrt{ h + \beta } - \sqrt{ \beta } }{ \sqrt{ h + \beta } + \sqrt{ \beta } } \rvert - \ln \lvert \frac{ \sqrt{ 1 + \beta } - \sqrt{ \beta } }{ \sqrt{ 1 + \beta } + \sqrt{ \beta } } \rvert \right)
$$
Similar to the method of characteristics, we want to find paths in $(\chi,\tau)$ where $w$ = constant, which can be described by:
$$
\frac{ d\chi }{ d\tau } = w + \sqrt{ h + \beta }
$$
which allows us to define a general solution for the first equation given by:
$$
w = \mathcal{F}\left( \chi - \left( w + \sqrt{ h + \beta } \right) \tau \right)
$$
We also have the following boundary conditions and initial values (some helped to determine the first equation above):
$$
\begin{align}
\lim_{\lvert x \rvert \rightarrow \infty} w\left( \chi, \tau \right) & = 0 \\
\lim_{\lvert x \rvert \rightarrow \infty} h\left( w\left( \chi, \tau \right) \right) & = 1 \\
\lim_{\tau \rightarrow 0} h\left( w\left( \chi, \tau \right) \right) & = 1 + \frac{ 1 }{ 2 } \cosh^{-1}{ \left( \frac{ \chi }{ 20 } \right) }
\end{align}
$$
I have tried several iterations on a theme, where I am trying to determine $w$ and $h$ as a function of $\chi$ and $\tau$, without success. The result I am looking for is the profile of the $w$ and $h$ versus position, $\chi$, and then be able to plot snapshots of that profile at different times, $\tau$.
Some variations resulted in the NDSolve::litarg
error when I had originally tried to explicitly write $h$ = $h(w(\chi,\tau))$. So then I tried to reform the equations such that $w$ = $w(\chi,\tau)$ and $h$ = $h(\chi,\tau)$, but now I get NDSolve::underdet
errors. I also tried using all of the equations (see code below), but then I get an over constrained system.
For instance, Mathematica was upset when I used 0 == Limit[w[x, t], x -> Infinity]
instead of 0 == w[Infinity, t]
. Unfortunately, I have run into a few errors, the source of which I did not fully understand, which resulted in my starting the typical I'm frustrated, so trial-and-error it is brute force method.
I assume I have an ignorance(inexperience)-based syntax issue, so any suggestions to help me see the error of my ways would be greatly appreciated.
Mathematica Code Trials
Mathematica version = 8.0.1.0
Operating System = Mac OS X x86 (v10.8.5)
hh[x_, t_] := h[w[x[t], t]];
ww[x_, t_] := w[x[t], t];
eq0 = ((w == -2 Sqrt[1 + bb] + 2 Sqrt[h + bb] -
Sqrt[bb] Log[(-Sqrt[bb] + Sqrt[1 + bb])/(
Sqrt[bb] + Sqrt[1 + bb])] +
Sqrt[bb] Log[(-Sqrt[bb] + Sqrt[h + bb])/(
Sqrt[bb] + Sqrt[h + bb])]) /. {h -> hh[x, t],
w -> ww[x, t]}) /. {h[w[x[t], t]] -> h[x, t],
w[x[t], t] -> w[x, t]};
eq1a = ((x[t] == (w + Sqrt[h + bb]) t) /. {h -> hh[x, t],
w -> ww[x, t]}) /. {h[w[x[t], t]] -> h[x, t],
w[x[t], t] -> w[x, t]};
eq1b = ((x'[t] == w + Sqrt[h + bb]) /. {h -> hh[x, t],
w -> ww[x, t]}) /. {h[w[x[t], t]] -> h[x, t],
w[x[t], t] -> w[x, t]};
eq2 = (ReleaseHold[
Hold[(0 == D[w, t] + (w + Sqrt[h + bb]) D[w, x])] /. {h ->
h[x, t], w -> w[x, t]}]);
eq3 = (ReleaseHold[
Hold[(0 == D[h, t] + w D[h, x] + h D[w, x])] /. {h -> h[x, t],
w -> w[x, t]}]);
eq4a = 0 == Limit[w[x, t], x -> Infinity];
eq4b = 0 == Limit[w[x, t], x -> -Infinity];
eq4c = 0 == Limit[w[x, t], Abs[x] -> -Infinity];
eq5a = 1 == Limit[h[x, t], x -> Infinity];
eq5b = 1 == Limit[h[x, t], x -> Infinity];
eq5c = (ReleaseHold[
Hold[(h == 1 + 1/2 Sech[x/20])] /. {h -> hh[x, 0],
w -> ww[x, t]}] /. {x[0] -> x}) /. {h[w[x, 0]] -> h[x, 0]};
eq5d = ReleaseHold[Hold[(Derivative[1, 0][h][0, t] == 0)]];
xmax = 150.;
tmax = 25.;
soln = NDSolve[
({eq0, eq2, h[Infinity, t] == 1, h[-Infinity, t] == 1,
w[Infinity, t] == 0, w[-Infinity, t] == 0, eq5c,
eq5d} /. {bb -> 2.}),
{w[x, t], h[x, t]},
{t, 0, tmax},
{x, -xmax, xmax},
MaxStepSize -> 0.01, MaxSteps -> 10^6, SolveDelayed -> True
]
[The folowing is only for house-keeping purposes, so ignore at your lesure]
Mathematica Code Trials: Things that didn't seem to work
(*
eq5a=((ReleaseHold[Hold[(h==1)]/.{h->hh[x,t],w->ww[x,t]}]/.{x[t]->\
Infinity})/.{h[w[Infinity,t]]->h[0,t],h[w[-Infinity,t]]->h[0,t]})/.{h[\
w[x[t],t]]->h[x,t],w[x[t],t]->w[x,t]};
eq5b=((ReleaseHold[Hold[(h==1)]/.{h->hh[x,t],w->ww[x,t]}]/.{x[t]->-\
Infinity})/.{h[w[Infinity,t]]->h[0,t],h[w[-Infinity,t]]->h[0,t]})/.{h[\
w[x[t],t]]->h[x,t],w[x[t],t]->w[x,t]};
eq4a=((ReleaseHold[Hold[(w==0)]/.{h->hh[x,t],w->ww[x,t]}]/.{x[t]->\
Infinity})/.{h[w[Infinity,t]]->h[0,t],h[w[-Infinity,t]]->h[0,t]})/.{h[\
w[x[t],t]]->h[x,t],w[x[t],t]->w[x,t]};
eq4b=((ReleaseHold[Hold[(w==0)]/.{h->hh[x,t],w->ww[x,t]}]/.{x[t]->-\
Infinity})/.{h[w[Infinity,t]]->h[0,t],h[w[-Infinity,t]]->h[0,t]})/.{h[\
w[x[t],t]]->h[x,t],w[x[t],t]->w[x,t]};
eq2=(ReleaseHold[Hold[(0==D[w,t]+(w+Sqrt[h+bb])D[w,x])]/.{h->hh[x,t],\
w->ww[x,t]}])/.{h[w[x[t],t]]->h[x,t],w[x[t],t]->w[x,t]};
eq3=(ReleaseHold[Hold[(0==D[h,t]+w D[h,x]+h \
D[w,x])]/.{h->hh[x,t],w->ww[x,t]}])/.{h[w[x[t],t]]->h[x,t],w[x[t],t]->\
w[x,t]};
eq4a=ReleaseHold[Hold[(Limit[w,x->Infinity]==0)]/.{x->x[t],h->hh[x,t],\
w->ww[x,t]}];
eq4b=ReleaseHold[Hold[(Limit[w,x->-Infinity]==0)]/.{x->x[t],h->hh[x,t]\
,w->ww[x,t]}];
eq5a=ReleaseHold[Hold[(Limit[h,x->Infinity]==1)]/.{x->x[t],h->hh[x,t],\
w->ww[x,t]}];
eq5b=ReleaseHold[Hold[(Limit[h,x->-Infinity]==1)]/.{x->x[t],h->hh[x,t]\
,w->ww[x,t]}];
*)
(*
soln=NDSolve[
({eq0,h[Infinity,t]==1,h[-Infinity,t]==1,w[Infinity,t]==0,w[-Infinity,\
t]==0,eq5c,eq5d}/.{bb->2.}),
{w[x,t],h[x,t]},
{t,0,tmax},
{x,-xmax,xmax},
MaxStepSize->0.01,MaxSteps->10^6,SolveDelayed->True
];
soln=NDSolve[
({eq0,eq4a,eq5a,eq5c,eq5d}/.{bb->2.}),
{w[x,t],h[x,t]},
{t,0,tmax},
{x,-xmax,xmax},
MaxStepSize->0.01,MaxSteps->10^6,SolveDelayed->True
];
soln=NDSolve[
{eq0,eq1a,eq1b,eq2,eq3,eq4c,eq5a,eq5c,eq5d},
{w[x,t],h[x,t]},
{t,0,tmax},
{x,-xmax,xmax},
MaxStepSize->0.01,MaxSteps->10^6,SolveDelayed->True
];
soln = NDSolve[
{eq0, eq1a, eq1b, eq2, Limit[w[x[t], t], x -> Infinity] == 0,
Limit[w[x[t], t], x -> -Infinity] == 0,
Limit[h[w[x[t], t]], x -> Infinity] == 1,
Limit[h[w[x[t], t]], x -> -Infinity] == 1,
Limit[h[w[x[t], t]], t -> 0] == 1 + 1/2 Sech[x[t]/20], x[0] == 0},
{w[x[t], t], h[w[x[t], t]]},
{t, 0, tmax},
MaxStepSize -> 0.01, MaxSteps -> 10^6, SolveDelayed -> True
]
*)