f



Numerical solution of differential equation with boundary values

Hallo,

I need to solve the following differential equation:

(1/4 r^2 + 2 Sin[F[r]]^2) F''[r] + 1/2 r F'[r] + 
  Sin[2 F[r]] (F'[r])^2 - 1/4 Sin[2 F[r]] - (Sin[F[r]]^2 Sin[2 F[r]])/r^2 == 0

with boundary values:
F[0]==Pi, F[Infinity]==0.

I tried NDSolve, but failed to get a solution.
How can I solve that equation?

Best regards,
susy

0
susy
5/19/2010 11:03:31 AM
comp.soft-sys.math.mathematica 28821 articles. 0 followers. Follow

2 Replies
468 Views

Similar Articles

[PageSpeed] 32

I suppose some insight into the behavior of F[r] is required to avoid
singularities.The following works for different BC.

NDSolve[{1/4 r^2 + 2 Sin[F[r]]^2 F''[r] + 1/2 r F'[r] +
    Sin[2 F[r]] F'[r]^2 -
    1/4 Sin[2 F[r]] - (Sin[F[r]]^2 Sin[2 F[r]])/r^2 == 0,
  F[10^-5] ==  Pi/2, F'[10^-5] == 0}, F, {r, 10^-5, 18.12}]
f[u_] = F[u] /. First[%]; Plot[f[r], {r, 10^-5, 18.12}]

Narasimham

 May 19, 4:03 pm, susy <fengk...@gmail.com> wrote:
> Hallo,
>
> I need to solve the following differential equation:
>
> (1/4 r^2 + 2 Sin[F[r]]^2) F''[r] + 1/2 r F'[r] +
>   Sin[2 F[r]] (F'[r])^2 - 1/4 Sin[2 F[r]] - (Sin[F[r]]^2 Sin[2 F[r]])/r=
^2 == 0
>
> with boundary values:
> F[0]==Pi, F[Infinity]==0.
>
> I tried NDSolve, but failed to get a solution.
> How can I solve that equation?
>
> Best regards,
> susy


0
Narasimham
5/20/2010 12:13:18 AM
This is classical Skyrme model equation.

My approach was:
1) find asymptotic behaviour and 0
2) shoot from far end close to zero

Below is the working (much simplified, but still devoted to generalized
equations of this type) cut from my old notebook.
In 7.0 Your can use direct NDolve method  "Shooting"
Somethong like

Method -> {"Shooting",
 "StartingInitialConditions" -> {F[startP] == uS, F'[startP] == uDS}}

-----------------------------------



FClassicalNearZero[kam_String][
 k2_] := ((F[rMin] - (rMin - #)*FClassicalDerivative[rMin]) /.
   oneStepShotClassical[kam][k2]) &

FClassicalAsymptotic[kam_String][k2_] :=
 With[{\[ScriptCapitalB]I = \[ScriptCapitalB]I[
    kam]}, (k2/(#)^((1 + Sqrt[1 + 8*\[ScriptCapitalB]I])/2)) &]

FClassicalDerivativeNearZero[kam_String][
 k2_] := ((FClassicalDerivative[rMin] - (rMin - #)*
      Derivative[1][FClassicalDerivative][rMin]) /.
   oneStepShotClassical[kam][k2]) &

FClassicalDerivativeAsymptotic[kam_String][k2_] :=
 Block[{r}, (D[FClassicalAsymptotic[kam][k2][r], r] /. {r -> #}) &]

FullRangeFClassical[kam_String][k2_][x_?(NonNegative[#] &)] :=
 Piecewise[{{
   F[x] /. F -> FClassicalNearZero[kam][k2],
   x <= rMin}, {F[x] /. oneStepShotClassical[kam][k2],
   rMin < x < rMax}, {F[x] /. F -> FClassicalAsymptotic[kam][k2],
   x >= rMax}}]

FullRangeFClassicalDerivative[kam_String][k2_][
 x_?(NonNegative[#] &)] := Piecewise[{{
   FClassicalDerivative[x] /.
    FClassicalDerivative -> FClassicalDerivativeNearZero[kam][k2],
   x <= rMin}, {FClassicalDerivative[x] /.
    oneStepShotClassical[kam][k2],
   rMin < x < rMax}, {FClassicalDerivative[x] /.
    FClassicalDerivative -> FClassicalDerivativeAsymptotic[kam][k2],
   x >= rMax}}]

SkyrmeClassicalEquation[kam_String] :=
 With[{\[ScriptCapitalB]I = \[ScriptCapitalB]I[
    kam], \[ScriptCapitalI]2I = \[ScriptCapitalI]2I[
    kam]}, (FClassicalDerivative'[
     r]*(4*r^2 + 8*\[ScriptCapitalB]I*Sin[F[r]]^2) +
   FClassicalDerivative[r]^2*(4*\[ScriptCapitalB]I*Sin[2*F[r]]) +
   r*FClassicalDerivative[r]*8 -
   Sin[2*F[r]]*(4*\[ScriptCapitalB]I + (4*\[ScriptCapitalI]2I*
         Sin[F[r]]^2)/r^2))]

FClassicalNearZero[kam_String][
 k2_] := ((F[rMin] - (rMin - #)*FClassicalDerivative[rMin]) /.
   oneStepShotClassical[kam][k2]) &

FClassicalAsymptotic[kam_String][k2_] :=
 With[{\[ScriptCapitalB]I = \[ScriptCapitalB]I[
    kam]}, (k2/(#)^((1 + Sqrt[1 + 8*\[ScriptCapitalB]I])/2)) &]

FClassicalDerivativeNearZero[kam_String][
 k2_] := ((FClassicalDerivative[rMin] - (rMin - #)*
      Derivative[1][FClassicalDerivative][rMin]) /.
   oneStepShotClassical[kam][k2]) &

FClassicalDerivativeAsymptotic[kam_String][k2_] :=
 Block[{r}, (D[FClassicalAsymptotic[kam][k2][r], r] /. {r -> #}) &]


FullRangeFClassical[kam_String][k2_][x_?(NonNegative[#] &)] :=
 Piecewise[{{
   F[x] /. F -> FClassicalNearZero[kam][k2],
   x <= rMin}, {F[x] /. oneStepShotClassical[kam][k2],
   rMin < x < rMax}, {F[x] /. F -> FClassicalAsymptotic[kam][k2],
   x >= rMax}}]

FullRangeFClassicalDerivative[kam_String][k2_][
 x_?(NonNegative[#] &)] := Piecewise[{{
   FClassicalDerivative[x] /.
    FClassicalDerivative -> FClassicalDerivativeNearZero[kam][k2],
   x <= rMin}, {FClassicalDerivative[x] /.
    oneStepShotClassical[kam][k2],
   rMin < x < rMax}, {FClassicalDerivative[x] /.
    FClassicalDerivative -> FClassicalDerivativeAsymptotic[kam][k2],
   x >= rMax}}]

Options[oneStepShotClassical] = {MaxSteps -> 100000,
 WorkingPrecision -> 25, AccuracyGoal -> 18, PrecisionGoal -> 18,
 MaxStepFraction -> 1/100, MaxStepSize -> 1/100};
oneStepShotClassical[kam_String, opts___?OptionQ][k2_?NumericQ] :=
 With[{optNDSolve =
   Sequence @@ Options[oneStepShotClassical]}, (First[
   NDSolve[{F[rMax] ==
      Rationalize[FClassicalAsymptotic[kam][k2][rMax], 10^(-25)],
     FClassicalDerivative[rMax] ==
      Rationalize[FClassicalDerivativeAsymptotic[kam][k2][rMax],
       10^(-25)], SkyrmeClassicalEquation[kam] == 0,
     FClassicalDerivative[r] - F'[r] == 0}, {F,
     FClassicalDerivative}, {r, rMin, rMax}, optNDSolve]]
  )]
oneStepShotClassicalForFindRoot[kam_String, opts___][k2_?NumericQ,
 barCharge_: 1] := ((F[rMin] - rMin*FClassicalDerivative[rMin]) /.
  oneStepShotClassical[kam, opts][k2])

(* ShowStatus is borrowed from Paul's Abbot "Tricks of the Trade", \
The MMa Journal 7-3, 2000
                                                        Author: \
Theodore Gray (theodore@wolfram.com) *)
                             \

ShowStatus[status_String] := LinkWrite[$ParentLink,
     SetNotebookStatusLine[FrontEnd`EvaluationNotebook[], status]]

Options[oneStepSkyrmeClassicalFixedParameters] = {MaxIterations ->
   600};
oneStepSkyrmeClassicalFixedParameters[kam_String, isko_String,
  barCharge_: 1][startParam_List, opts___?OptionQ] :=
 Block[{step = 0,
  optsFindRoot =
   Options[oneStepSkyrmeClassicalFixedParameters]}, {k[kam] =
   kampas /.
    FindRoot[
     oneStepShotClassicalForFindRoot[kam][kampas, barCharge] ==
      barCharge*Pi, {kampas, 1/2, 3}, WorkingPrecision -> 25,
     AccuracyGoal -> 17, PrecisionGoal -> 18, MaxIterations -> 600,
     Compiled -> False,
     EvaluationMonitor :> (If[Mod[step, 10] === 0,
        ShowStatus[
         "k2[" <> kam <> "," <> ToString[step] <> "] \[Rule] " <>
          ToString[kampas]]; step++;, step++])]}]

rMin = 1/100; rMax = 7.45;


\[ScriptL]["He"] = 0;
mt["He"] = 0;
\[ScriptCapitalB]I["He"] = 1;
\[ScriptN]2I["He"] = 0;
\[ScriptN]4I["He"] = 0;
\[ScriptCapitalI]2I["He"] = 1;

SkyrmeClassicalEquation["He"]

StartingParameters = Evaluate[{k["He"] = Rationalize[2.3, 0]}];

{{F[rMin], FClassicalDerivative[rMin]}, {F[rMax],
  FClassicalDerivative[rMax]}} /. oneStepShotClassical["He"][k["He"]]

oneStepSkyrmeClassicalFixedParameters["He", "xx",
 1][StartingParameters]

heFClassical =
 Plot[Evaluate[{F[rr], FClassicalDerivative[rr]} /.
   oneStepShotClassical["He"][k["He"]]], {rr, rMin, rMax},
 PlotRange -> All, AxesOrigin -> {rMin, 0}]




Pn, 2010 05 21 06:44 -0400, Daniel Lichtblau rašė:
- Hide quoted text -
> susy wrote:
> > Hallo,
> >
> > I need to solve the following differential equation:
> >
> > (1/4 r^2 + 2 Sin[F[r]]^2) F''[r] + 1/2 r F'[r] +
> >   Sin[2 F[r]] (F'[r])^2 - 1/4 Sin[2 F[r]] - (Sin[F[r]]^2 Sin[2 F[r]])/r^2 == 0
> >
> > with boundary values:
> > F[0]==Pi, F[Infinity]==0.
> >
> > I tried NDSolve, but failed to get a solution.
> > How can I solve that equation?
> >
> > Best regards,
> > susy
> >
>
> I had some luck by changing to a finite interval via r->1/(1+r). But I
> still needed to scoot in a bit from the origin (corresponding to
> infinity in the original coordinate).
>
> new = (1/4 r^2 + 2 Sin[ff[r]]^2) D[ff[r], {r, 2}] +
>      1/2 r D[ff[r], {r, 1}] + Sin[2 ff[r]] (D[ff[r], {r, 1}])^2 -
>      1/4 Sin[2 ff[r]] - (Sin[ff[r]]^2 Sin[2 ff[r]])/r^2 /.
>     Derivative[j_][ff][r] :> Derivative[j][ff][r]*D[1/(1 + r), {r, j}];
>
> In[125]:= eps = .0001;
>
> In[126]:= gg =
>   ff[r] /. First[
>     NDSolve[{new == 0, ff[1 - eps] == Pi, ff[eps] == 0},
>      ff[r], {r, 1 - eps, eps}]];
>
> During evaluation of In[126]:= FindRoot::sszero: The step size in the
> search has become less than the tolerance prescribed by the
> PrecisionGoal option, but the function value is still greater than the
> tolerance prescribed by the AccuracyGoal option. >>
>
> During evaluation of In[126]:= NDSolve::berr: There are significant
> errors {-7.77603*10^-8,0.000328812} in the boundary value residuals.
> Returning the best solution found. >>
>
> (*Ignoring the warning messages, the plot seems reasonable. *)
>
> hh[s_?NumberQ] := gg /. r -> 1/(s + 1)
>
> Plot[hh[s], {s, 1/(1 - eps) - 1, 1/eps - 1}]
>
> Daniel Lichtblau
> Wolfram Research

0
UTF
5/22/2010 4:40:59 AM
Reply: