/* nc.c SYMMETRICA source code */
#include "def.h"
#include "macro.h"

static INT m_nc_sym(OP, OP);
static INT m_nc_alt(OP, OP, OP);

/*
 * Diese Routine berechnet den Vektor der Konjugiertenklassen
 * der An.
 *
 * Input:
 *   - n   : Gewicht der Partitionen
 *   - res : Vektor der Konjugiertenklassen der An
 *
 * Rueckgabewert: OK oder error
 *
 */
INT ak_make_alt_classes(OP n, OP res)
    {
    OP par;     /* Partition von n */
    OP per;     /* Permutation */
    OP sgn;     /* Signum der Permutation */
    OP l;       /* Anzahl der verschiedenen Konjugiertenklassen der An */
    INT i=0L;
    INT erg=OK;

    CTO(INTEGER,"ak_make_alt_classes(1)",n);
    FREESELF(res);

    /* Test auf Ganzzahligkeit von n */
    SYMCHECK (S_I_I(n) <= 0, "ak_make_alt_classes : n <= 0");

    /* Speicherplatzreservierung fuer die Objekte */
    par=callocobject();
    per=callocobject();
    sgn=callocobject();
    l=callocobject();

    /* Berechnung des Partitionenvektors (eigentlich eine Matrix) */
    erg += alt_dimension(n,l);
    erg += m_il_v(S_I_I(l),res);
    erg += first_partition(n,par);
    do    {
        erg += m_part_perm(par,per);
        erg += signum(per,sgn);
        if(S_I_I(sgn) == 1L)
            {
            if(split(n,par)==1L)
                {
                m_il_v(2L,S_V_I(res,i));
                erg += copy(par,S_V_I(S_V_I(res,i),0L));
                erg += m_i_i(0L,S_V_I(S_V_I(res,i),1L));
                i++;
                m_il_v(2L,S_V_I(res,i));
                erg += copy(par,S_V_I(S_V_I(res,i),0L));
                erg += m_i_i(1L,S_V_I(S_V_I(res,i),1L));
                }
            else    {
                erg += copy(par,S_V_I(res,i));
                }
            i++;
            }
        }
    while(next(par,par));

    /* Speicherplatzfreigabe */
    erg += freeall(par);
    erg += freeall(per);
    erg += freeall(sgn);
    erg += freeall(l);

    /* Rueckkehr in die aufrufende Routine */
    ENDR("ak_make_alt_classes");
} /* Ende von make_alt_classes */


/* n:   Gewicht der Partitionen
 * res: Vektor der irred. Darst. der An
 */
INT ak_make_alt_partitions(OP n, OP res)
    {
    OP par;       /* Partition von n */
    OP conpar;    /* konjugierte Partition */
    OP l;         /* Anzahl der verschiedenen irred. Darst. der An */
    INT i=0L,j;
    INT erg=OK;

    /* Test auf Ganzzahligkeit von n */
    CTO(INTEGER,"ak_make_alt_partitions",n);
    if (S_I_I(n) <= 0L)
        {
        error("ak_make_alt_partitions : n <= 0");
        return ERROR;
        }

    /* Speicherplatzreservierung fuer die Objekte */
    par=callocobject();
    conpar=callocobject();
    l=callocobject();

    /* Berechnung des Partitionenvektors (eigentlich eine Matrix) */
    erg += alt_dimension(n,l);
    erg += m_il_v(S_I_I(l),res);
    erg += first_partition(n,par);
    do    {
        erg += conjugate(par,conpar);
        j=part_comp(par,conpar);
        if(j==0L)
                /* zerfaellt */
                {
                erg += m_il_v(2L,S_V_I(res,i));
                erg += copy(par,S_V_I(S_V_I(res,i),0L));
                erg += m_i_i(0L,S_V_I(S_V_I(res,i),1L));
                i++;
                erg += m_il_v(2L,S_V_I(res,i));
                erg += copy(par,S_V_I(S_V_I(res,i),0L));
                erg += m_i_i(1L,S_V_I(S_V_I(res,i),1L));
                i++;
                }
        else if (j>0L)    {
                /* zerfaellt nicht */
                erg += copy(par,S_V_I(res,i));
                i++;
                }
        }
    while(next_apply(par));

    /* Speicherplatzfreigabe */
    FREEALL3(par,conpar,l);

    /* Rueckkehr in die aufrufende Routine */
    ENDR("ak_make_alt_partitions");
}


INT scan_gl_nc(OP a, OP b)
{
    OBJECTKIND k;
    INT i,erg = OK;
    OP c;
    CTO(EMPTY,"scan_gl_nc(2)",b);

    c = callocobject();
    erg += printeingabe("input of a character");
    erg += printeingabe("grouplabel = "); println(a);
    erg += m_il_v(2L,b); copy(a,S_NC_GL(b));
    erg += printeingabe("type of charactervalues");
    k = scanobjectkind();
    erg += m_gl_cl(a,c);
    erg += m_il_v(S_V_LI(c),S_NC_C(b));
    for (i=0L;i<S_V_LI(c);i++)
        {
        erg += println(S_V_I(c,i));
        erg += scan(k,S_V_I(S_NC_C(b),i));
        }
    erg += freeall(c);
    ENDR("scan_gl_nc");
}

#ifdef CHARTRUE
INT reduce_nc(OP a, OP b)
{
    OP c,d;
    INT i, erg=OK;
    CTO(VECTOR,"reduce_nc(1)",a);
    c =callocobject();
    d =callocobject();
    erg += m_gl_il(S_NC_GL(a),c);
    erg += copy(a,b);
    for (i=0L;i<S_V_LI(c);i++)
        {
        erg += m_gl_nc(S_NC_GL(a),S_V_I(c,i),d);
        erg += scalarproduct_nc(d,a,S_V_I(S_NC_C(b),i));
        }
    FREEALL2(c,d);
    ENDR("reduce_nc");
}


INT scalarproduct_nc(OP a, OP b, OP c)
{
    OP d,e;
    INT erg = OK;

    d = callocobject();
    e = callocobject();
    erg += mult(S_NC_C(a),S_NC_C(b),d);
    erg += m_gl_co(S_NC_GL(a),e);
    erg += mult_apply(e,d);
    erg += SYM_sum(d,e);
    erg += m_gl_go(S_NC_GL(a),d);
    erg += div(e,d,c);
    erg += freeall(e);
    erg += freeall(d);
    return erg;
}
#endif /* CHARTRUE */

/* grouporder */
INT m_gl_go(OP a, OP b)
{
    INT erg;
    if (SYM_GL(a))
        return fakul(S_GL_SYM_A(a),b);
    if (ALT_GL(a))
        {
        erg = fakul(S_GL_ALT_A(a),b);
        if (not einsp(b)) /* sonderfall a1 */
            erg += ganzdiv(b,cons_zwei,b);
        return erg;
        }
    if (CYCLIC_GL(a))
        return copy(S_GL_CYCLIC_A(a),b);
#ifdef KRANZTRUE
    if (KRANZ_GL(a))
        {
        return grouporder_kranz(a,b);
        }
#endif /* KRANZTRUE */
    return error("can not compute grouporder");
}

#ifdef CHARTRUE
/* labeles of irreducible characters */
INT m_gl_il(OP a, OP b)
{
    INT erg = OK;
    INT i;
    CE2(a,b,m_gl_il);


    if (CYCLIC_GL(a))
        {
        erg += m_l_v(S_GL_CYCLIC_A(a), b);
        for (i=0;i<S_V_LI(b);i++)
            M_I_I(i,S_V_I(b,i));
        goto ende;
        }
    else if (SYM_GL(a))
        {
        erg += makevectorofpart(S_GL_SYM_A(a),b);
        goto ende;
        }
    else if (ALT_GL(a))
        {
        erg += ak_make_alt_partitions(S_GL_ALT_A(a),b);
        goto ende;
        }
#ifdef KRANZTRUE
    else if (KRANZ_GL(a))
        {
        erg += m_vcl_kranz(a,b);
        goto ende;
        }
#endif /* KRANZTRUE */
    else
        erg += error("can not compute irr labeling");
ende:
    ENDR("m_gl_il");
}


INT m_gl_nc(OP a, OP b, OP c)
{
    OP d;
    INT erg = OK,i;
    if (SYM_GL(a))
        {
        if (S_O_K(b) == PARTITION)
            return m_nc_sym(b,c);
        if (S_O_K(b) == INTEGER)
            {
            d = callocobject();
            erg += m_gl_il(a,d);
            erg += m_nc_sym(S_V_I(d,S_I_I(b)),c);
            erg += freeall(d);
            return erg;
            }
        }
    if (ALT_GL(a))
        {
        if ((S_O_K(b) == PARTITION) /* no splitting rep */
            ||
            (S_O_K(b) == VECTOR) /* splitting */ )
            return m_nc_alt(a,b,c);
        if (S_O_K(b) == INTEGER)
            {
            d = callocobject();
            erg += m_gl_il(a,d);
            erg += m_nc_alt(a,S_V_I(d,S_I_I(b)),c);
            erg += freeall(d);
            return erg;
            }
        }
#ifdef KRANZTRUE
    if (KRANZ_GL(a))
        {
        if (S_O_K(b) == INTEGER)
            return m_nc_kranz(a,b,c);
        if ( (S_O_K(b) == MATRIX) ||
             (S_O_K(b) == KRANZTYPUS))
            {
            d = callocobject();
            erg += m_gl_il(a,d);
            for(i=0L;i<S_V_LI(d);i++)
                if (eq(b,S_V_I(d,i)))
                    {m_i_i(i,d);break;}
            erg += m_nc_kranz(a,d,c);
            erg += freeall(d);
            return erg;
            }
        }
#endif /* KRANZTRUE */
    println(a); println(b);
    return error("can not compute irr char");
}
#endif /* CHARTRUE */

