Surface of Revolution

Author

Eric W. Weisstein
April 14, 2011

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Surfaces/SurfaceofRevolution.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/SurfaceofRevolution.html.

©2011 Wolfram Research, Inc. except for portions noted otherwise

Initialization

<<Graphics`SurfaceOfRevolution`

Code

SurfaceArea[g_,{y_,a_,b_},opts___]:=2Pi Integrate[g Sqrt[1+D[g,y]^2],{y,a,b},opts]

SurfaceAreaPlot[g_,{y_,a_,b_}]:={
ParametricPlot[{g,y},{y,a,b},DisplayFunction->Identity,Ticks->None,
AspectRatio->Automatic,
AxesOrigin->0],
SurfaceOfRevolution[{g,y},{y,a,b},
Boxed->False,Axes->False,DisplayFunction->Identity,Ticks->None]
}

Forms

FirstFundamentalForm[{ϕ[v]Cos[u],ϕ[v]Sin[u],ψ[v]},{u,v}]//Simplify

SecondFundamentalForm[{ϕ[v]Cos[u],ϕ[v]Sin[u],ψ[v]},{u,v}]//FullSimplify

Surfaces

ParametricSurfaceOfRevolutionAreaAboutY[{x_,y_},{t_,a_,b_}]:=2Pi Integrate[x Sqrt[D[x,t]^2+D[y,t]^2],{t,a,b}]

Overview

Show[GraphicsArray[{
With[{r=1,h=2},SurfaceAreaPlot[r-((r y)/h),{y,0,h}]],
With[{r1=1,r2=2,h=1},SurfaceAreaPlot[r2+(((r1-r2) y)/h),{y,0,h}]],
With[{r=1,h=2},SurfaceAreaPlot[r,{y,0,h}]],
With[{a=1.3,c=1},SurfaceAreaPlot[a (Sqrt[1-((y^2)/(c^2))]),{y,-c,c} ]],
With[{a=1,c=1.3},SurfaceAreaPlot[a (Sqrt[1-((y^2)/(c^2))]),{y,-c,c} ]],
With[{a=.3,b=.9,r=1},SurfaceAreaPlot[Sqrt[r^2-y^2],{y,a,b} ]]
}]]

Finite Cone

FullSimplify[Solve[(y-h)==h/(-r)x,x]]

SurfaceArea[r-((r y)/h),{y,0,h}]

With[{r=1,h=2},SurfaceAreaPlot[r-((r y)/h),{y,0,h}] ]

{a (h-u)/h Cos[v],a (h-u)/h Sin[v],u}/.v->0

Assuming[a>0&&h>0,FullSimplify[ParametricSurfaceOfRevolutionAreaAboutY[{((a (h-u))/h),u},{u,0,h}]]]

Conical Frustum

FullSimplify[Solve[(y-h)==h/(r1-r2)(x-r1),x]]

