(Subscript[D, 4]) molecular orbitals

Set 1

D4=<|
"Irreps"->{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[B, 1])","(Subscript[B, 2])","E"},
"CharacterTable"->
{
{1,1,1,1,1},
{1,1,1,-1,-1},
{1,-1,1,1,-1},
{1,-1,1,-1,1},
{2,0,-2,0,0}
},
"ConjugacyClasses"->{"E","(Subscript[C, 4])","(Subscript[C, 2]^z)","(Subscript[C, 2]^('))","(Subscript[C, 2]^(''))"},
"ConjugacyClassSizes"->{1,2,1,2,2}
|>;

OrbBasis={p1,p2,p3,p4};
D4gens={
(*(SuperPlus[(Subscript[C, 4])])*)(({{0, 0, 0, 1}, {1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}})),
(*(Subscript[C, 2]^('))(x)*)(({{1, 0, 0, 0}, {0, 0, 0, 1}, {0, 0, 1, 0}, {0, 1, 0, 0}}))
};
MatrixForm/@(D4mats=Flatten[Table[MatrixPower[D4gens[[1]],i].MatrixPower[D4gens[[2]],j],{i,0,3},{j,0,1}],1])

D4matClasses={"E","(Subscript[C, 2]^('))","(Subscript[C, 4])","(Subscript[C, 2]^(''))","(Subscript[C, 2]^z)","(Subscript[C, 2]^('))","(Subscript[C, 4])","(Subscript[C, 2]^(''))"};

projectorD4[irrep_]:=Module[{repind},
repind=Position[D4["Irreps"],irrep][[1,1]];
((D4["CharacterTable"][[repind,1]])/8)(∑_(i=1)^8)D4["CharacterTable"][[repind,Position[D4["ConjugacyClasses"],D4matClasses[[i]]][[1,1]]]]D4mats[[i]]
]

projectors={PA1,PA2,PB1,PB2,PE}=projectorD4/@D4["Irreps"];

TableForm[{MatrixForm/@projectors},TableHeadings->{None,D4["Irreps"]}]

#.#==#&/@projectors

PA1.OrbBasis

(*Or ψ'=Pψ, then Pψ'=ψ', ψ' is an eigen vector of P.*)

Eigensystem[PA1]

Normalize[{1,1,1,1}].OrbBasis

Eigensystem[PB1]

Normalize[-{-1,1,-1,1}].OrbBasis

Eigensystem[PE]

Normalize[{0,-1,0,1}].OrbBasis
Normalize[{-1,0,1,0}].OrbBasis

Set 2

D4=<|
"Irreps"->{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[B, 1])","(Subscript[B, 2])","E"},
"CharacterTable"->
{
{1,1,1,1,1},
{1,1,1,-1,-1},
{1,-1,1,1,-1},
{1,-1,1,-1,1},
{2,0,-2,0,0}
},
"ConjugacyClasses"->{"E","(Subscript[C, 4])","(Subscript[C, 2]^z)","(Subscript[C, 2]^('))","(Subscript[C, 2]^(''))"},
"ConjugacyClassSizes"->{1,2,1,2,2}
|>;

OrbBasis={p1,p2,p3,p4};
D4gens={
(*(SuperPlus[(Subscript[C, 4])])*)(({{0, 0, 0, 1}, {1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}})),
(*(Subscript[C, 2]^('))(x)*)(({{-1, 0, 0, 0}, {0, 0, 0, -1}, {0, 0, -1, 0}, {0, -1, 0, 0}}))
};
MatrixForm/@(D4mats=Flatten[Table[MatrixPower[D4gens[[1]],i].MatrixPower[D4gens[[2]],j],{i,0,3},{j,0,1}],1])

D4matClasses={"E","(Subscript[C, 2]^('))","(Subscript[C, 4])","(Subscript[C, 2]^(''))","(Subscript[C, 2]^z)","(Subscript[C, 2]^('))","(Subscript[C, 4])","(Subscript[C, 2]^(''))"};

projectorD4[irrep_]:=Module[{repind},
repind=Position[D4["Irreps"],irrep][[1,1]];
((D4["CharacterTable"][[repind,1]])/8)(∑_(i=1)^8)D4["CharacterTable"][[repind,Position[D4["ConjugacyClasses"],D4matClasses[[i]]][[1,1]]]]D4mats[[i]]
]

projectors={PA1,PA2,PB1,PB2,PE}=projectorD4/@D4["Irreps"];

TableForm[{MatrixForm/@projectors},TableHeadings->{None,D4["Irreps"]}]

#.#==#&/@projectors

(*Or ψ'=Pψ, then Pψ'=ψ', ψ' is an eigen vector of P.*)

Eigensystem[PA2]

Normalize[{1,1,1,1}].OrbBasis

Eigensystem[PB2]

Normalize[-{-1,1,-1,1}].OrbBasis

Eigensystem[PE]

Normalize[{0,-1,0,1}].OrbBasis
Normalize[{-1,0,1,0}].OrbBasis

Set 3

Set 3 identical to set 2 in terms of representation matrices, where the basis set consists of pz orbitals pointing up.

Emery three-orbital TB model

Needs["MathTB`TightBinding`"]

PlotBand[Energy_,Knames_,Emin_,Emax_,ratio_:0.7]:=ListPlot[
Energy,Joined->True,
PlotRange->{{0.9,Length[Energy[[1]]]+0.1},{Emin,Emax}},
Frame->True,FrameStyle->Thickness[0.0015],FrameTicks->{Reverse[#]&/@Knames,Automatic},FrameTicksStyle->Directive[FontFamily->"Times New Roman",FontSize->12,Black,Italic],
AspectRatio->ratio,PlotStyle->{RGBColor[1,0,0]},
GridLines->{Knames[[;;,2]],{}},GridLinesStyle->{{Black,Thickness[0.0015]},{}}
]

lat={{1,0},{0,1}};
orb={{0,0},{0.5,0},{0,0.5}};
emeryTB=InitTightBindingModel[2,2,lat,orb]

tpd=1.0;
SetOnSite[emeryTB,{-1.0,-4.0,-4.0}]
SetHoppings[emeryTB,tpd,1,2,{0,0}];
SetHoppings[emeryTB,-tpd,1,3,{0,0}];
SetHoppings[emeryTB,-tpd,1,2,{-1,0}];
SetHoppings[emeryTB,tpd,1,3,{0,-1}];

Chop[FullSimplify[ExpToTrig[CreateHamiltonian[emeryTB,{kx,ky}]],{kx,ky,mu,tpd}∈Reals]]//MatrixForm

HTBemery[{kx_,ky_}]:=(({{-1.0, 2 I Sin[π kx], -2 I Sin[π ky]}, {-2 I Sin[π kx], -4, 0}, {2 I Sin[π ky], 0, -4}}))

KPathDefine={
{"G",{0.0, 0.0},40},
{"X",{0.5,0},40},
{"M",{0.5,0.5},57},
{"G",{0.0, 0.0},1},
{"G",{0.0, 0.0},0}
};
KPoints=Flatten[Table[Table[KPathDefine[[i,2]](((KPathDefine[[i,3]]-j+1))/(KPathDefine[[i,3]]))+KPathDefine[[i+1,2]]((j-1)/(KPathDefine[[i,3]])),{j,1,KPathDefine[[i,3]]}],{i,1,Length[KPathDefine]-1}],1];
Knames=Table[{KPathDefine[[i,1]],1+Sum[KPathDefine[[ii,3]],{ii,1,i-1}]},{i,1,Length[KPathDefine]-1}];

TBval=Chop[Sort[Eigenvalues[HTBemery[#]]]&/@KPoints];

PlotBand[Transpose[TBval],Knames,-6.5,2]