# Contour lines on a 3D plot

I have the following function.

BetheSalpeter[Q2_, ν_] =
(g^4 (-1 + x[Q2, ν])^2 x[Q2, ν]^2) /
(32 M pe1 π Q2^2 (m^2 + M^2 (-1 + x[Q2, ν]) x[Q2, ν]));


Where the unknowns are defined as follows:

x[Q2_, ν_] = (Q2 + (M + ν - Sqrt[Q2 + ν^2]) (2 m - M))/(M (ν + Sqrt[Q2 + ν^2]));
M = 1.876 // Rationalize;
m = 0.9389 // Rationalize;
g = 1;
pe1 = 1;


I would like to plot contour lines of x[Q2, ν], for x[Q2, ν] = 0 to x[Q2, ν] = 1 in steps of 1/4, on top of the three dimensional plot of BetheSalpeter[Q2, ν] and I'm not sure where to start.

• What are the limits on Q2 and \[Nu]? Also, I'm not sure what you mean by "on top of". If x has different units than BetheSalpeter, then you can't really plot them together exactly. Do you somehow want the contours to "follow" the surface defined by BetheSalpeter? Oct 10 '15 at 0:34
• Q2 runs from 0 to 6, nu runs from 0 to 3. Sorry about that. And yes, I would like what you just said. Oct 10 '15 at 15:09

## Update

Alternatively, a much much easier way:

p1 = Plot3D[BetheSalpeter[a, b]
, {a, 0.0001, 5}, {b, 0.0001, 5}
, MeshFunctions -> {Function[x[#1, #2]]}
, Mesh -> {Range[0, 1, 0.25]}
, PlotPoints -> 30]


Plot3D[Log@BetheSalpeter[a, b]
, {a, 0.0001, 5}, {b, 0.0001, 5}
, MeshFunctions -> {Function[x[#1, #2]]}
, Mesh -> {Range[0, 1, 0.25]}
, PlotPoints -> 30]


### Original post

It's a little unclear from the problem exactly what you want. Here's my interpretation: you want curves along the surface of the graph defined by the function BetheSalpeter that follow along the contours of the function x.

Definitions:

BetheSalpeter[q_, n_] = (g^4 (-1 + x[q, n])^2 x[q, n]^2)/(32 M pe1 π q^2 (m^2 + M^2 (-1 + x[q, n]) x[q, ν]));
x[q_, n_] = (q + (M + n - Sqrt[q + n^2]) (2 m - M))/(M (n + Sqrt[q + n^2]));
M = 1.876 // Rationalize;
m = 0.9389 // Rationalize;
g = 1;
pe1 = 1;


First construct the contours of x:

ps = ContourPlot[x[a, b]
, {a, 0.001, 5}, {b, 0.001, 5}
, Contours -> Range[0, 1, 0.25]
, Frame -> False, PlotPoints -> 50]
contours = Cases[Normal@ps, Line[a_] :> a, Infinity];


Then, add z-values to the contours by plugging in the q and n values to BetheSalpeter:

curves = Map[{Sequence @@ ##, BetheSalpeter @@ ##} &, #] & /@ contours;
logcurves = Map[{Sequence @@ ##, Log@*BetheSalpeter @@ ##} &, #] & /@ contours;


(I did the logarithm version for viewing purposes later.) Construct the surface plots:

p1 = Plot3D[BetheSalpeter[a, b]
, {a, 0.0001, 5}, {b, 0.0001, 5}
, Mesh -> None, PlotPoints -> 30];
p1log = Plot3D[Log@BetheSalpeter[a, b]
, {a, 0.0001, 5}, {b, 0.0001, 5}
, Mesh -> None, PlotPoints -> 30];


Then, we combine with Show:

Show[p1, Graphics3D[{Thick, Line[#]}] & /@ curves]


resulting in

Because of the long "peak", the plot clips, and PlotRange -> All kills all the interesting features. For that reason, we plot the Log version:

Show[p1log, Graphics3D[{Thick, Line[#]}] & /@ logcurves]


results in

• Sorry for the late reply but I'm wondering if there is a way to label the value of x for along each mesh line. Oct 11 '15 at 17:38