Vortice singolo

a = 3.5

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

q0bar[z_, zbar_] = {{1, 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]

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

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

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

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

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

Eq[z_, zbar_, 
          t_] = (∂_z) (Inverse[Ω1[z, zbar, 
                    t]] . (∂_zbar) Ω1[z, zbar, 
                    t]) - (g^2)/
              2 ({{1, 0}, {0, 1}} - 
                Inverse[Ω1[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   /. 
      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  /. 
      g -> 1

Eq21[r_, t_] = %;

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

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

Eq22[r_, t_] = %;

d = 0.0001

D1 = 15

Init[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] ==  1 + a Conjugate[a],F12[r, 0] ==  1,F21[r, 0] ==  1, F22[r, 0]  ==  Init[r],F11[D1, t]  ==  1,F12[D1, t]  ==  1,F21[D1, t]  ==  1,F22[D1, t]  ==  Init[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, 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, 
          D1}, {PlotStyle -> {RGBColor[1, 0, 0], RGBColor[ .5, 0, 0], 
              RGBColor[0, 1, 0], RGBColor[0, 0, 1]}}, 
        GridLines -> Automatic, PlotRange -> {0, 100}], {t, 0, 5, 
        1}]

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, 50, 
        5}]

Do[Plot[{Evaluate[r/(Sqrt[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, 1.1}], {t, 0, 50, 
        5}]

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

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

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

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

Inverse[S[r, t]]

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

Do[Plot[{Evaluate[
            (1/(Sqrt[13.25 - ((12.25  (r^2))/F22)[r, t]]))  /. 
result], 
          Evaluate[
            (3.5/(Sqrt[13.25 - ((12.25  (r^2))/F22)[r, t]])) - ((3.5  (r^2))/((Sqrt[13.25 - ((12.25  (r^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, 50, 5}]