Simplify[PowerExpand[Together//@SurfaceArea[r2+(((r1-r2) y)/h),{y,0,h}]]]

With[{r1=1,r2=2,h=1},SurfaceAreaPlot[r2+(((r1-r2) y)/h),{y,0,h}]]

{((a (h-u)+b u) Cos[v])/h,((a (h-u)+b u) Sin[v])/h,u}/.v->0

Assuming[a>0&&b>0&&h>0,FullSimplify[ParametricSurfaceOfRevolutionAreaAboutY[{((a (h-u)+b u)/h),u},{u,0,h}]]]

Finite Cylinder

SurfaceArea[r,{y,0,h}]

With[{r=1,h=2},SurfaceAreaPlot[r,{y,0,h}]]

{a Cos[u],a Sin[u],v}/.u->0

Assuming[a>0&&b>0&&h>0,FullSimplify[ParametricSurfaceOfRevolutionAreaAboutY[{a,v},{v,0,h}]]]

Oblate Spheroid

Solve[x^2/a^2+y^2/c^2==1,x]

Expand[Simplify[PowerExpand[SurfaceArea[a (Sqrt[1-((y^2)/(c^2))]),{y,-c,c},Assumptions->a>c]]]]

Simplify[((a (c^2) π Log[(c ((a^2)-(c^2)+a (Sqrt[(a^2)-(c^2)])))/(c (-(a^2)+(c^2)+a (Sqrt[(a^2)-(c^2)])))])/(Sqrt[(a^2)-(c^2)])) /. c->a Sqrt[1-e^2]]

Simplify[PowerExpand[((a (e^2)+(Sqrt[(a^2) (e^2)]))/(-a (e^2)+(Sqrt[(a^2) (e^2)])))]]

2 (a^2) π-((((a^3) (-1+(e^2)) π )/(a e)))Log[((1+e)/(1-e))]

2 (a^2) π-((c^2 π Log[((1+e)/(1-e))])/e)

With[{a=1.3,c=1},SurfaceAreaPlot[a (Sqrt[1-((y^2)/(c^2))]),{y,-c,c} ]]

{a Cos[u] Sin[v],a Sin[u] Sin[v],c Cos[v]}/.u->0

Assuming[a>0&&c>0,FullSimplify[ParametricSurfaceOfRevolutionAreaAboutY[{a Sin[v],c Cos[v]},{v,0,π/2}]]]

Prolate Spheroid

Solve[x^2/a^2+y^2/c^2==1,x]

Simplify[PowerExpand[SurfaceArea[a (Sqrt[1-((y^2)/(c^2))]),{y,-c,c},Assumptions->{c>a}]]]

But the Oblate/Prolate Formulations are identical

e[a,c]:=Sqrt[1-c^2/a^2]

{(((c^2) π Log[((1+e[a,c])/(1-e[a,c]))])/(e[a,c])),2Pi(a c/e[c,a])ArcSin[e[c,a]]}

Chop[Subtract@@@Table[{(((c^2) π Log[((1+e[a,c])/(1-e[a,c]))])/(e[a,c])),2Pi(a c/e[c,a])ArcSin[e[c,a]]} /.{a->Random[Real,{0,4}],c->Random[Real,{0,4}]},{100}]]

With[{a=1,c=1.3},SurfaceAreaPlot[a (Sqrt[1-((y^2)/(c^2))]),{y,-c,c} ]]

Torispheircal Dome

SurfaceArea[If[x<c(1+((((R/a)-1))^(-1))),(Sqrt[(R^2)-(x^2)])-(R-h),(Sqrt[(a^2)-(((x-c))^2)])],{x,0,a+c},Assumptions->0<a+c<R&&0<a<c]

SurfaceArea[If[z<a((R-h)/(R-a)),c+(Sqrt[(a^2)-(z^2)]),(Sqrt[(R^2)-(((z+(R-h)))^2)])],{z,0,h},Assumptions->0<a+c<R&&0<a<c<R&&0<a<h<R]

With[{R=1,c=.6,a=.3},
With[{h=R-(Sqrt[(a-c-R) (a+c-R)])},
{
2 π ((a^2)+a c+c R),
2a c ArcSin[((R-h)/(R-a))]+2π R (h-a((R-h)/(R-a))),
2a c ArcSin[((R-h)/(R-a))]+π((c(1+((((R/a)-1))^(-1))))^2+(h-a((R-h)/(R-a)))^2)
}
]]

FullSimplify[{
2 π ((a^2)+a c+c R+(R^2) ArcSin[(c/(a-R))]+h R ArcSin[(c/(-a+R))]),
2a c ArcSin[((R-h)/(R-a))]+2π R (h-a((R-h)/(R-a))),
2a c ArcSin[((R-h)/(R-a))]+π((c(1+((((R/a)-1))^(-1))))^2+(h-a((R-h)/(R-a)))^2)
},0<a+c<R&&0<a<c]//ColumnForm

Torus

Solve[(x-c)^2+y^2==a^2,x]

s=FullSimplify[SurfaceArea[c-(Sqrt[(a^2)-(y^2)]),{y,-a,a}]+SurfaceArea[c+(Sqrt[(a^2)-(y^2)]),{y,-a,a}]]

ComplexExpand[s]

With[{a=1.3,c=1},SurfaceAreaPlot[a (Sqrt[1-((y^2)/(c^2))]),{y,-c,c} ]]

{(c+a Cos[v]) Cos[u],(c+a Cos[v]) Sin[u],a Sin[v]}/.u->0

Assuming[a>0&&c>0,FullSimplify[ParametricSurfaceOfRevolutionAreaAboutY[{c+a Cos[v],a Sin[v]},{v,0,2π}]]]

Zone

SurfaceArea[Sqrt[r^2-y^2],{y,a,b}]

Simplify[PowerExpand[2 π (-a (Sqrt[(r^2)]) +b (Sqrt[(r^2)]))]]

With[{a=.3,b=.9,r=1},SurfaceAreaPlot[Sqrt[r^2-y^2],{y,a,b} ]]

a{Cos[u] Sin[v],Sin[u] Sin[v],Cos[v]}/.u->0

Assuming[d>0&&a>0,FullSimplify[ParametricSurfaceOfRevolutionAreaAboutY[{a Sin[v],a Cos[v]},{v,ArcCos[(d+h)/a],ArcCos[d/a]}]]]

Plots

Elliptical Torus

Show[GraphicsArray[{SurfaceOfRevolution[{2+.5Cos[t],Sin[t]},{t,0,2Pi},Boxed->False,Axes->False,DisplayFunction->Identity],
Show[{ParametricPlot[{2+.5Cos[t],Sin[t]},{t,0,2Pi},PlotStyle->{Thickness[.01]},DisplayFunction->Identity,Axes->{False,True},AspectRatio->Automatic,AxesOrigin->{0,0},Ticks->None,PlotRange->All],
Graphics[Line[{{-.1,0},{2.6,0}}]]}]
}]]

Sphere

Show[GraphicsArray[{SurfaceOfRevolution[{Cos[t],Sin[t]},{t,-Pi/2,Pi/2},Boxed->False,Axes->False,DisplayFunction->Identity],
ParametricPlot[{Cos[t],Sin[t]},{t,-Pi/2,Pi/2},Ticks->None,DisplayFunction->Identity,AspectRatio->Automatic]
}]]

Torus

Show[GraphicsArray[{SurfaceOfRevolution[{2+Cos[t],Sin[t]},{t,0,2Pi},Boxed->False,Axes->False,DisplayFunction->Identity],
Show[{ParametricPlot[{2+Cos[t],Sin[t]},{t,0,2Pi},DisplayFunction->Identity,PlotStyle->{Thickness[.01]},Axes->{False,True},AspectRatio->Automatic,AxesOrigin->{0,0},Ticks->None,PlotRange->All],Graphics[Line[{{-.1,0},{3.1,0}}]]}]
}]]

RevolutionPlot3D

RevolutionPlot3D[{2+Cos[t],Sin[t]},{t,0,2Pi}]

RevolutionPlot3D[{Cos[t],Sin[t]},{t,-π,π}]

Surface Area

Sphere

About x-axis

With[{r=1},Show[{
RevolutionPlot3D[{x,(Sqrt[(r^2)-(x^2)])},{x,0,r},Axes->True,Boxed->False,AxesOrigin->{0,0,0}],
Graphics3D[Text@@@Transpose[{Style[#,Directive[Bold,Red],14]&/@{x,y,z},1.2r IdentityMatrix[3]}]]}]]

Assuming[r>0,With[{y=(Sqrt[(r^2)-(x^2)])},Simplify[2π Integrate[y(Sqrt[1+((D[y,x])^2)]),{x,0,r}]]]]

Parametric About x-axis

Plot[Cos[t],{t,0,2π}]

With[{x=r Cos[t],y=r Sin[t]},Assuming[r>0,Simplify[2π Integrate[x(Sqrt[D[x,t]^2+D[y,t]^2]),{t,0,π/2}]]]]

With[{x=r Cos[t],y=r Sin[t]},Assuming[r>0,Simplify[2π Integrate[x(Sqrt[D[x,t]^2+D[y,t]^2]),{t,-π/2,π/2}]]]]

ParametricPlot[{Cos[t],Sin[t]},{t,-π/2,π/2}]

About y-axis

With[{r=1},Show[{
RevolutionPlot3D[{(Sqrt[(r^2)-(y^2)]),y},{y,0,r},Axes->True,Boxed->False,AxesOrigin->{0,0,0}],
Graphics3D[Text@@@Transpose[{Style[#,Directive[Bold,Red],14]&/@{x,y,z},1.2r IdentityMatrix[3]}]]}]]

Assuming[r>0,With[{x=(Sqrt[(r^2)-(y^2)])},Simplify[2π Integrate[x(Sqrt[1+((D[x,y])^2)]),{y,0,r}]]]]

Parametric About y-axis

With[{x=r Cos[t],y=r Sin[t]},Assuming[r>0,Simplify[2π Integrate[y(Sqrt[D[x,t]^2+D[y,t]^2]),{t,0,π}]]]]

ParametricPlot[{Cos[t],Sin[t]},{t,0,2π}]