0
$\begingroup$

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:

2p orbital model from EQ

But no matter how I tweak my code I end up with this:2p failed model

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]

Code

Improve this question
$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – Jagra
    Feb 8, 2021 at 18:09
  • $\begingroup$ Have you see: mathematica.stackexchange.com/questions/32378/… $\endgroup$
    – Daniel Huber
    Feb 9, 2021 at 21:21

2 Answers 2

Reset to default
1
$\begingroup$

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]

enter image description here

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ 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. $\endgroup$
    – Erik Hammett
    Feb 10, 2021 at 20:00
0
$\begingroup$

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]

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.