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

static INT m_nc_sym();
static INT m_nc_alt();

/* PF 060292 */ /* PF 040692 */
/***********************************************************************/
/*                                                                     */
/*    Diese Routine berechnet den Vektor der Konjugiertenklassen       */
/*    der An.                                                          */
/*    Rueckgabewert: OK oder error                                     */
/*                                                                     */
/***********************************************************************/

INT ak_make_alt_classes(n,res)
	OP n;		/* Gewicht der Partitionen */
	OP res;		/* Vektor der Konjugiertenklassen der An */
	{
	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;

	INT alt_dimension();	/* Hilfsroutinen */
	INT split();

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

	/*** Test auf Ganzzahligkeit von n ************************************/

	if (S_O_K(n) != INTEGER)
		{
		error("ak_make_alt_classes : n is no INTEGER.");
		return ERROR;
		}
	if (S_I_I(n) <= 0L)
		{
		error("ak_make_alt_classes : n is negativ.");
		return ERROR;
		}
	
	/*** 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 += SYMfreeall(par);
	erg += SYMfreeall(per);
	erg += SYMfreeall(sgn);
	erg += SYMfreeall(l);

	/*** Rueckkehr in die aufrufende Routine *******************************/

	ENDR("ak_make_alt_classes");
	} /* Ende von make_alt_classes */

INT ak_make_alt_partitions(n,res)
	OP n;		/* Gewicht der Partitionen */
	OP res;		/* Vektor der irred. Darst. der An */
	{
	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;

	INT alt_dimension();	/* Hilfsroutinen */
	INT part_comp();

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

	/*** Test auf Ganzzahligkeit von n ************************************/

	if (S_O_K(n) != INTEGER)
		{
		error("ak_make_alt_partitions : n is no INTEGER.");
		return ERROR;
		}
	if (S_I_I(n) <= 0L)
		{
		error("ak_make_alt_partitions : n is negativ.");
		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(par,par));

	/*** Speicherplatzfreigabe *********************************************/

	erg += SYMfreeall(par);
	erg += SYMfreeall(conpar);
	erg += SYMfreeall(l);

	/*** Rueckkehr in die aufrufende Routine *******************************/

	ENDR("ak_make_alt_partitions");
	}/* Ende von make_alt_partitions */

INT scan_gl_nc(a,b) OP a,b;
/* AK 100692 */
{
	OBJECTKIND k;
	INT i,erg = OK;
	OP 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 += SYMfreeall(c);
	ENDR("scan_gl_nc");
}

#ifdef CHARTRUE
INT reduce_nc(a,b) OP a,b;
{
	OP c =callocobject();
	OP d =callocobject();
	INT i, erg=OK;
	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));
		}
	erg += SYMfreeall(c);
	erg += SYMfreeall(d);
	ENDR("reduce_nc");
}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT scalarproduct_nc(a,b,c) OP a,b,c;
{
	OP d = callocobject();
	OP e = callocobject();
	INT erg = OK;
	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 += sum(d,e);
	erg += m_gl_go(S_NC_GL(a),d);
	erg += div3(e,d,c);
	erg += SYMfreeall(e);
	erg += SYMfreeall(d);
	return erg;
}
#endif /* CHARTRUE */
INT m_gl_go(a,b) OP a,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)) /* AK 291092 */
		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
