(* PROGRAM BEGINS *)
 
 (* Clear memory *)
 Clear["Global`*"];
 
 (* Enter a trial (polynomial) function with real roots. *)
 f[x_] := (0)x^5 + (0)x^4 + (0)x^3 + (-1)x^2 + (0)x + (0)1 ;
 
 (* Find roots *)
roots = N[ x /. Solve[ f[x]==0,x]];

(* Assign phase lines to various conditions *)
test = Which[
f[-1] < 0 && f[1] < 0, "\[LeftArrow] \[EmptyDownTriangle] \[LeftArrow]",
f[-1] < 0 && f[1] > 0, "\[LeftArrow] \[EmptyDownTriangle] ->",
f[-1] > 0 && f[1] < 0, "-> \[FilledCircle] \[LeftArrow]",
f[-1] > 0 && f[1] > 0, "-> \[EmptyDownTriangle] ->"];

(* Assign markers to the roots, based on the sign of the
function derivative at the root location. *)
marker = ((D[f[x],x] /. x -> roots) // Sign )/.
{ 1 -> "\[LeftArrow] \[EmptyCircle] ->", -1 -> "-> \[FilledCircle] \[LeftArrow]", 0 -> test};
(* Generate plots *)
Which[ roots == Re[roots],
{
(* Generate plot limits based on the roots. *)
xmin = 2 Min[-1, Min[roots]];
xmax = 2 Max[1 , Max[roots]];
ylim = f[#]& /@ Max[x /.  Solve[ D[f[x],x] == 0, x]];
(* When the roots are real,...*)
(* Generate f (t)-t plot. *)
plt = Plot[ f[x], {x, xmin, xmax},
ImageSize -> 100];
(* Generate phase plot. *)
phs = ListPlot[ {Thread[{roots,0}][[#]]},
PlotMarkers -> If[Length[marker]!=0, {marker[[#]]} , "x"]
(* Close ListPlot *)]& /@ Table[i,{i,1,Length[roots]}];

(* Combine phase and f (t)-t plots. *)
Show[ {plt (* Delete plt if original plot is not desired *), phs},
AxesLabel  -> {"x", "y"},
PlotLabel  -> Style["Phase Plot", 24],
LabelStyle -> 24,
PlotRange  -> { {xmin, xmax}, {-2ylim, 2ylim} },
Epilog     -> Inset[(* Begin Framed *)Framed[Style[StringJoin["Roots = ",ToString[roots]], 24,
             Background -> White(* End Framed *)]],
             Scaled[{0.5,0.15}]],
ImageSize  -> 500]},

(* When the roots are imaginary,...*)
roots !=  Re[roots], {Print["Complex roots encountered.
There are no fixed points. Phase plot is not generated."]}(* Close Which *)][[1]]
(* PROGRAM ENDS *)