Initialisation

(Subscript[Y, ℓ_])[θ_]=SphericalHarmonicY[ℓ,0,θ,ϕ];

Needs["MaTeX`"]
SetOptions[MaTeX,"Preamble"->{"\\usepackage{amssymb,amsmath,latexsym,amsfonts,amsthm,xcolor,bm,mhchem}","\\definecolor{darkgreen}{RGB}{0, 180, 0}","\\definecolor{darkcyan}{RGB}{0, 180, 180}","\\definecolor{darkmagenta}{RGB}{180,0, 180}"}];

Spherium: RHF, UHF and symmetry breaking

The general function for the Hartree-Fock energy is:

EHF[R_,λ_]=(∑_(L=0)^1)(Subscript[a, L]^2)((L(L+1))/(2(R^2)))+(∑_(L=0)^1)(Subscript[b, L]^2)((L(L+1))/(2(R^2)))+(∑_(i=0)^1)(∑_(j=0)^1)(∑_(k=0)^1)(∑_(l=0)^1)(Subscript[a, i])(Subscript[a, j])(Subscript[b, k])(Subscript[b, l])(λ/R)(Sqrt[(2i+1)(2j+1)(2k+1)(2l+1)])(∑_(L=0)^2)((ThreeJSymbol[{i,0},{j,0},{L,0}])^2)((ThreeJSymbol[{k,0},{l,0},{L,0}])^2)/.{(Subscript[a, 0])->Cos[x],(Subscript[a, 1])->Sin[x],(Subscript[b, 0])->Cos[y],(Subscript[b, 1])->Sin[y]};

EHF[R,1]

We search stationnary solution

sol=Solve[{(∂_x)EHF[R,1]==0,(∂_y)EHF[R,1]==0},{x,y}]/.{C[1]->0,C[2]->0}//FullSimplify

{(∂_(x,x))EHF[R,1],(∂_(y,y))EHF[R,1]}/.{x->0,y->-(π/2)}

Some solutions correspond to RHF solutions et some to UHF solutions.

solRHF={{x->0,y->0},{x->0,y->π},{x->-(π/2),y->-(π/2)},{x->-(π/2),y->(π/2)},{x->(π/2),y->-(π/2)},{x->(π/2),y->(π/2)},{x->π,y->0},{x->π,y->π},{x->ArcTan[-((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))],y->ArcTan[-((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))]},{x->ArcTan[-((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))],y->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))]},{x->ArcTan[-((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))],y->ArcTan[-((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))]},{x->ArcTan[-((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))],y->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))]},{x->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))],y->ArcTan[-((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))]},{x->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))],y->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))]},{x->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))],y->ArcTan[-((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))]},{x->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))],y->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))]}};

solUHF={{x->0,y->-(π/2)},{x->0,y->(π/2)},{x->-(π/2),y->0},{x->-(π/2),y->π},{x->(π/2),y->0},{x->(π/2),y->π},{x->π,y->-(π/2)},{x->π,y->(π/2)},{x->ArcTan[-((Sqrt[75+62 R])/(Sqrt[R])),-((5 (Sqrt[-3+2 R]))/(Sqrt[R]))],y->ArcTan[-((Sqrt[75+62 R])/(Sqrt[R])),((5 (Sqrt[-3+2 R]))/(Sqrt[R]))]},{x->ArcTan[-((Sqrt[75+62 R])/(Sqrt[R])),-((5 (Sqrt[-3+2 R]))/(Sqrt[R]))],y->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),-((5 (Sqrt[-3+2 R]))/(Sqrt[R]))]},{x->ArcTan[-((Sqrt[75+62 R])/(Sqrt[R])),((5 (Sqrt[-3+2 R]))/(Sqrt[R]))],y->ArcTan[-((Sqrt[75+62 R])/(Sqrt[R])),-((5 (Sqrt[-3+2 R]))/(Sqrt[R]))]},{x->ArcTan[-((Sqrt[75+62 R])/(Sqrt[R])),((5 (Sqrt[-3+2 R]))/(Sqrt[R]))],y->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),((5 (Sqrt[-3+2 R]))/(Sqrt[R]))]},{x->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),-((5 (Sqrt[-3+2 R]))/(Sqrt[R]))],y->ArcTan[-((Sqrt[75+62 R])/(Sqrt[R])),-((5 (Sqrt[-3+2 R]))/(Sqrt[R]))]},{x->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),-((5 (Sqrt[-3+2 R]))/(Sqrt[R]))],y->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),((5 (Sqrt[-3+2 R]))/(Sqrt[R]))]},{x->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),((5 (Sqrt[-3+2 R]))/(Sqrt[R]))],y->ArcTan[-((Sqrt[75+62 R])/(Sqrt[R])),((5 (Sqrt[-3+2 R]))/(Sqrt[R]))]},{x->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),((5 (Sqrt[-3+2 R]))/(Sqrt[R]))],y->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),-((5 (Sqrt[-3+2 R]))/(Sqrt[R]))]}};