INT m_gl_il(a,b) OP a,b;
/* AK 090692 */
{
	INT erg = OK;
	INT i;

        if (check_equal_2(a,b,m_gl_il,&erg) == EQUAL)
                return erg;

        if (CYCLIC_GL(a)) /* AK 300695 */
                {
                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;
                }
	if (SYM_GL(a))
		return makevectorofpart(S_GL_SYM_A(a),b);
	if (ALT_GL(a))
		return ak_make_alt_partitions(S_GL_ALT_A(a),b);
#ifdef KRANZTRUE
	if (KRANZ_GL(a))
		return m_vcl_kranz(a,b);
#endif /* KRANZTRUE */
	error("can not compute irr labeling");
	return ERROR;
}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT m_gl_nc(a,b,c) OP a,b,c;
/* AK 090692 */
{
	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 += SYMfreeall(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 += SYMfreeall(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 += SYMfreeall(d);
			return erg;
			}
		}
#endif /* KRANZTRUE */
	println(a); println(b);
	return error("can not compute irr char");
}
#endif /* CHARTRUE */

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

        if (check_equal_2(a,b,m_gl_cl,&erg) == EQUAL)
                return erg;

        if (CYCLIC_GL(a)) /* AK 300695 */
                {
                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
	if (SYM_GL(a))
		return makevectorofpart(S_GL_SYM_A(a),b);
	if (ALT_GL(a))
		return ak_make_alt_classes(S_GL_ALT_A(a),b);
#endif /* PARTTRUE */
#ifdef KRANZTRUE
	if (KRANZ_GL(a))
		return m_vcl_kranz(a,b);
#endif /* KRANZTRUE */
	error("can not compute class labeling");
	return ERROR;
}

INT m_gl_co(a,b) OP a,b;
{
	OP c,d;
	INT i,erg=OK;
	if (check_equal_2(a,b,m_gl_co,&erg) == EQUAL)
                return erg;
                                           
	if (CYCLIC_GL(a)) /* AK 300695 */
		{
		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;
		}
	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 += SYMfreeall(c);
		return erg;
		}
	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 += div3(S_V_I(b,i),cons_zwei,S_V_I(b,i));
				}
			}
		erg += SYMfreeall(c);
		return erg;
		}
#ifdef KRANZTRUE
	if (KRANZ_GL(a))
		{
		c = callocobject();
		d = callocobject();
		erg += m_gl_cl(a,c);
		erg += m_gl_cl(S_GL_KRANZ_GLA(a),d); /* labeling of classes
					for the first group */
		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 += SYMfreeall(d);
		erg += SYMfreeall(c);
		return erg;
		}
#endif /* KRANZTRUE */
	return error("can not compute class order");
}

INT m_gl_cr(a,b) OP a,b;
{
	OP c;
	INT i,j,erg=OK;
	if (check_equal_2(a,b,m_gl_cr,&erg) == EQUAL)
                return erg;
	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));
			}
		return erg;
		}
	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 += SYMfreeall(c);
		return erg;
		}
#ifdef MATRIXTRUE
	if (ALT_GL(a))
		{
		c = callocobject();
		erg += makealtclassreps(S_GL_ALT_A(a),c,b);
		erg += SYMfreeall(c);
		return erg;
		}
#endif /* MATRIXTRUE */
	error("can not compute class reps");
	return ERROR;
}

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

INT cyclic_tafel(a,b) OP a,b;
{
	INT erg = OK,i,j;
	OP c;
	CTO(INTEGER,"cyclic_tafel",a);
	if (check_equal_2(a,b,cyclic_tafel,&erg) == EQUAL)
                return erg;
	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));
		}
	SYMfreeall(c);
	ENDR("cyclic_tafel");
}


#ifdef KRANZTRUE
INT m_vec_grad_nc_hyp(v,g,c) OP v,g,c;
/* v is vector with char values 
   g is degree of hyperoktaeder group
   c becomes character
*/
{
	OP d;
	INT erg = OK;
	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 += SYMfreeall(d);
	ENDR("m_vec_grad_nc_hyp");
}
#endif /* KRANZTRUE */

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

#ifdef KRANZTRUE
INT reduce_nc_kranz(a,b) OP a,b;
{
	OP c ,d,e,f,g;
	INT erg = OK;
	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 += div3(c,g,c);
		erg += sum(c,S_V_I(S_NC_C(b),S_I_I(d)));
	}
	erg += SYMfreeall(c); 
	erg += SYMfreeall(d); 
	erg += SYMfreeall(e); 
	erg += SYMfreeall(f); 
	erg += SYMfreeall(g);
	ENDR("reduce_nc_kranz");
}
#endif /* KRANZTRUE */

