Elegant method for computing 3D normals to a RevolutionPlot3D

Question

I create a (one-dimensional) radius function, such as:

r[h_] := Sin[2.5 h] Exp[-h];

where h is a "height." Now I create a

RevolutionPlot3D[{0, r[h], h},{h, 0, 1}]

I'd like to compute (and display) three-dimensional normal vectors to the surface, both at points over the full surface, as well as at a point on the surface of my selection.

I can do this through lots of computation of derivatives and such, but I was wondering if there is some functionality of Mathematica that computes the normal elegantly.

NormalsFunction allows me to specify normals to a surface, but (as far as I can tell) not infer them from a given surface in a RevolutionPlot3D.

I'm hoping this can be done without resorting to defining a Region. I could use SliceVectorPlot (which displays vectors on a surface) but here too, I would need to go through all the computation of derivatives to define the vectors.

Ideally, I would like to simply change my radius function and have all the shape (of course) but also the normals computed directly.

---

For the experts here, defining a scalar function such as:

scalarField = r[h] - Sqrt[x^2 + y^2];

and then its derivative,

vectorField = Normalize[D[scalarField, {{x, y, z}}]];

doesn't work as the normals from vectorField are not guaranteed to be perpendicular to the surface, as required.

I could work with all the derivatives, but I was hoping Mathematica would let me avoid all that.

Answer 1

r[h_] := Sin[5/2 h] Exp[-h];

f0[h_, t_] := { r[h] Cos[t], r[h] Sin[t], h}

Using ParametricPlot3D will make it easier to add the surface of normals later:

ParametricPlot3D[f0[h, t], {h, 0, 1}, {t, 0, 2 Pi}]

nf0[h_, t_] = FullSimplify[Cross @@ Transpose[D[f0[h, t], {{h, t}}]]]

{-E^-h Cos[t] Sin[(5 h)/2], 
  -E^-h Sin[(5 h)/2] Sin[t], 
  1/4 E^(-2 h) (-2 + 2 Cos[5 h] + 5 Sin[5 h])}

s = -.3;
{h0, t0} = {.3, 3 Pi/2};
tangentplane = InfinitePlane[f0[h0, t0], 
     Transpose[D[f0[h, t], {{h, t}}]] /. {h -> h0, t -> t0}];

Show[ParametricPlot3D[{f0[h, t], f0[h, t] + s Normalize[nf0[h, t]]}, 
   {h, 0, 1}, {t, 0, 2 π},
   BoxRatios -> 1, Mesh -> None, BaseStyle -> Opacity[.5]], 
 Graphics3D[{Red, PointSize[Large], Point[f0[h0, t0]], 
   Arrow[{f0[h0, t0], f0[h0, t0] + s Normalize[nf0[h0, t0]]}], 
   EdgeForm[], Opacity[.5], Red, tangentplane}]]

With s = .15; we get