The two electrons integrals are equal to

(Subscript[U, i_,j_,k_,l_]):=(Sqrt[(2i+1)(2j+1)(2k+1)(2l+1)])(∑_(L=0)^2)((ThreeJSymbol[{i,0},{j,0},{L,0}])^2)((ThreeJSymbol[{k,0},{l,0},{L,0}])^2);

The Fock operator for the electron α is

Fα=Table[KroneckerDelta[i,j]((i(i+1))/(2(R^2)))+(λ/R)(∑_(k=0)^1)(∑_(l=0)^1)(Subscript[a, k])(Subscript[a, l])((Subscript[U, i,j,k,l])-(Subscript[U, i,l,k,j]))+(λ/R)(∑_(k=0)^1)(∑_(l=0)^1)(Subscript[b, k])(Subscript[b, l])((Subscript[U, i,j,k,l]))/.{(Subscript[a, 0])->Cos[x],(Subscript[a, 1])->Sin[x],(Subscript[b, 0])->Cos[y],(Subscript[b, 1])->Sin[y]}/.λ->1//FullSimplify//Expand,{i,0,1},{j,0,1}]

And the Fock operator β

Fβ=Table[KroneckerDelta[i,j]((i(i+1))/(2(R^2)))+(λ/R)(∑_(k=0)^1)(∑_(l=0)^1)(Subscript[b, k])(Subscript[b, l])((Subscript[U, i,j,k,l])-(Subscript[U, i,l,k,j]))+(λ/R)(∑_(k=0)^1)(∑_(l=0)^1)(Subscript[a, k])(Subscript[a, l])((Subscript[U, i,j,k,l]))/.{(Subscript[a, 0])->Cos[x],(Subscript[a, 1])->Sin[x],(Subscript[b, 0])->Cos[y],(Subscript[b, 1])->Sin[y]}/.λ->1//FullSimplify//Expand,{i,0,1},{j,0,1}]

RHF solutions

In the RHF case Fα = Fβ

Fα/.solRHF//FullSimplify//Expand

Fβ/.solRHF//FullSimplify//Expand

The 16 stationnary RHF solutions yields 3  differents Fockian which are all diagonal.

{{{(1/R),0},{0,(1/(R^2))+(5/(3 R))}}//MatrixForm,{{(5/(3 R)),0},{0,(1/(R^2))+(29/(25 R))}}//MatrixForm,{{(25/(44 (R^2)))+(91/(66 R)),0},{0,(25/(44 (R^2)))+(91/(66 R))}}//MatrixForm}

The first solution corresponds to a density matrix spatially symmetric where the two electrons are in (Subscript[Y, 0]) and the second to a density matrix spatially symmetric where the two electrons are in (Subscript[Y, 1]). The last solution corresponds to the symmetry broken RHF solution. In the sb-RHF solution the two orbitals are degenerate.

{(∂_(x,x))EHF[R,1],(∂_(y,y))EHF[R,1]}/.{{x->0,y->π},{x->(π/2),y->-(π/2)},{x->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))],y->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))]}}//FullSimplify

Solve[-((50+8 R)/(25 (R^2)))==0,R]

Plot[{(1/R),(5/(3R)),(1/(R^2))+(5/(3 R)),(1/(R^2))+(29/(25 R)),(25/(44 (R^2)))+(91/(66 R))},{R,-3,3},PlotLegends->{"RHF_GS_min","RHF_GS_max","RHF_ES_min","RHF_ES_max","sb_RHF"}]

Plot[{(1/R),(5/(3R)),(1/(R^2))+(5/(3 R)),(1/(R^2))+(29/(25 R)),(25/(44 (R^2)))+(91/(66 R))},{R,1.5,2.5},PlotLegends->{"RHF_GS_min","RHF_GS_max","RHF_ES_min","RHF_ES_max","sb_RHF"}]

