matrix* Weyl_root_orbit(entry* v) { lie_Index i,j,r=Lierank(grp),s=Ssrank(grp); entry* x=mkintarray(r); matrix* orbit, *result; entry** m; lie_Index dc=Detcartan(); mulvecmatelm(v,Cartan()->elm,x,s,r); orbit=Weyl_orbit(x,NULL); result=mkmatrix(orbit->nrows,s); m=result->elm; mulmatmatelm(orbit->elm,Icartan()->elm,m,orbit->nrows,s,s); freemem(orbit); for (i=0; i<result->nrows; ++i) for (j=0; j<s; ++j) m[i][j]/=dc; return result; }
static void set_simp_adjoint(entry* dst,simpgrp* g) { _index r=g->lierank; vector* high=Highroot(g); mulvecmatelm(high->compon,g->cartan->elm,dst,r,r); freemem(high); }
matrix* simp_proots(simpgrp* g) { if (g->roots!=NULL) return g->roots; { _index r=g->lierank,l,i,last_root; entry** cartan=simp_Cartan(g)->elm; entry** posr=(g->roots=mkmatrix(simp_numproots(g),r))->elm; entry* level=(g->level=mkvector(simp_exponents(g)[r-1]+1))->compon; entry* norm=(g->root_norm=mkvector(g->roots->nrows))->compon; entry* alpha_wt=mkintarray(r); /* space to convert roots to weight coordinates */ setlonglife(g->roots), setlonglife(g->level), setlonglife(g->root_norm); /* permanent data */ { _index i,j; for (i=0; i<r; ++i) for (j=0; j<r; ++j) posr[i][j] = i==j; level[0]=0; last_root=r; for (i=0; i<r; ++i) norm[i]=1; /* norms are mostly |1| */ switch (g->lietype) /* here are the exceptions */ { case 'B': for (i=0; i<r-1; ++i) norm[i]=2; /* $2,2,\ldots,2,1$ */ break; case 'C': norm[r-1]=2; /* $1,1,\ldots,1,2$ */ break; case 'F': norm[0]=norm[1]=2; /* $2,2,1,1$ */ break; case 'G': norm[1]=3; /* $ 1,3$ */ } } for (l=0; last_root>level[l]; ++l) { level[l+1]=last_root; /* set beginning of a new level */ for (i=level[l]; i<level[l+1]; ++i) { _index j,k; entry* alpha=posr[i]; mulvecmatelm(alpha,cartan,alpha_wt,r,r); /* get values $\<\alpha,\alpha_j>$ */ for (j=0; j<r; ++j) /* try all fundamental roots */ { entry new_norm; { if (alpha_wt[j]<0) /* then $\alpha+\alpha_j$ is a root; find its norm */ if (norm[j]==norm[i]) new_norm=norm[j]; /* |alpha_wt[j]==-1| */ else new_norm=1; /* regardless of |alpha_wt[j]| */ else if (norm[i]>1 || norm[j]>1) continue; /* both roots must be short now */ else if (strchr("ADE",g->lietype)!=NULL) continue; /* but long roots must exist */ else if (alpha_wt[j]>0) if (g->lietype!='G'||alpha_wt[j]!=1) continue; else new_norm=3; /* $[2,1]\to[3,1]$ for $G_2$ */ else if (alpha[j]==0) continue; /* $\alpha-\alpha_j$ should not have a negative entry */ else { { --alpha[j]; for (k=level[l-1]; k<level[l]; ++k) if (eqrow(posr[k],alpha,r)) break; ++alpha[j]; if (k==level[l]) continue; } new_norm=2; } } ++alpha[j]; /* temporarily set $\alpha\K\alpha+\alpha_j$ */ for (k=level[l+1]; k<last_root; ++k) if (eqrow(posr[k],alpha,r)) break; /* if already present, don't add it */ if (k==last_root) { norm[last_root]=new_norm; copyrow(alpha,posr[last_root++],r); } --alpha[j]; /* restore |alpha| */ } } } freearr(alpha_wt); return g->roots; } }