How to program Mathematica to do the differential operator calculation

Question

I want to create a surface Laplacian under the spheroidal coordinates, Now, I already have the surface gradient defined, but I don't know how to find the Laplacian.

Since the surface gradient is too long, and it's a vector operator, I use this one as an example:

op[t_]:={Cos[t] D[#, t], Sin[t] D[#, t]}&;

Apply this on some u(t), I got:

In[540]:= op[t][u[t]]

Out[540]= {Cos[t] u'[t], Sin[t] u'[t]}

which is what I want.

However, I can't do divergence of this gradient. I've tried Composition, but it gives me a matrix instead of a scalar:

In[550]:= Composition[op[t], op[t]][u[t]]

Out[550]= {{Cos[t] (-Sin[t] u'[t] + Cos[t] u"[t]), Cos[t] (Cos[t] u'[t] + Sin[t] u"[t])}, 
           {Sin[t] (-Sin[t] u'[t] + Cos[t] u"[t]), Sin[t] (Cos[t] u'[t] + Sin[t] u"[t])}}

which is obviously wrong.

So, how can I get the Laplacian? Please help!

Answer 1

I did not exactly get what you are doing there but the following should work in a general setting.

We start with a simple surface parameterization f (I simply use the sphere and compute the Riemannian metric g and the volume density vol induced on the parameterization domain by f. Then we apply a well known formula for the Laplace-Beltrami operator in terms of g and vol.

f = X \[Function] {Cos[X[[2]]] Cos[X[[1]]], Cos[X[[2]]] Sin[X[[1]]], Sin[X[[2]]]};

LaplaceBeltrami = u \[Function] 
   Quiet[Block[{X, XX = Table[X[[i]], {i, 1, 2}], Df, g, vol},
     Df = X \[Function] Evaluate[D[f[XX], {XX, 1}]];
     g = X \[Function] Evaluate[Df[XX]\[Transpose].Df[XX]];
     vol = X \[Function] Evaluate[Sqrt[Det[g[XX]]]];

     Evaluate[X] \[Function] Evaluate[
       Simplify[
        Tr[D[D[u[XX], {XX, 1}].Inverse[g[XX]] vol[XX], {XX, 1}]]/ vol[XX]
        ]
       ]
     ]
    ];

LaplaceBeltrami[u][{ϕ, θ}]