Solve[(5/(3 R))==(1/(R^2))+(29/(25 R)),R]

Plot[{(1/R),(5/(3R)),(1/(R^2))+(5/(3 R)),(1/(R^2))+(29/(25 R)),(25/(44 (R^2)))+(91/(66 R))},{R,0,-3},PlotLegends->{"RHF_GS_min","RHF_GS_max","RHF_ES_min","RHF_ES_max","sb_RHF"}]

Solve[(1/R)==(1/(R^2))+(5/(3 R)),R]

The sb-RHF energy interacts with the minimized RHF for R<0 and the maximized RHF for R>0. For negative value of R there is a point at which the attraction of the sb-RHF will minimize the energy than the kinetical energy.  For positive value of lambda there is a point at which the repulsion of the sb RHF solution is bigger than the kinetical energy.

UHF solutions

Fα/.solUHF//FullSimplify//Expand

Fβ/.solUHF//FullSimplify//Expand

The 16 stationnary UHF solutions yields 3  differents Fockian, only two of them are already diagonal.

{{{(5/(3 R)),0},{0,(1/(R^2))+(1/R)}}//MatrixForm,{{(1/R),0},{0,(1/(R^2))+(137/(75 R))}}//MatrixForm,DiagonalMatrix[{{-(25/(56 (R^2)))+(109/(84 R)),((5 (Sqrt[-3+2 R]) (Sqrt[75+62 R]))/(84 (R^2)))},{((5 (Sqrt[-3+2 R]) (Sqrt[75+62 R]))/(84 (R^2))),(75/(56 (R^2)))+(121/(84 R))}}//Eigenvalues//Expand]//MatrixForm}

{(∂_(x,x))EHF[R,1],(∂_(y,y))EHF[R,1]}/.{{x->0,y->(π/2)},{x->-(π/2),y->0},{x->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),((5 (Sqrt[-3+2 R]))/(Sqrt[R]))],y->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),-((5 (Sqrt[-3+2 R]))/(Sqrt[R]))]}}//FullSimplify

Plot[{(1/R),(5/(3R)),(1/(R^2))+(1/R),(1/(R^2))+(137/(75 R)),(25/(56 (R^2)))+(59/(84 R)),(25/(56 (R^2)))+(57/(28 R))},{R,-3,3},PlotLegends->{"UHF_GS_min","UHF_GS_max","UHF_ES_min","UHF_ES_max","sb_UHF1","sb_UHF2"}]

Plot[{(1/R),(5/(3R)),(1/(R^2))+(1/R),(1/(R^2))+(137/(75 R)),(25/(56 (R^2)))+(59/(84 R)),(25/(56 (R^2)))+(57/(28 R))},{R,1,3},PlotLegends->{"UHF_GS_min","UHF_GS_max","UHF_ES_min","UHF_ES_max","sb_UHF1","sb_UHF2"}]

Solve[(1/(R^2))+(137/(75 R))==(25/(56 (R^2)))+(57/(28 R)),R]

{{R->(2325/878)}}//N

Plot[{(1/R),(5/(3R)),(1/(R^2))+(1/R),(1/(R^2))+(137/(75 R)),(25/(56 (R^2)))+(59/(84 R)),(25/(56 (R^2)))+(57/(28 R))},{R,0,-3},PlotLegends->{"UHF_GS_min","UHF_GS_max","UHF_ES_min","UHF_ES_max","sb_UHF1","sb_UHF2"}]

For R>0 the sb-UHF solution is a minimum because the symmetry breaking minimize the repulsion and for R<0 this is a maximum because the symmetry breaking minimize the attraction.
For R>0 the sb-UHF 1 is the “bonding” solution and the sb-UHF 2 is the antibonding solution. There is a point a which the bonding solution becomes better than the ground state of the symmetric solution, and an other point at which the anti bonding solution becomes higher than the symetric solution.
We can do the same reasoning for R<0.

sb-RHF and sb-UHF

Coulson-Fischer points

Table[ EHF[R,1]/.sol[[k]],{k,Length[sol]}]//FullSimplify//Expand//DeleteDuplicates

{(1/R),(1/(R^2))+(1/R),(2/(R^2))+(29/(25 R)),(75/(88 (R^3)))+(25/(22 (R^2)))+(91/(66 R)),-(75/(112 (R^3)))+(25/(28 (R^2)))+(59/(84 R))}

