# System of unknown matrices

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.

• What happens if you do Solve[(* equations *), Join[Flatten[B1], Flatten[C1], Flatten[D1], Flatten[S1]]]? – J. M.'s discontentment Mar 9 '18 at 22:48
• Or use Flatten[{B1, C1, D1, S1}] – mikado Mar 9 '18 at 22:51
• I tried your suggestions - and the code says "Running" and never actually finishes. I attempted running a single function at a time (f2 for instance) and it would either do the same thing, it output "{}", which as I understand, means that there is no solution? – Renato Mar 12 '18 at 19:05
• It should also be okay to do Flatten[{B1, C1, D1, S1}] – flinty Jun 20 at 23:48
• Even if you set parameters to definite values, you get lots of lots of solutions as you can see with nmin = NMinimize[{b[1, 2], Flatten[{f1[D1] == 0, f2[C1, D1] == Z, f3[B1, C1, D1, S1] == Z, f4[C1, S1] == Z}]} /. {\[CurlyEpsilon] -> 1, \[Gamma] -> 2, \[Sigma] -> 3, n -> 4}, Flatten[{B1, C1, D1, S1}], WorkingPrecision -> 30]  and variations with NMaximize thereof. I think, neither Solve nor NSolve can do that. – Akku14 Jul 21 at 10:54

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)]?

• This does not provide an answer to the question. Once you have sufficient reputation you will be able to comment on any post; instead, provide answers that don't require clarification from the asker. - From Review – Artes Jun 21 at 2:10
• Thank you for your feedback @Artes, just for clarification and to improve my future answers, to correctly answer this question I should have determined why exactly the system of equations has no solution? – Adriana LE Jun 21 at 2:37
• The original post states that Solve returns an error message, this should be explained why as well asone should provide a correct answer if possible. – Artes Jun 21 at 9:43

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[]
f2[C1, D1] /. parms /. sol[]
f3[B1, C1, D1, S1] /. parms /. sol[]
f4[C1, S1] /. parms /. sol[]