|
| 1 | +(* ::Package:: *) |
| 2 | + |
| 3 | +BeginPackage["MagneticTB`"] |
| 4 | + |
| 5 | + |
| 6 | +Begin["`Private`"] |
| 7 | + |
| 8 | + |
| 9 | +getSGLatt=SpaceGroupIrep`getSGLatt; |
| 10 | +BasicVectors=SpaceGroupIrep`BasicVectors; |
| 11 | +getRotMat=SpaceGroupIrep`getRotMat; |
| 12 | +getSpinRotOp=SpaceGroupIrep`getSpinRotOp; |
| 13 | + |
| 14 | + |
| 15 | +MSGSymStd=MSGCorep`MSGSymStd; |
| 16 | +getMSGElem=MSGCorep`getMSGElem; |
| 17 | +getBandCorep=MSGCorep`getBandCorep; |
| 18 | +showBandCorep=MSGCorep`showBandCorep; |
| 19 | +spinMatrix[op_] := |
| 20 | + FullSimplify[Module[{\[Alpha], \[Beta], \[Gamma], nop}, |
| 21 | + If[Det[op] == -1, nop = -op, nop = op]; |
| 22 | + {\[Alpha], \[Beta], \[Gamma]} = -EulerAngles[nop]; |
| 23 | + Transpose@{{E^(I \[Gamma]/2) Cos[\[Beta]/2] E^(I \[Alpha] /2), E^(I \[Gamma]/2) Sin[\[Beta]/2] E^(-I \[Alpha] /2)}, |
| 24 | + {-E^(-I \[Gamma]/2) Sin[\[Beta]/2] E^(I \[Alpha] /2), E^(-I \[Gamma]/2) Cos[\[Beta]/2] E^(-I \[Alpha] /2)}}]]; |
| 25 | + |
| 26 | + |
| 27 | +getMSGElemFromMSGCorep[MSG_]:=Module[ |
| 28 | +{SG,brav,msgelem,latt}, |
| 29 | + |
| 30 | + |
| 31 | + |
| 32 | +If[Not@MemberQ[$Packages,"MSGCorep`"],Print["Please install and import MSGCorep package (https://github.com/goodluck1982/MSGCorep)";Abort[]];]; |
| 33 | +msgelem=MapAt[If[#==0,"F","T"]&,getMSGElem[MSG],{;;,-1}]; |
| 34 | +SG=MSG[[1]]; |
| 35 | +brav=getSGLatt[SG]; |
| 36 | +latt=BasicVectors[brav]/.{ |
| 37 | +SpaceGroupIrep`a->MagneticTB`a, |
| 38 | +SpaceGroupIrep`b->MagneticTB`b,SpaceGroupIrep`c->MagneticTB`c, |
| 39 | +SpaceGroupIrep`\[Alpha]->MagneticTB`\[Alpha], |
| 40 | +SpaceGroupIrep`\[Beta]->MagneticTB`\[Beta], |
| 41 | +SpaceGroupIrep`\[Gamma]->MagneticTB`\[Gamma]}; |
| 42 | +Print["Magnetic space group (BNS):",MSGSymStd[MSG]," No. ",StringRiffle[MSG,"."]]; |
| 43 | +Print["Lattice: ",brav]; |
| 44 | +Print["Primitive Lattice Vactor: ",latt]; |
| 45 | +Insert[#,getRotMat[brav,#[[1]]],2]&/@msgelem |
| 46 | + |
| 47 | +]; |
| 48 | + |
| 49 | +findLittleGroupOfK[k_]:=Module[{rk,k0}, |
| 50 | +k0=Mod[k,1,0]; |
| 51 | + |
| 52 | +rk=Association@MapIndexed[First@#2->#1&,Insert[#,Inverse@Transpose[#[[2]]],5]&/@symminfo]; |
| 53 | +(*Print[rk];*) |
| 54 | +rk=MapAt[Mod[# . k0,1,0]&,rk,{;;,5}]; |
| 55 | +(*Print[rk];*) |
| 56 | +rk=Select[rk,#[[5]]==k0&&#[[4]]=="F"&]; |
| 57 | +Keys[rk] |
| 58 | +]; |
| 59 | + |
| 60 | + |
| 61 | + |
| 62 | +getTBBandCorep[MSG_, ham_, param_, kset_] := Module[ |
| 63 | + {rot,tmp, ops, wc, sym, tr, brav, msgele, eiv, little, trace, cr, coeff, |
| 64 | + U, opII, actk |
| 65 | + }, |
| 66 | + tr = Association[]; |
| 67 | + ops = N@symmetryops; |
| 68 | + wc = N@wcc; |
| 69 | + sym = symminfo; |
| 70 | + tr["nelec"] = Length[ham]; |
| 71 | + (*Print[basisdict[#]&@basis[[1,1]]];*) |
| 72 | + tr["soc"] =If[ListQ[basisdict[#]&@basis[[1,1]]],1,0]; |
| 73 | + (*Print[tr["soc"]];*) |
| 74 | + (*basis*) |
| 75 | + tr["nsym"] = Length[sym]; |
| 76 | +(* brav = getSGLatt[MSG[[1]]]; |
| 77 | + msgele = getMSGElem[MSG]; |
| 78 | + rot=getRotMat[brav, #[[1]]] & /@ msgele;*) |
| 79 | + rot=sym[[;;,2]]; |
| 80 | + tr["rot"] = rot; |
| 81 | + tr["trans"] = N@sym[[;;,3]]; |
| 82 | + (*tr["srot"] = N@getSpinRotOp[#[[1]]][[1]] & /@ msgele;*) |
| 83 | + (*Print[rot];*) |
| 84 | + (*latt={{0,-a,0},{(Sqrt[3] a)/2,a/2,0},{0,0,c}};*) |
| 85 | + tr["srot"] = N@spinMatrix[Transpose[latt] . # . Inverse@Transpose@latt] & /@ rot; |
| 86 | + |
| 87 | + (*Abort[];*) |
| 88 | + tr["unitary"] = If[# == "F", 1, -1] & /@ sym[[;; , -1]]; |
| 89 | + tr["nk"] = Length@kset; |
| 90 | + tr["kpt"] = kset; |
| 91 | + tr["nband"] = Length[ham]; |
| 92 | + |
| 93 | + Table[tr[i] = {}, {i, {"ene", "deg", "knsym", "kisym", "trace"}}]; |
| 94 | + Do[ |
| 95 | + U = N@DiagonalMatrix[Table[Exp[-2 Pi I kpoint . tau], {tau, wc}]]; |
| 96 | + (*Print[MatrixForm@U];*) |
| 97 | + eiv = Eigensystem[ |
| 98 | + ConjugateTranspose[ |
| 99 | + U] . (ham /. |
| 100 | + Join[param, Thread[{kx, ky, kz} -> 2 Pi kpoint]]) . U]; |
| 101 | + eiv = Transpose@SortBy[Transpose[eiv], #[[1]] &]; |
| 102 | + eiv = Transpose /@ SplitBy[Transpose[eiv], Round[#[[1]], 0.0001] &]; |
| 103 | + (*Print[eiv];*) |
| 104 | + AppendTo[tr["ene"], Flatten@eiv[[;; , 1]]]; |
| 105 | + AppendTo[tr["deg"], |
| 106 | + Flatten[Table[#, {i, #}] & /@ Length /@ eiv[[;; , 1]]]]; |
| 107 | + little = findLittleGroupOfK[kpoint]; |
| 108 | + AppendTo[tr["knsym"], Length@little]; |
| 109 | + AppendTo[tr["kisym"], little]; |
| 110 | + |
| 111 | + trace = |
| 112 | + Flatten[Table[ |
| 113 | + Table[ |
| 114 | + Table[ |
| 115 | + actk = Inverse[Transpose[symminfo[[i, 2]]]]; |
| 116 | + (*opII is from GB Liu's note*) |
| 117 | + opII = |
| 118 | + Exp[-2 Pi I symminfo[[i, 3]] . (actk . (kpoint))] Table[ |
| 119 | + Exp[2 Pi I actk . |
| 120 | + kpoint . (wc[[m]] - (symminfo[[i, 2]] . wc[[l]]))], {m, |
| 121 | + Length[wc]}, {l, Length[wc]}] ops[[i]]; |
| 122 | + Chop@Tr[Conjugate[e[[2]]] . (opII) . Transpose[e[[2]]]] |
| 123 | + , {i, little}] |
| 124 | + , {nr, Length[e[[1]]]}] |
| 125 | + , {e, eiv}]]; |
| 126 | + |
| 127 | + AppendTo[tr["trace"], Partition[trace, Length[little]]]; |
| 128 | + |
| 129 | + , {kpoint, kset}]; |
| 130 | + (*Print[tr];*) |
| 131 | + cr = getBandCorep[MSG, tr]; |
| 132 | + Print["Magnetic space group (BNS): ", MSGSymStd[MSG]," No. ",StringRiffle[MSG,"."]]; |
| 133 | + Print["Lattice: ",brav]; |
| 134 | + (*Print[cr];*) |
| 135 | + Do[ |
| 136 | + Print["k-name: "<>#2<>", k-point: "<>ToString[InputForm@#1]<>", little co-group: "<>ToString@#4 &@@cr["kinfo"][[k]]]; |
| 137 | + Print@showBandCorep[cr, k] |
| 138 | + |
| 139 | + ,{k,Length[kset]}] |
| 140 | + ] |
| 141 | + |
| 142 | + |
| 143 | +End[] |
| 144 | +EndPackage[] |
| 145 | + |
0 commit comments