#ifdef KRANZTRUE
INT mult_nc_kranz(a,b,c) OP a,b,c;
{
	INT erg = OK;
	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");
}
#endif /* KRANZTRUE */

#ifdef KRANZTRUE
INT grouporder_kranz(l,a) OP l,a;
{
	OP zz,z;
	INT erg = OK;
	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 += SYMfreeall(z); 
	erg += SYMfreeall(zz);
	ENDR("grouporder_kranz");
}
#endif /* KRANZTRUE */

#ifdef KRANZTRUE
INT scan_nc_kranz(a) OP a;
{
	OP b,c,l,d;
	OBJECTKIND k;
	INT i;
	INT erg = OK;
	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 += SYMfreeall(b);
	erg += SYMfreeall(c);
	erg += SYMfreeall(l);
	erg += SYMfreeall(d);
	ENDR("scan_nc_kranz");
}
#endif /* KRANZTRUE */

#ifdef KRANZTRUE
INT m_vcl_kranz(l,a) OP l,a;
/* AK 050692 */
/* computes the class labeling of a wreath product
   of two symm groups. l is the corresponding group label */
/* a becomes vector of matrices */
{
	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)); 
	}
	sort(a);
	SYMfreeall(f); SYMfreeall(h); SYMfreeall(c);
	return OK;
}
#endif /* KRANZTRUE */

#ifdef KRANZTRUE
INT m_vco_kranz(l,a) OP l,a;
/* vector of class orders of a wreath product of two symm
	groups */
{
	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)); 
		}
	
	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);
		}
	SYMfreeall(f); SYMfreeall(c); SYMfreeall(h);
	return OK;
}
#endif /* KRANZTRUE */

#ifdef KRANZTRUE
INT numberof_class_kranz(l,a) OP l,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 += SYMfreeall(f);
	erg += SYMfreeall(c);
	return erg;
}
#endif /* KRANZTRUE */

#ifdef KRANZTRUE
INT order_class_kranz(l,i,a) OP l,i,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 += sort(h);
	erg += typusorder(S_V_I(h,S_I_I(i)), zb, za, a, f);
	erg += SYMfreeall(f); 
	erg += SYMfreeall(c); 
	erg += SYMfreeall(h);
	return erg;
}
#endif /* KRANZTRUE */

#ifdef KRANZTRUE
INT m_nc_kranz(l,i,b) OP l,i,b;
/* l is group label
   i is integer which selects the i-th ireducible character
   b becomes character
*/
{
	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 += SYMfreeall(d);
		erg += SYMfreeall(e);
		erg += SYMfreeall(ll);
		erg += SYMfreeall(c);
		
	return erg;
}
#endif /* KRANZTRUE */

#ifdef KRANZTRUE
INT m_gl_symkranz(a,b,c) OP a,b,c;
/* make group label for kranzprodukt of two sym groups 
  c = s_a wr s_b */
/* AK 050692 */
{
	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;
}
#endif /* KRANZTRUE */

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

INT m_gl_cyclic(a,b) OP a,b;
/* make group-label for cyclic */ /* AK 291092 */
{
	INT erg = OK;
	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));
	return erg;
}

INT m_gl_alt(a,b) OP a,b;
/* make group-label for alt */ /* AK 050692 */
{
	INT erg = OK;
	erg += m_il_v(2L,b); 
	erg += m_i_i(2L,S_V_I(b,0L)); /* 2 == alternating group */
	erg += copy(a,S_V_I(b,1L));
	return erg;
}

INT m_gl_sym(a,b) OP a,b;
/* make group-label for sym */ /* AK 050692 */
{
	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
static INT m_nc_alt(c,b,a) OP c,b,a;
/* b is part or vec in case of splitting rep */
/* c is group label of thew alternating group */
{
	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));
			}
		}
	SYMfreeall(d);
	SYMfreeall(e);
	return erg;
}
#endif /* CHARTRUE */