Show[Plot[{λ,1+λ,2+((29 λ)/25)},{λ,-3,3},PlotStyle->{Blue,RGBColor["LimeGreen"],Darker[Purple]},PlotLegends->Placed[{MaTeX["\\text{s}^2",Magnification->1.5],MaTeX["\\text{sp}_\\text{z}",Magnification->1.5],MaTeX["\\text{p}_\\text{z}^2",Magnification->1.5]},{Left,Top}]],
Plot[(25/28)-(75/(112 λ))+((59 λ)/84),{λ,3/2,3},PlotStyle->{Thick,Darker[Magenta]}],Plot[(25/28)-(75/(112 λ))+((59 λ)/84),{λ,-75/62,3/2},PlotStyle->{Dotted,Darker[Magenta]}],Plot[(25/28)-(75/(112 λ))+((59 λ)/84),{λ,-3,-75/62},PlotStyle->{Thick,Darker[Magenta]}],Plot[(25/22)+(75/(88 λ))+((91 λ)/66),{λ,75/38,3},PlotStyle->{Thick,Darker[Cyan]}],Plot[(25/22)+(75/(88 λ))+((91 λ)/66),{λ,-3/2,75/38},PlotStyle->{Dotted,Darker[Cyan]}],Plot[(25/22)+(75/(88 λ))+((91 λ)/66),{λ,-3,-3/2},PlotStyle->{Thick,Darker[Cyan]}],
Epilog->{
Inset[MaTeX["\\text{\\textcolor{darkcyan}{sb-RHF state}}",Magnification->1.5],{2.2,5.5}],Inset[MaTeX["\\text{\\textcolor{darkmagenta}{sb-UHF state}}",Magnification->1.5],{2.5,1.4}],Inset[MaTeX["\\text{\\textcolor{darkcyan}{sb-RHF state}}",Magnification->1.5],{-1.5,-2.5}],Inset[MaTeX["\\text{\\textcolor{darkmagenta}{sb-UHF state}}",Magnification->1.5],{-2.5,0.5}]},
AxesLabel->{MaTeX["R",Magnification->1.5],MaTeX["E_\\text{HF}",Magnification->1.5]},AxesStyle->Directive[Thick,16],ImageSize->Large
]

EsHF[R_,λ_]=(∑_(L=0)^1)(Subscript[a, L]^2)((L(L+1))/(2(R^2)))+(∑_(L=0)^1)(Subscript[b, L]^2)((L(L+1))/(2(R^2)))+(∑_(i=0)^1)(∑_(j=0)^1)(∑_(k=0)^1)(∑_(l=0)^1)(Subscript[a, i])(Subscript[a, j])(Subscript[b, k])(Subscript[b, l])(λ/R)(Sqrt[(2i+1)(2j+1)(2k+1)(2l+1)])(∑_(L=0)^2)((ThreeJSymbol[{i,0},{j,0},{L,0}])^2)((ThreeJSymbol[{k,0},{l,0},{L,0}])^2)/.{(Subscript[a, 0])->-Sin[x],(Subscript[a, 1])->Cos[x],(Subscript[b, 0])->-Sin[y],(Subscript[b, 1])->Cos[y]};

(λ^2)*Table[ EsHF[R,1]/.sol[[k]],{k,Length[sol]}]/.R->λ//FullSimplify//Expand//DeleteDuplicates

Plot[{2+((29 λ)/25),1+λ,λ,(13/22)-(225/(88 λ))+((2239 λ)/1650),(37/28)+(225/(112 λ))+((1511 λ)/2100)},{λ,-3,3},PlotLegends->{"(s^2)_RHF","((Subscript[sp, z])_UHF) ???","((Subscript[p, z])^2)_RHF","sb_RHF/h_RHF","sb_UHF/h_UHF"}]

Plot[{(1/R),(1/(R^2))+(1/R),(2/(R^2))+(29/(25 R)),(75/(88 (R^3)))+(25/(22 (R^2)))+(91/(66 R)),-(75/(112 (R^3)))+(25/(28 (R^2)))+(59/(84 R))},{R,-1,-3},PlotLegends->{"(s^2)_RHF","((Subscript[sp, z])_UHF) ???","((Subscript[p, z])^2)_RHF","sb_RHF/h_RHF","sb_UHF/h_UHF"}]