/* make group label class label */
INT m_gl_cl(OP a, OP b)
{
    INT erg = OK,i;

    CE2(a,b,m_gl_cl);

        if (CYCLIC_GL(a))
                {
                erg += m_l_v(S_GL_CYCLIC_A(a), b);
                for (i=0;i<S_V_LI(b);i++)
                        M_I_I(i,S_V_I(b,i));
                return erg;
                }
#ifdef PARTTRUE
    else if (SYM_GL(a))
        return makevectorofpart(S_GL_SYM_A(a),b);
    else if (ALT_GL(a))
        return ak_make_alt_classes(S_GL_ALT_A(a),b);
#endif /* PARTTRUE */
#ifdef KRANZTRUE
    else if (KRANZ_GL(a))
        return m_vcl_kranz(a,b);
#endif /* KRANZTRUE */
    else
        erg += error("can not compute class labeling");
    ENDR("m_gl_cl");
}


/* enter group label a and group element b, get class label */
INT m_gl_ge_cl(OP a, OP b, OP c)
{
    INT erg = OK;
    CTO(VECTOR,"m_gl_ge_cl(1)",a);
    if (SYM_GL(a))
        {
        CTO(PERMUTATION,"m_gl_ge_cl(2)",b);
        erg += zykeltyp(b,c);
        goto ende;
        }
    else if (ALT_GL(a))
        {
        OP d;
        CTO(PERMUTATION,"m_gl_ge_cl(2)",b);
        d = CALLOCOBJECT();
        erg += zykeltyp(b,d);
        if (split(S_GL_ALT_A(a),d) ) {
            m_il_v(2,c);
            SWAP(d,S_V_I(c,0));
            M_I_I(which_part(b),S_V_I(c,1));
            }
        else
            SWAP(c,d);
        FREEALL(d);
        goto ende;
        }
    else {
        NYI("m_gl_ge_cl");
        }
ende:
    ENDR("m_gl_ge_cl");
}


/* class order */
INT m_gl_co(OP a, OP b)
{
    OP c,d;
    INT i,erg=OK;
    CE2(a,b,m_gl_co);

    if (CYCLIC_GL(a))
        {
        erg += m_l_v(S_GL_CYCLIC_A(a), b);
        for (i=0;i<S_V_LI(b);i++)
            M_I_I((INT)1,S_V_I(b,i));
        return erg;
        }
    else if (SYM_GL(a))
        {
        c = callocobject();
        erg += m_gl_cl(a,c);
        erg += m_l_v(S_V_L(c),b);
        for (i=0L;i<S_V_LI(b);i++)
            {
            erg += ordcon(S_V_I(c,i),S_V_I(b,i));
            }
        erg += freeall(c);
        return erg;
        }
    else if (ALT_GL(a))
        {
        c = callocobject();
        erg += m_gl_cl(a,c);
        erg += m_l_v(S_V_L(c),b);
        for (i=0L;i<S_V_LI(b);i++)
            {
            if (S_O_K(S_V_I(c,i)) == PARTITION)
                erg += ordcon(S_V_I(c,i),S_V_I(b,i));
            else /* is a splitting class */
                {
                erg += ordcon(S_V_I(S_V_I(c,i),0L),S_V_I(b,i));
                erg += div(S_V_I(b,i),cons_zwei,S_V_I(b,i));
                }
            }
        erg += freeall(c);
        return erg;
        }
#ifdef KRANZTRUE
    else if (KRANZ_GL(a))
        {
        c = callocobject();
        d = callocobject();
        erg += m_gl_cl(a,c);
	/* labeling of classes for the first group */
        erg += m_gl_cl(S_GL_KRANZ_GLA(a),d);
        erg += m_l_v(S_V_L(c),b);
        for (i=0L;i<S_V_LI(b);i++)
            {
            erg += typusorder(S_V_I(c,i),
                S_GL_KRANZ_A(a),S_GL_KRANZ_B(a),
                S_V_I(b,i),d);
            }
        erg += freeall(d);
        erg += freeall(c);
        return erg;
        }
#endif /* KRANZTRUE */
    else
        erg += error("can not compute class order");
    ENDR("m_gl_co");
}


/* class rep; b will be a vector object of length = number of classes */
INT m_gl_cr(OP a, OP b)
{
    OP c;
    INT i,j,erg=OK;
    CE2 (a,b,m_gl_cr);

    if (CYCLIC_GL(a))
        {
        erg += m_l_v(S_GL_CYCLIC_A(a),b);
        for (i=0;i<S_V_LI(b);i++)
            {
            erg += m_il_p(S_V_LI(b),S_V_I(b,i));
            for(j=0;j<S_P_LI(S_V_I(b,i));j++)
                erg += m_i_i((1+j+i) % S_V_LI(b),
                    S_P_I(S_V_I(b,i),j));
            }
        goto endr_ende;
        }
    if (SYM_GL(a))
        {
        c = callocobject();
        erg += m_gl_cl(a,c);
        erg += m_l_v(S_V_L(c),b);
        for (i=0L;i<S_V_LI(b);i++)
            {
            erg += m_part_perm(S_V_I(c,i),S_V_I(b,i));
            }
        erg += freeall(c);
        goto endr_ende;
        }
#ifdef MATRIXTRUE
    if (ALT_GL(a))
        {
        c = callocobject();
        erg += makealtclassreps(S_GL_ALT_A(a),c,b);
        erg += freeall(c);
        goto endr_ende;
        }
#endif /* MATRIXTRUE */
    if (GLNQ_GL(a))
        {
        erg += class_label_glnq(S_GL_GLNQ_N(a),S_GL_GLNQ_Q(a),b);
        goto endr_ende;
        }
    error("can not compute class reps");
    ENDR("m_gl_cr");
}

#ifdef CHARTRUE
INT m_gl_chartafel(OP a, OP b)
{
    INT erg = OK;
    if (SYM_GL(a))
        erg += chartafel(S_GL_SYM_A(a),b);
    else if (ALT_GL(a))
        erg += an_tafel(S_GL_SYM_A(a),b);
    else if (CYCLIC_GL(a))
        erg += cyclic_tafel(S_GL_CYCLIC_A(a),b);
#ifdef KRANZTRUE
    else if (KRANZ_GL(a))
        {
        OP c=callocobject();
        OP d=callocobject();
        erg += kranztafel(S_GL_KRANZ_B(a),S_GL_KRANZ_A(a),b,c,d);
        erg += freeall(c);
        erg += freeall(d);
        }
#endif /* KRANZTRUE */
    else
	{
	erg += error("can not compute character table");
	}
    ENDR("m_gl_chartafel");
}
#endif /* CHARTRUE */

INT cyclic_tafel(OP a, OP b)
{
    INT erg = OK,i,j;
    OP c;
    CTO(INTEGER,"cyclic_tafel",a);
    CE2(a,b,cyclic_tafel);

    c = callocobject();
    erg += m_lh_m(a,a,b);
    for (i=0;i<S_M_HI(b);i++)
    for (j=0;j<S_M_LI(b);j++)
        {
        m_i_i(i * j,c);
        make_index_coeff_power_cyclo(a,cons_eins,c,S_M_IJ(b,i,j));
        }
    freeall(c);
    ENDR("cyclic_tafel");
}


#ifdef KRANZTRUE

/* v is vector with char values
 * g is degree of hyperoktaeder group
 * c becomes character
 */
INT m_vec_grad_nc_hyp(OP v, OP g, OP c)
{
    OP d;
    INT erg = OK;
    CTO(VECTOR,"m_vec_grad_nc_hyp(1)",v);
    d = callocobject();
    erg += m_i_i(2L,d);
    erg += m_il_v(2L,c);
    erg += m_gl_symkranz(d,g,S_V_I(c,0L));
    erg += copy(v,S_V_I(c,1L));
    erg += freeall(d);
    ENDR("m_vec_grad_nc_hyp");
}


/* a is matrix labeling of Sm wr Sn class
 * b becomes representing element of the class
 */
INT class_rep_kranz(OP a, OP b)
{
    return error("class_rep_kranz:not yet implemented");
}