#ifdef CHARTRUE 
static INT m_nc_sym(b,a) OP b,a;
/* b is partition 
   a becomes irred char */
{
	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 += SYMfreeall(c);
	return erg;
}
#endif /* CHARTRUE */

/* Ab hier bis ende PF */
/* PF 050292 */ /* PF 040692 */
/***********************************************************************/
/*                                                                     */
/*    Diese Routine berechnet zwei Vektoren.                           */
/*    1.Vektor:	 Partition der Konjugiertenklassen der An (class)      */
/*    2.Vektor:  Standardrepraesentanten dieser Klassen (reps)         */
/*    Rueckgabewert: OK oder error                                     */
/*                                                                     */
/***********************************************************************/

#ifdef MATRIXTRUE
INT makealtclassreps(n,class,reps)
	OP 	n,class,reps;
	{
	OP	matrix;		/* Partitionen der Klassen */
	OP	trans;		/* (12) */
	INT	i,j;
	INT erg=OK;

	INT make_alt_classes(); 	/* Hilfsroutinen */
	INT std_perm();

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

	if (not EMPTYP(reps))
		erg +=  freeself(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));
			}
		}

	/*** Speicherplatzfreigabe ********************************************/

	erg += SYMfreeall(matrix);
	erg += SYMfreeall(trans);

	/*** Rueckkehr in die aufrufende Routine *******************************/

	if (erg != OK)
		{
		error("makealtclassreps : error during computation.");
		return ERROR;
		}
	return OK;
	} /* Ende von makealtclassreps */
#endif /* MATRIXTRUE */

/* PF 040692 */
/***********************************************************************/
/*                                                                     */
/*    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(a,b)
	OP a,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))
		{
		SYMfreeall(l);
		return -1L;
		}
	if(S_PA_II(a,S_PA_LI(a)-i)>S_PA_II(b,S_PA_LI(b)-i))
		{
		SYMfreeall(l);
	  	return 1L;	
		}
	SYMfreeall(l);
	return 0L;
	}

/**************************************************************************/
/*	Diese Routine berechnet zu einer Partition die Standardpermutation    */
/*	in umgekehrter Reihenfolge wie m_part_perm().			*/
/*	Rueckgabewert: OK oder error.					  */
/**************************************************************************/

#ifdef PERMTRUE
INT std_perm(a,b) OP a,b;
/* erzeugt aus zykeltyp standardpermutation */
{
	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));
	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 */

/* PF 250292 */
/***************************************************************************/ 
/*                                                                         */
/*   Diese Routine berechnet den Charakterwert einer irreduziblen          */
/*   Darstellung (rep) auf der Konjugiertenklasse (part) der An.           */
/*   Rueckgabewert:   OK oder error                                        */
/*                                                                         */
/***************************************************************************/

