Setup

SetDirectory[NotebookDirectory[]];

dX[n_]:=Symbol["d"<>ToString[coord[[n]]]]

$Assumptions=And[u∈Reals,r∈Reals,v∈Reals,r>Tu+Tv>0,Tu>0,Tv>0,L>0,T>0,r>2T,x∈(Reals)];

coord={u,v,r};
metricSign=-1;

Poincaré to BTZ

u2btz=u->(Sqrt[(((r^2)-(((Tu+Tv))^2))/((r^2)-(((Tu-Tv))^2)))])(E^(2u*Tu));
v2btz=(u2btz/.u->v/.{Tu->Tv,Tv->Tu})//Simplify
z2btz=z->(Sqrt[(((((Tu+Tv))^2)-(((Tu-Tv))^2))/((r^2)-(((Tu-Tv))^2)))])Exp[((u+v)/2)(Tu+Tv)+((u-v)/2)(Tu-Tv)]//Simplify
poincare2btz={u2btz,v2btz,z2btz};

((Dt[u]Dt[v]+((Dt[z])^2))/(z^2))/.poincare2btz/.(Dt[#]->0&/@{Tu,Tv})//Simplify

((r^2)-(((Tu+Tv))^2))((r^2)-(((Tu-Tv))^2))==(r^4)+((((Tu^2)-(Tv^2)))^2)-2 (r^2) ((Tu^2)+(Tv^2))//Simplify

ds2=(((r^2)(dr^2))/(((r^2)-(((Tu+Tv))^2))((r^2)-(((Tu-Tv))^2))))+(Tu^2)(du^2)+(Tv^2)(dv^2)+((r^2)-(Tu^2)-(Tv^2))du dv;

metric=btz`metric=Table[(1/2)D[ds2,dX[i],dX[j]],{i,1,Length[coord]},{j,1,Length[coord]}]

<<diffgeoM`

Simplify[Einstein- metric]

("DefaultPlotStyle"/.(Method/.Charting`ResolvePlotTheme[#2,#1]))/.Directive[x_,__]:>x&[Plot,"Web"]

Killing vectors

ju=Function[{n},({{\[Piecewise], ({{(E^(-2 Tu u)){((-((r^2)-(Tu^2)-(Tv^2)))/(2 Tu (Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))]))),(Tu/(Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))])),((-(Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))]))/(2 r))}, n==-1}, {{((-1)/(2 Tu)),0,0}, n==0}, {(E^(+2 Tu u)){((-((r^2)-(Tu^2)-(Tv^2)))/(2 Tu (Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))]))),(Tu/(Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))])),((+(Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))]))/(2 r))}, n==1}, {0, True}})}})];
jv=Function[{n},({{\[Piecewise], ({{(E^(-2 Tv v)) {(Tv/(Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))])),((-((r^2)-(Tu^2)-(Tv^2)))/(2 Tv(Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))]))),-((Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))])/(2 r))}, n==-1}, {{0,((-1)/(2 Tv)),0}, n==0}, {(E^(+2 Tv v)) {(Tv/(Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))])),((-((r^2)-(Tu^2)-(Tv^2)))/(2 Tv(Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))]))),((+(Sqrt[((r^2)-(((Tu-Tv))^2)) ((r^2)-(((Tu+Tv))^2))]))/(2 r))}, n==1}, {0, True}})}})];

From Poincaré AdS

juPoincare=Function[{n},({{\[Piecewise], ({{{-1,0,0}, n==-1}, {{-u,0,-(z/2)}, n==0}, {{-(u^2),(z^2),-u z}, n==1}, {0, True}})}})];
jvPoincare=Function[{n},({{\[Piecewise], ({{{0,-1,0}, n==-1}, {{0,-v,-(z/2)}, n==0}, {{(z^2),-(v^2),-v z}, n==1}, {0, True}})}})];

<<"Physica/GRUtils.wl"

{u,v,z}/.poincare2btz;

jacobianPoincarebyBTZ=jacobianFromFunc[
Function[{u,v,r},%//Evaluate],
{u,v,r}
]//Simplify;

jacobianBTZbyPoincare=Inverse[jacobianPoincarebyBTZ]//Simplify;

juBTZs=(jacobianBTZbyPoincare.(juPoincare[#]/.poincare2btz)//Simplify)&/@Range[-1,1];
jvBTZs=(jacobianBTZbyPoincare.(jvPoincare[#]/.poincare2btz)//Simplify)&/@Range[-1,1];

juBTZs//Column

ju/@Range[-1,1];
%//Column

ju/@Range[-1,1]==juBTZs//Simplify
jv/@Range[-1,1]==jvBTZs//Simplify

Basic Checks

Killing vectors at the boundary:

Series[ju[#][[1;;2]]&/@Range[-1,1],{r,∞,1}]

Series[jv[#][[1;;2]]&/@Range[-1,1],{r,∞,1}]

Check Killing’s equation:

Lie[ju[#1],metric]&/@Range[-1,1]

Lie[jv[#1],metric]&/@Range[-1,1]

The algebra:

Subsets[{-1,0,1},{2}]

algju=Lie[ju[#1],ju[#2],{up}]&@@@Subsets[{-1,0,1},{2}];
Simplify[algju+{ju[-1],2ju[0],ju[1]}]

algjv=Lie[jv[#1],jv[#2],{up}]&@@@Subsets[{-1,0,1},{2}];
Simplify[algjv+{jv[-1],2jv[0],jv[1]}]

Lie[ju[#1],jv[#2],{up}]&@@@Tuples[{-1,0,1},2]

Bulk modular flow generator

sameTuTv={Tu->T,Tv->T};

RTsameT=r->((2T Cosh[T L])/(Sqrt[((Cosh[T L])^2)-((Cosh[2T x])^2)]));

coeffs={((Coth[Tu(up-um)])/((E^(-2Tu up))+(E^(-2Tu um)))),-Coth[Tu(up-um)],((Coth[Tu(up-um)])/((E^(2Tu up))+(E^(2Tu um)))),((Coth[Tv(vp-vm)])/((E^(-2Tv vp))+(E^(-2Tv vm)))),-Coth[Tv(vp-vm)],((Coth[Tv(vp-vm)])/((E^(2Tv vp))+(E^(2Tv vm))))};

ξ=2π(
 coeffs[[1;;3]].(ju/@Range[-1,1])
- coeffs[[4;;6]].(jv/@Range[-1,1])
)/.{up->xp,vp->xp,um->xm,vm->xm}/.{xp->L/2,xm->-L/2}

Now we enforce (Subscript[T, u])=(Subscript[T, v])=T to simplify our calculations

metric=static`metric=btz`metric/.sameTuTv//Simplify
<<diffgeoM`

ξsameT=ξ/.sameTuTv

Simplify[ξsameT/.{u->x,v->x}/.RTsameT,{Cosh[2 L T]≥Cosh[4 T x]}]

Check surface gravity (for same T):

covD[lower[ξsameT]];
PrintTemporary["# covD: Done!"];

contract[%%**%%,{1,3},{2,4}];
PrintTemporary["# contract: Done!"];

FullSimplify[%%/.{u->x,v->x}/.RTsameT,{Cosh[2 L T]-Cosh[4 T x]>0,Cosh[L T]-Cosh[2T x]>0}]

Mathematica refuse to handle the Tu≠Tv case:

metric=btz`metric;
<<diffgeoM`

covD[lower[ξ]];
PrintTemporary["# covD: Done!"];

contract[%%**%%,{1,3},{2,4}];
PrintTemporary["# contract: Done!"];

FullSimplify[%%/.{u->x,v->x}/.RTsameT,{Cosh[2 L T]-Cosh[4 T x]>0,Cosh[L T]-Cosh[2T x]>0}]

Charges

To restore the original metric:

coord
metric=btz`metric
<<diffgeoM`

δ=(δTv(∂_Tv)#+δTu(∂_Tu)#)&;

kg[ξ_,h_]:=Module[{dh,dξ,ξdh,hdξ},
dh=covD[h];
dξ=covD[ξ];
ξdh=ξ**dh;
hdξ=h**dξ;
Identity[
-raise[antisymmetrize[contract[ξdh,{3,4}]-contract[ξdh,{2,3}]+contract[ξdh,{1,3}]+(1/2)contract[h,{1,2}]dξ-(1/2)contract[hdξ,{2,3}]+(1/2)contract[hdξ,{2,4}]]]
]
]

(*The minus accounts for the change to Poincare coordinates*)

δq[ξ_,h_]:=-(1/(8π G)) Identity[rg*((kg[lower[ξ],h])[[#,3]]&/@{1,2}).{1,-1}]

Quick check (finite Tu, Tv):

Simplify[2π δq[#,δ@metric]&/@{(∂_u)coord,-(∂_v)coord}]

Again enforce (Subscript[T, u])=(Subscript[T, v])=T to simplify our calculations

metric=static`metric
<<diffgeoM`
δ=(δT(∂_T)#)&;

varQξsameT=δq[ξsameT,δ@metric];

varQξsameT//Expand//Collect[#,r]&

FullSimplify[2π varQξsameT]

2π δq[ξ,δ@metric]/.r->rc/.sameTuTv/.{δTu->δT,δTv->δT}/.{u->x,v->x}//Simplify[#,{rc>0}]&//FullSimplify

∫(%/.δT->1)\[DifferentialD]T

(∫_(-L/2)^(L/2))π (-Coth[L T]+((rc Cosh[2 T x] Csch[L T])/(Sqrt[(rc^2)-4 (T^2)])))\[DifferentialD]x

∫(((π rc)/(T (Sqrt[(rc^2)-4 (T^2)])))-L π Coth[L T])\[DifferentialD]T

(∫_(-L/2)^(L/2))π (-Coth[L T]+Cosh[2 T x] Csch[L T])\[DifferentialD]x

Plot[r/.(RTsameT/.{L->1,T->1})//Evaluate,{x,-1,1},PlotRange->{0,20}]

sameTuTv

RTsameT

$Assumptions

2π δq[ξ,δ@metric]/.sameTuTv/.{δTu->δT,δTv->δT}/.{u->x,v->x}//Simplify

%/.RTsameT//FullSimplify

Entropy in Poincare AdS without a cutoff

Note that the generators and the coefficients yields a ξ that has dimensions of length:

ju/@Range[-1,1]

coeffs

ξR=Simplify[R ξ/.{u->x+t,v->x-t,up->xp,vp->xp,um->xm,vm->xm}/.{t->0,xp->(Sqrt[(d^2)/4+(zc^2)]),xm->-(Sqrt[(d^2)/4+(zc^2)])}]

ans=Simplify[δq[R ξ,δ@metric]/.{δTu->0,δTv->0,Tu->0,Tv->0},R>0]

sans=Simplify[ans/.{u->x+t,v->x-t,up->xp,vp->xp,um->xm,vm->xm}/.{t->0,xp->(Sqrt[(d^2)/4+(zc^2)]),xm->-(Sqrt[(d^2)/4+(zc^2)])}]

tmp=Simplify[sans/.z->(Sqrt[(d^2)/4-(x^2)+(zc^2)])]

Simplify[Integrate[tmp/.δR->1,d]]