For the double torus, a suitable function f has the formula
(h(x)+y^{2})^{2}+z^{2},
where h is given to Mathematica as

**
h[x_]:= (x-1)*x^2*(x+1),**

with graph as shown on the right.

Suppose the function f above does have a double torus as level surface.
To write the commands that will plot it, we would like to know,
ahead of time, a
coordinate box that will contain it. To find such limiting coordinates,
we draw the
intercepts of the torus with the coordinate planes of R^{3}.

To get the intercept with the xy plane, set z=0 in the formula for f. Then the command

**ContourPlot[(h[x]+y^2)^2,
**

** {x,-1.1,1.1},{y,-.63,.63},Contours->{.02},
**

** AspectRatio->Automatic,PlotPoints->40]**

will produce the intercept.

The parameters used here were found as much by trial-and-error as by
computation. However, for an indication of how the function f can produce a double
torus,. consider the line x=0.7 in the figures. If y=0, then since h(.7) ~ -0.22, the value
(h(.7)+0)^{2} ~ 0.04 already exceeds 0.02, so there can be no point
(.7,0,z) on the level surface f=0.02. By constrast, if y=±0.5, then clearly
(h(.7)+.25)^{2} is less than 0.02, so there *are* points
(.7,±.5,z) on f=0.02.

The intercept in the xz plane is given by

**ContourPlot[h[x]^2+z^2,
{x,-1.1,1.1},{z,-.2,.2},
**

** Contours->{.02},AspectRatio->Automatic,
PlotPoints->40]**

This plot will show that the z values of torus lie in the interval -0.2 < z < 0.2

The yz intercept is a single oval, giving no new information.

We construct the double torus as a union of three parts, an approach that will
make it easy to produce plots of *multitori*, those with any number of holes.
To plot level surfaces of a function on 3-space, we install a command
from Mathematica's Graphics package:

**<<Graphics`Contour3D`**

(Note that *backquotes*appear here, not ordinary single quotes.)

Mathematica does not find it easy to produce a good double torus from a single command. But asking for less gives something much more useful.

**bigX =
ContourPlot3D[(h[x]+y^2)^2+z^2,
**

** {x,-.7,.7},{y,-.63,.63},{z,-.2,.2},
**

** Contours->{.02},AspectRatio->Automatic,PlotPoints->{4,7}]
**

The ends are plotted by

** lftend = ContourPlot3D[(h[x]+y^2)^2+z^2,
**

** {x,-1.5,-.7},{y,-.63,.63},{z,-.2,.2},
**

** Contours->{.02},AspectRatio->Automatic,PlotPoints->{4,7}]
**

and

** rtend = ContourPlot3D[(h[x]+y^2)^2+z^2,
**

** {x,.7,1.5},{y,-.63,.63},{z,-.2,.2},
**

** Contours->{.02},AspectRatio->Automatic,PlotPoints->{4,7}]
**

Then the ends are attached by the following command, which also removes the enclosing boxes.

**Show[{lftend,bigX,rtend},
Boxed->False]**

To construct a multitorus with any number of holes, just glue another bigX onto the first one, and then another, and so on--finishing by attachinging left and right ends, as above.

We illustrate this in the case of the three-hole torus. The second bigX--the one to be attached to the first--is just a copy of the first that has been moved to the right by distance 1.4 (the width of a bigX). Thus in the command building bigX, we increase the limits on x by 1.4, and in the formula for the function f, subtract 1.4 from x.

** bigX2=ContourPlot3D[
(h[x-1.4]+y^2)^2+z^2,
**

** {x,.7,2.1},{y,-.63,.63},{z,-.2,.2},
**

** Contours->{.02},AspectRatio->Automatic,PlotPoints->{4,7}]
**

Similarly, the right end must be translated by 1.4 in the x direction

** rtend2=ContourPlot3D[
(h[x-1.4]^2+z^2)^2+z^2,
**

** {x,2.1,2.9},{y,-.63,.63},{z,-.2,.2},
**

** Contours->{.02},AspectRatio->Automatic,PlotPoints->{4,7}]
**

If all has gone well, these parts fit together to give a triple torus.

**Show[{lftend,bigX,bigX2,rtend2},
Boxed->False]**