In Balance

A follow-up to Map, this is also the Mercator projection of circles on a rotating sphere. In this case, I'm taking concentric circles about the point $(0,1,0)$, then rotating around the $x$-axis.

The key is to use ContourPlot[]: the concentric circles correspond to points on the sphere with a given dot product with $(0,1,0)$, but what I'm actually doing is applying ContourPlot[] to the composition of the inverse Mercator projection (from the plane to the sphere) and the dot product with $(0,1,0)$. To define the inverse Mercator map, recall that the Mercator projection is defined in terms of longitude and latitude by $(\lambda, \phi) \mapsto (\lambda, \ln(\tan(\pi/4+\phi/2)))$. That means that a point $(x,y)$ (with $-\pi \leq x \leq \pi$) is mapped to by the point on the sphere with latitude $x$ and longitude $2( \arctan e^y-\pi/4)$, which to say, the point $(\operatorname{sech} y \cos x, \operatorname{sech} y \sin x,\tanh y)$ in Cartesian coordinates:

InverseMercator[{x_, y_}] := {Sech[y] Cos[x], Sech[y] Sin[x], Tanh[y]};

To make the animation, then, it's just a matter of choosing a color scheme (in this case "GrayTones") and then evaluating ContourPlot[]:

Manipulate[
 ContourPlot[
  InverseMercator[{x, y}].RotationTransform[?, {1, 0, 0}][{0, 1, 0}],
  {x, -?, ?}, {y, -?, ?}, Frame -> False, 
  ImageSize -> 540, ContourStyle -> None, 
  Contours -> Range[-.95, .95, .1], PlotRangePadding -> -0.01, 
  ColorFunction -> "GrayTones"],
{?, 0, 2 ?}]