How should I edit my code to produce a particular type of image?

Question

I drew this tapered prolate spheroid in Mathematica as a 3D contour plot:

ContourPlot3D[
  (x^2 + y^2 + z^2)^2 == 1.2 x^3 + 0.36 x 
  (y^2 + z^2), {x, 0, 2}, {y, -1, 1}, {z, -1, 1}]

However, I am quite inexperienced in programming with Mathematica, and I am trying to make it look like this:

At least roughly. Preferably the color scheme, aspect ratio, and general outline could be the same -- the axes would be nice but I understand that this may not be possible.

Here is what I have tried so far:

ContourPlot3D[
  (x^2 + y^2 + z^2)^2 == 1.2 x^3 + 0.36 x (y^2 + z^2), 
  {x, 0, 2}, {y, -1, 1}, {z, -1, 1}, 
  ColorFunction -> Function[{x, y, z}, ColorData["Rainbow"][z]], 
  Mesh -> 4,
  Boxed -> False, 
  Axes->False, 
  Lighting->"Neutral", 
  ImageSize->Large]`

Which makes little progress.

Also, slightly unrelated, but when I double click (or click to rotate) on the image produced by the above code, the image becomes quite vivid and clear. How do I save this version of the image, instead of the 'dulled' default?

Answer 1

Here is some analysis that I performed to get a explicit plot rather than an implicit one.

Solve[(x^2 + y^2 + z^2)^2 == 120/100 x^3 + 36/100 x (y^2 + z^2), z, Reals]

This gives

The 2nd conditional solution is clearly the one giving the top side of the egg-shaped surface you are considering. Therefore, a normal 3D plot of the expression

Sqrt[(1/50) Sqrt[3] Sqrt[27 x^2 + 700 x^3] + (1/50) (9 x - 50 x^2 - 50 y^2)]

should be pursued. It also clear the x-range of plot should be {x, 0, 6/5}. The surface is symmetrical about the x-axis, so the y-range will be {y, -ymax, ymax} and ymax can determined by first evaluating

Reduce[
  0 < x < 6/5 && 
    Sqrt[2] Sqrt[9 x - 50 x^2 + Sqrt[3] Sqrt[x^2 (27 + 700 x)]] - 10 y > 0, 
  y]

0 < x < 6/5 && y < Root[-30 x^3 + 25 x^4 + (-9 x + 50 x^2) #1^2 + 25 #1^4&, 2]

and then

FindMaximum[Root[-30 x^3 + 25 x^4 + (-9 x + 50 x^2) #1^2 + 25 #1^4 &, 2], x]

{0.43456, {x -> 0.649557}}

This suggests that {y, -1/2, 1/2} will work for the y-range.

Using the results of my little analysis, I made the following plot:

Plot3D[
  Sqrt[(1/50) Sqrt[3] Sqrt[27 x^2 + 700 x^3] + (1/50) (9 x - 50 x^2 - 50 y^2)],
  {x, 0, 6/5}, {y, -1/2, 1/2}, 
  ColorFunction -> Function[{x, y, z}, ColorData["Rainbow"][z]],
  PlotStyle -> Opacity[.92],
  PlotPoints -> 50,
  BoxRatios -> {1, 1, 1/3},
  Mesh -> None,
  Boxed -> False,
  Axes -> False,
  SphericalRegion -> True,
  Lighting -> "Neutral",
  ImageSize -> 500]

This is certainly closer to the plot you show than the plot your code produces. The question I have is: it is close enough for this post to answer your question?

Update

This update address an issue raised by the OP in a comment to this question.

Here is how to add the lines you ask for. The numbers that determine the end points of the lines come from the analysis given above.

surface =
  Plot3D[
    Sqrt[(1/50) Sqrt[3] Sqrt[27 x^2 + 700 x^3] + (1/50) (9 x - 50 x^2 - 50 y^2)],
    {x, 0, 6/5}, {y, -1/2, 1/2}, 
    ColorFunction -> Function[{x, y, z}, ColorData["Rainbow"][z]],
    PlotStyle -> Opacity[.92],
    PlotPoints -> 50,
    BoxRatios -> {1, 2*0.43456, .43456},
    Mesh -> None,
    Boxed -> False,
    Axes -> False,
    SphericalRegion -> True,
    Lighting -> "Neutral",
    ImageSize -> 500];

lines = 
  Graphics3D[
    {AbsoluteThickness[4], CapForm[None],
     Line[{{0, 0, 0}, {1.2, 0, 0}}], 
     Line[{{.649557, -.43456, 0}, {.649557, .43456, 0}}], 
     Line[{{.649557, 0, 0}, {.649557, .0, .43456}}]}];

Show[surface, lines]

The following views make it evident that the surface is the top half of an egg-shaped surface and not an ellipsoid.

top view

front veiw