El.lipsoid  de  polaritzabilitat

ClearAll["Global`*"]

\(\( (*\ 
      Eq.\ de\ l´el.
            \(lipsoid : \ \((x\ y\ z)\) t \((ij)\) \((x\ y\ z)\)\)\  = \ 1; \ 
      això\ 
          \(és : 

            t \((11)\) x^2\  + \ t \((22)\) y^2\  + \ t \((33)\) z^2\  + \ 
              \((t \((12)\) + \ t \((21)\))\) xy\  + \ 

              \((t \((31)\) + \ t \((13)\))\)\ xz\  + \ 
              \((t \((23)\) + \ t \((32)\))\)\ yz\)\  = \ 1; \ 
      amb\ t \((ij)\)\ representem

      	les\ diferents\ components\ de\ la\ polaritzabilitat*) 

     (*\ planol\ y = 0\ \ *) 


    f[x_, z_] := 
      x^2*\ t[\([1, 1]\)] + y^2*t[\([2, 2]\)] + z^2*t[\([3, 3]\)] + 
          2*x*y*t[\([1, 2]\)] + 
		2*x*z*t[\([1, 3]\)] + \ 
          2*y*z*t[\([2, 3]\)] - 1 /. y -> 0\)\)

\(\( (*\ considerem\ el\ cas\ concret\ seguent*) 

    \(t = {{1, 1, 2}, {1, 10, 3}, {2, 3, 10}}; \)\)\)

sol = f[x, z]

\(sol2 = Solve[sol == 0, z]; 
z1[x_] = sol2[\([1, 1, 2]\)]; 

    z2[x_] = sol2[\([2, 1, 2]\)]\)

\(lim = \@\(5/3\) // N; 

    u = Plot[z1[x], {x, \(-lim\), lim}, AspectRatio -> 1]; 

    dos = Plot[z2[x], {x, \(-lim\), lim}, AspectRatio -> 1]; 
    Show[u, dos, AspectRatio -> GoldenRatio]\)

\(\( (*\ calculem\ els\ autovalors\ d' aquest\ tensor

      amb\ la\ finalitat\ de\ trobar\ els\ seus\ eixos\ pròpis*) 

    sol = \(Eigenvalues[t] // N\) // Chop\)\)

t = {{sol[[1]], 0, 0}, {0, sol[[2]], 0}, {0, 0, sol[[3]]}}

sol = f[x, z]

\(sol2 = Solve[sol == 0, z]; 
z1[x_] = sol2[\([1, 1, 2]\)]; 

    z2[x_] = sol2[\([2, 1, 2]\)]\)

\(lim = \@\(1/13.3663\) // N; 

    u = Plot[z1[x], {x, \(-lim\), lim}, AspectRatio -> 1]; 

    dos = Plot[z2[x], {x, \(-lim\), lim}, AspectRatio -> 1]; 
    Show[u, dos, AspectRatio -> GoldenRatio]\)

\(\(
 (*\ 
      Alternativa\ més\ simple\  - 
        prenem\ el\ radi\ de\ l' el.lipsoid\ igual\ a\ 10

      				
      per\ pura\ questió\ de\ una\ millor\ representació\ 
        gràfica\ *) \)\)

f[x_, y_, z_] := 
      x^2* t[[1, 1]] + y^2*t[[2, 2]] + z^2*t[[3, 3]] + 
        2*x*y*t[[1, 2]] + 2*x*z*t[[1, 3]] + 2*y*z*t[[2, 3]] - 10

t = {{10, 1, 2}, {1, 5, 3}, {2, 3, 5}};

<< Graphics`ContourPlot3D`

ContourPlot3D[
      f[x, y, z], {x, -2, 2}, {y, -2, 2}, {z, -2, 2},  
      AspectRatio -> 1]

\(sol = \(Eigenvalues[t] // N\) // Chop; 

    t = {{sol[\([1]\)], 0, 0}, {0, sol[\([2]\)], 0}, {0, 0, sol[\([3]\)]}}; 

    ContourPlot3D[f[x, y, z], {x, \(-6\), 6}, {y, \(-6\), 6}, {z, \(-6\), 6}, 
      \ AspectRatio -> 1]\)