Liquid Crystals

In this example, I apply  Tensorial and TContinuumMechanics, to the case of distortions in a nematic single liquid crystal.
I first recall that in a nematic single crystal, the molecules are aligned on average along one common vector denoted t in the following. But the molecules are not oriented, so the direction ±t are equivalent.
The order parameter is a tensor, called Q which must be invariant by the change t⇔- t.
A nematic can be deformed, and these elastic deformations modify the free energy of the system. Three main deformations can be considered :
    - the splay (where div t ≠ 0)
    - the bend (where t . curl t = 0)
    - the twist (where t // curl t)
This leads to introduce three elastic constants (K_1, K_2, K_3).
A systematic way to found explicit relations between Q and t, curl t and div t, is described here.

Initialization

Needs["TensorCalculus4`Tensorial`"]

Needs["TContinuumMechanics2`TContinuumMechanics`"] <br />

numequ = 1 ;

oldflavors = IndexFlavors ;

ClearIndexFlavor/@oldflavors ;

DeclareIndexFlavor[{black, Black}, {red, Red}, {green, ForestGreen}, {star, SuperStar}, {blue, Blue}, {hat, OverHat}, {tilde, OverTilde}, {bar, OverBar}]

Base2d = {1, 2} ;

Base3d = {1, 2, 3} ;

DeclareBaseIndices[Base3d] ;

labs = {x, δ, g, Γ} ;

SetScalarSingleCovariantD[False]

DefineTensorShortcuts[{{, J, J1, J2, , t, x}, 1}, {{g, gt, Q, Q§, Β, β}, 2}, {{Γ}, 3}, {{}, 4}] ;

Conventionally, the "black" flavor is used for the canonical orthonormal basis :

 = IdentityMatrix[3] ;

SetTensorValues[guu[black @ i, black @ j], ]

SetTensorValues[gud[black @ i, black @ j], ]

SetTensorValues[gdu[black @ i, black @ j], ]

SetTensorValues[gdd[black @ i, black @ j], ]

Nematics : Microscopic approach

Simple rods

The rods have in average the direction t.
A single rod is charaterized by a unit vector J in spherical coordinates. We will use the average direction t=_z^z of the rods, as Z-axis:

 = d[Z] ;

DeclareBaseIndices[{X, Y, Z}]

SetTensorValues[gtud[black @ i, black @ j], ]

SetTensorValues[gtdu[black @ i, black @ j], ]

SetTensorValues[gtdd[black @ i, black @ j], ]

comp = Ju[i]//EinsteinArray[]

 = Ju[i] d[i]

{J_X^X, J_Y^Y, J_Z^Z}

J_i^i _i^i

In spherical coordinates, the unit vector J is given by,

<<Calculus`VectorAnalysis`

BasisVectors = CoordinatesToCartesian[{1, θ, φ}, Spherical]

SetTensorValueRules[Ju[i], BasisVectors]

{Cos[φ] Sin[θ], Sin[θ] Sin[φ], Cos[θ]}

MatrixForm/@(comp == (comp/.TensorValueRules[J]))

( {{J_X^X}, {J_Y^Y}, {J_Z^Z}} ) == ( {{Cos[φ] Sin[θ]}, {Sin[θ] Sin[φ]}, {Cos[θ]}} )

Distribution function of the state of alignment of the rods:

f[θ, φ] Ω ;

(*  with  *)       Ω == Sin[θ] θ φ ;

For nematics, f is (1)  independent of φ, and  (2) m and  -m are equivalent so that f(θ)==f(π-θ)

Average[X_] := <X> == ∫_0^(2π) (∫_0^π f[θ] X Sin[θ] θ) φ

< - X_> := -<X>

Average[X_ + Y_] := <X + Y> == Average[X][[2]] + Average[Y][[2]]

Average[1]/.f[θ_] →1/(4π)

<1> == 1

Jt = ( . //EvaluateDotProducts[, gt]//EinsteinSum[])/.TensorValueRules[J]

J_Z^Z

Average[Jt/.θ→π - θ]/.Integrate[F_, var_] :→Integrate[(F/.θ→π - θ), var]/.f[π - θ] →f[θ]

<J_Z^Z> == 2 π ∫_0^πf[θ] Sin[θ] J_Z^Zθ

<J_Z^Z> == 2 π ∫_0^πf[θ] Sin[θ] J_Z^Zθ

so that,

Average[Jt][[1]] == 0

<J_Z^Z> == 0

The first multipole which gives a non zero average is the quadrupole,

M2[θ_] := (3Cos[θ]^2 - 1)/2

Average[M2[θ]]

Average[M2[θ]]/.f[θ_] →1/(4π) (* when f[θ] is peaked on a value θ_0 of θ :    *)

{M2[0], M2[π/2], M2[π]}

<1/2 (-1 + 3 Cos[θ]^2) > == 2 π ∫_0^π1/4 (1 + 3 Cos[2 θ]) f[θ] Sin[θ] θ

<1/2 (-1 + 3 Cos[θ]^2) > == 0

{1, -1/2, 1}

Order parameter Q:  Three dimensional situation

DeclareBaseIndices[Base3d] ;

NDim == 3

True

The system is located in an orthonormal (black) basis e, and we consider two molecules or fiber elements with principal axis _1 and _2, close from one another. The principal axis may correspond to a magnetic moment, or to identify a steric constrain...

_1 := J1u[i] d[i]

_2 := J2u[j] d[j]

 := tu[k] d[k]

The hamiltonian of interaction is,

H12§ := -K (3 (_1 . ) (_2 . /.k→ l) - _1 . _2  . (/.k→ l))

H12 := 3K J1u[i] J2u[j] (Coefficient[H12§/(3K)//EvaluateDotProducts[, g, False], J1u[i] J2u[j]]//MetricSimplify[g])

H12

%//Expand//UpDownSwap[black @ i]//Simplify

3 K J1_i^i J2_j^j (-t_i^i t_j^j + 1/3 g_ (ij)^(ij) t_l^l t_l^l)

K J1_i^i J2_j^j (-3 t_j^j t_i^i + g_ (ij)^(ij) t_l^l t_l^l)

The uniaxial nematic tensor order parameter is (we can verify that its trace is zero) :

Q§ud[i_, j_] := Tensor[t, {i}, {Void}] * Tensor[t, {Void}, {j}] + Rational[-1, 3] * Tensor[g, {i, Void}, {Void, j}] * Tensor[t, {l}, {Void}] * Tensor[t, {Void}, {l}]

Q§ud[i, j]/.tu[k_] td[k_] →Abs[t]^2

(Q§mat = (%//ArrayExpansion[black @ i, black @ j])//MetricSimplify[g])//MatrixForm

-1/3 Abs[t]^2 g_ (ij)^(ij) + t_j^j t_i^i

( {{-1/3 Abs[t]^2 + t_1^1 t_1^1, t_2^2 t_1^1, t_3^3 t_1^1}, {t_1^1 t_2^2, -1/3 Abs[t]^2 + t_2^2 t_2^2, t_3^3 t_2^2}, {t_1^1 t_3^3, t_2^2 t_3^3, -1/3 Abs[t]^2 + t_3^3 t_3^3}} )

It is convenient to introduce the usual parameter q by,

Abs[t]^2 == NDim  q/2

Abs[t]^2 == (3 q)/2

(Eigenvalues[Q§mat]//Simplify)/.(tu[k] td[k]//EinsteinSum[]) →Abs[t]^2

Ev = %/.Abs[t]^2→NDim q/2

Eigenvectors[Q§mat]//MatrixForm

%[[1]] . %[[3]]/.{td[i_] →tu[i]}

%%[[2]] . %%[[3]]/.{td[i_] →tu[i]}

%%%[[1]] . %%%[[2]]/.{td[i_] →tu[i]}

{-1/3 Abs[t]^2, -1/3 Abs[t]^2, (2 Abs[t]^2)/3}

{-q/2, -q/2, q}

( {{-t_3^3/t_1^1, 0, 1}, {-t_2^2/t_1^1, 1, 0}, {t_1^1/t_3^3, t_2^2/t_3^3, 1}} )

0

0

(t_2^2 t_3^3)/(t_1^1)^2

diagQud[i_, j_] := 0

diagQud[1, 1] := Ev[[1]]

diagQud[2, 2] := Ev[[2]]

diagQud[3, 3] := Ev[[3]]

1 = (td[3] Eigenvectors[Q§mat][[1]] + td[2] Eigenvectors[Q§mat][[2]]) td[1]//Simplify

2 = (-td[2] Eigenvectors[Q§mat][[1]] + td[3] Eigenvectors[Q§mat][[2]]) td[1]

3 = Eigenvectors[Q§mat][[3]] td[3]/.tu[k_] →td[k]//Simplify

{1 . 2, 2 . 3, 3 . 1//Simplify}

{1 . 1, 2 . 2, 3 . 3}//Simplify

{-(t_2^2)^2 - (t_3^3)^2, t_1^1 t_2^2, t_1^1 t_3^3}

{0, t_1^1 t_3^3, -t_1^1 t_2^2}

{t_1^1, t_2^2, t_3^3}

{0, 0, 0}

{((t_2^2)^2 + (t_3^3)^2) ((t_1^1)^2 + (t_2^2)^2 + (t_3^3)^2), (t_1^1)^2 ((t_2^2)^2 + (t_3^3)^2), (t_1^1)^2 + (t_2^2)^2 + (t_3^3)^2}

The red basis will be here a monoclinic basis :

ResultFrame[Qud[i, j] == Q§ud[i, j]//ToFlavor[red]]

      Q_ (ij)^(ij) == t_j^j t_i^i - 1/3 g_ (ij)^(ij) t_l^l t_l^l      (LC_I.1)

Rotation of the basis:
We recall first the expression of a rotation matrix using Euler angles (α, β, γ)

R[α, β, γ]//MatrixForm

R[α, β, γ]//Inverse//FullSimplify//MatrixForm

% - (R[α, β, γ]//Transpose)//MatrixForm

R[α, β, γ]//Det//FullSimplify

-1 The inverse rotation is equal to its transposed, and R and R have a determinant unity (special orthogonal group SO3) :

( {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}} )

1

R is the product of the three rotations,

R[α, β, γ] == R[α, 0, 0] . R[0, β, 0] . R[0, 0, γ]

True

We call Β the basis change :

SetTensorValueRules[Βud[j, red @ i], R[α, β, γ]]

SetTensorValueRules[Βud[red @ i, j], R[α, β, γ]]

TensorValueRules[Β]

and check that,

Βud[red @ i, j] Βud[j, red @ k]

(%//EinsteinSum[]//ArrayExpansion[red @ i, red @ k])/.TensorValueRules[Β]//FullSimplify//MatrixForm

Β_ (jk)^(jk) Β_ (ij)^(ij)

( {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}} )

Qud[red @ i, red @ j] == Q§ud[p, q] Βud[red @ i, p] Βud[q, red @ j]

%//ExpandAll//KroneckerAbsorb[Β]

Print["with in addition"]

tu[l] td[l]//EinsteinSum[] ;

% == (%/.{td[l_] →td[red @ i] Βud[red @ i, l], tu[l_] →tu[red @ j] Βud[l, red @ j]}//EinsteinSum[]) ;

%/.TensorValueRules[Β]//FullSimplify

Q_ (ij)^(ij) == (-1/3 g_ (pq)^(pq) t_l^l t_l^l + t_q^q t_p^p) Β_ (qj)^(qj) Β_ (ip)^(ip)

Q_ (ij)^(ij) == -1/3 g_ (ij)^(ij) t_l^l t_l^l + t_j^j t_i^i

with in addition

t_1^1 t_1^1 + t_2^2 t_2^2 + t_3^3 t_3^3 == t_1^1 t_1^1 + t_2^2 t_2^2 + t_3^3 t_3^3

For a general rotation, we would have,

Q§ud[red @ i_, red @ j_] := Q§ud[p, q] Βud[red @ i, p] Βud[q, red @ j]

(Q§val = Q§ud[red @ i, red @ j]//EinsteinSum[]//ArrayExpansion[red @ i, red @ j]//MetricSimplify[g])//MatrixForm

(Qval = Q§val/.TensorValueRules[Β]/.tu[k_] →td[k])//MatrixForm

t in the x-y plane (t_3^3=0):

t makes an angle φ with the first axis _1:
{td[1]→Abs[t] Cos[φ],td[2]→Abs[t] Sin[φ]}

( {{1/4 q (1 + 3 Cos[2 φ]), 3/4 q Sin[2 φ], 0}, {3/4 q Sin[2 φ], -1/4 q (-1 + 3 Cos[2 φ]), 0}, {0, 0, -q/2}} )

In a basis {X, Y, Z} :

DeclareBaseIndices[{X, Y, Z}]

DeclareBaseIndices[Base3d] ;

Free energy in terms of q and φ (one-dimensional)

"Tensorization" of the parameters : Tensor Notations

It is convenient in the following to use scalar tensors in place of the usual parameters. We will denote with an UnderBar the tensor associated with each parameter.

Underscript[_, _] := Tensor[]

Ruleφq = {φ→Underscript[φ, _], q→Underscript[q, _]} ;     (*  Replaces the parameters by tensors    *)

Qud[1, 1] == (Q2$val/.Ruleφq)[[1, 1]]

Qud[1, 2] == (Q2$val/.Ruleφq)[[1, 2]]

Qud[2, 2] == (Q2$val/.Ruleφq)[[2, 2]]

Qud[3, 3] == (Q2$val/.Ruleφq)[[3, 3]]

Q_ (11)^(11) == 1/4 (1 + 3 Cos[2 φ]) q

Q_ (12)^(12) == 3/4 Sin[2 φ] q

Q_ (22)^(22) == -1/4 (-1 + 3 Cos[2 φ]) q

Q_ (33)^(33) == -q/2

Q2§val = (Q2$val/.Ruleφq) ;

QqφRule := Tensor[Q, {Void, Void}, {black @ i_, black @ j_}] :→Q2§val[[i, j]]

( Q2§val/.Underscript[φ, _] →0)//MatrixForm

( Q2§val/.Underscript[φ, _] →π/2)//MatrixForm

-( Q2§val/.Underscript[φ, _] →π/2) - ( Q2§val/.Underscript[φ, _] →0)//MatrixForm

2/3 (Underscript[q, _]  - %)//MatrixForm

( {{q, 0, 0}, {0, -q/2, 0}, {0, 0, -q/2}} )

( {{-q/2, 0, 0}, {0, q, 0}, {0, 0, -q/2}} )

( {{-q/2, 0, 0}, {0, -q/2, 0}, {0, 0, q}} )

( {{q, 0, 0}, {0, q, 0}, {0, 0, 0}} )

2 = DiagonalMatrix[{1, 1, 0}] ; 2 = {{0, 1, 0}, {-1, 0, 0}, {0, 0, 0}} ;

A.  Forms  Q_ (ij)^(ij) Q_ (ji)^(ji), Q_ (ij)^(ij) Q_ (jk)^(jk) Q_ (ki)^(ki) , ...  and    {Q_ (ij)^(ij)},   without derivatives

2/3   (Qud[i, j] Qud[j, i])//StandardDownIndices[g]//EinsteinSum[] ;

%/.QqφRule ;

resfQ2 = 2/3   (Qud[i, j] Qud[j, i]) == %//FullSimplify

4/3 (Qud[i, j] Qud[j, k] Qud[k, i])//StandardDownIndices[g]//EinsteinSum[] ;

%/.QqφRule ;

resfQ3 =   4/3 (Qud[i, j] Qud[j, k] Qud[k, i]) == %//FullSimplify

3 (q)^2 == 2 Q_ (ij)^(ij) Q_ (ji)^(ji)

3 (q)^3 == 4 Q_ (ij)^(ij) Q_ (jk)^(jk) Q_ (ki)^(ki)

resfQDet = Det[Qud[i, j]] == Det[Q2§val]//FullSimplify

Qud[i, j] Qud[j, k] == (Q2§val . Q2§val//FullSimplify//MatrixForm)

Qud[i, j] Qud[j, k] Qud[k, l] == (Q2§val . Q2§val . Q2§val//FullSimplify//MatrixForm)

4 Det[Q_ (ij)^(ij)] == (q)^3

Q_ (ij)^(ij) Q_ (jk)^(jk) == ( {{1/8 (5 + 3 Cos[2 φ]) (q)^2, 3/8 Sin[2 φ] (q)^2, 0}, {3/8 Sin[2 φ] (q)^2, 1/8 (5 - 3 Cos[2 φ]) (q)^2, 0}, {0, 0, (q)^2/4}} )

Q_ (ij)^(ij) Q_ (jk)^(jk) Q_ (kl)^(kl) == ( {{1/16 (7 + 9 Cos[2 φ]) (q)^3, 9/16 Sin[2 φ] (q)^3, 0}, {9/16 Sin[2 φ] (q)^3, 1/16 (7 - 9 Cos[2 φ]) (q)^3, 0}, {0, 0, -(q)^3/8}} )

B.  Forms  with  first order covariant derivatives

I.  Forms   Q_ (ij ; i)^(ij ; i) Q_ (jk ; k)^(jk ; k)

Warning : EinsteinSum[] does not works :
1) on contravariant derivatives (we apply StandardDownIndices[g]).
2) on expression in an hold form (we apply ReleaseHoldD).

(CovariantD[Qud[i, j], i]) (ContravariantD[(Qud[j, k]/.l→h), k])

%//StandardDownIndices[g]//ReleaseHoldD//EinsteinSum[] ;

%/.CovariantD[Tensor[t__], i_] :→PartialD[labs][Tensor[t], xu[i]] ;              (*the basis is orhonormal  *)

fD1 = %/.QqφRule

Q_ (ij)^(ij) _ (; i) Q_ (jk)^(jk)^(; k)

The coefficients of the partial derivatives ∂ q/∂ x_i^iand ∂ φ/∂ x_i^i is given by,

(res1qq = Table[D[res1/2, PDq[i], PDq[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

(res1qφ = Table[D[res1/2, PDq[i], PDφ[j]], {i, 3}, {j, 3}]//TrigReduce//Simplify)//MatrixForm

(res1φφ = Table[D[res1/2, PDφ[i], PDφ[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

( {{1/8 (5 + 3 Cos[2 φ]), 3/8 Sin[2 φ], 0}, {3/8 Sin[2 φ], 1/8 (5 - 3 Cos[2 φ]), 0}, {0, 0, 1/4}} )

( {{-3/8 Sin[2 φ] q, 3/8 (3 + Cos[2 φ]) q, 0}, {3/8 (-3 + Cos[2 φ]) q, 3/8 Sin[2 φ] q, 0}, {0, 0, 0}} )

( {{(9 (q)^2)/4, 0, 0}, {0, (9 (q)^2)/4, 0}, {0, 0, 0}} )

and we can check that they are equal to,

res1qq == 1/Underscript[q, _]^2Q2§val . Q2§val//Simplify

res1qφ == 1/4 D[Q2§val, Underscript[φ, _]] + 9/8Underscript[q, _] 2//Simplify

res1φφ == 9/4Underscript[q, _]^22//Simplify

True

True

True

Introducing the projection  (∇φ) _t of ∇φ on the t-plane we find the expression for Q_ (ij ; i)^(ij ; i) Q_ (jk ; k)^(jk ; k) :

II.  Forms    Q_ (ij ; k)^(ij ; k) Q_ (ki ; j)^(ki ; j)

with a similar approach, we find

CovariantD[Qud[i, j], k] ContravariantD[(Qud[k, i]/.l→h), j]

%//StandardDownIndices[g]//ReleaseHoldD//EinsteinSum[] ;

%/.CovariantD[Tensor[t__], i_] :→PartialD[labs][Tensor[t], xu[i]] ;              (*the basis is orhonormal  *)

fD2 = %/.QqφRule

Q_ (ij)^(ij) _ (; k) Q_ (ki)^(ki)^(; j)

(res2qq = Table[D[res2/2, PDq[i], PDq[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

(res2qφ = Table[D[res2/2, PDq[i], PDφ[j]], {i, 3}, {j, 3}]//TrigReduce//Simplify)//MatrixForm

(res2φφ = Table[D[res2/2, PDφ[i], PDφ[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

( {{1/8 (5 + 3 Cos[2 φ]), 3/8 Sin[2 φ], 0}, {3/8 Sin[2 φ], 1/8 (5 - 3 Cos[2 φ]), 0}, {0, 0, 1/4}} )

( {{-3/8 Sin[2 φ] q, 3/8 (-3 + Cos[2 φ]) q, 0}, {3/8 (3 + Cos[2 φ]) q, 3/8 Sin[2 φ] q, 0}, {0, 0, 0}} )

( {{(9 (q)^2)/4, 0, 0}, {0, (9 (q)^2)/4, 0}, {0, 0, 0}} )

res2qq == 1/Underscript[q, _]^2Q2§val . Q2§val//Simplify

res2qφ == 1/4 D[Q2§val, Underscript[φ, _]] - 9/8Underscript[q, _] 2//Simplify

res2φφ == 9/4Underscript[q, _]^22//Simplify

True

True

True

III.  Form    Q_ (ij ; k)^(ij ; k) Q_ (ji ; k)^(ji ; k)

CovariantD[Qud[i, j], k] ContravariantD[(Qud[j, i]/.l→h), k]

%//StandardDownIndices[g]//ReleaseHoldD//EinsteinSum[] ;

%/.CovariantD[Tensor[t__], i_] :→PartialD[labs][Tensor[t], xu[i]] ;              (*the basis is orhonormal  *)

fD3 = %/.QqφRule//FullSimplify

Q_ (ij)^(ij) _ (; k) Q_ (ji)^(ji)^(; k)

3/2 ((∂q/∂x_1^1)^2 + (∂q/∂x_2^2)^2 + (∂q/∂x_3^3)^2 + 3 (q)^2 ((∂φ/∂x_1^1)^2 + (∂φ/∂x_2^2)^2 + (∂φ/∂x_3^3)^2))

(res3qq = Table[D[res3/2, PDq[i], PDq[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

(res3qφ = Table[D[res3/2, PDq[i], PDφ[j]], {i, 3}, {j, 3}]//TrigReduce//Simplify)//MatrixForm

(res3φφ = Table[D[res3/2, PDφ[i], PDφ[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

( {{3/2, 0, 0}, {0, 3/2, 0}, {0, 0, 3/2}} )

( {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}} )

( {{(9 (q)^2)/2, 0, 0}, {0, (9 (q)^2)/2, 0}, {0, 0, (9 (q)^2)/2}} )

ResultFrame[resLCI5 = CovariantD[Qud[i, j], k] ContravariantD[(Qud[j, i]/.l→h), k] == 3/2 ∇q . ∇q + 9q^2/2 ∇φ . ∇φ]

      Q_ (ij)^(ij) _ (; k) Q_ (ji)^(ji)^(; k) == (3 ∇q . ∇q)/2 + 9/2 q^2 ∇φ . ∇φ      (LC_I.5)

IV.  Form    Q_ (ij)^(ij) Q_ (jk ; l)^(jk ; l) Q_ (ki ; l)^(ki ; l)

(Qud[i, j] CovariantD[Qud[j, k], l]) (ContravariantD[(Qud[k, i]), l])

%//StandardDownIndices[g]//ReleaseHoldD//EinsteinSum[] ;

%/.CovariantD[Tensor[t__], i_] :→PartialD[labs][Tensor[t], xu[i]] ;              (*the basis is orhonormal  *)

fD4 = %/.QqφRule//FullSimplify

Q_ (jk)^(jk) _ (; l) Q_ (ki)^(ki)^(; l) Q_ (ij)^(ij)

3/8 q (2 (∂q/∂x_1^1)^2 + 2 (∂q/∂x_2^2)^2 + 2 (∂q/∂x_3^3)^2 + 3 (q)^2 ((∂φ/∂x_1^1)^2 + (∂φ/∂x_2^2)^2 + (∂φ/∂x_3^3)^2))

(res4qq = Table[D[res4/2, PDq[i], PDq[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

(res4qφ = Table[D[res4/2, PDq[i], PDφ[j]], {i, 3}, {j, 3}]//TrigReduce//Simplify)//MatrixForm

(res4φφ = Table[D[res4/2, PDφ[i], PDφ[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

( {{(3 q)/4, 0, 0}, {0, (3 q)/4, 0}, {0, 0, (3 q)/4}} )

( {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}} )

( {{(9 (q)^3)/8, 0, 0}, {0, (9 (q)^3)/8, 0}, {0, 0, (9 (q)^3)/8}} )

ResultFrame[resLCI6 = (Qud[i, j] CovariantD[Qud[j, k], l]) (ContravariantD[(Qud[k, i]), l]) == 3q/4 ∇q . ∇q + 9q^3/8 ∇φ . ∇φ]

V.  Form    Q_ (ij)^(ij) Q_ (hk ; j)^(hk ; j) Q_ (kh ; i)^(kh ; i)

(Qud[i, j] CovariantD[Qud[k, h], i]) (ContravariantD[(Qud[h, k]), j])

%//StandardDownIndices[g]//ReleaseHoldD//EinsteinSum[] ;

%/.CovariantD[Tensor[t__], i_] :→PartialD[labs][Tensor[t], xu[i]] ;              (*the basis is orhonormal  *)

fD5 = %/.QqφRule//FullSimplify

Q_ (kh)^(kh) _ (; i) Q_ (hk)^(hk)^(; j) Q_ (ij)^(ij)

(res5qq = Table[D[res5/2, PDq[i], PDq[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

(res5qφ = Table[D[res5/2, PDq[i], PDφ[j]], {i, 3}, {j, 3}]//TrigReduce//Simplify)//MatrixForm

(res5φφ = Table[D[res5/2, PDφ[i], PDφ[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

( {{3/8 (1 + 3 Cos[2 φ]) q, 9/8 Sin[2 φ] q, 0}, {9/8 Sin[2 φ] q, 3/8 (1 - 3 Cos[2 φ]) q, 0}, {0, 0, -(3 q)/4}} )

( {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}} )

( {{9/8 (1 + 3 Cos[2 φ]) (q)^3, 27/8 Sin[2 φ] (q)^3, 0}, {27/8 Sin[2 φ] (q)^3, 9/8 (1 - 3 Cos[2 φ]) (q)^3, 0}, {0, 0, -(9 (q)^3)/4}} )

res5qq == 3/2 Q2§val//Simplify

res5φφ == 9Underscript[q, _]^2/2 Q2§val//Simplify

True

True

ResultFrame[resLCI7 = (Qud[i, j] CovariantD[Qud[k, h], i]) (ContravariantD[(Qud[h, k]), j]) == 3/2 ∇q . Q . ∇q + 9q^2/2  ∇φ . Q . ∇φ]

VI.  Form    Q_ (ij)^(ij) Q_ (ji ; k)^(ji ; k) Q_ (lk ; l)^(lk ; l)

(Qud[i, j] CovariantD[Qud[l, k], l]) (ContravariantD[(Qud[j, i]), k])

%//StandardDownIndices[g]//ReleaseHoldD//EinsteinSum[] ;

%/.CovariantD[Tensor[t__], i_] :→PartialD[labs][Tensor[t], xu[i]] ;              (*the basis is orhonormal  *)

fD6 = %/.QqφRule//FullSimplify

Q_ (lk)^(lk) _ (; l) Q_ (ji)^(ji)^(; k) Q_ (ij)^(ij)

(res6qq = Table[D[res6/2, PDq[i], PDq[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

(res6qφ = Table[D[res6/2, PDq[i], PDφ[j]], {i, 3}, {j, 3}]//TrigReduce//Simplify)//MatrixForm

(res6φφ = Table[D[res6/2, PDφ[i], PDφ[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

( {{3/8 (1 + 3 Cos[2 φ]) q, 9/8 Sin[2 φ] q, 0}, {9/8 Sin[2 φ] q, 3/8 (1 - 3 Cos[2 φ]) q, 0}, {0, 0, -(3 q)/4}} )

( {{-9/8 Sin[2 φ] (q)^2, 9/8 Cos[2 φ] (q)^2, 0}, {9/8 Cos[2 φ] (q)^2, 9/8 Sin[2 φ] (q)^2, 0}, {0, 0, 0}} )

( {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}} )

res6qq == 3 /2 Q2§val//Simplify

res6qφ == 3/4 Underscript[q, _] D[Q2§val, Underscript[φ, _]]//Simplify

True

True

VII.  Form    Q_ (ij)^(ij) Q_ (jk ; l)^(jk ; l) Q_ (li ; k)^(li ; k)

(Qud[i, j] CovariantD[Qud[j, k], l]) (ContravariantD[(Qud[l, i]), k])

%//StandardDownIndices[g]//ReleaseHoldD//EinsteinSum[] ;

%/.CovariantD[Tensor[t__], i_] :→PartialD[labs][Tensor[t], xu[i]] ;              (*the basis is orhonormal  *)

fD7 = %/.QqφRule//FullSimplify

Q_ (jk)^(jk) _ (; l) Q_ (li)^(li)^(; k) Q_ (ij)^(ij)

(res7qq = Table[D[res7/2, PDq[i], PDq[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

(res7qφ = Table[D[res7/2, PDq[i], PDφ[j]], {i, 3}, {j, 3}]//TrigReduce//Simplify)//MatrixForm

(res7φφ = Table[D[res7/2, PDφ[i], PDφ[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

( {{1/16 (7 + 9 Cos[2 φ]) q, 9/16 Sin[2 φ] q, 0}, {9/16 Sin[2 φ] q, 1/16 (7 - 9 Cos[2 φ]) q, 0}, {0, 0, -q/8}} )

( {{-15/16 Sin[2 φ] (q)^2, 3/16 (-3 + 5 Cos[2 φ]) (q)^2, 0}, {3/16 (3 + 5 Cos[2 φ]) (q)^2, 15/16 Sin[2 φ] (q)^2, 0}, {0, 0, 0}} )

( {{9/16 (1 - 3 Cos[2 φ]) (q)^3, -27/16 Sin[2 φ] (q)^3, 0}, {-27/16 Sin[2 φ] (q)^3, 9/16 (1 + 3 Cos[2 φ]) (q)^3, 0}, {0, 0, 0}} )

res7qq == 1/Underscript[q, _]^2Q2§val . Q2§val . Q2§val//Simplify

res7qφ == 5/8 Underscript[q, _] D[(Q2§val), Underscript[φ, _]] - 9/16Underscript[q, _]^22//Simplify

res7φφ == -9/2 Underscript[q, _] (Q2§val . Q2§val) + 9/8Underscript[q, _]^3 + 9/4Underscript[q, _]^32//Simplify

True

True

True

(Qud[i, j] CovariantD[Qud[j, k], l]) (ContravariantD[(Qud[l, i]), k]) == (Qud[i, j] CovariantD[Qud[l, k], l]) (ContravariantD[(Qud[k, i]), j])

Q_ (jk)^(jk) _ (; l) Q_ (li)^(li)^(; k) Q_ (ij)^(ij) == Q_ (lk)^(lk) _ (; l) Q_ (ki)^(ki)^(; j) Q_ (ij)^(ij)

VIII.  Form     Q_ (ij)^(ij) Q_ (ki ; j)^(ki ; j) Q_ (lk ; l)^(lk ; l)

(Qud[i, j] CovariantD[Qud[l, k], l]) (ContravariantD[(Qud[k, i]), j])

%//StandardDownIndices[g]//ReleaseHoldD//EinsteinSum[] ;

%/.CovariantD[Tensor[t__], i_] :→PartialD[labs][Tensor[t], xu[i]] ;              (*the basis is orhonormal  *)

fD8 = %/.QqφRule//FullSimplify

Q_ (lk)^(lk) _ (; l) Q_ (ki)^(ki)^(; j) Q_ (ij)^(ij)

(res8qq = Table[D[res8/2, PDq[i], PDq[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

(res8qφ = Table[D[res8/2, PDq[i], PDφ[j]], {i, 3}, {j, 3}]//TrigReduce//Simplify)//MatrixForm

(res8φφ = Table[D[res8/2, PDφ[i], PDφ[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

( {{1/16 (7 + 9 Cos[2 φ]) q, 9/16 Sin[2 φ] q, 0}, {9/16 Sin[2 φ] q, 1/16 (7 - 9 Cos[2 φ]) q, 0}, {0, 0, -q/8}} )

( {{-3/32 Sin[2 φ] (q)^2, 3/32 (3 + Cos[2 φ]) (q)^2, 0}, {3/32 (-3 + Cos[2 φ]) (q)^2, 3/32 Sin[2 φ] (q)^2, 0}, {0, 0, 0}} )

( {{9/16 (1 + 3 Cos[2 φ]) (q)^3, 27/16 Sin[2 φ] (q)^3, 0}, {27/16 Sin[2 φ] (q)^3, 9/16 (1 - 3 Cos[2 φ]) (q)^3, 0}, {0, 0, 0}} )

res8qq == 1/Underscript[q, _]^2Q2§val . Q2§val . Q2§val//Simplify

res8qφ == 1/16 Underscript[q, _] D[(Q2§val), Underscript[φ, _]] + 9/32Underscript[q, _]^22//Simplify

res8φφ == 9/2 Underscript[q, _] (Q2§val . Q2§val) - 9/8Underscript[q, _]^3 - 9/8Underscript[q, _]^32//Simplify

True

True

True

IX.  Form    Q_ (ij)^(ij) Q_ (kl ; j)^(kl ; j) Q_ (li ; k)^(li ; k)

(Qud[i, j] CovariantD[Qud[l, i], k]) (ContravariantD[(Qud[k, l]), j])

%//StandardDownIndices[g]//ReleaseHoldD//EinsteinSum[] ;

%/.CovariantD[Tensor[t__], i_] :→PartialD[labs][Tensor[t], xu[i]] ;              (*the basis is orhonormal  *)

fD9 = %/.QqφRule//FullSimplify

Q_ (li)^(li) _ (; k) Q_ (kl)^(kl)^(; j) Q_ (ij)^(ij)

(res9qq = Table[D[res9/2, PDq[i], PDq[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

(res9qφ = Table[D[res9/2, PDq[i], PDφ[j]], {i, 3}, {j, 3}]//TrigReduce//Simplify)//MatrixForm

(res9φφ = Table[D[res9/2, PDφ[i], PDφ[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

( {{1/16 (7 + 9 Cos[2 φ]) q, 9/16 Sin[2 φ] q, 0}, {9/16 Sin[2 φ] q, 1/16 (7 - 9 Cos[2 φ]) q, 0}, {0, 0, -q/8}} )

( {{-3/32 Sin[2 φ] (q)^2, 3/32 (-3 + Cos[2 φ]) (q)^2, 0}, {3/32 (3 + Cos[2 φ]) (q)^2, 3/32 Sin[2 φ] (q)^2, 0}, {0, 0, 0}} )

( {{9/16 (1 + 3 Cos[2 φ]) (q)^3, 27/16 Sin[2 φ] (q)^3, 0}, {27/16 Sin[2 φ] (q)^3, 9/16 (1 - 3 Cos[2 φ]) (q)^3, 0}, {0, 0, 0}} )

res9qq == 1/Underscript[q, _]^2 (Q2§val . Q2§val . Q2§val//FullSimplify)

res9qφ == Underscript[q, _]/16D[Q2§val, Underscript[φ, _]] - 9/32Underscript[q, _]^22//Simplify

res9φφ == 9/2 Underscript[q, _] Q2§val . Q2§val - 9/8Underscript[q, _]^3 - 9/8Underscript[q, _]^32//FullSimplify

True

True

True

X.  Form    Q_ (ij)^(ij) Q_ (ji ; k)^(ji ; k) Q_ (kl ; l)^(kl ; l)

(Qud[i, j] CovariantD[Qud[j, i], k]) (ContravariantD[(Qud[k, l]), l])

%//StandardDownIndices[g]//ReleaseHoldD//EinsteinSum[] ;

%/.CovariantD[Tensor[t__], i_] :→PartialD[labs][Tensor[t], xu[i]] ;              (*the basis is orhonormal  *)

fD10 = %/.QqφRule//FullSimplify

Q_ (ji)^(ji) _ (; k) Q_ (kl)^(kl)^(; l) Q_ (ij)^(ij)

(res10qq = Table[D[res10/2, PDq[i], PDq[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

(res10qφ = Table[D[res10/2, PDq[i], PDφ[j]], {i, 3}, {j, 3}]//TrigReduce//Simplify)//MatrixForm

(res10φφ = Table[D[res10/2, PDφ[i], PDφ[j]], {i, 3}, {j, 3}]//Simplify)//MatrixForm

( {{3/8 (1 + 3 Cos[2 φ]) q, 9/8 Sin[2 φ] q, 0}, {9/8 Sin[2 φ] q, 3/8 (1 - 3 Cos[2 φ]) q, 0}, {0, 0, -(3 q)/4}} )

( {{-9/8 Sin[2 φ] (q)^2, 9/8 Cos[2 φ] (q)^2, 0}, {9/8 Cos[2 φ] (q)^2, 9/8 Sin[2 φ] (q)^2, 0}, {0, 0, 0}} )

( {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}} )

res10qq == 2/ Underscript[q, _]^2  Q2§val . Q2§val . Q2§val - 1/2 Underscript[q, _] //FullSimplify

res10qφ == 3 Underscript[q, _]/4D[Q2§val, Underscript[φ, _]]//Simplify

res10φφ == {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}

True

True

True

XI.  Combinations   Q_ (ij ; i)^(ij ; i) Q_ (jk ; k)^(jk ; k)  and    Q_ (ij ; k)^(ij ; k) Q_ (ki ; j)^(ki ; j)

Simplifications

Some of the above expression may be simplified. This leads to a simplification rule (Simplifrule) :

Q2§val . Q2§val == Underscript[q, _]/2 Q2§val + Underscript[q, _]^2/2 //Simplify

Q2§val . Q2§val . Q2§val == 3/4 Underscript[q, _]^2Q2§val + Underscript[q, _]^3/4 //Simplify

True

True

C.  RESUME

We summarize below all the results :

Another question is : what are the expressions involving ∇q and ∇φ as functions of the Q_ (ij)^(ij) and its covariant derivatives.
To do this we have to invert the above expressions.

Inversion

We first introduce shortened notations for the various terms, and find how some of them are related :

termsA = {A1, A2, A3, A4, A5, A6, A7} ;

termsB = {B3, B4, B5, B6, B7, B8, B9, B10, B11} ; <br />

Eliminate[(M . termsA == termsB), termsA]

4 B11 == 4 B10 - B3 q + B4 q&&2 B8 == 4 B10 - 2 B6 - B7 + 2 B9&&q≠0

we check the validity of these relations :

zero[a_, b_] = a (4B11 - (4B10 - B3 q + B4 q)) + b (-8q (2B8 - (4 * B10 - 2 * B6 - B7 + 2 * B9))) ;

{0, 0}

... and obtain the expected inverse relation :

AtoBrule = Solve[(M . termsA == termsB/.{B11→ (4B10 - B3 q + B4 q)/4, B8→ (4 * B10 - 2 * B6 - B7 + 2 * B9)/2}), termsA][[1]]

D.  RESUME (inversion)

QToBrule = Table[Rule[#2, #1] & @@ (BToQrule[[i$]]), {i$, Length[BToQrule]}]/.{i→i_, j→j_, k→k_, l→l_}

(resLCI12/.Simplifrule//Simplify)[[2]] == (resLCI8/.Simplifrule//Simplify)[[2]]

ResultFrame[RES = {resLCI12[[1]] == resLCI8[[1]], Collect[4B11 - (4B10 - B3 q + B4 q), q, Factor] == 0, 2B8 - (4B10 - 2B6 - B7 + 2B9) == 0}/.BToQrule//TableForm]

Print["with again a check of the relations involving B :"]

(RES//ExpandAll)/.QToBrule

4 Q_ (ji)^(ji) _ (; k) Q_ (kl)^(kl)^(; l) Q_ (ij)^(ij) == 4 Q_ (lk)^(lk) _ (; l) Q_ (ji)^(ji)^(; k) Q_ (ij)^(ij)

with again a check of the relations involving B :

Q_ (ji)^(ji) _ (; k) Q_ (kl)^(kl)^(; l) Q_ (ij)^(ij) == B8
B3 q-B4 q==0
-4 B10+2 B6+B7+2 B8-2 B9==0

All the results are summarized here :

A more general approach

Free Energy: Homogeneous form

The Landau free energy of a nematic-isotropic system may be written up to fourth order in Q :

equfw = fw[q] == A/2δ[q] + B/3Δ[q] + C/4δ[q]^2

rulδ = δ[q] →Tensor[Qud[i, j] Qud[j, i]]

rulΔ = Δ[q] →Tensor[Qud[i, j] Qud[j, k] Qud[k, i]]

ResultFrame[equfw/.{rulδ, rulΔ}]

fw[q] == 1/2 A δ[q] + 1/4 C δ[q]^2 + 1/3 B Δ[q]

δ[q] →Q_ (ij)^(ij) Q_ (ji)^(ji)

Δ[q] →Q_ (ij)^(ij) Q_ (jk)^(jk) Q_ (ki)^(ki)

these rotational invariants only depend on q :

Q$ud[i_, j_] := Q§ud[i, j]/.tu[k_] td[k_] →3q/2<br />

equδ = δ[q] == (Q$ud[i, j] Q$ud[j, i]//Expand//MetricSimplify[g])//.tu[k_] td[k_] →3q/2/.gud[i_, i_] →NDim

equΔ = Δ[q] == (Q$ud[i, j] Q$ud[j, k] Q$ud[k, i]//Expand//MetricSimplify[g])//.tu[k_] td[k_] →3q/2/.gud[i_, i_] →NDim

δ[q] == (3 q^2)/2

Δ[q] == (3 q^3)/4

and the corresponding free energy is,

equf = equfw/.{equδ[[1]] →equδ[[2]], equΔ[[1]] →equΔ[[2]]}

fw[q] == (3 A q^2)/4 + (B q^3)/4 + (9 C q^4)/16

fw  will be chosen in the form: fq = 1/2q^2(1 - q)^2. This fixes A,B, and C (rulABC):

equfq = fq[q] == 1/2 q^2 (1 - q)^2

Collect[equfq[[2]] - equf[[2]], {q}]

%/.(rulABC = {A→2/3, B→ -4, C→8/9})

fq[q] == 1/2 (1 - q)^2 q^2

(1/2 - (3 A)/4) q^2 + (-1 - B/4) q^3 + (1/2 - (9 C)/16) q^4

0

equf/.rulABC//Simplify

(-1 + q)^2 q^2 == 2 fw[q]

Now the free energy has the general expression :

ResultFrame[equfw/.rulABC]

      fw[q] == δ[q]/3 + (2 δ[q]^2)/9 - (4 Δ[q])/3      (LC_I.18)

List of invariants built with t, div[t], curl[t], grad[^2], grad[t], Δ[t]

We can now generate the invariants built with t.
We use the operators defined in TContinuumMechanics (TDiv,TGrad,TCurl,TLaplacian).

2 2[i_] =  == Tensor[t, {i}, {Void}] * Tensor[t, {Void}, {i}] <br />

div[i_] = "div[]" == TDiv[, g, i][ ] <br />

2 div2[i_, j_] = div[ ] == TDiv[, g, i][ ] TDiv[, g, j][ ]

gradgrad[p_, q_] = "grad[].grad[]" == (TGrad[, p][tu[q]] . TGrad[, r][td[q]]//EvaluateDotProducts[, g]//MetricSimplifyD[g])

    curl[i_, j_, k_] = "curl[]" == TCurl[, g, {i, j, k}, e][] ;

    res1 = (/.k→p) . TGrad[, i][tu[q] td[q]]//EvaluateDotProducts[, g] ;

2 grad[p_, q_] = .grad[  ]/2 == (res1[[1]] + (res1[[2]]//UpDownSwapD[q]))/2/.i→p

    curl = ".curl[]" ==  . TCurl[, g, {p, q, r}, e][]//EvaluateDotProducts[, g] ;

    res2 = curl[[2]] (curl[[2]]/.{p→i, q→j, k→h})//FullLeviCivitaExpand[e, g]//MetricSimplifyD[g] ;

res = (/.k→h) ×curl[i, j, k][[2]]//EvaluateCrossProducts[, e, g, m] ;

res3 = (res . (res/.{i→p, j→q, m→r})//EvaluateDotProducts[, g]//MetricSimplifyD[g]) ;

res4 = (TDiv[, g, h][res]//MetricSimplifyD[g]) ;

2 2 2curl2[p_, q_, r_] =  (curl[]) == tu[r] td[r] curl2[p, q][[2]]

    res5 = (TGrad[, i][tu[p] td[p]] . TGrad[, q][tu[r] td[r]]//EvaluateDotProducts[, g]//MetricSimplifyD[g])/.i→q ;

divdiv[p_, q_] = "div[div]" == TDiv[, g, q][  TDiv[, g, p][ ]]

res6 = TLaplacian[, g, q, r][2[p][[2]]]//MetricSimplifyD[g] ;

res7 = TLaplacian[, g, q, p][]//MetricSimplifyD[g] ;

lapl[p_, q_] = "Δ[]" == (/.k→r) . res7//EvaluateDotProducts[, g]//UpDownSwapD[k, p]

2  == t_i^i t_i^i

div[] == t_i^i_ (; i)

2 div[ ] == t_i^i_ (; i) t_j^j_ (; j)

grad[].grad[] == t_q^q_ (; p) t_q^q^(; p)

2 curl[ ] == -t_p^p_ (; q) t_q^q_ (; p) + t_q^q_ (; p) t_q^q^(; p)

2 .grad[  ]/2 == t_q^q_ (; p) t_q^q t_p^p

2 (.curl[]) == -(t_p^p_ (; q) - t_q^q^(; p)) ((-t_q^q_ (; r) + t_r^r^(; q)) t_p^p t_r^r + t_q^q_ (; p) t_r^r t_r^r)

2 (×curl[]) == -(t_p^p_ (; q) - t_q^q^(; p)) (t_q^q_ (; r) - t_r^r^(; q)) t_p^p t_r^r

div[×curl[]] == t_p^p_ (; q) (-t_q^q_ (; p) + t_p^p^(; q)) + ((t_p^p^(; q)) _ (; q) - t_q^q_ (; pq)) t_p^p

2 2  (curl[]) == (-t_p^p_ (; q) t_q^q_ (; p) + t_q^q_ (; p) t_q^q^(; p)) t_r^r t_r^r

2 2 grad[  ] /4 == t_p^p_ (; q) t_r^r^(; q) t_p^p t_r^r

2 (.grad[]) == t_q^q_ (; r) t_q^q^(; p) t_p^p t_r^r

div[div] == t_p^p_ (; p) t_q^q_ (; q) + t_p^p_ (; pq) t_q^q

2 Δ[  ] == 2 t_p^p_ (; q) t_p^p^(; q) + 2 (t_p^p^(; r)) _ (; r) t_p^p

Δ[] == (t_p^p^(; q)) _ (; q) t_p^p

List of terms of order one and three in t, with zero, and first order derivatives,

listOdd = {div[i][[2]], grad[i, j][[2]]}

{t_i^i_ (; i), t_j^j_ (; i) t_j^j t_i^i}

List of terms of order two in t, with zero, first and second order derivatives,

listSq1 = {2[i][[2]], div[i][[2]] (div[j][[2]]), -curl2[i, j][[2, 1]], curl2[i, j][[2, 2]]}

listSq2 = {tu[i] CovariantD[tu[j], {i, j}], tu[i] CovariantD[ContravariantD[td[i], j], j]}

{t_i^i t_i^i, t_i^i_ (; i) t_j^j_ (; j), t_i^i_ (; j) t_j^j_ (; i), t_j^j_ (; i) t_j^j^(; i)}

{t_j^j_ (; ij) t_i^i, (t_i^i^(; j)) _ (; j) t_i^i}

listSq = Union[listSq1, listSq2]

{t_i^i_ (; j) t_j^j_ (; i), t_i^i_ (; i) t_j^j_ (; j), t_j^j_ (; i) t_j^j^(; i), (t_i^i^(; j)) _ (; j) t_i^i, t_j^j_ (; ij) t_i^i, t_i^i t_i^i}

List of terms of order four in t, with zero and first order derivatives,

listQa = Table[tu[p] td[i] CovariantD[tu[q], j] CovariantD[tu[r], k]/.Apply[Rule, Transpose[{{p, q, r}, Permutations[{i, j, k}][[n]]}], {1}], {n, 6}]//Sort

{0, 0, 0, t_k^k_ (; j) t_k^k^(; j) t_i^i t_i^i, t_k^k_ (; j) t_k^k^(; i) t_i^i t_j^j, t_i^i_ (; j) t_k^k^(; j) t_i^i t_k^k}

In listQb, the factors t_ (k ; k)^(k ; k)≡ t_ (k ; k)^(k ; k) are already in listQa, so we have cancelled the corresponding terms

In addition, the following terms are duplicated in the list listQa :

{listQa[[5]], listQa[[6]]}/.{k→j, j→k}

% == {listQa[[4]], listQa[[3]]}

{t_i^i_ (; j) t_k^k_ (; k) t_i^i t_j^j, t_i^i_ (; k) t_k^k_ (; j) t_i^i t_j^j}

True

So in the general case, there exists seven invariants of this type :

res = Union[Take[listQa, 4], Take[listQb, -3]] ;

listQu = (tu[i] td[i] Coefficient[res, tu[i] td[i]] + tu[j] td[i] Coefficient[res, tu[j] td[i]] + tu[j] td[i] (Coefficient[res, tu[k] td[i]]/.{k→j, j→k}))//Sort

Notations for the invariants :  Sq for order two, Qu for order four.

rullistOd = Table[(listOdd[[n]]/.{i→i_, j→j_, k→k_}) →Od[n], {n, 2}] ;

ResultFrame[rullist = {2[i_][[2]] →2[i][[1]], rullistSq, rullistQ, rullistOd}//Flatten]

Correspondence between the list of invariant and the Divergence, Curl, Laplacian... forms,

while the inverse relation is,

Print["We have the following relations between the functions :"]

relS1 = Solve[relationsS[[1]]/."div[×curl[]]"→X, X][[1, 1]]/.X→"div[×curl[]]"

We have the following relations between the functions :

2 Δ[  ] →2 (grad[].grad[] + Δ[])

2 Sq[1] → -curl[ ] + grad[].grad[]
2 Sq[2] →div[ ]
Sq[3]→grad[t].grad[t]
Sq[4]→tΔ[t]
2 Sq[5] → -div[ ] + div[div]
2 Sq[6] → 

Print["We have the third relation between the functions :"]

relationsQ = Eliminate[{equivalence[[5]], equivalence[[6]], equivalence[[7]], equivalence[[8]], equivalence[[9]]}, {Qu[1], Qu[2], Qu[3], Qu[4], Qu[5], Qu[6], Qu[7]}] ;

We have the third relation between the functions :

2 2 2 2 (×curl[]) →  (curl[]) - (.curl[])

(rulInvOd = Solve[{equivalence[[14]], equivalence[[15]]}, {Od[1], Od[2]}][[1]])//TableForm

Od[1]→div[t]
2 Od[2] →.grad[  ]/2

resQu67 = Solve[{equivalence[[8]], equivalence[[9]]}, {Qu[6], Qu[7]}][[1]] ;

resQu4 = Qu[4] → ( Qu[4]/.Solve[equivalence[[6]]/.resQu67, Qu[4]][[1]]) ;

resQu5 = Qu[5] →listQu[[5]]/.div[i_][[2]] →div[i][[1]]/.grad[p_, q_][[2]] →grad[p, q][[1]] ;

(rulInvQ = {resQu1, resQu2, resQu3, resQu4, resQu5, resQu67}//Flatten//Sort)//TableForm

2 2 Qu[1] → (-curl[ ] + grad[].grad[]) 
2 Qu[2] →div[]^2 
2 Qu[3] →grad[].grad[] 
2 Qu[5] → (div[] .grad[  ])/2
2 2 Qu[6] →grad[  ] /4
2 Qu[7] →(.grad[])

rulInv = {rulInvS, rulInvQ, rulInvOd}//Flatten ;

There exists the following three identities :

ResultFrame[(identities = {relationsS[[1]], relationsS[[2]], relationsQ})//TableForm]

What is the meaning of the term "grad[t].grad[t]" ?

Now we showx that gradtgradt is the sum of a divergence div[...] plus curl[t\!\(\(]\^2\)\)+div[t\!\(\(]\^2\)\):
We start from the two last identities (valid for arbitrary t) :

identities[[1]]

identities[[2]]

2 2 div[ ] == -curl[ ] + div[div] + div[×curl[]] - Δ[]

2 2 grad[].grad[] == -2 Δ[] + Δ[  ]

and eliminate tΔ[t] :

Eliminate[{identities[[1]], identities[[2]]}/.(-identities[[1, 2, 4]]) →x, x] ;

identities[[2, 1]]/2 == ( x/.Solve[%/.identities[[2, 1]]/2→x, x][[1]]//Simplify)

Now the expression ^2grad[t].grad[t] can be rewritten, using,

TDiv[, g, j][ 2[i][[2]]   Tensor[u, {k}, {Void}] * Tensor[, {Void}, {k}] ]//Expand ;

2 div[  ] == %//.rul1

2 2 2 div[  ] == grad[  ]. + div[] 

Explicit form of 1/2 K(Q_ (jk ; i))^2 in the case  ^2arbitrary)

(CovariantD[Q§ud[i, j], k]//CovariantDSimplify[, g, e]) (ContravariantD[(Q§ud[j, i]/.l→h), k]//CovariantDSimplify[, g, e]) ;

res = (%//Expand//MetricSimplify[g])/.{gud[i_, i_] →NDim, gdu[i_, i_] →NDim}//Expand//TensorSimplify

2 (2 Qu[6])/3 + 2  Sq[3]

ClearTensorShortcuts[{{, J, J1, J2, , t}, 1}, {{g, Q, Q§, Β}, 2}, {{}, 3}, {{}, 4}] ;

Created by Mathematica  (November 27, 2007) Valid XHTML 1.1!