INT reduce_nc_kranz(OP a, OP b)
{
    OP c ,d,e,f,g;
    INT erg = OK;
    CTO(VECTOR,"reduce_nc_kranz(1)",a);
    c = callocobject();
    d = callocobject();
    e = callocobject();
    f = callocobject();
    g = callocobject();
    erg += m_i_i(0L,d);
    erg += m_vco_kranz(S_NC_GL(a),f);
    erg += grouporder_kranz(S_NC_GL(a),g);
    erg += copy(a,b);
    for (;lt(d,S_V_L(S_V_I(b,1L)));inc(d))
    {
        erg += m_nc_kranz(S_NC_GL(a),d,c);
        erg += mult_nc_kranz(c,a,e);
        erg += mult(S_V_I(e,1L),f,c);
        erg += div(c,g,c);
        erg += SYM_sum(c,S_V_I(S_NC_C(b),S_I_I(d)));
    }
    erg += freeall(c);
    erg += freeall(d);
    erg += freeall(e);
    erg += freeall(f);
    erg += freeall(g);
    ENDR("reduce_nc_kranz");
}


INT mult_nc_kranz(OP a, OP b, OP c)
{
    INT erg = OK;
    CTO(VECTOR,"mult_nc_kranz(1)",a);
    CTO(VECTOR,"mult_nc_kranz(2)",b);
    if (neq(S_NC_GL(a),S_NC_GL(b)))
        error("mult_nc_kranz:different groups");
    erg += copy(a,c);
    erg += mult(S_NC_C(a),S_NC_C(b),S_NC_C(c));
    ENDR("mult_nc_kranz");
}


INT grouporder_kranz(OP l, OP a)
{
    OP zz,z;
    INT erg = OK;
    CTO(VECTOR,"grouporder_kranz(1)",l);
    z = callocobject();
    zz = callocobject();
    erg += fakul(S_GL_KRANZ_B(l),z);
    erg += fakul(S_GL_KRANZ_A(l),zz);
    erg += hoch(zz,S_GL_KRANZ_B(l),a);
    erg += mult_apply(z,a);
    erg += freeall(z);
    erg += freeall(zz);
    ENDR("grouporder_kranz");
}


INT scan_nc_kranz(OP a)
{
    OP b,c,l,d;
    OBJECTKIND k;
    INT i;
    INT erg = OK;
    CTO(EMPTY,"scan_nc_kranz(1)",a);
    b = callocobject();
    c = callocobject();
    l = callocobject();
    d = callocobject();
    erg += scan(INTEGER,b);
    erg += scan(INTEGER,c);
    erg += m_gl_symkranz(b,c,l);
    erg += numberof_class_kranz(l,d);
    erg += k=scanobjectkind();
    erg += m_il_v(2L,a);
    erg += copy(l,S_V_I(a,0L));
    erg += m_l_v(d,S_V_I(a,1L));
    for (i=0L;i<S_I_I(d);i++)
        erg += scan(k,S_V_I(S_V_I(a,1L),i));
    erg += freeall(b);
    erg += freeall(c);
    erg += freeall(l);
    erg += freeall(d);
    ENDR("scan_nc_kranz");
}


/* computes the class labeling of a wreath product of two symm groups.
 * l is the corresponding group label, a becomes vector of matrices
 */
INT m_vcl_kranz(OP l, OP a)
{
    OP za,zb;
    OP f,c,h;
    INT j;
    za = S_V_I(S_V_I(S_V_I(l,1L),1L),1L);
    zb = S_V_I(S_V_I(S_V_I(l,1L),0L),1L);
    /* zb wr za */
    f = callocobject();
    c = callocobject();
    h = callocobject();
    makevectorofpart(zb,f);
    makevectorof_kranztypus(za,S_V_L(f),c);
    m_il_v(S_V_LI(c),a);
    for(j = 0L; j<S_V_LI(c);j++) {
        kranztypus_to_matrix(S_V_I(c,j),S_V_I(a,j));
    }
    SYM_sort(a);
    freeall(f); freeall(h); freeall(c);
    return OK;
}
#endif /* KRANZTRUE */

#ifdef KRANZTRUE
/* vector of class orders of a wreath product of two symm groups */
INT m_vco_kranz(OP l, OP a)
{
    OP za,zb;
    OP f,c,h;
    INT j;
    za = S_V_I(S_V_I(S_V_I(l,1L),1L),1L);
    zb = S_V_I(S_V_I(S_V_I(l,1L),0L),1L);
    /* zb wr za */
    f = callocobject();
    c = callocobject();
    h = callocobject();
    makevectorofpart(zb,f);
    makevectorof_kranztypus(za,S_V_L(f),c);
    m_il_v(S_V_LI(c),h);
    for(j = 0L; j<S_V_LI(c);j++) {
        kranztypus_to_matrix(S_V_I(c,j),S_V_I(h,j));
        }

    SYM_sort(h);
    m_l_v(S_V_L(h),a);
    for(j = 0L; j<S_V_LI(c);j++) {
        typusorder(S_V_I(h,j), zb, za, S_V_I(a,j), f);
        }
    freeall(f); freeall(c); freeall(h);
    return OK;
}


INT numberof_class_kranz(OP l, OP a)
{
    INT erg = OK;
    OP za,zb;
    OP f,c;
    za = S_V_I(S_V_I(S_V_I(l,1L),1L),1L);
    zb = S_V_I(S_V_I(S_V_I(l,1L),0L),1L);
    /* zb wr za */
    f = callocobject();
    c = callocobject();
    erg += makevectorofpart(zb,f);
    erg += makevectorof_kranztypus(za,S_V_L(f),c);
    erg += copy(S_V_L(c),a);
    erg += freeall(f);
    erg += freeall(c);
    return erg;
}


INT order_class_kranz(OP l, OP i, OP a)
{
    OP za,zb;
    OP f,c,h;
    INT j;
    INT erg = OK;
    za = S_V_I(S_V_I(S_V_I(l,1L),1L),1L);
    zb = S_V_I(S_V_I(S_V_I(l,1L),0L),1L);
    /* zb wr za */
    f = callocobject();
    c = callocobject();
    h = callocobject();
    erg += makevectorofpart(zb,f);
    erg += makevectorof_kranztypus(za,S_V_L(f),c);
    erg += m_il_v(S_V_LI(c),h);
    for(j = 0L; j<S_V_LI(c);j++) {
        erg += kranztypus_to_matrix(S_V_I(c,j),S_V_I(h,j));
    }

    erg += SYM_sort(h);
    erg += typusorder(S_V_I(h,S_I_I(i)), zb, za, a, f);
    erg += freeall(f);
    erg += freeall(c);
    erg += freeall(h);
    return erg;
}


/* l is group label
 * i is integer which selects the i-th ireducible character
 * b becomes character
 */
INT m_nc_kranz(OP l, OP i, OP b)
{
    OP c , ll ;
    OP d,e;
    OP za,zb;
    INT erg = OK;
    c = callocobject();
    ll = callocobject();

    erg += m_il_v(2L,b);
    erg += copy(l,S_V_I(b,0L));

        d = callocobject();
        e = callocobject();
        za = S_V_I(S_V_I(S_V_I(l,1L),1L),1L);
        zb = S_V_I(S_V_I(S_V_I(l,1L),0L),1L);
        /* zb wr za */
        erg += kranztafel(za,zb,c,d,e);
        erg += copy(l,ll);

    if (ge(i,S_M_H(c))) error("m_nc_kranz: wrong index");
    erg += select_row(c,S_I_I(i),S_V_I(b,1L));

    erg += freeall(d);
    erg += freeall(e);
    erg += freeall(ll);
    erg += freeall(c);

    return erg;
}


/* make group label for kranzprodukt of two sym groups,
 * c = s_a wr s_b */
INT m_gl_symkranz(OP a, OP b, OP c)
{
    m_il_v(2L,c);
    m_i_i(3L,S_V_I(c,0L));  /* 3 == Kranzprodukt */
    m_il_v(2L,S_V_I(c,1L));
    m_gl_sym(a,S_V_I(S_V_I(c,1L),0L));
    m_gl_sym(b,S_V_I(S_V_I(c,1L),1L));
    return OK;
}


INT m_gl_glnq(OP n, OP q, OP c)
{
    m_il_v(2L,c);
    m_i_i(5L,S_V_I(c,0L));  /* 5 == GL(n,q) */
    m_il_v(2L,S_V_I(c,1L));
    m_i_i(s_i_i(n), S_V_I(S_V_I(c,1L),0L));
    m_i_i(s_i_i(q), S_V_I(S_V_I(c,1L),1L));
    return OK;
}


/* make group-label for hyperoctaeder */
INT m_gl_hyp(OP a, OP b)
{
    return m_gl_symkranz(cons_zwei,a,b);
}
#endif /* KRANZTRUE */

/* make group-label for cyclic */
INT m_gl_cyclic(OP a, OP b)
{
    INT erg = OK;
    CTO(INTEGER,"m_gl_cyclic(1)",a);
    erg += m_il_v(2L,b);
    erg += m_i_i(4L,S_V_I(b,0L)); /* 4 == cyclic group */
    erg += copy(a,S_V_I(b,1L));
    ENDR("m_gl_cyclic");
}


