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

$\endgroup$
2
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

$\endgroup$
0
$\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

$\endgroup$
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 at 20:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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