For R > 0:
-the sb_RHF solution is a maximum and exist for R>75/38 (~1.97) before it is a holomorphic solution
-the sb_UHF solution is a minimum and exist for R>3/2  before it is a holomorphic solution
For R<0:
-the sb_RHF solution is a minimum and exist for R<-3/2 after it is a holomorphic solution
-the sb_UHF solution is a maximum and exist for R<-75/62(~1.2) after it is a holomorphic solution

Those points are the Coulson-Fischer points of the sb-RHF and sb-UHF solutions.

Mono electronic wavefunctions

(Subscript[ϕ, HF])=(Cos[x](Subscript[Y, 0])[θ1]+Sin[x](Subscript[Y, 1])[θ1])(Cos[y](Subscript[Y, 0])[θ2]+Sin[y](Subscript[Y, 1])[θ2])

cα={{Cos[x],Sin[x]},{-Sin[x],Cos[x]}}\[Transpose];	oα={{Cos[x](Subscript[Y, 0])[θ1],Sin[x](Subscript[Y, 1])[θ1]}}\[Transpose];	Pα=oα.oα\[Transpose];
cβ={{Cos[y],Sin[y]},{-Sin[y],Cos[y]}}\[Transpose];	oβ={{Cos[y](Subscript[Y, 0])[θ2],Sin[y](Subscript[Y, 1])[θ2]}}\[Transpose];	Pβ=oβ.oβ\[Transpose];

Pα+Pβ/.sol//FullSimplify

Pα-Pβ/.sol//FullSimplify

(Cos[x](Subscript[Y, 0])[θ1]+Sin[x](Subscript[Y, 1])[θ1])/.x->ArcTan[((Sqrt[75+62 R])/(Sqrt[R])),((5 (Sqrt[-3+2 R]))/(Sqrt[R]))]//FullSimplify

{(Cos[x](Subscript[Y, 0])[θ1]+Sin[x](Subscript[Y, 1])[θ1]),(-Sin[x](Subscript[Y, 0])[θ1]+Cos[x](Subscript[Y, 1])[θ1])}/.{x->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),-((5 (Sqrt[3+2 R]))/(Sqrt[R]))]}//FullSimplify

Plot[{-(((Sqrt[-75+38 R])+5 (Sqrt[9+6 R]) Cos[θ1])/(4 (Sqrt[22 π]) (Sqrt[R]))),-((-5 (Sqrt[3+2 R])+(Sqrt[3]) (Sqrt[-75+38 R]) Cos[θ1])/(4 (Sqrt[22 π]) (Sqrt[R])))}/.R->1000,{θ1,0,π}]

EHF[R_,λ_]=(∑_(L=0)^1)(Subscript[a, L]^2)((L(L+1))/(2(R^2)))+(∑_(L=0)^1)(Subscript[b, L]^2)((L(L+1))/(2(R^2)))+(∑_(i=0)^1)(∑_(j=0)^1)(∑_(k=0)^1)(∑_(l=0)^1)(Subscript[a, i])(Subscript[a, j])(Subscript[b, k])(Subscript[b, l])(λ/R)(Sqrt[(2i+1)(2j+1)(2k+1)(2l+1)])(∑_(L=0)^2)((ThreeJSymbol[{i,0},{j,0},{L,0}])^2)((ThreeJSymbol[{k,0},{l,0},{L,0}])^2)/.{(Subscript[a, 0])->Cos[x],(Subscript[a, 1])->Sin[x],(Subscript[b, 0])->Cos[y],(Subscript[b, 1])->Sin[y]}/.λ->1/.sol//FullSimplify//Expand

EHF[R_,λ_]=(∑_(L=0)^1)(Subscript[a, L]^2)((L(L+1))/(2(R^2)))+(∑_(L=0)^1)(Subscript[b, L]^2)((L(L+1))/(2(R^2)))+(∑_(i=0)^1)(∑_(j=0)^1)(∑_(k=0)^1)(∑_(l=0)^1)(Subscript[a, i])(Subscript[a, j])(Subscript[b, k])(Subscript[b, l])(λ/R)(Sqrt[(2i+1)(2j+1)(2k+1)(2l+1)])(∑_(L=0)^2)((ThreeJSymbol[{i,0},{j,0},{L,0}])^2)((ThreeJSymbol[{k,0},{l,0},{L,0}])^2)/.{(Subscript[a, 0])->-Sin[x],(Subscript[a, 1])->Cos[x],(Subscript[b, 0])->-Sin[y],(Subscript[b, 1])->Cos[y]}/.λ->1/.sol//FullSimplify//Expand