/* make group-label for alt, a and b may be equal */
INT m_gl_alt(OP a, OP b)
{
    INT erg = OK,i;
    CTO(INTEGER,"m_gl_alt(1)",a);
    i = S_I_I(a);
    erg += m_il_v(2L,b);
    M_I_I(2L,S_V_I(b,0L)); /* 2 == alternating group */
    M_I_I(i,S_V_I(b,1L));
    ENDR("m_gl_alt");
}

INT m_gl_sym(OP a, OP b)
/* make group-label for sym */
{
    INT erg = OK;
    erg += m_il_v(2L,b);
    erg += m_i_i(1L,S_V_I(b,0L)); /* 1 == symmetric group */
    erg += copy(a,S_V_I(b,1L));
    return erg;
}

#ifdef CHARTRUE

/* b is part or vec in case of splitting rep
 * c is group label of thew alternating group
 * the result is an irreducible character
 */
static INT m_nc_alt(OP c, OP b, OP a)
{
    OP d = callocobject();
    OP e = callocobject();
    INT erg = OK;
    INT i;
    erg += m_gl_cr(c,d); /* class reps */
    erg += m_gl_cl(c,e); /* class labels */
    erg += m_il_v(2L,a);
    erg += copy(c , S_V_I(a,0L));
    erg += m_il_v(S_V_LI(d), S_V_I(a,1L)); /* structure of new charater */
    for (i=0L;i < S_V_LI(d); i++)
        {
        if (S_O_K(b) == PARTITION) /* not splitting rep */
            a_charvalue(b,S_V_I(d,i),S_V_I(S_V_I(a,1L),i));
        else if (S_O_K(b) == VECTOR) /* splitting rep */
            {
            if (S_O_K(S_V_I(e,i)) == VECTOR) /* splitting class */
                {
                    if (nullp(S_V_I(b,1L))) /* irrep part+ */
                        a_charvalue(S_V_I(b,0L),S_V_I(d,i),S_V_I(S_V_I(a,1L),i));
                    else /* compute values for part+ on exchanged classes */
                        {
                        if (nullp(S_V_I(S_V_I(e,i),1L))) /* class+ */
                            a_charvalue(S_V_I(b,0L),S_V_I(d,i+1L),S_V_I(S_V_I(a,1L),i));
                        else /* class- */
                            a_charvalue(S_V_I(b,0L),S_V_I(d,i-1L),S_V_I(S_V_I(a,1L),i));
                        }
                }
            else
                a_charvalue(S_V_I(b,0L),S_V_I(d,i),S_V_I(S_V_I(a,1L),i));
            }
        }
    freeall(d);
    freeall(e);
    return erg;
}


/* b is partition, a becomes irred char */
static INT m_nc_sym(OP b, OP a)
{
    OP c = callocobject();
    INT erg = OK;

    erg += m_il_v(2L,a);
    erg += m_il_v(2L,S_V_I(a,0L));
    erg += weight(b,c);
    erg += m_gl_sym(c,S_V_I(a,0L));
    erg += m_part_sc(b,c);
    erg += copy(S_SC_W(c),S_V_I(a,1L));
    erg += freeall(c);
    return erg;
}
#endif /* CHARTRUE */

#ifdef MATRIXTRUE
/*
 * Diese Routine berechnet zwei Vektoren.
 *
 *   1.Vektor:  Partition der Konjugiertenklassen der An (class)
 *   2.Vektor:  Standardrepraesentanten dieser Klassen (reps)
 *
 * Rueckgabewert: OK oder error
 */
INT makealtclassreps(OP n, OP class, OP reps)
    {
    OP  matrix;       /* Partitionen der Klassen */
    OP  trans;        /* (12) */
    INT i,j;
    INT erg = OK;

    FREESELF2(class,reps);


    /* Test auf Ganzzahligkeit von n */
    if (S_O_K(n) != INTEGER)
        {
        error("makealtclassreps : n is no INTEGER.");
        return ERROR;
        }
    if (S_I_I(n) <= 0L)
        {
        error("makealtclassreps : n is negativ.");
        return ERROR;
        }

    /* Speicherplatzreservierung */
    matrix=callocobject();
    trans=callocobject();

    /* Berechnung der beiden Vektoren */
    erg += make_alt_classes(n,matrix);
    erg += m_il_nv(S_M_LI(matrix),class);
    erg += m_il_nv(S_M_LI(matrix),reps);
    for(i=0L;i<s_v_li(class);i++)
        {
        erg += copy(S_M_IJ(matrix,0L,i),S_V_I(class,i));
        erg += std_perm(S_V_I(class,i),S_V_I(reps,i));
        if(S_M_IJI(matrix,1L,i)==1L)
            {
            erg += m_il_p(S_I_I(n),trans);
            erg += m_i_i(2L,S_P_I(trans,0L));
            erg += m_i_i(1L,S_P_I(trans,1L));
            for(j=2L;j<S_I_I(n);j++)
                erg += m_i_i(j+1L,S_P_I(trans,j));
            erg += mult(trans,S_V_I(reps,i),S_V_I(reps,i));
            erg += mult(S_V_I(reps,i),trans,S_V_I(reps,i));
            }
        }

    FREEALL2(matrix,trans);
    ENDR("makealtclassreps");
    }
#endif /* MATRIXTRUE */


/*
 * Diese Routine vergleicht zwei Partitionen a und b bezueglich
 * der lexikographischen Ordnung.
 *    Rueckgabewert:    0L,  falls a=b
 *                      <0L, falls a<b
 *                      >0L, falls a>b
 *
 */
INT part_comp(OP a, OP b)
    {
    OP    l;
    INT i;

    l=callocobject();

    if (S_PA_LI(a) > S_PA_LI(b))
        m_i_i(S_PA_LI(b),l);
    else
        m_i_i(S_PA_LI(a),l);
    i=0L;
    do     i++;
    while(i<S_I_I(l) && S_PA_II(a,S_PA_LI(a)-i)==S_PA_II(b,S_PA_LI(b)-i));
    if(S_PA_II(a,S_PA_LI(a)-i)<S_PA_II(b,S_PA_LI(b)-i))
        {
        freeall(l);
        return -1L;
        }
    if(S_PA_II(a,S_PA_LI(a)-i)>S_PA_II(b,S_PA_LI(b)-i))
        {
        freeall(l);
          return 1L;
        }
    freeall(l);
    return 0L;
    }


#ifdef PERMTRUE
/*
 * Diese Routine berechnet zu einer Partition die Standardpermutation
 * in umgekehrter Reihenfolge wie m_part_perm().
 *
 * Rueckgabewert: OK oder error.
 */
INT std_perm(OP a, OP b)
{
    INT i,j,k; /* die adresse in der perm. b */
    OP l;

    l=callocobject();

    weight(a,l);
    if (not EMPTYP(b))
        freeself(b);
    b_ks_p(VECTOR,callocobject(),b);
    b_l_v(l,S_P_S(b));
    C_O_K(S_P_S(b),INTEGERVECTOR);
    k=0L;
    for (i=S_PA_LI(a)-1L;i>=0L;i--)
    {
        /* k ist naechste frei stelle */
        M_I_I(k+1L,S_P_I(b,k+S_PA_II(a,i)-1L));
        for (j=1L;j<S_PA_II(a,i);j++)
            M_I_I(j+k+1L,S_P_I(b,k+j-1L));
        k=k+S_PA_II(a,i);
    };
    return(OK);
}
#endif /* PERMTRUE */

#ifdef MATRIXTRUE
/*
 * Diese Routine berechnet den Charakterwert einer irreduziblen
 * Darstellung (rep) auf der Konjugiertenklasse (part) der An.
 *
 * Input:
 *   - rep:   Partition der irreduziblen Darstellung der An
 *   - part:  Partition der Konjugiertenklasse oder Permutation
 *   - res:   Beginn: leer; Ende: Charakterwert
 *   - index: 0 or 1  to switch between to different irreducibles
 *
 * Rueckgabewert:   OK oder error
 */
