10 deleted 2 characters in body edited Apr 24 at 6:49 apt45 73944 silver badges1111 bronze badges V[v_] = (-1 + (1/8 (-9 + Sqrt[145]) - v)^2)^2 + 3 (1/8 (-9 + Sqrt[145]) - v)^3; sol[rmax_, \[Delta]_] := Last@Last@ Last@NDSolve[{+D[v[r], {r, 2}] + 2/r D[v[r], {r, 1}] - (D[V[v], v] /. v -> v[r]) == 0, (D[v[r], r] /. r -> SetPrecision[10^-10, 100]) == 0, v[SetPrecision[10^-10, 100]] == SetPrecision[\[Delta], 100],v[t,rmax]==0}, v, {r, 10^-10, rmax}, WorkingPrecision -> 50, Method -> "Extrapolation"] iTf = sol[30, 1.506400187591933106770472351]; Plot[{iTf[r]}, {r, 0, 30}, PlotRange -> All, Frame -> True] iTfTime = v /. ParametricNDSolve[{-D[v[t, r], {t, 2}] + D[v[t, r], {r, 2}] + 2/r D[v[t, r], {r, 1}] - (D[V[v], v] /. v -> v[t, r]) == 0, v[0, r] == iTf[r], ((D[v[t, r], t]) /. t -> 0) == +\[Delta] 10^-2, (D[v[t, r], r] /. r -> 10^-10) == 0,v[t,30]==0}, v, {t, 0, 40}, {r, 10^-10, 30}, {\[Delta]}, WorkingPrecision -> MachinePrecision, Method -> {"MethodOfLines", "TemporalVariable" -> t, "SpatialDiscretization" -> {"TensorProductGrid", "MinPoints" -> 200}}, PrecisionGoal -> 15] iTfTimeToPlot0 = iTfTime[0.001]; (*Checking boundary conditions in generic points*) ((D[iTfTimeToPlot0[t, r], t] /. t -> 0) /. r -> RandomReal[]) == +0.001 10^-2 (*Output: True*) ((D[iTfTimeToPlot0[t, r], r] /. r -> 10^-10) /. t -> RandomReal[]) == 0 (*Output: False*)  V[v_] = (-1 + (1/8 (-9 + Sqrt[145]) - v)^2)^2 + 3 (1/8 (-9 + Sqrt[145]) - v)^3; sol[rmax_, \[Delta]_] := Last@Last@ Last@NDSolve[{+D[v[r], {r, 2}] + 2/r D[v[r], {r, 1}] - (D[V[v], v] /. v -> v[r]) == 0, (D[v[r], r] /. r -> SetPrecision[10^-10, 100]) == 0, v[SetPrecision[10^-10, 100]] == SetPrecision[\[Delta], 100],v[t,rmax]==0}, v, {r, 10^-10, rmax}, WorkingPrecision -> 50, Method -> "Extrapolation"] iTf = sol[30, 1.506400187591933106770472351]; Plot[{iTf[r]}, {r, 0, 30}, PlotRange -> All, Frame -> True] iTfTime = v /. ParametricNDSolve[{-D[v[t, r], {t, 2}] + D[v[t, r], {r, 2}] + 2/r D[v[t, r], {r, 1}] - (D[V[v], v] /. v -> v[t, r]) == 0, v[0, r] == iTf[r], ((D[v[t, r], t]) /. t -> 0) == +\[Delta] 10^-2, (D[v[t, r], r] /. r -> 10^-10) == 0}, v, {t, 0, 40}, {r, 10^-10, 30}, {\[Delta]}, WorkingPrecision -> MachinePrecision, Method -> {"MethodOfLines", "TemporalVariable" -> t, "SpatialDiscretization" -> {"TensorProductGrid", "MinPoints" -> 200}}, PrecisionGoal -> 15] iTfTimeToPlot0 = iTfTime[0.001]; (*Checking boundary conditions in generic points*) ((D[iTfTimeToPlot0[t, r], t] /. t -> 0) /. r -> RandomReal[]) == +0.001 10^-2 (*Output: True*) ((D[iTfTimeToPlot0[t, r], r] /. r -> 10^-10) /. t -> RandomReal[]) == 0 (*Output: False*)  V[v_] = (-1 + (1/8 (-9 + Sqrt[145]) - v)^2)^2 + 3 (1/8 (-9 + Sqrt[145]) - v)^3; sol[rmax_, \[Delta]_] := Last@Last@ Last@NDSolve[{+D[v[r], {r, 2}] + 2/r D[v[r], {r, 1}] - (D[V[v], v] /. v -> v[r]) == 0, (D[v[r], r] /. r -> SetPrecision[10^-10, 100]) == 0, v[SetPrecision[10^-10, 100]] == SetPrecision[\[Delta], 100]}, v, {r, 10^-10, rmax}, WorkingPrecision -> 50, Method -> "Extrapolation"] iTf = sol[30, 1.506400187591933106770472351]; Plot[{iTf[r]}, {r, 0, 30}, PlotRange -> All, Frame -> True] iTfTime = v /. ParametricNDSolve[{-D[v[t, r], {t, 2}] + D[v[t, r], {r, 2}] + 2/r D[v[t, r], {r, 1}] - (D[V[v], v] /. v -> v[t, r]) == 0, v[0, r] == iTf[r], ((D[v[t, r], t]) /. t -> 0) == +\[Delta] 10^-2, (D[v[t, r], r] /. r -> 10^-10) == 0,v[t,30]==0}, v, {t, 0, 40}, {r, 10^-10, 30}, {\[Delta]}, WorkingPrecision -> MachinePrecision, Method -> {"MethodOfLines", "TemporalVariable" -> t, "SpatialDiscretization" -> {"TensorProductGrid", "MinPoints" -> 200}}, PrecisionGoal -> 15] iTfTimeToPlot0 = iTfTime[0.001]; (*Checking boundary conditions in generic points*) ((D[iTfTimeToPlot0[t, r], t] /. t -> 0) /. r -> RandomReal[]) == +0.001 10^-2 (*Output: True*) ((D[iTfTimeToPlot0[t, r], r] /. r -> 10^-10) /. t -> RandomReal[]) == 0 (*Output: False*)  9 added 974 characters in body edited Apr 23 at 16:49 apt45 73944 silver badges1111 bronze badges Update I have tried adding the following methodMethod -> {"MethodOfLines", "DifferentiateBoundaryConditions" -> {True, "ScaleFactor" -> 1}}  but still the two solutions ($$v(t=0,r)$$ and $$\hat{v}(r)$$ differs for small values of $$r$$, instead they should coincide given the boundary condition)iTfTime = v /. ParametricNDSolve[{-D[v[t, r], {t, 2}] + D[v[t, r], {r, 2}] + 2/r D[v[t, r], {r, 1}] - (D[V[v], v] /. v -> v[t, r]) == 0, v[0, r] == iTf[r], ((D[v[t, r], t]) /. t -> 0) == +\[Delta] 10^-2, (D[v[t, r], r] /. r -> 10^-10) == 0, v[t, 30] == 0}, v, {t, 0, 40}, {r, 10^-10, 30}, {\[Delta]}, WorkingPrecision -> MachinePrecision, Method -> {"MethodOfLines", "DifferentiateBoundaryConditions" -> {True, "ScaleFactor" -> 1}}] iTfTimeToPlot = iTfTime[0.001] Plot[{iTfTimeToPlot[0, r], iTf[r]}, {r, 10^-10, 0.003}, PlotRange -> All] (*Output: *) Update I have tried adding the following methodMethod -> {"MethodOfLines", "DifferentiateBoundaryConditions" -> {True, "ScaleFactor" -> 1}}  but still the two solutions ($$v(t=0,r)$$ and $$\hat{v}(r)$$ differs for small values of $$r$$, instead they should coincide given the boundary condition)iTfTime = v /. ParametricNDSolve[{-D[v[t, r], {t, 2}] + D[v[t, r], {r, 2}] + 2/r D[v[t, r], {r, 1}] - (D[V[v], v] /. v -> v[t, r]) == 0, v[0, r] == iTf[r], ((D[v[t, r], t]) /. t -> 0) == +\[Delta] 10^-2, (D[v[t, r], r] /. r -> 10^-10) == 0, v[t, 30] == 0}, v, {t, 0, 40}, {r, 10^-10, 30}, {\[Delta]}, WorkingPrecision -> MachinePrecision, Method -> {"MethodOfLines", "DifferentiateBoundaryConditions" -> {True, "ScaleFactor" -> 1}}] iTfTimeToPlot = iTfTime[0.001] Plot[{iTfTimeToPlot[0, r], iTf[r]}, {r, 10^-10, 0.003}, PlotRange -> All] (*Output: *) 8 edited tags | link edited Apr 22 at 4:54 user21 24k77 gold badges6969 silver badges109109 bronze badges 7 added 13 characters in body edited Apr 19 at 15:02 apt45 73944 silver badges1111 bronze badges Tweeted twitter.com/StackMma/status/1119209315573927936 occurred Apr 19 at 12:01 6 edited title | link edited Apr 19 at 10:55 apt45 73944 silver badges1111 bronze badges 5 added 48 characters in body edited Apr 19 at 8:11 apt45 73944 silver badges1111 bronze badges 4 deleted 48 characters in body edited Apr 18 at 20:31 apt45 73944 silver badges1111 bronze badges 3 deleted 37 characters in body edited Apr 18 at 17:38 apt45 73944 silver badges1111 bronze badges 2 added 165 characters in body edited Apr 18 at 17:09 apt45 73944 silver badges1111 bronze badges 1 asked Apr 18 at 16:59 apt45 73944 silver badges1111 bronze badges