/* FileName: SimpleLieAlgebra0.mxm Contents: Maxima 5.46 program for Lie algebra calculation Creation: Hideo Kodama 2022/9/20 < SimpleLieAlgebra.mpl 2022/10/29: version 1.0 2022/11/2: version 1.1 : addition of proc: mkSOSLembM and some corrections 2022/11/3: v. 1.11: embedding matrix info for the Dynkin type A is installed to dict embM 2022/11/4: v. 1.12: embedding matrix info for the Dynkin type B is installed to dict embM 2022/11/5: v. 1.13: embedding matrix info for the Dynkin type C is installed to dict embM 2022/11/8: bug fix of the proc: SubGrdm 2022/11/13: correcting proc: MaxSubGlist, embedding matrix info for the Dynkin type D, E, F and G is installed to dict embM, and proc: embMlist and the procinfo on embMlist are pudated. 2022/11/13: v. 1.14 Last Updata: 2022/11/13 */ /******> Initialization */ print("Initialization"); load("eigen"); scalarmatrixp: false$ stringdisp: true$ /******> Global variables */ print("Global variables"); CM : 'CM $ /* Cartan metric */ SR : 'SR $ /* SimpleRootsbyH matrix */ alpha : 'alpha $ /*simmple root array */ /******> Job controle */ print("Job controle"); Job_all : true $ Job_test: false $ Job_SU2 : true $ Job_SU3 : true $ Job_SU3_SubG : true $ Job_SU3_SubG_SO3 : true $ Job_SU3_SubG_SU2U1 : true $ Job_SU4 : false $ Job_SU4_SubG_SU3 : true $ Job_SU4_SubG_SU2SU2U1 : true $ Job_SU4_SubG_SU2SU2 : true $ Job_SU4_SubG_Sp2 : true $ Job_SU5 : false $ Job_SU5_SubG : true $ Job_SU5_SubG_SU4U1 : true $ Job_SU5_SubG_SU3SU2U1 : true $ Job_SU5_SubG_SO5 : true $ Job_SU6 : false $ Job_SU6_SubG_SU5U1 : true $ Job_SU6_SubG_SU4SU2U1 : true $ Job_SU6_SubG_SU3SU3U1 : true $ Job_SU6_SubG_SU4 : true $ Job_SU6_SubG_SU3 : true $ Job_SU6_SubG_SU3SU2 : true $ Job_SU6_SubG_Sp3 : true $ Job_SO5 : false $ Job_SO5_SubG_SU2U1 : true $ Job_SO5_SubG_SU2SU2 : true $ Job_SO5_SubG_SU2max : true $ Job_SO7 : false $ Job_SO7_SubG_SU4 : true $ Job_SO7_SubG_SO5U1 : true $ Job_SO7_SubG_SU2SU2SU2 : true $ Job_SO7_SubG_G2 : true $ Job_Sp3 : false $ Job_Sp3_SubG_SU3U1 : true $ Job_Sp3_SubG_Sp2SU2 : true $ Job_Sp3_SubG_SU2 : true $ Job_Sp3_SubG_SU2SU2 : true $ Job_SO8 : false $ Job_SO8_SubG_SU4U1 : true $ Job_SO8_SubG_SU2SU2SU2SU2 : true $ Job_SO8_SubG_SO7 : true $ Job_SO8_SubG_SU3 : true $ Job_SO8_SubG_Sp2SU2 : true $ Job_SO9 : false $ Job_SO9_SubG_SO8 : true $ Job_SO9_SubG_SO7U1 : true $ Job_SO9_SubG_SU4SU2 : true $ Job_SO9_SubG_Sp2SU2SU2 : true $ Job_SO9_SubG_SU2 : true $ Job_SO9_SubG_SU2SU2 : true $ Job_Sp4 : false $ Job_Sp4_SubG_SU4U1 : true $ Job_Sp4_SubG_Sp3SU2 : true $ Job_Sp4_SubG_Sp2Sp2 : true $ Job_Sp4_SubG_SU2 : true $ Job_Sp4_SubG_SU2SU2SU2 : true $ Job_Sp5 : false $ Job_Sp5_SubG_SU5U1 : true $ Job_SO10 : false $ Job_SO10_SubG_SO8U1 : true $ Job_SO10_SubG_SU5U1 : true $ Job_SO10_SubG_SU4SU2SU2 : true $ Job_SO10_SubG_SO9 : true $ Job_SO10_SubG_SO7SU2 : true $ Job_SO10_SubG_Sp2Sp2 : true $ Job_SO10_SubG_Sp2 : true $ Job_E6 : false $ Job_E6_SubG_SO10U1 : true $ Job_E6_SubG_SU6SU2 : true $ Job_E6_SubG_SU3SU3SU3 : true $ Job_E6_SubG_SU3 : true $ Job_E6_SubG_G2 : true $ Job_E6_SubG_G2SU3 : true $ Job_E6_SubG_Sp4 : true $ Job_E6_SubG_F4 : true $ Job_F4 : false $ Job_F4_SubG_SO9 : true $ Job_F4_SubG_SU3SU3 : true $ Job_F4_SubG_Sp3SU2 : true $ Job_F4_SubG_G2SU2 : true $ Job_G2 : false $ Job_G2_SubG_SU3 : true $ if Job_all then ( Job_SU3 : true , Job_SU4 : true , Job_SU5 : true , Job_SU6 : true , Job_SO5 : true , Job_SO7 : true , Job_SO8 : true , Job_SO9 : true , Job_SO10 : true, Job_Sp3 : true , Job_Sp4 : true , Job_Sp5 : true , Job_G2 : true , Job_F4 : true , Job_E6 : true , Job_F4 : true )$ /******> Basic procedures */ print("Basic procedures"); /*****>Common procedures */ /****>proc: slist */ /* slist( L:: list, m, n) => [L[m],..., L[n]] */ slist ( L, m, n) := block ( [i], if listp(L) then ( if ( not integerp(m)) or (not integerp(n) ) then ( error("slist: the range indeces must be integers") ), /* end if*/ if m<0 then ( m: 1), /*end if*/ if n> length(L) then ( n: length(L)), /*end if*/ if m> n then ( return ([]) ) else ( return ( makelist(L[i], i, m, n) ) ) /*end if*/ ) else ( error("Usage: slist( , m, n )") ) )$ /****> proc: memberp */ /* memberp( , ) => a position list [i1,...] */ memberp (x, L) := block([poslist], if not member(x, L) then ( return ([]) ) else ( poslist : [], for i:1 thru length(L) do ( if L[i] = x then ( poslist : endcons( i, poslist) ) ), return (poslist) ) )$ /*end proc: memberp */ /*****> Matrix functions */ /****>proc: blockMatrices */ /* blockMatrices(mxlist) mxlist = [M1, ..., Mn] => M : blockdiagona */ blockMatrices(mxlist) := block( [ rownl, colnl, M], mxlist : map(lambda([x], if not matrixp(x) then ( matrix([x])) else (x) ), mxlist), rownl : [], colnl: [], for x in mxlist do ( [a, b] : matrix_size (x), if a # b then ( error ("Diagonal Matrix: matrix blocks must be square matrices") ), /*end if*/ rownl : append( rownl, [a] ), colnl : append(colnl, [b]) ), /*end do*/ M : zeromatrix( sumlist(rownl), sumlist(colnl)), [j0, k0] : [0,0], for i: 1 thru length(mxlist) do ( for j: 1 thru rownl[i] do ( for k: 1 thru colnl[i] do ( M[j0+j, k0+k] : mxlist[i][j,k] ) /*end do*/ ), /*end do*/ j0 : j0+rownl[i], k0 : k0+colnl[i] ), /*end do*/ return (copy(M)) )$ /*end proc: blockMatrices */ /****>proc: colMatrices */ /* colMatrices( mxlist) mxlist = [M1, ..., Mn], M1 =matrix(a1, b), ..., Mn = matrix(an,b) => M = matrix(a1+...+an,b) */ colMatrices( mxlist ) := block( [x, n, rown, coln, M], n : length(mxlist), x : matrix_size(mxlist[1]), coln : x[2], M : mxlist[1], for i:2 thru n do ( x : matrix_size(mxlist[i]), if x[2]# coln then ( error("colMatrices: all the component matrices should have the same column number") ), rown : x[1], M : apply(addrow, cons(M, makelist( row(mxlist[i],j), j, 1, rown) ) ) ), /*end do*/ return (M) )$ /*end proc: colMatrices */ /****>proc: rowMatrices */ /* rowMatrices( mxlist) mxlist = [M1, ..., Mn], M1 =matrix(a, b1), ..., Mn = matrix(a,bn) => M = matrix(a,b1+...+bn) */ rowMatrices( mxlist ) := block( [x, n, rown, coln, M], n : length(mxlist), x : matrix_size(mxlist[1]), rown : x[1], M : mxlist[1], for i:2 thru n do ( x : matrix_size(mxlist[i]), if x[1]# rown then ( error("rowMatrices: all the component matrices should have the same number of rows") ), coln : x[2], M : apply(addcol, cons(M, makelist( col(mxlist[i],j), j, 1, coln) ) ) ), /*end do*/ return (M) )$ /*end proc: rowMatrices */ /****>proc: submatrix1 */ /* submatrix1( rowrange, M, colrange ) => M1 : submatrix of M rowrange = [i_1, i_p], colrange = [j_1, j_q] M1 = Matrix(p,q) */ submatrix1 (rowrange, M, colrange) := block ( [m, n, rowl, coll, p, q, M1], [m, n] : matrix_size(M), rowl: makelist( i, i, rowrange[1], rowrange[2]), coll: makelist( i, i, colrange[1], colrange[2]), p : length(rowl), q : length(coll), M1 : zeromatrix(p,q), for i : 1 thru p do ( for j:1 thru q do ( M1[i,j] : M[rowl[i], coll[j]] ) /*end do*/ ), /*end do*/ return (copy(M1)) )$ /*end proc: submatrix1 */ /****>proc:listme */ /* listme = list_matrix_entries */ listme ( M ) := block( return ( list_matrix_entries (M)) )$ /*end proc: listme */ /*****> Dictionary-type variable and functions */ /*** X :: dict <=> X =[ [[a], [x,...]], ..., [[m], [z,...]] ]: a list of two element lists [tag, value list] */ /****> proc: checkdict */ /* checkdict(X) => true/false */ checkdict(X) := block ([result], if listp(X) then ( result: true, for i:1 thru length(X) do ( x : X[i], if ( (not listp(x)) or (length(x) #2) or (not listp(x[1])) or (not listp(x[2])) ) then ( display(x), result: [i, false], break ) /*end if*/ ) /*end do*/ ) else ( result : [0, false] ), /*end if*/ return (result) )$ /*end proc: checkdict*/ /****> proc: searchdict */ /* searchdict( X::dict, [tag], p) => true : p[1] =[i, [[tag], value]] /false: p[1]=[] p becomes a global array var i = position index in the list X */ searchdict (X, a, p) := block( [found], apply(remarray, [p]), arraysetapply(p, [1], []), found : false, for i:1 thru length(X) do ( if X[i][1]=a then ( found : true, arraysetapply(p, [1] , [i, [a, X[i][2]]]), break ) /*end if*/ ), return (found) )$ /*end proc: searchdict */ /****> proc: dicttaglist */ /* dicttaglist(X::dict) => output = [ a, b, ,...] for X=[[a,x], [b,y], ... */ dicttaglist (X ) := block([tags], tags : [], for x in X do ( tags : append(tags, [x[1]]) ), /*end do*/ return (copy(tags)) )$ /*end proc: dicttaglist*/ /****> proc: showdict */ /* showdict( X::dict [, opt]) => output=[ a=x, c=u, ...] opt = all / tag list [a, c, ..] */ showdict (X, [opt]) := block( [range,outlist, y], if ( length(opt)=0 or opt[1] = all ) then ( outlist: [], for x in X do ( outlist: endcons(x[1]=x[2], outlist) ) /*end do*/ ) elseif ( listp(opt[1]) ) then ( outlist: [], for a in opt[1] do ( if searchdict(X, a, y) then ( /* searchdict => y[1]= [ i, [a, x]] */ outlist : endcons( a= y[1][2][2], outlist), remarray(y) ) /*end if*/ ) /*end do*/ ), /*end if*/ return( copy(outlist) ) )$ /*end proc: showdict */ /****>proc: getdict */ /* getdict(X, a) => x if [a,x] is in X , false otherwise */ getdict(X, a) := block( [result], local(result), if searchdict(X, a, result) then ( return ( copy(result[1][2][2])) ) else ( return ([]) ) /*end if */ )$ /*end proc: getdict */ /****>proc: rmvdict */ /* rmvdict(X, data) => X ->new dict: X -data */ rmvdict(X, data) := block([X1, p, newdata, x], local(p), X1:copy(X), if searchdict(X1, data[1], p) then ( newdata: [], for x in p[1][2][2] do ( if not member (x, data[2]) then newdata : append(newdata, [x]) ) /*end if*/ ), /*end do*/ if length(newdata)>0 then ( X1[p[1][1]] : [data[1], newdata] ) else ( X1 : append(slist(X1, 1, p[1][1]-1), slist(X1, p[1][1]+1, length(X1)) ) /*end if*/ ), /*end if*/ return (copy(X1)) )$ /*end proc: rmvdict*/ /****> proc: adddict */ /* adddict(X, data) => X -> new dict: X + data; data = [ tag, contents list] */ adddict (X, data) := block ([p, X1, tmp],local(p), X1: copy(X), if searchdict(X1, data[1], p) then ( tmp : append( X1[p[1][1]][2] , data[2]), /* X1[p[1][1]] : [ data[1], listify(setify(tmp))] */ X1[p[1][1]] : [ data[1], tmp] ) else ( X1 : append(X1, [data]) ), /*end if*/ return (copy(X1)) )$ /*end proc: adddict*/ /****> proc: addsdict */ /* addssdict(X, datalist) => X -> new dict: X + datalist */ addsdict (X, datalist) := block ([p, X1], X1:copy(X), for x in datalist do ( X1 : adddict(X1, x) ), /*end do*/ return (copy(X1)) )$ /*end proc: addsdict*/ /****>proc: repldict */ /* repldict(X, data) => X[data[1]] => data */ repldict(X, data) := block ([X1, p], if searchdict(X, data[1], p) then ( X1: rmvdict(X, X[p[1][1]]), X1: adddict(X1, data) ) else ( X1: adddict(X, data) ), /*end if*/ return (copy(X1)) )$ /*end proc: repldict*/ /*****> Dynkin type procs */ /****> proc:resolvedt0 */ /* resolvedt0(dt): dt=Xr => ["X", r]: X=A/B/C/D/E/F/G, r=0,1,... */ dt : 'dt$ resolvedt0(dt,[opt]) := block( [X,t, r, n,len,i], if listp(dt) then ( if ( length(dt)=2 and stringp(dt[1]) and integerp(dt[2]) and dt[2]>=0 and member(dt[1],["A","B","C","D","E","F","G"]) ) then ( return (dt) ) else ( error("Usage: dt=Xr or dt::list=[\"X\", r]: X=A/B/C/D/E/F/G, r=0,1,...") ) ) else ( if not stringp(dt) then ( dt : string(dt) ), X : substring(dt,1, 2), len : slength(dt), r : 0, for i : 2 thru len do ( r : 10*r + cint(substring(dt,i,i+1))-cint("0") ), if ( member(X,["A","B","C","D","E","F","G"]) and r>=0) then ( return ([X,r]) ) else ( error("Usage: dt=Xr or dt::list=['X', r]: X=A/B/C/D/E/F/G, r=0,1,...") ) ) )$ /* end func: resolvedt0 */ /****> proc:resolvedt */ /* resolvedt(dt): dt=Xr[i] => ["X",r,i] */ resolvedt(dt, [opt]) :=block ( [dt0], if listp(dt) then ( if length(dt)=2 then ( return ( resolvedt0( dt ) ) ) elseif length(dt)>=3 then ( return ( endcons(dt[3], resolvedt0(slist(dt, 1, 2)))) ) else ( error(printf(false, "~a : Invalid Dynkin type notation", dt)) ) ) elseif subvarp(dt) then ( return ( append(resolvedt0(op(dt)), args(dt))) ) else ( return (resolvedt0(dt)) ) )$ /* end of proc: resolvedt */ /****> proc:abbrevdt0 */ /* abbrevdt0(dt): dt=["X",r]=>Xr */ abbrevdt0 (dt,[opt]) := block( [t, n], if (listp(dt) and length(dt)=2) then ( if (member(dt[1],["A","B","C","D","E","F","G"]) and nonnegintegerp(dt[2] ) ) then ( return ( eval_string(concat(dt[1],dt[2])) ) ) ) elseif ( stringp(dt) or symbolp(dt) ) then ( if stringp(dt) then ( dt1 : dt, dt : eval_string(dt) ) else ( dt1 : string(dt) ) , t : substring(dt1,1,2), printf(true,"dt = ~a, dt1 = ~s ", dt, dt1), n : eval_string(substring(dt1,2)), printf(true,"t = ~s, n = ~d", t , n), if (member(t, ["A","B","C","D","E","F","G"]) and nonnegintegerp(n) ) then ( return ( dt ) ) ), error("Invalid Dynkin type as the list representation") )$ /* end of proc: abbrevdt0 */ /****> proc:abbrevdt */ /* abbrevdt(dt0): dt0=["X",r,i] => Xr[i] */ abbrevdt (dt0) := block ( [dt], if not listp(dt0) then ( if stringp(dt0) then ( dt : eval_string(dt0) ) else ( dt : dt0 ), return ( dt ) ) else ( if length(dt0)<2 then ( error("Usage: abbrevdt([\"X\",r[,i]])") ), dt : abbrevdt0([dt0[1],dt0[2]]), if length(dt0)=2 then ( return (dt) ) else ( return (dt[dt0[3]]) ) ) )$ /* end of proc: abbrevdt */ /*****>Root related proc */ /****>proc:SimpleRootsbyH */ /* SimpleRootsbyH(dt) */ /* dt=[t,n] => Matrix A[i,j]: A_{ij}=alpha_j(h_i): */ /* h_j: the canonical basis of the Cartan subalgebra for the algebra embedding f: H' -> H, f(h_i')=B_i^j h_j, f^{-1}(alpha_j)=alpha'_i M^i_j; M=(A')^^(-1) B A dt[1]="A/B/C/D": */ SimpleRootsbyH(dt) := block ( [t, rn, AM], dt : resolvedt(dt), t : dt[1], rn : dt[2], if not member(t,{"A","B","C","D","E","F","G"}) then ( error("Dynkin type should be in [A,B,C,D,E,F,G]") ), if member(t,{"G","F","E"}) then ( AM : ident (rn) ) else ( AM : ident (rn), for i : 1 thru rn-1 do ( AM[i,i+1] : -1 ) ), if t="A" then ( for i : 1 thru rn do ( AM[rn,i] : AM[rn,i]+1 ) ) elseif t="C" then ( AM[rn,rn] : 2 ) elseif t="D" then ( AM[rn,rn-1] : 1 ), return (transpose(AM)) )$ /* end of proc: SimpleRootsbyH */ /****> proc:Kmetric */ /* Kmetric(dt) => KM::Matrix dt=Tn (Dynkin class): T=A,B,C,D,E,F,G; n=rank KM = Killing metric in the root space KM[i,j]=gamma_{ij} wrt the simple root basis A constant rescaling of KM[i,j] does not affect the final results. */ Kmetric(dt) := block ( [t,n, KM], dt : resolvedt(dt), t : dt[1], n : dt[2], KM : zeromatrix(n,n), /* KM must be a symmetric matrix */ if ( t="D" and n=2) then ( KM : 2*ident(2) ) elseif ( t="A" or (t="B" and n=1) or (t="C" and n=1) ) then ( for i : 1 thru n-1 do ( KM[i,i] : 2, KM[i,i+1] : -1, KM[i+1,i] : -1 ), KM[n,n] : 2 ) elseif ( t="B") then ( for i : 1 thru n-1 do ( KM[i,i] : 2, KM[i,i+1] : -1, KM[i+1,i] : -1 ), KM[n,n] : 1 ) elseif ( t="C" ) then ( for i : 1 thru n-2 do ( KM[i,i] : 1, KM[i,i+1] : -1/2, KM[i+1,i] : -1/2 ), KM[n-1,n-1] : 1, KM[n-1,n] : -1, KM[n,n-1] : -1, KM[n,n] : 2 ) elseif ( t="D" and n>=3) then ( for i : 1 thru n-2 do ( KM[i,i] : 2, KM[i,i+1] : -1, KM[i+1,i] : -1 ), KM[n-1,n-1] : 2, KM[n,n] : 2, KM[n-2,n] : -1, KM[n,n-2] : -1 ) elseif ( t="G" and n=2) then ( KM[1,1] : 3, KM[1,2] : -3/2, KM[2,1] : -3/2, KM[2,2] : 1 ) elseif ( t="F" and n=4) then ( KM[1,1] : 2, KM[1,2] : -1, KM[2,1]: -1, KM[2,2] : 2, KM[2,3] : -1, KM[3,2] : -1, KM[3,3] : 1, KM[3,4] : -1/2, KM[4,3] : -1/2, KM[4,4] : 1 ) elseif ( t="E" and n>=6 and n<=8) then ( for i : 1 thru n-2 do ( KM[i,i] : 2, KM[i,i+1] : -1, KM[i+1,i] : -1 ), KM[n-1,n-1] : 2, KM[n,n] : 2, KM[3,n] : -1, KM[n,3] : -1 ) else ( error("No such simple group") ), return (KM) )$ /* end of proc: Kmetric */ /****> proc:Cmatrix */ /* Cmatrix(dt) => C: Cartan matrix dt=tn: t=type(A,B,C,D,E,F,G), n=rank Cartan matrix C[i,j] */ Cmatrix(dt) := block( [t, n, KM, CM], local(CM), dt : resolvedt(dt), t : dt[1], n : dt[2], KM : Kmetric(dt), CM : zeromatrix(n,n), for i : 1 thru n do ( for j : 1 thru n do ( CM[i,j] : 2*KM[i,j]/KM[j,j] ) ), return (copy(CM)) )$ /* end of proc: Cmatrix */ /****> proc:Gmetric */ /* Gmetric(dt) => G_{ij}: metric in the Dynkin basis */ Gmetric(dt) := block( dt : resolvedt(dt), return ( Cmatrix(dt)^^(-1) . Kmetric(dt) . transpose(Cmatrix(dt)^^(-1)) ) )$ /****> proc:IPDB */ /* IPDB( dl1, dl2, dt) => the inner product (dl1,dl2) wrt Dynkin basis */ IPDB(dl1,dl2, dt) := block( dt : resolvedt(dt), return (transpose(covect(dl1)) . Gmetric(dt) . covect(dl2)) )$ /* end of proc: IPDB */ /****> proc:RIP */ /* RIP(r1,r2,dt) # r1,r2::list = root vectors, dt=Dynkin type =[t,n] Killing inner product for roots */ RIP(r1, r2, dt) := block([KM, v1, v2,m], dt : resolvedt(dt), KM : Kmetric(dt), v1 : covect(r1), v2 : covect(r2), m : (transpose(v2) . KM . v1), return( m[1,1]) )$ /* end of proc: RIP */ /****> proc:RCP */ /* RCP(r1,r2,dt) # r1,r2::list = root vectors, dt=Dynkin type =[t,n] Cartan product for roots: 2 (r1,r2)/(r2,r2) */ RCP(r1, r2, dt) := block( dt : resolvedt(dt), return ( 2*RIP(r1,r2,dt)/RIP(r2,r2,dt) ) )$ /*end of proc: RCP */ /****> proc:HighestRoot */ /* HighestRoot(dt) highest root::list (in the simple root basis) dt=(t,n): t=Lie algebra type, n=rank */ HighestRoot (dt) := block([ t, n, i, hr,CM,CMI], local(CM, CM1), dt : resolvedt(dt), [t, n] : dt, CM : Cmatrix(dt), CMI : CM^^(-1), if ( t="A" or (t="B" and n=1) or (t="C" and n=1) /*or (t="D" and n<=3)*/ ) then ( hr : makelist ( CMI[1,i]+CMI[n,i], i, 1, n) ) elseif ( t="B") then ( hr : makelist ( CMI[2,i], i, 1, n), if n=2 then ( hr : 2*hr ) ) elseif ( t="C") then ( hr : makelist( 2*CMI[1,i], i, 1, n) ) elseif ( t="D" and n>=3 ) then ( if n=3 then ( hr : makelist( CMI[2,i]+CMI[3,i], i, 1, n) ) else ( hr : makelist( CMI[2,i], i, 1, n) ) ) elseif (t="G" and n=2 ) then ( hr : makelist( CMI[1,i], i, 1, n) ) elseif ( t="F" and n=4 ) then ( hr : makelist( CMI[1,i], i, 1, n) ) elseif ( t="E" and n>=6 and n<=8 ) then ( if n=6 then ( hr : makelist( CMI[6,i], i. 1, n) ) elseif ( n=7 ) then ( hr : makelist ( CMI[1,i], i, 1, n) ) else ( hr : makelist(CMI[7,i], i, 1, n) ) ) else ( error("No such simple group") ), return (hr) )$ /* end of proc: HighestRoot */ /****> proc:sumlist */ /* sumlist( w ) # w::list=root vector in the SRB => level height */ sumlist(w) := block( return (apply("+", w)) )$ /* end of proc: sumlist */ /*****> proc:RootSystem */ /****>proc: copydict */ /* copydict(A,B) => dictタイプのhashed array AのコピーをBという名前で生成。Bはarraysにglobalに登録される。 */ copydict(A, B) := block([fields, data, n], fields : apply(arrayinfo, [A]), n: length(fields)-2, fields : makelist(fields[i],i, 3, n+2), data : apply(listarray, [A]), apply(remarray,[B]), for i : 1 thru n do ( arraysetapply(B, [fields[i][1]], data[i]) ) )$ /****> proc:RootSystem0 */ /* RootSystem0(dt[, prj]) => Root system RS for the Dynkin type dt dt=[t,nr]: t=Dynkin type, nr=rank, prj=output style (1/0) RS =新たに生成されるRoot system dictの名前 */ RootSystem0(dt, [opt]) := block( [ t, nr, prj, hrv, hl, bv, RootSys, rtv1, rtv2, p, q, pmq, dim], RootSys:[], /* RootSys = list-type dict */ dt : resolvedt(dt), [t, nr] : dt, if length(opt)>0 then ( prj : opt[1] ) else ( prj : 0 ), hrv : HighestRoot(dt), hl : sum(hrv[i], i, 1, nr), RootSys : adddict(RootSys, [[hl], [hrv]] ), if prj>0 then ( print(hl=getdict(RootSys,[hl])) ), dim : 1, for l : hl-1 thru 1 step -1 do ( for rtv in getdict(RootSys, [l+1]) do ( for i : 1 thru nr do ( bv : makelist(0, j, 1, nr), bv[i] : 1, pmq : RCP(rtv, bv, dt ), q : 0, rtv1 : copy(rtv), rtv1[i] : rtv1[i]+1, rtv2 : copy(rtv), rtv2[i] : rtv2[i]-1, if not member(rtv2, getdict(RootSys,[l])) then ( for l1 : l+1 thru hl do ( if member(rtv1,getdict(RootSys,[l1])) then ( rtv1[i] : rtv1[i]+1, q : q+1 ) ), p : q+pmq, if p>0 then ( RootSys : adddict(RootSys, [ [l], [rtv2] ]) ) ) /*end if*/ ) /*end do*/ ), /*end do*/ RootSys : repldict(RootSys, [ [l], sort(getdict(RootSys, [l])) ] ), dim : dim+length(getdict(RootSys,[l]) ), if prj>0 then ( print( l=getdict(RootSys,[l]) ) ) /*end if*/ ), /*end do*/ if prj>0 then ( printf(true, "dimension = ~d", 2*dim+nr) ), /*end if*/ RootSys : addsdict(RootSys,[ [["type"], [abbrevdt(dt)]], [["dim"], [2*dim+nr]], [["hl"], [hl]] ]), return(copy(RootSys)) )$ /* end of proc: RootSystem0 */ /****> proc:SRBtoDB */ /* SRBtoDB( srwv, dt) */ /* srwv= weight vector in the simple root basis, dt: Dynkin type=Ar, ... or ["A",r],.. */ SRBtoDB( wv, dt) := block( [CM,nr], local(CM), dt : resolvedt(dt), nr : dt[2], CM : Cmatrix(dt), return ( makelist( sum( wv[j]*CM[j,i], j, 1, nr), i, 1, nr)) )$ /* end of proc: SRBtoDB */ /****> proc:DBtoSRB */ /* DBtoSRB( dwv, dt) */ /* dwv= weight vector in the Dynkin basis, dt: Dynkin type=Ar, ... or ["A",r],.. */ DBtoSRB(wv, dt) := block( [CMIT,nr], dt : resolvedt(dt), nr : dt[2], CMIT : transpose(Cmatrix(dt)^^(-1)), return (list_matrix_entries ( CMIT . covect(wv))) )$ /* end of proc: DBtoSRB */ /****> proc:RootSystem */ /* RootSystem(dt [,basis,prn]) => RSdict: Root system in the Dynkin basis dt=Dynkin type, prn=output control flag, baiss="S" or "D" */ RootSystem(dt, [opt]) := block([ prn, BT, t,n, hl, output,u, RSS, RDS, RSdict], /* RDS = dictlist for a root system in the Dynkin basis */ /* RSS = dictlist for a root system in the simple root basis */ dt : resolvedt(dt), [t, n] : dt, BT : "S", if length(opt)>0 then ( BT : opt[1] ), prn : 0, if length(opt)>=2 then ( prn : opt[2] ), if BT="D" then ( RSS : RootSystem0(dt), hl : getdict(RSS, ["hl"])[1], RDS : [], for i : hl thru 1 step -1 do ( RDS : adddict( RDS, [ [i], map(lambda ([u], SRBtoDB(u, dt)), getdict(RSS,[i])) ] ), if prn>0 then ( print(i= getdict(RDS, [i])) ) ), RDS : addsdict(RDS, [ [["hl"] , getdict(RSS,[" hl"])], [["dim"], getdict(RSS, ["dim"])], [["type"] , getdict(RSS,["type"])] ]), if prn>0 then ( print("dimension"=getdict(RDS,["dim"][1])) ), RSdict : RDS ) else ( RSdict : RootSystem0(dt, prn) ), return (copy(RSdict)) )$ /* end of proc: RootSystem */ /*********************************************************/ /*****>Str Constin for the Weyl Basis */ /****>proc:isposlist */ /* isposlist(x) => true if x>0, false othewise x: list of number x>0 <=> x_1>=0 ... x_n>=0 & x#[0,...,0] */ isposlist(x) := block( [ /*list*/ zerolist, /*misc*/ flag ], x : ev(x, eval), if not listp(x) then ( return (false) ), /*end if*/ zerolist: makelist(0, i, 1, length(x)), if x=zerolist then ( return (false) ) else ( flag: true, for i: 1 thru length(x) do ( if x[i]<0 then ( flag : false, break ) /*end if*/ ), /*end do*/ return (flag) ) /*end if*/ )$ /*end proc: isposlist */ /****>proc:BianchiID */ /* BianchiID(x,y,z, NNtable) => [[Ex,Ey],Ez]+[[Ey,Ez],Ex]+[[Ez,Ex],Ey] /E_x+y+z x, y, z = list: root vectors indexing the Weyl basis dt = Dynkin type NNtable = dict( ["StrConst"]=NN , ["RootSet"]=a list of root vectors), NN = dict( [x, y] -> NN[x,y]: Weyl coefficient: [E_x,E_y=NN[x.y] E_(x+y) */ BianchiID(x, y, z, NNtable) := block( [/* scalar */ w, /* list */ zeroroot, RootSet, /* dict */ NN /* <- NNtable */ /* misc */ ], x: ev(x, eval), y: ev(y, eval), z: ev(z, eval), NN: getdict(NNtable, ["StrConst"]), RootSet: getdict(NNtable,["RootSet"]), zeroroot: 0*RootSet[1], if member((x+y+z),RootSet) then ( w:0, if member( x+y,RootSet) then ( w: w + getdict(NN,[x,y])[1]*getdict(NN,[x+y,z])[1] ) elseif x+y=zeroroot then ( w: w+inprod( getdict(NN,[x,y]), z) ), /*end if*/ if member( y+z, RootSet) then ( w: w + getdict(NN,[y,z])[1]*getdict(NN,[y+z,x])[1] ) elseif y+z =zeroroot then ( w: w+inprod(getdict(NN,[y,z]),x) ), /*end if*/ if member(z+x, RootSet) then ( w: w + getdict(NN,[z,x])[1]*getdict(NN,[z+x,y])[1] ) elseif z+x=zeroroot then ( w: w + inprod(getdict(NN,[z,x]),y) ), /*end if*/ /* if op(w)#"+" then ( print("single term,", [x,y,z]) ), /*end if*/ */ return (w) ) else ( return (0) ) /*end if*/ )$ /*end proc: */ /****>proc:StrConstWB0 */ /* StrConstWB0(alpha,beta, dt[,RootSet]) => N2=NN(alpha,beta)^2 [E_alpha,E_beta]=NN(alpha,beta)E_(alpha+beta) */ StrConstWB0( x, y, dt, [opt]) := block( [/*scalar*/ hl, q, p, N2, /*list*/ zerolist, RootSet, /*dict*/ RootSys /*misc*/ ], /** Set parameters **/ if not listp(x) or not listp(y) then ( error("Usage: StrConstWB0(x::list, y::list], dt::DynkinType[, RootSet)") ), /*end if*/ dt:resolvedt(dt), rank : dt[2], zerolist: makelist(0, i, 1, rank), if x+y = zerolist then ( error("StrConstWB0(alpha,beta, dt): alpha+beta # 0") ), /*end if*/ if length(opt)>0 then ( RootSet: opt[1] ) else ( RootSys: RootSystem0(dt), hl: getdict( RootSys, ["hl"])[1], RootSet:[], for el : 1 thru hl do ( RootSet: append(RootSet, getdict(RootSys,[el]), (-1)*getdict(RootSys,[el]) ) ) /*end do*/ ) , /*end if*/ RootSet: sort(RootSet, ordergreatp), /*print("Calculating NN"),*/ /** Calculate NN **/ q:0, while member( (y+(q+1)*x), RootSet) do ( q: q+1 ), /*end do*/ p:0, while member( (y-(p+1)*x), RootSet) do ( p: p+1 ), /*end do*/ N2: 1/2*q*(p+1)*RIP(x, x, dt), /*=StrConst^2 */ return (N2) )$ /*end proc: */ /****>proc:StrConstWB */ /* StrConstWB( dt[,sw]) => NNtable ::dict dt = Dynkin type, sw = no effect NNtable = dict : ["RootSet"]=the list of dt root system, ["StrConst"]= NN: dict( [x, y] ->[ N[x,y]]) : Weyl Basic CCR coeff. */ StrConstWB(dt, [opt]) := block( [/*scalar*/ sw, hl, sgn,epsilon , sgnidx,N2, n, p, q, w, /*list*/ RootSet, zeroroot, z, Hvec, eqs, unvalset, eqs1, eqs2, sol, sol1, sgnlist, nvarlist, /*dict*/ RootSys, NN, NNtable0,NNtable, /*misc*/ sgnsol, sgnsol1, x ], RootSys : [], NN: [], NNtable:[], NNtable0:[], dt:resolvedt(dt), sw:0, if length(opt)>0 then ( sw: opt[1] /* message control switch */ ) , /*end if*/ /** construct root system of the Dynkin type dt **/ RootSys: RootSystem0(dt), hl: getdict(RootSys, ["hl"])[1], RootSet:[], for el: 1 thru hl do ( RootSet: append(RootSet, getdict(RootSys,[el]), (-1)*getdict(RootSys,[el]) ) ), /*end do*/ RootSet : sort(RootSet, ordergreatp), /*print("RootSet"=RootSet); */ /** construct structure constant table NN **/ n: length(RootSet), sgn: 'sgn, sgnidx: 0, for i :1 thru n/2 do ( x: RootSet[i], for j: i+1 thru n-i+1 do ( y : RootSet[j], if y=(-1)*x then ( Hvec: listme( Kmetric(dt).covect(x)), NN: adddict(NN, [[x,-x], Hvec ] ), NN: adddict(NN,[[-x,x], -Hvec ]) ) else ( N2: StrConstWB0( x, y, dt, RootSet), if N2>0 then ( sgnidx: sgnidx+1, w: sqrt(N2)*sgn[sgnidx] ) else ( w:0 ), /*end if*/ NN: repldict(NN, [[x,y], [w]] ), NN: repldict(NN, [[y,x], [-w]] ), NN: repldict(NN, [[-x,-y], [-w]] ), NN: repldict(NN, [[-y,-x], [w]] ) /* , if sw>0 and w#0 then ( disp(printf(false, "NN[~a,~a]=~a~%", x,y, getdict(NN, [x,y]) )) ) /*end if*/ */ ) /*end if*/ ) /*end do: j */ ), /*end do: i */ for x in RootSet do ( for y in RootSet do ( if getdict(NN, [x,y])=[] then ( NN: adddict( NN, [[x,y],[0]]) ) /*end if*/ ) /*end do*/ ), /*end do*/ NNtable0: adddict(NNtable0, [["StrConst"], NN ]), NNtable0: adddict(NNtable0, [["RootSystem"], RootSys]), NNtable0: adddict(NNtable0, [["RootSet"], RootSet]), print("StrConstWB: NN dict is completed"), /** determine signs epsilon[*] of the str. consts **/ zeroroot: 0*RootSet[1], /*sgn[1]:1,*/ eqs:{}, for i: 1 thru n-2 do ( for j: i+1 thru n-1 do ( for k: j+1 thru n do ( w: BianchiID(RootSet[i], RootSet[j], RootSet[k], NNtable0), if w#0 then ( eqs: adjoin(w, eqs) ) /*end if*/ ) /*end do*/ ) /*end do*/ ), /*end do*/ eqs: listify(eqs), eqs : ev(eqs, sgn[1]=1), print("StrconstWB: determining sgn[i]'s"), sgnlist : makelist(sgn[i],i , 1, sgnidx), sgnsol: [sgn[1]=1], unvarset : slist(sgnlist, 2, sgnidx), for i:1 thru sgnidx while length(unvarset)>0 do ( eqs1: [], eqs2: [], x : 'x, svr : makelist( y=x, y, unvarset), for eq in eqs do ( tmp:apply(ev, append([eq], svr)), if tmp#0 and hipow(tmp, x)<2 then ( eqs1: endcons( eq, eqs1) ) elseif tmp#0 then ( eqs2: endcons(eq, eqs2) ) /*end if*/ ), /*end do*/ if length(eqs1)>0 then ( linsolve_params: false, sol : linsolve(eqs1, unvarset) ) else ( sol: [ unvarset[1]=1] ), /*end if*/ sol1: copy(sol), sol: [], for s in sol1 do ( if args(s)[1]#args(s)[2] then ( sol: endcons(s, sol) ) /*end if*/ ), /*end do*/ eqs: map(lambda([z], apply(ev,append([z],sol))),eqs2), eqs : sublist( eqs, lambda([z], z#0)), if length(eqs)>0 then ( eqs2: slist(eqs, 2, length(eqs)), eqs: [eqs[1]], for eq in eqs2 do ( indep: true, for eq1 in eqs do ( if numberp(eq/eq1) then ( indep: faslse, break ) /*end if*/ ), /*end do*/ if indep then ( eqs: endcons( eq, eqs) ) /*end if*/ ) /*end do*/ ), /*end if*/ sgnsol: append(sgnsol, sol), nvarlist: map(lambda([z], args(z)[1]), sgnsol), unvarset : listify( setdifference(setify(sgnlist), setify(nvarlist))) ), /*end do*/ /*display(sgnsol),*/ NNtable : apply(ev, append([NNtable0], sgnsol)), return (copy(NNtable)) )$ /*end proc: */ /****>proc:printStrConst */ /* printStrConst(NNtable,sw) => show the list of non-vanishing SC sw#0 => show the result to the monitor */ printStrConst(NNtable,[opt]):= block( [/*scalar*/ sw,n, /*string*/ ccrstring, /*list*/ zeroroot, RootSet, CRlist, x, y, z, /*dict*/ NN, /*misc*/ E, H, c ], E:'E, H:'H, sw:0, if length(opt)>0 then ( sw:opt[1] ), /*end if*/ NN: getdict(NNtable, ["StrConst"]), RootSet: getdict(NNtable,["RootSet"]), zeroroot: 0*RootSet[1], n: length(RootSet), if sw#0 then ( disp("Non-vanishing CCR of the Weyl basis") ), /*end if*/ CRlist: [], for i : 1 thru n-1 do ( for j: i+1 thru n do ( x:RootSet[i], y:RootSet[j], c: getdict(NN, [x,y]), z: x+y, if z=zeroroot then ( ccrstring : printf(false, "[E~a, E~a]=~a", x, y, sum(c[k]*H[k],k, 1, length(zeroroot))) ) elseif listp(c) and length(c)=1 and c[1]#0 then ( ccrstring: printf(false, "[E~a, E~a]=~a~a", x, y, c[1]*E, z) ) else ( ccrstring:"" ), /*end if*/ if ccrstring#"" then ( CRlist: append( CRlist,[ccrstring] ), if sw#0 then ( stringdisp:false, disp(ccrstring), stringdisp:true ) /*end if*/ ) /*end if*/ ) /*end do*/ ), /*end do*/ return ( copy(CRlist)) )$ /*end proc: */ /*********************************************************/ /*****>proc:WeylTrf */ /* WeylTrf(dt, rv[, wt]) => Weyl trf matrix wrt the root vector rv dt=Dynkin type, rv=root vector ::list, wt="S"(default) or "D" */ WeylTrf(dt, rv, [opt]) := block( [ /*scalar*/ wt, rank, IDM, /* list */ alpha, /* matrix */ WT ], dt: resolvedt(dt), rank: dt[2], if length(rv)# rank then ( error("The lenght of the root vector should be the same as the rank") ), /*end if*/ wt: "S", if length(opt)>0 then ( wt: opt[1] ), /*end if*/ /* unit basis vectors alpha[i] */ alpha : [], for i: 1 thru rank do ( alpha: append(alpha, [ append(makelist(0,j,1,(i-1)),[1],makelist(0,k,1,(rank-i)))]) ), /*end do*/ IDM: ident(rank), WT: IDM - covect(rv).matrix(makelist( RCP(alpha[i],rv,dt), i, 1, rank)), if wt="D" then ( WT: transpose(Cmatrix(dt)).WT.transpose(Cmatrix(dt)^^(-1)) ), /*end if*/ return (copy(WT)) )$ /*end proc, WeylTrf */ /*****> WeightSystem */ /****> proc:WeightSystem */ /* WeightSystem(dt,hdw [,basis, sw]) => output =Weight system listdict or weight list hdw=hight weight in the Dynkin basis dt=[t,nr], t:Dynkin type =A,B,C,D,E,F,G basis="D"(Dynkin) or "S"(Simple Root) sw= 0 (no message) 1 (with message) 2 (output only weight list) */ /* output : listdict with tags = [["DWS" / "SWS"] , ["dim"], ["hl"], ["dt"], ["hdw"]] output["dim"] = the dimension of the irrep, output["hl"] = the highest level of the irrep, output["dt"] = the Dynkin type Xr output["hdw"] = the highest Dynkin weight of the irrep. output["DWS"] = a listdict with tags =[[hl], [hl-1],..., [-hl]] output["DWS"][h]= [[m, dwv], ....] : a list of the pairs [multiplicity, Dynkin weigt vector] with the level h */ WeightSystem(dt, hdw, [opt]) := block( [t, sw, basis, nr, CM, CMI, hwv, hl, SWS, SWS0, WL, WS, WSdict, RS, wtv, wtv1, wtv2, p, q, pmq, dim, alpha, wtd, wtd1, DWS, DWS0, wnum, dw, k, ml, u, x, uwv, n,nl, rv, l, ghl, prt, kmax], local(CM, CMI, SWS, SWS0, DWS, DWS0, WL, WS, wnum, alpha), /* SWS =a listdict of weight vectors in the simple root basis */ /* DWS =a listdict of weight vectors in the Dykin basis */ /* [ [ [h], [[ m, wv], ...]], .... ] */ /***> parameters */ dt : resolvedt(dt), [t, nr] : dt, if length(hdw) # nr then ( error("The weight vector does not match the rank") ), /*end if:*/ basis : "D", if length(opt)>0 then ( basis : opt[1] ), /*end if*/ sw : 0, if length(opt)>1 then ( sw : opt[2] ), /*end if*/ CM : Cmatrix(dt), CMIT : transpose(CM^^(-1)), hwv : list_matrix_entries( CMIT. covect(hdw) ), /* if ( dt[1]="B" and nr=2 and hdw=[0,1]) then ( hwv : 2*hwv ), /*end if*/ */ /***>SWS & DWS */ /* Construction of weight vector lists SWS & DWS */ hl : sumlist(hwv), SWS : [ [[hl], [hwv]] ], DWS : [ [[hl], [hdw]] ], for l : hl-1 thru -hl step -1 do ( /* SWS : adddict(SWS, [ [l], [] ]), DWS : adddict( DWS, [ [l], [] ]), */ for wtv in getdict(SWS, [l+1]) do ( for i : 1 thru nr do ( alpha : makelist(0, j, 1, nr), alpha[i] : 1, /* i-th simple root */ pmq : RCP(wtv, alpha, dt), wtv1 : wtv + alpha, wtv2 : wtv - alpha, if not member(wtv2, getdict(SWS, [l])) then ( q : 0, for l1 : l+2 thru hl do ( if member(wtv1, getdict(SWS, [l1]) ) then ( q : q+1, wtv1 : wtv1 + alpha ) /*end if*/ ), /*end do*/ p : q+pmq, if p>0 then ( SWS : adddict(SWS, [ [l], [wtv2]] ), dw : makelist( sum( wtv2[k]*CM[k,j], k, 1, nr), j, 1, nr), DWS : adddict(DWS, [ [l], [dw] ]) ) /* end if */ ) /*end if*/ ) /*end do */ ) /* end do */ /* if basis ="D" then print(l=getdict(DWS, [l])) else print(l=getdict(SWS,[l])) */ ), /* end do */ /***> simple weight list output */ if sw=2 then ( WL : [], for l : hl thru -hl step -1 do ( if basis="D" then ( for x in getdict(DWS,[l]) do ( WL : endcons(x, WL) ) /*end if*/ ) else ( for x in getdict(SWS,[l]) do ( WL : endcons(x, WL) ) /*end do*/ ) /*end if*/ ), /*end do*/ return (copy(WL)) ), /*end if*/ /***> weight multiplicity */ RS : RootSystem0(dt), /* uwv= 1/2 x the sum of all positive root vectors */ ghl : sumlist(HighestRoot(dt)), uwv : makelist(0, i, 1, nr), for l : ghl step -1 while l>0 do ( for rv in getdict(RS,[l]) do ( uwv : uwv+1/2*rv ) /*end do*/ ), /*end do*/ DWS0 : copy( DWS), SWS0 : copy( SWS), DWS : [], SWS : [], /**> Highest level */ DWS : adddict(DWS, [ [hl], [ [1, getdict(DWS0,[hl])[1]] ] ] ), /* add the multiplicity info */ SWS : adddict(SWS, [ [hl], [ [1, getdict(SWS0,[hl])[1]] ] ] ), /* add the multiplicity info */ wnum[hl] : 1, if sw=1 then ( if basis="D" then ( print(hl=getdict(DWS,[hl])[1]) ) else ( print(hl=getdict(SWS,[hl])[1]) ) /*end if*/ ), /*end if*/ /**> Lower levels */ dim : 1, for l : hl-1 thru -hl step -1 do ( wnum[l] : length( getdict(SWS0,[l]) ), /* DWS : adddict( DWS, [ [l] , [] ] ), /* DWS[l] is a list of wnum[l] vectors */ SWS : adddict( SWS, [ [l] , [] ] ), */ for i : 1 thru wnum[l] do ( wtv : getdict(SWS0,[l])[i], x : 0, for l1 : 1 thru ghl do ( for prt in getdict(RS,[l1]) do ( /* for all positive root prt */ kmax : truncate((hl-l)/l1), for k : 1 thru kmax do ( /* for all k st wtv+k*prt in Delta^+ */ nl : memberp( ev(wtv+k*prt), getdict(SWS0,[l+k*l1]) ), /* print("wtv+k*prt=", wtv+k*prt, "SWS0[l+k*l1]=", SWS0[l+k*l1]), */ if listp(nl) and length(nl)>0 then ( n : nl[1], /* print("n=", n), */ x : x+2*getdict(DWS,[l+k*l1])[n][1]*RIP(wtv+k*prt,prt,dt) ) /*end if*/ ) /*end do*/ ) /*end do*/ ), /*end do*/ /* print("x=", x), */ ml : x/(RIP(hwv+uwv, hwv+uwv, dt) - RIP(wtv+uwv, wtv+uwv, dt)), DWS : adddict( DWS, [ [l], [ [ml, getdict(DWS0,[l])[i]] ]] ), SWS : adddict( SWS, [ [l], [ [ml, getdict(SWS0,[l])[i]] ] ] ), dim : dim+ml ), /*end do*/ if sw=1 then ( if basis="D" then ( print(l=getdict(DWS,[l])) ) else ( print(l=getdict(SWS,[l])) ) /*end if*/ ) /*end if*/ ), /*end do*/ WSdict : [ [["dt"] , [abbrevdt(dt)]], [["hdw"], [hdw]], [ ["dim"], [dim]], [["hl"], [hl]] ], if sw>=1 then ( print("dim"=dim, "hl"=hl) ), /*end if*/ if basis="D" then ( WSdict : adddict(WSdict, [ ["DWS"], DWS ] ) ) else ( WSdict : adddict(WSdict, [ ["SWS"], SWS ] ) ), /*end if*/ return (copy(WSdict)) )$ /* end of proc: WeightSystem */ /****> proc:printWS */ /* printWS(WStable) */ printWS (WStable) := block( [ WS, hl], print("dt"=getdict(WStable,["dt"])[1], "hdw"=getdict(WStable,["hdw"])[1]), if (WS :getdict(WStable, ["DWS"])) #[] then ( print("Weight system in the Dynkin basis") ) elseif (WS :getdict(WStable, ["SWS"])) #[] then( print("Weight system in the simple root basis") ) else ( error("The specified file does not contain a weight system info") ), /*end if*/ hl : getdict(WStable, ["hl"])[1], for i : hl thru -hl step -1 do ( print(i=WS[i]) ), /*end do*/ print("dim"=getdict(WStable, ["dim"])[1], "hl"=hl) )$ /* end proc: printWS */ /****> proc:isDominantWeight */ /* isDominantWeight(dw) => true/false */ isDominantWeight (dw) :=block([ans, x], ans : true, for x in dw while ans do ( if x<0 then ( ans : false ) /*end if*/ ), /*end do*/ return ( ans ) )$ /*end proc: Is DominantWeight */ /****> proc:mklattice */ /* mklattice(rn::integer,[n1,n2]) => lattice point list rn = lattice dimensions [n1,n2] = the range of the integer coordinates of lattice points */ mklattice ( rn, rng) := block( [sublattice,newlattice,x ], if ( not listp(rng) or length(rng)<2 or not integerp(rng[1]) or not integerp( rng[2] ) ) then ( error("Usage: mklattice(rn::positive integer, [n1::integer,n2::integer])") ), /*end if*/ if rn=1 then ( newlattice : makelist( [i], i, rng[1], rng[2]) ) else ( sublattice : mklattice(rn-1,rng), newlattice : [], for x in sublattice do ( newlattice: append( newlattice, makelist( endcons(i, x), i, rng[1], rng[2])) ) /*end do*/ ), /*end if*/ return (newlattice) )$ /* end proc: mklattice */ /****> proc:mklevellattice */ /* mklevellattice(rn::integer>0, level::integer>=0)=> level lattice point set */ mklevellattice (rn, level) := block( [ x,lattice, levellattice], lattice : mklattice(rn,[0,level]), levellattice : [], for x in lattice do ( if sumlist(x)=level then ( levellattice : endcons(x, levellattice) ) /*end if*/ ), /*end do*/ return (levellattice) )$ /* end proc: mklevellattice */ /****> proc:findHighestWeight0 */ /* findHighestWeight0(dw0,dt) => dominant weight list dw0 = a Dynkin weight of the type dt */ findHighestWeight0 (dw0, dt) := block( [rn, rs, SimpleRoots, maxrlevel, found, rlevel, rootlist, dw, dwlist], local(rs), dt : resolvedt(dt), rn : dt[2], remarray(rs), RootSystem(dt, rs, "D"), SimpleRoots : rs[1], found : false, rlevel : 'rlevel, maxrlevel : 10, dwlist : [], for rlevel : 1 thru maxrlevel while not found do ( rootlist : mklevellattice(rn, rlevel), for x in rootlist do ( dw : dw0+sum(x[i]*SimpleRoots[i], i, 1, rn), if isDominantWeight(dw) then ( dwlist : endcons(dw, dwlist), found : true ) /*end if*/ ) /*end do*/ ), /*end do*/ if found then ( return (dwlist) ) else ( print("Not found") ) /*end if*/ )$ /*end proc: findHighestWeight0 */ /****> proc:findHighestWeight */ /* findHighestWeight(dw0,dt) => do (minant weight list */ findHighestWeight(dw0, dt) := block( [rn, w0, level0, SimpleRootDB, CM, maxrlevel, found, rlevel, dw, w, q, qmax, bd] , local(CM), dt : resolvedt(dt), rn : dt[2], w0 : DBtoSRB(dw0, dt), level0 : sumlist(w0), CM : Cmatrix(dt), maxrlevel : 50, rlevel : 1, found : false, w : w0, while (not found and rlevel qmax then ( qmax : q, bd : i ) /*end if*/ ), /*end do*/ rlevel : rlevel+qmax, w[bd] : w[bd]+qmax, if qmax=0 then ( found:true ) /*end if*/ ), /*end do*/ return (SRBtoDB(w,dt)) )$ /*end proc: findHighestWeight */ /****> proc:fullWS */ /* fullWS(WStable) => WStable modified making the Weight System table equipped both with SWS and DWS */ fullWS(WStable) := block( [ WSinfo, flag, SWS, DWS, dt, hl, l, nwv ], local ( DWS), if not checkdict(WStable) then ( error(WStable, " is not defined") ), /*end if*/ if getdict(WStable, ["SWS"])#[] then ( if getdict(WSinfo, ["DWS"])#[] then ( error(WStable, " already contains both SWS and DWS") ) else ( flag : "dws" ) /*end if*/ ) else ( if getdict(WStable, ["DWS"])#[] then ( flag: "sws" ) else ( error(WStable, " contains neither SWS nor DWS") ) /*end if*/ ), /*end if*/ hl : getdict(WStable,["hl"])[1], dt : getdict(WStable,["dt"])[1], if flag = dws then ( SWS : getdict(WStable, ["SWS"]), /* alias of the dict WStable["SWS"] */ DWS : [], /* alias of the dict WStable["DWS"] */ for l : hl thru -hl step -1 do ( DWS : adddict(DWS, [[l], map(lambda([wd], [wd[1], SRBtoDB(wd[2], dt) ]), getdict(SWS, [l])) ]) ), /*end do*/ addd8ct( WStable, [ ["DWS"] , DWS]) ) else ( DWS : getdict(WStable, ["DWS"]), /* alias of the dict WStable["DWS"] */ SWS : [], /* alias of the dict WStable["SWS"] */ for l : hl thru -hl step -1 do ( SWS : adddict(SWS, [[l], map(lambda([wd], [wd[1], DRBtoSRB(wd[2], dt) ]), getdict(DWS, [l]))] ) ), /*end do*/ addd8ct( WStable, [ ["SWS"] , SWS]) ) /*end if*/ )$ /*end proc: */ /*****> Rep. Product Reduction */ /****> proc:ProductOfRep */ /* ProductOfRep( dt, hdw1, hdw2[, prn,basis]) dt=[t,rn] or e.g. A4 hdw1, hdw2 = highest Dynkin weights prn = 0 : no output display (default) >= 1 : show the = 2 : output the composite weight list on the monitor */ ProductOfRep( dt, hdw1, hdw2, [opt]) := block ( [t, nr, prn, basis, hdw, nwv1,nwv2,nwv, hl1,hl2,chl, k, ls,l , l1, l2, wd1, wd2, wd, cw, cm, chl0, ml, ReprList, dim, WStable1, WStable2, DWS1,DWS2,DWS1info, DWS2info, CDWS, CDWSlist, CSWS,IRWStable,IRDWS,TDWS, tmp, cdws, csws, tdws , irdws], local(WStable1, WStable2, CDWS, CSWS, TDWS, IRWStable, IRWStable_DWS), /***> set parameters */ dt: resolvedt(dt), [t, nr] : dt, /* Dynkin type */ if length(opt)>0 then ( prn : opt[1], basis : "D", if length(opt)>1 then ( basis : opt[2] ) /*end if*/ ) else ( prn : 0 ), /*end if*/ /***> DWS1, DWS2 =>CDWS, CSWS, TDWS */ /* making a composite weight system table: */ hdw : hdw1+hdw2, WStable1 : WeightSystem(dt, hdw1), DWS1 : getdict(WStable1,["DWS"]), /* alias for DWS of WStable1 */ DWS1info : dicttaglist(DWS1), WStable2 : WeightSystem(dt, hdw2), DWS2 : getdict(WStable2,["DWS"]), /* alias for DWS of WStable12 */ DWS2info : dicttaglist(DWS2), hl1 : getdict(WStable1,["hl"])[1], hl2 : getdict(WStable2,["hl"])[1], chl : hl1+hl2, if prn>=2 then ( if basis="S" then ( print("Product weight system (Simple root basis):", "dim"=getdict(WStable1,["dim"])[1]*getdict(WStable2,["dim"])[1] ) ) else ( print("Product weight system (Dynkin basis):", "dim"=getdict(WStable1,["dim"])[1]*getdict(WStable2,["dim"])[1] ) ) /*end if*/ ), /*end if*/ CDWS : [], CSWS : [], TDWS : [], for i : chl thru -chl step -1 do ( cdws: [], /* CDWS[i]: the list of the composite Dynkin weights with multipicity */ csws: [], /* CSWS[i]: in the simple root basis */ tdws: [], for j : hl1 thru -hl1 step -1 do ( k : i - j, if ( member([j], DWS1info) and member([k], DWS2info) ) then ( nwv1 : length(getdict(DWS1,[j])), for l1 : 1 thru nwv1 do ( wd1 : getdict(DWS1,[j])[l1] , nwv2 : length(getdict(DWS2,[k])), for l2 : 1 thru nwv2 do ( wd2 : getdict(DWS2,[k])[l2], cw : wd1[2]+wd2[2], cm : wd1[1]*wd2[1], if length(ls: memberp(cw,tdws))>0 then ( l : ls[1], cdws[l][1] : cdws[l][1]+cm, csws[l][1] : csws[l][1]+cm ) else ( tdws : endcons(cw, tdws), cdws : endcons([cm, cw], cdws), csws : endcons([cm, DBtoSRB(cw,dt)], csws) ) /*end if*/ ) /*end do*/ ) /*end do*/ ), /*end if*/ CDWS : repldict(CDWS, [[i], cdws]), CSWS : repldict(CSWS, [[i], csws]), TDWS : repldict(TDWS, [[i], tdws]) ), /*end do*/ /***> print CSWS/CDWS */ if prn=2 then ( if basis="S" then ( disp("level ", i=getdict(CSWS,[i])) ) else ( disp("level ", i=getdict(CDWS,[i])) ) /*end if*/ ) /*end if*/ ), /*end do*/ /***> Irrep decomposition */ if prn>=1 then ( disp("Component representations:") ), /*end if*/ ReprList: [], chl0: chl, while chl>=0 do ( /* print("chl"=chl), print(getdict(CDWS,[chl])), */ CDWSlist : copy(getdict(CDWS,[chl])), for cdw in CDWSlist do ( ml: cdw[1], if ml>0 then ( IRWStable: WeightSystem(dt, cdw[2]), IRDWS: getdict(IRWStable,["DWS"]), for i : chl thru -chl step -1 do ( irdws : getdict(IRDWS, [i]), cdws : getdict(CDWS, [i]), nwv: length(irdws), for j : 1 thru nwv do ( wd: irdws[j], if ( length(ls: memberp(wd[2],getdict(TDWS,[i])))>0 and cdws[ls[1]][1]>0 ) then ( l: ls[1], cdws[l][1]: cdws[l][1]-ml*wd[1] ) /*end if*/ ), /*end do*/ CDWS : repldict(CDWS, [[i], cdws]) ), /*end do*/ ReprList: append(ReprList, [ [cdw[2], ["dim" =getdict(IRWStable,["dim"])[1] ,"ml"= ml ] ] ]), if prn>=1 then ( disp(printf(false, "~a : dim = ~d, ml = ~d", cdw[2], getdict(IRWStable,["dim"])[1], ml)) ) /*end if*/ ) /*end if*/ ), /*end do*/ chl: chl-1 ), /*end do*/ if prn<=1 then ( return (ReprList) ) /*end if*/ )$ /*end proc: ProductOfRep */ /*****> Subgroup reduction */ /****>proc: mkgenlattice */ /* mkgenlattice ( rangelist) => vlist = lattice */ /* rengelist = [ range[1],...,range[n]] range[i] = [v[i][1], ..., v[i][k[i]]] vlist = [[y[1],..., y[n]], ....], y[i] in range[i] */ mkgenlattice (rangelist ) := block( [dim, x , y, vlist, vlist0], dim : length(rangelist), x: 'x, vlist: makelist( x[i] , i, 1, dim), for i : 1 thru dim do ( if i = 1 then ( y: 'y, vlist: makelist(ev(vlist,x[i]=y), y, rangelist[i] ) ) else ( vlist0 : copy(vlist), vlist : [], for y in rangelist[i] do ( vlist : append(vlist, ev(vlist0, x[i] = y)) ) /*end do*/ ) /*end if*/ ), /*end do*/ /* vlist=[[h1,h2,.., hsgc],[...],...]: the list of all possible level heights comb. */ return (copy(vlist)) )$ /*end proc: mkgenlattice*/ /****>proc:sbtDWSm */ /* sbtDWSm(dts, CDWS, hl0, dws) output: [ml, dimlist, newCDWStbl] : a table of reduced dw list dts=[[t1,rn1],..,[tp,rnp]] : the Dynkin type list of the subalgebra A1+...+Ap CDWS=[ [[hl], [...]], ...] : A Dynkin weight system table for a repr. of A1+...+Ap hl0=highest level of CDWS dws=[dwv1,..,dwvp]: a highest Dynkin weight vector list in CDWS output: [ [ml, dimlist], newCDWStbl] ml = multiplicity of the irrep dws contained in CDWS dimlist = the dimension list of the irrep dws newCDWStbl = a new CDWS table obtained by subtracting the CDWS corresponding to the irrep specified by dws from the original CDWS. */ sbtDWSm(dts, CDWS0, hl0, dws) := block( [ /* scalar */ sgc, hl2, ml1,ml, j, hlssum, dwcount, /* list */ hls, hv, hvlist, dimlist, dwsv, dw1, cdwl2, cdwl3, cdwl, /*misc*/ x, y, h, flag, tmp, lis, km, /* dict */ hl1,entrycount1, dim1, CDWS1, CDWS2,WStbl, /* list of dicts */ DWSs ], hl1 : [], /*hl1[Q] = the max height of wvs for charge Q */ dim1 : [], /*dim1[Q] = the dimension of the space of wvs with charge Q */ entrycount1 : [], /* entrycount1[h]=[m]: m= the number of wvs for height h*/ CDWS1:[], CDWS2:[], WStbl:[], DWSs:[], cwd1:[], /*print(printf(false, "sbtDWSm(dts=~a, CDWS=CDWS, hl0=~a, dws=~a", dts, hl0, dws)),*/ /***> set parameters */ sgc: length(dts), dts: map(resolvedt, dts), /***> dws -> CDWS1 */ /** constructing CDWS1 for dws to subtract */ /* constucting the DWSs[i] for the irrep of each simple subalgebra component */ dimlist: [], hls: [], DWSs : [], /* DWSs is the list of WStables for each component irrep*/ for i : 1 thru sgc do ( WStbl : WeightSystem(dts[i], dws[i]), DWSs : append(DWSs, [getdict(WStbl,["DWS"])]), /* DWSs[i][h]= a list of [m,w]'s */ dimlist: append(dimlist, getdict(WStbl,["dim"]) ), hls: append(hls, getdict(WStbl,["hl"])) ), /*end do*/ /* print("sbtGrdm: Check pt 1"), */ /*display(dimlist, hls, DWSs), */ /* construcing hvlist = the list of all possible level sequences corresponding to DWSs */ rangelist : makelist( makelist( hls[i]-j, j, 0, 2*hls[i]), i, 1, sgc), hvlist : mkgenlattice(rangelist), /* hvlist=[[h1,h2,.., hsgc],[...],...]: the list of all possible level heights comb. */ /* DWSs[1] x ...x DWSs[sgc] => CDWS1 */ for hv in hvlist do ( h: sumlist(hv), if getdict(entrycount1,[h])=[] then ( entrycount1 : adddict(entrycount1, [[h], [ 0]]) /* CDWS1 : repldict(CDWS1, [[h] , []] )*/ ), /*end fi*/ rangelist: makelist(getdict(DWSs[i], [hv[i]]), i, 1, sgc), dwsv : mkgenlattice( rangelist), /* dwsv=[[[m1,w1],...,[msgc,wsgc]],[...],...] ; the list of all possible weight comb */ for x in dwsv do ( ml: product(x[i][1],i, 1, sgc), dw1: makelist(x[i][2], i, 1, sgc), entrycount1: repldict(entrycount1, [[h], [getdict( entrycount1,[h])[1]+1]]), CDWS1 : adddict(CDWS1, [ [h], [ [ml,dw1] ] ]) /* CDWS1[h] is a list of [m, dw] pairs */ ) /*end do*/ ), /*end do*/ dim1: product(dimlist[i], i, 1, sgc), /* print("sbtDWSm: check point 2"),*/ /*display(CDWS1),*/ /*display(dws, dts, hl0, hlssum),*/ /***> CDWS0 - CDWS1 => CDWS2 */ /** making the top level list of the new CDWS2 */ hlssum: sumlist(hls), if ( hl0 # hlssum or map(length, dws) # map(lambda([u], u[2]), dts) ) then ( error("CDWS0 and dws should have the same height and rank") ), /*end fi*/ dwcount: length(getdict(CDWS0,[hl0])), if dwcount=1 then ( ml1: getdict(CDWS0,[hl0])[1][1], hl2: hl0-1 ) elseif dwcount>1 then ( hl2: hl0, for i : 1 thru dwcount do ( x: getdict(CDWS0,[hl0])[i], if x[2] # dws then ( CDWS2 : adddict(CDWS2, [[hl0], [x]] ) ) else ( ml1: x[1] ) /*end if*/ ) /*end do*/ ) else ( error("The top level height hl0 is empty") ), /*end if*/ /*print("sbtGdrm: Check pt 3"),*/ /* display(CDWS0, CDWS1), */ /** making the lower level lists of CDWS2 */ for h : hl0-1 thru -hl0 step -1 do ( cdwl : getdict(CDWS0, [h]), if length(cdwl)>0 then ( dwcount: length(cdwl), cdwl2 : copy(cdwl), /* a temporary list of [m,w] */ if getdict(entrycount1, [h])=[] then ( km:0 ) else ( km : getdict(entrycount1,[h])[1] ), /*end if*/ for k : 1 thru km do ( x: getdict(CDWS1,[h])[k], flag : false, for i : 1 thru dwcount while not flag do ( if cdwl[i][2]=x[2] then ( flag : true, cdwl2[i]: [cdwl[i][1]-ml1*x[1] , cdwl2[i][2]] ) /*end if*/ ), /*end do*/ if not flag then ( error("CDWS0 does not contain the irr. rep", dws) ) /*end if*/ ), /*end do: k-loop */ /* cdwl3: sublist(cdwl2, lambda([u], u[1] > 0)), */ cdwl3:[], for x in cdwl2 do ( if x[1]>0 then ( cdwl3: append(cdwl3, [x]) ) /*end if*/ ), /*end do:x */ if length(cdwl3)>0 then ( CDWS2 : repldict( CDWS2, [ [h], copy(cdwl3)] ) /******/ ) elseif (hl2=h) then ( hl2: h-1 ) /*end if*/ ) /*end if*/ ), /*end do : h*/ /* print("sbtGdrm: Check pt 4"), */ /*display(CDWS2),*/ for h : hl0-1/2 thru -hl0+1/2 step -1 do ( if length(lis:getdict(CDWS0, [h]))>0 and length(lis)>0 then ( CDWS2 : repldict(CDWS2, [[h], getdict(CDWS0,[h] )]), if h> hl2 then ( hl2: h ) /*end if*/ ) /*end if*/ ), /*end do*/ /* newCDWS : [ [ ["hl"], hl2], [ ["dim"], dim0-ml1*dim1 ] ], */ return ([ml1, dimlist, copy(CDWS2)] ) )$ /*end proc: sbtDWSm*/ /*print("proc:SubGrdm");*/ /****> proc: SubGrdm */ /* SubGrdm (dt0, dwv0, dts, embMDs[,sw,WStable0]) => DWL: Dynkin weight list of the Irr. decomposition of an irrep. of Lie algebra (L,H) wrt a subalgebra (L',H')=(L1+..+Lp+U1,H1+..+Hp+HU1) [[ input ]] dt0:=[t0,rn0]: Dynkin type of (L,H) dwv=highest Dynkin weight of (L,H) of type t0 dts=[[t1,rn1],..,[tp,rnp](,U1_1,...,U1_m)] = Dynkin types of the subalgebras (L1+..l+Lp,H1+...+Hp) specified by the embeding matrix embMDs=Matrix[embMD[1],...,embMD[p](,QvecD)]: H^* -> H1^*+...+Hp^*(+U1): merged to a single matrix WStable0= WS table in the Dynkin basis created by proc:WeightSystem sw=0 (default): no monitor output, sw=1: show main results, sw=2: +print_CDWS0=true, sw=3: +print_CDWS01=ture, sw=4: use WStable0 [[ output ]] the list of highest Dynkin weights for (L1+...+Lp(+U1+...+U1),H1+...+Hp(+HU1+...+HU1)) DWL::table=[ [[Q]= DWL(Q),] , Q in Qlist], DWL(Q)::list=[[dwv1,...,dwvp], dim, ml],...,[...], "Representation"=[[t0,rn0],dwv], "SubGroup"=[dts,embMD] ] */ SubGrdm (dt0, dwv0, dts0, embMDs, [opt]) := block( [/* scalar */ sgc0, sgc, sw, print_CDWS0, print_CDWS01, t0,rn0, ml0, U1count, sgname, hl0,dim0,tdim, p,q, ml, x,y,z, h,h1, l, flag, U1sw, /*list of list*/ dts, ts,rns, Q, Qlist,QHLlist, U1plist,hlist,hls,dw1, sbtx,dwv, hs, wlist1,/* list */ dwvs, QvecDs, DWL1,DWL, /* matrix */ CM0, /*colvec list*/ dwvec, wvecs, /*matrix list*/ CM, embMD, /* dict */ dws0, entrycount,dictec, outtable, WStable0,DWS0, CDWS0,cdws,CDWS01, dict, dict0,dict01, hl1,dim1, /* any */ tmp, dimQ ], local(CM, embMD), hl1:[], dim1:[], entrycount:[], dictec:[], outtable: [], DWS0: [], CDWS0:[], cdws: [], CDWS01:[], dict:[], dict0:[], dict01:[], /*print("set parameters"),*/ /***> set parameters */ if ( listp(embMDs) and length(dts0) # length[embMDs] ) then ( error("Subgroup list and embMDs are not consistent.") ), /*end if*/ /** option parameters */ print_CDWS0: false, print_CDWS01: false, sw: 0, if length(opt)>0 then ( sw: opt[1], if sw=2 then ( print_CDWS0: true ) elseif ( sw>=3) then ( print_CDWS01: true ), /*end if*/ if ( sw>=4 and length(opt)>1) then ( dws0: opt[2] ) else ( dws0: [] ) /*end if*/ ), /*end if*/ /*print("SubGrdm :Check pt 1"),*/ /* display(sw, print_CDWS0, print_CDWS01), */ /** U1 list */ /*print("making U! list and dts"),*/ dt0: resolvedt(dt0), [t0, rn0] : dt0, if listp(embMDs) then ( [a,b]: matrix_size(embMDs[1]) ) else ( [a,b]: matrix_size(embMDs) ), /*end if*/ if b # rn0 then ( error("SubGrdm: the size of embM is not consistent with the rank of the Lie algebra") ), /*end if*/ sgc0: length(dts0), U1plist: [], if member(U1,dts0) then ( U1sw: true, for i : 1 thru sgc0 do ( if dts0[i]=U1 then ( U1plist: endcons(i, U1plist) ) /*end if*/ ), /*end do*/ U1count: length(U1plist), dts: map(resolvedt, sublist(dts0, lambda([x], x # 'U1))) ) else ( U1sw: false, U1count: 0, dts: map(resolvedt, dts0) ), /*end if*/ /*print("SubGrdm: Check pt 2"),*/ /* display( U1sw, U1count, U1plist, dts), */ /*print("making embMD list and QvecDs"),*/ /***> embMD/QvecD list */ q: 1, /* the row index if embMDs */ j: 0, /* the counter of the non-Abelian factor */ QvecDs: [], /* QvecD list */ ts : [], /* non-U1 Dynkin type list */ rns: [], /* non-U1 rank list */ CM: [], /* Cmatrix list */ embMD: [], /* embMD list for the non-U! subalgebras */ for i: 1 thru sgc0 do ( if member(i, U1plist) then ( if listp(embMDs) then ( QvecDs: endcons( listme(embMDs[i]), QvecDs) ) else ( QvecDs: endcons( listme(row(embMDs, q)), QvecDs), q: q+1 ) /*end if*/ ) else ( j: j+1, ts : endcons(dts[j][1], ts), rns: endcons(dts[i][2], rns), CM : endcons( Cmatrix(dts[j]), CM), if listp(embMDs) then ( embMD : endcons( embMDs[i], embMD) ) else ( embMD: endcons( submatrix1([q, q+rns[j]-1], embMDs, [1, rn0]), embMD), q: q+rns[j] ) /*end if*/ ) /*end if*/ ), /*end do*/ sgc: sgc0-U1count, if U1count=0 then ( QvecDs: makelist(0, i, 1, rn0), U1count: 1 ), /*end if*/ /*print("SubGrdm: Check pt 3"), */ /* display(ts, rns, embMD, QvecDs, CM), */ /*print("(dt0, dwv0) =>dt0 irrep: WStable0(\"DWS\"=DWS0,..)"),*/ /***> (dt0, dwv0)=> WStable0("DWS"=DWS0,...) */ /* DWS0 = [ [ [hl0], [ dwv1, ...]], ... ] :: dict */ /** construct the irr rep weight system DWS0 for [dt0, dwv0] */ if length(dwv0) # rn0 then ( error("The weight vector does not match the rank:", "dw vector"=dwv0, "rank"=rn0) ), /*end if*/ if length(opt)>1 then ( WStable0 : copy(opt[2]), if not (resolvedt(getdict(WStable0,["dt"])[1])=dt0 and getdict(WStable0,["hdw"])[1]=dwv0) then ( error("Invalid Dynkin Weight System table") ) /*end if*/ ) else ( WStable0 : WeightSystem(dt0,dwv0) ), /*end if*/ /*display(WStable0), */ DWS0: getdict(WStable0,["DWS"]), hl0: getdict(WStable0,["hl"])[1], dim0: getdict(WStable0,["dim"])[1], /*display(dim0),*/ CM0: Cmatrix(dt0), if sw>0 then ( disp("Original Rep."), disp([abbrevdt(dt0), dwv0, "dim"=dim0]) ), /*end if*/ if sgc>0 then ( sgname: abbrevdt([ts[1],rns[1]]), for i : 2 thru sgc do ( sgname: concat(sgname,concat("x",abbrevdt([ts[i],rns[i]]))) ) /*end do*/ ) else ( sgname: "" ), /*end if*/ if sw>0 then ( if U1sw then ( if sgc>0 then ( sgname: printf(false, "~a^~d", concat(sgname,"xU1"), U1count) ) else ( sgname: printf(false, "~a^~d", concat(sgname,"U1"), U1count) ), /*end if*/ disp(printf(false, "Subgroup=[~s, embedding=~a, QvecDs=~a", sgname, makelist(embMD[i],i, 1, sgc), QvecDs)) ) else ( disp(printf(false, "Subgroup=[~s, embedding=~a", sgname, makelist(embMD[i],i, 1, sgc))) ) /*end if*/ ), /*end if*/ /* print("SubGrdm: Check pt 4"), */ /* display(hl0, dim0, DWS0, sgname),*/ /*print("dt0 irrep. DWS0 => dts weight dict: CDWS0"),*/ /***> DWS0 x embMD => CDWS0 for dts */ /* CDWS0[Q]= dict0, dict0[h] =[y0], y0=[ml0], dwvs[1..sgc] ] */ /* CDWS01[Q] = dict01, dict0[h] =[y01], y01=[ml0], dwvs[1..sgc],[dwv1,..] ] */ /** Irr DWS0 for [dt0, dwv0] to CDWS0 for dts=[[t1,rn1],,,[tp,rnp]](xU(1)) */ CDWS0: [], /* CDWS0[Q][h] is a list of weights */ CDWS01: [], /* CDWS0 + info on the original dwv */ entrycount:[], /* entrycount[Q] = dictec, dictec[h] = [ml] */ for h : hl0 thru -hl0 step -1 do ( for i : 1 thru length(getdict(DWS0,[h])) do ( [ml0, dwv]: getdict(DWS0,[h])[i], Q: makelist( inprod(QvecDs[j],dwv), j, 1, U1count), dwvec: makelist(0, k, 1, sgc), wvecs: copy(dwvec), hs: copy(dwvec), for j : 1 thru sgc do ( dwvec[j]: embMD[j].covect(dwv), wvecs[j]: transpose(CM[j]^^(-1)).dwvec[j], hs[j]: sumlist(listme(wvecs[j])) ), /*end do*/ dwvs: append(makelist(listme(dwvec[j]), j, 1, sgc), [Q]), h1: sumlist(hs), if getdict(hl1,[Q])#[] then ( if h1> getdict(hl1,[Q])[1] then ( hl1 : repldict(hl1, [[Q], [h1]]) ), /*end if*/ dim1 : repldict(dim1, [[Q] , [getdict(dim1,[Q])[1]+ml0 ]]) ) else ( hl1 : adddict (hl1, [[Q] , [h1]]), dim1 : adddict(dim1, [[Q],[ ml0]]) ), /*end if*/ if ((dict0: getdict(CDWS0,[Q])) # [] and (wlist1:getdict(dict0, [h1]) )# [] ) then ( flag: true, wlist01: copy(wlist1), wlist01: map( lambda([u], endcons( [], u)), wlist01), for j : 1 thru getdict(getdict(entrycount,[Q]),[h1])[1] do ( if wlist1[j][2] = slist(dwvs, 1, sgc) then ( wlist1[j]: [ wlist1[j][1]+ml0, wlist1[j][2] ], wlist01[j] : [ wlist01[j][1]+ml0, wlist01[j][2]], y: ev(wlist01[j][3],eval), wlist01[j] : endcons( append(y,[dwv]), slist( wlist01[j],1,2)), flag: false ) /*end if*/ ), /*end do*/ if flag then ( y: [ml0, makelist(dwvs[l], l, 1, sgc)], k1: getdict( getdict(entrycount,[Q]), [h1])[1]+1, /** **/ wlist1 : append(wlist1, [y]), wlist01: append(wlist01, [ append(y, [[dwv]]) ]), dictec : getdict(entrycount, [Q]), dictec : repldict(dictec, [[h1], [k1]]), entrycount : repldict(entrycount, [[Q] , dictec]) ), /*end if*/ dict0: repldict( dict0, [ [h1], wlist1 ]), CDWS0: repldict( CDWS0, [ [Q], dict0 ]), dict01: repldict( dict01, [ [h1], wlist01 ]), CDWS01: repldict( CDWS01, [ [Q], dict01 ]) ) else ( y: [ml0, makelist(dwvs[j], j, 1, sgc)], dict0: getdict(CDWS0,[Q]), dict0 : adddict(dict0, [[h1], [y] ]), CDWS0 : repldict(CDWS0, [ [Q],dict0] ), dict01 : getdict(CDWS01,[Q]), dict01 : adddict(dict01, [ [h1], [append(y, [[dwv]])] ]), CDWS01 : repldict(CDWS01, [ [Q], dict01 ]), dictec : getdict(entrycount,[Q]), dictec : adddict(dictec, [[h1],[ 1]]), entrycount : repldict(entrycount, [[Q], dictec]) ) /*end if*/ ) /*end do*/ ), /*end do*/ /*print("SubGrdm: Check pt 5"),*/ /* display(CDWS0, CDWS01), */ Qlist: dicttaglist(CDWS0), Qlist : makelist( Qlist[i][1], i, 1, length(Qlist)), Qlist: sort(Qlist, lambda([x,y],x[1]>y[1])), if print_CDWS0 or print_CDWS01 then ( display(Qlist), disp("Derived Dynkin weight system:"), for Q in Qlist do ( display(Q), if print_CDWS01 then ( outtable: getdict(CDWS01,[Q]) ) else ( outtable: getdict(CDWS0,[Q]) ), /*end if*/ hlist: sort( flatten(dicttaglist(outtable)), lambda( [x,y], x>y)), for h in hlist do ( disp("level"=h), for i : 1 thru getdict(getdict(entrycount,[Q]),[h])[1] do ( z: getdict(outtable, [h])[i], if sw<=3 or member(z[2], dws0) then ( disp(z) ) /*end if*/ ) /*end do*/ ) /*end do*/ ) /*end do*/ ), /*end if*/ /* for Q in Qlist do ( CDWS0 : adddict(CDWS0, [ [Q], [ [["hl"], getdict(hl1,[Q])], [["dim"], getdict(dim1,[Q])], [["hl"], getdict(hl1,[Q])] ] ]) ), /*end do*/ */ /*print("SubGrdm: Check pt 6"), */ /* display(Qlist),*/ /***> Irr decomposition of CDWS0 => DWL */ if sw>0 then ( disp(printf(false, "Derived Irr. Reps. wrt ~a", sgname)), display(Qlist), disp("[Q, hl] = [ Dynkin labels, dimensions, multiplicity]") ), /*end if*/ QHLlist: [], DWL1 : [], tdim: 0, for Q in Qlist do ( cdws: copy(getdict(CDWS0,[Q])), /* cdws[h] is a list of weights. Not an Array. */ for h : getdict( hl1,[Q])[1] step -1/2 while h>=0 do ( while ( wlist2 : getdict(cdws, [h]) )#[] do ( [ml, dw1]: wlist2[1], /* dominant weight check */ flag:false, for i :1 thru length(dw1[1]) do ( if dw1[1][i]<0 then ( flag:true ) /*end if*/ ). /*end do*/ if flag then ( display(dw1), display(cdws), error("Not a dominant weight!!") ), /*end if*/ sbtx: sbtDWSm(dts, cdws, h, dw1), /* subtract WS for dw1 : cdws */ if sgc=0 and U1sw then ( sbtx[2]: 1 ), /*end if*/ if (dict: getdict(DWL1,[Q]))#[] and (wlist: getdict(dict, [h]))#[] then ( DWL1: adddict(DWL1, [ [Q], [[[h], [[dw1, sbtx[2], ml ]]]] ] ) ) else ( dict : adddict(dict, [[h], [dw1, sbtx[2], ml] ]), DWL1 : repldict(DWL1, [[Q], dict]), QHLlist : append( QHLlist, [[Q, h]] ) ), /*end if*/ tdim: tdim +ml*product(sbtx[2][i],i, 1, sgc), if sw>0 then ( disp([Q,h]=[dw1,sbtx[2],ml]) ), /*end if*/ cdws: copy(sbtx[3]) ) /*end do*/ ) /*end do*/ ), /*end do*/ if tdim # dim0 then ( error("Unknown error! The total dimension count is not consistent.", "tdim"=tdim, "dim0"=dim0) ), /*end if*/ DWL : [[["Induced Reps"], ev(DWL1,eval)], [["Original Rep."], [abbrevdt(dt),dwv0]], [["SubGroup"], [sgname, embMDs]], [["Qlist"], Qlist], [["QHLlist"], QHLlist]], return (copy(DWL) ) )$ /*end proc: SubGrdm */ /******>Embedding/Projection Matrices */ print("Embedding Matrices"); /*****>Common part */ embM : 'embM$ Qvec : 'Qvec$ /***>Cartan matrix */ print("CM is an array reprenting a Cartan matrix dictionary"); remarray(CM)$ /* CM[X]=transpose(Cmatrix(X)): */ SL:'SL$ A:'A$ for r : 1 thru 10 do ( arraysetapply( CM, [concat(SL,r+1)], transpose(Cmatrix(concat(A,r))) ) )$ /*end do*/ SO:'SO$ B:'B$ D:'D$ for r : 1 thru 10 do ( arraysetapply( CM, [concat(SO,2*r+1)], transpose(Cmatrix(concat(B,r))) ) )$ /*end do*/ for r : 3 thru 10 do ( arraysetapply( CM, [concat(SO,2*r)], transpose(Cmatrix(concat(D, r))) ) )$ /*end do*/ Sp:'Sp$ C:'C$ for r : 2 thru 10 do ( arraysetapply(CM, [concat(Sp,r)], transpose(Cmatrix(concat(C,r))) ) )$ /*end do*/ CM[G2] : transpose(Cmatrix(G2))$ CM[F4] : transpose(Cmatrix(F4))$ CM[E6] : transpose(Cmatrix(E6))$ CM[E7] : transpose(Cmatrix(E7))$ CM[E8] : transpose(Cmatrix(E8))$ /****>Simple roots by dual Cartan basis */ print("SR is an array reprenting a SimpleRootsbyH dictionary"); remarray(SR)$ /* [alpha_1,...,alpha_r]=[h^1,...,h^r] SR */ SL:'SL$ A:'A$ for r : 1 thru 10 do ( arraysetapply( SR, [concat(SL,r+1)], SimpleRootsbyH(concat(A,r)) ) )$ /*end do*/ SO:'SO$ B:'B$ D:'D$ for r : 1 thru 10 do ( arraysetapply( SR, [concat(SO,2*r+1)], SimpleRootsbyH(concat(B,r)) ) )$ /*end do*/ for r : 3 thru 10 do ( arraysetapply( SR, [concat(SO,2*r)], SimpleRootsbyH(concat(D,r)) ) )$ /*end do*/ Sp:'Sp$ C:'C$ for r : 1 thru 10 do ( arraysetapply( SR, [concat(Sp,r)], SimpleRootsbyH(concat(C,r)) ) )$ /*end do*/ SR[G2] : ident(2)$ SR[E6] : Kmetric(E6)$ /****>Maximal Subalgebra List */ print("Procedures for maximal subalgebras and Symmetry Breakings"); /***>proc:MaxSubGlist */ /* MaxSubGlist(dt[, sw]) => the list of maximal semisimple subalgebras */ MaxSubGlist(dt, [opt]) := block( [sw, result], sw:0, if length(opt)>0 then ( sw: opt[1] ), /*end if*/ result: [], dt : resolvedt(dt), if dt[2]=1 then ( result :([ [[U1]], [] ]) ) elseif dt[2]=2 then ( if dt[1]="A" then ( result :( [ [[A1,U1]], [] ]) ) elseif dt[1]="B" or dt[1]="C" then ( result :( [ [[A1[1],A1[2]], [A1,U1]], [[A1]] ]) ) elseif dt[1]="G" then ( result :( [ [[A2],[A1[1],A1[2]]], [[A1]] ]) ) /*end if*/ ) elseif dt[2]=3 then ( if dt[1]="A" or dt[1]="D" then ( result :( [ [[A2,U1],[A1[1],A1[2],U1]], [[A1[1],A1[2]],[C2]] ]) ) elseif dt[1]="B" then ( result :( [ [[A3],[A1[1],A1[2],A1[3]],[C2,U1]], [[G2]] ]) ) elseif dt[1]="C" then ( result :( [ [[A2,U1],[C2,A1]], [[A1],[A1[1],A1[2]]] ]) ) /*end if*/ ) elseif dt[2]=4 then ( if dt[1]="A" then ( result :( [ [[A3,U1],[A2,A1,U1]], [[C2]] ]) ) elseif dt[1]="B" then ( result :( [ [[D4],[C2,A1[1],A1[2]],[A3,A1],[B3,U1]], [[A1],[A1[1],A1[2]]] ]) ) elseif dt[1]="C" then ( result :( [ [[A3,U1],[C3,A1],[C2[1],C2[2]]], [[A1],[A1[1],A1[2],A1[3]]] ]) ) elseif dt[1]="D" then ( result :( [ [[A1[1],A1[2],A1[3],A1[4]],[A3,U1]], [[A2],[B3],[C2,A1]] ]) ) elseif dt[1]="F" then ( result :( [[[B4],[A2[1],A2[2]],[C3,A1]], [[G2,A1],[A1]] ]) ) /*end if*/ ) elseif dt[2]=5 then ( if dt[1]="A" then ( result :( [ [[A4,U1],[A3,A1,U1],[A2[1],A2[2],U1]], [[C3],[A3],[A2],[A2,A1]] ]) ) elseif dt[1]="B" then ( result :( [ [[D5],[D4,A1],[A3,C2],[B3,A1[1],A1[2]],[B4,U1]], [[A1]] ]) ) elseif dt[1]="C" then ( result :( [ [[A4,U1],[C4,A1],[C3,C2]], [[A1],[C2,A1]] ]) ) elseif dt[1]="D" then ( result :( [ [[A4,U1],[A3,A1[1],A1[2]],[D4,U1]], [[B4],[B3,A1],[C2[1],C2[2]],[C2]] ]) ) /*end if*/ ) elseif dt[2]=6 then ( if dt[1]="A" then ( result :( [ [[A5,U1],[A4,A1,U1],[A3,A2,U1]], [[B3]] ]) ) elseif dt[1]="B" then ( result :( [ [[D6],[D5,A1],[D4,C2],[A3,B3],[B4,A1[1],A1[2]],[B5,U1]], [[A1]] ]) ) elseif dt[1]="C" then ( result :( [ [[A5,U1],[C5,A1],[C4,C2],[C3[1],C3[2]]], [[C2,A1],[A3,A1],[A1]] ]) ) elseif dt[1]="D" then ( result :( [ [[D5,U1],[A5,U1],[D4,A1[1],A1[2]],[A3[1],A3[2]]], [[B5],[B4,A1],[B3,C2],[C3,A1],[A1[1],A1[2],A1[3]]] ]) ) elseif dt[1]="E" then ( result :( [ [[D5,U1],[A5,A1],[A2[1],A2[2],A2[3]]], [[A2],[G2],[C4],[F4],[G2,A2]] ]) ) /*end if*/ ) elseif dt[2]=7 then ( if dt[1]="A" then ( result :( [ [[A6,U1],[A5,A1,U1],[A4,A2,U1],[A3[1],A3[2],U1]], [[D4],[C4],[A3,A1]] ]) ) elseif dt[1]="B" then ( result :( [ [[D7],[D6,A1],[D5,C2],[D4,B3],[B4,A3],[B5,A1[1],A1[2]],[B6,U1]], [[A3],[C2,A1],[A1]] ]) ) elseif dt[1]="C" then ( result :( [ [[A6,U1],[C6,A1],[C5,C2],[C4,C3]], [[B3,A1],[A1]] ]) ) elseif dt[1]="D" then ( result :( [ [[A6,U1],[D5,A1[1],A1[2]],[D4,A3],[D6,U1]], [[C3],[C2],[G2],[B6],[B5,A1],[B4,C3],[B3[1],B3[2]]] ]) ) elseif dt[1]="E" then ( result :( [ [[E6,U1],[A7],[D6,A1],[A5,A2]], [[A1],[A1],[A2],[A1[1],A1[2]],[G2,A1],[F4,A1],[C3,G2]] ]) ) /*end if*/ ) elseif dt[2]=8 then ( if dt[1]="A" then ( result :( [ [[A7,U1],[A6,A1,U1],[A5,A2,U1],[A4,A3,U1]], [[B4],[A2[1],A2[1]]] ]) ) elseif dt[1]="B" then ( result :( [ [[D8],[D7,A1],[D6,C2],[D5,B3],[B4,D4],[B5,A3], [B6,A1[1],A1[2]],[B7,U1]], [[A1]] ]) ) elseif dt[1]="C" then ( result :( [ [[A7,U1],[C7,A1],[C6,C2],[C5,C3],[C4[1],C4[1]]], [[C3],[D4,A1],[A1]] ]) ) elseif dt[1]="D" then ( result :( [ [[A7,U1],[D6,A1[1],A1[2]],[D5,A3],[D4[1],D4[2]],[D7,U1]], [[B4],[C4,A1],[C2[1],C2[2]],[B7],[B6,A1],[B5,C2],[B4,B3]] ]) ) elseif dt[1]="E" then ( result :( [ [[D8],[A4[1],A4[2]],[E6,A2],[E7,A1],[A8]], [[A1],[A1],[A1],[F4,G2],[A2,A1],[C2]] ]) ) /*end if*/ ) else ( result : [ "No infomation"] ), /*end if*/ if sw>0 and listp(result) and length(result)>1 then ( printf(true, "Regular subalgebra(s): ~a ~%", result[1]), printf(true, "Special subalgebra(s): ~a~%", result[2]) ),/*end if*/ return (result) )$ /*end proc: MaxSubGlist */ /***>proc:MaxSubGlist0 */ /* MaxSubGlist0(dt) => flat list of maximal subalgebras */ MaxSubGlist0(dt) :=block( [subglist], dt : resolvedt(dt), subglist : MaxSubGlist(dt), return ( append(subglist[1], subglist[2]) ) )$ /*end proc: MaxSubGlist0 */ /*print("proc: MaySubG");*/ /****>Symmetry breaking pattern search */ /***>proc:MaySubG */ /* MaySubG(dts1,dts0) -> maplist , [dts0[1]=[dts1[1],..], dts0[2]=[dts1[3],..]] dts0 = the original symmetry algebra dts1 = final symmetry algebra after symmetry breaking output = the list of possible embedings of dts1 to dts0 with the information on the residual rank (possibly corredpondint to the number of residual U(1) factors) */ MaySubG(dts1, dts0,[opt]) := block( [/*scalar */ sw, /*list*/ ranklist1,ranklist0,ranklis, dt0, /* dict */ newmap, /* list of dicts */ maplist, maplist1, /* misc*/ x, y ], newmap: [], /** set parameters **/ if not listp(dts0) or not listp(dts1) then ( error("usage, MaySubG(dts1,,list, dts0,,list)") ), /*end if*/ dts1: map(resolvedt,dts1), dts1: sort(dts1, lambda([x,y], x[2]>y[2]) ), dts0: map(resolvedt,dts0), dts0: sort(dts0, lambda([x,y], x[2]>y[2]) ), if length(opt)>0 then( sw: 1 ) else ( sw: 0 ), /*end if*/ /*print("Check pt 1"), */ /*print("dts0"=dts0, "dts1"=dts1), */ /** make maplist **/ ranklist0: map(lambda([x], x[2]), dts0), ranklist1: map(lambda([x], x[2]), dts1), maplist: [ [ [ ["residual rank"], ranklist0 ] ] ], /* a list of map tables */ for i: 1 thru length(ranklist1) do ( x: ranklist1[i], maplist1:[], for y in maplist do ( /* y= a dict repr. a mapping */ ranklis: getdict(y, ["residual rank"]), for j : 1 thru length(ranklis) do ( if ranklis[j]>=x then ( newmap: copy(y), dt0: abbrevdt(dts0[j]), newmap: adddict(newmap, [[dt0], [abbrevdt(dts1[i])]]), newmap: repldict(newmap, [["residual rank"], ranklis]), tmp: copy(ranklis), tmp[j] : tmp[j] -x, newmap : repldict(newmap, [["residual rank"], tmp]), maplist1: append(maplist1, [copy(newmap)]) ) /*end if*/ ) /*end do*/ ), /*end do*/ maplist: copy(maplist1) ), /*end do*/ maplist1:maplist, for i : 1 thru length(maplist1) do ( x: maplist1[i], for j : 1 thru length(ranklist0) do ( if getdict(x,["residual rank"])[j]=ranklist0[j] then ( maplist[i] : repldict(maplist[i], [[abbrevdt(dts0[j])], []]) ) /*end if*/ ) /*end do*/ ), /*end do*/ if sw>0 then ( disp(printf(false, "Possible Symmetry Breaking: ~a -> ~a", map(abbrevdt,dts0), map(abbrevdt, dts1))), disp( map(showdict, maplist)) ), /*end if */ maplist : map(lambda([x], sort(x, ordergreatp)), maplist), return (copy(maplist)) )$ /*end proc*/ /*print("proc: mkSBchain"); */ /***>proc,mkSBchain */ /* mkSBchain(SBClist0[,sw]) => complete SB chain list SBClist0= [ SBchains], SBchain=[ [ A_0,[B_1, B_2,...] ], [ [B_1,[C_1,..]],[B_2,[C_2,...],... ],..., [ [D_1=[X1,.],D_2=[X_2,..]..], [X_3,U_1,...] ] ] */ mkSBchain( SBClist0, [opt]) := block( [ /*scalar*/ sw, lastp, algmap0,algmap1,algmap2, algmap,SBC1, oldSBC, finished, dt0,dts0,dts1r,dts2,tbl,oldunb,oldmaps,oldSBs, /*list*/ SBClist1, unbrokenlist,unblis1, newSBlist,addlist,oldSBlist, /*dict*/ /*misc*/ x,x1,y ], /** set parameters **/ if not listp(SBClist0) then ( error("Usage, mkSBchain (SBClist0)") ), /*end if*/ sw:0, if length(opt)>0 then ( sw: opt[1] ), /*end if*/ /** make one-step advanced SB chain list */ SBClist1:[], for SBC in SBClist0 do ( /* SBC do-loop */ /* SBC=[ [ E6 =[D5,U1] ], [ [ D5=[A2,A1], ..], [U1,..] ] ]*/ lastp: length(SBC), algmap0: SBC[lastp][1], /* algmap0=[D5=[A2,A1,..],...] */ algmap1: [], for X in algmap0 do ( if length(args(X)[2])>1 or [abbrevdt(slist(resolvedt(args(X)[1]), 1, 2))]# args(X)[2] then ( algmap1: append(algmap1, [X]) ) /*end if*/ ), /*end do: SBC*/ if lastp>1 then ( /* line 2235 */ oldSBC: slist(SBC, 1, (lastp-1)) /* oldSBC=[ [E6=[D5,U1]] ] */ ) else ( oldSBC: [] ), /*end if*/ unbrokenlist: SBC[lastp][2], /* unbrokenlist=[A1,U1,...] */ SBC1: append(oldSBC ,[[algmap1,unbrokenlist]]), newSBlist: [ [ [], [[],[]] ] ], for X in algmap1 do ( /* X: D5=[A2,A1] */ dt0: resolvedt(args(X)[1]), /* dt0 = D5 */ dt0: slist(dt0, 1, 2), dts0: args(X)[2], /* dts0=[A2, A1] */ addlist:[], for dts1 in MaxSubGlist0(dt0) do ( /* dts1: [A4, U1] */ /* D5 -> [[A4,U1],[A3,A1[1],A1[2]],[D4, U1], ...] */ dts1r:sublist(dts1, lambda([x], x#U1)), /* dtsr1=[A4] */ algmap: MaySubG(dts0,dts1r), /* algmap=[dict: [ [["residual rank"], [1]], [ [[A4], [A1,A2]], ... ], ... ] */ if length(algmap)>0 then ( for tbl in algmap do ( /* tbl=dict: [ [["residual rank"], [1]], [[A4], [A1,A2]],,..] */ algmap2: [], unblis1:[], for x in dts1 do ( /* x: A4 */ x1:x, if x#U1 and length(resolvedt(x))=3 then ( x1: op(x) ), /*end if*/ if (y: getdict(tbl, [x]))#[] then ( /* y: [A1,A2]*/ if [x1]#y then ( algmap2: append(algmap2,[ x=y] ) ) /*end if*/ /* algmap2 = [ A4=[A1,A2] ] */ ) else ( unblis1: append(unblis1, [x1]) ) /*end if*/ ), /*end do*/ dts2:[], for x in dts1 do ( if x=U1 then ( dts2: append(dts2, [U1]) ) else ( dts2: append(dts2, [abbrevdt(slist(resolvedt(x), 1, 2))]) ) /*end if*/ /* dts2=[A4,U1] */ ), /*end do*/ addlist: append(addlist, [ [abbrevdt(dt0)=dts2,algmap2,unblis1]]) /* addlist =[..., [ D5=[A4, U1], [A4=[A1,A2]], []] ]*/ ) /*end do*/ /* algmap do-loop */ ) /*end if*/ ), /*end do*/ /* subalg dts1 do-loop */ /* print("addlist"=addlist); */ oldSBlist: copy(newSBlist), newSBlist:[], for x in oldSBlist do ( for y in addlist do ( if length(x[1])=0 then ( oldSBs: [] /* no further SB */ ) else ( oldSBs: x[1] ), /*end if*/ if x[2][1]=[] then ( oldmaps: [] /* no map */ ) else ( oldmaps: x[2][1] ), /*end if*/ if x[2][2]=[] then ( oldunb: [] /* no unbroken residual algebras */ ) else ( oldunb: x[2][2] ), /*end if*/ newSBlist: append(newSBlist, [[ append(oldSBs,[y[1]]), [append(oldmaps,y[2]), append(oldunb, y[3]) ] ]]) ) /*end do: addlist*/ ) /*end do: oldSBlist*/ ), /*end do: X in algmap1 */ if algmap1=[] then ( SBClist1: append(SBClist1, [SBC1]) ) else ( oldSBlist: copy(newSBlist), newSBlist:[], for x in oldSBlist do ( newSBlist: append(newSBlist, [ append(oldSBC , [ x[1], [x[2][1],append(unbrokenlist,x[2][2])] ]) ]) ), /*end do*/ if length(newSBlist)>0 then ( SBClist1: append(SBClist1, newSBlist) ) /*end if*/ ) /*end if*/ ), /*end do : SBC choice*/ finished:true, for SBC in SBClist1 while finished do ( lastp: length(SBC), if length(SBC[lastp][1])#0 then ( finished:false ) /*end if*/ ), /*end do*/ if finished or sw=1 then ( return (copy(SBClist1)) ) else ( mkSBchain(SBClist1) ) /*end if*/ )$ /*end proc: mkSBchain */ /*print("proc:SBpattern"); */ /***>proc: SBpattern */ /* SBpattern(dt0,dts0[,outsw=0/1]) => Symmetry breaking chains , dt0 thru dts=[dt1,...] dt0: a single Dynkin type (unification group) dts0, a list of Dynkin type (final symmetry) */ SBpattern( dt0, dts0, [opt]) := block( [ /*scalar*/ outsw, U1count1,SBCnum,resrank,lastp, /* list */ SBClist0,SBClist1,SBlist, completeSBC, /* set */ SBCset2, /* dict */ SBCtable, /*misc*/ unbrkn, finished ], dt0: resolvedt(dt0), dts: sublist(dts0, lambda([x], x#U1)), U1count: length(dts0)-length(dts), dts: map(resolvedt,dts), outsw: 0, if length(opt)>0 then ( outsw : 1 ), /*end if*/ SBClist0: [[ [[dt0=dts],[]] ]], finished: false, while not finished do ( SBClist1: mkSBchain(SBClist0,1), completeSBC: true, for SBC in SBClist1 while completeSBC do ( /* SBC:: list */ lastp: length(SBC), if length(SBC[lastp][1])>0 then ( completeSBC: false ) /*end if*/ ), /*end do*/ if completeSBC then ( finished:true ) else ( SBClist0: SBClist1 ) /*end if*/ ), /*end do*/ SBCset2: {}, SBCtable: [], SBCnum: 0, for SBC in SBClist1 do ( lastp: length(SBC), SBlist: slist(SBC, 1, (lastp-1)), unbrkn: SBC[lastp][2], resrank:0, for x in unbrkn do ( if x=U1 then ( resrank: resrank+1 ) else ( resrank: resrank+resolvedt(x)[2] ) /*end if*/ ), /*end do*/ if resrank>=U1count then ( if not member(SBC, SBCset2) then ( SBCnum:SBCnum+1, SBCtable : adddict(SBCtable, [ [SBCnum], SBC]), SBCset2: union(SBCset2,{SBC}), if outsw=1 then ( printf(true, " (~a) ~a => [~a,~a]~%",SBCnum,SBlist,map(abbrevdt,dts),unbrkn) ) /*end if*/ ) /*end if*/ ) /*end if*/ ), /*end do*/ return (copy(SBCtable)) )$ /*end proc: SBpattern*/ /*****>Projection/embedding matrix makers */ /****> proc:Jmatrix */ /* Jmatrix(n) => J[i,j]=delta[i,n+1-j], i,j=1..n */ Jmatrix(n) := block( [JM], if not (integerp(n) and n>=0) then ( error("Usage: Jmatrix( n: non-negative integer )") ), /*end if*/ JM: zeromatrix(n, n), for i : 1 thru n do ( JM[i,n+1-i]:1 ), /*end do*/ return (JM) )$ /*end proc: */ /****> proc:Pmatrix */ /* Pmatrix(plist::permutation of [1,...,n]) => Permutation Matrix */ Pmatrix ( plist ) := block ( [n, PM], if not (listp(plist) and length(plist)>0) then ( error("The argument must of a permutation list of [1,...,n]") ), /*end if*/ n: length(plist), PM: zeromatrix(n, n), for i : 1 thru n do ( PM[i,plist[i]] : 1 ), /*end do*/ return (PM) )$ /*end proc: */ /****>Regular sublagebras */ /***>proc: mkRSembM */ /* mkRSembM( dt, nodepos, type) => dict: [[["subalgebra"], dts],[["embM"],embM] ] nodepos = the number of the node eliminated from the Dynkin diagram type=1 => eliminate one node from the Dynkin diagram and add U1 type=2 => use the extended Dynkin diagram */ mkRSembM( dt, nodepos, type) := block ( [rank,rank1, Qvec, RSembM, IDM,CM,CM1,SR, SR1,dts, q, eqs, qsol,dt1, dt2, M1,M2,M3,M4,swapM], loal(CM), dt : resolvedt(dt), rank : dt[2], rank1 : rank-1, if not member(nodepos,makelist(i, i, 1, rank)) then ( error("mkSRembM: node number should be a positive integer <=rank.") ), /*end if*/ if not member(type,[1,2]) then ( error("mkSRembM: type should be 1 or 2") ), /*end if*/ IDM : ident(rank1), RSembM : [ [[D], []] ], if not member(type, [1,2]) then ( error("mkSRembM: Illegal subalgebra type") ), /*end if*/ /**> type=1 */ if type=1 then ( if rank1>0 then ( if nodepos =1 then ( RSembM : adddict(RSembM, [ [D], [rowMatrices([zeromatrix(rank1,1), submatrix1([1, rank1], IDM, [1, rank1]) ])] ]) ) elseif nodepos = rank then ( RSembM : adddict(RSembM, [ [D], [rowMatrices([ submatrix1( [1, rank1], IDM, [1, rank1] ), zeromatrix(rank1,1) ] ) ]] ) ) else ( RSembM : adddict(RSembM, [ [D], [rowMatrices([ submatrix1( [1, rank1], IDM, [1, (nodepos-1)] ), zeromatrix(rank1,1), submatrix1([1, rank1], IDM, [nodepos, rank1] ) ]) ]] ) ), /*end if*/ q:'q, Qvec: append(makelist(q[i], i, 1, (nodepos-1)), [1], makelist(q[j], j, nodepos, rank1)), eqs : listme(rowMatrices(makelist( row(getdict(RSembM,[D])[1], i).Gmetric(dt)^^(-1).covect(Qvec), i, 1, rank1))), qsol : linsolve(eqs,makelist(q[i], i, 1, rank1)), Qvec : ev(Qvec,qsol), RSembM : repldict(RSembM, [ [D], [ colMatrices([getdict(RSembM,[D])[1], matrix(Qvec)] )]]) ) else ( RSembM : adddict(RSembM, [ [D], [matrix([1]) ]] ) ), /*end if*/ /* print("Check pt 1: RSembM=", RSembM), */ CM1:[], SR1:[], dts:[], /* print("mkRSembM: check pt *"), display(RSembM), */ /*>A */ if dt[1]="A" then ( if nodepos>1 then ( dt1 : abbrevdt(["A",nodepos-1]), dts : append (dts, [dt1]), SR1 : append( SR1, [SimpleRootsbyH(dt1)] ), CM1 : append( CM1, [ transpose(Cmatrix(dt1))] ) ), /*end if*/ if nodeposB */ ) elseif ( dt[1]="B" ) then ( if rank<2 then ( error("mkSRembM: Rank >=2 for the Dynkin type B") ), /*end if*/ if nodepos>1 then ( dt1 : abbrevdt(["A",nodepos-1]), dts : append(dts, [dt1]) , SR1 : append(SR1, [ SimpleRootsbyH(dt1)]) , CM1 : append( CM1, [ transpose(Cmatrix(dt1))]) ), /*end if*/ if nodepos<=rank-2 then ( dt1 : abbrevdt(["B",rank-nodepos]) , dts : append(dts, [dt1]) , SR1 : append(SR1, [ SimpleRootsbyH(dt1)]) , CM1 : append( CM1, [ transpose(Cmatrix(dt1))]) ) elseif nodepos=rank-1 then ( dt1 : 'A1, dts : append(dts, [dt1]) , SR1 : append(SR1, [ SimpleRootsbyH(dt1)]) , CM1 : append( CM1, [ transpose(Cmatrix(dt1))]) ) /*end if*/ /*>C */ ) elseif dt[1]="C" then ( if rank<2 then ( error("mkSRembM: Rank >=2 for the Dynkin type C") ), /*end if*/ if nodepos>1 then ( dt1 : abbrevdt(["A",nodepos-1]), dts : append(dts, [dt1]) , SR1 : append(SR1, [ SimpleRootsbyH(dt1)]) , CM1 : append( CM1, [ transpose(Cmatrix(dt1))]) ), /*end if*/ if nodepos<=rank-2 then ( dt1 : abbrevdt(["C",rank-nodepos]), dts : append(dts, [dt1]) , SR1 : append(SR1, [ SimpleRootsbyH(dt1)]) , CM1 : append( CM1, [ transpose(Cmatrix(dt1))]) ) elseif nodepos=rank-1 then ( dt1 : 'A1, dts : append(dts, [dt1]) , SR1 : append(SR1, [ SimpleRootsbyH(dt1)]) , CM1 : append( CM1, [ transpose(Cmatrix(dt1))]) ) /*end if*/ /*>D */ ) elseif dt[1]="D" then ( if rank<3 then ( error("mkSRembM: Rank >=3 for the Dynkin type D") ), /*end if*/ if nodepos>1 then ( if nodepos=rank-1 then ( dt1 : abbrevdt(["A",rank1]) ) else ( dt1 : abbrevdt(["A",nodepos-1]) ), /*end if*/ dts : endcons( dt1, dts) , SR1 : endcons( SimpleRootsbyH(dt1), SR1), CM1 : endcons( transpose(Cmatrix(dt1)), CM1) ), /*end if*/ if nodepos<=rank-4 then ( dt1 : abbrevdt(["D",rank-nodepos]), dts : endcons( dt1, dts) , SR1 : endcons( SimpleRootsbyH(dt1), SR1), CM1 : endcons( transpose(Cmatrix(dt1)), CM1) ) elseif nodepos=rank-3 then ( dt1 : abbrevdt(["D",rank-nodepos]), dts : endcons( dt1, dts) , SR1 : endcons( SimpleRootsbyH(dt1), SR1), CM1 : endcons( transpose(Cmatrix(dt1)), CM1) ) elseif nodepos=rank-2 then ( dts : append(dts,['A1,'A1]), SR1 : append(SR1, [SimpleRootsbyH(A1),SimpleRootsbyH(A1)]), CM1 : append(CM1,[transpose(Cmatrix(A1)),transpose(Cmatrix(A1))]) ) /*end if*/ /*>G2 */ ) elseif dt=["G",2] then ( dts : ['A1] , SR1 : [SimpleRootsbyH(A1)] , CM1 : [transpose(Cmatrix(A1))] /*>F4 */ ) elseif dt=["F",4] then ( if nodepos=1 then ( dts : ['C3], swapM : blockMatrices([transpose(matrix([0,0,1],[0,1,0],[1,0,0])),1]), RSembM : repldict( RSembM, [ [D], [swapM.getdict(RSembM,[D])[1]]] ) ) elseif nodepos=2 then ( dts : ['A1,'A2] ) elseif nodepos=3 then ( dts : ['A2,'A1] ) elseif nodepos=4 then ( dts : ['B3] ), /*end if*/ SR1 : map(SimpleRootsbyH, dts), CM1 : map(transpose, map(Cmatrix, dts) ) /*>E6 */ ) elseif dt=["E",6] then ( if nodepos=1 then ( dts : ['D5 ] , swapM : blockMatrices([transpose(matrix([0,0,0,1],[0,0,1,0],[0,1,0,0],[1,0,0,0])),1,1]) , RSembM : repldict( RSembM, [ [D] , [swapM.getdict(RSembM,[D])[1] ]]) ) elseif nodepos=2 then ( dts : ['A1,'A4] , swapM : blockMatrices([transpose(matrix([1,0,0,0],[0,0,0,1],[0,0,1,0],[0,1,0,0])),1,1]) , RSembM : repldict(RSembM, [ [D] ,[ swapM.getdict(RSembM,[D])[1] ]]) ) elseif nodepos=3 then ( dts : ['A2,'A2,'A1] ) elseif nodepos=4 then ( dts : ['A4,'A1] , swapM : blockMatrices([1,1,1,transpose(matrix([0,1],[1,0])), 1]) , RSembM : repldict(RSembM, [[D] , [swapM.getdict(RSembM,[D]) [1]]]) ) elseif nodepos=5 then ( dts : ['D5] ) elseif nodepos=6 then ( dts : ['A5] ) , /*end if*/ SR1 : map(SimpleRootsbyH, dts), CM1 : map(transpose, map(Cmatrix, dts)) /*>E7 */ ) elseif dt=["E",7] then ( if nodepos=6 then ( dts : ['E6] ) elseif nodepos=5 then ( dts : ['D5,'A1] , swapM : matrix([0,1], [1,0]), swapM : blockMatrices([1,1,1,1,swapM,1]), RSembM : repldict(RSembM, [[D] , [swapM.getdict(RSembM,[D])[1]]]) ) elseif nodepos=4 then ( dts : ['A4,'A2] , swapM : blockMatrices([1,1,1, transpose(matrix([0,1,0],[0,0,1],[1,0,0])),1]), RSembM : repldict(RSembM, [[D] , [swapM.getdict(RSembM,[D])[1]]]) ) elseif nodepos=3 then ( dts : ['A2,'A3,'A1] ) elseif nodepos=2 then ( dts : ['A1,'A5] , swapM : transpose(matrix([0,0,0,1],[0,0,1,0],[0,1,0,0],[1,0,0,0])) , swapM : blockMatrices([1,swapM,1,1]) , RSembM : repldict(RSembM, [[D] , [swapM.getdict(RSembM,[D])[1]]]) ) elseif nodeos=1 then ( dts : ['D6] , swapM : transpose(matrix([0,0,0,0,1],[0,0,0,1,0],[0,0,1,0,0],[0,1,0,0,0],[1,0,0,0,0])), swapM : blockMatrices([swapM,1,1]), RSembM : repldict(RSembM, [[D] , [swapM.getdict(RSembM,[D])[1]]]) ) elseif nodepos=7 then ( dts : ['A6] ), /*end if*/ SR1 : map(SimpleRootsbyH, dts), CM1 : map(transpose, map(Cmatrix, dts)) /*>E8 */ ) elseif dt=["E",8] then ( if nodepos=7 then ( dts : ['E7] ) elseif nodepos=6 then ( dts : ['E6,'A1] , swapM : blockMatrices([1,1,1,1,1,transpose(matrix([0,1],[1,0])),1]) : RSembM : repldict(RSembM, [[D] , [swapM.getdict(RSembM,[D])[1]]]) ) elseif nodepos=5 then ( dts : ['D5,'A2] , swapM : transpose(matrix([0,1,0],[0,0,1],[1,0,0])) , swapM : blockMatrices([1,1,1,1,swapM,1]), RSembM : repldict(RSembM, [[D] , [swapM.getdict(RSembM,[D])[1]]]) ) elseif nodepos=4 then ( dts : ['A4,'A3] , swapM : transpose(matrix([0,1,0,0],[0,0,1,0],[0,0,0,1],[1,0,0,0])) , swapM : blockMatrices([1,1,1,swapM,1]) , RSembM : repldict(RSembM, [[D] , [swapM.getdict(RSembM,[D])[1]]]) ) elseif nodepos=3 then ( dts : ['A2,'A4,'A1] ) elseif nodepos=2 then ( dts : ['A1,'A6] , swapM : transpose(matrix([0,0,0,0,1],[0,0,0,1,0],[0,0,1,0,0],[0,1,0,0,0],[1,0,0,0,0])) , swapM : blockMatrices([1,swapM,1,1]), RSembM : repldict(RSembM, [[D] , [swapM.getdict(RSembM,[D])[1]]]) ) elseif nodepos=1 then ( dts : ['D7] , swapM : zeromatrix(6,6), for i:1 thru 6 do ( swapM[i,7-i] : 1 ), /*end do*/ swapM : blockMatrices([swapM,1,1]) , RSembM : repldict(RSembM, [[D] , [swapM.getdict(RSembM,[D])[1]]]) ) elseif nodepos=8 then ( dts : ['A7] ), /*end if*/ SR1 : map(SimpleRootsbyH, dts), CM1 : map(transpose, map(Cmatrix, dts)) ), /*end if*/ dts : append(dts, ['U1]) , SR1 : blockMatrices(append(SR1, [1]) ) , CM1 : blockMatrices(append(CM1,[1]) ) , CM : transpose(Cmatrix(dt)) , SR : SimpleRootsbyH(dt) , RSembM : adddict(RSembM, [[S] , [CM1^^(-1).getdict(RSembM,[D])[1].CM ]] ) , RSembM : adddict(RSembM, [[H] , [SR1.getdict(RSembM,[S])[1].SR^^(-1) ]]) ), /*end if: type=1 */ /**> type=2 */ if type=2 then ( /*>A */ if dt[1]="A" then ( error("mkSRembM: No type 2 regular subalgebra for the Dynkin type A") ), /*end if*/ /*>B */ if dt[1]="B" then ( if rank<2 then ( error("mkSRembM: Rank >=2 for the Dynkin type B") ), /*end if*/ if nodepos=1 then ( error("mkSRembM: No type 2 regular subalgebra") ), /*end if*/ /** r=2 */ if rank=2 then ( dts : ['A1,'A1] , RSembM : adddict(RSembM, [[S] , [matrix([1,-1/2], [0,-1/2]) ]]) /** r>=3 */ ) else ( /* p=2 */ if nodepos=2 then ( if rank=3 then ( dt1 : 'A1 ) else ( dt1 : abbrevdt(["B",rank-2]) ), /*end if*/ dts : ['A1, dt1,'A1] , M1 : zeromatrix(1,rank), M1[1,1] : 1, M1[1,2] : -1/2, M2 : rowMatrices([zeromatrix(rank-2,1),zeromatrix(rank-2,1)-1,ident(rank-2)]) , M3 : zeromatrix(1,rank), M3[1,2] : -1/2, RSembM : adddict(RSembM, [[S] , [colMatrices([M1,M2,M3])]]) /* p=r */ ) elseif nodepos=rank then ( if rank=3 then ( dt1 : 'A3 , RSembM : adddict(RSembM, [[S] , [transpose(matrix([1,0,0],[0,1,0],[-1/2,-1,-1/2]))]]) ) else ( dt1 : abbrevdt(["D",rank]), M1 : zeromatrix(rank,1) -1, M1[rank-1,1] : -1/2, M1[rank,1] : -1/2 , RSembM : adddict(RSembM, [[S], [rowMatrices([colMatrices([Jmatrix(rank-1),zeromatrix(1,rank-1)]),M1])]]) ), /*end if*/ dts : [dt1] /* p=3 */ ) elseif nodepos=3 then ( if rank=4 then ( dt1 : 'A1 ) else ( dt1 : abbrevdt(["B",rank-3]) ), /*end if*/ M1 : colMatrices([ident(2), zeromatrix(rank-2,2)]) , M2 : zeromatrix(rank,1)-1 , M2[1,1] : -1/2, M2[3,1] : -1/2, M3 : colMatrices([zeromatrix(3,rank-3),ident(rank-3) ]), RSembM: adddict(RSembM, [[S] , [rowMatrices([M1,M2,M3])]]) , dts : ['A3,dt1] /* p=4, , , r-1 */ ) else ( dt1 : abbrevdt(["D",nodepos]) , if nodepos=rank-1 then ( dt2 : 'A1 ) else ( dt2 : abbrevdt(["B",rank-nodepos]) ), /*end if*/ dts : [dt1,dt2] , M1 : colMatrices([Jmatrix(nodepos-1),zeromatrix(rank-nodepos+1,nodepos-1)] ), M2 : zeromatrix(rank,1) -1, M2[nodepos-1,1] : -1/2, M2[nodepos,1] : -1/2, M3 : colMatrices([zeromatrix(nodepos,rank-nodepos),ident(rank-nodepos)]), RSembM: adddict(RSembM, [[S] , [rowMatrices([M1,M2,M3]) ]]) ) /*end if: node position*/ ), /*end if: rank =2 ?*/ SR1 : map(SimpleRootsbyH, dts), CM1 : map(transpose, map(Cmatrix, dts)) /*>C */ ) elseif dt[1]="C" then ( if rank<3 then ( if rank<2 then ( error("mkSRembM: Rank >=2 for the Dynkin type C") ) else ( error("mkSRembM: C2[ab] = B2[ba]. Try B2.") ) /*end if*/ ), /*end if*/ if nodepos=rank then ( error("mkSRembM: No type 2 regular subalgebra") ), /*end if*/ if nodepos=1 then ( dt1 : 'A1 ) elseif nodepos=2 then ( dt1 : 'B2 ) else ( dt1 : abbrevdt(["C",nodepos]) ), /*end if*/ if nodepos=rank-1 then ( dt2 : 'A1 ) elseif nodepos=rank-2 then ( dt2 : 'B2 ) else ( dt2 : abbrevdt(["C",rank-nodepos]) ), /*end if*/ dts : [dt1,dt2], SR1 : [SimpleRootsbyH(dt1),SimpleRootsbyH(dt2)], CM1 : [transpose(Cmatrix(dt1)),transpose(Cmatrix(dt2))] , M1 : colMatrices([Jmatrix(nodepos-1),zeromatrix(rank-nodepos+1,nodepos-1)]) , M2 : zeromatrix(rank,1) -1, M2[nodepos,1] : -1/2 , M2[rank,1] : -1/2 , M3 : colMatrices([zeromatrix(nodepos,rank-nodepos),ident(rank-nodepos)]), RSembM : adddict( RSembM, [[S] , [rowMatrices([M1,M2,M3])]]), if nodepos=2 then ( swapM : Pmatrix(append([2,1], makelist(i,i, 3, rank))) , RSembM : repldict(RSembM, [ [S] , [swapM.getdict(RSembM,[S])[1] ]]) ), /*end if*/ if nodepos=rank-2 then ( swapM : Pmatrix(append(makelist(i, i, 1, (rank-2)), [rank,rank-1])) , RSembM : repldict(RSembM, [ [S] , [swapM.getdict(RSembM,[S])[1] ]]) ) /*end if*/ /*>D */ ) elseif dt[1]="D" then ( if rank<4 then ( if rank<3 then ( error("mkSRembM: Rank >=3 for the Dynkin type D") ) else ( error("mkSRembM: There is no type-2 regular subalgebra for D3=A3") ) /*end if*/ ), /*end if*/ if member(nodepos,{1,rank-1,rank}) then ( error("mkSRembM: No type 2 regular subalgebra") ), /*end if*/ if nodepos=2 then ( dts : ['A1, 'A1] ) elseif nodepos=3 then ( dts : ['A3] ) else ( dts : [abbrevdt(["D",nodepos])] ), /*end if*/ if nodepos=rank-2 then ( dts : append( dts, ['A1, 'A1]) ) elseif nodepos=rank-3 then ( dts : append( dts, ['A3] ) ) else ( dts : append( dts, [abbrevdt(["D",rank-nodepos])]) ), /*end if*/ SR1 : map(SimpleRootsbyH,dts), CM1 : map(transpose,map(Cmatrix,dts)), M1 : colMatrices([Jmatrix(nodepos-1), zeromatrix(rank-nodepos+1,nodepos-1)] ) , M2 : zeromatrix(rank,1) -1 , M2[nodepos-1,1] : -1/2 , M2[nodepos,1] : -1/2 , M2[rank-1,1] : -1/2 , M2[rank,1] : -1/2 , M3 : colMatrices([zeromatrix(nodepos,rank-nodepos),ident(rank-nodepos)]) , RSembM : adddict(RSembM, [[S] , [rowMatrices([M1,M2,M3])]]), if nodepos=3 then ( swapM : Pmatrix(append([2,1], makelist(i,i, 3, rank))), RSembM : repldict(RSembM, [[S] , [swapM.getdict(RSembM,[S])[1] ]] ) ), /*end if*/ if nodepos=rank-3 then ( swapM : Pmatrix(append(makelist(i, i, 1, (rank-3)),[ rank-1,rank-2,rank])) , RSembM : repldict(RSembM, [[S] , [swapM.getdict(RSembM,[S])[1] ]] ) ) /*end if*/ /*>G2 */ ) elseif dt=["G",2] then ( if nodepos=1 then ( dts : ['A1, 'A1] , RSembM : adddict( RSembM, [ [S] ,[ transpose( matrix([-1/2,-3/2], [0,1]))] ]) ) elseif nodepos=2 then ( dts : ['A2] , RSembM : adddict( RSembM, [ [S] ,[ transpose( matrix([0,1], [-1/3,-2/3]))] ]) ), /*end if*/ SR1 : map(SimpleRootsbyH,dts), CM1 : map(transpose,map(Cmatrix,dts)) /*>F4 */ ) elseif dt=["F",4] then ( if nodepos=1 then ( dts : ['A1, 'C3] , RSembM : adddict( RSembM, [[S], [ transpose(matrix([-1/2,-3/2,-2,-1],[0,1,0,0],[0,0,1,0],[0,0,0,1]))]]) , swapM : Pmatrix([1,4,3,2]) , RSembM : repldict(RSembM, [[S] ,[ swapM.getdict(RSembM,[S])[1] ] ]) ) elseif nodepos=2 then ( dts : ['A2, 'A2] , RSembM : adddict( RSembM, [[S], [transpose(matrix([0,1,0,0],[-1/3,-2/3,-4/3,-2/3],[0,0,1,0],[0,0,0,1]))] ]) ) elseif nodepos=3 then ( dts : ['A3, 'A1] , RSembM : adddict( RSembM, [[S],[ transpose(matrix([0,1,0,0],[0,0,1,0],[-1/4,-1/2,-3/4,-1/2],[0,0,0,1]))]]) ) elseif nodepos=4 then ( dts : ['B4] , RSembM : adddict( RSembM, [[S],[ transpose(matrix([0,1,0,0],[0,0,1,0],[0,0,0,1],[-1/2,-1,-3/2,-2]))] ]) ), /*end if*/ SR1 : map(SimpleRootsbyH,dts) , CM1 : map(transpose,map(Cmatrix,dts)) /*>E6 */ ) elseif dt=["E",6] then ( if nodepos=2 then ( dts : ['A1, 'A5] , M1 : zeromatrix(6,1) , M1[1,1] : 1 , M2 : covect([-1/2,-1/2,-1,-3/2,-1,-1/2]), M3 : colMatrices([ zeromatrix(1,3), Jmatrix(3), zeromatrix(2,3)]), M4 : zeromatrix(6,1), M4[5,1] : 1 , RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3,M4]) ]]) ) elseif nodepos=4 then ( dts : ['A5, 'A1] , M1 : colMatrices([ident(3), zeromatrix(3,3)]) , M2 : covect([-1/2,-1,-3/2,-1,-1/2,-1/2]) , M3 : colMatrices([ zeromatrix(3,2), transpose(matrix([0,0,1],[1,0,0])) ]), RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3]) ]]) ) elseif nodepos=6 then ( dts : ['A5, 'A1] , M1 : colMatrices([ ident(5), zeromatrix(1,5) ]), M2 : covect([-1/2,-1,-3/2,-1,-1/2,-1/2] ), RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2])] ]) ) elseif nodepos=3 then ( dts : ['A2, 'A2, 'A2] , M1 : colMatrices([ident(2), zeromatrix(4,2)]), M2 : covect([-1/3,-2/3,-2/3,-1/3,-2/3,-1/3]), M3 : colMatrices([zeromatrix(2,3), ident(3), zeromatrix(1,3)]), RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3]) ]]) ) else ( error("mkSRembM: Wrong node position") ), /*end if*/ SR1 : map(SimpleRootsbyH,dts), CM1 : map(transpose,map(Cmatrix,dts)) /*>E7 */ ) elseif dt=["E",7] then ( if nodepos=1 then ( dts : ['D6, 'A1] , M1 : covect([-1/2,-1,-3/2,-2,-3/2,-1,-1/2]), M2 : colMatrices([Jmatrix(5), zeromatrix(2,5)]), M3 : zeromatrix(7,1) , M3[6,1] : 1 , RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3])] ]) ) elseif nodepos=5 then ( dts : ['D6, 'A1] , M1 : colMatrices([ zeromatrix(1,4), ident(4), zeromatrix(2,4)] ) , M2 : covect([-1/2,-1,-3/2,-2,-3/2,-1,-1/2]), M3 : colMatrices([zeromatrix(5,2), Jmatrix(2)]), RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3]) ]]) ) elseif nodepos=2 then ( /*********** */ dts : ['A2, 'A5] , M1 : zeromatrix(7,1), M1[2,1] : 1 , M2 : covect([-1/3,-2/3,-1/3,-2/3,-1,-4/3,-2/3]), M3 : colMatrices([zeromatrix(2,4),Jmatrix(4), zeromatrix(1,4)]), M4 : zeromatrix(7,1) , M4[7,1] : 1 , RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3,M4]) ]]) ) elseif nodepos=4 then ( dts : ['A5, 'A2], M1 : colMatrices([ zeromatrix(1,3), ident(3), zeromatrix(3)]) , M2 : covect([-1/3,-2/3,-1,-4/3,-2/3,-2/3,-1/3]), M3 : colMatrices([ zeromatrix(4,3), transpose(matrix([0,1,0],[0,0,1],[1,0,0])) ]), RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3]) ]]) ) elseif nodepos=3 then ( dts : ['A3, 'A3, 'A1] , M1 : colMatrices([ transpose(matrix([0,1,0],[0,0,1])), zeromatrix(4,2) ]), M2 : covect([-1/4,-1/2,-3/4,-3/4,-1/2,-1/4,-1/2]), M3 : colMatrices([ zeromatrix(3,4), ident(4) ]) , RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3])] ]) ) elseif nodepos=7 then ( dts : ['A7] , M1 : colMatrices([ zeromatrix(1,6), ident(6)]), M2 : covect([-1/2,-1,-3/2,-2,-3/2,-1,-1/2]), RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2]) ]]) ) else ( error("mkSRembM: Wrong node position") ), /*end if*/ SR1 : map(SimpleRootsbyH,dts), CM1 : map(transpose,map(Cmatrix, dts)) /*>E8 */ ) elseif dt=["E",8] then ( if nodepos=1 then ( dts : ['D8] , M1 : covect([-1/2,-1,-3/2,-2,-5/2,-3,-2,-3/2]), M2 : colMatrices([ zeromatrix(1,6), Jmatrix(6), zeromatrix(1,6)]), M3 : zeromatrix(8,1) , M3[8,1] : 1 , RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3]) ]]) ) elseif nodepos=2 then ( dts : ['A1, 'A7] , M1 : zeromatrix(8,1) , M1[1,1] : 1 , M2 : covect([-1/2,-1/4,-1/2,-3/4,-1,-5/4,-3/2,-3/4]), M3 : colMatrices([ zeromatrix(2,5), Jmatrix(5), zeromatrix(1,5)]), M4 : zeromatrix(8,1), M4[8,1] : 1 , RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3, M4])] ]) ) elseif nodepos=3 then ( dts : ['A2, 'A5, 'A1] , M1 : colMatrices([ ident(2), zeromatrix(6,2) ]), M2 : covect( [-1/3,-2/3,-5/6,-2/3,-1/2,-1/3,-1/6,-1/2] ), M3 : colMatrices([ zeromatrix(2,4), ident(4), zeromatrix(2,4) ]), M4 : zeromatrix(8,1), M4[8,1] : 1 , RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3, M4]) ]]) ) elseif nodepos=4 then ( dts : ['A4, 'A4] , M1 : colMatrices([ident(3), zeromatrix(5,3)]), M2 : covect([-2/5,-4/5,-6/5,-3/5,-4/5,-3/5,-2/5,-1/5]), M3 : colMatrices([ zeromatrix(4,3), ident(3), zeromatrix(1,3) ]), M4 : zeromatrix(8,1) , M4[4,1] : 1 , RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3, M4]) ]]) ) elseif nodepos=5 then ( dts : ['D5, 'A3] , M1 : colMatrices([ ident(4), zeromatrix(4)] ), M2 : covect([-1/2,-1,-3/2,-5/4,-3/4,-3/4,-1/2,-1/4] ), M3 : colMatrices([ zeromatrix(5,2), ident(2), zeromatrix(1,2)]), M4 : zeromatrix(8,1) , M4[5,1] : 1 , RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2,M3, M4]) ]]) ) elseif nodepos=6 then ( dts : ['E6, 'A2] , M1 : colMatrices([ ident(5), zeromatrix(3,5) ]), M2 : covect([-2/3,-4/3,-2,-5/3,-4/3,-1,-2/3,-1/3] ), M3 : colMatrices([ zeromatrix(5,2), Jmatrix(2), zeromatrix(1,2) ]), RSembM: adddict(RSembM, [ [S] ,[ rowMatrices([M1,M2,M3]) ]]) ) elseif nodepos=7 then ( dts : ['E7, 'A1] , M1 : colMatrices([ ident(6), zeromatrix(2,6) ]), M2 : covect([-1,-2,-3,-5/2,-2,-3/2,-3/2,-1/2]), M3 : zeromatrix(8,1) , M3[7,1] : 1 , RSembM: adddict(RSembM, [ [S] ,[ rowMatrices([M1,M2,M3]) ]]) ) elseif nodepos=8 then ( dts : ['A8] , M1 : colMatrices([ ident(7), zeromatrix(1,7) ]), M2 : covect([-2/3,-4/3,-2,-5/3,-4/3,-1,-2/3,-1/3]), RSembM: adddict(RSembM, [ [S] , [rowMatrices([M1,M2]) ]]) ) else ( error("mkSRembM: Wrong node position") ), /*end if*/ SR1 : map(SimpleRootsbyH,dts), CM1 : map(transpose,map(Cmatrix,dts)) ) else ( error("mkSRembM: Illegal Dynkin type") ), /*end if: dt */ SR : SimpleRootsbyH(dt) , SR1 : blockMatrices(SR1) , CM : transpose(Cmatrix(dt)), CM1 : blockMatrices(CM1) , RSembM : adddict(RSembM, [ [D] , [CM1.getdict(RSembM,[S])[1].CM^^(-1)]]) , RSembM : adddict(RSembM, [ [H] , [SR1.getdict(RSembM,[S])[1].SR^^(-1)] ]) ), /*end if: tyep=2 */ return ( [ [ ["subalgebra"], dts], [ ["embM"], RSembM] ]) )$ /*end proc : */ /****>SO(dim)->SL(dim) embedding */ /***>proc:mkSOSLembM */ /* mkSOSLembM(dim) => embM embM: dict[[H],[embMH]], [[S], [embMS]], [[D],[embMD]]] */ mkSOSLembM(dim) := block( [/*scalar*/ rank, /*list */ /* dict */ embM, /*matrix*/ embMH, /*misc*/ dt,dts ], embM:[], if not integerp(dim) or dim<=1 then ( error("Usage: mkSOSLembM(dim). dim>1") ), /*end if*/ dt: ["A",dim-1], if dim=2 then ( embM: getdict(mkRSembM(A1,1,1),["embM"]) ) else ( if mod(dim, 2)=0 then ( rank:dim/2, dts:["D", rank], embMH: rowMatrices([ident(rank), colMatrices([zeromatrix(1,rank-1),-Jmatrix(rank-1)])]) ) else ( rank:(dim-1)/2, dts:["B",rank], embMH: rowMatrices( [ ident(rank), zeromatrix(rank,1), colMatrices([zeromatrix(1,rank-1),-Jmatrix(rank-1)]) ]) ), /*end if*/ embM: adddict(embM, [[H], [embMH] ]), embMS: SimpleRootsbyH(dts)^^(-1).embMH.SimpleRootsbyH(dt), embM: adddict( embM, [[S], [embMS]]), embMD: transpose(Cmatrix(dts)).embMS.transpose(Cmatrix(dt)^^(-1)), embM: adddict( embM, [[D], [embMD]]) ), /*end if*/ return (copy(embM)) )$ /*end proc, */ /*****>Embedding matrix list */ /****>proc:embMlist */ /* embMlist(dt) dt:Dynkin type (e.g. A5) => list of the embM[D] indeces */ embMlist(dt0) :=block( [dt,dc,rn], dt0:resolvedt(dt0), [dc, rn] :dt0, dt:abbrevdt(dt0), if dc="A" then ( if rn=1 then ( printf(true, " ~20a: [~a, 0]~%", U1, U1_SU2), printf(true, " =20a: [~a, n]~%", SO3, SO3_SU2) ) elseif rn=2 then ( printf(true, " ~20a: [~a, 0]~%", U1xU1, U1U1_SU3), printf(true, " ~20a: [~a, ~a]~%", SO3, SO3_SU3, n), printf(true, " ~20a: [~a, ~a]~%", 'SU2xU1, SU2U1_SU3, "n/c") ) elseif rn=3 then ( printf(true, " ~20a: [~a, ~a]~%", "SU3xU1", 'SU3U1_SU4, "c/s"), printf(true, " ~20a: [~a, ~a]~%", "SU2xSU2xU1", 'SU2SU2U1_SU4, "n/c"), printf(true, " ~20a: [~a, ~a]~%", "SU2xSU2", 'SU2SU2_SU4, c ), printf(true, " ~20a: [~a, ~a]~%", "Sp2", 'Sp2_SU4, n) ) elseif rn=4 then ( printf(true, " ~20a: [~a, ~a]~%", 'SU4xU1, SU4U1_SU5, "n/c/s"), printf(true, " ~20a: [~a, ~a]~%", 'SU3xSU2xU1, SU3SU2U1_SU5, "n/c/s"), printf(true, " ~20a: [~a, ~a]~%", 'SU3xU1em, SU3U1em_SU5, 0 ), printf(true, " ~20a: [~a, ~a]~%", 'SO5, SO5_SU5, n ) ) elseif rn=5 then ( printf(true, " ~20a: [~a, ~a]~%", 'SU5xU1, SU5U1_SU6, n ), printf(true, " ~20a: [~a, ~a]~%", 'SU4xSU2xU1, SU4SU2U1_SU6, "n/s"), printf(true, " ~20a: [~a, ~a]~%", 'SU3xSU3xU1, SU3SU3U1_SU6, "n/s"), printf(true, " ~20a: [~a, ~a]~%", 'SU4, SU4_SU6, n ), printf(true, " ~20a: [~a, ~a]~%", 'SU3, SU3_SU6, n ), printf(true, " ~20a: [~a, ~a]~%", 'SU3xSU2, SU3SU2_SU6, n ), printf(true, " ~20a: [~a, ~a]~%", 'Sp3, Sp3_SU6, 0 ) ) else ( printf(true, "No information~%") ) /*end if*/ ) elseif dc="B" then ( if rn=2 then ( printf(true, " ~20a: [~a, ~a]~%", 'SU2xU1, SU2U1_SO5, "n/c"), printf(true, " ~20a: [~a, ~a]~%", 'SU2xSU2, SU2SU2_SO5, "n1/n2" ), printf(true, " ~20a: [~a, ~a]~%", 'SU2, SU2SU2_SO5, n ) ) elseif rn=3 then ( printf(true, " ~20a: [~a, ~a]~%", 'SU4, SU4_SO7, "n/s"), printf(true, " ~20a: [~a, ~a]~%", 'SO5xU1, SO5U1_SO7, n ), printf(true, " ~20a: [~a, ~a]~%", 'SU2xSU2xSU2, SU2SU2SU2_SO7, n ), printf(true, " ~20a: [~a, ~a]~%", 'G2, G2_SO7, n ) ) elseif rn=4 then ( printf(true, " ~20a: [~a, ~a]~%", 'SO8, SO8_SO9, "n/s"), printf(true, " ~20a: [~a, ~a]~%", 'SO7xU1, SO7U1_SO9, n ), printf(true, " ~20a: [~a, ~a]~%", 'SU4xSU2, SU4SU2_SO9, "n/s"), printf(true, " ~20a: [~a, ~a]~%", 'SU2xSU2xSp2, SU2SU2Sp2_SO9, n ), printf(true, " ~20a: [~a, ~a]~%", 'SU2, SU2_SO9, '0 ), printf(true, " ~20a: [~a, ~a]~%", 'SU2xSU2, SU2SU2_SO9, n ) ) else ( printf(true, "No information~%") ) /*end if*/ ) elseif dc="C" then ( if rn=3 then ( printf(true, " ~20a: [~a, ~a]~%", 'SU3xU1, SU3U1_Sp3, n ), printf(true, " ~20a: [~a, ~a]~%", 'Sp2xSU2, Sp2SU2_Sp3, "n1/n2/c"), printf(true, " ~20a: [~a, ~a]~%", 'SU2, SU2_Sp3, n ), printf(true, " ~20a: [~a, ~a]~%", 'SU2xSU2, SU2SU2_Sp3, n ) ) elseif rn=4 then ( printf(true, " ~20a: [~a, ~a]~%", 'SU4xU1, SU4U1_Sp4, n ), printf(true, " ~20a: [~a, ~a]~%", 'Sp3xSU2, Sp3SU2_Sp4, n ), printf(true, " ~20a: [~a, ~a]~%", 'Sp2xSp2, Sp2Sp2_Sp4, n ), printf(true, " ~20a: [~a, ~a]~%", 'SU2, SU2_Sp4, n ), printf(true, " ~20a: [~a, ~a]~%", 'SU2xSU2xSU2, SU2SU2SU2_Sp4, n ) ) elseif rn=5 then ( printf(true, " ~20a: [~a, ~a]~%", 'SU5xU1, SU5U1_Sp5, n ), printf(true, " This list is imcomplete!") ) else ( printf(true, "No information~%") ) /*end if*/ ) elseif dc="D" then ( if rn=4 then ( printf(true, " ~20a: [~a, ~a]~%", 'SU4xU1, SU4U1_SO8, "n/s"), printf(true, " ~20a: [~a, ~a]~%", 'SU2xSU2xSU2xSU2, SU2SU2SU2SU2_SO8, n ), printf(true, " ~20a: [~a, ~a]~%", 'SO7, SO7_SO8, "n/s1/s2" ), printf(true, " ~20a: [~a, ~a]~%", 'SU3, SU3_SO8, n ), printf(true, " ~20a: [~a, ~a]~%", 'Sp2xSU2, Sp2SU2_SO8, n ) ) elseif rn=5 then ( printf(true, " ~20a: [~a, ~a]~%", 'SO8xU1, SO8U1_SO10, "n/c/s"), printf(true, " ~20a: [~a, ~a]~%", 'SU5xU1, SU5U1_SO10, "n1/n2/n3/c"), printf(true, " ~20a: [~a, ~a]~%", 'SU4xSU2xSU2, SU4SU2SU2_SO10, "n1/n2/c/s"), printf(true, " ~20a: [~a, ~a]~%", 'SO9, SO9_SO10, "c/s"), printf(true, " ~20a: [~a, ~a]~%", 'SO7xSU2, SO7SU2_SO10, "n/c/s"), printf(true, " ~20a: [~a, ~a]~%", 'Sp2xSp2, Sp2Sp2_SO10, n ), printf(true, " ~20a: [~a, ~a]~%", 'Sp2, Sp2_SO10, n ) ) else ( printf(true, "No information~%") ) /*end if*/ ) elseif dc="E" then ( if rn=6 then ( printf(true, " ~20a: [~a, ~a]~%", 'SO10xU1, SO10U1_E6, "n1/n2/c"), printf(true, " ~20a: [~a, ~a]~%", 'SU6xSU2, SU6SU2_E6, "n1/n2/c/s1/s2" ), printf(true, " ~20a: [~a, ~a]~%", 'SU3xSU3xSU3, SU3SU3SU3_E6, "n/c/s"), printf(true, " ~20a: [~a, ~a]~%", 'SU3, SU3_E6, c ), printf(true, " ~20a: [~a, ~a]~%", 'G2, G2_E6, n ), printf(true, " ~20a: [~a, ~a]~%", 'G2xSU3, G2SU3_E6, c ), printf(true, " ~20a: [~a, ~a]~%", 'Sp4, Sp4_E6, n ), printf(true, " ~20a: [~a, ~a]~%", 'F4, F4_E6, "c/s") ) else ( printf(true, "No information~%") ) /*end if*/ ) elseif dt=F4 then ( printf(true, " ~20a: [~a, ~a]~%", 'SO9, SO9_F4, "n/s"), printf(true, " ~20a: [~a, ~a]~%", 'SU3xSU3, SU3SU3_F4, "n/s"), printf(true, " ~20a: [~a, ~a]~%", 'Sp3xSU2, Sp3SU2_F4, "n/c"), printf(true, " ~20a: [~a, ~a]~%", 'G2xSU2, G2SU2_F4, n ) ) elseif dt=G2 then ( printf(true, " ~20a: [~a, ~a]~%", 'SU3, SU3_G2, n ) ) else ( printf(true, "No such semi-simple Lie algebra.") )/*end if*/ )$ /*end proc: embMlist*/ /*****>Type A */ embM:[]$ /****>SU(2) */ /** Begin: Job_SU2 **/ if Job_SU2 then ( print("Info on the maximal quasi-semisimple subgroups and embedding matrices preloaded:"), printf(true, " SU(2),"), /**>U1->SU2 */ embMH : matrix([1]), embMS : embMH . SR[SL2], embMD : embMS . CM[SL2]^^(-1), embM: adddict(embM, [ [U1_SU2], [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ] ]) )$ /*end if: Job_SU2 */ /****>SU(3) */ /* Begin: Job_SU3 */ if Job_SU3 then ( printf(true, "SU(3),"), /***> Basis of su(3) */ E:'E, H:'H, A:'A, S:'S, BasisDefSU3:[ H[1]=%i *(E[1,1]-E[3,3]), H[2]=%i *(E[2,2]-E[3,3]), A[1]=E[2,3]-E[3,2], A[2]=E[3,1]-E[1,3], A[3]=E[1,2]-E[2,1], S[1]=%i *(E[2,3]+E[3,2]), S[2]=%i *(E[3,1]+E[1,3]), S[3]=%i *(E[1,2]+E[2,1]) ], H: 'H, WB: 'WB, WeylBasisDef:[ H[1]=1/(3*%i )*(2*H[1]-H[2]), H[2]=1/(3*%i )*(H[1]+H[2]), WB[1]=A[3]-%i *S[3], WB[-1]=A[3]+%i *S[3], WB[2]=A[1]-%i *S[1], WB[-2]=A[1]+%i *S[1], WB[3]=A[2]+%i *S[2], WB[-3]=A[2]-%i *S[2] ], /* Matrix representation */ SU3BasisMatrixRep:[ HM[1]= matrix( [%i ,0,0],[0,0,0],[0,0,-%i ] ), HM[2]= matrix( [0,0,0],[0,%i ,0],[0,0,-%i ] ), AM[1]= matrix( [0,0,0],[0,0,1],[0,-1,0] ), AM[2]= matrix( [0,0,-1],[0,0,0],[1,0,0] ), AM[3]= matrix( [0,1,0],[-1,0,0],[0,0,0] ), SM[1]= matrix( [0,0,0],[0,0,%i ],[0,%i ,0] ), SM[2]= matrix( [0,0,%i ],[0,0,0],[%i ,0,0] ), SM[3]= matrix( [0,%i ,0],[%i ,0,0],[0,0,0] ) ], /***>Subgroup reduction */ /* Begin, Job_SU3_SubG */ if Job_SU3_SubG then ( /*print("SU(3) subgroup reduction"), */ /**>U1xU1->SU3 */ embMH: ident(2), embMS: embMH . SR[SL3], embMD: embMS . CL[SL3]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:U1U1_SU3, Z: 0, embM: adddict(embM, [ [Y, Z], dict]), /**>SO(3)->SU(3) */ /* Begin, Job_SU3_SubG_SO3 */ if Job_SU3_SubG_SO3 then ( /*print("Job, SU(3) -> SO(3) reduction"), */ EmbDef: [Hs[1]=H[1]], embMH : zeromatrix(1,2), for i : 1 thru 2 do ( embMH[1,i]: coeff(expand(ev(Hs[1],EmbDef)),H[i]) ), /*end do*/ embMS: SR[SO3]^^(-1) . embMH . SR[SL3], embMD: CM[SO3] . embMS . CM[SL3]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y: SO3_SU2, Z: 'n, embM: adddict(embM, [ [Y, Z], dict]), Y: SO3_SU2, Z: 0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if : Job_SU3_SubG_SO3 */ /**>SU(2)xU(1) -> SU(3) */ /* Begin, Job_SU3_SubG_SU2U1 */ if Job_SU3_SubG_SU2U1 then ( /*print("Job, SU(3) -> SU(2)xU(1)"), */ /*>normal embedding */ embMH : matrix([1,-1]), embMS : SR[SL2]^^(-1) . embMH . SR[SL3], embMD : CM[SL2] . embMS . CM[SL3]^^(-1), QvecH : matrix ( [1,1] ), QvecS : QvecH . SR[SL3], QvecD : QvecS . CM[SL3]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y: SU2U1_SU3, Z: 'n, embM: adddict(embM, [ [Y, Z], dict]), Y: SU2U1_SU3, Z: 0, embM: adddict(embM, [ [Y, Z], dict]), /*>Canonical embedding */ embMD : matrix([1, 1]), embMS : CM[SL2]^^(-1) . embMD . CM[SL3], embMH : SR[SL2] . embMS . SR[SL3]^^(-1), QvecH : matrix ( [-1,2] ), QvecS : QvecH . SR[SL3], QvecD : QvecS . CM[SL3]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y: SU2U1_SU3, Z: 'c, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_SU3_SubG_SU2U1 */ ) /*end if: Job_SU3_SubG*/ )$ /*end if : Job_SU3*/ /****>SU(4) */ /* Begin: Job_SU4 */ if Job_SU4 then ( printf(true, "SU(4),"), /***>RootSystem */ alpha : 'alpha, SRbyONB:[ alpha = matrix( [sqrt(2),0,0], [-1/sqrt(2),sqrt(3/2),0], [0,-sqrt(2/3),2/sqrt(3)] ) ], CMI_SU4: Cmatrix(A3)^^(-1), f: 'f, DBbySR: makelist( f[i]=sum(CMI_SU4[i,j]*alpha[j], j, 1, 3), i, 1, 3), DBbyONB : f = CMI_SU4 . colMatrices( ev( makelist(matrix( alpha[i]),i, 1, 3), SRbyONB)), RootSystemp:[alpha[1],alpha[2],alpha[3], alpha[1]+alpha[2],alpha[2]+alpha[3], alpha[1]+alpha[2]+alpha[3] ], RootSystemm: -1*RootSystemp, RVSp: ev(RootSystemp,SRbyONB), RVSm:ev(RootSystemm,SRbyONB), /* Dynkin basis */ FVS: 'FVS, remarray(FVS), FVS[1]: ev([f[1],-f[1]+f[2],-f[2]+f[3],-f[3]], DBbyONB), FVS[2]: ev([f [2],f[1]-f[2]+f[3],f[1]-f[3],-f[1]+f[3],-f[1]+f[2]-f[3],-f[2]], DBbyONB), FVS[3]:ev([f[3], f[2]-f[3],f[1]-f[2], -f[1]],DBbyONB), /* projection to the SU3 hyperplane */ nv: ev(alpha[1]+2*alpha[2]+3*alpha[3], SRbyONB ), x:'x, y:'y, SU3HPeq: [-(nv[1]*x+nv[2]*y)/nv[3]], /* plot */ /**>Root Plot */ /* proc: RootPlot_SU4 */ RootPlot_SU4() := block( [FVSplot, colorlist, RSplot, SRplot, SU3HP], remarray(FVSplot), colorlist: ["green", "blue", "yellow"], for i : 1 thru 3 do ( FVSplot[i] : append( [color=colorlist[i]], makelist( vector([0,0,0], v) , v , FVS[i])) ), /*end do*/ RSplot: append( [color="red"], makelist(vector([0,0,0], v), v, RVSp), [color="black"], makelist(vector([0,0,0],v) , v, RVSm) ), /* SRplot: append([color="red"], makelist(vector([0,0,0],RVSp[i]) , i, 1, 3), [color="black"], makelist(vector([0,0,0],RVSm[i]), i, 1, 3) ), */ SU3HP: explicit(SU3HPeq[1], x, -1, 1, y, -1, 1), draw3d ( head_angle =10, head_length=0.5, line_width=2, RSplot, FVSplot[1], FVSplot[2], FVSplot[3]), remarray(FVSplot) ), /*end proc: RootPlot_SU4t*/ /***>Subgroups */ /**>SU3xU1->SU4 */ /*Begin, Job_SU4_SubG_SU3 */ if Job_SU4_SubG_SU3 then ( /*print("Job, embedding of SU(3)xU(1) thru SU(4)"), */ /*>standard embedding (Slansky) */ /* HA2[1]=HA3[1]-HA3[3], HA3[2]=HA3[2]-HA3[3]*/ embMH : matrix([1,0,-1],[0,1,-1]), embMS : SR[SL3]^^(-1) . embMH . SR[SL4], embMD : CM[SL3] . embMS . CM[SL4]^^(-1), QvecH : matrix( [1,1,1] ), QvecS : QvecH . SR[SL4], QvecD : QvecS . CM[SL4]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU3U1_SU4, Z:s, embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding */ embMD : matrix([1,1,0],[0,0,1]), embMS :CM[SL3]^^(-1) . embMD . CM[SL4], embMH :SR[SL3] . embMS . SR[SL4]^^(-1), QvecD : matrix( [1,-2,-1] ), QvecS : QvecD . CM[SL4], QvecH : QvecS . SR[SL4]^^(-1), /*=[1,-3,1]*/ embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU3U1_SU4, Z:c, embM: adddict(embM, [ [Y, Z], dict]), Y:SU3U1_SU4, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_SU4_SubG_SU3 */ /**>SU2xSU2xU1->SU4 */ /*Begin, Job_SU4_SubG_SU2SU2U1*/ if Job_SU4_SubG_SU2SU2U1 then ( /*print("Job, embedding of SU(2)xSU(2)xU(1) thru SU(4)"), */ /*>standard embedding*/ embMH1 : matrix( [1,-1,0] ), embMH2 : matrix( [0,0,1] ), embMH: 'embMH, embMS: 'embMS, embMD: 'embMD, for j : 1 thru 2 do ( concat(embMS, j) :: SR[SL2]^^(-1) . ev(concat(embMH, j),eval) . SR[SL4], concat(embMD, j) :: CM[SL2] . ev(concat(embMS, j),eval) . CM[SL4]^^(-1) ) , /*end do*/ QvecH : matrix( [1,1,-1] ), QvecS : QvecH . SR[SL4], QvecD : QvecS . CM[SL4]^^(-1), embMH : colMatrices( [ embMH1, embMH2, QvecH] ), embMS : colMatrices( [ embMS1, embMS2, QvecS] ), embMD : colMatrices( [ embMD1, embMD2, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU2SU2U1_SU4, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding*/ embMD1 : matrix( [1, 1,0] ), embMD2 : matrix( [0,1,1] ), embMH: 'embMH, embMS: 'embMS, embMD: 'embMD, for j : 1 thru 2 do ( concat(embMS, j) :: CM[SL2]^^(-1) . ev(concat(embMD, j),eval) . CM[SL4], concat(embMH, j) :: SR[SL2] . ev(concat(embMS, j),eval) . SR[SL4]^^(-1) ) , /*end do*/ QvecD : matrix( [1, 0, 1] ), QvecS : QvecD . CM[SL4], QvecH : QvecS . SR[SL4]^^(-1), embMH : colMatrices( [ embMH1, embMH2, QvecH] ), embMS : colMatrices( [ embMS1, embMS2, QvecS] ), embMD : colMatrices( [ embMD1, embMD2, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU2SU2U1_SU4, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), Y:SU2SU2U1_SU4, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_SU4_SubG_SU2SU2U1 */ /**>SU2xSU2->SU4 */ /*Begin, Job_SU4_SubG_SU2SU2*/ if Job_SU4_SubG_SU2SU2 then ( /*print("Job, embedding of SU2xSU2 thru SU4"), */ /*>canonical embedding*/ /* this is the Weyl trf w[0,0,0,1]w[0,0,1,0] of the normal embedding*/ embMH1 : matrix( [1,1, -1] ), embMH2 : matrix( [1,-1,1] ), embMH: 'embMH, embMS: 'embMS, embMD: 'embMD, for j : 1 thru 2 do ( concat(embMS, j) :: SR[SL2]^^(-1) . ev(concat(embMH, j),eval) . SR[SL4], concat(embMD, j) :: CM[SL2] .ev( concat(embMS, j) ,eval). CM[SL4]^^(-1) ), /*end do*/ embMH : colMatrices( [ embMH1, embMH2] ), embMS : colMatrices( [ embMS1, embMS2] ), embMD : colMatrices( [ embMD1, embMD2] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU2SU2_SU4, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), Y:SU2SU2_SU4, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_SU4_SubG_SU2SU2 */ /**>Sp2->SU4 */ /* Begin, Job_SU4_SubG_Sp2*/ if Job_SU4_SubG_Sp2 then ( /*print("Job, embedding of Sp2 thru SU4"), */ /* SO5->SO6*/ embMH_SO5SO6: matrix( [1,0,0], [0,1,0] ), SR1: rowMatrices([covect([0,1,-1]), covect([1,-1,0]), covect([0,1,1])]), embMS_SO5SO6 : SR[SO5]^^(-1) . embMH_SO5SO6 . SR1, embMD_SO5SO6 : CM[SO5] . embMS_SO5SO6 . CM[SO6]^^(-1), /*Sp2->SU4 */ embMH : matrix( [1,1],[1,-1] ) . embMH_SO5SO6 . matrix( [1,1,0],[1,0,-1],[0,1,-1])^^(-1), embMS : SR[Sp2]^^(-1) . embMH . SR[SL4], embMD : CM[Sp2] . embMS . CM[SL4]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:Sp2_SU4, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_SU4_SubG_Sp2*/ )$ /*end if: Job_SU4 */ /****>SU(5) */ /* Begin, Job_SU5 */ if Job_SU5 then ( printf(true, "SU(5),"), /***>Weyl trf */ WTD_A4( rv) := WeylTrf(A4,rv,"D"), /***>Root System of SU(5) */ Cartan_SL5 : [ HA4[1]=E[1,1]-E[5,5], HA4[2]=E[2,2]-E[5,5], HA4[3]=E[3,3]-E[5,5], HA4[4]=E[4,4]-E[5,5] ], /***>Subgroup */ /* Begin, Job_SU5_SubG */ if Job_SU5_SubG then ( /*print("Job, Subgroups of SU(5)"), */ /**>SU4xU1->SU5 */ /* Begin, Job_SU5_SubG_SU4U1 */ if Job_SU5_SubG_SU4U1 then ( /*print("Job, SU(5) => SU(4)xU(1)"), */ /*>normal embedding */ embMH : matrix( [1,0,0,-1],[0,1,0,-1],[0,0,1,-1]), embMS : SR[SL4]^^(-1) . embMH . SR[SL5], embMD : CM[SL4] . embMS . CM[SL5]^^(-1), QvecH : matrix([1,1,1,1]), QvecS : QvecH . SR[SL5], QvecD : QvecS . CM[SL5]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU4U1_SU5, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), Y:SU4U1_SU5, Z:0, embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding */ embMD : rowMatrices([covect([1,0,0]), covect([0,1,0]), covect([0,1,0]), covect([0,0,1])]), embMS : CM[SL4]^^(-1) . embMD . CM[SL5], embMH : SR[SL4] . embMS . SR[SL5]^^(-1), QvecD : matrix([1,2,-2,-1]), QvecS : QvecH . CM[SL5], QvecD : QvecS . SR[SL5]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU4U1_SU5, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ WTDs: WTD_A4([0,0,0,1]).WTD_A4([0,1,1,0]).WTD_A4([0,0,1,0]), embMD : embMD . WTDs, embMS : blockMatrices([CM[SL4], ident(1)])^^(-1) . embMD . CM[SL5], embMH : blockMatrices([SR[SL4], ident(1)]) . embMS . SR[SL5]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU4U1_SU5, Z:'s, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_SU5_SubG_SU4U1 */ /**>SU(3)xSU(2)xU(1) */ /* Begin, Job_SU5_SubG_SU3SU2U1 */ if Job_SU5_SubG_SU3SU2U1 then ( /*print("SU(5) => SU(3)xSU(2)xU(1)"), */ /*> SU(3)xSU(2)xU(1) standard model */ if false then ( remarray(quark, lepton), quark[UL]:[2/3, 1/2], quark[DL]:[-1/3,-1/2], quark[URc]:[-2/3,0], quark[DRc]:[1/3,0], lepton[nuL]:[0,1/2], lepton[eL]:[-1,-1/2], lepton[eRc]:[1,0], x:'x, y:'y, Ydef : x*Qem+y*I3, remarray(Y), for ps in [UL, DL, URc, DRc] do ( Y[ps] :: ev(Ydef, Qem=quark[ps][1], I3=quark[ps][2]) ), /*end do*/ for ps in [nuL, eL, eRc] do ( Y[ps] :: ev(Ydef, Qem=lepton[ps][1], I3=lepton[ps][2]) ), /*end do*/ sol : solve([Y[UL]=Y[DL],Y[nuL]=Y[eL]], [x,y] ), remarray(Y, quark, lepton) ), /*end if*/ /*> canonical embedding */ /* embedding, SU(3)->SU(5) */ embMD3 : rowMatrices([covect([1,0]), covect([1,0]), covect([0,1]), covect([0,1])]), embMS3 : CM[SL3]^^(-1) . embMD3 . CM[SL5], embMH3 :SR[SL3] . embMS3 . SR[SL5]^^(-1), /* embedding, SU(2) ->SU(5) */ embMD2 : matrix( [0,1,1,0] ), embMS2 : CM[SL2]^^(-1) . embMD2 . CM[SL5], embMH2 : SR[SL2].embMS2 .SR[SL5]^^(-1), /* embedding, U(1) ->SU(5) */ QemD_SU5 : 1/3*[-1,2,1,1], I3D : 1/2*[0,1,1,0], QvecD : matrix( 2*(QemD_SU5 - I3D) ), QvecS : QvecD . CM[SL5], QvecH :QvecS .SR[SL5]^^(-1), embMH : colMatrices( [ embMH3, embMH2, QvecH] ), embMS : colMatrices( [ embMS3, embMS2, QvecS] ), embMD : colMatrices( [ embMD3, embMD2, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU3SU2U1_SU5, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky type */ Y:SU3SU2U1_SU5, Z:'s, embM: adddict(embM, [ [Y, Z], dict]), /*>normal embedding */ /* embedding, SU(3)->SU(5) */ /* HA3[1]=HA4[1]-HA4[3], HA3[2]=HA4[2]-HA4[3] */ embMH3 : matrix( [1,0,-1,0],[0,1,-1,0] ), embMS3 : SR[SL3]^^(-1) . embMH3 . SR[SL5], embMD3 : CM[SL3].embMS3 . CM[SL5]^^(-1), /* embedding, SU(2) ->SU(5) */ embMH2 : matrix( [0, 0, 0, 1] ), embMS2 : SR[SL2]^^(-1) . embMH2 . SR[SL5], embMD2 : CM[SL2].embMS2 . CM[SL5]^^(-1), /* embedding, U(1) ->SU(5) */ q:-1/3, QvecH : q*matrix( [2,2,2,-3] ), QvecS : QvecH . SR[SL5], QvecD : QvecS . CM[SL5]^^(-1), embMH : colMatrices( [ embMH3, embMH2, QvecH] ), embMS : colMatrices( [ embMS3, embMS2, QvecS] ), embMD : colMatrices( [ embMD3, embMD2, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU3SU2U1_SU5, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y:SU3SU2U1_SU5, Z:0, embM: adddict(embM, [ [Y, Z], dict]), /*>SU3xU1em */ MH: embMH, MS : embMS, MD : embMD, embMH: 'embMH, embMS : 'embMS, embMD : 'embMD, for X in [H, S, D] do ( concat('embM, X) :: rowMatrices([ colMatrices([ident(2), zeromatrix(1,2)]), colMatrices([zeromatrix(2,2), matrix([1/2,1/2])]) ]) . ev(concat('M, X)) ), /*end do*/ dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU3U1em_SU5, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_SU5_SubG_SU3SU2U1 */ /**>SO(5) */ /* Begin, Job_SU5_SubG_SO5 */ if Job_SU5_SubG_SO5 then ( /* print("SU(5) => SO(5)"), */ embMH : matrix([1,0,0,0],[0,1,0,-1]), embMS : SR[SO5]^^(-1).embMH . SR[SL5], embMD : CM[SO5] . embMS . CM[SL5]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SO5_SU5, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y:SO5_SU5, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_SU5_SubG_SO5 */ ) /*end if: Job_SU5_SubG" */ )$ /*end if: Job_SU5 */ /****>SU(6) */ /* Begin, Job_SU6 */ if Job_SU6 then ( printf(true, "SU(6),"), /***>Weyl Trf */ WTD_A5 (rv) := WeylTrf(A5,rv,"D"), /***>Root System of SU(6) */ Cartan_SL6: makelist( HA[i]=E[i,i]-E[6,6], i, 1, 5), /***>Subalgebras */ /**>SU5xU1 */ /* Begin, Job_SU6_SubG_SU5U1 */ if Job_SU6_SubG_SU5U1 then ( /* print("Subalgbra, su5+u1"), */ /*>normal embedding =Slansky */ embMD : rowMatrices([covect([0,0,0,0]), covect([1,0,0,0]), covect([0,1,0,0]), covect([0,0,1,0]), covect([0,0,0,1])]), c:'c, Qv: [5, c[1], c[2], c[3], c[4]], eqs: makelist( inprod(covect(Qv), Kmetric(A5).transpose(row(embMD, i)))[1,1], i, 1, 4), sol : linsolve(eqs, makelist(c[i],i, 1, 4)), QvecD : matrix(ev(Qv,sol)), embMD : colMatrices([embMD, QvecD]), embMS : blockMatrices([CM[SL5],ident(1)])^^(-1) . embMD . CM[SL6], embMH : blockMatrices([SR[SL5],ident(1)]) . embMS . SR[SL6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU5U1_SU6, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y:SU5U1_SU6, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) , /*end ir: Job_SU6_SubG_SU5U1 */ /**>SU4xSU2xU1 */ /* Begin, Job_SU6_SubG_SU4SU2U1 */ if Job_SU6_SubG_SU4SU2U1 then ( /* print("Subalgbra, su4+su2"), */ /*>normal embedding */ embMD : rowMatrices( [covect([1,0,0,0]), covect([0,1,0,0]), covect([0,0,1,0]), covect([0,0,0,0]), covect([0,0,0,1])]), c : 'c, Qv:[c[1],c[2],c[3],4,c[4]], eqs: makelist( inprod( covect(Qv), Kmetric(A5) . transpose(row(embMD, i)))[1,1], i, 1, 4), sol:solve(eqs, makelist(c[i], i, 1, 4)), QvecD : matrix(ev(Qv,sol)), embMD : colMatrices([ embMD, QvecD]), embMS : blockmatrices([ CM[SL4] , CM[SL2],1])^^(-1) . embMD . CM[SL6], embMH : blockMatrices([SR[SL4], SR[SL2],1]) . embMS . SR[SL6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU4SU2U1_SU6, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ WTDs : WTD_A5([1,1,1,0,0]) . WTD_A5([0,0,1,1,1]) . WTD_A5([0,1,1,0,0]) . WTD_A5([0,0,1,1,0]), embMD : embMD . WTDs, embMS : blockMatrices([CM[SL4],CM[SL2],ident(1)])^^(-1) . embMD . CM[SL6], embMH : blockMatrices([SR[SL4],SR[SL2],ident(1)]) . embMS . SR[SL6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU4SU2U1_SU6, Z : 's, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Z:0, embM : adddict( embM, [ [Y, Z], getdict(embM, [Y, 'n])] ) ) , /*end if: Job_SU6_SubG_SU4SU2U1 */ /**>SU3xSU3xU1 */ /* Begin, Job_SU6_SubG_SU3SU3U1 */ if Job_SU6_SubG_SU3SU3U1 then ( /*print("Subalgbra, su3+su3+u1"), */ /*>normal embedding */ embMD : rowMatrices([covect([1,0,0,0]), covect([0,1,0,0]), covect([0,0,0,0]), covect([0,0,1,0]), covect([0,0,0,1])]), c : 'c, Qv:[c[1],c[2],3,c[3],c[4]], eqs : makelist(inprod(covect(Qv), Kmetric(A5) . transpose(row(embMD, i)))[1,1], i, 1, 4), sol : solve(eqs,makelist(c[i], i, 1, 4)), QvecD : matrix(ev(Qv,sol)), embMD : colMatrices([ embMD, QvecD ]), embMS : blockMatrices([CM[SL3],CM[SL3],ident(1)])^^(-1) . embMD . CM[SL6], embMH : blockMatrices([SR[SL3],SR[SL3],ident(1)]) . embMS . SR[SL6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU3SU3U1_SU6, Z : 'n, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ WTDs : WTD_A5([1,1,0,0,0]) . WTD_A5([0,1,1,0,0]) . WTD_A5([0,0,0,1,0]), embMD : embMD . WTDs, embMS : blockMatrices([CM[SL3],CM[SL3],ident(1)])^^(-1) . embMD . CM[SL6], embMH : blockMatrices([SR[SL3],SR[SL3],ident(1)]) . embMS . SR[SL6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU3SU3U1_SU6, Z : 's, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Z:0, embM : adddict( embM, [ [Y, Z], getdict(embM, [Y, 'n])] ) ), /*end if: Job_SU6_SubG_SU3SU3U1 */ /**>SU4 (special) */ /* Begin, Job_SU6_SubG_SU4 */ if Job_SU6_SubG_SU4 then ( /*print("Subalgbra, su4 (special)"),*/ /*>normal embedding */ embMS : rowMatrices([covect([0,1,0]), covect([1,0,0]), covect([-1,0,1]), covect([1,0,0]), covect([0,1,0])]), embMH : SR[SL4] . embMS .SR[SL6]^^(-1), embMD : CM[SL4] . embMS .CM[SL6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU4_SU6, Z : 'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Z:0, embM : adddict( embM, [ [Y, Z], getdict(embM, [Y, 'n])] ) ), /*end if: Job_SU6_SubG_SU4 */ /**>SU3 (special) */ /* Begin, Job_SU6_SubG_SU3 */ if Job_SU6_SubG_SU3 then ( /*print("Subalgbra, su3 (special)"), */ /*>normal embedding */ embMS : rowMatrices([covect([1,0]), covect([1,0]), covect([-1,1]), covect([1,0]), covect([0,1])]), embMD : CM[SL3] . embMS . CM[SL6]^^(-1), embMH : SR[SL3] . embMS . SR[SL6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU3_SU6, Z : 'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Z:0, embM : adddict( embM, [ [Y, Z], getdict(embM, [Y, 'n])] ) ), /*end if: Job_SU6_SubG_SU3 */ /**>SU3xSU2 (special) */ /* Begin, Job_SU6_SubG_SU3SU2 */ if Job_SU6_SubG_SU3SU2 then ( /*print("Subalgbra, su3+su2 (special)"), */ /*>normal embedding */ embMS : rowMatrices([covect([1,0,0]), covect([-1,0,1]), covect([1,1,-1]), covect([0,-1,1]), covect([0,1,0])]), embMD : blockMatrices([CM[SL3], CM[SL2]]) . embMS . CM[SL6]^^(-1), embMH : blockMatrices([SR[SL3], SR[SL2]]) . embMS . SR[SL6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:SU3SU2_SU6, Z : 'n, embM: adddict(embM, [ [Y, Z], dict]), /* default embM */ Z:0, embM : adddict( embM, [ [Y, Z], getdict(embM, [Y, 'n])] ) ), /*end if: Job_SU6_SubG_SU3SU2 */ /**>Sp3 (special) */ /* Begin, Job_SU6_SubG_Sp3 */ if Job_SU6_SubG_Sp3 then ( /* print("Subalgbra, sp3 (special)"), */ /*>normal embedding */ embMS : rowMatrices([covect([1,0,0]), covect([0,1,0]), covect([0,0,1]), covect([0,1,0]), covect([1,0,0])]), embMH : SR[Sp3] . embMS . SR[SL6]^^(-1), embMD : CM[Sp3] . embMS . CM[SL6]^^(-1), /*> default embM */ dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y:Sp3_SU6, Z : 0, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_SU6_SubG_Sp3 */ )$ /*end if: Job_SU6 */ /*****>Type B */ /****>SO(5) */ /* Begin, Job_SO5 */ if Job_SO5 then ( printf(true, "SO(5), "), /***>Algebra */ /* Basis */ H: 'H, E: 'E, CartanBasis[SO5]: [ H[1]=-I*(E[1,2]-E[2,1]), H[2]=-I*(E[3,4]-E[4,3]) ], /***>Subgroups */ /**>SU2xU1 -> SO5 */ /* Begin, Job_SO5_SubG_SU2U1 */ if Job_SO5_SubG_SU2U1 then ( /*print("Job: Regular subgroup SU2xU1"), */ /*>normal Embedding */ embMH : matrix([0,2]), embMS : SR[SL2]^^(-1) . embMH . SR[SO5], embMD : CM[SL2] . embMS . CM[SO5]^^(-1), QvecH : matrix( [2,0] ), QvecS : QvecH . SR[SO5], QvecD : QvecS . CM[SO5]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2U1_SO5, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding */ embMD : matrix( [2,1] ), embMS : CM[SL2]^^(-1).embMD . CM[SO5], embMH : SR[SL2].embMS . SR[SO5]^^(-1), QvecD : matrix([0,1]), QvecS : QvecD . CM[SO5], QvecH : QvecS . SR[SO5]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2U1_SO5, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y: SU2U1_SO5, Z:0, embM : adddict( embM, [ [Y, Z], getdict(embM, [Y, 'n])] ) ) , /*end if: Job_SO5_SubG_SU2U1 */ /**>SU2xSU2 */ /* Begin, Job_SO5_SubG_SU2SU2 */ if Job_SO5_SubG_SU2SU2 then ( /* print("Job: Regular subgroup SU2xSU2=SO4->SO5"), */ /*> normal embedding */ embMH2 : matrix([1,-1]), embMH3 : matrix([1,1]), embMS: 'embMS, embMH : 'embMH, embMD: 'embMD, for i : 2 thru 3 do ( concat('embMS, i) :: SR[SL2]^^(-1) . ev(concat('embMH, i),eval).SR[SO5], concat('embMD, i) :: CM[SL2] . ev(concat('embMS, i), eval) . CM[SO5]^^(-1) ), /*end do*/ embMH : colMatrices( [ embMH2, embMH3] ), embMS : colMatrices( [ embMS2, embMS3] ), embMD : colMatrices( [ embMD2, embMD3] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2SU2_SO5, Z:'n1, embM: adddict(embM, [ [Y, Z], dict]), /*>the choice based on the extended Dynkin diagram */ embMS4 : matrix([1,-1/2]), embMS5 : matrix([0,-1/2]), embMS: 'embMS, embMH : 'embMH, embMD: 'embMD, for i : 4 thru 5 do ( concat('embMH, i) :: SR[SL2] . ev(concat('embMS, i),eval).SR[SO5]^^(-1), concat('embMD, i) :: CM[SL2] . ev(concat('embMS, i), eval) . CM[SO5]^^(-1) ), /*end do*/ embMH : colMatrices( [ embMH4, embMH5] ), embMS : colMatrices( [ embMS4, embMS5] ), embMD : colMatrices( [ embMD4, embMD5] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2SU2_SO5, Z:'n2, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y: SU2U1_SO5, Z:0, embM : adddict( embM, [ [Y, Z], getdict(embM, [Y, 'n1])] ) ) , /*end if: Job_SO5_SubG_SU2SU2 */ /**>SU2 (special) */ /* Begin, Job_SO5_SubG_SU2max */ if Job_SO5_SubG_SU2max then ( /* print("Job: Special maximal subgroup SU2"), */ /*embedding */ embMH : matrix([4,2]), embMS : SR[SL2]^^(-1) . embMH . SR[SO5], embMD : CM[SL2] . embMS . CM[SO5]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2_SO5, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y: SU2U1_SO5, Z:0, embM : adddict( embM, [ [Y, Z], getdict(embM, [Y, 'n])] ) ) /*end if: Job_SO5_SubG_SU2max */ )$ /*end if: Job_SO5*/ /****>SO(7) */ /* Bein, Job_SO7 */ if Job_SO7 then ( printf(true, "SO(7),"), /***>Algebra */ /* Basis */ H: 'H, E: 'E, CartanBasis[SO7]: [ H[1]=-I*(E[1,2]-E[2,1]), H[2]=-I*(E[3,4]-E[4,3]), H[3]=-I*(E[5,6]-E[6,5]) ], /***>Subgroups */ /**>SU4 (regular)->SO(7) */ /* Begin, Job_SO7_SubG_SU4 */ if Job_SO7_SubG_SU4 then ( /* print("Job: Regular maximal subgroup SU4"), */ /*>Normal embedding*/ embMH : matrix([1,1,0],[1,0,-1],[0,1,-1]), embMS : SR[SL4]^^(-1).embMH . SR[SO7], embMD : CM[SL4].embMS . CM[SO7]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU4_SO7, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky type embedding */ /* n=>s , special trf alpha1 <-> alpha3 in SU4 */ Y: SU4_SO7, Z: s, embMS : matrix([0,0,1],[0,1,0],[1,0,0]). embMS, embMH : SR[SL4] . embMS . SR[SO7]^^(-1), embMD : CM[SL4] . embMS . CM[SO7]^^(-1). dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU4_SO7, Z:'s, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y: SU2U1_SO5, Z:0, embM : adddict( embM, [ [Y, Z], getdict(embM, [Y, 'n])] ) ) , /*end if: Job_SO7_SubG_SU4 */ /**>SO5xU1 (regular) */ /* Begin, Job_SO7_SubG_SO5U1 */ if Job_SO7_SubG_SO5U1 then ( /* print("Job: Regular maximal subgroup SO5xU1"), */ /* normal Embedding */ embMH : matrix([0,1,0],[0,0,1]), embMS : SR[SO5]^^(-1) . embMH . SR[SO7], embMD : CM[SO5] .embMS . CM[SO7]^^(-1), QvecH : matrix([1,0,0] ), QvecS : QvecH .SR[SO7], QvecD : QvecS .CM[SO7]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO5U1_SO7, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU5U1_SO7, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_SO7_SubG_SO5U1 */ /**>SU2xSU2xSU2 (regular) */ /* Begin, Job_SO7_SubG_SU2SU2SU2 */ if Job_SO7_SubG_SU2SU2SU2 then ( /* print("Regular maximal subgroup SU2xSU2xSU2"), */ /*> Embedding */ mbMH1 : matrix([1,-1,0]), embMH2 : matrix([1,1,0]), embMH3 : matrix([0,0,2]), embMS: 'embMS, embMH : 'embMH, embMD: 'embMD, for i : 1 thru 3 do ( concat('embMS, i) :: SR[SL2]^^(-1). ev(concat('embMH, i), eval) . SR[SO7], concat('embMD,i) :: CM[SL2] . ev(concat('embMS,i),eval) . CM[SO7]^^(-1) ), /*end do */ embMH : colMatrices( [ embMH1, embMH2, embMH3] ), embMS : colMatrices( [ embMS1, embMS2, embMS3] ), embMD : colMatrices( [ embMD1, embMD2, embMD3] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2SU2SU2_SO7, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU2SU2SU2_SO7, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) , /*end if: Job_SO7_SubG_SU4*/ /**>G2 (special) */ /* Begin, Job_SO7_SubG_G2 */ if Job_SO7_SubG_G2 then ( /* print("Special subgroup G2"), */ Y: G2_SO7, Z: n, embMS : matrix([0,1,0],[1,0,1]), embMH : SR[G2] . embMS . SR[SO7]^^(-1), embMD : CM[G2].embMS .CM[SO7]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : G2_SO7, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : G2_SO7, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_SO7_SubG_G2 */ )$ /*end if: Job_SO7 */ /****>SO(9) */ /* Begin, Job_SO9 */ if Job_SO9 then ( printf(true, "SO(9), "), /***>Weyl Trf */ WTD_B4 (rv) := WeylTrf(B4,rv,"D"), /***>Algebra */ /* Basis */ H: 'H, E: 'E, CartanBasis[SO9]: [ H[1]=-I*(E[1,2]-E[2,1]), H[2]=-I*(E[3,4]-E[4,3]), H[3]=-I*(E[5,6]-E[6,5]), H[4]=-I*(E[7,8]-E[8,7]) ], /***>Subgroups */ /**>SO8 -> SO9*/ /*% Begin, Job_SO9_SubG_SO8 */ if Job_SO9_SubG_SO8 then ( /*print("Embedding so8 to so9"), */ /*>normal embedding */ embMH : matrix([1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]), embMS : SR[SO8]^^(-1).embMH . SR[SO9], embMD : CM[SO8] . embMS .CM[SO9]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO8_SO9, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ embMD : embMD . WeylTrf(B4,[0,0,0,1],"D"), embMS : embMS . WeylTrf(B4,[0,0,0,1],"S"), embMH : SR[SO8] . embMS . SR[SO9]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO8_SO9, Z:'s, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SO8_SO9, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_SO9_SubG_SO8*/ /**>SO7xU1 */ /* Begin, Job_SO9_SubG_SO7U1 */ if Job_SO9_SubG_SO7U1 then ( /* print("Embedding so7+u1 to so9"), */ embMH : matrix([0,1,0,0],[0,0,1,0],[0,0,0,1]), embMS : SR[SO7]^^(-1) . embMH . SR[SO9], embMD : CM[SO7] . embMS . CM[SO9]^^(-1), QvecH : matrix([1,0,0,0]), QvecS : QvecH . SR[SO9], QvecD : QvecS . CM[SO9]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO7U1_SO9, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SO7U1_SO9, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_SO9_SubG_SO7U1 */ /**>SU4xSU2 */ /* Begin, Job_SO9_SubG_SU4SU2 */ if Job_SO9_SubG_SU4SU2 then ( /* print("Embedding su4+su2 to so9"), */ /*>normal embedding */ Z: n, embMH4 : matrix([1,1,0,0],[1,0,-1,0],[0,1,-1,0]), embMS4 : SR[SL4]^^(-1) . embMH4 . SR[SO9], embMD4 : CM[SL4] . embMS4 . CM[SO9]^^(-1), embMH2 : matrix([0,0,0,2]), embMS2 : SR[SL2]^^(-1) . embMH2 . SR[SO9], embMD2 : CM[SL2] . embMS2 . CM[SO9]^^(-1), embMH : colMatrices( [ embMH4, embMH2 ] ), embMS : colMatrices( [ embMS4, embMS2 ] ), embMD : colMatrices( [ embMD4, embMD2 ] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU4SU2_SO9, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ WTDs: WTD_B4([1,1,1,2]).WTD_B4([0,0,1,2]).WTD_B4([0,1,1,2]).WTD_B4([0,0,1,0]).WTD_B4([0,0,0,1]), embMD : embMD . WTDs, embMS : blockMatrices([CM[SL4],CM[SL2]])^^(-1) . embMD . CM[SO9], embMH : blockMatrices([SR[SL4],SR[SL2]]) . embMS . SR[SO9]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU4SU2_SO9, Z:'s, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ embM : adddict(embM, [ [Y,0], getdict(embM, [Y, 'n])]) ), /*end if: Job_SO9_SubG_SU4SU2 */ /**> SU2xSU2xSp2 -> SO9 */ /* Begin, Job_SO9_SubG_Sp2SU2SU2 */ if Job_SO9_SubG_Sp2SU2SU2 then ( /* print("Embedding SU2xSU2xSp2 to SO9"), */ /* SU2-> SO9 */ embMH1: matrix([1,-1,0,0]), embMH2: matrix([1,1,0,0]), embMS: 'embMS, embMH : 'embMH, embMD: 'embMD, for i : 1 thru 2 do ( concat('embMS,i) :: SR[SL2]^^(-1) . ev(concat('embMH,i),eval) . SR[SO9], concat('embMD,i) :: CM[SL2] . ev(concat('embMS,i),eval) . CM[SO9]^^(-1) ), /*end do */ embMH3 : matrix([0,0,1,1],[0,0,1,-1]), embMS3 : SR[Sp2]^^(-1) . embMH3 . SR[SO9], embMD3 : CM[Sp2] . embMS3 . CM[SO9]^^(-1), embMH : colMatrices( [ embMH1, embMH2, embMH3] ), embMS : colMatrices( [ embMS1, embMS2, embMS3] ), embMD : colMatrices( [ embMD1, embMD2, embMD3] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2SU2Sp2_SO9, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU2SU2Sp2_SO9, Z:'0, embM: adddict(embM, [ [Y, Z], dict]) ) , /*end if: Job_SO9_SubG_Sp2SU2SU2 */ /**>max SU2 */ /* Begin, Job_SO9_SubG_SU2 */ if Job_SO9_SubG_SU2 then ( /* print("Embedding max su2 to so9"), */ embMH : matrix([8,6,4,2]), embMS : SR[SL2]^^(-1) . embMH . SR[SO9], embMD : CM[SL2] . embMS . CM[SO9]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], /*> default embM */ Y : SU2_SO9, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_SO9_SubG_SU2 */ /**> max SU2xSU2 -> SO9 */ /* Begin, Job_SO9_SubG_SU2SU2 */ if Job_SO9_SubG_SU2SU2 then ( /* print("Embedding max SU2xSU2 to SO9"), */ /* SU2-> SO9 */ embMH1 : matrix([2,2,0,2]), embMH2 : matrix([2,0,2,-2]), embMS: 'embMS, embMH : 'embMH, embMD: 'embMD, for i : 1 thru 2 do ( concat('embMS, i) :: SR[SL2]^^(-1 ) . ev(concat('embMH, i), eval) . SR[SO9], concat('embMD, i) :: CM[SL2] . ev(concat('embMS,i),eval) . CM[SO9]^^(-1) ), /*end do */ embMH : colMatrices( [ embMH1, embMH2] ), embMS : colMatrices( [ embMS1, embMS2] ), embMD : colMatrices( [ embMD1, embMD2] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2SU2_SO9, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU2SU2_SO9, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_SO9_SubG_SU2SU2 */ )$ /*end if: Job_SO9 */ /*****>Type C */ /****>Sp3 */ /*Begin, Job_Sp3*/ if Job_Sp3 then ( printf(true, "Sp3,"), /***>Algebra */ /* Basis of sp3 */ CartanBasis[Sp3]: [ H[1]=E[1,1]-E[6,6], H[2]=E[2,2]-E[5,5], H[3]=E[3,3]-E[4,4] ], /***>Weyl Trf */ WTD_C3 (rv) := WeylTrf(C3,rv,"D"), /***>Subalgebras */ /**>SU3xU1 */ /* Begin, Job_Sp3_SubG_SU3U1 */ if Job_Sp3_SubG_SU3U1 then ( /* print("Subalgebra su3+u1 of sp3"), */ embMH : matrix([1,-1,0],[0,1,-1]), AM_SL3 : matrix([2, -1],[-1,2]), embMS : AM_SL3^^(-1) . embMH . SR[Sp3], embMD : CM[SL3] . embMS . CM[Sp3]^^(-1), QvecH : matrix([1,1,1]), QvecS : QvecH . SR[Sp3], QvecD : QvecS . CM[Sp3]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU3U1_Sp3, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU3U1_Sp3, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_Sp3_SubG_SU3U1 */ /**>Sp2xSU2 */ /* Begin, Job_Sp3_SubG_Sp2SU2 */ if Job_Sp3_SubG_Sp2SU2 then ( /* print("Subalgebra sp2+su2 of sp3"), */ /*>normal embedding (1) */ Y: Sp2SU2_Sp3, embMS : rowMatrices([covect([-1,-1/2,-1]), covect([1,0,0]), covect([0,1,0])]), embMD : blockMatrices([CM[Sp2],CM[SL2]]) . embMS . CM[Sp3]^^(-1), embMH : blockMatrices([SR[Sp2],SR[SL2]]) . embMS . SR[Sp3]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : Sp2SU2_Sp3, Z:'n1, embM: adddict(embM, [ [Y, Z], dict]), /*>normal embedding (2) */ embMH2 : matrix([0,1,0],[0,0,1]), embMS2 : SR[Sp2]^^(-1) . embMH2 . SR[Sp3], embMD2 : CM[Sp2] . embMS2 . CM[Sp3]^^(-1), embMH1 : matrix([1,0,0]), embMS1 : SR[SL2]^^(-1) . embMH1 . SR[Sp3], embMD1 : CM[SL2] . embMS1 . CM[Sp3]^^(-1), embMH : colMatrices( [ embMH2, embMH1 ]), embMS : colMatrices( [ embMS2, embMS1] ), embMD : colMatrices( [ embMD2, embMD1] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : Sp2SU2_Sp3, Z:'n2, embM: adddict(embM, [ [Y, Z], dict]), /* embM [Sp2SU2_Sp3, n2][S][1] =WeylTrf(C2,"S") . embM [Sp2SU2_Sp3,n1][S][1] */ /*>canonical embedding */ Y: Sp2SU2_Sp3,Z: c, WTDs: WTD_C3([1,0,0]) . WTD_C3([0,1,0]), embMD : embMD . WTDs, embMS : blockMatrices([CM[Sp2],CM[SL2]])^^(-1) . embMD . CM[Sp3], embMH : blockMatrices([SR[Sp2],SR[SL2]]) . embMS . SR[Sp3]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : Sp2SU2_Sp3, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y: Sp2SU2_Sp3, Z:0, embM : adddict( embM, [ [Y, Z], getdict(embM, [Y, 'n1])] ) ), /*end if: Job_Sp3_SubG_Sp2SU2*/ /**>SU2 */ /* Begin, Job_Sp3_SubG_SU2*/ if Job_Sp3_SubG_SU2 then ( /* print("Maximal subalgebra su2 of sp3"), */ /*>normal embedding */ embMH : matrix([5,3,1]), embMS : SR[SL2]^^(-1) . embMH . SR[Sp3], embMD : CM[SL2] . embMS . CM[Sp3]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2_Sp3, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU2_Sp3, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_Sp3_SubG_SU2 */ /**>SU2xSU2 */ /* Begin, Job_Sp3_SubG_SU2SU2 */ if Job_Sp3_SubG_SU2SU2 then ( /* print("Maximal subalgebra su2+su2 of sp3"), */ embMH1 : matrix([1,1,1]), embMH2 : matrix([2,0,-2]), embMH : 'embMH, embMS : 'embMS, embMD : 'embMD, for i : 1 thru 2 do ( concat('embMS, i) :: SR[SL2]^^(-1) . ev(concat('embMH, i),eval) . SR[Sp3], concat('embMD,i) :: CM[SL2] . ev(concat('embMS,i),eval) . CM[Sp3]^^(-1) ), /*end do*/ embMH : colMatrices( [ embMH1, embMH2] ), embMS : colMatrices( [ embMS1, embMS2] ), embMD : colMatrices( [ embMD1, embMD2] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2SU2_Sp3, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU2SU2_Sp3, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_Sp3_SubG_SU2SU2 */ )$ /*end if: Job_Sp3 */ /****>Sp4 */ /* Begin, Job_Sp4 */ if Job_Sp4 then ( printf(true, "Sp4,"), /***>Algebra */ /* Basis of sp4 */ CartanBasis[Sp4]: [ H[1]=E[1,1]-E[8,8], H[2]=E[2,2]-E[7,7], H[3]=E[3,3]-E[6,6], H[4]=E[4,4]-E[5,5] ], /***>Subalgebras */ /**>SU4xU1 */ /* Begin, Job_Sp4_SubG_SU4U1 */ if Job_Sp4_SubG_SU4U1 then ( /* print("Subalgebra su4+u1 of sp4"), */ /*>normal embedding */ embMH : matrix([1, 0, 0, -1],[0,1,0,-1],[0,0,1,-1]), embMS : SR[SL4]^^(-1) . embMH . SR[Sp4], embMD : CM[SL4] . embMS . CM[Sp4]^^(-1), QvecH : matrix([1,1,1,1]), QvecS : QvecH . SR[Sp4], QvecD : QvecS . CM[Sp4]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU4U1_Sp4, Z:'n, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_Sp4_SubG_SU4U1 */ /**>Sp3xSU2 */ /* Begin, Job_Sp4_SubG_Sp3SU2*/ if Job_Sp4_SubG_Sp3SU2 then ( /* print("Subalgebra sp3+su2 of sp4"), */ /*>normal embedding */ embMH1: matrix([0, 1, 0, 0],[0,0,1,0],[0,0,0,1]), embMS1: SR[Sp3]^^(-1) . embMH1 . SR[Sp4], embMD1: CM[Sp3] . embMS1 . CM[Sp4]^^(-1), embMH2: matrix([1, 0, 0, 0]), embMS2: SR[SL2]^^(-1) . embMH2 . SR[Sp4], embMD2: CM[SL2] . embMS2 . CM[Sp4]^^(-1), embMH : colMatrices( [ embMH1, embMH2] ), embMS : colMatrices( [ embMS1, embMS2] ), embMD : colMatrices( [ embMD1, embMD2] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : Sp3SU2_Sp4, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : Sp3SU2_Sp4, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_Sp4_SubG_So3SU2 */ /**>Sp2xSp2 */ /* Begin, Job_Sp4_SubG_Sp2Sp2 */ if Job_Sp4_SubG_Sp2Sp2 then ( /* print("Subalgebra sp2+sp2 of sp4"), */ /*>normal embedding*/ embMH1 : matrix([1, 0, 0, 0],[0,1,0,0]), embMH2 : matrix([0, 0, 1, 0],[0,0,0,1]), embMH : 'embMH, embMS : 'embMS, embMD : 'embMD, for i : 1 thru 2 do ( concat('embMS, i) :: SR[Sp2]^^(-1) . ev(concat('embMH, i),eval) . SR[Sp4], concat('embMD,i) :: CM[Sp2] . ev(concat('embMS,i),eval) . CM[Sp4]^^(-1) ), /*end do*/ embMH : colMatrices( [ embMH1, embMH2] ), embMS : colMatrices( [ embMS1, embMS2] ), embMD : colMatrices( [ embMD1, embMD2] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : Sp2Sp2_Sp4, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : Sp2Sp2_Sp4, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_Sp2Sp2 */ /**>max SU2 */ /* Begin, Job_Sp4_SubG_SU2 */ if Job_Sp4_SubG_SU2 then ( /* print("Subalgebra max su2 of sp4"), */ /*> normal embedding */ embMH : matrix([7,5,3,1]), embMS : SR[SL2]^^(-1) . embMH . SR[Sp4], embMD : CM[SL2] . embMS . CM[Sp4]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2_Sp4, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU2_Sp4, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_Sp4_SubG_SU2 */ /**>max SU2xSU2xSU2 */ /* Begin, Job_Sp4_SubG_SU2SU2SU2 */ if Job_Sp4_SubG_SU2SU2SU2 then ( /* print("Subalgebra max su2+su2+su2 of sp4"), */ /*>normal embedding */ embMH1 : matrix([1,1,1,-1]), embMH2 : matrix([1,1,-1,1]), embMH3 : matrix([1,-1,1,1]), embMH : 'embMH, embMS : 'embMS, embMD : 'embMD, for i : 1 thru 3 do ( concat('embMS, i) :: SR[SL2]^^(-1) . ev(concat('embMH, i),eval) . SR[Sp4], concat('embMD,i) :: CM[SL2] . ev(concat('embMS,i),eval) . CM[Sp4]^^(-1) ), /*end do*/ embMH : colMatrices( [ embMH1, embMH2, embMH3] ), embMS : colMatrices( [ embMS1, embMS2, embMS3] ), embMD : colMatrices( [ embMD1, embMD2, embMD3] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2SU2SU2_Sp4, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU2SU2SU2_Sp4, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_Sp4_SubG_SU2 */ )$ /*end if: Job_Sp4 */ /****>Sp5 */ /* Begin, Job_Sp5*/ if Job_Sp5 then ( printf(true, "Sp5,"), /***>Subalgebras */ /* incomplete!! */ /**>SU5xU1*/ /* Begin, Job_Sp5_SubG_SU5U1*/ if Job_Sp5_SubG_SU5U1 then ( /* print("Subalgebra su5+u1 of sp4"), */ /*>normal embedding*/ embMD : rowMatrices([ covect([1,0,0,0]), covect([0,1,0,0]), covect([0,0,1,0]), covect([0,0,0,1]), covect([0,0,0,0])]), embMS : CM[SL5]^^(-1) . embMD . CM[Sp5], embMH : SR[SL5] . embMS . SR[Sp5]^^(-1), remarray(q), q : 'q, Qv : cons(1, makelist( q[i], i, 2, 5)), eqs : listme ( embMD . (Gmetric(C5))^^(-1) . covect(Qv) ) , sol : linsolve( eqs, makelist(q[i], i, 2, 5)), QvecD : ev(matrix(Qv), sol), QvecS : QvecD . CM[Sp5], QvecH : QvecS . SR[Sp5]^^(-1), remarray(q), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU5U1_Sp5, Z:'n, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_Sp5_SubG_SU5U1 */ )$ /*end if: End, Job_Sp5 */ /*****>Type D */ /****>SO(8) */ /* Begin, Job_SO8 */ if Job_SO8 then ( printf(true, "SO(8),"), /***>Weyl trf */ WTD_D4(rv) := WeylTrf(D4,rv,"D"), /***>Algebra */ /* Basis of so(8) */ E: 'E, H: 'H, A: 'A, S: 'S, H0:'H0, CartanBasis[SO8]: [ H0[1]=I*(E[1,2]-E[2,1]), H0[2]=I*(E[3,4]-E[4,3]), H0[3]=I*(E[5,6]-E[6,5]), H0[4]=I*(E[7,8]-E[8,7]) ], /***>Subalgebras */ /**>U4=U1xSU4 -> SO8*/ /* Begin, Job_SO8_SubG_SU4U1 */ if Job_SO8_SubG_SU4U1 then ( /*print("Embedding SU4xU1 to SO8"), */ H1: 'H1, CartanBasis[SU4]: [ H1[1]=E[1,1]-E[4,4], H1[2]=E[2,2]-E[4,4], H1[3]=E[3,3]-E[4,4] ], /*>normal embedding */ Hembeding: [H1[1]=H0[1]-H0[4], H1[2]=H0[2]-H0[4], H1[3]=H0[3]-H0[4], H1[4]=H0[1]+H0[2]+H0[3]+H0[4] ], embMH : zeromatrix(3,4), for i : 1 thru 3 do ( for j : 1 thru 4 do ( setelmx( coeff(ev(H1[i],Hembeding),H0[j]), i, j, embMH) ) /*end do*/ ), /*end do*/ embMS : SR[SL4]^^(-1) . embMH. SR[SO8], embMD : CM[SL4] . embMS . CM[SO8]^^(-1), QvecH : zeromatrix(1,4), for i : 1 thru 4 do ( setelmx( coeff(ev( H1[4], Hembeding),H0[i]), 1, i, QvecH ) ), /*end do*/ QvecS : QvecH . SR[SO8], QvecD : QvecS . CM[SO8]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU4U1_SO8, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ WTDs: WTD_D4([1,1,0,1]) . WTD_D4([0,0,0,1]) . WTD_D4([0,1,0,0]), embMD : embMD . WTDs, embMS : blockMatrices([CM[SL4]^^(-1),ident(1)]) . embMD . CM[SO8], embMH : blockMatrices([SR[SL4],ident(1)]) . embMS . SR[SO8]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU4U1_SO8, Z:'s, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU4U1_SO8, Z:0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'n]) ] ) ), /*end if: Job_SO8_SubG_SU4U1 */ /**> SU2xSU2xSU2xSU2 -> SO8 */ /* Begin, Job_SO8_SubG_SU2SU2SU2SU2 */ if Job_SO8_SubG_SU2SU2SU2SU2 then ( /* print("Embedding SU2xSU2xSU2xSU2 to SO8"), */ /*> normal embeding */ embMH1 : matrix([1,-1,0,0]), embMH2: matrix([1,1,0,0]), embMH3: matrix([0,0,1,-1]), embMH4: matrix([0,0,1,1]), embMS: 'embMS, embMH : 'embMH, embMD: 'embMD, for i : 1 thru 4 do ( concat('embMS, i) :: SR[SL2]^^(-1) . ev(concat('embMH,i),eval) . SR[SO8], concat('embMD, i) :: CM[SL2] . ev(concat('embMS, i),eval) . CM[SO8]^^(-1) ), /*end do*/ embMH : colMatrices( [ embMH1, embMH2, embMH3, embMH4] ), embMS : colMatrices( [ embMS1, embMS2, embMS3, embMS4] ), embMD : colMatrices( [ embMD1, embMD2, embMD3, embMD4] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU2SU2SU2SU2_SO8, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU2SU2SU2SU2_SO8, Z:'0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_SO8_SubG_SU2SU2SU2SU2 */ /**> SO7 */ /* Begin, Job_SO8_SubG_SO7 */ if Job_SO8_SubG_SO7 then ( /* print("Embedding SO7to SO8"), */ /*>natural embedding */ Z: n, embMH : matrix([1,0,0,0],[0,1,0,0],[0,0,1,0]), embMS : SR[SO7]^^(-1) . embMH . SR[SO8], embMD : CM[SO7] . embMS . CM[SO8]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO7_SO8, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ /* non-equivalent to the natural one */ /* n=>s, special trf alpha1<->alpha4 in SO8 */ Y: SO7_SO8, Z: s, embMS : embMS . matrix([0,0,0,1],[0,1,0,0],[0,0,1,0],[1,0,0,0]), embMH : SR[SO7] . embMS . SR[SO8]^^(-1), embMD : CM[SO7] . embMS . CM[SO8]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO7_SO8, Z:'s1, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding(dual) */ /* non-equivalent to the above two */ /* n=>s2, special trf alpha1<->alpha3 in SO8 */ embMS : getdict(getdict(embM, [Y, n]),[S])[1] . matrix([0,0,1,0],[0,1,0,0],[1,0,0,0],[0,0,0,1]), embMH : SR[SO7] . embMS . SR[SO8]^^(-1), embMD : CM[SO7] . embMS . CM[SO8]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO7_SO8, Z:'s2, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU4U1_SO8, Z:0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'n]) ] ) ), /*end if: Job_SO8_SubG_SO7 */ /**> SU3 */ /* Begin, Job_SO8_SubG_SU3 */ if Job_SO8_SubG_SU3 then ( /*print("Embedding SU3 to SO8"), */ /*>normal embedding */ Y: SU3_SO8, Z: n, embMH : matrix([2,1,1,0],[1,-1,2,0]), embMS : SR[SL3]^^(-1) . embMH . SR[SO8], embMD : CM[SL3] . embMS . CM[SO8]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU3_SO8, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SU3_SO8, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) , /*end if: Job_SO8_SubG_SU3 */ /**> Sp2xSU2 */ /* Begin, Job_SO8_SubG_Sp2SU2 */ if Job_SO8_SubG_Sp2SU2 then ( /* print("Embedding Sp2xSU2 to SO8"), */ /* normal embedding */ /* SU2-> SO8 */ embMH2 : matrix([2,0,0,0]), embMS2 : SR[SL2]^^(-1) . embMH2 . SR[SO8], embMD2 : CM[SL2] . embMS2 . CM[SO8]^^(-1), /* SO5 -> SO8 */ embMH3 : matrix([0,1,0,0],[0,0,1,0]), embMS3 : SR[SO5]^^(-1) . embMH3 . SR[SO8], embMD3 : CM[SO5] . embMS3 . CM[SO8]^^(-1), /* Sp2 -> SO8 */ embMH1 : matrix([1,1],[1,-1]) . embMH3, embMS1 : SR[Sp2]^^(-1) . embMH1 . SR[SO8], embMD1 : CM[Sp2] . embMS1 . CM[SO8]^^(-1), embMH : colMatrices( [ embMH1, embMH2 ]), embMS : colMatrices( [ embMS1, embMS2] ), embMD : colMatrices( [ embMD1, embMD2] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : Sp2SU2_SO8, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : Sp2SU2_SO8, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_SO8_SubG_Sp2SU2 */ )$ /*end if: Job_SO8 */ /****>SO(10) */ /* Begin, Job_SO10 */ if Job_SO10 then ( printf(true, "SO(10),"), /***>Weyl trf */ WTD_D5(rv) := WeylTrf(D5,rv,"D"), /***>Algebra */ /* Basis of so(10)*/ E: 'E, H: 'H, A: 'A, S: 'S, CartanBasis[SO8]: [ H0[1]=-I*(E[1,2]-E[2,1]), H0[2]=-I*(E[3,4]-E[4,3]), H0[3]=-I*(E[5,6]-E[6,5]), H0[4]=-I*(E[7,8]-E[8,7]), H0[5]=-I*(E[9,10]-E[10,9]) ], /***>Subalgebras */ /**>SO8xU(1) */ /* Begin, Job_SO10_SubG_SO8U1 */ if Job_SO10_SubG_SO8U1 then ( /* print("The subalgebra so8+u1"), */ /*>normal embedding */ embMD : rowMatrices([covect([0,0,0,0]), covect([1,0,0,0]), covect([0,1,0,0]), covect([0,0,1,0]), covect([0,0,0,1])]), embMS : CM[SO8]^^(-1) . embMD . CM[SO10], embMH : SR[SO8] . embMS . SR[SO10]^^(-1), b: 'b, beta: [1,b[1],b[2],b[3],b[4]], eqs: makelist( inprod( matrix(beta). Gmetric(D5)^^(-1), row(embMD , i ) ), i, 1, 4), sol: linsolve(eqs, makelist(b[i], i, 1 , 4)), QvecH : matrix(ev(beta, sol)), QvecS : QvecH . SR[SO10], QvecD : QvecS . CM[SO10]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO8U1_SO10, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding */ embMH : matrix([1,0,0,0,0],[0,1,0,0,0],[0,0,1,0,0],[0,0,0,1,0]), embMS : SR[SO8]^^(-1) . embMH . SR[SO10], embMD : CM[SO8] . embMS . CM[SO10]^^(-1), QvecH : matrix([0,0,0,0,1]), QvecS : QvecH . SR[SO10], QvecD : QvecS . CM[SO10]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO8U1_SO10, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding*/ WTDs: WTD_D5([1,0,0,0,0]) . WTD_D5([0,1,2,1,1]) . WTD_D5([0,1,1,1,0]) . WTD_D5([0,1,1,0,0]), Y: SO8U1_SO10, Z: s, embMD : embMD . WTDs, embMS : blockMatrices([CM[SO8],ident(1)])^^(-1) . embMD . CM[SO10], embMH : blockMatrices([SR[SO8],ident(1)]) . embMS . SR[SO10]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO8U1_SO10, Z:'s, embM: adddict(embM, [ [Y, Z], dict]), /*> default embM */ Y : SO8U1_SO10, Z:0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'n]) ]) ), /*end if: Job_SO10_SubG_SO8U1 */ /**>U5=SU5xU1 */ /* Begin, Job_SO10_SubG_SU5U1*/ if Job_SO10_SubG_SU5U1 then ( /* print("Job, Flipped SU5"),*/ /*>normal embedding (1) */ embMH : matrix([1,0,0,0,-1],[0,1,0,0,-1],[0,0,1,0,-1],[0,0,0,1,-1]), embMS : SR[SL5]^^(-1) . embMH . SR[SO10], embMD : CM[SL5] . embMS . CM[SO10]^^(-1), QvecH : matrix([2,2,2,2,2]), QvecS : QvecH . SR[SO10], QvecD : QvecS . CM[SO10]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU5U1_SO10, Z:'n1, embM: adddict(embM, [ [Y, Z], dict]), /*>normal embedding (2)*/ /* complex conjugation of normal embedding (1) */ Y : SU5U1_SO10, Z:'n2, embMH : - getdict(getdict(embM, [Y, n1]), [H])[1], embMS : - getdict(getdict(embM, [Y, n1]), [S])[1], embMD : - getdict(getdict(embM, [Y, n1]), [D])[1], dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>normal embedding (3) */ /* The sign of the U(1) charge is reversed :(1) */ Z: n3, embMD : rowMatrices([covect([1,0,0,0]), covect([1,0,0,1]), covect([1,0,1,0]), covect([0,1,0,0]), covect([0,0,1,0])]), embMS : CM[SL5]^^(-1) . embMD . CM[SO10], embMH : SR[SL5] . embMS . SR[SO10]^^(-1), QvecD : matrix([-2,0,2,1,-1]), QvecS : QvecD . CM[SO10], QvecH : QvecS . SR[SO10]^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU5U1_SO10, Z:'n3, embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding (Slansky type) */ /* equivalent to Z=n2 */ WTDs: WTD_D5([1,2,2,1,1]) . WTD_D5([1,0,0,0,0]) . WTD_D5([0,0,1,1,1]), embMD : blockMatrices([-1,-1,-1,-1,1]) . getdict(getdict(embM, [Y, n3]),[D])[1] . WTDs, /* complex conjugation of (3) in the SU(5) sector only . */ embMS : blockMatrices([CM[SL5],1])^^(-1) . embMD . CM[SO10], embMH : blockMatrices([SR[SL5],1]) . embMS . SR[SO10]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU5U1_SO10, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y : SU5U1_SO10, Z:0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'n1])] ) ) , /*end if: Job_SO10_SubG_SU5U1 */ /**>SU4xSU2xSU2-> SO10 */ /* Begin, Job_SO10_SubG_SU4SU2SU2*/ if Job_SO10_SubG_SU4SU2SU2 then ( /*print("Job, Embedding of SU4xSU2xSU2 to SO10"),*/ /*>normal embedding */ embMS : rowMatrices([covect([1,0,0,0,0]), covect([0,1,0,0,0]), covect([-1/2,-1,-1/2,-1/2,-1/2]), covect([0,0,0,1,0]), covect([0,0,0,0,1])]), embMD : blockMatrices([CM[SL4],CM[SL2],CM[SL2]]) . embMS . CM[SO10]^^(-1), embMH : blockMatrices([SR[SL4],SR[SL2],SR[SL2]]) . embMS . SR[SO10]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU4SU2SU2_SO10, Z:'n1, embM: adddict(embM, [ [Y, Z], dict]), /*>natural embedding */ embMH1 : matrix([0,0,0,1,-1]), embMH2 : matrix([0,0,0,1,1]), embMH: 'embMH, embMS : 'embMS, embMD: 'embMD, for i : 1 thru 2 do ( concat('embMS, i) :: SR[SL2]^^(-1) . ev(concat('embMH,i),eval) . SR[SO10], concat('embMD, i) :: CM[SL2] . ev(concat('embMS, i),eval) . CM[SO10]^^(-1) ), /*end do*/ embMH3: matrix([1,1,0,0,0],[1,0,-1,0,0],[0,1,-1,0,0]), embMS3: SR[SL4]^^(-1) . embMH3 . SR[SO10], embMD3: CM[SL4] . embMS3 . CM[SO10]^^(-1), embMH : colMatrices( [ embMH1, embMH2, embMH3] ), embMS : colMatrices( [ embMS1, embMS2, embMS3] ), embMD : colMatrices( [ embMD1, embMD2, embMD3] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU4SU2SU2_SO10, Z:'n2, embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding */ embMD2 : matrix([0,0,1,1,0]), embMD3 : matrix([0,0,1,0,1]), embMH: 'embMH, embMD : 'embMD, embMS: 'embMS, for i : 2 thru 3 do ( concat('embMS, i) :: CM[SL2]^^(-1) . ev(concat(embMD,i),eval) . CM[SO10], concat('embMH, i) :: SR[SL2] . ev(concat('embMS, i),eval) . SR[SO10]^^(-1) ), /*end do*/ embMD1: rowMatrices([covect([0,1,0]), covect([1,0,1]), covect([1,0,1]), covect([1,0,0]), covect([1,0,0])]), embMS1: CM[SL4]^^(-1) . embMD1 . CM[SO10], embMH1: SR[SL4] . embMS1 . SR[SO10]^^(-1), embMH : colMatrices( [ embMH1, embMH2, embMH3] ), embMS : colMatrices( [ embMS1, embMS2, embMS3] ), embMD : colMatrices( [ embMD1, embMD2, embMD3] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SU4SU2SU2_SO10, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ WTDs: WTD_D5([1,1,1,0,0]) . WTD_D5([0,1,1,0,0]) . WTD_D5([0,0,0,1,0]), Y: SU4SU2SU2_SO10, Z: 's, embMD : getdict(getdict(embM,[Y,'c]),[D] )[1] . WTDs, embMS : blockMatrices([CM[SL4],CM[SL2],CM[SL2]])^^(-1) . embMD . CM[SO10], embMH : blockMatrices([SR[SL4],SR[SL2],SR[SL2]]) . embMS . SR[SO10]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: SU4SU2SU2_SO10, Z: 0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y,n])]) ), /*end if: Job_SO10_SubG_SU4SU2SU2 */ /**>SO9 */ /* Begin, Job_SO10_SubG_SO9 */ if Job_SO10_SubG_SO9 then ( /*print("The subalgebra so9"),*/ /*>normal and canonical embedding */ embMH : matrix([1,0,0,0,0],[0,1,0,0,0],[0,0,1,0,0],[0,0,0,1,0]), embMS : SR[SO9]^^(-1) . embMH . SR[SO10], embMD : CM[SO9] . embMS . CM[SO10]^^(-1), Y: SO9_SO10, Z: c, dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ WTDs: WTD_D5([1,0,0,0,0]) . WTD_D5([0,1,1,1,1]) . WTD_D5([0,0,1,0,1]) . WTD_D5([0,0,1,0,0]), Y: SO9_SO10, Z: 's, embMD : getdict(getdict(embM, [Y,c]), [D])[1] . WTDs, embMS : CM[SO9]^^(-1) . embMD . CM[SO10], embMH : SR[SO9] . embMS . SR[SO10]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: SO9_SO10, Z:0, embM: adddict(embM, [[Y,Z], getdict(embM, [Y, c])]) ), /*end if: Job_SO10_SubG_SO9 */ /**>SO7xSU2-> SO10 */ /* Begin, Job_SO10_SubG_SO7SU2 */ if Job_SO10_SubG_SO7SU2 then ( /*print("Job, Embedding of SO7xSU2 to SO10"),*/ /*>normal embedding */ embMH2: matrix([2,0,0,0,0]), embMS2: SR[SL2]^^(-1) . embMH2 . SR[SO10], embMD2: CM[SL2] . embMS2 . CM[SO10]^^(-1), embMH1: matrix([0,0,1,0,0],[0,0,0,1,0],[0,0,0,0,1]), embMS1: SR[SO7]^^(-1) . embMH1 . SR[SO10], embMD1: CM[SO7] . embMS1 . CM[SO10]^^(-1), embMH : colMatrices( [ embMH1, embMH2 ]), embMS : colMatrices( [ embMS1, embMS2] ), embMD : colMatrices( [ embMD1, embMD2] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO7SU2_SO10, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding */ WTDs: WTD_D5([1,1,0,0,0]) . WTD_D5([0,1,1,0,0]) . WTD_D5([0,0,1,1,0]) . WTD_D5([0,0,0,1,0]), embMD: getdict(getdict(embM, [Y, n]), [D])[1] . WTDs, embMS: blockMatrices([CM[SO7],CM[SL2]])^^(-1) . embMD . CM[SO10], embMH: blockMatrices([SR[SO7],SR[SL2]]) . embMS . SR[SO10]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO7SU2_SO10, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ WTDs: WTD_D5([1,1,2,1,1]) . WTD_D5([0,1,2,1,1]) . WTD_D5([0,0,1,0,1]) . WTD_D5([0,0,1,0,0]), embMD: getdict(getdict(embM, [Y, c]),[D])[1] . WTDs, embMS: blockMatrices([CM[SO7],CM[SL2]])^^(-1) . embMD . CM[SO10], embMH: blockMatrices([SR[SO7],SR[SL2]]) . embMS . SR[SO10]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO7SU2_SO10, Z:'s, embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y : SO7SU2_SO10, Z:0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'n])]) ), /*end if: Job_SO10_SubG_SO7SU2 */ /**>Sp2xSp2-> SO10 */ /* Begin, Job_SO10_SubG_Sp2Sp2 */ if Job_SO10_SubG_Sp2Sp2 then ( /*print("Job, Embedding of Sp2xSp2 to SO10"),*/ /*>normal embedding */ embMH1 : matrix([1,1,0,0,0],[1,-1,0,0,0]), embMH2 : matrix([0,0,1,1,0],[0,0,1,-1,0]), embMH : 'embMH, embMS : 'embMS, embMD : 'embMD, for i : 1 thru 2 do ( concat('embMS, i) :: SR[Sp2]^^(-1) . ev(concat('embMH, i),eval) . SR[SO10], concat('embMD, i) :: CM[Sp2] . ev(concat('embMS, i), eval) . CM[SO10]^^(-1) ), /*end do*/ embMH : colMatrices( [ embMH1, embMH2 ] ), embMS : colMatrices( [ embMS1, embMS2 ] ), embMD : colMatrices( [ embMD1, embMD2 ] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : Sp2Sp2_SO10, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y : Sp2Sp2_SO10, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) , /*end if: Job_SO10_SubG_Sp2Sp2 */ /**> max Sp2-> SO10 */ /* Begin, Job_SO10_SubG_Sp2 */ if Job_SO10_SubG_Sp2 then ( /*print("Job, Embedding of max Sp2 to SO10"),*/ /*>normal embedding */ embMH : matrix([2,1,1,0,0],[0,1,-1,2,0]), embMS : SR[Sp2]^^(-1) . embMH . SR[SO10], embMD : CM[Sp2] . embMS . CM[SO10]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : Sp2_SO10, Z:'n, embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y : Sp2_SO10, Z:0, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_SO10_SubG_Sp2 */ )$ /*end if: Job_SO10 */ /*****>Type E */ /****>E6 */ /* Begin, Job_E6 */ if Job_E6 then ( printf(true, "E6, "), /***>WeylTrf */ WTD_E6(rv) := WeylTrf(E6,rv,"D"), /***>Subalgebras */ /**>SO10xU1 */ /* Begin, Job_E6_SubG_SO10U1 */ if Job_E6_SubG_SO10U1 then ( /*print("Subalgebra so10+u1"),*/ /*> normal embedding 1->U1 */ Y : SO10U1_E6, Z:'n1, dict: getdict( mkRSembM(E6, 1,1), ["embM"]), embM: adddict(embM, [ [Y,Z], dict] ), /*> normal embedding 5->U1 */ Y : SO10U1_E6, Z:'n2, dict:getdict( mkRSembM(E6, 5,1), ["embM"]), embM: adddict(embM, [ [Y,Z], dict] ), /*>canonical (Slansky) */ embMD : rowMatrices([covect([0, 0, 0, 0, 1]), covect([1, 0, 0, 0, 1]), covect([1, 0, 1, 0, 0]), covect([1, 0, 0, 1, 0]), covect([0, 0, 0, 1, 0]), covect([0, 1, 0, 0, 0])]), embMS : CM[SO10]^^(-1) . embMD . CM[E6], embMH : SR[SO10] . embMS . Kmetric(E6)^^(-1), b: 'b, beta: matrix(append(makelist(b[i], i. 1, 4), [-1, b[5]] )), eqs: makelist( inprod( beta . Gmetric(E6), row( embMD, i ))[1,1], i, 1, 5), sol: linsolve(eqs, makelist(b[i],i,1,5)), QvecD : ev(beta,sol) , QvecS : QvecD . CM[E6], QvecH : QvecS . Kmetric(E6)^^(-1), embMH : colMatrices( [ embMH, QvecH] ), embMS : colMatrices( [ embMS, QvecS] ), embMD : colMatrices( [ embMD, QvecD] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], Y : SO10U1_E6, Z:'c, embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y : SO10U1_E6, Z:0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'n1]) ] ) ), /*end if: Job_E6_SubG_SO10U1 */ /**>SU6xSU2 */ /* Begin, Job_E6_SubG_SU6SU2 */ if Job_E6_SubG_SU6SU2 then ( /*print("The subalgebra su6+su2"),*/ /*>normal embedding, alpha_4 => -theta */ Y : SU6SU2_E6, Z:'n1, dict :getdict( mkRSembM(E6, 4,2), ["embM"]), embM: adddict(embM, [ [Y,Z], dict ] ), /*>normal embedding, alpha6 => -theta */ Y : SU6SU2_E6, Z:'n2, dict: getdict( mkRSembM(E6, 6,2),["embM"]), embM: adddict(embM, [ [Y,Z], dict] ), /*>canonical embedding */ WTDs: WTD_E6([0,1,2,1,0,1]) . WTD_E6([0,0,0,0,0,1]) . WTD_E6([0,0,1,1,1,0]) . WTD_E6([0,1,1,1,0,0]) . WTD_E6([1,1,1,0,0,0]), Y : SU6SU2_E6, Z: c, embMD : getdict(getdict(embM, [Y, n2]), [D])[1] . WTDs, embMS : blockMatrices([CM[SL6],CM[SL2]])^^(-1) . embMD . CM[E6], embMH : blockMatrices([SR[SL6],SR[SL2]]) . embMS . Kmetric(E6)^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding (1) */ WTDs: WTD_E6([1,1,0,0,0,0]) . WTD_E6([0,1,2,2,1,1]) . WTD_E6([0,1,2,1,0,1]) . WTD_E6([0,1,1,0,0,0]) . WTD_E6([0,0,1,0,0,0]), Y: SU6SU2_E6, Z: 's1, embMD : getdict(getdict(embM, [Y, c]), [D])[1] . WTDs, embMS : blockMatrices([CM[SL6],CM[SL2]])^^(-1) . embMD . CM[E6], embMH : blockMatrices([SR[SL6],SR[SL2]]) . embMS . Kmetric(E6)^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding (2) */ /*complex conjugate of (1) */ WTDs: WTD_E6([1,2,2,1,1,1]) . WTD_E6([0,1,1,1,1,0]) . WTD_E6([0,0,1,0,0,1]) . WTD_E6([0,1,1,1,0,0]) . WTD_E6([0,0,1,1,0,0]), Y: SU6SU2_E6, Z: 's2, embMD : blockMatrices([Jmatrix(5), ident(1)]) . getdict(getdict(embM, [Y, 's1]),[D])[1] . WTDs, embMS : blockMatrices([CM[SL6],CM[SL2]])^^(-1) . embMD . CM[E6], embMH : blockMatrices([SR[SL6],SR[SL2]]) . embMS . Kmetric(E6)^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: SU6SU2_E6, Z: 0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'c]) ]) ), /*end if: Job_E6_SubG_SU6SU2 */ /**>SU3xSU3xSU3 */ /* Begin, Job_E6_SubG_SU3SU3SU3 */ if Job_E6_SubG_SU3SU3SU3 then ( /*print("The subalgebra su3+su3+su3"),*/ /*>normal embedding */ Y: SU3SU3SU3_E6, Z: 'n, embMS : rowMatrices([covect([1,0,0,0,0,0]), covect([0,1,0,0,0,0]), covect([-1/3,-2/3,-2/3,-1/3,-2/3,-1/3]), covect([0,0,1,0,0,0]), covect([0,0,0,1,0,0]), covect([0,0,0,0,1,0])]), embMH : blockMatrices([SR[SL3],SR[SL3],SR[SL3]]) . embMS . SR[E6]^^(-1), embMD : blockMatrices([CM[SL3],CM[SL3],CM[SL3]]) . embMS . CM[E6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding (1) */ WTDs: WTD_E6([0,1,2,1,1,1]) . WTD_E6([0,0,1,1,0,1]) . WTD_E6([1,1,1,0,0,0]) . WTD_E6([0,1,1,1,0,0]) . WTD_E6([0,0,0,1,0,0]), Y: SU3SU3SU3_E6, Z: 'c, embMD : getdict(getdict(embM, [Y, 'n]), [D])[1] . WTDs, embMS : blockMatrices([CM[SL3],CM[SL3],CM[SL3]])^^(-1) . embMD . CM[E6], embMH : blockMatrices([SR[SL3],SR[SL3],SR[SL3]]) . embMS . Kmetric(E6)^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding (2) (Slansky)*/ Y: SU3SU3SU3_E6, Z: 's, embMD : rowMatrices([covect([1,0,0,0,1,0]), covect([1,-1,0,0,2,0]), covect([1,-1,1,-1,2,1]), covect([1,-1,0,-1,1,1]), covect([1,-1,0,0,0,1]), covect([0,0,0,0,1,1])]), embMS : blockMatrices([CM[SL3],CM[SL3],CM[SL3]])^^(-1) . embMD . CM[E6], embMH : blockMatrices([SR[SL3],SR[SL3],SR[SL3]]) . embMS . Kmetric(E6)^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: SU3SU3SU3_E6, Z: 0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'n])]) ), /*end if: Job_E6_SubG_SU3SU3SU3 */ /**>special SU3 */ /* Begin, Job_E6_SubG_SU3 */ if Job_E6_SubG_SU3 then ( /*print("The subalgebra special su3"),*/ /* 27dim reps of SU3*/ if false then ( WS_SU3_27 : WeightSystem(A2,[2,2],"S"), hl: getdict( WS_SU3_27, ["hl"])[1], for i : 1 thru 2 do ( concat('HV_SU3_27_, i) :: [], for j : hl thru -hl step -1 do ( for x in getdict(getdict(WS_SU3_27, ["SWS"]), [j]) do ( concat('HV_SU3_27_, i) :: append(ev(concat('HV_SU3_27_, i),eval), makelist(x[2][i], k, 1, x[1]) ) ) /*end do*/ ) /*end do*/ ), /*end do*/ display(HV_SU3_27_1, HV_SU3_27_2) ), /* end if*/ Y : SU3_E6, Z: 'c, embMH : matrix([1,-1,2,-1,1,-1],[0,1,-1,1,0,1]), embMS : embMH , embMD : CM[SL3] . embMS . CM[E6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y : SU3_E6, Z: 0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_E6_SubG_SU3 */ /**>special G2 */ /* Begin, Job_E6_SubG_G2 */ if Job_E6_SubG_G2 then ( /*print("The subalgebra special g2"),*/ /*>normal embedding */ if false then ( WS_G2_27 : WeightSystem(A2,[2,2],"S"), hl: getdict( WS_G2_27, ["hl"])[1], for i : 1 thru 2 do ( concat('HV_G2_27_, i) :: [], for j : hl thru -hl step -1 do ( for x in getdict(getdict(WS_G2_27, ["SWS"]), [j]) do ( concat('HV_G2_27_, i) :: append(ev(concat('HV_SU3_27_, i),eval), makelist(x[2][i], k, 1, x[1]) ) ) /*end do*/ ) /*end do*/ ), /*end do*/ display(HV_G2_27_1, HV_G2_27_2) ), /* end if*/ Y: G2_E6, Z: 'n, embMH : matrix([0,1,-1,1,0,1],[1,0,1,0,1,0]), embMS : embMH , embMD : CM[G2] . embMS . CM[E6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: G2_E6, Z: 0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_E6_SubG_G2 */ /**>special G2xSU3 */ /* Begin, Job_E6_SubG_G2SU3 */ if Job_E6_SubG_G2SU3 then ( /*print("The subalgebra special g2+su3"),*/ /*>canonical embedding */ embMH2: matrix([1,0,-1,1,0,0],[0,1,-1,0,1,0]), embMS2: embMH2, embMD2: CM[SL3] . embMS2 . CM[E6]^^(-1), embMH1: matrix([0,0,0,0,0,1],[0,0,1,0,0,0]), embMS1: embMH1, embMD1: CM[G2] . embMS1 . CM[E6]^^(-1), Y: G2SU3_E6, Z: 'c, embMH : colMatrices( [ embMH1, embMH2 ] ), embMS : colMatrices( [ embMS1, embMS2 ] ), embMD : colMatrices( [ embMD1, embMD2 ] ), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: G2SU3_E6, Z: 0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_E6_SubG_G2SU3 */ /**>special Sp4 */ /* Begin, Job_E6_SubG_Sp4 */ if Job_E6_SubG_Sp4 then ( /*print("The subalgebra special sp4"),*/ /*>normal embedding */ Y: Sp4_E6, Z: 'n, embMH : matrix([0,1,-1,1,0,0],[1,0,0,0,1,0],[0,0,1,0,0,0],[0,0,0,0,0,1]), embMS : embMH , embMD : CM[Sp4] . embMS . CM[E6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: G2SU3_E6, Z: 0, embM: adddict(embM, [ [Y, Z], dict]) ), /*end if: Job_E6_SubG_Sp4 */ /**>special F4 */ /* Begin, Job_E6_SubG_F4 */ if Job_E6_SubG_F4 then ( /*print("The subalgebra special f4"),*/ /*>Canonical embedding */ Y: F4_E6, Z: c, embMH : matrix([0,0,0,0,0,1],[0,0,1,0,0,0],[0,1,0,1,0,0],[1,0,0,0,1,0]), embMS : embMH , embMD : CM[F4] . embMS . CM[E6]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ WTDs: WTD_E6([0,0,1,1,1,0]) . WTD_E6([0,1,1,1,0,0]) . WTD_E6([0,0,1,0,0,0]), Y: F4_E6, Z: s, embMD : getdict(getdict(embM, [Y, 'c]), [D])[1] . WTDs, embMS : CM[F4]^^(-1) . embMD . CM[E6], embMH : embMS , dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: F4_E6, Z: 0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y. 'c])]) ) /*end if: Job_E6_SubG_F4 */ )$ /*end if: Job_E6*/ /*****>Type F */ /****>F4 */ /* Begin, Job_F4 */ if Job_F4 then ( printf(true, "F4,"), /***>Weyl Trf*/ WTD_F4(rv) := WeylTrf(F4,rv,"D"), /***>Subalgebras */ /**>SO9 */ /* Begin, Job_F4_SubG_SO9 */ if Job_F4_SubG_SO9 then ( /*print("Subalgebra, SO9"),*/ /*>normal embedding */ Y: SO9_F4, Z: 'n, embMS : rowMatrices([covect([0,1,0,0]), covect([0,0,1,0]), covect([0,0,0,1]), covect([-1/2,-1,-3/2,-2])]), embMD : CM[SO9] . embMS . CM[F4]^^(-1), embMH : SR[SO9] . embMS , dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embedding */ WTDs: WTD_F4([1,2,4,2]) . WTD_F4([0,1,2,1]) . WTD_F4([0,1,2,0]) . WTD_F4([0,1,0,0]), Y: SO9_F4, Z: 's, embMD : getdict(getdict(embM, [Y, 'n]),[D])[1] . WTDs, embMS : CM[SO9]^^(-1) . embMD . CM[F4], embMH : SR[SO9] . embMS , dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM*/ Y: SO9_F4, Z: 0, embM: adddict(embM, [ [Y, Z], getdict(embM,[Y, 'n])]) ) , /*end if: Job_F4_SubG_SO9 */ /**>SU3xSU3 */ /* Begin, Job_F4_SubG_SU3SU3 */ if Job_F4_SubG_SU3SU3 then ( /*print("Subalgebra, SU3xSU3"), */ /*>normal embedding */ Y: SU3SU3_F4, Z: 'n, embMS : rowMatrices([covect([0,0,0,1]), covect([-4/3,-2/3,-1/3,-2/3]), covect([1,0,0,0]), covect([0,1,0,0])]), embMD : blockMatrices([CM[SL3],CM[SL3]]) . embMS . CM[F4]^^(-1), embMH : blockMatrices([SR[SL3],SR[SL3]]) . embMS , dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>Slansky embeddging */ WTDs: WTD_F4([2,3,4,2]) . WTD_F4([0,1,1,1]) . WTD_F4([1,2,2,0]) . WTD_F4([0,0,1,0]) . WTD_F4([1,1,0,0]) . WTD_F4([0,1,0,0]), Y: SU3SU3_F4, Z: 's, embMD : getdict(getdict(embM, [Y, 'n]),[D])[1] . WTDs, embMS : blockMatrices([CM[SL3],CM[SL3]])^^(-1) . embMD . CM[F4], embMH : blockMatrices([SR[SL3],SR[SL3]]) . embMS , dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: SU3SU3_F4, Z: 0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'n]) ]) ), /*end if: Job_F4_SubG_SU3SU3*/ /**>Sp3xSU2 */ /* Begin, Job_F4_SubG_Sp3SU2 */ if Job_F4_SubG_Sp3SU2 then ( /*print("Subalgebra, Sp3xSU2"), */ /*>normal embedding */ Y: Sp3SU2_F4, Z: 'n, embMS : rowMatrices([covect([-1,-2,-3/2,-1/2]), covect([0,0,1,0]), covect([0,1,0,0]), covect([1,0,0,0])]), embMD : blockMatrices([CM[Sp3],CM[SL2]]) . embMS . CM[F4]^^(-1), embMH : blockMatrices([SR[Sp3],SR[SL2]]) . embMS , dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>canonical embedding */ WTDs: WTD_F4([1,1,1,1]) . WTD_F4([1,1,2,0]) . WTD_F4([1,1,0,0]) . WTD_F4([0,1,0,0]), Z: 'c, Y: Sp3SU2_F4, Z: 'c, embMD : getdict(getdict(embM, [Y,'n]),[D ])[1] . WTDs, embMS : blockMatrices([CM[Sp3],CM[SL2]])^^(-1) . embMD . CM[F4], embMH : blockMatrices([SR[Sp3],SR[SL2]]) . embMS , dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: SU3SU3_F4, Z: 0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'n]) ]) ), /*end if: Job_F4_SubG_Sp3SU2 */ /**>G2xSU2 (special) */ /* Begin, Job_F4_SubG_G2SU2 */ if Job_F4_SubG_G2SU2 then ( /*print("Subalgebra, G2xSU2 (special)"), */ /*>normal embedding */ Y: G2SU2_F4, Z: 'n, embMS : rowMatrices([covect([1,0,0]), covect([0,1,0]), covect([0,0,-1]), covect([0,0,2])]), embMD : blockMatrices([CM[G2],CM[SL2]]) . embMS . CM[F4]^^(-1), embMH : blockMatrices([SR[G2],SR[SL2]]) . embMS , dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: SU3SU3_F4, Z: 0, embM: adddict(embM, [ [Y, Z], getdict(embM, [Y, 'n]) ]) ) /*end if: Job_F4_SubG_G2SU2 */ )$ /*end if: Job_F4 */ /*****>Type G */ /****>G2 */ /* Begin, Job_G2 */ if Job_G2 then ( printf(true, "G2~%"), /***>Root Diagram */ G2_RootDiagram() := block( [ /* list */ Deltap, Deltam, pRootsPlot, mRootsPlot, circle, /* array */ alpha ], local(alpha), print("G2 : Root Diagram"), /* Root vectors */ alphabyvec : [ alpha[1] = [1,0], alpha[2] = [-1/2,sqrt(3)/6] ], Deltap: [alpha[1],alpha[2],alpha[1]+alpha[2],alpha[1]+2*alpha[2], alpha[1]+3*alpha[2],2*alpha[1]+3*alpha[2]], Deltap : ev( Deltap, alphabyvec), Deltam: -1*Deltap, /* drawing */ pRootsPlot: [], for v in Deltap do ( pRootsPlot: endcons([ vector([0,0], v)], pRootsPlot) ), /*end do*/ mRootsPlot: [], for v in Deltam do ( mRootsPlot: endcons([ vector([0,0],v)], mRootsPlot) ), /*end do*/ circle: parametric(cos(t),sin(t), t, 0, 2*%pi ), draw2d( head_angle=10, head_length=0.5, line_width=2, color="green", pRootsPlot, color="blue", mRootsPlot, line_width=1, circle) ), /*end proc: G2_RootDiagram */ /***>Subalgebra */ /**>SU3 */ /* Begin, Job_G2_SubG_SU3 */ if Job_G2_SubG_SU3 then ( /*print("Subalgebra SU3"), */ /*>Normal embedding */ Y: SU3_G2, Z: 'n, embMS : rowMatrices([covect([1,0]), covect([-2/3,-1/3])]), embMH : SR[SL3] . embMS . SR[G2]^^(-1), embMD : CM[SL3] . embMS . CM[G2]^^(-1), dict : [ [[H], [embMH]], [[S], [embMS]], [[D], [embMD]] ], embM: adddict(embM, [ [Y, Z], dict]), /*>default embM */ Y: SU3_G2, Z: 0, embM: adddict(embM, [ [Y, Z], dict]) ) /*end if: Job_G2_SubG_SU3 */ )$ /*end if: Job_G2 */ /******>help procedures */ /*****>proc:procinfo */ /* procinfo(opt) => info on procedure(s) opt = "" ; info on all major defined procedures opt = ::string : info on the procedure */ procinfo([opt]) := block( if length(opt)=0 then ( choice : "all" ) else ( choice : opt[1] ), /*end if*/ /****>Common procedures */ /***>Notations */ printf(true, "*Comman notations ~%"), printf(true, " dt = Dynkin type (e.g. A4, [\"A\",4])~%"), printf(true, " w :: list = a weight vector in a simple root basis~%"), printf(true, " dw :: list = Dynkin label for a weight (e.g., [0,-1,2,-1])~%"), printf(true, " hdw :: list = highest Dynkin label for a weight (e.g., [1,0,0,1])~%"), printf(true, " basis = \"~a\"~%", S/D), printf(true, " dict = the dictionary data type. It is realized as a list of a special structure. See the info on \"dict\". ~%"), printf(true, " ( name ) means data of the type name.~%"), /***>Dict */ if member(choice, ["all", "dict", "getdict", "adddict", "repldict", "remdict"]) then ( printf(true, " ~%"), printf(true, " ~%"), printf(true, "*Functions to handle dict~%"), printf(true, " dict type data = [ item1, item2, ... ]; item = [ [tag], [data]].~%"), printf(true, " getdict ((dict), [(tag)]) => [data] ~%"), printf(true, " adddict((dict), (item)) => adding (item) to (dict).~%"), printf(true, " repldict((dict), (item)) => replacing the data with (tag) of (item) in (dict) by (item). ~%"), printf(true, " remdict((dict), (item)) => remove (item) from (dict)~%") ), /*end if*/ /***>Metrics */ if member(choice, ["all", "metric", "Kmetric", "Cmatrix", "Gmetric"]) then ( printf(true, "~%"), printf(true, "*Metric related functions: ~%"), printf(true, " Kmetric(dt) => Killing metric matrix~%"), printf(true, " Cmatrix(dt) => Cartan matrix~%"), printf(true, " Gmetric(dt) => Killing metric matrix in the Dynkin basis~%") ), /*end if*/ /***>Inner product */ if member(choice, ["all", "product", "IPDB", "RIP", "RCP"]) then ( printf(true, "~%"), printf(true, "*Inner products: ~%"), printf(true, " IPDB(dw1,dw2,dt) => Inner product of Dynkin weights~%"), printf(true, " RIP(w1,w2,dt) => Inner product of weights in the simple root basis~%"), printf(true, " RCP(w1,w2,dt) => Cartan product < w1,w2>>~%") ), /*end if*/ /***>SRB <=> DB */ if member(choice, ["all", "basis", "DBtoSRB", "SRBtoDB"]) then ( printf(true, "~%"), printf(true, "*Basis change: ~%"), printf(true, " DBtoSRB: coordinate trf of weights. Dynkin basis => Simple root basis~%"), printf(true, " usage: DBtoSRB(dw,dt)~%"), printf(true, " SRBtoDB: coordinate trf of weights. Simple root basis => Dynkin basis ~%"), printf(true, " usage: SRBtoDB(w,dt)~%") ), /*end if*/ /***>RootSystem */ if member(choice, ["all", "root", "HighestRoot", "Rlevel", "RootSystem"]) then ( printf(true, "~%"), printf(true, "*Root System: ~%"), printf(true, " HighestRoot(dt) => the highest root in the simple root basis~%"), printf(true, " RootSystem=> dict: giving the root system in the simple root/Dynkin basis~%"), printf(true, " usage: RootSystem(dt[, basis, output=0/1])~%"), printf(true, " return: dict[[\"type\"]=(dt), [\"dim\"]=(the algebra dim), [\"hl\"]=(highest level), rootdict]~%"), printf(true, " rootdict= dict[ [hl]=[w1,...], [hl-1]=[w2,...],...]~%") ), /*end if*/ /***>Structure constant */ if member(choice, ["all", "StrConst", "Weyl", "StrConstWB", "pritStrConst"]) then ( printf(true, "~%"), printf(true, "*Structure constant: ~%"), printf(true, " StrConstWB( dt ) => NNdict describing the Weyl Basic CR coefficients.~%"), printf(true, " NNdict = dict: [ [\"StrConst\"] = [ [[w1,w2], [N[w1,w2]], ...], ... ]~%"), printf(true, " [ E_w1, E_w2]=N[w1,w2] E_(w1+w2) (w1+w2 #0) : N[w1,w2] is a number,~%"), printf(true, " [ E_w, E_(-w)] = H_w (= K. w) : N[w,-w]= K. w. : a weight vector ~%"), printf(true, " e.g., for dt=B3. ~%"), printf(true, " NNdict: StrConstWB(B3)$ ~%"), printf(true, " NN: getdict(NNdict, [\"StrConst\"])$~%"), printf(true, " getdict(NN, [[1,2,2], [0,-1,0]] );~%"), printf(true, " [1] ~%"), printf(true, " printStrConst(NNdict[, sw]) => show the list of non-vanishing str. constants.~%"), printf(true, " sw=0 : no display output. ~%"), printf(true, " sw=1 : display the non-vanishing CRs. ~%") ), /*end if*/ /***>WeightSystem */ if member(choice, ["all", "weight", "WeightSystem", "printWS", "findHighestWeight", "fullWS"]) then ( printf(true, "~%"), printf(true, "*Weight system related functions: ~%"), printf(true, " WeightSystem => the weight system in the Dynkin or in the simple root basis ~%"), printf(true, " usage: WeightSystem(dt,hdw [, basis, sw=0/1/2])~%"), printf(true, " sw=0 => output=WSdict. No monitor output,~%"), printf(true, " sw=1 => output=WSdict. Display the weight system,~%"), printf(true, " sw=2 => output= the flat weight list.~%"), printf(true, " WSdict = dict: [ \"dt\"=(dt), \"hdw\"=(hdw), \"dim\"=(dim), \"hl\"=(heighest level)~%"), printf(true, " \"SWS\"=(SWS::dict) (and/or \"DWS\"=(DWS::dict) ) ]~%"), printf(true, " printWS((WSdict)): gives a formated display of a weight system~%"), printf(true, " findHighestWeight: finds the highest weight of the irrep to which a given weight belongs to in Dynkin basis~%"), printf(true, " usage: findHighestWeight(dw, dt)~%"), printf(true, " fullWS: create a new WSdict containing both WSs in the Simple Root Basis and the Dynkin Basis from a WS containing only one of them.~%"), printf(true, " usage: fullWS((WSdict) )~%") ), /*end if*/ /***>Weyl trf */ if member(choice, ["all", "WeylTrf"]) then ( printf(true, "~%"), printf(true, "*Weyl transformation: ~%"), printf(true, " WeylTrf(dt, rv[, basis]) => Weyl trf matrix in the (basis) wrt the root vector (rv)~%"), printf(true, " rv=a root vector in the simple root basis~%") ), /*end if*/ /***>ProductOfRep */ if member(choice, ["all", "ProductOfRep"]) then ( printf(true, "~%"), printf(true, "*Irr. decomposition of a product of representations: ~%"), printf(true, " ProductOfRep(dt, hdw1, hdw2 [, sw=0/1, basis])~%"), printf(true, " sw=0 (default) => output = Irrep. list only~%"), printf(true, " sw=1 => output = Irrep. list with a formated display~%"), printf(true, " sw=2 => output = Irrep. list with display of the composite weight system~%"), printf(true, " in the Simple Root Basis (basis=\"S\") or the Dynkin Basis(basis=\"D\")~%") ), /*end if*/ /***>Low rank maximal quasi-semisimple subalgebras */ if member(choice, ["all", "MaxSubGlist", "MaxSubGlist0"]) then ( printf(true, "~%"), printf(true, "*Listing maximal quasi-semisimple subalgebras for low rank Lie algebras~%"), printf(true, " MaxSubGlist(dt[, sw]) => [[the list of regular subalgs],[the list of special subalgs]]~%"), printf(true, " sw=0 (default) => no output display,~%"), printf(true, " sw>0 => display the result in a formated form.~%"), printf(true, " MaxSubGlist0(dt) => [ the flat list of all maximal subalgs].~%") ), /*end if*/ /***>Constructing embedding matrices */ /**>regular quasi-semisimple subalgebra */ if member(choice, ["all", "mkRSembM"]) then ( printf(true, "~%"), printf(true, "*Constructing an embedding matrix for any regular quasi-semisimple subalgebra of any simple Lie algebra~%"), printf(true, " mkRSembM(dt,nodepos,type) ~%"), printf(true, " output = dict: [[\"subalgebra\"=(dts),\"embM\"=(embM)]]~%"), printf(true, " dts= the list of the Dynkin types of the resulting subalgebra. e.g. [A4,U1] for D5 ~%"), printf(true, " embM = dict:[ [D]=(embMD), [S]=(embMS), [H]=(embMH) ] ~%"), printf(true, " embMD = projection matrix for Dynkin labels, ~%"), printf(true, " embMS = matrix specifying the pull back of simple roots,~%"), printf(true, " embMH = matrix specifying the embedding of the Cartan subalgebra~%"), printf(true, " nodepos= a node position to remove from the (extended) Dynkin diagram~%"), printf(true, " type=1 => remove one node from the Dynkin diagram and add U1 ~%"), printf(true, " type=2 => use the extended Dynkin diagram ~%") ), /*end if*/ /**>SO(d) => SL(d) embedding */ if member(choice, ["all", "mkSOSLembM"]) then ( printf(true, "*Constructing an embedding matrix for the canonical embedding SO(dim) -> SL(dim)~%"), printf(true, " mkSOSLembM(dim) => dict[ [H]=[embMH], [S]=[embMS], [D]=[embMD]]~%") ), /*end if*/ /***>Listing subalgebras with preinstalled embedding matrices */ if member(choice, ["all", "embMlist", "embM"]) then ( printf(true, "*Listing subalgebras with preinstalled embedding matrices~%"), printf(true, " embMlist(dt) => an index list in the form: subalgebra: [Y, Z]~%"), printf(true, " This means that embMX[Y. Z] (X=H,S,D) are defined~%"), printf(true, " e.g.~%"), printf(true, " embMlist(A4)~%"), printf(true, " SU4xU1 : [SU4U1_SU5, n/c/s]~%"), printf(true, " ,,,,~%"), printf(true, " This means that embMX (X=H, S, D) are defined for the tag [SU4U1_SU5, Z] (Z=n,c,s) and accessed, e.g, by~%"), printf(true, " embMD : getdict(getdict(embM, [SU4U1_SU5, n]), [D])[1]. ~%") ), /*end if*/ /***>Subalgebra reduction of Irreps */ if member(choice, ["all", "SubGrdm"]) then ( printf(true, "~%"), printf(true, "*Irr. decomposition of an irrep by subalgebras: ~%"), printf(true, " SubGrdm(dt,hwd dts,embMD[,sw] ) => DWS/WL~%"), printf(true, " e.g. dts=[A3, B4, U1]~%"), printf(true, " embMD=embedding matrix in the Dynkin basis~%"), printf(true, " sw=0 => output=Irrep list. No monitor output,~%"), printf(true, " sw=1 => output=Irrep list with monitor display,~%"), printf(true, " sw=2 => output=Irrep list. Display the projected Dynkin weight system,~%"), printf(true, " sw=3 => output=Irrep list. Display the projeced Dynkin weight system together with the original weight system.~%"), printf(true, " WL = dict: [[\"Induced Reps\"]=(list of irreps), [\"Original Rep.\"]=[(dt), (hdw)], [\"SubGroup\"]= [(subgroup), (embMD)], ~%"), printf(true, " [\"Qlist\"] =(Q list), [\"QHLli st\"]=([Q, highest level] list).~%"), printf(true, " SubGrdm allows multiple U1 factors.~%") ), /*end if*/ /****>Symmetry breaking */ /***>proc:MaySubG */ if member(choice, ["all", "MaySubG"]) then ( printf(true, "~%"), printf(true, "*Embedding of algebras.~%"), printf(true, " MaySubG(dts1,dts0) => maplist : [dts0[1]=[dts1[1],..], dts0[2]=[dts1[3],..]]~%"), printf(true, " dts0=a target list of simple algebras,~%"), printf(true, " dts1=a list of may be subalgebras.~%") ), /*end if*/ /***>proc:mkSBchain */ if member(choice, ["all", "mkSBchain"]) then ( printf(true, "~%"), printf(true, "*Symmetry breaking chain making~%"), printf(true, " mkSBchain(SBClist0) => a complete SB chain list SBClist1.~%"), printf(true, " SBClist0=[a list of incomplete SBC's]~%"), printf(true, " e.g. [ [E6=[D5,U1], [D5=[A2,A1], [U1] ]] ] ~%"), printf(true, " SBClist1=[a list of complete SBC's]~%"), printf(true, " SBC=[ SBs,[maplist,unbroken alg list]]~%"), pritnf(true, " SBs=[a sequence of SB], SB=[E6=[D5,U1]](e.g.)~%"), printf(true, " maplist=[ a seq of alg maps], alg map= D5=[A2,A1] (e.g.)~%"), printf(true, " unbroken alg list= [A1,U1] (e.g.)~%"), printf(true, " a complete SBC=SBC with maplist=[] describing a complete SB chain from dt0 to dts~%"), printf(true, " e.g. [[E6=[D5,U1]],[D5=[A4,U1]],[A4=[A2,A1,U1]],[[],[U1,U1,U1]]]~%") ), /*end if*/ /***>proc:SBpattern */ if member(choice, ["all", "SBpattern"]) then ( printf(true, "~%"), printf(true, "*Symmetry breaking chain list~%"), printf(true, " SBpattern(dt,dts[,outsw=0/1])~%"), printf(true, " output: the SBchain list = [ [[SBlist,[[],Unbrknlist],...]~%"), printf(true, " SBlist =[ [ X0 =[ Y1, Y2,..]], [Y1 =[ Z1, ..], Y2=[Z2,...]], ... ] ~%"), printf(true, " Unbrknlist = [U1, P, ...] ~%"), printf(true, " dt=the Dynkin type of the initial algebra,~%"), printf(true, " dts= a list of Dynkin types for the final algebra,~%"), printf(true, " outsw=0 => output=the SBchain list, no display,~%"), printf(true, " outsw=1 => + monitordisplay of the SBchain list~%") ) /*end if*/ )$ /*end proc: procinfo */ /******>Applications */ /*****>test of the program */ if Job_test then( print("Program test"), /****> A4 */ /***>A4->A1xA2xU1 */ tmp: mkRSembM(A4, 2,1), embMD_A4_A1A2U1 : getdict(getdict(tmp, ["embM"]),[D])[1], /****>E6 */ /***>E6-> A1xA4xU1 */ tmp: mkRSembM(E6, 2,1), embMD_E6_A1A4U1 : getdict(getdict(tmp, ["embM"]),[D])[1] )$ /*end : Job_test */ /*****> EOF */