INT a_charvalue_co(OP rep, OP part, OP res, INT index)
    {
    OP conrep;    /* konjugierte Partition zu rep */
    OP newpart;   /* Zykelpartition,falls part Permutation ist */
    OP h_part;    /* Hakenpartition zu rep */
    OP sgn;       /* Signum zu part */

    INT erg=OK;   /* Rueckgabewert */

    CTO(PARTITION,"a_charvalue(1)",rep);
    CTTO(PERMUTATION,PARTITION,"a_charvalue(2)",part);

    FREESELF(res);

    /* newpart wird Partition der Konjugiertenklasse, */
    /* part wird Permutation daraus. */
    newpart = CALLOCOBJECT();
    if (S_O_K(part) == PERMUTATION)
        erg += zykeltyp_permutation(part,newpart);
    else
        {
        erg += copy(part,newpart);
        erg += m_part_perm(newpart,part);
        }

    /* Test, ob part tatsaechlich in der An liegt */
    sgn = CALLOCOBJECT();
    erg += signum_permutation(part,sgn);
    if (S_I_I(sgn) == -1L)
        {
        erg += error("a_charvalue: odd permutation ");
        goto acv_ende3;
        }

    /* Test, ob rep und newpart Partitionen der gleichen Zahl n sind */
    { INT wi,wj;
      PARTITION_WEIGHT(rep,wi);
      PARTITION_WEIGHT(newpart,wj);
      if (wi != wj) {
        error("a_charvalue: disagree in partition weights"); 
        goto acv_ende2;
        }
    }

    /* Falls rep nicht selbstassoziiert ist, kann der Charakterwert */
    /* wie bei der Sn (Murnaghan-Nakayama) berechnet werden. */
    conrep = CALLOCOBJECT();
    erg += conjugate_partition(rep,conrep);
    if(NEQ(rep,conrep))
        {
        erg += charvalue(rep,newpart,res,NULL);
        goto acv_ende1;
        }

    /* Falls rep selbstassoziiert ist */
    h_part = CALLOCOBJECT();
    erg += hook_part(rep,h_part);

    /* und falls part nicht die Hakenpartition von rep ist, bzw eine
     * Permutation aus der entsprechenden Konjugiertenklasse, wird der
     * Charakterwert der Sn halbiert. */

    if(NEQ(h_part,newpart))
        {
        erg += charvalue(rep,newpart,res,NULL);
        erg += half_apply(res);
        goto acv_ende;
        }

    /* und falls part doch die Hakenpartition ist, bzw. Permutation
     * daraus, wird der Charakterwert der zerfallenden Darstellung
     * auf der zerfallenden Konjugiertenklasse berechnet.
     */
    erg += wert((which_part(part) + index)%2,newpart,res);

acv_ende:
    FREEALL(h_part);
acv_ende1:
    FREEALL(conrep);
acv_ende2:
acv_ende3:
    FREEALL2(newpart,sgn);
    ENDR("a_charvalue");
    }
#endif /* MATRIXTRUE */

INT a_charvalue(OP rep, OP part, OP res)
{
    return a_charvalue_co(rep,part,res,0);
}


#ifdef MATRIXTRUE
/*
 * Diese Routine entscheidet, ob die Permutation per einer ueber
 * der An zerfallenden Konjugiertenklasse im ersten oder zweiten
 * Teil dieser Klasse liegt.
 *
 * Input:
 *   - per: Permutation einer zerfallenden Klasse
 *
 * Rueckgabewert: 0L, falls per im ersten Teil liegt 1L, sonst
 */
INT which_part(OP per)
    {
    OP typ;            /* Zykelpartition von per */
    OP std;            /* Konjugator zu per */
    OP sgn;            /* Signum von std */
    OP check;          /* Hilfsvektor der Laenge n */
    OP std_first;      /* Hilfsmatrix zur Konstruktion von std */
    INT alt,neu,i,j,k,l;
    INT erg = OK;

    CTO(PERMUTATION,"which_part(1)",per);
    CALLOCOBJECT5(std,typ,std_first,check,sgn);

    zykeltyp_permutation(per,typ);
    m_ilih_nm(S_PA_LI(typ),2L,std_first);
    for(i=0L;i<S_PA_LI(typ);i++)
        M_I_I(S_PA_II(typ,i),S_M_IJ(std_first,0L,i));
    m_il_nv(S_P_LI(per),check);
    m_il_p(S_P_LI(per),std);

    k= -1L;
    for(i=0L;i<S_PA_LI(typ);i++)
        {
        do k++;
        while(S_V_II(check,k)==1L);
        alt=k;
        M_I_I(1L,S_V_I(check,k));
        j=0L;
        do    {
            j++;
            neu=S_P_II(per,alt);
            alt=neu-1L;
            M_I_I(1L,S_V_I(check,alt));
            }
        while(neu!=k+1L);
        l= -1L;
        do    l++;
        while(S_M_IJI(std_first,0L,l)!=j);

        M_I_I(k,S_M_IJ(std_first,1L,l));
        }

    /* Belegung des Konjugators */
    k=0L;
    for(i=S_PA_LI(typ)-1L;i>=0L;i--)
        {
        M_I_I(S_M_IJI(std_first,1L,i)+1,S_P_I(std,k));
        k++;
        l=S_M_IJI(std_first,1L,i);
        for(j=0L;j<S_M_IJI(std_first,0L,i)-1L;j++)
            {
            M_I_I(S_P_II(per,l),S_P_I(std,k));
            l=S_P_II(per,l)-1L;
            k++;
            }
        }

    signum(std,sgn);
    i = S_I_I(sgn);
    FREEALL5(std,typ,std_first,check,sgn);
    if(i==1) return 0;
    else if(i==-1) return 1;

    SYMCHECK(1,"which_part:should never be here");
    ENDR("which_part");
    }


/*
 * Diese Routine berechnet den Vektor der irreduziblen Dar-
 * stellungen der An.p
 *
 * Input:
 *   - n:   Gewicht der Partitionen
 *   - res: Vektor der irred. Darst. der An
 *
 * Rueckgabewert: OK oder error
 *
 */
INT make_alt_partitions(OP n, OP res)
    {
    OP par;        /* Partition von n */
    OP conpar;     /* konjugierte Partition */
    OP l;          /* Anzahl der verschiedenen irred. Darst. der An */
    INT i=0L;
    INT erg=OK;

    if (not EMPTYP(res))
        erg +=  freeself(res);

    /* Test auf Ganzzahligkeit von n */
    if (S_O_K(n) != INTEGER)
        {
        error("make_alt_partitions : n is no INTEGER.");
        return ERROR;
        }
    if (S_I_I(n) <= 0L)
        {
        error("make_alt_partitions : n is negativ.");
        return ERROR;
        }

    /* Speicherplatzreservierung fuer die Objekte */
    conpar=callocobject();
    l=callocobject();
    par=callocobject();

    /*** Berechnung des Partitionenvektors (eigentlich eine Matrix) *******/
    erg += alt_dimension(n,l);
    erg += m_ilih_nm(S_I_I(l),2L,res);
    erg += first_partition(n,par);
    do    {
        erg += conjugate(par,conpar);
        if(part_comp(par,conpar)>=0L)
            {
            erg += copy(par,S_M_IJ(res,0L,i));
            if(part_comp(par,conpar)==0L && S_I_I(n)!=1L)
                {
                i++;
                erg += copy(par,S_M_IJ(res,0L,i));
                erg += m_i_i(1L,S_M_IJ(res,1L,i));
                }
            i++;
            }
        }
    while(next(par,par));

    /* Speicherplatzfreigabe */
    erg += freeall(par);
    erg += freeall(conpar);
    erg += freeall(l);

    /* Rueckkehr in die aufrufende Routine */
    if (erg != OK)
        {
        error("make_alt_partitions : error during computation.");
        return ERROR;
        }
    return OK;
    }/* Ende von make_alt_partitions */
#endif /* MATRIXTRUE */


#ifdef MATRIXTRUE
/*
 * Diese Routine berechnet den Vektor der Konjugiertenklassen
 * der An.
 *
 * Input:
 *   - n:   Gewicht der Partitionen
 *   - res: Vektor der Konjugiertenklassen der An
 *
 * Rueckgabewert: OK oder error
 */
INT make_alt_classes(OP n, OP res)
    {
    OP par;      /* Partition von n */
    OP per;      /* Permutation */
    OP sgn;      /* Signum der Permutation */
    OP l;        /* Anzahl der verschiedenen Konjugiertenklassen der An */
    INT i=0L;
    INT erg=OK;

    CTO(INTEGER,"make_alt_classes(1)",n);

    FREESELF(res);

    /* Test auf Ganzzahligkeit von n */
    SYMCHECK (S_I_I(n) <= 0,"make_alt_classes : n <=0");

    /* Speicherplatzreservierung fuer die Objekte */
    par=callocobject();
    per=callocobject();
    sgn=callocobject();
    l=callocobject();

    /* Berechnung des Partitionenvektors (eigentlich eine Matrix) */
    erg += alt_dimension(n,l);
    erg += m_ilih_nm(S_I_I(l),2L,res);
    erg += first_partition(n,par);
    do    {
        erg += m_part_perm(par,per);
        erg += signum(per,sgn);
        if(S_I_I(sgn) == 1L)
            {
            erg += copy(par,S_M_IJ(res,0L,i));
            if(split(n,par)==1L)
                {
                i++;
                erg += copy(par,S_M_IJ(res,0L,i));
                erg += m_i_i(1L,S_M_IJ(res,1L,i));
                }
            i++;
            }
        }
    while(next(par,par));

    /* Speicherplatzfreigabe */
    erg += freeall(par);
    erg += freeall(per);
    erg += freeall(sgn);
    erg += freeall(l);

    /* Rueckkehr in die aufrufende Routine */

    ENDR("make_alt_classes");
} /* Ende von make_alt_classes */
#endif /* MATRIXTRUE */

