# Unknown plotting issue

I'm trying to model a surface based on the parameters listed here, it's a 2p orbital isosurface using the equations S10, S11, and S12

My model is of a 2p surface, and should look like this:

But no matter how I tweak my code I end up with this:

model = ParametricPlot3D[
{Sin[x]*Cos[y]*(-2*ProductLog[0 - (0.003*Sqrt[6])/Abs[(Sqrt[3]*Sin[x]*Cos[y])/(2*Sqrt[Pi])]]),
Sin[x]*Sin[y]*(-2*ProductLog[0 - (0.003*Sqrt[6])/Abs[(Sqrt[3]*Sin[x]*Cos[y])/(2*Sqrt[Pi])]]),
Cos[x]*(-2*ProductLog[0 - (0.003*Sqrt[6])/Abs[(Sqrt[3]*Sin[x]*Cos[y])/(2*Sqrt[Pi])]])},
{x, 0.040893729329, 3.10069892426},
{y, ArcSin[0.0408823325378/Sin[x]], Pi -ArcSin[0.0408823325378/Sin[x]]}]

Export["model.stl", model]


• See my extended comment below. Also, please add to your question the specific function(s) from your linked paper that you want to plot in Mathematica. Feb 8, 2021 at 18:09
• Have you see: mathematica.stackexchange.com/questions/32378/… Feb 9, 2021 at 21:21

I would not use the Lambert function, this makes things only complicated, but plot the wave function or the probability directly. To be able to use ContourPlot you need to calculate the polar coordinates from the cartesian coordinates.

For an example I do not bother with the constants and set them all to 1 and I choose l=1 and m=0. You are welcome to try other l and m. I then plot a contour surface of the probability. You will get some error message from the coordinate change calculation, because the polar coordinates are not defined at the origin. But this is only a single point and need not distract us.

fun[x_, y_, z_] =
With[{r = Sqrt[x^2 + y^2 + z^2], th = ArcTan[z, Sqrt[x^2 + y^2]],
ph = ArcTan[x, y]},
Abs[SphericalHarmonicY[1, 0, th, ph] (r Exp[-r/2] Cos[th])]]^2;
ContourPlot3D[fun[x, y, z] == .02, {x, -3, 3}, {y, -3, 3}, {z, -7, 7},
BoxRatios -> Automatic]


• This is actually what I went with! I identified the Lambert function as my problem and got in touch with the paper's author, who directed me to another older paper using cartesian parametrics from which I generated the surfaces i needed. Feb 10, 2021 at 20:00

Just an extended comment to perhaps help everyone understand what the OP has got so far...

I suggest addressing the PlotRange so you can see all of what you have, e.g.:

model = ParametricPlot3D[
{
Sin[x]*
Cos[y]*(-2*
ProductLog[
0 - (0.003*Sqrt[6])/
Abs[(Sqrt[3]*Sin[x]*Cos[y])/(2*Sqrt[Pi])]]),
Sin[x]*Sin[
y]*(-2*ProductLog[
0 - (0.003*Sqrt[6])/
Abs[(Sqrt[3]*Sin[x]*Cos[y])/(2*Sqrt[Pi])]]),
Cos[x]*(-2*
ProductLog[
0 - (0.003*Sqrt[6])/
Abs[(Sqrt[3]*Sin[x]*Cos[y])/(2*Sqrt[Pi])]])
},
{x, 0.040893729329, 3.10069892426},
{y, ArcSin[0.0408823325378/Sin[x]],
Pi - ArcSin[0.0408823325378/Sin[x]]},
PlotRange -> {{-2, 2}, {-2, 2}, {-10, 10}},
ImageSize -> 1000]