Pensieve header: The Boy surface in the Bryant-Kusner parametrization, following http://en.wikipedia.org/wiki/Boy%27s_surface. Continues pensieve://2008-05/.

z=r (E^(I θ));
(Subscript[g, 1])=-(3/2)Im[((z(1-(z^4)))/((z^6)+(Sqrt[5])(z^3)-1))]; (Subscript[g, 2])=-(3/2)Re[((z(1+(z^4)))/((z^6)+(Sqrt[5])(z^3)-1))]; (Subscript[g, 3])=Im[((1+(z^6))/((z^6)+(Sqrt[5])(z^3)-1))]-(1/2);

Manipulate[ParametricPlot3D[(({(Subscript[g, 1]), (Subscript[g, 2]), (Subscript[g, 3])})/(((Subscript[g, 1])^2)+((Subscript[g, 2])^2)+((Subscript[g, 3])^2))),
{r,0,1}, {θ, 0, 2π},
PlotPoints -> 50, Mesh -> False, Boxed -> False,Axes -> False, PlotStyle -> {Opacity[0.75]},
PlotRange->{All, All, {-2,t}}, ViewPoint->{1.57603,-2.20037,2.03088},ViewVertical->{0.0428432,0.0431793,1.35113}
], {{t,0}, -1.75,0.5}]

ParametricPlot3D[(({(Subscript[g, 1]), (Subscript[g, 2]), (Subscript[g, 3])})/(((Subscript[g, 1])^2)+((Subscript[g, 2])^2)+((Subscript[g, 3])^2))),
{r,0,1}, {θ, 0, 2π},
PlotPoints -> 50, Mesh -> False, Boxed -> False,Axes -> False, 
PlotRange->{All, All, {-0.8,-0.4}}, ViewPoint->{1.57603,-2.20037,2.03088},ViewVertical->{0.0428432,0.0431793,1.35113}
]

Table[
ParametricPlot3D[(({(Subscript[g, 1]), (Subscript[g, 2]), (Subscript[g, 3])})/(((Subscript[g, 1])^2)+((Subscript[g, 2])^2)+((Subscript[g, 3])^2))),
{r,0,1}, {θ, 0, 2π},
PlotPoints -> 50, Mesh -> False, Boxed -> False,Axes -> False, 
PlotRange->{All, All, {t,t+0.1}}, ViewPoint->{1.57603,-2.20037,2.03088},ViewVertical->{0.0428432,0.0431793,1.35113}
],
{t,-1.8,0.5,0.1}]

z=r (E^(I θ));
(Subscript[g, 1])=-(3/2)Im[((z(1-(z^4)))/((z^6)+(Sqrt[5])(z^3)-1))]; (Subscript[g, 2])=-(3/2)Re[((z(1+(z^4)))/((z^6)+(Sqrt[5])(z^3)-1))]; (Subscript[g, 3])=Im[((1+(z^6))/((z^6)+(Sqrt[5])(z^3)-1))]-(1/2);
Manipulate[ParametricPlot3D[(({(Subscript[g, 1]), (Subscript[g, 2]), (Subscript[g, 3])})/(((Subscript[g, 1])^2)+((Subscript[g, 2])^2)+((Subscript[g, 3])^2))),
{r,0,t}, {θ, 0, 2π},
PlotPoints -> 50, Mesh -> False, Boxed -> False,Axes -> False, PlotStyle -> {Opacity[0.75]}
], {{t,0.5}, 0.1,1}]

z=r (E^(I θ));
(Subscript[g, 1])=-(3/2)Im[((z(1-(z^4)))/((z^6)+(Sqrt[5])(z^3)-1))]; (Subscript[g, 2])=-(3/2)Re[((z(1+(z^4)))/((z^6)+(Sqrt[5])(z^3)-1))]; (Subscript[g, 3])=Im[((1+(z^6))/((z^6)+(Sqrt[5])(z^3)-1))]-(1/2);
frames=Table[ParametricPlot3D[(({(Subscript[g, 1]), (Subscript[g, 2]), (Subscript[g, 3])})/(((Subscript[g, 1])^2)+((Subscript[g, 2])^2)+((Subscript[g, 3])^2))),
{r,0,1}, {θ, 0, 2π},
PlotPoints -> 50, Mesh -> False, Boxed -> False,Axes -> False, PlotStyle -> {Opacity[0.75]},
PlotRange->{All, All, {-2,t}}
],
{t, Union[
Table[t,{t, -1.4,0.5,0.02}],
Table[t, {t, -0.9, -0.5, 0.005}]
]}
];
SetDirectory["C:\\drorbn\\AcademicPensieve\\2013-04"];
Export["Boy.gif", frames]