/*
 * Diese Routine berechnet die Dimension der Charaktertafel der
 * An, d.h. die Anzahl der gewoehnlichen irreduziblen Darstel-
 * lungen der An.
 *
 * Rueckgabewert: OK oder error
 */
INT alt_dimension(OP n, OP res)
    {
    OP par;        /* Partition von n */
    OP conpar;     /* konjugierte Partition */
    INT erg=OK;

    CTO(INTEGER,"alt_dimension(1)",n);

    FREESELF(res);

    /* Test auf Ganzzahligkeit von n */
    SYMCHECK(S_I_I(n) <= 0,"alt_dimension : n <= 0");

    /* Speicherplatzreservierung */
    par=callocobject();
    conpar=callocobject();

    /* Berechnung der Anzahl irreduzibler Darstellungen der An */
    erg += m_i_i(0L,res);
    erg += first_partition(n,par);
    do    {
        erg += conjugate(par,conpar);
        if(part_comp(par,conpar)>=0L)
            {
            erg += inc(res);
            if(part_comp(par,conpar)==0L && S_I_I(n)!=1L)
                erg += inc(res);
            }
        }
    while(next(par,par));

    /* Speicherplatzfreigabe */
    erg += freeall(par);
    erg += freeall(conpar);

    /* Rueckkehr in die aufrufende Routine */
    ENDR("alt_dimension");
} /* Ende von alt_dimension */



/*
 * Siese routine ueberprueft, ob die konjugiertenklasse par ueber
 * der an zerfaellt.
 *
 * Rueckgabewert:    1    falls die klasse zerfaellt,
 *                   0    sonst.
 */
INT split(OP n, OP par)
    {
    INT    i;

    OP    v;
    OP    w;

    /* Spezialfall n=1 */
    if (S_I_I(n) == 1L)
        return 0L;

    w=callocobject();
    v=callocobject();

    m_l_nv(n,v);
    for(i=0L;i<S_PA_LI(par);i++)
        {
        if (S_PA_II(par,i)%2 == 0L)
            {
            freeall(w);
            freeall(v);
            return 0L;
            }
        m_i_i(1L,w);
        add(S_V_I(v,S_PA_II(par,i)-1L),w,S_V_I(v,S_PA_II(par,i)-1L));
        }
    for(i=0L;i<S_I_I(n);i++)
        if (S_I_I(S_V_I(v,i)) > 1L)
            {
            freeall(w);
            freeall(v);
            return 0L;
            }
    freeall(w);
    freeall(v);
    return 1L;
    }

#ifdef MATRIXTRUE
/*
 *  Diese Routine berechnet die Charaktertafel der alternierenden Gruppe
 *  An fuer eine beliebige natuerliche Zahl n.
 */
INT an_tafel(OP n, OP tafel)
{
    OP    v_part;      /* Vektor der Partitionen von n */
    OP    par;         /* Partition von n */
    OP    conpar;      /* assoziierte Partition zu par */
    OP    per;         /* Permutation aus der Konjugiertenklasse (par) */
    OP    sgn;         /* Signum der Permutation per */
    OP    split_class; /* Hakenpartition h(par), falls par selbstassoziiert */
    OP    info_pa;     /* Infovektor fuer die irreduziblen Darstellungen */
    OP    info_cc;     /* Infovektor fuer die Konjugiertenklassen */
    OP    hilf;        /* Hilfsobjekt zum Umspeichern */

    INT    i,j;          /* Zaehlvariable zum Durchlauf der Infovektoren */
    INT    l=0L;         /* Groesse der Charaktertafel der An */
    INT    zeile,spalte; /* Indexvariable bei der Belegung der Charaktertafel */
    INT erg=OK;          /* Rueckgabewert */

    /* Test auf Ganzzahligkeit von n */
    CTO(INTEGER,"an_tafel",n);
    CE2(n,tafel,an_tafel);

    if (S_I_I(n) <= 0L)
        {
        erg += error("an_tafel : n is negativ.");
        goto endr_ende;
        }

    /* Die Charaktertafel der A1, und die der A2 ist [1] */
    if ((S_I_I(n) == 2L) || (S_I_I(n) == 1L))
        {
        erg +=  m_ilih_m(1L,1L,tafel);
        erg += m_i_i(1L,S_M_IJ(tafel,0L,0L));
        goto endr_ende;
        }

    C1R(n,"an_tafel",tafel);

    /* Speicherplatzreservierung der Objekte */
    v_part = callocobject();
    conpar = callocobject();
    par = callocobject();
    per = callocobject();
    sgn = callocobject();
    hilf = callocobject();
    split_class = callocobject();
    info_cc = callocobject();
    info_pa = callocobject();

    /* Initialisierung der Zahl 2 und des Partitionsvektors */
    erg +=  makevectorofpart(n,v_part);

    /* Initialisierung der Infovektoren als Nullvektoren */
    erg +=  m_il_nv(S_V_LI(v_part),info_pa);
    erg +=  copy(info_pa,info_cc);

    /* Belegung der Infovektoren */
    /* Durchlaufe die Partitionen von n mit par. */
    i = 0L;
    erg += first_partition(n,par);
    do
        {
	  /* Falls die Konjugiertenklasse (par) in der An liegt, wird in
	   * info_cc an der entsprechenden Stelle eine 1 eingetragen. */

        erg +=  m_part_perm(par,per);
        erg +=  signum(per,sgn);
        if (S_I_I(sgn) == 1L)
            {
            erg +=  m_i_i(1L,S_V_I(info_cc,i));
            l++;
            }

	/* Falls par selbstassoziiert ist, wird in info_pa fuer diese
	 * Partition und in info_cc fuer die zugehoerige Hakenpartition
	 * eine 2 eingetragen. */
        erg +=  conjugate(par,conpar);
        if (comp(par,conpar) == 0L)
            {
            erg +=  m_i_i(2L,S_V_I(info_pa,i));
            erg +=  hook_part(par,split_class);
            erg +=  m_i_i(2L,S_V_I(info_cc,indexofpart(split_class)));
            l++;
            }

	/* Falls par lexikographisch groesser als die dazu assoziierte
	 * Partition ist, erhaelt info_pa den Eintrag 1. */
        else
            if (S_V_II(info_pa,indexofpart(conpar)) == 0L)
                erg +=  m_i_i(1L,S_V_I(info_pa,i));

        i++;
        }
    while(next_apply(par));

    /* Initialisierung der Charaktertafel als Nullmatrix */
    erg +=  m_ilih_m(l,l,tafel);

    /* Belegung der Charaktertafel */
    zeile = 0L;
    spalte = 0L;

    /* Durchlaufe den Infovektor der irreduziblen Darstellungen  mit i */
    for(i=0L;i<S_V_LI(info_pa);i++)
        {
	  /* Im Falle einer nicht zerfallenden irreduziblen Darstellung
	   * erstelle die dazugehoerige Zeile der Charaktertafel. */
        if(S_V_II(info_pa,i)==1L)
            {
	      /* Durchlaufe den Infovektor der Konjugiertenklassen mit j. */

            for(j=0L;j<S_V_LI(info_cc);j++)
                {
		  /* Liegt die Konjugiertenklasse in der An, berechne
		   * den entsprechenden Charakterwert der Sn. */

                if(S_V_II(info_cc,j)>0L)
                    {
                    erg +=  charvalue(S_V_I(v_part,i),
                          S_V_I(v_part,j),
                          S_M_IJ(tafel,zeile,spalte),
                          NULL);
                    spalte++;

                    if(S_V_II(info_cc,j)==2L)
                        {
                    erg +=  copy(S_M_IJ(tafel,zeile,spalte-1L),
                             S_M_IJ(tafel,zeile,spalte));
                        spalte++;
                        }
                    }
                }
            zeile++;
            spalte = 0L;
            }

        /* Im Falle einer zerfallenden irreduziblen Darstellung
         * muessen zwei Zeilen in der Charaktertafel berechnet
         * werden. */
        if(S_V_II(info_pa,i)==2L)
            {
            erg +=  hook_part(S_V_I(v_part,i),split_class);

	    /* Durchlaufe den Infovektor der Konjugiertenklassen mit j. */

            for(j=0L;j<S_V_LI(info_cc);j++)
                {
		  /* Zerfaellt die Konjugiertenklasse nicht, berechne
		   * den entsprechenden Charakterwert der Sn, teile
		   * ihn durch zwei und trage ihn in beiden Zeilen ein.
		   */

                if(S_V_II(info_cc,j)==1L)
                    {
        erg +=  charvalue(S_V_I(v_part,i), S_V_I(v_part,j), hilf, NULL);
        erg +=  div(hilf,cons_zwei,S_M_IJ(tafel,zeile,spalte));
        erg +=  copy(S_M_IJ(tafel,zeile,spalte),
                     S_M_IJ(tafel,zeile+1L,spalte));
                    spalte++;
                    }
                /* Falls die Konjugiertenklasse jedoch zerfaellt, */

                if(S_V_II(info_cc,j)==2L)
                    {
		      /* und es sich um die zugehoerige Hakenpartition
		       * handelt, so berechne die entsprechenden zwei
		       * Charakterwerte und trage sie ueber Kreuz in
		       * die Charaktertafel ein. */

            if(eq(split_class,S_V_I(v_part,j)))
                        {
                erg +=  wert(0L,S_V_I(v_part,j),
                        S_M_IJ(tafel,zeile,spalte));
                erg +=  copy(S_M_IJ(tafel,zeile,spalte),
                    S_M_IJ(tafel,zeile+1L,spalte+1L));
                erg +=  wert(1L,S_V_I(v_part,j),
                    S_M_IJ(tafel,zeile,spalte+1L));
                erg +=  copy(S_M_IJ(tafel,zeile,spalte+1L),
                    S_M_IJ(tafel,zeile+1L,spalte));
                        }
	    /* Handelt es sich nicht um die zugehoerige Haken-
	     * partition, so berechne wieder den halben Wert
	     * des Charakters der Sn und trage diesen viermal
	     * in die Charaktertafel ein. */

                    else
                        {
            erg +=  charvalue(S_V_I(v_part,i),
                    S_V_I(v_part,j), hilf, NULL);
            erg +=  div(hilf,cons_zwei,S_M_IJ(tafel,zeile,spalte));
            COPY(S_M_IJ(tafel,zeile,spalte), S_M_IJ(tafel,zeile+1L,spalte));
            COPY(S_M_IJ(tafel,zeile,spalte), S_M_IJ(tafel,zeile+1L,spalte+1L));
            COPY(S_M_IJ(tafel,zeile,spalte), S_M_IJ(tafel,zeile,spalte+1L));
                        }

                    spalte = spalte+2L;
                    }
                }
            zeile = zeile+2L;
            spalte = 0L;
            }
        }


    /* Speicherplatzfreigabe */
    erg +=  freeall(v_part);
    erg +=  freeall(conpar);
    erg +=  freeall(par);
    erg +=  freeall(per);
    erg +=  freeall(sgn);
    erg +=  freeall(hilf);
    erg +=  freeall(split_class);
    erg +=  freeall(info_cc);
    erg +=  freeall(info_pa);

    /* Rueckkehr in die aufrufende Routine */
    S1R(n,"an_tafel",tafel);
    ENDR("an_tafel");
}/*** Ende von an_tafel ***/
#endif /* MATRIXTRUE */