#ifdef MATRIXTRUE
INT a_charvalue(rep,part,res)
    OP rep;		/* Partition der irreduziblen Darstellung der An     */
	OP part;	/* Partition der Konjugiertenklasse oder Permutation */
	OP res;         /* Beginn: leer; Ende: Charakterwert                 */
	{	
	OP conrep;	/* konjugierte Partition zu rep */
	OP newpart;	/* Zykelpartition,falls part Permutation ist */ 
	OP h_part;	/* Hakenpartition zu rep */ 
	OP sgn;		/* Signum zu part */ 
	OP w_eins,w_zwei;	/* Gewichte von rep und part zum Gleichheits-Check */
	INT erg=OK;	/* Rueckgabewert */

	if (S_O_K(rep) != PARTITION)
		return error("a_charvalue:wrong type");


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

	/*** newpart wird Partition der Konjugiertenklasse, ***/
	/*** part wird Permutation daraus. ***/

	newpart = callocobject(); 
	if (S_O_K(part) == PERMUTATION)
		erg += zykeltyp(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(part,sgn);
	if (S_I_I(sgn) == -1L)
		{
		erg += SYMfreeall(newpart);
		erg += SYMfreeall(sgn);
		error("a_charvalue: odd permutation ");
		return erg;
		}

	/*** Test, ob rep und newpart Partitionen der gleichen Zahl n sind ***/

	w_eins = callocobject(); 
	w_zwei = callocobject(); 
	erg += weight(rep,w_eins);
	erg += weight(newpart,w_zwei);
	if (comp(w_eins,w_zwei) != 0L)
		{
		erg += SYMfreeall(newpart);
		erg += SYMfreeall(sgn);
		erg += SYMfreeall(w_eins);
		erg += SYMfreeall(w_zwei);
		error("a_charvalue: disagree in partition weights"); 
		return erg;
		}

	/*** Falls rep nicht selbstassoziiert ist, kann der Charakterwert ***/
	/*** wie bei der Sn (Murnaghan-Nakayama) berechnet werden. ***/

	conrep = callocobject(); 
	erg += conjugate(rep,conrep);
	if(neq(rep,conrep))
		{
		erg += charvalue(rep,part,res,NULL);
		erg += SYMfreeall(conrep);
		erg += SYMfreeall(newpart);
		erg += SYMfreeall(sgn);
		erg += SYMfreeall(w_eins);
		erg += SYMfreeall(w_zwei);
		return erg;
		}
	
	/*** 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(comp(h_part,newpart) != 0L)
		{
		erg += charvalue(rep,part,res,NULL);
		erg += div3(res,cons_zwei,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),newpart,res);
	
acv_ende:	
	erg += SYMfreeall(conrep);
	erg += SYMfreeall(newpart);
	erg += SYMfreeall(h_part);
	erg += SYMfreeall(sgn);
	erg += SYMfreeall(w_eins);
	erg += SYMfreeall(w_zwei);
	if (erg != OK)
		error("a_charvalue:error during computation");
	return erg;
	}
#endif /* MATRIXTRUE */
/* PF 120292 */
/***********************************************************************/
/*                                                                     */
/*    Diese Routine entscheidet, ob die Permutation per einer ueber    */
/*    der An zerfallenden Konjugiertenklasse im ersten oder zweiten    */
/*    Teil dieser Klasse liegt.                                        */
/*    Rueckgabewert: 0L, falls per im ersten Teil liegt                */
/*                   1L, sonst                                         */
/*                                                                     */
/***********************************************************************/

#ifdef MATRIXTRUE
INT which_part(per)
	OP per;		/* Permutation einer zerfallenden Klasse */
	{
	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 */
	OP vgl;
	INT alt,neu,i,j,k,l;

	typ=callocobject();
	std=callocobject();
	sgn=callocobject();
	check=callocobject();
	std_first=callocobject();
	vgl=callocobject();

	zykeltyp(per,typ);
	m_ilih_nm(S_PA_LI(typ),2L,std_first);
	for(i=0L;i<S_PA_LI(typ);i++)
		copy(S_PA_I(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,vgl);
		copy(vgl,S_M_IJ(std_first,1L,l));
		}

	/* Belegung des Konjugators */
			
	k=0L;
	for(i=S_PA_LI(typ)-1L;i>=0L;i--)
		{
		add(S_M_IJ(std_first,1L,i),cons_eins,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++)
			{
			copy(S_P_I(per,l),S_P_I(std,k));
			l=S_P_II(per,l)-1L;
			k++;
			}
		}
	
	signum(std,sgn);
	if(S_I_I(sgn)==1L)
		{
		SYMfreeall(std);
		SYMfreeall(typ);
		SYMfreeall(std_first);
		SYMfreeall(check);
		SYMfreeall(vgl);
		SYMfreeall(sgn);
 		return 0L;
		}
	if(S_I_I(sgn)==-1L)
		{
		SYMfreeall(std);
		SYMfreeall(typ);
		SYMfreeall(std_first);
		SYMfreeall(check);
		SYMfreeall(vgl);
		SYMfreeall(sgn);
 		return 1L;
		}
	return error("which_part: impossible");	 
	}

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

	INT alt_dimension();	/* Hilfsroutinen */
	INT part_comp();

	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 += SYMfreeall(par);
	erg += SYMfreeall(conpar);
	erg += SYMfreeall(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 */

/* PF 060292 */ /* PF 040692 */ 
/***********************************************************************/
/*                                                                     */
/*    Diese Routine berechnet den Vektor der Konjugiertenklassen       */
/*    der An.                                                          */
/*    Rueckgabewert: OK oder error                                     */
/*                                                                     */
/***********************************************************************/

#ifdef MATRIXTRUE
INT make_alt_classes(n,res)
	OP n;		/* Gewicht der Partitionen */
	OP res;		/* Vektor der Konjugiertenklassen der An */
	{
	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;

	INT alt_dimension();	/* Hilfsroutinen */
	INT split();

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

	/*** Test auf Ganzzahligkeit von n ************************************/

	if (S_O_K(n) != INTEGER)
		{
		error("make_alt_classes : n is no INTEGER.");
		return ERROR;
		}
	if (S_I_I(n) <= 0L)
		{
		error("make_alt_classes : n is negativ.");
		return ERROR;
		}

	/*** 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 += SYMfreeall(par);
	erg += SYMfreeall(per);
	erg += SYMfreeall(sgn);
	erg += SYMfreeall(l);

/*** Rueckkehr in die aufrufende Routine *******************************/

	if (erg != OK)
		{
		error("make_alt_classes : error during computation.");
		return ERROR;
		}
	return OK;
	} /* Ende von make_alt_classes */
#endif /* MATRIXTRUE */

/* PF 040692 */ /* PF 100692 */
/**********************************************************************/
/*                                                                    */
/*    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(n,res)
	OP n,res;
	{
	OP par;		/* Partition von n */
	OP conpar; 	/* konjugierte Partition */ 
	INT erg=OK;

	INT part_comp();	/* Hilfsroutine */

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

	/*** Test auf Ganzzahligkeit von n ************************************/

	if (S_O_K(n) != INTEGER)
		{
		error("alt_dimension : n is no INTEGER.");
		return ERROR;
		}
	if (S_I_I(n) <= 0L)
		{
		error("alt_dimension : n is negativ.");
		return ERROR;
		}
	
	/*** 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 += SYMfreeall(par);
	erg += SYMfreeall(conpar);

	/*** Rueckkehr in die aufrufende Routine *******************************/

	if (erg != OK)
		EDC("alt_dimension");
	return erg;
	} /* Ende von alt_dimension */



/* PF 040692 */ /* PF 100692 */
/*****************************************************************************/
/*	DIESE ROUTINE UEBERPRUEFT, OB DIE KONJUGIERTENKLASSE PAR UEBER     */
/*	DER An ZERFAELLT. 						   */
/*	RUECKGABEWERT:	1	FALLS DIE KLASSE ZERFAELLT,		  */
/*					0	SONST.			 */
/*****************************************************************************/

INT split(n,par) OP	n,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)
			{
			SYMfreeall(w);
			SYMfreeall(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)
			{
			SYMfreeall(w);
			SYMfreeall(v);
			return 0L;
			}
	SYMfreeall(w);
	SYMfreeall(v);
	return 1L;
	}
/* PF 070592 *//* PF 010692 */ /* AK 020692 */
/****************************************************************************/
/*									    */
/*  Diese Routine berechnet die Charaktertafel der alternierenden Gruppe    */
/*  An fuer eine beliebige natuerliche Zahl n.			*/
/*	VERSION 1.2	 PF040592					*/
/****************************************************************************/

#ifdef MATRIXTRUE
INT an_tafel(n,tafel) OP	n,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	length=0L;	/* Groesse der Charaktertafel der An */
	INT	zeile,spalte;	/* Indexvariable bei der Belegung der Charaktertafel */
	INT erg=OK;		/* Rueckgabewert */


/*** Loeschen der alten Eintraege von tafel ***************************/

	if (not EMPTYP(tafel))
		{
		erg +=  freeself(tafel);
		}

	/*** Test auf Ganzzahligkeit von n ************************************/

	if (s_o_k(n) != INTEGER)
		{
		error("an_tafel : n is no INTEGER.");
		return ERROR;
		}
	if (S_I_I(n) <= 0L)
		{
		error("an_tafel : n is negativ.");
		return ERROR;
		}
	
	/*** 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); /* AK 120692 */
		erg += m_i_i(1L,S_M_IJ(tafel,0L,0L));
		return erg;
		}

	/*** 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));
			length++;
			}

/*** 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)));
			length++;
			}

/*** 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(par,par));

/***********************************************************************/
/*** Initialisierung der Charaktertafel als Nullmatrix *****************/

	erg +=  m_ilih_m(length,length,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 +=  div3(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 +=  div3(hilf,cons_zwei,S_M_IJ(tafel,zeile,spalte));
			erg +=  copy(S_M_IJ(tafel,zeile,spalte),
					S_M_IJ(tafel,zeile+1L,spalte));
			erg +=  copy(S_M_IJ(tafel,zeile,spalte),
				S_M_IJ(tafel,zeile+1L,spalte+1L));
			erg +=  copy(S_M_IJ(tafel,zeile,spalte),
				S_M_IJ(tafel,zeile,spalte+1L));
						}
						
					spalte = spalte+2L;
					}
				}
			zeile = zeile+2L;
			spalte = 0L;
			}
		}
