Placing a ContourPlot under a Plot3D

Strategy is simple texture map 2D plot on a rectangle under your 3D surface. I took a liberty with some styling that I like - you can always come back to yours.

contourPotentialPlot1 = ContourPlot[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 
   0.275 h^2 s^2 + 0.125 s^4, {h, -400, 400}, {s, -300, 300}, 
 PlotRange -> {-1.4*10^8, 2*10^7}, Contours -> 15, Axes -> False, 
 PlotPoints -> 30, PlotRangePadding -> 0, Frame -> False, ColorFunction -> "DarkRainbow"];

potential1 = Plot3D[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 0.275 h^2 s^2 + 
    0.125 s^4, {h, -400, 400}, {s, -300, 300}, 
   PlotRange -> {-1.4*10^8, 2*10^7}, ClippingStyle -> None, 
   MeshFunctions -> {#3 &}, Mesh -> 15, MeshStyle -> Opacity[.5], 
   MeshShading -> {{Opacity[.3], Blue}, {Opacity[.8], Orange}}, Lighting -> "Neutral"];

level = -1.2 10^8; gr = Graphics3D[{Texture[contourPotentialPlot1], EdgeForm[], 
Polygon[{{-400, -300, level}, {400, -300, level}, {400, 300, level}, {-400, 300, level}}, 
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}, Lighting -> "Neutral"];

Show[potential1, gr, PlotRange -> All, BoxRatios -> {1, 1, .6}, FaceGrids -> {Back, Left}]

enter image description here

You can see I used PlotRangePadding -> 0 option in ContourPlot. It is to remove white space around the graphics to make texture mapping more precise. If you need utmost precision you can take another path. Extract graphics primitives from ContourPlot and make them 3D graphics primitives. If you need to color the bare contours - you could replace Line by Polygon and do some tricks with FaceForm based on a contour location.

level = -1.2 10^8;
pts = Append[#, level] & /@ contourPotentialPlot1[[1, 1]];
cts = Cases[contourPotentialPlot1, Line[l_], Infinity];
cts3D = Graphics3D[GraphicsComplex[pts, {Opacity[.5], cts}]];

Show[potential1, cts3D, PlotRange -> All, BoxRatios -> {1, 1, .6}, 
 FaceGrids -> {Bottom, Back, Left}]

enter image description here


A simpler version but not as nice as Vitally's is this:

potential1 /. 
 Graphics3D[gr_, opts___] :> 
  Graphics3D[{gr, Scale[gr, {1, 1, 1/100}, {0, 0, -2 10^8}]}, 
   PlotRange -> All, opts]

enter image description here

This can also be "projected" onto the other sides.

potential1 /. 
 Graphics3D[gr_, opts___] :> 
  Graphics3D[{gr, Scale[gr, {1, 1, 1/100}, {0, 0, -2 10^8}], 
    Scale[gr, {1/100, 1, 1}, {-400, 0, 0}]}, PlotRange -> All, opts]

enter image description here


Here's one using SliceContourPlot3D (introduced in 10.2) and Vitaliy's stylings.

f = -3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 0.275 h^2 s^2 + 0.125 s^4;

min = -1.4*10^8;
max = 2*10^7;

potential1 = Plot3D[f, {h, -400, 400}, {s, -300, 300}, 
  PlotRange -> {min, max}, ClippingStyle -> None, MeshFunctions -> {#3 &}, 
  Mesh -> 15, MeshStyle -> Opacity[.5], 
  MeshShading -> {{Opacity[.3], Blue}, {Opacity[.8], Orange}}, 
  Lighting -> "Neutral"
]

enter image description here

slice = SliceContourPlot3D[f, z == min, 
  {h, -400, 400}, {s, -300, 300}, {z, min - 1, min + 1}, 
  PlotRange -> {min, max}, Contours -> 15, Axes -> False, 
  PlotPoints -> 50, PlotRangePadding -> 0, ColorFunction -> "DarkRainbow"
]

enter image description here

Show[potential1, slice, PlotRange -> All, BoxRatios -> {1, 1, .6}, FaceGrids -> {Back, Left}]

enter image description here