Vortice  non abeliano doppio

Clear[a]

Definizione del parametro a:

a = 20

Definizione della matrice dei moduli q0 e delle funzioni F,  
    elementi della matrice Ω come funzioni delle coordinate complesse z e zbar e del tempo t:

q0[z_, zbar_] = {{z, a}, {0, z}}

q0bar[z_, zbar_] = {{zbar, 0}, {Conjugate[a], zbar}}

q0[z, zbar] . q0bar[z, zbar]

F11[z_, zbar_, t_] = F11[(z zbar)^(1/2), t]

F12[z_, zbar_, t_] = F12[(z zbar)^(1/2), t]

F21[z_, zbar_, t_] = F21[(z zbar)^(1/2), t]

F22[z_, zbar_, t_] = F22[(z zbar)^(1/2), t]

La matrice Ω viene scritta in termini delle funzioni F nel seguente modo:

Ω[z_, zbar_, 
        t] = {{F11[z, zbar, t] + a Conjugate[a], 
          F12[z, zbar, t] a zbar}, {F21[z, zbar, t] Conjugate[a] z, 
          F22[z, zbar, t]}}

Le funzioni F definite in questo modo risultano dipendere solo dal raggio r .  
        Infatti scriviamo le equazioni per le funzioni F corrispondenti alla eq.

Simplify[
        Inverse[Ω[z, zbar, t]] . q0[z, zbar] . 
          q0bar[z, zbar]];

%  /. (Sqrt[z zbar]) -> r  /. z zbar  -> r^2 /. 
        z^2 zbar^2  -> r^4;

Simplify[(∂_z) (Inverse[Ω[z, zbar, 
                  t]] . (∂_zbar) Ω[z, zbar, 
                  t])];

%  /. (Sqrt[z zbar]) -> r  /. z zbar  -> r^2  /. 
        z^2 zbar^2  -> r^4;

Otteniamo le seguenti quattro equzioni differenziali:

Eq[z_, zbar_, 
          t_] = (∂_z) (Inverse[Ω[z, zbar, 
                    t]] . (∂_zbar) Ω[z, zbar, 
                    t]) - (g^2)/
              2 ({{1, 0}, {0, 1}} - 
                Inverse[Ω[z, zbar, t]] . q0[z, zbar] . 
                  q0bar[z, zbar]);

Simplify[Eq[z, zbar, t][[1, 2]]/zbar] ;

%  /. (Sqrt[z zbar]) -> r  /. 
          z zbar  -> r^2   /. z^2 zbar^2  -> r^4  /. 
      g -> 1

Eq12[r_, t_] = %;

Simplify[Eq[z, zbar, t][[1, 1]]] ;

%  /. (Sqrt[z zbar]) -> r  /. 
          z zbar  -> r^2   /. g -> 1  /. 
      z^2 zbar^2  -> r^4

Eq11[r_, t_] = %;

Simplify[Eq[z, zbar, t][[2, 1]]/z] ;

%  /. (Sqrt[z zbar]) -> r  /. z zbar  -> r^2  /. 
        z^2 zbar^2  -> 
          r^4   /. g->1

Eq21[r_, t_] = %;

Simplify[Eq[z, zbar, t][[2, 2]]] ;

%  /. (Sqrt[z zbar]) -> r  /. z zbar  -> r^2  /. 
        z^2 zbar^2  -> r^4 /. g -> 1

Eq22[r_, t_] = %;

Definiamo adesso gli estremi di integrazione,  per esempio,

d = 0.00001

D1 = 6

I valori iniziali per le funzioni F sono scelti come al solito considerando il limite di accoppiamento infinito:

Init11[r_] = D1^2

Init22[r_] = r^2

Timing[result=NDSolve[{Eq11[r, t] == (∂_t) F11[r, t] ,Eq12[r, t] ==  (∂_t) F12[r, t],Eq21[r, t] ==  (∂_t) F21[r, t],Eq22[r, t] ==  (∂_t) F22[r, t],F11[r, 0] ==  Init11[r],F12[r, 0] ==  1,F21[r, 0] ==  1, F22[r, 0]  ==  Init22[r],F11[D1, t]  ==  Init11[D1],F12[D1, t]  ==  1,F21[D1, t]  ==  1,F22[D1, t]  ==  Init22[D1],Derivative[1, 0][F11][d, t] == 0,Derivative[1, 0][F12][d, t] == 0,Derivative[1, 0][F21][d, t] == 0,Derivative[1, 0][F22][d, t] == 0},{F11, F12, F21, F22},{r, d, D1},{t, 0, 10000}]]

Do[Plot[{Evaluate[F11[r, t]  /. 
result], 
          Evaluate[F12[r, t]  /. 
result], 
          Evaluate[F21[r, t]  /. 
result], 
          Evaluate[F22[r, t]  /. 
result]}, {r, d, 
          D1}, {PlotStyle -> {RGBColor[1, 0, 0], RGBColor[ .5, 0, 0], 
              RGBColor[0, 1, 0], RGBColor[0, 0, 1]}}, 
        GridLines -> Automatic, PlotRange -> {0, D1^2}], {t, 0, 
        9000, 500}]

Do[Plot[{Evaluate[F11[r, t]  /. 
result], 
          Evaluate[F12[r, t]  /. 
result], 
          Evaluate[F21[r, t]  /. 
result], 
          Evaluate[F22[r, t]  /. 
result]}, {r, d, 
          2}, {PlotStyle -> {RGBColor[0, 0, 1], RGBColor[ .5, 0, 0], 
              RGBColor[0,  .5, 0], RGBColor[1, 0, 0]}}, 
        GridLines -> Automatic, PlotRange -> {0, 2}], {t, 0, 9000, 
        1000}]

Infine possiamo trovare la forma esplicita per la matrice q dei campi scalari,  
    i cui soli elementi non nulli sono rappresentati dalle funzioni f:

f1[r_, 
        t_] = (Sqrt[F11[r, t] + a^2 - a^2 r^2 (F12^2)[r, t]/F22[r, t]])

f2[r_, t_] = (Sqrt[F22])[r, t]

f3[r, t] = a r F12[r, t]/(Sqrt[F22])[r, t]

S[r_, t_] = {{f1[r, t], f3[r, t]}, {0, f2[r, t]}}

Inverse[S[r, t]]

% . {{r, a}, {0, r}}

Do[Plot[{Evaluate[
            (r/(Sqrt[400 + F11[r, t] - (( (20  r F12[r, t])^2)/F22)[r, t]]))  /. 
result], 
          Evaluate[
            (20/(Sqrt[400 + F11[r, t] - (( (20  r F12[r, t])^2)/F22)[r, t]])) - ((20 (r^2) F12[r, t])/((Sqrt[400 + F11[r, t] - (( (20  r F12[r, t])^2)/F22)[r, t]]) F22[r, t]))  /. 
result], 
          Evaluate[(r/(Sqrt[F22]))[r, t]  /. 
result]}, {r, d, 
          6}, {PlotStyle -> {RGBColor[1, 0, 0], RGBColor[0, 1, 0], 
              RGBColor[0, 0, 1]}}, GridLines -> Automatic, 
        PlotRange -> {0, 1}], {t, 0, 9000, 500}]