/************************************************************************/

	/*** Speicherplatzfreigabe ***/

	erg +=  SYMfreeall(v_part);
	erg +=  SYMfreeall(conpar);
	erg +=  SYMfreeall(par);
	erg +=  SYMfreeall(per);
	erg +=  SYMfreeall(sgn);
	erg +=  SYMfreeall(hilf);
	erg +=  SYMfreeall(split_class);
	erg +=  SYMfreeall(info_cc);
	erg +=  SYMfreeall(info_pa);

	/*** Rueckkehr in die aufrufende Routine *******************************/

	if (erg != OK)
		{
		error("an_tafel : error during computation.");
		return ERROR;
		}
	return erg;
}/*** Ende von an_tafel ***/
#endif /* MATRIXTRUE */

/*****************************************************************************/
/*	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					     */
/*****************************************************************************/
/* PF 200891 V1.3 */ /* PF 070592 */ /* PF 110992 */

#ifdef CHARTRUE
INT wert(index,split_class,res) OP	split_class,res; INT	index;
	{
	INT	i;
	OP	expo,	term_eins,	term_zwei,	zwei;
	OP	n;
	INT erg=OK;

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

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


	erg += 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 += m_i_i(2L,zwei);
	erg += div3(res,zwei,res);


	erg += SYMfreeall(expo);
	erg += SYMfreeall(term_eins);
	erg += SYMfreeall(term_zwei);
	erg += SYMfreeall(zwei);
	erg += SYMfreeall(n);

	if ( erg != OK )
		error("wert : error during computation.");
	return erg;
	}
#endif /* CHARTRUE */

/*****************************************************************************/
/*	DIESE ROUTINE BERECHNET ZU EINER SELBSTASSOZIIERTEN PARTITION PAR DIE */
/*	PARTITION, DIE AUS DEN HAKENLAENGEN VON PAR BESTEHT.		      */
/*****************************************************************************/

#ifdef PARTTRUE
INT hook_part(par,res) OP	par,res;
/* PF 070592 */
	{
	INT	i,j;
	INT	elementwert;
	OP	element;
	OP	v,hilfsvector;
	INT erg = OK;

	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 +=  SYMfreeall(v);
	erg +=  SYMfreeall(element);
	erg +=  SYMfreeall(hilfsvector);

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

#ifdef PERMTRUE
INT m_gl_first(a,b) OP a,b;
/* AK 291092 */
{
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");
}

INT m_gl_next(a,b,c) OP a,b,c;
/* AK 291092 */
{
	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);
		SYMfreeall(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(c,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 */

