Disclaimer: Not all of the code is written by me. A while back I found online a very useful notebook showing how to construct these things in GR, and then I just wrote some commands that I needed and were not included in the original notebook. This is the relevant link original code. I am including the link to the site with several notebooks as I consider that they might be helpful for closely related stuff and also the people who did this originally, did extraordinary work.
The metric is given in the OP and is repeated here to set-up notation and conventions.
$$g_{\mu \nu} dx^{\mu} dx^{\nu} + h_{ij} dy^{i} dy^{j}$$
where the indices run as follows: $\mu,\nu=0,1,2,3$ and $i,j=4,5,6,7,8,9$ - as it smells like SUGRA related stuff :-)
I will also assume a Minkowski spacetime in the greek indices and mostly plus signature. Final assumption. The metric is diagonal. The functions will be left completely arbitrary.
The output of the code for some commands is quite big and ugly, but it kind of makes sense as the functions are completely undefined. The upshot is that the code works.
I think that the important part of the whole procedure is to understand how to create correctly the derivatives w.r.t to the spacetime points and construct one tensor consistently. Once, that is done, the rest of the work is just changing the formulae.
To begin with, we define a set of coordinates and the dimensionality of spacetime
(*Define a list of the coordinates*)
coord = {t, x, y, z, y0, y1, y2, y3, y4, y5};
(*The dimension n of the spacetime*)
n = Length[coord];
So, now we can define our metric as a list in the following way and make a first check for the implementation
(*These are the Subscript[g, AB] elements*)
metric = { {-g[x, y], 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, g[x, y], 0, 0,
0, 0, 0, 0, 0, 0}, {0, 0, g[x, y], 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0,
g[x, y], 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, h[y], 0, 0, 0, 0,
0}, {0, 0, 0, 0, 0, h[y], 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, h[y], 0,
0, 0}, {0, 0, 0, 0, 0, 0, 0, h[y], 0, 0}, {0, 0, 0, 0, 0, 0, 0,
0, h[y], 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, h[y]}};
metric // MatrixForm;
(*Invert in order to obtain the g^AB elements*)
inversemetric = Simplify[Inverse[metric]];
inversemetric // MatrixForm;
(*Test N^o 1.*)
metric.inversemetric;
% // MatrixForm
The basic idea now is that we can start representing tensor explicitly as lists of lists and check their non-vanishing elements. This is shown explicitly below.
A simple starting point is the square root of the determinant of the metric, which is a common quantity.
Sqrt[-Det[metric]] // PowerExpand
Below are the non-vanishing Christoffel symbols - the independent ones.
(*The Christoffel*)
(*In the output the symbol \[CapitalGamma][1,2,3] \
stands for Subscript[\[CapitalGamma]^1, 23]*)
affine :=
affine = FullSimplify[Table[(1/2)*Sum[(inversemetric[[i, s]])*
(D[metric[[s, j]], coord[[k]] ] +
D[metric[[s, k]], coord[[j]] ] -
D[metric[[j, k]], coord[[s]] ]), {s, 1, n}],
{i, 1, n}, {j, 1, n}, {k, 1, n}] ]
listaffine :=
Table[If[UnsameQ[affine[[i, j, k]],
0], {ToString[\[CapitalGamma][i - 1, j - 1, k - 1]],
affine[[i, j, k]]}] , {i, 1, n}, {j, 1, n}, {k, 1, j}]
TableForm[Partition[DeleteCases[Flatten[listaffine], Null], 2],
TableSpacing -> {2, 2}]
The Riemann tensor follows - in the form $R^{x}_{xxx}$
riemann := riemann = Simplify[Table[D[affine[[i,j,l]], coord[[k]]] - D[affine[[i,j,k]], coord[[l]]] +
Sum[affine[[s,j,l]]*affine[[i,k,s]] - affine[[s,j,k]]*affine[[i,l,s]], {s, 1, n}], {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, n}]]
listriemann := Table[If[riemann[[i,j,k,l]] =!= 0, {ToString[R[i - 1, j - 1, k - 1, l - 1]], riemann[[i,j,k,l]]}], {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, k - 1}]
TableForm[Partition[DeleteCases[Flatten[listriemann], Null], 2], TableSpacing -> {2, 2}]
Similarly, we build the Ricci tensor components $R_{xx}$
ricci := ricci = FullSimplify[Table[Sum[riemann[[i,j,i,l]], {i, 1, n}], {j, 1, n}, {l, 1, n}]]
listricci := Table[If[ricci[[j,l]] =!= 0, {ToString[R[j - 1, l - 1]], ricci[[j,l]]}], {j, 1, n}, {l, 1, j}]
TableForm[Partition[DeleteCases[Flatten[listricci], Null], 2], TableSpacing -> {2, 2}]
From that, we can obtain the Ricci scalar
scalar = FullSimplify[Sum[inversemetric[[i,j]]*ricci[[i,j]], {i, 1, n}, {j, 1, n}]]
We are getting closer to the end. Below, we are giving the Einstein tensor
einstein := einstein = FullSimplify[ricci - (1/2)*scalar*metric]
listeinstein := Table[If[einstein[[j,l]] =!= 0, {ToString[G[j, l]], einstein[[j,l]]}], {j, 1, n}, {l, 1, j}]
TableForm[Partition[DeleteCases[Flatten[listeinstein], Null], 2], TableSpacing -> {2, 2}]
For the Kretschmann scalar, we need the Riemann tensor in the form $R^{xxxx}$ and $R_{xxxx}$ in order to make the contraction. All the commands are shown below
riemann1 := riemann1 = Simplify[Table[Sum[metric[[\[Mu],\[Mu]1]]*riemann[[\[Mu]1,\[Nu],\[Rho],\[Sigma]]], {\[Mu]1, 1, n}], {\[Mu], 1, n}, {\[Nu], 1, n}, {\[Rho], 1, n}, {\[Sigma], 1, n}]]
listriemann1 := Table[If[riemann1[[\[Mu],\[Nu],\[Rho],\[Sigma]]] =!= 0, {ToString[R1[\[Mu], \[Nu], \[Rho], \[Sigma]]], riemann1[[\[Mu],\[Nu],\[Rho],\[Sigma]]]}], {\[Mu], 1, n}, {\[Nu], 1, n}, {\[Rho], 1, n},
{\[Sigma], 1, \[Rho] - 1}];
TableForm[Partition[DeleteCases[Flatten[listriemann1], Null], 2], TableSpacing -> {2, 2}];
riemann2 := riemann2 = Simplify[Table[Sum[Sum[Sum[inversemetric[[\[Nu]1,\[Nu]]]*inversemetric[[\[Rho]1,\[Rho]]]*inversemetric[[\[Sigma]1,\[Sigma]]]*riemann[[\[Mu],\[Nu]1,\[Rho]1,\[Sigma]1]], {\[Nu]1, 1, n}],
{\[Rho]1, 1, n}], {\[Sigma]1, 1, n}], {\[Mu], 1, n}, {\[Nu], 1, n}, {\[Rho], 1, n}, {\[Sigma], 1, n}]]
listriemann2 := Table[If[riemann2[[\[Mu],\[Nu],\[Rho],\[Sigma]]] =!= 0, {ToString[R2[\[Mu], \[Nu], \[Rho], \[Sigma]]], riemann2[[\[Mu],\[Nu],\[Rho],\[Sigma]]]}], {\[Mu], 1, n}, {\[Nu], 1, n}, {\[Rho], 1, n},
{\[Sigma], 1, \[Rho] - 1}];
TableForm[Partition[DeleteCases[Flatten[listriemann2], Null], 2], TableSpacing -> {2, 2}];
KretschmannScalar = Simplify[Sum[riemann1[[a,b,c,d]]*riemann2[[a,b,c,d]], {a, 1, n}, {b, 1, n}, {c, 1, n}, {d, 1, n}]]
Finally, we give the Weyl tensor in the form $C_{xxxx}$
weyltensor := weyltensor = Simplify[Table[If[n >= 4, riemann1[[a,b,c,d]] - (1/(n - 2))*(metric[[a,c]]*ricci[[d,b]] + metric[[b,d]]*ricci[[c,a]] -
metric[[a,d]]*ricci[[c,b]] - metric[[b,c]]*ricci[[d,a]]) + (1/((n - 1)*(n - 2)))*scalar*(metric[[a,c]]*metric[[d,b]] - metric[[a,d]]*metric[[c,b]]), 0],
{a, 1, n}, {b, 1, n}, {c, 1, n}, {d, 1, n}]]
listeweyl := Table[If[weyltensor[[i,j,k,l]] =!= 0, {ToString[C[i - 1, j - 1, k - 1, l - 1]], weyltensor[[i,j,k,l]]}], {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, k - 1}]
TableForm[Partition[DeleteCases[Flatten[listeweyl], Null], 2], TableSpacing -> {2, 2}]
And since, we did all of the above we define and orthonormal basis and compute the spin-connection components.
Below, we give the zehn-beine
Eup = {{Sqrt[g[x, y]], 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, Sqrt[g[x, y]], 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, Sqrt[g[x, y]], 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, Sqrt[g[x, y]], 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, Sqrt[h[y]], 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, Sqrt[h[y]], 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, Sqrt[h[y]], 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, Sqrt[h[y]], 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, Sqrt[h[y]], 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, Sqrt[h[y]]}};
And the spin-connection components, $\left(\omega _{\mu }\right)_b^a$, are equal to
spinconnection := spinconnection = FullSimplify[Table[Sum[Edown[[a,q]]*Eup[[b,\[Nu]]]*affine[[\[Nu],\[Mu],q]], {q, 1, n}, {\[Nu], 1, n}] -
Sum[Edown[[a,\[Nu]]]*D[Eup[[b,\[Nu]]], coord[[\[Mu]]]], {\[Nu], 1, n}], {\[Mu], 1, n}, {b, 1, n}, {a, 1, n}]]
listspinconnection := Table[If[spinconnection[[i,j,k]] =!= 0, {ToString[\[Omega][i - 1, j - 1, k - 1]], spinconnection[[i,j,k]]}], {i, 1, n}, {j, 1, n}, {k, 1, j}];
TableForm[Partition[DeleteCases[Flatten[listspinconnection], Null], 2], TableSpacing -> {2, 2}];
And as a consistency check, we ask to see if we can verify the tetrad postulate
tetradpostulate = Flatten[FullSimplify[Table[D[Eup[[a,\[Nu]]], coord[[\[Mu]]]] + Sum[spinconnection[[\[Mu],a,b]]*Eup[[b,\[Nu]]], {b, 1, n}] -
Sum[affine[[q,\[Mu],\[Nu]]]*Eup[[a,q]], {q, 1, n}], {\[Mu], 1, n}, {\[Nu], 1, n}, {a, 1, n}]]];
tetradpostulate;
AllTrue[tetradpostulate, #1 == 0 & ]