# Plotting the intersection of two surfaces with singular behaviour

I would like to plot the intersection of two surfaces, as in this example: https://reference.wolfram.com/language/example/HighlightTheIntersectionOfTwoSurfaces.html

However, my surfaces are badly singular at their intersection. Is there a nice workaround? I think they should be well-behaved enough that it's not hopeless. Here is the code for the surfaces and my attempt to plot their intersection.

\[Epsilon] = 0; t = 0;
A = (x^2 + y^2 + z^2 - t^2 + 1)/2;
\[Phi] = ((A x - t z) +
I (A y + t (A - 1)))/(\[Epsilon] + (A z + t x) +
I (A (A - 1) - t y));
\[Theta] = ((A y + t (A - 1)) +
I (A z + t x))/(\[Epsilon] + (A x - t z) + I (A (A - 1) - t y));
ContourPlot3D[
{Re[\[Phi]] == 1.0, Im[\[Phi]] == 1.0},
{x, -plotRange, plotRange},
{y, -plotRange, plotRange},
{z, -plotRange, plotRange},
Mesh -> None, PlotPoints -> 5,
(*Boxed\[Rule]False,Axes\[Rule]None,*)
PlotPoints -> 60,
MeshFunctions -> {Function[{x, y, z, f},
Re[\[Phi]] - Im[\[Phi]]]}, MeshStyle -> {{Thick, Blue}},
Mesh -> {{0}},
ContourStyle ->
Directive[Orange, Opacity[0.5], Specularity[White, 30]]
]


## 1 Answer

• In the first ContourPlot3D, we only draw the surface Re[ϕ] == 1.0 and its Mesh according to the condition Re[ϕ] - Im[ϕ].

• Then we draw the second surface Im[ϕ] == 1.0 and using Show.

ϵ = 0; t = 0;
A = (x^2 + y^2 + z^2 - t^2 + 1)/2;
ϕ = ((A x - t z) +
I (A y + t (A - 1)))/(ϵ + (A z + t x) +
I (A (A - 1) - t y));
θ = ((A y + t (A - 1)) +
I (A z + t x))/(ϵ + (A x - t z) + I (A (A - 1) - t y));
plotRange = 3;
surf1 = ContourPlot3D[
Re[ϕ] == 1.0, {x, -plotRange, plotRange}, {y, -plotRange,
plotRange}, {z, -plotRange, plotRange}, PlotPoints -> 20,
MaxRecursion -> 2,
MeshFunctions -> {Function[{x, y, z, f}, Re[ϕ] - Im[ϕ]]},
MeshStyle -> {{Thick, Blue}}, Mesh -> {{0}},
ContourStyle ->
Directive[Orange, Opacity[0.5], Specularity[White, 30]]];
surf2 = ContourPlot3D[
Im[ϕ] == 1.0, {x, -plotRange, plotRange}, {y, -plotRange,
plotRange}, {z, -plotRange, plotRange}, PlotPoints -> 20,
MaxRecursion -> 2, MeshStyle -> {{Thick, Blue}}, Mesh -> None,
ContourStyle ->
Directive[Orange, Opacity[0.5], Specularity[White, 30]]];
Show[surf2, surf1]


• In some case it looks better than draw {Re[ϕ] == 1.0, Im[ϕ] == 1.0} in the same time.
ϵ = 0; t = 0;
A = (x^2 + y^2 + z^2 - t^2 + 1)/2;
ϕ = ((A x - t z) +
I (A y + t (A - 1)))/(ϵ + (A z + t x) +
I (A (A - 1) - t y));
θ = ((A y + t (A - 1)) +
I (A z + t x))/(ϵ + (A x - t z) + I (A (A - 1) - t y));
plotRange = 3;
surf = ContourPlot3D[{Re[ϕ] == 1.0,
Im[ϕ] == 1.0}, {x, -plotRange, plotRange}, {y, -plotRange,
plotRange}, {z, -plotRange, plotRange}, PlotPoints -> 20,
MaxRecursion -> 2,
MeshFunctions -> {Function[{x, y, z, f}, Re[ϕ] - Im[ϕ]]},
MeshStyle -> {{Thick, Blue}}, Mesh -> {{0}},
ContourStyle -> {Directive[Orange, Opacity[0.5],
Specularity[White, 30]],
Directive[Green, Opacity[0.5], Specularity[White, 30]]}]


• Super cool, thanks! On my machine the curves are still a bit jagged but I think there is not much more that can be done to fix this without getting into the muck. Nov 30, 2022 at 3:54