#ifdef CHARTRUE
/*
 * Routine zur Berechnung des Charakterwertes auf der zerfallenden
 * Konjugiertenklasse (split_class) , den die zugehoerige irreduzible
 * Darstellung liefert. Der Wert wird in res zurueckgegeben.
 * Der Index gibt an, welcher der beiden konjugierten Werte berechnet
 *
 * Rueckgabewert:    OK oder error
 */
INT wert(INT index, OP split_class, OP res)
    {
    INT    i;
    OP    expo,    term_eins,    term_zwei;
    OP    n;
    INT erg=OK;
    CTO(PARTITION,"wert(2)",split_class);

    expo = callocobject();
    term_eins = callocobject();
    term_zwei = callocobject();
    n = callocobject();

    erg += weight(split_class,n);
    erg += copy(n,expo);
    erg += sub(expo,S_PA_L(split_class),term_eins);
    C_I_I(expo,S_I_I(term_eins)/2L);
    C_I_I(term_eins,-1L);
    erg += hoch(term_eins,expo,term_eins);

    C_I_I(expo,1L);
    for(i=0L;i<S_PA_LI(split_class);i++)
        erg += mult_apply(S_PA_I(split_class,i),expo);
    erg += mult_apply(term_eins,expo);
    erg += squareroot(expo,term_zwei);

    if (index == 0L)
        erg += add(term_eins,term_zwei,res);
    else
        erg += sub(term_eins,term_zwei,res);
    erg += div(res,cons_zwei,res);

    erg += freeall(expo);
    erg += freeall(term_eins);
    erg += freeall(term_zwei);
    erg += freeall(n);

    ENDR("wert");
    }
#endif /* CHARTRUE */

#ifdef PARTTRUE
/*
 * Diese routine berechnet zu einer selbstassoziierten partition par die
 * partition, die aus den hakenlaengen von par besteht.
  */
INT hook_part(OP par, OP res)
    {
    INT    i,j;
    INT    elementwert;
    OP    element;
    OP    v,hilfsvector;
    INT erg = OK;
    CTO(PARTITION,"hook_part(1)",par);

    if (not EMPTYP(res))
        freeself(res);

    element=callocobject();
    v=callocobject();
    hilfsvector=callocobject();


    elementwert = S_PA_II(par,S_PA_LI(par)-1L);
    elementwert = 2L *elementwert - 1L;
    erg +=  m_i_i(elementwert,element);
    erg +=  m_o_v(element,v);
    j = 2L;
    for (i=S_PA_LI(par)-2L; i>=0L; i--)
        {
        elementwert = S_PA_II(par,i);
        elementwert = 2L *(elementwert-j) + 1L;
        if (elementwert > 0L)
            {
            erg +=  c_i_i(element,elementwert);
            erg +=  append(v,element,hilfsvector);
            erg +=  copy(hilfsvector,v);
            }
        j++;
        }

    erg +=  m_v_pa(v,res);

    erg +=  freeall(v);
    erg +=  freeall(element);
    erg +=  freeall(hilfsvector);

    ENDR("hook_part");
    }
#endif /* PARTTRUE */

#ifdef PERMTRUE
INT m_gl_first(OP a, OP b)
{
if (CYCLIC_GL(a))
    return first_permutation(S_GL_CYCLIC_A(a),b);
if (SYM_GL(a))
    return first_permutation(S_GL_SYM_A(a),b);
if (ALT_GL(a))
    return first_permutation(S_GL_ALT_A(a),b);
return error("m_gl_first: can not handle group label");
}

/* loop over all group elements */
INT m_gl_next(OP a, OP b, OP c)
{
    OP d;
    INT erg,i,j;
    if (b == c)
        {
         d = callocobject();
        *d = *c;
        C_O_K(c,EMPTY);
        erg = m_gl_next(a,d,c);
        freeall(d);
        return erg;
        }
    if (SYM_GL(a))
        {
        return next(b,c);
        }
    if (ALT_GL(a))
        {
        erg = next(b,c);
        if (erg == FALSE)
            return erg; /* d.h. b war letzte permutation */
        while (oddp(c))
            {
            erg = next_apply(c);
            if (erg == FALSE) /* es gibt kein permutation aus an
			       * nach der permutation b */
                {
                copy(b,c);
                return FALSE;
                }
            }
        return TRUE;
        }
    if (CYCLIC_GL(a))
        {
        if (S_P_II(b,0L) == S_P_LI(b))
            return FALSE; /* war die letzte */
        copy(b,c);
        for (i=1L,j=0L;i<S_P_LI(c); i++,j++)
            M_I_I(S_P_II(b,i),S_P_I(c,j));
        M_I_I(S_P_II(b,0L),S_P_I(c,j));
        return TRUE;
        }
    return error("m_gl_next: can not handle group label");
}
#endif /* PERMTRUE */


/* the characteristic polynom of the companion matrix is the polynom p */
static INT companion_matrix(OP p, OP m)
{
    INT erg = OK,i;
    OP d,z,nu;
    d = CALLOCOBJECT();
    nu = CALLOCOBJECT();
    degree_polynom(p,d);
    m_lh_m(d,d,m);
    null(S_PO_K(p),nu);

    FORALL(z,m,{ copy(nu,z); });
    for (i=1;i<S_M_HI(m);i++) eins(S_PO_K(p),S_M_IJ(m,i,i-1));
    FORALL(z,p,{
               i = S_MO_SII(z,0);
               if (i < S_M_LI(m))
                   addinvers(S_MO_K(z),S_M_IJ(m,i,S_M_LI(m)-1));
               });
    FREEALL2(nu,d);
    ENDR("companion_matrix");
}


static INT all_irred_companion(OP n, OP q, OP v)
{
   INT erg = OK;
   CTO(INTEGER,"all_irred_companion(1)",n);
   SYMCHECK(S_I_I(n)<1,"all_irred_companion:degree < 1");
   CTO(INTEGER,"all_irred_companion(2)",q);
   SYMCHECK(prime_power_p(q)==FALSE,"all_irred_companion(2): no prime power");
   {
#ifdef FFTRUE
   if (einsp(n) )
      {
      OP ff=callocobject();INT i;
      first_ff_given_q(q,ff);/* Nul */
      m_il_v(S_I_I(q)-1,v);
      for (i=0;i<S_V_LI(v);i++) {
          next(ff,ff);
          m_lh_m(n,n,S_V_I(v,i));
          copy(ff,S_M_IJ(S_V_I(v,i),0,0));
          }
      FREEALL(ff);
      }
   else {
        OP p;INT i;
        p = CALLOCOBJECT();
        all_irred_polynomials(n,q,p);
        m_il_v(S_V_LI(p),v);
        for (i=0;i<S_V_LI(v);i++)
            companion_matrix(S_V_I(p,i),S_V_I(v,i));
        FREEALL(p);
        }
#endif
   }
   ENDR("all_irred_companion");
}


