Solving a differential equation involving the square of the derivative

You could differentiate to make a second-order equation without square root problems. Actually, it moves the square trouble to the initial conditions, but that is easier to solve.

foo = D[r'[λ]^2 == 1 - L^2/r[λ]^2*(1 - 1/r[λ]), λ] /. Equal -> Subtract // FactorList
(*  {{-1, 1}, {r[λ], -4}, {r'[λ], 1}, {-3 L^2 + 2 L^2 r[λ] - 2 r[λ]^4 (r^′′)[λ], 1}}  *)

ode = foo[[-1, 1]] == 0     (* pick the right equation by inspection *)
(*  -3 L^2 + 2 L^2 r[λ] - 2 r[λ]^4 (r'')[λ] == 0  *)

icsALL = Solve[{r'[λ]^2 == 1 - L^2/r[λ]^2*(1 - 1/r[λ]), r[0] == 1000} /. λ -> 0,
  {r[0], r'[0]}]
(*
  {{r[0]  -> 1000, 
    r'[0] -> -(Sqrt[1000000000 - 999 L^2]/(10000 Sqrt[10]))}, (* negative radical *)
   {r[0]  -> 1000, 
    r'[0] -> Sqrt[1000000000 - 999 L^2]/(10000 Sqrt[10])}}    (* positive radical *)
*)

ics = {r[0], r'[0]} == ({r[0], r'[0]} /. First@icsALL); (* pick negative solution *)

soln = ParametricNDSolve[
   {ode, ics},
   r, {λ, 0, 2000}, {L}];
Plot[r[30][λ] /. soln, {λ, 0, 2000}]

Mathematica graphics


As I remarked in earlier comments, this problem can be solved symbolically, although with more difficulty than I had anticipated. The differential equation is given by

r'[λ]^2 == 1 - L^2/r[λ]^2*(1 - 1/r[λ])

which can be rewritten as

Simplify /@ %
(* r'[λ]^2 == (L^2 - L^2 r[λ] + r[λ]^3)/r[λ]^3 *)

It is useful to examine the turning points of this ODE, given by

(L^2 - L^2 r[λ] + r[λ]^3)/r[λ]^3 == 0

Although Solve can handle this equation easily, it is more compact to express the turning points as Root[L^2 - L^2 #1 + #1^3 &, n], where n is 1, 2, or 3. Plotting these roots then gives

Plot[Evaluate@Table[Root[L^2 - L^2 # + #^3 &, n], {n, 3}], {L, 0, 10}, AxesLabel -> {r, L}]

enter image description here

Clearly, the upper (green) turning point curve is desired. It has a lower limit of {L -> (3 Sqrt[3])/2, r -> 3/2}.

Because the ODE itself represents two first order autonomous equations, either can be solved by direct integration.

ss = Integrate[1/Sqrt[1 - L^2/r^2*(1 - 1/r)], r]

I have found no set of Assumptions which causes this expression to yield the desired solution branch. (Edit: Needed Assumptions found.) However, Integrate can treat correctly the more general expression

s = Integrate[r^(3/2)/Sqrt[(r - a) (r - b) (r - c)], r, Assumptions -> a < b < c < r];

although the answer is too long to reproduce here. Given the general answer, the specific answer desired is obtained by

ss = s /. {a -> Root[L^2 - L^2 #1 + #1^3 &, 1], b -> Root[L^2 - L^2 #1 + #1^3 &, 2], 
    c -> Root[L^2 - L^2 #1 + #1^3 &, 3]};

Its plot for L == 30 (used in the two answers earlier determined numerically) is

With[{L0 = 30}, Quiet@ParametricPlot[{{Chop[-ss /. L -> L0] + 1000, r}, 
    {Chop[ss /. L -> L0] + 1000, r}}, {r, Evaluate@Root[L0^2 - L0^2 # + #^3 &, 3], 1000}, 
    AspectRatio -> 1/GoldenRatio, PlotStyle -> Blue, AxesLabel -> {λ, r}]]

enter image description here

The turning point is 29.4869.

Addendum: L just above its minimum value

The minimum value of L, given above, is

N[3 Sqrt[3]/2]
(* 2.598076211353316 *)

to machine precision. The trajectory for L = 2.5981 is

With[{L0 = 2.5981}, Quiet@ParametricPlot[{{Chop[-ss /. L -> L0], r}, 
    {Chop[ss /. L -> L0], r}}, {r, Evaluate@Root[L0^2 - L0^2 # + #^3 &, 3], 10}, 
    AspectRatio -> 1/GoldenRatio, PlotStyle -> Blue, AxesLabel -> {λ, r}, 
    AxesOrigin -> {0, 0}]]

enter image description here

with a turning point of 1.50372. I presume that the trajectory would skim r == 3/2 for longer and longer times as L further approached 3 Sqrt[3]/2.


Using SolveDelayed -> True inside NDSolve will address your issue. Don't worry about the red color of this addition, it will still work.

f[r_] := 1 - 1/r;

soln = ParametricNDSolve[{r'[λ]^2 == 1 - L^2/r[λ]^2*f[r[λ]], r[0] == 1000}, r, 
{λ, 0, 2000}, {L}, SolveDelayed -> True];

Plot[r[30][λ] /. soln, {λ, 0, 2000}, Frame -> True, PlotStyle -> Red]

enter image description here

A new version of SolveDelayed -> True is Method -> {"EquationSimplification" -> "Residual"}.