Export the real roots of an equation

Question

I wish to find the roots of y (with only its real part) for different values of r in range 1(0.01)30. I have tried the following:

b = 2.6666;
Pr = 10;
y = Roots[x^3 + x^2 (1 + b + Pr) + x (b + b (r - 1) + Pr*b) + 2*Pr*b (r - 1) == 0, x];
q1 = y /. {r -> {0}}
q2 = y /. {r -> {0.01}}
q3 = y /. {r -> {0.02}}
q4 = y /. {r -> {0.03}}

Is there a neater way to do this? Also, I want to export these roots to an excel sheet as shown here:

Answer 1

$Version

"13.2.1 for Mac OS X ARM (64-bit) (January 27, 2023)"

Clear["Global`*"]

b = 2.6666;
Pr = 10;

EDIT 2: Modified to return real part of roots rather than real roots.

(table = Prepend[
    Table[{r, Sequence @@
       Re[SolveValues[
        x^3 + x^2 (1 + b + Pr) + x (b + b (r - 1) + Pr*b) + 
          2*Pr*b (r - 1) == 0, x]]},
     {r, 0, 0.03, 0.01}],
    {"r", "x1", "x2", "x3"}]) // Grid

EDIT: Or, for earlier versions without SolveValues, use

(table = 
   Prepend[Table[{r, 
      Sequence @@ Re[(x /. 
         Solve[x^3 + x^2 (1 + b + Pr) + x (b + b (r - 1) + Pr*b) + 
            2*Pr*b (r - 1) == 0, x])]}, {r, 0, 0.03, 
      0.01}], {"r", "x1", "x2", "x3"}]) // Grid

Export["test.csv", table];

Import["test.csv"] // Grid