Symbolic Vector Analysis Using Mathematica \[MathematicaIcon]  (Demo) 
Hong Qin, Plasma Physics Laboratory, Princeton University
                   1997 Mathematica Visiting Scholar

<< GeneralVectorAnalysis.m

FullForm/@{ a·(b + c), 
        (a + d)\[Cross](b\[Cross]c)}

FullForm/@{∇\[Cross](a + a\[Cross](b\[Cross]c)), 
        ∇·(a + b\[Cross]d)}

\(FullForm/@{∇\^2\((f\ g)\), A\&^, \ \(|B | \), 𝒥[r]}
        \)

DeclareVector[A, (Subscript[B, 0]), B, C, D, E, F, G, H, J, ξ, Q]; 
    DeclareScalar[a, b, c, d, e, f, g, h]

{A\[Cross]A,  A·(A\[Cross]C), 
      ∇\[Cross](∇f),  
      ∇·(∇\[Cross]A),  
      VectorExpand[A\[Cross](B\[Cross]C)]}

VectorExpand/@{
        A\[Cross](B\[Cross]C) + B\[Cross](C\[Cross]A) + 
          C\[Cross](A\[Cross]B), 
        (A\[Cross]B)\[Cross](C\[Cross]D), 
        ∇·(f (A\[Cross]B + ∇\[Cross]C))}

∇·((Subscript[B, 0])) = 0;   
    Q = ∇\[Cross](ξ\[Cross](Subscript[B, 0]));   
    J = ∇\[Cross]Q

VectorExpand[J]

\(\(SetCoordinateSystem["Cartesian"]\)[x, y, z]; 
    A = DefineVector[1, \ y\ z, \ \(-x\), x\^2]; 
    B = \((∇\(\[Cross]A\))\)[[1]]; 
    
SetCoordinateSystem["None"]; Needs["Graphics`PlotField3D`"]\)

PlotVectorField3D[
      B, {x, -10, 10}, {y, -1, 1}, {z, -1, 1}, 
      ColorFunction  ->  Hue ];

SetCoordinateSystem["Cylindrical"][r, θ, z];

A = 
      DefineVector[1, Ar[r, θ, z],  Aθ[r, θ, z], 
        Az[r, θ, z]]; 
    B = DefineVector[1, Br[r, θ, z],  Bθ[r, θ, z], 
        Bz[r, θ, z]];

A·B

A\[Cross]B

∇·A

∇\[Cross]A

{{(A^1), (A^2), (A^3)}, {(Subscript[B, 1]), (Subscript[B, 2]), (Subscript[B, 3])}}

|A |

\(\(A\&^\ \)\)

Needs["Utilities`Notation`"]

\(Symbolize[B\_0]; \ 
Clear[B]; 

    \(SetCoordinateSystem["Cartesian"]\)[x, y, z]; \)

(Subscript[B, 0]) = DefineVector[1, (Subscript[B, X]), (Subscript[B, Y]), (Subscript[B, Z])];

ξ[x, y, z] = 
      Exp[I ( (Subscript[K, X]) x +  (Subscript[K, Y]) y  +  (Subscript[K, Z]) z )] 
        DefineVector[1,  (Subscript[ξ, X]),   (Subscript[ξ, Y]) ,  (Subscript[ξ, Z]) ];

F[ξ_] := 
      (Q = ∇\[Cross](ξ\[Cross](Subscript[B, 0]));   
        (∇\[Cross]Q)\[Cross] ((((Subscript[B, 0])))/(4 π)) + 
          (∇\[Cross]((Subscript[B, 0])))\[Cross](Q/(4 π)) + 
          ∇(
              ξ·∇p  +  
                γ p ∇·ξ)  )

force = 
      Expand[-
          F[ξ[x, y, z]]/(ρ 
                Exp[I ((Subscript[K, X]) x + (Subscript[K, Y]) y + (Subscript[K, Z]) z)])];

matrix = 
      Table[Coefficient[force[[1, i]], 
          Switch[j, 1, (Subscript[ξ, X]), 2, (Subscript[ξ, Y]), 3, (Subscript[ξ, Z])]], {i, 3}, {j, 3}];

eigenfreq = FullSimplify[Expand[Eigenvalues[matrix]]]

AddCoordinateSystem["Tokamak", (Subscript[R, 0]),  ϵ][r, θ, 
        φ][{{1, 0, 0},{0, (1/(r^2)), 0},{0,0,\(1\/R\_0\%2\)-\(\(2\ \((r\ Cos[θ])\)\ ϵ\)\/R\_0\%3\)+\(\(3\ r\^2\ Cos[θ]\^2\ ϵ\^2\)\/R\_0\%4\)+O[ϵ]^3}}]

SetCoordinateSystem["Tokamak", (Subscript[R, 0]), ϵ][r, θ, 
      φ];

Clear[B,  (Subscript[B, 0])]; 
    B[r, θ, φ] = 
      DefineVector[1, 0, 
        Series[((ϵ (r^(2 )) (Subscript[B, 0]))/((Subscript[R, 0])  q[r] 
              (1 + ((ϵ r)/(Subscript[R, 0])) Cos[θ]))), {
            ϵ, 0, 2}], (Subscript[B, 0]) (Subscript[R, 0])]

J = Simplify[∇\[Cross]B[r, θ, φ]]

Simplify[|B[r, θ, φ] |  ]

\(b = Simplify[\(B[r, θ, φ]\)\&^]\)

Simplify[J\[Cross]B[r, θ, φ]]

Symbolize[ (Subscript[T,  ∥])  ]  ;  
    Symbolize[(Subscript[T,  ⊥]) ]

Vg = ((c  (Subscript[T,  ⊥]) )/(e 
            (((| B[r, θ, φ] | ))^2)))    
        b\[Cross] ∇ (|B[r, θ, φ] | ); 
    Vc = ((c 2  (Subscript[T,  ∥]) )/(e 
              (|B[r, θ, φ] | ))) 
        b \[Cross] ( (b·∇) b);  
    Vd = FullSimplify[Vg + Vc];

Vd[[1]]