Finding the maximum on a plot and adding dashed lines

Question

I am trying to plot the effective potential of massive particles with the help of this Mathematica code:

f[r_] := 1 - (2*M)/r + Q^2/r^2 + r^2/l^2;
M = (rp/2)*(1 + Q^2/rp^2 + rp^2/l^2);
L = 20.0;
Subscript[V, eff][r_] := f[r]*(L^2/r^2 + \[Delta]1);
\[Delta]1 = 0.0;
l = 1.0;
Q = 0.11;
A1 = Block[{rp = 0.11}, Plot[Subscript[V, eff][r], {r, 0, 1.}, PlotStyle -> Red]]
A2 = Block[{rp = 0.2}, Plot[Subscript[V, eff][r], {r, 0, 1.}, 
    PlotStyle -> Darker[Green], PlotRange -> {Automatic, {-3000, 3500}}]]
A3 = Block[{rp = 0.4}, Plot[Subscript[V, eff][r], {r, 0, 1.}, PlotStyle -> Blue]]
Show[{A1, A2, A3}, PlotRange -> {Automatic, {-3000, 3000}}, ImageSize -> 800]

I wish to add vertical dashed lines and use black dots representing the maxima of the effective potentials as given in the below figure, in my plot:

Answer 1

Clear["Global`*"]

f[r_] := 1 - (2*M)/r + Q^2/r^2 + r^2/l^2;
M = (rp/2)*(1 + Q^2/rp^2 + rp^2/l^2);
L = 20;
Subscript[V, eff][r_] := f[r]*(L^2/r^2 + δ1);
δ1 = 0;
l = 1;
Q = 11/100;

max[rp_] = Assuming[r > rp > 0,
   Maximize[{Subscript[V, eff][r], r > rp > 0}, r] // Simplify];

Plot[Evaluate@
  Table[Subscript[V, eff][r], {rp, {11/100, 1/5, 2/5}}], {r, 0, 1},
 PlotStyle -> {Red, Darker[Green], Blue},
 PlotRange -> {{0.07, 1}, {-3000, 3000}},
 ImageSize -> 500,
 AxesLabel -> {r, Subscript[V, eff]},
 Epilog -> {Dashed,
   Red, InfiniteLine[
    {{0.11, 0}, {0.11, 1}}],
   Darker[Green], InfiniteLine[
    {{0.2, 0}, {0.2, 1}}],
   Blue, InfiniteLine[
    {{0.4, 0}, {0.4, 1}}],
   Black, AbsolutePointSize[4],
   Point[({r, Subscript[V, eff][r]} /.
        {rp -> #, max[#][[2, 1]]}) & /@
     {0.11, 0.2, 0.4}]},
 PlotLegends -> Placed[
   (StringForm["``=``", Subscript[r, "+"], NumberForm[#, {5, 2}]] & /@
     {0.11, 0.2, 0.4}), {0.85, 0.25}]]

Answer 2

Clear["Global`*"]
f[r_] := 1 - (2*M)/r + Q^2/r^2 + r^2/l^2;
M = (rp/2)*(1 + Q^2/rp^2 + rp^2/l^2);
L = 20.0;
Subscript[V, eff][r_] := f[r]*(L^2/r^2 + \[Delta]1);
\[Delta]1 = 0.0;
l = 1.0;
Q = 0.11;

{m1, m2, m3} = 
 NMaximize[{Subscript[V, eff][r], r > 0.1}, r] /. rp -> # & /@ {0.11, 
    0.2, 0.4} // Quiet
pts = {First@Values@Last@#, First@#} & /@ {m1, m2, m3}

Plot[Evaluate[
  Subscript[V, eff][r] /. rp -> # & /@ {0.11, 0.2, 0.4}
  ]
 , {r, 0, 1.}
 , PlotStyle -> {Red, Darker@Green, Blue},
 Epilog -> {
   AbsolutePointSize[5], Black, Point /@ pts
   , Dashed, Transpose[{{Red, Darker@Green, Blue}
     , Map[InfiniteLine,
      {{#, 0}, {#, 1}} & /@ {0.11, 0.2, 0.4}, {1}]}]
   , Text[Last@#, # + {0, 140}] & /@ pts
   }
 , PlotLegends -> Placed[
   LineLegend[{Red, Darker@Green, Blue}, "r+ = " <> 
       ToString[NumberForm[#, {5, 2}]] & /@ {0.11, 0.2, 0.4}
    ], {0.8, 0.14}
   ]
 , ImageSize -> Large
 ]