static void J_matrix(OP n, OP q, OP m)
{
    INT j; OP y;
    m_lh_m(n,n,m);
    FORALL(y,m,{ null_ff_given_q(q,y); });
    for (j=0;j<S_M_HI(m);j++) eins_ff_given_q(q,S_M_IJ(m,j,j));
    for (j=1;j<S_M_HI(m);j++) eins_ff_given_q(q,S_M_IJ(m,j,j-1));
}


/* alle füllungen eines blocks der grösse n */
static INT all_blocks(OP n, OP q, OP v)
{
    OP d,z,y;INT i,j;
    INT erg = OK;
    d = CALLOCOBJECT();
    m_il_v(0,v);
    alle_teiler(n,d);

    for (i=0;i<S_V_LI(d);i++) {
            OP teil= callocobject();
            OP v2= callocobject();
            OP j2= callocobject();
            ganzdiv(n,S_V_I(d,i),teil);
            all_irred_companion(teil,q,v2);
            J_matrix(S_V_I(d,i),q,j2);
            FORALL(z,v2, {kronecker_product(j2,z,z); });
            append(v2,v,v);
            FREEALL3(j2,teil,v2);
        }
    FREEALL(d);
    ENDR("all_blocks");
}


INT class_label_glnq(OP n, OP q, OP v)
{
    INT erg = OK;
    C2R(n,q,"class_label_glnq",v);
    erg += class_label_glnq_co(n,q,v,NULL);
    S2R(n,q,"class_label_glnq",v);
    ENDR("class_label_glnq");
}


INT class_label_glnq_co(OP n, OP q, OP v, OP pav)
{
	OP pa,cm;INT i,erg=OK,j,k;
	CALLOCOBJECT2(pa,cm);
	m_l_v(n,cm);
	for (i=0;i<S_V_LI(cm);i++)
	    {
	    m_i_i(1+i,pa); all_blocks(pa,q,S_V_I(cm,i));
	    }

	m_il_v(0,v);
	if (pav != NULL) m_il_v(0,pav);
	first_partition(n,pa);
	do {
	   OP vc= callocobject();
	   OP uc= callocobject();
	   OP f= callocobject();
	   m_l_v(S_PA_L(pa),vc);
	   m_l_nv(S_PA_L(pa),uc);
	   for (i=0;i<S_V_LI(vc);i++) M_I_I(S_V_LI(S_V_I(cm,S_PA_II(pa,i)-1)), S_V_I(vc,i));
	   /* vc enthaält die anzahl der möglichen block einträge */

	again:
	   m_lh_m(n,n,f);
	   for (i=0;i<S_M_HI(f);i++)
	   for (j=0;j<S_M_LI(f);j++) null_ff_given_q(q,S_M_IJ(f,i,j));
	   for (i=0,j=0;i<S_PA_LI(pa);i++)
	       {
	       INT ii,jj;
	       OP z = S_V_I(cm,S_PA_II(pa,i)-1); /* von hier wird der block geholt*/
	       for (ii=0;ii<S_PA_II(pa,i);ii++)
	       for (jj=0;jj<S_PA_II(pa,i);jj++)  copy(S_M_IJ(S_V_I(z,S_V_II(uc,i)),ii,jj),
						      S_M_IJ(f,j+ii,j+jj));
	       j+=S_PA_II(pa,i);
	       }
	   inc(v); SWAP(f,S_V_I(v,S_V_LI(v)-1));
	   if (pav != NULL) { inc(pav); copy(pa,S_V_I(pav,S_V_LI(pav)-1));}

	   /* compute next label */
	    for (i=S_V_LI(uc)-1;i>=0;i--)
		if ( S_V_II(uc,i) < S_V_II(vc,i)-1) {
		   if (i==0) { incr: inc(S_V_I(uc,i));
			       for (j=i+1;j<S_V_LI(uc); j++) m_i_i(0,S_V_I(uc,j));
			       goto again; }
		   else if (S_PA_II(pa,i) > S_PA_II(pa,i-1)) goto incr;
		   else if (S_V_II(uc,i) < S_V_II(uc,i-1) ) goto incr;
		   else continue;
		   }

	/* keine weitere klasse */
	  FREEALL3(f,uc,vc);
	  } while(next_apply(pa));
	FREEALL2(pa,cm);
	ENDR("class_label_glnq");
}


/* for the computation of c_ijk with group labels,
 * berechnung c_ijk mit gl.
 * input: group label gl
 *        class label cl
 * output: representing element
 */
INT class_rep(OP gl, OP cl, OP res)
{
	INT erg = OK;
	if (SYM_GL(gl))
		erg += m_part_perm(cl,res);
	else if (ALT_GL(gl)) {
		if (S_O_K(cl) == PARTITION)
			erg += m_part_perm(cl,res);
		else if (S_O_K(cl)==VECTOR)
			{
			erg += std_perm(S_V_I(cl,0),res);
			if (S_V_II(cl,1)==1) {
				OP trans=callocobject();
				make_n_kelmtrans(S_P_L(res),cons_eins,trans);
				mult(res,trans,res);
				mult(trans,res,res);
				freeall(trans);
				}
			}
		else
			error("class_rep(1): wrong cl for alternating group");
		}
	else
		NYI("class_rep");
	ENDR("class_rep");
}


/* gl is grouplabel
 * ge is a group element
 * res becomes the corresponding class label
 */
INT class_label(OP gl, OP ge, OP res)
{
	return m_gl_ge_cl(gl,ge,res);
}


/* computes value of the irreducible character il, on the class cl */
INT compute_gl_charvalue(OP gl, OP il, OP cl, OP res)
{
	INT erg = OK;
        if (SYM_GL(gl))
                erg += charvalue(il,cl,res,NULL);
        else if (ALT_GL(gl)) {
		OP h=callocobject();
		class_rep(gl,cl,h);
		if (S_O_K(il) == VECTOR)
			erg += a_charvalue_co(S_V_I(il,0),h,res,S_V_II(il,1));
		else
			erg += a_charvalue_co(il,h,res,0);
		freeall(h);
                }
        else
                NYI("compute_gl_charvalue");
        ENDR("compute_gl_charvalue");
}


INT compute_gl_il_dimension(OP gl, OP il, OP res)
{
        INT erg = OK;
        if (SYM_GL(gl))
                erg += dimension(il,res);
        else if (ALT_GL(gl)) {
		if (S_O_K(il) == VECTOR)
			{
			erg += dimension(S_V_S(il),res);
			erg += half_apply(res);
			}
                else
			erg += dimension(il,res);
                }
        else
                NYI("compute_gl_il_dimension");
        ENDR("compute_gl_il_dimension");
}


INT compute_gl_cl_classorder(OP gl, OP cl, OP res)
{
        INT erg = OK;
        if (SYM_GL(gl))
                erg += ordcon(cl,res);
        else if (ALT_GL(gl)) {
                if (S_O_K(cl) == VECTOR)
                        {
                        erg += ordcon(S_V_S(cl),res);
                        erg += half_apply(res);
                        }
                else
                        erg += ordcon(cl,res);
                }
        else
                NYI("compute_gl_cl_classorder");
        ENDR("compute_gl_cl_classorder");
}


/* gl is grouplabel,
 * i,j,k  are class labels of this group label,
 * res will be the result
 */
INT compute_gl_c_ijk(OP gl, OP i, OP j, OP k, OP res)
{
	INT erg = OK;
	if (SYM_GL(gl))
		c_ijk_sn(i,j,k,res);
	else {
		/* we use the formula of curtis reiner */
		OP il,h,ki,h1,h2,h3;
		INT l;
		CALLOCOBJECT3(il,h,ki);
		CALLOCOBJECT3(h1,h2,h3);

		m_i_i(0,res);
		/* ki is the class containing the inverse element */
		class_rep(gl,k,h1); invers(h1,h1); class_label(gl,h1,ki);

		m_gl_il(gl,il);
		for (l=0;l<S_V_LI(il);l++) /* over all irreducible characters */
			{
			compute_gl_charvalue(gl,S_V_I(il,l),i,h1);
			compute_gl_charvalue(gl,S_V_I(il,l),j,h2);
			compute_gl_charvalue(gl,S_V_I(il,l),ki,h3);
			mult(h1,h2,h);mult_apply(h3,h);
			compute_gl_il_dimension(gl,S_V_I(il,l),h1);
			div(h,h1,h);
			add_apply(h,res);
			}

		/* class orders */
		compute_gl_cl_classorder(gl,i,h1); mult_apply(h1,res);
		compute_gl_cl_classorder(gl,j,h1); mult_apply(h1,res);
		/* divide by group order */
		m_gl_go(gl,h1); div(res,h1,res);
		FREEALL3(il,h,ki);
		FREEALL3(h1,h2,h3);

	     }
	ENDR("compute_gl_c_ijk");
}
