<<xAct`xTras`

Manifold

$DefInfoQ=False;
$Post=ScreenDollarIndices;

(* DefConstantSymbol[Dim,PrintAs->"D"] (* dimension D*) *)
DefConstantSymbol[Λ,PrintAs->"Λ"] 
DefConstantSymbol[α,PrintAs->"α"] 
DefConstantSymbol[λ,PrintAs->"λ"] 
DefConstantSymbol[J,PrintAs->"J"](* weight *)

DefManifold[M,3,{a,b,c,d,i,j,k}]
DefMetric[-1,g[-a,-b],CD];

$CommuteCovDsOnScalars=True;(* commutation of CovDs on scalars*)

DefTensor[ϕ[],M]

term1=RicciScalarCD[];
term2=-2Λ ;
term3=4α EinsteinCD[a,b]CD[-a][ϕ[]]CD[-b][ϕ[]];
term4=-4α CD[-a][ϕ[]]CD[a][ϕ[]]CD[-b][CD[b][ϕ[]]];
term5=2α CD[-a][ϕ[]]CD[a][ϕ[]]CD[-b][ϕ[]]CD[b][ϕ[]];
term6=-2λ RicciScalarCD[] Exp[-2ϕ[]];
term7=-12λ CD[-a][ϕ[]]CD[a][ϕ[]] Exp[-2ϕ[]];
term8=-6λ^2 Exp[-4ϕ[]];
sqrtming=Sqrt[-Detg[]];

DefChart[polar,M,{0,1,2},{t[],r[],θ[]}]

DefScalarFunction[f]
DefScalarFunction[h]
DefScalarFunction[χ]

(metric=CTensor[{{-f[r[]]+J^2/(4r[]^2),0,-J/2},{0,1/(f[r[]]h[r[]]),0},{-J/2,0,J^2/(2r[]^2)}},{-polar,-polar}])[-a,-b]

metricCD=CovDOfMetric[metric]

rules={
g[a_?DownIndexQ,b_?DownIndexQ]->metric[a,b],
g[a_?UpIndexQ,b_?UpIndexQ]->Inv[metric][a,b],
Detg->Determinant[metric],
CD->metricCD,
RicciCD->Ricci[metricCD],
EinsteinCD->Einstein[metricCD],
RicciScalarCD->RicciScalar[metricCD],
ϕ[]->χ[r[]]
};

newterm1=term1//.rules//ContractBasis//Simplify;
newterm2=term2//.rules//ContractBasis//Simplify;
newterm3=term3//.rules//ContractBasis//Simplify;
newterm4=term4//.rules//ContractBasis//Simplify;
newterm5=term5//.rules//ContractBasis//Simplify;
newterm6=term6//.rules//ContractBasis//Simplify;
newterm7=term7//.rules//ContractBasis//Simplify;
newterm8=term8//.rules//ContractBasis//Simplify;
newsqrtming=sqrtming//.rules;

LagrangianGB3=newsqrtming(newterm1+newterm2+newterm3+newterm4+newterm5+newterm6+newterm7+newterm8)

<<VariationalMethods`

equations=EulerEquations[LagrangianGB3,{f[r[]],h[r[]],χ[r[]]},r[]]//Simplify