System of unknown matrices

Question

I am very new to Mathematica. I am attempting to solve a system of equations with 4 unknown matrices (B, C, D and S). B, D and S are symmetric. This is what I have:

A = {{ε, 0, 0}, {0, ε, 0}, {0, 
   0, -2 ε}}

B1 = Array[b, {3, 3}];
C1 = Array[c, {3, 3}];
D1 = Array[d, {3, 3}];
S1 = Array[s, {3, 3}];

Z = {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}};

f1[D2_] := n γ + σ^2/2 Tr[D2];
f2[C2_, D2_] := -C2 - Transpose[C2] + 2 γ D2 - Transpose[A].D2 - D2.A + σ^2 D2.D2;
f3[B2_, C2_, D2_, S2_] := -Transpose[B2] - γ Transpose[A].D2 + γ C2 - C2.A + S2.D2 + σ^2 C2.D2;
f4[C2_, S2_] := -γ C2.A + γ Transpose[A].Transpose[C2] + C2.S2 + S2.Transpose[C2] + σ^2 Transpose[C2].C2;

Solve[{f1[D1]\[Equal]0,f2[C1,D1]\[Equal]Z,f3[B1,C1,D1,S1]\[Equal]Z,\
f4[C1,S1]\[Equal]Z},{Flatten[B1],Flatten[C1],Flatten[D1],Flatten[S1]}]\

But it gives me the error:

Solve::ivar: {b[1,1],b[1,2],b[1,3],b[2,1],b[2,2],b[2,3],b[3,1],b[3,2],b[3,3]} is not a valid variable.

Is my code just plain wrong, or is it that I am being unrealistic by trying to solve this symbolically? Any feedback/suggestions are much appreciated.

Thanks a lot in advance!

Answer 1

I think the problem is the system you are trying to solve. Reading J.M.'s technical difficulties's suggestion; I rewrote your code as follows:

(* Define a handy function *)

genmat[b_, m_, n_] := Array[Subscript[b, ##1] & , {m, n}]; 

(* Define parameters *)

A = {{\[CurlyEpsilon], 0, 0}, {0, \[CurlyEpsilon], 0}, {0, 
    0, -2 \[CurlyEpsilon]}};
Z = {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}};

(* Define unknowns *)
B1 = genmat[b, 3, 3]; 
C1 = genmat[c, 3, 3];
D1 = genmat[d, 3, 3];
S1 = genmat[s, 3, 3];

(* Define system of equations *)

f1[D2_] := n \[Gamma] + \[Sigma]^2/2 Tr[D2]
f2[C2_, D2_] := -C2 - Transpose[C2] + 2 \[Gamma] D2 - 
  Transpose[A].D2 - D2.A + \[Sigma]^2 D2.D2
f3[B2_, C2_, D2_, 
  S2_] := -Transpose[B2] - \[Gamma] Transpose[A].D2 + \[Gamma] C2 - 
  C2.A + S2.D2 + \[Sigma]^2 C2.D2
f4[C2_, S2_] := -\[Gamma] C2.A + \[Gamma] Transpose[A].Transpose[C2] +
   C2.S2 + S2.Transpose[C2] + \[Sigma]^2 Transpose[C2].C2
system = {f1[D1] == 0, f2[C1, D1] == Z, f3[B1, C1, D1, S1] == Z, 
  f4[C1, S1] == Z}

(* Solve system *)
Solve[system,Join[Flatten[B1],Flatten[C1],Flatten[D1],Flatten[S1]]]

And as you said, the code keeps running forever. However, you can see that the system is well defined in terms of Mathematica syntax. Well defined mathematically is a different issue. As you mention, it seems it may be too complex for a symbolic solution. Maybe you can simplify it by imposing some extra assumptions/restrictions and using something like Asuming[assumptions, Solve(system)]?

Answer 2

You can obtain a numerical result with a script as follows:

A = {{\[CurlyEpsilon], 0, 0}, {0, \[CurlyEpsilon], 0}, {0, 0, -2 \[CurlyEpsilon]}}

B1 = {{b11, b12, b13}, {b12, b22, b23}, {b13, b23, b33}};
C1 = {{c11, c12, c13}, {c21, c22, c23}, {c31, c32, c33}};
D1 = {{d11, d12, d13}, {d12, d22, d23}, {d13, d23, d33}};
S1 = {{s11, s12, s13}, {s12, s22, s23}, {s13, s23, s33}};

f1[D2_] := n \[Gamma] + \[Sigma]^2/2 Tr[D2];
f2[C2_, D2_] := -C2 - Transpose[C2] + 2 \[Gamma] D2 - Transpose[A].D2 - D2.A + \[Sigma]^2 D2.D2;
f3[B2_, C2_, D2_, S2_] := -Transpose[B2] - \[Gamma] Transpose[A].D2 + \[Gamma] C2 - C2.A + S2.D2 + \[Sigma]^2 C2.D2;
f4[C2_, S2_] := -\[Gamma] C2.A + \[Gamma] Transpose[A].Transpose[C2] + C2.S2 + S2.Transpose[C2] + \[Sigma]^2 Transpose[C2].C2;

parms = {\[CurlyEpsilon] -> 1, \[Gamma] -> 2, \[Sigma] -> 3, n -> 4};

ff2 = Flatten[f2[C1, D1]]
ff3 = Flatten[f3[B1, C1, D1, S1]]
ff4 = Flatten[f4[C1, S1]]

obj = f1[D1]^2 + ff2.ff2 + ff3.ff3 + ff4.ff4 /. parms
vars = Join[Join[Join[Variables[B1], Variables[C1]], Variables[D1]], Variables[S1]]

sol = NMinimize[obj, vars]

f1[D1] /. parms /. sol[[2]]
f2[C1, D1] /. parms /. sol[[2]]
f3[B1, C1, D1, S1] /. parms /. sol[[2]]
f4[C1, S1] /. parms /. sol[[2]]