2
$\begingroup$

I would like to evaluate a trace of a matrix of size 4Wn×4Wn at different point (x,y). with Wn=2 and using Compile I get the desired results very fast. But the part with Compile takes too long and can not finish when, for example, Wn=20.

tc = {{0, 0, 0, 0}, {0, 0, 0, 0}, {-1, 0, 0, 0}, {0, -1, 0, 0}};
m1[x_, y_] = {{0, I Sin[x] + Sin[y], 
    13/4 - Cos[x] - Cos[y], -1}, {-I Sin[x] + Sin[y], 0, -1, 
    13/4 - Cos[x] - Cos[y]}, {13/4 - Cos[x] - Cos[y], -1, 
    0, -I Sin[x] - Sin[y]}, {-1, 13/4 - Cos[x] - Cos[y], 
    I Sin[x] - Sin[y], 0}};
m2[x_, y_, Wn_] := 
  SparseArray[{Band[{1, 1}, {4 Wn, 4 Wn}] -> {m1[x, y]}, 
    Band[{1, 5}, {4 Wn, 4 Wn}] -> {tc}, 
    Band[{5, 1}, {4 Wn, 4 Wn}] -> {ConjugateTranspose[tc]}}];
Wn = 2;
M[x_, y_] = m2[x, y, Wn];
O1[x_, y_] = D[M[x, y], y];
fn[x_, y_, r_] = 
  Block[{ks = M[x, y], 
    id = IdentityMatrix[
      4 Wn]}, {(Inverse[(r - I*0.01)*id - 
       ks]), (Inverse[(r + I*0.01)*id - ks])}];  

Then I use Compile and this part takes 2 min with Wn=2 but never works with Wn=20

F1 = Compile[{{x, _Real}, {y, _Real}, {r, _Real}}, 
    Evaluate@
     Block[{f = fn[x, y, r]}, 
      Re[Tr[(O1[x, y].(-f[[1]] + f[[2]]).O1[x, 
           y].(-f[[1]] + f[[2]]))]]], 
    CompilationTarget -> "C"]; 
F2 = Compile[{{rf, _Real}, {nc, _Integer}}, 
    Sum[((2 \[Pi])/nc)^3 F1[x, y, rf], {x, \[Pi]/nc, \[Pi], (2 \[Pi])/
      nc}, {y, \[Pi]/nc, \[Pi], (2 \[Pi])/nc}], 
    CompilationTarget -> "C"];

Finally, within 10 sec I get the desires results

sfs = ParallelTable[{rf, -1/4^2 surfzyx[rf, 599]}, {rf, -2, 2, 
    0.05}];
ListLinePlot[sfs, PlotRange -> {0, 2}, Frame -> True]   

enter image description here

So, how can I make this code runs in reasonable time with Wn=20 or larger?

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.