Koordinaten

X={ψ,θ,ϕ};

Metrik, inverse Metrik

G={{1,0,0},{0,Sin[ψ]^2,0},{0,0,Sin[ψ]^2Sin[θ]^2}};
Gi=Inverse[G];
G //MatrixForm
Gi //MatrixForm

Christoffel Symbole

Table[
(Overscript[(Subscript[Γ, μ,ν]), λ])=FullSimplify[1/2 
Sum[Gi[[λ,ρ]]((∂_(X[[ν]]))G[[ρ,μ]]+(∂_(X[[μ]]))G[[ρ,ν]]-(∂_(X[[ρ]]))G[[μ,ν]]),{ρ,1,3}]
],
{λ,1,3},{μ,1,3},{ν,1,3}];

listchristoffel=Table[If[UnsameQ[(Overscript[(Subscript[Γ, μ,ν]), λ]),0],{Subscript[Superscript["Γ",ToString[λ-1]],StringJoin[ToString[μ-1],ToString[ν-1]]],(Overscript[(Subscript[Γ, μ,ν]), λ])}],{λ,1,3},{μ,1,3},{ν,1,3}];
TableForm[Partition[DeleteCases[Flatten[listchristoffel],Null],2],TableSpacing->{2,5},TableAlignments->Left]

Table[
(Overscript[(Subscript[R, μ,ν,κ]), λ])=(∂_(X[[κ]])) (Overscript[(Subscript[Γ, μ,ν]), λ])-(∂_(X[[ν]])) (Overscript[(Subscript[Γ, μ,κ]), λ])+(∑_(η=1)^3)((Overscript[(Subscript[Γ, μ,ν]), η])(Overscript[(Subscript[Γ, κ,η]), λ])-(Overscript[(Subscript[Γ, μ,κ]), η]) (Overscript[(Subscript[Γ, ν,η]), λ])),{λ,1,3},{μ,1,3},{ν,1,3},{κ,1,3}];

listriemann=Table[If[UnsameQ[(Overscript[(Subscript[R, μ,ν,κ]), λ]),0],{Subscript[Superscript["R",ToString[λ-1]],StringJoin[ToString[μ-1],ToString[ν-1],ToString[κ-1]]],(Overscript[(Subscript[R, μ,ν,κ]), λ])}],{λ,1,3},{μ,1,3},{κ,1,3},{ν,1,3}];
TableForm[Partition[DeleteCases[Flatten[listriemann],Null],2],TableSpacing->{2,5},TableAlignments->Left]

Table[(Subscript[Ri, μ,κ])=FullSimplify@Sum[(Overscript[(Subscript[R, μ,λ,κ]), λ]),{λ,1,3}] ,{μ,1,3},{κ,1,3}] //MatrixForm

Rs=Sum[Gi[[μ,ν]](Subscript[Ri, μ,ν]),{μ,1,3},{ν,1,3}] //FullSimplify

Table[(Subscript[Rf, ρ,σ,μ,ν])=FullSimplify@Sum[G[[ρ,τ]](Overscript[(Subscript[R, σ,μ,ν]), τ]),{τ,1,3}],{ρ,1,3},{σ,1,3},{μ,1,3},{ν,1,3}];

n=3;
Table[(Subscript[Rf, ρ,σ,μ,ν])-(Rs/(n(n-1)))(G[[ρ,μ]]G[[σ,ν]]-G[[ρ,ν]]G[[σ,μ]]),{ρ,1,3},{σ,1,3},{μ,1,3},{ν,1,3}] //MatrixForm