Singularity structure

{(Subscript[ψα, 1])[θ_,R_]:=Cos[χα](Subscript[Y, 0])[θ]+Sin[χα](Subscript[Y, 1])[θ]/.χα->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))],
(Subscript[ψβ, 1])[θ_,R_]:=Cos[χβ](Subscript[Y, 0])[θ]+Sin[χβ](Subscript[Y, 1])[θ]/.χβ->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))],
(Subscript[ψα, 2])[θ_,R_]:=-Sin[χα](Subscript[Y, 0])[θ]+Cos[χα](Subscript[Y, 1])[θ]/.χα->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))],
(Subscript[ψβ, 2])[θ_,R_]:=-Sin[χβ](Subscript[Y, 0])[θ]+Cos[χβ](Subscript[Y, 1])[θ]/.χβ->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))]}//FullSimplify;

{Ψ1=(Subscript[ψα, 1])[θ1,R](Subscript[ψβ, 1])[θ2,R],Ψ2=(Subscript[ψα, 1])[θ1,R](Subscript[ψβ, 2])[θ2,R],Ψ3=(Subscript[ψα, 2])[θ1,R](Subscript[ψβ, 1])[θ2,R],Ψ4=(Subscript[ψα, 2])[θ1,R](Subscript[ψβ, 2])[θ2,R]}//FullSimplify;

S[Ψ1_,Ψ2_,R_]:=(((2π))^2)(∫_0^π)(∫_0^π) Expand[Ψ1 Ψ2] Sin[θ1]Sin[θ2]\[DifferentialD]θ1\[DifferentialD]θ2//FullSimplify
H[Ψ1_,Ψ2_,R_]:=((((2π))^2)/(2(R^2)))(∫_0^π)(∫_0^π)Expand[((∂_(θ1))Ψ1)((∂_(θ1))Ψ2)+((∂_(θ2))Ψ1)((∂_(θ2))Ψ2)]Sin[θ1]Sin[θ2]\[DifferentialD]θ1\[DifferentialD]θ2+((((2π))^2)/R)(∫_0^π)(∫_0^π) Expand[Ψ1 Ψ2(1+Cos[θ1] Cos[θ2]+(1/4) (-1+3 ((Cos[θ1])^2)) (-1+3 ((Cos[θ2])^2)))] Sin[θ1]Sin[θ2]\[DifferentialD]θ1\[DifferentialD]θ2//FullSimplify

H[Ψ1,Ψ1,R]

(({{H[Ψ1,Ψ1,R], H[Ψ2,Ψ1,R], H[Ψ3,Ψ1,R], H[Ψ4,Ψ1,R]}, {H[Ψ1,Ψ2,R], H[Ψ2,Ψ2,R], H[Ψ3,Ψ2,R], H[Ψ4,Ψ2,R]}, {H[Ψ1,Ψ3,R], H[Ψ2,Ψ3,R], H[Ψ3,Ψ3,R], H[Ψ4,Ψ3,R]}, {H[Ψ1,Ψ4,R], H[Ψ2,Ψ4,R], H[Ψ3,Ψ4,R], H[Ψ4,Ψ4,R]}}))

{{((225+4 R (75+91 R))/(264 (R^3))),0,0,((75+4 R (3+R))/(88 (R^3)))},{0,((225+4 R (75+47 R))/(264 (R^3))),((75+4 R (3+R))/(88 (R^3))),(((Sqrt[3+2 R]) (25+2 R) (Sqrt[-75+38 R]))/(220 (R^3)))},{0,((75+4 R (3+R))/(88 (R^3))),((225+4 R (75+47 R))/(264 (R^3))),(((Sqrt[3+2 R]) (25+2 R) (Sqrt[-75+38 R]))/(220 (R^3)))},{((75+4 R (3+R))/(88 (R^3))),(((Sqrt[3+2 R]) (25+2 R) (Sqrt[-75+38 R]))/(220 (R^3))),(((Sqrt[3+2 R]) (25+2 R) (Sqrt[-75+38 R]))/(220 (R^3))),((-16875+4 R (975+2239 R))/(6600 (R^3)))}}//MatrixForm

