int matsol(void)
{
register struct elm *pivot;
register struct elm *el;
struct elm *hold;
int i, j;
double max;
/* Upper triangularization */
for (i=1 ; i <= neqn ; i++)
{
if (fabs((pivot = getelm(ELM0, eqord[i], varord[i]))->value) <= SMALL)
{
/* use max row element as pivot */
remelm(pivot);
max = SMALL;
pivot = ELM0;
for (el = rowst[eqord[i]] ; el != ELM0 ;
el = el->c_right)
if (fabs(el->value) > max)
max = fabs((pivot = el)->value);
if (pivot == ELM0)
return(0);
else
{
for (j = i; j<= neqn ; j++)
if (varord[j] == pivot->col)
break;
varord[j] = varord[i];
varord[i] = pivot->col;
}
}
/* Eliminate all elements in pivot column */
for (el = colst[pivot->col] ; el != ELM0 ; el = hold)
{
hold = el->r_down; /* el will be freed below */
if (el != pivot)
{
subrow(pivot, el);
remelm(el);
}
}
/* Remove pivot row from further upper triangle work */
for (el = rowst[pivot->row] ; el != ELM0 ; el = el->c_right)
{
if (el->r_up != ELM0)
el->r_up->r_down = el->r_down;
else
colst[el->col] = el->r_down;
if (el->r_down != ELM0)
el->r_down->r_up = el->r_up;
}
}
bksub();
return(1);
}
local void long_close(matrix* m, lie_Index first, lie_Index last)
{ lie_Index i,j; entry* root_i,* root_j,* t=mkintarray(s);
for (i=first; i<last; ++i)
{ root_i=m->elm[i]; if (Norm(root_i)>1) continue;
for (j=i+1; j<last; ++j)
{ root_j=m->elm[j]; if (Norm(root_j)>1) continue;
subrow(root_i,root_j,t,s);
if (isroot(t))
if (isposroot(t))
{ copyrow(t,root_i,s); break; } /* need not consider more |j|'s */
else add_xrow_to(root_j,-1,root_i,s);
}
}
freearr(t);
}
local void fundam(matrix* roots, lie_Index first, lie_Index* last)
{ lie_Index i,j,d; boolean changed;
entry* t=mkintarray(s); matrix mm,* m=&mm;
mm.elm=&roots->elm[first]; mm.nrows=*last-first; mm.ncols=roots->ncols;
for (i=m->nrows-1; i>0; changed ? Unique(m,cmpfn),i=m->nrows-1 : --i)
{ entry* root_i=m->elm[i]; changed=false;
for (j=i-1; j>=0; j--)
{ entry* root_j=m->elm[j]; entry c=Cart_inprod(root_j,root_i);
if (c==2 && eqrow(root_j,root_i,s))
{ cycle_block(m,j,m->nrows--,1); root_i=m->elm[--i];
}
else if (c>0)
{ changed=true;
{ copyrow(root_j,t,s); add_xrow_to(t,-c,root_i,s);
if (isposroot(t)) copyrow(t,root_j,s);
else
{ j=i; c=Cart_inprod(root_i,root_j);
copyrow(root_i,t,s); add_xrow_to(t,-c,root_j,s);
if (isposroot(t)) copyrow(t,root_i,s);
else
{ lie_Index k; entry* ln,* sh; /* the longer and the shorter root */
if (Norm(root_i)>Norm(root_j))
ln=root_i, sh=root_j; else ln=root_j, sh=root_i;
switch (Norm(ln))
{ case 2: subrow(ln,sh,sh,s); /* |sh=ln-sh| */
add_xrow_to(ln,-2,sh,s); /* |ln=ln-2*sh| */
break; case 3: /* |grp=@t$G_2$@>| now */
for (k=0; sh[k]==0; ++k) {} /* find the place of this $G_2$ component */
sh[k]=1; sh[k+1]=0; ln[k]=0; ln[k+1]=1;
/* return standard basis of full system */
break; default: error("problem with norm 1 roots\n");
}
}
}
}
}
}
}
cycle_block(roots,first+mm.nrows,roots->nrows,d=*last-first-mm.nrows);
*last-=d; roots->nrows-=d;
freearr(t);
}
poly* alt_Wsum(poly* p)
{ lie_Index i,k=0,r=p->ncols; poly* result; entry** res,*rho=mkintarray(r);
p=Alt_dom(p); for (i=0; i<r; ++i) rho[i]=1;
for (i=0; i<p->nrows; ++i) add_xrow_to(p->elm[i],1,rho,r);
result=mkpoly(p->nrows*bigint2entry(Worder(grp)),r); res=result->elm;
for (i=0; i<p->nrows; ++i)
{ lie_Index j,l; matrix* orbit=Weyl_orbit(p->elm[i],NULL); entry** x=orbit->elm;
bigint* c=p->coef[i],* min_c=sub(null,c);
for (j=0; j<orbit->nrows; ++j)
{ subrow(*x,rho,res[k],r); l=make_dominant(*x++)%2;
result->coef[k]= l ? min_c : c; setshared(result->coef[k]); ++k;
}
freemem(orbit);
}
freearr(rho);
assert(k==result->nrows);
return result; /* not sorted, but rows are unique */
}
