Contour lines on a 3D plot

Question

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.

Answer 1

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