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? Commented Oct 10, 2015 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. Commented Oct 10, 2015 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]
, ContourShading -> None
, 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. Commented Oct 11, 2015 at 17:38