sbRHF[R_]:=(({{((225+4 R (75+91 R))/(264 (R^3))), 0, 0, ((75+4 R (3+R))/(88 (R^3)))}, {0, ((225+4 R (75+47 R))/(264 (R^3))), ((75+4 R (3+R))/(88 (R^3))), (((Sqrt[3+2 R]) (25+2 R) (Sqrt[-75+38 R]))/(220 (R^3)))}, {0, ((75+4 R (3+R))/(88 (R^3))), ((225+4 R (75+47 R))/(264 (R^3))), (((Sqrt[3+2 R]) (25+2 R) (Sqrt[-75+38 R]))/(220 (R^3)))}, {((75+4 R (3+R))/(88 (R^3))), (((Sqrt[3+2 R]) (25+2 R) (Sqrt[-75+38 R]))/(220 (R^3))), (((Sqrt[3+2 R]) (25+2 R) (Sqrt[-75+38 R]))/(220 (R^3))), ((-16875+4 R (975+2239 R))/(6600 (R^3)))}}))

On veut vérifier (f^α) (ψ^α) = ϵ (ψ^α)

h(1)(ψ^α)= -(1/2)(∂_(θ,θ))(ψ^α)

(Subscript[ψα, 1])[θ_,R_]:=Cos[χα](Subscript[Y, 0])[θ]+Sin[χα](Subscript[Y, 1])[θ]/.χα->ArcTan[((Sqrt[-75+38 R])/(Sqrt[R])),((5 (Sqrt[3+2 R]))/(Sqrt[R]))]

(∑_a^(N^α))[(Subscript[J, a]^α)(1)-(Subscript[K, a]^α)(1)]+(∑_a^(N^β))(Subscript[J, a]^β)(1)

Ici un seul électron α et un seul β

(Subscript[J, a]^α)(1)=∫(Subscript[ψ, a]^(SuperStar[α]))(2)(1/(Subscript[r, 12]))(Subscript[ψ, a]^α)(2)\[DifferentialD](Subscript[r, 2])

(Subscript[ψα, 1])[θ1,R]//FullSimplify

-(1/(2 (R^2)Sin[θ1]))(∂_(θ1))(Sin[θ1](∂_(θ1))(Subscript[ψα, 1])[θ1,R])//FullSimplify

((5 (Sqrt[9+6 R]) Cos[θ1])/(4 (Sqrt[22 π]) (R^(5/2))))=(1/(R^2)) ((5 (Sqrt[9+6 R]) Cos[θ1])/(4 (Sqrt[22 π]) (Sqrt[R])))

(Subscript[ψα, 2])[θ1,R]//FullSimplify

-(1/(2 (R^2)Sin[θ1]))(∂_(θ1))(Sin[θ1](∂_(θ1))(Subscript[ψα, 2])[θ1,R])//FullSimplify

(((Sqrt[(3/(22 π))]) (Sqrt[-75+38 R]) Cos[θ1])/(4 (R^(5/2))))=(1/(R^2)) (((Sqrt[3]) (Sqrt[-75+38 R]) Cos[θ1])/(4 (Sqrt[22 π]) (Sqrt[R])))

((2π (R^2))/R)(∫_0^π)(Subscript[ψα, 1])[θ2,R](1+Cos[θ1] Cos[θ2]+(1/4) (-1+3 ((Cos[θ1])^2)) (-1+3 ((Cos[θ2])^2)))(Subscript[ψα, 1])[θ2,R]Sin[θ2]\[DifferentialD]θ2

(1/528) (20 (Sqrt[9+6 R]) (Sqrt[-75+38 R]) Cos[θ1]+9 (5+62 R+5 (3+2 R) Cos[2 θ1]))(Subscript[ψα, 1])[θ1,R]+((5 (Sqrt[9+6 R]) Cos[θ1])/(4 (Sqrt[22 π]) (R^(5/2))))//FullSimplify

(1/528) (20 (Sqrt[9+6 R]) (Sqrt[-75+38 R]) Cos[θ1]+9 (5+62 R+5 (3+2 R) Cos[2 θ1]))

(Subscript[K, a]^α)(1)(Subscript[ψ, i]^α)(1)=[∫(Subscript[ψ, a]^(SuperStar[α]))(2)(1/(Subscript[r, 12]))(Subscript[ψ, i]^α)(2)\[DifferentialD](Subscript[r, 2])](Subscript[ψ, a]^α)(1)

(1/(Subscript[r, 12]))=(1+Cos[θ1] Cos[θ2]+(1/4) (-1+3 ((Cos[θ1])^2)) (-1+3 ((Cos[θ2])^2)))